From 3372bc25d03711aa2e61540fa483c4ca5d886639 Mon Sep 17 00:00:00 2001
From: stefanyagl <42984899+stefanyagl@users.noreply.github.com>
Date: Sun, 9 Jun 2019 00:08:30 +0700
Subject: [PATCH 01/46] Add files via upload

Test version of Bessel beams implementation in ADDA
---
 GenerateB.c |  529 +++++++++++
 bess.c      |  352 +++++++
 bess.h      |   27 +
 const.h     |  427 +++++++++
 param.c     | 2568 +++++++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 3903 insertions(+)
 create mode 100644 GenerateB.c
 create mode 100644 bess.c
 create mode 100644 bess.h
 create mode 100644 const.h
 create mode 100644 param.c

diff --git a/GenerateB.c b/GenerateB.c
new file mode 100644
index 00000000..ebd6f92c
--- /dev/null
+++ b/GenerateB.c
@@ -0,0 +1,529 @@
+/* File: GenerateB.c
+ * $Date::                            $
+ * Descr: generate a incident beam
+ *
+ *        Lminus beam is based on: G. Gouesbet, B. Maheu, G. Grehan, "Light scattering from a sphere arbitrary located
+ *        in a Gaussian beam, using a Bromwhich formulation", J.Opt.Soc.Am.A 5,1427-1443 (1988).
+ *        Eq.(22) - complex conjugate.
+ *
+ *        Davis beam is based on: L. W. Davis, "Theory of electromagnetic beams," Phys.Rev.A 19, 1177-1179 (1979).
+ *        Eqs.(15a),(15b) - complex conjugate; in (15a) "Q" changed to "Q^2" (typo).
+ *
+ *        Barton beam is based on: J. P. Barton and D. R. Alexander, "Fifth-order corrected electromagnetic-field
+ *        components for a fundamental Gaussian-beam," J.Appl.Phys. 66,2800-2802 (1989).
+ *        Eqs.(25)-(28) - complex conjugate.
+ *
+ * Copyright (C) 2006-2014 ADDA contributors
+ * This file is part of ADDA.
+ *
+ * ADDA is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as
+ * published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
+ *
+ * ADDA is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ * of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along with ADDA. If not, see
+ * <http://www.gnu.org/licenses/>.
+ */
+#include "const.h" // keep this first
+// project headers
+#include "cmplx.h"
+#include "comm.h"
+#include "io.h"
+#include "interaction.h"
+#include "param.h"
+#include "vars.h"
+#include <stdio.h>
+#include <string.h>
+#include "bess.h"
+
+// SEMI-GLOBAL VARIABLES
+
+// defined and initialized in param.c
+extern const int beam_Npars;
+extern const double beam_pars[];
+extern const char *beam_fnameY;
+extern const char *beam_fnameX;
+extern const opt_index opt_beam;
+
+// used in CalculateE.c
+double C0dipole,C0dipole_refl; // inherent cross sections of exciting dipole (in free space and addition due to surface)
+
+// used in crosssec.c
+double beam_center_0[3]; // position of the beam center in laboratory reference frame
+/* complex wave amplitudes of secondary waves (with phase relative to particle center);
+ * The transmitted wave can be inhomogeneous wave (when msub is complex), then eIncTran (e) is normalized
+ * counter-intuitively. Before multiplying by tc, it satisfies (e,e)=1!=||e||^2. This normalization is consistent with
+ * used formulae for transmission coefficients. So this transmission coefficient is not (generally) equal to the ratio
+ * of amplitudes of the electric fields. In particular, when E=E0*e, ||E||!=|E0|*||e||, where
+ * ||e||^2=(e,e*)=|e_x|^2+|e_y|^2+|e_z|^2=1
+ *
+ * !!! TODO: determine whether they are actually needed in crosssec.c, or make them static here
+ */
+doublecomplex eIncRefl[3],eIncTran[3];
+// used in param.c
+char beam_descr[MAX_MESSAGE2]; // string for log file with beam parameters
+
+// LOCAL VARIABLES
+static double s,s2;            // beam confinement factor and its square
+static double scale_x,scale_z; // multipliers for scaling coordinates
+static doublecomplex ki,kt;    // abs of normal components of k_inc/k0, and ktran/k0
+static doublecomplex ktVec[3]; // k_tran/k0
+static double p0;              // amplitude of the incident dipole moment
+static int n0;                 // Bessel beam order
+static double alpha0;          // half-cone angle
+/* TO ADD NEW BEAM
+ * Add here all internal variables (beam parameters), which you initialize in InitBeam() and use in GenerateB()
+ * afterwards. If you need local, intermediate variables, put them into the beginning of the corresponding function.
+ * Add descriptive comments, use 'static'.
+ */
+
+//======================================================================================================================
+
+void InitBeam(void)
+// initialize beam; produce description string
+{
+	double w0; // beam width
+	/* TO ADD NEW BEAM
+	 * Add here all intermediate variables, which are used only inside this function.
+	 */
+	// initialization of global option index for error messages
+	opt=opt_beam;
+	// beam initialization
+	switch (beamtype) {
+		case B_PLANE:
+			if (IFROOT) strcpy(beam_descr,"plane wave");
+			beam_asym=false;
+			if (surface) {
+				if (prop_0[2]==0) PrintError("Ambiguous setting of beam propagating along the surface. Please specify "
+					"the incident direction to have (arbitrary) small positive or negative z-component");
+				if (msubInf && prop_0[2]>0) PrintError("Perfectly reflecting surface ('-surf ... inf') is incompatible "
+					"with incident direction from below (including the default one)");
+				// Here we set ki,kt,ktVec and propagation directions prIncRefl,prIncTran
+				if (prop_0[2]>0) { // beam comes from the substrate (below)
+					// here msub should always be defined
+					inc_scale=1/creal(msub);
+					ki=msub*prop_0[2];
+					/* Special case for msub near 1 to remove discontinuities for near-grazing incidence. The details
+					 * are discussed in CalcFieldSurf() in crosssec.c.
+					 */
+					if (cabs(msub-1)<ROUND_ERR && fabs(ki)<SQRT_RND_ERR) kt=ki;
+					else kt=cSqrtCut(1 - msub*msub*(prop_0[0]*prop_0[0]+prop_0[1]*prop_0[1]));
+					// determine propagation direction and full wavevector of wave transmitted into substrate
+					ktVec[0]=msub*prop_0[0];
+					ktVec[1]=msub*prop_0[1];
+					ktVec[2]=kt;
+				}
+				else if (prop_0[2]<0) { // beam comes from above the substrate
+					inc_scale=1;
+					vRefl(prop_0,prIncRefl);
+					ki=-prop_0[2];
+					if (!msubInf) {
+						// same special case as above
+						if (cabs(msub-1)<ROUND_ERR && fabs(ki)<SQRT_RND_ERR) kt=ki;
+						else kt=cSqrtCut(msub*msub - (prop_0[0]*prop_0[0]+prop_0[1]*prop_0[1]));
+						// determine propagation direction of wave transmitted into substrate
+						ktVec[0]=prop_0[0];
+						ktVec[1]=prop_0[1];
+						ktVec[2]=-kt;
+					}
+				}
+				else LogError(ONE_POS,"Ambiguous setting of beam propagating along the surface. Please specify the"
+					"incident direction to have (arbitrary) small positive or negative z-component");
+				vRefl(prop_0,prIncRefl);
+				if (!msubInf) {
+					vReal(ktVec,prIncTran);
+					vNormalize(prIncTran);
+				}
+			}
+			return;
+		case B_DIPOLE:
+			vCopy(beam_pars,beam_center_0);
+			if (surface) {
+				if (beam_center_0[2]<=-hsub)
+					PrintErrorHelp("External dipole should be placed strictly above the surface");
+				inc_scale=1; // but scaling of Mueller matrix is weird anyway
+			}
+			// in weird scenarios the dipole can be positioned exactly at the origin; reused code from Gaussian beams
+			beam_asym=(beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0);
+			if (!beam_asym) vInit(beam_center);
+			/* definition of p0 is important for scaling of many scattering quantities (that are normalized to incident
+			 * irradiance). Alternative definition is p0=1, but then the results will scale with unit of length
+			 * (breaking scale invariance)
+			 */
+			p0=1/(WaveNum*WaveNum*WaveNum);
+			if (IFROOT) sprintf(beam_descr,"point dipole at "GFORMDEF3V,COMP3V(beam_center_0));
+			return;
+		case B_LMINUS:
+		case B_DAVIS3:
+		case B_BARTON5:
+			if (surface) PrintError("Currently, Gaussian incident beam is not supported for '-surf'");
+			// initialize parameters
+			w0=beam_pars[0];
+			TestPositive(w0,"beam width");
+			vCopy(beam_pars+1,beam_center_0);
+			beam_asym=(beam_Npars==4 && (beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0));
+			if (!beam_asym) vInit(beam_center);
+			s=1/(WaveNum*w0);
+			s2=s*s;
+			scale_x=1/w0;
+			scale_z=s*scale_x; // 1/(k*w0^2)
+			// beam info
+			if (IFROOT) {
+				strcpy(beam_descr,"Gaussian beam (");
+				switch (beamtype) {
+					case B_LMINUS:
+						strcat(beam_descr,"L- approximation)\n");
+						break;
+					case B_DAVIS3:
+						strcat(beam_descr,"3rd order approximation, by Davis)\n");
+						break;
+					case B_BARTON5:
+						strcat(beam_descr,"5th order approximation, by Barton)\n");
+						break;
+					default: break;
+				}
+				sprintf(beam_descr+strlen(beam_descr),"\tWidth="GFORMDEF" (confinement factor s="GFORMDEF")\n"
+				                                      "\tCenter position: "GFORMDEF3V,w0,s,COMP3V(beam_center_0));
+			}
+			return;
+		case B_BESSELCS:
+			if (surface) PrintError("Currently, Bessel incident beam is not supported for '-surf'");
+			// initialize parameters
+			n0=beam_pars[0];
+			alpha0 = beam_pars[1];
+			//TestPositive(n0,"order of bessel beam");
+			vCopy(beam_pars+2,beam_center_0);
+			beam_asym=(beam_Npars==4 && (beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0));
+			if (!beam_asym) vInit(beam_center);
+			if (IFROOT) {
+				strcpy(beam_descr,"Bessel beam (CS - representation)");
+				sprintf(beam_descr+strlen(beam_descr),"\tOrder="GFORMDEF" tilt angle alpha0="GFORMDEF")\n"
+				                                      "\tCenter position: "GFORMDEF3V,n0,alpha0,COMP3V(beam_center_0));
+			}
+			return;
+		case B_BESSELLP:
+			if (surface) PrintError("Currently, Bessel incident beam is not supported for '-surf'");
+			// initialize parameters
+			n0=beam_pars[0];
+			alpha0 = beam_pars[1];
+			//TestPositive(n0,"order of bessel beam");
+			vCopy(beam_pars+2,beam_center_0);
+			beam_asym=(beam_Npars==4 && (beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0));
+			if (!beam_asym) vInit(beam_center);
+			if (IFROOT) {
+				strcpy(beam_descr,"Bessel beam (LP - representation)");
+				sprintf(beam_descr+strlen(beam_descr),"\tOrder="GFORMDEF" tilt angle alpha0="GFORMDEF")\n"
+				                                      "\tCenter position: "GFORMDEF3V,n0,alpha0,COMP3V(beam_center_0));
+			}
+			return;
+		case B_READ:
+			// the safest is to assume cancellation of all symmetries
+			symX=symY=symZ=symR=false;
+			if (surface) inc_scale=1; // since we can't know it, we assume the default case
+			if (IFROOT) {
+				if (beam_Npars==1) sprintf(beam_descr,"specified by file '%s'",beam_fnameY);
+				else sprintf(beam_descr,"specified by files '%s' and '%s'",beam_fnameY,beam_fnameX);
+			}
+			// we do not define beam_asym here, because beam_center is not defined anyway
+			return;
+	}
+	LogError(ONE_POS,"Unknown type of incident beam (%d)",(int)beamtype);
+	/* TO ADD NEW BEAM
+	 * add a case above. Identifier ('B_...') should be defined inside 'enum beam' in const.h. The case should
+	 * 1) save all the input parameters from array 'beam_pars' to local variables (defined in the beginning of this
+	 *    source files)
+	 * 2) test all input parameters (for that you're encouraged to use functions from param.h since they would
+	 *    automatically produce informative output in case of error).
+	 * 3) the symmetry breaking due to prop or beam_center is taken care of in VariablesInterconnect() in param.c.
+	 *    But if there are other reasons why beam would break any symmetry, corresponding variable should be set to
+	 *    false here. Do not set any of them to true, as they can be set to false by other factors.
+	 *    symX, symY, symZ - symmetries of reflection over planes YZ, XZ, XY respectively.
+	 *    symR - symmetry of rotation for 90 degrees over the Z axis
+	 * 4) initialize the following:
+	 *    beam_descr - descriptive string, which will appear in log file.
+	 *    beam_asym - whether beam center does not coincide with the reference frame origin. If it is set to true, then
+	 *                set also beam_center_0 - 3D radius-vector of beam center in the laboratory reference frame (it
+	 *                will be then automatically transformed to particle reference frame, if required).
+	 * 5) Consider the case of surface (substrate near the particle). If the new beam type is incompatible with it, add
+	 *    an explicit exception, like "if (surface) PrintErrorHelp(...);". Otherwise, you also need to define inc_scale.
+	 * All other auxiliary variables, which are used in beam generation (GenerateB(), see below), should be defined in
+	 * the beginning of this file. If you need temporary local variables (which are used only in this part of the code),
+	 * define them in the beginning of this function.
+	 */
+}
+
+//======================================================================================================================
+
+void GenerateB (const enum incpol which,   // x - or y polarized incident light
+                doublecomplex *restrict b) // the b vector for the incident field
+// generates incident beam at every dipole
+{
+	size_t i,j;
+	doublecomplex psi0,Q,Q2;
+	doublecomplex v1[3],v2[3],v3[3],gt[6];
+	double ro, ro2,ro4;
+	double x,y,z,x2_s,xy_s;
+	doublecomplex t1,t2,t3,t4,t5,t6,t7,t8,ctemp;
+	const double *ex; // coordinate axis of the beam reference frame
+	double ey[3];
+	double r1[3];
+	double jn2[2];
+	double jn5[5];
+	const char *fname;
+	/* TO ADD NEW BEAM
+	 * Add here all intermediate variables, which are used only inside this function. You may as well use 't1'-'t8'
+	 * variables defined above.
+	 */
+
+	// set reference frame of the beam; ez=prop, ex - incident polarization
+	if (which==INCPOL_Y) {
+		ex=incPolY;
+		vMultScal(-1,incPolX,ey);
+	}
+	else { // which==INCPOL_X
+		ex=incPolX;
+		vCopy(incPolY,ey);
+	}
+
+	switch (beamtype) {
+		case B_PLANE: // plane is separate to be fast (for non-surface)
+			if (surface) {
+				/* With respect to normalization we use here the same assumption as in the free space - the origin is in
+				 * the particle center, and amplitude of incoming plane wave is equal to 1. Then irradiance of the beam
+				 * coming from below is c*Re(msub)/(8pi), different from that coming from above.
+				 * Original incident (incoming) beam propagating from the vacuum (above) is Exp(i*k*r.a), while - from
+				 * the substrate (below) is Exp(i*k*msub*r.a). We assume that the incoming beam is homogeneous in its
+				 * original medium.
+				 */
+				doublecomplex rc,tc; // reflection and transmission coefficients
+				if (prop[2]>0) { // beam comes from the substrate (below)
+					//  determine amplitude of the reflected and transmitted waves; here msub is always defined
+					if (which==INCPOL_Y) { // s-polarized
+						cvBuildRe(ex,eIncRefl);
+						cvBuildRe(ex,eIncTran);
+						rc=FresnelRS(ki,kt);
+						tc=FresnelTS(ki,kt);
+					}
+					else { // p-polarized
+						vInvRefl_cr(ex,eIncRefl);
+						crCrossProd(ey,ktVec,eIncTran);
+						rc=FresnelRP(ki,kt,1/msub);
+						tc=FresnelTP(ki,kt,1/msub);
+					}
+					// phase shift due to the origin at height hsub
+					cvMultScal_cmplx(rc*cexp(-2*I*WaveNum*ki*hsub),eIncRefl,eIncRefl);
+					cvMultScal_cmplx(tc*cexp(I*WaveNum*(kt-ki)*hsub),eIncTran,eIncTran);
+					// main part
+					for (i=0;i<local_nvoid_Ndip;i++) {
+						j=3*i;
+						// b[i] = eIncTran*exp(ik*kt.r)
+						cvMultScal_cmplx(cexp(I*WaveNum*crDotProd(ktVec,DipoleCoord+j)),eIncTran,b+j);
+					}
+				}
+				else if (prop[2]<0) { // beam comes from above the substrate
+					// determine amplitude of the reflected and transmitted waves
+					if (which==INCPOL_Y) { // s-polarized
+						cvBuildRe(ex,eIncRefl);
+						if (msubInf) rc=-1;
+						else {
+							cvBuildRe(ex,eIncTran);
+							rc=FresnelRS(ki,kt);
+							tc=FresnelTS(ki,kt);
+						}
+					}
+					else { // p-polarized
+						vInvRefl_cr(ex,eIncRefl);
+						if (msubInf) rc=1;
+						else {
+							crCrossProd(ey,ktVec,eIncTran);
+							cvMultScal_cmplx(1/msub,eIncTran,eIncTran); // normalize eIncTran by ||ktVec||=msub
+							rc=FresnelRP(ki,kt,msub);
+							tc=FresnelTP(ki,kt,msub);
+						}
+					}
+					// phase shift due to the origin at height hsub
+					cvMultScal_cmplx(rc*imExp(2*WaveNum*ki*hsub),eIncRefl,eIncRefl);
+					if (!msubInf) cvMultScal_cmplx(tc*cexp(I*WaveNum*(ki-kt)*hsub),eIncTran,eIncTran);
+					// main part
+					for (i=0;i<local_nvoid_Ndip;i++) {
+						j=3*i;
+						// b[i] = ex*exp(ik*r.a) + eIncRefl*exp(ik*prIncRefl.r)
+						cvMultScal_RVec(imExp(WaveNum*DotProd(DipoleCoord+j,prop)),ex,b+j);
+						cvLinComb1_cmplx(eIncRefl,b+j,imExp(WaveNum*DotProd(DipoleCoord+j,prIncRefl)),b+j);
+					}
+				}
+			}
+			else for (i=0;i<local_nvoid_Ndip;i++) { // standard (non-surface) plane wave
+				j=3*i;
+				ctemp=imExp(WaveNum*DotProd(DipoleCoord+j,prop)); // ctemp=exp(ik*r.a)
+				cvMultScal_RVec(ctemp,ex,b+j); // b[i]=ctemp*ex
+			}
+			return;
+		case B_DIPOLE: {
+			double dip_p[3]; // dipole moment, = p0*prop
+			vMultScal(p0,prop,dip_p);
+			for (i=0;i<local_nvoid_Ndip;i++) { // here we explicitly use that dip_p is real
+				j=3*i;
+				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
+				(*InterTerm_real)(r1,gt);
+				cSymMatrVecReal(gt,dip_p,b+j);
+				if (surface) { // add reflected field
+					r1[2]=DipoleCoord[j+2]+beam_center[2]+2*hsub;
+					(*ReflTerm_real)(r1,gt);
+					cReflMatrVecReal(gt,dip_p,v1);
+					cvAdd(v1,b+j,b+j);
+				}
+			}
+			/* calculate dipole inherent cross sections (for decay rate enhancements)
+			 * General formula is C0=4pi*k*Im(p0*.G(r0,r0).p0) and it is used for reflection; but for direct
+			 * interaction it is expected to be singular, so we use an explicit formula for point dipole:
+			 * C0=(8pi/3)*k^4*|p0|^2. Thus we discard the choice of "-int ...", but still the used value should be
+			 * correct for most formulations, e.g. poi, fcd, fcd_st, igt_so. Moreover, it is also logical, since the
+			 * exciting dipole is really point one, in contrast to the dipoles composing the particle.
+			 */
+			double temp=p0*WaveNum*WaveNum; // in principle, t1=1/k, but we keep a general formula
+			C0dipole=2*FOUR_PI_OVER_THREE*temp*temp;
+			if (surface) {
+				r1[0]=r1[1]=0;
+				r1[2]=2*(beam_center[2]+hsub);
+				(*ReflTerm_real)(r1,gt);
+				double tmp;
+				/* the following expression uses that dip_p is real and a specific (anti-)symmetry of the gt
+				 * a general expression is commented out below
+				 */
+				tmp=dip_p[0]*dip_p[0]*cimag(gt[0])+2*dip_p[0]*dip_p[1]*cimag(gt[1])+dip_p[1]*dip_p[1]*cimag(gt[3])
+				   +dip_p[2]*dip_p[2]*cimag(gt[5]);
+//				v1[0]=dip_p[0]; v1[1]=dip_p[1]; v1[2]=dip_p[2];
+//				cReflMatrVec(gt,v1,v2);
+//				tmp=cDotProd_Im(v2,v1);
+				C0dipole_refl=FOUR_PI*WaveNum*tmp;
+			}
+			return;
+		}
+		case B_LMINUS:
+		case B_DAVIS3:
+		case B_BARTON5:
+			for (i=0;i<local_nvoid_Ndip;i++) {
+				j=3*i;
+				// set relative coordinates (in beam's coordinate system)
+				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
+				x=DotProd(r1,ex)*scale_x;
+				y=DotProd(r1,ey)*scale_x;
+				z=DotProd(r1,prop)*scale_z;
+				ro2=x*x+y*y;
+				Q=1/(2*z-I);
+				psi0=-I*Q*cexp(I*Q*ro2);
+				// ctemp=exp(ik*z0)*psi0, z0 - non-scaled coordinate (z/scale_z)
+				ctemp=imExp(WaveNum*z/scale_z)*psi0;
+				// the following logic (if-else-if...) is hard to replace by a simple switch
+				if (beamtype==B_LMINUS) cvMultScal_RVec(ctemp,ex,b+j); // b[i]=ctemp*ex
+				else {
+					x2_s=x*x/ro2;
+					Q2=Q*Q;
+					ro4=ro2*ro2;
+					// some combinations that are used more than once
+					t4=s2*ro2*Q2; // t4=(s*ro*Q)^2
+					t5=I*ro2*Q;   // t5=i*Q*ro^2
+					t6=ro4*Q2;    // t6=ro^4*Q^2
+					t7=x*s*Q;     // t7=x*s*Q
+					if (beamtype==B_DAVIS3) {
+						// t1=1+s^2(-4Q^2*x^2-iQ^3*ro^4)=1-t4(4x2_s+t5)
+						t1 = 1 - t4*(4*x2_s+t5);
+						// t2=0
+						t2=0;
+						// t3=-s(2Qx)+s^3(8Q^3*ro^2*x+2iQ^4*ro^4*x-4iQ^2x)=2t7[-1+iQ*s2*(-4t5+t6-2)]
+						t3 = 2*t7*(-1 + I*Q*s2*(-4*t5+t6-2));
+					}
+					else if (beamtype==B_BARTON5) {
+						xy_s=x*y/ro2;
+						t8=8+2*t5; // t8=8+2i*Q*ro^2
+						/* t1 = 1 + s^2(-ro^2*Q^2-i*ro^4*Q^3-2Q^2*x^2)
+						 *    + s^4[2ro^4*Q^4+3iro^6*Q^5-0.5ro^8*Q^6+x^2(8ro^2*Q^4+2iro^4*Q^5)]
+						 *    = 1 + t4*{-1-2x2_s-t5+t4*[2+3t5-0.5t6+x2_s*t8]}
+						 */
+						t1 = 1 + t4*(-1 - 2*x2_s - t5 + t4*(2+3*t5-0.5*t6+x2_s*t8));
+						// t2=s^2(-2Q^2*xy)+s^4[xy(8ro^2*Q^4+2iro^4*Q^5)]=xy_s*t4(-2+t4*t8)
+						t2=xy_s*t4*(-2+t4*t8);
+						/* t3 = s(-2Qx) + s^3[(6ro^2*Q^3+2iro^4*Q^4)x] + s^5[(-20ro^4*Q^5-10iro^6*Q^6+ro^8*Q^7)x]
+						 *    = t7{-2+t4[6+2t5+t4(-20-10t5+t6)]}
+						 */
+						t3 = t7*(-2 + t4*(6 + 2*t5 + t4*(-20-10*t5+t6)));
+					}
+					else LogError(ONE_POS,"Inconsistency in beam definition"); // to remove warnings
+					// b[i]=ctemp(ex*t1+ey*t2+ez*t3)
+					cvMultScal_RVec(t1,ex,v1);
+					cvMultScal_RVec(t2,ey,v2);
+					cvMultScal_RVec(t3,prop,v3);
+					cvAdd2Self(v1,v2,v3);
+					cvMultScal_cmplx(ctemp,v1,b+j);
+				}
+			}
+			return;
+		case B_BESSELCS:
+			for (i=0;i<local_nvoid_Ndip;i++) {
+				j=3*i;
+				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
+				x=DotProd(r1,ex);
+				y=DotProd(r1,ey);
+				z=DotProd(r1,prop);
+				ro=sqrt(x*x+y*y);
+				t1=WaveNum;
+				t2=atan(y/x);
+				ctemp=(t1*t1/4)*(1 + cos(alpha0))*cpow(-I,n0)*cexp(I*n0*t2)*cexp(-I*t1*z*cos(alpha0));
+				BESSJCS(n0,ro*sin(alpha0),jn5);
+				t3=(1 + cos(alpha0))*jn5[2] + (1 - cos(alpha0))/2*(cexp(2*I*n0*t2)*jn5[4] + cexp(-2*I*n0*t2)*jn5[0]);
+				t4=(1 - cos(alpha0))*(1/2/I)*(cexp(2*I*n0*t2)*jn5[4] - cexp(-2*I*n0*t2)*jn5[0]);
+				t5=I*cos(alpha0)*(cexp(I*n0*t2)*jn5[3] - cexp(-I*n0*t2)*jn5[1]);
+				cvMultScal_RVec(t3,ex,v1);
+				cvMultScal_RVec(t4,ey,v2);
+				cvMultScal_RVec(t5,prop,v3);
+				cvAdd2Self(v1,v2,v3);
+				cvMultScal_cmplx(ctemp,v1,b+j);
+			}
+			return;
+		case B_BESSELLP:
+			for (i=0;i<local_nvoid_Ndip;i++) {
+				j=3*i;
+				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
+				x=DotProd(r1,ex);
+				y=DotProd(r1,ey);
+				z=DotProd(r1,prop);
+				ro=sqrt(x*x+y*y);
+				t1=WaveNum;
+				t2=atan(y/x);
+				ctemp=t1*cpow(-I,n0)*cexp(I*n0*t2)*cexp(-I*t1*z*cos(alpha0));
+				BESSJLP(n0,ro*sin(alpha0),jn2);
+				t3=t1*cos(alpha0)*jn2[0];
+				t4=0;
+				t5=(I*x/ro)*jn2[1] - (I*x+y)/(ro*ro)*n0*jn2[0];
+				cvMultScal_RVec(t3,ex,v1);
+				cvMultScal_RVec(t4,ey,v2);
+				cvMultScal_RVec(t5,prop,v3);
+				cvAdd2Self(v1,v2,v3);
+				cvMultScal_cmplx(ctemp,v1,b+j);
+			}
+			return;
+		case B_READ:
+			if (which==INCPOL_Y) fname=beam_fnameY;
+			else fname=beam_fnameX; // which==INCPOL_X
+			ReadField(fname,b);
+			return;
+	}
+	LogError(ONE_POS,"Unknown type of incident beam (%d)",(int)beamtype);
+	/* TO ADD NEW BEAM
+	 * add a case above. Identifier ('B_...') should be defined inside 'enum beam' in const.h. This case should set
+	 * complex vector 'b', describing the incident field in the particle reference frame. It is set inside the cycle for
+	 * each dipole of the particle and is calculated using
+	 * 1) 'DipoleCoord' – array of dipole coordinates;
+	 * 2) 'prop' – propagation direction of the incident field;
+	 * 3) 'ex' – direction of incident polarization;
+	 * 4) 'ey' – complementary unity vector of polarization (orthogonal to both 'prop' and 'ex');
+	 * 5) 'beam_center' – beam center in the particle reference frame (automatically calculated from 'beam_center_0'
+	 *                    defined in InitBeam).
+	 * If the new beam type is compatible with '-surf', include here the corresponding code. For that you will need
+	 * the variables, related to surface - see vars.c after "// related to a nearby surface".
+	 * If you need temporary local variables (which are used only in this part of the code), either use 't1'-'t8' or
+	 * define your own (with more informative names) in the beginning of this function.
+	 */
+}
diff --git a/bess.c b/bess.c
new file mode 100644
index 00000000..984a1b9c
--- /dev/null
+++ b/bess.c
@@ -0,0 +1,352 @@
+/* File: bess.c
+ * $Date::                            $
+ * Descr:
+ *
+ * Copyright (C) 2006-2013 ADDA contributors
+ * This file is part of ADDA.
+ *
+ * ADDA is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as
+ * published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
+ *
+ * ADDA is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ * of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along with ADDA. If not, see
+ * <http://www.gnu.org/licenses/>.
+ */
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+double BESSJ0 (double X) {
+	const double
+		P1=1.0, P2=-0.1098628627E-2, P3=0.2734510407E-4,
+		P4=-0.2073370639E-5, P5= 0.2093887211E-6,
+		Q1=-0.1562499995E-1, Q2= 0.1430488765E-3, Q3=-0.6911147651E-5,
+		Q4= 0.7621095161E-6, Q5=-0.9349451520E-7,
+		R1= 57568490574.0, R2=-13362590354.0, R3=651619640.7,
+		R4=-11214424.18, R5= 77392.33017, R6=-184.9052456,
+		S1= 57568490411.0, S2=1029532985.0, S3=9494680.718,
+		S4= 59272.64853, S5=267.8532712, S6=1.0;
+    double
+		AX,FR,FS,Z,FP,FQ,XX,Y, TMP;
+	if (X==0.0) return 1.0;
+	AX = fabs(X);
+	if (AX < 8.0) {
+		Y = X*X;
+		FR = R1+Y*(R2+Y*(R3+Y*(R4+Y*(R5+Y*R6))));
+		FS = S1+Y*(S2+Y*(S3+Y*(S4+Y*(S5+Y*S6))));
+		TMP = FR/FS;
+	}
+	else {
+		Z = 8./AX;
+		Y = Z*Z;
+		XX = AX-0.785398164;
+		FP = P1+Y*(P2+Y*(P3+Y*(P4+Y*P5)));
+		FQ = Q1+Y*(Q2+Y*(Q3+Y*(Q4+Y*Q5)));
+		TMP = sqrt(0.636619772/AX)*(FP*cos(XX)-Z*FQ*sin(XX));
+	}
+return TMP;
+}
+
+double Sign(double X, double Y) {
+	if (Y<0.0) return (-fabs(X));
+	else return (fabs(X));
+}
+
+double BESSJ1 (double X) {
+	const double  
+		P1=1.0, P2=0.183105E-2, P3=-0.3516396496E-4, P4=0.2457520174E-5,
+		P5=-0.240337019E-6,  P6=0.636619772,
+		Q1= 0.04687499995, Q2=-0.2002690873E-3, Q3=0.8449199096E-5,
+		Q4=-0.88228987E-6, Q5= 0.105787412E-6,
+		R1= 72362614232.0, R2=-7895059235.0, R3=242396853.1,
+		R4=-2972611.439,   R5=15704.48260,  R6=-30.16036606,
+		S1=144725228442.0, S2=2300535178.0, S3=18583304.74,
+		S4=99447.43394,    S5=376.9991397,  S6=1.0;
+
+	double AX,FR,FS,Y,Z,FP,FQ,XX, TMP;
+
+	AX = fabs(X);
+	if (AX < 8.0) {
+		Y = X*X;
+		FR = R1+Y*(R2+Y*(R3+Y*(R4+Y*(R5+Y*R6))));
+		FS = S1+Y*(S2+Y*(S3+Y*(S4+Y*(S5+Y*S6))));
+		TMP = X*(FR/FS);
+	}
+	else {
+		Z = 8.0/AX;
+		Y = Z*Z;
+		XX = AX-2.35619491;
+		FP = P1+Y*(P2+Y*(P3+Y*(P4+Y*P5)));
+		FQ = Q1+Y*(Q2+Y*(Q3+Y*(Q4+Y*Q5)));
+		TMP = sqrt(P6/AX)*(cos(XX)*FP-Z*sin(XX)*FQ)*Sign(S6,X);
+	}
+	return TMP;
+}
+
+void BESSJCS (int N2, double X, double ARRJ[5]) {
+	const IACC = 40; 
+	const double BIGNO = 1e10,  BIGNI = 1e-10;
+
+	double TOX,BJM,BJ,BJP,SUM,TMP,BJM1,BJ1,BJP1,SUM1,TMP1;
+	int J, JSUM, JSUM1, M, K, N, sgn, sgn1;
+
+	N = (N2 - 2);
+	if (X == 0.0) {
+		switch(N2) {
+			case -2:
+			ARRJ[0] = 0.0;
+			ARRJ[1] = 0.0;
+			ARRJ[2] = 0.0;
+			ARRJ[3] = 0.0;
+			ARRJ[4] = 1.0;
+			break;
+			case -1:
+			ARRJ[0] = 0.0;
+			ARRJ[1] = 0.0;
+			ARRJ[2] = 0.0;
+			ARRJ[3] = 1.0;
+			ARRJ[4] = 0.0;
+			break;
+			case 0:
+			ARRJ[0] = 0.0;
+			ARRJ[1] = 0.0;
+			ARRJ[2] = 1.0;
+			ARRJ[3] = 0.0;
+			ARRJ[4] = 0.0;
+			break;
+			case 1:
+			ARRJ[0] = 0.0;
+			ARRJ[1] = 1.0;
+			ARRJ[2] = 0.0;
+			ARRJ[3] = 0.0;
+			ARRJ[4] = 0.0;
+			break;
+			case 2:
+			ARRJ[0] = 1.0;
+			ARRJ[1] = 0.0;
+			ARRJ[2] = 0.0;
+			ARRJ[3] = 0.0;
+			ARRJ[4] = 0.0;
+			break;
+			default:
+			ARRJ[0] = 0.0;
+			ARRJ[1] = 0.0;
+			ARRJ[2] = 0.0;
+			ARRJ[3] = 0.0;
+			ARRJ[4] = 0.0;
+			break;
+		}
+	}
+	else {
+		if ((N == -5)||(N == -4)||(N == -3)||(N == -2)||(N == -1)||(N == 0)||(N == 1)) {
+			switch(N) {
+				case -5:
+				ARRJ[4] = -BESSJ1(X); 
+				ARRJ[3] = -(2.0/X)*ARRJ[4]-BESSJ0(X);
+				ARRJ[2] = -(4.0/X)*ARRJ[3]-ARRJ[4];
+				ARRJ[1] = -(6.0/X)*ARRJ[2]-ARRJ[3];
+				ARRJ[0] = -(8.0/X)*ARRJ[1]-ARRJ[2];
+				break;
+				case -4:
+				ARRJ[4] = BESSJ0(X); 
+				ARRJ[3] = -BESSJ1(X);
+				ARRJ[2] = -(2.0/X)*ARRJ[3]-ARRJ[4];
+				ARRJ[1] = -(4.0/X)*ARRJ[2]-ARRJ[3];
+				ARRJ[0] = -(6.0/X)*ARRJ[1]-ARRJ[2];
+				break;
+				case -3:
+				ARRJ[4] = BESSJ1(X); 
+				ARRJ[3] = BESSJ0(X);
+				ARRJ[2] = -ARRJ[4];;
+				ARRJ[1] = -(2.0/X)*ARRJ[2]-ARRJ[3];
+				ARRJ[0] = -(4.0/X)*ARRJ[1]-ARRJ[2];
+				break;
+				case -2:
+				ARRJ[3] = BESSJ1(X); 
+				ARRJ[2] = BESSJ0(X);
+				ARRJ[1] = -ARRJ[4];;
+				ARRJ[1] = -(2.0/X)*ARRJ[2]-ARRJ[3];
+				ARRJ[0] = -(4.0/X)*ARRJ[1]-ARRJ[2];
+				break;
+				case -1:
+				ARRJ[0] = -BESSJ1(X);
+				ARRJ[1] = BESSJ0(X);
+				ARRJ[2] = -ARRJ[0];
+				ARRJ[3] = (2.0/X)*ARRJ[2]-ARRJ[1];
+				ARRJ[4] = (4.0/X)*ARRJ[3]-ARRJ[2];
+				break;
+				case 0:
+				ARRJ[0] = BESSJ0(X);
+				ARRJ[1] = BESSJ1(X);
+				ARRJ[2] = (2.0/X)*ARRJ[1]-ARRJ[0];
+				ARRJ[3] = (4.0/X)*ARRJ[2]-ARRJ[1];
+				ARRJ[4] = (6.0/X)*ARRJ[3]-ARRJ[2];
+				break;
+				case 1:
+				ARRJ[0] = BESSJ1(X);
+				ARRJ[1] = (2.0/X)*ARRJ[0]-BESSJ0(X);
+				ARRJ[2] = (4.0/X)*ARRJ[1]-ARRJ[0];
+				ARRJ[3] = (6.0/X)*ARRJ[2]-ARRJ[1];
+				ARRJ[4] = (8.0/X)*ARRJ[3]-ARRJ[2];
+				break;
+			}
+		}
+		else {
+			TOX = 2.0/X;
+			sgn = 1;
+			sgn1 = 1;
+			N = abs(N2-2);
+			if ((N2-2 <0)&((N2-2)%2 != 0)) sgn = -1;
+			if ((N2-1 <0)&((N2-1)%2 != 0)) sgn1 = -1;
+			if (X > 1.0*N) {
+				BJM = BESSJ0(X);
+				BJ  = BESSJ1(X);
+				
+				for (J=1; J<N; J++) {
+					BJP = J*TOX*BJ-BJM;
+					BJM = BJ;
+					BJ  = BJP;
+				}
+				
+				BJP = N*TOX*BJ-BJM;
+				ARRJ[0] = sgn*BJ; 
+				ARRJ[1] = sgn1*BJP;
+				ARRJ[2] = (N+2)*(2.0/X)*ARRJ[1]-ARRJ[0];
+				ARRJ[3] = (N+3)*(2.0/X)*ARRJ[2]-ARRJ[1];
+				ARRJ[4] = (N+4)*(2.0/X)*ARRJ[3]-ARRJ[2];
+			}
+			else {
+				M = (int) (2*((N+floor(sqrt(1.0*(IACC*N))))/2));
+				K = (int) (2*((N+1+floor(sqrt(1.0*(IACC*(N+1)))))/2));
+				TMP = 0.0;
+				TMP1 = 0.0;
+				JSUM = 0;
+				JSUM1 = 0;
+				SUM = 0.0;
+				SUM1 = 0.0;
+				BJP = 0.0;
+				BJP1 = 0.0;
+				BJ  = 1.0;
+				BJ1  = 1.0;
+				
+				for (J=K; J>0; J--) {
+					BJM1 = J*TOX*BJ1-BJP1;
+					BJP1 = BJ1;
+					BJ1  = BJM1;
+					if (fabs(BJ1) > BIGNO) {
+						BJ1  = BJ1*BIGNI;
+						BJP1 = BJP1*BIGNI;
+						TMP1 = TMP1*BIGNI;
+						SUM1 = SUM1*BIGNI;
+					}
+					if (JSUM1 != 0)  SUM1 += BJ1;
+					JSUM1 = 1-JSUM1;
+					if (J == N+1)  TMP1 = BJP1;
+					if (J <= M) {
+						BJM = J*TOX*BJ-BJP;
+						BJP = BJ;
+						BJ  = BJM;
+						if (fabs(BJ) > BIGNO) {
+							BJ  = BJ*BIGNI;
+							BJP = BJP*BIGNI;
+							TMP = TMP*BIGNI;
+							SUM = SUM*BIGNI;
+						}
+						if (JSUM != 0)  SUM += BJ;
+						JSUM = 1-JSUM;
+						if (J == N)  TMP = BJP;
+					}
+				}
+				
+				ARRJ[0] = sgn*TMP/(2.0*SUM-BJ);
+				ARRJ[1] = sgn1*TMP1/(2.0*SUM1-BJ1);
+				ARRJ[2] = (N+2)*(2.0/X)*ARRJ[1]-ARRJ[0];
+				ARRJ[3] = (N+3)*(2.0/X)*ARRJ[2]-ARRJ[1];
+				ARRJ[4] = (N+4)*(2.0/X)*ARRJ[3]-ARRJ[2];
+
+			}
+		}
+	}
+}
+
+void BESSJLP (int N, double X, double ARRJ[2]) {
+	const IACC = 40; 
+	const double BIGNO = 1e10,  BIGNI = 1e-10;
+
+	double TOX,BJM,BJ,BJP,SUM,TMP,BJM1,BJ1,BJP1,SUM1,TMP1;
+	int J, JSUM, JSUM1, M, K;
+	if (X == 0.0) {
+		if (N == 0) { ARRJ[0] = 1.0; ARRJ[1] = 0.0;}
+		else { ARRJ[0] = 0.0; ARRJ[1] = 0.0;} 
+	}
+	else {
+		if ((N == 0)||(N == 1)) {
+			if (N == 0) { ARRJ[0] = BESSJ0(X); ARRJ[1] = BESSJ1(X);}
+			if (N == 1) { ARRJ[0] = BESSJ1(X); ARRJ[1] = (2.0/X)*ARRJ[0]-BESSJ0(X);}
+		}
+		else {
+			TOX = 2.0/X;
+			if (X > 1.0*N) {
+				BJM = BESSJ0(X);
+				BJ  = BESSJ1(X);
+				
+				for (J=1; J<N; J++) {
+					BJP = J*TOX*BJ-BJM;
+					BJM = BJ;
+					BJ  = BJP;
+				}
+				
+				BJP = N*TOX*BJ-BJM;
+				ARRJ[0] = BJ; ARRJ[1] = BJP;
+			}
+			else {
+				M = (int) (2*((N+floor(sqrt(1.0*(IACC*N))))/2));
+				K = (int) (2*((N+1+floor(sqrt(1.0*(IACC*(N+1)))))/2));
+				TMP = 0.0;
+				TMP1 = 0.0;
+				JSUM = 0;
+				JSUM1 = 0;
+				SUM = 0.0;
+				SUM1 = 0.0;
+				BJP = 0.0;
+				BJP1 = 0.0;
+				BJ  = 1.0;
+				BJ1  = 1.0;
+				
+				for (J=K; J>0; J--) {
+					BJM1 = J*TOX*BJ1-BJP1;
+					BJP1 = BJ1;
+					BJ1  = BJM1;
+					if (fabs(BJ1) > BIGNO) {
+						BJ1  = BJ1*BIGNI;
+						BJP1 = BJP1*BIGNI;
+						TMP1 = TMP1*BIGNI;
+						SUM1 = SUM1*BIGNI;
+					}
+					if (JSUM1 != 0)  SUM1 += BJ1;
+					JSUM1 = 1-JSUM1;
+					if (J == N+1)  TMP1 = BJP1;
+					if (J <= M) {
+						BJM = J*TOX*BJ-BJP;
+						BJP = BJ;
+						BJ  = BJM;
+						if (fabs(BJ) > BIGNO) {
+							BJ  = BJ*BIGNI;
+							BJP = BJP*BIGNI;
+							TMP = TMP*BIGNI;
+							SUM = SUM*BIGNI;
+						}
+						if (JSUM != 0)  SUM += BJ;
+						JSUM = 1-JSUM;
+						if (J == N)  TMP = BJP;
+					}
+				}
+				
+				ARRJ[0] = TMP/(2.0*SUM-BJ);
+				ARRJ[1] = TMP1/(2.0*SUM1-BJ1);
+			}
+		}
+	}
+}
diff --git a/bess.h b/bess.h
new file mode 100644
index 00000000..71e6048d
--- /dev/null
+++ b/bess.h
@@ -0,0 +1,27 @@
+/* File: bess.h
+ * $Date::                            $
+ * Descr:
+ *
+ * Copyright (C) 2006,2008-2013
+ * This file is part of ADDA.
+ *
+ * ADDA is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as
+ * published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
+ *
+ * ADDA is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ * of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along with ADDA. If not, see
+ * <http://www.gnu.org/licenses/>.
+ */
+
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+double BESSJ0 (double X);
+double Sign(double X, double Y);
+double BESSJ1 (double X);
+
+void BESSJCS (int N2, double X, double ARRJ[5]);
+void BESSJLP (int N, double X, double ARRJ[2]);
diff --git a/const.h b/const.h
new file mode 100644
index 00000000..c1fcc441
--- /dev/null
+++ b/const.h
@@ -0,0 +1,427 @@
+/* File: const.h
+ * $Date::                            $
+ * Descr: all the constants used by ADDA code, including enum constants, also defines some useful macros
+ *
+ * Copyright (C) 2006-2014 ADDA contributors
+ * This file is part of ADDA.
+ *
+ * ADDA is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as
+ * published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
+ *
+ * ADDA is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ * of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along with ADDA. If not, see
+ * <http://www.gnu.org/licenses/>.
+ */
+#ifndef __const_h
+#define __const_h
+
+// version number (string)
+#define ADDA_VERSION "1.4.0-alpha"
+
+/* ADDA uses certain C99 extensions, which are widely supported by GNU and Intel compilers. However, they may be not
+ * completely supported by e.g. Microsoft Visual Studio compiler. Therefore, we check the version of the standard here
+ * and produce a strong warning, if it is not satisfied. The list of C99 features, used by ADDA, include (but may be not
+ * limited to): stdbool.h, snprintf, %z argument in printf, '//' comments, restricted pointers, variadic macros
+*/
+# if !defined(OVERRIDE_STDC_TEST) && (!defined(__STDC_VERSION__) || (__STDC_VERSION__ < 199901L))
+#   error "Support for C99 standard (at least many of its parts) is strongly recommended for compilation. Otherwise \
+	the compilation will may fail or produce wrong results. If you still want to try, you may enable an override in \
+	the Makefile."
+#endif
+
+/* The following is to ensure that mingw64 with "-std=c99" will use c99-compliant printf-family functions. For some
+ * (philosophical) reasons mingw64 developers have not implemented this behavior as the default one. So we need to set
+ * it manually. This macro should be defined before any system includes, hence inclusion of "const.h" should be the
+ * first one in all sources. This is also convenient for testing c99 standard above. However, there is no simple way
+ * then to test for MinGW64 at this point, since, e.g., __MINGW64_VERSION_STR is defined by the system header (not by
+ * the compiler itself). So the code executes always. Not the most reliable way, but seems the only way to keep the
+ * following definition in one place.
+ */
+#if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L)
+#	define __USE_MINGW_ANSI_STDIO 1
+#endif
+
+// basic constants
+#define UNDEF -1 // should be used only for variables, which are naturally non-negative
+	// denotes that shape accepts filename arguments; used in definitions of options
+#define FNAME_ARG     -2  // single filename
+#define FNAME_ARG_2   -3  // two filenames
+#define FNAME_ARG_1_2 -4  // 1 or 2 filenames
+	// macro to test for occurrence of one of FNAME_ARG
+#define IS_FNAME_ARG(A) (((A)==FNAME_ARG) || ((A)==FNAME_ARG_2) || ((A)==FNAME_ARG_1_2))
+
+// simple functions
+#define MIN(A,B) (((A) > (B)) ? (B) : (A))
+#define MAX(A,B) (((A) < (B)) ? (B) : (A))
+#define MAXIMIZE(A,B) {if ((A)<(B)) (A)=(B);}
+#define IS_EVEN(A) (((A)%2) == 0)
+#define DIV_CEILING(A,B) (((A)%(B)==0) ? (A)/(B) : ((A)/(B))+1 ) // valid only for nonnegative A and B
+#define LENGTH(A) ((int)(sizeof(A)/sizeof(A[0]))) // length of any array (converted to int)
+#define STRINGIFY(A) #A
+#define GREATER_EQ2(a1,a2,b1,b2) ( (a1)>(b1) || ( (a1)==(b1) && (a2)>=(b2) )) // a1.a2>=b1.b2
+
+// parallel definitions
+#ifdef ADDA_MPI
+#	define PARALLEL
+#endif
+
+/* ringid of root processor. Using ADDA_ROOT!=0 should work, however it was not thoroughly tested. Hence do not change
+ * without necessity.
+ */
+#define ADDA_ROOT 0
+
+// math constants rounded for 32 decimals; C99 standard specifies that they are encoded as double
+#define PI                  3.1415926535897932384626433832795
+#define TWO_PI              6.283185307179586476925286766559
+#define FOUR_PI             12.566370614359172953850573533118
+#define EIGHT_PI            25.132741228718345907701147066236
+#define FOUR_PI_OVER_THREE  4.1887902047863909846168578443727
+#define PI_OVER_TWO         1.5707963267948966192313216916398
+#define PI_OVER_FOUR        0.78539816339744830961566084581988
+#define PI_OVER_SIX         0.52359877559829887307710723054658
+#define INV_PI              0.31830988618379067153776752674503
+#define TWO_OVER_PI         0.63661977236758134307553505349006
+#define THREE_OVER_FOUR_PI  0.23873241463784300365332564505877
+#define SIX_OVER_PI         1.9098593171027440292266051604702
+#define ONE_THIRD           0.33333333333333333333333333333333
+#define PI_OVER_180         0.017453292519943295769236907684886
+#define INV_PI_180          57.295779513082320876798154814105
+#define SQRT_PI             1.7724538509055160272981674833411
+#define TWO_OVER_SQRT_PI    1.1283791670955125738961589031215
+#define SQRT2               1.4142135623730950488016887242097
+#define SQRT3               1.7320508075688772935274463415059
+#define SQRT1_2             0.70710678118654752440084436210485
+#define SQRT1_2PI           0.39894228040143267793994605993438
+#define SQRT2_9PI           0.26596152026762178529329737328959
+#define EULER               0.57721566490153286060651209008241
+#define FULL_ANGLE          360.0
+#define MICRO               1E-6
+
+// sets the maximum box size; otherwise 'position' should be changed
+#define BOX_MAX USHRT_MAX
+
+// sizes of some arrays
+#define MAX_NMAT         15   // maximum number of different refractive indices (<256)
+#define MAX_N_SH_PARMS   25   // maximum number of shape parameters
+#define MAX_N_BEAM_PARMS 10   // maximum number of beam parameters
+
+// sizes of filenames and other strings
+/* There is MAX_PATH constant that equals 260 on Windows. However, even this OS allows ways to override this limit. On
+ * POSIX this constant may be much larger and have even less reliability. So the values below are conservatively high,
+ * but are not guaranteed to suffice. However, the functions in the code are designed to survive if this buffer won't
+ * suffice.
+ */
+#define MAX_DIRNAME      300 // maximum length of dirname; increase THIS if any errors appear
+#define MAX_FNAME_SH     100 // maximum length of filename (used for known names)
+#define MAX_TMP_FNAME_SH  15 // maximum length of names of temporary files (short)
+#define MAX_SYSTEM_CALL   10 // maximum string length of system call (itself)
+#define MAX_WORD          10 // maximum length of a short word
+#define MAX_LINE         100 // maximum length of a line
+#define BUF_LINE         300 // size of buffer for reading lines (longer lines are handled robustly)
+#define MAX_PARAGRAPH    600 // maximum length of a paragraph (few lines)
+
+// derived sizes
+	// maximum string to create directory
+#define MAX_DIRSYS  (MAX_DIRNAME + MAX_SYSTEM_CALL)
+	// maximum length of filename (including directory name)
+#define MAX_FNAME   (MAX_DIRNAME + MAX_FNAME_SH)
+	// maximum length of temporary filename (including directory name)
+#define MAX_TMP_FNAME   (MAX_DIRNAME + MAX_TMP_FNAME_SH)
+	// maximum message that may include a filename (for PrintError)
+#define MAX_MESSAGE (MAX_FNAME + MAX_PARAGRAPH)
+	// maximum message that may include 2 filenames (for LogError)
+#define MAX_MESSAGE2 (2*MAX_FNAME + MAX_PARAGRAPH)
+
+// widths of terminal used for output
+#define DEF_TERM_WIDTH 80 // default
+#define MIN_TERM_WIDTH 20 // ADDA never takes value less than that from environmental variables
+
+// formats for outputs of float values
+#define EFORM "%.10E"        // fixed width
+#define GFORM "%.10g"        // variable width (showing significant digits)
+#define GFORMDEF "%g"        // default output for non-precise values
+#define GFORM_DEBUG "%.2g"   // for debug and error output
+#define CFORM "%.10g%+.10gi" // for complex numbers; may be defined in terms of GFORM
+	// derived formats; starting "" is to avoid redundant syntax errors in Eclipse
+#define GFORM3V "("GFORM","GFORM","GFORM")"
+#define GFORM3L ""GFORM" "GFORM" "GFORM
+#define GFORM6L ""GFORM" "GFORM" "GFORM" "GFORM" "GFORM" "GFORM
+#define GFORM7L ""GFORM" "GFORM" "GFORM" "GFORM" "GFORM" "GFORM" "GFORM
+#define GFORM10L ""GFORM" "GFORM" "GFORM" "GFORM" "GFORM" "GFORM" "GFORM" "GFORM" "GFORM" "GFORM
+#define GFORMDEF3V "("GFORMDEF","GFORMDEF","GFORMDEF")"
+#define CFORM3V "("CFORM","CFORM","CFORM")"
+	// macros to shorten printing of all vector components
+#define COMP3V(a) (a)[0],(a)[1],(a)[2]
+#define COMP16V(a) (a)[0],(a)[1],(a)[2],(a)[3],(a)[4],(a)[5],(a)[6],(a)[7],(a)[8],(a)[9],(a)[10],(a)[11],(a)[12],\
+	(a)[13],(a)[14],(a)[15]
+
+enum sh { // shape types
+	SH_AXISYMMETRIC, // axisymmetric
+	SH_BICOATED,     // two coated spheres
+	SH_BIELLIPSOID,  // two general ellipsoids
+	SH_BISPHERE,     // two spheres
+	SH_BOX,          // box (may be rectangular)
+	SH_CAPSULE,      // capsule
+	SH_CHEBYSHEV,    // Chebyshev particle (axisymmetric)
+	SH_COATED,       // coated sphere
+	SH_CYLINDER,     // cylinder
+	SH_EGG,          // egg
+	SH_ELLIPSOID,    // general ellipsoid
+	SH_LINE,         // line with width of one dipole
+	SH_PLATE,        // plate
+	SH_PRISM,        // right rectangular prism
+	SH_RBC,          // Red Blood Cell
+	SH_READ,         // read from file
+	//SH_SDISK_ROT,  // disc cut of a sphere -- not operational
+	SH_SPHERE,       // sphere
+	SH_SPHEREBOX     // sphere in a box
+	/* TO ADD NEW SHAPE
+	 * add an identifier starting with 'SH_' and a descriptive comment to this list in alphabetical order.
+	 */
+};
+
+enum pol { // which way to calculate coupleconstant
+	POL_CLDR,    // Corrected Lattice Dispersion Relation
+	POL_CM,      // Clausius-Mossotti
+	POL_DGF,     // Digitized Green's Function (second order approximation of LAK)
+	POL_FCD,     // Filtered Coupled Dipoles
+	POL_IGT_SO,  // Second order approximation to Green's tensor integrated over a cube
+	POL_LAK,     // Exact result of IGT for sphere
+	POL_LDR,     // Lattice Dispersion Relation
+	POL_NLOC,    // non-local extension (Gaussian dipole-density, formula based on lattice sums)
+	POL_NLOC_AV, // same as NLOC, but based on averaging of Gaussian over the dipole volume
+	POL_RRC,     // Radiative Reaction correction
+	POL_SO       // Second Order formulation
+	/* TO ADD NEW POLARIZABILITY FORMULATION
+	 * add an identifier starting with 'POL_' and a descriptive comment to this list in the alphabetical order.
+	 */
+};
+// in alphabetical order
+
+enum scat { // how to calculate scattering quantities
+	SQ_DRAINE, // classical, as Draine
+	SQ_FINDIP, /* Same as Draine, but with correction of radiation energy of a _finite_ dipole when calculating
+	              absorption cross section */
+	SQ_IGT_SO, // Integration of Green's tensor (second order in kd approximation)
+	SQ_SO      // Second Order formulation
+};
+// in alphabetical order
+
+enum inter { // how to calculate interaction term
+	G_FCD,       // Filtered Green's tensor (Filtered Coupled Dipoles)
+	G_FCD_ST,    // quasi-static version of FCD
+	G_IGT,       // (direct) integration of Green's tensor
+	G_IGT_SO,    // approximate integration of Green's tensor (based on ideas of SO)
+	G_NLOC,      // non-local extension (interaction of Gaussian dipole-densities)
+	G_NLOC_AV,   // same as NLOC, but based on averaging of Gaussian over the dipole volume
+	G_POINT_DIP, // as point dipoles
+	G_SO         // Second Order formulation
+	/* TO ADD NEW INTERACTION FORMULATION
+	 * add an identifier starting with 'G_' and a descriptive comment to this list in the alphabetical order.
+	 */
+};
+enum refl { // how to calculate interaction of dipoles through the nearby surface (reflected G)
+	GR_IMG,       // approximate expression based on a single image dipole
+	GR_SOM        // direct evaluation of Sommerfeld integrals
+	/* TO ADD NEW REFLECTION FORMULATION
+	 * add an identifier starting with 'GR_' and a descriptive comment to this list in the alphabetical order.
+	 */
+};// in alphabetical order
+
+// ldr constants
+#define LDR_B1  1.8915316
+#define LDR_B2 -0.1648469
+#define LDR_B3  1.7700004
+
+// 2nd_order constants; derived from c1=ln(5+3^(3/2))-ln(2)/2-pi/4 and c2=pi/6
+#define SO_B1 1.5867182426530356710958782335228 // 4c1/3
+#define SO_B2 0.13488017286410948123541594310740 // c1/3 - c2/2
+#define SO_B3 0.11895825700597042937085940122438 // (5/2)c1 - c2
+
+// other constants for polarizability
+#define DGF_B1 1.6119919540164696407169668466385  // (4pi/3)^(1/3)
+#define LAK_C  0.62035049089940001666800681204778 // (4pi/3)^(-1/3)
+
+// two boundaries for separation between G_SO 'close', 'median', and 'far'
+#define G_BOUND_CLOSE  1 // k*R^2/d < GB_CLOSE => 'close'
+#define G_BOUND_MEDIAN 1 // k*R < GB_MEDIAN => 'median'
+
+enum iter { // iterative methods
+	IT_BCGS2,    // Enhanced Bi-Conjugate Gradient Stabilized (2)
+	IT_BICG_CS,  // Bi-Conjugate Gradient for Complex-Symmetric matrices
+	IT_BICGSTAB, // Bi-Conjugate Gradient Stabilized
+	IT_CGNR,     // Conjugate Gradient for Normalized equations minimizing Residual norm
+	IT_CSYM,     // Algorithm CSYM
+	IT_QMR_CS,   // Quasi-minimal residual for Complex-Symmetric matrices
+	IT_QMR_CS_2  // 2-term QMR (better roundoff properties)
+	/* TO ADD NEW ITERATIVE SOLVER
+	 * add an identifier starting with 'IT_' and a descriptive comment to this list in the alphabetical order.
+	 */
+};
+
+enum Eftype { // type of E field calculation
+	CE_NORMAL, // normal
+	CE_PARPER  // use symmetry to calculate both incident polarizations from one calculation of internal fields
+};
+
+enum incpol {
+	INCPOL_Y, // y-polarization, assumed to be used first
+	INCPOL_X  // x-polarization
+};
+// path and size of tables
+#define TAB_PATH     "tables/"
+#define TAB_FNAME(a) "t"#a"f.dat" // a is a number, e.g. TAB_FNAME(2) -> "t2f.dat"
+#define TAB_SIZE     142
+#define TAB_RMAX     10
+
+enum beam { // beam types
+	B_BARTON5, // 5th order description of the Gaussian beam
+	B_BESSELCS, // circularly symmetric Bessel beam derived using ASR
+	B_BESSELLP, // linearly polarized Bessel beam derived using Hertz vector potentials
+	B_DAVIS3,  // 3rd order description of the Gaussian beam
+	B_DIPOLE,  // field of a point dipole
+	B_LMINUS,  // 1st order description of the Gaussian beam
+	B_PLANE,   // infinite plane wave
+	B_READ     // read from file
+	/* TO ADD NEW BEAM
+	 * add an identifier starting with 'B_' and a descriptive comment to this list in alphabetical order.
+	 */
+};
+
+enum scatgrid { // types of scattering grid
+	SG_GRID, // grid of angles
+	SG_PAIRS // set of independent pairs
+};
+enum angleset {// types of angles set
+	AS_RANGE, // range with uniformly spaced points
+	AS_VALUES // any set of values
+};
+
+// types of phi_integr (should be different one-bit numbers)
+#define PHI_UNITY 1 // just integrate
+#define PHI_COS2  2 // integrate with cos(2*phi)
+#define PHI_SIN2  4 // integrate with sin(2*phi)
+#define PHI_COS4  8 // integrate with cos(4*phi)
+#define PHI_SIN4 16 // integrate with sin(4*phi)
+
+enum sym { // ways to treat particle symmetries
+	SYM_AUTO, // automatic
+	SYM_NO,   // do not take into account
+	SYM_ENF   // enforce
+};
+
+enum chpoint { // types of checkpoint (to save)
+	CHP_NONE,    // do not save checkpoint
+	CHP_NORMAL,  // save checkpoint if not finished in time and exit
+	CHP_REGULAR, // save checkpoints in regular time intervals (until finished or halted)
+	CHP_ALWAYS   /* save checkpoint if either simulation is finished or time elapsed and calculate all scattering
+	                quantities */
+};
+
+enum init_field { // how to calculate initial field to be used in the iterative solver
+	IF_AUTO, // automatically choose from ZERO or INC (based on lower residual value)
+	IF_ZERO, // zero
+	IF_INC,  // equal to incident field
+	IF_READ, // read from file
+	IF_WKB   // from WKB approximation (incident field corrected for phase shift in the particle)
+};
+
+// return values for functions
+#define CHP_EXIT -2 // exit after saving checkpoint
+
+// default values; other are specified in InitVariables (param.c)
+#define DEF_GRID       (16*jagged)
+#define MIN_AUTO_GRID  16 // minimum grid, when set from default dpl
+
+// numbers less than this value (compared to unity) are considered to be zero (approximately 10*DBL_EPSILON)
+#define ROUND_ERR 1E-15
+#define SQRT_RND_ERR 3E-8 // sqrt(ROUND_ERR)
+
+// output and input file and directory names (can only be changed at compile time)
+#define F_EXPCOUNT      "ExpCount"
+#define F_EXPCOUNT_LCK  F_EXPCOUNT ".lck"
+#define F_CS            "CrossSec"
+#define F_FRP           "RadForce"
+#define F_INTFLD        "IntField"
+#define F_DIPPOL        "DipPol"
+#define F_BEAM          "IncBeam"
+#define F_GRANS         "granules"
+	// suffixes
+#define F_XSUF          "-X"
+#define F_YSUF          "-Y"
+	// logs
+#define F_LOG           "log"
+#define F_LOG_ERR       "logerr.%d"    // ringid as argument
+#define F_LOG_ORAVG     "log_orient_avg"
+#define F_LOG_INT_CSCA  "log_int_Csca"
+#define F_LOG_INT_ASYM  "log_int_asym"
+	// log suffixes
+#define F_LOG_X         "_x"
+#define F_LOG_Y         "_y"
+#define F_LOG_Z         "_z"
+	// Mueller files
+#define F_MUEL          "mueller"
+#define F_MUEL_SG       "mueller_scatgrid"
+#define F_MUEL_INT      "mueller_integr"
+#define F_MUEL_C2       "mueller_integr_c2"
+#define F_MUEL_S2       "mueller_integr_s2"
+#define F_MUEL_C4       "mueller_integr_c4"
+#define F_MUEL_S4       "mueller_integr_s4"
+	// files for amplitude matrix
+#define F_AMPL          "ampl"
+#define F_AMPL_SG       "ampl_scatgrid"
+	// temporary files; used in printf with ringid as argument
+#define F_FRP_TMP       "rf%d.tmp"
+#define F_BEAM_TMP      "b%d.tmp"
+#define F_INTFLD_TMP    "f%d.tmp"
+#define F_DIPPOL_TMP    "p%d.tmp"
+#define F_GEOM_TMP      "g%d.tmp"
+	// checkpoint files
+#define F_CHP_LOG       "chp.log"
+#define F_CHP           "chp.%d"   // ringid as argument
+
+// default file and directory names; can be changed by command line options
+#define FD_ALLDIR_PARMS "alldir_params.dat"
+#define FD_AVG_PARMS    "avg_params.dat"
+#define FD_SCAT_PARMS   "scat_params.dat"
+#define FD_CHP_DIR      "chpoint"
+
+/* number of components of D. Really, it can't be easily changed, but using constant instead of 6 adds more
+ * understanding for reader
+ */
+#define NDCOMP 6
+
+// shape formats; numbers should be nonnegative
+enum shform {
+	SF_DDSCAT6,  // DDSCAT 6 format (FRMFIL), produced by calltarget
+	SF_DDSCAT7,  // DDSCAT 7 format (FRMFIL), produced by calltarget
+	SF_TEXT,     // ADDA text format for one-domain particles
+	SF_TEXT_EXT  // ADDA text format for multi-domain particles
+	/* TO ADD NEW FORMAT OF SHAPE FILE
+	 * add an identifier starting with 'SF_' and a descriptive comment to this list in alphabetical order.
+	 */
+};
+
+#define POSIT __FILE__,__LINE__ // position of the error in source code
+
+enum enwho { // who is calling
+	ALL, // each processor may report this error
+	ONE  // only root processor reports an error
+};
+
+// derived; for simplicity
+#define ALL_POS ALL,POSIT
+#define ONE_POS ONE,POSIT
+#define ALL_POS_FUNC ALL_POS,__func__
+#define ONE_POS_FUNC ONE_POS,__func__
+
+enum ec { // error codes
+	EC_OK,    // no error, corresponds to zero exit code
+	EC_ERROR, // error
+	EC_WARN,  // warning
+	EC_INFO   // slight warning, that does not interfere at all with normal execution
+};
+
+#endif // __const_h
diff --git a/param.c b/param.c
new file mode 100644
index 00000000..68903f0d
--- /dev/null
+++ b/param.c
@@ -0,0 +1,2568 @@
+/* File: param.c
+ * $Date::                            $
+ * Descr: initialization, parsing and handling of input parameters; also printout general information; contains file
+ *        locking routines
+ *
+ * Copyright (C) 2006-2014 ADDA contributors
+ * This file is part of ADDA.
+ *
+ * ADDA is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as
+ * published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
+ *
+ * ADDA is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ * of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along with ADDA. If not, see
+ * <http://www.gnu.org/licenses/>.
+ */
+#include "const.h" // keep this first
+#include "param.h" // corresponding header
+// project headers
+#include "cmplx.h"
+#include "comm.h"
+#include "crosssec.h"
+#include "debug.h"
+#include "fft.h"
+#include "function.h"
+#include "io.h"
+#include "oclcore.h"
+#include "os.h"
+#include "parbas.h"
+#include "vars.h"
+// system headers
+#include <ctype.h>
+#include <math.h>
+#include <stdarg.h>
+#include <stdint.h>
+#include <stdlib.h>
+#include <string.h>
+#include <time.h>
+
+#ifdef CLFFT_AMD
+/* One can also include clFFT.h (the only recommended public header), which can be redundant, but more portable.
+ * However, version macros are not documented anyway (in the manual), so there seem to be no perfectly portable way to
+ * obtain them.
+ */
+#	include <clFFT.version.h>
+#endif
+
+#ifdef OCL_BLAS
+/* In contrast to clFFT, here including main header (clBLAS.h) is not an option, since it doesn't include the
+ * following header.
+ */
+#	include <clBLAS.version.h>
+#endif
+
+#ifndef NO_GITHASH
+#	include "githash.h" // for GITHASH, this file is automatically created during compilation
+#endif
+
+// definitions for file locking
+#ifdef USE_LOCK
+#	ifdef WINDOWS
+#		define FILEHANDLE HANDLE
+#	elif defined(POSIX)
+#		include <unistd.h>
+#		include <fcntl.h>
+#		ifdef LOCK_FOR_NFS
+#			include <errno.h> // for error handling of fcntl call
+#		endif
+#		define FILEHANDLE int
+#	else
+#		error "Unknown operation system. Creation of lock files is not supported."
+#	endif
+#	define LOCK_WAIT 1 // in seconds
+#	define MAX_LOCK_WAIT_CYCLES 60
+#	define ONLY_FOR_LOCK
+#else
+#	define FILEHANDLE int
+#	define ONLY_FOR_LOCK ATT_UNUSED
+#endif
+
+// GLOBAL VARIABLES
+
+opt_index opt; // main option index; it is also defined as extern in param.h
+
+// SEMI-GLOBAL VARIABLES
+
+// defined and initialized in crosssec.c
+extern const char avg_string[];
+// defined and initialized in GenerateB.c
+extern const char beam_descr[];
+// defined and initialized in make_particle.c
+extern const bool volcor_used;
+extern const char *sh_form_str1,*sh_form_str2;
+#ifndef SPARSE
+extern const int gr_N;
+extern const double gr_vf_real;
+#endif //SPARSE
+extern const size_t mat_count[];
+
+// used in CalculateE.c
+bool store_int_field; // save full internal fields to text file
+bool store_dip_pol;   // save dipole polarizations to text file
+bool store_beam;      // save incident beam to file
+bool store_scat_grid; // Store the scattered field for grid of angles
+bool calc_Cext;       // Calculate the extinction cross-section - always do
+bool calc_Cabs;       // Calculate the absorption cross-section - always do
+bool calc_Csca;       // Calculate the scattering cross-section by integration
+bool calc_vec;        // Calculate the unnormalized asymmetry-parameter
+bool calc_asym;       // Calculate the asymmetry-parameter
+bool calc_mat_force;  // Calculate the scattering force by matrix-evaluation
+bool store_force;     // Write radiation pressure per dipole to file
+bool store_ampl;      // Write amplitude matrix to file
+int phi_int_type;     // type of phi integration (each bit determines whether to calculate with different multipliers)
+// used in calculator.c
+bool avg_inc_pol;            // whether to average CC over incident polarization
+double polNlocRp;            // Gaussian width for non-local polarizability
+const char *alldir_parms;    // name of file with alldir parameters
+const char *scat_grid_parms; // name of file with parameters of scattering grid
+// used in crosssec.c
+double incPolX_0[3],incPolY_0[3]; // initial incident polarizations (in lab RF)
+enum scat ScatRelation;           // type of formulae for scattering quantities
+// used in GenerateB.c
+int beam_Npars;
+double beam_pars[MAX_N_BEAM_PARMS]; // beam parameters
+opt_index opt_beam;                 // option index of beam option used
+const char *beam_fnameY;            // names of files, defining the beam (for two polarizations)
+const char *beam_fnameX;
+// used in interaction.c
+double igt_lim; // limit (threshold) for integration in IGT
+double igt_eps; // relative error of integration in IGT
+double nloc_Rp; // Gaussian width for non-local interaction
+bool InteractionRealArgs; // whether interaction (or reflection) routines can be called with real arguments
+// used in io.c
+char logfname[MAX_FNAME]=""; // name of logfile
+// used in iterative.c
+double iter_eps;           // relative error to reach
+enum init_field InitField; // how to calculate initial field for the iterative solver
+const char *infi_fnameY;   // names of files, defining the initial field (for two polarizations)
+const char *infi_fnameX;
+bool recalc_resid;         // whether to recalculate residual at the end of iterative solver
+enum chpoint chp_type;     // type of checkpoint (to save)
+time_t chp_time;           // time of checkpoint (in sec)
+char const *chp_dir;       // directory name to save/load checkpoint
+// used in make_particle.c
+enum sh shape;                   // particle shape definition
+int sh_Npars;                    // number of shape parameters
+double sh_pars[MAX_N_SH_PARMS];  // storage for shape parameters
+double sizeX;                    // size of particle along x-axis
+double dpl;                      // number of dipoles per lambda (wavelength)
+double lambda;                   // incident wavelength (in vacuum)
+int jagged;                      // size of big dipoles, used to construct a particle
+const char *shape_fname;         // name of file, defining the shape
+const char *save_geom_fname;     // geometry file name to save dipole configuration
+const char *shapename;           // name of the used shape
+bool volcor;                     // whether to use volume correction
+bool save_geom;                  // whether to save dipole configuration in .geom file
+opt_index opt_sh;                // option index of shape option used
+double gr_vf;                    // granules volume fraction
+double gr_d;                     // granules diameter
+int gr_mat;                      // domain number to granulate
+double a_eq;                     // volume-equivalent radius of the particle
+enum shform sg_format;           // format for saving geometry files
+bool store_grans;                // whether to save granule positions to file
+
+// LOCAL VARIABLES
+
+#define GFORM_RI_DIRNAME "%.4g" // format for refractive index in directory name
+
+static const char *run_name;    // first part of the dir name ('run' or 'test')
+static const char *avg_parms;   // name of file with orientation averaging parameters
+static const char *exename;     // name of executable (adda, adda.exe, adda_mpi,...)
+static int Nmat_given;          // number of refractive indices given in the command line
+static enum sym sym_type;       // how to treat particle symmetries
+/* The following '..._used' flags are, in principle, redundant, since the structure 'options' contains the same flags.
+ * However, the latter can't be easily addressed by the option name (a search over the whole options is required).
+ * When thinking about adding a new one, first consider using UNDEF machinery instead
+ */
+static bool prop_used;          // whether '-prop ...' was used in the command line
+static bool orient_used;        // whether '-orient ...' was used in the command line
+static bool yz_used;            // whether '-yz ...' was used in the command line
+static bool scat_plane_used;    // whether '-scat_plane ...' was used in the command line
+
+/* TO ADD NEW COMMAND LINE OPTION
+ * If you need new variables or flags to implement effect of the new command line option, define them here. If a
+ * variable is used only in this source file, define it as local (static). If it is used in one another file, define
+ * them as semi-global, i.e. define them here under corresponding 'used in ...' line and put 'extern' declaration in
+ * corresponding source file under 'defined and initialized in param.c' line. If it is used in this and two or more
+ * files, define it as global, by putting definition in vars.c and 'extern' declaration in vars.h.
+ */
+
+// structure definitions
+struct subopt_struct {
+	const char *name;  // name of option
+	const char *usage; // how to use (argument list)
+	const char *help;  // help string
+	const int narg;    /* possible number of arguments; UNDEF -> should not be checked; may contain also some special
+	                      negative codes, like FNAME_ARG. Currently it is assumed that all arguments are float (if no
+	                      special argument is specified), but it can be changed if will become a limitation. */
+	const int type;    // type of suboption
+};
+struct opt_struct {
+	const char *name;                // name of option
+	void (*func)(int Narg,char **argv); // pointer to a function, parsing this parameter
+	bool used;                       // flag to indicate, if the option was already used
+	const char *usage;               // how to use (argument list)
+	const char *help;                // help string
+	const int narg;                  // possible number of arguments; UNDEF -> should not be checked
+	const struct subopt_struct *sub; // suboptions
+};
+// const string for usage of ADDA
+static const char exeusage[]="[-<opt1> [<args1>] [-<opt2> <args2>]...]]";
+
+/* initializations of suboptions (comments to elements of subopt_struct are above); Contrary to 'options', suboptions
+ * are defined as null-terminated array, because they may be referenced not directly by their names but also as
+ * options[i].sub. In the latter case macro LENGTH can't be used to estimate the length of the array. So getting this
+ * length is at least nontrivial (e.g. can be done with some intermediate variables). So using NULL-termination seems
+ * to be the easiest.
+ */
+static const struct subopt_struct beam_opt[]={
+	{"barton5","<width> [<x> <y> <z>]","5th order approximation of the Gaussian beam (by Barton). The beam width is "
+		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
+		"(zero, by default). All arguments are in um. This is recommended option for simulation of the Gaussian beam.",
+		UNDEF,B_BARTON5},
+	{"besselCS","[<order> <angle> <x> <y> <z>]","Circularly symmetric Bessel beam of integer order derived "
+			"using ASR method. The tilt angle is measured from the z axis. Arguments x, y, z are coordinates of the "
+			"center of the beam (in laboratory reference frame). Coordinate arguments are in um. All arguments are "
+			"optional (zero, by default).",UNDEF,B_BESSELCS},
+	{"besselLP","[<order> <angle> <x> <y> <z>]","Linearly polarized Bessel beam of integer order derived using "
+			"Hertz vector potentials (m- type). The tilt angle is measured from the z axis. Arguments x, y, z are coordinates of "
+			"the center of the beam (in laboratory reference frame). Coordinate arguments are in um. All arguments are "
+			"optional (zero, by default).",UNDEF,B_BESSELLP},
+	{"davis3","<width> [<x> <y> <z>]","3rd order approximation of the Gaussian beam (by Davis). The beam width is "
+		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
+		"(zero, by default). All arguments are in um.",UNDEF,B_DAVIS3},
+	{"dipole","<x> <y> <z>","Field of a unit point dipole placed at x, y, z coordinates (in laboratory reference "
+		"frame). All arguments are in um. Orientation of the dipole is determined by -prop command line option."
+		"Implies '-scat_matr none'. If '-surf' is used, dipole position should be above the surface.",3,B_DIPOLE},
+	{"lminus","<width> [<x> <y> <z>]","Simplest approximation of the Gaussian beam. The beam width is obligatory and "
+		"x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional (zero, by"
+		" default). All arguments are in um.",UNDEF,B_LMINUS},
+	{"plane","","Infinite plane wave",0,B_PLANE},
+	{"read","<filenameY> [<filenameX>]","Defined by separate files, which names are given as arguments. Normally two "
+		"files are required for Y- and X-polarizations respectively, but a single filename is sufficient if only "
+		"Y-polarization is used (e.g. due to symmetry). Incident field should be specified in a particle reference "
+		"frame in the same format as used by '-store_beam'.",FNAME_ARG_1_2,B_READ},
+	/* TO ADD NEW BEAM
+	 * add a row to this list in alphabetical order. It contains: beam name (used in command line), usage string, help
+	 * string, possible number of float parameters, beam identifier (defined inside 'enum beam' in const.h). Usage and
+	 * help string are shown either when -h option is invoked or error is found in input command line. Usage string is
+	 * one line giving a list of possible arguments or argument combinations. Do not include beam name in it, use
+	 * <arg_name> to denote argument, [...] for optional arguments, and {...|...|...} for multiple options of an
+	 * argument. Help string should contain general description of the beam type and its arguments. Instead of number
+	 * of parameters UNDEF can be used (if beam can accept variable number of parameters, then check it explicitly in
+	 * function PARSE_FUNC(beam) below) or one of FNAME_ARG family (see explanation in const.h) if beam accepts a
+	 * filenames as arguments. Number of parameters should not be greater than MAX_N_BEAM_PARMS (defined in const.h).
+	 */
+	{NULL,NULL,NULL,0,0}
+};
+static const struct subopt_struct shape_opt[]={
+#ifndef SPARSE
+	{"axisymmetric","<filename>","Axisymmetric homogeneous shape, defined by its contour in ro-z plane of the "
+		"cylindrical coordinate system. Its symmetry axis coincides with the z-axis, and the contour is read from "
+		"file.",FNAME_ARG,SH_AXISYMMETRIC},
+	{"bicoated","<R_cc/d> <d_in/d>","Two identical concentric coated spheres with outer diameter d (first domain), "
+		"inner diameter d_in, and center-to-center distance R_cc (along the z-axis). It describes both separate and "
+		"sintered coated spheres. In the latter case sintering is considered symmetrically for cores and shells.",
+		2,SH_BICOATED},
+	{"biellipsoid","<y1/x1> <z1/x1> <x2/x1> <y2/x2> <z2/x2>","Two general ellipsoids in default orientations with "
+		"centers on the z-axis, touching each other. Their semi-axes are x1,y1,z1 (lower one, first domain) and "
+		"x2,y2,z2 (upper one, second domain).",5,SH_BIELLIPSOID},
+	{"bisphere","<R_cc/d> ","Two identical spheres with diameter d and center-to-center distance R_cc (along the "
+		"z-axis). It describe both separate and sintered spheres.",1,SH_BISPHERE},
+	{"box","[<y/x> <z/x>]","Homogeneous cube (if no arguments are given) or a rectangular parallelepiped with edges "
+		"x,y,z.",UNDEF,SH_BOX},
+	{"capsule","<h/d>","Homogeneous capsule (cylinder with half-spherical end caps) with cylinder height h and "
+		"diameter d (its axis of symmetry coincides with the z-axis).",1,SH_CAPSULE},
+	{"chebyshev","<eps> <n>","Axisymmetric Chebyshev particle of amplitude eps and order n, r=r_0[1+eps*cos(n*theta)]. "
+		"eps is a real number, such that |eps|<=1, while n is a natural number",2,SH_CHEBYSHEV},
+	{"coated","<d_in/d> [<x/d> <y/d> <z/d>]","Sphere with a spherical inclusion; outer sphere has a diameter d (first "
+		"domain). The included sphere has a diameter d_in (optional position of the center: x,y,z).",UNDEF,SH_COATED},
+	{"cylinder","<h/d>","Homogeneous cylinder with height (length) h and diameter d (its axis of symmetry coincides "
+		"with the z-axis).",1,SH_CYLINDER},
+	{"egg","<eps> <nu>","Axisymmetric egg shape given by a^2=r^2+nu*r*z-(1-eps)z^2, where 'a' is scaling factor. "
+		"Parameters must satisfy 0<eps<=1, 0<=nu<eps.",2,SH_EGG},
+	{"ellipsoid","<y/x> <z/x>","Homogeneous general ellipsoid with semi-axes x,y,z",2,SH_ELLIPSOID},
+	{"line","","Line along the x-axis with the width of one dipole",0,SH_LINE},
+	{"plate", "<h/d>","Homogeneous plate (cylinder with rounded side) with cylinder height h and full diameter d (i.e. "
+		"diameter of the constituent cylinder is d-h). Its axis of symmetry coincides with the z-axis.",1,SH_PLATE},
+	{"prism","<n> <h/Dx>","Homogeneous right prism with height (length along the z-axis) h based on a regular polygon "
+		"with n sides of size 'a'. The polygon is oriented so that positive x-axis is a middle perpendicular for one "
+		"of its sides. Dx is size of the polygon along the x-axis, equal to 2Ri and Rc+Ri for even and odd n "
+		"respectively. Rc=a/[2sin(pi/n)] and Ri=Rc*cos(pi/n) are radii of circumscribed and inscribed circles "
+		"respectively.",2,SH_PRISM},
+	{"rbc","<h/d> <b/d> <c/d>","Red Blood Cell, an axisymmetric (over z-axis) biconcave homogeneous particle, which is "
+		"characterized by diameter d, maximum and minimum width h, b, and diameter at the position of the maximum "
+		"width c. The surface is described by ro^4+2S*ro^2*z^2+z^4+P*ro^2+Q*z^2+R=0, ro^2=x^2+y^2, P,Q,R,S are "
+		"determined by the described parameters.",3,SH_RBC},
+#endif // !SPARSE
+	{"read","<filename>","Read a particle geometry from file <filename>",FNAME_ARG,SH_READ},
+#ifndef SPARSE
+	{"sphere","","Homogeneous sphere",0,SH_SPHERE},
+	{"spherebox","<d_sph/Dx>","Sphere (diameter d_sph) in a cube (size Dx, first domain)",1,SH_SPHEREBOX},
+#endif // !SPARSE
+	/* TO ADD NEW SHAPE
+	 * add a row to this list in alphabetical order. It contains: shape name (used in command line), usage string, help
+	 * string, possible number of float parameters, shape identifier (defined inside 'enum sh' in const.h). Usage and
+	 * help string are shown either when -h option is invoked or error is found in input command line. Usage string is
+	 * one line giving a list of possible arguments or argument combinations. Do not include shape name in it, use
+	 * <arg_name> to denote argument, [...] for optional arguments, and {...|...|...} for multiple options of an
+	 * argument. Help string should contain general description of the shape and its arguments. Instead of number of
+	 * parameters UNDEF can be used (if shape can accept variable number of parameters, then check it explicitly in
+	 * function PARSE_FUNC(shape) below) or FNAME_ARG (if the shape accepts a single string argument with file name).
+	 * Number of parameters should not be greater than MAX_N_SH_PARMS (defined in const.h). It is recommended to use
+	 * dimensionless shape parameters, e.g. aspect ratios.
+	 */
+	{NULL,NULL,NULL,0,0}
+};
+/* TO ADD NEW COMMAND LINE OPTION
+ * If a new option requires separate description of suboptions, add a static structure here (similar to already existing
+ * ones). It should contain a number of rows corresponding to different suboptions (see definition of subopt_struct
+ * above for details) and terminate with a NULL row.
+ */
+
+// EXTERNAL FUNCTIONS
+
+// GenerateB.c
+void InitBeam(void);
+
+//======================================================================================================================
+/* Prototypes of parsing functions; definitions are given below. defines are for conciseness. Since we use one common
+ * prototype style for all parsing functions and many of the latter do not actually use the passed parameters, these
+ * parameters have 'unused' attribute to eliminate spurious warnings.
+ */
+#define PARSE_NAME(a) parse_##a
+#define PARSE_FUNC(a) static void PARSE_NAME(a)(int Narg ATT_UNUSED,char **argv ATT_UNUSED)
+#define PAR(a) #a,PARSE_NAME(a),false
+PARSE_FUNC(alldir_inp);
+PARSE_FUNC(anisotr);
+PARSE_FUNC(asym);
+PARSE_FUNC(beam);
+PARSE_FUNC(chp_dir);
+PARSE_FUNC(chp_load);
+PARSE_FUNC(chp_type);
+PARSE_FUNC(chpoint);
+PARSE_FUNC(Cpr);
+PARSE_FUNC(Csca);
+PARSE_FUNC(dir);
+PARSE_FUNC(dpl);
+PARSE_FUNC(eps);
+PARSE_FUNC(eq_rad);
+#ifdef OPENCL
+PARSE_FUNC(gpu);
+#endif
+#ifndef SPARSE
+PARSE_FUNC(granul);
+#endif
+PARSE_FUNC(grid);
+PARSE_FUNC(h) ATT_NORETURN;
+PARSE_FUNC(init_field);
+PARSE_FUNC(int);
+PARSE_FUNC(int_surf);
+PARSE_FUNC(iter);
+PARSE_FUNC(jagged);
+PARSE_FUNC(lambda);
+PARSE_FUNC(m);
+PARSE_FUNC(maxiter);
+PARSE_FUNC(no_reduced_fft);
+PARSE_FUNC(no_vol_cor);
+PARSE_FUNC(ntheta);
+PARSE_FUNC(opt);
+PARSE_FUNC(orient);
+PARSE_FUNC(phi_integr);
+PARSE_FUNC(pol);
+PARSE_FUNC(prognosis);
+PARSE_FUNC(prop);
+PARSE_FUNC(recalc_resid);
+PARSE_FUNC(rect_dip);
+#ifndef SPARSE
+PARSE_FUNC(save_geom);
+#endif
+PARSE_FUNC(scat);
+PARSE_FUNC(scat_grid_inp);
+PARSE_FUNC(scat_matr);
+PARSE_FUNC(scat_plane);
+#ifndef SPARSE
+PARSE_FUNC(sg_format);
+#endif
+PARSE_FUNC(shape);
+PARSE_FUNC(size);
+PARSE_FUNC(store_beam);
+PARSE_FUNC(store_dip_pol);
+PARSE_FUNC(store_force);
+#ifndef SPARSE
+PARSE_FUNC(store_grans);
+#endif
+PARSE_FUNC(store_int_field);
+PARSE_FUNC(store_scat_grid);
+PARSE_FUNC(surf);
+PARSE_FUNC(sym);
+PARSE_FUNC(test);
+PARSE_FUNC(V) ATT_NORETURN;
+PARSE_FUNC(vec);
+PARSE_FUNC(yz);
+/* TO ADD NEW COMMAND LINE OPTION
+ * add a function prototype to this list. Add a line 'PARSE_FUNC(option_name);' in alphabetical order. It will be
+ * expanded automatically using defines specified above.
+ */
+
+static struct opt_struct options[]={
+	{PAR(alldir_inp),"<filename>","Specifies a file with parameters of the grid of scattering angles for calculating "
+		"integral scattering quantities.\n"
+		"Default: "FD_ALLDIR_PARMS,1,NULL},
+	{PAR(anisotr),"","Specifies that refractive index is anisotropic (its tensor is limited to be diagonal in particle "
+		"reference frame). '-m' then accepts 6 arguments per each domain. Can not be used with CLDR polarizability and "
+		"all SO formulations.",0,NULL},
+	{PAR(asym),"","Calculate the asymmetry vector. Implies '-Csca' and '-vec'",0,NULL},
+	{PAR(beam),"<type> [<args>]","Sets the incident beam, either predefined or 'read' from file. All parameters of "
+		"predefined beam types (if present) are floats.\n"
+		"Default: plane",UNDEF,beam_opt},
+	{PAR(chp_dir),"<dirname>","Sets directory for the checkpoint (both for saving and loading).\n"
+		"Default: "FD_CHP_DIR,1,NULL},
+	{PAR(chp_load),"","Restart a simulation from a checkpoint",0,NULL},
+	{PAR(chp_type),"{normal|regular|always}",
+		"Sets type of the checkpoint. All types, except 'always', require '-chpoint'.\n"
+		"Default: normal",1,NULL},
+	{PAR(chpoint),"<time>","Specifies the time for checkpoints in format '#d#h#m#s'. All fields are optional, numbers "
+		"are integers, 's' can be omitted, the format is not case sensitive.\n"
+		"Examples: 12h30M, 1D10s, 3600",1,NULL},
+	{PAR(Cpr),"","Calculate the total radiation force, expressed as cross section.",0,NULL},
+	{PAR(Csca),"","Calculate scattering cross section (by integrating the scattered field)",0,NULL},
+	{PAR(dir),"<dirname>","Sets directory for output files.\n"
+		"Default: constructed automatically",1,NULL},
+	{PAR(dpl),"<arg>","Sets parameter 'dipoles per lambda' (along the x-axis), float.\n"
+		"Default: 10|m|, where |m| is the maximum of all given refractive indices.",1,NULL},
+	{PAR(eps),"<arg>","Specifies the stopping criterion for the iterative solver by setting the relative norm of the "
+		"residual 'epsilon' to reach. <arg> is an exponent of base 10 (float), i.e. epsilon=10^(-<arg>).\n"
+		"Default: 5 (epsilon=1E-5)",1,NULL},
+	{PAR(eq_rad),"<arg>","Sets volume-equivalent radius of the particle in um, float. If default wavelength is used, "
+		"this option specifies the volume-equivalent size parameter. Can not be used together with '-size'. Size is "
+		"defined by some shapes themselves, then this option can be used to override the internal specification and "
+		"scale the shape.\n"
+		"Default: determined by the value of '-size' or by '-grid', '-dpl', and '-lambda'.",1,NULL},
+#ifdef OPENCL
+	{PAR(gpu),"<index>","Specifies index of GPU that should be used (starting from 0). Relevant only for OpenCL "
+		"version of ADDA, running on a system with several GPUs.\n"
+		"Default: 0",1,NULL},
+#endif
+#ifndef SPARSE
+	{PAR(granul),"<vol_frac> <diam> [<dom_number>]","Specifies that one particle domain should be randomly filled with "
+		"spherical granules with specified diameter <diam> and volume fraction <vol_frac>. Domain number to fill is "
+		"given by the last optional argument. Algorithm may fail for volume fractions > 30-50%.\n"
+		"Default <dom_number>: 1",UNDEF,NULL},
+#endif // !SPARSE
+	{PAR(grid),"<nx> [<ny> <nz>]","Sets dimensions of the computation grid (any positive integers). In most "
+		"cases <ny> and <nz> can be omitted (they are automatically determined by <nx> based on the proportions of the "
+		"scatterer). This command line option is not relevant when particle geometry is read from a file ('-shape "
+		"read'). If '-jagged' option is used the grid dimension is effectively multiplied by the specified number.\n"
+		"Default: 16 (if neither '-size' nor '-eq_rad' are specified) or defined by\n"
+		"         '-size' or '-eq_rad', '-lambda', and '-dpl'.",UNDEF,NULL},
+	{PAR(h),"[<opt> [<subopt>]]","Shows help. If used without arguments, ADDA shows a list of all available command "
+		"line options. If first argument is specified, help on specific command line option <opt> is shown (only the "
+		"name of the option should be given without preceding dash). For some options (e.g. '-beam' or '-shape') "
+		"specific help on a particular suboption <subopt> may be shown.\n"
+		"Example: shape coated",UNDEF,NULL},
+	{PAR(init_field),"{auto|inc|read <filenameY> [<filenameX>]|wkb|zero}",
+		"Sets prescription to calculate initial (starting) field for the iterative solver.\n"
+		"'auto' - automatically choose from 'zero' and 'inc' based on the lower residual value.\n"
+		"'inc' - derived from the incident field,\n"
+		"'read' - defined by separate files, which names are given as arguments. Normally two files are required for "
+		"Y- and X-polarizations respectively, but a single filename is sufficient if only Y-polarization is used (e.g. "
+		"due to symmetry). Initial field should be specified in a particle reference frame in the same format as used "
+		"by '-store_int_field',\n"
+		"'wkb' - from Wentzel-Kramers-Brillouin approximation,\n"
+#ifdef SPARSE
+		"!!! 'wkb' is not operational in sparse mode\n"
+#endif
+		"'zero' is a zero vector,\n"
+		"Default: auto",UNDEF,NULL},
+	{PAR(int),"{fcd|fcd_st|igt [<lim> [<prec>]]|igt_so|nloc <Rp>|nloc_av <Rp>|poi|so}",
+		"Sets prescription to calculate the interaction term.\n"
+		"'fcd' - Filtered Coupled Dipoles - requires dpl to be larger than 2.\n"
+		"'fcd_st' - static (long-wavelength limit) version of FCD.\n"
+		"'igt' - Integration of Green's Tensor. Its parameters are: <lim> - maximum distance (in largest dipole "
+		"dimensions), for which integration is used, (default: infinity); <prec> - minus decimal logarithm of relative "
+		"error of the integration, i.e. epsilon=10^(-<prec>) (default: the same as the argument (or default value) of "
+		"'-eps' command line option).\n"
+#ifdef NO_FORTRAN
+		"!!! 'igt' relies on Fortran sources that were disabled at compile time.\n"
+#endif
+		"'igt_so' - approximate evaluation of IGT using second order of kd approximation.\n"
+		"'nloc' - non-local interaction of two Gaussian dipole densities (based on point value of Gh), <Rp> is the "
+		"width of the latter in um (must be non-negative).\n"
+		"'nloc_av' - same as 'nloc' but based on averaging over the cube volume.\n"
+		"'poi' - (the simplest) interaction between point dipoles.\n"
+		"'so' - under development and incompatible with '-anisotr'.\n"
+#ifdef SPARSE
+		"!!! All options except 'poi' incur a significant slowing down in sparse mode.\n"
+#endif
+		"Default: poi",UNDEF,NULL},
+		/* TO ADD NEW INTERACTION FORMULATION
+		 * Modify string constants after 'PAR(int)': add new argument (possibly with additional sub-arguments) to list
+		 * {...} and its description to the next string. If the new interaction formulation requires unusually large
+		 * computational time, add a special note for sparse mode (after '#ifdef SPARSE').
+		 */
+	{PAR(int_surf),"{img|som}",
+		"Sets prescription to calculate the reflection term.\n"
+		"'img' - approximation based on a single image dipole (fast but inaccurate).\n"
+		"'som' - direct evaluation of Sommerfeld integrals.\n"
+	#ifdef SPARSE
+		"!!! In sparse mode 'som' is expected to be very slow.\n"
+	#endif
+		"Default: som (but 'img' if surface is perfectly reflecting)",1,NULL},
+		/* TO ADD NEW REFLECTION FORMULATION
+		 * Modify string constants after 'PAR(int_surf)': add new argument (possibly with additional sub-arguments) to
+		 * list {...} and its description to the next string. If the new reflection formulation requires unusually
+		 * large computational time, add a special note for sparse mode (after '#ifdef SPARSE').
+		 * !!! If subarguments are added, second-to-last argument should be changed from 1 to UNDEF, and consistency
+		 * test for number of arguments should be implemented in PARSE_FUNC(int_surf) below.
+		 */
+	{PAR(iter),"{bcgs2|bicg|bicgstab|cgnr|csym|qmr|qmr2}","Sets the iterative solver.\n"
+		"Default: qmr",1,NULL},
+		/* TO ADD NEW ITERATIVE SOLVER
+		 * add the short name, used to define the new iterative solver in the command line, to the list "{...}" in the
+		 * alphabetical order.
+		 */
+	{PAR(jagged),"<arg>","Sets a size of a big dipole in units of small dipoles, integer. It is used to improve the "
+		"discretization of the particle without changing the shape.\n"
+		"Default: 1",1,NULL},
+	{PAR(lambda),"<arg>","Sets incident wavelength in um, float.\n"
+		"Default: 2*pi",1,NULL},
+	{PAR(m),"{<m1Re> <m1Im> [...]|<m1xxRe> <m1xxIm> <m1yyRe> <m1yyIm> <m1zzRe> <m1zzIm> [...]}","Sets refractive "
+		"indices, float. Each pair of arguments specifies real and imaginary part of the refractive index of one of "
+		"the domains. If '-anisotr' is specified, three refractive indices correspond to one domain (diagonal elements "
+		"of refractive index tensor in particle reference frame). Maximum number of different refractive indices is "
+		"defined at compilation time by the parameter MAX_NMAT in file const.h (by default, 15). None of the "
+		"refractive indices can be equal to 1+0i.\n"
+		"Default: 1.5 0",UNDEF,NULL},
+	{PAR(maxiter),"<arg>","Sets the maximum number of iterations of the iterative solver, integer.\n"
+		"Default: very large, not realistic value",1,NULL},
+	{PAR(no_reduced_fft),"","Do not use symmetry of the interaction matrix to reduce the storage space for the "
+		"Fourier-transformed matrix.",0,NULL},
+	{PAR(no_vol_cor),"","Do not use 'dpl (volume) correction'. If this option is given, ADDA will try to match size of "
+		"the dipole grid along x-axis to that of the particle, either given by '-size' or calculated analytically from "
+		"'-eq_rad'. Otherwise (by default) ADDA will try to match the volumes, using either '-eq_rad' or the value "
+		"calculated analytically from '-size'.",0,NULL},
+	{PAR(ntheta),"<arg>","Sets the number of intervals, into which the range of scattering angles [0,180] (degrees) is "
+		"equally divided, integer. This is used for scattering angles in yz-plane. If particle is not symmetric and "
+		"orientation averaging is not used, the range is extended to 360 degrees (with the same length of elementary "
+		"interval, i.e. number of intervals is doubled).\n"
+		"Default: from 90 to 720 depending on the size of the computational grid.",1,NULL},
+	{PAR(opt),"{speed|mem}",
+		"Sets whether ADDA should optimize itself for maximum speed or for minimum memory usage.\n"
+		"Default: speed",1,NULL},
+	{PAR(orient),"{<alpha> <beta> <gamma>|avg [<filename>]}","Either sets an orientation of the particle by three "
+		"Euler angles 'alpha','beta','gamma' (in degrees) or specifies that orientation averaging should be "
+		"performed. <filename> sets a file with parameters for orientation averaging. Here zyz-notation (or "
+		"y-convention) is used for Euler angles.\n"
+		"Default orientation: 0 0 0\n"
+		"Default <filename>: "FD_AVG_PARMS,UNDEF,NULL},
+	{PAR(phi_integr),"<arg>","Turns on and specifies the type of Mueller matrix integration over azimuthal angle "
+		"'phi'. <arg> is an integer from 1 to 31, each bit of which, from lowest to highest, indicates whether the "
+		"integration should be performed with multipliers 1, cos(2*phi), sin(2*phi), cos(4*phi), and sin(4*phi) "
+		"respectively.\n"
+		"Examples: 1 (one integration with no multipliers),\n"
+		"          6 (two integration with cos(2*phi) and sin(2*phi) multipliers).",1,NULL},
+	{PAR(pol),"{cldr|cm|dgf|fcd|igt_so|lak|ldr [avgpol]|nloc <Rp>|nloc_av <Rp>|rrc|so}",
+		"Sets prescription to calculate the dipole polarizability.\n"
+		"'cldr' - Corrected LDR (see below), incompatible with '-anisotr'.\n"
+		"'cm' - (the simplest) Clausius-Mossotti.\n"
+		"'dgf' - Digitized Green's Function (second order approximation to LAK).\n"
+		"'fcd' - Filtered Coupled Dipoles (requires dpl to be larger than 2).\n"
+		"'igt_so' - Integration of Green's Tensor over a cube (second order approximation).\n"
+		"'lak' - (by Lakhtakia) exact integration of Green's Tensor over a sphere.\n"
+		"'ldr' - Lattice Dispersion Relation, optional flag 'avgpol' can be added to average polarizability over "
+		"incident polarizations.\n"
+		"'nloc' - non-local (Gaussian dipole density, based on lattice sums), <Rp> is the width of the latter in um "
+		"(must be non-negative).\n"
+		"'nloc_av' - same as 'nloc' but based on averaging of Gh over the dipole volume.\n"
+		"'rrc' - Radiative Reaction Correction (added to CM).\n"
+		"'so' - under development and incompatible with '-anisotr'.\n"
+		"Default: ldr (without averaging) or cldr (for -rect_dip).",UNDEF,NULL},
+		/* TO ADD NEW POLARIZABILITY FORMULATION
+		 * Modify string constants after 'PAR(pol)': add new argument (possibly with additional sub-arguments) to list
+		 * {...} and its description to the next string.
+		 */
+	{PAR(prognosis),"","Do not actually perform simulation (not even memory allocation) but only estimate the required "
+		"RAM. Implies '-test'.",0,NULL},
+	{PAR(prop),"<x> <y> <z>","Sets propagation direction of incident radiation, float. Normalization (to the unity "
+		"vector) is performed automatically. For point-dipole incident beam this determines its direction.\n"
+		"Default: 0 0 1",3,NULL},
+	{PAR(recalc_resid),"","Recalculate residual at the end of iterative solver.",0,NULL},
+	{PAR(rect_dip),"<x> <y> <z>","Use rectangular-cuboid dipoles. Three arguments are the relative dipole sizes along "
+		"the corresponding axes. Absolute scale is not relevant, i.e. '1 2 2' is equivalent to '0.5 1 1'.\n"
+		"Default: 1 1 1",3,NULL},
+#ifndef SPARSE
+	{PAR(save_geom),"[<filename>]","Save dipole configuration to a file <filename> (a path relative to the output "
+		"directory). Can be used with '-prognosis'.\n"
+		"Default: <type>.geom \n"
+		"(<type> is a first argument to the '-shape' option; '_gran' is added if '-granul' option is used; file "
+		"extension can differ depending on argument of '-sg_format' option).",
+		UNDEF,NULL},
+#endif // !SPARSE
+	{PAR(scat),"{dr|fin|igt_so|so}","Sets prescription to calculate scattering quantities.\n"
+		"'dr' - (by Draine) standard formulation for point dipoles\n"
+		"'fin' - slightly different one, based on a radiative correction for a finite dipole.\n"
+		"'igt_so' - second order in kd approximation to Integration of Green's Tensor.\n"
+		"'so' - under development and incompatible with '-anisotr'.\n"
+		"Default: dr",1,NULL},
+	{PAR(scat_grid_inp),"<filename>","Specifies a file with parameters of the grid of scattering angles for "
+		"calculating Mueller matrix (possibly integrated over 'phi').\n"
+		"Default: "FD_SCAT_PARMS,1,NULL},
+	{PAR(scat_matr),"{muel|ampl|both|none}","Specifies which scattering matrices (from Mueller and amplitude) should "
+		"be saved to file. Amplitude matrix is never integrated (in combination with '-orient avg' or '-phi_integr').\n"
+		"Default: muel",1,NULL},
+	{PAR(scat_plane),"","Explicitly enables calculation of the scattering in the plane through e_z (in laboratory "
+		"reference frame) and propagation direction of incident wave. For default incidence this is the xz-plane. It "
+		"can also be implicitly enabled by other options.",0,NULL},
+#ifndef SPARSE
+	{PAR(sg_format),"{text|text_ext|ddscat6|ddscat7}","Specifies format for saving geometry files. First two are ADDA "
+		"default formats for single- and multi-domain particles respectively. 'text' is automatically changed to "
+		"'text_ext' for multi-domain particles. Two DDSCAT formats correspond to its shape options 'FRMFIL' (version "
+		"6) and 'FROM_FILE' (version 7) and output of 'calltarget' utility.\n"
+		"Default: text",1,NULL},
+#endif // !SPARSE
+		/* TO ADD NEW FORMAT OF SHAPE FILE
+		 * Modify string constants after 'PAR(sg_format)': add new argument to list {...} and add its description to
+		 * the next string.
+		 */
+	{PAR(shape),"<type> [<args>]","Sets shape of the particle, either predefined or 'read' from file. All parameters "
+		"of predefined shapes are floats except for filenames.\n"
+		"Default: sphere",UNDEF,shape_opt},
+	{PAR(size),"<arg>","Sets the size of the computational grid along the x-axis in um, float. If default wavelength "
+		"is used, this option specifies the 'size parameter' of the computational grid. Can not be used together with "
+		"'-eq_rad'. Size is defined by some shapes themselves, then this option can be used to override the internal "
+		"specification and scale the shape.\n"
+		"Default: determined by the value of '-eq_rad' or by '-grid', '-dpl', and '-lambda'.",1,NULL},
+	{PAR(store_beam),"","Save incident beam to a file",0,NULL},
+	{PAR(store_dip_pol),"","Save dipole polarizations to a file",0,NULL},
+	{PAR(store_force),"","Calculate the radiation force on each dipole. Implies '-Cpr'",0,NULL},
+#ifndef SPARSE
+	{PAR(store_grans),"","Save granule coordinates (placed by '-granul' option) to a file",0,NULL},
+#endif
+	{PAR(store_int_field),"","Save internal fields to a file",0,NULL},
+	{PAR(store_scat_grid),"","Calculate Mueller matrix for a grid of scattering angles and save it to a file.",0,NULL},
+	{PAR(surf),"<h> {<mre> <mim>|inf}","Specifies that scatterer is located above the plane surface, parallel to the "
+		"xy-plane. <h> specifies the height of particle center above the surface (along the z-axis, in um). Particle "
+		"must be entirely above the substrate. Following argument(s) specify the refractive index of the substrate "
+		"(below the surface), assuming that the vacuum is above the surface. It is done either by two values (real and "
+		"imaginary parts of the complex value) or as effectively infinite 'inf' which corresponds to perfectly"
+		"reflective surface. The latter implies certain simplifications during calculations.",UNDEF,NULL},
+	{PAR(sym),"{auto|no|enf}","Automatically determine particle symmetries ('auto'), do not take them into account "
+		"('no'), or enforce them ('enf').\n"
+		"Default: auto",1,NULL},
+	{PAR(test),"","Begin name of the output directory with 'test' instead of 'run'",0,NULL},
+	{PAR(V),"","Show ADDA version, compiler used to build this executable, build options, and copyright information",
+		0,NULL},
+	{PAR(vec),"","Calculate the not-normalized asymmetry vector",0,NULL},
+	{PAR(yz),"","Explicitly enables calculation of the scattering in the yz-plane (in incident-wave reference frame). "
+		"It can also be implicitly enabled by other options.",0,NULL}
+	/* TO ADD NEW COMMAND LINE OPTION
+	 * add a row to this list, initializing an option. It should contain: PAR(option_name), usage string, help string,
+	 * number of arguments, pointer to suboption (if exist, NULL otherwise). Usage and help string are shown either
+	 * when -h option is invoked or error is found in input command line. Usage string is one line giving a list of
+	 * possible arguments or argument combinations. Do not include option name in it, use <arg_name> to denote argument,
+	 * [...] for optional arguments, and {...|...|...} for multiple options of an argument. Help string should contain
+	 * general description of the option and its arguments, and provide default value for the arguments (if applicable).
+	 * UNDEF can be used instead of number of arguments to avoid automatic checking, e.g. when command line option can
+	 * accept variable number of arguments. Then check it explicitly in function PARSE_FUNC(option_name) below. A
+	 * separate suboption structure is recommended only for large options such as -beam and -shape, and it should be
+	 * defined above.
+	 */
+};
+
+// auxiliary functions
+//======================================================================================================================
+
+static const char *OptionName(void)
+// produces full option name for error messages
+{
+	static char buf[MAX_LINE];
+
+	if (opt.l2==UNDEF) return options[opt.l1].name;
+	else {
+		sprintf(buf,"%s %s",options[opt.l1].name,options[opt.l1].sub[opt.l2].name);
+		return buf;
+	}
+}
+
+//======================================================================================================================
+
+void PrintErrorHelp(const char * restrict fmt, ... )
+/* print anything to stderr (on root processor), then help on the arguments used, and stop; assumes that all processors
+ * call it; has line wrapping. It is designed to be relatively safe (using snprintf and vsnprintf), but do not produce
+ * any additional errors in case of buffer overflows, etc. (not to distract from the main error itself). However, for
+ * uncontrolled (e.g. user-input) arguments, it is recommended to use PrintErrorHelpSafe instead.
+ */
+{
+	va_list args;
+	const char * restrict optname,* restrict use;
+	char msg[MAX_MESSAGE]="ERROR: ";
+	int shift,tmp;
+
+	if (IFROOT) {
+		// produce error message
+		va_start(args,fmt);
+		shift=strlen(msg);
+		VSNPRINTF_SHIFT_ROBUST(shift,tmp,msg,MAX_MESSAGE,fmt,args);
+		va_end(args);
+		// add help message
+		if (opt.l1==UNDEF) { // no option is found
+			SNPRINTF_SHIFT_ROBUST(shift,tmp,msg,MAX_MESSAGE,"\n"
+				"Usage: %s %s\n"
+				"Type '%s -h' for help\n",exename,exeusage,exename);
+		}
+		else { // at least option is found
+			if (opt.l2==UNDEF) use=options[opt.l1].usage;
+			else use=options[opt.l1].sub[opt.l2].usage;
+			optname=OptionName();
+			SNPRINTF_SHIFT_ROBUST(shift,tmp,msg,MAX_MESSAGE,"\n"
+				"Usage: -%s %s\n"
+				"Type '%s -h %s' for details\n",optname,use,exename,optname);
+		}
+		WrapLines(msg);
+		fprintf(stderr,"%s",msg);
+		fflush(stderr);
+	}
+	// wait for root to generate an error message
+	Synchronize();
+	Stop(EXIT_FAILURE);
+}
+
+//======================================================================================================================
+
+static void ATT_NORETURN ATT_PRINTF(1,2) PrintErrorHelpSafe(const char * restrict fmt, ... )
+/* print anything to stderr (on root processor), then help on the arguments used, and stop; assumes that all processors
+ * call it; same as PrintErrorHelp but uses no internal buffers to be safe for any input parameters, which may come
+ * from a command line, at a cost of lacking line wrapping.
+ */
+{
+	va_list args;
+	const char * restrict optname,* restrict use;
+
+	if (IFROOT) {
+		// produce error message
+		va_start(args,fmt);
+		fprintf(stderr,"ERROR: ");
+		vfprintf(stderr,fmt,args);
+		fprintf(stderr,"\n");
+		va_end(args);
+		// add help message
+		if (opt.l1==UNDEF) // no option is found
+			fprintf(stderr,"Usage: %s %s\n"
+			               "Type '%s -h' for help\n",exename,exeusage,exename);
+		else { // at least option is found
+			if (opt.l2==UNDEF) use=options[opt.l1].usage;
+			else use=options[opt.l1].sub[opt.l2].usage;
+			optname=OptionName();
+			fprintf(stderr,"Usage: -%s %s\n"
+			               "Type '%s -h %s' for details\n",optname,use,exename,optname);
+		}
+		fflush(stderr);
+	}
+	// wait for root to generate an error message
+	Synchronize();
+	Stop(EXIT_FAILURE);
+}
+
+//======================================================================================================================
+
+static void NargError(const int Narg,const char *expec)
+// Print error of illegal number of arguments to an option (suboption) and display correct usage information
+{
+	PrintErrorHelp("Illegal number of arguments (%d) to '-%s' option (%s expected)",Narg,OptionName(),expec);
+}
+
+
+//======================================================================================================================
+
+static void NargErrorSub(const int Narg,const char *option,const char *expec)
+/* Print error of illegal number of arguments to an option (usually with suboption) and display correct usage
+ * information. Narg is decremented before printing.
+ */
+{
+	PrintErrorHelp("Illegal number of arguments (%d) to '-%s' option (%s expected)",Narg-1,option,expec);
+}
+
+//======================================================================================================================
+
+static void TestExtraNarg(const int Narg, const bool notAllowed,const char *subopt)
+// check if Narg is larger than 1 for suboption, which doesn't allow that
+{
+	if (Narg>1 && notAllowed) PrintErrorHelp("Additional arguments are not allowed for '-%s %s'",OptionName(),subopt);
+}
+
+//======================================================================================================================
+
+static void TestNarg(const int Narg,const int need)
+// check if Narg given to an option (or suboption) is correct; interface to NargError
+{
+	if (need>=0) { // usual case
+		if (Narg!=need) {
+			char buf[MAX_WORD];
+			snprintf(buf,MAX_WORD,"%d",need);
+			NargError(Narg,buf);
+		}
+	} // otherwise special cases are considered, encoded by negative values
+	else switch (need) {
+		case UNDEF: break; // do nothing
+		case FNAME_ARG: if (Narg!=1) NargError(Narg,"1"); break;
+		case FNAME_ARG_2: if (Narg!=2) NargError(Narg,"2"); break;
+		case FNAME_ARG_1_2: if (Narg!=1 && Narg!=2) NargError(Narg,"1 or 2"); break;
+		default: // rigorous test that every possible special case is taken care of
+			PrintError("Critical error in TestNarg function (unknown argument 'need'=%d). Probably this comes from "
+				"value of 'narg' in one of static arrays, describing command line options.",need);
+			// no break
+	}
+}
+
+//======================================================================================================================
+
+static void ATT_NORETURN NotSupported(const char * restrict type,const char * restrict given)
+// print error message that "type 'given' is not supported"; type should start with a capital letter
+{
+	PrintErrorHelpSafe("%s '%s' is not supported",type,given);
+}
+
+//======================================================================================================================
+
+static const char *ScanStrError(const char * restrict str,const unsigned int size)
+// check if string fits in buffer of size 'size', otherwise produces error message; returns the passed str (redirects)
+{
+	if (strlen(str)>=size) PrintErrorHelp("Too long argument to '-%s' option (only %ud chars allowed). If you really "
+		"need it you may increase MAX_DIRNAME in const.h and recompile",OptionName(),size-1);
+	return str;
+}
+
+//======================================================================================================================
+
+static void ScanDoubleError(const char * restrict str,double *res)
+// scanf an option argument and checks for errors
+{
+	if (sscanf(str,"%lf",res)!=1)
+		PrintErrorHelpSafe("Non-numeric argument (%s) is given to the option '-%s'",str,OptionName());
+}
+
+//======================================================================================================================
+
+static void ScanIntError(const char * restrict str,int *res)
+// scanf an option argument and checks for errors
+{
+	double tmp;
+
+	if (sscanf(str,"%lf",&tmp)!=1)
+		PrintErrorHelpSafe("Non-numeric argument (%s) is given to the option '-%s'",str,OptionName());
+	// The following can be rewritten by call to ConvertToInteger(), but it is complicated due to presence of OptionName
+	if (tmp != floor(tmp))
+		PrintErrorHelpSafe("Argument value (%s) of the option '-%s' is not an integer",str,OptionName());
+	if (tmp <INT_MIN || tmp>INT_MAX)
+		PrintErrorHelpSafe("Argument value (%s) of the option '-%s' is out of integer bounds",str,OptionName());
+	*res=(int)tmp;
+}
+
+//======================================================================================================================
+
+static bool ScanFnamesError(const int Narg,const int need,char **argv,const char **fname1,const char **fname2)
+/* If 'need' corresponds to one of FNAME_ARG, scan Narg<=2 filenames from argv into fname1 and fname2. All consistency
+ * checks are left to the caller (in particular, whether Narg corresponds to need). argv should be shifted to contain
+ * only filenames. fname2 can be NULL, but it will produce an error in combination with Narg=2)
+ *
+ * Returns whether filenames has been scanned.
+ */
+{
+	bool res=false;
+
+	if (IS_FNAME_ARG(need)) {
+		*fname1=ScanStrError(argv[0],MAX_FNAME);
+		if (Narg==2) {
+			if (fname2==NULL) // consistency check e.g. for reading shape filename
+				PrintError("Failed to store the second filename in function ScanFnamesError");
+			else *fname2=ScanStrError(argv[1],MAX_FNAME);
+		}
+		res=true;
+	}
+	return res;
+}
+
+//======================================================================================================================
+
+static bool IsOption(const char * restrict str)
+/* checks if string is an option. First should be '-' and then letter (any case); it enables use of negative numbers
+ * as sub-parameters
+ */
+{
+	// conversion to int is needed to remove warnings caused by the fact that str[1] is _signed_ char
+	return (str[0]=='-' && isalpha((int)(str[1])));
+}
+//======================================================================================================================
+
+static int TimeField(const char c)
+// analyze one time multiplier
+{
+	switch (c) {
+		case 'd':
+		case 'D': return 86400;
+		case 'h':
+		case 'H': return 3600;
+		case 'm':
+		case 'M': return 60;
+		case 's':
+		case 'S': return 1;
+	}
+	PrintErrorHelp("Illegal time format specifier (%c)",c);
+}
+
+//======================================================================================================================
+
+static int ScanTime(const char * restrict str)
+// scans time in seconds from a string "%d[d,D[%d]][h,H[%d]][m,M[%d]][s,S]
+{
+#define TIME_N_TYPES 4 // not so easy to change
+	int tim,t[TIME_N_TYPES],n,i;
+	char c[TIME_N_TYPES];
+
+	for (i=0;i<TIME_N_TYPES;i++) c[i]=0;
+	n=sscanf(str,"%d%c%d%c%d%c%d%c",t,c,t+1,c+1,t+2,c+2,t+3,c+3);
+	if (n<1) PrintErrorHelpSafe("Wrong time format '%s'",str);
+	tim=0;
+	i=0;
+	while (n>0) {
+		tim+=t[i]*TimeField(c[i]);
+		n-=2;
+		i++;
+	}
+	return tim;
+#undef TIME_N_TYPES
+}
+
+//======================================================================================================================
+
+static void PrintTime(char * restrict s,const time_t *time_ptr)
+{
+	struct tm *t;
+
+	t=gmtime(time_ptr);
+	s[0]=0; // initialize string
+	if (t->tm_yday>0) sprintf(s,"%dd ",t->tm_yday);
+	if (t->tm_hour>0) sprintf(s+strlen(s),"%dh ",t->tm_hour);
+	if (t->tm_min>0) sprintf(s+strlen(s),"%dm ",t->tm_min);
+	if (t->tm_sec>0) sprintf(s+strlen(s),"%ds ",t->tm_sec);
+}
+
+//======================================================================================================================
+// parsing functions definitions
+
+PARSE_FUNC(alldir_inp)
+{
+	alldir_parms=ScanStrError(argv[1],MAX_FNAME);
+}
+PARSE_FUNC(anisotr)
+{
+	anisotropy = true;
+	Ncomp=3;
+}
+PARSE_FUNC(asym)
+{
+	calc_asym = true;
+	calc_vec = true;
+	calc_Csca = true;
+}
+PARSE_FUNC(beam)
+{
+	int i,j,need;
+	bool found;
+
+	if (Narg==0) PrintErrorHelp("Suboption (argument) is missing for '-beam' option");
+	Narg--;
+	found=false;
+	i=-1;
+	while (beam_opt[++i].name!=NULL) if (strcmp(argv[1],beam_opt[i].name)==0) {
+		// set suboption and beam type
+		opt.l2=i;
+		beamtype=(enum beam)beam_opt[i].type;
+		beam_Npars=Narg;
+		opt_beam=opt;
+		need=beam_opt[i].narg;
+		// check number of arguments
+		switch (beamtype) {
+			case B_LMINUS:
+			case B_DAVIS3:
+			case B_BARTON5: if (Narg!=1 && Narg!=4) NargError(Narg,"1 or 4"); break;
+			case B_BESSELCS:
+			case B_BESSELLP:
+			default: TestNarg(Narg,need); break;
+		}
+		/* TO ADD NEW BEAM
+		 * If the beam accepts variable number of arguments (UNDEF was used in beam definition above) add a check of
+		 * number of received arguments as a new case above. Use NargError function similarly as done in existing tests.
+		 */
+		// either parse filename or parse all parameters as float; consistency is checked later
+		if (!ScanFnamesError(Narg,need,argv+2,&beam_fnameY,&beam_fnameX))
+			for (j=0;j<Narg;j++) ScanDoubleError(argv[j+2],beam_pars+j);
+		// stop search
+		found=true;
+		break;
+	}
+	if(!found) NotSupported("Beam type",argv[1]);
+}
+PARSE_FUNC(chp_dir)
+{
+	chp_dir=ScanStrError(argv[1],MAX_DIRNAME);
+}
+PARSE_FUNC(chp_load)
+{
+	load_chpoint = true;
+}
+PARSE_FUNC(chp_type)
+{
+	if (strcmp(argv[1],"normal")==0) chp_type=CHP_NORMAL;
+	else if (strcmp(argv[1],"regular")==0) chp_type=CHP_REGULAR;
+	else if (strcmp(argv[1],"always")==0) chp_type=CHP_ALWAYS;
+	else NotSupported("Checkpoint type",argv[1]);
+}
+PARSE_FUNC(chpoint)
+{
+	chp_time=ScanTime(argv[1]);
+	if (chp_time<=0) {
+		chp_time=UNDEF;
+		if (chp_type==CHP_NONE) chp_type=CHP_ALWAYS;
+	}
+	else if (chp_type==CHP_NONE) chp_type=CHP_NORMAL;
+}
+PARSE_FUNC(Cpr)
+{
+	calc_mat_force = true;
+}
+PARSE_FUNC(Csca)
+{
+	calc_Csca = true;
+}
+PARSE_FUNC(dir)
+{
+	directory=ScanStrError(argv[1],MAX_DIRNAME);
+}
+PARSE_FUNC(dpl)
+{
+	ScanDoubleError(argv[1],&dpl);
+	TestPositive(dpl,"dpl");
+}
+PARSE_FUNC(eps)
+{
+	double tmp;
+
+	ScanDoubleError(argv[1],&tmp);
+	TestPositive(tmp,"eps exponent");
+	iter_eps=pow(10,-tmp);
+}
+PARSE_FUNC(eq_rad)
+{
+	ScanDoubleError(argv[1],&a_eq);
+	TestPositive(a_eq,"dpl");
+}
+#ifdef OPENCL
+PARSE_FUNC(gpu)
+{
+	ScanIntError(argv[1],&gpuInd);
+	TestNonNegative_i(gpuInd,"GPU index");
+}
+#endif
+#ifndef SPARSE
+PARSE_FUNC(granul)
+{
+	if (Narg!=2 && Narg!=3) NargError(Narg,"2 or 3");
+	ScanDoubleError(argv[1],&gr_vf);
+	TestRangeII(gr_vf,"volume fraction",0,PI_OVER_SIX);
+	ScanDoubleError(argv[2],&gr_d);
+	TestPositive(gr_d,"diameter");
+	if (Narg==3) {
+		ScanIntError(argv[3],&gr_mat);
+		TestPositive_i(gr_mat,"domain number");
+	}
+	else gr_mat=1;
+	gr_mat--; // converted to usual indexing starting from 0
+	sh_granul=true;
+}
+#endif
+PARSE_FUNC(grid)
+{
+	if (Narg!=1 && Narg!=3) NargError(Narg,"1 or 3");
+	ScanIntError(argv[1],&boxX); // boxes are further multiplied by jagged if needed
+	TestRange_i(boxX,"gridX",1,BOX_MAX);
+	if (Narg==3) {
+		ScanIntError(argv[2],&boxY);
+		TestRange_i(boxY,"gridY",1,BOX_MAX);
+		ScanIntError(argv[3],&boxZ);
+		TestRange_i(boxZ,"gridZ",1,BOX_MAX);
+	}
+}
+PARSE_FUNC(h)
+{
+	int i,j;
+	bool found;
+
+	if (Narg>2) NargError(Narg,"not more than 2");
+	// do all output on root processor
+	if (IFROOT) {
+		found=false;
+		if (Narg>=1) {
+			for(i=0;i<LENGTH(options);i++) if (strcmp(argv[1],options[i].name)==0) {
+				if (Narg==2) {
+					if (options[i].sub==NULL) printf("No specific help is available for suboptions of this option\n\n");
+					else {
+						j=-1;
+						while (options[i].sub[++j].name!=NULL)
+							if (strcmp(argv[2],options[i].sub[j].name)==0) {
+								printf("  -%s %s %s\n%s\n",options[i].name,options[i].sub[j].name,
+									options[i].sub[j].usage,WrapLinesCopy(options[i].sub[j].help));
+								found=true;
+								break;
+							}
+						if (!found) printf("Unknown suboption '%s'\n\n",argv[2]);
+					}
+				}
+				if (!found) {
+					printf("  -%s %s\n%s\n",options[i].name,options[i].usage,WrapLinesCopy(options[i].help));
+					if (options[i].sub!=NULL) {
+						printf("Available suboptions:\n");
+						j=-1;
+						while (options[i].sub[++j].name!=NULL)
+							printf("  %s %s\n",options[i].sub[j].name,options[i].sub[j].usage);
+						printf("Type '%s -h %s <subopt>' for details\n",exename,options[i].name);
+#ifdef SPARSE
+						if (strcmp(options[i].name,"shape")==0)
+							printf("!!! Most of the shape options are disabled in sparse mode\n");
+#endif
+					}
+				}
+				found=true;
+				break;
+			}
+			if (!found) printf("Unknown option '%s'\n\n",argv[1]);
+		}
+		if (!found) {
+			printf("Usage: '%s %s'\n"
+			       "Available options:\n",exename,exeusage);
+			for (i=0;i<LENGTH(options);i++) printf("  -%s %s\n",options[i].name,options[i].usage);
+			printf("Type '%s -h <opt>' for details\n",exename);
+#ifdef SPARSE
+			printf("!!! A number of options are disabled in sparse mode\n");
+#endif
+		}
+	}
+	// exit
+	Stop(EXIT_SUCCESS);
+}
+PARSE_FUNC(init_field)
+{
+	bool noExtraArgs=true;
+
+	if (Narg<1 || Narg>3) NargError(Narg,"from 1 to 3");
+	if (strcmp(argv[1],"auto")==0) InitField=IF_AUTO;
+	else if (strcmp(argv[1],"inc")==0) InitField=IF_INC;
+	else if (strcmp(argv[1],"read")==0) {
+		if (Narg!=2 && Narg!=3) NargErrorSub(Narg,"init_field read","1 or 2");
+		ScanFnamesError(Narg-1,FNAME_ARG_1_2,argv+2,&infi_fnameY,&infi_fnameX);
+		InitField=IF_READ;
+		noExtraArgs=false;
+	}
+	else if (strcmp(argv[1],"wkb")==0) {
+#ifdef SPARSE
+		PrintErrorHelp("Initial field 'wkb' is not supported in sparse mode");
+#else
+		InitField=IF_WKB;
+#endif
+	}
+	else if (strcmp(argv[1],"zero")==0) InitField=IF_ZERO;
+	else NotSupported("Initial field prescription",argv[1]);
+	TestExtraNarg(Narg,noExtraArgs,argv[1]);
+}
+PARSE_FUNC(int)
+{
+	double tmp;
+	bool noExtraArgs=true;
+	
+	if (Narg<1 || Narg>3) NargError(Narg,"from 1 to 3");
+	if (strcmp(argv[1],"fcd")==0) IntRelation=G_FCD;
+	else if (strcmp(argv[1],"fcd_st")==0) IntRelation=G_FCD_ST;
+	else if (strcmp(argv[1],"igt")==0) {
+#ifdef NO_FORTRAN
+		PrintErrorHelp("To use IGT compiling of Fortran sources must be enabled (comment line "
+			           "'CFLAGS += -DNO_FORTRAN' in Makefile and recompile");
+#endif
+		IntRelation=G_IGT;
+		if (Narg<1 || Narg>3) NargErrorSub(Narg,"int igt","from 0 to 2");
+		if (Narg>=2) {
+			ScanDoubleError(argv[2],&igt_lim);
+			TestNonNegative(igt_lim,"distance limit for IGT");
+			if (Narg==3) {
+				ScanDoubleError(argv[3],&tmp);
+				TestPositive(tmp,"IGT precision");
+				igt_eps=pow(10,-tmp);
+			}
+		}
+		noExtraArgs=false;
+	}
+	else if (strcmp(argv[1],"igt_so")==0) IntRelation=G_IGT_SO;
+	else if (strcmp(argv[1],"nloc")==0) {
+		IntRelation=G_NLOC;
+		if (Narg!=2) NargErrorSub(Narg,"int nloc","1");
+		ScanDoubleError(argv[2],&nloc_Rp);
+		TestNonNegative(nloc_Rp,"Gaussian width");
+		noExtraArgs=false;
+	}
+	else if (strcmp(argv[1],"nloc_av")==0) {
+		IntRelation=G_NLOC_AV;
+		if (Narg!=2) NargErrorSub(Narg,"int nloc_av","1");
+		ScanDoubleError(argv[2],&nloc_Rp);
+		TestNonNegative(nloc_Rp,"Gaussian width");
+		noExtraArgs=false;
+	}
+	else if (strcmp(argv[1],"poi")==0) IntRelation=G_POINT_DIP;
+	else if (strcmp(argv[1],"so")==0) IntRelation=G_SO;
+	/* TO ADD NEW INTERACTION FORMULATION
+	 * add the line to else-if sequence above in the alphabetical order, analogous to the ones already present. The
+	 * variable parts of the line are its name used in command line and its descriptor, defined in const.h. If
+	 * subarguments are used, test their quantity explicitly, process (scan) subarguments, and set noExtraArgs to false.
+	 * See "igt" for example. You may also need to change the test for Narg in the beginning of this function.
+	 */
+	else NotSupported("Interaction term prescription",argv[1]);
+	TestExtraNarg(Narg,noExtraArgs,argv[1]);
+}
+PARSE_FUNC(int_surf)
+{
+	if (strcmp(argv[1],"img")==0) ReflRelation=GR_IMG;
+	else if (strcmp(argv[1],"som")==0) ReflRelation=GR_SOM;
+	else NotSupported("Interaction term prescription",argv[1]);
+	/* TO ADD NEW REFLECTION FORMULATION
+	 * add the line to else-if sequence above in the alphabetical order, analogous to the ones already present. The
+	 * variable parts of the line are its name used in command line and its descriptor, defined in const.h.
+	 * !!! If subarguments need to be used a test for them should be implemented throughout the function, similar to
+	 * PARSE_FUNC(int) above
+	 */
+}
+PARSE_FUNC(iter)
+{
+	if (strcmp(argv[1],"bcgs2")==0) IterMethod=IT_BCGS2;
+	else if (strcmp(argv[1],"bicg")==0) IterMethod=IT_BICG_CS;
+	else if (strcmp(argv[1],"bicgstab")==0) IterMethod=IT_BICGSTAB;
+	else if (strcmp(argv[1],"cgnr")==0) IterMethod=IT_CGNR;
+	else if (strcmp(argv[1],"csym")==0) IterMethod=IT_CSYM;
+	else if (strcmp(argv[1],"qmr")==0) IterMethod=IT_QMR_CS;
+	else if (strcmp(argv[1],"qmr2")==0) IterMethod=IT_QMR_CS_2;
+	/* TO ADD NEW ITERATIVE SOLVER
+	 * add the line to else-if sequence above in the alphabetical order, analogous to the ones already present. The
+	 * variable parts of the line are its name used in command line and its descriptor, defined in const.h
+	 */
+	else NotSupported("Iterative method",argv[1]);
+}
+PARSE_FUNC(jagged)
+{
+	ScanIntError(argv[1],&jagged);
+	TestRange_i(jagged,"jagged",1,BOX_MAX);
+}
+PARSE_FUNC(lambda)
+{
+	ScanDoubleError(argv[1],&lambda);
+	TestPositive(lambda,"wavelength");
+}
+PARSE_FUNC(m)
+{
+	int i;
+	double mre,mim;
+
+	if (!IS_EVEN(Narg) || Narg==0) NargError(Narg,"even");
+	Nmat=Nmat_given=Narg/2;
+	if (Nmat>MAX_NMAT) PrintErrorHelp("Too many materials (%d), maximum %d are supported. You may increase parameter "
+		"MAX_NMAT in const.h and recompile.",Nmat,MAX_NMAT);
+	for (i=0;i<Nmat;i++) {
+		ScanDoubleError(argv[2*i+1],&mre);
+		ScanDoubleError(argv[2*i+2],&mim);
+		ref_index[i] = mre + I*mim;
+		if (ref_index[i]==1) PrintErrorHelp("Given refractive index #%d is that of vacuum, which is not supported. "
+			"Consider using, for instance, 1.0001 instead.",i+1);
+	}
+}
+PARSE_FUNC(maxiter)
+{
+	ScanIntError(argv[1],&maxiter);
+	TestPositive_i(maxiter,"maximum number of iterations");
+}
+PARSE_FUNC(no_reduced_fft)
+{
+	reduced_FFT=false;
+}
+PARSE_FUNC(no_vol_cor)
+{
+	volcor=false;
+}
+PARSE_FUNC(ntheta)
+{
+	ScanIntError(argv[1],&nTheta);
+	TestPositive_i(nTheta,"number of theta intervals");
+	nTheta++;
+}
+PARSE_FUNC(opt)
+{
+	if (strcmp(argv[1],"speed")==0) save_memory=false;
+	else if (strcmp(argv[1],"mem")==0) save_memory=true;
+	else NotSupported("Optimization method",argv[1]);
+}
+PARSE_FUNC(orient)
+{
+	if (Narg==0) NargError(Narg,"at least 1");
+	if (strcmp(argv[1],"avg")==0) {
+		if (Narg>2) NargErrorSub(Narg,"orient avg","0 or 1");
+		orient_avg=true;
+		if (Narg==2) avg_parms=ScanStrError(argv[2],MAX_FNAME);
+	}
+	else {
+		if (Narg!=3) NargError(Narg,"3 or 'avg ...'");
+		ScanDoubleError(argv[1],&alph_deg);
+		ScanDoubleError(argv[2],&bet_deg);
+		ScanDoubleError(argv[3],&gam_deg);
+	}
+	/* this will catch even trivial cases like '-orient 0 0 0', but we still want to point the user to existent
+	 * incompatibilities. This may help to prevent misunderstanding on the user's side.
+	 */
+	orient_used=true;
+}
+PARSE_FUNC(phi_integr)
+{
+	phi_integr = true;
+	ScanIntError(argv[1],&phi_int_type);
+	TestRange_i(phi_int_type,"type of integration over phi",1,31);
+}
+PARSE_FUNC(pol)
+{
+	bool noExtraArgs=true;
+
+	if (Narg!=1 && Narg!=2) NargError(Narg,"1 or 2");
+	if (strcmp(argv[1],"cldr")==0) PolRelation=POL_CLDR;
+	else if (strcmp(argv[1],"cm")==0) PolRelation=POL_CM;
+	else if (strcmp(argv[1],"dgf")==0) PolRelation=POL_DGF;
+	else if (strcmp(argv[1],"fcd")==0) PolRelation=POL_FCD;
+	else if (strcmp(argv[1],"igt_so")==0) PolRelation=POL_IGT_SO;
+	else if (strcmp(argv[1],"lak")==0) PolRelation=POL_LAK;
+	else if (strcmp(argv[1],"ldr")==0) {
+		PolRelation=POL_LDR;
+		if (Narg!=1 && Narg!=2) NargErrorSub(Narg,"pol ldr","from 0 to 1");
+		if (Narg==2) {
+			if (strcmp(argv[2],"avgpol")==0) avg_inc_pol=true;
+			else PrintErrorHelpSafe("Unknown argument '%s' to '-pol ldr' option",argv[2]);
+		}
+		noExtraArgs=false;
+	}
+	else if (strcmp(argv[1],"nloc")==0) {
+		PolRelation=POL_NLOC;
+		if (Narg!=2) NargErrorSub(Narg,"pol nloc","1");
+		ScanDoubleError(argv[2],&polNlocRp);
+		TestNonNegative(polNlocRp,"Gaussian width");
+		noExtraArgs=false;
+	}
+	else if (strcmp(argv[1],"nloc_av")==0) {
+		PolRelation=POL_NLOC_AV;
+		if (Narg!=2) NargErrorSub(Narg,"pol nloc_av","1");
+		ScanDoubleError(argv[2],&polNlocRp);
+		TestNonNegative(polNlocRp,"Gaussian width");
+		noExtraArgs=false;
+	}
+	else if (strcmp(argv[1],"rrc")==0) PolRelation=POL_RRC;
+	else if (strcmp(argv[1],"so")==0) PolRelation=POL_SO;
+	/* TO ADD NEW POLARIZABILITY FORMULATION
+	 * add the line to else-if sequence above in the alphabetical order, analogous to the ones already present. The
+	 * variable parts of the line are its name used in command line and its descriptor, defined in const.h. If
+	 * subarguments are used, test their quantity explicitly, process (scan) subarguments, and set noExtraArgs to false.
+	 * See "nloc" for example. You may also need to change the test for Narg in the beginning of this function.
+	 */
+	else NotSupported("Polarizability relation",argv[1]);
+	TestExtraNarg(Narg,noExtraArgs,argv[1]);
+}
+PARSE_FUNC(prognosis)
+{
+	prognosis=true;
+	run_name="test";
+}
+PARSE_FUNC(prop)
+{
+	double tmp;
+
+	ScanDoubleError(argv[1],prop_0);
+	ScanDoubleError(argv[2],prop_0+1);
+	ScanDoubleError(argv[3],prop_0+2);
+	tmp=DotProd(prop_0,prop_0);
+	if (tmp==0) PrintErrorHelp("Given propagation vector is null");
+	vMultScal(1/sqrt(tmp),prop_0,prop_0);
+	prop_used=true;
+}
+PARSE_FUNC(recalc_resid)
+{
+	recalc_resid=true;
+}
+PARSE_FUNC(rect_dip)
+{
+	ScanDoubleError(argv[1],&rectScaleX);
+	ScanDoubleError(argv[2],&rectScaleY);
+	ScanDoubleError(argv[3],&rectScaleZ);
+	TestPositive(rectScaleX,"x-scale of rectangular dipole");
+	TestPositive(rectScaleY,"y-scale of rectangular dipole");
+	TestPositive(rectScaleZ,"z-scale of rectangular dipole");
+	rectDip=true;
+	if (rectScaleX!=rectScaleY) symR=false;
+}
+#ifndef SPARSE
+PARSE_FUNC(save_geom)
+{
+	if (Narg>1) NargError(Narg,"0 or 1");
+	save_geom=true;
+	if (Narg==1) save_geom_fname=ScanStrError(argv[1],MAX_FNAME);
+}
+#endif
+PARSE_FUNC(scat)
+{
+	if (strcmp(argv[1],"dr")==0) ScatRelation=SQ_DRAINE;
+	else if (strcmp(argv[1],"fin")==0) ScatRelation=SQ_FINDIP;
+	else if (strcmp(argv[1],"igt_so")==0) ScatRelation=SQ_IGT_SO;
+	else if (strcmp(argv[1],"so")==0) ScatRelation=SQ_SO;
+	else NotSupported("Scattering quantities relation",argv[1]);
+}
+PARSE_FUNC(scat_grid_inp)
+{
+	scat_grid_parms=ScanStrError(argv[1],MAX_FNAME);
+}
+PARSE_FUNC(scat_matr)
+{
+	if (strcmp(argv[1],"muel")==0) {
+		store_mueller=true;
+		store_ampl=false;
+	}
+	else if (strcmp(argv[1],"ampl")==0) {
+		store_mueller=false;
+		store_ampl=true;
+	}
+	else if (strcmp(argv[1],"both")==0) store_mueller=store_ampl=true;
+	else if (strcmp(argv[1],"none")==0) store_mueller=store_ampl=false;
+	else NotSupported("Scattering matrix specifier",argv[1]);
+}
+PARSE_FUNC(scat_plane)
+{
+	scat_plane_used = true;
+	scat_plane = true;
+}
+#ifndef SPARSE
+PARSE_FUNC(sg_format)
+{
+	if (strcmp(argv[1],"text")==0) sg_format=SF_TEXT;
+	else if (strcmp(argv[1],"text_ext")==0) sg_format=SF_TEXT_EXT;
+	else if (strcmp(argv[1],"ddscat6")==0) sg_format=SF_DDSCAT6;
+	else if (strcmp(argv[1],"ddscat7")==0) sg_format=SF_DDSCAT7;
+	/* TO ADD NEW FORMAT OF SHAPE FILE
+	 * Based on argument of command line option '-sg_format' assign value to variable 'sg_format' (one of handles
+	 * defined in const.h).
+	 */
+	else NotSupported("Geometry format",argv[1]);
+}
+#endif
+PARSE_FUNC(shape)
+{
+	int i,j,need;
+	bool found;
+
+	if (Narg==0) PrintErrorHelp("Suboption (argument) is missing for '-shape' option");
+	Narg--;
+	found=false;
+	i=-1;
+	while (shape_opt[++i].name!=NULL) if (strcmp(argv[1],shape_opt[i].name)==0) {
+		// set shape and shape option index
+		shape=(enum sh)shape_opt[i].type;
+		opt.l2=i;
+		opt_sh=opt;
+		sh_Npars=Narg;
+		need=shape_opt[i].narg;
+		// check number of arguments
+		switch (shape) {
+			case SH_COATED: if (Narg!=1 && Narg!=4) NargError(Narg,"1 or 4"); break;
+			case SH_BOX: if (Narg!=0 && Narg!=2) NargError(Narg,"0 or 2"); break;
+			default: TestNarg(Narg,need); break;
+		}
+		/* TO ADD NEW SHAPE
+		 * If the shape accepts variable number of arguments (UNDEF was used in shape definition above) add a check of
+		 * number of received arguments as a new case above. Use NargError function similarly as done in existing tests.
+		 */
+		// either parse filename or parse all parameters as float; consistency is checked later
+		if (!ScanFnamesError(Narg,need,argv+2,&shape_fname,NULL))
+			for (j=0;j<Narg;j++) ScanDoubleError(argv[j+2],sh_pars+j);
+		// stop search
+		found=true;
+		break;
+	}
+	if (!found) NotSupported("Shape type",argv[1]);
+	// set shape name; takes place only if shape name was matched above
+	shapename=argv[1];
+}
+PARSE_FUNC(size)
+{
+	ScanDoubleError(argv[1],&sizeX);
+	TestPositive(sizeX,"particle size");
+}
+PARSE_FUNC(store_beam)
+{
+	store_beam = true;
+}
+PARSE_FUNC(store_dip_pol)
+{
+	store_dip_pol=true;
+}
+PARSE_FUNC(store_force)
+{
+	store_force = true;
+	calc_mat_force = true;
+}
+#ifndef SPARSE
+PARSE_FUNC(store_grans)
+{
+	store_grans=true;
+}
+#endif
+PARSE_FUNC(store_int_field)
+{
+	store_int_field=true;
+}
+PARSE_FUNC(store_scat_grid)
+{
+	store_scat_grid = true;
+}
+PARSE_FUNC(surf)
+{
+	double mre,mim;
+	if (Narg!=2 && Narg!=3) NargError(Narg,"2 or 3");
+	ScanDoubleError(argv[1],&hsub);
+	TestPositive(hsub,"height above surface");
+	if (strcmp(argv[2],"inf")==0) {
+		if (Narg>2) PrintErrorHelp("Additional arguments are not allowed for '-surf ... inf'");
+		msubInf=true;
+	}
+	else {
+		if (Narg!=3) NargError(Narg,"total 3 or second argument 'inf'");
+		ScanDoubleError(argv[2],&mre);
+		ScanDoubleError(argv[3],&mim);
+		msub = mre + I*mim;
+	}
+	surface = true;
+	symZ=false;
+}
+PARSE_FUNC(sym)
+{
+	if (strcmp(argv[1],"auto")==0) sym_type=SYM_AUTO;
+	else if (strcmp(argv[1],"no")==0) sym_type=SYM_NO;
+	else if (strcmp(argv[1],"enf")==0) sym_type=SYM_ENF;
+	else NotSupported("Symmetry option",argv[1]);
+}
+PARSE_FUNC(test)
+{
+	run_name="test";
+}
+PARSE_FUNC(V)
+{
+	char copyright[]="\n\nCopyright (C) 2006-2018 ADDA contributors\n"
+		"This program is free software; you can redistribute it and/or modify it under the terms of the GNU General "
+		"Public License as published by the Free Software Foundation; either version 3 of the License, or (at your "
+		"option) any later version.\n\n"
+		"This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the "
+		"implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License "
+		"for more details.\n\n"
+		"You should have received a copy of the GNU General Public License along with this program. If not, see "
+		"<http://www.gnu.org/licenses/>.\n";
+	char ccver_str[MAX_LINE];
+#if defined(__DECC)
+	char cctype;
+#elif defined(__BORLANDC__)
+	int ccver;
+#endif
+	size_t num;
+	int bits,len;
+
+	if (IFROOT) {
+		// compiler & version (works only for selected compilers)
+		// Intel
+#if defined(__ICC) || defined(__INTEL_COMPILER)
+#	define COMPILER "Intel"
+#	ifdef __INTEL_COMPILER
+#		define CCVERSION __INTEL_COMPILER
+#	else
+#		define CCVERSION __ICC
+#	endif
+		sprintf(ccver_str,"%d.%d",CCVERSION/100,CCVERSION%100);
+		// DEC (Compaq)
+#elif defined(__DECC)
+#	define COMPILER "DEC (Compaq)"
+		cctype=(__DECC_VER/10000)%10;
+		if (cctype==6) cctype='T';
+		else if (cctype==8) cctype='S';
+		else if (cctype==9) cctype='V';
+		else cctype=' ';
+		sprintf(ccver_str,"%c%d.%d-%d",cctype,__DECC_VER/10000000,(__DECC_VER/100000)%100,__DECC_VER%1000);
+		// Borland
+#elif defined(__BORLANDC__)
+#	define COMPILER "Borland"
+		sprintf(ccver_str,"%x",__BORLANDC__);
+		sscanf(ccver_str,"%d",&ccver);
+		sprintf(ccver_str,"%d.%d",ccver/100,ccver%100);
+		// Microsoft
+#elif defined(_MSC_VER)
+#	define COMPILER "Microsoft"
+		sprintf(ccver_str,"%d.%d",_MSC_VER/100,_MSC_VER%100);
+		// GNU
+#elif defined(__GNUC__)
+#	define COMPILER "GNU"
+		sprintf(ccver_str,"%d.%d.%d",__GNUC__,__GNUC_MINOR__,__GNUC_PATCHLEVEL__);
+		// IBM
+#elif defined(__xlc__)
+#	define COMPILER "IBM"
+		strncpy(ccver_str,__xlc__,MAX_LINE-1);
+		// unknown compiler
+#else
+#	define COMPILER_UNKNOWN
+#	define COMPILER "unknown"
+#endif
+		// print version, MPI standard, type and compiler information, bit-mode
+#ifdef GITHASH // git hash is printed if available, but only here
+		printf("ADDA v."ADDA_VERSION" ("GITHASH")\n");
+#else
+		printf("ADDA v."ADDA_VERSION"\n");
+#endif
+#ifdef OPENCL
+#	if defined(CL_VERSION_1_2)
+#		define OCL_VERSION "1.2"
+#	elif defined(CL_VERSION_1_1)
+#		define OCL_VERSION "1.1"
+#	elif defined(CL_VERSION_1_0)
+#		define OCL_VERSION "1.0"
+#	else // this should never happen, since minimum OpenCL version is checked in oclcore.h
+#		error "OpenCL version not recognized"
+#	endif
+		printf("GPU-accelerated version conforming to OpenCL standard "OCL_VERSION"\n");
+#	ifdef CLFFT_AMD
+		printf("Linked to clFFT version %d.%d.%d\n",clfftVersionMajor,clfftVersionMinor,clfftVersionPatch);
+#	endif
+#	ifdef OCL_BLAS
+		printf("Linked to clBLAS version %d.%d.%d\n",clblasVersionMajor,clblasVersionMinor,
+			clblasVersionPatch);
+#	endif
+#elif defined(ADDA_MPI)
+		// Version of MPI standard is specified
+		printf("Parallel version conforming to MPI standard %d.%d\n",RUN_MPI_VER_REQ,RUN_MPI_SUBVER_REQ);
+#	ifdef MPICH2
+		printf("Linked to MPICH2 version "MPICH2_VERSION"\n");
+#	elif defined(OPEN_MPI)
+		printf("Linked to OpenMPI version %d.%d.%d\n",OMPI_MAJOR_VERSION,OMPI_MINOR_VERSION,OMPI_RELEASE_VERSION);
+#	endif
+		// Additional debug information about MPI implementation
+#	ifndef SUPPORT_MPI_BOOL
+		D("No full support for MPI_C_BOOL (emulated)");
+#	endif
+#	ifndef SUPPORT_MPI_COMPLEX
+		D("No support for complex MPI datatypes (emulated)");
+#	else
+#		ifndef SUPPORT_MPI_COMPLEX
+		D("Complex MPI datatypes are supported, but their use in reduce operations is not supported (emulated)");
+#		endif
+#	endif
+#else
+		printf("Sequential version\n");
+#endif
+		printf("Built with "COMPILER" compilers");
+#ifndef COMPILER_UNKNOWN
+		printf(" version %s",ccver_str);
+#endif
+		// determine number of bits in size_t; not the most efficient way, but should work robustly
+		num=SIZE_MAX;
+		bits=1;
+		while(num>>=1) bits++;
+		printf(" (%d-bit)\n",bits);
+#ifdef __MINGW64_VERSION_STR
+		printf("      using MinGW-64 environment version "__MINGW64_VERSION_STR"\n");
+#elif defined(__MINGW32_VERSION)
+		printf("      using MinGW-32 environment version %g\n",__MINGW32_VERSION);
+#endif
+		// extra build flags - can it be shortened by some clever defines?
+		const char build_opts[]=
+#ifdef DEBUGFULL
+		"DEBUGFULL, "
+#elif defined(DEBUG)
+		"DEBUG, "
+#endif
+#ifdef FFT_TEMPERTON
+		"FFT_TEMPERTON, "
+#endif
+#ifdef PRECISE_TIMING
+		"PRECISE_TIMING, "
+#endif
+#ifdef NOT_USE_LOCK
+		"NOT_USE_LOCK, "
+#elif defined(ONLY_LOCKFILE)
+		"ONLY_LOCKFILE, "
+#endif
+#ifdef NO_FORTRAN
+		"NO_FORTRAN, "
+#endif
+#ifdef NO_CPP
+		"NO_CPP, "
+#endif
+#ifdef OVERRIDE_STDC_TEST
+		"OVERRIDE_STDC_TEST, "
+#endif
+#ifdef OCL_READ_SOURCE_RUNTIME
+		"OCL_READ_SOURCE_RUNTIME, "
+#endif
+#ifdef CLFFT_APPLE
+		"CLFFT_APPLE, "
+#endif
+#ifdef SPARSE
+		"SPARSE, "
+#endif
+#ifdef USE_SSE3
+		"USE_SSE3, "
+#endif
+#ifdef OCL_BLAS
+		"OCL_BLAS, "
+#endif
+#ifdef NO_GITHASH
+		"NO_GITHASH, "
+#endif
+		"";
+		printf("Extra build options: ");
+		len=strlen(build_opts);
+		if (len==0) printf("none");
+		else printf("%.*s",len-2,build_opts); // trailing comma and space are omitted
+		// print copyright information
+		WrapLines(copyright);
+		printf("%s",copyright);
+	}
+	// exit
+	Stop(EXIT_SUCCESS);
+#undef COMPILER
+#undef CCVERSION
+#undef COMPILER_UNKNOWN
+#undef BUILD_OPTS_SIZE
+}
+PARSE_FUNC(vec)
+{
+	calc_vec = true;
+}
+PARSE_FUNC(yz)
+{
+	yz_used = true;
+	yzplane = true;
+}
+/* TO ADD NEW COMMAND LINE OPTION
+ * add a function definition to this list. It should start with 'PARSE_FUNC(option_name)', and contain all necessary
+ * logic (code) to implement (or register) command line option. Typically, it should check number of parameters (if
+ * UNDEF was used instead of number of parameters in the option definition), scanf input parameters (if any) and check
+ * them for consistency and set the values of some internal variables or flags. These variables should be defined in
+ * the beginning of this file and initialized in InitVariables() below. It is recommended to use functions from param.h
+ * and those defined above since they are designed to be overflow-safe for any input parameters and would automatically
+ * produce informative output in case of error. If a new command line option contains suboptions, you may easily parse
+ * them using the suboption structure (which should be defined in the beginning of this file). See PARSE_FUNC(beam) and
+ * PARSE_FUNC(shape) above for examples. Potential conflicts or interactions between different command line options
+ * should be processed in VariablesInterconnect() below. If any output in log files or stdout should be produced based
+ * on the values of command line option, this should be implemented in PrintInfo() below.
+ */
+#undef PAR
+#undef PARSE_FUNC
+#undef PARSE_NAME
+
+// end of parsing functions
+//=============================================================
+
+static FILEHANDLE CreateLockFile(const char * restrict fname ONLY_FOR_LOCK)
+// create lock file; works only if USE_LOCK is enabled
+{
+#ifdef USE_LOCK
+	FILEHANDLE fd;
+	int i;
+
+#	ifdef WINDOWS
+	i=0;
+	while ((fd=CreateFile(fname,GENERIC_WRITE,FILE_SHARE_WRITE,NULL,CREATE_NEW,FILE_ATTRIBUTE_NORMAL,NULL))
+		    ==INVALID_HANDLE_VALUE) {
+		Sleep(LOCK_WAIT*1000);
+		if (i++ == MAX_LOCK_WAIT_CYCLES) LogError(ONE_POS,"Lock file %s permanently exists",fname);
+	}
+#	elif defined(POSIX)
+#		ifdef LOCK_FOR_NFS
+	struct flock lock;
+#		endif
+	// open file exclusively
+	i=0;
+	while ((fd=open(fname,O_WRONLY | O_CREAT | O_EXCL,0666))==-1) {
+		sleep(LOCK_WAIT);
+		if (i++ == MAX_LOCK_WAIT_CYCLES) LogError(ONE_POS,"Lock file %s permanently exists",fname);
+	}
+#		ifdef LOCK_FOR_NFS
+	// specify lock
+	lock.l_type=F_WRLCK;
+	lock.l_whence=SEEK_SET;
+	lock.l_start=0;
+	lock.l_len=0;
+	// obtain lock*/
+	i=0;
+	while (fcntl(fd,F_SETLK,&lock)==-1) {
+		// if locked by another process wait and try again
+		if (errno==EACCES || errno==EAGAIN) {
+			sleep(LOCK_WAIT);
+			if (i++ == MAX_LOCK_WAIT_CYCLES) LogError(ONE_POS,"Lock file %s permanently exists",fname);
+		}
+		else { // otherwise produce a message and continue
+			if (errno==EOPNOTSUPP || errno==ENOLCK || errno==ENOSYS)
+				LogWarning(EC_WARN,ONE_POS,"Advanced file locking is not supported by the file system");
+			else LogWarning(EC_WARN,ONE_POS,"Unknown problem with file locking ('%s').",strerror(errno));
+			break;
+		}
+	}
+#		endif
+#	endif
+	// return file handle
+	return fd;
+#else
+	return 0;
+#endif
+}
+
+//======================================================================================================================
+
+static void RemoveLockFile(FILEHANDLE fd ONLY_FOR_LOCK,const char * restrict fname ONLY_FOR_LOCK)
+// closes and remove lock file; works only if USE_LOCK is enabled
+{
+#ifdef USE_LOCK
+#	ifdef WINDOWS
+	// close file
+	CloseHandle(fd);
+#	elif defined(POSIX)
+	// close file; all locks are automatically released
+	close(fd);
+#	endif
+	// remove lock file
+	RemoveErr(fname,ONE_POS);
+#endif
+}
+
+//======================================================================================================================
+
+static void UpdateSymVec(const double a[static 3])
+// tests whether vector a satisfies a number of symmetries (with round-off errors) and cancels the failing symmetries
+{
+	if (fabs(a[0])>ROUND_ERR) symX=false;
+	if (fabs(a[1])>ROUND_ERR) symY=false;
+	if (fabs(a[2])>ROUND_ERR) symZ=false;
+	if (!vAlongZ(a)) symR=false;
+}
+
+//======================================================================================================================
+
+void InitVariables(void)
+// some defaults are specified also in const.h
+{
+	rectDip=false;
+	prop_used=false;
+	orient_used=false;
+	directory="";
+	lambda=TWO_PI;
+	// initialize ref_index of scatterer
+	Nmat=Nmat_given=1;
+	ref_index[0]=1.5;
+	// initialize to null to determine further whether it is initialized
+	logfile=NULL;
+	boxX=boxY=boxZ=UNDEF;
+	sizeX=UNDEF;
+	a_eq=UNDEF;
+	dpl=UNDEF;
+	run_name="run";
+	nTheta=UNDEF;
+	iter_eps=1E-5;
+	shape=SH_SPHERE;
+	shapename="sphere";
+	store_int_field=false;
+	store_dip_pol=false;
+	PolRelation=UNDEF;
+	avg_inc_pol=false;
+	ScatRelation=SQ_DRAINE;
+	IntRelation=G_POINT_DIP;
+	IterMethod=IT_QMR_CS;
+	sym_type=SYM_AUTO;
+	prognosis=false;
+	maxiter=UNDEF;
+	jagged=1;
+	beamtype=B_PLANE;
+	alldir_parms=FD_ALLDIR_PARMS;
+	avg_parms=FD_AVG_PARMS;
+	scat_grid_parms=FD_SCAT_PARMS;
+	chp_dir=FD_CHP_DIR;
+	chp_time=UNDEF;
+	chp_type=CHP_NONE;
+	orient_avg=false;
+	alph_deg=bet_deg=gam_deg=0.0;
+	volcor=true;
+	reduced_FFT=true;
+	save_geom=false;
+	save_geom_fname="";
+	yzplane=false;
+	yz_used=false;
+	scat_plane=false;
+	scat_plane_used=false;
+	all_dir=false;
+	scat_grid=false;
+	phi_integr=false;
+	store_scat_grid=false;
+	calc_Cext=true;
+	calc_Cabs=true;
+	calc_Csca=false;
+	calc_vec=false;
+	calc_asym=false;
+	calc_mat_force=false;
+	store_force=false;
+	store_mueller=true;
+	store_ampl=false;
+	store_grans=false;
+	load_chpoint=false;
+	sh_granul=false;
+	symX=symY=symZ=symR=true;
+	anisotropy=false;
+	save_memory=false;
+	sg_format=SF_TEXT;
+	memory=0;
+	memPeak=0;
+	Ncomp=1;
+	igt_lim=UNDEF;
+	igt_eps=UNDEF;
+	InitField=IF_AUTO;
+	recalc_resid=false;
+	surface=false;
+	msubInf=false;
+	ReflRelation=UNDEF;
+	// sometimes the following two are left uninitialized
+	beam_fnameX=NULL;
+	infi_fnameX=NULL;
+	rectScaleX=1.0;
+	rectScaleY=1.0;
+	rectScaleZ=1.0;
+	maxRectScale=1;
+
+#ifdef OPENCL
+	gpuInd=0;
+#endif
+	/* TO ADD NEW COMMAND LINE OPTION
+	 * If you use some new variables, flags, etc. you should specify their default values here. This value will be used
+	 * if new option is not specified in the command line.
+	 */
+}
+
+//======================================================================================================================
+
+void ParseParameters(const int argc,char **argv)
+// parses input parameters
+{
+	int i,j,Narg,tmp;
+	bool found;
+	char *p1,*p2;
+
+	// try to determine terminal width
+	if ((p1=getenv("COLUMNS"))!=NULL && sscanf(p1,"%d",&tmp)==1 && tmp>=MIN_TERM_WIDTH) term_width=tmp;
+	// get name of executable; remove all path overhead
+	if ((p1=strrchr(argv[0],'\\'))==NULL) p1=argv[0];
+	if ((p2=strrchr(argv[0],'/'))==NULL) p2=argv[0];
+	exename=MAX(p1,p2)+1;
+	// initialize option
+	opt.l1=UNDEF;
+	// check first argument
+	if (argc>1 && !IsOption(argv[1])) PrintErrorHelpSafe("Illegal format of first argument '%s'",argv[1]);
+	// read command line
+	for (i=1;i<argc;i++) {
+		// get number of arguments
+		Narg=0;
+		while ((i+(++Narg))<argc && !IsOption(argv[i+Narg]));
+		Narg--;
+
+		argv[i]++; // shift to remove "-" in the beginning of the string
+		found=false;
+		opt.l1=opt.l2=UNDEF;
+		for (j=0;j<LENGTH(options);j++) if (strcmp(argv[i],options[j].name)==0) {
+			opt.l1=j;
+			// check consistency, if enabled for this parameter
+			TestNarg(Narg,options[j].narg);
+			// parse this parameter
+			(*options[j].func)(Narg,argv+i);
+			// check duplicate options; it is safe since at this point argv[i] is known to be normal
+			if (options[j].used) PrintError("Option '-%s' is used more than once",argv[i]);
+			else options[j].used=true;
+			// stop search
+			found=true;
+			break;
+		}
+		if(!found) PrintErrorHelpSafe("Unknown option '-%s'",argv[i]);
+		argv[i]--; // shift back
+		i+=Narg;
+	}
+}
+
+//======================================================================================================================
+
+void VariablesInterconnect(void)
+// finish parameters initialization based on their interconnections
+{
+	double temp;
+
+	// initialize WaveNum ASAP
+	WaveNum = TWO_PI/lambda;
+	// set default incident direction, which is +z for all configurations
+	if (!prop_used) {
+		prop_0[0]=prop_0[1]=0;
+		prop_0[2]=1;
+	}
+	// parameter interconnections
+	if (IntRelation==G_SO) {
+		reduced_FFT=false;
+		// this limitation is due to assumption of reciprocity in DecayCross()
+		if (beamtype==B_DIPOLE) PrintError("'-beam dipole' and '-int so' can not be used together");
+	}
+	/* TO ADD NEW INTERACTION FORMULATION
+	 * If the new Green's tensor is non-symmetric (which is very unlikely) add it to the definition of reduced_FFT
+	 */
+	if (calc_Csca || calc_vec) all_dir = true;
+	// by default, one of the scattering options is activated
+	if (store_scat_grid || phi_integr) scat_grid = true;
+	else if (!scat_plane_used && !yz_used) { // default values when no scattering plane is explicitly specified
+		if (surface) scat_plane = true;
+		else yzplane = true;
+	}
+	// if not initialized before, IGT precision is set to that of the iterative solver
+	if (igt_eps==UNDEF) igt_eps=iter_eps;
+	// defautl polarizability formulation depends on rect_dip
+	if (PolRelation==UNDEF) PolRelation = rectDip ? POL_CLDR : POL_LDR;
+	// parameter incompatibilities
+	if (scat_plane && yzplane) PrintError("Currently '-scat_plane' and '-yz' cannot be used together.");
+	if (orient_avg) {
+		if (prop_used) PrintError("'-prop' and '-orient avg' can not be used together");
+		if (store_int_field) PrintError("'-store_int_field' and '-orient avg' can not be used together");
+		if (store_dip_pol) PrintError("'-store_dip_pol' and '-orient avg' can not be used together");
+		if (store_beam) PrintError("'-store_beam' and '-orient avg' can not be used together");
+		if (beamtype==B_READ) PrintError("'-beam read' and '-orient avg' can not be used together");
+		if (scat_grid) PrintError("'-orient avg' can not be used with calculation of scattering for a grid of angles");
+		// TODO: this limitation should be removed in the future
+		if (all_dir) PrintError("Currently '-orient avg' can not be used with calculation of asym or Csca");
+		if (calc_mat_force) PrintError("Currently '-orient avg' can not be used with calculation of Cpr");
+		if (store_force) PrintError("'-store_force' and '-orient avg' can not be used together");
+		if (!store_mueller && store_ampl) {
+			store_ampl=false;
+			LogWarning(EC_WARN,ONE_POS,"Amplitude matrix can not be averaged over orientations. So switching off "
+				"calculation of Mueller matrix results in no calculation of scattering matrices at all.");
+		}
+		if (scat_plane && yzplane) PrintError("Only one scattering plane can be used during orientation averaging, so "
+			"a combination of '-scat_plane' and '-yz' cannot be used together with '-orient avg'.");
+	}
+	if (phi_integr && !store_mueller) PrintError("Integration over phi can only be performed for Mueller matrix. "
+		"Hence, '-phi_integr' is incompatible with '-scat_matr {ampl|none}'");
+	if (!store_mueller && !store_ampl) {
+		if (nTheta!=UNDEF) PrintError("'-scat_matr none' turns off calculation of angle-resolved quantities making "
+			"'-ntheta' irrelevant. Hence, these two options are incompatible.");
+		if (store_scat_grid) PrintError("'-scat_matr none' turns off calculation of angle-resolved quantities. Hence, "
+			"it is incompatible with '-store_scat_grid'.");
+		if (yz_used) PrintError("'-scat_matr none' turns off calculation of angle-resolved quantities. Hence, it is "
+			"incompatible with '-yz'.");
+		if (scat_plane_used) PrintError("'-scat_matr none' turns off calculation of angle-resolved quantities. Hence, "
+			"it is incompatible with '-scat_plane'.");
+		nTheta=0;
+		yzplane=false;
+		scat_plane=false;
+		scat_grid=false;
+	}
+	if (rectDip) {
+		maxRectScale=MAX(rectScaleX,rectScaleY);
+		MAXIMIZE(maxRectScale,rectScaleZ);
+		if (PolRelation!=POL_CLDR && PolRelation!=POL_CM && PolRelation!=POL_IGT_SO)
+			PrintError("The specified polarizability formulation is designed only for cubical dipoles. Currently, only "
+			"the following formulations can be used with rectangular dipoles: cm, cldr, and igt_so");
+		else if (PolRelation!=POL_IGT_SO && IntRelation==G_IGT) LogWarning(EC_WARN,ONE_POS,"Using IGT interaction with "
+			"point-dipole polarizability formulations will produce wrong results for rectangular dipoles. In most "
+			"cases you should use '-rect_dip ... -int igt ... -pol igt_so'");
+		if (anisotropy) PrintError("Currently '-anisotr' and '-rect_dip' can not be used together");
+		if (sh_granul) PrintError("Currently '-granul' and '-rect_dip' can not be used together");
+		if (IntRelation!=G_POINT_DIP && IntRelation!=G_IGT) PrintError("The specified interaction formulation is "
+			"designed only for cubical dipoles. Currently, only 'poi' and 'igt' can be used with rectangular dipoles");
+	}	
+	if (anisotropy) {
+		if (PolRelation==POL_CLDR) PrintError("'-anisotr' is incompatible with '-pol cldr'");
+		if (PolRelation==POL_SO) PrintError("'-anisotr' is incompatible with '-pol so'");
+		if (ScatRelation==SQ_SO) PrintError("'-anisotr' is incompatible with '-scat so'");
+		if (IntRelation==G_SO) PrintError("'-anisotr' is incompatible with '-int so'");
+		/* TO ADD NEW POLARIZABILITY FORMULATION
+		 * If the new polarizability formulation is incompatible with anisotropic material, add an exception here
+		 */
+		if (Nmat%3!=0)
+			PrintError("When '-anisotr' is used 6 numbers (3 complex values) should be given per each domain");
+		else Nmat=Nmat/3;
+	}
+	if (chp_type!=CHP_NONE) {
+		if (chp_time==UNDEF && chp_type!=CHP_ALWAYS) PrintError("You must specify time for this checkpoint type");
+		// TODO: this limitation should be removed in the future
+		if (orient_avg) PrintError("Currently checkpoint is incompatible with '-orient avg'");
+	}
+	if (sizeX!=UNDEF && a_eq!=UNDEF) PrintError("'-size' and '-eq_rad' can not be used together");
+	if (calc_mat_force && beamtype!=B_PLANE)
+		PrintError("Currently radiation forces can not be calculated for non-plane incident wave");
+	if (InitField==IF_WKB) {
+		if (prop_used) PrintError("Currently '-init_field wkb' and '-prop' can not be used together");
+		if (beamtype!=B_PLANE) PrintError("'-init_field wkb' is incompatible with non-plane incident wave");
+	}
+	if (surface) { // currently a lot of limitations for particles near surface
+		if (orient_used) PrintError("Currently '-orient' and '-surf' can not be used together");
+		if (calc_mat_force) PrintError("Currently calculation of radiation forces is incompatible with '-surf'");
+		if (InitField==IF_WKB) PrintError("'-init_field wkb' and '-surf' can not be used together");
+		if (ReflRelation==UNDEF) ReflRelation = msubInf ? GR_IMG : GR_SOM;
+		else if (msubInf && ReflRelation!=GR_IMG) PrintError("For perfectly reflecting surface interaction is always "
+			"computed through an image dipole. So this case is incompatible with other options to '-int_surf ...'");
+		/* TO ADD NEW REFLECTION FORMULATION
+		 * Take a look at the above logic, and revise if the new formulation is not fully consistent with it
+		 */
+		 if (rectDip && ReflRelation==GR_SOM && rectScaleX!=rectScaleY) PrintError("Currently calculation of "
+			"Sommerfeld integrals (default for the surface mode) requires dipoles to have the same dimensions along "
+			"the x- and y-axes (but not z)");
+	}
+	InteractionRealArgs=(beamtype==B_DIPOLE); // other cases may be added here in the future (e.g. nearfields)
+#ifdef SPARSE
+	if (shape==SH_SPHERE) PrintError("Sparse mode requires shape to be read from file (-shape read ...)");
+#endif
+#if defined(PARALLEL) && !defined(SPARSE)
+	/* Transpose of the non-symmetric interaction matrix can't be done in MPI mode, due to existing memory distribution
+	 * among different processors. This causes problems for iterative solvers, which require a product of Hermitian
+	 * transpose (calculated through the standard transpose) of the matrix with vector (currently, only CGNR). To remove
+	 * this limitation (issue 174) memory distribution should be changed to have both x and gridX-x on the same
+	 * processor.
+	 */
+	if (!reduced_FFT && IterMethod==IT_CGNR) PrintError("Non-symmetric interaction matrix (e.g., -no_reduced_fft) "
+		"can not be used together with CGNR iterative solver in the MPI mode");
+	/* TO ADD NEW ITERATIVE SOLVER
+	 * add the new iterative solver to the above line, if it requires calculation of product of Hermitian transpose
+	 * of the matrix with vector (i.e. calls MatVec function with 'true' as the fourth argument)
+	 */
+#endif
+	// scale boxes by jagged; should be completely robust to overflows
+#define JAGGED_BOX(a) { \
+	if (a!=UNDEF) { \
+		if ((BOX_MAX/(size_t)jagged)<(size_t)a) \
+			LogError(ONE_POS,"Derived grid size (" #a ") is too large (>%d)",BOX_MAX); \
+		else a*=jagged; \
+	} }
+
+	if (jagged!=1) {
+		JAGGED_BOX(boxX);
+		JAGGED_BOX(boxY);
+		JAGGED_BOX(boxZ);
+	}
+#undef JAGGED_BOX
+	/* Determine two incident polarizations. Equivalent to rotation of X,Y,Z basis by angles theta and phi from (0,0,1)
+	 * to given propagation vector.
+	 */
+	if (vAlongZ(prop_0)) {
+		propAlongZ=incPolX_0[0]=copysign(1.0,prop_0[2]);
+		incPolY_0[1]=1;
+		incPolX_0[1]=incPolX_0[2]=incPolY_0[0]=incPolY_0[2]=0.0;
+	}
+	else {
+		propAlongZ=0;
+		if (sym_type==SYM_ENF && scat_plane) PrintError("Enforcing symmetry for incident propagation not along the "
+			"z-axis in combination with defining scattering directions relative to z-axis is not supported");
+		temp=sqrt(1-prop_0[2]*prop_0[2]);
+		incPolX_0[0]=prop_0[0]*prop_0[2]/temp;
+		incPolX_0[1]=prop_0[1]*prop_0[2]/temp;
+		incPolX_0[2]=-temp;
+		incPolY_0[0]=-prop_0[1]/temp;
+		incPolY_0[1]=prop_0[0]/temp;
+		incPolY_0[2]=0.0;
+	}
+	// initialize beam description
+	InitBeam();
+	// initialize averaging over orientation
+	if (orient_avg) {
+		ReadAvgParms(avg_parms);
+		symX=symY=symZ=symR=false;
+		avg_inc_pol=true;
+	}
+	else { // initialize rotation stuff and test symmetries of the beam in particle reference frame
+		InitRotation();
+		UpdateSymVec(prop);
+		if (beam_asym) UpdateSymVec(beam_center);
+	}
+	ipr_required=(IterMethod==IT_BICGSTAB || IterMethod==IT_CGNR);
+	/* TO ADD NEW ITERATIVE SOLVER
+	 * add the new iterative solver to the above line, if it requires inner product calculation during matrix-vector
+	 * multiplication (i.e. calls MatVec function with non-NULL third argument)
+	 */
+
+	/* TO ADD NEW COMMAND LINE OPTION
+	 * If a new command line option may potentially conflict or interact with other options, add here code to implement
+	 * corresponding tests or cross-dependence.
+	 */
+}
+
+//======================================================================================================================
+
+void FinalizeSymmetry(void) {
+	// finalize symmetries
+	if (sym_type==SYM_NO) symX=symY=symZ=symR=false;
+	else if (sym_type==SYM_ENF) symX=symY=symZ=symR=true;
+	// test based on SR^2 = SX*SY; uses handmade XOR
+	if (symR && ((symX&&!symY) || (symY&&!symX))) LogError(ONE_POS,"Inconsistency in internally defined symmetries");
+	// additional tests in case of two polarization runs
+	if (!(symR && !scat_grid)) {
+		if (beamtype==B_READ && beam_fnameX==NULL)
+			PrintError("Only one beam file is specified, while two incident polarizations need to be considered");
+		if (InitField==IF_READ && infi_fnameX==NULL) PrintError("Only one file with initial field is specified, while "
+			"two incident polarizations need to be considered");
+		// the following limitation should be removed in the future
+		if (chp_type!=CHP_NONE) PrintError("Currently checkpoints can be used when internal fields are calculated only "
+			"once, i.e. for a single incident polarization");
+	}
+}
+
+//======================================================================================================================
+
+void DirectoryLog(const int argc,char **argv)
+// create input directory and start logfile
+{
+	int i,Nexp;
+	FILE * restrict Nexpfile;
+	char *compname;
+	FILEHANDLE lockid;
+#ifdef PARALLEL
+	char *ptmp,*ptmp2;
+#endif
+
+	// devise directory name (for output files)
+	if (directory[0]==0) {
+		// root processor works with ExpCount
+		if (IFROOT) {
+			// lock file
+			lockid=CreateLockFile(F_EXPCOUNT_LCK);
+			// read ExpCount
+			if ((Nexpfile=fopen(F_EXPCOUNT,"r"))!=NULL) {
+				if (fscanf(Nexpfile,"%i",&Nexp)!=1) Nexp=0;
+				FCloseErr(Nexpfile,F_EXPCOUNT,ONE_POS);
+			}
+			else Nexp=0;
+			// put new number in Nexpfile
+			Nexpfile=FOpenErr(F_EXPCOUNT,"w",ONE_POS);
+			fprintf(Nexpfile,"%i",Nexp+1);
+			FCloseErr(Nexpfile,F_EXPCOUNT,ONE_POS);
+			// unlock
+			RemoveLockFile(lockid,F_EXPCOUNT_LCK);
+		}
+		// cast Nexp to all processors
+		MyBcast(&Nexp,int_type,1,NULL);
+		/* create automatic directory name; It is stored in the following buffer. MAX_LINE should be enough for
+		 * auto-name, however up to MAX_DIRNAME can be obtained from '-dir ...'. So the latter size is considered in all
+		 * relevant buffers (for filenames or messages).
+		 */
+		static char sbuffer[MAX_LINE];
+		sprintf(sbuffer,"%s%03i_%s_g%i_m"GFORM_RI_DIRNAME,run_name,Nexp,shapename,boxX,creal(ref_index[0]));
+#ifdef PARALLEL
+		// add PBS, SGE or SLURM job id to the directory name if available
+		if ((ptmp=getenv("PBS_JOBID"))!=NULL || (ptmp=getenv("JOB_ID"))!=NULL || (ptmp=getenv("SLURM_JOBID"))!=NULL) {
+			// job ID is truncated at first ".", probably can happen only for PBS
+			if ((ptmp2=strchr(ptmp,'.'))!=NULL) *ptmp2=0;
+			sprintf(sbuffer+strlen(sbuffer),"_id%s",ptmp);
+		}
+#endif
+		directory=sbuffer;
+	}
+	// make new directory and print info
+	if (IFROOT) {
+		MkDirErr(directory,ONE_POS);
+		printf("all data is saved in '%s'\n",directory);
+	}
+	// make logname; do it for all processors to enable additional logging in LogError
+	if (IFROOT) SnprintfErr(ONE_POS,logfname,MAX_FNAME,"%s/"F_LOG,directory);
+	else SnprintfErr(ALL_POS,logfname,MAX_FNAME,"%s/"F_LOG_ERR,directory,ringid);
+	// start logfile
+	if (IFROOT) {
+		// open logfile
+		logfile=FOpenErr(logfname,"w",ONE_POS);
+		// log version number
+		fprintf(logfile,"Generated by ADDA v."ADDA_VERSION"\n");
+		// get computer name
+#ifdef WINDOWS
+		TCHAR cname[MAX_COMPUTERNAME_LENGTH+1];
+		DWORD cname_size=MAX_COMPUTERNAME_LENGTH+1;
+		GetComputerName(cname,&cname_size);
+		compname=cname;
+#else // POSIX and others
+		compname=getenv("HOST");
+#endif
+		// write number of processors and computer name
+#ifdef PARALLEL
+		// write number of processors
+		fprintf(logfile,"The program was run on: %d processors (cores)",nprocs);
+		// add PBS or SGE host name if present, otherwise use compname
+		if ((ptmp=getenv("PBS_O_HOST"))!=NULL || (ptmp=getenv("SGE_O_HOST"))!=NULL) fprintf(logfile," from %s\n",ptmp);
+		else if (compname!=NULL) fprintf(logfile," from %s\n",compname);
+		else fprintf(logfile,"\n");
+#else // sequential
+		if (compname!=NULL) fprintf(logfile,"The program was run on: %s\n",compname);
+#endif
+		// log command line
+		fprintf(logfile,"command: '");
+		for(i=0;i<argc;i++) fprintf(logfile,"%s ",argv[i]);
+		fprintf(logfile,"'\n");
+	}
+	Synchronize(); // needed to wait for creation of the output directory
+	LogPending();
+}
+
+//======================================================================================================================
+
+void PrintInfo(void)
+// print info to stdout and logfile
+{
+	int i;
+	char sbuffer[MAX_LINE];
+
+	if (IFROOT) {
+		// print basic parameters
+		printf("box dimensions: %ix%ix%i\n",boxX,boxY,boxZ);
+		printf("lambda: "GFORM"   Dipoles/lambda: "GFORMDEF"%s\n",lambda,dpl,rectDip ? " (along the x-axis)" : "");
+		printf("Required relative residual norm: "GFORMDEF"\n",iter_eps);
+		printf("Total number of occupied dipoles: %zu\n",nvoid_Ndip);
+		// log basic parameters
+		fprintf(logfile,"lambda: "GFORM"\n",lambda);
+		fprintf(logfile,"shape: ");
+		fprintf(logfile,"%s"GFORM"%s\n",sh_form_str1,sizeX,sh_form_str2);
+#ifndef SPARSE
+		if (sh_granul) fprintf(logfile,"  domain %d is filled with %d granules of diameter "GFORMDEF"\n"
+			"    volume fraction: specified - "GFORMDEF", actual - "GFORMDEF"\n",gr_mat+1,gr_N,gr_d,gr_vf,gr_vf_real);
+#endif // SPARSE
+		fprintf(logfile,"box dimensions: %ix%ix%i\n",boxX,boxY,boxZ);
+		if(rectDip) PrintBoth(logfile,"Using rectangular dipoles with proportions %g:%g:%g (x:y:z)\n",
+			rectScaleX,rectScaleY,rectScaleZ);
+		if (anisotropy) {
+			fprintf(logfile,"refractive index (diagonal elements of the tensor):\n");
+			if (Nmat==1) fprintf(logfile,"    "CFORM3V"\n",REIM3V(ref_index));
+			else {
+				for (i=0;i<Nmat;i++) {
+					if (i<Nmat_given) fprintf(logfile,"    %d. "CFORM3V"\n",i+1,REIM3V(ref_index+3*i));
+					else fprintf(logfile,"   %d. not specified\n",i+1);
+				}
+			}
+		}
+		else {
+			fprintf(logfile,"refractive index: ");
+			if (Nmat==1) fprintf(logfile,CFORM"\n",REIM(ref_index[0]));
+			else {
+				fprintf(logfile,"1. "CFORM"\n",REIM(ref_index[0]));
+				for (i=1;i<Nmat;i++) {
+					if (i<Nmat_given) fprintf(logfile,"                  %d. "CFORM"\n",i+1,REIM(ref_index[i]));
+					else fprintf(logfile,"                  %d. not specified\n",i+1);
+				}
+			}
+		}
+		if (surface) {
+			if (msubInf) fprintf(logfile,"Particle is placed near the perfectly reflecting substrate\n");
+			else fprintf(logfile,"Particle is placed near the substrate with refractive index "CFORM",\n",REIM(msub));
+			fprintf(logfile,"  height of the particle center: "GFORMDEF"\n",hsub);
+		}
+		fprintf(logfile,"Dipoles/lambda: "GFORMDEF"%s\n",dpl,rectDip ? " (along the x-axis)" : "");
+		if (volcor_used) fprintf(logfile,"\t(Volume correction used)\n");
+		fprintf(logfile,"Required relative residual norm: "GFORMDEF"\n",iter_eps);
+		fprintf(logfile,"Total number of occupied dipoles: %zu\n",nvoid_Ndip);
+		if (Nmat>1) {
+			fprintf(logfile,"  per domain: 1. %zu\n",mat_count[0]);
+			for (i=1;i<Nmat;i++) fprintf(logfile,"              %d. %zu\n",i+1,mat_count[i]);
+		}
+		fprintf(logfile,"Volume-equivalent size parameter: "GFORM"\n",ka_eq);
+		// log incident beam and polarization
+		fprintf(logfile,"\n---In laboratory reference frame:---\nIncident beam: %s\n",beam_descr);
+		fprintf(logfile,"Incident propagation vector: "GFORMDEF3V"\n",COMP3V(prop_0));
+		if (beamtype==B_DIPOLE) fprintf(logfile,"(dipole orientation)\n");
+		else { // polarizations are not shown for dipole incident field
+			fprintf(logfile,"Incident polarization Y(par): "GFORMDEF3V"\n",COMP3V(incPolY_0));
+			fprintf(logfile,"Incident polarization X(per): "GFORMDEF3V"\n",COMP3V(incPolX_0));
+		}
+		if (surface && beamtype!=B_DIPOLE) { // include surface-specific vectors
+			fprintf(logfile,"Reflected propagation vector: "GFORMDEF3V"\n",COMP3V(prIncRefl));
+			fprintf(logfile,"Transmitted propagation vector: ");
+			if (msubInf) fprintf (logfile,"none\n");
+			else {
+				fprintf(logfile,GFORMDEF3V,COMP3V(prIncTran));
+				if (prIncTran[2]==0) fprintf(logfile," (evanescent)\n");
+				else fprintf(logfile,"\n");
+			}
+		}
+		fprintf(logfile,"\n");
+		// log particle orientation
+		if (orient_avg) fprintf(logfile,"Particle orientation - averaged\n%s\n",avg_string);
+		else {
+			// log incident polarization after transformation
+			if (alph_deg!=0 || bet_deg!=0 || gam_deg!=0) {
+				fprintf(logfile,"Particle orientation (deg): alpha="GFORMDEF", beta="GFORMDEF", gamma="GFORMDEF"\n\n"
+					"---In particle reference frame:---\n",alph_deg,bet_deg,gam_deg);
+				if (beam_asym) fprintf(logfile,"Incident Beam center position: "GFORMDEF3V"\n",
+					beam_center[0],beam_center[1],beam_center[2]);
+				fprintf(logfile,"Incident propagation vector: "GFORMDEF3V"\n",COMP3V(prop));
+				if (beamtype==B_DIPOLE) fprintf(logfile,"(dipole orientation)\n");
+				else { // polarizations are not shown for dipole incident field
+					fprintf(logfile,"Incident polarization Y(par): "GFORMDEF3V"\n",COMP3V(incPolY));
+					fprintf(logfile,"Incident polarization X(per): "GFORMDEF3V"\n",COMP3V(incPolX));
+				}
+			}
+			else fprintf(logfile,"Particle orientation: default\n");
+			fprintf(logfile,"\n");
+		}
+		// log type of scattering matrices
+		if (store_mueller) {
+			if (store_ampl) fprintf(logfile,"Calculating both amplitude and Mueller scattering matrices\n");
+			else fprintf(logfile,"Calculating only Mueller scattering matrix\n");
+		}
+		else {
+			if (store_ampl) fprintf(logfile,"Calculating only amplitude scattering matrix\n");
+			else fprintf(logfile,"Calculating no scattering matrices\n");
+		}
+		// log polarizability relation
+		fprintf(logfile,"Polarizability relation: ");
+		switch (PolRelation) {
+			case POL_CLDR: fprintf(logfile,"'Corrected Lattice Dispersion Relation'\n"); break;
+			case POL_CM: fprintf(logfile,"'Clausius-Mossotti'\n"); break;
+			case POL_DGF: fprintf(logfile,"'Digitized Green's Function'\n"); break;
+			case POL_FCD: fprintf(logfile,"'Filtered Coupled Dipoles'\n"); break;
+			case POL_IGT_SO: fprintf(logfile,"'Integration of Green's Tensor [approximation O(kd^2)]'\n"); break;
+			case POL_LAK: fprintf(logfile,"'by Lakhtakia'\n"); break;
+			case POL_LDR:
+				fprintf(logfile,"'Lattice Dispersion Relation'");
+				if (avg_inc_pol) fprintf(logfile," (averaged over incident polarization)");
+				fprintf(logfile,"\n");
+				break;
+			case POL_NLOC:
+				fprintf(logfile,"'Non-local' (based on lattice sum, Gaussian width Rp="GFORMDEF")\n",polNlocRp);
+				break;
+			case POL_NLOC_AV:
+				fprintf(logfile,"'Non-local' (averaged, Gaussian width Rp="GFORMDEF")\n",polNlocRp);
+				break;
+			case POL_RRC: fprintf(logfile,"'Radiative Reaction Correction'\n"); break;
+			case POL_SO: fprintf(logfile,"'Second Order'\n"); break;
+		}
+		/* TO ADD NEW POLARIZABILITY FORMULATION
+		 * add a case above in the alphabetical order, analogous to the ones already present. The variable parts of the
+		 * case are descriptor, defined in const.h, and its plain-text description (to be shown in log).
+		 */
+		// log Scattering Quantities formulae
+		fprintf(logfile,"Scattering quantities formulae: ");
+		switch (ScatRelation) {
+			case SQ_DRAINE: fprintf(logfile,"'by Draine'\n"); break;
+			case SQ_FINDIP: fprintf(logfile,"'Finite Dipoles'\n"); break;
+			case SQ_IGT_SO: fprintf(logfile,"'Integration of Green's Tensor [approximation O(kd^2)]'\n"); break;
+			case SQ_SO: fprintf(logfile,"'Second Order'\n"); break;
+		}
+		// log Interaction term prescription
+		fprintf(logfile,"Interaction term prescription: ");
+		switch (IntRelation) {
+			case G_FCD: fprintf(logfile,"'Filtered Green's tensor'\n"); break;
+			case G_FCD_ST: fprintf(logfile,"'Filtered Green's tensor (quasistatic)'\n"); break;
+			case G_IGT:
+				fprintf(logfile,"'Integrated Green's tensor' (accuracy "GFORMDEF", ",igt_eps);
+				if (igt_lim==UNDEF) fprintf(logfile,"no distance limit)\n");
+				else fprintf(logfile,"for distance < "GFORMDEF" dipole sizes%s)\n",igt_lim,
+					rectDip ? " along the greatest dimension" : "");
+				break;
+			case G_IGT_SO: fprintf(logfile,"'Integrated Green's tensor [approximation O(kd^2)]'\n"); break;
+			case G_NLOC: fprintf(logfile,"'Non-local' (point-value, Gaussian width Rp="GFORMDEF")\n",nloc_Rp); break;
+			case G_NLOC_AV: fprintf(logfile,"'Non-local' (averaged, Gaussian width Rp="GFORMDEF")\n",nloc_Rp); break;
+			case G_POINT_DIP: fprintf(logfile,"'as Point dipoles'\n"); break;
+			case G_SO: fprintf(logfile,"'Second Order'\n"); break;
+		}
+		/* TO ADD NEW INTERACTION FORMULATION
+		 * add a case above in the alphabetical order, analogous to the ones already present. The variable parts of the
+		 * case are descriptor, defined in const.h, and its plain-text description (to be shown in log).
+		 */
+		// log reflected Green'tensor formulae
+		if (surface) {
+			fprintf(logfile,"Reflected Green's tensor formulae: ");
+			switch (ReflRelation) {
+				case GR_IMG: fprintf(logfile,"'Image-dipole approximation'\n"); break;
+				case GR_SOM: fprintf(logfile,"'Sommerfeld integrals'\n"); break;
+			}
+		}
+		/* TO ADD NEW REFLECTION FORMULATION
+		 * add a case above in the alphabetical order, analogous to the ones already present. The variable parts of the
+		 * case are descriptor, defined in const.h, and its plain-text description (to be shown in log).
+		 */
+		// log FFT and (if needed) clFFT method
+		fprintf(logfile,"FFT algorithm: ");
+#ifdef FFTW3
+		fprintf(logfile,"FFTW3\n");
+#elif defined(FFT_TEMPERTON)
+		fprintf(logfile,"by C.Temperton\n");
+#elif defined(SPARSE)
+		fprintf(logfile,"none (sparse mode)\n");
+#endif
+#if defined(OPENCL) && !defined(SPARSE)
+		fprintf(logfile,"OpenCL FFT algorithm: ");
+#	ifdef CLFFT_AMD
+		fprintf(logfile,"by AMD\n");
+#	elif defined(CLFFT_APPLE)
+		fprintf(logfile,"by Apple\n");
+#	endif
+#endif
+		// log Iterative Method
+		fprintf(logfile,"Iterative Method: ");
+		switch (IterMethod) {
+			case IT_BCGS2: fprintf(logfile,"Enhanced Bi-CG Stabilized(2)\n"); break;
+			case IT_BICG_CS: fprintf(logfile,"Bi-CG (complex symmetric)\n"); break;
+			case IT_BICGSTAB: fprintf(logfile,"Bi-CG Stabilized\n"); break;
+			case IT_CGNR: fprintf(logfile,"CGNR\n"); break;
+			case IT_CSYM: fprintf(logfile,"CSYM\n"); break;
+			case IT_QMR_CS: fprintf(logfile,"QMR (complex symmetric)\n"); break;
+			case IT_QMR_CS_2: fprintf(logfile,"2-term QMR (complex symmetric)\n"); break;
+		}
+		/* TO ADD NEW ITERATIVE SOLVER
+		 * add a case above in the alphabetical order, analogous to the ones already present. The variable parts of the
+		 * case are descriptor, defined in const.h, and its plain-text description (to be shown in log).
+		 */
+		// log Symmetry options
+		switch (sym_type) {
+			case SYM_AUTO:
+				fprintf(logfile,"Symmetries: ");
+				if (symX) fprintf(logfile,"X");
+				if (symY) fprintf(logfile,"Y");
+				if (symZ) fprintf(logfile,"Z");
+				if (symR) fprintf(logfile,"R");
+				if (!(symX||symY||symZ||symR)) fprintf(logfile,"none");
+				fprintf(logfile,"\n");
+				break;
+			case SYM_NO: fprintf(logfile,"Symmetries: cancelled by user\n"); break;
+			case SYM_ENF: fprintf(logfile,"Symmetries: enforced by user (warning!)\n"); break;
+		}
+		// log optimization method
+		if (save_memory) fprintf(logfile,"Optimization is done for minimum memory usage\n");
+		else fprintf(logfile,"Optimization is done for maximum speed\n");
+		// log Checkpoint options
+		if (load_chpoint) fprintf(logfile,"Simulation is continued from a checkpoint\n");
+		if (chp_type!=CHP_NONE) {
+			fprintf(logfile,"Checkpoint is turned on:\n");
+			switch (chp_type) {
+				case CHP_NONE: break; // redundant; to keep a set of cases complete
+				case CHP_NORMAL: fprintf(logfile,"    type = normal\n"); break;
+				case CHP_REGULAR: fprintf(logfile,"    type = regular\n"); break;
+				case CHP_ALWAYS: fprintf(logfile,"    type = always\n"); break;
+			}
+			if (chp_time==UNDEF) fprintf(logfile,"    time = no limit\n");
+			else {
+				PrintTime(sbuffer,&chp_time);
+				// chp_time is converted to long to avoid problems with definition of time_t (can be either int or long)
+				fprintf(logfile,"    time = %s(%ld sec)\n",sbuffer,(long)chp_time);
+			}
+		}
+		if (load_chpoint || chp_type!=CHP_NONE) fprintf(logfile,"    directory = '%s'\n",chp_dir);
+		/* TO ADD NEW COMMAND LINE OPTION
+		 * If a new command line option requires additional output to log file or stdout, implement this functionality
+		 * here, choosing appropriate place for this information among the above lines.
+		 */
+	}
+}

From 5292e624ed9ce30c97d7d0e66661d1c949312e78 Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Wed, 25 Mar 2020 17:50:23 +0700
Subject: [PATCH 02/46] Added other BB types (not tested)

---
 .gitignore  |  24 +++++++--
 GenerateB.c | 142 +++++++++++++++++++++++++++++++++-------------------
 bess.c      | 126 +++++++++++++++++++++++-----------------------
 bess.h      |  13 ++---
 const.h     |   7 ++-
 param.c     |  29 ++++++++---
 6 files changed, 209 insertions(+), 132 deletions(-)

diff --git a/.gitignore b/.gitignore
index 538be38a..a6eb73b9 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,3 +1,21 @@
-# This is currently empty. If you need some ignores, which are specific to your workflow (e.g. IDE), consider
-# including them into $GIT_DIR/info/exclude (in this repository) or globally into $XDG_CONFIG_HOME/git/ignore
-# See https://git-scm.com/docs/gitignore 
\ No newline at end of file
+/githash.h
+
+# The same ignores apply to all compilation folders
+/*/*.exe
+/*/*.dll
+/*/adda*
+/*/*.o
+/*/*.d
+/*/.*opts
+/*/*stackdump
+/*/ExpCount
+/*/tables/
+/*/run*/
+/*/test*/
+/*/*.dat
+/*/*.geom
+/*/out
+/*/*.clstr
+
+
+
diff --git a/GenerateB.c b/GenerateB.c
index ebd6f92c..dca1510d 100644
--- a/GenerateB.c
+++ b/GenerateB.c
@@ -188,32 +188,39 @@ void InitBeam(void)
 			}
 			return;
 		case B_BESSELCS:
+		case B_BESSELLE:
+		case B_BESSELLM:
+		case B_BESSELTEC:
+		case B_BESSELTMC:
 			if (surface) PrintError("Currently, Bessel incident beam is not supported for '-surf'");
 			// initialize parameters
-			n0=beam_pars[0];
+			n0=round(beam_pars[0]);
 			alpha0 = beam_pars[1];
-			//TestPositive(n0,"order of bessel beam");
 			vCopy(beam_pars+2,beam_center_0);
-			beam_asym=(beam_Npars==4 && (beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0));
-			if (!beam_asym) vInit(beam_center);
-			if (IFROOT) {
-				strcpy(beam_descr,"Bessel beam (CS - representation)");
-				sprintf(beam_descr+strlen(beam_descr),"\tOrder="GFORMDEF" tilt angle alpha0="GFORMDEF")\n"
-				                                      "\tCenter position: "GFORMDEF3V,n0,alpha0,COMP3V(beam_center_0));
-			}
-			return;
-		case B_BESSELLP:
-			if (surface) PrintError("Currently, Bessel incident beam is not supported for '-surf'");
-			// initialize parameters
-			n0=beam_pars[0];
-			alpha0 = beam_pars[1];
-			//TestPositive(n0,"order of bessel beam");
-			vCopy(beam_pars+2,beam_center_0);
-			beam_asym=(beam_Npars==4 && (beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0));
+			beam_asym=(beam_Npars==5 && (beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0));
+			symR=symX=symY=symZ=FALSE;
 			if (!beam_asym) vInit(beam_center);
 			if (IFROOT) {
-				strcpy(beam_descr,"Bessel beam (LP - representation)");
-				sprintf(beam_descr+strlen(beam_descr),"\tOrder="GFORMDEF" tilt angle alpha0="GFORMDEF")\n"
+				strcpy(beam_descr,"Bessel beam (");
+				switch (beamtype) {
+					case B_BESSELCS:
+						strcat(beam_descr,"circular symmetric energy density)\n");
+						break;
+					case B_BESSELLE:
+						strcat(beam_descr,"linear electric field)\n");
+						break;
+					case B_BESSELLM:
+						strcat(beam_descr,"linear magnetic field)\n");
+						break;
+					case B_BESSELTEC:
+						strcat(beam_descr,"forming TE Bessel beam)\n");
+						break;
+					case B_BESSELTMC:
+						strcat(beam_descr,"forming TM Bessel beam)\n");
+						break;
+					default: break;
+				}
+				sprintf(beam_descr+strlen(beam_descr),"\tOrder=""%d"" tilt angle alpha0="GFORMDEF")\n"
 				                                      "\tCenter position: "GFORMDEF3V,n0,alpha0,COMP3V(beam_center_0));
 			}
 			return;
@@ -263,13 +270,12 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 	doublecomplex psi0,Q,Q2;
 	doublecomplex v1[3],v2[3],v3[3],gt[6];
 	double ro, ro2,ro4;
-	double x,y,z,x2_s,xy_s;
+	double x,y,z,x2_s,xy_s,phi;
 	doublecomplex t1,t2,t3,t4,t5,t6,t7,t8,ctemp;
 	const double *ex; // coordinate axis of the beam reference frame
 	double ey[3];
 	double r1[3];
 	double jn2[2];
-	double jn5[5];
 	const char *fname;
 	/* TO ADD NEW BEAM
 	 * Add here all intermediate variables, which are used only inside this function. You may as well use 't1'-'t8'
@@ -461,42 +467,74 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 			}
 			return;
 		case B_BESSELCS:
+		case B_BESSELLE:
+		case B_BESSELLM:
+		case B_BESSELTEC:
+		case B_BESSELTMC:
 			for (i=0;i<local_nvoid_Ndip;i++) {
 				j=3*i;
 				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
 				x=DotProd(r1,ex);
 				y=DotProd(r1,ey);
 				z=DotProd(r1,prop);
-				ro=sqrt(x*x+y*y);
-				t1=WaveNum;
-				t2=atan(y/x);
-				ctemp=(t1*t1/4)*(1 + cos(alpha0))*cpow(-I,n0)*cexp(I*n0*t2)*cexp(-I*t1*z*cos(alpha0));
-				BESSJCS(n0,ro*sin(alpha0),jn5);
-				t3=(1 + cos(alpha0))*jn5[2] + (1 - cos(alpha0))/2*(cexp(2*I*n0*t2)*jn5[4] + cexp(-2*I*n0*t2)*jn5[0]);
-				t4=(1 - cos(alpha0))*(1/2/I)*(cexp(2*I*n0*t2)*jn5[4] - cexp(-2*I*n0*t2)*jn5[0]);
-				t5=I*cos(alpha0)*(cexp(I*n0*t2)*jn5[3] - cexp(-I*n0*t2)*jn5[1]);
-				cvMultScal_RVec(t3,ex,v1);
-				cvMultScal_RVec(t4,ey,v2);
-				cvMultScal_RVec(t5,prop,v3);
-				cvAdd2Self(v1,v2,v3);
-				cvMultScal_cmplx(ctemp,v1,b+j);
-			}
-			return;
-		case B_BESSELLP:
-			for (i=0;i<local_nvoid_Ndip;i++) {
-				j=3*i;
-				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
-				x=DotProd(r1,ex);
-				y=DotProd(r1,ey);
-				z=DotProd(r1,prop);
-				ro=sqrt(x*x+y*y);
-				t1=WaveNum;
-				t2=atan(y/x);
-				ctemp=t1*cpow(-I,n0)*cexp(I*n0*t2)*cexp(-I*t1*z*cos(alpha0));
-				BESSJLP(n0,ro*sin(alpha0),jn2);
-				t3=t1*cos(alpha0)*jn2[0];
-				t4=0;
-				t5=(I*x/ro)*jn2[1] - (I*x+y)/(ro*ro)*n0*jn2[0];
+				ro=sqrt(x*x+y*y);	// radial distance in a cilindrical coordinate system
+				phi=atan(y/x);		// angular coordinate in a cilindrical coordinate system
+				t1=WaveNum*sin(alpha0);
+				t2=WaveNum*cos(alpha0);
+				// common factor
+				ctemp=cpow(-I,n0)*cexp(I*n0*phi)*cexp(-I*t2*z);
+				bessjn2(n0,ro*t1,jn2);
+				// field components (see J.J. Wang et.al./JQSRT 184 2016 218-232 [7])
+				switch (beamtype) {
+					case B_BESSELCS:
+						t3=1/2/ro/ro*(jn2[1]*t1*ro*(cos(2*phi)+I*n0*sin(2*phi)) + 
+							jn2[0]*(cexp(-2*I*phi)*(n0-1)*n0+cpow(WaveNum*ro,2)*(cos(alpha0)+
+								pow(cos(alpha0)*cos(phi),2)+pow(sin(phi),2))));
+						t4=1/8/ro/ro*(jn2[1]*4*t1*ro*(-I*n0*cos(2*phi)+sin(2*phi)) +
+							jn2[0]*(4*I*(n0-1)*n0*cos(2*phi)+(4*(n0-1)*n0-
+								cpow(WaveNum*ro,2)*(cos(2*alpha0)-1))*sin(2*phi)));
+						t5=I/2/ro*(WaveNum+t2)*cexp(-I*phi)*(jn2[1]*cexp(I*phi)*ro*t1*cos(phi) -
+							jn2[0]*n0);
+						break;
+					case B_BESSELLE:
+						t3=jn2[0]*t2*WaveNum;
+						t4=0;
+						t5=WaveNum*I*(jn2[1]*t1*cos(phi) -
+							jn2[0]*cexp(-I*phi)/ro*n0);
+						break;
+					case B_BESSELLM:
+						t3=1/ro/ro*(jn2[1]*t1*ro*(I*n0*cos(2*phi)-sin(2*phi)) +
+							jn2[0]*4*(-4*I*(n0-1)*n0*cos(2*phi)+(-4*(n0-1)*n0+
+								cpow(WaveNum*ro,2)*(1-cos(2*alpha0)))*sin(2*phi)));
+						t4=1/4/ro/ro*(jn2[1]*4*t1*ro*(cos(2*phi)+I*n0*sin(2*phi)) -
+							jn2[0]*((-4*(n0-1)*n0 + cpow(WaveNum*ro,2))*cos(2*phi)+
+								cpow(WaveNum*ro,2)*(3+2*cos(2*alpha0)*pow(sin(phi),2))+4*I*(n0-1)*n0*sin(2*phi)));
+						t5=-1/ro*t2*(jn2[1]*I*ro*t1*sin(phi) +
+							jn2[0]*n0*cexp(-I*phi));
+						break;
+					case B_BESSELTEC:
+						t3=1/2/ro/ro*(jn2[1]*ro*WaveNum*(-I*n0*cos(2*phi)+sin(2*phi)) +
+							jn2[0]*(2*I*(n0-1)*n0*cexp(-2*I*phi)/sin(alpha0)+
+								cpow(WaveNum*ro,2)*(2*I*cos(alpha0)/tan(alpha0)-sin(alpha0)*sin(2*phi))));
+						t4=1/ro/ro*(-jn2[1]*ro*WaveNum*(cos(2*phi)+I*n0*sin(2*phi)) +
+							jn2[0]*(-(n0-1)*n0*cexp(-2*I*phi)/sin(alpha0)+
+								cpow(WaveNum*ro,2)/sin(alpha0)*(1-pow(sin(alpha0)*sin(phi),2))));
+						t5=-1/ro*cexp(-I*phi)*t2/sin(alpha0)*(jn2[1]*ro*t1 -
+							jn2[0]*2*n0);
+						break;
+					case B_BESSELTMC:
+						t3=1/ro/ro*(jn2[1]*ro*t2*(n0*cos(2*phi)+I*sin(2*phi)) +
+							jn2[0]*(-cexp(-2*I*phi)*(n0-1)*n0/tan(alpha0)-
+								cpow(WaveNum*ro,2)*(1/tan(alpha0)+I/4*sin(2*alpha0)*sin(2*phi))));
+						t4=-I/ro/ro/tan(alpha0)*(jn2[1]*ro*t1*(cos(2*phi)+I*n0*sin(2*phi)) -
+							jn2[0]/4*((cpow(WaveNum*ro,2)-4*(n0-1)*n0)*pow(cos(phi),2)+
+								cpow(WaveNum*ro,2)*(3+2*cos(2*alpha0)*pow(sin(phi),2))+4*I*(n0-1)*n0*sin(2*phi)));
+						t5=I/2*WaveNum*cexp(-I*phi)*(-jn2[1]*2*WaveNum*cexp(I*phi)*(cos(phi)-
+								I*pow(cos(alpha0),2)*sin(phi)) +
+							jn2[0]*n0*(3+cos(2*alpha0))/ro/sin(alpha0));
+						break;
+					default: break;
+				}
 				cvMultScal_RVec(t3,ex,v1);
 				cvMultScal_RVec(t4,ey,v2);
 				cvMultScal_RVec(t5,prop,v3);
diff --git a/bess.c b/bess.c
index 984a1b9c..fa45dcdc 100644
--- a/bess.c
+++ b/bess.c
@@ -1,6 +1,7 @@
 /* File: bess.c
- * $Date::                            $
- * Descr:
+ * $Date::      17/07/2019                      $
+ * Descr: 		Two functions "bessjn2" and "bessjn5" for computing 2 and 5 orders of Bessel functions respectively
+ * Reference:	C++ Release 1.0 By J-P Moreau, Paris.(www.jpmoreau.fr)  
  *
  * Copyright (C) 2006-2013 ADDA contributors
  * This file is part of ADDA.
@@ -18,7 +19,17 @@
 #include <stdio.h>
 #include <stdlib.h>
 
-double BESSJ0 (double X) {
+
+
+/*	This subroutine calculates the First Kind Bessel Function of
+	order 0, for any real number X. The polynomial approximation by
+	series of Chebyshev polynomials is used for 0<X<8 and 0<8/X<1.
+	REFERENCES:
+	M.ABRAMOWITZ,I.A.STEGUN, HANDBOOK OF MATHEMATICAL FUNCTIONS, 1965.
+	C.W.CLENSHAW, NATIONAL PHYSICAL LABORATORY MATHEMATICAL TABLES,
+	VOL.5, 1962.
+*/
+double bessj0 (double X) { 
 	const double
 		P1=1.0, P2=-0.1098628627E-2, P3=0.2734510407E-4,
 		P4=-0.2073370639E-5, P5= 0.2093887211E-6,
@@ -54,7 +65,16 @@ double Sign(double X, double Y) {
 	else return (fabs(X));
 }
 
-double BESSJ1 (double X) {
+
+/*	This subroutine calculates the First Kind Bessel Function of
+	order 1, for any real number X. The polynomial approximation by
+	series of Chebyshev polynomials is used for 0<X<8 and 0<8/X<1.	
+	REFERENCES:
+	M.ABRAMOWITZ,I.A.STEGUN, HANDBOOK OF MATHEMATICAL FUNCTIONS, 1965.
+	C.W.CLENSHAW, NATIONAL PHYSICAL LABORATORY MATHEMATICAL TABLES,
+	VOL.5, 1962.
+*/
+double bessj1 (double X) {
 	const double  
 		P1=1.0, P2=0.183105E-2, P3=-0.3516396496E-4, P4=0.2457520174E-5,
 		P5=-0.240337019E-6,  P6=0.636619772,
@@ -84,9 +104,9 @@ double BESSJ1 (double X) {
 	}
 	return TMP;
 }
-
-void BESSJCS (int N2, double X, double ARRJ[5]) {
-	const IACC = 40; 
+/*
+void bessjn5 (int N2, double X, double ARRJ[5]) { // Computing 5 orders of Bessel function
+	const int A = 40;
 	const double BIGNO = 1e10,  BIGNI = 1e-10;
 
 	double TOX,BJM,BJ,BJP,SUM,TMP,BJM1,BJ1,BJP1,SUM1,TMP1;
@@ -96,46 +116,27 @@ void BESSJCS (int N2, double X, double ARRJ[5]) {
 	if (X == 0.0) {
 		switch(N2) {
 			case -2:
-			ARRJ[0] = 0.0;
-			ARRJ[1] = 0.0;
-			ARRJ[2] = 0.0;
-			ARRJ[3] = 0.0;
+			ARRJ[0] = ARRJ[1] = ARRJ[2] = ARRJ[3] = 0.0;
 			ARRJ[4] = 1.0;
 			break;
 			case -1:
-			ARRJ[0] = 0.0;
-			ARRJ[1] = 0.0;
-			ARRJ[2] = 0.0;
+			ARRJ[0] = ARRJ[1] = ARRJ[2] = ARRJ[4] = 0.0;
 			ARRJ[3] = 1.0;
-			ARRJ[4] = 0.0;
 			break;
 			case 0:
-			ARRJ[0] = 0.0;
-			ARRJ[1] = 0.0;
+			ARRJ[0] = ARRJ[1] = ARRJ[3] = ARRJ[4] = 0.0;
 			ARRJ[2] = 1.0;
-			ARRJ[3] = 0.0;
-			ARRJ[4] = 0.0;
 			break;
 			case 1:
-			ARRJ[0] = 0.0;
+			ARRJ[0] = ARRJ[2] = ARRJ[3] = ARRJ[4] = 0.0;
 			ARRJ[1] = 1.0;
-			ARRJ[2] = 0.0;
-			ARRJ[3] = 0.0;
-			ARRJ[4] = 0.0;
 			break;
 			case 2:
+			ARRJ[1] = ARRJ[2] = ARRJ[3] = ARRJ[4] = 0.0;
 			ARRJ[0] = 1.0;
-			ARRJ[1] = 0.0;
-			ARRJ[2] = 0.0;
-			ARRJ[3] = 0.0;
-			ARRJ[4] = 0.0;
 			break;
 			default:
-			ARRJ[0] = 0.0;
-			ARRJ[1] = 0.0;
-			ARRJ[2] = 0.0;
-			ARRJ[3] = 0.0;
-			ARRJ[4] = 0.0;
+			ARRJ[0] = ARRJ[1] = ARRJ[2] = ARRJ[3] = ARRJ[4] =0.0;
 			break;
 		}
 	}
@@ -143,50 +144,50 @@ void BESSJCS (int N2, double X, double ARRJ[5]) {
 		if ((N == -5)||(N == -4)||(N == -3)||(N == -2)||(N == -1)||(N == 0)||(N == 1)) {
 			switch(N) {
 				case -5:
-				ARRJ[4] = -BESSJ1(X); 
-				ARRJ[3] = -(2.0/X)*ARRJ[4]-BESSJ0(X);
+				ARRJ[4] = -bessj1(X); 
+				ARRJ[3] = -(2.0/X)*ARRJ[4]-bessj0(X);
 				ARRJ[2] = -(4.0/X)*ARRJ[3]-ARRJ[4];
 				ARRJ[1] = -(6.0/X)*ARRJ[2]-ARRJ[3];
 				ARRJ[0] = -(8.0/X)*ARRJ[1]-ARRJ[2];
 				break;
 				case -4:
-				ARRJ[4] = BESSJ0(X); 
-				ARRJ[3] = -BESSJ1(X);
+				ARRJ[4] = bessj0(X); 
+				ARRJ[3] = -bessj1(X);
 				ARRJ[2] = -(2.0/X)*ARRJ[3]-ARRJ[4];
 				ARRJ[1] = -(4.0/X)*ARRJ[2]-ARRJ[3];
 				ARRJ[0] = -(6.0/X)*ARRJ[1]-ARRJ[2];
 				break;
 				case -3:
-				ARRJ[4] = BESSJ1(X); 
-				ARRJ[3] = BESSJ0(X);
+				ARRJ[4] = bessj1(X); 
+				ARRJ[3] = bessj0(X);
 				ARRJ[2] = -ARRJ[4];;
 				ARRJ[1] = -(2.0/X)*ARRJ[2]-ARRJ[3];
 				ARRJ[0] = -(4.0/X)*ARRJ[1]-ARRJ[2];
 				break;
 				case -2:
-				ARRJ[3] = BESSJ1(X); 
-				ARRJ[2] = BESSJ0(X);
+				ARRJ[3] = bessj1(X); 
+				ARRJ[2] = bessj0(X);
 				ARRJ[1] = -ARRJ[4];;
 				ARRJ[1] = -(2.0/X)*ARRJ[2]-ARRJ[3];
 				ARRJ[0] = -(4.0/X)*ARRJ[1]-ARRJ[2];
 				break;
 				case -1:
-				ARRJ[0] = -BESSJ1(X);
-				ARRJ[1] = BESSJ0(X);
+				ARRJ[0] = -bessj1(X);
+				ARRJ[1] = bessj0(X);
 				ARRJ[2] = -ARRJ[0];
 				ARRJ[3] = (2.0/X)*ARRJ[2]-ARRJ[1];
 				ARRJ[4] = (4.0/X)*ARRJ[3]-ARRJ[2];
 				break;
 				case 0:
-				ARRJ[0] = BESSJ0(X);
-				ARRJ[1] = BESSJ1(X);
+				ARRJ[0] = bessj0(X);
+				ARRJ[1] = bessj1(X);
 				ARRJ[2] = (2.0/X)*ARRJ[1]-ARRJ[0];
 				ARRJ[3] = (4.0/X)*ARRJ[2]-ARRJ[1];
 				ARRJ[4] = (6.0/X)*ARRJ[3]-ARRJ[2];
 				break;
 				case 1:
-				ARRJ[0] = BESSJ1(X);
-				ARRJ[1] = (2.0/X)*ARRJ[0]-BESSJ0(X);
+				ARRJ[0] = bessj1(X);
+				ARRJ[1] = (2.0/X)*ARRJ[0]-bessj0(X);
 				ARRJ[2] = (4.0/X)*ARRJ[1]-ARRJ[0];
 				ARRJ[3] = (6.0/X)*ARRJ[2]-ARRJ[1];
 				ARRJ[4] = (8.0/X)*ARRJ[3]-ARRJ[2];
@@ -201,10 +202,10 @@ void BESSJCS (int N2, double X, double ARRJ[5]) {
 			if ((N2-2 <0)&((N2-2)%2 != 0)) sgn = -1;
 			if ((N2-1 <0)&((N2-1)%2 != 0)) sgn1 = -1;
 			if (X > 1.0*N) {
-				BJM = BESSJ0(X);
-				BJ  = BESSJ1(X);
+				BJM = bessj0(X);
+				BJ  = bessj1(X);
 				
-				for (J=1; J<N; J++) {
+				for (J=1; J<N; J++) {  // Upward recurrence
 					BJP = J*TOX*BJ-BJM;
 					BJM = BJ;
 					BJ  = BJP;
@@ -218,8 +219,8 @@ void BESSJCS (int N2, double X, double ARRJ[5]) {
 				ARRJ[4] = (N+4)*(2.0/X)*ARRJ[3]-ARRJ[2];
 			}
 			else {
-				M = (int) (2*((N+floor(sqrt(1.0*(IACC*N))))/2));
-				K = (int) (2*((N+1+floor(sqrt(1.0*(IACC*(N+1)))))/2));
+				M = (int) (2*((N+floor(sqrt(1.0*(A*N))))/2));
+				K = (int) (2*((N+1+floor(sqrt(1.0*(A*(N+1)))))/2));
 				TMP = 0.0;
 				TMP1 = 0.0;
 				JSUM = 0;
@@ -231,7 +232,7 @@ void BESSJCS (int N2, double X, double ARRJ[5]) {
 				BJ  = 1.0;
 				BJ1  = 1.0;
 				
-				for (J=K; J>0; J--) {
+				for (J=K; J>0; J--) {  // Downward recurrence ( Miller's algorithm )
 					BJM1 = J*TOX*BJ1-BJP1;
 					BJP1 = BJ1;
 					BJ1  = BJM1;
@@ -270,9 +271,10 @@ void BESSJCS (int N2, double X, double ARRJ[5]) {
 		}
 	}
 }
+*/
 
-void BESSJLP (int N, double X, double ARRJ[2]) {
-	const IACC = 40; 
+void bessjn2 (int N, double X, double ARRJ[2]) {  // Computing 2 orders of Bessel function
+	const int A = 40;
 	const double BIGNO = 1e10,  BIGNI = 1e-10;
 
 	double TOX,BJM,BJ,BJP,SUM,TMP,BJM1,BJ1,BJP1,SUM1,TMP1;
@@ -283,16 +285,16 @@ void BESSJLP (int N, double X, double ARRJ[2]) {
 	}
 	else {
 		if ((N == 0)||(N == 1)) {
-			if (N == 0) { ARRJ[0] = BESSJ0(X); ARRJ[1] = BESSJ1(X);}
-			if (N == 1) { ARRJ[0] = BESSJ1(X); ARRJ[1] = (2.0/X)*ARRJ[0]-BESSJ0(X);}
+			if (N == 0) { ARRJ[0] = bessj0(X); ARRJ[1] = bessj1(X);}
+			if (N == 1) { ARRJ[0] = bessj1(X); ARRJ[1] = (2.0/X)*ARRJ[0]-bessj0(X);}
 		}
 		else {
 			TOX = 2.0/X;
 			if (X > 1.0*N) {
-				BJM = BESSJ0(X);
-				BJ  = BESSJ1(X);
+				BJM = bessj0(X);
+				BJ  = bessj1(X);
 				
-				for (J=1; J<N; J++) {
+				for (J=1; J<N; J++) {  // Upward recurrence
 					BJP = J*TOX*BJ-BJM;
 					BJM = BJ;
 					BJ  = BJP;
@@ -302,8 +304,8 @@ void BESSJLP (int N, double X, double ARRJ[2]) {
 				ARRJ[0] = BJ; ARRJ[1] = BJP;
 			}
 			else {
-				M = (int) (2*((N+floor(sqrt(1.0*(IACC*N))))/2));
-				K = (int) (2*((N+1+floor(sqrt(1.0*(IACC*(N+1)))))/2));
+				M = (int) (2*((N+floor(sqrt(1.0*(A*N))))/2));
+				K = (int) (2*((N+1+floor(sqrt(1.0*(A*(N+1)))))/2));
 				TMP = 0.0;
 				TMP1 = 0.0;
 				JSUM = 0;
@@ -315,7 +317,7 @@ void BESSJLP (int N, double X, double ARRJ[2]) {
 				BJ  = 1.0;
 				BJ1  = 1.0;
 				
-				for (J=K; J>0; J--) {
+				for (J=K; J>0; J--) {  // Downward recurrence ( Miller's algorithm )
 					BJM1 = J*TOX*BJ1-BJP1;
 					BJP1 = BJ1;
 					BJ1  = BJM1;
diff --git a/bess.h b/bess.h
index 71e6048d..ef79b17e 100644
--- a/bess.h
+++ b/bess.h
@@ -1,6 +1,7 @@
 /* File: bess.h
- * $Date::                            $
- * Descr:
+ * $Date::      17/07/2019                      $
+ * Descr:		Two functions "bessjn2" and "bessjn5" for computing 2 and 5 orders of Bessel functions respectively
+ * Reference:	C++ Release 1.0 By J-P Moreau, Paris.(www.jpmoreau.fr) 
  *
  * Copyright (C) 2006,2008-2013
  * This file is part of ADDA.
@@ -19,9 +20,9 @@
 #include <stdio.h>
 #include <stdlib.h>
 
-double BESSJ0 (double X);
+double bessj0 (double X);
 double Sign(double X, double Y);
-double BESSJ1 (double X);
+double bessj1 (double X);
 
-void BESSJCS (int N2, double X, double ARRJ[5]);
-void BESSJLP (int N, double X, double ARRJ[2]);
+//void bessjn5 (int N2, double X, double ARRJ[5]);
+void bessjn2 (int N, double X, double ARRJ[2]);
diff --git a/const.h b/const.h
index c1fcc441..2e560f63 100644
--- a/const.h
+++ b/const.h
@@ -278,8 +278,11 @@ enum incpol {
 
 enum beam { // beam types
 	B_BARTON5, // 5th order description of the Gaussian beam
-	B_BESSELCS, // circularly symmetric Bessel beam derived using ASR
-	B_BESSELLP, // linearly polarized Bessel beam derived using Hertz vector potentials
+	B_BESSELCS, // Bessel beam with circularky symmetric energy density
+	B_BESSELLE, // Bessel beam with linearly polarized electric field
+	B_BESSELLM, // Bessel beam with linearly polarized magnetic field
+	B_BESSELTEC, // Bessel beam forming TE Bessel beam 
+	B_BESSELTMC, // Bessel beam forming TM Bessel beam 
 	B_DAVIS3,  // 3rd order description of the Gaussian beam
 	B_DIPOLE,  // field of a point dipole
 	B_LMINUS,  // 1st order description of the Gaussian beam
diff --git a/param.c b/param.c
index 68903f0d..fdfc8d22 100644
--- a/param.c
+++ b/param.c
@@ -222,14 +222,26 @@ static const struct subopt_struct beam_opt[]={
 		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
 		"(zero, by default). All arguments are in um. This is recommended option for simulation of the Gaussian beam.",
 		UNDEF,B_BARTON5},
-	{"besselCS","[<order> <angle> <x> <y> <z>]","Circularly symmetric Bessel beam of integer order derived "
-			"using ASR method. The tilt angle is measured from the z axis. Arguments x, y, z are coordinates of the "
+	{"besselCS","[<order> <angle> <x> <y> <z>]","Bessel beam with circularky symmetric energy density. The tilt angle "
+			"is measured from the z axis. Arguments x, y, z are coordinates of the "
 			"center of the beam (in laboratory reference frame). Coordinate arguments are in um. All arguments are "
 			"optional (zero, by default).",UNDEF,B_BESSELCS},
-	{"besselLP","[<order> <angle> <x> <y> <z>]","Linearly polarized Bessel beam of integer order derived using "
-			"Hertz vector potentials (m- type). The tilt angle is measured from the z axis. Arguments x, y, z are coordinates of "
+	{"besselLE","[<order> <angle> <x> <y> <z>]","Bessel beam with linearly polarized electric field. The tilt angle is "
+			"measured from the z axis. Arguments x, y, z are coordinates of "
 			"the center of the beam (in laboratory reference frame). Coordinate arguments are in um. All arguments are "
-			"optional (zero, by default).",UNDEF,B_BESSELLP},
+			"optional (zero, by default).",UNDEF,B_BESSELLE},
+	{"besselLM","[<order> <angle> <x> <y> <z>]","Bessel beam with linearly polarized magnetic field. The tilt angle is "
+			"measured from the z axis. Arguments x, y, z are coordinates of "
+			"the center of the beam (in laboratory reference frame). Coordinate arguments are in um. All arguments are "
+			"optional (zero, by default).",UNDEF,B_BESSELLM},
+	{"besselTEC","[<order> <angle> <x> <y> <z>]","Bessel beam forming TE Bessel beam. The tilt angle is "
+			"measured from the z axis. Arguments x, y, z are coordinates of "
+			"the center of the beam (in laboratory reference frame). Coordinate arguments are in um. All arguments are "
+			"optional (zero, by default).",UNDEF,B_BESSELTEC},
+	{"besselTMC","[<order> <angle> <x> <y> <z>]","Bessel beam forming TM Bessel beam. The tilt angle is "
+			"measured from the z axis. Arguments x, y, z are coordinates of "
+			"the center of the beam (in laboratory reference frame). Coordinate arguments are in um. All arguments are "
+			"optional (zero, by default).",UNDEF,B_BESSELTMC},
 	{"davis3","<width> [<x> <y> <z>]","3rd order approximation of the Gaussian beam (by Davis). The beam width is "
 		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
 		"(zero, by default). All arguments are in um.",UNDEF,B_DAVIS3},
@@ -989,8 +1001,11 @@ PARSE_FUNC(beam)
 			case B_LMINUS:
 			case B_DAVIS3:
 			case B_BARTON5: if (Narg!=1 && Narg!=4) NargError(Narg,"1 or 4"); break;
-			case B_BESSELCS:
-			case B_BESSELLP:
+			case B_BESSELCS: if (Narg!=0 && Narg!=1 && Narg!=2 && Narg!=5) NargError(Narg,"0, 1, 2 or 5"); break;
+			case B_BESSELLE: if (Narg!=0 && Narg!=1 && Narg!=2 && Narg!=5) NargError(Narg,"0, 1, 2 or 5"); break;
+			case B_BESSELLM: if (Narg!=0 && Narg!=1 && Narg!=2 && Narg!=5) NargError(Narg,"0, 1, 2 or 5"); break;
+			case B_BESSELTEC: if (Narg!=0 && Narg!=1 && Narg!=2 && Narg!=5) NargError(Narg,"0, 1, 2 or 5"); break;
+			case B_BESSELTMC: if (Narg!=0 && Narg!=1 && Narg!=2 && Narg!=5) NargError(Narg,"0, 1, 2 or 5"); break;
 			default: TestNarg(Narg,need); break;
 		}
 		/* TO ADD NEW BEAM

From b5e2eb0719004587613eac2e84c768cb2c88f8c6 Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Wed, 1 Apr 2020 22:50:34 +0700
Subject: [PATCH 03/46] Log file parameters have been changed a bit for BBs

---
 GenerateB.c          |  567 ----------
 const.h              |  430 -------
 param.c              | 2583 ------------------------------------------
 src/.cproject        |  140 +++
 src/.gitignore       |   18 -
 src/.project         |   26 +
 src/GenerateB.c      |  123 +-
 src/Makefile         |   10 +-
 bess.c => src/bess.c |  708 ++++++------
 bess.h => src/bess.h |   56 +-
 src/const.h          |    5 +
 src/githash.h        |    1 +
 src/param.c          |   25 +
 src/parbas.h         |    2 +-
 14 files changed, 704 insertions(+), 3990 deletions(-)
 delete mode 100644 GenerateB.c
 delete mode 100644 const.h
 delete mode 100644 param.c
 create mode 100644 src/.cproject
 delete mode 100644 src/.gitignore
 create mode 100644 src/.project
 rename bess.c => src/bess.c (96%)
 rename bess.h => src/bess.h (97%)
 create mode 100644 src/githash.h

diff --git a/GenerateB.c b/GenerateB.c
deleted file mode 100644
index dca1510d..00000000
--- a/GenerateB.c
+++ /dev/null
@@ -1,567 +0,0 @@
-/* File: GenerateB.c
- * $Date::                            $
- * Descr: generate a incident beam
- *
- *        Lminus beam is based on: G. Gouesbet, B. Maheu, G. Grehan, "Light scattering from a sphere arbitrary located
- *        in a Gaussian beam, using a Bromwhich formulation", J.Opt.Soc.Am.A 5,1427-1443 (1988).
- *        Eq.(22) - complex conjugate.
- *
- *        Davis beam is based on: L. W. Davis, "Theory of electromagnetic beams," Phys.Rev.A 19, 1177-1179 (1979).
- *        Eqs.(15a),(15b) - complex conjugate; in (15a) "Q" changed to "Q^2" (typo).
- *
- *        Barton beam is based on: J. P. Barton and D. R. Alexander, "Fifth-order corrected electromagnetic-field
- *        components for a fundamental Gaussian-beam," J.Appl.Phys. 66,2800-2802 (1989).
- *        Eqs.(25)-(28) - complex conjugate.
- *
- * Copyright (C) 2006-2014 ADDA contributors
- * This file is part of ADDA.
- *
- * ADDA is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as
- * published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
- *
- * ADDA is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- * of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along with ADDA. If not, see
- * <http://www.gnu.org/licenses/>.
- */
-#include "const.h" // keep this first
-// project headers
-#include "cmplx.h"
-#include "comm.h"
-#include "io.h"
-#include "interaction.h"
-#include "param.h"
-#include "vars.h"
-#include <stdio.h>
-#include <string.h>
-#include "bess.h"
-
-// SEMI-GLOBAL VARIABLES
-
-// defined and initialized in param.c
-extern const int beam_Npars;
-extern const double beam_pars[];
-extern const char *beam_fnameY;
-extern const char *beam_fnameX;
-extern const opt_index opt_beam;
-
-// used in CalculateE.c
-double C0dipole,C0dipole_refl; // inherent cross sections of exciting dipole (in free space and addition due to surface)
-
-// used in crosssec.c
-double beam_center_0[3]; // position of the beam center in laboratory reference frame
-/* complex wave amplitudes of secondary waves (with phase relative to particle center);
- * The transmitted wave can be inhomogeneous wave (when msub is complex), then eIncTran (e) is normalized
- * counter-intuitively. Before multiplying by tc, it satisfies (e,e)=1!=||e||^2. This normalization is consistent with
- * used formulae for transmission coefficients. So this transmission coefficient is not (generally) equal to the ratio
- * of amplitudes of the electric fields. In particular, when E=E0*e, ||E||!=|E0|*||e||, where
- * ||e||^2=(e,e*)=|e_x|^2+|e_y|^2+|e_z|^2=1
- *
- * !!! TODO: determine whether they are actually needed in crosssec.c, or make them static here
- */
-doublecomplex eIncRefl[3],eIncTran[3];
-// used in param.c
-char beam_descr[MAX_MESSAGE2]; // string for log file with beam parameters
-
-// LOCAL VARIABLES
-static double s,s2;            // beam confinement factor and its square
-static double scale_x,scale_z; // multipliers for scaling coordinates
-static doublecomplex ki,kt;    // abs of normal components of k_inc/k0, and ktran/k0
-static doublecomplex ktVec[3]; // k_tran/k0
-static double p0;              // amplitude of the incident dipole moment
-static int n0;                 // Bessel beam order
-static double alpha0;          // half-cone angle
-/* TO ADD NEW BEAM
- * Add here all internal variables (beam parameters), which you initialize in InitBeam() and use in GenerateB()
- * afterwards. If you need local, intermediate variables, put them into the beginning of the corresponding function.
- * Add descriptive comments, use 'static'.
- */
-
-//======================================================================================================================
-
-void InitBeam(void)
-// initialize beam; produce description string
-{
-	double w0; // beam width
-	/* TO ADD NEW BEAM
-	 * Add here all intermediate variables, which are used only inside this function.
-	 */
-	// initialization of global option index for error messages
-	opt=opt_beam;
-	// beam initialization
-	switch (beamtype) {
-		case B_PLANE:
-			if (IFROOT) strcpy(beam_descr,"plane wave");
-			beam_asym=false;
-			if (surface) {
-				if (prop_0[2]==0) PrintError("Ambiguous setting of beam propagating along the surface. Please specify "
-					"the incident direction to have (arbitrary) small positive or negative z-component");
-				if (msubInf && prop_0[2]>0) PrintError("Perfectly reflecting surface ('-surf ... inf') is incompatible "
-					"with incident direction from below (including the default one)");
-				// Here we set ki,kt,ktVec and propagation directions prIncRefl,prIncTran
-				if (prop_0[2]>0) { // beam comes from the substrate (below)
-					// here msub should always be defined
-					inc_scale=1/creal(msub);
-					ki=msub*prop_0[2];
-					/* Special case for msub near 1 to remove discontinuities for near-grazing incidence. The details
-					 * are discussed in CalcFieldSurf() in crosssec.c.
-					 */
-					if (cabs(msub-1)<ROUND_ERR && fabs(ki)<SQRT_RND_ERR) kt=ki;
-					else kt=cSqrtCut(1 - msub*msub*(prop_0[0]*prop_0[0]+prop_0[1]*prop_0[1]));
-					// determine propagation direction and full wavevector of wave transmitted into substrate
-					ktVec[0]=msub*prop_0[0];
-					ktVec[1]=msub*prop_0[1];
-					ktVec[2]=kt;
-				}
-				else if (prop_0[2]<0) { // beam comes from above the substrate
-					inc_scale=1;
-					vRefl(prop_0,prIncRefl);
-					ki=-prop_0[2];
-					if (!msubInf) {
-						// same special case as above
-						if (cabs(msub-1)<ROUND_ERR && fabs(ki)<SQRT_RND_ERR) kt=ki;
-						else kt=cSqrtCut(msub*msub - (prop_0[0]*prop_0[0]+prop_0[1]*prop_0[1]));
-						// determine propagation direction of wave transmitted into substrate
-						ktVec[0]=prop_0[0];
-						ktVec[1]=prop_0[1];
-						ktVec[2]=-kt;
-					}
-				}
-				else LogError(ONE_POS,"Ambiguous setting of beam propagating along the surface. Please specify the"
-					"incident direction to have (arbitrary) small positive or negative z-component");
-				vRefl(prop_0,prIncRefl);
-				if (!msubInf) {
-					vReal(ktVec,prIncTran);
-					vNormalize(prIncTran);
-				}
-			}
-			return;
-		case B_DIPOLE:
-			vCopy(beam_pars,beam_center_0);
-			if (surface) {
-				if (beam_center_0[2]<=-hsub)
-					PrintErrorHelp("External dipole should be placed strictly above the surface");
-				inc_scale=1; // but scaling of Mueller matrix is weird anyway
-			}
-			// in weird scenarios the dipole can be positioned exactly at the origin; reused code from Gaussian beams
-			beam_asym=(beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0);
-			if (!beam_asym) vInit(beam_center);
-			/* definition of p0 is important for scaling of many scattering quantities (that are normalized to incident
-			 * irradiance). Alternative definition is p0=1, but then the results will scale with unit of length
-			 * (breaking scale invariance)
-			 */
-			p0=1/(WaveNum*WaveNum*WaveNum);
-			if (IFROOT) sprintf(beam_descr,"point dipole at "GFORMDEF3V,COMP3V(beam_center_0));
-			return;
-		case B_LMINUS:
-		case B_DAVIS3:
-		case B_BARTON5:
-			if (surface) PrintError("Currently, Gaussian incident beam is not supported for '-surf'");
-			// initialize parameters
-			w0=beam_pars[0];
-			TestPositive(w0,"beam width");
-			vCopy(beam_pars+1,beam_center_0);
-			beam_asym=(beam_Npars==4 && (beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0));
-			if (!beam_asym) vInit(beam_center);
-			s=1/(WaveNum*w0);
-			s2=s*s;
-			scale_x=1/w0;
-			scale_z=s*scale_x; // 1/(k*w0^2)
-			// beam info
-			if (IFROOT) {
-				strcpy(beam_descr,"Gaussian beam (");
-				switch (beamtype) {
-					case B_LMINUS:
-						strcat(beam_descr,"L- approximation)\n");
-						break;
-					case B_DAVIS3:
-						strcat(beam_descr,"3rd order approximation, by Davis)\n");
-						break;
-					case B_BARTON5:
-						strcat(beam_descr,"5th order approximation, by Barton)\n");
-						break;
-					default: break;
-				}
-				sprintf(beam_descr+strlen(beam_descr),"\tWidth="GFORMDEF" (confinement factor s="GFORMDEF")\n"
-				                                      "\tCenter position: "GFORMDEF3V,w0,s,COMP3V(beam_center_0));
-			}
-			return;
-		case B_BESSELCS:
-		case B_BESSELLE:
-		case B_BESSELLM:
-		case B_BESSELTEC:
-		case B_BESSELTMC:
-			if (surface) PrintError("Currently, Bessel incident beam is not supported for '-surf'");
-			// initialize parameters
-			n0=round(beam_pars[0]);
-			alpha0 = beam_pars[1];
-			vCopy(beam_pars+2,beam_center_0);
-			beam_asym=(beam_Npars==5 && (beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0));
-			symR=symX=symY=symZ=FALSE;
-			if (!beam_asym) vInit(beam_center);
-			if (IFROOT) {
-				strcpy(beam_descr,"Bessel beam (");
-				switch (beamtype) {
-					case B_BESSELCS:
-						strcat(beam_descr,"circular symmetric energy density)\n");
-						break;
-					case B_BESSELLE:
-						strcat(beam_descr,"linear electric field)\n");
-						break;
-					case B_BESSELLM:
-						strcat(beam_descr,"linear magnetic field)\n");
-						break;
-					case B_BESSELTEC:
-						strcat(beam_descr,"forming TE Bessel beam)\n");
-						break;
-					case B_BESSELTMC:
-						strcat(beam_descr,"forming TM Bessel beam)\n");
-						break;
-					default: break;
-				}
-				sprintf(beam_descr+strlen(beam_descr),"\tOrder=""%d"" tilt angle alpha0="GFORMDEF")\n"
-				                                      "\tCenter position: "GFORMDEF3V,n0,alpha0,COMP3V(beam_center_0));
-			}
-			return;
-		case B_READ:
-			// the safest is to assume cancellation of all symmetries
-			symX=symY=symZ=symR=false;
-			if (surface) inc_scale=1; // since we can't know it, we assume the default case
-			if (IFROOT) {
-				if (beam_Npars==1) sprintf(beam_descr,"specified by file '%s'",beam_fnameY);
-				else sprintf(beam_descr,"specified by files '%s' and '%s'",beam_fnameY,beam_fnameX);
-			}
-			// we do not define beam_asym here, because beam_center is not defined anyway
-			return;
-	}
-	LogError(ONE_POS,"Unknown type of incident beam (%d)",(int)beamtype);
-	/* TO ADD NEW BEAM
-	 * add a case above. Identifier ('B_...') should be defined inside 'enum beam' in const.h. The case should
-	 * 1) save all the input parameters from array 'beam_pars' to local variables (defined in the beginning of this
-	 *    source files)
-	 * 2) test all input parameters (for that you're encouraged to use functions from param.h since they would
-	 *    automatically produce informative output in case of error).
-	 * 3) the symmetry breaking due to prop or beam_center is taken care of in VariablesInterconnect() in param.c.
-	 *    But if there are other reasons why beam would break any symmetry, corresponding variable should be set to
-	 *    false here. Do not set any of them to true, as they can be set to false by other factors.
-	 *    symX, symY, symZ - symmetries of reflection over planes YZ, XZ, XY respectively.
-	 *    symR - symmetry of rotation for 90 degrees over the Z axis
-	 * 4) initialize the following:
-	 *    beam_descr - descriptive string, which will appear in log file.
-	 *    beam_asym - whether beam center does not coincide with the reference frame origin. If it is set to true, then
-	 *                set also beam_center_0 - 3D radius-vector of beam center in the laboratory reference frame (it
-	 *                will be then automatically transformed to particle reference frame, if required).
-	 * 5) Consider the case of surface (substrate near the particle). If the new beam type is incompatible with it, add
-	 *    an explicit exception, like "if (surface) PrintErrorHelp(...);". Otherwise, you also need to define inc_scale.
-	 * All other auxiliary variables, which are used in beam generation (GenerateB(), see below), should be defined in
-	 * the beginning of this file. If you need temporary local variables (which are used only in this part of the code),
-	 * define them in the beginning of this function.
-	 */
-}
-
-//======================================================================================================================
-
-void GenerateB (const enum incpol which,   // x - or y polarized incident light
-                doublecomplex *restrict b) // the b vector for the incident field
-// generates incident beam at every dipole
-{
-	size_t i,j;
-	doublecomplex psi0,Q,Q2;
-	doublecomplex v1[3],v2[3],v3[3],gt[6];
-	double ro, ro2,ro4;
-	double x,y,z,x2_s,xy_s,phi;
-	doublecomplex t1,t2,t3,t4,t5,t6,t7,t8,ctemp;
-	const double *ex; // coordinate axis of the beam reference frame
-	double ey[3];
-	double r1[3];
-	double jn2[2];
-	const char *fname;
-	/* TO ADD NEW BEAM
-	 * Add here all intermediate variables, which are used only inside this function. You may as well use 't1'-'t8'
-	 * variables defined above.
-	 */
-
-	// set reference frame of the beam; ez=prop, ex - incident polarization
-	if (which==INCPOL_Y) {
-		ex=incPolY;
-		vMultScal(-1,incPolX,ey);
-	}
-	else { // which==INCPOL_X
-		ex=incPolX;
-		vCopy(incPolY,ey);
-	}
-
-	switch (beamtype) {
-		case B_PLANE: // plane is separate to be fast (for non-surface)
-			if (surface) {
-				/* With respect to normalization we use here the same assumption as in the free space - the origin is in
-				 * the particle center, and amplitude of incoming plane wave is equal to 1. Then irradiance of the beam
-				 * coming from below is c*Re(msub)/(8pi), different from that coming from above.
-				 * Original incident (incoming) beam propagating from the vacuum (above) is Exp(i*k*r.a), while - from
-				 * the substrate (below) is Exp(i*k*msub*r.a). We assume that the incoming beam is homogeneous in its
-				 * original medium.
-				 */
-				doublecomplex rc,tc; // reflection and transmission coefficients
-				if (prop[2]>0) { // beam comes from the substrate (below)
-					//  determine amplitude of the reflected and transmitted waves; here msub is always defined
-					if (which==INCPOL_Y) { // s-polarized
-						cvBuildRe(ex,eIncRefl);
-						cvBuildRe(ex,eIncTran);
-						rc=FresnelRS(ki,kt);
-						tc=FresnelTS(ki,kt);
-					}
-					else { // p-polarized
-						vInvRefl_cr(ex,eIncRefl);
-						crCrossProd(ey,ktVec,eIncTran);
-						rc=FresnelRP(ki,kt,1/msub);
-						tc=FresnelTP(ki,kt,1/msub);
-					}
-					// phase shift due to the origin at height hsub
-					cvMultScal_cmplx(rc*cexp(-2*I*WaveNum*ki*hsub),eIncRefl,eIncRefl);
-					cvMultScal_cmplx(tc*cexp(I*WaveNum*(kt-ki)*hsub),eIncTran,eIncTran);
-					// main part
-					for (i=0;i<local_nvoid_Ndip;i++) {
-						j=3*i;
-						// b[i] = eIncTran*exp(ik*kt.r)
-						cvMultScal_cmplx(cexp(I*WaveNum*crDotProd(ktVec,DipoleCoord+j)),eIncTran,b+j);
-					}
-				}
-				else if (prop[2]<0) { // beam comes from above the substrate
-					// determine amplitude of the reflected and transmitted waves
-					if (which==INCPOL_Y) { // s-polarized
-						cvBuildRe(ex,eIncRefl);
-						if (msubInf) rc=-1;
-						else {
-							cvBuildRe(ex,eIncTran);
-							rc=FresnelRS(ki,kt);
-							tc=FresnelTS(ki,kt);
-						}
-					}
-					else { // p-polarized
-						vInvRefl_cr(ex,eIncRefl);
-						if (msubInf) rc=1;
-						else {
-							crCrossProd(ey,ktVec,eIncTran);
-							cvMultScal_cmplx(1/msub,eIncTran,eIncTran); // normalize eIncTran by ||ktVec||=msub
-							rc=FresnelRP(ki,kt,msub);
-							tc=FresnelTP(ki,kt,msub);
-						}
-					}
-					// phase shift due to the origin at height hsub
-					cvMultScal_cmplx(rc*imExp(2*WaveNum*ki*hsub),eIncRefl,eIncRefl);
-					if (!msubInf) cvMultScal_cmplx(tc*cexp(I*WaveNum*(ki-kt)*hsub),eIncTran,eIncTran);
-					// main part
-					for (i=0;i<local_nvoid_Ndip;i++) {
-						j=3*i;
-						// b[i] = ex*exp(ik*r.a) + eIncRefl*exp(ik*prIncRefl.r)
-						cvMultScal_RVec(imExp(WaveNum*DotProd(DipoleCoord+j,prop)),ex,b+j);
-						cvLinComb1_cmplx(eIncRefl,b+j,imExp(WaveNum*DotProd(DipoleCoord+j,prIncRefl)),b+j);
-					}
-				}
-			}
-			else for (i=0;i<local_nvoid_Ndip;i++) { // standard (non-surface) plane wave
-				j=3*i;
-				ctemp=imExp(WaveNum*DotProd(DipoleCoord+j,prop)); // ctemp=exp(ik*r.a)
-				cvMultScal_RVec(ctemp,ex,b+j); // b[i]=ctemp*ex
-			}
-			return;
-		case B_DIPOLE: {
-			double dip_p[3]; // dipole moment, = p0*prop
-			vMultScal(p0,prop,dip_p);
-			for (i=0;i<local_nvoid_Ndip;i++) { // here we explicitly use that dip_p is real
-				j=3*i;
-				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
-				(*InterTerm_real)(r1,gt);
-				cSymMatrVecReal(gt,dip_p,b+j);
-				if (surface) { // add reflected field
-					r1[2]=DipoleCoord[j+2]+beam_center[2]+2*hsub;
-					(*ReflTerm_real)(r1,gt);
-					cReflMatrVecReal(gt,dip_p,v1);
-					cvAdd(v1,b+j,b+j);
-				}
-			}
-			/* calculate dipole inherent cross sections (for decay rate enhancements)
-			 * General formula is C0=4pi*k*Im(p0*.G(r0,r0).p0) and it is used for reflection; but for direct
-			 * interaction it is expected to be singular, so we use an explicit formula for point dipole:
-			 * C0=(8pi/3)*k^4*|p0|^2. Thus we discard the choice of "-int ...", but still the used value should be
-			 * correct for most formulations, e.g. poi, fcd, fcd_st, igt_so. Moreover, it is also logical, since the
-			 * exciting dipole is really point one, in contrast to the dipoles composing the particle.
-			 */
-			double temp=p0*WaveNum*WaveNum; // in principle, t1=1/k, but we keep a general formula
-			C0dipole=2*FOUR_PI_OVER_THREE*temp*temp;
-			if (surface) {
-				r1[0]=r1[1]=0;
-				r1[2]=2*(beam_center[2]+hsub);
-				(*ReflTerm_real)(r1,gt);
-				double tmp;
-				/* the following expression uses that dip_p is real and a specific (anti-)symmetry of the gt
-				 * a general expression is commented out below
-				 */
-				tmp=dip_p[0]*dip_p[0]*cimag(gt[0])+2*dip_p[0]*dip_p[1]*cimag(gt[1])+dip_p[1]*dip_p[1]*cimag(gt[3])
-				   +dip_p[2]*dip_p[2]*cimag(gt[5]);
-//				v1[0]=dip_p[0]; v1[1]=dip_p[1]; v1[2]=dip_p[2];
-//				cReflMatrVec(gt,v1,v2);
-//				tmp=cDotProd_Im(v2,v1);
-				C0dipole_refl=FOUR_PI*WaveNum*tmp;
-			}
-			return;
-		}
-		case B_LMINUS:
-		case B_DAVIS3:
-		case B_BARTON5:
-			for (i=0;i<local_nvoid_Ndip;i++) {
-				j=3*i;
-				// set relative coordinates (in beam's coordinate system)
-				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
-				x=DotProd(r1,ex)*scale_x;
-				y=DotProd(r1,ey)*scale_x;
-				z=DotProd(r1,prop)*scale_z;
-				ro2=x*x+y*y;
-				Q=1/(2*z-I);
-				psi0=-I*Q*cexp(I*Q*ro2);
-				// ctemp=exp(ik*z0)*psi0, z0 - non-scaled coordinate (z/scale_z)
-				ctemp=imExp(WaveNum*z/scale_z)*psi0;
-				// the following logic (if-else-if...) is hard to replace by a simple switch
-				if (beamtype==B_LMINUS) cvMultScal_RVec(ctemp,ex,b+j); // b[i]=ctemp*ex
-				else {
-					x2_s=x*x/ro2;
-					Q2=Q*Q;
-					ro4=ro2*ro2;
-					// some combinations that are used more than once
-					t4=s2*ro2*Q2; // t4=(s*ro*Q)^2
-					t5=I*ro2*Q;   // t5=i*Q*ro^2
-					t6=ro4*Q2;    // t6=ro^4*Q^2
-					t7=x*s*Q;     // t7=x*s*Q
-					if (beamtype==B_DAVIS3) {
-						// t1=1+s^2(-4Q^2*x^2-iQ^3*ro^4)=1-t4(4x2_s+t5)
-						t1 = 1 - t4*(4*x2_s+t5);
-						// t2=0
-						t2=0;
-						// t3=-s(2Qx)+s^3(8Q^3*ro^2*x+2iQ^4*ro^4*x-4iQ^2x)=2t7[-1+iQ*s2*(-4t5+t6-2)]
-						t3 = 2*t7*(-1 + I*Q*s2*(-4*t5+t6-2));
-					}
-					else if (beamtype==B_BARTON5) {
-						xy_s=x*y/ro2;
-						t8=8+2*t5; // t8=8+2i*Q*ro^2
-						/* t1 = 1 + s^2(-ro^2*Q^2-i*ro^4*Q^3-2Q^2*x^2)
-						 *    + s^4[2ro^4*Q^4+3iro^6*Q^5-0.5ro^8*Q^6+x^2(8ro^2*Q^4+2iro^4*Q^5)]
-						 *    = 1 + t4*{-1-2x2_s-t5+t4*[2+3t5-0.5t6+x2_s*t8]}
-						 */
-						t1 = 1 + t4*(-1 - 2*x2_s - t5 + t4*(2+3*t5-0.5*t6+x2_s*t8));
-						// t2=s^2(-2Q^2*xy)+s^4[xy(8ro^2*Q^4+2iro^4*Q^5)]=xy_s*t4(-2+t4*t8)
-						t2=xy_s*t4*(-2+t4*t8);
-						/* t3 = s(-2Qx) + s^3[(6ro^2*Q^3+2iro^4*Q^4)x] + s^5[(-20ro^4*Q^5-10iro^6*Q^6+ro^8*Q^7)x]
-						 *    = t7{-2+t4[6+2t5+t4(-20-10t5+t6)]}
-						 */
-						t3 = t7*(-2 + t4*(6 + 2*t5 + t4*(-20-10*t5+t6)));
-					}
-					else LogError(ONE_POS,"Inconsistency in beam definition"); // to remove warnings
-					// b[i]=ctemp(ex*t1+ey*t2+ez*t3)
-					cvMultScal_RVec(t1,ex,v1);
-					cvMultScal_RVec(t2,ey,v2);
-					cvMultScal_RVec(t3,prop,v3);
-					cvAdd2Self(v1,v2,v3);
-					cvMultScal_cmplx(ctemp,v1,b+j);
-				}
-			}
-			return;
-		case B_BESSELCS:
-		case B_BESSELLE:
-		case B_BESSELLM:
-		case B_BESSELTEC:
-		case B_BESSELTMC:
-			for (i=0;i<local_nvoid_Ndip;i++) {
-				j=3*i;
-				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
-				x=DotProd(r1,ex);
-				y=DotProd(r1,ey);
-				z=DotProd(r1,prop);
-				ro=sqrt(x*x+y*y);	// radial distance in a cilindrical coordinate system
-				phi=atan(y/x);		// angular coordinate in a cilindrical coordinate system
-				t1=WaveNum*sin(alpha0);
-				t2=WaveNum*cos(alpha0);
-				// common factor
-				ctemp=cpow(-I,n0)*cexp(I*n0*phi)*cexp(-I*t2*z);
-				bessjn2(n0,ro*t1,jn2);
-				// field components (see J.J. Wang et.al./JQSRT 184 2016 218-232 [7])
-				switch (beamtype) {
-					case B_BESSELCS:
-						t3=1/2/ro/ro*(jn2[1]*t1*ro*(cos(2*phi)+I*n0*sin(2*phi)) + 
-							jn2[0]*(cexp(-2*I*phi)*(n0-1)*n0+cpow(WaveNum*ro,2)*(cos(alpha0)+
-								pow(cos(alpha0)*cos(phi),2)+pow(sin(phi),2))));
-						t4=1/8/ro/ro*(jn2[1]*4*t1*ro*(-I*n0*cos(2*phi)+sin(2*phi)) +
-							jn2[0]*(4*I*(n0-1)*n0*cos(2*phi)+(4*(n0-1)*n0-
-								cpow(WaveNum*ro,2)*(cos(2*alpha0)-1))*sin(2*phi)));
-						t5=I/2/ro*(WaveNum+t2)*cexp(-I*phi)*(jn2[1]*cexp(I*phi)*ro*t1*cos(phi) -
-							jn2[0]*n0);
-						break;
-					case B_BESSELLE:
-						t3=jn2[0]*t2*WaveNum;
-						t4=0;
-						t5=WaveNum*I*(jn2[1]*t1*cos(phi) -
-							jn2[0]*cexp(-I*phi)/ro*n0);
-						break;
-					case B_BESSELLM:
-						t3=1/ro/ro*(jn2[1]*t1*ro*(I*n0*cos(2*phi)-sin(2*phi)) +
-							jn2[0]*4*(-4*I*(n0-1)*n0*cos(2*phi)+(-4*(n0-1)*n0+
-								cpow(WaveNum*ro,2)*(1-cos(2*alpha0)))*sin(2*phi)));
-						t4=1/4/ro/ro*(jn2[1]*4*t1*ro*(cos(2*phi)+I*n0*sin(2*phi)) -
-							jn2[0]*((-4*(n0-1)*n0 + cpow(WaveNum*ro,2))*cos(2*phi)+
-								cpow(WaveNum*ro,2)*(3+2*cos(2*alpha0)*pow(sin(phi),2))+4*I*(n0-1)*n0*sin(2*phi)));
-						t5=-1/ro*t2*(jn2[1]*I*ro*t1*sin(phi) +
-							jn2[0]*n0*cexp(-I*phi));
-						break;
-					case B_BESSELTEC:
-						t3=1/2/ro/ro*(jn2[1]*ro*WaveNum*(-I*n0*cos(2*phi)+sin(2*phi)) +
-							jn2[0]*(2*I*(n0-1)*n0*cexp(-2*I*phi)/sin(alpha0)+
-								cpow(WaveNum*ro,2)*(2*I*cos(alpha0)/tan(alpha0)-sin(alpha0)*sin(2*phi))));
-						t4=1/ro/ro*(-jn2[1]*ro*WaveNum*(cos(2*phi)+I*n0*sin(2*phi)) +
-							jn2[0]*(-(n0-1)*n0*cexp(-2*I*phi)/sin(alpha0)+
-								cpow(WaveNum*ro,2)/sin(alpha0)*(1-pow(sin(alpha0)*sin(phi),2))));
-						t5=-1/ro*cexp(-I*phi)*t2/sin(alpha0)*(jn2[1]*ro*t1 -
-							jn2[0]*2*n0);
-						break;
-					case B_BESSELTMC:
-						t3=1/ro/ro*(jn2[1]*ro*t2*(n0*cos(2*phi)+I*sin(2*phi)) +
-							jn2[0]*(-cexp(-2*I*phi)*(n0-1)*n0/tan(alpha0)-
-								cpow(WaveNum*ro,2)*(1/tan(alpha0)+I/4*sin(2*alpha0)*sin(2*phi))));
-						t4=-I/ro/ro/tan(alpha0)*(jn2[1]*ro*t1*(cos(2*phi)+I*n0*sin(2*phi)) -
-							jn2[0]/4*((cpow(WaveNum*ro,2)-4*(n0-1)*n0)*pow(cos(phi),2)+
-								cpow(WaveNum*ro,2)*(3+2*cos(2*alpha0)*pow(sin(phi),2))+4*I*(n0-1)*n0*sin(2*phi)));
-						t5=I/2*WaveNum*cexp(-I*phi)*(-jn2[1]*2*WaveNum*cexp(I*phi)*(cos(phi)-
-								I*pow(cos(alpha0),2)*sin(phi)) +
-							jn2[0]*n0*(3+cos(2*alpha0))/ro/sin(alpha0));
-						break;
-					default: break;
-				}
-				cvMultScal_RVec(t3,ex,v1);
-				cvMultScal_RVec(t4,ey,v2);
-				cvMultScal_RVec(t5,prop,v3);
-				cvAdd2Self(v1,v2,v3);
-				cvMultScal_cmplx(ctemp,v1,b+j);
-			}
-			return;
-		case B_READ:
-			if (which==INCPOL_Y) fname=beam_fnameY;
-			else fname=beam_fnameX; // which==INCPOL_X
-			ReadField(fname,b);
-			return;
-	}
-	LogError(ONE_POS,"Unknown type of incident beam (%d)",(int)beamtype);
-	/* TO ADD NEW BEAM
-	 * add a case above. Identifier ('B_...') should be defined inside 'enum beam' in const.h. This case should set
-	 * complex vector 'b', describing the incident field in the particle reference frame. It is set inside the cycle for
-	 * each dipole of the particle and is calculated using
-	 * 1) 'DipoleCoord' – array of dipole coordinates;
-	 * 2) 'prop' – propagation direction of the incident field;
-	 * 3) 'ex' – direction of incident polarization;
-	 * 4) 'ey' – complementary unity vector of polarization (orthogonal to both 'prop' and 'ex');
-	 * 5) 'beam_center' – beam center in the particle reference frame (automatically calculated from 'beam_center_0'
-	 *                    defined in InitBeam).
-	 * If the new beam type is compatible with '-surf', include here the corresponding code. For that you will need
-	 * the variables, related to surface - see vars.c after "// related to a nearby surface".
-	 * If you need temporary local variables (which are used only in this part of the code), either use 't1'-'t8' or
-	 * define your own (with more informative names) in the beginning of this function.
-	 */
-}
diff --git a/const.h b/const.h
deleted file mode 100644
index 2e560f63..00000000
--- a/const.h
+++ /dev/null
@@ -1,430 +0,0 @@
-/* File: const.h
- * $Date::                            $
- * Descr: all the constants used by ADDA code, including enum constants, also defines some useful macros
- *
- * Copyright (C) 2006-2014 ADDA contributors
- * This file is part of ADDA.
- *
- * ADDA is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as
- * published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
- *
- * ADDA is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- * of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along with ADDA. If not, see
- * <http://www.gnu.org/licenses/>.
- */
-#ifndef __const_h
-#define __const_h
-
-// version number (string)
-#define ADDA_VERSION "1.4.0-alpha"
-
-/* ADDA uses certain C99 extensions, which are widely supported by GNU and Intel compilers. However, they may be not
- * completely supported by e.g. Microsoft Visual Studio compiler. Therefore, we check the version of the standard here
- * and produce a strong warning, if it is not satisfied. The list of C99 features, used by ADDA, include (but may be not
- * limited to): stdbool.h, snprintf, %z argument in printf, '//' comments, restricted pointers, variadic macros
-*/
-# if !defined(OVERRIDE_STDC_TEST) && (!defined(__STDC_VERSION__) || (__STDC_VERSION__ < 199901L))
-#   error "Support for C99 standard (at least many of its parts) is strongly recommended for compilation. Otherwise \
-	the compilation will may fail or produce wrong results. If you still want to try, you may enable an override in \
-	the Makefile."
-#endif
-
-/* The following is to ensure that mingw64 with "-std=c99" will use c99-compliant printf-family functions. For some
- * (philosophical) reasons mingw64 developers have not implemented this behavior as the default one. So we need to set
- * it manually. This macro should be defined before any system includes, hence inclusion of "const.h" should be the
- * first one in all sources. This is also convenient for testing c99 standard above. However, there is no simple way
- * then to test for MinGW64 at this point, since, e.g., __MINGW64_VERSION_STR is defined by the system header (not by
- * the compiler itself). So the code executes always. Not the most reliable way, but seems the only way to keep the
- * following definition in one place.
- */
-#if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L)
-#	define __USE_MINGW_ANSI_STDIO 1
-#endif
-
-// basic constants
-#define UNDEF -1 // should be used only for variables, which are naturally non-negative
-	// denotes that shape accepts filename arguments; used in definitions of options
-#define FNAME_ARG     -2  // single filename
-#define FNAME_ARG_2   -3  // two filenames
-#define FNAME_ARG_1_2 -4  // 1 or 2 filenames
-	// macro to test for occurrence of one of FNAME_ARG
-#define IS_FNAME_ARG(A) (((A)==FNAME_ARG) || ((A)==FNAME_ARG_2) || ((A)==FNAME_ARG_1_2))
-
-// simple functions
-#define MIN(A,B) (((A) > (B)) ? (B) : (A))
-#define MAX(A,B) (((A) < (B)) ? (B) : (A))
-#define MAXIMIZE(A,B) {if ((A)<(B)) (A)=(B);}
-#define IS_EVEN(A) (((A)%2) == 0)
-#define DIV_CEILING(A,B) (((A)%(B)==0) ? (A)/(B) : ((A)/(B))+1 ) // valid only for nonnegative A and B
-#define LENGTH(A) ((int)(sizeof(A)/sizeof(A[0]))) // length of any array (converted to int)
-#define STRINGIFY(A) #A
-#define GREATER_EQ2(a1,a2,b1,b2) ( (a1)>(b1) || ( (a1)==(b1) && (a2)>=(b2) )) // a1.a2>=b1.b2
-
-// parallel definitions
-#ifdef ADDA_MPI
-#	define PARALLEL
-#endif
-
-/* ringid of root processor. Using ADDA_ROOT!=0 should work, however it was not thoroughly tested. Hence do not change
- * without necessity.
- */
-#define ADDA_ROOT 0
-
-// math constants rounded for 32 decimals; C99 standard specifies that they are encoded as double
-#define PI                  3.1415926535897932384626433832795
-#define TWO_PI              6.283185307179586476925286766559
-#define FOUR_PI             12.566370614359172953850573533118
-#define EIGHT_PI            25.132741228718345907701147066236
-#define FOUR_PI_OVER_THREE  4.1887902047863909846168578443727
-#define PI_OVER_TWO         1.5707963267948966192313216916398
-#define PI_OVER_FOUR        0.78539816339744830961566084581988
-#define PI_OVER_SIX         0.52359877559829887307710723054658
-#define INV_PI              0.31830988618379067153776752674503
-#define TWO_OVER_PI         0.63661977236758134307553505349006
-#define THREE_OVER_FOUR_PI  0.23873241463784300365332564505877
-#define SIX_OVER_PI         1.9098593171027440292266051604702
-#define ONE_THIRD           0.33333333333333333333333333333333
-#define PI_OVER_180         0.017453292519943295769236907684886
-#define INV_PI_180          57.295779513082320876798154814105
-#define SQRT_PI             1.7724538509055160272981674833411
-#define TWO_OVER_SQRT_PI    1.1283791670955125738961589031215
-#define SQRT2               1.4142135623730950488016887242097
-#define SQRT3               1.7320508075688772935274463415059
-#define SQRT1_2             0.70710678118654752440084436210485
-#define SQRT1_2PI           0.39894228040143267793994605993438
-#define SQRT2_9PI           0.26596152026762178529329737328959
-#define EULER               0.57721566490153286060651209008241
-#define FULL_ANGLE          360.0
-#define MICRO               1E-6
-
-// sets the maximum box size; otherwise 'position' should be changed
-#define BOX_MAX USHRT_MAX
-
-// sizes of some arrays
-#define MAX_NMAT         15   // maximum number of different refractive indices (<256)
-#define MAX_N_SH_PARMS   25   // maximum number of shape parameters
-#define MAX_N_BEAM_PARMS 10   // maximum number of beam parameters
-
-// sizes of filenames and other strings
-/* There is MAX_PATH constant that equals 260 on Windows. However, even this OS allows ways to override this limit. On
- * POSIX this constant may be much larger and have even less reliability. So the values below are conservatively high,
- * but are not guaranteed to suffice. However, the functions in the code are designed to survive if this buffer won't
- * suffice.
- */
-#define MAX_DIRNAME      300 // maximum length of dirname; increase THIS if any errors appear
-#define MAX_FNAME_SH     100 // maximum length of filename (used for known names)
-#define MAX_TMP_FNAME_SH  15 // maximum length of names of temporary files (short)
-#define MAX_SYSTEM_CALL   10 // maximum string length of system call (itself)
-#define MAX_WORD          10 // maximum length of a short word
-#define MAX_LINE         100 // maximum length of a line
-#define BUF_LINE         300 // size of buffer for reading lines (longer lines are handled robustly)
-#define MAX_PARAGRAPH    600 // maximum length of a paragraph (few lines)
-
-// derived sizes
-	// maximum string to create directory
-#define MAX_DIRSYS  (MAX_DIRNAME + MAX_SYSTEM_CALL)
-	// maximum length of filename (including directory name)
-#define MAX_FNAME   (MAX_DIRNAME + MAX_FNAME_SH)
-	// maximum length of temporary filename (including directory name)
-#define MAX_TMP_FNAME   (MAX_DIRNAME + MAX_TMP_FNAME_SH)
-	// maximum message that may include a filename (for PrintError)
-#define MAX_MESSAGE (MAX_FNAME + MAX_PARAGRAPH)
-	// maximum message that may include 2 filenames (for LogError)
-#define MAX_MESSAGE2 (2*MAX_FNAME + MAX_PARAGRAPH)
-
-// widths of terminal used for output
-#define DEF_TERM_WIDTH 80 // default
-#define MIN_TERM_WIDTH 20 // ADDA never takes value less than that from environmental variables
-
-// formats for outputs of float values
-#define EFORM "%.10E"        // fixed width
-#define GFORM "%.10g"        // variable width (showing significant digits)
-#define GFORMDEF "%g"        // default output for non-precise values
-#define GFORM_DEBUG "%.2g"   // for debug and error output
-#define CFORM "%.10g%+.10gi" // for complex numbers; may be defined in terms of GFORM
-	// derived formats; starting "" is to avoid redundant syntax errors in Eclipse
-#define GFORM3V "("GFORM","GFORM","GFORM")"
-#define GFORM3L ""GFORM" "GFORM" "GFORM
-#define GFORM6L ""GFORM" "GFORM" "GFORM" "GFORM" "GFORM" "GFORM
-#define GFORM7L ""GFORM" "GFORM" "GFORM" "GFORM" "GFORM" "GFORM" "GFORM
-#define GFORM10L ""GFORM" "GFORM" "GFORM" "GFORM" "GFORM" "GFORM" "GFORM" "GFORM" "GFORM" "GFORM
-#define GFORMDEF3V "("GFORMDEF","GFORMDEF","GFORMDEF")"
-#define CFORM3V "("CFORM","CFORM","CFORM")"
-	// macros to shorten printing of all vector components
-#define COMP3V(a) (a)[0],(a)[1],(a)[2]
-#define COMP16V(a) (a)[0],(a)[1],(a)[2],(a)[3],(a)[4],(a)[5],(a)[6],(a)[7],(a)[8],(a)[9],(a)[10],(a)[11],(a)[12],\
-	(a)[13],(a)[14],(a)[15]
-
-enum sh { // shape types
-	SH_AXISYMMETRIC, // axisymmetric
-	SH_BICOATED,     // two coated spheres
-	SH_BIELLIPSOID,  // two general ellipsoids
-	SH_BISPHERE,     // two spheres
-	SH_BOX,          // box (may be rectangular)
-	SH_CAPSULE,      // capsule
-	SH_CHEBYSHEV,    // Chebyshev particle (axisymmetric)
-	SH_COATED,       // coated sphere
-	SH_CYLINDER,     // cylinder
-	SH_EGG,          // egg
-	SH_ELLIPSOID,    // general ellipsoid
-	SH_LINE,         // line with width of one dipole
-	SH_PLATE,        // plate
-	SH_PRISM,        // right rectangular prism
-	SH_RBC,          // Red Blood Cell
-	SH_READ,         // read from file
-	//SH_SDISK_ROT,  // disc cut of a sphere -- not operational
-	SH_SPHERE,       // sphere
-	SH_SPHEREBOX     // sphere in a box
-	/* TO ADD NEW SHAPE
-	 * add an identifier starting with 'SH_' and a descriptive comment to this list in alphabetical order.
-	 */
-};
-
-enum pol { // which way to calculate coupleconstant
-	POL_CLDR,    // Corrected Lattice Dispersion Relation
-	POL_CM,      // Clausius-Mossotti
-	POL_DGF,     // Digitized Green's Function (second order approximation of LAK)
-	POL_FCD,     // Filtered Coupled Dipoles
-	POL_IGT_SO,  // Second order approximation to Green's tensor integrated over a cube
-	POL_LAK,     // Exact result of IGT for sphere
-	POL_LDR,     // Lattice Dispersion Relation
-	POL_NLOC,    // non-local extension (Gaussian dipole-density, formula based on lattice sums)
-	POL_NLOC_AV, // same as NLOC, but based on averaging of Gaussian over the dipole volume
-	POL_RRC,     // Radiative Reaction correction
-	POL_SO       // Second Order formulation
-	/* TO ADD NEW POLARIZABILITY FORMULATION
-	 * add an identifier starting with 'POL_' and a descriptive comment to this list in the alphabetical order.
-	 */
-};
-// in alphabetical order
-
-enum scat { // how to calculate scattering quantities
-	SQ_DRAINE, // classical, as Draine
-	SQ_FINDIP, /* Same as Draine, but with correction of radiation energy of a _finite_ dipole when calculating
-	              absorption cross section */
-	SQ_IGT_SO, // Integration of Green's tensor (second order in kd approximation)
-	SQ_SO      // Second Order formulation
-};
-// in alphabetical order
-
-enum inter { // how to calculate interaction term
-	G_FCD,       // Filtered Green's tensor (Filtered Coupled Dipoles)
-	G_FCD_ST,    // quasi-static version of FCD
-	G_IGT,       // (direct) integration of Green's tensor
-	G_IGT_SO,    // approximate integration of Green's tensor (based on ideas of SO)
-	G_NLOC,      // non-local extension (interaction of Gaussian dipole-densities)
-	G_NLOC_AV,   // same as NLOC, but based on averaging of Gaussian over the dipole volume
-	G_POINT_DIP, // as point dipoles
-	G_SO         // Second Order formulation
-	/* TO ADD NEW INTERACTION FORMULATION
-	 * add an identifier starting with 'G_' and a descriptive comment to this list in the alphabetical order.
-	 */
-};
-enum refl { // how to calculate interaction of dipoles through the nearby surface (reflected G)
-	GR_IMG,       // approximate expression based on a single image dipole
-	GR_SOM        // direct evaluation of Sommerfeld integrals
-	/* TO ADD NEW REFLECTION FORMULATION
-	 * add an identifier starting with 'GR_' and a descriptive comment to this list in the alphabetical order.
-	 */
-};// in alphabetical order
-
-// ldr constants
-#define LDR_B1  1.8915316
-#define LDR_B2 -0.1648469
-#define LDR_B3  1.7700004
-
-// 2nd_order constants; derived from c1=ln(5+3^(3/2))-ln(2)/2-pi/4 and c2=pi/6
-#define SO_B1 1.5867182426530356710958782335228 // 4c1/3
-#define SO_B2 0.13488017286410948123541594310740 // c1/3 - c2/2
-#define SO_B3 0.11895825700597042937085940122438 // (5/2)c1 - c2
-
-// other constants for polarizability
-#define DGF_B1 1.6119919540164696407169668466385  // (4pi/3)^(1/3)
-#define LAK_C  0.62035049089940001666800681204778 // (4pi/3)^(-1/3)
-
-// two boundaries for separation between G_SO 'close', 'median', and 'far'
-#define G_BOUND_CLOSE  1 // k*R^2/d < GB_CLOSE => 'close'
-#define G_BOUND_MEDIAN 1 // k*R < GB_MEDIAN => 'median'
-
-enum iter { // iterative methods
-	IT_BCGS2,    // Enhanced Bi-Conjugate Gradient Stabilized (2)
-	IT_BICG_CS,  // Bi-Conjugate Gradient for Complex-Symmetric matrices
-	IT_BICGSTAB, // Bi-Conjugate Gradient Stabilized
-	IT_CGNR,     // Conjugate Gradient for Normalized equations minimizing Residual norm
-	IT_CSYM,     // Algorithm CSYM
-	IT_QMR_CS,   // Quasi-minimal residual for Complex-Symmetric matrices
-	IT_QMR_CS_2  // 2-term QMR (better roundoff properties)
-	/* TO ADD NEW ITERATIVE SOLVER
-	 * add an identifier starting with 'IT_' and a descriptive comment to this list in the alphabetical order.
-	 */
-};
-
-enum Eftype { // type of E field calculation
-	CE_NORMAL, // normal
-	CE_PARPER  // use symmetry to calculate both incident polarizations from one calculation of internal fields
-};
-
-enum incpol {
-	INCPOL_Y, // y-polarization, assumed to be used first
-	INCPOL_X  // x-polarization
-};
-// path and size of tables
-#define TAB_PATH     "tables/"
-#define TAB_FNAME(a) "t"#a"f.dat" // a is a number, e.g. TAB_FNAME(2) -> "t2f.dat"
-#define TAB_SIZE     142
-#define TAB_RMAX     10
-
-enum beam { // beam types
-	B_BARTON5, // 5th order description of the Gaussian beam
-	B_BESSELCS, // Bessel beam with circularky symmetric energy density
-	B_BESSELLE, // Bessel beam with linearly polarized electric field
-	B_BESSELLM, // Bessel beam with linearly polarized magnetic field
-	B_BESSELTEC, // Bessel beam forming TE Bessel beam 
-	B_BESSELTMC, // Bessel beam forming TM Bessel beam 
-	B_DAVIS3,  // 3rd order description of the Gaussian beam
-	B_DIPOLE,  // field of a point dipole
-	B_LMINUS,  // 1st order description of the Gaussian beam
-	B_PLANE,   // infinite plane wave
-	B_READ     // read from file
-	/* TO ADD NEW BEAM
-	 * add an identifier starting with 'B_' and a descriptive comment to this list in alphabetical order.
-	 */
-};
-
-enum scatgrid { // types of scattering grid
-	SG_GRID, // grid of angles
-	SG_PAIRS // set of independent pairs
-};
-enum angleset {// types of angles set
-	AS_RANGE, // range with uniformly spaced points
-	AS_VALUES // any set of values
-};
-
-// types of phi_integr (should be different one-bit numbers)
-#define PHI_UNITY 1 // just integrate
-#define PHI_COS2  2 // integrate with cos(2*phi)
-#define PHI_SIN2  4 // integrate with sin(2*phi)
-#define PHI_COS4  8 // integrate with cos(4*phi)
-#define PHI_SIN4 16 // integrate with sin(4*phi)
-
-enum sym { // ways to treat particle symmetries
-	SYM_AUTO, // automatic
-	SYM_NO,   // do not take into account
-	SYM_ENF   // enforce
-};
-
-enum chpoint { // types of checkpoint (to save)
-	CHP_NONE,    // do not save checkpoint
-	CHP_NORMAL,  // save checkpoint if not finished in time and exit
-	CHP_REGULAR, // save checkpoints in regular time intervals (until finished or halted)
-	CHP_ALWAYS   /* save checkpoint if either simulation is finished or time elapsed and calculate all scattering
-	                quantities */
-};
-
-enum init_field { // how to calculate initial field to be used in the iterative solver
-	IF_AUTO, // automatically choose from ZERO or INC (based on lower residual value)
-	IF_ZERO, // zero
-	IF_INC,  // equal to incident field
-	IF_READ, // read from file
-	IF_WKB   // from WKB approximation (incident field corrected for phase shift in the particle)
-};
-
-// return values for functions
-#define CHP_EXIT -2 // exit after saving checkpoint
-
-// default values; other are specified in InitVariables (param.c)
-#define DEF_GRID       (16*jagged)
-#define MIN_AUTO_GRID  16 // minimum grid, when set from default dpl
-
-// numbers less than this value (compared to unity) are considered to be zero (approximately 10*DBL_EPSILON)
-#define ROUND_ERR 1E-15
-#define SQRT_RND_ERR 3E-8 // sqrt(ROUND_ERR)
-
-// output and input file and directory names (can only be changed at compile time)
-#define F_EXPCOUNT      "ExpCount"
-#define F_EXPCOUNT_LCK  F_EXPCOUNT ".lck"
-#define F_CS            "CrossSec"
-#define F_FRP           "RadForce"
-#define F_INTFLD        "IntField"
-#define F_DIPPOL        "DipPol"
-#define F_BEAM          "IncBeam"
-#define F_GRANS         "granules"
-	// suffixes
-#define F_XSUF          "-X"
-#define F_YSUF          "-Y"
-	// logs
-#define F_LOG           "log"
-#define F_LOG_ERR       "logerr.%d"    // ringid as argument
-#define F_LOG_ORAVG     "log_orient_avg"
-#define F_LOG_INT_CSCA  "log_int_Csca"
-#define F_LOG_INT_ASYM  "log_int_asym"
-	// log suffixes
-#define F_LOG_X         "_x"
-#define F_LOG_Y         "_y"
-#define F_LOG_Z         "_z"
-	// Mueller files
-#define F_MUEL          "mueller"
-#define F_MUEL_SG       "mueller_scatgrid"
-#define F_MUEL_INT      "mueller_integr"
-#define F_MUEL_C2       "mueller_integr_c2"
-#define F_MUEL_S2       "mueller_integr_s2"
-#define F_MUEL_C4       "mueller_integr_c4"
-#define F_MUEL_S4       "mueller_integr_s4"
-	// files for amplitude matrix
-#define F_AMPL          "ampl"
-#define F_AMPL_SG       "ampl_scatgrid"
-	// temporary files; used in printf with ringid as argument
-#define F_FRP_TMP       "rf%d.tmp"
-#define F_BEAM_TMP      "b%d.tmp"
-#define F_INTFLD_TMP    "f%d.tmp"
-#define F_DIPPOL_TMP    "p%d.tmp"
-#define F_GEOM_TMP      "g%d.tmp"
-	// checkpoint files
-#define F_CHP_LOG       "chp.log"
-#define F_CHP           "chp.%d"   // ringid as argument
-
-// default file and directory names; can be changed by command line options
-#define FD_ALLDIR_PARMS "alldir_params.dat"
-#define FD_AVG_PARMS    "avg_params.dat"
-#define FD_SCAT_PARMS   "scat_params.dat"
-#define FD_CHP_DIR      "chpoint"
-
-/* number of components of D. Really, it can't be easily changed, but using constant instead of 6 adds more
- * understanding for reader
- */
-#define NDCOMP 6
-
-// shape formats; numbers should be nonnegative
-enum shform {
-	SF_DDSCAT6,  // DDSCAT 6 format (FRMFIL), produced by calltarget
-	SF_DDSCAT7,  // DDSCAT 7 format (FRMFIL), produced by calltarget
-	SF_TEXT,     // ADDA text format for one-domain particles
-	SF_TEXT_EXT  // ADDA text format for multi-domain particles
-	/* TO ADD NEW FORMAT OF SHAPE FILE
-	 * add an identifier starting with 'SF_' and a descriptive comment to this list in alphabetical order.
-	 */
-};
-
-#define POSIT __FILE__,__LINE__ // position of the error in source code
-
-enum enwho { // who is calling
-	ALL, // each processor may report this error
-	ONE  // only root processor reports an error
-};
-
-// derived; for simplicity
-#define ALL_POS ALL,POSIT
-#define ONE_POS ONE,POSIT
-#define ALL_POS_FUNC ALL_POS,__func__
-#define ONE_POS_FUNC ONE_POS,__func__
-
-enum ec { // error codes
-	EC_OK,    // no error, corresponds to zero exit code
-	EC_ERROR, // error
-	EC_WARN,  // warning
-	EC_INFO   // slight warning, that does not interfere at all with normal execution
-};
-
-#endif // __const_h
diff --git a/param.c b/param.c
deleted file mode 100644
index fdfc8d22..00000000
--- a/param.c
+++ /dev/null
@@ -1,2583 +0,0 @@
-/* File: param.c
- * $Date::                            $
- * Descr: initialization, parsing and handling of input parameters; also printout general information; contains file
- *        locking routines
- *
- * Copyright (C) 2006-2014 ADDA contributors
- * This file is part of ADDA.
- *
- * ADDA is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as
- * published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
- *
- * ADDA is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- * of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along with ADDA. If not, see
- * <http://www.gnu.org/licenses/>.
- */
-#include "const.h" // keep this first
-#include "param.h" // corresponding header
-// project headers
-#include "cmplx.h"
-#include "comm.h"
-#include "crosssec.h"
-#include "debug.h"
-#include "fft.h"
-#include "function.h"
-#include "io.h"
-#include "oclcore.h"
-#include "os.h"
-#include "parbas.h"
-#include "vars.h"
-// system headers
-#include <ctype.h>
-#include <math.h>
-#include <stdarg.h>
-#include <stdint.h>
-#include <stdlib.h>
-#include <string.h>
-#include <time.h>
-
-#ifdef CLFFT_AMD
-/* One can also include clFFT.h (the only recommended public header), which can be redundant, but more portable.
- * However, version macros are not documented anyway (in the manual), so there seem to be no perfectly portable way to
- * obtain them.
- */
-#	include <clFFT.version.h>
-#endif
-
-#ifdef OCL_BLAS
-/* In contrast to clFFT, here including main header (clBLAS.h) is not an option, since it doesn't include the
- * following header.
- */
-#	include <clBLAS.version.h>
-#endif
-
-#ifndef NO_GITHASH
-#	include "githash.h" // for GITHASH, this file is automatically created during compilation
-#endif
-
-// definitions for file locking
-#ifdef USE_LOCK
-#	ifdef WINDOWS
-#		define FILEHANDLE HANDLE
-#	elif defined(POSIX)
-#		include <unistd.h>
-#		include <fcntl.h>
-#		ifdef LOCK_FOR_NFS
-#			include <errno.h> // for error handling of fcntl call
-#		endif
-#		define FILEHANDLE int
-#	else
-#		error "Unknown operation system. Creation of lock files is not supported."
-#	endif
-#	define LOCK_WAIT 1 // in seconds
-#	define MAX_LOCK_WAIT_CYCLES 60
-#	define ONLY_FOR_LOCK
-#else
-#	define FILEHANDLE int
-#	define ONLY_FOR_LOCK ATT_UNUSED
-#endif
-
-// GLOBAL VARIABLES
-
-opt_index opt; // main option index; it is also defined as extern in param.h
-
-// SEMI-GLOBAL VARIABLES
-
-// defined and initialized in crosssec.c
-extern const char avg_string[];
-// defined and initialized in GenerateB.c
-extern const char beam_descr[];
-// defined and initialized in make_particle.c
-extern const bool volcor_used;
-extern const char *sh_form_str1,*sh_form_str2;
-#ifndef SPARSE
-extern const int gr_N;
-extern const double gr_vf_real;
-#endif //SPARSE
-extern const size_t mat_count[];
-
-// used in CalculateE.c
-bool store_int_field; // save full internal fields to text file
-bool store_dip_pol;   // save dipole polarizations to text file
-bool store_beam;      // save incident beam to file
-bool store_scat_grid; // Store the scattered field for grid of angles
-bool calc_Cext;       // Calculate the extinction cross-section - always do
-bool calc_Cabs;       // Calculate the absorption cross-section - always do
-bool calc_Csca;       // Calculate the scattering cross-section by integration
-bool calc_vec;        // Calculate the unnormalized asymmetry-parameter
-bool calc_asym;       // Calculate the asymmetry-parameter
-bool calc_mat_force;  // Calculate the scattering force by matrix-evaluation
-bool store_force;     // Write radiation pressure per dipole to file
-bool store_ampl;      // Write amplitude matrix to file
-int phi_int_type;     // type of phi integration (each bit determines whether to calculate with different multipliers)
-// used in calculator.c
-bool avg_inc_pol;            // whether to average CC over incident polarization
-double polNlocRp;            // Gaussian width for non-local polarizability
-const char *alldir_parms;    // name of file with alldir parameters
-const char *scat_grid_parms; // name of file with parameters of scattering grid
-// used in crosssec.c
-double incPolX_0[3],incPolY_0[3]; // initial incident polarizations (in lab RF)
-enum scat ScatRelation;           // type of formulae for scattering quantities
-// used in GenerateB.c
-int beam_Npars;
-double beam_pars[MAX_N_BEAM_PARMS]; // beam parameters
-opt_index opt_beam;                 // option index of beam option used
-const char *beam_fnameY;            // names of files, defining the beam (for two polarizations)
-const char *beam_fnameX;
-// used in interaction.c
-double igt_lim; // limit (threshold) for integration in IGT
-double igt_eps; // relative error of integration in IGT
-double nloc_Rp; // Gaussian width for non-local interaction
-bool InteractionRealArgs; // whether interaction (or reflection) routines can be called with real arguments
-// used in io.c
-char logfname[MAX_FNAME]=""; // name of logfile
-// used in iterative.c
-double iter_eps;           // relative error to reach
-enum init_field InitField; // how to calculate initial field for the iterative solver
-const char *infi_fnameY;   // names of files, defining the initial field (for two polarizations)
-const char *infi_fnameX;
-bool recalc_resid;         // whether to recalculate residual at the end of iterative solver
-enum chpoint chp_type;     // type of checkpoint (to save)
-time_t chp_time;           // time of checkpoint (in sec)
-char const *chp_dir;       // directory name to save/load checkpoint
-// used in make_particle.c
-enum sh shape;                   // particle shape definition
-int sh_Npars;                    // number of shape parameters
-double sh_pars[MAX_N_SH_PARMS];  // storage for shape parameters
-double sizeX;                    // size of particle along x-axis
-double dpl;                      // number of dipoles per lambda (wavelength)
-double lambda;                   // incident wavelength (in vacuum)
-int jagged;                      // size of big dipoles, used to construct a particle
-const char *shape_fname;         // name of file, defining the shape
-const char *save_geom_fname;     // geometry file name to save dipole configuration
-const char *shapename;           // name of the used shape
-bool volcor;                     // whether to use volume correction
-bool save_geom;                  // whether to save dipole configuration in .geom file
-opt_index opt_sh;                // option index of shape option used
-double gr_vf;                    // granules volume fraction
-double gr_d;                     // granules diameter
-int gr_mat;                      // domain number to granulate
-double a_eq;                     // volume-equivalent radius of the particle
-enum shform sg_format;           // format for saving geometry files
-bool store_grans;                // whether to save granule positions to file
-
-// LOCAL VARIABLES
-
-#define GFORM_RI_DIRNAME "%.4g" // format for refractive index in directory name
-
-static const char *run_name;    // first part of the dir name ('run' or 'test')
-static const char *avg_parms;   // name of file with orientation averaging parameters
-static const char *exename;     // name of executable (adda, adda.exe, adda_mpi,...)
-static int Nmat_given;          // number of refractive indices given in the command line
-static enum sym sym_type;       // how to treat particle symmetries
-/* The following '..._used' flags are, in principle, redundant, since the structure 'options' contains the same flags.
- * However, the latter can't be easily addressed by the option name (a search over the whole options is required).
- * When thinking about adding a new one, first consider using UNDEF machinery instead
- */
-static bool prop_used;          // whether '-prop ...' was used in the command line
-static bool orient_used;        // whether '-orient ...' was used in the command line
-static bool yz_used;            // whether '-yz ...' was used in the command line
-static bool scat_plane_used;    // whether '-scat_plane ...' was used in the command line
-
-/* TO ADD NEW COMMAND LINE OPTION
- * If you need new variables or flags to implement effect of the new command line option, define them here. If a
- * variable is used only in this source file, define it as local (static). If it is used in one another file, define
- * them as semi-global, i.e. define them here under corresponding 'used in ...' line and put 'extern' declaration in
- * corresponding source file under 'defined and initialized in param.c' line. If it is used in this and two or more
- * files, define it as global, by putting definition in vars.c and 'extern' declaration in vars.h.
- */
-
-// structure definitions
-struct subopt_struct {
-	const char *name;  // name of option
-	const char *usage; // how to use (argument list)
-	const char *help;  // help string
-	const int narg;    /* possible number of arguments; UNDEF -> should not be checked; may contain also some special
-	                      negative codes, like FNAME_ARG. Currently it is assumed that all arguments are float (if no
-	                      special argument is specified), but it can be changed if will become a limitation. */
-	const int type;    // type of suboption
-};
-struct opt_struct {
-	const char *name;                // name of option
-	void (*func)(int Narg,char **argv); // pointer to a function, parsing this parameter
-	bool used;                       // flag to indicate, if the option was already used
-	const char *usage;               // how to use (argument list)
-	const char *help;                // help string
-	const int narg;                  // possible number of arguments; UNDEF -> should not be checked
-	const struct subopt_struct *sub; // suboptions
-};
-// const string for usage of ADDA
-static const char exeusage[]="[-<opt1> [<args1>] [-<opt2> <args2>]...]]";
-
-/* initializations of suboptions (comments to elements of subopt_struct are above); Contrary to 'options', suboptions
- * are defined as null-terminated array, because they may be referenced not directly by their names but also as
- * options[i].sub. In the latter case macro LENGTH can't be used to estimate the length of the array. So getting this
- * length is at least nontrivial (e.g. can be done with some intermediate variables). So using NULL-termination seems
- * to be the easiest.
- */
-static const struct subopt_struct beam_opt[]={
-	{"barton5","<width> [<x> <y> <z>]","5th order approximation of the Gaussian beam (by Barton). The beam width is "
-		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
-		"(zero, by default). All arguments are in um. This is recommended option for simulation of the Gaussian beam.",
-		UNDEF,B_BARTON5},
-	{"besselCS","[<order> <angle> <x> <y> <z>]","Bessel beam with circularky symmetric energy density. The tilt angle "
-			"is measured from the z axis. Arguments x, y, z are coordinates of the "
-			"center of the beam (in laboratory reference frame). Coordinate arguments are in um. All arguments are "
-			"optional (zero, by default).",UNDEF,B_BESSELCS},
-	{"besselLE","[<order> <angle> <x> <y> <z>]","Bessel beam with linearly polarized electric field. The tilt angle is "
-			"measured from the z axis. Arguments x, y, z are coordinates of "
-			"the center of the beam (in laboratory reference frame). Coordinate arguments are in um. All arguments are "
-			"optional (zero, by default).",UNDEF,B_BESSELLE},
-	{"besselLM","[<order> <angle> <x> <y> <z>]","Bessel beam with linearly polarized magnetic field. The tilt angle is "
-			"measured from the z axis. Arguments x, y, z are coordinates of "
-			"the center of the beam (in laboratory reference frame). Coordinate arguments are in um. All arguments are "
-			"optional (zero, by default).",UNDEF,B_BESSELLM},
-	{"besselTEC","[<order> <angle> <x> <y> <z>]","Bessel beam forming TE Bessel beam. The tilt angle is "
-			"measured from the z axis. Arguments x, y, z are coordinates of "
-			"the center of the beam (in laboratory reference frame). Coordinate arguments are in um. All arguments are "
-			"optional (zero, by default).",UNDEF,B_BESSELTEC},
-	{"besselTMC","[<order> <angle> <x> <y> <z>]","Bessel beam forming TM Bessel beam. The tilt angle is "
-			"measured from the z axis. Arguments x, y, z are coordinates of "
-			"the center of the beam (in laboratory reference frame). Coordinate arguments are in um. All arguments are "
-			"optional (zero, by default).",UNDEF,B_BESSELTMC},
-	{"davis3","<width> [<x> <y> <z>]","3rd order approximation of the Gaussian beam (by Davis). The beam width is "
-		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
-		"(zero, by default). All arguments are in um.",UNDEF,B_DAVIS3},
-	{"dipole","<x> <y> <z>","Field of a unit point dipole placed at x, y, z coordinates (in laboratory reference "
-		"frame). All arguments are in um. Orientation of the dipole is determined by -prop command line option."
-		"Implies '-scat_matr none'. If '-surf' is used, dipole position should be above the surface.",3,B_DIPOLE},
-	{"lminus","<width> [<x> <y> <z>]","Simplest approximation of the Gaussian beam. The beam width is obligatory and "
-		"x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional (zero, by"
-		" default). All arguments are in um.",UNDEF,B_LMINUS},
-	{"plane","","Infinite plane wave",0,B_PLANE},
-	{"read","<filenameY> [<filenameX>]","Defined by separate files, which names are given as arguments. Normally two "
-		"files are required for Y- and X-polarizations respectively, but a single filename is sufficient if only "
-		"Y-polarization is used (e.g. due to symmetry). Incident field should be specified in a particle reference "
-		"frame in the same format as used by '-store_beam'.",FNAME_ARG_1_2,B_READ},
-	/* TO ADD NEW BEAM
-	 * add a row to this list in alphabetical order. It contains: beam name (used in command line), usage string, help
-	 * string, possible number of float parameters, beam identifier (defined inside 'enum beam' in const.h). Usage and
-	 * help string are shown either when -h option is invoked or error is found in input command line. Usage string is
-	 * one line giving a list of possible arguments or argument combinations. Do not include beam name in it, use
-	 * <arg_name> to denote argument, [...] for optional arguments, and {...|...|...} for multiple options of an
-	 * argument. Help string should contain general description of the beam type and its arguments. Instead of number
-	 * of parameters UNDEF can be used (if beam can accept variable number of parameters, then check it explicitly in
-	 * function PARSE_FUNC(beam) below) or one of FNAME_ARG family (see explanation in const.h) if beam accepts a
-	 * filenames as arguments. Number of parameters should not be greater than MAX_N_BEAM_PARMS (defined in const.h).
-	 */
-	{NULL,NULL,NULL,0,0}
-};
-static const struct subopt_struct shape_opt[]={
-#ifndef SPARSE
-	{"axisymmetric","<filename>","Axisymmetric homogeneous shape, defined by its contour in ro-z plane of the "
-		"cylindrical coordinate system. Its symmetry axis coincides with the z-axis, and the contour is read from "
-		"file.",FNAME_ARG,SH_AXISYMMETRIC},
-	{"bicoated","<R_cc/d> <d_in/d>","Two identical concentric coated spheres with outer diameter d (first domain), "
-		"inner diameter d_in, and center-to-center distance R_cc (along the z-axis). It describes both separate and "
-		"sintered coated spheres. In the latter case sintering is considered symmetrically for cores and shells.",
-		2,SH_BICOATED},
-	{"biellipsoid","<y1/x1> <z1/x1> <x2/x1> <y2/x2> <z2/x2>","Two general ellipsoids in default orientations with "
-		"centers on the z-axis, touching each other. Their semi-axes are x1,y1,z1 (lower one, first domain) and "
-		"x2,y2,z2 (upper one, second domain).",5,SH_BIELLIPSOID},
-	{"bisphere","<R_cc/d> ","Two identical spheres with diameter d and center-to-center distance R_cc (along the "
-		"z-axis). It describe both separate and sintered spheres.",1,SH_BISPHERE},
-	{"box","[<y/x> <z/x>]","Homogeneous cube (if no arguments are given) or a rectangular parallelepiped with edges "
-		"x,y,z.",UNDEF,SH_BOX},
-	{"capsule","<h/d>","Homogeneous capsule (cylinder with half-spherical end caps) with cylinder height h and "
-		"diameter d (its axis of symmetry coincides with the z-axis).",1,SH_CAPSULE},
-	{"chebyshev","<eps> <n>","Axisymmetric Chebyshev particle of amplitude eps and order n, r=r_0[1+eps*cos(n*theta)]. "
-		"eps is a real number, such that |eps|<=1, while n is a natural number",2,SH_CHEBYSHEV},
-	{"coated","<d_in/d> [<x/d> <y/d> <z/d>]","Sphere with a spherical inclusion; outer sphere has a diameter d (first "
-		"domain). The included sphere has a diameter d_in (optional position of the center: x,y,z).",UNDEF,SH_COATED},
-	{"cylinder","<h/d>","Homogeneous cylinder with height (length) h and diameter d (its axis of symmetry coincides "
-		"with the z-axis).",1,SH_CYLINDER},
-	{"egg","<eps> <nu>","Axisymmetric egg shape given by a^2=r^2+nu*r*z-(1-eps)z^2, where 'a' is scaling factor. "
-		"Parameters must satisfy 0<eps<=1, 0<=nu<eps.",2,SH_EGG},
-	{"ellipsoid","<y/x> <z/x>","Homogeneous general ellipsoid with semi-axes x,y,z",2,SH_ELLIPSOID},
-	{"line","","Line along the x-axis with the width of one dipole",0,SH_LINE},
-	{"plate", "<h/d>","Homogeneous plate (cylinder with rounded side) with cylinder height h and full diameter d (i.e. "
-		"diameter of the constituent cylinder is d-h). Its axis of symmetry coincides with the z-axis.",1,SH_PLATE},
-	{"prism","<n> <h/Dx>","Homogeneous right prism with height (length along the z-axis) h based on a regular polygon "
-		"with n sides of size 'a'. The polygon is oriented so that positive x-axis is a middle perpendicular for one "
-		"of its sides. Dx is size of the polygon along the x-axis, equal to 2Ri and Rc+Ri for even and odd n "
-		"respectively. Rc=a/[2sin(pi/n)] and Ri=Rc*cos(pi/n) are radii of circumscribed and inscribed circles "
-		"respectively.",2,SH_PRISM},
-	{"rbc","<h/d> <b/d> <c/d>","Red Blood Cell, an axisymmetric (over z-axis) biconcave homogeneous particle, which is "
-		"characterized by diameter d, maximum and minimum width h, b, and diameter at the position of the maximum "
-		"width c. The surface is described by ro^4+2S*ro^2*z^2+z^4+P*ro^2+Q*z^2+R=0, ro^2=x^2+y^2, P,Q,R,S are "
-		"determined by the described parameters.",3,SH_RBC},
-#endif // !SPARSE
-	{"read","<filename>","Read a particle geometry from file <filename>",FNAME_ARG,SH_READ},
-#ifndef SPARSE
-	{"sphere","","Homogeneous sphere",0,SH_SPHERE},
-	{"spherebox","<d_sph/Dx>","Sphere (diameter d_sph) in a cube (size Dx, first domain)",1,SH_SPHEREBOX},
-#endif // !SPARSE
-	/* TO ADD NEW SHAPE
-	 * add a row to this list in alphabetical order. It contains: shape name (used in command line), usage string, help
-	 * string, possible number of float parameters, shape identifier (defined inside 'enum sh' in const.h). Usage and
-	 * help string are shown either when -h option is invoked or error is found in input command line. Usage string is
-	 * one line giving a list of possible arguments or argument combinations. Do not include shape name in it, use
-	 * <arg_name> to denote argument, [...] for optional arguments, and {...|...|...} for multiple options of an
-	 * argument. Help string should contain general description of the shape and its arguments. Instead of number of
-	 * parameters UNDEF can be used (if shape can accept variable number of parameters, then check it explicitly in
-	 * function PARSE_FUNC(shape) below) or FNAME_ARG (if the shape accepts a single string argument with file name).
-	 * Number of parameters should not be greater than MAX_N_SH_PARMS (defined in const.h). It is recommended to use
-	 * dimensionless shape parameters, e.g. aspect ratios.
-	 */
-	{NULL,NULL,NULL,0,0}
-};
-/* TO ADD NEW COMMAND LINE OPTION
- * If a new option requires separate description of suboptions, add a static structure here (similar to already existing
- * ones). It should contain a number of rows corresponding to different suboptions (see definition of subopt_struct
- * above for details) and terminate with a NULL row.
- */
-
-// EXTERNAL FUNCTIONS
-
-// GenerateB.c
-void InitBeam(void);
-
-//======================================================================================================================
-/* Prototypes of parsing functions; definitions are given below. defines are for conciseness. Since we use one common
- * prototype style for all parsing functions and many of the latter do not actually use the passed parameters, these
- * parameters have 'unused' attribute to eliminate spurious warnings.
- */
-#define PARSE_NAME(a) parse_##a
-#define PARSE_FUNC(a) static void PARSE_NAME(a)(int Narg ATT_UNUSED,char **argv ATT_UNUSED)
-#define PAR(a) #a,PARSE_NAME(a),false
-PARSE_FUNC(alldir_inp);
-PARSE_FUNC(anisotr);
-PARSE_FUNC(asym);
-PARSE_FUNC(beam);
-PARSE_FUNC(chp_dir);
-PARSE_FUNC(chp_load);
-PARSE_FUNC(chp_type);
-PARSE_FUNC(chpoint);
-PARSE_FUNC(Cpr);
-PARSE_FUNC(Csca);
-PARSE_FUNC(dir);
-PARSE_FUNC(dpl);
-PARSE_FUNC(eps);
-PARSE_FUNC(eq_rad);
-#ifdef OPENCL
-PARSE_FUNC(gpu);
-#endif
-#ifndef SPARSE
-PARSE_FUNC(granul);
-#endif
-PARSE_FUNC(grid);
-PARSE_FUNC(h) ATT_NORETURN;
-PARSE_FUNC(init_field);
-PARSE_FUNC(int);
-PARSE_FUNC(int_surf);
-PARSE_FUNC(iter);
-PARSE_FUNC(jagged);
-PARSE_FUNC(lambda);
-PARSE_FUNC(m);
-PARSE_FUNC(maxiter);
-PARSE_FUNC(no_reduced_fft);
-PARSE_FUNC(no_vol_cor);
-PARSE_FUNC(ntheta);
-PARSE_FUNC(opt);
-PARSE_FUNC(orient);
-PARSE_FUNC(phi_integr);
-PARSE_FUNC(pol);
-PARSE_FUNC(prognosis);
-PARSE_FUNC(prop);
-PARSE_FUNC(recalc_resid);
-PARSE_FUNC(rect_dip);
-#ifndef SPARSE
-PARSE_FUNC(save_geom);
-#endif
-PARSE_FUNC(scat);
-PARSE_FUNC(scat_grid_inp);
-PARSE_FUNC(scat_matr);
-PARSE_FUNC(scat_plane);
-#ifndef SPARSE
-PARSE_FUNC(sg_format);
-#endif
-PARSE_FUNC(shape);
-PARSE_FUNC(size);
-PARSE_FUNC(store_beam);
-PARSE_FUNC(store_dip_pol);
-PARSE_FUNC(store_force);
-#ifndef SPARSE
-PARSE_FUNC(store_grans);
-#endif
-PARSE_FUNC(store_int_field);
-PARSE_FUNC(store_scat_grid);
-PARSE_FUNC(surf);
-PARSE_FUNC(sym);
-PARSE_FUNC(test);
-PARSE_FUNC(V) ATT_NORETURN;
-PARSE_FUNC(vec);
-PARSE_FUNC(yz);
-/* TO ADD NEW COMMAND LINE OPTION
- * add a function prototype to this list. Add a line 'PARSE_FUNC(option_name);' in alphabetical order. It will be
- * expanded automatically using defines specified above.
- */
-
-static struct opt_struct options[]={
-	{PAR(alldir_inp),"<filename>","Specifies a file with parameters of the grid of scattering angles for calculating "
-		"integral scattering quantities.\n"
-		"Default: "FD_ALLDIR_PARMS,1,NULL},
-	{PAR(anisotr),"","Specifies that refractive index is anisotropic (its tensor is limited to be diagonal in particle "
-		"reference frame). '-m' then accepts 6 arguments per each domain. Can not be used with CLDR polarizability and "
-		"all SO formulations.",0,NULL},
-	{PAR(asym),"","Calculate the asymmetry vector. Implies '-Csca' and '-vec'",0,NULL},
-	{PAR(beam),"<type> [<args>]","Sets the incident beam, either predefined or 'read' from file. All parameters of "
-		"predefined beam types (if present) are floats.\n"
-		"Default: plane",UNDEF,beam_opt},
-	{PAR(chp_dir),"<dirname>","Sets directory for the checkpoint (both for saving and loading).\n"
-		"Default: "FD_CHP_DIR,1,NULL},
-	{PAR(chp_load),"","Restart a simulation from a checkpoint",0,NULL},
-	{PAR(chp_type),"{normal|regular|always}",
-		"Sets type of the checkpoint. All types, except 'always', require '-chpoint'.\n"
-		"Default: normal",1,NULL},
-	{PAR(chpoint),"<time>","Specifies the time for checkpoints in format '#d#h#m#s'. All fields are optional, numbers "
-		"are integers, 's' can be omitted, the format is not case sensitive.\n"
-		"Examples: 12h30M, 1D10s, 3600",1,NULL},
-	{PAR(Cpr),"","Calculate the total radiation force, expressed as cross section.",0,NULL},
-	{PAR(Csca),"","Calculate scattering cross section (by integrating the scattered field)",0,NULL},
-	{PAR(dir),"<dirname>","Sets directory for output files.\n"
-		"Default: constructed automatically",1,NULL},
-	{PAR(dpl),"<arg>","Sets parameter 'dipoles per lambda' (along the x-axis), float.\n"
-		"Default: 10|m|, where |m| is the maximum of all given refractive indices.",1,NULL},
-	{PAR(eps),"<arg>","Specifies the stopping criterion for the iterative solver by setting the relative norm of the "
-		"residual 'epsilon' to reach. <arg> is an exponent of base 10 (float), i.e. epsilon=10^(-<arg>).\n"
-		"Default: 5 (epsilon=1E-5)",1,NULL},
-	{PAR(eq_rad),"<arg>","Sets volume-equivalent radius of the particle in um, float. If default wavelength is used, "
-		"this option specifies the volume-equivalent size parameter. Can not be used together with '-size'. Size is "
-		"defined by some shapes themselves, then this option can be used to override the internal specification and "
-		"scale the shape.\n"
-		"Default: determined by the value of '-size' or by '-grid', '-dpl', and '-lambda'.",1,NULL},
-#ifdef OPENCL
-	{PAR(gpu),"<index>","Specifies index of GPU that should be used (starting from 0). Relevant only for OpenCL "
-		"version of ADDA, running on a system with several GPUs.\n"
-		"Default: 0",1,NULL},
-#endif
-#ifndef SPARSE
-	{PAR(granul),"<vol_frac> <diam> [<dom_number>]","Specifies that one particle domain should be randomly filled with "
-		"spherical granules with specified diameter <diam> and volume fraction <vol_frac>. Domain number to fill is "
-		"given by the last optional argument. Algorithm may fail for volume fractions > 30-50%.\n"
-		"Default <dom_number>: 1",UNDEF,NULL},
-#endif // !SPARSE
-	{PAR(grid),"<nx> [<ny> <nz>]","Sets dimensions of the computation grid (any positive integers). In most "
-		"cases <ny> and <nz> can be omitted (they are automatically determined by <nx> based on the proportions of the "
-		"scatterer). This command line option is not relevant when particle geometry is read from a file ('-shape "
-		"read'). If '-jagged' option is used the grid dimension is effectively multiplied by the specified number.\n"
-		"Default: 16 (if neither '-size' nor '-eq_rad' are specified) or defined by\n"
-		"         '-size' or '-eq_rad', '-lambda', and '-dpl'.",UNDEF,NULL},
-	{PAR(h),"[<opt> [<subopt>]]","Shows help. If used without arguments, ADDA shows a list of all available command "
-		"line options. If first argument is specified, help on specific command line option <opt> is shown (only the "
-		"name of the option should be given without preceding dash). For some options (e.g. '-beam' or '-shape') "
-		"specific help on a particular suboption <subopt> may be shown.\n"
-		"Example: shape coated",UNDEF,NULL},
-	{PAR(init_field),"{auto|inc|read <filenameY> [<filenameX>]|wkb|zero}",
-		"Sets prescription to calculate initial (starting) field for the iterative solver.\n"
-		"'auto' - automatically choose from 'zero' and 'inc' based on the lower residual value.\n"
-		"'inc' - derived from the incident field,\n"
-		"'read' - defined by separate files, which names are given as arguments. Normally two files are required for "
-		"Y- and X-polarizations respectively, but a single filename is sufficient if only Y-polarization is used (e.g. "
-		"due to symmetry). Initial field should be specified in a particle reference frame in the same format as used "
-		"by '-store_int_field',\n"
-		"'wkb' - from Wentzel-Kramers-Brillouin approximation,\n"
-#ifdef SPARSE
-		"!!! 'wkb' is not operational in sparse mode\n"
-#endif
-		"'zero' is a zero vector,\n"
-		"Default: auto",UNDEF,NULL},
-	{PAR(int),"{fcd|fcd_st|igt [<lim> [<prec>]]|igt_so|nloc <Rp>|nloc_av <Rp>|poi|so}",
-		"Sets prescription to calculate the interaction term.\n"
-		"'fcd' - Filtered Coupled Dipoles - requires dpl to be larger than 2.\n"
-		"'fcd_st' - static (long-wavelength limit) version of FCD.\n"
-		"'igt' - Integration of Green's Tensor. Its parameters are: <lim> - maximum distance (in largest dipole "
-		"dimensions), for which integration is used, (default: infinity); <prec> - minus decimal logarithm of relative "
-		"error of the integration, i.e. epsilon=10^(-<prec>) (default: the same as the argument (or default value) of "
-		"'-eps' command line option).\n"
-#ifdef NO_FORTRAN
-		"!!! 'igt' relies on Fortran sources that were disabled at compile time.\n"
-#endif
-		"'igt_so' - approximate evaluation of IGT using second order of kd approximation.\n"
-		"'nloc' - non-local interaction of two Gaussian dipole densities (based on point value of Gh), <Rp> is the "
-		"width of the latter in um (must be non-negative).\n"
-		"'nloc_av' - same as 'nloc' but based on averaging over the cube volume.\n"
-		"'poi' - (the simplest) interaction between point dipoles.\n"
-		"'so' - under development and incompatible with '-anisotr'.\n"
-#ifdef SPARSE
-		"!!! All options except 'poi' incur a significant slowing down in sparse mode.\n"
-#endif
-		"Default: poi",UNDEF,NULL},
-		/* TO ADD NEW INTERACTION FORMULATION
-		 * Modify string constants after 'PAR(int)': add new argument (possibly with additional sub-arguments) to list
-		 * {...} and its description to the next string. If the new interaction formulation requires unusually large
-		 * computational time, add a special note for sparse mode (after '#ifdef SPARSE').
-		 */
-	{PAR(int_surf),"{img|som}",
-		"Sets prescription to calculate the reflection term.\n"
-		"'img' - approximation based on a single image dipole (fast but inaccurate).\n"
-		"'som' - direct evaluation of Sommerfeld integrals.\n"
-	#ifdef SPARSE
-		"!!! In sparse mode 'som' is expected to be very slow.\n"
-	#endif
-		"Default: som (but 'img' if surface is perfectly reflecting)",1,NULL},
-		/* TO ADD NEW REFLECTION FORMULATION
-		 * Modify string constants after 'PAR(int_surf)': add new argument (possibly with additional sub-arguments) to
-		 * list {...} and its description to the next string. If the new reflection formulation requires unusually
-		 * large computational time, add a special note for sparse mode (after '#ifdef SPARSE').
-		 * !!! If subarguments are added, second-to-last argument should be changed from 1 to UNDEF, and consistency
-		 * test for number of arguments should be implemented in PARSE_FUNC(int_surf) below.
-		 */
-	{PAR(iter),"{bcgs2|bicg|bicgstab|cgnr|csym|qmr|qmr2}","Sets the iterative solver.\n"
-		"Default: qmr",1,NULL},
-		/* TO ADD NEW ITERATIVE SOLVER
-		 * add the short name, used to define the new iterative solver in the command line, to the list "{...}" in the
-		 * alphabetical order.
-		 */
-	{PAR(jagged),"<arg>","Sets a size of a big dipole in units of small dipoles, integer. It is used to improve the "
-		"discretization of the particle without changing the shape.\n"
-		"Default: 1",1,NULL},
-	{PAR(lambda),"<arg>","Sets incident wavelength in um, float.\n"
-		"Default: 2*pi",1,NULL},
-	{PAR(m),"{<m1Re> <m1Im> [...]|<m1xxRe> <m1xxIm> <m1yyRe> <m1yyIm> <m1zzRe> <m1zzIm> [...]}","Sets refractive "
-		"indices, float. Each pair of arguments specifies real and imaginary part of the refractive index of one of "
-		"the domains. If '-anisotr' is specified, three refractive indices correspond to one domain (diagonal elements "
-		"of refractive index tensor in particle reference frame). Maximum number of different refractive indices is "
-		"defined at compilation time by the parameter MAX_NMAT in file const.h (by default, 15). None of the "
-		"refractive indices can be equal to 1+0i.\n"
-		"Default: 1.5 0",UNDEF,NULL},
-	{PAR(maxiter),"<arg>","Sets the maximum number of iterations of the iterative solver, integer.\n"
-		"Default: very large, not realistic value",1,NULL},
-	{PAR(no_reduced_fft),"","Do not use symmetry of the interaction matrix to reduce the storage space for the "
-		"Fourier-transformed matrix.",0,NULL},
-	{PAR(no_vol_cor),"","Do not use 'dpl (volume) correction'. If this option is given, ADDA will try to match size of "
-		"the dipole grid along x-axis to that of the particle, either given by '-size' or calculated analytically from "
-		"'-eq_rad'. Otherwise (by default) ADDA will try to match the volumes, using either '-eq_rad' or the value "
-		"calculated analytically from '-size'.",0,NULL},
-	{PAR(ntheta),"<arg>","Sets the number of intervals, into which the range of scattering angles [0,180] (degrees) is "
-		"equally divided, integer. This is used for scattering angles in yz-plane. If particle is not symmetric and "
-		"orientation averaging is not used, the range is extended to 360 degrees (with the same length of elementary "
-		"interval, i.e. number of intervals is doubled).\n"
-		"Default: from 90 to 720 depending on the size of the computational grid.",1,NULL},
-	{PAR(opt),"{speed|mem}",
-		"Sets whether ADDA should optimize itself for maximum speed or for minimum memory usage.\n"
-		"Default: speed",1,NULL},
-	{PAR(orient),"{<alpha> <beta> <gamma>|avg [<filename>]}","Either sets an orientation of the particle by three "
-		"Euler angles 'alpha','beta','gamma' (in degrees) or specifies that orientation averaging should be "
-		"performed. <filename> sets a file with parameters for orientation averaging. Here zyz-notation (or "
-		"y-convention) is used for Euler angles.\n"
-		"Default orientation: 0 0 0\n"
-		"Default <filename>: "FD_AVG_PARMS,UNDEF,NULL},
-	{PAR(phi_integr),"<arg>","Turns on and specifies the type of Mueller matrix integration over azimuthal angle "
-		"'phi'. <arg> is an integer from 1 to 31, each bit of which, from lowest to highest, indicates whether the "
-		"integration should be performed with multipliers 1, cos(2*phi), sin(2*phi), cos(4*phi), and sin(4*phi) "
-		"respectively.\n"
-		"Examples: 1 (one integration with no multipliers),\n"
-		"          6 (two integration with cos(2*phi) and sin(2*phi) multipliers).",1,NULL},
-	{PAR(pol),"{cldr|cm|dgf|fcd|igt_so|lak|ldr [avgpol]|nloc <Rp>|nloc_av <Rp>|rrc|so}",
-		"Sets prescription to calculate the dipole polarizability.\n"
-		"'cldr' - Corrected LDR (see below), incompatible with '-anisotr'.\n"
-		"'cm' - (the simplest) Clausius-Mossotti.\n"
-		"'dgf' - Digitized Green's Function (second order approximation to LAK).\n"
-		"'fcd' - Filtered Coupled Dipoles (requires dpl to be larger than 2).\n"
-		"'igt_so' - Integration of Green's Tensor over a cube (second order approximation).\n"
-		"'lak' - (by Lakhtakia) exact integration of Green's Tensor over a sphere.\n"
-		"'ldr' - Lattice Dispersion Relation, optional flag 'avgpol' can be added to average polarizability over "
-		"incident polarizations.\n"
-		"'nloc' - non-local (Gaussian dipole density, based on lattice sums), <Rp> is the width of the latter in um "
-		"(must be non-negative).\n"
-		"'nloc_av' - same as 'nloc' but based on averaging of Gh over the dipole volume.\n"
-		"'rrc' - Radiative Reaction Correction (added to CM).\n"
-		"'so' - under development and incompatible with '-anisotr'.\n"
-		"Default: ldr (without averaging) or cldr (for -rect_dip).",UNDEF,NULL},
-		/* TO ADD NEW POLARIZABILITY FORMULATION
-		 * Modify string constants after 'PAR(pol)': add new argument (possibly with additional sub-arguments) to list
-		 * {...} and its description to the next string.
-		 */
-	{PAR(prognosis),"","Do not actually perform simulation (not even memory allocation) but only estimate the required "
-		"RAM. Implies '-test'.",0,NULL},
-	{PAR(prop),"<x> <y> <z>","Sets propagation direction of incident radiation, float. Normalization (to the unity "
-		"vector) is performed automatically. For point-dipole incident beam this determines its direction.\n"
-		"Default: 0 0 1",3,NULL},
-	{PAR(recalc_resid),"","Recalculate residual at the end of iterative solver.",0,NULL},
-	{PAR(rect_dip),"<x> <y> <z>","Use rectangular-cuboid dipoles. Three arguments are the relative dipole sizes along "
-		"the corresponding axes. Absolute scale is not relevant, i.e. '1 2 2' is equivalent to '0.5 1 1'.\n"
-		"Default: 1 1 1",3,NULL},
-#ifndef SPARSE
-	{PAR(save_geom),"[<filename>]","Save dipole configuration to a file <filename> (a path relative to the output "
-		"directory). Can be used with '-prognosis'.\n"
-		"Default: <type>.geom \n"
-		"(<type> is a first argument to the '-shape' option; '_gran' is added if '-granul' option is used; file "
-		"extension can differ depending on argument of '-sg_format' option).",
-		UNDEF,NULL},
-#endif // !SPARSE
-	{PAR(scat),"{dr|fin|igt_so|so}","Sets prescription to calculate scattering quantities.\n"
-		"'dr' - (by Draine) standard formulation for point dipoles\n"
-		"'fin' - slightly different one, based on a radiative correction for a finite dipole.\n"
-		"'igt_so' - second order in kd approximation to Integration of Green's Tensor.\n"
-		"'so' - under development and incompatible with '-anisotr'.\n"
-		"Default: dr",1,NULL},
-	{PAR(scat_grid_inp),"<filename>","Specifies a file with parameters of the grid of scattering angles for "
-		"calculating Mueller matrix (possibly integrated over 'phi').\n"
-		"Default: "FD_SCAT_PARMS,1,NULL},
-	{PAR(scat_matr),"{muel|ampl|both|none}","Specifies which scattering matrices (from Mueller and amplitude) should "
-		"be saved to file. Amplitude matrix is never integrated (in combination with '-orient avg' or '-phi_integr').\n"
-		"Default: muel",1,NULL},
-	{PAR(scat_plane),"","Explicitly enables calculation of the scattering in the plane through e_z (in laboratory "
-		"reference frame) and propagation direction of incident wave. For default incidence this is the xz-plane. It "
-		"can also be implicitly enabled by other options.",0,NULL},
-#ifndef SPARSE
-	{PAR(sg_format),"{text|text_ext|ddscat6|ddscat7}","Specifies format for saving geometry files. First two are ADDA "
-		"default formats for single- and multi-domain particles respectively. 'text' is automatically changed to "
-		"'text_ext' for multi-domain particles. Two DDSCAT formats correspond to its shape options 'FRMFIL' (version "
-		"6) and 'FROM_FILE' (version 7) and output of 'calltarget' utility.\n"
-		"Default: text",1,NULL},
-#endif // !SPARSE
-		/* TO ADD NEW FORMAT OF SHAPE FILE
-		 * Modify string constants after 'PAR(sg_format)': add new argument to list {...} and add its description to
-		 * the next string.
-		 */
-	{PAR(shape),"<type> [<args>]","Sets shape of the particle, either predefined or 'read' from file. All parameters "
-		"of predefined shapes are floats except for filenames.\n"
-		"Default: sphere",UNDEF,shape_opt},
-	{PAR(size),"<arg>","Sets the size of the computational grid along the x-axis in um, float. If default wavelength "
-		"is used, this option specifies the 'size parameter' of the computational grid. Can not be used together with "
-		"'-eq_rad'. Size is defined by some shapes themselves, then this option can be used to override the internal "
-		"specification and scale the shape.\n"
-		"Default: determined by the value of '-eq_rad' or by '-grid', '-dpl', and '-lambda'.",1,NULL},
-	{PAR(store_beam),"","Save incident beam to a file",0,NULL},
-	{PAR(store_dip_pol),"","Save dipole polarizations to a file",0,NULL},
-	{PAR(store_force),"","Calculate the radiation force on each dipole. Implies '-Cpr'",0,NULL},
-#ifndef SPARSE
-	{PAR(store_grans),"","Save granule coordinates (placed by '-granul' option) to a file",0,NULL},
-#endif
-	{PAR(store_int_field),"","Save internal fields to a file",0,NULL},
-	{PAR(store_scat_grid),"","Calculate Mueller matrix for a grid of scattering angles and save it to a file.",0,NULL},
-	{PAR(surf),"<h> {<mre> <mim>|inf}","Specifies that scatterer is located above the plane surface, parallel to the "
-		"xy-plane. <h> specifies the height of particle center above the surface (along the z-axis, in um). Particle "
-		"must be entirely above the substrate. Following argument(s) specify the refractive index of the substrate "
-		"(below the surface), assuming that the vacuum is above the surface. It is done either by two values (real and "
-		"imaginary parts of the complex value) or as effectively infinite 'inf' which corresponds to perfectly"
-		"reflective surface. The latter implies certain simplifications during calculations.",UNDEF,NULL},
-	{PAR(sym),"{auto|no|enf}","Automatically determine particle symmetries ('auto'), do not take them into account "
-		"('no'), or enforce them ('enf').\n"
-		"Default: auto",1,NULL},
-	{PAR(test),"","Begin name of the output directory with 'test' instead of 'run'",0,NULL},
-	{PAR(V),"","Show ADDA version, compiler used to build this executable, build options, and copyright information",
-		0,NULL},
-	{PAR(vec),"","Calculate the not-normalized asymmetry vector",0,NULL},
-	{PAR(yz),"","Explicitly enables calculation of the scattering in the yz-plane (in incident-wave reference frame). "
-		"It can also be implicitly enabled by other options.",0,NULL}
-	/* TO ADD NEW COMMAND LINE OPTION
-	 * add a row to this list, initializing an option. It should contain: PAR(option_name), usage string, help string,
-	 * number of arguments, pointer to suboption (if exist, NULL otherwise). Usage and help string are shown either
-	 * when -h option is invoked or error is found in input command line. Usage string is one line giving a list of
-	 * possible arguments or argument combinations. Do not include option name in it, use <arg_name> to denote argument,
-	 * [...] for optional arguments, and {...|...|...} for multiple options of an argument. Help string should contain
-	 * general description of the option and its arguments, and provide default value for the arguments (if applicable).
-	 * UNDEF can be used instead of number of arguments to avoid automatic checking, e.g. when command line option can
-	 * accept variable number of arguments. Then check it explicitly in function PARSE_FUNC(option_name) below. A
-	 * separate suboption structure is recommended only for large options such as -beam and -shape, and it should be
-	 * defined above.
-	 */
-};
-
-// auxiliary functions
-//======================================================================================================================
-
-static const char *OptionName(void)
-// produces full option name for error messages
-{
-	static char buf[MAX_LINE];
-
-	if (opt.l2==UNDEF) return options[opt.l1].name;
-	else {
-		sprintf(buf,"%s %s",options[opt.l1].name,options[opt.l1].sub[opt.l2].name);
-		return buf;
-	}
-}
-
-//======================================================================================================================
-
-void PrintErrorHelp(const char * restrict fmt, ... )
-/* print anything to stderr (on root processor), then help on the arguments used, and stop; assumes that all processors
- * call it; has line wrapping. It is designed to be relatively safe (using snprintf and vsnprintf), but do not produce
- * any additional errors in case of buffer overflows, etc. (not to distract from the main error itself). However, for
- * uncontrolled (e.g. user-input) arguments, it is recommended to use PrintErrorHelpSafe instead.
- */
-{
-	va_list args;
-	const char * restrict optname,* restrict use;
-	char msg[MAX_MESSAGE]="ERROR: ";
-	int shift,tmp;
-
-	if (IFROOT) {
-		// produce error message
-		va_start(args,fmt);
-		shift=strlen(msg);
-		VSNPRINTF_SHIFT_ROBUST(shift,tmp,msg,MAX_MESSAGE,fmt,args);
-		va_end(args);
-		// add help message
-		if (opt.l1==UNDEF) { // no option is found
-			SNPRINTF_SHIFT_ROBUST(shift,tmp,msg,MAX_MESSAGE,"\n"
-				"Usage: %s %s\n"
-				"Type '%s -h' for help\n",exename,exeusage,exename);
-		}
-		else { // at least option is found
-			if (opt.l2==UNDEF) use=options[opt.l1].usage;
-			else use=options[opt.l1].sub[opt.l2].usage;
-			optname=OptionName();
-			SNPRINTF_SHIFT_ROBUST(shift,tmp,msg,MAX_MESSAGE,"\n"
-				"Usage: -%s %s\n"
-				"Type '%s -h %s' for details\n",optname,use,exename,optname);
-		}
-		WrapLines(msg);
-		fprintf(stderr,"%s",msg);
-		fflush(stderr);
-	}
-	// wait for root to generate an error message
-	Synchronize();
-	Stop(EXIT_FAILURE);
-}
-
-//======================================================================================================================
-
-static void ATT_NORETURN ATT_PRINTF(1,2) PrintErrorHelpSafe(const char * restrict fmt, ... )
-/* print anything to stderr (on root processor), then help on the arguments used, and stop; assumes that all processors
- * call it; same as PrintErrorHelp but uses no internal buffers to be safe for any input parameters, which may come
- * from a command line, at a cost of lacking line wrapping.
- */
-{
-	va_list args;
-	const char * restrict optname,* restrict use;
-
-	if (IFROOT) {
-		// produce error message
-		va_start(args,fmt);
-		fprintf(stderr,"ERROR: ");
-		vfprintf(stderr,fmt,args);
-		fprintf(stderr,"\n");
-		va_end(args);
-		// add help message
-		if (opt.l1==UNDEF) // no option is found
-			fprintf(stderr,"Usage: %s %s\n"
-			               "Type '%s -h' for help\n",exename,exeusage,exename);
-		else { // at least option is found
-			if (opt.l2==UNDEF) use=options[opt.l1].usage;
-			else use=options[opt.l1].sub[opt.l2].usage;
-			optname=OptionName();
-			fprintf(stderr,"Usage: -%s %s\n"
-			               "Type '%s -h %s' for details\n",optname,use,exename,optname);
-		}
-		fflush(stderr);
-	}
-	// wait for root to generate an error message
-	Synchronize();
-	Stop(EXIT_FAILURE);
-}
-
-//======================================================================================================================
-
-static void NargError(const int Narg,const char *expec)
-// Print error of illegal number of arguments to an option (suboption) and display correct usage information
-{
-	PrintErrorHelp("Illegal number of arguments (%d) to '-%s' option (%s expected)",Narg,OptionName(),expec);
-}
-
-
-//======================================================================================================================
-
-static void NargErrorSub(const int Narg,const char *option,const char *expec)
-/* Print error of illegal number of arguments to an option (usually with suboption) and display correct usage
- * information. Narg is decremented before printing.
- */
-{
-	PrintErrorHelp("Illegal number of arguments (%d) to '-%s' option (%s expected)",Narg-1,option,expec);
-}
-
-//======================================================================================================================
-
-static void TestExtraNarg(const int Narg, const bool notAllowed,const char *subopt)
-// check if Narg is larger than 1 for suboption, which doesn't allow that
-{
-	if (Narg>1 && notAllowed) PrintErrorHelp("Additional arguments are not allowed for '-%s %s'",OptionName(),subopt);
-}
-
-//======================================================================================================================
-
-static void TestNarg(const int Narg,const int need)
-// check if Narg given to an option (or suboption) is correct; interface to NargError
-{
-	if (need>=0) { // usual case
-		if (Narg!=need) {
-			char buf[MAX_WORD];
-			snprintf(buf,MAX_WORD,"%d",need);
-			NargError(Narg,buf);
-		}
-	} // otherwise special cases are considered, encoded by negative values
-	else switch (need) {
-		case UNDEF: break; // do nothing
-		case FNAME_ARG: if (Narg!=1) NargError(Narg,"1"); break;
-		case FNAME_ARG_2: if (Narg!=2) NargError(Narg,"2"); break;
-		case FNAME_ARG_1_2: if (Narg!=1 && Narg!=2) NargError(Narg,"1 or 2"); break;
-		default: // rigorous test that every possible special case is taken care of
-			PrintError("Critical error in TestNarg function (unknown argument 'need'=%d). Probably this comes from "
-				"value of 'narg' in one of static arrays, describing command line options.",need);
-			// no break
-	}
-}
-
-//======================================================================================================================
-
-static void ATT_NORETURN NotSupported(const char * restrict type,const char * restrict given)
-// print error message that "type 'given' is not supported"; type should start with a capital letter
-{
-	PrintErrorHelpSafe("%s '%s' is not supported",type,given);
-}
-
-//======================================================================================================================
-
-static const char *ScanStrError(const char * restrict str,const unsigned int size)
-// check if string fits in buffer of size 'size', otherwise produces error message; returns the passed str (redirects)
-{
-	if (strlen(str)>=size) PrintErrorHelp("Too long argument to '-%s' option (only %ud chars allowed). If you really "
-		"need it you may increase MAX_DIRNAME in const.h and recompile",OptionName(),size-1);
-	return str;
-}
-
-//======================================================================================================================
-
-static void ScanDoubleError(const char * restrict str,double *res)
-// scanf an option argument and checks for errors
-{
-	if (sscanf(str,"%lf",res)!=1)
-		PrintErrorHelpSafe("Non-numeric argument (%s) is given to the option '-%s'",str,OptionName());
-}
-
-//======================================================================================================================
-
-static void ScanIntError(const char * restrict str,int *res)
-// scanf an option argument and checks for errors
-{
-	double tmp;
-
-	if (sscanf(str,"%lf",&tmp)!=1)
-		PrintErrorHelpSafe("Non-numeric argument (%s) is given to the option '-%s'",str,OptionName());
-	// The following can be rewritten by call to ConvertToInteger(), but it is complicated due to presence of OptionName
-	if (tmp != floor(tmp))
-		PrintErrorHelpSafe("Argument value (%s) of the option '-%s' is not an integer",str,OptionName());
-	if (tmp <INT_MIN || tmp>INT_MAX)
-		PrintErrorHelpSafe("Argument value (%s) of the option '-%s' is out of integer bounds",str,OptionName());
-	*res=(int)tmp;
-}
-
-//======================================================================================================================
-
-static bool ScanFnamesError(const int Narg,const int need,char **argv,const char **fname1,const char **fname2)
-/* If 'need' corresponds to one of FNAME_ARG, scan Narg<=2 filenames from argv into fname1 and fname2. All consistency
- * checks are left to the caller (in particular, whether Narg corresponds to need). argv should be shifted to contain
- * only filenames. fname2 can be NULL, but it will produce an error in combination with Narg=2)
- *
- * Returns whether filenames has been scanned.
- */
-{
-	bool res=false;
-
-	if (IS_FNAME_ARG(need)) {
-		*fname1=ScanStrError(argv[0],MAX_FNAME);
-		if (Narg==2) {
-			if (fname2==NULL) // consistency check e.g. for reading shape filename
-				PrintError("Failed to store the second filename in function ScanFnamesError");
-			else *fname2=ScanStrError(argv[1],MAX_FNAME);
-		}
-		res=true;
-	}
-	return res;
-}
-
-//======================================================================================================================
-
-static bool IsOption(const char * restrict str)
-/* checks if string is an option. First should be '-' and then letter (any case); it enables use of negative numbers
- * as sub-parameters
- */
-{
-	// conversion to int is needed to remove warnings caused by the fact that str[1] is _signed_ char
-	return (str[0]=='-' && isalpha((int)(str[1])));
-}
-//======================================================================================================================
-
-static int TimeField(const char c)
-// analyze one time multiplier
-{
-	switch (c) {
-		case 'd':
-		case 'D': return 86400;
-		case 'h':
-		case 'H': return 3600;
-		case 'm':
-		case 'M': return 60;
-		case 's':
-		case 'S': return 1;
-	}
-	PrintErrorHelp("Illegal time format specifier (%c)",c);
-}
-
-//======================================================================================================================
-
-static int ScanTime(const char * restrict str)
-// scans time in seconds from a string "%d[d,D[%d]][h,H[%d]][m,M[%d]][s,S]
-{
-#define TIME_N_TYPES 4 // not so easy to change
-	int tim,t[TIME_N_TYPES],n,i;
-	char c[TIME_N_TYPES];
-
-	for (i=0;i<TIME_N_TYPES;i++) c[i]=0;
-	n=sscanf(str,"%d%c%d%c%d%c%d%c",t,c,t+1,c+1,t+2,c+2,t+3,c+3);
-	if (n<1) PrintErrorHelpSafe("Wrong time format '%s'",str);
-	tim=0;
-	i=0;
-	while (n>0) {
-		tim+=t[i]*TimeField(c[i]);
-		n-=2;
-		i++;
-	}
-	return tim;
-#undef TIME_N_TYPES
-}
-
-//======================================================================================================================
-
-static void PrintTime(char * restrict s,const time_t *time_ptr)
-{
-	struct tm *t;
-
-	t=gmtime(time_ptr);
-	s[0]=0; // initialize string
-	if (t->tm_yday>0) sprintf(s,"%dd ",t->tm_yday);
-	if (t->tm_hour>0) sprintf(s+strlen(s),"%dh ",t->tm_hour);
-	if (t->tm_min>0) sprintf(s+strlen(s),"%dm ",t->tm_min);
-	if (t->tm_sec>0) sprintf(s+strlen(s),"%ds ",t->tm_sec);
-}
-
-//======================================================================================================================
-// parsing functions definitions
-
-PARSE_FUNC(alldir_inp)
-{
-	alldir_parms=ScanStrError(argv[1],MAX_FNAME);
-}
-PARSE_FUNC(anisotr)
-{
-	anisotropy = true;
-	Ncomp=3;
-}
-PARSE_FUNC(asym)
-{
-	calc_asym = true;
-	calc_vec = true;
-	calc_Csca = true;
-}
-PARSE_FUNC(beam)
-{
-	int i,j,need;
-	bool found;
-
-	if (Narg==0) PrintErrorHelp("Suboption (argument) is missing for '-beam' option");
-	Narg--;
-	found=false;
-	i=-1;
-	while (beam_opt[++i].name!=NULL) if (strcmp(argv[1],beam_opt[i].name)==0) {
-		// set suboption and beam type
-		opt.l2=i;
-		beamtype=(enum beam)beam_opt[i].type;
-		beam_Npars=Narg;
-		opt_beam=opt;
-		need=beam_opt[i].narg;
-		// check number of arguments
-		switch (beamtype) {
-			case B_LMINUS:
-			case B_DAVIS3:
-			case B_BARTON5: if (Narg!=1 && Narg!=4) NargError(Narg,"1 or 4"); break;
-			case B_BESSELCS: if (Narg!=0 && Narg!=1 && Narg!=2 && Narg!=5) NargError(Narg,"0, 1, 2 or 5"); break;
-			case B_BESSELLE: if (Narg!=0 && Narg!=1 && Narg!=2 && Narg!=5) NargError(Narg,"0, 1, 2 or 5"); break;
-			case B_BESSELLM: if (Narg!=0 && Narg!=1 && Narg!=2 && Narg!=5) NargError(Narg,"0, 1, 2 or 5"); break;
-			case B_BESSELTEC: if (Narg!=0 && Narg!=1 && Narg!=2 && Narg!=5) NargError(Narg,"0, 1, 2 or 5"); break;
-			case B_BESSELTMC: if (Narg!=0 && Narg!=1 && Narg!=2 && Narg!=5) NargError(Narg,"0, 1, 2 or 5"); break;
-			default: TestNarg(Narg,need); break;
-		}
-		/* TO ADD NEW BEAM
-		 * If the beam accepts variable number of arguments (UNDEF was used in beam definition above) add a check of
-		 * number of received arguments as a new case above. Use NargError function similarly as done in existing tests.
-		 */
-		// either parse filename or parse all parameters as float; consistency is checked later
-		if (!ScanFnamesError(Narg,need,argv+2,&beam_fnameY,&beam_fnameX))
-			for (j=0;j<Narg;j++) ScanDoubleError(argv[j+2],beam_pars+j);
-		// stop search
-		found=true;
-		break;
-	}
-	if(!found) NotSupported("Beam type",argv[1]);
-}
-PARSE_FUNC(chp_dir)
-{
-	chp_dir=ScanStrError(argv[1],MAX_DIRNAME);
-}
-PARSE_FUNC(chp_load)
-{
-	load_chpoint = true;
-}
-PARSE_FUNC(chp_type)
-{
-	if (strcmp(argv[1],"normal")==0) chp_type=CHP_NORMAL;
-	else if (strcmp(argv[1],"regular")==0) chp_type=CHP_REGULAR;
-	else if (strcmp(argv[1],"always")==0) chp_type=CHP_ALWAYS;
-	else NotSupported("Checkpoint type",argv[1]);
-}
-PARSE_FUNC(chpoint)
-{
-	chp_time=ScanTime(argv[1]);
-	if (chp_time<=0) {
-		chp_time=UNDEF;
-		if (chp_type==CHP_NONE) chp_type=CHP_ALWAYS;
-	}
-	else if (chp_type==CHP_NONE) chp_type=CHP_NORMAL;
-}
-PARSE_FUNC(Cpr)
-{
-	calc_mat_force = true;
-}
-PARSE_FUNC(Csca)
-{
-	calc_Csca = true;
-}
-PARSE_FUNC(dir)
-{
-	directory=ScanStrError(argv[1],MAX_DIRNAME);
-}
-PARSE_FUNC(dpl)
-{
-	ScanDoubleError(argv[1],&dpl);
-	TestPositive(dpl,"dpl");
-}
-PARSE_FUNC(eps)
-{
-	double tmp;
-
-	ScanDoubleError(argv[1],&tmp);
-	TestPositive(tmp,"eps exponent");
-	iter_eps=pow(10,-tmp);
-}
-PARSE_FUNC(eq_rad)
-{
-	ScanDoubleError(argv[1],&a_eq);
-	TestPositive(a_eq,"dpl");
-}
-#ifdef OPENCL
-PARSE_FUNC(gpu)
-{
-	ScanIntError(argv[1],&gpuInd);
-	TestNonNegative_i(gpuInd,"GPU index");
-}
-#endif
-#ifndef SPARSE
-PARSE_FUNC(granul)
-{
-	if (Narg!=2 && Narg!=3) NargError(Narg,"2 or 3");
-	ScanDoubleError(argv[1],&gr_vf);
-	TestRangeII(gr_vf,"volume fraction",0,PI_OVER_SIX);
-	ScanDoubleError(argv[2],&gr_d);
-	TestPositive(gr_d,"diameter");
-	if (Narg==3) {
-		ScanIntError(argv[3],&gr_mat);
-		TestPositive_i(gr_mat,"domain number");
-	}
-	else gr_mat=1;
-	gr_mat--; // converted to usual indexing starting from 0
-	sh_granul=true;
-}
-#endif
-PARSE_FUNC(grid)
-{
-	if (Narg!=1 && Narg!=3) NargError(Narg,"1 or 3");
-	ScanIntError(argv[1],&boxX); // boxes are further multiplied by jagged if needed
-	TestRange_i(boxX,"gridX",1,BOX_MAX);
-	if (Narg==3) {
-		ScanIntError(argv[2],&boxY);
-		TestRange_i(boxY,"gridY",1,BOX_MAX);
-		ScanIntError(argv[3],&boxZ);
-		TestRange_i(boxZ,"gridZ",1,BOX_MAX);
-	}
-}
-PARSE_FUNC(h)
-{
-	int i,j;
-	bool found;
-
-	if (Narg>2) NargError(Narg,"not more than 2");
-	// do all output on root processor
-	if (IFROOT) {
-		found=false;
-		if (Narg>=1) {
-			for(i=0;i<LENGTH(options);i++) if (strcmp(argv[1],options[i].name)==0) {
-				if (Narg==2) {
-					if (options[i].sub==NULL) printf("No specific help is available for suboptions of this option\n\n");
-					else {
-						j=-1;
-						while (options[i].sub[++j].name!=NULL)
-							if (strcmp(argv[2],options[i].sub[j].name)==0) {
-								printf("  -%s %s %s\n%s\n",options[i].name,options[i].sub[j].name,
-									options[i].sub[j].usage,WrapLinesCopy(options[i].sub[j].help));
-								found=true;
-								break;
-							}
-						if (!found) printf("Unknown suboption '%s'\n\n",argv[2]);
-					}
-				}
-				if (!found) {
-					printf("  -%s %s\n%s\n",options[i].name,options[i].usage,WrapLinesCopy(options[i].help));
-					if (options[i].sub!=NULL) {
-						printf("Available suboptions:\n");
-						j=-1;
-						while (options[i].sub[++j].name!=NULL)
-							printf("  %s %s\n",options[i].sub[j].name,options[i].sub[j].usage);
-						printf("Type '%s -h %s <subopt>' for details\n",exename,options[i].name);
-#ifdef SPARSE
-						if (strcmp(options[i].name,"shape")==0)
-							printf("!!! Most of the shape options are disabled in sparse mode\n");
-#endif
-					}
-				}
-				found=true;
-				break;
-			}
-			if (!found) printf("Unknown option '%s'\n\n",argv[1]);
-		}
-		if (!found) {
-			printf("Usage: '%s %s'\n"
-			       "Available options:\n",exename,exeusage);
-			for (i=0;i<LENGTH(options);i++) printf("  -%s %s\n",options[i].name,options[i].usage);
-			printf("Type '%s -h <opt>' for details\n",exename);
-#ifdef SPARSE
-			printf("!!! A number of options are disabled in sparse mode\n");
-#endif
-		}
-	}
-	// exit
-	Stop(EXIT_SUCCESS);
-}
-PARSE_FUNC(init_field)
-{
-	bool noExtraArgs=true;
-
-	if (Narg<1 || Narg>3) NargError(Narg,"from 1 to 3");
-	if (strcmp(argv[1],"auto")==0) InitField=IF_AUTO;
-	else if (strcmp(argv[1],"inc")==0) InitField=IF_INC;
-	else if (strcmp(argv[1],"read")==0) {
-		if (Narg!=2 && Narg!=3) NargErrorSub(Narg,"init_field read","1 or 2");
-		ScanFnamesError(Narg-1,FNAME_ARG_1_2,argv+2,&infi_fnameY,&infi_fnameX);
-		InitField=IF_READ;
-		noExtraArgs=false;
-	}
-	else if (strcmp(argv[1],"wkb")==0) {
-#ifdef SPARSE
-		PrintErrorHelp("Initial field 'wkb' is not supported in sparse mode");
-#else
-		InitField=IF_WKB;
-#endif
-	}
-	else if (strcmp(argv[1],"zero")==0) InitField=IF_ZERO;
-	else NotSupported("Initial field prescription",argv[1]);
-	TestExtraNarg(Narg,noExtraArgs,argv[1]);
-}
-PARSE_FUNC(int)
-{
-	double tmp;
-	bool noExtraArgs=true;
-	
-	if (Narg<1 || Narg>3) NargError(Narg,"from 1 to 3");
-	if (strcmp(argv[1],"fcd")==0) IntRelation=G_FCD;
-	else if (strcmp(argv[1],"fcd_st")==0) IntRelation=G_FCD_ST;
-	else if (strcmp(argv[1],"igt")==0) {
-#ifdef NO_FORTRAN
-		PrintErrorHelp("To use IGT compiling of Fortran sources must be enabled (comment line "
-			           "'CFLAGS += -DNO_FORTRAN' in Makefile and recompile");
-#endif
-		IntRelation=G_IGT;
-		if (Narg<1 || Narg>3) NargErrorSub(Narg,"int igt","from 0 to 2");
-		if (Narg>=2) {
-			ScanDoubleError(argv[2],&igt_lim);
-			TestNonNegative(igt_lim,"distance limit for IGT");
-			if (Narg==3) {
-				ScanDoubleError(argv[3],&tmp);
-				TestPositive(tmp,"IGT precision");
-				igt_eps=pow(10,-tmp);
-			}
-		}
-		noExtraArgs=false;
-	}
-	else if (strcmp(argv[1],"igt_so")==0) IntRelation=G_IGT_SO;
-	else if (strcmp(argv[1],"nloc")==0) {
-		IntRelation=G_NLOC;
-		if (Narg!=2) NargErrorSub(Narg,"int nloc","1");
-		ScanDoubleError(argv[2],&nloc_Rp);
-		TestNonNegative(nloc_Rp,"Gaussian width");
-		noExtraArgs=false;
-	}
-	else if (strcmp(argv[1],"nloc_av")==0) {
-		IntRelation=G_NLOC_AV;
-		if (Narg!=2) NargErrorSub(Narg,"int nloc_av","1");
-		ScanDoubleError(argv[2],&nloc_Rp);
-		TestNonNegative(nloc_Rp,"Gaussian width");
-		noExtraArgs=false;
-	}
-	else if (strcmp(argv[1],"poi")==0) IntRelation=G_POINT_DIP;
-	else if (strcmp(argv[1],"so")==0) IntRelation=G_SO;
-	/* TO ADD NEW INTERACTION FORMULATION
-	 * add the line to else-if sequence above in the alphabetical order, analogous to the ones already present. The
-	 * variable parts of the line are its name used in command line and its descriptor, defined in const.h. If
-	 * subarguments are used, test their quantity explicitly, process (scan) subarguments, and set noExtraArgs to false.
-	 * See "igt" for example. You may also need to change the test for Narg in the beginning of this function.
-	 */
-	else NotSupported("Interaction term prescription",argv[1]);
-	TestExtraNarg(Narg,noExtraArgs,argv[1]);
-}
-PARSE_FUNC(int_surf)
-{
-	if (strcmp(argv[1],"img")==0) ReflRelation=GR_IMG;
-	else if (strcmp(argv[1],"som")==0) ReflRelation=GR_SOM;
-	else NotSupported("Interaction term prescription",argv[1]);
-	/* TO ADD NEW REFLECTION FORMULATION
-	 * add the line to else-if sequence above in the alphabetical order, analogous to the ones already present. The
-	 * variable parts of the line are its name used in command line and its descriptor, defined in const.h.
-	 * !!! If subarguments need to be used a test for them should be implemented throughout the function, similar to
-	 * PARSE_FUNC(int) above
-	 */
-}
-PARSE_FUNC(iter)
-{
-	if (strcmp(argv[1],"bcgs2")==0) IterMethod=IT_BCGS2;
-	else if (strcmp(argv[1],"bicg")==0) IterMethod=IT_BICG_CS;
-	else if (strcmp(argv[1],"bicgstab")==0) IterMethod=IT_BICGSTAB;
-	else if (strcmp(argv[1],"cgnr")==0) IterMethod=IT_CGNR;
-	else if (strcmp(argv[1],"csym")==0) IterMethod=IT_CSYM;
-	else if (strcmp(argv[1],"qmr")==0) IterMethod=IT_QMR_CS;
-	else if (strcmp(argv[1],"qmr2")==0) IterMethod=IT_QMR_CS_2;
-	/* TO ADD NEW ITERATIVE SOLVER
-	 * add the line to else-if sequence above in the alphabetical order, analogous to the ones already present. The
-	 * variable parts of the line are its name used in command line and its descriptor, defined in const.h
-	 */
-	else NotSupported("Iterative method",argv[1]);
-}
-PARSE_FUNC(jagged)
-{
-	ScanIntError(argv[1],&jagged);
-	TestRange_i(jagged,"jagged",1,BOX_MAX);
-}
-PARSE_FUNC(lambda)
-{
-	ScanDoubleError(argv[1],&lambda);
-	TestPositive(lambda,"wavelength");
-}
-PARSE_FUNC(m)
-{
-	int i;
-	double mre,mim;
-
-	if (!IS_EVEN(Narg) || Narg==0) NargError(Narg,"even");
-	Nmat=Nmat_given=Narg/2;
-	if (Nmat>MAX_NMAT) PrintErrorHelp("Too many materials (%d), maximum %d are supported. You may increase parameter "
-		"MAX_NMAT in const.h and recompile.",Nmat,MAX_NMAT);
-	for (i=0;i<Nmat;i++) {
-		ScanDoubleError(argv[2*i+1],&mre);
-		ScanDoubleError(argv[2*i+2],&mim);
-		ref_index[i] = mre + I*mim;
-		if (ref_index[i]==1) PrintErrorHelp("Given refractive index #%d is that of vacuum, which is not supported. "
-			"Consider using, for instance, 1.0001 instead.",i+1);
-	}
-}
-PARSE_FUNC(maxiter)
-{
-	ScanIntError(argv[1],&maxiter);
-	TestPositive_i(maxiter,"maximum number of iterations");
-}
-PARSE_FUNC(no_reduced_fft)
-{
-	reduced_FFT=false;
-}
-PARSE_FUNC(no_vol_cor)
-{
-	volcor=false;
-}
-PARSE_FUNC(ntheta)
-{
-	ScanIntError(argv[1],&nTheta);
-	TestPositive_i(nTheta,"number of theta intervals");
-	nTheta++;
-}
-PARSE_FUNC(opt)
-{
-	if (strcmp(argv[1],"speed")==0) save_memory=false;
-	else if (strcmp(argv[1],"mem")==0) save_memory=true;
-	else NotSupported("Optimization method",argv[1]);
-}
-PARSE_FUNC(orient)
-{
-	if (Narg==0) NargError(Narg,"at least 1");
-	if (strcmp(argv[1],"avg")==0) {
-		if (Narg>2) NargErrorSub(Narg,"orient avg","0 or 1");
-		orient_avg=true;
-		if (Narg==2) avg_parms=ScanStrError(argv[2],MAX_FNAME);
-	}
-	else {
-		if (Narg!=3) NargError(Narg,"3 or 'avg ...'");
-		ScanDoubleError(argv[1],&alph_deg);
-		ScanDoubleError(argv[2],&bet_deg);
-		ScanDoubleError(argv[3],&gam_deg);
-	}
-	/* this will catch even trivial cases like '-orient 0 0 0', but we still want to point the user to existent
-	 * incompatibilities. This may help to prevent misunderstanding on the user's side.
-	 */
-	orient_used=true;
-}
-PARSE_FUNC(phi_integr)
-{
-	phi_integr = true;
-	ScanIntError(argv[1],&phi_int_type);
-	TestRange_i(phi_int_type,"type of integration over phi",1,31);
-}
-PARSE_FUNC(pol)
-{
-	bool noExtraArgs=true;
-
-	if (Narg!=1 && Narg!=2) NargError(Narg,"1 or 2");
-	if (strcmp(argv[1],"cldr")==0) PolRelation=POL_CLDR;
-	else if (strcmp(argv[1],"cm")==0) PolRelation=POL_CM;
-	else if (strcmp(argv[1],"dgf")==0) PolRelation=POL_DGF;
-	else if (strcmp(argv[1],"fcd")==0) PolRelation=POL_FCD;
-	else if (strcmp(argv[1],"igt_so")==0) PolRelation=POL_IGT_SO;
-	else if (strcmp(argv[1],"lak")==0) PolRelation=POL_LAK;
-	else if (strcmp(argv[1],"ldr")==0) {
-		PolRelation=POL_LDR;
-		if (Narg!=1 && Narg!=2) NargErrorSub(Narg,"pol ldr","from 0 to 1");
-		if (Narg==2) {
-			if (strcmp(argv[2],"avgpol")==0) avg_inc_pol=true;
-			else PrintErrorHelpSafe("Unknown argument '%s' to '-pol ldr' option",argv[2]);
-		}
-		noExtraArgs=false;
-	}
-	else if (strcmp(argv[1],"nloc")==0) {
-		PolRelation=POL_NLOC;
-		if (Narg!=2) NargErrorSub(Narg,"pol nloc","1");
-		ScanDoubleError(argv[2],&polNlocRp);
-		TestNonNegative(polNlocRp,"Gaussian width");
-		noExtraArgs=false;
-	}
-	else if (strcmp(argv[1],"nloc_av")==0) {
-		PolRelation=POL_NLOC_AV;
-		if (Narg!=2) NargErrorSub(Narg,"pol nloc_av","1");
-		ScanDoubleError(argv[2],&polNlocRp);
-		TestNonNegative(polNlocRp,"Gaussian width");
-		noExtraArgs=false;
-	}
-	else if (strcmp(argv[1],"rrc")==0) PolRelation=POL_RRC;
-	else if (strcmp(argv[1],"so")==0) PolRelation=POL_SO;
-	/* TO ADD NEW POLARIZABILITY FORMULATION
-	 * add the line to else-if sequence above in the alphabetical order, analogous to the ones already present. The
-	 * variable parts of the line are its name used in command line and its descriptor, defined in const.h. If
-	 * subarguments are used, test their quantity explicitly, process (scan) subarguments, and set noExtraArgs to false.
-	 * See "nloc" for example. You may also need to change the test for Narg in the beginning of this function.
-	 */
-	else NotSupported("Polarizability relation",argv[1]);
-	TestExtraNarg(Narg,noExtraArgs,argv[1]);
-}
-PARSE_FUNC(prognosis)
-{
-	prognosis=true;
-	run_name="test";
-}
-PARSE_FUNC(prop)
-{
-	double tmp;
-
-	ScanDoubleError(argv[1],prop_0);
-	ScanDoubleError(argv[2],prop_0+1);
-	ScanDoubleError(argv[3],prop_0+2);
-	tmp=DotProd(prop_0,prop_0);
-	if (tmp==0) PrintErrorHelp("Given propagation vector is null");
-	vMultScal(1/sqrt(tmp),prop_0,prop_0);
-	prop_used=true;
-}
-PARSE_FUNC(recalc_resid)
-{
-	recalc_resid=true;
-}
-PARSE_FUNC(rect_dip)
-{
-	ScanDoubleError(argv[1],&rectScaleX);
-	ScanDoubleError(argv[2],&rectScaleY);
-	ScanDoubleError(argv[3],&rectScaleZ);
-	TestPositive(rectScaleX,"x-scale of rectangular dipole");
-	TestPositive(rectScaleY,"y-scale of rectangular dipole");
-	TestPositive(rectScaleZ,"z-scale of rectangular dipole");
-	rectDip=true;
-	if (rectScaleX!=rectScaleY) symR=false;
-}
-#ifndef SPARSE
-PARSE_FUNC(save_geom)
-{
-	if (Narg>1) NargError(Narg,"0 or 1");
-	save_geom=true;
-	if (Narg==1) save_geom_fname=ScanStrError(argv[1],MAX_FNAME);
-}
-#endif
-PARSE_FUNC(scat)
-{
-	if (strcmp(argv[1],"dr")==0) ScatRelation=SQ_DRAINE;
-	else if (strcmp(argv[1],"fin")==0) ScatRelation=SQ_FINDIP;
-	else if (strcmp(argv[1],"igt_so")==0) ScatRelation=SQ_IGT_SO;
-	else if (strcmp(argv[1],"so")==0) ScatRelation=SQ_SO;
-	else NotSupported("Scattering quantities relation",argv[1]);
-}
-PARSE_FUNC(scat_grid_inp)
-{
-	scat_grid_parms=ScanStrError(argv[1],MAX_FNAME);
-}
-PARSE_FUNC(scat_matr)
-{
-	if (strcmp(argv[1],"muel")==0) {
-		store_mueller=true;
-		store_ampl=false;
-	}
-	else if (strcmp(argv[1],"ampl")==0) {
-		store_mueller=false;
-		store_ampl=true;
-	}
-	else if (strcmp(argv[1],"both")==0) store_mueller=store_ampl=true;
-	else if (strcmp(argv[1],"none")==0) store_mueller=store_ampl=false;
-	else NotSupported("Scattering matrix specifier",argv[1]);
-}
-PARSE_FUNC(scat_plane)
-{
-	scat_plane_used = true;
-	scat_plane = true;
-}
-#ifndef SPARSE
-PARSE_FUNC(sg_format)
-{
-	if (strcmp(argv[1],"text")==0) sg_format=SF_TEXT;
-	else if (strcmp(argv[1],"text_ext")==0) sg_format=SF_TEXT_EXT;
-	else if (strcmp(argv[1],"ddscat6")==0) sg_format=SF_DDSCAT6;
-	else if (strcmp(argv[1],"ddscat7")==0) sg_format=SF_DDSCAT7;
-	/* TO ADD NEW FORMAT OF SHAPE FILE
-	 * Based on argument of command line option '-sg_format' assign value to variable 'sg_format' (one of handles
-	 * defined in const.h).
-	 */
-	else NotSupported("Geometry format",argv[1]);
-}
-#endif
-PARSE_FUNC(shape)
-{
-	int i,j,need;
-	bool found;
-
-	if (Narg==0) PrintErrorHelp("Suboption (argument) is missing for '-shape' option");
-	Narg--;
-	found=false;
-	i=-1;
-	while (shape_opt[++i].name!=NULL) if (strcmp(argv[1],shape_opt[i].name)==0) {
-		// set shape and shape option index
-		shape=(enum sh)shape_opt[i].type;
-		opt.l2=i;
-		opt_sh=opt;
-		sh_Npars=Narg;
-		need=shape_opt[i].narg;
-		// check number of arguments
-		switch (shape) {
-			case SH_COATED: if (Narg!=1 && Narg!=4) NargError(Narg,"1 or 4"); break;
-			case SH_BOX: if (Narg!=0 && Narg!=2) NargError(Narg,"0 or 2"); break;
-			default: TestNarg(Narg,need); break;
-		}
-		/* TO ADD NEW SHAPE
-		 * If the shape accepts variable number of arguments (UNDEF was used in shape definition above) add a check of
-		 * number of received arguments as a new case above. Use NargError function similarly as done in existing tests.
-		 */
-		// either parse filename or parse all parameters as float; consistency is checked later
-		if (!ScanFnamesError(Narg,need,argv+2,&shape_fname,NULL))
-			for (j=0;j<Narg;j++) ScanDoubleError(argv[j+2],sh_pars+j);
-		// stop search
-		found=true;
-		break;
-	}
-	if (!found) NotSupported("Shape type",argv[1]);
-	// set shape name; takes place only if shape name was matched above
-	shapename=argv[1];
-}
-PARSE_FUNC(size)
-{
-	ScanDoubleError(argv[1],&sizeX);
-	TestPositive(sizeX,"particle size");
-}
-PARSE_FUNC(store_beam)
-{
-	store_beam = true;
-}
-PARSE_FUNC(store_dip_pol)
-{
-	store_dip_pol=true;
-}
-PARSE_FUNC(store_force)
-{
-	store_force = true;
-	calc_mat_force = true;
-}
-#ifndef SPARSE
-PARSE_FUNC(store_grans)
-{
-	store_grans=true;
-}
-#endif
-PARSE_FUNC(store_int_field)
-{
-	store_int_field=true;
-}
-PARSE_FUNC(store_scat_grid)
-{
-	store_scat_grid = true;
-}
-PARSE_FUNC(surf)
-{
-	double mre,mim;
-	if (Narg!=2 && Narg!=3) NargError(Narg,"2 or 3");
-	ScanDoubleError(argv[1],&hsub);
-	TestPositive(hsub,"height above surface");
-	if (strcmp(argv[2],"inf")==0) {
-		if (Narg>2) PrintErrorHelp("Additional arguments are not allowed for '-surf ... inf'");
-		msubInf=true;
-	}
-	else {
-		if (Narg!=3) NargError(Narg,"total 3 or second argument 'inf'");
-		ScanDoubleError(argv[2],&mre);
-		ScanDoubleError(argv[3],&mim);
-		msub = mre + I*mim;
-	}
-	surface = true;
-	symZ=false;
-}
-PARSE_FUNC(sym)
-{
-	if (strcmp(argv[1],"auto")==0) sym_type=SYM_AUTO;
-	else if (strcmp(argv[1],"no")==0) sym_type=SYM_NO;
-	else if (strcmp(argv[1],"enf")==0) sym_type=SYM_ENF;
-	else NotSupported("Symmetry option",argv[1]);
-}
-PARSE_FUNC(test)
-{
-	run_name="test";
-}
-PARSE_FUNC(V)
-{
-	char copyright[]="\n\nCopyright (C) 2006-2018 ADDA contributors\n"
-		"This program is free software; you can redistribute it and/or modify it under the terms of the GNU General "
-		"Public License as published by the Free Software Foundation; either version 3 of the License, or (at your "
-		"option) any later version.\n\n"
-		"This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the "
-		"implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License "
-		"for more details.\n\n"
-		"You should have received a copy of the GNU General Public License along with this program. If not, see "
-		"<http://www.gnu.org/licenses/>.\n";
-	char ccver_str[MAX_LINE];
-#if defined(__DECC)
-	char cctype;
-#elif defined(__BORLANDC__)
-	int ccver;
-#endif
-	size_t num;
-	int bits,len;
-
-	if (IFROOT) {
-		// compiler & version (works only for selected compilers)
-		// Intel
-#if defined(__ICC) || defined(__INTEL_COMPILER)
-#	define COMPILER "Intel"
-#	ifdef __INTEL_COMPILER
-#		define CCVERSION __INTEL_COMPILER
-#	else
-#		define CCVERSION __ICC
-#	endif
-		sprintf(ccver_str,"%d.%d",CCVERSION/100,CCVERSION%100);
-		// DEC (Compaq)
-#elif defined(__DECC)
-#	define COMPILER "DEC (Compaq)"
-		cctype=(__DECC_VER/10000)%10;
-		if (cctype==6) cctype='T';
-		else if (cctype==8) cctype='S';
-		else if (cctype==9) cctype='V';
-		else cctype=' ';
-		sprintf(ccver_str,"%c%d.%d-%d",cctype,__DECC_VER/10000000,(__DECC_VER/100000)%100,__DECC_VER%1000);
-		// Borland
-#elif defined(__BORLANDC__)
-#	define COMPILER "Borland"
-		sprintf(ccver_str,"%x",__BORLANDC__);
-		sscanf(ccver_str,"%d",&ccver);
-		sprintf(ccver_str,"%d.%d",ccver/100,ccver%100);
-		// Microsoft
-#elif defined(_MSC_VER)
-#	define COMPILER "Microsoft"
-		sprintf(ccver_str,"%d.%d",_MSC_VER/100,_MSC_VER%100);
-		// GNU
-#elif defined(__GNUC__)
-#	define COMPILER "GNU"
-		sprintf(ccver_str,"%d.%d.%d",__GNUC__,__GNUC_MINOR__,__GNUC_PATCHLEVEL__);
-		// IBM
-#elif defined(__xlc__)
-#	define COMPILER "IBM"
-		strncpy(ccver_str,__xlc__,MAX_LINE-1);
-		// unknown compiler
-#else
-#	define COMPILER_UNKNOWN
-#	define COMPILER "unknown"
-#endif
-		// print version, MPI standard, type and compiler information, bit-mode
-#ifdef GITHASH // git hash is printed if available, but only here
-		printf("ADDA v."ADDA_VERSION" ("GITHASH")\n");
-#else
-		printf("ADDA v."ADDA_VERSION"\n");
-#endif
-#ifdef OPENCL
-#	if defined(CL_VERSION_1_2)
-#		define OCL_VERSION "1.2"
-#	elif defined(CL_VERSION_1_1)
-#		define OCL_VERSION "1.1"
-#	elif defined(CL_VERSION_1_0)
-#		define OCL_VERSION "1.0"
-#	else // this should never happen, since minimum OpenCL version is checked in oclcore.h
-#		error "OpenCL version not recognized"
-#	endif
-		printf("GPU-accelerated version conforming to OpenCL standard "OCL_VERSION"\n");
-#	ifdef CLFFT_AMD
-		printf("Linked to clFFT version %d.%d.%d\n",clfftVersionMajor,clfftVersionMinor,clfftVersionPatch);
-#	endif
-#	ifdef OCL_BLAS
-		printf("Linked to clBLAS version %d.%d.%d\n",clblasVersionMajor,clblasVersionMinor,
-			clblasVersionPatch);
-#	endif
-#elif defined(ADDA_MPI)
-		// Version of MPI standard is specified
-		printf("Parallel version conforming to MPI standard %d.%d\n",RUN_MPI_VER_REQ,RUN_MPI_SUBVER_REQ);
-#	ifdef MPICH2
-		printf("Linked to MPICH2 version "MPICH2_VERSION"\n");
-#	elif defined(OPEN_MPI)
-		printf("Linked to OpenMPI version %d.%d.%d\n",OMPI_MAJOR_VERSION,OMPI_MINOR_VERSION,OMPI_RELEASE_VERSION);
-#	endif
-		// Additional debug information about MPI implementation
-#	ifndef SUPPORT_MPI_BOOL
-		D("No full support for MPI_C_BOOL (emulated)");
-#	endif
-#	ifndef SUPPORT_MPI_COMPLEX
-		D("No support for complex MPI datatypes (emulated)");
-#	else
-#		ifndef SUPPORT_MPI_COMPLEX
-		D("Complex MPI datatypes are supported, but their use in reduce operations is not supported (emulated)");
-#		endif
-#	endif
-#else
-		printf("Sequential version\n");
-#endif
-		printf("Built with "COMPILER" compilers");
-#ifndef COMPILER_UNKNOWN
-		printf(" version %s",ccver_str);
-#endif
-		// determine number of bits in size_t; not the most efficient way, but should work robustly
-		num=SIZE_MAX;
-		bits=1;
-		while(num>>=1) bits++;
-		printf(" (%d-bit)\n",bits);
-#ifdef __MINGW64_VERSION_STR
-		printf("      using MinGW-64 environment version "__MINGW64_VERSION_STR"\n");
-#elif defined(__MINGW32_VERSION)
-		printf("      using MinGW-32 environment version %g\n",__MINGW32_VERSION);
-#endif
-		// extra build flags - can it be shortened by some clever defines?
-		const char build_opts[]=
-#ifdef DEBUGFULL
-		"DEBUGFULL, "
-#elif defined(DEBUG)
-		"DEBUG, "
-#endif
-#ifdef FFT_TEMPERTON
-		"FFT_TEMPERTON, "
-#endif
-#ifdef PRECISE_TIMING
-		"PRECISE_TIMING, "
-#endif
-#ifdef NOT_USE_LOCK
-		"NOT_USE_LOCK, "
-#elif defined(ONLY_LOCKFILE)
-		"ONLY_LOCKFILE, "
-#endif
-#ifdef NO_FORTRAN
-		"NO_FORTRAN, "
-#endif
-#ifdef NO_CPP
-		"NO_CPP, "
-#endif
-#ifdef OVERRIDE_STDC_TEST
-		"OVERRIDE_STDC_TEST, "
-#endif
-#ifdef OCL_READ_SOURCE_RUNTIME
-		"OCL_READ_SOURCE_RUNTIME, "
-#endif
-#ifdef CLFFT_APPLE
-		"CLFFT_APPLE, "
-#endif
-#ifdef SPARSE
-		"SPARSE, "
-#endif
-#ifdef USE_SSE3
-		"USE_SSE3, "
-#endif
-#ifdef OCL_BLAS
-		"OCL_BLAS, "
-#endif
-#ifdef NO_GITHASH
-		"NO_GITHASH, "
-#endif
-		"";
-		printf("Extra build options: ");
-		len=strlen(build_opts);
-		if (len==0) printf("none");
-		else printf("%.*s",len-2,build_opts); // trailing comma and space are omitted
-		// print copyright information
-		WrapLines(copyright);
-		printf("%s",copyright);
-	}
-	// exit
-	Stop(EXIT_SUCCESS);
-#undef COMPILER
-#undef CCVERSION
-#undef COMPILER_UNKNOWN
-#undef BUILD_OPTS_SIZE
-}
-PARSE_FUNC(vec)
-{
-	calc_vec = true;
-}
-PARSE_FUNC(yz)
-{
-	yz_used = true;
-	yzplane = true;
-}
-/* TO ADD NEW COMMAND LINE OPTION
- * add a function definition to this list. It should start with 'PARSE_FUNC(option_name)', and contain all necessary
- * logic (code) to implement (or register) command line option. Typically, it should check number of parameters (if
- * UNDEF was used instead of number of parameters in the option definition), scanf input parameters (if any) and check
- * them for consistency and set the values of some internal variables or flags. These variables should be defined in
- * the beginning of this file and initialized in InitVariables() below. It is recommended to use functions from param.h
- * and those defined above since they are designed to be overflow-safe for any input parameters and would automatically
- * produce informative output in case of error. If a new command line option contains suboptions, you may easily parse
- * them using the suboption structure (which should be defined in the beginning of this file). See PARSE_FUNC(beam) and
- * PARSE_FUNC(shape) above for examples. Potential conflicts or interactions between different command line options
- * should be processed in VariablesInterconnect() below. If any output in log files or stdout should be produced based
- * on the values of command line option, this should be implemented in PrintInfo() below.
- */
-#undef PAR
-#undef PARSE_FUNC
-#undef PARSE_NAME
-
-// end of parsing functions
-//=============================================================
-
-static FILEHANDLE CreateLockFile(const char * restrict fname ONLY_FOR_LOCK)
-// create lock file; works only if USE_LOCK is enabled
-{
-#ifdef USE_LOCK
-	FILEHANDLE fd;
-	int i;
-
-#	ifdef WINDOWS
-	i=0;
-	while ((fd=CreateFile(fname,GENERIC_WRITE,FILE_SHARE_WRITE,NULL,CREATE_NEW,FILE_ATTRIBUTE_NORMAL,NULL))
-		    ==INVALID_HANDLE_VALUE) {
-		Sleep(LOCK_WAIT*1000);
-		if (i++ == MAX_LOCK_WAIT_CYCLES) LogError(ONE_POS,"Lock file %s permanently exists",fname);
-	}
-#	elif defined(POSIX)
-#		ifdef LOCK_FOR_NFS
-	struct flock lock;
-#		endif
-	// open file exclusively
-	i=0;
-	while ((fd=open(fname,O_WRONLY | O_CREAT | O_EXCL,0666))==-1) {
-		sleep(LOCK_WAIT);
-		if (i++ == MAX_LOCK_WAIT_CYCLES) LogError(ONE_POS,"Lock file %s permanently exists",fname);
-	}
-#		ifdef LOCK_FOR_NFS
-	// specify lock
-	lock.l_type=F_WRLCK;
-	lock.l_whence=SEEK_SET;
-	lock.l_start=0;
-	lock.l_len=0;
-	// obtain lock*/
-	i=0;
-	while (fcntl(fd,F_SETLK,&lock)==-1) {
-		// if locked by another process wait and try again
-		if (errno==EACCES || errno==EAGAIN) {
-			sleep(LOCK_WAIT);
-			if (i++ == MAX_LOCK_WAIT_CYCLES) LogError(ONE_POS,"Lock file %s permanently exists",fname);
-		}
-		else { // otherwise produce a message and continue
-			if (errno==EOPNOTSUPP || errno==ENOLCK || errno==ENOSYS)
-				LogWarning(EC_WARN,ONE_POS,"Advanced file locking is not supported by the file system");
-			else LogWarning(EC_WARN,ONE_POS,"Unknown problem with file locking ('%s').",strerror(errno));
-			break;
-		}
-	}
-#		endif
-#	endif
-	// return file handle
-	return fd;
-#else
-	return 0;
-#endif
-}
-
-//======================================================================================================================
-
-static void RemoveLockFile(FILEHANDLE fd ONLY_FOR_LOCK,const char * restrict fname ONLY_FOR_LOCK)
-// closes and remove lock file; works only if USE_LOCK is enabled
-{
-#ifdef USE_LOCK
-#	ifdef WINDOWS
-	// close file
-	CloseHandle(fd);
-#	elif defined(POSIX)
-	// close file; all locks are automatically released
-	close(fd);
-#	endif
-	// remove lock file
-	RemoveErr(fname,ONE_POS);
-#endif
-}
-
-//======================================================================================================================
-
-static void UpdateSymVec(const double a[static 3])
-// tests whether vector a satisfies a number of symmetries (with round-off errors) and cancels the failing symmetries
-{
-	if (fabs(a[0])>ROUND_ERR) symX=false;
-	if (fabs(a[1])>ROUND_ERR) symY=false;
-	if (fabs(a[2])>ROUND_ERR) symZ=false;
-	if (!vAlongZ(a)) symR=false;
-}
-
-//======================================================================================================================
-
-void InitVariables(void)
-// some defaults are specified also in const.h
-{
-	rectDip=false;
-	prop_used=false;
-	orient_used=false;
-	directory="";
-	lambda=TWO_PI;
-	// initialize ref_index of scatterer
-	Nmat=Nmat_given=1;
-	ref_index[0]=1.5;
-	// initialize to null to determine further whether it is initialized
-	logfile=NULL;
-	boxX=boxY=boxZ=UNDEF;
-	sizeX=UNDEF;
-	a_eq=UNDEF;
-	dpl=UNDEF;
-	run_name="run";
-	nTheta=UNDEF;
-	iter_eps=1E-5;
-	shape=SH_SPHERE;
-	shapename="sphere";
-	store_int_field=false;
-	store_dip_pol=false;
-	PolRelation=UNDEF;
-	avg_inc_pol=false;
-	ScatRelation=SQ_DRAINE;
-	IntRelation=G_POINT_DIP;
-	IterMethod=IT_QMR_CS;
-	sym_type=SYM_AUTO;
-	prognosis=false;
-	maxiter=UNDEF;
-	jagged=1;
-	beamtype=B_PLANE;
-	alldir_parms=FD_ALLDIR_PARMS;
-	avg_parms=FD_AVG_PARMS;
-	scat_grid_parms=FD_SCAT_PARMS;
-	chp_dir=FD_CHP_DIR;
-	chp_time=UNDEF;
-	chp_type=CHP_NONE;
-	orient_avg=false;
-	alph_deg=bet_deg=gam_deg=0.0;
-	volcor=true;
-	reduced_FFT=true;
-	save_geom=false;
-	save_geom_fname="";
-	yzplane=false;
-	yz_used=false;
-	scat_plane=false;
-	scat_plane_used=false;
-	all_dir=false;
-	scat_grid=false;
-	phi_integr=false;
-	store_scat_grid=false;
-	calc_Cext=true;
-	calc_Cabs=true;
-	calc_Csca=false;
-	calc_vec=false;
-	calc_asym=false;
-	calc_mat_force=false;
-	store_force=false;
-	store_mueller=true;
-	store_ampl=false;
-	store_grans=false;
-	load_chpoint=false;
-	sh_granul=false;
-	symX=symY=symZ=symR=true;
-	anisotropy=false;
-	save_memory=false;
-	sg_format=SF_TEXT;
-	memory=0;
-	memPeak=0;
-	Ncomp=1;
-	igt_lim=UNDEF;
-	igt_eps=UNDEF;
-	InitField=IF_AUTO;
-	recalc_resid=false;
-	surface=false;
-	msubInf=false;
-	ReflRelation=UNDEF;
-	// sometimes the following two are left uninitialized
-	beam_fnameX=NULL;
-	infi_fnameX=NULL;
-	rectScaleX=1.0;
-	rectScaleY=1.0;
-	rectScaleZ=1.0;
-	maxRectScale=1;
-
-#ifdef OPENCL
-	gpuInd=0;
-#endif
-	/* TO ADD NEW COMMAND LINE OPTION
-	 * If you use some new variables, flags, etc. you should specify their default values here. This value will be used
-	 * if new option is not specified in the command line.
-	 */
-}
-
-//======================================================================================================================
-
-void ParseParameters(const int argc,char **argv)
-// parses input parameters
-{
-	int i,j,Narg,tmp;
-	bool found;
-	char *p1,*p2;
-
-	// try to determine terminal width
-	if ((p1=getenv("COLUMNS"))!=NULL && sscanf(p1,"%d",&tmp)==1 && tmp>=MIN_TERM_WIDTH) term_width=tmp;
-	// get name of executable; remove all path overhead
-	if ((p1=strrchr(argv[0],'\\'))==NULL) p1=argv[0];
-	if ((p2=strrchr(argv[0],'/'))==NULL) p2=argv[0];
-	exename=MAX(p1,p2)+1;
-	// initialize option
-	opt.l1=UNDEF;
-	// check first argument
-	if (argc>1 && !IsOption(argv[1])) PrintErrorHelpSafe("Illegal format of first argument '%s'",argv[1]);
-	// read command line
-	for (i=1;i<argc;i++) {
-		// get number of arguments
-		Narg=0;
-		while ((i+(++Narg))<argc && !IsOption(argv[i+Narg]));
-		Narg--;
-
-		argv[i]++; // shift to remove "-" in the beginning of the string
-		found=false;
-		opt.l1=opt.l2=UNDEF;
-		for (j=0;j<LENGTH(options);j++) if (strcmp(argv[i],options[j].name)==0) {
-			opt.l1=j;
-			// check consistency, if enabled for this parameter
-			TestNarg(Narg,options[j].narg);
-			// parse this parameter
-			(*options[j].func)(Narg,argv+i);
-			// check duplicate options; it is safe since at this point argv[i] is known to be normal
-			if (options[j].used) PrintError("Option '-%s' is used more than once",argv[i]);
-			else options[j].used=true;
-			// stop search
-			found=true;
-			break;
-		}
-		if(!found) PrintErrorHelpSafe("Unknown option '-%s'",argv[i]);
-		argv[i]--; // shift back
-		i+=Narg;
-	}
-}
-
-//======================================================================================================================
-
-void VariablesInterconnect(void)
-// finish parameters initialization based on their interconnections
-{
-	double temp;
-
-	// initialize WaveNum ASAP
-	WaveNum = TWO_PI/lambda;
-	// set default incident direction, which is +z for all configurations
-	if (!prop_used) {
-		prop_0[0]=prop_0[1]=0;
-		prop_0[2]=1;
-	}
-	// parameter interconnections
-	if (IntRelation==G_SO) {
-		reduced_FFT=false;
-		// this limitation is due to assumption of reciprocity in DecayCross()
-		if (beamtype==B_DIPOLE) PrintError("'-beam dipole' and '-int so' can not be used together");
-	}
-	/* TO ADD NEW INTERACTION FORMULATION
-	 * If the new Green's tensor is non-symmetric (which is very unlikely) add it to the definition of reduced_FFT
-	 */
-	if (calc_Csca || calc_vec) all_dir = true;
-	// by default, one of the scattering options is activated
-	if (store_scat_grid || phi_integr) scat_grid = true;
-	else if (!scat_plane_used && !yz_used) { // default values when no scattering plane is explicitly specified
-		if (surface) scat_plane = true;
-		else yzplane = true;
-	}
-	// if not initialized before, IGT precision is set to that of the iterative solver
-	if (igt_eps==UNDEF) igt_eps=iter_eps;
-	// defautl polarizability formulation depends on rect_dip
-	if (PolRelation==UNDEF) PolRelation = rectDip ? POL_CLDR : POL_LDR;
-	// parameter incompatibilities
-	if (scat_plane && yzplane) PrintError("Currently '-scat_plane' and '-yz' cannot be used together.");
-	if (orient_avg) {
-		if (prop_used) PrintError("'-prop' and '-orient avg' can not be used together");
-		if (store_int_field) PrintError("'-store_int_field' and '-orient avg' can not be used together");
-		if (store_dip_pol) PrintError("'-store_dip_pol' and '-orient avg' can not be used together");
-		if (store_beam) PrintError("'-store_beam' and '-orient avg' can not be used together");
-		if (beamtype==B_READ) PrintError("'-beam read' and '-orient avg' can not be used together");
-		if (scat_grid) PrintError("'-orient avg' can not be used with calculation of scattering for a grid of angles");
-		// TODO: this limitation should be removed in the future
-		if (all_dir) PrintError("Currently '-orient avg' can not be used with calculation of asym or Csca");
-		if (calc_mat_force) PrintError("Currently '-orient avg' can not be used with calculation of Cpr");
-		if (store_force) PrintError("'-store_force' and '-orient avg' can not be used together");
-		if (!store_mueller && store_ampl) {
-			store_ampl=false;
-			LogWarning(EC_WARN,ONE_POS,"Amplitude matrix can not be averaged over orientations. So switching off "
-				"calculation of Mueller matrix results in no calculation of scattering matrices at all.");
-		}
-		if (scat_plane && yzplane) PrintError("Only one scattering plane can be used during orientation averaging, so "
-			"a combination of '-scat_plane' and '-yz' cannot be used together with '-orient avg'.");
-	}
-	if (phi_integr && !store_mueller) PrintError("Integration over phi can only be performed for Mueller matrix. "
-		"Hence, '-phi_integr' is incompatible with '-scat_matr {ampl|none}'");
-	if (!store_mueller && !store_ampl) {
-		if (nTheta!=UNDEF) PrintError("'-scat_matr none' turns off calculation of angle-resolved quantities making "
-			"'-ntheta' irrelevant. Hence, these two options are incompatible.");
-		if (store_scat_grid) PrintError("'-scat_matr none' turns off calculation of angle-resolved quantities. Hence, "
-			"it is incompatible with '-store_scat_grid'.");
-		if (yz_used) PrintError("'-scat_matr none' turns off calculation of angle-resolved quantities. Hence, it is "
-			"incompatible with '-yz'.");
-		if (scat_plane_used) PrintError("'-scat_matr none' turns off calculation of angle-resolved quantities. Hence, "
-			"it is incompatible with '-scat_plane'.");
-		nTheta=0;
-		yzplane=false;
-		scat_plane=false;
-		scat_grid=false;
-	}
-	if (rectDip) {
-		maxRectScale=MAX(rectScaleX,rectScaleY);
-		MAXIMIZE(maxRectScale,rectScaleZ);
-		if (PolRelation!=POL_CLDR && PolRelation!=POL_CM && PolRelation!=POL_IGT_SO)
-			PrintError("The specified polarizability formulation is designed only for cubical dipoles. Currently, only "
-			"the following formulations can be used with rectangular dipoles: cm, cldr, and igt_so");
-		else if (PolRelation!=POL_IGT_SO && IntRelation==G_IGT) LogWarning(EC_WARN,ONE_POS,"Using IGT interaction with "
-			"point-dipole polarizability formulations will produce wrong results for rectangular dipoles. In most "
-			"cases you should use '-rect_dip ... -int igt ... -pol igt_so'");
-		if (anisotropy) PrintError("Currently '-anisotr' and '-rect_dip' can not be used together");
-		if (sh_granul) PrintError("Currently '-granul' and '-rect_dip' can not be used together");
-		if (IntRelation!=G_POINT_DIP && IntRelation!=G_IGT) PrintError("The specified interaction formulation is "
-			"designed only for cubical dipoles. Currently, only 'poi' and 'igt' can be used with rectangular dipoles");
-	}	
-	if (anisotropy) {
-		if (PolRelation==POL_CLDR) PrintError("'-anisotr' is incompatible with '-pol cldr'");
-		if (PolRelation==POL_SO) PrintError("'-anisotr' is incompatible with '-pol so'");
-		if (ScatRelation==SQ_SO) PrintError("'-anisotr' is incompatible with '-scat so'");
-		if (IntRelation==G_SO) PrintError("'-anisotr' is incompatible with '-int so'");
-		/* TO ADD NEW POLARIZABILITY FORMULATION
-		 * If the new polarizability formulation is incompatible with anisotropic material, add an exception here
-		 */
-		if (Nmat%3!=0)
-			PrintError("When '-anisotr' is used 6 numbers (3 complex values) should be given per each domain");
-		else Nmat=Nmat/3;
-	}
-	if (chp_type!=CHP_NONE) {
-		if (chp_time==UNDEF && chp_type!=CHP_ALWAYS) PrintError("You must specify time for this checkpoint type");
-		// TODO: this limitation should be removed in the future
-		if (orient_avg) PrintError("Currently checkpoint is incompatible with '-orient avg'");
-	}
-	if (sizeX!=UNDEF && a_eq!=UNDEF) PrintError("'-size' and '-eq_rad' can not be used together");
-	if (calc_mat_force && beamtype!=B_PLANE)
-		PrintError("Currently radiation forces can not be calculated for non-plane incident wave");
-	if (InitField==IF_WKB) {
-		if (prop_used) PrintError("Currently '-init_field wkb' and '-prop' can not be used together");
-		if (beamtype!=B_PLANE) PrintError("'-init_field wkb' is incompatible with non-plane incident wave");
-	}
-	if (surface) { // currently a lot of limitations for particles near surface
-		if (orient_used) PrintError("Currently '-orient' and '-surf' can not be used together");
-		if (calc_mat_force) PrintError("Currently calculation of radiation forces is incompatible with '-surf'");
-		if (InitField==IF_WKB) PrintError("'-init_field wkb' and '-surf' can not be used together");
-		if (ReflRelation==UNDEF) ReflRelation = msubInf ? GR_IMG : GR_SOM;
-		else if (msubInf && ReflRelation!=GR_IMG) PrintError("For perfectly reflecting surface interaction is always "
-			"computed through an image dipole. So this case is incompatible with other options to '-int_surf ...'");
-		/* TO ADD NEW REFLECTION FORMULATION
-		 * Take a look at the above logic, and revise if the new formulation is not fully consistent with it
-		 */
-		 if (rectDip && ReflRelation==GR_SOM && rectScaleX!=rectScaleY) PrintError("Currently calculation of "
-			"Sommerfeld integrals (default for the surface mode) requires dipoles to have the same dimensions along "
-			"the x- and y-axes (but not z)");
-	}
-	InteractionRealArgs=(beamtype==B_DIPOLE); // other cases may be added here in the future (e.g. nearfields)
-#ifdef SPARSE
-	if (shape==SH_SPHERE) PrintError("Sparse mode requires shape to be read from file (-shape read ...)");
-#endif
-#if defined(PARALLEL) && !defined(SPARSE)
-	/* Transpose of the non-symmetric interaction matrix can't be done in MPI mode, due to existing memory distribution
-	 * among different processors. This causes problems for iterative solvers, which require a product of Hermitian
-	 * transpose (calculated through the standard transpose) of the matrix with vector (currently, only CGNR). To remove
-	 * this limitation (issue 174) memory distribution should be changed to have both x and gridX-x on the same
-	 * processor.
-	 */
-	if (!reduced_FFT && IterMethod==IT_CGNR) PrintError("Non-symmetric interaction matrix (e.g., -no_reduced_fft) "
-		"can not be used together with CGNR iterative solver in the MPI mode");
-	/* TO ADD NEW ITERATIVE SOLVER
-	 * add the new iterative solver to the above line, if it requires calculation of product of Hermitian transpose
-	 * of the matrix with vector (i.e. calls MatVec function with 'true' as the fourth argument)
-	 */
-#endif
-	// scale boxes by jagged; should be completely robust to overflows
-#define JAGGED_BOX(a) { \
-	if (a!=UNDEF) { \
-		if ((BOX_MAX/(size_t)jagged)<(size_t)a) \
-			LogError(ONE_POS,"Derived grid size (" #a ") is too large (>%d)",BOX_MAX); \
-		else a*=jagged; \
-	} }
-
-	if (jagged!=1) {
-		JAGGED_BOX(boxX);
-		JAGGED_BOX(boxY);
-		JAGGED_BOX(boxZ);
-	}
-#undef JAGGED_BOX
-	/* Determine two incident polarizations. Equivalent to rotation of X,Y,Z basis by angles theta and phi from (0,0,1)
-	 * to given propagation vector.
-	 */
-	if (vAlongZ(prop_0)) {
-		propAlongZ=incPolX_0[0]=copysign(1.0,prop_0[2]);
-		incPolY_0[1]=1;
-		incPolX_0[1]=incPolX_0[2]=incPolY_0[0]=incPolY_0[2]=0.0;
-	}
-	else {
-		propAlongZ=0;
-		if (sym_type==SYM_ENF && scat_plane) PrintError("Enforcing symmetry for incident propagation not along the "
-			"z-axis in combination with defining scattering directions relative to z-axis is not supported");
-		temp=sqrt(1-prop_0[2]*prop_0[2]);
-		incPolX_0[0]=prop_0[0]*prop_0[2]/temp;
-		incPolX_0[1]=prop_0[1]*prop_0[2]/temp;
-		incPolX_0[2]=-temp;
-		incPolY_0[0]=-prop_0[1]/temp;
-		incPolY_0[1]=prop_0[0]/temp;
-		incPolY_0[2]=0.0;
-	}
-	// initialize beam description
-	InitBeam();
-	// initialize averaging over orientation
-	if (orient_avg) {
-		ReadAvgParms(avg_parms);
-		symX=symY=symZ=symR=false;
-		avg_inc_pol=true;
-	}
-	else { // initialize rotation stuff and test symmetries of the beam in particle reference frame
-		InitRotation();
-		UpdateSymVec(prop);
-		if (beam_asym) UpdateSymVec(beam_center);
-	}
-	ipr_required=(IterMethod==IT_BICGSTAB || IterMethod==IT_CGNR);
-	/* TO ADD NEW ITERATIVE SOLVER
-	 * add the new iterative solver to the above line, if it requires inner product calculation during matrix-vector
-	 * multiplication (i.e. calls MatVec function with non-NULL third argument)
-	 */
-
-	/* TO ADD NEW COMMAND LINE OPTION
-	 * If a new command line option may potentially conflict or interact with other options, add here code to implement
-	 * corresponding tests or cross-dependence.
-	 */
-}
-
-//======================================================================================================================
-
-void FinalizeSymmetry(void) {
-	// finalize symmetries
-	if (sym_type==SYM_NO) symX=symY=symZ=symR=false;
-	else if (sym_type==SYM_ENF) symX=symY=symZ=symR=true;
-	// test based on SR^2 = SX*SY; uses handmade XOR
-	if (symR && ((symX&&!symY) || (symY&&!symX))) LogError(ONE_POS,"Inconsistency in internally defined symmetries");
-	// additional tests in case of two polarization runs
-	if (!(symR && !scat_grid)) {
-		if (beamtype==B_READ && beam_fnameX==NULL)
-			PrintError("Only one beam file is specified, while two incident polarizations need to be considered");
-		if (InitField==IF_READ && infi_fnameX==NULL) PrintError("Only one file with initial field is specified, while "
-			"two incident polarizations need to be considered");
-		// the following limitation should be removed in the future
-		if (chp_type!=CHP_NONE) PrintError("Currently checkpoints can be used when internal fields are calculated only "
-			"once, i.e. for a single incident polarization");
-	}
-}
-
-//======================================================================================================================
-
-void DirectoryLog(const int argc,char **argv)
-// create input directory and start logfile
-{
-	int i,Nexp;
-	FILE * restrict Nexpfile;
-	char *compname;
-	FILEHANDLE lockid;
-#ifdef PARALLEL
-	char *ptmp,*ptmp2;
-#endif
-
-	// devise directory name (for output files)
-	if (directory[0]==0) {
-		// root processor works with ExpCount
-		if (IFROOT) {
-			// lock file
-			lockid=CreateLockFile(F_EXPCOUNT_LCK);
-			// read ExpCount
-			if ((Nexpfile=fopen(F_EXPCOUNT,"r"))!=NULL) {
-				if (fscanf(Nexpfile,"%i",&Nexp)!=1) Nexp=0;
-				FCloseErr(Nexpfile,F_EXPCOUNT,ONE_POS);
-			}
-			else Nexp=0;
-			// put new number in Nexpfile
-			Nexpfile=FOpenErr(F_EXPCOUNT,"w",ONE_POS);
-			fprintf(Nexpfile,"%i",Nexp+1);
-			FCloseErr(Nexpfile,F_EXPCOUNT,ONE_POS);
-			// unlock
-			RemoveLockFile(lockid,F_EXPCOUNT_LCK);
-		}
-		// cast Nexp to all processors
-		MyBcast(&Nexp,int_type,1,NULL);
-		/* create automatic directory name; It is stored in the following buffer. MAX_LINE should be enough for
-		 * auto-name, however up to MAX_DIRNAME can be obtained from '-dir ...'. So the latter size is considered in all
-		 * relevant buffers (for filenames or messages).
-		 */
-		static char sbuffer[MAX_LINE];
-		sprintf(sbuffer,"%s%03i_%s_g%i_m"GFORM_RI_DIRNAME,run_name,Nexp,shapename,boxX,creal(ref_index[0]));
-#ifdef PARALLEL
-		// add PBS, SGE or SLURM job id to the directory name if available
-		if ((ptmp=getenv("PBS_JOBID"))!=NULL || (ptmp=getenv("JOB_ID"))!=NULL || (ptmp=getenv("SLURM_JOBID"))!=NULL) {
-			// job ID is truncated at first ".", probably can happen only for PBS
-			if ((ptmp2=strchr(ptmp,'.'))!=NULL) *ptmp2=0;
-			sprintf(sbuffer+strlen(sbuffer),"_id%s",ptmp);
-		}
-#endif
-		directory=sbuffer;
-	}
-	// make new directory and print info
-	if (IFROOT) {
-		MkDirErr(directory,ONE_POS);
-		printf("all data is saved in '%s'\n",directory);
-	}
-	// make logname; do it for all processors to enable additional logging in LogError
-	if (IFROOT) SnprintfErr(ONE_POS,logfname,MAX_FNAME,"%s/"F_LOG,directory);
-	else SnprintfErr(ALL_POS,logfname,MAX_FNAME,"%s/"F_LOG_ERR,directory,ringid);
-	// start logfile
-	if (IFROOT) {
-		// open logfile
-		logfile=FOpenErr(logfname,"w",ONE_POS);
-		// log version number
-		fprintf(logfile,"Generated by ADDA v."ADDA_VERSION"\n");
-		// get computer name
-#ifdef WINDOWS
-		TCHAR cname[MAX_COMPUTERNAME_LENGTH+1];
-		DWORD cname_size=MAX_COMPUTERNAME_LENGTH+1;
-		GetComputerName(cname,&cname_size);
-		compname=cname;
-#else // POSIX and others
-		compname=getenv("HOST");
-#endif
-		// write number of processors and computer name
-#ifdef PARALLEL
-		// write number of processors
-		fprintf(logfile,"The program was run on: %d processors (cores)",nprocs);
-		// add PBS or SGE host name if present, otherwise use compname
-		if ((ptmp=getenv("PBS_O_HOST"))!=NULL || (ptmp=getenv("SGE_O_HOST"))!=NULL) fprintf(logfile," from %s\n",ptmp);
-		else if (compname!=NULL) fprintf(logfile," from %s\n",compname);
-		else fprintf(logfile,"\n");
-#else // sequential
-		if (compname!=NULL) fprintf(logfile,"The program was run on: %s\n",compname);
-#endif
-		// log command line
-		fprintf(logfile,"command: '");
-		for(i=0;i<argc;i++) fprintf(logfile,"%s ",argv[i]);
-		fprintf(logfile,"'\n");
-	}
-	Synchronize(); // needed to wait for creation of the output directory
-	LogPending();
-}
-
-//======================================================================================================================
-
-void PrintInfo(void)
-// print info to stdout and logfile
-{
-	int i;
-	char sbuffer[MAX_LINE];
-
-	if (IFROOT) {
-		// print basic parameters
-		printf("box dimensions: %ix%ix%i\n",boxX,boxY,boxZ);
-		printf("lambda: "GFORM"   Dipoles/lambda: "GFORMDEF"%s\n",lambda,dpl,rectDip ? " (along the x-axis)" : "");
-		printf("Required relative residual norm: "GFORMDEF"\n",iter_eps);
-		printf("Total number of occupied dipoles: %zu\n",nvoid_Ndip);
-		// log basic parameters
-		fprintf(logfile,"lambda: "GFORM"\n",lambda);
-		fprintf(logfile,"shape: ");
-		fprintf(logfile,"%s"GFORM"%s\n",sh_form_str1,sizeX,sh_form_str2);
-#ifndef SPARSE
-		if (sh_granul) fprintf(logfile,"  domain %d is filled with %d granules of diameter "GFORMDEF"\n"
-			"    volume fraction: specified - "GFORMDEF", actual - "GFORMDEF"\n",gr_mat+1,gr_N,gr_d,gr_vf,gr_vf_real);
-#endif // SPARSE
-		fprintf(logfile,"box dimensions: %ix%ix%i\n",boxX,boxY,boxZ);
-		if(rectDip) PrintBoth(logfile,"Using rectangular dipoles with proportions %g:%g:%g (x:y:z)\n",
-			rectScaleX,rectScaleY,rectScaleZ);
-		if (anisotropy) {
-			fprintf(logfile,"refractive index (diagonal elements of the tensor):\n");
-			if (Nmat==1) fprintf(logfile,"    "CFORM3V"\n",REIM3V(ref_index));
-			else {
-				for (i=0;i<Nmat;i++) {
-					if (i<Nmat_given) fprintf(logfile,"    %d. "CFORM3V"\n",i+1,REIM3V(ref_index+3*i));
-					else fprintf(logfile,"   %d. not specified\n",i+1);
-				}
-			}
-		}
-		else {
-			fprintf(logfile,"refractive index: ");
-			if (Nmat==1) fprintf(logfile,CFORM"\n",REIM(ref_index[0]));
-			else {
-				fprintf(logfile,"1. "CFORM"\n",REIM(ref_index[0]));
-				for (i=1;i<Nmat;i++) {
-					if (i<Nmat_given) fprintf(logfile,"                  %d. "CFORM"\n",i+1,REIM(ref_index[i]));
-					else fprintf(logfile,"                  %d. not specified\n",i+1);
-				}
-			}
-		}
-		if (surface) {
-			if (msubInf) fprintf(logfile,"Particle is placed near the perfectly reflecting substrate\n");
-			else fprintf(logfile,"Particle is placed near the substrate with refractive index "CFORM",\n",REIM(msub));
-			fprintf(logfile,"  height of the particle center: "GFORMDEF"\n",hsub);
-		}
-		fprintf(logfile,"Dipoles/lambda: "GFORMDEF"%s\n",dpl,rectDip ? " (along the x-axis)" : "");
-		if (volcor_used) fprintf(logfile,"\t(Volume correction used)\n");
-		fprintf(logfile,"Required relative residual norm: "GFORMDEF"\n",iter_eps);
-		fprintf(logfile,"Total number of occupied dipoles: %zu\n",nvoid_Ndip);
-		if (Nmat>1) {
-			fprintf(logfile,"  per domain: 1. %zu\n",mat_count[0]);
-			for (i=1;i<Nmat;i++) fprintf(logfile,"              %d. %zu\n",i+1,mat_count[i]);
-		}
-		fprintf(logfile,"Volume-equivalent size parameter: "GFORM"\n",ka_eq);
-		// log incident beam and polarization
-		fprintf(logfile,"\n---In laboratory reference frame:---\nIncident beam: %s\n",beam_descr);
-		fprintf(logfile,"Incident propagation vector: "GFORMDEF3V"\n",COMP3V(prop_0));
-		if (beamtype==B_DIPOLE) fprintf(logfile,"(dipole orientation)\n");
-		else { // polarizations are not shown for dipole incident field
-			fprintf(logfile,"Incident polarization Y(par): "GFORMDEF3V"\n",COMP3V(incPolY_0));
-			fprintf(logfile,"Incident polarization X(per): "GFORMDEF3V"\n",COMP3V(incPolX_0));
-		}
-		if (surface && beamtype!=B_DIPOLE) { // include surface-specific vectors
-			fprintf(logfile,"Reflected propagation vector: "GFORMDEF3V"\n",COMP3V(prIncRefl));
-			fprintf(logfile,"Transmitted propagation vector: ");
-			if (msubInf) fprintf (logfile,"none\n");
-			else {
-				fprintf(logfile,GFORMDEF3V,COMP3V(prIncTran));
-				if (prIncTran[2]==0) fprintf(logfile," (evanescent)\n");
-				else fprintf(logfile,"\n");
-			}
-		}
-		fprintf(logfile,"\n");
-		// log particle orientation
-		if (orient_avg) fprintf(logfile,"Particle orientation - averaged\n%s\n",avg_string);
-		else {
-			// log incident polarization after transformation
-			if (alph_deg!=0 || bet_deg!=0 || gam_deg!=0) {
-				fprintf(logfile,"Particle orientation (deg): alpha="GFORMDEF", beta="GFORMDEF", gamma="GFORMDEF"\n\n"
-					"---In particle reference frame:---\n",alph_deg,bet_deg,gam_deg);
-				if (beam_asym) fprintf(logfile,"Incident Beam center position: "GFORMDEF3V"\n",
-					beam_center[0],beam_center[1],beam_center[2]);
-				fprintf(logfile,"Incident propagation vector: "GFORMDEF3V"\n",COMP3V(prop));
-				if (beamtype==B_DIPOLE) fprintf(logfile,"(dipole orientation)\n");
-				else { // polarizations are not shown for dipole incident field
-					fprintf(logfile,"Incident polarization Y(par): "GFORMDEF3V"\n",COMP3V(incPolY));
-					fprintf(logfile,"Incident polarization X(per): "GFORMDEF3V"\n",COMP3V(incPolX));
-				}
-			}
-			else fprintf(logfile,"Particle orientation: default\n");
-			fprintf(logfile,"\n");
-		}
-		// log type of scattering matrices
-		if (store_mueller) {
-			if (store_ampl) fprintf(logfile,"Calculating both amplitude and Mueller scattering matrices\n");
-			else fprintf(logfile,"Calculating only Mueller scattering matrix\n");
-		}
-		else {
-			if (store_ampl) fprintf(logfile,"Calculating only amplitude scattering matrix\n");
-			else fprintf(logfile,"Calculating no scattering matrices\n");
-		}
-		// log polarizability relation
-		fprintf(logfile,"Polarizability relation: ");
-		switch (PolRelation) {
-			case POL_CLDR: fprintf(logfile,"'Corrected Lattice Dispersion Relation'\n"); break;
-			case POL_CM: fprintf(logfile,"'Clausius-Mossotti'\n"); break;
-			case POL_DGF: fprintf(logfile,"'Digitized Green's Function'\n"); break;
-			case POL_FCD: fprintf(logfile,"'Filtered Coupled Dipoles'\n"); break;
-			case POL_IGT_SO: fprintf(logfile,"'Integration of Green's Tensor [approximation O(kd^2)]'\n"); break;
-			case POL_LAK: fprintf(logfile,"'by Lakhtakia'\n"); break;
-			case POL_LDR:
-				fprintf(logfile,"'Lattice Dispersion Relation'");
-				if (avg_inc_pol) fprintf(logfile," (averaged over incident polarization)");
-				fprintf(logfile,"\n");
-				break;
-			case POL_NLOC:
-				fprintf(logfile,"'Non-local' (based on lattice sum, Gaussian width Rp="GFORMDEF")\n",polNlocRp);
-				break;
-			case POL_NLOC_AV:
-				fprintf(logfile,"'Non-local' (averaged, Gaussian width Rp="GFORMDEF")\n",polNlocRp);
-				break;
-			case POL_RRC: fprintf(logfile,"'Radiative Reaction Correction'\n"); break;
-			case POL_SO: fprintf(logfile,"'Second Order'\n"); break;
-		}
-		/* TO ADD NEW POLARIZABILITY FORMULATION
-		 * add a case above in the alphabetical order, analogous to the ones already present. The variable parts of the
-		 * case are descriptor, defined in const.h, and its plain-text description (to be shown in log).
-		 */
-		// log Scattering Quantities formulae
-		fprintf(logfile,"Scattering quantities formulae: ");
-		switch (ScatRelation) {
-			case SQ_DRAINE: fprintf(logfile,"'by Draine'\n"); break;
-			case SQ_FINDIP: fprintf(logfile,"'Finite Dipoles'\n"); break;
-			case SQ_IGT_SO: fprintf(logfile,"'Integration of Green's Tensor [approximation O(kd^2)]'\n"); break;
-			case SQ_SO: fprintf(logfile,"'Second Order'\n"); break;
-		}
-		// log Interaction term prescription
-		fprintf(logfile,"Interaction term prescription: ");
-		switch (IntRelation) {
-			case G_FCD: fprintf(logfile,"'Filtered Green's tensor'\n"); break;
-			case G_FCD_ST: fprintf(logfile,"'Filtered Green's tensor (quasistatic)'\n"); break;
-			case G_IGT:
-				fprintf(logfile,"'Integrated Green's tensor' (accuracy "GFORMDEF", ",igt_eps);
-				if (igt_lim==UNDEF) fprintf(logfile,"no distance limit)\n");
-				else fprintf(logfile,"for distance < "GFORMDEF" dipole sizes%s)\n",igt_lim,
-					rectDip ? " along the greatest dimension" : "");
-				break;
-			case G_IGT_SO: fprintf(logfile,"'Integrated Green's tensor [approximation O(kd^2)]'\n"); break;
-			case G_NLOC: fprintf(logfile,"'Non-local' (point-value, Gaussian width Rp="GFORMDEF")\n",nloc_Rp); break;
-			case G_NLOC_AV: fprintf(logfile,"'Non-local' (averaged, Gaussian width Rp="GFORMDEF")\n",nloc_Rp); break;
-			case G_POINT_DIP: fprintf(logfile,"'as Point dipoles'\n"); break;
-			case G_SO: fprintf(logfile,"'Second Order'\n"); break;
-		}
-		/* TO ADD NEW INTERACTION FORMULATION
-		 * add a case above in the alphabetical order, analogous to the ones already present. The variable parts of the
-		 * case are descriptor, defined in const.h, and its plain-text description (to be shown in log).
-		 */
-		// log reflected Green'tensor formulae
-		if (surface) {
-			fprintf(logfile,"Reflected Green's tensor formulae: ");
-			switch (ReflRelation) {
-				case GR_IMG: fprintf(logfile,"'Image-dipole approximation'\n"); break;
-				case GR_SOM: fprintf(logfile,"'Sommerfeld integrals'\n"); break;
-			}
-		}
-		/* TO ADD NEW REFLECTION FORMULATION
-		 * add a case above in the alphabetical order, analogous to the ones already present. The variable parts of the
-		 * case are descriptor, defined in const.h, and its plain-text description (to be shown in log).
-		 */
-		// log FFT and (if needed) clFFT method
-		fprintf(logfile,"FFT algorithm: ");
-#ifdef FFTW3
-		fprintf(logfile,"FFTW3\n");
-#elif defined(FFT_TEMPERTON)
-		fprintf(logfile,"by C.Temperton\n");
-#elif defined(SPARSE)
-		fprintf(logfile,"none (sparse mode)\n");
-#endif
-#if defined(OPENCL) && !defined(SPARSE)
-		fprintf(logfile,"OpenCL FFT algorithm: ");
-#	ifdef CLFFT_AMD
-		fprintf(logfile,"by AMD\n");
-#	elif defined(CLFFT_APPLE)
-		fprintf(logfile,"by Apple\n");
-#	endif
-#endif
-		// log Iterative Method
-		fprintf(logfile,"Iterative Method: ");
-		switch (IterMethod) {
-			case IT_BCGS2: fprintf(logfile,"Enhanced Bi-CG Stabilized(2)\n"); break;
-			case IT_BICG_CS: fprintf(logfile,"Bi-CG (complex symmetric)\n"); break;
-			case IT_BICGSTAB: fprintf(logfile,"Bi-CG Stabilized\n"); break;
-			case IT_CGNR: fprintf(logfile,"CGNR\n"); break;
-			case IT_CSYM: fprintf(logfile,"CSYM\n"); break;
-			case IT_QMR_CS: fprintf(logfile,"QMR (complex symmetric)\n"); break;
-			case IT_QMR_CS_2: fprintf(logfile,"2-term QMR (complex symmetric)\n"); break;
-		}
-		/* TO ADD NEW ITERATIVE SOLVER
-		 * add a case above in the alphabetical order, analogous to the ones already present. The variable parts of the
-		 * case are descriptor, defined in const.h, and its plain-text description (to be shown in log).
-		 */
-		// log Symmetry options
-		switch (sym_type) {
-			case SYM_AUTO:
-				fprintf(logfile,"Symmetries: ");
-				if (symX) fprintf(logfile,"X");
-				if (symY) fprintf(logfile,"Y");
-				if (symZ) fprintf(logfile,"Z");
-				if (symR) fprintf(logfile,"R");
-				if (!(symX||symY||symZ||symR)) fprintf(logfile,"none");
-				fprintf(logfile,"\n");
-				break;
-			case SYM_NO: fprintf(logfile,"Symmetries: cancelled by user\n"); break;
-			case SYM_ENF: fprintf(logfile,"Symmetries: enforced by user (warning!)\n"); break;
-		}
-		// log optimization method
-		if (save_memory) fprintf(logfile,"Optimization is done for minimum memory usage\n");
-		else fprintf(logfile,"Optimization is done for maximum speed\n");
-		// log Checkpoint options
-		if (load_chpoint) fprintf(logfile,"Simulation is continued from a checkpoint\n");
-		if (chp_type!=CHP_NONE) {
-			fprintf(logfile,"Checkpoint is turned on:\n");
-			switch (chp_type) {
-				case CHP_NONE: break; // redundant; to keep a set of cases complete
-				case CHP_NORMAL: fprintf(logfile,"    type = normal\n"); break;
-				case CHP_REGULAR: fprintf(logfile,"    type = regular\n"); break;
-				case CHP_ALWAYS: fprintf(logfile,"    type = always\n"); break;
-			}
-			if (chp_time==UNDEF) fprintf(logfile,"    time = no limit\n");
-			else {
-				PrintTime(sbuffer,&chp_time);
-				// chp_time is converted to long to avoid problems with definition of time_t (can be either int or long)
-				fprintf(logfile,"    time = %s(%ld sec)\n",sbuffer,(long)chp_time);
-			}
-		}
-		if (load_chpoint || chp_type!=CHP_NONE) fprintf(logfile,"    directory = '%s'\n",chp_dir);
-		/* TO ADD NEW COMMAND LINE OPTION
-		 * If a new command line option requires additional output to log file or stdout, implement this functionality
-		 * here, choosing appropriate place for this information among the above lines.
-		 */
-	}
-}
diff --git a/src/.cproject b/src/.cproject
new file mode 100644
index 00000000..9b251a9e
--- /dev/null
+++ b/src/.cproject
@@ -0,0 +1,140 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<?fileVersion 4.0.0?><cproject storage_type_id="org.eclipse.cdt.core.XmlProjectDescriptionStorage">
+    	
+    <storageModule moduleId="org.eclipse.cdt.core.settings">
+        		
+        <cconfiguration id="cdt.managedbuild.toolchain.gnu.mingw.base.723465254">
+            			
+            <storageModule buildSystemId="org.eclipse.cdt.managedbuilder.core.configurationDataProvider" id="cdt.managedbuild.toolchain.gnu.mingw.base.723465254" moduleId="org.eclipse.cdt.core.settings" name="Default">
+                				
+                <externalSettings/>
+                				
+                <extensions>
+                    					
+                    <extension id="org.eclipse.cdt.core.PE" point="org.eclipse.cdt.core.BinaryParser"/>
+                    					
+                    <extension id="org.eclipse.cdt.core.GASErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+                    					
+                    <extension id="org.eclipse.cdt.core.GLDErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+                    					
+                    <extension id="org.eclipse.cdt.core.GCCErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+                    					
+                    <extension id="org.eclipse.cdt.core.GmakeErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+                    					
+                    <extension id="org.eclipse.cdt.core.CWDLocator" point="org.eclipse.cdt.core.ErrorParser"/>
+                    				
+                </extensions>
+                			
+            </storageModule>
+            			
+            <storageModule moduleId="cdtBuildSystem" version="4.0.0">
+                				
+                <configuration buildProperties="" description="" id="cdt.managedbuild.toolchain.gnu.mingw.base.723465254" name="Default" optionalBuildProperties="" parent="org.eclipse.cdt.build.core.emptycfg">
+                    					
+                    <folderInfo id="cdt.managedbuild.toolchain.gnu.mingw.base.723465254.940084196" name="/" resourcePath="">
+                        						
+                        <toolChain id="cdt.managedbuild.toolchain.gnu.mingw.base.424651525" name="MinGW GCC" superClass="cdt.managedbuild.toolchain.gnu.mingw.base">
+                            							
+                            <targetPlatform archList="all" binaryParser="org.eclipse.cdt.core.PE" id="cdt.managedbuild.target.gnu.platform.mingw.base.193021253" name="Debug Platform" osList="win32" superClass="cdt.managedbuild.target.gnu.platform.mingw.base"/>
+                            							
+                            <builder buildPath="C:\adda3\src" id="cdt.managedbuild.builder.gnu.cross.888301030" managedBuildOn="false" superClass="cdt.managedbuild.builder.gnu.cross"/>
+                            							
+                            <tool id="cdt.managedbuild.tool.gnu.assembler.mingw.base.738995375" name="GCC Assembler" superClass="cdt.managedbuild.tool.gnu.assembler.mingw.base">
+                                								
+                                <inputType id="cdt.managedbuild.tool.gnu.assembler.input.2143708375" superClass="cdt.managedbuild.tool.gnu.assembler.input"/>
+                                							
+                            </tool>
+                            							
+                            <tool id="cdt.managedbuild.tool.gnu.archiver.mingw.base.1562857147" name="GCC Archiver" superClass="cdt.managedbuild.tool.gnu.archiver.mingw.base"/>
+                            							
+                            <tool id="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base.840199152" name="GCC C++ Compiler" superClass="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base"/>
+                            							
+                            <tool id="cdt.managedbuild.tool.gnu.c.compiler.mingw.base.1654760587" name="GCC C Compiler" superClass="cdt.managedbuild.tool.gnu.c.compiler.mingw.base">
+                                								
+                                <inputType id="cdt.managedbuild.tool.gnu.c.compiler.input.885069331" superClass="cdt.managedbuild.tool.gnu.c.compiler.input"/>
+                                							
+                            </tool>
+                            							
+                            <tool id="cdt.managedbuild.tool.gnu.c.linker.mingw.base.855642708" name="MinGW C Linker" superClass="cdt.managedbuild.tool.gnu.c.linker.mingw.base">
+                                								
+                                <inputType id="cdt.managedbuild.tool.gnu.c.linker.input.1899695635" superClass="cdt.managedbuild.tool.gnu.c.linker.input">
+                                    									
+                                    <additionalInput kind="additionalinputdependency" paths="$(USER_OBJS)"/>
+                                    									
+                                    <additionalInput kind="additionalinput" paths="$(LIBS)"/>
+                                    								
+                                </inputType>
+                                							
+                            </tool>
+                            							
+                            <tool id="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base.1172644723" name="MinGW C++ Linker" superClass="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base"/>
+                            						
+                        </toolChain>
+                        					
+                    </folderInfo>
+                    				
+                </configuration>
+                			
+            </storageModule>
+            			
+            <storageModule moduleId="org.eclipse.cdt.core.externalSettings"/>
+            		
+        </cconfiguration>
+        	
+    </storageModule>
+    	
+    <storageModule moduleId="scannerConfiguration">
+        		
+        <autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId=""/>
+        		
+        <scannerConfigBuildInfo instanceId="cdt.managedbuild.toolchain.gnu.mingw.base.1055110387;cdt.managedbuild.toolchain.gnu.mingw.base.1055110387.763791221;cdt.managedbuild.tool.gnu.c.compiler.mingw.base.1203535434;cdt.managedbuild.tool.gnu.c.compiler.input.557581763">
+            			
+            <autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId=""/>
+            		
+        </scannerConfigBuildInfo>
+        	
+    </storageModule>
+    	
+    <storageModule moduleId="cdtBuildSystem" version="4.0.0">
+        		
+        <project id="adda_3_onC.null.1757565600" name="adda_3_onC"/>
+        	
+    </storageModule>
+    	
+    <storageModule moduleId="org.eclipse.cdt.core.LanguageSettingsProviders"/>
+    	
+    <storageModule moduleId="refreshScope" versionNumber="2">
+        		
+        <configuration configurationName="Default">
+            			
+            <resource resourceType="PROJECT" workspacePath="/adda_3_onC"/>
+            		
+        </configuration>
+        	
+    </storageModule>
+    	
+    <storageModule moduleId="org.eclipse.cdt.make.core.buildtargets">
+        		
+        <buildTargets>
+            			
+            <target name="seq" path="" targetID="org.eclipse.cdt.build.MakeTargetBuilder">
+                				
+                <buildCommand>make</buildCommand>
+                				
+                <buildArguments/>
+                				
+                <buildTarget>seq</buildTarget>
+                				
+                <stopOnError>true</stopOnError>
+                				
+                <useDefaultCommand>true</useDefaultCommand>
+                				
+                <runAllBuilders>true</runAllBuilders>
+                			
+            </target>
+            		
+        </buildTargets>
+        	
+    </storageModule>
+    
+</cproject>
diff --git a/src/.gitignore b/src/.gitignore
deleted file mode 100644
index 07090655..00000000
--- a/src/.gitignore
+++ /dev/null
@@ -1,18 +0,0 @@
-/githash.h
-
-# The same ignores apply to all compilation folders
-/*/*.exe
-/*/*.dll
-/*/adda*
-/*/*.o
-/*/*.d
-/*/.*opts
-/*/*stackdump
-/*/ExpCount
-/*/tables/
-/*/run*/
-/*/test*/
-/*/*.dat
-/*/*.geom
-/*/out
-/*/*.clstr
diff --git a/src/.project b/src/.project
new file mode 100644
index 00000000..5f126b26
--- /dev/null
+++ b/src/.project
@@ -0,0 +1,26 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<projectDescription>
+	<name>adda</name>
+	<comment></comment>
+	<projects>
+	</projects>
+	<buildSpec>
+		<buildCommand>
+			<name>org.eclipse.cdt.managedbuilder.core.genmakebuilder</name>
+			<triggers>clean,full,incremental,</triggers>
+			<arguments>
+			</arguments>
+		</buildCommand>
+		<buildCommand>
+			<name>org.eclipse.cdt.managedbuilder.core.ScannerConfigBuilder</name>
+			<triggers>full,incremental,</triggers>
+			<arguments>
+			</arguments>
+		</buildCommand>
+	</buildSpec>
+	<natures>
+		<nature>org.eclipse.cdt.core.cnature</nature>
+		<nature>org.eclipse.cdt.managedbuilder.core.managedBuildNature</nature>
+		<nature>org.eclipse.cdt.managedbuilder.core.ScannerConfigNature</nature>
+	</natures>
+</projectDescription>
diff --git a/src/GenerateB.c b/src/GenerateB.c
index 85019a60..8ab98dea 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -33,9 +33,9 @@
 #include "interaction.h"
 #include "param.h"
 #include "vars.h"
-// system headers
 #include <stdio.h>
 #include <string.h>
+#include "bess.h"
 
 // SEMI-GLOBAL VARIABLES
 
@@ -70,6 +70,8 @@ static double scale_x,scale_z; // multipliers for scaling coordinates
 static doublecomplex ki,kt;    // abs of normal components of k_inc/k0, and ktran/k0
 static doublecomplex ktVec[3]; // k_tran/k0
 static double p0;              // amplitude of the incident dipole moment
+static int n0;                 // Bessel beam order
+static double alpha0;          // half-cone angle
 /* TO ADD NEW BEAM
  * Add here all internal variables (beam parameters), which you initialize in InitBeam() and use in GenerateB()
  * afterwards. If you need local, intermediate variables, put them into the beginning of the corresponding function.
@@ -85,7 +87,6 @@ void InitBeam(void)
 	/* TO ADD NEW BEAM
 	 * Add here all intermediate variables, which are used only inside this function.
 	 */
-
 	// initialization of global option index for error messages
 	opt=opt_beam;
 	// beam initialization
@@ -186,6 +187,43 @@ void InitBeam(void)
 				                                      "\tCenter position: "GFORMDEF3V,w0,s,COMP3V(beam_center_0));
 			}
 			return;
+		case B_BESSELCS:
+		case B_BESSELLE:
+		case B_BESSELLM:
+		case B_BESSELTEC:
+		case B_BESSELTMC:
+			if (surface) PrintError("Currently, Bessel incident beam is not supported for '-surf'");
+			// initialize parameters
+			n0=round(beam_pars[0]);
+			alpha0 = beam_pars[1];
+			vCopy(beam_pars+2,beam_center_0);
+			beam_asym=(beam_Npars==5 && (beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0));
+			symR=symX=symY=symZ=FALSE;
+			if (!beam_asym) vInit(beam_center);
+			if (IFROOT) {
+				strcpy(beam_descr,"Bessel beam (");
+				switch (beamtype) {
+					case B_BESSELCS:
+						strcat(beam_descr,"circularly symmetric energy density)\n");
+						break;
+					case B_BESSELLE:
+						strcat(beam_descr,"linear electric field)\n");
+						break;
+					case B_BESSELLM:
+						strcat(beam_descr,"linear magnetic field)\n");
+						break;
+					case B_BESSELTEC:
+						strcat(beam_descr,"forming TE Bessel beam)\n");
+						break;
+					case B_BESSELTMC:
+						strcat(beam_descr,"forming TM Bessel beam)\n");
+						break;
+					default: break;
+				}
+				sprintf(beam_descr+strlen(beam_descr),"\tOrder=""%d""\n\t""half-cone angle: "GFORMDEF"\n"
+				                                      "\tCenter position: "GFORMDEF3V,n0,alpha0,COMP3V(beam_center_0));
+			}
+			return;
 		case B_READ:
 			// the safest is to assume cancellation of all symmetries
 			symX=symY=symZ=symR=false;
@@ -231,12 +269,13 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 	size_t i,j;
 	doublecomplex psi0,Q,Q2;
 	doublecomplex v1[3],v2[3],v3[3],gt[6];
-	double ro2,ro4;
-	double x,y,z,x2_s,xy_s;
+	double ro, ro2,ro4;
+	double x,y,z,x2_s,xy_s,phi;
 	doublecomplex t1,t2,t3,t4,t5,t6,t7,t8,ctemp;
 	const double *ex; // coordinate axis of the beam reference frame
 	double ey[3];
 	double r1[3];
+	double jn2[2];
 	const char *fname;
 	/* TO ADD NEW BEAM
 	 * Add here all intermediate variables, which are used only inside this function. You may as well use 't1'-'t8'
@@ -427,6 +466,82 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				}
 			}
 			return;
+		case B_BESSELCS:
+		case B_BESSELLE:
+		case B_BESSELLM:
+		case B_BESSELTEC:
+		case B_BESSELTMC:
+			for (i=0;i<local_nvoid_Ndip;i++) {
+				j=3*i;
+				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
+				x=DotProd(r1,ex);
+				y=DotProd(r1,ey);
+				z=DotProd(r1,prop);
+				ro=sqrt(x*x+y*y);	// radial distance in a cilindrical coordinate system
+				phi=atan(y/x);		// angular coordinate in a cilindrical coordinate system
+				t1=WaveNum*sin(alpha0);
+				t2=WaveNum*cos(alpha0);
+				// common factor
+				ctemp=cpow(-I,n0)*cexp(I*n0*phi)*cexp(-I*t2*z);
+				bessjn2(n0,ro*t1,jn2);
+				// field components (see J.J. Wang et.al./JQSRT 184 2016 218-232 [7])
+				switch (beamtype) {
+					case B_BESSELCS:
+						t3=1/2/ro/ro*(jn2[1]*t1*ro*(cos(2*phi)+I*n0*sin(2*phi)) + 
+							jn2[0]*(cexp(-2*I*phi)*(n0-1)*n0+cpow(WaveNum*ro,2)*(cos(alpha0)+
+								pow(cos(alpha0)*cos(phi),2)+pow(sin(phi),2))));
+						t4=1/8/ro/ro*(jn2[1]*4*t1*ro*(-I*n0*cos(2*phi)+sin(2*phi)) +
+							jn2[0]*(4*I*(n0-1)*n0*cos(2*phi)+(4*(n0-1)*n0-
+								cpow(WaveNum*ro,2)*(cos(2*alpha0)-1))*sin(2*phi)));
+						t5=I/2/ro*(WaveNum+t2)*cexp(-I*phi)*(jn2[1]*cexp(I*phi)*ro*t1*cos(phi) -
+							jn2[0]*n0);
+						break;
+					case B_BESSELLE:
+						t3=jn2[0]*t2*WaveNum;
+						t4=0;
+						t5=WaveNum*I*(jn2[1]*t1*cos(phi) -
+							jn2[0]*cexp(-I*phi)/ro*n0);
+						break;
+					case B_BESSELLM:
+						t3=1/ro/ro*(jn2[1]*t1*ro*(I*n0*cos(2*phi)-sin(2*phi)) +
+							jn2[0]*4*(-4*I*(n0-1)*n0*cos(2*phi)+(-4*(n0-1)*n0+
+								cpow(WaveNum*ro,2)*(1-cos(2*alpha0)))*sin(2*phi)));
+						t4=1/4/ro/ro*(jn2[1]*4*t1*ro*(cos(2*phi)+I*n0*sin(2*phi)) -
+							jn2[0]*((-4*(n0-1)*n0 + cpow(WaveNum*ro,2))*cos(2*phi)+
+								cpow(WaveNum*ro,2)*(3+2*cos(2*alpha0)*pow(sin(phi),2))+4*I*(n0-1)*n0*sin(2*phi)));
+						t5=-1/ro*t2*(jn2[1]*I*ro*t1*sin(phi) +
+							jn2[0]*n0*cexp(-I*phi));
+						break;
+					case B_BESSELTEC:
+						t3=1/2/ro/ro*(jn2[1]*ro*WaveNum*(-I*n0*cos(2*phi)+sin(2*phi)) +
+							jn2[0]*(2*I*(n0-1)*n0*cexp(-2*I*phi)/sin(alpha0)+
+								cpow(WaveNum*ro,2)*(2*I*cos(alpha0)/tan(alpha0)-sin(alpha0)*sin(2*phi))));
+						t4=1/ro/ro*(-jn2[1]*ro*WaveNum*(cos(2*phi)+I*n0*sin(2*phi)) +
+							jn2[0]*(-(n0-1)*n0*cexp(-2*I*phi)/sin(alpha0)+
+								cpow(WaveNum*ro,2)/sin(alpha0)*(1-pow(sin(alpha0)*sin(phi),2))));
+						t5=-1/ro*cexp(-I*phi)*t2/sin(alpha0)*(jn2[1]*ro*t1 -
+							jn2[0]*2*n0);
+						break;
+					case B_BESSELTMC:
+						t3=1/ro/ro*(jn2[1]*ro*t2*(n0*cos(2*phi)+I*sin(2*phi)) +
+							jn2[0]*(-cexp(-2*I*phi)*(n0-1)*n0/tan(alpha0)-
+								cpow(WaveNum*ro,2)*(1/tan(alpha0)+I/4*sin(2*alpha0)*sin(2*phi))));
+						t4=-I/ro/ro/tan(alpha0)*(jn2[1]*ro*t1*(cos(2*phi)+I*n0*sin(2*phi)) -
+							jn2[0]/4*((cpow(WaveNum*ro,2)-4*(n0-1)*n0)*pow(cos(phi),2)+
+								cpow(WaveNum*ro,2)*(3+2*cos(2*alpha0)*pow(sin(phi),2))+4*I*(n0-1)*n0*sin(2*phi)));
+						t5=I/2*WaveNum*cexp(-I*phi)*(-jn2[1]*2*WaveNum*cexp(I*phi)*(cos(phi)-
+								I*pow(cos(alpha0),2)*sin(phi)) +
+							jn2[0]*n0*(3+cos(2*alpha0))/ro/sin(alpha0));
+						break;
+					default: break;
+				}
+				cvMultScal_RVec(t3,ex,v1);
+				cvMultScal_RVec(t4,ey,v2);
+				cvMultScal_RVec(t5,prop,v3);
+				cvAdd2Self(v1,v2,v3);
+				cvMultScal_cmplx(ctemp,v1,b+j);
+			}
+			return;
 		case B_READ:
 			if (which==INCPOL_Y) fname=beam_fnameY;
 			else fname=beam_fnameX; // which==INCPOL_X
diff --git a/src/Makefile b/src/Makefile
index 2bb67058..d89b640a 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -91,7 +91,7 @@ VALID_OPTS := DEBUG DEBUGFULL FFT_TEMPERTON PRECISE_TIMING NOT_USE_LOCK ONLY_LOC
 # producing debugging symbols (-g) and warnings and brings optimization down to O2 (this is required to produce all
 # possible warnings by the compiler). DEBUGFULL turns off optimization completely (for more accurate debugging symbols)
 # and turns on additional diagnostic messages in the source code (debug.c/h).
-#override OPTIONS += DEBUG
+override OPTIONS += DEBUG
 #override OPTIONS += DEBUGFULL
 #override OPTIONS += SPARSE ACCIMEXP
 #USE_SSE3
@@ -174,8 +174,8 @@ override EXTRA_FLAGS +=
 #FFTW3_LIB_PATH := $(FFTWLIB)
 #FFTW3_INC_PATH := $(HOME)/include
 #FFTW3_LIB_PATH := $(HOME)/lib
-#FFTW3_INC_PATH := "$(abspath ./../lib)"
-#FFTW3_LIB_PATH := "$(abspath ./../lib)"
+FFTW3_INC_PATH := "$(abspath ./../../fftw)"
+FFTW3_LIB_PATH := "$(abspath ./../../fftw)"
 
 #=======================================================================================================================
 # !!! End of control section. Everything below is not designed to be modified by user. However, advanced users may wish
@@ -187,7 +187,7 @@ override EXTRA_FLAGS +=
 # C files are located in source folder (src/), other files may be added below
 CSOURCE := ADDAmain.c CalculateE.c calculator.c chebyshev.c comm.c crosssec.c GenerateB.c interaction.c io.c \
            iterative.c linalg.c make_particle.c memory.c  mt19937ar.c param.c Romberg.c sinint.c somnec.c \
-           timing.c vars.c
+           timing.c vars.c bess.c
 # Fortran files are located in src/fort folder, other files may be added below
 FSOURCE := d07hre.f d09hre.f d113re.f d132re.f dadhre.f dchhre.f dcuhre.f dfshre.f dinhre.f drlhre.f dtrhre.f \
            propaesplibreintadda.f
@@ -374,7 +374,7 @@ ifeq ($(COMPILER),gnu)
   # Use gfortran if available (GCC 4 and later), otherwise try g77
   ifeq ($(shell which gfortran > /dev/null 2>&1 && echo 0),0)
     CF    := gfortran
-    FLIBS += -lgfortran
+    FLIBS += -lgfortran -lquadmath
   else
     # This is not expected to work for f90 sources but we keep it for now
     CF    := g77
diff --git a/bess.c b/src/bess.c
similarity index 96%
rename from bess.c
rename to src/bess.c
index fa45dcdc..97cf5f73 100644
--- a/bess.c
+++ b/src/bess.c
@@ -1,354 +1,354 @@
-/* File: bess.c
- * $Date::      17/07/2019                      $
- * Descr: 		Two functions "bessjn2" and "bessjn5" for computing 2 and 5 orders of Bessel functions respectively
- * Reference:	C++ Release 1.0 By J-P Moreau, Paris.(www.jpmoreau.fr)  
- *
- * Copyright (C) 2006-2013 ADDA contributors
- * This file is part of ADDA.
- *
- * ADDA is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as
- * published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
- *
- * ADDA is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- * of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along with ADDA. If not, see
- * <http://www.gnu.org/licenses/>.
- */
-#include <math.h>
-#include <stdio.h>
-#include <stdlib.h>
-
-
-
-/*	This subroutine calculates the First Kind Bessel Function of
-	order 0, for any real number X. The polynomial approximation by
-	series of Chebyshev polynomials is used for 0<X<8 and 0<8/X<1.
-	REFERENCES:
-	M.ABRAMOWITZ,I.A.STEGUN, HANDBOOK OF MATHEMATICAL FUNCTIONS, 1965.
-	C.W.CLENSHAW, NATIONAL PHYSICAL LABORATORY MATHEMATICAL TABLES,
-	VOL.5, 1962.
-*/
-double bessj0 (double X) { 
-	const double
-		P1=1.0, P2=-0.1098628627E-2, P3=0.2734510407E-4,
-		P4=-0.2073370639E-5, P5= 0.2093887211E-6,
-		Q1=-0.1562499995E-1, Q2= 0.1430488765E-3, Q3=-0.6911147651E-5,
-		Q4= 0.7621095161E-6, Q5=-0.9349451520E-7,
-		R1= 57568490574.0, R2=-13362590354.0, R3=651619640.7,
-		R4=-11214424.18, R5= 77392.33017, R6=-184.9052456,
-		S1= 57568490411.0, S2=1029532985.0, S3=9494680.718,
-		S4= 59272.64853, S5=267.8532712, S6=1.0;
-    double
-		AX,FR,FS,Z,FP,FQ,XX,Y, TMP;
-	if (X==0.0) return 1.0;
-	AX = fabs(X);
-	if (AX < 8.0) {
-		Y = X*X;
-		FR = R1+Y*(R2+Y*(R3+Y*(R4+Y*(R5+Y*R6))));
-		FS = S1+Y*(S2+Y*(S3+Y*(S4+Y*(S5+Y*S6))));
-		TMP = FR/FS;
-	}
-	else {
-		Z = 8./AX;
-		Y = Z*Z;
-		XX = AX-0.785398164;
-		FP = P1+Y*(P2+Y*(P3+Y*(P4+Y*P5)));
-		FQ = Q1+Y*(Q2+Y*(Q3+Y*(Q4+Y*Q5)));
-		TMP = sqrt(0.636619772/AX)*(FP*cos(XX)-Z*FQ*sin(XX));
-	}
-return TMP;
-}
-
-double Sign(double X, double Y) {
-	if (Y<0.0) return (-fabs(X));
-	else return (fabs(X));
-}
-
-
-/*	This subroutine calculates the First Kind Bessel Function of
-	order 1, for any real number X. The polynomial approximation by
-	series of Chebyshev polynomials is used for 0<X<8 and 0<8/X<1.	
-	REFERENCES:
-	M.ABRAMOWITZ,I.A.STEGUN, HANDBOOK OF MATHEMATICAL FUNCTIONS, 1965.
-	C.W.CLENSHAW, NATIONAL PHYSICAL LABORATORY MATHEMATICAL TABLES,
-	VOL.5, 1962.
-*/
-double bessj1 (double X) {
-	const double  
-		P1=1.0, P2=0.183105E-2, P3=-0.3516396496E-4, P4=0.2457520174E-5,
-		P5=-0.240337019E-6,  P6=0.636619772,
-		Q1= 0.04687499995, Q2=-0.2002690873E-3, Q3=0.8449199096E-5,
-		Q4=-0.88228987E-6, Q5= 0.105787412E-6,
-		R1= 72362614232.0, R2=-7895059235.0, R3=242396853.1,
-		R4=-2972611.439,   R5=15704.48260,  R6=-30.16036606,
-		S1=144725228442.0, S2=2300535178.0, S3=18583304.74,
-		S4=99447.43394,    S5=376.9991397,  S6=1.0;
-
-	double AX,FR,FS,Y,Z,FP,FQ,XX, TMP;
-
-	AX = fabs(X);
-	if (AX < 8.0) {
-		Y = X*X;
-		FR = R1+Y*(R2+Y*(R3+Y*(R4+Y*(R5+Y*R6))));
-		FS = S1+Y*(S2+Y*(S3+Y*(S4+Y*(S5+Y*S6))));
-		TMP = X*(FR/FS);
-	}
-	else {
-		Z = 8.0/AX;
-		Y = Z*Z;
-		XX = AX-2.35619491;
-		FP = P1+Y*(P2+Y*(P3+Y*(P4+Y*P5)));
-		FQ = Q1+Y*(Q2+Y*(Q3+Y*(Q4+Y*Q5)));
-		TMP = sqrt(P6/AX)*(cos(XX)*FP-Z*sin(XX)*FQ)*Sign(S6,X);
-	}
-	return TMP;
-}
-/*
-void bessjn5 (int N2, double X, double ARRJ[5]) { // Computing 5 orders of Bessel function
-	const int A = 40;
-	const double BIGNO = 1e10,  BIGNI = 1e-10;
-
-	double TOX,BJM,BJ,BJP,SUM,TMP,BJM1,BJ1,BJP1,SUM1,TMP1;
-	int J, JSUM, JSUM1, M, K, N, sgn, sgn1;
-
-	N = (N2 - 2);
-	if (X == 0.0) {
-		switch(N2) {
-			case -2:
-			ARRJ[0] = ARRJ[1] = ARRJ[2] = ARRJ[3] = 0.0;
-			ARRJ[4] = 1.0;
-			break;
-			case -1:
-			ARRJ[0] = ARRJ[1] = ARRJ[2] = ARRJ[4] = 0.0;
-			ARRJ[3] = 1.0;
-			break;
-			case 0:
-			ARRJ[0] = ARRJ[1] = ARRJ[3] = ARRJ[4] = 0.0;
-			ARRJ[2] = 1.0;
-			break;
-			case 1:
-			ARRJ[0] = ARRJ[2] = ARRJ[3] = ARRJ[4] = 0.0;
-			ARRJ[1] = 1.0;
-			break;
-			case 2:
-			ARRJ[1] = ARRJ[2] = ARRJ[3] = ARRJ[4] = 0.0;
-			ARRJ[0] = 1.0;
-			break;
-			default:
-			ARRJ[0] = ARRJ[1] = ARRJ[2] = ARRJ[3] = ARRJ[4] =0.0;
-			break;
-		}
-	}
-	else {
-		if ((N == -5)||(N == -4)||(N == -3)||(N == -2)||(N == -1)||(N == 0)||(N == 1)) {
-			switch(N) {
-				case -5:
-				ARRJ[4] = -bessj1(X); 
-				ARRJ[3] = -(2.0/X)*ARRJ[4]-bessj0(X);
-				ARRJ[2] = -(4.0/X)*ARRJ[3]-ARRJ[4];
-				ARRJ[1] = -(6.0/X)*ARRJ[2]-ARRJ[3];
-				ARRJ[0] = -(8.0/X)*ARRJ[1]-ARRJ[2];
-				break;
-				case -4:
-				ARRJ[4] = bessj0(X); 
-				ARRJ[3] = -bessj1(X);
-				ARRJ[2] = -(2.0/X)*ARRJ[3]-ARRJ[4];
-				ARRJ[1] = -(4.0/X)*ARRJ[2]-ARRJ[3];
-				ARRJ[0] = -(6.0/X)*ARRJ[1]-ARRJ[2];
-				break;
-				case -3:
-				ARRJ[4] = bessj1(X); 
-				ARRJ[3] = bessj0(X);
-				ARRJ[2] = -ARRJ[4];;
-				ARRJ[1] = -(2.0/X)*ARRJ[2]-ARRJ[3];
-				ARRJ[0] = -(4.0/X)*ARRJ[1]-ARRJ[2];
-				break;
-				case -2:
-				ARRJ[3] = bessj1(X); 
-				ARRJ[2] = bessj0(X);
-				ARRJ[1] = -ARRJ[4];;
-				ARRJ[1] = -(2.0/X)*ARRJ[2]-ARRJ[3];
-				ARRJ[0] = -(4.0/X)*ARRJ[1]-ARRJ[2];
-				break;
-				case -1:
-				ARRJ[0] = -bessj1(X);
-				ARRJ[1] = bessj0(X);
-				ARRJ[2] = -ARRJ[0];
-				ARRJ[3] = (2.0/X)*ARRJ[2]-ARRJ[1];
-				ARRJ[4] = (4.0/X)*ARRJ[3]-ARRJ[2];
-				break;
-				case 0:
-				ARRJ[0] = bessj0(X);
-				ARRJ[1] = bessj1(X);
-				ARRJ[2] = (2.0/X)*ARRJ[1]-ARRJ[0];
-				ARRJ[3] = (4.0/X)*ARRJ[2]-ARRJ[1];
-				ARRJ[4] = (6.0/X)*ARRJ[3]-ARRJ[2];
-				break;
-				case 1:
-				ARRJ[0] = bessj1(X);
-				ARRJ[1] = (2.0/X)*ARRJ[0]-bessj0(X);
-				ARRJ[2] = (4.0/X)*ARRJ[1]-ARRJ[0];
-				ARRJ[3] = (6.0/X)*ARRJ[2]-ARRJ[1];
-				ARRJ[4] = (8.0/X)*ARRJ[3]-ARRJ[2];
-				break;
-			}
-		}
-		else {
-			TOX = 2.0/X;
-			sgn = 1;
-			sgn1 = 1;
-			N = abs(N2-2);
-			if ((N2-2 <0)&((N2-2)%2 != 0)) sgn = -1;
-			if ((N2-1 <0)&((N2-1)%2 != 0)) sgn1 = -1;
-			if (X > 1.0*N) {
-				BJM = bessj0(X);
-				BJ  = bessj1(X);
-				
-				for (J=1; J<N; J++) {  // Upward recurrence
-					BJP = J*TOX*BJ-BJM;
-					BJM = BJ;
-					BJ  = BJP;
-				}
-				
-				BJP = N*TOX*BJ-BJM;
-				ARRJ[0] = sgn*BJ; 
-				ARRJ[1] = sgn1*BJP;
-				ARRJ[2] = (N+2)*(2.0/X)*ARRJ[1]-ARRJ[0];
-				ARRJ[3] = (N+3)*(2.0/X)*ARRJ[2]-ARRJ[1];
-				ARRJ[4] = (N+4)*(2.0/X)*ARRJ[3]-ARRJ[2];
-			}
-			else {
-				M = (int) (2*((N+floor(sqrt(1.0*(A*N))))/2));
-				K = (int) (2*((N+1+floor(sqrt(1.0*(A*(N+1)))))/2));
-				TMP = 0.0;
-				TMP1 = 0.0;
-				JSUM = 0;
-				JSUM1 = 0;
-				SUM = 0.0;
-				SUM1 = 0.0;
-				BJP = 0.0;
-				BJP1 = 0.0;
-				BJ  = 1.0;
-				BJ1  = 1.0;
-				
-				for (J=K; J>0; J--) {  // Downward recurrence ( Miller's algorithm )
-					BJM1 = J*TOX*BJ1-BJP1;
-					BJP1 = BJ1;
-					BJ1  = BJM1;
-					if (fabs(BJ1) > BIGNO) {
-						BJ1  = BJ1*BIGNI;
-						BJP1 = BJP1*BIGNI;
-						TMP1 = TMP1*BIGNI;
-						SUM1 = SUM1*BIGNI;
-					}
-					if (JSUM1 != 0)  SUM1 += BJ1;
-					JSUM1 = 1-JSUM1;
-					if (J == N+1)  TMP1 = BJP1;
-					if (J <= M) {
-						BJM = J*TOX*BJ-BJP;
-						BJP = BJ;
-						BJ  = BJM;
-						if (fabs(BJ) > BIGNO) {
-							BJ  = BJ*BIGNI;
-							BJP = BJP*BIGNI;
-							TMP = TMP*BIGNI;
-							SUM = SUM*BIGNI;
-						}
-						if (JSUM != 0)  SUM += BJ;
-						JSUM = 1-JSUM;
-						if (J == N)  TMP = BJP;
-					}
-				}
-				
-				ARRJ[0] = sgn*TMP/(2.0*SUM-BJ);
-				ARRJ[1] = sgn1*TMP1/(2.0*SUM1-BJ1);
-				ARRJ[2] = (N+2)*(2.0/X)*ARRJ[1]-ARRJ[0];
-				ARRJ[3] = (N+3)*(2.0/X)*ARRJ[2]-ARRJ[1];
-				ARRJ[4] = (N+4)*(2.0/X)*ARRJ[3]-ARRJ[2];
-
-			}
-		}
-	}
-}
-*/
-
-void bessjn2 (int N, double X, double ARRJ[2]) {  // Computing 2 orders of Bessel function
-	const int A = 40;
-	const double BIGNO = 1e10,  BIGNI = 1e-10;
-
-	double TOX,BJM,BJ,BJP,SUM,TMP,BJM1,BJ1,BJP1,SUM1,TMP1;
-	int J, JSUM, JSUM1, M, K;
-	if (X == 0.0) {
-		if (N == 0) { ARRJ[0] = 1.0; ARRJ[1] = 0.0;}
-		else { ARRJ[0] = 0.0; ARRJ[1] = 0.0;} 
-	}
-	else {
-		if ((N == 0)||(N == 1)) {
-			if (N == 0) { ARRJ[0] = bessj0(X); ARRJ[1] = bessj1(X);}
-			if (N == 1) { ARRJ[0] = bessj1(X); ARRJ[1] = (2.0/X)*ARRJ[0]-bessj0(X);}
-		}
-		else {
-			TOX = 2.0/X;
-			if (X > 1.0*N) {
-				BJM = bessj0(X);
-				BJ  = bessj1(X);
-				
-				for (J=1; J<N; J++) {  // Upward recurrence
-					BJP = J*TOX*BJ-BJM;
-					BJM = BJ;
-					BJ  = BJP;
-				}
-				
-				BJP = N*TOX*BJ-BJM;
-				ARRJ[0] = BJ; ARRJ[1] = BJP;
-			}
-			else {
-				M = (int) (2*((N+floor(sqrt(1.0*(A*N))))/2));
-				K = (int) (2*((N+1+floor(sqrt(1.0*(A*(N+1)))))/2));
-				TMP = 0.0;
-				TMP1 = 0.0;
-				JSUM = 0;
-				JSUM1 = 0;
-				SUM = 0.0;
-				SUM1 = 0.0;
-				BJP = 0.0;
-				BJP1 = 0.0;
-				BJ  = 1.0;
-				BJ1  = 1.0;
-				
-				for (J=K; J>0; J--) {  // Downward recurrence ( Miller's algorithm )
-					BJM1 = J*TOX*BJ1-BJP1;
-					BJP1 = BJ1;
-					BJ1  = BJM1;
-					if (fabs(BJ1) > BIGNO) {
-						BJ1  = BJ1*BIGNI;
-						BJP1 = BJP1*BIGNI;
-						TMP1 = TMP1*BIGNI;
-						SUM1 = SUM1*BIGNI;
-					}
-					if (JSUM1 != 0)  SUM1 += BJ1;
-					JSUM1 = 1-JSUM1;
-					if (J == N+1)  TMP1 = BJP1;
-					if (J <= M) {
-						BJM = J*TOX*BJ-BJP;
-						BJP = BJ;
-						BJ  = BJM;
-						if (fabs(BJ) > BIGNO) {
-							BJ  = BJ*BIGNI;
-							BJP = BJP*BIGNI;
-							TMP = TMP*BIGNI;
-							SUM = SUM*BIGNI;
-						}
-						if (JSUM != 0)  SUM += BJ;
-						JSUM = 1-JSUM;
-						if (J == N)  TMP = BJP;
-					}
-				}
-				
-				ARRJ[0] = TMP/(2.0*SUM-BJ);
-				ARRJ[1] = TMP1/(2.0*SUM1-BJ1);
-			}
-		}
-	}
-}
+/* File: bess.c
+ * $Date::      17/07/2019                      $
+ * Descr: 		Two functions "bessjn2" and "bessjn5" for computing 2 and 5 orders of Bessel functions respectively
+ * Reference:	C++ Release 1.0 By J-P Moreau, Paris.(www.jpmoreau.fr)  
+ *
+ * Copyright (C) 2006-2013 ADDA contributors
+ * This file is part of ADDA.
+ *
+ * ADDA is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as
+ * published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
+ *
+ * ADDA is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ * of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along with ADDA. If not, see
+ * <http://www.gnu.org/licenses/>.
+ */
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+
+
+/*	This subroutine calculates the First Kind Bessel Function of
+	order 0, for any real number X. The polynomial approximation by
+	series of Chebyshev polynomials is used for 0<X<8 and 0<8/X<1.
+	REFERENCES:
+	M.ABRAMOWITZ,I.A.STEGUN, HANDBOOK OF MATHEMATICAL FUNCTIONS, 1965.
+	C.W.CLENSHAW, NATIONAL PHYSICAL LABORATORY MATHEMATICAL TABLES,
+	VOL.5, 1962.
+*/
+double bessj0 (double X) { 
+	const double
+		P1=1.0, P2=-0.1098628627E-2, P3=0.2734510407E-4,
+		P4=-0.2073370639E-5, P5= 0.2093887211E-6,
+		Q1=-0.1562499995E-1, Q2= 0.1430488765E-3, Q3=-0.6911147651E-5,
+		Q4= 0.7621095161E-6, Q5=-0.9349451520E-7,
+		R1= 57568490574.0, R2=-13362590354.0, R3=651619640.7,
+		R4=-11214424.18, R5= 77392.33017, R6=-184.9052456,
+		S1= 57568490411.0, S2=1029532985.0, S3=9494680.718,
+		S4= 59272.64853, S5=267.8532712, S6=1.0;
+    double
+		AX,FR,FS,Z,FP,FQ,XX,Y, TMP;
+	if (X==0.0) return 1.0;
+	AX = fabs(X);
+	if (AX < 8.0) {
+		Y = X*X;
+		FR = R1+Y*(R2+Y*(R3+Y*(R4+Y*(R5+Y*R6))));
+		FS = S1+Y*(S2+Y*(S3+Y*(S4+Y*(S5+Y*S6))));
+		TMP = FR/FS;
+	}
+	else {
+		Z = 8./AX;
+		Y = Z*Z;
+		XX = AX-0.785398164;
+		FP = P1+Y*(P2+Y*(P3+Y*(P4+Y*P5)));
+		FQ = Q1+Y*(Q2+Y*(Q3+Y*(Q4+Y*Q5)));
+		TMP = sqrt(0.636619772/AX)*(FP*cos(XX)-Z*FQ*sin(XX));
+	}
+return TMP;
+}
+
+double Sign(double X, double Y) {
+	if (Y<0.0) return (-fabs(X));
+	else return (fabs(X));
+}
+
+
+/*	This subroutine calculates the First Kind Bessel Function of
+	order 1, for any real number X. The polynomial approximation by
+	series of Chebyshev polynomials is used for 0<X<8 and 0<8/X<1.	
+	REFERENCES:
+	M.ABRAMOWITZ,I.A.STEGUN, HANDBOOK OF MATHEMATICAL FUNCTIONS, 1965.
+	C.W.CLENSHAW, NATIONAL PHYSICAL LABORATORY MATHEMATICAL TABLES,
+	VOL.5, 1962.
+*/
+double bessj1 (double X) {
+	const double  
+		P1=1.0, P2=0.183105E-2, P3=-0.3516396496E-4, P4=0.2457520174E-5,
+		P5=-0.240337019E-6,  P6=0.636619772,
+		Q1= 0.04687499995, Q2=-0.2002690873E-3, Q3=0.8449199096E-5,
+		Q4=-0.88228987E-6, Q5= 0.105787412E-6,
+		R1= 72362614232.0, R2=-7895059235.0, R3=242396853.1,
+		R4=-2972611.439,   R5=15704.48260,  R6=-30.16036606,
+		S1=144725228442.0, S2=2300535178.0, S3=18583304.74,
+		S4=99447.43394,    S5=376.9991397,  S6=1.0;
+
+	double AX,FR,FS,Y,Z,FP,FQ,XX, TMP;
+
+	AX = fabs(X);
+	if (AX < 8.0) {
+		Y = X*X;
+		FR = R1+Y*(R2+Y*(R3+Y*(R4+Y*(R5+Y*R6))));
+		FS = S1+Y*(S2+Y*(S3+Y*(S4+Y*(S5+Y*S6))));
+		TMP = X*(FR/FS);
+	}
+	else {
+		Z = 8.0/AX;
+		Y = Z*Z;
+		XX = AX-2.35619491;
+		FP = P1+Y*(P2+Y*(P3+Y*(P4+Y*P5)));
+		FQ = Q1+Y*(Q2+Y*(Q3+Y*(Q4+Y*Q5)));
+		TMP = sqrt(P6/AX)*(cos(XX)*FP-Z*sin(XX)*FQ)*Sign(S6,X);
+	}
+	return TMP;
+}
+/*
+void bessjn5 (int N2, double X, double ARRJ[5]) { // Computing 5 orders of Bessel function
+	const int A = 40;
+	const double BIGNO = 1e10,  BIGNI = 1e-10;
+
+	double TOX,BJM,BJ,BJP,SUM,TMP,BJM1,BJ1,BJP1,SUM1,TMP1;
+	int J, JSUM, JSUM1, M, K, N, sgn, sgn1;
+
+	N = (N2 - 2);
+	if (X == 0.0) {
+		switch(N2) {
+			case -2:
+			ARRJ[0] = ARRJ[1] = ARRJ[2] = ARRJ[3] = 0.0;
+			ARRJ[4] = 1.0;
+			break;
+			case -1:
+			ARRJ[0] = ARRJ[1] = ARRJ[2] = ARRJ[4] = 0.0;
+			ARRJ[3] = 1.0;
+			break;
+			case 0:
+			ARRJ[0] = ARRJ[1] = ARRJ[3] = ARRJ[4] = 0.0;
+			ARRJ[2] = 1.0;
+			break;
+			case 1:
+			ARRJ[0] = ARRJ[2] = ARRJ[3] = ARRJ[4] = 0.0;
+			ARRJ[1] = 1.0;
+			break;
+			case 2:
+			ARRJ[1] = ARRJ[2] = ARRJ[3] = ARRJ[4] = 0.0;
+			ARRJ[0] = 1.0;
+			break;
+			default:
+			ARRJ[0] = ARRJ[1] = ARRJ[2] = ARRJ[3] = ARRJ[4] =0.0;
+			break;
+		}
+	}
+	else {
+		if ((N == -5)||(N == -4)||(N == -3)||(N == -2)||(N == -1)||(N == 0)||(N == 1)) {
+			switch(N) {
+				case -5:
+				ARRJ[4] = -bessj1(X); 
+				ARRJ[3] = -(2.0/X)*ARRJ[4]-bessj0(X);
+				ARRJ[2] = -(4.0/X)*ARRJ[3]-ARRJ[4];
+				ARRJ[1] = -(6.0/X)*ARRJ[2]-ARRJ[3];
+				ARRJ[0] = -(8.0/X)*ARRJ[1]-ARRJ[2];
+				break;
+				case -4:
+				ARRJ[4] = bessj0(X); 
+				ARRJ[3] = -bessj1(X);
+				ARRJ[2] = -(2.0/X)*ARRJ[3]-ARRJ[4];
+				ARRJ[1] = -(4.0/X)*ARRJ[2]-ARRJ[3];
+				ARRJ[0] = -(6.0/X)*ARRJ[1]-ARRJ[2];
+				break;
+				case -3:
+				ARRJ[4] = bessj1(X); 
+				ARRJ[3] = bessj0(X);
+				ARRJ[2] = -ARRJ[4];;
+				ARRJ[1] = -(2.0/X)*ARRJ[2]-ARRJ[3];
+				ARRJ[0] = -(4.0/X)*ARRJ[1]-ARRJ[2];
+				break;
+				case -2:
+				ARRJ[3] = bessj1(X); 
+				ARRJ[2] = bessj0(X);
+				ARRJ[1] = -ARRJ[4];;
+				ARRJ[1] = -(2.0/X)*ARRJ[2]-ARRJ[3];
+				ARRJ[0] = -(4.0/X)*ARRJ[1]-ARRJ[2];
+				break;
+				case -1:
+				ARRJ[0] = -bessj1(X);
+				ARRJ[1] = bessj0(X);
+				ARRJ[2] = -ARRJ[0];
+				ARRJ[3] = (2.0/X)*ARRJ[2]-ARRJ[1];
+				ARRJ[4] = (4.0/X)*ARRJ[3]-ARRJ[2];
+				break;
+				case 0:
+				ARRJ[0] = bessj0(X);
+				ARRJ[1] = bessj1(X);
+				ARRJ[2] = (2.0/X)*ARRJ[1]-ARRJ[0];
+				ARRJ[3] = (4.0/X)*ARRJ[2]-ARRJ[1];
+				ARRJ[4] = (6.0/X)*ARRJ[3]-ARRJ[2];
+				break;
+				case 1:
+				ARRJ[0] = bessj1(X);
+				ARRJ[1] = (2.0/X)*ARRJ[0]-bessj0(X);
+				ARRJ[2] = (4.0/X)*ARRJ[1]-ARRJ[0];
+				ARRJ[3] = (6.0/X)*ARRJ[2]-ARRJ[1];
+				ARRJ[4] = (8.0/X)*ARRJ[3]-ARRJ[2];
+				break;
+			}
+		}
+		else {
+			TOX = 2.0/X;
+			sgn = 1;
+			sgn1 = 1;
+			N = abs(N2-2);
+			if ((N2-2 <0)&((N2-2)%2 != 0)) sgn = -1;
+			if ((N2-1 <0)&((N2-1)%2 != 0)) sgn1 = -1;
+			if (X > 1.0*N) {
+				BJM = bessj0(X);
+				BJ  = bessj1(X);
+				
+				for (J=1; J<N; J++) {  // Upward recurrence
+					BJP = J*TOX*BJ-BJM;
+					BJM = BJ;
+					BJ  = BJP;
+				}
+				
+				BJP = N*TOX*BJ-BJM;
+				ARRJ[0] = sgn*BJ; 
+				ARRJ[1] = sgn1*BJP;
+				ARRJ[2] = (N+2)*(2.0/X)*ARRJ[1]-ARRJ[0];
+				ARRJ[3] = (N+3)*(2.0/X)*ARRJ[2]-ARRJ[1];
+				ARRJ[4] = (N+4)*(2.0/X)*ARRJ[3]-ARRJ[2];
+			}
+			else {
+				M = (int) (2*((N+floor(sqrt(1.0*(A*N))))/2));
+				K = (int) (2*((N+1+floor(sqrt(1.0*(A*(N+1)))))/2));
+				TMP = 0.0;
+				TMP1 = 0.0;
+				JSUM = 0;
+				JSUM1 = 0;
+				SUM = 0.0;
+				SUM1 = 0.0;
+				BJP = 0.0;
+				BJP1 = 0.0;
+				BJ  = 1.0;
+				BJ1  = 1.0;
+				
+				for (J=K; J>0; J--) {  // Downward recurrence ( Miller's algorithm )
+					BJM1 = J*TOX*BJ1-BJP1;
+					BJP1 = BJ1;
+					BJ1  = BJM1;
+					if (fabs(BJ1) > BIGNO) {
+						BJ1  = BJ1*BIGNI;
+						BJP1 = BJP1*BIGNI;
+						TMP1 = TMP1*BIGNI;
+						SUM1 = SUM1*BIGNI;
+					}
+					if (JSUM1 != 0)  SUM1 += BJ1;
+					JSUM1 = 1-JSUM1;
+					if (J == N+1)  TMP1 = BJP1;
+					if (J <= M) {
+						BJM = J*TOX*BJ-BJP;
+						BJP = BJ;
+						BJ  = BJM;
+						if (fabs(BJ) > BIGNO) {
+							BJ  = BJ*BIGNI;
+							BJP = BJP*BIGNI;
+							TMP = TMP*BIGNI;
+							SUM = SUM*BIGNI;
+						}
+						if (JSUM != 0)  SUM += BJ;
+						JSUM = 1-JSUM;
+						if (J == N)  TMP = BJP;
+					}
+				}
+				
+				ARRJ[0] = sgn*TMP/(2.0*SUM-BJ);
+				ARRJ[1] = sgn1*TMP1/(2.0*SUM1-BJ1);
+				ARRJ[2] = (N+2)*(2.0/X)*ARRJ[1]-ARRJ[0];
+				ARRJ[3] = (N+3)*(2.0/X)*ARRJ[2]-ARRJ[1];
+				ARRJ[4] = (N+4)*(2.0/X)*ARRJ[3]-ARRJ[2];
+
+			}
+		}
+	}
+}
+*/
+
+void bessjn2 (int N, double X, double ARRJ[2]) {  // Computing 2 orders of Bessel function
+	const int A = 40;
+	const double BIGNO = 1e10,  BIGNI = 1e-10;
+
+	double TOX,BJM,BJ,BJP,SUM,TMP,BJM1,BJ1,BJP1,SUM1,TMP1;
+	int J, JSUM, JSUM1, M, K;
+	if (X == 0.0) {
+		if (N == 0) { ARRJ[0] = 1.0; ARRJ[1] = 0.0;}
+		else { ARRJ[0] = 0.0; ARRJ[1] = 0.0;} 
+	}
+	else {
+		if ((N == 0)||(N == 1)) {
+			if (N == 0) { ARRJ[0] = bessj0(X); ARRJ[1] = bessj1(X);}
+			if (N == 1) { ARRJ[0] = bessj1(X); ARRJ[1] = (2.0/X)*ARRJ[0]-bessj0(X);}
+		}
+		else {
+			TOX = 2.0/X;
+			if (X > 1.0*N) {
+				BJM = bessj0(X);
+				BJ  = bessj1(X);
+				
+				for (J=1; J<N; J++) {  // Upward recurrence
+					BJP = J*TOX*BJ-BJM;
+					BJM = BJ;
+					BJ  = BJP;
+				}
+				
+				BJP = N*TOX*BJ-BJM;
+				ARRJ[0] = BJ; ARRJ[1] = BJP;
+			}
+			else {
+				M = (int) (2*((N+floor(sqrt(1.0*(A*N))))/2));
+				K = (int) (2*((N+1+floor(sqrt(1.0*(A*(N+1)))))/2));
+				TMP = 0.0;
+				TMP1 = 0.0;
+				JSUM = 0;
+				JSUM1 = 0;
+				SUM = 0.0;
+				SUM1 = 0.0;
+				BJP = 0.0;
+				BJP1 = 0.0;
+				BJ  = 1.0;
+				BJ1  = 1.0;
+				
+				for (J=K; J>0; J--) {  // Downward recurrence ( Miller's algorithm )
+					BJM1 = J*TOX*BJ1-BJP1;
+					BJP1 = BJ1;
+					BJ1  = BJM1;
+					if (fabs(BJ1) > BIGNO) {
+						BJ1  = BJ1*BIGNI;
+						BJP1 = BJP1*BIGNI;
+						TMP1 = TMP1*BIGNI;
+						SUM1 = SUM1*BIGNI;
+					}
+					if (JSUM1 != 0)  SUM1 += BJ1;
+					JSUM1 = 1-JSUM1;
+					if (J == N+1)  TMP1 = BJP1;
+					if (J <= M) {
+						BJM = J*TOX*BJ-BJP;
+						BJP = BJ;
+						BJ  = BJM;
+						if (fabs(BJ) > BIGNO) {
+							BJ  = BJ*BIGNI;
+							BJP = BJP*BIGNI;
+							TMP = TMP*BIGNI;
+							SUM = SUM*BIGNI;
+						}
+						if (JSUM != 0)  SUM += BJ;
+						JSUM = 1-JSUM;
+						if (J == N)  TMP = BJP;
+					}
+				}
+				
+				ARRJ[0] = TMP/(2.0*SUM-BJ);
+				ARRJ[1] = TMP1/(2.0*SUM1-BJ1);
+			}
+		}
+	}
+}
diff --git a/bess.h b/src/bess.h
similarity index 97%
rename from bess.h
rename to src/bess.h
index ef79b17e..d7008fe0 100644
--- a/bess.h
+++ b/src/bess.h
@@ -1,28 +1,28 @@
-/* File: bess.h
- * $Date::      17/07/2019                      $
- * Descr:		Two functions "bessjn2" and "bessjn5" for computing 2 and 5 orders of Bessel functions respectively
- * Reference:	C++ Release 1.0 By J-P Moreau, Paris.(www.jpmoreau.fr) 
- *
- * Copyright (C) 2006,2008-2013
- * This file is part of ADDA.
- *
- * ADDA is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as
- * published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
- *
- * ADDA is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- * of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along with ADDA. If not, see
- * <http://www.gnu.org/licenses/>.
- */
-
-#include <math.h>
-#include <stdio.h>
-#include <stdlib.h>
-
-double bessj0 (double X);
-double Sign(double X, double Y);
-double bessj1 (double X);
-
-//void bessjn5 (int N2, double X, double ARRJ[5]);
-void bessjn2 (int N, double X, double ARRJ[2]);
+/* File: bess.h
+ * $Date::      17/07/2019                      $
+ * Descr:		Two functions "bessjn2" and "bessjn5" for computing 2 and 5 orders of Bessel functions respectively
+ * Reference:	C++ Release 1.0 By J-P Moreau, Paris.(www.jpmoreau.fr) 
+ *
+ * Copyright (C) 2006,2008-2013
+ * This file is part of ADDA.
+ *
+ * ADDA is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as
+ * published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
+ *
+ * ADDA is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ * of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along with ADDA. If not, see
+ * <http://www.gnu.org/licenses/>.
+ */
+
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+double bessj0 (double X);
+double Sign(double X, double Y);
+double bessj1 (double X);
+
+//void bessjn5 (int N2, double X, double ARRJ[5]);
+void bessjn2 (int N, double X, double ARRJ[2]);
diff --git a/src/const.h b/src/const.h
index 015499de..a4a2e94f 100644
--- a/src/const.h
+++ b/src/const.h
@@ -278,6 +278,11 @@ enum incpol {
 
 enum beam { // beam types
 	B_BARTON5, // 5th order description of the Gaussian beam
+	B_BESSELCS, // Bessel beam with circularky symmetric energy density
+	B_BESSELLE, // Bessel beam with linearly polarized electric field
+	B_BESSELLM, // Bessel beam with linearly polarized magnetic field
+	B_BESSELTEC, // Bessel beam forming TE Bessel beam 
+	B_BESSELTMC, // Bessel beam forming TM Bessel beam 
 	B_DAVIS3,  // 3rd order description of the Gaussian beam
 	B_DIPOLE,  // field of a point dipole
 	B_LMINUS,  // 1st order description of the Gaussian beam
diff --git a/src/githash.h b/src/githash.h
new file mode 100644
index 00000000..64b27497
--- /dev/null
+++ b/src/githash.h
@@ -0,0 +1 @@
+#define GITHASH "b660860"
diff --git a/src/param.c b/src/param.c
index 471700fe..7bde42a3 100644
--- a/src/param.c
+++ b/src/param.c
@@ -222,6 +222,26 @@ static const struct subopt_struct beam_opt[]={
 		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
 		"(zero, by default). All arguments are in um. This is recommended option for simulation of the Gaussian beam.",
 		UNDEF,B_BARTON5},
+	{"besselCS","<order> <angle> [<x> <y> <z>]","Bessel beam with circularly symmetric energy density. The half-cone angle "
+		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
+		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
+		UNDEF,B_BESSELCS},
+	{"besselLE","<order> <angle> [<x> <y> <z>]","Bessel beam with linearly polarized electric field. The half-cone angle "
+		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
+		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
+		UNDEF,B_BESSELLE},
+	{"besselLM","<order> <angle> [<x> <y> <z>]","Bessel beam with linearly polarized magnetic field. The half-cone angle "
+		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
+		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
+		UNDEF,B_BESSELLM},
+	{"besselTEC","<order> <angle> [<x> <y> <z>]","Bessel beam forming TE Bessel beam. The half-cone angle "
+		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
+		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
+		UNDEF,B_BESSELTEC},
+	{"besselTMC","<order> <angle> [<x> <y> <z>]","Bessel beam forming TM Bessel beam. The half-cone angle "
+		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
+		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
+		UNDEF,B_BESSELTMC},
 	{"davis3","<width> [<x> <y> <z>]","3rd order approximation of the Gaussian beam (by Davis). The beam width is "
 		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
 		"(zero, by default). All arguments are in um.",UNDEF,B_DAVIS3},
@@ -981,6 +1001,11 @@ PARSE_FUNC(beam)
 			case B_LMINUS:
 			case B_DAVIS3:
 			case B_BARTON5: if (Narg!=1 && Narg!=4) NargError(Narg,"1 or 4"); break;
+			case B_BESSELCS: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
+			case B_BESSELLE: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
+			case B_BESSELLM: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
+			case B_BESSELTEC: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
+			case B_BESSELTMC: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
 			default: TestNarg(Narg,need); break;
 		}
 		/* TO ADD NEW BEAM
diff --git a/src/parbas.h b/src/parbas.h
index 608a662f..f3c9b42d 100644
--- a/src/parbas.h
+++ b/src/parbas.h
@@ -27,7 +27,7 @@
  * removed, then even MPI 2.0 will do.
  */
 #define MPI_VER_REQ 2
-#define MPI_SUBVER_REQ 1
+#define MPI_SUBVER_REQ 0
 // check MPI version for conformity during compilation
 #if !defined(MPI_VERSION) || !defined(MPI_SUBVERSION)
 #	error "Can not determine MPI version, hence MPI is too old."

From 0a7ff485c0e28b31dd414789928d82f1bc031ff7 Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Wed, 10 Jun 2020 14:49:21 +0700
Subject: [PATCH 04/46] 1

---
 doc/Bessel beam fields.docx                   |   Bin 0 -> 15899 bytes
 src/.cproject                                 |    60 +-
 src/.gitignore                                |    21 +
 src/.project                                  |     1 +
 src/.settings/language.settings.xml           |    28 +
 .../org.eclipse.cdt.codan.core.prefs          |    77 +
 src/Default/cpp/subdir.mk                     |    30 +
 src/Default/makefile                          |    61 +
 src/Default/mpi/subdir.mk                     |    44 +
 src/Default/objects.mk                        |     8 +
 src/Default/ocl/subdir.mk                     |    45 +
 src/Default/seq/subdir.mk                     |    44 +
 src/Default/sources.mk                        |    31 +
 src/Default/subdir.mk                         |    99 +
 src/GenerateB.c                               |   352 +-
 src/Makefile                                  |     4 +-
 src/bess.c                                    |   354 -
 src/bess.h                                    |    28 -
 src/const.h                                   |     2 +-
 src/fort/special_functions.f90                | 25413 ++++++++++++++++
 src/githash.h                                 |     2 +-
 src/mpi/Makefile                              |     6 +-
 src/ocl/Makefile                              |    12 +-
 src/param.c                                   |     4 +-
 24 files changed, 26241 insertions(+), 485 deletions(-)
 create mode 100644 doc/Bessel beam fields.docx
 create mode 100644 src/.gitignore
 create mode 100644 src/.settings/language.settings.xml
 create mode 100644 src/.settings/org.eclipse.cdt.codan.core.prefs
 create mode 100644 src/Default/cpp/subdir.mk
 create mode 100644 src/Default/makefile
 create mode 100644 src/Default/mpi/subdir.mk
 create mode 100644 src/Default/objects.mk
 create mode 100644 src/Default/ocl/subdir.mk
 create mode 100644 src/Default/seq/subdir.mk
 create mode 100644 src/Default/sources.mk
 create mode 100644 src/Default/subdir.mk
 delete mode 100644 src/bess.c
 delete mode 100644 src/bess.h
 create mode 100644 src/fort/special_functions.f90

diff --git a/doc/Bessel beam fields.docx b/doc/Bessel beam fields.docx
new file mode 100644
index 0000000000000000000000000000000000000000..e170489e0b233467df2a9d27f77e3e031c90c91a
GIT binary patch
literal 15899
zcmeHu1$P}gvh^{<6muLiL(GgZ#>^NqGcz+YGseu!%rP@FGc((<{hi#QJ9p-Nf8f1d
zt9!Yn-gP9oN+oSo$%uo2qW~ZPPyhgc0I-oaZLSIe0N{TB06qbrK-KuIEbR>}?X~1x
ztPSimXq+v~@pHgI$+7^T!0-R>`d>T(b@3yXKj{z!9}=DsVj2~64|7T=K*P8bspXC!
z(cM55Ut<T_-a0;k$|``wz?c(~Fg~m^D)#$LEvK48Bh@>RoS<<f`ow9Puu?89>{5H_
zV|>|)r(5S8V(~U-YHP=kU;&{cs_%&%`wk=hBlm~jXXQsgBt=4$BC%@(Bd-51RL0GR
z_I0qNbrNfG>3T>kc+D*2k8w2%%pR5^gy{N9b~DOG2@?L=btoan?nkqk@$N}7(Y7mo
zb~u-jnCLvoGD?w<r}lXEOtO@N{e%ThI>lj??(*s`%~g3+QY+Y-w+i_rb<fMx0<<78
z<EyDT<;vM>8Si9}1rZ=^oPs+mI0)o1o0tHO11bN{5<HbcS0ino@^V%~k};b&h0NBV
zV~oMFUG69L7ngs8=8fCjf|%s)@bs@&nwO88Yy#+yX1p}gMCOeqAnz=)zTph+ue?}1
zf&l>U?_dC#e=|wk7|g~Cpq@zqE$$=GB(-b}%<X7ten0=u6#p07-=Df(7TaywLkIiq
z!td2@s$F)u8$DNwR&R0zeF+juO;qC3%A)DQ+biedBB;iZj_}CzOx&ca-47v$&3KJV
z%tQsa(01tgC(RzUmo{fWLO@$Sz4N^FHf-Adz2WOHktq4FUzp10&<RY4n8)Dcv93>h
z6ax2qg&$1_$tPy@h--5*Y!ntAl06x-Qt0RAO-0n)AWOIeI|6Z9#xXo$40)=P7^$P9
zey-PO^vWN{H8Dh(lHXBbn$yve{D{#lgTcIPn>u#Q?JVpI37~?`h7O^9aW_;)R((4N
z-N)czxgb!f)7rAa`k}#l19VLPX&>|YwX(Os!Jr3P4>kY_#L3E5pZ0G?qHm?=U;*@A
zzune93<d<~yMS{3cVA_(BS3`#&fNiTe#sux93C=!yXIm9EAy`aL0q09D(JD>t<Fjj
z(UVE-mP^};WV;D(mX(R_P^a)&x5BJJTg1cgO1A|H=VIK-b6!L<C9@M83iKFlHBC+P
zj7d`|@!2~cfgCouN&2Arczt$kCIjv)aoUI|zkQ~DMF<N`hcMfO11AP444DkNz6wP|
zr#t3gQ`kqm2CLNdO+QvEFm~?m1U%O7;iE@vV#+vb`XA!x#08=c1Qo?YC-K7c7z$;m
zO1g6Uio0|&N;@@bGG=Jr8u0ors*>%RRHn19A}QM&KSgC8k`YLAyFLMzGXJSHUbN0K
z9>@Rympdo`38)NzXw9GX<y1q(c4rXj)ye;&Yg371*7SUqfk@Ig9X)7eik|Du(VLif
ziV(PNVpe<QX`tQodnC-@7!`#@0YOv%2u6=mcn3TX(PUB7+Lo57mvp>ul`@;T(`#5A
zFQSc&2RYX2EbAFD)Z@{ndcEwuJ=QH<y7y$DGY+uOrdAd#{Mx#X@_O{N;kN0gO*DCl
z(1u#!&>9^;8zbGw%xqL$e;lfVz3^kkX^lMKe8lUIoU_HnEzqm2w_X)3T{*8?YHdCV
zmz?;xxrTm^)?+5r6VZu^WwDJJwwc)j@=|^kxAnZgFo&LA4vA4Wu3EVLP0`VGe6`Lm
z2qDr8!}D^=!(1is<rf1Fe1AIDn>|yy<m-a=;5{8~f3tB%)4dB*uZ^$RBkh5>d`{9M
z&nlsH(z`8IwI8o}^FCEqcXfN=5odOB{fTjRPoZ-(t(D|<7;~6cW3top3v};UEM+N3
zSQcLObSgEyms_t?D?s=sLF_x3FDL?Ie=kG9J<O$4o+wfy<D#XvrJ;AWktJ&{K4#8d
zyDH_J@+jWJ&UIA94TDw$%bHbP=IMcc*`%fgy&^HS3H1Fv|Nc!JJ%aoaX6E~?F-HY`
z>Id`>ZC2o?W_0jOeAFhI5cBrC5}G{=E_yb&$~!|7Xk(789xKfjnan$t+|64_eo`;4
zRnOP+?sS@lo{xDP=<5%VS8>u?N=klPYfIFAbnm-?wCk(rkWC+W7;xPg(W_UiSk<=T
zyu$rxJJD;y_Sq)gXEZ!dXx=S)xt%w*Gwr2&2FedzC^6Q@1RE~Dh1tDdvu9;|H4B&M
zG3AsPTk8FY_cDS<tz$su;KAP3-29nru9N2|{qBaW@BN1?#dD}mD&Io8lljI+Ph-ps
zuRX~KEl^&lMPo^@$aTRDXhx{LpsBBqYpcv$Gq1WVw3UXnf$!|B?SWgVaFkv8?3t2d
zqI$Q>n_tkCGopOD;WnHzwf3*f*qR);@7GlPQ@pdbA_{%(SJCGO(=j8ggROm~l^RGr
z)Av_R2Nf|RG2RIL^*-FV!Snjh=o2*(;;-9=_ExnJQbBx4C3O3Q<l^P1<+&)!9YFhW
z#Hh@aBL|z(Ou$z<(99YyaRSs#o0{3)ko)oUov~AN<cQ2ufw&L}JHd9iKm>MVV)%$G
zg^;Vwea8N3b#t<698dGq=2wYtHYFQ^7js#1v0`}RL1+IoTa*BOzi;@b?ojG$!fpd{
zz_h=+4L7yu?E8aOK+U?R+I&(Mk&d<%;Y%zFr+IJ0{hh^kSBIH%^))7FNt46QuM=Ak
zm$i7O*nUU_aR51}IhLPDZ*RGF7U7vmqmf>2M$)lbG>~IbRJNP8U;24sSgP9tp_BSL
zSD7REJB@A#hh8dqtZcWhS2b)w5ou#7y=dG^=R-yA&dymDk@5>xkrf%Yw>G@SnDs*_
zIdr^c=~+QZ{K`{OXsB<AQysSD27D!9-}tokhh7LG(A|E$RK9zLH6k|}Ix4zNtJO|7
zOK`4jc)cpYXB!}~YL~vQcpVFF!SsFB)nYko#Jg5}oG=p^0ge~t08Mx-c_2@WjwdUY
zW-kjoaf8j#{wTG+;bUDONJRBc2srOIKa@pB5IEb*3&G329g;;;@dPXL`eK1!%u0R8
z7w~Ep6qjgi^rdap$Lnxz7U-1dr7#$!R&<J?;R#(Ly&sCn!kV<xcYJ%lJ!$(Xx*|`0
z|A9m3#bNd)OG=rNs~=k<U{pJaf8R(+)%%9tJKX;ky!CoN;r?7Gs>O(!l|hvVrovLN
zdwD_+$qndvBa1mFL44_prK8p~-I|ZKG@ibOE`*R8Te)1fHN9OHzhVp+LDf+x7!iU!
z7r_bJK;GfEhD~5#w@^?Gk*24&5P~l!v~<~Ls@o!&4GFk~7sameIRN?kWg{fnJjPiq
zQ*S3jWVrfsx5@XtpWXJN?o^A!HcrzVN7du8d^ZPPk@{q@+4Kxwf?%K2r--Z7W#&lv
zLxRwHut{FPF^Ax6%S$*rDfU%IQ1m7F5(c~Ey7?d!p~Yi-1fQil^od@R(%xo9?RNXb
zS)<DNs@c~>UZfDQcU939G51v8<Vp4j0-eBX3q$P&C&?KQI7#8xp0T^X$`<GE#VHnB
zmfUD+=WX`Tt%((|>v+i$@`9B%#vB(TLq98o`i*->ZYv48hi?vU5)G>}>yZtsBk&j}
z)w5xiV<)it!x2yiDx{p_>lUO!qa&+U$B(EwiJu#l%Fm*&JUf^Q!Ad(=NBf~#oQV|)
zOb=C_VjBp2+2j4hzr$-HC{m66os|?q$IK)zz$^Gi3m>qVK|fj;#=9#O^l@*8i;YwT
zv+`75zKAJ&BEJhp6e%v9uGTO4bdN^vfT{c%A+Ke3{Oy_RtK#uFc~kp2Y!K<yC;Qgi
z6)qtm$3~8G@?gXCMJ)T)Pi2C@5o}pgaKS!wJotdIb}r9{)g41ncj&kfnSbagY!mH1
zBxDnPzjnSl>u@uV_>?H5s=pVLpj5=!ducrwBzI15l0PV5Jbwlcr;wlhd(1Qmsqv6N
zO<WY%6D1sez7bMOgMCatzkUpsavDPqm2$cR;jq^^8&kE{kwubA#$1JuV3m)b5v)U-
z(hL~phn2pa4ha%|59XWtmM0YR%1efU*%B8>7!M2f0aCOelH_}ORVNh5OxJQrkN7i;
zg5s(O?NjmWREUgZbb~Ippg}vdzuGK00zGH@gQ~J@UJNQ_DATmA;8I(T^I`510y_Ls
zdF+!+iF&ZFp#L`%iG;{{#3wmnlk3`ubxw>T^m(@*9`?VLub!W+xHhWAsYesb2oLFz
zQSNiDq7k0Qi0PL!BYnu^<*id9&`Y+L!*6>KMtH^7A|=lENc1vS*!cdU=!#HrGN7eb
zHbg#hJ4MtK%50|M(Bd|;sFBODv`fk_whP?7F$*Dt^lho@3c{S!8AjHYMPw=TDApF6
z%WZI#C9j)ug(1O${s}_j2I!me0|rfkYL~ywNksU2_wrX9$;crm!Y^v-m9;EsqdYP3
zk~F?E1(aSD5IwE6YD2*^*Di|o$%0)OX%ho)C#$fXA6@!{M$_Ln3q0(+w4C1_($^KF
zS#qQAX$wLV#9lVs_p1mpPhTWhI8%!}UEaroBqYe%3rZ$_U3?B*tSt*Ed_K>H@jWh)
zu=IJbMA7ScFpOnW$}3y$c_Pe$Pq7p79#I@u+rwy1%3edF#|TXJuC9TxfRd@*Nc@`o
zF+<%yfRlJpq;t27FI2hLmpg0=HxJ1%AOI7Zgi0_1+?04%oW+#b){J-<76N}QUIC!%
ztTC65@zsflU_&0xkQ6Uv+zKqMOLo8jQof3T;X`J8#vqwx@wya-O)?>}YIha2a-#|e
z<p_J<W7`QfP<Qmwx~hJ1rywVf?gT>3;^%^cqsk`)Q045&*c3eylsbc4vdK!MqIbJ*
z2CD@O*TQl7)@Nq6x-ReowDzLCb*F=+Qo=>ls4GR~M}?swDb7MZPZ$X#UNh4Su=qKc
z*y1Qs8x41K`ROU+NKhpIgnGzd^(cyA30uML+dS)`|I)iGPOzr1t#LO<bZ(>lp1<-g
zxsPYSo}evoZS%8}l!*Y8+YLLw!;7m47v%z4NZQ<{Zxb+#*yDQF+YwqD@ddM)5mV6i
z_BdqCQb7we#*PzBN7@X;xDXWSPHa>D{#*1kba@QH&#mK<+2YWkQZwQ~k6Za^lP|6m
z3RNgv35Uh;v`b{frRvfoSF`+hk!ZBNrbK0RrYrLOy1l-QI`-EwDJVk{LEpuj*04#w
z!+L=xq0*eGU7FgiJ4^KiNp;8-lf+*Rqbstz8L+E>CW8<%%2bc&gcJ%ZhN%m*3o5&k
z!coNg#aVvMMv)2a`3}=$4@-IGx3mT$TpJfP>cXpTovtny<{wHp1?qe%i{<LJh5;|l
z$5y;Nd55-=#bVE4N9=%6retx*YSS<!kZYio+fHuEzc(8wcBEe#t@ev%6s(jpu6w+M
z80HZwzy2Et9{uEj6OMz5;i*-Fn(gknm8rw=3`aXyjVZN4(<xb_yknw|gv^mb4XlBH
zhQA?fxtRtyeGw7L)65Z9=r7=)2)-?{iXfL?!-o}7eVjBx8u6jR`d$y_me1ns#E2Sc
z#=j1M+3mu)5i*D}aq}ZR<Mz1+F*132D^o=5Xm^`9FNGyt+?E-AJ$+3~$UbIbCZ~rA
z^!}Hvlig|O_}Jx0w2JwlI;g-Q8p$`>tc7E2G~$hD_pq3!fB_*cP*#=4_@2)9)Ye0P
z+7^;`21ZGBQx>ziVxH}-zA8$o^d*o~<-~HOQ_RBgGNL*mMfk$;!xR{b#JUPS<3X%2
zd0us26y=BsFDMR{7<2-^fZkx_L_&JsqBi%T{^P=z<AE?#<R~OX)w@L_@y4lLc{oj=
z!3bvWyN!Qn&3#k|ur%A94XxUop8kYUh==2;UsLLq7QMZF8J$tj9;|vb#lR-$2ZJg#
zMHW@3%nL7KYhBBs3Z8UH{M@Ke%1AxKj@&b|V&Lu2BGATFUSnR++oheZXb6_Q2=rfL
zA#3AlVx6P|CQ-G8GH*1JU)j7F1d#SFOu+S%I!ACixEm{SnlfN;Cm2u`@CMhR`tDAk
z%3~7vZQ3au_-s6weXGeTq(gAi$my%t(H3%RGGI|DP7<n667GU;N0Q8`JQCENqk|_X
z0Q7APVjC`>g@5K#j7o7cq>~1w+woli7opiJm@esrRF6My1%!@TpZ7F#HSX!pG4pF2
z$)E~-1AH%QL`KY@8kk`z%Nv;K<mlueE%WMZ<y=!V&6G6)6Yi(vV=j7ol-QNkIxOTV
zHjY(^5Jh%3$?q#DW^tn>6#6wE$T***qD{cz9sT?Ld~J$`*D1&Bi$SY|DIvXRA1Bf(
zkc26PZ32E9Fi)Lr9unKBV&t=WtY)=hWQ{BJEzJ2QgkAG(c@Nxvj_&+i7!F4Y(^m>G
zQJ(~Nh_2S13TmiU&cwuSiCHL<ei?ONNl=(1?N7&C>~iu|C^+PYA~Cc}mmCR?>DZ5|
z!_IRwuA~r2U%vr{@HJG*@7WzREWc}IE^TLSvfQ-?>NFO6QMsl)XU%lr{`mam+d+wk
z$3}t#U>85^NVncL8ZV$vni;f7GTpR<?J@%RPpM%*aG#+h3Hr1&kEBY(=>KU+zW95)
zls-R<tCE#s2Kcshs;WLy^pE-QY__f(l(?*z3!e%tle}{I1zLK}>d%^m9@52d60XI7
z>57&@jrtB-DFZPKP<0t^2UXKvJ=m)7^Oo>!b6g7L%V}QK)T5s-tpYkGs)dUZAwFAj
zGmGZL-wi%eh2kv~W7BiaIaFXXHHEjfhJzA}Xt^bnKu6AnLiy;`4{9g4l+Dv)!VYO?
zcgsMFPiY5xWC3-byUJEUu=o3c;78F=D9YjiJQ!k9+z$VjmiQsW2C%u9yxkptFX_mB
z+yVO>L8;Uh8-M{6tLpAF6!txRdL<z(5sOeZc*HMqrcK%I9hE=`&XOU;CXgs}*Lg<j
zlsL?#ulA3{(@OS_3KWXo@SO>OniOQPQX49G6*30pK|XRF@*0^zzM&-ZGWP_vr|2)k
zKqcjTofc>V;ms(*&53u{zYj&X=K_oEoqQ%_x{@!G1@4EcFfI55lox#`KVb|c7d^Z&
zg*Ic~^h;MZXGbV@r1Mr5qA)5Uo4CMr(<JExXjsZx)A`u$66O}t`5=py#(bRRK!$@g
zXYUbvne=F!u70^LPm+Tc=&=@nVuGC^cUIh+cf0Pbih5pJ=KH6<4y;pB%gObHwRs$t
z@SLuaYUOws8y!d=N5Y)(1GT!<<1lS-Bsd~QFMDb@?4E$anRA3`c;1Llu&GBZ@>4iG
znqc<?g<}&U*dG7ET{xesUd$mG{+ADmJM$RMsNj<fNcF1B2eA{<dpW4=l*4Gu93x%8
zo(B6MOR`c30$0Qof(V`|7a<>52KO1uqQ^)B8q$fz%&_PwgpFZH{Q?TCfop*8Y^gu@
z#94INTL$c{{dAG6qR=(lKkkpr;zBtoHdVXFH^ixIDTpC}h5{Cj!09<ZE4W(CH+|;6
z@e4M%qUgB$;P&g2=m$4?sf@4pJk4K&>6N20J3mCBqK!#4u2?bVfL}lscDsG4y%~rS
zdYtHBMCiD<O*}}F#>?~#`2oMk6OO&%R5mwL1xoj5KYd=cC84L=f;JXM^K#|4^H>}e
zMa%ty&WpuSYh40l3(`h5swzpxABCORp$9US_X~@8;G<9BmSz+=`R^Tpgv3(Xrj{nv
z%suTp?Qd4{Ke;OT2EA5E2ms(GCIImHA6%8av4MpF?H^D2-~8sO%3A1(5K0H_Esp;=
z&Pc;<Cds<?h~tbQEA*127|p=6a;kG4ed^VDDk4-`>3SW?^mG`+^7?H~JPlKRHq-6r
zA4bX|#xp^Oqk}cf_f2W`I8Y=k$~QOZj2k}~ZzA+H+U!wub^u>cVwy}6X_N~<^r9Zg
z;8XX<UNy5VG2?v}A(MNnOr-FcX)QY6*9EKk_|SR%RtD@pGL1!7PbpT5aIM20eqivW
zzrczn1`St=%Q__8jDCr*t~OVh(*>6?$D|K#S~+r>(JJVamJT=b1G&y>PJg=4efz{n
zfyw#f6#9aW@%et~>Q?{R{@K~}`jnfNXK!I5ubhV}<YT%F8fiaBmt-8mSzM2YbFTy#
z*s!zkOx^APm8BNdcm$oAURv$R(8Q>v;U>b!G!68#9si2ssj1ny7AT!spM%+&X(Rgs
zDM;7N<LGx9m$DhlI*xJJG_ZWZhzqIm@8sl<Ki-F7I`)DqeUq~4j4L<YxSWuBu*s;|
zQ<G<hE6O)X$fy;SE}2W`s?A_Defh$-w_uiSOFpxvonbTJKh~hGTc2u{bNbQB^sSnT
zpXuF~n9+hdiA?W6Ff4gzFKWjjVFRL8ngO|<zTr41{_X^k-z3Pa8io}oN-njo>J3DN
zpv-xrYo*dSTc(L0F=oXlgPF&onv@tJUEX$wj;?lQcC@7NIN7+~Ojzzq)(j9KU0Rbi
zyxtyiU;4Fpyl$?y&|EpkcC>yy4ux&JJ+eMXWZ&%#g$<BSbUxos;NhBXmV@8kTza7J
znyLo`^}``wL7PH&zwX{q-Sc~2qn5K};Y0is@;k4Q;nhk9z%n(l$nQ8)Ze3@CdD3;{
zBCdaoqvyxmOrVqVZuQ?}5v{XpA?zO(*1?8+?vAs;bprDSTU$JrOKjai+JF=}n1;*d
zyJ6oahXe^HU=+Z^;47kUjfh5G(AXvMj|E}0B+7-0W+8qlsw^uAm@+`QYLl=Bcj-u2
zJY8p420vMK+VlzCbpz8*7Y|OL^91z63aIwu|8&`f*UpaIT_?VZ_x|3`i1SS%yaIuI
zZb@DI3(Oj&y5X(KMqiwW;1^gphe4cgBDhNg{H)+pA|n`mI=C+cIM*aF;V1qkqKFPb
z!R!-Y!3za1sJ>z?6YDFi&9Fyk!G{>6Ez}?(EqJ8PfGm4W_31mPKBLfIv27eyQtQpZ
z-0#mZns%)CN3NSLy=@8jXO^momkvz^TaKdJxs6(l9NO4gLGGo-Sr_^*>E`bj25xJf
z>ut)kw<_z4MvWKKlDEST*I@ovxM|u={Q1-0xivZmunYv*Q+UL}`80pPRc`u%57xvW
z-qY)DX+jCPFUDdMWHBy)Fbnx#*YdHLd4$1pMmmOMHYAEI%}}xe%%{dDQp?gaC8#XQ
z=TW0f>>g@R2M12Vy{kNMkej>Zkw3$QsLne>K!2@`s4_NIo(*`Zr`k10{M>;DhyV7`
z<}@Bj%L~A-wM$+<QPX-QQTefe{jA2&6|UQXF-1{iH!)3&uo0GjvuAG~?x3Ywq?k|I
zUpGOh{OyY^wSa*rmUY>DIDf|h1-#RakL(QgWvhT@xX>!zXLcBCL{`bDG0<17c!PME
zc@QQEof^t?FMo6i*l@y*`5Tk2D_^x@^-p&0;zP`3jkLDcvC<6Kuvr81byOv7v<^9E
zT%^kKgUNC0A7A-%qXvfHy1@2k#R$E*bIfri@kpBc+Jm=a)yEogt}B;y!$3J<x=#g$
z!dzgI_P(aCauUz%sTAKW=|B63OgBrf)kX*iOEE2A<8RN-o(!aM?An!~wp3P$<-4hz
zV5ZEMbC8UC;qMkvLwqlS?#DC@Q%qQfu!6Gf8B5x4Vbq-|?7lAf3@PB4Np412$tdy;
zul0oE`NG~GE>?0G%){8Ugf~%)JUB0*5t&RcB{S1z_LX{tn!~cYgk#NDqq>}L%|ro)
zdZ0MIMQZ4{ZsfsPMj1Wfhy5w8S4Vf;(nqYNj_c_!!<MbI&cqbRPc#K&5qsikaw;w+
zaUG@f_kx`!__!&pbGDVTCUvC&Liux)i|LN-lh&nYe1*sJ?Cp^!vsmqJ1vdEIj-}hn
zbC&Hg)XkRN6{^0T?XpEnd$uDL^~V~m4pyjU+&8DG0ZP})Z;=1Z|4d}UusVPP0G+Ua
zf1Q=s8Q9yKSQ^>=_C0k<E0HTKh#s_)UUawWl@3W%y;veObLLf+q0ToT@d7Kop*i2C
z@7V?4+lj=~F9M)h;I8#e$465>2Jt_yy+AHYL?(ayxg4;kzBCWs__<WHRZUszJk-Qo
z(qF(L0&{*lz@h)AtJmv`)rC|@mz-~EGC+_LS(Uo1Jzj$$EyOg699gNXhuT}MpFH+*
z$cZuZ@ijY5G2BrkHkL^s!>Ga{XkMfTb>63ONQ6E=Z(E|O{8SRTVJ#LWif7rkv+qK?
zMt{y{TahA)F%m1-r(Rc@J$vc!-2lwGQZ#Zyd|L#o+{yNoHP21A&9lx~+_{~1KqVl+
z8!jgTKDrKV;EggzctdH^O+r@Ir&+IbZf4LAkH}gJ$shC`U64+0v^QlNQj$2eF<#%>
zQgjFj57V*?vOG3TV}y+Y3kvd>!Dsdh1^WqR%P&ejds{K~QOZSAHo^vrF;@W0XaiOV
zF@&;xlgVsKF=n{;ef%j~&g7YDj=5=@V35#ywk?qgq?j=Hl<>KT${CVyLa+NwHq4^!
zyx2Hqxl(Os^61vC_2S|bUwZC{DdP{(Dr2Mo_l)#f=29EHC7-xPv<_C8_4Li+k)%lU
zQA8<I_k{%;q6s(}{71N_(3yreXT(@QF1rN}QuhOBm&L`?r_*0+%{?E4t^o$mg5$GN
zC~!yf{&xLV%b2b^NneRpsP{L$zg3oJdq5eHDjXo7&(XDbO<$avV08=1d~AOlO`a`j
zID^pHijthnMeEgM7k9Jd`!PEXv*7QZHl`7fah8UN5Zx90Sd7OWfTZ%Ffpz}jgPg$n
z>L4ncBP#k0H1>pO#1nXPI$A%}Pco>SeCQBAvior6-~&e#4=|epOGCbWo86~uXi-0F
zW>%r-0?QwLLc~F1Ba$MhK`xg1Bm5i8D^wmF;}K6(U<-G^CnG5=(Wjcwwm~eTeY-sC
zwpqq=6Qm^_)6u#?U-QF~CB65Vyw36Web+gJT4)?9TLE#YN&Pjg$6C$Y-3JU4W=-8D
z=gaT<c4W+K>G0lJMJ6!G_n0zAlX+iq)V9l2S<QN#(AH)Bu=1^I-Q9POttdv{cTXqb
z4nuM+(dAV8u3o2N>#h@JsL_IKbIVnmC^EkVHN4sHmPjRC|3HTB5rTVB%L`1L?mN33
zF(h-GyOiXKzQlA`qgxnGudTwYSrIS96GZMXbw(?RvOS1QE~RtonuRQR9{uK~uC8B^
z$Tf9SH`+SrPJKgL^KHa8jB2)~D(P%XXv?~NqbGQ7M6<&{vPY`v&AMAFB#<ze>-f^P
z={3835g$DhOxIT860D8dT9TNvkwfnL?IaJgy2B6QGl=vhUhbK*YRzW1aT%hJTWc@F
zGSy##RIjCZgp-kJjMTJI5v2r|fly7+?9NFd{ml14Ke2g=RUE)bp%ul>2X2@~ZLPe)
z?lNMWCU+mIE;6rJ_(2zl3MBoyZ!?V*1bot-X6T}3iZ33Qn8w45G5g<a_sZlp(v03C
zgXG_Dn%)rp+Z@HZ?XIu`Jl7Wou9Jbsx_>**H3SB)$?NEv8~mQ6R^z5DSMX5+FG$aD
z5Fa9{KNVWY7cSQbrPkf)9^-l=n&)Cvu@PIYdqSS(&E&{C&^pqq)m(aQGP(!0z8I}V
zx7%lxksGt?#ETG}DyEcV@np^`vBrBJ7>;0>>GL8WAHH7i1hrbqs_yt~I)i<rhEa9f
zpos++pk@vVvB>Y%HA&yc)zU~XKKDFZrqpp5X<sf9dg70zXDI~hZx7HNk%NBf3r$b#
zAGivMgF`O&QLVSmbFj*Gn72?f3IOk7J}EdbsThTh8z29s3T@P#=;<4VVTdBj#%WNU
zpN9608$LQ6WFLQk;2I>Ri+99GtWMdzJlw&31|K>}z*>>m_sI4!B~J~#qPlH6Vwvsp
zM`~77{m^<YE0|%12E(u1JzRP-mwBRxWTxleAVf}^RPStt>P_JXP}o0AqN(l)dW=4-
z7Sq*tfS3II3C~iNg%DnSI^!z&LM&)2Vz`hQMBF2Kw{R9MAr1X8B>2Z;>OD5n*Fx^c
zu{>65!);L$=v`UI-JrQub-LK<uc?Dm!gP!{2EBsk#zY8SSj`<n?;$at7n+#ap2j^q
zc!eh?PoPx$EutTew3jm34OJHL3wH&D)qkC^TMC~93kSG=S2&}^P1fGx;iBUQOYHow
zfgy2@^P=d$ns30sDU^Sxgp+~p_dj{A_^EC&FnUCY&DKp0|J4=qFzOn6HN;|PBwi11
zrgRIx6p6t+%aa+73I!zEGwL{f?tLS}FfNEYh!n0qp{T$FMMRu(k5#7UJ(sUd^Pyo8
zW>{o=xd>gZ^qp<V4i1o|q-27gHOM5k5fxJ_a&i{1t<+h21SG-Ni*iD0d81f<ES=}m
zT}WTlehouv!5gY8eD~15CWomncd{0@3_=v&uwnp5BEOy|eVcFjUKe@IZeZI*<wED~
zV(jrtM@Z=%|CZ*{ceOy|eKuKX(U+oQX>?DYA(yU4JURomsAO#D9!URo#lzzl$vkr<
zUgD5EeTumrR~pKEdCq4iWx0-_S$h2&7YqKZ^Q$c>m>Z*u8=!6dmklVHCbbwOa1?(5
zLu?R%AvVA`2^m`}YdcyUYwO>p1&l-czpxtM$o=@fW;sKL(jmN!le1bW)lxx`a02bX
z*9uUKF>hrV7d0EJrd}ykTn}*iCIV&Y9K?w{FoY?$8LBR@@$~ZR>4%={(`=DG!nk;@
zk_q?FG<Y3d!t9EIt6IlbwY(4nbtQESxYAnycRMh?X)=NlRXuw1Q{JR!!Z}}+IA7Z$
zZ_g`u4<=E)4IF}T3pKq1^#^r~t3_{k{Zs=xP-zhR4|6FvP%{}e%?R(}su)OjPp#M5
zF;P><n5E8udv3)NQ3F2yq0Rh!X!V2|kcPoY9%cKU#?7VpSlmgs9f}D<G)6I3kp+(P
zCa6U|mUicWIU-08i}F}s$Wt0O(g4QwS%T&xV$vAzSR0r=GZcK>bXdqhdA+!f1a`3@
z@*^ZuJNJ{OH5ZmBP{=S;UrJ>?Nae8vNHI^2L*`4iHMk_%O>U|Od|#W8q)h9M8K$Q}
zuHKIFX)dSOljwVs_9-0$59_kmRZo-7My;#&+Se)1Tzx19Yjyg5+x}}BkZu!QBYRuK
zOc-hdnN2IxHp9oDbN8~=naNVzAq+~6j4Q~KWv0XvFiIADVx=0gIE1RLZIHre>`*=D
z%f<#KB^$ep7q?^Vv)*>t)}OXMH|!JRXgg=<0meR>Mb@i5T@aA%{TyFEBXp^@2OKBg
zIN_hKXuKz@aA)d2I(&4z-AaV541Wch$bYgo9AQxOrod@v6<CY(XXDYcvi-v`{h##!
zO$T^|$7)FX(E%N_<S&H0hsmGzn4na$wUkN8Y`Iqz4Mt_~Vl$5XZ|xr-KCJ~f9qe#P
zOKr^PUn!ujgVZ4<NXVii?)vC|Mq`kk8gV_^Ae>O9_)1LyO>WwiCFtl9L-)B>tS7Dl
z#h9|oIg(g%R6ev}z64#br$I*U6I+1&m}I`VsYZ!i8QIDdwza?@c9J%EVd6IGVQEZo
zq{z5X-ttKfm~~*bH*y{`8!VsuwCZI3SB^;sPcm^GtPe){{C4tQ81yhFE%3)Gqz*4Z
zj}~{2t6XzvHFu#P!^q>hl;$8RzS7xYqi;K(lFvr;wsi}9mc@*|T&VIdW48MhR4}nx
z8pnRcfb6N0nNP12mV%MekkL~*&%grtRdICaRa!37!&}#hA7+@YKN^=?_$t=Lbs)IP
z!D_E*^nh?eGE9h!lsW2QTMM82=!*O4dfk#ag$HD02jZPrvu}%b8*mtr@-}da_1_ef
z&JnSh=pz6?YYhPWp8x*{g|oAFF*o>QbJv!xVYkwP6nMcg^WHV3;1)A@ZM6M$9AhQK
zOnL`9bI_!M06A91&wn^-@wk!}N)Gvugp8)?E`eJ11<)IY*5#XbyK+HW4eNQu^ogPw
zU2+{S95ln90(od#_jc!Me=SHhdXFk3SsuC*z1)T6`E^F?{d(obC9#rZ0u)Z9=7y~e
zo%+Vzfg9IoD|Ud&tx}P53i5y=LZw2hAk1cTx={CyM*b>vPxnjS;KELipWlpZgy@UR
ztUC?gn@WJ-XxwUV)OQ+YS&}8WvKqLvW`r}9{3!|rf(ZtX>FP3P`cFfsj9($Ll>Li`
zXF0tpr3)%zc#kfJe4c0%Il7?Xt)T#g7y|@SroC)x1HTMVdbgg|2xZCBL?x#SQ4Uo<
zKyW_i&4tT9rc9_1+?2VeaOd5PJSRNa<;HS;%$QI?g}Ev+%a*O4oLw0q{zT;AUrW_F
z3U0>LMD=dMg>2Y-cb^d4YpkA_{Hlcat8cgO@Y4Eb+(E^!-z}CTY|M?*<w4JMq1V-{
zpc#!Qu_H}0(P!tmx1@9as6w-o;X|b|nZ#G~47)X1(n3fQ`Os;!AW}S5+72{>kF|tK
z4g?S~uWPykS$z)gbL}pwDPnkgH<c9b+fz&nkTgOCRImF{twHid@>mDDw^Q-O8$Yg<
zS3}9RL+-lu$qC==hT`xrq8u;YUG&(!UWJN61>U{vS?Jrp8BQf7MOTVZ9_2z)GCwIo
z3|`L!EPl59`CjWIX-cxZo%ADNN0iPbf^JTj0DdHRlzqj~@alMVtWf3yPP+o{fR)1J
zklJVaXT=Zcz*oHW5`4cWFI3{#;7)lV|31JmcVth5ab%A<@D>N&6u=wWI5Iak_iLnQ
z_&!?;xo=$Q<lM*danIeuv$fS%JAXW<_xR0$H6E}>n+JqP&(+tRR$!6!Ik3p}1z0ri
zY*{}Gb6z(V>s~doFSZvl>=J#Gw8fNYoG4mj?7WvZ@I5w;xJ#Z$jSC5(AYim@eS<$-
z^!4DTP2vEQ8DU>nHjkYZPt_*l*S4I|5J(u|7!h~@C#{@t*yHU{{DjMJT=aKGb9Unt
zXb4fH38?4&Q0hTt&XC|VD}G`Olm;BtgNc!8V&AOq15^@omnGyvEZpv&mo6J92)Y#r
zNJw=(a*uQanK@bMlDCR|x?v|^VGW&iwM~TP1eha=@=Y;i{pOf*97~@`6<YuJ!$jar
zaVD^FC3i3%WBW{DAn$#BtzLew;c?SdqK{C=6@<>crT9U@4>GYva9D99Yc;`gVEG`N
z`an$ZWHUxrY9+R4{;nWQ{iGIEl)jA@i;2R{!bRYI`8pW3VGpixv0d{^(#JZrRChzw
z(QCySOgY*asT8V`4`<em)$Yy+D;S$Xc^D~h%hljqk7~_7sQ2>FpB(G4HLG#Vn#wh!
z#Pa4!W5Da<Dco}~0<9J(Gmh&{P3Vq<M2j<A1cZO=7neMzT0HR+iPDaEg(!(9LdQ`u
zBfb_skA1k?%qWM*ob=Nt%$_<MX-$U4m@LP)#JlK(h%!|uNHOS{1XRjrlqQF(T!6ow
zk!HT87x*TzLrcvI7`choap`L>_-e-%i%<{}9vKvffDd7tI=}Cpr0ALm@Vkk)I3S3R
zhXj8|tt=6Q^l7|pdMq2j^PP*{dJW6ZSw+iXm?MH7U1k{#UFvjUb1!-+0F6!0<_TRr
z<w?!22r1}+)B3_>-ID|*B+11U|C+R^kJYqAy3!?^ep;`u^5sX8OuLJGVe6J`=Edc1
z<vw}wv<txzrZpI`SvOpC8FT{GHgPVeUJntcPERhk)=wHeXK*#!z=tS#0exL`^aNxG
zAre0ySrcvTJW$w9{sCXOPRZX7r9xjMY7i=P1s<aGw~&f!Wx5hiLv8uj(XOKB6d&2U
z+T00{%!xa~WXsU%XnBuuzG+D&(ea%GF_o4te4a7x-B2tdl*{}j`+Gfb6vdX?U%n-}
z&Bj_+Yitz>ybT%YD^RM$-w`e%8OTux)-^VySxe~Otk-+!?2ATrD>z3}?TV8SWw4JA
z;gsI&ncOM&pB$$FBlzxrQJ{`+Cet*wzOwA!YFq7o(XsMBqpd0*lV+W$tqWMY5ka{s
z$hp)BoymRcE)Zt*je3B*P(+RxjLV3r8l8EKX;rW#x-K&!rn=#u5ZRd#(oe$UuDva;
zC;H)VmuV4saOiHN(Qb^js%owzye!n<&|O=hIa?)WjS;vv2U;Y>Gtsp3k}`l3WfPO;
zTOF4+y`p3(kks9Aqm}bxiQcb(+{*0%9Q|R8uw`NJ$tb(T<E8&Y;TwX(+EKvw*sH7r
zyV>`j3VQK2jd~Yb{Sk*;=S@iMkoc@Q3nII)!f>LNVi(mzz+#bRq{Atgaj2##nEo9h
zO7sgxRo>7EV`lBon?kpm@J&d@xqRTuMPQ0Bmf*uh_^TsD(Y`Dc0$C9-z?z>Q(8r7D
zaE;{AFZAR^uIMT9{#O1Qf#~zcXUEMAPJwP1pXDZn0-)+-2|z96Yc;X8<<X-UDZ(Fs
zh)484*9CvW`b_xy(|B3lrX*Q{4;J!&FDl1nzGbBdAHewB{{n=#hr^Knt!aP%q2KM{
z`_Cq(h6R9y!|d1y1zd3p1)$*N^1=MGZGVIOer2G5dSLix>jjkF%V=d=ENe42ow(AS
zP9Hk$6_k!!U&$IH*pH)@XNSj*->H5k$Vu~__yq}n**JtmVkD1W%5hXzY;4|7gqjVQ
z;HhZMysSO~>$ETSME$AG_~CM=BSu?#uc>roB?f<p<NWx@kyzOQ*D0dIkvJJ5sue<G
zXJky0+?5@)TcaoZGpCKeQ^dR?oB4JH{W6R{^(r%inopHaYrh`lB{3P~!NL?N*UFK-
zn-@90y@PO=_5K%o2l1jgL$<*FL(0^&NhL1U?8<OUP%&vz2--5N0L8_K>p0A1SjzfN
z*){O8+2~CY=B`I^IN5bM{`kyUYwcb!IB4bKS4bn)ZgErZt0c^vw){Xcp5iU}zywU>
zDmi{o#bcjOHJ^59nFU;cI8V8rJ{(0;k*+^*1pf}=O$<-`JIGYzG8R+&7f_Z}F+qvA
zX>HhaG-iI)=SVew6`v;PC752gam6g*27N&{Lvhq@Mm1km3#I`B@djf{KCQb|{|<&0
zXfm#J^tLKX6jdG8VQEwKhS@KF??sdO5IHlA+HpK)619U^#7N?*+)hnCOR>$8T-xlL
zUu_z&m;Y0BlX<b^KYH}{Z<_P_4a6<}B;x-o|F-~OV|M@f<Lvp4`r<nW{Rngk<~J{f
z&pl7BeIpl}4Y<i6B^UVRw4kX7>w;)RhMxSzWdbtqm<q2mq6HOq^*>AKK7oltC$%J3
zy=@aKkwa#o4>;wd>N*{?JlU@~wwh(k9bhi7a+swgS*$4Z91rAa^UIes9p6=-8@^B!
zl+wq|McE#CoyUrRWt`yUl~AC!SHa{*Y1xrqsN9*<+j_}gyJ+I1V<!h~YvE)nY+USz
zOOJiq1P@P3DAt_kf!#OWKgQZPp`5KK;5IigwJYtNR9v4kyV1Ho@&c}w|F+=+0i_0V
zO#eNL_V?cA&)0v+sg)7`cLD#N^Y>?P9FT(fQwHE)f&ZQi^=Du$kQn`AW&b~<M*UUN
zUlU~hCF=;7D*T6}Kc~z575>+lg@3^lfSZs%;D3!^_^XJ&9y|R@#Am{P>{9+j<^2`@
zS4Q|>@a8XnhyNQt{8#*6>BE2FN6G$<{|lM;R|)@4oBaz90H9I;0DmRX{)+y0-r&#Z
v@6>-n|AR&NEBvp!x_=3{rTxd~{d12eBmM!X9>4QTKLWaeJcR(q@3;R4FrMz;

literal 0
HcmV?d00001

diff --git a/src/.cproject b/src/.cproject
index 9b251a9e..fa1d02cc 100644
--- a/src/.cproject
+++ b/src/.cproject
@@ -3,9 +3,9 @@
     	
     <storageModule moduleId="org.eclipse.cdt.core.settings">
         		
-        <cconfiguration id="cdt.managedbuild.toolchain.gnu.mingw.base.723465254">
+        <cconfiguration id="cdt.managedbuild.toolchain.gnu.mingw.base.1058757420">
             			
-            <storageModule buildSystemId="org.eclipse.cdt.managedbuilder.core.configurationDataProvider" id="cdt.managedbuild.toolchain.gnu.mingw.base.723465254" moduleId="org.eclipse.cdt.core.settings" name="Default">
+            <storageModule buildSystemId="org.eclipse.cdt.managedbuilder.core.configurationDataProvider" id="cdt.managedbuild.toolchain.gnu.mingw.base.1058757420" moduleId="org.eclipse.cdt.core.settings" name="Default">
                 				
                 <externalSettings/>
                 				
@@ -29,35 +29,41 @@
             			
             <storageModule moduleId="cdtBuildSystem" version="4.0.0">
                 				
-                <configuration buildProperties="" description="" id="cdt.managedbuild.toolchain.gnu.mingw.base.723465254" name="Default" optionalBuildProperties="" parent="org.eclipse.cdt.build.core.emptycfg">
+                <configuration buildProperties="" description="" id="cdt.managedbuild.toolchain.gnu.mingw.base.1058757420" name="Default" optionalBuildProperties="" parent="org.eclipse.cdt.build.core.emptycfg">
                     					
-                    <folderInfo id="cdt.managedbuild.toolchain.gnu.mingw.base.723465254.940084196" name="/" resourcePath="">
+                    <folderInfo id="cdt.managedbuild.toolchain.gnu.mingw.base.1058757420.1612633561" name="/" resourcePath="">
                         						
-                        <toolChain id="cdt.managedbuild.toolchain.gnu.mingw.base.424651525" name="MinGW GCC" superClass="cdt.managedbuild.toolchain.gnu.mingw.base">
+                        <toolChain id="cdt.managedbuild.toolchain.gnu.mingw.base.821623901" name="MinGW GCC" superClass="cdt.managedbuild.toolchain.gnu.mingw.base">
                             							
-                            <targetPlatform archList="all" binaryParser="org.eclipse.cdt.core.PE" id="cdt.managedbuild.target.gnu.platform.mingw.base.193021253" name="Debug Platform" osList="win32" superClass="cdt.managedbuild.target.gnu.platform.mingw.base"/>
+                            <targetPlatform archList="all" binaryParser="org.eclipse.cdt.core.PE" id="cdt.managedbuild.target.gnu.platform.mingw.base.1627500181" name="Debug Platform" osList="win32" superClass="cdt.managedbuild.target.gnu.platform.mingw.base"/>
                             							
-                            <builder buildPath="C:\adda3\src" id="cdt.managedbuild.builder.gnu.cross.888301030" managedBuildOn="false" superClass="cdt.managedbuild.builder.gnu.cross"/>
+                            <builder buildPath="C:\adda_1\src" id="cdt.managedbuild.builder.gnu.cross.36234924" keepEnvironmentInBuildfile="false" managedBuildOn="false" name="Gnu Make Builder" superClass="cdt.managedbuild.builder.gnu.cross"/>
                             							
-                            <tool id="cdt.managedbuild.tool.gnu.assembler.mingw.base.738995375" name="GCC Assembler" superClass="cdt.managedbuild.tool.gnu.assembler.mingw.base">
+                            <tool id="cdt.managedbuild.tool.gnu.assembler.mingw.base.823972384" name="GCC Assembler" superClass="cdt.managedbuild.tool.gnu.assembler.mingw.base">
                                 								
-                                <inputType id="cdt.managedbuild.tool.gnu.assembler.input.2143708375" superClass="cdt.managedbuild.tool.gnu.assembler.input"/>
+                                <inputType id="cdt.managedbuild.tool.gnu.assembler.input.1692673043" superClass="cdt.managedbuild.tool.gnu.assembler.input"/>
                                 							
                             </tool>
                             							
-                            <tool id="cdt.managedbuild.tool.gnu.archiver.mingw.base.1562857147" name="GCC Archiver" superClass="cdt.managedbuild.tool.gnu.archiver.mingw.base"/>
+                            <tool id="cdt.managedbuild.tool.gnu.archiver.mingw.base.1623148525" name="GCC Archiver" superClass="cdt.managedbuild.tool.gnu.archiver.mingw.base"/>
                             							
-                            <tool id="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base.840199152" name="GCC C++ Compiler" superClass="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base"/>
+                            <tool id="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base.1390697299" name="GCC C++ Compiler" superClass="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base">
+                                								
+                                <inputType id="cdt.managedbuild.tool.gnu.cpp.compiler.input.21165115" superClass="cdt.managedbuild.tool.gnu.cpp.compiler.input"/>
+                                							
+                            </tool>
                             							
-                            <tool id="cdt.managedbuild.tool.gnu.c.compiler.mingw.base.1654760587" name="GCC C Compiler" superClass="cdt.managedbuild.tool.gnu.c.compiler.mingw.base">
+                            <tool id="cdt.managedbuild.tool.gnu.c.compiler.mingw.base.1776027495" name="GCC C Compiler" superClass="cdt.managedbuild.tool.gnu.c.compiler.mingw.base">
                                 								
-                                <inputType id="cdt.managedbuild.tool.gnu.c.compiler.input.885069331" superClass="cdt.managedbuild.tool.gnu.c.compiler.input"/>
+                                <inputType id="cdt.managedbuild.tool.gnu.c.compiler.input.1961918274" superClass="cdt.managedbuild.tool.gnu.c.compiler.input"/>
                                 							
                             </tool>
                             							
-                            <tool id="cdt.managedbuild.tool.gnu.c.linker.mingw.base.855642708" name="MinGW C Linker" superClass="cdt.managedbuild.tool.gnu.c.linker.mingw.base">
+                            <tool id="cdt.managedbuild.tool.gnu.c.linker.mingw.base.397089588" name="MinGW C Linker" superClass="cdt.managedbuild.tool.gnu.c.linker.mingw.base"/>
+                            							
+                            <tool id="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base.486856509" name="MinGW C++ Linker" superClass="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base">
                                 								
-                                <inputType id="cdt.managedbuild.tool.gnu.c.linker.input.1899695635" superClass="cdt.managedbuild.tool.gnu.c.linker.input">
+                                <inputType id="cdt.managedbuild.tool.gnu.cpp.linker.input.822805650" superClass="cdt.managedbuild.tool.gnu.cpp.linker.input">
                                     									
                                     <additionalInput kind="additionalinputdependency" paths="$(USER_OBJS)"/>
                                     									
@@ -66,8 +72,6 @@
                                 </inputType>
                                 							
                             </tool>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base.1172644723" name="MinGW C++ Linker" superClass="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base"/>
                             						
                         </toolChain>
                         					
@@ -97,22 +101,12 @@
     	
     <storageModule moduleId="cdtBuildSystem" version="4.0.0">
         		
-        <project id="adda_3_onC.null.1757565600" name="adda_3_onC"/>
+        <project id="adda.null.1400785423" name="adda"/>
         	
     </storageModule>
     	
     <storageModule moduleId="org.eclipse.cdt.core.LanguageSettingsProviders"/>
     	
-    <storageModule moduleId="refreshScope" versionNumber="2">
-        		
-        <configuration configurationName="Default">
-            			
-            <resource resourceType="PROJECT" workspacePath="/adda_3_onC"/>
-            		
-        </configuration>
-        	
-    </storageModule>
-    	
     <storageModule moduleId="org.eclipse.cdt.make.core.buildtargets">
         		
         <buildTargets>
@@ -136,5 +130,15 @@
         </buildTargets>
         	
     </storageModule>
+    	
+    <storageModule moduleId="refreshScope" versionNumber="2">
+        		
+        <configuration configurationName="Default">
+            			
+            <resource resourceType="PROJECT" workspacePath="/adda"/>
+            		
+        </configuration>
+        	
+    </storageModule>
     
 </cproject>
diff --git a/src/.gitignore b/src/.gitignore
new file mode 100644
index 00000000..a6eb73b9
--- /dev/null
+++ b/src/.gitignore
@@ -0,0 +1,21 @@
+/githash.h
+
+# The same ignores apply to all compilation folders
+/*/*.exe
+/*/*.dll
+/*/adda*
+/*/*.o
+/*/*.d
+/*/.*opts
+/*/*stackdump
+/*/ExpCount
+/*/tables/
+/*/run*/
+/*/test*/
+/*/*.dat
+/*/*.geom
+/*/out
+/*/*.clstr
+
+
+
diff --git a/src/.project b/src/.project
index 5f126b26..0adaf783 100644
--- a/src/.project
+++ b/src/.project
@@ -22,5 +22,6 @@
 		<nature>org.eclipse.cdt.core.cnature</nature>
 		<nature>org.eclipse.cdt.managedbuilder.core.managedBuildNature</nature>
 		<nature>org.eclipse.cdt.managedbuilder.core.ScannerConfigNature</nature>
+		<nature>org.eclipse.cdt.core.ccnature</nature>
 	</natures>
 </projectDescription>
diff --git a/src/.settings/language.settings.xml b/src/.settings/language.settings.xml
new file mode 100644
index 00000000..2ad3bdaa
--- /dev/null
+++ b/src/.settings/language.settings.xml
@@ -0,0 +1,28 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<project>
+    	
+    <configuration id="cdt.managedbuild.toolchain.gnu.mingw.base.1058757420" name="Default">
+        		
+        <extension point="org.eclipse.cdt.core.LanguageSettingsProvider">
+            			
+            <provider copy-of="extension" id="org.eclipse.cdt.ui.UserLanguageSettingsProvider"/>
+            			
+            <provider-reference id="org.eclipse.cdt.core.ReferencedProjectsLanguageSettingsProvider" ref="shared-provider"/>
+            			
+            <provider class="org.eclipse.cdt.managedbuilder.language.settings.providers.GCCBuildCommandParser" id="org.eclipse.cdt.managedbuilder.core.GCCBuildCommandParser" keep-relative-paths="false" name="CDT GCC Build Output Parser" parameter="(g?cc)|([gc]\+\+)|(clang)" prefer-non-shared="true"/>
+            			
+            <provider class="org.eclipse.cdt.managedbuilder.internal.language.settings.providers.GCCBuiltinSpecsDetectorMinGW" console="false" env-hash="-404675868575427125" id="org.eclipse.cdt.managedbuilder.core.GCCBuiltinSpecsDetectorMinGW" keep-relative-paths="false" name="CDT GCC Built-in Compiler Settings MinGW" parameter="${COMMAND} ${FLAGS} -E -P -v -dD &quot;${INPUTS}&quot;" prefer-non-shared="true">
+                				
+                <language-scope id="org.eclipse.cdt.core.gcc"/>
+                				
+                <language-scope id="org.eclipse.cdt.core.g++"/>
+                			
+            </provider>
+            			
+            <provider-reference id="org.eclipse.cdt.managedbuilder.core.MBSLanguageSettingsProvider" ref="shared-provider"/>
+            		
+        </extension>
+        	
+    </configuration>
+    
+</project>
diff --git a/src/.settings/org.eclipse.cdt.codan.core.prefs b/src/.settings/org.eclipse.cdt.codan.core.prefs
new file mode 100644
index 00000000..73293b43
--- /dev/null
+++ b/src/.settings/org.eclipse.cdt.codan.core.prefs
@@ -0,0 +1,77 @@
+eclipse.preferences.version=1
+org.eclipse.cdt.codan.checkers.errnoreturn=Warning
+org.eclipse.cdt.codan.checkers.errnoreturn.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"No return\\")",implicit\=>false}
+org.eclipse.cdt.codan.checkers.errreturnvalue=Error
+org.eclipse.cdt.codan.checkers.errreturnvalue.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Unused return value\\")"}
+org.eclipse.cdt.codan.checkers.nocommentinside=-Error
+org.eclipse.cdt.codan.checkers.nocommentinside.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Nesting comments\\")"}
+org.eclipse.cdt.codan.checkers.nolinecomment=-Error
+org.eclipse.cdt.codan.checkers.nolinecomment.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Line comments\\")"}
+org.eclipse.cdt.codan.checkers.noreturn=Error
+org.eclipse.cdt.codan.checkers.noreturn.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"No return value\\")",implicit\=>false}
+org.eclipse.cdt.codan.internal.checkers.AbstractClassCreation=Error
+org.eclipse.cdt.codan.internal.checkers.AbstractClassCreation.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Abstract class cannot be instantiated\\")"}
+org.eclipse.cdt.codan.internal.checkers.AmbiguousProblem=Error
+org.eclipse.cdt.codan.internal.checkers.AmbiguousProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Ambiguous problem\\")"}
+org.eclipse.cdt.codan.internal.checkers.AssignmentInConditionProblem=Warning
+org.eclipse.cdt.codan.internal.checkers.AssignmentInConditionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Assignment in condition\\")"}
+org.eclipse.cdt.codan.internal.checkers.AssignmentToItselfProblem=Error
+org.eclipse.cdt.codan.internal.checkers.AssignmentToItselfProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Assignment to itself\\")"}
+org.eclipse.cdt.codan.internal.checkers.CaseBreakProblem=Warning
+org.eclipse.cdt.codan.internal.checkers.CaseBreakProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"No break at end of case\\")",no_break_comment\=>"no break",last_case_param\=>false,empty_case_param\=>false,enable_fallthrough_quickfix_param\=>false}
+org.eclipse.cdt.codan.internal.checkers.CatchByReference=Warning
+org.eclipse.cdt.codan.internal.checkers.CatchByReference.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Catching by reference is recommended\\")",unknown\=>false,exceptions\=>()}
+org.eclipse.cdt.codan.internal.checkers.CircularReferenceProblem=Error
+org.eclipse.cdt.codan.internal.checkers.CircularReferenceProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Circular inheritance\\")"}
+org.eclipse.cdt.codan.internal.checkers.ClassMembersInitialization=Warning
+org.eclipse.cdt.codan.internal.checkers.ClassMembersInitialization.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Class members should be properly initialized\\")",skip\=>true}
+org.eclipse.cdt.codan.internal.checkers.DecltypeAutoProblem=Error
+org.eclipse.cdt.codan.internal.checkers.DecltypeAutoProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid 'decltype(auto)' specifier\\")"}
+org.eclipse.cdt.codan.internal.checkers.FieldResolutionProblem=Error
+org.eclipse.cdt.codan.internal.checkers.FieldResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Field cannot be resolved\\")"}
+org.eclipse.cdt.codan.internal.checkers.FunctionResolutionProblem=Error
+org.eclipse.cdt.codan.internal.checkers.FunctionResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Function cannot be resolved\\")"}
+org.eclipse.cdt.codan.internal.checkers.InvalidArguments=Error
+org.eclipse.cdt.codan.internal.checkers.InvalidArguments.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid arguments\\")"}
+org.eclipse.cdt.codan.internal.checkers.InvalidTemplateArgumentsProblem=Error
+org.eclipse.cdt.codan.internal.checkers.InvalidTemplateArgumentsProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid template argument\\")"}
+org.eclipse.cdt.codan.internal.checkers.LabelStatementNotFoundProblem=Error
+org.eclipse.cdt.codan.internal.checkers.LabelStatementNotFoundProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Label statement not found\\")"}
+org.eclipse.cdt.codan.internal.checkers.MemberDeclarationNotFoundProblem=Error
+org.eclipse.cdt.codan.internal.checkers.MemberDeclarationNotFoundProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Member declaration not found\\")"}
+org.eclipse.cdt.codan.internal.checkers.MethodResolutionProblem=Error
+org.eclipse.cdt.codan.internal.checkers.MethodResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Method cannot be resolved\\")"}
+org.eclipse.cdt.codan.internal.checkers.NamingConventionFunctionChecker=-Info
+org.eclipse.cdt.codan.internal.checkers.NamingConventionFunctionChecker.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Name convention for function\\")",pattern\=>"^[a-z]",macro\=>true,exceptions\=>()}
+org.eclipse.cdt.codan.internal.checkers.NonVirtualDestructorProblem=Warning
+org.eclipse.cdt.codan.internal.checkers.NonVirtualDestructorProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Class has a virtual method and non-virtual destructor\\")"}
+org.eclipse.cdt.codan.internal.checkers.OverloadProblem=Error
+org.eclipse.cdt.codan.internal.checkers.OverloadProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid overload\\")"}
+org.eclipse.cdt.codan.internal.checkers.RedeclarationProblem=Error
+org.eclipse.cdt.codan.internal.checkers.RedeclarationProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid redeclaration\\")"}
+org.eclipse.cdt.codan.internal.checkers.RedefinitionProblem=Error
+org.eclipse.cdt.codan.internal.checkers.RedefinitionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid redefinition\\")"}
+org.eclipse.cdt.codan.internal.checkers.ReturnStyleProblem=-Warning
+org.eclipse.cdt.codan.internal.checkers.ReturnStyleProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Return with parenthesis\\")"}
+org.eclipse.cdt.codan.internal.checkers.ScanfFormatStringSecurityProblem=-Warning
+org.eclipse.cdt.codan.internal.checkers.ScanfFormatStringSecurityProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Format String Vulnerability\\")"}
+org.eclipse.cdt.codan.internal.checkers.StatementHasNoEffectProblem=Warning
+org.eclipse.cdt.codan.internal.checkers.StatementHasNoEffectProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Statement has no effect\\")",macro\=>true,exceptions\=>()}
+org.eclipse.cdt.codan.internal.checkers.SuggestedParenthesisProblem=Warning
+org.eclipse.cdt.codan.internal.checkers.SuggestedParenthesisProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Suggested parenthesis around expression\\")",paramNot\=>false}
+org.eclipse.cdt.codan.internal.checkers.SuspiciousSemicolonProblem=Warning
+org.eclipse.cdt.codan.internal.checkers.SuspiciousSemicolonProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Suspicious semicolon\\")",else\=>false,afterelse\=>false}
+org.eclipse.cdt.codan.internal.checkers.TypeResolutionProblem=Error
+org.eclipse.cdt.codan.internal.checkers.TypeResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Type cannot be resolved\\")"}
+org.eclipse.cdt.codan.internal.checkers.UnusedFunctionDeclarationProblem=Warning
+org.eclipse.cdt.codan.internal.checkers.UnusedFunctionDeclarationProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Unused function declaration\\")",macro\=>true}
+org.eclipse.cdt.codan.internal.checkers.UnusedStaticFunctionProblem=Warning
+org.eclipse.cdt.codan.internal.checkers.UnusedStaticFunctionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Unused static function\\")",macro\=>true}
+org.eclipse.cdt.codan.internal.checkers.UnusedVariableDeclarationProblem=Warning
+org.eclipse.cdt.codan.internal.checkers.UnusedVariableDeclarationProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Unused variable declaration in file scope\\")",macro\=>true,exceptions\=>("@(\#)","$Id")}
+org.eclipse.cdt.codan.internal.checkers.UsingInHeaderProblem=-Warning
+org.eclipse.cdt.codan.internal.checkers.UsingInHeaderProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Using directive in header\\")"}
+org.eclipse.cdt.codan.internal.checkers.VariableResolutionProblem=Error
+org.eclipse.cdt.codan.internal.checkers.VariableResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Symbol is not resolved\\")"}
+org.eclipse.cdt.qt.core.qtproblem=Warning
+org.eclipse.cdt.qt.core.qtproblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>false,RUN_ON_INC_BUILD\=>false,RUN_ON_FILE_OPEN\=>true,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>null}
diff --git a/src/Default/cpp/subdir.mk b/src/Default/cpp/subdir.mk
new file mode 100644
index 00000000..ca31b88e
--- /dev/null
+++ b/src/Default/cpp/subdir.mk
@@ -0,0 +1,30 @@
+################################################################################
+# Automatically-generated file. Do not edit!
+################################################################################
+
+# Add inputs and outputs from these tool invocations to the build variables 
+CPP_SRCS += \
+../cpp/fft_execute.cpp \
+../cpp/fft_kernelstring.cpp \
+../cpp/fft_setup.cpp 
+
+OBJS += \
+./cpp/fft_execute.o \
+./cpp/fft_kernelstring.o \
+./cpp/fft_setup.o 
+
+CPP_DEPS += \
+./cpp/fft_execute.d \
+./cpp/fft_kernelstring.d \
+./cpp/fft_setup.d 
+
+
+# Each subdirectory must supply rules for building sources it contributes
+cpp/%.o: ../cpp/%.cpp
+	@echo 'Building file: $<'
+	@echo 'Invoking: GCC C++ Compiler'
+	g++ -O2 -g -Wall -c -fmessage-length=0 -MMD -MP -MF"$(@:%.o=%.d)" -MT"$(@)" -o "$@" "$<"
+	@echo 'Finished building: $<'
+	@echo ' '
+
+
diff --git a/src/Default/makefile b/src/Default/makefile
new file mode 100644
index 00000000..ab38455d
--- /dev/null
+++ b/src/Default/makefile
@@ -0,0 +1,61 @@
+################################################################################
+# Automatically-generated file. Do not edit!
+################################################################################
+
+-include ../makefile.init
+
+RM := del
+
+# All of the sources participating in the build are defined here
+-include sources.mk
+-include seq/subdir.mk
+-include ocl/subdir.mk
+-include mpi/subdir.mk
+-include cpp/subdir.mk
+-include subdir.mk
+-include objects.mk
+
+ifneq ($(MAKECMDGOALS),clean)
+ifneq ($(strip $(CC_DEPS)),)
+-include $(CC_DEPS)
+endif
+ifneq ($(strip $(C++_DEPS)),)
+-include $(C++_DEPS)
+endif
+ifneq ($(strip $(C_UPPER_DEPS)),)
+-include $(C_UPPER_DEPS)
+endif
+ifneq ($(strip $(CXX_DEPS)),)
+-include $(CXX_DEPS)
+endif
+ifneq ($(strip $(CPP_DEPS)),)
+-include $(CPP_DEPS)
+endif
+ifneq ($(strip $(C_DEPS)),)
+-include $(C_DEPS)
+endif
+endif
+
+-include ../makefile.defs
+
+# Add inputs and outputs from these tool invocations to the build variables 
+
+# All Target
+all: 
+
+# Tool invocations
+: $(OBJS) $(USER_OBJS)
+	@echo 'Building target: $@'
+	@echo 'Invoking: MinGW C++ Linker'
+	g++  -o  $(OBJS) $(USER_OBJS) $(LIBS)
+	@echo 'Finished building target: $@'
+	@echo ' '
+
+# Other Targets
+clean:
+	-$(RM) $(CC_DEPS)$(C++_DEPS)$(EXECUTABLES)$(OBJS)$(C_UPPER_DEPS)$(CXX_DEPS)$(CPP_DEPS)$(C_DEPS) 
+	-@echo ' '
+
+.PHONY: all clean dependents
+
+-include ../makefile.targets
diff --git a/src/Default/mpi/subdir.mk b/src/Default/mpi/subdir.mk
new file mode 100644
index 00000000..29205625
--- /dev/null
+++ b/src/Default/mpi/subdir.mk
@@ -0,0 +1,44 @@
+################################################################################
+# Automatically-generated file. Do not edit!
+################################################################################
+
+# Add inputs and outputs from these tool invocations to the build variables 
+O_SRCS += \
+../mpi/ADDAmain.o \
+../mpi/CalculateE.o \
+../mpi/GenerateB.o \
+../mpi/Romberg.o \
+../mpi/calculator.o \
+../mpi/chebyshev.o \
+../mpi/comm.o \
+../mpi/crosssec.o \
+../mpi/d07hre.o \
+../mpi/d09hre.o \
+../mpi/d113re.o \
+../mpi/d132re.o \
+../mpi/dadhre.o \
+../mpi/dchhre.o \
+../mpi/dcuhre.o \
+../mpi/dfshre.o \
+../mpi/dinhre.o \
+../mpi/drlhre.o \
+../mpi/dtrhre.o \
+../mpi/fft.o \
+../mpi/interaction.o \
+../mpi/io.o \
+../mpi/iterative.o \
+../mpi/linalg.o \
+../mpi/make_particle.o \
+../mpi/matvec.o \
+../mpi/memory.o \
+../mpi/mt19937ar.o \
+../mpi/param.o \
+../mpi/propaesplibreintadda.o \
+../mpi/sinint.o \
+../mpi/somnec.o \
+../mpi/timing.o \
+../mpi/vars.o 
+
+
+# Each subdirectory must supply rules for building sources it contributes
+
diff --git a/src/Default/objects.mk b/src/Default/objects.mk
new file mode 100644
index 00000000..742c2da0
--- /dev/null
+++ b/src/Default/objects.mk
@@ -0,0 +1,8 @@
+################################################################################
+# Automatically-generated file. Do not edit!
+################################################################################
+
+USER_OBJS :=
+
+LIBS :=
+
diff --git a/src/Default/ocl/subdir.mk b/src/Default/ocl/subdir.mk
new file mode 100644
index 00000000..f92ada69
--- /dev/null
+++ b/src/Default/ocl/subdir.mk
@@ -0,0 +1,45 @@
+################################################################################
+# Automatically-generated file. Do not edit!
+################################################################################
+
+# Add inputs and outputs from these tool invocations to the build variables 
+O_SRCS += \
+../ocl/ADDAmain.o \
+../ocl/CalculateE.o \
+../ocl/GenerateB.o \
+../ocl/Romberg.o \
+../ocl/calculator.o \
+../ocl/chebyshev.o \
+../ocl/comm.o \
+../ocl/crosssec.o \
+../ocl/d07hre.o \
+../ocl/d09hre.o \
+../ocl/d113re.o \
+../ocl/d132re.o \
+../ocl/dadhre.o \
+../ocl/dchhre.o \
+../ocl/dcuhre.o \
+../ocl/dfshre.o \
+../ocl/dinhre.o \
+../ocl/drlhre.o \
+../ocl/dtrhre.o \
+../ocl/fft.o \
+../ocl/interaction.o \
+../ocl/io.o \
+../ocl/iterative.o \
+../ocl/linalg.o \
+../ocl/make_particle.o \
+../ocl/memory.o \
+../ocl/mt19937ar.o \
+../ocl/oclcore.o \
+../ocl/oclmatvec.o \
+../ocl/param.o \
+../ocl/propaesplibreintadda.o \
+../ocl/sinint.o \
+../ocl/somnec.o \
+../ocl/timing.o \
+../ocl/vars.o 
+
+
+# Each subdirectory must supply rules for building sources it contributes
+
diff --git a/src/Default/seq/subdir.mk b/src/Default/seq/subdir.mk
new file mode 100644
index 00000000..cbefc6e9
--- /dev/null
+++ b/src/Default/seq/subdir.mk
@@ -0,0 +1,44 @@
+################################################################################
+# Automatically-generated file. Do not edit!
+################################################################################
+
+# Add inputs and outputs from these tool invocations to the build variables 
+O_SRCS += \
+../seq/ADDAmain.o \
+../seq/CalculateE.o \
+../seq/GenerateB.o \
+../seq/Romberg.o \
+../seq/calculator.o \
+../seq/chebyshev.o \
+../seq/comm.o \
+../seq/crosssec.o \
+../seq/d07hre.o \
+../seq/d09hre.o \
+../seq/d113re.o \
+../seq/d132re.o \
+../seq/dadhre.o \
+../seq/dchhre.o \
+../seq/dcuhre.o \
+../seq/dfshre.o \
+../seq/dinhre.o \
+../seq/drlhre.o \
+../seq/dtrhre.o \
+../seq/fft.o \
+../seq/interaction.o \
+../seq/io.o \
+../seq/iterative.o \
+../seq/linalg.o \
+../seq/make_particle.o \
+../seq/matvec.o \
+../seq/memory.o \
+../seq/mt19937ar.o \
+../seq/param.o \
+../seq/propaesplibreintadda.o \
+../seq/sinint.o \
+../seq/somnec.o \
+../seq/timing.o \
+../seq/vars.o 
+
+
+# Each subdirectory must supply rules for building sources it contributes
+
diff --git a/src/Default/sources.mk b/src/Default/sources.mk
new file mode 100644
index 00000000..adbfb64f
--- /dev/null
+++ b/src/Default/sources.mk
@@ -0,0 +1,31 @@
+################################################################################
+# Automatically-generated file. Do not edit!
+################################################################################
+
+C_UPPER_SRCS := 
+CXX_SRCS := 
+C++_SRCS := 
+OBJ_SRCS := 
+CC_SRCS := 
+ASM_SRCS := 
+CPP_SRCS := 
+C_SRCS := 
+S_UPPER_SRCS := 
+O_SRCS := 
+CC_DEPS := 
+C++_DEPS := 
+EXECUTABLES := 
+OBJS := 
+C_UPPER_DEPS := 
+CXX_DEPS := 
+CPP_DEPS := 
+C_DEPS := 
+
+# Every subdirectory with source files must be described here
+SUBDIRS := \
+. \
+cpp \
+mpi \
+ocl \
+seq \
+
diff --git a/src/Default/subdir.mk b/src/Default/subdir.mk
new file mode 100644
index 00000000..442b1d97
--- /dev/null
+++ b/src/Default/subdir.mk
@@ -0,0 +1,99 @@
+################################################################################
+# Automatically-generated file. Do not edit!
+################################################################################
+
+# Add inputs and outputs from these tool invocations to the build variables 
+C_SRCS += \
+../ADDAmain.c \
+../CalculateE.c \
+../GenerateB.c \
+../Romberg.c \
+../calculator.c \
+../chebyshev.c \
+../comm.c \
+../crosssec.c \
+../debug.c \
+../fft.c \
+../interaction.c \
+../io.c \
+../iterative.c \
+../linalg.c \
+../make_particle.c \
+../matvec.c \
+../memory.c \
+../mt19937ar.c \
+../oclcore.c \
+../oclmatvec.c \
+../param.c \
+../prec_time.c \
+../sinint.c \
+../somnec.c \
+../timing.c \
+../vars.c 
+
+OBJS += \
+./ADDAmain.o \
+./CalculateE.o \
+./GenerateB.o \
+./Romberg.o \
+./calculator.o \
+./chebyshev.o \
+./comm.o \
+./crosssec.o \
+./debug.o \
+./fft.o \
+./interaction.o \
+./io.o \
+./iterative.o \
+./linalg.o \
+./make_particle.o \
+./matvec.o \
+./memory.o \
+./mt19937ar.o \
+./oclcore.o \
+./oclmatvec.o \
+./param.o \
+./prec_time.o \
+./sinint.o \
+./somnec.o \
+./timing.o \
+./vars.o 
+
+C_DEPS += \
+./ADDAmain.d \
+./CalculateE.d \
+./GenerateB.d \
+./Romberg.d \
+./calculator.d \
+./chebyshev.d \
+./comm.d \
+./crosssec.d \
+./debug.d \
+./fft.d \
+./interaction.d \
+./io.d \
+./iterative.d \
+./linalg.d \
+./make_particle.d \
+./matvec.d \
+./memory.d \
+./mt19937ar.d \
+./oclcore.d \
+./oclmatvec.d \
+./param.d \
+./prec_time.d \
+./sinint.d \
+./somnec.d \
+./timing.d \
+./vars.d 
+
+
+# Each subdirectory must supply rules for building sources it contributes
+%.o: ../%.c
+	@echo 'Building file: $<'
+	@echo 'Invoking: GCC C Compiler'
+	gcc -O2 -g -Wall -c -fmessage-length=0 -MMD -MP -MF"$(@:%.o=%.d)" -MT"$(@)" -o "$@" "$<"
+	@echo 'Finished building: $<'
+	@echo ' '
+
+
diff --git a/src/GenerateB.c b/src/GenerateB.c
index 8ab98dea..f0389d71 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -35,7 +35,6 @@
 #include "vars.h"
 #include <stdio.h>
 #include <string.h>
-#include "bess.h"
 
 // SEMI-GLOBAL VARIABLES
 
@@ -46,6 +45,10 @@ extern const char *beam_fnameY;
 extern const char *beam_fnameX;
 extern const opt_index opt_beam;
 
+extern void bjndd_(int *n, double *x, double *bj, double *dj, double *fj);
+
+
+
 // used in CalculateE.c
 double C0dipole,C0dipole_refl; // inherent cross sections of exciting dipole (in free space and addition due to surface)
 
@@ -213,14 +216,14 @@ void InitBeam(void)
 						strcat(beam_descr,"linear magnetic field)\n");
 						break;
 					case B_BESSELTEC:
-						strcat(beam_descr,"forming TE Bessel beam)\n");
+						strcat(beam_descr,"forming the TE Bessel beam)\n");
 						break;
 					case B_BESSELTMC:
-						strcat(beam_descr,"forming TM Bessel beam)\n");
+						strcat(beam_descr,"forming the TM Bessel beam)\n");
 						break;
 					default: break;
 				}
-				sprintf(beam_descr+strlen(beam_descr),"\tOrder=""%d""\n\t""half-cone angle: "GFORMDEF"\n"
+				sprintf(beam_descr+strlen(beam_descr),"\tOrder=""%d""\n\t""Half-cone angle: "GFORMDEF"\n"
 				                                      "\tCenter position: "GFORMDEF3V,n0,alpha0,COMP3V(beam_center_0));
 			}
 			return;
@@ -270,12 +273,13 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 	doublecomplex psi0,Q,Q2;
 	doublecomplex v1[3],v2[3],v3[3],gt[6];
 	double ro, ro2,ro4;
-	double x,y,z,x2_s,xy_s,phi;
+	double x,y,z,x2_s,xy_s,phi,arg,td1[n0+2],td2[n0+2],jn1[n0+2];
 	doublecomplex t1,t2,t3,t4,t5,t6,t7,t8,ctemp;
 	const double *ex; // coordinate axis of the beam reference frame
 	double ey[3];
 	double r1[3];
-	double jn2[2];
+	double jn2[2]; // for Bessel functions on n and n+1 orders
+	int n1;
 	const char *fname;
 	/* TO ADD NEW BEAM
 	 * Add here all intermediate variables, which are used only inside this function. You may as well use 't1'-'t8'
@@ -477,63 +481,289 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				x=DotProd(r1,ex);
 				y=DotProd(r1,ey);
 				z=DotProd(r1,prop);
-				ro=sqrt(x*x+y*y);	// radial distance in a cilindrical coordinate system
-				phi=atan(y/x);		// angular coordinate in a cilindrical coordinate system
+				ro2=x*x+y*y;
+				ro=sqrt(ro2);	// radial distance in a cylindrical coordinate system
+				phi=atan2(y,x);	// angular coordinate in a cylindrical coordinate system
 				t1=WaveNum*sin(alpha0);
 				t2=WaveNum*cos(alpha0);
-				// common factor
-				ctemp=cpow(-I,n0)*cexp(I*n0*phi)*cexp(-I*t2*z);
-				bessjn2(n0,ro*t1,jn2);
-				// field components (see J.J. Wang et.al./JQSRT 184 2016 218-232 [7])
-				switch (beamtype) {
-					case B_BESSELCS:
-						t3=1/2/ro/ro*(jn2[1]*t1*ro*(cos(2*phi)+I*n0*sin(2*phi)) + 
-							jn2[0]*(cexp(-2*I*phi)*(n0-1)*n0+cpow(WaveNum*ro,2)*(cos(alpha0)+
-								pow(cos(alpha0)*cos(phi),2)+pow(sin(phi),2))));
-						t4=1/8/ro/ro*(jn2[1]*4*t1*ro*(-I*n0*cos(2*phi)+sin(2*phi)) +
-							jn2[0]*(4*I*(n0-1)*n0*cos(2*phi)+(4*(n0-1)*n0-
-								cpow(WaveNum*ro,2)*(cos(2*alpha0)-1))*sin(2*phi)));
-						t5=I/2/ro*(WaveNum+t2)*cexp(-I*phi)*(jn2[1]*cexp(I*phi)*ro*t1*cos(phi) -
-							jn2[0]*n0);
-						break;
-					case B_BESSELLE:
-						t3=jn2[0]*t2*WaveNum;
-						t4=0;
-						t5=WaveNum*I*(jn2[1]*t1*cos(phi) -
-							jn2[0]*cexp(-I*phi)/ro*n0);
-						break;
-					case B_BESSELLM:
-						t3=1/ro/ro*(jn2[1]*t1*ro*(I*n0*cos(2*phi)-sin(2*phi)) +
-							jn2[0]*4*(-4*I*(n0-1)*n0*cos(2*phi)+(-4*(n0-1)*n0+
-								cpow(WaveNum*ro,2)*(1-cos(2*alpha0)))*sin(2*phi)));
-						t4=1/4/ro/ro*(jn2[1]*4*t1*ro*(cos(2*phi)+I*n0*sin(2*phi)) -
-							jn2[0]*((-4*(n0-1)*n0 + cpow(WaveNum*ro,2))*cos(2*phi)+
-								cpow(WaveNum*ro,2)*(3+2*cos(2*alpha0)*pow(sin(phi),2))+4*I*(n0-1)*n0*sin(2*phi)));
-						t5=-1/ro*t2*(jn2[1]*I*ro*t1*sin(phi) +
-							jn2[0]*n0*cexp(-I*phi));
-						break;
-					case B_BESSELTEC:
-						t3=1/2/ro/ro*(jn2[1]*ro*WaveNum*(-I*n0*cos(2*phi)+sin(2*phi)) +
-							jn2[0]*(2*I*(n0-1)*n0*cexp(-2*I*phi)/sin(alpha0)+
-								cpow(WaveNum*ro,2)*(2*I*cos(alpha0)/tan(alpha0)-sin(alpha0)*sin(2*phi))));
-						t4=1/ro/ro*(-jn2[1]*ro*WaveNum*(cos(2*phi)+I*n0*sin(2*phi)) +
-							jn2[0]*(-(n0-1)*n0*cexp(-2*I*phi)/sin(alpha0)+
-								cpow(WaveNum*ro,2)/sin(alpha0)*(1-pow(sin(alpha0)*sin(phi),2))));
-						t5=-1/ro*cexp(-I*phi)*t2/sin(alpha0)*(jn2[1]*ro*t1 -
-							jn2[0]*2*n0);
-						break;
-					case B_BESSELTMC:
-						t3=1/ro/ro*(jn2[1]*ro*t2*(n0*cos(2*phi)+I*sin(2*phi)) +
-							jn2[0]*(-cexp(-2*I*phi)*(n0-1)*n0/tan(alpha0)-
-								cpow(WaveNum*ro,2)*(1/tan(alpha0)+I/4*sin(2*alpha0)*sin(2*phi))));
-						t4=-I/ro/ro/tan(alpha0)*(jn2[1]*ro*t1*(cos(2*phi)+I*n0*sin(2*phi)) -
-							jn2[0]/4*((cpow(WaveNum*ro,2)-4*(n0-1)*n0)*pow(cos(phi),2)+
-								cpow(WaveNum*ro,2)*(3+2*cos(2*alpha0)*pow(sin(phi),2))+4*I*(n0-1)*n0*sin(2*phi)));
-						t5=I/2*WaveNum*cexp(-I*phi)*(-jn2[1]*2*WaveNum*cexp(I*phi)*(cos(phi)-
-								I*pow(cos(alpha0),2)*sin(phi)) +
-							jn2[0]*n0*(3+cos(2*alpha0))/ro/sin(alpha0));
-						break;
-					default: break;
+				// common factor 
+				ctemp=cpow(-I,n0)*cexp(I*n0*phi)*cexp(I*t2*z)/WaveNum/WaveNum;
+				// t3,t4,t5 - x,y,z field components are described in the doc file "Bessel beam fields" in the "doc" folder 
+				if (n0==0){
+					if (ro==0){
+						switch (beamtype) {
+							case B_BESSELCS:
+								t3=0.5*WaveNum*WaveNum*(cos(alpha0)-0.5*sin(alpha0)*sin(alpha0)+1.0);
+								t4=0.0;
+								t5=0.0;
+								break;
+							case B_BESSELLE:
+								t3=t2*WaveNum;
+								t4=0.0;
+								t5=0.0;
+								break;
+							case B_BESSELLM:
+								t3=0.0;
+								t4=-0.25*WaveNum*WaveNum*(3.0+cos(2*alpha0));
+								t5=0.0;
+								break;
+							case B_BESSELTEC:
+								t3=I*t2*t2/sin(alpha0);
+								t4=0.25*WaveNum*WaveNum*(3.0+cos(2*alpha0))/sin(alpha0);
+								t5=0.0;
+								break;
+							case B_BESSELTMC:
+								t3=WaveNum*WaveNum/tan(alpha0);
+								t4=0.25*I*WaveNum*WaveNum*(3.0+cos(2*alpha0))/tan(alpha0);
+								t5=0.0;
+								break;
+							default: break;
+						}
+
+					}
+					else{
+						arg=ro*WaveNum*sin(alpha0);
+						if (arg<ROUND_ERR){
+							jn2[0]=1.0;
+							jn2[1]=0.0;
+						}
+						else {
+							n1=n0+1;
+							bjndd_(&n1, &arg, jn1, td1, td2);
+							jn2[0]=jn1[n0];
+							jn2[1]=jn1[n0+1];
+						}
+						switch (beamtype) {
+							case B_BESSELCS:
+								t3= 0.5*(
+										jn2[1]*t1/ro*cos(2*phi) +
+										jn2[0]*pow(WaveNum,2)*(cos(alpha0)-
+											pow(sin(alpha0)*cos(phi),2)+1.0));
+								t4= 0.125*(
+										jn2[1]*4*t1/ro*sin(2*phi) +
+										jn2[0]*(pow(WaveNum,2)*(cos(2*alpha0)-1)*sin(2*phi)));
+								t5= 0.5*I*(WaveNum+t2)*cexp(-I*phi)*(
+										jn2[1]*cexp(I*phi)*t1*cos(phi));
+								break;
+							case B_BESSELLE:
+								t3= jn2[0]*t2*WaveNum;
+								t4= 0;
+								t5= WaveNum*I*jn2[1]*t1*cos(phi);
+								break;
+							case B_BESSELLM:
+								t3= jn2[1]*t1/ro*(-sin(2*phi)) +
+									jn2[0]*0.25/ro2*((cpow(WaveNum*ro,2)*(1-cos(2*alpha0)))*sin(2*phi));
+								t4= 0.25*(
+										jn2[1]*4*t1/ro*cos(2*phi) -
+										jn2[0]*(cpow(WaveNum,2)*cos(2*phi)+
+												cpow(WaveNum,2)*(3+2*cos(2*alpha0)*pow(sin(phi),2))));
+								t5= -t2*jn2[1]*I*t1*sin(phi);
+								break;
+							case B_BESSELTEC:
+								t3= 0.5/ro2*cexp(-2*I*phi)*(
+										jn2[1]*2*WaveNum*ro*cexp(2*I*phi)*sin(2*phi) +
+										jn2[0]*(cexp(2*I*phi)*cpow(WaveNum*ro,2)*(2.*I*cos(alpha0)/tan(alpha0) -
+												sin(alpha0)*sin(2*phi))));
+								t4= -1./ro2/4.*(
+										jn2[1]*4*WaveNum*ro*cos(2*phi) -
+										jn2[0]/sin(alpha0)*(cpow(WaveNum*ro,2)*(3 + 2*cos(2*alpha0)*pow(sin(phi),2))));
+								t5= -1./ro/tan(alpha0)*WaveNum*cexp(-I*phi)*(
+										jn2[1]*ro*t1);
+								break;
+							case B_BESSELTMC:
+								t3= 1./ro2*(
+										jn2[1]*t2*ro*I*sin(2*phi) +
+										jn2[0]*(-cpow(WaveNum*ro,2)*(1./tan(alpha0)+I/4.*sin(2*alpha0)*sin(2*phi))));
+								t4= -I/tan(alpha0)/ro2*(
+										jn2[1]*t1*ro*cos(2*phi) -
+										jn2[0]/4.*((cpow(WaveNum*ro,2))*cos(2*phi) +
+												cpow(WaveNum*ro,2)*(3 + 2*cos(2*alpha0)*pow(sin(phi),2))));
+								t5= 0.5*I*WaveNum*(
+										-jn2[1]*2*WaveNum*(cos(phi) - I*pow(cos(alpha0),2)*sin(phi)));
+								break;
+								default: break;
+						}
+					}
+				}
+				else if (n0==1){
+					if (ro==0){
+						t3=0.0; t4=0.0; t5=0.0;
+					}
+					else{
+						arg=ro*WaveNum*sin(alpha0);
+						if (arg<ROUND_ERR){
+							jn2[0]=0.0;
+							jn2[1]=0.0;
+						}
+						else {
+							n1=n0+1;
+							bjndd_(&n1, &arg, jn1, td1, td2);
+							jn2[0]=jn1[n0];
+							jn2[1]=jn1[n0+1];
+						}
+						switch (beamtype) {
+							case B_BESSELCS:
+								t3= 0.5*(
+										jn2[1]*t1/ro*(cos(2*phi)+I*n0*sin(2*phi)) +
+										jn2[0]*pow(WaveNum,2)*(cos(alpha0)-
+											pow(sin(alpha0)*cos(phi),2)+1.0));
+								t4= 0.125*(
+										jn2[1]*4*t1/ro*(-I*n0*cos(2*phi)+sin(2*phi)) +
+										jn2[0]*(pow(WaveNum,2)*(cos(2*alpha0)-1)*sin(2*phi)));
+								t5= 0.5*I*(WaveNum+t2)*cexp(-I*phi)*(
+										jn2[1]*cexp(I*phi)*t1*cos(phi) -
+										jn2[0]*n0/ro);
+								break;
+							case B_BESSELLE:
+								t3= jn2[0]*t2*WaveNum;
+								t4= 0;
+								t5= WaveNum*I*(
+										jn2[1]*t1*cos(phi) -
+										jn2[0]*cexp(-I*phi)/ro*n0);
+								break;
+							case B_BESSELLM:
+								t3= jn2[1]*t1/ro*(I*n0*cos(2*phi)-sin(2*phi)) +
+									jn2[0]*0.25/ro2*((cpow(WaveNum*ro,2)*(1-cos(2*alpha0)))*sin(2*phi));
+								t4= 0.25*(
+										jn2[1]*4*t1/ro*(cos(2*phi)+I*n0*sin(2*phi)) -
+										jn2[0]*(cpow(WaveNum,2)*cos(2*phi)+
+												cpow(WaveNum,2)*(3+2*cos(2*alpha0)*pow(sin(phi),2))));
+								t5= -t2*(
+										jn2[1]*I*t1*sin(phi) +
+										jn2[0]/ro*n0*cexp(-I*phi));
+								break;
+							case B_BESSELTEC:
+								t3= 0.5/ro2*cexp(-2*I*phi)*(
+										jn2[1]*2*WaveNum*ro*cexp(2*I*phi)*(-I*n0*cos(2*phi) + sin(2*phi)) +
+										jn2[0]*(cexp(2*I*phi)*cpow(WaveNum*ro,2)*(2.*I*cos(alpha0)/tan(alpha0) -
+												sin(alpha0)*sin(2*phi))));
+								t4= -1./ro2/4.*(
+										jn2[1]*4*WaveNum*ro*(cos(2*phi) + I*n0*sin(2*phi)) -
+										jn2[0]/sin(alpha0)*(cpow(WaveNum*ro,2)*(3 + 2*cos(2*alpha0)*pow(sin(phi),2))));
+								t5= -1./ro/tan(alpha0)*WaveNum*cexp(-I*phi)*(
+										jn2[1]*ro*t1 -
+										jn2[0]*2*n0);
+								break;
+							case B_BESSELTMC:
+								t3= 1./ro2*(
+										jn2[1]*t2*ro*(n0*cos(2*phi) + I*sin(2*phi)) +
+										jn2[0]*(-cpow(WaveNum*ro,2)*(1./tan(alpha0)+I/4.*sin(2*alpha0)*sin(2*phi))));
+								t4= -I/tan(alpha0)/ro2*(
+										jn2[1]*t1*ro*(cos(2*phi) + I*n0*sin(2*phi)) -
+										jn2[0]/4.*((cpow(WaveNum*ro,2))*cos(2*phi) +
+												cpow(WaveNum*ro,2)*(3 + 2*cos(2*alpha0)*pow(sin(phi),2))));
+								t5= 0.5*I*WaveNum*(
+										-jn2[1]*2*WaveNum*(cos(phi) - I*pow(cos(alpha0),2)*sin(phi)) +
+										 jn2[0]*n0*cexp(-I*phi)/ro*(3+cos(2*alpha0))/sin(alpha0));
+								break;
+								default: break;
+						}
+					}
+				}
+				else {
+					if (ro==0){
+						if (n0==2){
+							switch (beamtype) {
+								case B_BESSELCS:
+									t3=-0.125*I*t1*t1; t4=0.125*t1*t1; t5=0.0;
+									break;
+								case B_BESSELLE:
+									t3=0.0; t4=0.0; t5=0.0;
+									break;
+								case B_BESSELLM:
+									t3=-0.25*t1*t1; t4=0.25*I*t1*t1; t5=0.0;
+									break;
+								case B_BESSELTEC:
+									t3=0.25*t1*t1/sin(alpha0); t4=0.25*I*t1*t1/sin(alpha0); t5=0.0;
+									break;
+								case B_BESSELTMC:
+									t3=0.25*I*t1*t1/tan(alpha0); t4=-0.25*t1*t1/tan(alpha0); t5=0.0;
+									break;
+								default: break;
+							}
+						}
+						else {
+							t3=0.0; t4=0.0; t5=0.0;
+						}
+					}
+					else{
+						arg=ro*WaveNum*sin(alpha0);
+						if (arg<ROUND_ERR){
+							jn2[0]=0.0;
+							jn2[1]=0.0;
+						}
+						else {
+							n1=n0+1;
+							bjndd_(&n1, &arg, jn1, td1, td2);
+							jn2[0]=jn1[n0];
+							jn2[1]=jn1[n0+1];
+						}
+						switch (beamtype) {
+							case B_BESSELCS:
+								t3= 0.5*(
+										jn2[1]*t1/ro*(cos(2*phi)+I*n0*sin(2*phi)) +
+										jn2[0]*((n0-1)*n0*cexp(-2*I*phi)/ro2+pow(WaveNum,2)*(cos(alpha0)-
+											pow(sin(alpha0)*cos(phi),2)+1.0)));
+								t4= 0.125*(
+										jn2[1]*4*t1/ro*(-I*n0*cos(2*phi)+sin(2*phi)) +
+										jn2[0]*(4*I*(n0-1)*n0/ro2*cos(2*phi)+(4*(n0-1)*n0/ro2 +
+												pow(WaveNum,2)*(cos(2*alpha0)-1))*sin(2*phi)));
+								t5= 0.5*I*(WaveNum+t2)*cexp(-I*phi)*(
+										jn2[1]*cexp(I*phi)*t1*cos(phi) -
+										jn2[0]*n0/ro);
+								break;
+							case B_BESSELLE:
+								t3= jn2[0]*t2*WaveNum;
+								t4= 0;
+								t5= WaveNum*I*(
+										jn2[1]*t1*cos(phi) -
+										jn2[0]*cexp(-I*phi)/ro*n0);
+								break;
+							case B_BESSELLM:
+								t3= jn2[1]*t1/ro*(I*n0*cos(2*phi)-sin(2*phi)) +
+									jn2[0]*0.25/ro2*(-4*I*(n0-1)*n0*cos(2*phi)+(-4*(n0-1)*n0 +
+										cpow(WaveNum*ro,2)*(1-cos(2*alpha0)))*sin(2*phi));
+								t4= 0.25*(
+										jn2[1]*4*t1/ro*(cos(2*phi)+I*n0*sin(2*phi)) -
+										jn2[0]*((-4*(n0-1)*n0/ro2 + cpow(WaveNum,2))*cos(2*phi) +
+												cpow(WaveNum,2)*(3+2*cos(2*alpha0)*pow(sin(phi),2)) +
+												4*I*(n0-1)*n0/ro2*sin(2*phi)));
+								t5= -t2*(
+										jn2[1]*I*t1*sin(phi) +
+										jn2[0]/ro*n0*cexp(-I*phi));
+								break;
+							case B_BESSELTEC:
+								t3= 0.5/ro2*cexp(-2*I*phi)*(
+										jn2[1]*2*WaveNum*ro*cexp(2*I*phi)*(-I*n0*cos(2*phi) + sin(2*phi)) +
+										jn2[0]*(2.*I*(n0-1)*n0/sin(alpha0) +
+												cexp(2*I*phi)*cpow(WaveNum*ro,2)*(2.*I*cos(alpha0)/tan(alpha0) -
+												sin(alpha0)*sin(2*phi))));
+								t4= -1./ro2/4.*(
+										jn2[1]*4*WaveNum*ro*(cos(2*phi) + I*n0*sin(2*phi)) -
+										jn2[0]/sin(alpha0)*((-4*(n0-1)*n0+cpow(WaveNum*ro,2))*cos(2*phi) +
+												cpow(WaveNum*ro,2)*(3 + 2*cos(2*alpha0)*pow(sin(phi),2)) +
+												4*I*(n0-1)*n0*sin(2*phi)));
+								t5= -1./ro/tan(alpha0)*WaveNum*cexp(-I*phi)*(
+										jn2[1]*ro*t1 -
+										jn2[0]*2*n0);
+								break;
+							case B_BESSELTMC:
+								t3= 1./ro2*(
+										jn2[1]*t2*ro*(n0*cos(2*phi) + I*sin(2*phi)) +
+										jn2[0]*(-cexp(-2*I*phi)*(n0-1)*n0*1./tan(alpha0) -
+												cpow(WaveNum*ro,2)*(1./tan(alpha0)+I/4.*sin(2*alpha0)*sin(2*phi))));
+								t4= -I/tan(alpha0)/ro2*(
+										jn2[1]*t1*ro*(cos(2*phi) + I*n0*sin(2*phi)) -
+										jn2[0]/4.*((-4*(n0-1)*n0+cpow(WaveNum*ro,2))*cos(2*phi) +
+												cpow(WaveNum*ro,2)*(3 + 2*cos(2*alpha0)*pow(sin(phi),2)) +
+												4*I*(n0-1)*n0*sin(2*phi)));
+								t5= 0.5*I*WaveNum*(
+										-jn2[1]*2*WaveNum*(cos(phi) - I*pow(cos(alpha0),2)*sin(phi)) +
+										 jn2[0]*n0*cexp(-I*phi)/ro*(3+cos(2*alpha0))/sin(alpha0));
+								break;
+							default: break;
+						}
+					}
 				}
 				cvMultScal_RVec(t3,ex,v1);
 				cvMultScal_RVec(t4,ey,v2);
diff --git a/src/Makefile b/src/Makefile
index d89b640a..f2b926bf 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -187,11 +187,11 @@ FFTW3_LIB_PATH := "$(abspath ./../../fftw)"
 # C files are located in source folder (src/), other files may be added below
 CSOURCE := ADDAmain.c CalculateE.c calculator.c chebyshev.c comm.c crosssec.c GenerateB.c interaction.c io.c \
            iterative.c linalg.c make_particle.c memory.c  mt19937ar.c param.c Romberg.c sinint.c somnec.c \
-           timing.c vars.c bess.c
+           timing.c vars.c 
 # Fortran files are located in src/fort folder, other files may be added below
 FSOURCE := d07hre.f d09hre.f d113re.f d132re.f dadhre.f dchhre.f dcuhre.f dfshre.f dinhre.f drlhre.f dtrhre.f \
            propaesplibreintadda.f
-F90SOURCE := 
+F90SOURCE := special_functions.f90 
 # C++ files are located in src/cpp folder, other files may be added below
 CPPSOURCE :=
 
diff --git a/src/bess.c b/src/bess.c
deleted file mode 100644
index 97cf5f73..00000000
--- a/src/bess.c
+++ /dev/null
@@ -1,354 +0,0 @@
-/* File: bess.c
- * $Date::      17/07/2019                      $
- * Descr: 		Two functions "bessjn2" and "bessjn5" for computing 2 and 5 orders of Bessel functions respectively
- * Reference:	C++ Release 1.0 By J-P Moreau, Paris.(www.jpmoreau.fr)  
- *
- * Copyright (C) 2006-2013 ADDA contributors
- * This file is part of ADDA.
- *
- * ADDA is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as
- * published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
- *
- * ADDA is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- * of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along with ADDA. If not, see
- * <http://www.gnu.org/licenses/>.
- */
-#include <math.h>
-#include <stdio.h>
-#include <stdlib.h>
-
-
-
-/*	This subroutine calculates the First Kind Bessel Function of
-	order 0, for any real number X. The polynomial approximation by
-	series of Chebyshev polynomials is used for 0<X<8 and 0<8/X<1.
-	REFERENCES:
-	M.ABRAMOWITZ,I.A.STEGUN, HANDBOOK OF MATHEMATICAL FUNCTIONS, 1965.
-	C.W.CLENSHAW, NATIONAL PHYSICAL LABORATORY MATHEMATICAL TABLES,
-	VOL.5, 1962.
-*/
-double bessj0 (double X) { 
-	const double
-		P1=1.0, P2=-0.1098628627E-2, P3=0.2734510407E-4,
-		P4=-0.2073370639E-5, P5= 0.2093887211E-6,
-		Q1=-0.1562499995E-1, Q2= 0.1430488765E-3, Q3=-0.6911147651E-5,
-		Q4= 0.7621095161E-6, Q5=-0.9349451520E-7,
-		R1= 57568490574.0, R2=-13362590354.0, R3=651619640.7,
-		R4=-11214424.18, R5= 77392.33017, R6=-184.9052456,
-		S1= 57568490411.0, S2=1029532985.0, S3=9494680.718,
-		S4= 59272.64853, S5=267.8532712, S6=1.0;
-    double
-		AX,FR,FS,Z,FP,FQ,XX,Y, TMP;
-	if (X==0.0) return 1.0;
-	AX = fabs(X);
-	if (AX < 8.0) {
-		Y = X*X;
-		FR = R1+Y*(R2+Y*(R3+Y*(R4+Y*(R5+Y*R6))));
-		FS = S1+Y*(S2+Y*(S3+Y*(S4+Y*(S5+Y*S6))));
-		TMP = FR/FS;
-	}
-	else {
-		Z = 8./AX;
-		Y = Z*Z;
-		XX = AX-0.785398164;
-		FP = P1+Y*(P2+Y*(P3+Y*(P4+Y*P5)));
-		FQ = Q1+Y*(Q2+Y*(Q3+Y*(Q4+Y*Q5)));
-		TMP = sqrt(0.636619772/AX)*(FP*cos(XX)-Z*FQ*sin(XX));
-	}
-return TMP;
-}
-
-double Sign(double X, double Y) {
-	if (Y<0.0) return (-fabs(X));
-	else return (fabs(X));
-}
-
-
-/*	This subroutine calculates the First Kind Bessel Function of
-	order 1, for any real number X. The polynomial approximation by
-	series of Chebyshev polynomials is used for 0<X<8 and 0<8/X<1.	
-	REFERENCES:
-	M.ABRAMOWITZ,I.A.STEGUN, HANDBOOK OF MATHEMATICAL FUNCTIONS, 1965.
-	C.W.CLENSHAW, NATIONAL PHYSICAL LABORATORY MATHEMATICAL TABLES,
-	VOL.5, 1962.
-*/
-double bessj1 (double X) {
-	const double  
-		P1=1.0, P2=0.183105E-2, P3=-0.3516396496E-4, P4=0.2457520174E-5,
-		P5=-0.240337019E-6,  P6=0.636619772,
-		Q1= 0.04687499995, Q2=-0.2002690873E-3, Q3=0.8449199096E-5,
-		Q4=-0.88228987E-6, Q5= 0.105787412E-6,
-		R1= 72362614232.0, R2=-7895059235.0, R3=242396853.1,
-		R4=-2972611.439,   R5=15704.48260,  R6=-30.16036606,
-		S1=144725228442.0, S2=2300535178.0, S3=18583304.74,
-		S4=99447.43394,    S5=376.9991397,  S6=1.0;
-
-	double AX,FR,FS,Y,Z,FP,FQ,XX, TMP;
-
-	AX = fabs(X);
-	if (AX < 8.0) {
-		Y = X*X;
-		FR = R1+Y*(R2+Y*(R3+Y*(R4+Y*(R5+Y*R6))));
-		FS = S1+Y*(S2+Y*(S3+Y*(S4+Y*(S5+Y*S6))));
-		TMP = X*(FR/FS);
-	}
-	else {
-		Z = 8.0/AX;
-		Y = Z*Z;
-		XX = AX-2.35619491;
-		FP = P1+Y*(P2+Y*(P3+Y*(P4+Y*P5)));
-		FQ = Q1+Y*(Q2+Y*(Q3+Y*(Q4+Y*Q5)));
-		TMP = sqrt(P6/AX)*(cos(XX)*FP-Z*sin(XX)*FQ)*Sign(S6,X);
-	}
-	return TMP;
-}
-/*
-void bessjn5 (int N2, double X, double ARRJ[5]) { // Computing 5 orders of Bessel function
-	const int A = 40;
-	const double BIGNO = 1e10,  BIGNI = 1e-10;
-
-	double TOX,BJM,BJ,BJP,SUM,TMP,BJM1,BJ1,BJP1,SUM1,TMP1;
-	int J, JSUM, JSUM1, M, K, N, sgn, sgn1;
-
-	N = (N2 - 2);
-	if (X == 0.0) {
-		switch(N2) {
-			case -2:
-			ARRJ[0] = ARRJ[1] = ARRJ[2] = ARRJ[3] = 0.0;
-			ARRJ[4] = 1.0;
-			break;
-			case -1:
-			ARRJ[0] = ARRJ[1] = ARRJ[2] = ARRJ[4] = 0.0;
-			ARRJ[3] = 1.0;
-			break;
-			case 0:
-			ARRJ[0] = ARRJ[1] = ARRJ[3] = ARRJ[4] = 0.0;
-			ARRJ[2] = 1.0;
-			break;
-			case 1:
-			ARRJ[0] = ARRJ[2] = ARRJ[3] = ARRJ[4] = 0.0;
-			ARRJ[1] = 1.0;
-			break;
-			case 2:
-			ARRJ[1] = ARRJ[2] = ARRJ[3] = ARRJ[4] = 0.0;
-			ARRJ[0] = 1.0;
-			break;
-			default:
-			ARRJ[0] = ARRJ[1] = ARRJ[2] = ARRJ[3] = ARRJ[4] =0.0;
-			break;
-		}
-	}
-	else {
-		if ((N == -5)||(N == -4)||(N == -3)||(N == -2)||(N == -1)||(N == 0)||(N == 1)) {
-			switch(N) {
-				case -5:
-				ARRJ[4] = -bessj1(X); 
-				ARRJ[3] = -(2.0/X)*ARRJ[4]-bessj0(X);
-				ARRJ[2] = -(4.0/X)*ARRJ[3]-ARRJ[4];
-				ARRJ[1] = -(6.0/X)*ARRJ[2]-ARRJ[3];
-				ARRJ[0] = -(8.0/X)*ARRJ[1]-ARRJ[2];
-				break;
-				case -4:
-				ARRJ[4] = bessj0(X); 
-				ARRJ[3] = -bessj1(X);
-				ARRJ[2] = -(2.0/X)*ARRJ[3]-ARRJ[4];
-				ARRJ[1] = -(4.0/X)*ARRJ[2]-ARRJ[3];
-				ARRJ[0] = -(6.0/X)*ARRJ[1]-ARRJ[2];
-				break;
-				case -3:
-				ARRJ[4] = bessj1(X); 
-				ARRJ[3] = bessj0(X);
-				ARRJ[2] = -ARRJ[4];;
-				ARRJ[1] = -(2.0/X)*ARRJ[2]-ARRJ[3];
-				ARRJ[0] = -(4.0/X)*ARRJ[1]-ARRJ[2];
-				break;
-				case -2:
-				ARRJ[3] = bessj1(X); 
-				ARRJ[2] = bessj0(X);
-				ARRJ[1] = -ARRJ[4];;
-				ARRJ[1] = -(2.0/X)*ARRJ[2]-ARRJ[3];
-				ARRJ[0] = -(4.0/X)*ARRJ[1]-ARRJ[2];
-				break;
-				case -1:
-				ARRJ[0] = -bessj1(X);
-				ARRJ[1] = bessj0(X);
-				ARRJ[2] = -ARRJ[0];
-				ARRJ[3] = (2.0/X)*ARRJ[2]-ARRJ[1];
-				ARRJ[4] = (4.0/X)*ARRJ[3]-ARRJ[2];
-				break;
-				case 0:
-				ARRJ[0] = bessj0(X);
-				ARRJ[1] = bessj1(X);
-				ARRJ[2] = (2.0/X)*ARRJ[1]-ARRJ[0];
-				ARRJ[3] = (4.0/X)*ARRJ[2]-ARRJ[1];
-				ARRJ[4] = (6.0/X)*ARRJ[3]-ARRJ[2];
-				break;
-				case 1:
-				ARRJ[0] = bessj1(X);
-				ARRJ[1] = (2.0/X)*ARRJ[0]-bessj0(X);
-				ARRJ[2] = (4.0/X)*ARRJ[1]-ARRJ[0];
-				ARRJ[3] = (6.0/X)*ARRJ[2]-ARRJ[1];
-				ARRJ[4] = (8.0/X)*ARRJ[3]-ARRJ[2];
-				break;
-			}
-		}
-		else {
-			TOX = 2.0/X;
-			sgn = 1;
-			sgn1 = 1;
-			N = abs(N2-2);
-			if ((N2-2 <0)&((N2-2)%2 != 0)) sgn = -1;
-			if ((N2-1 <0)&((N2-1)%2 != 0)) sgn1 = -1;
-			if (X > 1.0*N) {
-				BJM = bessj0(X);
-				BJ  = bessj1(X);
-				
-				for (J=1; J<N; J++) {  // Upward recurrence
-					BJP = J*TOX*BJ-BJM;
-					BJM = BJ;
-					BJ  = BJP;
-				}
-				
-				BJP = N*TOX*BJ-BJM;
-				ARRJ[0] = sgn*BJ; 
-				ARRJ[1] = sgn1*BJP;
-				ARRJ[2] = (N+2)*(2.0/X)*ARRJ[1]-ARRJ[0];
-				ARRJ[3] = (N+3)*(2.0/X)*ARRJ[2]-ARRJ[1];
-				ARRJ[4] = (N+4)*(2.0/X)*ARRJ[3]-ARRJ[2];
-			}
-			else {
-				M = (int) (2*((N+floor(sqrt(1.0*(A*N))))/2));
-				K = (int) (2*((N+1+floor(sqrt(1.0*(A*(N+1)))))/2));
-				TMP = 0.0;
-				TMP1 = 0.0;
-				JSUM = 0;
-				JSUM1 = 0;
-				SUM = 0.0;
-				SUM1 = 0.0;
-				BJP = 0.0;
-				BJP1 = 0.0;
-				BJ  = 1.0;
-				BJ1  = 1.0;
-				
-				for (J=K; J>0; J--) {  // Downward recurrence ( Miller's algorithm )
-					BJM1 = J*TOX*BJ1-BJP1;
-					BJP1 = BJ1;
-					BJ1  = BJM1;
-					if (fabs(BJ1) > BIGNO) {
-						BJ1  = BJ1*BIGNI;
-						BJP1 = BJP1*BIGNI;
-						TMP1 = TMP1*BIGNI;
-						SUM1 = SUM1*BIGNI;
-					}
-					if (JSUM1 != 0)  SUM1 += BJ1;
-					JSUM1 = 1-JSUM1;
-					if (J == N+1)  TMP1 = BJP1;
-					if (J <= M) {
-						BJM = J*TOX*BJ-BJP;
-						BJP = BJ;
-						BJ  = BJM;
-						if (fabs(BJ) > BIGNO) {
-							BJ  = BJ*BIGNI;
-							BJP = BJP*BIGNI;
-							TMP = TMP*BIGNI;
-							SUM = SUM*BIGNI;
-						}
-						if (JSUM != 0)  SUM += BJ;
-						JSUM = 1-JSUM;
-						if (J == N)  TMP = BJP;
-					}
-				}
-				
-				ARRJ[0] = sgn*TMP/(2.0*SUM-BJ);
-				ARRJ[1] = sgn1*TMP1/(2.0*SUM1-BJ1);
-				ARRJ[2] = (N+2)*(2.0/X)*ARRJ[1]-ARRJ[0];
-				ARRJ[3] = (N+3)*(2.0/X)*ARRJ[2]-ARRJ[1];
-				ARRJ[4] = (N+4)*(2.0/X)*ARRJ[3]-ARRJ[2];
-
-			}
-		}
-	}
-}
-*/
-
-void bessjn2 (int N, double X, double ARRJ[2]) {  // Computing 2 orders of Bessel function
-	const int A = 40;
-	const double BIGNO = 1e10,  BIGNI = 1e-10;
-
-	double TOX,BJM,BJ,BJP,SUM,TMP,BJM1,BJ1,BJP1,SUM1,TMP1;
-	int J, JSUM, JSUM1, M, K;
-	if (X == 0.0) {
-		if (N == 0) { ARRJ[0] = 1.0; ARRJ[1] = 0.0;}
-		else { ARRJ[0] = 0.0; ARRJ[1] = 0.0;} 
-	}
-	else {
-		if ((N == 0)||(N == 1)) {
-			if (N == 0) { ARRJ[0] = bessj0(X); ARRJ[1] = bessj1(X);}
-			if (N == 1) { ARRJ[0] = bessj1(X); ARRJ[1] = (2.0/X)*ARRJ[0]-bessj0(X);}
-		}
-		else {
-			TOX = 2.0/X;
-			if (X > 1.0*N) {
-				BJM = bessj0(X);
-				BJ  = bessj1(X);
-				
-				for (J=1; J<N; J++) {  // Upward recurrence
-					BJP = J*TOX*BJ-BJM;
-					BJM = BJ;
-					BJ  = BJP;
-				}
-				
-				BJP = N*TOX*BJ-BJM;
-				ARRJ[0] = BJ; ARRJ[1] = BJP;
-			}
-			else {
-				M = (int) (2*((N+floor(sqrt(1.0*(A*N))))/2));
-				K = (int) (2*((N+1+floor(sqrt(1.0*(A*(N+1)))))/2));
-				TMP = 0.0;
-				TMP1 = 0.0;
-				JSUM = 0;
-				JSUM1 = 0;
-				SUM = 0.0;
-				SUM1 = 0.0;
-				BJP = 0.0;
-				BJP1 = 0.0;
-				BJ  = 1.0;
-				BJ1  = 1.0;
-				
-				for (J=K; J>0; J--) {  // Downward recurrence ( Miller's algorithm )
-					BJM1 = J*TOX*BJ1-BJP1;
-					BJP1 = BJ1;
-					BJ1  = BJM1;
-					if (fabs(BJ1) > BIGNO) {
-						BJ1  = BJ1*BIGNI;
-						BJP1 = BJP1*BIGNI;
-						TMP1 = TMP1*BIGNI;
-						SUM1 = SUM1*BIGNI;
-					}
-					if (JSUM1 != 0)  SUM1 += BJ1;
-					JSUM1 = 1-JSUM1;
-					if (J == N+1)  TMP1 = BJP1;
-					if (J <= M) {
-						BJM = J*TOX*BJ-BJP;
-						BJP = BJ;
-						BJ  = BJM;
-						if (fabs(BJ) > BIGNO) {
-							BJ  = BJ*BIGNI;
-							BJP = BJP*BIGNI;
-							TMP = TMP*BIGNI;
-							SUM = SUM*BIGNI;
-						}
-						if (JSUM != 0)  SUM += BJ;
-						JSUM = 1-JSUM;
-						if (J == N)  TMP = BJP;
-					}
-				}
-				
-				ARRJ[0] = TMP/(2.0*SUM-BJ);
-				ARRJ[1] = TMP1/(2.0*SUM1-BJ1);
-			}
-		}
-	}
-}
diff --git a/src/bess.h b/src/bess.h
deleted file mode 100644
index d7008fe0..00000000
--- a/src/bess.h
+++ /dev/null
@@ -1,28 +0,0 @@
-/* File: bess.h
- * $Date::      17/07/2019                      $
- * Descr:		Two functions "bessjn2" and "bessjn5" for computing 2 and 5 orders of Bessel functions respectively
- * Reference:	C++ Release 1.0 By J-P Moreau, Paris.(www.jpmoreau.fr) 
- *
- * Copyright (C) 2006,2008-2013
- * This file is part of ADDA.
- *
- * ADDA is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as
- * published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
- *
- * ADDA is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
- * of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along with ADDA. If not, see
- * <http://www.gnu.org/licenses/>.
- */
-
-#include <math.h>
-#include <stdio.h>
-#include <stdlib.h>
-
-double bessj0 (double X);
-double Sign(double X, double Y);
-double bessj1 (double X);
-
-//void bessjn5 (int N2, double X, double ARRJ[5]);
-void bessjn2 (int N, double X, double ARRJ[2]);
diff --git a/src/const.h b/src/const.h
index a4a2e94f..85f876e7 100644
--- a/src/const.h
+++ b/src/const.h
@@ -278,7 +278,7 @@ enum incpol {
 
 enum beam { // beam types
 	B_BARTON5, // 5th order description of the Gaussian beam
-	B_BESSELCS, // Bessel beam with circularky symmetric energy density
+	B_BESSELCS, // Bessel beam with circularly symmetric energy density
 	B_BESSELLE, // Bessel beam with linearly polarized electric field
 	B_BESSELLM, // Bessel beam with linearly polarized magnetic field
 	B_BESSELTEC, // Bessel beam forming TE Bessel beam 
diff --git a/src/fort/special_functions.f90 b/src/fort/special_functions.f90
new file mode 100644
index 00000000..6428ffaa
--- /dev/null
+++ b/src/fort/special_functions.f90
@@ -0,0 +1,25413 @@
+subroutine airya ( x, ai, bi, ad, bd )
+
+!*****************************************************************************80
+!
+!! AIRYA computes Airy functions and their derivatives.
+!
+!  Licensing:
+!
+!    The original FORTRAN77 version of this routine is copyrighted by 
+!    Shanjie Zhang and Jianming Jin.  However, they give permission to 
+!    incorporate this routine into a user program that the copyright 
+!    is acknowledged.
+!
+!  Modified:
+!
+!    30 June 2012
+!
+!  Author:
+!
+!    Original FORTRAN77 version by Shanjie Zhang, Jianming Jin.
+!    FORTRAN90 version by John Burkardt.
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!       
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument of the Airy function.
+!
+!    Output, real ( kind = 8 ) AI, BI, AD, BD, the values of Ai(x), Bi(x),
+!    Ai'(x), Bi'(x).
+!
+  implicit none
+
+  real ( kind = 8 ) ad
+  real ( kind = 8 ) ai
+  real ( kind = 8 ) bd
+  real ( kind = 8 ) bi
+  real ( kind = 8 ) c1
+  real ( kind = 8 ) c2
+  real ( kind = 8 ) pir
+  real ( kind = 8 ) sr3
+  real ( kind = 8 ) vi1
+  real ( kind = 8 ) vi2
+  real ( kind = 8 ) vj1
+  real ( kind = 8 ) vj2
+  real ( kind = 8 ) vk1
+  real ( kind = 8 ) vk2
+  real ( kind = 8 ) vy1
+  real ( kind = 8 ) vy2
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xa
+  real ( kind = 8 ) xq
+  real ( kind = 8 ) z
+
+  xa = abs ( x )
+  pir = 0.318309886183891D+00
+  c1 = 0.355028053887817D+00
+  c2 = 0.258819403792807D+00
+  sr3 = 1.732050807568877D+00
+  z = xa ** 1.5D+00 / 1.5D+00
+  xq = sqrt ( xa )
+
+  call ajyik ( z, vj1, vj2, vy1, vy2, vi1, vi2, vk1, vk2 )
+
+  if ( x == 0.0D+00 ) then
+    ai = c1
+    bi = sr3 * c1
+    ad = - c2
+    bd = sr3 * c2
+  else if ( 0.0D+00 < x ) then
+    ai = pir * xq / sr3 * vk1
+    bi = xq * ( pir * vk1 + 2.0D+00 / sr3 * vi1 )
+    ad = - xa / sr3 * pir * vk2
+    bd = xa * ( pir * vk2 + 2.0D+00 / sr3 * vi2 )
+  else
+    ai = 0.5D+00 * xq * ( vj1 - vy1 / sr3 )
+    bi = - 0.5D+00 * xq * ( vj1 / sr3 + vy1 )
+    ad = 0.5D+00 * xa * ( vj2 + vy2 / sr3 )
+    bd = 0.5D+00 * xa * ( vj2 / sr3 - vy2 )
+  end if
+
+  return
+end
+subroutine airyb ( x, ai, bi, ad, bd )
+
+!*****************************************************************************80
+!
+!! AIRYB computes Airy functions and their derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    02 June 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, argument of Airy function.
+!
+!    Output, real ( kind = 8 ) AI, Ai(x).
+!
+!    Output, real ( kind = 8 ) BI, Bi(x).
+!
+!    Output, real ( kind = 8 ) AD, Ai'(x).
+!
+!    Output, real ( kind = 8 ) BD, Bi'(x).
+!
+  implicit none
+
+  real ( kind = 8 ) ad
+  real ( kind = 8 ) ai
+  real ( kind = 8 ) bd
+  real ( kind = 8 ) bi
+  real ( kind = 8 ) c1
+  real ( kind = 8 ) c2
+  real ( kind = 8 ) ck(41)
+  real ( kind = 8 ) df
+  real ( kind = 8 ) dg
+  real ( kind = 8 ) dk(41)
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) fx
+  real ( kind = 8 ) gx
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) km
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r
+  real ( kind = 8 ) rp
+  real ( kind = 8 ) sad
+  real ( kind = 8 ) sai
+  real ( kind = 8 ) sbd
+  real ( kind = 8 ) sbi
+  real ( kind = 8 ) sda
+  real ( kind = 8 ) sdb
+  real ( kind = 8 ) sr3
+  real ( kind = 8 ) ssa
+  real ( kind = 8 ) ssb
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xa
+  real ( kind = 8 ) xar
+  real ( kind = 8 ) xcs
+  real ( kind = 8 ) xe
+  real ( kind = 8 ) xf
+  real ( kind = 8 ) xm
+  real ( kind = 8 ) xp1
+  real ( kind = 8 ) xq
+  real ( kind = 8 ) xr1
+  real ( kind = 8 ) xr2
+  real ( kind = 8 ) xss
+
+  eps = 1.0D-15
+  pi = 3.141592653589793D+00
+  c1 = 0.355028053887817D+00
+  c2 = 0.258819403792807D+00
+  sr3 = 1.732050807568877D+00
+  xa = abs ( x )
+  xq = sqrt ( xa )
+
+  if ( x <= 0.0D+00 ) then
+    xm = 8.0D+00
+  else
+    xm = 5.0D+00
+  end if
+
+  if ( x == 0.0D+00 ) then
+    ai = c1
+    bi = sr3 * c1
+    ad = -c2
+    bd = sr3 * c2
+    return
+  end if
+
+  if ( xa <= xm ) then
+
+    fx = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 40
+      r = r * x / ( 3.0D+00 * k ) * x / ( 3.0D+00 * k - 1.0D+00 ) * x
+      fx = fx + r
+      if ( abs ( r ) < abs ( fx ) * eps ) then
+        exit
+      end if
+    end do
+
+    gx = x
+    r = x
+    do k = 1, 40
+      r = r * x / ( 3.0D+00 * k ) * x / ( 3.0D+00 * k + 1.0D+00 ) * x
+      gx = gx + r
+      if ( abs ( r ) < abs ( gx ) * eps ) then
+        exit
+      end if
+    end do
+
+    ai = c1 * fx - c2 * gx
+    bi = sr3 * ( c1 * fx + c2 * gx )
+    df = 0.5D+00 * x * x
+    r = df
+    do k = 1, 40
+      r = r * x / ( 3.0D+00 * k ) * x / ( 3.0D+00 * k + 2.0D+00 ) * x
+      df = df + r 
+      if ( abs ( r ) < abs ( df ) * eps ) then
+        exit
+      end if
+    end do
+
+    dg = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 40
+      r = r * x / ( 3.0D+00 * k ) * x / ( 3.0D+00 * k - 2.0D+00 ) * x
+      dg = dg + r
+      if ( abs ( r ) < abs ( dg ) * eps ) then
+        exit
+      end if
+    end do
+
+    ad = c1 * df - c2 * dg
+    bd = sr3 * ( c1 * df + c2 * dg )
+
+  else
+
+    xe = xa * xq / 1.5D+00
+    xr1 = 1.0D+00 / xe
+    xar = 1.0D+00 / xq
+    xf = sqrt ( xar )
+    rp = 0.5641895835477563D+00
+    r = 1.0D+00
+    do k = 1, 40
+      r = r * ( 6.0D+00 * k - 1.0D+00 ) &
+        / 216.0D+00 * ( 6.0D+00 * k - 3.0D+00 ) &
+        / k * ( 6.0D+00 * k - 5.0D+00 ) / ( 2.0D+00 * k - 1.0D+00 )
+      ck(k) = r
+      dk(k) = - ( 6.0D+00 * k + 1.0D+00 ) / ( 6.0D+00 * k - 1.0D+00 ) * ck(k)
+    end do
+
+    km = int ( 24.5D+00 - xa )
+
+    if ( xa < 6.0D+00 ) then
+      km = 14
+    end if
+
+    if ( 15.0D+00 < xa ) then
+      km = 10
+    end if
+
+    if ( 0.0D+00 < x ) then
+      sai = 1.0D+00
+      sad = 1.0D+00
+      r = 1.0D+00
+      do k = 1, km
+        r = - r * xr1
+        sai = sai + ck(k) * r
+        sad = sad + dk(k) * r
+      end do
+      sbi = 1.0D+00
+      sbd = 1.0D+00
+      r = 1.0D+00
+      do k = 1, km
+        r = r * xr1
+        sbi = sbi + ck(k) * r
+        sbd = sbd + dk(k) * r
+      end do
+      xp1 = exp ( - xe )
+      ai = 0.5D+00 * rp * xf * xp1 * sai
+      bi = rp * xf / xp1 * sbi
+      ad = -0.5D+00 * rp / xf * xp1 * sad
+      bd = rp / xf / xp1 * sbd
+    else
+      xcs = cos ( xe + pi / 4.0D+00 )
+      xss = sin ( xe + pi / 4.0D+00 )
+      ssa = 1.0D+00
+      sda = 1.0D+00
+      r = 1.0D+00
+      xr2 = 1.0D+00 / ( xe * xe )
+      do k = 1, km
+        r = - r * xr2
+        ssa = ssa + ck(2*k) * r
+        sda = sda + dk(2*k) * r
+      end do
+      ssb = ck(1) * xr1
+      sdb = dk(1) * xr1
+      r = xr1
+      do k = 1, km
+        r = - r * xr2
+        ssb = ssb + ck(2*k+1) * r
+        sdb = sdb + dk(2*k+1) * r
+      end do
+      ai = rp * xf * ( xss * ssa - xcs * ssb )
+      bi = rp * xf * ( xcs * ssa + xss * ssb )
+      ad = -rp / xf * ( xcs * sda + xss * sdb )
+      bd =  rp / xf * ( xss * sda - xcs * sdb )
+    end if
+
+  end if
+
+  return
+end
+subroutine airyzo ( nt, kf, xa, xb, xc, xd )
+
+!*****************************************************************************80
+!
+!! AIRYZO computes the first NT zeros of Ai(x) and Ai'(x).
+!
+!   Discussion:
+!
+!    Compute the first NT zeros of Airy functions Ai(x) and Ai'(x), 
+!    a and a', and the associated values of Ai(a') and Ai'(a); and 
+!    the first NT zeros of Airy functions Bi(x) and Bi'(x), b and
+!    b', and the associated values of Bi(b') and Bi'(b).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    14 March 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) NT, the number of zeros.
+!
+!    Input, integer ( kind = 4 ) KF, the function code.
+!    1 for Ai(x) and Ai'(x);
+!    2 for Bi(x) and Bi'(x).
+!
+!    Output, real ( kind = 8 ) XA(m), a, the m-th zero of Ai(x) or
+!    b, the m-th zero of Bi(x).
+!
+!    Output, real ( kind = 8 ) XB(m), a', the m-th zero of Ai'(x) or
+!    b', the m-th zero of Bi'(x).
+!
+!    Output, real ( kind = 8 ) XC(m), Ai(a') or Bi(b').
+!
+!    Output, real ( kind = 8 ) XD(m), Ai'(a) or Bi'(b)
+!
+  implicit none
+
+  integer ( kind = 4 ) nt
+
+  real ( kind = 8 ) ad
+  real ( kind = 8 ) ai
+  real ( kind = 8 ) bd
+  real ( kind = 8 ) bi
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) kf
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) rt
+  real ( kind = 8 ) rt0
+  real ( kind = 8 ) u
+  real ( kind = 8 ) u1
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xa(nt)
+  real ( kind = 8 ) xb(nt)
+  real ( kind = 8 ) xc(nt)
+  real ( kind = 8 ) xd(nt)
+
+  pi = 3.141592653589793D+00
+
+  do i = 1, nt
+
+    if (kf == 1) then
+      u = 3.0D+00 * pi * ( 4.0D+00 * i - 1 ) / 8.0D+00
+      u1 = 1.0D+00 / ( u * u )
+      rt0 = - ( u * u ) ** ( 1.0 / 3.0 ) &
+        * (((( -15.5902D+00 * u1 + 0.929844D+00 ) * u1 &
+        - 0.138889D+00 ) * u1 + 0.10416667D+00 ) * u1 + 1.0D+00 )
+    else if ( kf == 2 ) then
+      if ( i == 1 ) then
+        rt0 = -1.17371D+00
+      else
+        u = 3.0D+00 * pi * ( 4.0D+00 * i - 3.0D+00 ) / 8.0D+00
+        u1 = 1.0D+00 / ( u * u )
+        rt0 = - ( u * u ) ** ( 1.0D+00 / 3.0D+00 ) &
+          * (((( -15.5902D+00 * u1 + 0.929844D+00 ) * u1 &
+          - 0.138889D+00 ) * u1 + 0.10416667D+00 ) * u1 + 1.0D+00 )
+      end if
+    end if
+
+    do
+
+      x = rt0
+      call airyb ( x, ai, bi, ad, bd )
+
+      if ( kf == 1 ) then
+        rt = rt0 - ai / ad
+      else
+        rt = rt0 - bi / bd
+      end if
+
+      if ( abs ( ( rt - rt0 ) / rt ) <= 1.0D-09 ) then
+        exit
+      end if
+      rt0 = rt
+
+    end do
+
+    xa(i) = rt
+    if ( kf == 1 ) then
+      xd(i) = ad
+    else
+      xd(i) = bd
+    end if
+
+  end do
+
+  do i = 1, nt
+
+    if ( kf == 1 ) then
+      if ( i == 1 ) then
+        rt0 = -1.01879D+00
+      else
+        u = 3.0D+00 * pi * ( 4.0D+00 * i - 3.0D+00 ) / 8.0D+00
+        u1 = 1.0D+00 / ( u * u )
+        rt0 = - ( u * u ) ** ( 1.0D+00 / 3.0D+00 ) &
+          * (((( 15.0168D+00 * u1 - 0.873954D+00 ) &
+          * u1 + 0.121528D+00 ) * u1 - 0.145833D+00 ) * u1 + 1.0D+00 )
+      end if
+    else if ( kf == 2 ) then
+      if ( i == 1 ) then
+        rt0 = -2.29444D+00
+      else
+        u = 3.0D+00 * pi * ( 4.0D+00 * i - 1.0D+00 ) / 8.0D+00
+        u1 = 1.0D+00 / ( u * u )
+        rt0 = - ( u * u ) ** ( 1.0D+00 / 3.0D+00 ) &
+          * (((( 15.0168D+00 * u1 - 0.873954D+00 ) &
+          * u1 + 0.121528D+00 ) * u1 - 0.145833D+00 ) * u1 + 1.0D+00 )
+      end if
+    end if
+
+    do
+
+      x = rt0
+      call airyb ( x, ai, bi, ad, bd )
+
+      if ( kf == 1 ) then
+        rt = rt0 - ad / ( ai * x )
+      else
+        rt = rt0 - bd / ( bi * x )
+      end if
+
+      if ( abs ( ( rt - rt0 ) / rt ) <= 1.0D-09 ) then
+        exit
+      end if
+
+      rt0 = rt
+
+    end do
+    
+    xb(i) = rt
+    if ( kf == 1 ) then
+      xc(i) = ai
+    else
+      xc(i) = bi
+    end if
+
+  end do
+
+  return
+end
+subroutine ajyik ( x, vj1, vj2, vy1, vy2, vi1, vi2, vk1, vk2 )
+
+!*****************************************************************************80
+!
+!! AJYIK computes Bessel functions Jv(x), Yv(x), Iv(x), Kv(x).
+!
+!  Discussion: 
+!
+!    Compute Bessel functions Jv(x) and Yv(x), and modified Bessel functions 
+!    Iv(x) and Kv(x), and their derivatives with v = 1/3, 2/3.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    31 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.  X should not be zero.
+!
+!    Output, real ( kind = 8 ) VJ1, VJ2, VY1, VY2, VI1, VI2, VK1, VK2,
+!    the values of J1/3(x), J2/3(x), Y1/3(x), Y2/3(x), I1/3(x), I2/3(x),
+!    K1/3(x), K2/3(x).
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) b0
+  real ( kind = 8 ) c0
+  real ( kind = 8 ) ck
+  real ( kind = 8 ) gn
+  real ( kind = 8 ) gn1
+  real ( kind = 8 ) gn2
+  real ( kind = 8 ) gp1
+  real ( kind = 8 ) gp2
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k0
+  integer ( kind = 4 ) l
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) pv1
+  real ( kind = 8 ) pv2
+  real ( kind = 8 ) px
+  real ( kind = 8 ) qx
+  real ( kind = 8 ) r
+  real ( kind = 8 ) rp
+  real ( kind = 8 ) rp2
+  real ( kind = 8 ) rq
+  real ( kind = 8 ) sk
+  real ( kind = 8 ) sum
+  real ( kind = 8 ) uj1
+  real ( kind = 8 ) uj2
+  real ( kind = 8 ) uu0
+  real ( kind = 8 ) vi1
+  real ( kind = 8 ) vi2
+  real ( kind = 8 ) vil
+  real ( kind = 8 ) vj1
+  real ( kind = 8 ) vj2
+  real ( kind = 8 ) vjl
+  real ( kind = 8 ) vk1
+  real ( kind = 8 ) vk2
+  real ( kind = 8 ) vl
+  real ( kind = 8 ) vsl
+  real ( kind = 8 ) vv
+  real ( kind = 8 ) vv0
+  real ( kind = 8 ) vy1
+  real ( kind = 8 ) vy2
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x2
+  real ( kind = 8 ) xk
+
+  if ( x == 0.0D+00 ) then
+    vj1 = 0.0D+00
+    vj2 = 0.0D+00
+    vy1 = -1.0D+300
+    vy2 = 1.0D+300
+    vi1 = 0.0D+00
+    vi2 = 0.0D+00
+    vk1 = -1.0D+300
+    vk2 = -1.0D+300
+    return
+  end if
+
+  pi = 3.141592653589793D+00
+  rp2 = 0.63661977236758D+00
+  gp1 = 0.892979511569249D+00
+  gp2 = 0.902745292950934D+00
+  gn1 = 1.3541179394264D+00
+  gn2 = 2.678938534707747D+00
+  vv0 = 0.444444444444444D+00
+  uu0 = 1.1547005383793D+00
+  x2 = x * x
+
+  if ( x < 35.0D+00 ) then
+    k0 = 12
+  else if ( x < 50.0D+00 ) then
+    k0 = 10
+  else
+    k0 = 8
+  end if
+
+  if ( x <= 12.0D+00 ) then
+
+    do l = 1, 2
+      vl = l / 3.0D+00
+      vjl = 1.0D+00
+      r = 1.0D+00
+      do k = 1, 40
+        r = -0.25D+00 * r * x2 / ( k * ( k + vl ) )
+        vjl = vjl + r
+        if ( abs ( r ) < 1.0D-15 ) then
+          exit
+        end if
+      end do
+
+      a0 = ( 0.5D+00 * x ) ** vl
+      if ( l == 1 ) then
+        vj1 = a0 / gp1 * vjl
+      else
+        vj2 = a0 / gp2 * vjl
+      end if
+
+    end do
+
+  else
+
+    do l = 1, 2
+
+      vv = vv0 * l * l
+      px = 1.0D+00
+      rp = 1.0D+00
+
+      do k = 1, k0
+        rp = - 0.78125D-02 * rp &
+          * ( vv - ( 4.0D+00 * k - 3.0D+00 ) ** 2 ) &
+          * ( vv - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
+          / ( k * ( 2.0D+00 * k - 1.0D+00 ) * x2 )
+        px = px + rp
+      end do
+
+      qx = 1.0D+00
+      rq = 1.0D+00
+      do k = 1, k0
+        rq = - 0.78125D-02 * rq &
+          * ( vv - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
+          * ( vv - ( 4.0D+00 * k + 1.0D+00 ) ** 2 ) &
+          / ( k * ( 2.0D+00 * k + 1.0D+00 ) * x2 )
+        qx = qx + rq
+      end do
+
+      qx = 0.125D+00 * ( vv - 1.0D+00 ) * qx / x
+      xk = x - ( 0.5D+00 * l / 3.0D+00 + 0.25D+00 ) * pi
+      a0 = sqrt ( rp2 / x )
+      ck = cos ( xk )
+      sk = sin ( xk )
+      if ( l == 1) then
+        vj1 = a0 * ( px * ck - qx * sk )
+        vy1 = a0 * ( px * sk + qx * ck )
+      else
+        vj2 = a0 * ( px * ck - qx * sk )
+        vy2 = a0 * ( px * sk + qx * ck )
+      end if
+
+    end do
+
+  end if
+
+  if ( x <= 12.0D+00 ) then
+
+    do l = 1, 2
+
+      vl = l / 3.0D+00
+      vjl = 1.0D+00
+      r = 1.0D+00
+      do k = 1, 40
+        r = -0.25D+00 * r * x2 / ( k * ( k - vl ) )
+        vjl = vjl + r
+        if ( abs ( r ) < 1.0D-15 ) then
+          exit
+        end if
+      end do
+
+      b0 = ( 2.0D+00 / x ) ** vl
+      if ( l == 1 ) then
+        uj1 = b0 * vjl / gn1
+      else
+         uj2 = b0 * vjl / gn2
+      end if
+
+    end do
+
+    pv1 = pi / 3.0D+00
+    pv2 = pi / 1.5D+00
+    vy1 = uu0 * ( vj1 * cos ( pv1 ) - uj1 )
+    vy2 = uu0 * ( vj2 * cos ( pv2 ) - uj2 )
+
+  end if
+
+  if ( x <= 18.0D+00 ) then
+
+    do l = 1, 2
+      vl = l / 3.0D+00
+      vil = 1.0D+00
+      r = 1.0D+00
+      do k = 1, 40
+        r = 0.25D+00 * r * x2 / ( k * ( k + vl ) )
+        vil = vil + r
+        if ( abs ( r ) < 1.0D-15 ) then
+          exit
+        end if
+      end do
+
+      a0 = ( 0.5D+00 * x ) ** vl
+
+      if ( l == 1 ) then
+        vi1 = a0 / gp1 * vil
+      else
+        vi2 = a0 / gp2 * vil
+      end if
+
+    end do
+
+  else
+
+    c0 = exp ( x ) / sqrt ( 2.0D+00 * pi * x )
+
+    do l = 1, 2
+      vv = vv0 * l * l
+      vsl = 1.0D+00
+      r = 1.0D+00
+      do k = 1, k0
+        r = - 0.125D+00 * r &
+          * ( vv - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * x )
+        vsl = vsl + r
+      end do
+      if ( l == 1 ) then
+        vi1 = c0 * vsl
+      else
+        vi2 = c0 * vsl
+      end if
+    end do
+
+  end if
+
+  if ( x <= 9.0D+00 ) then
+
+    do l = 1, 2
+      vl = l / 3.0D+00
+      if ( l == 1 ) then
+        gn = gn1
+      else
+        gn = gn2
+      end if
+      a0 = ( 2.0D+00 / x ) ** vl / gn
+      sum = 1.0D+00
+      r = 1.0D+00
+      do k = 1, 60
+        r = 0.25D+00 * r * x2 / ( k * ( k - vl ) )
+        sum = sum + r
+        if ( abs ( r ) < 1.0D-15 ) then
+          exit
+        end if
+      end do
+
+      if ( l == 1 ) then
+        vk1 = 0.5D+00 * uu0 * pi * ( sum * a0 - vi1 )
+      else
+        vk2 = 0.5D+00 * uu0 * pi * ( sum * a0 - vi2 )
+      end if
+
+    end do
+
+  else
+
+    c0 = exp ( - x ) * sqrt ( 0.5D+00 * pi / x )
+
+    do l = 1, 2
+      vv = vv0 * l * l
+      sum = 1.0D+00
+      r = 1.0D+00
+      do k = 1, k0
+        r = 0.125D+00 * r * ( vv - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * x )
+        sum = sum + r
+      end do
+      if ( l == 1 ) then
+        vk1 = c0 * sum
+      else
+        vk2 = c0 * sum
+      end if
+    end do
+
+  end if
+
+  return
+end
+subroutine aswfa ( m, n, c, x, kd, cv, s1f, s1d )
+
+!*****************************************************************************80
+!
+!! ASWFA: prolate and oblate spheroidal angular functions of the first kind.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    13 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the mode parameter.
+!
+!    Input, integer ( kind = 4 ) N, the mode parameter, with N = M, M+1, ...
+!
+!    Input, real ( kind = 8 ) C, the spheroidal parameter.
+!
+!    Input, real ( kind = 8 ) X, the argument of the angular function.
+!    |X| < 1.0.
+!
+!    Input, integer ( kind = 4 ) KD, the function code.
+!    1, the prolate function.
+!    -1, the oblate function.
+!
+!    Input, real ( kind = 8 ) CV, the characteristic value.
+!
+!    Output, real ( kind = 8 ) S1F, S1D, the angular function of the first
+!    kind and its derivative.
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) c
+  real ( kind = 8 ) ck(200)
+  real ( kind = 8 ) cv
+  real ( kind = 8 ) d0
+  real ( kind = 8 ) d1
+  real ( kind = 8 ) df(200)
+  real ( kind = 8 ) eps
+  integer ( kind = 4 ) ip
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  integer ( kind = 4 ) nm
+  integer ( kind = 4 ) nm2
+  real ( kind = 8 ) r
+  real ( kind = 8 ) s1d
+  real ( kind = 8 ) s1f
+  real ( kind = 8 ) su1
+  real ( kind = 8 ) su2
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x0
+  real ( kind = 8 ) x1
+
+  eps = 1.0D-14
+  x0 = x
+  x = abs ( x )
+
+  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
+    ip = 0
+  else
+    ip = 1
+  end if
+
+  nm = 10 + int ( ( n - m ) / 2 + c )
+  nm2 = nm / 2 - 2 
+  call sdmn ( m, n, c, cv, kd, df )
+  call sckb ( m, n, c, df, ck )
+  x1 = 1.0D+00 - x * x
+
+  if ( m == 0 .and. x1 == 0.0D+00 ) then
+    a0 = 1.0D+00
+  else
+    a0 = x1 ** ( 0.5D+00 * m )
+  end if
+
+  su1 = ck(1)
+  do k = 1, nm2
+    r = ck(k+1) * x1 ** k
+    su1 = su1 + r
+    if ( 10 <= k .and. abs ( r / su1 ) < eps ) then
+      exit
+    end if
+  end do
+
+  s1f = a0 * x ** ip * su1
+
+  if ( x == 1.0D+00 ) then
+
+    if ( m == 0 ) then
+      s1d = ip * ck(1) - 2.0D+00 * ck(2)
+    else if ( m == 1 ) then
+      s1d = -1.0D+100
+    else if ( m == 2 ) then
+      s1d = -2.0D+00 * ck(1)
+    else if ( 3 <= m ) then
+      s1d = 0.0D+00
+    end if
+
+  else
+
+    d0 = ip - m / x1 * x ** ( ip + 1.0D+00 )
+    d1 = -2.0D+00 * a0 * x ** ( ip + 1.0D+00 )
+    su2 = ck(2)
+    do k = 2, nm2
+      r = k * ck(k+1) * x1 ** ( k - 1.0D+00 )
+      su2 = su2 + r
+      if ( 10 <= k .and. abs ( r / su2 ) < eps ) then
+        exit
+      end if
+    end do
+
+    s1d = d0 * a0 * su1 + d1 * su2
+
+  end if
+
+  if ( x0 < 0.0D+00 ) then
+    if ( ip == 0 ) then
+      s1d = -s1d
+    else if ( ip == 1 ) then
+      s1f = -s1f
+    end if
+  end if
+
+  x = x0
+
+  return
+end
+subroutine aswfb ( m, n, c, x, kd, cv, s1f, s1d )
+
+!*****************************************************************************80
+!
+!! ASWFB: prolate and oblate spheroidal angular functions of the first kind.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    20 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the mode parameter, m = 0, 1, 2, ...
+!
+!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M+1, M+2, ...
+!
+!    Input, real ( kind = 8 ) C, the spheroidal parameter.
+!
+!    Input, real ( kind = 8 ) X, the argument, with |X| < 1.0.
+!
+!    Input, integer ( kind = 4 ) KD, the function code.
+!    1, the prolate function.
+!    -1, the oblate function.
+!
+!    Input, real ( kind = 8 ) CV, the characteristic value.
+!
+!    Output, real ( kind = 8 ) S1F, S1D, the angular function of the first
+!    kind and its derivative.
+!
+  implicit none
+
+  real ( kind = 8 ) c
+  real ( kind = 8 ) cv
+  real ( kind = 8 ) df(200)
+  real ( kind = 8 ) eps
+  integer ( kind = 4 ) ip
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) mk
+  integer ( kind = 4 ) n
+  integer ( kind = 4 ) nm
+  integer ( kind = 4 ) nm2
+  real ( kind = 8 ) pd(0:251)
+  real ( kind = 8 ) pm(0:251)
+  real ( kind = 8 ) s1d
+  real ( kind = 8 ) s1f
+  real ( kind = 8 ) su1
+  real ( kind = 8 ) sw
+  real ( kind = 8 ) x
+
+  eps = 1.0D-14
+
+  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
+    ip = 0
+  else
+    ip = 1
+  end if
+
+  nm = 25 + int ( ( n - m ) / 2 + c )
+  nm2 = 2 * nm + m
+  call sdmn ( m, n, c, cv, kd, df )
+  call lpmns ( m, nm2, x, pm, pd )
+  su1 = 0.0D+00
+  do k = 1, nm
+    mk = m + 2 * ( k - 1 ) + ip
+    su1 = su1 + df(k) * pm(mk)
+    if ( abs ( sw - su1 ) < abs ( su1 ) * eps ) then
+      exit
+    end if
+    sw = su1
+  end do
+
+  s1f = ( -1.0D+00 ) ** m * su1
+
+  su1 = 0.0D+00
+  do k = 1, nm
+    mk = m + 2 * ( k - 1 ) + ip
+    su1 = su1 + df(k) * pd(mk)
+    if ( abs ( sw - su1 ) < abs ( su1 ) * eps ) then
+      exit
+    end if
+    sw = su1
+  end do
+
+  s1d = ( -1.0D+00 ) ** m * su1
+
+  return
+end
+subroutine bernoa ( n, bn )
+
+!*****************************************************************************80
+!
+!! BERNOA computes the Bernoulli number Bn.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    11 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the index.
+!
+!    Output, real ( kind = 8 ) BN, the value of the N-th Bernoulli number.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) bn(0:n)
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) r
+  real ( kind = 8 ) s
+
+  bn(0) = 1.0D+00
+  bn(1) = -0.5D+00
+
+  do m = 2, n
+    s = - ( 1.0D+00 / ( m + 1.0D+00 ) - 0.5D+00 )
+    do k = 2, m - 1
+      r = 1.0D+00
+      do j = 2, k
+        r = r * ( j + m - k ) / j
+      end do
+    s = s - r * bn(k)
+   end do
+   bn(m) = s
+  end do
+
+  do m = 3, n, 2
+    bn(m) = 0.0D+00
+  end do
+
+  return
+end
+subroutine bernob ( n, bn )
+
+!*****************************************************************************80
+!
+!! BERNOB computes the Bernoulli number Bn.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    11 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the index.
+!
+!    Output, real ( kind = 8 ) BN, the value of the N-th Bernoulli number.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) bn(0:n)
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) r2
+  real ( kind = 8 ) s
+  real ( kind = 8 ) tpi
+
+  tpi = 6.283185307179586D+00
+  bn(0) = 1.0D+00
+  bn(1) = -0.5D+00
+  bn(2) = 1.0D+00 / 6.0D+00
+  r1 = ( 2.0D+00 / tpi )**2
+
+  do m = 4, n, 2
+
+    r1 = - r1 * ( m - 1 ) * m / ( tpi * tpi )
+    r2 = 1.0D+00
+ 
+    do k = 2, 10000
+      s = ( 1.0D+00 / k ) ** m
+      r2 = r2 + s
+      if ( s < 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    bn(m) = r1 * r2
+
+  end do
+
+  return
+end
+subroutine beta ( p, q, bt )
+
+!*****************************************************************************80
+!
+!! BETA computes the Beta function B(p,q).
+!
+!  Licensing:
+!
+!    The original FORTRAN77 version of this routine is copyrighted by 
+!    Shanjie Zhang and Jianming Jin.  However, they give permission to 
+!    incorporate this routine into a user program that the copyright 
+!    is acknowledged.
+!
+!  Modified:
+!
+!    12 March 2012
+!
+!  Author:
+!
+!    Original FORTRAN77 version by Shanjie Zhang, Jianming Jin.
+!    FORTRAN90 version by John Burkardt.
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) P, Q, the parameters.
+!    0 < P, 0 < Q.
+!
+!    Output, real ( kind = 8 ) BT, the value of B(P,Q).
+!
+  implicit none
+
+  real ( kind = 8 ) bt
+  real ( kind = 8 ) gp
+  real ( kind = 8 ) gpq
+  real ( kind = 8 ) gq
+  real ( kind = 8 ) p
+  real ( kind = 8 ) ppq
+  real ( kind = 8 ) q
+
+  call gamma ( p, gp )
+  call gamma ( q, gq )
+  ppq = p + q
+  call gamma ( ppq, gpq )
+  bt = gp * gq / gpq
+
+  return
+end
+subroutine bjndd ( n, x, bj, dj, fj )
+
+!*****************************************************************************80
+!
+!! BJNDD computes Bessel functions Jn(x) and first and second derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    11 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) BJ(N+1), DJ(N+1), FJ(N+1), the values of 
+!    Jn(x), Jn'(x) and Jn''(x) in the last entries.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) bj(n+1)
+  real ( kind = 8 ) bs
+  real ( kind = 8 ) dj(n+1)
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) fj(n+1)
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) mt
+  integer ( kind = 4 ) nt
+  real ( kind = 8 ) x
+
+  do nt = 1, 900
+    mt = int ( 0.5D+00 * log10 ( 6.28D+00 * nt ) &
+      - nt * log10 ( 1.36D+00 * abs ( x ) / nt ) )
+    if ( 20 < mt ) then
+      exit
+    end if
+  end do
+
+  m = nt
+  bs = 0.0D+00
+  f0 = 0.0D+00
+  f1 = 1.0D-35
+  do k = m, 0, -1
+    f = 2.0D+00 * ( k + 1.0D+00 ) * f1 / x - f0
+    if ( k <= n ) then
+      bj(k+1) = f
+    end if
+    if ( k == 2 * int ( k / 2 ) ) then
+      bs = bs + 2.0D+00 * f
+    end if
+    f0 = f1
+    f1 = f
+  end do
+
+  do k = 0, n
+    bj(k+1) = bj(k+1) / ( bs - f )
+  end do
+
+  dj(1) = -bj(2)
+  fj(1) = -1.0D+00 * bj(1) - dj(1) / x
+  do k = 1, n
+    dj(k+1) = bj(k) - k * bj(k+1) / x
+    fj(k+1) = ( k * k / ( x * x ) - 1.0D+00 ) * bj(k+1) - dj(k+1) / x
+  end do
+
+  return
+end
+subroutine cbk ( m, n, c, cv, qt, ck, bk )
+
+!*****************************************************************************80
+!
+!! CBK computes coefficients for oblate radial functions with small argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    20 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
+!
+!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
+!
+!    Input, real ( kind = 8 ) C, spheroidal parameter.
+!
+!    Input, real ( kind = 8 ) CV, the characteristic value.
+!
+!    Input, real ( kind = 8 ) QT, ?
+!
+!    Input, real ( kind = 8 ) CK(*), ?
+!
+!    Output, real ( kind = 8 ) BK(*), the coefficients.
+!
+  implicit none
+
+  real ( kind = 8 ) bk(200)
+  real ( kind = 8 ) c
+  real ( kind = 8 ) ck(200)
+  real ( kind = 8 ) cv
+  real ( kind = 8 ) eps
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) i1
+  integer ( kind = 4 ) ip
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  integer ( kind = 4 ) n2
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) qt
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) s1
+  real ( kind = 8 ) sw
+  real ( kind = 8 ) t
+  real ( kind = 8 ) u(200)
+  real ( kind = 8 ) v(200)
+  real ( kind = 8 ) w(200)
+
+  eps = 1.0D-14
+  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
+    ip = 0
+  else
+    ip = 1
+  end if
+  nm = 25 + int ( 0.5D+00 * ( n - m ) + c )
+  u(1) = 0.0D+00
+  n2 = nm - 2
+  do j = 2, n2
+    u(j) = c * c
+  end do
+
+  do j = 1, n2
+    v(j) = ( 2.0D+00 * j - 1.0D+00 - ip ) &
+      * ( 2.0D+00 * ( j - m ) - ip ) + m * ( m - 1.0D+00 ) - cv
+  end do
+
+  do j = 1, nm - 1
+    w(j) = ( 2.0D+00 * j - ip ) * ( 2.0D+00 * j + 1.0D+00 - ip )
+  end do
+
+  if ( ip == 0 ) then
+
+    do k = 0, n2 - 1
+
+      s1 = 0.0D+00
+      i1 = k - m + 1
+
+      do i = i1, nm
+        if ( 0 <= i ) then
+          r1 = 1.0D+00
+          do j = 1, k
+            r1 = r1 * ( i + m - j ) / j
+          end do
+          s1 = s1 + ck(i+1) * ( 2.0D+00 * i + m ) * r1
+          if ( abs ( s1 - sw ) < abs ( s1 ) * eps ) then
+            exit
+          end if
+          sw = s1
+        end if
+      end do
+
+      bk(k+1) = qt * s1
+
+    end do
+
+  else if ( ip == 1 ) then
+
+    do k = 0, n2 - 1
+
+      s1 = 0.0D+00
+      i1 = k - m + 1
+
+      do i = i1, nm
+
+        if ( 0 <= i ) then
+
+          r1 = 1.0D+00
+          do j = 1, k
+            r1 = r1 * ( i + m - j ) / j
+          end do
+
+          if ( 0 < i ) then
+            s1 = s1 + ck(i) * ( 2.0D+00 * i + m - 1 ) * r1
+          end if
+          s1 = s1 - ck(i+1) * ( 2.0D+00 * i + m ) * r1
+          if ( abs ( s1 - sw ) < abs ( s1 ) * eps ) then
+            exit
+          end if
+          sw = s1
+
+        end if
+
+      end do
+
+      bk(k+1) = qt * s1
+
+    end do
+
+  end if
+
+  w(1) = w(1) / v(1)
+  bk(1) = bk(1) / v(1)
+  do k = 2, n2
+    t = v(k) - w(k-1) * u(k)
+    w(k) = w(k) / t
+    bk(k) = ( bk(k) - bk(k-1) * u(k) ) / t
+  end do
+
+  do k = n2 - 1, 1, -1
+    bk(k) = bk(k) - w(k) * bk(k+1)
+  end do
+
+  return
+end
+subroutine cchg ( a, b, z, chg )
+
+!*****************************************************************************80
+!
+!! CCHG computes the confluent hypergeometric function.
+!
+!  Discussion:
+!
+!    This function computes the confluent hypergeometric function
+!    M(a,b,z) with real parameters a, b and complex argument z.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    26 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) A, B, parameter values.
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, complex ( kind = 8 ) CHG, the value of M(a,b,z).
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) a1
+  real ( kind = 8 ) b
+  real ( kind = 8 ) ba
+  complex ( kind = 8 ) cfac
+  complex ( kind = 8 ) chg
+  complex ( kind = 8 ) chg1
+  complex ( kind = 8 ) chg2
+  complex ( kind = 8 ) chw
+  complex ( kind = 8 ) ci
+  complex ( kind = 8 ) cr
+  complex ( kind = 8 ) cr1
+  complex ( kind = 8 ) cr2
+  complex ( kind = 8 ) crg
+  complex ( kind = 8 ) cs1
+  complex ( kind = 8 ) cs2
+  complex ( kind = 8 ) cy0
+  complex ( kind = 8 ) cy1
+  real ( kind = 8 ) g1
+  real ( kind = 8 ) g2
+  real ( kind = 8 ) g3
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) la
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  integer ( kind = 4 ) nl
+  integer ( kind = 4 ) ns
+  real ( kind = 8 ) phi
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x0
+  real ( kind = 8 ) y
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) z0
+
+  pi = 3.141592653589793D+00
+  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
+  a0 = a
+  a1 = a
+  z0 = z
+
+  if ( b == 0.0D+00 .or. b == - int ( abs ( b ) ) ) then
+    chg = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+  else if ( a == 0.0D+00 .or. z == 0.0D+00 ) then
+    chg = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+  else if ( a == -1.0D+00 ) then
+    chg = 1.0D+00 - z / b
+  else if ( a == b ) then
+    chg = exp ( z )
+  else if ( a - b == 1.0D+00 ) then
+    chg = ( 1.0D+00 + z / b ) * exp ( z )
+  else if ( a == 1.0D+00 .and. b == 2.0D+00 ) then
+    chg = ( exp ( z ) - 1.0D+00 ) / z
+  else if ( a == int ( a ) .and. a < 0.0D+00 ) then
+    m = int ( - a )
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    chg = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, m
+      cr = cr * ( a + k - 1.0D+00 ) / k / ( b + k - 1.0D+00 ) * z
+      chg = chg + cr
+    end do
+  else
+
+    x0 = real ( z, kind = 8 )
+    if ( x0 < 0.0D+00 ) then
+      a = b - a
+      a0 = a
+      z = - z
+    end if
+
+    if ( a < 2.0D+00 ) then
+      nl = 0
+    else
+      nl = 1
+      la = int ( a )
+      a = a - la - 1.0D+00
+    end if
+
+    do n = 0, nl
+
+      if ( 2.0D+00 <= a0 ) then
+        a = a + 1.0D+00
+      end if
+
+      if ( cdabs ( z ) < 20.0D+00 + abs ( b ) .or. a < 0.0D+00 ) then
+
+        chg = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+        crg = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+        do j = 1, 500
+          crg = crg * ( a + j - 1.0D+00 ) / ( j * ( b + j - 1.0D+00 ) ) * z
+          chg = chg + crg
+          if ( abs ( ( chg - chw ) / chg ) < 1.0D-15 ) then
+            exit
+          end if
+          chw = chg
+        end do
+
+      else
+
+        call gamma ( a, g1 )
+        call gamma ( b, g2 )
+        ba = b - a
+        call gamma ( ba, g3 )
+        cs1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+        cs2 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+        cr1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+        cr2 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+
+        do i = 1, 8
+          cr1 = - cr1 * (     a + i - 1.0D+00 ) * ( a - b + i ) / ( z * i )
+          cr2 =   cr2 * ( b - a + i - 1.0D+00 ) * ( i - a ) / ( z * i )
+          cs1 = cs1 + cr1
+          cs2 = cs2 + cr2
+        end do
+
+        x = real ( z, kind = 8 )
+        y = imag ( z )
+
+        if ( x == 0.0D+00 .and. 0.0D+00 <= y ) then
+          phi = 0.5D+00 * pi
+        else if ( x == 0.0D+00 .and. y <= 0.0D+00 ) then
+          phi = -0.5D+00 * pi
+        else
+          phi = atan ( y / x )
+        end if
+
+        if ( -1.5D+00 * pi < phi .and. phi <= -0.5 * pi ) then
+          ns = -1
+        else if ( -0.5D+00 * pi < phi .and. phi < 1.5D+00 * pi ) then
+          ns = 1
+        end if
+
+        if ( y == 0.0D+00 ) then
+          cfac = cos ( pi * a )
+        else
+          cfac = exp ( ns * ci * pi * a )
+        end if
+
+        chg1 = g2 / g3 * z ** ( - a ) * cfac * cs1
+        chg2 = g2 / g1 * exp ( z ) * z ** ( a - b ) * cs2
+        chg = chg1 + chg2
+
+      end if
+
+      if ( n == 0 ) then
+        cy0 = chg
+      else if ( n == 1 ) then
+        cy1 = chg
+      end if
+
+    end do
+
+    if ( 2.0D+00 <= a0 ) then
+      do i = 1, la - 1
+        chg = ( ( 2.0D+00 * a - b + z ) * cy1 + ( b - a ) * cy0 ) / a
+        cy0 = cy1
+        cy1 = chg
+        a = a + 1.0D+00
+      end do
+    end if
+
+    if ( x0 < 0.0D+00 ) then
+      chg = chg * exp ( - z )
+    end if
+
+  end if
+
+  a = a1
+  z = z0
+
+  return
+end
+subroutine cerf ( z, cer, cder )
+
+!*****************************************************************************80
+!
+!! CERF computes the error function and derivative for a complex argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    25 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+! 
+!  Parameters:
+!
+!    Input, complex ( kind = 8 ), the argument.
+!
+!    Output, complex ( kind = 8 ) CER, CDER, the values of erf(z) and erf'(z).
+!
+  implicit none
+
+  real ( kind = 8 ) c0
+  complex ( kind = 8 ) cder
+  complex ( kind = 8 ) cer
+  real ( kind = 8 ) cs
+  real ( kind = 8 ) ei1
+  real ( kind = 8 ) ei2
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) er
+  real ( kind = 8 ) er0
+  real ( kind = 8 ) er1
+  real ( kind = 8 ) er2 
+  real ( kind = 8 ) eri
+  real ( kind = 8 ) err
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r
+  real ( kind = 8 ) ss
+  real ( kind = 8 ) w
+  real ( kind = 8 ) w1
+  real ( kind = 8 ) w2
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x2
+  real ( kind = 8 ) y
+  complex ( kind = 8 ) z
+
+  eps = 1.0D-12
+  pi = 3.141592653589793D+00
+  x = real ( z, kind = 8 )
+  y = imag ( z )
+  x2 = x * x
+
+  if ( x <= 3.5D+00 ) then
+
+    er = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 100
+      r = r * x2 / ( k + 0.5D+00 )
+      er = er + r
+      if ( abs ( er - w ) <= eps * abs ( er ) ) then
+        exit
+      end if
+      w = er
+    end do
+
+    c0 = 2.0D+00 / sqrt ( pi ) * x * exp ( - x2 )
+    er0 = c0 * er
+
+  else
+
+    er = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 12
+      r = - r * ( k - 0.5D+00 ) / x2
+      er = er + r
+    end do
+    c0 = exp ( - x2 ) / ( x * sqrt ( pi ) )
+    er0 = 1.0D+00 - c0 * er
+
+  end if
+
+  if ( y == 0.0D+00 ) then
+
+    err = er0
+    eri = 0.0D+00
+
+  else
+
+    cs = cos ( 2.0D+00 * x * y )
+    ss = sin ( 2.0D+00 * x * y )
+    er1 = exp ( - x2 ) * ( 1.0D+00 - cs ) / ( 2.0D+00 * pi * x )
+    ei1 = exp ( - x2 ) * ss / ( 2.0D+00 * pi * x )
+    er2 = 0.0D+00
+    do n = 1, 100
+      er2 = er2 + exp ( - 0.25D+00 * n * n ) &
+        / ( n * n + 4.0D+00 * x2 ) * ( 2.0D+00 * x &
+        - 2.0D+00 * x * cosh ( n * y ) * cs &
+        + n * sinh ( n * y ) * ss )
+      if ( abs ( ( er2 - w1 ) / er2 ) < eps ) then
+        exit
+      end if
+      w1 = er2
+    end do
+
+    c0 = 2.0D+00 * exp ( - x2 ) / pi
+    err = er0 + er1 + c0 * er2
+    ei2 = 0.0D+00
+    do n = 1, 100
+      ei2 = ei2 + exp ( - 0.25D+00 * n * n ) &
+        / ( n * n + 4.0D+00 * x2 ) * ( 2.0D+00 * x &
+        * cosh ( n * y ) * ss + n * sinh ( n * y ) * cs )
+      if ( abs ( ( ei2 - w2 ) / ei2 ) < eps ) then
+        exit
+      end if
+      w2 = ei2
+    end do
+
+    eri = ei1 + c0 * ei2
+
+  end if
+
+  cer = cmplx ( err, eri, kind = 8 )
+  cder = 2.0D+00 / sqrt ( pi ) * exp ( - z * z )
+
+  return
+end
+subroutine cerror ( z, cer )
+
+!*****************************************************************************80
+!
+!! CERROR computes the error function for a complex argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    15 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+! 
+!  Parameters:
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, complex ( kind = 8 ) CER, the function value.
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  complex ( kind = 8 ) c0
+  complex ( kind = 8 ) cer
+  complex ( kind = 8 ) cl
+  complex ( kind = 8 ) cr
+  complex ( kind = 8 ) cs
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) pi
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) z1
+
+  a0 = abs ( z )
+  c0 = exp ( - z * z )
+  pi = 3.141592653589793D+00
+  z1 = z
+
+  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
+    z1 = - z
+  end if
+
+  if ( a0 <= 5.8D+00 ) then    
+
+    cs = z1
+    cr = z1
+    do k = 1, 120
+      cr = cr * z1 * z1 / ( k + 0.5D+00 )
+      cs = cs + cr
+      if ( abs ( cr / cs ) < 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    cer = 2.0D+00 * c0 * cs / sqrt ( pi )
+
+  else
+
+    cl = 1.0D+00 / z1              
+    cr = cl
+    do k = 1, 13
+      cr = -cr * ( k - 0.5D+00 ) / ( z1 * z1 )
+      cl = cl + cr
+      if ( abs ( cr / cl ) < 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    cer = 1.0D+00 - c0 * cl / sqrt ( pi )
+
+  end if
+
+  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
+    cer = -cer
+  end if
+
+  return
+end
+subroutine cerzo ( nt, zo )
+
+!*****************************************************************************80
+!
+!! CERZO evaluates the complex zeros of the error function.
+!
+!  Discussion:
+!
+!    The modified Newton method is used.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    15 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) NT, the number of zeros.
+!
+!    Output, complex ( kind = 8 ) ZO(NT), the zeros.
+!
+  implicit none
+
+  integer ( kind = 4 ) nt
+
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) it
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) nr
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) pu
+  real ( kind = 8 ) pv
+  real ( kind = 8 ) px
+  real ( kind = 8 ) py
+  real ( kind = 8 ) w
+  real ( kind = 8 ) w0
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) zd
+  complex ( kind = 8 ) zf
+  complex ( kind = 8 ) zfd
+  complex ( kind = 8 ) zgd
+  complex ( kind = 8 ) zo(nt)
+  complex ( kind = 8 ) zp
+  complex ( kind = 8 ) zq
+  complex ( kind = 8 ) zw
+
+  pi = 3.141592653589793D+00
+
+  do nr = 1, nt
+
+    pu = sqrt ( pi * ( 4.0D+00 * nr - 0.5D+00 ) )
+    pv = pi * sqrt ( 2.0D+00 * nr - 0.25D+00 )
+    px = 0.5D+00 * pu - 0.5D+00 * log ( pv ) / pu
+    py = 0.5D+00 * pu + 0.5D+00 * log ( pv ) / pu
+    z = cmplx ( px, py, kind = 8 )
+    it = 0
+
+    do
+
+      it = it + 1
+      call cerf ( z, zf, zd )
+      zp = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do i = 1, nr - 1
+        zp = zp * ( z - zo(i) )
+      end do
+      zfd = zf / zp
+
+      zq = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      do i = 1, nr - 1
+        zw = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+        do j = 1, nr - 1
+          if ( j /= i ) then
+            zw = zw * ( z - zo(j) )
+          end if
+        end do
+        zq = zq + zw
+      end do
+
+      zgd = ( zd - zq * zfd ) / zp
+      z = z - zfd / zgd
+      w0 = w
+      w = abs ( z )
+
+      if ( 50 < it .or. abs ( ( w - w0 ) / w ) <= 1.0D-11 ) then
+        exit
+      end if
+
+    end do
+
+    zo(nr) = z
+
+  end do
+
+  return
+end
+subroutine cfc ( z, zf, zd )
+
+!*****************************************************************************80
+!
+!! CFC computes the complex Fresnel integral C(z) and C'(z).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    26 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, complex ( kind = 8 ) ZF, ZD, the values of C(z) and C'(z).
+!
+  implicit none
+
+  complex ( kind = 8 ) c
+  complex ( kind = 8 ) cf
+  complex ( kind = 8 ) cf0
+  complex ( kind = 8 ) cf1
+  complex ( kind = 8 ) cg
+  complex ( kind = 8 ) cr
+  real ( kind = 8 ) eps
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) w0
+  real ( kind = 8 ) wa
+  real ( kind = 8 ) wa0
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) z0
+  complex ( kind = 8 ) zd
+  complex ( kind = 8 ) zf
+  complex ( kind = 8 ) zp
+  complex ( kind = 8 ) zp2
+
+  eps = 1.0D-14
+  pi = 3.141592653589793D+00
+  w0 = abs ( z )
+  zp = 0.5D+00 * pi * z * z
+  zp2 = zp * zp
+  z0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+
+  if ( z == z0 ) then
+
+    c = z0
+
+  else if ( w0 <= 2.5D+00 ) then
+
+    cr = z
+    c = cr
+    do k = 1, 80
+      cr = -0.5D+00 * cr * ( 4.0D+00 * k - 3.0D+00 ) &
+        / k / ( 2.0D+00 * k - 1.0D+00 ) &
+        / ( 4.0D+00 * k + 1.0D+00 ) * zp2
+      c = c + cr
+      wa = abs ( c )
+      if ( abs ( ( wa - wa0 ) / wa ) < eps .and. 10 < k ) then
+        exit
+      end if
+      wa0 = wa
+    end do
+
+  else if ( 2.5D+00 < w0 .and. w0 < 4.5D+00 ) then
+
+    m = 85
+    c = z0
+    cf1 = z0
+    cf0 = cmplx ( 1.0D-30, 0.0D+00, kind = 8 )
+    do k = m, 0, -1
+      cf = ( 2.0D+00 * k + 3.0D+00 ) * cf0 / zp - cf1
+      if ( k == int ( k / 2 ) * 2 ) then
+        c = c + cf
+      end if
+      cf1 = cf0
+      cf0 = cf
+    end do
+    c = sqrt ( 2.0D+00 / ( pi * zp ) ) * sin ( zp ) / cf * c
+
+  else
+
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cf = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 20
+      cr = - 0.25D+00 * cr * ( 4.0D+00 * k - 1.0D+00 ) &
+        * ( 4.0D+00 * k - 3.0D+00 ) / zp2
+      cf = cf + cr
+    end do
+    cr = 1.0D+00 / ( pi * z * z )
+    cg = cr
+    do k = 1, 12
+      cr = - 0.25D+00 * cr * ( 4.0D+00 * k + 1.0D+00 ) &
+        * ( 4.0D+00 * k - 1.0D+00 ) / zp2
+      cg = cg + cr
+    end do
+    c = 0.5D+00 + ( cf * sin ( zp ) - cg * cos ( zp ) ) / ( pi * z )
+
+  end if
+
+  zf = c
+  zd = cos ( 0.5D+00 * pi * z * z )
+
+  return
+end
+subroutine cfs ( z, zf, zd )
+
+!*****************************************************************************80
+!
+!! CFS computes the complex Fresnel integral S(z) and S'(z).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    24 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, complex ( kind = 8 ) ZF, ZD, the values of S(z) and S'(z).
+!
+  implicit none
+
+  complex ( kind = 8 ) cf
+  complex ( kind = 8 ) cf0
+  complex ( kind = 8 ) cf1
+  complex ( kind = 8 ) cg
+  complex ( kind = 8 ) cr
+  real ( kind = 8 ) eps
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) pi
+  complex ( kind = 8 ) s
+  real ( kind = 8 ) w0
+  real ( kind = 8 ) wb
+  real ( kind = 8 ) wb0
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) z0
+  complex ( kind = 8 ) zd
+  complex ( kind = 8 ) zf
+  complex ( kind = 8 ) zp
+  complex ( kind = 8 ) zp2
+
+  eps = 1.0D-14
+  pi = 3.141592653589793D+00
+  w0 = abs ( z )
+  zp = 0.5D+00 * pi * z * z
+  zp2 = zp * zp
+  z0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+
+  if ( z == z0 ) then
+
+    s = z0
+
+  else if ( w0 <= 2.5D+00 ) then
+
+    s = z * zp / 3.0D+00
+    cr = s
+    do k = 1, 80
+      cr = -0.5D+00 * cr * ( 4.0D+00 * k - 1.0D+00 ) / k &
+        / ( 2.0D+00 * k + 1.0D+00 ) &
+        / ( 4.0D+00 * k + 3.0D+00 ) * zp2
+      s = s + cr
+      wb = abs ( s )
+      if ( abs ( wb - wb0 ) < eps .and. 10 < k ) then
+        exit
+      end if
+      wb0 = wb
+    end do
+
+  else if ( 2.5D+00 < w0 .and. w0 < 4.5D+00 ) then
+
+    m = 85
+    s = z0
+    cf1 = z0
+    cf0 = cmplx ( 1.0D-30, 0.0D+00, kind = 8  )
+    do k = m, 0, -1
+      cf = ( 2.0D+00 * k + 3.0D+00 ) * cf0 / zp - cf1
+      if ( k /= int ( k / 2 ) * 2 ) then
+        s = s + cf
+      end if
+      cf1 = cf0
+      cf0 = cf
+    end do
+    s = sqrt ( 2.0D+00 / ( pi * zp ) ) * sin ( zp ) / cf * s
+
+  else
+
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8  )
+    cf = cmplx ( 1.0D+00, 0.0D+00, kind = 8  )
+    do k = 1, 20
+      cr = -0.25D+00 * cr * ( 4.0D+00 * k - 1.0D+00 ) &
+        * ( 4.0D+00 * k - 3.0D+00 ) / zp2
+      cf = cf + cr
+    end do
+    cr = 1.0D+00 / ( pi * z * z )
+    cg = cr
+    do k = 1, 12
+      cr = -0.25D+00 * cr * ( 4.0D+00 * k + 1.0D+00 ) &
+        * ( 4.0D+00 * k - 1.0D+00 ) / zp2
+      cg = cg + cr
+    end do
+    s = 0.5D+00 - ( cf * cos ( zp ) + cg * sin ( zp ) ) / ( pi * z )
+
+  end if
+
+  zf = s
+  zd = sin ( 0.5D+00 * pi * z * z )
+
+  return
+end
+subroutine cgama ( x, y, kf, gr, gi )
+
+!*****************************************************************************80
+!
+!! CGAMA computes the Gamma function for complex argument.
+!
+!  Discussion:
+!
+!    This procedcure computes the gamma function â(z) or ln[â(z)]
+!    for a complex argument
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    26 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, Y, the real and imaginary parts of 
+!    the argument Z.
+!
+!    Input, integer ( kind = 4 ) KF, the function code.
+!    0 for ln[â(z)]
+!    1 for â(z)
+!
+!    Output, real ( kind = 8 ) GR, GI, the real and imaginary parts of
+!    the selected function.
+!
+  implicit none
+
+  real ( kind = 8 ), save, dimension ( 10 ) :: a = (/ &
+    8.333333333333333D-02, -2.777777777777778D-03, &
+    7.936507936507937D-04, -5.952380952380952D-04, &
+    8.417508417508418D-04, -1.917526917526918D-03, &
+    6.410256410256410D-03, -2.955065359477124D-02, &
+    1.796443723688307D-01, -1.39243221690590D+00 /)
+  real ( kind = 8 ) g0
+  real ( kind = 8 ) gi
+  real ( kind = 8 ) gi1
+  real ( kind = 8 ) gr
+  real ( kind = 8 ) gr1
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) kf
+  integer ( kind = 4 ) na
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) si
+  real ( kind = 8 ) sr
+  real ( kind = 8 ) t
+  real ( kind = 8 ) th
+  real ( kind = 8 ) th1
+  real ( kind = 8 ) th2
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x0
+  real ( kind = 8 ) x1
+  real ( kind = 8 ) y
+  real ( kind = 8 ) y1
+  real ( kind = 8 ) z1
+  real ( kind = 8 ) z2
+
+  pi = 3.141592653589793D+00
+
+  if ( y == 0.0D+00 .and. x == int ( x ) .and. x <= 0.0D+00 ) then
+    gr = 1.0D+300
+    gi = 0.0D+00
+    return
+  else if ( x < 0.0D+00 ) then
+    x1 = x
+    y1 = y
+    x = -x
+    y = -y
+  end if
+
+  x0 = x
+
+  if ( x <= 7.0D+00 ) then
+    na = int ( 7 - x )
+    x0 = x + na
+  end if
+
+  z1 = sqrt ( x0 * x0 + y * y )
+  th = atan ( y / x0 )
+  gr = ( x0 - 0.5D+00 ) * log ( z1 ) - th * y - x0 &
+    + 0.5D+00 * log ( 2.0D+00 * pi )
+  gi = th * ( x0 - 0.5D+00 ) + y * log ( z1 ) - y
+
+  do k = 1, 10
+    t = z1 ** ( 1 - 2 * k )
+    gr = gr + a(k) * t * cos ( ( 2.0D+00 * k - 1.0D+00 ) * th )
+    gi = gi - a(k) * t * sin ( ( 2.0D+00 * k - 1.0D+00 ) * th )
+  end do
+
+  if ( x <= 7.0D+00 ) then
+    gr1 = 0.0D+00
+    gi1 = 0.0D+00
+    do j = 0, na - 1
+      gr1 = gr1 + 0.5D+00 * log ( ( x + j ) ** 2 + y * y )
+      gi1 = gi1 + atan ( y / ( x + j ) )
+    end do
+    gr = gr - gr1
+    gi = gi - gi1
+  end if
+
+  if ( x1 < 0.0D+00 ) then
+    z1 = sqrt ( x * x + y * y )
+    th1 = atan ( y / x )
+    sr = - sin ( pi * x ) * cosh ( pi * y )
+    si = - cos ( pi * x ) * sinh ( pi * y )
+    z2 = sqrt ( sr * sr + si * si )
+    th2 = atan ( si / sr )
+    if ( sr < 0.0D+00 ) then
+      th2 = pi + th2
+    end if
+    gr = log ( pi / ( z1 * z2 ) ) - gr
+    gi = - th1 - th2 - gi
+    x = x1
+    y = y1
+  end if
+
+  if ( kf == 1 ) then
+    g0 = exp ( gr )
+    gr = g0 * cos ( gi )
+    gi = g0 * sin ( gi )
+  end if
+
+  return
+end
+subroutine ch12n ( n, z, nm, chf1, chd1, chf2, chd2 )
+
+!*****************************************************************************80
+!
+!! CH12N computes Hankel functions of first and second kinds, complex argument.
+!
+!  Discussion:
+!
+!    Both the Hankel functions and their derivatives are computed.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    26 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+! 
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order of the functions.
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, integer ( kind = 4 ) NM, the highest order computed.
+!
+!    Output, complex ( kind = 8 ) CHF1(0:n), CHD1(0:n), CHF2(0:n), CHD2(0:n), 
+!    the values of Hn(1)(z), Hn(1)'(z), Hn(2)(z), Hn(2)'(z).
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  complex ( kind = 8 ) cbi(0:250)
+  complex ( kind = 8 ) cbj(0:250)
+  complex ( kind = 8 ) cbk(0:250)
+  complex ( kind = 8 ) cby(0:250)
+  complex ( kind = 8 ) cdi(0:250)
+  complex ( kind = 8 ) cdj(0:250)
+  complex ( kind = 8 ) cdk(0:250)
+  complex ( kind = 8 ) cdy(0:250)
+  complex ( kind = 8 ) chd1(0:n)
+  complex ( kind = 8 ) chd2(0:n)
+  complex ( kind = 8 ) cf1
+  complex ( kind = 8 ) cfac
+  complex ( kind = 8 ) chf1(0:n)
+  complex ( kind = 8 ) chf2(0:n)
+  complex ( kind = 8 ) ci
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) pi
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) zi
+
+  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
+  pi = 3.141592653589793D+00
+
+  if ( imag ( z ) < 0.0D+00 ) then
+
+    call cjynb ( n, z, nm, cbj, cdj, cby, cdy )
+
+    do k = 0, nm
+      chf1(k) = cbj(k) + ci * cby(k)
+      chd1(k) = cdj(k) + ci * cdy(k)
+    end do
+
+    zi = ci * z
+    call ciknb ( n, zi, nm, cbi, cdi, cbk, cdk )
+    cfac = -2.0D+00 / ( pi * ci )
+
+    do k = 0, nm
+      chf2(k) = cfac * cbk(k)
+      chd2(k) = cfac * ci * cdk(k)
+      cfac = cfac * ci
+    end do
+
+  else if ( 0.0D+00 < imag ( z ) ) then
+
+    zi = - ci * z
+    call ciknb ( n, zi, nm, cbi, cdi, cbk, cdk )
+    cf1 = -ci
+    cfac = 2.0D+00 / ( pi * ci )
+
+    do k = 0, nm
+      chf1(k) = cfac * cbk(k)
+      chd1(k) = -cfac * ci * cdk(k)
+      cfac = cfac * cf1
+    end do
+
+    call cjynb ( n, z, nm, cbj, cdj, cby, cdy )
+
+    do k = 0, nm
+      chf2(k) = cbj(k) - ci * cby(k)
+      chd2(k) = cdj(k) - ci * cdy(k)
+    end do
+
+  else
+
+    call cjynb ( n, z, nm, cbj, cdj, cby, cdy )
+
+    do k = 0, nm
+      chf1(k) = cbj(k) + ci * cby(k)
+      chd1(k) = cdj(k) + ci * cdy(k)
+      chf2(k) = cbj(k) - ci * cby(k)
+      chd2(k) = cdj(k) - ci * cdy(k)
+    end do
+
+  end if
+
+  return
+end
+subroutine chgm ( a, b, x, hg )
+
+!*****************************************************************************80
+!
+!! CHGM computes the confluent hypergeometric function M(a,b,x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    27 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) A, B, parameters.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) HG, the value of M(a,b,x).
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) a1
+  real ( kind = 8 ) b
+  real ( kind = 8 ) hg
+  real ( kind = 8 ) hg1
+  real ( kind = 8 ) hg2
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) la
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  integer ( kind = 4 ) nl
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) r2
+  real ( kind = 8 ) rg
+  real ( kind = 8 ) sum1
+  real ( kind = 8 ) sum2
+  real ( kind = 8 ) ta
+  real ( kind = 8 ) tb
+  real ( kind = 8 ) tba
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x0
+  real ( kind = 8 ) xg
+  real ( kind = 8 ) y0
+  real ( kind = 8 ) y1
+
+  pi = 3.141592653589793D+00
+  a0 = a
+  a1 = a
+  x0 = x
+  hg = 0.0D+00
+
+  if ( b == 0.0D+00 .or. b == - abs ( int ( b ) ) ) then
+    hg = 1.0D+300
+  else if ( a == 0.0D+00 .or. x == 0.0D+00 ) then
+    hg = 1.0D+00
+  else if ( a == -1.0D+00 ) then
+    hg = 1.0D+00 - x / b
+  else if ( a == b ) then
+    hg = exp ( x )
+  else if ( a - b == 1.0D+00 ) then
+    hg = ( 1.0D+00 + x / b ) * exp ( x )
+  else if ( a == 1.0D+00 .and. b == 2.0D+00 ) then
+    hg = ( exp ( x ) - 1.0D+00 ) / x
+  else if ( a == int ( a ) .and. a < 0.0D+00 ) then
+    m = int ( - a )
+    r = 1.0D+00
+    hg = 1.0D+00
+    do k = 1, m
+      r = r * ( a + k - 1.0D+00 ) / k / ( b + k - 1.0D+00 ) * x
+      hg = hg + r
+    end do
+  end if
+
+  if ( hg /= 0.0D+00 ) then
+    return
+  end if
+
+  if ( x < 0.0D+00 ) then
+    a = b - a
+    a0 = a
+    x = abs ( x )
+  end if
+
+  if ( a < 2.0D+00 ) then
+    nl = 0
+  end if
+
+  if ( 2.0D+00 <= a ) then
+    nl = 1
+    la = int ( a )
+    a = a - la - 1.0D+00
+  end if
+
+  do n = 0, nl
+
+    if ( 2.0D+00 <= a0 ) then
+      a = a + 1.0D+00
+    end if
+
+    if ( x <= 30.0D+00 + abs ( b ) .or. a < 0.0D+00 ) then
+
+      hg = 1.0D+00
+      rg = 1.0D+00
+      do j = 1, 500
+        rg = rg * ( a + j - 1.0D+00 ) &
+          / ( j * ( b + j - 1.0D+00 ) ) * x
+        hg = hg + rg
+        if ( abs ( rg / hg ) < 1.0D-15 ) then
+          exit
+        end if
+      end do
+
+    else
+
+      call gamma ( a, ta )
+      call gamma ( b, tb )
+      xg = b - a
+      call gamma ( xg, tba )
+      sum1 = 1.0D+00
+      sum2 = 1.0D+00
+      r1 = 1.0D+00
+      r2 = 1.0D+00
+      do i = 1, 8
+        r1 = - r1 * ( a + i - 1.0D+00 ) * ( a - b + i ) / ( x * i )
+        r2 = - r2 * ( b - a + i - 1.0D+00 ) * ( a - i ) / ( x * i )
+        sum1 = sum1 + r1
+        sum2 = sum2 + r2
+      end do
+      hg1 = tb / tba * x ** ( - a ) * cos ( pi * a ) * sum1
+      hg2 = tb / ta * exp ( x ) * x ** ( a - b ) * sum2
+      hg = hg1 + hg2
+
+    end if
+
+    if ( n == 0 ) then
+      y0 = hg
+    else if ( n == 1 ) then
+      y1 = hg
+    end if
+
+  end do
+
+  if ( 2.0D+00 <= a0 ) then
+    do i = 1, la - 1
+      hg = ( ( 2.0D+00 * a - b + x ) * y1 + ( b - a ) * y0 ) / a
+      y0 = y1
+      y1 = hg
+      a = a + 1.0D+00
+    end do
+  end if
+
+  if ( x0 < 0.0D+00 ) then
+    hg = hg * exp ( x0 )
+  end if
+
+  a = a1
+  x = x0
+
+  return
+end
+subroutine chgu ( a, b, x, hu, md )
+
+!*****************************************************************************80
+!
+!! CHGU computes the confluent hypergeometric function U(a,b,x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    27 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+! 
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) A, B, parameters.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) HU, U(a,b,x).
+!
+!    Output, integer ( kind = 4 ) MD, the method code.
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) a00
+  real ( kind = 8 ) aa
+  real ( kind = 8 ) b
+  real ( kind = 8 ) b00
+  logical bl1
+  logical bl2
+  logical bl3
+  logical bn
+  real ( kind = 8 ) hu
+  real ( kind = 8 ) hu1
+  integer ( kind = 4 ) id
+  integer ( kind = 4 ) id1
+  logical il1
+  logical il2
+  logical il3
+  integer ( kind = 4 ) md
+  real ( kind = 8 ) x
+
+  aa = a - b + 1.0D+00
+  il1 = a == int ( a ) .and. a <= 0.0D+00
+  il2 = aa == int ( aa ) .and. aa <= 0.0D+00
+  il3 = abs ( a * ( a - b + 1.0D+00 ) ) / x <= 2.0D+00
+  bl1 = x <= 5.0D+00 .or. ( x <= 10.0D+00 .and. a <= 2.0D+00 )
+  bl2 = ( 5.0D+00 < x .and. x <= 12.5D+00 ) .and. &
+    ( 1.0D+00 <= a .and. a + 4.0D+00 <= b )
+  bl3 = 12.5D+00 < x .and. 5.0D+00 <= a .and. a + 5.0D+00 <= b
+  bn = b == int ( b ) .and. b .ne. 0.0D+00
+  id1 = -100
+
+  if ( b .ne. int ( b ) ) then
+    call chgus ( a, b, x, hu, id1 )
+    md = 1
+    if ( 6 <= id1 ) then
+      return
+    end if
+    hu1 = hu
+  end if
+
+  if ( il1 .or. il2 .or. il3 ) then
+    call chgul ( a, b, x, hu, id )
+    md = 2
+    if ( 6 <= id ) then
+      return
+    end if
+    if ( id < id1 ) then
+      md = 1
+      id = id1
+      hu = hu1
+    end if
+  end if
+
+  if ( 0.0D+00 <= a ) then
+    if ( bn .and. ( bl1 .or. bl2 .or. bl3 ) ) then
+      call chgubi ( a, b, x, hu, id )
+      md = 3
+    else
+      call chguit ( a, b, x, hu, id )
+      md = 4
+    end if
+  else
+    if ( b <= a ) then
+      a00 = a
+      b00 = b
+      a = a - b + 1.0D+00
+      b = 2.0D+00 - b
+      call chguit ( a, b, x, hu, id )
+      hu = x ** ( 1.0D+00 - b00 ) * hu
+      a = a00
+      b = b00
+      md = 4
+    else if ( bn .and. ( .not. il1 ) ) then
+      call chgubi ( a, b, x, hu, id )
+      md = 3
+    end if
+  end if
+
+  if ( id < 6 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'CHGU - Warning!'
+    write ( *, '(a)' ) '  Accurate results were not obtained.'
+  end if
+
+  return
+end
+subroutine chgubi ( a, b, x, hu, id )
+
+!*****************************************************************************80
+!
+!! CHGUBI: confluent hypergeometric function with integer argument B.
+!
+!  Discussion:
+!
+!    This procedure computes the confluent hypergeometric function
+!    U(a,b,x) with integer ( kind = 4 ) b ( b = ń1,ń2,... )
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    31 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) A, B, parameters.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) HU, the value of U(a,b,x).
+!
+!    Output, integer ( kind = 4 ) ID, the estimated number of significant
+!    digits.
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) a1
+  real ( kind = 8 ) a2
+  real ( kind = 8 ) b
+  real ( kind = 8 ) da1
+  real ( kind = 8 ) da2
+  real ( kind = 8 ) db1
+  real ( kind = 8 ) db2
+  real ( kind = 8 ) el
+  real ( kind = 8 ) ga
+  real ( kind = 8 ) ga1
+  real ( kind = 8 ) h0
+  real ( kind = 8 ) hm1
+  real ( kind = 8 ) hm2
+  real ( kind = 8 ) hm3
+  real ( kind = 8 ) hmax
+  real ( kind = 8 ) hmin
+  real ( kind = 8 ) hu
+  real ( kind = 8 ) hu1
+  real ( kind = 8 ) hu2
+  real ( kind = 8 ) hw
+  integer ( kind = 4 ) id
+  integer ( kind = 4 ) id1
+  integer ( kind = 4 ) id2
+  integer ( kind = 4 ) j 
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) ps
+  real ( kind = 8 ) r
+  real ( kind = 8 ) rn
+  real ( kind = 8 ) rn1
+  real ( kind = 8 ) s0
+  real ( kind = 8 ) s1
+  real ( kind = 8 ) s2
+  real ( kind = 8 ) sa
+  real ( kind = 8 ) sb
+  real ( kind = 8 ) ua
+  real ( kind = 8 ) ub
+  real ( kind = 8 ) x
+
+  id = - 100
+  el = 0.5772156649015329D+00
+  n = int ( abs ( b - 1 ) )
+  rn1 = 1.0D+00
+  rn = 1.0D+00
+  do j = 1, n
+    rn = rn * j
+    if ( j == n - 1 ) then
+      rn1 = rn
+    end if
+  end do
+
+  call psi ( a, ps )
+  call gamma ( a, ga )
+
+  if ( 0.0D+00 < b ) then
+    a0 = a
+    a1 = a - n
+    a2 = a1
+    call gamma ( a1, ga1 )
+    ua = ( - 1 ) ** ( n - 1 ) / ( rn * ga1 )
+    ub = rn1 / ga * x ** ( - n )
+  else
+    a0 = a + n
+    a1 = a0
+    a2 = a
+    call gamma ( a1, ga1 )
+    ua = ( - 1 ) ** ( n - 1 ) / ( rn * ga ) * x ** n
+    ub = rn1 / ga1
+  end if
+
+  hm1 = 1.0D+00
+  r = 1.0D+00
+  hmax = 0.0D+00
+  hmin = 1.0D+300
+
+  do k = 1, 150
+    r = r * ( a0 + k - 1.0D+00 ) * x / ( ( n + k ) * k )
+    hm1 = hm1 + r
+    hu1 = abs ( hm1 )
+    hmax = max ( hmax, hu1 )
+    hmin = min ( hmin, hu1 )
+    if ( abs ( hm1 - h0 ) < abs ( hm1 ) * 1.0D-15 ) then
+      exit
+    end if
+    h0 = hm1
+  end do
+
+  da1 = log10 ( hmax )
+  if ( hmin /= 0.0D+00 ) then
+    da2 = log10 ( hmin )
+  end if
+  id = 15 - int ( abs ( da1 - da2 ) )
+  hm1 = hm1 * log ( x )
+  s0 = 0.0D+00
+  do m = 1, n
+    if ( 0.0D+00 <= b ) then
+      s0 = s0 - 1.0D+00 / m
+    else
+      s0 = s0 + ( 1.0D+00 - a ) / ( m * ( a + m - 1.0D+00 ) )
+    end if
+  end do
+  hm2 = ps + 2.0D+00 * el + s0
+  r = 1.0D+00
+  hmax = 0.0D+00
+  hmin = 1.0D+300
+  do k = 1, 150
+    s1 = 0.0D+00
+    s2 = 0.0D+00
+    if ( 0.0D+00 < b ) then
+      do m = 1, k
+        s1 = s1 - ( m + 2.0D+00 * a - 2.0D+00 ) / ( m * ( m + a - 1.0D+00 ) )
+      end do
+      do m = 1, n
+        s2 = s2 + 1.0D+00 / ( k + m )
+      end do
+    else
+      do m = 1, k + n
+        s1 = s1 + ( 1.0D+00 - a ) / ( m * ( m + a - 1.0D+00 ) )
+      end do
+      do m = 1, k
+        s2 = s2 + 1.0D+00 / m
+      end do
+    end if
+    hw = 2.0D+00 * el + ps + s1 - s2
+    r = r * ( a0 + k - 1.0D+00 ) * x / ( ( n + k ) * k )
+    hm2 = hm2 + r * hw
+    hu2 = abs ( hm2 )
+    hmax = max ( hmax, hu2 )
+    hmin = min ( hmin, hu2 )
+
+    if ( abs ( ( hm2 - h0 ) / hm2 ) < 1.0D-15 ) then
+      exit
+    end if
+
+    h0 = hm2
+
+  end do
+
+  db1 = log10 ( hmax )
+  if ( hmin /= 0.0D+00 ) then
+    db2 = log10 ( hmin )
+  end if
+  id1 = 15 - int ( abs ( db1 - db2 ) )
+  id = min ( id, id1 )
+
+  if ( n == 0 ) then
+    hm3 = 0.0D+00
+  else
+    hm3 = 1.0D+00
+  end if
+
+  r = 1.0D+00
+  do k = 1, n - 1
+    r = r * ( a2 + k - 1.0D+00 ) / ( ( k - n ) * k ) * x
+    hm3 = hm3 + r
+  end do
+
+  sa = ua * ( hm1 + hm2 )
+  sb = ub * hm3
+  hu = sa + sb
+
+  if ( sa /= 0.0D+00 ) then
+    id1 = int ( log10 ( abs ( sa ) ) )
+  end if
+
+  if ( hu /= 0.0D+00 ) then
+    id2 = int ( log10 ( abs ( hu ) ) )
+  end if
+
+  if ( sa * sb < 0.0D+00 ) then
+    id = id - abs ( id1 - id2 )
+  end if
+
+  return
+end
+subroutine chguit ( a, b, x, hu, id )
+
+!*****************************************************************************80
+!
+!! CHGUIT computes the hypergeometric function using Gauss-Legendre integration.
+!
+!  Discussion:
+!
+!    This procedure computes the hypergeometric function U(a,b,x) by
+!    using Gaussian-Legendre integration (n = 60)
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    22 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, double precision A, B, parameters.
+!
+!    Input, double precision X, the argument.
+!
+!    Output, double precision HU, U(a,b,z).
+!
+!    Output, integer ID, the estimated number of significant digits.
+!
+  implicit none
+
+  double precision a
+  double precision a1
+  double precision b
+  double precision b1
+  double precision c
+  double precision d
+  double precision f1
+  double precision f2
+  double precision g
+  double precision ga
+  double precision hu
+  double precision hu0
+  double precision hu1
+  double precision hu2
+  integer id
+  integer j
+  integer k
+  integer m
+  double precision s
+  double precision, save, dimension ( 30 ) :: t = (/ &
+    0.259597723012478D-01, 0.778093339495366D-01, &
+    0.129449135396945D+00, 0.180739964873425D+00, &
+    0.231543551376029D+00, 0.281722937423262D+00, &
+    0.331142848268448D+00, 0.379670056576798D+00, &
+    0.427173741583078D+00, 0.473525841761707D+00, &
+    0.518601400058570D+00, 0.562278900753945D+00, &
+    0.604440597048510D+00, 0.644972828489477D+00, &
+    0.683766327381356D+00, 0.720716513355730D+00, &
+    0.755723775306586D+00, 0.788693739932264D+00, &
+    0.819537526162146D+00, 0.848171984785930D+00, &
+    0.874519922646898D+00, 0.898510310810046D+00, &
+    0.920078476177628D+00, 0.939166276116423D+00, &
+    0.955722255839996D+00, 0.969701788765053D+00, &
+    0.981067201752598D+00, 0.989787895222222D+00, &
+    0.995840525118838D+00, 0.999210123227436D+00 /)
+  double precision t1
+  double precision t2
+  double precision t3
+  double precision t4
+  double precision, save, dimension ( 30 ) :: w = (/ &
+    0.519078776312206D-01, 0.517679431749102D-01, &
+    0.514884515009810D-01, 0.510701560698557D-01, &
+    0.505141845325094D-01, 0.498220356905502D-01, &
+    0.489955754557568D-01, 0.480370318199712D-01, &
+    0.469489888489122D-01, 0.457343797161145D-01, &
+    0.443964787957872D-01, 0.429388928359356D-01, &
+    0.413655512355848D-01, 0.396806954523808D-01, &
+    0.378888675692434D-01, 0.359948980510845D-01, &
+    0.340038927249464D-01, 0.319212190192963D-01, &
+    0.297524915007890D-01, 0.275035567499248D-01, &
+    0.251804776215213D-01, 0.227895169439978D-01, &
+    0.203371207294572D-01, 0.178299010142074D-01, &
+    0.152746185967848D-01, 0.126781664768159D-01, &
+    0.100475571822880D-01, 0.738993116334531D-02, &
+    0.471272992695363D-02, 0.202681196887362D-02 /)
+  double precision x
+
+  id = 7
+  a1 = a - 1.0D+00
+  b1 = b - a - 1.0D+00
+  c = 12.0D+00 / x
+
+  do m = 10, 100, 5
+
+    hu1 = 0.0D+00
+    g = 0.5D+00 * c / m
+    d = g
+    do j = 1, m
+      s = 0.0D+00
+      do k = 1, 30
+        t1 = d + g * t(k)
+        t2 = d - g * t(k)
+        f1 = exp ( - x * t1 ) * t1 ** a1 * ( 1.0D+00 + t1 ) ** b1
+        f2 = exp ( - x * t2 ) * t2 ** a1 * ( 1.0D+00 + t2 ) ** b1
+        s = s + w(k) * ( f1 + f2 )
+      end do
+      hu1 = hu1 + s * g
+      d = d + 2.0D+00 * g
+    end do
+
+    if ( abs ( 1.0D+00 - hu0 / hu1 ) < 1.0D-07 ) then
+      exit
+    end if
+
+    hu0 = hu1
+
+  end do
+
+  call gamma ( a, ga )
+  hu1 = hu1 / ga
+
+  do m = 2, 10, 2
+    hu2 = 0.0D+00
+    g = 0.5D+00 / m
+    d = g
+    do j = 1, m
+      s = 0.0D+00
+      do k = 1, 30
+        t1 = d + g * t(k)
+        t2 = d - g * t(k)
+        t3 = c / ( 1.0D+00 - t1 )
+        t4 = c / ( 1.0D+00 - t2 ) 
+        f1 = t3 * t3 / c * exp ( - x * t3 ) * t3 ** a1 * ( 1.0D+00 + t3 ) ** b1
+        f2 = t4 * t4 / c * exp ( - x * t4 ) * t4 ** a1 * ( 1.0D+00 + t4 ) ** b1
+        s = s + w(k) * ( f1 + f2 )
+      end do
+      hu2 = hu2 + s * g
+      d = d + 2.0D+00 * g
+    end do
+
+    if ( abs ( 1.0D+00 - hu0 / hu2 ) < 1.0D-07 ) then
+      exit
+    end if
+
+    hu0 = hu2
+
+  end do
+
+  call gamma ( a, ga )
+  hu2 = hu2 / ga
+  hu = hu1 + hu2
+
+  return
+end
+subroutine chgul ( a, b, x, hu, id )
+
+!*****************************************************************************80
+!
+!! CHGUL: confluent hypergeometric function U(a,b,x) for large argument X.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    22 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+! 
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) A, B, parameters.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) HU, the value of U(a,b,x).
+!
+!    Output, integer ( kind = 4 ) ID, the estimated number of 
+!    significant digits.
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) aa
+  real ( kind = 8 ) b
+  real ( kind = 8 ) hu
+  integer ( kind = 4 ) id
+  logical il1
+  logical il2
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) r
+  real ( kind = 8 ) ra
+  real ( kind = 8 ) r0
+  real ( kind = 8 ) x
+
+  id = -100
+  aa = a - b + 1.0D+00
+  il1 = ( a == int ( a ) ) .and. ( a <= 0.0D+00 )
+  il2 = ( aa == int ( aa ) ) .and. ( aa <= 0.0D+00 )
+
+  if ( il1 .or. il2 ) then
+
+    if ( il1 ) then
+      nm = int ( abs ( a ) )
+    end if
+
+    if ( il2 ) then
+      nm = int ( abs ( aa ) )
+    end if
+
+    hu = 1.0D+00
+    r = 1.0D+00
+    do k = 1, nm
+      r = - r * ( a + k - 1.0D+00 ) * ( a - b + k ) / ( k * x )
+      hu = hu + r
+    end do
+    hu = x ** ( - a ) * hu
+    id = 10
+
+  else
+
+    hu = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 25
+      r = - r * ( a + k - 1.0D+00 ) * ( a - b + k ) / ( k * x )
+      ra = abs ( r )
+      if ( ( 5 < k .and. r0 <= ra ) .or. ra < 1.0D-15 ) then
+        exit
+      end if
+      r0 = ra
+      hu = hu + r
+    end do
+
+    id = int ( abs ( log10 ( ra ) ) )
+    hu = x ** ( - a ) * hu
+
+  end if
+
+  return
+end
+subroutine chgus ( a, b, x, hu, id )
+
+!*****************************************************************************80
+!
+!! CHGUS: confluent hypergeometric function U(a,b,x) for small argument X.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    27 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) A, B, parameters.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) HU, U(a,b,x).
+!
+!    Output, integer ( kind = 4 ) ID, the estimated number of 
+!    significant digits.
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) b
+  real ( kind = 8 ) d1
+  real ( kind = 8 ) d2
+  real ( kind = 8 ) ga
+  real ( kind = 8 ) gab
+  real ( kind = 8 ) gb
+  real ( kind = 8 ) gb2
+  real ( kind = 8 ) h0
+  real ( kind = 8 ) hmax
+  real ( kind = 8 ) hmin
+  real ( kind = 8 ) hu
+  real ( kind = 8 ) hu0
+  real ( kind = 8 ) hua
+  integer ( kind = 4 ) id
+  integer ( kind = 4 ) j
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) r2
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xg1
+  real ( kind = 8 ) xg2
+
+  id = -100
+  pi = 3.141592653589793D+00
+  call gamma ( a, ga )
+  call gamma ( b, gb )
+  xg1 = 1.0D+00 + a - b
+  call gamma ( xg1, gab )
+  xg2 = 2.0D+00 - b
+  call gamma ( xg2, gb2 )
+  hu0 = pi / sin ( pi * b )
+  r1 = hu0 / ( gab * gb )
+  r2 = hu0 * x ** ( 1.0D+00 - b ) / ( ga * gb2 )
+  hu = r1 - r2
+  hmax = 0.0D+00
+  hmin = 1.0D+300
+  do j = 1, 150
+    r1 = r1 * ( a + j - 1.0D+00 ) / ( j * ( b + j - 1.0D+00 ) ) * x
+    r2 = r2 * ( a - b + j ) / ( j * ( 1.0D+00 - b + j ) ) * x
+    hu = hu + r1 - r2
+    hua = abs ( hu )
+    hmax = max ( hmax, hua )
+    hmin = min ( hmin, hua )
+    if ( abs ( hu - h0 ) < abs ( hu ) * 1.0D-15 ) then
+      exit
+    end if
+    h0 = hu
+  end do
+
+  d1 = log10 ( hmax )
+  if ( hmin /= 0.0D+00 ) then
+    d2 = log10 ( hmin )
+  end if
+  id = 15 - int ( abs ( d1 - d2 ) )
+
+  return
+end
+subroutine cik01 ( z, cbi0, cdi0, cbi1, cdi1, cbk0, cdk0, cbk1, cdk1 )
+
+!*****************************************************************************80
+!
+!! CIK01: modified Bessel I0(z), I1(z), K0(z) and K1(z) for complex argument.
+!
+!  Discussion:
+!
+!    This procedure computes the modified Bessel functions I0(z), I1(z), 
+!    K0(z), K1(z), and their derivatives for a complex argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    31 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+! 
+!  Parameters:
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, complex ( kind = 8 ) CBI0, CDI0, CBI1, CDI1, CBK0, CDK0, CBK1, 
+!    CDK1, the values of I0(z), I0'(z), I1(z), I1'(z), K0(z), K0'(z), K1(z), 
+!    and K1'(z).
+!
+  implicit none
+
+  real ( kind = 8 ), save, dimension ( 12 ) :: a = (/ &
+    0.125D+00,           7.03125D-02,&
+    7.32421875D-02,      1.1215209960938D-01,&
+    2.2710800170898D-01, 5.7250142097473D-01,&
+    1.7277275025845D+00, 6.0740420012735D+00,&
+    2.4380529699556D+01, 1.1001714026925D+02,&
+    5.5133589612202D+02, 3.0380905109224D+03 /)
+  real ( kind = 8 ) a0
+  real ( kind = 8 ), save, dimension ( 10 ) :: a1 = (/ &
+    0.125D+00,            0.2109375D+00, &
+    1.0986328125D+00,     1.1775970458984D+01, &
+    2.1461706161499D+002, 5.9511522710323D+03, &
+    2.3347645606175D+05,  1.2312234987631D+07, &
+    8.401390346421D+08,   7.2031420482627D+10 /)
+  real ( kind = 8 ), save, dimension ( 12 ) :: b = (/ &
+   -0.375D+00,           -1.171875D-01, &
+   -1.025390625D-01,     -1.4419555664063D-01, &
+   -2.7757644653320D-01, -6.7659258842468D-01, &
+   -1.9935317337513D+00, -6.8839142681099D+00, &
+   -2.7248827311269D+01, -1.2159789187654D+02, &
+   -6.0384407670507D+02, -3.3022722944809D+03 /)
+  complex ( kind = 8 ) ca
+  complex ( kind = 8 ) cb
+  complex ( kind = 8 ) cbi0
+  complex ( kind = 8 ) cbi1
+  complex ( kind = 8 ) cbk0
+  complex ( kind = 8 ) cbk1
+  complex ( kind = 8 ) cdi0
+  complex ( kind = 8 ) cdi1
+  complex ( kind = 8 ) cdk0
+  complex ( kind = 8 ) cdk1
+  complex ( kind = 8 ) ci
+  complex ( kind = 8 ) cr
+  complex ( kind = 8 ) cs
+  complex ( kind = 8 ) ct
+  complex ( kind = 8 ) cw
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k0
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) w0
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) z1
+  complex ( kind = 8 ) z2
+  complex ( kind = 8 ) zr
+  complex ( kind = 8 ) zr2
+
+  pi = 3.141592653589793D+00
+  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
+  a0 = abs ( z )
+  z2 = z * z
+  z1 = z
+
+  if ( a0 == 0.0D+00 ) then
+    cbi0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cbi1 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+    cdi0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+    cdi1 = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
+    cbk0 = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    cbk1 = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    cdk0 = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    cdk1 = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    return
+  end if
+
+  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
+    z1 = -z
+  end if
+
+  if ( a0 <= 18.0D+00 ) then
+
+    cbi0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 50
+      cr = 0.25D+00 * cr * z2 / ( k * k )
+      cbi0 = cbi0 + cr
+      if ( abs ( cr / cbi0 ) < 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    cbi1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 50
+      cr = 0.25D+00 * cr * z2 / ( k * ( k + 1 ) )
+      cbi1 = cbi1 + cr
+      if ( abs ( cr / cbi1 ) < 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    cbi1 = 0.5D+00 * z1 * cbi1
+
+  else
+
+    if ( a0 < 35.0D+00 ) then
+      k0 = 12
+    else if ( a0 < 50.0D+00 ) then
+      k0 = 9
+    else
+      k0 = 7
+    end if
+
+    ca = exp ( z1 ) / sqrt ( 2.0D+00 * pi * z1 )
+    cbi0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    zr = 1.0D+00 / z1
+    do k = 1, k0
+      cbi0 = cbi0 + a(k) * zr ** k
+    end do
+    cbi0 = ca * cbi0
+    cbi1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, k0
+      cbi1 = cbi1 + b(k) * zr ** k
+    end do
+    cbi1 = ca * cbi1
+
+  end if
+
+  if ( a0 <= 9.0D+00 ) then
+
+    cs = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+    ct = - log ( 0.5D+00 * z1 ) - 0.5772156649015329D+00
+    w0 = 0.0D+00
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 50
+      w0 = w0 + 1.0D+00 / k
+      cr = 0.25D+00 * cr / ( k * k ) * z2
+      cs = cs + cr * ( w0 + ct )
+      if ( abs ( ( cs - cw ) / cs ) < 1.0D-15 ) then
+        exit
+      end if
+      cw = cs
+    end do
+
+    cbk0 = ct + cs
+
+  else
+
+    cb = 0.5D+00 / z1
+    zr2 = 1.0D+00 / z2
+    cbk0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 10
+      cbk0 = cbk0 + a1(k) * zr2 ** k
+    end do
+    cbk0 = cb * cbk0 / cbi0
+
+  end if
+
+  cbk1 = ( 1.0D+00 / z1 - cbi1 * cbk0 ) / cbi0
+
+  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
+
+    if ( imag ( z ) < 0.0D+00 ) then
+      cbk0 = cbk0 + ci * pi * cbi0
+      cbk1 = - cbk1 + ci * pi * cbi1
+    else
+      cbk0 = cbk0 - ci * pi * cbi0
+      cbk1 = - cbk1 - ci * pi * cbi1
+    end if
+
+    cbi1 = - cbi1
+
+  end if
+
+  cdi0 = cbi1
+  cdi1 = cbi0 - 1.0D+00 / z * cbi1
+  cdk0 = - cbk1
+  cdk1 = - cbk0 - 1.0D+00 / z * cbk1
+
+  return
+end
+subroutine ciklv ( v, z, cbiv, cdiv, cbkv, cdkv )
+
+!*****************************************************************************80
+!
+!! CIKLV: modified Bessel functions Iv(z), Kv(z), complex argument, large order.
+!
+!  Discussion:
+!
+!    This procedure computes modified Bessel functions Iv(z) and
+!    Kv(z) and their derivatives with a complex argument and a large order.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    31 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) V, the order of Iv(z) and Kv(z).
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, real ( kind = 8 ) CBIV, CDIV, CBKV, CDKV, the values of
+!    Iv(z), Iv'(z), Kv(z), Kv'(z).
+!
+  implicit none
+
+  real ( kind = 8 ) a(91)
+  complex ( kind = 8 ) cbiv
+  complex ( kind = 8 ) cbkv
+  complex ( kind = 8 ) cdiv
+  complex ( kind = 8 ) cdkv
+  complex ( kind = 8 ) ceta
+  complex ( kind = 8 ) cf(12)
+  complex ( kind = 8 ) cfi
+  complex ( kind = 8 ) cfk
+  complex ( kind = 8 ) csi
+  complex ( kind = 8 ) csk
+  complex ( kind = 8 ) ct
+  complex ( kind = 8 ) ct2
+  complex ( kind = 8 ) cws
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) km
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) l0
+  integer ( kind = 4 ) lf
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) v
+  real ( kind = 8 ) v0
+  real ( kind = 8 ) vr
+  complex ( kind = 8 ) z
+
+  pi = 3.141592653589793D+00
+  km = 12
+  call cjk ( km, a )
+
+  do l = 1, 0, -1
+
+    v0 = v - l
+    cws = sqrt ( 1.0D+00 + ( z / v0 ) * ( z / v0 ) )
+    ceta = cws + log ( z / v0 / ( 1.0D+00 + cws ) )
+    ct = 1.0D+00 / cws
+    ct2 = ct * ct
+    do k = 1, km
+      l0 = k * ( k + 1 ) / 2 + 1
+      lf = l0 + k
+      cf(k) = a(lf)
+      do i = lf - 1, l0, -1
+        cf(k) = cf(k) * ct2 + a(i)
+      end do
+      cf(k) = cf(k) * ct ** k
+    end do
+    vr = 1.0D+00 / v0
+    csi = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, km
+      csi = csi + cf(k) * vr ** k
+    end do
+    cbiv = sqrt ( ct / ( 2.0D+00 * pi * v0 ) ) * exp ( v0 * ceta ) * csi
+    if ( l == 1 ) then
+      cfi = cbiv
+    end if
+    csk = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, km
+      csk = csk + ( - 1 ) ** k * cf(k) * vr ** k
+    end do
+    cbkv = sqrt ( pi * ct / ( 2.0D+00 * v0 ) ) * exp ( - v0 * ceta ) * csk
+
+    if ( l == 1 ) then
+      cfk = cbkv
+    end if
+
+  end do
+
+  cdiv =   cfi - v / z * cbiv
+  cdkv = - cfk - v / z * cbkv
+
+  return
+end
+subroutine cikna ( n, z, nm, cbi, cdi, cbk, cdk )
+
+!*****************************************************************************80
+!
+!! CIKNA: modified Bessel functions In(z), Kn(z), derivatives, complex argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    30 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order of In(z) and Kn(z).
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, integer ( kind = 4 ) NM, the highest order computed.
+!
+!    Output, complex ( kind = 8 ) CBI((0:N), CDI(0:N), CBK(0:N), CDK(0:N), 
+!    the values of In(z), In'(z), Kn(z), Kn'(z).
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) a0
+  complex ( kind = 8 ) cbi(0:n)
+  complex ( kind = 8 ) cbi0
+  complex ( kind = 8 ) cbi1
+  complex ( kind = 8 ) cbk(0:n)
+  complex ( kind = 8 ) cbk0
+  complex ( kind = 8 ) cbk1
+  complex ( kind = 8 ) cdi(0:n)
+  complex ( kind = 8 ) cdi0
+  complex ( kind = 8 ) cdi1
+  complex ( kind = 8 ) cdk(0:n)
+  complex ( kind = 8 ) cdk0
+  complex ( kind = 8 ) cdk1
+  complex ( kind = 8 ) cf
+  complex ( kind = 8 ) cf1
+  complex ( kind = 8 ) cf2
+  complex ( kind = 8 ) ckk
+  complex ( kind = 8 ) cs
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) nm
+  complex ( kind = 8 ) z
+
+  a0 = abs ( z )
+  nm = n
+
+  if ( a0 < 1.0D-100 ) then
+    do k = 0, n
+      cbi(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      cdi(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      cbk(k) = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+      cdk(k) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    end do
+    cbi(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cdi(1) = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
+    return
+  end if
+
+  call cik01 ( z, cbi0, cdi0, cbi1, cdi1, cbk0, cdk0, cbk1, cdk1 )
+
+  cbi(0) = cbi0
+  cbi(1) = cbi1
+  cbk(0) = cbk0
+  cbk(1) = cbk1
+  cdi(0) = cdi0
+  cdi(1) = cdi1
+  cdk(0) = cdk0
+  cdk(1) = cdk1
+
+  if ( n <= 1 ) then
+    return
+  end if
+
+  m = msta1 ( a0, 200 )
+
+  if ( m < n ) then
+    nm = m
+  else
+    m = msta2 ( a0, n, 15 )
+  end if
+
+  cf2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+  cf1 = cmplx ( 1.0D-30, 0.0D+00, kind = 8 )
+  do k = m, 0, -1
+    cf = 2.0D+00 * ( k + 1.0D+00 ) / z * cf1 + cf2
+    if ( k <= nm ) then
+      cbi(k) = cf
+    end if
+    cf2 = cf1
+    cf1 = cf
+  end do
+
+  cs = cbi0 / cf
+  do k = 0, nm
+    cbi(k) = cs * cbi(k)
+  end do
+
+  do k = 2, nm
+    if ( abs ( cbi(k-2) ) < abs ( cbi(k-1) ) ) then
+      ckk = ( 1.0D+00 / z - cbi(k) * cbk(k-1) ) / cbi(k-1)
+    else
+      ckk = ( cbi(k) * cbk(k-2) + 2.0D+00 * ( k - 1.0D+00 ) &
+        / ( z * z ) ) / cbi(k-2)
+    end if
+    cbk(k) = ckk
+  end do
+
+  do k = 2, nm
+    cdi(k) =   cbi(k-1) - k / z * cbi(k)
+    cdk(k) = - cbk(k-1) - k / z * cbk(k)
+  end do
+
+  return
+end
+subroutine ciknb ( n, z, nm, cbi, cdi, cbk, cdk )
+
+!*****************************************************************************80
+!
+!! CIKNB computes complex modified Bessel functions In(z) and Kn(z).
+!
+!  Discussion:
+!
+!    This procedure also evaluates the derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    30 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order of In(z) and Kn(z).
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, integer ( kind = 4 ) NM, the highest order computed.
+!
+!    Output, complex ( kind = 8 ) CB((0:N), CDI(0:N), CBK(0:N), CDK(0:N), 
+!    the values of In(z), In'(z), Kn(z), Kn'(z).
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) a0
+  complex ( kind = 8 ) ca0
+  complex ( kind = 8 ) cbi(0:n)
+  complex ( kind = 8 ) cbkl
+  complex ( kind = 8 ) cbs
+  complex ( kind = 8 ) cdi(0:n)
+  complex ( kind = 8 ) cbk(0:n)
+  complex ( kind = 8 ) cdk(0:n)
+  complex ( kind = 8 ) cf
+  complex ( kind = 8 ) cf0
+  complex ( kind = 8 ) cf1
+  complex ( kind = 8 ) cg
+  complex ( kind = 8 ) cg0
+  complex ( kind = 8 ) cg1
+  complex ( kind = 8 ) ci
+  complex ( kind = 8 ) cr
+  complex ( kind = 8 ) cs0
+  complex ( kind = 8 ) csk0
+  real ( kind = 8 ) el
+  real ( kind = 8 ) fac
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k0
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) vt
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) z1
+
+  pi = 3.141592653589793D+00
+  el = 0.57721566490153D+00
+  a0 = abs ( z )
+  nm = n
+
+  if ( a0 < 1.0D-100 ) then
+    do k = 0, n
+      cbi(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      cbk(k) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+      cdi(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      cdk(k) = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    end do
+    cbi(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cdi(1) = cmplx ( 0.5D+00, 0.0D+00, kind = 8 ) 
+    return
+  end if
+
+  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
+
+  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
+    z1 = -z
+  else
+    z1 = z
+  end if
+
+  if ( n == 0 ) then
+    nm = 1
+  end if
+
+  m = msta1 ( a0, 200 )
+
+  if ( m < nm ) then
+    nm = m
+  else
+    m = msta2 ( a0, nm, 15 )
+  end if
+
+  cbs = 0.0D+00
+  csk0 = 0.0D+00
+  cf0 = 0.0D+00
+  cf1 = 1.0D-100
+
+  do k = m, 0, -1
+    cf = 2.0D+00 * ( k + 1.0D+00 ) * cf1 / z1 + cf0
+    if ( k <= nm ) then
+      cbi(k) = cf
+    end if
+    if ( k /= 0 .and. k == 2 * int ( k / 2 ) ) then
+      csk0 = csk0 + 4.0D+00 * cf / k
+    end if
+    cbs = cbs + 2.0D+00 * cf
+    cf0 = cf1
+    cf1 = cf
+  end do
+
+  cs0 = exp ( z1 ) / ( cbs - cf )
+
+  do k = 0, nm
+    cbi(k) = cs0 * cbi(k)
+  end do
+
+  if ( a0 <= 9.0D+00 ) then
+
+    cbk(0) = - ( log ( 0.5D+00 * z1 ) + el ) * cbi(0) + cs0 * csk0
+    cbk(1) = ( 1.0D+00 / z1 - cbi(1) * cbk(0) ) / cbi(0)
+
+  else
+
+    ca0 = sqrt ( pi / ( 2.0D+00 * z1 ) ) * exp ( -z1 )
+
+    if ( a0 < 25.0D+00 ) then
+      k0 = 16
+    else if ( a0 < 80.0D+00 ) then
+      k0 = 10
+    else if ( a0 < 200.0D+00 ) then
+      k0 = 8
+    else
+      k0 = 6
+    end if
+
+    do l = 0, 1
+      cbkl = 1.0D+00
+      vt = 4.0D+00 * l
+      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, k0
+        cr = 0.125D+00 * cr &
+          * ( vt - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * z1 )
+        cbkl = cbkl + cr
+      end do
+      cbk(l) = ca0 * cbkl
+    end do
+  end if
+
+  cg0 = cbk(0)
+  cg1 = cbk(1)
+  do k = 2, nm
+    cg = 2.0D+00 * ( k - 1.0D+00 ) / z1 * cg1 + cg0
+    cbk(k) = cg
+    cg0 = cg1
+    cg1 = cg
+  end do
+
+  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
+    fac = 1.0D+00
+    do k = 0, nm
+      if ( imag ( z ) < 0.0D+00 ) then
+        cbk(k) = fac * cbk(k) + ci * pi * cbi(k)
+      else
+        cbk(k) = fac * cbk(k) - ci * pi * cbi(k)
+      end if
+      cbi(k) = fac * cbi(k)
+      fac = - fac
+    end do
+  end if
+
+  cdi(0) = cbi(1)
+  cdk(0) = -cbk(1)
+  do k = 1, nm
+    cdi(k) = cbi(k-1) - k / z * cbi(k)
+    cdk(k) = - cbk(k-1) - k / z * cbk(k)
+  end do
+
+  return
+end
+subroutine cikva ( v, z, vm, cbi, cdi, cbk, cdk )
+
+!*****************************************************************************80
+!
+!! CIKVA: modified Bessel functions Iv(z), Kv(z), arbitrary order, complex.
+!
+!  Discussion:
+!
+!    Compute the modified Bessel functions Iv(z), Kv(z)
+!    and their derivatives for an arbitrary order and
+!    complex argument
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    31 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:       
+!
+!    Input, real ( kind = 8 ) V, the order of the functions.
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, real ( kind = 8 ) VM, the highest order computed.
+!
+!    Output, real ( kind = 8 ) CBI(0:N), CDI(0:N), CBK(0:N), CDK(0:N),
+!    the values of In+v0(z), In+v0'(z), Kn+v0(z), Kn+v0'(z).
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  complex ( kind = 8 ) ca
+  complex ( kind = 8 ) ca1
+  complex ( kind = 8 ) ca2
+  complex ( kind = 8 ) cb
+  complex ( kind = 8 ) cbi(0:*)
+  complex ( kind = 8 ) cbi0
+  complex ( kind = 8 ) cdi(0:*)
+  complex ( kind = 8 ) cbk(0:*)
+  complex ( kind = 8 ) cbk0
+  complex ( kind = 8 ) cbk1
+  complex ( kind = 8 ) cdk(0:*)
+  complex ( kind = 8 ) cf
+  complex ( kind = 8 ) cf1
+  complex ( kind = 8 ) cf2
+  complex ( kind = 8 ) cg0
+  complex ( kind = 8 ) cg1
+  complex ( kind = 8 ) cgk
+  complex ( kind = 8 ) ci
+  complex ( kind = 8 ) ci0
+  complex ( kind = 8 ) cp
+  complex ( kind = 8 ) cr
+  complex ( kind = 8 ) cr1
+  complex ( kind = 8 ) cr2
+  complex ( kind = 8 ) cs
+  complex ( kind = 8 ) csu
+  complex ( kind = 8 ) ct
+  complex ( kind = 8 ) cvk
+  real ( kind = 8 ) gan
+  real ( kind = 8 ) gap
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k0
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) piv
+  real ( kind = 8 ) v
+  real ( kind = 8 ) v0
+  real ( kind = 8 ) v0n
+  real ( kind = 8 ) v0p
+  real ( kind = 8 ) vm
+  real ( kind = 8 ) vt
+  real ( kind = 8 ) w0
+  real ( kind = 8 ) ws
+  real ( kind = 8 ) ws0
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) z1
+  complex ( kind = 8 ) z2
+
+  pi = 3.141592653589793D+00
+  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
+  a0 = abs ( z )
+  z1 = z
+  z2 = z * z
+  n = int ( v )
+  v0 = v - n
+  piv = pi * v0
+  vt = 4.0D+00 * v0 * v0
+
+  if ( n == 0 ) then
+    n = 1
+  end if
+
+  if ( a0 < 1.0D-100 ) then
+
+    do k = 0, n
+      cbi(k) = 0.0D+00
+      cdi(k) = 0.0D+00
+      cbk(k) = -1.0D+300
+      cdk(k) = 1.0D+300
+    end do
+
+    if ( v0 == 0.0D+00 ) then
+      cbi(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      cdi(1) = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
+    end if
+
+    vm = v
+    return
+
+  end if
+
+  if ( a0 < 35.0D+00 ) then
+    k0 = 14
+  else if ( a0 < 50.0D+00 ) then
+    k0 = 10
+  else
+    k0 = 8
+  end if
+
+  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
+    z1 = -z
+  end if
+
+  if ( a0 < 18.0D+00 ) then
+
+    if ( v0 == 0.0D+00 ) then
+      ca1 = cmplx (1.0D+00, 0.0D+00, kind = 8 )
+    else
+      v0p = 1.0D+00 + v0
+      call gamma ( v0p, gap )
+      ca1 = ( 0.5D+00 * z1 ) ** v0 / gap
+    end if
+
+    ci0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 50
+      cr = 0.25D+00 * cr * z2 / ( k * ( k + v0 ) )
+      ci0 = ci0 + cr
+      if ( abs ( cr ) < abs ( ci0 ) * 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    cbi0 = ci0 * ca1
+
+  else
+
+    ca = exp ( z1 ) / sqrt ( 2.0D+00 * pi * z1 )
+    cs = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, k0
+      cr = - 0.125D+00 * cr &
+        * ( vt - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * z1 )
+      cs = cs + cr
+    end do
+    cbi0 = ca * cs
+
+  end if
+
+  m = msta1 ( a0, 200 )
+
+  if ( m < n ) then
+     n = m
+  else
+     m = msta2 ( a0, n, 15 )
+  end if
+
+  cf2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+  cf1 = cmplx ( 1.0D-30, 0.0D+00, kind = 8 )
+  do k = m, 0, -1
+    cf = 2.0D+00 * ( v0 + k + 1.0D+00 ) / z1 * cf1 + cf2
+    if ( k <= n ) then
+      cbi(k) = cf
+    end if
+    cf2 = cf1
+    cf1 = cf
+  end do
+
+  cs = cbi0 / cf
+  do k = 0, n
+    cbi(k) = cs * cbi(k)
+  end do
+
+  if ( a0 <= 9.0D+00 ) then
+
+    if ( v0 == 0.0D+00 ) then
+      ct = - log ( 0.5D+00 * z1 ) - 0.5772156649015329D+00
+      cs = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      w0 = 0.0D+00
+      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, 50
+        w0 = w0 + 1.0D+00 / k
+        cr = 0.25D+00 * cr / ( k * k ) * z2
+        cp = cr * ( w0 + ct )
+        cs = cs + cp
+        if ( 10 <= k .and. abs ( cp / cs ) < 1.0D-15 ) then
+          exit
+        end if
+      end do
+
+      cbk0 = ct + cs
+
+    else
+
+      v0n = 1.0D+00 - v0
+      call gamma ( v0n, gan )
+      ca2 = 1.0D+00 / ( gan * ( 0.5D+00 * z1 ) ** v0 )
+      ca1 = ( 0.5D+00 * z1 ) ** v0 / gap
+      csu = ca2 - ca1
+      cr1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      cr2 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, 50
+        cr1 = 0.25D+00 * cr1 * z2 / ( k * ( k - v0 ) )
+        cr2 = 0.25D+00 * cr2 * z2 / ( k * ( k + v0 ) )
+        csu = csu + ca2 * cr1 - ca1 * cr2
+        ws = abs ( csu )
+        if ( 10 <= k .and. abs ( ws - ws0 ) / ws < 1.0D-15 ) then
+          exit
+        end if
+        ws0 = ws
+      end do
+
+      cbk0 = 0.5D+00 * pi * csu / sin ( piv )
+
+    end if
+
+  else
+
+    cb = exp ( - z1 ) * sqrt ( 0.5D+00 * pi / z1 )
+    cs = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, k0
+      cr = 0.125D+00 * cr &
+        * ( vt - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * z1 )
+      cs = cs + cr
+    end do
+    cbk0 = cb * cs
+
+  end if
+
+  cbk1 = ( 1.0D+00 / z1 - cbi(1) * cbk0 ) / cbi(0)
+  cbk(0) = cbk0
+  cbk(1) = cbk1
+  cg0 = cbk0
+  cg1 = cbk1
+
+  do k = 2, n
+    cgk = 2.0D+00 * ( v0 + k - 1.0D+00 ) / z1 * cg1 + cg0
+    cbk(k) = cgk
+    cg0 = cg1
+    cg1 = cgk
+  end do
+
+  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
+    do k = 0, n
+      cvk = exp ( ( k + v0 ) * pi * ci )
+      if ( imag ( z ) < 0.0D+00 ) then
+        cbk(k) = cvk * cbk(k) + pi * ci * cbi(k)
+        cbi(k) = cbi(k) / cvk
+      else if ( 0.0D+00 < imag ( z ) ) then
+        cbk(k) = cbk(k) / cvk - pi * ci * cbi(k)
+        cbi(k) = cvk * cbi(k)
+      end if
+    end do
+  end if
+
+  cdi(0) = v0 / z * cbi(0) + cbi(1)
+  cdk(0) = v0 / z * cbk(0) - cbk(1)
+  do k = 1, n
+    cdi(k) = - ( k + v0 ) / z * cbi(k) + cbi(k-1)
+    cdk(k) = - ( k + v0 ) / z * cbk(k) - cbk(k-1)
+  end do
+
+  vm = n + v0
+
+  return
+end
+subroutine cikvb ( v, z, vm, cbi, cdi, cbk, cdk )
+
+!*****************************************************************************80
+!
+!! CIKVB: modified Bessel functions,Iv(z), Kv(z), arbitrary order, complex.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    02 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) V, the order of the functions.
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, real ( kind = 8 ) VM, the highest order computed.
+!
+!    Output, real ( kind = 8 ) CBI(0:N), CDI(0:N), CBK(0:N), CDK(0:N),
+!    the values of In+v0(z), In+v0'(z), Kn+v0(z), Kn+v0'(z).
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  complex ( kind = 8 ) ca
+  complex ( kind = 8 ) ca1
+  complex ( kind = 8 ) ca2
+  complex ( kind = 8 ) cb
+  complex ( kind = 8 ) cbi(0:*)
+  complex ( kind = 8 ) cbi0
+  complex ( kind = 8 ) cdi(0:*)
+  complex ( kind = 8 ) cbk(0:*)
+  complex ( kind = 8 ) cbk0
+  complex ( kind = 8 ) cdk(0:*)
+  complex ( kind = 8 ) cf
+  complex ( kind = 8 ) cf1
+  complex ( kind = 8 ) cf2
+  complex ( kind = 8 ) ci
+  complex ( kind = 8 ) ci0
+  complex ( kind = 8 ) ckk
+  complex ( kind = 8 ) cp
+  complex ( kind = 8 ) cr
+  complex ( kind = 8 ) cr1
+  complex ( kind = 8 ) cr2
+  complex ( kind = 8 ) cs
+  complex ( kind = 8 ) csu
+  complex ( kind = 8 ) ct
+  complex ( kind = 8 ) cvk
+  real ( kind = 8 ) gan
+  real ( kind = 8 ) gap
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k0
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) piv
+  real ( kind = 8 ) v
+  real ( kind = 8 ) v0
+  real ( kind = 8 ) v0n
+  real ( kind = 8 ) v0p
+  real ( kind = 8 ) vm
+  real ( kind = 8 ) vt
+  real ( kind = 8 ) w0
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) z1
+  complex ( kind = 8 ) z2
+
+  z1 = z
+  z2 = z * z
+  a0 = abs ( z )
+  pi = 3.141592653589793D+00
+  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
+  n = int ( v )
+  v0 = v - n
+  piv = pi * v0
+  vt = 4.0D+00 * v0 * v0
+
+  if ( n == 0 ) then
+    n = 1
+  end if
+
+  if ( a0 < 1.0D-100 ) then
+    do k = 0, n
+      cbi(k) = 0.0D+00
+      cdi(k) = 0.0D+00
+      cbk(k) = -1.0D+300
+      cdk(k) = 1.0D+300
+    end do
+    if ( v0 == 0.0D+00 ) then
+      cbi(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      cdi(1) = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
+    end if
+    vm = v
+    return
+  end if
+
+  if ( a0 < 35.0D+00 ) then
+    k0 = 14
+  else if ( a0 < 50.0D+00 ) then
+    k0 = 10
+  else
+    k0 = 8
+  end if
+
+  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
+    z1 = -z
+  end if
+
+  if ( a0 < 18.0D+00 ) then
+
+    if ( v0 == 0.0D+00 ) then
+      ca1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    else
+      v0p = 1.0D+00 + v0
+      call gamma ( v0p, gap )
+      ca1 = ( 0.5D+00 * z1 ) ** v0 / gap
+    end if
+
+    ci0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 50
+      cr = 0.25D+00 * cr * z2 / ( k * ( k + v0 ) )
+      ci0 = ci0 + cr
+      if ( abs ( cr / ci0 ) < 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    cbi0 = ci0 * ca1
+
+  else
+
+    ca = exp ( z1 ) / sqrt ( 2.0D+00 * pi * z1 )
+    cs = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, k0
+      cr = -0.125D+00 * cr &
+        * ( vt - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * z1 )
+      cs = cs + cr
+    end do
+    cbi0 = ca * cs
+
+  end if
+
+  m = msta1 ( a0, 200 )
+  if ( m < n ) then
+    n = m
+  else
+    m = msta2 ( a0, n, 15 )
+  end if
+
+  cf2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+  cf1 = cmplx ( 1.0D-30, 0.0D+00, kind = 8 )
+  do k = m, 0, -1
+    cf = 2.0D+00 * ( v0 + k + 1.0D+00 ) / z1 * cf1 + cf2
+    if ( k <= n ) then
+      cbi(k) = cf
+    end if
+    cf2 = cf1
+    cf1 = cf
+  end do
+  cs = cbi0 / cf
+
+  do k = 0, n
+    cbi(k) = cs * cbi(k)
+  end do
+
+  if ( a0 <= 9.0D+00 ) then
+
+    if ( v0 == 0.0D+00 ) then
+
+      ct = - log ( 0.5D+00 * z1 ) - 0.5772156649015329D+00
+      cs = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      w0 = 0.0D+00
+      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, 50
+        w0 = w0 + 1.0D+00 / k
+        cr = 0.25D+00 * cr / ( k * k ) * z2
+        cp = cr * ( w0 + ct )
+        cs = cs + cp
+        if ( 10 <= k .and. abs ( cp / cs ) < 1.0D-15 ) then
+          exit
+        end if
+      end do
+
+      cbk0 = ct + cs
+
+    else
+
+      v0n = 1.0D+00 - v0
+      call gamma ( v0n, gan )
+      ca2 = 1.0D+00 / ( gan * ( 0.5D+00 * z1 ) ** v0 )
+      ca1 = ( 0.5D+00 * z1 ) ** v0 / gap
+      csu = ca2 - ca1
+      cr1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      cr2 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, 50
+        cr1 = 0.25D+00 * cr1 * z2 / ( k * ( k - v0 ) )
+        cr2 = 0.25D+00 * cr2 * z2 / ( k * ( k + v0 ) )
+        cp = ca2 * cr1 - ca1 * cr2
+        csu = csu + cp
+        if ( 10 <= k .and. abs ( cp / csu ) < 1.0D-15 ) then
+          exit
+        end if
+      end do
+
+      cbk0 = 0.5D+00 * pi * csu / sin ( piv )
+
+    end if
+
+  else
+
+    cb = exp ( -z1 ) * sqrt ( 0.5D+00 * pi / z1 )
+    cs = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, k0
+      cr = 0.125D+00 * cr * ( vt - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) &
+        / ( k * z1 )
+      cs = cs + cr
+    end do
+
+    cbk0 = cb * cs
+
+  end if
+
+  cbk(0) = cbk0
+
+  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
+    do k = 0, n
+      cvk = exp ( ( k + v0 ) * pi * ci )
+      if ( imag ( z ) < 0.0D+00 ) then
+        cbk(k) = cvk * cbk(k) + pi * ci * cbi(k)
+        cbi(k) = cbi(k) / cvk
+      else if ( 0.0D+00 < imag ( z ) ) then
+        cbk(k) = cbk(k) / cvk - pi * ci * cbi(k)
+        cbi(k) = cvk * cbi(k)
+      end if
+    end do
+  end if
+
+  do k = 1, n
+    ckk = ( 1.0D+00 / z - cbi(k) * cbk(k-1) ) / cbi(k-1)
+    cbk(k) = ckk
+  end do
+
+  cdi(0) = v0 / z * cbi(0) + cbi(1)
+  cdk(0) = v0 / z * cbk(0) - cbk(1)
+  do k = 1, n
+    cdi(k) = - ( k + v0 ) / z * cbi(k) + cbi(k-1)
+    cdk(k) = - ( k + v0 ) / z * cbk(k) - cbk(k-1)
+  end do 
+ 
+  vm = n + v0
+
+  return
+end
+subroutine cisia ( x, ci, si )
+
+!*****************************************************************************80
+!
+!! CISIA computes cosine Ci(x) and sine integrals Si(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    03 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument of Ci(x) and Si(x).
+!
+!    Output, real ( kind = 8 ) CI, SI, the values of Ci(x) and Si(x).
+!
+  implicit none
+
+  real ( kind = 8 ) bj(101)
+  real ( kind = 8 ) ci
+  real ( kind = 8 ) el
+  real ( kind = 8 ) eps
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) p2
+  real ( kind = 8 ) si
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x2
+  real ( kind = 8 ) xa
+  real ( kind = 8 ) xa0
+  real ( kind = 8 ) xa1
+  real ( kind = 8 ) xcs
+  real ( kind = 8 ) xf
+  real ( kind = 8 ) xg
+  real ( kind = 8 ) xg1
+  real ( kind = 8 ) xg2
+  real ( kind = 8 ) xr
+  real ( kind = 8 ) xs
+  real ( kind = 8 ) xss
+
+  p2 = 1.570796326794897D+00
+  el = 0.5772156649015329D+00
+  eps = 1.0D-15
+  x2 = x * x
+
+  if ( x == 0.0D+00 ) then
+
+    ci = -1.0D+300
+    si = 0.0D+00
+
+  else if ( x <= 16.0D+00 ) then
+
+    xr = -0.25D+00 * x2
+    ci = el + log ( x ) + xr
+    do k = 2, 40
+      xr = -0.5D+00 * xr * ( k - 1 ) / ( k * k * ( 2 * k - 1 ) ) * x2
+      ci = ci + xr
+      if ( abs ( xr ) < abs ( ci ) * eps ) then
+        exit
+      end if
+    end do
+
+    xr = x
+    si = x
+    do k = 1, 40
+      xr = -0.5D+00 * xr * ( 2 * k - 1 ) / k / ( 4 * k * k + 4 * k + 1 ) * x2
+      si = si + xr
+      if ( abs ( xr ) < abs ( si ) * eps ) then
+        return
+      end if
+    end do
+
+  else if ( x <= 32.0D+00 ) then
+
+    m = int ( 47.2D+00 + 0.82D+00 * x )
+    xa1 = 0.0D+00
+    xa0 = 1.0D-100
+    do k = m, 1, -1
+      xa = 4.0D+00 * k * xa0 / x - xa1
+      bj(k) = xa
+      xa1 = xa0
+      xa0 = xa
+    end do
+    xs = bj(1)
+    do k = 3, m, 2
+      xs = xs + 2.0D+00 * bj(k)
+    end do
+    bj(1) = bj(1) / xs
+    do k = 2, m
+      bj(k) = bj(k) / xs
+    end do
+    xr = 1.0D+00
+    xg1 = bj(1)
+    do k = 2, m
+      xr = 0.25D+00 * xr * ( 2.0D+00 * k - 3.0D+00 ) **2 &
+        / ( ( k - 1.0D+00 ) * ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) * x
+      xg1 = xg1 + bj(k) * xr
+    end do
+
+    xr = 1.0D+00
+    xg2 = bj(1)
+    do k = 2, m
+      xr = 0.25D+00 * xr * ( 2.0D+00 * k - 5.0D+00 )**2 &
+        / ( ( k-1.0D+00 ) * ( 2.0D+00 * k - 3.0D+00 ) ** 2 ) * x
+      xg2 = xg2 + bj(k) * xr
+    end do
+
+    xcs = cos ( x / 2.0D+00 )
+    xss = sin ( x / 2.0D+00 )
+    ci = el + log ( x ) - x * xss * xg1 + 2.0 * xcs * xg2 - 2.0 * xcs * xcs
+    si = x * xcs * xg1 + 2.0 * xss * xg2 - sin ( x )
+
+  else
+
+    xr = 1.0D+00
+    xf = 1.0D+00
+    do k = 1, 9
+      xr = -2.0D+00 * xr * k * ( 2 * k - 1 ) / x2
+      xf = xf + xr
+    end do
+    xr = 1.0D+00 / x
+    xg = xr
+    do k = 1, 8
+      xr = -2.0D+00 * xr * ( 2 * k + 1 ) * k / x2
+      xg = xg + xr
+    end do
+    ci = xf * sin ( x ) / x - xg * cos ( x ) / x
+    si = p2 - xf * cos ( x ) / x - xg * sin ( x ) / x
+
+  end if
+
+  return
+end
+subroutine cisib ( x, ci, si )
+
+!*****************************************************************************80
+!
+!! CISIB computes cosine and sine integrals.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    20 March 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument of Ci(x) and Si(x).
+!
+!    Output, real ( kind = 8 ) CI, SI, the values of Ci(x) and Si(x).
+!
+  implicit none
+
+  real ( kind = 8 ) ci
+  real ( kind = 8 ) fx
+  real ( kind = 8 ) gx
+  real ( kind = 8 ) si
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x2
+
+  x2 = x * x
+
+  if ( x == 0.0D+00 ) then
+
+    ci = -1.0D+300
+    si = 0.0D+00
+
+  else if ( x <= 1.0D+00 ) then
+
+    ci = (((( -3.0D-08        * x2 &
+             + 3.10D-06     ) * x2 &
+             - 2.3148D-04   ) * x2 &
+             + 1.041667D-02 ) * x2 &
+             - 0.25D+00     ) * x2 + 0.577215665D+00 + log ( x )
+
+     si = (((( 3.1D-07        * x2 &
+             - 2.834D-05    ) * x2 &
+             + 1.66667D-03  ) * x2 &
+             - 5.555556D-02 ) * x2 + 1.0D+00 ) * x
+
+  else
+
+    fx = (((( x2              &
+      + 38.027264D+00  ) * x2 &
+      + 265.187033D+00 ) * x2 &
+      + 335.67732D+00  ) * x2 &
+      + 38.102495D+00  ) /    &
+      (((( x2                 &
+      + 40.021433D+00  ) * x2 &
+      + 322.624911D+00 ) * x2 &
+      + 570.23628D+00  ) * x2 &
+      + 157.105423D+00 )
+
+    gx = (((( x2               &
+      + 42.242855D+00  ) * x2  &
+      + 302.757865D+00 ) * x2  &
+      + 352.018498D+00 ) * x2  &
+      + 21.821899D+00 ) /      &
+      (((( x2                  &
+      + 48.196927D+00   ) * x2 &
+      + 482.485984D+00  ) * x2 &
+      + 1114.978885D+00 ) * x2 &
+      + 449.690326D+00  ) / x
+
+    ci = fx * sin ( x ) / x - gx * cos ( x ) / x
+
+    si = 1.570796327D+00 - fx * cos ( x ) / x - gx * sin ( x ) / x
+
+  end if
+
+  return
+end
+subroutine cjk ( km, a )
+
+!*****************************************************************************80
+!
+!! CJK: asymptotic expansion coefficients for Bessel functions of large order.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    01 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) KM, the maximum value of K.
+!
+!    Output, real ( kind = 8 ) A(L), the value of Cj(k) where j and k are 
+!    related to L by L = j+1+[k*(k+1)]/2; j,k = 0,1,...,Km.
+!
+  implicit none
+
+  real ( kind = 8 ) a(*)
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) g
+  real ( kind = 8 ) g0
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) km
+  integer ( kind = 4 ) l1
+  integer ( kind = 4 ) l2
+  integer ( kind = 4 ) l3
+  integer ( kind = 4 ) l4
+
+  a(1) = 1.0D+00
+  f0 = 1.0D+00
+  g0 = 1.0D+00
+  do k = 0, km - 1
+    l1 = ( k + 1 ) * ( k + 2 ) / 2 + 1
+    l2 = ( k + 1 ) * ( k + 2 ) / 2 + k + 2
+    f = ( 0.5D+00 * k + 0.125D+00 / ( k + 1 ) ) * f0
+    g = - ( 1.5D+00 * k + 0.625D+00 &
+      / ( 3.0D+00 * ( k + 1.0D+00 ) ) ) * g0
+    a(l1) = f
+    a(l2) = g
+    f0 = f
+    g0 = g
+  end do
+
+  do k = 1, km - 1
+    do j = 1, k
+      l3 = k * ( k + 1 ) / 2 + j + 1
+      l4 = ( k + 1 ) * ( k + 2 ) / 2 + j + 1
+      a(l4) = ( j + 0.5D+00 * k + 0.125D+00 &
+        / ( 2.0D+00 * j + k + 1.0D+00 ) ) * a(l3) &
+        - ( j + 0.5D+00 * k - 1.0D+00 + 0.625D+00 &
+        / ( 2.0D+00 * j + k + 1.0D+00 ) ) * a(l3-1)
+    end do
+  end do
+
+  return
+end
+subroutine cjy01 ( z, cbj0, cdj0, cbj1, cdj1, cby0, cdy0, cby1, cdy1 )
+
+!*****************************************************************************80
+!
+!! CJY01: complexBessel functions, derivatives, J0(z), J1(z), Y0(z), Y1(z).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    02 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+! 
+!  Parameters:
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, complex ( kind = 8 ) CBJ0, CDJ0, CBJ1, CDJ1, CBY0, CDY0, CBY1, 
+!    CDY1, the values of J0(z), J0'(z), J1(z), J1'(z), Y0(z), Y0'(z), 
+!    Y1(z), Y1'(z).
+!
+  implicit none
+
+  real ( kind = 8 ), save, dimension ( 12 ) :: a = (/ &
+    -0.703125D-01,0.112152099609375D+00, &
+    -0.5725014209747314D+00,0.6074042001273483D+01, &
+    -0.1100171402692467D+03,0.3038090510922384D+04, &
+    -0.1188384262567832D+06,0.6252951493434797D+07, &
+    -0.4259392165047669D+09,0.3646840080706556D+11, &
+    -0.3833534661393944D+13,0.4854014686852901D+15 /)
+  real ( kind = 8 ) a0
+  real ( kind = 8 ), save, dimension ( 12 ) :: a1 = (/ &
+    0.1171875D+00,-0.144195556640625D+00, &
+    0.6765925884246826D+00,-0.6883914268109947D+01, &
+    0.1215978918765359D+03,-0.3302272294480852D+04, &
+    0.1276412726461746D+06,-0.6656367718817688D+07, &
+    0.4502786003050393D+09,-0.3833857520742790D+11, &
+    0.4011838599133198D+13,-0.5060568503314727D+15 /)
+  real ( kind = 8 ), save, dimension ( 12 ) :: b = (/ &
+    0.732421875D-01,-0.2271080017089844D+00, &
+    0.1727727502584457D+01,-0.2438052969955606D+02, &
+    0.5513358961220206D+03,-0.1825775547429318D+05, &
+    0.8328593040162893D+06,-0.5006958953198893D+08, &
+    0.3836255180230433D+10,-0.3649010818849833D+12, &
+    0.4218971570284096D+14,-0.5827244631566907D+16 /)
+  real ( kind = 8 ), save, dimension ( 12 ) :: b1 = (/ &
+    -0.1025390625D+00,0.2775764465332031D+00, &
+    -0.1993531733751297D+01,0.2724882731126854D+02, &
+    -0.6038440767050702D+03,0.1971837591223663D+05, &
+    -0.8902978767070678D+06,0.5310411010968522D+08, &
+    -0.4043620325107754D+10,0.3827011346598605D+12, &
+    -0.4406481417852278D+14,0.6065091351222699D+16 /)
+  complex ( kind = 8 ) cbj0
+  complex ( kind = 8 ) cbj1
+  complex ( kind = 8 ) cby0
+  complex ( kind = 8 ) cby1
+  complex ( kind = 8 ) cdj0
+  complex ( kind = 8 ) cdj1
+  complex ( kind = 8 ) cdy0
+  complex ( kind = 8 ) cdy1
+  complex ( kind = 8 ) ci
+  complex ( kind = 8 ) cp
+  complex ( kind = 8 ) cp0
+  complex ( kind = 8 ) cp1
+  complex ( kind = 8 ) cq0
+  complex ( kind = 8 ) cq1
+  complex ( kind = 8 ) cr
+  complex ( kind = 8 ) cs
+  complex ( kind = 8 ) ct1
+  complex ( kind = 8 ) ct2
+  complex ( kind = 8 ) cu
+  real ( kind = 8 ) el
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k0
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) rp2
+  real ( kind = 8 ) w0
+  real ( kind = 8 ) w1
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) z1
+  complex ( kind = 8 ) z2
+
+  pi = 3.141592653589793D+00
+  el = 0.5772156649015329D+00
+  rp2 = 2.0D+00 / pi
+  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
+  a0 = abs ( z )
+  z2 = z * z
+  z1 = z
+
+  if ( a0 == 0.0D+00 ) then
+    cbj0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cbj1 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+    cdj0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+    cdj1 = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
+    cby0 = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    cby1 = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    cdy0 = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    cdy1 = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    return
+  end if
+
+  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
+    z1 = -z
+  end if
+
+  if ( a0 <= 12.0D+00 ) then
+
+    cbj0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 40
+      cr = -0.25D+00 * cr * z2 / ( k * k )
+      cbj0 = cbj0 + cr
+      if ( abs ( cr ) < abs ( cbj0 ) * 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    cbj1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 40
+      cr = -0.25D+00 * cr * z2 / ( k * ( k + 1.0D+00 ) )
+      cbj1 = cbj1 + cr
+      if ( abs ( cr ) < abs ( cbj1 ) * 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    cbj1 = 0.5D+00 * z1 * cbj1
+    w0 = 0.0D+00
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cs = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 40
+      w0 = w0 + 1.0D+00 / k
+      cr = -0.25D+00 * cr / ( k * k ) * z2
+      cp = cr * w0
+      cs = cs + cp
+      if ( abs ( cp ) < abs ( cs ) * 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    cby0 = rp2 * ( log ( z1 / 2.0D+00 ) + el ) * cbj0 - rp2 * cs
+    w1 = 0.0D+00
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cs = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 40
+      w1 = w1 + 1.0D+00 / k
+      cr = -0.25D+00 * cr / ( k * ( k + 1 ) ) * z2
+      cp = cr * ( 2.0D+00 * w1 + 1.0D+00 / ( k + 1.0D+00 ) )
+      cs = cs + cp
+      if ( abs ( cp ) < abs ( cs ) * 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    cby1 = rp2 * ( ( log ( z1 / 2.0D+00 ) + el ) * cbj1 &
+      - 1.0D+00 / z1 - 0.25D+00 * z1 * cs )
+
+  else
+
+    if ( a0 < 35.0D+00 ) then
+      k0 = 12
+    else if ( a0 < 50.0D+00 ) then
+      k0 = 10
+    else
+      k0 = 8
+    end if
+
+    ct1 = z1 - 0.25D+00 * pi
+
+    cp0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, k0
+      cp0 = cp0 + a(k) * z1 ** ( - 2 * k )
+    end do
+
+    cq0 = -0.125D+00 / z1
+    do k = 1, k0
+      cq0 = cq0 + b(k) * z1 ** ( - 2 * k - 1 )
+    end do
+
+    cu = sqrt ( rp2 / z1 )
+    cbj0 = cu * ( cp0 * cos ( ct1 ) - cq0 * sin ( ct1 ) )
+    cby0 = cu * ( cp0 * sin ( ct1 ) + cq0 * cos ( ct1 ) )
+    ct2 = z1 - 0.75D+00 * pi
+
+    cp1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, k0
+      cp1 = cp1 + a1(k) * z1 ** ( - 2 * k )
+    end do
+
+    cq1 = 0.375D+00 / z1
+    do k = 1, k0
+      cq1 = cq1 + b1(k) * z1 ** ( - 2 * k - 1 )
+    end do
+
+    cbj1 = cu * ( cp1 * cos ( ct2 ) - cq1 * sin ( ct2 ) )
+    cby1 = cu * ( cp1 * sin ( ct2 ) + cq1 * cos ( ct2 ) )
+
+  end if
+
+  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
+    if ( imag ( z ) < 0.0D+00 ) then
+      cby0 =     cby0 - 2.0D+00 * ci * cbj0
+      cby1 = - ( cby1 - 2.0D+00 * ci * cbj1 )
+    else
+      cby0 =     cby0 + 2.0D+00 * ci * cbj0
+      cby1 = - ( cby1 + 2.0D+00 * ci * cbj1 )
+    end if
+    cbj1 = -cbj1
+  end if
+
+  cdj0 = -cbj1
+  cdj1 = cbj0 - 1.0D+00 / z * cbj1
+  cdy0 = -cby1
+  cdy1 = cby0 - 1.0D+00 / z * cby1
+
+  return
+end
+subroutine cjylv ( v, z, cbjv, cdjv, cbyv, cdyv )
+
+!*****************************************************************************80
+!
+!! CJYLV: Bessel functions Jv(z), Yv(z) of complex argument and large order v.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    25 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) V, the order of Jv(z) and Yv(z).
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, complex ( kind = 8 ) CBJV, CDJV, CBYV, CDYV, the values of Jv(z), 
+!    Jv'(z), Yv(z), Yv'(z).
+!
+  implicit none
+
+  real ( kind = 8 ) a(91)
+  complex ( kind = 8 ) cbjv
+  complex ( kind = 8 ) cbyv
+  complex ( kind = 8 ) cdjv
+  complex ( kind = 8 ) cdyv
+  complex ( kind = 8 ) ceta
+  complex ( kind = 8 ) cf(12)
+  complex ( kind = 8 ) cfj
+  complex ( kind = 8 ) cfy
+  complex ( kind = 8 ) csj
+  complex ( kind = 8 ) csy
+  complex ( kind = 8 ) ct
+  complex ( kind = 8 ) ct2
+  complex ( kind = 8 ) cws
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) km
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) l0
+  integer ( kind = 4 ) lf
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) v
+  real ( kind = 8 ) v0
+  real ( kind = 8 ) vr
+  complex ( kind = 8 ) z
+
+  km = 12
+  call cjk ( km, a )
+  pi = 3.141592653589793D+00
+
+  do l = 1, 0, -1
+
+    v0 = v - l
+    cws = sqrt ( 1.0D+00 - ( z / v0 ) * ( z / v0 ) )
+    ceta = cws + log ( z / v0 / ( 1.0D+00 + cws ) )
+    ct = 1.0D+00 / cws
+    ct2 = ct * ct
+
+    do k = 1, km
+      l0 = k * ( k + 1 ) / 2 + 1
+      lf = l0 + k
+      cf(k) = a(lf)
+      do i = lf - 1, l0, -1
+        cf(k) = cf(k) * ct2 + a(i)
+      end do
+      cf(k) = cf(k) * ct ** k
+    end do
+
+    vr = 1.0D+00 / v0
+    csj = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, km
+      csj = csj + cf(k) * vr ** k
+    end do
+    cbjv = sqrt ( ct / ( 2.0D+00 * pi * v0 ) ) * exp ( v0 * ceta ) * csj
+    if ( l == 1 ) then
+      cfj = cbjv
+    end if
+    csy = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, km
+      csy = csy + ( -1.0D+00 ) ** k * cf(k) * vr ** k
+    end do
+    cbyv = - sqrt ( 2.0D+00 * ct / ( pi * v0 ) ) * exp ( - v0 * ceta ) * csy
+    if ( l == 1 ) then
+      cfy = cbyv
+    end if
+
+  end do
+
+  cdjv = - v / z * cbjv + cfj
+  cdyv = - v / z * cbyv + cfy
+
+  return
+end
+subroutine cjyna ( n, z, nm, cbj, cdj, cby, cdy )
+
+!*****************************************************************************80
+!
+!! CJYNA: Bessel functions and derivatives, Jn(z) and Yn(z) of complex argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    02 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order of Jn(z) and Yn(z).
+!
+!    Input, complex ( kind = 8 ) Z, the argument of Jn(z) and Yn(z).
+!
+!    Output, integer ( kind = 4 ) NM, the highest order computed.
+!
+!    Output, complex ( kind = 8 ), CBJ(0:N), CDJ(0:N), CBY(0:N), CDY(0:N),
+!    the values of Jn(z), Jn'(z), Yn(z), Yn'(z).
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) a0
+  complex ( kind = 8 ) cbj(0:n)
+  complex ( kind = 8 ) cbj0
+  complex ( kind = 8 ) cbj1
+  complex ( kind = 8 ) cby(0:n)
+  complex ( kind = 8 ) cby0
+  complex ( kind = 8 ) cby1
+  complex ( kind = 8 ) cdj(0:n)
+  complex ( kind = 8 ) cdj0
+  complex ( kind = 8 ) cdj1
+  complex ( kind = 8 ) cdy(0:n)
+  complex ( kind = 8 ) cdy0
+  complex ( kind = 8 ) cdy1
+  complex ( kind = 8 ) cf
+  complex ( kind = 8 ) cf1
+  complex ( kind = 8 ) cf2
+  complex ( kind = 8 ) cg0
+  complex ( kind = 8 ) cg1
+  complex ( kind = 8 ) ch0
+  complex ( kind = 8 ) ch1
+  complex ( kind = 8 ) ch2
+  complex ( kind = 8 ) cj0
+  complex ( kind = 8 ) cj1
+  complex ( kind = 8 ) cjk
+  complex ( kind = 8 ) cp11
+  complex ( kind = 8 ) cp12
+  complex ( kind = 8 ) cp21
+  complex ( kind = 8 ) cp22
+  complex ( kind = 8 ) cs
+  complex ( kind = 8 ) cyk
+  complex ( kind = 8 ) cyl1
+  complex ( kind = 8 ) cyl2
+  complex ( kind = 8 ) cylk
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) lb
+  integer ( kind = 4 ) lb0
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) wa
+  real ( kind = 8 ) ya0
+  real ( kind = 8 ) ya1
+  real ( kind = 8 ) yak
+  complex ( kind = 8 ) z
+
+  pi = 3.141592653589793D+00
+  a0 = abs ( z )
+  nm = n
+
+  if ( a0 < 1.0D-100 ) then
+    do k = 0, n
+      cbj(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      cdj(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      cby(k) = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+      cdy(k) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    end do
+    cbj(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cdj(1) = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
+    return
+  end if
+
+  call cjy01 ( z, cbj0, cdj0, cbj1, cdj1, cby0, cdy0, cby1, cdy1 )
+  cbj(0) = cbj0
+  cbj(1) = cbj1
+  cby(0) = cby0
+  cby(1) = cby1
+  cdj(0) = cdj0
+  cdj(1) = cdj1
+  cdy(0) = cdy0
+  cdy(1) = cdy1
+
+  if ( n <= 1 ) then
+    return
+  end if
+
+  if ( n < int ( 0.25D+00 * a0 ) ) then
+
+    cj0 = cbj0
+    cj1 = cbj1
+    do k = 2, n
+      cjk = 2.0D+00 * ( k - 1.0D+00 ) / z * cj1 - cj0
+      cbj(k) = cjk
+      cj0 = cj1
+      cj1 = cjk
+    end do
+
+  else
+
+    m = msta1 ( a0, 200 )
+
+    if ( m < n ) then
+      nm = m
+    else
+      m = msta2 ( a0, n, 15 )
+    end if
+
+    cf2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 ) 
+    cf1 = cmplx ( 1.0D-30, 0.0D+00, kind = 8 )
+    do k = m, 0, -1
+      cf = 2.0D+00 * ( k + 1.0D+00 ) / z * cf1 - cf2
+      if ( k <= nm ) then
+        cbj(k) = cf
+      end if
+      cf2 = cf1
+      cf1 = cf
+    end do
+
+    if ( abs ( cbj1 ) < abs ( cbj0 ) ) then
+      cs = cbj0 / cf
+    else
+      cs = cbj1 / cf2
+    end if
+
+    do k = 0, nm
+      cbj(k) = cs * cbj(k)
+    end do
+
+  end if
+
+  do k = 2, nm
+    cdj(k) = cbj(k-1) - k / z * cbj(k)
+  end do
+  ya0 = abs ( cby0 )
+  lb = 0
+  cg0 = cby0
+  cg1 = cby1
+  do k = 2, nm
+    cyk = 2.0D+00 * ( k - 1.0D+00 ) / z * cg1 - cg0
+    if ( abs ( cyk ) <= 1.0D+290 ) then         
+      yak = abs ( cyk )
+      ya1 = abs ( cg0 )
+      if ( yak < ya0 .and. yak < ya1 ) then
+        lb = k
+      end if
+      cby(k) = cyk
+      cg0 = cg1
+      cg1 = cyk
+    end if
+  end do
+
+  if ( 4 < lb  .and. imag ( z ) /= 0.0D+00 ) then
+
+    do
+
+      if ( lb == lb0 ) then
+        exit
+      end if
+
+      ch2 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      ch1 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      lb0 = lb
+      do k = lb, 1, -1
+        ch0 = 2.0D+00 * k / z * ch1 - ch2
+        ch2 = ch1
+        ch1 = ch0
+      end do
+      cp12 = ch0
+      cp22 = ch2
+      ch2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      ch1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = lb, 1, -1
+        ch0 = 2.0D+00 * k / z * ch1 - ch2
+        ch2 = ch1
+        ch1 = ch0
+      end do
+      cp11 = ch0
+      cp21 = ch2
+
+      if ( lb == nm ) then
+        cbj(lb+1) = 2.0D+00 * lb / z * cbj(lb) - cbj(lb-1)
+      end if
+
+      if ( abs ( cbj(1) ) < abs ( cbj(0) ) ) then
+        cby(lb+1) = ( cbj(lb+1) * cby0 - 2.0D+00 * cp11 / ( pi * z ) ) / cbj(0)
+        cby(lb) = ( cbj(lb) * cby0 + 2.0D+00 * cp12 / ( pi * z ) ) / cbj(0)
+      else
+        cby(lb+1) = ( cbj(lb+1) * cby1 - 2.0D+00 * cp21 / ( pi * z ) ) / cbj(1)
+        cby(lb) = ( cbj(lb) * cby1 + 2.0D+00 * cp22 / ( pi * z ) )  / cbj(1)
+      end if
+
+      cyl2 = cby(lb+1)
+      cyl1 = cby(lb)
+      do k = lb - 1, 0, -1
+        cylk = 2.0D+00 * ( k + 1.0D+00 ) / z * cyl1 - cyl2
+        cby(k) = cylk
+        cyl2 = cyl1
+        cyl1 = cylk
+      end do
+
+      cyl1 = cby(lb)
+      cyl2 = cby(lb+1)
+      do k = lb + 1, nm - 1
+        cylk = 2.0D+00 * k / z * cyl2 - cyl1
+        cby(k+1) = cylk
+        cyl1 = cyl2
+        cyl2 = cylk
+      end do
+
+      do k = 2, nm
+        wa = abs ( cby(k) )
+        if ( wa < abs ( cby(k-1) ) ) then
+          lb = k
+        end if
+      end do
+
+    end do
+
+  end if
+
+  do k = 2, nm
+    cdy(k) = cby(k-1) - k / z * cby(k)
+  end do
+
+  return
+end
+subroutine cjynb ( n, z, nm, cbj, cdj, cby, cdy )
+
+!*****************************************************************************80
+!
+!! CJYNB: Bessel functions, derivatives, Jn(z) and Yn(z) of complex argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    03 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+! 
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order of Jn(z) and Yn(z).
+!
+!    Input, complex ( kind = 8 ) Z, the argument of Jn(z) and Yn(z).
+!
+!    Output, integer ( kind = 4 ) NM, the highest order computed.
+!
+!    Output, complex ( kind = 8 ) CBJ(0:N), CDJ(0:N), CBY(0:N), CDY(0:N), 
+!    the values of Jn(z), Jn'(z), Yn(z), Yn'(z).
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ), save, dimension ( 4 ) :: a = (/ &
+    -0.7031250000000000D-01, 0.1121520996093750D+00, &
+    -0.5725014209747314D+00, 0.6074042001273483D+01 /)
+  real ( kind = 8 ) a0
+  real ( kind = 8 ), save, dimension ( 4 ) :: a1 = (/ &
+    0.1171875000000000D+00,-0.1441955566406250D+00, &
+    0.6765925884246826D+00,-0.6883914268109947D+01 /)
+  real ( kind = 8 ), save, dimension ( 4 ) :: b = (/  &
+    0.7324218750000000D-01,-0.2271080017089844D+00, &
+    0.1727727502584457D+01,-0.2438052969955606D+02 /)
+  real ( kind = 8 ), save, dimension ( 4 ) :: b1 = (/ &
+   -0.1025390625000000D+00,0.2775764465332031D+00, &
+   -0.1993531733751297D+01,0.2724882731126854D+02 /)
+  complex ( kind = 8 ) cbj(0:n)
+  complex ( kind = 8 ) cbj0
+  complex ( kind = 8 ) cbj1
+  complex ( kind = 8 ) cbjk
+  complex ( kind = 8 ) cbs
+  complex ( kind = 8 ) cby(0:n)
+  complex ( kind = 8 ) cby0
+  complex ( kind = 8 ) cby1
+  complex ( kind = 8 ) cdj(0:n)
+  complex ( kind = 8 ) cdy(0:n)
+  complex ( kind = 8 ) ce
+  complex ( kind = 8 ) cf
+  complex ( kind = 8 ) cf1
+  complex ( kind = 8 ) cf2
+  complex ( kind = 8 ) cp0
+  complex ( kind = 8 ) cp1
+  complex ( kind = 8 ) cq0
+  complex ( kind = 8 ) cq1
+  complex ( kind = 8 ) cs0
+  complex ( kind = 8 ) csu
+  complex ( kind = 8 ) csv
+  complex ( kind = 8 ) ct1
+  complex ( kind = 8 ) ct2
+  complex ( kind = 8 ) cu
+  complex ( kind = 8 ) cyy
+  real ( kind = 8 ) el
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r2p
+  real ( kind = 8 ) y0
+  complex ( kind = 8 ) z
+
+  el = 0.5772156649015329D+00
+  pi = 3.141592653589793D+00
+  r2p = 0.63661977236758D+00
+  y0 = abs ( imag ( z ) )
+  a0 = abs ( z )
+  nm = n
+
+  if ( a0 < 1.0D-100 ) then
+    do k = 0, n
+      cbj(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      cdj(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      cby(k) = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+      cdy(k) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    end do
+    cbj(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cdj(1) = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
+    return
+  end if
+
+  if ( a0 <= 300.0D+00 .or. 80 < n ) then
+
+    if ( n == 0 ) then
+      nm = 1
+    end if
+    m = msta1 ( a0, 200 )
+    if ( m < nm ) then
+      nm = m
+    else
+      m = msta2 ( a0, nm, 15 )
+    end if
+
+    cbs = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+    csu = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+    csv = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+    cf2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+    cf1 = cmplx ( 1.0D-30, 0.0D+00, kind = 8 )
+
+    do k = m, 0, -1
+      cf = 2.0D+00 * ( k + 1.0D+00 ) / z * cf1 - cf2
+      if ( k <= nm ) then
+        cbj(k) = cf
+      end if
+      if ( k == 2 * int ( k / 2 ) .and. k .ne. 0 ) then
+        if ( y0 <= 1.0D+00 ) then
+          cbs = cbs + 2.0D+00 * cf
+        else
+          cbs = cbs + ( -1.0D+00 ) ** ( k / 2 ) * 2.0D+00 * cf
+        end if
+        csu = csu + ( -1.0D+00 ) ** ( k / 2 ) * cf / k
+      else if ( 1 < k ) then
+        csv = csv + ( -1.0D+00 ) ** ( k / 2 ) * k / ( k * k - 1.0D+00 ) * cf
+      end if
+      cf2 = cf1
+      cf1 = cf
+    end do
+
+    if ( y0 <= 1.0D+00 ) then
+      cs0 = cbs + cf
+    else
+      cs0 = ( cbs + cf ) / cos ( z )
+    end if
+
+    do k = 0, nm
+      cbj(k) = cbj(k) / cs0
+    end do
+
+    ce = log ( z / 2.0D+00 ) + el
+    cby(0) = r2p * ( ce * cbj(0) - 4.0D+00 * csu / cs0 )
+    cby(1) = r2p * ( - cbj(0) / z + ( ce - 1.0D+00 ) * cbj(1) &
+      - 4.0D+00 * csv / cs0 )
+
+  else
+
+    ct1 = z - 0.25D+00 * pi
+    cp0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 4
+      cp0 = cp0 + a(k) * z ** ( - 2 * k )
+    end do
+    cq0 = -0.125D+00 / z
+    do k = 1, 4
+      cq0 = cq0 + b(k) * z ** ( - 2 * k - 1 )
+    end do
+    cu = sqrt ( r2p / z )
+    cbj0 = cu * ( cp0 * cos ( ct1 ) - cq0 * sin ( ct1 ) )
+    cby0 = cu * ( cp0 * sin ( ct1 ) + cq0 * cos ( ct1 ) )
+    cbj(0) = cbj0
+    cby(0) = cby0
+    ct2 = z - 0.75D+00 * pi
+    cp1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 4
+      cp1 = cp1 + a1(k) * z ** ( - 2 * k )
+    end do
+    cq1 = 0.375D+00 / z
+    do k = 1, 4
+      cq1 = cq1 + b1(k) * z ** ( - 2 * k - 1 )
+    end do
+    cbj1 = cu * ( cp1 * cos ( ct2 ) - cq1 * sin ( ct2 ) )
+    cby1 = cu * ( cp1 * sin ( ct2 ) + cq1 * cos ( ct2 ) )
+    cbj(1) = cbj1
+    cby(1) = cby1
+    do k = 2, nm
+      cbjk = 2.0D+00 * ( k - 1.0D+00 ) / z * cbj1 - cbj0
+      cbj(k) = cbjk
+      cbj0 = cbj1
+      cbj1 = cbjk
+    end do
+  end if
+
+  cdj(0) = -cbj(1)
+  do k = 1, nm
+    cdj(k) = cbj(k-1) - k / z * cbj(k)
+  end do
+
+  if ( 1.0D+00 < abs ( cbj(0) ) ) then
+    cby(1) = ( cbj(1) * cby(0) - 2.0D+00 / ( pi * z ) ) / cbj(0)
+  end if
+
+  do k = 2, nm
+    if ( abs ( cbj(k-2) ) <= abs ( cbj(k-1) ) ) then
+      cyy = ( cbj(k) * cby(k-1) - 2.0D+00 / ( pi * z ) ) / cbj(k-1)
+    else
+      cyy = ( cbj(k) * cby(k-2) - 4.0D+00 * ( k - 1.0D+00 ) &
+        / ( pi * z * z ) ) / cbj(k-2)
+    end if
+    cby(k) = cyy
+  end do
+
+  cdy(0) = -cby(1)
+  do k = 1, nm
+    cdy(k) = cby(k-1) - k / z * cby(k)
+  end do
+
+  return
+end
+subroutine cjyva ( v, z, vm, cbj, cdj, cby, cdy )
+
+!*****************************************************************************80
+!
+!! CJYVA: Bessel functions and derivatives, Jv(z) and Yv(z) of complex argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    03 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) V, the order of Jv(z) and Yv(z).
+!
+!    Input, complex ( kind = 8 ), the argument.
+!
+!    Output, real ( kind = 8 ) VM, the highest order computed.
+!
+!    Output, real ( kind = 8 ) CBJ(0:*), CDJ(0:*), CBY(0:*), CDY(0:*), 
+!    the values of Jn+v0(z), Jn+v0'(z), Yn+v0(z), Yn+v0'(z).
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  complex ( kind = 8 ) ca
+  complex ( kind = 8 ) ca0
+  complex ( kind = 8 ) cb
+  complex ( kind = 8 ) cbj(0:*)
+  complex ( kind = 8 ) cby(0:*)
+  complex ( kind = 8 ) cck
+  complex ( kind = 8 ) cdj(0:*)
+  complex ( kind = 8 ) cdy(0:*)
+  complex ( kind = 8 ) cec
+  complex ( kind = 8 ) cf
+  complex ( kind = 8 ) cf0
+  complex ( kind = 8 ) cf1
+  complex ( kind = 8 ) cf2
+  complex ( kind = 8 ) cfac0
+  complex ( kind = 8 ) cfac1
+  complex ( kind = 8 ) cg0
+  complex ( kind = 8 ) cg1
+  complex ( kind = 8 ) ch0
+  complex ( kind = 8 ) ch1
+  complex ( kind = 8 ) ch2
+  complex ( kind = 8 ) ci
+  complex ( kind = 8 ) cju0
+  complex ( kind = 8 ) cju1
+  complex ( kind = 8 ) cjv0
+  complex ( kind = 8 ) cjv1
+  complex ( kind = 8 ) cjvl
+  complex ( kind = 8 ) cp11
+  complex ( kind = 8 ) cp12
+  complex ( kind = 8 ) cp21
+  complex ( kind = 8 ) cp22
+  complex ( kind = 8 ) cpz
+  complex ( kind = 8 ) cqz
+  complex ( kind = 8 ) cr
+  complex ( kind = 8 ) cr0
+  complex ( kind = 8 ) cr1
+  complex ( kind = 8 ) crp
+  complex ( kind = 8 ) crq
+  complex ( kind = 8 ) cs
+  complex ( kind = 8 ) cs0
+  complex ( kind = 8 ) cs1
+  complex ( kind = 8 ) csk
+  complex ( kind = 8 ) cyk
+  complex ( kind = 8 ) cyl1
+  complex ( kind = 8 ) cyl2
+  complex ( kind = 8 ) cylk
+  complex ( kind = 8 ) cyv0
+  complex ( kind = 8 ) cyv1
+  real ( kind = 8 ) ga
+  real ( kind = 8 ) gb
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k0
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) lb
+  integer ( kind = 4 ) lb0
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) pv0
+  real ( kind = 8 ) pv1
+  real ( kind = 8 ) rp2
+  real ( kind = 8 ) v
+  real ( kind = 8 ) v0
+  real ( kind = 8 ) vg
+  real ( kind = 8 ) vl
+  real ( kind = 8 ) vm
+  real ( kind = 8 ) vv
+  real ( kind = 8 ) w0
+  real ( kind = 8 ) w1
+  real ( kind = 8 ) wa
+  real ( kind = 8 ) ya0
+  real ( kind = 8 ) ya1
+  real ( kind = 8 ) yak
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) z1
+  complex ( kind = 8 ) z2
+  complex ( kind = 8 ) zk
+
+  pi = 3.141592653589793D+00
+  rp2 = 0.63661977236758D+00
+  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
+  a0 = abs ( z )
+  z1 = z
+  z2 = z * z
+  n = int ( v )
+  v0 = v - n
+  pv0 = pi * v0
+  pv1 = pi * ( 1.0D+00 + v0 )
+
+  if ( a0 < 1.0D-100 ) then
+
+    do k = 0, n
+      cbj(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      cdj(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      cby(k) = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+      cdy(k) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    end do
+
+    if ( v0 == 0.0D+00 ) then
+      cbj(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      cdj(1) = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
+    else
+      cdj(0) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    end if
+
+    vm = v                     
+    return
+
+  end if
+
+  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
+    z1 = -z
+  end if
+
+  if ( a0 <= 12.0D+00 ) then
+
+    do l = 0, 1
+      vl = v0 + l
+      cjvl = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, 40
+        cr = -0.25D+00 * cr * z2 / ( k * ( k + vl ) )
+        cjvl = cjvl + cr
+        if ( abs ( cr ) < abs ( cjvl ) * 1.0D-15 ) then
+          exit
+        end if
+      end do
+
+      vg = 1.0D+00 + vl
+      call gamma ( vg, ga )
+      ca = ( 0.5D+00 * z1 ) ** vl / ga
+
+      if ( l == 0 ) then
+        cjv0 = cjvl * ca
+      else
+        cjv1 = cjvl * ca
+      end if
+
+    end do
+
+  else
+
+    if ( a0 < 35.0D+00 ) then
+      k0 = 11
+    else if ( a0 <50.0D+00 ) then
+      k0 = 10
+    else
+      k0 = 8
+    end if
+
+    do j = 0, 1
+      vv = 4.0D+00 * ( j + v0 ) * ( j + v0 )
+      cpz = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      crp = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, k0
+        crp = - 0.78125D-02 * crp &
+          * ( vv - ( 4.0D+00 * k - 3.0D+00 ) ** 2 ) &
+          * ( vv - ( 4.0D+00 * k - 1.0D+00 ) ** 2 )  &
+          / ( k * ( 2.0D+00 * k - 1.0D+00 ) * z2 )
+        cpz = cpz + crp
+      end do
+      cqz = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      crq = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, k0
+        crq = -0.78125D-02 * crq &
+          * ( vv - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
+          * ( vv - ( 4.0D+00 * k + 1.0D+00 ) ** 2 ) &
+          / ( k * ( 2.0D+00 * k + 1.0D+00 ) * z2 )
+        cqz = cqz + crq
+      end do
+      cqz = 0.125D+00 * ( vv - 1.0D+00 ) * cqz / z1
+      zk = z1 - ( 0.5D+00 * ( j + v0 ) + 0.25D+00 ) * pi
+      ca0 = sqrt ( rp2 / z1 )
+      cck = cos ( zk )
+      csk = sin ( zk )
+      if ( j == 0 ) then
+        cjv0 = ca0 * ( cpz * cck - cqz * csk )
+        cyv0 = ca0 * ( cpz * csk + cqz * cck )
+      else if ( j == 1 ) then
+        cjv1 = ca0 * ( cpz * cck - cqz * csk )
+        cyv1 = ca0 * ( cpz * csk + cqz * cck )
+      end if
+    end do
+
+  end if
+
+  if ( a0 <= 12.0D+00 ) then
+
+    if ( v0 .ne. 0.0D+00 ) then
+
+      do l = 0, 1
+        vl = v0 + l
+        cjvl = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+        cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+        do k = 1, 40
+          cr = -0.25D+00 * cr * z2 / ( k * ( k - vl ) )
+          cjvl = cjvl + cr
+          if ( abs ( cr ) < abs ( cjvl ) * 1.0D-15 ) then
+            exit
+          end if
+        end do
+
+        vg = 1.0D+00 - vl
+        call gamma ( vg, gb )
+        cb = ( 2.0D+00 / z1 ) ** vl / gb
+        if ( l == 0 ) then
+          cju0 = cjvl * cb
+        else
+          cju1 = cjvl * cb
+        end if
+      end do
+      cyv0 = ( cjv0 * cos ( pv0 ) - cju0 ) / sin ( pv0 )
+      cyv1 = ( cjv1 * cos ( pv1 ) - cju1 ) / sin ( pv1 )
+
+    else
+
+      cec = log ( z1 / 2.0D+00 ) + 0.5772156649015329D+00
+      cs0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      w0 = 0.0D+00
+      cr0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, 30
+        w0 = w0 + 1.0D+00 / k
+        cr0 = -0.25D+00 * cr0 / ( k * k ) * z2
+        cs0 = cs0 + cr0 * w0
+      end do
+      cyv0 = rp2 * ( cec * cjv0 - cs0 )
+      cs1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      w1 = 0.0D+00
+      cr1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, 30
+        w1 = w1 + 1.0D+00 / k
+        cr1 = -0.25D+00 * cr1 / ( k * ( k + 1 ) ) * z2
+        cs1 = cs1 + cr1 * ( 2.0D+00 * w1 + 1.0D+00 / ( k + 1.0D+00 ) )
+      end do
+      cyv1 = rp2 * ( cec * cjv1 - 1.0D+00 / z1 - 0.25D+00 * z1 * cs1 )
+
+    end if
+
+  end if
+
+  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
+
+    cfac0 = exp ( pv0 * ci )
+    cfac1 = exp ( pv1 * ci )
+
+    if ( imag ( z ) < 0.0D+00 ) then
+      cyv0 = cfac0 * cyv0 - 2.0D+00 * ci * cos ( pv0 ) * cjv0
+      cyv1 = cfac1 * cyv1 - 2.0D+00 * ci * cos ( pv1 ) * cjv1
+      cjv0 = cjv0 / cfac0
+      cjv1 = cjv1 / cfac1
+    else if ( 0.0D+00 < imag ( z ) ) then
+      cyv0 = cyv0 / cfac0 + 2.0D+00 * ci * cos ( pv0 ) * cjv0
+      cyv1 = cyv1 / cfac1 + 2.0D+00 * ci * cos ( pv1 ) * cjv1
+      cjv0 = cfac0 * cjv0
+      cjv1 = cfac1 * cjv1
+    end if
+
+  end if
+
+  cbj(0) = cjv0
+  cbj(1) = cjv1
+
+  if ( 2 <= n .and. n <= int ( 0.25D+00 * a0 ) ) then
+
+    cf0 = cjv0
+    cf1 = cjv1
+    do k = 2, n
+      cf = 2.0D+00 * ( k + v0 - 1.0D+00 ) / z * cf1 - cf0
+      cbj(k) = cf
+      cf0 = cf1
+      cf1 = cf
+    end do
+
+  else if ( 2 <= n ) then
+
+    m = msta1 ( a0, 200 )
+    if ( m < n ) then
+      n = m
+    else
+      m = msta2 ( a0, n, 15 )
+    end if
+    cf2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+    cf1 = cmplx ( 1.0D-30, 0.0D+00, kind = 8 )
+    do k = m, 0, -1
+      cf = 2.0D+00 * ( v0 + k + 1.0D+00 ) / z * cf1 - cf2
+      if ( k <= n ) then
+        cbj(k) = cf
+      end if
+      cf2 = cf1
+      cf1 = cf
+    end do
+    if ( abs ( cjv1 ) < abs ( cjv0 ) ) then
+      cs = cjv0 / cf
+    else
+      cs = cjv1 / cf2
+    end if
+
+    do k = 0, n
+      cbj(k) = cs * cbj(k)
+    end do
+
+  end if
+
+    cdj(0) = v0 / z * cbj(0) - cbj(1)
+    do k = 1, n
+      cdj(k) = - ( k + v0 ) / z * cbj(k) + cbj(k-1)
+    end do
+
+    cby(0) = cyv0
+    cby(1) = cyv1
+    ya0 = abs ( cyv0 )
+    lb = 0
+    cg0 = cyv0
+    cg1 = cyv1
+    do k = 2, n
+      cyk = 2.0D+00 * ( v0 + k - 1.0D+00 ) / z * cg1 - cg0
+      if ( abs ( cyk ) <= 1.0D+290 ) then
+        yak = abs ( cyk )
+        ya1 = abs ( cg0 )
+        if ( yak < ya0 .and. yak < ya1 ) then
+          lb = k
+        end if
+        cby(k) = cyk
+        cg0 = cg1
+        cg1 = cyk
+      end if
+    end do
+
+    if ( 4 < lb .and. imag ( z ) /= 0.0D+00 ) then
+
+      do
+
+        if ( lb == lb0 ) then
+          exit
+        end if
+
+        ch2 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+        ch1 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+        lb0 = lb
+        do k = lb, 1, -1
+          ch0 = 2.0D+00 * ( k + v0 ) / z * ch1 - ch2
+          ch2 = ch1
+          ch1 = ch0
+        end do
+        cp12 = ch0
+        cp22 = ch2
+        ch2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+        ch1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+        do k = lb, 1, -1
+          ch0 = 2.0D+00 * ( k + v0 ) / z * ch1 - ch2
+          ch2 = ch1
+          ch1 = ch0
+        end do
+        cp11 = ch0
+        cp21 = ch2
+
+        if ( lb == n ) then
+          cbj(lb+1) = 2.0D+00 * ( lb + v0 ) / z * cbj(lb) - cbj(lb-1)
+        end if
+
+        if ( abs ( cbj(1) ) < abs ( cbj(0) ) ) then
+          cby(lb+1) = ( cbj(lb+1) * cyv0 - 2.0D+00 * cp11 / ( pi * z ) ) &
+            / cbj(0)
+          cby(lb) = ( cbj(lb) * cyv0 + 2.0D+00 * cp12 / ( pi * z ) ) / cbj(0)
+        else
+          cby(lb+1) = ( cbj(lb+1) * cyv1 - 2.0D+00 * cp21 / ( pi * z ) ) &
+            / cbj(1)
+          cby(lb) = ( cbj(lb) * cyv1 + 2.0D+00 * cp22 / ( pi * z ) ) / cbj(1)
+        end if
+
+        cyl2 = cby(lb+1)
+        cyl1 = cby(lb)
+        do k = lb - 1, 0, -1
+          cylk = 2.0D+00 * ( k + v0 + 1.0D+00 ) / z * cyl1 - cyl2
+          cby(k) = cylk
+          cyl2 = cyl1
+          cyl1 = cylk
+        end do
+
+      cyl1 = cby(lb)
+      cyl2 = cby(lb+1)
+      do k = lb + 1, n - 1
+        cylk = 2.0D+00 * ( k + v0 ) / z * cyl2 - cyl1
+        cby(k+1) = cylk
+        cyl1 = cyl2
+        cyl2 = cylk
+      end do
+
+      do k = 2, n
+        wa = abs ( cby(k) )
+        if ( wa < abs ( cby(k-1) ) ) then
+          lb = k
+        end if
+      end do
+
+    end do
+
+  end if
+
+  cdy(0) = v0 / z * cby(0) - cby(1)
+  do k = 1, n
+    cdy(k) = cby(k-1) - ( k + v0 ) / z * cby(k)
+  end do
+  vm = n + v0
+
+  return
+end
+subroutine cjyvb ( v, z, vm, cbj, cdj, cby, cdy )
+
+!*****************************************************************************80
+!
+!! CJYVB: Bessel functions and derivatives, Jv(z) and Yv(z) of complex argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    03 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) V, the order of Jv(z) and Yv(z).
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, real ( kind = 8 ) VM, the highest order computed.
+!
+!    Output, real ( kind = 8 ) CBJ(0:*), CDJ(0:*), CBY(0:*), CDY(0:*), 
+!    the values of Jn+v0(z), Jn+v0'(z), Yn+v0(z), Yn+v0'(z).
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  complex ( kind = 8 ) ca
+  complex ( kind = 8 ) ca0
+  complex ( kind = 8 ) cb
+  complex ( kind = 8 ) cbj(0:*)
+  complex ( kind = 8 ) cby(0:*)
+  complex ( kind = 8 ) cck
+  complex ( kind = 8 ) cdj(0:*)
+  complex ( kind = 8 ) cdy(0:*)
+  complex ( kind = 8 ) cec
+  complex ( kind = 8 ) cf
+  complex ( kind = 8 ) cf1
+  complex ( kind = 8 ) cf2
+  complex ( kind = 8 ) cfac0
+  complex ( kind = 8 ) ci
+  complex ( kind = 8 ) cju0
+  complex ( kind = 8 ) cjv0
+  complex ( kind = 8 ) cjvn
+  complex ( kind = 8 ) cpz
+  complex ( kind = 8 ) cqz
+  complex ( kind = 8 ) cr
+  complex ( kind = 8 ) cr0
+  complex ( kind = 8 ) crp
+  complex ( kind = 8 ) crq
+  complex ( kind = 8 ) cs
+  complex ( kind = 8 ) cs0
+  complex ( kind = 8 ) csk
+  complex ( kind = 8 ) cyv0
+  complex ( kind = 8 ) cyy
+  real ( kind = 8 ) ga
+  real ( kind = 8 ) gb
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k0
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) pv0
+  real ( kind = 8 ) rp2
+  real ( kind = 8 ) v
+  real ( kind = 8 ) v0
+  real ( kind = 8 ) vg
+  real ( kind = 8 ) vm
+  real ( kind = 8 ) vv
+  real ( kind = 8 ) w0
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) z1
+  complex ( kind = 8 ) z2
+  complex ( kind = 8 ) zk
+
+  pi = 3.141592653589793D+00
+  rp2 = 0.63661977236758D+00
+  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
+  a0 = abs ( z )
+  z1 = z
+  z2 = z * z
+  n = int ( v )
+  v0 = v - n
+  pv0 = pi * v0
+  
+  if ( a0 < 1.0D-100 ) then
+
+    do k = 0, n
+      cbj(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      cdj(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      cby(k) = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+      cdy(k) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    end do
+
+    if ( v0 == 0.0D+00 ) then
+      cbj(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      cdj(1) = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
+    else
+      cdj(0) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    end if
+
+    vm = v
+    return
+
+  end if
+
+  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
+    z1 = -z
+  end if
+
+  if ( a0 <= 12.0D+00 ) then
+
+    cjv0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 40
+      cr = -0.25D+00 * cr * z2 / ( k * ( k + v0 ) )
+      cjv0 = cjv0 + cr
+      if ( abs ( cr ) < abs ( cjv0 ) * 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    vg = 1.0D+00 + v0
+    call gamma ( vg, ga )
+    ca = ( 0.5D+00 * z1 ) ** v0 / ga
+    cjv0 = cjv0 * ca
+
+  else
+
+    if ( a0 < 35.0D+00 ) then
+      k0 = 11
+    else if ( a0 < 50.0D+00 ) then
+      k0 = 10
+    else
+      k0 = 8
+    end if
+
+    vv = 4.0D+00 * v0 * v0
+    cpz = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    crp = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, k0
+      crp = -0.78125D-02 * crp &
+        * ( vv - ( 4.0D+00 * k - 3.0D+00 ) ** 2 ) &
+        * ( vv - ( 4.0D+00 * k - 1.0D+00 ) **2 ) &
+        / ( k * ( 2.0D+00 * k - 1.0D+00 ) * z2 )
+      cpz = cpz + crp
+    end do
+    cqz = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    crq = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, k0
+      crq = -0.78125D-02 * crq &
+        * ( vv - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
+        * ( vv - ( 4.0D+00 * k + 1.0D+00 ) ** 2 ) &
+        / ( k * ( 2.0D+00 * k + 1.0D+00 ) * z2 )
+      cqz = cqz + crq
+    end do
+    cqz = 0.125D+00 * ( vv - 1.0D+00 ) * cqz / z1
+    zk = z1 - ( 0.5D+00 * v0 + 0.25D+00 ) * pi
+    ca0 = sqrt ( rp2 / z1 )
+    cck = cos ( zk )
+    csk = sin ( zk )
+    cjv0 = ca0 * ( cpz * cck - cqz * csk )
+    cyv0 = ca0 * ( cpz * csk + cqz * cck )
+
+  end if
+
+  if ( a0 <= 12.0D+00 ) then
+
+    if ( v0 .ne. 0.0D+00 ) then
+
+      cjvn = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, 40
+        cr = -0.25D+00 * cr * z2 / ( k * ( k - v0 ) )
+        cjvn = cjvn + cr
+        if ( abs ( cr ) < abs ( cjvn ) * 1.0D-15 ) then
+          exit
+        end if
+      end do
+
+      vg = 1.0D+00 - v0
+      call gamma ( vg, gb )
+      cb = ( 2.0D+00 / z1 ) ** v0 / gb
+      cju0 = cjvn * cb
+      cyv0 = ( cjv0 * cos ( pv0 ) - cju0 ) / sin ( pv0 )
+
+    else
+
+      cec = log ( z1 / 2.0D+00 ) + 0.5772156649015329D+00
+      cs0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      w0 = 0.0D+00
+      cr0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, 30
+        w0 = w0 + 1.0D+00 / k
+        cr0 = -0.25D+00 * cr0 / ( k * k ) * z2
+        cs0 = cs0 + cr0 * w0
+      end do
+      cyv0 = rp2 * ( cec * cjv0 - cs0 )
+
+    end if
+
+  end if
+
+  if ( n == 0 ) then
+    n = 1
+  end if
+
+  m = msta1 ( a0, 200 )
+  if ( m < n ) then
+    n = m
+  else
+    m = msta2 ( a0, n, 15 )
+  end if
+
+  cf2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+  cf1 = cmplx ( 1.0D-30, 0.0D+00, kind = 8 )
+  do k = m, 0, -1
+    cf = 2.0D+00 * ( v0 + k + 1.0D+00 ) / z1 * cf1 - cf2
+    if ( k <= n ) then
+      cbj(k) = cf
+    end if
+    cf2 = cf1
+    cf1 = cf
+  end do
+
+  cs = cjv0 / cf
+  do k = 0, n
+    cbj(k) = cs * cbj(k)
+  end do
+
+  if ( real ( z, kind = 8 ) < 0.0D+00) then
+
+    cfac0 = exp ( pv0 * ci )
+    if ( imag ( z ) < 0.0D+00 ) then
+      cyv0 = cfac0 * cyv0 - 2.0D+00 * ci * cos ( pv0 ) * cjv0
+    else if ( 0.0D+00 < imag ( z ) ) then
+      cyv0 = cyv0 / cfac0 + 2.0D+00 * ci * cos ( pv0 ) * cjv0
+    end if
+
+    do k = 0, n
+      if ( imag ( z ) < 0.0D+00) then
+        cbj(k) = exp ( - pi * ( k + v0 ) * ci ) * cbj(k)
+      else if ( 0.0D+00 < imag ( z ) ) then
+        cbj(k) = exp ( pi * ( k + v0 ) * ci ) * cbj(k)
+      end if
+    end do
+
+    z1 = z1
+
+  end if
+
+  cby(0) = cyv0
+  do k = 1, n
+    cyy = ( cbj(k) * cby(k-1) - 2.0D+00 / ( pi * z ) ) / cbj(k-1)
+    cby(k) = cyy
+  end do
+
+  cdj(0) = v0 / z * cbj(0) - cbj(1)
+  do k = 1, n
+    cdj(k) = - ( k + v0 ) / z * cbj(k) + cbj(k-1)
+  end do
+
+  cdy(0) = v0 / z * cby(0) - cby(1)
+  do k = 1, n
+    cdy(k) = cby(k-1) - ( k + v0 ) / z * cby(k)
+  end do
+
+  vm = n + v0
+
+  return
+end
+subroutine clpmn ( mm, m, n, x, y, cpm, cpd )
+
+!*****************************************************************************80
+!
+!! CLPMN: associated Legendre functions and derivatives for complex argument.
+!
+!  Discussion:
+!
+!    Compute the associated Legendre functions Pmn(z)   
+!    and their derivatives Pmn'(z) for a complex argument
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    01 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) MM, the physical dimension of CPM and CPD.
+!
+!    Input, integer ( kind = 4 ) M, N, the order and degree of Pmn(z).
+!
+!    Input, real ( kind = 8 ) X, Y, the real and imaginary parts of 
+!    the argument Z.
+!
+!    Output, complex ( kind = 8 ) CPM(0:MM,0:N), CPD(0:MM,0:N), the values of
+!    Pmn(z) and Pmn'(z).
+!
+  implicit none
+
+  integer ( kind = 4 ) mm
+
+  complex ( kind = 8 ) cpd(0:mm,0:n)
+  complex ( kind = 8 ) cpm(0:mm,0:n)
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) ls
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) x
+  real ( kind = 8 ) y
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) zq
+  complex ( kind = 8 ) zs
+
+  z = cmplx ( x, y, kind = 8 )
+
+  do i = 0, n
+    do j = 0, m
+      cpm(j,i) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      cpd(j,i) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+    end do
+  end do
+
+  cpm(0,0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+
+  if ( abs ( x ) == 1.0D+00 .and. y == 0.0D+00 ) then
+
+    do i = 1, n
+      cpm(0,i) = x ** i
+      cpd(0,i) = 0.5D+00 * i * ( i + 1 ) * x ** ( i + 1 )
+    end do
+
+    do j = 1, n
+      do i = 1, m
+        if ( i == 1 ) then
+          cpd(i,j) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+        else if ( i == 2 ) then
+          cpd(i,j) = -0.25D+00 &
+            * ( j + 2 ) * ( j + 1 ) * j * ( j - 1 ) * x ** ( j + 1 )
+        end if
+      end do
+    end do
+
+    return
+
+  end if
+
+  if ( 1.0D+00 < abs ( z ) ) then
+    ls = -1
+  else
+    ls = 1
+  end if
+
+  zq = sqrt ( ls * ( 1.0D+00 - z * z ) )
+  zs = ls * ( 1.0D+00 - z * z )
+  do i = 1, m
+    cpm(i,i) = -ls * ( 2.0D+00 * i - 1.0D+00 ) * zq * cpm(i-1,i-1)
+  end do
+  do i = 0, m
+    cpm(i,i+1) = ( 2.0D+00 * i + 1.0D+00 ) * z * cpm(i,i)
+  end do
+
+  do i = 0, m
+    do j = i + 2, n
+      cpm(i,j) = ( ( 2.0D+00 * j - 1.0D+00 ) * z * cpm(i,j-1) &
+        - ( i + j - 1.0D+00 ) * cpm(i,j-2) ) / ( j - i )
+    end do
+  end do
+
+  cpd(0,0) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+  do j = 1, n
+    cpd(0,j) = ls * j * ( cpm(0,j-1) - z * cpm(0,j) ) / zs
+  end do 
+
+  do i = 1, m
+    do j = i, n
+      cpd(i,j) = ls * i * z * cpm(i,j) / zs &
+        + ( j + i ) * ( j - i + 1.0D+00 ) / zq * cpm(i-1,j)
+    end do
+  end do
+
+  return
+end
+subroutine clpn ( n, x, y, cpn, cpd )
+
+!*****************************************************************************80
+!
+!! CLPN computes Legendre functions and derivatives for complex argument.
+!
+!  Discussion:
+!
+!    Compute Legendre polynomials Pn(z) and their derivatives Pn'(z) for 
+!    a complex argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    15 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the degree.
+!
+!    Input, real ( kind = 8 ) X, Y, the real and imaginary parts 
+!    of the argument.
+!
+!    Output, complex ( kind = 8 ) CPN(0:N), CPD(0:N), the values of Pn(z)
+!    and Pn'(z).
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  complex ( kind = 8 ) cp0
+  complex ( kind = 8 ) cp1
+  complex ( kind = 8 ) cpd(0:n)
+  complex ( kind = 8 ) cpf
+  complex ( kind = 8 ) cpn(0:n)
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) x
+  real ( kind = 8 ) y
+  complex ( kind = 8 ) z
+
+  z = cmplx ( x, y, kind = 8 )
+
+  cpn(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+  cpn(1) = z
+  cpd(0) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+  cpd(1) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+
+  cp0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+  cp1 = z
+  do k = 2, n
+    cpf = ( 2.0D+00 * k - 1.0D+00 ) / k * z * cp1 - ( k - 1.0D+00 ) / k * cp0
+    cpn(k) = cpf
+    if ( abs ( x ) == 1.0D+00 .and. y == 0.0D+00 ) then
+      cpd(k) = 0.5D+00 * x ** ( k + 1 ) * k * ( k + 1.0D+00 )
+    else
+      cpd(k) = k * ( cp1 - z * cpf ) / ( 1.0D+00 - z * z )
+    end if
+    cp0 = cp1
+    cp1 = cpf
+  end do
+
+  return
+end
+subroutine clqmn ( mm, m, n, x, y, cqm, cqd )
+
+!*****************************************************************************80
+!
+!! CLQMN: associated Legendre functions and derivatives for complex argument.
+!
+!  Discussion:
+!
+!    This procedure computes the associated Legendre functions of the second 
+!    kind, Qmn(z) and Qmn'(z), for a complex argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    02 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+! 
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) MM, the physical dimension of CQM and CQD.
+!
+!    Input, integer ( kind = 4 ) M, N, the order and degree of Qmn(z).
+!
+!    Input, real ( kind = 8 ) X, Y, the real and imaginary parts of the 
+!    argument Z.
+!
+!    Output, complex ( kind = 8 ) CQM(0:MM,0:N), CQD(0:MM,0:N), the values of
+!    Qmn(z) and Qmn'(z).
+!
+  implicit none
+
+  integer ( kind = 4 ) mm
+  integer ( kind = 4 ) n 
+
+  complex ( kind = 8 ) cq0
+  complex ( kind = 8 ) cq1
+  complex ( kind = 8 ) cq10
+  complex ( kind = 8 ) cqf
+  complex ( kind = 8 ) cqf0
+  complex ( kind = 8 ) cqf1
+  complex ( kind = 8 ) cqf2
+  complex ( kind = 8 ) cqm(0:mm,0:n)
+  complex ( kind = 8 ) cqd(0:mm,0:n)
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) km
+  integer ( kind = 4 ) ls
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xc
+  real ( kind = 8 ) y
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) zq
+  complex ( kind = 8 ) zs
+
+  z = cmplx ( x, y, kind = 8 )
+
+  if ( abs ( x ) == 1.0D+00 .and. y == 0.0D+00 ) then
+    do i = 0, m
+      do j = 0, n
+        cqm(i,j) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+        cqd(i,j) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+      end do
+    end do
+    return
+  end if
+
+  xc = abs ( z )
+
+  if ( imag ( z ) == 0.0D+00 .or. xc < 1.0D+00 ) then
+    ls = 1
+  end if
+
+  if ( 1.0D+00 < xc ) then
+    ls = -1
+  end if
+
+  zq = sqrt ( ls * ( 1.0D+00 - z * z ) )
+  zs = ls * ( 1.0D+00 - z * z )
+  cq0 = 0.5D+00 * log ( ls * ( 1.0D+00 + z ) / ( 1.0D+00 - z ) )
+
+  if ( xc < 1.0001D+00 ) then
+
+    cqm(0,0) = cq0
+    cqm(0,1) = z * cq0 - 1.0D+00
+    cqm(1,0) = -1.0D+00 / zq
+    cqm(1,1) = - zq * ( cq0 + z / ( 1.0D+00 - z * z ) )
+    do i = 0, 1
+      do j = 2, n
+        cqm(i,j) = ( ( 2.0D+00 * j - 1.0D+00 ) * z * cqm(i,j-1) &
+          - ( j + i - 1.0D+00 ) * cqm(i,j-2) ) / ( j - i )
+      end do
+    end do
+
+    do j = 0, n
+      do i = 2, m
+        cqm(i,j) = -2.0D+00 * ( i - 1.0D+00 ) * z / zq * cqm(i-1,j) &
+          - ls * ( j + i - 1.0D+00 ) * ( j - i + 2.0D+00 ) * cqm(i-2,j)
+      end do
+    end do
+
+  else
+
+    if ( 1.1D+00 < xc ) then
+      km = 40 + m + n
+    else
+      km = ( 40 + m + n ) * int ( - 1.0D+00 - 1.8D+00 * log ( xc - 1.0D+00 ) )
+    end if
+
+    cqf2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+    cqf1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = km, 0, -1
+      cqf0 = ( ( 2 * k + 3.0D+00 ) * z * cqf1 &
+        - ( k + 2.0D+00 ) * cqf2 ) / ( k + 1.0D+00 )
+      if ( k <= n ) then
+        cqm(0,k) = cqf0
+      end if
+      cqf2 = cqf1
+      cqf1 = cqf0
+    end do
+
+    do k = 0, n
+      cqm(0,k) = cq0 * cqm(0,k) / cqf0
+    end do
+ 
+    cqf2 = 0.0D+00
+    cqf1 = 1.0D+00
+    do k = km, 0, -1
+      cqf0 = ( ( 2 * k + 3.0D+00 ) * z * cqf1 &
+        - ( k + 1.0D+00 ) * cqf2 ) / ( k + 2.0D+00 )
+      if ( k <= n ) then
+        cqm(1,k) = cqf0
+      end if
+      cqf2 = cqf1
+      cqf1 = cqf0
+    end do
+
+    cq10 = -1.0D+00 / zq
+    do k = 0, n 
+      cqm(1,k) = cq10 * cqm(1,k) / cqf0
+    end do
+
+    do j = 0, n
+      cq0 = cqm(0,j)
+      cq1 = cqm(1,j)
+      do i = 0, m - 2
+        cqf = -2.0D+00 * ( i + 1 ) * z / zq * cq1 &
+          + ( j - i ) * ( j + i + 1.0D+00 ) * cq0
+        cqm(i+2,j) = cqf
+        cq0 = cq1
+        cq1 = cqf
+      end do
+    end do
+
+  end if
+
+  cqd(0,0) = ls / zs
+  do j = 1, n
+    cqd(0,j) = ls * j * ( cqm(0,j-1) - z * cqm(0,j) ) / zs
+  end do
+
+  do j = 0, n
+    do i = 1, m
+      cqd(i,j) = ls * i * z / zs * cqm(i,j) &
+        + ( i + j ) * ( j - i + 1.0D+00 ) / zq * cqm(i-1,j)
+    end do
+  end do
+
+  return
+end
+subroutine clqn ( n, x, y, cqn, cqd )
+
+!*****************************************************************************80
+!
+!! CLQN: Legendre function Qn(z) and derivative Wn'(z) for complex argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    01 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the degree of Qn(z).
+!
+!    Input, real ( kind = 8 ) X, Y, the real and imaginary parts of the 
+!    argument Z.
+!
+!    Output, complex ( kind = 8 ) CQN(0:N), CQD(0:N), the values of Qn(z) 
+!    and Qn'(z.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  complex ( kind = 8 ) cq0
+  complex ( kind = 8 ) cq1
+  complex ( kind = 8 ) cqf0
+  complex ( kind = 8 ) cqf1
+  complex ( kind = 8 ) cqf2
+  complex ( kind = 8 ) cqn(0:n)
+  complex ( kind = 8 ) cqd(0:n)
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) km
+  integer ( kind = 4 ) ls
+  real ( kind = 8 ) x
+  real ( kind = 8 ) y
+  complex ( kind = 8 ) z
+
+  z = cmplx ( x, y, kind = 8 )
+
+  if ( z == 1.0D+00 ) then
+    do k = 0, n
+      cqn(k) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+      cqd(k) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    end do
+    return
+  end if
+
+  if ( 1.0D+00 < abs ( z ) ) then
+    ls = -1
+  else
+    ls = +1
+  end if
+
+  cq0 = 0.5D+00 * log ( ls * ( 1.0D+00 + z ) / ( 1.0D+00 - z ) )
+  cq1 = z * cq0 - 1.0D+00
+  cqn(0) = cq0
+  cqn(1) = cq1
+
+  if ( abs ( z ) < 1.0001D+00 ) then
+
+    cqf0 = cq0
+    cqf1 = cq1
+    do k = 2, n
+      cqf2 = ( ( 2.0D+00 * k - 1.0D+00 ) * z * cqf1 &
+        - ( k - 1.0D+00 ) * cqf0 ) / k
+      cqn(k) = cqf2
+      cqf0 = cqf1
+      cqf1 = cqf2
+    end do
+
+  else
+
+    if ( 1.1D+00 < abs ( z ) ) then
+      km = 40 + n
+    else
+      km = ( 40 + n ) * int ( - 1.0D+00 &
+        - 1.8D+00 * log ( abs ( z - 1.0D+00 ) ) )
+    end if
+
+    cqf2 = 0.0D+00
+    cqf1 = 1.0D+00
+    do k = km, 0, -1
+      cqf0 = ( ( 2 * k + 3.0D+00 ) * z * cqf1 &
+        - ( k + 2.0D+00 ) * cqf2 ) / ( k + 1.0D+00 )
+      if ( k <= n ) then
+        cqn(k) = cqf0
+      end if
+      cqf2 = cqf1
+      cqf1 = cqf0
+    end do
+    do k = 0, n
+      cqn(k) = cqn(k) * cq0 / cqf0
+    end do
+  end if
+
+  cqd(0) = ( cqn(1) - z * cqn(0) ) / ( z * z - 1.0D+00 )
+  do k = 1, n
+    cqd(k) = ( k * z * cqn(k) - k * cqn(k-1) ) / ( z * z - 1.0D+00 )
+  end do
+
+  return
+end
+subroutine comelp ( hk, ck, ce )
+
+!*****************************************************************************80
+!
+!! COMELP computes complete elliptic integrals K(k) and E(k).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    07 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) HK, the modulus.  0 <= HK <= 1.
+!
+!    Output, real ( kind = 8 ) CK, CE, the values of K(HK) and E(HK).
+!
+  implicit none
+
+  real ( kind = 8 ) ae
+  real ( kind = 8 ) ak
+  real ( kind = 8 ) be
+  real ( kind = 8 ) bk
+  real ( kind = 8 ) ce
+  real ( kind = 8 ) ck
+  real ( kind = 8 ) hk
+  real ( kind = 8 ) pk
+
+  pk = 1.0D+00 - hk * hk
+
+  if ( hk == 1.0D+00 ) then
+
+    ck = 1.0D+300
+    ce = 1.0D+00
+
+  else
+
+    ak = ((( &
+        0.01451196212D+00   * pk &
+      + 0.03742563713D+00 ) * pk &
+      + 0.03590092383D+00 ) * pk &
+      + 0.09666344259D+00 ) * pk &
+      + 1.38629436112D+00
+
+    bk = ((( &
+        0.00441787012D+00   * pk &
+      + 0.03328355346D+00 ) * pk &
+      + 0.06880248576D+00 ) * pk &
+      + 0.12498593597D+00 ) * pk &
+      + 0.5D+00
+
+    ck = ak - bk * log ( pk )
+
+    ae = ((( &
+        0.01736506451D+00   * pk &
+      + 0.04757383546D+00 ) * pk &
+      + 0.0626060122D+00  ) * pk &
+      + 0.44325141463D+00 ) * pk &
+      + 1.0D+00
+
+    be = ((( &
+        0.00526449639D+00   * pk &
+      + 0.04069697526D+00 ) * pk &
+      + 0.09200180037D+00 ) * pk &
+      + 0.2499836831D+00  ) * pk
+
+    ce = ae - be * log ( pk )
+
+  end if
+
+  return
+end
+subroutine cpbdn ( n, z, cpb, cpd )
+
+!*****************************************************************************80
+!
+!! CPBDN: parabolic cylinder function Dn(z) and Dn'(z) for complex argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    29 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order.
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, complex ( kind = 8 ) CPB(0:N), CPD(0:N), the values of Dn(z) 
+!    and Dn'(z).
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) a0
+  complex ( kind = 8 ) c0
+  complex ( kind = 8 ) ca0
+  complex ( kind = 8 ) cf
+  complex ( kind = 8 ) cf0
+  complex ( kind = 8 ) cf1
+  complex ( kind = 8 ) cfa
+  complex ( kind = 8 ) cfb
+  complex ( kind = 8 ) cpb(0:n)
+  complex ( kind = 8 ) cpd(0:n)
+  complex ( kind = 8 ) cs0
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n0
+  integer ( kind = 4 ) n1
+  integer ( kind = 4 ) nm1
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) x
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) z1
+
+  pi = 3.141592653589793D+00
+  x = real ( z, kind = 8 )
+  a0 = abs ( z )
+  c0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+  ca0 = exp ( -0.25D+00 * z * z )
+
+  if ( 0 <= n ) then
+
+    cf0 = ca0
+    cf1 = z * ca0
+    cpb(0) = cf0
+    cpb(1) = cf1
+    do k = 2, n
+      cf = z * cf1 - ( k - 1.0D+00 ) * cf0
+      cpb(k) = cf
+      cf0 = cf1
+      cf1 = cf
+    end do
+
+  else
+
+    n0 = -n
+
+    if ( x <= 0.0D+00 .or. abs ( z ) == 0.0D+00 ) then
+
+      cf0 = ca0
+      cpb(0) = cf0
+      z1 = - z
+      if ( a0 <= 7.0D+00 ) then
+        call cpdsa ( -1, z1, cf1 )
+      else
+        call cpdla ( -1, z1, cf1 )
+      end if
+      cf1 = sqrt ( 2.0D+00 * pi ) / ca0 - cf1
+      cpb(1) = cf1
+      do k = 2, n0
+        cf = ( - z * cf1 + cf0 ) / ( k - 1.0D+00 )
+        cpb(k) = cf
+        cf0 = cf1
+        cf1 = cf
+      end do
+
+    else
+
+      if ( a0 <= 3.0D+00 ) then
+
+        call cpdsa ( -n0, z, cfa )
+        cpb(n0) = cfa
+        n1 = n0 + 1
+        call cpdsa ( -n1, z, cfb )
+        cpb(n1) = cfb
+        nm1 = n0 - 1
+        do k = nm1, 0, -1
+          cf = z * cfa + ( k + 1.0D+00 ) * cfb
+          cpb(k) = cf
+          cfb = cfa
+          cfa = cf
+        end do
+
+      else
+
+        m = 100 + abs ( n )
+        cfa = c0
+        cfb = cmplx ( 1.0D-30, 0.0D+00, kind = 8 )
+        do k = m, 0, -1
+          cf = z * cfb + ( k + 1.0D+00 ) * cfa
+          if ( k <= n0 ) then
+            cpb(k) = cf
+          end if
+          cfa = cfb
+          cfb = cf
+        end do
+        cs0 = ca0 / cf
+        do k = 0, n0
+          cpb(k) = cs0 * cpb(k)
+        end do
+
+      end if
+
+    end if
+
+  end if
+
+  cpd(0) = -0.5D+00 * z * cpb(0)
+
+  if ( 0 <= n ) then
+    do k = 1, n
+      cpd(k) = -0.5D+00 * z * cpb(k) + k * cpb(k-1)
+    end do
+  else
+    do k = 1, n0
+      cpd(k) = 0.5D+00 * z * cpb(k) - cpb(k-1)
+    end do
+  end if
+
+  return
+end
+subroutine cpdla ( n, z, cdn )
+
+!****************************************************************************80
+!
+!! CPDLA computes complex parabolic cylinder function Dn(z) for large argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    07 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer N, the order.
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, complex ( kind = 8 ) CDN, the function value.
+!
+  implicit none
+
+  complex ( kind = 8 ) cb0
+  complex ( kind = 8 ) cdn
+  complex ( kind = 8 ) cr
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) n
+  complex ( kind = 8 ) z
+
+  cb0 = z ** n * exp ( -0.25D+00 * z * z )
+  cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+  cdn = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+
+  do k = 1, 16
+
+    cr = -0.5D+00 * cr * ( 2.0D+00 * k - n - 1.0D+00 ) &
+      * ( 2.0D+00 * k - n - 2.0D+00 ) / ( k * z * z )
+
+    cdn = cdn + cr
+
+    if ( abs ( cr ) < abs ( cdn ) * 1.0D-12 ) then
+      exit
+    end if
+
+  end do
+
+  cdn = cb0 * cdn
+
+  return
+end
+subroutine cpdsa ( n, z, cdn )
+
+!*****************************************************************************80
+!
+!! CPDSA computes complex parabolic cylinder function Dn(z) for small argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    29 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order.
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, complex ( kind = 8 ) CDN, the value of DN(z).
+!
+  implicit none
+
+  complex ( kind = 8 ) ca0
+  complex ( kind = 8 ) cb0
+  complex ( kind = 8 ) cdn
+  complex ( kind = 8 ) cdw
+  complex ( kind = 8 ) cr
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) g0
+  real ( kind = 8 ) g1
+  real ( kind = 8 ) ga0
+  real ( kind = 8 ) gm
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) pd
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) sq2
+  real ( kind = 8 ) va0
+  real ( kind = 8 ) vm
+  real ( kind = 8 ) vt
+  real ( kind = 8 ) xn
+  complex ( kind = 8 ) z
+
+  eps = 1.0D-15
+  pi = 3.141592653589793D+00
+  sq2 = sqrt ( 2.0D+00 )
+  ca0 = exp ( - 0.25D+00 * z * z )
+  va0 = 0.5D+00 * ( 1.0D+00 - n )
+
+  if ( n == 0 ) then
+
+    cdn = ca0
+
+  else
+
+    if ( abs ( z ) == 0.0D+00 ) then
+
+      if ( va0 <= 0.0D+00 .and. va0 == int ( va0 ) ) then
+        cdn = 0.0D+00
+      else
+        call gaih ( va0, ga0 )
+        pd = sqrt ( pi ) / ( 2.0D+00 ** ( -0.5D+00 * n ) * ga0 )
+        cdn = cmplx ( pd, 0.0D+00, kind = 8 )
+      end if
+
+    else
+
+      xn = - n
+      call gaih ( xn, g1 )
+      cb0 = 2.0D+00 ** ( -0.5D+00 * n - 1.0D+00 ) * ca0 / g1
+      vt = -0.5D+00 * n
+      call gaih ( vt, g0 )
+      cdn = cmplx ( g0, 0.0D+00, kind = 8 )
+      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+
+      do m = 1, 250
+        vm = 0.5D+00 * ( m - n )
+        call gaih ( vm, gm )
+        cr = - cr * sq2 * z / m
+        cdw = gm * cr
+        cdn = cdn + cdw
+        if ( abs ( cdw ) < abs ( cdn ) * eps ) then
+          exit
+        end if
+      end do
+
+      cdn = cb0 * cdn
+
+    end if
+
+  end if
+
+  return
+end
+subroutine cpsi ( x, y, psr, psi )
+
+!*****************************************************************************80
+!
+!! CPSI computes the psi function for a complex argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    16 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, Y, the real and imaginary parts 
+!    of the argument.
+!
+!    Output, real ( kind = 8 ) PSR, PSI, the real and imaginary parts
+!    of the function value.
+!
+  implicit none
+
+  real ( kind = 8 ), save, dimension ( 8 ) :: a = (/ &
+    -0.8333333333333D-01, 0.83333333333333333D-02, &
+    -0.39682539682539683D-02, 0.41666666666666667D-02, &
+    -0.75757575757575758D-02, 0.21092796092796093D-01, &
+    -0.83333333333333333D-01, 0.4432598039215686D+00 /)
+  real ( kind = 8 ) ct2
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) psi
+  real ( kind = 8 ) psr
+  real ( kind = 8 ) ri
+  real ( kind = 8 ) rr
+  real ( kind = 8 ) th
+  real ( kind = 8 ) tm
+  real ( kind = 8 ) tn
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x0
+  real ( kind = 8 ) x1
+  real ( kind = 8 ) y
+  real ( kind = 8 ) y1
+  real ( kind = 8 ) z0
+  real ( kind = 8 ) z2
+
+  pi = 3.141592653589793D+00
+
+  if ( y == 0.0D+00 .and. x == int ( x ) .and. x <= 0.0D+00 ) then
+
+    psr = 1.0D+300
+    psi = 0.0D+00
+
+  else
+
+    if ( x < 0.0D+00 ) then
+      x1 = x
+      y1 = y
+      x = -x
+      y = -y
+    end if
+
+    x0 = x
+
+    if ( x < 8.0D+00 ) then
+      n = 8 - int ( x )
+      x0 = x + n
+    end if
+
+    if ( x0 == 0.0D+00 ) then
+      if ( y /= 0.0D+00 ) then
+        th = 0.5D+00 * pi
+      else
+        th = 0.0D+00
+      end if
+    else
+      th = atan ( y / x0 )
+    end if
+
+    z2 = x0 * x0 + y * y
+    z0 = sqrt ( z2 )
+    psr = log ( z0 ) - 0.5D+00 * x0 / z2
+    psi = th + 0.5D+00 * y / z2
+    do k = 1, 8
+      psr = psr + a(k) * z2 ** ( - k ) * cos ( 2.0D+00 * k * th )
+      psi = psi - a(k) * z2 ** ( - k ) * sin ( 2.0D+00 * k * th )
+    end do
+
+    if ( x < 8.0D+00 ) then
+      rr = 0.0D+00
+      ri = 0.0D+00
+      do k = 1, n
+        rr = rr + ( x0 - k ) / ( ( x0 - k ) ** 2.0D+00 + y * y )
+        ri = ri + y / ( ( x0 - k ) ** 2.0D+00 + y * y )
+      end do
+      psr = psr - rr
+      psi = psi + ri
+    end if
+
+    if ( x1 < 0.0D+00 ) then
+      tn = tan ( pi * x )
+      tm = tanh ( pi * y )
+      ct2 = tn * tn + tm * tm
+      psr = psr + x / ( x * x + y * y ) + pi * ( tn - tn * tm * tm ) / ct2
+      psi = psi - y / ( x * x + y * y ) - pi * tm * ( 1.0D+00 + tn * tn ) / ct2
+      x = x1
+      y = y1
+    end if
+
+  end if
+
+  return
+end
+subroutine csphik ( n, z, nm, csi, cdi, csk, cdk )
+
+!*****************************************************************************80
+!
+!! CSPHIK: complex modified spherical Bessel functions and derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    29 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+! 
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order of in(z) and kn(z).
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, integer ( kind = 4 ) NM, the highest order computed.
+!
+!    Output, complex ( kind = 8 ) CSI(0:N), CDI(0:N), CSK(0:N), CDK(0:N),
+!    the values of in(z), in'(z), kn(z), kn'(z).
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) a0
+  complex ( kind = 8 ) ccosh1
+  complex ( kind = 8 ) cdi(0:n)
+  complex ( kind = 8 ) cdk(0:n)
+  complex ( kind = 8 ) cf
+  complex ( kind = 8 ) cf0
+  complex ( kind = 8 ) cf1
+  complex ( kind = 8 ) ci
+  complex ( kind = 8 ) cs
+  complex ( kind = 8 ) csi(0:n)
+  complex ( kind = 8 ) csi0
+  complex ( kind = 8 ) csi1
+  complex ( kind = 8 ) csinh1
+  complex ( kind = 8 ) csk(0:n)
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) pi
+  complex ( kind = 8 ) z
+
+  pi = 3.141592653589793D+00
+  a0 = abs ( z )    
+  nm = n
+
+  if ( a0 < 1.0D-60 ) then
+    do k = 0, n
+      csi(k) = 0.0D+00
+      cdi(k) = 0.0D+00
+      csk(k) = 1.0D+300
+      cdk(k) = -1.0D+300
+    end do
+    csi(0) = 1.0D+00
+    cdi(1) = 0.3333333333333333D+00
+    return
+  end if
+
+  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
+  csinh1 = sin ( ci * z ) / ci
+  ccosh1 = cos ( ci * z )
+  csi0 = csinh1 / z
+  csi1 = ( - csinh1 / z + ccosh1 ) / z
+  csi(0) = csi0
+  csi(1) = csi1
+
+  if ( 2 <= n ) then
+
+    m = msta1 ( a0, 200 )
+    if ( m < n ) then
+      nm = m
+    else
+      m = msta2 ( a0, n, 15 )
+    end if
+
+    cf0 = 0.0D+00
+    cf1 = 1.0D+00-100
+    do k = m, 0, -1
+      cf = ( 2.0D+00 * k + 3.0D+00 ) * cf1 / z + cf0
+      if ( k <= nm ) then
+        csi(k) = cf
+      end if
+      cf0 = cf1
+      cf1 = cf
+    end do
+
+    if ( abs ( csi0 ) <= abs ( csi1 ) ) then
+      cs = csi1 / cf0
+    else
+      cs = csi0 / cf
+    end if
+
+    do k = 0, nm
+      csi(k) = cs * csi(k)
+    end do
+
+  end if
+
+  cdi(0) = csi(1)
+  do k = 1, nm
+    cdi(k) = csi(k-1) - ( k + 1.0D+00 ) * csi(k) / z
+  end do
+
+  csk(0) = 0.5D+00 * pi / z * exp ( - z )
+  csk(1) = csk(0) * ( 1.0D+00 + 1.0D+00 / z )
+  do k = 2, nm
+    if ( abs ( csi(k-2) ) < abs ( csi(k-1) ) ) then
+      csk(k) = ( 0.5D+00 * pi / ( z * z ) - csi(k) * csk(k-1) ) / csi(k-1)
+    else
+      csk(k) = ( csi(k) * csk(k-2) + ( k - 0.5D+00 ) * pi / z ** 3 ) / csi(k-2)
+    end if
+  end do
+
+  cdk(0) = -csk(1)
+  do k = 1, nm
+    cdk(k) = - csk(k-1) - ( k + 1.0D+00 ) * csk(k) / z
+  end do
+
+  return
+end
+subroutine csphjy ( n, z, nm, csj, cdj, csy, cdy )
+
+!*****************************************************************************80
+!
+!! CSPHJY: spherical Bessel functions jn(z) and yn(z) for complex argument.
+!
+!  Discussion:
+!
+!    This procedure computes spherical Bessel functions jn(z) and yn(z)
+!    and their derivatives for a complex argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    01 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+! 
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order of jn(z) and yn(z).
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, integer ( kind = 4 ) NM, the highest order computed.
+!
+!    Output, complex ( kind = 8 ) CSJ(0:N0, CDJ(0:N), CSY(0:N), CDY(0:N),
+!    the values of jn(z), jn'(z), yn(z), yn'(z).
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) a0
+  complex ( kind = 8 ) csj(0:n)
+  complex ( kind = 8 ) cdj(0:n)
+  complex ( kind = 8 ) csy(0:n)
+  complex ( kind = 8 ) cdy(0:n)
+  complex ( kind = 8 ) cf
+  complex ( kind = 8 ) cf0
+  complex ( kind = 8 ) cf1
+  complex ( kind = 8 ) cs
+  complex ( kind = 8 ) csa
+  complex ( kind = 8 ) csb
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) nm
+  complex ( kind = 8 ) z
+
+  a0 = abs ( z )
+  nm = n
+
+  if ( a0 < 1.0D-60 ) then
+    do k = 0, n
+      csj(k) = 0.0D+00
+      cdj(k) = 0.0D+00
+      csy(k) = -1.0D+300
+      cdy(k) = 1.0D+300
+    end do
+    csj(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cdj(1) = cmplx ( 0.333333333333333D+00, 0.0D+00, kind = 8 )
+    return
+  end if
+
+  csj(0) = sin ( z ) / z
+  csj(1) = ( csj(0) - cos ( z ) ) / z
+
+  if ( 2 <= n ) then
+    csa = csj(0)
+    csb = csj(1)
+    m = msta1 ( a0, 200 )
+    if ( m < n ) then
+      nm = m
+    else
+      m = msta2 ( a0, n, 15 )
+    end if
+    cf0 = 0.0D+00
+    cf1 = 1.0D+00-100
+    do k = m, 0, -1
+      cf = ( 2.0D+00 * k + 3.0D+00 ) * cf1 / z - cf0
+      if ( k <= nm ) then
+        csj(k) = cf
+      end if
+      cf0 = cf1
+      cf1 = cf
+    end do
+
+    if ( abs ( csa ) <= abs ( csb ) ) then
+      cs = csb / cf0
+    else
+      cs = csa / cf
+    end if
+
+    do k = 0, nm
+      csj(k) = cs * csj(k)
+    end do
+
+  end if
+
+  cdj(0) = ( cos ( z ) - sin ( z ) / z ) / z
+  do k = 1, nm
+    cdj(k) = csj(k-1) - ( k + 1.0D+00 ) * csj(k) / z
+  end do
+  csy(0) = - cos ( z ) / z
+  csy(1) = ( csy(0) - sin ( z ) ) / z
+  cdy(0) = ( sin ( z ) + cos ( z ) / z ) / z
+  cdy(1) = ( 2.0D+00 * cdy(0) - cos ( z ) )  / z
+
+  do k = 2, nm
+    if ( abs ( csj(k-2) ) < abs ( csj(k-1) ) ) then 
+      csy(k) = ( csj(k) * csy(k-1) - 1.0D+00 / ( z * z ) ) / csj(k-1)
+    else
+      csy(k) = ( csj(k) * csy(k-2) &
+        - ( 2.0D+00 * k - 1.0D+00 ) / z ** 3 ) / csj(k-2)
+    end if
+  end do
+
+  do k = 2, nm
+    cdy(k) = csy(k-1) - ( k + 1.0D+00 ) * csy(k) / z
+  end do
+
+  return
+end
+subroutine cv0 ( kd, m, q, a0 )
+
+!*****************************************************************************80
+!
+!! CV0 computes the initial characteristic value of Mathieu functions.
+!
+!  Discussion:
+!
+!    This procedure computes the initial characteristic value of Mathieu 
+!    functions for m <= 12 or q <= 300 or q <= m*m.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!   03 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) KD, the case code:
+!    1, for cem(x,q)  ( m = 0,2,4,...)
+!    2, for cem(x,q)  ( m = 1,3,5,...)
+!    3, for sem(x,q)  ( m = 1,3,5,...)
+!    4, for sem(x,q)  ( m = 2,4,6,...)
+!
+!    Input, integer ( kind = 4 ) M, the order of the functions.
+!
+!    Input, real ( kind = 8 ) Q, the parameter of the functions.
+!
+!    Output, real ( kind = 8 ) A0, the characteristic value.
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) q
+  real ( kind = 8 ) q2
+
+  q2 = q * q
+
+  if ( m == 0 ) then
+
+    if ( q <= 1.0D+00 ) then
+
+      a0 = ((( &
+          0.0036392D+00   * q2 &
+        - 0.0125868D+00 ) * q2 &
+        + 0.0546875D+00 ) * q2 &
+        - 0.5D+00 )       * q2
+
+    else if ( q <= 10.0D+00 ) then
+
+      a0 = (( &
+          3.999267D-03   * q &
+        - 9.638957D-02 ) * q &
+        - 0.88297D+00 )  * q &
+        + 0.5542818D+00 
+
+    else
+
+      call cvql ( kd, m, q, a0 )
+
+    end if
+
+  else if ( m == 1 ) then
+
+    if ( q <= 1.0D+00 .and. kd == 2 ) then
+
+      a0 = ((( &
+        - 6.51D-04 * q &
+        - 0.015625D+00 ) *  q &
+        - 0.125D+00 ) * q &
+        + 1.0D+00 ) * q &
+        + 1.0D+00 
+
+    else if ( q <= 1.0D+00 .and. kd == 3 ) then
+
+      a0 = ((( &
+        - 6.51D-04 * q &
+        + 0.015625D+00 ) * q &
+        - 0.125D+00 ) * q &
+        - 1.0D+00 ) * q &
+        + 1.0D+00
+ 
+    else if ( q <= 10.0D+00 .and. kd == 2 ) then
+
+      a0 = ((( &
+        - 4.94603D-04 * q &
+        + 1.92917D-02 ) * q &
+        - 0.3089229D+00 ) * q &
+        + 1.33372D+00 ) * q &
+        + 0.811752D+00 
+
+    else if ( q <= 10.0D+00 .and. kd == 3 ) then
+
+      a0 = (( &
+          1.971096D-03 * q &
+        - 5.482465D-02 ) * q &
+        - 1.152218D+00 ) * q &
+        + 1.10427D+00 
+
+    else
+
+      call cvql ( kd, m, q, a0 )
+
+    end if
+
+  else if ( m == 2 ) then
+
+    if ( q <= 1.0D+00 .and. kd == 1 ) then
+
+      a0 = ((( &
+        - 0.0036391D+00   * q2 &
+        + 0.0125888D+00 ) * q2 &
+        - 0.0551939D+00 ) * q2 &
+        + 0.416667D+00 )  * q2 + 4.0D+00 
+
+    else if ( q <= 1.0D+00 .and. kd == 4 ) then
+
+      a0 = (  &
+          0.0003617D+00 * q2  &
+        - 0.0833333D+00 ) * q2 + 4.0D+00 
+
+    else if ( q <= 15.0D+00 .and. kd == 1 ) then
+
+      a0 = ((( &
+          3.200972D-04    * q &
+        - 8.667445D-03 )  * q &
+        - 1.829032D-04 )  * q &
+        + 0.9919999D+00 ) * q &
+        + 3.3290504D+00 
+
+    else if ( q <= 10.0D+00 .and. kd == 4 ) then
+
+      a0 = (( &
+          2.38446D-03 * q &
+        - 0.08725329D+00 ) * q &
+        - 4.732542D-03 ) * q &
+        + 4.00909D+00 
+
+    else
+
+      call cvql ( kd, m, q, a0 )
+
+    end if
+
+  else if ( m == 3 ) then
+
+    if ( q <= 1.0D+00 .and. kd == 2 ) then
+      a0 = (( &
+          6.348D-04 * q &
+        + 0.015625D+00 ) * q &
+        + 0.0625 ) * q2  &
+        + 9.0D+00 
+    else if ( q <= 1.0D+00 .and. kd == 3 ) then
+      a0 = (( &
+          6.348D-04 * q &
+        - 0.015625D+00 ) * q &
+        + 0.0625D+00 ) * q2 &
+        + 9.0D+00 
+    else if ( q <= 20.0D+00 .and. kd == 2 ) then
+      a0 = ((( &
+          3.035731D-04 * q &
+        - 1.453021D-02 ) * q &
+        + 0.19069602D+00 ) * q &
+        - 0.1039356D+00 ) * q &
+        + 8.9449274D+00 
+    else if ( q <= 15.0D+00 .and. kd == 3 ) then
+      a0 = (( &
+          9.369364D-05 * q &
+        - 0.03569325D+00 ) * q &
+        + 0.2689874D+00 ) * q &
+        + 8.771735D+00 
+    else
+      call cvql ( kd, m, q, a0 )
+    end if
+
+  else if ( m == 4 ) then
+
+    if ( q <= 1.0D+00 .and. kd == 1 ) then
+      a0 = (( &
+        - 2.1D-06 * q2 &
+        + 5.012D-04 ) * q2 &
+        + 0.0333333 ) * q2 &
+        + 16.0D+00
+    else if ( q <= 1.0D+00 .and. kd == 4 ) then
+      a0 = (( &
+          3.7D-06 * q2 &
+        - 3.669D-04 ) * q2 &
+        + 0.0333333D+00 ) * q2 &
+        + 16.0D+00
+    else if ( q <= 25.0D+00 .and. kd == 1 ) then
+      a0 = ((( &
+          1.076676D-04 * q &
+        - 7.9684875D-03 ) * q &
+        + 0.17344854D+00 ) * q &
+        - 0.5924058D+00 ) * q &
+        + 16.620847D+00
+    else if ( q <= 20.0D+00 .and. kd == 4 ) then
+      a0 = (( &
+        - 7.08719D-04 * q &
+        + 3.8216144D-03 ) * q &
+        + 0.1907493D+00 ) * q &
+        + 15.744D+00
+    else
+      call cvql ( kd, m, q, a0 )
+    end if
+
+  else if ( m == 5 ) then
+
+    if ( q <= 1.0D+00 .and. kd == 2 ) then
+      a0 = (( &
+          6.8D-6 * q &
+        + 1.42D-05 ) * q2 &
+        + 0.0208333D+00 ) * q2 &
+        + 25.0D+00
+    else if ( q <= 1.0D+00 .and. kd == 3 ) then
+      a0 = (( &
+        - 6.8D-06 * q &
+        + 1.42D-05 ) * q2 &
+        + 0.0208333D+00 ) * q2 &
+        + 25.0D+00
+    else if ( q <= 35.0D+00 .and. kd == 2 ) then
+      a0 = ((( &
+          2.238231D-05 * q &
+        - 2.983416D-03 ) * q &
+        + 0.10706975D+00 ) * q &
+        - 0.600205D+00 ) * q &
+        + 25.93515D+00
+    else if ( q <= 25.0D+00 .and. kd == 3 ) then
+      a0 = (( &
+        - 7.425364D-04 * q &
+        + 2.18225D-02 ) * q &
+        + 4.16399D-02 ) * q &
+        + 24.897D+00
+    else
+      call cvql ( kd, m, q, a0 )
+    end if
+
+  else if ( m == 6 ) then
+
+    if ( q <= 1.0D+00 ) then
+      a0 = ( 0.4D-06 * q2 + 0.0142857 ) * q2 + 36.0D+00
+    else if ( q <= 40.0D+00 .and. kd == 1 ) then
+      a0 = ((( &
+        - 1.66846D-05 * q &
+        + 4.80263D-04 ) * q &
+        + 2.53998D-02 ) * q &
+        - 0.181233D+00 ) * q  &
+        + 36.423D+00
+    else if ( q <= 35.0D+00 .and. kd == 4 ) then
+      a0 = (( &
+        - 4.57146D-04 * q &
+        + 2.16609D-02 ) * q &
+        - 2.349616D-02 ) * q &
+        + 35.99251D+00
+    else
+      call cvql ( kd, m, q, a0 )
+    end if
+
+  else if ( m == 7 ) then
+
+    if ( q <= 10.0D+00 ) then
+      call cvqm ( m, q, a0 )
+    else if ( q <= 50.0D+00 .and. kd == 2 ) then
+      a0 = ((( &
+        - 1.411114D-05 * q &
+        + 9.730514D-04 ) * q &
+        - 3.097887D-03 ) * q &
+        + 3.533597D-02 ) * q &
+        + 49.0547D+00
+    else if ( q <= 40.0D+00 .and. kd == 3 ) then
+      a0 = (( &
+        - 3.043872D-04 * q &
+        + 2.05511D-02 ) * q &
+        - 9.16292D-02 ) * q &
+        + 49.19035D+00
+    else
+      call cvql ( kd, m, q, a0 )
+    end if
+
+  else if ( 8 <= m ) then
+
+    if ( q <= 3.0D+00 * m ) then
+      call cvqm ( m, q, a0 )
+    else if ( m * m .lt. q ) then
+      call cvql ( kd, m, q, a0 )
+    else if ( m == 8 .and. kd == 1 ) then
+      a0 = ((( &
+          8.634308D-06 * q &
+        - 2.100289D-03 ) * q &
+        + 0.169072D+00 ) * q &
+        - 4.64336D+00 ) * q &
+        + 109.4211D+00
+    else if ( m == 8 .and. kd == 4 ) then
+      a0 = (( &
+        - 6.7842D-05 * q &
+        + 2.2057D-03 ) * q &
+        + 0.48296D+00 ) * q &
+        + 56.59D+00
+    else if ( m == 9 .and. kd == 2 ) then
+      a0 = ((( &
+          2.906435D-06 * q &
+        - 1.019893D-03 ) * q &
+        + 0.1101965D+00 ) * q &
+        - 3.821851D+00 ) * q &
+        + 127.6098D+00
+    else if ( m == 9 .and. kd == 3 ) then
+      a0 = (( &
+        - 9.577289D-05 * q &
+        + 0.01043839D+00 ) * q &
+        + 0.06588934D+00 ) * q &
+        + 78.0198D+00
+    else if ( m == 10 .and. kd == 1 ) then
+      a0 = ((( &
+          5.44927D-07 * q &
+        - 3.926119D-04 ) * q &
+        + 0.0612099D+00 ) * q &
+        - 2.600805D+00 ) * q &
+        + 138.1923D+00
+    else if ( m == 10 .and. kd == 4 ) then
+      a0 = (( &
+        - 7.660143D-05 * q &
+        + 0.01132506D+00 ) * q &
+        - 0.09746023D+00 ) * q &
+        + 99.29494D+00
+    else if ( m == 11 .and. kd == 2 ) then
+      a0 = ((( &
+        - 5.67615D-07 * q &
+        + 7.152722D-06 ) * q &
+        + 0.01920291D+00 ) * q &
+        - 1.081583D+00 ) * q &
+        + 140.88D+00
+    else if ( m == 11 .and. kd == 3 ) then
+      a0 = (( &
+        - 6.310551D-05 * q &
+        + 0.0119247D+00 ) * q &
+        - 0.2681195D+00 ) * q &
+        + 123.667D+00 
+    else if ( m == 12 .and. kd == 1 ) then
+      a0 = ((( &
+        - 2.38351D-07 * q &
+        - 2.90139D-05 ) * q &
+        + 0.02023088D+00 ) * q &
+        - 1.289D+00 ) * q &
+        + 171.2723D+00
+    else if ( m == 12 .and. kd == 4 ) then
+      a0 = ((( &
+          3.08902D-07 * q &
+        - 1.577869D-04 ) * q &
+        + 0.0247911D+00 ) * q &
+        - 1.05454D+00 ) * q  &
+        + 161.471D+00
+
+    end if
+
+  end if
+
+  return
+end
+subroutine cva1 ( kd, m, q, cv )
+
+!*****************************************************************************80
+!
+!! CVA1 computes a sequence of characteristic values of Mathieu functions.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    25 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) KD, the case code.
+!    1, for cem(x,q)  ( m = 0,2,4,úúú )
+!    2, for cem(x,q)  ( m = 1,3,5,úúú )
+!    3, for sem(x,q)  ( m = 1,3,5,úúú )
+!    4, for sem(x,q)  ( m = 2,4,6,úúú )
+!
+!    Input, integer ( kind = 4 ) M, the maximum order of the Mathieu functions.
+!
+!    Input, real ( kind = 8 ) Q, the parameter of the Mathieu functions.
+!
+!    Output, real ( kind = 8 ) CV(*), characteristic values.
+!    For KD = 1, CV(1), CV(2), CV(3),..., correspond to
+!    the characteristic values of cem for m = 0,2,4,...
+!    For KD = 2, CV(1), CV(2), CV(3),..., correspond to
+!    the characteristic values of cem for m = 1,3,5,...
+!    For KD = 3, CV(1), CV(2), CV(3),..., correspond to
+!    the characteristic values of sem for m = 1,3,5,...
+!    For KD = 4, CV(1), CV(2), CV(3),..., correspond to
+!    the characteristic values of sem for m = 0,2,4,...
+!       
+  implicit none
+
+  real ( kind = 8 ) cv(200)
+  real ( kind = 8 ) d(500)
+  real ( kind = 8 ) e(500)
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) f(500)
+  real ( kind = 8 ) g(200)
+  real ( kind = 8 ) h(200)
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) ic
+  integer ( kind = 4 ) icm
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k1
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) nm
+  integer ( kind = 4 ) nm1
+  real ( kind = 8 ) q
+  real ( kind = 8 ) s
+  real ( kind = 8 ) t
+  real ( kind = 8 ) t1
+  real ( kind = 8 ) x1
+  real ( kind = 8 ) xa
+  real ( kind = 8 ) xb
+
+  eps = 1.0D-14
+
+  if ( kd == 4 ) then
+    icm = m / 2
+  else
+    icm = int ( m / 2 ) + 1
+  end if
+
+  if ( q == 0.0D+00 ) then
+
+    if ( kd == 1 ) then
+      do ic = 1, icm
+        cv(ic) = 4.0D+00 * ( ic - 1.0D+00 ) ** 2
+      end do
+    else if ( kd /= 4 ) then
+      do ic = 1, icm
+        cv(ic) = ( 2.0D+00 * ic - 1.0D+00 ) ** 2
+      end do
+    else
+      do ic = 1, icm
+        cv(ic) = 4.0D+00 * ic * ic
+      end do
+    end if
+
+  else
+
+    nm = int ( 10D+00 + 1.5D+00 * m + 0.5D+00 * q )
+    e(1) = 0.0D+00
+    f(1) = 0.0D+00
+
+    if ( kd == 1 ) then
+
+      d(1) = 0.0D+00
+      do i = 2, nm
+        d(i) = 4.0D+00 * ( i - 1.0D+00 ) ** 2
+        e(i) = q
+        f(i) = q * q
+      end do
+      e(2) = sqrt ( 2.0D+00 ) * q
+      f(2) = 2.0D+00 * q * q
+
+    else if ( kd /= 4 ) then
+
+      d(1) = 1.0D+00 + ( -1.0D+00 ) ** kd * q
+      do i = 2, nm
+        d(i) = ( 2.0D+00 * i - 1.0D+00 ) ** 2
+        e(i) = q
+        f(i) = q * q
+      end do
+
+    else
+
+      d(1) = 4.0D+00
+      do i = 2, nm
+        d(i) = 4.0D+00 * i * i
+        e(i) = q
+        f(i) = q * q
+      end do
+
+    end if
+
+    xa = d(nm) + abs ( e(nm) )
+    xb = d(nm) - abs ( e(nm) )
+
+    nm1 = nm - 1
+    do i = 1, nm1
+      t = abs ( e(i) ) + abs ( e(i+1) )
+      t1 = d(i) + t
+      xa = max ( xa, t1 )
+      t1 = d(i) - t
+      xb = min ( xb, t1 )
+    end do
+
+    do i = 1, icm
+      g(i) = xa
+      h(i) = xb
+    end do
+
+    do k = 1, icm
+
+      do k1 = k, icm
+        if ( g(k1) < g(k) ) then
+          g(k) = g(k1)
+          exit
+        end if
+      end do
+
+      if ( k /= 1 .and. h(k) < h(k-1) ) then
+        h(k) = h(k-1)
+      end if
+
+      do
+
+        x1 = ( g(k) + h(k) ) /2.0D+00
+        cv(k) = x1
+
+        if ( abs ( ( g(k) - h(k) ) / x1 ) < eps ) then
+          exit
+        end if
+
+        j = 0
+        s = 1.0D+00
+        do i = 1, nm
+          if ( s == 0.0D+00 ) then
+            s = s + 1.0D-30
+          end if
+          t = f(i) / s
+          s = d(i) - t - x1
+          if ( s < 0.0D+00 ) then
+            j = j + 1
+          end if
+        end do
+
+        if ( j < k ) then
+          h(k) = x1
+        else
+          g(k) = x1
+          if ( icm <= j ) then
+            g(icm) = x1
+          else
+            h(j+1) = max ( h(j+1), x1 )
+            g(j) = min ( g(j), x1 )
+          end if
+        end if
+
+      end do
+
+      cv(k) = x1
+
+    end do
+
+  end if
+
+  return
+end
+subroutine cva2 ( kd, m, q, a )
+
+!*****************************************************************************80
+!
+!! CVA2 computes a specific characteristic value of Mathieu functions.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    22 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) KD, the case code:
+!    1, for cem(x,q)  ( m = 0,2,4,...)
+!    2, for cem(x,q)  ( m = 1,3,5,...)
+!    3, for sem(x,q)  ( m = 1,3,5,...)
+!    4, for sem(x,q)  ( m = 2,4,6,...)
+!
+!    Input, integer ( kind = 4 ) M, the order of the Mathieu functions.
+!
+!    Input, real ( kind = 8 ) Q, the parameter of the Mathieu functions.
+!
+!    Output, real ( kind = 8 ) A, the characteristic value.
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) a1
+  real ( kind = 8 ) a2
+  real ( kind = 8 ) delta
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) iflag
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) ndiv
+  integer ( kind = 4 ) nn
+  real ( kind = 8 ) q
+  real ( kind = 8 ) q1
+  real ( kind = 8 ) q2
+  real ( kind = 8 ) qq
+
+  if ( m <= 12 .or. q <= 3.0D+00 * m .or. m * m < q ) then
+
+    call cv0 ( kd, m, q, a )
+
+    if ( q /= 0.0D+00 ) then
+      call refine ( kd, m, q, a, 1 )
+    end if
+
+  else
+
+    ndiv = 10
+    delta = ( m - 3.0D+00 ) * m / real ( ndiv, kind = 8 )
+
+    if ( ( q - 3.0D+00 * m ) <= ( m * m - q ) ) then
+
+      do
+
+        nn = int ( ( q - 3.0D+00 * m ) / delta ) + 1
+        delta = ( q - 3.0D+00 * m ) / nn
+        q1 = 2.0D+00 * m
+        call cvqm ( m, q1, a1 )
+        q2 = 3.0D+00 * m
+        call cvqm ( m, q2, a2 )
+        qq = 3.0D+00 * m
+ 
+        do i = 1, nn
+
+          qq = qq + delta
+          a = ( a1 * q2 - a2 * q1 + ( a2 - a1 ) * qq ) / ( q2 - q1 )
+ 
+          if ( i == nn ) then
+            iflag = -1
+          else
+            iflag = 1
+          end if
+
+          call refine ( kd, m, qq, a, iflag )
+          q1 = q2
+          q2 = qq
+          a1 = a2
+          a2 = a
+
+        end do
+
+        if ( iflag /= -10 ) then
+          exit
+        end if
+
+        ndiv = ndiv * 2
+        delta = ( m - 3.0D+00 ) * m / real ( ndiv, kind = 8 )
+
+      end do
+
+    else
+
+      do
+
+        nn = int ( ( m * m - q ) / delta ) + 1
+        delta = ( m * m - q ) / nn
+        q1 = m * ( m - 1.0D+00 )
+        call cvql ( kd, m, q1, a1 )
+        q2 = m * m
+        call cvql ( kd, m, q2, a2 )
+        qq = m * m
+
+        do i = 1, nn
+
+          qq = qq - delta
+          a = ( a1 * q2 - a2 * q1 + ( a2 - a1 ) * qq ) / ( q2 - q1 )
+
+          if ( i == nn ) then
+            iflag = -1
+          else
+            iflag = 1
+          end if
+
+          call refine ( kd, m, qq, a, iflag )
+          q1 = q2
+          q2 = qq
+          a1 = a2
+          a2 = a
+
+        end do
+
+        if ( iflag /= -10 ) then
+          exit
+        end if
+
+        ndiv = ndiv * 2
+        delta = ( m - 3.0D+00 ) * m / real ( ndiv, kind = 8 )
+
+      end do
+
+    end if
+
+  end if
+
+  return
+end
+subroutine cvf ( kd, m, q, a, mj, f )
+
+!*****************************************************************************80
+!
+!! CVF computes F for the characteristic equation of Mathieu functions.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    16 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) KD, the case code:
+!    1, for cem(x,q)  ( m = 0,2,4,...)
+!    2, for cem(x,q)  ( m = 1,3,5,...)
+!    3, for sem(x,q)  ( m = 1,3,5,...)
+!    4, for sem(x,q)  ( m = 2,4,6,...)
+!
+!    Input, integer ( kind = 4 ) M, the order of the Mathieu functions.
+!
+!    Input, real ( kind = 8 ) Q, the parameter of the Mathieu functions.
+!
+!    Input, real ( kind = 8 ) A, the characteristic value.
+!
+!    Input, integer ( kind = 4 ) MJ, ?
+!
+!    Output, real ( kind = 8 ) F, the value of the function for the
+!    characteristic equation.
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) b
+  real ( kind = 8 ) f
+  integer ( kind = 4 ) ic
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) j0
+  integer ( kind = 4 ) jf
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) l0
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) mj
+  real ( kind = 8 ) q
+  real ( kind = 8 ) t0
+  real ( kind = 8 ) t1
+  real ( kind = 8 ) t2
+
+  b = a
+  ic = int ( m / 2 )
+  l = 0
+  l0 = 0
+  j0 = 2
+  jf = ic
+
+  if ( kd == 1 ) then
+    l0 = 2
+    j0 = 3
+  else if ( kd == 2 .or. kd == 3 ) then
+    l = 1
+  else if ( kd == 4 ) then
+    jf = ic - 1
+  end if
+
+  t1 = 0.0D+00
+  do j = mj, ic + 1, -1
+    t1 = - q * q / ( ( 2.0D+00 * j + l ) ** 2 - b + t1 )
+  end do
+
+  if ( m <= 2 ) then
+
+    t2 = 0.0D+00
+
+    if ( kd == 1 ) then
+      if ( m == 0 ) then
+        t1 = t1 + t1
+      else if ( m == 2 ) then
+        t1 = - 2.0D+00 * q * q / ( 4.0D+00 - b + t1 ) - 4.0D+00
+      end if
+    else if ( kd == 2 ) then
+      if ( m == 1 ) then
+        t1 = t1 + q
+      end if
+    else if ( kd == 3 ) then
+      if ( m == 1 ) then
+        t1 = t1 - q
+      end if
+    end if
+
+  else
+
+    if ( kd == 1 ) then
+      t0 = 4.0D+00 - b + 2.0D+00 * q * q / b
+    else if ( kd == 2 ) then
+      t0 = 1.0D+00 - b + q
+    else if ( kd == 3 ) then
+      t0 = 1.0D+00 - b - q
+    else if ( kd == 4 ) then
+      t0 = 4.0D+00 - b
+    end if
+
+    t2 = - q * q / t0
+    do j = j0, jf
+      t2 = - q * q / ( ( 2.0D+00 * j - l - l0 ) ** 2 - b + t2 )
+    end do
+
+  end if
+
+  f = ( 2.0D+00 * ic + l ) ** 2 + t1 + t2 - b
+
+  return
+end
+subroutine cvql ( kd, m, q, a0 )
+
+!*****************************************************************************80
+!
+!! CVQL computes the characteristic value of Mathieu functions for q <= 3*m.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    10 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) KD, the case code:
+!    1, for cem(x,q)  ( m = 0,2,4,...)
+!    2, for cem(x,q)  ( m = 1,3,5,...)
+!    3, for sem(x,q)  ( m = 1,3,5,...)
+!    4, for sem(x,q)  ( m = 2,4,6,...)
+!
+!    Input, integer ( kind = 4 ) M, the order of the Mathieu functions.
+!
+!    Input, real ( kind = 8 ) Q, the parameter value.
+!
+!    Output, real ( kind = 8 ) A0, the initial characteristic value.
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) c1
+  real ( kind = 8 ) cv1
+  real ( kind = 8 ) cv2
+  real ( kind = 8 ) d1
+  real ( kind = 8 ) d2
+  real ( kind = 8 ) d3
+  real ( kind = 8 ) d4
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) p1
+  real ( kind = 8 ) p2
+  real ( kind = 8 ) q
+  real ( kind = 8 ) w
+  real ( kind = 8 ) w2
+  real ( kind = 8 ) w3
+  real ( kind = 8 ) w4
+  real ( kind = 8 ) w6
+
+  if ( kd == 1 .or. kd == 2 ) then
+    w = 2.0D+00 * m + 1.0D+00
+  else
+    w = 2.0D+00 * m - 1.0D+00
+  end if
+
+  w2 = w * w
+  w3 = w * w2
+  w4 = w2 * w2
+  w6 = w2 * w4
+  d1 = 5.0D+00 + 34.0D+00 / w2 + 9.0D+00 / w4
+  d2 = ( 33.0D+00 + 410.0D+00 / w2 + 405.0D+00 / w4 ) / w
+  d3 = ( 63.0D+00 + 1260.0D+00 / w2 + 2943.0D+00 / w4 + 486.0D+00 / w6 ) / w2
+  d4 = ( 527.0D+00 + 15617.0D+00 / w2 + 69001.0D+00 / w4 &
+    + 41607.0D+00 / w6 ) / w3
+  c1 = 128.0D+00
+  p2 = q / w4
+  p1 = sqrt ( p2 )
+  cv1 = - 2.0D+00 * q + 2.0D+00 * w * sqrt ( q ) &
+    - ( w2 + 1.0D+00 ) / 8.0D+00
+  cv2 = ( w + 3.0D+00 / w ) + d1 / ( 32.0D+00 * p1 ) + d2 &
+    / ( 8.0D+00 * c1 * p2 )
+  cv2 = cv2 + d3 / ( 64.0D+00 * c1 * p1 * p2 ) + d4 &
+    / ( 16.0D+00 * c1 * c1 * p2 * p2 )
+  a0 = cv1 - cv2 / ( c1 * p1 )
+
+  return
+end
+subroutine cvqm ( m, q, a0 )
+
+!*****************************************************************************80
+!
+!! CVQM computes the characteristic value of Mathieu functions for q <= m*m.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    07 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the order of the Mathieu functions.
+!
+!    Input, real ( kind = 8 ) Q, the parameter value.
+!
+!    Output, real ( kind = 8 ) A0, the initial characteristic value.
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) hm1
+  real ( kind = 8 ) hm3
+  real ( kind = 8 ) hm5
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) q
+
+  hm1 = 0.5D+00 * q / ( m * m - 1.0D+00 )
+  hm3 = 0.25D+00 * hm1 ** 3 / ( m * m - 4.0D+00 )
+  hm5 = hm1 * hm3 * q / ( ( m * m - 1.0D+00 ) * ( m * m - 9.0D+00 ) )
+  a0 = m * m + q * ( hm1 + ( 5.0D+00 * m * m + 7.0D+00 ) * hm3 &
+    + ( 9.0D+00 * m ** 4 + 58.0D+00 * m * m + 29.0D+00 ) * hm5 )
+
+  return
+end
+subroutine cy01 ( kf, z, zf, zd )
+
+!*****************************************************************************80
+!
+!! CY01 computes complex Bessel functions Y0(z) and Y1(z) and derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    01 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer KF, the function choice.
+!    0 for ZF = Y0(z) and ZD = Y0'(z);
+!    1 for ZF = Y1(z) and ZD = Y1'(z);
+!    2 for ZF = Y1'(z) and ZD = Y1''(z).
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, complex ( kind = 8 ) ZF, ZD, the values of the requested function 
+!    and derivative.
+!
+  implicit none
+
+  real ( kind = 8 ), save, dimension(12) :: a = (/ &
+    -0.703125D-01, 0.112152099609375D+00, &
+    -0.5725014209747314D+00, 0.6074042001273483D+01, &
+    -0.1100171402692467D+03, 0.3038090510922384D+04, &
+    -0.1188384262567832D+06, 0.6252951493434797D+07, &
+    -0.4259392165047669D+09, 0.3646840080706556D+11, &
+    -0.3833534661393944D+13, 0.4854014686852901D+15 /)
+  real ( kind = 8 ) a0
+  real ( kind = 8 ), save, dimension(12) :: a1 = (/ &
+    0.1171875D+00, -0.144195556640625D+00, &
+    0.6765925884246826D+00, -0.6883914268109947D+01, &
+    0.1215978918765359D+03, -0.3302272294480852D+04, &
+    0.1276412726461746D+06, -0.6656367718817688D+07, &
+    0.4502786003050393D+09, -0.3833857520742790D+11, &
+    0.4011838599133198D+13, -0.5060568503314727D+15 /)
+  real ( kind = 8 ), save, dimension(12) :: b = (/ &
+    0.732421875D-01, -0.2271080017089844D+00, &
+    0.1727727502584457D+01, -0.2438052969955606D+02, &
+    0.5513358961220206D+03, -0.1825775547429318D+05, &
+    0.8328593040162893D+06, -0.5006958953198893D+08, &
+    0.3836255180230433D+10, -0.3649010818849833D+12, &
+    0.4218971570284096D+14, -0.5827244631566907D+16 /)
+  real ( kind = 8 ), save, dimension(12) :: b1 = (/ &
+    -0.1025390625D+00, 0.2775764465332031D+00, &
+    -0.1993531733751297D+01, 0.2724882731126854D+02, &
+    -0.6038440767050702D+03, 0.1971837591223663D+05, &
+    -0.8902978767070678D+06, 0.5310411010968522D+08, &
+    -0.4043620325107754D+10, 0.3827011346598605D+12, &
+    -0.4406481417852278D+14, 0.6065091351222699D+16 /)
+  complex ( kind = 8 ) cbj0
+  complex ( kind = 8 ) cbj1
+  complex ( kind = 8 ) cby0
+  complex ( kind = 8 ) cby1
+  complex ( kind = 8 ) cdy0
+  complex ( kind = 8 ) cdy1
+  complex ( kind = 8 ) ci
+  complex ( kind = 8 ) cp
+  complex ( kind = 8 ) cp0
+  complex ( kind = 8 ) cp1
+  complex ( kind = 8 ) cq0
+  complex ( kind = 8 ) cq1
+  complex ( kind = 8 ) cr
+  complex ( kind = 8 ) cs
+  complex ( kind = 8 ) ct1
+  complex ( kind = 8 ) ct2
+  complex ( kind = 8 ) cu
+  real ( kind = 8 ) el
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k0
+  integer ( kind = 4 ) kf
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) rp2
+  real ( kind = 8 ) w0
+  real ( kind = 8 ) w1
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) z1
+  complex ( kind = 8 ) z2
+  complex ( kind = 8 ) zd
+  complex ( kind = 8 ) zf
+
+  pi = 3.141592653589793D+00
+  el = 0.5772156649015329D+00
+  rp2 = 2.0D+00 / pi
+  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
+  a0 = abs ( z )
+  z2 = z * z
+  z1 = z
+
+  if ( a0 == 0.0D+00 ) then
+
+    cbj0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cbj1 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+    cby0 = cmplx ( -1.0D+30, 0.0D+00, kind = 8 )
+    cby1 = cmplx ( -1.0D+30, 0.0D+00, kind = 8 )
+    cdy0 = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    cdy1 = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+
+  else
+
+    if ( real ( z, kind = 8 ) < 0.0D+00) then
+      z1 = -z
+    end if
+
+    if ( a0 <= 12.0D+00 ) then
+
+      cbj0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, 40
+        cr = - 0.25D+00 * cr * z2 / ( k * k )
+        cbj0 = cbj0 + cr
+        if ( abs ( cr ) < abs ( cbj0 ) * 1.0D-15 ) then
+          exit
+        end if
+      end do
+
+      cbj1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, 40
+        cr = -0.25D+00 * cr * z2 / ( k * ( k + 1.0D+00 ) )
+        cbj1 = cbj1 + cr
+        if ( abs ( cr ) < abs ( cbj1 ) * 1.0D-15 ) then
+          exit
+        end if
+      end do
+
+      cbj1 = 0.5D+00 * z1 * cbj1
+      w0 = 0.0D+00
+      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      cs = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, 40
+        w0 = w0 + 1.0D+00 / k
+        cr = -0.25D+00 * cr / ( k * k ) * z2
+        cp = cr * w0
+        cs = cs + cp
+        if ( abs ( cp ) < abs ( cs ) * 1.0D-15 ) then
+          exit
+        end if
+      end do
+
+      cby0 = rp2 * ( log ( z1 / 2.0D+00 ) + el ) * cbj0 - rp2 * cs
+      w1 = 0.0D+00
+      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      cs = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, 40
+        w1 = w1 + 1.0D+00 / k
+        cr = - 0.25D+00 * cr / ( k * ( k + 1 ) ) * z2
+        cp = cr * ( 2.0D+00 * w1 + 1.0D+00 / ( k + 1.0D+00 ) )
+        cs = cs + cp
+        if ( abs ( cp ) < abs ( cs ) * 1.0D-15 ) then
+          exit
+        end if
+      end do
+
+      cby1 = rp2 * ( ( log ( z1 / 2.0D+00 ) + el ) * cbj1 &
+        - 1.0D+00 / z1 - 0.25D+00 * z1 * cs )
+
+    else
+
+      if ( a0 < 35.0D+00 ) then
+        k0 = 12
+      else if ( a0 < 50.0D+00 ) then
+        k0 = 10
+      else
+        k0 = 8
+      end if
+
+      ct1 = z1 - 0.25D+00 * pi
+      cp0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, k0
+        cp0 = cp0 + a(k) * z1 ** ( - 2 * k )
+      end do
+      cq0 = -0.125D+00 / z1
+      do k = 1, k0
+        cq0 = cq0 + b(k) * z1 ** ( - 2 * k - 1 )
+      end do
+      cu = sqrt ( rp2 / z1 )
+      cbj0 = cu * ( cp0 * cos ( ct1 ) - cq0 * sin ( ct1 ) )
+      cby0 = cu * ( cp0 * sin ( ct1 ) + cq0 * cos ( ct1 ) )
+      ct2 = z1 - 0.75D+00 * pi
+      cp1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, k0
+        cp1 = cp1 + a1(k) * z1 ** ( - 2 * k )
+      end do
+      cq1 = 0.375D+00 / z1
+      do k = 1, k0
+        cq1 = cq1 + b1(k) * z1 ** ( - 2 * k - 1 )
+      end do
+      cbj1 = cu * ( cp1 * cos ( ct2 ) - cq1 * sin ( ct2 ) )
+      cby1 = cu * ( cp1 * sin ( ct2 ) + cq1 * cos ( ct2 ) )
+ 
+    end if
+
+    if ( real ( z, kind = 8 ) < 0.0D+00 ) then
+
+      if ( imag ( z ) < 0.0D+00 ) then
+        cby0 = cby0 - 2.0D+00 * ci * cbj0
+      else
+        cby0 = cby0 + 2.0D+00 * ci * cbj0
+      end if
+
+      if ( imag ( z ) < 0.0D+00 ) then
+        cby1 = - ( cby1 - 2.0D+00 * ci * cbj1 )
+      else
+        cby1 = - ( cby1 + 2.0D+00 * ci * cbj1 )
+      end if
+      cbj1 = - cbj1
+ 
+    end if
+
+    cdy0 = - cby1
+    cdy1 = cby0 - 1.0D+00 / z * cby1
+
+  end if
+
+  if ( kf == 0 ) then
+    zf = cby0
+    zd = cdy0
+  else if ( kf == 1 ) then
+    zf = cby1
+    zd = cdy1
+  else if ( kf == 2 ) then
+    zf = cdy1
+    zd = - cdy1 / z - ( 1.0D+00 - 1.0D+00 / ( z * z ) ) * cby1
+  end if
+
+  return
+end
+subroutine cyzo ( nt, kf, kc, zo, zv )
+
+!*****************************************************************************80
+!
+!! CYZO computes zeros of complex Bessel functions Y0(z) and Y1(z) and Y1'(z).
+!
+!  Parameters:
+!
+!    Ths procedure computes the complex zeros of Y0(z), Y1(z) and Y1'(z), 
+!    and their associated values at the zeros using the modified Newton's 
+!    iteration method.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    22 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) NT, the number of zeros.
+!
+!    Input, integer ( kind = 4 ) KF, the function choice.
+!    0 for Y0(z) and Y1(z0);
+!    1 for Y1(z) and Y0(z1);
+!    2 for Y1'(z) and Y1(z1').
+!
+!    Input, integer ( kind = 4 ) KC, complex/real choice.
+!    0, for complex roots;
+!    1, for real roots.
+!
+!    Output, real ( kind = 8 ) ZO(NT), ZV(NT), the zeros of Y0(z) or Y1(z) 
+!    or Y1'(z), and the value of Y0'(z) or Y1'(z) or Y1(z) at the L-th zero.
+!
+  implicit none
+
+  integer ( kind = 4 ) nt
+
+  real ( kind = 8 ) h
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) it
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) kc
+  integer ( kind = 4 ) kf
+  integer ( kind = 4 ) nr
+  real ( kind = 8 ) w
+  real ( kind = 8 ) w0
+  real ( kind = 8 ) x
+  real ( kind = 8 ) y
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) zd
+  complex ( kind = 8 ) zero
+  complex ( kind = 8 ) zf
+  complex ( kind = 8 ) zfd
+  complex ( kind = 8 ) zgd
+  complex ( kind = 8 ) zo(nt)
+  complex ( kind = 8 ) zp
+  complex ( kind = 8 ) zq
+  complex ( kind = 8 ) zv(nt)
+  complex ( kind = 8 ) zw
+
+  if ( kc == 0 ) then
+    x = -2.4D+00
+    y = 0.54D+00
+    h = 3.14D+00
+  else if ( kc == 1 ) then
+    x = 0.89D+00
+    y = 0.0D+00
+    h = -3.14D+00
+  end if
+
+  if ( kf == 1 ) then
+    x = -0.503D+00
+  else if ( kf == 2 ) then
+    x = 0.577D+00
+  end if
+
+  zero = cmplx ( x, y, kind = 8 )
+
+  do nr = 1, nt
+
+    if ( nr == 1 ) then
+      z = zero
+    else
+      z = zo(nr-1) - h
+    end if
+
+    it = 0
+
+    do
+
+      it = it + 1
+      call cy01 ( kf, z, zf, zd )
+
+      zp = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do i = 1, nr - 1
+        zp = zp * ( z - zo(i) )
+      end do
+
+      zfd = zf / zp
+
+      zq = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      do i = 1, nr - 1
+        zw = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+        do j = 1, nr - 1
+          if ( j /= i ) then
+            zw = zw * ( z - zo(j) )
+          end if
+        end do
+        zq = zq + zw
+      end do
+
+      zgd = ( zd - zq * zfd ) / zp
+      z = z - zfd / zgd
+      w0 = w
+      w = abs ( z )
+
+      if ( 50 < it .or. abs ( ( w - w0 ) / w ) <= 1.0D-12 ) then
+        exit
+      end if
+
+    end do
+
+    zo(nr) = z
+
+  end do
+
+  do i = 1, nt
+    z = zo(i)
+    if ( kf == 0 .or. kf == 2 ) then
+      call cy01 ( 1, z, zf, zd )
+      zv(i) = zf
+    else if ( kf == 1 ) then
+      call cy01 ( 0, z, zf, zd )
+      zv(i) = zf
+    end if
+  end do
+
+  return
+end
+subroutine dvla ( va, x, pd )
+
+!*****************************************************************************80
+!
+!! DVLA computes parabolic cylinder functions Dv(x) for large argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    06 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+! 
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Input, real ( kind = 8 ) VA, the order.
+!
+!    Output, real ( kind = 8 ) PD, the function value.
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) ep
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) gl
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) pd
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r
+  real ( kind = 8 ) va
+  real ( kind = 8 ) vl
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x1
+
+  pi = 3.141592653589793D+00
+  eps = 1.0D-12
+  ep = exp ( -0.25D+00 * x * x )
+  a0 = abs ( x ) ** va * ep
+  r = 1.0D+00
+  pd = 1.0D+00
+  do k = 1, 16
+    r = -0.5D+00 * r * ( 2.0D+00 * k - va - 1.0D+00 ) &
+      * ( 2.0D+00 * k - va - 2.0D+00 ) / ( k * x * x )
+    pd = pd + r
+    if ( abs ( r / pd ) < eps ) then
+      exit
+    end if
+  end do
+
+  pd = a0 * pd
+
+  if ( x < 0.0D+00 ) then
+    x1 = - x
+    call vvla ( va, x1, vl )
+    call gamma ( -va, gl )
+    pd = pi * vl / gl + cos ( pi * va ) * pd
+  end if
+
+  return
+end
+subroutine dvsa ( va, x, pd )
+
+!*****************************************************************************80
+!
+!! DVSA computes parabolic cylinder functions Dv(x) for small argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    07 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) VA, the order.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) PD, the function value.
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) ep
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) g0
+  real ( kind = 8 ) g1
+  real ( kind = 8 ) ga0
+  real ( kind = 8 ) gm
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) pd
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) sq2
+  real ( kind = 8 ) va
+  real ( kind = 8 ) va0
+  real ( kind = 8 ) vm
+  real ( kind = 8 ) vt
+  real ( kind = 8 ) x
+
+  eps = 1.0D-15
+  pi = 3.141592653589793D+00
+  sq2 = sqrt ( 2.0D+00 )
+  ep = exp ( -0.25D+00 * x * x )
+  va0 = 0.5D+00 * ( 1.0D+00 - va )
+
+  if ( va == 0.0D+00 ) then
+
+    pd = ep
+
+  else
+
+    if ( x == 0.0D+00 ) then
+      if ( va0 <= 0.0D+00 .and. va0 == int ( va0 ) ) then
+        pd = 0.0D+00
+      else
+        call gamma ( va0, ga0 )
+        pd = sqrt ( pi ) / ( 2.0D+00 ** ( -0.5D+00 * va ) * ga0 )
+      end if
+
+    else
+
+      call gamma ( -va, g1 )
+      a0 = 2.0D+00 ** ( -0.5D+00 * va - 1.0D+00 ) * ep / g1
+      vt = -0.5D+00 * va
+      call gamma ( vt, g0 )
+      pd = g0
+      r = 1.0D+00
+      do m = 1, 250
+        vm = 0.5D+00 * ( m - va )
+        call gamma ( vm, gm )
+        r = -r * sq2 * x / m
+        r1 = gm * r
+        pd = pd + r1
+        if ( abs ( r1 ) < abs ( pd ) * eps ) then
+          exit
+        end if
+      end do
+
+      pd = a0 * pd
+
+    end if
+
+  end if
+
+  return
+end
+subroutine e1xa ( x, e1 )
+
+!*****************************************************************************80
+!
+!! E1XA computes the exponential integral E1(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    06 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) E1, the function value.
+!
+  implicit none
+
+  real ( kind = 8 ) e1
+  real ( kind = 8 ) es1
+  real ( kind = 8 ) es2
+  real ( kind = 8 ) x
+
+  if ( x == 0.0D+00 ) then
+
+    e1 = 1.0D+300
+
+  else if ( x <= 1.0D+00 ) then
+
+    e1 = - log ( x ) + (((( &
+        1.07857D-03 * x &
+      - 9.76004D-03 ) * x &
+      + 5.519968D-02 ) * x &
+      - 0.24991055D+00 ) * x &
+      + 0.99999193D+00 ) * x &
+      - 0.57721566D+00
+
+  else
+
+    es1 = ((( x &
+      + 8.5733287401D+00 ) * x &
+      +18.059016973D+00  ) * x &
+      + 8.6347608925D+00 ) * x &
+      + 0.2677737343D+00
+
+    es2 = ((( x &
+      +  9.5733223454D+00 ) * x &
+      + 25.6329561486D+00 ) * x &
+      + 21.0996530827D+00 ) * x &
+      +  3.9584969228D+00
+
+    e1 = exp ( - x ) / x * es1 / es2
+
+  end if
+
+  return
+end
+subroutine e1xb ( x, e1 )
+
+!*****************************************************************************80
+!
+!! E1XB computes the exponential integral E1(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    06 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) E1, the function value.
+!
+  implicit none
+
+  real ( kind = 8 ) e1
+  real ( kind = 8 ) ga
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) r
+  real ( kind = 8 ) t
+  real ( kind = 8 ) t0
+  real ( kind = 8 ) x
+
+  if ( x == 0.0D+00 ) then
+
+    e1 = 1.0D+300
+
+  else if ( x <= 1.0D+00 ) then
+
+    e1 = 1.0D+00
+    r = 1.0D+00
+
+    do k = 1, 25
+      r = -r * k * x / ( k + 1.0D+00 )**2
+      e1 = e1 + r
+      if ( abs ( r ) <= abs ( e1 ) * 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    ga = 0.5772156649015328D+00
+    e1 = - ga - log ( x ) + x * e1
+
+  else
+
+    m = 20 + int ( 80.0D+00 / x )
+    t0 = 0.0D+00
+    do k = m, 1, -1
+      t0 = k / ( 1.0D+00 + k / ( x + t0 ) )
+    end do
+    t = 1.0D+00 / ( x + t0 )
+    e1 = exp ( -x ) * t
+
+  end if
+
+  return
+end
+subroutine e1z ( z, ce1 )
+
+!*****************************************************************************80
+!
+!! E1Z computes the complex exponential integral E1(z).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    16 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+! 
+!  Parameters:
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, complex ( kind = 8 ) CE1, the function value.
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  complex ( kind = 8 ) ce1
+  complex ( kind = 8 ) cr
+  complex ( kind = 8 ) ct
+  complex ( kind = 8 ) ct0
+  real ( kind = 8 ) el
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) x
+  complex ( kind = 8 ) z
+
+  pi = 3.141592653589793D+00
+  el = 0.5772156649015328D+00
+  x = real ( z, kind = 8 )
+  a0 = abs ( z )
+
+  if ( a0 == 0.0D+00 ) then
+    ce1 = cmplx ( 1.0D+300, 0.0D+00, kind = 8 )
+  else if ( a0 <= 10.0D+00 .or. &
+    ( x < 0.0D+00 .and. a0 < 20.0D+00 ) ) then
+    ce1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 150
+      cr = - cr * k * z / ( k + 1.0D+00 )**2
+      ce1 = ce1 + cr
+      if ( abs ( cr ) <= abs ( ce1 ) * 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    ce1 = - el - log ( z ) + z * ce1
+
+  else
+
+    ct0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+    do k = 120, 1, -1
+      ct0 = k / ( 1.0D+00 + k / ( z + ct0 ) )
+    end do
+    ct = 1.0D+00 / ( z + ct0 )
+
+    ce1 = exp ( - z ) * ct
+    if ( x <= 0.0D+00 .and. imag ( z ) == 0.0D+00 ) then
+      ce1 = ce1 - pi * cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
+    end if
+
+  end if
+
+  return
+end
+subroutine eix ( x, ei )
+
+!*****************************************************************************80
+!
+!! EIX computes the exponential integral Ei(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    10 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) EI, the function value.
+!
+  implicit none
+
+  real ( kind = 8 ) ei
+  real ( kind = 8 ) ga
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) r
+  real ( kind = 8 ) x
+
+  if ( x == 0.0D+00 ) then
+
+    ei = -1.0D+300
+
+  else if ( x <= 40.0D+00 ) then
+
+    ei = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 100
+      r = r * k * x / ( k + 1.0D+00 )**2
+      ei = ei + r
+      if ( abs ( r / ei ) <= 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    ga = 0.5772156649015328D+00
+    ei = ga + log ( x ) + x * ei
+
+  else
+
+    ei = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 20
+      r = r * k / x
+      ei = ei + r
+    end do
+    ei = exp ( x ) / x * ei
+
+  end if
+
+  return
+end
+subroutine elit ( hk, phi, fe, ee )
+
+!*****************************************************************************80
+!
+!! ELIT: complete and incomplete elliptic integrals F(k,phi) and E(k,phi).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    12 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) HK, the modulus, between 0 and 1.
+!
+!    Input, real ( kind = 8 ) PHI, the argument in degrees.
+!
+!    Output, real ( kind = 8 ) FE, EE, the values of F(k,phi) and E(k,phi).
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) b
+  real ( kind = 8 ) b0
+  real ( kind = 8 ) c
+  real ( kind = 8 ) ce
+  real ( kind = 8 ) ck
+  real ( kind = 8 ) d
+  real ( kind = 8 ) d0
+  real ( kind = 8 ) ee
+  real ( kind = 8 ) fac
+  real ( kind = 8 ) fe
+  real ( kind = 8 ) g
+  real ( kind = 8 ) hk
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) phi
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r
+
+  g = 0.0D+00
+  pi = 3.14159265358979D+00
+  a0 = 1.0D+00
+  b0 = sqrt ( 1.0D+00 - hk * hk )
+  d0 = ( pi / 180.0D+00 ) * phi
+  r = hk * hk
+
+  if ( hk == 1.0D+00 .and. phi == 90.0D+00 ) then
+
+    fe = 1.0D+300
+    ee = 1.0D+00
+
+  else if ( hk == 1.0D+00 ) then
+
+    fe = log ( ( 1.0D+00 + sin ( d0 ) ) / cos ( d0 ) )
+    ee = sin ( d0 )
+
+  else
+
+    fac = 1.0D+00
+    do n = 1, 40
+      a = ( a0 + b0 ) /2.0D+00
+      b = sqrt ( a0 * b0 )
+      c = ( a0 - b0 ) / 2.0D+00
+      fac = 2.0D+00 * fac
+      r = r + fac * c * c
+      if ( phi /= 90.0D+00 ) then
+        d = d0 + atan ( ( b0 / a0 ) * tan ( d0 ) )
+        g = g + c * sin( d )
+        d0 = d + pi * int ( d / pi + 0.5D+00 )
+      end if
+      a0 = a
+      b0 = b
+      if ( c < 1.0D-07 ) then
+        exit
+      end if
+    end do
+
+    ck = pi / ( 2.0D+00 * a )
+    ce = pi * ( 2.0D+00 - r ) / ( 4.0D+00 * a )
+    if ( phi == 90.0D+00 ) then
+      fe = ck
+      ee = ce
+    else
+      fe = d / ( fac * a )
+      ee = fe * ce / ck + g
+    end if
+
+  end if
+
+  return
+end
+subroutine elit3 ( phi, hk, c, el3 )
+
+!*****************************************************************************80
+!
+!! ELIT3 computes the elliptic integral of the third kind.
+!
+!  Discussion:
+!
+!    Gauss-Legendre quadrature is used.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    14 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) PHI, the argument in degrees.
+!
+!    Input, real ( kind = 8 ) HK, the modulus, between 0 and 1.
+!
+!    Input, real ( kind = 8 ) C, the parameter, between 0 and 1.
+!
+!    Output, real ( kind = 8 ) EL3, the value of the elliptic integral
+!    of the third kind.
+!
+  implicit none
+
+  real ( kind = 8 ) c
+  real ( kind = 8 ) c0
+  real ( kind = 8 ) c1
+  real ( kind = 8 ) c2
+  real ( kind = 8 ) el3
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) f2
+  real ( kind = 8 ) hk
+  integer ( kind = 4 ) i 
+  logical lb1
+  logical lb2
+  real ( kind = 8 ) phi
+  real ( kind = 8 ), dimension ( 10 ), save :: t = (/ &
+    0.9931285991850949D+00, 0.9639719272779138D+00, &
+    0.9122344282513259D+00, 0.8391169718222188D+00, &
+    0.7463319064601508D+00, 0.6360536807265150D+00, &
+    0.5108670019508271D+00, 0.3737060887154195D+00, &
+    0.2277858511416451D+00, 0.7652652113349734D-01 /)
+  real ( kind = 8 ) t1
+  real ( kind = 8 ) t2
+  real ( kind = 8 ), dimension ( 10 ), save :: w = (/ &
+    0.1761400713915212D-01, 0.4060142980038694D-01, &
+    0.6267204833410907D-01, 0.8327674157670475D-01, &
+    0.1019301198172404D+00, 0.1181945319615184D+00, &
+    0.1316886384491766D+00, 0.1420961093183820D+00, &
+    0.1491729864726037D+00, 0.1527533871307258D+00 /)
+
+  lb1 = ( hk == 1.0D+00 ) .and. ( abs ( phi - 90.0D+00 ) <= 1.0D-08 )
+
+  lb2 = c == 1.0D+00 .and. abs ( phi - 90.0D+00 ) <= 1.0D-08
+
+  if ( lb1 .or. lb2 ) then
+    el3 = 1.0D+300
+    return
+  end if
+
+  c1 = 0.87266462599716D-02 * phi
+  c2 = c1
+
+  el3 = 0.0D+00
+  do i = 1, 10
+    c0 = c2 * t(i)
+    t1 = c1 + c0
+    t2 = c1 - c0
+    f1 = 1.0D+00 / ( ( 1.0D+00 - c * sin(t1) * sin(t1) ) &
+      * sqrt ( 1.0D+00 - hk * hk * sin ( t1 ) * sin ( t1 ) ) )
+    f2 = 1.0D+00 / ( ( 1.0D+00 - c * sin ( t2 ) * sin ( t2 ) ) &
+      * sqrt( 1.0D+00 - hk * hk * sin ( t2 ) * sin ( t2 ) ) )
+    el3 = el3 + w(i) * ( f1 + f2 )
+  end do
+
+  el3 = c1 * el3
+
+  return
+end
+function envj ( n, x )
+
+!*****************************************************************************80
+!
+!! ENVJ is a utility function used by MSTA1 and MSTA2.
+!
+!  Discussion:
+!
+!    ENVJ estimates -log(Jn(x)) from the estimate
+!    Jn(x) approx 1/sqrt(2*pi*n) * ( e*x/(2*n))^n
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    14 January 2016
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!    Modifications suggested by Vincent Lafage, 11 January 2016.
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order of the Bessel function.
+!
+!    Input, real ( kind = 8 ) X, the absolute value of the argument.
+!
+!    Output, real ( kind = 8 ) ENVJ, the value.
+!
+  implicit none
+
+  real ( kind = 8 ) envj
+  real ( kind = 8 ) logten
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) n_r8
+  real ( kind = 8 ) r8_gamma_log
+  real ( kind = 8 ) x
+!
+!  Original code
+!
+  if ( .true. ) then
+
+    envj = 0.5D+00 * log10 ( 6.28D+00 * n ) &
+      - n * log10 ( 1.36D+00 * x / n )
+!
+!  Modification suggested by Vincent Lafage.
+!
+  else
+
+    n_r8 = real ( n, kind = 8 )
+    logten = log ( 10.0D+00 )
+    envj = r8_gamma_log ( n_r8 + 1.0D+00 ) / logten - n_r8 * log10 ( x )
+
+  end if
+
+  return
+end
+subroutine enxa ( n, x, en )
+
+!*****************************************************************************80
+!
+!! ENXA computes the exponential integral En(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    07 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) EN(0:N), the function values.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) e1
+  real ( kind = 8 ) ek
+  real ( kind = 8 ) en(0:n)
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) x
+
+  en(0) = exp ( - x ) / x 
+  call e1xb ( x, e1 )
+
+  en(1) = e1
+  do k = 2, n
+    ek = ( exp ( - x ) - x * e1 ) / ( k - 1.0D+00 )
+    en(k) = ek
+    e1 = ek
+  end do
+
+  return
+end
+subroutine enxb ( n, x, en )
+
+!*****************************************************************************80
+!
+!! ENXB computes the exponential integral En(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    10 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) EN(0:N), the function values.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) en(0:n)
+  real ( kind = 8 ) ens
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) ps
+  real ( kind = 8 ) r
+  real ( kind = 8 ) rp
+  real ( kind = 8 ) s
+  real ( kind = 8 ) s0
+  real ( kind = 8 ) t
+  real ( kind = 8 ) t0
+  real ( kind = 8 ) x
+
+  if ( x == 0.0D+00 ) then
+
+    en(0) = 1.0D+300
+    en(1) = 1.0D+300
+    do k = 2, n
+      en(k) = 1.0D+00 / ( k - 1.0D+00 )
+    end do
+    return
+
+  else if ( x <= 1.0D+00 ) then
+
+    en(0) = exp ( - x ) / x
+    do l = 1, n
+      rp = 1.0D+00
+      do j = 1, l - 1
+        rp = - rp * x / j
+      end do
+      ps = -0.5772156649015328D+00
+      do m = 1, l - 1
+        ps = ps + 1.0D+00 / m
+      end do
+      ens = rp * ( - log ( x ) + ps )
+      s = 0.0D+00
+      do m = 0, 20
+        if ( m /= l - 1 ) then
+          r = 1.0D+00
+          do j = 1, m
+            r = - r * x / j
+          end do
+          s = s + r / ( m - l + 1.0D+00 )
+          if ( abs ( s - s0 ) < abs ( s ) * 1.0D-15 ) then
+            exit
+          end if
+          s0 = s
+        end if
+      end do
+
+      en(l) = ens - s
+
+    end do
+
+  else
+
+    en(0) = exp ( - x ) / x
+    m = 15 + int ( 100.0D+00 / x )
+    do l = 1, n
+      t0 = 0.0D+00
+      do k = m, 1, -1
+        t0 = ( l + k - 1.0D+00 ) / ( 1.0D+00 + k / ( x + t0 ) )
+      end do
+      t = 1.0D+00 / ( x + t0 )
+      en(l) = exp ( - x ) * t
+    end do
+
+  end if
+
+  return
+end
+subroutine error ( x, err )
+
+!*****************************************************************************80
+!
+!! ERROR evaluates the error function.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    07 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) ERR, the function value.
+!
+  implicit none
+
+  real ( kind = 8 ) c0
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) er
+  real ( kind = 8 ) err
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x2
+
+  eps = 1.0D-15
+  pi = 3.141592653589793D+00
+  x2 = x * x
+
+  if ( abs ( x ) < 3.5D+00 ) then
+
+    er = 1.0D+00
+    r = 1.0D+00
+
+    do k = 1, 50
+      r = r * x2 / ( k + 0.5D+00 )
+      er = er + r
+      if ( abs ( r ) <= abs ( er ) * eps ) then
+        exit
+      end if
+    end do
+
+    c0 = 2.0D+00 / sqrt ( pi ) * x * exp ( - x2 )
+    err = c0 * er
+
+  else
+
+    er = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 12
+      r = - r * ( k - 0.5D+00 ) / x2
+      er = er + r
+    end do
+
+    c0 = exp ( - x2 ) / ( abs ( x ) * sqrt ( pi ) )
+
+    err = 1.0D+00 - c0 * er
+    if ( x < 0.0D+00 ) then
+      err = -err
+    end if
+
+  end if
+
+  return
+end
+subroutine eulera ( n, en )
+
+!*****************************************************************************80
+!
+!! EULERA computes the Euler number En.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    10 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the index of the highest value to compute.
+!
+!    Output, real ( kind = 8 ) EN(0:N), the Euler numbers up to the N-th value.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) en(0:n)
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) r
+  real ( kind = 8 ) s
+
+  en(0) = 1.0D+00
+
+  do m = 1, n / 2
+    s = 1.0D+00
+    do k = 1, m - 1
+      r = 1.0D+00
+      do j = 1, 2 * k
+        r = r * ( 2.0D+00 * m - 2.0D+00 * k + j ) / j
+      end do
+      s = s + r * en(2*k)
+    end do
+    en(2*m) = -s
+  end do
+
+  return
+end
+subroutine eulerb ( n, en )
+
+!*****************************************************************************80
+!
+!! EULERB computes the Euler number En.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    09 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the index of the highest value to compute.
+!
+!    Output, real ( kind = 8 ) EN(0:N), the Euler numbers up to the N-th value.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) en(0:n)
+  real ( kind = 8 ) hpi
+  real ( kind = 8 ) isgn
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) r2
+  real ( kind = 8 ) s
+
+  hpi = 2.0D+00 / 3.141592653589793D+00
+  en(0) = 1.0D+00
+  en(2) = -1.0D+00
+  r1 = -4.0D+00 * hpi ** 3
+
+  do m = 4, n, 2
+    r1 = - r1 * ( m - 1 ) * m * hpi * hpi
+    r2 = 1.0D+00
+    isgn = 1.0D+00
+    do k = 3, 1000, 2
+      isgn = - isgn
+      s = ( 1.0D+00 / k ) ** ( m + 1 )
+      r2 = r2 + isgn * s
+      if ( s < 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    en(m) = r1 * r2
+
+    end do
+
+  return
+end
+subroutine fcoef ( kd, m, q, a, fc )
+
+!*****************************************************************************80
+!
+!! FCOEF: expansion coefficients for Mathieu and modified Mathieu functions.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    01 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) KD, the case code.
+!    1, for cem(x,q)  ( m = 0,2,4,...)
+!    2, for cem(x,q)  ( m = 1,3,5,...)
+!    3, for sem(x,q)  ( m = 1,3,5,...)
+!    4, for sem(x,q)  ( m = 2,4,6,...)
+!
+!    Input, integer ( kind = 4 ) M, the order of the Mathieu function.
+!
+!    Input, real ( kind = 8 ) Q, the parameter of the Mathieu functions.
+!
+!    Input, real ( kind = 8 ) A, the characteristic value of the Mathieu
+!    functions for given m and q.
+!
+!    Output, real ( kind = 8 ) FC(*), the expansion coefficients of Mathieu
+!    functions ( k =  1,2,...,KM ).  FC(1),FC(2),FC(3),... correspond to
+!    A0,A2,A4,... for KD = 1 case, 
+!    A1,A3,A5,... for KD = 2 case,
+!    B1,B3,B5,... for KD = 3 case,
+!    B2,B4,B6,... for KD = 4 case.
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) f2
+  real ( kind = 8 ) f3
+  real ( kind = 8 ) fc(251)
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) kb
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) km
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) q
+  real ( kind = 8 ) qm
+  real ( kind = 8 ) s
+  real ( kind = 8 ) s0
+  real ( kind = 8 ) sp
+  real ( kind = 8 ) ss
+  real ( kind = 8 ) u
+  real ( kind = 8 ) v
+
+  if ( q <= 1.0D+00 ) then
+    qm = 7.5D+00 + 56.1D+00 * sqrt ( q ) - 134.7D+00 * q &
+      + 90.7D+00 * sqrt ( q ) * q
+  else
+    qm = 17.0D+00 + 3.1D+00 * sqrt ( q ) - 0.126D+00 * q &
+      + 0.0037D+00 * sqrt ( q ) * q
+  end if
+
+  km = int ( qm + 0.5D+00 * m )
+
+  if ( q == 0.0D+00 ) then
+
+    do k = 1, km
+      fc(k) = 0.0D+00
+    end do
+
+    if ( kd == 1 ) then
+      fc((m+2)/2) = 1.0D+00
+      if (m == 0 ) then
+        fc(1) = 1.0D+00 / sqrt ( 2.0D+00 )
+      end if
+    else if ( kd == 4 ) then
+      fc(m/2) = 1.0D+00
+    else
+      fc((m+1)/2) = 1.0D+00
+    end if
+
+    return
+
+  end if
+
+  kb = 0
+  s = 0.0D+00
+  f = 1.0D-100
+  u = 0.0D+00
+  fc(km) = 0.0D+00
+
+  if ( kd == 1 ) then
+
+    l = 0
+
+    do k = km, 3, -1
+
+      v = u
+      u = f
+      f = ( a - 4.0D+00 * k * k ) * u / q - v
+
+      if ( abs ( f ) < abs ( fc(k+1) ) ) then
+
+        kb = k
+        fc(1) = 1.0D-100
+        sp = 0.0D+00
+        f3 = fc(k+1)
+        fc(2) = a / q * fc(1)
+        fc(3) = ( a - 4.0D+00 ) * fc(2) / q - 2.0D+00 * fc(1)
+        u = fc(2)
+        f1 = fc(3)
+
+        do i = 3, kb
+          v = u
+          u = f1
+          f1 = ( a - 4.0D+00 * ( i - 1.0D+00 ) ** 2 ) * u / q - v
+          fc(i+1) = f1
+          if ( i == kb ) then
+            f2 = f1
+          else
+            sp = sp + f1 * f1
+          end if
+        end do
+
+        sp = sp + 2.0D+00 * fc(1) ** 2 + fc(2) ** 2 + fc(3) ** 2
+        ss = s + sp * ( f3 / f2 ) ** 2
+        s0 = sqrt ( 1.0D+00 / ss )
+        do j = 1, km
+          if ( j <= kb + 1 ) then
+            fc(j) = s0 * fc(j) * f3 / f2
+          else
+            fc(j) = s0 * fc(j)
+          end if
+        end do
+        l = 1
+        exit
+      else
+        fc(k) = f
+        s = s + f * f
+      end if
+
+    end do
+
+    if ( l == 0 ) then
+      fc(2) = q * fc(3) / ( a - 4.0D+00 - 2.0D+00 * q * q / a )
+      fc(1) = q / a * fc(2)
+      s = s + 2.0D+00 * fc(1) ** 2 + fc(2) ** 2
+      s0 = sqrt ( 1.0D+00 / s )
+      do k = 1, km
+        fc(k) = s0 * fc(k)
+      end do
+    end if
+
+  else if ( kd == 2 .or. kd == 3 ) then
+
+    l = 0
+
+    do k = km, 3, -1
+
+      v = u
+      u = f
+      f = ( a - ( 2.0D+00 * k - 1 ) ** 2 ) * u / q - v
+
+      if ( abs ( fc(k) ) <= abs ( f ) ) then
+        fc(k-1) = f
+        s = s + f * f
+      else
+        kb = k
+        f3 = fc(k)
+        l = 1
+        exit
+      end if
+
+    end do
+
+    if ( l == 0 ) then
+
+      fc(1) = q / ( a - 1.0D+00 - ( - 1 ) ** kd * q ) * fc(2)
+      s = s + fc(1) * fc(1)
+      s0 = sqrt ( 1.0D+00 / s )
+      do k = 1, km
+        fc(k) = s0 * fc(k)
+      end do
+
+    else
+
+      fc(1) = 1.0D-100
+      fc(2) = ( a - 1.0D+00 - ( - 1 ) ** kd * q ) / q * fc(1)
+      sp = 0.0D+00
+      u = fc(1)
+      f1 = fc(2)
+      do i = 2, kb - 1
+        v = u
+        u = f1
+        f1 = ( a - ( 2.0D+00 * i - 1.0D+00 ) ** 2 ) * u / q - v
+        if ( i /= kb - 1 ) then
+          fc(i+1) = f1
+          sp = sp + f1 * f1
+        else
+          f2 = f1
+        end if
+      end do
+
+      sp = sp + fc(1) ** 2 + fc(2) ** 2
+      ss = s + sp * ( f3 / f2 ) ** 2
+      s0 = 1.0D+00 / sqrt ( ss )
+      do j = 1, km
+        if ( j < kb ) then
+          fc(j) = s0 * fc(j) * f3 / f2
+        else
+          fc(j) = s0 * fc(j)
+        end if
+      end do
+
+    end if
+
+  else if ( kd == 4 ) then
+
+    l = 0
+
+    do k = km, 3, -1
+      v = u
+      u = f
+      f = ( a - 4.0D+00 * k * k ) * u / q - v
+      if ( abs ( fc(k) ) <= abs ( f ) ) then
+        fc(k-1) = f
+        s = s + f * f
+      else
+        kb = k
+        f3 = fc(k)
+        l = 1
+        exit
+      end if
+    end do
+
+    if ( l == 0 ) then
+
+      fc(1) = q / ( a - 4.0D+00 ) * fc(2)
+      s = s + fc(1) * fc(1)
+      s0 = sqrt ( 1.0D+00 / s )
+      do k = 1, km
+        fc(k) = s0 * fc(k)
+      end do
+
+    else
+
+      fc(1) = 1.0D-100
+      fc(2) = ( a - 4.0D+00 ) / q * fc(1)
+      sp = 0.0D+00
+      u = fc(1)
+      f1 = fc(2)
+
+      do i = 2, kb - 1
+        v = u
+        u = f1
+        f1 = ( a - 4.0D+00 * i * i ) * u / q - v
+        if ( i /= kb - 1 ) then
+          fc(i+1) = f1
+          sp = sp + f1 * f1
+        else
+          f2 = f1
+        end if
+      end do
+
+      sp = sp + fc(1) ** 2 + fc(2) ** 2
+      ss = s + sp * ( f3 / f2 ) ** 2
+      s0 = 1.0D+00 / sqrt ( ss )
+
+      do j = 1, km
+        if ( j < kb ) then
+          fc(j) = s0 * fc(j) * f3 / f2
+        else
+          fc(j) = s0 * fc(j)
+        end if
+      end do
+
+    end if
+
+  end if
+
+  if ( fc(1) < 0.0D+00 ) then
+    do j = 1, km
+      fc(j) = -fc(j)
+    end do
+  end if
+
+  return
+end
+subroutine fcs ( x, c, s )
+
+!*****************************************************************************80
+!
+!! FCS computes Fresnel integrals C(x) and S(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    17 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+! 
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) C, S, the function values.
+!
+  implicit none
+
+  real ( kind = 8 ) c
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) g
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) px
+  real ( kind = 8 ) q
+  real ( kind = 8 ) r
+  real ( kind = 8 ) s
+  real ( kind = 8 ) su
+  real ( kind = 8 ) t
+  real ( kind = 8 ) t0
+  real ( kind = 8 ) t2
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xa
+
+  eps = 1.0D-15
+  pi = 3.141592653589793D+00
+  xa = abs ( x )
+  px = pi * xa
+  t = 0.5D+00 * px * xa
+  t2 = t * t
+
+  if ( xa == 0.0D+00 ) then
+
+    c = 0.0D+00
+    s = 0.0D+00
+
+  else if ( xa < 2.5D+00 ) then
+
+    r = xa
+    c = r
+    do k = 1, 50
+      r = -0.5D+00 * r * ( 4.0D+00 * k - 3.0D+00 ) / k &
+        / ( 2.0D+00 * k - 1.0D+00 ) / ( 4.0D+00 * k + 1.0D+00 ) * t2
+      c = c + r
+      if ( abs ( r ) < abs ( c ) * eps ) then
+        exit
+      end if
+    end do
+
+    s = xa * t / 3.0D+00
+    r = s
+    do k = 1, 50
+      r = - 0.5D+00 * r * ( 4.0D+00 * k - 1.0D+00 ) / k &
+        / ( 2.0D+00 * k + 1.0D+00 ) / ( 4.0D+00 * k + 3.0D+00 ) * t2
+      s = s + r
+      if ( abs ( r ) < abs ( s ) * eps ) then
+        if ( x < 0.0D+00 ) then
+          c = -c
+          s = -s
+        end if
+        return
+      end if
+    end do
+
+  else if ( xa < 4.5D+00 ) then
+
+    m = int ( 42.0D+00 + 1.75D+00 * t )
+    su = 0.0D+00
+    c = 0.0D+00
+    s = 0.0D+00
+    f1 = 0.0D+00
+    f0 = 1.0D-100
+
+    do k = m, 0, -1
+      f = ( 2.0D+00 * k + 3.0D+00 ) * f0 / t - f1
+      if ( k == int ( k / 2 ) * 2 ) then
+        c = c + f
+      else
+        s = s + f
+      end if
+      su = su + ( 2.0D+00 * k + 1.0D+00 ) * f * f
+      f1 = f0
+      f0 = f
+    end do
+
+    q = sqrt ( su )
+    c = c * xa / q
+    s = s * xa / q
+
+  else
+
+    r = 1.0D+00
+    f = 1.0D+00
+    do k = 1, 20
+      r = -0.25D+00 * r * ( 4.0D+00 * k - 1.0D+00 ) &
+        * ( 4.0D+00 * k - 3.0D+00 ) / t2
+      f = f + r
+    end do
+    r = 1.0D+00 / ( px * xa )
+    g = r
+    do k = 1, 12
+      r = -0.25D+00 * r * ( 4.0D+00 * k + 1.0D+00 ) &
+        * ( 4.0D+00 * k - 1.0D+00 ) / t2
+      g = g + r
+    end do
+
+    t0 = t - int ( t / ( 2.0D+00 * pi ) ) * 2.0D+00 * pi
+    c = 0.5D+00 + ( f * sin ( t0 ) - g * cos ( t0 ) ) / px
+    s = 0.5D+00 - ( f * cos ( t0 ) + g * sin ( t0 ) ) / px
+
+  end if
+
+  if ( x < 0.0D+00 ) then
+    c = -c
+    s = -s
+  end if
+
+  return
+end
+subroutine fcszo ( kf, nt, zo )
+
+!*****************************************************************************80
+!
+!! FCSZO computes complex zeros of Fresnel integrals C(x) or S(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    17 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) KF, the function code.
+!    1 for C(z);
+!    2 for S(z)
+!
+!    Input, integer ( kind = 4 ) NT, the total number of zeros desired.
+!
+!    Output, complex ( kind = 8 ) Z0(NT), the zeros.
+!
+  implicit none
+
+  integer ( kind = 4 ) nt
+
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) it
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) kf
+  integer ( kind = 4 ) nr
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) psq
+  real ( kind = 8 ) px
+  real ( kind = 8 ) py
+  real ( kind = 8 ) w
+  real ( kind = 8 ) w0
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) zd
+  complex ( kind = 8 ) zf
+  complex ( kind = 8 ) zfd
+  complex ( kind = 8 ) zgd
+  complex ( kind = 8 ) zo(nt)
+  complex ( kind = 8 ) zp
+  complex ( kind = 8 ) zq
+  complex ( kind = 8 ) zw
+
+  pi = 3.141592653589793D+00
+
+  do nr = 1, nt
+
+    if ( kf == 1 ) then
+      psq = sqrt ( 4.0D+00 * nr - 1.0D+00 )
+    else
+      psq = 2.0D+00 * sqrt ( real ( nr, kind = 8 ) )
+    end if
+
+    px = psq - log ( pi * psq ) / ( pi * pi * psq ** 3.0D+00 )
+    py = log ( pi * psq ) / ( pi * psq )
+    z = cmplx ( px, py, kind = 8 )
+
+    if ( kf == 2 ) then
+      if ( nr == 2 ) then
+        z = cmplx ( 2.8334D+00, 0.2443D+00, kind = 8 )
+      else if ( nr == 3 ) then
+        z = cmplx ( 3.4674D+00, 0.2185D+00, kind = 8 )
+      else if ( nr == 4 ) then
+        z = cmplx ( 4.0025D+00, 0.2008D+00, kind = 8 )
+      end if
+    end if
+
+    it = 0
+
+    do
+
+      it = it + 1
+
+      if ( kf == 1 ) then
+        call cfc ( z, zf, zd )
+      else
+        call cfs ( z, zf, zd )
+      end if
+
+      zp = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do i = 1, nr - 1
+        zp = zp * ( z - zo(i) )
+      end do
+      zfd = zf / zp
+      zq = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+
+      do i = 1, nr - 1
+        zw = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+        do j = 1, nr - 1
+          if ( j /= i ) then
+            zw = zw * ( z - zo(j) )
+          end if
+        end do
+        zq = zq + zw
+      end do
+
+      zgd = ( zd - zq * zfd ) / zp
+      z = z - zfd / zgd
+      w0 = w
+      w = cdabs ( z )
+
+      if ( abs ( ( w - w0 ) / w ) <= 1.0D-12 ) then
+        exit
+      end if
+
+      if ( 50 < it ) then
+        exit
+      end if
+
+    end do
+
+    zo(nr) = z
+
+  end do
+
+  return
+end
+subroutine ffk ( ks, x, fr, fi, fm, fa, gr, gi, gm, ga )
+
+!*****************************************************************************80
+!
+!! FFK computes modified Fresnel integrals F+/-(x) and K+/-(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    23 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) KS, the sign code.
+!    0, to calculate F+(x) and K+(x);
+!    1, to calculate F_(x) and K_(x).
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) FR, FI, FM, FA, the values of
+!    Re[F+/-(x)], Im[F+/-(x)], |F+/-(x)|, Arg[F+/-(x)]  (Degs.).
+!
+!    Output, real ( kind = 8 ) GR, GI, GM, GA, the values of
+!    Re[K+/-(x)], Im[K+/-(x)], |K+/-(x)|, Arg[K+/-(x)]  (Degs.).
+!       
+  implicit none
+
+  real ( kind = 8 ) c1
+  real ( kind = 8 ) cs
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) fa
+  real ( kind = 8 ) fi
+  real ( kind = 8 ) fi0
+  real ( kind = 8 ) fm
+  real ( kind = 8 ) fr
+  real ( kind = 8 ) ga
+  real ( kind = 8 ) gi
+  real ( kind = 8 ) gm
+  real ( kind = 8 ) gr
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) ks
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) p2p
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) pp2
+  real ( kind = 8 ) s1
+  real ( kind = 8 ) srd
+  real ( kind = 8 ) ss
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x2
+  real ( kind = 8 ) x4
+  real ( kind = 8 ) xa
+  real ( kind = 8 ) xc
+  real ( kind = 8 ) xf
+  real ( kind = 8 ) xf0
+  real ( kind = 8 ) xf1
+  real ( kind = 8 ) xg
+  real ( kind = 8 ) xp
+  real ( kind = 8 ) xq
+  real ( kind = 8 ) xq2
+  real ( kind = 8 ) xr
+  real ( kind = 8 ) xs
+  real ( kind = 8 ) xsu
+  real ( kind = 8 ) xw
+
+  srd = 57.29577951308233D+00
+  eps = 1.0D-15
+  pi = 3.141592653589793D+00
+  pp2 = 1.2533141373155D+00
+  p2p = 0.7978845608028654D+00
+  xa = abs ( x )
+  x2 = x * x
+  x4 = x2 * x2
+
+  if ( x == 0.0D+00 ) then
+
+    fr = 0.5D+00 * sqrt ( 0.5D+00 * pi )
+    fi = ( -1.0D+00 ) ** ks * fr
+    fm = sqrt ( 0.25D+00 * pi )
+    fa = ( -1.0D+00 ) ** ks * 45.0D+00
+    gr = 0.5D+00
+    gi = 0.0D+00
+    gm = 0.5D+00
+    ga = 0.0D+00
+
+  else
+
+    if ( xa <= 2.5D+00 ) then
+
+      xr = p2p * xa
+      c1 = xr
+      do k = 1, 50
+        xr = -0.5D+00 * xr * ( 4.0D+00 * k - 3.0D+00 ) / k &
+          / ( 2.0D+00 * k - 1.0D+00 ) &
+          / ( 4.0D+00 * k + 1.0D+00 ) * x4
+        c1 = c1 + xr
+        if ( abs ( xr / c1 ) < eps ) then
+          exit
+        end if
+      end do
+
+      s1 = p2p * xa * xa * xa / 3.0D+00
+      xr = s1
+      do k = 1, 50
+        xr = -0.5D+00 * xr * ( 4.0D+00 * k - 1.0D+00 ) &
+          / k / ( 2.0D+00 * k + 1.0D+00 ) &
+          / ( 4.0D+00 * k + 3.0D+00 ) * x4
+        s1 = s1 + xr
+        if ( abs ( xr / s1 ) < eps ) then
+          exit
+        end if
+      end do
+
+    else if ( xa < 5.5D+00 ) then
+
+      m = int ( 42.0D+00 + 1.75D+00 * x2 )
+      xsu = 0.0D+00
+      xc = 0.0D+00
+      xs = 0.0D+00
+      xf1 = 0.0D+00
+      xf0 = 1.0D-100
+      do k = m, 0, -1
+        xf = ( 2.0D+00 * k + 3.0D+00 ) * xf0 / x2 - xf1
+        if ( k == 2 * int ( k / 2 ) )  then
+          xc = xc + xf
+        else
+          xs = xs + xf
+        end if
+        xsu = xsu + ( 2.0D+00 * k + 1.0D+00 ) * xf * xf
+        xf1 = xf0
+        xf0 = xf
+      end do
+      xq = sqrt ( xsu )
+      xw = p2p * xa / xq
+      c1 = xc * xw
+      s1 = xs * xw
+
+    else
+
+      xr = 1.0D+00
+      xf = 1.0D+00
+      do k = 1, 12
+        xr = -0.25D+00 * xr * ( 4.0D+00 * k - 1.0D+00 ) &
+          * ( 4.0D+00 * k - 3.0D+00 ) / x4
+        xf = xf + xr
+      end do
+      xr = 1.0D+00 / ( 2.0D+00 * xa * xa )
+      xg = xr
+      do k = 1, 12
+        xr = -0.25D+00 * xr * ( 4.0D+00 * k + 1.0D+00 ) &
+          * ( 4.0D+00 * k - 1.0D+00 ) / x4
+        xg = xg + xr
+      end do
+      c1 = 0.5D+00 + ( xf * sin ( x2 ) - xg * cos ( x2 ) ) &
+        / sqrt ( 2.0D+00 * pi ) / xa
+      s1 = 0.5D+00 - ( xf * cos ( x2 ) + xg * sin ( x2 ) ) &
+        / sqrt ( 2.0D+00 * pi ) / xa
+
+    end if
+ 
+    fr = pp2 * ( 0.5D+00 - c1 )
+    fi0 = pp2 * ( 0.5D+00 - s1 )
+    fi = ( -1.0D+00 ) ** ks * fi0
+    fm = sqrt ( fr * fr + fi * fi )
+
+    if ( 0.0D+00 <= fr ) then
+      fa = srd * atan ( fi / fr )
+    else if ( 0.0D+00 < fi ) then
+      fa = srd * ( atan ( fi / fr ) + pi )
+    else if ( fi < 0.0D+00 ) then
+      fa = srd * ( atan ( fi / fr ) - pi )
+    end if
+
+    xp = x * x + pi / 4.0D+00
+    cs = cos ( xp )
+    ss = sin ( xp )
+    xq2 = 1.0D+00 / sqrt ( pi )
+    gr = xq2 * ( fr * cs + fi0 * ss )
+    gi = ( -1.0D+00 ) ** ks * xq2 * ( fi0 * cs - fr * ss )
+    gm = sqrt ( gr * gr + gi * gi )
+
+    if ( 0.0D+00 <= gr ) then
+      ga = srd * atan ( gi / gr )
+    else if ( 0.0D+00 < gi ) then
+      ga = srd * ( atan ( gi / gr ) + pi )
+    else if ( gi < 0.0D+00 ) then
+      ga = srd * ( atan ( gi / gr ) - pi )
+    end if
+
+    if ( x < 0.0D+00 ) then
+      fr = pp2 - fr
+      fi = ( -1.0D+00 ) ** ks * pp2 - fi
+      fm = sqrt ( fr * fr + fi * fi )
+      fa = srd * atan ( fi / fr )
+      gr = cos ( x * x ) - gr
+      gi = - ( -1.0D+00 ) ** ks * sin ( x * x ) - gi
+      gm = sqrt ( gr * gr + gi * gi )
+      ga = srd * atan ( gi / gr )
+    end if
+
+  end if
+
+  return
+end
+subroutine gaih ( x, ga )
+
+!*****************************************************************************80
+!
+!! GAIH computes the GammaH function.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    09 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) GA, the function value.
+!
+  implicit none
+
+  real ( kind = 8 ) ga
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) m1
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) x
+
+  pi = 3.141592653589793D+00
+
+  if ( x == int ( x ) .and. 0.0 < x ) then
+    ga = 1.0D+00
+    m1 = int ( x - 1.0D+00 )
+    do k = 2, m1
+      ga = ga * k
+    end do
+  else if ( x + 0.5D+00 == int ( x + 0.5D+00) .and. 0.0D+00 < x ) then
+    m = int ( x )
+    ga = sqrt ( pi )
+    do k = 1, m
+      ga = 0.5D+00 * ga * ( 2.0D+00 * k - 1.0D+00 )
+    end do
+  end if
+
+  return
+end
+subroutine gam0 ( x, ga )
+
+!*****************************************************************************80
+!
+!! GAM0 computes the Gamma function for the LAMV function.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    09 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) GA, the function value.
+!   
+  implicit none
+
+  real ( kind = 8 ), dimension ( 25 ) :: g = (/ &
+    1.0D+00, &
+    0.5772156649015329D+00, &
+   -0.6558780715202538D+00, &
+   -0.420026350340952D-01, &
+    0.1665386113822915D+00, &
+   -0.421977345555443D-01, &
+   -0.96219715278770D-02, &
+    0.72189432466630D-02, &
+   -0.11651675918591D-02, &
+   -0.2152416741149D-03, &
+    0.1280502823882D-03, &
+   -0.201348547807D-04, &
+   -0.12504934821D-05, &
+    0.11330272320D-05, &
+   -0.2056338417D-06, &
+    0.61160950D-08, &
+    0.50020075D-08, &
+   -0.11812746D-08, &
+    0.1043427D-09, &
+    0.77823D-11, &
+   -0.36968D-11, &
+    0.51D-12, &
+   -0.206D-13, &
+   -0.54D-14, &
+    0.14D-14 /)
+  real ( kind = 8 ) ga
+  real ( kind = 8 ) gr
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) x
+
+  gr = g(25)
+  do k = 24, 1, -1
+    gr = gr * x + g(k)
+  end do
+
+  ga = 1.0D+00 / ( gr * x )
+
+  return
+end
+subroutine gamma ( x, ga )
+
+!*****************************************************************************80
+!
+!! GAMMA evaluates the Gamma function.
+!
+!  Licensing:
+!
+!    The original FORTRAN77 version of this routine is copyrighted by 
+!    Shanjie Zhang and Jianming Jin.  However, they give permission to 
+!    incorporate this routine into a user program that the copyright 
+!    is acknowledged.
+!
+!  Modified:
+!
+!    08 September 2007
+!
+!  Author:
+!
+!    Original FORTRAN77 version by Shanjie Zhang, Jianming Jin.
+!    FORTRAN90 version by John Burkardt.
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!    X must not be 0, or any negative integer.
+!
+!    Output, real ( kind = 8 ) GA, the value of the Gamma function.
+!
+  implicit none
+
+  real ( kind = 8 ), dimension ( 26 ) :: g = (/ &
+    1.0D+00, &
+    0.5772156649015329D+00, &
+   -0.6558780715202538D+00, &
+   -0.420026350340952D-01, &
+    0.1665386113822915D+00, &
+   -0.421977345555443D-01, &
+   -0.96219715278770D-02, &
+    0.72189432466630D-02, &
+   -0.11651675918591D-02, &
+   -0.2152416741149D-03, &
+    0.1280502823882D-03, & 
+   -0.201348547807D-04, &
+   -0.12504934821D-05, &
+    0.11330272320D-05, &
+   -0.2056338417D-06, & 
+    0.61160950D-08, &
+    0.50020075D-08, &
+   -0.11812746D-08, &
+    0.1043427D-09, & 
+    0.77823D-11, &
+   -0.36968D-11, &
+    0.51D-12, &
+   -0.206D-13, &
+   -0.54D-14, &
+    0.14D-14, &
+    0.1D-15 /)
+  real ( kind = 8 ) ga
+  real ( kind = 8 ) gr
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) m1
+  real ( kind = 8 ), parameter :: pi = 3.141592653589793D+00
+  real ( kind = 8 ) r
+  real ( kind = 8 ) x
+  real ( kind = 8 ) z
+
+  if ( x == aint ( x ) ) then
+
+    if ( 0.0D+00 < x ) then
+      ga = 1.0D+00
+      m1 = int ( x ) - 1
+      do k = 2, m1
+        ga = ga * k
+      end do
+    else
+      ga = 1.0D+300
+    end if
+
+  else
+
+    if ( 1.0D+00 < abs ( x ) ) then
+      z = abs ( x )
+      m = int ( z )
+      r = 1.0D+00
+      do k = 1, m
+        r = r * ( z - real ( k, kind = 8 ) )
+      end do
+      z = z - real ( m, kind = 8 )
+    else
+      z = x
+    end if
+
+    gr = g(26)
+    do k = 25, 1, -1
+      gr = gr * z + g(k)
+    end do
+
+    ga = 1.0D+00 / ( gr * z )
+
+    if ( 1.0D+00 < abs ( x ) ) then
+      ga = ga * r
+      if ( x < 0.0D+00 ) then
+        ga = - pi / ( x* ga * sin ( pi * x ) )
+      end if
+    end if
+
+  end if
+
+  return
+end
+subroutine gmn ( m, n, c, x, bk, gf, gd )
+
+!*****************************************************************************80
+!
+!! GMN computes quantities for oblate radial functions with small argument.
+!
+!  Discussion:
+!
+!    This procedure computes Gmn(-ic,ix) and its derivative for oblate
+!    radial functions with a small argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    15 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
+!
+!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
+!
+!    Input, real ( kind = 8 ) C, spheroidal parameter.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Input, real ( kind = 8 ) BK(*), coefficients.
+!
+!    Output, real ( kind = 8 ) GF, GD, the value of Gmn(-C,X) and Gmn'(-C,X).
+!
+  implicit none
+
+  real ( kind = 8 ) bk(200)
+  real ( kind = 8 ) c
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) gd
+  real ( kind = 8 ) gd0
+  real ( kind = 8 ) gd1
+  real ( kind = 8 ) gf
+  real ( kind = 8 ) gf0
+  real ( kind = 8 ) gw
+  integer ( kind = 4 ) ip
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xm
+
+  eps = 1.0D-14
+
+  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
+    ip = 0
+  else
+    ip = 1
+  end if
+
+  nm = 25 + int ( 0.5D+00 * ( n - m ) + c )
+  xm = ( 1.0D+00 + x * x ) ** ( -0.5D+00 * m )
+  gf0 = 0.0D+00
+  do k = 1, nm
+    gf0 = gf0 + bk(k) * x ** ( 2.0D+00 * k - 2.0D+00 )
+    if ( abs ( ( gf0 - gw ) / gf0 ) < eps .and. 10 <= k ) then
+      exit
+    end if
+    gw = gf0
+  end do
+
+  gf = xm * gf0 * x ** ( 1 - ip )
+
+  gd1 = - m * x / ( 1.0D+00 + x * x ) * gf
+  gd0 = 0.0D+00
+
+  do k = 1, nm
+
+    if ( ip == 0 ) then
+      gd0 = gd0 + ( 2.0D+00 * k - 1.0D+00 ) * bk(k) &
+        * x ** ( 2.0D+00 * k - 2.0D+00 )
+    else
+      gd0 = gd0 + 2.0D+00 * k * bk(k+1) * x ** ( 2.0D+00 * k - 1.0D+00 )
+    end if
+
+    if ( abs ( ( gd0 - gw ) / gd0 ) < eps .and. 10 <= k ) then
+      exit
+    end if
+
+    gw = gd0
+
+  end do
+
+  gd = gd1 + xm * gd0
+
+  return
+end
+subroutine herzo ( n, x, w )
+
+!*****************************************************************************80
+!
+!! HERZO computes the zeros the Hermite polynomial Hn(x).
+!
+!  Discussion:
+!
+!    This procedure computes the zeros of Hermite polynomial Ln(x)
+!    in the interval [-1,+1], and the corresponding
+!    weighting coefficients for Gauss-Hermite integration.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    15 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order of the polynomial.
+!
+!    Output, real ( kind = 8 ) X(N), the zeros.
+!
+!    Output, real ( kind = 8 ) W(N), the corresponding weights.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) fd
+  real ( kind = 8 ) gd
+  real ( kind = 8 ) hd
+  real ( kind = 8 ) hf
+  real ( kind = 8 ) hn
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) it
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) nr
+  real ( kind = 8 ) p
+  real ( kind = 8 ) q
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) r2
+  real ( kind = 8 ) w(n)
+  real ( kind = 8 ) wp
+  real ( kind = 8 ) x(n)
+  real ( kind = 8 ) z
+  real ( kind = 8 ) z0
+  real ( kind = 8 ) zl
+
+  hn = 1.0D+00 / n
+  zl = -1.1611D+00 + 1.46D+00 * sqrt ( real ( n, kind = 8 ) )
+
+  do nr = 1, n / 2
+
+    if ( nr == 1 ) then
+      z = zl
+    else
+      z = z - hn * ( n / 2 + 1 - nr )
+    end if
+
+    it = 0
+
+    do
+
+      it = it + 1
+      z0 = z
+      f0 = 1.0D+00
+      f1 = 2.0D+00 * z
+      do k = 2, n
+        hf = 2.0D+00 * z * f1 - 2.0D+00 * ( k - 1.0D+00 ) * f0
+        hd = 2.0D+00 * k * f1
+        f0 = f1
+        f1 = hf
+      end do
+
+      p = 1.0D+00
+      do i = 1, nr - 1
+        p = p * ( z - x(i) )
+      end do
+      fd = hf / p
+
+      q = 0.0D+00
+      do i = 1, nr - 1
+        wp = 1.0D+00
+        do j = 1, nr - 1
+          if ( j /= i ) then
+            wp = wp * ( z - x(j) )
+          end if
+        end do
+        q = q + wp
+      end do
+
+      gd = ( hd - q * fd ) / p
+      z = z - fd / gd
+
+      if ( 40 < it .or. abs ( ( z - z0 ) / z ) <= 1.0D-15 ) then
+        exit
+      end if
+
+    end do
+
+    x(nr) = z
+    x(n+1-nr) = -z
+    r = 1.0D+00
+    do k = 1, n
+      r = 2.0D+00 * r * k
+    end do
+    w(nr) = 3.544907701811D+00 * r / ( hd * hd )
+    w(n+1-nr) = w(nr)
+
+  end do
+
+  if ( n /= 2 * int ( n / 2 ) ) then
+    r1 = 1.0D+00
+    r2 = 1.0D+00
+    do j = 1, n
+      r1 = 2.0D+00 * r1 * j
+      if ( ( n + 1 ) / 2 <= j ) then
+        r2 = r2 * j
+      end if
+    end do
+    w(n/2+1) = 0.88622692545276D+00 * r1 / ( r2 * r2 )
+    x(n/2+1) = 0.0D+00
+  end if
+
+  return
+end
+subroutine hygfx ( a, b, c, x, hf )
+
+!*****************************************************************************80
+!
+!! HYGFX evaluates the hypergeometric function F(A,B,C,X).
+!
+!  Licensing:
+!
+!    The original FORTRAN77 version of this routine is copyrighted by 
+!    Shanjie Zhang and Jianming Jin.  However, they give permission to 
+!    incorporate this routine into a user program that the copyright 
+!    is acknowledged.
+!
+!  Modified:
+!
+!    08 September 2007
+!
+!  Author:
+!
+!    Original FORTRAN77 version by Shanjie Zhang, Jianming Jin.
+!    FORTRAN90 version by John Burkardt.
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) A, B, C, X, the arguments of the function.
+!    C must not be equal to a nonpositive integer.
+!    X < 1.
+!
+!    Output, real HF, the value of the function.
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) aa
+  real ( kind = 8 ) b
+  real ( kind = 8 ) bb
+  real ( kind = 8 ) c
+  real ( kind = 8 ) c0
+  real ( kind = 8 ) c1
+  real ( kind = 8 ), parameter :: el = 0.5772156649015329D+00
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) g0
+  real ( kind = 8 ) g1
+  real ( kind = 8 ) g2
+  real ( kind = 8 ) g3
+  real ( kind = 8 ) ga
+  real ( kind = 8 ) gabc
+  real ( kind = 8 ) gam
+  real ( kind = 8 ) gb
+  real ( kind = 8 ) gbm
+  real ( kind = 8 ) gc
+  real ( kind = 8 ) gca
+  real ( kind = 8 ) gcab
+  real ( kind = 8 ) gcb
+  real ( kind = 8 ) gm
+  real ( kind = 8 ) hf
+  real ( kind = 8 ) hw
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  logical l0
+  logical l1
+  logical l2
+  logical l3
+  logical l4
+  logical l5
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) pa
+  real ( kind = 8 ) pb
+  real ( kind = 8 ), parameter :: pi = 3.141592653589793D+00
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r0
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) rm
+  real ( kind = 8 ) rp
+  real ( kind = 8 ) sm
+  real ( kind = 8 ) sp
+  real ( kind = 8 ) sp0
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x1
+
+  l0 = ( c == aint ( c ) ) .and. ( c < 0.0D+00 )
+  l1 = ( 1.0D+00 - x < 1.0D-15 ) .and. ( c - a - b <= 0.0D+00 )
+  l2 = ( a == aint ( a ) ) .and. ( a < 0.0D+00 )
+  l3 = ( b == aint ( b ) ) .and. ( b < 0.0D+00 )
+  l4 = ( c - a == aint ( c - a ) ) .and. ( c - a <= 0.0D+00 )
+  l5 = ( c - b == aint ( c - b ) ) .and. ( c - b <= 0.0D+00 )
+
+  if ( l0 .or. l1 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'HYGFX - Fatal error!'
+    write ( *, '(a)' ) '  The hypergeometric series is divergent.'
+    return
+  end if
+
+  if ( 0.95D+00 < x ) then 
+    eps = 1.0D-08
+  else
+    eps = 1.0D-15
+  end if
+
+  if ( x == 0.0D+00 .or. a == 0.0D+00 .or. b == 0.0D+00 ) then
+
+    hf = 1.0D+00
+    return
+
+  else if ( 1.0D+00 - x == eps .and. 0.0D+00 < c - a - b ) then
+
+    call gamma ( c, gc )
+    call gamma ( c - a - b, gcab )
+    call gamma ( c - a, gca )
+    call gamma ( c - b, gcb )
+    hf = gc * gcab /( gca *gcb )
+    return
+
+  else if ( 1.0D+00 + x <= eps .and. abs ( c - a + b - 1.0D+00 ) <= eps ) then
+
+    g0 = sqrt ( pi ) * 2.0D+00**( - a )
+    call gamma ( c, g1 )
+    call gamma ( 1.0D+00 + a / 2.0D+00 - b, g2 )
+    call gamma ( 0.5D+00 + 0.5D+00 * a, g3 )
+    hf = g0 * g1 / ( g2 * g3 )
+    return
+
+  else if ( l2 .or. l3 ) then
+
+    if ( l2 ) then
+      nm = int ( abs ( a ) )
+    end if
+
+    if ( l3 ) then
+      nm = int ( abs ( b ) )
+    end if
+
+    hf = 1.0D+00
+    r = 1.0D+00
+
+    do k = 1, nm
+      r = r * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
+        / ( k * ( c + k - 1.0D+00 ) ) * x
+      hf = hf + r
+    end do
+
+    return
+
+  else if ( l4 .or. l5 ) then
+
+    if ( l4 ) then
+      nm = int ( abs ( c - a ) )
+    end if
+
+    if ( l5 ) then
+      nm = int ( abs ( c - b ) )
+    end if
+
+    hf = 1.0D+00
+    r  = 1.0D+00
+    do k = 1, nm
+      r = r * ( c - a + k - 1.0D+00 ) * ( c - b + k - 1.0D+00 ) &
+        / ( k * ( c + k - 1.0D+00 ) ) * x
+      hf = hf + r
+    end do
+    hf = ( 1.0D+00 - x )**( c - a - b ) * hf
+    return
+
+  end if
+
+  aa = a
+  bb = b
+  x1 = x
+!
+!  WARNING: ALTERATION OF INPUT ARGUMENTS A AND B, WHICH MIGHT BE CONSTANTS.
+!
+  if ( x < 0.0D+00 ) then
+    x = x / ( x - 1.0D+00 )
+    if ( a < c .and. b < a .and. 0.0D+00 < b ) then
+      a = bb
+      b = aa
+    end if
+    b = c - b
+  end if
+
+  if ( 0.75D+00 <= x ) then
+
+    gm = 0.0D+00
+
+    if ( abs ( c - a - b - aint ( c - a - b ) ) < 1.0D-15 ) then
+
+      m = int ( c - a - b )
+      call gamma ( a, ga )
+      call gamma ( b, gb )
+      call gamma ( c, gc )
+      call gamma ( a + m, gam )
+      call gamma ( b + m, gbm )
+      call psi ( a, pa )
+      call psi ( b, pb )
+
+      if ( m /= 0 ) then
+        gm = 1.0D+00
+      end if
+
+      do j = 1, abs ( m ) - 1
+        gm = gm * j
+      end do
+
+      rm = 1.0D+00
+      do j = 1, abs ( m )
+        rm = rm * j
+      end do
+
+      f0 = 1.0D+00
+      r0 = 1.0D+00
+      r1 = 1.0D+00
+      sp0 = 0.0D+00
+      sp = 0.0D+00
+
+      if ( 0 <= m ) then
+
+        c0 = gm * gc / ( gam * gbm )
+        c1 = - gc * ( x - 1.0D+00 )**m / ( ga * gb * rm )
+
+        do k = 1, m - 1
+          r0 = r0 * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
+            / ( k * ( k - m ) ) * ( 1.0D+00 - x )
+          f0 = f0 + r0
+        end do
+
+        do k = 1, m
+          sp0 = sp0 + 1.0D+00 / ( a + k - 1.0D+00 ) &
+            + 1.0D+00 / ( b + k - 1.0D+00 ) - 1.0D+00 / real ( k, kind = 8 )
+        end do
+
+        f1 = pa + pb + sp0 + 2.0D+00 * el + log ( 1.0D+00 - x )
+        hw = f1
+
+        do k = 1, 250
+
+          sp = sp + ( 1.0D+00 - a ) / ( k * ( a + k - 1.0D+00 ) ) &
+            + ( 1.0D+00 - b ) / ( k * ( b + k - 1.0D+00 ) )
+
+          sm = 0.0D+00
+          do j = 1, m
+            sm = sm + ( 1.0D+00 - a ) &
+              / ( ( j + k ) * ( a + j + k - 1.0D+00 ) ) &
+              + 1.0D+00 / ( b + j + k - 1.0D+00 )
+          end do
+
+          rp = pa + pb + 2.0D+00 * el + sp + sm + log ( 1.0D+00 - x )
+
+          r1 = r1 * ( a + m + k - 1.0D+00 ) * ( b + m + k - 1.0D+00 ) &
+            / ( k * ( m + k ) ) * ( 1.0D+00 - x )
+
+          f1 = f1 + r1 * rp
+
+          if ( abs ( f1 - hw ) < abs ( f1 ) * eps ) then
+            exit
+          end if
+
+          hw = f1
+
+        end do
+
+        hf = f0 * c0 + f1 * c1
+
+      else if ( m < 0 ) then
+
+        m = - m
+        c0 = gm * gc / ( ga * gb * ( 1.0D+00 - x )**m )
+        c1 = - ( - 1 )**m * gc / ( gam * gbm * rm )
+
+        do k = 1, m - 1
+          r0 = r0 * ( a - m + k - 1.0D+00 ) * ( b - m + k - 1.0D+00 ) &
+            / ( k * ( k - m ) ) * ( 1.0D+00 - x )
+          f0 = f0 + r0
+        end do
+
+        do k = 1, m
+          sp0 = sp0 + 1.0D+00 / real ( k, kind = 8 )
+        end do
+
+        f1 = pa + pb - sp0 + 2.0D+00 * el + log ( 1.0D+00 - x )
+
+        do k = 1, 250
+
+          sp = sp + ( 1.0D+00 - a ) &
+            / ( k * ( a + k - 1.0D+00 ) ) &
+            + ( 1.0D+00 - b ) / ( k * ( b + k - 1.0D+00 ) )
+
+          sm = 0.0D+00
+          do j = 1, m
+            sm = sm + 1.0D+00 / real ( j + k, kind = 8 )
+          end do
+
+          rp = pa + pb + 2.0D+00 * el + sp - sm + log ( 1.0D+00 - x )
+
+          r1 = r1 * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
+            / ( k * ( m + k ) ) * ( 1.0D+00 - x )
+
+          f1 = f1 + r1 * rp
+
+          if ( abs ( f1 - hw ) < abs ( f1 ) * eps ) then
+            exit
+          end if
+
+          hw = f1
+
+        end do
+
+        hf = f0 * c0 + f1 * c1
+
+      end if
+
+    else
+
+      call gamma ( a, ga )
+      call gamma ( b, gb )
+      call gamma ( c, gc )
+      call gamma ( c - a, gca )
+      call gamma ( c - b, gcb )
+      call gamma ( c - a - b, gcab )
+      call gamma ( a + b - c, gabc )
+      c0 = gc * gcab / ( gca * gcb )
+      c1 = gc * gabc / ( ga * gb ) * ( 1.0D+00 - x )**( c - a - b )
+      hf = 0.0D+00
+      r0 = c0
+      r1 = c1
+
+      do k = 1, 250
+
+        r0 = r0 * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
+          / ( k * ( a + b - c + k ) ) * ( 1.0D+00 - x )
+
+        r1 = r1 * ( c - a + k - 1.0D+00 ) * ( c - b + k - 1.0D+00 ) &
+          / ( k * ( c - a - b + k ) ) * ( 1.0D+00 - x )
+
+        hf = hf + r0 + r1
+
+        if ( abs ( hf - hw ) < abs ( hf ) * eps ) then
+          exit
+        end if
+
+        hw = hf
+
+      end do
+
+      hf = hf + c0 + c1
+
+    end if
+
+  else
+
+    a0 = 1.0D+00
+
+    if ( a < c .and. c < 2.0D+00 * a .and. b < c .and. c < 2.0D+00 * b ) then
+
+      a0 = ( 1.0D+00 - x )**( c - a - b )
+      a = c - a
+      b = c - b
+
+    end if
+
+    hf = 1.0D+00
+    r = 1.0D+00
+
+    do k = 1, 250
+
+      r = r * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
+        / ( k * ( c + k - 1.0D+00 ) ) * x
+
+      hf = hf + r
+
+      if ( abs ( hf - hw ) <= abs ( hf ) * eps ) then
+        exit
+      end if
+
+      hw = hf
+
+    end do
+
+    hf = a0 * hf
+
+  end if
+
+  if ( x1 < 0.0D+00 ) then
+    x = x1
+    c0 = 1.0D+00 / ( 1.0D+00 - x )**aa
+    hf = c0 * hf
+  end if
+
+  a = aa
+  b = bb
+
+  if ( 120 < k ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'HYGFX - Warning!'
+    write ( *, '(a)' ) '  A large number of iterations were needed.'
+    write ( *, '(a)' ) '  The accuracy of the results should be checked.'
+  end if
+
+  return
+end
+subroutine hygfz ( a, b, c, z, zhf )
+
+!*****************************************************************************80
+!
+!! HYGFZ computes the hypergeometric function F(a,b,c,x) for complex argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    03 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) A, B, C, parameters.
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, complex ( kind = 8 ) ZHF, the value of F(a,b,c,z).
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) aa
+  real ( kind = 8 ) b
+  real ( kind = 8 ) bb
+  real ( kind = 8 ) c
+  real ( kind = 8 ) ca
+  real ( kind = 8 ) cb
+  real ( kind = 8 ) el
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) g0
+  real ( kind = 8 ) g1
+  real ( kind = 8 ) g2
+  real ( kind = 8 ) g3
+  real ( kind = 8 ) ga
+  real ( kind = 8 ) gab
+  real ( kind = 8 ) gabc
+  real ( kind = 8 ) gam
+  real ( kind = 8 ) gb
+  real ( kind = 8 ) gba
+  real ( kind = 8 ) gbm
+  real ( kind = 8 ) gc
+  real ( kind = 8 ) gca
+  real ( kind = 8 ) gcab
+  real ( kind = 8 ) gcb
+  real ( kind = 8 ) gcbk
+  real ( kind = 8 ) gm
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  logical l0
+  logical l1
+  logical l2
+  logical l3
+  logical l4
+  logical l5
+  logical l6
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) mab
+  integer ( kind = 4 ) mcab
+  integer ( kind = 4 ) nca
+  integer ( kind = 4 ) ncb
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) pa
+  real ( kind = 8 ) pac
+  real ( kind = 8 ) pb
+  real ( kind = 8 ) pca
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) rk1
+  real ( kind = 8 ) rk2
+  real ( kind = 8 ) rm
+  real ( kind = 8 ) sj1
+  real ( kind = 8 ) sj2
+  real ( kind = 8 ) sm
+  real ( kind = 8 ) sp
+  real ( kind = 8 ) sp0
+  real ( kind = 8 ) sq
+  real ( kind = 8 ) t0
+  real ( kind = 8 ) w0
+  real ( kind = 8 ) ws
+  real ( kind = 8 ) x
+  real ( kind = 8 ) y
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) z00
+  complex ( kind = 8 ) z1
+  complex ( kind = 8 ) zc0
+  complex ( kind = 8 ) zc1
+  complex ( kind = 8 ) zf0
+  complex ( kind = 8 ) zf1
+  complex ( kind = 8 ) zhf
+  complex ( kind = 8 ) zp
+  complex ( kind = 8 ) zp0
+  complex ( kind = 8 ) zr
+  complex ( kind = 8 ) zr0
+  complex ( kind = 8 ) zr1
+  complex ( kind = 8 ) zw
+
+  x = real ( z, kind = 8 )
+  y = imag ( z )
+  eps = 1.0D-15
+  l0 = c == int ( c ) .and. c < 0.0D+00
+  l1 = abs ( 1.0D+00 - x ) < eps .and. y == 0.0D+00 .and. &
+    c - a - b <= 0.0D+00
+  l2 = abs ( z + 1.0D+00 ) < eps .and. &
+    abs ( c - a + b - 1.0D+00 ) < eps
+  l3 = a == int ( a ) .and. a < 0.0D+00
+  l4 = b == int ( b ) .and. b < 0.0D+00
+  l5 = c - a == int ( c - a ) .and. c - a <= 0.0D+00
+  l6 = c - b == int ( c - b ) .and. c - b <= 0.0D+00
+  aa = a
+  bb = b
+  a0 = abs ( z )
+  if ( 0.95D+00 < a0 ) then
+    eps = 1.0D-08
+  end if
+  pi = 3.141592653589793D+00
+  el = 0.5772156649015329D+00
+
+  if ( l0 .or. l1 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'HYGFZ - Fatal error!'
+    write ( *, '(a)' ) '  The hypergeometric series is divergent.'
+    stop
+  end if
+
+  if ( a0 == 0.0D+00 .or. a == 0.0D+00 .or. b == 0.0D+00 ) then
+
+    zhf = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+
+  else if ( z == 1.0D+00.and. 0.0D+00 < c - a - b ) then
+
+    call gamma ( c, gc )
+    call gamma ( c - a - b, gcab )
+    call gamma ( c - a, gca )
+    call gamma ( c - b, gcb )
+    zhf = gc * gcab / ( gca * gcb )
+
+  else if ( l2 ) then
+
+    g0 = sqrt ( pi ) * 2.0D+00 ** ( - a )
+    call gamma ( c, g1 )
+    call gamma ( 1.0D+00 + a / 2.0D+00 - b, g2 )
+    call gamma ( 0.5D+00 + 0.5D+00 * a, g3 )
+    zhf = g0 * g1 / ( g2 * g3 )
+
+  else if ( l3 .or. l4 ) then
+
+    if ( l3 ) then
+      nm = int ( abs ( a ) )
+    end if
+
+    if ( l4 ) then
+      nm = int ( abs ( b ) )
+    end if
+
+    zhf = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    zr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, nm
+      zr = zr * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
+        / ( k * ( c + k - 1.0D+00 ) ) * z
+      zhf = zhf + zr
+    end do
+
+  else if ( l5 .or. l6 ) then
+
+    if ( l5 ) then
+      nm = int ( abs ( c - a ) )
+    end if
+
+    if ( l6 ) then
+      nm = int ( abs ( c - b ) )
+    end if
+
+    zhf = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    zr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, nm
+      zr = zr * ( c - a + k - 1.0D+00 ) * ( c - b + k - 1.0D+00 ) &
+        / ( k * ( c + k - 1.0D+00 ) ) * z
+      zhf = zhf + zr
+    end do
+    zhf = ( 1.0D+00 - z ) ** ( c - a - b ) * zhf
+
+  else if ( a0 <= 1.0D+00 ) then
+
+    if ( x < 0.0D+00 ) then
+
+      z1 = z / ( z - 1.0D+00 )
+      if ( a < c .and. b < a .and. 0.0D+00 < b ) then  
+        a = bb
+        b = aa
+      end if
+      zc0 = 1.0D+00 / ( ( 1.0D+00 - z ) ** a )
+      zhf = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      zr0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      do k = 1, 500
+        zr0 = zr0 * ( a + k - 1.0D+00 ) * ( c - b + k - 1.0D+00 ) &
+          / ( k * ( c + k - 1.0D+00 ) ) * z1
+        zhf = zhf + zr0
+        if ( abs ( zhf - zw ) < abs ( zhf ) * eps ) then
+          exit
+        end if
+        zw = zhf
+      end do
+
+      zhf = zc0 * zhf
+
+    else if ( 0.90D+00 <= a0 ) then
+
+      gm = 0.0D+00
+      mcab = int ( c - a - b + eps * sign ( 1.0D+00, c - a - b ) )
+
+      if ( abs ( c - a - b - mcab ) < eps ) then
+
+        m = int ( c - a - b )
+        call gamma ( a, ga )
+        call gamma ( b, gb )
+        call gamma ( c, gc )
+        call gamma ( a + m, gam )
+        call gamma ( b + m, gbm ) 
+        call psi ( a, pa )
+        call psi ( b, pb )
+        if ( m /= 0 ) then
+          gm = 1.0D+00
+        end if
+        do j = 1, abs ( m ) - 1
+          gm = gm * j
+        end do
+        rm = 1.0D+00
+        do j = 1, abs ( m )
+          rm = rm * j
+        end do
+        zf0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+        zr0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+        zr1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+        sp0 = 0.0D+00
+        sp = 0.0D+00
+
+        if ( 0 <= m ) then
+
+          zc0 = gm * gc / ( gam * gbm )
+          zc1 = - gc * ( z - 1.0D+00 ) ** m / ( ga * gb * rm )
+          do k = 1, m - 1
+            zr0 = zr0 * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
+              / ( k * ( k - m ) ) * ( 1.0D+00 - z )
+            zf0 = zf0 + zr0
+          end do
+          do k = 1, m
+            sp0 = sp0 + 1.0D+00 / ( a + k - 1.0D+00 ) &
+              + 1.0D+00 / ( b + k - 1.0D+00 ) - 1.0D+00 / k
+          end do
+          zf1 = pa + pb + sp0 + 2.0D+00 * el + log ( 1.0D+00 - z )
+          do k = 1, 500
+            sp = sp + ( 1.0D+00 - a ) &
+              / ( k * ( a + k - 1.0D+00 ) ) + ( 1.0D+00 - b ) &
+              / ( k * ( b + k - 1.0D+00 ) )
+            sm = 0.0D+00
+            do j = 1, m
+              sm = sm + ( 1.0D+00 - a ) / ( ( j + k ) &
+                * ( a + j + k - 1.0D+00 ) ) &
+                + 1.0D+00 / ( b + j + k - 1.0D+00 )
+            end do
+            zp = pa + pb + 2.0D+00 * el + sp + sm  + log ( 1.0D+00 - z )
+            zr1 = zr1 * ( a + m + k - 1.0D+00 ) &
+              * ( b + m + k - 1.0D+00 ) / ( k * ( m + k ) ) &
+              * ( 1.0D+00 - z )
+            zf1 = zf1 + zr1 * zp
+            if ( abs ( zf1 - zw ) < abs ( zf1 ) * eps ) then
+              exit
+            end if
+            zw = zf1
+          end do
+
+          zhf = zf0 * zc0 + zf1 * zc1
+
+        else if ( m < 0 ) then
+
+          m = - m
+          zc0 = gm * gc / ( ga * gb * ( 1.0D+00 - z ) ** m )
+          zc1 = - ( - 1.0D+00 ) ** m * gc / ( gam * gbm * rm )
+          do k = 1, m - 1
+            zr0 = zr0 * ( a - m + k - 1.0D+00 ) &
+              * ( b - m + k - 1.0D+00 ) / ( k * ( k - m ) ) &
+              * ( 1.0D+00 - z )
+            zf0 = zf0 + zr0
+          end do
+
+          do k = 1, m
+            sp0 = sp0 + 1.0D+00 / k
+          end do
+
+          zf1 = pa + pb - sp0 + 2.0D+00 * el + log ( 1.0D+00 - z )
+
+          do k = 1, 500
+            sp = sp + ( 1.0D+00 - a ) / ( k * ( a + k - 1.0D+00 ) ) &
+              + ( 1.0D+00 - b ) / ( k * ( b + k - 1.0D+00 ) )
+            sm = 0.0D+00
+            do j = 1, m
+              sm = sm + 1.0D+00 / ( j + k )
+            end do
+            zp = pa + pb + 2.0D+00 * el + sp - sm + log ( 1.0D+00 - z )
+            zr1 = zr1 * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
+              / ( k * ( m + k ) ) * ( 1.0D+00 - z )
+            zf1 = zf1 + zr1 * zp
+            if ( abs ( zf1 - zw ) < abs ( zf1 ) * eps ) then
+              exit
+            end if
+            zw = zf1
+
+          end do
+
+          zhf = zf0 * zc0 + zf1 * zc1
+
+        end if
+
+      else
+
+        call gamma ( a, ga )
+        call gamma ( b, gb )
+        call gamma ( c, gc )
+        call gamma ( c - a, gca )
+        call gamma ( c - b, gcb )
+        call gamma ( c - a - b, gcab )
+        call gamma ( a + b - c, gabc )
+        zc0 = gc * gcab / ( gca * gcb )
+        zc1 = gc * gabc / ( ga * gb ) * ( 1.0D+00 - z ) ** ( c - a - b )
+        zhf = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+        zr0 = zc0
+        zr1 = zc1
+        do k = 1, 500
+          zr0 = zr0 * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
+            / ( k * ( a + b - c + k ) ) * ( 1.0D+00 - z )
+          zr1 = zr1 * ( c - a + k - 1.0D+00 ) &
+            * ( c - b + k - 1.0D+00 ) / ( k * ( c - a - b + k ) ) &
+            * ( 1.0D+00 - z )
+          zhf = zhf + zr0 + zr1
+          if ( abs ( zhf - zw ) < abs ( zhf ) * eps ) then
+            exit
+          end if
+          zw = zhf
+        end do
+
+        zhf = zhf + zc0 + zc1
+
+      end if
+
+    else
+
+      z00 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+
+      if ( c - a < a .and. c - b < b ) then
+        z00 = ( 1.0D+00 - z ) ** ( c - a - b )
+        a = c - a
+        b = c - b
+      end if
+
+      zhf = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+      zr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+
+      do k = 1, 1500
+        zr = zr * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
+          / ( k * ( c + k - 1.0D+00 ) ) * z
+        zhf = zhf + zr
+        if ( abs ( zhf - zw ) <= abs ( zhf ) * eps ) then
+          exit
+        end if
+        zw = zhf
+      end do
+
+      zhf = z00 * zhf
+
+    end if
+
+  else if ( 1.0D+00 < a0 ) then
+
+    mab = int ( a - b + eps * sign ( 1.0D+00, a - b ) )
+
+    if ( abs ( a - b - mab ) < eps .and. a0 <= 1.1D+00 ) then
+      b = b + eps
+    end if
+
+    if ( eps < abs ( a - b - mab ) ) then
+
+      call gamma ( a, ga )
+      call gamma ( b, gb )
+      call gamma ( c, gc )
+      call gamma ( a - b, gab )
+      call gamma ( b - a, gba )
+      call gamma ( c - a, gca )
+      call gamma ( c - b, gcb )
+      zc0 = gc * gba / ( gca * gb * ( - z ) ** a )
+      zc1 = gc * gab / ( gcb * ga * ( - z ) ** b )
+      zr0 = zc0
+      zr1 = zc1
+      zhf = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+
+      do k = 1, 500
+        zr0 = zr0 * ( a + k - 1.0D+00 ) * ( a - c + k ) &
+          / ( ( a - b + k ) * k * z )
+        zr1 = zr1 * ( b + k - 1.0D+00 ) * ( b - c + k ) &
+          / ( ( b - a + k ) * k * z )
+        zhf = zhf + zr0 + zr1
+        if ( abs ( ( zhf - zw ) / zhf ) <= eps ) then
+          exit
+        end if
+        zw = zhf
+      end do
+
+      zhf = zhf + zc0 + zc1
+
+    else
+
+      if ( a - b < 0.0D+00 ) then
+        a = bb
+        b = aa
+      end if
+
+      ca = c - a
+      cb = c - b
+      nca = int ( ca + eps * sign ( 1.0D+00, ca ) )
+      ncb = int ( cb + eps * sign ( 1.0D+00, cb ) )
+
+      if ( abs ( ca - nca ) < eps .or. abs ( cb - ncb ) < eps ) then
+        c = c + eps
+      end if
+
+      call gamma ( a, ga )
+      call gamma ( c, gc )
+      call gamma ( c - b, gcb )
+      call psi ( a, pa )
+      call psi ( c - a, pca )
+      call psi ( a - c, pac )
+      mab = int ( a - b + eps )
+      zc0 = gc / ( ga * ( - z ) ** b )
+      call gamma ( a - b, gm )
+      zf0 = gm / gcb * zc0
+      zr = zc0
+      do k = 1, mab - 1
+        zr = zr * ( b + k - 1.0D+00 ) / ( k * z )
+        t0 = a - b - k
+        call gamma ( t0, g0 )
+        call gamma ( c - b - k, gcbk )
+        zf0 = zf0 + zr * g0 / gcbk
+      end do
+
+      if ( mab == 0 ) then
+        zf0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+      end if
+
+      zc1 = gc / ( ga * gcb * ( - z ) ** a )
+      sp = -2.0D+00 * el - pa - pca
+      do j = 1, mab
+        sp = sp + 1.0D+00 / j
+      end do
+      zp0 = sp + log ( - z )
+      sq = 1.0D+00
+      do j = 1, mab
+        sq = sq * ( b + j - 1.0D+00 ) * ( b - c + j ) / j
+      end do
+      zf1 = ( sq * zp0 ) * zc1
+      zr = zc1
+      rk1 = 1.0D+00
+      sj1 = 0.0D+00
+
+      do k = 1, 10000
+        zr = zr / z
+        rk1 = rk1 * ( b + k - 1.0D+00 ) * ( b - c + k ) / ( k * k )
+        rk2 = rk1
+        do j = k + 1, k + mab
+          rk2 = rk2 * ( b + j - 1.0D+00 ) * ( b - c + j ) / j
+        end do
+        sj1 = sj1 + ( a - 1.0D+00 ) / ( k * ( a + k - 1.0D+00 ) ) &
+          + ( a - c - 1.0D+00 ) / ( k * ( a - c + k - 1.0D+00 ) )
+        sj2 = sj1
+        do j = k + 1, k + mab
+          sj2 = sj2 + 1.0D+00 / j
+        end do
+        zp = -2.0D+00 * el - pa - pac + sj2 - 1.0D+00 / ( k + a - c ) &
+          - pi / tan ( pi * ( k + a - c ) ) + log ( - z ) 
+        zf1 = zf1 + rk2 * zr * zp
+        ws = abs ( zf1 )
+        if ( abs ( ( ws - w0 ) / ws ) < eps ) then
+          exit
+        end if
+        w0 = ws
+      end do
+
+      zhf = zf0 + zf1
+
+    end if
+
+  end if
+
+  a = aa
+  b = bb
+  if ( 150 < k ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'HYGFZ - Warning!'
+    write ( *, '(a)' ) '  The solution returned may have low accuracy.'
+  end if
+
+  return
+end
+subroutine ik01a ( x, bi0, di0, bi1, di1, bk0, dk0, bk1, dk1 )
+
+!*****************************************************************************80
+!
+!! IK01A compute Bessel function I0(x), I1(x), K0(x), and K1(x).
+!
+!  Discussion:
+!
+!    This procedure computes modified Bessel functions I0(x), I1(x),
+!    K0(x) and K1(x), and their derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    16 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) BI0, DI0, BI1, DI1, BK0, DK0, BK1, DK1, the
+!    values of I0(x), I0'(x), I1(x), I1'(x), K0(x), K0'(x), K1(x), K1'(x).
+!
+  implicit none
+
+  real ( kind = 8 ), save, dimension ( 12 ) :: a = (/ &
+    0.125D+00, 7.03125D-02, &
+    7.32421875D-02, 1.1215209960938D-01, &
+    2.2710800170898D-01, 5.7250142097473D-01, &
+    1.7277275025845D+00, 6.0740420012735D+00, &
+    2.4380529699556D+01, 1.1001714026925D+02, &
+    5.5133589612202D+02, 3.0380905109224D+03 /)
+  real ( kind = 8 ), save, dimension ( 8 ) :: a1 = (/ &
+    0.125D+00, 0.2109375D+00, &
+    1.0986328125D+00, 1.1775970458984D+01, &
+    2.1461706161499D+02, 5.9511522710323D+03, &
+    2.3347645606175D+05, 1.2312234987631D+07 /)
+  real ( kind = 8 ), save, dimension ( 12 ) :: b = (/ &
+    -0.375D+00, -1.171875D-01, &
+    -1.025390625D-01, -1.4419555664063D-01, &
+    -2.7757644653320D-01, -6.7659258842468D-01, &
+    -1.9935317337513D+00, -6.8839142681099D+00, &
+    -2.7248827311269D+01, -1.2159789187654D+02, &
+    -6.0384407670507D+02, -3.3022722944809D+03 /)
+  real ( kind = 8 ) bi0
+  real ( kind = 8 ) bi1
+  real ( kind = 8 ) bk0
+  real ( kind = 8 ) bk1
+  real ( kind = 8 ) ca
+  real ( kind = 8 ) cb
+  real ( kind = 8 ) ct
+  real ( kind = 8 ) di0
+  real ( kind = 8 ) di1
+  real ( kind = 8 ) dk0
+  real ( kind = 8 ) dk1
+  real ( kind = 8 ) el
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k0
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r
+  real ( kind = 8 ) w0
+  real ( kind = 8 ) ww
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x2
+  real ( kind = 8 ) xr
+  real ( kind = 8 ) xr2
+
+  pi = 3.141592653589793D+00
+  el = 0.5772156649015329D+00
+  x2 = x * x
+
+  if ( x == 0.0D+00 ) then
+
+    bi0 = 1.0D+00
+    bi1 = 0.0D+00
+    bk0 = 1.0D+300
+    bk1 = 1.0D+300
+    di0 = 0.0D+00
+    di1 = 0.5D+00
+    dk0 = -1.0D+300
+    dk1 = -1.0D+300
+    return
+
+  else if ( x <= 18.0D+00 ) then
+
+    bi0 = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 50
+      r = 0.25D+00 * r * x2 / ( k * k )
+      bi0 = bi0 + r
+      if ( abs ( r / bi0 ) < 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    bi1 = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 50
+      r = 0.25D+00 * r * x2 / ( k * ( k + 1 ) )
+      bi1 = bi1 + r
+      if ( abs ( r / bi1 ) < 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    bi1 = 0.5D+00 * x * bi1
+
+  else
+
+    if ( x < 35.0D+00 ) then
+      k0 = 12
+    else if ( x < 50.0D+00 ) then
+      k0 = 9
+    else
+      k0 = 7
+    end if
+
+    ca = exp ( x ) / sqrt ( 2.0D+00 * pi * x )
+    bi0 = 1.0D+00
+    xr = 1.0D+00 / x
+    do k = 1, k0
+      bi0 = bi0 + a(k) * xr ** k
+    end do
+    bi0 = ca * bi0
+    bi1 = 1.0D+00
+    do k = 1, k0
+      bi1 = bi1 + b(k) * xr ** k
+    end do
+    bi1 = ca * bi1
+
+  end if
+
+  if ( x <= 9.0D+00 ) then
+
+    ct = - ( log ( x / 2.0D+00 ) + el )
+    bk0 = 0.0D+00
+    w0 = 0.0D+00
+    r = 1.0D+00
+    do k = 1, 50
+      w0 = w0 + 1.0D+00 / k
+      r = 0.25D+00 * r / ( k * k ) * x2
+      bk0 = bk0 + r * ( w0 + ct )
+      if ( abs ( ( bk0 - ww ) / bk0 ) < 1.0D-15 ) then
+        exit
+      end if
+      ww = bk0
+    end do
+
+    bk0 = bk0 + ct
+
+  else
+
+    cb = 0.5D+00 / x
+    xr2 = 1.0D+00 / x2
+    bk0 = 1.0D+00
+    do k = 1, 8
+      bk0 = bk0 + a1(k) * xr2 ** k
+    end do
+    bk0 = cb * bk0 / bi0
+
+  end if
+
+  bk1 = ( 1.0D+00 / x - bi1 * bk0 ) / bi0
+  di0 = bi1
+  di1 = bi0 - bi1 / x
+  dk0 = - bk1
+  dk1 = - bk0 - bk1 / x
+
+  return
+end
+subroutine ik01b ( x, bi0, di0, bi1, di1, bk0, dk0, bk1, dk1 )
+
+!*****************************************************************************80
+!
+!! IK01B: Bessel functions I0(x), I1(x), K0(x), and K1(x) and derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    17 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) BI0, DI0, BI1, DI1, BK0, DK0, BK1, DK1, the
+!    values of I0(x), I0'(x), I1(x), I1'(x), K0(x), K0'(x), K1(x), K1'(x).
+!
+  implicit none
+
+  real ( kind = 8 ) bi0
+  real ( kind = 8 ) bi1
+  real ( kind = 8 ) bk0
+  real ( kind = 8 ) bk1
+  real ( kind = 8 ) di0
+  real ( kind = 8 ) di1
+  real ( kind = 8 ) dk0
+  real ( kind = 8 ) dk1
+  real ( kind = 8 ) t
+  real ( kind = 8 ) t2
+  real ( kind = 8 ) x
+
+  if ( x == 0.0D+00 ) then
+
+    bi0 = 1.0D+00
+    bi1 = 0.0D+00
+    bk0 = 1.0D+300
+    bk1 = 1.0D+300
+    di0 = 0.0D+00
+    di1 = 0.5D+00
+    dk0 = -1.0D+300
+    dk1 = -1.0D+300
+    return
+
+  else if ( x <= 3.75D+00 ) then
+
+    t = x / 3.75D+00
+    t2 = t * t
+
+    bi0 = ((((( &
+        0.0045813D+00   * t2 &
+      + 0.0360768D+00 ) * t2 &
+      + 0.2659732D+00 ) * t2 &
+      + 1.2067492D+00 ) * t2 &
+      + 3.0899424D+00 ) * t2 &
+      + 3.5156229D+00 ) * t2 &
+      + 1.0D+00
+
+    bi1 = x * (((((( &
+        0.00032411D+00   * t2 &
+      + 0.00301532D+00 ) * t2 &
+      + 0.02658733D+00 ) * t2 &
+      + 0.15084934D+00 ) * t2 &
+      + 0.51498869D+00 ) * t2 &
+      + 0.87890594D+00 ) * t2 &
+      + 0.5D+00 )
+
+  else
+
+    t = 3.75D+00 / x
+
+    bi0 = (((((((( &
+        0.00392377D+00   * t &
+      - 0.01647633D+00 ) * t &
+      + 0.02635537D+00 ) * t &
+      - 0.02057706D+00 ) * t &
+      + 0.916281D-02 ) * t &
+      - 0.157565D-02 ) * t &
+      + 0.225319D-02 ) * t &
+      + 0.01328592D+00 ) * t &
+      + 0.39894228D+00 ) * exp ( x ) / sqrt ( x )
+
+    bi1 = (((((((( &
+      - 0.420059D-02     * t &
+      + 0.01787654D+00 ) * t &
+      - 0.02895312D+00 ) * t &
+      + 0.02282967D+00 ) * t &
+      - 0.01031555D+00 ) * t &
+      + 0.163801D-02 ) * t &
+      - 0.00362018D+00 ) * t &
+      - 0.03988024D+00 ) * t &
+      + 0.39894228D+00 ) * exp ( x ) / sqrt ( x )
+
+  end if
+
+  if ( x <= 2.0D+00 ) then
+
+    t = x / 2.0D+00
+    t2 = t * t
+
+    bk0 = ((((( &
+        0.0000074D+00   * t2 &
+      + 0.0001075D+00 ) * t2 &
+      + 0.00262698D+00 ) * t2 &
+      + 0.0348859D+00 ) * t2 &
+      + 0.23069756D+00 ) * t2 &
+      + 0.4227842D+00 ) * t2 &
+      - 0.57721566D+00 - bi0 * log ( t )
+
+    bk1 = (((((( &
+      - 0.00004686D+00   * t2 &
+      - 0.00110404D+00 ) * t2 &
+      - 0.01919402D+00 ) * t2 &
+      - 0.18156897D+00 ) * t2 &
+      - 0.67278579D+00 ) * t2 &
+      + 0.15443144D+00 ) * t2 &
+      + 1.0D+00 ) / x + bi1 * log ( t )
+
+  else
+
+    t = 2.0D+00 / x
+    t2 = t * t
+
+    bk0 = (((((( &
+        0.00053208D+00   * t &
+      - 0.0025154D+00 )  * t &
+      + 0.00587872D+00 ) * t &
+      - 0.01062446D+00 ) * t &
+      + 0.02189568D+00 ) * t &
+      - 0.07832358D+00 ) * t &
+      + 1.25331414D+00 ) * exp ( - x ) / sqrt ( x )
+
+    bk1 = (((((( &
+      - 0.00068245D+00   * t &
+      + 0.00325614D+00 ) * t &
+      - 0.00780353D+00 ) * t &
+      + 0.01504268D+00 ) * t &
+      - 0.0365562D+00  ) * t & 
+      + 0.23498619D+00 ) * t &
+      + 1.25331414D+00 ) * exp ( - x ) / sqrt ( x )
+
+  end if
+
+  di0 = bi1
+  di1 = bi0 - bi1 / x
+  dk0 = -bk1
+  dk1 = -bk0 - bk1 / x
+
+  return
+end
+subroutine ikna ( n, x, nm, bi, di, bk, dk )
+
+!*****************************************************************************80
+!
+!! IKNA compute Bessel function In(x) and Kn(x), and derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    16 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order of In(x) and Kn(x).
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, integer ( kind = 4 ) NM, the highest order computed.
+!
+!    Output, real ( kind = 8 ) BI(0:N), DI(0:N), BK(0:N), DK(0:N),
+!    the values of In(x), In'(x), Kn(x), Kn'(x).
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) bi(0:n)
+  real ( kind = 8 ) bi0
+  real ( kind = 8 ) bi1
+  real ( kind = 8 ) bk(0:n)
+  real ( kind = 8 ) bk0
+  real ( kind = 8 ) bk1
+  real ( kind = 8 ) di(0:n)
+  real ( kind = 8 ) di0
+  real ( kind = 8 ) di1
+  real ( kind = 8 ) dk(0:n)
+  real ( kind = 8 ) dk0
+  real ( kind = 8 ) dk1
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) g
+  real ( kind = 8 ) g0
+  real ( kind = 8 ) g1
+  real ( kind = 8 ) h
+  real ( kind = 8 ) h0
+  real ( kind = 8 ) h1
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) s0
+  real ( kind = 8 ) x
+
+  nm = n
+
+  if ( x <= 1.0D-100 ) then
+    do k = 0, n
+      bi(k) = 0.0D+00
+      di(k) = 0.0D+00
+      bk(k) = 1.0D+300
+      dk(k) = -1.0D+300
+    end do
+    bi(0) = 1.0D+00
+    di(1) = 0.5D+00
+    return
+  end if
+
+  call ik01a ( x, bi0, di0, bi1, di1, bk0, dk0, bk1, dk1 )
+  bi(0) = bi0
+  bi(1) = bi1
+  bk(0) = bk0
+  bk(1) = bk1
+  di(0) = di0
+  di(1) = di1
+  dk(0) = dk0
+  dk(1) = dk1
+
+  if ( n <= 1 ) then
+    return
+  end if
+
+  if ( 40.0D+00 < x .and. n < int ( 0.25D+00 * x ) ) then
+
+    h0 = bi0
+    h1 = bi1
+    do k = 2, n
+      h = -2.0D+00 * ( k - 1.0D+00 ) / x * h1 + h0
+      bi(k) = h
+      h0 = h1
+      h1 = h
+    end do
+
+  else
+
+    m = msta1 ( x, 200 )
+
+    if ( m < n ) then
+      nm = m
+    else
+      m = msta2 ( x, n, 15 )
+    end if
+
+    f0 = 0.0D+00
+    f1 = 1.0D-100
+    do k = m, 0, -1
+      f = 2.0D+00 * ( k + 1.0D+00 ) * f1 / x + f0
+      if ( k <= nm ) then
+        bi(k) = f
+      end if
+      f0 = f1
+      f1 = f
+    end do
+    s0 = bi0 / f
+    do k = 0, nm
+      bi(k) = s0 * bi(k)
+    end do
+  end if
+
+  g0 = bk0
+  g1 = bk1
+  do k = 2, nm
+    g = 2.0D+00 * ( k - 1.0D+00 ) / x * g1 + g0
+    bk(k) = g
+    g0 = g1
+    g1 = g
+  end do
+
+  do k = 2, nm
+    di(k) = bi(k-1) - k / x * bi(k)
+    dk(k) = - bk(k-1) - k / x * bk(k)
+  end do
+
+  return
+end
+subroutine iknb ( n, x, nm, bi, di, bk, dk )
+
+!*****************************************************************************80
+!
+!! IKNB compute Bessel function In(x) and Kn(x).
+!
+!  Discussion:
+!
+!    Compute modified Bessel functions In(x) and Kn(x),
+!    and their derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    17 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order of In(x) and Kn(x).
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, integer ( kind = 4 ) NM, the highest order computed.
+!
+!    Output, real ( kind = 8 ) BI(0:N), DI(0:N), BK(0:N), DK(0:N),
+!    the values of In(x), In'(x), Kn(x), Kn'(x).
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) bi(0:n)
+  real ( kind = 8 ) bk(0:n)
+  real ( kind = 8 ) bkl
+  real ( kind = 8 ) bs
+  real ( kind = 8 ) di(0:n)
+  real ( kind = 8 ) dk(0:n)
+  real ( kind = 8 ) el
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) g
+  real ( kind = 8 ) g0
+  real ( kind = 8 ) g1
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k0
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r
+  real ( kind = 8 ) s0
+  real ( kind = 8 ) sk0
+  real ( kind = 8 ) vt
+  real ( kind = 8 ) x
+
+  pi = 3.141592653589793D+00
+  el = 0.5772156649015329d0
+  nm = n
+
+  if ( x <= 1.0D-100 ) then
+    do k = 0, n
+      bi(k) = 0.0D+00
+      di(k) = 0.0D+00
+      bk(k) = 1.0D+300
+      dk(k) = -1.0D+300
+    end do
+    bi(0) = 1.0D+00
+    di(1) = 0.5D+00
+    return
+  end if
+
+  if ( n == 0 ) then
+    nm = 1
+  end if
+
+  m = msta1 ( x, 200 )
+  if ( m < nm ) then
+    nm = m
+  else
+    m = msta2 ( x, nm, 15 )
+  end if
+
+  bs = 0.0D+00
+  sk0 = 0.0D+00
+  f0 = 0.0D+00
+  f1 = 1.0D-100
+  do k = m, 0, -1
+    f = 2.0D+00 * ( k + 1.0D+00 ) / x * f1 + f0
+    if ( k <= nm ) then
+      bi(k) = f
+    end if
+    if ( k /= 0 .and. k == 2 * int ( k / 2 ) ) then
+      sk0 = sk0 + 4.0D+00 * f / k
+    end if
+    bs = bs + 2.0D+00 * f
+    f0 = f1
+    f1 = f
+  end do
+
+  s0 = exp ( x ) / ( bs - f )
+  do k = 0, nm
+    bi(k) = s0 * bi(k)
+  end do
+
+  if ( x <= 8.0D+00 ) then
+    bk(0) = - ( log ( 0.5D+00 * x ) + el ) * bi(0) + s0 * sk0
+    bk(1) = ( 1.0D+00 / x - bi(1) * bk(0) ) / bi(0)
+  else
+    a0 = sqrt ( pi / ( 2.0D+00 * x ) ) * exp ( - x ) 
+
+    if ( x < 25.0D+00 ) then
+      k0 = 16
+    else if ( x < 80.0D+00 ) then
+      k0 = 10
+    else if ( x < 200.0D+00 ) then
+      k0 = 8
+    else
+      k0 = 6
+    end if
+
+    do l = 0, 1
+      bkl = 1.0D+00
+      vt = 4.0D+00 * l
+      r = 1.0D+00
+      do k = 1, k0
+        r = 0.125D+00 * r * ( vt - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * x )
+        bkl = bkl + r
+      end do
+      bk(l) = a0 * bkl
+    end do
+  end if
+
+  g0 = bk(0)
+  g1 = bk(1)
+  do k = 2, nm
+    g = 2.0D+00 * ( k - 1.0D+00 ) / x * g1 + g0
+    bk(k) = g
+    g0 = g1
+    g1 = g
+  end do
+
+  di(0) = bi(1)
+  dk(0) = -bk(1)
+  do k = 1, nm
+    di(k) = bi(k-1) - k / x * bi(k)
+    dk(k) = -bk(k-1) - k / x * bk(k)
+  end do
+
+  return
+end
+subroutine ikv ( v, x, vm, bi, di, bk, dk )
+
+!*****************************************************************************80
+!
+!! IKV compute modified Bessel function Iv(x) and Kv(x) and their derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    17 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) V, the order of Iv(x) and Kv(x).
+!    V = N + V0.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) VM, the highest order computed.
+!
+!    Output, real ( kind = 8 ) BI(0:N), DI(0:N), BK(0:N), DK(0:N), the
+!    values of In+v0(x), In+v0'(x), Kn+v0(x), Kn+v0'(x).
+!
+  implicit none
+
+  real ( kind = 8 ) a1
+  real ( kind = 8 ) a2
+  real ( kind = 8 ) bi(0:*)
+  real ( kind = 8 ) bi0
+  real ( kind = 8 ) bk(0:*)
+  real ( kind = 8 ) bk0
+  real ( kind = 8 ) bk1
+  real ( kind = 8 ) bk2
+  real ( kind = 8 ) ca
+  real ( kind = 8 ) cb
+  real ( kind = 8 ) cs
+  real ( kind = 8 ) ct
+  real ( kind = 8 ) di(0:*)
+  real ( kind = 8 ) dk(0:*)
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) f2
+  real ( kind = 8 ) gan
+  real ( kind = 8 ) gap
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k0
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) piv
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) r2
+  real ( kind = 8 ) sum
+  real ( kind = 8 ) v
+  real ( kind = 8 ) v0
+  real ( kind = 8 ) v0n
+  real ( kind = 8 ) v0p
+  real ( kind = 8 ) vm
+  real ( kind = 8 ) vt
+  real ( kind = 8 ) w0
+  real ( kind = 8 ) wa
+  real ( kind = 8 ) ww
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x2
+
+  pi = 3.141592653589793D+00
+  x2 = x * x
+  n = int ( v )
+  v0 = v - n
+  if ( n == 0 ) then
+    n = 1
+  end if
+
+  if ( x < 1.0D-100 ) then
+
+    do k = 0, n
+      bi(k) = 0.0D+00
+      di(k) = 0.0D+00
+      bk(k) = -1.0D+300
+      dk(k) = 1.0D+300
+    end do
+
+    if ( v == 0.0D+00 ) then
+      bi(0) = 1.0D+00
+      di(1) = 0.5D+00
+    end if
+
+    vm = v
+    return
+
+  end if
+
+  piv = pi * v0
+  vt = 4.0D+00 * v0 * v0
+
+  if ( v0 == 0.0D+00 ) then
+    a1 = 1.0D+00
+  else
+    v0p = 1.0D+00 + v0
+    call gamma ( v0p, gap )
+    a1 = ( 0.5D+00 * x ) ** v0 / gap
+  end if
+
+  if ( x < 35.0D+00 ) then
+    k0 = 14
+  else if ( x < 50.0D+00 ) then
+    k0 = 10
+  else
+    k0 = 8
+  end if
+ 
+  if ( x <= 18.0D+00 ) then
+
+    bi0 = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 30
+      r = 0.25D+00 * r * x2 / ( k * ( k + v0 ) )
+      bi0 = bi0 + r
+      if ( abs ( r / bi0 ) < 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    bi0 = bi0 * a1
+
+  else
+
+    ca = exp ( x ) / sqrt ( 2.0D+00 * pi * x )
+    sum = 1.0D+00
+    r = 1.0D+00
+    do k = 1, k0
+      r = -0.125D+00 * r * ( vt - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * x )
+      sum = sum + r
+    end do
+    bi0 = ca * sum
+
+  end if
+
+  m = msta1 ( x, 200 )
+
+  if ( m < n ) then
+    n = m
+  else
+    m = msta2 ( x, n, 15 )
+  end if
+
+  f2 = 0.0D+00
+  f1 = 1.0D-100
+  do k = m, 0, -1
+    f = 2.0D+00 * ( v0 + k + 1.0D+00 ) / x * f1 + f2
+    if ( k <= n ) then
+      bi(k) = f
+    end if
+    f2 = f1
+    f1 = f
+  end do
+
+  cs = bi0 / f
+  do k = 0, n
+    bi(k) = cs * bi(k)
+  end do
+
+  di(0) = v0 / x * bi(0) + bi(1)
+  do k = 1, n
+    di(k) = - ( k + v0 ) / x * bi(k) + bi(k-1)
+  end do
+
+  if ( x <= 9.0D+00 ) then
+
+    if ( v0 == 0.0D+00 ) then
+
+      ct = - log ( 0.5D+00 * x ) - 0.5772156649015329D+00
+      cs = 0.0D+00
+      w0 = 0.0D+00
+      r = 1.0D+00
+      do k = 1, 50
+        w0 = w0 + 1.0D+00 / k
+        r = 0.25D+00 * r / ( k * k ) * x2
+        cs = cs + r * ( w0 + ct )
+        wa = abs ( cs )
+        if ( abs ( ( wa - ww ) / wa ) < 1.0D-15 ) then
+          exit
+        end if
+        ww = wa
+      end do
+
+      bk0 = ct + cs
+
+    else
+
+      v0n = 1.0D+00 - v0
+      call gamma ( v0n, gan )
+      a2 = 1.0D+00 / ( gan * ( 0.5D+00 * x ) ** v0 )
+      a1 = ( 0.5D+00 * x ) ** v0 / gap
+      sum = a2 - a1
+      r1 = 1.0D+00
+      r2 = 1.0D+00
+      do k = 1, 120
+        r1 = 0.25D+00 * r1 * x2 / ( k * ( k - v0 ) )
+        r2 = 0.25D+00 * r2 * x2 / ( k * ( k + v0 ) )
+        sum = sum + a2 * r1 - a1 * r2
+        wa = abs ( sum )
+        if ( abs ( ( wa - ww ) / wa ) < 1.0D-15 ) then
+          exit
+        end if
+        ww = wa
+      end do
+
+      bk0 = 0.5D+00 * pi * sum / sin ( piv )
+
+    end if
+
+  else
+
+    cb = exp ( - x ) * sqrt ( 0.5D+00 * pi / x )
+    sum = 1.0D+00
+    r = 1.0D+00
+    do k = 1, k0
+      r = 0.125D+00 * r * ( vt - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * x )
+      sum = sum + r
+    end do
+    bk0 = cb * sum
+
+  end if
+
+  bk1 = ( 1.0D+00 / x - bi(1) * bk0 ) / bi(0)
+  bk(0) = bk0
+  bk(1) = bk1
+  do k = 2, n
+    bk2 = 2.0D+00 * ( v0 + k - 1.0D+00 ) / x * bk1 + bk0
+    bk(k) = bk2
+    bk0 = bk1
+    bk1 = bk2
+  end do
+
+  dk(0) = v0 / x * bk(0) - bk(1)
+  do k = 1, n
+    dk(k) = - ( k + v0 ) / x * bk(k) - bk(k-1)
+  end do
+
+  vm = n + v0
+
+  return
+end
+subroutine incob ( a, b, x, bix )
+
+!*****************************************************************************80
+!
+!! INCOB computes the incomplete beta function Ix(a,b).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    22 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) A, B, parameters.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) BIX, the function value.
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) b
+  real ( kind = 8 ) bix
+  real ( kind = 8 ) bt
+  real ( kind = 8 ) dk(51)
+  real ( kind = 8 ) fk(51)
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) s0
+  real ( kind = 8 ) t1
+  real ( kind = 8 ) t2
+  real ( kind = 8 ) ta
+  real ( kind = 8 ) tb
+  real ( kind = 8 ) x
+
+  s0 = ( a + 1.0D+00 ) / ( a + b + 2.0D+00 )
+  call beta ( a, b, bt )
+
+  if ( x <= s0 ) then
+
+    do k = 1, 20
+      dk(2*k) = k * ( b - k ) * x / &
+        ( a + 2.0D+00 * k - 1.0D+00 ) / ( a + 2.0D+00 * k )
+    end do
+
+    do k = 0, 20
+      dk(2*k+1) = - ( a + k ) * ( a + b + k ) * x &
+        / ( a + 2.0D+00 * k ) / ( a + 2.0D+00 * k + 1.0D+00 )
+    end do
+
+    t1 = 0.0D+00
+    do k = 20, 1, -1
+      t1 = dk(k) / ( 1.0D+00 + t1 )
+    end do
+    ta = 1.0D+00 / ( 1.0D+00 + t1 )
+    bix = x ** a * ( 1.0D+00 - x ) ** b / ( a * bt ) * ta
+
+  else
+
+    do k = 1, 20
+      fk(2*k) = k * ( a - k ) * ( 1.0D+00 - x ) &
+        / ( b + 2.0D+00 * k - 1.0D+00 ) / ( b + 2.0D+00 * k )
+    end do
+
+    do k = 0,20
+      fk(2*k+1) = - ( b + k ) * ( a + b + k ) * ( 1.0D+00 - x ) &
+        / ( b + 2.0D+00 * k ) / ( b + 2.0D+00 * k + 1.0D+00 )
+    end do
+
+    t2 = 0.0D+00
+    do k = 20, 1, -1
+      t2 = fk(k) / ( 1.0D+00 + t2 )
+    end do
+    tb = 1.0D+00 / ( 1.0D+00 + t2 )
+    bix = 1.0D+00 - x ** a * ( 1.0D+00 - x ) ** b / ( b * bt ) * tb
+
+  end if
+
+  return
+end
+subroutine incog ( a, x, gin, gim, gip )
+
+!*****************************************************************************80
+!
+!! INCOG computes the incomplete gamma function r(a,x), ,(a,x), P(a,x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    22 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) A, the parameter.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) GIN, GIM, GIP, the values of
+!    r(a,x), â(a,x), P(a,x).
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) ga
+  real ( kind = 8 ) gim
+  real ( kind = 8 ) gin
+  real ( kind = 8 ) gip
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) r
+  real ( kind = 8 ) s
+  real ( kind = 8 ) t0
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xam
+
+  xam = -  x + a * log ( x )
+
+  if ( 700.0D+00 < xam .or. 170.0D+00 < a ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'INCOG - Fatal error!'
+    write ( *, '(a)' ) '  A and/or X is too large!'
+    stop
+  end if
+
+  if ( x == 0.0D+00 ) then
+
+    gin = 0.0D+00
+    call gamma ( a, ga )
+    gim = ga
+    gip = 0.0D+00
+
+  else if ( x <= 1.0D+00 + a ) then
+
+    s = 1.0D+00 / a
+    r = s
+    do k = 1, 60
+      r = r * x / ( a + k )
+      s = s + r
+      if ( abs ( r / s ) < 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    gin = exp ( xam ) * s
+    call gamma ( a, ga )
+    gip = gin / ga
+    gim = ga - gin
+
+  else if ( 1.0D+00 + a < x ) then
+
+    t0 = 0.0D+00
+    do k = 60, 1, -1
+      t0 = ( k - a ) / ( 1.0D+00 + k / ( x + t0 ) )
+    end do
+    gim = exp ( xam ) / ( x + t0 )
+    call gamma ( a, ga )
+    gin = ga - gim
+    gip = 1.0D+00 - gim / ga
+
+  end if
+
+  return
+end
+subroutine itairy ( x, apt, bpt, ant, bnt )
+
+!****************************************************************************80
+!
+!! ITAIRY computes the integrals of Airy functions.
+!
+!  Discussion:
+!
+!    Compute the integrals of Airy functions with respect to t,
+!    from 0 and x.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    19 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the upper limit of the integral.
+!
+!    Output, real ( kind = 8 ) APT, BPT, ANT, BNT, the integrals, from 0 to x,
+!    of Ai(t), Bi(t), Ai(-t), and Bi(-t).
+!       
+  implicit none
+
+  real ( kind = 8 ), save, dimension ( 16 ) :: a = (/ &
+    0.569444444444444D+00, 0.891300154320988D+00, &
+    0.226624344493027D+01, 0.798950124766861D+01, &
+    0.360688546785343D+02, 0.198670292131169D+03, &
+    0.129223456582211D+04, 0.969483869669600D+04, &
+    0.824184704952483D+05, 0.783031092490225D+06, &
+    0.822210493622814D+07, 0.945557399360556D+08, &
+    0.118195595640730D+10, 0.159564653040121D+11, &
+    0.231369166433050D+12, 0.358622522796969D+13 /)
+  real ( kind = 8 ) ant
+  real ( kind = 8 ) apt
+  real ( kind = 8 ) bnt
+  real ( kind = 8 ) bpt
+  real ( kind = 8 ) c1
+  real ( kind = 8 ) c2
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) fx
+  real ( kind = 8 ) gx
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) l
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) q0
+  real ( kind = 8 ) q1
+  real ( kind = 8 ) q2
+  real ( kind = 8 ) r
+  real ( kind = 8 ) sr3
+  real ( kind = 8 ) su1
+  real ( kind = 8 ) su2
+  real ( kind = 8 ) su3
+  real ( kind = 8 ) su4
+  real ( kind = 8 ) su5
+  real ( kind = 8 ) su6
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xe
+  real ( kind = 8 ) xp6
+  real ( kind = 8 ) xr1
+  real ( kind = 8 ) xr2
+
+  eps = 1.0D-15
+  pi = 3.141592653589793D+00
+  c1 = 0.355028053887817D+00
+  c2 = 0.258819403792807D+00
+  sr3 = 1.732050807568877D+00
+
+  if ( x == 0.0D+00 ) then
+
+    apt = 0.0D+00
+    bpt = 0.0D+00
+    ant = 0.0D+00
+    bnt = 0.0D+00
+
+  else
+
+    if ( abs ( x ) <= 9.25D+00 ) then
+
+      do l = 0, 1
+
+        x = ( -1.0D+00 ) ** l * x
+        fx = x
+        r = x
+
+        do k = 1, 40
+          r = r * ( 3.0D+00 * k - 2.0D+00 ) &
+            / ( 3.0D+00 * k + 1.0D+00 ) * x / ( 3.0D+00 * k ) &
+            * x / ( 3.0D+00 * k - 1.0D+00 ) * x 
+          fx = fx + r
+          if ( abs ( r ) < abs ( fx ) * eps ) then
+            exit
+          end if
+        end do
+
+        gx = 0.5D+00 * x * x
+        r = gx
+
+        do k = 1, 40
+          r = r * ( 3.0D+00 * k - 1.0D+00 ) &
+            / ( 3.0D+00 * k + 2.0D+00 ) * x / ( 3.0D+00 * k ) * x &
+            / ( 3.0D+00 * k + 1.0D+00 ) * x
+          gx = gx + r
+          if ( abs ( r ) < abs ( gx ) * eps ) then
+            exit
+          end if
+        end do
+
+        ant = c1 * fx - c2 * gx
+        bnt = sr3 * ( c1 * fx + c2 * gx )
+
+        if ( l == 0 ) then
+          apt = ant
+          bpt = bnt
+        else
+          ant = -ant
+          bnt = -bnt
+          x = -x
+        end if
+
+      end do
+
+    else
+
+      q2 = 1.414213562373095D+00
+      q0 = 0.3333333333333333D+00
+      q1 = 0.6666666666666667D+00
+      xe = x * sqrt ( x ) / 1.5D+00
+      xp6 = 1.0D+00 / sqrt ( 6.0D+00 * pi * xe )
+      su1 = 1.0D+00
+      r = 1.0D+00
+      xr1 = 1.0D+00 / xe
+      do k = 1, 16
+        r = - r * xr1
+        su1 = su1 + a(k) * r
+      end do
+      su2 = 1.0D+00
+      r = 1.0D+00
+      do k = 1, 16
+        r = r * xr1
+        su2 = su2 + a(k) * r
+      end do
+
+      apt = q0 - exp ( - xe ) * xp6 * su1
+      bpt = 2.0D+00 * exp ( xe ) * xp6 * su2
+      su3 = 1.0D+00
+      r = 1.0D+00
+      xr2 = 1.0D+00 / ( xe * xe )
+      do k = 1, 8
+        r = - r * xr2
+        su3 = su3 + a(2*k) * r
+      end do
+      su4 = a(1) * xr1
+      r = xr1
+      do k = 1, 7
+        r = -r * xr2
+        su4 = su4 + a(2*k+1) * r
+      end do
+      su5 = su3 + su4
+      su6 = su3 - su4
+      ant = q1 - q2 * xp6 * ( su5 * cos ( xe ) - su6 * sin ( xe ) )
+      bnt = q2 * xp6 * ( su5 * sin ( xe ) + su6 * cos ( xe ) )
+
+    end if
+
+  end if
+
+  return
+end
+subroutine itika ( x, ti, tk )
+
+!*****************************************************************************80
+!
+!! ITIKA computes the integral of the modified Bessel functions I0(t) and K0(t).
+!
+!  Discussion:
+!
+!    This procedure integrates modified Bessel functions I0(t) and
+!    K0(t) with respect to t from 0 to x.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    18 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the upper limit of the integral.
+!
+!    Output, real ( kind = 8 ) TI, TK, the integrals of I0(t) and K0(t)
+!    from 0 to X.
+!
+  implicit none
+
+  real ( kind = 8 ), save, dimension ( 10 ) :: a = (/ &
+    0.625D+00,           1.0078125D+00, &
+    2.5927734375D+00,    9.1868591308594D+00, &
+    4.1567974090576D+01, 2.2919635891914D+02, &
+    1.491504060477D+03,  1.1192354495579D+04, &
+    9.515939374212D+04,  9.0412425769041D+05 /)
+  real ( kind = 8 ) b1
+  real ( kind = 8 ) b2
+  real ( kind = 8 ) e0
+  real ( kind = 8 ) el
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r
+  real ( kind = 8 ) rc1
+  real ( kind = 8 ) rc2
+  real ( kind = 8 ) rs
+  real ( kind = 8 ) ti
+  real ( kind = 8 ) tk
+  real ( kind = 8 ) tw
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x2
+
+  pi = 3.141592653589793D+00
+  el = 0.5772156649015329D+00
+
+  if ( x == 0.0D+00 ) then
+
+    ti = 0.0D+00
+    tk = 0.0D+00
+    return
+
+  else if ( x < 20.0D+00 ) then
+
+    x2 = x * x
+    ti = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 50
+      r = 0.25D+00 * r * ( 2 * k - 1.0D+00 ) / ( 2 * k + 1.0D+00 ) &
+        / ( k * k ) * x2
+      ti = ti + r
+      if ( abs ( r / ti ) < 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    ti = ti * x
+
+  else
+
+    ti = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 10
+      r = r / x
+      ti = ti + a(k) * r
+    end do
+    rc1 = 1.0D+00 / sqrt ( 2.0D+00 * pi * x )
+    ti = rc1 * exp ( x ) * ti
+
+  end if
+
+  if ( x < 12.0D+00 ) then
+
+    e0 = el + log ( x / 2.0D+00 )
+    b1 = 1.0D+00 - e0
+    b2 = 0.0D+00
+    rs = 0.0D+00
+    r = 1.0D+00
+    do k = 1, 50
+      r = 0.25D+00 * r * ( 2 * k - 1.0D+00 ) &
+        / ( 2 * k + 1.0D+00 ) / ( k * k ) * x2
+      b1 = b1 + r * ( 1.0D+00 / ( 2 * k + 1 ) - e0 )
+      rs = rs + 1.0D+00 / k
+      b2 = b2 + r * rs
+      tk = b1 + b2
+      if ( abs ( ( tk - tw ) / tk ) < 1.0D-12 ) then
+        exit
+      end if
+      tw = tk
+    end do
+
+    tk = tk * x
+
+  else
+
+    tk = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 10
+      r = -r / x
+      tk = tk + a(k) * r
+    end do 
+    rc2 = sqrt ( pi / ( 2.0D+00 * x ) )
+    tk = pi / 2.0D+00 - rc2 * tk * exp ( - x )
+
+  end if
+
+  return
+end
+subroutine itikb ( x, ti, tk )
+
+!*****************************************************************************80
+!
+!! ITIKB computes the integral of the Bessel functions I0(t) and K0(t).
+!
+!  Discussion:
+!
+!    This procedure integrates Bessel functions I0(t) and K0(t)
+!    with respect to t from 0 to x.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    24 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+! 
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the upper limit of the integral.
+!
+!    Output, real ( kind = 8 ) TI, TK, the integral of I0(t) and K0(t)
+!    from 0 to X.
+!
+  implicit none
+
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) t
+  real ( kind = 8 ) t1
+  real ( kind = 8 ) ti
+  real ( kind = 8 ) tk
+  real ( kind = 8 ) x
+
+  pi = 3.141592653589793D+00
+
+  if ( x == 0.0D+00 ) then
+
+    ti = 0.0D+00
+
+  else if ( x < 5.0D+00 ) then
+
+    t1 = x / 5.0D+00
+    t = t1 * t1
+    ti = (((((((( &
+        0.59434D-03 * t &
+      + 0.4500642D-02 ) * t &
+      + 0.044686921D+00 ) * t &
+      + 0.300704878D+00 ) * t &
+      + 1.471860153D+00 ) * t &
+      + 4.844024624D+00 ) * t &
+      + 9.765629849D+00 ) * t &
+      +10.416666367D+00 ) * t &
+      + 5.0D+00 ) * t1
+
+  else if ( 5.0D+00 <= x .and. x <= 8.0D+00 ) then
+
+    t = 5.0D+00 / x
+    ti = ((( &
+      - 0.015166D+00 * t &
+      - 0.0202292D+00 ) * t &
+      + 0.1294122D+00 ) * t &
+      - 0.0302912D+00 ) * t &
+      + 0.4161224D+00
+    ti = ti * exp ( x ) / sqrt ( x )
+
+  else
+
+    t = 8.0D+00 / x
+    ti = ((((( &
+      - 0.0073995D+00 * t &
+      + 0.017744D+00 ) * t &
+      - 0.0114858D+00 ) * t &
+      + 0.55956D-02 ) * t &
+      + 0.59191D-02 ) * t &
+      + 0.0311734D+00 ) * t &
+      + 0.3989423D+00
+    ti = ti * exp ( x ) / sqrt ( x )
+
+  end if
+
+  if ( x == 0.0D+00 ) then
+
+    tk = 0.0D+00
+
+  else if ( x <= 2.0D+00 ) then
+
+    t1 = x / 2.0D+00
+    t = t1 * t1
+    tk = (((((( &
+        0.116D-05        * t &
+      + 0.2069D-04 )     * t &
+      + 0.62664D-03 )    * t &
+      + 0.01110118D+00 ) * t &
+      + 0.11227902D+00 ) * t &
+      + 0.50407836D+00 ) * t &
+      + 0.84556868D+00 ) * t1
+    tk = tk - log ( x / 2.0D+00 ) * ti
+
+  else if ( 2.0D+00 < x .and. x <= 4.0D+00 ) then
+
+    t = 2.0D+00 / x
+    tk = ((( &
+        0.0160395D+00   * t &
+      - 0.0781715D+00 ) * t &
+      + 0.185984D+00 )  * t &
+      - 0.3584641D+00 ) * t &
+      + 1.2494934D+00
+    tk = pi / 2.0D+00 - tk * exp ( - x ) / sqrt ( x )
+
+  else if ( 4.0D+00 < x .and. x <= 7.0D+00 ) then
+
+    t = 4.0D+00 / x
+    tk = ((((( &
+        0.37128D-02 * t &
+      - 0.0158449D+00 ) * t &
+      + 0.0320504D+00 ) * t &
+      - 0.0481455D+00 ) * t &
+      + 0.0787284D+00 ) * t &
+      - 0.1958273D+00 ) * t &
+      + 1.2533141D+00
+    tk = pi / 2.0D+00 - tk * exp ( - x ) / sqrt ( x )
+
+  else
+
+    t = 7.0D+00 / x
+    tk = ((((( &
+        0.33934D-03      * t &
+      - 0.163271D-02 )   * t &
+      + 0.417454D-02 )   * t &
+      - 0.933944D-02 )   * t &
+      + 0.02576646D+00 ) * t &
+      - 0.11190289D+00 ) * t &
+      + 1.25331414D+00
+    tk = pi / 2.0D+00 - tk * exp ( - x ) / sqrt ( x )
+
+  end if
+
+  return
+end
+subroutine itjya ( x, tj, ty )
+
+!*****************************************************************************80
+!
+!! ITJYA computes integrals of Bessel functions J0(t) and Y0(t).
+!
+!  Discussion:
+!
+!    This procedure integrates Bessel functions J0(t) and Y0(t) with
+!    respect to t from 0 to x.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    25 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the upper limit of the integral.
+!
+!    Output, real ( kind = 8 ) TJ, TY, the integrals of J0(t) and Y0(t) 
+!    from 0 to x.
+!
+  implicit none
+
+  real ( kind = 8 ) a(18)
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) a1
+  real ( kind = 8 ) af
+  real ( kind = 8 ) bf
+  real ( kind = 8 ) bg
+  real ( kind = 8 ) el
+  real ( kind = 8 ) eps
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r2
+  real ( kind = 8 ) rc
+  real ( kind = 8 ) rs
+  real ( kind = 8 ) tj
+  real ( kind = 8 ) ty
+  real ( kind = 8 ) ty1
+  real ( kind = 8 ) ty2
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x2
+  real ( kind = 8 ) xp
+
+  pi = 3.141592653589793D+00
+  el = 0.5772156649015329D+00
+  eps = 1.0D-12
+
+  if ( x == 0.0D+00 ) then
+
+    tj = 0.0D+00
+    ty = 0.0D+00
+
+  else if ( x <= 20.0D+00 ) then
+
+    x2 = x * x
+    tj = x
+    r = x
+    do k = 1, 60
+      r = -0.25D+00 * r * ( 2 * k - 1.0D+00 ) / ( 2 * k + 1.0D+00 ) &
+        / ( k * k ) * x2
+      tj = tj + r
+      if ( abs ( r ) < abs ( tj ) * eps ) then
+        exit
+      end if
+    end do
+
+    ty1 = ( el + log ( x / 2.0D+00 ) ) * tj
+    rs = 0.0D+00
+    ty2 = 1.0D+00
+    r = 1.0D+00
+
+    do k = 1, 60
+      r = -0.25D+00 * r * ( 2 * k - 1.0D+00 ) / ( 2 * k + 1.0D+00 ) &
+        / ( k * k ) * x2
+      rs = rs + 1.0D+00 / k
+      r2 = r * ( rs + 1.0D+00 / ( 2.0D+00 * k + 1.0D+00 ) )
+      ty2 = ty2 + r2
+      if ( abs ( r2 ) < abs ( ty2 ) * eps ) then
+        exit
+      end if
+    end do
+
+    ty = ( ty1 - x * ty2 ) * 2.0D+00 / pi
+
+  else
+
+    a0 = 1.0D+00
+    a1 = 5.0D+00 / 8.0D+00
+    a(1) = a1
+
+    do k = 1, 16
+      af = ( ( 1.5D+00 * ( k + 0.5D+00 ) * ( k + 5.0D+00 / 6.0D+00 ) &
+        * a1 - 0.5D+00 * ( k + 0.5D+00 ) * ( k + 0.5D+00 )  &
+        * ( k - 0.5D+00 ) * a0 ) ) / ( k + 1.0D+00 )
+      a(k+1) = af
+      a0 = a1
+      a1 = af
+    end do
+
+    bf = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 8
+      r = -r / ( x * x )
+      bf = bf + a(2*k) * r
+    end do
+    bg = a(1) / x
+    r = 1.0D+00 / x
+    do k = 1, 8
+      r = -r / ( x * x )
+      bg = bg + a(2*k+1) * r
+    end do
+    xp = x + 0.25D+00 * pi
+    rc = sqrt ( 2.0D+00 / ( pi * x ) )
+    tj = 1.0D+00 - rc * ( bf * cos ( xp ) + bg * sin ( xp ) )
+    ty = rc * ( bg * cos ( xp ) - bf * sin ( xp ) )
+
+  end if
+
+  return
+end
+subroutine itjyb ( x, tj, ty )
+
+!*****************************************************************************80
+!
+!! ITJYB computes integrals of Bessel functions J0(t) and Y0(t).
+!
+!  Discussion:
+!
+!    This procedure integrates Bessel functions J0(t) and Y0(t)
+!    with respect to t from 0 to x.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    25 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the upper limit of the integral.
+!
+!    Output, real ( kind = 8 ) TJ, TY, the integrals of J0(t) and Y0(t) 
+!    from 0 to x.
+!
+  implicit none
+
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) g0
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) t
+  real ( kind = 8 ) tj
+  real ( kind = 8 ) ty
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x1
+  real ( kind = 8 ) xt
+
+  pi = 3.141592653589793D+00
+
+  if ( x == 0.0D+00 ) then
+
+    tj = 0.0D+00
+    ty = 0.0D+00
+
+  else if ( x <= 4.0D+00 ) then
+
+    x1 = x / 4.0D+00
+    t = x1 * x1
+
+    tj = ((((((( &
+      - 0.133718D-03      * t &
+      + 0.2362211D-02 )   * t &
+      - 0.025791036D+00 ) * t &
+      + 0.197492634D+00 ) * t &
+      - 1.015860606D+00 ) * t &
+      + 3.199997842D+00 ) * t &
+      - 5.333333161D+00 ) * t &
+      + 4.0D+00 ) * x1
+
+    ty = (((((((( &
+        0.13351D-04       * t &
+      - 0.235002D-03 )    * t &
+      + 0.3034322d-02 )   * t &
+      - 0.029600855D+00 ) * t &
+      + 0.203380298D+00 ) * t &
+      - 0.904755062D+00 ) * t &
+      + 2.287317974D+00 ) * t &
+      - 2.567250468D+00 ) * t &
+      + 1.076611469D+00 ) * x1
+
+    ty = 2.0D+00 / pi * log ( x / 2.0D+00 ) * tj - ty
+
+  else if ( x <= 8.0D+00 ) then
+
+    xt = x - 0.25D+00 * pi
+    t = 16.0D+00 / ( x * x )
+
+    f0 = (((((( &
+        0.1496119D-02     * t &
+      - 0.739083D-02 )    * t &
+      + 0.016236617D+00 ) * t &
+      - 0.022007499D+00 ) * t &
+      + 0.023644978D+00 ) * t &
+      - 0.031280848D+00 ) * t &
+      + 0.124611058D+00 ) * 4.0D+00 / x
+
+    g0 = ((((( &
+        0.1076103D-02     * t &
+      - 0.5434851D-02 )   * t &
+      + 0.01242264D+00 )  * t &
+      - 0.018255209D+00 ) * t &
+      + 0.023664841D+00 ) * t &
+      - 0.049635633D+00 ) * t &
+      + 0.79784879D+00
+
+    tj = 1.0D+00 - ( f0 * cos ( xt ) - g0 * sin ( xt ) ) / sqrt ( x )
+
+    ty = - ( f0 * sin ( xt ) + g0 * cos ( xt ) ) / sqrt ( x )
+
+  else
+
+    t = 64.0D+00 / ( x * x )
+    xt = x-0.25D+00 * pi
+
+    f0 = ((((((( &
+      - 0.268482D-04     * t &
+      + 0.1270039D-03 )  * t &
+      - 0.2755037D-03 )  * t &
+      + 0.3992825D-03 )  * t &
+      - 0.5366169D-03 )  * t &
+      + 0.10089872D-02 ) * t &
+      - 0.40403539D-02 ) * t &
+      + 0.0623347304D+00 ) * 8.0D+00 / x
+
+    g0 = (((((( &
+      - 0.226238D-04        * t &
+      + 0.1107299D-03 )     * t &
+      - 0.2543955D-03 )     * t &
+      + 0.4100676D-03 )     * t &
+      - 0.6740148D-03 )     * t &
+      + 0.17870944D-02 )    * t &
+      - 0.01256424405D+00 ) * t &
+      + 0.79788456D+00
+
+    tj = 1.0D+00  - ( f0 * cos ( xt ) - g0 * sin ( xt ) ) / sqrt ( x )
+
+    ty = - ( f0 * sin ( xt ) + g0 * cos ( xt ) ) / sqrt ( x )
+
+  end if
+
+  return
+end
+subroutine itsh0 ( x, th0 )
+
+!*****************************************************************************80
+!
+!! ITSH0 integrates the Struve function H0(t) from 0 to x.
+!
+!  Discussion:
+!
+!    This procedure evaluates the integral of Struve function
+!    H0(t) with respect to t from 0 and x.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    25 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the upper limit of the integral.
+!
+!    Output, real ( kind = 8 ) TH0, the integral of H0(t) from 0 to x.
+!
+  implicit none
+
+  real ( kind = 8 ) a(25)
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) a1
+  real ( kind = 8 ) af
+  real ( kind = 8 ) bf
+  real ( kind = 8 ) bg
+  real ( kind = 8 ) el
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r
+  real ( kind = 8 ) rd
+  real ( kind = 8 ) s
+  real ( kind = 8 ) s0
+  real ( kind = 8 ) th0
+  real ( kind = 8 ) ty
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xp
+
+  pi = 3.141592653589793D+00
+  r = 1.0D+00            
+
+  if ( x <= 30.0D+00 ) then
+
+    s = 0.5D+00
+
+    do k = 1, 100
+
+      if ( k == 1 ) then
+        rd = 0.5D+00
+      else
+        rd = 1.0D+00
+      end if
+
+      r = - r * rd * k / ( k + 1.0D+00 ) &
+        * ( x / ( 2.0D+00 * k + 1.0D+00 ) ) ** 2
+      s = s + r
+
+      if ( abs ( r ) < abs ( s ) * 1.0D-12 ) then
+        exit
+      end if
+
+    end do
+
+    th0 = 2.0D+00 / pi * x * x * s
+
+  else
+
+    s = 1.0D+00
+    do k = 1, 12
+      r = - r * k / ( k + 1.0D+00 ) &
+        * ( ( 2.0D+00 * k + 1.0D+00 ) / x ) ** 2
+      s = s + r
+      if ( abs ( r ) < abs ( s ) * 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    el = 0.57721566490153D+00
+    s0 = s / ( pi * x * x ) + 2.0D+00 / pi &
+      * ( log ( 2.0D+00 * x ) + el )
+    a0 = 1.0D+00
+    a1 = 5.0D+00 / 8.0D+00
+    a(1) = a1
+    do k = 1, 20
+      af = ( ( 1.5D+00 * ( k + 0.5D+00 ) &
+        * ( k + 5.0D+00 / 6.0D+00 ) * a1 - 0.5D+00 &
+        * ( k + 0.5D+00 ) * ( k + 0.5D+00 ) &
+        * ( k - 0.5D+00 ) * a0 ) ) / ( k + 1.0D+00 )
+      a(k+1) = af
+      a0 = a1
+      a1 = af
+    end do
+
+    bf = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 10
+      r = - r / ( x * x )
+      bf = bf + a(2*k) * r
+    end do
+    bg = a(1) / x
+    r = 1.0D+00 / x
+    do k = 1, 10
+      r = - r / ( x * x ) 
+      bg = bg + a(2*k+1) * r
+    end do
+    xp = x + 0.25D+00 * pi
+    ty = sqrt ( 2.0D+00 / ( pi * x ) ) &
+      * ( bg * cos ( xp ) - bf * sin ( xp ) )
+    th0 = ty + s0
+
+  end if
+
+  return
+end
+subroutine itsl0 ( x, tl0 )
+
+!*****************************************************************************80
+!
+!! ITSL0 integrates the Struve function L0(t) from 0 to x.
+!
+!  Discussion:
+!
+!    This procedure evaluates the integral of modified Struve function
+!    L0(t) with respect to t from 0 to x.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    31 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the upper limit of the integral.
+!
+!    Output, real ( kind = 8 ) TL0, the integral of L0(t) from 0 to x.
+!
+  implicit none
+
+  real ( kind = 8 ) a(18)
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) a1
+  real ( kind = 8 ) af
+  real ( kind = 8 ) el
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r
+  real ( kind = 8 ) rd
+  real ( kind = 8 ) s
+  real ( kind = 8 ) s0
+  real ( kind = 8 ) ti
+  real ( kind = 8 ) tl0
+  real ( kind = 8 ) x
+
+  pi = 3.141592653589793D+00
+  r = 1.0D+00
+
+  if ( x <= 20.0D+00 ) then
+
+    s = 0.5D+00
+    do k = 1, 100
+ 
+      if ( k == 1 ) then
+        rd = 0.5D+00
+      else
+        rd = 1.0D+00
+      end if
+      r = r * rd * k / ( k + 1.0D+00 ) &
+        * ( x / ( 2.0D+00 * k + 1.0D+00 ) ) ** 2
+      s = s + r
+      if ( abs ( r / s ) < 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    tl0 = 2.0D+00 / pi * x * x * s
+
+  else
+
+    s = 1.0D+00
+    do k = 1, 10
+      r = r * k / ( k + 1.0D+00 ) &
+        * ( ( 2.0D+00 * k + 1.0D+00 ) / x ) ** 2
+      s = s + r
+      if ( abs ( r / s ) < 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    el = 0.57721566490153D+00
+    s0 = - s / ( pi * x * x ) + 2.0D+00 / pi &
+      * ( log ( 2.0D+00 * x ) + el )
+    a0 = 1.0D+00
+    a1 = 5.0D+00 / 8.0D+00
+    a(1) = a1
+    do k = 1, 10
+      af = ( ( 1.5D+00 * ( k + 0.50D+00 ) &
+        * ( k + 5.0D+00 / 6.0D+00 ) * a1 - 0.5D+00 &
+        * ( k + 0.5D+00 ) ** 2 * ( k -0.5D+00 ) * a0 ) ) &
+        / ( k + 1.0D+00 )
+      a(k+1) = af
+      a0 = a1
+      a1 = af
+    end do
+
+    ti = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 11
+      r = r / x
+      ti = ti + a(k) * r
+    end do
+    tl0 = ti / sqrt ( 2.0D+00 * pi * x ) * exp ( x ) + s0
+
+  end if
+
+  return
+end
+subroutine itth0 ( x, tth )
+
+!*****************************************************************************80
+!
+!! ITTH0 integrates H0(t)/t from x to oo.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    23 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the lower limit of the integral.
+!
+!    Output, real ( kind = 8 ) TTH, the integral of H0(t)/t from x to oo.
+!
+  implicit none
+
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) g0
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r
+  real ( kind = 8 ) s
+  real ( kind = 8 ) t
+  real ( kind = 8 ) tth
+  real ( kind = 8 ) tty
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xt
+
+  pi = 3.141592653589793D+00
+  s = 1.0D+00
+  r = 1.0D+00
+
+  if ( x < 24.5D+00 ) then
+
+    do k = 1, 60
+      r = - r * x * x * ( 2.0D+00 * k - 1.0D+00 ) &
+        / ( 2.0D+00 * k + 1.0D+00 ) ** 3
+      s = s + r
+      if ( abs ( r ) < abs ( s ) * 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    tth = pi / 2.0D+00 - 2.0D+00 / pi * x * s
+
+  else
+
+    do k = 1, 10
+      r = - r * ( 2.0D+00 * k - 1.0D+00 ) ** 3 &
+        / ( ( 2.0D+00 * k + 1.0D+00 ) * x * x )
+      s = s + r
+      if ( abs ( r ) < abs ( s ) * 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    tth = 2.0D+00 / ( pi * x ) * s
+    t = 8.0D+00 / x
+    xt = x + 0.25D+00 * pi
+    f0 = ((((( &
+        0.18118D-02 * t &
+      - 0.91909D-02 ) * t &
+      + 0.017033D+00 ) * t &
+      - 0.9394D-03 ) * t &
+      - 0.051445D+00 ) * t &
+      - 0.11D-05 ) * t &
+      + 0.7978846D+00
+    g0 = ((((( &
+      - 0.23731D-02 * t &
+      + 0.59842D-02 ) * t &
+      + 0.24437D-02 ) * t &
+      - 0.0233178D+00 ) * t &
+      + 0.595D-04 ) * t &
+      + 0.1620695D+00 ) * t
+    tty = ( f0 * sin ( xt ) - g0 * cos ( xt ) ) / ( sqrt ( x ) * x )
+    tth = tth + tty
+
+    end if
+
+  return
+end
+subroutine ittika ( x, tti, ttk )
+
+!*****************************************************************************80
+!
+!! ITTIKA integrates (I0(t)-1)/t from 0 to x, K0(t)/t from x to infinity.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    23 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the integral limit.
+!
+!    Output, real ( kind = 8 ) TTI, TTK, the integrals of [I0(t)-1]/t 
+!    from 0 to x, and of K0(t)/t from x to oo.
+!
+  implicit none
+
+  real ( kind = 8 ) b1
+  real ( kind = 8 ), save, dimension ( 8 ) :: c = (/ &
+    1.625D+00, 4.1328125D+00, &
+    1.45380859375D+01, 6.553353881835D+01, &
+    3.6066157150269D+02, 2.3448727161884D+03, &
+    1.7588273098916D+04, 1.4950639538279D+05 /)
+  real ( kind = 8 ) e0
+  real ( kind = 8 ) el
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r2
+  real ( kind = 8 ) rc
+  real ( kind = 8 ) rs
+  real ( kind = 8 ) tti
+  real ( kind = 8 ) ttk
+  real ( kind = 8 ) x
+
+  pi = 3.141592653589793D+00
+  el = 0.5772156649015329D+00
+
+  if ( x == 0.0D+00 ) then
+    tti = 0.0D+00
+    ttk = 1.0D+300
+    return
+  end if
+
+  if ( x < 40.0D+00 ) then
+    tti = 1.0D+00
+    r = 1.0D+00
+    do k = 2, 50
+      r = 0.25D+00 * r * ( k - 1.0D+00 ) / ( k * k * k ) * x * x
+      tti = tti + r
+      if ( abs ( r / tti ) < 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    tti = tti * 0.125D+00 * x * x
+
+  else
+
+    tti = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 8
+      r = r / x
+      tti = tti + c(k) * r
+    end do
+    rc = x * sqrt ( 2.0D+00 * pi * x )
+    tti = tti * exp ( x ) / rc
+
+  end if
+
+  if ( x <= 12.0D+00 ) then
+
+    e0 = ( 0.5D+00 * log ( x / 2.0D+00 ) + el ) &
+      * log ( x / 2.0D+00 ) + pi * pi / 24.0D+00 + 0.5D+00 * el * el
+    b1 = 1.5D+00 - ( el + log ( x / 2.0D+00 ) )
+    rs = 1.0D+00
+    r = 1.0D+00
+    do k = 2, 50
+      r = 0.25D+00 * r * ( k - 1.0D+00 ) / ( k * k * k ) * x * x
+      rs = rs + 1.0D+00 / k
+      r2 = r * ( rs + 1.0D+00 / ( 2.0D+00 * k ) &
+        - ( el + log ( x / 2.0D+00 ) ) )
+      b1 = b1 + r2
+      if ( abs ( r2 / b1 ) < 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    ttk = e0 - 0.125D+00 * x * x * b1
+
+  else
+
+    ttk = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 8
+      r = - r / x
+      ttk = ttk + c(k) * r
+    end do
+    rc = x * sqrt ( 2.0D+00 / pi * x )
+    ttk = ttk * exp ( - x ) / rc
+
+  end if
+
+  return
+end
+subroutine ittikb ( x, tti, ttk )
+
+!*****************************************************************************80
+!
+!! ITTIKB integrates (I0(t)-1)/t from 0 to x, K0(t)/t from x to infinity.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    28 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the integral limit.
+!
+!    Output, real ( kind = 8 ) TTI, TTK, the integrals of
+!    [I0(t)-1]/t from 0 to x, and K0(t)/t from x to oo.
+!
+  implicit none
+
+  real ( kind = 8 ) e0
+  real ( kind = 8 ) el
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) t
+  real ( kind = 8 ) t1
+  real ( kind = 8 ) tti
+  real ( kind = 8 ) ttk
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x1
+
+  pi = 3.141592653589793D+00
+  el = 0.5772156649015329D+00
+
+  if ( x == 0.0D+00 ) then
+
+    tti = 0.0D+00
+
+  else if ( x <= 5.0D+00 ) then
+
+    x1 = x / 5.0D+00
+    t = x1 * x1
+    tti = ((((((( &
+        0.1263D-03       * t &
+      + 0.96442D-03 )    * t &
+      + 0.968217D-02 )   * t &
+      + 0.06615507D+00 ) * t &
+      + 0.33116853D+00 ) * t &
+      + 1.13027241D+00 ) * t &
+      + 2.44140746D+00 ) * t &
+      + 3.12499991D+00 ) * t
+
+  else
+
+    t = 5.0D+00 / x
+    tti = ((((((((( &
+         2.1945464D+00   * t &
+      -  3.5195009D+00 ) * t &
+      - 11.9094395D+00 ) * t &
+      + 40.394734D+00  ) * t &
+      - 48.0524115D+00 ) * t &
+      + 28.1221478D+00 ) * t &
+      -  8.6556013D+00 ) * t &
+      +  1.4780044D+00 ) * t &
+      -  0.0493843D+00 ) * t &
+      +  0.1332055D+00 ) * t &
+      +  0.3989314D+00
+    tti = tti * exp ( x ) / ( sqrt ( x ) * x )
+
+  end if
+
+  if ( x == 0.0D+00 ) then
+
+    ttk = 1.0D+300
+
+  else if ( x <= 2.0D+00 ) then
+
+    t1 = x / 2.0D+00
+    t = t1 * t1
+    ttk = ((((( &
+        0.77D-06         * t &
+      + 0.1544D-04 )     * t &
+      + 0.48077D-03 )    * t &
+      + 0.925821D-02 )   * t &
+      + 0.10937537D+00 ) * t &
+      + 0.74999993D+00 ) * t
+    e0 = el + log ( x / 2.0D+00 )
+    ttk = pi * pi / 24.0D+00 + e0 * ( 0.5D+00 * e0 + tti ) - ttk
+
+  else if ( x <= 4.0D+00 ) then
+
+    t = 2.0D+00 / x
+    ttk = ((( &
+        0.06084D+00    * t &
+      - 0.280367D+00 ) * t &
+      + 0.590944D+00 ) * t &
+      - 0.850013D+00 ) * t &
+      + 1.234684D+00
+    ttk = ttk * exp ( - x ) / ( sqrt ( x ) * x )
+
+  else
+
+    t = 4.0D+00 / x
+    ttk = ((((( &
+        0.02724D+00     * t &
+      - 0.1110396D+00 ) * t &
+      + 0.2060126D+00 ) * t &
+      - 0.2621446D+00 ) * t &
+      + 0.3219184D+00 ) * t &
+      - 0.5091339D+00 ) * t &
+      + 1.2533141D+00
+    ttk = ttk * exp ( - x ) / ( sqrt ( x ) * x )
+
+  end if
+
+  return
+end
+subroutine ittjya ( x, ttj, tty )
+
+!*****************************************************************************80
+!
+!! ITTJYA integrates (1-J0(t))/t from 0 to x, and Y0(t)/t from x to infinity.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    28 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the integral limit.
+!
+!    Output, real ( kind = 8 ) TTJ, TTY, the integrals of [1-J0(t)]/t 
+!    from 0 to x and of Y0(t)/t from x to oo.
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) b1
+  real ( kind = 8 ) bj0
+  real ( kind = 8 ) bj1
+  real ( kind = 8 ) by0
+  real ( kind = 8 ) by1
+  real ( kind = 8 ) e0
+  real ( kind = 8 ) el
+  real ( kind = 8 ) g0
+  real ( kind = 8 ) g1
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) l
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) px
+  real ( kind = 8 ) qx
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r0
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) r2
+  real ( kind = 8 ) rs
+  real ( kind = 8 ) t
+  real ( kind = 8 ) ttj
+  real ( kind = 8 ) tty
+  real ( kind = 8 ) vt
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xk
+
+  pi = 3.141592653589793D+00
+  el = 0.5772156649015329D+00
+
+  if ( x == 0.0D+00 ) then
+
+    ttj = 0.0D+00
+    tty = -1.0D+300
+
+  else if ( x <= 20.0D+00 ) then
+
+    ttj = 1.0D+00
+    r = 1.0D+00
+    do k = 2, 100
+      r = - 0.25D+00 * r * ( k - 1.0D+00 ) / ( k * k * k ) * x * x
+      ttj = ttj + r
+      if ( abs ( r ) < abs ( ttj ) * 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    ttj = ttj * 0.125D+00 * x * x
+    e0 = 0.5D+00 * ( pi * pi / 6.0D+00 - el * el ) &
+      - ( 0.5D+00 * log ( x / 2.0D+00 ) + el ) &
+      * log ( x / 2.0D+00 )
+    b1 = el + log ( x / 2.0D+00 ) - 1.5D+00
+    rs = 1.0D+00
+    r = -1.0D+00
+    do k = 2, 100
+      r = - 0.25D+00 * r * ( k - 1.0D+00 ) / ( k * k * k ) * x * x
+      rs = rs + 1.0D+00 / k
+      r2 = r * ( rs + 1.0D+00 / ( 2.0D+00 * k ) &
+        - ( el + log ( x / 2.0D+00 ) ) ) 
+      b1 = b1 + r2
+      if ( abs ( r2 ) < abs ( b1 ) * 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    tty = 2.0D+00 / pi * ( e0 + 0.125D+00 * x * x * b1 )
+
+  else
+
+    a0 = sqrt ( 2.0D+00 / ( pi * x ) )
+
+    do l = 0, 1
+
+      vt = 4.0D+00 * l * l
+      px = 1.0D+00
+      r = 1.0D+00
+      do k = 1, 14
+        r = - 0.0078125D+00 * r &
+          * ( vt - ( 4.0D+00 * k - 3.0D+00 ) ** 2 ) &
+          / ( x * k ) * ( vt - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
+          / ( ( 2.0D+00 * k - 1.0D+00 ) * x )
+        px = px + r
+        if ( abs ( r ) < abs ( px ) * 1.0D-12 ) then
+          exit
+        end if
+      end do
+
+      qx = 1.0D+00
+      r = 1.0D+00
+      do k = 1, 14
+        r = -0.0078125D+00 * r &
+          * ( vt - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
+          / ( x * k ) * ( vt - ( 4.0D+00 * k + 1.0D+00 ) ** 2 ) &
+          / ( 2.0D+00 * k + 1.0D+00 ) / x
+        qx = qx + r
+        if ( abs ( r ) < abs ( qx ) * 1.0D-12 ) then
+          exit
+        end if
+      end do
+
+      qx = 0.125D+00 * ( vt - 1.0D+00 ) / x * qx
+      xk = x - ( 0.25D+00 + 0.5D+00 * l ) * pi
+      bj1 = a0 * ( px * cos ( xk ) - qx * sin ( xk ) )
+      by1 = a0 * ( px * sin ( xk ) + qx * cos ( xk ) )
+      if ( l == 0 ) then
+        bj0 = bj1
+        by0 = by1
+      end if
+
+    end do
+
+    t = 2.0D+00 / x
+    g0 = 1.0D+00
+    r0 = 1.0D+00
+    do k = 1, 10
+      r0 = - k * k * t * t *r0
+      g0 = g0 + r0
+    end do
+
+    g1 = 1.0D+00
+    r1 = 1.0D+00
+    do k = 1, 10
+      r1 = - k * ( k + 1.0D+00 ) * t * t * r1
+      g1 = g1 + r1
+    end do
+
+    ttj = 2.0D+00 * g1 * bj0 / ( x * x ) - g0 * bj1 / x &
+      + el + log ( x / 2.0D+00 )
+    tty = 2.0D+00 * g1 * by0 / ( x * x ) - g0 * by1 / x
+
+  end if
+
+  return
+end
+subroutine ittjyb ( x, ttj, tty )
+
+!*****************************************************************************80
+!
+!! ITTJYB integrates (1-J0(t))/t from 0 to x, and Y0(t)/t from x to infinity.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    01 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the integral limit.
+!
+!    Output, real ( kind = 8 ) TTJ, TTY, the integrals of [1-J0(t)]/t 
+!    from 0 to x and of Y0(t)/t from x to oo.
+!
+  implicit none
+
+  real ( kind = 8 ) e0
+  real ( kind = 8 ) el
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) g0
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) t
+  real ( kind = 8 ) t1
+  real ( kind = 8 ) ttj
+  real ( kind = 8 ) tty
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x1
+  real ( kind = 8 ) xt
+
+  pi = 3.141592653589793D+00
+  el = 0.5772156649015329D+00
+
+  if ( x == 0.0D+00 ) then
+
+    ttj = 0.0D+00
+    tty = -1.0D+300
+
+  else if ( x <= 4.0D+00 ) then
+
+    x1 = x / 4.0D+00
+    t = x1 * x1
+
+    ttj = (((((( &
+        0.35817D-04 * t &
+      - 0.639765D-03 ) * t &
+      + 0.7092535D-02 ) * t &
+      - 0.055544803D+00 ) * t &
+      + 0.296292677D+00 ) * t &
+      - 0.999999326D+00 ) * t &
+      + 1.999999936D+00 ) * t
+ 
+    tty = ((((((( &
+      - 0.3546D-05        * t &
+      + 0.76217D-04 )     * t &
+      - 0.1059499D-02 )   * t &
+      + 0.010787555D+00 ) * t &
+      - 0.07810271D+00 )  * t &
+      + 0.377255736D+00 ) * t &
+      - 1.114084491D+00 ) * t &
+      + 1.909859297D+00 ) * t
+
+    e0 = el + log ( x / 2.0D+00 )
+    tty = pi / 6.0D+00 + e0 / pi * ( 2.0D+00 * ttj - e0 ) - tty
+
+  else if ( x <= 8.0D+00 ) then
+
+    xt = x + 0.25D+00 * pi
+    t1 = 4.0D+00 / x
+    t = t1 * t1
+
+    f0 = ((((( &
+        0.0145369D+00 * t &
+      - 0.0666297D+00 ) * t &
+      + 0.1341551D+00 ) * t &
+      - 0.1647797D+00 ) * t &
+      + 0.1608874D+00 ) * t &
+      - 0.2021547D+00 ) * t &
+      + 0.7977506D+00
+
+    g0 = (((((( &
+        0.0160672D+00   * t &
+      - 0.0759339D+00 ) * t &
+      + 0.1576116D+00 ) * t &
+      - 0.1960154D+00 ) * t &
+      + 0.1797457D+00 ) * t &
+      - 0.1702778D+00 ) * t &
+      + 0.3235819D+00 ) * t1
+
+    ttj = ( f0 * cos ( xt ) + g0 * sin ( xt ) ) / ( sqrt ( x ) * x )
+    ttj = ttj + el + log ( x / 2.0D+00 )
+    tty = ( f0 * sin ( xt ) - g0 * cos ( xt ) ) / ( sqrt ( x ) * x )
+
+  else
+
+    t = 8.0D+00 / x
+    xt = x + 0.25D+00 * pi
+
+    f0 = ((((( &
+        0.18118D-02    * t &
+      - 0.91909D-02 )  * t &
+      + 0.017033D+00 ) * t &
+      - 0.9394D-03 )   * t &
+      - 0.051445D+00 ) * t &
+      - 0.11D-05 )     * t &
+      + 0.7978846D+00
+
+    g0 = ((((( &
+      - 0.23731D-02     * t &
+      + 0.59842D-02 )   * t &
+      + 0.24437D-02 )   * t &
+      - 0.0233178D+00 ) * t &
+      + 0.595D-04 )     * t &
+      + 0.1620695D+00 ) * t
+
+    ttj = ( f0 * cos ( xt ) + g0 * sin ( xt ) )  &
+      / ( sqrt ( x ) * x ) + el + log ( x / 2.0D+00 )
+    tty = ( f0 * sin ( xt ) - g0 * cos ( xt ) )  &
+      / ( sqrt ( x ) * x )
+
+  end if
+
+  return
+end
+subroutine jdzo ( nt, n, m, p, zo )
+
+!*****************************************************************************80
+!
+!! JDZO computes the zeros of Bessel functions Jn(x) and Jn'(x).
+!
+!  Discussion:
+!
+!    This procedure computes the zeros of Bessel functions Jn(x) and
+!    Jn'(x), and arrange them in the order of their magnitudes.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    01 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) NT, the number of zeros.
+!
+!    Output, integer ( kind = 4 ) N(*), the  order of Jn(x) or Jn'(x) associated
+!    with the L-th zero.
+!
+!    Output, integer ( kind = 4 ) M(*), the serial number of the zeros of Jn(x)
+!    or Jn'(x) associated with the L-th zero ( L is the serial number of all the
+!    zeros of Jn(x) and Jn'(x) ).
+!
+!    Output, character ( len = 4 ) P(L), 'TM' or 'TE', a code for designating 
+!    the zeros of Jn(x)  or Jn'(x).  In the waveguide applications, the zeros
+!    of Jn(x) correspond to TM modes and those of Jn'(x) correspond to TE modes.
+!
+!    Output, real ( kind = 8 ) ZO(*), the zeros of Jn(x) and Jn'(x).
+!
+  implicit none
+
+  real ( kind = 8 ) bj(101)
+  real ( kind = 8 ) dj(101)
+  real ( kind = 8 ) fj(101)
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) l0
+  integer ( kind = 4 ) l1
+  integer ( kind = 4 ) l2
+  integer ( kind = 4 ) m(1400)
+  integer ( kind = 4 ) m1(70)
+  integer ( kind = 4 ) mm
+  integer ( kind = 4 ) n(1400)
+  integer ( kind = 4 ) n1(70)
+  integer ( kind = 4 ) nm
+  integer ( kind = 4 ) nt
+  character ( len = 4 ) p(1400)
+  character ( len = 4 ) p1(70)
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x0
+  real ( kind = 8 ) x1
+  real ( kind = 8 ) x2
+  real ( kind = 8 ) xm
+  real ( kind = 8 ) zo(1400)
+  real ( kind = 8 ) zoc(70)
+
+  if ( nt < 600 ) then
+    xm = -1.0D+00 + 2.248485D+00 * real ( nt, kind = 8 ) ** 0.5D+00 &
+      - 0.0159382D+00 * nt + 3.208775D-04 * real ( nt, kind = 8 ) ** 1.5D+00
+    nm = int ( 14.5D+00 + 0.05875D+00 * nt )
+    mm = int ( 0.02D+00 * nt ) + 6
+  else
+    xm = 5.0D+00 + 1.445389D+00 * ( real ( nt, kind = 8 ) ) ** 0.5D+00 &
+      + 0.01889876D+00 * nt &
+      - 2.147763D-04 * ( real ( nt, kind = 8 ) ) ** 1.5D+00
+    nm = int ( 27.8D+00 + 0.0327D+00 * nt )
+    mm = int ( 0.01088D+00 * nt ) + 10
+  end if
+
+  l0 = 0
+
+  do i = 1,nm
+
+    x1 = 0.407658D+00 + 0.4795504D+00 &
+      * ( real ( i - 1, kind = 8 ) ) ** 0.5D+00 + 0.983618D+00 * ( i - 1 )
+    x2 = 1.99535D+00 + 0.8333883 * ( real ( i - 1, kind = 8 ) ) ** 0.5D+00 &
+      + 0.984584D+00 * ( i - 1 )
+    l1 = 0
+
+    do j = 1, mm
+
+      if ( i == 1 .and. j == 1 ) then
+
+        l1 = l1 + 1
+        n1(l1) = i - 1
+        m1(l1) = j
+        if ( i == 1 ) then
+          m1(l1) = j - 1
+        end if
+        p1(l1) = 'TE'
+        zoc(l1) = x
+
+        if ( i <= 15 ) then
+          x1 = x + 3.057D+00 + 0.0122D+00 * ( i - 1 ) &
+            + ( 1.555D+00 + 0.41575D+00 * ( i - 1 ) ) / ( j + 1 ) ** 2
+        else
+          x1 = x + 2.918D+00 + 0.01924D+00 * ( i - 1 ) &
+            + ( 6.26D+00 + 0.13205D+00 * ( i - 1 ) ) / ( j + 1 ) ** 2
+        end if
+
+      else
+
+        x = x1
+
+        do
+
+          call bjndd ( i, x, bj, dj, fj )
+          x0 = x
+          x = x - dj(i) / fj(i)
+
+          if ( xm < x1 ) then
+            exit
+          end if
+
+          if ( abs ( x - x0 ) <= 1.0D-10 ) then
+            l1 = l1 + 1
+            n1(l1) = i - 1
+            m1(l1) = j
+            if ( i == 1 ) then
+              m1(l1) = j - 1
+            end if
+            p1(l1) = 'TE'
+            zoc(l1) = x
+
+            if ( i <= 15 ) then
+              x1 = x + 3.057D+00 + 0.0122D+00 * ( i - 1 ) &
+                + ( 1.555D+00 + 0.41575D+00 * ( i - 1 ) ) / ( j + 1 ) ** 2
+            else
+              x1 = x + 2.918D+00 + 0.01924D+00 * ( i - 1 ) &
+                + ( 6.26D+00 + 0.13205D+00 * ( i - 1 ) ) / ( j + 1 ) ** 2
+            end if
+            exit
+          end if
+
+        end do
+
+      end if
+
+      x = x2
+
+      do
+
+        call bjndd ( i, x, bj, dj, fj )
+        x0 = x
+        x = x - bj(i) / dj(i)
+
+        if ( xm < x ) then
+          exit
+        end if
+
+        if ( abs ( x - x0 ) <= 1.0D-10 ) then
+          exit
+        end if
+
+      end do
+
+      if ( x <= xm ) then
+
+        l1 = l1 + 1
+        n1(l1) = i - 1
+        m1(l1) = j
+        p1(l1) = 'TM'
+        zoc(l1) = x
+        if ( i <= 15 ) then
+          x2 = x + 3.11D+00 + 0.0138D+00 * ( i - 1 ) &
+            + ( 0.04832D+00 + 0.2804D+00 * ( i - 1 ) ) / ( j + 1 ) ** 2
+        else
+          x2 = x + 3.001D+00 + 0.0105D+00 * ( i - 1 ) &
+            + ( 11.52D+00 + 0.48525D+00 * ( i - 1 ) ) / ( j + 3 ) ** 2
+        end if
+
+      end if
+
+    end do
+
+    l = l0 + l1
+    l2 = l
+
+    do
+
+      if ( l0 == 0 ) then
+        do k = 1, l
+          zo(k) = zoc(k)
+          n(k) = n1(k)
+          m(k) = m1(k)
+          p(k) = p1(k)
+        end do
+        l1 = 0
+      else if ( l0 /= 0 ) then
+        if ( zoc(l1) .le. zo(l0) ) then
+          zo(l0+l1) = zo(l0)
+          n(l0+l1) = n(l0)
+          m(l0+l1) = m(l0)
+          p(l0+l1) = p(l0)
+          l0 = l0 - 1
+        else
+          zo(l0+l1) = zoc(l1)
+          n(l0+l1) = n1(l1)
+          m(l0+l1) = m1(l1)
+          p(l0+l1) = p1(l1)
+          l1 = l1 - 1
+        end if
+      end if
+
+      if ( l1 == 0 ) then
+        exit 
+      end if
+
+    end do
+
+    l0 = l2
+
+  end do
+
+  return
+end
+subroutine jelp ( u, hk, esn, ecn, edn, eph )
+
+!*****************************************************************************80
+!
+!! JELP computes Jacobian elliptic functions SN(u), CN(u), DN(u).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    08 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) U, the argument.
+!
+!    Input, real ( kind = 8 ) HK, the modulus, between 0 and 1.
+!
+!    Output, real ( kind = 8 ) ESN, ECN, EDN, EPH, the values of
+!    sn(u), cn(u), dn(u), and phi (in degrees).
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) b
+  real ( kind = 8 ) b0
+  real ( kind = 8 ) c
+  real ( kind = 8 ) d
+  real ( kind = 8 ) dn
+  real ( kind = 8 ) ecn
+  real ( kind = 8 ) edn
+  real ( kind = 8 ) eph
+  real ( kind = 8 ) esn
+  real ( kind = 8 ) hk
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) n 
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r(40)
+  real ( kind = 8 ) sa
+  real ( kind = 8 ) t
+  real ( kind = 8 ) u
+
+  pi = 3.14159265358979D+00
+  a0 = 1.0D+00
+  b0 = sqrt ( 1.0D+00 - hk * hk )
+
+  do n = 1, 40
+
+    a = ( a0 + b0 ) / 2.0D+00
+    b = sqrt ( a0 * b0 )
+    c = ( a0 - b0 ) / 2.0D+00
+    r(n) = c / a
+
+    if ( c < 1.0D-07 ) then
+      exit
+    end if
+
+    a0 = a
+    b0 = b
+
+  end do
+
+  dn = 2.0D+00 ** n * a * u
+
+  do j = n, 1, -1
+    t = r(j) * sin ( dn )
+    sa = atan ( t / sqrt ( abs ( 1.0D+00 - t * t )))
+    d = 0.5D+00 * ( dn + sa )
+    dn = d
+  end do
+
+  eph = d * 180.0D+00 / pi
+  esn = sin ( d )
+  ecn = cos ( d )
+  edn = sqrt ( 1.0D+00 - hk * hk * esn * esn )
+
+  return
+end
+subroutine jy01a ( x, bj0, dj0, bj1, dj1, by0, dy0, by1, dy1 )
+
+!*****************************************************************************80
+!
+!! JY01A computes Bessel functions J0(x), J1(x), Y0(x), Y1(x) and derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    01 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) BJ0, DJ0, BJ1, DJ1, BY0, DY0, BY1, DY1,
+!    the values of J0(x), J0'(x), J1(x), J1'(x), Y0(x), Y0'(x), Y1(x), Y1'(x).
+!
+  implicit none
+
+  real ( kind = 8 ), save, dimension(12) :: a = (/ &
+    -0.7031250000000000D-01, 0.1121520996093750D+00, &
+    -0.5725014209747314D+00, 0.6074042001273483D+01, &
+    -0.1100171402692467D+03, 0.3038090510922384D+04, &
+    -0.1188384262567832D+06, 0.6252951493434797D+07, &
+    -0.4259392165047669D+09, 0.3646840080706556D+11, &
+    -0.3833534661393944D+13, 0.4854014686852901D+15 /)
+  real ( kind = 8 ), save, dimension(12) :: a1 = (/ &
+    0.1171875000000000D+00, -0.1441955566406250D+00, &
+    0.6765925884246826D+00, -0.6883914268109947D+01, &
+    0.1215978918765359D+03, -0.3302272294480852D+04, &
+    0.1276412726461746D+06, -0.6656367718817688D+07, &
+    0.4502786003050393D+09, -0.3833857520742790D+11, &
+    0.4011838599133198D+13, -0.5060568503314727D+15 /)
+  real ( kind = 8 ), save, dimension(12) :: b = (/ &
+    0.7324218750000000D-01, -0.2271080017089844D+00, &
+    0.1727727502584457D+01, -0.2438052969955606D+02, &
+    0.5513358961220206D+03, -0.1825775547429318D+05, &
+    0.8328593040162893D+06, -0.5006958953198893D+08, &
+    0.3836255180230433D+10, -0.3649010818849833D+12, &
+    0.4218971570284096D+14, -0.5827244631566907D+16 /)
+  real ( kind = 8 ), save, dimension(12) :: b1 = (/ &
+    -0.1025390625000000D+00, 0.2775764465332031D+00, &
+    -0.1993531733751297D+01, 0.2724882731126854D+02, &
+    -0.6038440767050702D+03, 0.1971837591223663D+05, &
+    -0.8902978767070678D+06, 0.5310411010968522D+08, &
+    -0.4043620325107754D+10, 0.3827011346598605D+12, &
+    -0.4406481417852278D+14, 0.6065091351222699D+16 /)
+  real ( kind = 8 ) bj0
+  real ( kind = 8 ) bj1
+  real ( kind = 8 ) by0
+  real ( kind = 8 ) by1
+  real ( kind = 8 ) cs0
+  real ( kind = 8 ) cs1
+  real ( kind = 8 ) cu
+  real ( kind = 8 ) dj0
+  real ( kind = 8 ) dj1
+  real ( kind = 8 ) dy0
+  real ( kind = 8 ) dy1
+  real ( kind = 8 ) ec
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k0
+  real ( kind = 8 ) p0
+  real ( kind = 8 ) p1
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) q0
+  real ( kind = 8 ) q1
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r0
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) rp2
+  real ( kind = 8 ) t1
+  real ( kind = 8 ) t2
+  real ( kind = 8 ) w0
+  real ( kind = 8 ) w1
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x2
+
+  pi = 3.141592653589793D+00
+  rp2 = 0.63661977236758D+00
+  x2 = x * x
+
+  if ( x == 0.0D+00 ) then
+    bj0 = 1.0D+00
+    bj1 = 0.0D+00
+    dj0 = 0.0D+00
+    dj1 = 0.5D+00
+    by0 = -1.0D+300
+    by1 = -1.0D+300
+    dy0 = 1.0D+300
+    dy1 = 1.0D+300
+    return
+  end if
+
+  if ( x <= 12.0D+00 ) then
+
+    bj0 = 1.0D+00
+    r = 1.0D+00
+    do k = 1,30
+      r = -0.25D+00 * r * x2 / ( k * k )
+      bj0 = bj0 + r
+      if ( abs ( r ) < abs ( bj0 ) * 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    bj1 = 1.0D+00
+    r = 1.0D+00
+    do k = 1, 30
+      r = -0.25D+00 * r * x2 / ( k * ( k + 1.0D+00 ) )
+      bj1 = bj1 + r
+      if ( abs ( r ) < abs ( bj1 ) * 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    bj1 = 0.5D+00 * x * bj1
+    ec = log ( x / 2.0D+00 ) + 0.5772156649015329D+00
+    cs0 = 0.0D+00
+    w0 = 0.0D+00
+    r0 = 1.0D+00
+    do k = 1, 30
+      w0 = w0 + 1.0D+00 / k
+      r0 = -0.25D+00 * r0 / ( k * k ) * x2
+      r = r0 * w0
+      cs0 = cs0 + r
+      if ( abs ( r ) < abs ( cs0 ) * 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    by0 = rp2 * ( ec * bj0 - cs0 )
+    cs1 = 1.0D+00
+    w1 = 0.0D+00
+    r1 = 1.0D+00
+    do k = 1, 30
+      w1 = w1 + 1.0D+00 / k
+      r1 = -0.25D+00 * r1 / ( k * ( k + 1 ) ) * x2
+      r = r1 * ( 2.0D+00 * w1 + 1.0D+00 / ( k + 1.0D+00 ) )
+      cs1 = cs1 + r
+      if ( abs ( r ) < abs ( cs1 ) * 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    by1 = rp2 * ( ec * bj1 - 1.0D+00 / x - 0.25D+00 * x * cs1 )
+
+  else
+
+    if ( x < 35.0D+00 ) then
+      k0 = 12
+    else if ( x < 50.0D+00 ) then
+      k0 = 10
+    else
+      k0 = 8
+    end if
+
+    t1 = x - 0.25D+00 * pi
+    p0 = 1.0D+00
+    q0 = -0.125D+00 / x
+    do k = 1, k0
+      p0 = p0 + a(k) * x ** ( - 2 * k )
+      q0 = q0 + b(k) * x ** ( - 2 * k - 1 )
+    end do
+    cu = sqrt ( rp2 / x )
+    bj0 = cu * ( p0 * cos ( t1 ) - q0 * sin ( t1 ) )
+    by0 = cu * ( p0 * sin ( t1 ) + q0 * cos ( t1 ) )
+    t2 = x - 0.75D+00 * pi
+    p1 = 1.0D+00
+    q1 = 0.375D+00 / x
+    do k = 1, k0
+      p1 = p1 + a1(k) * x ** ( - 2 * k )
+      q1 = q1 + b1(k) * x ** ( - 2 * k - 1 )
+    end do
+    cu = sqrt ( rp2 / x )
+    bj1 = cu * ( p1 * cos ( t2 ) - q1 * sin ( t2 ) )
+    by1 = cu * ( p1 * sin ( t2 ) + q1 * cos ( t2 ) )
+
+  end if
+
+  dj0 = - bj1
+  dj1 = bj0 - bj1 / x
+  dy0 = - by1
+  dy1 = by0 - by1 / x
+
+  return
+end
+subroutine jy01b ( x, bj0, dj0, bj1, dj1, by0, dy0, by1, dy1 )
+
+!*****************************************************************************80
+!
+!! JY01B computes Bessel functions J0(x), J1(x), Y0(x), Y1(x) and derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    02 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) BJ0, DJ0, BJ1, DJ1, BY0, DY0, BY1, DY1,
+!    the values of J0(x), J0'(x), J1(x), J1'(x), Y0(x), Y0'(x), Y1(x), Y1'(x).
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) bj0
+  real ( kind = 8 ) bj1
+  real ( kind = 8 ) by0
+  real ( kind = 8 ) by1
+  real ( kind = 8 ) dj0
+  real ( kind = 8 ) dj1
+  real ( kind = 8 ) dy0
+  real ( kind = 8 ) dy1
+  real ( kind = 8 ) p0
+  real ( kind = 8 ) p1
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) q0
+  real ( kind = 8 ) q1
+  real ( kind = 8 ) t
+  real ( kind = 8 ) t2
+  real ( kind = 8 ) ta0
+  real ( kind = 8 ) ta1
+  real ( kind = 8 ) x
+
+  pi = 3.141592653589793D+00
+
+  if ( x == 0.0D+00 ) then
+
+    bj0 = 1.0D+00
+    bj1 = 0.0D+00
+    dj0 = 0.0D+00
+    dj1 = 0.5D+00
+    by0 = -1.0D+300
+    by1 = -1.0D+300
+    dy0 = 1.0D+300
+    dy1 = 1.0D+300
+    return
+
+  else if ( x <= 4.0D+00 ) then
+
+    t = x / 4.0D+00
+    t2 = t * t
+
+    bj0 = (((((( &
+      - 0.5014415D-03 * t2 &
+      + 0.76771853D-02 ) * t2 &
+      - 0.0709253492D+00 ) * t2 &
+      + 0.4443584263D+00 ) * t2 &
+      - 1.7777560599D+00 ) * t2 &
+      + 3.9999973021D+00 ) * t2 &
+      - 3.9999998721D+00 ) * t2 &
+      + 1.0D+00
+
+    bj1 = t * ((((((( &
+      - 0.1289769D-03 * t2 &
+      + 0.22069155D-02 ) * t2 &
+      - 0.0236616773D+00 ) * t2 &
+      + 0.1777582922D+00 ) * t2 &
+      - 0.8888839649D+00 ) * t2 &
+      + 2.6666660544D+00 ) * t2 &
+      - 3.9999999710D+00 ) * t2 &
+      + 1.9999999998D+00 )
+
+    by0 = ((((((( &
+      - 0.567433D-04 * t2 &
+      + 0.859977D-03 ) * t2 &
+      - 0.94855882D-02 ) * t2 &
+      + 0.0772975809D+00 ) * t2 &
+      - 0.4261737419D+00 ) * t2 &
+      + 1.4216421221D+00 ) * t2 &
+      - 2.3498519931D+00 ) * t2 &
+      + 1.0766115157D+00 ) * t2 &
+      + 0.3674669052D+00
+
+    by0 = 2.0D+00 / pi * log ( x / 2.0D+00 ) * bj0 + by0
+
+    by1 = (((((((( &
+        0.6535773D-03 * t2 &
+      - 0.0108175626D+00 ) * t2 &
+      + 0.107657606D+00 ) * t2 &
+      - 0.7268945577D+00 ) * t2 &
+      + 3.1261399273D+00 ) * t2 &
+      - 7.3980241381D+00 ) * t2 &
+      + 6.8529236342D+00 ) * t2 &
+      + 0.3932562018D+00 ) * t2 &
+      - 0.6366197726D+00 ) / x
+
+    by1 = 2.0D+00 / pi * log ( x / 2.0D+00 ) * bj1 + by1
+
+  else
+
+    t = 4.0D+00 / x
+    t2 = t * t
+    a0 = sqrt ( 2.0D+00 / ( pi * x ) )
+
+    p0 = (((( &
+      - 0.9285D-05 * t2 &
+      + 0.43506D-04 ) * t2 &
+      - 0.122226D-03 ) * t2 &
+      + 0.434725D-03 ) * t2 &
+      - 0.4394275D-02 ) * t2 &
+      + 0.999999997D+00
+
+    q0 = t * ((((( &
+        0.8099D-05 * t2 &
+      - 0.35614D-04 ) * t2 &
+      + 0.85844D-04 ) * t2 &
+      - 0.218024D-03 ) * t2 &
+      + 0.1144106D-02 ) * t2 &
+      - 0.031249995D+00 )
+
+    ta0 = x - 0.25D+00 * pi
+    bj0 = a0 * ( p0 * cos ( ta0 ) - q0 * sin ( ta0 ) )
+    by0 = a0 * ( p0 * sin ( ta0 ) + q0 * cos ( ta0 ) )
+
+    p1 = (((( &
+        0.10632D-04 * t2 &
+      - 0.50363D-04 ) * t2 &
+      + 0.145575D-03 ) * t2 &
+      - 0.559487D-03 ) * t2 &
+      + 0.7323931D-02 ) * t2 &
+      + 1.000000004D+00
+
+    q1 = t * ((((( &
+      - 0.9173D-05      * t2 &
+      + 0.40658D-04 )   * t2 &
+      - 0.99941D-04 )   * t2 &
+      + 0.266891D-03 )  * t2 &
+      - 0.1601836D-02 ) * t2 &
+      + 0.093749994D+00 )
+
+    ta1 = x - 0.75D+00 * pi
+    bj1 = a0 * ( p1 * cos ( ta1 ) - q1 * sin ( ta1 ) )
+    by1 = a0 * ( p1 * sin ( ta1 ) + q1 * cos ( ta1 ) )
+
+  end if
+
+  dj0 = - bj1
+  dj1 = bj0 - bj1 / x
+  dy0 = - by1
+  dy1 = by0 - by1 / x
+
+  return
+end
+subroutine jyna ( n, x, nm, bj, dj, by, dy )
+
+!*****************************************************************************80
+!
+!! JYNA computes Bessel functions Jn(x) and Yn(x) and derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    29 April 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, integer ( kind = 4 ) NM, the highest order computed.
+!
+!    Output, real ( kind = 8 ) BJ(0:N), DJ(0:N), BY(0:N), DY(0:N), the values
+!    of Jn(x), Jn'(x), Yn(x), Yn'(x).
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) bj(0:n)
+  real ( kind = 8 ) bj0
+  real ( kind = 8 ) bj1
+  real ( kind = 8 ) bjk
+  real ( kind = 8 ) by(0:n)
+  real ( kind = 8 ) by0
+  real ( kind = 8 ) by1
+  real ( kind = 8 ) cs
+  real ( kind = 8 ) dj(0:n)
+  real ( kind = 8 ) dj0
+  real ( kind = 8 ) dj1
+  real ( kind = 8 ) dy(0:n)
+  real ( kind = 8 ) dy0
+  real ( kind = 8 ) dy1
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) f2
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) x
+
+  nm = n
+
+  if ( x < 1.0D-100 ) then
+
+    do k = 0, n
+      bj(k) = 0.0D+00
+      dj(k) = 0.0D+00
+      by(k) = -1.0D+300
+      dy(k) = 1.0D+300
+    end do
+    bj(0) = 1.0D+00
+    dj(1) = 0.5D+00
+    return
+
+  end if
+
+  call jy01b ( x, bj0, dj0, bj1, dj1, by0, dy0, by1, dy1 )
+  bj(0) = bj0
+  bj(1) = bj1
+  by(0) = by0
+  by(1) = by1
+  dj(0) = dj0
+  dj(1) = dj1
+  dy(0) = dy0
+  dy(1) = dy1
+
+  if ( n <= 1 ) then
+    return
+  end if
+
+  if ( n < int ( 0.9D+00 * x) ) then
+
+    do k = 2, n
+      bjk = 2.0D+00 * ( k - 1.0D+00 ) / x * bj1 - bj0
+      bj(k) = bjk
+      bj0 = bj1
+      bj1 = bjk
+    end do
+
+  else
+
+    m = msta1 ( x, 200 )
+
+    if ( m < n ) then
+      nm = m
+    else
+      m = msta2 ( x, n, 15 )
+    end if
+
+    f2 = 0.0D+00
+    f1 = 1.0D-100
+    do k = m, 0, -1
+      f = 2.0D+00 * ( k + 1.0D+00 ) / x * f1 - f2
+      if ( k <= nm ) then
+        bj(k) = f
+      end if
+      f2 = f1
+      f1 = f
+    end do
+
+    if ( abs ( bj1 ) < abs ( bj0 ) ) then
+      cs = bj0 / f
+    else
+      cs = bj1 / f2
+    end if
+
+    do k = 0, nm
+      bj(k) = cs * bj(k)
+    end do
+
+  end if
+
+  do k = 2, nm
+    dj(k) = bj(k-1) - k / x * bj(k)
+  end do
+
+  f0 = by(0)
+  f1 = by(1)
+  do k = 2, nm
+    f = 2.0D+00 * ( k - 1.0D+00 ) / x * f1 - f0
+    by(k) = f
+    f0 = f1
+    f1 = f
+  end do
+
+  do k = 2, nm
+    dy(k) = by(k-1) - k * by(k) / x
+  end do
+
+  return
+end
+subroutine jynb ( n, x, nm, bj, dj, by, dy )
+
+!*****************************************************************************80
+!
+!! JYNB computes Bessel functions Jn(x) and Yn(x) and derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    02 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, integer ( kind = 4 ) NM, the highest order computed.
+!
+!    Output, real ( kind = 8 ) BJ(0:N), DJ(0:N), BY(0:N), DY(0:N), the values
+!    of Jn(x), Jn'(x), Yn(x), Yn'(x).
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ), save, dimension ( 4 ) :: a = (/ &
+    -0.7031250000000000D-01, 0.1121520996093750D+00, &
+    -0.5725014209747314D+00, 0.6074042001273483D+01 /)
+  real ( kind = 8 ), save, dimension ( 4 ) :: a1 = (/ &
+    0.1171875000000000D+00, -0.1441955566406250D+00, &
+    0.6765925884246826D+00, -0.6883914268109947D+01 /)
+  real ( kind = 8 ), save, dimension ( 4 ) :: b = (/ &
+    0.7324218750000000D-01, -0.2271080017089844D+00, &
+    0.1727727502584457D+01, -0.2438052969955606D+02 /)
+  real ( kind = 8 ), save, dimension ( 4 ) :: b1 = (/ &
+    -0.1025390625000000D+00, 0.2775764465332031D+00, &
+    -0.1993531733751297D+01, 0.2724882731126854D+02 /)
+  real ( kind = 8 ) bj(0:n)
+  real ( kind = 8 ) bj0
+  real ( kind = 8 ) bj1
+  real ( kind = 8 ) bjk
+  real ( kind = 8 ) bs
+  real ( kind = 8 ) by(0:n)
+  real ( kind = 8 ) by0
+  real ( kind = 8 ) by1
+  real ( kind = 8 ) byk
+  real ( kind = 8 ) cu
+  real ( kind = 8 ) dj(0:n)
+  real ( kind = 8 ) dy(0:n)
+  real ( kind = 8 ) ec
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) f2
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) p0
+  real ( kind = 8 ) p1
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) q0
+  real ( kind = 8 ) q1
+  real ( kind = 8 ) r2p
+  real ( kind = 8 ) s0
+  real ( kind = 8 ) su
+  real ( kind = 8 ) sv
+  real ( kind = 8 ) t1
+  real ( kind = 8 ) t2
+  real ( kind = 8 ) x
+
+  pi = 3.141592653589793D+00
+  r2p = 0.63661977236758D+00
+  nm = n
+
+  if ( x < 1.0D-100 ) then
+    do k = 0, n
+      bj(k) = 0.0D+00
+      dj(k) = 0.0D+00
+      by(k) = -1.0D+300
+      dy(k) = 1.0D+300
+    end do
+    bj(0) = 1.0D+00
+    dj(1) = 0.5D+00
+    return
+  end if
+
+  if ( x <= 300.0D+00 .or. int ( 0.9D+00 * x ) < n ) then
+
+    if ( n == 0 ) then
+      nm = 1
+    end if
+
+    m = msta1 ( x, 200 )
+
+    if ( m < nm ) then
+      nm = m
+    else
+      m = msta2 ( x, nm, 15 )
+    end if
+
+    bs = 0.0D+00
+    su = 0.0D+00
+    sv = 0.0D+00
+    f2 = 0.0D+00
+    f1 = 1.0D-100
+
+    do k = m, 0, -1
+      f = 2.0D+00 * ( k + 1.0D+00 ) / x * f1 - f2
+      if ( k <= nm ) then
+        bj(k) = f
+      end if
+      if ( k == 2 * int ( k / 2 ) .and. k /= 0 ) then
+        bs = bs + 2.0D+00 * f
+        su = su + ( -1.0D+00 ) ** ( k / 2 ) * f / k
+      else if ( 1 < k ) then
+        sv = sv + ( -1.0D+00 ) ** ( k / 2 ) * k / ( k * k - 1.0D+00 ) * f
+      end if
+      f2 = f1
+      f1 = f
+    end do
+
+    s0 = bs + f
+    do k = 0, nm
+      bj(k) = bj(k) / s0
+    end do
+
+    ec = log ( x / 2.0D+00 ) + 0.5772156649015329D+00
+    by0 = r2p * ( ec * bj(0) - 4.0D+00 * su / s0 )
+    by(0) = by0
+    by1 = r2p * ( ( ec - 1.0D+00 ) * bj(1) - bj(0) / x - 4.0D+00 * sv / s0 )
+    by(1) = by1
+
+  else
+
+    t1 = x - 0.25D+00 * pi
+    p0 = 1.0D+00
+    q0 = -0.125D+00 / x
+    do k = 1, 4
+      p0 = p0 + a(k) * x ** ( - 2 * k )
+      q0 = q0 + b(k) * x ** ( - 2 * k - 1 )
+    end do
+    cu = sqrt ( r2p / x )
+    bj0 = cu * ( p0 * cos ( t1 ) - q0 * sin ( t1 ) )
+    by0 = cu * ( p0 * sin ( t1 ) + q0 * cos ( t1 ) )
+    bj(0) = bj0
+    by(0) = by0
+    t2 = x - 0.75D+00 * pi
+    p1 = 1.0D+00
+    q1 = 0.375D+00 / x
+    do k = 1, 4
+      p1 = p1 + a1(k) * x ** ( - 2 * k )
+      q1 = q1 + b1(k) * x ** ( - 2 * k - 1 )
+    end do
+    bj1 = cu * ( p1 * cos ( t2 ) - q1 * sin ( t2 ) )
+    by1 = cu * ( p1 * sin ( t2 ) + q1 * cos ( t2 ) )
+    bj(1) = bj1
+    by(1) = by1
+    do k = 2, nm
+      bjk = 2.0D+00 * ( k - 1.0D+00 ) / x * bj1 - bj0
+      bj(k) = bjk
+      bj0 = bj1
+      bj1 = bjk
+    end do
+  end if
+
+  dj(0) = -bj(1)
+  do k = 1, nm
+    dj(k) = bj(k-1) - k / x * bj(k)
+  end do
+
+  do k = 2, nm
+    byk = 2.0D+00 * ( k - 1.0D+00 ) * by1 / x - by0
+    by(k) = byk
+    by0 = by1
+    by1 = byk
+  end do
+
+  dy(0) = -by(1)
+  do k = 1, nm
+    dy(k) = by(k-1) - k * by(k) / x
+  end do
+
+  return
+end
+subroutine jyndd ( n, x, bjn, djn, fjn, byn, dyn, fyn )
+
+!*****************************************************************************80
+!
+!! JYNDD: Bessel functions Jn(x) and Yn(x), first and second derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    02 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) BJN, DJN, FJN, BYN, DYN, FYN, the values of
+!    Jn(x), Jn'(x), Jn"(x), Yn(x), Yn'(x), Yn"(x).
+!
+  implicit none
+
+  real ( kind = 8 ) bj(102)
+  real ( kind = 8 ) bjn
+  real ( kind = 8 ) byn
+  real ( kind = 8 ) bs
+  real ( kind = 8 ) by(102)
+  real ( kind = 8 ) djn
+  real ( kind = 8 ) dyn
+  real ( kind = 8 ) e0
+  real ( kind = 8 ) ec
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) fjn
+  real ( kind = 8 ) fyn
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) mt
+  integer ( kind = 4 ) n
+  integer ( kind = 4 ) nt
+  real ( kind = 8 ) s1
+  real ( kind = 8 ) su
+  real ( kind = 8 ) x
+
+  do nt = 1, 900
+    mt = int ( 0.5D+00 * log10 ( 6.28D+00 * nt ) &
+      - nt * log10 ( 1.36D+00 * abs ( x ) / nt ) )
+    if ( 20 < mt ) then
+      exit
+    end if
+  end do
+
+  m = nt
+  bs = 0.0D+00
+  f0 = 0.0D+00
+  f1 = 1.0D-35
+  su = 0.0D+00
+  do k = m, 0, -1
+    f = 2.0D+00 * ( k + 1.0D+00 ) * f1 / x - f0
+    if ( k <= n + 1 ) then
+      bj(k+1) = f
+    end if
+    if ( k == 2 * int ( k / 2 ) ) then
+      bs = bs + 2.0D+00 * f
+      if ( k /= 0 ) then
+        su = su + ( -1.0D+00 ) ** ( k / 2 ) * f / k
+      end if
+    end if
+    f0 = f1
+    f1 = f
+  end do
+
+  do k = 0, n + 1
+    bj(k+1) = bj(k+1) / ( bs - f )
+  end do
+
+  bjn = bj(n+1)
+  ec = 0.5772156649015329D+00
+  e0 = 0.3183098861837907D+00
+  s1 = 2.0D+00 * e0 * ( log ( x / 2.0D+00 ) + ec ) * bj(1)
+  f0 = s1 - 8.0D+00 * e0 * su / ( bs - f )
+  f1 = ( bj(2) * f0 - 2.0D+00 * e0 / x ) / bj(1)
+
+  by(1) = f0
+  by(2) = f1
+  do k = 2, n + 1 
+    f = 2.0D+00 * ( k - 1.0D+00 ) * f1 / x - f0
+    by(k+1) = f
+    f0 = f1
+    f1 = f
+  end do
+
+  byn = by(n+1)
+  djn = - bj(n+2) + n * bj(n+1) / x
+  dyn = - by(n+2) + n * by(n+1) / x
+  fjn = ( n * n / ( x * x ) - 1.0D+00 ) * bjn - djn / x
+  fyn = ( n * n / ( x * x ) - 1.0D+00 ) * byn - dyn / x
+
+  return
+end
+subroutine jyv ( v, x, vm, bj, dj, by, dy )
+
+!*****************************************************************************80
+!
+!! JYV computes Bessel functions Jv(x) and Yv(x) and their derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    02 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) V, the order of Jv(x) and Yv(x).
+!
+!    Input, real ( kind = 8 ) X, the argument of Jv(x) and Yv(x).
+!
+!    Output, real ( kind = 8 ) VM, the highest order computed.
+!
+!    Output, real ( kind = 8 ) BJ(0:N), DJ(0:N), BY(0:N), DY(0:N),
+!    the values of Jn+v0(x), Jn+v0'(x), Yn+v0(x), Yn+v0'(x).
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) b
+  real ( kind = 8 ) bj(0:*)
+  real ( kind = 8 ) bju0
+  real ( kind = 8 ) bju1
+  real ( kind = 8 ) bjv0
+  real ( kind = 8 ) bjv1
+  real ( kind = 8 ) bjvl
+  real ( kind = 8 ) by(0:*)
+  real ( kind = 8 ) byv0
+  real ( kind = 8 ) byv1
+  real ( kind = 8 ) byvk
+  real ( kind = 8 ) ck
+  real ( kind = 8 ) cs
+  real ( kind = 8 ) cs0
+  real ( kind = 8 ) cs1
+  real ( kind = 8 ) dj(0:*)
+  real ( kind = 8 ) dy(0:*)
+  real ( kind = 8 ) ec
+  real ( kind = 8 ) el
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) f2
+  real ( kind = 8 ) ga
+  real ( kind = 8 ) gb
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k0
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) pv0
+  real ( kind = 8 ) pv1
+  real ( kind = 8 ) px
+  real ( kind = 8 ) qx
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r0
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) rp
+  real ( kind = 8 ) rp2
+  real ( kind = 8 ) rq
+  real ( kind = 8 ) sk
+  real ( kind = 8 ) v
+  real ( kind = 8 ) v0
+  real ( kind = 8 ) vg
+  real ( kind = 8 ) vl
+  real ( kind = 8 ) vm
+  real ( kind = 8 ) vv
+  real ( kind = 8 ) w0
+  real ( kind = 8 ) w1
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x2
+  real ( kind = 8 ) xk
+
+  el = 0.5772156649015329D+00
+  pi = 3.141592653589793D+00
+  rp2 = 0.63661977236758D+00
+  x2 = x * x
+  n = int ( v )
+  v0 = v - n
+
+  if ( x < 1.0D-100 ) then
+
+    do k = 0, n
+      bj(k) = 0.0D+00
+      dj(k) = 0.0D+00
+      by(k) = -1.0D+300
+      dy(k) = 1.0D+300
+    end do
+
+    if ( v0 == 0.0D+00 ) then
+      bj(0) = 1.0D+00
+      dj(1) = 0.5D+00
+    else
+      dj(0) = 1.0D+300
+    end if
+    vm = v  
+    return
+
+  end if
+
+  if ( x <= 12.0D+00 ) then
+
+    do l = 0, 1
+      vl = v0 + l
+      bjvl = 1.0D+00
+      r = 1.0D+00
+      do k = 1, 40
+        r = -0.25D+00 * r * x2 / ( k * ( k + vl ) )
+        bjvl = bjvl + r
+        if ( abs ( r ) < abs ( bjvl ) * 1.0D-15 ) then
+          exit
+        end if
+      end do
+
+      vg = 1.0D+00 + vl
+      call gamma ( vg, ga )
+      a = ( 0.5D+00 * x ) ** vl / ga
+
+      if ( l == 0 ) then
+        bjv0 = bjvl * a
+      else
+        bjv1 = bjvl * a
+      end if
+
+    end do
+
+  else
+
+    if ( x < 35.0D+00 ) then
+      k0 = 11
+    else if ( x < 50.0D+00 ) then
+      k0 = 10
+    else
+      k0 = 8
+    end if
+
+    do j = 0, 1
+
+      vv = 4.0D+00 * ( j + v0 ) * ( j + v0 )
+      px = 1.0D+00
+      rp = 1.0D+00
+      do k = 1, k0
+        rp = -0.78125D-02 * rp &
+          * ( vv - ( 4.0D+00 * k - 3.0D+00 ) ** 2 ) &
+          * ( vv - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
+          / ( k * ( 2.0D+00 * k - 1.0D+00 ) * x2 )
+        px = px + rp
+      end do
+      qx = 1.0D+00
+      rq = 1.0D+00
+      do k = 1, k0
+        rq = -0.78125D-02 * rq &
+          * ( vv - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
+          * ( vv - ( 4.0D+00 * k + 1.0D+00 ) ** 2 ) &
+          / ( k * ( 2.0D+00 * k + 1.0D+00 ) * x2 )
+        qx = qx + rq
+      end do
+      qx = 0.125D+00 * ( vv - 1.0D+00 ) * qx / x
+      xk = x - ( 0.5D+00 * ( j + v0 ) + 0.25D+00 ) * pi
+      a0 = sqrt ( rp2 / x )
+      ck = cos ( xk )
+      sk = sin ( xk )
+      if ( j == 0 ) then
+        bjv0 = a0 * ( px * ck - qx * sk )
+        byv0 = a0 * ( px * sk + qx * ck )
+      else if ( j == 1 ) then
+        bjv1 = a0 * ( px * ck - qx * sk )
+        byv1 = a0 * ( px * sk + qx * ck )
+      end if
+
+    end do
+
+  end if
+
+  bj(0) = bjv0
+  bj(1) = bjv1
+  dj(0) = v0 / x * bj(0) - bj(1)
+  dj(1) = - ( 1.0D+00 + v0 ) / x * bj(1) + bj(0)
+
+  if ( 2 <= n .and. n <= int ( 0.9D+00 * x ) ) then
+    f0 = bjv0
+    f1 = bjv1
+    do k = 2, n
+      f = 2.0D+00 * ( k + v0 - 1.0D+00 ) / x * f1 - f0
+      bj(k) = f
+      f0 = f1
+      f1 = f
+    end do
+  else if ( 2 <= n ) then
+    m = msta1 ( x, 200 )
+    if ( m < n ) then
+      n = m
+    else
+      m = msta2 ( x, n, 15 )
+    end if
+    f2 = 0.0D+00
+    f1 = 1.0D-100
+    do k = m, 0, -1
+      f = 2.0D+00 * ( v0 + k + 1.0D+00 ) / x * f1 - f2
+      if ( k <= n ) then
+        bj(k) = f
+      end if
+      f2 = f1
+      f1 = f
+    end do
+
+    if ( abs ( bjv1 ) < abs ( bjv0 ) ) then
+      cs = bjv0 / f
+    else
+      cs = bjv1 / f2
+    end if
+    do k = 0, n
+      bj(k) = cs * bj(k)
+    end do
+  end if
+
+  do k = 2, n
+    dj(k) = - ( k + v0 ) / x * bj(k) + bj(k-1)
+  end do
+
+  if ( x <= 12.0D+00 ) then
+
+    if ( v0 /= 0.0D+00 ) then
+
+      do l = 0, 1
+
+        vl = v0 + l
+        bjvl = 1.0D+00
+        r = 1.0D+00
+        do k = 1, 40
+          r = -0.25D+00 * r * x2 / ( k * ( k - vl ) )
+          bjvl = bjvl + r
+          if ( abs ( r ) < abs ( bjvl ) * 1.0D-15 ) then
+            exit
+          end if
+        end do
+
+        vg = 1.0D+00 - vl
+        call gamma ( vg, gb )
+        b = ( 2.0D+00 / x ) ** vl / gb
+
+        if ( l == 0 ) then
+          bju0 = bjvl * b
+        else
+          bju1 = bjvl * b
+        end if
+
+      end do
+
+      pv0 = pi * v0
+      pv1 = pi * ( 1.0D+00 + v0 )
+      byv0 = ( bjv0 * cos ( pv0 ) - bju0 ) / sin ( pv0 )
+      byv1 = ( bjv1 * cos ( pv1 ) - bju1 ) / sin ( pv1 )
+
+    else
+
+      ec = log ( x / 2.0D+00 ) + el
+      cs0 = 0.0D+00
+      w0 = 0.0D+00
+      r0 = 1.0D+00
+      do k = 1, 30
+        w0 = w0 + 1.0D+00 / k
+        r0 = -0.25D+00 * r0 / ( k * k ) * x2
+        cs0 = cs0 + r0 * w0
+      end do
+      byv0 = rp2 * ( ec * bjv0 - cs0 )
+      cs1 = 1.0D+00
+      w1 = 0.0D+00
+      r1 = 1.0D+00
+      do k = 1, 30
+        w1 = w1 + 1.0D+00 / k
+        r1 = -0.25D+00 * r1 / ( k * ( k + 1 ) ) * x2
+        cs1 = cs1 + r1 * ( 2.0D+00 * w1 + 1.0D+00 / ( k + 1.0D+00 ) )
+      end do
+      byv1 = rp2 * ( ec * bjv1 - 1.0D+00 / x - 0.25D+00 * x * cs1 )
+
+    end if
+
+  end if
+
+  by(0) = byv0
+  by(1) = byv1
+  do k = 2, n
+    byvk = 2.0D+00 * ( v0 + k - 1.0D+00 ) / x * byv1 - byv0
+    by(k) = byvk
+    byv0 = byv1
+    byv1 = byvk
+  end do
+
+  dy(0) = v0 / x * by(0) - by(1)
+  do k = 1, n
+    dy(k) = - ( k + v0 ) / x * by(k) + by(k-1)
+  end do
+
+  vm = n + v0
+
+  return
+end
+subroutine jyzo ( n, nt, rj0, rj1, ry0, ry1 )
+
+!*****************************************************************************80
+!
+!! JYZO computes the zeros of Bessel functions Jn(x), Yn(x) and derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    28 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order of the Bessel functions.
+!
+!    Input, integer ( kind = 4 ) NT, the number of zeros.
+!
+!    Output, real ( kind = 8 ) RJ0(NT), RJ1(NT), RY0(NT), RY1(NT), the zeros 
+!    of Jn(x), Jn'(x), Yn(x), Yn'(x).
+!
+  implicit none
+
+  integer ( kind = 4 ) nt
+
+  real ( kind = 8 ) bjn
+  real ( kind = 8 ) byn
+  real ( kind = 8 ) djn
+  real ( kind = 8 ) dyn
+  real ( kind = 8 ) fjn
+  real ( kind = 8 ) fyn
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) n_r8
+  real ( kind = 8 ) rj0(nt)
+  real ( kind = 8 ) rj1(nt)
+  real ( kind = 8 ) ry0(nt)
+  real ( kind = 8 ) ry1(nt)
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x0
+
+  n_r8 = real ( n, kind = 8 )
+
+  if ( n <= 20 ) then
+    x = 2.82141D+00 + 1.15859D+00 * n_r8 
+  else
+    x = n + 1.85576D+00 * n_r8 ** 0.33333D+00 &
+      + 1.03315D+00 / n_r8 ** 0.33333D+00
+  end if
+
+  l = 0
+
+  do
+
+    x0 = x
+    call jyndd ( n, x, bjn, djn, fjn, byn, dyn, fyn )
+    x = x - bjn / djn
+
+    if ( 1.0D-09 < abs ( x - x0 ) ) then
+      cycle
+    end if
+
+    l = l + 1
+    rj0(l) = x
+    x = x + 3.1416D+00 + ( 0.0972D+00 + 0.0679D+00 * n_r8 &
+      - 0.000354D+00 * n_r8 ** 2 ) / l
+
+    if ( nt <= l ) then
+      exit
+    end if
+
+  end do
+
+  if ( n <= 20 ) then
+    x = 0.961587D+00 + 1.07703D+00 * n_r8 
+  else
+    x = n_r8 + 0.80861D+00 * n_r8 ** 0.33333D+00 &
+      + 0.07249D+00 / n_r8 ** 0.33333D+00
+  end if
+
+  if ( n == 0 ) then
+    x = 3.8317D+00
+  end if
+
+  l = 0
+
+  do
+
+    x0 = x
+    call jyndd ( n, x, bjn, djn, fjn, byn, dyn, fyn )
+    x = x - djn / fjn
+    if ( 1.0D-09 < abs ( x - x0 ) ) then
+      cycle
+    end if
+    l = l + 1
+    rj1(l) = x
+    x = x + 3.1416D+00 + ( 0.4955D+00 + 0.0915D+00 * n_r8 &
+      - 0.000435D+00 * n_r8 ** 2 ) / l
+
+    if ( nt <= l ) then
+      exit
+    end if
+
+  end do
+
+  if ( n <= 20 ) then
+    x = 1.19477D+00 + 1.08933D+00 * n_r8 
+  else
+    x = n_r8 + 0.93158D+00 * n_r8 ** 0.33333D+00 &
+      + 0.26035D+00 / n_r8 ** 0.33333D+00
+  end if
+ 
+  l = 0
+
+  do
+
+    x0 = x
+    call jyndd ( n, x, bjn, djn, fjn, byn, dyn, fyn )
+    x = x - byn / dyn
+
+    if ( 1.0D-09 < abs ( x - x0 ) ) then
+      cycle
+    end if
+
+    l = l + 1
+    ry0(l) = x 
+    x = x + 3.1416D+00 + ( 0.312D+00 + 0.0852D+00 * n_r8 &
+      - 0.000403D+00 * n_r8 ** 2 ) / l
+
+    if ( nt <= l ) then
+      exit
+    end if
+
+  end do
+
+  if ( n <= 20 ) then
+    x = 2.67257D+00 + 1.16099D+00 * n_r8 
+  else
+    x = n_r8 + 1.8211D+00 * n_r8 ** 0.33333D+00 &
+      + 0.94001D+00 / n_r8 ** 0.33333D+00
+  end if
+  
+  l = 0
+
+  do
+
+    x0 = x
+    call jyndd ( n, x, bjn, djn, fjn, byn, dyn, fyn )
+    x = x - dyn / fyn
+
+    if ( 1.0D-09 < abs ( x - x0 ) ) then
+      cycle
+    end if
+
+    l = l + 1
+    ry1(l) = x
+    x = x + 3.1416D+00 + ( 0.197D+00 + 0.0643D+00 * n_r8 &
+      -0.000286D+00 * n_r8 ** 2 ) / l 
+
+    if ( nt <= l ) then
+      exit
+    end if
+
+  end do
+
+  return
+end
+subroutine klvna ( x, ber, bei, ger, gei, der, dei, her, hei )
+
+!*****************************************************************************80
+!
+!! KLVNA: Kelvin functions ber(x), bei(x), ker(x), and kei(x), and derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    03 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) BER, BEI, GER, GEI, DER, DEI, HER, HEI, 
+!    the values of ber x, bei x, ker x, kei x, ber'x, bei'x, ker'x, kei'x.
+!
+  implicit none
+
+  real ( kind = 8 ) bei
+  real ( kind = 8 ) ber
+  real ( kind = 8 ) cn0
+  real ( kind = 8 ) cp0
+  real ( kind = 8 ) cs
+  real ( kind = 8 ) dei
+  real ( kind = 8 ) der
+  real ( kind = 8 ) el
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) fac
+  real ( kind = 8 ) gei
+  real ( kind = 8 ) ger
+  real ( kind = 8 ) gs
+  real ( kind = 8 ) hei
+  real ( kind = 8 ) her
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) km
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) pn0
+  real ( kind = 8 ) pn1
+  real ( kind = 8 ) pp0
+  real ( kind = 8 ) pp1
+  real ( kind = 8 ) qn0
+  real ( kind = 8 ) qn1
+  real ( kind = 8 ) qp0
+  real ( kind = 8 ) qp1
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r0
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) rc
+  real ( kind = 8 ) rs
+  real ( kind = 8 ) sn0
+  real ( kind = 8 ) sp0
+  real ( kind = 8 ) ss
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x2
+  real ( kind = 8 ) x4
+  real ( kind = 8 ) xc1
+  real ( kind = 8 ) xc2
+  real ( kind = 8 ) xd
+  real ( kind = 8 ) xe1
+  real ( kind = 8 ) xe2
+  real ( kind = 8 ) xt
+
+  pi = 3.141592653589793D+00
+  el = 0.5772156649015329D+00
+  eps = 1.0D-15
+
+  if ( x == 0.0D+00 ) then
+    ber = 1.0D+00
+    bei = 0.0D+00
+    ger = 1.0D+300
+    gei = -0.25D+00 * pi
+    der = 0.0D+00
+    dei = 0.0D+00
+    her = -1.0D+300
+    hei = 0.0D+00
+    return
+  end if
+
+  x2 = 0.25D+00 * x * x
+  x4 = x2 * x2
+
+  if ( abs ( x ) < 10.0D+00 ) then
+
+    ber = 1.0D+00
+    r = 1.0D+00
+    do m = 1, 60
+      r = -0.25D+00 * r / ( m * m ) / ( 2.0D+00 * m - 1.0D+00 ) ** 2 * x4
+      ber = ber + r
+      if ( abs ( r ) < abs ( ber ) * eps ) then
+        exit
+      end if
+    end do
+
+    bei = x2
+    r = x2
+    do m = 1, 60
+      r = -0.25D+00 * r / ( m * m ) / ( 2.0D+00 * m + 1.0D+00 ) ** 2 * x4
+      bei = bei + r
+      if ( abs ( r ) < abs ( bei ) * eps ) then
+        exit
+      end if
+    end do
+
+    ger = - ( log ( x / 2.0D+00 ) + el ) * ber + 0.25D+00 * pi * bei
+    r = 1.0D+00
+    gs = 0.0D+00
+    do m = 1, 60
+      r = -0.25D+00 * r / ( m * m ) / ( 2.0D+00 * m - 1.0D+00 ) ** 2 * x4
+      gs = gs + 1.0D+00 / ( 2.0D+00 * m - 1.0D+00 ) + 1.0D+00 / ( 2.0D+00 * m )
+      ger = ger + r * gs
+      if ( abs ( r * gs ) < abs ( ger ) * eps ) then
+        exit
+      end if
+    end do
+
+    gei = x2 - ( log ( x / 2.0D+00 ) + el ) * bei - 0.25D+00 * pi * ber
+    r = x2
+    gs = 1.0D+00
+    do m = 1, 60
+      r = -0.25D+00 * r / ( m * m ) / ( 2.0D+00 * m + 1.0D+00 ) ** 2 * x4
+      gs = gs + 1.0D+00 / ( 2.0D+00 * m ) + 1.0D+00 / ( 2.0D+00 * m + 1.0D+00 )
+      gei = gei + r * gs
+      if ( abs ( r * gs ) < abs ( gei ) * eps ) then
+        exit
+      end if
+    end do
+
+    der = -0.25D+00 * x * x2
+    r = der
+    do m = 1, 60
+      r = -0.25D+00 * r / m / ( m + 1.0D+00 ) &
+        / ( 2.0D+00 * m + 1.0D+00 ) ** 2 * x4
+      der = der + r
+      if ( abs ( r ) < abs ( der ) * eps ) then
+        exit
+      end if
+    end do
+
+    dei = 0.5D+00 * x
+    r = dei
+    do m = 1, 60
+      r = -0.25D+00 * r / ( m * m ) / ( 2.0D+00 * m - 1.0D+00 ) &
+        / ( 2.0D+00 * m + 1.0D+00 ) * x4
+      dei = dei + r
+      if ( abs ( r ) < abs ( dei ) * eps ) then
+        exit
+      end if
+    end do
+
+    r = -0.25D+00 * x * x2
+    gs = 1.5D+00
+    her = 1.5D+00 * r - ber / x &
+      - ( log ( x / 2.0D+00 ) + el ) * der + 0.25D+00 * pi * dei
+    do m = 1, 60
+      r = -0.25D+00 * r / m / ( m + 1.0D+00 ) &
+        / ( 2.0D+00 * m + 1.0D+00 ) ** 2 * x4
+      gs = gs + 1.0D+00 / ( 2 * m + 1.0D+00 ) + 1.0D+00 &
+        / ( 2 * m + 2.0D+00 )
+      her = her + r * gs
+      if ( abs ( r * gs ) < abs ( her ) * eps ) then
+        exit
+      end if
+    end do
+
+    r = 0.5D+00 * x
+    gs = 1.0D+00
+    hei = 0.5D+00 * x - bei / x &
+      - ( log ( x / 2.0D+00 ) + el ) * dei - 0.25D+00 * pi * der
+    do m = 1, 60
+      r = -0.25D+00 * r / ( m * m ) / ( 2 * m - 1.0D+00 ) &
+        / ( 2 * m + 1.0D+00 ) * x4
+      gs = gs + 1.0D+00 / ( 2.0D+00 * m ) + 1.0D+00 &
+        / ( 2 * m + 1.0D+00 )
+      hei = hei + r * gs
+      if ( abs ( r * gs ) < abs ( hei ) * eps ) then 
+        return
+      end if
+    end do
+
+  else
+
+    pp0 = 1.0D+00
+    pn0 = 1.0D+00
+    qp0 = 0.0D+00
+    qn0 = 0.0D+00
+    r0 = 1.0D+00
+
+    if ( abs ( x ) < 40.0D+00 ) then
+      km = 18
+    else
+      km = 10
+    end if
+
+    fac = 1.0D+00
+    do k = 1, km
+      fac = -fac
+      xt = 0.25D+00 * k * pi - int ( 0.125D+00 * k ) * 2.0D+00 * pi
+      cs = cos ( xt )
+      ss = sin ( xt )
+      r0 = 0.125D+00 * r0 * ( 2.0D+00 * k - 1.0D+00 ) ** 2 / k / x
+      rc = r0 * cs
+      rs = r0 * ss
+      pp0 = pp0 + rc
+      pn0 = pn0 + fac * rc
+      qp0 = qp0 + rs
+      qn0 = qn0 + fac * rs
+    end do
+
+    xd = x / sqrt (2.0D+00 )
+    xe1 = exp ( xd )
+    xe2 = exp ( - xd )
+    xc1 = 1.0D+00 / sqrt ( 2.0D+00 * pi * x )
+    xc2 = sqrt ( 0.5D+00 * pi / x )
+    cp0 = cos ( xd + 0.125D+00 * pi )
+    cn0 = cos ( xd - 0.125D+00 * pi )
+    sp0 = sin ( xd + 0.125D+00 * pi )
+    sn0 = sin ( xd - 0.125D+00 * pi )
+    ger = xc2 * xe2 * (  pn0 * cp0 - qn0 * sp0 )
+    gei = xc2 * xe2 * ( -pn0 * sp0 - qn0 * cp0 )
+    ber = xc1 * xe1 * (  pp0 * cn0 + qp0 * sn0 ) - gei / pi
+    bei = xc1 * xe1 * (  pp0 * sn0 - qp0 * cn0 ) + ger / pi
+    pp1 = 1.0D+00
+    pn1 = 1.0D+00
+    qp1 = 0.0D+00
+    qn1 = 0.0D+00
+    r1 = 1.0D+00
+    fac = 1.0D+00
+
+    do k = 1, km
+      fac = -fac
+      xt = 0.25D+00 * k * pi - int ( 0.125D+00 * k ) * 2.0D+00 * pi
+      cs = cos ( xt )
+      ss = sin ( xt )
+      r1 = 0.125D+00 * r1 &
+        * ( 4.0D+00 - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / k / x
+      rc = r1 * cs
+      rs = r1 * ss
+      pp1 = pp1 + fac * rc
+      pn1 = pn1 + rc
+      qp1 = qp1 + fac * rs
+      qn1 = qn1 + rs
+    end do
+
+    her = xc2 * xe2 * ( - pn1 * cn0 + qn1 * sn0 )
+    hei = xc2 * xe2 * (   pn1 * sn0 + qn1 * cn0 )
+    der = xc1 * xe1 * (   pp1 * cp0 + qp1 * sp0 ) - hei / pi
+    dei = xc1 * xe1 * (   pp1 * sp0 - qp1 * cp0 ) + her / pi
+
+  end if
+
+  return
+end
+subroutine klvnb ( x, ber, bei, ger, gei, der, dei, her, hei )
+
+!*****************************************************************************80
+!
+!! KLVNB: Kelvin functions ber(x), bei(x), ker(x), and kei(x), and derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    03 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) BER, BEI, GER, GEI, DER, DEI, HER, HEI, 
+!    the values of ber x, bei x, ker x, kei x, ber'x, bei'x, ker'x, kei'x.
+!
+  implicit none
+
+  real ( kind = 8 ) bei
+  real ( kind = 8 ) ber
+  real ( kind = 8 ) csn
+  real ( kind = 8 ) csp
+  real ( kind = 8 ) dei
+  real ( kind = 8 ) der
+  real ( kind = 8 ) fxi
+  real ( kind = 8 ) fxr
+  real ( kind = 8 ) gei
+  real ( kind = 8 ) ger
+  real ( kind = 8 ) hei
+  real ( kind = 8 ) her
+  integer ( kind = 4 ) l
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) pni
+  real ( kind = 8 ) pnr
+  real ( kind = 8 ) ppi
+  real ( kind = 8 ) ppr
+  real ( kind = 8 ) ssn
+  real ( kind = 8 ) ssp
+  real ( kind = 8 ) t
+  real ( kind = 8 ) t2
+  real ( kind = 8 ) tni
+  real ( kind = 8 ) tnr
+  real ( kind = 8 ) tpi
+  real ( kind = 8 ) tpr
+  real ( kind = 8 ) u
+  real ( kind = 8 ) v
+  real ( kind = 8 ) x
+  real ( kind = 8 ) yc1
+  real ( kind = 8 ) yc2
+  real ( kind = 8 ) ye1
+  real ( kind = 8 ) ye2
+  real ( kind = 8 ) yd
+
+  pi = 3.141592653589793D+00
+
+  if ( x == 0.0D+00 ) then
+
+    ber = 1.0D+00
+    bei = 0.0D+00
+    ger = 1.0D+300
+    gei = -0.25D+00 * pi
+    der = 0.0D+00
+    dei = 0.0D+00
+    her = -1.0D+300
+    hei = 0.0D+00
+
+  else if ( x < 8.0D+00 ) then
+
+    t = x / 8.0D+00
+    t2 = t * t
+    u = t2 * t2
+
+    ber = (((((( &
+      - 0.901D-05 * u &
+      + 0.122552D-02 ) * u &
+      - 0.08349609D+00 ) * u &
+      + 2.64191397D+00 ) * u &
+      - 32.36345652D+00 ) * u &
+      + 113.77777774D+00 ) * u &
+      - 64.0D+00 ) * u &
+      + 1.0D+00
+
+    bei = t * t * (((((( &
+        0.11346D-03 * u &
+      - 0.01103667D+00 ) * u &
+      + 0.52185615D+00 ) * u &
+      - 10.56765779D+00 ) * u &
+      + 72.81777742D+00 ) * u &
+      - 113.77777774D+00 ) * u &
+      + 16.0D+00 )
+
+    ger = (((((( &
+      - 0.2458D-04 * u &
+      + 0.309699D-02 ) * u &
+      - 0.19636347D+00 ) * u &
+      + 5.65539121D+00 ) * u &
+      - 60.60977451D+00 ) * u &
+      + 171.36272133D+00 ) * u &
+      - 59.05819744D+00 ) * u &
+      - 0.57721566D+00
+
+    ger = ger - log ( 0.5D+00 * x ) * ber + 0.25D+00 * pi * bei
+
+    gei = t2 * (((((( &
+        0.29532D-03 * u &
+      - 0.02695875D+00 ) * u &
+      + 1.17509064D+00 ) * u &
+      - 21.30060904D+00 ) * u &
+      + 124.2356965D+00 ) * u &
+      - 142.91827687D+00 ) * u &
+      + 6.76454936D+00 )
+
+    gei = gei - log ( 0.5D+00 * x ) * bei - 0.25D+00 * pi * ber
+
+    der = x * t2 * (((((( &
+      - 0.394D-05 * u &
+      + 0.45957D-03 ) * u &
+      - 0.02609253D+00 ) * u &
+      + 0.66047849D+00 ) * u &
+      - 6.0681481D+00 ) * u &
+      + 14.22222222D+00 ) * u &
+      - 4.0D+00 )
+
+    dei = x * (((((( &
+        0.4609D-04 * u &
+      - 0.379386D-02 ) * u &
+      + 0.14677204D+00 ) * u &
+      - 2.31167514D+00 ) * u &
+      + 11.37777772D+00 ) * u &
+      - 10.66666666D+00 ) * u &
+      + 0.5D+00 ) 
+
+    her = x * t2 * (((((( &
+      - 0.1075D-04 * u &
+      + 0.116137D-02 ) * u &
+      - 0.06136358D+00 ) * u &
+      + 1.4138478D+00 ) * u &
+      - 11.36433272D+00 ) * u &
+      + 21.42034017D+00 ) * u &
+      - 3.69113734D+00 )
+
+    her = her - log ( 0.5D+00 * x ) * der - ber / x  &
+      + 0.25D+00 * pi * dei
+
+    hei = x * (((((( &
+        0.11997D-03 * u &
+      - 0.926707D-02 ) * u &
+      + 0.33049424D+00 ) * u &
+      - 4.65950823D+00 ) * u &
+      + 19.41182758D+00 ) * u &
+      - 13.39858846D+00 ) * u &
+      + 0.21139217D+00 )
+
+    hei = hei - log ( 0.5D+00 * x ) * dei - bei / x  &
+      - 0.25D+00 * pi * der
+
+  else
+
+    t = 8.0D+00 / x
+
+    do l = 1, 2
+
+      v = ( -1.0D+00 ) ** l * t
+
+      tpr = (((( &
+          0.6D-06 * v &
+        - 0.34D-05 ) * v &
+        - 0.252D-04 ) * v &
+        - 0.906D-04 ) * v * v &
+        + 0.0110486D+00 ) * v
+
+      tpi = (((( &
+          0.19D-05 * v &
+        + 0.51D-05 ) * v * v &
+        - 0.901D-04 ) * v &
+        - 0.9765D-03 ) * v &
+        - 0.0110485D+00 ) * v &
+        - 0.3926991D+00
+
+      if ( l == 1 ) then
+        tnr = tpr
+        tni = tpi
+      end if
+
+    end do
+
+    yd = x / sqrt ( 2.0D+00 )
+    ye1 = exp ( yd + tpr )
+    ye2 = exp ( - yd + tnr )
+    yc1 = 1.0D+00 / sqrt ( 2.0D+00 * pi * x )
+    yc2 = sqrt ( pi / ( 2.0D+00 * x ) )
+    csp = cos ( yd + tpi )
+    ssp = sin ( yd + tpi )
+    csn = cos ( - yd + tni )
+    ssn = sin ( - yd + tni )
+    ger = yc2 * ye2 * csn
+    gei = yc2 * ye2 * ssn
+    fxr = yc1 * ye1 * csp
+    fxi = yc1 * ye1 * ssp
+    ber = fxr - gei / pi
+    bei = fxi + ger / pi
+
+    do l = 1, 2
+
+      v = ( -1.0D+00 ) ** l * t
+
+      ppr = ((((( &
+          0.16D-05 * v &
+        + 0.117D-04 ) * v &
+        + 0.346D-04 ) * v &
+        + 0.5D-06 ) * v &
+        - 0.13813D-02 ) * v &
+        - 0.0625001D+00 ) * v &
+        + 0.7071068D+00
+
+      ppi = ((((( &
+        - 0.32D-05 * v &
+        - 0.24D-05 ) * v &
+        + 0.338D-04 ) * v &
+        + 0.2452D-03 ) * v &
+        + 0.13811D-02 ) * v &
+        - 0.1D-06 ) * v &
+        + 0.7071068D+00
+
+      if ( l == 1 ) then
+        pnr = ppr
+        pni = ppi
+      end if
+
+    end do
+
+    her =     gei * pni - ger * pnr
+    hei = - ( gei * pnr + ger * pni )
+    der = fxr * ppr - fxi * ppi - hei / pi
+    dei = fxi * ppr + fxr * ppi + her / pi
+
+  end if
+
+  return
+end
+subroutine klvnzo ( nt, kd, zo )
+
+!*****************************************************************************80
+!
+!! KLVNZO computes zeros of the Kelvin functions.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    15 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) NT, the number of zeros.
+!
+!    Input, integer ( kind = 4 ) KD, the function code.
+!    1 for ber x, 
+!    2 for bei x,
+!    3 for ker x, 
+!    4 for kei x,
+!    5 for ber' x, 
+!    6 for bei' x,
+!    7 for ker' x, 
+!    8 for kei' x.
+!
+!    Output, real ( kind = 8 ) ZO(NT), the zeros of the given Kelvin function.
+!
+  implicit none
+
+  integer ( kind = 4 ) nt
+
+  real ( kind = 8 ) bei
+  real ( kind = 8 ) ber
+  real ( kind = 8 ) ddi
+  real ( kind = 8 ) ddr
+  real ( kind = 8 ) dei
+  real ( kind = 8 ) der
+  real ( kind = 8 ) gdi
+  real ( kind = 8 ) gdr
+  real ( kind = 8 ) gei
+  real ( kind = 8 ) ger
+  real ( kind = 8 ) hei
+  real ( kind = 8 ) her
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) rt
+  real ( kind = 8 ) rt0(8)
+  real ( kind = 8 ) zo(nt)
+
+  rt0(1) = 2.84891D+00
+  rt0(2) = 5.02622D+00
+  rt0(3) = 1.71854D+00
+  rt0(4) = 3.91467D+00
+  rt0(5) = 6.03871D+00
+  rt0(6) = 3.77268D+00
+  rt0(7) = 2.66584D+00
+  rt0(8) = 4.93181D+00
+
+  rt = rt0(kd)
+
+  do m = 1, nt
+
+    do
+
+      call klvna ( rt, ber, bei, ger, gei, der, dei, her, hei )
+
+      if ( kd == 1 ) then
+        rt = rt - ber / der
+      else if ( kd == 2 ) then
+        rt = rt - bei / dei
+      else if ( kd == 3 ) then
+        rt = rt - ger / her
+      else if ( kd == 4 ) then
+        rt = rt - gei / hei
+      else if ( kd == 5 ) then
+        ddr = - bei - der / rt
+        rt = rt - der / ddr
+      else if ( kd == 6 ) then
+        ddi = ber - dei / rt
+        rt = rt - dei / ddi
+      else if ( kd == 7 ) then
+        gdr = - gei - her / rt
+        rt = rt - her / gdr
+      else
+        gdi = ger - hei / rt
+        rt = rt - hei / gdi
+      end if
+
+      if ( abs ( rt - rt0(kd) ) <= 5.0D-10 ) then
+        exit
+      end if
+
+      rt0(kd) = rt
+
+    end do
+
+    zo(m) = rt
+    rt = rt + 4.44D+00
+
+  end do
+
+  return
+end
+subroutine kmn ( m, n, c, cv, kd, df, dn, ck1, ck2 )
+
+!*****************************************************************************80
+!
+!! KMN: expansion coefficients of prolate or oblate spheroidal functions.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    02 August 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
+!
+!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
+!
+!    Input, real ( kind = 8 ) C, spheroidal parameter.
+!
+!    Input, real ( kind = 8 ) CV, the characteristic value.
+!
+!    Input, integer ( kind = 4 ) KD, the function code.
+!    1, the prolate function.
+!    -1, the oblate function.
+!
+!    Input, real ( kind = 8 ) DF(*), the expansion coefficients.
+!
+  implicit none
+
+  real ( kind = 8 ) c
+  real ( kind = 8 ) ck1
+  real ( kind = 8 ) ck2
+  real ( kind = 8 ) cs
+  real ( kind = 8 ) cv
+  real ( kind = 8 ) df(200)
+  real ( kind = 8 ) dn(200)
+  real ( kind = 8 ) dnp
+  real ( kind = 8 ) g0
+  real ( kind = 8 ) gk0
+  real ( kind = 8 ) gk1
+  real ( kind = 8 ) gk2
+  real ( kind = 8 ) gk3
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) ip
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  integer ( kind = 4 ) nm
+  integer ( kind = 4 ) nm1
+  integer ( kind = 4 ) nn
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) r2
+  real ( kind = 8 ) r3
+  real ( kind = 8 ) r4
+  real ( kind = 8 ) r5
+  real ( kind = 8 ) rk(200)
+  real ( kind = 8 ) sa0
+  real ( kind = 8 ) sb0
+  real ( kind = 8 ) su0
+  real ( kind = 8 ) sw
+  real ( kind = 8 ) t
+  real ( kind = 8 ) tp(200)
+  real ( kind = 8 ) u(200)
+  real ( kind = 8 ) v(200)
+  real ( kind = 8 ) w(200)
+
+  nm = 25 + int ( 0.5D+00 * ( n - m ) + c )
+  nn = nm + m
+  cs = c * c * kd
+
+  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
+    ip = 0
+  else
+    ip = 1
+  end if
+
+  do i = 1, nn + 3
+
+    if ( ip == 0 ) then
+      k = - 2 * ( i - 1 )
+    else
+      k = - ( 2 * i - 3 )
+    end if
+
+    gk0 = 2.0D+00 * m + k
+    gk1 = ( m + k ) * ( m + k + 1.0D+00 )
+    gk2 = 2.0D+00 * ( m + k ) - 1.0D+00
+    gk3 = 2.0D+00 * ( m + k ) + 3.0D+00
+    u(i) = gk0 * ( gk0 - 1.0D+00 ) * cs / ( gk2 * ( gk2 + 2.0D+00 ) )
+    v(i) = gk1 - cv + ( 2.0D+00 * ( gk1 - m * m ) - 1.0D+00 ) * cs &
+      / ( gk2 * gk3 )
+    w(i) = ( k + 1.0D+00 ) * ( k + 2.0D+00 ) * cs / ( ( gk2 + 2.0D+00 ) * gk3 )
+
+  end do
+
+  do k = 1, m
+    t = v(m+1)
+    do l = 0, m - k - 1
+      t = v(m-l) - w(m-l+1) * u(m-l) / t
+    end do
+    rk(k) = -u(k) / t
+  end do
+
+  r = 1.0D+00
+  do k = 1, m
+    r = r * rk(k)
+    dn(k) = df(1) * r
+  end do
+
+  tp(nn) = v(nn+1)
+  do k = nn - 1, m + 1,-1
+    tp(k) = v(k+1) - w(k+2) * u(k+1) / tp(k+1)
+    if ( m + 1 < k ) then
+      rk(k) = -u(k) / tp(k)
+    end if
+  end do
+
+  if ( m == 0 ) then
+    dnp = df(1)
+  else
+    dnp = dn(m)
+  end if
+
+  dn(m+1) = ( - 1.0D+00 ) ** ip * dnp * cs &
+    / ( ( 2.0D+00 * m - 1.0D+00 ) &
+    * ( 2.0D+00 * m + 1.0D+00 - 4.0D+00 * ip ) * tp(m+1) )
+  do k = m + 2, nn
+    dn(k) = rk(k) * dn(k-1)
+  end do
+
+  r1 = 1.0D+00
+  do j = 1, ( n + m + ip ) / 2
+       r1 = r1 * ( j + 0.5D+00 * ( n + m + ip ) )
+  end do
+  nm1 = ( n - m ) / 2
+  r = 1.0D+00
+  do j = 1, 2 * m + ip
+    r = r * j
+  end do
+  su0 = r * df(1)
+
+  do k = 2, nm
+    r = r * ( m + k - 1.0D+00 ) * ( m + k + ip - 1.5D+00 ) &
+      / ( k - 1.0D+00 ) / ( k + ip - 1.5D+00 )
+    su0 = su0 + r * df(k)
+    if ( nm1 < k .and. &
+      abs ( ( su0 - sw ) / su0 ) < 1.0D-14 ) then
+      exit
+    end if
+    sw = su0
+  end do
+
+  if ( kd /= 1 ) then
+
+    r2 = 1.0D+00
+    do j = 1,m
+      r2 = 2.0D+00 * c * r2 * j
+    end do
+    r3 = 1.0D+00
+    do j = 1, ( n - m - ip ) / 2
+      r3 = r3 * j
+    end do
+    sa0 = ( 2.0D+00 * ( m + ip ) + 1.0D+00 ) * r1 &
+      / ( 2.0D+00 ** n * c ** ip * r2 * r3 * df(1) )
+    ck1 = sa0 * su0
+
+    if ( kd == -1 ) then
+      return
+    end if
+
+  end if
+
+  r4 = 1.0D+00
+  do j = 1, ( n - m - ip ) / 2
+    r4 = 4.0D+00 * r4 * j
+  end do
+  r5 = 1.0D+00
+  do j = 1, m
+    r5 = r5 * ( j + m ) / c
+  end do
+
+  if ( m == 0 ) then
+    g0 = df(1)
+  else
+    g0 = dn(m)
+  end if
+
+  sb0 = ( ip + 1.0D+00 ) * c ** ( ip + 1 ) &
+    / ( 2.0D+00 * ip * ( m - 2.0D+00 ) + 1.0D+00 ) &
+    / ( 2.0D+00 * m - 1.0D+00 )
+
+  ck2 = ( -1 ) ** ip * sb0 * r4 * r5 * g0 / r1 * su0
+
+  return
+end
+subroutine lagzo ( n, x, w )
+
+!*****************************************************************************80
+!
+!! LAGZO computes zeros of the Laguerre polynomial, and integration weights.
+!
+!  Discussion:
+!
+!    This procedure computes the zeros of Laguerre polynomial Ln(x) in the 
+!    interval [0,ě], and the corresponding weighting coefficients for 
+!    Gauss-Laguerre integration.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    07 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order of the Laguerre polynomial.
+!
+!    Output, real ( kind = 8 ) X(N), the zeros of the Laguerre polynomial.
+!
+!    Output, real ( kind = 8 ) W(N), the weighting coefficients.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) fd
+  real ( kind = 8 ) gd
+  real ( kind = 8 ) hn
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) it
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) nr
+  real ( kind = 8 ) p
+  real ( kind = 8 ) pd
+  real ( kind = 8 ) pf
+  real ( kind = 8 ) q
+  real ( kind = 8 ) w(n)
+  real ( kind = 8 ) wp
+  real ( kind = 8 ) x(n)
+  real ( kind = 8 ) z
+  real ( kind = 8 ) z0
+
+  hn = 1.0D+00 / real ( n, kind = 8 )
+
+  do nr = 1, n
+
+    if ( nr == 1 ) then
+      z = hn
+    else
+      z = x(nr-1) + hn * nr ** 1.27D+00
+    end if
+
+    it = 0
+
+    do
+
+      it = it + 1
+      z0 = z
+      p = 1.0D+00
+      do i = 1, nr - 1
+        p = p * ( z - x(i) )
+      end do
+
+      f0 = 1.0D+00
+      f1 = 1.0D+00 - z
+      do k = 2, n
+        pf = (( 2.0D+00 * k - 1.0D+00 - z ) * f1 &
+          - ( k - 1.0D+00 ) * f0 ) / k
+        pd = k / z * ( pf - f1 )
+        f0 = f1
+        f1 = pf
+      end do
+
+      fd = pf / p
+
+      q = 0.0D+00
+      do i = 1, nr - 1
+        wp = 1.0D+00
+        do j = 1, nr - 1
+          if ( j /= i ) then
+            wp = wp * ( z - x(j) )
+          end if
+        end do
+        q = q + wp
+      end do
+
+      gd = ( pd - q * fd ) / p
+      z = z - fd / gd
+
+      if ( 40 < it .or. abs ( ( z - z0 ) / z ) <= 1.0D-15 ) then
+        exit
+      end if
+
+    end do
+
+    x(nr) = z
+    w(nr) = 1.0D+00 / ( z * pd * pd )
+
+  end do
+
+  return
+end
+subroutine lamn ( n, x, nm, bl, dl )
+
+!*****************************************************************************80
+!
+!! LAMN computes lambda functions and derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    14 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, integer ( kind = 4 ) NM, the highest order computed.
+!
+!    Output, real ( kind = 8 ) BL(0:N), DL(0:N), the
+!    value of the lambda function and its derivative of orders 0 through N.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) bg
+  real ( kind = 8 ) bk
+  real ( kind = 8 ) bl(0:n)
+  real ( kind = 8 ) bs
+  real ( kind = 8 ) dl(0:n)
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r0
+  real ( kind = 8 ) uk
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x2
+
+  nm = n
+
+  if ( abs ( x ) < 1.0D-100 ) then
+    do k = 0, n
+      bl(k) = 0.0D+00
+      dl(k) = 0.0D+00
+    end do
+    bl(0) = 1.0D+00
+    dl(1) = 0.5D+00
+    return
+  end if
+
+  if ( x <= 12.0D+00 ) then
+
+    x2 = x * x
+
+    do k = 0, n
+      bk = 1.0D+00
+      r = 1.0D+00
+      do i = 1, 50
+        r = -0.25D+00 * r * x2 / ( i * ( i + k ) )
+        bk = bk + r
+        if ( abs ( r ) < abs ( bk ) * 1.0D-15 ) then
+          exit
+        end if
+      end do
+
+      bl(k) = bk
+      if ( 1 <= k ) then
+        dl(k-1) = - 0.5D+00 * x / k * bk
+      end if
+
+    end do
+
+    uk = 1.0D+00
+    r = 1.0D+00
+    do i = 1, 50
+      r = -0.25D+00 * r * x2 / ( i * ( i + n + 1.0D+00 ) )
+      uk = uk + r
+      if ( abs ( r ) < abs ( uk ) * 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    dl(n) = -0.5D+00 * x / ( n + 1.0D+00 ) * uk
+    return
+
+  end if
+
+  if ( n == 0 ) then
+    nm = 1
+  end if
+
+  m = msta1 ( x, 200 )
+
+  if ( m < nm ) then
+    nm = m
+  else
+    m = msta2 ( x, nm, 15 )
+  end if
+
+  bs = 0.0D+00
+  f0 = 0.0D+00
+  f1 = 1.0D-100
+  do k = m, 0, -1
+    f = 2.0D+00 * ( k + 1.0D+00 ) * f1 / x - f0
+    if ( k <= nm ) then
+      bl(k) = f
+    end if
+    if ( k == 2 * int ( k / 2 ) ) then
+      bs = bs + 2.0D+00 * f
+    end if
+    f0 = f1
+    f1 = f
+  end do
+
+  bg = bs - f
+  do k = 0, nm
+    bl(k) = bl(k) / bg
+  end do
+
+  r0 = 1.0D+00
+  do k = 1, nm
+    r0 = 2.0D+00 * r0 * k / x
+    bl(k) = r0 * bl(k)
+  end do
+
+  dl(0) = -0.5D+00 * x * bl(1)
+  do k = 1, nm
+    dl(k) = 2.0D+00 * k / x * ( bl(k-1) - bl(k) )
+  end do
+
+  return
+end
+subroutine lamv ( v, x, vm, vl, dl )
+
+!*****************************************************************************80
+!
+!! LAMV computes lambda functions and derivatives of arbitrary order.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    31 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) V, the order.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) VM, the highest order computed.
+!
+!    Output, real ( kind = 8 ) VL(0:*), DL(0:*), the Lambda function and 
+!    derivative, of orders N+V0.
+!
+  implicit none
+
+  real ( kind = 8 ) v
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) bjv0
+  real ( kind = 8 ) bjv1
+  real ( kind = 8 ) bk
+  real ( kind = 8 ) ck
+  real ( kind = 8 ) cs
+  real ( kind = 8 ) dl(0:int(v))
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) f2
+  real ( kind = 8 ) fac
+  real ( kind = 8 ) ga
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k0
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) px
+  real ( kind = 8 ) qx
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r0
+  real ( kind = 8 ) rc
+  real ( kind = 8 ) rp
+  real ( kind = 8 ) rp2
+  real ( kind = 8 ) rq
+  real ( kind = 8 ) sk
+  real ( kind = 8 ) uk
+  real ( kind = 8 ) v0
+  real ( kind = 8 ) vk
+  real ( kind = 8 ) vl(0:int(v))
+  real ( kind = 8 ) vm
+  real ( kind = 8 ) vv
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x2
+  real ( kind = 8 ) xk
+
+  pi = 3.141592653589793D+00
+  rp2 = 0.63661977236758D+00
+  x = abs ( x )
+  x2 = x * x
+  n = int ( v )
+  v0 = v - n
+  vm = v
+
+  if ( x <= 12.0D+00 ) then
+
+    do k = 0, n
+
+      vk = v0 + k
+      bk = 1.0D+00
+      r = 1.0D+00
+
+      do i = 1, 50
+        r = -0.25D+00 * r * x2 / ( i * ( i + vk ) )
+        bk = bk + r
+        if ( abs ( r ) < abs ( bk ) * 1.0D-15 ) then
+          exit
+        end if
+      end do
+
+      vl(k) = bk
+      uk = 1.0D+00
+      r = 1.0D+00
+      do i = 1, 50
+        r = -0.25D+00 * r * x2 / ( i * ( i + vk + 1.0D+00 ))
+        uk = uk + r
+        if ( abs ( r ) < abs ( uk ) * 1.0D-15 ) then
+          exit
+        end if
+      end do
+
+      dl(k) = - 0.5D+00 * x / ( vk + 1.0D+00 ) * uk
+
+    end do
+
+    return
+
+  end if
+
+  if ( x < 35.0D+00 ) then
+    k0 = 11
+  else if ( x < 50.0D+00 ) then
+    k0 = 10
+  else
+    k0 = 8
+  end if
+
+  do j = 0, 1
+    vv = 4.0D+00 * ( j + v0 ) * ( j + v0 )
+    px = 1.0D+00
+    rp = 1.0D+00
+    do k = 1, k0
+      rp = - 0.78125D-02 * rp * ( vv - ( 4.0D+00 * k - 3.0D+00 ) ** 2 ) &
+        * ( vv - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
+        / ( k * ( 2.0 * k - 1.0D+00 ) * x2 )
+      px = px + rp
+    end do
+    qx = 1.0D+00
+    rq = 1.0D+00
+    do k = 1, k0
+      rq = - 0.78125D-02 * rq * ( vv - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
+        * ( vv - ( 4.0D+00 * k + 1.0D+00 ) ** 2 ) &
+        / ( k * ( 2.0D+00 * k + 1.0D+00 ) * x2 )
+      qx = qx + rq
+    end do
+    qx = 0.125D+00 * ( vv - 1.0D+00 ) * qx / x
+    xk = x - ( 0.5D+00 * ( j + v0 ) + 0.25D+00 ) * pi
+    a0 = sqrt ( rp2 / x )
+    ck = cos ( xk )
+    sk = sin ( xk )
+    if ( j == 0 ) then
+      bjv0 = a0 * ( px * ck - qx * sk )
+    else
+      bjv1 = a0 * ( px * ck - qx * sk )
+    end if
+  end do
+
+  if ( v0 == 0.0D+00 ) then
+    ga = 1.0D+00
+  else
+    call gam0 ( v0, ga )
+    ga = v0 * ga
+  end if
+
+  fac = ( 2.0D+00 / x ) ** v0 * ga
+  vl(0) = bjv0
+  dl(0) = - bjv1 + v0 / x * bjv0
+  vl(1) = bjv1
+  dl(1) = bjv0 - ( 1.0D+00 + v0 ) / x * bjv1
+  r0 = 2.0D+00 * ( 1.0D+00 + v0 ) / x
+
+  if ( n <= 1 ) then
+    vl(0) = fac * vl(0)
+    dl(0) = fac * dl(0) - v0 / x * vl(0)
+    vl(1) = fac * r0 * vl(1)
+    dl(1) = fac * r0 * dl(1) - ( 1.0D+00 + v0 ) / x * vl(1)
+    return
+  end if
+
+  if ( 2 <= n .and. n <= int ( 0.9D+00 * x ) ) then
+
+    f0 = bjv0
+    f1 = bjv1
+    do k = 2, n
+      f = 2.0D+00 * ( k + v0 - 1.0D+00 ) / x * f1 - f0
+      f0 = f1
+      f1 = f
+      vl(k) = f
+    end do
+
+  else if ( 2 <= n ) then
+
+    m = msta1 ( x, 200 )
+    if ( m < n ) then
+      n = m
+    else
+      m = msta2 ( x, n, 15 )
+    end if
+    f2 = 0.0D+00
+    f1 = 1.0D-100
+    do k = m, 0, -1
+      f = 2.0D+00 * ( v0 + k + 1.0D+00 ) / x * f1 - f2
+      if ( k <= n ) then
+        vl(k) = f
+      end if
+      f2 = f1
+      f1 = f
+    end do
+
+    if ( abs ( bjv0 ) <= abs ( bjv1 ) ) then
+      cs = bjv1 / f2
+    else
+      cs = bjv0 / f
+    end if
+
+    do k = 0, n
+      vl(k) = cs * vl(k)
+    end do
+
+  end if
+
+  vl(0) = fac * vl(0)
+  do j = 1, n
+    rc = fac * r0
+    vl(j) = rc * vl(j)
+    dl(j-1) = - 0.5D+00 * x / ( j + v0 ) * vl(j)
+    r0 = 2.0D+00 * ( j + v0 + 1 ) / x * r0
+  end do
+  dl(n) = 2.0D+00 * ( v0 + n ) * ( vl(n-1) - vl(n) ) / x
+  vm = n + v0
+
+  return
+end
+subroutine legzo ( n, x, w )
+
+!*****************************************************************************80
+!
+!! LEGZO computes the zeros of Legendre polynomials, and integration weights.
+!
+!  Discussion:
+!
+!    This procedure computes the zeros of Legendre polynomial Pn(x) in the 
+!    interval [-1,1], and the corresponding weighting coefficients for 
+!    Gauss-Legendre integration.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    13 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order of the polynomial.
+!
+!    Output, real ( kind = 8 ) X(N), W(N), the zeros of the polynomial,
+!    and the corresponding weights.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) fd
+  real ( kind = 8 ) gd
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) n0
+  integer ( kind = 4 ) nr
+  real ( kind = 8 ) p
+  real ( kind = 8 ) pd
+  real ( kind = 8 ) pf
+  real ( kind = 8 ) q
+  real ( kind = 8 ) w(n)
+  real ( kind = 8 ) wp
+  real ( kind = 8 ) x(n)
+  real ( kind = 8 ) z
+  real ( kind = 8 ) z0
+
+  n0 = ( n + 1 ) / 2
+
+  do nr = 1, n0
+
+    z = cos ( 3.1415926D+00 * ( nr - 0.25D+00 ) / n )
+
+    do
+
+      z0 = z
+      p = 1.0D+00
+      do i = 1, nr - 1
+        p = p * ( z - x(i))
+      end do
+      f0 = 1.0D+00
+      if ( nr == n0 .and. n /= 2 * int ( n / 2 ) ) then
+        z = 0.0D+00
+      end if
+      f1 = z
+      do k = 2, n
+        pf = ( 2.0D+00 - 1.0D+00 / k ) * z * f1 &
+          - ( 1.0D+00 - 1.0D+00 / k ) * f0
+        pd = k * ( f1 - z * pf ) / ( 1.0D+00 - z * z )
+        f0 = f1
+        f1 = pf
+      end do
+
+      if ( z == 0.0D+00 ) then
+        exit
+      end if
+
+      fd = pf / p
+      q = 0.0D+00
+      do i = 1, nr - 1
+        wp = 1.0D+00
+        do j = 1, nr - 1
+          if ( j /= i ) then
+            wp = wp * ( z - x(j) )
+          end if
+        end do
+        q = q + wp
+      end do
+      gd = ( pd - q * fd ) / p
+      z = z - fd / gd
+
+      if ( abs ( z - z0 ) < abs ( z ) * 1.0D-15 ) then
+        exit
+      end if
+
+    end do
+
+    x(nr) = z
+    x(n+1-nr) = - z
+    w(nr) = 2.0D+00 / ( ( 1.0D+00 - z * z ) * pd * pd )
+    w(n+1-nr) = w(nr)
+
+  end do
+
+  return
+end
+subroutine lgama ( kf, x, gl )
+
+!*****************************************************************************80
+!
+!! LGAMA computes the gamma function or its logarithm.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    15 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) KF, the argument code.
+!    1, for gamma(x);
+!    2, for ln(gamma(x)).
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) GL, the function value.
+!
+  implicit none
+
+  real ( kind = 8 ), save, dimension ( 10 ) :: a = (/ &
+    8.333333333333333D-02, &
+   -2.777777777777778D-03, &
+    7.936507936507937D-04, &
+   -5.952380952380952D-04, &
+    8.417508417508418D-04, &
+   -1.917526917526918D-03, &
+    6.410256410256410D-03, &
+   -2.955065359477124D-02, &
+    1.796443723688307D-01, &
+   -1.39243221690590D+00 /)
+  real ( kind = 8 ) gl
+  real ( kind = 8 ) gl0
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) kf
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x0
+  real ( kind = 8 ) x2
+  real ( kind = 8 ) xp
+
+  x0 = x
+
+  if ( x == 1.0D+00 .or. x == 2.0D+00 ) then
+    gl = 0.0D+00
+    if ( kf == 1 ) then
+      gl = 1.0D+00
+    end if
+    return
+  else if ( x <= 7.0D+00 ) then
+    n = int ( 7.0D+00 - x )
+    x0 = x + n
+  end if
+
+  x2 = 1.0D+00 / ( x0 * x0 )
+  xp = 6.283185307179586477D+00
+  gl0 = a(10)
+
+  do k = 9, 1, -1
+    gl0 = gl0 * x2 + a(k)
+  end do
+
+  gl = gl0 / x0 + 0.5D+00 * log ( xp ) + ( x0 - 0.5D+00 ) * log ( x0 ) - x0
+
+  if ( x <= 7.0D+00 ) then
+    do k = 1, n
+      gl = gl - log ( x0 - 1.0D+00 )
+      x0 = x0 - 1.0D+00
+    end do
+  end if
+
+  if ( kf == 1 ) then
+    gl = exp ( gl )
+  end if
+
+  return
+end
+subroutine lpmn ( mm, m, n, x, pm, pd )
+
+!*****************************************************************************80
+!
+!! LPMN computes associated Legendre functions Pmn(X) and derivatives P'mn(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    19 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) MM, the leading dimension of PM and PD.
+!
+!    Input, integer ( kind = 4 ) M, the order of Pmn(x).
+!
+!    Input, integer ( kind = 4 ) N, the degree of Pmn(x).
+!
+!    Input, real ( kind = 8 ) X, the argument of Pmn(x).
+!
+!    Output, real ( kind = 8 ) PM(0:MM,0:N), PD(0:MM,0:N), the
+!    values of Pmn(x) and Pmn'(x).
+!
+  implicit none
+
+  integer ( kind = 4 ) mm
+  integer ( kind = 4 ) n
+
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) ls
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) pd(0:mm,0:n)
+  real ( kind = 8 ) pm(0:mm,0:n)
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xq
+  real ( kind = 8 ) xs
+
+  do i = 0, n
+    do j = 0, m
+      pm(j,i) = 0.0D+00
+      pd(j,i) = 0.0D+00
+    end do
+  end do
+
+  pm(0,0) = 1.0D+00
+
+  if ( abs ( x ) == 1.0D+00 ) then
+
+    do i = 1, n
+      pm(0,i) = x ** i
+      pd(0,i) = 0.5D+00 * i * ( i + 1.0D+00 ) * x ** ( i + 1 )
+    end do
+
+    do j = 1, n
+      do i = 1, m
+        if ( i == 1 ) then
+          pd(i,j) = 1.0D+300
+        else if ( i == 2 ) then
+          pd(i,j) = -0.25D+00 * ( j + 2 ) * ( j + 1 ) * j &
+            * ( j - 1 ) * x ** ( j + 1 )
+        end if
+      end do
+    end do
+
+    return
+
+  end if
+
+  if ( 1.0D+00 < abs ( x ) ) then
+    ls = -1
+  else
+    ls = +1
+  end if
+
+  xq = sqrt ( ls * ( 1.0D+00 - x * x ) )
+  xs = ls * ( 1.0D+00 - x * x )
+  do i = 1, m
+    pm(i,i) = - ls * ( 2.0D+00 * i - 1.0D+00 ) * xq * pm(i-1,i-1)
+  end do
+
+  do i = 0, m
+    pm(i,i+1) = ( 2.0D+00 * i + 1.0D+00 ) * x * pm(i,i)
+  end do
+
+  do i = 0, m
+    do j = i + 2, n
+      pm(i,j) = ( ( 2.0D+00 * j - 1.0D+00 ) * x * pm(i,j-1) - &
+        ( i + j - 1.0D+00 ) * pm(i,j-2) ) / ( j - i )
+    end do
+  end do
+
+  pd(0,0) = 0.0D+00
+  do j = 1, n
+    pd(0,j) = ls * j * ( pm(0,j-1) - x * pm(0,j) ) / xs
+  end do
+
+  do i = 1, m
+    do j = i, n
+      pd(i,j) = ls * i * x * pm(i,j) / xs + ( j + i ) &
+        * ( j - i + 1.0D+00 ) / xq * pm(i-1,j)
+    end do
+  end do
+
+  return
+end
+subroutine lpmns ( m, n, x, pm, pd )
+
+!*****************************************************************************80
+!
+!! LPMNS computes associated Legendre functions Pmn(X) and derivatives P'mn(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    18 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the order of Pmn(x).
+!
+!    Input, integer ( kind = 4 ) N, the degree of Pmn(x).
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) PM(0:N), PD(0:N), the values and derivatives
+!    of the function from degree 0 to N.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) pm(0:n)
+  real ( kind = 8 ) pm0
+  real ( kind = 8 ) pm1
+  real ( kind = 8 ) pm2
+  real ( kind = 8 ) pmk
+  real ( kind = 8 ) pd(0:n)
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x0
+
+  do k = 0, n
+    pm(k) = 0.0D+00
+    pd(k) = 0.0D+00
+  end do
+
+  if ( abs ( x ) == 1.0D+00 ) then
+
+    do k = 0, n
+      if ( m == 0 ) then
+        pm(k) = 1.0D+00
+        pd(k) = 0.5D+00 * k * ( k + 1.0D+00 )
+        if ( x < 0.0D+00 ) then
+          pm(k) = ( -1.0D+00 ) ** k * pm(k)
+          pd(k) = ( -1.0D+00 ) ** ( k + 1 ) * pd(k)
+        end if
+      else if ( m == 1 ) then
+        pd(k) = 1.0D+300
+      else if ( m == 2 ) then
+        pd(k) = -0.25D+00 * ( k + 2.0D+00 ) * ( k + 1.0D+00 ) &
+          * k * ( k - 1.0D+00 )
+        if ( x < 0.0D+00 ) then
+          pd(k) = ( -1.0D+00 ) ** ( k + 1 ) * pd(k)
+        end if
+      end if
+    end do
+    return
+  end if
+
+  x0 = abs ( 1.0D+00 - x * x )
+  pm0 = 1.0D+00
+  pmk = pm0
+  do k = 1, m
+    pmk = ( 2.0D+00 * k - 1.0D+00 ) * sqrt ( x0 ) * pm0
+    pm0 = pmk
+  end do
+  pm1 = ( 2.0D+00 * m + 1.0D+00 ) * x * pm0
+  pm(m) = pmk
+  pm(m+1) = pm1
+  do k = m + 2, n
+    pm2 = ( ( 2.0D+00 * k - 1.0D+00 ) * x * pm1 &
+      - ( k + m - 1.0D+00 ) * pmk ) / ( k - m )
+    pm(k) = pm2
+    pmk = pm1
+    pm1 = pm2
+  end do
+
+  pd(0) = ( ( 1.0D+00 - m ) * pm(1) - x * pm(0) ) &
+    / ( x * x - 1.0D+00 )  
+  do k = 1, n
+    pd(k) = ( k * x * pm(k) - ( k + m ) * pm(k-1) ) &
+      / ( x * x - 1.0D+00 )
+  end do
+
+  return
+end
+subroutine lpmv ( v, m, x, pmv )
+
+!*****************************************************************************80
+!
+!! LPMV computes associated Legendre functions Pmv(X) with arbitrary degree.
+!
+!  Discussion:
+!
+!    Compute the associated Legendre function Pmv(x) with an integer order 
+!    and an arbitrary nonnegative degree v.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    19 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) V, the degree of Pmv(x).
+!
+!    Input, integer ( kind = 4 ) M, the order of Pmv(x).
+!
+!    Input, real ( kind = 8 ) X, the argument of Pm(x).
+!
+!    Output, real ( kind = 8 ) PMV, the value of Pm(x).
+!
+  implicit none
+
+  real ( kind = 8 ) c0
+  real ( kind = 8 ) el
+  real ( kind = 8 ) eps
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) nv
+  real ( kind = 8 ) pa
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) pmv
+  real ( kind = 8 ) pss
+  real ( kind = 8 ) psv
+  real ( kind = 8 ) pv0
+  real ( kind = 8 ) qr
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r0
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) r2
+  real ( kind = 8 ) rg
+  real ( kind = 8 ) s
+  real ( kind = 8 ) s0
+  real ( kind = 8 ) s1
+  real ( kind = 8 ) s2
+  real ( kind = 8 ) v
+  real ( kind = 8 ) v0
+  real ( kind = 8 ) vs
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xq
+
+  pi = 3.141592653589793D+00
+  el = 0.5772156649015329D+00
+  eps = 1.0D-14
+  nv = int ( v )
+  v0 = v - nv
+
+  if ( x == -1.0D+00 .and. v /= nv ) then
+    if ( m == 0 ) then
+      pmv = -1.0D+300
+    else
+      pmv = 1.0D+300
+    end if
+    return
+  end if
+
+  c0 = 1.0D+00
+
+  if ( m /= 0 ) then
+
+    rg = v * ( v + m )
+    do j = 1, m - 1 
+      rg = rg * ( v * v - j * j )
+    end do
+    xq = sqrt ( 1.0D+00 - x * x )
+    r0 = 1.0D+00
+    do j = 1, m
+      r0 = 0.5D+00 * r0 * xq / j
+    end do
+    c0 = r0 * rg
+
+  end if
+
+  if ( v0 == 0.0D+00 ) then
+
+    pmv = 1.0D+00
+    r = 1.0D+00
+    do k = 1, nv - m
+      r = 0.5D+00 * r * ( - nv + m + k - 1.0D+00 ) &
+        * ( nv + m + k ) / ( k * ( k + m ) ) * ( 1.0D+00 + x )
+      pmv = pmv + r
+    end do
+    pmv = ( -1.0D+00 ) ** nv * c0 * pmv
+
+  else
+
+    if ( -0.35D+00 <= x ) then
+
+      pmv = 1.0D+00
+      r = 1.0D+00
+      do k = 1, 100
+        r = 0.5D+00 * r * ( - v + m + k - 1.0D+00 ) &
+          * ( v + m + k ) / ( k * ( m + k ) ) * ( 1.0D+00 - x )
+        pmv = pmv + r
+        if ( 12 < k .and. abs ( r / pmv ) < eps ) then
+          exit
+        end if
+      end do
+
+      pmv = ( -1.0D+00 ) ** m * c0 * pmv
+
+    else
+
+      vs = sin ( v * pi ) / pi
+      pv0 = 0.0D+00
+
+      if ( m /= 0 ) then
+
+        qr = sqrt ( ( 1.0D+00 - x ) / ( 1.0D+00 + x ) )
+        r2 = 1.0D+00
+        do j = 1, m
+          r2 = r2 * qr * j
+        end do
+        s0 = 1.0D+00
+        r1 = 1.0D+00
+        do k = 1, m - 1 
+          r1 = 0.5D+00 * r1 * ( - v + k - 1 ) * ( v + k ) &
+            / ( k * ( k - m ) ) * ( 1.0D+00 + x )
+          s0 = s0 + r1
+        end do
+        pv0 = - vs * r2 / m * s0
+
+      end if
+
+      call psi ( v, psv )
+      pa = 2.0D+00 * ( psv + el ) + pi / tan ( pi * v ) &
+        + 1.0D+00 / v
+
+      s1 = 0.0D+00
+      do j = 1, m
+        s1 = s1 + ( j * j + v * v ) / ( j * ( j * j - v * v ) )
+      end do
+
+      pmv = pa + s1 - 1.0D+00 / ( m - v ) &
+        + log ( 0.5D+00 * ( 1.0D+00 + x ) )
+      r = 1.0D+00
+      do k = 1, 100
+        r = 0.5D+00 * r * ( - v + m + k - 1.0D+00 ) * ( v + m + k ) &
+          / ( k * ( k + m ) ) * ( 1.0D+00 + x )
+        s = 0.0D+00
+        do j = 1, m
+          s = s + ( ( k + j ) ** 2 + v * v ) &
+            / ( ( k + j ) * ( ( k + j ) ** 2 - v * v ) )
+        end do
+        s2 = 0.0D+00
+        do j = 1, k
+          s2 = s2 + 1.0D+00 / ( j * ( j * j - v * v ) )
+        end do
+        pss = pa + s + 2.0D+00 * v * v * s2 &
+          - 1.0D+00 / ( m + k - v ) &
+          + log ( 0.5D+00 * ( 1.0D+00 + x ) )
+        r2 = pss * r
+        pmv = pmv + r2
+        if ( abs ( r2 / pmv ) < eps ) then
+          exit
+        end if
+      end do
+
+      pmv = pv0 + pmv * vs * c0
+
+    end if
+
+  end if
+
+  return
+end
+subroutine lpn ( n, x, pn, pd )
+
+!*****************************************************************************80
+!
+!! LPN computes Legendre polynomials Pn(x) and derivatives Pn'(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    07 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the maximum degree.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) PN(0:N), PD(0:N), the values and derivatives
+!    of the polyomials of degrees 0 to N at X.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) p0
+  real ( kind = 8 ) p1
+  real ( kind = 8 ) pd(0:n)
+  real ( kind = 8 ) pf
+  real ( kind = 8 ) pn(0:n)
+  real ( kind = 8 ) x
+
+  pn(0) = 1.0D+00
+  pn(1) = x
+  pd(0) = 0.0D+00
+  pd(1) = 1.0D+00
+  p0 = 1.0D+00
+  p1 = x
+
+  do k = 2, n
+
+    pf = ( 2.0D+00 * k - 1.0D+00 ) / k * x * p1 &
+      - ( k - 1.0D+00 ) / k * p0
+    pn(k) = pf
+
+    if ( abs ( x ) == 1.0D+00 ) then
+      pd(k) = 0.5D+00 * x ** ( k + 1 ) * k * ( k + 1.0D+00 )
+    else
+      pd(k) = k * ( p1 - x * pf ) / ( 1.0D+00 - x * x )
+    end if
+
+    p0 = p1
+    p1 = pf
+
+  end do
+
+  return
+end
+subroutine lpni ( n, x, pn, pd, pl )
+
+!*****************************************************************************80
+!
+!! LPNI computes Legendre polynomials Pn(x), derivatives, and integrals.
+!
+!  Discussion:
+!
+!    This routine computes Legendre polynomials Pn(x), Pn'(x)
+!    and the integral of Pn(t) from 0 to x.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    13 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the maximum degree.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) PN(0:N), PD(0:N), PL(0:N), the values, 
+!    derivatives and integrals of the polyomials of degrees 0 to N at X.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) n1
+  real ( kind = 8 ) p0
+  real ( kind = 8 ) p1
+  real ( kind = 8 ) pd(0:n)
+  real ( kind = 8 ) pf
+  real ( kind = 8 ) pl(0:n)
+  real ( kind = 8 ) pn(0:n)
+  real ( kind = 8 ) r
+  real ( kind = 8 ) x
+
+  pn(0) = 1.0D+00
+  pn(1) = x
+  pd(0) = 0.0D+00
+  pd(1) = 1.0D+00
+  pl(0) = x
+  pl(1) = 0.5D+00 * x * x
+  p0 = 1.0D+00
+  p1 = x
+
+  do k = 2, n
+
+    pf = ( 2.0D+00 * k - 1.0D+00 ) / k * x * p1 - ( k - 1.0D+00 ) / k * p0
+    pn(k) = pf
+
+    if ( abs ( x ) == 1.0D+00 ) then
+      pd(k) = 0.5D+00 * x ** ( k + 1 ) * k * ( k + 1.0D+00 )
+    else
+      pd(k) = k * ( p1 - x * pf ) / ( 1.0D+00 - x * x )
+    end if
+
+    pl(k) = ( x * pn(k) - pn(k-1) ) / ( k + 1.0D+00 )
+    p0 = p1
+    p1 = pf
+
+    if ( k /= 2 * int ( k / 2 ) ) then
+
+      r = 1.0D+00 / ( k + 1.0D+00 )
+      n1 = ( k - 1 ) / 2
+      do j = 1, n1
+        r = ( 0.5D+00 / j - 1.0D+00 ) * r
+      end do
+      pl(k) = pl(k) + r
+
+    end if
+
+  end do
+
+  return
+end
+subroutine lqmn ( mm, m, n, x, qm, qd )
+
+!*****************************************************************************80
+!
+!! LQMN computes associated Legendre functions Qmn(x) and derivatives.
+!
+!  Discussion:
+!
+!    This routine computes the associated Legendre functions of the
+!    second kind, Qmn(x) and Qmn'(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    13 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) MM, determines the leading dimension 
+!    of QM and QD.
+!
+!    Input, integer ( kind = 4 ) M, the order of Qmn(x).
+!
+!    Input, integer ( kind = 4 ) N, the degree of Qmn(x).
+!
+!    Output, real ( kind = 8 ) QM(0:MM,0:N), QD(0:MM,0:N), contains the values
+!    of Qmn(x) and Qmn'(x).
+!
+  implicit none
+
+  integer ( kind = 4 ) mm
+  integer ( kind = 4 ) n
+
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) km
+  integer ( kind = 4 ) ls
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) q0
+  real ( kind = 8 ) q1
+  real ( kind = 8 ) q10
+  real ( kind = 8 ) qd(0:mm,0:n)
+  real ( kind = 8 ) qf
+  real ( kind = 8 ) qf0
+  real ( kind = 8 ) qf1
+  real ( kind = 8 ) qf2
+  real ( kind = 8 ) qm(0:mm,0:n)
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xq
+  real ( kind = 8 ) xs
+
+  if ( abs ( x ) == 1.0D+00 ) then
+    do i = 0, m
+      do j = 0, n
+        qm(i,j) = 1.0D+300
+        qd(i,j) = 1.0D+300
+      end do
+    end do
+    return
+  end if
+
+  if ( 1.0D+00 < abs ( x ) ) then
+    ls = -1
+  else
+    ls = 1
+  end if
+
+  xs = ls * ( 1.0D+00 - x * x )
+  xq = sqrt ( xs )
+  q0 = 0.5D+00 * log ( abs ( ( x + 1.0D+00 ) / ( x - 1.0D+00 ) ) )
+
+  if ( abs ( x ) < 1.0001D+00 ) then
+    qm(0,0) = q0
+    qm(0,1) = x * q0 - 1.0D+00
+    qm(1,0) = -1.0D+00 / xq
+    qm(1,1) = -xq * ( q0 + x / ( 1.0D+00 - x * x ) )
+    do i = 0, 1
+      do j = 2, n
+        qm(i,j) = ( ( 2.0D+00 * j - 1.0D+00 ) * x * qm(i,j-1) &
+              - ( j + i - 1.0D+00 ) * qm(i,j-2))/ ( j - i )
+      end do
+    end do
+
+    do j = 0, n
+      do i = 2, m
+        qm(i,j) = -2.0D+00 * ( i - 1.0D+00 ) * x / xq * qm(i-1,j) &
+          - ls * ( j + i - 1.0D+00 ) * ( j - i + 2.0D+00 ) * qm(i-2,j)
+      end do
+    end do
+
+  else
+
+    if ( 1.1D+00 < abs ( x ) ) then
+      km = 40 + m + n
+    else
+      km = ( 40 + m + n ) &
+        * int ( -1.0D+00 - 1.8D+00 * log ( x - 1.0D+00 ) )
+    end if
+
+    qf2 = 0.0D+00
+    qf1 = 1.0D+00
+    do k = km, 0, -1
+      qf0 = ( ( 2 * k + 3.0D+00 ) * x * qf1 &
+        - ( k + 2.0D+00 ) * qf2 ) / ( k + 1.0D+00 )
+      if ( k <= n ) then
+        qm(0,k) = qf0
+      end if
+      qf2 = qf1
+      qf1 = qf0
+    end do
+
+    do k = 0, n
+      qm(0,k) = q0 * qm(0,k) / qf0
+    end do
+
+    qf2 = 0.0D+00
+    qf1 = 1.0D+00
+    do k = km, 0, -1
+      qf0 = ( ( 2 * k + 3.0D+00 ) * x * qf1 &
+        - ( k + 1.0D+00 ) * qf2 ) / ( k + 2.0D+00 )
+      if ( k <= n ) then
+        qm(1,k) = qf0
+      end if
+      qf2 = qf1
+      qf1 = qf0
+    end do
+
+    q10 = -1.0D+00 / xq
+    do k = 0, n
+      qm(1,k) = q10 * qm(1,k) / qf0
+    end do
+
+    do j = 0, n
+      q0 = qm(0,j)
+      q1 = qm(1,j)
+      do i = 0, m - 2
+        qf = -2.0D+00 * ( i + 1 ) * x / xq * q1 &
+          + ( j - i ) * ( j + i + 1.0D+00 ) * q0
+        qm(i+2,j) = qf
+        q0 = q1
+        q1 = qf
+      end do
+    end do
+
+  end if
+
+  qd(0,0) = ls / xs
+  do j = 1, n
+    qd(0,j) = ls * j * ( qm(0,j-1) - x * qm(0,j) ) / xs
+  end do
+
+  do j = 0, n
+    do i = 1, m
+      qd(i,j) = ls * i * x / xs * qm(i,j) &
+        + ( i + j ) * ( j - i + 1.0D+00 ) / xq * qm(i-1,j)
+    end do
+  end do
+
+  return
+end
+subroutine lqmns ( m, n, x, qm, qd )
+
+!*****************************************************************************80
+!
+!! LQMNS computes associated Legendre functions Qmn(x) and derivatives Qmn'(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    28 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the order.
+!
+!    Input, integer ( kind = 4 ) N, the degree.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) QM(0:N), QD(0:N), the values of Qmn(x) 
+!    and Qmn'(x).
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) km
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) ls
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) q0
+  real ( kind = 8 ) q00
+  real ( kind = 8 ) q01
+  real ( kind = 8 ) q0l
+  real ( kind = 8 ) q10
+  real ( kind = 8 ) q11
+  real ( kind = 8 ) q1l
+  real ( kind = 8 ) qd(0:n)
+  real ( kind = 8 ) qf0
+  real ( kind = 8 ) qf1
+  real ( kind = 8 ) qf2
+  real ( kind = 8 ) qg0
+  real ( kind = 8 ) qg1
+  real ( kind = 8 ) qh0
+  real ( kind = 8 ) qh1
+  real ( kind = 8 ) qh2
+  real ( kind = 8 ) qm(0:n)
+  real ( kind = 8 ) qm0
+  real ( kind = 8 ) qm1
+  real ( kind = 8 ) qmk
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xq
+
+  do k = 0, n
+    qm(k) = 0.0D+00
+    qd(k) = 0.0D+00
+  end do
+
+  if ( abs ( x ) == 1.0D+00 ) then
+     do k = 0, n
+       qm(k) = 1.0D+300
+       qd(k) = 1.0D+300
+     end do
+     return
+  end if
+
+  if ( 1.0D+00 < abs ( x ) ) then
+    ls = -1
+  else
+    ls = +1
+  end if
+
+  xq = sqrt ( ls * ( 1.0D+00 - x * x ) )
+  q0 = 0.5D+00 * log ( abs ( ( x + 1.0D+00 ) / ( x - 1.0D+00 ) ) )
+  q00 = q0
+  q10 = -1.0D+00 / xq
+  q01 = x * q0 - 1.0D+00
+  q11 = - ls * xq * ( q0 + x / ( 1.0D+00 - x * x ) )
+  qf0 = q00
+  qf1 = q10
+  do k = 2, m
+    qm0 = -2.0D+00 * ( k - 1.0D+00 ) / xq * x * qf1 &
+      - ls * ( k - 1.0D+00 ) * ( 2.0D+00 - k ) * qf0
+    qf0 = qf1
+    qf1 = qm0
+  end do
+
+  if ( m == 0 ) then
+    qm0 = q00
+  else if ( m == 1 ) then
+    qm0 = q10
+  end if
+
+  qm(0) = qm0
+
+  if ( abs ( x ) < 1.0001D+00 ) then
+
+    if ( m == 0 .and. 0 < n ) then
+
+      qf0 = q00
+      qf1 = q01
+      do k = 2, n
+        qf2 = ( ( 2.0D+00 * k - 1.0D+00 ) * x * qf1 &
+          - ( k - 1.0D+00 ) * qf0 ) / k
+        qm(k) = qf2
+        qf0 = qf1
+        qf1 = qf2
+      end do
+
+    end if
+    qg0 = q01
+    qg1 = q11
+    do k = 2, m
+      qm1 = - 2.0D+00 * ( k - 1.0D+00 ) / xq * x * qg1 &
+        - ls * k * ( 3.0D+00 - k ) * qg0
+      qg0 = qg1
+      qg1 = qm1
+    end do
+
+    if ( m == 0 ) then
+      qm1 = q01
+    else if ( m == 1 ) then
+      qm1 = q11
+    end if
+    qm(1) = qm1
+
+    if ( m == 1 .and. 1 < n ) then
+
+      qh0 = q10
+      qh1 = q11
+      do k = 2, n
+        qh2 = ( ( 2.0D+00 * k - 1.0D+00 ) * x * qh1 - k * qh0 ) &
+          / ( k - 1.0D+00 )
+        qm(k) = qh2
+        qh0 = qh1
+        qh1 = qh2
+      end do
+
+    else if ( 2 <= m ) then
+
+      qg0 = q00
+      qg1 = q01
+      qh0 = q10
+      qh1 = q11
+
+      do l = 2, n
+        q0l = ( ( 2.0D+00 * l - 1.0D+00 ) * x * qg1 &
+          - ( l - 1.0D+00 ) * qg0 ) / l
+        q1l = ( ( 2.0D+00 * l - 1.0D+00 ) * x * qh1 - l * qh0 ) &
+          / ( l - 1.0D+00 )
+        qf0 = q0l
+        qf1 = q1l
+        do k = 2, m
+          qmk = - 2.0D+00 * ( k - 1.0D+00 ) / xq * x * qf1 &
+            - ls * ( k + l - 1.0D+00 ) * ( l + 2.0D+00 - k ) * qf0
+          qf0 = qf1
+          qf1 = qmk
+        end do
+        qm(l) = qmk
+        qg0 = qg1
+        qg1 = q0l
+        qh0 = qh1
+        qh1 = q1l
+      end do
+
+    end if
+
+  else
+
+    if ( 1.1D+00 < abs ( x ) ) then
+      km = 40 + m + n
+    else
+      km = ( 40 + m + n ) * int ( - 1.0D+00 - 1.8D+00 * log ( x - 1.0D+00 ) )
+    end if
+
+    qf2 = 0.0D+00
+    qf1 = 1.0D+00
+    do k = km, 0, -1
+      qf0 = ( ( 2.0D+00 * k + 3.0D+00 ) * x * qf1 &
+        - ( k + 2.0D+00 - m ) * qf2 ) / ( k + m + 1.0D+00 )
+      if ( k <= n ) then
+        qm(k) = qf0
+      end if
+      qf2 = qf1
+      qf1 = qf0
+    end do
+
+    do k = 0, n
+     qm(k) = qm(k) * qm0 / qf0
+    end do
+
+  end if
+
+  if ( abs ( x ) < 1.0D+00 ) then
+    do k = 0, n
+      qm(k) = ( -1 ) ** m * qm(k)
+    end do
+  end if
+
+  qd(0) = ( ( 1.0D+00 - m ) * qm(1) - x * qm(0) )  / ( x * x - 1.0D+00 )
+  do k = 1, n
+    qd(k) = ( k * x * qm(k) - ( k + m ) * qm(k-1) ) / ( x * x - 1.0D+00 )
+  end do
+
+  return
+end
+subroutine lqna ( n, x, qn, qd )
+
+!*****************************************************************************80
+!
+!! LQNA computes Legendre function Qn(x) and derivatives Qn'(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    19 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the degree of Qn(x).
+!
+!    Input, real ( kind = 8 ) X, the argument of Qn(x).
+!
+!    Output, real ( kind = 8 ) QN(0:N), QD(0:N), the values of
+!    Qn(x) and Qn'(x).
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) q0
+  real ( kind = 8 ) q1
+  real ( kind = 8 ) qd(0:n)
+  real ( kind = 8 ) qf
+  real ( kind = 8 ) qn(0:n)
+  real ( kind = 8 ) x
+
+  if ( abs ( x ) == 1.0D+00 ) then
+
+    do k = 0, n
+      qn(k) = 1.0D+300
+      qd(k) = -1.0D+300
+    end do
+
+  else if ( abs ( x ) < 1.0D+00 ) then
+
+    q0 = 0.5D+00 * log ( ( 1.0D+00 + x ) / ( 1.0D+00 - x ) )
+    q1 = x * q0 - 1.0D+00
+    qn(0) = q0
+    qn(1) = q1
+    qd(0) = 1.0D+00 / ( 1.0D+00 - x * x )
+    qd(1) = qn(0) + x * qd(0)
+    do k = 2, n
+      qf = ( ( 2 * k - 1 ) * x * q1 - ( k - 1 ) * q0 ) / k
+      qn(k) = qf
+      qd(k) = ( qn(k-1) - x * qf ) * k / ( 1.0D+00 - x * x )
+      q0 = q1
+      q1 = qf
+    end do
+
+  end if
+
+  return
+end
+subroutine lqnb ( n, x, qn, qd )
+
+!*****************************************************************************80
+!
+!! LQNB computes Legendre function Qn(x) and derivatives Qn'(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    19 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the degree of Qn(x).
+!
+!    Input, real ( kind = 8 ) X, the argument of Qn(x).
+!
+!    Output, real ( kind = 8 ) QN(0:N), QD(0:N), the values of
+!    Qn(x) and Qn'(x).
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) eps
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) nl
+  real ( kind = 8 ) q0
+  real ( kind = 8 ) q1
+  real ( kind = 8 ) qc1
+  real ( kind = 8 ) qc2
+  real ( kind = 8 ) qd(0:n)
+  real ( kind = 8 ) qf
+  real ( kind = 8 ) qf0
+  real ( kind = 8 ) qf1
+  real ( kind = 8 ) qf2
+  real ( kind = 8 ) qn(0:n)
+  real ( kind = 8 ) qr
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x2
+
+  eps = 1.0D-14
+
+  if ( abs ( x ) == 1.0D+00 ) then
+    do k = 0, n
+      qn(k) = 1.0D+300
+      qd(k) = 1.0D+300
+    end do
+    return
+  end if
+
+  if ( x <= 1.021D+00 ) then
+
+    x2 = abs ( ( 1.0D+00 + x ) / ( 1.0D+00 - x ) )
+    q0 = 0.5D+00 * log ( x2 )
+    q1 = x * q0 - 1.0D+00
+    qn(0) = q0
+    qn(1) = q1
+    qd(0) = 1.0D+00 / ( 1.0D+00 - x * x )
+    qd(1) = qn(0) + x * qd(0)
+    do k = 2, n
+      qf = ( ( 2.0D+00 * k - 1.0D+00 ) * x * q1 &
+        - ( k - 1.0D+00 ) * q0 ) / k
+      qn(k) = qf
+      qd(k) = ( qn(k-1) - x * qf ) * k / ( 1.0D+00 - x * x )
+      q0 = q1
+      q1 = qf
+    end do
+
+  else
+
+    qc2 = 1.0D+00 / x
+    do j = 1, n
+      qc2 = qc2 * j / ( ( 2.0D+00 * j + 1.0D+00 ) * x )
+      if ( j == n - 1 ) then
+        qc1 = qc2
+      end if
+    end do
+
+    do l = 0, 1
+
+      nl = n + l
+      qf = 1.0D+00
+      qr = 1.0D+00
+      do k = 1, 500
+        qr = qr * ( 0.5D+00 * nl + k - 1.0D+00 ) &
+          * ( 0.5D+00 * ( nl - 1 ) + k ) &
+          / ( ( nl + k - 0.5D+00 ) * k * x * x )
+        qf = qf + qr
+        if ( abs ( qr / qf ) < eps ) then
+          exit
+        end if
+      end do
+
+      if ( l == 0 ) then
+        qn(n-1) = qf * qc1
+      else
+        qn(n) = qf * qc2
+      end if
+
+    end do
+
+    qf2 = qn(n)
+    qf1 = qn(n-1)
+    do k = n, 2, -1
+      qf0 = ( ( 2.0D+00 * k - 1.0D+00 ) * x * qf1 - k * qf2 ) / ( k - 1.0D+00 )
+      qn(k-2) = qf0
+      qf2 = qf1
+      qf1 = qf0
+    end do
+
+    qd(0) = 1.0D+00 / ( 1.0D+00 - x * x )
+    do k = 1, n
+      qd(k) = k * ( qn(k-1) - x * qn(k) ) / ( 1.0D+00 - x * x )
+    end do
+
+  end if
+
+  return
+end
+function msta1 ( x, mp )
+
+!*****************************************************************************80
+!
+!! MSTA1 determines a backward recurrence starting point for Jn(x).
+!
+!  Discussion:
+!
+!    This procedure determines the starting point for backward  
+!    recurrence such that the magnitude of    
+!    Jn(x) at that point is about 10^(-MP).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    08 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Input, integer ( kind = 4 ) MP, the negative logarithm of the 
+!    desired magnitude.
+!
+!    Output, integer ( kind = 4 ) MSTA1, the starting point.
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) envj
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  integer ( kind = 4 ) it
+  integer ( kind = 4 ) mp
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) n0
+  integer ( kind = 4 ) n1
+  integer ( kind = 4 ) nn
+  real ( kind = 8 ) x
+
+  a0 = abs ( x )
+  n0 = int ( 1.1D+00 * a0 ) + 1
+  f0 = envj ( n0, a0 ) - mp
+  n1 = n0 + 5
+  f1 = envj ( n1, a0 ) - mp
+  do it = 1, 20       
+    nn = n1 - int ( real ( n1 - n0, kind = 8 ) / ( 1.0D+00 - f0 / f1 ) )               
+    f = envj ( nn, a0 ) - mp
+    if ( abs ( nn - n1 ) < 1 ) then
+      exit
+    end if
+    n0 = n1
+    f0 = f1
+    n1 = nn
+    f1 = f
+  end do
+
+  msta1 = nn
+
+  return
+end
+function msta2 ( x, n, mp )
+
+!*****************************************************************************80
+!
+!! MSTA2 determines a backward recurrence starting point for Jn(x).
+!
+!  Discussion:
+!
+!    This procedure determines the starting point for a backward
+!    recurrence such that all Jn(x) has MP significant digits.
+!
+!    Jianming Jin supplied a modification to this code on 12 January 2016.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    14 January 2016
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument of Jn(x).
+!
+!    Input, integer ( kind = 4 ) N, the order of Jn(x).
+!
+!    Input, integer ( kind = 4 ) MP, the number of significant digits.
+!
+!    Output, integer ( kind = 4 ) MSTA2, the starting point.
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) ejn
+  real ( kind = 8 ) envj
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) hmp
+  integer ( kind = 4 ) it
+  integer ( kind = 4 ) mp
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) n
+  integer ( kind = 4 ) n0
+  integer ( kind = 4 ) n1
+  integer ( kind = 4 ) nn
+  real ( kind = 8 ) obj
+  real ( kind = 8 ) x
+
+  a0 = abs ( x )
+  hmp = 0.5D+00 * mp
+  ejn = envj ( n, a0 )
+
+  if ( ejn <= hmp ) then
+    obj = mp
+!
+!  Original code:
+!
+!   n0 = int ( 1.1D+00 * a0 )
+!
+!  Updated code:
+!
+    n0 = int ( 1.1D+00 * a0 ) + 1
+  else
+    obj = hmp + ejn
+    n0 = n
+  end if
+
+  f0 = envj ( n0, a0 ) - obj
+  n1 = n0 + 5
+  f1 = envj ( n1, a0 ) - obj
+
+  do it = 1, 20
+    nn = n1 - int ( real ( n1 - n0, kind = 8 ) / ( 1.0D+00 - f0 / f1 ) )
+    f = envj ( nn, a0 ) - obj
+    if ( abs ( nn - n1 ) < 1 ) then
+      exit
+    end if
+    n0 = n1
+    f0 = f1
+    n1 = nn
+    f1 = f
+  end do
+
+  msta2 = nn + 10
+
+  return
+end
+subroutine mtu0 ( kf, m, q, x, csf, csd )
+
+!*****************************************************************************80
+!
+!! MTU0 computes Mathieu functions CEM(x,q) and SEM(x,q) and derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    20 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) KF, the function code.
+!    1 for computing cem(x,q) and cem'(x,q)
+!    2 for computing sem(x,q) and sem'(x,q).
+!
+!    Input, integer ( kind = 4 ) M, the order of the Mathieu functions.
+!
+!    Input, real ( kind = 8 ) Q, the parameter of the Mathieu functions.
+!
+!    Input, real ( kind = 8 ) X, the argument of the Mathieu functions,
+!    in degrees.
+!
+!    Output, real ( kind = 8 ) CSF, CSD, the values of cem(x,q) and cem'(x,q),
+!    or of sem(x,q) and sem'(x,q).
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) csd
+  real ( kind = 8 ) csf
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) fg(251)
+  integer ( kind = 4 ) ic
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) kf
+  integer ( kind = 4 ) km
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) q
+  real ( kind = 8 ) qm
+  real ( kind = 8 ) rd
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xr
+
+  eps = 1.0D-14
+
+  if ( kf == 1 ) then
+
+    if ( m == 2 * int ( m / 2 ) ) then
+      kd = 1
+    else
+      kd = 2
+    end if
+
+  else
+
+    if ( m /= 2 * int ( m / 2 ) ) then
+      kd = 3
+    else
+      kd = 4
+    end if
+
+  end if
+
+  call cva2 ( kd, m, q, a )
+
+  if ( q <= 1.0D+00 ) then
+    qm = 7.5D+00 + 56.1D+00 * sqrt ( q ) - 134.7D+00 * q &
+      + 90.7D+00 * sqrt ( q ) * q
+  else
+    qm = 17.0D+00 + 3.1D+00 * sqrt ( q ) - 0.126D+00 * q &
+      + 0.0037D+00 * sqrt ( q ) * q
+  end if
+
+  km = int ( qm + 0.5D+00 * m )
+  call fcoef ( kd, m, q, a, fg )
+  ic = int ( m / 2 ) + 1
+  rd = 1.74532925199433D-02
+  xr = x * rd
+
+  csf = 0.0D+00
+
+  do k = 1, km
+
+    if ( kd == 1 ) then
+      csf = csf + fg(k) * cos ( ( 2.0D+00 * k - 2.0D+00 ) * xr )
+    else if ( kd == 2 ) then
+      csf = csf + fg(k) * cos ( ( 2.0D+00 * k - 1.0D+00 ) * xr )
+    else if ( kd == 3 ) then
+      csf = csf + fg(k) * sin ( ( 2.0D+00 * k - 1.0D+00 ) * xr )
+    else if ( kd == 4 ) then
+      csf = csf + fg(k) * sin ( 2.0D+00 * k * xr )
+    end if
+
+    if ( ic <= k .and. abs ( fg(k) ) < abs ( csf ) * eps ) then
+      exit
+    end if
+
+  end do
+
+  csd = 0.0D+00
+
+  do k = 1, km
+
+    if ( kd == 1 ) then
+      csd = csd - ( 2 * k - 2 ) * fg(k) * sin ( ( 2 * k - 2 ) * xr )
+    else if ( kd == 2 ) then
+      csd = csd - ( 2 * k - 1 ) * fg(k) * sin ( ( 2 * k - 1 ) * xr )
+    else if ( kd == 3 ) then
+      csd = csd + ( 2 * k - 1 ) * fg(k) * cos ( ( 2 * k - 1 ) * xr )
+    else if ( kd == 4 ) then
+      csd = csd + 2.0D+00 * k * fg(k) * cos ( 2 * k * xr )
+    end if
+
+    if ( ic <= k .and. abs ( fg(k) ) < abs ( csd ) * eps ) then
+      exit
+    end if
+
+  end do
+
+  return
+end
+subroutine mtu12 ( kf, kc, m, q, x, f1r, d1r, f2r, d2r )
+
+!*****************************************************************************80
+!
+!! MTU12 computes modified Mathieu functions of the first and second kind.
+!
+!  Discussion:
+!
+!    This procedure computes modified Mathieu functions of the first and
+!    second kinds, Mcm(1)(2)(x,q) and Msm(1)(2)(x,q),
+!    and their derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    31 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) KF, the function code.
+!    1 for computing Mcm(x,q);
+!    2 for computing Msm(x,q).
+!
+!    Input, integer ( kind = 4 ) KC, the function code.
+!    1, for computing the first kind
+!    2, for computing the second kind or Msm(2)(x,q) and Msm(2)'(x,q)
+!    3, for computing both the first and second kinds.
+!
+!    Input, integer ( kind = 4 ) M, the order of the Mathieu functions.
+!
+!    Input, real ( kind = 8 ) Q, the parameter of the Mathieu functions.
+!
+!    Input, real ( kind = 8 ) X, the argument of the Mathieu functions.
+!
+!    Output, real ( kind = 8 ) F1R, D1R, F2R, D2R, the values of 
+!    Mcm(1)(x,q) or Msm(1)(x,q), Derivative of Mcm(1)(x,q) or Msm(1)(x,q),
+!    Mcm(2)(x,q) or Msm(2)(x,q), Derivative of Mcm(2)(x,q) or Msm(2)(x,q).
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) bj1(0:251)
+  real ( kind = 8 ) bj2(0:251)
+  real ( kind = 8 ) by1(0:251)
+  real ( kind = 8 ) by2(0:251)
+  real ( kind = 8 ) c1
+  real ( kind = 8 ) c2
+  real ( kind = 8 ) d1r
+  real ( kind = 8 ) d2r
+  real ( kind = 8 ) dj1(0:251)
+  real ( kind = 8 ) dj2(0:251)
+  real ( kind = 8 ) dy1(0:251)
+  real ( kind = 8 ) dy2(0:251)
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) f1r
+  real ( kind = 8 ) f2r
+  real ( kind = 8 ) fg(251)
+  integer ( kind = 4 ) ic
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) kc
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) kf
+  integer ( kind = 4 ) km
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) q
+  real ( kind = 8 ) qm
+  real ( kind = 8 ) u1
+  real ( kind = 8 ) u2
+  real ( kind = 8 ) w1
+  real ( kind = 8 ) w2
+  real ( kind = 8 ) x
+
+  eps = 1.0D-14
+
+  if ( kf == 1 ) then
+    if ( m == 2 * int ( m / 2 ) ) then
+      kd = 1
+    else
+      kd = 2
+    end if
+  else
+    if ( m /= 2 * int ( m / 2 ) ) then
+      kd = 3
+    else
+      kd = 4
+    end if
+  end if
+
+  call cva2 ( kd, m, q, a )
+
+  if ( q <= 1.0D+00 ) then
+    qm = 7.5D+00 + 56.1D+00 * sqrt ( q ) - 134.7D+00 * q &
+      + 90.7D+00 * sqrt ( q ) * q
+  else
+    qm = 17.0D+00 + 3.1D+00 * sqrt ( q ) - 0.126D+00 * q &
+      + 0.0037D+00 * sqrt ( q ) * q
+  end if
+
+  km = int ( qm + 0.5D+00 * m )              
+  call fcoef ( kd, m, q, a, fg )
+
+  if ( kd == 4 ) then
+    ic = m / 2
+  else
+    ic = int ( m / 2 ) + 1
+  end if
+
+  c1 = exp ( - x )
+  c2 = exp ( x )
+  u1 = sqrt ( q ) * c1
+  u2 = sqrt ( q ) * c2
+
+  call jynb ( km, u1, nm, bj1, dj1, by1, dy1 )
+  call jynb ( km, u2, nm, bj2, dj2, by2, dy2 )
+
+  if ( kc == 1 ) then
+
+    f1r = 0.0D+00
+
+    do k = 1, km
+
+      if ( kd == 1 ) then
+        f1r = f1r + ( - 1.0D+00 ) ** ( ic + k ) * fg(k) * bj1(k-1) * bj2(k-1)
+      else if ( kd == 2 .or. kd == 3 ) then
+        f1r = f1r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) * ( bj1(k-1) * bj2(k) &
+          + ( - 1.0D+00 ) ** kd * bj1(k) * bj2(k-1) )
+      else
+        f1r = f1r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) &
+          * ( bj1(k-1) * bj2(k+1) - bj1(k+1) * bj2(k-1) )
+      end if
+
+      if ( 5 <= k .and. abs ( f1r - w1 ) < abs ( f1r ) * eps ) then
+        exit
+      end if
+
+      w1 = f1r
+
+    end do
+
+    f1r = f1r / fg(1)
+    d1r = 0.0D+00
+    do k = 1, km
+      if ( kd == 1 ) then
+        d1r = d1r + ( - 1.0D+00 ) ** ( ic + k ) * fg(k) &
+          * ( c2 * bj1(k-1) * dj2(k-1) - c1 * dj1(k-1) * bj2(k-1) )
+      else if ( kd == 2 .or. kd == 3 ) then
+        d1r = d1r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) &
+          * ( c2 * ( bj1(k-1) * dj2(k) &
+          + ( -1.0D+00 ) ** kd * bj1(k) * dj2(k-1) ) &
+          - c1 * ( dj1(k-1) * bj2(k) &
+          + ( -1.0D+00 ) ** kd * dj1(k) * bj2(k-1) ) )
+      else
+        d1r = d1r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) &
+          * ( c2 * ( bj1(k-1) * dj2(k+1) - bj1(k+1) * dj2(k-1) ) &
+          - c1 * ( dj1(k-1) * bj2(k+1) - dj1(k+1) * bj2(k-1) ) )
+      end if
+      if ( 5 <= k .and. abs ( d1r - w2 ) < abs ( d1r ) * eps ) then
+        exit
+      end if
+      w2 = d1r
+    end do
+
+    d1r = d1r * sqrt ( q ) / fg(1)
+
+  else
+
+    f2r = 0.0D+00
+
+    do k = 1, km
+      if ( kd == 1 ) then
+        f2r = f2r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) &
+          * bj1(k-1) * by2(k-1)
+      else if ( kd == 2 .or. kd == 3 ) then
+        f2r = f2r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) * ( bj1(k-1) * by2(k) &
+          + ( -1.0D+00 ) ** kd * bj1(k) * by2(k-1) )
+      else
+        f2r = f2r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) &
+          * ( bj1(k-1) * by2(k+1) - bj1(k+1) * by2(k-1) )
+      end if
+      if ( 5 <= k .and. abs ( f2r - w1 ) < abs ( f2r ) * eps ) then
+        exit
+      end if
+      w1 = f2r
+    end do
+
+    f2r = f2r / fg(1)
+    d2r = 0.0D+00
+
+    do k = 1, km
+      if ( kd == 1 ) then
+        d2r = d2r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) &
+          * ( c2 * bj1(k-1) * dy2(k-1) - c1 * dj1(k-1) * by2(k-1) )
+      else if ( kd == 2 .or. kd == 3 ) then
+        d2r = d2r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) &
+          * ( c2 * ( bj1(k-1) * dy2(k) &
+          + ( -1.0D+00 ) ** kd * bj1(k) * dy2(k-1) ) &
+          - c1 * ( dj1(k-1) * by2(k) + ( -1.0D+00 ) ** kd &
+          * dj1(k) * by2(k-1) ) )
+      else
+        d2r = d2r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) &
+          * ( c2 * ( bj1(k-1) * dy2(k+1) - bj1(k+1) * dy2(k-1) ) &
+          - c1 * ( dj1(k-1) * by2(k+1) - dj1(k+1) * by2(k-1) ) )
+      end if
+
+      if ( 5 <= k .and. abs ( d2r - w2 ) < abs ( d2r ) * eps ) then
+        exit
+      end if
+
+      w2 = d2r
+
+    end do
+
+    d2r = d2r * sqrt ( q ) / fg(1)
+
+  end if
+
+  return
+end
+subroutine othpl ( kf, n, x, pl, dpl )
+
+!*****************************************************************************80
+!
+!! OTHPL computes orthogonal polynomials Tn(x), Un(x), Ln(x) or Hn(x).
+!
+!  Discussion:
+!
+!    This procedure computes orthogonal polynomials: Tn(x) or Un(x),
+!    or Ln(x) or Hn(x), and their derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    08 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) KT, the function code:
+!    1 for Chebyshev polynomial Tn(x)
+!    2 for Chebyshev polynomial Un(x)
+!    3 for Laguerre polynomial Ln(x)
+!    4 for Hermite polynomial Hn(x)
+!
+!    Input, integer ( kind = 4 ) N, the order.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) PL(0:N), DPL(0:N), the value and derivative of
+!    the polynomials of order 0 through N at X.
+!
+  implicit none
+
+  integer n
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) b
+  real ( kind = 8 ) c
+  real ( kind = 8 ) dpl(0:n)
+  real ( kind = 8 ) dy0
+  real ( kind = 8 ) dy1
+  real ( kind = 8 ) dyn
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) kf
+  real ( kind = 8 ) pl(0:n)
+  real ( kind = 8 ) x
+  real ( kind = 8 ) y0
+  real ( kind = 8 ) y1
+  real ( kind = 8 ) yn
+
+  a = 2.0D+00
+  b = 0.0D+00
+  c = 1.0D+00
+  y0 = 1.0D+00
+  y1 = 2.0D+00 * x
+  dy0 = 0.0D+00
+  dy1 = 2.0D+00
+  pl(0) = 1.0D+00
+  pl(1) = 2.0D+00 * x
+  dpl(0) = 0.0D+00
+  dpl(1) = 2.0D+00
+
+  if ( kf == 1 ) then
+    y1 = x
+    dy1 = 1.0D+00
+    pl(1) = x
+    dpl(1) = 1.0D+00
+  else if ( kf == 3 ) then
+    y1 = 1.0D+00 - x
+    dy1 = -1.0D+00
+    pl(1) = 1.0D+00 - x
+    dpl(1) = -1.0D+00
+  end if
+
+  do k = 2, n
+
+    if ( kf == 3 ) then
+      a = -1.0D+00 / k
+      b = 2.0D+00 + a
+      c = 1.0D+00 + a
+    else if ( kf == 4 ) then
+      c = 2.0D+00 * ( k - 1.0D+00 )
+    end if
+
+    yn = ( a * x + b ) * y1 - c * y0
+    dyn = a * y1 + ( a * x + b ) * dy1 - c * dy0
+    pl(k) = yn
+    dpl(k) = dyn
+    y0 = y1
+    y1 = yn
+    dy0 = dy1
+    dy1 = dyn
+
+  end do
+
+  return
+end
+subroutine pbdv ( v, x, dv, dp, pdf, pdd )
+
+!*****************************************************************************80
+!
+!! PBDV computes parabolic cylinder functions Dv(x) and derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    29 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) V, the order.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) DV(0:*), DP(0:*), the values of
+!    Dn+v0(x), Dn+v0'(x).
+!
+!    Output, real ( kind = 8 ) PDF, PDD, the values of Dv(x) and Dv'(x).
+!
+  implicit none
+
+  real ( kind = 8 ) dp(0:*)
+  real ( kind = 8 ) dv(0:*)
+  real ( kind = 8 ) ep
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  integer ( kind = 4 ) ja
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) na
+  integer ( kind = 4 ) nk
+  integer ( kind = 4 ) nv
+  real ( kind = 8 ) pd
+  real ( kind = 8 ) pd0
+  real ( kind = 8 ) pd1
+  real ( kind = 8 ) pdd
+  real ( kind = 8 ) pdf
+  real ( kind = 8 ) s0
+  real ( kind = 8 ) v
+  real ( kind = 8 ) v0
+  real ( kind = 8 ) v1
+  real ( kind = 8 ) v2
+  real ( kind = 8 ) vh
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xa
+
+  xa = abs ( x )
+  vh = v
+  v = v + sign ( 1.0D+00, v )
+  nv = int ( v )
+  v0 = v - nv
+  na = abs ( nv )
+  ep = exp ( -0.25D+00 * x * x )
+
+  if ( 1 <= na ) then
+    ja = 1
+  end if
+
+  if ( 0.0D+00 <= v ) then
+    if ( v0 == 0.0D+00 ) then
+      pd0 = ep
+      pd1 = x * ep
+    else
+      do l = 0, ja
+        v1 = v0 + l
+        if ( xa <= 5.8D+00 ) then
+          call dvsa ( v1, x, pd1 )
+        else
+          call dvla ( v1, x, pd1 )
+        end if
+        if ( l == 0 ) then
+          pd0 = pd1
+        end if
+      end do
+    end if
+
+    dv(0) = pd0
+    dv(1) = pd1
+    do k = 2, na
+      pdf = x * pd1 - ( k + v0 - 1.0D+00 ) * pd0
+      dv(k) = pdf
+      pd0 = pd1
+      pd1 = pdf
+    end do
+
+  else
+
+    if ( x <= 0.0D+00 ) then
+
+      if ( xa <= 5.8D+00 )  then
+        call dvsa ( v0, x, pd0 )
+        v1 = v0 - 1.0D+00
+        call dvsa ( v1, x, pd1 )
+      else
+        call dvla ( v0, x, pd0 )
+        v1 = v0 - 1.0D+00
+        call dvla ( v1, x, pd1 )
+      end if
+
+      dv(0) = pd0
+      dv(1) = pd1
+      do k = 2, na
+        pd = ( - x * pd1 + pd0 ) / ( k - 1.0D+00 - v0 )
+        dv(k) = pd
+        pd0 = pd1
+        pd1 = pd
+      end do
+
+    else if ( x <= 2.0D+00 ) then
+
+      v2 = nv + v0
+      if ( nv == 0 ) then
+        v2 = v2 - 1.0D+00
+      end if
+
+      nk = int ( - v2 )
+      call dvsa ( v2, x, f1 )
+      v1 = v2 + 1.0D+00
+      call dvsa ( v1, x, f0 )
+      dv(nk) = f1
+      dv(nk-1) = f0
+      do k = nk - 2, 0, -1
+        f = x * f0 + ( k - v0 + 1.0D+00 ) * f1
+        dv(k) = f
+        f1 = f0
+        f0 = f
+      end do
+
+    else
+
+      if ( xa <= 5.8D+00 ) then
+        call dvsa ( v0, x, pd0 )
+      else
+        call dvla ( v0, x, pd0 )
+      end if
+
+      dv(0) = pd0
+      m = 100 + na
+      f1 = 0.0D+00
+      f0 = 1.0D-30
+      do k = m, 0, -1
+        f = x * f0 + ( k - v0 + 1.0D+00 ) * f1
+        if ( k <= na ) then
+          dv(k) = f
+        end if
+        f1 = f0
+        f0 = f
+      end do
+      s0 = pd0 / f
+      do k = 0, na
+        dv(k) = s0 * dv(k)
+      end do
+
+    end if
+
+  end if
+
+  do k = 0, na - 1
+    v1 = abs ( v0 ) + k
+    if ( 0.0D+00 <= v ) then
+      dp(k) = 0.5D+00 * x * dv(k) - dv(k+1)
+    else
+      dp(k) = -0.5D+00 * x * dv(k) - v1 * dv(k+1)
+    end if
+  end do
+
+  pdf = dv(na-1)
+  pdd = dp(na-1)
+  v = vh
+
+  return
+end
+subroutine pbvv ( v, x, vv, vp, pvf, pvd )
+
+!*****************************************************************************80
+!
+!! PBVV computes parabolic cylinder functions Vv(x) and their derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    29 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) V, the order.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) VV(0:*), VP(0:*), the values of Vv(x), Vv'(x).
+!
+!    Output, real ( kind = 8 ) PVF, PVD, the values of Vv(x) and Vv'(x).
+!
+  implicit none
+
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  integer ( kind = 4 ) ja
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) kv
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) na
+  integer ( kind = 4 ) nv
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) pv0
+  real ( kind = 8 ) pvd
+  real ( kind = 8 ) pvf
+  real ( kind = 8 ) q2p
+  real ( kind = 8 ) qe
+  real ( kind = 8 ) s0
+  real ( kind = 8 ) v
+  real ( kind = 8 ) v0
+  real ( kind = 8 ) v1
+  real ( kind = 8 ) v2
+  real ( kind = 8 ) vh
+  real ( kind = 8 ) vp(0:*)
+  real ( kind = 8 ) vv(0:*)
+  real ( kind = 8 ) x
+  real ( kind = 8 ) xa
+
+  pi = 3.141592653589793D+00
+  xa = abs ( x )
+  vh = v
+  v = v + sign ( 1.0D+00, v )
+  nv = int ( v )
+  v0 = v - nv
+  na = abs ( nv )
+  qe = exp ( 0.25D+00 * x * x )
+  q2p = sqrt ( 2.0D+00 / pi )
+
+  if ( 1 <= na ) then
+    ja = 1
+  end if
+
+  if ( v <= 0.0D+00 ) then
+
+    if ( v0 == 0.0D+00 ) then
+
+      if ( xa <= 7.5D+00 ) then 
+        call vvsa ( v0, x, pv0 )
+      else
+        call vvla ( v0, x, pv0 )
+      end if
+
+      f0 = q2p * qe
+      f1 = x * f0
+      vv(0) = pv0
+      vv(1) = f0
+      vv(2) = f1
+
+    else
+
+      do l = 0, ja
+        v1 = v0 - l
+        if ( xa <= 7.5D+00 ) then
+          call vvsa ( v1, x, f1 )
+        else
+          call vvla ( v1, x, f1 )
+        end if
+        if ( l == 0 ) then
+          f0 = f1
+        end if
+      end do
+
+      vv(0) = f0
+      vv(1) = f1
+
+    end if
+
+    if ( v0 == 0.0D+00 ) then
+      kv = 3
+    else
+      kv = 2
+    end if
+
+    do k = kv, na
+      f = x * f1 + ( k - v0 - 2.0D+00 ) * f0
+      vv(k) = f
+      f0 = f1
+      f1 = f
+    end do
+
+  else
+
+    if ( 0.0D+00 <= x .and. x <= 7.5D+00 ) then
+
+      v2 = v
+      if ( v2 < 1.0D+00 ) then
+        v2 = v2 + 1.0D+00
+      end if
+
+      call vvsa ( v2, x, f1 )
+      v1 = v2 - 1.0D+00
+      kv = int ( v2 )
+      call vvsa ( v1, x, f0 )
+      vv(kv) = f1
+      vv(kv-1) = f0
+      do k = kv - 2, 0, - 1
+        f = x * f0 - ( k + v0 + 2.0D+00 ) * f1
+        if ( k <= na ) then
+          vv(k) = f
+        end if
+        f1 = f0
+        f0 = f
+      end do
+
+    else if ( 7.5D+00 < x ) then
+
+      call vvla ( v0, x, pv0 )
+      m = 100 + abs ( na )
+      vv(1) = pv0
+      f1 = 0.0D+00
+      f0 = 1.0D-40
+      do k = m, 0, -1
+        f = x * f0 - ( k + v0 + 2.0D+00 ) * f1
+        if ( k <= na ) then
+          vv(k) = f
+        end if
+        f1 = f0
+        f0 = f
+      end do
+      s0 = pv0 / f
+      do k = 0, na
+        vv(k) = s0 * vv(k)
+      end do
+
+    else
+
+      if ( xa <= 7.5D+00 ) then
+        call vvsa ( v0, x, f0 )
+        v1 = v0 + 1.0D+00
+        call vvsa ( v1, x, f1 )
+      else
+        call vvla ( v0, x, f0 )
+        v1 = v0 + 1.0D+00
+        call vvla ( v1, x, f1 )
+      end if
+
+      vv(0) = f0
+      vv(1) = f1
+      do k = 2, na
+        f = ( x * f1 - f0 ) / ( k + v0 )
+        vv(k) = f
+        f0 = f1
+        f1 = f
+      end do
+
+    end if
+
+  end if
+
+  do k = 0, na - 1
+    v1 = v0 + k
+    if ( 0.0D+00 <= v ) then
+      vp(k) = 0.5D+00 * x * vv(k) - ( v1 + 1.0D+00 ) * vv(k+1)
+    else
+      vp(k) = - 0.5D+00 * x * vv(k) + vv(k+1)
+    end if
+  end do
+
+  pvf = vv(na-1)
+  pvd = vp(na-1)
+  v = vh
+
+  return
+end
+subroutine pbwa ( a, x, w1f, w1d, w2f, w2d )
+
+!*****************************************************************************80
+!
+!! PBWA computes parabolic cylinder functions W(a,x) and derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    29 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) A, the parameter.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) W1F, W1D, W2F, W2D, the values of
+!    W(a,x), W'(a,x), W(a,-x), W'(a,-x).
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) d(100)
+  real ( kind = 8 ) d1
+  real ( kind = 8 ) d2
+  real ( kind = 8 ) dl
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) f2
+  real ( kind = 8 ) g1
+  real ( kind = 8 ) g2
+  real ( kind = 8 ) h(100)
+  real ( kind = 8 ) h0
+  real ( kind = 8 ) h1
+  real ( kind = 8 ) hl
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) l1
+  integer ( kind = 4 ) l2
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) p0
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) ugi
+  real ( kind = 8 ) ugr
+  real ( kind = 8 ) vgi
+  real ( kind = 8 ) vgr
+  real ( kind = 8 ) w1d
+  real ( kind = 8 ) w1f
+  real ( kind = 8 ) w2d
+  real ( kind = 8 ) w2f
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x1
+  real ( kind = 8 ) x2
+  real ( kind = 8 ) y1
+  real ( kind = 8 ) y1d
+  real ( kind = 8 ) y1f
+  real ( kind = 8 ) y2d
+  real ( kind = 8 ) y2f
+
+  eps = 1.0D-15
+  p0 = 0.59460355750136D+00
+
+  if ( a == 0.0D+00 ) then
+    g1 = 3.625609908222D+00
+    g2 = 1.225416702465D+00
+  else
+    x1 = 0.25D+00
+    y1 = 0.5D+00 * a
+    call cgama ( x1, y1, 1, ugr, ugi )
+    g1 = sqrt ( ugr * ugr + ugi * ugi )
+    x2 = 0.75D+00
+    call cgama ( x2, y1, 1, vgr, vgi )
+    g2 = sqrt ( vgr * vgr + vgi * vgi )
+  end if
+
+  f1 = sqrt ( g1 / g2 )
+  f2 = sqrt ( 2.0D+00 * g2 / g1 )
+  h0 = 1.0D+00
+  h1 = a
+  h(1) = a
+  do l1 = 4, 200, 2
+    m = l1 / 2
+    hl = a * h1 - 0.25D+00 * ( l1 - 2.0D+00 ) * ( l1 - 3.0D+00 ) * h0
+    h(m) = hl
+    h0 = h1
+    h1 = hl
+  end do
+  y1f = 1.0D+00
+  r = 1.0D+00
+  do k = 1, 100
+    r = 0.5D+00 * r * x * x / ( k * ( 2.0D+00 * k - 1.0D+00 ) )
+    r1 = h(k) * r
+    y1f = y1f + r1
+    if ( abs ( r1 / y1f ) <= eps .and. 30 < k ) then
+      exit
+    end if
+  end do
+
+  y1d = a
+  r = 1.0D+00
+  do k = 1, 100
+    r = 0.5D+00 * r * x * x / ( k * ( 2.0D+00 * k + 1.0D+00 ) )
+    r1 = h(k+1) * r
+    y1d = y1d + r1
+    if ( abs ( r1 / y1d ) <= eps .and. 30 < k ) then
+      exit
+    end if
+  end do
+
+  y1d = x * y1d
+  d1 = 1.0D+00
+  d2 = a
+  d(1) = 1.0D+00
+  d(2) = a
+  do l2 = 5, 160, 2
+    m = ( l2 + 1 ) / 2
+    dl = a * d2 - 0.25D+00 * ( l2 - 2.0D+00 ) * ( l2 - 3.0D+00 ) * d1
+    d(m) = dl
+    d1 = d2
+    d2 = dl
+  end do
+
+  y2f = 1.0D+00
+  r = 1.0D+00
+  do k = 1, 100
+    r = 0.5D+00 * r * x * x / ( k * ( 2.0D+00 * k + 1.0D+00 ) )
+    r1 = d(k+1) * r
+    y2f = y2f + r1
+    if ( abs ( r1 / y2f ) <= eps .and. 30 < k ) then
+      exit
+    end if
+  end do
+
+  y2f = x * y2f
+  y2d = 1.0D+00
+  r = 1.0D+00
+  do k = 1, 100
+    r = 0.5D+00 * r * x * x / ( k * ( 2.0D+00 * k - 1.0D+00 ) )
+    r1 = d(k+1) * r
+    y2d = y2d + r1
+    if ( abs ( r1 / y2d ) <= eps .and. 30 < k ) then
+      exit
+    end if
+  end do
+
+  w1f = p0 * ( f1 * y1f - f2 * y2f )
+  w2f = p0 * ( f1 * y1f + f2 * y2f )
+  w1d = p0 * ( f1 * y1d - f2 * y2d )
+  w2d = p0 * ( f1 * y1d + f2 * y2d )
+
+  return
+end
+subroutine psi ( x, ps )
+
+!*****************************************************************************80
+!
+!! PSI computes the PSI function.
+!
+!  Licensing:
+!
+!    The original FORTRAN77 version of this routine is copyrighted by 
+!    Shanjie Zhang and Jianming Jin.  However, they give permission to 
+!    incorporate this routine into a user program that the copyright 
+!    is acknowledged.
+!
+!  Modified:
+!
+!    08 September 2007
+!
+!  Author:
+!
+!    Original FORTRAN77 by Shanjie Zhang, Jianming Jin.
+!    FORTRAN90 version by John Burkardt.
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) PS, the value of the PSI function.
+!
+  implicit none
+
+  real ( kind = 8 ), parameter :: a1 = -0.83333333333333333D-01
+  real ( kind = 8 ), parameter :: a2 =  0.83333333333333333D-02
+  real ( kind = 8 ), parameter :: a3 = -0.39682539682539683D-02
+  real ( kind = 8 ), parameter :: a4 =  0.41666666666666667D-02
+  real ( kind = 8 ), parameter :: a5 = -0.75757575757575758D-02
+  real ( kind = 8 ), parameter :: a6 =  0.21092796092796093D-01
+  real ( kind = 8 ), parameter :: a7 = -0.83333333333333333D-01
+  real ( kind = 8 ), parameter :: a8 =  0.4432598039215686D+00
+  real ( kind = 8 ), parameter :: el = 0.5772156649015329D+00
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) n
+  real ( kind = 8 ), parameter :: pi = 3.141592653589793D+00
+  real ( kind = 8 ) ps
+  real ( kind = 8 ) s
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x2
+  real ( kind = 8 ) xa
+
+  xa = abs ( x )
+  s = 0.0D+00
+
+  if ( x == aint ( x ) .and. x <= 0.0D+00 ) then
+
+    ps = 1.0D+300
+    return
+
+  else if ( xa == aint ( xa ) ) then
+
+    n = int ( xa )
+    do k = 1, n - 1
+      s = s + 1.0D+00 / real ( k, kind = 8 )
+    end do
+
+    ps = - el + s
+
+  else if ( xa + 0.5D+00 == aint ( xa + 0.5D+00 ) ) then
+
+    n = int ( xa - 0.5D+00 )
+
+    do k = 1, n
+      s = s + 1.0D+00 / real ( 2 * k - 1, kind = 8 )
+    end do
+
+    ps = - el + 2.0D+00 * s - 1.386294361119891D+00
+
+  else
+
+    if ( xa < 10.0D+00 ) then
+
+      n = 10 - int ( xa )
+      do k = 0, n - 1
+        s = s + 1.0D+00 / ( xa + real ( k, kind = 8 ) )
+      end do
+
+      xa = xa + real ( n, kind = 8 )
+
+    end if
+
+    x2 = 1.0D+00 / ( xa * xa )
+
+    ps = log ( xa ) - 0.5D+00 / xa + x2 * ((((((( &
+             a8   &
+      * x2 + a7 ) &
+      * x2 + a6 ) &
+      * x2 + a5 ) &
+      * x2 + a4 ) &
+      * x2 + a3 ) &
+      * x2 + a2 ) &
+      * x2 + a1 )
+
+    ps = ps - s
+
+  end if
+
+  if ( x < 0.0D+00 ) then
+    ps = ps - pi * cos ( pi * x ) / sin ( pi * x ) - 1.0D+00 / x
+  end if
+
+  return
+end
+subroutine qstar ( m, n, c, ck, ck1, qs, qt )
+
+!*****************************************************************************80
+!
+!! QSTAR computes Q*mn(-ic) for oblate radial functions with a small argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    18 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
+!
+!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
+!
+!    Input, real ( kind = 8 ) C, spheroidal parameter.
+!
+!    Input, real ( kind = 8 ) CK(*), ?
+!
+!    Input, real ( kind = 8 ) CK1, ?
+!
+!    Output, real ( kind = 8 ) QS, ?
+!
+!    Output, real ( kind = 8 ) QT, ?
+!
+  implicit none
+
+  real ( kind = 8 ) ap(200)
+  real ( kind = 8 ) c
+  real ( kind = 8 ) ck(200)
+  real ( kind = 8 ) ck1
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) ip
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) qs
+  real ( kind = 8 ) qs0
+  real ( kind = 8 ) qt
+  real ( kind = 8 ) r
+  real ( kind = 8 ) s
+  real ( kind = 8 ) sk
+
+  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
+    ip = 0
+  else
+    ip = 1
+  end if
+
+  r = 1.0D+00 / ck(1) ** 2
+  ap(1) = r
+  do i = 1, m
+    s = 0.0D+00
+    do l = 1, i
+      sk = 0.0D+00
+      do k = 0, l
+        sk = sk + ck(k+1) * ck(l-k+1)
+      end do
+      s = s + sk * ap(i-l+1)
+    end do
+    ap(i+1) = -r * s
+  end do 
+
+  qs0 = ap(m+1)     
+  do l = 1, m
+    r = 1.0D+00
+    do k = 1, l
+      r = r * ( 2.0D+00 * k + ip ) &
+        * ( 2.0D+00 * k - 1.0D+00 + ip ) / ( 2.0D+00 * k ) ** 2
+    end do
+    qs0 = qs0 + ap(m-l+1) * r
+  end do
+
+  qs = ( -1.0D+00 ) ** ip * ck1 * ( ck1 * qs0 ) / c
+  qt = - 2.0D+00 / ck1 * qs
+
+  return
+end
+function r8_gamma_log ( x )
+
+!*****************************************************************************80
+!
+!! R8_GAMMA_LOG evaluates the logarithm of the gamma function.
+!
+!  Discussion:
+!
+!    This routine calculates the LOG(GAMMA) function for a positive real
+!    argument X.  Computation is based on an algorithm outlined in
+!    references 1 and 2.  The program uses rational functions that
+!    theoretically approximate LOG(GAMMA) to at least 18 significant
+!    decimal digits.  The approximation for X > 12 is from reference
+!    3, while approximations for X < 12.0 are similar to those in
+!    reference 1, but are unpublished.
+!
+!  Licensing:
+!
+!    This code is distributed under the GNU LGPL license.
+!
+!  Modified:
+!
+!    15 April 2013
+!
+!  Author:
+!
+!    Original FORTRAN77 version by William Cody, Laura Stoltz.
+!    FORTRAN90 version by John Burkardt.
+!
+!  Reference:
+!
+!    William Cody, Kenneth Hillstrom,
+!    Chebyshev Approximations for the Natural Logarithm of the
+!    Gamma Function,
+!    Mathematics of Computation,
+!    Volume 21, Number 98, April 1967, pages 198-203.
+!
+!    Kenneth Hillstrom,
+!    ANL/AMD Program ANLC366S, DGAMMA/DLGAMA,
+!    May 1969.
+!
+!    John Hart, Ward Cheney, Charles Lawson, Hans Maehly,
+!    Charles Mesztenyi, John Rice, Henry Thatcher,
+!    Christoph Witzgall,
+!    Computer Approximations,
+!    Wiley, 1968,
+!    LC: QA297.C64.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument of the function.
+!
+!    Output, real ( kind = 8 ) R8_GAMMA_LOG, the value of the function.
+!
+  implicit none
+
+  real ( kind = 8 ), dimension ( 7 ) :: c = (/ &
+    -1.910444077728D-03, &
+     8.4171387781295D-04, &
+    -5.952379913043012D-04, &
+     7.93650793500350248D-04, &
+    -2.777777777777681622553D-03, &
+     8.333333333333333331554247D-02, &
+     5.7083835261D-03 /)
+  real ( kind = 8 ) corr
+  real ( kind = 8 ) :: d1 = -5.772156649015328605195174D-01
+  real ( kind = 8 ) :: d2 = 4.227843350984671393993777D-01
+  real ( kind = 8 ) :: d4 = 1.791759469228055000094023D+00
+  real ( kind = 8 ), parameter :: frtbig = 2.25D+76
+  integer ( kind = 4 ) i
+  real ( kind = 8 ), dimension ( 8 ) :: p1 = (/ &
+    4.945235359296727046734888D+00, &
+    2.018112620856775083915565D+02, &
+    2.290838373831346393026739D+03, &
+    1.131967205903380828685045D+04, &
+    2.855724635671635335736389D+04, &
+    3.848496228443793359990269D+04, &
+    2.637748787624195437963534D+04, &
+    7.225813979700288197698961D+03 /)
+  real ( kind = 8 ), dimension ( 8 ) :: p2 = (/ &
+    4.974607845568932035012064D+00, &
+    5.424138599891070494101986D+02, &
+    1.550693864978364947665077D+04, &
+    1.847932904445632425417223D+05, &
+    1.088204769468828767498470D+06, &
+    3.338152967987029735917223D+06, &
+    5.106661678927352456275255D+06, &
+    3.074109054850539556250927D+06 /)
+  real ( kind = 8 ), dimension ( 8 ) :: p4 = (/ &
+    1.474502166059939948905062D+04, &
+    2.426813369486704502836312D+06, &
+    1.214755574045093227939592D+08, &
+    2.663432449630976949898078D+09, &
+    2.940378956634553899906876D+10, &
+    1.702665737765398868392998D+11, &
+    4.926125793377430887588120D+11, &
+    5.606251856223951465078242D+11 /)
+  real ( kind = 8 ), dimension ( 8 ) :: q1 = (/ &
+    6.748212550303777196073036D+01, &
+    1.113332393857199323513008D+03, &
+    7.738757056935398733233834D+03, &
+    2.763987074403340708898585D+04, &
+    5.499310206226157329794414D+04, &
+    6.161122180066002127833352D+04, &
+    3.635127591501940507276287D+04, &
+    8.785536302431013170870835D+03 /)
+  real ( kind = 8 ), dimension ( 8 ) :: q2 = (/ &
+    1.830328399370592604055942D+02, &
+    7.765049321445005871323047D+03, &
+    1.331903827966074194402448D+05, &
+    1.136705821321969608938755D+06, &
+    5.267964117437946917577538D+06, &
+    1.346701454311101692290052D+07, &
+    1.782736530353274213975932D+07, &
+    9.533095591844353613395747D+06 /)
+  real ( kind = 8 ), dimension ( 8 ) :: q4 = (/ &
+    2.690530175870899333379843D+03, &
+    6.393885654300092398984238D+05, &
+    4.135599930241388052042842D+07, &
+    1.120872109616147941376570D+09, &
+    1.488613728678813811542398D+10, &
+    1.016803586272438228077304D+11, &
+    3.417476345507377132798597D+11, &
+    4.463158187419713286462081D+11 /)
+  real ( kind = 8 ) r8_gamma_log
+  real ( kind = 8 ) res
+  real ( kind = 8 ), parameter :: sqrtpi = 0.9189385332046727417803297D+00
+  real ( kind = 8 ) x
+  real ( kind = 8 ), parameter :: xbig = 2.55D+305
+  real ( kind = 8 ) xden
+  real ( kind = 8 ), parameter :: xinf = 1.79D+308
+  real ( kind = 8 ) xm1
+  real ( kind = 8 ) xm2
+  real ( kind = 8 ) xm4
+  real ( kind = 8 ) xnum
+  real ( kind = 8 ) y
+  real ( kind = 8 ) ysq
+
+  y = x
+
+  if ( 0.0D+00 < y .and. y <= xbig ) then
+
+    if ( y <= epsilon ( y ) ) then
+
+      res = - log ( y )
+!
+!  EPS < X <= 1.5.
+!
+    else if ( y <= 1.5D+00 ) then
+
+      if ( y < 0.6796875D+00 ) then
+        corr = -log ( y )
+        xm1 = y
+      else
+        corr = 0.0D+00
+        xm1 = ( y - 0.5D+00 ) - 0.5D+00
+      end if
+
+      if ( y <= 0.5D+00 .or. 0.6796875D+00 <= y ) then
+
+        xden = 1.0D+00
+        xnum = 0.0D+00
+        do i = 1, 8
+          xnum = xnum * xm1 + p1(i)
+          xden = xden * xm1 + q1(i)
+        end do
+
+        res = corr + ( xm1 * ( d1 + xm1 * ( xnum / xden ) ) )
+
+      else
+
+        xm2 = ( y - 0.5D+00 ) - 0.5D+00
+        xden = 1.0D+00
+        xnum = 0.0D+00
+        do i = 1, 8
+          xnum = xnum * xm2 + p2(i)
+          xden = xden * xm2 + q2(i)
+        end do
+
+        res = corr + xm2 * ( d2 + xm2 * ( xnum / xden ) )
+
+      end if
+!
+!  1.5 < X <= 4.0.
+!
+    else if ( y <= 4.0D+00 ) then
+
+      xm2 = y - 2.0D+00
+      xden = 1.0D+00
+      xnum = 0.0D+00
+      do i = 1, 8
+        xnum = xnum * xm2 + p2(i)
+        xden = xden * xm2 + q2(i)
+      end do
+
+      res = xm2 * ( d2 + xm2 * ( xnum / xden ) )
+!
+!  4.0 < X <= 12.0.
+!
+    else if ( y <= 12.0D+00 ) then
+
+      xm4 = y - 4.0D+00
+      xden = -1.0D+00
+      xnum = 0.0D+00
+      do i = 1, 8
+        xnum = xnum * xm4 + p4(i)
+        xden = xden * xm4 + q4(i)
+      end do
+
+      res = d4 + xm4 * ( xnum / xden )
+!
+!  Evaluate for 12 <= argument.
+!
+    else
+
+      res = 0.0D+00
+
+      if ( y <= frtbig ) then
+
+        res = c(7)
+        ysq = y * y
+
+        do i = 1, 6
+          res = res / ysq + c(i)
+        end do
+
+      end if
+
+      res = res / y
+      corr = log ( y )
+      res = res + sqrtpi - 0.5D+00 * corr
+      res = res + y * ( corr - 1.0D+00 )
+
+    end if
+!
+!  Return for bad arguments.
+!
+  else
+
+    res = xinf
+
+  end if
+!
+!  Final adjustments and return.
+!
+  r8_gamma_log = res
+
+  return
+end
+subroutine rctj ( n, x, nm, rj, dj )
+
+!*****************************************************************************80
+!
+!! RCTJ computes Riccati-Bessel function of the first kind, and derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    18 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order of jn(x).
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, integer ( kind = 4 ) NM, the highest order computed.
+!
+!    Output, real ( kind = 8 ) RJ(0:N), the values of x jn(x).
+!
+!    Output, real ( kind = 8 ) DJ(0:N), the values of [x jn(x)]'.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) cs
+  real ( kind = 8 ) dj(0:n)
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) rj(0:n)
+  real ( kind = 8 ) rj0
+  real ( kind = 8 ) rj1
+  real ( kind = 8 ) x
+
+  nm = n
+
+  if ( abs ( x ) < 1.0D-100 ) then
+    do k = 0, n
+      rj(k) = 0.0D+00
+      dj(k) = 0.0D+00
+    end do
+    dj(0) = 1.0D+00
+    return
+  end if
+
+  rj(0) = sin ( x )
+  rj(1) = rj(0) / x - cos ( x )
+  rj0 = rj(0)
+  rj1 = rj(1)
+
+  if ( 2 <= n ) then
+
+    m = msta1 ( x, 200 )
+
+    if ( m < n ) then
+      nm = m
+    else
+      m = msta2 ( x, n, 15 )
+    end if
+
+    f0 = 0.0D+00
+    f1 = 1.0D-100
+    do k = m, 0, -1
+      f = ( 2.0D+00 * k + 3.0D+00 ) * f1 / x - f0
+      if ( k <= nm ) then
+        rj(k) = f
+      end if
+      f0 = f1
+      f1 = f
+    end do
+
+    if ( abs ( rj1 ) < abs ( rj0 ) ) then
+      cs = rj0 / f
+    else
+      cs = rj1 / f0
+    end if
+
+    do k = 0, nm
+      rj(k) = cs * rj(k)
+    end do
+
+  end if
+
+  dj(0) = cos ( x )
+  do k = 1, nm
+    dj(k) = - k * rj(k) / x + rj(k-1)
+  end do
+
+  return
+end
+subroutine rcty ( n, x, nm, ry, dy )
+
+!*****************************************************************************80
+!
+!! RCTY computes Riccati-Bessel function of the second kind, and derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    18 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order of yn(x).
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, integer ( kind = 4 ) NM, the highest order computed.
+!
+!    Output, real ( kind = 8 ) RY(0:N), the values of x yn(x).
+!
+!    Output, real ( kind = 8 ) DY(0:N), the values of [x yn(x)]'.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) dy(0:n)
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) rf0
+  real ( kind = 8 ) rf1
+  real ( kind = 8 ) rf2
+  real ( kind = 8 ) ry(0:n)
+  real ( kind = 8 ) x
+
+  nm = n
+
+  if ( x < 1.0D-60 ) then
+    do k = 0, n
+      ry(k) = -1.0D+300
+      dy(k) = 1.0D+300
+    end do
+    ry(0) = -1.0D+00
+    dy(0) = 0.0D+00
+    return
+  end if
+
+  ry(0) = - cos ( x )
+  ry(1) = ry(0) / x - sin ( x )
+  rf0 = ry(0)
+  rf1 = ry(1)
+  do k = 2, n
+    rf2 = ( 2.0D+00 * k - 1.0D+00 ) * rf1 / x - rf0
+    if ( 1.0D+300 < abs ( rf2 ) ) then
+      exit
+    end if
+    ry(k) = rf2
+    rf0 = rf1
+    rf1 = rf2
+  end do
+
+  nm = k - 1
+  dy(0) = sin ( x )
+  do k = 1, nm
+    dy(k) = - k * ry(k) / x + ry(k-1)
+  end do
+
+  return
+end
+subroutine refine ( kd, m, q, a, iflag )
+
+!*****************************************************************************80
+!
+!! REFINE refines an estimate of the characteristic value of Mathieu functions.
+!
+!  Discussion:
+!
+!    This procedure calculates the accurate characteristic value
+!    by the secant method.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    20 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) KD, the case code:
+!    1, for cem(x,q)  ( m = 0,2,4,...)
+!    2, for cem(x,q)  ( m = 1,3,5,...)
+!    3, for sem(x,q)  ( m = 1,3,5,...)
+!    4, for sem(x,q)  ( m = 2,4,6,...)
+!
+!    Input, integer ( kind = 4 ) M, the order of the Mathieu functions.
+!
+!    Input, real ( kind = 8 ) Q, the parameter of the Mathieu functions.
+!
+!    Input/output, real ( kind = 8 ) A, the characteristic value, which
+!    should have been refined on output.
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) ca
+  real ( kind = 8 ) delta
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  integer ( kind = 4 ) it
+  integer ( kind = 4 ) iflag
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) mj
+  real ( kind = 8 ) q
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x0
+  real ( kind = 8 ) x1
+
+  eps = 1.0D-14
+  mj = 10 + m
+  ca = a
+  delta = 0.0D+00
+  x0 = a
+  call cvf ( kd, m, q, x0, mj, f0 )
+  x1 = 1.002D+00 * a
+  call cvf ( kd, m, q, x1, mj, f1 )
+
+  do
+  
+    do it = 1, 100
+      mj = mj + 1
+      x = x1 - ( x1 - x0 ) / ( 1.0D+00 - f0 / f1 )
+      call cvf ( kd, m, q, x, mj, f )
+      if ( abs ( 1.0D+00 - x1 / x ) < eps .or. f == 0.0D+00 ) then
+        exit
+      end if
+      x0 = x1
+      f0 = f1
+      x1 = x
+      f1 = f
+    end do
+
+    a = x
+
+    if ( 0.05D+00 < delta ) then
+      a = ca
+      if ( iflag < 0 ) then
+        iflag = -10
+      end if
+      return
+    end if
+
+    if ( abs ( ( a - ca ) / ca )  <= 0.05D+00 ) then
+      exit
+    end if
+
+    x0 = ca
+    delta = delta + 0.005D+00
+    call cvf ( kd, m, q, x0, mj, f0 )
+    x1 = ( 1.0D+00 + delta ) * ca
+    call cvf ( kd, m, q, x1, mj, f1 )
+
+  end do
+
+  return
+end
+subroutine rmn1 ( m, n, c, x, df, kd, r1f, r1d )
+
+!*****************************************************************************80
+!
+!! RMN1 computes prolate and oblate spheroidal functions of the first kind.
+!
+!  Discussion:
+!
+!    This procedure computes prolate and oblate spheroidal radial
+!    functions of the first kind for given m, n, c and x.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    29 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
+!
+!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
+!
+!    Input, real ( kind = 8 ) C, spheroidal parameter.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Input, real ( kind = 8 ) DF(*), the expansion coefficients.
+!
+!    Input, integer ( kind = 4 ) KD, the function code.
+!    1, the prolate function.
+!    -1, the oblate function.
+!
+!    Output, real ( kind = 8 ) R1F, R1D, the function and derivative.
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) b0
+  real ( kind = 8 ) c
+  real ( kind = 8 ) ck(200)
+  real ( kind = 8 ) cx
+  real ( kind = 8 ) df(200)
+  real ( kind = 8 ) dj(0:251)
+  real ( kind = 8 ) eps
+  integer ( kind = 4 ) ip
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) lg
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  integer ( kind = 4 ) nm
+  integer ( kind = 4 ) nm1
+  integer ( kind = 4 ) nm2
+  integer ( kind = 4 ) np
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r0
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) r1d
+  real ( kind = 8 ) r1f
+  real ( kind = 8 ) r2
+  real ( kind = 8 ) r3
+  real ( kind = 8 ) reg
+  real ( kind = 8 ) sa0
+  real ( kind = 8 ) sj(0:251)
+  real ( kind = 8 ) suc
+  real ( kind = 8 ) sud
+  real ( kind = 8 ) sum
+  real ( kind = 8 ) sw
+  real ( kind = 8 ) sw1
+  real ( kind = 8 ) x
+
+  eps = 1.0D-14
+  nm1 = int ( ( n - m ) / 2 )
+  if ( n - m == 2 * nm1 ) then
+    ip = 0
+  else
+    ip = 1
+  end if
+  nm = 25 + nm1 + int ( c )
+  reg = 1.0D+00
+  if ( 80 < m + nm ) then
+    reg = 1.0D-200
+  end if
+  r0 = reg
+  do j = 1, 2 * m + ip
+    r0 = r0 * j
+  end do
+  r = r0    
+  suc = r * df(1)
+  do k = 2, nm
+    r = r * ( m + k - 1.0D+00 ) * ( m + k + ip - 1.5D+00 ) &
+      / ( k - 1.0D+00 ) / ( k + ip - 1.5D+00 )
+    suc = suc + r * df(k)
+
+    if ( nm1 < k .and. abs ( suc - sw ) < abs ( suc ) * eps ) then
+      exit
+    end if
+
+    sw = suc
+
+  end do
+
+  if ( x == 0.0D+00 ) then
+
+    call sckb ( m, n, c, df, ck )
+    sum = 0.0D+00
+    do j = 1, nm
+      sum = sum + ck(j)
+      if ( abs ( sum - sw1 ) < abs ( sum ) * eps ) then
+        exit
+      end if
+      sw1 = sum
+    end do
+
+    r1 = 1.0D+00
+    do j = 1, ( n + m + ip ) / 2
+      r1 = r1 * ( j + 0.5D+00 * ( n + m + ip ) )
+    end do
+
+    r2 = 1.0D+00
+    do j = 1, m
+      r2 = 2.0D+00 * c * r2 * j
+    end do
+
+    r3 = 1.0D+00
+    do j = 1, ( n - m - ip ) / 2
+      r3 = r3 * j
+    end do
+
+    sa0 = ( 2.0D+00 * ( m + ip ) + 1.0D+00 ) * r1 &
+      / ( 2.0D+00 ** n * c ** ip * r2 * r3 )
+
+    if ( ip == 0 ) then
+      r1f = sum / ( sa0 * suc ) * df(1) * reg
+      r1d = 0.0D+00
+    else if ( ip == 1 ) then
+      r1f = 0.0D+00
+      r1d = sum / ( sa0 * suc ) * df(1) * reg
+    end if
+
+    return
+
+  end if
+
+  cx = c * x
+  nm2 = 2 * nm + m
+  call sphj ( nm2, cx, nm2, sj, dj )
+  a0 = ( 1.0D+00 - kd / ( x * x ) ) ** ( 0.5D+00 * m ) / suc  
+  r1f = 0.0D+00
+  do k = 1, nm
+    l = 2 * k + m - n - 2 + ip
+    if ( l == 4 * int ( l / 4 ) ) then
+      lg = 1
+    else
+      lg = -1
+    end if
+    if ( k == 1 ) then
+      r = r0
+    else
+      r = r * ( m + k - 1.0D+00 ) * ( m + k + ip - 1.5D+00 ) &
+        / ( k - 1.0D+00 ) / ( k + ip - 1.5D+00 )
+    end if
+    np = m + 2 * k - 2 + ip
+    r1f = r1f + lg * r * df(k) * sj(np)
+    if ( nm1 < k .and. abs ( r1f - sw ) < abs ( r1f ) * eps ) then
+      exit
+    end if
+    sw = r1f
+  end do
+
+  r1f = r1f * a0
+  b0 = kd * m / x ** 3.0D+00 / ( 1.0D+00 - kd / ( x * x ) ) * r1f    
+  sud = 0.0D+00
+
+  do k = 1, nm
+
+    l = 2 * k + m - n - 2 + ip
+
+    if ( l == 4 * int ( l / 4 ) ) then
+      lg = 1
+    else
+      lg = -1
+    end if
+
+    if ( k == 1 ) then
+      r = r0
+    else
+      r = r * ( m + k - 1.0D+00 ) * ( m + k + ip - 1.5D+00 ) &
+        / ( k - 1.0D+00 ) / ( k + ip - 1.5D+00 )
+    end if
+
+    np = m + 2 * k - 2 + ip
+    sud = sud + lg * r * df(k) * dj(np)
+    if ( nm1 < k .and. abs ( sud - sw ) < abs ( sud ) * eps ) then
+      exit
+    end if
+    sw = sud
+  end do
+
+  r1d = b0 + a0 * c * sud
+
+  return
+end
+subroutine rmn2l ( m, n, c, x, df, kd, r2f, r2d, id )
+
+!*****************************************************************************80
+!
+!! RMN2L: prolate and oblate spheroidal functions, second kind, large CX.
+!
+!  Discussion:
+!
+!    This procedure computes prolate and oblate spheroidal radial functions 
+!    of the second kind for given m, n, c and a large cx.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    30 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
+!
+!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
+!
+!    Input, real ( kind = 8 ) C, spheroidal parameter.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Input, real ( kind = 8 ) DF(*), the expansion coefficients.
+!
+!    Input, integer ( kind = 4 ) KD, the function code.
+!    1, the prolate function.
+!    -1, the oblate function.
+!
+!    Output, real ( kind = 8 ) R2F, R2D, the function and derivative values.
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) b0
+  real ( kind = 8 ) c
+  real ( kind = 8 ) cx
+  real ( kind = 8 ) df(200)
+  real ( kind = 8 ) dy(0:251)
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) eps1
+  real ( kind = 8 ) eps2
+  integer ( kind = 4 ) id
+  integer ( kind = 4 ) id1
+  integer ( kind = 4 ) id2
+  integer ( kind = 4 ) ip
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) lg
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  integer ( kind = 4 ) nm
+  integer ( kind = 4 ) nm1
+  integer ( kind = 4 ) nm2
+  integer ( kind = 4 ) np
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r0
+  real ( kind = 8 ) r2d
+  real ( kind = 8 ) r2f
+  real ( kind = 8 ) reg
+  real ( kind = 8 ) sw
+  real ( kind = 8 ) suc
+  real ( kind = 8 ) sud
+  real ( kind = 8 ) sy(0:251)
+  real ( kind = 8 ) x
+
+  eps = 1.0D-14
+
+  nm1 = int ( ( n - m ) / 2 )
+
+  if ( n - m == 2 * nm1 ) then
+    ip = 0
+  else
+    ip = 1
+  end if
+  nm = 25 + nm1 + int ( c )
+
+  if ( 80 < m + nm ) then
+    reg = 1.0D-200
+  else
+    reg = 1.0D+00
+  end if
+  nm2 = 2 * nm + m
+  cx = c * x
+  call sphy ( nm2, cx, nm2, sy, dy )
+  r0 = reg
+  do j = 1, 2 * m + ip
+    r0 = r0 * j
+  end do
+  r = r0    
+  suc = r * df(1)
+  do k = 2, nm
+    r = r * ( m + k - 1.0D+00 ) * ( m + k + ip - 1.5D+00 ) &
+      / ( k - 1.0D+00 ) / ( k + ip - 1.5D+00 )
+    suc = suc + r * df(k)
+    if ( nm1 < k .and. abs ( suc - sw ) < abs ( suc ) * eps ) then
+      exit
+    end if
+    sw = suc
+  end do
+
+  a0 = ( 1.0D+00 - kd / ( x * x ) ) ** ( 0.5D+00 * m ) / suc
+  r2f = 0.0D+00
+  do k = 1, nm
+    l = 2 * k + m - n - 2 + ip
+    if ( l == 4 * int ( l / 4 ) ) then
+      lg = 1
+    else
+      lg = -1
+    end if
+
+    if ( k == 1 ) then
+      r = r0
+    else
+      r = r * ( m + k - 1.0D+00 ) * ( m + k + ip - 1.5D+00 ) &
+        / ( k - 1.0D+00 ) / ( k + ip - 1.5D+00 )
+    end if
+
+    np = m + 2 * k - 2 + ip
+    r2f = r2f + lg * r * ( df(k) * sy(np) )
+    eps1 = abs ( r2f - sw )
+    if ( nm1 < k .and. eps1 < abs ( r2f ) * eps ) then
+      exit
+    end if
+    sw = r2f
+  end do
+
+  id1 = int ( log10 ( eps1 / abs ( r2f ) + eps ) )
+  r2f = r2f * a0
+
+  if ( nm2 <= np ) then
+    id = 10
+    return
+  end if
+
+  b0 = kd * m / x ** 3.0D+00 / ( 1.0D+00 - kd / ( x * x ) ) * r2f
+  sud = 0.0D+00
+  do k = 1, nm
+    l = 2 * k + m - n - 2 + ip
+    if ( l == 4 * int ( l / 4 ) ) then
+      lg = 1
+    else
+      lg = -1
+    end if
+    if (k == 1) then
+      r = r0
+    else
+      r = r * ( m + k - 1.0D+00 ) * ( m + k + ip - 1.5D+00 ) &
+        / ( k - 1.0D+00 ) / ( k + ip - 1.5D+00 )
+    end if
+    np = m + 2 * k - 2 + ip
+    sud = sud + lg * r * ( df(k) * dy(np) )
+    eps2 = abs ( sud - sw )
+    if ( nm1 < k .and. eps2 < abs ( sud ) * eps ) then
+      exit
+    end if
+    sw = sud
+  end do
+
+  r2d = b0 + a0 * c * sud
+  id2 = int ( log10 ( eps2 / abs ( sud ) + eps ) )
+  id = max ( id1, id2 )
+
+  return
+end
+subroutine rmn2so ( m, n, c, x, cv, df, kd, r2f, r2d )
+
+!*****************************************************************************80
+!
+!! RMN2SO: oblate radial functions of the second kind with small argument.
+!
+!  Discussion:
+!
+!    This procedure computes oblate radial functions of the second kind
+!    with a small argument, Rmn(-ic,ix) and Rmn'(-ic,ix).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    27 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+! 
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
+!
+!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
+!
+!    Input, real ( kind = 8 ) C, spheroidal parameter.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Input, real ( kind = 8 ) CV, the characteristic value.
+!
+!    Input, real ( kind = 8 ) DF(*), the expansion coefficients.
+!
+!    Input, integer ( kind = 4 ) KD, the function code.
+!    1, the prolate function.
+!    -1, the oblate function.
+!
+!    Output, real ( kind = 8 ) R2F, R2D, the values of Rmn(-ic,ix) 
+!    and Rmn'(-ic,ix).
+!
+  implicit none
+
+  real ( kind = 8 ) bk(200)
+  real ( kind = 8 ) c
+  real ( kind = 8 ) ck(200)
+  real ( kind = 8 ) ck1
+  real ( kind = 8 ) ck2
+  real ( kind = 8 ) cv
+  real ( kind = 8 ) df(200)
+  real ( kind = 8 ) dn(200)
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) gd
+  real ( kind = 8 ) gf
+  real ( kind = 8 ) h0
+  integer ( kind = 4 ) ip
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) qs
+  real ( kind = 8 ) qt
+  real ( kind = 8 ) r1d
+  real ( kind = 8 ) r1f
+  real ( kind = 8 ) r2d
+  real ( kind = 8 ) r2f
+  real ( kind = 8 ) sum
+  real ( kind = 8 ) sw
+  real ( kind = 8 ) x
+
+  if ( abs ( df(1) ) <= 1.0D-280 ) then
+    r2f = 1.0D+300
+    r2d = 1.0D+300
+    return
+  end if
+
+  eps = 1.0D-14
+  pi = 3.141592653589793D+00
+  nm = 25 + int ( ( n - m ) / 2 + c )
+  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
+    ip = 0
+  else
+    ip = 1
+  end if
+
+  call sckb ( m, n, c, df, ck )
+  call kmn ( m, n, c, cv, kd, df, dn, ck1, ck2 )
+  call qstar ( m, n, c, ck, ck1, qs, qt )
+  call cbk ( m, n, c, cv, qt, ck, bk )
+
+  if ( x == 0.0D+00 ) then
+
+    sum = 0.0D+00
+    do j = 1, nm
+      sum = sum + ck(j)
+      if ( abs ( sum - sw ) < abs ( sum ) * eps ) then
+        exit
+      end if
+      sw = sum
+    end do
+
+    if ( ip == 0 ) then
+      r1f = sum / ck1
+      r2f = - 0.5D+00 * pi * qs * r1f
+      r2d = qs * r1f + bk(1)
+    else if ( ip == 1 ) then
+       r1d = sum / ck1
+       r2f = bk(1)
+       r2d = -0.5D+00 * pi * qs * r1d
+    end if
+
+    return
+
+  else
+
+    call gmn ( m, n, c, x, bk, gf, gd )
+    call rmn1 ( m, n, c, x, df, kd, r1f, r1d )
+    h0 = atan ( x ) - 0.5D+00 * pi
+    r2f = qs * r1f * h0 + gf
+    r2d = qs * ( r1d * h0 + r1f / ( 1.0D+00 + x * x ) ) + gd
+
+  end if
+
+  return
+end
+subroutine rmn2sp ( m, n, c, x, cv, df, kd, r2f, r2d )
+
+!*****************************************************************************80
+!
+!! RMN2SP: prolate, oblate spheroidal radial functions, kind 2, small argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    28 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
+!
+!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
+!
+!    Input, real ( kind = 8 ) C, spheroidal parameter.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Input, real ( kind = 8 ) CV, the characteristic value.
+!
+!    Input, real ( kind = 8 ) DF(*), the expansion coefficients.
+!
+!    Input, integer ( kind = 4 ) KD, the function code.
+!    1, the prolate function.
+!    -1, the oblate function.
+!
+!    Output, real ( kind = 8 ) R2F, R2D, the values of the function and 
+!    its derivative.
+!
+  implicit none
+
+  real ( kind = 8 ) c
+  real ( kind = 8 ) ck1
+  real ( kind = 8 ) ck2
+  real ( kind = 8 ) cv
+  real ( kind = 8 ) df(200)
+  real ( kind = 8 ) dn(200)
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) ga
+  real ( kind = 8 ) gb
+  real ( kind = 8 ) gc
+  integer ( kind = 4 ) ip
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) j1
+  integer ( kind = 4 ) j2
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) ki
+  integer ( kind = 4 ) l1
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  integer ( kind = 4 ) nm
+  integer ( kind = 4 ) nm1
+  integer ( kind = 4 ) nm2
+  integer ( kind = 4 ) nm3
+  real ( kind = 8 ) pd(0:251)
+  real ( kind = 8 ) pm(0:251)
+  real ( kind = 8 ) qd(0:251)
+  real ( kind = 8 ) qm(0:251)
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) r2
+  real ( kind = 8 ) r2d
+  real ( kind = 8 ) r2f
+  real ( kind = 8 ) r3
+  real ( kind = 8 ) r4
+  real ( kind = 8 ) sd
+  real ( kind = 8 ) sd0
+  real ( kind = 8 ) sd1
+  real ( kind = 8 ) sd2
+  real ( kind = 8 ) sdm
+  real ( kind = 8 ) sf
+  real ( kind = 8 ) spd1
+  real ( kind = 8 ) spd2
+  real ( kind = 8 ) spl
+  real ( kind = 8 ) su0
+  real ( kind = 8 ) su1
+  real ( kind = 8 ) su2
+  real ( kind = 8 ) sum
+  real ( kind = 8 ) sw
+  real ( kind = 8 ) x
+
+  if ( abs ( df(1) ) < 1.0D-280 ) then
+    r2f = 1.0D+300
+    r2d = 1.0D+300
+    return
+  end if
+
+  eps = 1.0D-14
+
+  nm1 = int ( ( n - m ) / 2 )
+
+  if ( n - m == 2 * nm1 ) then
+    ip = 0
+  else
+    ip = 1
+  end if
+
+  nm = 25 + nm1 + int ( c )
+  nm2 = 2 * nm + m
+  call kmn ( m, n, c, cv, kd, df, dn, ck1, ck2 )
+  call lpmns ( m, nm2, x, pm, pd )
+  call lqmns ( m, nm2, x, qm, qd )
+
+  su0 = 0.0D+00
+  do k = 1, nm
+    j = 2 * k - 2 + m + ip
+    su0 = su0 + df(k) * qm(j)
+    if ( nm1 < k .and. abs ( su0 - sw ) < abs ( su0 ) * eps ) then
+      exit                                                               
+    end if
+    sw = su0
+  end do
+
+  sd0 = 0.0D+00
+
+  do k = 1, nm
+    j = 2 * k - 2 + m + ip
+    sd0 = sd0 + df(k) * qd(j)
+    if ( nm1 < k .and. abs ( sd0 - sw ) < abs ( sd0 ) * eps ) then
+      exit
+    end if
+    sw = sd0
+  end do
+
+  su1 = 0.0D+00
+  sd1 = 0.0D+00
+  do k = 1, m
+    j = m - 2 * k + ip
+    if ( j < 0 ) then
+      j = - j - 1
+    end if
+    su1 = su1 + dn(k) * qm(j)
+    sd1 = sd1 + dn(k) * qd(j)
+  end do
+
+  ga = ( ( x - 1.0D+00 ) / ( x + 1.0D+00 ) ) ** ( 0.5D+00 * m )
+
+  do k = 1, m
+
+    j = m - 2 * k + ip
+
+    if ( 0 <= j ) then
+      cycle
+    end if
+
+    if ( j < 0 ) then
+      j = - j - 1
+    end if 
+    r1 = 1.0D+00
+    do j1 = 1, j
+      r1 = ( m + j1 ) * r1
+    end do
+    r2 = 1.0D+00
+    do j2 = 1, m - j - 2
+      r2 = j2 * r2
+    end do
+    r3 = 1.0D+00
+    sf = 1.0D+00
+    do l1 = 1, j
+      r3 = 0.5D+00 * r3 * ( - j + l1 - 1.0D+00 ) * ( j + l1 ) &
+        / ( ( m + l1 ) * l1 ) * ( 1.0D+00 - x )
+      sf = sf + r3
+    end do
+
+    if ( m - j <= 1 ) then
+      gb = 1.0D+00
+    else
+      gb = ( m - j - 1.0D+00 ) * r2
+    end if
+
+    spl = r1 * ga * gb * sf
+    su1 = su1 + ( -1 ) ** ( j + m ) * dn(k) * spl
+    spd1 = m / ( x * x - 1.0D+00 ) * spl
+    gc = 0.5D+00 * j * ( j + 1.0 ) / ( m + 1.0D+00 )
+    sd = 1.0D+00
+    r4 = 1.0D+00
+    do l1 = 1, j - 1
+      r4 = 0.5D+00 * r4 * ( - j + l1 ) * ( j + l1 + 1.0D+00 ) &
+        / ( ( m + l1 + 1.0D+00 ) * l1 ) * ( 1.0D+00 - x )
+      sd = sd + r4
+    end do
+
+    spd2 = r1 * ga * gb * gc * sd
+    sd1 = sd1 + ( - 1 ) ** ( j + m ) * dn(k) * ( spd1 + spd2 )
+
+  end do
+
+  su2 = 0.0D+00
+  ki = ( 2 * m + 1 + ip ) / 2
+  nm3 = nm + ki
+  do k = ki, nm3
+    j = 2 * k - 1 - m - ip
+    su2 = su2 + dn(k) * pm(j)
+    if ( m < j .and. &
+      abs ( su2 - sw ) < abs ( su2 ) * eps ) then
+      exit
+    end if
+    sw = su2
+  end do
+
+  sd2 = 0.0D+00
+
+  do k = ki, nm3
+    j = 2 * k - 1 - m - ip
+    sd2 = sd2 + dn(k) * pd(j)
+    if ( m < j .and. &
+      abs ( sd2 - sw ) < abs ( sd2 ) * eps ) then
+      exit
+    end if
+    sw = sd2
+  end do
+
+  sum = su0 + su1 + su2
+  sdm = sd0 + sd1 + sd2
+  r2f = sum / ck2
+  r2d = sdm / ck2
+
+  return
+end
+subroutine rswfo ( m, n, c, x, cv, kf, r1f, r1d, r2f, r2d )
+
+!*****************************************************************************80
+!
+!! RSWFO computes prolate spheroidal radial function of first and second kinds.
+!
+!  Discussion:
+!
+!    This procedure computes oblate radial functions of the first
+!    and second kinds, and their derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    07 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+! 
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
+!
+!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
+!
+!    Input, real ( kind = 8 ) C, spheroidal parameter.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Input, real ( kind = 8 ) CV, the characteristic value.
+!
+!    Input, integer ( kind = 4 ) KF, the function code.
+!    1, for the first kind
+!    2, for the second kind
+!    3, for both the first and second kinds.
+!
+!    Output, real ( kind = 8 ) R1F, the radial function of the first kind;
+!
+!    Output, real ( kind = 8 ) R1D, the derivative of the radial function of
+!    the first kind;
+!
+!    Output, real ( kind = 8 ) R2F, the radial function of the second kind;
+!
+!    Output, real ( kind = 8 ) R2D, the derivative of the radial function of
+!    the second kind;
+!
+  implicit none
+
+  real ( kind = 8 ) c
+  real ( kind = 8 ) cv
+  real ( kind = 8 ) df(200)
+  integer ( kind = 4 ) id
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) kf
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) r1d
+  real ( kind = 8 ) r1f
+  real ( kind = 8 ) r2d
+  real ( kind = 8 ) r2f
+  real ( kind = 8 ) x
+
+  kd = -1
+  call sdmn ( m, n, c, cv, kd, df )
+
+  if ( kf /= 2 ) then
+    call rmn1 ( m, n, c, x, df, kd, r1f, r1d )
+  end if
+
+  if ( 1 < kf ) then
+    id = 10
+    if ( 1.0D-08 < x ) then
+      call rmn2l ( m, n, c, x, df, kd, r2f, r2d, id )
+    end if
+    if ( -1 < id ) then
+      call rmn2so ( m, n, c, x, cv, df, kd, r2f, r2d )
+    end if
+  end if
+
+  return
+end
+subroutine rswfp ( m, n, c, x, cv, kf, r1f, r1d, r2f, r2d )
+
+!*****************************************************************************80
+!
+!! RSWFP computes prolate spheroidal radial function of first and second kinds.
+!
+!  Discussion:
+!
+!    This procedure computes prolate spheriodal radial functions of the
+!    first and second kinds, and their derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    07 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
+!
+!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
+!
+!    Input, real ( kind = 8 ) C, spheroidal parameter.
+!
+!    Input, real ( kind = 8 ) X, the argument of the radial function, 1 < X.
+!
+!    Input, real ( kind = 8 ) CV, the characteristic value.
+!
+!    Input, integer ( kind = 4 ) KF, the function code.
+!    1, for the first kind
+!    2, for the second kind
+!    3, for both the first and second kinds.
+!
+!    Output, real ( kind = 8 ) R1F, the radial function of the first kind;
+!
+!    Output, real ( kind = 8 ) R1D, the derivative of the radial function of
+!    the first kind;
+!
+!    Output, real ( kind = 8 ) R2F, the radial function of the second kind;
+!
+!    Output, real ( kind = 8 ) R2D, the derivative of the radial function of
+!    the second kind;
+!
+  implicit none
+
+  real ( kind = 8 ) c
+  real ( kind = 8 ) cv
+  real ( kind = 8 ) df(200)
+  integer ( kind = 4 ) id
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) kf
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) r1d
+  real ( kind = 8 ) r1f
+  real ( kind = 8 ) r2d
+  real ( kind = 8 ) r2f
+  real ( kind = 8 ) x
+
+  kd = 1
+  call sdmn ( m, n, c, cv, kd, df )
+
+  if ( kf /= 2 ) then
+    call rmn1 ( m, n, c, x, df, kd, r1f, r1d )
+  end if
+
+  if ( 1 < kf ) then
+    call rmn2l ( m, n, c, x, df, kd, r2f, r2d, id )
+    if ( -8 < id ) then
+      call rmn2sp ( m, n, c, x, cv, df, kd, r2f, r2d )
+    end if
+  end if
+
+  return
+end
+subroutine scka ( m, n, c, cv, kd, ck )
+
+!*****************************************************************************80
+!
+!! SCKA: expansion coefficients for prolate and oblate spheroidal functions.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    22 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the mode parameter.
+!
+!    Input, integer ( kind = 4 ) N, the mode parameter.
+!
+!    Input, real ( kind = 8 ) C, the spheroidal parameter.
+!
+!    Input, real ( kind = 8 ) CV, the characteristic value.
+!
+!    Input, integer ( kind = 4 ) KD, the function code.
+!    1, the prolate function.
+!    -1, the oblate function.
+!
+!    Output, real ( kind = 8 ) CK(*), the expansion coefficients.
+!    CK(1), CK(2),... correspond to c0, c2,..., and so on.
+!       
+  implicit none
+
+  real ( kind = 8 ) c
+  real ( kind = 8 ) ck(200)
+  real ( kind = 8 ) cs
+  real ( kind = 8 ) cv
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) f2
+  real ( kind = 8 ) fl
+  real ( kind = 8 ) fs
+  integer ( kind = 4 ) ip
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k1
+  integer ( kind = 4 ) kb
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) r2
+  real ( kind = 8 ) s0
+  real ( kind = 8 ) su1
+  real ( kind = 8 ) su2
+
+  if ( c <= 1.0D-10 ) then
+    c = 1.0D-10
+  end if
+
+  nm = 25 + int ( ( n - m ) / 2 + c )
+  cs = c * c * kd
+
+  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
+    ip = 0
+  else
+    ip = 1
+  end if
+
+  fs = 1.0D+00
+  f1 = 0.0D+00
+  f0 = 1.0D-100
+  kb = 0
+  ck(nm+1) = 0.0D+00
+
+  do k = nm, 1, -1
+
+    f = ((( 2.0D+00 * k + m + ip ) &
+      * ( 2.0D+00 * k + m + 1.0D+00 + ip ) - cv + cs ) * f0 &
+      - 4.0D+00 * ( k + 1.0D+00 ) * ( k + m + 1.0D+00 ) * f1 ) / cs
+
+    if ( abs ( ck(k+1) ) < abs ( f ) ) then
+
+      ck(k) = f
+      f1 = f0
+      f0 = f
+
+      if ( 1.0D+100 < abs ( f ) ) then
+        do k1 = nm, k, -1
+          ck(k1) = ck(k1) * 1.0D-100
+        end do
+        f1 = f1 * 1.0D-100
+        f0 = f0 * 1.0D-100
+      end if
+
+    else
+
+      kb = k
+      fl = ck(k+1)
+      f1 = 1.0D+00
+      f2 = 0.25D+00 * ( ( m + ip ) * ( m + ip + 1.0D+00 ) &
+        - cv + cs ) / ( m + 1.0D+00 ) * f1
+      ck(1) = f1
+
+      if ( kb == 1 ) then
+        fs = f2
+      else if (kb == 2 ) then
+        ck(2) = f2
+        fs = 0.125D+00 * ( ( ( m + ip + 2.0D+00 ) &
+          * ( m + ip + 3.0D+00 ) - cv + cs ) * f2 &
+          - cs * f1 ) / ( m + 2.0D+00 )
+      else
+        ck(2) = f2
+        do j = 3, kb + 1
+          f = 0.25D+00 * ( ( ( 2.0D+00 * j + m + ip - 4.0D+00 ) &
+            * ( 2.0D+00 * j + m + ip - 3.0D+00 ) - cv + cs ) * f2 &
+            - cs * f1 ) / ( ( j - 1.0D+00 ) * ( j + m - 1.0D+00 ) )
+          if ( j <= kb ) then
+            ck(j) = f
+          end if
+          f1 = f2
+          f2 = f
+        end do
+        fs = f
+      end if
+
+      exit
+
+    end if
+
+  end do
+
+  su1 = 0.0D+00
+  do k = 1, kb
+    su1 = su1 + ck(k)
+  end do
+
+  su2 = 0.0D+00
+  do k = kb + 1, nm
+    su2 = su2 + ck(k)
+  end do
+
+  r1 = 1.0D+00
+  do j = 1, ( n + m + ip ) / 2
+    r1 = r1 * ( j + 0.5D+00 * ( n + m + ip ) )
+  end do
+
+  r2 = 1.0D+00
+  do j = 1, ( n - m - ip ) / 2
+    r2 = - r2 * j
+  end do
+
+  if ( kb == 0 ) then
+    s0 = r1 / ( 2.0D+00 ** n * r2 * su2 )
+  else
+    s0 = r1 / ( 2.0D+00 ** n * r2 * ( fl / fs * su1 + su2 ) )
+  end if
+
+  do k = 1, kb
+    ck(k) = fl / fs * s0 * ck(k)
+  end do
+
+  do k = kb + 1, nm
+    ck(k) = s0 * ck(k)
+  end do
+
+  return
+end
+subroutine sckb ( m, n, c, df, ck )
+
+!*****************************************************************************80
+!
+!! SCKB: expansion coefficients for prolate and oblate spheroidal functions.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    15 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the mode parameter.
+!
+!    Input, integer ( kind = 4 ) N, the mode parameter.
+!
+!    Input, real ( kind = 8 ) C, the spheroidal parameter.
+!
+!    Input, real ( kind = 8 ) DF(*), the expansion coefficients DK.
+!
+!    Output, real ( kind = 8 ) CK(*), the expansion coefficients CK.
+!
+  implicit none
+
+  real ( kind = 8 ) c
+  real ( kind = 8 ) ck(200)
+  real ( kind = 8 ) d1
+  real ( kind = 8 ) d2
+  real ( kind = 8 ) d3
+  real ( kind = 8 ) df(200)
+  real ( kind = 8 ) fac
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) i1
+  integer ( kind = 4 ) i2
+  integer ( kind = 4 ) ip
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) reg
+  real ( kind = 8 ) sum
+  real ( kind = 8 ) sw
+
+  c = max ( c, 1.0D-10 )
+
+  nm = 25 + int ( 0.5D+00 * ( n - m ) + c )
+ 
+  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
+    ip = 0
+  else
+    ip = 1
+  end if
+
+  if ( 80 < m + nm ) then
+    reg = 1.0D-200
+  else
+    reg = 1.0D+00
+  end if
+
+  fac = - 0.5D+00 ** m
+
+  do k = 0, nm - 1
+
+    fac = - fac
+    i1 = 2 * k + ip + 1
+    r = reg
+    do i = i1, i1 + 2 * m - 1
+      r = r * i
+    end do 
+
+    i2 = k + m + ip
+    do i = i2, i2 + k - 1
+      r = r * ( i + 0.5D+00 )
+    end do
+
+    sum = r * df(k+1)
+    do i = k + 1, nm
+      d1 = 2.0D+00 * i + ip
+      d2 = 2.0D+00 * m + d1
+      d3 = i + m + ip - 0.5D+00
+      r = r * d2 * ( d2 - 1.0D+00 ) * i * ( d3 + k ) &
+        / ( d1 * ( d1 - 1.0D+00 ) * ( i - k ) * d3 )
+      sum = sum + r * df(i+1)
+      if ( abs ( sw - sum ) < abs ( sum ) * 1.0D-14 ) then
+        exit
+      end if
+      sw = sum
+    end do
+
+    r1 = reg
+    do i = 2, m + k
+      r1 = r1 * i
+    end do
+
+    ck(k+1) = fac * sum / r1
+
+  end do
+
+  return
+end
+subroutine sdmn ( m, n, c, cv, kd, df )
+
+!*****************************************************************************80
+!
+!! SDMN: expansion coefficients for prolate and oblate spheroidal functions.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    29 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the mode parameter.
+!
+!    Input, integer ( kind = 4 ) N, the mode parameter.
+!
+!    Input, real ( kind = 8 ) C, the spheroidal parameter.
+!
+!    Input, real ( kind = 8 ) CV, the characteristic value.
+!
+!    Input, integer ( kind = 4 ) KD, the function code.
+!    1, the prolate function.
+!    -1, the oblate function.
+!
+!    Output, real ( kind = 8 ) DF(*), expansion coefficients;
+!    DF(1), DF(2), ... correspond to d0, d2, ... for even n-m and d1,
+!    d3, ... for odd n-m
+!
+  implicit none
+
+  real ( kind = 8 ) a(200)
+  real ( kind = 8 ) c
+  real ( kind = 8 ) cs
+  real ( kind = 8 ) cv
+  real ( kind = 8 ) d(200)
+  real ( kind = 8 ) d2k
+  real ( kind = 8 ) df(200)
+  real ( kind = 8 ) dk0
+  real ( kind = 8 ) dk1
+  real ( kind = 8 ) dk2
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) f2
+  real ( kind = 8 ) fl
+  real ( kind = 8 ) fs
+  real ( kind = 8 ) g(200)
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) ip
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k1
+  integer ( kind = 4 ) kb
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) r3
+  real ( kind = 8 ) r4
+  real ( kind = 8 ) s0
+  real ( kind = 8 ) su1
+  real ( kind = 8 ) su2
+  real ( kind = 8 ) sw
+
+  nm = 25 + int ( 0.5D+00 * ( n - m ) + c )
+
+  if ( c < 1.0D-10 ) then
+     do i = 1, nm
+       df(i) = 0D+00
+     end do
+     df((n-m)/2+1) = 1.0D+00
+     return
+  end if   
+
+  cs = c * c * kd
+
+  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
+    ip = 0
+  else
+    ip = 1
+  end if
+
+  do i = 1, nm + 2
+    if ( ip == 0 ) then
+      k = 2 * ( i - 1 )
+    else
+      k = 2 * i - 1
+    end if
+    dk0 = m + k
+    dk1 = m + k + 1
+    dk2 = 2 * ( m + k )
+    d2k = 2 * m + k
+    a(i) = ( d2k + 2.0D+00 ) * ( d2k + 1.0D+00 ) &
+      / ( ( dk2 + 3.0D+00 ) * ( dk2 + 5.0D+00 ) ) * cs
+    d(i) = dk0 * dk1 &
+      + ( 2.0D+00 * dk0 * dk1 - 2.0D+00 * m * m - 1.0D+00 ) &
+      / ( ( dk2 - 1.0D+00 ) * ( dk2 + 3.0D+00 ) ) * cs
+    g(i) = k * ( k - 1.0D+00 ) / ( ( dk2 - 3.0D+00 ) &
+      * ( dk2 - 1.0D+00 ) ) * cs
+  end do
+
+  fs = 1.0D+00
+  f1 = 0.0D+00
+  f0 = 1.0D-100
+  kb = 0
+  df(nm+1) = 0.0D+00
+
+  do k = nm, 1, -1
+
+    f = - ( ( d(k+1) - cv ) * f0 + a(k+1) * f1 ) / g(k+1)
+
+    if ( abs ( df(k+1) ) < abs ( f ) ) then
+
+      df(k) = f
+      f1 = f0
+      f0 = f
+      if ( 1.0D+100 < abs ( f ) ) then
+        do k1 = k, nm
+          df(k1) = df(k1) * 1.0D-100
+        end do
+        f1 = f1 * 1.0D-100
+        f0 = f0 * 1.0D-100
+      end if  
+
+    else
+
+      kb = k
+      fl = df(k+1)
+      f1 = 1.0D-100
+      f2 = - ( d(1) - cv ) / a(1) * f1
+      df(1) = f1
+
+      if ( kb == 1 ) then
+
+        fs = f2
+
+      else if ( kb == 2 ) then
+
+        df(2) = f2
+        fs = - ( ( d(2) - cv ) * f2 + g(2) * f1 ) / a(2)
+
+      else 
+
+        df(2) = f2
+        do j = 3, kb + 1
+          f = - ( ( d(j-1) - cv ) * f2 + g(j-1) * f1 ) / a(j-1)
+          if ( j <= kb ) then
+            df(j) = f
+          end if
+          if ( 1.0D+100 < abs ( f ) ) then
+            do k1 = 1, j
+              df(k1) = df(k1) * 1.0D-100
+            end do
+            f = f * 1.0D-100
+            f2 = f2 * 1.0D-100
+          end if  
+          f1 = f2
+          f2 = f
+        end do
+        fs = f
+
+      end if
+
+      exit
+
+    end if
+
+  end do
+
+  su1 = 0.0D+00
+
+  r1 = 1.0D+00
+  do j = m + ip + 1, 2 * ( m + ip )
+    r1 = r1 * j
+  end do
+
+  su1 = df(1) * r1
+  do k = 2, kb
+    r1 = - r1 * ( k + m + ip - 1.5D+00 ) / ( k - 1.0D+00 )
+    su1 = su1 + r1 * df(k)
+  end do
+
+  su2 = 0.0D+00
+  do k = kb + 1, nm
+    if ( k /= 1 ) then
+      r1 = - r1 * ( k + m + ip - 1.5D+00 ) / ( k - 1.0D+00 )
+    end if
+    su2 = su2 + r1 * df(k)
+    if ( abs ( sw - su2 ) < abs ( su2 ) * 1.0D-14 ) then
+      exit
+    end if
+    sw = su2
+  end do
+
+  r3 = 1.0D+00
+  do j = 1, ( m + n + ip ) / 2
+    r3 = r3 * ( j + 0.5D+00 * ( n + m + ip ) )
+  end do
+
+  r4 = 1.0D+00
+  do j = 1, ( n - m - ip ) / 2
+    r4 = -4.0D+00 * r4 * j
+  end do
+
+  s0 = r3 / ( fl * ( su1 / fs ) + su2 ) / r4
+  do k = 1, kb
+    df(k) = fl / fs * s0 * df(k)
+  end do
+
+  do k = kb + 1, nm
+    df(k) = s0 * df(k)
+  end do
+
+  return
+end
+subroutine segv ( m, n, c, kd, cv, eg )
+
+!*****************************************************************************80
+!
+!! SEGV computes the characteristic values of spheroidal wave functions.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    28 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) M, the mode parameter.
+!
+!    Input, integer ( kind = 4 ) N, the mode parameter.
+!
+!    Input, real ( kind = 8 ) C, the spheroidal parameter.
+!
+!    Input, integer ( kind = 4 ) KD, the function code.
+!    1, the prolate function.
+!    -1, the oblate function.
+!
+!    Output, real ( kind = 8 ) CV, the characteristic value.
+!
+!    Output, real ( kind = 8 ) EG(*), the characteristic value for 
+!    mode parameters m and n.  ( L = n - m + 1 )
+!
+  implicit none
+
+  real ( kind = 8 ) a(300)
+  real ( kind = 8 ) b(100)
+  real ( kind = 8 ) c
+  real ( kind = 8 ) cs
+  real ( kind = 8 ) cv
+  real ( kind = 8 ) cv0(100)
+  real ( kind = 8 ) d(300)
+  real ( kind = 8 ) d2k
+  real ( kind = 8 ) dk0
+  real ( kind = 8 ) dk1
+  real ( kind = 8 ) dk2
+  real ( kind = 8 ) e(300)
+  real ( kind = 8 ) eg(200)
+  real ( kind = 8 ) f(300)
+  real ( kind = 8 ) g(300)
+  real ( kind = 8 ) h(100)
+  integer ( kind = 4 ) i
+  integer ( kind = 4 ) icm
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k1
+  integer ( kind = 4 ) kd
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) n
+  integer ( kind = 4 ) nm
+  integer ( kind = 4 ) nm1
+  real ( kind = 8 ) s
+  real ( kind = 8 ) t
+  real ( kind = 8 ) t1
+  real ( kind = 8 ) x1
+  real ( kind = 8 ) xa
+  real ( kind = 8 ) xb
+
+  if ( c < 1.0D-10 ) then
+    do i = 1, n
+      eg(i) = ( i + m ) * ( i + m - 1.0D+00 )
+    end do
+    cv = eg(n-m+1)
+    return
+  end if
+
+  icm = ( n - m + 2 ) / 2
+  nm = 10 + int ( 0.5D+00 * ( n - m ) + c )
+  cs = c * c * kd
+
+  do l = 0, 1
+
+    do i = 1, nm
+      if ( l == 0 ) then
+        k = 2 * ( i - 1 )
+      else
+        k = 2 * i - 1
+      end if
+      dk0 = m + k
+      dk1 = m + k + 1
+      dk2 = 2 * ( m + k )
+      d2k = 2 * m + k
+      a(i) = ( d2k + 2.0D+00 ) * ( d2k + 1.0D+00 ) &
+        / ( ( dk2 + 3.0D+00 ) * ( dk2 + 5.0D+00 ) ) * cs
+      d(i) = dk0 * dk1 + ( 2.0D+00 * dk0 * dk1 &
+        - 2.0 * m * m - 1.0D+00 ) &
+        / ( ( dk2 - 1.0D+00 ) * ( dk2 + 3.0D+00 ) ) * cs
+      g(i) = k * ( k - 1.0D+00 ) / ( ( dk2 - 3.0D+00 ) &
+        * ( dk2 - 1.0D+00 ) ) * cs
+    end do
+
+    do k = 2, nm
+      e(k) = sqrt ( a(k-1) * g(k) )
+      f(k) = e(k) * e(k)
+    end do
+
+    f(1) = 0.0D+00
+    e(1) = 0.0D+00
+    xa = d(nm) + abs ( e(nm) )
+    xb = d(nm) - abs ( e(nm) )
+    nm1 = nm - 1
+    do i = 1, nm1
+      t = abs ( e(i) ) + abs ( e(i+1) )
+      t1 = d(i) + t
+      if ( xa < t1 ) then
+        xa = t1
+      end if
+      t1 = d(i) - t
+      if ( t1 < xb ) then
+        xb = t1
+      end if
+    end do
+
+    do i = 1, icm
+      b(i) = xa
+      h(i) = xb
+    end do
+
+    do k = 1, icm
+
+      do k1 = k, icm
+        if ( b(k1) < b(k) ) then
+          b(k) = b(k1)
+          exit
+        end if
+      end do
+
+      if ( k /= 1 .and. h(k) < h(k-1) ) then
+        h(k) = h(k-1)
+      end if
+
+      do
+
+        x1 = ( b(k) + h(k) ) /2.0D+00
+        cv0(k) = x1
+
+        if ( abs ( ( b(k) - h(k) ) / x1 ) < 1.0D-14 ) then
+          exit
+        end if
+
+        j = 0
+        s = 1.0D+00
+
+        do i = 1, nm
+
+          if ( s == 0.0D+00 ) then
+            s = s + 1.0D-30
+          end if
+          t = f(i) / s
+          s = d(i) - t - x1
+          if ( s < 0.0D+00 ) then
+            j = j + 1
+          end if
+        end do
+ 
+        if ( j < k ) then
+
+          h(k) = x1
+
+        else
+
+          b(k) = x1
+          if ( icm <= j ) then
+            b(icm) = x1
+          else
+            if ( h(j+1) < x1 ) then
+              h(j+1) = x1
+            end if
+            if ( x1 < b(j) ) then
+              b(j) = x1
+            end if
+          end if
+
+        end if
+
+      end do
+
+      cv0(k) = x1
+
+      if ( l == 0 ) then
+        eg(2*k-1) = cv0(k)
+      else
+        eg(2*k) = cv0(k)
+      end if
+
+    end do
+
+  end do
+
+  cv = eg(n-m+1)
+
+  return
+end
+subroutine sphi ( n, x, nm, si, di )
+
+!*****************************************************************************80
+!
+!! SPHI computes spherical Bessel functions in(x) and their derivatives in'(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    18 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order of In(X).
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, integer ( kind = 4 ) NM, the highest order computed.
+!
+!    Output, real ( kind = 8 ) SI(0:N), DI(0:N), the values and derivatives
+!    of the function of orders 0 through N.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) cs
+  real ( kind = 8 ) di(0:n)
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) si(0:n)
+  real ( kind = 8 ) si0
+  real ( kind = 8 ) x
+
+  nm = n
+
+  if ( abs ( x ) < 1.0D-100 ) then
+    do k = 0, n
+      si(k) = 0.0D+00
+      di(k) = 0.0D+00
+    end do
+    si(0) = 1.0D+00
+    di(1) = 0.333333333333333D+00
+    return
+  end if
+
+  si(0) = sinh ( x ) / x
+  si(1) = -( sinh ( x ) / x - cosh ( x ) ) / x
+  si0 = si(0)
+
+  if ( 2 <= n ) then
+
+    m = msta1 ( x, 200 )
+    if ( m < n ) then
+      nm = m
+    else
+      m = msta2 ( x, n, 15 )
+    end if
+    f0 = 0.0D+00
+    f1 = 1.0D+00-100
+    do k = m, 0, -1
+      f = ( 2.0D+00 * k + 3.0D+00 ) * f1 / x + f0
+      if ( k <= nm ) then
+        si(k) = f
+      end if
+      f0 = f1
+      f1 = f
+    end do
+    cs = si0 / f
+    do k = 0, nm
+      si(k) = cs * si(k)
+    end do
+
+  end if
+
+  di(0) = si(1)
+  do k = 1, nm
+    di(k) = si(k-1) - ( k + 1.0D+00 ) / x * si(k)
+  end do
+
+  return
+end
+subroutine sphj ( n, x, nm, sj, dj )
+
+!*****************************************************************************80
+!
+!! SPHJ computes spherical Bessel functions jn(x) and their derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    12 January 2016
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin.
+!    Modifications suggested by Vincent Lagage, 12 January 2016.
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, integer ( kind = 4 ) NM, the highest order computed.
+!
+!    Output, real ( kind = 8 ) SJ(0:N), the values of jn(x).
+!
+!    Output, real ( kind = 8 ) DJ(0:N), the values of jn'(x).
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) cs
+  real ( kind = 8 ) dj(0:n)
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) msta1
+  integer ( kind = 4 ) msta2
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) sa
+  real ( kind = 8 ) sb
+  real ( kind = 8 ) sj(0:n)
+  real ( kind = 8 ) x
+
+  nm = n
+!
+!  Original code.
+!
+  if ( .true. ) then
+
+    if ( abs ( x ) <= 1.0D-100 ) then
+      do k = 0, n
+        sj(k) = 0.0D+00
+        dj(k) = 0.0D+00
+      end do
+      sj(0) = 1.0D+00
+      dj(1) = 0.3333333333333333D+00
+      return
+    end if
+!
+!  Updated code.
+!
+  else
+
+    if ( abs ( x ) <= 1.0D-16 ) then
+      do k = 0, n
+        sj(k) = 0.0D+00
+        dj(k) = 0.0D+00
+      end do
+      sj(0) = 1.0D+00
+      if ( 0 < n ) then
+        do k = 1, n
+          sj(k) = sj(k-1) * x / real ( 2 * k + 1, kind = 8 )
+        end do
+        dj(1) = 1.0D+00 / 3.0D+00
+      end if
+      return
+    end if
+
+  end if
+
+  sj(0) = sin ( x ) / x
+  sj(1) = ( sj(0) - cos ( x ) ) / x
+
+  if ( 2 <= n ) then
+
+    sa = sj(0)
+    sb = sj(1)
+    m = msta1 ( x, 200 )
+    if ( m < n ) then
+      nm = m
+    else
+      m = msta2 ( x, n, 15 )
+    end if
+
+    f0 = 0.0D+00
+    f1 = 1.0D+00-100
+    do k = m, 0, -1
+      f = ( 2.0D+00 * k + 3.0D+00 ) * f1 / x - f0
+      if ( k <= nm ) then
+        sj(k) = f
+      end if
+      f0 = f1
+      f1 = f
+    end do
+
+    if ( abs ( sa ) <= abs ( sb ) ) then
+      cs = sb / f0
+    else
+      cs = sa / f
+    end if
+
+    do k = 0, nm
+      sj(k) = cs * sj(k)
+    end do
+
+  end if      
+
+  dj(0) = ( cos(x) - sin(x) / x ) / x
+  do k = 1, nm
+    dj(k) = sj(k-1) - ( k + 1.0D+00 ) * sj(k) / x
+  end do
+
+  return
+end
+subroutine sphk ( n, x, nm, sk, dk )
+
+!*****************************************************************************80
+!
+!! SPHK computes modified spherical Bessel functions kn(x) and derivatives.
+!
+!  Discussion:
+!
+!    This procedure computes modified spherical Bessel functions
+!    of the second kind, kn(x) and kn'(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    15 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, integer ( kind = 4 ) NM, the highest order computed.
+!
+!    Output, real ( kind = 8 ) SK(0:N), DK(0:N), the values of kn(x) and kn'(x).
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) dk(0:n)
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) sk(0:n)
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) x
+
+  pi = 3.141592653589793D+00
+  nm = n
+  if ( x < 1.0D-60 ) then
+    do k = 0,n
+      sk(k) = 1.0D+300
+      dk(k) = -1.0D+300
+    end do
+    return
+  end if
+
+  sk(0) = 0.5D+00 * pi / x * exp ( - x )
+  sk(1) = sk(0) * ( 1.0D+00 + 1.0D+00 / x )
+  f0 = sk(0)
+  f1 = sk(1)
+  do k = 2, n
+    f = ( 2.0D+00 * k - 1.0D+00 ) * f1 / x + f0
+    sk(k) = f
+    if ( 1.0D+300 < abs ( f ) ) then
+      exit
+    end if
+    f0 = f1
+    f1 = f
+  end do
+
+  nm = k - 1
+
+  dk(0) = -sk(1)
+  do k = 1, nm
+    dk(k) = -sk(k-1) - ( k + 1.0D+00 ) / x * sk(k)
+  end do
+
+  return
+end
+subroutine sphy ( n, x, nm, sy, dy )
+
+!*****************************************************************************80
+!
+!! SPHY computes spherical Bessel functions yn(x) and their derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    15 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, integer ( kind = 4 ) NM, the highest order computed.
+!
+!    Output, real ( kind = 8 ) SY(0:N), DY(0:N), the values of yn(x) and yn'(x).
+! 
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) dy(0:n)
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) nm
+  real ( kind = 8 ) sy(0:n)
+  real ( kind = 8 ) x
+
+  nm = n
+
+  if ( x < 1.0D-60 ) then
+    do k = 0, n
+      sy(k) = -1.0D+300
+      dy(k) = 1.0D+300
+    end do
+    return
+  end if
+
+  sy(0) = - cos ( x ) / x
+  sy(1) = ( sy(0) - sin ( x ) ) / x
+  f0 = sy(0)
+  f1 = sy(1)
+  do k = 2, n
+    f = ( 2.0D+00 * k - 1.0D+00 ) * f1 / x - f0
+    sy(k) = f
+    if ( 1.0D+300 <= abs ( f ) ) then
+      exit
+    end if              
+    f0 = f1
+    f1 = f
+  end do
+
+  nm = k - 1
+  dy(0) = ( sin ( x ) + cos ( x ) / x ) / x
+  do k = 1, nm
+    dy(k) = sy(k-1) - ( k + 1.0D+00 ) * sy(k) / x
+  end do
+
+  return
+end
+subroutine stvh0 ( x, sh0 )
+
+!*****************************************************************************80
+!
+!! STVH0 computes the Struve function H0(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    22 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) SH0, the value of H0(x).
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) by0
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) km
+  real ( kind = 8 ) p0
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) q0
+  real ( kind = 8 ) r
+  real ( kind = 8 ) s
+  real ( kind = 8 ) sh0
+  real ( kind = 8 ) t
+  real ( kind = 8 ) t2
+  real ( kind = 8 ) ta0
+  real ( kind = 8 ) x
+
+  pi = 3.141592653589793D+00
+  s = 1.0D+00
+  r = 1.0D+00
+
+  if ( x <= 20.0D+00 ) then
+    a0 = 2.0D+00 * x / pi
+    do k = 1, 60
+      r = - r * x / ( 2.0D+00 * k + 1.0D+00 ) * x &
+        / ( 2.0D+00 * k + 1.0D+00 )
+      s = s + r
+      if ( abs ( r ) < abs ( s ) * 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    sh0 = a0 * s
+
+  else
+
+    if ( x < 50.0D+00 ) then
+      km = int ( 0.5D+00 * ( x + 1.0D+00 ) )
+    else
+      km = 25
+    end if
+
+    do k = 1, km
+      r = - r * ( ( 2.0D+00 * k - 1.0D+00 ) / x ) ** 2
+      s = s + r
+      if ( abs ( r ) < abs ( s ) * 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    t = 4.0D+00 / x
+    t2 = t * t
+
+    p0 = (((( &
+      - 0.37043D-05     * t2 &
+      + 0.173565D-04 )  * t2 &
+      - 0.487613D-04 )  * t2 &
+      + 0.17343D-03 )   * t2 &
+      - 0.1753062D-02 ) * t2 &
+      + 0.3989422793D+00
+
+    q0 = t * ((((( &
+        0.32312D-05     * t2 &
+      - 0.142078D-04 )  * t2 &
+      + 0.342468D-04 )  * t2 &
+      - 0.869791D-04 )  * t2 &
+      + 0.4564324D-03 ) * t2 &
+      - 0.0124669441D+00 )
+
+    ta0 = x - 0.25D+00 * pi
+    by0 = 2.0D+00 / sqrt ( x ) &
+      * ( p0 * sin ( ta0 ) + q0 * cos ( ta0 ) )
+    sh0 = 2.0D+00 / ( pi * x ) * s + by0
+
+  end if
+
+  return
+end
+subroutine stvh1 ( x, sh1 )
+
+!*****************************************************************************80
+!
+!! STVH1 computes the Struve function H1(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    22 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) SH1, the value of H1(x).
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) by1
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) km
+  real ( kind = 8 ) p1
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) q1
+  real ( kind = 8 ) r
+  real ( kind = 8 ) s
+  real ( kind = 8 ) sh1
+  real ( kind = 8 ) t
+  real ( kind = 8 ) t2
+  real ( kind = 8 ) ta1
+  real ( kind = 8 ) x
+
+  pi = 3.141592653589793D+00
+  r = 1.0D+00
+
+  if ( x <= 20.0D+00 ) then
+
+    s = 0.0D+00
+    a0 = - 2.0D+00 / pi
+    do k = 1, 60
+      r = - r * x * x / ( 4.0D+00 * k * k - 1.0D+00 )
+      s = s + r
+      if ( abs ( r ) < abs ( s ) * 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    sh1 = a0 * s
+
+  else
+
+    s = 1.0D+00
+
+    if ( x <= 50.0D+00 ) then
+      km = int ( 0.5D+00 * x )
+    else
+      km = 25
+    end if
+
+    do k = 1, km
+      r = - r * ( 4.0D+00 * k * k - 1.0D+00 ) / ( x * x )
+      s = s + r
+      if ( abs ( r ) < abs ( s ) * 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    t = 4.0D+00 / x
+    t2 = t * t
+
+    p1 = (((( &
+        0.42414D-05      * t2 &
+      - 0.20092d-04 )    * t2 &
+      + 0.580759D-04 )   * t2 &
+      - 0.223203D-03 )   * t2 &
+      + 0.29218256D-02 ) * t2 &
+      + 0.3989422819D+00
+
+    q1 = t * ((((( &
+      - 0.36594D-05     * t2 &
+      + 0.1622D-04 )    * t2 &
+      - 0.398708D-04 )  * t2 &
+      + 0.1064741D-03 ) * t2 &
+      - 0.63904D-03 )   * t2 &
+      + 0.0374008364D+00 )
+
+    ta1 = x - 0.75D+00 * pi
+    by1 = 2.0D+00 / sqrt ( x ) * ( p1 * sin ( ta1 ) + q1 * cos ( ta1 ) )
+    sh1 = 2.0D+00 / pi * ( 1.0D+00 + s / ( x * x ) ) + by1
+
+  end if
+
+  return
+end
+ subroutine stvhv ( v, x, hv )
+
+!*****************************************************************************80
+!
+!! STVHV computes the Struve function Hv(x) with arbitrary order v.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    24 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) V, the order of the function.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) HV, the value of Hv(x).
+!
+  implicit none
+
+  real ( kind = 8 ) bf
+  real ( kind = 8 ) bf0
+  real ( kind = 8 ) bf1
+  real ( kind = 8 ) by0
+  real ( kind = 8 ) by1
+  real ( kind = 8 ) byv
+  real ( kind = 8 ) ga
+  real ( kind = 8 ) gb
+  real ( kind = 8 ) hv
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) pu0
+  real ( kind = 8 ) pu1
+  real ( kind = 8 ) qu0
+  real ( kind = 8 ) qu1
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) r2
+  real ( kind = 8 ) s
+  real ( kind = 8 ) s0
+  real ( kind = 8 ) sa
+  real ( kind = 8 ) sr
+  real ( kind = 8 ) t0
+  real ( kind = 8 ) t1
+  real ( kind = 8 ) u
+  real ( kind = 8 ) u0
+  real ( kind = 8 ) v
+  real ( kind = 8 ) v0
+  real ( kind = 8 ) va
+  real ( kind = 8 ) vb
+  real ( kind = 8 ) vt
+  real ( kind = 8 ) x
+
+  pi = 3.141592653589793D+00
+
+  if ( x == 0.0D+00 ) then
+    if ( -1.0D+00 < v .or. int ( v ) - v == 0.5D+00 ) then
+      hv = 0.0D+00
+    else if ( v < -1.0D+00 ) then
+      hv = ( -1.0D+00 ) ** ( int ( 0.5D+00 - v ) - 1 ) * 1.0D+300
+    else if ( v == -1.0D+00 ) then
+      hv = 2.0D+00 / pi
+    end if
+    return
+  end if
+
+  if ( x <= 20.0D+00 ) then
+
+    v0 = v + 1.5D+00
+    call gamma ( v0, ga )
+    s = 2.0D+00 / ( sqrt ( pi ) * ga )
+    r1 = 1.0D+00
+
+    do k = 1, 100
+      va = k + 1.5D+00
+      call gamma ( va, ga )
+      vb = v + k + 1.5D+00
+      call gamma ( vb, gb )
+      r1 = -r1 * ( 0.5D+00 * x ) ** 2
+      r2 = r1 / ( ga * gb )
+      s = s + r2
+      if ( abs ( r2 ) < abs ( s ) * 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    hv = ( 0.5D+00 * x ) ** ( v + 1.0D+00 ) * s
+
+  else
+
+    sa = ( 0.5D+00 * x ) ** ( v - 1.0D+00 ) / pi
+    v0 = v + 0.5D+00
+    call gamma ( v0, ga )
+    s = sqrt ( pi ) / ga
+    r1 = 1.0D+00
+
+    do k = 1, 12
+      va = k + 0.5D+00
+      call gamma ( va, ga )
+      vb = - k + v + 0.5D+00
+      call gamma ( vb, gb )
+      r1 = r1 / ( 0.5D+00 * x ) ** 2
+      s = s + r1 * ga / gb
+    end do
+
+    s0 = sa * s
+    u = abs ( v )
+    n = int ( u )
+    u0 = u - n
+
+    do l = 0, 1
+
+      vt = 4.0D+00 * ( u0 + l ) ** 2
+      r1 = 1.0D+00
+      pu1 = 1.0D+00
+      do k = 1, 12
+        r1 = -0.0078125D+00 * r1 &
+          * ( vt - ( 4.0D+00 * k - 3.0D+00 ) ** 2 ) &
+          * ( vt - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
+          / ( ( 2.0D+00 * k - 1.0D+00 ) * k * x * x )
+        pu1 = pu1 + r1
+      end do
+
+      qu1 = 1.0D+00
+      r2 = 1.0D+00
+      do k = 1, 12
+        r2 = -0.0078125D+00 * r2 &
+          * ( vt - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
+          * ( vt - ( 4.0D+00 * k + 1.0D+00 ) ** 2 ) &
+          / ( ( 2.0D+00 * k + 1.0D+00 ) * k * x * x )
+        qu1 = qu1 + r2
+      end do
+      qu1 = 0.125D+00 * ( vt - 1.0D+00 ) / x * qu1
+
+      if ( l == 0 ) then
+        pu0 = pu1
+        qu0 = qu1
+      end if
+
+    end do
+
+    t0 = x - ( 0.5D+00 * u0 + 0.25D+00 ) * pi
+    t1 = x - ( 0.5D+00 * u0 + 0.75D+00 ) * pi
+    sr = sqrt ( 2.0D+00 / ( pi * x ) )
+    by0 = sr * ( pu0 * sin ( t0 ) + qu0 * cos ( t0 ) )
+    by1 = sr * ( pu1 * sin ( t1 ) + qu1 * cos ( t1 ) )
+    bf0 = by0
+    bf1 = by1
+    do k = 2, n
+      bf = 2.0D+00 * ( k - 1.0D+00 + u0 ) / x * bf1 - bf0
+      bf0 = bf1
+      bf1 = bf
+    end do
+
+    if ( n == 0 ) then
+      byv = by0
+    else if ( n == 1 ) then
+      byv = by1
+    else
+      byv = bf
+    end if
+    hv = byv + s0
+  end if
+
+  return
+end
+subroutine stvl0 ( x, sl0 )
+
+!*****************************************************************************80
+!
+!! STVL0 computes the modified Struve function L0(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    22 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) SL0, the function value.
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) a1
+  real ( kind = 8 ) bi0
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) km
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r
+  real ( kind = 8 ) s
+  real ( kind = 8 ) sl0
+  real ( kind = 8 ) x
+
+  pi = 3.141592653589793D+00
+  s = 1.0D+00
+  r = 1.0D+00
+
+  if ( x <= 20.0D+00 ) then
+
+    a0 = 2.0D+00 * x / pi
+
+    do k = 1, 60
+      r = r * ( x / ( 2.0D+00 * k + 1.0D+00 ) ) ** 2
+      s = s + r
+      if ( abs ( r / s ) < 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    sl0 = a0 * s
+
+  else
+
+    if ( x < 50.0D+00 ) then
+      km = int ( 0.5D+00 * ( x + 1.0D+00 ) )
+    else
+      km = 25
+    end if
+
+    do k = 1, km
+      r = r * ( ( 2.0D+00 * k - 1.0D+00 ) / x ) ** 2
+      s = s + r
+      if ( abs ( r / s ) < 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    a1 = exp ( x ) / sqrt ( 2.0D+00 * pi * x )
+    r = 1.0D+00
+    bi0 = 1.0D+00
+    do k = 1, 16
+      r = 0.125D+00 * r * ( 2.0D+00 * k - 1.0D+00 ) ** 2 / ( k * x )
+      bi0 = bi0 + r
+      if ( abs ( r / bi0 ) < 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    bi0 = a1 * bi0
+    sl0 = - 2.0D+00 / ( pi * x ) * s + bi0
+
+  end if
+
+  return
+end
+subroutine stvl1 ( x, sl1 )
+
+!*****************************************************************************80
+!
+!! STVL1 computes the modified Struve function L1(x).
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    05 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) SL1, the function value.
+!
+  implicit none
+
+  real ( kind = 8 ) a1
+  real ( kind = 8 ) bi1
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) km
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r
+  real ( kind = 8 ) s
+  real ( kind = 8 ) sl1
+  real ( kind = 8 ) x
+
+  pi = 3.141592653589793D+00
+  r = 1.0D+00
+  if ( x <= 20.0D+00 ) then
+    s = 0.0D+00
+    do k = 1, 60
+      r = r * x * x / ( 4.0D+00 * k * k - 1.0D+00 )
+      s = s + r
+      if ( abs ( r / s ) < 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    sl1 = 2.0D+00 / pi * s
+
+  else
+
+    s = 1.0D+00
+    km = int ( 0.50D+00 * x )
+    km = min ( km, 25 )
+
+    do k = 1, km
+      r = r * ( 2.0D+00 * k + 3.0D+00 ) &
+        * ( 2.0D+00 * k + 1.0D+00 ) / ( x * x )
+      s = s + r
+      if ( abs ( r / s ) < 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    sl1 = 2.0D+00 / pi * ( -1.0D+00 + 1.0D+00 &
+      / ( x * x ) + 3.0D+00 * s / x**4 )
+    a1 = exp ( x ) / sqrt ( 2.0D+00 * pi * x )
+    r = 1.0D+00
+    bi1 = 1.0D+00
+    do k = 1, 16
+      r = -0.125D+00 * r &
+        * ( 4.0D+00 - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * x )
+      bi1 = bi1 + r
+      if ( abs ( r / bi1 ) < 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    sl1 = sl1 + a1 * bi1
+
+  end if
+
+  return
+end
+subroutine stvlv ( v, x, slv )
+
+!*****************************************************************************80
+!
+!! STVLV computes the modified Struve function Lv(x) with arbitary order.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    04 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) V, the order of Lv(x).
+!
+!    Input, real ( kind = 8 ) X, the argument of Lv(x).
+!
+!    Output, real ( kind = 8 ) SLV, the value of Lv(x).
+!
+  implicit none
+
+  real ( kind = 8 ) bf
+  real ( kind = 8 ) bf0
+  real ( kind = 8 ) bf1
+  real ( kind = 8 ) biv
+  real ( kind = 8 ) biv0
+  real ( kind = 8 ) ga
+  real ( kind = 8 ) gb
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) l
+  integer ( kind = 4 ) n
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) r2
+  real ( kind = 8 ) s
+  real ( kind = 8 ) s0
+  real ( kind = 8 ) sa
+  real ( kind = 8 ) slv
+  real ( kind = 8 ) u
+  real ( kind = 8 ) u0
+  real ( kind = 8 ) v
+  real ( kind = 8 ) v0
+  real ( kind = 8 ) va
+  real ( kind = 8 ) vb
+  real ( kind = 8 ) vt
+  real ( kind = 8 ) x
+
+  pi = 3.141592653589793D+00
+
+  if ( x == 0.0D+00 ) then
+
+    if ( -1.0D+00 < v .or. int ( v ) - v == 0.5D+00 ) then
+      slv = 0.0D+00
+    else if ( v < -1.0D+00 ) then
+      slv = ( -1 ) ** ( int ( 0.5D+00 - v ) - 1 ) * 1.0D+300
+    else if ( v == -1.0D+00 ) then
+      slv = 2.0D+00 / pi
+    end if
+
+  else if ( x <= 40.0D+00 ) then
+
+    v0 = v + 1.5D+00
+    call gamma ( v0, ga )
+    s = 2.0D+00 / ( sqrt ( pi ) * ga )
+    r1 = 1.0D+00
+    do k = 1, 100
+      va = k + 1.5D+00
+      call gamma ( va, ga )
+      vb = v + k + 1.5D+00
+      call gamma ( vb, gb )
+      r1 = r1 * ( 0.5D+00 * x ) ** 2
+      r2 = r1 / ( ga * gb )
+      s = s + r2
+      if ( abs ( r2 / s ) < 1.0D-12 ) then
+        exit
+      end if
+    end do
+
+    slv = ( 0.5D+00 * x ) ** ( v + 1.0D+00 ) * s
+
+  else
+
+    sa = -1.0D+00 / pi * ( 0.5D+00 * x ) ** ( v - 1.0D+00 )
+    v0 = v + 0.5D+00
+    call gamma ( v0, ga )
+    s = - sqrt ( pi ) / ga
+    r1 = -1.0D+00
+    do k = 1, 12
+      va = k + 0.5D+00
+      call gamma ( va, ga )
+      vb = - k + v + 0.5D+00
+      call gamma ( vb, gb )
+      r1 = - r1 / ( 0.5D+00 * x ) ** 2
+      s = s + r1 * ga / gb
+    end do
+    s0 = sa * s
+    u = abs ( v )
+    n = int ( u )
+    u0 = u - n
+    do l = 0, 1
+      vt = u0 + l
+      r = 1.0D+00
+      biv = 1.0D+00
+      do k = 1, 16
+        r = -0.125D+00 * r * ( 4.0D+00 * vt * vt - &
+          ( 2.0D+00 * k - 1.0D+00 )**2 ) / ( k * x )
+        biv = biv + r
+        if ( abs ( r / biv ) < 1.0D-12 ) then
+          exit
+        end if
+      end do
+
+      if ( l == 0 ) then
+        biv0 = biv
+      end if
+
+    end do
+
+    bf0 = biv0
+    bf1 = biv
+    do k = 2, n
+      bf = - 2.0D+00 * ( k - 1.0D+00 + u0 ) / x * bf1 + bf0
+      bf0 = bf1
+      bf1 = bf
+    end do
+
+    if ( n == 0 ) then
+      biv = biv0
+    else if ( 1 < n ) then
+      biv = bf
+    end if
+
+    slv = exp ( x ) / sqrt ( 2.0D+00 * pi * x ) * biv + s0
+
+  end if
+
+  return
+end
+subroutine timestamp ( )
+
+!*****************************************************************************80
+!
+!! TIMESTAMP prints the current YMDHMS date as a time stamp.
+!
+!  Example:
+!
+!    May 31 2001   9:45:54.872 AM
+!
+!  Modified:
+!
+!    31 May 2001
+!
+!  Author:
+!
+!    John Burkardt
+!
+!  Parameters:
+!
+!    None
+!
+  implicit none
+
+  character ( len = 8 ) ampm
+  integer ( kind = 4 ) d
+  character ( len = 8 ) date
+  integer ( kind = 4 ) h
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) mm
+  character ( len = 9 ), parameter, dimension(12) :: month = (/ &
+    'January  ', 'February ', 'March    ', 'April    ', &
+    'May      ', 'June     ', 'July     ', 'August   ', &
+    'September', 'October  ', 'November ', 'December ' /)
+  integer ( kind = 4 ) n
+  integer ( kind = 4 ) s
+  character ( len = 10 ) time
+  integer ( kind = 4 ) values(8)
+  integer ( kind = 4 ) y
+  character ( len = 5 ) zone
+
+  call date_and_time ( date, time, zone, values )
+
+  y = values(1)
+  m = values(2)
+  d = values(3)
+  h = values(5)
+  n = values(6)
+  s = values(7)
+  mm = values(8)
+
+  if ( h < 12 ) then
+    ampm = 'AM'
+  else if ( h == 12 ) then
+    if ( n == 0 .and. s == 0 ) then
+      ampm = 'Noon'
+    else
+      ampm = 'PM'
+    end if
+  else
+    h = h - 12
+    if ( h < 12 ) then
+      ampm = 'PM'
+    else if ( h == 12 ) then
+      if ( n == 0 .and. s == 0 ) then
+        ampm = 'Midnight'
+      else
+        ampm = 'AM'
+      end if
+    end if
+  end if
+
+  write ( *, '(a,1x,i2,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) &
+    trim ( month(m) ), d, y, h, ':', n, ':', s, '.', mm, trim ( ampm )
+
+  return
+end
+subroutine vvla ( va, x, pv )
+
+!*****************************************************************************80
+!
+!! VVLA computes parabolic cylinder function Vv(x) for large arguments.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    04 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Input, real ( kind = 8 ) VA, the order nu.
+!
+!    Output, real ( kind = 8 ) PV, the value of V(nu,x).
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) dsl
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) gl
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) pdl
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) pv
+  real ( kind = 8 ) qe
+  real ( kind = 8 ) r
+  real ( kind = 8 ) va
+  real ( kind = 8 ) x
+  real ( kind = 8 ) x1
+
+  pi = 3.141592653589793D+00
+  eps = 1.0D-12
+  qe = exp ( 0.25D+00 * x * x )
+  a0 = abs ( x ) ** ( -va - 1.0D+00 ) * sqrt ( 2.0D+00 / pi ) * qe
+
+  r = 1.0D+00
+  pv = 1.0D+00
+  do k = 1, 18
+    r = 0.5D+00 * r * ( 2.0D+00 * k + va - 1.0D+00 ) &
+      * ( 2.0D+00 * k + va ) / ( k * x * x )
+    pv = pv + r
+    if ( abs ( r / pv ) < eps ) then
+      exit
+    end if
+  end do
+
+  pv = a0 * pv
+
+  if ( x < 0.0D+00 ) then
+    x1 = -x
+    call dvla ( va, x1, pdl )
+    call gamma ( -va, gl )
+    dsl = sin ( pi * va ) * sin ( pi * va )
+    pv = dsl * gl / pi * pdl - cos ( pi * va ) * pv
+  end if
+
+  return
+end
+subroutine vvsa ( va, x, pv )
+
+!*****************************************************************************80
+!
+!! VVSA computes parabolic cylinder function V(nu,x) for small arguments.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
+!    they give permission to incorporate this routine into a user program 
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    04 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Input, real ( kind = 8 ) VA, the order nu.
+!
+!    Output, real ( kind = 8 ) PV, the value of V(nu,x).
+!
+  implicit none
+
+  real ( kind = 8 ) a0
+  real ( kind = 8 ) ep
+  real ( kind = 8 ) eps
+  real ( kind = 8 ) fac
+  real ( kind = 8 ) g1
+  real ( kind = 8 ) ga0
+  real ( kind = 8 ) gm
+  real ( kind = 8 ) gw
+  integer ( kind = 4 ) m
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) pv
+  real ( kind = 8 ) r
+  real ( kind = 8 ) r1
+  real ( kind = 8 ) sq2
+  real ( kind = 8 ) sv
+  real ( kind = 8 ) sv0
+  real ( kind = 8 ) v1
+  real ( kind = 8 ) va
+  real ( kind = 8 ) va0
+  real ( kind = 8 ) vb0
+  real ( kind = 8 ) vm
+  real ( kind = 8 ) x
+
+  eps = 1.0D-15
+  pi = 3.141592653589793D+00
+  ep = exp ( -0.25D+00 * x * x )
+  va0 = 1.0D+00 + 0.5D+00 * va
+
+  if ( x == 0.0D+00 ) then
+
+    if ( ( va0 <= 0.0D+00 .and. va0 == int ( va0 ) ) .or. &
+      va == 0.0D+00 ) then
+      pv = 0.0D+00
+    else
+      vb0 = -0.5D+00 * va
+      sv0 = sin ( va0 * pi )
+      call gamma ( va0, ga0 )
+      pv = 2.0D+00 ** vb0 * sv0 / ga0
+    end if
+
+  else
+
+    sq2 = sqrt ( 2.0D+00 )
+    a0 = 2.0D+00 ** ( -0.5D+00 * va ) * ep / ( 2.0D+00 * pi )
+    sv = sin ( - ( va + 0.5D+00 ) * pi )
+    v1 = -0.5D+00 * va
+    call gamma ( v1, g1 )
+    pv = ( sv + 1.0D+00 ) * g1
+    r = 1.0D+00
+    fac = 1.0D+00
+
+    do m = 1, 250
+      vm = 0.5D+00 * ( m - va )
+      call gamma ( vm, gm )
+      r = r * sq2 * x / m
+      fac = - fac
+      gw = fac * sv + 1.0D+00
+      r1 = gw * r * gm
+      pv = pv + r1
+      if ( abs ( r1 / pv ) < eps .and. gw /= 0.0D+00 ) then
+        exit
+      end if
+    end do
+
+    pv = a0 * pv
+
+  end if
+
+  return
+end
diff --git a/src/githash.h b/src/githash.h
index 64b27497..ee42eee7 100644
--- a/src/githash.h
+++ b/src/githash.h
@@ -1 +1 @@
-#define GITHASH "b660860"
+#define GITHASH "005ead3"
diff --git a/src/mpi/Makefile b/src/mpi/Makefile
index 018667a0..ab563e94 100644
--- a/src/mpi/Makefile
+++ b/src/mpi/Makefile
@@ -41,10 +41,10 @@ endif
 ifeq ($(MPICC),$(CC))
   # Depending on a particular MPI installation one may need to manually specify paths to MPI headers and libraries.
   # Path should be absolute or relative to the location of this Makefile.
-  #CFLAGS += -I"C:/Program Files/MPICH2/include"
-  #LDFLAGS += -L"C:/Program Files/MPICH2/lib"
+  CFLAGS += -I'$(MSMPI_INC)'
+  LDFLAGS += -L'$(MSMPI_LIB64)'
 
-  LDLIBS += -lmpi
+  LDLIBS += -lmsmpi
 # If MPI compiler wrapper is used, environmental variables are set to define C compiler and linker
 else
   # for MPICH
diff --git a/src/ocl/Makefile b/src/ocl/Makefile
index eee51d55..6916e7bb 100644
--- a/src/ocl/Makefile
+++ b/src/ocl/Makefile
@@ -22,8 +22,9 @@
 # Depending on a particular OpenCL installation one may need to manually specify paths to corresponding headers and
 # libraries. Path should be absolute or relative to the location of this Makefile.
 # On Windows it is also possible to link to OpenCL.dll directly.
-#CFLAGS += -I"C:/Program Files/NVIDIA GPU Computing Toolkit/CUDA/v3.2/include"
-#LDFLAGS += -L"C:/Program Files/NVIDIA GPU Computing Toolkit/CUDA/v3.2/lib/Win32"
+CFLAGS += -I"C:/OpenCL-Headers"
+CFLAGS += -I"C:/clFFT-2.12.2-Windows-x64/include"
+LDFLAGS += -L"C:/clFFT-2.12.2-Windows-x64/bin"
 
 # This workaround is to disable linker warnings when linking against 32-bit OpenCL.dll on 64-bit Windows. The issue 
 # appeared with Nvidia library supplied with driver 301.42. Uncomment the following 3 lines to enable it.
@@ -45,9 +46,10 @@ else # the following is only for non-sparse mode
     # Depending on a particular clFFT installation one may need to manually specify paths to its headers and 
     # libraries. Path should be absolute or relative to the location of this Makefile.
     # On Windows (as in example below) it is recommended to link to *.dll instead of *.lib
-    #CFLAGS  += -I"C:\Program Files (x86)\AMD\clAmdFft\include"
-    #LDFLAGS += -L"C:\Program Files (x86)\AMD\clAmdFft\bin64"
-  
+    #CFLAGS += -I"C:/OpenCL-Headers"
+    #CFLAGS += -I"C:/clFFT-2.12.2-Windows-x64/include"
+    #LDFLAGS += -L"C:/clFFT-2.12.2-Windows-x64/bin"
+
     LDLIBS += -lclFFT
 
     # On Unix clFFT may need pthread library, which is not linked by default; if yes, uncomment the following
diff --git a/src/param.c b/src/param.c
index 7bde42a3..d6d49a11 100644
--- a/src/param.c
+++ b/src/param.c
@@ -234,11 +234,11 @@ static const struct subopt_struct beam_opt[]={
 		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
 		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
 		UNDEF,B_BESSELLM},
-	{"besselTEC","<order> <angle> [<x> <y> <z>]","Bessel beam forming TE Bessel beam. The half-cone angle "
+	{"besselTEC","<order> <angle> [<x> <y> <z>]","Bessel beam forming the TE Bessel beam. The half-cone angle "
 		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
 		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
 		UNDEF,B_BESSELTEC},
-	{"besselTMC","<order> <angle> [<x> <y> <z>]","Bessel beam forming TM Bessel beam. The half-cone angle "
+	{"besselTMC","<order> <angle> [<x> <y> <z>]","Bessel beam forming the TM Bessel beam. The half-cone angle "
 		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
 		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
 		UNDEF,B_BESSELTMC},

From f7238e1312b65b8b7e462f2862de25c8f59768f6 Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Wed, 10 Jun 2020 14:51:53 +0700
Subject: [PATCH 05/46] Examined Bessel beams

---
 src/GenerateB.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/GenerateB.c b/src/GenerateB.c
index f0389d71..0853e254 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -488,7 +488,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				t2=WaveNum*cos(alpha0);
 				// common factor 
 				ctemp=cpow(-I,n0)*cexp(I*n0*phi)*cexp(I*t2*z)/WaveNum/WaveNum;
-				// t3,t4,t5 - x,y,z field components are described in the doc file "Bessel beam fields" in the "doc" folder 
+				// t3,t4,t5 - x,y,z field components are described in the doc file "Bessel beam fields" (in the doc folder) 
 				if (n0==0){
 					if (ro==0){
 						switch (beamtype) {

From 51bfec34e9e0fd15d9164a95e8e8a5738240152c Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Fri, 11 Sep 2020 16:23:20 +0700
Subject: [PATCH 06/46] Added Generalized BB

---
 src/.cproject                                 |   144 -
 src/.project                                  |    27 -
 src/.settings/language.settings.xml           |    28 -
 .../org.eclipse.cdt.codan.core.prefs          |    77 -
 src/Default/cpp/subdir.mk                     |    30 -
 src/Default/makefile                          |    61 -
 src/Default/mpi/subdir.mk                     |    44 -
 src/Default/objects.mk                        |     8 -
 src/Default/ocl/subdir.mk                     |    45 -
 src/Default/seq/subdir.mk                     |    44 -
 src/Default/sources.mk                        |    31 -
 src/Default/subdir.mk                         |    99 -
 src/GenerateB.c                               |   176 +-
 src/const.h                                   |     1 +
 src/fort/special_functions.f90                | 25412 +---------------
 src/param.c                                   |    10 +-
 16 files changed, 203 insertions(+), 26034 deletions(-)
 delete mode 100644 src/.cproject
 delete mode 100644 src/.project
 delete mode 100644 src/.settings/language.settings.xml
 delete mode 100644 src/.settings/org.eclipse.cdt.codan.core.prefs
 delete mode 100644 src/Default/cpp/subdir.mk
 delete mode 100644 src/Default/makefile
 delete mode 100644 src/Default/mpi/subdir.mk
 delete mode 100644 src/Default/objects.mk
 delete mode 100644 src/Default/ocl/subdir.mk
 delete mode 100644 src/Default/seq/subdir.mk
 delete mode 100644 src/Default/sources.mk
 delete mode 100644 src/Default/subdir.mk

diff --git a/src/.cproject b/src/.cproject
deleted file mode 100644
index fa1d02cc..00000000
--- a/src/.cproject
+++ /dev/null
@@ -1,144 +0,0 @@
-<?xml version="1.0" encoding="UTF-8" standalone="no"?>
-<?fileVersion 4.0.0?><cproject storage_type_id="org.eclipse.cdt.core.XmlProjectDescriptionStorage">
-    	
-    <storageModule moduleId="org.eclipse.cdt.core.settings">
-        		
-        <cconfiguration id="cdt.managedbuild.toolchain.gnu.mingw.base.1058757420">
-            			
-            <storageModule buildSystemId="org.eclipse.cdt.managedbuilder.core.configurationDataProvider" id="cdt.managedbuild.toolchain.gnu.mingw.base.1058757420" moduleId="org.eclipse.cdt.core.settings" name="Default">
-                				
-                <externalSettings/>
-                				
-                <extensions>
-                    					
-                    <extension id="org.eclipse.cdt.core.PE" point="org.eclipse.cdt.core.BinaryParser"/>
-                    					
-                    <extension id="org.eclipse.cdt.core.GASErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-                    					
-                    <extension id="org.eclipse.cdt.core.GLDErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-                    					
-                    <extension id="org.eclipse.cdt.core.GCCErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-                    					
-                    <extension id="org.eclipse.cdt.core.GmakeErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-                    					
-                    <extension id="org.eclipse.cdt.core.CWDLocator" point="org.eclipse.cdt.core.ErrorParser"/>
-                    				
-                </extensions>
-                			
-            </storageModule>
-            			
-            <storageModule moduleId="cdtBuildSystem" version="4.0.0">
-                				
-                <configuration buildProperties="" description="" id="cdt.managedbuild.toolchain.gnu.mingw.base.1058757420" name="Default" optionalBuildProperties="" parent="org.eclipse.cdt.build.core.emptycfg">
-                    					
-                    <folderInfo id="cdt.managedbuild.toolchain.gnu.mingw.base.1058757420.1612633561" name="/" resourcePath="">
-                        						
-                        <toolChain id="cdt.managedbuild.toolchain.gnu.mingw.base.821623901" name="MinGW GCC" superClass="cdt.managedbuild.toolchain.gnu.mingw.base">
-                            							
-                            <targetPlatform archList="all" binaryParser="org.eclipse.cdt.core.PE" id="cdt.managedbuild.target.gnu.platform.mingw.base.1627500181" name="Debug Platform" osList="win32" superClass="cdt.managedbuild.target.gnu.platform.mingw.base"/>
-                            							
-                            <builder buildPath="C:\adda_1\src" id="cdt.managedbuild.builder.gnu.cross.36234924" keepEnvironmentInBuildfile="false" managedBuildOn="false" name="Gnu Make Builder" superClass="cdt.managedbuild.builder.gnu.cross"/>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.assembler.mingw.base.823972384" name="GCC Assembler" superClass="cdt.managedbuild.tool.gnu.assembler.mingw.base">
-                                								
-                                <inputType id="cdt.managedbuild.tool.gnu.assembler.input.1692673043" superClass="cdt.managedbuild.tool.gnu.assembler.input"/>
-                                							
-                            </tool>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.archiver.mingw.base.1623148525" name="GCC Archiver" superClass="cdt.managedbuild.tool.gnu.archiver.mingw.base"/>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base.1390697299" name="GCC C++ Compiler" superClass="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base">
-                                								
-                                <inputType id="cdt.managedbuild.tool.gnu.cpp.compiler.input.21165115" superClass="cdt.managedbuild.tool.gnu.cpp.compiler.input"/>
-                                							
-                            </tool>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.c.compiler.mingw.base.1776027495" name="GCC C Compiler" superClass="cdt.managedbuild.tool.gnu.c.compiler.mingw.base">
-                                								
-                                <inputType id="cdt.managedbuild.tool.gnu.c.compiler.input.1961918274" superClass="cdt.managedbuild.tool.gnu.c.compiler.input"/>
-                                							
-                            </tool>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.c.linker.mingw.base.397089588" name="MinGW C Linker" superClass="cdt.managedbuild.tool.gnu.c.linker.mingw.base"/>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base.486856509" name="MinGW C++ Linker" superClass="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base">
-                                								
-                                <inputType id="cdt.managedbuild.tool.gnu.cpp.linker.input.822805650" superClass="cdt.managedbuild.tool.gnu.cpp.linker.input">
-                                    									
-                                    <additionalInput kind="additionalinputdependency" paths="$(USER_OBJS)"/>
-                                    									
-                                    <additionalInput kind="additionalinput" paths="$(LIBS)"/>
-                                    								
-                                </inputType>
-                                							
-                            </tool>
-                            						
-                        </toolChain>
-                        					
-                    </folderInfo>
-                    				
-                </configuration>
-                			
-            </storageModule>
-            			
-            <storageModule moduleId="org.eclipse.cdt.core.externalSettings"/>
-            		
-        </cconfiguration>
-        	
-    </storageModule>
-    	
-    <storageModule moduleId="scannerConfiguration">
-        		
-        <autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId=""/>
-        		
-        <scannerConfigBuildInfo instanceId="cdt.managedbuild.toolchain.gnu.mingw.base.1055110387;cdt.managedbuild.toolchain.gnu.mingw.base.1055110387.763791221;cdt.managedbuild.tool.gnu.c.compiler.mingw.base.1203535434;cdt.managedbuild.tool.gnu.c.compiler.input.557581763">
-            			
-            <autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId=""/>
-            		
-        </scannerConfigBuildInfo>
-        	
-    </storageModule>
-    	
-    <storageModule moduleId="cdtBuildSystem" version="4.0.0">
-        		
-        <project id="adda.null.1400785423" name="adda"/>
-        	
-    </storageModule>
-    	
-    <storageModule moduleId="org.eclipse.cdt.core.LanguageSettingsProviders"/>
-    	
-    <storageModule moduleId="org.eclipse.cdt.make.core.buildtargets">
-        		
-        <buildTargets>
-            			
-            <target name="seq" path="" targetID="org.eclipse.cdt.build.MakeTargetBuilder">
-                				
-                <buildCommand>make</buildCommand>
-                				
-                <buildArguments/>
-                				
-                <buildTarget>seq</buildTarget>
-                				
-                <stopOnError>true</stopOnError>
-                				
-                <useDefaultCommand>true</useDefaultCommand>
-                				
-                <runAllBuilders>true</runAllBuilders>
-                			
-            </target>
-            		
-        </buildTargets>
-        	
-    </storageModule>
-    	
-    <storageModule moduleId="refreshScope" versionNumber="2">
-        		
-        <configuration configurationName="Default">
-            			
-            <resource resourceType="PROJECT" workspacePath="/adda"/>
-            		
-        </configuration>
-        	
-    </storageModule>
-    
-</cproject>
diff --git a/src/.project b/src/.project
deleted file mode 100644
index 0adaf783..00000000
--- a/src/.project
+++ /dev/null
@@ -1,27 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<projectDescription>
-	<name>adda</name>
-	<comment></comment>
-	<projects>
-	</projects>
-	<buildSpec>
-		<buildCommand>
-			<name>org.eclipse.cdt.managedbuilder.core.genmakebuilder</name>
-			<triggers>clean,full,incremental,</triggers>
-			<arguments>
-			</arguments>
-		</buildCommand>
-		<buildCommand>
-			<name>org.eclipse.cdt.managedbuilder.core.ScannerConfigBuilder</name>
-			<triggers>full,incremental,</triggers>
-			<arguments>
-			</arguments>
-		</buildCommand>
-	</buildSpec>
-	<natures>
-		<nature>org.eclipse.cdt.core.cnature</nature>
-		<nature>org.eclipse.cdt.managedbuilder.core.managedBuildNature</nature>
-		<nature>org.eclipse.cdt.managedbuilder.core.ScannerConfigNature</nature>
-		<nature>org.eclipse.cdt.core.ccnature</nature>
-	</natures>
-</projectDescription>
diff --git a/src/.settings/language.settings.xml b/src/.settings/language.settings.xml
deleted file mode 100644
index 2ad3bdaa..00000000
--- a/src/.settings/language.settings.xml
+++ /dev/null
@@ -1,28 +0,0 @@
-<?xml version="1.0" encoding="UTF-8" standalone="no"?>
-<project>
-    	
-    <configuration id="cdt.managedbuild.toolchain.gnu.mingw.base.1058757420" name="Default">
-        		
-        <extension point="org.eclipse.cdt.core.LanguageSettingsProvider">
-            			
-            <provider copy-of="extension" id="org.eclipse.cdt.ui.UserLanguageSettingsProvider"/>
-            			
-            <provider-reference id="org.eclipse.cdt.core.ReferencedProjectsLanguageSettingsProvider" ref="shared-provider"/>
-            			
-            <provider class="org.eclipse.cdt.managedbuilder.language.settings.providers.GCCBuildCommandParser" id="org.eclipse.cdt.managedbuilder.core.GCCBuildCommandParser" keep-relative-paths="false" name="CDT GCC Build Output Parser" parameter="(g?cc)|([gc]\+\+)|(clang)" prefer-non-shared="true"/>
-            			
-            <provider class="org.eclipse.cdt.managedbuilder.internal.language.settings.providers.GCCBuiltinSpecsDetectorMinGW" console="false" env-hash="-404675868575427125" id="org.eclipse.cdt.managedbuilder.core.GCCBuiltinSpecsDetectorMinGW" keep-relative-paths="false" name="CDT GCC Built-in Compiler Settings MinGW" parameter="${COMMAND} ${FLAGS} -E -P -v -dD &quot;${INPUTS}&quot;" prefer-non-shared="true">
-                				
-                <language-scope id="org.eclipse.cdt.core.gcc"/>
-                				
-                <language-scope id="org.eclipse.cdt.core.g++"/>
-                			
-            </provider>
-            			
-            <provider-reference id="org.eclipse.cdt.managedbuilder.core.MBSLanguageSettingsProvider" ref="shared-provider"/>
-            		
-        </extension>
-        	
-    </configuration>
-    
-</project>
diff --git a/src/.settings/org.eclipse.cdt.codan.core.prefs b/src/.settings/org.eclipse.cdt.codan.core.prefs
deleted file mode 100644
index 73293b43..00000000
--- a/src/.settings/org.eclipse.cdt.codan.core.prefs
+++ /dev/null
@@ -1,77 +0,0 @@
-eclipse.preferences.version=1
-org.eclipse.cdt.codan.checkers.errnoreturn=Warning
-org.eclipse.cdt.codan.checkers.errnoreturn.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"No return\\")",implicit\=>false}
-org.eclipse.cdt.codan.checkers.errreturnvalue=Error
-org.eclipse.cdt.codan.checkers.errreturnvalue.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Unused return value\\")"}
-org.eclipse.cdt.codan.checkers.nocommentinside=-Error
-org.eclipse.cdt.codan.checkers.nocommentinside.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Nesting comments\\")"}
-org.eclipse.cdt.codan.checkers.nolinecomment=-Error
-org.eclipse.cdt.codan.checkers.nolinecomment.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Line comments\\")"}
-org.eclipse.cdt.codan.checkers.noreturn=Error
-org.eclipse.cdt.codan.checkers.noreturn.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"No return value\\")",implicit\=>false}
-org.eclipse.cdt.codan.internal.checkers.AbstractClassCreation=Error
-org.eclipse.cdt.codan.internal.checkers.AbstractClassCreation.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Abstract class cannot be instantiated\\")"}
-org.eclipse.cdt.codan.internal.checkers.AmbiguousProblem=Error
-org.eclipse.cdt.codan.internal.checkers.AmbiguousProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Ambiguous problem\\")"}
-org.eclipse.cdt.codan.internal.checkers.AssignmentInConditionProblem=Warning
-org.eclipse.cdt.codan.internal.checkers.AssignmentInConditionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Assignment in condition\\")"}
-org.eclipse.cdt.codan.internal.checkers.AssignmentToItselfProblem=Error
-org.eclipse.cdt.codan.internal.checkers.AssignmentToItselfProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Assignment to itself\\")"}
-org.eclipse.cdt.codan.internal.checkers.CaseBreakProblem=Warning
-org.eclipse.cdt.codan.internal.checkers.CaseBreakProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"No break at end of case\\")",no_break_comment\=>"no break",last_case_param\=>false,empty_case_param\=>false,enable_fallthrough_quickfix_param\=>false}
-org.eclipse.cdt.codan.internal.checkers.CatchByReference=Warning
-org.eclipse.cdt.codan.internal.checkers.CatchByReference.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Catching by reference is recommended\\")",unknown\=>false,exceptions\=>()}
-org.eclipse.cdt.codan.internal.checkers.CircularReferenceProblem=Error
-org.eclipse.cdt.codan.internal.checkers.CircularReferenceProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Circular inheritance\\")"}
-org.eclipse.cdt.codan.internal.checkers.ClassMembersInitialization=Warning
-org.eclipse.cdt.codan.internal.checkers.ClassMembersInitialization.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Class members should be properly initialized\\")",skip\=>true}
-org.eclipse.cdt.codan.internal.checkers.DecltypeAutoProblem=Error
-org.eclipse.cdt.codan.internal.checkers.DecltypeAutoProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid 'decltype(auto)' specifier\\")"}
-org.eclipse.cdt.codan.internal.checkers.FieldResolutionProblem=Error
-org.eclipse.cdt.codan.internal.checkers.FieldResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Field cannot be resolved\\")"}
-org.eclipse.cdt.codan.internal.checkers.FunctionResolutionProblem=Error
-org.eclipse.cdt.codan.internal.checkers.FunctionResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Function cannot be resolved\\")"}
-org.eclipse.cdt.codan.internal.checkers.InvalidArguments=Error
-org.eclipse.cdt.codan.internal.checkers.InvalidArguments.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid arguments\\")"}
-org.eclipse.cdt.codan.internal.checkers.InvalidTemplateArgumentsProblem=Error
-org.eclipse.cdt.codan.internal.checkers.InvalidTemplateArgumentsProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid template argument\\")"}
-org.eclipse.cdt.codan.internal.checkers.LabelStatementNotFoundProblem=Error
-org.eclipse.cdt.codan.internal.checkers.LabelStatementNotFoundProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Label statement not found\\")"}
-org.eclipse.cdt.codan.internal.checkers.MemberDeclarationNotFoundProblem=Error
-org.eclipse.cdt.codan.internal.checkers.MemberDeclarationNotFoundProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Member declaration not found\\")"}
-org.eclipse.cdt.codan.internal.checkers.MethodResolutionProblem=Error
-org.eclipse.cdt.codan.internal.checkers.MethodResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Method cannot be resolved\\")"}
-org.eclipse.cdt.codan.internal.checkers.NamingConventionFunctionChecker=-Info
-org.eclipse.cdt.codan.internal.checkers.NamingConventionFunctionChecker.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Name convention for function\\")",pattern\=>"^[a-z]",macro\=>true,exceptions\=>()}
-org.eclipse.cdt.codan.internal.checkers.NonVirtualDestructorProblem=Warning
-org.eclipse.cdt.codan.internal.checkers.NonVirtualDestructorProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Class has a virtual method and non-virtual destructor\\")"}
-org.eclipse.cdt.codan.internal.checkers.OverloadProblem=Error
-org.eclipse.cdt.codan.internal.checkers.OverloadProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid overload\\")"}
-org.eclipse.cdt.codan.internal.checkers.RedeclarationProblem=Error
-org.eclipse.cdt.codan.internal.checkers.RedeclarationProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid redeclaration\\")"}
-org.eclipse.cdt.codan.internal.checkers.RedefinitionProblem=Error
-org.eclipse.cdt.codan.internal.checkers.RedefinitionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid redefinition\\")"}
-org.eclipse.cdt.codan.internal.checkers.ReturnStyleProblem=-Warning
-org.eclipse.cdt.codan.internal.checkers.ReturnStyleProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Return with parenthesis\\")"}
-org.eclipse.cdt.codan.internal.checkers.ScanfFormatStringSecurityProblem=-Warning
-org.eclipse.cdt.codan.internal.checkers.ScanfFormatStringSecurityProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Format String Vulnerability\\")"}
-org.eclipse.cdt.codan.internal.checkers.StatementHasNoEffectProblem=Warning
-org.eclipse.cdt.codan.internal.checkers.StatementHasNoEffectProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Statement has no effect\\")",macro\=>true,exceptions\=>()}
-org.eclipse.cdt.codan.internal.checkers.SuggestedParenthesisProblem=Warning
-org.eclipse.cdt.codan.internal.checkers.SuggestedParenthesisProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Suggested parenthesis around expression\\")",paramNot\=>false}
-org.eclipse.cdt.codan.internal.checkers.SuspiciousSemicolonProblem=Warning
-org.eclipse.cdt.codan.internal.checkers.SuspiciousSemicolonProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Suspicious semicolon\\")",else\=>false,afterelse\=>false}
-org.eclipse.cdt.codan.internal.checkers.TypeResolutionProblem=Error
-org.eclipse.cdt.codan.internal.checkers.TypeResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Type cannot be resolved\\")"}
-org.eclipse.cdt.codan.internal.checkers.UnusedFunctionDeclarationProblem=Warning
-org.eclipse.cdt.codan.internal.checkers.UnusedFunctionDeclarationProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Unused function declaration\\")",macro\=>true}
-org.eclipse.cdt.codan.internal.checkers.UnusedStaticFunctionProblem=Warning
-org.eclipse.cdt.codan.internal.checkers.UnusedStaticFunctionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Unused static function\\")",macro\=>true}
-org.eclipse.cdt.codan.internal.checkers.UnusedVariableDeclarationProblem=Warning
-org.eclipse.cdt.codan.internal.checkers.UnusedVariableDeclarationProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Unused variable declaration in file scope\\")",macro\=>true,exceptions\=>("@(\#)","$Id")}
-org.eclipse.cdt.codan.internal.checkers.UsingInHeaderProblem=-Warning
-org.eclipse.cdt.codan.internal.checkers.UsingInHeaderProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Using directive in header\\")"}
-org.eclipse.cdt.codan.internal.checkers.VariableResolutionProblem=Error
-org.eclipse.cdt.codan.internal.checkers.VariableResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Symbol is not resolved\\")"}
-org.eclipse.cdt.qt.core.qtproblem=Warning
-org.eclipse.cdt.qt.core.qtproblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>false,RUN_ON_INC_BUILD\=>false,RUN_ON_FILE_OPEN\=>true,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>null}
diff --git a/src/Default/cpp/subdir.mk b/src/Default/cpp/subdir.mk
deleted file mode 100644
index ca31b88e..00000000
--- a/src/Default/cpp/subdir.mk
+++ /dev/null
@@ -1,30 +0,0 @@
-################################################################################
-# Automatically-generated file. Do not edit!
-################################################################################
-
-# Add inputs and outputs from these tool invocations to the build variables 
-CPP_SRCS += \
-../cpp/fft_execute.cpp \
-../cpp/fft_kernelstring.cpp \
-../cpp/fft_setup.cpp 
-
-OBJS += \
-./cpp/fft_execute.o \
-./cpp/fft_kernelstring.o \
-./cpp/fft_setup.o 
-
-CPP_DEPS += \
-./cpp/fft_execute.d \
-./cpp/fft_kernelstring.d \
-./cpp/fft_setup.d 
-
-
-# Each subdirectory must supply rules for building sources it contributes
-cpp/%.o: ../cpp/%.cpp
-	@echo 'Building file: $<'
-	@echo 'Invoking: GCC C++ Compiler'
-	g++ -O2 -g -Wall -c -fmessage-length=0 -MMD -MP -MF"$(@:%.o=%.d)" -MT"$(@)" -o "$@" "$<"
-	@echo 'Finished building: $<'
-	@echo ' '
-
-
diff --git a/src/Default/makefile b/src/Default/makefile
deleted file mode 100644
index ab38455d..00000000
--- a/src/Default/makefile
+++ /dev/null
@@ -1,61 +0,0 @@
-################################################################################
-# Automatically-generated file. Do not edit!
-################################################################################
-
--include ../makefile.init
-
-RM := del
-
-# All of the sources participating in the build are defined here
--include sources.mk
--include seq/subdir.mk
--include ocl/subdir.mk
--include mpi/subdir.mk
--include cpp/subdir.mk
--include subdir.mk
--include objects.mk
-
-ifneq ($(MAKECMDGOALS),clean)
-ifneq ($(strip $(CC_DEPS)),)
--include $(CC_DEPS)
-endif
-ifneq ($(strip $(C++_DEPS)),)
--include $(C++_DEPS)
-endif
-ifneq ($(strip $(C_UPPER_DEPS)),)
--include $(C_UPPER_DEPS)
-endif
-ifneq ($(strip $(CXX_DEPS)),)
--include $(CXX_DEPS)
-endif
-ifneq ($(strip $(CPP_DEPS)),)
--include $(CPP_DEPS)
-endif
-ifneq ($(strip $(C_DEPS)),)
--include $(C_DEPS)
-endif
-endif
-
--include ../makefile.defs
-
-# Add inputs and outputs from these tool invocations to the build variables 
-
-# All Target
-all: 
-
-# Tool invocations
-: $(OBJS) $(USER_OBJS)
-	@echo 'Building target: $@'
-	@echo 'Invoking: MinGW C++ Linker'
-	g++  -o  $(OBJS) $(USER_OBJS) $(LIBS)
-	@echo 'Finished building target: $@'
-	@echo ' '
-
-# Other Targets
-clean:
-	-$(RM) $(CC_DEPS)$(C++_DEPS)$(EXECUTABLES)$(OBJS)$(C_UPPER_DEPS)$(CXX_DEPS)$(CPP_DEPS)$(C_DEPS) 
-	-@echo ' '
-
-.PHONY: all clean dependents
-
--include ../makefile.targets
diff --git a/src/Default/mpi/subdir.mk b/src/Default/mpi/subdir.mk
deleted file mode 100644
index 29205625..00000000
--- a/src/Default/mpi/subdir.mk
+++ /dev/null
@@ -1,44 +0,0 @@
-################################################################################
-# Automatically-generated file. Do not edit!
-################################################################################
-
-# Add inputs and outputs from these tool invocations to the build variables 
-O_SRCS += \
-../mpi/ADDAmain.o \
-../mpi/CalculateE.o \
-../mpi/GenerateB.o \
-../mpi/Romberg.o \
-../mpi/calculator.o \
-../mpi/chebyshev.o \
-../mpi/comm.o \
-../mpi/crosssec.o \
-../mpi/d07hre.o \
-../mpi/d09hre.o \
-../mpi/d113re.o \
-../mpi/d132re.o \
-../mpi/dadhre.o \
-../mpi/dchhre.o \
-../mpi/dcuhre.o \
-../mpi/dfshre.o \
-../mpi/dinhre.o \
-../mpi/drlhre.o \
-../mpi/dtrhre.o \
-../mpi/fft.o \
-../mpi/interaction.o \
-../mpi/io.o \
-../mpi/iterative.o \
-../mpi/linalg.o \
-../mpi/make_particle.o \
-../mpi/matvec.o \
-../mpi/memory.o \
-../mpi/mt19937ar.o \
-../mpi/param.o \
-../mpi/propaesplibreintadda.o \
-../mpi/sinint.o \
-../mpi/somnec.o \
-../mpi/timing.o \
-../mpi/vars.o 
-
-
-# Each subdirectory must supply rules for building sources it contributes
-
diff --git a/src/Default/objects.mk b/src/Default/objects.mk
deleted file mode 100644
index 742c2da0..00000000
--- a/src/Default/objects.mk
+++ /dev/null
@@ -1,8 +0,0 @@
-################################################################################
-# Automatically-generated file. Do not edit!
-################################################################################
-
-USER_OBJS :=
-
-LIBS :=
-
diff --git a/src/Default/ocl/subdir.mk b/src/Default/ocl/subdir.mk
deleted file mode 100644
index f92ada69..00000000
--- a/src/Default/ocl/subdir.mk
+++ /dev/null
@@ -1,45 +0,0 @@
-################################################################################
-# Automatically-generated file. Do not edit!
-################################################################################
-
-# Add inputs and outputs from these tool invocations to the build variables 
-O_SRCS += \
-../ocl/ADDAmain.o \
-../ocl/CalculateE.o \
-../ocl/GenerateB.o \
-../ocl/Romberg.o \
-../ocl/calculator.o \
-../ocl/chebyshev.o \
-../ocl/comm.o \
-../ocl/crosssec.o \
-../ocl/d07hre.o \
-../ocl/d09hre.o \
-../ocl/d113re.o \
-../ocl/d132re.o \
-../ocl/dadhre.o \
-../ocl/dchhre.o \
-../ocl/dcuhre.o \
-../ocl/dfshre.o \
-../ocl/dinhre.o \
-../ocl/drlhre.o \
-../ocl/dtrhre.o \
-../ocl/fft.o \
-../ocl/interaction.o \
-../ocl/io.o \
-../ocl/iterative.o \
-../ocl/linalg.o \
-../ocl/make_particle.o \
-../ocl/memory.o \
-../ocl/mt19937ar.o \
-../ocl/oclcore.o \
-../ocl/oclmatvec.o \
-../ocl/param.o \
-../ocl/propaesplibreintadda.o \
-../ocl/sinint.o \
-../ocl/somnec.o \
-../ocl/timing.o \
-../ocl/vars.o 
-
-
-# Each subdirectory must supply rules for building sources it contributes
-
diff --git a/src/Default/seq/subdir.mk b/src/Default/seq/subdir.mk
deleted file mode 100644
index cbefc6e9..00000000
--- a/src/Default/seq/subdir.mk
+++ /dev/null
@@ -1,44 +0,0 @@
-################################################################################
-# Automatically-generated file. Do not edit!
-################################################################################
-
-# Add inputs and outputs from these tool invocations to the build variables 
-O_SRCS += \
-../seq/ADDAmain.o \
-../seq/CalculateE.o \
-../seq/GenerateB.o \
-../seq/Romberg.o \
-../seq/calculator.o \
-../seq/chebyshev.o \
-../seq/comm.o \
-../seq/crosssec.o \
-../seq/d07hre.o \
-../seq/d09hre.o \
-../seq/d113re.o \
-../seq/d132re.o \
-../seq/dadhre.o \
-../seq/dchhre.o \
-../seq/dcuhre.o \
-../seq/dfshre.o \
-../seq/dinhre.o \
-../seq/drlhre.o \
-../seq/dtrhre.o \
-../seq/fft.o \
-../seq/interaction.o \
-../seq/io.o \
-../seq/iterative.o \
-../seq/linalg.o \
-../seq/make_particle.o \
-../seq/matvec.o \
-../seq/memory.o \
-../seq/mt19937ar.o \
-../seq/param.o \
-../seq/propaesplibreintadda.o \
-../seq/sinint.o \
-../seq/somnec.o \
-../seq/timing.o \
-../seq/vars.o 
-
-
-# Each subdirectory must supply rules for building sources it contributes
-
diff --git a/src/Default/sources.mk b/src/Default/sources.mk
deleted file mode 100644
index adbfb64f..00000000
--- a/src/Default/sources.mk
+++ /dev/null
@@ -1,31 +0,0 @@
-################################################################################
-# Automatically-generated file. Do not edit!
-################################################################################
-
-C_UPPER_SRCS := 
-CXX_SRCS := 
-C++_SRCS := 
-OBJ_SRCS := 
-CC_SRCS := 
-ASM_SRCS := 
-CPP_SRCS := 
-C_SRCS := 
-S_UPPER_SRCS := 
-O_SRCS := 
-CC_DEPS := 
-C++_DEPS := 
-EXECUTABLES := 
-OBJS := 
-C_UPPER_DEPS := 
-CXX_DEPS := 
-CPP_DEPS := 
-C_DEPS := 
-
-# Every subdirectory with source files must be described here
-SUBDIRS := \
-. \
-cpp \
-mpi \
-ocl \
-seq \
-
diff --git a/src/Default/subdir.mk b/src/Default/subdir.mk
deleted file mode 100644
index 442b1d97..00000000
--- a/src/Default/subdir.mk
+++ /dev/null
@@ -1,99 +0,0 @@
-################################################################################
-# Automatically-generated file. Do not edit!
-################################################################################
-
-# Add inputs and outputs from these tool invocations to the build variables 
-C_SRCS += \
-../ADDAmain.c \
-../CalculateE.c \
-../GenerateB.c \
-../Romberg.c \
-../calculator.c \
-../chebyshev.c \
-../comm.c \
-../crosssec.c \
-../debug.c \
-../fft.c \
-../interaction.c \
-../io.c \
-../iterative.c \
-../linalg.c \
-../make_particle.c \
-../matvec.c \
-../memory.c \
-../mt19937ar.c \
-../oclcore.c \
-../oclmatvec.c \
-../param.c \
-../prec_time.c \
-../sinint.c \
-../somnec.c \
-../timing.c \
-../vars.c 
-
-OBJS += \
-./ADDAmain.o \
-./CalculateE.o \
-./GenerateB.o \
-./Romberg.o \
-./calculator.o \
-./chebyshev.o \
-./comm.o \
-./crosssec.o \
-./debug.o \
-./fft.o \
-./interaction.o \
-./io.o \
-./iterative.o \
-./linalg.o \
-./make_particle.o \
-./matvec.o \
-./memory.o \
-./mt19937ar.o \
-./oclcore.o \
-./oclmatvec.o \
-./param.o \
-./prec_time.o \
-./sinint.o \
-./somnec.o \
-./timing.o \
-./vars.o 
-
-C_DEPS += \
-./ADDAmain.d \
-./CalculateE.d \
-./GenerateB.d \
-./Romberg.d \
-./calculator.d \
-./chebyshev.d \
-./comm.d \
-./crosssec.d \
-./debug.d \
-./fft.d \
-./interaction.d \
-./io.d \
-./iterative.d \
-./linalg.d \
-./make_particle.d \
-./matvec.d \
-./memory.d \
-./mt19937ar.d \
-./oclcore.d \
-./oclmatvec.d \
-./param.d \
-./prec_time.d \
-./sinint.d \
-./somnec.d \
-./timing.d \
-./vars.d 
-
-
-# Each subdirectory must supply rules for building sources it contributes
-%.o: ../%.c
-	@echo 'Building file: $<'
-	@echo 'Invoking: GCC C Compiler'
-	gcc -O2 -g -Wall -c -fmessage-length=0 -MMD -MP -MF"$(@:%.o=%.d)" -MT"$(@)" -o "$@" "$<"
-	@echo 'Finished building: $<'
-	@echo ' '
-
-
diff --git a/src/GenerateB.c b/src/GenerateB.c
index 0853e254..4cf21383 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -75,6 +75,7 @@ static doublecomplex ktVec[3]; // k_tran/k0
 static double p0;              // amplitude of the incident dipole moment
 static int n0;                 // Bessel beam order
 static double alpha0;          // half-cone angle
+static double hvp[8];		   // Hertz vector potentials' components
 /* TO ADD NEW BEAM
  * Add here all internal variables (beam parameters), which you initialize in InitBeam() and use in GenerateB()
  * afterwards. If you need local, intermediate variables, put them into the beginning of the corresponding function.
@@ -87,6 +88,7 @@ void InitBeam(void)
 // initialize beam; produce description string
 {
 	double w0; // beam width
+	int n_par; // for besselGen
 	/* TO ADD NEW BEAM
 	 * Add here all intermediate variables, which are used only inside this function.
 	 */
@@ -191,16 +193,25 @@ void InitBeam(void)
 			}
 			return;
 		case B_BESSELCS:
+		case B_BESSELGEN:
 		case B_BESSELLE:
 		case B_BESSELLM:
 		case B_BESSELTEC:
 		case B_BESSELTMC:
 			if (surface) PrintError("Currently, Bessel incident beam is not supported for '-surf'");
 			// initialize parameters
-			n0=round(beam_pars[0]);
-			alpha0 = beam_pars[1];
-			vCopy(beam_pars+2,beam_center_0);
-			beam_asym=(beam_Npars==5 && (beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0));
+			if (beamtype==B_BESSELGEN) {
+				n_par = 8;
+				hvp[0] = beam_pars[0]; hvp[1] = beam_pars[1];
+				hvp[2] = beam_pars[2]; hvp[3] = beam_pars[3];
+				hvp[4] = beam_pars[4]; hvp[5] = beam_pars[5];
+				hvp[6] = beam_pars[6]; hvp[7] = beam_pars[7];
+			}
+			else n_par = 0;
+			n0=round(beam_pars[0 + n_par]);
+			alpha0 = beam_pars[1 + n_par];
+			vCopy(beam_pars+2 + n_par,beam_center_0);
+			beam_asym=(beam_Npars==(5 + n_par) && (beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0));
 			symR=symX=symY=symZ=FALSE;
 			if (!beam_asym) vInit(beam_center);
 			if (IFROOT) {
@@ -209,6 +220,9 @@ void InitBeam(void)
 					case B_BESSELCS:
 						strcat(beam_descr,"circularly symmetric energy density)\n");
 						break;
+					case B_BESSELGEN:
+						strcat(beam_descr,"generalized)\n");
+						break;
 					case B_BESSELLE:
 						strcat(beam_descr,"linear electric field)\n");
 						break;
@@ -273,7 +287,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 	doublecomplex psi0,Q,Q2;
 	doublecomplex v1[3],v2[3],v3[3],gt[6];
 	double ro, ro2,ro4;
-	double x,y,z,x2_s,xy_s,phi,arg,td1[n0+2],td2[n0+2],jn1[n0+2];
+	double x,y,z,x2_s,xy_s,phi,arg,td1[n0+2],td2[n0+2],jn1[n0+2],p[4][2];
 	doublecomplex t1,t2,t3,t4,t5,t6,t7,t8,ctemp;
 	const double *ex; // coordinate axis of the beam reference frame
 	double ey[3];
@@ -470,6 +484,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				}
 			}
 			return;
+		/*
 		case B_BESSELCS:
 		case B_BESSELLE:
 		case B_BESSELLM:
@@ -486,9 +501,9 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				phi=atan2(y,x);	// angular coordinate in a cylindrical coordinate system
 				t1=WaveNum*sin(alpha0);
 				t2=WaveNum*cos(alpha0);
-				// common factor 
-				ctemp=cpow(-I,n0)*cexp(I*n0*phi)*cexp(I*t2*z)/WaveNum/WaveNum;
-				// t3,t4,t5 - x,y,z field components are described in the doc file "Bessel beam fields" (in the doc folder) 
+				// common factor
+				ctemp=cpow(I,n0)*cexp(I*n0*phi)*cexp(I*t2*z)/WaveNum/WaveNum;
+				// t3,t4,t5 - x,y,z field components are described in the doc file "Bessel beam fields" (in the doc folder)
 				if (n0==0){
 					if (ro==0){
 						switch (beamtype) {
@@ -519,7 +534,6 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 								break;
 							default: break;
 						}
-
 					}
 					else{
 						arg=ro*WaveNum*sin(alpha0);
@@ -542,13 +556,13 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 								t4= 0.125*(
 										jn2[1]*4*t1/ro*sin(2*phi) +
 										jn2[0]*(pow(WaveNum,2)*(cos(2*alpha0)-1)*sin(2*phi)));
-								t5= 0.5*I*(WaveNum+t2)*cexp(-I*phi)*(
-										jn2[1]*cexp(I*phi)*t1*cos(phi));
+								t5= -0.5*I*(WaveNum+t2)*
+										jn2[1]*t1*cos(phi);
 								break;
 							case B_BESSELLE:
 								t3= jn2[0]*t2*WaveNum;
 								t4= 0;
-								t5= WaveNum*I*jn2[1]*t1*cos(phi);
+								t5= -WaveNum*I*jn2[1]*t1*cos(phi);
 								break;
 							case B_BESSELLM:
 								t3= jn2[1]*t1/ro*(-sin(2*phi)) +
@@ -557,7 +571,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 										jn2[1]*4*t1/ro*cos(2*phi) -
 										jn2[0]*(cpow(WaveNum,2)*cos(2*phi)+
 												cpow(WaveNum,2)*(3+2*cos(2*alpha0)*pow(sin(phi),2))));
-								t5= -t2*jn2[1]*I*t1*sin(phi);
+								t5= t2*jn2[1]*I*t1*sin(phi);
 								break;
 							case B_BESSELTEC:
 								t3= 0.5/ro2*cexp(-2*I*phi)*(
@@ -567,7 +581,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 								t4= -1./ro2/4.*(
 										jn2[1]*4*WaveNum*ro*cos(2*phi) -
 										jn2[0]/sin(alpha0)*(cpow(WaveNum*ro,2)*(3 + 2*cos(2*alpha0)*pow(sin(phi),2))));
-								t5= -1./ro/tan(alpha0)*WaveNum*cexp(-I*phi)*(
+								t5= 1./ro/tan(alpha0)*WaveNum*cexp(-I*phi)*(
 										jn2[1]*ro*t1);
 								break;
 							case B_BESSELTMC:
@@ -578,7 +592,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 										jn2[1]*t1*ro*cos(2*phi) -
 										jn2[0]/4.*((cpow(WaveNum*ro,2))*cos(2*phi) +
 												cpow(WaveNum*ro,2)*(3 + 2*cos(2*alpha0)*pow(sin(phi),2))));
-								t5= 0.5*I*WaveNum*(
+								t5= -0.5*I*WaveNum*(
 										-jn2[1]*2*WaveNum*(cos(phi) - I*pow(cos(alpha0),2)*sin(phi)));
 								break;
 								default: break;
@@ -610,14 +624,14 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 								t4= 0.125*(
 										jn2[1]*4*t1/ro*(-I*n0*cos(2*phi)+sin(2*phi)) +
 										jn2[0]*(pow(WaveNum,2)*(cos(2*alpha0)-1)*sin(2*phi)));
-								t5= 0.5*I*(WaveNum+t2)*cexp(-I*phi)*(
+								t5= -0.5*I*(WaveNum+t2)*cexp(-I*phi)*(
 										jn2[1]*cexp(I*phi)*t1*cos(phi) -
 										jn2[0]*n0/ro);
 								break;
 							case B_BESSELLE:
 								t3= jn2[0]*t2*WaveNum;
 								t4= 0;
-								t5= WaveNum*I*(
+								t5= -WaveNum*I*(
 										jn2[1]*t1*cos(phi) -
 										jn2[0]*cexp(-I*phi)/ro*n0);
 								break;
@@ -628,7 +642,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 										jn2[1]*4*t1/ro*(cos(2*phi)+I*n0*sin(2*phi)) -
 										jn2[0]*(cpow(WaveNum,2)*cos(2*phi)+
 												cpow(WaveNum,2)*(3+2*cos(2*alpha0)*pow(sin(phi),2))));
-								t5= -t2*(
+								t5= t2*(
 										jn2[1]*I*t1*sin(phi) +
 										jn2[0]/ro*n0*cexp(-I*phi));
 								break;
@@ -640,7 +654,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 								t4= -1./ro2/4.*(
 										jn2[1]*4*WaveNum*ro*(cos(2*phi) + I*n0*sin(2*phi)) -
 										jn2[0]/sin(alpha0)*(cpow(WaveNum*ro,2)*(3 + 2*cos(2*alpha0)*pow(sin(phi),2))));
-								t5= -1./ro/tan(alpha0)*WaveNum*cexp(-I*phi)*(
+								t5= 1./ro/tan(alpha0)*WaveNum*cexp(-I*phi)*(
 										jn2[1]*ro*t1 -
 										jn2[0]*2*n0);
 								break;
@@ -652,7 +666,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 										jn2[1]*t1*ro*(cos(2*phi) + I*n0*sin(2*phi)) -
 										jn2[0]/4.*((cpow(WaveNum*ro,2))*cos(2*phi) +
 												cpow(WaveNum*ro,2)*(3 + 2*cos(2*alpha0)*pow(sin(phi),2))));
-								t5= 0.5*I*WaveNum*(
+								t5= -0.5*I*WaveNum*(
 										-jn2[1]*2*WaveNum*(cos(phi) - I*pow(cos(alpha0),2)*sin(phi)) +
 										 jn2[0]*n0*cexp(-I*phi)/ro*(3+cos(2*alpha0))/sin(alpha0));
 								break;
@@ -708,14 +722,14 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 										jn2[1]*4*t1/ro*(-I*n0*cos(2*phi)+sin(2*phi)) +
 										jn2[0]*(4*I*(n0-1)*n0/ro2*cos(2*phi)+(4*(n0-1)*n0/ro2 +
 												pow(WaveNum,2)*(cos(2*alpha0)-1))*sin(2*phi)));
-								t5= 0.5*I*(WaveNum+t2)*cexp(-I*phi)*(
-										jn2[1]*cexp(I*phi)*t1*cos(phi) -
-										jn2[0]*n0/ro);
+								t5= -0.5*I*(WaveNum+t2)*(
+										jn2[1]*t1*cos(phi) -
+										jn2[0]*cexp(-I*phi)*n0/ro);
 								break;
 							case B_BESSELLE:
 								t3= jn2[0]*t2*WaveNum;
 								t4= 0;
-								t5= WaveNum*I*(
+								t5= -WaveNum*I*(
 										jn2[1]*t1*cos(phi) -
 										jn2[0]*cexp(-I*phi)/ro*n0);
 								break;
@@ -728,7 +742,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 										jn2[0]*((-4*(n0-1)*n0/ro2 + cpow(WaveNum,2))*cos(2*phi) +
 												cpow(WaveNum,2)*(3+2*cos(2*alpha0)*pow(sin(phi),2)) +
 												4*I*(n0-1)*n0/ro2*sin(2*phi)));
-								t5= -t2*(
+								t5= t2*(
 										jn2[1]*I*t1*sin(phi) +
 										jn2[0]/ro*n0*cexp(-I*phi));
 								break;
@@ -743,7 +757,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 										jn2[0]/sin(alpha0)*((-4*(n0-1)*n0+cpow(WaveNum*ro,2))*cos(2*phi) +
 												cpow(WaveNum*ro,2)*(3 + 2*cos(2*alpha0)*pow(sin(phi),2)) +
 												4*I*(n0-1)*n0*sin(2*phi)));
-								t5= -1./ro/tan(alpha0)*WaveNum*cexp(-I*phi)*(
+								t5= 1./ro/tan(alpha0)*WaveNum*cexp(-I*phi)*(
 										jn2[1]*ro*t1 -
 										jn2[0]*2*n0);
 								break;
@@ -757,7 +771,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 										jn2[0]/4.*((-4*(n0-1)*n0+cpow(WaveNum*ro,2))*cos(2*phi) +
 												cpow(WaveNum*ro,2)*(3 + 2*cos(2*alpha0)*pow(sin(phi),2)) +
 												4*I*(n0-1)*n0*sin(2*phi)));
-								t5= 0.5*I*WaveNum*(
+								t5= -0.5*I*WaveNum*(
 										-jn2[1]*2*WaveNum*(cos(phi) - I*pow(cos(alpha0),2)*sin(phi)) +
 										 jn2[0]*n0*cexp(-I*phi)/ro*(3+cos(2*alpha0))/sin(alpha0));
 								break;
@@ -772,6 +786,114 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				cvMultScal_cmplx(ctemp,v1,b+j);
 			}
 			return;
+		*/
+		case B_BESSELCS:
+		case B_BESSELGEN:
+		case B_BESSELLE:
+		case B_BESSELLM:
+		case B_BESSELTEC:
+		case B_BESSELTMC:
+			for (i=0;i<local_nvoid_Ndip;i++) {
+				j=3*i;
+				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
+				x=DotProd(r1,ex);
+				y=DotProd(r1,ey);
+				z=DotProd(r1,prop);
+				ro2=x*x+y*y;
+				ro=sqrt(ro2);	// radial distance in a cylindrical coordinate system
+				phi=atan2(y,x);	// angular coordinate in a cylindrical coordinate system
+				t1=WaveNum*sin(alpha0);
+				t2=WaveNum*cos(alpha0);
+				// common factor
+				ctemp=cpow(I,n0)*cexp(I*n0*phi)*cexp(I*t2*z)/WaveNum/WaveNum;
+
+				arg=ro*WaveNum*sin(alpha0);
+				if (arg<ROUND_ERR){
+					jn2[0]=0.0;
+					jn2[1]=0.0;
+				}
+				else {
+					n1=n0+1;
+					bjndd_(&n1, &arg, jn1, td1, td2);
+					jn2[0]=jn1[n0];
+					jn2[1]=jn1[n0+1];
+				}
+				switch (beamtype) {
+					case B_BESSELCS:
+						p[0][0]=0.5; p[0][1]=0;		p[1][0]=0; p[1][1]=0;
+						p[2][0]=0; p[2][1]=0; 		p[3][0]=0.5; p[3][1]=0;
+						break;
+					case B_BESSELGEN:
+						p[0][0]=0.5; p[0][1]=0;		p[1][0]=0; p[1][1]=0;
+						p[2][0]=0; p[2][1]=0; 		p[3][0]=0.5; p[3][1]=0;
+						break;
+					case B_BESSELLE:
+						p[0][0]=0; p[0][1]=0;	p[1][0]=0; p[1][1]=0;
+						p[2][0]=0; p[2][1]=0; 	p[3][0]=1.; p[3][1]=0;
+						break;
+					case B_BESSELLM:
+						p[0][0]=0; p[0][1]=0;	p[1][0]=-1.; p[1][1]=0;
+						p[2][0]=0; p[2][1]=0; 	p[3][0]=0; p[3][1]=0;
+						break;
+					case B_BESSELTEC:
+						p[0][0]=0; p[0][1]=0; 	p[1][0]=1./sin(alpha0); p[1][1]=0;
+						p[2][0]=0; p[2][1]=0; 	p[3][0]=0; p[3][1]=1./tan(alpha0);
+						break;
+					case B_BESSELTMC:
+						p[0][0]=0; p[0][1]=0; 	p[1][0]=0; p[1][1]=1./tan(alpha0);
+						p[2][0]=0; p[2][1]=0; 	p[3][0]=-1./sin(alpha0); p[3][1]=0;
+						break;
+					default: break;
+				}
+				t3 = 0; t4 = 0; t5 = 0;
+				if ((fabs(p[0][0])>=ROUND_ERR) || (fabs(p[0][1])>=ROUND_ERR)) {		//Pex - LMy
+					t3 += (p[0][0]+I*p[0][1])*0.25*(
+							jn2[1]*4.*t1/ro*(cos(2*phi)+I*n0*sin(2*phi)) +
+							jn2[0]*(4.*(n0-1)*n0/ro2*cexp(-2*I*phi) +
+									cpow(WaveNum,2)*(3+cos(2*alpha0)-2*cos(2*phi)*pow(sin(alpha0),2))));
+					t4 += (p[0][0]+I*p[0][1])*(
+							jn2[1]*t1/ro*(-I*n0*cos(2*phi)+sin(2*phi)) +
+							jn2[0]/ro2*(I*(n0-1)*n0*pow(cos(phi),2)+0.5*sin(2*phi)*(2*(n0-1)*n0 -
+								cpow(WaveNum*ro,2)*pow(sin(alpha0),2)) - I*(n0-1)*n0*pow(sin(phi),2)));
+					t5 += (p[0][0]+I*p[0][1])*t2*I*(
+							-jn2[1]*t1*cos(phi) +
+							 jn2[0]/ro*n0*cexp(-I*phi));
+				}
+				if ((fabs(p[1][0])>=ROUND_ERR) || (fabs(p[1][1])>=ROUND_ERR)) {		//Pey - LMx
+					t3 += -(p[1][0]+I*p[1][1])*(
+							jn2[1]*t1/ro*(I*n0*cos(2*phi)-sin(2*phi)) +
+							jn2[0]/ro2*(-I*(n0-1)*n0*pow(cos(phi),2)+0.5*sin(2*phi)*(-2*(n0-1)*n0 +
+							cpow(WaveNum*ro,2)*pow(sin(alpha0),2)) + I*(n0-1)*n0*pow(sin(phi),2)));
+					t4 += -(p[1][0]+I*p[1][1])*(
+							jn2[1]*t1/ro*(cos(2*phi)+I*n0*sin(2*phi)) -
+							jn2[0]*(pow(cos(phi),2)*(-(n0-1)*n0/ro2 + cpow(WaveNum,2)) +
+								pow(sin(phi),2)*((n0-1)*n0/ro2 + cpow(WaveNum,2)*pow(cos(alpha0),2)) +
+								I*(n0-1)*n0/ro2*sin(2*phi)));
+					t5 += -(p[1][0]+I*p[1][1])*t2*(
+							jn2[1]*I*t1*sin(phi) +
+							jn2[0]/ro*n0*cexp(-I*phi));
+				}
+				if ((fabs(p[2][0])>=ROUND_ERR) || (fabs(p[2][1])>=ROUND_ERR)) { 	//Pmx - LEy
+					t3 += 0;
+					t4 += -(p[2][0]+I*p[2][1])*jn2[0]*t2*WaveNum;
+					t5 += -(p[2][0]+I*p[2][1])*WaveNum*(
+							-jn2[1]*I*t1*sin(phi) -
+							 jn2[0]*cexp(-I*phi)/ro*n0);
+				}
+				if ((fabs(p[3][0])>=ROUND_ERR) || (fabs(p[3][1])>=ROUND_ERR)) {		//Pmy - LEx
+					t3 += (p[3][0]+I*p[3][1])*jn2[0]*t2*WaveNum;
+					t4 += 0;
+					t5 += (p[3][0]+I*p[3][1])*WaveNum*I*(
+							-jn2[1]*t1*cos(phi) +
+							 jn2[0]*cexp(-I*phi)/ro*n0);
+				}
+				cvMultScal_RVec(t3,ex,v1);
+				cvMultScal_RVec(t4,ey,v2);
+				cvMultScal_RVec(t5,prop,v3);
+				cvAdd2Self(v1,v2,v3);
+				cvMultScal_cmplx(ctemp,v1,b+j);
+			}
+			return;
 		case B_READ:
 			if (which==INCPOL_Y) fname=beam_fnameY;
 			else fname=beam_fnameX; // which==INCPOL_X
diff --git a/src/const.h b/src/const.h
index 85f876e7..7b362da1 100644
--- a/src/const.h
+++ b/src/const.h
@@ -279,6 +279,7 @@ enum incpol {
 enum beam { // beam types
 	B_BARTON5, // 5th order description of the Gaussian beam
 	B_BESSELCS, // Bessel beam with circularly symmetric energy density
+	B_BESSELGEN, // Generalized Bessel beam
 	B_BESSELLE, // Bessel beam with linearly polarized electric field
 	B_BESSELLM, // Bessel beam with linearly polarized magnetic field
 	B_BESSELTEC, // Bessel beam forming TE Bessel beam 
diff --git a/src/fort/special_functions.f90 b/src/fort/special_functions.f90
index 6428ffaa..674d693f 100644
--- a/src/fort/special_functions.f90
+++ b/src/fort/special_functions.f90
@@ -1,25000 +1,8 @@
-subroutine airya ( x, ai, bi, ad, bd )
-
-!*****************************************************************************80
-!
-!! AIRYA computes Airy functions and their derivatives.
-!
-!  Licensing:
-!
-!    The original FORTRAN77 version of this routine is copyrighted by 
-!    Shanjie Zhang and Jianming Jin.  However, they give permission to 
-!    incorporate this routine into a user program that the copyright 
-!    is acknowledged.
-!
-!  Modified:
-!
-!    30 June 2012
-!
-!  Author:
-!
-!    Original FORTRAN77 version by Shanjie Zhang, Jianming Jin.
-!    FORTRAN90 version by John Burkardt.
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!       
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument of the Airy function.
-!
-!    Output, real ( kind = 8 ) AI, BI, AD, BD, the values of Ai(x), Bi(x),
-!    Ai'(x), Bi'(x).
-!
-  implicit none
-
-  real ( kind = 8 ) ad
-  real ( kind = 8 ) ai
-  real ( kind = 8 ) bd
-  real ( kind = 8 ) bi
-  real ( kind = 8 ) c1
-  real ( kind = 8 ) c2
-  real ( kind = 8 ) pir
-  real ( kind = 8 ) sr3
-  real ( kind = 8 ) vi1
-  real ( kind = 8 ) vi2
-  real ( kind = 8 ) vj1
-  real ( kind = 8 ) vj2
-  real ( kind = 8 ) vk1
-  real ( kind = 8 ) vk2
-  real ( kind = 8 ) vy1
-  real ( kind = 8 ) vy2
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xa
-  real ( kind = 8 ) xq
-  real ( kind = 8 ) z
-
-  xa = abs ( x )
-  pir = 0.318309886183891D+00
-  c1 = 0.355028053887817D+00
-  c2 = 0.258819403792807D+00
-  sr3 = 1.732050807568877D+00
-  z = xa ** 1.5D+00 / 1.5D+00
-  xq = sqrt ( xa )
-
-  call ajyik ( z, vj1, vj2, vy1, vy2, vi1, vi2, vk1, vk2 )
-
-  if ( x == 0.0D+00 ) then
-    ai = c1
-    bi = sr3 * c1
-    ad = - c2
-    bd = sr3 * c2
-  else if ( 0.0D+00 < x ) then
-    ai = pir * xq / sr3 * vk1
-    bi = xq * ( pir * vk1 + 2.0D+00 / sr3 * vi1 )
-    ad = - xa / sr3 * pir * vk2
-    bd = xa * ( pir * vk2 + 2.0D+00 / sr3 * vi2 )
-  else
-    ai = 0.5D+00 * xq * ( vj1 - vy1 / sr3 )
-    bi = - 0.5D+00 * xq * ( vj1 / sr3 + vy1 )
-    ad = 0.5D+00 * xa * ( vj2 + vy2 / sr3 )
-    bd = 0.5D+00 * xa * ( vj2 / sr3 - vy2 )
-  end if
-
-  return
-end
-subroutine airyb ( x, ai, bi, ad, bd )
-
-!*****************************************************************************80
-!
-!! AIRYB computes Airy functions and their derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    02 June 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, argument of Airy function.
-!
-!    Output, real ( kind = 8 ) AI, Ai(x).
-!
-!    Output, real ( kind = 8 ) BI, Bi(x).
-!
-!    Output, real ( kind = 8 ) AD, Ai'(x).
-!
-!    Output, real ( kind = 8 ) BD, Bi'(x).
-!
-  implicit none
-
-  real ( kind = 8 ) ad
-  real ( kind = 8 ) ai
-  real ( kind = 8 ) bd
-  real ( kind = 8 ) bi
-  real ( kind = 8 ) c1
-  real ( kind = 8 ) c2
-  real ( kind = 8 ) ck(41)
-  real ( kind = 8 ) df
-  real ( kind = 8 ) dg
-  real ( kind = 8 ) dk(41)
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) fx
-  real ( kind = 8 ) gx
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) km
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r
-  real ( kind = 8 ) rp
-  real ( kind = 8 ) sad
-  real ( kind = 8 ) sai
-  real ( kind = 8 ) sbd
-  real ( kind = 8 ) sbi
-  real ( kind = 8 ) sda
-  real ( kind = 8 ) sdb
-  real ( kind = 8 ) sr3
-  real ( kind = 8 ) ssa
-  real ( kind = 8 ) ssb
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xa
-  real ( kind = 8 ) xar
-  real ( kind = 8 ) xcs
-  real ( kind = 8 ) xe
-  real ( kind = 8 ) xf
-  real ( kind = 8 ) xm
-  real ( kind = 8 ) xp1
-  real ( kind = 8 ) xq
-  real ( kind = 8 ) xr1
-  real ( kind = 8 ) xr2
-  real ( kind = 8 ) xss
-
-  eps = 1.0D-15
-  pi = 3.141592653589793D+00
-  c1 = 0.355028053887817D+00
-  c2 = 0.258819403792807D+00
-  sr3 = 1.732050807568877D+00
-  xa = abs ( x )
-  xq = sqrt ( xa )
-
-  if ( x <= 0.0D+00 ) then
-    xm = 8.0D+00
-  else
-    xm = 5.0D+00
-  end if
-
-  if ( x == 0.0D+00 ) then
-    ai = c1
-    bi = sr3 * c1
-    ad = -c2
-    bd = sr3 * c2
-    return
-  end if
-
-  if ( xa <= xm ) then
-
-    fx = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 40
-      r = r * x / ( 3.0D+00 * k ) * x / ( 3.0D+00 * k - 1.0D+00 ) * x
-      fx = fx + r
-      if ( abs ( r ) < abs ( fx ) * eps ) then
-        exit
-      end if
-    end do
-
-    gx = x
-    r = x
-    do k = 1, 40
-      r = r * x / ( 3.0D+00 * k ) * x / ( 3.0D+00 * k + 1.0D+00 ) * x
-      gx = gx + r
-      if ( abs ( r ) < abs ( gx ) * eps ) then
-        exit
-      end if
-    end do
-
-    ai = c1 * fx - c2 * gx
-    bi = sr3 * ( c1 * fx + c2 * gx )
-    df = 0.5D+00 * x * x
-    r = df
-    do k = 1, 40
-      r = r * x / ( 3.0D+00 * k ) * x / ( 3.0D+00 * k + 2.0D+00 ) * x
-      df = df + r 
-      if ( abs ( r ) < abs ( df ) * eps ) then
-        exit
-      end if
-    end do
-
-    dg = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 40
-      r = r * x / ( 3.0D+00 * k ) * x / ( 3.0D+00 * k - 2.0D+00 ) * x
-      dg = dg + r
-      if ( abs ( r ) < abs ( dg ) * eps ) then
-        exit
-      end if
-    end do
-
-    ad = c1 * df - c2 * dg
-    bd = sr3 * ( c1 * df + c2 * dg )
-
-  else
-
-    xe = xa * xq / 1.5D+00
-    xr1 = 1.0D+00 / xe
-    xar = 1.0D+00 / xq
-    xf = sqrt ( xar )
-    rp = 0.5641895835477563D+00
-    r = 1.0D+00
-    do k = 1, 40
-      r = r * ( 6.0D+00 * k - 1.0D+00 ) &
-        / 216.0D+00 * ( 6.0D+00 * k - 3.0D+00 ) &
-        / k * ( 6.0D+00 * k - 5.0D+00 ) / ( 2.0D+00 * k - 1.0D+00 )
-      ck(k) = r
-      dk(k) = - ( 6.0D+00 * k + 1.0D+00 ) / ( 6.0D+00 * k - 1.0D+00 ) * ck(k)
-    end do
-
-    km = int ( 24.5D+00 - xa )
-
-    if ( xa < 6.0D+00 ) then
-      km = 14
-    end if
-
-    if ( 15.0D+00 < xa ) then
-      km = 10
-    end if
-
-    if ( 0.0D+00 < x ) then
-      sai = 1.0D+00
-      sad = 1.0D+00
-      r = 1.0D+00
-      do k = 1, km
-        r = - r * xr1
-        sai = sai + ck(k) * r
-        sad = sad + dk(k) * r
-      end do
-      sbi = 1.0D+00
-      sbd = 1.0D+00
-      r = 1.0D+00
-      do k = 1, km
-        r = r * xr1
-        sbi = sbi + ck(k) * r
-        sbd = sbd + dk(k) * r
-      end do
-      xp1 = exp ( - xe )
-      ai = 0.5D+00 * rp * xf * xp1 * sai
-      bi = rp * xf / xp1 * sbi
-      ad = -0.5D+00 * rp / xf * xp1 * sad
-      bd = rp / xf / xp1 * sbd
-    else
-      xcs = cos ( xe + pi / 4.0D+00 )
-      xss = sin ( xe + pi / 4.0D+00 )
-      ssa = 1.0D+00
-      sda = 1.0D+00
-      r = 1.0D+00
-      xr2 = 1.0D+00 / ( xe * xe )
-      do k = 1, km
-        r = - r * xr2
-        ssa = ssa + ck(2*k) * r
-        sda = sda + dk(2*k) * r
-      end do
-      ssb = ck(1) * xr1
-      sdb = dk(1) * xr1
-      r = xr1
-      do k = 1, km
-        r = - r * xr2
-        ssb = ssb + ck(2*k+1) * r
-        sdb = sdb + dk(2*k+1) * r
-      end do
-      ai = rp * xf * ( xss * ssa - xcs * ssb )
-      bi = rp * xf * ( xcs * ssa + xss * ssb )
-      ad = -rp / xf * ( xcs * sda + xss * sdb )
-      bd =  rp / xf * ( xss * sda - xcs * sdb )
-    end if
-
-  end if
-
-  return
-end
-subroutine airyzo ( nt, kf, xa, xb, xc, xd )
-
-!*****************************************************************************80
-!
-!! AIRYZO computes the first NT zeros of Ai(x) and Ai'(x).
-!
-!   Discussion:
-!
-!    Compute the first NT zeros of Airy functions Ai(x) and Ai'(x), 
-!    a and a', and the associated values of Ai(a') and Ai'(a); and 
-!    the first NT zeros of Airy functions Bi(x) and Bi'(x), b and
-!    b', and the associated values of Bi(b') and Bi'(b).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    14 March 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) NT, the number of zeros.
-!
-!    Input, integer ( kind = 4 ) KF, the function code.
-!    1 for Ai(x) and Ai'(x);
-!    2 for Bi(x) and Bi'(x).
-!
-!    Output, real ( kind = 8 ) XA(m), a, the m-th zero of Ai(x) or
-!    b, the m-th zero of Bi(x).
-!
-!    Output, real ( kind = 8 ) XB(m), a', the m-th zero of Ai'(x) or
-!    b', the m-th zero of Bi'(x).
-!
-!    Output, real ( kind = 8 ) XC(m), Ai(a') or Bi(b').
-!
-!    Output, real ( kind = 8 ) XD(m), Ai'(a) or Bi'(b)
-!
-  implicit none
-
-  integer ( kind = 4 ) nt
-
-  real ( kind = 8 ) ad
-  real ( kind = 8 ) ai
-  real ( kind = 8 ) bd
-  real ( kind = 8 ) bi
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) kf
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) rt
-  real ( kind = 8 ) rt0
-  real ( kind = 8 ) u
-  real ( kind = 8 ) u1
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xa(nt)
-  real ( kind = 8 ) xb(nt)
-  real ( kind = 8 ) xc(nt)
-  real ( kind = 8 ) xd(nt)
-
-  pi = 3.141592653589793D+00
-
-  do i = 1, nt
-
-    if (kf == 1) then
-      u = 3.0D+00 * pi * ( 4.0D+00 * i - 1 ) / 8.0D+00
-      u1 = 1.0D+00 / ( u * u )
-      rt0 = - ( u * u ) ** ( 1.0 / 3.0 ) &
-        * (((( -15.5902D+00 * u1 + 0.929844D+00 ) * u1 &
-        - 0.138889D+00 ) * u1 + 0.10416667D+00 ) * u1 + 1.0D+00 )
-    else if ( kf == 2 ) then
-      if ( i == 1 ) then
-        rt0 = -1.17371D+00
-      else
-        u = 3.0D+00 * pi * ( 4.0D+00 * i - 3.0D+00 ) / 8.0D+00
-        u1 = 1.0D+00 / ( u * u )
-        rt0 = - ( u * u ) ** ( 1.0D+00 / 3.0D+00 ) &
-          * (((( -15.5902D+00 * u1 + 0.929844D+00 ) * u1 &
-          - 0.138889D+00 ) * u1 + 0.10416667D+00 ) * u1 + 1.0D+00 )
-      end if
-    end if
-
-    do
-
-      x = rt0
-      call airyb ( x, ai, bi, ad, bd )
-
-      if ( kf == 1 ) then
-        rt = rt0 - ai / ad
-      else
-        rt = rt0 - bi / bd
-      end if
-
-      if ( abs ( ( rt - rt0 ) / rt ) <= 1.0D-09 ) then
-        exit
-      end if
-      rt0 = rt
-
-    end do
-
-    xa(i) = rt
-    if ( kf == 1 ) then
-      xd(i) = ad
-    else
-      xd(i) = bd
-    end if
-
-  end do
-
-  do i = 1, nt
-
-    if ( kf == 1 ) then
-      if ( i == 1 ) then
-        rt0 = -1.01879D+00
-      else
-        u = 3.0D+00 * pi * ( 4.0D+00 * i - 3.0D+00 ) / 8.0D+00
-        u1 = 1.0D+00 / ( u * u )
-        rt0 = - ( u * u ) ** ( 1.0D+00 / 3.0D+00 ) &
-          * (((( 15.0168D+00 * u1 - 0.873954D+00 ) &
-          * u1 + 0.121528D+00 ) * u1 - 0.145833D+00 ) * u1 + 1.0D+00 )
-      end if
-    else if ( kf == 2 ) then
-      if ( i == 1 ) then
-        rt0 = -2.29444D+00
-      else
-        u = 3.0D+00 * pi * ( 4.0D+00 * i - 1.0D+00 ) / 8.0D+00
-        u1 = 1.0D+00 / ( u * u )
-        rt0 = - ( u * u ) ** ( 1.0D+00 / 3.0D+00 ) &
-          * (((( 15.0168D+00 * u1 - 0.873954D+00 ) &
-          * u1 + 0.121528D+00 ) * u1 - 0.145833D+00 ) * u1 + 1.0D+00 )
-      end if
-    end if
-
-    do
-
-      x = rt0
-      call airyb ( x, ai, bi, ad, bd )
-
-      if ( kf == 1 ) then
-        rt = rt0 - ad / ( ai * x )
-      else
-        rt = rt0 - bd / ( bi * x )
-      end if
-
-      if ( abs ( ( rt - rt0 ) / rt ) <= 1.0D-09 ) then
-        exit
-      end if
-
-      rt0 = rt
-
-    end do
-    
-    xb(i) = rt
-    if ( kf == 1 ) then
-      xc(i) = ai
-    else
-      xc(i) = bi
-    end if
-
-  end do
-
-  return
-end
-subroutine ajyik ( x, vj1, vj2, vy1, vy2, vi1, vi2, vk1, vk2 )
-
-!*****************************************************************************80
-!
-!! AJYIK computes Bessel functions Jv(x), Yv(x), Iv(x), Kv(x).
-!
-!  Discussion: 
-!
-!    Compute Bessel functions Jv(x) and Yv(x), and modified Bessel functions 
-!    Iv(x) and Kv(x), and their derivatives with v = 1/3, 2/3.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    31 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.  X should not be zero.
-!
-!    Output, real ( kind = 8 ) VJ1, VJ2, VY1, VY2, VI1, VI2, VK1, VK2,
-!    the values of J1/3(x), J2/3(x), Y1/3(x), Y2/3(x), I1/3(x), I2/3(x),
-!    K1/3(x), K2/3(x).
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) b0
-  real ( kind = 8 ) c0
-  real ( kind = 8 ) ck
-  real ( kind = 8 ) gn
-  real ( kind = 8 ) gn1
-  real ( kind = 8 ) gn2
-  real ( kind = 8 ) gp1
-  real ( kind = 8 ) gp2
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k0
-  integer ( kind = 4 ) l
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) pv1
-  real ( kind = 8 ) pv2
-  real ( kind = 8 ) px
-  real ( kind = 8 ) qx
-  real ( kind = 8 ) r
-  real ( kind = 8 ) rp
-  real ( kind = 8 ) rp2
-  real ( kind = 8 ) rq
-  real ( kind = 8 ) sk
-  real ( kind = 8 ) sum
-  real ( kind = 8 ) uj1
-  real ( kind = 8 ) uj2
-  real ( kind = 8 ) uu0
-  real ( kind = 8 ) vi1
-  real ( kind = 8 ) vi2
-  real ( kind = 8 ) vil
-  real ( kind = 8 ) vj1
-  real ( kind = 8 ) vj2
-  real ( kind = 8 ) vjl
-  real ( kind = 8 ) vk1
-  real ( kind = 8 ) vk2
-  real ( kind = 8 ) vl
-  real ( kind = 8 ) vsl
-  real ( kind = 8 ) vv
-  real ( kind = 8 ) vv0
-  real ( kind = 8 ) vy1
-  real ( kind = 8 ) vy2
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x2
-  real ( kind = 8 ) xk
-
-  if ( x == 0.0D+00 ) then
-    vj1 = 0.0D+00
-    vj2 = 0.0D+00
-    vy1 = -1.0D+300
-    vy2 = 1.0D+300
-    vi1 = 0.0D+00
-    vi2 = 0.0D+00
-    vk1 = -1.0D+300
-    vk2 = -1.0D+300
-    return
-  end if
-
-  pi = 3.141592653589793D+00
-  rp2 = 0.63661977236758D+00
-  gp1 = 0.892979511569249D+00
-  gp2 = 0.902745292950934D+00
-  gn1 = 1.3541179394264D+00
-  gn2 = 2.678938534707747D+00
-  vv0 = 0.444444444444444D+00
-  uu0 = 1.1547005383793D+00
-  x2 = x * x
-
-  if ( x < 35.0D+00 ) then
-    k0 = 12
-  else if ( x < 50.0D+00 ) then
-    k0 = 10
-  else
-    k0 = 8
-  end if
-
-  if ( x <= 12.0D+00 ) then
-
-    do l = 1, 2
-      vl = l / 3.0D+00
-      vjl = 1.0D+00
-      r = 1.0D+00
-      do k = 1, 40
-        r = -0.25D+00 * r * x2 / ( k * ( k + vl ) )
-        vjl = vjl + r
-        if ( abs ( r ) < 1.0D-15 ) then
-          exit
-        end if
-      end do
-
-      a0 = ( 0.5D+00 * x ) ** vl
-      if ( l == 1 ) then
-        vj1 = a0 / gp1 * vjl
-      else
-        vj2 = a0 / gp2 * vjl
-      end if
-
-    end do
-
-  else
-
-    do l = 1, 2
-
-      vv = vv0 * l * l
-      px = 1.0D+00
-      rp = 1.0D+00
-
-      do k = 1, k0
-        rp = - 0.78125D-02 * rp &
-          * ( vv - ( 4.0D+00 * k - 3.0D+00 ) ** 2 ) &
-          * ( vv - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
-          / ( k * ( 2.0D+00 * k - 1.0D+00 ) * x2 )
-        px = px + rp
-      end do
-
-      qx = 1.0D+00
-      rq = 1.0D+00
-      do k = 1, k0
-        rq = - 0.78125D-02 * rq &
-          * ( vv - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
-          * ( vv - ( 4.0D+00 * k + 1.0D+00 ) ** 2 ) &
-          / ( k * ( 2.0D+00 * k + 1.0D+00 ) * x2 )
-        qx = qx + rq
-      end do
-
-      qx = 0.125D+00 * ( vv - 1.0D+00 ) * qx / x
-      xk = x - ( 0.5D+00 * l / 3.0D+00 + 0.25D+00 ) * pi
-      a0 = sqrt ( rp2 / x )
-      ck = cos ( xk )
-      sk = sin ( xk )
-      if ( l == 1) then
-        vj1 = a0 * ( px * ck - qx * sk )
-        vy1 = a0 * ( px * sk + qx * ck )
-      else
-        vj2 = a0 * ( px * ck - qx * sk )
-        vy2 = a0 * ( px * sk + qx * ck )
-      end if
-
-    end do
-
-  end if
-
-  if ( x <= 12.0D+00 ) then
-
-    do l = 1, 2
-
-      vl = l / 3.0D+00
-      vjl = 1.0D+00
-      r = 1.0D+00
-      do k = 1, 40
-        r = -0.25D+00 * r * x2 / ( k * ( k - vl ) )
-        vjl = vjl + r
-        if ( abs ( r ) < 1.0D-15 ) then
-          exit
-        end if
-      end do
-
-      b0 = ( 2.0D+00 / x ) ** vl
-      if ( l == 1 ) then
-        uj1 = b0 * vjl / gn1
-      else
-         uj2 = b0 * vjl / gn2
-      end if
-
-    end do
-
-    pv1 = pi / 3.0D+00
-    pv2 = pi / 1.5D+00
-    vy1 = uu0 * ( vj1 * cos ( pv1 ) - uj1 )
-    vy2 = uu0 * ( vj2 * cos ( pv2 ) - uj2 )
-
-  end if
-
-  if ( x <= 18.0D+00 ) then
-
-    do l = 1, 2
-      vl = l / 3.0D+00
-      vil = 1.0D+00
-      r = 1.0D+00
-      do k = 1, 40
-        r = 0.25D+00 * r * x2 / ( k * ( k + vl ) )
-        vil = vil + r
-        if ( abs ( r ) < 1.0D-15 ) then
-          exit
-        end if
-      end do
-
-      a0 = ( 0.5D+00 * x ) ** vl
-
-      if ( l == 1 ) then
-        vi1 = a0 / gp1 * vil
-      else
-        vi2 = a0 / gp2 * vil
-      end if
-
-    end do
-
-  else
-
-    c0 = exp ( x ) / sqrt ( 2.0D+00 * pi * x )
-
-    do l = 1, 2
-      vv = vv0 * l * l
-      vsl = 1.0D+00
-      r = 1.0D+00
-      do k = 1, k0
-        r = - 0.125D+00 * r &
-          * ( vv - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * x )
-        vsl = vsl + r
-      end do
-      if ( l == 1 ) then
-        vi1 = c0 * vsl
-      else
-        vi2 = c0 * vsl
-      end if
-    end do
-
-  end if
-
-  if ( x <= 9.0D+00 ) then
-
-    do l = 1, 2
-      vl = l / 3.0D+00
-      if ( l == 1 ) then
-        gn = gn1
-      else
-        gn = gn2
-      end if
-      a0 = ( 2.0D+00 / x ) ** vl / gn
-      sum = 1.0D+00
-      r = 1.0D+00
-      do k = 1, 60
-        r = 0.25D+00 * r * x2 / ( k * ( k - vl ) )
-        sum = sum + r
-        if ( abs ( r ) < 1.0D-15 ) then
-          exit
-        end if
-      end do
-
-      if ( l == 1 ) then
-        vk1 = 0.5D+00 * uu0 * pi * ( sum * a0 - vi1 )
-      else
-        vk2 = 0.5D+00 * uu0 * pi * ( sum * a0 - vi2 )
-      end if
-
-    end do
-
-  else
-
-    c0 = exp ( - x ) * sqrt ( 0.5D+00 * pi / x )
-
-    do l = 1, 2
-      vv = vv0 * l * l
-      sum = 1.0D+00
-      r = 1.0D+00
-      do k = 1, k0
-        r = 0.125D+00 * r * ( vv - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * x )
-        sum = sum + r
-      end do
-      if ( l == 1 ) then
-        vk1 = c0 * sum
-      else
-        vk2 = c0 * sum
-      end if
-    end do
-
-  end if
-
-  return
-end
-subroutine aswfa ( m, n, c, x, kd, cv, s1f, s1d )
-
-!*****************************************************************************80
-!
-!! ASWFA: prolate and oblate spheroidal angular functions of the first kind.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    13 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the mode parameter.
-!
-!    Input, integer ( kind = 4 ) N, the mode parameter, with N = M, M+1, ...
-!
-!    Input, real ( kind = 8 ) C, the spheroidal parameter.
-!
-!    Input, real ( kind = 8 ) X, the argument of the angular function.
-!    |X| < 1.0.
-!
-!    Input, integer ( kind = 4 ) KD, the function code.
-!    1, the prolate function.
-!    -1, the oblate function.
-!
-!    Input, real ( kind = 8 ) CV, the characteristic value.
-!
-!    Output, real ( kind = 8 ) S1F, S1D, the angular function of the first
-!    kind and its derivative.
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) c
-  real ( kind = 8 ) ck(200)
-  real ( kind = 8 ) cv
-  real ( kind = 8 ) d0
-  real ( kind = 8 ) d1
-  real ( kind = 8 ) df(200)
-  real ( kind = 8 ) eps
-  integer ( kind = 4 ) ip
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  integer ( kind = 4 ) nm
-  integer ( kind = 4 ) nm2
-  real ( kind = 8 ) r
-  real ( kind = 8 ) s1d
-  real ( kind = 8 ) s1f
-  real ( kind = 8 ) su1
-  real ( kind = 8 ) su2
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x0
-  real ( kind = 8 ) x1
-
-  eps = 1.0D-14
-  x0 = x
-  x = abs ( x )
-
-  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
-    ip = 0
-  else
-    ip = 1
-  end if
-
-  nm = 10 + int ( ( n - m ) / 2 + c )
-  nm2 = nm / 2 - 2 
-  call sdmn ( m, n, c, cv, kd, df )
-  call sckb ( m, n, c, df, ck )
-  x1 = 1.0D+00 - x * x
-
-  if ( m == 0 .and. x1 == 0.0D+00 ) then
-    a0 = 1.0D+00
-  else
-    a0 = x1 ** ( 0.5D+00 * m )
-  end if
-
-  su1 = ck(1)
-  do k = 1, nm2
-    r = ck(k+1) * x1 ** k
-    su1 = su1 + r
-    if ( 10 <= k .and. abs ( r / su1 ) < eps ) then
-      exit
-    end if
-  end do
-
-  s1f = a0 * x ** ip * su1
-
-  if ( x == 1.0D+00 ) then
-
-    if ( m == 0 ) then
-      s1d = ip * ck(1) - 2.0D+00 * ck(2)
-    else if ( m == 1 ) then
-      s1d = -1.0D+100
-    else if ( m == 2 ) then
-      s1d = -2.0D+00 * ck(1)
-    else if ( 3 <= m ) then
-      s1d = 0.0D+00
-    end if
-
-  else
-
-    d0 = ip - m / x1 * x ** ( ip + 1.0D+00 )
-    d1 = -2.0D+00 * a0 * x ** ( ip + 1.0D+00 )
-    su2 = ck(2)
-    do k = 2, nm2
-      r = k * ck(k+1) * x1 ** ( k - 1.0D+00 )
-      su2 = su2 + r
-      if ( 10 <= k .and. abs ( r / su2 ) < eps ) then
-        exit
-      end if
-    end do
-
-    s1d = d0 * a0 * su1 + d1 * su2
-
-  end if
-
-  if ( x0 < 0.0D+00 ) then
-    if ( ip == 0 ) then
-      s1d = -s1d
-    else if ( ip == 1 ) then
-      s1f = -s1f
-    end if
-  end if
-
-  x = x0
-
-  return
-end
-subroutine aswfb ( m, n, c, x, kd, cv, s1f, s1d )
-
-!*****************************************************************************80
-!
-!! ASWFB: prolate and oblate spheroidal angular functions of the first kind.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    20 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the mode parameter, m = 0, 1, 2, ...
-!
-!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M+1, M+2, ...
-!
-!    Input, real ( kind = 8 ) C, the spheroidal parameter.
-!
-!    Input, real ( kind = 8 ) X, the argument, with |X| < 1.0.
-!
-!    Input, integer ( kind = 4 ) KD, the function code.
-!    1, the prolate function.
-!    -1, the oblate function.
-!
-!    Input, real ( kind = 8 ) CV, the characteristic value.
-!
-!    Output, real ( kind = 8 ) S1F, S1D, the angular function of the first
-!    kind and its derivative.
-!
-  implicit none
-
-  real ( kind = 8 ) c
-  real ( kind = 8 ) cv
-  real ( kind = 8 ) df(200)
-  real ( kind = 8 ) eps
-  integer ( kind = 4 ) ip
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) mk
-  integer ( kind = 4 ) n
-  integer ( kind = 4 ) nm
-  integer ( kind = 4 ) nm2
-  real ( kind = 8 ) pd(0:251)
-  real ( kind = 8 ) pm(0:251)
-  real ( kind = 8 ) s1d
-  real ( kind = 8 ) s1f
-  real ( kind = 8 ) su1
-  real ( kind = 8 ) sw
-  real ( kind = 8 ) x
-
-  eps = 1.0D-14
-
-  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
-    ip = 0
-  else
-    ip = 1
-  end if
-
-  nm = 25 + int ( ( n - m ) / 2 + c )
-  nm2 = 2 * nm + m
-  call sdmn ( m, n, c, cv, kd, df )
-  call lpmns ( m, nm2, x, pm, pd )
-  su1 = 0.0D+00
-  do k = 1, nm
-    mk = m + 2 * ( k - 1 ) + ip
-    su1 = su1 + df(k) * pm(mk)
-    if ( abs ( sw - su1 ) < abs ( su1 ) * eps ) then
-      exit
-    end if
-    sw = su1
-  end do
-
-  s1f = ( -1.0D+00 ) ** m * su1
-
-  su1 = 0.0D+00
-  do k = 1, nm
-    mk = m + 2 * ( k - 1 ) + ip
-    su1 = su1 + df(k) * pd(mk)
-    if ( abs ( sw - su1 ) < abs ( su1 ) * eps ) then
-      exit
-    end if
-    sw = su1
-  end do
-
-  s1d = ( -1.0D+00 ) ** m * su1
-
-  return
-end
-subroutine bernoa ( n, bn )
-
-!*****************************************************************************80
-!
-!! BERNOA computes the Bernoulli number Bn.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    11 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the index.
-!
-!    Output, real ( kind = 8 ) BN, the value of the N-th Bernoulli number.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) bn(0:n)
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) r
-  real ( kind = 8 ) s
-
-  bn(0) = 1.0D+00
-  bn(1) = -0.5D+00
-
-  do m = 2, n
-    s = - ( 1.0D+00 / ( m + 1.0D+00 ) - 0.5D+00 )
-    do k = 2, m - 1
-      r = 1.0D+00
-      do j = 2, k
-        r = r * ( j + m - k ) / j
-      end do
-    s = s - r * bn(k)
-   end do
-   bn(m) = s
-  end do
-
-  do m = 3, n, 2
-    bn(m) = 0.0D+00
-  end do
-
-  return
-end
-subroutine bernob ( n, bn )
-
-!*****************************************************************************80
-!
-!! BERNOB computes the Bernoulli number Bn.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    11 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the index.
-!
-!    Output, real ( kind = 8 ) BN, the value of the N-th Bernoulli number.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) bn(0:n)
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) r2
-  real ( kind = 8 ) s
-  real ( kind = 8 ) tpi
-
-  tpi = 6.283185307179586D+00
-  bn(0) = 1.0D+00
-  bn(1) = -0.5D+00
-  bn(2) = 1.0D+00 / 6.0D+00
-  r1 = ( 2.0D+00 / tpi )**2
-
-  do m = 4, n, 2
-
-    r1 = - r1 * ( m - 1 ) * m / ( tpi * tpi )
-    r2 = 1.0D+00
- 
-    do k = 2, 10000
-      s = ( 1.0D+00 / k ) ** m
-      r2 = r2 + s
-      if ( s < 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    bn(m) = r1 * r2
-
-  end do
-
-  return
-end
-subroutine beta ( p, q, bt )
-
-!*****************************************************************************80
-!
-!! BETA computes the Beta function B(p,q).
-!
-!  Licensing:
-!
-!    The original FORTRAN77 version of this routine is copyrighted by 
-!    Shanjie Zhang and Jianming Jin.  However, they give permission to 
-!    incorporate this routine into a user program that the copyright 
-!    is acknowledged.
-!
-!  Modified:
-!
-!    12 March 2012
-!
-!  Author:
-!
-!    Original FORTRAN77 version by Shanjie Zhang, Jianming Jin.
-!    FORTRAN90 version by John Burkardt.
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) P, Q, the parameters.
-!    0 < P, 0 < Q.
-!
-!    Output, real ( kind = 8 ) BT, the value of B(P,Q).
-!
-  implicit none
-
-  real ( kind = 8 ) bt
-  real ( kind = 8 ) gp
-  real ( kind = 8 ) gpq
-  real ( kind = 8 ) gq
-  real ( kind = 8 ) p
-  real ( kind = 8 ) ppq
-  real ( kind = 8 ) q
-
-  call gamma ( p, gp )
-  call gamma ( q, gq )
-  ppq = p + q
-  call gamma ( ppq, gpq )
-  bt = gp * gq / gpq
-
-  return
-end
-subroutine bjndd ( n, x, bj, dj, fj )
-
-!*****************************************************************************80
-!
-!! BJNDD computes Bessel functions Jn(x) and first and second derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    11 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) BJ(N+1), DJ(N+1), FJ(N+1), the values of 
-!    Jn(x), Jn'(x) and Jn''(x) in the last entries.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) bj(n+1)
-  real ( kind = 8 ) bs
-  real ( kind = 8 ) dj(n+1)
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) fj(n+1)
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) mt
-  integer ( kind = 4 ) nt
-  real ( kind = 8 ) x
-
-  do nt = 1, 900
-    mt = int ( 0.5D+00 * log10 ( 6.28D+00 * nt ) &
-      - nt * log10 ( 1.36D+00 * abs ( x ) / nt ) )
-    if ( 20 < mt ) then
-      exit
-    end if
-  end do
-
-  m = nt
-  bs = 0.0D+00
-  f0 = 0.0D+00
-  f1 = 1.0D-35
-  do k = m, 0, -1
-    f = 2.0D+00 * ( k + 1.0D+00 ) * f1 / x - f0
-    if ( k <= n ) then
-      bj(k+1) = f
-    end if
-    if ( k == 2 * int ( k / 2 ) ) then
-      bs = bs + 2.0D+00 * f
-    end if
-    f0 = f1
-    f1 = f
-  end do
-
-  do k = 0, n
-    bj(k+1) = bj(k+1) / ( bs - f )
-  end do
-
-  dj(1) = -bj(2)
-  fj(1) = -1.0D+00 * bj(1) - dj(1) / x
-  do k = 1, n
-    dj(k+1) = bj(k) - k * bj(k+1) / x
-    fj(k+1) = ( k * k / ( x * x ) - 1.0D+00 ) * bj(k+1) - dj(k+1) / x
-  end do
-
-  return
-end
-subroutine cbk ( m, n, c, cv, qt, ck, bk )
-
-!*****************************************************************************80
-!
-!! CBK computes coefficients for oblate radial functions with small argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    20 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
-!
-!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
-!
-!    Input, real ( kind = 8 ) C, spheroidal parameter.
-!
-!    Input, real ( kind = 8 ) CV, the characteristic value.
-!
-!    Input, real ( kind = 8 ) QT, ?
-!
-!    Input, real ( kind = 8 ) CK(*), ?
-!
-!    Output, real ( kind = 8 ) BK(*), the coefficients.
-!
-  implicit none
-
-  real ( kind = 8 ) bk(200)
-  real ( kind = 8 ) c
-  real ( kind = 8 ) ck(200)
-  real ( kind = 8 ) cv
-  real ( kind = 8 ) eps
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) i1
-  integer ( kind = 4 ) ip
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  integer ( kind = 4 ) n2
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) qt
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) s1
-  real ( kind = 8 ) sw
-  real ( kind = 8 ) t
-  real ( kind = 8 ) u(200)
-  real ( kind = 8 ) v(200)
-  real ( kind = 8 ) w(200)
-
-  eps = 1.0D-14
-  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
-    ip = 0
-  else
-    ip = 1
-  end if
-  nm = 25 + int ( 0.5D+00 * ( n - m ) + c )
-  u(1) = 0.0D+00
-  n2 = nm - 2
-  do j = 2, n2
-    u(j) = c * c
-  end do
-
-  do j = 1, n2
-    v(j) = ( 2.0D+00 * j - 1.0D+00 - ip ) &
-      * ( 2.0D+00 * ( j - m ) - ip ) + m * ( m - 1.0D+00 ) - cv
-  end do
-
-  do j = 1, nm - 1
-    w(j) = ( 2.0D+00 * j - ip ) * ( 2.0D+00 * j + 1.0D+00 - ip )
-  end do
-
-  if ( ip == 0 ) then
-
-    do k = 0, n2 - 1
-
-      s1 = 0.0D+00
-      i1 = k - m + 1
-
-      do i = i1, nm
-        if ( 0 <= i ) then
-          r1 = 1.0D+00
-          do j = 1, k
-            r1 = r1 * ( i + m - j ) / j
-          end do
-          s1 = s1 + ck(i+1) * ( 2.0D+00 * i + m ) * r1
-          if ( abs ( s1 - sw ) < abs ( s1 ) * eps ) then
-            exit
-          end if
-          sw = s1
-        end if
-      end do
-
-      bk(k+1) = qt * s1
-
-    end do
-
-  else if ( ip == 1 ) then
-
-    do k = 0, n2 - 1
-
-      s1 = 0.0D+00
-      i1 = k - m + 1
-
-      do i = i1, nm
-
-        if ( 0 <= i ) then
-
-          r1 = 1.0D+00
-          do j = 1, k
-            r1 = r1 * ( i + m - j ) / j
-          end do
-
-          if ( 0 < i ) then
-            s1 = s1 + ck(i) * ( 2.0D+00 * i + m - 1 ) * r1
-          end if
-          s1 = s1 - ck(i+1) * ( 2.0D+00 * i + m ) * r1
-          if ( abs ( s1 - sw ) < abs ( s1 ) * eps ) then
-            exit
-          end if
-          sw = s1
-
-        end if
-
-      end do
-
-      bk(k+1) = qt * s1
-
-    end do
-
-  end if
-
-  w(1) = w(1) / v(1)
-  bk(1) = bk(1) / v(1)
-  do k = 2, n2
-    t = v(k) - w(k-1) * u(k)
-    w(k) = w(k) / t
-    bk(k) = ( bk(k) - bk(k-1) * u(k) ) / t
-  end do
-
-  do k = n2 - 1, 1, -1
-    bk(k) = bk(k) - w(k) * bk(k+1)
-  end do
-
-  return
-end
-subroutine cchg ( a, b, z, chg )
-
-!*****************************************************************************80
-!
-!! CCHG computes the confluent hypergeometric function.
-!
-!  Discussion:
-!
-!    This function computes the confluent hypergeometric function
-!    M(a,b,z) with real parameters a, b and complex argument z.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    26 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) A, B, parameter values.
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, complex ( kind = 8 ) CHG, the value of M(a,b,z).
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) a1
-  real ( kind = 8 ) b
-  real ( kind = 8 ) ba
-  complex ( kind = 8 ) cfac
-  complex ( kind = 8 ) chg
-  complex ( kind = 8 ) chg1
-  complex ( kind = 8 ) chg2
-  complex ( kind = 8 ) chw
-  complex ( kind = 8 ) ci
-  complex ( kind = 8 ) cr
-  complex ( kind = 8 ) cr1
-  complex ( kind = 8 ) cr2
-  complex ( kind = 8 ) crg
-  complex ( kind = 8 ) cs1
-  complex ( kind = 8 ) cs2
-  complex ( kind = 8 ) cy0
-  complex ( kind = 8 ) cy1
-  real ( kind = 8 ) g1
-  real ( kind = 8 ) g2
-  real ( kind = 8 ) g3
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) la
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  integer ( kind = 4 ) nl
-  integer ( kind = 4 ) ns
-  real ( kind = 8 ) phi
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x0
-  real ( kind = 8 ) y
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) z0
-
-  pi = 3.141592653589793D+00
-  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
-  a0 = a
-  a1 = a
-  z0 = z
-
-  if ( b == 0.0D+00 .or. b == - int ( abs ( b ) ) ) then
-    chg = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-  else if ( a == 0.0D+00 .or. z == 0.0D+00 ) then
-    chg = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-  else if ( a == -1.0D+00 ) then
-    chg = 1.0D+00 - z / b
-  else if ( a == b ) then
-    chg = exp ( z )
-  else if ( a - b == 1.0D+00 ) then
-    chg = ( 1.0D+00 + z / b ) * exp ( z )
-  else if ( a == 1.0D+00 .and. b == 2.0D+00 ) then
-    chg = ( exp ( z ) - 1.0D+00 ) / z
-  else if ( a == int ( a ) .and. a < 0.0D+00 ) then
-    m = int ( - a )
-    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    chg = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, m
-      cr = cr * ( a + k - 1.0D+00 ) / k / ( b + k - 1.0D+00 ) * z
-      chg = chg + cr
-    end do
-  else
-
-    x0 = real ( z, kind = 8 )
-    if ( x0 < 0.0D+00 ) then
-      a = b - a
-      a0 = a
-      z = - z
-    end if
-
-    if ( a < 2.0D+00 ) then
-      nl = 0
-    else
-      nl = 1
-      la = int ( a )
-      a = a - la - 1.0D+00
-    end if
-
-    do n = 0, nl
-
-      if ( 2.0D+00 <= a0 ) then
-        a = a + 1.0D+00
-      end if
-
-      if ( cdabs ( z ) < 20.0D+00 + abs ( b ) .or. a < 0.0D+00 ) then
-
-        chg = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-        crg = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-        do j = 1, 500
-          crg = crg * ( a + j - 1.0D+00 ) / ( j * ( b + j - 1.0D+00 ) ) * z
-          chg = chg + crg
-          if ( abs ( ( chg - chw ) / chg ) < 1.0D-15 ) then
-            exit
-          end if
-          chw = chg
-        end do
-
-      else
-
-        call gamma ( a, g1 )
-        call gamma ( b, g2 )
-        ba = b - a
-        call gamma ( ba, g3 )
-        cs1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-        cs2 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-        cr1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-        cr2 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-
-        do i = 1, 8
-          cr1 = - cr1 * (     a + i - 1.0D+00 ) * ( a - b + i ) / ( z * i )
-          cr2 =   cr2 * ( b - a + i - 1.0D+00 ) * ( i - a ) / ( z * i )
-          cs1 = cs1 + cr1
-          cs2 = cs2 + cr2
-        end do
-
-        x = real ( z, kind = 8 )
-        y = imag ( z )
-
-        if ( x == 0.0D+00 .and. 0.0D+00 <= y ) then
-          phi = 0.5D+00 * pi
-        else if ( x == 0.0D+00 .and. y <= 0.0D+00 ) then
-          phi = -0.5D+00 * pi
-        else
-          phi = atan ( y / x )
-        end if
-
-        if ( -1.5D+00 * pi < phi .and. phi <= -0.5 * pi ) then
-          ns = -1
-        else if ( -0.5D+00 * pi < phi .and. phi < 1.5D+00 * pi ) then
-          ns = 1
-        end if
-
-        if ( y == 0.0D+00 ) then
-          cfac = cos ( pi * a )
-        else
-          cfac = exp ( ns * ci * pi * a )
-        end if
-
-        chg1 = g2 / g3 * z ** ( - a ) * cfac * cs1
-        chg2 = g2 / g1 * exp ( z ) * z ** ( a - b ) * cs2
-        chg = chg1 + chg2
-
-      end if
-
-      if ( n == 0 ) then
-        cy0 = chg
-      else if ( n == 1 ) then
-        cy1 = chg
-      end if
-
-    end do
-
-    if ( 2.0D+00 <= a0 ) then
-      do i = 1, la - 1
-        chg = ( ( 2.0D+00 * a - b + z ) * cy1 + ( b - a ) * cy0 ) / a
-        cy0 = cy1
-        cy1 = chg
-        a = a + 1.0D+00
-      end do
-    end if
-
-    if ( x0 < 0.0D+00 ) then
-      chg = chg * exp ( - z )
-    end if
-
-  end if
-
-  a = a1
-  z = z0
-
-  return
-end
-subroutine cerf ( z, cer, cder )
-
-!*****************************************************************************80
-!
-!! CERF computes the error function and derivative for a complex argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    25 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-! 
-!  Parameters:
-!
-!    Input, complex ( kind = 8 ), the argument.
-!
-!    Output, complex ( kind = 8 ) CER, CDER, the values of erf(z) and erf'(z).
-!
-  implicit none
-
-  real ( kind = 8 ) c0
-  complex ( kind = 8 ) cder
-  complex ( kind = 8 ) cer
-  real ( kind = 8 ) cs
-  real ( kind = 8 ) ei1
-  real ( kind = 8 ) ei2
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) er
-  real ( kind = 8 ) er0
-  real ( kind = 8 ) er1
-  real ( kind = 8 ) er2 
-  real ( kind = 8 ) eri
-  real ( kind = 8 ) err
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r
-  real ( kind = 8 ) ss
-  real ( kind = 8 ) w
-  real ( kind = 8 ) w1
-  real ( kind = 8 ) w2
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x2
-  real ( kind = 8 ) y
-  complex ( kind = 8 ) z
-
-  eps = 1.0D-12
-  pi = 3.141592653589793D+00
-  x = real ( z, kind = 8 )
-  y = imag ( z )
-  x2 = x * x
-
-  if ( x <= 3.5D+00 ) then
-
-    er = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 100
-      r = r * x2 / ( k + 0.5D+00 )
-      er = er + r
-      if ( abs ( er - w ) <= eps * abs ( er ) ) then
-        exit
-      end if
-      w = er
-    end do
-
-    c0 = 2.0D+00 / sqrt ( pi ) * x * exp ( - x2 )
-    er0 = c0 * er
-
-  else
-
-    er = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 12
-      r = - r * ( k - 0.5D+00 ) / x2
-      er = er + r
-    end do
-    c0 = exp ( - x2 ) / ( x * sqrt ( pi ) )
-    er0 = 1.0D+00 - c0 * er
-
-  end if
-
-  if ( y == 0.0D+00 ) then
-
-    err = er0
-    eri = 0.0D+00
-
-  else
-
-    cs = cos ( 2.0D+00 * x * y )
-    ss = sin ( 2.0D+00 * x * y )
-    er1 = exp ( - x2 ) * ( 1.0D+00 - cs ) / ( 2.0D+00 * pi * x )
-    ei1 = exp ( - x2 ) * ss / ( 2.0D+00 * pi * x )
-    er2 = 0.0D+00
-    do n = 1, 100
-      er2 = er2 + exp ( - 0.25D+00 * n * n ) &
-        / ( n * n + 4.0D+00 * x2 ) * ( 2.0D+00 * x &
-        - 2.0D+00 * x * cosh ( n * y ) * cs &
-        + n * sinh ( n * y ) * ss )
-      if ( abs ( ( er2 - w1 ) / er2 ) < eps ) then
-        exit
-      end if
-      w1 = er2
-    end do
-
-    c0 = 2.0D+00 * exp ( - x2 ) / pi
-    err = er0 + er1 + c0 * er2
-    ei2 = 0.0D+00
-    do n = 1, 100
-      ei2 = ei2 + exp ( - 0.25D+00 * n * n ) &
-        / ( n * n + 4.0D+00 * x2 ) * ( 2.0D+00 * x &
-        * cosh ( n * y ) * ss + n * sinh ( n * y ) * cs )
-      if ( abs ( ( ei2 - w2 ) / ei2 ) < eps ) then
-        exit
-      end if
-      w2 = ei2
-    end do
-
-    eri = ei1 + c0 * ei2
-
-  end if
-
-  cer = cmplx ( err, eri, kind = 8 )
-  cder = 2.0D+00 / sqrt ( pi ) * exp ( - z * z )
-
-  return
-end
-subroutine cerror ( z, cer )
-
-!*****************************************************************************80
-!
-!! CERROR computes the error function for a complex argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    15 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-! 
-!  Parameters:
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, complex ( kind = 8 ) CER, the function value.
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  complex ( kind = 8 ) c0
-  complex ( kind = 8 ) cer
-  complex ( kind = 8 ) cl
-  complex ( kind = 8 ) cr
-  complex ( kind = 8 ) cs
-  integer ( kind = 4 ) k
-  real ( kind = 8 ) pi
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) z1
-
-  a0 = abs ( z )
-  c0 = exp ( - z * z )
-  pi = 3.141592653589793D+00
-  z1 = z
-
-  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
-    z1 = - z
-  end if
-
-  if ( a0 <= 5.8D+00 ) then    
-
-    cs = z1
-    cr = z1
-    do k = 1, 120
-      cr = cr * z1 * z1 / ( k + 0.5D+00 )
-      cs = cs + cr
-      if ( abs ( cr / cs ) < 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    cer = 2.0D+00 * c0 * cs / sqrt ( pi )
-
-  else
-
-    cl = 1.0D+00 / z1              
-    cr = cl
-    do k = 1, 13
-      cr = -cr * ( k - 0.5D+00 ) / ( z1 * z1 )
-      cl = cl + cr
-      if ( abs ( cr / cl ) < 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    cer = 1.0D+00 - c0 * cl / sqrt ( pi )
-
-  end if
-
-  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
-    cer = -cer
-  end if
-
-  return
-end
-subroutine cerzo ( nt, zo )
-
-!*****************************************************************************80
-!
-!! CERZO evaluates the complex zeros of the error function.
-!
-!  Discussion:
-!
-!    The modified Newton method is used.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    15 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) NT, the number of zeros.
-!
-!    Output, complex ( kind = 8 ) ZO(NT), the zeros.
-!
-  implicit none
-
-  integer ( kind = 4 ) nt
-
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) it
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) nr
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) pu
-  real ( kind = 8 ) pv
-  real ( kind = 8 ) px
-  real ( kind = 8 ) py
-  real ( kind = 8 ) w
-  real ( kind = 8 ) w0
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) zd
-  complex ( kind = 8 ) zf
-  complex ( kind = 8 ) zfd
-  complex ( kind = 8 ) zgd
-  complex ( kind = 8 ) zo(nt)
-  complex ( kind = 8 ) zp
-  complex ( kind = 8 ) zq
-  complex ( kind = 8 ) zw
-
-  pi = 3.141592653589793D+00
-
-  do nr = 1, nt
-
-    pu = sqrt ( pi * ( 4.0D+00 * nr - 0.5D+00 ) )
-    pv = pi * sqrt ( 2.0D+00 * nr - 0.25D+00 )
-    px = 0.5D+00 * pu - 0.5D+00 * log ( pv ) / pu
-    py = 0.5D+00 * pu + 0.5D+00 * log ( pv ) / pu
-    z = cmplx ( px, py, kind = 8 )
-    it = 0
-
-    do
-
-      it = it + 1
-      call cerf ( z, zf, zd )
-      zp = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do i = 1, nr - 1
-        zp = zp * ( z - zo(i) )
-      end do
-      zfd = zf / zp
-
-      zq = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      do i = 1, nr - 1
-        zw = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-        do j = 1, nr - 1
-          if ( j /= i ) then
-            zw = zw * ( z - zo(j) )
-          end if
-        end do
-        zq = zq + zw
-      end do
-
-      zgd = ( zd - zq * zfd ) / zp
-      z = z - zfd / zgd
-      w0 = w
-      w = abs ( z )
-
-      if ( 50 < it .or. abs ( ( w - w0 ) / w ) <= 1.0D-11 ) then
-        exit
-      end if
-
-    end do
-
-    zo(nr) = z
-
-  end do
-
-  return
-end
-subroutine cfc ( z, zf, zd )
-
-!*****************************************************************************80
-!
-!! CFC computes the complex Fresnel integral C(z) and C'(z).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    26 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, complex ( kind = 8 ) ZF, ZD, the values of C(z) and C'(z).
-!
-  implicit none
-
-  complex ( kind = 8 ) c
-  complex ( kind = 8 ) cf
-  complex ( kind = 8 ) cf0
-  complex ( kind = 8 ) cf1
-  complex ( kind = 8 ) cg
-  complex ( kind = 8 ) cr
-  real ( kind = 8 ) eps
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) w0
-  real ( kind = 8 ) wa
-  real ( kind = 8 ) wa0
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) z0
-  complex ( kind = 8 ) zd
-  complex ( kind = 8 ) zf
-  complex ( kind = 8 ) zp
-  complex ( kind = 8 ) zp2
-
-  eps = 1.0D-14
-  pi = 3.141592653589793D+00
-  w0 = abs ( z )
-  zp = 0.5D+00 * pi * z * z
-  zp2 = zp * zp
-  z0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-
-  if ( z == z0 ) then
-
-    c = z0
-
-  else if ( w0 <= 2.5D+00 ) then
-
-    cr = z
-    c = cr
-    do k = 1, 80
-      cr = -0.5D+00 * cr * ( 4.0D+00 * k - 3.0D+00 ) &
-        / k / ( 2.0D+00 * k - 1.0D+00 ) &
-        / ( 4.0D+00 * k + 1.0D+00 ) * zp2
-      c = c + cr
-      wa = abs ( c )
-      if ( abs ( ( wa - wa0 ) / wa ) < eps .and. 10 < k ) then
-        exit
-      end if
-      wa0 = wa
-    end do
-
-  else if ( 2.5D+00 < w0 .and. w0 < 4.5D+00 ) then
-
-    m = 85
-    c = z0
-    cf1 = z0
-    cf0 = cmplx ( 1.0D-30, 0.0D+00, kind = 8 )
-    do k = m, 0, -1
-      cf = ( 2.0D+00 * k + 3.0D+00 ) * cf0 / zp - cf1
-      if ( k == int ( k / 2 ) * 2 ) then
-        c = c + cf
-      end if
-      cf1 = cf0
-      cf0 = cf
-    end do
-    c = sqrt ( 2.0D+00 / ( pi * zp ) ) * sin ( zp ) / cf * c
-
-  else
-
-    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cf = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, 20
-      cr = - 0.25D+00 * cr * ( 4.0D+00 * k - 1.0D+00 ) &
-        * ( 4.0D+00 * k - 3.0D+00 ) / zp2
-      cf = cf + cr
-    end do
-    cr = 1.0D+00 / ( pi * z * z )
-    cg = cr
-    do k = 1, 12
-      cr = - 0.25D+00 * cr * ( 4.0D+00 * k + 1.0D+00 ) &
-        * ( 4.0D+00 * k - 1.0D+00 ) / zp2
-      cg = cg + cr
-    end do
-    c = 0.5D+00 + ( cf * sin ( zp ) - cg * cos ( zp ) ) / ( pi * z )
-
-  end if
-
-  zf = c
-  zd = cos ( 0.5D+00 * pi * z * z )
-
-  return
-end
-subroutine cfs ( z, zf, zd )
-
-!*****************************************************************************80
-!
-!! CFS computes the complex Fresnel integral S(z) and S'(z).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    24 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, complex ( kind = 8 ) ZF, ZD, the values of S(z) and S'(z).
-!
-  implicit none
-
-  complex ( kind = 8 ) cf
-  complex ( kind = 8 ) cf0
-  complex ( kind = 8 ) cf1
-  complex ( kind = 8 ) cg
-  complex ( kind = 8 ) cr
-  real ( kind = 8 ) eps
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) pi
-  complex ( kind = 8 ) s
-  real ( kind = 8 ) w0
-  real ( kind = 8 ) wb
-  real ( kind = 8 ) wb0
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) z0
-  complex ( kind = 8 ) zd
-  complex ( kind = 8 ) zf
-  complex ( kind = 8 ) zp
-  complex ( kind = 8 ) zp2
-
-  eps = 1.0D-14
-  pi = 3.141592653589793D+00
-  w0 = abs ( z )
-  zp = 0.5D+00 * pi * z * z
-  zp2 = zp * zp
-  z0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-
-  if ( z == z0 ) then
-
-    s = z0
-
-  else if ( w0 <= 2.5D+00 ) then
-
-    s = z * zp / 3.0D+00
-    cr = s
-    do k = 1, 80
-      cr = -0.5D+00 * cr * ( 4.0D+00 * k - 1.0D+00 ) / k &
-        / ( 2.0D+00 * k + 1.0D+00 ) &
-        / ( 4.0D+00 * k + 3.0D+00 ) * zp2
-      s = s + cr
-      wb = abs ( s )
-      if ( abs ( wb - wb0 ) < eps .and. 10 < k ) then
-        exit
-      end if
-      wb0 = wb
-    end do
-
-  else if ( 2.5D+00 < w0 .and. w0 < 4.5D+00 ) then
-
-    m = 85
-    s = z0
-    cf1 = z0
-    cf0 = cmplx ( 1.0D-30, 0.0D+00, kind = 8  )
-    do k = m, 0, -1
-      cf = ( 2.0D+00 * k + 3.0D+00 ) * cf0 / zp - cf1
-      if ( k /= int ( k / 2 ) * 2 ) then
-        s = s + cf
-      end if
-      cf1 = cf0
-      cf0 = cf
-    end do
-    s = sqrt ( 2.0D+00 / ( pi * zp ) ) * sin ( zp ) / cf * s
-
-  else
-
-    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8  )
-    cf = cmplx ( 1.0D+00, 0.0D+00, kind = 8  )
-    do k = 1, 20
-      cr = -0.25D+00 * cr * ( 4.0D+00 * k - 1.0D+00 ) &
-        * ( 4.0D+00 * k - 3.0D+00 ) / zp2
-      cf = cf + cr
-    end do
-    cr = 1.0D+00 / ( pi * z * z )
-    cg = cr
-    do k = 1, 12
-      cr = -0.25D+00 * cr * ( 4.0D+00 * k + 1.0D+00 ) &
-        * ( 4.0D+00 * k - 1.0D+00 ) / zp2
-      cg = cg + cr
-    end do
-    s = 0.5D+00 - ( cf * cos ( zp ) + cg * sin ( zp ) ) / ( pi * z )
-
-  end if
-
-  zf = s
-  zd = sin ( 0.5D+00 * pi * z * z )
-
-  return
-end
-subroutine cgama ( x, y, kf, gr, gi )
-
-!*****************************************************************************80
-!
-!! CGAMA computes the Gamma function for complex argument.
-!
-!  Discussion:
-!
-!    This procedcure computes the gamma function â(z) or ln[â(z)]
-!    for a complex argument
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    26 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, Y, the real and imaginary parts of 
-!    the argument Z.
-!
-!    Input, integer ( kind = 4 ) KF, the function code.
-!    0 for ln[â(z)]
-!    1 for â(z)
-!
-!    Output, real ( kind = 8 ) GR, GI, the real and imaginary parts of
-!    the selected function.
-!
-  implicit none
-
-  real ( kind = 8 ), save, dimension ( 10 ) :: a = (/ &
-    8.333333333333333D-02, -2.777777777777778D-03, &
-    7.936507936507937D-04, -5.952380952380952D-04, &
-    8.417508417508418D-04, -1.917526917526918D-03, &
-    6.410256410256410D-03, -2.955065359477124D-02, &
-    1.796443723688307D-01, -1.39243221690590D+00 /)
-  real ( kind = 8 ) g0
-  real ( kind = 8 ) gi
-  real ( kind = 8 ) gi1
-  real ( kind = 8 ) gr
-  real ( kind = 8 ) gr1
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) kf
-  integer ( kind = 4 ) na
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) si
-  real ( kind = 8 ) sr
-  real ( kind = 8 ) t
-  real ( kind = 8 ) th
-  real ( kind = 8 ) th1
-  real ( kind = 8 ) th2
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x0
-  real ( kind = 8 ) x1
-  real ( kind = 8 ) y
-  real ( kind = 8 ) y1
-  real ( kind = 8 ) z1
-  real ( kind = 8 ) z2
-
-  pi = 3.141592653589793D+00
-
-  if ( y == 0.0D+00 .and. x == int ( x ) .and. x <= 0.0D+00 ) then
-    gr = 1.0D+300
-    gi = 0.0D+00
-    return
-  else if ( x < 0.0D+00 ) then
-    x1 = x
-    y1 = y
-    x = -x
-    y = -y
-  end if
-
-  x0 = x
-
-  if ( x <= 7.0D+00 ) then
-    na = int ( 7 - x )
-    x0 = x + na
-  end if
-
-  z1 = sqrt ( x0 * x0 + y * y )
-  th = atan ( y / x0 )
-  gr = ( x0 - 0.5D+00 ) * log ( z1 ) - th * y - x0 &
-    + 0.5D+00 * log ( 2.0D+00 * pi )
-  gi = th * ( x0 - 0.5D+00 ) + y * log ( z1 ) - y
-
-  do k = 1, 10
-    t = z1 ** ( 1 - 2 * k )
-    gr = gr + a(k) * t * cos ( ( 2.0D+00 * k - 1.0D+00 ) * th )
-    gi = gi - a(k) * t * sin ( ( 2.0D+00 * k - 1.0D+00 ) * th )
-  end do
-
-  if ( x <= 7.0D+00 ) then
-    gr1 = 0.0D+00
-    gi1 = 0.0D+00
-    do j = 0, na - 1
-      gr1 = gr1 + 0.5D+00 * log ( ( x + j ) ** 2 + y * y )
-      gi1 = gi1 + atan ( y / ( x + j ) )
-    end do
-    gr = gr - gr1
-    gi = gi - gi1
-  end if
-
-  if ( x1 < 0.0D+00 ) then
-    z1 = sqrt ( x * x + y * y )
-    th1 = atan ( y / x )
-    sr = - sin ( pi * x ) * cosh ( pi * y )
-    si = - cos ( pi * x ) * sinh ( pi * y )
-    z2 = sqrt ( sr * sr + si * si )
-    th2 = atan ( si / sr )
-    if ( sr < 0.0D+00 ) then
-      th2 = pi + th2
-    end if
-    gr = log ( pi / ( z1 * z2 ) ) - gr
-    gi = - th1 - th2 - gi
-    x = x1
-    y = y1
-  end if
-
-  if ( kf == 1 ) then
-    g0 = exp ( gr )
-    gr = g0 * cos ( gi )
-    gi = g0 * sin ( gi )
-  end if
-
-  return
-end
-subroutine ch12n ( n, z, nm, chf1, chd1, chf2, chd2 )
-
-!*****************************************************************************80
-!
-!! CH12N computes Hankel functions of first and second kinds, complex argument.
-!
-!  Discussion:
-!
-!    Both the Hankel functions and their derivatives are computed.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    26 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-! 
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order of the functions.
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, integer ( kind = 4 ) NM, the highest order computed.
-!
-!    Output, complex ( kind = 8 ) CHF1(0:n), CHD1(0:n), CHF2(0:n), CHD2(0:n), 
-!    the values of Hn(1)(z), Hn(1)'(z), Hn(2)(z), Hn(2)'(z).
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  complex ( kind = 8 ) cbi(0:250)
-  complex ( kind = 8 ) cbj(0:250)
-  complex ( kind = 8 ) cbk(0:250)
-  complex ( kind = 8 ) cby(0:250)
-  complex ( kind = 8 ) cdi(0:250)
-  complex ( kind = 8 ) cdj(0:250)
-  complex ( kind = 8 ) cdk(0:250)
-  complex ( kind = 8 ) cdy(0:250)
-  complex ( kind = 8 ) chd1(0:n)
-  complex ( kind = 8 ) chd2(0:n)
-  complex ( kind = 8 ) cf1
-  complex ( kind = 8 ) cfac
-  complex ( kind = 8 ) chf1(0:n)
-  complex ( kind = 8 ) chf2(0:n)
-  complex ( kind = 8 ) ci
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) pi
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) zi
-
-  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
-  pi = 3.141592653589793D+00
-
-  if ( imag ( z ) < 0.0D+00 ) then
-
-    call cjynb ( n, z, nm, cbj, cdj, cby, cdy )
-
-    do k = 0, nm
-      chf1(k) = cbj(k) + ci * cby(k)
-      chd1(k) = cdj(k) + ci * cdy(k)
-    end do
-
-    zi = ci * z
-    call ciknb ( n, zi, nm, cbi, cdi, cbk, cdk )
-    cfac = -2.0D+00 / ( pi * ci )
-
-    do k = 0, nm
-      chf2(k) = cfac * cbk(k)
-      chd2(k) = cfac * ci * cdk(k)
-      cfac = cfac * ci
-    end do
-
-  else if ( 0.0D+00 < imag ( z ) ) then
-
-    zi = - ci * z
-    call ciknb ( n, zi, nm, cbi, cdi, cbk, cdk )
-    cf1 = -ci
-    cfac = 2.0D+00 / ( pi * ci )
-
-    do k = 0, nm
-      chf1(k) = cfac * cbk(k)
-      chd1(k) = -cfac * ci * cdk(k)
-      cfac = cfac * cf1
-    end do
-
-    call cjynb ( n, z, nm, cbj, cdj, cby, cdy )
-
-    do k = 0, nm
-      chf2(k) = cbj(k) - ci * cby(k)
-      chd2(k) = cdj(k) - ci * cdy(k)
-    end do
-
-  else
-
-    call cjynb ( n, z, nm, cbj, cdj, cby, cdy )
-
-    do k = 0, nm
-      chf1(k) = cbj(k) + ci * cby(k)
-      chd1(k) = cdj(k) + ci * cdy(k)
-      chf2(k) = cbj(k) - ci * cby(k)
-      chd2(k) = cdj(k) - ci * cdy(k)
-    end do
-
-  end if
-
-  return
-end
-subroutine chgm ( a, b, x, hg )
-
-!*****************************************************************************80
-!
-!! CHGM computes the confluent hypergeometric function M(a,b,x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    27 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) A, B, parameters.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) HG, the value of M(a,b,x).
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) a1
-  real ( kind = 8 ) b
-  real ( kind = 8 ) hg
-  real ( kind = 8 ) hg1
-  real ( kind = 8 ) hg2
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) la
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  integer ( kind = 4 ) nl
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) r2
-  real ( kind = 8 ) rg
-  real ( kind = 8 ) sum1
-  real ( kind = 8 ) sum2
-  real ( kind = 8 ) ta
-  real ( kind = 8 ) tb
-  real ( kind = 8 ) tba
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x0
-  real ( kind = 8 ) xg
-  real ( kind = 8 ) y0
-  real ( kind = 8 ) y1
-
-  pi = 3.141592653589793D+00
-  a0 = a
-  a1 = a
-  x0 = x
-  hg = 0.0D+00
-
-  if ( b == 0.0D+00 .or. b == - abs ( int ( b ) ) ) then
-    hg = 1.0D+300
-  else if ( a == 0.0D+00 .or. x == 0.0D+00 ) then
-    hg = 1.0D+00
-  else if ( a == -1.0D+00 ) then
-    hg = 1.0D+00 - x / b
-  else if ( a == b ) then
-    hg = exp ( x )
-  else if ( a - b == 1.0D+00 ) then
-    hg = ( 1.0D+00 + x / b ) * exp ( x )
-  else if ( a == 1.0D+00 .and. b == 2.0D+00 ) then
-    hg = ( exp ( x ) - 1.0D+00 ) / x
-  else if ( a == int ( a ) .and. a < 0.0D+00 ) then
-    m = int ( - a )
-    r = 1.0D+00
-    hg = 1.0D+00
-    do k = 1, m
-      r = r * ( a + k - 1.0D+00 ) / k / ( b + k - 1.0D+00 ) * x
-      hg = hg + r
-    end do
-  end if
-
-  if ( hg /= 0.0D+00 ) then
-    return
-  end if
-
-  if ( x < 0.0D+00 ) then
-    a = b - a
-    a0 = a
-    x = abs ( x )
-  end if
-
-  if ( a < 2.0D+00 ) then
-    nl = 0
-  end if
-
-  if ( 2.0D+00 <= a ) then
-    nl = 1
-    la = int ( a )
-    a = a - la - 1.0D+00
-  end if
-
-  do n = 0, nl
-
-    if ( 2.0D+00 <= a0 ) then
-      a = a + 1.0D+00
-    end if
-
-    if ( x <= 30.0D+00 + abs ( b ) .or. a < 0.0D+00 ) then
-
-      hg = 1.0D+00
-      rg = 1.0D+00
-      do j = 1, 500
-        rg = rg * ( a + j - 1.0D+00 ) &
-          / ( j * ( b + j - 1.0D+00 ) ) * x
-        hg = hg + rg
-        if ( abs ( rg / hg ) < 1.0D-15 ) then
-          exit
-        end if
-      end do
-
-    else
-
-      call gamma ( a, ta )
-      call gamma ( b, tb )
-      xg = b - a
-      call gamma ( xg, tba )
-      sum1 = 1.0D+00
-      sum2 = 1.0D+00
-      r1 = 1.0D+00
-      r2 = 1.0D+00
-      do i = 1, 8
-        r1 = - r1 * ( a + i - 1.0D+00 ) * ( a - b + i ) / ( x * i )
-        r2 = - r2 * ( b - a + i - 1.0D+00 ) * ( a - i ) / ( x * i )
-        sum1 = sum1 + r1
-        sum2 = sum2 + r2
-      end do
-      hg1 = tb / tba * x ** ( - a ) * cos ( pi * a ) * sum1
-      hg2 = tb / ta * exp ( x ) * x ** ( a - b ) * sum2
-      hg = hg1 + hg2
-
-    end if
-
-    if ( n == 0 ) then
-      y0 = hg
-    else if ( n == 1 ) then
-      y1 = hg
-    end if
-
-  end do
-
-  if ( 2.0D+00 <= a0 ) then
-    do i = 1, la - 1
-      hg = ( ( 2.0D+00 * a - b + x ) * y1 + ( b - a ) * y0 ) / a
-      y0 = y1
-      y1 = hg
-      a = a + 1.0D+00
-    end do
-  end if
-
-  if ( x0 < 0.0D+00 ) then
-    hg = hg * exp ( x0 )
-  end if
-
-  a = a1
-  x = x0
-
-  return
-end
-subroutine chgu ( a, b, x, hu, md )
-
-!*****************************************************************************80
-!
-!! CHGU computes the confluent hypergeometric function U(a,b,x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    27 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-! 
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) A, B, parameters.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) HU, U(a,b,x).
-!
-!    Output, integer ( kind = 4 ) MD, the method code.
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) a00
-  real ( kind = 8 ) aa
-  real ( kind = 8 ) b
-  real ( kind = 8 ) b00
-  logical bl1
-  logical bl2
-  logical bl3
-  logical bn
-  real ( kind = 8 ) hu
-  real ( kind = 8 ) hu1
-  integer ( kind = 4 ) id
-  integer ( kind = 4 ) id1
-  logical il1
-  logical il2
-  logical il3
-  integer ( kind = 4 ) md
-  real ( kind = 8 ) x
-
-  aa = a - b + 1.0D+00
-  il1 = a == int ( a ) .and. a <= 0.0D+00
-  il2 = aa == int ( aa ) .and. aa <= 0.0D+00
-  il3 = abs ( a * ( a - b + 1.0D+00 ) ) / x <= 2.0D+00
-  bl1 = x <= 5.0D+00 .or. ( x <= 10.0D+00 .and. a <= 2.0D+00 )
-  bl2 = ( 5.0D+00 < x .and. x <= 12.5D+00 ) .and. &
-    ( 1.0D+00 <= a .and. a + 4.0D+00 <= b )
-  bl3 = 12.5D+00 < x .and. 5.0D+00 <= a .and. a + 5.0D+00 <= b
-  bn = b == int ( b ) .and. b .ne. 0.0D+00
-  id1 = -100
-
-  if ( b .ne. int ( b ) ) then
-    call chgus ( a, b, x, hu, id1 )
-    md = 1
-    if ( 6 <= id1 ) then
-      return
-    end if
-    hu1 = hu
-  end if
-
-  if ( il1 .or. il2 .or. il3 ) then
-    call chgul ( a, b, x, hu, id )
-    md = 2
-    if ( 6 <= id ) then
-      return
-    end if
-    if ( id < id1 ) then
-      md = 1
-      id = id1
-      hu = hu1
-    end if
-  end if
-
-  if ( 0.0D+00 <= a ) then
-    if ( bn .and. ( bl1 .or. bl2 .or. bl3 ) ) then
-      call chgubi ( a, b, x, hu, id )
-      md = 3
-    else
-      call chguit ( a, b, x, hu, id )
-      md = 4
-    end if
-  else
-    if ( b <= a ) then
-      a00 = a
-      b00 = b
-      a = a - b + 1.0D+00
-      b = 2.0D+00 - b
-      call chguit ( a, b, x, hu, id )
-      hu = x ** ( 1.0D+00 - b00 ) * hu
-      a = a00
-      b = b00
-      md = 4
-    else if ( bn .and. ( .not. il1 ) ) then
-      call chgubi ( a, b, x, hu, id )
-      md = 3
-    end if
-  end if
-
-  if ( id < 6 ) then
-    write ( *, '(a)' ) ' '
-    write ( *, '(a)' ) 'CHGU - Warning!'
-    write ( *, '(a)' ) '  Accurate results were not obtained.'
-  end if
-
-  return
-end
-subroutine chgubi ( a, b, x, hu, id )
-
-!*****************************************************************************80
-!
-!! CHGUBI: confluent hypergeometric function with integer argument B.
-!
-!  Discussion:
-!
-!    This procedure computes the confluent hypergeometric function
-!    U(a,b,x) with integer ( kind = 4 ) b ( b = ń1,ń2,... )
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    31 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) A, B, parameters.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) HU, the value of U(a,b,x).
-!
-!    Output, integer ( kind = 4 ) ID, the estimated number of significant
-!    digits.
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) a1
-  real ( kind = 8 ) a2
-  real ( kind = 8 ) b
-  real ( kind = 8 ) da1
-  real ( kind = 8 ) da2
-  real ( kind = 8 ) db1
-  real ( kind = 8 ) db2
-  real ( kind = 8 ) el
-  real ( kind = 8 ) ga
-  real ( kind = 8 ) ga1
-  real ( kind = 8 ) h0
-  real ( kind = 8 ) hm1
-  real ( kind = 8 ) hm2
-  real ( kind = 8 ) hm3
-  real ( kind = 8 ) hmax
-  real ( kind = 8 ) hmin
-  real ( kind = 8 ) hu
-  real ( kind = 8 ) hu1
-  real ( kind = 8 ) hu2
-  real ( kind = 8 ) hw
-  integer ( kind = 4 ) id
-  integer ( kind = 4 ) id1
-  integer ( kind = 4 ) id2
-  integer ( kind = 4 ) j 
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) ps
-  real ( kind = 8 ) r
-  real ( kind = 8 ) rn
-  real ( kind = 8 ) rn1
-  real ( kind = 8 ) s0
-  real ( kind = 8 ) s1
-  real ( kind = 8 ) s2
-  real ( kind = 8 ) sa
-  real ( kind = 8 ) sb
-  real ( kind = 8 ) ua
-  real ( kind = 8 ) ub
-  real ( kind = 8 ) x
-
-  id = - 100
-  el = 0.5772156649015329D+00
-  n = int ( abs ( b - 1 ) )
-  rn1 = 1.0D+00
-  rn = 1.0D+00
-  do j = 1, n
-    rn = rn * j
-    if ( j == n - 1 ) then
-      rn1 = rn
-    end if
-  end do
-
-  call psi ( a, ps )
-  call gamma ( a, ga )
-
-  if ( 0.0D+00 < b ) then
-    a0 = a
-    a1 = a - n
-    a2 = a1
-    call gamma ( a1, ga1 )
-    ua = ( - 1 ) ** ( n - 1 ) / ( rn * ga1 )
-    ub = rn1 / ga * x ** ( - n )
-  else
-    a0 = a + n
-    a1 = a0
-    a2 = a
-    call gamma ( a1, ga1 )
-    ua = ( - 1 ) ** ( n - 1 ) / ( rn * ga ) * x ** n
-    ub = rn1 / ga1
-  end if
-
-  hm1 = 1.0D+00
-  r = 1.0D+00
-  hmax = 0.0D+00
-  hmin = 1.0D+300
-
-  do k = 1, 150
-    r = r * ( a0 + k - 1.0D+00 ) * x / ( ( n + k ) * k )
-    hm1 = hm1 + r
-    hu1 = abs ( hm1 )
-    hmax = max ( hmax, hu1 )
-    hmin = min ( hmin, hu1 )
-    if ( abs ( hm1 - h0 ) < abs ( hm1 ) * 1.0D-15 ) then
-      exit
-    end if
-    h0 = hm1
-  end do
-
-  da1 = log10 ( hmax )
-  if ( hmin /= 0.0D+00 ) then
-    da2 = log10 ( hmin )
-  end if
-  id = 15 - int ( abs ( da1 - da2 ) )
-  hm1 = hm1 * log ( x )
-  s0 = 0.0D+00
-  do m = 1, n
-    if ( 0.0D+00 <= b ) then
-      s0 = s0 - 1.0D+00 / m
-    else
-      s0 = s0 + ( 1.0D+00 - a ) / ( m * ( a + m - 1.0D+00 ) )
-    end if
-  end do
-  hm2 = ps + 2.0D+00 * el + s0
-  r = 1.0D+00
-  hmax = 0.0D+00
-  hmin = 1.0D+300
-  do k = 1, 150
-    s1 = 0.0D+00
-    s2 = 0.0D+00
-    if ( 0.0D+00 < b ) then
-      do m = 1, k
-        s1 = s1 - ( m + 2.0D+00 * a - 2.0D+00 ) / ( m * ( m + a - 1.0D+00 ) )
-      end do
-      do m = 1, n
-        s2 = s2 + 1.0D+00 / ( k + m )
-      end do
-    else
-      do m = 1, k + n
-        s1 = s1 + ( 1.0D+00 - a ) / ( m * ( m + a - 1.0D+00 ) )
-      end do
-      do m = 1, k
-        s2 = s2 + 1.0D+00 / m
-      end do
-    end if
-    hw = 2.0D+00 * el + ps + s1 - s2
-    r = r * ( a0 + k - 1.0D+00 ) * x / ( ( n + k ) * k )
-    hm2 = hm2 + r * hw
-    hu2 = abs ( hm2 )
-    hmax = max ( hmax, hu2 )
-    hmin = min ( hmin, hu2 )
-
-    if ( abs ( ( hm2 - h0 ) / hm2 ) < 1.0D-15 ) then
-      exit
-    end if
-
-    h0 = hm2
-
-  end do
-
-  db1 = log10 ( hmax )
-  if ( hmin /= 0.0D+00 ) then
-    db2 = log10 ( hmin )
-  end if
-  id1 = 15 - int ( abs ( db1 - db2 ) )
-  id = min ( id, id1 )
-
-  if ( n == 0 ) then
-    hm3 = 0.0D+00
-  else
-    hm3 = 1.0D+00
-  end if
-
-  r = 1.0D+00
-  do k = 1, n - 1
-    r = r * ( a2 + k - 1.0D+00 ) / ( ( k - n ) * k ) * x
-    hm3 = hm3 + r
-  end do
-
-  sa = ua * ( hm1 + hm2 )
-  sb = ub * hm3
-  hu = sa + sb
-
-  if ( sa /= 0.0D+00 ) then
-    id1 = int ( log10 ( abs ( sa ) ) )
-  end if
-
-  if ( hu /= 0.0D+00 ) then
-    id2 = int ( log10 ( abs ( hu ) ) )
-  end if
-
-  if ( sa * sb < 0.0D+00 ) then
-    id = id - abs ( id1 - id2 )
-  end if
-
-  return
-end
-subroutine chguit ( a, b, x, hu, id )
-
-!*****************************************************************************80
-!
-!! CHGUIT computes the hypergeometric function using Gauss-Legendre integration.
-!
-!  Discussion:
-!
-!    This procedure computes the hypergeometric function U(a,b,x) by
-!    using Gaussian-Legendre integration (n = 60)
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    22 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, double precision A, B, parameters.
-!
-!    Input, double precision X, the argument.
-!
-!    Output, double precision HU, U(a,b,z).
-!
-!    Output, integer ID, the estimated number of significant digits.
-!
-  implicit none
-
-  double precision a
-  double precision a1
-  double precision b
-  double precision b1
-  double precision c
-  double precision d
-  double precision f1
-  double precision f2
-  double precision g
-  double precision ga
-  double precision hu
-  double precision hu0
-  double precision hu1
-  double precision hu2
-  integer id
-  integer j
-  integer k
-  integer m
-  double precision s
-  double precision, save, dimension ( 30 ) :: t = (/ &
-    0.259597723012478D-01, 0.778093339495366D-01, &
-    0.129449135396945D+00, 0.180739964873425D+00, &
-    0.231543551376029D+00, 0.281722937423262D+00, &
-    0.331142848268448D+00, 0.379670056576798D+00, &
-    0.427173741583078D+00, 0.473525841761707D+00, &
-    0.518601400058570D+00, 0.562278900753945D+00, &
-    0.604440597048510D+00, 0.644972828489477D+00, &
-    0.683766327381356D+00, 0.720716513355730D+00, &
-    0.755723775306586D+00, 0.788693739932264D+00, &
-    0.819537526162146D+00, 0.848171984785930D+00, &
-    0.874519922646898D+00, 0.898510310810046D+00, &
-    0.920078476177628D+00, 0.939166276116423D+00, &
-    0.955722255839996D+00, 0.969701788765053D+00, &
-    0.981067201752598D+00, 0.989787895222222D+00, &
-    0.995840525118838D+00, 0.999210123227436D+00 /)
-  double precision t1
-  double precision t2
-  double precision t3
-  double precision t4
-  double precision, save, dimension ( 30 ) :: w = (/ &
-    0.519078776312206D-01, 0.517679431749102D-01, &
-    0.514884515009810D-01, 0.510701560698557D-01, &
-    0.505141845325094D-01, 0.498220356905502D-01, &
-    0.489955754557568D-01, 0.480370318199712D-01, &
-    0.469489888489122D-01, 0.457343797161145D-01, &
-    0.443964787957872D-01, 0.429388928359356D-01, &
-    0.413655512355848D-01, 0.396806954523808D-01, &
-    0.378888675692434D-01, 0.359948980510845D-01, &
-    0.340038927249464D-01, 0.319212190192963D-01, &
-    0.297524915007890D-01, 0.275035567499248D-01, &
-    0.251804776215213D-01, 0.227895169439978D-01, &
-    0.203371207294572D-01, 0.178299010142074D-01, &
-    0.152746185967848D-01, 0.126781664768159D-01, &
-    0.100475571822880D-01, 0.738993116334531D-02, &
-    0.471272992695363D-02, 0.202681196887362D-02 /)
-  double precision x
-
-  id = 7
-  a1 = a - 1.0D+00
-  b1 = b - a - 1.0D+00
-  c = 12.0D+00 / x
-
-  do m = 10, 100, 5
-
-    hu1 = 0.0D+00
-    g = 0.5D+00 * c / m
-    d = g
-    do j = 1, m
-      s = 0.0D+00
-      do k = 1, 30
-        t1 = d + g * t(k)
-        t2 = d - g * t(k)
-        f1 = exp ( - x * t1 ) * t1 ** a1 * ( 1.0D+00 + t1 ) ** b1
-        f2 = exp ( - x * t2 ) * t2 ** a1 * ( 1.0D+00 + t2 ) ** b1
-        s = s + w(k) * ( f1 + f2 )
-      end do
-      hu1 = hu1 + s * g
-      d = d + 2.0D+00 * g
-    end do
-
-    if ( abs ( 1.0D+00 - hu0 / hu1 ) < 1.0D-07 ) then
-      exit
-    end if
-
-    hu0 = hu1
-
-  end do
-
-  call gamma ( a, ga )
-  hu1 = hu1 / ga
-
-  do m = 2, 10, 2
-    hu2 = 0.0D+00
-    g = 0.5D+00 / m
-    d = g
-    do j = 1, m
-      s = 0.0D+00
-      do k = 1, 30
-        t1 = d + g * t(k)
-        t2 = d - g * t(k)
-        t3 = c / ( 1.0D+00 - t1 )
-        t4 = c / ( 1.0D+00 - t2 ) 
-        f1 = t3 * t3 / c * exp ( - x * t3 ) * t3 ** a1 * ( 1.0D+00 + t3 ) ** b1
-        f2 = t4 * t4 / c * exp ( - x * t4 ) * t4 ** a1 * ( 1.0D+00 + t4 ) ** b1
-        s = s + w(k) * ( f1 + f2 )
-      end do
-      hu2 = hu2 + s * g
-      d = d + 2.0D+00 * g
-    end do
-
-    if ( abs ( 1.0D+00 - hu0 / hu2 ) < 1.0D-07 ) then
-      exit
-    end if
-
-    hu0 = hu2
-
-  end do
-
-  call gamma ( a, ga )
-  hu2 = hu2 / ga
-  hu = hu1 + hu2
-
-  return
-end
-subroutine chgul ( a, b, x, hu, id )
-
-!*****************************************************************************80
-!
-!! CHGUL: confluent hypergeometric function U(a,b,x) for large argument X.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    22 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-! 
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) A, B, parameters.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) HU, the value of U(a,b,x).
-!
-!    Output, integer ( kind = 4 ) ID, the estimated number of 
-!    significant digits.
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) aa
-  real ( kind = 8 ) b
-  real ( kind = 8 ) hu
-  integer ( kind = 4 ) id
-  logical il1
-  logical il2
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) r
-  real ( kind = 8 ) ra
-  real ( kind = 8 ) r0
-  real ( kind = 8 ) x
-
-  id = -100
-  aa = a - b + 1.0D+00
-  il1 = ( a == int ( a ) ) .and. ( a <= 0.0D+00 )
-  il2 = ( aa == int ( aa ) ) .and. ( aa <= 0.0D+00 )
-
-  if ( il1 .or. il2 ) then
-
-    if ( il1 ) then
-      nm = int ( abs ( a ) )
-    end if
-
-    if ( il2 ) then
-      nm = int ( abs ( aa ) )
-    end if
-
-    hu = 1.0D+00
-    r = 1.0D+00
-    do k = 1, nm
-      r = - r * ( a + k - 1.0D+00 ) * ( a - b + k ) / ( k * x )
-      hu = hu + r
-    end do
-    hu = x ** ( - a ) * hu
-    id = 10
-
-  else
-
-    hu = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 25
-      r = - r * ( a + k - 1.0D+00 ) * ( a - b + k ) / ( k * x )
-      ra = abs ( r )
-      if ( ( 5 < k .and. r0 <= ra ) .or. ra < 1.0D-15 ) then
-        exit
-      end if
-      r0 = ra
-      hu = hu + r
-    end do
-
-    id = int ( abs ( log10 ( ra ) ) )
-    hu = x ** ( - a ) * hu
-
-  end if
-
-  return
-end
-subroutine chgus ( a, b, x, hu, id )
-
-!*****************************************************************************80
-!
-!! CHGUS: confluent hypergeometric function U(a,b,x) for small argument X.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    27 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) A, B, parameters.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) HU, U(a,b,x).
-!
-!    Output, integer ( kind = 4 ) ID, the estimated number of 
-!    significant digits.
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) b
-  real ( kind = 8 ) d1
-  real ( kind = 8 ) d2
-  real ( kind = 8 ) ga
-  real ( kind = 8 ) gab
-  real ( kind = 8 ) gb
-  real ( kind = 8 ) gb2
-  real ( kind = 8 ) h0
-  real ( kind = 8 ) hmax
-  real ( kind = 8 ) hmin
-  real ( kind = 8 ) hu
-  real ( kind = 8 ) hu0
-  real ( kind = 8 ) hua
-  integer ( kind = 4 ) id
-  integer ( kind = 4 ) j
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) r2
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xg1
-  real ( kind = 8 ) xg2
-
-  id = -100
-  pi = 3.141592653589793D+00
-  call gamma ( a, ga )
-  call gamma ( b, gb )
-  xg1 = 1.0D+00 + a - b
-  call gamma ( xg1, gab )
-  xg2 = 2.0D+00 - b
-  call gamma ( xg2, gb2 )
-  hu0 = pi / sin ( pi * b )
-  r1 = hu0 / ( gab * gb )
-  r2 = hu0 * x ** ( 1.0D+00 - b ) / ( ga * gb2 )
-  hu = r1 - r2
-  hmax = 0.0D+00
-  hmin = 1.0D+300
-  do j = 1, 150
-    r1 = r1 * ( a + j - 1.0D+00 ) / ( j * ( b + j - 1.0D+00 ) ) * x
-    r2 = r2 * ( a - b + j ) / ( j * ( 1.0D+00 - b + j ) ) * x
-    hu = hu + r1 - r2
-    hua = abs ( hu )
-    hmax = max ( hmax, hua )
-    hmin = min ( hmin, hua )
-    if ( abs ( hu - h0 ) < abs ( hu ) * 1.0D-15 ) then
-      exit
-    end if
-    h0 = hu
-  end do
-
-  d1 = log10 ( hmax )
-  if ( hmin /= 0.0D+00 ) then
-    d2 = log10 ( hmin )
-  end if
-  id = 15 - int ( abs ( d1 - d2 ) )
-
-  return
-end
-subroutine cik01 ( z, cbi0, cdi0, cbi1, cdi1, cbk0, cdk0, cbk1, cdk1 )
-
-!*****************************************************************************80
-!
-!! CIK01: modified Bessel I0(z), I1(z), K0(z) and K1(z) for complex argument.
-!
-!  Discussion:
-!
-!    This procedure computes the modified Bessel functions I0(z), I1(z), 
-!    K0(z), K1(z), and their derivatives for a complex argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    31 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-! 
-!  Parameters:
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, complex ( kind = 8 ) CBI0, CDI0, CBI1, CDI1, CBK0, CDK0, CBK1, 
-!    CDK1, the values of I0(z), I0'(z), I1(z), I1'(z), K0(z), K0'(z), K1(z), 
-!    and K1'(z).
-!
-  implicit none
-
-  real ( kind = 8 ), save, dimension ( 12 ) :: a = (/ &
-    0.125D+00,           7.03125D-02,&
-    7.32421875D-02,      1.1215209960938D-01,&
-    2.2710800170898D-01, 5.7250142097473D-01,&
-    1.7277275025845D+00, 6.0740420012735D+00,&
-    2.4380529699556D+01, 1.1001714026925D+02,&
-    5.5133589612202D+02, 3.0380905109224D+03 /)
-  real ( kind = 8 ) a0
-  real ( kind = 8 ), save, dimension ( 10 ) :: a1 = (/ &
-    0.125D+00,            0.2109375D+00, &
-    1.0986328125D+00,     1.1775970458984D+01, &
-    2.1461706161499D+002, 5.9511522710323D+03, &
-    2.3347645606175D+05,  1.2312234987631D+07, &
-    8.401390346421D+08,   7.2031420482627D+10 /)
-  real ( kind = 8 ), save, dimension ( 12 ) :: b = (/ &
-   -0.375D+00,           -1.171875D-01, &
-   -1.025390625D-01,     -1.4419555664063D-01, &
-   -2.7757644653320D-01, -6.7659258842468D-01, &
-   -1.9935317337513D+00, -6.8839142681099D+00, &
-   -2.7248827311269D+01, -1.2159789187654D+02, &
-   -6.0384407670507D+02, -3.3022722944809D+03 /)
-  complex ( kind = 8 ) ca
-  complex ( kind = 8 ) cb
-  complex ( kind = 8 ) cbi0
-  complex ( kind = 8 ) cbi1
-  complex ( kind = 8 ) cbk0
-  complex ( kind = 8 ) cbk1
-  complex ( kind = 8 ) cdi0
-  complex ( kind = 8 ) cdi1
-  complex ( kind = 8 ) cdk0
-  complex ( kind = 8 ) cdk1
-  complex ( kind = 8 ) ci
-  complex ( kind = 8 ) cr
-  complex ( kind = 8 ) cs
-  complex ( kind = 8 ) ct
-  complex ( kind = 8 ) cw
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k0
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) w0
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) z1
-  complex ( kind = 8 ) z2
-  complex ( kind = 8 ) zr
-  complex ( kind = 8 ) zr2
-
-  pi = 3.141592653589793D+00
-  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
-  a0 = abs ( z )
-  z2 = z * z
-  z1 = z
-
-  if ( a0 == 0.0D+00 ) then
-    cbi0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cbi1 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-    cdi0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-    cdi1 = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
-    cbk0 = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-    cbk1 = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-    cdk0 = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-    cdk1 = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-    return
-  end if
-
-  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
-    z1 = -z
-  end if
-
-  if ( a0 <= 18.0D+00 ) then
-
-    cbi0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, 50
-      cr = 0.25D+00 * cr * z2 / ( k * k )
-      cbi0 = cbi0 + cr
-      if ( abs ( cr / cbi0 ) < 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    cbi1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, 50
-      cr = 0.25D+00 * cr * z2 / ( k * ( k + 1 ) )
-      cbi1 = cbi1 + cr
-      if ( abs ( cr / cbi1 ) < 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    cbi1 = 0.5D+00 * z1 * cbi1
-
-  else
-
-    if ( a0 < 35.0D+00 ) then
-      k0 = 12
-    else if ( a0 < 50.0D+00 ) then
-      k0 = 9
-    else
-      k0 = 7
-    end if
-
-    ca = exp ( z1 ) / sqrt ( 2.0D+00 * pi * z1 )
-    cbi0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    zr = 1.0D+00 / z1
-    do k = 1, k0
-      cbi0 = cbi0 + a(k) * zr ** k
-    end do
-    cbi0 = ca * cbi0
-    cbi1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, k0
-      cbi1 = cbi1 + b(k) * zr ** k
-    end do
-    cbi1 = ca * cbi1
-
-  end if
-
-  if ( a0 <= 9.0D+00 ) then
-
-    cs = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-    ct = - log ( 0.5D+00 * z1 ) - 0.5772156649015329D+00
-    w0 = 0.0D+00
-    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, 50
-      w0 = w0 + 1.0D+00 / k
-      cr = 0.25D+00 * cr / ( k * k ) * z2
-      cs = cs + cr * ( w0 + ct )
-      if ( abs ( ( cs - cw ) / cs ) < 1.0D-15 ) then
-        exit
-      end if
-      cw = cs
-    end do
-
-    cbk0 = ct + cs
-
-  else
-
-    cb = 0.5D+00 / z1
-    zr2 = 1.0D+00 / z2
-    cbk0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, 10
-      cbk0 = cbk0 + a1(k) * zr2 ** k
-    end do
-    cbk0 = cb * cbk0 / cbi0
-
-  end if
-
-  cbk1 = ( 1.0D+00 / z1 - cbi1 * cbk0 ) / cbi0
-
-  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
-
-    if ( imag ( z ) < 0.0D+00 ) then
-      cbk0 = cbk0 + ci * pi * cbi0
-      cbk1 = - cbk1 + ci * pi * cbi1
-    else
-      cbk0 = cbk0 - ci * pi * cbi0
-      cbk1 = - cbk1 - ci * pi * cbi1
-    end if
-
-    cbi1 = - cbi1
-
-  end if
-
-  cdi0 = cbi1
-  cdi1 = cbi0 - 1.0D+00 / z * cbi1
-  cdk0 = - cbk1
-  cdk1 = - cbk0 - 1.0D+00 / z * cbk1
-
-  return
-end
-subroutine ciklv ( v, z, cbiv, cdiv, cbkv, cdkv )
-
-!*****************************************************************************80
-!
-!! CIKLV: modified Bessel functions Iv(z), Kv(z), complex argument, large order.
-!
-!  Discussion:
-!
-!    This procedure computes modified Bessel functions Iv(z) and
-!    Kv(z) and their derivatives with a complex argument and a large order.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    31 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) V, the order of Iv(z) and Kv(z).
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, real ( kind = 8 ) CBIV, CDIV, CBKV, CDKV, the values of
-!    Iv(z), Iv'(z), Kv(z), Kv'(z).
-!
-  implicit none
-
-  real ( kind = 8 ) a(91)
-  complex ( kind = 8 ) cbiv
-  complex ( kind = 8 ) cbkv
-  complex ( kind = 8 ) cdiv
-  complex ( kind = 8 ) cdkv
-  complex ( kind = 8 ) ceta
-  complex ( kind = 8 ) cf(12)
-  complex ( kind = 8 ) cfi
-  complex ( kind = 8 ) cfk
-  complex ( kind = 8 ) csi
-  complex ( kind = 8 ) csk
-  complex ( kind = 8 ) ct
-  complex ( kind = 8 ) ct2
-  complex ( kind = 8 ) cws
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) km
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) l0
-  integer ( kind = 4 ) lf
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) v
-  real ( kind = 8 ) v0
-  real ( kind = 8 ) vr
-  complex ( kind = 8 ) z
-
-  pi = 3.141592653589793D+00
-  km = 12
-  call cjk ( km, a )
-
-  do l = 1, 0, -1
-
-    v0 = v - l
-    cws = sqrt ( 1.0D+00 + ( z / v0 ) * ( z / v0 ) )
-    ceta = cws + log ( z / v0 / ( 1.0D+00 + cws ) )
-    ct = 1.0D+00 / cws
-    ct2 = ct * ct
-    do k = 1, km
-      l0 = k * ( k + 1 ) / 2 + 1
-      lf = l0 + k
-      cf(k) = a(lf)
-      do i = lf - 1, l0, -1
-        cf(k) = cf(k) * ct2 + a(i)
-      end do
-      cf(k) = cf(k) * ct ** k
-    end do
-    vr = 1.0D+00 / v0
-    csi = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, km
-      csi = csi + cf(k) * vr ** k
-    end do
-    cbiv = sqrt ( ct / ( 2.0D+00 * pi * v0 ) ) * exp ( v0 * ceta ) * csi
-    if ( l == 1 ) then
-      cfi = cbiv
-    end if
-    csk = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, km
-      csk = csk + ( - 1 ) ** k * cf(k) * vr ** k
-    end do
-    cbkv = sqrt ( pi * ct / ( 2.0D+00 * v0 ) ) * exp ( - v0 * ceta ) * csk
-
-    if ( l == 1 ) then
-      cfk = cbkv
-    end if
-
-  end do
-
-  cdiv =   cfi - v / z * cbiv
-  cdkv = - cfk - v / z * cbkv
-
-  return
-end
-subroutine cikna ( n, z, nm, cbi, cdi, cbk, cdk )
-
-!*****************************************************************************80
-!
-!! CIKNA: modified Bessel functions In(z), Kn(z), derivatives, complex argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    30 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order of In(z) and Kn(z).
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, integer ( kind = 4 ) NM, the highest order computed.
-!
-!    Output, complex ( kind = 8 ) CBI((0:N), CDI(0:N), CBK(0:N), CDK(0:N), 
-!    the values of In(z), In'(z), Kn(z), Kn'(z).
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) a0
-  complex ( kind = 8 ) cbi(0:n)
-  complex ( kind = 8 ) cbi0
-  complex ( kind = 8 ) cbi1
-  complex ( kind = 8 ) cbk(0:n)
-  complex ( kind = 8 ) cbk0
-  complex ( kind = 8 ) cbk1
-  complex ( kind = 8 ) cdi(0:n)
-  complex ( kind = 8 ) cdi0
-  complex ( kind = 8 ) cdi1
-  complex ( kind = 8 ) cdk(0:n)
-  complex ( kind = 8 ) cdk0
-  complex ( kind = 8 ) cdk1
-  complex ( kind = 8 ) cf
-  complex ( kind = 8 ) cf1
-  complex ( kind = 8 ) cf2
-  complex ( kind = 8 ) ckk
-  complex ( kind = 8 ) cs
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) nm
-  complex ( kind = 8 ) z
-
-  a0 = abs ( z )
-  nm = n
-
-  if ( a0 < 1.0D-100 ) then
-    do k = 0, n
-      cbi(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      cdi(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      cbk(k) = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-      cdk(k) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-    end do
-    cbi(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cdi(1) = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
-    return
-  end if
-
-  call cik01 ( z, cbi0, cdi0, cbi1, cdi1, cbk0, cdk0, cbk1, cdk1 )
-
-  cbi(0) = cbi0
-  cbi(1) = cbi1
-  cbk(0) = cbk0
-  cbk(1) = cbk1
-  cdi(0) = cdi0
-  cdi(1) = cdi1
-  cdk(0) = cdk0
-  cdk(1) = cdk1
-
-  if ( n <= 1 ) then
-    return
-  end if
-
-  m = msta1 ( a0, 200 )
-
-  if ( m < n ) then
-    nm = m
-  else
-    m = msta2 ( a0, n, 15 )
-  end if
-
-  cf2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-  cf1 = cmplx ( 1.0D-30, 0.0D+00, kind = 8 )
-  do k = m, 0, -1
-    cf = 2.0D+00 * ( k + 1.0D+00 ) / z * cf1 + cf2
-    if ( k <= nm ) then
-      cbi(k) = cf
-    end if
-    cf2 = cf1
-    cf1 = cf
-  end do
-
-  cs = cbi0 / cf
-  do k = 0, nm
-    cbi(k) = cs * cbi(k)
-  end do
-
-  do k = 2, nm
-    if ( abs ( cbi(k-2) ) < abs ( cbi(k-1) ) ) then
-      ckk = ( 1.0D+00 / z - cbi(k) * cbk(k-1) ) / cbi(k-1)
-    else
-      ckk = ( cbi(k) * cbk(k-2) + 2.0D+00 * ( k - 1.0D+00 ) &
-        / ( z * z ) ) / cbi(k-2)
-    end if
-    cbk(k) = ckk
-  end do
-
-  do k = 2, nm
-    cdi(k) =   cbi(k-1) - k / z * cbi(k)
-    cdk(k) = - cbk(k-1) - k / z * cbk(k)
-  end do
-
-  return
-end
-subroutine ciknb ( n, z, nm, cbi, cdi, cbk, cdk )
-
-!*****************************************************************************80
-!
-!! CIKNB computes complex modified Bessel functions In(z) and Kn(z).
-!
-!  Discussion:
-!
-!    This procedure also evaluates the derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    30 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order of In(z) and Kn(z).
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, integer ( kind = 4 ) NM, the highest order computed.
-!
-!    Output, complex ( kind = 8 ) CB((0:N), CDI(0:N), CBK(0:N), CDK(0:N), 
-!    the values of In(z), In'(z), Kn(z), Kn'(z).
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) a0
-  complex ( kind = 8 ) ca0
-  complex ( kind = 8 ) cbi(0:n)
-  complex ( kind = 8 ) cbkl
-  complex ( kind = 8 ) cbs
-  complex ( kind = 8 ) cdi(0:n)
-  complex ( kind = 8 ) cbk(0:n)
-  complex ( kind = 8 ) cdk(0:n)
-  complex ( kind = 8 ) cf
-  complex ( kind = 8 ) cf0
-  complex ( kind = 8 ) cf1
-  complex ( kind = 8 ) cg
-  complex ( kind = 8 ) cg0
-  complex ( kind = 8 ) cg1
-  complex ( kind = 8 ) ci
-  complex ( kind = 8 ) cr
-  complex ( kind = 8 ) cs0
-  complex ( kind = 8 ) csk0
-  real ( kind = 8 ) el
-  real ( kind = 8 ) fac
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k0
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) vt
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) z1
-
-  pi = 3.141592653589793D+00
-  el = 0.57721566490153D+00
-  a0 = abs ( z )
-  nm = n
-
-  if ( a0 < 1.0D-100 ) then
-    do k = 0, n
-      cbi(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      cbk(k) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-      cdi(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      cdk(k) = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-    end do
-    cbi(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cdi(1) = cmplx ( 0.5D+00, 0.0D+00, kind = 8 ) 
-    return
-  end if
-
-  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
-
-  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
-    z1 = -z
-  else
-    z1 = z
-  end if
-
-  if ( n == 0 ) then
-    nm = 1
-  end if
-
-  m = msta1 ( a0, 200 )
-
-  if ( m < nm ) then
-    nm = m
-  else
-    m = msta2 ( a0, nm, 15 )
-  end if
-
-  cbs = 0.0D+00
-  csk0 = 0.0D+00
-  cf0 = 0.0D+00
-  cf1 = 1.0D-100
-
-  do k = m, 0, -1
-    cf = 2.0D+00 * ( k + 1.0D+00 ) * cf1 / z1 + cf0
-    if ( k <= nm ) then
-      cbi(k) = cf
-    end if
-    if ( k /= 0 .and. k == 2 * int ( k / 2 ) ) then
-      csk0 = csk0 + 4.0D+00 * cf / k
-    end if
-    cbs = cbs + 2.0D+00 * cf
-    cf0 = cf1
-    cf1 = cf
-  end do
-
-  cs0 = exp ( z1 ) / ( cbs - cf )
-
-  do k = 0, nm
-    cbi(k) = cs0 * cbi(k)
-  end do
-
-  if ( a0 <= 9.0D+00 ) then
-
-    cbk(0) = - ( log ( 0.5D+00 * z1 ) + el ) * cbi(0) + cs0 * csk0
-    cbk(1) = ( 1.0D+00 / z1 - cbi(1) * cbk(0) ) / cbi(0)
-
-  else
-
-    ca0 = sqrt ( pi / ( 2.0D+00 * z1 ) ) * exp ( -z1 )
-
-    if ( a0 < 25.0D+00 ) then
-      k0 = 16
-    else if ( a0 < 80.0D+00 ) then
-      k0 = 10
-    else if ( a0 < 200.0D+00 ) then
-      k0 = 8
-    else
-      k0 = 6
-    end if
-
-    do l = 0, 1
-      cbkl = 1.0D+00
-      vt = 4.0D+00 * l
-      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, k0
-        cr = 0.125D+00 * cr &
-          * ( vt - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * z1 )
-        cbkl = cbkl + cr
-      end do
-      cbk(l) = ca0 * cbkl
-    end do
-  end if
-
-  cg0 = cbk(0)
-  cg1 = cbk(1)
-  do k = 2, nm
-    cg = 2.0D+00 * ( k - 1.0D+00 ) / z1 * cg1 + cg0
-    cbk(k) = cg
-    cg0 = cg1
-    cg1 = cg
-  end do
-
-  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
-    fac = 1.0D+00
-    do k = 0, nm
-      if ( imag ( z ) < 0.0D+00 ) then
-        cbk(k) = fac * cbk(k) + ci * pi * cbi(k)
-      else
-        cbk(k) = fac * cbk(k) - ci * pi * cbi(k)
-      end if
-      cbi(k) = fac * cbi(k)
-      fac = - fac
-    end do
-  end if
-
-  cdi(0) = cbi(1)
-  cdk(0) = -cbk(1)
-  do k = 1, nm
-    cdi(k) = cbi(k-1) - k / z * cbi(k)
-    cdk(k) = - cbk(k-1) - k / z * cbk(k)
-  end do
-
-  return
-end
-subroutine cikva ( v, z, vm, cbi, cdi, cbk, cdk )
-
-!*****************************************************************************80
-!
-!! CIKVA: modified Bessel functions Iv(z), Kv(z), arbitrary order, complex.
-!
-!  Discussion:
-!
-!    Compute the modified Bessel functions Iv(z), Kv(z)
-!    and their derivatives for an arbitrary order and
-!    complex argument
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    31 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:       
-!
-!    Input, real ( kind = 8 ) V, the order of the functions.
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, real ( kind = 8 ) VM, the highest order computed.
-!
-!    Output, real ( kind = 8 ) CBI(0:N), CDI(0:N), CBK(0:N), CDK(0:N),
-!    the values of In+v0(z), In+v0'(z), Kn+v0(z), Kn+v0'(z).
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  complex ( kind = 8 ) ca
-  complex ( kind = 8 ) ca1
-  complex ( kind = 8 ) ca2
-  complex ( kind = 8 ) cb
-  complex ( kind = 8 ) cbi(0:*)
-  complex ( kind = 8 ) cbi0
-  complex ( kind = 8 ) cdi(0:*)
-  complex ( kind = 8 ) cbk(0:*)
-  complex ( kind = 8 ) cbk0
-  complex ( kind = 8 ) cbk1
-  complex ( kind = 8 ) cdk(0:*)
-  complex ( kind = 8 ) cf
-  complex ( kind = 8 ) cf1
-  complex ( kind = 8 ) cf2
-  complex ( kind = 8 ) cg0
-  complex ( kind = 8 ) cg1
-  complex ( kind = 8 ) cgk
-  complex ( kind = 8 ) ci
-  complex ( kind = 8 ) ci0
-  complex ( kind = 8 ) cp
-  complex ( kind = 8 ) cr
-  complex ( kind = 8 ) cr1
-  complex ( kind = 8 ) cr2
-  complex ( kind = 8 ) cs
-  complex ( kind = 8 ) csu
-  complex ( kind = 8 ) ct
-  complex ( kind = 8 ) cvk
-  real ( kind = 8 ) gan
-  real ( kind = 8 ) gap
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k0
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) piv
-  real ( kind = 8 ) v
-  real ( kind = 8 ) v0
-  real ( kind = 8 ) v0n
-  real ( kind = 8 ) v0p
-  real ( kind = 8 ) vm
-  real ( kind = 8 ) vt
-  real ( kind = 8 ) w0
-  real ( kind = 8 ) ws
-  real ( kind = 8 ) ws0
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) z1
-  complex ( kind = 8 ) z2
-
-  pi = 3.141592653589793D+00
-  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
-  a0 = abs ( z )
-  z1 = z
-  z2 = z * z
-  n = int ( v )
-  v0 = v - n
-  piv = pi * v0
-  vt = 4.0D+00 * v0 * v0
-
-  if ( n == 0 ) then
-    n = 1
-  end if
-
-  if ( a0 < 1.0D-100 ) then
-
-    do k = 0, n
-      cbi(k) = 0.0D+00
-      cdi(k) = 0.0D+00
-      cbk(k) = -1.0D+300
-      cdk(k) = 1.0D+300
-    end do
-
-    if ( v0 == 0.0D+00 ) then
-      cbi(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      cdi(1) = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
-    end if
-
-    vm = v
-    return
-
-  end if
-
-  if ( a0 < 35.0D+00 ) then
-    k0 = 14
-  else if ( a0 < 50.0D+00 ) then
-    k0 = 10
-  else
-    k0 = 8
-  end if
-
-  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
-    z1 = -z
-  end if
-
-  if ( a0 < 18.0D+00 ) then
-
-    if ( v0 == 0.0D+00 ) then
-      ca1 = cmplx (1.0D+00, 0.0D+00, kind = 8 )
-    else
-      v0p = 1.0D+00 + v0
-      call gamma ( v0p, gap )
-      ca1 = ( 0.5D+00 * z1 ) ** v0 / gap
-    end if
-
-    ci0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, 50
-      cr = 0.25D+00 * cr * z2 / ( k * ( k + v0 ) )
-      ci0 = ci0 + cr
-      if ( abs ( cr ) < abs ( ci0 ) * 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    cbi0 = ci0 * ca1
-
-  else
-
-    ca = exp ( z1 ) / sqrt ( 2.0D+00 * pi * z1 )
-    cs = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, k0
-      cr = - 0.125D+00 * cr &
-        * ( vt - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * z1 )
-      cs = cs + cr
-    end do
-    cbi0 = ca * cs
-
-  end if
-
-  m = msta1 ( a0, 200 )
-
-  if ( m < n ) then
-     n = m
-  else
-     m = msta2 ( a0, n, 15 )
-  end if
-
-  cf2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-  cf1 = cmplx ( 1.0D-30, 0.0D+00, kind = 8 )
-  do k = m, 0, -1
-    cf = 2.0D+00 * ( v0 + k + 1.0D+00 ) / z1 * cf1 + cf2
-    if ( k <= n ) then
-      cbi(k) = cf
-    end if
-    cf2 = cf1
-    cf1 = cf
-  end do
-
-  cs = cbi0 / cf
-  do k = 0, n
-    cbi(k) = cs * cbi(k)
-  end do
-
-  if ( a0 <= 9.0D+00 ) then
-
-    if ( v0 == 0.0D+00 ) then
-      ct = - log ( 0.5D+00 * z1 ) - 0.5772156649015329D+00
-      cs = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      w0 = 0.0D+00
-      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, 50
-        w0 = w0 + 1.0D+00 / k
-        cr = 0.25D+00 * cr / ( k * k ) * z2
-        cp = cr * ( w0 + ct )
-        cs = cs + cp
-        if ( 10 <= k .and. abs ( cp / cs ) < 1.0D-15 ) then
-          exit
-        end if
-      end do
-
-      cbk0 = ct + cs
-
-    else
-
-      v0n = 1.0D+00 - v0
-      call gamma ( v0n, gan )
-      ca2 = 1.0D+00 / ( gan * ( 0.5D+00 * z1 ) ** v0 )
-      ca1 = ( 0.5D+00 * z1 ) ** v0 / gap
-      csu = ca2 - ca1
-      cr1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      cr2 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, 50
-        cr1 = 0.25D+00 * cr1 * z2 / ( k * ( k - v0 ) )
-        cr2 = 0.25D+00 * cr2 * z2 / ( k * ( k + v0 ) )
-        csu = csu + ca2 * cr1 - ca1 * cr2
-        ws = abs ( csu )
-        if ( 10 <= k .and. abs ( ws - ws0 ) / ws < 1.0D-15 ) then
-          exit
-        end if
-        ws0 = ws
-      end do
-
-      cbk0 = 0.5D+00 * pi * csu / sin ( piv )
-
-    end if
-
-  else
-
-    cb = exp ( - z1 ) * sqrt ( 0.5D+00 * pi / z1 )
-    cs = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, k0
-      cr = 0.125D+00 * cr &
-        * ( vt - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * z1 )
-      cs = cs + cr
-    end do
-    cbk0 = cb * cs
-
-  end if
-
-  cbk1 = ( 1.0D+00 / z1 - cbi(1) * cbk0 ) / cbi(0)
-  cbk(0) = cbk0
-  cbk(1) = cbk1
-  cg0 = cbk0
-  cg1 = cbk1
-
-  do k = 2, n
-    cgk = 2.0D+00 * ( v0 + k - 1.0D+00 ) / z1 * cg1 + cg0
-    cbk(k) = cgk
-    cg0 = cg1
-    cg1 = cgk
-  end do
-
-  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
-    do k = 0, n
-      cvk = exp ( ( k + v0 ) * pi * ci )
-      if ( imag ( z ) < 0.0D+00 ) then
-        cbk(k) = cvk * cbk(k) + pi * ci * cbi(k)
-        cbi(k) = cbi(k) / cvk
-      else if ( 0.0D+00 < imag ( z ) ) then
-        cbk(k) = cbk(k) / cvk - pi * ci * cbi(k)
-        cbi(k) = cvk * cbi(k)
-      end if
-    end do
-  end if
-
-  cdi(0) = v0 / z * cbi(0) + cbi(1)
-  cdk(0) = v0 / z * cbk(0) - cbk(1)
-  do k = 1, n
-    cdi(k) = - ( k + v0 ) / z * cbi(k) + cbi(k-1)
-    cdk(k) = - ( k + v0 ) / z * cbk(k) - cbk(k-1)
-  end do
-
-  vm = n + v0
-
-  return
-end
-subroutine cikvb ( v, z, vm, cbi, cdi, cbk, cdk )
-
-!*****************************************************************************80
-!
-!! CIKVB: modified Bessel functions,Iv(z), Kv(z), arbitrary order, complex.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    02 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) V, the order of the functions.
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, real ( kind = 8 ) VM, the highest order computed.
-!
-!    Output, real ( kind = 8 ) CBI(0:N), CDI(0:N), CBK(0:N), CDK(0:N),
-!    the values of In+v0(z), In+v0'(z), Kn+v0(z), Kn+v0'(z).
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  complex ( kind = 8 ) ca
-  complex ( kind = 8 ) ca1
-  complex ( kind = 8 ) ca2
-  complex ( kind = 8 ) cb
-  complex ( kind = 8 ) cbi(0:*)
-  complex ( kind = 8 ) cbi0
-  complex ( kind = 8 ) cdi(0:*)
-  complex ( kind = 8 ) cbk(0:*)
-  complex ( kind = 8 ) cbk0
-  complex ( kind = 8 ) cdk(0:*)
-  complex ( kind = 8 ) cf
-  complex ( kind = 8 ) cf1
-  complex ( kind = 8 ) cf2
-  complex ( kind = 8 ) ci
-  complex ( kind = 8 ) ci0
-  complex ( kind = 8 ) ckk
-  complex ( kind = 8 ) cp
-  complex ( kind = 8 ) cr
-  complex ( kind = 8 ) cr1
-  complex ( kind = 8 ) cr2
-  complex ( kind = 8 ) cs
-  complex ( kind = 8 ) csu
-  complex ( kind = 8 ) ct
-  complex ( kind = 8 ) cvk
-  real ( kind = 8 ) gan
-  real ( kind = 8 ) gap
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k0
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) piv
-  real ( kind = 8 ) v
-  real ( kind = 8 ) v0
-  real ( kind = 8 ) v0n
-  real ( kind = 8 ) v0p
-  real ( kind = 8 ) vm
-  real ( kind = 8 ) vt
-  real ( kind = 8 ) w0
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) z1
-  complex ( kind = 8 ) z2
-
-  z1 = z
-  z2 = z * z
-  a0 = abs ( z )
-  pi = 3.141592653589793D+00
-  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
-  n = int ( v )
-  v0 = v - n
-  piv = pi * v0
-  vt = 4.0D+00 * v0 * v0
-
-  if ( n == 0 ) then
-    n = 1
-  end if
-
-  if ( a0 < 1.0D-100 ) then
-    do k = 0, n
-      cbi(k) = 0.0D+00
-      cdi(k) = 0.0D+00
-      cbk(k) = -1.0D+300
-      cdk(k) = 1.0D+300
-    end do
-    if ( v0 == 0.0D+00 ) then
-      cbi(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      cdi(1) = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
-    end if
-    vm = v
-    return
-  end if
-
-  if ( a0 < 35.0D+00 ) then
-    k0 = 14
-  else if ( a0 < 50.0D+00 ) then
-    k0 = 10
-  else
-    k0 = 8
-  end if
-
-  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
-    z1 = -z
-  end if
-
-  if ( a0 < 18.0D+00 ) then
-
-    if ( v0 == 0.0D+00 ) then
-      ca1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    else
-      v0p = 1.0D+00 + v0
-      call gamma ( v0p, gap )
-      ca1 = ( 0.5D+00 * z1 ) ** v0 / gap
-    end if
-
-    ci0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, 50
-      cr = 0.25D+00 * cr * z2 / ( k * ( k + v0 ) )
-      ci0 = ci0 + cr
-      if ( abs ( cr / ci0 ) < 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    cbi0 = ci0 * ca1
-
-  else
-
-    ca = exp ( z1 ) / sqrt ( 2.0D+00 * pi * z1 )
-    cs = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, k0
-      cr = -0.125D+00 * cr &
-        * ( vt - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * z1 )
-      cs = cs + cr
-    end do
-    cbi0 = ca * cs
-
-  end if
-
-  m = msta1 ( a0, 200 )
-  if ( m < n ) then
-    n = m
-  else
-    m = msta2 ( a0, n, 15 )
-  end if
-
-  cf2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-  cf1 = cmplx ( 1.0D-30, 0.0D+00, kind = 8 )
-  do k = m, 0, -1
-    cf = 2.0D+00 * ( v0 + k + 1.0D+00 ) / z1 * cf1 + cf2
-    if ( k <= n ) then
-      cbi(k) = cf
-    end if
-    cf2 = cf1
-    cf1 = cf
-  end do
-  cs = cbi0 / cf
-
-  do k = 0, n
-    cbi(k) = cs * cbi(k)
-  end do
-
-  if ( a0 <= 9.0D+00 ) then
-
-    if ( v0 == 0.0D+00 ) then
-
-      ct = - log ( 0.5D+00 * z1 ) - 0.5772156649015329D+00
-      cs = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      w0 = 0.0D+00
-      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, 50
-        w0 = w0 + 1.0D+00 / k
-        cr = 0.25D+00 * cr / ( k * k ) * z2
-        cp = cr * ( w0 + ct )
-        cs = cs + cp
-        if ( 10 <= k .and. abs ( cp / cs ) < 1.0D-15 ) then
-          exit
-        end if
-      end do
-
-      cbk0 = ct + cs
-
-    else
-
-      v0n = 1.0D+00 - v0
-      call gamma ( v0n, gan )
-      ca2 = 1.0D+00 / ( gan * ( 0.5D+00 * z1 ) ** v0 )
-      ca1 = ( 0.5D+00 * z1 ) ** v0 / gap
-      csu = ca2 - ca1
-      cr1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      cr2 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, 50
-        cr1 = 0.25D+00 * cr1 * z2 / ( k * ( k - v0 ) )
-        cr2 = 0.25D+00 * cr2 * z2 / ( k * ( k + v0 ) )
-        cp = ca2 * cr1 - ca1 * cr2
-        csu = csu + cp
-        if ( 10 <= k .and. abs ( cp / csu ) < 1.0D-15 ) then
-          exit
-        end if
-      end do
-
-      cbk0 = 0.5D+00 * pi * csu / sin ( piv )
-
-    end if
-
-  else
-
-    cb = exp ( -z1 ) * sqrt ( 0.5D+00 * pi / z1 )
-    cs = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, k0
-      cr = 0.125D+00 * cr * ( vt - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) &
-        / ( k * z1 )
-      cs = cs + cr
-    end do
-
-    cbk0 = cb * cs
-
-  end if
-
-  cbk(0) = cbk0
-
-  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
-    do k = 0, n
-      cvk = exp ( ( k + v0 ) * pi * ci )
-      if ( imag ( z ) < 0.0D+00 ) then
-        cbk(k) = cvk * cbk(k) + pi * ci * cbi(k)
-        cbi(k) = cbi(k) / cvk
-      else if ( 0.0D+00 < imag ( z ) ) then
-        cbk(k) = cbk(k) / cvk - pi * ci * cbi(k)
-        cbi(k) = cvk * cbi(k)
-      end if
-    end do
-  end if
-
-  do k = 1, n
-    ckk = ( 1.0D+00 / z - cbi(k) * cbk(k-1) ) / cbi(k-1)
-    cbk(k) = ckk
-  end do
-
-  cdi(0) = v0 / z * cbi(0) + cbi(1)
-  cdk(0) = v0 / z * cbk(0) - cbk(1)
-  do k = 1, n
-    cdi(k) = - ( k + v0 ) / z * cbi(k) + cbi(k-1)
-    cdk(k) = - ( k + v0 ) / z * cbk(k) - cbk(k-1)
-  end do 
- 
-  vm = n + v0
-
-  return
-end
-subroutine cisia ( x, ci, si )
-
-!*****************************************************************************80
-!
-!! CISIA computes cosine Ci(x) and sine integrals Si(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    03 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument of Ci(x) and Si(x).
-!
-!    Output, real ( kind = 8 ) CI, SI, the values of Ci(x) and Si(x).
-!
-  implicit none
-
-  real ( kind = 8 ) bj(101)
-  real ( kind = 8 ) ci
-  real ( kind = 8 ) el
-  real ( kind = 8 ) eps
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) p2
-  real ( kind = 8 ) si
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x2
-  real ( kind = 8 ) xa
-  real ( kind = 8 ) xa0
-  real ( kind = 8 ) xa1
-  real ( kind = 8 ) xcs
-  real ( kind = 8 ) xf
-  real ( kind = 8 ) xg
-  real ( kind = 8 ) xg1
-  real ( kind = 8 ) xg2
-  real ( kind = 8 ) xr
-  real ( kind = 8 ) xs
-  real ( kind = 8 ) xss
-
-  p2 = 1.570796326794897D+00
-  el = 0.5772156649015329D+00
-  eps = 1.0D-15
-  x2 = x * x
-
-  if ( x == 0.0D+00 ) then
-
-    ci = -1.0D+300
-    si = 0.0D+00
-
-  else if ( x <= 16.0D+00 ) then
-
-    xr = -0.25D+00 * x2
-    ci = el + log ( x ) + xr
-    do k = 2, 40
-      xr = -0.5D+00 * xr * ( k - 1 ) / ( k * k * ( 2 * k - 1 ) ) * x2
-      ci = ci + xr
-      if ( abs ( xr ) < abs ( ci ) * eps ) then
-        exit
-      end if
-    end do
-
-    xr = x
-    si = x
-    do k = 1, 40
-      xr = -0.5D+00 * xr * ( 2 * k - 1 ) / k / ( 4 * k * k + 4 * k + 1 ) * x2
-      si = si + xr
-      if ( abs ( xr ) < abs ( si ) * eps ) then
-        return
-      end if
-    end do
-
-  else if ( x <= 32.0D+00 ) then
-
-    m = int ( 47.2D+00 + 0.82D+00 * x )
-    xa1 = 0.0D+00
-    xa0 = 1.0D-100
-    do k = m, 1, -1
-      xa = 4.0D+00 * k * xa0 / x - xa1
-      bj(k) = xa
-      xa1 = xa0
-      xa0 = xa
-    end do
-    xs = bj(1)
-    do k = 3, m, 2
-      xs = xs + 2.0D+00 * bj(k)
-    end do
-    bj(1) = bj(1) / xs
-    do k = 2, m
-      bj(k) = bj(k) / xs
-    end do
-    xr = 1.0D+00
-    xg1 = bj(1)
-    do k = 2, m
-      xr = 0.25D+00 * xr * ( 2.0D+00 * k - 3.0D+00 ) **2 &
-        / ( ( k - 1.0D+00 ) * ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) * x
-      xg1 = xg1 + bj(k) * xr
-    end do
-
-    xr = 1.0D+00
-    xg2 = bj(1)
-    do k = 2, m
-      xr = 0.25D+00 * xr * ( 2.0D+00 * k - 5.0D+00 )**2 &
-        / ( ( k-1.0D+00 ) * ( 2.0D+00 * k - 3.0D+00 ) ** 2 ) * x
-      xg2 = xg2 + bj(k) * xr
-    end do
-
-    xcs = cos ( x / 2.0D+00 )
-    xss = sin ( x / 2.0D+00 )
-    ci = el + log ( x ) - x * xss * xg1 + 2.0 * xcs * xg2 - 2.0 * xcs * xcs
-    si = x * xcs * xg1 + 2.0 * xss * xg2 - sin ( x )
-
-  else
-
-    xr = 1.0D+00
-    xf = 1.0D+00
-    do k = 1, 9
-      xr = -2.0D+00 * xr * k * ( 2 * k - 1 ) / x2
-      xf = xf + xr
-    end do
-    xr = 1.0D+00 / x
-    xg = xr
-    do k = 1, 8
-      xr = -2.0D+00 * xr * ( 2 * k + 1 ) * k / x2
-      xg = xg + xr
-    end do
-    ci = xf * sin ( x ) / x - xg * cos ( x ) / x
-    si = p2 - xf * cos ( x ) / x - xg * sin ( x ) / x
-
-  end if
-
-  return
-end
-subroutine cisib ( x, ci, si )
-
-!*****************************************************************************80
-!
-!! CISIB computes cosine and sine integrals.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    20 March 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument of Ci(x) and Si(x).
-!
-!    Output, real ( kind = 8 ) CI, SI, the values of Ci(x) and Si(x).
-!
-  implicit none
-
-  real ( kind = 8 ) ci
-  real ( kind = 8 ) fx
-  real ( kind = 8 ) gx
-  real ( kind = 8 ) si
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x2
-
-  x2 = x * x
-
-  if ( x == 0.0D+00 ) then
-
-    ci = -1.0D+300
-    si = 0.0D+00
-
-  else if ( x <= 1.0D+00 ) then
-
-    ci = (((( -3.0D-08        * x2 &
-             + 3.10D-06     ) * x2 &
-             - 2.3148D-04   ) * x2 &
-             + 1.041667D-02 ) * x2 &
-             - 0.25D+00     ) * x2 + 0.577215665D+00 + log ( x )
-
-     si = (((( 3.1D-07        * x2 &
-             - 2.834D-05    ) * x2 &
-             + 1.66667D-03  ) * x2 &
-             - 5.555556D-02 ) * x2 + 1.0D+00 ) * x
-
-  else
-
-    fx = (((( x2              &
-      + 38.027264D+00  ) * x2 &
-      + 265.187033D+00 ) * x2 &
-      + 335.67732D+00  ) * x2 &
-      + 38.102495D+00  ) /    &
-      (((( x2                 &
-      + 40.021433D+00  ) * x2 &
-      + 322.624911D+00 ) * x2 &
-      + 570.23628D+00  ) * x2 &
-      + 157.105423D+00 )
-
-    gx = (((( x2               &
-      + 42.242855D+00  ) * x2  &
-      + 302.757865D+00 ) * x2  &
-      + 352.018498D+00 ) * x2  &
-      + 21.821899D+00 ) /      &
-      (((( x2                  &
-      + 48.196927D+00   ) * x2 &
-      + 482.485984D+00  ) * x2 &
-      + 1114.978885D+00 ) * x2 &
-      + 449.690326D+00  ) / x
-
-    ci = fx * sin ( x ) / x - gx * cos ( x ) / x
-
-    si = 1.570796327D+00 - fx * cos ( x ) / x - gx * sin ( x ) / x
-
-  end if
-
-  return
-end
-subroutine cjk ( km, a )
-
-!*****************************************************************************80
-!
-!! CJK: asymptotic expansion coefficients for Bessel functions of large order.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    01 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) KM, the maximum value of K.
-!
-!    Output, real ( kind = 8 ) A(L), the value of Cj(k) where j and k are 
-!    related to L by L = j+1+[k*(k+1)]/2; j,k = 0,1,...,Km.
-!
-  implicit none
-
-  real ( kind = 8 ) a(*)
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) g
-  real ( kind = 8 ) g0
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) km
-  integer ( kind = 4 ) l1
-  integer ( kind = 4 ) l2
-  integer ( kind = 4 ) l3
-  integer ( kind = 4 ) l4
-
-  a(1) = 1.0D+00
-  f0 = 1.0D+00
-  g0 = 1.0D+00
-  do k = 0, km - 1
-    l1 = ( k + 1 ) * ( k + 2 ) / 2 + 1
-    l2 = ( k + 1 ) * ( k + 2 ) / 2 + k + 2
-    f = ( 0.5D+00 * k + 0.125D+00 / ( k + 1 ) ) * f0
-    g = - ( 1.5D+00 * k + 0.625D+00 &
-      / ( 3.0D+00 * ( k + 1.0D+00 ) ) ) * g0
-    a(l1) = f
-    a(l2) = g
-    f0 = f
-    g0 = g
-  end do
-
-  do k = 1, km - 1
-    do j = 1, k
-      l3 = k * ( k + 1 ) / 2 + j + 1
-      l4 = ( k + 1 ) * ( k + 2 ) / 2 + j + 1
-      a(l4) = ( j + 0.5D+00 * k + 0.125D+00 &
-        / ( 2.0D+00 * j + k + 1.0D+00 ) ) * a(l3) &
-        - ( j + 0.5D+00 * k - 1.0D+00 + 0.625D+00 &
-        / ( 2.0D+00 * j + k + 1.0D+00 ) ) * a(l3-1)
-    end do
-  end do
-
-  return
-end
-subroutine cjy01 ( z, cbj0, cdj0, cbj1, cdj1, cby0, cdy0, cby1, cdy1 )
-
-!*****************************************************************************80
-!
-!! CJY01: complexBessel functions, derivatives, J0(z), J1(z), Y0(z), Y1(z).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    02 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-! 
-!  Parameters:
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, complex ( kind = 8 ) CBJ0, CDJ0, CBJ1, CDJ1, CBY0, CDY0, CBY1, 
-!    CDY1, the values of J0(z), J0'(z), J1(z), J1'(z), Y0(z), Y0'(z), 
-!    Y1(z), Y1'(z).
-!
-  implicit none
-
-  real ( kind = 8 ), save, dimension ( 12 ) :: a = (/ &
-    -0.703125D-01,0.112152099609375D+00, &
-    -0.5725014209747314D+00,0.6074042001273483D+01, &
-    -0.1100171402692467D+03,0.3038090510922384D+04, &
-    -0.1188384262567832D+06,0.6252951493434797D+07, &
-    -0.4259392165047669D+09,0.3646840080706556D+11, &
-    -0.3833534661393944D+13,0.4854014686852901D+15 /)
-  real ( kind = 8 ) a0
-  real ( kind = 8 ), save, dimension ( 12 ) :: a1 = (/ &
-    0.1171875D+00,-0.144195556640625D+00, &
-    0.6765925884246826D+00,-0.6883914268109947D+01, &
-    0.1215978918765359D+03,-0.3302272294480852D+04, &
-    0.1276412726461746D+06,-0.6656367718817688D+07, &
-    0.4502786003050393D+09,-0.3833857520742790D+11, &
-    0.4011838599133198D+13,-0.5060568503314727D+15 /)
-  real ( kind = 8 ), save, dimension ( 12 ) :: b = (/ &
-    0.732421875D-01,-0.2271080017089844D+00, &
-    0.1727727502584457D+01,-0.2438052969955606D+02, &
-    0.5513358961220206D+03,-0.1825775547429318D+05, &
-    0.8328593040162893D+06,-0.5006958953198893D+08, &
-    0.3836255180230433D+10,-0.3649010818849833D+12, &
-    0.4218971570284096D+14,-0.5827244631566907D+16 /)
-  real ( kind = 8 ), save, dimension ( 12 ) :: b1 = (/ &
-    -0.1025390625D+00,0.2775764465332031D+00, &
-    -0.1993531733751297D+01,0.2724882731126854D+02, &
-    -0.6038440767050702D+03,0.1971837591223663D+05, &
-    -0.8902978767070678D+06,0.5310411010968522D+08, &
-    -0.4043620325107754D+10,0.3827011346598605D+12, &
-    -0.4406481417852278D+14,0.6065091351222699D+16 /)
-  complex ( kind = 8 ) cbj0
-  complex ( kind = 8 ) cbj1
-  complex ( kind = 8 ) cby0
-  complex ( kind = 8 ) cby1
-  complex ( kind = 8 ) cdj0
-  complex ( kind = 8 ) cdj1
-  complex ( kind = 8 ) cdy0
-  complex ( kind = 8 ) cdy1
-  complex ( kind = 8 ) ci
-  complex ( kind = 8 ) cp
-  complex ( kind = 8 ) cp0
-  complex ( kind = 8 ) cp1
-  complex ( kind = 8 ) cq0
-  complex ( kind = 8 ) cq1
-  complex ( kind = 8 ) cr
-  complex ( kind = 8 ) cs
-  complex ( kind = 8 ) ct1
-  complex ( kind = 8 ) ct2
-  complex ( kind = 8 ) cu
-  real ( kind = 8 ) el
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k0
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) rp2
-  real ( kind = 8 ) w0
-  real ( kind = 8 ) w1
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) z1
-  complex ( kind = 8 ) z2
-
-  pi = 3.141592653589793D+00
-  el = 0.5772156649015329D+00
-  rp2 = 2.0D+00 / pi
-  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
-  a0 = abs ( z )
-  z2 = z * z
-  z1 = z
-
-  if ( a0 == 0.0D+00 ) then
-    cbj0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cbj1 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-    cdj0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-    cdj1 = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
-    cby0 = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-    cby1 = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-    cdy0 = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-    cdy1 = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-    return
-  end if
-
-  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
-    z1 = -z
-  end if
-
-  if ( a0 <= 12.0D+00 ) then
-
-    cbj0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, 40
-      cr = -0.25D+00 * cr * z2 / ( k * k )
-      cbj0 = cbj0 + cr
-      if ( abs ( cr ) < abs ( cbj0 ) * 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    cbj1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, 40
-      cr = -0.25D+00 * cr * z2 / ( k * ( k + 1.0D+00 ) )
-      cbj1 = cbj1 + cr
-      if ( abs ( cr ) < abs ( cbj1 ) * 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    cbj1 = 0.5D+00 * z1 * cbj1
-    w0 = 0.0D+00
-    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cs = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, 40
-      w0 = w0 + 1.0D+00 / k
-      cr = -0.25D+00 * cr / ( k * k ) * z2
-      cp = cr * w0
-      cs = cs + cp
-      if ( abs ( cp ) < abs ( cs ) * 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    cby0 = rp2 * ( log ( z1 / 2.0D+00 ) + el ) * cbj0 - rp2 * cs
-    w1 = 0.0D+00
-    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cs = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, 40
-      w1 = w1 + 1.0D+00 / k
-      cr = -0.25D+00 * cr / ( k * ( k + 1 ) ) * z2
-      cp = cr * ( 2.0D+00 * w1 + 1.0D+00 / ( k + 1.0D+00 ) )
-      cs = cs + cp
-      if ( abs ( cp ) < abs ( cs ) * 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    cby1 = rp2 * ( ( log ( z1 / 2.0D+00 ) + el ) * cbj1 &
-      - 1.0D+00 / z1 - 0.25D+00 * z1 * cs )
-
-  else
-
-    if ( a0 < 35.0D+00 ) then
-      k0 = 12
-    else if ( a0 < 50.0D+00 ) then
-      k0 = 10
-    else
-      k0 = 8
-    end if
-
-    ct1 = z1 - 0.25D+00 * pi
-
-    cp0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, k0
-      cp0 = cp0 + a(k) * z1 ** ( - 2 * k )
-    end do
-
-    cq0 = -0.125D+00 / z1
-    do k = 1, k0
-      cq0 = cq0 + b(k) * z1 ** ( - 2 * k - 1 )
-    end do
-
-    cu = sqrt ( rp2 / z1 )
-    cbj0 = cu * ( cp0 * cos ( ct1 ) - cq0 * sin ( ct1 ) )
-    cby0 = cu * ( cp0 * sin ( ct1 ) + cq0 * cos ( ct1 ) )
-    ct2 = z1 - 0.75D+00 * pi
-
-    cp1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, k0
-      cp1 = cp1 + a1(k) * z1 ** ( - 2 * k )
-    end do
-
-    cq1 = 0.375D+00 / z1
-    do k = 1, k0
-      cq1 = cq1 + b1(k) * z1 ** ( - 2 * k - 1 )
-    end do
-
-    cbj1 = cu * ( cp1 * cos ( ct2 ) - cq1 * sin ( ct2 ) )
-    cby1 = cu * ( cp1 * sin ( ct2 ) + cq1 * cos ( ct2 ) )
-
-  end if
-
-  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
-    if ( imag ( z ) < 0.0D+00 ) then
-      cby0 =     cby0 - 2.0D+00 * ci * cbj0
-      cby1 = - ( cby1 - 2.0D+00 * ci * cbj1 )
-    else
-      cby0 =     cby0 + 2.0D+00 * ci * cbj0
-      cby1 = - ( cby1 + 2.0D+00 * ci * cbj1 )
-    end if
-    cbj1 = -cbj1
-  end if
-
-  cdj0 = -cbj1
-  cdj1 = cbj0 - 1.0D+00 / z * cbj1
-  cdy0 = -cby1
-  cdy1 = cby0 - 1.0D+00 / z * cby1
-
-  return
-end
-subroutine cjylv ( v, z, cbjv, cdjv, cbyv, cdyv )
-
-!*****************************************************************************80
-!
-!! CJYLV: Bessel functions Jv(z), Yv(z) of complex argument and large order v.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    25 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) V, the order of Jv(z) and Yv(z).
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, complex ( kind = 8 ) CBJV, CDJV, CBYV, CDYV, the values of Jv(z), 
-!    Jv'(z), Yv(z), Yv'(z).
-!
-  implicit none
-
-  real ( kind = 8 ) a(91)
-  complex ( kind = 8 ) cbjv
-  complex ( kind = 8 ) cbyv
-  complex ( kind = 8 ) cdjv
-  complex ( kind = 8 ) cdyv
-  complex ( kind = 8 ) ceta
-  complex ( kind = 8 ) cf(12)
-  complex ( kind = 8 ) cfj
-  complex ( kind = 8 ) cfy
-  complex ( kind = 8 ) csj
-  complex ( kind = 8 ) csy
-  complex ( kind = 8 ) ct
-  complex ( kind = 8 ) ct2
-  complex ( kind = 8 ) cws
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) km
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) l0
-  integer ( kind = 4 ) lf
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) v
-  real ( kind = 8 ) v0
-  real ( kind = 8 ) vr
-  complex ( kind = 8 ) z
-
-  km = 12
-  call cjk ( km, a )
-  pi = 3.141592653589793D+00
-
-  do l = 1, 0, -1
-
-    v0 = v - l
-    cws = sqrt ( 1.0D+00 - ( z / v0 ) * ( z / v0 ) )
-    ceta = cws + log ( z / v0 / ( 1.0D+00 + cws ) )
-    ct = 1.0D+00 / cws
-    ct2 = ct * ct
-
-    do k = 1, km
-      l0 = k * ( k + 1 ) / 2 + 1
-      lf = l0 + k
-      cf(k) = a(lf)
-      do i = lf - 1, l0, -1
-        cf(k) = cf(k) * ct2 + a(i)
-      end do
-      cf(k) = cf(k) * ct ** k
-    end do
-
-    vr = 1.0D+00 / v0
-    csj = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, km
-      csj = csj + cf(k) * vr ** k
-    end do
-    cbjv = sqrt ( ct / ( 2.0D+00 * pi * v0 ) ) * exp ( v0 * ceta ) * csj
-    if ( l == 1 ) then
-      cfj = cbjv
-    end if
-    csy = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, km
-      csy = csy + ( -1.0D+00 ) ** k * cf(k) * vr ** k
-    end do
-    cbyv = - sqrt ( 2.0D+00 * ct / ( pi * v0 ) ) * exp ( - v0 * ceta ) * csy
-    if ( l == 1 ) then
-      cfy = cbyv
-    end if
-
-  end do
-
-  cdjv = - v / z * cbjv + cfj
-  cdyv = - v / z * cbyv + cfy
-
-  return
-end
-subroutine cjyna ( n, z, nm, cbj, cdj, cby, cdy )
-
-!*****************************************************************************80
-!
-!! CJYNA: Bessel functions and derivatives, Jn(z) and Yn(z) of complex argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    02 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order of Jn(z) and Yn(z).
-!
-!    Input, complex ( kind = 8 ) Z, the argument of Jn(z) and Yn(z).
-!
-!    Output, integer ( kind = 4 ) NM, the highest order computed.
-!
-!    Output, complex ( kind = 8 ), CBJ(0:N), CDJ(0:N), CBY(0:N), CDY(0:N),
-!    the values of Jn(z), Jn'(z), Yn(z), Yn'(z).
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) a0
-  complex ( kind = 8 ) cbj(0:n)
-  complex ( kind = 8 ) cbj0
-  complex ( kind = 8 ) cbj1
-  complex ( kind = 8 ) cby(0:n)
-  complex ( kind = 8 ) cby0
-  complex ( kind = 8 ) cby1
-  complex ( kind = 8 ) cdj(0:n)
-  complex ( kind = 8 ) cdj0
-  complex ( kind = 8 ) cdj1
-  complex ( kind = 8 ) cdy(0:n)
-  complex ( kind = 8 ) cdy0
-  complex ( kind = 8 ) cdy1
-  complex ( kind = 8 ) cf
-  complex ( kind = 8 ) cf1
-  complex ( kind = 8 ) cf2
-  complex ( kind = 8 ) cg0
-  complex ( kind = 8 ) cg1
-  complex ( kind = 8 ) ch0
-  complex ( kind = 8 ) ch1
-  complex ( kind = 8 ) ch2
-  complex ( kind = 8 ) cj0
-  complex ( kind = 8 ) cj1
-  complex ( kind = 8 ) cjk
-  complex ( kind = 8 ) cp11
-  complex ( kind = 8 ) cp12
-  complex ( kind = 8 ) cp21
-  complex ( kind = 8 ) cp22
-  complex ( kind = 8 ) cs
-  complex ( kind = 8 ) cyk
-  complex ( kind = 8 ) cyl1
-  complex ( kind = 8 ) cyl2
-  complex ( kind = 8 ) cylk
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) lb
-  integer ( kind = 4 ) lb0
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) wa
-  real ( kind = 8 ) ya0
-  real ( kind = 8 ) ya1
-  real ( kind = 8 ) yak
-  complex ( kind = 8 ) z
-
-  pi = 3.141592653589793D+00
-  a0 = abs ( z )
-  nm = n
-
-  if ( a0 < 1.0D-100 ) then
-    do k = 0, n
-      cbj(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      cdj(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      cby(k) = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-      cdy(k) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-    end do
-    cbj(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cdj(1) = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
-    return
-  end if
-
-  call cjy01 ( z, cbj0, cdj0, cbj1, cdj1, cby0, cdy0, cby1, cdy1 )
-  cbj(0) = cbj0
-  cbj(1) = cbj1
-  cby(0) = cby0
-  cby(1) = cby1
-  cdj(0) = cdj0
-  cdj(1) = cdj1
-  cdy(0) = cdy0
-  cdy(1) = cdy1
-
-  if ( n <= 1 ) then
-    return
-  end if
-
-  if ( n < int ( 0.25D+00 * a0 ) ) then
-
-    cj0 = cbj0
-    cj1 = cbj1
-    do k = 2, n
-      cjk = 2.0D+00 * ( k - 1.0D+00 ) / z * cj1 - cj0
-      cbj(k) = cjk
-      cj0 = cj1
-      cj1 = cjk
-    end do
-
-  else
-
-    m = msta1 ( a0, 200 )
-
-    if ( m < n ) then
-      nm = m
-    else
-      m = msta2 ( a0, n, 15 )
-    end if
-
-    cf2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 ) 
-    cf1 = cmplx ( 1.0D-30, 0.0D+00, kind = 8 )
-    do k = m, 0, -1
-      cf = 2.0D+00 * ( k + 1.0D+00 ) / z * cf1 - cf2
-      if ( k <= nm ) then
-        cbj(k) = cf
-      end if
-      cf2 = cf1
-      cf1 = cf
-    end do
-
-    if ( abs ( cbj1 ) < abs ( cbj0 ) ) then
-      cs = cbj0 / cf
-    else
-      cs = cbj1 / cf2
-    end if
-
-    do k = 0, nm
-      cbj(k) = cs * cbj(k)
-    end do
-
-  end if
-
-  do k = 2, nm
-    cdj(k) = cbj(k-1) - k / z * cbj(k)
-  end do
-  ya0 = abs ( cby0 )
-  lb = 0
-  cg0 = cby0
-  cg1 = cby1
-  do k = 2, nm
-    cyk = 2.0D+00 * ( k - 1.0D+00 ) / z * cg1 - cg0
-    if ( abs ( cyk ) <= 1.0D+290 ) then         
-      yak = abs ( cyk )
-      ya1 = abs ( cg0 )
-      if ( yak < ya0 .and. yak < ya1 ) then
-        lb = k
-      end if
-      cby(k) = cyk
-      cg0 = cg1
-      cg1 = cyk
-    end if
-  end do
-
-  if ( 4 < lb  .and. imag ( z ) /= 0.0D+00 ) then
-
-    do
-
-      if ( lb == lb0 ) then
-        exit
-      end if
-
-      ch2 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      ch1 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      lb0 = lb
-      do k = lb, 1, -1
-        ch0 = 2.0D+00 * k / z * ch1 - ch2
-        ch2 = ch1
-        ch1 = ch0
-      end do
-      cp12 = ch0
-      cp22 = ch2
-      ch2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      ch1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = lb, 1, -1
-        ch0 = 2.0D+00 * k / z * ch1 - ch2
-        ch2 = ch1
-        ch1 = ch0
-      end do
-      cp11 = ch0
-      cp21 = ch2
-
-      if ( lb == nm ) then
-        cbj(lb+1) = 2.0D+00 * lb / z * cbj(lb) - cbj(lb-1)
-      end if
-
-      if ( abs ( cbj(1) ) < abs ( cbj(0) ) ) then
-        cby(lb+1) = ( cbj(lb+1) * cby0 - 2.0D+00 * cp11 / ( pi * z ) ) / cbj(0)
-        cby(lb) = ( cbj(lb) * cby0 + 2.0D+00 * cp12 / ( pi * z ) ) / cbj(0)
-      else
-        cby(lb+1) = ( cbj(lb+1) * cby1 - 2.0D+00 * cp21 / ( pi * z ) ) / cbj(1)
-        cby(lb) = ( cbj(lb) * cby1 + 2.0D+00 * cp22 / ( pi * z ) )  / cbj(1)
-      end if
-
-      cyl2 = cby(lb+1)
-      cyl1 = cby(lb)
-      do k = lb - 1, 0, -1
-        cylk = 2.0D+00 * ( k + 1.0D+00 ) / z * cyl1 - cyl2
-        cby(k) = cylk
-        cyl2 = cyl1
-        cyl1 = cylk
-      end do
-
-      cyl1 = cby(lb)
-      cyl2 = cby(lb+1)
-      do k = lb + 1, nm - 1
-        cylk = 2.0D+00 * k / z * cyl2 - cyl1
-        cby(k+1) = cylk
-        cyl1 = cyl2
-        cyl2 = cylk
-      end do
-
-      do k = 2, nm
-        wa = abs ( cby(k) )
-        if ( wa < abs ( cby(k-1) ) ) then
-          lb = k
-        end if
-      end do
-
-    end do
-
-  end if
-
-  do k = 2, nm
-    cdy(k) = cby(k-1) - k / z * cby(k)
-  end do
-
-  return
-end
-subroutine cjynb ( n, z, nm, cbj, cdj, cby, cdy )
-
-!*****************************************************************************80
-!
-!! CJYNB: Bessel functions, derivatives, Jn(z) and Yn(z) of complex argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    03 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-! 
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order of Jn(z) and Yn(z).
-!
-!    Input, complex ( kind = 8 ) Z, the argument of Jn(z) and Yn(z).
-!
-!    Output, integer ( kind = 4 ) NM, the highest order computed.
-!
-!    Output, complex ( kind = 8 ) CBJ(0:N), CDJ(0:N), CBY(0:N), CDY(0:N), 
-!    the values of Jn(z), Jn'(z), Yn(z), Yn'(z).
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ), save, dimension ( 4 ) :: a = (/ &
-    -0.7031250000000000D-01, 0.1121520996093750D+00, &
-    -0.5725014209747314D+00, 0.6074042001273483D+01 /)
-  real ( kind = 8 ) a0
-  real ( kind = 8 ), save, dimension ( 4 ) :: a1 = (/ &
-    0.1171875000000000D+00,-0.1441955566406250D+00, &
-    0.6765925884246826D+00,-0.6883914268109947D+01 /)
-  real ( kind = 8 ), save, dimension ( 4 ) :: b = (/  &
-    0.7324218750000000D-01,-0.2271080017089844D+00, &
-    0.1727727502584457D+01,-0.2438052969955606D+02 /)
-  real ( kind = 8 ), save, dimension ( 4 ) :: b1 = (/ &
-   -0.1025390625000000D+00,0.2775764465332031D+00, &
-   -0.1993531733751297D+01,0.2724882731126854D+02 /)
-  complex ( kind = 8 ) cbj(0:n)
-  complex ( kind = 8 ) cbj0
-  complex ( kind = 8 ) cbj1
-  complex ( kind = 8 ) cbjk
-  complex ( kind = 8 ) cbs
-  complex ( kind = 8 ) cby(0:n)
-  complex ( kind = 8 ) cby0
-  complex ( kind = 8 ) cby1
-  complex ( kind = 8 ) cdj(0:n)
-  complex ( kind = 8 ) cdy(0:n)
-  complex ( kind = 8 ) ce
-  complex ( kind = 8 ) cf
-  complex ( kind = 8 ) cf1
-  complex ( kind = 8 ) cf2
-  complex ( kind = 8 ) cp0
-  complex ( kind = 8 ) cp1
-  complex ( kind = 8 ) cq0
-  complex ( kind = 8 ) cq1
-  complex ( kind = 8 ) cs0
-  complex ( kind = 8 ) csu
-  complex ( kind = 8 ) csv
-  complex ( kind = 8 ) ct1
-  complex ( kind = 8 ) ct2
-  complex ( kind = 8 ) cu
-  complex ( kind = 8 ) cyy
-  real ( kind = 8 ) el
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r2p
-  real ( kind = 8 ) y0
-  complex ( kind = 8 ) z
-
-  el = 0.5772156649015329D+00
-  pi = 3.141592653589793D+00
-  r2p = 0.63661977236758D+00
-  y0 = abs ( imag ( z ) )
-  a0 = abs ( z )
-  nm = n
-
-  if ( a0 < 1.0D-100 ) then
-    do k = 0, n
-      cbj(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      cdj(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      cby(k) = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-      cdy(k) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-    end do
-    cbj(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cdj(1) = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
-    return
-  end if
-
-  if ( a0 <= 300.0D+00 .or. 80 < n ) then
-
-    if ( n == 0 ) then
-      nm = 1
-    end if
-    m = msta1 ( a0, 200 )
-    if ( m < nm ) then
-      nm = m
-    else
-      m = msta2 ( a0, nm, 15 )
-    end if
-
-    cbs = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-    csu = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-    csv = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-    cf2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-    cf1 = cmplx ( 1.0D-30, 0.0D+00, kind = 8 )
-
-    do k = m, 0, -1
-      cf = 2.0D+00 * ( k + 1.0D+00 ) / z * cf1 - cf2
-      if ( k <= nm ) then
-        cbj(k) = cf
-      end if
-      if ( k == 2 * int ( k / 2 ) .and. k .ne. 0 ) then
-        if ( y0 <= 1.0D+00 ) then
-          cbs = cbs + 2.0D+00 * cf
-        else
-          cbs = cbs + ( -1.0D+00 ) ** ( k / 2 ) * 2.0D+00 * cf
-        end if
-        csu = csu + ( -1.0D+00 ) ** ( k / 2 ) * cf / k
-      else if ( 1 < k ) then
-        csv = csv + ( -1.0D+00 ) ** ( k / 2 ) * k / ( k * k - 1.0D+00 ) * cf
-      end if
-      cf2 = cf1
-      cf1 = cf
-    end do
-
-    if ( y0 <= 1.0D+00 ) then
-      cs0 = cbs + cf
-    else
-      cs0 = ( cbs + cf ) / cos ( z )
-    end if
-
-    do k = 0, nm
-      cbj(k) = cbj(k) / cs0
-    end do
-
-    ce = log ( z / 2.0D+00 ) + el
-    cby(0) = r2p * ( ce * cbj(0) - 4.0D+00 * csu / cs0 )
-    cby(1) = r2p * ( - cbj(0) / z + ( ce - 1.0D+00 ) * cbj(1) &
-      - 4.0D+00 * csv / cs0 )
-
-  else
-
-    ct1 = z - 0.25D+00 * pi
-    cp0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, 4
-      cp0 = cp0 + a(k) * z ** ( - 2 * k )
-    end do
-    cq0 = -0.125D+00 / z
-    do k = 1, 4
-      cq0 = cq0 + b(k) * z ** ( - 2 * k - 1 )
-    end do
-    cu = sqrt ( r2p / z )
-    cbj0 = cu * ( cp0 * cos ( ct1 ) - cq0 * sin ( ct1 ) )
-    cby0 = cu * ( cp0 * sin ( ct1 ) + cq0 * cos ( ct1 ) )
-    cbj(0) = cbj0
-    cby(0) = cby0
-    ct2 = z - 0.75D+00 * pi
-    cp1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, 4
-      cp1 = cp1 + a1(k) * z ** ( - 2 * k )
-    end do
-    cq1 = 0.375D+00 / z
-    do k = 1, 4
-      cq1 = cq1 + b1(k) * z ** ( - 2 * k - 1 )
-    end do
-    cbj1 = cu * ( cp1 * cos ( ct2 ) - cq1 * sin ( ct2 ) )
-    cby1 = cu * ( cp1 * sin ( ct2 ) + cq1 * cos ( ct2 ) )
-    cbj(1) = cbj1
-    cby(1) = cby1
-    do k = 2, nm
-      cbjk = 2.0D+00 * ( k - 1.0D+00 ) / z * cbj1 - cbj0
-      cbj(k) = cbjk
-      cbj0 = cbj1
-      cbj1 = cbjk
-    end do
-  end if
-
-  cdj(0) = -cbj(1)
-  do k = 1, nm
-    cdj(k) = cbj(k-1) - k / z * cbj(k)
-  end do
-
-  if ( 1.0D+00 < abs ( cbj(0) ) ) then
-    cby(1) = ( cbj(1) * cby(0) - 2.0D+00 / ( pi * z ) ) / cbj(0)
-  end if
-
-  do k = 2, nm
-    if ( abs ( cbj(k-2) ) <= abs ( cbj(k-1) ) ) then
-      cyy = ( cbj(k) * cby(k-1) - 2.0D+00 / ( pi * z ) ) / cbj(k-1)
-    else
-      cyy = ( cbj(k) * cby(k-2) - 4.0D+00 * ( k - 1.0D+00 ) &
-        / ( pi * z * z ) ) / cbj(k-2)
-    end if
-    cby(k) = cyy
-  end do
-
-  cdy(0) = -cby(1)
-  do k = 1, nm
-    cdy(k) = cby(k-1) - k / z * cby(k)
-  end do
-
-  return
-end
-subroutine cjyva ( v, z, vm, cbj, cdj, cby, cdy )
-
-!*****************************************************************************80
-!
-!! CJYVA: Bessel functions and derivatives, Jv(z) and Yv(z) of complex argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    03 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) V, the order of Jv(z) and Yv(z).
-!
-!    Input, complex ( kind = 8 ), the argument.
-!
-!    Output, real ( kind = 8 ) VM, the highest order computed.
-!
-!    Output, real ( kind = 8 ) CBJ(0:*), CDJ(0:*), CBY(0:*), CDY(0:*), 
-!    the values of Jn+v0(z), Jn+v0'(z), Yn+v0(z), Yn+v0'(z).
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  complex ( kind = 8 ) ca
-  complex ( kind = 8 ) ca0
-  complex ( kind = 8 ) cb
-  complex ( kind = 8 ) cbj(0:*)
-  complex ( kind = 8 ) cby(0:*)
-  complex ( kind = 8 ) cck
-  complex ( kind = 8 ) cdj(0:*)
-  complex ( kind = 8 ) cdy(0:*)
-  complex ( kind = 8 ) cec
-  complex ( kind = 8 ) cf
-  complex ( kind = 8 ) cf0
-  complex ( kind = 8 ) cf1
-  complex ( kind = 8 ) cf2
-  complex ( kind = 8 ) cfac0
-  complex ( kind = 8 ) cfac1
-  complex ( kind = 8 ) cg0
-  complex ( kind = 8 ) cg1
-  complex ( kind = 8 ) ch0
-  complex ( kind = 8 ) ch1
-  complex ( kind = 8 ) ch2
-  complex ( kind = 8 ) ci
-  complex ( kind = 8 ) cju0
-  complex ( kind = 8 ) cju1
-  complex ( kind = 8 ) cjv0
-  complex ( kind = 8 ) cjv1
-  complex ( kind = 8 ) cjvl
-  complex ( kind = 8 ) cp11
-  complex ( kind = 8 ) cp12
-  complex ( kind = 8 ) cp21
-  complex ( kind = 8 ) cp22
-  complex ( kind = 8 ) cpz
-  complex ( kind = 8 ) cqz
-  complex ( kind = 8 ) cr
-  complex ( kind = 8 ) cr0
-  complex ( kind = 8 ) cr1
-  complex ( kind = 8 ) crp
-  complex ( kind = 8 ) crq
-  complex ( kind = 8 ) cs
-  complex ( kind = 8 ) cs0
-  complex ( kind = 8 ) cs1
-  complex ( kind = 8 ) csk
-  complex ( kind = 8 ) cyk
-  complex ( kind = 8 ) cyl1
-  complex ( kind = 8 ) cyl2
-  complex ( kind = 8 ) cylk
-  complex ( kind = 8 ) cyv0
-  complex ( kind = 8 ) cyv1
-  real ( kind = 8 ) ga
-  real ( kind = 8 ) gb
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k0
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) lb
-  integer ( kind = 4 ) lb0
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) pv0
-  real ( kind = 8 ) pv1
-  real ( kind = 8 ) rp2
-  real ( kind = 8 ) v
-  real ( kind = 8 ) v0
-  real ( kind = 8 ) vg
-  real ( kind = 8 ) vl
-  real ( kind = 8 ) vm
-  real ( kind = 8 ) vv
-  real ( kind = 8 ) w0
-  real ( kind = 8 ) w1
-  real ( kind = 8 ) wa
-  real ( kind = 8 ) ya0
-  real ( kind = 8 ) ya1
-  real ( kind = 8 ) yak
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) z1
-  complex ( kind = 8 ) z2
-  complex ( kind = 8 ) zk
-
-  pi = 3.141592653589793D+00
-  rp2 = 0.63661977236758D+00
-  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
-  a0 = abs ( z )
-  z1 = z
-  z2 = z * z
-  n = int ( v )
-  v0 = v - n
-  pv0 = pi * v0
-  pv1 = pi * ( 1.0D+00 + v0 )
-
-  if ( a0 < 1.0D-100 ) then
-
-    do k = 0, n
-      cbj(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      cdj(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      cby(k) = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-      cdy(k) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-    end do
-
-    if ( v0 == 0.0D+00 ) then
-      cbj(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      cdj(1) = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
-    else
-      cdj(0) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-    end if
-
-    vm = v                     
-    return
-
-  end if
-
-  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
-    z1 = -z
-  end if
-
-  if ( a0 <= 12.0D+00 ) then
-
-    do l = 0, 1
-      vl = v0 + l
-      cjvl = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, 40
-        cr = -0.25D+00 * cr * z2 / ( k * ( k + vl ) )
-        cjvl = cjvl + cr
-        if ( abs ( cr ) < abs ( cjvl ) * 1.0D-15 ) then
-          exit
-        end if
-      end do
-
-      vg = 1.0D+00 + vl
-      call gamma ( vg, ga )
-      ca = ( 0.5D+00 * z1 ) ** vl / ga
-
-      if ( l == 0 ) then
-        cjv0 = cjvl * ca
-      else
-        cjv1 = cjvl * ca
-      end if
-
-    end do
-
-  else
-
-    if ( a0 < 35.0D+00 ) then
-      k0 = 11
-    else if ( a0 <50.0D+00 ) then
-      k0 = 10
-    else
-      k0 = 8
-    end if
-
-    do j = 0, 1
-      vv = 4.0D+00 * ( j + v0 ) * ( j + v0 )
-      cpz = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      crp = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, k0
-        crp = - 0.78125D-02 * crp &
-          * ( vv - ( 4.0D+00 * k - 3.0D+00 ) ** 2 ) &
-          * ( vv - ( 4.0D+00 * k - 1.0D+00 ) ** 2 )  &
-          / ( k * ( 2.0D+00 * k - 1.0D+00 ) * z2 )
-        cpz = cpz + crp
-      end do
-      cqz = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      crq = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, k0
-        crq = -0.78125D-02 * crq &
-          * ( vv - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
-          * ( vv - ( 4.0D+00 * k + 1.0D+00 ) ** 2 ) &
-          / ( k * ( 2.0D+00 * k + 1.0D+00 ) * z2 )
-        cqz = cqz + crq
-      end do
-      cqz = 0.125D+00 * ( vv - 1.0D+00 ) * cqz / z1
-      zk = z1 - ( 0.5D+00 * ( j + v0 ) + 0.25D+00 ) * pi
-      ca0 = sqrt ( rp2 / z1 )
-      cck = cos ( zk )
-      csk = sin ( zk )
-      if ( j == 0 ) then
-        cjv0 = ca0 * ( cpz * cck - cqz * csk )
-        cyv0 = ca0 * ( cpz * csk + cqz * cck )
-      else if ( j == 1 ) then
-        cjv1 = ca0 * ( cpz * cck - cqz * csk )
-        cyv1 = ca0 * ( cpz * csk + cqz * cck )
-      end if
-    end do
-
-  end if
-
-  if ( a0 <= 12.0D+00 ) then
-
-    if ( v0 .ne. 0.0D+00 ) then
-
-      do l = 0, 1
-        vl = v0 + l
-        cjvl = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-        cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-        do k = 1, 40
-          cr = -0.25D+00 * cr * z2 / ( k * ( k - vl ) )
-          cjvl = cjvl + cr
-          if ( abs ( cr ) < abs ( cjvl ) * 1.0D-15 ) then
-            exit
-          end if
-        end do
-
-        vg = 1.0D+00 - vl
-        call gamma ( vg, gb )
-        cb = ( 2.0D+00 / z1 ) ** vl / gb
-        if ( l == 0 ) then
-          cju0 = cjvl * cb
-        else
-          cju1 = cjvl * cb
-        end if
-      end do
-      cyv0 = ( cjv0 * cos ( pv0 ) - cju0 ) / sin ( pv0 )
-      cyv1 = ( cjv1 * cos ( pv1 ) - cju1 ) / sin ( pv1 )
-
-    else
-
-      cec = log ( z1 / 2.0D+00 ) + 0.5772156649015329D+00
-      cs0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      w0 = 0.0D+00
-      cr0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, 30
-        w0 = w0 + 1.0D+00 / k
-        cr0 = -0.25D+00 * cr0 / ( k * k ) * z2
-        cs0 = cs0 + cr0 * w0
-      end do
-      cyv0 = rp2 * ( cec * cjv0 - cs0 )
-      cs1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      w1 = 0.0D+00
-      cr1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, 30
-        w1 = w1 + 1.0D+00 / k
-        cr1 = -0.25D+00 * cr1 / ( k * ( k + 1 ) ) * z2
-        cs1 = cs1 + cr1 * ( 2.0D+00 * w1 + 1.0D+00 / ( k + 1.0D+00 ) )
-      end do
-      cyv1 = rp2 * ( cec * cjv1 - 1.0D+00 / z1 - 0.25D+00 * z1 * cs1 )
-
-    end if
-
-  end if
-
-  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
-
-    cfac0 = exp ( pv0 * ci )
-    cfac1 = exp ( pv1 * ci )
-
-    if ( imag ( z ) < 0.0D+00 ) then
-      cyv0 = cfac0 * cyv0 - 2.0D+00 * ci * cos ( pv0 ) * cjv0
-      cyv1 = cfac1 * cyv1 - 2.0D+00 * ci * cos ( pv1 ) * cjv1
-      cjv0 = cjv0 / cfac0
-      cjv1 = cjv1 / cfac1
-    else if ( 0.0D+00 < imag ( z ) ) then
-      cyv0 = cyv0 / cfac0 + 2.0D+00 * ci * cos ( pv0 ) * cjv0
-      cyv1 = cyv1 / cfac1 + 2.0D+00 * ci * cos ( pv1 ) * cjv1
-      cjv0 = cfac0 * cjv0
-      cjv1 = cfac1 * cjv1
-    end if
-
-  end if
-
-  cbj(0) = cjv0
-  cbj(1) = cjv1
-
-  if ( 2 <= n .and. n <= int ( 0.25D+00 * a0 ) ) then
-
-    cf0 = cjv0
-    cf1 = cjv1
-    do k = 2, n
-      cf = 2.0D+00 * ( k + v0 - 1.0D+00 ) / z * cf1 - cf0
-      cbj(k) = cf
-      cf0 = cf1
-      cf1 = cf
-    end do
-
-  else if ( 2 <= n ) then
-
-    m = msta1 ( a0, 200 )
-    if ( m < n ) then
-      n = m
-    else
-      m = msta2 ( a0, n, 15 )
-    end if
-    cf2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-    cf1 = cmplx ( 1.0D-30, 0.0D+00, kind = 8 )
-    do k = m, 0, -1
-      cf = 2.0D+00 * ( v0 + k + 1.0D+00 ) / z * cf1 - cf2
-      if ( k <= n ) then
-        cbj(k) = cf
-      end if
-      cf2 = cf1
-      cf1 = cf
-    end do
-    if ( abs ( cjv1 ) < abs ( cjv0 ) ) then
-      cs = cjv0 / cf
-    else
-      cs = cjv1 / cf2
-    end if
-
-    do k = 0, n
-      cbj(k) = cs * cbj(k)
-    end do
-
-  end if
-
-    cdj(0) = v0 / z * cbj(0) - cbj(1)
-    do k = 1, n
-      cdj(k) = - ( k + v0 ) / z * cbj(k) + cbj(k-1)
-    end do
-
-    cby(0) = cyv0
-    cby(1) = cyv1
-    ya0 = abs ( cyv0 )
-    lb = 0
-    cg0 = cyv0
-    cg1 = cyv1
-    do k = 2, n
-      cyk = 2.0D+00 * ( v0 + k - 1.0D+00 ) / z * cg1 - cg0
-      if ( abs ( cyk ) <= 1.0D+290 ) then
-        yak = abs ( cyk )
-        ya1 = abs ( cg0 )
-        if ( yak < ya0 .and. yak < ya1 ) then
-          lb = k
-        end if
-        cby(k) = cyk
-        cg0 = cg1
-        cg1 = cyk
-      end if
-    end do
-
-    if ( 4 < lb .and. imag ( z ) /= 0.0D+00 ) then
-
-      do
-
-        if ( lb == lb0 ) then
-          exit
-        end if
-
-        ch2 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-        ch1 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-        lb0 = lb
-        do k = lb, 1, -1
-          ch0 = 2.0D+00 * ( k + v0 ) / z * ch1 - ch2
-          ch2 = ch1
-          ch1 = ch0
-        end do
-        cp12 = ch0
-        cp22 = ch2
-        ch2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-        ch1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-        do k = lb, 1, -1
-          ch0 = 2.0D+00 * ( k + v0 ) / z * ch1 - ch2
-          ch2 = ch1
-          ch1 = ch0
-        end do
-        cp11 = ch0
-        cp21 = ch2
-
-        if ( lb == n ) then
-          cbj(lb+1) = 2.0D+00 * ( lb + v0 ) / z * cbj(lb) - cbj(lb-1)
-        end if
-
-        if ( abs ( cbj(1) ) < abs ( cbj(0) ) ) then
-          cby(lb+1) = ( cbj(lb+1) * cyv0 - 2.0D+00 * cp11 / ( pi * z ) ) &
-            / cbj(0)
-          cby(lb) = ( cbj(lb) * cyv0 + 2.0D+00 * cp12 / ( pi * z ) ) / cbj(0)
-        else
-          cby(lb+1) = ( cbj(lb+1) * cyv1 - 2.0D+00 * cp21 / ( pi * z ) ) &
-            / cbj(1)
-          cby(lb) = ( cbj(lb) * cyv1 + 2.0D+00 * cp22 / ( pi * z ) ) / cbj(1)
-        end if
-
-        cyl2 = cby(lb+1)
-        cyl1 = cby(lb)
-        do k = lb - 1, 0, -1
-          cylk = 2.0D+00 * ( k + v0 + 1.0D+00 ) / z * cyl1 - cyl2
-          cby(k) = cylk
-          cyl2 = cyl1
-          cyl1 = cylk
-        end do
-
-      cyl1 = cby(lb)
-      cyl2 = cby(lb+1)
-      do k = lb + 1, n - 1
-        cylk = 2.0D+00 * ( k + v0 ) / z * cyl2 - cyl1
-        cby(k+1) = cylk
-        cyl1 = cyl2
-        cyl2 = cylk
-      end do
-
-      do k = 2, n
-        wa = abs ( cby(k) )
-        if ( wa < abs ( cby(k-1) ) ) then
-          lb = k
-        end if
-      end do
-
-    end do
-
-  end if
-
-  cdy(0) = v0 / z * cby(0) - cby(1)
-  do k = 1, n
-    cdy(k) = cby(k-1) - ( k + v0 ) / z * cby(k)
-  end do
-  vm = n + v0
-
-  return
-end
-subroutine cjyvb ( v, z, vm, cbj, cdj, cby, cdy )
-
-!*****************************************************************************80
-!
-!! CJYVB: Bessel functions and derivatives, Jv(z) and Yv(z) of complex argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    03 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) V, the order of Jv(z) and Yv(z).
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, real ( kind = 8 ) VM, the highest order computed.
-!
-!    Output, real ( kind = 8 ) CBJ(0:*), CDJ(0:*), CBY(0:*), CDY(0:*), 
-!    the values of Jn+v0(z), Jn+v0'(z), Yn+v0(z), Yn+v0'(z).
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  complex ( kind = 8 ) ca
-  complex ( kind = 8 ) ca0
-  complex ( kind = 8 ) cb
-  complex ( kind = 8 ) cbj(0:*)
-  complex ( kind = 8 ) cby(0:*)
-  complex ( kind = 8 ) cck
-  complex ( kind = 8 ) cdj(0:*)
-  complex ( kind = 8 ) cdy(0:*)
-  complex ( kind = 8 ) cec
-  complex ( kind = 8 ) cf
-  complex ( kind = 8 ) cf1
-  complex ( kind = 8 ) cf2
-  complex ( kind = 8 ) cfac0
-  complex ( kind = 8 ) ci
-  complex ( kind = 8 ) cju0
-  complex ( kind = 8 ) cjv0
-  complex ( kind = 8 ) cjvn
-  complex ( kind = 8 ) cpz
-  complex ( kind = 8 ) cqz
-  complex ( kind = 8 ) cr
-  complex ( kind = 8 ) cr0
-  complex ( kind = 8 ) crp
-  complex ( kind = 8 ) crq
-  complex ( kind = 8 ) cs
-  complex ( kind = 8 ) cs0
-  complex ( kind = 8 ) csk
-  complex ( kind = 8 ) cyv0
-  complex ( kind = 8 ) cyy
-  real ( kind = 8 ) ga
-  real ( kind = 8 ) gb
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k0
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) pv0
-  real ( kind = 8 ) rp2
-  real ( kind = 8 ) v
-  real ( kind = 8 ) v0
-  real ( kind = 8 ) vg
-  real ( kind = 8 ) vm
-  real ( kind = 8 ) vv
-  real ( kind = 8 ) w0
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) z1
-  complex ( kind = 8 ) z2
-  complex ( kind = 8 ) zk
-
-  pi = 3.141592653589793D+00
-  rp2 = 0.63661977236758D+00
-  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
-  a0 = abs ( z )
-  z1 = z
-  z2 = z * z
-  n = int ( v )
-  v0 = v - n
-  pv0 = pi * v0
-  
-  if ( a0 < 1.0D-100 ) then
-
-    do k = 0, n
-      cbj(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      cdj(k) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      cby(k) = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-      cdy(k) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-    end do
-
-    if ( v0 == 0.0D+00 ) then
-      cbj(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      cdj(1) = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
-    else
-      cdj(0) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-    end if
-
-    vm = v
-    return
-
-  end if
-
-  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
-    z1 = -z
-  end if
-
-  if ( a0 <= 12.0D+00 ) then
-
-    cjv0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, 40
-      cr = -0.25D+00 * cr * z2 / ( k * ( k + v0 ) )
-      cjv0 = cjv0 + cr
-      if ( abs ( cr ) < abs ( cjv0 ) * 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    vg = 1.0D+00 + v0
-    call gamma ( vg, ga )
-    ca = ( 0.5D+00 * z1 ) ** v0 / ga
-    cjv0 = cjv0 * ca
-
-  else
-
-    if ( a0 < 35.0D+00 ) then
-      k0 = 11
-    else if ( a0 < 50.0D+00 ) then
-      k0 = 10
-    else
-      k0 = 8
-    end if
-
-    vv = 4.0D+00 * v0 * v0
-    cpz = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    crp = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, k0
-      crp = -0.78125D-02 * crp &
-        * ( vv - ( 4.0D+00 * k - 3.0D+00 ) ** 2 ) &
-        * ( vv - ( 4.0D+00 * k - 1.0D+00 ) **2 ) &
-        / ( k * ( 2.0D+00 * k - 1.0D+00 ) * z2 )
-      cpz = cpz + crp
-    end do
-    cqz = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    crq = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, k0
-      crq = -0.78125D-02 * crq &
-        * ( vv - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
-        * ( vv - ( 4.0D+00 * k + 1.0D+00 ) ** 2 ) &
-        / ( k * ( 2.0D+00 * k + 1.0D+00 ) * z2 )
-      cqz = cqz + crq
-    end do
-    cqz = 0.125D+00 * ( vv - 1.0D+00 ) * cqz / z1
-    zk = z1 - ( 0.5D+00 * v0 + 0.25D+00 ) * pi
-    ca0 = sqrt ( rp2 / z1 )
-    cck = cos ( zk )
-    csk = sin ( zk )
-    cjv0 = ca0 * ( cpz * cck - cqz * csk )
-    cyv0 = ca0 * ( cpz * csk + cqz * cck )
-
-  end if
-
-  if ( a0 <= 12.0D+00 ) then
-
-    if ( v0 .ne. 0.0D+00 ) then
-
-      cjvn = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, 40
-        cr = -0.25D+00 * cr * z2 / ( k * ( k - v0 ) )
-        cjvn = cjvn + cr
-        if ( abs ( cr ) < abs ( cjvn ) * 1.0D-15 ) then
-          exit
-        end if
-      end do
-
-      vg = 1.0D+00 - v0
-      call gamma ( vg, gb )
-      cb = ( 2.0D+00 / z1 ) ** v0 / gb
-      cju0 = cjvn * cb
-      cyv0 = ( cjv0 * cos ( pv0 ) - cju0 ) / sin ( pv0 )
-
-    else
-
-      cec = log ( z1 / 2.0D+00 ) + 0.5772156649015329D+00
-      cs0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      w0 = 0.0D+00
-      cr0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, 30
-        w0 = w0 + 1.0D+00 / k
-        cr0 = -0.25D+00 * cr0 / ( k * k ) * z2
-        cs0 = cs0 + cr0 * w0
-      end do
-      cyv0 = rp2 * ( cec * cjv0 - cs0 )
-
-    end if
-
-  end if
-
-  if ( n == 0 ) then
-    n = 1
-  end if
-
-  m = msta1 ( a0, 200 )
-  if ( m < n ) then
-    n = m
-  else
-    m = msta2 ( a0, n, 15 )
-  end if
-
-  cf2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-  cf1 = cmplx ( 1.0D-30, 0.0D+00, kind = 8 )
-  do k = m, 0, -1
-    cf = 2.0D+00 * ( v0 + k + 1.0D+00 ) / z1 * cf1 - cf2
-    if ( k <= n ) then
-      cbj(k) = cf
-    end if
-    cf2 = cf1
-    cf1 = cf
-  end do
-
-  cs = cjv0 / cf
-  do k = 0, n
-    cbj(k) = cs * cbj(k)
-  end do
-
-  if ( real ( z, kind = 8 ) < 0.0D+00) then
-
-    cfac0 = exp ( pv0 * ci )
-    if ( imag ( z ) < 0.0D+00 ) then
-      cyv0 = cfac0 * cyv0 - 2.0D+00 * ci * cos ( pv0 ) * cjv0
-    else if ( 0.0D+00 < imag ( z ) ) then
-      cyv0 = cyv0 / cfac0 + 2.0D+00 * ci * cos ( pv0 ) * cjv0
-    end if
-
-    do k = 0, n
-      if ( imag ( z ) < 0.0D+00) then
-        cbj(k) = exp ( - pi * ( k + v0 ) * ci ) * cbj(k)
-      else if ( 0.0D+00 < imag ( z ) ) then
-        cbj(k) = exp ( pi * ( k + v0 ) * ci ) * cbj(k)
-      end if
-    end do
-
-    z1 = z1
-
-  end if
-
-  cby(0) = cyv0
-  do k = 1, n
-    cyy = ( cbj(k) * cby(k-1) - 2.0D+00 / ( pi * z ) ) / cbj(k-1)
-    cby(k) = cyy
-  end do
-
-  cdj(0) = v0 / z * cbj(0) - cbj(1)
-  do k = 1, n
-    cdj(k) = - ( k + v0 ) / z * cbj(k) + cbj(k-1)
-  end do
-
-  cdy(0) = v0 / z * cby(0) - cby(1)
-  do k = 1, n
-    cdy(k) = cby(k-1) - ( k + v0 ) / z * cby(k)
-  end do
-
-  vm = n + v0
-
-  return
-end
-subroutine clpmn ( mm, m, n, x, y, cpm, cpd )
-
-!*****************************************************************************80
-!
-!! CLPMN: associated Legendre functions and derivatives for complex argument.
-!
-!  Discussion:
-!
-!    Compute the associated Legendre functions Pmn(z)   
-!    and their derivatives Pmn'(z) for a complex argument
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    01 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) MM, the physical dimension of CPM and CPD.
-!
-!    Input, integer ( kind = 4 ) M, N, the order and degree of Pmn(z).
-!
-!    Input, real ( kind = 8 ) X, Y, the real and imaginary parts of 
-!    the argument Z.
-!
-!    Output, complex ( kind = 8 ) CPM(0:MM,0:N), CPD(0:MM,0:N), the values of
-!    Pmn(z) and Pmn'(z).
-!
-  implicit none
-
-  integer ( kind = 4 ) mm
-
-  complex ( kind = 8 ) cpd(0:mm,0:n)
-  complex ( kind = 8 ) cpm(0:mm,0:n)
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) ls
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) x
-  real ( kind = 8 ) y
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) zq
-  complex ( kind = 8 ) zs
-
-  z = cmplx ( x, y, kind = 8 )
-
-  do i = 0, n
-    do j = 0, m
-      cpm(j,i) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      cpd(j,i) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-    end do
-  end do
-
-  cpm(0,0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-
-  if ( abs ( x ) == 1.0D+00 .and. y == 0.0D+00 ) then
-
-    do i = 1, n
-      cpm(0,i) = x ** i
-      cpd(0,i) = 0.5D+00 * i * ( i + 1 ) * x ** ( i + 1 )
-    end do
-
-    do j = 1, n
-      do i = 1, m
-        if ( i == 1 ) then
-          cpd(i,j) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-        else if ( i == 2 ) then
-          cpd(i,j) = -0.25D+00 &
-            * ( j + 2 ) * ( j + 1 ) * j * ( j - 1 ) * x ** ( j + 1 )
-        end if
-      end do
-    end do
-
-    return
-
-  end if
-
-  if ( 1.0D+00 < abs ( z ) ) then
-    ls = -1
-  else
-    ls = 1
-  end if
-
-  zq = sqrt ( ls * ( 1.0D+00 - z * z ) )
-  zs = ls * ( 1.0D+00 - z * z )
-  do i = 1, m
-    cpm(i,i) = -ls * ( 2.0D+00 * i - 1.0D+00 ) * zq * cpm(i-1,i-1)
-  end do
-  do i = 0, m
-    cpm(i,i+1) = ( 2.0D+00 * i + 1.0D+00 ) * z * cpm(i,i)
-  end do
-
-  do i = 0, m
-    do j = i + 2, n
-      cpm(i,j) = ( ( 2.0D+00 * j - 1.0D+00 ) * z * cpm(i,j-1) &
-        - ( i + j - 1.0D+00 ) * cpm(i,j-2) ) / ( j - i )
-    end do
-  end do
-
-  cpd(0,0) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-  do j = 1, n
-    cpd(0,j) = ls * j * ( cpm(0,j-1) - z * cpm(0,j) ) / zs
-  end do 
-
-  do i = 1, m
-    do j = i, n
-      cpd(i,j) = ls * i * z * cpm(i,j) / zs &
-        + ( j + i ) * ( j - i + 1.0D+00 ) / zq * cpm(i-1,j)
-    end do
-  end do
-
-  return
-end
-subroutine clpn ( n, x, y, cpn, cpd )
-
-!*****************************************************************************80
-!
-!! CLPN computes Legendre functions and derivatives for complex argument.
-!
-!  Discussion:
-!
-!    Compute Legendre polynomials Pn(z) and their derivatives Pn'(z) for 
-!    a complex argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    15 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the degree.
-!
-!    Input, real ( kind = 8 ) X, Y, the real and imaginary parts 
-!    of the argument.
-!
-!    Output, complex ( kind = 8 ) CPN(0:N), CPD(0:N), the values of Pn(z)
-!    and Pn'(z).
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  complex ( kind = 8 ) cp0
-  complex ( kind = 8 ) cp1
-  complex ( kind = 8 ) cpd(0:n)
-  complex ( kind = 8 ) cpf
-  complex ( kind = 8 ) cpn(0:n)
-  integer ( kind = 4 ) k
-  real ( kind = 8 ) x
-  real ( kind = 8 ) y
-  complex ( kind = 8 ) z
-
-  z = cmplx ( x, y, kind = 8 )
-
-  cpn(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-  cpn(1) = z
-  cpd(0) = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-  cpd(1) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-
-  cp0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-  cp1 = z
-  do k = 2, n
-    cpf = ( 2.0D+00 * k - 1.0D+00 ) / k * z * cp1 - ( k - 1.0D+00 ) / k * cp0
-    cpn(k) = cpf
-    if ( abs ( x ) == 1.0D+00 .and. y == 0.0D+00 ) then
-      cpd(k) = 0.5D+00 * x ** ( k + 1 ) * k * ( k + 1.0D+00 )
-    else
-      cpd(k) = k * ( cp1 - z * cpf ) / ( 1.0D+00 - z * z )
-    end if
-    cp0 = cp1
-    cp1 = cpf
-  end do
-
-  return
-end
-subroutine clqmn ( mm, m, n, x, y, cqm, cqd )
-
-!*****************************************************************************80
-!
-!! CLQMN: associated Legendre functions and derivatives for complex argument.
-!
-!  Discussion:
-!
-!    This procedure computes the associated Legendre functions of the second 
-!    kind, Qmn(z) and Qmn'(z), for a complex argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    02 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-! 
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) MM, the physical dimension of CQM and CQD.
-!
-!    Input, integer ( kind = 4 ) M, N, the order and degree of Qmn(z).
-!
-!    Input, real ( kind = 8 ) X, Y, the real and imaginary parts of the 
-!    argument Z.
-!
-!    Output, complex ( kind = 8 ) CQM(0:MM,0:N), CQD(0:MM,0:N), the values of
-!    Qmn(z) and Qmn'(z).
-!
-  implicit none
-
-  integer ( kind = 4 ) mm
-  integer ( kind = 4 ) n 
-
-  complex ( kind = 8 ) cq0
-  complex ( kind = 8 ) cq1
-  complex ( kind = 8 ) cq10
-  complex ( kind = 8 ) cqf
-  complex ( kind = 8 ) cqf0
-  complex ( kind = 8 ) cqf1
-  complex ( kind = 8 ) cqf2
-  complex ( kind = 8 ) cqm(0:mm,0:n)
-  complex ( kind = 8 ) cqd(0:mm,0:n)
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) km
-  integer ( kind = 4 ) ls
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xc
-  real ( kind = 8 ) y
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) zq
-  complex ( kind = 8 ) zs
-
-  z = cmplx ( x, y, kind = 8 )
-
-  if ( abs ( x ) == 1.0D+00 .and. y == 0.0D+00 ) then
-    do i = 0, m
-      do j = 0, n
-        cqm(i,j) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-        cqd(i,j) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-      end do
-    end do
-    return
-  end if
-
-  xc = abs ( z )
-
-  if ( imag ( z ) == 0.0D+00 .or. xc < 1.0D+00 ) then
-    ls = 1
-  end if
-
-  if ( 1.0D+00 < xc ) then
-    ls = -1
-  end if
-
-  zq = sqrt ( ls * ( 1.0D+00 - z * z ) )
-  zs = ls * ( 1.0D+00 - z * z )
-  cq0 = 0.5D+00 * log ( ls * ( 1.0D+00 + z ) / ( 1.0D+00 - z ) )
-
-  if ( xc < 1.0001D+00 ) then
-
-    cqm(0,0) = cq0
-    cqm(0,1) = z * cq0 - 1.0D+00
-    cqm(1,0) = -1.0D+00 / zq
-    cqm(1,1) = - zq * ( cq0 + z / ( 1.0D+00 - z * z ) )
-    do i = 0, 1
-      do j = 2, n
-        cqm(i,j) = ( ( 2.0D+00 * j - 1.0D+00 ) * z * cqm(i,j-1) &
-          - ( j + i - 1.0D+00 ) * cqm(i,j-2) ) / ( j - i )
-      end do
-    end do
-
-    do j = 0, n
-      do i = 2, m
-        cqm(i,j) = -2.0D+00 * ( i - 1.0D+00 ) * z / zq * cqm(i-1,j) &
-          - ls * ( j + i - 1.0D+00 ) * ( j - i + 2.0D+00 ) * cqm(i-2,j)
-      end do
-    end do
-
-  else
-
-    if ( 1.1D+00 < xc ) then
-      km = 40 + m + n
-    else
-      km = ( 40 + m + n ) * int ( - 1.0D+00 - 1.8D+00 * log ( xc - 1.0D+00 ) )
-    end if
-
-    cqf2 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-    cqf1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = km, 0, -1
-      cqf0 = ( ( 2 * k + 3.0D+00 ) * z * cqf1 &
-        - ( k + 2.0D+00 ) * cqf2 ) / ( k + 1.0D+00 )
-      if ( k <= n ) then
-        cqm(0,k) = cqf0
-      end if
-      cqf2 = cqf1
-      cqf1 = cqf0
-    end do
-
-    do k = 0, n
-      cqm(0,k) = cq0 * cqm(0,k) / cqf0
-    end do
- 
-    cqf2 = 0.0D+00
-    cqf1 = 1.0D+00
-    do k = km, 0, -1
-      cqf0 = ( ( 2 * k + 3.0D+00 ) * z * cqf1 &
-        - ( k + 1.0D+00 ) * cqf2 ) / ( k + 2.0D+00 )
-      if ( k <= n ) then
-        cqm(1,k) = cqf0
-      end if
-      cqf2 = cqf1
-      cqf1 = cqf0
-    end do
-
-    cq10 = -1.0D+00 / zq
-    do k = 0, n 
-      cqm(1,k) = cq10 * cqm(1,k) / cqf0
-    end do
-
-    do j = 0, n
-      cq0 = cqm(0,j)
-      cq1 = cqm(1,j)
-      do i = 0, m - 2
-        cqf = -2.0D+00 * ( i + 1 ) * z / zq * cq1 &
-          + ( j - i ) * ( j + i + 1.0D+00 ) * cq0
-        cqm(i+2,j) = cqf
-        cq0 = cq1
-        cq1 = cqf
-      end do
-    end do
-
-  end if
-
-  cqd(0,0) = ls / zs
-  do j = 1, n
-    cqd(0,j) = ls * j * ( cqm(0,j-1) - z * cqm(0,j) ) / zs
-  end do
-
-  do j = 0, n
-    do i = 1, m
-      cqd(i,j) = ls * i * z / zs * cqm(i,j) &
-        + ( i + j ) * ( j - i + 1.0D+00 ) / zq * cqm(i-1,j)
-    end do
-  end do
-
-  return
-end
-subroutine clqn ( n, x, y, cqn, cqd )
-
-!*****************************************************************************80
-!
-!! CLQN: Legendre function Qn(z) and derivative Wn'(z) for complex argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    01 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the degree of Qn(z).
-!
-!    Input, real ( kind = 8 ) X, Y, the real and imaginary parts of the 
-!    argument Z.
-!
-!    Output, complex ( kind = 8 ) CQN(0:N), CQD(0:N), the values of Qn(z) 
-!    and Qn'(z.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  complex ( kind = 8 ) cq0
-  complex ( kind = 8 ) cq1
-  complex ( kind = 8 ) cqf0
-  complex ( kind = 8 ) cqf1
-  complex ( kind = 8 ) cqf2
-  complex ( kind = 8 ) cqn(0:n)
-  complex ( kind = 8 ) cqd(0:n)
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) km
-  integer ( kind = 4 ) ls
-  real ( kind = 8 ) x
-  real ( kind = 8 ) y
-  complex ( kind = 8 ) z
-
-  z = cmplx ( x, y, kind = 8 )
-
-  if ( z == 1.0D+00 ) then
-    do k = 0, n
-      cqn(k) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-      cqd(k) = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-    end do
-    return
-  end if
-
-  if ( 1.0D+00 < abs ( z ) ) then
-    ls = -1
-  else
-    ls = +1
-  end if
-
-  cq0 = 0.5D+00 * log ( ls * ( 1.0D+00 + z ) / ( 1.0D+00 - z ) )
-  cq1 = z * cq0 - 1.0D+00
-  cqn(0) = cq0
-  cqn(1) = cq1
-
-  if ( abs ( z ) < 1.0001D+00 ) then
-
-    cqf0 = cq0
-    cqf1 = cq1
-    do k = 2, n
-      cqf2 = ( ( 2.0D+00 * k - 1.0D+00 ) * z * cqf1 &
-        - ( k - 1.0D+00 ) * cqf0 ) / k
-      cqn(k) = cqf2
-      cqf0 = cqf1
-      cqf1 = cqf2
-    end do
-
-  else
-
-    if ( 1.1D+00 < abs ( z ) ) then
-      km = 40 + n
-    else
-      km = ( 40 + n ) * int ( - 1.0D+00 &
-        - 1.8D+00 * log ( abs ( z - 1.0D+00 ) ) )
-    end if
-
-    cqf2 = 0.0D+00
-    cqf1 = 1.0D+00
-    do k = km, 0, -1
-      cqf0 = ( ( 2 * k + 3.0D+00 ) * z * cqf1 &
-        - ( k + 2.0D+00 ) * cqf2 ) / ( k + 1.0D+00 )
-      if ( k <= n ) then
-        cqn(k) = cqf0
-      end if
-      cqf2 = cqf1
-      cqf1 = cqf0
-    end do
-    do k = 0, n
-      cqn(k) = cqn(k) * cq0 / cqf0
-    end do
-  end if
-
-  cqd(0) = ( cqn(1) - z * cqn(0) ) / ( z * z - 1.0D+00 )
-  do k = 1, n
-    cqd(k) = ( k * z * cqn(k) - k * cqn(k-1) ) / ( z * z - 1.0D+00 )
-  end do
-
-  return
-end
-subroutine comelp ( hk, ck, ce )
-
-!*****************************************************************************80
-!
-!! COMELP computes complete elliptic integrals K(k) and E(k).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    07 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) HK, the modulus.  0 <= HK <= 1.
-!
-!    Output, real ( kind = 8 ) CK, CE, the values of K(HK) and E(HK).
-!
-  implicit none
-
-  real ( kind = 8 ) ae
-  real ( kind = 8 ) ak
-  real ( kind = 8 ) be
-  real ( kind = 8 ) bk
-  real ( kind = 8 ) ce
-  real ( kind = 8 ) ck
-  real ( kind = 8 ) hk
-  real ( kind = 8 ) pk
-
-  pk = 1.0D+00 - hk * hk
-
-  if ( hk == 1.0D+00 ) then
-
-    ck = 1.0D+300
-    ce = 1.0D+00
-
-  else
-
-    ak = ((( &
-        0.01451196212D+00   * pk &
-      + 0.03742563713D+00 ) * pk &
-      + 0.03590092383D+00 ) * pk &
-      + 0.09666344259D+00 ) * pk &
-      + 1.38629436112D+00
-
-    bk = ((( &
-        0.00441787012D+00   * pk &
-      + 0.03328355346D+00 ) * pk &
-      + 0.06880248576D+00 ) * pk &
-      + 0.12498593597D+00 ) * pk &
-      + 0.5D+00
-
-    ck = ak - bk * log ( pk )
-
-    ae = ((( &
-        0.01736506451D+00   * pk &
-      + 0.04757383546D+00 ) * pk &
-      + 0.0626060122D+00  ) * pk &
-      + 0.44325141463D+00 ) * pk &
-      + 1.0D+00
-
-    be = ((( &
-        0.00526449639D+00   * pk &
-      + 0.04069697526D+00 ) * pk &
-      + 0.09200180037D+00 ) * pk &
-      + 0.2499836831D+00  ) * pk
-
-    ce = ae - be * log ( pk )
-
-  end if
-
-  return
-end
-subroutine cpbdn ( n, z, cpb, cpd )
-
-!*****************************************************************************80
-!
-!! CPBDN: parabolic cylinder function Dn(z) and Dn'(z) for complex argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    29 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order.
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, complex ( kind = 8 ) CPB(0:N), CPD(0:N), the values of Dn(z) 
-!    and Dn'(z).
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) a0
-  complex ( kind = 8 ) c0
-  complex ( kind = 8 ) ca0
-  complex ( kind = 8 ) cf
-  complex ( kind = 8 ) cf0
-  complex ( kind = 8 ) cf1
-  complex ( kind = 8 ) cfa
-  complex ( kind = 8 ) cfb
-  complex ( kind = 8 ) cpb(0:n)
-  complex ( kind = 8 ) cpd(0:n)
-  complex ( kind = 8 ) cs0
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n0
-  integer ( kind = 4 ) n1
-  integer ( kind = 4 ) nm1
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) x
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) z1
-
-  pi = 3.141592653589793D+00
-  x = real ( z, kind = 8 )
-  a0 = abs ( z )
-  c0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-  ca0 = exp ( -0.25D+00 * z * z )
-
-  if ( 0 <= n ) then
-
-    cf0 = ca0
-    cf1 = z * ca0
-    cpb(0) = cf0
-    cpb(1) = cf1
-    do k = 2, n
-      cf = z * cf1 - ( k - 1.0D+00 ) * cf0
-      cpb(k) = cf
-      cf0 = cf1
-      cf1 = cf
-    end do
-
-  else
-
-    n0 = -n
-
-    if ( x <= 0.0D+00 .or. abs ( z ) == 0.0D+00 ) then
-
-      cf0 = ca0
-      cpb(0) = cf0
-      z1 = - z
-      if ( a0 <= 7.0D+00 ) then
-        call cpdsa ( -1, z1, cf1 )
-      else
-        call cpdla ( -1, z1, cf1 )
-      end if
-      cf1 = sqrt ( 2.0D+00 * pi ) / ca0 - cf1
-      cpb(1) = cf1
-      do k = 2, n0
-        cf = ( - z * cf1 + cf0 ) / ( k - 1.0D+00 )
-        cpb(k) = cf
-        cf0 = cf1
-        cf1 = cf
-      end do
-
-    else
-
-      if ( a0 <= 3.0D+00 ) then
-
-        call cpdsa ( -n0, z, cfa )
-        cpb(n0) = cfa
-        n1 = n0 + 1
-        call cpdsa ( -n1, z, cfb )
-        cpb(n1) = cfb
-        nm1 = n0 - 1
-        do k = nm1, 0, -1
-          cf = z * cfa + ( k + 1.0D+00 ) * cfb
-          cpb(k) = cf
-          cfb = cfa
-          cfa = cf
-        end do
-
-      else
-
-        m = 100 + abs ( n )
-        cfa = c0
-        cfb = cmplx ( 1.0D-30, 0.0D+00, kind = 8 )
-        do k = m, 0, -1
-          cf = z * cfb + ( k + 1.0D+00 ) * cfa
-          if ( k <= n0 ) then
-            cpb(k) = cf
-          end if
-          cfa = cfb
-          cfb = cf
-        end do
-        cs0 = ca0 / cf
-        do k = 0, n0
-          cpb(k) = cs0 * cpb(k)
-        end do
-
-      end if
-
-    end if
-
-  end if
-
-  cpd(0) = -0.5D+00 * z * cpb(0)
-
-  if ( 0 <= n ) then
-    do k = 1, n
-      cpd(k) = -0.5D+00 * z * cpb(k) + k * cpb(k-1)
-    end do
-  else
-    do k = 1, n0
-      cpd(k) = 0.5D+00 * z * cpb(k) - cpb(k-1)
-    end do
-  end if
-
-  return
-end
-subroutine cpdla ( n, z, cdn )
-
-!****************************************************************************80
-!
-!! CPDLA computes complex parabolic cylinder function Dn(z) for large argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    07 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer N, the order.
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, complex ( kind = 8 ) CDN, the function value.
-!
-  implicit none
-
-  complex ( kind = 8 ) cb0
-  complex ( kind = 8 ) cdn
-  complex ( kind = 8 ) cr
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) n
-  complex ( kind = 8 ) z
-
-  cb0 = z ** n * exp ( -0.25D+00 * z * z )
-  cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-  cdn = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-
-  do k = 1, 16
-
-    cr = -0.5D+00 * cr * ( 2.0D+00 * k - n - 1.0D+00 ) &
-      * ( 2.0D+00 * k - n - 2.0D+00 ) / ( k * z * z )
-
-    cdn = cdn + cr
-
-    if ( abs ( cr ) < abs ( cdn ) * 1.0D-12 ) then
-      exit
-    end if
-
-  end do
-
-  cdn = cb0 * cdn
-
-  return
-end
-subroutine cpdsa ( n, z, cdn )
-
-!*****************************************************************************80
-!
-!! CPDSA computes complex parabolic cylinder function Dn(z) for small argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    29 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order.
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, complex ( kind = 8 ) CDN, the value of DN(z).
-!
-  implicit none
-
-  complex ( kind = 8 ) ca0
-  complex ( kind = 8 ) cb0
-  complex ( kind = 8 ) cdn
-  complex ( kind = 8 ) cdw
-  complex ( kind = 8 ) cr
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) g0
-  real ( kind = 8 ) g1
-  real ( kind = 8 ) ga0
-  real ( kind = 8 ) gm
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) pd
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) sq2
-  real ( kind = 8 ) va0
-  real ( kind = 8 ) vm
-  real ( kind = 8 ) vt
-  real ( kind = 8 ) xn
-  complex ( kind = 8 ) z
-
-  eps = 1.0D-15
-  pi = 3.141592653589793D+00
-  sq2 = sqrt ( 2.0D+00 )
-  ca0 = exp ( - 0.25D+00 * z * z )
-  va0 = 0.5D+00 * ( 1.0D+00 - n )
-
-  if ( n == 0 ) then
-
-    cdn = ca0
-
-  else
-
-    if ( abs ( z ) == 0.0D+00 ) then
-
-      if ( va0 <= 0.0D+00 .and. va0 == int ( va0 ) ) then
-        cdn = 0.0D+00
-      else
-        call gaih ( va0, ga0 )
-        pd = sqrt ( pi ) / ( 2.0D+00 ** ( -0.5D+00 * n ) * ga0 )
-        cdn = cmplx ( pd, 0.0D+00, kind = 8 )
-      end if
-
-    else
-
-      xn = - n
-      call gaih ( xn, g1 )
-      cb0 = 2.0D+00 ** ( -0.5D+00 * n - 1.0D+00 ) * ca0 / g1
-      vt = -0.5D+00 * n
-      call gaih ( vt, g0 )
-      cdn = cmplx ( g0, 0.0D+00, kind = 8 )
-      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-
-      do m = 1, 250
-        vm = 0.5D+00 * ( m - n )
-        call gaih ( vm, gm )
-        cr = - cr * sq2 * z / m
-        cdw = gm * cr
-        cdn = cdn + cdw
-        if ( abs ( cdw ) < abs ( cdn ) * eps ) then
-          exit
-        end if
-      end do
-
-      cdn = cb0 * cdn
-
-    end if
-
-  end if
-
-  return
-end
-subroutine cpsi ( x, y, psr, psi )
-
-!*****************************************************************************80
-!
-!! CPSI computes the psi function for a complex argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    16 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, Y, the real and imaginary parts 
-!    of the argument.
-!
-!    Output, real ( kind = 8 ) PSR, PSI, the real and imaginary parts
-!    of the function value.
-!
-  implicit none
-
-  real ( kind = 8 ), save, dimension ( 8 ) :: a = (/ &
-    -0.8333333333333D-01, 0.83333333333333333D-02, &
-    -0.39682539682539683D-02, 0.41666666666666667D-02, &
-    -0.75757575757575758D-02, 0.21092796092796093D-01, &
-    -0.83333333333333333D-01, 0.4432598039215686D+00 /)
-  real ( kind = 8 ) ct2
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) psi
-  real ( kind = 8 ) psr
-  real ( kind = 8 ) ri
-  real ( kind = 8 ) rr
-  real ( kind = 8 ) th
-  real ( kind = 8 ) tm
-  real ( kind = 8 ) tn
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x0
-  real ( kind = 8 ) x1
-  real ( kind = 8 ) y
-  real ( kind = 8 ) y1
-  real ( kind = 8 ) z0
-  real ( kind = 8 ) z2
-
-  pi = 3.141592653589793D+00
-
-  if ( y == 0.0D+00 .and. x == int ( x ) .and. x <= 0.0D+00 ) then
-
-    psr = 1.0D+300
-    psi = 0.0D+00
-
-  else
-
-    if ( x < 0.0D+00 ) then
-      x1 = x
-      y1 = y
-      x = -x
-      y = -y
-    end if
-
-    x0 = x
-
-    if ( x < 8.0D+00 ) then
-      n = 8 - int ( x )
-      x0 = x + n
-    end if
-
-    if ( x0 == 0.0D+00 ) then
-      if ( y /= 0.0D+00 ) then
-        th = 0.5D+00 * pi
-      else
-        th = 0.0D+00
-      end if
-    else
-      th = atan ( y / x0 )
-    end if
-
-    z2 = x0 * x0 + y * y
-    z0 = sqrt ( z2 )
-    psr = log ( z0 ) - 0.5D+00 * x0 / z2
-    psi = th + 0.5D+00 * y / z2
-    do k = 1, 8
-      psr = psr + a(k) * z2 ** ( - k ) * cos ( 2.0D+00 * k * th )
-      psi = psi - a(k) * z2 ** ( - k ) * sin ( 2.0D+00 * k * th )
-    end do
-
-    if ( x < 8.0D+00 ) then
-      rr = 0.0D+00
-      ri = 0.0D+00
-      do k = 1, n
-        rr = rr + ( x0 - k ) / ( ( x0 - k ) ** 2.0D+00 + y * y )
-        ri = ri + y / ( ( x0 - k ) ** 2.0D+00 + y * y )
-      end do
-      psr = psr - rr
-      psi = psi + ri
-    end if
-
-    if ( x1 < 0.0D+00 ) then
-      tn = tan ( pi * x )
-      tm = tanh ( pi * y )
-      ct2 = tn * tn + tm * tm
-      psr = psr + x / ( x * x + y * y ) + pi * ( tn - tn * tm * tm ) / ct2
-      psi = psi - y / ( x * x + y * y ) - pi * tm * ( 1.0D+00 + tn * tn ) / ct2
-      x = x1
-      y = y1
-    end if
-
-  end if
-
-  return
-end
-subroutine csphik ( n, z, nm, csi, cdi, csk, cdk )
-
-!*****************************************************************************80
-!
-!! CSPHIK: complex modified spherical Bessel functions and derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    29 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-! 
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order of in(z) and kn(z).
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, integer ( kind = 4 ) NM, the highest order computed.
-!
-!    Output, complex ( kind = 8 ) CSI(0:N), CDI(0:N), CSK(0:N), CDK(0:N),
-!    the values of in(z), in'(z), kn(z), kn'(z).
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) a0
-  complex ( kind = 8 ) ccosh1
-  complex ( kind = 8 ) cdi(0:n)
-  complex ( kind = 8 ) cdk(0:n)
-  complex ( kind = 8 ) cf
-  complex ( kind = 8 ) cf0
-  complex ( kind = 8 ) cf1
-  complex ( kind = 8 ) ci
-  complex ( kind = 8 ) cs
-  complex ( kind = 8 ) csi(0:n)
-  complex ( kind = 8 ) csi0
-  complex ( kind = 8 ) csi1
-  complex ( kind = 8 ) csinh1
-  complex ( kind = 8 ) csk(0:n)
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) pi
-  complex ( kind = 8 ) z
-
-  pi = 3.141592653589793D+00
-  a0 = abs ( z )    
-  nm = n
-
-  if ( a0 < 1.0D-60 ) then
-    do k = 0, n
-      csi(k) = 0.0D+00
-      cdi(k) = 0.0D+00
-      csk(k) = 1.0D+300
-      cdk(k) = -1.0D+300
-    end do
-    csi(0) = 1.0D+00
-    cdi(1) = 0.3333333333333333D+00
-    return
-  end if
-
-  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
-  csinh1 = sin ( ci * z ) / ci
-  ccosh1 = cos ( ci * z )
-  csi0 = csinh1 / z
-  csi1 = ( - csinh1 / z + ccosh1 ) / z
-  csi(0) = csi0
-  csi(1) = csi1
-
-  if ( 2 <= n ) then
-
-    m = msta1 ( a0, 200 )
-    if ( m < n ) then
-      nm = m
-    else
-      m = msta2 ( a0, n, 15 )
-    end if
-
-    cf0 = 0.0D+00
-    cf1 = 1.0D+00-100
-    do k = m, 0, -1
-      cf = ( 2.0D+00 * k + 3.0D+00 ) * cf1 / z + cf0
-      if ( k <= nm ) then
-        csi(k) = cf
-      end if
-      cf0 = cf1
-      cf1 = cf
-    end do
-
-    if ( abs ( csi0 ) <= abs ( csi1 ) ) then
-      cs = csi1 / cf0
-    else
-      cs = csi0 / cf
-    end if
-
-    do k = 0, nm
-      csi(k) = cs * csi(k)
-    end do
-
-  end if
-
-  cdi(0) = csi(1)
-  do k = 1, nm
-    cdi(k) = csi(k-1) - ( k + 1.0D+00 ) * csi(k) / z
-  end do
-
-  csk(0) = 0.5D+00 * pi / z * exp ( - z )
-  csk(1) = csk(0) * ( 1.0D+00 + 1.0D+00 / z )
-  do k = 2, nm
-    if ( abs ( csi(k-2) ) < abs ( csi(k-1) ) ) then
-      csk(k) = ( 0.5D+00 * pi / ( z * z ) - csi(k) * csk(k-1) ) / csi(k-1)
-    else
-      csk(k) = ( csi(k) * csk(k-2) + ( k - 0.5D+00 ) * pi / z ** 3 ) / csi(k-2)
-    end if
-  end do
-
-  cdk(0) = -csk(1)
-  do k = 1, nm
-    cdk(k) = - csk(k-1) - ( k + 1.0D+00 ) * csk(k) / z
-  end do
-
-  return
-end
-subroutine csphjy ( n, z, nm, csj, cdj, csy, cdy )
-
-!*****************************************************************************80
-!
-!! CSPHJY: spherical Bessel functions jn(z) and yn(z) for complex argument.
-!
-!  Discussion:
-!
-!    This procedure computes spherical Bessel functions jn(z) and yn(z)
-!    and their derivatives for a complex argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    01 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-! 
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order of jn(z) and yn(z).
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, integer ( kind = 4 ) NM, the highest order computed.
-!
-!    Output, complex ( kind = 8 ) CSJ(0:N0, CDJ(0:N), CSY(0:N), CDY(0:N),
-!    the values of jn(z), jn'(z), yn(z), yn'(z).
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) a0
-  complex ( kind = 8 ) csj(0:n)
-  complex ( kind = 8 ) cdj(0:n)
-  complex ( kind = 8 ) csy(0:n)
-  complex ( kind = 8 ) cdy(0:n)
-  complex ( kind = 8 ) cf
-  complex ( kind = 8 ) cf0
-  complex ( kind = 8 ) cf1
-  complex ( kind = 8 ) cs
-  complex ( kind = 8 ) csa
-  complex ( kind = 8 ) csb
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) nm
-  complex ( kind = 8 ) z
-
-  a0 = abs ( z )
-  nm = n
-
-  if ( a0 < 1.0D-60 ) then
-    do k = 0, n
-      csj(k) = 0.0D+00
-      cdj(k) = 0.0D+00
-      csy(k) = -1.0D+300
-      cdy(k) = 1.0D+300
-    end do
-    csj(0) = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cdj(1) = cmplx ( 0.333333333333333D+00, 0.0D+00, kind = 8 )
-    return
-  end if
-
-  csj(0) = sin ( z ) / z
-  csj(1) = ( csj(0) - cos ( z ) ) / z
-
-  if ( 2 <= n ) then
-    csa = csj(0)
-    csb = csj(1)
-    m = msta1 ( a0, 200 )
-    if ( m < n ) then
-      nm = m
-    else
-      m = msta2 ( a0, n, 15 )
-    end if
-    cf0 = 0.0D+00
-    cf1 = 1.0D+00-100
-    do k = m, 0, -1
-      cf = ( 2.0D+00 * k + 3.0D+00 ) * cf1 / z - cf0
-      if ( k <= nm ) then
-        csj(k) = cf
-      end if
-      cf0 = cf1
-      cf1 = cf
-    end do
-
-    if ( abs ( csa ) <= abs ( csb ) ) then
-      cs = csb / cf0
-    else
-      cs = csa / cf
-    end if
-
-    do k = 0, nm
-      csj(k) = cs * csj(k)
-    end do
-
-  end if
-
-  cdj(0) = ( cos ( z ) - sin ( z ) / z ) / z
-  do k = 1, nm
-    cdj(k) = csj(k-1) - ( k + 1.0D+00 ) * csj(k) / z
-  end do
-  csy(0) = - cos ( z ) / z
-  csy(1) = ( csy(0) - sin ( z ) ) / z
-  cdy(0) = ( sin ( z ) + cos ( z ) / z ) / z
-  cdy(1) = ( 2.0D+00 * cdy(0) - cos ( z ) )  / z
-
-  do k = 2, nm
-    if ( abs ( csj(k-2) ) < abs ( csj(k-1) ) ) then 
-      csy(k) = ( csj(k) * csy(k-1) - 1.0D+00 / ( z * z ) ) / csj(k-1)
-    else
-      csy(k) = ( csj(k) * csy(k-2) &
-        - ( 2.0D+00 * k - 1.0D+00 ) / z ** 3 ) / csj(k-2)
-    end if
-  end do
-
-  do k = 2, nm
-    cdy(k) = csy(k-1) - ( k + 1.0D+00 ) * csy(k) / z
-  end do
-
-  return
-end
-subroutine cv0 ( kd, m, q, a0 )
-
-!*****************************************************************************80
-!
-!! CV0 computes the initial characteristic value of Mathieu functions.
-!
-!  Discussion:
-!
-!    This procedure computes the initial characteristic value of Mathieu 
-!    functions for m <= 12 or q <= 300 or q <= m*m.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!   03 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) KD, the case code:
-!    1, for cem(x,q)  ( m = 0,2,4,...)
-!    2, for cem(x,q)  ( m = 1,3,5,...)
-!    3, for sem(x,q)  ( m = 1,3,5,...)
-!    4, for sem(x,q)  ( m = 2,4,6,...)
-!
-!    Input, integer ( kind = 4 ) M, the order of the functions.
-!
-!    Input, real ( kind = 8 ) Q, the parameter of the functions.
-!
-!    Output, real ( kind = 8 ) A0, the characteristic value.
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) q
-  real ( kind = 8 ) q2
-
-  q2 = q * q
-
-  if ( m == 0 ) then
-
-    if ( q <= 1.0D+00 ) then
-
-      a0 = ((( &
-          0.0036392D+00   * q2 &
-        - 0.0125868D+00 ) * q2 &
-        + 0.0546875D+00 ) * q2 &
-        - 0.5D+00 )       * q2
-
-    else if ( q <= 10.0D+00 ) then
-
-      a0 = (( &
-          3.999267D-03   * q &
-        - 9.638957D-02 ) * q &
-        - 0.88297D+00 )  * q &
-        + 0.5542818D+00 
-
-    else
-
-      call cvql ( kd, m, q, a0 )
-
-    end if
-
-  else if ( m == 1 ) then
-
-    if ( q <= 1.0D+00 .and. kd == 2 ) then
-
-      a0 = ((( &
-        - 6.51D-04 * q &
-        - 0.015625D+00 ) *  q &
-        - 0.125D+00 ) * q &
-        + 1.0D+00 ) * q &
-        + 1.0D+00 
-
-    else if ( q <= 1.0D+00 .and. kd == 3 ) then
-
-      a0 = ((( &
-        - 6.51D-04 * q &
-        + 0.015625D+00 ) * q &
-        - 0.125D+00 ) * q &
-        - 1.0D+00 ) * q &
-        + 1.0D+00
- 
-    else if ( q <= 10.0D+00 .and. kd == 2 ) then
-
-      a0 = ((( &
-        - 4.94603D-04 * q &
-        + 1.92917D-02 ) * q &
-        - 0.3089229D+00 ) * q &
-        + 1.33372D+00 ) * q &
-        + 0.811752D+00 
-
-    else if ( q <= 10.0D+00 .and. kd == 3 ) then
-
-      a0 = (( &
-          1.971096D-03 * q &
-        - 5.482465D-02 ) * q &
-        - 1.152218D+00 ) * q &
-        + 1.10427D+00 
-
-    else
-
-      call cvql ( kd, m, q, a0 )
-
-    end if
-
-  else if ( m == 2 ) then
-
-    if ( q <= 1.0D+00 .and. kd == 1 ) then
-
-      a0 = ((( &
-        - 0.0036391D+00   * q2 &
-        + 0.0125888D+00 ) * q2 &
-        - 0.0551939D+00 ) * q2 &
-        + 0.416667D+00 )  * q2 + 4.0D+00 
-
-    else if ( q <= 1.0D+00 .and. kd == 4 ) then
-
-      a0 = (  &
-          0.0003617D+00 * q2  &
-        - 0.0833333D+00 ) * q2 + 4.0D+00 
-
-    else if ( q <= 15.0D+00 .and. kd == 1 ) then
-
-      a0 = ((( &
-          3.200972D-04    * q &
-        - 8.667445D-03 )  * q &
-        - 1.829032D-04 )  * q &
-        + 0.9919999D+00 ) * q &
-        + 3.3290504D+00 
-
-    else if ( q <= 10.0D+00 .and. kd == 4 ) then
-
-      a0 = (( &
-          2.38446D-03 * q &
-        - 0.08725329D+00 ) * q &
-        - 4.732542D-03 ) * q &
-        + 4.00909D+00 
-
-    else
-
-      call cvql ( kd, m, q, a0 )
-
-    end if
-
-  else if ( m == 3 ) then
-
-    if ( q <= 1.0D+00 .and. kd == 2 ) then
-      a0 = (( &
-          6.348D-04 * q &
-        + 0.015625D+00 ) * q &
-        + 0.0625 ) * q2  &
-        + 9.0D+00 
-    else if ( q <= 1.0D+00 .and. kd == 3 ) then
-      a0 = (( &
-          6.348D-04 * q &
-        - 0.015625D+00 ) * q &
-        + 0.0625D+00 ) * q2 &
-        + 9.0D+00 
-    else if ( q <= 20.0D+00 .and. kd == 2 ) then
-      a0 = ((( &
-          3.035731D-04 * q &
-        - 1.453021D-02 ) * q &
-        + 0.19069602D+00 ) * q &
-        - 0.1039356D+00 ) * q &
-        + 8.9449274D+00 
-    else if ( q <= 15.0D+00 .and. kd == 3 ) then
-      a0 = (( &
-          9.369364D-05 * q &
-        - 0.03569325D+00 ) * q &
-        + 0.2689874D+00 ) * q &
-        + 8.771735D+00 
-    else
-      call cvql ( kd, m, q, a0 )
-    end if
-
-  else if ( m == 4 ) then
-
-    if ( q <= 1.0D+00 .and. kd == 1 ) then
-      a0 = (( &
-        - 2.1D-06 * q2 &
-        + 5.012D-04 ) * q2 &
-        + 0.0333333 ) * q2 &
-        + 16.0D+00
-    else if ( q <= 1.0D+00 .and. kd == 4 ) then
-      a0 = (( &
-          3.7D-06 * q2 &
-        - 3.669D-04 ) * q2 &
-        + 0.0333333D+00 ) * q2 &
-        + 16.0D+00
-    else if ( q <= 25.0D+00 .and. kd == 1 ) then
-      a0 = ((( &
-          1.076676D-04 * q &
-        - 7.9684875D-03 ) * q &
-        + 0.17344854D+00 ) * q &
-        - 0.5924058D+00 ) * q &
-        + 16.620847D+00
-    else if ( q <= 20.0D+00 .and. kd == 4 ) then
-      a0 = (( &
-        - 7.08719D-04 * q &
-        + 3.8216144D-03 ) * q &
-        + 0.1907493D+00 ) * q &
-        + 15.744D+00
-    else
-      call cvql ( kd, m, q, a0 )
-    end if
-
-  else if ( m == 5 ) then
-
-    if ( q <= 1.0D+00 .and. kd == 2 ) then
-      a0 = (( &
-          6.8D-6 * q &
-        + 1.42D-05 ) * q2 &
-        + 0.0208333D+00 ) * q2 &
-        + 25.0D+00
-    else if ( q <= 1.0D+00 .and. kd == 3 ) then
-      a0 = (( &
-        - 6.8D-06 * q &
-        + 1.42D-05 ) * q2 &
-        + 0.0208333D+00 ) * q2 &
-        + 25.0D+00
-    else if ( q <= 35.0D+00 .and. kd == 2 ) then
-      a0 = ((( &
-          2.238231D-05 * q &
-        - 2.983416D-03 ) * q &
-        + 0.10706975D+00 ) * q &
-        - 0.600205D+00 ) * q &
-        + 25.93515D+00
-    else if ( q <= 25.0D+00 .and. kd == 3 ) then
-      a0 = (( &
-        - 7.425364D-04 * q &
-        + 2.18225D-02 ) * q &
-        + 4.16399D-02 ) * q &
-        + 24.897D+00
-    else
-      call cvql ( kd, m, q, a0 )
-    end if
-
-  else if ( m == 6 ) then
-
-    if ( q <= 1.0D+00 ) then
-      a0 = ( 0.4D-06 * q2 + 0.0142857 ) * q2 + 36.0D+00
-    else if ( q <= 40.0D+00 .and. kd == 1 ) then
-      a0 = ((( &
-        - 1.66846D-05 * q &
-        + 4.80263D-04 ) * q &
-        + 2.53998D-02 ) * q &
-        - 0.181233D+00 ) * q  &
-        + 36.423D+00
-    else if ( q <= 35.0D+00 .and. kd == 4 ) then
-      a0 = (( &
-        - 4.57146D-04 * q &
-        + 2.16609D-02 ) * q &
-        - 2.349616D-02 ) * q &
-        + 35.99251D+00
-    else
-      call cvql ( kd, m, q, a0 )
-    end if
-
-  else if ( m == 7 ) then
-
-    if ( q <= 10.0D+00 ) then
-      call cvqm ( m, q, a0 )
-    else if ( q <= 50.0D+00 .and. kd == 2 ) then
-      a0 = ((( &
-        - 1.411114D-05 * q &
-        + 9.730514D-04 ) * q &
-        - 3.097887D-03 ) * q &
-        + 3.533597D-02 ) * q &
-        + 49.0547D+00
-    else if ( q <= 40.0D+00 .and. kd == 3 ) then
-      a0 = (( &
-        - 3.043872D-04 * q &
-        + 2.05511D-02 ) * q &
-        - 9.16292D-02 ) * q &
-        + 49.19035D+00
-    else
-      call cvql ( kd, m, q, a0 )
-    end if
-
-  else if ( 8 <= m ) then
-
-    if ( q <= 3.0D+00 * m ) then
-      call cvqm ( m, q, a0 )
-    else if ( m * m .lt. q ) then
-      call cvql ( kd, m, q, a0 )
-    else if ( m == 8 .and. kd == 1 ) then
-      a0 = ((( &
-          8.634308D-06 * q &
-        - 2.100289D-03 ) * q &
-        + 0.169072D+00 ) * q &
-        - 4.64336D+00 ) * q &
-        + 109.4211D+00
-    else if ( m == 8 .and. kd == 4 ) then
-      a0 = (( &
-        - 6.7842D-05 * q &
-        + 2.2057D-03 ) * q &
-        + 0.48296D+00 ) * q &
-        + 56.59D+00
-    else if ( m == 9 .and. kd == 2 ) then
-      a0 = ((( &
-          2.906435D-06 * q &
-        - 1.019893D-03 ) * q &
-        + 0.1101965D+00 ) * q &
-        - 3.821851D+00 ) * q &
-        + 127.6098D+00
-    else if ( m == 9 .and. kd == 3 ) then
-      a0 = (( &
-        - 9.577289D-05 * q &
-        + 0.01043839D+00 ) * q &
-        + 0.06588934D+00 ) * q &
-        + 78.0198D+00
-    else if ( m == 10 .and. kd == 1 ) then
-      a0 = ((( &
-          5.44927D-07 * q &
-        - 3.926119D-04 ) * q &
-        + 0.0612099D+00 ) * q &
-        - 2.600805D+00 ) * q &
-        + 138.1923D+00
-    else if ( m == 10 .and. kd == 4 ) then
-      a0 = (( &
-        - 7.660143D-05 * q &
-        + 0.01132506D+00 ) * q &
-        - 0.09746023D+00 ) * q &
-        + 99.29494D+00
-    else if ( m == 11 .and. kd == 2 ) then
-      a0 = ((( &
-        - 5.67615D-07 * q &
-        + 7.152722D-06 ) * q &
-        + 0.01920291D+00 ) * q &
-        - 1.081583D+00 ) * q &
-        + 140.88D+00
-    else if ( m == 11 .and. kd == 3 ) then
-      a0 = (( &
-        - 6.310551D-05 * q &
-        + 0.0119247D+00 ) * q &
-        - 0.2681195D+00 ) * q &
-        + 123.667D+00 
-    else if ( m == 12 .and. kd == 1 ) then
-      a0 = ((( &
-        - 2.38351D-07 * q &
-        - 2.90139D-05 ) * q &
-        + 0.02023088D+00 ) * q &
-        - 1.289D+00 ) * q &
-        + 171.2723D+00
-    else if ( m == 12 .and. kd == 4 ) then
-      a0 = ((( &
-          3.08902D-07 * q &
-        - 1.577869D-04 ) * q &
-        + 0.0247911D+00 ) * q &
-        - 1.05454D+00 ) * q  &
-        + 161.471D+00
-
-    end if
-
-  end if
-
-  return
-end
-subroutine cva1 ( kd, m, q, cv )
-
-!*****************************************************************************80
-!
-!! CVA1 computes a sequence of characteristic values of Mathieu functions.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    25 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) KD, the case code.
-!    1, for cem(x,q)  ( m = 0,2,4,úúú )
-!    2, for cem(x,q)  ( m = 1,3,5,úúú )
-!    3, for sem(x,q)  ( m = 1,3,5,úúú )
-!    4, for sem(x,q)  ( m = 2,4,6,úúú )
-!
-!    Input, integer ( kind = 4 ) M, the maximum order of the Mathieu functions.
-!
-!    Input, real ( kind = 8 ) Q, the parameter of the Mathieu functions.
-!
-!    Output, real ( kind = 8 ) CV(*), characteristic values.
-!    For KD = 1, CV(1), CV(2), CV(3),..., correspond to
-!    the characteristic values of cem for m = 0,2,4,...
-!    For KD = 2, CV(1), CV(2), CV(3),..., correspond to
-!    the characteristic values of cem for m = 1,3,5,...
-!    For KD = 3, CV(1), CV(2), CV(3),..., correspond to
-!    the characteristic values of sem for m = 1,3,5,...
-!    For KD = 4, CV(1), CV(2), CV(3),..., correspond to
-!    the characteristic values of sem for m = 0,2,4,...
-!       
-  implicit none
-
-  real ( kind = 8 ) cv(200)
-  real ( kind = 8 ) d(500)
-  real ( kind = 8 ) e(500)
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) f(500)
-  real ( kind = 8 ) g(200)
-  real ( kind = 8 ) h(200)
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) ic
-  integer ( kind = 4 ) icm
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k1
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) nm
-  integer ( kind = 4 ) nm1
-  real ( kind = 8 ) q
-  real ( kind = 8 ) s
-  real ( kind = 8 ) t
-  real ( kind = 8 ) t1
-  real ( kind = 8 ) x1
-  real ( kind = 8 ) xa
-  real ( kind = 8 ) xb
-
-  eps = 1.0D-14
-
-  if ( kd == 4 ) then
-    icm = m / 2
-  else
-    icm = int ( m / 2 ) + 1
-  end if
-
-  if ( q == 0.0D+00 ) then
-
-    if ( kd == 1 ) then
-      do ic = 1, icm
-        cv(ic) = 4.0D+00 * ( ic - 1.0D+00 ) ** 2
-      end do
-    else if ( kd /= 4 ) then
-      do ic = 1, icm
-        cv(ic) = ( 2.0D+00 * ic - 1.0D+00 ) ** 2
-      end do
-    else
-      do ic = 1, icm
-        cv(ic) = 4.0D+00 * ic * ic
-      end do
-    end if
-
-  else
-
-    nm = int ( 10D+00 + 1.5D+00 * m + 0.5D+00 * q )
-    e(1) = 0.0D+00
-    f(1) = 0.0D+00
-
-    if ( kd == 1 ) then
-
-      d(1) = 0.0D+00
-      do i = 2, nm
-        d(i) = 4.0D+00 * ( i - 1.0D+00 ) ** 2
-        e(i) = q
-        f(i) = q * q
-      end do
-      e(2) = sqrt ( 2.0D+00 ) * q
-      f(2) = 2.0D+00 * q * q
-
-    else if ( kd /= 4 ) then
-
-      d(1) = 1.0D+00 + ( -1.0D+00 ) ** kd * q
-      do i = 2, nm
-        d(i) = ( 2.0D+00 * i - 1.0D+00 ) ** 2
-        e(i) = q
-        f(i) = q * q
-      end do
-
-    else
-
-      d(1) = 4.0D+00
-      do i = 2, nm
-        d(i) = 4.0D+00 * i * i
-        e(i) = q
-        f(i) = q * q
-      end do
-
-    end if
-
-    xa = d(nm) + abs ( e(nm) )
-    xb = d(nm) - abs ( e(nm) )
-
-    nm1 = nm - 1
-    do i = 1, nm1
-      t = abs ( e(i) ) + abs ( e(i+1) )
-      t1 = d(i) + t
-      xa = max ( xa, t1 )
-      t1 = d(i) - t
-      xb = min ( xb, t1 )
-    end do
-
-    do i = 1, icm
-      g(i) = xa
-      h(i) = xb
-    end do
-
-    do k = 1, icm
-
-      do k1 = k, icm
-        if ( g(k1) < g(k) ) then
-          g(k) = g(k1)
-          exit
-        end if
-      end do
-
-      if ( k /= 1 .and. h(k) < h(k-1) ) then
-        h(k) = h(k-1)
-      end if
-
-      do
-
-        x1 = ( g(k) + h(k) ) /2.0D+00
-        cv(k) = x1
-
-        if ( abs ( ( g(k) - h(k) ) / x1 ) < eps ) then
-          exit
-        end if
-
-        j = 0
-        s = 1.0D+00
-        do i = 1, nm
-          if ( s == 0.0D+00 ) then
-            s = s + 1.0D-30
-          end if
-          t = f(i) / s
-          s = d(i) - t - x1
-          if ( s < 0.0D+00 ) then
-            j = j + 1
-          end if
-        end do
-
-        if ( j < k ) then
-          h(k) = x1
-        else
-          g(k) = x1
-          if ( icm <= j ) then
-            g(icm) = x1
-          else
-            h(j+1) = max ( h(j+1), x1 )
-            g(j) = min ( g(j), x1 )
-          end if
-        end if
-
-      end do
-
-      cv(k) = x1
-
-    end do
-
-  end if
-
-  return
-end
-subroutine cva2 ( kd, m, q, a )
-
-!*****************************************************************************80
-!
-!! CVA2 computes a specific characteristic value of Mathieu functions.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    22 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) KD, the case code:
-!    1, for cem(x,q)  ( m = 0,2,4,...)
-!    2, for cem(x,q)  ( m = 1,3,5,...)
-!    3, for sem(x,q)  ( m = 1,3,5,...)
-!    4, for sem(x,q)  ( m = 2,4,6,...)
-!
-!    Input, integer ( kind = 4 ) M, the order of the Mathieu functions.
-!
-!    Input, real ( kind = 8 ) Q, the parameter of the Mathieu functions.
-!
-!    Output, real ( kind = 8 ) A, the characteristic value.
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) a1
-  real ( kind = 8 ) a2
-  real ( kind = 8 ) delta
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) iflag
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) ndiv
-  integer ( kind = 4 ) nn
-  real ( kind = 8 ) q
-  real ( kind = 8 ) q1
-  real ( kind = 8 ) q2
-  real ( kind = 8 ) qq
-
-  if ( m <= 12 .or. q <= 3.0D+00 * m .or. m * m < q ) then
-
-    call cv0 ( kd, m, q, a )
-
-    if ( q /= 0.0D+00 ) then
-      call refine ( kd, m, q, a, 1 )
-    end if
-
-  else
-
-    ndiv = 10
-    delta = ( m - 3.0D+00 ) * m / real ( ndiv, kind = 8 )
-
-    if ( ( q - 3.0D+00 * m ) <= ( m * m - q ) ) then
-
-      do
-
-        nn = int ( ( q - 3.0D+00 * m ) / delta ) + 1
-        delta = ( q - 3.0D+00 * m ) / nn
-        q1 = 2.0D+00 * m
-        call cvqm ( m, q1, a1 )
-        q2 = 3.0D+00 * m
-        call cvqm ( m, q2, a2 )
-        qq = 3.0D+00 * m
- 
-        do i = 1, nn
-
-          qq = qq + delta
-          a = ( a1 * q2 - a2 * q1 + ( a2 - a1 ) * qq ) / ( q2 - q1 )
- 
-          if ( i == nn ) then
-            iflag = -1
-          else
-            iflag = 1
-          end if
-
-          call refine ( kd, m, qq, a, iflag )
-          q1 = q2
-          q2 = qq
-          a1 = a2
-          a2 = a
-
-        end do
-
-        if ( iflag /= -10 ) then
-          exit
-        end if
-
-        ndiv = ndiv * 2
-        delta = ( m - 3.0D+00 ) * m / real ( ndiv, kind = 8 )
-
-      end do
-
-    else
-
-      do
-
-        nn = int ( ( m * m - q ) / delta ) + 1
-        delta = ( m * m - q ) / nn
-        q1 = m * ( m - 1.0D+00 )
-        call cvql ( kd, m, q1, a1 )
-        q2 = m * m
-        call cvql ( kd, m, q2, a2 )
-        qq = m * m
-
-        do i = 1, nn
-
-          qq = qq - delta
-          a = ( a1 * q2 - a2 * q1 + ( a2 - a1 ) * qq ) / ( q2 - q1 )
-
-          if ( i == nn ) then
-            iflag = -1
-          else
-            iflag = 1
-          end if
-
-          call refine ( kd, m, qq, a, iflag )
-          q1 = q2
-          q2 = qq
-          a1 = a2
-          a2 = a
-
-        end do
-
-        if ( iflag /= -10 ) then
-          exit
-        end if
-
-        ndiv = ndiv * 2
-        delta = ( m - 3.0D+00 ) * m / real ( ndiv, kind = 8 )
-
-      end do
-
-    end if
-
-  end if
-
-  return
-end
-subroutine cvf ( kd, m, q, a, mj, f )
-
-!*****************************************************************************80
-!
-!! CVF computes F for the characteristic equation of Mathieu functions.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    16 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) KD, the case code:
-!    1, for cem(x,q)  ( m = 0,2,4,...)
-!    2, for cem(x,q)  ( m = 1,3,5,...)
-!    3, for sem(x,q)  ( m = 1,3,5,...)
-!    4, for sem(x,q)  ( m = 2,4,6,...)
-!
-!    Input, integer ( kind = 4 ) M, the order of the Mathieu functions.
-!
-!    Input, real ( kind = 8 ) Q, the parameter of the Mathieu functions.
-!
-!    Input, real ( kind = 8 ) A, the characteristic value.
-!
-!    Input, integer ( kind = 4 ) MJ, ?
-!
-!    Output, real ( kind = 8 ) F, the value of the function for the
-!    characteristic equation.
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) b
-  real ( kind = 8 ) f
-  integer ( kind = 4 ) ic
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) j0
-  integer ( kind = 4 ) jf
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) l0
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) mj
-  real ( kind = 8 ) q
-  real ( kind = 8 ) t0
-  real ( kind = 8 ) t1
-  real ( kind = 8 ) t2
-
-  b = a
-  ic = int ( m / 2 )
-  l = 0
-  l0 = 0
-  j0 = 2
-  jf = ic
-
-  if ( kd == 1 ) then
-    l0 = 2
-    j0 = 3
-  else if ( kd == 2 .or. kd == 3 ) then
-    l = 1
-  else if ( kd == 4 ) then
-    jf = ic - 1
-  end if
-
-  t1 = 0.0D+00
-  do j = mj, ic + 1, -1
-    t1 = - q * q / ( ( 2.0D+00 * j + l ) ** 2 - b + t1 )
-  end do
-
-  if ( m <= 2 ) then
-
-    t2 = 0.0D+00
-
-    if ( kd == 1 ) then
-      if ( m == 0 ) then
-        t1 = t1 + t1
-      else if ( m == 2 ) then
-        t1 = - 2.0D+00 * q * q / ( 4.0D+00 - b + t1 ) - 4.0D+00
-      end if
-    else if ( kd == 2 ) then
-      if ( m == 1 ) then
-        t1 = t1 + q
-      end if
-    else if ( kd == 3 ) then
-      if ( m == 1 ) then
-        t1 = t1 - q
-      end if
-    end if
-
-  else
-
-    if ( kd == 1 ) then
-      t0 = 4.0D+00 - b + 2.0D+00 * q * q / b
-    else if ( kd == 2 ) then
-      t0 = 1.0D+00 - b + q
-    else if ( kd == 3 ) then
-      t0 = 1.0D+00 - b - q
-    else if ( kd == 4 ) then
-      t0 = 4.0D+00 - b
-    end if
-
-    t2 = - q * q / t0
-    do j = j0, jf
-      t2 = - q * q / ( ( 2.0D+00 * j - l - l0 ) ** 2 - b + t2 )
-    end do
-
-  end if
-
-  f = ( 2.0D+00 * ic + l ) ** 2 + t1 + t2 - b
-
-  return
-end
-subroutine cvql ( kd, m, q, a0 )
-
-!*****************************************************************************80
-!
-!! CVQL computes the characteristic value of Mathieu functions for q <= 3*m.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    10 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) KD, the case code:
-!    1, for cem(x,q)  ( m = 0,2,4,...)
-!    2, for cem(x,q)  ( m = 1,3,5,...)
-!    3, for sem(x,q)  ( m = 1,3,5,...)
-!    4, for sem(x,q)  ( m = 2,4,6,...)
-!
-!    Input, integer ( kind = 4 ) M, the order of the Mathieu functions.
-!
-!    Input, real ( kind = 8 ) Q, the parameter value.
-!
-!    Output, real ( kind = 8 ) A0, the initial characteristic value.
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) c1
-  real ( kind = 8 ) cv1
-  real ( kind = 8 ) cv2
-  real ( kind = 8 ) d1
-  real ( kind = 8 ) d2
-  real ( kind = 8 ) d3
-  real ( kind = 8 ) d4
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) p1
-  real ( kind = 8 ) p2
-  real ( kind = 8 ) q
-  real ( kind = 8 ) w
-  real ( kind = 8 ) w2
-  real ( kind = 8 ) w3
-  real ( kind = 8 ) w4
-  real ( kind = 8 ) w6
-
-  if ( kd == 1 .or. kd == 2 ) then
-    w = 2.0D+00 * m + 1.0D+00
-  else
-    w = 2.0D+00 * m - 1.0D+00
-  end if
-
-  w2 = w * w
-  w3 = w * w2
-  w4 = w2 * w2
-  w6 = w2 * w4
-  d1 = 5.0D+00 + 34.0D+00 / w2 + 9.0D+00 / w4
-  d2 = ( 33.0D+00 + 410.0D+00 / w2 + 405.0D+00 / w4 ) / w
-  d3 = ( 63.0D+00 + 1260.0D+00 / w2 + 2943.0D+00 / w4 + 486.0D+00 / w6 ) / w2
-  d4 = ( 527.0D+00 + 15617.0D+00 / w2 + 69001.0D+00 / w4 &
-    + 41607.0D+00 / w6 ) / w3
-  c1 = 128.0D+00
-  p2 = q / w4
-  p1 = sqrt ( p2 )
-  cv1 = - 2.0D+00 * q + 2.0D+00 * w * sqrt ( q ) &
-    - ( w2 + 1.0D+00 ) / 8.0D+00
-  cv2 = ( w + 3.0D+00 / w ) + d1 / ( 32.0D+00 * p1 ) + d2 &
-    / ( 8.0D+00 * c1 * p2 )
-  cv2 = cv2 + d3 / ( 64.0D+00 * c1 * p1 * p2 ) + d4 &
-    / ( 16.0D+00 * c1 * c1 * p2 * p2 )
-  a0 = cv1 - cv2 / ( c1 * p1 )
-
-  return
-end
-subroutine cvqm ( m, q, a0 )
-
-!*****************************************************************************80
-!
-!! CVQM computes the characteristic value of Mathieu functions for q <= m*m.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    07 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the order of the Mathieu functions.
-!
-!    Input, real ( kind = 8 ) Q, the parameter value.
-!
-!    Output, real ( kind = 8 ) A0, the initial characteristic value.
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) hm1
-  real ( kind = 8 ) hm3
-  real ( kind = 8 ) hm5
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) q
-
-  hm1 = 0.5D+00 * q / ( m * m - 1.0D+00 )
-  hm3 = 0.25D+00 * hm1 ** 3 / ( m * m - 4.0D+00 )
-  hm5 = hm1 * hm3 * q / ( ( m * m - 1.0D+00 ) * ( m * m - 9.0D+00 ) )
-  a0 = m * m + q * ( hm1 + ( 5.0D+00 * m * m + 7.0D+00 ) * hm3 &
-    + ( 9.0D+00 * m ** 4 + 58.0D+00 * m * m + 29.0D+00 ) * hm5 )
-
-  return
-end
-subroutine cy01 ( kf, z, zf, zd )
-
-!*****************************************************************************80
-!
-!! CY01 computes complex Bessel functions Y0(z) and Y1(z) and derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    01 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer KF, the function choice.
-!    0 for ZF = Y0(z) and ZD = Y0'(z);
-!    1 for ZF = Y1(z) and ZD = Y1'(z);
-!    2 for ZF = Y1'(z) and ZD = Y1''(z).
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, complex ( kind = 8 ) ZF, ZD, the values of the requested function 
-!    and derivative.
-!
-  implicit none
-
-  real ( kind = 8 ), save, dimension(12) :: a = (/ &
-    -0.703125D-01, 0.112152099609375D+00, &
-    -0.5725014209747314D+00, 0.6074042001273483D+01, &
-    -0.1100171402692467D+03, 0.3038090510922384D+04, &
-    -0.1188384262567832D+06, 0.6252951493434797D+07, &
-    -0.4259392165047669D+09, 0.3646840080706556D+11, &
-    -0.3833534661393944D+13, 0.4854014686852901D+15 /)
-  real ( kind = 8 ) a0
-  real ( kind = 8 ), save, dimension(12) :: a1 = (/ &
-    0.1171875D+00, -0.144195556640625D+00, &
-    0.6765925884246826D+00, -0.6883914268109947D+01, &
-    0.1215978918765359D+03, -0.3302272294480852D+04, &
-    0.1276412726461746D+06, -0.6656367718817688D+07, &
-    0.4502786003050393D+09, -0.3833857520742790D+11, &
-    0.4011838599133198D+13, -0.5060568503314727D+15 /)
-  real ( kind = 8 ), save, dimension(12) :: b = (/ &
-    0.732421875D-01, -0.2271080017089844D+00, &
-    0.1727727502584457D+01, -0.2438052969955606D+02, &
-    0.5513358961220206D+03, -0.1825775547429318D+05, &
-    0.8328593040162893D+06, -0.5006958953198893D+08, &
-    0.3836255180230433D+10, -0.3649010818849833D+12, &
-    0.4218971570284096D+14, -0.5827244631566907D+16 /)
-  real ( kind = 8 ), save, dimension(12) :: b1 = (/ &
-    -0.1025390625D+00, 0.2775764465332031D+00, &
-    -0.1993531733751297D+01, 0.2724882731126854D+02, &
-    -0.6038440767050702D+03, 0.1971837591223663D+05, &
-    -0.8902978767070678D+06, 0.5310411010968522D+08, &
-    -0.4043620325107754D+10, 0.3827011346598605D+12, &
-    -0.4406481417852278D+14, 0.6065091351222699D+16 /)
-  complex ( kind = 8 ) cbj0
-  complex ( kind = 8 ) cbj1
-  complex ( kind = 8 ) cby0
-  complex ( kind = 8 ) cby1
-  complex ( kind = 8 ) cdy0
-  complex ( kind = 8 ) cdy1
-  complex ( kind = 8 ) ci
-  complex ( kind = 8 ) cp
-  complex ( kind = 8 ) cp0
-  complex ( kind = 8 ) cp1
-  complex ( kind = 8 ) cq0
-  complex ( kind = 8 ) cq1
-  complex ( kind = 8 ) cr
-  complex ( kind = 8 ) cs
-  complex ( kind = 8 ) ct1
-  complex ( kind = 8 ) ct2
-  complex ( kind = 8 ) cu
-  real ( kind = 8 ) el
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k0
-  integer ( kind = 4 ) kf
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) rp2
-  real ( kind = 8 ) w0
-  real ( kind = 8 ) w1
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) z1
-  complex ( kind = 8 ) z2
-  complex ( kind = 8 ) zd
-  complex ( kind = 8 ) zf
-
-  pi = 3.141592653589793D+00
-  el = 0.5772156649015329D+00
-  rp2 = 2.0D+00 / pi
-  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
-  a0 = abs ( z )
-  z2 = z * z
-  z1 = z
-
-  if ( a0 == 0.0D+00 ) then
-
-    cbj0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cbj1 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-    cby0 = cmplx ( -1.0D+30, 0.0D+00, kind = 8 )
-    cby1 = cmplx ( -1.0D+30, 0.0D+00, kind = 8 )
-    cdy0 = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-    cdy1 = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
-
-  else
-
-    if ( real ( z, kind = 8 ) < 0.0D+00) then
-      z1 = -z
-    end if
-
-    if ( a0 <= 12.0D+00 ) then
-
-      cbj0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, 40
-        cr = - 0.25D+00 * cr * z2 / ( k * k )
-        cbj0 = cbj0 + cr
-        if ( abs ( cr ) < abs ( cbj0 ) * 1.0D-15 ) then
-          exit
-        end if
-      end do
-
-      cbj1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, 40
-        cr = -0.25D+00 * cr * z2 / ( k * ( k + 1.0D+00 ) )
-        cbj1 = cbj1 + cr
-        if ( abs ( cr ) < abs ( cbj1 ) * 1.0D-15 ) then
-          exit
-        end if
-      end do
-
-      cbj1 = 0.5D+00 * z1 * cbj1
-      w0 = 0.0D+00
-      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      cs = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, 40
-        w0 = w0 + 1.0D+00 / k
-        cr = -0.25D+00 * cr / ( k * k ) * z2
-        cp = cr * w0
-        cs = cs + cp
-        if ( abs ( cp ) < abs ( cs ) * 1.0D-15 ) then
-          exit
-        end if
-      end do
-
-      cby0 = rp2 * ( log ( z1 / 2.0D+00 ) + el ) * cbj0 - rp2 * cs
-      w1 = 0.0D+00
-      cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      cs = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, 40
-        w1 = w1 + 1.0D+00 / k
-        cr = - 0.25D+00 * cr / ( k * ( k + 1 ) ) * z2
-        cp = cr * ( 2.0D+00 * w1 + 1.0D+00 / ( k + 1.0D+00 ) )
-        cs = cs + cp
-        if ( abs ( cp ) < abs ( cs ) * 1.0D-15 ) then
-          exit
-        end if
-      end do
-
-      cby1 = rp2 * ( ( log ( z1 / 2.0D+00 ) + el ) * cbj1 &
-        - 1.0D+00 / z1 - 0.25D+00 * z1 * cs )
-
-    else
-
-      if ( a0 < 35.0D+00 ) then
-        k0 = 12
-      else if ( a0 < 50.0D+00 ) then
-        k0 = 10
-      else
-        k0 = 8
-      end if
-
-      ct1 = z1 - 0.25D+00 * pi
-      cp0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, k0
-        cp0 = cp0 + a(k) * z1 ** ( - 2 * k )
-      end do
-      cq0 = -0.125D+00 / z1
-      do k = 1, k0
-        cq0 = cq0 + b(k) * z1 ** ( - 2 * k - 1 )
-      end do
-      cu = sqrt ( rp2 / z1 )
-      cbj0 = cu * ( cp0 * cos ( ct1 ) - cq0 * sin ( ct1 ) )
-      cby0 = cu * ( cp0 * sin ( ct1 ) + cq0 * cos ( ct1 ) )
-      ct2 = z1 - 0.75D+00 * pi
-      cp1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, k0
-        cp1 = cp1 + a1(k) * z1 ** ( - 2 * k )
-      end do
-      cq1 = 0.375D+00 / z1
-      do k = 1, k0
-        cq1 = cq1 + b1(k) * z1 ** ( - 2 * k - 1 )
-      end do
-      cbj1 = cu * ( cp1 * cos ( ct2 ) - cq1 * sin ( ct2 ) )
-      cby1 = cu * ( cp1 * sin ( ct2 ) + cq1 * cos ( ct2 ) )
- 
-    end if
-
-    if ( real ( z, kind = 8 ) < 0.0D+00 ) then
-
-      if ( imag ( z ) < 0.0D+00 ) then
-        cby0 = cby0 - 2.0D+00 * ci * cbj0
-      else
-        cby0 = cby0 + 2.0D+00 * ci * cbj0
-      end if
-
-      if ( imag ( z ) < 0.0D+00 ) then
-        cby1 = - ( cby1 - 2.0D+00 * ci * cbj1 )
-      else
-        cby1 = - ( cby1 + 2.0D+00 * ci * cbj1 )
-      end if
-      cbj1 = - cbj1
- 
-    end if
-
-    cdy0 = - cby1
-    cdy1 = cby0 - 1.0D+00 / z * cby1
-
-  end if
-
-  if ( kf == 0 ) then
-    zf = cby0
-    zd = cdy0
-  else if ( kf == 1 ) then
-    zf = cby1
-    zd = cdy1
-  else if ( kf == 2 ) then
-    zf = cdy1
-    zd = - cdy1 / z - ( 1.0D+00 - 1.0D+00 / ( z * z ) ) * cby1
-  end if
-
-  return
-end
-subroutine cyzo ( nt, kf, kc, zo, zv )
-
-!*****************************************************************************80
-!
-!! CYZO computes zeros of complex Bessel functions Y0(z) and Y1(z) and Y1'(z).
-!
-!  Parameters:
-!
-!    Ths procedure computes the complex zeros of Y0(z), Y1(z) and Y1'(z), 
-!    and their associated values at the zeros using the modified Newton's 
-!    iteration method.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    22 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) NT, the number of zeros.
-!
-!    Input, integer ( kind = 4 ) KF, the function choice.
-!    0 for Y0(z) and Y1(z0);
-!    1 for Y1(z) and Y0(z1);
-!    2 for Y1'(z) and Y1(z1').
-!
-!    Input, integer ( kind = 4 ) KC, complex/real choice.
-!    0, for complex roots;
-!    1, for real roots.
-!
-!    Output, real ( kind = 8 ) ZO(NT), ZV(NT), the zeros of Y0(z) or Y1(z) 
-!    or Y1'(z), and the value of Y0'(z) or Y1'(z) or Y1(z) at the L-th zero.
-!
-  implicit none
-
-  integer ( kind = 4 ) nt
-
-  real ( kind = 8 ) h
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) it
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) kc
-  integer ( kind = 4 ) kf
-  integer ( kind = 4 ) nr
-  real ( kind = 8 ) w
-  real ( kind = 8 ) w0
-  real ( kind = 8 ) x
-  real ( kind = 8 ) y
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) zd
-  complex ( kind = 8 ) zero
-  complex ( kind = 8 ) zf
-  complex ( kind = 8 ) zfd
-  complex ( kind = 8 ) zgd
-  complex ( kind = 8 ) zo(nt)
-  complex ( kind = 8 ) zp
-  complex ( kind = 8 ) zq
-  complex ( kind = 8 ) zv(nt)
-  complex ( kind = 8 ) zw
-
-  if ( kc == 0 ) then
-    x = -2.4D+00
-    y = 0.54D+00
-    h = 3.14D+00
-  else if ( kc == 1 ) then
-    x = 0.89D+00
-    y = 0.0D+00
-    h = -3.14D+00
-  end if
-
-  if ( kf == 1 ) then
-    x = -0.503D+00
-  else if ( kf == 2 ) then
-    x = 0.577D+00
-  end if
-
-  zero = cmplx ( x, y, kind = 8 )
-
-  do nr = 1, nt
-
-    if ( nr == 1 ) then
-      z = zero
-    else
-      z = zo(nr-1) - h
-    end if
-
-    it = 0
-
-    do
-
-      it = it + 1
-      call cy01 ( kf, z, zf, zd )
-
-      zp = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do i = 1, nr - 1
-        zp = zp * ( z - zo(i) )
-      end do
-
-      zfd = zf / zp
-
-      zq = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      do i = 1, nr - 1
-        zw = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-        do j = 1, nr - 1
-          if ( j /= i ) then
-            zw = zw * ( z - zo(j) )
-          end if
-        end do
-        zq = zq + zw
-      end do
-
-      zgd = ( zd - zq * zfd ) / zp
-      z = z - zfd / zgd
-      w0 = w
-      w = abs ( z )
-
-      if ( 50 < it .or. abs ( ( w - w0 ) / w ) <= 1.0D-12 ) then
-        exit
-      end if
-
-    end do
-
-    zo(nr) = z
-
-  end do
-
-  do i = 1, nt
-    z = zo(i)
-    if ( kf == 0 .or. kf == 2 ) then
-      call cy01 ( 1, z, zf, zd )
-      zv(i) = zf
-    else if ( kf == 1 ) then
-      call cy01 ( 0, z, zf, zd )
-      zv(i) = zf
-    end if
-  end do
-
-  return
-end
-subroutine dvla ( va, x, pd )
-
-!*****************************************************************************80
-!
-!! DVLA computes parabolic cylinder functions Dv(x) for large argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    06 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-! 
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Input, real ( kind = 8 ) VA, the order.
-!
-!    Output, real ( kind = 8 ) PD, the function value.
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) ep
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) gl
-  integer ( kind = 4 ) k
-  real ( kind = 8 ) pd
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r
-  real ( kind = 8 ) va
-  real ( kind = 8 ) vl
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x1
-
-  pi = 3.141592653589793D+00
-  eps = 1.0D-12
-  ep = exp ( -0.25D+00 * x * x )
-  a0 = abs ( x ) ** va * ep
-  r = 1.0D+00
-  pd = 1.0D+00
-  do k = 1, 16
-    r = -0.5D+00 * r * ( 2.0D+00 * k - va - 1.0D+00 ) &
-      * ( 2.0D+00 * k - va - 2.0D+00 ) / ( k * x * x )
-    pd = pd + r
-    if ( abs ( r / pd ) < eps ) then
-      exit
-    end if
-  end do
-
-  pd = a0 * pd
-
-  if ( x < 0.0D+00 ) then
-    x1 = - x
-    call vvla ( va, x1, vl )
-    call gamma ( -va, gl )
-    pd = pi * vl / gl + cos ( pi * va ) * pd
-  end if
-
-  return
-end
-subroutine dvsa ( va, x, pd )
-
-!*****************************************************************************80
-!
-!! DVSA computes parabolic cylinder functions Dv(x) for small argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    07 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) VA, the order.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) PD, the function value.
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) ep
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) g0
-  real ( kind = 8 ) g1
-  real ( kind = 8 ) ga0
-  real ( kind = 8 ) gm
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) pd
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) sq2
-  real ( kind = 8 ) va
-  real ( kind = 8 ) va0
-  real ( kind = 8 ) vm
-  real ( kind = 8 ) vt
-  real ( kind = 8 ) x
-
-  eps = 1.0D-15
-  pi = 3.141592653589793D+00
-  sq2 = sqrt ( 2.0D+00 )
-  ep = exp ( -0.25D+00 * x * x )
-  va0 = 0.5D+00 * ( 1.0D+00 - va )
-
-  if ( va == 0.0D+00 ) then
-
-    pd = ep
-
-  else
-
-    if ( x == 0.0D+00 ) then
-      if ( va0 <= 0.0D+00 .and. va0 == int ( va0 ) ) then
-        pd = 0.0D+00
-      else
-        call gamma ( va0, ga0 )
-        pd = sqrt ( pi ) / ( 2.0D+00 ** ( -0.5D+00 * va ) * ga0 )
-      end if
-
-    else
-
-      call gamma ( -va, g1 )
-      a0 = 2.0D+00 ** ( -0.5D+00 * va - 1.0D+00 ) * ep / g1
-      vt = -0.5D+00 * va
-      call gamma ( vt, g0 )
-      pd = g0
-      r = 1.0D+00
-      do m = 1, 250
-        vm = 0.5D+00 * ( m - va )
-        call gamma ( vm, gm )
-        r = -r * sq2 * x / m
-        r1 = gm * r
-        pd = pd + r1
-        if ( abs ( r1 ) < abs ( pd ) * eps ) then
-          exit
-        end if
-      end do
-
-      pd = a0 * pd
-
-    end if
-
-  end if
-
-  return
-end
-subroutine e1xa ( x, e1 )
-
-!*****************************************************************************80
-!
-!! E1XA computes the exponential integral E1(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    06 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) E1, the function value.
-!
-  implicit none
-
-  real ( kind = 8 ) e1
-  real ( kind = 8 ) es1
-  real ( kind = 8 ) es2
-  real ( kind = 8 ) x
-
-  if ( x == 0.0D+00 ) then
-
-    e1 = 1.0D+300
-
-  else if ( x <= 1.0D+00 ) then
-
-    e1 = - log ( x ) + (((( &
-        1.07857D-03 * x &
-      - 9.76004D-03 ) * x &
-      + 5.519968D-02 ) * x &
-      - 0.24991055D+00 ) * x &
-      + 0.99999193D+00 ) * x &
-      - 0.57721566D+00
-
-  else
-
-    es1 = ((( x &
-      + 8.5733287401D+00 ) * x &
-      +18.059016973D+00  ) * x &
-      + 8.6347608925D+00 ) * x &
-      + 0.2677737343D+00
-
-    es2 = ((( x &
-      +  9.5733223454D+00 ) * x &
-      + 25.6329561486D+00 ) * x &
-      + 21.0996530827D+00 ) * x &
-      +  3.9584969228D+00
-
-    e1 = exp ( - x ) / x * es1 / es2
-
-  end if
-
-  return
-end
-subroutine e1xb ( x, e1 )
-
-!*****************************************************************************80
-!
-!! E1XB computes the exponential integral E1(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    06 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) E1, the function value.
-!
-  implicit none
-
-  real ( kind = 8 ) e1
-  real ( kind = 8 ) ga
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) r
-  real ( kind = 8 ) t
-  real ( kind = 8 ) t0
-  real ( kind = 8 ) x
-
-  if ( x == 0.0D+00 ) then
-
-    e1 = 1.0D+300
-
-  else if ( x <= 1.0D+00 ) then
-
-    e1 = 1.0D+00
-    r = 1.0D+00
-
-    do k = 1, 25
-      r = -r * k * x / ( k + 1.0D+00 )**2
-      e1 = e1 + r
-      if ( abs ( r ) <= abs ( e1 ) * 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    ga = 0.5772156649015328D+00
-    e1 = - ga - log ( x ) + x * e1
-
-  else
-
-    m = 20 + int ( 80.0D+00 / x )
-    t0 = 0.0D+00
-    do k = m, 1, -1
-      t0 = k / ( 1.0D+00 + k / ( x + t0 ) )
-    end do
-    t = 1.0D+00 / ( x + t0 )
-    e1 = exp ( -x ) * t
-
-  end if
-
-  return
-end
-subroutine e1z ( z, ce1 )
-
-!*****************************************************************************80
-!
-!! E1Z computes the complex exponential integral E1(z).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    16 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-! 
-!  Parameters:
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, complex ( kind = 8 ) CE1, the function value.
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  complex ( kind = 8 ) ce1
-  complex ( kind = 8 ) cr
-  complex ( kind = 8 ) ct
-  complex ( kind = 8 ) ct0
-  real ( kind = 8 ) el
-  integer ( kind = 4 ) k
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) x
-  complex ( kind = 8 ) z
-
-  pi = 3.141592653589793D+00
-  el = 0.5772156649015328D+00
-  x = real ( z, kind = 8 )
-  a0 = abs ( z )
-
-  if ( a0 == 0.0D+00 ) then
-    ce1 = cmplx ( 1.0D+300, 0.0D+00, kind = 8 )
-  else if ( a0 <= 10.0D+00 .or. &
-    ( x < 0.0D+00 .and. a0 < 20.0D+00 ) ) then
-    ce1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, 150
-      cr = - cr * k * z / ( k + 1.0D+00 )**2
-      ce1 = ce1 + cr
-      if ( abs ( cr ) <= abs ( ce1 ) * 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    ce1 = - el - log ( z ) + z * ce1
-
-  else
-
-    ct0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-    do k = 120, 1, -1
-      ct0 = k / ( 1.0D+00 + k / ( z + ct0 ) )
-    end do
-    ct = 1.0D+00 / ( z + ct0 )
-
-    ce1 = exp ( - z ) * ct
-    if ( x <= 0.0D+00 .and. imag ( z ) == 0.0D+00 ) then
-      ce1 = ce1 - pi * cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
-    end if
-
-  end if
-
-  return
-end
-subroutine eix ( x, ei )
-
-!*****************************************************************************80
-!
-!! EIX computes the exponential integral Ei(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    10 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) EI, the function value.
-!
-  implicit none
-
-  real ( kind = 8 ) ei
-  real ( kind = 8 ) ga
-  integer ( kind = 4 ) k
-  real ( kind = 8 ) r
-  real ( kind = 8 ) x
-
-  if ( x == 0.0D+00 ) then
-
-    ei = -1.0D+300
-
-  else if ( x <= 40.0D+00 ) then
-
-    ei = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 100
-      r = r * k * x / ( k + 1.0D+00 )**2
-      ei = ei + r
-      if ( abs ( r / ei ) <= 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    ga = 0.5772156649015328D+00
-    ei = ga + log ( x ) + x * ei
-
-  else
-
-    ei = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 20
-      r = r * k / x
-      ei = ei + r
-    end do
-    ei = exp ( x ) / x * ei
-
-  end if
-
-  return
-end
-subroutine elit ( hk, phi, fe, ee )
-
-!*****************************************************************************80
-!
-!! ELIT: complete and incomplete elliptic integrals F(k,phi) and E(k,phi).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    12 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) HK, the modulus, between 0 and 1.
-!
-!    Input, real ( kind = 8 ) PHI, the argument in degrees.
-!
-!    Output, real ( kind = 8 ) FE, EE, the values of F(k,phi) and E(k,phi).
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) b
-  real ( kind = 8 ) b0
-  real ( kind = 8 ) c
-  real ( kind = 8 ) ce
-  real ( kind = 8 ) ck
-  real ( kind = 8 ) d
-  real ( kind = 8 ) d0
-  real ( kind = 8 ) ee
-  real ( kind = 8 ) fac
-  real ( kind = 8 ) fe
-  real ( kind = 8 ) g
-  real ( kind = 8 ) hk
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) phi
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r
-
-  g = 0.0D+00
-  pi = 3.14159265358979D+00
-  a0 = 1.0D+00
-  b0 = sqrt ( 1.0D+00 - hk * hk )
-  d0 = ( pi / 180.0D+00 ) * phi
-  r = hk * hk
-
-  if ( hk == 1.0D+00 .and. phi == 90.0D+00 ) then
-
-    fe = 1.0D+300
-    ee = 1.0D+00
-
-  else if ( hk == 1.0D+00 ) then
-
-    fe = log ( ( 1.0D+00 + sin ( d0 ) ) / cos ( d0 ) )
-    ee = sin ( d0 )
-
-  else
-
-    fac = 1.0D+00
-    do n = 1, 40
-      a = ( a0 + b0 ) /2.0D+00
-      b = sqrt ( a0 * b0 )
-      c = ( a0 - b0 ) / 2.0D+00
-      fac = 2.0D+00 * fac
-      r = r + fac * c * c
-      if ( phi /= 90.0D+00 ) then
-        d = d0 + atan ( ( b0 / a0 ) * tan ( d0 ) )
-        g = g + c * sin( d )
-        d0 = d + pi * int ( d / pi + 0.5D+00 )
-      end if
-      a0 = a
-      b0 = b
-      if ( c < 1.0D-07 ) then
-        exit
-      end if
-    end do
-
-    ck = pi / ( 2.0D+00 * a )
-    ce = pi * ( 2.0D+00 - r ) / ( 4.0D+00 * a )
-    if ( phi == 90.0D+00 ) then
-      fe = ck
-      ee = ce
-    else
-      fe = d / ( fac * a )
-      ee = fe * ce / ck + g
-    end if
-
-  end if
-
-  return
-end
-subroutine elit3 ( phi, hk, c, el3 )
-
-!*****************************************************************************80
-!
-!! ELIT3 computes the elliptic integral of the third kind.
-!
-!  Discussion:
-!
-!    Gauss-Legendre quadrature is used.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    14 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) PHI, the argument in degrees.
-!
-!    Input, real ( kind = 8 ) HK, the modulus, between 0 and 1.
-!
-!    Input, real ( kind = 8 ) C, the parameter, between 0 and 1.
-!
-!    Output, real ( kind = 8 ) EL3, the value of the elliptic integral
-!    of the third kind.
-!
-  implicit none
-
-  real ( kind = 8 ) c
-  real ( kind = 8 ) c0
-  real ( kind = 8 ) c1
-  real ( kind = 8 ) c2
-  real ( kind = 8 ) el3
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) f2
-  real ( kind = 8 ) hk
-  integer ( kind = 4 ) i 
-  logical lb1
-  logical lb2
-  real ( kind = 8 ) phi
-  real ( kind = 8 ), dimension ( 10 ), save :: t = (/ &
-    0.9931285991850949D+00, 0.9639719272779138D+00, &
-    0.9122344282513259D+00, 0.8391169718222188D+00, &
-    0.7463319064601508D+00, 0.6360536807265150D+00, &
-    0.5108670019508271D+00, 0.3737060887154195D+00, &
-    0.2277858511416451D+00, 0.7652652113349734D-01 /)
-  real ( kind = 8 ) t1
-  real ( kind = 8 ) t2
-  real ( kind = 8 ), dimension ( 10 ), save :: w = (/ &
-    0.1761400713915212D-01, 0.4060142980038694D-01, &
-    0.6267204833410907D-01, 0.8327674157670475D-01, &
-    0.1019301198172404D+00, 0.1181945319615184D+00, &
-    0.1316886384491766D+00, 0.1420961093183820D+00, &
-    0.1491729864726037D+00, 0.1527533871307258D+00 /)
-
-  lb1 = ( hk == 1.0D+00 ) .and. ( abs ( phi - 90.0D+00 ) <= 1.0D-08 )
-
-  lb2 = c == 1.0D+00 .and. abs ( phi - 90.0D+00 ) <= 1.0D-08
-
-  if ( lb1 .or. lb2 ) then
-    el3 = 1.0D+300
-    return
-  end if
-
-  c1 = 0.87266462599716D-02 * phi
-  c2 = c1
-
-  el3 = 0.0D+00
-  do i = 1, 10
-    c0 = c2 * t(i)
-    t1 = c1 + c0
-    t2 = c1 - c0
-    f1 = 1.0D+00 / ( ( 1.0D+00 - c * sin(t1) * sin(t1) ) &
-      * sqrt ( 1.0D+00 - hk * hk * sin ( t1 ) * sin ( t1 ) ) )
-    f2 = 1.0D+00 / ( ( 1.0D+00 - c * sin ( t2 ) * sin ( t2 ) ) &
-      * sqrt( 1.0D+00 - hk * hk * sin ( t2 ) * sin ( t2 ) ) )
-    el3 = el3 + w(i) * ( f1 + f2 )
-  end do
-
-  el3 = c1 * el3
-
-  return
-end
-function envj ( n, x )
-
-!*****************************************************************************80
-!
-!! ENVJ is a utility function used by MSTA1 and MSTA2.
-!
-!  Discussion:
-!
-!    ENVJ estimates -log(Jn(x)) from the estimate
-!    Jn(x) approx 1/sqrt(2*pi*n) * ( e*x/(2*n))^n
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    14 January 2016
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!    Modifications suggested by Vincent Lafage, 11 January 2016.
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order of the Bessel function.
-!
-!    Input, real ( kind = 8 ) X, the absolute value of the argument.
-!
-!    Output, real ( kind = 8 ) ENVJ, the value.
-!
-  implicit none
-
-  real ( kind = 8 ) envj
-  real ( kind = 8 ) logten
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) n_r8
-  real ( kind = 8 ) r8_gamma_log
-  real ( kind = 8 ) x
-!
-!  Original code
-!
-  if ( .true. ) then
-
-    envj = 0.5D+00 * log10 ( 6.28D+00 * n ) &
-      - n * log10 ( 1.36D+00 * x / n )
-!
-!  Modification suggested by Vincent Lafage.
-!
-  else
-
-    n_r8 = real ( n, kind = 8 )
-    logten = log ( 10.0D+00 )
-    envj = r8_gamma_log ( n_r8 + 1.0D+00 ) / logten - n_r8 * log10 ( x )
-
-  end if
-
-  return
-end
-subroutine enxa ( n, x, en )
-
-!*****************************************************************************80
-!
-!! ENXA computes the exponential integral En(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    07 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) EN(0:N), the function values.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) e1
-  real ( kind = 8 ) ek
-  real ( kind = 8 ) en(0:n)
-  integer ( kind = 4 ) k
-  real ( kind = 8 ) x
-
-  en(0) = exp ( - x ) / x 
-  call e1xb ( x, e1 )
-
-  en(1) = e1
-  do k = 2, n
-    ek = ( exp ( - x ) - x * e1 ) / ( k - 1.0D+00 )
-    en(k) = ek
-    e1 = ek
-  end do
-
-  return
-end
-subroutine enxb ( n, x, en )
-
-!*****************************************************************************80
-!
-!! ENXB computes the exponential integral En(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    10 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) EN(0:N), the function values.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) en(0:n)
-  real ( kind = 8 ) ens
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) ps
-  real ( kind = 8 ) r
-  real ( kind = 8 ) rp
-  real ( kind = 8 ) s
-  real ( kind = 8 ) s0
-  real ( kind = 8 ) t
-  real ( kind = 8 ) t0
-  real ( kind = 8 ) x
-
-  if ( x == 0.0D+00 ) then
-
-    en(0) = 1.0D+300
-    en(1) = 1.0D+300
-    do k = 2, n
-      en(k) = 1.0D+00 / ( k - 1.0D+00 )
-    end do
-    return
-
-  else if ( x <= 1.0D+00 ) then
-
-    en(0) = exp ( - x ) / x
-    do l = 1, n
-      rp = 1.0D+00
-      do j = 1, l - 1
-        rp = - rp * x / j
-      end do
-      ps = -0.5772156649015328D+00
-      do m = 1, l - 1
-        ps = ps + 1.0D+00 / m
-      end do
-      ens = rp * ( - log ( x ) + ps )
-      s = 0.0D+00
-      do m = 0, 20
-        if ( m /= l - 1 ) then
-          r = 1.0D+00
-          do j = 1, m
-            r = - r * x / j
-          end do
-          s = s + r / ( m - l + 1.0D+00 )
-          if ( abs ( s - s0 ) < abs ( s ) * 1.0D-15 ) then
-            exit
-          end if
-          s0 = s
-        end if
-      end do
-
-      en(l) = ens - s
-
-    end do
-
-  else
-
-    en(0) = exp ( - x ) / x
-    m = 15 + int ( 100.0D+00 / x )
-    do l = 1, n
-      t0 = 0.0D+00
-      do k = m, 1, -1
-        t0 = ( l + k - 1.0D+00 ) / ( 1.0D+00 + k / ( x + t0 ) )
-      end do
-      t = 1.0D+00 / ( x + t0 )
-      en(l) = exp ( - x ) * t
-    end do
-
-  end if
-
-  return
-end
-subroutine error ( x, err )
-
-!*****************************************************************************80
-!
-!! ERROR evaluates the error function.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    07 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) ERR, the function value.
-!
-  implicit none
-
-  real ( kind = 8 ) c0
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) er
-  real ( kind = 8 ) err
-  integer ( kind = 4 ) k
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x2
-
-  eps = 1.0D-15
-  pi = 3.141592653589793D+00
-  x2 = x * x
-
-  if ( abs ( x ) < 3.5D+00 ) then
-
-    er = 1.0D+00
-    r = 1.0D+00
-
-    do k = 1, 50
-      r = r * x2 / ( k + 0.5D+00 )
-      er = er + r
-      if ( abs ( r ) <= abs ( er ) * eps ) then
-        exit
-      end if
-    end do
-
-    c0 = 2.0D+00 / sqrt ( pi ) * x * exp ( - x2 )
-    err = c0 * er
-
-  else
-
-    er = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 12
-      r = - r * ( k - 0.5D+00 ) / x2
-      er = er + r
-    end do
-
-    c0 = exp ( - x2 ) / ( abs ( x ) * sqrt ( pi ) )
-
-    err = 1.0D+00 - c0 * er
-    if ( x < 0.0D+00 ) then
-      err = -err
-    end if
-
-  end if
-
-  return
-end
-subroutine eulera ( n, en )
-
-!*****************************************************************************80
-!
-!! EULERA computes the Euler number En.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    10 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the index of the highest value to compute.
-!
-!    Output, real ( kind = 8 ) EN(0:N), the Euler numbers up to the N-th value.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) en(0:n)
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) r
-  real ( kind = 8 ) s
-
-  en(0) = 1.0D+00
-
-  do m = 1, n / 2
-    s = 1.0D+00
-    do k = 1, m - 1
-      r = 1.0D+00
-      do j = 1, 2 * k
-        r = r * ( 2.0D+00 * m - 2.0D+00 * k + j ) / j
-      end do
-      s = s + r * en(2*k)
-    end do
-    en(2*m) = -s
-  end do
-
-  return
-end
-subroutine eulerb ( n, en )
-
-!*****************************************************************************80
-!
-!! EULERB computes the Euler number En.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    09 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the index of the highest value to compute.
-!
-!    Output, real ( kind = 8 ) EN(0:N), the Euler numbers up to the N-th value.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) en(0:n)
-  real ( kind = 8 ) hpi
-  real ( kind = 8 ) isgn
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) r2
-  real ( kind = 8 ) s
-
-  hpi = 2.0D+00 / 3.141592653589793D+00
-  en(0) = 1.0D+00
-  en(2) = -1.0D+00
-  r1 = -4.0D+00 * hpi ** 3
-
-  do m = 4, n, 2
-    r1 = - r1 * ( m - 1 ) * m * hpi * hpi
-    r2 = 1.0D+00
-    isgn = 1.0D+00
-    do k = 3, 1000, 2
-      isgn = - isgn
-      s = ( 1.0D+00 / k ) ** ( m + 1 )
-      r2 = r2 + isgn * s
-      if ( s < 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    en(m) = r1 * r2
-
-    end do
-
-  return
-end
-subroutine fcoef ( kd, m, q, a, fc )
-
-!*****************************************************************************80
-!
-!! FCOEF: expansion coefficients for Mathieu and modified Mathieu functions.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    01 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) KD, the case code.
-!    1, for cem(x,q)  ( m = 0,2,4,...)
-!    2, for cem(x,q)  ( m = 1,3,5,...)
-!    3, for sem(x,q)  ( m = 1,3,5,...)
-!    4, for sem(x,q)  ( m = 2,4,6,...)
-!
-!    Input, integer ( kind = 4 ) M, the order of the Mathieu function.
-!
-!    Input, real ( kind = 8 ) Q, the parameter of the Mathieu functions.
-!
-!    Input, real ( kind = 8 ) A, the characteristic value of the Mathieu
-!    functions for given m and q.
-!
-!    Output, real ( kind = 8 ) FC(*), the expansion coefficients of Mathieu
-!    functions ( k =  1,2,...,KM ).  FC(1),FC(2),FC(3),... correspond to
-!    A0,A2,A4,... for KD = 1 case, 
-!    A1,A3,A5,... for KD = 2 case,
-!    B1,B3,B5,... for KD = 3 case,
-!    B2,B4,B6,... for KD = 4 case.
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) f2
-  real ( kind = 8 ) f3
-  real ( kind = 8 ) fc(251)
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) kb
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) km
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) q
-  real ( kind = 8 ) qm
-  real ( kind = 8 ) s
-  real ( kind = 8 ) s0
-  real ( kind = 8 ) sp
-  real ( kind = 8 ) ss
-  real ( kind = 8 ) u
-  real ( kind = 8 ) v
-
-  if ( q <= 1.0D+00 ) then
-    qm = 7.5D+00 + 56.1D+00 * sqrt ( q ) - 134.7D+00 * q &
-      + 90.7D+00 * sqrt ( q ) * q
-  else
-    qm = 17.0D+00 + 3.1D+00 * sqrt ( q ) - 0.126D+00 * q &
-      + 0.0037D+00 * sqrt ( q ) * q
-  end if
-
-  km = int ( qm + 0.5D+00 * m )
-
-  if ( q == 0.0D+00 ) then
-
-    do k = 1, km
-      fc(k) = 0.0D+00
-    end do
-
-    if ( kd == 1 ) then
-      fc((m+2)/2) = 1.0D+00
-      if (m == 0 ) then
-        fc(1) = 1.0D+00 / sqrt ( 2.0D+00 )
-      end if
-    else if ( kd == 4 ) then
-      fc(m/2) = 1.0D+00
-    else
-      fc((m+1)/2) = 1.0D+00
-    end if
-
-    return
-
-  end if
-
-  kb = 0
-  s = 0.0D+00
-  f = 1.0D-100
-  u = 0.0D+00
-  fc(km) = 0.0D+00
-
-  if ( kd == 1 ) then
-
-    l = 0
-
-    do k = km, 3, -1
-
-      v = u
-      u = f
-      f = ( a - 4.0D+00 * k * k ) * u / q - v
-
-      if ( abs ( f ) < abs ( fc(k+1) ) ) then
-
-        kb = k
-        fc(1) = 1.0D-100
-        sp = 0.0D+00
-        f3 = fc(k+1)
-        fc(2) = a / q * fc(1)
-        fc(3) = ( a - 4.0D+00 ) * fc(2) / q - 2.0D+00 * fc(1)
-        u = fc(2)
-        f1 = fc(3)
-
-        do i = 3, kb
-          v = u
-          u = f1
-          f1 = ( a - 4.0D+00 * ( i - 1.0D+00 ) ** 2 ) * u / q - v
-          fc(i+1) = f1
-          if ( i == kb ) then
-            f2 = f1
-          else
-            sp = sp + f1 * f1
-          end if
-        end do
-
-        sp = sp + 2.0D+00 * fc(1) ** 2 + fc(2) ** 2 + fc(3) ** 2
-        ss = s + sp * ( f3 / f2 ) ** 2
-        s0 = sqrt ( 1.0D+00 / ss )
-        do j = 1, km
-          if ( j <= kb + 1 ) then
-            fc(j) = s0 * fc(j) * f3 / f2
-          else
-            fc(j) = s0 * fc(j)
-          end if
-        end do
-        l = 1
-        exit
-      else
-        fc(k) = f
-        s = s + f * f
-      end if
-
-    end do
-
-    if ( l == 0 ) then
-      fc(2) = q * fc(3) / ( a - 4.0D+00 - 2.0D+00 * q * q / a )
-      fc(1) = q / a * fc(2)
-      s = s + 2.0D+00 * fc(1) ** 2 + fc(2) ** 2
-      s0 = sqrt ( 1.0D+00 / s )
-      do k = 1, km
-        fc(k) = s0 * fc(k)
-      end do
-    end if
-
-  else if ( kd == 2 .or. kd == 3 ) then
-
-    l = 0
-
-    do k = km, 3, -1
-
-      v = u
-      u = f
-      f = ( a - ( 2.0D+00 * k - 1 ) ** 2 ) * u / q - v
-
-      if ( abs ( fc(k) ) <= abs ( f ) ) then
-        fc(k-1) = f
-        s = s + f * f
-      else
-        kb = k
-        f3 = fc(k)
-        l = 1
-        exit
-      end if
-
-    end do
-
-    if ( l == 0 ) then
-
-      fc(1) = q / ( a - 1.0D+00 - ( - 1 ) ** kd * q ) * fc(2)
-      s = s + fc(1) * fc(1)
-      s0 = sqrt ( 1.0D+00 / s )
-      do k = 1, km
-        fc(k) = s0 * fc(k)
-      end do
-
-    else
-
-      fc(1) = 1.0D-100
-      fc(2) = ( a - 1.0D+00 - ( - 1 ) ** kd * q ) / q * fc(1)
-      sp = 0.0D+00
-      u = fc(1)
-      f1 = fc(2)
-      do i = 2, kb - 1
-        v = u
-        u = f1
-        f1 = ( a - ( 2.0D+00 * i - 1.0D+00 ) ** 2 ) * u / q - v
-        if ( i /= kb - 1 ) then
-          fc(i+1) = f1
-          sp = sp + f1 * f1
-        else
-          f2 = f1
-        end if
-      end do
-
-      sp = sp + fc(1) ** 2 + fc(2) ** 2
-      ss = s + sp * ( f3 / f2 ) ** 2
-      s0 = 1.0D+00 / sqrt ( ss )
-      do j = 1, km
-        if ( j < kb ) then
-          fc(j) = s0 * fc(j) * f3 / f2
-        else
-          fc(j) = s0 * fc(j)
-        end if
-      end do
-
-    end if
-
-  else if ( kd == 4 ) then
-
-    l = 0
-
-    do k = km, 3, -1
-      v = u
-      u = f
-      f = ( a - 4.0D+00 * k * k ) * u / q - v
-      if ( abs ( fc(k) ) <= abs ( f ) ) then
-        fc(k-1) = f
-        s = s + f * f
-      else
-        kb = k
-        f3 = fc(k)
-        l = 1
-        exit
-      end if
-    end do
-
-    if ( l == 0 ) then
-
-      fc(1) = q / ( a - 4.0D+00 ) * fc(2)
-      s = s + fc(1) * fc(1)
-      s0 = sqrt ( 1.0D+00 / s )
-      do k = 1, km
-        fc(k) = s0 * fc(k)
-      end do
-
-    else
-
-      fc(1) = 1.0D-100
-      fc(2) = ( a - 4.0D+00 ) / q * fc(1)
-      sp = 0.0D+00
-      u = fc(1)
-      f1 = fc(2)
-
-      do i = 2, kb - 1
-        v = u
-        u = f1
-        f1 = ( a - 4.0D+00 * i * i ) * u / q - v
-        if ( i /= kb - 1 ) then
-          fc(i+1) = f1
-          sp = sp + f1 * f1
-        else
-          f2 = f1
-        end if
-      end do
-
-      sp = sp + fc(1) ** 2 + fc(2) ** 2
-      ss = s + sp * ( f3 / f2 ) ** 2
-      s0 = 1.0D+00 / sqrt ( ss )
-
-      do j = 1, km
-        if ( j < kb ) then
-          fc(j) = s0 * fc(j) * f3 / f2
-        else
-          fc(j) = s0 * fc(j)
-        end if
-      end do
-
-    end if
-
-  end if
-
-  if ( fc(1) < 0.0D+00 ) then
-    do j = 1, km
-      fc(j) = -fc(j)
-    end do
-  end if
-
-  return
-end
-subroutine fcs ( x, c, s )
-
-!*****************************************************************************80
-!
-!! FCS computes Fresnel integrals C(x) and S(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    17 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-! 
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) C, S, the function values.
-!
-  implicit none
-
-  real ( kind = 8 ) c
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) g
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) px
-  real ( kind = 8 ) q
-  real ( kind = 8 ) r
-  real ( kind = 8 ) s
-  real ( kind = 8 ) su
-  real ( kind = 8 ) t
-  real ( kind = 8 ) t0
-  real ( kind = 8 ) t2
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xa
-
-  eps = 1.0D-15
-  pi = 3.141592653589793D+00
-  xa = abs ( x )
-  px = pi * xa
-  t = 0.5D+00 * px * xa
-  t2 = t * t
-
-  if ( xa == 0.0D+00 ) then
-
-    c = 0.0D+00
-    s = 0.0D+00
-
-  else if ( xa < 2.5D+00 ) then
-
-    r = xa
-    c = r
-    do k = 1, 50
-      r = -0.5D+00 * r * ( 4.0D+00 * k - 3.0D+00 ) / k &
-        / ( 2.0D+00 * k - 1.0D+00 ) / ( 4.0D+00 * k + 1.0D+00 ) * t2
-      c = c + r
-      if ( abs ( r ) < abs ( c ) * eps ) then
-        exit
-      end if
-    end do
-
-    s = xa * t / 3.0D+00
-    r = s
-    do k = 1, 50
-      r = - 0.5D+00 * r * ( 4.0D+00 * k - 1.0D+00 ) / k &
-        / ( 2.0D+00 * k + 1.0D+00 ) / ( 4.0D+00 * k + 3.0D+00 ) * t2
-      s = s + r
-      if ( abs ( r ) < abs ( s ) * eps ) then
-        if ( x < 0.0D+00 ) then
-          c = -c
-          s = -s
-        end if
-        return
-      end if
-    end do
-
-  else if ( xa < 4.5D+00 ) then
-
-    m = int ( 42.0D+00 + 1.75D+00 * t )
-    su = 0.0D+00
-    c = 0.0D+00
-    s = 0.0D+00
-    f1 = 0.0D+00
-    f0 = 1.0D-100
-
-    do k = m, 0, -1
-      f = ( 2.0D+00 * k + 3.0D+00 ) * f0 / t - f1
-      if ( k == int ( k / 2 ) * 2 ) then
-        c = c + f
-      else
-        s = s + f
-      end if
-      su = su + ( 2.0D+00 * k + 1.0D+00 ) * f * f
-      f1 = f0
-      f0 = f
-    end do
-
-    q = sqrt ( su )
-    c = c * xa / q
-    s = s * xa / q
-
-  else
-
-    r = 1.0D+00
-    f = 1.0D+00
-    do k = 1, 20
-      r = -0.25D+00 * r * ( 4.0D+00 * k - 1.0D+00 ) &
-        * ( 4.0D+00 * k - 3.0D+00 ) / t2
-      f = f + r
-    end do
-    r = 1.0D+00 / ( px * xa )
-    g = r
-    do k = 1, 12
-      r = -0.25D+00 * r * ( 4.0D+00 * k + 1.0D+00 ) &
-        * ( 4.0D+00 * k - 1.0D+00 ) / t2
-      g = g + r
-    end do
-
-    t0 = t - int ( t / ( 2.0D+00 * pi ) ) * 2.0D+00 * pi
-    c = 0.5D+00 + ( f * sin ( t0 ) - g * cos ( t0 ) ) / px
-    s = 0.5D+00 - ( f * cos ( t0 ) + g * sin ( t0 ) ) / px
-
-  end if
-
-  if ( x < 0.0D+00 ) then
-    c = -c
-    s = -s
-  end if
-
-  return
-end
-subroutine fcszo ( kf, nt, zo )
-
-!*****************************************************************************80
-!
-!! FCSZO computes complex zeros of Fresnel integrals C(x) or S(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    17 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) KF, the function code.
-!    1 for C(z);
-!    2 for S(z)
-!
-!    Input, integer ( kind = 4 ) NT, the total number of zeros desired.
-!
-!    Output, complex ( kind = 8 ) Z0(NT), the zeros.
-!
-  implicit none
-
-  integer ( kind = 4 ) nt
-
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) it
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) kf
-  integer ( kind = 4 ) nr
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) psq
-  real ( kind = 8 ) px
-  real ( kind = 8 ) py
-  real ( kind = 8 ) w
-  real ( kind = 8 ) w0
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) zd
-  complex ( kind = 8 ) zf
-  complex ( kind = 8 ) zfd
-  complex ( kind = 8 ) zgd
-  complex ( kind = 8 ) zo(nt)
-  complex ( kind = 8 ) zp
-  complex ( kind = 8 ) zq
-  complex ( kind = 8 ) zw
-
-  pi = 3.141592653589793D+00
-
-  do nr = 1, nt
-
-    if ( kf == 1 ) then
-      psq = sqrt ( 4.0D+00 * nr - 1.0D+00 )
-    else
-      psq = 2.0D+00 * sqrt ( real ( nr, kind = 8 ) )
-    end if
-
-    px = psq - log ( pi * psq ) / ( pi * pi * psq ** 3.0D+00 )
-    py = log ( pi * psq ) / ( pi * psq )
-    z = cmplx ( px, py, kind = 8 )
-
-    if ( kf == 2 ) then
-      if ( nr == 2 ) then
-        z = cmplx ( 2.8334D+00, 0.2443D+00, kind = 8 )
-      else if ( nr == 3 ) then
-        z = cmplx ( 3.4674D+00, 0.2185D+00, kind = 8 )
-      else if ( nr == 4 ) then
-        z = cmplx ( 4.0025D+00, 0.2008D+00, kind = 8 )
-      end if
-    end if
-
-    it = 0
-
-    do
-
-      it = it + 1
-
-      if ( kf == 1 ) then
-        call cfc ( z, zf, zd )
-      else
-        call cfs ( z, zf, zd )
-      end if
-
-      zp = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do i = 1, nr - 1
-        zp = zp * ( z - zo(i) )
-      end do
-      zfd = zf / zp
-      zq = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-
-      do i = 1, nr - 1
-        zw = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-        do j = 1, nr - 1
-          if ( j /= i ) then
-            zw = zw * ( z - zo(j) )
-          end if
-        end do
-        zq = zq + zw
-      end do
-
-      zgd = ( zd - zq * zfd ) / zp
-      z = z - zfd / zgd
-      w0 = w
-      w = cdabs ( z )
-
-      if ( abs ( ( w - w0 ) / w ) <= 1.0D-12 ) then
-        exit
-      end if
-
-      if ( 50 < it ) then
-        exit
-      end if
-
-    end do
-
-    zo(nr) = z
-
-  end do
-
-  return
-end
-subroutine ffk ( ks, x, fr, fi, fm, fa, gr, gi, gm, ga )
-
-!*****************************************************************************80
-!
-!! FFK computes modified Fresnel integrals F+/-(x) and K+/-(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    23 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) KS, the sign code.
-!    0, to calculate F+(x) and K+(x);
-!    1, to calculate F_(x) and K_(x).
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) FR, FI, FM, FA, the values of
-!    Re[F+/-(x)], Im[F+/-(x)], |F+/-(x)|, Arg[F+/-(x)]  (Degs.).
-!
-!    Output, real ( kind = 8 ) GR, GI, GM, GA, the values of
-!    Re[K+/-(x)], Im[K+/-(x)], |K+/-(x)|, Arg[K+/-(x)]  (Degs.).
-!       
-  implicit none
-
-  real ( kind = 8 ) c1
-  real ( kind = 8 ) cs
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) fa
-  real ( kind = 8 ) fi
-  real ( kind = 8 ) fi0
-  real ( kind = 8 ) fm
-  real ( kind = 8 ) fr
-  real ( kind = 8 ) ga
-  real ( kind = 8 ) gi
-  real ( kind = 8 ) gm
-  real ( kind = 8 ) gr
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) ks
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) p2p
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) pp2
-  real ( kind = 8 ) s1
-  real ( kind = 8 ) srd
-  real ( kind = 8 ) ss
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x2
-  real ( kind = 8 ) x4
-  real ( kind = 8 ) xa
-  real ( kind = 8 ) xc
-  real ( kind = 8 ) xf
-  real ( kind = 8 ) xf0
-  real ( kind = 8 ) xf1
-  real ( kind = 8 ) xg
-  real ( kind = 8 ) xp
-  real ( kind = 8 ) xq
-  real ( kind = 8 ) xq2
-  real ( kind = 8 ) xr
-  real ( kind = 8 ) xs
-  real ( kind = 8 ) xsu
-  real ( kind = 8 ) xw
-
-  srd = 57.29577951308233D+00
-  eps = 1.0D-15
-  pi = 3.141592653589793D+00
-  pp2 = 1.2533141373155D+00
-  p2p = 0.7978845608028654D+00
-  xa = abs ( x )
-  x2 = x * x
-  x4 = x2 * x2
-
-  if ( x == 0.0D+00 ) then
-
-    fr = 0.5D+00 * sqrt ( 0.5D+00 * pi )
-    fi = ( -1.0D+00 ) ** ks * fr
-    fm = sqrt ( 0.25D+00 * pi )
-    fa = ( -1.0D+00 ) ** ks * 45.0D+00
-    gr = 0.5D+00
-    gi = 0.0D+00
-    gm = 0.5D+00
-    ga = 0.0D+00
-
-  else
-
-    if ( xa <= 2.5D+00 ) then
-
-      xr = p2p * xa
-      c1 = xr
-      do k = 1, 50
-        xr = -0.5D+00 * xr * ( 4.0D+00 * k - 3.0D+00 ) / k &
-          / ( 2.0D+00 * k - 1.0D+00 ) &
-          / ( 4.0D+00 * k + 1.0D+00 ) * x4
-        c1 = c1 + xr
-        if ( abs ( xr / c1 ) < eps ) then
-          exit
-        end if
-      end do
-
-      s1 = p2p * xa * xa * xa / 3.0D+00
-      xr = s1
-      do k = 1, 50
-        xr = -0.5D+00 * xr * ( 4.0D+00 * k - 1.0D+00 ) &
-          / k / ( 2.0D+00 * k + 1.0D+00 ) &
-          / ( 4.0D+00 * k + 3.0D+00 ) * x4
-        s1 = s1 + xr
-        if ( abs ( xr / s1 ) < eps ) then
-          exit
-        end if
-      end do
-
-    else if ( xa < 5.5D+00 ) then
-
-      m = int ( 42.0D+00 + 1.75D+00 * x2 )
-      xsu = 0.0D+00
-      xc = 0.0D+00
-      xs = 0.0D+00
-      xf1 = 0.0D+00
-      xf0 = 1.0D-100
-      do k = m, 0, -1
-        xf = ( 2.0D+00 * k + 3.0D+00 ) * xf0 / x2 - xf1
-        if ( k == 2 * int ( k / 2 ) )  then
-          xc = xc + xf
-        else
-          xs = xs + xf
-        end if
-        xsu = xsu + ( 2.0D+00 * k + 1.0D+00 ) * xf * xf
-        xf1 = xf0
-        xf0 = xf
-      end do
-      xq = sqrt ( xsu )
-      xw = p2p * xa / xq
-      c1 = xc * xw
-      s1 = xs * xw
-
-    else
-
-      xr = 1.0D+00
-      xf = 1.0D+00
-      do k = 1, 12
-        xr = -0.25D+00 * xr * ( 4.0D+00 * k - 1.0D+00 ) &
-          * ( 4.0D+00 * k - 3.0D+00 ) / x4
-        xf = xf + xr
-      end do
-      xr = 1.0D+00 / ( 2.0D+00 * xa * xa )
-      xg = xr
-      do k = 1, 12
-        xr = -0.25D+00 * xr * ( 4.0D+00 * k + 1.0D+00 ) &
-          * ( 4.0D+00 * k - 1.0D+00 ) / x4
-        xg = xg + xr
-      end do
-      c1 = 0.5D+00 + ( xf * sin ( x2 ) - xg * cos ( x2 ) ) &
-        / sqrt ( 2.0D+00 * pi ) / xa
-      s1 = 0.5D+00 - ( xf * cos ( x2 ) + xg * sin ( x2 ) ) &
-        / sqrt ( 2.0D+00 * pi ) / xa
-
-    end if
- 
-    fr = pp2 * ( 0.5D+00 - c1 )
-    fi0 = pp2 * ( 0.5D+00 - s1 )
-    fi = ( -1.0D+00 ) ** ks * fi0
-    fm = sqrt ( fr * fr + fi * fi )
-
-    if ( 0.0D+00 <= fr ) then
-      fa = srd * atan ( fi / fr )
-    else if ( 0.0D+00 < fi ) then
-      fa = srd * ( atan ( fi / fr ) + pi )
-    else if ( fi < 0.0D+00 ) then
-      fa = srd * ( atan ( fi / fr ) - pi )
-    end if
-
-    xp = x * x + pi / 4.0D+00
-    cs = cos ( xp )
-    ss = sin ( xp )
-    xq2 = 1.0D+00 / sqrt ( pi )
-    gr = xq2 * ( fr * cs + fi0 * ss )
-    gi = ( -1.0D+00 ) ** ks * xq2 * ( fi0 * cs - fr * ss )
-    gm = sqrt ( gr * gr + gi * gi )
-
-    if ( 0.0D+00 <= gr ) then
-      ga = srd * atan ( gi / gr )
-    else if ( 0.0D+00 < gi ) then
-      ga = srd * ( atan ( gi / gr ) + pi )
-    else if ( gi < 0.0D+00 ) then
-      ga = srd * ( atan ( gi / gr ) - pi )
-    end if
-
-    if ( x < 0.0D+00 ) then
-      fr = pp2 - fr
-      fi = ( -1.0D+00 ) ** ks * pp2 - fi
-      fm = sqrt ( fr * fr + fi * fi )
-      fa = srd * atan ( fi / fr )
-      gr = cos ( x * x ) - gr
-      gi = - ( -1.0D+00 ) ** ks * sin ( x * x ) - gi
-      gm = sqrt ( gr * gr + gi * gi )
-      ga = srd * atan ( gi / gr )
-    end if
-
-  end if
-
-  return
-end
-subroutine gaih ( x, ga )
-
-!*****************************************************************************80
-!
-!! GAIH computes the GammaH function.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    09 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) GA, the function value.
-!
-  implicit none
-
-  real ( kind = 8 ) ga
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) m1
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) x
-
-  pi = 3.141592653589793D+00
-
-  if ( x == int ( x ) .and. 0.0 < x ) then
-    ga = 1.0D+00
-    m1 = int ( x - 1.0D+00 )
-    do k = 2, m1
-      ga = ga * k
-    end do
-  else if ( x + 0.5D+00 == int ( x + 0.5D+00) .and. 0.0D+00 < x ) then
-    m = int ( x )
-    ga = sqrt ( pi )
-    do k = 1, m
-      ga = 0.5D+00 * ga * ( 2.0D+00 * k - 1.0D+00 )
-    end do
-  end if
-
-  return
-end
-subroutine gam0 ( x, ga )
-
-!*****************************************************************************80
-!
-!! GAM0 computes the Gamma function for the LAMV function.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    09 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) GA, the function value.
-!   
-  implicit none
-
-  real ( kind = 8 ), dimension ( 25 ) :: g = (/ &
-    1.0D+00, &
-    0.5772156649015329D+00, &
-   -0.6558780715202538D+00, &
-   -0.420026350340952D-01, &
-    0.1665386113822915D+00, &
-   -0.421977345555443D-01, &
-   -0.96219715278770D-02, &
-    0.72189432466630D-02, &
-   -0.11651675918591D-02, &
-   -0.2152416741149D-03, &
-    0.1280502823882D-03, &
-   -0.201348547807D-04, &
-   -0.12504934821D-05, &
-    0.11330272320D-05, &
-   -0.2056338417D-06, &
-    0.61160950D-08, &
-    0.50020075D-08, &
-   -0.11812746D-08, &
-    0.1043427D-09, &
-    0.77823D-11, &
-   -0.36968D-11, &
-    0.51D-12, &
-   -0.206D-13, &
-   -0.54D-14, &
-    0.14D-14 /)
-  real ( kind = 8 ) ga
-  real ( kind = 8 ) gr
-  integer ( kind = 4 ) k
-  real ( kind = 8 ) x
-
-  gr = g(25)
-  do k = 24, 1, -1
-    gr = gr * x + g(k)
-  end do
-
-  ga = 1.0D+00 / ( gr * x )
-
-  return
-end
-subroutine gamma ( x, ga )
-
-!*****************************************************************************80
-!
-!! GAMMA evaluates the Gamma function.
-!
-!  Licensing:
-!
-!    The original FORTRAN77 version of this routine is copyrighted by 
-!    Shanjie Zhang and Jianming Jin.  However, they give permission to 
-!    incorporate this routine into a user program that the copyright 
-!    is acknowledged.
-!
-!  Modified:
-!
-!    08 September 2007
-!
-!  Author:
-!
-!    Original FORTRAN77 version by Shanjie Zhang, Jianming Jin.
-!    FORTRAN90 version by John Burkardt.
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!    X must not be 0, or any negative integer.
-!
-!    Output, real ( kind = 8 ) GA, the value of the Gamma function.
-!
-  implicit none
-
-  real ( kind = 8 ), dimension ( 26 ) :: g = (/ &
-    1.0D+00, &
-    0.5772156649015329D+00, &
-   -0.6558780715202538D+00, &
-   -0.420026350340952D-01, &
-    0.1665386113822915D+00, &
-   -0.421977345555443D-01, &
-   -0.96219715278770D-02, &
-    0.72189432466630D-02, &
-   -0.11651675918591D-02, &
-   -0.2152416741149D-03, &
-    0.1280502823882D-03, & 
-   -0.201348547807D-04, &
-   -0.12504934821D-05, &
-    0.11330272320D-05, &
-   -0.2056338417D-06, & 
-    0.61160950D-08, &
-    0.50020075D-08, &
-   -0.11812746D-08, &
-    0.1043427D-09, & 
-    0.77823D-11, &
-   -0.36968D-11, &
-    0.51D-12, &
-   -0.206D-13, &
-   -0.54D-14, &
-    0.14D-14, &
-    0.1D-15 /)
-  real ( kind = 8 ) ga
-  real ( kind = 8 ) gr
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) m1
-  real ( kind = 8 ), parameter :: pi = 3.141592653589793D+00
-  real ( kind = 8 ) r
-  real ( kind = 8 ) x
-  real ( kind = 8 ) z
-
-  if ( x == aint ( x ) ) then
-
-    if ( 0.0D+00 < x ) then
-      ga = 1.0D+00
-      m1 = int ( x ) - 1
-      do k = 2, m1
-        ga = ga * k
-      end do
-    else
-      ga = 1.0D+300
-    end if
-
-  else
-
-    if ( 1.0D+00 < abs ( x ) ) then
-      z = abs ( x )
-      m = int ( z )
-      r = 1.0D+00
-      do k = 1, m
-        r = r * ( z - real ( k, kind = 8 ) )
-      end do
-      z = z - real ( m, kind = 8 )
-    else
-      z = x
-    end if
-
-    gr = g(26)
-    do k = 25, 1, -1
-      gr = gr * z + g(k)
-    end do
-
-    ga = 1.0D+00 / ( gr * z )
-
-    if ( 1.0D+00 < abs ( x ) ) then
-      ga = ga * r
-      if ( x < 0.0D+00 ) then
-        ga = - pi / ( x* ga * sin ( pi * x ) )
-      end if
-    end if
-
-  end if
-
-  return
-end
-subroutine gmn ( m, n, c, x, bk, gf, gd )
-
-!*****************************************************************************80
-!
-!! GMN computes quantities for oblate radial functions with small argument.
-!
-!  Discussion:
-!
-!    This procedure computes Gmn(-ic,ix) and its derivative for oblate
-!    radial functions with a small argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    15 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
-!
-!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
-!
-!    Input, real ( kind = 8 ) C, spheroidal parameter.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Input, real ( kind = 8 ) BK(*), coefficients.
-!
-!    Output, real ( kind = 8 ) GF, GD, the value of Gmn(-C,X) and Gmn'(-C,X).
-!
-  implicit none
-
-  real ( kind = 8 ) bk(200)
-  real ( kind = 8 ) c
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) gd
-  real ( kind = 8 ) gd0
-  real ( kind = 8 ) gd1
-  real ( kind = 8 ) gf
-  real ( kind = 8 ) gf0
-  real ( kind = 8 ) gw
-  integer ( kind = 4 ) ip
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xm
-
-  eps = 1.0D-14
-
-  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
-    ip = 0
-  else
-    ip = 1
-  end if
-
-  nm = 25 + int ( 0.5D+00 * ( n - m ) + c )
-  xm = ( 1.0D+00 + x * x ) ** ( -0.5D+00 * m )
-  gf0 = 0.0D+00
-  do k = 1, nm
-    gf0 = gf0 + bk(k) * x ** ( 2.0D+00 * k - 2.0D+00 )
-    if ( abs ( ( gf0 - gw ) / gf0 ) < eps .and. 10 <= k ) then
-      exit
-    end if
-    gw = gf0
-  end do
-
-  gf = xm * gf0 * x ** ( 1 - ip )
-
-  gd1 = - m * x / ( 1.0D+00 + x * x ) * gf
-  gd0 = 0.0D+00
-
-  do k = 1, nm
-
-    if ( ip == 0 ) then
-      gd0 = gd0 + ( 2.0D+00 * k - 1.0D+00 ) * bk(k) &
-        * x ** ( 2.0D+00 * k - 2.0D+00 )
-    else
-      gd0 = gd0 + 2.0D+00 * k * bk(k+1) * x ** ( 2.0D+00 * k - 1.0D+00 )
-    end if
-
-    if ( abs ( ( gd0 - gw ) / gd0 ) < eps .and. 10 <= k ) then
-      exit
-    end if
-
-    gw = gd0
-
-  end do
-
-  gd = gd1 + xm * gd0
-
-  return
-end
-subroutine herzo ( n, x, w )
-
-!*****************************************************************************80
-!
-!! HERZO computes the zeros the Hermite polynomial Hn(x).
-!
-!  Discussion:
-!
-!    This procedure computes the zeros of Hermite polynomial Ln(x)
-!    in the interval [-1,+1], and the corresponding
-!    weighting coefficients for Gauss-Hermite integration.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    15 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order of the polynomial.
-!
-!    Output, real ( kind = 8 ) X(N), the zeros.
-!
-!    Output, real ( kind = 8 ) W(N), the corresponding weights.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) fd
-  real ( kind = 8 ) gd
-  real ( kind = 8 ) hd
-  real ( kind = 8 ) hf
-  real ( kind = 8 ) hn
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) it
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) nr
-  real ( kind = 8 ) p
-  real ( kind = 8 ) q
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) r2
-  real ( kind = 8 ) w(n)
-  real ( kind = 8 ) wp
-  real ( kind = 8 ) x(n)
-  real ( kind = 8 ) z
-  real ( kind = 8 ) z0
-  real ( kind = 8 ) zl
-
-  hn = 1.0D+00 / n
-  zl = -1.1611D+00 + 1.46D+00 * sqrt ( real ( n, kind = 8 ) )
-
-  do nr = 1, n / 2
-
-    if ( nr == 1 ) then
-      z = zl
-    else
-      z = z - hn * ( n / 2 + 1 - nr )
-    end if
-
-    it = 0
-
-    do
-
-      it = it + 1
-      z0 = z
-      f0 = 1.0D+00
-      f1 = 2.0D+00 * z
-      do k = 2, n
-        hf = 2.0D+00 * z * f1 - 2.0D+00 * ( k - 1.0D+00 ) * f0
-        hd = 2.0D+00 * k * f1
-        f0 = f1
-        f1 = hf
-      end do
-
-      p = 1.0D+00
-      do i = 1, nr - 1
-        p = p * ( z - x(i) )
-      end do
-      fd = hf / p
-
-      q = 0.0D+00
-      do i = 1, nr - 1
-        wp = 1.0D+00
-        do j = 1, nr - 1
-          if ( j /= i ) then
-            wp = wp * ( z - x(j) )
-          end if
-        end do
-        q = q + wp
-      end do
-
-      gd = ( hd - q * fd ) / p
-      z = z - fd / gd
-
-      if ( 40 < it .or. abs ( ( z - z0 ) / z ) <= 1.0D-15 ) then
-        exit
-      end if
-
-    end do
-
-    x(nr) = z
-    x(n+1-nr) = -z
-    r = 1.0D+00
-    do k = 1, n
-      r = 2.0D+00 * r * k
-    end do
-    w(nr) = 3.544907701811D+00 * r / ( hd * hd )
-    w(n+1-nr) = w(nr)
-
-  end do
-
-  if ( n /= 2 * int ( n / 2 ) ) then
-    r1 = 1.0D+00
-    r2 = 1.0D+00
-    do j = 1, n
-      r1 = 2.0D+00 * r1 * j
-      if ( ( n + 1 ) / 2 <= j ) then
-        r2 = r2 * j
-      end if
-    end do
-    w(n/2+1) = 0.88622692545276D+00 * r1 / ( r2 * r2 )
-    x(n/2+1) = 0.0D+00
-  end if
-
-  return
-end
-subroutine hygfx ( a, b, c, x, hf )
-
-!*****************************************************************************80
-!
-!! HYGFX evaluates the hypergeometric function F(A,B,C,X).
-!
-!  Licensing:
-!
-!    The original FORTRAN77 version of this routine is copyrighted by 
-!    Shanjie Zhang and Jianming Jin.  However, they give permission to 
-!    incorporate this routine into a user program that the copyright 
-!    is acknowledged.
-!
-!  Modified:
-!
-!    08 September 2007
-!
-!  Author:
-!
-!    Original FORTRAN77 version by Shanjie Zhang, Jianming Jin.
-!    FORTRAN90 version by John Burkardt.
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) A, B, C, X, the arguments of the function.
-!    C must not be equal to a nonpositive integer.
-!    X < 1.
-!
-!    Output, real HF, the value of the function.
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) aa
-  real ( kind = 8 ) b
-  real ( kind = 8 ) bb
-  real ( kind = 8 ) c
-  real ( kind = 8 ) c0
-  real ( kind = 8 ) c1
-  real ( kind = 8 ), parameter :: el = 0.5772156649015329D+00
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) g0
-  real ( kind = 8 ) g1
-  real ( kind = 8 ) g2
-  real ( kind = 8 ) g3
-  real ( kind = 8 ) ga
-  real ( kind = 8 ) gabc
-  real ( kind = 8 ) gam
-  real ( kind = 8 ) gb
-  real ( kind = 8 ) gbm
-  real ( kind = 8 ) gc
-  real ( kind = 8 ) gca
-  real ( kind = 8 ) gcab
-  real ( kind = 8 ) gcb
-  real ( kind = 8 ) gm
-  real ( kind = 8 ) hf
-  real ( kind = 8 ) hw
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  logical l0
-  logical l1
-  logical l2
-  logical l3
-  logical l4
-  logical l5
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) pa
-  real ( kind = 8 ) pb
-  real ( kind = 8 ), parameter :: pi = 3.141592653589793D+00
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r0
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) rm
-  real ( kind = 8 ) rp
-  real ( kind = 8 ) sm
-  real ( kind = 8 ) sp
-  real ( kind = 8 ) sp0
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x1
-
-  l0 = ( c == aint ( c ) ) .and. ( c < 0.0D+00 )
-  l1 = ( 1.0D+00 - x < 1.0D-15 ) .and. ( c - a - b <= 0.0D+00 )
-  l2 = ( a == aint ( a ) ) .and. ( a < 0.0D+00 )
-  l3 = ( b == aint ( b ) ) .and. ( b < 0.0D+00 )
-  l4 = ( c - a == aint ( c - a ) ) .and. ( c - a <= 0.0D+00 )
-  l5 = ( c - b == aint ( c - b ) ) .and. ( c - b <= 0.0D+00 )
-
-  if ( l0 .or. l1 ) then
-    write ( *, '(a)' ) ' '
-    write ( *, '(a)' ) 'HYGFX - Fatal error!'
-    write ( *, '(a)' ) '  The hypergeometric series is divergent.'
-    return
-  end if
-
-  if ( 0.95D+00 < x ) then 
-    eps = 1.0D-08
-  else
-    eps = 1.0D-15
-  end if
-
-  if ( x == 0.0D+00 .or. a == 0.0D+00 .or. b == 0.0D+00 ) then
-
-    hf = 1.0D+00
-    return
-
-  else if ( 1.0D+00 - x == eps .and. 0.0D+00 < c - a - b ) then
-
-    call gamma ( c, gc )
-    call gamma ( c - a - b, gcab )
-    call gamma ( c - a, gca )
-    call gamma ( c - b, gcb )
-    hf = gc * gcab /( gca *gcb )
-    return
-
-  else if ( 1.0D+00 + x <= eps .and. abs ( c - a + b - 1.0D+00 ) <= eps ) then
-
-    g0 = sqrt ( pi ) * 2.0D+00**( - a )
-    call gamma ( c, g1 )
-    call gamma ( 1.0D+00 + a / 2.0D+00 - b, g2 )
-    call gamma ( 0.5D+00 + 0.5D+00 * a, g3 )
-    hf = g0 * g1 / ( g2 * g3 )
-    return
-
-  else if ( l2 .or. l3 ) then
-
-    if ( l2 ) then
-      nm = int ( abs ( a ) )
-    end if
-
-    if ( l3 ) then
-      nm = int ( abs ( b ) )
-    end if
-
-    hf = 1.0D+00
-    r = 1.0D+00
-
-    do k = 1, nm
-      r = r * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
-        / ( k * ( c + k - 1.0D+00 ) ) * x
-      hf = hf + r
-    end do
-
-    return
-
-  else if ( l4 .or. l5 ) then
-
-    if ( l4 ) then
-      nm = int ( abs ( c - a ) )
-    end if
-
-    if ( l5 ) then
-      nm = int ( abs ( c - b ) )
-    end if
-
-    hf = 1.0D+00
-    r  = 1.0D+00
-    do k = 1, nm
-      r = r * ( c - a + k - 1.0D+00 ) * ( c - b + k - 1.0D+00 ) &
-        / ( k * ( c + k - 1.0D+00 ) ) * x
-      hf = hf + r
-    end do
-    hf = ( 1.0D+00 - x )**( c - a - b ) * hf
-    return
-
-  end if
-
-  aa = a
-  bb = b
-  x1 = x
-!
-!  WARNING: ALTERATION OF INPUT ARGUMENTS A AND B, WHICH MIGHT BE CONSTANTS.
-!
-  if ( x < 0.0D+00 ) then
-    x = x / ( x - 1.0D+00 )
-    if ( a < c .and. b < a .and. 0.0D+00 < b ) then
-      a = bb
-      b = aa
-    end if
-    b = c - b
-  end if
-
-  if ( 0.75D+00 <= x ) then
-
-    gm = 0.0D+00
-
-    if ( abs ( c - a - b - aint ( c - a - b ) ) < 1.0D-15 ) then
-
-      m = int ( c - a - b )
-      call gamma ( a, ga )
-      call gamma ( b, gb )
-      call gamma ( c, gc )
-      call gamma ( a + m, gam )
-      call gamma ( b + m, gbm )
-      call psi ( a, pa )
-      call psi ( b, pb )
-
-      if ( m /= 0 ) then
-        gm = 1.0D+00
-      end if
-
-      do j = 1, abs ( m ) - 1
-        gm = gm * j
-      end do
-
-      rm = 1.0D+00
-      do j = 1, abs ( m )
-        rm = rm * j
-      end do
-
-      f0 = 1.0D+00
-      r0 = 1.0D+00
-      r1 = 1.0D+00
-      sp0 = 0.0D+00
-      sp = 0.0D+00
-
-      if ( 0 <= m ) then
-
-        c0 = gm * gc / ( gam * gbm )
-        c1 = - gc * ( x - 1.0D+00 )**m / ( ga * gb * rm )
-
-        do k = 1, m - 1
-          r0 = r0 * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
-            / ( k * ( k - m ) ) * ( 1.0D+00 - x )
-          f0 = f0 + r0
-        end do
-
-        do k = 1, m
-          sp0 = sp0 + 1.0D+00 / ( a + k - 1.0D+00 ) &
-            + 1.0D+00 / ( b + k - 1.0D+00 ) - 1.0D+00 / real ( k, kind = 8 )
-        end do
-
-        f1 = pa + pb + sp0 + 2.0D+00 * el + log ( 1.0D+00 - x )
-        hw = f1
-
-        do k = 1, 250
-
-          sp = sp + ( 1.0D+00 - a ) / ( k * ( a + k - 1.0D+00 ) ) &
-            + ( 1.0D+00 - b ) / ( k * ( b + k - 1.0D+00 ) )
-
-          sm = 0.0D+00
-          do j = 1, m
-            sm = sm + ( 1.0D+00 - a ) &
-              / ( ( j + k ) * ( a + j + k - 1.0D+00 ) ) &
-              + 1.0D+00 / ( b + j + k - 1.0D+00 )
-          end do
-
-          rp = pa + pb + 2.0D+00 * el + sp + sm + log ( 1.0D+00 - x )
-
-          r1 = r1 * ( a + m + k - 1.0D+00 ) * ( b + m + k - 1.0D+00 ) &
-            / ( k * ( m + k ) ) * ( 1.0D+00 - x )
-
-          f1 = f1 + r1 * rp
-
-          if ( abs ( f1 - hw ) < abs ( f1 ) * eps ) then
-            exit
-          end if
-
-          hw = f1
-
-        end do
-
-        hf = f0 * c0 + f1 * c1
-
-      else if ( m < 0 ) then
-
-        m = - m
-        c0 = gm * gc / ( ga * gb * ( 1.0D+00 - x )**m )
-        c1 = - ( - 1 )**m * gc / ( gam * gbm * rm )
-
-        do k = 1, m - 1
-          r0 = r0 * ( a - m + k - 1.0D+00 ) * ( b - m + k - 1.0D+00 ) &
-            / ( k * ( k - m ) ) * ( 1.0D+00 - x )
-          f0 = f0 + r0
-        end do
-
-        do k = 1, m
-          sp0 = sp0 + 1.0D+00 / real ( k, kind = 8 )
-        end do
-
-        f1 = pa + pb - sp0 + 2.0D+00 * el + log ( 1.0D+00 - x )
-
-        do k = 1, 250
-
-          sp = sp + ( 1.0D+00 - a ) &
-            / ( k * ( a + k - 1.0D+00 ) ) &
-            + ( 1.0D+00 - b ) / ( k * ( b + k - 1.0D+00 ) )
-
-          sm = 0.0D+00
-          do j = 1, m
-            sm = sm + 1.0D+00 / real ( j + k, kind = 8 )
-          end do
-
-          rp = pa + pb + 2.0D+00 * el + sp - sm + log ( 1.0D+00 - x )
-
-          r1 = r1 * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
-            / ( k * ( m + k ) ) * ( 1.0D+00 - x )
-
-          f1 = f1 + r1 * rp
-
-          if ( abs ( f1 - hw ) < abs ( f1 ) * eps ) then
-            exit
-          end if
-
-          hw = f1
-
-        end do
-
-        hf = f0 * c0 + f1 * c1
-
-      end if
-
-    else
-
-      call gamma ( a, ga )
-      call gamma ( b, gb )
-      call gamma ( c, gc )
-      call gamma ( c - a, gca )
-      call gamma ( c - b, gcb )
-      call gamma ( c - a - b, gcab )
-      call gamma ( a + b - c, gabc )
-      c0 = gc * gcab / ( gca * gcb )
-      c1 = gc * gabc / ( ga * gb ) * ( 1.0D+00 - x )**( c - a - b )
-      hf = 0.0D+00
-      r0 = c0
-      r1 = c1
-
-      do k = 1, 250
-
-        r0 = r0 * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
-          / ( k * ( a + b - c + k ) ) * ( 1.0D+00 - x )
-
-        r1 = r1 * ( c - a + k - 1.0D+00 ) * ( c - b + k - 1.0D+00 ) &
-          / ( k * ( c - a - b + k ) ) * ( 1.0D+00 - x )
-
-        hf = hf + r0 + r1
-
-        if ( abs ( hf - hw ) < abs ( hf ) * eps ) then
-          exit
-        end if
-
-        hw = hf
-
-      end do
-
-      hf = hf + c0 + c1
-
-    end if
-
-  else
-
-    a0 = 1.0D+00
-
-    if ( a < c .and. c < 2.0D+00 * a .and. b < c .and. c < 2.0D+00 * b ) then
-
-      a0 = ( 1.0D+00 - x )**( c - a - b )
-      a = c - a
-      b = c - b
-
-    end if
-
-    hf = 1.0D+00
-    r = 1.0D+00
-
-    do k = 1, 250
-
-      r = r * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
-        / ( k * ( c + k - 1.0D+00 ) ) * x
-
-      hf = hf + r
-
-      if ( abs ( hf - hw ) <= abs ( hf ) * eps ) then
-        exit
-      end if
-
-      hw = hf
-
-    end do
-
-    hf = a0 * hf
-
-  end if
-
-  if ( x1 < 0.0D+00 ) then
-    x = x1
-    c0 = 1.0D+00 / ( 1.0D+00 - x )**aa
-    hf = c0 * hf
-  end if
-
-  a = aa
-  b = bb
-
-  if ( 120 < k ) then
-    write ( *, '(a)' ) ' '
-    write ( *, '(a)' ) 'HYGFX - Warning!'
-    write ( *, '(a)' ) '  A large number of iterations were needed.'
-    write ( *, '(a)' ) '  The accuracy of the results should be checked.'
-  end if
-
-  return
-end
-subroutine hygfz ( a, b, c, z, zhf )
-
-!*****************************************************************************80
-!
-!! HYGFZ computes the hypergeometric function F(a,b,c,x) for complex argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    03 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) A, B, C, parameters.
-!
-!    Input, complex ( kind = 8 ) Z, the argument.
-!
-!    Output, complex ( kind = 8 ) ZHF, the value of F(a,b,c,z).
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) aa
-  real ( kind = 8 ) b
-  real ( kind = 8 ) bb
-  real ( kind = 8 ) c
-  real ( kind = 8 ) ca
-  real ( kind = 8 ) cb
-  real ( kind = 8 ) el
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) g0
-  real ( kind = 8 ) g1
-  real ( kind = 8 ) g2
-  real ( kind = 8 ) g3
-  real ( kind = 8 ) ga
-  real ( kind = 8 ) gab
-  real ( kind = 8 ) gabc
-  real ( kind = 8 ) gam
-  real ( kind = 8 ) gb
-  real ( kind = 8 ) gba
-  real ( kind = 8 ) gbm
-  real ( kind = 8 ) gc
-  real ( kind = 8 ) gca
-  real ( kind = 8 ) gcab
-  real ( kind = 8 ) gcb
-  real ( kind = 8 ) gcbk
-  real ( kind = 8 ) gm
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  logical l0
-  logical l1
-  logical l2
-  logical l3
-  logical l4
-  logical l5
-  logical l6
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) mab
-  integer ( kind = 4 ) mcab
-  integer ( kind = 4 ) nca
-  integer ( kind = 4 ) ncb
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) pa
-  real ( kind = 8 ) pac
-  real ( kind = 8 ) pb
-  real ( kind = 8 ) pca
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) rk1
-  real ( kind = 8 ) rk2
-  real ( kind = 8 ) rm
-  real ( kind = 8 ) sj1
-  real ( kind = 8 ) sj2
-  real ( kind = 8 ) sm
-  real ( kind = 8 ) sp
-  real ( kind = 8 ) sp0
-  real ( kind = 8 ) sq
-  real ( kind = 8 ) t0
-  real ( kind = 8 ) w0
-  real ( kind = 8 ) ws
-  real ( kind = 8 ) x
-  real ( kind = 8 ) y
-  complex ( kind = 8 ) z
-  complex ( kind = 8 ) z00
-  complex ( kind = 8 ) z1
-  complex ( kind = 8 ) zc0
-  complex ( kind = 8 ) zc1
-  complex ( kind = 8 ) zf0
-  complex ( kind = 8 ) zf1
-  complex ( kind = 8 ) zhf
-  complex ( kind = 8 ) zp
-  complex ( kind = 8 ) zp0
-  complex ( kind = 8 ) zr
-  complex ( kind = 8 ) zr0
-  complex ( kind = 8 ) zr1
-  complex ( kind = 8 ) zw
-
-  x = real ( z, kind = 8 )
-  y = imag ( z )
-  eps = 1.0D-15
-  l0 = c == int ( c ) .and. c < 0.0D+00
-  l1 = abs ( 1.0D+00 - x ) < eps .and. y == 0.0D+00 .and. &
-    c - a - b <= 0.0D+00
-  l2 = abs ( z + 1.0D+00 ) < eps .and. &
-    abs ( c - a + b - 1.0D+00 ) < eps
-  l3 = a == int ( a ) .and. a < 0.0D+00
-  l4 = b == int ( b ) .and. b < 0.0D+00
-  l5 = c - a == int ( c - a ) .and. c - a <= 0.0D+00
-  l6 = c - b == int ( c - b ) .and. c - b <= 0.0D+00
-  aa = a
-  bb = b
-  a0 = abs ( z )
-  if ( 0.95D+00 < a0 ) then
-    eps = 1.0D-08
-  end if
-  pi = 3.141592653589793D+00
-  el = 0.5772156649015329D+00
-
-  if ( l0 .or. l1 ) then
-    write ( *, '(a)' ) ' '
-    write ( *, '(a)' ) 'HYGFZ - Fatal error!'
-    write ( *, '(a)' ) '  The hypergeometric series is divergent.'
-    stop
-  end if
-
-  if ( a0 == 0.0D+00 .or. a == 0.0D+00 .or. b == 0.0D+00 ) then
-
-    zhf = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-
-  else if ( z == 1.0D+00.and. 0.0D+00 < c - a - b ) then
-
-    call gamma ( c, gc )
-    call gamma ( c - a - b, gcab )
-    call gamma ( c - a, gca )
-    call gamma ( c - b, gcb )
-    zhf = gc * gcab / ( gca * gcb )
-
-  else if ( l2 ) then
-
-    g0 = sqrt ( pi ) * 2.0D+00 ** ( - a )
-    call gamma ( c, g1 )
-    call gamma ( 1.0D+00 + a / 2.0D+00 - b, g2 )
-    call gamma ( 0.5D+00 + 0.5D+00 * a, g3 )
-    zhf = g0 * g1 / ( g2 * g3 )
-
-  else if ( l3 .or. l4 ) then
-
-    if ( l3 ) then
-      nm = int ( abs ( a ) )
-    end if
-
-    if ( l4 ) then
-      nm = int ( abs ( b ) )
-    end if
-
-    zhf = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    zr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, nm
-      zr = zr * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
-        / ( k * ( c + k - 1.0D+00 ) ) * z
-      zhf = zhf + zr
-    end do
-
-  else if ( l5 .or. l6 ) then
-
-    if ( l5 ) then
-      nm = int ( abs ( c - a ) )
-    end if
-
-    if ( l6 ) then
-      nm = int ( abs ( c - b ) )
-    end if
-
-    zhf = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    zr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-    do k = 1, nm
-      zr = zr * ( c - a + k - 1.0D+00 ) * ( c - b + k - 1.0D+00 ) &
-        / ( k * ( c + k - 1.0D+00 ) ) * z
-      zhf = zhf + zr
-    end do
-    zhf = ( 1.0D+00 - z ) ** ( c - a - b ) * zhf
-
-  else if ( a0 <= 1.0D+00 ) then
-
-    if ( x < 0.0D+00 ) then
-
-      z1 = z / ( z - 1.0D+00 )
-      if ( a < c .and. b < a .and. 0.0D+00 < b ) then  
-        a = bb
-        b = aa
-      end if
-      zc0 = 1.0D+00 / ( ( 1.0D+00 - z ) ** a )
-      zhf = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      zr0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      do k = 1, 500
-        zr0 = zr0 * ( a + k - 1.0D+00 ) * ( c - b + k - 1.0D+00 ) &
-          / ( k * ( c + k - 1.0D+00 ) ) * z1
-        zhf = zhf + zr0
-        if ( abs ( zhf - zw ) < abs ( zhf ) * eps ) then
-          exit
-        end if
-        zw = zhf
-      end do
-
-      zhf = zc0 * zhf
-
-    else if ( 0.90D+00 <= a0 ) then
-
-      gm = 0.0D+00
-      mcab = int ( c - a - b + eps * sign ( 1.0D+00, c - a - b ) )
-
-      if ( abs ( c - a - b - mcab ) < eps ) then
-
-        m = int ( c - a - b )
-        call gamma ( a, ga )
-        call gamma ( b, gb )
-        call gamma ( c, gc )
-        call gamma ( a + m, gam )
-        call gamma ( b + m, gbm ) 
-        call psi ( a, pa )
-        call psi ( b, pb )
-        if ( m /= 0 ) then
-          gm = 1.0D+00
-        end if
-        do j = 1, abs ( m ) - 1
-          gm = gm * j
-        end do
-        rm = 1.0D+00
-        do j = 1, abs ( m )
-          rm = rm * j
-        end do
-        zf0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-        zr0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-        zr1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-        sp0 = 0.0D+00
-        sp = 0.0D+00
-
-        if ( 0 <= m ) then
-
-          zc0 = gm * gc / ( gam * gbm )
-          zc1 = - gc * ( z - 1.0D+00 ) ** m / ( ga * gb * rm )
-          do k = 1, m - 1
-            zr0 = zr0 * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
-              / ( k * ( k - m ) ) * ( 1.0D+00 - z )
-            zf0 = zf0 + zr0
-          end do
-          do k = 1, m
-            sp0 = sp0 + 1.0D+00 / ( a + k - 1.0D+00 ) &
-              + 1.0D+00 / ( b + k - 1.0D+00 ) - 1.0D+00 / k
-          end do
-          zf1 = pa + pb + sp0 + 2.0D+00 * el + log ( 1.0D+00 - z )
-          do k = 1, 500
-            sp = sp + ( 1.0D+00 - a ) &
-              / ( k * ( a + k - 1.0D+00 ) ) + ( 1.0D+00 - b ) &
-              / ( k * ( b + k - 1.0D+00 ) )
-            sm = 0.0D+00
-            do j = 1, m
-              sm = sm + ( 1.0D+00 - a ) / ( ( j + k ) &
-                * ( a + j + k - 1.0D+00 ) ) &
-                + 1.0D+00 / ( b + j + k - 1.0D+00 )
-            end do
-            zp = pa + pb + 2.0D+00 * el + sp + sm  + log ( 1.0D+00 - z )
-            zr1 = zr1 * ( a + m + k - 1.0D+00 ) &
-              * ( b + m + k - 1.0D+00 ) / ( k * ( m + k ) ) &
-              * ( 1.0D+00 - z )
-            zf1 = zf1 + zr1 * zp
-            if ( abs ( zf1 - zw ) < abs ( zf1 ) * eps ) then
-              exit
-            end if
-            zw = zf1
-          end do
-
-          zhf = zf0 * zc0 + zf1 * zc1
-
-        else if ( m < 0 ) then
-
-          m = - m
-          zc0 = gm * gc / ( ga * gb * ( 1.0D+00 - z ) ** m )
-          zc1 = - ( - 1.0D+00 ) ** m * gc / ( gam * gbm * rm )
-          do k = 1, m - 1
-            zr0 = zr0 * ( a - m + k - 1.0D+00 ) &
-              * ( b - m + k - 1.0D+00 ) / ( k * ( k - m ) ) &
-              * ( 1.0D+00 - z )
-            zf0 = zf0 + zr0
-          end do
-
-          do k = 1, m
-            sp0 = sp0 + 1.0D+00 / k
-          end do
-
-          zf1 = pa + pb - sp0 + 2.0D+00 * el + log ( 1.0D+00 - z )
-
-          do k = 1, 500
-            sp = sp + ( 1.0D+00 - a ) / ( k * ( a + k - 1.0D+00 ) ) &
-              + ( 1.0D+00 - b ) / ( k * ( b + k - 1.0D+00 ) )
-            sm = 0.0D+00
-            do j = 1, m
-              sm = sm + 1.0D+00 / ( j + k )
-            end do
-            zp = pa + pb + 2.0D+00 * el + sp - sm + log ( 1.0D+00 - z )
-            zr1 = zr1 * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
-              / ( k * ( m + k ) ) * ( 1.0D+00 - z )
-            zf1 = zf1 + zr1 * zp
-            if ( abs ( zf1 - zw ) < abs ( zf1 ) * eps ) then
-              exit
-            end if
-            zw = zf1
-
-          end do
-
-          zhf = zf0 * zc0 + zf1 * zc1
-
-        end if
-
-      else
-
-        call gamma ( a, ga )
-        call gamma ( b, gb )
-        call gamma ( c, gc )
-        call gamma ( c - a, gca )
-        call gamma ( c - b, gcb )
-        call gamma ( c - a - b, gcab )
-        call gamma ( a + b - c, gabc )
-        zc0 = gc * gcab / ( gca * gcb )
-        zc1 = gc * gabc / ( ga * gb ) * ( 1.0D+00 - z ) ** ( c - a - b )
-        zhf = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-        zr0 = zc0
-        zr1 = zc1
-        do k = 1, 500
-          zr0 = zr0 * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
-            / ( k * ( a + b - c + k ) ) * ( 1.0D+00 - z )
-          zr1 = zr1 * ( c - a + k - 1.0D+00 ) &
-            * ( c - b + k - 1.0D+00 ) / ( k * ( c - a - b + k ) ) &
-            * ( 1.0D+00 - z )
-          zhf = zhf + zr0 + zr1
-          if ( abs ( zhf - zw ) < abs ( zhf ) * eps ) then
-            exit
-          end if
-          zw = zhf
-        end do
-
-        zhf = zhf + zc0 + zc1
-
-      end if
-
-    else
-
-      z00 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-
-      if ( c - a < a .and. c - b < b ) then
-        z00 = ( 1.0D+00 - z ) ** ( c - a - b )
-        a = c - a
-        b = c - b
-      end if
-
-      zhf = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-      zr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
-
-      do k = 1, 1500
-        zr = zr * ( a + k - 1.0D+00 ) * ( b + k - 1.0D+00 ) &
-          / ( k * ( c + k - 1.0D+00 ) ) * z
-        zhf = zhf + zr
-        if ( abs ( zhf - zw ) <= abs ( zhf ) * eps ) then
-          exit
-        end if
-        zw = zhf
-      end do
-
-      zhf = z00 * zhf
-
-    end if
-
-  else if ( 1.0D+00 < a0 ) then
-
-    mab = int ( a - b + eps * sign ( 1.0D+00, a - b ) )
-
-    if ( abs ( a - b - mab ) < eps .and. a0 <= 1.1D+00 ) then
-      b = b + eps
-    end if
-
-    if ( eps < abs ( a - b - mab ) ) then
-
-      call gamma ( a, ga )
-      call gamma ( b, gb )
-      call gamma ( c, gc )
-      call gamma ( a - b, gab )
-      call gamma ( b - a, gba )
-      call gamma ( c - a, gca )
-      call gamma ( c - b, gcb )
-      zc0 = gc * gba / ( gca * gb * ( - z ) ** a )
-      zc1 = gc * gab / ( gcb * ga * ( - z ) ** b )
-      zr0 = zc0
-      zr1 = zc1
-      zhf = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-
-      do k = 1, 500
-        zr0 = zr0 * ( a + k - 1.0D+00 ) * ( a - c + k ) &
-          / ( ( a - b + k ) * k * z )
-        zr1 = zr1 * ( b + k - 1.0D+00 ) * ( b - c + k ) &
-          / ( ( b - a + k ) * k * z )
-        zhf = zhf + zr0 + zr1
-        if ( abs ( ( zhf - zw ) / zhf ) <= eps ) then
-          exit
-        end if
-        zw = zhf
-      end do
-
-      zhf = zhf + zc0 + zc1
-
-    else
-
-      if ( a - b < 0.0D+00 ) then
-        a = bb
-        b = aa
-      end if
-
-      ca = c - a
-      cb = c - b
-      nca = int ( ca + eps * sign ( 1.0D+00, ca ) )
-      ncb = int ( cb + eps * sign ( 1.0D+00, cb ) )
-
-      if ( abs ( ca - nca ) < eps .or. abs ( cb - ncb ) < eps ) then
-        c = c + eps
-      end if
-
-      call gamma ( a, ga )
-      call gamma ( c, gc )
-      call gamma ( c - b, gcb )
-      call psi ( a, pa )
-      call psi ( c - a, pca )
-      call psi ( a - c, pac )
-      mab = int ( a - b + eps )
-      zc0 = gc / ( ga * ( - z ) ** b )
-      call gamma ( a - b, gm )
-      zf0 = gm / gcb * zc0
-      zr = zc0
-      do k = 1, mab - 1
-        zr = zr * ( b + k - 1.0D+00 ) / ( k * z )
-        t0 = a - b - k
-        call gamma ( t0, g0 )
-        call gamma ( c - b - k, gcbk )
-        zf0 = zf0 + zr * g0 / gcbk
-      end do
-
-      if ( mab == 0 ) then
-        zf0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
-      end if
-
-      zc1 = gc / ( ga * gcb * ( - z ) ** a )
-      sp = -2.0D+00 * el - pa - pca
-      do j = 1, mab
-        sp = sp + 1.0D+00 / j
-      end do
-      zp0 = sp + log ( - z )
-      sq = 1.0D+00
-      do j = 1, mab
-        sq = sq * ( b + j - 1.0D+00 ) * ( b - c + j ) / j
-      end do
-      zf1 = ( sq * zp0 ) * zc1
-      zr = zc1
-      rk1 = 1.0D+00
-      sj1 = 0.0D+00
-
-      do k = 1, 10000
-        zr = zr / z
-        rk1 = rk1 * ( b + k - 1.0D+00 ) * ( b - c + k ) / ( k * k )
-        rk2 = rk1
-        do j = k + 1, k + mab
-          rk2 = rk2 * ( b + j - 1.0D+00 ) * ( b - c + j ) / j
-        end do
-        sj1 = sj1 + ( a - 1.0D+00 ) / ( k * ( a + k - 1.0D+00 ) ) &
-          + ( a - c - 1.0D+00 ) / ( k * ( a - c + k - 1.0D+00 ) )
-        sj2 = sj1
-        do j = k + 1, k + mab
-          sj2 = sj2 + 1.0D+00 / j
-        end do
-        zp = -2.0D+00 * el - pa - pac + sj2 - 1.0D+00 / ( k + a - c ) &
-          - pi / tan ( pi * ( k + a - c ) ) + log ( - z ) 
-        zf1 = zf1 + rk2 * zr * zp
-        ws = abs ( zf1 )
-        if ( abs ( ( ws - w0 ) / ws ) < eps ) then
-          exit
-        end if
-        w0 = ws
-      end do
-
-      zhf = zf0 + zf1
-
-    end if
-
-  end if
-
-  a = aa
-  b = bb
-  if ( 150 < k ) then
-    write ( *, '(a)' ) ' '
-    write ( *, '(a)' ) 'HYGFZ - Warning!'
-    write ( *, '(a)' ) '  The solution returned may have low accuracy.'
-  end if
-
-  return
-end
-subroutine ik01a ( x, bi0, di0, bi1, di1, bk0, dk0, bk1, dk1 )
-
-!*****************************************************************************80
-!
-!! IK01A compute Bessel function I0(x), I1(x), K0(x), and K1(x).
-!
-!  Discussion:
-!
-!    This procedure computes modified Bessel functions I0(x), I1(x),
-!    K0(x) and K1(x), and their derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    16 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) BI0, DI0, BI1, DI1, BK0, DK0, BK1, DK1, the
-!    values of I0(x), I0'(x), I1(x), I1'(x), K0(x), K0'(x), K1(x), K1'(x).
-!
-  implicit none
-
-  real ( kind = 8 ), save, dimension ( 12 ) :: a = (/ &
-    0.125D+00, 7.03125D-02, &
-    7.32421875D-02, 1.1215209960938D-01, &
-    2.2710800170898D-01, 5.7250142097473D-01, &
-    1.7277275025845D+00, 6.0740420012735D+00, &
-    2.4380529699556D+01, 1.1001714026925D+02, &
-    5.5133589612202D+02, 3.0380905109224D+03 /)
-  real ( kind = 8 ), save, dimension ( 8 ) :: a1 = (/ &
-    0.125D+00, 0.2109375D+00, &
-    1.0986328125D+00, 1.1775970458984D+01, &
-    2.1461706161499D+02, 5.9511522710323D+03, &
-    2.3347645606175D+05, 1.2312234987631D+07 /)
-  real ( kind = 8 ), save, dimension ( 12 ) :: b = (/ &
-    -0.375D+00, -1.171875D-01, &
-    -1.025390625D-01, -1.4419555664063D-01, &
-    -2.7757644653320D-01, -6.7659258842468D-01, &
-    -1.9935317337513D+00, -6.8839142681099D+00, &
-    -2.7248827311269D+01, -1.2159789187654D+02, &
-    -6.0384407670507D+02, -3.3022722944809D+03 /)
-  real ( kind = 8 ) bi0
-  real ( kind = 8 ) bi1
-  real ( kind = 8 ) bk0
-  real ( kind = 8 ) bk1
-  real ( kind = 8 ) ca
-  real ( kind = 8 ) cb
-  real ( kind = 8 ) ct
-  real ( kind = 8 ) di0
-  real ( kind = 8 ) di1
-  real ( kind = 8 ) dk0
-  real ( kind = 8 ) dk1
-  real ( kind = 8 ) el
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k0
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r
-  real ( kind = 8 ) w0
-  real ( kind = 8 ) ww
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x2
-  real ( kind = 8 ) xr
-  real ( kind = 8 ) xr2
-
-  pi = 3.141592653589793D+00
-  el = 0.5772156649015329D+00
-  x2 = x * x
-
-  if ( x == 0.0D+00 ) then
-
-    bi0 = 1.0D+00
-    bi1 = 0.0D+00
-    bk0 = 1.0D+300
-    bk1 = 1.0D+300
-    di0 = 0.0D+00
-    di1 = 0.5D+00
-    dk0 = -1.0D+300
-    dk1 = -1.0D+300
-    return
-
-  else if ( x <= 18.0D+00 ) then
-
-    bi0 = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 50
-      r = 0.25D+00 * r * x2 / ( k * k )
-      bi0 = bi0 + r
-      if ( abs ( r / bi0 ) < 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    bi1 = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 50
-      r = 0.25D+00 * r * x2 / ( k * ( k + 1 ) )
-      bi1 = bi1 + r
-      if ( abs ( r / bi1 ) < 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    bi1 = 0.5D+00 * x * bi1
-
-  else
-
-    if ( x < 35.0D+00 ) then
-      k0 = 12
-    else if ( x < 50.0D+00 ) then
-      k0 = 9
-    else
-      k0 = 7
-    end if
-
-    ca = exp ( x ) / sqrt ( 2.0D+00 * pi * x )
-    bi0 = 1.0D+00
-    xr = 1.0D+00 / x
-    do k = 1, k0
-      bi0 = bi0 + a(k) * xr ** k
-    end do
-    bi0 = ca * bi0
-    bi1 = 1.0D+00
-    do k = 1, k0
-      bi1 = bi1 + b(k) * xr ** k
-    end do
-    bi1 = ca * bi1
-
-  end if
-
-  if ( x <= 9.0D+00 ) then
-
-    ct = - ( log ( x / 2.0D+00 ) + el )
-    bk0 = 0.0D+00
-    w0 = 0.0D+00
-    r = 1.0D+00
-    do k = 1, 50
-      w0 = w0 + 1.0D+00 / k
-      r = 0.25D+00 * r / ( k * k ) * x2
-      bk0 = bk0 + r * ( w0 + ct )
-      if ( abs ( ( bk0 - ww ) / bk0 ) < 1.0D-15 ) then
-        exit
-      end if
-      ww = bk0
-    end do
-
-    bk0 = bk0 + ct
-
-  else
-
-    cb = 0.5D+00 / x
-    xr2 = 1.0D+00 / x2
-    bk0 = 1.0D+00
-    do k = 1, 8
-      bk0 = bk0 + a1(k) * xr2 ** k
-    end do
-    bk0 = cb * bk0 / bi0
-
-  end if
-
-  bk1 = ( 1.0D+00 / x - bi1 * bk0 ) / bi0
-  di0 = bi1
-  di1 = bi0 - bi1 / x
-  dk0 = - bk1
-  dk1 = - bk0 - bk1 / x
-
-  return
-end
-subroutine ik01b ( x, bi0, di0, bi1, di1, bk0, dk0, bk1, dk1 )
-
-!*****************************************************************************80
-!
-!! IK01B: Bessel functions I0(x), I1(x), K0(x), and K1(x) and derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    17 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) BI0, DI0, BI1, DI1, BK0, DK0, BK1, DK1, the
-!    values of I0(x), I0'(x), I1(x), I1'(x), K0(x), K0'(x), K1(x), K1'(x).
-!
-  implicit none
-
-  real ( kind = 8 ) bi0
-  real ( kind = 8 ) bi1
-  real ( kind = 8 ) bk0
-  real ( kind = 8 ) bk1
-  real ( kind = 8 ) di0
-  real ( kind = 8 ) di1
-  real ( kind = 8 ) dk0
-  real ( kind = 8 ) dk1
-  real ( kind = 8 ) t
-  real ( kind = 8 ) t2
-  real ( kind = 8 ) x
-
-  if ( x == 0.0D+00 ) then
-
-    bi0 = 1.0D+00
-    bi1 = 0.0D+00
-    bk0 = 1.0D+300
-    bk1 = 1.0D+300
-    di0 = 0.0D+00
-    di1 = 0.5D+00
-    dk0 = -1.0D+300
-    dk1 = -1.0D+300
-    return
-
-  else if ( x <= 3.75D+00 ) then
-
-    t = x / 3.75D+00
-    t2 = t * t
-
-    bi0 = ((((( &
-        0.0045813D+00   * t2 &
-      + 0.0360768D+00 ) * t2 &
-      + 0.2659732D+00 ) * t2 &
-      + 1.2067492D+00 ) * t2 &
-      + 3.0899424D+00 ) * t2 &
-      + 3.5156229D+00 ) * t2 &
-      + 1.0D+00
-
-    bi1 = x * (((((( &
-        0.00032411D+00   * t2 &
-      + 0.00301532D+00 ) * t2 &
-      + 0.02658733D+00 ) * t2 &
-      + 0.15084934D+00 ) * t2 &
-      + 0.51498869D+00 ) * t2 &
-      + 0.87890594D+00 ) * t2 &
-      + 0.5D+00 )
-
-  else
-
-    t = 3.75D+00 / x
-
-    bi0 = (((((((( &
-        0.00392377D+00   * t &
-      - 0.01647633D+00 ) * t &
-      + 0.02635537D+00 ) * t &
-      - 0.02057706D+00 ) * t &
-      + 0.916281D-02 ) * t &
-      - 0.157565D-02 ) * t &
-      + 0.225319D-02 ) * t &
-      + 0.01328592D+00 ) * t &
-      + 0.39894228D+00 ) * exp ( x ) / sqrt ( x )
-
-    bi1 = (((((((( &
-      - 0.420059D-02     * t &
-      + 0.01787654D+00 ) * t &
-      - 0.02895312D+00 ) * t &
-      + 0.02282967D+00 ) * t &
-      - 0.01031555D+00 ) * t &
-      + 0.163801D-02 ) * t &
-      - 0.00362018D+00 ) * t &
-      - 0.03988024D+00 ) * t &
-      + 0.39894228D+00 ) * exp ( x ) / sqrt ( x )
-
-  end if
-
-  if ( x <= 2.0D+00 ) then
-
-    t = x / 2.0D+00
-    t2 = t * t
-
-    bk0 = ((((( &
-        0.0000074D+00   * t2 &
-      + 0.0001075D+00 ) * t2 &
-      + 0.00262698D+00 ) * t2 &
-      + 0.0348859D+00 ) * t2 &
-      + 0.23069756D+00 ) * t2 &
-      + 0.4227842D+00 ) * t2 &
-      - 0.57721566D+00 - bi0 * log ( t )
-
-    bk1 = (((((( &
-      - 0.00004686D+00   * t2 &
-      - 0.00110404D+00 ) * t2 &
-      - 0.01919402D+00 ) * t2 &
-      - 0.18156897D+00 ) * t2 &
-      - 0.67278579D+00 ) * t2 &
-      + 0.15443144D+00 ) * t2 &
-      + 1.0D+00 ) / x + bi1 * log ( t )
-
-  else
-
-    t = 2.0D+00 / x
-    t2 = t * t
-
-    bk0 = (((((( &
-        0.00053208D+00   * t &
-      - 0.0025154D+00 )  * t &
-      + 0.00587872D+00 ) * t &
-      - 0.01062446D+00 ) * t &
-      + 0.02189568D+00 ) * t &
-      - 0.07832358D+00 ) * t &
-      + 1.25331414D+00 ) * exp ( - x ) / sqrt ( x )
-
-    bk1 = (((((( &
-      - 0.00068245D+00   * t &
-      + 0.00325614D+00 ) * t &
-      - 0.00780353D+00 ) * t &
-      + 0.01504268D+00 ) * t &
-      - 0.0365562D+00  ) * t & 
-      + 0.23498619D+00 ) * t &
-      + 1.25331414D+00 ) * exp ( - x ) / sqrt ( x )
-
-  end if
-
-  di0 = bi1
-  di1 = bi0 - bi1 / x
-  dk0 = -bk1
-  dk1 = -bk0 - bk1 / x
-
-  return
-end
-subroutine ikna ( n, x, nm, bi, di, bk, dk )
-
-!*****************************************************************************80
-!
-!! IKNA compute Bessel function In(x) and Kn(x), and derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    16 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order of In(x) and Kn(x).
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, integer ( kind = 4 ) NM, the highest order computed.
-!
-!    Output, real ( kind = 8 ) BI(0:N), DI(0:N), BK(0:N), DK(0:N),
-!    the values of In(x), In'(x), Kn(x), Kn'(x).
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) bi(0:n)
-  real ( kind = 8 ) bi0
-  real ( kind = 8 ) bi1
-  real ( kind = 8 ) bk(0:n)
-  real ( kind = 8 ) bk0
-  real ( kind = 8 ) bk1
-  real ( kind = 8 ) di(0:n)
-  real ( kind = 8 ) di0
-  real ( kind = 8 ) di1
-  real ( kind = 8 ) dk(0:n)
-  real ( kind = 8 ) dk0
-  real ( kind = 8 ) dk1
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) g
-  real ( kind = 8 ) g0
-  real ( kind = 8 ) g1
-  real ( kind = 8 ) h
-  real ( kind = 8 ) h0
-  real ( kind = 8 ) h1
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) s0
-  real ( kind = 8 ) x
-
-  nm = n
-
-  if ( x <= 1.0D-100 ) then
-    do k = 0, n
-      bi(k) = 0.0D+00
-      di(k) = 0.0D+00
-      bk(k) = 1.0D+300
-      dk(k) = -1.0D+300
-    end do
-    bi(0) = 1.0D+00
-    di(1) = 0.5D+00
-    return
-  end if
-
-  call ik01a ( x, bi0, di0, bi1, di1, bk0, dk0, bk1, dk1 )
-  bi(0) = bi0
-  bi(1) = bi1
-  bk(0) = bk0
-  bk(1) = bk1
-  di(0) = di0
-  di(1) = di1
-  dk(0) = dk0
-  dk(1) = dk1
-
-  if ( n <= 1 ) then
-    return
-  end if
-
-  if ( 40.0D+00 < x .and. n < int ( 0.25D+00 * x ) ) then
-
-    h0 = bi0
-    h1 = bi1
-    do k = 2, n
-      h = -2.0D+00 * ( k - 1.0D+00 ) / x * h1 + h0
-      bi(k) = h
-      h0 = h1
-      h1 = h
-    end do
-
-  else
-
-    m = msta1 ( x, 200 )
-
-    if ( m < n ) then
-      nm = m
-    else
-      m = msta2 ( x, n, 15 )
-    end if
-
-    f0 = 0.0D+00
-    f1 = 1.0D-100
-    do k = m, 0, -1
-      f = 2.0D+00 * ( k + 1.0D+00 ) * f1 / x + f0
-      if ( k <= nm ) then
-        bi(k) = f
-      end if
-      f0 = f1
-      f1 = f
-    end do
-    s0 = bi0 / f
-    do k = 0, nm
-      bi(k) = s0 * bi(k)
-    end do
-  end if
-
-  g0 = bk0
-  g1 = bk1
-  do k = 2, nm
-    g = 2.0D+00 * ( k - 1.0D+00 ) / x * g1 + g0
-    bk(k) = g
-    g0 = g1
-    g1 = g
-  end do
-
-  do k = 2, nm
-    di(k) = bi(k-1) - k / x * bi(k)
-    dk(k) = - bk(k-1) - k / x * bk(k)
-  end do
-
-  return
-end
-subroutine iknb ( n, x, nm, bi, di, bk, dk )
-
-!*****************************************************************************80
-!
-!! IKNB compute Bessel function In(x) and Kn(x).
-!
-!  Discussion:
-!
-!    Compute modified Bessel functions In(x) and Kn(x),
-!    and their derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    17 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order of In(x) and Kn(x).
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, integer ( kind = 4 ) NM, the highest order computed.
-!
-!    Output, real ( kind = 8 ) BI(0:N), DI(0:N), BK(0:N), DK(0:N),
-!    the values of In(x), In'(x), Kn(x), Kn'(x).
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) bi(0:n)
-  real ( kind = 8 ) bk(0:n)
-  real ( kind = 8 ) bkl
-  real ( kind = 8 ) bs
-  real ( kind = 8 ) di(0:n)
-  real ( kind = 8 ) dk(0:n)
-  real ( kind = 8 ) el
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) g
-  real ( kind = 8 ) g0
-  real ( kind = 8 ) g1
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k0
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r
-  real ( kind = 8 ) s0
-  real ( kind = 8 ) sk0
-  real ( kind = 8 ) vt
-  real ( kind = 8 ) x
-
-  pi = 3.141592653589793D+00
-  el = 0.5772156649015329d0
-  nm = n
-
-  if ( x <= 1.0D-100 ) then
-    do k = 0, n
-      bi(k) = 0.0D+00
-      di(k) = 0.0D+00
-      bk(k) = 1.0D+300
-      dk(k) = -1.0D+300
-    end do
-    bi(0) = 1.0D+00
-    di(1) = 0.5D+00
-    return
-  end if
-
-  if ( n == 0 ) then
-    nm = 1
-  end if
-
-  m = msta1 ( x, 200 )
-  if ( m < nm ) then
-    nm = m
-  else
-    m = msta2 ( x, nm, 15 )
-  end if
-
-  bs = 0.0D+00
-  sk0 = 0.0D+00
-  f0 = 0.0D+00
-  f1 = 1.0D-100
-  do k = m, 0, -1
-    f = 2.0D+00 * ( k + 1.0D+00 ) / x * f1 + f0
-    if ( k <= nm ) then
-      bi(k) = f
-    end if
-    if ( k /= 0 .and. k == 2 * int ( k / 2 ) ) then
-      sk0 = sk0 + 4.0D+00 * f / k
-    end if
-    bs = bs + 2.0D+00 * f
-    f0 = f1
-    f1 = f
-  end do
-
-  s0 = exp ( x ) / ( bs - f )
-  do k = 0, nm
-    bi(k) = s0 * bi(k)
-  end do
-
-  if ( x <= 8.0D+00 ) then
-    bk(0) = - ( log ( 0.5D+00 * x ) + el ) * bi(0) + s0 * sk0
-    bk(1) = ( 1.0D+00 / x - bi(1) * bk(0) ) / bi(0)
-  else
-    a0 = sqrt ( pi / ( 2.0D+00 * x ) ) * exp ( - x ) 
-
-    if ( x < 25.0D+00 ) then
-      k0 = 16
-    else if ( x < 80.0D+00 ) then
-      k0 = 10
-    else if ( x < 200.0D+00 ) then
-      k0 = 8
-    else
-      k0 = 6
-    end if
-
-    do l = 0, 1
-      bkl = 1.0D+00
-      vt = 4.0D+00 * l
-      r = 1.0D+00
-      do k = 1, k0
-        r = 0.125D+00 * r * ( vt - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * x )
-        bkl = bkl + r
-      end do
-      bk(l) = a0 * bkl
-    end do
-  end if
-
-  g0 = bk(0)
-  g1 = bk(1)
-  do k = 2, nm
-    g = 2.0D+00 * ( k - 1.0D+00 ) / x * g1 + g0
-    bk(k) = g
-    g0 = g1
-    g1 = g
-  end do
-
-  di(0) = bi(1)
-  dk(0) = -bk(1)
-  do k = 1, nm
-    di(k) = bi(k-1) - k / x * bi(k)
-    dk(k) = -bk(k-1) - k / x * bk(k)
-  end do
-
-  return
-end
-subroutine ikv ( v, x, vm, bi, di, bk, dk )
-
-!*****************************************************************************80
-!
-!! IKV compute modified Bessel function Iv(x) and Kv(x) and their derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    17 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) V, the order of Iv(x) and Kv(x).
-!    V = N + V0.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) VM, the highest order computed.
-!
-!    Output, real ( kind = 8 ) BI(0:N), DI(0:N), BK(0:N), DK(0:N), the
-!    values of In+v0(x), In+v0'(x), Kn+v0(x), Kn+v0'(x).
-!
-  implicit none
-
-  real ( kind = 8 ) a1
-  real ( kind = 8 ) a2
-  real ( kind = 8 ) bi(0:*)
-  real ( kind = 8 ) bi0
-  real ( kind = 8 ) bk(0:*)
-  real ( kind = 8 ) bk0
-  real ( kind = 8 ) bk1
-  real ( kind = 8 ) bk2
-  real ( kind = 8 ) ca
-  real ( kind = 8 ) cb
-  real ( kind = 8 ) cs
-  real ( kind = 8 ) ct
-  real ( kind = 8 ) di(0:*)
-  real ( kind = 8 ) dk(0:*)
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) f2
-  real ( kind = 8 ) gan
-  real ( kind = 8 ) gap
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k0
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) piv
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) r2
-  real ( kind = 8 ) sum
-  real ( kind = 8 ) v
-  real ( kind = 8 ) v0
-  real ( kind = 8 ) v0n
-  real ( kind = 8 ) v0p
-  real ( kind = 8 ) vm
-  real ( kind = 8 ) vt
-  real ( kind = 8 ) w0
-  real ( kind = 8 ) wa
-  real ( kind = 8 ) ww
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x2
-
-  pi = 3.141592653589793D+00
-  x2 = x * x
-  n = int ( v )
-  v0 = v - n
-  if ( n == 0 ) then
-    n = 1
-  end if
-
-  if ( x < 1.0D-100 ) then
-
-    do k = 0, n
-      bi(k) = 0.0D+00
-      di(k) = 0.0D+00
-      bk(k) = -1.0D+300
-      dk(k) = 1.0D+300
-    end do
-
-    if ( v == 0.0D+00 ) then
-      bi(0) = 1.0D+00
-      di(1) = 0.5D+00
-    end if
-
-    vm = v
-    return
-
-  end if
-
-  piv = pi * v0
-  vt = 4.0D+00 * v0 * v0
-
-  if ( v0 == 0.0D+00 ) then
-    a1 = 1.0D+00
-  else
-    v0p = 1.0D+00 + v0
-    call gamma ( v0p, gap )
-    a1 = ( 0.5D+00 * x ) ** v0 / gap
-  end if
-
-  if ( x < 35.0D+00 ) then
-    k0 = 14
-  else if ( x < 50.0D+00 ) then
-    k0 = 10
-  else
-    k0 = 8
-  end if
- 
-  if ( x <= 18.0D+00 ) then
-
-    bi0 = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 30
-      r = 0.25D+00 * r * x2 / ( k * ( k + v0 ) )
-      bi0 = bi0 + r
-      if ( abs ( r / bi0 ) < 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    bi0 = bi0 * a1
-
-  else
-
-    ca = exp ( x ) / sqrt ( 2.0D+00 * pi * x )
-    sum = 1.0D+00
-    r = 1.0D+00
-    do k = 1, k0
-      r = -0.125D+00 * r * ( vt - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * x )
-      sum = sum + r
-    end do
-    bi0 = ca * sum
-
-  end if
-
-  m = msta1 ( x, 200 )
-
-  if ( m < n ) then
-    n = m
-  else
-    m = msta2 ( x, n, 15 )
-  end if
-
-  f2 = 0.0D+00
-  f1 = 1.0D-100
-  do k = m, 0, -1
-    f = 2.0D+00 * ( v0 + k + 1.0D+00 ) / x * f1 + f2
-    if ( k <= n ) then
-      bi(k) = f
-    end if
-    f2 = f1
-    f1 = f
-  end do
-
-  cs = bi0 / f
-  do k = 0, n
-    bi(k) = cs * bi(k)
-  end do
-
-  di(0) = v0 / x * bi(0) + bi(1)
-  do k = 1, n
-    di(k) = - ( k + v0 ) / x * bi(k) + bi(k-1)
-  end do
-
-  if ( x <= 9.0D+00 ) then
-
-    if ( v0 == 0.0D+00 ) then
-
-      ct = - log ( 0.5D+00 * x ) - 0.5772156649015329D+00
-      cs = 0.0D+00
-      w0 = 0.0D+00
-      r = 1.0D+00
-      do k = 1, 50
-        w0 = w0 + 1.0D+00 / k
-        r = 0.25D+00 * r / ( k * k ) * x2
-        cs = cs + r * ( w0 + ct )
-        wa = abs ( cs )
-        if ( abs ( ( wa - ww ) / wa ) < 1.0D-15 ) then
-          exit
-        end if
-        ww = wa
-      end do
-
-      bk0 = ct + cs
-
-    else
-
-      v0n = 1.0D+00 - v0
-      call gamma ( v0n, gan )
-      a2 = 1.0D+00 / ( gan * ( 0.5D+00 * x ) ** v0 )
-      a1 = ( 0.5D+00 * x ) ** v0 / gap
-      sum = a2 - a1
-      r1 = 1.0D+00
-      r2 = 1.0D+00
-      do k = 1, 120
-        r1 = 0.25D+00 * r1 * x2 / ( k * ( k - v0 ) )
-        r2 = 0.25D+00 * r2 * x2 / ( k * ( k + v0 ) )
-        sum = sum + a2 * r1 - a1 * r2
-        wa = abs ( sum )
-        if ( abs ( ( wa - ww ) / wa ) < 1.0D-15 ) then
-          exit
-        end if
-        ww = wa
-      end do
-
-      bk0 = 0.5D+00 * pi * sum / sin ( piv )
-
-    end if
-
-  else
-
-    cb = exp ( - x ) * sqrt ( 0.5D+00 * pi / x )
-    sum = 1.0D+00
-    r = 1.0D+00
-    do k = 1, k0
-      r = 0.125D+00 * r * ( vt - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * x )
-      sum = sum + r
-    end do
-    bk0 = cb * sum
-
-  end if
-
-  bk1 = ( 1.0D+00 / x - bi(1) * bk0 ) / bi(0)
-  bk(0) = bk0
-  bk(1) = bk1
-  do k = 2, n
-    bk2 = 2.0D+00 * ( v0 + k - 1.0D+00 ) / x * bk1 + bk0
-    bk(k) = bk2
-    bk0 = bk1
-    bk1 = bk2
-  end do
-
-  dk(0) = v0 / x * bk(0) - bk(1)
-  do k = 1, n
-    dk(k) = - ( k + v0 ) / x * bk(k) - bk(k-1)
-  end do
-
-  vm = n + v0
-
-  return
-end
-subroutine incob ( a, b, x, bix )
-
-!*****************************************************************************80
-!
-!! INCOB computes the incomplete beta function Ix(a,b).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    22 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) A, B, parameters.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) BIX, the function value.
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) b
-  real ( kind = 8 ) bix
-  real ( kind = 8 ) bt
-  real ( kind = 8 ) dk(51)
-  real ( kind = 8 ) fk(51)
-  integer ( kind = 4 ) k
-  real ( kind = 8 ) s0
-  real ( kind = 8 ) t1
-  real ( kind = 8 ) t2
-  real ( kind = 8 ) ta
-  real ( kind = 8 ) tb
-  real ( kind = 8 ) x
-
-  s0 = ( a + 1.0D+00 ) / ( a + b + 2.0D+00 )
-  call beta ( a, b, bt )
-
-  if ( x <= s0 ) then
-
-    do k = 1, 20
-      dk(2*k) = k * ( b - k ) * x / &
-        ( a + 2.0D+00 * k - 1.0D+00 ) / ( a + 2.0D+00 * k )
-    end do
-
-    do k = 0, 20
-      dk(2*k+1) = - ( a + k ) * ( a + b + k ) * x &
-        / ( a + 2.0D+00 * k ) / ( a + 2.0D+00 * k + 1.0D+00 )
-    end do
-
-    t1 = 0.0D+00
-    do k = 20, 1, -1
-      t1 = dk(k) / ( 1.0D+00 + t1 )
-    end do
-    ta = 1.0D+00 / ( 1.0D+00 + t1 )
-    bix = x ** a * ( 1.0D+00 - x ) ** b / ( a * bt ) * ta
-
-  else
-
-    do k = 1, 20
-      fk(2*k) = k * ( a - k ) * ( 1.0D+00 - x ) &
-        / ( b + 2.0D+00 * k - 1.0D+00 ) / ( b + 2.0D+00 * k )
-    end do
-
-    do k = 0,20
-      fk(2*k+1) = - ( b + k ) * ( a + b + k ) * ( 1.0D+00 - x ) &
-        / ( b + 2.0D+00 * k ) / ( b + 2.0D+00 * k + 1.0D+00 )
-    end do
-
-    t2 = 0.0D+00
-    do k = 20, 1, -1
-      t2 = fk(k) / ( 1.0D+00 + t2 )
-    end do
-    tb = 1.0D+00 / ( 1.0D+00 + t2 )
-    bix = 1.0D+00 - x ** a * ( 1.0D+00 - x ) ** b / ( b * bt ) * tb
-
-  end if
-
-  return
-end
-subroutine incog ( a, x, gin, gim, gip )
-
-!*****************************************************************************80
-!
-!! INCOG computes the incomplete gamma function r(a,x), ,(a,x), P(a,x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    22 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) A, the parameter.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) GIN, GIM, GIP, the values of
-!    r(a,x), â(a,x), P(a,x).
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) ga
-  real ( kind = 8 ) gim
-  real ( kind = 8 ) gin
-  real ( kind = 8 ) gip
-  integer ( kind = 4 ) k
-  real ( kind = 8 ) r
-  real ( kind = 8 ) s
-  real ( kind = 8 ) t0
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xam
-
-  xam = -  x + a * log ( x )
-
-  if ( 700.0D+00 < xam .or. 170.0D+00 < a ) then
-    write ( *, '(a)' ) ' '
-    write ( *, '(a)' ) 'INCOG - Fatal error!'
-    write ( *, '(a)' ) '  A and/or X is too large!'
-    stop
-  end if
-
-  if ( x == 0.0D+00 ) then
-
-    gin = 0.0D+00
-    call gamma ( a, ga )
-    gim = ga
-    gip = 0.0D+00
-
-  else if ( x <= 1.0D+00 + a ) then
-
-    s = 1.0D+00 / a
-    r = s
-    do k = 1, 60
-      r = r * x / ( a + k )
-      s = s + r
-      if ( abs ( r / s ) < 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    gin = exp ( xam ) * s
-    call gamma ( a, ga )
-    gip = gin / ga
-    gim = ga - gin
-
-  else if ( 1.0D+00 + a < x ) then
-
-    t0 = 0.0D+00
-    do k = 60, 1, -1
-      t0 = ( k - a ) / ( 1.0D+00 + k / ( x + t0 ) )
-    end do
-    gim = exp ( xam ) / ( x + t0 )
-    call gamma ( a, ga )
-    gin = ga - gim
-    gip = 1.0D+00 - gim / ga
-
-  end if
-
-  return
-end
-subroutine itairy ( x, apt, bpt, ant, bnt )
-
-!****************************************************************************80
-!
-!! ITAIRY computes the integrals of Airy functions.
-!
-!  Discussion:
-!
-!    Compute the integrals of Airy functions with respect to t,
-!    from 0 and x.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    19 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the upper limit of the integral.
-!
-!    Output, real ( kind = 8 ) APT, BPT, ANT, BNT, the integrals, from 0 to x,
-!    of Ai(t), Bi(t), Ai(-t), and Bi(-t).
-!       
-  implicit none
-
-  real ( kind = 8 ), save, dimension ( 16 ) :: a = (/ &
-    0.569444444444444D+00, 0.891300154320988D+00, &
-    0.226624344493027D+01, 0.798950124766861D+01, &
-    0.360688546785343D+02, 0.198670292131169D+03, &
-    0.129223456582211D+04, 0.969483869669600D+04, &
-    0.824184704952483D+05, 0.783031092490225D+06, &
-    0.822210493622814D+07, 0.945557399360556D+08, &
-    0.118195595640730D+10, 0.159564653040121D+11, &
-    0.231369166433050D+12, 0.358622522796969D+13 /)
-  real ( kind = 8 ) ant
-  real ( kind = 8 ) apt
-  real ( kind = 8 ) bnt
-  real ( kind = 8 ) bpt
-  real ( kind = 8 ) c1
-  real ( kind = 8 ) c2
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) fx
-  real ( kind = 8 ) gx
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) l
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) q0
-  real ( kind = 8 ) q1
-  real ( kind = 8 ) q2
-  real ( kind = 8 ) r
-  real ( kind = 8 ) sr3
-  real ( kind = 8 ) su1
-  real ( kind = 8 ) su2
-  real ( kind = 8 ) su3
-  real ( kind = 8 ) su4
-  real ( kind = 8 ) su5
-  real ( kind = 8 ) su6
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xe
-  real ( kind = 8 ) xp6
-  real ( kind = 8 ) xr1
-  real ( kind = 8 ) xr2
-
-  eps = 1.0D-15
-  pi = 3.141592653589793D+00
-  c1 = 0.355028053887817D+00
-  c2 = 0.258819403792807D+00
-  sr3 = 1.732050807568877D+00
-
-  if ( x == 0.0D+00 ) then
-
-    apt = 0.0D+00
-    bpt = 0.0D+00
-    ant = 0.0D+00
-    bnt = 0.0D+00
-
-  else
-
-    if ( abs ( x ) <= 9.25D+00 ) then
-
-      do l = 0, 1
-
-        x = ( -1.0D+00 ) ** l * x
-        fx = x
-        r = x
-
-        do k = 1, 40
-          r = r * ( 3.0D+00 * k - 2.0D+00 ) &
-            / ( 3.0D+00 * k + 1.0D+00 ) * x / ( 3.0D+00 * k ) &
-            * x / ( 3.0D+00 * k - 1.0D+00 ) * x 
-          fx = fx + r
-          if ( abs ( r ) < abs ( fx ) * eps ) then
-            exit
-          end if
-        end do
-
-        gx = 0.5D+00 * x * x
-        r = gx
-
-        do k = 1, 40
-          r = r * ( 3.0D+00 * k - 1.0D+00 ) &
-            / ( 3.0D+00 * k + 2.0D+00 ) * x / ( 3.0D+00 * k ) * x &
-            / ( 3.0D+00 * k + 1.0D+00 ) * x
-          gx = gx + r
-          if ( abs ( r ) < abs ( gx ) * eps ) then
-            exit
-          end if
-        end do
-
-        ant = c1 * fx - c2 * gx
-        bnt = sr3 * ( c1 * fx + c2 * gx )
-
-        if ( l == 0 ) then
-          apt = ant
-          bpt = bnt
-        else
-          ant = -ant
-          bnt = -bnt
-          x = -x
-        end if
-
-      end do
-
-    else
-
-      q2 = 1.414213562373095D+00
-      q0 = 0.3333333333333333D+00
-      q1 = 0.6666666666666667D+00
-      xe = x * sqrt ( x ) / 1.5D+00
-      xp6 = 1.0D+00 / sqrt ( 6.0D+00 * pi * xe )
-      su1 = 1.0D+00
-      r = 1.0D+00
-      xr1 = 1.0D+00 / xe
-      do k = 1, 16
-        r = - r * xr1
-        su1 = su1 + a(k) * r
-      end do
-      su2 = 1.0D+00
-      r = 1.0D+00
-      do k = 1, 16
-        r = r * xr1
-        su2 = su2 + a(k) * r
-      end do
-
-      apt = q0 - exp ( - xe ) * xp6 * su1
-      bpt = 2.0D+00 * exp ( xe ) * xp6 * su2
-      su3 = 1.0D+00
-      r = 1.0D+00
-      xr2 = 1.0D+00 / ( xe * xe )
-      do k = 1, 8
-        r = - r * xr2
-        su3 = su3 + a(2*k) * r
-      end do
-      su4 = a(1) * xr1
-      r = xr1
-      do k = 1, 7
-        r = -r * xr2
-        su4 = su4 + a(2*k+1) * r
-      end do
-      su5 = su3 + su4
-      su6 = su3 - su4
-      ant = q1 - q2 * xp6 * ( su5 * cos ( xe ) - su6 * sin ( xe ) )
-      bnt = q2 * xp6 * ( su5 * sin ( xe ) + su6 * cos ( xe ) )
-
-    end if
-
-  end if
-
-  return
-end
-subroutine itika ( x, ti, tk )
-
-!*****************************************************************************80
-!
-!! ITIKA computes the integral of the modified Bessel functions I0(t) and K0(t).
-!
-!  Discussion:
-!
-!    This procedure integrates modified Bessel functions I0(t) and
-!    K0(t) with respect to t from 0 to x.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    18 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the upper limit of the integral.
-!
-!    Output, real ( kind = 8 ) TI, TK, the integrals of I0(t) and K0(t)
-!    from 0 to X.
-!
-  implicit none
-
-  real ( kind = 8 ), save, dimension ( 10 ) :: a = (/ &
-    0.625D+00,           1.0078125D+00, &
-    2.5927734375D+00,    9.1868591308594D+00, &
-    4.1567974090576D+01, 2.2919635891914D+02, &
-    1.491504060477D+03,  1.1192354495579D+04, &
-    9.515939374212D+04,  9.0412425769041D+05 /)
-  real ( kind = 8 ) b1
-  real ( kind = 8 ) b2
-  real ( kind = 8 ) e0
-  real ( kind = 8 ) el
-  integer ( kind = 4 ) k
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r
-  real ( kind = 8 ) rc1
-  real ( kind = 8 ) rc2
-  real ( kind = 8 ) rs
-  real ( kind = 8 ) ti
-  real ( kind = 8 ) tk
-  real ( kind = 8 ) tw
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x2
-
-  pi = 3.141592653589793D+00
-  el = 0.5772156649015329D+00
-
-  if ( x == 0.0D+00 ) then
-
-    ti = 0.0D+00
-    tk = 0.0D+00
-    return
-
-  else if ( x < 20.0D+00 ) then
-
-    x2 = x * x
-    ti = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 50
-      r = 0.25D+00 * r * ( 2 * k - 1.0D+00 ) / ( 2 * k + 1.0D+00 ) &
-        / ( k * k ) * x2
-      ti = ti + r
-      if ( abs ( r / ti ) < 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    ti = ti * x
-
-  else
-
-    ti = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 10
-      r = r / x
-      ti = ti + a(k) * r
-    end do
-    rc1 = 1.0D+00 / sqrt ( 2.0D+00 * pi * x )
-    ti = rc1 * exp ( x ) * ti
-
-  end if
-
-  if ( x < 12.0D+00 ) then
-
-    e0 = el + log ( x / 2.0D+00 )
-    b1 = 1.0D+00 - e0
-    b2 = 0.0D+00
-    rs = 0.0D+00
-    r = 1.0D+00
-    do k = 1, 50
-      r = 0.25D+00 * r * ( 2 * k - 1.0D+00 ) &
-        / ( 2 * k + 1.0D+00 ) / ( k * k ) * x2
-      b1 = b1 + r * ( 1.0D+00 / ( 2 * k + 1 ) - e0 )
-      rs = rs + 1.0D+00 / k
-      b2 = b2 + r * rs
-      tk = b1 + b2
-      if ( abs ( ( tk - tw ) / tk ) < 1.0D-12 ) then
-        exit
-      end if
-      tw = tk
-    end do
-
-    tk = tk * x
-
-  else
-
-    tk = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 10
-      r = -r / x
-      tk = tk + a(k) * r
-    end do 
-    rc2 = sqrt ( pi / ( 2.0D+00 * x ) )
-    tk = pi / 2.0D+00 - rc2 * tk * exp ( - x )
-
-  end if
-
-  return
-end
-subroutine itikb ( x, ti, tk )
-
-!*****************************************************************************80
-!
-!! ITIKB computes the integral of the Bessel functions I0(t) and K0(t).
-!
-!  Discussion:
-!
-!    This procedure integrates Bessel functions I0(t) and K0(t)
-!    with respect to t from 0 to x.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    24 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-! 
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the upper limit of the integral.
-!
-!    Output, real ( kind = 8 ) TI, TK, the integral of I0(t) and K0(t)
-!    from 0 to X.
-!
-  implicit none
-
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) t
-  real ( kind = 8 ) t1
-  real ( kind = 8 ) ti
-  real ( kind = 8 ) tk
-  real ( kind = 8 ) x
-
-  pi = 3.141592653589793D+00
-
-  if ( x == 0.0D+00 ) then
-
-    ti = 0.0D+00
-
-  else if ( x < 5.0D+00 ) then
-
-    t1 = x / 5.0D+00
-    t = t1 * t1
-    ti = (((((((( &
-        0.59434D-03 * t &
-      + 0.4500642D-02 ) * t &
-      + 0.044686921D+00 ) * t &
-      + 0.300704878D+00 ) * t &
-      + 1.471860153D+00 ) * t &
-      + 4.844024624D+00 ) * t &
-      + 9.765629849D+00 ) * t &
-      +10.416666367D+00 ) * t &
-      + 5.0D+00 ) * t1
-
-  else if ( 5.0D+00 <= x .and. x <= 8.0D+00 ) then
-
-    t = 5.0D+00 / x
-    ti = ((( &
-      - 0.015166D+00 * t &
-      - 0.0202292D+00 ) * t &
-      + 0.1294122D+00 ) * t &
-      - 0.0302912D+00 ) * t &
-      + 0.4161224D+00
-    ti = ti * exp ( x ) / sqrt ( x )
-
-  else
-
-    t = 8.0D+00 / x
-    ti = ((((( &
-      - 0.0073995D+00 * t &
-      + 0.017744D+00 ) * t &
-      - 0.0114858D+00 ) * t &
-      + 0.55956D-02 ) * t &
-      + 0.59191D-02 ) * t &
-      + 0.0311734D+00 ) * t &
-      + 0.3989423D+00
-    ti = ti * exp ( x ) / sqrt ( x )
-
-  end if
-
-  if ( x == 0.0D+00 ) then
-
-    tk = 0.0D+00
-
-  else if ( x <= 2.0D+00 ) then
-
-    t1 = x / 2.0D+00
-    t = t1 * t1
-    tk = (((((( &
-        0.116D-05        * t &
-      + 0.2069D-04 )     * t &
-      + 0.62664D-03 )    * t &
-      + 0.01110118D+00 ) * t &
-      + 0.11227902D+00 ) * t &
-      + 0.50407836D+00 ) * t &
-      + 0.84556868D+00 ) * t1
-    tk = tk - log ( x / 2.0D+00 ) * ti
-
-  else if ( 2.0D+00 < x .and. x <= 4.0D+00 ) then
-
-    t = 2.0D+00 / x
-    tk = ((( &
-        0.0160395D+00   * t &
-      - 0.0781715D+00 ) * t &
-      + 0.185984D+00 )  * t &
-      - 0.3584641D+00 ) * t &
-      + 1.2494934D+00
-    tk = pi / 2.0D+00 - tk * exp ( - x ) / sqrt ( x )
-
-  else if ( 4.0D+00 < x .and. x <= 7.0D+00 ) then
-
-    t = 4.0D+00 / x
-    tk = ((((( &
-        0.37128D-02 * t &
-      - 0.0158449D+00 ) * t &
-      + 0.0320504D+00 ) * t &
-      - 0.0481455D+00 ) * t &
-      + 0.0787284D+00 ) * t &
-      - 0.1958273D+00 ) * t &
-      + 1.2533141D+00
-    tk = pi / 2.0D+00 - tk * exp ( - x ) / sqrt ( x )
-
-  else
-
-    t = 7.0D+00 / x
-    tk = ((((( &
-        0.33934D-03      * t &
-      - 0.163271D-02 )   * t &
-      + 0.417454D-02 )   * t &
-      - 0.933944D-02 )   * t &
-      + 0.02576646D+00 ) * t &
-      - 0.11190289D+00 ) * t &
-      + 1.25331414D+00
-    tk = pi / 2.0D+00 - tk * exp ( - x ) / sqrt ( x )
-
-  end if
-
-  return
-end
-subroutine itjya ( x, tj, ty )
-
-!*****************************************************************************80
-!
-!! ITJYA computes integrals of Bessel functions J0(t) and Y0(t).
-!
-!  Discussion:
-!
-!    This procedure integrates Bessel functions J0(t) and Y0(t) with
-!    respect to t from 0 to x.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    25 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the upper limit of the integral.
-!
-!    Output, real ( kind = 8 ) TJ, TY, the integrals of J0(t) and Y0(t) 
-!    from 0 to x.
-!
-  implicit none
-
-  real ( kind = 8 ) a(18)
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) a1
-  real ( kind = 8 ) af
-  real ( kind = 8 ) bf
-  real ( kind = 8 ) bg
-  real ( kind = 8 ) el
-  real ( kind = 8 ) eps
-  integer ( kind = 4 ) k
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r2
-  real ( kind = 8 ) rc
-  real ( kind = 8 ) rs
-  real ( kind = 8 ) tj
-  real ( kind = 8 ) ty
-  real ( kind = 8 ) ty1
-  real ( kind = 8 ) ty2
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x2
-  real ( kind = 8 ) xp
-
-  pi = 3.141592653589793D+00
-  el = 0.5772156649015329D+00
-  eps = 1.0D-12
-
-  if ( x == 0.0D+00 ) then
-
-    tj = 0.0D+00
-    ty = 0.0D+00
-
-  else if ( x <= 20.0D+00 ) then
-
-    x2 = x * x
-    tj = x
-    r = x
-    do k = 1, 60
-      r = -0.25D+00 * r * ( 2 * k - 1.0D+00 ) / ( 2 * k + 1.0D+00 ) &
-        / ( k * k ) * x2
-      tj = tj + r
-      if ( abs ( r ) < abs ( tj ) * eps ) then
-        exit
-      end if
-    end do
-
-    ty1 = ( el + log ( x / 2.0D+00 ) ) * tj
-    rs = 0.0D+00
-    ty2 = 1.0D+00
-    r = 1.0D+00
-
-    do k = 1, 60
-      r = -0.25D+00 * r * ( 2 * k - 1.0D+00 ) / ( 2 * k + 1.0D+00 ) &
-        / ( k * k ) * x2
-      rs = rs + 1.0D+00 / k
-      r2 = r * ( rs + 1.0D+00 / ( 2.0D+00 * k + 1.0D+00 ) )
-      ty2 = ty2 + r2
-      if ( abs ( r2 ) < abs ( ty2 ) * eps ) then
-        exit
-      end if
-    end do
-
-    ty = ( ty1 - x * ty2 ) * 2.0D+00 / pi
-
-  else
-
-    a0 = 1.0D+00
-    a1 = 5.0D+00 / 8.0D+00
-    a(1) = a1
-
-    do k = 1, 16
-      af = ( ( 1.5D+00 * ( k + 0.5D+00 ) * ( k + 5.0D+00 / 6.0D+00 ) &
-        * a1 - 0.5D+00 * ( k + 0.5D+00 ) * ( k + 0.5D+00 )  &
-        * ( k - 0.5D+00 ) * a0 ) ) / ( k + 1.0D+00 )
-      a(k+1) = af
-      a0 = a1
-      a1 = af
-    end do
-
-    bf = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 8
-      r = -r / ( x * x )
-      bf = bf + a(2*k) * r
-    end do
-    bg = a(1) / x
-    r = 1.0D+00 / x
-    do k = 1, 8
-      r = -r / ( x * x )
-      bg = bg + a(2*k+1) * r
-    end do
-    xp = x + 0.25D+00 * pi
-    rc = sqrt ( 2.0D+00 / ( pi * x ) )
-    tj = 1.0D+00 - rc * ( bf * cos ( xp ) + bg * sin ( xp ) )
-    ty = rc * ( bg * cos ( xp ) - bf * sin ( xp ) )
-
-  end if
-
-  return
-end
-subroutine itjyb ( x, tj, ty )
-
-!*****************************************************************************80
-!
-!! ITJYB computes integrals of Bessel functions J0(t) and Y0(t).
-!
-!  Discussion:
-!
-!    This procedure integrates Bessel functions J0(t) and Y0(t)
-!    with respect to t from 0 to x.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    25 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the upper limit of the integral.
-!
-!    Output, real ( kind = 8 ) TJ, TY, the integrals of J0(t) and Y0(t) 
-!    from 0 to x.
-!
-  implicit none
-
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) g0
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) t
-  real ( kind = 8 ) tj
-  real ( kind = 8 ) ty
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x1
-  real ( kind = 8 ) xt
-
-  pi = 3.141592653589793D+00
-
-  if ( x == 0.0D+00 ) then
-
-    tj = 0.0D+00
-    ty = 0.0D+00
-
-  else if ( x <= 4.0D+00 ) then
-
-    x1 = x / 4.0D+00
-    t = x1 * x1
-
-    tj = ((((((( &
-      - 0.133718D-03      * t &
-      + 0.2362211D-02 )   * t &
-      - 0.025791036D+00 ) * t &
-      + 0.197492634D+00 ) * t &
-      - 1.015860606D+00 ) * t &
-      + 3.199997842D+00 ) * t &
-      - 5.333333161D+00 ) * t &
-      + 4.0D+00 ) * x1
-
-    ty = (((((((( &
-        0.13351D-04       * t &
-      - 0.235002D-03 )    * t &
-      + 0.3034322d-02 )   * t &
-      - 0.029600855D+00 ) * t &
-      + 0.203380298D+00 ) * t &
-      - 0.904755062D+00 ) * t &
-      + 2.287317974D+00 ) * t &
-      - 2.567250468D+00 ) * t &
-      + 1.076611469D+00 ) * x1
-
-    ty = 2.0D+00 / pi * log ( x / 2.0D+00 ) * tj - ty
-
-  else if ( x <= 8.0D+00 ) then
-
-    xt = x - 0.25D+00 * pi
-    t = 16.0D+00 / ( x * x )
-
-    f0 = (((((( &
-        0.1496119D-02     * t &
-      - 0.739083D-02 )    * t &
-      + 0.016236617D+00 ) * t &
-      - 0.022007499D+00 ) * t &
-      + 0.023644978D+00 ) * t &
-      - 0.031280848D+00 ) * t &
-      + 0.124611058D+00 ) * 4.0D+00 / x
-
-    g0 = ((((( &
-        0.1076103D-02     * t &
-      - 0.5434851D-02 )   * t &
-      + 0.01242264D+00 )  * t &
-      - 0.018255209D+00 ) * t &
-      + 0.023664841D+00 ) * t &
-      - 0.049635633D+00 ) * t &
-      + 0.79784879D+00
-
-    tj = 1.0D+00 - ( f0 * cos ( xt ) - g0 * sin ( xt ) ) / sqrt ( x )
-
-    ty = - ( f0 * sin ( xt ) + g0 * cos ( xt ) ) / sqrt ( x )
-
-  else
-
-    t = 64.0D+00 / ( x * x )
-    xt = x-0.25D+00 * pi
-
-    f0 = ((((((( &
-      - 0.268482D-04     * t &
-      + 0.1270039D-03 )  * t &
-      - 0.2755037D-03 )  * t &
-      + 0.3992825D-03 )  * t &
-      - 0.5366169D-03 )  * t &
-      + 0.10089872D-02 ) * t &
-      - 0.40403539D-02 ) * t &
-      + 0.0623347304D+00 ) * 8.0D+00 / x
-
-    g0 = (((((( &
-      - 0.226238D-04        * t &
-      + 0.1107299D-03 )     * t &
-      - 0.2543955D-03 )     * t &
-      + 0.4100676D-03 )     * t &
-      - 0.6740148D-03 )     * t &
-      + 0.17870944D-02 )    * t &
-      - 0.01256424405D+00 ) * t &
-      + 0.79788456D+00
-
-    tj = 1.0D+00  - ( f0 * cos ( xt ) - g0 * sin ( xt ) ) / sqrt ( x )
-
-    ty = - ( f0 * sin ( xt ) + g0 * cos ( xt ) ) / sqrt ( x )
-
-  end if
-
-  return
-end
-subroutine itsh0 ( x, th0 )
-
-!*****************************************************************************80
-!
-!! ITSH0 integrates the Struve function H0(t) from 0 to x.
-!
-!  Discussion:
-!
-!    This procedure evaluates the integral of Struve function
-!    H0(t) with respect to t from 0 and x.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    25 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the upper limit of the integral.
-!
-!    Output, real ( kind = 8 ) TH0, the integral of H0(t) from 0 to x.
-!
-  implicit none
-
-  real ( kind = 8 ) a(25)
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) a1
-  real ( kind = 8 ) af
-  real ( kind = 8 ) bf
-  real ( kind = 8 ) bg
-  real ( kind = 8 ) el
-  integer ( kind = 4 ) k
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r
-  real ( kind = 8 ) rd
-  real ( kind = 8 ) s
-  real ( kind = 8 ) s0
-  real ( kind = 8 ) th0
-  real ( kind = 8 ) ty
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xp
-
-  pi = 3.141592653589793D+00
-  r = 1.0D+00            
-
-  if ( x <= 30.0D+00 ) then
-
-    s = 0.5D+00
-
-    do k = 1, 100
-
-      if ( k == 1 ) then
-        rd = 0.5D+00
-      else
-        rd = 1.0D+00
-      end if
-
-      r = - r * rd * k / ( k + 1.0D+00 ) &
-        * ( x / ( 2.0D+00 * k + 1.0D+00 ) ) ** 2
-      s = s + r
-
-      if ( abs ( r ) < abs ( s ) * 1.0D-12 ) then
-        exit
-      end if
-
-    end do
-
-    th0 = 2.0D+00 / pi * x * x * s
-
-  else
-
-    s = 1.0D+00
-    do k = 1, 12
-      r = - r * k / ( k + 1.0D+00 ) &
-        * ( ( 2.0D+00 * k + 1.0D+00 ) / x ) ** 2
-      s = s + r
-      if ( abs ( r ) < abs ( s ) * 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    el = 0.57721566490153D+00
-    s0 = s / ( pi * x * x ) + 2.0D+00 / pi &
-      * ( log ( 2.0D+00 * x ) + el )
-    a0 = 1.0D+00
-    a1 = 5.0D+00 / 8.0D+00
-    a(1) = a1
-    do k = 1, 20
-      af = ( ( 1.5D+00 * ( k + 0.5D+00 ) &
-        * ( k + 5.0D+00 / 6.0D+00 ) * a1 - 0.5D+00 &
-        * ( k + 0.5D+00 ) * ( k + 0.5D+00 ) &
-        * ( k - 0.5D+00 ) * a0 ) ) / ( k + 1.0D+00 )
-      a(k+1) = af
-      a0 = a1
-      a1 = af
-    end do
-
-    bf = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 10
-      r = - r / ( x * x )
-      bf = bf + a(2*k) * r
-    end do
-    bg = a(1) / x
-    r = 1.0D+00 / x
-    do k = 1, 10
-      r = - r / ( x * x ) 
-      bg = bg + a(2*k+1) * r
-    end do
-    xp = x + 0.25D+00 * pi
-    ty = sqrt ( 2.0D+00 / ( pi * x ) ) &
-      * ( bg * cos ( xp ) - bf * sin ( xp ) )
-    th0 = ty + s0
-
-  end if
-
-  return
-end
-subroutine itsl0 ( x, tl0 )
-
-!*****************************************************************************80
-!
-!! ITSL0 integrates the Struve function L0(t) from 0 to x.
-!
-!  Discussion:
-!
-!    This procedure evaluates the integral of modified Struve function
-!    L0(t) with respect to t from 0 to x.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    31 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the upper limit of the integral.
-!
-!    Output, real ( kind = 8 ) TL0, the integral of L0(t) from 0 to x.
-!
-  implicit none
-
-  real ( kind = 8 ) a(18)
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) a1
-  real ( kind = 8 ) af
-  real ( kind = 8 ) el
-  integer ( kind = 4 ) k
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r
-  real ( kind = 8 ) rd
-  real ( kind = 8 ) s
-  real ( kind = 8 ) s0
-  real ( kind = 8 ) ti
-  real ( kind = 8 ) tl0
-  real ( kind = 8 ) x
-
-  pi = 3.141592653589793D+00
-  r = 1.0D+00
-
-  if ( x <= 20.0D+00 ) then
-
-    s = 0.5D+00
-    do k = 1, 100
- 
-      if ( k == 1 ) then
-        rd = 0.5D+00
-      else
-        rd = 1.0D+00
-      end if
-      r = r * rd * k / ( k + 1.0D+00 ) &
-        * ( x / ( 2.0D+00 * k + 1.0D+00 ) ) ** 2
-      s = s + r
-      if ( abs ( r / s ) < 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    tl0 = 2.0D+00 / pi * x * x * s
-
-  else
-
-    s = 1.0D+00
-    do k = 1, 10
-      r = r * k / ( k + 1.0D+00 ) &
-        * ( ( 2.0D+00 * k + 1.0D+00 ) / x ) ** 2
-      s = s + r
-      if ( abs ( r / s ) < 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    el = 0.57721566490153D+00
-    s0 = - s / ( pi * x * x ) + 2.0D+00 / pi &
-      * ( log ( 2.0D+00 * x ) + el )
-    a0 = 1.0D+00
-    a1 = 5.0D+00 / 8.0D+00
-    a(1) = a1
-    do k = 1, 10
-      af = ( ( 1.5D+00 * ( k + 0.50D+00 ) &
-        * ( k + 5.0D+00 / 6.0D+00 ) * a1 - 0.5D+00 &
-        * ( k + 0.5D+00 ) ** 2 * ( k -0.5D+00 ) * a0 ) ) &
-        / ( k + 1.0D+00 )
-      a(k+1) = af
-      a0 = a1
-      a1 = af
-    end do
-
-    ti = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 11
-      r = r / x
-      ti = ti + a(k) * r
-    end do
-    tl0 = ti / sqrt ( 2.0D+00 * pi * x ) * exp ( x ) + s0
-
-  end if
-
-  return
-end
-subroutine itth0 ( x, tth )
-
-!*****************************************************************************80
-!
-!! ITTH0 integrates H0(t)/t from x to oo.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    23 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the lower limit of the integral.
-!
-!    Output, real ( kind = 8 ) TTH, the integral of H0(t)/t from x to oo.
-!
-  implicit none
-
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) g0
-  integer ( kind = 4 ) k
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r
-  real ( kind = 8 ) s
-  real ( kind = 8 ) t
-  real ( kind = 8 ) tth
-  real ( kind = 8 ) tty
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xt
-
-  pi = 3.141592653589793D+00
-  s = 1.0D+00
-  r = 1.0D+00
-
-  if ( x < 24.5D+00 ) then
-
-    do k = 1, 60
-      r = - r * x * x * ( 2.0D+00 * k - 1.0D+00 ) &
-        / ( 2.0D+00 * k + 1.0D+00 ) ** 3
-      s = s + r
-      if ( abs ( r ) < abs ( s ) * 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    tth = pi / 2.0D+00 - 2.0D+00 / pi * x * s
-
-  else
-
-    do k = 1, 10
-      r = - r * ( 2.0D+00 * k - 1.0D+00 ) ** 3 &
-        / ( ( 2.0D+00 * k + 1.0D+00 ) * x * x )
-      s = s + r
-      if ( abs ( r ) < abs ( s ) * 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    tth = 2.0D+00 / ( pi * x ) * s
-    t = 8.0D+00 / x
-    xt = x + 0.25D+00 * pi
-    f0 = ((((( &
-        0.18118D-02 * t &
-      - 0.91909D-02 ) * t &
-      + 0.017033D+00 ) * t &
-      - 0.9394D-03 ) * t &
-      - 0.051445D+00 ) * t &
-      - 0.11D-05 ) * t &
-      + 0.7978846D+00
-    g0 = ((((( &
-      - 0.23731D-02 * t &
-      + 0.59842D-02 ) * t &
-      + 0.24437D-02 ) * t &
-      - 0.0233178D+00 ) * t &
-      + 0.595D-04 ) * t &
-      + 0.1620695D+00 ) * t
-    tty = ( f0 * sin ( xt ) - g0 * cos ( xt ) ) / ( sqrt ( x ) * x )
-    tth = tth + tty
-
-    end if
-
-  return
-end
-subroutine ittika ( x, tti, ttk )
-
-!*****************************************************************************80
-!
-!! ITTIKA integrates (I0(t)-1)/t from 0 to x, K0(t)/t from x to infinity.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    23 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the integral limit.
-!
-!    Output, real ( kind = 8 ) TTI, TTK, the integrals of [I0(t)-1]/t 
-!    from 0 to x, and of K0(t)/t from x to oo.
-!
-  implicit none
-
-  real ( kind = 8 ) b1
-  real ( kind = 8 ), save, dimension ( 8 ) :: c = (/ &
-    1.625D+00, 4.1328125D+00, &
-    1.45380859375D+01, 6.553353881835D+01, &
-    3.6066157150269D+02, 2.3448727161884D+03, &
-    1.7588273098916D+04, 1.4950639538279D+05 /)
-  real ( kind = 8 ) e0
-  real ( kind = 8 ) el
-  integer ( kind = 4 ) k
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r2
-  real ( kind = 8 ) rc
-  real ( kind = 8 ) rs
-  real ( kind = 8 ) tti
-  real ( kind = 8 ) ttk
-  real ( kind = 8 ) x
-
-  pi = 3.141592653589793D+00
-  el = 0.5772156649015329D+00
-
-  if ( x == 0.0D+00 ) then
-    tti = 0.0D+00
-    ttk = 1.0D+300
-    return
-  end if
-
-  if ( x < 40.0D+00 ) then
-    tti = 1.0D+00
-    r = 1.0D+00
-    do k = 2, 50
-      r = 0.25D+00 * r * ( k - 1.0D+00 ) / ( k * k * k ) * x * x
-      tti = tti + r
-      if ( abs ( r / tti ) < 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    tti = tti * 0.125D+00 * x * x
-
-  else
-
-    tti = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 8
-      r = r / x
-      tti = tti + c(k) * r
-    end do
-    rc = x * sqrt ( 2.0D+00 * pi * x )
-    tti = tti * exp ( x ) / rc
-
-  end if
-
-  if ( x <= 12.0D+00 ) then
-
-    e0 = ( 0.5D+00 * log ( x / 2.0D+00 ) + el ) &
-      * log ( x / 2.0D+00 ) + pi * pi / 24.0D+00 + 0.5D+00 * el * el
-    b1 = 1.5D+00 - ( el + log ( x / 2.0D+00 ) )
-    rs = 1.0D+00
-    r = 1.0D+00
-    do k = 2, 50
-      r = 0.25D+00 * r * ( k - 1.0D+00 ) / ( k * k * k ) * x * x
-      rs = rs + 1.0D+00 / k
-      r2 = r * ( rs + 1.0D+00 / ( 2.0D+00 * k ) &
-        - ( el + log ( x / 2.0D+00 ) ) )
-      b1 = b1 + r2
-      if ( abs ( r2 / b1 ) < 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    ttk = e0 - 0.125D+00 * x * x * b1
-
-  else
-
-    ttk = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 8
-      r = - r / x
-      ttk = ttk + c(k) * r
-    end do
-    rc = x * sqrt ( 2.0D+00 / pi * x )
-    ttk = ttk * exp ( - x ) / rc
-
-  end if
-
-  return
-end
-subroutine ittikb ( x, tti, ttk )
-
-!*****************************************************************************80
-!
-!! ITTIKB integrates (I0(t)-1)/t from 0 to x, K0(t)/t from x to infinity.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    28 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the integral limit.
-!
-!    Output, real ( kind = 8 ) TTI, TTK, the integrals of
-!    [I0(t)-1]/t from 0 to x, and K0(t)/t from x to oo.
-!
-  implicit none
-
-  real ( kind = 8 ) e0
-  real ( kind = 8 ) el
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) t
-  real ( kind = 8 ) t1
-  real ( kind = 8 ) tti
-  real ( kind = 8 ) ttk
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x1
-
-  pi = 3.141592653589793D+00
-  el = 0.5772156649015329D+00
-
-  if ( x == 0.0D+00 ) then
-
-    tti = 0.0D+00
-
-  else if ( x <= 5.0D+00 ) then
-
-    x1 = x / 5.0D+00
-    t = x1 * x1
-    tti = ((((((( &
-        0.1263D-03       * t &
-      + 0.96442D-03 )    * t &
-      + 0.968217D-02 )   * t &
-      + 0.06615507D+00 ) * t &
-      + 0.33116853D+00 ) * t &
-      + 1.13027241D+00 ) * t &
-      + 2.44140746D+00 ) * t &
-      + 3.12499991D+00 ) * t
-
-  else
-
-    t = 5.0D+00 / x
-    tti = ((((((((( &
-         2.1945464D+00   * t &
-      -  3.5195009D+00 ) * t &
-      - 11.9094395D+00 ) * t &
-      + 40.394734D+00  ) * t &
-      - 48.0524115D+00 ) * t &
-      + 28.1221478D+00 ) * t &
-      -  8.6556013D+00 ) * t &
-      +  1.4780044D+00 ) * t &
-      -  0.0493843D+00 ) * t &
-      +  0.1332055D+00 ) * t &
-      +  0.3989314D+00
-    tti = tti * exp ( x ) / ( sqrt ( x ) * x )
-
-  end if
-
-  if ( x == 0.0D+00 ) then
-
-    ttk = 1.0D+300
-
-  else if ( x <= 2.0D+00 ) then
-
-    t1 = x / 2.0D+00
-    t = t1 * t1
-    ttk = ((((( &
-        0.77D-06         * t &
-      + 0.1544D-04 )     * t &
-      + 0.48077D-03 )    * t &
-      + 0.925821D-02 )   * t &
-      + 0.10937537D+00 ) * t &
-      + 0.74999993D+00 ) * t
-    e0 = el + log ( x / 2.0D+00 )
-    ttk = pi * pi / 24.0D+00 + e0 * ( 0.5D+00 * e0 + tti ) - ttk
-
-  else if ( x <= 4.0D+00 ) then
-
-    t = 2.0D+00 / x
-    ttk = ((( &
-        0.06084D+00    * t &
-      - 0.280367D+00 ) * t &
-      + 0.590944D+00 ) * t &
-      - 0.850013D+00 ) * t &
-      + 1.234684D+00
-    ttk = ttk * exp ( - x ) / ( sqrt ( x ) * x )
-
-  else
-
-    t = 4.0D+00 / x
-    ttk = ((((( &
-        0.02724D+00     * t &
-      - 0.1110396D+00 ) * t &
-      + 0.2060126D+00 ) * t &
-      - 0.2621446D+00 ) * t &
-      + 0.3219184D+00 ) * t &
-      - 0.5091339D+00 ) * t &
-      + 1.2533141D+00
-    ttk = ttk * exp ( - x ) / ( sqrt ( x ) * x )
-
-  end if
-
-  return
-end
-subroutine ittjya ( x, ttj, tty )
-
-!*****************************************************************************80
-!
-!! ITTJYA integrates (1-J0(t))/t from 0 to x, and Y0(t)/t from x to infinity.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    28 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the integral limit.
-!
-!    Output, real ( kind = 8 ) TTJ, TTY, the integrals of [1-J0(t)]/t 
-!    from 0 to x and of Y0(t)/t from x to oo.
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) b1
-  real ( kind = 8 ) bj0
-  real ( kind = 8 ) bj1
-  real ( kind = 8 ) by0
-  real ( kind = 8 ) by1
-  real ( kind = 8 ) e0
-  real ( kind = 8 ) el
-  real ( kind = 8 ) g0
-  real ( kind = 8 ) g1
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) l
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) px
-  real ( kind = 8 ) qx
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r0
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) r2
-  real ( kind = 8 ) rs
-  real ( kind = 8 ) t
-  real ( kind = 8 ) ttj
-  real ( kind = 8 ) tty
-  real ( kind = 8 ) vt
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xk
-
-  pi = 3.141592653589793D+00
-  el = 0.5772156649015329D+00
-
-  if ( x == 0.0D+00 ) then
-
-    ttj = 0.0D+00
-    tty = -1.0D+300
-
-  else if ( x <= 20.0D+00 ) then
-
-    ttj = 1.0D+00
-    r = 1.0D+00
-    do k = 2, 100
-      r = - 0.25D+00 * r * ( k - 1.0D+00 ) / ( k * k * k ) * x * x
-      ttj = ttj + r
-      if ( abs ( r ) < abs ( ttj ) * 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    ttj = ttj * 0.125D+00 * x * x
-    e0 = 0.5D+00 * ( pi * pi / 6.0D+00 - el * el ) &
-      - ( 0.5D+00 * log ( x / 2.0D+00 ) + el ) &
-      * log ( x / 2.0D+00 )
-    b1 = el + log ( x / 2.0D+00 ) - 1.5D+00
-    rs = 1.0D+00
-    r = -1.0D+00
-    do k = 2, 100
-      r = - 0.25D+00 * r * ( k - 1.0D+00 ) / ( k * k * k ) * x * x
-      rs = rs + 1.0D+00 / k
-      r2 = r * ( rs + 1.0D+00 / ( 2.0D+00 * k ) &
-        - ( el + log ( x / 2.0D+00 ) ) ) 
-      b1 = b1 + r2
-      if ( abs ( r2 ) < abs ( b1 ) * 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    tty = 2.0D+00 / pi * ( e0 + 0.125D+00 * x * x * b1 )
-
-  else
-
-    a0 = sqrt ( 2.0D+00 / ( pi * x ) )
-
-    do l = 0, 1
-
-      vt = 4.0D+00 * l * l
-      px = 1.0D+00
-      r = 1.0D+00
-      do k = 1, 14
-        r = - 0.0078125D+00 * r &
-          * ( vt - ( 4.0D+00 * k - 3.0D+00 ) ** 2 ) &
-          / ( x * k ) * ( vt - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
-          / ( ( 2.0D+00 * k - 1.0D+00 ) * x )
-        px = px + r
-        if ( abs ( r ) < abs ( px ) * 1.0D-12 ) then
-          exit
-        end if
-      end do
-
-      qx = 1.0D+00
-      r = 1.0D+00
-      do k = 1, 14
-        r = -0.0078125D+00 * r &
-          * ( vt - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
-          / ( x * k ) * ( vt - ( 4.0D+00 * k + 1.0D+00 ) ** 2 ) &
-          / ( 2.0D+00 * k + 1.0D+00 ) / x
-        qx = qx + r
-        if ( abs ( r ) < abs ( qx ) * 1.0D-12 ) then
-          exit
-        end if
-      end do
-
-      qx = 0.125D+00 * ( vt - 1.0D+00 ) / x * qx
-      xk = x - ( 0.25D+00 + 0.5D+00 * l ) * pi
-      bj1 = a0 * ( px * cos ( xk ) - qx * sin ( xk ) )
-      by1 = a0 * ( px * sin ( xk ) + qx * cos ( xk ) )
-      if ( l == 0 ) then
-        bj0 = bj1
-        by0 = by1
-      end if
-
-    end do
-
-    t = 2.0D+00 / x
-    g0 = 1.0D+00
-    r0 = 1.0D+00
-    do k = 1, 10
-      r0 = - k * k * t * t *r0
-      g0 = g0 + r0
-    end do
-
-    g1 = 1.0D+00
-    r1 = 1.0D+00
-    do k = 1, 10
-      r1 = - k * ( k + 1.0D+00 ) * t * t * r1
-      g1 = g1 + r1
-    end do
-
-    ttj = 2.0D+00 * g1 * bj0 / ( x * x ) - g0 * bj1 / x &
-      + el + log ( x / 2.0D+00 )
-    tty = 2.0D+00 * g1 * by0 / ( x * x ) - g0 * by1 / x
-
-  end if
-
-  return
-end
-subroutine ittjyb ( x, ttj, tty )
-
-!*****************************************************************************80
-!
-!! ITTJYB integrates (1-J0(t))/t from 0 to x, and Y0(t)/t from x to infinity.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    01 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the integral limit.
-!
-!    Output, real ( kind = 8 ) TTJ, TTY, the integrals of [1-J0(t)]/t 
-!    from 0 to x and of Y0(t)/t from x to oo.
-!
-  implicit none
-
-  real ( kind = 8 ) e0
-  real ( kind = 8 ) el
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) g0
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) t
-  real ( kind = 8 ) t1
-  real ( kind = 8 ) ttj
-  real ( kind = 8 ) tty
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x1
-  real ( kind = 8 ) xt
-
-  pi = 3.141592653589793D+00
-  el = 0.5772156649015329D+00
-
-  if ( x == 0.0D+00 ) then
-
-    ttj = 0.0D+00
-    tty = -1.0D+300
-
-  else if ( x <= 4.0D+00 ) then
-
-    x1 = x / 4.0D+00
-    t = x1 * x1
-
-    ttj = (((((( &
-        0.35817D-04 * t &
-      - 0.639765D-03 ) * t &
-      + 0.7092535D-02 ) * t &
-      - 0.055544803D+00 ) * t &
-      + 0.296292677D+00 ) * t &
-      - 0.999999326D+00 ) * t &
-      + 1.999999936D+00 ) * t
- 
-    tty = ((((((( &
-      - 0.3546D-05        * t &
-      + 0.76217D-04 )     * t &
-      - 0.1059499D-02 )   * t &
-      + 0.010787555D+00 ) * t &
-      - 0.07810271D+00 )  * t &
-      + 0.377255736D+00 ) * t &
-      - 1.114084491D+00 ) * t &
-      + 1.909859297D+00 ) * t
-
-    e0 = el + log ( x / 2.0D+00 )
-    tty = pi / 6.0D+00 + e0 / pi * ( 2.0D+00 * ttj - e0 ) - tty
-
-  else if ( x <= 8.0D+00 ) then
-
-    xt = x + 0.25D+00 * pi
-    t1 = 4.0D+00 / x
-    t = t1 * t1
-
-    f0 = ((((( &
-        0.0145369D+00 * t &
-      - 0.0666297D+00 ) * t &
-      + 0.1341551D+00 ) * t &
-      - 0.1647797D+00 ) * t &
-      + 0.1608874D+00 ) * t &
-      - 0.2021547D+00 ) * t &
-      + 0.7977506D+00
-
-    g0 = (((((( &
-        0.0160672D+00   * t &
-      - 0.0759339D+00 ) * t &
-      + 0.1576116D+00 ) * t &
-      - 0.1960154D+00 ) * t &
-      + 0.1797457D+00 ) * t &
-      - 0.1702778D+00 ) * t &
-      + 0.3235819D+00 ) * t1
-
-    ttj = ( f0 * cos ( xt ) + g0 * sin ( xt ) ) / ( sqrt ( x ) * x )
-    ttj = ttj + el + log ( x / 2.0D+00 )
-    tty = ( f0 * sin ( xt ) - g0 * cos ( xt ) ) / ( sqrt ( x ) * x )
-
-  else
-
-    t = 8.0D+00 / x
-    xt = x + 0.25D+00 * pi
-
-    f0 = ((((( &
-        0.18118D-02    * t &
-      - 0.91909D-02 )  * t &
-      + 0.017033D+00 ) * t &
-      - 0.9394D-03 )   * t &
-      - 0.051445D+00 ) * t &
-      - 0.11D-05 )     * t &
-      + 0.7978846D+00
-
-    g0 = ((((( &
-      - 0.23731D-02     * t &
-      + 0.59842D-02 )   * t &
-      + 0.24437D-02 )   * t &
-      - 0.0233178D+00 ) * t &
-      + 0.595D-04 )     * t &
-      + 0.1620695D+00 ) * t
-
-    ttj = ( f0 * cos ( xt ) + g0 * sin ( xt ) )  &
-      / ( sqrt ( x ) * x ) + el + log ( x / 2.0D+00 )
-    tty = ( f0 * sin ( xt ) - g0 * cos ( xt ) )  &
-      / ( sqrt ( x ) * x )
-
-  end if
-
-  return
-end
-subroutine jdzo ( nt, n, m, p, zo )
-
-!*****************************************************************************80
-!
-!! JDZO computes the zeros of Bessel functions Jn(x) and Jn'(x).
-!
-!  Discussion:
-!
-!    This procedure computes the zeros of Bessel functions Jn(x) and
-!    Jn'(x), and arrange them in the order of their magnitudes.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    01 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) NT, the number of zeros.
-!
-!    Output, integer ( kind = 4 ) N(*), the  order of Jn(x) or Jn'(x) associated
-!    with the L-th zero.
-!
-!    Output, integer ( kind = 4 ) M(*), the serial number of the zeros of Jn(x)
-!    or Jn'(x) associated with the L-th zero ( L is the serial number of all the
-!    zeros of Jn(x) and Jn'(x) ).
-!
-!    Output, character ( len = 4 ) P(L), 'TM' or 'TE', a code for designating 
-!    the zeros of Jn(x)  or Jn'(x).  In the waveguide applications, the zeros
-!    of Jn(x) correspond to TM modes and those of Jn'(x) correspond to TE modes.
-!
-!    Output, real ( kind = 8 ) ZO(*), the zeros of Jn(x) and Jn'(x).
-!
-  implicit none
-
-  real ( kind = 8 ) bj(101)
-  real ( kind = 8 ) dj(101)
-  real ( kind = 8 ) fj(101)
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) l0
-  integer ( kind = 4 ) l1
-  integer ( kind = 4 ) l2
-  integer ( kind = 4 ) m(1400)
-  integer ( kind = 4 ) m1(70)
-  integer ( kind = 4 ) mm
-  integer ( kind = 4 ) n(1400)
-  integer ( kind = 4 ) n1(70)
-  integer ( kind = 4 ) nm
-  integer ( kind = 4 ) nt
-  character ( len = 4 ) p(1400)
-  character ( len = 4 ) p1(70)
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x0
-  real ( kind = 8 ) x1
-  real ( kind = 8 ) x2
-  real ( kind = 8 ) xm
-  real ( kind = 8 ) zo(1400)
-  real ( kind = 8 ) zoc(70)
-
-  if ( nt < 600 ) then
-    xm = -1.0D+00 + 2.248485D+00 * real ( nt, kind = 8 ) ** 0.5D+00 &
-      - 0.0159382D+00 * nt + 3.208775D-04 * real ( nt, kind = 8 ) ** 1.5D+00
-    nm = int ( 14.5D+00 + 0.05875D+00 * nt )
-    mm = int ( 0.02D+00 * nt ) + 6
-  else
-    xm = 5.0D+00 + 1.445389D+00 * ( real ( nt, kind = 8 ) ) ** 0.5D+00 &
-      + 0.01889876D+00 * nt &
-      - 2.147763D-04 * ( real ( nt, kind = 8 ) ) ** 1.5D+00
-    nm = int ( 27.8D+00 + 0.0327D+00 * nt )
-    mm = int ( 0.01088D+00 * nt ) + 10
-  end if
-
-  l0 = 0
-
-  do i = 1,nm
-
-    x1 = 0.407658D+00 + 0.4795504D+00 &
-      * ( real ( i - 1, kind = 8 ) ) ** 0.5D+00 + 0.983618D+00 * ( i - 1 )
-    x2 = 1.99535D+00 + 0.8333883 * ( real ( i - 1, kind = 8 ) ) ** 0.5D+00 &
-      + 0.984584D+00 * ( i - 1 )
-    l1 = 0
-
-    do j = 1, mm
-
-      if ( i == 1 .and. j == 1 ) then
-
-        l1 = l1 + 1
-        n1(l1) = i - 1
-        m1(l1) = j
-        if ( i == 1 ) then
-          m1(l1) = j - 1
-        end if
-        p1(l1) = 'TE'
-        zoc(l1) = x
-
-        if ( i <= 15 ) then
-          x1 = x + 3.057D+00 + 0.0122D+00 * ( i - 1 ) &
-            + ( 1.555D+00 + 0.41575D+00 * ( i - 1 ) ) / ( j + 1 ) ** 2
-        else
-          x1 = x + 2.918D+00 + 0.01924D+00 * ( i - 1 ) &
-            + ( 6.26D+00 + 0.13205D+00 * ( i - 1 ) ) / ( j + 1 ) ** 2
-        end if
-
-      else
-
-        x = x1
-
-        do
-
-          call bjndd ( i, x, bj, dj, fj )
-          x0 = x
-          x = x - dj(i) / fj(i)
-
-          if ( xm < x1 ) then
-            exit
-          end if
-
-          if ( abs ( x - x0 ) <= 1.0D-10 ) then
-            l1 = l1 + 1
-            n1(l1) = i - 1
-            m1(l1) = j
-            if ( i == 1 ) then
-              m1(l1) = j - 1
-            end if
-            p1(l1) = 'TE'
-            zoc(l1) = x
-
-            if ( i <= 15 ) then
-              x1 = x + 3.057D+00 + 0.0122D+00 * ( i - 1 ) &
-                + ( 1.555D+00 + 0.41575D+00 * ( i - 1 ) ) / ( j + 1 ) ** 2
-            else
-              x1 = x + 2.918D+00 + 0.01924D+00 * ( i - 1 ) &
-                + ( 6.26D+00 + 0.13205D+00 * ( i - 1 ) ) / ( j + 1 ) ** 2
-            end if
-            exit
-          end if
-
-        end do
-
-      end if
-
-      x = x2
-
-      do
-
-        call bjndd ( i, x, bj, dj, fj )
-        x0 = x
-        x = x - bj(i) / dj(i)
-
-        if ( xm < x ) then
-          exit
-        end if
-
-        if ( abs ( x - x0 ) <= 1.0D-10 ) then
-          exit
-        end if
-
-      end do
-
-      if ( x <= xm ) then
-
-        l1 = l1 + 1
-        n1(l1) = i - 1
-        m1(l1) = j
-        p1(l1) = 'TM'
-        zoc(l1) = x
-        if ( i <= 15 ) then
-          x2 = x + 3.11D+00 + 0.0138D+00 * ( i - 1 ) &
-            + ( 0.04832D+00 + 0.2804D+00 * ( i - 1 ) ) / ( j + 1 ) ** 2
-        else
-          x2 = x + 3.001D+00 + 0.0105D+00 * ( i - 1 ) &
-            + ( 11.52D+00 + 0.48525D+00 * ( i - 1 ) ) / ( j + 3 ) ** 2
-        end if
-
-      end if
-
-    end do
-
-    l = l0 + l1
-    l2 = l
-
-    do
-
-      if ( l0 == 0 ) then
-        do k = 1, l
-          zo(k) = zoc(k)
-          n(k) = n1(k)
-          m(k) = m1(k)
-          p(k) = p1(k)
-        end do
-        l1 = 0
-      else if ( l0 /= 0 ) then
-        if ( zoc(l1) .le. zo(l0) ) then
-          zo(l0+l1) = zo(l0)
-          n(l0+l1) = n(l0)
-          m(l0+l1) = m(l0)
-          p(l0+l1) = p(l0)
-          l0 = l0 - 1
-        else
-          zo(l0+l1) = zoc(l1)
-          n(l0+l1) = n1(l1)
-          m(l0+l1) = m1(l1)
-          p(l0+l1) = p1(l1)
-          l1 = l1 - 1
-        end if
-      end if
-
-      if ( l1 == 0 ) then
-        exit 
-      end if
-
-    end do
-
-    l0 = l2
-
-  end do
-
-  return
-end
-subroutine jelp ( u, hk, esn, ecn, edn, eph )
-
-!*****************************************************************************80
-!
-!! JELP computes Jacobian elliptic functions SN(u), CN(u), DN(u).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    08 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) U, the argument.
-!
-!    Input, real ( kind = 8 ) HK, the modulus, between 0 and 1.
-!
-!    Output, real ( kind = 8 ) ESN, ECN, EDN, EPH, the values of
-!    sn(u), cn(u), dn(u), and phi (in degrees).
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) b
-  real ( kind = 8 ) b0
-  real ( kind = 8 ) c
-  real ( kind = 8 ) d
-  real ( kind = 8 ) dn
-  real ( kind = 8 ) ecn
-  real ( kind = 8 ) edn
-  real ( kind = 8 ) eph
-  real ( kind = 8 ) esn
-  real ( kind = 8 ) hk
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) n 
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r(40)
-  real ( kind = 8 ) sa
-  real ( kind = 8 ) t
-  real ( kind = 8 ) u
-
-  pi = 3.14159265358979D+00
-  a0 = 1.0D+00
-  b0 = sqrt ( 1.0D+00 - hk * hk )
-
-  do n = 1, 40
-
-    a = ( a0 + b0 ) / 2.0D+00
-    b = sqrt ( a0 * b0 )
-    c = ( a0 - b0 ) / 2.0D+00
-    r(n) = c / a
-
-    if ( c < 1.0D-07 ) then
-      exit
-    end if
-
-    a0 = a
-    b0 = b
-
-  end do
-
-  dn = 2.0D+00 ** n * a * u
-
-  do j = n, 1, -1
-    t = r(j) * sin ( dn )
-    sa = atan ( t / sqrt ( abs ( 1.0D+00 - t * t )))
-    d = 0.5D+00 * ( dn + sa )
-    dn = d
-  end do
-
-  eph = d * 180.0D+00 / pi
-  esn = sin ( d )
-  ecn = cos ( d )
-  edn = sqrt ( 1.0D+00 - hk * hk * esn * esn )
-
-  return
-end
-subroutine jy01a ( x, bj0, dj0, bj1, dj1, by0, dy0, by1, dy1 )
-
-!*****************************************************************************80
-!
-!! JY01A computes Bessel functions J0(x), J1(x), Y0(x), Y1(x) and derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    01 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) BJ0, DJ0, BJ1, DJ1, BY0, DY0, BY1, DY1,
-!    the values of J0(x), J0'(x), J1(x), J1'(x), Y0(x), Y0'(x), Y1(x), Y1'(x).
-!
-  implicit none
-
-  real ( kind = 8 ), save, dimension(12) :: a = (/ &
-    -0.7031250000000000D-01, 0.1121520996093750D+00, &
-    -0.5725014209747314D+00, 0.6074042001273483D+01, &
-    -0.1100171402692467D+03, 0.3038090510922384D+04, &
-    -0.1188384262567832D+06, 0.6252951493434797D+07, &
-    -0.4259392165047669D+09, 0.3646840080706556D+11, &
-    -0.3833534661393944D+13, 0.4854014686852901D+15 /)
-  real ( kind = 8 ), save, dimension(12) :: a1 = (/ &
-    0.1171875000000000D+00, -0.1441955566406250D+00, &
-    0.6765925884246826D+00, -0.6883914268109947D+01, &
-    0.1215978918765359D+03, -0.3302272294480852D+04, &
-    0.1276412726461746D+06, -0.6656367718817688D+07, &
-    0.4502786003050393D+09, -0.3833857520742790D+11, &
-    0.4011838599133198D+13, -0.5060568503314727D+15 /)
-  real ( kind = 8 ), save, dimension(12) :: b = (/ &
-    0.7324218750000000D-01, -0.2271080017089844D+00, &
-    0.1727727502584457D+01, -0.2438052969955606D+02, &
-    0.5513358961220206D+03, -0.1825775547429318D+05, &
-    0.8328593040162893D+06, -0.5006958953198893D+08, &
-    0.3836255180230433D+10, -0.3649010818849833D+12, &
-    0.4218971570284096D+14, -0.5827244631566907D+16 /)
-  real ( kind = 8 ), save, dimension(12) :: b1 = (/ &
-    -0.1025390625000000D+00, 0.2775764465332031D+00, &
-    -0.1993531733751297D+01, 0.2724882731126854D+02, &
-    -0.6038440767050702D+03, 0.1971837591223663D+05, &
-    -0.8902978767070678D+06, 0.5310411010968522D+08, &
-    -0.4043620325107754D+10, 0.3827011346598605D+12, &
-    -0.4406481417852278D+14, 0.6065091351222699D+16 /)
-  real ( kind = 8 ) bj0
-  real ( kind = 8 ) bj1
-  real ( kind = 8 ) by0
-  real ( kind = 8 ) by1
-  real ( kind = 8 ) cs0
-  real ( kind = 8 ) cs1
-  real ( kind = 8 ) cu
-  real ( kind = 8 ) dj0
-  real ( kind = 8 ) dj1
-  real ( kind = 8 ) dy0
-  real ( kind = 8 ) dy1
-  real ( kind = 8 ) ec
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k0
-  real ( kind = 8 ) p0
-  real ( kind = 8 ) p1
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) q0
-  real ( kind = 8 ) q1
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r0
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) rp2
-  real ( kind = 8 ) t1
-  real ( kind = 8 ) t2
-  real ( kind = 8 ) w0
-  real ( kind = 8 ) w1
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x2
-
-  pi = 3.141592653589793D+00
-  rp2 = 0.63661977236758D+00
-  x2 = x * x
-
-  if ( x == 0.0D+00 ) then
-    bj0 = 1.0D+00
-    bj1 = 0.0D+00
-    dj0 = 0.0D+00
-    dj1 = 0.5D+00
-    by0 = -1.0D+300
-    by1 = -1.0D+300
-    dy0 = 1.0D+300
-    dy1 = 1.0D+300
-    return
-  end if
-
-  if ( x <= 12.0D+00 ) then
-
-    bj0 = 1.0D+00
-    r = 1.0D+00
-    do k = 1,30
-      r = -0.25D+00 * r * x2 / ( k * k )
-      bj0 = bj0 + r
-      if ( abs ( r ) < abs ( bj0 ) * 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    bj1 = 1.0D+00
-    r = 1.0D+00
-    do k = 1, 30
-      r = -0.25D+00 * r * x2 / ( k * ( k + 1.0D+00 ) )
-      bj1 = bj1 + r
-      if ( abs ( r ) < abs ( bj1 ) * 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    bj1 = 0.5D+00 * x * bj1
-    ec = log ( x / 2.0D+00 ) + 0.5772156649015329D+00
-    cs0 = 0.0D+00
-    w0 = 0.0D+00
-    r0 = 1.0D+00
-    do k = 1, 30
-      w0 = w0 + 1.0D+00 / k
-      r0 = -0.25D+00 * r0 / ( k * k ) * x2
-      r = r0 * w0
-      cs0 = cs0 + r
-      if ( abs ( r ) < abs ( cs0 ) * 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    by0 = rp2 * ( ec * bj0 - cs0 )
-    cs1 = 1.0D+00
-    w1 = 0.0D+00
-    r1 = 1.0D+00
-    do k = 1, 30
-      w1 = w1 + 1.0D+00 / k
-      r1 = -0.25D+00 * r1 / ( k * ( k + 1 ) ) * x2
-      r = r1 * ( 2.0D+00 * w1 + 1.0D+00 / ( k + 1.0D+00 ) )
-      cs1 = cs1 + r
-      if ( abs ( r ) < abs ( cs1 ) * 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    by1 = rp2 * ( ec * bj1 - 1.0D+00 / x - 0.25D+00 * x * cs1 )
-
-  else
-
-    if ( x < 35.0D+00 ) then
-      k0 = 12
-    else if ( x < 50.0D+00 ) then
-      k0 = 10
-    else
-      k0 = 8
-    end if
-
-    t1 = x - 0.25D+00 * pi
-    p0 = 1.0D+00
-    q0 = -0.125D+00 / x
-    do k = 1, k0
-      p0 = p0 + a(k) * x ** ( - 2 * k )
-      q0 = q0 + b(k) * x ** ( - 2 * k - 1 )
-    end do
-    cu = sqrt ( rp2 / x )
-    bj0 = cu * ( p0 * cos ( t1 ) - q0 * sin ( t1 ) )
-    by0 = cu * ( p0 * sin ( t1 ) + q0 * cos ( t1 ) )
-    t2 = x - 0.75D+00 * pi
-    p1 = 1.0D+00
-    q1 = 0.375D+00 / x
-    do k = 1, k0
-      p1 = p1 + a1(k) * x ** ( - 2 * k )
-      q1 = q1 + b1(k) * x ** ( - 2 * k - 1 )
-    end do
-    cu = sqrt ( rp2 / x )
-    bj1 = cu * ( p1 * cos ( t2 ) - q1 * sin ( t2 ) )
-    by1 = cu * ( p1 * sin ( t2 ) + q1 * cos ( t2 ) )
-
-  end if
-
-  dj0 = - bj1
-  dj1 = bj0 - bj1 / x
-  dy0 = - by1
-  dy1 = by0 - by1 / x
-
-  return
-end
-subroutine jy01b ( x, bj0, dj0, bj1, dj1, by0, dy0, by1, dy1 )
-
-!*****************************************************************************80
-!
-!! JY01B computes Bessel functions J0(x), J1(x), Y0(x), Y1(x) and derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    02 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) BJ0, DJ0, BJ1, DJ1, BY0, DY0, BY1, DY1,
-!    the values of J0(x), J0'(x), J1(x), J1'(x), Y0(x), Y0'(x), Y1(x), Y1'(x).
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) bj0
-  real ( kind = 8 ) bj1
-  real ( kind = 8 ) by0
-  real ( kind = 8 ) by1
-  real ( kind = 8 ) dj0
-  real ( kind = 8 ) dj1
-  real ( kind = 8 ) dy0
-  real ( kind = 8 ) dy1
-  real ( kind = 8 ) p0
-  real ( kind = 8 ) p1
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) q0
-  real ( kind = 8 ) q1
-  real ( kind = 8 ) t
-  real ( kind = 8 ) t2
-  real ( kind = 8 ) ta0
-  real ( kind = 8 ) ta1
-  real ( kind = 8 ) x
-
-  pi = 3.141592653589793D+00
-
-  if ( x == 0.0D+00 ) then
-
-    bj0 = 1.0D+00
-    bj1 = 0.0D+00
-    dj0 = 0.0D+00
-    dj1 = 0.5D+00
-    by0 = -1.0D+300
-    by1 = -1.0D+300
-    dy0 = 1.0D+300
-    dy1 = 1.0D+300
-    return
-
-  else if ( x <= 4.0D+00 ) then
-
-    t = x / 4.0D+00
-    t2 = t * t
-
-    bj0 = (((((( &
-      - 0.5014415D-03 * t2 &
-      + 0.76771853D-02 ) * t2 &
-      - 0.0709253492D+00 ) * t2 &
-      + 0.4443584263D+00 ) * t2 &
-      - 1.7777560599D+00 ) * t2 &
-      + 3.9999973021D+00 ) * t2 &
-      - 3.9999998721D+00 ) * t2 &
-      + 1.0D+00
-
-    bj1 = t * ((((((( &
-      - 0.1289769D-03 * t2 &
-      + 0.22069155D-02 ) * t2 &
-      - 0.0236616773D+00 ) * t2 &
-      + 0.1777582922D+00 ) * t2 &
-      - 0.8888839649D+00 ) * t2 &
-      + 2.6666660544D+00 ) * t2 &
-      - 3.9999999710D+00 ) * t2 &
-      + 1.9999999998D+00 )
-
-    by0 = ((((((( &
-      - 0.567433D-04 * t2 &
-      + 0.859977D-03 ) * t2 &
-      - 0.94855882D-02 ) * t2 &
-      + 0.0772975809D+00 ) * t2 &
-      - 0.4261737419D+00 ) * t2 &
-      + 1.4216421221D+00 ) * t2 &
-      - 2.3498519931D+00 ) * t2 &
-      + 1.0766115157D+00 ) * t2 &
-      + 0.3674669052D+00
-
-    by0 = 2.0D+00 / pi * log ( x / 2.0D+00 ) * bj0 + by0
-
-    by1 = (((((((( &
-        0.6535773D-03 * t2 &
-      - 0.0108175626D+00 ) * t2 &
-      + 0.107657606D+00 ) * t2 &
-      - 0.7268945577D+00 ) * t2 &
-      + 3.1261399273D+00 ) * t2 &
-      - 7.3980241381D+00 ) * t2 &
-      + 6.8529236342D+00 ) * t2 &
-      + 0.3932562018D+00 ) * t2 &
-      - 0.6366197726D+00 ) / x
-
-    by1 = 2.0D+00 / pi * log ( x / 2.0D+00 ) * bj1 + by1
-
-  else
-
-    t = 4.0D+00 / x
-    t2 = t * t
-    a0 = sqrt ( 2.0D+00 / ( pi * x ) )
-
-    p0 = (((( &
-      - 0.9285D-05 * t2 &
-      + 0.43506D-04 ) * t2 &
-      - 0.122226D-03 ) * t2 &
-      + 0.434725D-03 ) * t2 &
-      - 0.4394275D-02 ) * t2 &
-      + 0.999999997D+00
-
-    q0 = t * ((((( &
-        0.8099D-05 * t2 &
-      - 0.35614D-04 ) * t2 &
-      + 0.85844D-04 ) * t2 &
-      - 0.218024D-03 ) * t2 &
-      + 0.1144106D-02 ) * t2 &
-      - 0.031249995D+00 )
-
-    ta0 = x - 0.25D+00 * pi
-    bj0 = a0 * ( p0 * cos ( ta0 ) - q0 * sin ( ta0 ) )
-    by0 = a0 * ( p0 * sin ( ta0 ) + q0 * cos ( ta0 ) )
-
-    p1 = (((( &
-        0.10632D-04 * t2 &
-      - 0.50363D-04 ) * t2 &
-      + 0.145575D-03 ) * t2 &
-      - 0.559487D-03 ) * t2 &
-      + 0.7323931D-02 ) * t2 &
-      + 1.000000004D+00
-
-    q1 = t * ((((( &
-      - 0.9173D-05      * t2 &
-      + 0.40658D-04 )   * t2 &
-      - 0.99941D-04 )   * t2 &
-      + 0.266891D-03 )  * t2 &
-      - 0.1601836D-02 ) * t2 &
-      + 0.093749994D+00 )
-
-    ta1 = x - 0.75D+00 * pi
-    bj1 = a0 * ( p1 * cos ( ta1 ) - q1 * sin ( ta1 ) )
-    by1 = a0 * ( p1 * sin ( ta1 ) + q1 * cos ( ta1 ) )
-
-  end if
-
-  dj0 = - bj1
-  dj1 = bj0 - bj1 / x
-  dy0 = - by1
-  dy1 = by0 - by1 / x
-
-  return
-end
-subroutine jyna ( n, x, nm, bj, dj, by, dy )
-
-!*****************************************************************************80
-!
-!! JYNA computes Bessel functions Jn(x) and Yn(x) and derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    29 April 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, integer ( kind = 4 ) NM, the highest order computed.
-!
-!    Output, real ( kind = 8 ) BJ(0:N), DJ(0:N), BY(0:N), DY(0:N), the values
-!    of Jn(x), Jn'(x), Yn(x), Yn'(x).
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) bj(0:n)
-  real ( kind = 8 ) bj0
-  real ( kind = 8 ) bj1
-  real ( kind = 8 ) bjk
-  real ( kind = 8 ) by(0:n)
-  real ( kind = 8 ) by0
-  real ( kind = 8 ) by1
-  real ( kind = 8 ) cs
-  real ( kind = 8 ) dj(0:n)
-  real ( kind = 8 ) dj0
-  real ( kind = 8 ) dj1
-  real ( kind = 8 ) dy(0:n)
-  real ( kind = 8 ) dy0
-  real ( kind = 8 ) dy1
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) f2
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) x
-
-  nm = n
-
-  if ( x < 1.0D-100 ) then
-
-    do k = 0, n
-      bj(k) = 0.0D+00
-      dj(k) = 0.0D+00
-      by(k) = -1.0D+300
-      dy(k) = 1.0D+300
-    end do
-    bj(0) = 1.0D+00
-    dj(1) = 0.5D+00
-    return
-
-  end if
-
-  call jy01b ( x, bj0, dj0, bj1, dj1, by0, dy0, by1, dy1 )
-  bj(0) = bj0
-  bj(1) = bj1
-  by(0) = by0
-  by(1) = by1
-  dj(0) = dj0
-  dj(1) = dj1
-  dy(0) = dy0
-  dy(1) = dy1
-
-  if ( n <= 1 ) then
-    return
-  end if
-
-  if ( n < int ( 0.9D+00 * x) ) then
-
-    do k = 2, n
-      bjk = 2.0D+00 * ( k - 1.0D+00 ) / x * bj1 - bj0
-      bj(k) = bjk
-      bj0 = bj1
-      bj1 = bjk
-    end do
-
-  else
-
-    m = msta1 ( x, 200 )
-
-    if ( m < n ) then
-      nm = m
-    else
-      m = msta2 ( x, n, 15 )
-    end if
-
-    f2 = 0.0D+00
-    f1 = 1.0D-100
-    do k = m, 0, -1
-      f = 2.0D+00 * ( k + 1.0D+00 ) / x * f1 - f2
-      if ( k <= nm ) then
-        bj(k) = f
-      end if
-      f2 = f1
-      f1 = f
-    end do
-
-    if ( abs ( bj1 ) < abs ( bj0 ) ) then
-      cs = bj0 / f
-    else
-      cs = bj1 / f2
-    end if
-
-    do k = 0, nm
-      bj(k) = cs * bj(k)
-    end do
-
-  end if
-
-  do k = 2, nm
-    dj(k) = bj(k-1) - k / x * bj(k)
-  end do
-
-  f0 = by(0)
-  f1 = by(1)
-  do k = 2, nm
-    f = 2.0D+00 * ( k - 1.0D+00 ) / x * f1 - f0
-    by(k) = f
-    f0 = f1
-    f1 = f
-  end do
-
-  do k = 2, nm
-    dy(k) = by(k-1) - k * by(k) / x
-  end do
-
-  return
-end
-subroutine jynb ( n, x, nm, bj, dj, by, dy )
-
-!*****************************************************************************80
-!
-!! JYNB computes Bessel functions Jn(x) and Yn(x) and derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    02 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, integer ( kind = 4 ) NM, the highest order computed.
-!
-!    Output, real ( kind = 8 ) BJ(0:N), DJ(0:N), BY(0:N), DY(0:N), the values
-!    of Jn(x), Jn'(x), Yn(x), Yn'(x).
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ), save, dimension ( 4 ) :: a = (/ &
-    -0.7031250000000000D-01, 0.1121520996093750D+00, &
-    -0.5725014209747314D+00, 0.6074042001273483D+01 /)
-  real ( kind = 8 ), save, dimension ( 4 ) :: a1 = (/ &
-    0.1171875000000000D+00, -0.1441955566406250D+00, &
-    0.6765925884246826D+00, -0.6883914268109947D+01 /)
-  real ( kind = 8 ), save, dimension ( 4 ) :: b = (/ &
-    0.7324218750000000D-01, -0.2271080017089844D+00, &
-    0.1727727502584457D+01, -0.2438052969955606D+02 /)
-  real ( kind = 8 ), save, dimension ( 4 ) :: b1 = (/ &
-    -0.1025390625000000D+00, 0.2775764465332031D+00, &
-    -0.1993531733751297D+01, 0.2724882731126854D+02 /)
-  real ( kind = 8 ) bj(0:n)
-  real ( kind = 8 ) bj0
-  real ( kind = 8 ) bj1
-  real ( kind = 8 ) bjk
-  real ( kind = 8 ) bs
-  real ( kind = 8 ) by(0:n)
-  real ( kind = 8 ) by0
-  real ( kind = 8 ) by1
-  real ( kind = 8 ) byk
-  real ( kind = 8 ) cu
-  real ( kind = 8 ) dj(0:n)
-  real ( kind = 8 ) dy(0:n)
-  real ( kind = 8 ) ec
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) f2
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) p0
-  real ( kind = 8 ) p1
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) q0
-  real ( kind = 8 ) q1
-  real ( kind = 8 ) r2p
-  real ( kind = 8 ) s0
-  real ( kind = 8 ) su
-  real ( kind = 8 ) sv
-  real ( kind = 8 ) t1
-  real ( kind = 8 ) t2
-  real ( kind = 8 ) x
-
-  pi = 3.141592653589793D+00
-  r2p = 0.63661977236758D+00
-  nm = n
-
-  if ( x < 1.0D-100 ) then
-    do k = 0, n
-      bj(k) = 0.0D+00
-      dj(k) = 0.0D+00
-      by(k) = -1.0D+300
-      dy(k) = 1.0D+300
-    end do
-    bj(0) = 1.0D+00
-    dj(1) = 0.5D+00
-    return
-  end if
-
-  if ( x <= 300.0D+00 .or. int ( 0.9D+00 * x ) < n ) then
-
-    if ( n == 0 ) then
-      nm = 1
-    end if
-
-    m = msta1 ( x, 200 )
-
-    if ( m < nm ) then
-      nm = m
-    else
-      m = msta2 ( x, nm, 15 )
-    end if
-
-    bs = 0.0D+00
-    su = 0.0D+00
-    sv = 0.0D+00
-    f2 = 0.0D+00
-    f1 = 1.0D-100
-
-    do k = m, 0, -1
-      f = 2.0D+00 * ( k + 1.0D+00 ) / x * f1 - f2
-      if ( k <= nm ) then
-        bj(k) = f
-      end if
-      if ( k == 2 * int ( k / 2 ) .and. k /= 0 ) then
-        bs = bs + 2.0D+00 * f
-        su = su + ( -1.0D+00 ) ** ( k / 2 ) * f / k
-      else if ( 1 < k ) then
-        sv = sv + ( -1.0D+00 ) ** ( k / 2 ) * k / ( k * k - 1.0D+00 ) * f
-      end if
-      f2 = f1
-      f1 = f
-    end do
-
-    s0 = bs + f
-    do k = 0, nm
-      bj(k) = bj(k) / s0
-    end do
-
-    ec = log ( x / 2.0D+00 ) + 0.5772156649015329D+00
-    by0 = r2p * ( ec * bj(0) - 4.0D+00 * su / s0 )
-    by(0) = by0
-    by1 = r2p * ( ( ec - 1.0D+00 ) * bj(1) - bj(0) / x - 4.0D+00 * sv / s0 )
-    by(1) = by1
-
-  else
-
-    t1 = x - 0.25D+00 * pi
-    p0 = 1.0D+00
-    q0 = -0.125D+00 / x
-    do k = 1, 4
-      p0 = p0 + a(k) * x ** ( - 2 * k )
-      q0 = q0 + b(k) * x ** ( - 2 * k - 1 )
-    end do
-    cu = sqrt ( r2p / x )
-    bj0 = cu * ( p0 * cos ( t1 ) - q0 * sin ( t1 ) )
-    by0 = cu * ( p0 * sin ( t1 ) + q0 * cos ( t1 ) )
-    bj(0) = bj0
-    by(0) = by0
-    t2 = x - 0.75D+00 * pi
-    p1 = 1.0D+00
-    q1 = 0.375D+00 / x
-    do k = 1, 4
-      p1 = p1 + a1(k) * x ** ( - 2 * k )
-      q1 = q1 + b1(k) * x ** ( - 2 * k - 1 )
-    end do
-    bj1 = cu * ( p1 * cos ( t2 ) - q1 * sin ( t2 ) )
-    by1 = cu * ( p1 * sin ( t2 ) + q1 * cos ( t2 ) )
-    bj(1) = bj1
-    by(1) = by1
-    do k = 2, nm
-      bjk = 2.0D+00 * ( k - 1.0D+00 ) / x * bj1 - bj0
-      bj(k) = bjk
-      bj0 = bj1
-      bj1 = bjk
-    end do
-  end if
-
-  dj(0) = -bj(1)
-  do k = 1, nm
-    dj(k) = bj(k-1) - k / x * bj(k)
-  end do
-
-  do k = 2, nm
-    byk = 2.0D+00 * ( k - 1.0D+00 ) * by1 / x - by0
-    by(k) = byk
-    by0 = by1
-    by1 = byk
-  end do
-
-  dy(0) = -by(1)
-  do k = 1, nm
-    dy(k) = by(k-1) - k * by(k) / x
-  end do
-
-  return
-end
-subroutine jyndd ( n, x, bjn, djn, fjn, byn, dyn, fyn )
-
-!*****************************************************************************80
-!
-!! JYNDD: Bessel functions Jn(x) and Yn(x), first and second derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    02 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) BJN, DJN, FJN, BYN, DYN, FYN, the values of
-!    Jn(x), Jn'(x), Jn"(x), Yn(x), Yn'(x), Yn"(x).
-!
-  implicit none
-
-  real ( kind = 8 ) bj(102)
-  real ( kind = 8 ) bjn
-  real ( kind = 8 ) byn
-  real ( kind = 8 ) bs
-  real ( kind = 8 ) by(102)
-  real ( kind = 8 ) djn
-  real ( kind = 8 ) dyn
-  real ( kind = 8 ) e0
-  real ( kind = 8 ) ec
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) fjn
-  real ( kind = 8 ) fyn
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) mt
-  integer ( kind = 4 ) n
-  integer ( kind = 4 ) nt
-  real ( kind = 8 ) s1
-  real ( kind = 8 ) su
-  real ( kind = 8 ) x
-
-  do nt = 1, 900
-    mt = int ( 0.5D+00 * log10 ( 6.28D+00 * nt ) &
-      - nt * log10 ( 1.36D+00 * abs ( x ) / nt ) )
-    if ( 20 < mt ) then
-      exit
-    end if
-  end do
-
-  m = nt
-  bs = 0.0D+00
-  f0 = 0.0D+00
-  f1 = 1.0D-35
-  su = 0.0D+00
-  do k = m, 0, -1
-    f = 2.0D+00 * ( k + 1.0D+00 ) * f1 / x - f0
-    if ( k <= n + 1 ) then
-      bj(k+1) = f
-    end if
-    if ( k == 2 * int ( k / 2 ) ) then
-      bs = bs + 2.0D+00 * f
-      if ( k /= 0 ) then
-        su = su + ( -1.0D+00 ) ** ( k / 2 ) * f / k
-      end if
-    end if
-    f0 = f1
-    f1 = f
-  end do
-
-  do k = 0, n + 1
-    bj(k+1) = bj(k+1) / ( bs - f )
-  end do
-
-  bjn = bj(n+1)
-  ec = 0.5772156649015329D+00
-  e0 = 0.3183098861837907D+00
-  s1 = 2.0D+00 * e0 * ( log ( x / 2.0D+00 ) + ec ) * bj(1)
-  f0 = s1 - 8.0D+00 * e0 * su / ( bs - f )
-  f1 = ( bj(2) * f0 - 2.0D+00 * e0 / x ) / bj(1)
-
-  by(1) = f0
-  by(2) = f1
-  do k = 2, n + 1 
-    f = 2.0D+00 * ( k - 1.0D+00 ) * f1 / x - f0
-    by(k+1) = f
-    f0 = f1
-    f1 = f
-  end do
-
-  byn = by(n+1)
-  djn = - bj(n+2) + n * bj(n+1) / x
-  dyn = - by(n+2) + n * by(n+1) / x
-  fjn = ( n * n / ( x * x ) - 1.0D+00 ) * bjn - djn / x
-  fyn = ( n * n / ( x * x ) - 1.0D+00 ) * byn - dyn / x
-
-  return
-end
-subroutine jyv ( v, x, vm, bj, dj, by, dy )
-
-!*****************************************************************************80
-!
-!! JYV computes Bessel functions Jv(x) and Yv(x) and their derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    02 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) V, the order of Jv(x) and Yv(x).
-!
-!    Input, real ( kind = 8 ) X, the argument of Jv(x) and Yv(x).
-!
-!    Output, real ( kind = 8 ) VM, the highest order computed.
-!
-!    Output, real ( kind = 8 ) BJ(0:N), DJ(0:N), BY(0:N), DY(0:N),
-!    the values of Jn+v0(x), Jn+v0'(x), Yn+v0(x), Yn+v0'(x).
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) b
-  real ( kind = 8 ) bj(0:*)
-  real ( kind = 8 ) bju0
-  real ( kind = 8 ) bju1
-  real ( kind = 8 ) bjv0
-  real ( kind = 8 ) bjv1
-  real ( kind = 8 ) bjvl
-  real ( kind = 8 ) by(0:*)
-  real ( kind = 8 ) byv0
-  real ( kind = 8 ) byv1
-  real ( kind = 8 ) byvk
-  real ( kind = 8 ) ck
-  real ( kind = 8 ) cs
-  real ( kind = 8 ) cs0
-  real ( kind = 8 ) cs1
-  real ( kind = 8 ) dj(0:*)
-  real ( kind = 8 ) dy(0:*)
-  real ( kind = 8 ) ec
-  real ( kind = 8 ) el
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) f2
-  real ( kind = 8 ) ga
-  real ( kind = 8 ) gb
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k0
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) pv0
-  real ( kind = 8 ) pv1
-  real ( kind = 8 ) px
-  real ( kind = 8 ) qx
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r0
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) rp
-  real ( kind = 8 ) rp2
-  real ( kind = 8 ) rq
-  real ( kind = 8 ) sk
-  real ( kind = 8 ) v
-  real ( kind = 8 ) v0
-  real ( kind = 8 ) vg
-  real ( kind = 8 ) vl
-  real ( kind = 8 ) vm
-  real ( kind = 8 ) vv
-  real ( kind = 8 ) w0
-  real ( kind = 8 ) w1
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x2
-  real ( kind = 8 ) xk
-
-  el = 0.5772156649015329D+00
-  pi = 3.141592653589793D+00
-  rp2 = 0.63661977236758D+00
-  x2 = x * x
-  n = int ( v )
-  v0 = v - n
-
-  if ( x < 1.0D-100 ) then
-
-    do k = 0, n
-      bj(k) = 0.0D+00
-      dj(k) = 0.0D+00
-      by(k) = -1.0D+300
-      dy(k) = 1.0D+300
-    end do
-
-    if ( v0 == 0.0D+00 ) then
-      bj(0) = 1.0D+00
-      dj(1) = 0.5D+00
-    else
-      dj(0) = 1.0D+300
-    end if
-    vm = v  
-    return
-
-  end if
-
-  if ( x <= 12.0D+00 ) then
-
-    do l = 0, 1
-      vl = v0 + l
-      bjvl = 1.0D+00
-      r = 1.0D+00
-      do k = 1, 40
-        r = -0.25D+00 * r * x2 / ( k * ( k + vl ) )
-        bjvl = bjvl + r
-        if ( abs ( r ) < abs ( bjvl ) * 1.0D-15 ) then
-          exit
-        end if
-      end do
-
-      vg = 1.0D+00 + vl
-      call gamma ( vg, ga )
-      a = ( 0.5D+00 * x ) ** vl / ga
-
-      if ( l == 0 ) then
-        bjv0 = bjvl * a
-      else
-        bjv1 = bjvl * a
-      end if
-
-    end do
-
-  else
-
-    if ( x < 35.0D+00 ) then
-      k0 = 11
-    else if ( x < 50.0D+00 ) then
-      k0 = 10
-    else
-      k0 = 8
-    end if
-
-    do j = 0, 1
-
-      vv = 4.0D+00 * ( j + v0 ) * ( j + v0 )
-      px = 1.0D+00
-      rp = 1.0D+00
-      do k = 1, k0
-        rp = -0.78125D-02 * rp &
-          * ( vv - ( 4.0D+00 * k - 3.0D+00 ) ** 2 ) &
-          * ( vv - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
-          / ( k * ( 2.0D+00 * k - 1.0D+00 ) * x2 )
-        px = px + rp
-      end do
-      qx = 1.0D+00
-      rq = 1.0D+00
-      do k = 1, k0
-        rq = -0.78125D-02 * rq &
-          * ( vv - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
-          * ( vv - ( 4.0D+00 * k + 1.0D+00 ) ** 2 ) &
-          / ( k * ( 2.0D+00 * k + 1.0D+00 ) * x2 )
-        qx = qx + rq
-      end do
-      qx = 0.125D+00 * ( vv - 1.0D+00 ) * qx / x
-      xk = x - ( 0.5D+00 * ( j + v0 ) + 0.25D+00 ) * pi
-      a0 = sqrt ( rp2 / x )
-      ck = cos ( xk )
-      sk = sin ( xk )
-      if ( j == 0 ) then
-        bjv0 = a0 * ( px * ck - qx * sk )
-        byv0 = a0 * ( px * sk + qx * ck )
-      else if ( j == 1 ) then
-        bjv1 = a0 * ( px * ck - qx * sk )
-        byv1 = a0 * ( px * sk + qx * ck )
-      end if
-
-    end do
-
-  end if
-
-  bj(0) = bjv0
-  bj(1) = bjv1
-  dj(0) = v0 / x * bj(0) - bj(1)
-  dj(1) = - ( 1.0D+00 + v0 ) / x * bj(1) + bj(0)
-
-  if ( 2 <= n .and. n <= int ( 0.9D+00 * x ) ) then
-    f0 = bjv0
-    f1 = bjv1
-    do k = 2, n
-      f = 2.0D+00 * ( k + v0 - 1.0D+00 ) / x * f1 - f0
-      bj(k) = f
-      f0 = f1
-      f1 = f
-    end do
-  else if ( 2 <= n ) then
-    m = msta1 ( x, 200 )
-    if ( m < n ) then
-      n = m
-    else
-      m = msta2 ( x, n, 15 )
-    end if
-    f2 = 0.0D+00
-    f1 = 1.0D-100
-    do k = m, 0, -1
-      f = 2.0D+00 * ( v0 + k + 1.0D+00 ) / x * f1 - f2
-      if ( k <= n ) then
-        bj(k) = f
-      end if
-      f2 = f1
-      f1 = f
-    end do
-
-    if ( abs ( bjv1 ) < abs ( bjv0 ) ) then
-      cs = bjv0 / f
-    else
-      cs = bjv1 / f2
-    end if
-    do k = 0, n
-      bj(k) = cs * bj(k)
-    end do
-  end if
-
-  do k = 2, n
-    dj(k) = - ( k + v0 ) / x * bj(k) + bj(k-1)
-  end do
-
-  if ( x <= 12.0D+00 ) then
-
-    if ( v0 /= 0.0D+00 ) then
-
-      do l = 0, 1
-
-        vl = v0 + l
-        bjvl = 1.0D+00
-        r = 1.0D+00
-        do k = 1, 40
-          r = -0.25D+00 * r * x2 / ( k * ( k - vl ) )
-          bjvl = bjvl + r
-          if ( abs ( r ) < abs ( bjvl ) * 1.0D-15 ) then
-            exit
-          end if
-        end do
-
-        vg = 1.0D+00 - vl
-        call gamma ( vg, gb )
-        b = ( 2.0D+00 / x ) ** vl / gb
-
-        if ( l == 0 ) then
-          bju0 = bjvl * b
-        else
-          bju1 = bjvl * b
-        end if
-
-      end do
-
-      pv0 = pi * v0
-      pv1 = pi * ( 1.0D+00 + v0 )
-      byv0 = ( bjv0 * cos ( pv0 ) - bju0 ) / sin ( pv0 )
-      byv1 = ( bjv1 * cos ( pv1 ) - bju1 ) / sin ( pv1 )
-
-    else
-
-      ec = log ( x / 2.0D+00 ) + el
-      cs0 = 0.0D+00
-      w0 = 0.0D+00
-      r0 = 1.0D+00
-      do k = 1, 30
-        w0 = w0 + 1.0D+00 / k
-        r0 = -0.25D+00 * r0 / ( k * k ) * x2
-        cs0 = cs0 + r0 * w0
-      end do
-      byv0 = rp2 * ( ec * bjv0 - cs0 )
-      cs1 = 1.0D+00
-      w1 = 0.0D+00
-      r1 = 1.0D+00
-      do k = 1, 30
-        w1 = w1 + 1.0D+00 / k
-        r1 = -0.25D+00 * r1 / ( k * ( k + 1 ) ) * x2
-        cs1 = cs1 + r1 * ( 2.0D+00 * w1 + 1.0D+00 / ( k + 1.0D+00 ) )
-      end do
-      byv1 = rp2 * ( ec * bjv1 - 1.0D+00 / x - 0.25D+00 * x * cs1 )
-
-    end if
-
-  end if
-
-  by(0) = byv0
-  by(1) = byv1
-  do k = 2, n
-    byvk = 2.0D+00 * ( v0 + k - 1.0D+00 ) / x * byv1 - byv0
-    by(k) = byvk
-    byv0 = byv1
-    byv1 = byvk
-  end do
-
-  dy(0) = v0 / x * by(0) - by(1)
-  do k = 1, n
-    dy(k) = - ( k + v0 ) / x * by(k) + by(k-1)
-  end do
-
-  vm = n + v0
-
-  return
-end
-subroutine jyzo ( n, nt, rj0, rj1, ry0, ry1 )
-
-!*****************************************************************************80
-!
-!! JYZO computes the zeros of Bessel functions Jn(x), Yn(x) and derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    28 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order of the Bessel functions.
-!
-!    Input, integer ( kind = 4 ) NT, the number of zeros.
-!
-!    Output, real ( kind = 8 ) RJ0(NT), RJ1(NT), RY0(NT), RY1(NT), the zeros 
-!    of Jn(x), Jn'(x), Yn(x), Yn'(x).
-!
-  implicit none
-
-  integer ( kind = 4 ) nt
-
-  real ( kind = 8 ) bjn
-  real ( kind = 8 ) byn
-  real ( kind = 8 ) djn
-  real ( kind = 8 ) dyn
-  real ( kind = 8 ) fjn
-  real ( kind = 8 ) fyn
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) n_r8
-  real ( kind = 8 ) rj0(nt)
-  real ( kind = 8 ) rj1(nt)
-  real ( kind = 8 ) ry0(nt)
-  real ( kind = 8 ) ry1(nt)
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x0
-
-  n_r8 = real ( n, kind = 8 )
-
-  if ( n <= 20 ) then
-    x = 2.82141D+00 + 1.15859D+00 * n_r8 
-  else
-    x = n + 1.85576D+00 * n_r8 ** 0.33333D+00 &
-      + 1.03315D+00 / n_r8 ** 0.33333D+00
-  end if
-
-  l = 0
-
-  do
-
-    x0 = x
-    call jyndd ( n, x, bjn, djn, fjn, byn, dyn, fyn )
-    x = x - bjn / djn
-
-    if ( 1.0D-09 < abs ( x - x0 ) ) then
-      cycle
-    end if
-
-    l = l + 1
-    rj0(l) = x
-    x = x + 3.1416D+00 + ( 0.0972D+00 + 0.0679D+00 * n_r8 &
-      - 0.000354D+00 * n_r8 ** 2 ) / l
-
-    if ( nt <= l ) then
-      exit
-    end if
-
-  end do
-
-  if ( n <= 20 ) then
-    x = 0.961587D+00 + 1.07703D+00 * n_r8 
-  else
-    x = n_r8 + 0.80861D+00 * n_r8 ** 0.33333D+00 &
-      + 0.07249D+00 / n_r8 ** 0.33333D+00
-  end if
-
-  if ( n == 0 ) then
-    x = 3.8317D+00
-  end if
-
-  l = 0
-
-  do
-
-    x0 = x
-    call jyndd ( n, x, bjn, djn, fjn, byn, dyn, fyn )
-    x = x - djn / fjn
-    if ( 1.0D-09 < abs ( x - x0 ) ) then
-      cycle
-    end if
-    l = l + 1
-    rj1(l) = x
-    x = x + 3.1416D+00 + ( 0.4955D+00 + 0.0915D+00 * n_r8 &
-      - 0.000435D+00 * n_r8 ** 2 ) / l
-
-    if ( nt <= l ) then
-      exit
-    end if
-
-  end do
-
-  if ( n <= 20 ) then
-    x = 1.19477D+00 + 1.08933D+00 * n_r8 
-  else
-    x = n_r8 + 0.93158D+00 * n_r8 ** 0.33333D+00 &
-      + 0.26035D+00 / n_r8 ** 0.33333D+00
-  end if
- 
-  l = 0
-
-  do
-
-    x0 = x
-    call jyndd ( n, x, bjn, djn, fjn, byn, dyn, fyn )
-    x = x - byn / dyn
-
-    if ( 1.0D-09 < abs ( x - x0 ) ) then
-      cycle
-    end if
-
-    l = l + 1
-    ry0(l) = x 
-    x = x + 3.1416D+00 + ( 0.312D+00 + 0.0852D+00 * n_r8 &
-      - 0.000403D+00 * n_r8 ** 2 ) / l
-
-    if ( nt <= l ) then
-      exit
-    end if
-
-  end do
-
-  if ( n <= 20 ) then
-    x = 2.67257D+00 + 1.16099D+00 * n_r8 
-  else
-    x = n_r8 + 1.8211D+00 * n_r8 ** 0.33333D+00 &
-      + 0.94001D+00 / n_r8 ** 0.33333D+00
-  end if
-  
-  l = 0
-
-  do
-
-    x0 = x
-    call jyndd ( n, x, bjn, djn, fjn, byn, dyn, fyn )
-    x = x - dyn / fyn
-
-    if ( 1.0D-09 < abs ( x - x0 ) ) then
-      cycle
-    end if
-
-    l = l + 1
-    ry1(l) = x
-    x = x + 3.1416D+00 + ( 0.197D+00 + 0.0643D+00 * n_r8 &
-      -0.000286D+00 * n_r8 ** 2 ) / l 
-
-    if ( nt <= l ) then
-      exit
-    end if
-
-  end do
-
-  return
-end
-subroutine klvna ( x, ber, bei, ger, gei, der, dei, her, hei )
-
-!*****************************************************************************80
-!
-!! KLVNA: Kelvin functions ber(x), bei(x), ker(x), and kei(x), and derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    03 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) BER, BEI, GER, GEI, DER, DEI, HER, HEI, 
-!    the values of ber x, bei x, ker x, kei x, ber'x, bei'x, ker'x, kei'x.
-!
-  implicit none
-
-  real ( kind = 8 ) bei
-  real ( kind = 8 ) ber
-  real ( kind = 8 ) cn0
-  real ( kind = 8 ) cp0
-  real ( kind = 8 ) cs
-  real ( kind = 8 ) dei
-  real ( kind = 8 ) der
-  real ( kind = 8 ) el
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) fac
-  real ( kind = 8 ) gei
-  real ( kind = 8 ) ger
-  real ( kind = 8 ) gs
-  real ( kind = 8 ) hei
-  real ( kind = 8 ) her
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) km
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) pn0
-  real ( kind = 8 ) pn1
-  real ( kind = 8 ) pp0
-  real ( kind = 8 ) pp1
-  real ( kind = 8 ) qn0
-  real ( kind = 8 ) qn1
-  real ( kind = 8 ) qp0
-  real ( kind = 8 ) qp1
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r0
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) rc
-  real ( kind = 8 ) rs
-  real ( kind = 8 ) sn0
-  real ( kind = 8 ) sp0
-  real ( kind = 8 ) ss
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x2
-  real ( kind = 8 ) x4
-  real ( kind = 8 ) xc1
-  real ( kind = 8 ) xc2
-  real ( kind = 8 ) xd
-  real ( kind = 8 ) xe1
-  real ( kind = 8 ) xe2
-  real ( kind = 8 ) xt
-
-  pi = 3.141592653589793D+00
-  el = 0.5772156649015329D+00
-  eps = 1.0D-15
-
-  if ( x == 0.0D+00 ) then
-    ber = 1.0D+00
-    bei = 0.0D+00
-    ger = 1.0D+300
-    gei = -0.25D+00 * pi
-    der = 0.0D+00
-    dei = 0.0D+00
-    her = -1.0D+300
-    hei = 0.0D+00
-    return
-  end if
-
-  x2 = 0.25D+00 * x * x
-  x4 = x2 * x2
-
-  if ( abs ( x ) < 10.0D+00 ) then
-
-    ber = 1.0D+00
-    r = 1.0D+00
-    do m = 1, 60
-      r = -0.25D+00 * r / ( m * m ) / ( 2.0D+00 * m - 1.0D+00 ) ** 2 * x4
-      ber = ber + r
-      if ( abs ( r ) < abs ( ber ) * eps ) then
-        exit
-      end if
-    end do
-
-    bei = x2
-    r = x2
-    do m = 1, 60
-      r = -0.25D+00 * r / ( m * m ) / ( 2.0D+00 * m + 1.0D+00 ) ** 2 * x4
-      bei = bei + r
-      if ( abs ( r ) < abs ( bei ) * eps ) then
-        exit
-      end if
-    end do
-
-    ger = - ( log ( x / 2.0D+00 ) + el ) * ber + 0.25D+00 * pi * bei
-    r = 1.0D+00
-    gs = 0.0D+00
-    do m = 1, 60
-      r = -0.25D+00 * r / ( m * m ) / ( 2.0D+00 * m - 1.0D+00 ) ** 2 * x4
-      gs = gs + 1.0D+00 / ( 2.0D+00 * m - 1.0D+00 ) + 1.0D+00 / ( 2.0D+00 * m )
-      ger = ger + r * gs
-      if ( abs ( r * gs ) < abs ( ger ) * eps ) then
-        exit
-      end if
-    end do
-
-    gei = x2 - ( log ( x / 2.0D+00 ) + el ) * bei - 0.25D+00 * pi * ber
-    r = x2
-    gs = 1.0D+00
-    do m = 1, 60
-      r = -0.25D+00 * r / ( m * m ) / ( 2.0D+00 * m + 1.0D+00 ) ** 2 * x4
-      gs = gs + 1.0D+00 / ( 2.0D+00 * m ) + 1.0D+00 / ( 2.0D+00 * m + 1.0D+00 )
-      gei = gei + r * gs
-      if ( abs ( r * gs ) < abs ( gei ) * eps ) then
-        exit
-      end if
-    end do
-
-    der = -0.25D+00 * x * x2
-    r = der
-    do m = 1, 60
-      r = -0.25D+00 * r / m / ( m + 1.0D+00 ) &
-        / ( 2.0D+00 * m + 1.0D+00 ) ** 2 * x4
-      der = der + r
-      if ( abs ( r ) < abs ( der ) * eps ) then
-        exit
-      end if
-    end do
-
-    dei = 0.5D+00 * x
-    r = dei
-    do m = 1, 60
-      r = -0.25D+00 * r / ( m * m ) / ( 2.0D+00 * m - 1.0D+00 ) &
-        / ( 2.0D+00 * m + 1.0D+00 ) * x4
-      dei = dei + r
-      if ( abs ( r ) < abs ( dei ) * eps ) then
-        exit
-      end if
-    end do
-
-    r = -0.25D+00 * x * x2
-    gs = 1.5D+00
-    her = 1.5D+00 * r - ber / x &
-      - ( log ( x / 2.0D+00 ) + el ) * der + 0.25D+00 * pi * dei
-    do m = 1, 60
-      r = -0.25D+00 * r / m / ( m + 1.0D+00 ) &
-        / ( 2.0D+00 * m + 1.0D+00 ) ** 2 * x4
-      gs = gs + 1.0D+00 / ( 2 * m + 1.0D+00 ) + 1.0D+00 &
-        / ( 2 * m + 2.0D+00 )
-      her = her + r * gs
-      if ( abs ( r * gs ) < abs ( her ) * eps ) then
-        exit
-      end if
-    end do
-
-    r = 0.5D+00 * x
-    gs = 1.0D+00
-    hei = 0.5D+00 * x - bei / x &
-      - ( log ( x / 2.0D+00 ) + el ) * dei - 0.25D+00 * pi * der
-    do m = 1, 60
-      r = -0.25D+00 * r / ( m * m ) / ( 2 * m - 1.0D+00 ) &
-        / ( 2 * m + 1.0D+00 ) * x4
-      gs = gs + 1.0D+00 / ( 2.0D+00 * m ) + 1.0D+00 &
-        / ( 2 * m + 1.0D+00 )
-      hei = hei + r * gs
-      if ( abs ( r * gs ) < abs ( hei ) * eps ) then 
-        return
-      end if
-    end do
-
-  else
-
-    pp0 = 1.0D+00
-    pn0 = 1.0D+00
-    qp0 = 0.0D+00
-    qn0 = 0.0D+00
-    r0 = 1.0D+00
-
-    if ( abs ( x ) < 40.0D+00 ) then
-      km = 18
-    else
-      km = 10
-    end if
-
-    fac = 1.0D+00
-    do k = 1, km
-      fac = -fac
-      xt = 0.25D+00 * k * pi - int ( 0.125D+00 * k ) * 2.0D+00 * pi
-      cs = cos ( xt )
-      ss = sin ( xt )
-      r0 = 0.125D+00 * r0 * ( 2.0D+00 * k - 1.0D+00 ) ** 2 / k / x
-      rc = r0 * cs
-      rs = r0 * ss
-      pp0 = pp0 + rc
-      pn0 = pn0 + fac * rc
-      qp0 = qp0 + rs
-      qn0 = qn0 + fac * rs
-    end do
-
-    xd = x / sqrt (2.0D+00 )
-    xe1 = exp ( xd )
-    xe2 = exp ( - xd )
-    xc1 = 1.0D+00 / sqrt ( 2.0D+00 * pi * x )
-    xc2 = sqrt ( 0.5D+00 * pi / x )
-    cp0 = cos ( xd + 0.125D+00 * pi )
-    cn0 = cos ( xd - 0.125D+00 * pi )
-    sp0 = sin ( xd + 0.125D+00 * pi )
-    sn0 = sin ( xd - 0.125D+00 * pi )
-    ger = xc2 * xe2 * (  pn0 * cp0 - qn0 * sp0 )
-    gei = xc2 * xe2 * ( -pn0 * sp0 - qn0 * cp0 )
-    ber = xc1 * xe1 * (  pp0 * cn0 + qp0 * sn0 ) - gei / pi
-    bei = xc1 * xe1 * (  pp0 * sn0 - qp0 * cn0 ) + ger / pi
-    pp1 = 1.0D+00
-    pn1 = 1.0D+00
-    qp1 = 0.0D+00
-    qn1 = 0.0D+00
-    r1 = 1.0D+00
-    fac = 1.0D+00
-
-    do k = 1, km
-      fac = -fac
-      xt = 0.25D+00 * k * pi - int ( 0.125D+00 * k ) * 2.0D+00 * pi
-      cs = cos ( xt )
-      ss = sin ( xt )
-      r1 = 0.125D+00 * r1 &
-        * ( 4.0D+00 - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / k / x
-      rc = r1 * cs
-      rs = r1 * ss
-      pp1 = pp1 + fac * rc
-      pn1 = pn1 + rc
-      qp1 = qp1 + fac * rs
-      qn1 = qn1 + rs
-    end do
-
-    her = xc2 * xe2 * ( - pn1 * cn0 + qn1 * sn0 )
-    hei = xc2 * xe2 * (   pn1 * sn0 + qn1 * cn0 )
-    der = xc1 * xe1 * (   pp1 * cp0 + qp1 * sp0 ) - hei / pi
-    dei = xc1 * xe1 * (   pp1 * sp0 - qp1 * cp0 ) + her / pi
-
-  end if
-
-  return
-end
-subroutine klvnb ( x, ber, bei, ger, gei, der, dei, her, hei )
-
-!*****************************************************************************80
-!
-!! KLVNB: Kelvin functions ber(x), bei(x), ker(x), and kei(x), and derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    03 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) BER, BEI, GER, GEI, DER, DEI, HER, HEI, 
-!    the values of ber x, bei x, ker x, kei x, ber'x, bei'x, ker'x, kei'x.
-!
-  implicit none
-
-  real ( kind = 8 ) bei
-  real ( kind = 8 ) ber
-  real ( kind = 8 ) csn
-  real ( kind = 8 ) csp
-  real ( kind = 8 ) dei
-  real ( kind = 8 ) der
-  real ( kind = 8 ) fxi
-  real ( kind = 8 ) fxr
-  real ( kind = 8 ) gei
-  real ( kind = 8 ) ger
-  real ( kind = 8 ) hei
-  real ( kind = 8 ) her
-  integer ( kind = 4 ) l
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) pni
-  real ( kind = 8 ) pnr
-  real ( kind = 8 ) ppi
-  real ( kind = 8 ) ppr
-  real ( kind = 8 ) ssn
-  real ( kind = 8 ) ssp
-  real ( kind = 8 ) t
-  real ( kind = 8 ) t2
-  real ( kind = 8 ) tni
-  real ( kind = 8 ) tnr
-  real ( kind = 8 ) tpi
-  real ( kind = 8 ) tpr
-  real ( kind = 8 ) u
-  real ( kind = 8 ) v
-  real ( kind = 8 ) x
-  real ( kind = 8 ) yc1
-  real ( kind = 8 ) yc2
-  real ( kind = 8 ) ye1
-  real ( kind = 8 ) ye2
-  real ( kind = 8 ) yd
-
-  pi = 3.141592653589793D+00
-
-  if ( x == 0.0D+00 ) then
-
-    ber = 1.0D+00
-    bei = 0.0D+00
-    ger = 1.0D+300
-    gei = -0.25D+00 * pi
-    der = 0.0D+00
-    dei = 0.0D+00
-    her = -1.0D+300
-    hei = 0.0D+00
-
-  else if ( x < 8.0D+00 ) then
-
-    t = x / 8.0D+00
-    t2 = t * t
-    u = t2 * t2
-
-    ber = (((((( &
-      - 0.901D-05 * u &
-      + 0.122552D-02 ) * u &
-      - 0.08349609D+00 ) * u &
-      + 2.64191397D+00 ) * u &
-      - 32.36345652D+00 ) * u &
-      + 113.77777774D+00 ) * u &
-      - 64.0D+00 ) * u &
-      + 1.0D+00
-
-    bei = t * t * (((((( &
-        0.11346D-03 * u &
-      - 0.01103667D+00 ) * u &
-      + 0.52185615D+00 ) * u &
-      - 10.56765779D+00 ) * u &
-      + 72.81777742D+00 ) * u &
-      - 113.77777774D+00 ) * u &
-      + 16.0D+00 )
-
-    ger = (((((( &
-      - 0.2458D-04 * u &
-      + 0.309699D-02 ) * u &
-      - 0.19636347D+00 ) * u &
-      + 5.65539121D+00 ) * u &
-      - 60.60977451D+00 ) * u &
-      + 171.36272133D+00 ) * u &
-      - 59.05819744D+00 ) * u &
-      - 0.57721566D+00
-
-    ger = ger - log ( 0.5D+00 * x ) * ber + 0.25D+00 * pi * bei
-
-    gei = t2 * (((((( &
-        0.29532D-03 * u &
-      - 0.02695875D+00 ) * u &
-      + 1.17509064D+00 ) * u &
-      - 21.30060904D+00 ) * u &
-      + 124.2356965D+00 ) * u &
-      - 142.91827687D+00 ) * u &
-      + 6.76454936D+00 )
-
-    gei = gei - log ( 0.5D+00 * x ) * bei - 0.25D+00 * pi * ber
-
-    der = x * t2 * (((((( &
-      - 0.394D-05 * u &
-      + 0.45957D-03 ) * u &
-      - 0.02609253D+00 ) * u &
-      + 0.66047849D+00 ) * u &
-      - 6.0681481D+00 ) * u &
-      + 14.22222222D+00 ) * u &
-      - 4.0D+00 )
-
-    dei = x * (((((( &
-        0.4609D-04 * u &
-      - 0.379386D-02 ) * u &
-      + 0.14677204D+00 ) * u &
-      - 2.31167514D+00 ) * u &
-      + 11.37777772D+00 ) * u &
-      - 10.66666666D+00 ) * u &
-      + 0.5D+00 ) 
-
-    her = x * t2 * (((((( &
-      - 0.1075D-04 * u &
-      + 0.116137D-02 ) * u &
-      - 0.06136358D+00 ) * u &
-      + 1.4138478D+00 ) * u &
-      - 11.36433272D+00 ) * u &
-      + 21.42034017D+00 ) * u &
-      - 3.69113734D+00 )
-
-    her = her - log ( 0.5D+00 * x ) * der - ber / x  &
-      + 0.25D+00 * pi * dei
-
-    hei = x * (((((( &
-        0.11997D-03 * u &
-      - 0.926707D-02 ) * u &
-      + 0.33049424D+00 ) * u &
-      - 4.65950823D+00 ) * u &
-      + 19.41182758D+00 ) * u &
-      - 13.39858846D+00 ) * u &
-      + 0.21139217D+00 )
-
-    hei = hei - log ( 0.5D+00 * x ) * dei - bei / x  &
-      - 0.25D+00 * pi * der
-
-  else
-
-    t = 8.0D+00 / x
-
-    do l = 1, 2
-
-      v = ( -1.0D+00 ) ** l * t
-
-      tpr = (((( &
-          0.6D-06 * v &
-        - 0.34D-05 ) * v &
-        - 0.252D-04 ) * v &
-        - 0.906D-04 ) * v * v &
-        + 0.0110486D+00 ) * v
-
-      tpi = (((( &
-          0.19D-05 * v &
-        + 0.51D-05 ) * v * v &
-        - 0.901D-04 ) * v &
-        - 0.9765D-03 ) * v &
-        - 0.0110485D+00 ) * v &
-        - 0.3926991D+00
-
-      if ( l == 1 ) then
-        tnr = tpr
-        tni = tpi
-      end if
-
-    end do
-
-    yd = x / sqrt ( 2.0D+00 )
-    ye1 = exp ( yd + tpr )
-    ye2 = exp ( - yd + tnr )
-    yc1 = 1.0D+00 / sqrt ( 2.0D+00 * pi * x )
-    yc2 = sqrt ( pi / ( 2.0D+00 * x ) )
-    csp = cos ( yd + tpi )
-    ssp = sin ( yd + tpi )
-    csn = cos ( - yd + tni )
-    ssn = sin ( - yd + tni )
-    ger = yc2 * ye2 * csn
-    gei = yc2 * ye2 * ssn
-    fxr = yc1 * ye1 * csp
-    fxi = yc1 * ye1 * ssp
-    ber = fxr - gei / pi
-    bei = fxi + ger / pi
-
-    do l = 1, 2
-
-      v = ( -1.0D+00 ) ** l * t
-
-      ppr = ((((( &
-          0.16D-05 * v &
-        + 0.117D-04 ) * v &
-        + 0.346D-04 ) * v &
-        + 0.5D-06 ) * v &
-        - 0.13813D-02 ) * v &
-        - 0.0625001D+00 ) * v &
-        + 0.7071068D+00
-
-      ppi = ((((( &
-        - 0.32D-05 * v &
-        - 0.24D-05 ) * v &
-        + 0.338D-04 ) * v &
-        + 0.2452D-03 ) * v &
-        + 0.13811D-02 ) * v &
-        - 0.1D-06 ) * v &
-        + 0.7071068D+00
-
-      if ( l == 1 ) then
-        pnr = ppr
-        pni = ppi
-      end if
-
-    end do
-
-    her =     gei * pni - ger * pnr
-    hei = - ( gei * pnr + ger * pni )
-    der = fxr * ppr - fxi * ppi - hei / pi
-    dei = fxi * ppr + fxr * ppi + her / pi
-
-  end if
-
-  return
-end
-subroutine klvnzo ( nt, kd, zo )
-
-!*****************************************************************************80
-!
-!! KLVNZO computes zeros of the Kelvin functions.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    15 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) NT, the number of zeros.
-!
-!    Input, integer ( kind = 4 ) KD, the function code.
-!    1 for ber x, 
-!    2 for bei x,
-!    3 for ker x, 
-!    4 for kei x,
-!    5 for ber' x, 
-!    6 for bei' x,
-!    7 for ker' x, 
-!    8 for kei' x.
-!
-!    Output, real ( kind = 8 ) ZO(NT), the zeros of the given Kelvin function.
-!
-  implicit none
-
-  integer ( kind = 4 ) nt
-
-  real ( kind = 8 ) bei
-  real ( kind = 8 ) ber
-  real ( kind = 8 ) ddi
-  real ( kind = 8 ) ddr
-  real ( kind = 8 ) dei
-  real ( kind = 8 ) der
-  real ( kind = 8 ) gdi
-  real ( kind = 8 ) gdr
-  real ( kind = 8 ) gei
-  real ( kind = 8 ) ger
-  real ( kind = 8 ) hei
-  real ( kind = 8 ) her
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) rt
-  real ( kind = 8 ) rt0(8)
-  real ( kind = 8 ) zo(nt)
-
-  rt0(1) = 2.84891D+00
-  rt0(2) = 5.02622D+00
-  rt0(3) = 1.71854D+00
-  rt0(4) = 3.91467D+00
-  rt0(5) = 6.03871D+00
-  rt0(6) = 3.77268D+00
-  rt0(7) = 2.66584D+00
-  rt0(8) = 4.93181D+00
-
-  rt = rt0(kd)
-
-  do m = 1, nt
-
-    do
-
-      call klvna ( rt, ber, bei, ger, gei, der, dei, her, hei )
-
-      if ( kd == 1 ) then
-        rt = rt - ber / der
-      else if ( kd == 2 ) then
-        rt = rt - bei / dei
-      else if ( kd == 3 ) then
-        rt = rt - ger / her
-      else if ( kd == 4 ) then
-        rt = rt - gei / hei
-      else if ( kd == 5 ) then
-        ddr = - bei - der / rt
-        rt = rt - der / ddr
-      else if ( kd == 6 ) then
-        ddi = ber - dei / rt
-        rt = rt - dei / ddi
-      else if ( kd == 7 ) then
-        gdr = - gei - her / rt
-        rt = rt - her / gdr
-      else
-        gdi = ger - hei / rt
-        rt = rt - hei / gdi
-      end if
-
-      if ( abs ( rt - rt0(kd) ) <= 5.0D-10 ) then
-        exit
-      end if
-
-      rt0(kd) = rt
-
-    end do
-
-    zo(m) = rt
-    rt = rt + 4.44D+00
-
-  end do
-
-  return
-end
-subroutine kmn ( m, n, c, cv, kd, df, dn, ck1, ck2 )
-
-!*****************************************************************************80
-!
-!! KMN: expansion coefficients of prolate or oblate spheroidal functions.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    02 August 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
-!
-!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
-!
-!    Input, real ( kind = 8 ) C, spheroidal parameter.
-!
-!    Input, real ( kind = 8 ) CV, the characteristic value.
-!
-!    Input, integer ( kind = 4 ) KD, the function code.
-!    1, the prolate function.
-!    -1, the oblate function.
-!
-!    Input, real ( kind = 8 ) DF(*), the expansion coefficients.
-!
-  implicit none
-
-  real ( kind = 8 ) c
-  real ( kind = 8 ) ck1
-  real ( kind = 8 ) ck2
-  real ( kind = 8 ) cs
-  real ( kind = 8 ) cv
-  real ( kind = 8 ) df(200)
-  real ( kind = 8 ) dn(200)
-  real ( kind = 8 ) dnp
-  real ( kind = 8 ) g0
-  real ( kind = 8 ) gk0
-  real ( kind = 8 ) gk1
-  real ( kind = 8 ) gk2
-  real ( kind = 8 ) gk3
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) ip
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  integer ( kind = 4 ) nm
-  integer ( kind = 4 ) nm1
-  integer ( kind = 4 ) nn
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) r2
-  real ( kind = 8 ) r3
-  real ( kind = 8 ) r4
-  real ( kind = 8 ) r5
-  real ( kind = 8 ) rk(200)
-  real ( kind = 8 ) sa0
-  real ( kind = 8 ) sb0
-  real ( kind = 8 ) su0
-  real ( kind = 8 ) sw
-  real ( kind = 8 ) t
-  real ( kind = 8 ) tp(200)
-  real ( kind = 8 ) u(200)
-  real ( kind = 8 ) v(200)
-  real ( kind = 8 ) w(200)
-
-  nm = 25 + int ( 0.5D+00 * ( n - m ) + c )
-  nn = nm + m
-  cs = c * c * kd
-
-  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
-    ip = 0
-  else
-    ip = 1
-  end if
-
-  do i = 1, nn + 3
-
-    if ( ip == 0 ) then
-      k = - 2 * ( i - 1 )
-    else
-      k = - ( 2 * i - 3 )
-    end if
-
-    gk0 = 2.0D+00 * m + k
-    gk1 = ( m + k ) * ( m + k + 1.0D+00 )
-    gk2 = 2.0D+00 * ( m + k ) - 1.0D+00
-    gk3 = 2.0D+00 * ( m + k ) + 3.0D+00
-    u(i) = gk0 * ( gk0 - 1.0D+00 ) * cs / ( gk2 * ( gk2 + 2.0D+00 ) )
-    v(i) = gk1 - cv + ( 2.0D+00 * ( gk1 - m * m ) - 1.0D+00 ) * cs &
-      / ( gk2 * gk3 )
-    w(i) = ( k + 1.0D+00 ) * ( k + 2.0D+00 ) * cs / ( ( gk2 + 2.0D+00 ) * gk3 )
-
-  end do
-
-  do k = 1, m
-    t = v(m+1)
-    do l = 0, m - k - 1
-      t = v(m-l) - w(m-l+1) * u(m-l) / t
-    end do
-    rk(k) = -u(k) / t
-  end do
-
-  r = 1.0D+00
-  do k = 1, m
-    r = r * rk(k)
-    dn(k) = df(1) * r
-  end do
-
-  tp(nn) = v(nn+1)
-  do k = nn - 1, m + 1,-1
-    tp(k) = v(k+1) - w(k+2) * u(k+1) / tp(k+1)
-    if ( m + 1 < k ) then
-      rk(k) = -u(k) / tp(k)
-    end if
-  end do
-
-  if ( m == 0 ) then
-    dnp = df(1)
-  else
-    dnp = dn(m)
-  end if
-
-  dn(m+1) = ( - 1.0D+00 ) ** ip * dnp * cs &
-    / ( ( 2.0D+00 * m - 1.0D+00 ) &
-    * ( 2.0D+00 * m + 1.0D+00 - 4.0D+00 * ip ) * tp(m+1) )
-  do k = m + 2, nn
-    dn(k) = rk(k) * dn(k-1)
-  end do
-
-  r1 = 1.0D+00
-  do j = 1, ( n + m + ip ) / 2
-       r1 = r1 * ( j + 0.5D+00 * ( n + m + ip ) )
-  end do
-  nm1 = ( n - m ) / 2
-  r = 1.0D+00
-  do j = 1, 2 * m + ip
-    r = r * j
-  end do
-  su0 = r * df(1)
-
-  do k = 2, nm
-    r = r * ( m + k - 1.0D+00 ) * ( m + k + ip - 1.5D+00 ) &
-      / ( k - 1.0D+00 ) / ( k + ip - 1.5D+00 )
-    su0 = su0 + r * df(k)
-    if ( nm1 < k .and. &
-      abs ( ( su0 - sw ) / su0 ) < 1.0D-14 ) then
-      exit
-    end if
-    sw = su0
-  end do
-
-  if ( kd /= 1 ) then
-
-    r2 = 1.0D+00
-    do j = 1,m
-      r2 = 2.0D+00 * c * r2 * j
-    end do
-    r3 = 1.0D+00
-    do j = 1, ( n - m - ip ) / 2
-      r3 = r3 * j
-    end do
-    sa0 = ( 2.0D+00 * ( m + ip ) + 1.0D+00 ) * r1 &
-      / ( 2.0D+00 ** n * c ** ip * r2 * r3 * df(1) )
-    ck1 = sa0 * su0
-
-    if ( kd == -1 ) then
-      return
-    end if
-
-  end if
-
-  r4 = 1.0D+00
-  do j = 1, ( n - m - ip ) / 2
-    r4 = 4.0D+00 * r4 * j
-  end do
-  r5 = 1.0D+00
-  do j = 1, m
-    r5 = r5 * ( j + m ) / c
-  end do
-
-  if ( m == 0 ) then
-    g0 = df(1)
-  else
-    g0 = dn(m)
-  end if
-
-  sb0 = ( ip + 1.0D+00 ) * c ** ( ip + 1 ) &
-    / ( 2.0D+00 * ip * ( m - 2.0D+00 ) + 1.0D+00 ) &
-    / ( 2.0D+00 * m - 1.0D+00 )
-
-  ck2 = ( -1 ) ** ip * sb0 * r4 * r5 * g0 / r1 * su0
-
-  return
-end
-subroutine lagzo ( n, x, w )
-
-!*****************************************************************************80
-!
-!! LAGZO computes zeros of the Laguerre polynomial, and integration weights.
-!
-!  Discussion:
-!
-!    This procedure computes the zeros of Laguerre polynomial Ln(x) in the 
-!    interval [0,ě], and the corresponding weighting coefficients for 
-!    Gauss-Laguerre integration.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    07 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order of the Laguerre polynomial.
-!
-!    Output, real ( kind = 8 ) X(N), the zeros of the Laguerre polynomial.
-!
-!    Output, real ( kind = 8 ) W(N), the weighting coefficients.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) fd
-  real ( kind = 8 ) gd
-  real ( kind = 8 ) hn
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) it
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) nr
-  real ( kind = 8 ) p
-  real ( kind = 8 ) pd
-  real ( kind = 8 ) pf
-  real ( kind = 8 ) q
-  real ( kind = 8 ) w(n)
-  real ( kind = 8 ) wp
-  real ( kind = 8 ) x(n)
-  real ( kind = 8 ) z
-  real ( kind = 8 ) z0
-
-  hn = 1.0D+00 / real ( n, kind = 8 )
-
-  do nr = 1, n
-
-    if ( nr == 1 ) then
-      z = hn
-    else
-      z = x(nr-1) + hn * nr ** 1.27D+00
-    end if
-
-    it = 0
-
-    do
-
-      it = it + 1
-      z0 = z
-      p = 1.0D+00
-      do i = 1, nr - 1
-        p = p * ( z - x(i) )
-      end do
-
-      f0 = 1.0D+00
-      f1 = 1.0D+00 - z
-      do k = 2, n
-        pf = (( 2.0D+00 * k - 1.0D+00 - z ) * f1 &
-          - ( k - 1.0D+00 ) * f0 ) / k
-        pd = k / z * ( pf - f1 )
-        f0 = f1
-        f1 = pf
-      end do
-
-      fd = pf / p
-
-      q = 0.0D+00
-      do i = 1, nr - 1
-        wp = 1.0D+00
-        do j = 1, nr - 1
-          if ( j /= i ) then
-            wp = wp * ( z - x(j) )
-          end if
-        end do
-        q = q + wp
-      end do
-
-      gd = ( pd - q * fd ) / p
-      z = z - fd / gd
-
-      if ( 40 < it .or. abs ( ( z - z0 ) / z ) <= 1.0D-15 ) then
-        exit
-      end if
-
-    end do
-
-    x(nr) = z
-    w(nr) = 1.0D+00 / ( z * pd * pd )
-
-  end do
-
-  return
-end
-subroutine lamn ( n, x, nm, bl, dl )
-
-!*****************************************************************************80
-!
-!! LAMN computes lambda functions and derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    14 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, integer ( kind = 4 ) NM, the highest order computed.
-!
-!    Output, real ( kind = 8 ) BL(0:N), DL(0:N), the
-!    value of the lambda function and its derivative of orders 0 through N.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) bg
-  real ( kind = 8 ) bk
-  real ( kind = 8 ) bl(0:n)
-  real ( kind = 8 ) bs
-  real ( kind = 8 ) dl(0:n)
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r0
-  real ( kind = 8 ) uk
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x2
-
-  nm = n
-
-  if ( abs ( x ) < 1.0D-100 ) then
-    do k = 0, n
-      bl(k) = 0.0D+00
-      dl(k) = 0.0D+00
-    end do
-    bl(0) = 1.0D+00
-    dl(1) = 0.5D+00
-    return
-  end if
-
-  if ( x <= 12.0D+00 ) then
-
-    x2 = x * x
-
-    do k = 0, n
-      bk = 1.0D+00
-      r = 1.0D+00
-      do i = 1, 50
-        r = -0.25D+00 * r * x2 / ( i * ( i + k ) )
-        bk = bk + r
-        if ( abs ( r ) < abs ( bk ) * 1.0D-15 ) then
-          exit
-        end if
-      end do
-
-      bl(k) = bk
-      if ( 1 <= k ) then
-        dl(k-1) = - 0.5D+00 * x / k * bk
-      end if
-
-    end do
-
-    uk = 1.0D+00
-    r = 1.0D+00
-    do i = 1, 50
-      r = -0.25D+00 * r * x2 / ( i * ( i + n + 1.0D+00 ) )
-      uk = uk + r
-      if ( abs ( r ) < abs ( uk ) * 1.0D-15 ) then
-        exit
-      end if
-    end do
-
-    dl(n) = -0.5D+00 * x / ( n + 1.0D+00 ) * uk
-    return
-
-  end if
-
-  if ( n == 0 ) then
-    nm = 1
-  end if
-
-  m = msta1 ( x, 200 )
-
-  if ( m < nm ) then
-    nm = m
-  else
-    m = msta2 ( x, nm, 15 )
-  end if
-
-  bs = 0.0D+00
-  f0 = 0.0D+00
-  f1 = 1.0D-100
-  do k = m, 0, -1
-    f = 2.0D+00 * ( k + 1.0D+00 ) * f1 / x - f0
-    if ( k <= nm ) then
-      bl(k) = f
-    end if
-    if ( k == 2 * int ( k / 2 ) ) then
-      bs = bs + 2.0D+00 * f
-    end if
-    f0 = f1
-    f1 = f
-  end do
-
-  bg = bs - f
-  do k = 0, nm
-    bl(k) = bl(k) / bg
-  end do
-
-  r0 = 1.0D+00
-  do k = 1, nm
-    r0 = 2.0D+00 * r0 * k / x
-    bl(k) = r0 * bl(k)
-  end do
-
-  dl(0) = -0.5D+00 * x * bl(1)
-  do k = 1, nm
-    dl(k) = 2.0D+00 * k / x * ( bl(k-1) - bl(k) )
-  end do
-
-  return
-end
-subroutine lamv ( v, x, vm, vl, dl )
-
-!*****************************************************************************80
-!
-!! LAMV computes lambda functions and derivatives of arbitrary order.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    31 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) V, the order.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) VM, the highest order computed.
-!
-!    Output, real ( kind = 8 ) VL(0:*), DL(0:*), the Lambda function and 
-!    derivative, of orders N+V0.
-!
-  implicit none
-
-  real ( kind = 8 ) v
-
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) bjv0
-  real ( kind = 8 ) bjv1
-  real ( kind = 8 ) bk
-  real ( kind = 8 ) ck
-  real ( kind = 8 ) cs
-  real ( kind = 8 ) dl(0:int(v))
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) f2
-  real ( kind = 8 ) fac
-  real ( kind = 8 ) ga
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k0
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) px
-  real ( kind = 8 ) qx
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r0
-  real ( kind = 8 ) rc
-  real ( kind = 8 ) rp
-  real ( kind = 8 ) rp2
-  real ( kind = 8 ) rq
-  real ( kind = 8 ) sk
-  real ( kind = 8 ) uk
-  real ( kind = 8 ) v0
-  real ( kind = 8 ) vk
-  real ( kind = 8 ) vl(0:int(v))
-  real ( kind = 8 ) vm
-  real ( kind = 8 ) vv
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x2
-  real ( kind = 8 ) xk
-
-  pi = 3.141592653589793D+00
-  rp2 = 0.63661977236758D+00
-  x = abs ( x )
-  x2 = x * x
-  n = int ( v )
-  v0 = v - n
-  vm = v
-
-  if ( x <= 12.0D+00 ) then
-
-    do k = 0, n
-
-      vk = v0 + k
-      bk = 1.0D+00
-      r = 1.0D+00
-
-      do i = 1, 50
-        r = -0.25D+00 * r * x2 / ( i * ( i + vk ) )
-        bk = bk + r
-        if ( abs ( r ) < abs ( bk ) * 1.0D-15 ) then
-          exit
-        end if
-      end do
-
-      vl(k) = bk
-      uk = 1.0D+00
-      r = 1.0D+00
-      do i = 1, 50
-        r = -0.25D+00 * r * x2 / ( i * ( i + vk + 1.0D+00 ))
-        uk = uk + r
-        if ( abs ( r ) < abs ( uk ) * 1.0D-15 ) then
-          exit
-        end if
-      end do
-
-      dl(k) = - 0.5D+00 * x / ( vk + 1.0D+00 ) * uk
-
-    end do
-
-    return
-
-  end if
-
-  if ( x < 35.0D+00 ) then
-    k0 = 11
-  else if ( x < 50.0D+00 ) then
-    k0 = 10
-  else
-    k0 = 8
-  end if
-
-  do j = 0, 1
-    vv = 4.0D+00 * ( j + v0 ) * ( j + v0 )
-    px = 1.0D+00
-    rp = 1.0D+00
-    do k = 1, k0
-      rp = - 0.78125D-02 * rp * ( vv - ( 4.0D+00 * k - 3.0D+00 ) ** 2 ) &
-        * ( vv - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
-        / ( k * ( 2.0 * k - 1.0D+00 ) * x2 )
-      px = px + rp
-    end do
-    qx = 1.0D+00
-    rq = 1.0D+00
-    do k = 1, k0
-      rq = - 0.78125D-02 * rq * ( vv - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
-        * ( vv - ( 4.0D+00 * k + 1.0D+00 ) ** 2 ) &
-        / ( k * ( 2.0D+00 * k + 1.0D+00 ) * x2 )
-      qx = qx + rq
-    end do
-    qx = 0.125D+00 * ( vv - 1.0D+00 ) * qx / x
-    xk = x - ( 0.5D+00 * ( j + v0 ) + 0.25D+00 ) * pi
-    a0 = sqrt ( rp2 / x )
-    ck = cos ( xk )
-    sk = sin ( xk )
-    if ( j == 0 ) then
-      bjv0 = a0 * ( px * ck - qx * sk )
-    else
-      bjv1 = a0 * ( px * ck - qx * sk )
-    end if
-  end do
-
-  if ( v0 == 0.0D+00 ) then
-    ga = 1.0D+00
-  else
-    call gam0 ( v0, ga )
-    ga = v0 * ga
-  end if
-
-  fac = ( 2.0D+00 / x ) ** v0 * ga
-  vl(0) = bjv0
-  dl(0) = - bjv1 + v0 / x * bjv0
-  vl(1) = bjv1
-  dl(1) = bjv0 - ( 1.0D+00 + v0 ) / x * bjv1
-  r0 = 2.0D+00 * ( 1.0D+00 + v0 ) / x
-
-  if ( n <= 1 ) then
-    vl(0) = fac * vl(0)
-    dl(0) = fac * dl(0) - v0 / x * vl(0)
-    vl(1) = fac * r0 * vl(1)
-    dl(1) = fac * r0 * dl(1) - ( 1.0D+00 + v0 ) / x * vl(1)
-    return
-  end if
-
-  if ( 2 <= n .and. n <= int ( 0.9D+00 * x ) ) then
-
-    f0 = bjv0
-    f1 = bjv1
-    do k = 2, n
-      f = 2.0D+00 * ( k + v0 - 1.0D+00 ) / x * f1 - f0
-      f0 = f1
-      f1 = f
-      vl(k) = f
-    end do
-
-  else if ( 2 <= n ) then
-
-    m = msta1 ( x, 200 )
-    if ( m < n ) then
-      n = m
-    else
-      m = msta2 ( x, n, 15 )
-    end if
-    f2 = 0.0D+00
-    f1 = 1.0D-100
-    do k = m, 0, -1
-      f = 2.0D+00 * ( v0 + k + 1.0D+00 ) / x * f1 - f2
-      if ( k <= n ) then
-        vl(k) = f
-      end if
-      f2 = f1
-      f1 = f
-    end do
-
-    if ( abs ( bjv0 ) <= abs ( bjv1 ) ) then
-      cs = bjv1 / f2
-    else
-      cs = bjv0 / f
-    end if
-
-    do k = 0, n
-      vl(k) = cs * vl(k)
-    end do
-
-  end if
-
-  vl(0) = fac * vl(0)
-  do j = 1, n
-    rc = fac * r0
-    vl(j) = rc * vl(j)
-    dl(j-1) = - 0.5D+00 * x / ( j + v0 ) * vl(j)
-    r0 = 2.0D+00 * ( j + v0 + 1 ) / x * r0
-  end do
-  dl(n) = 2.0D+00 * ( v0 + n ) * ( vl(n-1) - vl(n) ) / x
-  vm = n + v0
-
-  return
-end
-subroutine legzo ( n, x, w )
-
-!*****************************************************************************80
-!
-!! LEGZO computes the zeros of Legendre polynomials, and integration weights.
-!
-!  Discussion:
-!
-!    This procedure computes the zeros of Legendre polynomial Pn(x) in the 
-!    interval [-1,1], and the corresponding weighting coefficients for 
-!    Gauss-Legendre integration.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    13 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order of the polynomial.
-!
-!    Output, real ( kind = 8 ) X(N), W(N), the zeros of the polynomial,
-!    and the corresponding weights.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) fd
-  real ( kind = 8 ) gd
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) n0
-  integer ( kind = 4 ) nr
-  real ( kind = 8 ) p
-  real ( kind = 8 ) pd
-  real ( kind = 8 ) pf
-  real ( kind = 8 ) q
-  real ( kind = 8 ) w(n)
-  real ( kind = 8 ) wp
-  real ( kind = 8 ) x(n)
-  real ( kind = 8 ) z
-  real ( kind = 8 ) z0
-
-  n0 = ( n + 1 ) / 2
-
-  do nr = 1, n0
-
-    z = cos ( 3.1415926D+00 * ( nr - 0.25D+00 ) / n )
-
-    do
-
-      z0 = z
-      p = 1.0D+00
-      do i = 1, nr - 1
-        p = p * ( z - x(i))
-      end do
-      f0 = 1.0D+00
-      if ( nr == n0 .and. n /= 2 * int ( n / 2 ) ) then
-        z = 0.0D+00
-      end if
-      f1 = z
-      do k = 2, n
-        pf = ( 2.0D+00 - 1.0D+00 / k ) * z * f1 &
-          - ( 1.0D+00 - 1.0D+00 / k ) * f0
-        pd = k * ( f1 - z * pf ) / ( 1.0D+00 - z * z )
-        f0 = f1
-        f1 = pf
-      end do
-
-      if ( z == 0.0D+00 ) then
-        exit
-      end if
-
-      fd = pf / p
-      q = 0.0D+00
-      do i = 1, nr - 1
-        wp = 1.0D+00
-        do j = 1, nr - 1
-          if ( j /= i ) then
-            wp = wp * ( z - x(j) )
-          end if
-        end do
-        q = q + wp
-      end do
-      gd = ( pd - q * fd ) / p
-      z = z - fd / gd
-
-      if ( abs ( z - z0 ) < abs ( z ) * 1.0D-15 ) then
-        exit
-      end if
-
-    end do
-
-    x(nr) = z
-    x(n+1-nr) = - z
-    w(nr) = 2.0D+00 / ( ( 1.0D+00 - z * z ) * pd * pd )
-    w(n+1-nr) = w(nr)
-
-  end do
-
-  return
-end
-subroutine lgama ( kf, x, gl )
-
-!*****************************************************************************80
-!
-!! LGAMA computes the gamma function or its logarithm.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    15 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) KF, the argument code.
-!    1, for gamma(x);
-!    2, for ln(gamma(x)).
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) GL, the function value.
-!
-  implicit none
-
-  real ( kind = 8 ), save, dimension ( 10 ) :: a = (/ &
-    8.333333333333333D-02, &
-   -2.777777777777778D-03, &
-    7.936507936507937D-04, &
-   -5.952380952380952D-04, &
-    8.417508417508418D-04, &
-   -1.917526917526918D-03, &
-    6.410256410256410D-03, &
-   -2.955065359477124D-02, &
-    1.796443723688307D-01, &
-   -1.39243221690590D+00 /)
-  real ( kind = 8 ) gl
-  real ( kind = 8 ) gl0
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) kf
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x0
-  real ( kind = 8 ) x2
-  real ( kind = 8 ) xp
-
-  x0 = x
-
-  if ( x == 1.0D+00 .or. x == 2.0D+00 ) then
-    gl = 0.0D+00
-    if ( kf == 1 ) then
-      gl = 1.0D+00
-    end if
-    return
-  else if ( x <= 7.0D+00 ) then
-    n = int ( 7.0D+00 - x )
-    x0 = x + n
-  end if
-
-  x2 = 1.0D+00 / ( x0 * x0 )
-  xp = 6.283185307179586477D+00
-  gl0 = a(10)
-
-  do k = 9, 1, -1
-    gl0 = gl0 * x2 + a(k)
-  end do
-
-  gl = gl0 / x0 + 0.5D+00 * log ( xp ) + ( x0 - 0.5D+00 ) * log ( x0 ) - x0
-
-  if ( x <= 7.0D+00 ) then
-    do k = 1, n
-      gl = gl - log ( x0 - 1.0D+00 )
-      x0 = x0 - 1.0D+00
-    end do
-  end if
-
-  if ( kf == 1 ) then
-    gl = exp ( gl )
-  end if
-
-  return
-end
-subroutine lpmn ( mm, m, n, x, pm, pd )
-
-!*****************************************************************************80
-!
-!! LPMN computes associated Legendre functions Pmn(X) and derivatives P'mn(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    19 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) MM, the leading dimension of PM and PD.
-!
-!    Input, integer ( kind = 4 ) M, the order of Pmn(x).
-!
-!    Input, integer ( kind = 4 ) N, the degree of Pmn(x).
-!
-!    Input, real ( kind = 8 ) X, the argument of Pmn(x).
-!
-!    Output, real ( kind = 8 ) PM(0:MM,0:N), PD(0:MM,0:N), the
-!    values of Pmn(x) and Pmn'(x).
-!
-  implicit none
-
-  integer ( kind = 4 ) mm
-  integer ( kind = 4 ) n
-
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) ls
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) pd(0:mm,0:n)
-  real ( kind = 8 ) pm(0:mm,0:n)
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xq
-  real ( kind = 8 ) xs
-
-  do i = 0, n
-    do j = 0, m
-      pm(j,i) = 0.0D+00
-      pd(j,i) = 0.0D+00
-    end do
-  end do
-
-  pm(0,0) = 1.0D+00
-
-  if ( abs ( x ) == 1.0D+00 ) then
-
-    do i = 1, n
-      pm(0,i) = x ** i
-      pd(0,i) = 0.5D+00 * i * ( i + 1.0D+00 ) * x ** ( i + 1 )
-    end do
-
-    do j = 1, n
-      do i = 1, m
-        if ( i == 1 ) then
-          pd(i,j) = 1.0D+300
-        else if ( i == 2 ) then
-          pd(i,j) = -0.25D+00 * ( j + 2 ) * ( j + 1 ) * j &
-            * ( j - 1 ) * x ** ( j + 1 )
-        end if
-      end do
-    end do
-
-    return
-
-  end if
-
-  if ( 1.0D+00 < abs ( x ) ) then
-    ls = -1
-  else
-    ls = +1
-  end if
-
-  xq = sqrt ( ls * ( 1.0D+00 - x * x ) )
-  xs = ls * ( 1.0D+00 - x * x )
-  do i = 1, m
-    pm(i,i) = - ls * ( 2.0D+00 * i - 1.0D+00 ) * xq * pm(i-1,i-1)
-  end do
-
-  do i = 0, m
-    pm(i,i+1) = ( 2.0D+00 * i + 1.0D+00 ) * x * pm(i,i)
-  end do
-
-  do i = 0, m
-    do j = i + 2, n
-      pm(i,j) = ( ( 2.0D+00 * j - 1.0D+00 ) * x * pm(i,j-1) - &
-        ( i + j - 1.0D+00 ) * pm(i,j-2) ) / ( j - i )
-    end do
-  end do
-
-  pd(0,0) = 0.0D+00
-  do j = 1, n
-    pd(0,j) = ls * j * ( pm(0,j-1) - x * pm(0,j) ) / xs
-  end do
-
-  do i = 1, m
-    do j = i, n
-      pd(i,j) = ls * i * x * pm(i,j) / xs + ( j + i ) &
-        * ( j - i + 1.0D+00 ) / xq * pm(i-1,j)
-    end do
-  end do
-
-  return
-end
-subroutine lpmns ( m, n, x, pm, pd )
-
-!*****************************************************************************80
-!
-!! LPMNS computes associated Legendre functions Pmn(X) and derivatives P'mn(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    18 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the order of Pmn(x).
-!
-!    Input, integer ( kind = 4 ) N, the degree of Pmn(x).
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) PM(0:N), PD(0:N), the values and derivatives
-!    of the function from degree 0 to N.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) pm(0:n)
-  real ( kind = 8 ) pm0
-  real ( kind = 8 ) pm1
-  real ( kind = 8 ) pm2
-  real ( kind = 8 ) pmk
-  real ( kind = 8 ) pd(0:n)
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x0
-
-  do k = 0, n
-    pm(k) = 0.0D+00
-    pd(k) = 0.0D+00
-  end do
-
-  if ( abs ( x ) == 1.0D+00 ) then
-
-    do k = 0, n
-      if ( m == 0 ) then
-        pm(k) = 1.0D+00
-        pd(k) = 0.5D+00 * k * ( k + 1.0D+00 )
-        if ( x < 0.0D+00 ) then
-          pm(k) = ( -1.0D+00 ) ** k * pm(k)
-          pd(k) = ( -1.0D+00 ) ** ( k + 1 ) * pd(k)
-        end if
-      else if ( m == 1 ) then
-        pd(k) = 1.0D+300
-      else if ( m == 2 ) then
-        pd(k) = -0.25D+00 * ( k + 2.0D+00 ) * ( k + 1.0D+00 ) &
-          * k * ( k - 1.0D+00 )
-        if ( x < 0.0D+00 ) then
-          pd(k) = ( -1.0D+00 ) ** ( k + 1 ) * pd(k)
-        end if
-      end if
-    end do
-    return
-  end if
-
-  x0 = abs ( 1.0D+00 - x * x )
-  pm0 = 1.0D+00
-  pmk = pm0
-  do k = 1, m
-    pmk = ( 2.0D+00 * k - 1.0D+00 ) * sqrt ( x0 ) * pm0
-    pm0 = pmk
-  end do
-  pm1 = ( 2.0D+00 * m + 1.0D+00 ) * x * pm0
-  pm(m) = pmk
-  pm(m+1) = pm1
-  do k = m + 2, n
-    pm2 = ( ( 2.0D+00 * k - 1.0D+00 ) * x * pm1 &
-      - ( k + m - 1.0D+00 ) * pmk ) / ( k - m )
-    pm(k) = pm2
-    pmk = pm1
-    pm1 = pm2
-  end do
-
-  pd(0) = ( ( 1.0D+00 - m ) * pm(1) - x * pm(0) ) &
-    / ( x * x - 1.0D+00 )  
-  do k = 1, n
-    pd(k) = ( k * x * pm(k) - ( k + m ) * pm(k-1) ) &
-      / ( x * x - 1.0D+00 )
-  end do
-
-  return
-end
-subroutine lpmv ( v, m, x, pmv )
-
-!*****************************************************************************80
-!
-!! LPMV computes associated Legendre functions Pmv(X) with arbitrary degree.
-!
-!  Discussion:
-!
-!    Compute the associated Legendre function Pmv(x) with an integer order 
-!    and an arbitrary nonnegative degree v.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    19 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) V, the degree of Pmv(x).
-!
-!    Input, integer ( kind = 4 ) M, the order of Pmv(x).
-!
-!    Input, real ( kind = 8 ) X, the argument of Pm(x).
-!
-!    Output, real ( kind = 8 ) PMV, the value of Pm(x).
-!
-  implicit none
-
-  real ( kind = 8 ) c0
-  real ( kind = 8 ) el
-  real ( kind = 8 ) eps
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) nv
-  real ( kind = 8 ) pa
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) pmv
-  real ( kind = 8 ) pss
-  real ( kind = 8 ) psv
-  real ( kind = 8 ) pv0
-  real ( kind = 8 ) qr
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r0
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) r2
-  real ( kind = 8 ) rg
-  real ( kind = 8 ) s
-  real ( kind = 8 ) s0
-  real ( kind = 8 ) s1
-  real ( kind = 8 ) s2
-  real ( kind = 8 ) v
-  real ( kind = 8 ) v0
-  real ( kind = 8 ) vs
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xq
-
-  pi = 3.141592653589793D+00
-  el = 0.5772156649015329D+00
-  eps = 1.0D-14
-  nv = int ( v )
-  v0 = v - nv
-
-  if ( x == -1.0D+00 .and. v /= nv ) then
-    if ( m == 0 ) then
-      pmv = -1.0D+300
-    else
-      pmv = 1.0D+300
-    end if
-    return
-  end if
-
-  c0 = 1.0D+00
-
-  if ( m /= 0 ) then
-
-    rg = v * ( v + m )
-    do j = 1, m - 1 
-      rg = rg * ( v * v - j * j )
-    end do
-    xq = sqrt ( 1.0D+00 - x * x )
-    r0 = 1.0D+00
-    do j = 1, m
-      r0 = 0.5D+00 * r0 * xq / j
-    end do
-    c0 = r0 * rg
-
-  end if
-
-  if ( v0 == 0.0D+00 ) then
-
-    pmv = 1.0D+00
-    r = 1.0D+00
-    do k = 1, nv - m
-      r = 0.5D+00 * r * ( - nv + m + k - 1.0D+00 ) &
-        * ( nv + m + k ) / ( k * ( k + m ) ) * ( 1.0D+00 + x )
-      pmv = pmv + r
-    end do
-    pmv = ( -1.0D+00 ) ** nv * c0 * pmv
-
-  else
-
-    if ( -0.35D+00 <= x ) then
-
-      pmv = 1.0D+00
-      r = 1.0D+00
-      do k = 1, 100
-        r = 0.5D+00 * r * ( - v + m + k - 1.0D+00 ) &
-          * ( v + m + k ) / ( k * ( m + k ) ) * ( 1.0D+00 - x )
-        pmv = pmv + r
-        if ( 12 < k .and. abs ( r / pmv ) < eps ) then
-          exit
-        end if
-      end do
-
-      pmv = ( -1.0D+00 ) ** m * c0 * pmv
-
-    else
-
-      vs = sin ( v * pi ) / pi
-      pv0 = 0.0D+00
-
-      if ( m /= 0 ) then
-
-        qr = sqrt ( ( 1.0D+00 - x ) / ( 1.0D+00 + x ) )
-        r2 = 1.0D+00
-        do j = 1, m
-          r2 = r2 * qr * j
-        end do
-        s0 = 1.0D+00
-        r1 = 1.0D+00
-        do k = 1, m - 1 
-          r1 = 0.5D+00 * r1 * ( - v + k - 1 ) * ( v + k ) &
-            / ( k * ( k - m ) ) * ( 1.0D+00 + x )
-          s0 = s0 + r1
-        end do
-        pv0 = - vs * r2 / m * s0
-
-      end if
-
-      call psi ( v, psv )
-      pa = 2.0D+00 * ( psv + el ) + pi / tan ( pi * v ) &
-        + 1.0D+00 / v
-
-      s1 = 0.0D+00
-      do j = 1, m
-        s1 = s1 + ( j * j + v * v ) / ( j * ( j * j - v * v ) )
-      end do
-
-      pmv = pa + s1 - 1.0D+00 / ( m - v ) &
-        + log ( 0.5D+00 * ( 1.0D+00 + x ) )
-      r = 1.0D+00
-      do k = 1, 100
-        r = 0.5D+00 * r * ( - v + m + k - 1.0D+00 ) * ( v + m + k ) &
-          / ( k * ( k + m ) ) * ( 1.0D+00 + x )
-        s = 0.0D+00
-        do j = 1, m
-          s = s + ( ( k + j ) ** 2 + v * v ) &
-            / ( ( k + j ) * ( ( k + j ) ** 2 - v * v ) )
-        end do
-        s2 = 0.0D+00
-        do j = 1, k
-          s2 = s2 + 1.0D+00 / ( j * ( j * j - v * v ) )
-        end do
-        pss = pa + s + 2.0D+00 * v * v * s2 &
-          - 1.0D+00 / ( m + k - v ) &
-          + log ( 0.5D+00 * ( 1.0D+00 + x ) )
-        r2 = pss * r
-        pmv = pmv + r2
-        if ( abs ( r2 / pmv ) < eps ) then
-          exit
-        end if
-      end do
-
-      pmv = pv0 + pmv * vs * c0
-
-    end if
-
-  end if
-
-  return
-end
-subroutine lpn ( n, x, pn, pd )
-
-!*****************************************************************************80
-!
-!! LPN computes Legendre polynomials Pn(x) and derivatives Pn'(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    07 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the maximum degree.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) PN(0:N), PD(0:N), the values and derivatives
-!    of the polyomials of degrees 0 to N at X.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  integer ( kind = 4 ) k
-  real ( kind = 8 ) p0
-  real ( kind = 8 ) p1
-  real ( kind = 8 ) pd(0:n)
-  real ( kind = 8 ) pf
-  real ( kind = 8 ) pn(0:n)
-  real ( kind = 8 ) x
-
-  pn(0) = 1.0D+00
-  pn(1) = x
-  pd(0) = 0.0D+00
-  pd(1) = 1.0D+00
-  p0 = 1.0D+00
-  p1 = x
-
-  do k = 2, n
-
-    pf = ( 2.0D+00 * k - 1.0D+00 ) / k * x * p1 &
-      - ( k - 1.0D+00 ) / k * p0
-    pn(k) = pf
-
-    if ( abs ( x ) == 1.0D+00 ) then
-      pd(k) = 0.5D+00 * x ** ( k + 1 ) * k * ( k + 1.0D+00 )
-    else
-      pd(k) = k * ( p1 - x * pf ) / ( 1.0D+00 - x * x )
-    end if
-
-    p0 = p1
-    p1 = pf
-
-  end do
-
-  return
-end
-subroutine lpni ( n, x, pn, pd, pl )
-
-!*****************************************************************************80
-!
-!! LPNI computes Legendre polynomials Pn(x), derivatives, and integrals.
-!
-!  Discussion:
-!
-!    This routine computes Legendre polynomials Pn(x), Pn'(x)
-!    and the integral of Pn(t) from 0 to x.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    13 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the maximum degree.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) PN(0:N), PD(0:N), PL(0:N), the values, 
-!    derivatives and integrals of the polyomials of degrees 0 to N at X.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) n1
-  real ( kind = 8 ) p0
-  real ( kind = 8 ) p1
-  real ( kind = 8 ) pd(0:n)
-  real ( kind = 8 ) pf
-  real ( kind = 8 ) pl(0:n)
-  real ( kind = 8 ) pn(0:n)
-  real ( kind = 8 ) r
-  real ( kind = 8 ) x
-
-  pn(0) = 1.0D+00
-  pn(1) = x
-  pd(0) = 0.0D+00
-  pd(1) = 1.0D+00
-  pl(0) = x
-  pl(1) = 0.5D+00 * x * x
-  p0 = 1.0D+00
-  p1 = x
-
-  do k = 2, n
-
-    pf = ( 2.0D+00 * k - 1.0D+00 ) / k * x * p1 - ( k - 1.0D+00 ) / k * p0
-    pn(k) = pf
-
-    if ( abs ( x ) == 1.0D+00 ) then
-      pd(k) = 0.5D+00 * x ** ( k + 1 ) * k * ( k + 1.0D+00 )
-    else
-      pd(k) = k * ( p1 - x * pf ) / ( 1.0D+00 - x * x )
-    end if
-
-    pl(k) = ( x * pn(k) - pn(k-1) ) / ( k + 1.0D+00 )
-    p0 = p1
-    p1 = pf
-
-    if ( k /= 2 * int ( k / 2 ) ) then
-
-      r = 1.0D+00 / ( k + 1.0D+00 )
-      n1 = ( k - 1 ) / 2
-      do j = 1, n1
-        r = ( 0.5D+00 / j - 1.0D+00 ) * r
-      end do
-      pl(k) = pl(k) + r
-
-    end if
-
-  end do
-
-  return
-end
-subroutine lqmn ( mm, m, n, x, qm, qd )
-
-!*****************************************************************************80
-!
-!! LQMN computes associated Legendre functions Qmn(x) and derivatives.
-!
-!  Discussion:
-!
-!    This routine computes the associated Legendre functions of the
-!    second kind, Qmn(x) and Qmn'(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    13 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) MM, determines the leading dimension 
-!    of QM and QD.
-!
-!    Input, integer ( kind = 4 ) M, the order of Qmn(x).
-!
-!    Input, integer ( kind = 4 ) N, the degree of Qmn(x).
-!
-!    Output, real ( kind = 8 ) QM(0:MM,0:N), QD(0:MM,0:N), contains the values
-!    of Qmn(x) and Qmn'(x).
-!
-  implicit none
-
-  integer ( kind = 4 ) mm
-  integer ( kind = 4 ) n
-
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) km
-  integer ( kind = 4 ) ls
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) q0
-  real ( kind = 8 ) q1
-  real ( kind = 8 ) q10
-  real ( kind = 8 ) qd(0:mm,0:n)
-  real ( kind = 8 ) qf
-  real ( kind = 8 ) qf0
-  real ( kind = 8 ) qf1
-  real ( kind = 8 ) qf2
-  real ( kind = 8 ) qm(0:mm,0:n)
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xq
-  real ( kind = 8 ) xs
-
-  if ( abs ( x ) == 1.0D+00 ) then
-    do i = 0, m
-      do j = 0, n
-        qm(i,j) = 1.0D+300
-        qd(i,j) = 1.0D+300
-      end do
-    end do
-    return
-  end if
-
-  if ( 1.0D+00 < abs ( x ) ) then
-    ls = -1
-  else
-    ls = 1
-  end if
-
-  xs = ls * ( 1.0D+00 - x * x )
-  xq = sqrt ( xs )
-  q0 = 0.5D+00 * log ( abs ( ( x + 1.0D+00 ) / ( x - 1.0D+00 ) ) )
-
-  if ( abs ( x ) < 1.0001D+00 ) then
-    qm(0,0) = q0
-    qm(0,1) = x * q0 - 1.0D+00
-    qm(1,0) = -1.0D+00 / xq
-    qm(1,1) = -xq * ( q0 + x / ( 1.0D+00 - x * x ) )
-    do i = 0, 1
-      do j = 2, n
-        qm(i,j) = ( ( 2.0D+00 * j - 1.0D+00 ) * x * qm(i,j-1) &
-              - ( j + i - 1.0D+00 ) * qm(i,j-2))/ ( j - i )
-      end do
-    end do
-
-    do j = 0, n
-      do i = 2, m
-        qm(i,j) = -2.0D+00 * ( i - 1.0D+00 ) * x / xq * qm(i-1,j) &
-          - ls * ( j + i - 1.0D+00 ) * ( j - i + 2.0D+00 ) * qm(i-2,j)
-      end do
-    end do
-
-  else
-
-    if ( 1.1D+00 < abs ( x ) ) then
-      km = 40 + m + n
-    else
-      km = ( 40 + m + n ) &
-        * int ( -1.0D+00 - 1.8D+00 * log ( x - 1.0D+00 ) )
-    end if
-
-    qf2 = 0.0D+00
-    qf1 = 1.0D+00
-    do k = km, 0, -1
-      qf0 = ( ( 2 * k + 3.0D+00 ) * x * qf1 &
-        - ( k + 2.0D+00 ) * qf2 ) / ( k + 1.0D+00 )
-      if ( k <= n ) then
-        qm(0,k) = qf0
-      end if
-      qf2 = qf1
-      qf1 = qf0
-    end do
-
-    do k = 0, n
-      qm(0,k) = q0 * qm(0,k) / qf0
-    end do
-
-    qf2 = 0.0D+00
-    qf1 = 1.0D+00
-    do k = km, 0, -1
-      qf0 = ( ( 2 * k + 3.0D+00 ) * x * qf1 &
-        - ( k + 1.0D+00 ) * qf2 ) / ( k + 2.0D+00 )
-      if ( k <= n ) then
-        qm(1,k) = qf0
-      end if
-      qf2 = qf1
-      qf1 = qf0
-    end do
-
-    q10 = -1.0D+00 / xq
-    do k = 0, n
-      qm(1,k) = q10 * qm(1,k) / qf0
-    end do
-
-    do j = 0, n
-      q0 = qm(0,j)
-      q1 = qm(1,j)
-      do i = 0, m - 2
-        qf = -2.0D+00 * ( i + 1 ) * x / xq * q1 &
-          + ( j - i ) * ( j + i + 1.0D+00 ) * q0
-        qm(i+2,j) = qf
-        q0 = q1
-        q1 = qf
-      end do
-    end do
-
-  end if
-
-  qd(0,0) = ls / xs
-  do j = 1, n
-    qd(0,j) = ls * j * ( qm(0,j-1) - x * qm(0,j) ) / xs
-  end do
-
-  do j = 0, n
-    do i = 1, m
-      qd(i,j) = ls * i * x / xs * qm(i,j) &
-        + ( i + j ) * ( j - i + 1.0D+00 ) / xq * qm(i-1,j)
-    end do
-  end do
-
-  return
-end
-subroutine lqmns ( m, n, x, qm, qd )
-
-!*****************************************************************************80
-!
-!! LQMNS computes associated Legendre functions Qmn(x) and derivatives Qmn'(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    28 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the order.
-!
-!    Input, integer ( kind = 4 ) N, the degree.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) QM(0:N), QD(0:N), the values of Qmn(x) 
-!    and Qmn'(x).
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) km
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) ls
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) q0
-  real ( kind = 8 ) q00
-  real ( kind = 8 ) q01
-  real ( kind = 8 ) q0l
-  real ( kind = 8 ) q10
-  real ( kind = 8 ) q11
-  real ( kind = 8 ) q1l
-  real ( kind = 8 ) qd(0:n)
-  real ( kind = 8 ) qf0
-  real ( kind = 8 ) qf1
-  real ( kind = 8 ) qf2
-  real ( kind = 8 ) qg0
-  real ( kind = 8 ) qg1
-  real ( kind = 8 ) qh0
-  real ( kind = 8 ) qh1
-  real ( kind = 8 ) qh2
-  real ( kind = 8 ) qm(0:n)
-  real ( kind = 8 ) qm0
-  real ( kind = 8 ) qm1
-  real ( kind = 8 ) qmk
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xq
-
-  do k = 0, n
-    qm(k) = 0.0D+00
-    qd(k) = 0.0D+00
-  end do
-
-  if ( abs ( x ) == 1.0D+00 ) then
-     do k = 0, n
-       qm(k) = 1.0D+300
-       qd(k) = 1.0D+300
-     end do
-     return
-  end if
-
-  if ( 1.0D+00 < abs ( x ) ) then
-    ls = -1
-  else
-    ls = +1
-  end if
-
-  xq = sqrt ( ls * ( 1.0D+00 - x * x ) )
-  q0 = 0.5D+00 * log ( abs ( ( x + 1.0D+00 ) / ( x - 1.0D+00 ) ) )
-  q00 = q0
-  q10 = -1.0D+00 / xq
-  q01 = x * q0 - 1.0D+00
-  q11 = - ls * xq * ( q0 + x / ( 1.0D+00 - x * x ) )
-  qf0 = q00
-  qf1 = q10
-  do k = 2, m
-    qm0 = -2.0D+00 * ( k - 1.0D+00 ) / xq * x * qf1 &
-      - ls * ( k - 1.0D+00 ) * ( 2.0D+00 - k ) * qf0
-    qf0 = qf1
-    qf1 = qm0
-  end do
-
-  if ( m == 0 ) then
-    qm0 = q00
-  else if ( m == 1 ) then
-    qm0 = q10
-  end if
-
-  qm(0) = qm0
-
-  if ( abs ( x ) < 1.0001D+00 ) then
-
-    if ( m == 0 .and. 0 < n ) then
-
-      qf0 = q00
-      qf1 = q01
-      do k = 2, n
-        qf2 = ( ( 2.0D+00 * k - 1.0D+00 ) * x * qf1 &
-          - ( k - 1.0D+00 ) * qf0 ) / k
-        qm(k) = qf2
-        qf0 = qf1
-        qf1 = qf2
-      end do
-
-    end if
-    qg0 = q01
-    qg1 = q11
-    do k = 2, m
-      qm1 = - 2.0D+00 * ( k - 1.0D+00 ) / xq * x * qg1 &
-        - ls * k * ( 3.0D+00 - k ) * qg0
-      qg0 = qg1
-      qg1 = qm1
-    end do
-
-    if ( m == 0 ) then
-      qm1 = q01
-    else if ( m == 1 ) then
-      qm1 = q11
-    end if
-    qm(1) = qm1
-
-    if ( m == 1 .and. 1 < n ) then
-
-      qh0 = q10
-      qh1 = q11
-      do k = 2, n
-        qh2 = ( ( 2.0D+00 * k - 1.0D+00 ) * x * qh1 - k * qh0 ) &
-          / ( k - 1.0D+00 )
-        qm(k) = qh2
-        qh0 = qh1
-        qh1 = qh2
-      end do
-
-    else if ( 2 <= m ) then
-
-      qg0 = q00
-      qg1 = q01
-      qh0 = q10
-      qh1 = q11
-
-      do l = 2, n
-        q0l = ( ( 2.0D+00 * l - 1.0D+00 ) * x * qg1 &
-          - ( l - 1.0D+00 ) * qg0 ) / l
-        q1l = ( ( 2.0D+00 * l - 1.0D+00 ) * x * qh1 - l * qh0 ) &
-          / ( l - 1.0D+00 )
-        qf0 = q0l
-        qf1 = q1l
-        do k = 2, m
-          qmk = - 2.0D+00 * ( k - 1.0D+00 ) / xq * x * qf1 &
-            - ls * ( k + l - 1.0D+00 ) * ( l + 2.0D+00 - k ) * qf0
-          qf0 = qf1
-          qf1 = qmk
-        end do
-        qm(l) = qmk
-        qg0 = qg1
-        qg1 = q0l
-        qh0 = qh1
-        qh1 = q1l
-      end do
-
-    end if
-
-  else
-
-    if ( 1.1D+00 < abs ( x ) ) then
-      km = 40 + m + n
-    else
-      km = ( 40 + m + n ) * int ( - 1.0D+00 - 1.8D+00 * log ( x - 1.0D+00 ) )
-    end if
-
-    qf2 = 0.0D+00
-    qf1 = 1.0D+00
-    do k = km, 0, -1
-      qf0 = ( ( 2.0D+00 * k + 3.0D+00 ) * x * qf1 &
-        - ( k + 2.0D+00 - m ) * qf2 ) / ( k + m + 1.0D+00 )
-      if ( k <= n ) then
-        qm(k) = qf0
-      end if
-      qf2 = qf1
-      qf1 = qf0
-    end do
-
-    do k = 0, n
-     qm(k) = qm(k) * qm0 / qf0
-    end do
-
-  end if
-
-  if ( abs ( x ) < 1.0D+00 ) then
-    do k = 0, n
-      qm(k) = ( -1 ) ** m * qm(k)
-    end do
-  end if
-
-  qd(0) = ( ( 1.0D+00 - m ) * qm(1) - x * qm(0) )  / ( x * x - 1.0D+00 )
-  do k = 1, n
-    qd(k) = ( k * x * qm(k) - ( k + m ) * qm(k-1) ) / ( x * x - 1.0D+00 )
-  end do
-
-  return
-end
-subroutine lqna ( n, x, qn, qd )
-
-!*****************************************************************************80
-!
-!! LQNA computes Legendre function Qn(x) and derivatives Qn'(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    19 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the degree of Qn(x).
-!
-!    Input, real ( kind = 8 ) X, the argument of Qn(x).
-!
-!    Output, real ( kind = 8 ) QN(0:N), QD(0:N), the values of
-!    Qn(x) and Qn'(x).
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  integer ( kind = 4 ) k
-  real ( kind = 8 ) q0
-  real ( kind = 8 ) q1
-  real ( kind = 8 ) qd(0:n)
-  real ( kind = 8 ) qf
-  real ( kind = 8 ) qn(0:n)
-  real ( kind = 8 ) x
-
-  if ( abs ( x ) == 1.0D+00 ) then
-
-    do k = 0, n
-      qn(k) = 1.0D+300
-      qd(k) = -1.0D+300
-    end do
-
-  else if ( abs ( x ) < 1.0D+00 ) then
-
-    q0 = 0.5D+00 * log ( ( 1.0D+00 + x ) / ( 1.0D+00 - x ) )
-    q1 = x * q0 - 1.0D+00
-    qn(0) = q0
-    qn(1) = q1
-    qd(0) = 1.0D+00 / ( 1.0D+00 - x * x )
-    qd(1) = qn(0) + x * qd(0)
-    do k = 2, n
-      qf = ( ( 2 * k - 1 ) * x * q1 - ( k - 1 ) * q0 ) / k
-      qn(k) = qf
-      qd(k) = ( qn(k-1) - x * qf ) * k / ( 1.0D+00 - x * x )
-      q0 = q1
-      q1 = qf
-    end do
-
-  end if
-
-  return
-end
-subroutine lqnb ( n, x, qn, qd )
-
-!*****************************************************************************80
-!
-!! LQNB computes Legendre function Qn(x) and derivatives Qn'(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    19 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the degree of Qn(x).
-!
-!    Input, real ( kind = 8 ) X, the argument of Qn(x).
-!
-!    Output, real ( kind = 8 ) QN(0:N), QD(0:N), the values of
-!    Qn(x) and Qn'(x).
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) eps
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) nl
-  real ( kind = 8 ) q0
-  real ( kind = 8 ) q1
-  real ( kind = 8 ) qc1
-  real ( kind = 8 ) qc2
-  real ( kind = 8 ) qd(0:n)
-  real ( kind = 8 ) qf
-  real ( kind = 8 ) qf0
-  real ( kind = 8 ) qf1
-  real ( kind = 8 ) qf2
-  real ( kind = 8 ) qn(0:n)
-  real ( kind = 8 ) qr
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x2
-
-  eps = 1.0D-14
-
-  if ( abs ( x ) == 1.0D+00 ) then
-    do k = 0, n
-      qn(k) = 1.0D+300
-      qd(k) = 1.0D+300
-    end do
-    return
-  end if
-
-  if ( x <= 1.021D+00 ) then
-
-    x2 = abs ( ( 1.0D+00 + x ) / ( 1.0D+00 - x ) )
-    q0 = 0.5D+00 * log ( x2 )
-    q1 = x * q0 - 1.0D+00
-    qn(0) = q0
-    qn(1) = q1
-    qd(0) = 1.0D+00 / ( 1.0D+00 - x * x )
-    qd(1) = qn(0) + x * qd(0)
-    do k = 2, n
-      qf = ( ( 2.0D+00 * k - 1.0D+00 ) * x * q1 &
-        - ( k - 1.0D+00 ) * q0 ) / k
-      qn(k) = qf
-      qd(k) = ( qn(k-1) - x * qf ) * k / ( 1.0D+00 - x * x )
-      q0 = q1
-      q1 = qf
-    end do
-
-  else
-
-    qc2 = 1.0D+00 / x
-    do j = 1, n
-      qc2 = qc2 * j / ( ( 2.0D+00 * j + 1.0D+00 ) * x )
-      if ( j == n - 1 ) then
-        qc1 = qc2
-      end if
-    end do
-
-    do l = 0, 1
-
-      nl = n + l
-      qf = 1.0D+00
-      qr = 1.0D+00
-      do k = 1, 500
-        qr = qr * ( 0.5D+00 * nl + k - 1.0D+00 ) &
-          * ( 0.5D+00 * ( nl - 1 ) + k ) &
-          / ( ( nl + k - 0.5D+00 ) * k * x * x )
-        qf = qf + qr
-        if ( abs ( qr / qf ) < eps ) then
-          exit
-        end if
-      end do
-
-      if ( l == 0 ) then
-        qn(n-1) = qf * qc1
-      else
-        qn(n) = qf * qc2
-      end if
-
-    end do
-
-    qf2 = qn(n)
-    qf1 = qn(n-1)
-    do k = n, 2, -1
-      qf0 = ( ( 2.0D+00 * k - 1.0D+00 ) * x * qf1 - k * qf2 ) / ( k - 1.0D+00 )
-      qn(k-2) = qf0
-      qf2 = qf1
-      qf1 = qf0
-    end do
-
-    qd(0) = 1.0D+00 / ( 1.0D+00 - x * x )
-    do k = 1, n
-      qd(k) = k * ( qn(k-1) - x * qn(k) ) / ( 1.0D+00 - x * x )
-    end do
-
-  end if
-
-  return
-end
-function msta1 ( x, mp )
-
-!*****************************************************************************80
-!
-!! MSTA1 determines a backward recurrence starting point for Jn(x).
-!
-!  Discussion:
-!
-!    This procedure determines the starting point for backward  
-!    recurrence such that the magnitude of    
-!    Jn(x) at that point is about 10^(-MP).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    08 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Input, integer ( kind = 4 ) MP, the negative logarithm of the 
-!    desired magnitude.
-!
-!    Output, integer ( kind = 4 ) MSTA1, the starting point.
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) envj
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  integer ( kind = 4 ) it
-  integer ( kind = 4 ) mp
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) n0
-  integer ( kind = 4 ) n1
-  integer ( kind = 4 ) nn
-  real ( kind = 8 ) x
-
-  a0 = abs ( x )
-  n0 = int ( 1.1D+00 * a0 ) + 1
-  f0 = envj ( n0, a0 ) - mp
-  n1 = n0 + 5
-  f1 = envj ( n1, a0 ) - mp
-  do it = 1, 20       
-    nn = n1 - int ( real ( n1 - n0, kind = 8 ) / ( 1.0D+00 - f0 / f1 ) )               
-    f = envj ( nn, a0 ) - mp
-    if ( abs ( nn - n1 ) < 1 ) then
-      exit
-    end if
-    n0 = n1
-    f0 = f1
-    n1 = nn
-    f1 = f
-  end do
-
-  msta1 = nn
-
-  return
-end
-function msta2 ( x, n, mp )
-
-!*****************************************************************************80
-!
-!! MSTA2 determines a backward recurrence starting point for Jn(x).
-!
-!  Discussion:
-!
-!    This procedure determines the starting point for a backward
-!    recurrence such that all Jn(x) has MP significant digits.
-!
-!    Jianming Jin supplied a modification to this code on 12 January 2016.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    14 January 2016
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument of Jn(x).
-!
-!    Input, integer ( kind = 4 ) N, the order of Jn(x).
-!
-!    Input, integer ( kind = 4 ) MP, the number of significant digits.
-!
-!    Output, integer ( kind = 4 ) MSTA2, the starting point.
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) ejn
-  real ( kind = 8 ) envj
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) hmp
-  integer ( kind = 4 ) it
-  integer ( kind = 4 ) mp
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) n
-  integer ( kind = 4 ) n0
-  integer ( kind = 4 ) n1
-  integer ( kind = 4 ) nn
-  real ( kind = 8 ) obj
-  real ( kind = 8 ) x
-
-  a0 = abs ( x )
-  hmp = 0.5D+00 * mp
-  ejn = envj ( n, a0 )
-
-  if ( ejn <= hmp ) then
-    obj = mp
-!
-!  Original code:
-!
-!   n0 = int ( 1.1D+00 * a0 )
-!
-!  Updated code:
-!
-    n0 = int ( 1.1D+00 * a0 ) + 1
-  else
-    obj = hmp + ejn
-    n0 = n
-  end if
-
-  f0 = envj ( n0, a0 ) - obj
-  n1 = n0 + 5
-  f1 = envj ( n1, a0 ) - obj
-
-  do it = 1, 20
-    nn = n1 - int ( real ( n1 - n0, kind = 8 ) / ( 1.0D+00 - f0 / f1 ) )
-    f = envj ( nn, a0 ) - obj
-    if ( abs ( nn - n1 ) < 1 ) then
-      exit
-    end if
-    n0 = n1
-    f0 = f1
-    n1 = nn
-    f1 = f
-  end do
-
-  msta2 = nn + 10
-
-  return
-end
-subroutine mtu0 ( kf, m, q, x, csf, csd )
-
-!*****************************************************************************80
-!
-!! MTU0 computes Mathieu functions CEM(x,q) and SEM(x,q) and derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    20 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) KF, the function code.
-!    1 for computing cem(x,q) and cem'(x,q)
-!    2 for computing sem(x,q) and sem'(x,q).
-!
-!    Input, integer ( kind = 4 ) M, the order of the Mathieu functions.
-!
-!    Input, real ( kind = 8 ) Q, the parameter of the Mathieu functions.
-!
-!    Input, real ( kind = 8 ) X, the argument of the Mathieu functions,
-!    in degrees.
-!
-!    Output, real ( kind = 8 ) CSF, CSD, the values of cem(x,q) and cem'(x,q),
-!    or of sem(x,q) and sem'(x,q).
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) csd
-  real ( kind = 8 ) csf
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) fg(251)
-  integer ( kind = 4 ) ic
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) kf
-  integer ( kind = 4 ) km
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) q
-  real ( kind = 8 ) qm
-  real ( kind = 8 ) rd
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xr
-
-  eps = 1.0D-14
-
-  if ( kf == 1 ) then
-
-    if ( m == 2 * int ( m / 2 ) ) then
-      kd = 1
-    else
-      kd = 2
-    end if
-
-  else
-
-    if ( m /= 2 * int ( m / 2 ) ) then
-      kd = 3
-    else
-      kd = 4
-    end if
-
-  end if
-
-  call cva2 ( kd, m, q, a )
-
-  if ( q <= 1.0D+00 ) then
-    qm = 7.5D+00 + 56.1D+00 * sqrt ( q ) - 134.7D+00 * q &
-      + 90.7D+00 * sqrt ( q ) * q
-  else
-    qm = 17.0D+00 + 3.1D+00 * sqrt ( q ) - 0.126D+00 * q &
-      + 0.0037D+00 * sqrt ( q ) * q
-  end if
-
-  km = int ( qm + 0.5D+00 * m )
-  call fcoef ( kd, m, q, a, fg )
-  ic = int ( m / 2 ) + 1
-  rd = 1.74532925199433D-02
-  xr = x * rd
-
-  csf = 0.0D+00
-
-  do k = 1, km
-
-    if ( kd == 1 ) then
-      csf = csf + fg(k) * cos ( ( 2.0D+00 * k - 2.0D+00 ) * xr )
-    else if ( kd == 2 ) then
-      csf = csf + fg(k) * cos ( ( 2.0D+00 * k - 1.0D+00 ) * xr )
-    else if ( kd == 3 ) then
-      csf = csf + fg(k) * sin ( ( 2.0D+00 * k - 1.0D+00 ) * xr )
-    else if ( kd == 4 ) then
-      csf = csf + fg(k) * sin ( 2.0D+00 * k * xr )
-    end if
-
-    if ( ic <= k .and. abs ( fg(k) ) < abs ( csf ) * eps ) then
-      exit
-    end if
-
-  end do
-
-  csd = 0.0D+00
-
-  do k = 1, km
-
-    if ( kd == 1 ) then
-      csd = csd - ( 2 * k - 2 ) * fg(k) * sin ( ( 2 * k - 2 ) * xr )
-    else if ( kd == 2 ) then
-      csd = csd - ( 2 * k - 1 ) * fg(k) * sin ( ( 2 * k - 1 ) * xr )
-    else if ( kd == 3 ) then
-      csd = csd + ( 2 * k - 1 ) * fg(k) * cos ( ( 2 * k - 1 ) * xr )
-    else if ( kd == 4 ) then
-      csd = csd + 2.0D+00 * k * fg(k) * cos ( 2 * k * xr )
-    end if
-
-    if ( ic <= k .and. abs ( fg(k) ) < abs ( csd ) * eps ) then
-      exit
-    end if
-
-  end do
-
-  return
-end
-subroutine mtu12 ( kf, kc, m, q, x, f1r, d1r, f2r, d2r )
-
-!*****************************************************************************80
-!
-!! MTU12 computes modified Mathieu functions of the first and second kind.
-!
-!  Discussion:
-!
-!    This procedure computes modified Mathieu functions of the first and
-!    second kinds, Mcm(1)(2)(x,q) and Msm(1)(2)(x,q),
-!    and their derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    31 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) KF, the function code.
-!    1 for computing Mcm(x,q);
-!    2 for computing Msm(x,q).
-!
-!    Input, integer ( kind = 4 ) KC, the function code.
-!    1, for computing the first kind
-!    2, for computing the second kind or Msm(2)(x,q) and Msm(2)'(x,q)
-!    3, for computing both the first and second kinds.
-!
-!    Input, integer ( kind = 4 ) M, the order of the Mathieu functions.
-!
-!    Input, real ( kind = 8 ) Q, the parameter of the Mathieu functions.
-!
-!    Input, real ( kind = 8 ) X, the argument of the Mathieu functions.
-!
-!    Output, real ( kind = 8 ) F1R, D1R, F2R, D2R, the values of 
-!    Mcm(1)(x,q) or Msm(1)(x,q), Derivative of Mcm(1)(x,q) or Msm(1)(x,q),
-!    Mcm(2)(x,q) or Msm(2)(x,q), Derivative of Mcm(2)(x,q) or Msm(2)(x,q).
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) bj1(0:251)
-  real ( kind = 8 ) bj2(0:251)
-  real ( kind = 8 ) by1(0:251)
-  real ( kind = 8 ) by2(0:251)
-  real ( kind = 8 ) c1
-  real ( kind = 8 ) c2
-  real ( kind = 8 ) d1r
-  real ( kind = 8 ) d2r
-  real ( kind = 8 ) dj1(0:251)
-  real ( kind = 8 ) dj2(0:251)
-  real ( kind = 8 ) dy1(0:251)
-  real ( kind = 8 ) dy2(0:251)
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) f1r
-  real ( kind = 8 ) f2r
-  real ( kind = 8 ) fg(251)
-  integer ( kind = 4 ) ic
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) kc
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) kf
-  integer ( kind = 4 ) km
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) q
-  real ( kind = 8 ) qm
-  real ( kind = 8 ) u1
-  real ( kind = 8 ) u2
-  real ( kind = 8 ) w1
-  real ( kind = 8 ) w2
-  real ( kind = 8 ) x
-
-  eps = 1.0D-14
-
-  if ( kf == 1 ) then
-    if ( m == 2 * int ( m / 2 ) ) then
-      kd = 1
-    else
-      kd = 2
-    end if
-  else
-    if ( m /= 2 * int ( m / 2 ) ) then
-      kd = 3
-    else
-      kd = 4
-    end if
-  end if
-
-  call cva2 ( kd, m, q, a )
-
-  if ( q <= 1.0D+00 ) then
-    qm = 7.5D+00 + 56.1D+00 * sqrt ( q ) - 134.7D+00 * q &
-      + 90.7D+00 * sqrt ( q ) * q
-  else
-    qm = 17.0D+00 + 3.1D+00 * sqrt ( q ) - 0.126D+00 * q &
-      + 0.0037D+00 * sqrt ( q ) * q
-  end if
-
-  km = int ( qm + 0.5D+00 * m )              
-  call fcoef ( kd, m, q, a, fg )
-
-  if ( kd == 4 ) then
-    ic = m / 2
-  else
-    ic = int ( m / 2 ) + 1
-  end if
-
-  c1 = exp ( - x )
-  c2 = exp ( x )
-  u1 = sqrt ( q ) * c1
-  u2 = sqrt ( q ) * c2
-
-  call jynb ( km, u1, nm, bj1, dj1, by1, dy1 )
-  call jynb ( km, u2, nm, bj2, dj2, by2, dy2 )
-
-  if ( kc == 1 ) then
-
-    f1r = 0.0D+00
-
-    do k = 1, km
-
-      if ( kd == 1 ) then
-        f1r = f1r + ( - 1.0D+00 ) ** ( ic + k ) * fg(k) * bj1(k-1) * bj2(k-1)
-      else if ( kd == 2 .or. kd == 3 ) then
-        f1r = f1r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) * ( bj1(k-1) * bj2(k) &
-          + ( - 1.0D+00 ) ** kd * bj1(k) * bj2(k-1) )
-      else
-        f1r = f1r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) &
-          * ( bj1(k-1) * bj2(k+1) - bj1(k+1) * bj2(k-1) )
-      end if
-
-      if ( 5 <= k .and. abs ( f1r - w1 ) < abs ( f1r ) * eps ) then
-        exit
-      end if
-
-      w1 = f1r
-
-    end do
-
-    f1r = f1r / fg(1)
-    d1r = 0.0D+00
-    do k = 1, km
-      if ( kd == 1 ) then
-        d1r = d1r + ( - 1.0D+00 ) ** ( ic + k ) * fg(k) &
-          * ( c2 * bj1(k-1) * dj2(k-1) - c1 * dj1(k-1) * bj2(k-1) )
-      else if ( kd == 2 .or. kd == 3 ) then
-        d1r = d1r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) &
-          * ( c2 * ( bj1(k-1) * dj2(k) &
-          + ( -1.0D+00 ) ** kd * bj1(k) * dj2(k-1) ) &
-          - c1 * ( dj1(k-1) * bj2(k) &
-          + ( -1.0D+00 ) ** kd * dj1(k) * bj2(k-1) ) )
-      else
-        d1r = d1r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) &
-          * ( c2 * ( bj1(k-1) * dj2(k+1) - bj1(k+1) * dj2(k-1) ) &
-          - c1 * ( dj1(k-1) * bj2(k+1) - dj1(k+1) * bj2(k-1) ) )
-      end if
-      if ( 5 <= k .and. abs ( d1r - w2 ) < abs ( d1r ) * eps ) then
-        exit
-      end if
-      w2 = d1r
-    end do
-
-    d1r = d1r * sqrt ( q ) / fg(1)
-
-  else
-
-    f2r = 0.0D+00
-
-    do k = 1, km
-      if ( kd == 1 ) then
-        f2r = f2r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) &
-          * bj1(k-1) * by2(k-1)
-      else if ( kd == 2 .or. kd == 3 ) then
-        f2r = f2r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) * ( bj1(k-1) * by2(k) &
-          + ( -1.0D+00 ) ** kd * bj1(k) * by2(k-1) )
-      else
-        f2r = f2r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) &
-          * ( bj1(k-1) * by2(k+1) - bj1(k+1) * by2(k-1) )
-      end if
-      if ( 5 <= k .and. abs ( f2r - w1 ) < abs ( f2r ) * eps ) then
-        exit
-      end if
-      w1 = f2r
-    end do
-
-    f2r = f2r / fg(1)
-    d2r = 0.0D+00
-
-    do k = 1, km
-      if ( kd == 1 ) then
-        d2r = d2r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) &
-          * ( c2 * bj1(k-1) * dy2(k-1) - c1 * dj1(k-1) * by2(k-1) )
-      else if ( kd == 2 .or. kd == 3 ) then
-        d2r = d2r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) &
-          * ( c2 * ( bj1(k-1) * dy2(k) &
-          + ( -1.0D+00 ) ** kd * bj1(k) * dy2(k-1) ) &
-          - c1 * ( dj1(k-1) * by2(k) + ( -1.0D+00 ) ** kd &
-          * dj1(k) * by2(k-1) ) )
-      else
-        d2r = d2r + ( -1.0D+00 ) ** ( ic + k ) * fg(k) &
-          * ( c2 * ( bj1(k-1) * dy2(k+1) - bj1(k+1) * dy2(k-1) ) &
-          - c1 * ( dj1(k-1) * by2(k+1) - dj1(k+1) * by2(k-1) ) )
-      end if
-
-      if ( 5 <= k .and. abs ( d2r - w2 ) < abs ( d2r ) * eps ) then
-        exit
-      end if
-
-      w2 = d2r
-
-    end do
-
-    d2r = d2r * sqrt ( q ) / fg(1)
-
-  end if
-
-  return
-end
-subroutine othpl ( kf, n, x, pl, dpl )
-
-!*****************************************************************************80
-!
-!! OTHPL computes orthogonal polynomials Tn(x), Un(x), Ln(x) or Hn(x).
-!
-!  Discussion:
-!
-!    This procedure computes orthogonal polynomials: Tn(x) or Un(x),
-!    or Ln(x) or Hn(x), and their derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    08 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) KT, the function code:
-!    1 for Chebyshev polynomial Tn(x)
-!    2 for Chebyshev polynomial Un(x)
-!    3 for Laguerre polynomial Ln(x)
-!    4 for Hermite polynomial Hn(x)
-!
-!    Input, integer ( kind = 4 ) N, the order.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) PL(0:N), DPL(0:N), the value and derivative of
-!    the polynomials of order 0 through N at X.
-!
-  implicit none
-
-  integer n
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) b
-  real ( kind = 8 ) c
-  real ( kind = 8 ) dpl(0:n)
-  real ( kind = 8 ) dy0
-  real ( kind = 8 ) dy1
-  real ( kind = 8 ) dyn
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) kf
-  real ( kind = 8 ) pl(0:n)
-  real ( kind = 8 ) x
-  real ( kind = 8 ) y0
-  real ( kind = 8 ) y1
-  real ( kind = 8 ) yn
-
-  a = 2.0D+00
-  b = 0.0D+00
-  c = 1.0D+00
-  y0 = 1.0D+00
-  y1 = 2.0D+00 * x
-  dy0 = 0.0D+00
-  dy1 = 2.0D+00
-  pl(0) = 1.0D+00
-  pl(1) = 2.0D+00 * x
-  dpl(0) = 0.0D+00
-  dpl(1) = 2.0D+00
-
-  if ( kf == 1 ) then
-    y1 = x
-    dy1 = 1.0D+00
-    pl(1) = x
-    dpl(1) = 1.0D+00
-  else if ( kf == 3 ) then
-    y1 = 1.0D+00 - x
-    dy1 = -1.0D+00
-    pl(1) = 1.0D+00 - x
-    dpl(1) = -1.0D+00
-  end if
-
-  do k = 2, n
-
-    if ( kf == 3 ) then
-      a = -1.0D+00 / k
-      b = 2.0D+00 + a
-      c = 1.0D+00 + a
-    else if ( kf == 4 ) then
-      c = 2.0D+00 * ( k - 1.0D+00 )
-    end if
-
-    yn = ( a * x + b ) * y1 - c * y0
-    dyn = a * y1 + ( a * x + b ) * dy1 - c * dy0
-    pl(k) = yn
-    dpl(k) = dyn
-    y0 = y1
-    y1 = yn
-    dy0 = dy1
-    dy1 = dyn
-
-  end do
-
-  return
-end
-subroutine pbdv ( v, x, dv, dp, pdf, pdd )
-
-!*****************************************************************************80
-!
-!! PBDV computes parabolic cylinder functions Dv(x) and derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    29 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) V, the order.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) DV(0:*), DP(0:*), the values of
-!    Dn+v0(x), Dn+v0'(x).
-!
-!    Output, real ( kind = 8 ) PDF, PDD, the values of Dv(x) and Dv'(x).
-!
-  implicit none
-
-  real ( kind = 8 ) dp(0:*)
-  real ( kind = 8 ) dv(0:*)
-  real ( kind = 8 ) ep
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  integer ( kind = 4 ) ja
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) na
-  integer ( kind = 4 ) nk
-  integer ( kind = 4 ) nv
-  real ( kind = 8 ) pd
-  real ( kind = 8 ) pd0
-  real ( kind = 8 ) pd1
-  real ( kind = 8 ) pdd
-  real ( kind = 8 ) pdf
-  real ( kind = 8 ) s0
-  real ( kind = 8 ) v
-  real ( kind = 8 ) v0
-  real ( kind = 8 ) v1
-  real ( kind = 8 ) v2
-  real ( kind = 8 ) vh
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xa
-
-  xa = abs ( x )
-  vh = v
-  v = v + sign ( 1.0D+00, v )
-  nv = int ( v )
-  v0 = v - nv
-  na = abs ( nv )
-  ep = exp ( -0.25D+00 * x * x )
-
-  if ( 1 <= na ) then
-    ja = 1
-  end if
-
-  if ( 0.0D+00 <= v ) then
-    if ( v0 == 0.0D+00 ) then
-      pd0 = ep
-      pd1 = x * ep
-    else
-      do l = 0, ja
-        v1 = v0 + l
-        if ( xa <= 5.8D+00 ) then
-          call dvsa ( v1, x, pd1 )
-        else
-          call dvla ( v1, x, pd1 )
-        end if
-        if ( l == 0 ) then
-          pd0 = pd1
-        end if
-      end do
-    end if
-
-    dv(0) = pd0
-    dv(1) = pd1
-    do k = 2, na
-      pdf = x * pd1 - ( k + v0 - 1.0D+00 ) * pd0
-      dv(k) = pdf
-      pd0 = pd1
-      pd1 = pdf
-    end do
-
-  else
-
-    if ( x <= 0.0D+00 ) then
-
-      if ( xa <= 5.8D+00 )  then
-        call dvsa ( v0, x, pd0 )
-        v1 = v0 - 1.0D+00
-        call dvsa ( v1, x, pd1 )
-      else
-        call dvla ( v0, x, pd0 )
-        v1 = v0 - 1.0D+00
-        call dvla ( v1, x, pd1 )
-      end if
-
-      dv(0) = pd0
-      dv(1) = pd1
-      do k = 2, na
-        pd = ( - x * pd1 + pd0 ) / ( k - 1.0D+00 - v0 )
-        dv(k) = pd
-        pd0 = pd1
-        pd1 = pd
-      end do
-
-    else if ( x <= 2.0D+00 ) then
-
-      v2 = nv + v0
-      if ( nv == 0 ) then
-        v2 = v2 - 1.0D+00
-      end if
-
-      nk = int ( - v2 )
-      call dvsa ( v2, x, f1 )
-      v1 = v2 + 1.0D+00
-      call dvsa ( v1, x, f0 )
-      dv(nk) = f1
-      dv(nk-1) = f0
-      do k = nk - 2, 0, -1
-        f = x * f0 + ( k - v0 + 1.0D+00 ) * f1
-        dv(k) = f
-        f1 = f0
-        f0 = f
-      end do
-
-    else
-
-      if ( xa <= 5.8D+00 ) then
-        call dvsa ( v0, x, pd0 )
-      else
-        call dvla ( v0, x, pd0 )
-      end if
-
-      dv(0) = pd0
-      m = 100 + na
-      f1 = 0.0D+00
-      f0 = 1.0D-30
-      do k = m, 0, -1
-        f = x * f0 + ( k - v0 + 1.0D+00 ) * f1
-        if ( k <= na ) then
-          dv(k) = f
-        end if
-        f1 = f0
-        f0 = f
-      end do
-      s0 = pd0 / f
-      do k = 0, na
-        dv(k) = s0 * dv(k)
-      end do
-
-    end if
-
-  end if
-
-  do k = 0, na - 1
-    v1 = abs ( v0 ) + k
-    if ( 0.0D+00 <= v ) then
-      dp(k) = 0.5D+00 * x * dv(k) - dv(k+1)
-    else
-      dp(k) = -0.5D+00 * x * dv(k) - v1 * dv(k+1)
-    end if
-  end do
-
-  pdf = dv(na-1)
-  pdd = dp(na-1)
-  v = vh
-
-  return
-end
-subroutine pbvv ( v, x, vv, vp, pvf, pvd )
-
-!*****************************************************************************80
-!
-!! PBVV computes parabolic cylinder functions Vv(x) and their derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    29 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) V, the order.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) VV(0:*), VP(0:*), the values of Vv(x), Vv'(x).
-!
-!    Output, real ( kind = 8 ) PVF, PVD, the values of Vv(x) and Vv'(x).
-!
-  implicit none
-
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  integer ( kind = 4 ) ja
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) kv
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) na
-  integer ( kind = 4 ) nv
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) pv0
-  real ( kind = 8 ) pvd
-  real ( kind = 8 ) pvf
-  real ( kind = 8 ) q2p
-  real ( kind = 8 ) qe
-  real ( kind = 8 ) s0
-  real ( kind = 8 ) v
-  real ( kind = 8 ) v0
-  real ( kind = 8 ) v1
-  real ( kind = 8 ) v2
-  real ( kind = 8 ) vh
-  real ( kind = 8 ) vp(0:*)
-  real ( kind = 8 ) vv(0:*)
-  real ( kind = 8 ) x
-  real ( kind = 8 ) xa
-
-  pi = 3.141592653589793D+00
-  xa = abs ( x )
-  vh = v
-  v = v + sign ( 1.0D+00, v )
-  nv = int ( v )
-  v0 = v - nv
-  na = abs ( nv )
-  qe = exp ( 0.25D+00 * x * x )
-  q2p = sqrt ( 2.0D+00 / pi )
-
-  if ( 1 <= na ) then
-    ja = 1
-  end if
-
-  if ( v <= 0.0D+00 ) then
-
-    if ( v0 == 0.0D+00 ) then
-
-      if ( xa <= 7.5D+00 ) then 
-        call vvsa ( v0, x, pv0 )
-      else
-        call vvla ( v0, x, pv0 )
-      end if
-
-      f0 = q2p * qe
-      f1 = x * f0
-      vv(0) = pv0
-      vv(1) = f0
-      vv(2) = f1
-
-    else
-
-      do l = 0, ja
-        v1 = v0 - l
-        if ( xa <= 7.5D+00 ) then
-          call vvsa ( v1, x, f1 )
-        else
-          call vvla ( v1, x, f1 )
-        end if
-        if ( l == 0 ) then
-          f0 = f1
-        end if
-      end do
-
-      vv(0) = f0
-      vv(1) = f1
-
-    end if
-
-    if ( v0 == 0.0D+00 ) then
-      kv = 3
-    else
-      kv = 2
-    end if
-
-    do k = kv, na
-      f = x * f1 + ( k - v0 - 2.0D+00 ) * f0
-      vv(k) = f
-      f0 = f1
-      f1 = f
-    end do
-
-  else
-
-    if ( 0.0D+00 <= x .and. x <= 7.5D+00 ) then
-
-      v2 = v
-      if ( v2 < 1.0D+00 ) then
-        v2 = v2 + 1.0D+00
-      end if
-
-      call vvsa ( v2, x, f1 )
-      v1 = v2 - 1.0D+00
-      kv = int ( v2 )
-      call vvsa ( v1, x, f0 )
-      vv(kv) = f1
-      vv(kv-1) = f0
-      do k = kv - 2, 0, - 1
-        f = x * f0 - ( k + v0 + 2.0D+00 ) * f1
-        if ( k <= na ) then
-          vv(k) = f
-        end if
-        f1 = f0
-        f0 = f
-      end do
-
-    else if ( 7.5D+00 < x ) then
-
-      call vvla ( v0, x, pv0 )
-      m = 100 + abs ( na )
-      vv(1) = pv0
-      f1 = 0.0D+00
-      f0 = 1.0D-40
-      do k = m, 0, -1
-        f = x * f0 - ( k + v0 + 2.0D+00 ) * f1
-        if ( k <= na ) then
-          vv(k) = f
-        end if
-        f1 = f0
-        f0 = f
-      end do
-      s0 = pv0 / f
-      do k = 0, na
-        vv(k) = s0 * vv(k)
-      end do
-
-    else
-
-      if ( xa <= 7.5D+00 ) then
-        call vvsa ( v0, x, f0 )
-        v1 = v0 + 1.0D+00
-        call vvsa ( v1, x, f1 )
-      else
-        call vvla ( v0, x, f0 )
-        v1 = v0 + 1.0D+00
-        call vvla ( v1, x, f1 )
-      end if
-
-      vv(0) = f0
-      vv(1) = f1
-      do k = 2, na
-        f = ( x * f1 - f0 ) / ( k + v0 )
-        vv(k) = f
-        f0 = f1
-        f1 = f
-      end do
-
-    end if
-
-  end if
-
-  do k = 0, na - 1
-    v1 = v0 + k
-    if ( 0.0D+00 <= v ) then
-      vp(k) = 0.5D+00 * x * vv(k) - ( v1 + 1.0D+00 ) * vv(k+1)
-    else
-      vp(k) = - 0.5D+00 * x * vv(k) + vv(k+1)
-    end if
-  end do
-
-  pvf = vv(na-1)
-  pvd = vp(na-1)
-  v = vh
-
-  return
-end
-subroutine pbwa ( a, x, w1f, w1d, w2f, w2d )
-
-!*****************************************************************************80
-!
-!! PBWA computes parabolic cylinder functions W(a,x) and derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    29 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) A, the parameter.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) W1F, W1D, W2F, W2D, the values of
-!    W(a,x), W'(a,x), W(a,-x), W'(a,-x).
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) d(100)
-  real ( kind = 8 ) d1
-  real ( kind = 8 ) d2
-  real ( kind = 8 ) dl
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) f2
-  real ( kind = 8 ) g1
-  real ( kind = 8 ) g2
-  real ( kind = 8 ) h(100)
-  real ( kind = 8 ) h0
-  real ( kind = 8 ) h1
-  real ( kind = 8 ) hl
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) l1
-  integer ( kind = 4 ) l2
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) p0
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) ugi
-  real ( kind = 8 ) ugr
-  real ( kind = 8 ) vgi
-  real ( kind = 8 ) vgr
-  real ( kind = 8 ) w1d
-  real ( kind = 8 ) w1f
-  real ( kind = 8 ) w2d
-  real ( kind = 8 ) w2f
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x1
-  real ( kind = 8 ) x2
-  real ( kind = 8 ) y1
-  real ( kind = 8 ) y1d
-  real ( kind = 8 ) y1f
-  real ( kind = 8 ) y2d
-  real ( kind = 8 ) y2f
-
-  eps = 1.0D-15
-  p0 = 0.59460355750136D+00
-
-  if ( a == 0.0D+00 ) then
-    g1 = 3.625609908222D+00
-    g2 = 1.225416702465D+00
-  else
-    x1 = 0.25D+00
-    y1 = 0.5D+00 * a
-    call cgama ( x1, y1, 1, ugr, ugi )
-    g1 = sqrt ( ugr * ugr + ugi * ugi )
-    x2 = 0.75D+00
-    call cgama ( x2, y1, 1, vgr, vgi )
-    g2 = sqrt ( vgr * vgr + vgi * vgi )
-  end if
-
-  f1 = sqrt ( g1 / g2 )
-  f2 = sqrt ( 2.0D+00 * g2 / g1 )
-  h0 = 1.0D+00
-  h1 = a
-  h(1) = a
-  do l1 = 4, 200, 2
-    m = l1 / 2
-    hl = a * h1 - 0.25D+00 * ( l1 - 2.0D+00 ) * ( l1 - 3.0D+00 ) * h0
-    h(m) = hl
-    h0 = h1
-    h1 = hl
-  end do
-  y1f = 1.0D+00
-  r = 1.0D+00
-  do k = 1, 100
-    r = 0.5D+00 * r * x * x / ( k * ( 2.0D+00 * k - 1.0D+00 ) )
-    r1 = h(k) * r
-    y1f = y1f + r1
-    if ( abs ( r1 / y1f ) <= eps .and. 30 < k ) then
-      exit
-    end if
-  end do
-
-  y1d = a
-  r = 1.0D+00
-  do k = 1, 100
-    r = 0.5D+00 * r * x * x / ( k * ( 2.0D+00 * k + 1.0D+00 ) )
-    r1 = h(k+1) * r
-    y1d = y1d + r1
-    if ( abs ( r1 / y1d ) <= eps .and. 30 < k ) then
-      exit
-    end if
-  end do
-
-  y1d = x * y1d
-  d1 = 1.0D+00
-  d2 = a
-  d(1) = 1.0D+00
-  d(2) = a
-  do l2 = 5, 160, 2
-    m = ( l2 + 1 ) / 2
-    dl = a * d2 - 0.25D+00 * ( l2 - 2.0D+00 ) * ( l2 - 3.0D+00 ) * d1
-    d(m) = dl
-    d1 = d2
-    d2 = dl
-  end do
-
-  y2f = 1.0D+00
-  r = 1.0D+00
-  do k = 1, 100
-    r = 0.5D+00 * r * x * x / ( k * ( 2.0D+00 * k + 1.0D+00 ) )
-    r1 = d(k+1) * r
-    y2f = y2f + r1
-    if ( abs ( r1 / y2f ) <= eps .and. 30 < k ) then
-      exit
-    end if
-  end do
-
-  y2f = x * y2f
-  y2d = 1.0D+00
-  r = 1.0D+00
-  do k = 1, 100
-    r = 0.5D+00 * r * x * x / ( k * ( 2.0D+00 * k - 1.0D+00 ) )
-    r1 = d(k+1) * r
-    y2d = y2d + r1
-    if ( abs ( r1 / y2d ) <= eps .and. 30 < k ) then
-      exit
-    end if
-  end do
-
-  w1f = p0 * ( f1 * y1f - f2 * y2f )
-  w2f = p0 * ( f1 * y1f + f2 * y2f )
-  w1d = p0 * ( f1 * y1d - f2 * y2d )
-  w2d = p0 * ( f1 * y1d + f2 * y2d )
-
-  return
-end
-subroutine psi ( x, ps )
-
-!*****************************************************************************80
-!
-!! PSI computes the PSI function.
-!
-!  Licensing:
-!
-!    The original FORTRAN77 version of this routine is copyrighted by 
-!    Shanjie Zhang and Jianming Jin.  However, they give permission to 
-!    incorporate this routine into a user program that the copyright 
-!    is acknowledged.
-!
-!  Modified:
-!
-!    08 September 2007
-!
-!  Author:
-!
-!    Original FORTRAN77 by Shanjie Zhang, Jianming Jin.
-!    FORTRAN90 version by John Burkardt.
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) PS, the value of the PSI function.
-!
-  implicit none
-
-  real ( kind = 8 ), parameter :: a1 = -0.83333333333333333D-01
-  real ( kind = 8 ), parameter :: a2 =  0.83333333333333333D-02
-  real ( kind = 8 ), parameter :: a3 = -0.39682539682539683D-02
-  real ( kind = 8 ), parameter :: a4 =  0.41666666666666667D-02
-  real ( kind = 8 ), parameter :: a5 = -0.75757575757575758D-02
-  real ( kind = 8 ), parameter :: a6 =  0.21092796092796093D-01
-  real ( kind = 8 ), parameter :: a7 = -0.83333333333333333D-01
-  real ( kind = 8 ), parameter :: a8 =  0.4432598039215686D+00
-  real ( kind = 8 ), parameter :: el = 0.5772156649015329D+00
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) n
-  real ( kind = 8 ), parameter :: pi = 3.141592653589793D+00
-  real ( kind = 8 ) ps
-  real ( kind = 8 ) s
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x2
-  real ( kind = 8 ) xa
-
-  xa = abs ( x )
-  s = 0.0D+00
-
-  if ( x == aint ( x ) .and. x <= 0.0D+00 ) then
-
-    ps = 1.0D+300
-    return
-
-  else if ( xa == aint ( xa ) ) then
-
-    n = int ( xa )
-    do k = 1, n - 1
-      s = s + 1.0D+00 / real ( k, kind = 8 )
-    end do
-
-    ps = - el + s
-
-  else if ( xa + 0.5D+00 == aint ( xa + 0.5D+00 ) ) then
-
-    n = int ( xa - 0.5D+00 )
-
-    do k = 1, n
-      s = s + 1.0D+00 / real ( 2 * k - 1, kind = 8 )
-    end do
-
-    ps = - el + 2.0D+00 * s - 1.386294361119891D+00
-
-  else
-
-    if ( xa < 10.0D+00 ) then
-
-      n = 10 - int ( xa )
-      do k = 0, n - 1
-        s = s + 1.0D+00 / ( xa + real ( k, kind = 8 ) )
-      end do
-
-      xa = xa + real ( n, kind = 8 )
-
-    end if
-
-    x2 = 1.0D+00 / ( xa * xa )
-
-    ps = log ( xa ) - 0.5D+00 / xa + x2 * ((((((( &
-             a8   &
-      * x2 + a7 ) &
-      * x2 + a6 ) &
-      * x2 + a5 ) &
-      * x2 + a4 ) &
-      * x2 + a3 ) &
-      * x2 + a2 ) &
-      * x2 + a1 )
-
-    ps = ps - s
-
-  end if
-
-  if ( x < 0.0D+00 ) then
-    ps = ps - pi * cos ( pi * x ) / sin ( pi * x ) - 1.0D+00 / x
-  end if
-
-  return
-end
-subroutine qstar ( m, n, c, ck, ck1, qs, qt )
-
-!*****************************************************************************80
-!
-!! QSTAR computes Q*mn(-ic) for oblate radial functions with a small argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    18 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
-!
-!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
-!
-!    Input, real ( kind = 8 ) C, spheroidal parameter.
-!
-!    Input, real ( kind = 8 ) CK(*), ?
-!
-!    Input, real ( kind = 8 ) CK1, ?
-!
-!    Output, real ( kind = 8 ) QS, ?
-!
-!    Output, real ( kind = 8 ) QT, ?
-!
-  implicit none
-
-  real ( kind = 8 ) ap(200)
-  real ( kind = 8 ) c
-  real ( kind = 8 ) ck(200)
-  real ( kind = 8 ) ck1
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) ip
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) qs
-  real ( kind = 8 ) qs0
-  real ( kind = 8 ) qt
-  real ( kind = 8 ) r
-  real ( kind = 8 ) s
-  real ( kind = 8 ) sk
-
-  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
-    ip = 0
-  else
-    ip = 1
-  end if
-
-  r = 1.0D+00 / ck(1) ** 2
-  ap(1) = r
-  do i = 1, m
-    s = 0.0D+00
-    do l = 1, i
-      sk = 0.0D+00
-      do k = 0, l
-        sk = sk + ck(k+1) * ck(l-k+1)
-      end do
-      s = s + sk * ap(i-l+1)
-    end do
-    ap(i+1) = -r * s
-  end do 
-
-  qs0 = ap(m+1)     
-  do l = 1, m
-    r = 1.0D+00
-    do k = 1, l
-      r = r * ( 2.0D+00 * k + ip ) &
-        * ( 2.0D+00 * k - 1.0D+00 + ip ) / ( 2.0D+00 * k ) ** 2
-    end do
-    qs0 = qs0 + ap(m-l+1) * r
-  end do
-
-  qs = ( -1.0D+00 ) ** ip * ck1 * ( ck1 * qs0 ) / c
-  qt = - 2.0D+00 / ck1 * qs
-
-  return
-end
-function r8_gamma_log ( x )
-
-!*****************************************************************************80
-!
-!! R8_GAMMA_LOG evaluates the logarithm of the gamma function.
-!
-!  Discussion:
-!
-!    This routine calculates the LOG(GAMMA) function for a positive real
-!    argument X.  Computation is based on an algorithm outlined in
-!    references 1 and 2.  The program uses rational functions that
-!    theoretically approximate LOG(GAMMA) to at least 18 significant
-!    decimal digits.  The approximation for X > 12 is from reference
-!    3, while approximations for X < 12.0 are similar to those in
-!    reference 1, but are unpublished.
-!
-!  Licensing:
-!
-!    This code is distributed under the GNU LGPL license.
-!
-!  Modified:
-!
-!    15 April 2013
-!
-!  Author:
-!
-!    Original FORTRAN77 version by William Cody, Laura Stoltz.
-!    FORTRAN90 version by John Burkardt.
-!
-!  Reference:
-!
-!    William Cody, Kenneth Hillstrom,
-!    Chebyshev Approximations for the Natural Logarithm of the
-!    Gamma Function,
-!    Mathematics of Computation,
-!    Volume 21, Number 98, April 1967, pages 198-203.
-!
-!    Kenneth Hillstrom,
-!    ANL/AMD Program ANLC366S, DGAMMA/DLGAMA,
-!    May 1969.
-!
-!    John Hart, Ward Cheney, Charles Lawson, Hans Maehly,
-!    Charles Mesztenyi, John Rice, Henry Thatcher,
-!    Christoph Witzgall,
-!    Computer Approximations,
-!    Wiley, 1968,
-!    LC: QA297.C64.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument of the function.
-!
-!    Output, real ( kind = 8 ) R8_GAMMA_LOG, the value of the function.
-!
-  implicit none
-
-  real ( kind = 8 ), dimension ( 7 ) :: c = (/ &
-    -1.910444077728D-03, &
-     8.4171387781295D-04, &
-    -5.952379913043012D-04, &
-     7.93650793500350248D-04, &
-    -2.777777777777681622553D-03, &
-     8.333333333333333331554247D-02, &
-     5.7083835261D-03 /)
-  real ( kind = 8 ) corr
-  real ( kind = 8 ) :: d1 = -5.772156649015328605195174D-01
-  real ( kind = 8 ) :: d2 = 4.227843350984671393993777D-01
-  real ( kind = 8 ) :: d4 = 1.791759469228055000094023D+00
-  real ( kind = 8 ), parameter :: frtbig = 2.25D+76
-  integer ( kind = 4 ) i
-  real ( kind = 8 ), dimension ( 8 ) :: p1 = (/ &
-    4.945235359296727046734888D+00, &
-    2.018112620856775083915565D+02, &
-    2.290838373831346393026739D+03, &
-    1.131967205903380828685045D+04, &
-    2.855724635671635335736389D+04, &
-    3.848496228443793359990269D+04, &
-    2.637748787624195437963534D+04, &
-    7.225813979700288197698961D+03 /)
-  real ( kind = 8 ), dimension ( 8 ) :: p2 = (/ &
-    4.974607845568932035012064D+00, &
-    5.424138599891070494101986D+02, &
-    1.550693864978364947665077D+04, &
-    1.847932904445632425417223D+05, &
-    1.088204769468828767498470D+06, &
-    3.338152967987029735917223D+06, &
-    5.106661678927352456275255D+06, &
-    3.074109054850539556250927D+06 /)
-  real ( kind = 8 ), dimension ( 8 ) :: p4 = (/ &
-    1.474502166059939948905062D+04, &
-    2.426813369486704502836312D+06, &
-    1.214755574045093227939592D+08, &
-    2.663432449630976949898078D+09, &
-    2.940378956634553899906876D+10, &
-    1.702665737765398868392998D+11, &
-    4.926125793377430887588120D+11, &
-    5.606251856223951465078242D+11 /)
-  real ( kind = 8 ), dimension ( 8 ) :: q1 = (/ &
-    6.748212550303777196073036D+01, &
-    1.113332393857199323513008D+03, &
-    7.738757056935398733233834D+03, &
-    2.763987074403340708898585D+04, &
-    5.499310206226157329794414D+04, &
-    6.161122180066002127833352D+04, &
-    3.635127591501940507276287D+04, &
-    8.785536302431013170870835D+03 /)
-  real ( kind = 8 ), dimension ( 8 ) :: q2 = (/ &
-    1.830328399370592604055942D+02, &
-    7.765049321445005871323047D+03, &
-    1.331903827966074194402448D+05, &
-    1.136705821321969608938755D+06, &
-    5.267964117437946917577538D+06, &
-    1.346701454311101692290052D+07, &
-    1.782736530353274213975932D+07, &
-    9.533095591844353613395747D+06 /)
-  real ( kind = 8 ), dimension ( 8 ) :: q4 = (/ &
-    2.690530175870899333379843D+03, &
-    6.393885654300092398984238D+05, &
-    4.135599930241388052042842D+07, &
-    1.120872109616147941376570D+09, &
-    1.488613728678813811542398D+10, &
-    1.016803586272438228077304D+11, &
-    3.417476345507377132798597D+11, &
-    4.463158187419713286462081D+11 /)
-  real ( kind = 8 ) r8_gamma_log
-  real ( kind = 8 ) res
-  real ( kind = 8 ), parameter :: sqrtpi = 0.9189385332046727417803297D+00
-  real ( kind = 8 ) x
-  real ( kind = 8 ), parameter :: xbig = 2.55D+305
-  real ( kind = 8 ) xden
-  real ( kind = 8 ), parameter :: xinf = 1.79D+308
-  real ( kind = 8 ) xm1
-  real ( kind = 8 ) xm2
-  real ( kind = 8 ) xm4
-  real ( kind = 8 ) xnum
-  real ( kind = 8 ) y
-  real ( kind = 8 ) ysq
-
-  y = x
-
-  if ( 0.0D+00 < y .and. y <= xbig ) then
-
-    if ( y <= epsilon ( y ) ) then
-
-      res = - log ( y )
-!
-!  EPS < X <= 1.5.
-!
-    else if ( y <= 1.5D+00 ) then
-
-      if ( y < 0.6796875D+00 ) then
-        corr = -log ( y )
-        xm1 = y
-      else
-        corr = 0.0D+00
-        xm1 = ( y - 0.5D+00 ) - 0.5D+00
-      end if
-
-      if ( y <= 0.5D+00 .or. 0.6796875D+00 <= y ) then
-
-        xden = 1.0D+00
-        xnum = 0.0D+00
-        do i = 1, 8
-          xnum = xnum * xm1 + p1(i)
-          xden = xden * xm1 + q1(i)
-        end do
-
-        res = corr + ( xm1 * ( d1 + xm1 * ( xnum / xden ) ) )
-
-      else
-
-        xm2 = ( y - 0.5D+00 ) - 0.5D+00
-        xden = 1.0D+00
-        xnum = 0.0D+00
-        do i = 1, 8
-          xnum = xnum * xm2 + p2(i)
-          xden = xden * xm2 + q2(i)
-        end do
-
-        res = corr + xm2 * ( d2 + xm2 * ( xnum / xden ) )
-
-      end if
-!
-!  1.5 < X <= 4.0.
-!
-    else if ( y <= 4.0D+00 ) then
-
-      xm2 = y - 2.0D+00
-      xden = 1.0D+00
-      xnum = 0.0D+00
-      do i = 1, 8
-        xnum = xnum * xm2 + p2(i)
-        xden = xden * xm2 + q2(i)
-      end do
-
-      res = xm2 * ( d2 + xm2 * ( xnum / xden ) )
-!
-!  4.0 < X <= 12.0.
-!
-    else if ( y <= 12.0D+00 ) then
-
-      xm4 = y - 4.0D+00
-      xden = -1.0D+00
-      xnum = 0.0D+00
-      do i = 1, 8
-        xnum = xnum * xm4 + p4(i)
-        xden = xden * xm4 + q4(i)
-      end do
-
-      res = d4 + xm4 * ( xnum / xden )
-!
-!  Evaluate for 12 <= argument.
-!
-    else
-
-      res = 0.0D+00
-
-      if ( y <= frtbig ) then
-
-        res = c(7)
-        ysq = y * y
-
-        do i = 1, 6
-          res = res / ysq + c(i)
-        end do
-
-      end if
-
-      res = res / y
-      corr = log ( y )
-      res = res + sqrtpi - 0.5D+00 * corr
-      res = res + y * ( corr - 1.0D+00 )
-
-    end if
-!
-!  Return for bad arguments.
-!
-  else
-
-    res = xinf
-
-  end if
-!
-!  Final adjustments and return.
-!
-  r8_gamma_log = res
-
-  return
-end
-subroutine rctj ( n, x, nm, rj, dj )
-
-!*****************************************************************************80
-!
-!! RCTJ computes Riccati-Bessel function of the first kind, and derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    18 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order of jn(x).
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, integer ( kind = 4 ) NM, the highest order computed.
-!
-!    Output, real ( kind = 8 ) RJ(0:N), the values of x jn(x).
-!
-!    Output, real ( kind = 8 ) DJ(0:N), the values of [x jn(x)]'.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) cs
-  real ( kind = 8 ) dj(0:n)
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) rj(0:n)
-  real ( kind = 8 ) rj0
-  real ( kind = 8 ) rj1
-  real ( kind = 8 ) x
-
-  nm = n
-
-  if ( abs ( x ) < 1.0D-100 ) then
-    do k = 0, n
-      rj(k) = 0.0D+00
-      dj(k) = 0.0D+00
-    end do
-    dj(0) = 1.0D+00
-    return
-  end if
-
-  rj(0) = sin ( x )
-  rj(1) = rj(0) / x - cos ( x )
-  rj0 = rj(0)
-  rj1 = rj(1)
-
-  if ( 2 <= n ) then
-
-    m = msta1 ( x, 200 )
-
-    if ( m < n ) then
-      nm = m
-    else
-      m = msta2 ( x, n, 15 )
-    end if
-
-    f0 = 0.0D+00
-    f1 = 1.0D-100
-    do k = m, 0, -1
-      f = ( 2.0D+00 * k + 3.0D+00 ) * f1 / x - f0
-      if ( k <= nm ) then
-        rj(k) = f
-      end if
-      f0 = f1
-      f1 = f
-    end do
-
-    if ( abs ( rj1 ) < abs ( rj0 ) ) then
-      cs = rj0 / f
-    else
-      cs = rj1 / f0
-    end if
-
-    do k = 0, nm
-      rj(k) = cs * rj(k)
-    end do
-
-  end if
-
-  dj(0) = cos ( x )
-  do k = 1, nm
-    dj(k) = - k * rj(k) / x + rj(k-1)
-  end do
-
-  return
-end
-subroutine rcty ( n, x, nm, ry, dy )
-
-!*****************************************************************************80
-!
-!! RCTY computes Riccati-Bessel function of the second kind, and derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    18 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order of yn(x).
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, integer ( kind = 4 ) NM, the highest order computed.
-!
-!    Output, real ( kind = 8 ) RY(0:N), the values of x yn(x).
-!
-!    Output, real ( kind = 8 ) DY(0:N), the values of [x yn(x)]'.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) dy(0:n)
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) rf0
-  real ( kind = 8 ) rf1
-  real ( kind = 8 ) rf2
-  real ( kind = 8 ) ry(0:n)
-  real ( kind = 8 ) x
-
-  nm = n
-
-  if ( x < 1.0D-60 ) then
-    do k = 0, n
-      ry(k) = -1.0D+300
-      dy(k) = 1.0D+300
-    end do
-    ry(0) = -1.0D+00
-    dy(0) = 0.0D+00
-    return
-  end if
-
-  ry(0) = - cos ( x )
-  ry(1) = ry(0) / x - sin ( x )
-  rf0 = ry(0)
-  rf1 = ry(1)
-  do k = 2, n
-    rf2 = ( 2.0D+00 * k - 1.0D+00 ) * rf1 / x - rf0
-    if ( 1.0D+300 < abs ( rf2 ) ) then
-      exit
-    end if
-    ry(k) = rf2
-    rf0 = rf1
-    rf1 = rf2
-  end do
-
-  nm = k - 1
-  dy(0) = sin ( x )
-  do k = 1, nm
-    dy(k) = - k * ry(k) / x + ry(k-1)
-  end do
-
-  return
-end
-subroutine refine ( kd, m, q, a, iflag )
-
-!*****************************************************************************80
-!
-!! REFINE refines an estimate of the characteristic value of Mathieu functions.
-!
-!  Discussion:
-!
-!    This procedure calculates the accurate characteristic value
-!    by the secant method.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    20 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) KD, the case code:
-!    1, for cem(x,q)  ( m = 0,2,4,...)
-!    2, for cem(x,q)  ( m = 1,3,5,...)
-!    3, for sem(x,q)  ( m = 1,3,5,...)
-!    4, for sem(x,q)  ( m = 2,4,6,...)
-!
-!    Input, integer ( kind = 4 ) M, the order of the Mathieu functions.
-!
-!    Input, real ( kind = 8 ) Q, the parameter of the Mathieu functions.
-!
-!    Input/output, real ( kind = 8 ) A, the characteristic value, which
-!    should have been refined on output.
-!
-  implicit none
-
-  real ( kind = 8 ) a
-  real ( kind = 8 ) ca
-  real ( kind = 8 ) delta
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  integer ( kind = 4 ) it
-  integer ( kind = 4 ) iflag
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) mj
-  real ( kind = 8 ) q
-  real ( kind = 8 ) x
-  real ( kind = 8 ) x0
-  real ( kind = 8 ) x1
-
-  eps = 1.0D-14
-  mj = 10 + m
-  ca = a
-  delta = 0.0D+00
-  x0 = a
-  call cvf ( kd, m, q, x0, mj, f0 )
-  x1 = 1.002D+00 * a
-  call cvf ( kd, m, q, x1, mj, f1 )
-
-  do
-  
-    do it = 1, 100
-      mj = mj + 1
-      x = x1 - ( x1 - x0 ) / ( 1.0D+00 - f0 / f1 )
-      call cvf ( kd, m, q, x, mj, f )
-      if ( abs ( 1.0D+00 - x1 / x ) < eps .or. f == 0.0D+00 ) then
-        exit
-      end if
-      x0 = x1
-      f0 = f1
-      x1 = x
-      f1 = f
-    end do
-
-    a = x
-
-    if ( 0.05D+00 < delta ) then
-      a = ca
-      if ( iflag < 0 ) then
-        iflag = -10
-      end if
-      return
-    end if
-
-    if ( abs ( ( a - ca ) / ca )  <= 0.05D+00 ) then
-      exit
-    end if
-
-    x0 = ca
-    delta = delta + 0.005D+00
-    call cvf ( kd, m, q, x0, mj, f0 )
-    x1 = ( 1.0D+00 + delta ) * ca
-    call cvf ( kd, m, q, x1, mj, f1 )
-
-  end do
-
-  return
-end
-subroutine rmn1 ( m, n, c, x, df, kd, r1f, r1d )
-
-!*****************************************************************************80
-!
-!! RMN1 computes prolate and oblate spheroidal functions of the first kind.
-!
-!  Discussion:
-!
-!    This procedure computes prolate and oblate spheroidal radial
-!    functions of the first kind for given m, n, c and x.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    29 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
-!
-!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
-!
-!    Input, real ( kind = 8 ) C, spheroidal parameter.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Input, real ( kind = 8 ) DF(*), the expansion coefficients.
-!
-!    Input, integer ( kind = 4 ) KD, the function code.
-!    1, the prolate function.
-!    -1, the oblate function.
-!
-!    Output, real ( kind = 8 ) R1F, R1D, the function and derivative.
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) b0
-  real ( kind = 8 ) c
-  real ( kind = 8 ) ck(200)
-  real ( kind = 8 ) cx
-  real ( kind = 8 ) df(200)
-  real ( kind = 8 ) dj(0:251)
-  real ( kind = 8 ) eps
-  integer ( kind = 4 ) ip
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) lg
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  integer ( kind = 4 ) nm
-  integer ( kind = 4 ) nm1
-  integer ( kind = 4 ) nm2
-  integer ( kind = 4 ) np
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r0
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) r1d
-  real ( kind = 8 ) r1f
-  real ( kind = 8 ) r2
-  real ( kind = 8 ) r3
-  real ( kind = 8 ) reg
-  real ( kind = 8 ) sa0
-  real ( kind = 8 ) sj(0:251)
-  real ( kind = 8 ) suc
-  real ( kind = 8 ) sud
-  real ( kind = 8 ) sum
-  real ( kind = 8 ) sw
-  real ( kind = 8 ) sw1
-  real ( kind = 8 ) x
-
-  eps = 1.0D-14
-  nm1 = int ( ( n - m ) / 2 )
-  if ( n - m == 2 * nm1 ) then
-    ip = 0
-  else
-    ip = 1
-  end if
-  nm = 25 + nm1 + int ( c )
-  reg = 1.0D+00
-  if ( 80 < m + nm ) then
-    reg = 1.0D-200
-  end if
-  r0 = reg
-  do j = 1, 2 * m + ip
-    r0 = r0 * j
-  end do
-  r = r0    
-  suc = r * df(1)
-  do k = 2, nm
-    r = r * ( m + k - 1.0D+00 ) * ( m + k + ip - 1.5D+00 ) &
-      / ( k - 1.0D+00 ) / ( k + ip - 1.5D+00 )
-    suc = suc + r * df(k)
-
-    if ( nm1 < k .and. abs ( suc - sw ) < abs ( suc ) * eps ) then
-      exit
-    end if
-
-    sw = suc
-
-  end do
-
-  if ( x == 0.0D+00 ) then
-
-    call sckb ( m, n, c, df, ck )
-    sum = 0.0D+00
-    do j = 1, nm
-      sum = sum + ck(j)
-      if ( abs ( sum - sw1 ) < abs ( sum ) * eps ) then
-        exit
-      end if
-      sw1 = sum
-    end do
-
-    r1 = 1.0D+00
-    do j = 1, ( n + m + ip ) / 2
-      r1 = r1 * ( j + 0.5D+00 * ( n + m + ip ) )
-    end do
-
-    r2 = 1.0D+00
-    do j = 1, m
-      r2 = 2.0D+00 * c * r2 * j
-    end do
-
-    r3 = 1.0D+00
-    do j = 1, ( n - m - ip ) / 2
-      r3 = r3 * j
-    end do
-
-    sa0 = ( 2.0D+00 * ( m + ip ) + 1.0D+00 ) * r1 &
-      / ( 2.0D+00 ** n * c ** ip * r2 * r3 )
-
-    if ( ip == 0 ) then
-      r1f = sum / ( sa0 * suc ) * df(1) * reg
-      r1d = 0.0D+00
-    else if ( ip == 1 ) then
-      r1f = 0.0D+00
-      r1d = sum / ( sa0 * suc ) * df(1) * reg
-    end if
-
-    return
-
-  end if
-
-  cx = c * x
-  nm2 = 2 * nm + m
-  call sphj ( nm2, cx, nm2, sj, dj )
-  a0 = ( 1.0D+00 - kd / ( x * x ) ) ** ( 0.5D+00 * m ) / suc  
-  r1f = 0.0D+00
-  do k = 1, nm
-    l = 2 * k + m - n - 2 + ip
-    if ( l == 4 * int ( l / 4 ) ) then
-      lg = 1
-    else
-      lg = -1
-    end if
-    if ( k == 1 ) then
-      r = r0
-    else
-      r = r * ( m + k - 1.0D+00 ) * ( m + k + ip - 1.5D+00 ) &
-        / ( k - 1.0D+00 ) / ( k + ip - 1.5D+00 )
-    end if
-    np = m + 2 * k - 2 + ip
-    r1f = r1f + lg * r * df(k) * sj(np)
-    if ( nm1 < k .and. abs ( r1f - sw ) < abs ( r1f ) * eps ) then
-      exit
-    end if
-    sw = r1f
-  end do
-
-  r1f = r1f * a0
-  b0 = kd * m / x ** 3.0D+00 / ( 1.0D+00 - kd / ( x * x ) ) * r1f    
-  sud = 0.0D+00
-
-  do k = 1, nm
-
-    l = 2 * k + m - n - 2 + ip
-
-    if ( l == 4 * int ( l / 4 ) ) then
-      lg = 1
-    else
-      lg = -1
-    end if
-
-    if ( k == 1 ) then
-      r = r0
-    else
-      r = r * ( m + k - 1.0D+00 ) * ( m + k + ip - 1.5D+00 ) &
-        / ( k - 1.0D+00 ) / ( k + ip - 1.5D+00 )
-    end if
-
-    np = m + 2 * k - 2 + ip
-    sud = sud + lg * r * df(k) * dj(np)
-    if ( nm1 < k .and. abs ( sud - sw ) < abs ( sud ) * eps ) then
-      exit
-    end if
-    sw = sud
-  end do
-
-  r1d = b0 + a0 * c * sud
-
-  return
-end
-subroutine rmn2l ( m, n, c, x, df, kd, r2f, r2d, id )
-
-!*****************************************************************************80
-!
-!! RMN2L: prolate and oblate spheroidal functions, second kind, large CX.
-!
-!  Discussion:
-!
-!    This procedure computes prolate and oblate spheroidal radial functions 
-!    of the second kind for given m, n, c and a large cx.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    30 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
-!
-!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
-!
-!    Input, real ( kind = 8 ) C, spheroidal parameter.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Input, real ( kind = 8 ) DF(*), the expansion coefficients.
-!
-!    Input, integer ( kind = 4 ) KD, the function code.
-!    1, the prolate function.
-!    -1, the oblate function.
-!
-!    Output, real ( kind = 8 ) R2F, R2D, the function and derivative values.
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) b0
-  real ( kind = 8 ) c
-  real ( kind = 8 ) cx
-  real ( kind = 8 ) df(200)
-  real ( kind = 8 ) dy(0:251)
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) eps1
-  real ( kind = 8 ) eps2
-  integer ( kind = 4 ) id
-  integer ( kind = 4 ) id1
-  integer ( kind = 4 ) id2
-  integer ( kind = 4 ) ip
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) lg
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  integer ( kind = 4 ) nm
-  integer ( kind = 4 ) nm1
-  integer ( kind = 4 ) nm2
-  integer ( kind = 4 ) np
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r0
-  real ( kind = 8 ) r2d
-  real ( kind = 8 ) r2f
-  real ( kind = 8 ) reg
-  real ( kind = 8 ) sw
-  real ( kind = 8 ) suc
-  real ( kind = 8 ) sud
-  real ( kind = 8 ) sy(0:251)
-  real ( kind = 8 ) x
-
-  eps = 1.0D-14
-
-  nm1 = int ( ( n - m ) / 2 )
-
-  if ( n - m == 2 * nm1 ) then
-    ip = 0
-  else
-    ip = 1
-  end if
-  nm = 25 + nm1 + int ( c )
-
-  if ( 80 < m + nm ) then
-    reg = 1.0D-200
-  else
-    reg = 1.0D+00
-  end if
-  nm2 = 2 * nm + m
-  cx = c * x
-  call sphy ( nm2, cx, nm2, sy, dy )
-  r0 = reg
-  do j = 1, 2 * m + ip
-    r0 = r0 * j
-  end do
-  r = r0    
-  suc = r * df(1)
-  do k = 2, nm
-    r = r * ( m + k - 1.0D+00 ) * ( m + k + ip - 1.5D+00 ) &
-      / ( k - 1.0D+00 ) / ( k + ip - 1.5D+00 )
-    suc = suc + r * df(k)
-    if ( nm1 < k .and. abs ( suc - sw ) < abs ( suc ) * eps ) then
-      exit
-    end if
-    sw = suc
-  end do
-
-  a0 = ( 1.0D+00 - kd / ( x * x ) ) ** ( 0.5D+00 * m ) / suc
-  r2f = 0.0D+00
-  do k = 1, nm
-    l = 2 * k + m - n - 2 + ip
-    if ( l == 4 * int ( l / 4 ) ) then
-      lg = 1
-    else
-      lg = -1
-    end if
-
-    if ( k == 1 ) then
-      r = r0
-    else
-      r = r * ( m + k - 1.0D+00 ) * ( m + k + ip - 1.5D+00 ) &
-        / ( k - 1.0D+00 ) / ( k + ip - 1.5D+00 )
-    end if
-
-    np = m + 2 * k - 2 + ip
-    r2f = r2f + lg * r * ( df(k) * sy(np) )
-    eps1 = abs ( r2f - sw )
-    if ( nm1 < k .and. eps1 < abs ( r2f ) * eps ) then
-      exit
-    end if
-    sw = r2f
-  end do
-
-  id1 = int ( log10 ( eps1 / abs ( r2f ) + eps ) )
-  r2f = r2f * a0
-
-  if ( nm2 <= np ) then
-    id = 10
-    return
-  end if
-
-  b0 = kd * m / x ** 3.0D+00 / ( 1.0D+00 - kd / ( x * x ) ) * r2f
-  sud = 0.0D+00
-  do k = 1, nm
-    l = 2 * k + m - n - 2 + ip
-    if ( l == 4 * int ( l / 4 ) ) then
-      lg = 1
-    else
-      lg = -1
-    end if
-    if (k == 1) then
-      r = r0
-    else
-      r = r * ( m + k - 1.0D+00 ) * ( m + k + ip - 1.5D+00 ) &
-        / ( k - 1.0D+00 ) / ( k + ip - 1.5D+00 )
-    end if
-    np = m + 2 * k - 2 + ip
-    sud = sud + lg * r * ( df(k) * dy(np) )
-    eps2 = abs ( sud - sw )
-    if ( nm1 < k .and. eps2 < abs ( sud ) * eps ) then
-      exit
-    end if
-    sw = sud
-  end do
-
-  r2d = b0 + a0 * c * sud
-  id2 = int ( log10 ( eps2 / abs ( sud ) + eps ) )
-  id = max ( id1, id2 )
-
-  return
-end
-subroutine rmn2so ( m, n, c, x, cv, df, kd, r2f, r2d )
-
-!*****************************************************************************80
-!
-!! RMN2SO: oblate radial functions of the second kind with small argument.
-!
-!  Discussion:
-!
-!    This procedure computes oblate radial functions of the second kind
-!    with a small argument, Rmn(-ic,ix) and Rmn'(-ic,ix).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    27 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-! 
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
-!
-!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
-!
-!    Input, real ( kind = 8 ) C, spheroidal parameter.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Input, real ( kind = 8 ) CV, the characteristic value.
-!
-!    Input, real ( kind = 8 ) DF(*), the expansion coefficients.
-!
-!    Input, integer ( kind = 4 ) KD, the function code.
-!    1, the prolate function.
-!    -1, the oblate function.
-!
-!    Output, real ( kind = 8 ) R2F, R2D, the values of Rmn(-ic,ix) 
-!    and Rmn'(-ic,ix).
-!
-  implicit none
-
-  real ( kind = 8 ) bk(200)
-  real ( kind = 8 ) c
-  real ( kind = 8 ) ck(200)
-  real ( kind = 8 ) ck1
-  real ( kind = 8 ) ck2
-  real ( kind = 8 ) cv
-  real ( kind = 8 ) df(200)
-  real ( kind = 8 ) dn(200)
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) gd
-  real ( kind = 8 ) gf
-  real ( kind = 8 ) h0
-  integer ( kind = 4 ) ip
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) qs
-  real ( kind = 8 ) qt
-  real ( kind = 8 ) r1d
-  real ( kind = 8 ) r1f
-  real ( kind = 8 ) r2d
-  real ( kind = 8 ) r2f
-  real ( kind = 8 ) sum
-  real ( kind = 8 ) sw
-  real ( kind = 8 ) x
-
-  if ( abs ( df(1) ) <= 1.0D-280 ) then
-    r2f = 1.0D+300
-    r2d = 1.0D+300
-    return
-  end if
-
-  eps = 1.0D-14
-  pi = 3.141592653589793D+00
-  nm = 25 + int ( ( n - m ) / 2 + c )
-  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
-    ip = 0
-  else
-    ip = 1
-  end if
-
-  call sckb ( m, n, c, df, ck )
-  call kmn ( m, n, c, cv, kd, df, dn, ck1, ck2 )
-  call qstar ( m, n, c, ck, ck1, qs, qt )
-  call cbk ( m, n, c, cv, qt, ck, bk )
-
-  if ( x == 0.0D+00 ) then
-
-    sum = 0.0D+00
-    do j = 1, nm
-      sum = sum + ck(j)
-      if ( abs ( sum - sw ) < abs ( sum ) * eps ) then
-        exit
-      end if
-      sw = sum
-    end do
-
-    if ( ip == 0 ) then
-      r1f = sum / ck1
-      r2f = - 0.5D+00 * pi * qs * r1f
-      r2d = qs * r1f + bk(1)
-    else if ( ip == 1 ) then
-       r1d = sum / ck1
-       r2f = bk(1)
-       r2d = -0.5D+00 * pi * qs * r1d
-    end if
-
-    return
-
-  else
-
-    call gmn ( m, n, c, x, bk, gf, gd )
-    call rmn1 ( m, n, c, x, df, kd, r1f, r1d )
-    h0 = atan ( x ) - 0.5D+00 * pi
-    r2f = qs * r1f * h0 + gf
-    r2d = qs * ( r1d * h0 + r1f / ( 1.0D+00 + x * x ) ) + gd
-
-  end if
-
-  return
-end
-subroutine rmn2sp ( m, n, c, x, cv, df, kd, r2f, r2d )
-
-!*****************************************************************************80
-!
-!! RMN2SP: prolate, oblate spheroidal radial functions, kind 2, small argument.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    28 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
-!
-!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
-!
-!    Input, real ( kind = 8 ) C, spheroidal parameter.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Input, real ( kind = 8 ) CV, the characteristic value.
-!
-!    Input, real ( kind = 8 ) DF(*), the expansion coefficients.
-!
-!    Input, integer ( kind = 4 ) KD, the function code.
-!    1, the prolate function.
-!    -1, the oblate function.
-!
-!    Output, real ( kind = 8 ) R2F, R2D, the values of the function and 
-!    its derivative.
-!
-  implicit none
-
-  real ( kind = 8 ) c
-  real ( kind = 8 ) ck1
-  real ( kind = 8 ) ck2
-  real ( kind = 8 ) cv
-  real ( kind = 8 ) df(200)
-  real ( kind = 8 ) dn(200)
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) ga
-  real ( kind = 8 ) gb
-  real ( kind = 8 ) gc
-  integer ( kind = 4 ) ip
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) j1
-  integer ( kind = 4 ) j2
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) ki
-  integer ( kind = 4 ) l1
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  integer ( kind = 4 ) nm
-  integer ( kind = 4 ) nm1
-  integer ( kind = 4 ) nm2
-  integer ( kind = 4 ) nm3
-  real ( kind = 8 ) pd(0:251)
-  real ( kind = 8 ) pm(0:251)
-  real ( kind = 8 ) qd(0:251)
-  real ( kind = 8 ) qm(0:251)
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) r2
-  real ( kind = 8 ) r2d
-  real ( kind = 8 ) r2f
-  real ( kind = 8 ) r3
-  real ( kind = 8 ) r4
-  real ( kind = 8 ) sd
-  real ( kind = 8 ) sd0
-  real ( kind = 8 ) sd1
-  real ( kind = 8 ) sd2
-  real ( kind = 8 ) sdm
-  real ( kind = 8 ) sf
-  real ( kind = 8 ) spd1
-  real ( kind = 8 ) spd2
-  real ( kind = 8 ) spl
-  real ( kind = 8 ) su0
-  real ( kind = 8 ) su1
-  real ( kind = 8 ) su2
-  real ( kind = 8 ) sum
-  real ( kind = 8 ) sw
-  real ( kind = 8 ) x
-
-  if ( abs ( df(1) ) < 1.0D-280 ) then
-    r2f = 1.0D+300
-    r2d = 1.0D+300
-    return
-  end if
-
-  eps = 1.0D-14
-
-  nm1 = int ( ( n - m ) / 2 )
-
-  if ( n - m == 2 * nm1 ) then
-    ip = 0
-  else
-    ip = 1
-  end if
-
-  nm = 25 + nm1 + int ( c )
-  nm2 = 2 * nm + m
-  call kmn ( m, n, c, cv, kd, df, dn, ck1, ck2 )
-  call lpmns ( m, nm2, x, pm, pd )
-  call lqmns ( m, nm2, x, qm, qd )
-
-  su0 = 0.0D+00
-  do k = 1, nm
-    j = 2 * k - 2 + m + ip
-    su0 = su0 + df(k) * qm(j)
-    if ( nm1 < k .and. abs ( su0 - sw ) < abs ( su0 ) * eps ) then
-      exit                                                               
-    end if
-    sw = su0
-  end do
-
-  sd0 = 0.0D+00
-
-  do k = 1, nm
-    j = 2 * k - 2 + m + ip
-    sd0 = sd0 + df(k) * qd(j)
-    if ( nm1 < k .and. abs ( sd0 - sw ) < abs ( sd0 ) * eps ) then
-      exit
-    end if
-    sw = sd0
-  end do
-
-  su1 = 0.0D+00
-  sd1 = 0.0D+00
-  do k = 1, m
-    j = m - 2 * k + ip
-    if ( j < 0 ) then
-      j = - j - 1
-    end if
-    su1 = su1 + dn(k) * qm(j)
-    sd1 = sd1 + dn(k) * qd(j)
-  end do
-
-  ga = ( ( x - 1.0D+00 ) / ( x + 1.0D+00 ) ) ** ( 0.5D+00 * m )
-
-  do k = 1, m
-
-    j = m - 2 * k + ip
-
-    if ( 0 <= j ) then
-      cycle
-    end if
-
-    if ( j < 0 ) then
-      j = - j - 1
-    end if 
-    r1 = 1.0D+00
-    do j1 = 1, j
-      r1 = ( m + j1 ) * r1
-    end do
-    r2 = 1.0D+00
-    do j2 = 1, m - j - 2
-      r2 = j2 * r2
-    end do
-    r3 = 1.0D+00
-    sf = 1.0D+00
-    do l1 = 1, j
-      r3 = 0.5D+00 * r3 * ( - j + l1 - 1.0D+00 ) * ( j + l1 ) &
-        / ( ( m + l1 ) * l1 ) * ( 1.0D+00 - x )
-      sf = sf + r3
-    end do
-
-    if ( m - j <= 1 ) then
-      gb = 1.0D+00
-    else
-      gb = ( m - j - 1.0D+00 ) * r2
-    end if
-
-    spl = r1 * ga * gb * sf
-    su1 = su1 + ( -1 ) ** ( j + m ) * dn(k) * spl
-    spd1 = m / ( x * x - 1.0D+00 ) * spl
-    gc = 0.5D+00 * j * ( j + 1.0 ) / ( m + 1.0D+00 )
-    sd = 1.0D+00
-    r4 = 1.0D+00
-    do l1 = 1, j - 1
-      r4 = 0.5D+00 * r4 * ( - j + l1 ) * ( j + l1 + 1.0D+00 ) &
-        / ( ( m + l1 + 1.0D+00 ) * l1 ) * ( 1.0D+00 - x )
-      sd = sd + r4
-    end do
-
-    spd2 = r1 * ga * gb * gc * sd
-    sd1 = sd1 + ( - 1 ) ** ( j + m ) * dn(k) * ( spd1 + spd2 )
-
-  end do
-
-  su2 = 0.0D+00
-  ki = ( 2 * m + 1 + ip ) / 2
-  nm3 = nm + ki
-  do k = ki, nm3
-    j = 2 * k - 1 - m - ip
-    su2 = su2 + dn(k) * pm(j)
-    if ( m < j .and. &
-      abs ( su2 - sw ) < abs ( su2 ) * eps ) then
-      exit
-    end if
-    sw = su2
-  end do
-
-  sd2 = 0.0D+00
-
-  do k = ki, nm3
-    j = 2 * k - 1 - m - ip
-    sd2 = sd2 + dn(k) * pd(j)
-    if ( m < j .and. &
-      abs ( sd2 - sw ) < abs ( sd2 ) * eps ) then
-      exit
-    end if
-    sw = sd2
-  end do
-
-  sum = su0 + su1 + su2
-  sdm = sd0 + sd1 + sd2
-  r2f = sum / ck2
-  r2d = sdm / ck2
-
-  return
-end
-subroutine rswfo ( m, n, c, x, cv, kf, r1f, r1d, r2f, r2d )
-
-!*****************************************************************************80
-!
-!! RSWFO computes prolate spheroidal radial function of first and second kinds.
-!
-!  Discussion:
-!
-!    This procedure computes oblate radial functions of the first
-!    and second kinds, and their derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    07 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-! 
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
-!
-!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
-!
-!    Input, real ( kind = 8 ) C, spheroidal parameter.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Input, real ( kind = 8 ) CV, the characteristic value.
-!
-!    Input, integer ( kind = 4 ) KF, the function code.
-!    1, for the first kind
-!    2, for the second kind
-!    3, for both the first and second kinds.
-!
-!    Output, real ( kind = 8 ) R1F, the radial function of the first kind;
-!
-!    Output, real ( kind = 8 ) R1D, the derivative of the radial function of
-!    the first kind;
-!
-!    Output, real ( kind = 8 ) R2F, the radial function of the second kind;
-!
-!    Output, real ( kind = 8 ) R2D, the derivative of the radial function of
-!    the second kind;
-!
-  implicit none
-
-  real ( kind = 8 ) c
-  real ( kind = 8 ) cv
-  real ( kind = 8 ) df(200)
-  integer ( kind = 4 ) id
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) kf
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) r1d
-  real ( kind = 8 ) r1f
-  real ( kind = 8 ) r2d
-  real ( kind = 8 ) r2f
-  real ( kind = 8 ) x
-
-  kd = -1
-  call sdmn ( m, n, c, cv, kd, df )
-
-  if ( kf /= 2 ) then
-    call rmn1 ( m, n, c, x, df, kd, r1f, r1d )
-  end if
-
-  if ( 1 < kf ) then
-    id = 10
-    if ( 1.0D-08 < x ) then
-      call rmn2l ( m, n, c, x, df, kd, r2f, r2d, id )
-    end if
-    if ( -1 < id ) then
-      call rmn2so ( m, n, c, x, cv, df, kd, r2f, r2d )
-    end if
-  end if
-
-  return
-end
-subroutine rswfp ( m, n, c, x, cv, kf, r1f, r1d, r2f, r2d )
-
-!*****************************************************************************80
-!
-!! RSWFP computes prolate spheroidal radial function of first and second kinds.
-!
-!  Discussion:
-!
-!    This procedure computes prolate spheriodal radial functions of the
-!    first and second kinds, and their derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    07 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the mode parameter;  M = 0, 1, 2, ...
-!
-!    Input, integer ( kind = 4 ) N, mode parameter, N = M, M + 1, M + 2, ...
-!
-!    Input, real ( kind = 8 ) C, spheroidal parameter.
-!
-!    Input, real ( kind = 8 ) X, the argument of the radial function, 1 < X.
-!
-!    Input, real ( kind = 8 ) CV, the characteristic value.
-!
-!    Input, integer ( kind = 4 ) KF, the function code.
-!    1, for the first kind
-!    2, for the second kind
-!    3, for both the first and second kinds.
-!
-!    Output, real ( kind = 8 ) R1F, the radial function of the first kind;
-!
-!    Output, real ( kind = 8 ) R1D, the derivative of the radial function of
-!    the first kind;
-!
-!    Output, real ( kind = 8 ) R2F, the radial function of the second kind;
-!
-!    Output, real ( kind = 8 ) R2D, the derivative of the radial function of
-!    the second kind;
-!
-  implicit none
-
-  real ( kind = 8 ) c
-  real ( kind = 8 ) cv
-  real ( kind = 8 ) df(200)
-  integer ( kind = 4 ) id
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) kf
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) r1d
-  real ( kind = 8 ) r1f
-  real ( kind = 8 ) r2d
-  real ( kind = 8 ) r2f
-  real ( kind = 8 ) x
-
-  kd = 1
-  call sdmn ( m, n, c, cv, kd, df )
-
-  if ( kf /= 2 ) then
-    call rmn1 ( m, n, c, x, df, kd, r1f, r1d )
-  end if
-
-  if ( 1 < kf ) then
-    call rmn2l ( m, n, c, x, df, kd, r2f, r2d, id )
-    if ( -8 < id ) then
-      call rmn2sp ( m, n, c, x, cv, df, kd, r2f, r2d )
-    end if
-  end if
-
-  return
-end
-subroutine scka ( m, n, c, cv, kd, ck )
-
-!*****************************************************************************80
-!
-!! SCKA: expansion coefficients for prolate and oblate spheroidal functions.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    22 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the mode parameter.
-!
-!    Input, integer ( kind = 4 ) N, the mode parameter.
-!
-!    Input, real ( kind = 8 ) C, the spheroidal parameter.
-!
-!    Input, real ( kind = 8 ) CV, the characteristic value.
-!
-!    Input, integer ( kind = 4 ) KD, the function code.
-!    1, the prolate function.
-!    -1, the oblate function.
-!
-!    Output, real ( kind = 8 ) CK(*), the expansion coefficients.
-!    CK(1), CK(2),... correspond to c0, c2,..., and so on.
-!       
-  implicit none
-
-  real ( kind = 8 ) c
-  real ( kind = 8 ) ck(200)
-  real ( kind = 8 ) cs
-  real ( kind = 8 ) cv
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) f2
-  real ( kind = 8 ) fl
-  real ( kind = 8 ) fs
-  integer ( kind = 4 ) ip
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k1
-  integer ( kind = 4 ) kb
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) r2
-  real ( kind = 8 ) s0
-  real ( kind = 8 ) su1
-  real ( kind = 8 ) su2
-
-  if ( c <= 1.0D-10 ) then
-    c = 1.0D-10
-  end if
-
-  nm = 25 + int ( ( n - m ) / 2 + c )
-  cs = c * c * kd
-
-  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
-    ip = 0
-  else
-    ip = 1
-  end if
-
-  fs = 1.0D+00
-  f1 = 0.0D+00
-  f0 = 1.0D-100
-  kb = 0
-  ck(nm+1) = 0.0D+00
-
-  do k = nm, 1, -1
-
-    f = ((( 2.0D+00 * k + m + ip ) &
-      * ( 2.0D+00 * k + m + 1.0D+00 + ip ) - cv + cs ) * f0 &
-      - 4.0D+00 * ( k + 1.0D+00 ) * ( k + m + 1.0D+00 ) * f1 ) / cs
-
-    if ( abs ( ck(k+1) ) < abs ( f ) ) then
-
-      ck(k) = f
-      f1 = f0
-      f0 = f
-
-      if ( 1.0D+100 < abs ( f ) ) then
-        do k1 = nm, k, -1
-          ck(k1) = ck(k1) * 1.0D-100
-        end do
-        f1 = f1 * 1.0D-100
-        f0 = f0 * 1.0D-100
-      end if
-
-    else
-
-      kb = k
-      fl = ck(k+1)
-      f1 = 1.0D+00
-      f2 = 0.25D+00 * ( ( m + ip ) * ( m + ip + 1.0D+00 ) &
-        - cv + cs ) / ( m + 1.0D+00 ) * f1
-      ck(1) = f1
-
-      if ( kb == 1 ) then
-        fs = f2
-      else if (kb == 2 ) then
-        ck(2) = f2
-        fs = 0.125D+00 * ( ( ( m + ip + 2.0D+00 ) &
-          * ( m + ip + 3.0D+00 ) - cv + cs ) * f2 &
-          - cs * f1 ) / ( m + 2.0D+00 )
-      else
-        ck(2) = f2
-        do j = 3, kb + 1
-          f = 0.25D+00 * ( ( ( 2.0D+00 * j + m + ip - 4.0D+00 ) &
-            * ( 2.0D+00 * j + m + ip - 3.0D+00 ) - cv + cs ) * f2 &
-            - cs * f1 ) / ( ( j - 1.0D+00 ) * ( j + m - 1.0D+00 ) )
-          if ( j <= kb ) then
-            ck(j) = f
-          end if
-          f1 = f2
-          f2 = f
-        end do
-        fs = f
-      end if
-
-      exit
-
-    end if
-
-  end do
-
-  su1 = 0.0D+00
-  do k = 1, kb
-    su1 = su1 + ck(k)
-  end do
-
-  su2 = 0.0D+00
-  do k = kb + 1, nm
-    su2 = su2 + ck(k)
-  end do
-
-  r1 = 1.0D+00
-  do j = 1, ( n + m + ip ) / 2
-    r1 = r1 * ( j + 0.5D+00 * ( n + m + ip ) )
-  end do
-
-  r2 = 1.0D+00
-  do j = 1, ( n - m - ip ) / 2
-    r2 = - r2 * j
-  end do
-
-  if ( kb == 0 ) then
-    s0 = r1 / ( 2.0D+00 ** n * r2 * su2 )
-  else
-    s0 = r1 / ( 2.0D+00 ** n * r2 * ( fl / fs * su1 + su2 ) )
-  end if
-
-  do k = 1, kb
-    ck(k) = fl / fs * s0 * ck(k)
-  end do
-
-  do k = kb + 1, nm
-    ck(k) = s0 * ck(k)
-  end do
-
-  return
-end
-subroutine sckb ( m, n, c, df, ck )
-
-!*****************************************************************************80
-!
-!! SCKB: expansion coefficients for prolate and oblate spheroidal functions.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    15 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the mode parameter.
-!
-!    Input, integer ( kind = 4 ) N, the mode parameter.
-!
-!    Input, real ( kind = 8 ) C, the spheroidal parameter.
-!
-!    Input, real ( kind = 8 ) DF(*), the expansion coefficients DK.
-!
-!    Output, real ( kind = 8 ) CK(*), the expansion coefficients CK.
-!
-  implicit none
-
-  real ( kind = 8 ) c
-  real ( kind = 8 ) ck(200)
-  real ( kind = 8 ) d1
-  real ( kind = 8 ) d2
-  real ( kind = 8 ) d3
-  real ( kind = 8 ) df(200)
-  real ( kind = 8 ) fac
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) i1
-  integer ( kind = 4 ) i2
-  integer ( kind = 4 ) ip
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) reg
-  real ( kind = 8 ) sum
-  real ( kind = 8 ) sw
-
-  c = max ( c, 1.0D-10 )
-
-  nm = 25 + int ( 0.5D+00 * ( n - m ) + c )
- 
-  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
-    ip = 0
-  else
-    ip = 1
-  end if
-
-  if ( 80 < m + nm ) then
-    reg = 1.0D-200
-  else
-    reg = 1.0D+00
-  end if
-
-  fac = - 0.5D+00 ** m
-
-  do k = 0, nm - 1
-
-    fac = - fac
-    i1 = 2 * k + ip + 1
-    r = reg
-    do i = i1, i1 + 2 * m - 1
-      r = r * i
-    end do 
-
-    i2 = k + m + ip
-    do i = i2, i2 + k - 1
-      r = r * ( i + 0.5D+00 )
-    end do
-
-    sum = r * df(k+1)
-    do i = k + 1, nm
-      d1 = 2.0D+00 * i + ip
-      d2 = 2.0D+00 * m + d1
-      d3 = i + m + ip - 0.5D+00
-      r = r * d2 * ( d2 - 1.0D+00 ) * i * ( d3 + k ) &
-        / ( d1 * ( d1 - 1.0D+00 ) * ( i - k ) * d3 )
-      sum = sum + r * df(i+1)
-      if ( abs ( sw - sum ) < abs ( sum ) * 1.0D-14 ) then
-        exit
-      end if
-      sw = sum
-    end do
-
-    r1 = reg
-    do i = 2, m + k
-      r1 = r1 * i
-    end do
-
-    ck(k+1) = fac * sum / r1
-
-  end do
-
-  return
-end
-subroutine sdmn ( m, n, c, cv, kd, df )
-
-!*****************************************************************************80
-!
-!! SDMN: expansion coefficients for prolate and oblate spheroidal functions.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    29 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the mode parameter.
-!
-!    Input, integer ( kind = 4 ) N, the mode parameter.
-!
-!    Input, real ( kind = 8 ) C, the spheroidal parameter.
-!
-!    Input, real ( kind = 8 ) CV, the characteristic value.
-!
-!    Input, integer ( kind = 4 ) KD, the function code.
-!    1, the prolate function.
-!    -1, the oblate function.
-!
-!    Output, real ( kind = 8 ) DF(*), expansion coefficients;
-!    DF(1), DF(2), ... correspond to d0, d2, ... for even n-m and d1,
-!    d3, ... for odd n-m
-!
-  implicit none
-
-  real ( kind = 8 ) a(200)
-  real ( kind = 8 ) c
-  real ( kind = 8 ) cs
-  real ( kind = 8 ) cv
-  real ( kind = 8 ) d(200)
-  real ( kind = 8 ) d2k
-  real ( kind = 8 ) df(200)
-  real ( kind = 8 ) dk0
-  real ( kind = 8 ) dk1
-  real ( kind = 8 ) dk2
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) f2
-  real ( kind = 8 ) fl
-  real ( kind = 8 ) fs
-  real ( kind = 8 ) g(200)
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) ip
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k1
-  integer ( kind = 4 ) kb
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) r3
-  real ( kind = 8 ) r4
-  real ( kind = 8 ) s0
-  real ( kind = 8 ) su1
-  real ( kind = 8 ) su2
-  real ( kind = 8 ) sw
-
-  nm = 25 + int ( 0.5D+00 * ( n - m ) + c )
-
-  if ( c < 1.0D-10 ) then
-     do i = 1, nm
-       df(i) = 0D+00
-     end do
-     df((n-m)/2+1) = 1.0D+00
-     return
-  end if   
-
-  cs = c * c * kd
-
-  if ( n - m == 2 * int ( ( n - m ) / 2 ) ) then
-    ip = 0
-  else
-    ip = 1
-  end if
-
-  do i = 1, nm + 2
-    if ( ip == 0 ) then
-      k = 2 * ( i - 1 )
-    else
-      k = 2 * i - 1
-    end if
-    dk0 = m + k
-    dk1 = m + k + 1
-    dk2 = 2 * ( m + k )
-    d2k = 2 * m + k
-    a(i) = ( d2k + 2.0D+00 ) * ( d2k + 1.0D+00 ) &
-      / ( ( dk2 + 3.0D+00 ) * ( dk2 + 5.0D+00 ) ) * cs
-    d(i) = dk0 * dk1 &
-      + ( 2.0D+00 * dk0 * dk1 - 2.0D+00 * m * m - 1.0D+00 ) &
-      / ( ( dk2 - 1.0D+00 ) * ( dk2 + 3.0D+00 ) ) * cs
-    g(i) = k * ( k - 1.0D+00 ) / ( ( dk2 - 3.0D+00 ) &
-      * ( dk2 - 1.0D+00 ) ) * cs
-  end do
-
-  fs = 1.0D+00
-  f1 = 0.0D+00
-  f0 = 1.0D-100
-  kb = 0
-  df(nm+1) = 0.0D+00
-
-  do k = nm, 1, -1
-
-    f = - ( ( d(k+1) - cv ) * f0 + a(k+1) * f1 ) / g(k+1)
-
-    if ( abs ( df(k+1) ) < abs ( f ) ) then
-
-      df(k) = f
-      f1 = f0
-      f0 = f
-      if ( 1.0D+100 < abs ( f ) ) then
-        do k1 = k, nm
-          df(k1) = df(k1) * 1.0D-100
-        end do
-        f1 = f1 * 1.0D-100
-        f0 = f0 * 1.0D-100
-      end if  
-
-    else
-
-      kb = k
-      fl = df(k+1)
-      f1 = 1.0D-100
-      f2 = - ( d(1) - cv ) / a(1) * f1
-      df(1) = f1
-
-      if ( kb == 1 ) then
-
-        fs = f2
-
-      else if ( kb == 2 ) then
-
-        df(2) = f2
-        fs = - ( ( d(2) - cv ) * f2 + g(2) * f1 ) / a(2)
-
-      else 
-
-        df(2) = f2
-        do j = 3, kb + 1
-          f = - ( ( d(j-1) - cv ) * f2 + g(j-1) * f1 ) / a(j-1)
-          if ( j <= kb ) then
-            df(j) = f
-          end if
-          if ( 1.0D+100 < abs ( f ) ) then
-            do k1 = 1, j
-              df(k1) = df(k1) * 1.0D-100
-            end do
-            f = f * 1.0D-100
-            f2 = f2 * 1.0D-100
-          end if  
-          f1 = f2
-          f2 = f
-        end do
-        fs = f
-
-      end if
-
-      exit
-
-    end if
-
-  end do
-
-  su1 = 0.0D+00
-
-  r1 = 1.0D+00
-  do j = m + ip + 1, 2 * ( m + ip )
-    r1 = r1 * j
-  end do
-
-  su1 = df(1) * r1
-  do k = 2, kb
-    r1 = - r1 * ( k + m + ip - 1.5D+00 ) / ( k - 1.0D+00 )
-    su1 = su1 + r1 * df(k)
-  end do
-
-  su2 = 0.0D+00
-  do k = kb + 1, nm
-    if ( k /= 1 ) then
-      r1 = - r1 * ( k + m + ip - 1.5D+00 ) / ( k - 1.0D+00 )
-    end if
-    su2 = su2 + r1 * df(k)
-    if ( abs ( sw - su2 ) < abs ( su2 ) * 1.0D-14 ) then
-      exit
-    end if
-    sw = su2
-  end do
-
-  r3 = 1.0D+00
-  do j = 1, ( m + n + ip ) / 2
-    r3 = r3 * ( j + 0.5D+00 * ( n + m + ip ) )
-  end do
-
-  r4 = 1.0D+00
-  do j = 1, ( n - m - ip ) / 2
-    r4 = -4.0D+00 * r4 * j
-  end do
-
-  s0 = r3 / ( fl * ( su1 / fs ) + su2 ) / r4
-  do k = 1, kb
-    df(k) = fl / fs * s0 * df(k)
-  end do
-
-  do k = kb + 1, nm
-    df(k) = s0 * df(k)
-  end do
-
-  return
-end
-subroutine segv ( m, n, c, kd, cv, eg )
-
-!*****************************************************************************80
-!
-!! SEGV computes the characteristic values of spheroidal wave functions.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    28 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) M, the mode parameter.
-!
-!    Input, integer ( kind = 4 ) N, the mode parameter.
-!
-!    Input, real ( kind = 8 ) C, the spheroidal parameter.
-!
-!    Input, integer ( kind = 4 ) KD, the function code.
-!    1, the prolate function.
-!    -1, the oblate function.
-!
-!    Output, real ( kind = 8 ) CV, the characteristic value.
-!
-!    Output, real ( kind = 8 ) EG(*), the characteristic value for 
-!    mode parameters m and n.  ( L = n - m + 1 )
-!
-  implicit none
-
-  real ( kind = 8 ) a(300)
-  real ( kind = 8 ) b(100)
-  real ( kind = 8 ) c
-  real ( kind = 8 ) cs
-  real ( kind = 8 ) cv
-  real ( kind = 8 ) cv0(100)
-  real ( kind = 8 ) d(300)
-  real ( kind = 8 ) d2k
-  real ( kind = 8 ) dk0
-  real ( kind = 8 ) dk1
-  real ( kind = 8 ) dk2
-  real ( kind = 8 ) e(300)
-  real ( kind = 8 ) eg(200)
-  real ( kind = 8 ) f(300)
-  real ( kind = 8 ) g(300)
-  real ( kind = 8 ) h(100)
-  integer ( kind = 4 ) i
-  integer ( kind = 4 ) icm
-  integer ( kind = 4 ) j
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) k1
-  integer ( kind = 4 ) kd
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) n
-  integer ( kind = 4 ) nm
-  integer ( kind = 4 ) nm1
-  real ( kind = 8 ) s
-  real ( kind = 8 ) t
-  real ( kind = 8 ) t1
-  real ( kind = 8 ) x1
-  real ( kind = 8 ) xa
-  real ( kind = 8 ) xb
-
-  if ( c < 1.0D-10 ) then
-    do i = 1, n
-      eg(i) = ( i + m ) * ( i + m - 1.0D+00 )
-    end do
-    cv = eg(n-m+1)
-    return
-  end if
-
-  icm = ( n - m + 2 ) / 2
-  nm = 10 + int ( 0.5D+00 * ( n - m ) + c )
-  cs = c * c * kd
-
-  do l = 0, 1
-
-    do i = 1, nm
-      if ( l == 0 ) then
-        k = 2 * ( i - 1 )
-      else
-        k = 2 * i - 1
-      end if
-      dk0 = m + k
-      dk1 = m + k + 1
-      dk2 = 2 * ( m + k )
-      d2k = 2 * m + k
-      a(i) = ( d2k + 2.0D+00 ) * ( d2k + 1.0D+00 ) &
-        / ( ( dk2 + 3.0D+00 ) * ( dk2 + 5.0D+00 ) ) * cs
-      d(i) = dk0 * dk1 + ( 2.0D+00 * dk0 * dk1 &
-        - 2.0 * m * m - 1.0D+00 ) &
-        / ( ( dk2 - 1.0D+00 ) * ( dk2 + 3.0D+00 ) ) * cs
-      g(i) = k * ( k - 1.0D+00 ) / ( ( dk2 - 3.0D+00 ) &
-        * ( dk2 - 1.0D+00 ) ) * cs
-    end do
-
-    do k = 2, nm
-      e(k) = sqrt ( a(k-1) * g(k) )
-      f(k) = e(k) * e(k)
-    end do
-
-    f(1) = 0.0D+00
-    e(1) = 0.0D+00
-    xa = d(nm) + abs ( e(nm) )
-    xb = d(nm) - abs ( e(nm) )
-    nm1 = nm - 1
-    do i = 1, nm1
-      t = abs ( e(i) ) + abs ( e(i+1) )
-      t1 = d(i) + t
-      if ( xa < t1 ) then
-        xa = t1
-      end if
-      t1 = d(i) - t
-      if ( t1 < xb ) then
-        xb = t1
-      end if
-    end do
-
-    do i = 1, icm
-      b(i) = xa
-      h(i) = xb
-    end do
-
-    do k = 1, icm
-
-      do k1 = k, icm
-        if ( b(k1) < b(k) ) then
-          b(k) = b(k1)
-          exit
-        end if
-      end do
-
-      if ( k /= 1 .and. h(k) < h(k-1) ) then
-        h(k) = h(k-1)
-      end if
-
-      do
-
-        x1 = ( b(k) + h(k) ) /2.0D+00
-        cv0(k) = x1
-
-        if ( abs ( ( b(k) - h(k) ) / x1 ) < 1.0D-14 ) then
-          exit
-        end if
-
-        j = 0
-        s = 1.0D+00
-
-        do i = 1, nm
-
-          if ( s == 0.0D+00 ) then
-            s = s + 1.0D-30
-          end if
-          t = f(i) / s
-          s = d(i) - t - x1
-          if ( s < 0.0D+00 ) then
-            j = j + 1
-          end if
-        end do
- 
-        if ( j < k ) then
-
-          h(k) = x1
-
-        else
-
-          b(k) = x1
-          if ( icm <= j ) then
-            b(icm) = x1
-          else
-            if ( h(j+1) < x1 ) then
-              h(j+1) = x1
-            end if
-            if ( x1 < b(j) ) then
-              b(j) = x1
-            end if
-          end if
-
-        end if
-
-      end do
-
-      cv0(k) = x1
-
-      if ( l == 0 ) then
-        eg(2*k-1) = cv0(k)
-      else
-        eg(2*k) = cv0(k)
-      end if
-
-    end do
-
-  end do
-
-  cv = eg(n-m+1)
-
-  return
-end
-subroutine sphi ( n, x, nm, si, di )
-
-!*****************************************************************************80
-!
-!! SPHI computes spherical Bessel functions in(x) and their derivatives in'(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    18 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order of In(X).
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, integer ( kind = 4 ) NM, the highest order computed.
-!
-!    Output, real ( kind = 8 ) SI(0:N), DI(0:N), the values and derivatives
-!    of the function of orders 0 through N.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) cs
-  real ( kind = 8 ) di(0:n)
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) si(0:n)
-  real ( kind = 8 ) si0
-  real ( kind = 8 ) x
-
-  nm = n
-
-  if ( abs ( x ) < 1.0D-100 ) then
-    do k = 0, n
-      si(k) = 0.0D+00
-      di(k) = 0.0D+00
-    end do
-    si(0) = 1.0D+00
-    di(1) = 0.333333333333333D+00
-    return
-  end if
-
-  si(0) = sinh ( x ) / x
-  si(1) = -( sinh ( x ) / x - cosh ( x ) ) / x
-  si0 = si(0)
-
-  if ( 2 <= n ) then
-
-    m = msta1 ( x, 200 )
-    if ( m < n ) then
-      nm = m
-    else
-      m = msta2 ( x, n, 15 )
-    end if
-    f0 = 0.0D+00
-    f1 = 1.0D+00-100
-    do k = m, 0, -1
-      f = ( 2.0D+00 * k + 3.0D+00 ) * f1 / x + f0
-      if ( k <= nm ) then
-        si(k) = f
-      end if
-      f0 = f1
-      f1 = f
-    end do
-    cs = si0 / f
-    do k = 0, nm
-      si(k) = cs * si(k)
-    end do
-
-  end if
-
-  di(0) = si(1)
-  do k = 1, nm
-    di(k) = si(k-1) - ( k + 1.0D+00 ) / x * si(k)
-  end do
-
-  return
-end
-subroutine sphj ( n, x, nm, sj, dj )
-
-!*****************************************************************************80
-!
-!! SPHJ computes spherical Bessel functions jn(x) and their derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    12 January 2016
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin.
-!    Modifications suggested by Vincent Lagage, 12 January 2016.
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, integer ( kind = 4 ) NM, the highest order computed.
-!
-!    Output, real ( kind = 8 ) SJ(0:N), the values of jn(x).
-!
-!    Output, real ( kind = 8 ) DJ(0:N), the values of jn'(x).
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) cs
-  real ( kind = 8 ) dj(0:n)
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) msta1
-  integer ( kind = 4 ) msta2
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) sa
-  real ( kind = 8 ) sb
-  real ( kind = 8 ) sj(0:n)
-  real ( kind = 8 ) x
-
-  nm = n
-!
-!  Original code.
-!
-  if ( .true. ) then
-
-    if ( abs ( x ) <= 1.0D-100 ) then
-      do k = 0, n
-        sj(k) = 0.0D+00
-        dj(k) = 0.0D+00
-      end do
-      sj(0) = 1.0D+00
-      dj(1) = 0.3333333333333333D+00
-      return
-    end if
-!
-!  Updated code.
-!
-  else
-
-    if ( abs ( x ) <= 1.0D-16 ) then
-      do k = 0, n
-        sj(k) = 0.0D+00
-        dj(k) = 0.0D+00
-      end do
-      sj(0) = 1.0D+00
-      if ( 0 < n ) then
-        do k = 1, n
-          sj(k) = sj(k-1) * x / real ( 2 * k + 1, kind = 8 )
-        end do
-        dj(1) = 1.0D+00 / 3.0D+00
-      end if
-      return
-    end if
-
-  end if
-
-  sj(0) = sin ( x ) / x
-  sj(1) = ( sj(0) - cos ( x ) ) / x
-
-  if ( 2 <= n ) then
-
-    sa = sj(0)
-    sb = sj(1)
-    m = msta1 ( x, 200 )
-    if ( m < n ) then
-      nm = m
-    else
-      m = msta2 ( x, n, 15 )
-    end if
-
-    f0 = 0.0D+00
-    f1 = 1.0D+00-100
-    do k = m, 0, -1
-      f = ( 2.0D+00 * k + 3.0D+00 ) * f1 / x - f0
-      if ( k <= nm ) then
-        sj(k) = f
-      end if
-      f0 = f1
-      f1 = f
-    end do
-
-    if ( abs ( sa ) <= abs ( sb ) ) then
-      cs = sb / f0
-    else
-      cs = sa / f
-    end if
-
-    do k = 0, nm
-      sj(k) = cs * sj(k)
-    end do
-
-  end if      
-
-  dj(0) = ( cos(x) - sin(x) / x ) / x
-  do k = 1, nm
-    dj(k) = sj(k-1) - ( k + 1.0D+00 ) * sj(k) / x
-  end do
-
-  return
-end
-subroutine sphk ( n, x, nm, sk, dk )
-
-!*****************************************************************************80
-!
-!! SPHK computes modified spherical Bessel functions kn(x) and derivatives.
-!
-!  Discussion:
-!
-!    This procedure computes modified spherical Bessel functions
-!    of the second kind, kn(x) and kn'(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    15 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, integer ( kind = 4 ) NM, the highest order computed.
-!
-!    Output, real ( kind = 8 ) SK(0:N), DK(0:N), the values of kn(x) and kn'(x).
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) dk(0:n)
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) sk(0:n)
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) x
-
-  pi = 3.141592653589793D+00
-  nm = n
-  if ( x < 1.0D-60 ) then
-    do k = 0,n
-      sk(k) = 1.0D+300
-      dk(k) = -1.0D+300
-    end do
-    return
-  end if
-
-  sk(0) = 0.5D+00 * pi / x * exp ( - x )
-  sk(1) = sk(0) * ( 1.0D+00 + 1.0D+00 / x )
-  f0 = sk(0)
-  f1 = sk(1)
-  do k = 2, n
-    f = ( 2.0D+00 * k - 1.0D+00 ) * f1 / x + f0
-    sk(k) = f
-    if ( 1.0D+300 < abs ( f ) ) then
-      exit
-    end if
-    f0 = f1
-    f1 = f
-  end do
-
-  nm = k - 1
-
-  dk(0) = -sk(1)
-  do k = 1, nm
-    dk(k) = -sk(k-1) - ( k + 1.0D+00 ) / x * sk(k)
-  end do
-
-  return
-end
-subroutine sphy ( n, x, nm, sy, dy )
-
-!*****************************************************************************80
-!
-!! SPHY computes spherical Bessel functions yn(x) and their derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    15 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, integer ( kind = 4 ) NM, the highest order computed.
-!
-!    Output, real ( kind = 8 ) SY(0:N), DY(0:N), the values of yn(x) and yn'(x).
-! 
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) dy(0:n)
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) nm
-  real ( kind = 8 ) sy(0:n)
-  real ( kind = 8 ) x
-
-  nm = n
-
-  if ( x < 1.0D-60 ) then
-    do k = 0, n
-      sy(k) = -1.0D+300
-      dy(k) = 1.0D+300
-    end do
-    return
-  end if
-
-  sy(0) = - cos ( x ) / x
-  sy(1) = ( sy(0) - sin ( x ) ) / x
-  f0 = sy(0)
-  f1 = sy(1)
-  do k = 2, n
-    f = ( 2.0D+00 * k - 1.0D+00 ) * f1 / x - f0
-    sy(k) = f
-    if ( 1.0D+300 <= abs ( f ) ) then
-      exit
-    end if              
-    f0 = f1
-    f1 = f
-  end do
-
-  nm = k - 1
-  dy(0) = ( sin ( x ) + cos ( x ) / x ) / x
-  do k = 1, nm
-    dy(k) = sy(k-1) - ( k + 1.0D+00 ) * sy(k) / x
-  end do
-
-  return
-end
-subroutine stvh0 ( x, sh0 )
-
-!*****************************************************************************80
-!
-!! STVH0 computes the Struve function H0(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    22 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) SH0, the value of H0(x).
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) by0
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) km
-  real ( kind = 8 ) p0
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) q0
-  real ( kind = 8 ) r
-  real ( kind = 8 ) s
-  real ( kind = 8 ) sh0
-  real ( kind = 8 ) t
-  real ( kind = 8 ) t2
-  real ( kind = 8 ) ta0
-  real ( kind = 8 ) x
-
-  pi = 3.141592653589793D+00
-  s = 1.0D+00
-  r = 1.0D+00
-
-  if ( x <= 20.0D+00 ) then
-    a0 = 2.0D+00 * x / pi
-    do k = 1, 60
-      r = - r * x / ( 2.0D+00 * k + 1.0D+00 ) * x &
-        / ( 2.0D+00 * k + 1.0D+00 )
-      s = s + r
-      if ( abs ( r ) < abs ( s ) * 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    sh0 = a0 * s
-
-  else
-
-    if ( x < 50.0D+00 ) then
-      km = int ( 0.5D+00 * ( x + 1.0D+00 ) )
-    else
-      km = 25
-    end if
-
-    do k = 1, km
-      r = - r * ( ( 2.0D+00 * k - 1.0D+00 ) / x ) ** 2
-      s = s + r
-      if ( abs ( r ) < abs ( s ) * 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    t = 4.0D+00 / x
-    t2 = t * t
-
-    p0 = (((( &
-      - 0.37043D-05     * t2 &
-      + 0.173565D-04 )  * t2 &
-      - 0.487613D-04 )  * t2 &
-      + 0.17343D-03 )   * t2 &
-      - 0.1753062D-02 ) * t2 &
-      + 0.3989422793D+00
-
-    q0 = t * ((((( &
-        0.32312D-05     * t2 &
-      - 0.142078D-04 )  * t2 &
-      + 0.342468D-04 )  * t2 &
-      - 0.869791D-04 )  * t2 &
-      + 0.4564324D-03 ) * t2 &
-      - 0.0124669441D+00 )
-
-    ta0 = x - 0.25D+00 * pi
-    by0 = 2.0D+00 / sqrt ( x ) &
-      * ( p0 * sin ( ta0 ) + q0 * cos ( ta0 ) )
-    sh0 = 2.0D+00 / ( pi * x ) * s + by0
-
-  end if
-
-  return
-end
-subroutine stvh1 ( x, sh1 )
-
-!*****************************************************************************80
-!
-!! STVH1 computes the Struve function H1(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    22 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) SH1, the value of H1(x).
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) by1
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) km
-  real ( kind = 8 ) p1
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) q1
-  real ( kind = 8 ) r
-  real ( kind = 8 ) s
-  real ( kind = 8 ) sh1
-  real ( kind = 8 ) t
-  real ( kind = 8 ) t2
-  real ( kind = 8 ) ta1
-  real ( kind = 8 ) x
-
-  pi = 3.141592653589793D+00
-  r = 1.0D+00
-
-  if ( x <= 20.0D+00 ) then
-
-    s = 0.0D+00
-    a0 = - 2.0D+00 / pi
-    do k = 1, 60
-      r = - r * x * x / ( 4.0D+00 * k * k - 1.0D+00 )
-      s = s + r
-      if ( abs ( r ) < abs ( s ) * 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    sh1 = a0 * s
-
-  else
-
-    s = 1.0D+00
-
-    if ( x <= 50.0D+00 ) then
-      km = int ( 0.5D+00 * x )
-    else
-      km = 25
-    end if
-
-    do k = 1, km
-      r = - r * ( 4.0D+00 * k * k - 1.0D+00 ) / ( x * x )
-      s = s + r
-      if ( abs ( r ) < abs ( s ) * 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    t = 4.0D+00 / x
-    t2 = t * t
-
-    p1 = (((( &
-        0.42414D-05      * t2 &
-      - 0.20092d-04 )    * t2 &
-      + 0.580759D-04 )   * t2 &
-      - 0.223203D-03 )   * t2 &
-      + 0.29218256D-02 ) * t2 &
-      + 0.3989422819D+00
-
-    q1 = t * ((((( &
-      - 0.36594D-05     * t2 &
-      + 0.1622D-04 )    * t2 &
-      - 0.398708D-04 )  * t2 &
-      + 0.1064741D-03 ) * t2 &
-      - 0.63904D-03 )   * t2 &
-      + 0.0374008364D+00 )
-
-    ta1 = x - 0.75D+00 * pi
-    by1 = 2.0D+00 / sqrt ( x ) * ( p1 * sin ( ta1 ) + q1 * cos ( ta1 ) )
-    sh1 = 2.0D+00 / pi * ( 1.0D+00 + s / ( x * x ) ) + by1
-
-  end if
-
-  return
-end
- subroutine stvhv ( v, x, hv )
-
-!*****************************************************************************80
-!
-!! STVHV computes the Struve function Hv(x) with arbitrary order v.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    24 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) V, the order of the function.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) HV, the value of Hv(x).
-!
-  implicit none
-
-  real ( kind = 8 ) bf
-  real ( kind = 8 ) bf0
-  real ( kind = 8 ) bf1
-  real ( kind = 8 ) by0
-  real ( kind = 8 ) by1
-  real ( kind = 8 ) byv
-  real ( kind = 8 ) ga
-  real ( kind = 8 ) gb
-  real ( kind = 8 ) hv
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) pu0
-  real ( kind = 8 ) pu1
-  real ( kind = 8 ) qu0
-  real ( kind = 8 ) qu1
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) r2
-  real ( kind = 8 ) s
-  real ( kind = 8 ) s0
-  real ( kind = 8 ) sa
-  real ( kind = 8 ) sr
-  real ( kind = 8 ) t0
-  real ( kind = 8 ) t1
-  real ( kind = 8 ) u
-  real ( kind = 8 ) u0
-  real ( kind = 8 ) v
-  real ( kind = 8 ) v0
-  real ( kind = 8 ) va
-  real ( kind = 8 ) vb
-  real ( kind = 8 ) vt
-  real ( kind = 8 ) x
-
-  pi = 3.141592653589793D+00
-
-  if ( x == 0.0D+00 ) then
-    if ( -1.0D+00 < v .or. int ( v ) - v == 0.5D+00 ) then
-      hv = 0.0D+00
-    else if ( v < -1.0D+00 ) then
-      hv = ( -1.0D+00 ) ** ( int ( 0.5D+00 - v ) - 1 ) * 1.0D+300
-    else if ( v == -1.0D+00 ) then
-      hv = 2.0D+00 / pi
-    end if
-    return
-  end if
-
-  if ( x <= 20.0D+00 ) then
-
-    v0 = v + 1.5D+00
-    call gamma ( v0, ga )
-    s = 2.0D+00 / ( sqrt ( pi ) * ga )
-    r1 = 1.0D+00
-
-    do k = 1, 100
-      va = k + 1.5D+00
-      call gamma ( va, ga )
-      vb = v + k + 1.5D+00
-      call gamma ( vb, gb )
-      r1 = -r1 * ( 0.5D+00 * x ) ** 2
-      r2 = r1 / ( ga * gb )
-      s = s + r2
-      if ( abs ( r2 ) < abs ( s ) * 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    hv = ( 0.5D+00 * x ) ** ( v + 1.0D+00 ) * s
-
-  else
-
-    sa = ( 0.5D+00 * x ) ** ( v - 1.0D+00 ) / pi
-    v0 = v + 0.5D+00
-    call gamma ( v0, ga )
-    s = sqrt ( pi ) / ga
-    r1 = 1.0D+00
-
-    do k = 1, 12
-      va = k + 0.5D+00
-      call gamma ( va, ga )
-      vb = - k + v + 0.5D+00
-      call gamma ( vb, gb )
-      r1 = r1 / ( 0.5D+00 * x ) ** 2
-      s = s + r1 * ga / gb
-    end do
-
-    s0 = sa * s
-    u = abs ( v )
-    n = int ( u )
-    u0 = u - n
-
-    do l = 0, 1
-
-      vt = 4.0D+00 * ( u0 + l ) ** 2
-      r1 = 1.0D+00
-      pu1 = 1.0D+00
-      do k = 1, 12
-        r1 = -0.0078125D+00 * r1 &
-          * ( vt - ( 4.0D+00 * k - 3.0D+00 ) ** 2 ) &
-          * ( vt - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
-          / ( ( 2.0D+00 * k - 1.0D+00 ) * k * x * x )
-        pu1 = pu1 + r1
-      end do
-
-      qu1 = 1.0D+00
-      r2 = 1.0D+00
-      do k = 1, 12
-        r2 = -0.0078125D+00 * r2 &
-          * ( vt - ( 4.0D+00 * k - 1.0D+00 ) ** 2 ) &
-          * ( vt - ( 4.0D+00 * k + 1.0D+00 ) ** 2 ) &
-          / ( ( 2.0D+00 * k + 1.0D+00 ) * k * x * x )
-        qu1 = qu1 + r2
-      end do
-      qu1 = 0.125D+00 * ( vt - 1.0D+00 ) / x * qu1
-
-      if ( l == 0 ) then
-        pu0 = pu1
-        qu0 = qu1
-      end if
-
-    end do
-
-    t0 = x - ( 0.5D+00 * u0 + 0.25D+00 ) * pi
-    t1 = x - ( 0.5D+00 * u0 + 0.75D+00 ) * pi
-    sr = sqrt ( 2.0D+00 / ( pi * x ) )
-    by0 = sr * ( pu0 * sin ( t0 ) + qu0 * cos ( t0 ) )
-    by1 = sr * ( pu1 * sin ( t1 ) + qu1 * cos ( t1 ) )
-    bf0 = by0
-    bf1 = by1
-    do k = 2, n
-      bf = 2.0D+00 * ( k - 1.0D+00 + u0 ) / x * bf1 - bf0
-      bf0 = bf1
-      bf1 = bf
-    end do
-
-    if ( n == 0 ) then
-      byv = by0
-    else if ( n == 1 ) then
-      byv = by1
-    else
-      byv = bf
-    end if
-    hv = byv + s0
-  end if
-
-  return
-end
-subroutine stvl0 ( x, sl0 )
-
-!*****************************************************************************80
-!
-!! STVL0 computes the modified Struve function L0(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    22 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) SL0, the function value.
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) a1
-  real ( kind = 8 ) bi0
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) km
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r
-  real ( kind = 8 ) s
-  real ( kind = 8 ) sl0
-  real ( kind = 8 ) x
-
-  pi = 3.141592653589793D+00
-  s = 1.0D+00
-  r = 1.0D+00
-
-  if ( x <= 20.0D+00 ) then
-
-    a0 = 2.0D+00 * x / pi
-
-    do k = 1, 60
-      r = r * ( x / ( 2.0D+00 * k + 1.0D+00 ) ) ** 2
-      s = s + r
-      if ( abs ( r / s ) < 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    sl0 = a0 * s
-
-  else
-
-    if ( x < 50.0D+00 ) then
-      km = int ( 0.5D+00 * ( x + 1.0D+00 ) )
-    else
-      km = 25
-    end if
-
-    do k = 1, km
-      r = r * ( ( 2.0D+00 * k - 1.0D+00 ) / x ) ** 2
-      s = s + r
-      if ( abs ( r / s ) < 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    a1 = exp ( x ) / sqrt ( 2.0D+00 * pi * x )
-    r = 1.0D+00
-    bi0 = 1.0D+00
-    do k = 1, 16
-      r = 0.125D+00 * r * ( 2.0D+00 * k - 1.0D+00 ) ** 2 / ( k * x )
-      bi0 = bi0 + r
-      if ( abs ( r / bi0 ) < 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    bi0 = a1 * bi0
-    sl0 = - 2.0D+00 / ( pi * x ) * s + bi0
-
-  end if
-
-  return
-end
-subroutine stvl1 ( x, sl1 )
-
-!*****************************************************************************80
-!
-!! STVL1 computes the modified Struve function L1(x).
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    05 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) SL1, the function value.
-!
-  implicit none
-
-  real ( kind = 8 ) a1
-  real ( kind = 8 ) bi1
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) km
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r
-  real ( kind = 8 ) s
-  real ( kind = 8 ) sl1
-  real ( kind = 8 ) x
-
-  pi = 3.141592653589793D+00
-  r = 1.0D+00
-  if ( x <= 20.0D+00 ) then
-    s = 0.0D+00
-    do k = 1, 60
-      r = r * x * x / ( 4.0D+00 * k * k - 1.0D+00 )
-      s = s + r
-      if ( abs ( r / s ) < 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    sl1 = 2.0D+00 / pi * s
-
-  else
-
-    s = 1.0D+00
-    km = int ( 0.50D+00 * x )
-    km = min ( km, 25 )
-
-    do k = 1, km
-      r = r * ( 2.0D+00 * k + 3.0D+00 ) &
-        * ( 2.0D+00 * k + 1.0D+00 ) / ( x * x )
-      s = s + r
-      if ( abs ( r / s ) < 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    sl1 = 2.0D+00 / pi * ( -1.0D+00 + 1.0D+00 &
-      / ( x * x ) + 3.0D+00 * s / x**4 )
-    a1 = exp ( x ) / sqrt ( 2.0D+00 * pi * x )
-    r = 1.0D+00
-    bi1 = 1.0D+00
-    do k = 1, 16
-      r = -0.125D+00 * r &
-        * ( 4.0D+00 - ( 2.0D+00 * k - 1.0D+00 ) ** 2 ) / ( k * x )
-      bi1 = bi1 + r
-      if ( abs ( r / bi1 ) < 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    sl1 = sl1 + a1 * bi1
-
-  end if
-
-  return
-end
-subroutine stvlv ( v, x, slv )
+subroutine bjndd ( n, x, bj, dj, fj )
 
 !*****************************************************************************80
 !
-!! STVLV computes the modified Struve function Lv(x) with arbitary order.
+!! BJNDD computes Bessel functions Jn(x) and first and second derivatives.
 !
 !  Licensing:
 !
@@ -25004,7 +12,7 @@ subroutine stvlv ( v, x, slv )
 !
 !  Modified:
 !
-!    04 July 2012
+!    11 July 2012
 !
 !  Author:
 !
@@ -25020,394 +28,64 @@ subroutine stvlv ( v, x, slv )
 !
 !  Parameters:
 !
-!    Input, real ( kind = 8 ) V, the order of Lv(x).
-!
-!    Input, real ( kind = 8 ) X, the argument of Lv(x).
-!
-!    Output, real ( kind = 8 ) SLV, the value of Lv(x).
-!
-  implicit none
-
-  real ( kind = 8 ) bf
-  real ( kind = 8 ) bf0
-  real ( kind = 8 ) bf1
-  real ( kind = 8 ) biv
-  real ( kind = 8 ) biv0
-  real ( kind = 8 ) ga
-  real ( kind = 8 ) gb
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) l
-  integer ( kind = 4 ) n
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) r2
-  real ( kind = 8 ) s
-  real ( kind = 8 ) s0
-  real ( kind = 8 ) sa
-  real ( kind = 8 ) slv
-  real ( kind = 8 ) u
-  real ( kind = 8 ) u0
-  real ( kind = 8 ) v
-  real ( kind = 8 ) v0
-  real ( kind = 8 ) va
-  real ( kind = 8 ) vb
-  real ( kind = 8 ) vt
-  real ( kind = 8 ) x
-
-  pi = 3.141592653589793D+00
-
-  if ( x == 0.0D+00 ) then
-
-    if ( -1.0D+00 < v .or. int ( v ) - v == 0.5D+00 ) then
-      slv = 0.0D+00
-    else if ( v < -1.0D+00 ) then
-      slv = ( -1 ) ** ( int ( 0.5D+00 - v ) - 1 ) * 1.0D+300
-    else if ( v == -1.0D+00 ) then
-      slv = 2.0D+00 / pi
-    end if
-
-  else if ( x <= 40.0D+00 ) then
-
-    v0 = v + 1.5D+00
-    call gamma ( v0, ga )
-    s = 2.0D+00 / ( sqrt ( pi ) * ga )
-    r1 = 1.0D+00
-    do k = 1, 100
-      va = k + 1.5D+00
-      call gamma ( va, ga )
-      vb = v + k + 1.5D+00
-      call gamma ( vb, gb )
-      r1 = r1 * ( 0.5D+00 * x ) ** 2
-      r2 = r1 / ( ga * gb )
-      s = s + r2
-      if ( abs ( r2 / s ) < 1.0D-12 ) then
-        exit
-      end if
-    end do
-
-    slv = ( 0.5D+00 * x ) ** ( v + 1.0D+00 ) * s
-
-  else
-
-    sa = -1.0D+00 / pi * ( 0.5D+00 * x ) ** ( v - 1.0D+00 )
-    v0 = v + 0.5D+00
-    call gamma ( v0, ga )
-    s = - sqrt ( pi ) / ga
-    r1 = -1.0D+00
-    do k = 1, 12
-      va = k + 0.5D+00
-      call gamma ( va, ga )
-      vb = - k + v + 0.5D+00
-      call gamma ( vb, gb )
-      r1 = - r1 / ( 0.5D+00 * x ) ** 2
-      s = s + r1 * ga / gb
-    end do
-    s0 = sa * s
-    u = abs ( v )
-    n = int ( u )
-    u0 = u - n
-    do l = 0, 1
-      vt = u0 + l
-      r = 1.0D+00
-      biv = 1.0D+00
-      do k = 1, 16
-        r = -0.125D+00 * r * ( 4.0D+00 * vt * vt - &
-          ( 2.0D+00 * k - 1.0D+00 )**2 ) / ( k * x )
-        biv = biv + r
-        if ( abs ( r / biv ) < 1.0D-12 ) then
-          exit
-        end if
-      end do
-
-      if ( l == 0 ) then
-        biv0 = biv
-      end if
-
-    end do
-
-    bf0 = biv0
-    bf1 = biv
-    do k = 2, n
-      bf = - 2.0D+00 * ( k - 1.0D+00 + u0 ) / x * bf1 + bf0
-      bf0 = bf1
-      bf1 = bf
-    end do
-
-    if ( n == 0 ) then
-      biv = biv0
-    else if ( 1 < n ) then
-      biv = bf
-    end if
-
-    slv = exp ( x ) / sqrt ( 2.0D+00 * pi * x ) * biv + s0
-
-  end if
-
-  return
-end
-subroutine timestamp ( )
-
-!*****************************************************************************80
-!
-!! TIMESTAMP prints the current YMDHMS date as a time stamp.
-!
-!  Example:
-!
-!    May 31 2001   9:45:54.872 AM
-!
-!  Modified:
-!
-!    31 May 2001
-!
-!  Author:
-!
-!    John Burkardt
+!    Input, integer ( kind = 4 ) N, the order.
 !
-!  Parameters:
+!    Input, real ( kind = 8 ) X, the argument.
 !
-!    None
+!    Output, real ( kind = 8 ) BJ(N+1), DJ(N+1), FJ(N+1), the values of 
+!    Jn(x), Jn'(x) and Jn''(x) in the last entries.
 !
   implicit none
 
-  character ( len = 8 ) ampm
-  integer ( kind = 4 ) d
-  character ( len = 8 ) date
-  integer ( kind = 4 ) h
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) mm
-  character ( len = 9 ), parameter, dimension(12) :: month = (/ &
-    'January  ', 'February ', 'March    ', 'April    ', &
-    'May      ', 'June     ', 'July     ', 'August   ', &
-    'September', 'October  ', 'November ', 'December ' /)
   integer ( kind = 4 ) n
-  integer ( kind = 4 ) s
-  character ( len = 10 ) time
-  integer ( kind = 4 ) values(8)
-  integer ( kind = 4 ) y
-  character ( len = 5 ) zone
-
-  call date_and_time ( date, time, zone, values )
-
-  y = values(1)
-  m = values(2)
-  d = values(3)
-  h = values(5)
-  n = values(6)
-  s = values(7)
-  mm = values(8)
-
-  if ( h < 12 ) then
-    ampm = 'AM'
-  else if ( h == 12 ) then
-    if ( n == 0 .and. s == 0 ) then
-      ampm = 'Noon'
-    else
-      ampm = 'PM'
-    end if
-  else
-    h = h - 12
-    if ( h < 12 ) then
-      ampm = 'PM'
-    else if ( h == 12 ) then
-      if ( n == 0 .and. s == 0 ) then
-        ampm = 'Midnight'
-      else
-        ampm = 'AM'
-      end if
-    end if
-  end if
-
-  write ( *, '(a,1x,i2,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) &
-    trim ( month(m) ), d, y, h, ':', n, ':', s, '.', mm, trim ( ampm )
-
-  return
-end
-subroutine vvla ( va, x, pv )
-
-!*****************************************************************************80
-!
-!! VVLA computes parabolic cylinder function Vv(x) for large arguments.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    04 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Input, real ( kind = 8 ) VA, the order nu.
-!
-!    Output, real ( kind = 8 ) PV, the value of V(nu,x).
-!
-  implicit none
 
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) dsl
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) gl
+  real ( kind = 8 ) bj(n+1)
+  real ( kind = 8 ) bs
+  real ( kind = 8 ) dj(n+1)
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) fj(n+1)
   integer ( kind = 4 ) k
-  real ( kind = 8 ) pdl
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) pv
-  real ( kind = 8 ) qe
-  real ( kind = 8 ) r
-  real ( kind = 8 ) va
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) mt
+  integer ( kind = 4 ) nt
   real ( kind = 8 ) x
-  real ( kind = 8 ) x1
 
-  pi = 3.141592653589793D+00
-  eps = 1.0D-12
-  qe = exp ( 0.25D+00 * x * x )
-  a0 = abs ( x ) ** ( -va - 1.0D+00 ) * sqrt ( 2.0D+00 / pi ) * qe
-
-  r = 1.0D+00
-  pv = 1.0D+00
-  do k = 1, 18
-    r = 0.5D+00 * r * ( 2.0D+00 * k + va - 1.0D+00 ) &
-      * ( 2.0D+00 * k + va ) / ( k * x * x )
-    pv = pv + r
-    if ( abs ( r / pv ) < eps ) then
+  do nt = 1, 900
+    mt = int ( 0.5D+00 * log10 ( 6.28D+00 * nt ) &
+      - nt * log10 ( 1.36D+00 * abs ( x ) / nt ) )
+    if ( 20 < mt ) then
       exit
     end if
   end do
 
-  pv = a0 * pv
-
-  if ( x < 0.0D+00 ) then
-    x1 = -x
-    call dvla ( va, x1, pdl )
-    call gamma ( -va, gl )
-    dsl = sin ( pi * va ) * sin ( pi * va )
-    pv = dsl * gl / pi * pdl - cos ( pi * va ) * pv
-  end if
-
-  return
-end
-subroutine vvsa ( va, x, pv )
-
-!*****************************************************************************80
-!
-!! VVSA computes parabolic cylinder function V(nu,x) for small arguments.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    04 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Input, real ( kind = 8 ) VA, the order nu.
-!
-!    Output, real ( kind = 8 ) PV, the value of V(nu,x).
-!
-  implicit none
-
-  real ( kind = 8 ) a0
-  real ( kind = 8 ) ep
-  real ( kind = 8 ) eps
-  real ( kind = 8 ) fac
-  real ( kind = 8 ) g1
-  real ( kind = 8 ) ga0
-  real ( kind = 8 ) gm
-  real ( kind = 8 ) gw
-  integer ( kind = 4 ) m
-  real ( kind = 8 ) pi
-  real ( kind = 8 ) pv
-  real ( kind = 8 ) r
-  real ( kind = 8 ) r1
-  real ( kind = 8 ) sq2
-  real ( kind = 8 ) sv
-  real ( kind = 8 ) sv0
-  real ( kind = 8 ) v1
-  real ( kind = 8 ) va
-  real ( kind = 8 ) va0
-  real ( kind = 8 ) vb0
-  real ( kind = 8 ) vm
-  real ( kind = 8 ) x
-
-  eps = 1.0D-15
-  pi = 3.141592653589793D+00
-  ep = exp ( -0.25D+00 * x * x )
-  va0 = 1.0D+00 + 0.5D+00 * va
-
-  if ( x == 0.0D+00 ) then
-
-    if ( ( va0 <= 0.0D+00 .and. va0 == int ( va0 ) ) .or. &
-      va == 0.0D+00 ) then
-      pv = 0.0D+00
-    else
-      vb0 = -0.5D+00 * va
-      sv0 = sin ( va0 * pi )
-      call gamma ( va0, ga0 )
-      pv = 2.0D+00 ** vb0 * sv0 / ga0
+  m = nt
+  bs = 0.0D+00
+  f0 = 0.0D+00
+  f1 = 1.0D-35
+  do k = m, 0, -1
+    f = 2.0D+00 * ( k + 1.0D+00 ) * f1 / x - f0
+    if ( k <= n ) then
+      bj(k+1) = f
     end if
+    if ( k == 2 * int ( k / 2 ) ) then
+      bs = bs + 2.0D+00 * f
+    end if
+    f0 = f1
+    f1 = f
+  end do
 
-  else
-
-    sq2 = sqrt ( 2.0D+00 )
-    a0 = 2.0D+00 ** ( -0.5D+00 * va ) * ep / ( 2.0D+00 * pi )
-    sv = sin ( - ( va + 0.5D+00 ) * pi )
-    v1 = -0.5D+00 * va
-    call gamma ( v1, g1 )
-    pv = ( sv + 1.0D+00 ) * g1
-    r = 1.0D+00
-    fac = 1.0D+00
-
-    do m = 1, 250
-      vm = 0.5D+00 * ( m - va )
-      call gamma ( vm, gm )
-      r = r * sq2 * x / m
-      fac = - fac
-      gw = fac * sv + 1.0D+00
-      r1 = gw * r * gm
-      pv = pv + r1
-      if ( abs ( r1 / pv ) < eps .and. gw /= 0.0D+00 ) then
-        exit
-      end if
-    end do
-
-    pv = a0 * pv
+  do k = 0, n
+    bj(k+1) = bj(k+1) / ( bs - f )
+  end do
 
-  end if
+  dj(1) = -bj(2)
+  fj(1) = -1.0D+00 * bj(1) - dj(1) / x
+  do k = 1, n
+    dj(k+1) = bj(k) - k * bj(k+1) / x
+    fj(k+1) = ( k * k / ( x * x ) - 1.0D+00 ) * bj(k+1) - dj(k+1) / x
+  end do
 
   return
-end
+end
\ No newline at end of file
diff --git a/src/param.c b/src/param.c
index d6d49a11..e9ef60cb 100644
--- a/src/param.c
+++ b/src/param.c
@@ -226,6 +226,11 @@ static const struct subopt_struct beam_opt[]={
 		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
 		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
 		UNDEF,B_BESSELCS},
+	{"besselGen","<RePex> <ImPex> <RePey> <ImPey> <RePmx> <ImPmx> <RePmy> <ImPmy> \n\t<order> <angle> [<x> <y> <z>]",
+		"Generalized Bessel beam. The half-cone angle is measured from the z axis. The half-cone angle and beam order "
+		"are obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
+		"(zero, by default). Coordinate arguments are in um.",
+		UNDEF,B_BESSELGEN},
 	{"besselLE","<order> <angle> [<x> <y> <z>]","Bessel beam with linearly polarized electric field. The half-cone angle "
 		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
 		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
@@ -234,11 +239,11 @@ static const struct subopt_struct beam_opt[]={
 		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
 		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
 		UNDEF,B_BESSELLM},
-	{"besselTEC","<order> <angle> [<x> <y> <z>]","Bessel beam forming the TE Bessel beam. The half-cone angle "
+	{"besselTEC","<order> <angle> [<x> <y> <z>]","Bessel beam forming TE Bessel beam. The half-cone angle "
 		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
 		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
 		UNDEF,B_BESSELTEC},
-	{"besselTMC","<order> <angle> [<x> <y> <z>]","Bessel beam forming the TM Bessel beam. The half-cone angle "
+	{"besselTMC","<order> <angle> [<x> <y> <z>]","Bessel beam forming TM Bessel beam. The half-cone angle "
 		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
 		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
 		UNDEF,B_BESSELTMC},
@@ -1002,6 +1007,7 @@ PARSE_FUNC(beam)
 			case B_DAVIS3:
 			case B_BARTON5: if (Narg!=1 && Narg!=4) NargError(Narg,"1 or 4"); break;
 			case B_BESSELCS: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
+			case B_BESSELGEN: if (Narg!=10 && Narg!=13) NargError(Narg,"10 or 13"); break;
 			case B_BESSELLE: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
 			case B_BESSELLM: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
 			case B_BESSELTEC: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;

From 2958bf9733ff72ac7195b126ce0e9524c0c8c959 Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Wed, 23 Dec 2020 17:18:50 +0700
Subject: [PATCH 07/46] cleaning

---
 src/.cproject                                 | 134 +++++
 src/.project                                  |  26 +
 src/.settings/language.settings.xml           |  28 ++
 .../org.eclipse.cdt.codan.core.prefs          |  77 +++
 src/GenerateB.c                               | 464 +++++-------------
 src/Makefile                                  |   2 +-
 src/const.h                                   |   1 +
 src/mpi/Makefile                              |  70 ---
 src/param.c                                   |   5 +
 src/updgithash.sh                             |  32 --
 10 files changed, 397 insertions(+), 442 deletions(-)
 create mode 100644 src/.cproject
 create mode 100644 src/.project
 create mode 100644 src/.settings/language.settings.xml
 create mode 100644 src/.settings/org.eclipse.cdt.codan.core.prefs
 delete mode 100644 src/mpi/Makefile
 delete mode 100644 src/updgithash.sh

diff --git a/src/.cproject b/src/.cproject
new file mode 100644
index 00000000..e6f78a6f
--- /dev/null
+++ b/src/.cproject
@@ -0,0 +1,134 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<?fileVersion 4.0.0?><cproject storage_type_id="org.eclipse.cdt.core.XmlProjectDescriptionStorage">
+    	
+    <storageModule moduleId="org.eclipse.cdt.core.settings">
+        		
+        <cconfiguration id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582">
+            			
+            <storageModule buildSystemId="org.eclipse.cdt.managedbuilder.core.configurationDataProvider" id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582" moduleId="org.eclipse.cdt.core.settings" name="Default">
+                				
+                <externalSettings/>
+                				
+                <extensions>
+                    					
+                    <extension id="org.eclipse.cdt.core.PE" point="org.eclipse.cdt.core.BinaryParser"/>
+                    					
+                    <extension id="org.eclipse.cdt.core.GASErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+                    					
+                    <extension id="org.eclipse.cdt.core.GLDErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+                    					
+                    <extension id="org.eclipse.cdt.core.GCCErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+                    					
+                    <extension id="org.eclipse.cdt.core.GmakeErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+                    					
+                    <extension id="org.eclipse.cdt.core.CWDLocator" point="org.eclipse.cdt.core.ErrorParser"/>
+                    				
+                </extensions>
+                			
+            </storageModule>
+            			
+            <storageModule moduleId="cdtBuildSystem" version="4.0.0">
+                				
+                <configuration buildProperties="" description="" id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582" name="Default" optionalBuildProperties="" parent="org.eclipse.cdt.build.core.emptycfg">
+                    					
+                    <folderInfo id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582.1127462783" name="/" resourcePath="">
+                        						
+                        <toolChain id="cdt.managedbuild.toolchain.gnu.mingw.base.1035458335" name="MinGW GCC" superClass="cdt.managedbuild.toolchain.gnu.mingw.base">
+                            							
+                            <targetPlatform archList="all" binaryParser="org.eclipse.cdt.core.PE" id="cdt.managedbuild.target.gnu.platform.mingw.base.1085348987" name="Debug Platform" osList="win32" superClass="cdt.managedbuild.target.gnu.platform.mingw.base"/>
+                            							
+                            <builder id="cdt.managedbuild.builder.gnu.cross.1398979264" managedBuildOn="false" superClass="cdt.managedbuild.builder.gnu.cross"/>
+                            							
+                            <tool id="cdt.managedbuild.tool.gnu.assembler.mingw.base.1518750006" name="GCC Assembler" superClass="cdt.managedbuild.tool.gnu.assembler.mingw.base">
+                                								
+                                <inputType id="cdt.managedbuild.tool.gnu.assembler.input.1540650047" superClass="cdt.managedbuild.tool.gnu.assembler.input"/>
+                                							
+                            </tool>
+                            							
+                            <tool id="cdt.managedbuild.tool.gnu.archiver.mingw.base.909230791" name="GCC Archiver" superClass="cdt.managedbuild.tool.gnu.archiver.mingw.base"/>
+                            							
+                            <tool id="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base.462309889" name="GCC C++ Compiler" superClass="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base"/>
+                            							
+                            <tool id="cdt.managedbuild.tool.gnu.c.compiler.mingw.base.1803672067" name="GCC C Compiler" superClass="cdt.managedbuild.tool.gnu.c.compiler.mingw.base">
+                                								
+                                <inputType id="cdt.managedbuild.tool.gnu.c.compiler.input.1946895431" superClass="cdt.managedbuild.tool.gnu.c.compiler.input"/>
+                                							
+                            </tool>
+                            							
+                            <tool id="cdt.managedbuild.tool.gnu.c.linker.mingw.base.1010477471" name="MinGW C Linker" superClass="cdt.managedbuild.tool.gnu.c.linker.mingw.base">
+                                								
+                                <inputType id="cdt.managedbuild.tool.gnu.c.linker.input.1282503363" superClass="cdt.managedbuild.tool.gnu.c.linker.input">
+                                    									
+                                    <additionalInput kind="additionalinputdependency" paths="$(USER_OBJS)"/>
+                                    									
+                                    <additionalInput kind="additionalinput" paths="$(LIBS)"/>
+                                    								
+                                </inputType>
+                                							
+                            </tool>
+                            							
+                            <tool id="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base.625915771" name="MinGW C++ Linker" superClass="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base"/>
+                            						
+                        </toolChain>
+                        					
+                    </folderInfo>
+                    				
+                </configuration>
+                			
+            </storageModule>
+            			
+            <storageModule moduleId="org.eclipse.cdt.core.externalSettings"/>
+            		
+        </cconfiguration>
+        	
+    </storageModule>
+    	
+    <storageModule moduleId="cdtBuildSystem" version="4.0.0">
+        		
+        <project id="adda-master.null.1518122536" name="adda-master"/>
+        	
+    </storageModule>
+    	
+    <storageModule moduleId="scannerConfiguration">
+        		
+        <autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId=""/>
+        	
+    </storageModule>
+    	
+    <storageModule moduleId="org.eclipse.cdt.core.LanguageSettingsProviders"/>
+    	
+    <storageModule moduleId="refreshScope" versionNumber="2">
+        		
+        <configuration configurationName="Default">
+            			
+            <resource resourceType="PROJECT" workspacePath="/adda-master"/>
+            		
+        </configuration>
+        	
+    </storageModule>
+    	
+    <storageModule moduleId="org.eclipse.cdt.make.core.buildtargets">
+        		
+        <buildTargets>
+            			
+            <target name="seq" path="" targetID="org.eclipse.cdt.build.MakeTargetBuilder">
+                				
+                <buildCommand>make</buildCommand>
+                				
+                <buildArguments/>
+                				
+                <buildTarget>seq</buildTarget>
+                				
+                <stopOnError>true</stopOnError>
+                				
+                <useDefaultCommand>true</useDefaultCommand>
+                				
+                <runAllBuilders>true</runAllBuilders>
+                			
+            </target>
+            		
+        </buildTargets>
+        	
+    </storageModule>
+    
+</cproject>
diff --git a/src/.project b/src/.project
new file mode 100644
index 00000000..0fbe4c7f
--- /dev/null
+++ b/src/.project
@@ -0,0 +1,26 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<projectDescription>
+	<name>adda-master</name>
+	<comment></comment>
+	<projects>
+	</projects>
+	<buildSpec>
+		<buildCommand>
+			<name>org.eclipse.cdt.managedbuilder.core.genmakebuilder</name>
+			<triggers>clean,full,incremental,</triggers>
+			<arguments>
+			</arguments>
+		</buildCommand>
+		<buildCommand>
+			<name>org.eclipse.cdt.managedbuilder.core.ScannerConfigBuilder</name>
+			<triggers>full,incremental,</triggers>
+			<arguments>
+			</arguments>
+		</buildCommand>
+	</buildSpec>
+	<natures>
+		<nature>org.eclipse.cdt.core.cnature</nature>
+		<nature>org.eclipse.cdt.managedbuilder.core.managedBuildNature</nature>
+		<nature>org.eclipse.cdt.managedbuilder.core.ScannerConfigNature</nature>
+	</natures>
+</projectDescription>
diff --git a/src/.settings/language.settings.xml b/src/.settings/language.settings.xml
new file mode 100644
index 00000000..b4d2bd76
--- /dev/null
+++ b/src/.settings/language.settings.xml
@@ -0,0 +1,28 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<project>
+    	
+    <configuration id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582" name="Default">
+        		
+        <extension point="org.eclipse.cdt.core.LanguageSettingsProvider">
+            			
+            <provider copy-of="extension" id="org.eclipse.cdt.ui.UserLanguageSettingsProvider"/>
+            			
+            <provider-reference id="org.eclipse.cdt.core.ReferencedProjectsLanguageSettingsProvider" ref="shared-provider"/>
+            			
+            <provider class="org.eclipse.cdt.managedbuilder.language.settings.providers.GCCBuildCommandParser" id="org.eclipse.cdt.managedbuilder.core.GCCBuildCommandParser" keep-relative-paths="false" name="CDT GCC Build Output Parser" parameter="(g?cc)|([gc]\+\+)|(clang)" prefer-non-shared="true"/>
+            			
+            <provider class="org.eclipse.cdt.managedbuilder.internal.language.settings.providers.GCCBuiltinSpecsDetectorMinGW" console="false" env-hash="-1655415211902458007" id="org.eclipse.cdt.managedbuilder.core.GCCBuiltinSpecsDetectorMinGW" keep-relative-paths="false" name="CDT GCC Built-in Compiler Settings MinGW" parameter="${COMMAND} ${FLAGS} -E -P -v -dD &quot;${INPUTS}&quot;" prefer-non-shared="true">
+                				
+                <language-scope id="org.eclipse.cdt.core.gcc"/>
+                				
+                <language-scope id="org.eclipse.cdt.core.g++"/>
+                			
+            </provider>
+            			
+            <provider-reference id="org.eclipse.cdt.managedbuilder.core.MBSLanguageSettingsProvider" ref="shared-provider"/>
+            		
+        </extension>
+        	
+    </configuration>
+    
+</project>
diff --git a/src/.settings/org.eclipse.cdt.codan.core.prefs b/src/.settings/org.eclipse.cdt.codan.core.prefs
new file mode 100644
index 00000000..73293b43
--- /dev/null
+++ b/src/.settings/org.eclipse.cdt.codan.core.prefs
@@ -0,0 +1,77 @@
+eclipse.preferences.version=1
+org.eclipse.cdt.codan.checkers.errnoreturn=Warning
+org.eclipse.cdt.codan.checkers.errnoreturn.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"No return\\")",implicit\=>false}
+org.eclipse.cdt.codan.checkers.errreturnvalue=Error
+org.eclipse.cdt.codan.checkers.errreturnvalue.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Unused return value\\")"}
+org.eclipse.cdt.codan.checkers.nocommentinside=-Error
+org.eclipse.cdt.codan.checkers.nocommentinside.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Nesting comments\\")"}
+org.eclipse.cdt.codan.checkers.nolinecomment=-Error
+org.eclipse.cdt.codan.checkers.nolinecomment.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Line comments\\")"}
+org.eclipse.cdt.codan.checkers.noreturn=Error
+org.eclipse.cdt.codan.checkers.noreturn.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"No return value\\")",implicit\=>false}
+org.eclipse.cdt.codan.internal.checkers.AbstractClassCreation=Error
+org.eclipse.cdt.codan.internal.checkers.AbstractClassCreation.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Abstract class cannot be instantiated\\")"}
+org.eclipse.cdt.codan.internal.checkers.AmbiguousProblem=Error
+org.eclipse.cdt.codan.internal.checkers.AmbiguousProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Ambiguous problem\\")"}
+org.eclipse.cdt.codan.internal.checkers.AssignmentInConditionProblem=Warning
+org.eclipse.cdt.codan.internal.checkers.AssignmentInConditionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Assignment in condition\\")"}
+org.eclipse.cdt.codan.internal.checkers.AssignmentToItselfProblem=Error
+org.eclipse.cdt.codan.internal.checkers.AssignmentToItselfProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Assignment to itself\\")"}
+org.eclipse.cdt.codan.internal.checkers.CaseBreakProblem=Warning
+org.eclipse.cdt.codan.internal.checkers.CaseBreakProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"No break at end of case\\")",no_break_comment\=>"no break",last_case_param\=>false,empty_case_param\=>false,enable_fallthrough_quickfix_param\=>false}
+org.eclipse.cdt.codan.internal.checkers.CatchByReference=Warning
+org.eclipse.cdt.codan.internal.checkers.CatchByReference.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Catching by reference is recommended\\")",unknown\=>false,exceptions\=>()}
+org.eclipse.cdt.codan.internal.checkers.CircularReferenceProblem=Error
+org.eclipse.cdt.codan.internal.checkers.CircularReferenceProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Circular inheritance\\")"}
+org.eclipse.cdt.codan.internal.checkers.ClassMembersInitialization=Warning
+org.eclipse.cdt.codan.internal.checkers.ClassMembersInitialization.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Class members should be properly initialized\\")",skip\=>true}
+org.eclipse.cdt.codan.internal.checkers.DecltypeAutoProblem=Error
+org.eclipse.cdt.codan.internal.checkers.DecltypeAutoProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid 'decltype(auto)' specifier\\")"}
+org.eclipse.cdt.codan.internal.checkers.FieldResolutionProblem=Error
+org.eclipse.cdt.codan.internal.checkers.FieldResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Field cannot be resolved\\")"}
+org.eclipse.cdt.codan.internal.checkers.FunctionResolutionProblem=Error
+org.eclipse.cdt.codan.internal.checkers.FunctionResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Function cannot be resolved\\")"}
+org.eclipse.cdt.codan.internal.checkers.InvalidArguments=Error
+org.eclipse.cdt.codan.internal.checkers.InvalidArguments.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid arguments\\")"}
+org.eclipse.cdt.codan.internal.checkers.InvalidTemplateArgumentsProblem=Error
+org.eclipse.cdt.codan.internal.checkers.InvalidTemplateArgumentsProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid template argument\\")"}
+org.eclipse.cdt.codan.internal.checkers.LabelStatementNotFoundProblem=Error
+org.eclipse.cdt.codan.internal.checkers.LabelStatementNotFoundProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Label statement not found\\")"}
+org.eclipse.cdt.codan.internal.checkers.MemberDeclarationNotFoundProblem=Error
+org.eclipse.cdt.codan.internal.checkers.MemberDeclarationNotFoundProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Member declaration not found\\")"}
+org.eclipse.cdt.codan.internal.checkers.MethodResolutionProblem=Error
+org.eclipse.cdt.codan.internal.checkers.MethodResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Method cannot be resolved\\")"}
+org.eclipse.cdt.codan.internal.checkers.NamingConventionFunctionChecker=-Info
+org.eclipse.cdt.codan.internal.checkers.NamingConventionFunctionChecker.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Name convention for function\\")",pattern\=>"^[a-z]",macro\=>true,exceptions\=>()}
+org.eclipse.cdt.codan.internal.checkers.NonVirtualDestructorProblem=Warning
+org.eclipse.cdt.codan.internal.checkers.NonVirtualDestructorProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Class has a virtual method and non-virtual destructor\\")"}
+org.eclipse.cdt.codan.internal.checkers.OverloadProblem=Error
+org.eclipse.cdt.codan.internal.checkers.OverloadProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid overload\\")"}
+org.eclipse.cdt.codan.internal.checkers.RedeclarationProblem=Error
+org.eclipse.cdt.codan.internal.checkers.RedeclarationProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid redeclaration\\")"}
+org.eclipse.cdt.codan.internal.checkers.RedefinitionProblem=Error
+org.eclipse.cdt.codan.internal.checkers.RedefinitionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid redefinition\\")"}
+org.eclipse.cdt.codan.internal.checkers.ReturnStyleProblem=-Warning
+org.eclipse.cdt.codan.internal.checkers.ReturnStyleProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Return with parenthesis\\")"}
+org.eclipse.cdt.codan.internal.checkers.ScanfFormatStringSecurityProblem=-Warning
+org.eclipse.cdt.codan.internal.checkers.ScanfFormatStringSecurityProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Format String Vulnerability\\")"}
+org.eclipse.cdt.codan.internal.checkers.StatementHasNoEffectProblem=Warning
+org.eclipse.cdt.codan.internal.checkers.StatementHasNoEffectProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Statement has no effect\\")",macro\=>true,exceptions\=>()}
+org.eclipse.cdt.codan.internal.checkers.SuggestedParenthesisProblem=Warning
+org.eclipse.cdt.codan.internal.checkers.SuggestedParenthesisProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Suggested parenthesis around expression\\")",paramNot\=>false}
+org.eclipse.cdt.codan.internal.checkers.SuspiciousSemicolonProblem=Warning
+org.eclipse.cdt.codan.internal.checkers.SuspiciousSemicolonProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Suspicious semicolon\\")",else\=>false,afterelse\=>false}
+org.eclipse.cdt.codan.internal.checkers.TypeResolutionProblem=Error
+org.eclipse.cdt.codan.internal.checkers.TypeResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Type cannot be resolved\\")"}
+org.eclipse.cdt.codan.internal.checkers.UnusedFunctionDeclarationProblem=Warning
+org.eclipse.cdt.codan.internal.checkers.UnusedFunctionDeclarationProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Unused function declaration\\")",macro\=>true}
+org.eclipse.cdt.codan.internal.checkers.UnusedStaticFunctionProblem=Warning
+org.eclipse.cdt.codan.internal.checkers.UnusedStaticFunctionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Unused static function\\")",macro\=>true}
+org.eclipse.cdt.codan.internal.checkers.UnusedVariableDeclarationProblem=Warning
+org.eclipse.cdt.codan.internal.checkers.UnusedVariableDeclarationProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Unused variable declaration in file scope\\")",macro\=>true,exceptions\=>("@(\#)","$Id")}
+org.eclipse.cdt.codan.internal.checkers.UsingInHeaderProblem=-Warning
+org.eclipse.cdt.codan.internal.checkers.UsingInHeaderProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Using directive in header\\")"}
+org.eclipse.cdt.codan.internal.checkers.VariableResolutionProblem=Error
+org.eclipse.cdt.codan.internal.checkers.VariableResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Symbol is not resolved\\")"}
+org.eclipse.cdt.qt.core.qtproblem=Warning
+org.eclipse.cdt.qt.core.qtproblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>false,RUN_ON_INC_BUILD\=>false,RUN_ON_FILE_OPEN\=>true,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>null}
diff --git a/src/GenerateB.c b/src/GenerateB.c
index 4cf21383..f18b1855 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -192,6 +192,7 @@ void InitBeam(void)
 				                                      "\tCenter position: "GFORMDEF3V,w0,s,COMP3V(beam_center_0));
 			}
 			return;
+		case B_BESSELASD:
 		case B_BESSELCS:
 		case B_BESSELGEN:
 		case B_BESSELLE:
@@ -217,6 +218,9 @@ void InitBeam(void)
 			if (IFROOT) {
 				strcpy(beam_descr,"Bessel beam (");
 				switch (beamtype) {
+					case B_BESSELASD:
+						strcat(beam_descr,"angular spectrum decomposition)\n");
+						break;
 					case B_BESSELCS:
 						strcat(beam_descr,"circularly symmetric energy density)\n");
 						break;
@@ -278,6 +282,14 @@ void InitBeam(void)
 }
 
 //======================================================================================================================
+void Fpw(doublecomplex *F,int l,doublecomplex k,double r0,double tht0, double phi0, double alph, double bet)
+{
+	doublecomplex fexp = cexp(I*l*bet + I*k*r0*(sin(alph)*sin(tht0)*cos(bet-phi0)+cos(alph)*cos(tht0)));
+	*F = (cos(alph)*cos(bet)*cos(bet)+sin(bet)*sin(bet))*fexp;
+	*(F+1) = -(1-cos(alph))*sin(bet)*cos(bet)*fexp;
+	*(F+2) = -sin(alph)*cos(bet)*fexp;
+}
+
 
 void GenerateB (const enum incpol which,   // x - or y polarized incident light
                 doublecomplex *restrict b) // the b vector for the incident field
@@ -285,15 +297,15 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 {
 	size_t i,j;
 	doublecomplex psi0,Q,Q2;
-	doublecomplex v1[3],v2[3],v3[3],gt[6];
-	double ro, ro2,ro4;
-	double x,y,z,x2_s,xy_s,phi,arg,td1[n0+2],td2[n0+2],jn1[n0+2],p[4][2];
+	doublecomplex v1[3],v2[3],v3[3],gt[6],fint[3],sum[3];
+	double ro,ro2,ro4,r;
+	double x,y,z,x2_s,xy_s,tht,phi,arg,td1[n0+2],td2[n0+2],jn1[n0+2],p[4][2],db;
 	doublecomplex t1,t2,t3,t4,t5,t6,t7,t8,ctemp;
 	const double *ex; // coordinate axis of the beam reference frame
 	double ey[3];
 	double r1[3];
 	double jn2[2]; // for Bessel functions on n and n+1 orders
-	int n1;
+	int n1,it,N;
 	const char *fname;
 	/* TO ADD NEW BEAM
 	 * Add here all intermediate variables, which are used only inside this function. You may as well use 't1'-'t8'
@@ -484,315 +496,51 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				}
 			}
 			return;
-		/*
-		case B_BESSELCS:
-		case B_BESSELLE:
-		case B_BESSELLM:
-		case B_BESSELTEC:
-		case B_BESSELTMC:
+		case B_BESSELASD:
 			for (i=0;i<local_nvoid_Ndip;i++) {
 				j=3*i;
 				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
 				x=DotProd(r1,ex);
 				y=DotProd(r1,ey);
 				z=DotProd(r1,prop);
-				ro2=x*x+y*y;
-				ro=sqrt(ro2);	// radial distance in a cylindrical coordinate system
-				phi=atan2(y,x);	// angular coordinate in a cylindrical coordinate system
-				t1=WaveNum*sin(alpha0);
-				t2=WaveNum*cos(alpha0);
-				// common factor
-				ctemp=cpow(I,n0)*cexp(I*n0*phi)*cexp(I*t2*z)/WaveNum/WaveNum;
-				// t3,t4,t5 - x,y,z field components are described in the doc file "Bessel beam fields" (in the doc folder)
-				if (n0==0){
-					if (ro==0){
-						switch (beamtype) {
-							case B_BESSELCS:
-								t3=0.5*WaveNum*WaveNum*(cos(alpha0)-0.5*sin(alpha0)*sin(alpha0)+1.0);
-								t4=0.0;
-								t5=0.0;
-								break;
-							case B_BESSELLE:
-								t3=t2*WaveNum;
-								t4=0.0;
-								t5=0.0;
-								break;
-							case B_BESSELLM:
-								t3=0.0;
-								t4=-0.25*WaveNum*WaveNum*(3.0+cos(2*alpha0));
-								t5=0.0;
-								break;
-							case B_BESSELTEC:
-								t3=I*t2*t2/sin(alpha0);
-								t4=0.25*WaveNum*WaveNum*(3.0+cos(2*alpha0))/sin(alpha0);
-								t5=0.0;
-								break;
-							case B_BESSELTMC:
-								t3=WaveNum*WaveNum/tan(alpha0);
-								t4=0.25*I*WaveNum*WaveNum*(3.0+cos(2*alpha0))/tan(alpha0);
-								t5=0.0;
-								break;
-							default: break;
-						}
-					}
-					else{
-						arg=ro*WaveNum*sin(alpha0);
-						if (arg<ROUND_ERR){
-							jn2[0]=1.0;
-							jn2[1]=0.0;
-						}
-						else {
-							n1=n0+1;
-							bjndd_(&n1, &arg, jn1, td1, td2);
-							jn2[0]=jn1[n0];
-							jn2[1]=jn1[n0+1];
-						}
-						switch (beamtype) {
-							case B_BESSELCS:
-								t3= 0.5*(
-										jn2[1]*t1/ro*cos(2*phi) +
-										jn2[0]*pow(WaveNum,2)*(cos(alpha0)-
-											pow(sin(alpha0)*cos(phi),2)+1.0));
-								t4= 0.125*(
-										jn2[1]*4*t1/ro*sin(2*phi) +
-										jn2[0]*(pow(WaveNum,2)*(cos(2*alpha0)-1)*sin(2*phi)));
-								t5= -0.5*I*(WaveNum+t2)*
-										jn2[1]*t1*cos(phi);
-								break;
-							case B_BESSELLE:
-								t3= jn2[0]*t2*WaveNum;
-								t4= 0;
-								t5= -WaveNum*I*jn2[1]*t1*cos(phi);
-								break;
-							case B_BESSELLM:
-								t3= jn2[1]*t1/ro*(-sin(2*phi)) +
-									jn2[0]*0.25/ro2*((cpow(WaveNum*ro,2)*(1-cos(2*alpha0)))*sin(2*phi));
-								t4= 0.25*(
-										jn2[1]*4*t1/ro*cos(2*phi) -
-										jn2[0]*(cpow(WaveNum,2)*cos(2*phi)+
-												cpow(WaveNum,2)*(3+2*cos(2*alpha0)*pow(sin(phi),2))));
-								t5= t2*jn2[1]*I*t1*sin(phi);
-								break;
-							case B_BESSELTEC:
-								t3= 0.5/ro2*cexp(-2*I*phi)*(
-										jn2[1]*2*WaveNum*ro*cexp(2*I*phi)*sin(2*phi) +
-										jn2[0]*(cexp(2*I*phi)*cpow(WaveNum*ro,2)*(2.*I*cos(alpha0)/tan(alpha0) -
-												sin(alpha0)*sin(2*phi))));
-								t4= -1./ro2/4.*(
-										jn2[1]*4*WaveNum*ro*cos(2*phi) -
-										jn2[0]/sin(alpha0)*(cpow(WaveNum*ro,2)*(3 + 2*cos(2*alpha0)*pow(sin(phi),2))));
-								t5= 1./ro/tan(alpha0)*WaveNum*cexp(-I*phi)*(
-										jn2[1]*ro*t1);
-								break;
-							case B_BESSELTMC:
-								t3= 1./ro2*(
-										jn2[1]*t2*ro*I*sin(2*phi) +
-										jn2[0]*(-cpow(WaveNum*ro,2)*(1./tan(alpha0)+I/4.*sin(2*alpha0)*sin(2*phi))));
-								t4= -I/tan(alpha0)/ro2*(
-										jn2[1]*t1*ro*cos(2*phi) -
-										jn2[0]/4.*((cpow(WaveNum*ro,2))*cos(2*phi) +
-												cpow(WaveNum*ro,2)*(3 + 2*cos(2*alpha0)*pow(sin(phi),2))));
-								t5= -0.5*I*WaveNum*(
-										-jn2[1]*2*WaveNum*(cos(phi) - I*pow(cos(alpha0),2)*sin(phi)));
-								break;
-								default: break;
-						}
-					}
-				}
-				else if (n0==1){
-					if (ro==0){
-						t3=0.0; t4=0.0; t5=0.0;
-					}
-					else{
-						arg=ro*WaveNum*sin(alpha0);
-						if (arg<ROUND_ERR){
-							jn2[0]=0.0;
-							jn2[1]=0.0;
-						}
-						else {
-							n1=n0+1;
-							bjndd_(&n1, &arg, jn1, td1, td2);
-							jn2[0]=jn1[n0];
-							jn2[1]=jn1[n0+1];
-						}
-						switch (beamtype) {
-							case B_BESSELCS:
-								t3= 0.5*(
-										jn2[1]*t1/ro*(cos(2*phi)+I*n0*sin(2*phi)) +
-										jn2[0]*pow(WaveNum,2)*(cos(alpha0)-
-											pow(sin(alpha0)*cos(phi),2)+1.0));
-								t4= 0.125*(
-										jn2[1]*4*t1/ro*(-I*n0*cos(2*phi)+sin(2*phi)) +
-										jn2[0]*(pow(WaveNum,2)*(cos(2*alpha0)-1)*sin(2*phi)));
-								t5= -0.5*I*(WaveNum+t2)*cexp(-I*phi)*(
-										jn2[1]*cexp(I*phi)*t1*cos(phi) -
-										jn2[0]*n0/ro);
-								break;
-							case B_BESSELLE:
-								t3= jn2[0]*t2*WaveNum;
-								t4= 0;
-								t5= -WaveNum*I*(
-										jn2[1]*t1*cos(phi) -
-										jn2[0]*cexp(-I*phi)/ro*n0);
-								break;
-							case B_BESSELLM:
-								t3= jn2[1]*t1/ro*(I*n0*cos(2*phi)-sin(2*phi)) +
-									jn2[0]*0.25/ro2*((cpow(WaveNum*ro,2)*(1-cos(2*alpha0)))*sin(2*phi));
-								t4= 0.25*(
-										jn2[1]*4*t1/ro*(cos(2*phi)+I*n0*sin(2*phi)) -
-										jn2[0]*(cpow(WaveNum,2)*cos(2*phi)+
-												cpow(WaveNum,2)*(3+2*cos(2*alpha0)*pow(sin(phi),2))));
-								t5= t2*(
-										jn2[1]*I*t1*sin(phi) +
-										jn2[0]/ro*n0*cexp(-I*phi));
-								break;
-							case B_BESSELTEC:
-								t3= 0.5/ro2*cexp(-2*I*phi)*(
-										jn2[1]*2*WaveNum*ro*cexp(2*I*phi)*(-I*n0*cos(2*phi) + sin(2*phi)) +
-										jn2[0]*(cexp(2*I*phi)*cpow(WaveNum*ro,2)*(2.*I*cos(alpha0)/tan(alpha0) -
-												sin(alpha0)*sin(2*phi))));
-								t4= -1./ro2/4.*(
-										jn2[1]*4*WaveNum*ro*(cos(2*phi) + I*n0*sin(2*phi)) -
-										jn2[0]/sin(alpha0)*(cpow(WaveNum*ro,2)*(3 + 2*cos(2*alpha0)*pow(sin(phi),2))));
-								t5= 1./ro/tan(alpha0)*WaveNum*cexp(-I*phi)*(
-										jn2[1]*ro*t1 -
-										jn2[0]*2*n0);
-								break;
-							case B_BESSELTMC:
-								t3= 1./ro2*(
-										jn2[1]*t2*ro*(n0*cos(2*phi) + I*sin(2*phi)) +
-										jn2[0]*(-cpow(WaveNum*ro,2)*(1./tan(alpha0)+I/4.*sin(2*alpha0)*sin(2*phi))));
-								t4= -I/tan(alpha0)/ro2*(
-										jn2[1]*t1*ro*(cos(2*phi) + I*n0*sin(2*phi)) -
-										jn2[0]/4.*((cpow(WaveNum*ro,2))*cos(2*phi) +
-												cpow(WaveNum*ro,2)*(3 + 2*cos(2*alpha0)*pow(sin(phi),2))));
-								t5= -0.5*I*WaveNum*(
-										-jn2[1]*2*WaveNum*(cos(phi) - I*pow(cos(alpha0),2)*sin(phi)) +
-										 jn2[0]*n0*cexp(-I*phi)/ro*(3+cos(2*alpha0))/sin(alpha0));
-								break;
-								default: break;
-						}
-					}
-				}
-				else {
-					if (ro==0){
-						if (n0==2){
-							switch (beamtype) {
-								case B_BESSELCS:
-									t3=-0.125*I*t1*t1; t4=0.125*t1*t1; t5=0.0;
-									break;
-								case B_BESSELLE:
-									t3=0.0; t4=0.0; t5=0.0;
-									break;
-								case B_BESSELLM:
-									t3=-0.25*t1*t1; t4=0.25*I*t1*t1; t5=0.0;
-									break;
-								case B_BESSELTEC:
-									t3=0.25*t1*t1/sin(alpha0); t4=0.25*I*t1*t1/sin(alpha0); t5=0.0;
-									break;
-								case B_BESSELTMC:
-									t3=0.25*I*t1*t1/tan(alpha0); t4=-0.25*t1*t1/tan(alpha0); t5=0.0;
-									break;
-								default: break;
-							}
-						}
-						else {
-							t3=0.0; t4=0.0; t5=0.0;
-						}
-					}
-					else{
-						arg=ro*WaveNum*sin(alpha0);
-						if (arg<ROUND_ERR){
-							jn2[0]=0.0;
-							jn2[1]=0.0;
-						}
-						else {
-							n1=n0+1;
-							bjndd_(&n1, &arg, jn1, td1, td2);
-							jn2[0]=jn1[n0];
-							jn2[1]=jn1[n0+1];
-						}
-						switch (beamtype) {
-							case B_BESSELCS:
-								t3= 0.5*(
-										jn2[1]*t1/ro*(cos(2*phi)+I*n0*sin(2*phi)) +
-										jn2[0]*((n0-1)*n0*cexp(-2*I*phi)/ro2+pow(WaveNum,2)*(cos(alpha0)-
-											pow(sin(alpha0)*cos(phi),2)+1.0)));
-								t4= 0.125*(
-										jn2[1]*4*t1/ro*(-I*n0*cos(2*phi)+sin(2*phi)) +
-										jn2[0]*(4*I*(n0-1)*n0/ro2*cos(2*phi)+(4*(n0-1)*n0/ro2 +
-												pow(WaveNum,2)*(cos(2*alpha0)-1))*sin(2*phi)));
-								t5= -0.5*I*(WaveNum+t2)*(
-										jn2[1]*t1*cos(phi) -
-										jn2[0]*cexp(-I*phi)*n0/ro);
-								break;
-							case B_BESSELLE:
-								t3= jn2[0]*t2*WaveNum;
-								t4= 0;
-								t5= -WaveNum*I*(
-										jn2[1]*t1*cos(phi) -
-										jn2[0]*cexp(-I*phi)/ro*n0);
-								break;
-							case B_BESSELLM:
-								t3= jn2[1]*t1/ro*(I*n0*cos(2*phi)-sin(2*phi)) +
-									jn2[0]*0.25/ro2*(-4*I*(n0-1)*n0*cos(2*phi)+(-4*(n0-1)*n0 +
-										cpow(WaveNum*ro,2)*(1-cos(2*alpha0)))*sin(2*phi));
-								t4= 0.25*(
-										jn2[1]*4*t1/ro*(cos(2*phi)+I*n0*sin(2*phi)) -
-										jn2[0]*((-4*(n0-1)*n0/ro2 + cpow(WaveNum,2))*cos(2*phi) +
-												cpow(WaveNum,2)*(3+2*cos(2*alpha0)*pow(sin(phi),2)) +
-												4*I*(n0-1)*n0/ro2*sin(2*phi)));
-								t5= t2*(
-										jn2[1]*I*t1*sin(phi) +
-										jn2[0]/ro*n0*cexp(-I*phi));
-								break;
-							case B_BESSELTEC:
-								t3= 0.5/ro2*cexp(-2*I*phi)*(
-										jn2[1]*2*WaveNum*ro*cexp(2*I*phi)*(-I*n0*cos(2*phi) + sin(2*phi)) +
-										jn2[0]*(2.*I*(n0-1)*n0/sin(alpha0) +
-												cexp(2*I*phi)*cpow(WaveNum*ro,2)*(2.*I*cos(alpha0)/tan(alpha0) -
-												sin(alpha0)*sin(2*phi))));
-								t4= -1./ro2/4.*(
-										jn2[1]*4*WaveNum*ro*(cos(2*phi) + I*n0*sin(2*phi)) -
-										jn2[0]/sin(alpha0)*((-4*(n0-1)*n0+cpow(WaveNum*ro,2))*cos(2*phi) +
-												cpow(WaveNum*ro,2)*(3 + 2*cos(2*alpha0)*pow(sin(phi),2)) +
-												4*I*(n0-1)*n0*sin(2*phi)));
-								t5= 1./ro/tan(alpha0)*WaveNum*cexp(-I*phi)*(
-										jn2[1]*ro*t1 -
-										jn2[0]*2*n0);
-								break;
-							case B_BESSELTMC:
-								t3= 1./ro2*(
-										jn2[1]*t2*ro*(n0*cos(2*phi) + I*sin(2*phi)) +
-										jn2[0]*(-cexp(-2*I*phi)*(n0-1)*n0*1./tan(alpha0) -
-												cpow(WaveNum*ro,2)*(1./tan(alpha0)+I/4.*sin(2*alpha0)*sin(2*phi))));
-								t4= -I/tan(alpha0)/ro2*(
-										jn2[1]*t1*ro*(cos(2*phi) + I*n0*sin(2*phi)) -
-										jn2[0]/4.*((-4*(n0-1)*n0+cpow(WaveNum*ro,2))*cos(2*phi) +
-												cpow(WaveNum*ro,2)*(3 + 2*cos(2*alpha0)*pow(sin(phi),2)) +
-												4*I*(n0-1)*n0*sin(2*phi)));
-								t5= -0.5*I*WaveNum*(
-										-jn2[1]*2*WaveNum*(cos(phi) - I*pow(cos(alpha0),2)*sin(phi)) +
-										 jn2[0]*n0*cexp(-I*phi)/ro*(3+cos(2*alpha0))/sin(alpha0));
-								break;
-							default: break;
-						}
-					}
+				r=sqrt(x*x+y*y+z*z);	// radial distance in a spherical coordinate system
+				tht=atan2(sqrt(x*x+y*y),z);	// polar angle
+				phi=atan2(y,x);			// azimuthal angle
+
+				// Integration
+				N=1000;
+				db=2.*PI/N;
+
+				Fpw(fint,n0,WaveNum,r,tht,phi,alpha0,0);
+				sum[0] = fint[0];	sum[1] = fint[1];	sum[2] = fint[2];
+
+				for (it=1;it<N;it++) {
+					Fpw(fint,n0,WaveNum,r,tht,phi,alpha0,it*db);
+					sum[0] += fint[0];
+					sum[1] += fint[1];
+					sum[2] += fint[2];
 				}
+
+				t3=sum[0]/N;	t4=sum[1]/N;	t5=sum[2]/N;
+
+				///printf("\n i: %d \t %g\t %g\t %g\t %g\t %g\t %g",i,creal(t3),cimag(t3),creal(t4),cimag(t4),creal(t5),cimag(t5));
+
 				cvMultScal_RVec(t3,ex,v1);
 				cvMultScal_RVec(t4,ey,v2);
 				cvMultScal_RVec(t5,prop,v3);
 				cvAdd2Self(v1,v2,v3);
-				cvMultScal_cmplx(ctemp,v1,b+j);
+				cvMultScal_cmplx(1.,v1,b+j);
 			}
 			return;
-		*/
 		case B_BESSELCS:
 		case B_BESSELGEN:
 		case B_BESSELLE:
 		case B_BESSELLM:
 		case B_BESSELTEC:
 		case B_BESSELTMC:
+			t1=WaveNum*sin(alpha0);
+			t2=WaveNum*cos(alpha0);
+
 			for (i=0;i<local_nvoid_Ndip;i++) {
 				j=3*i;
 				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
@@ -802,14 +550,12 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				ro2=x*x+y*y;
 				ro=sqrt(ro2);	// radial distance in a cylindrical coordinate system
 				phi=atan2(y,x);	// angular coordinate in a cylindrical coordinate system
-				t1=WaveNum*sin(alpha0);
-				t2=WaveNum*cos(alpha0);
 				// common factor
 				ctemp=cpow(I,n0)*cexp(I*n0*phi)*cexp(I*t2*z)/WaveNum/WaveNum;
-
-				arg=ro*WaveNum*sin(alpha0);
+				arg=ro*t1;
 				if (arg<ROUND_ERR){
-					jn2[0]=0.0;
+					if (n0 == 0) jn2[0]=1.0;
+					else jn2[0]=0.0;
 					jn2[1]=0.0;
 				}
 				else {
@@ -820,7 +566,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				}
 				switch (beamtype) {
 					case B_BESSELCS:
-						p[0][0]=0.5; p[0][1]=0;		p[1][0]=0; p[1][1]=0;
+						p[0][0]=0.50; p[0][1]=0;		p[1][0]=0; p[1][1]=0;
 						p[2][0]=0; p[2][1]=0; 		p[3][0]=0.5; p[3][1]=0;
 						break;
 					case B_BESSELGEN:
@@ -846,47 +592,87 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 					default: break;
 				}
 				t3 = 0; t4 = 0; t5 = 0;
-				if ((fabs(p[0][0])>=ROUND_ERR) || (fabs(p[0][1])>=ROUND_ERR)) {		//Pex - LMy
-					t3 += (p[0][0]+I*p[0][1])*0.25*(
-							jn2[1]*4.*t1/ro*(cos(2*phi)+I*n0*sin(2*phi)) +
-							jn2[0]*(4.*(n0-1)*n0/ro2*cexp(-2*I*phi) +
-									cpow(WaveNum,2)*(3+cos(2*alpha0)-2*cos(2*phi)*pow(sin(alpha0),2))));
-					t4 += (p[0][0]+I*p[0][1])*(
-							jn2[1]*t1/ro*(-I*n0*cos(2*phi)+sin(2*phi)) +
-							jn2[0]/ro2*(I*(n0-1)*n0*pow(cos(phi),2)+0.5*sin(2*phi)*(2*(n0-1)*n0 -
-								cpow(WaveNum*ro,2)*pow(sin(alpha0),2)) - I*(n0-1)*n0*pow(sin(phi),2)));
-					t5 += (p[0][0]+I*p[0][1])*t2*I*(
-							-jn2[1]*t1*cos(phi) +
-							 jn2[0]/ro*n0*cexp(-I*phi));
-				}
-				if ((fabs(p[1][0])>=ROUND_ERR) || (fabs(p[1][1])>=ROUND_ERR)) {		//Pey - LMx
-					t3 += -(p[1][0]+I*p[1][1])*(
-							jn2[1]*t1/ro*(I*n0*cos(2*phi)-sin(2*phi)) +
-							jn2[0]/ro2*(-I*(n0-1)*n0*pow(cos(phi),2)+0.5*sin(2*phi)*(-2*(n0-1)*n0 +
-							cpow(WaveNum*ro,2)*pow(sin(alpha0),2)) + I*(n0-1)*n0*pow(sin(phi),2)));
-					t4 += -(p[1][0]+I*p[1][1])*(
-							jn2[1]*t1/ro*(cos(2*phi)+I*n0*sin(2*phi)) -
-							jn2[0]*(pow(cos(phi),2)*(-(n0-1)*n0/ro2 + cpow(WaveNum,2)) +
-								pow(sin(phi),2)*((n0-1)*n0/ro2 + cpow(WaveNum,2)*pow(cos(alpha0),2)) +
-								I*(n0-1)*n0/ro2*sin(2*phi)));
-					t5 += -(p[1][0]+I*p[1][1])*t2*(
-							jn2[1]*I*t1*sin(phi) +
-							jn2[0]/ro*n0*cexp(-I*phi));
-				}
-				if ((fabs(p[2][0])>=ROUND_ERR) || (fabs(p[2][1])>=ROUND_ERR)) { 	//Pmx - LEy
-					t3 += 0;
-					t4 += -(p[2][0]+I*p[2][1])*jn2[0]*t2*WaveNum;
-					t5 += -(p[2][0]+I*p[2][1])*WaveNum*(
-							-jn2[1]*I*t1*sin(phi) -
-							 jn2[0]*cexp(-I*phi)/ro*n0);
+				if (ro<=ROUND_ERR) {
+					if ((fabs(p[0][0])>=ROUND_ERR) || (fabs(p[0][1])>=ROUND_ERR)) {		//Pex - LMy
+						t3 += (p[0][0]+I*p[0][1])*0.25*(
+								jn2[0]*(cpow(WaveNum,2)*(3+cos(2*alpha0)-2*cos(2*phi)*pow(sin(alpha0),2))));
+						t4 += (p[0][0]+I*p[0][1])*(
+								jn2[0]/4.*(sin(2*phi)*(-2*cpow(WaveNum,2)*pow(sin(alpha0),2))));
+						t5 += (p[0][0]+I*p[0][1])*t2*I*(
+								 n0*cexp(-I*phi));
+					}
+					if ((fabs(p[1][0])>=ROUND_ERR) || (fabs(p[1][1])>=ROUND_ERR)) {		//Pey - LMx
+						t3 += -(p[1][0]+I*p[1][1])*(
+								jn2[0]*0.5*sin(2*phi)*cpow(WaveNum,2)*pow(sin(alpha0),2));
+						t4 += -(p[1][0]+I*p[1][1])*( -
+								jn2[0]*(pow(cos(phi),2)*(cpow(WaveNum,2)) +
+									pow(sin(phi),2)*cpow(WaveNum,2)*pow(cos(alpha0),2)));
+						t5 += -(p[1][0]+I*p[1][1])*t2*(
+								n0*cexp(-I*phi));
+					}
+					if ((fabs(p[2][0])>=ROUND_ERR) || (fabs(p[2][1])>=ROUND_ERR)) { 	//Pmx - LEy
+						t3 += 0;
+						t4 += -(p[2][0]+I*p[2][1])*jn2[0]*t2*WaveNum;
+						t5 += -(p[2][0]+I*p[2][1])*WaveNum*(
+								-jn2[1]*I*t1*sin(phi) -
+								n0*cexp(-I*phi));
+					}
+					if ((fabs(p[3][0])>=ROUND_ERR) || (fabs(p[3][1])>=ROUND_ERR)) {		//Pmy - LEx
+						t3 += (p[3][0]+I*p[3][1])*jn2[0]*t2*WaveNum;
+						t4 += 0;
+						t5 += (p[3][0]+I*p[3][1])*WaveNum*I*(
+								-jn2[1]*t1*cos(phi) +
+								n0*cexp(-I*phi));
+					}
 				}
-				if ((fabs(p[3][0])>=ROUND_ERR) || (fabs(p[3][1])>=ROUND_ERR)) {		//Pmy - LEx
-					t3 += (p[3][0]+I*p[3][1])*jn2[0]*t2*WaveNum;
-					t4 += 0;
-					t5 += (p[3][0]+I*p[3][1])*WaveNum*I*(
-							-jn2[1]*t1*cos(phi) +
-							 jn2[0]*cexp(-I*phi)/ro*n0);
+				else {
+					if ((fabs(p[0][0])>=ROUND_ERR) || (fabs(p[0][1])>=ROUND_ERR)) {		//Pex - LMy
+						t3 += (p[0][0]+I*p[0][1])*0.25*(
+								jn2[1]*4.*t1/ro*(cos(2*phi)+I*n0*sin(2*phi)) +
+								jn2[0]*(4.*(n0-1)*n0/ro2*cexp(-2*I*phi) +
+										cpow(WaveNum,2)*(3+cos(2*alpha0)-2*cos(2*phi)*pow(sin(alpha0),2))));
+						t4 += (p[0][0]+I*p[0][1])*(
+								jn2[1]*t1/ro*(-I*n0*cos(2*phi)+sin(2*phi)) +
+								jn2[0]/4./ro2*(4.*I*(n0-1)*n0*cos(2*phi) + sin(2*phi)*(4*(n0-1)*n0 -
+									2*cpow(WaveNum*ro,2)*pow(sin(alpha0),2))));
+						t5 += (p[0][0]+I*p[0][1])*t2*I*(
+								-jn2[1]*t1*cos(phi) +
+								 jn2[0]/ro*n0*cexp(-I*phi));
+					}
+					if ((fabs(p[1][0])>=ROUND_ERR) || (fabs(p[1][1])>=ROUND_ERR)) {		//Pey - LMx
+						t3 += -(p[1][0]+I*p[1][1])*(
+								jn2[1]*t1/ro*(I*n0*cos(2*phi)-sin(2*phi)) +
+								jn2[0]/ro2*(-I*(n0-1)*n0*pow(cos(phi),2)+0.5*sin(2*phi)*(-2*(n0-1)*n0 +
+								cpow(WaveNum*ro,2)*pow(sin(alpha0),2)) + I*(n0-1)*n0*pow(sin(phi),2)));
+						t4 += -(p[1][0]+I*p[1][1])*(
+								jn2[1]*t1/ro*(cos(2*phi)+I*n0*sin(2*phi)) -
+								jn2[0]*(pow(cos(phi),2)*(-(n0-1)*n0/ro2 + cpow(WaveNum,2)) +
+									pow(sin(phi),2)*((n0-1)*n0/ro2 + cpow(WaveNum,2)*pow(cos(alpha0),2)) +
+									I*(n0-1)*n0/ro2*sin(2*phi)));
+						t5 += -(p[1][0]+I*p[1][1])*t2*(
+								jn2[1]*I*t1*sin(phi) +
+								jn2[0]/ro*n0*cexp(-I*phi));
+					}
+					if ((fabs(p[2][0])>=ROUND_ERR) || (fabs(p[2][1])>=ROUND_ERR)) { 	//Pmx - LEy
+						t3 += 0;
+						t4 += -(p[2][0]+I*p[2][1])*jn2[0]*t2*WaveNum;
+						t5 += -(p[2][0]+I*p[2][1])*WaveNum*(
+								-jn2[1]*I*t1*sin(phi) -
+								 jn2[0]*cexp(-I*phi)/ro*n0);
+					}
+					if ((fabs(p[3][0])>=ROUND_ERR) || (fabs(p[3][1])>=ROUND_ERR)) {		//Pmy - LEx
+						t3 += (p[3][0]+I*p[3][1])*jn2[0]*t2*WaveNum;
+						t4 += 0;
+						t5 += (p[3][0]+I*p[3][1])*WaveNum*I*(
+								-jn2[1]*t1*cos(phi) +
+								 jn2[0]*cexp(-I*phi)/ro*n0);
+					}
 				}
+
+
+				///printf("\n i: %d \t %g\t %g\t %g\t %g\t %g\t %g",i,creal(t3),cimag(t3),creal(t4),cimag(t4),creal(t5),cimag(t5));
+
+
 				cvMultScal_RVec(t3,ex,v1);
 				cvMultScal_RVec(t4,ey,v2);
 				cvMultScal_RVec(t5,prop,v3);
diff --git a/src/Makefile b/src/Makefile
index f2b926bf..1a6531e7 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -187,7 +187,7 @@ FFTW3_LIB_PATH := "$(abspath ./../../fftw)"
 # C files are located in source folder (src/), other files may be added below
 CSOURCE := ADDAmain.c CalculateE.c calculator.c chebyshev.c comm.c crosssec.c GenerateB.c interaction.c io.c \
            iterative.c linalg.c make_particle.c memory.c  mt19937ar.c param.c Romberg.c sinint.c somnec.c \
-           timing.c vars.c 
+           timing.c vars.c
 # Fortran files are located in src/fort folder, other files may be added below
 FSOURCE := d07hre.f d09hre.f d113re.f d132re.f dadhre.f dchhre.f dcuhre.f dfshre.f dinhre.f drlhre.f dtrhre.f \
            propaesplibreintadda.f
diff --git a/src/const.h b/src/const.h
index 7b362da1..1d24eb87 100644
--- a/src/const.h
+++ b/src/const.h
@@ -278,6 +278,7 @@ enum incpol {
 
 enum beam { // beam types
 	B_BARTON5, // 5th order description of the Gaussian beam
+	B_BESSELASD, // Bessel beam (Angular spectrum decomposition)
 	B_BESSELCS, // Bessel beam with circularly symmetric energy density
 	B_BESSELGEN, // Generalized Bessel beam
 	B_BESSELLE, // Bessel beam with linearly polarized electric field
diff --git a/src/mpi/Makefile b/src/mpi/Makefile
deleted file mode 100644
index ab563e94..00000000
--- a/src/mpi/Makefile
+++ /dev/null
@@ -1,70 +0,0 @@
-# Makefile for MPI version of ADDA package
-# Most options are defined in Makefile
-# $Date::                            $
-#
-# Copyright (C) 2006-2014 ADDA contributors
-# This file is part of ADDA.
-#
-# ADDA is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as
-# published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
-#
-# ADDA is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
-# of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License along with ADDA. If not, see
-# <http://www.gnu.org/licenses/>.
-
-#=======================================================================================================================
-# !!! Start of control section. Flags and options here are designed to be modified by user to choose particular options
-# for compilation. However, the default set of options may work out-of-box on some systems.
-#=======================================================================================================================
-
-# Heurestics to determine if MPI wrapper is available. If $(MPICC) is defined it is used as is. Otherwise we try to
-# locate 'mpicc' wrapper through system call, and reverse to $(CC) as the last resort. This should work fine in many
-# cases, but can be replaced by a simple assignment of MPICC.
-ifndef MPICC
-  ifeq ($(shell which mpicc > /dev/null 2>&1 && echo 0),0)
-    MPICC := mpicc
-  else
-    MPICC := $(CC)
-  endif
-endif
-
-# Compiler dependent options
-# These are options for a particular Alpha system
-ifeq ($(COMPILER),compaq)
-  MPICC := cc
-  LDLIBS += -lmpi -lelan
-endif
-
-# If the compiler is used directly, a few additional options are needed
-ifeq ($(MPICC),$(CC))
-  # Depending on a particular MPI installation one may need to manually specify paths to MPI headers and libraries.
-  # Path should be absolute or relative to the location of this Makefile.
-  CFLAGS += -I'$(MSMPI_INC)'
-  LDFLAGS += -L'$(MSMPI_LIB64)'
-
-  LDLIBS += -lmsmpi
-# If MPI compiler wrapper is used, environmental variables are set to define C compiler and linker
-else
-  # for MPICH
-  export MPICH_CC = $(CC)
-  export MPICH_CLINKER = $(CC)
-  # for OpenMPI
-  export OMPI_CC = $(CC)
-endif
-
-#=======================================================================================================================
-# !!! End of control section. Everything below is not designed to be modified by user
-#=======================================================================================================================
-
-# Finalize flags
-CFLAGS  += -DADDA_MPI
-CSOURCE += matvec.c
-
-PROG   := $(PROGMPI)
-MYCC   := $(MPICC)
-MYCF   := $(CF)
-MYCCPP := $(CCPP)
-
-include $(COMMONMK)
diff --git a/src/param.c b/src/param.c
index e9ef60cb..38313538 100644
--- a/src/param.c
+++ b/src/param.c
@@ -222,6 +222,10 @@ static const struct subopt_struct beam_opt[]={
 		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
 		"(zero, by default). All arguments are in um. This is recommended option for simulation of the Gaussian beam.",
 		UNDEF,B_BARTON5},
+	{"besselASD","<order> <angle> [<x> <y> <z>]","Bessel beam (Angular spectrum decomposition). The half-cone angle "
+		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
+		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
+		UNDEF,B_BESSELASD},
 	{"besselCS","<order> <angle> [<x> <y> <z>]","Bessel beam with circularly symmetric energy density. The half-cone angle "
 		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
 		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
@@ -1006,6 +1010,7 @@ PARSE_FUNC(beam)
 			case B_LMINUS:
 			case B_DAVIS3:
 			case B_BARTON5: if (Narg!=1 && Narg!=4) NargError(Narg,"1 or 4"); break;
+			case B_BESSELASD: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
 			case B_BESSELCS: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
 			case B_BESSELGEN: if (Narg!=10 && Narg!=13) NargError(Narg,"10 or 13"); break;
 			case B_BESSELLE: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
diff --git a/src/updgithash.sh b/src/updgithash.sh
deleted file mode 100644
index 1e2cb759..00000000
--- a/src/updgithash.sh
+++ /dev/null
@@ -1,32 +0,0 @@
-#!bin/sh
-# Since the script is run by 'sh ...' from the Makefile to be compatible with both Unix and Windows (MinGW), we
-# define its shebang also as 'sh', which means that it is supposed to be compatible with any posix-compliant shell
-# like dash on Ubuntu.
-# Tests subversion revision number of current directory (where script is located) and stores it as a C macro, like
-# #define GITHASH "1234"
-# in a special file (see variables below). Outputs obtained revision number to stdout. 
-# If revision number can't be obtained, the file is emptied (or created empty if doesn't exist).
-# File update happens only if it will change the content of the file to avoid redundant rebuilds.
-
-file=githash.h
-macro=GITHASH
-
-# if git log is not available, the following should silently produce ""
-# git log should produce either text (like "Unversioned directory") or hash string (f09cb11a0d36f94fbe6f78b92ef3f294d0049613)
-HASH=`git log --pretty=format:'%h' -n 1`
-if [ "$HASH" != "" ]; then
-  line="#define $macro \"$HASH\""
-  if [ -s $file ]; then
-    if [ "$(cat $file)" != "$line" ]; then
-      echo "$line" > $file
-    fi
-  else
-    echo "$line" > $file
-  fi
-  echo $HASH
-else
-  # produces empty file, but only if it is not already empty (and existent)
-  if [ \( ! -f $file \) -o \( -s $file \) ]; then
-    > $file
-  fi
-fi

From 7dffe17ab42773c8a5c9a2c9cc55e82756cb33e3 Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Wed, 23 Dec 2020 18:21:47 +0700
Subject: [PATCH 08/46] fixing Makefiles

---
 src/.cproject    | 16 +++++++++++
 src/Makefile     |  4 +--
 src/mpi/Makefile | 70 ++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 88 insertions(+), 2 deletions(-)
 create mode 100644 src/mpi/Makefile

diff --git a/src/.cproject b/src/.cproject
index e6f78a6f..f6d49861 100644
--- a/src/.cproject
+++ b/src/.cproject
@@ -126,6 +126,22 @@
                 <runAllBuilders>true</runAllBuilders>
                 			
             </target>
+            			
+            <target name="mpi" path="" targetID="org.eclipse.cdt.build.MakeTargetBuilder">
+                				
+                <buildCommand>make</buildCommand>
+                				
+                <buildArguments/>
+                				
+                <buildTarget>mpi</buildTarget>
+                				
+                <stopOnError>true</stopOnError>
+                				
+                <useDefaultCommand>true</useDefaultCommand>
+                				
+                <runAllBuilders>true</runAllBuilders>
+                			
+            </target>
             		
         </buildTargets>
         	
diff --git a/src/Makefile b/src/Makefile
index 1a6531e7..05a5ad89 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -174,8 +174,8 @@ override EXTRA_FLAGS +=
 #FFTW3_LIB_PATH := $(FFTWLIB)
 #FFTW3_INC_PATH := $(HOME)/include
 #FFTW3_LIB_PATH := $(HOME)/lib
-FFTW3_INC_PATH := "$(abspath ./../../fftw)"
-FFTW3_LIB_PATH := "$(abspath ./../../fftw)"
+FFTW3_INC_PATH := "C:/fftw"
+FFTW3_LIB_PATH := "C:/fftw"
 
 #=======================================================================================================================
 # !!! End of control section. Everything below is not designed to be modified by user. However, advanced users may wish
diff --git a/src/mpi/Makefile b/src/mpi/Makefile
new file mode 100644
index 00000000..ab563e94
--- /dev/null
+++ b/src/mpi/Makefile
@@ -0,0 +1,70 @@
+# Makefile for MPI version of ADDA package
+# Most options are defined in Makefile
+# $Date::                            $
+#
+# Copyright (C) 2006-2014 ADDA contributors
+# This file is part of ADDA.
+#
+# ADDA is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as
+# published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
+#
+# ADDA is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+# of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with ADDA. If not, see
+# <http://www.gnu.org/licenses/>.
+
+#=======================================================================================================================
+# !!! Start of control section. Flags and options here are designed to be modified by user to choose particular options
+# for compilation. However, the default set of options may work out-of-box on some systems.
+#=======================================================================================================================
+
+# Heurestics to determine if MPI wrapper is available. If $(MPICC) is defined it is used as is. Otherwise we try to
+# locate 'mpicc' wrapper through system call, and reverse to $(CC) as the last resort. This should work fine in many
+# cases, but can be replaced by a simple assignment of MPICC.
+ifndef MPICC
+  ifeq ($(shell which mpicc > /dev/null 2>&1 && echo 0),0)
+    MPICC := mpicc
+  else
+    MPICC := $(CC)
+  endif
+endif
+
+# Compiler dependent options
+# These are options for a particular Alpha system
+ifeq ($(COMPILER),compaq)
+  MPICC := cc
+  LDLIBS += -lmpi -lelan
+endif
+
+# If the compiler is used directly, a few additional options are needed
+ifeq ($(MPICC),$(CC))
+  # Depending on a particular MPI installation one may need to manually specify paths to MPI headers and libraries.
+  # Path should be absolute or relative to the location of this Makefile.
+  CFLAGS += -I'$(MSMPI_INC)'
+  LDFLAGS += -L'$(MSMPI_LIB64)'
+
+  LDLIBS += -lmsmpi
+# If MPI compiler wrapper is used, environmental variables are set to define C compiler and linker
+else
+  # for MPICH
+  export MPICH_CC = $(CC)
+  export MPICH_CLINKER = $(CC)
+  # for OpenMPI
+  export OMPI_CC = $(CC)
+endif
+
+#=======================================================================================================================
+# !!! End of control section. Everything below is not designed to be modified by user
+#=======================================================================================================================
+
+# Finalize flags
+CFLAGS  += -DADDA_MPI
+CSOURCE += matvec.c
+
+PROG   := $(PROGMPI)
+MYCC   := $(MPICC)
+MYCF   := $(CF)
+MYCCPP := $(CCPP)
+
+include $(COMMONMK)

From 15d3f60210885f9520f7ba20959fd07d6c209472 Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Wed, 23 Dec 2020 18:43:50 +0700
Subject: [PATCH 09/46] merging from upstream

---
 src/.settings/language.settings.xml | 2 +-
 src/githash.h                       | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/.settings/language.settings.xml b/src/.settings/language.settings.xml
index b4d2bd76..7a8dd2ac 100644
--- a/src/.settings/language.settings.xml
+++ b/src/.settings/language.settings.xml
@@ -11,7 +11,7 @@
             			
             <provider class="org.eclipse.cdt.managedbuilder.language.settings.providers.GCCBuildCommandParser" id="org.eclipse.cdt.managedbuilder.core.GCCBuildCommandParser" keep-relative-paths="false" name="CDT GCC Build Output Parser" parameter="(g?cc)|([gc]\+\+)|(clang)" prefer-non-shared="true"/>
             			
-            <provider class="org.eclipse.cdt.managedbuilder.internal.language.settings.providers.GCCBuiltinSpecsDetectorMinGW" console="false" env-hash="-1655415211902458007" id="org.eclipse.cdt.managedbuilder.core.GCCBuiltinSpecsDetectorMinGW" keep-relative-paths="false" name="CDT GCC Built-in Compiler Settings MinGW" parameter="${COMMAND} ${FLAGS} -E -P -v -dD &quot;${INPUTS}&quot;" prefer-non-shared="true">
+            <provider class="org.eclipse.cdt.managedbuilder.internal.language.settings.providers.GCCBuiltinSpecsDetectorMinGW" console="false" env-hash="-1157191489300509973" id="org.eclipse.cdt.managedbuilder.core.GCCBuiltinSpecsDetectorMinGW" keep-relative-paths="false" name="CDT GCC Built-in Compiler Settings MinGW" parameter="${COMMAND} ${FLAGS} -E -P -v -dD &quot;${INPUTS}&quot;" prefer-non-shared="true">
                 				
                 <language-scope id="org.eclipse.cdt.core.gcc"/>
                 				
diff --git a/src/githash.h b/src/githash.h
index ee42eee7..364f032a 100644
--- a/src/githash.h
+++ b/src/githash.h
@@ -1 +1 @@
-#define GITHASH "005ead3"
+#define GITHASH "7dffe17"

From bb4f787f627bec1f1b0064b3cf93a4b45d363a2d Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Thu, 24 Dec 2020 13:15:06 +0700
Subject: [PATCH 10/46] Removed ASD code

---
 src/.settings/language.settings.xml |  2 +-
 src/GenerateB.c                     | 44 -----------------------------
 src/const.h                         |  1 -
 src/githash.h                       |  2 +-
 src/param.c                         |  5 ----
 5 files changed, 2 insertions(+), 52 deletions(-)

diff --git a/src/.settings/language.settings.xml b/src/.settings/language.settings.xml
index 7a8dd2ac..b4d2bd76 100644
--- a/src/.settings/language.settings.xml
+++ b/src/.settings/language.settings.xml
@@ -11,7 +11,7 @@
             			
             <provider class="org.eclipse.cdt.managedbuilder.language.settings.providers.GCCBuildCommandParser" id="org.eclipse.cdt.managedbuilder.core.GCCBuildCommandParser" keep-relative-paths="false" name="CDT GCC Build Output Parser" parameter="(g?cc)|([gc]\+\+)|(clang)" prefer-non-shared="true"/>
             			
-            <provider class="org.eclipse.cdt.managedbuilder.internal.language.settings.providers.GCCBuiltinSpecsDetectorMinGW" console="false" env-hash="-1157191489300509973" id="org.eclipse.cdt.managedbuilder.core.GCCBuiltinSpecsDetectorMinGW" keep-relative-paths="false" name="CDT GCC Built-in Compiler Settings MinGW" parameter="${COMMAND} ${FLAGS} -E -P -v -dD &quot;${INPUTS}&quot;" prefer-non-shared="true">
+            <provider class="org.eclipse.cdt.managedbuilder.internal.language.settings.providers.GCCBuiltinSpecsDetectorMinGW" console="false" env-hash="-1655415211902458007" id="org.eclipse.cdt.managedbuilder.core.GCCBuiltinSpecsDetectorMinGW" keep-relative-paths="false" name="CDT GCC Built-in Compiler Settings MinGW" parameter="${COMMAND} ${FLAGS} -E -P -v -dD &quot;${INPUTS}&quot;" prefer-non-shared="true">
                 				
                 <language-scope id="org.eclipse.cdt.core.gcc"/>
                 				
diff --git a/src/GenerateB.c b/src/GenerateB.c
index e0d00aa6..9e0c2178 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -191,7 +191,6 @@ void InitBeam(void)
 				                       "\tCenter position: "GFORMDEF3V,tmp_str,w0,s,COMP3V(beam_center_0));
 			}
 			return;
-		case B_BESSELASD:
 		case B_BESSELCS:
 		case B_BESSELGEN:
 		case B_BESSELLE:
@@ -217,8 +216,6 @@ void InitBeam(void)
 			if (IFROOT) {
 				strcpy(beam_descr,"Bessel beam (");
 				switch (beamtype) {
-					case B_BESSELASD:
-						strcat(beam_descr,"angular spectrum decomposition)\n");
 						break;
 					case B_BESSELCS:
 						strcat(beam_descr,"circularly symmetric energy density)\n");
@@ -507,42 +504,6 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				}
 			}
 			return;
-		case B_BESSELASD:
-			for (i=0;i<local_nvoid_Ndip;i++) {
-				j=3*i;
-				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
-				x=DotProd(r1,ex);
-				y=DotProd(r1,ey);
-				z=DotProd(r1,prop);
-				r=sqrt(x*x+y*y+z*z);	// radial distance in a spherical coordinate system
-				tht=atan2(sqrt(x*x+y*y),z);	// polar angle
-				phi=atan2(y,x);			// azimuthal angle
-
-				// Integration
-				N=1000;
-				db=2.*PI/N;
-
-				Fpw(fint,n0,WaveNum,r,tht,phi,alpha0,0);
-				sum[0] = fint[0];	sum[1] = fint[1];	sum[2] = fint[2];
-
-				for (it=1;it<N;it++) {
-					Fpw(fint,n0,WaveNum,r,tht,phi,alpha0,it*db);
-					sum[0] += fint[0];
-					sum[1] += fint[1];
-					sum[2] += fint[2];
-				}
-
-				t3=sum[0]/N;	t4=sum[1]/N;	t5=sum[2]/N;
-
-				///printf("\n i: %d \t %g\t %g\t %g\t %g\t %g\t %g",i,creal(t3),cimag(t3),creal(t4),cimag(t4),creal(t5),cimag(t5));
-
-				cvMultScal_RVec(t3,ex,v1);
-				cvMultScal_RVec(t4,ey,v2);
-				cvMultScal_RVec(t5,prop,v3);
-				cvAdd2Self(v1,v2,v3);
-				cvMultScal_cmplx(1.,v1,b+j);
-			}
-			return;
 		case B_BESSELCS:
 		case B_BESSELGEN:
 		case B_BESSELLE:
@@ -679,11 +640,6 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 								 jn2[0]*cexp(-I*phi)/ro*n0);
 					}
 				}
-
-
-				///printf("\n i: %d \t %g\t %g\t %g\t %g\t %g\t %g",i,creal(t3),cimag(t3),creal(t4),cimag(t4),creal(t5),cimag(t5));
-
-
 				cvMultScal_RVec(t3,ex,v1);
 				cvMultScal_RVec(t4,ey,v2);
 				cvMultScal_RVec(t5,prop,v3);
diff --git a/src/const.h b/src/const.h
index c0c3db3c..9ae5163f 100644
--- a/src/const.h
+++ b/src/const.h
@@ -285,7 +285,6 @@ enum incpol {
 
 enum beam { // beam types
 	B_BARTON5, // 5th order description of the Gaussian beam
-	B_BESSELASD, // Bessel beam (Angular spectrum decomposition)
 	B_BESSELCS, // Bessel beam with circularly symmetric energy density
 	B_BESSELGEN, // Generalized Bessel beam
 	B_BESSELLE, // Bessel beam with linearly polarized electric field
diff --git a/src/githash.h b/src/githash.h
index 364f032a..1ed048bc 100644
--- a/src/githash.h
+++ b/src/githash.h
@@ -1 +1 @@
-#define GITHASH "7dffe17"
+#define GITHASH "15d3f60"
diff --git a/src/param.c b/src/param.c
index b07ab6e6..220c5aa6 100644
--- a/src/param.c
+++ b/src/param.c
@@ -230,10 +230,6 @@ static const struct subopt_struct beam_opt[]={
 		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
 		"(zero, by default). All arguments are in um. This is recommended option for simulation of the Gaussian beam.",
 		UNDEF,B_BARTON5},
-	{"besselASD","<order> <angle> [<x> <y> <z>]","Bessel beam (Angular spectrum decomposition). The half-cone angle "
-		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
-		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
-		UNDEF,B_BESSELASD},
 	{"besselCS","<order> <angle> [<x> <y> <z>]","Bessel beam with circularly symmetric energy density. The half-cone angle "
 		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
 		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
@@ -1028,7 +1024,6 @@ PARSE_FUNC(beam)
 			case B_LMINUS:
 			case B_DAVIS3:
 			case B_BARTON5: if (Narg!=1 && Narg!=4) NargError(Narg,"1 or 4"); break;
-			case B_BESSELASD: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
 			case B_BESSELCS: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
 			case B_BESSELGEN: if (Narg!=10 && Narg!=13) NargError(Narg,"10 or 13"); break;
 			case B_BESSELLE: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;

From 597fd7f9f1d02711713107e538df6825072d3fee Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Wed, 24 Mar 2021 17:44:43 +0700
Subject: [PATCH 11/46] Fixed beam description

---
 src/.settings/language.settings.xml | 37 ++++++++++-------------------
 src/GenerateB.c                     | 30 +++++++++++------------
 src/githash.h                       |  2 +-
 3 files changed, 28 insertions(+), 41 deletions(-)

diff --git a/src/.settings/language.settings.xml b/src/.settings/language.settings.xml
index b4d2bd76..a463dc28 100644
--- a/src/.settings/language.settings.xml
+++ b/src/.settings/language.settings.xml
@@ -1,28 +1,15 @@
 <?xml version="1.0" encoding="UTF-8" standalone="no"?>
 <project>
-    	
-    <configuration id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582" name="Default">
-        		
-        <extension point="org.eclipse.cdt.core.LanguageSettingsProvider">
-            			
-            <provider copy-of="extension" id="org.eclipse.cdt.ui.UserLanguageSettingsProvider"/>
-            			
-            <provider-reference id="org.eclipse.cdt.core.ReferencedProjectsLanguageSettingsProvider" ref="shared-provider"/>
-            			
-            <provider class="org.eclipse.cdt.managedbuilder.language.settings.providers.GCCBuildCommandParser" id="org.eclipse.cdt.managedbuilder.core.GCCBuildCommandParser" keep-relative-paths="false" name="CDT GCC Build Output Parser" parameter="(g?cc)|([gc]\+\+)|(clang)" prefer-non-shared="true"/>
-            			
-            <provider class="org.eclipse.cdt.managedbuilder.internal.language.settings.providers.GCCBuiltinSpecsDetectorMinGW" console="false" env-hash="-1655415211902458007" id="org.eclipse.cdt.managedbuilder.core.GCCBuiltinSpecsDetectorMinGW" keep-relative-paths="false" name="CDT GCC Built-in Compiler Settings MinGW" parameter="${COMMAND} ${FLAGS} -E -P -v -dD &quot;${INPUTS}&quot;" prefer-non-shared="true">
-                				
-                <language-scope id="org.eclipse.cdt.core.gcc"/>
-                				
-                <language-scope id="org.eclipse.cdt.core.g++"/>
-                			
-            </provider>
-            			
-            <provider-reference id="org.eclipse.cdt.managedbuilder.core.MBSLanguageSettingsProvider" ref="shared-provider"/>
-            		
-        </extension>
-        	
-    </configuration>
-    
+	<configuration id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582" name="Default">
+		<extension point="org.eclipse.cdt.core.LanguageSettingsProvider">
+			<provider copy-of="extension" id="org.eclipse.cdt.ui.UserLanguageSettingsProvider"/>
+			<provider-reference id="org.eclipse.cdt.core.ReferencedProjectsLanguageSettingsProvider" ref="shared-provider"/>
+			<provider class="org.eclipse.cdt.managedbuilder.language.settings.providers.GCCBuildCommandParser" id="org.eclipse.cdt.managedbuilder.core.GCCBuildCommandParser" keep-relative-paths="false" name="CDT GCC Build Output Parser" parameter="(g?cc)|([gc]\+\+)|(clang)" prefer-non-shared="true"/>
+			<provider class="org.eclipse.cdt.managedbuilder.internal.language.settings.providers.GCCBuiltinSpecsDetectorMinGW" console="false" env-hash="1736031386934720504" id="org.eclipse.cdt.managedbuilder.core.GCCBuiltinSpecsDetectorMinGW" keep-relative-paths="false" name="CDT GCC Built-in Compiler Settings MinGW" parameter="${COMMAND} ${FLAGS} -E -P -v -dD &quot;${INPUTS}&quot;" prefer-non-shared="true">
+				<language-scope id="org.eclipse.cdt.core.gcc"/>
+				<language-scope id="org.eclipse.cdt.core.g++"/>
+			</provider>
+			<provider-reference id="org.eclipse.cdt.managedbuilder.core.MBSLanguageSettingsProvider" ref="shared-provider"/>
+		</extension>
+	</configuration>
 </project>
diff --git a/src/GenerateB.c b/src/GenerateB.c
index 9e0c2178..b4248e72 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -213,32 +213,32 @@ void InitBeam(void)
 			beam_asym=(beam_Npars==(5 + n_par) && (beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0));
 			symR=symX=symY=symZ=FALSE;
 			if (!beam_asym) vInit(beam_center);
+			// beam info
 			if (IFROOT) {
-				strcpy(beam_descr,"Bessel beam (");
 				switch (beamtype) {
-						break;
 					case B_BESSELCS:
-						strcat(beam_descr,"circularly symmetric energy density)\n");
+						tmp_str="circularly symmetric energy density)\n";
 						break;
 					case B_BESSELGEN:
-						strcat(beam_descr,"generalized)\n");
+						tmp_str="generalized)\n";
 						break;
 					case B_BESSELLE:
-						strcat(beam_descr,"linear electric field)\n");
+						tmp_str="linear electric field)\n";
 						break;
 					case B_BESSELLM:
-						strcat(beam_descr,"linear magnetic field)\n");
+						tmp_str="linear magnetic field)\n";
 						break;
 					case B_BESSELTEC:
-						strcat(beam_descr,"forming the TE Bessel beam)\n");
+						tmp_str="forming the TE Bessel beam)\n";
 						break;
 					case B_BESSELTMC:
-						strcat(beam_descr,"forming the TM Bessel beam)\n");
+						tmp_str="forming the TM Bessel beam)\n";
 						break;
-					default: break;
+					default: LogError(ONE_POS,"Incompatibility error in GenerateB");
 				}
-				sprintf(beam_descr+strlen(beam_descr),"\tOrder=""%d""\n\t""Half-cone angle: "GFORMDEF"\n"
-				                                      "\tCenter position: "GFORMDEF3V,n0,alpha0,COMP3V(beam_center_0));
+				beam_descr=dyn_sprintf("Bessel beam (%s)\n"
+									   "\tOrder=""%d""\n\t""Half-cone angle: "GFORMDEF"\n"
+									   "\tCenter position: "GFORMDEF3V,tmp_str,n0,alpha0,COMP3V(beam_center_0));
 			}
 			return;
 		case B_READ:
@@ -293,15 +293,15 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 {
 	size_t i,j;
 	doublecomplex psi0,Q,Q2;
-	doublecomplex v1[3],v2[3],v3[3],gt[6],fint[3],sum[3];
-	double ro,ro2,ro4,r;
-	double x,y,z,x2_s,xy_s,tht,phi,arg,td1[n0+2],td2[n0+2],jn1[n0+2],p[4][2],db;
+	doublecomplex v1[3],v2[3],v3[3],gt[6];
+	double ro,ro2,ro4;
+	double x,y,z,x2_s,xy_s,phi,arg,td1[n0+2],td2[n0+2],jn1[n0+2],p[4][2];
 	doublecomplex t1,t2,t3,t4,t5,t6,t7,t8,ctemp;
 	const double *ex; // coordinate axis of the beam reference frame
 	double ey[3];
 	double r1[3];
 	double jn2[2]; // for Bessel functions on n and n+1 orders
-	int n1,it,N;
+	int n1;
 	const char *fname;
 	/* TO ADD NEW BEAM
 	 * Add here all intermediate variables, which are used only inside this function. You may as well use 't1'-'t8'
diff --git a/src/githash.h b/src/githash.h
index 1ed048bc..dc8f4e57 100644
--- a/src/githash.h
+++ b/src/githash.h
@@ -1 +1 @@
-#define GITHASH "15d3f60"
+#define GITHASH "bb4f787"

From 3fcc7c635f68209a6a4ba645e45f8dbfa168b0ee Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Wed, 7 Apr 2021 23:31:54 +0700
Subject: [PATCH 12/46] Fixed besselGen initialization

---
 .gitignore                          |   4 +
 src/.cproject                       | 263 ++++++++++++----------------
 src/.settings/language.settings.xml |  12 ++
 src/GenerateB.c                     |  18 +-
 src/githash.h                       |   2 +-
 5 files changed, 142 insertions(+), 157 deletions(-)

diff --git a/.gitignore b/.gitignore
index fd1a556e..e9209659 100644
--- a/.gitignore
+++ b/.gitignore
@@ -16,3 +16,7 @@
 /*/*.clstr
 
 
+src/githash.h
+src/.cproject
+src/.settings/language.settings.xml
+src/.cproject
diff --git a/src/.cproject b/src/.cproject
index f6d49861..f06ffd45 100644
--- a/src/.cproject
+++ b/src/.cproject
@@ -1,150 +1,119 @@
 <?xml version="1.0" encoding="UTF-8" standalone="no"?>
 <?fileVersion 4.0.0?><cproject storage_type_id="org.eclipse.cdt.core.XmlProjectDescriptionStorage">
-    	
-    <storageModule moduleId="org.eclipse.cdt.core.settings">
-        		
-        <cconfiguration id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582">
-            			
-            <storageModule buildSystemId="org.eclipse.cdt.managedbuilder.core.configurationDataProvider" id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582" moduleId="org.eclipse.cdt.core.settings" name="Default">
-                				
-                <externalSettings/>
-                				
-                <extensions>
-                    					
-                    <extension id="org.eclipse.cdt.core.PE" point="org.eclipse.cdt.core.BinaryParser"/>
-                    					
-                    <extension id="org.eclipse.cdt.core.GASErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-                    					
-                    <extension id="org.eclipse.cdt.core.GLDErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-                    					
-                    <extension id="org.eclipse.cdt.core.GCCErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-                    					
-                    <extension id="org.eclipse.cdt.core.GmakeErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-                    					
-                    <extension id="org.eclipse.cdt.core.CWDLocator" point="org.eclipse.cdt.core.ErrorParser"/>
-                    				
-                </extensions>
-                			
-            </storageModule>
-            			
-            <storageModule moduleId="cdtBuildSystem" version="4.0.0">
-                				
-                <configuration buildProperties="" description="" id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582" name="Default" optionalBuildProperties="" parent="org.eclipse.cdt.build.core.emptycfg">
-                    					
-                    <folderInfo id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582.1127462783" name="/" resourcePath="">
-                        						
-                        <toolChain id="cdt.managedbuild.toolchain.gnu.mingw.base.1035458335" name="MinGW GCC" superClass="cdt.managedbuild.toolchain.gnu.mingw.base">
-                            							
-                            <targetPlatform archList="all" binaryParser="org.eclipse.cdt.core.PE" id="cdt.managedbuild.target.gnu.platform.mingw.base.1085348987" name="Debug Platform" osList="win32" superClass="cdt.managedbuild.target.gnu.platform.mingw.base"/>
-                            							
-                            <builder id="cdt.managedbuild.builder.gnu.cross.1398979264" managedBuildOn="false" superClass="cdt.managedbuild.builder.gnu.cross"/>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.assembler.mingw.base.1518750006" name="GCC Assembler" superClass="cdt.managedbuild.tool.gnu.assembler.mingw.base">
-                                								
-                                <inputType id="cdt.managedbuild.tool.gnu.assembler.input.1540650047" superClass="cdt.managedbuild.tool.gnu.assembler.input"/>
-                                							
-                            </tool>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.archiver.mingw.base.909230791" name="GCC Archiver" superClass="cdt.managedbuild.tool.gnu.archiver.mingw.base"/>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base.462309889" name="GCC C++ Compiler" superClass="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base"/>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.c.compiler.mingw.base.1803672067" name="GCC C Compiler" superClass="cdt.managedbuild.tool.gnu.c.compiler.mingw.base">
-                                								
-                                <inputType id="cdt.managedbuild.tool.gnu.c.compiler.input.1946895431" superClass="cdt.managedbuild.tool.gnu.c.compiler.input"/>
-                                							
-                            </tool>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.c.linker.mingw.base.1010477471" name="MinGW C Linker" superClass="cdt.managedbuild.tool.gnu.c.linker.mingw.base">
-                                								
-                                <inputType id="cdt.managedbuild.tool.gnu.c.linker.input.1282503363" superClass="cdt.managedbuild.tool.gnu.c.linker.input">
-                                    									
-                                    <additionalInput kind="additionalinputdependency" paths="$(USER_OBJS)"/>
-                                    									
-                                    <additionalInput kind="additionalinput" paths="$(LIBS)"/>
-                                    								
-                                </inputType>
-                                							
-                            </tool>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base.625915771" name="MinGW C++ Linker" superClass="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base"/>
-                            						
-                        </toolChain>
-                        					
-                    </folderInfo>
-                    				
-                </configuration>
-                			
-            </storageModule>
-            			
-            <storageModule moduleId="org.eclipse.cdt.core.externalSettings"/>
-            		
-        </cconfiguration>
-        	
-    </storageModule>
-    	
-    <storageModule moduleId="cdtBuildSystem" version="4.0.0">
-        		
-        <project id="adda-master.null.1518122536" name="adda-master"/>
-        	
-    </storageModule>
-    	
-    <storageModule moduleId="scannerConfiguration">
-        		
-        <autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId=""/>
-        	
-    </storageModule>
-    	
-    <storageModule moduleId="org.eclipse.cdt.core.LanguageSettingsProviders"/>
-    	
-    <storageModule moduleId="refreshScope" versionNumber="2">
-        		
-        <configuration configurationName="Default">
-            			
-            <resource resourceType="PROJECT" workspacePath="/adda-master"/>
-            		
-        </configuration>
-        	
-    </storageModule>
-    	
-    <storageModule moduleId="org.eclipse.cdt.make.core.buildtargets">
-        		
-        <buildTargets>
-            			
-            <target name="seq" path="" targetID="org.eclipse.cdt.build.MakeTargetBuilder">
-                				
-                <buildCommand>make</buildCommand>
-                				
-                <buildArguments/>
-                				
-                <buildTarget>seq</buildTarget>
-                				
-                <stopOnError>true</stopOnError>
-                				
-                <useDefaultCommand>true</useDefaultCommand>
-                				
-                <runAllBuilders>true</runAllBuilders>
-                			
-            </target>
-            			
-            <target name="mpi" path="" targetID="org.eclipse.cdt.build.MakeTargetBuilder">
-                				
-                <buildCommand>make</buildCommand>
-                				
-                <buildArguments/>
-                				
-                <buildTarget>mpi</buildTarget>
-                				
-                <stopOnError>true</stopOnError>
-                				
-                <useDefaultCommand>true</useDefaultCommand>
-                				
-                <runAllBuilders>true</runAllBuilders>
-                			
-            </target>
-            		
-        </buildTargets>
-        	
-    </storageModule>
-    
+	<storageModule moduleId="org.eclipse.cdt.core.settings">
+		<cconfiguration id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582">
+			<storageModule buildSystemId="org.eclipse.cdt.managedbuilder.core.configurationDataProvider" id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582" moduleId="org.eclipse.cdt.core.settings" name="Default">
+				<externalSettings/>
+				<extensions>
+					<extension id="org.eclipse.cdt.core.PE" point="org.eclipse.cdt.core.BinaryParser"/>
+					<extension id="org.eclipse.cdt.core.GASErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+					<extension id="org.eclipse.cdt.core.GLDErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+					<extension id="org.eclipse.cdt.core.GCCErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+					<extension id="org.eclipse.cdt.core.GmakeErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+					<extension id="org.eclipse.cdt.core.CWDLocator" point="org.eclipse.cdt.core.ErrorParser"/>
+				</extensions>
+			</storageModule>
+			<storageModule moduleId="cdtBuildSystem" version="4.0.0">
+				<configuration buildProperties="" description="" id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582" name="Default" optionalBuildProperties="" parent="org.eclipse.cdt.build.core.emptycfg">
+					<folderInfo id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582.1127462783" name="/" resourcePath="">
+						<toolChain id="cdt.managedbuild.toolchain.gnu.mingw.base.1035458335" name="MinGW GCC" superClass="cdt.managedbuild.toolchain.gnu.mingw.base">
+							<targetPlatform archList="all" binaryParser="org.eclipse.cdt.core.PE" id="cdt.managedbuild.target.gnu.platform.mingw.base.1085348987" name="Debug Platform" osList="win32" superClass="cdt.managedbuild.target.gnu.platform.mingw.base"/>
+							<builder id="cdt.managedbuild.builder.gnu.cross.1398979264" managedBuildOn="false" superClass="cdt.managedbuild.builder.gnu.cross"/>
+							<tool id="cdt.managedbuild.tool.gnu.assembler.mingw.base.1518750006" name="GCC Assembler" superClass="cdt.managedbuild.tool.gnu.assembler.mingw.base">
+								<inputType id="cdt.managedbuild.tool.gnu.assembler.input.1540650047" superClass="cdt.managedbuild.tool.gnu.assembler.input"/>
+							</tool>
+							<tool id="cdt.managedbuild.tool.gnu.archiver.mingw.base.909230791" name="GCC Archiver" superClass="cdt.managedbuild.tool.gnu.archiver.mingw.base"/>
+							<tool id="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base.462309889" name="GCC C++ Compiler" superClass="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base"/>
+							<tool id="cdt.managedbuild.tool.gnu.c.compiler.mingw.base.1803672067" name="GCC C Compiler" superClass="cdt.managedbuild.tool.gnu.c.compiler.mingw.base">
+								<inputType id="cdt.managedbuild.tool.gnu.c.compiler.input.1946895431" superClass="cdt.managedbuild.tool.gnu.c.compiler.input"/>
+							</tool>
+							<tool id="cdt.managedbuild.tool.gnu.c.linker.mingw.base.1010477471" name="MinGW C Linker" superClass="cdt.managedbuild.tool.gnu.c.linker.mingw.base">
+								<inputType id="cdt.managedbuild.tool.gnu.c.linker.input.1282503363" superClass="cdt.managedbuild.tool.gnu.c.linker.input">
+									<additionalInput kind="additionalinputdependency" paths="$(USER_OBJS)"/>
+									<additionalInput kind="additionalinput" paths="$(LIBS)"/>
+								</inputType>
+							</tool>
+							<tool id="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base.625915771" name="MinGW C++ Linker" superClass="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base"/>
+						</toolChain>
+					</folderInfo>
+				</configuration>
+			</storageModule>
+			<storageModule moduleId="org.eclipse.cdt.core.externalSettings"/>
+		</cconfiguration>
+		<cconfiguration id="cdt.managedbuild.toolchain.gnu.mingw.base.2024424744">
+			<storageModule buildSystemId="org.eclipse.cdt.managedbuilder.core.configurationDataProvider" id="cdt.managedbuild.toolchain.gnu.mingw.base.2024424744" moduleId="org.eclipse.cdt.core.settings" name="Default">
+				<externalSettings/>
+				<extensions>
+					<extension id="org.eclipse.cdt.core.PE" point="org.eclipse.cdt.core.BinaryParser"/>
+					<extension id="org.eclipse.cdt.core.GASErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+					<extension id="org.eclipse.cdt.core.GmakeErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+					<extension id="org.eclipse.cdt.core.GLDErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+					<extension id="org.eclipse.cdt.core.CWDLocator" point="org.eclipse.cdt.core.ErrorParser"/>
+					<extension id="org.eclipse.cdt.core.GCCErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+				</extensions>
+			</storageModule>
+			<storageModule moduleId="cdtBuildSystem" version="4.0.0">
+				<configuration buildProperties="" description="" id="cdt.managedbuild.toolchain.gnu.mingw.base.2024424744" name="Default" optionalBuildProperties="" parent="org.eclipse.cdt.build.core.emptycfg">
+					<folderInfo id="cdt.managedbuild.toolchain.gnu.mingw.base.2024424744.1785269505" name="/" resourcePath="">
+						<toolChain id="cdt.managedbuild.toolchain.gnu.mingw.base.653372581" name="MinGW GCC" superClass="cdt.managedbuild.toolchain.gnu.mingw.base">
+							<targetPlatform archList="all" binaryParser="org.eclipse.cdt.core.PE" id="cdt.managedbuild.target.gnu.platform.mingw.base.2053374167" name="Debug Platform" osList="win32" superClass="cdt.managedbuild.target.gnu.platform.mingw.base"/>
+							<builder id="cdt.managedbuild.builder.gnu.cross.2064603808" managedBuildOn="false" superClass="cdt.managedbuild.builder.gnu.cross"/>
+							<tool id="cdt.managedbuild.tool.gnu.assembler.mingw.base.522448096" name="GCC Assembler" superClass="cdt.managedbuild.tool.gnu.assembler.mingw.base">
+								<inputType id="cdt.managedbuild.tool.gnu.assembler.input.1719103837" superClass="cdt.managedbuild.tool.gnu.assembler.input"/>
+							</tool>
+							<tool id="cdt.managedbuild.tool.gnu.archiver.mingw.base.1922443684" name="GCC Archiver" superClass="cdt.managedbuild.tool.gnu.archiver.mingw.base"/>
+							<tool id="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base.1187222196" name="GCC C++ Compiler" superClass="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base">
+								<inputType id="cdt.managedbuild.tool.gnu.cpp.compiler.input.2095853106" superClass="cdt.managedbuild.tool.gnu.cpp.compiler.input"/>
+							</tool>
+							<tool id="cdt.managedbuild.tool.gnu.c.compiler.mingw.base.1663302345" name="GCC C Compiler" superClass="cdt.managedbuild.tool.gnu.c.compiler.mingw.base">
+								<inputType id="cdt.managedbuild.tool.gnu.c.compiler.input.1672570293" superClass="cdt.managedbuild.tool.gnu.c.compiler.input"/>
+							</tool>
+							<tool id="cdt.managedbuild.tool.gnu.c.linker.mingw.base.19363403" name="MinGW C Linker" superClass="cdt.managedbuild.tool.gnu.c.linker.mingw.base"/>
+							<tool id="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base.103511842" name="MinGW C++ Linker" superClass="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base">
+								<inputType id="cdt.managedbuild.tool.gnu.cpp.linker.input.85834039" superClass="cdt.managedbuild.tool.gnu.cpp.linker.input">
+									<additionalInput kind="additionalinputdependency" paths="$(USER_OBJS)"/>
+									<additionalInput kind="additionalinput" paths="$(LIBS)"/>
+								</inputType>
+							</tool>
+						</toolChain>
+					</folderInfo>
+				</configuration>
+			</storageModule>
+		</cconfiguration>
+	</storageModule>
+	<storageModule moduleId="cdtBuildSystem" version="4.0.0">
+		<project id="adda-asd.null.975128964" name="adda-asd"/>
+	</storageModule>
+	<storageModule moduleId="org.eclipse.cdt.core.LanguageSettingsProviders"/>
+	<storageModule moduleId="refreshScope" versionNumber="2">
+		<configuration configurationName="Default">
+			<resource resourceType="PROJECT" workspacePath="/adda-master"/>
+		</configuration>
+	</storageModule>
+	<storageModule moduleId="org.eclipse.cdt.make.core.buildtargets">
+		<buildTargets>
+			<target name="seq" path="" targetID="org.eclipse.cdt.build.MakeTargetBuilder">
+				<buildCommand>make</buildCommand>
+				<buildArguments/>
+				<buildTarget>seq</buildTarget>
+				<stopOnError>true</stopOnError>
+				<useDefaultCommand>true</useDefaultCommand>
+				<runAllBuilders>true</runAllBuilders>
+			</target>
+			<target name="mpi" path="" targetID="org.eclipse.cdt.build.MakeTargetBuilder">
+				<buildCommand>make</buildCommand>
+				<buildArguments/>
+				<buildTarget>mpi</buildTarget>
+				<stopOnError>true</stopOnError>
+				<useDefaultCommand>true</useDefaultCommand>
+				<runAllBuilders>true</runAllBuilders>
+			</target>
+		</buildTargets>
+	</storageModule>
+	<storageModule moduleId="scannerConfiguration">
+		<autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId=""/>
+		<scannerConfigBuildInfo instanceId="cdt.managedbuild.toolchain.gnu.mingw.base.1055110387;cdt.managedbuild.toolchain.gnu.mingw.base.1055110387.763791221;cdt.managedbuild.tool.gnu.c.compiler.mingw.base.1203535434;cdt.managedbuild.tool.gnu.c.compiler.input.557581763">
+			<autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId=""/>
+		</scannerConfigBuildInfo>
+	</storageModule>
 </cproject>
diff --git a/src/.settings/language.settings.xml b/src/.settings/language.settings.xml
index a463dc28..66a6a6ee 100644
--- a/src/.settings/language.settings.xml
+++ b/src/.settings/language.settings.xml
@@ -12,4 +12,16 @@
 			<provider-reference id="org.eclipse.cdt.managedbuilder.core.MBSLanguageSettingsProvider" ref="shared-provider"/>
 		</extension>
 	</configuration>
+	<configuration id="cdt.managedbuild.toolchain.gnu.mingw.base.2024424744" name="Default">
+		<extension point="org.eclipse.cdt.core.LanguageSettingsProvider">
+			<provider copy-of="extension" id="org.eclipse.cdt.ui.UserLanguageSettingsProvider"/>
+			<provider-reference id="org.eclipse.cdt.core.ReferencedProjectsLanguageSettingsProvider" ref="shared-provider"/>
+			<provider copy-of="extension" id="org.eclipse.cdt.managedbuilder.core.GCCBuildCommandParser"/>
+			<provider class="org.eclipse.cdt.managedbuilder.internal.language.settings.providers.GCCBuiltinSpecsDetectorMinGW" console="false" env-hash="1736031386934720504" id="org.eclipse.cdt.managedbuilder.core.GCCBuiltinSpecsDetectorMinGW" keep-relative-paths="false" name="CDT GCC Built-in Compiler Settings MinGW" parameter="${COMMAND} ${FLAGS} -E -P -v -dD &quot;${INPUTS}&quot;" prefer-non-shared="true">
+				<language-scope id="org.eclipse.cdt.core.gcc"/>
+				<language-scope id="org.eclipse.cdt.core.g++"/>
+			</provider>
+			<provider-reference id="org.eclipse.cdt.managedbuilder.core.MBSLanguageSettingsProvider" ref="shared-provider"/>
+		</extension>
+	</configuration>
 </project>
diff --git a/src/GenerateB.c b/src/GenerateB.c
index eeca65e2..af8fce31 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -538,28 +538,28 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				}
 				switch (beamtype) {
 					case B_BESSELCS:
-						p[0][0]=0.50; p[0][1]=0;		p[1][0]=0; p[1][1]=0;
+						p[0][0]=0.50; p[0][1]=0;	p[1][0]=0; p[1][1]=0;
 						p[2][0]=0; p[2][1]=0; 		p[3][0]=0.5; p[3][1]=0;
 						break;
 					case B_BESSELGEN:
-						p[0][0]=0.5; p[0][1]=0;		p[1][0]=0; p[1][1]=0;
-						p[2][0]=0; p[2][1]=0; 		p[3][0]=0.5; p[3][1]=0;
+						p[0][0]=hvp[0]; p[0][1]=hvp[1];	p[1][0]=hvp[2]; p[1][1]=hvp[3];
+						p[2][0]=hvp[4]; p[2][1]=hvp[5];	p[3][0]=hvp[6]; p[3][1]=hvp[7];
 						break;
 					case B_BESSELLE:
-						p[0][0]=0; p[0][1]=0;	p[1][0]=0; p[1][1]=0;
+						p[0][0]=0; p[0][1]=0;	p[1][0]=0; 	p[1][1]=0;
 						p[2][0]=0; p[2][1]=0; 	p[3][0]=1.; p[3][1]=0;
 						break;
 					case B_BESSELLM:
-						p[0][0]=0; p[0][1]=0;	p[1][0]=-1.; p[1][1]=0;
-						p[2][0]=0; p[2][1]=0; 	p[3][0]=0; p[3][1]=0;
+						p[0][0]=0; p[0][1]=0;	p[1][0]=-1.; 	p[1][1]=0;
+						p[2][0]=0; p[2][1]=0; 	p[3][0]=0; 		p[3][1]=0;
 						break;
 					case B_BESSELTEC:
 						p[0][0]=0; p[0][1]=0; 	p[1][0]=1./sin(alpha0); p[1][1]=0;
-						p[2][0]=0; p[2][1]=0; 	p[3][0]=0; p[3][1]=1./tan(alpha0);
+						p[2][0]=0; p[2][1]=0; 	p[3][0]=0; 				p[3][1]=1./tan(alpha0);
 						break;
 					case B_BESSELTMC:
-						p[0][0]=0; p[0][1]=0; 	p[1][0]=0; p[1][1]=1./tan(alpha0);
-						p[2][0]=0; p[2][1]=0; 	p[3][0]=-1./sin(alpha0); p[3][1]=0;
+						p[0][0]=0; p[0][1]=0; 	p[1][0]=0; 					p[1][1]=1./tan(alpha0);
+						p[2][0]=0; p[2][1]=0; 	p[3][0]=-1./sin(alpha0);	p[3][1]=0;
 						break;
 					default: break;
 				}
diff --git a/src/githash.h b/src/githash.h
index dc8f4e57..a8b9f2f6 100644
--- a/src/githash.h
+++ b/src/githash.h
@@ -1 +1 @@
-#define GITHASH "bb4f787"
+#define GITHASH "21b201d"

From 61e931e7583b6e4ed7286228ba71f9d5ae7bd91f Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Thu, 15 Apr 2021 16:52:34 +0700
Subject: [PATCH 13/46] Changed besselGen -> besselM

---
 .gitignore      |  1 +
 src/GenerateB.c | 12 ++++++------
 src/const.h     |  2 +-
 src/githash.h   |  2 +-
 src/param.c     |  6 +++---
 5 files changed, 12 insertions(+), 11 deletions(-)

diff --git a/.gitignore b/.gitignore
index e9209659..0ca0f676 100644
--- a/.gitignore
+++ b/.gitignore
@@ -20,3 +20,4 @@ src/githash.h
 src/.cproject
 src/.settings/language.settings.xml
 src/.cproject
+src/githash.h
diff --git a/src/GenerateB.c b/src/GenerateB.c
index af8fce31..300464dd 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -86,7 +86,7 @@ void InitBeam(void)
 // initialize beam; produce description string
 {
 	double w0; // beam width
-	int n_par; // for besselGen
+	int n_par; // for besselM
 	const char *tmp_str; // temporary string
 	/* TO ADD NEW BEAM
 	 * Add here all intermediate variables, which are used only inside this function.
@@ -192,14 +192,14 @@ void InitBeam(void)
 			}
 			return;
 		case B_BESSELCS:
-		case B_BESSELGEN:
+		case B_BESSELM:
 		case B_BESSELLE:
 		case B_BESSELLM:
 		case B_BESSELTEC:
 		case B_BESSELTMC:
 			if (surface) PrintError("Currently, Bessel incident beam is not supported for '-surf'");
 			// initialize parameters
-			if (beamtype==B_BESSELGEN) {
+			if (beamtype==B_BESSELM) {
 				n_par = 8;
 				hvp[0] = beam_pars[0]; hvp[1] = beam_pars[1];
 				hvp[2] = beam_pars[2]; hvp[3] = beam_pars[3];
@@ -219,7 +219,7 @@ void InitBeam(void)
 					case B_BESSELCS:
 						tmp_str="circularly symmetric energy density)\n";
 						break;
-					case B_BESSELGEN:
+					case B_BESSELM:
 						tmp_str="generalized)\n";
 						break;
 					case B_BESSELLE:
@@ -505,7 +505,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 			}
 			return;
 		case B_BESSELCS:
-		case B_BESSELGEN:
+		case B_BESSELM:
 		case B_BESSELLE:
 		case B_BESSELLM:
 		case B_BESSELTEC:
@@ -541,7 +541,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 						p[0][0]=0.50; p[0][1]=0;	p[1][0]=0; p[1][1]=0;
 						p[2][0]=0; p[2][1]=0; 		p[3][0]=0.5; p[3][1]=0;
 						break;
-					case B_BESSELGEN:
+					case B_BESSELM:
 						p[0][0]=hvp[0]; p[0][1]=hvp[1];	p[1][0]=hvp[2]; p[1][1]=hvp[3];
 						p[2][0]=hvp[4]; p[2][1]=hvp[5];	p[3][0]=hvp[6]; p[3][1]=hvp[7];
 						break;
diff --git a/src/const.h b/src/const.h
index 9ae5163f..14373aab 100644
--- a/src/const.h
+++ b/src/const.h
@@ -286,7 +286,7 @@ enum incpol {
 enum beam { // beam types
 	B_BARTON5, // 5th order description of the Gaussian beam
 	B_BESSELCS, // Bessel beam with circularly symmetric energy density
-	B_BESSELGEN, // Generalized Bessel beam
+	B_BESSELM, // Generalized Bessel beam
 	B_BESSELLE, // Bessel beam with linearly polarized electric field
 	B_BESSELLM, // Bessel beam with linearly polarized magnetic field
 	B_BESSELTEC, // Bessel beam forming TE Bessel beam 
diff --git a/src/githash.h b/src/githash.h
index a8b9f2f6..edf5dfcd 100644
--- a/src/githash.h
+++ b/src/githash.h
@@ -1 +1 @@
-#define GITHASH "21b201d"
+#define GITHASH "3fcc7c6"
diff --git a/src/param.c b/src/param.c
index d2932cc4..004eaaab 100644
--- a/src/param.c
+++ b/src/param.c
@@ -234,11 +234,11 @@ static const struct subopt_struct beam_opt[]={
 		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
 		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
 		UNDEF,B_BESSELCS},
-	{"besselGen","<RePex> <ImPex> <RePey> <ImPey> <RePmx> <ImPmx> <RePmy> <ImPmy> \n\t<order> <angle> [<x> <y> <z>]",
+	{"besselM","<ReMex> <ImMex> <ReMey> <ImPey> <ReMmx> <ImMmx> <ReMmy> <ImMmy> \n\t<order> <angle> [<x> <y> <z>]",
 		"Generalized Bessel beam. The half-cone angle is measured from the z axis. The half-cone angle and beam order "
 		"are obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
 		"(zero, by default). Coordinate arguments are in um.",
-		UNDEF,B_BESSELGEN},
+		UNDEF,B_BESSELM},
 	{"besselLE","<order> <angle> [<x> <y> <z>]","Bessel beam with linearly polarized electric field. The half-cone angle "
 		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
 		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
@@ -1025,7 +1025,7 @@ PARSE_FUNC(beam)
 			case B_DAVIS3:
 			case B_BARTON5: if (Narg!=1 && Narg!=4) NargError(Narg,"1 or 4"); break;
 			case B_BESSELCS: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
-			case B_BESSELGEN: if (Narg!=10 && Narg!=13) NargError(Narg,"10 or 13"); break;
+			case B_BESSELM: if (Narg!=10 && Narg!=13) NargError(Narg,"10 or 13"); break;
 			case B_BESSELLE: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
 			case B_BESSELLM: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
 			case B_BESSELTEC: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;

From 97852cd89c182a47e379f386286cdf8f33b293eb Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Mon, 28 Jun 2021 11:49:19 +0700
Subject: [PATCH 14/46] minor fixes

---
 src/.cproject                       | 263 ++++++++++++----------------
 src/.settings/language.settings.xml |  12 ++
 src/GenerateB.c                     |  48 ++++-
 src/const.h                         |   1 +
 src/githash.h                       |   2 +-
 src/param.c                         |   5 +
 6 files changed, 179 insertions(+), 152 deletions(-)

diff --git a/src/.cproject b/src/.cproject
index f6d49861..f06ffd45 100644
--- a/src/.cproject
+++ b/src/.cproject
@@ -1,150 +1,119 @@
 <?xml version="1.0" encoding="UTF-8" standalone="no"?>
 <?fileVersion 4.0.0?><cproject storage_type_id="org.eclipse.cdt.core.XmlProjectDescriptionStorage">
-    	
-    <storageModule moduleId="org.eclipse.cdt.core.settings">
-        		
-        <cconfiguration id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582">
-            			
-            <storageModule buildSystemId="org.eclipse.cdt.managedbuilder.core.configurationDataProvider" id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582" moduleId="org.eclipse.cdt.core.settings" name="Default">
-                				
-                <externalSettings/>
-                				
-                <extensions>
-                    					
-                    <extension id="org.eclipse.cdt.core.PE" point="org.eclipse.cdt.core.BinaryParser"/>
-                    					
-                    <extension id="org.eclipse.cdt.core.GASErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-                    					
-                    <extension id="org.eclipse.cdt.core.GLDErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-                    					
-                    <extension id="org.eclipse.cdt.core.GCCErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-                    					
-                    <extension id="org.eclipse.cdt.core.GmakeErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-                    					
-                    <extension id="org.eclipse.cdt.core.CWDLocator" point="org.eclipse.cdt.core.ErrorParser"/>
-                    				
-                </extensions>
-                			
-            </storageModule>
-            			
-            <storageModule moduleId="cdtBuildSystem" version="4.0.0">
-                				
-                <configuration buildProperties="" description="" id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582" name="Default" optionalBuildProperties="" parent="org.eclipse.cdt.build.core.emptycfg">
-                    					
-                    <folderInfo id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582.1127462783" name="/" resourcePath="">
-                        						
-                        <toolChain id="cdt.managedbuild.toolchain.gnu.mingw.base.1035458335" name="MinGW GCC" superClass="cdt.managedbuild.toolchain.gnu.mingw.base">
-                            							
-                            <targetPlatform archList="all" binaryParser="org.eclipse.cdt.core.PE" id="cdt.managedbuild.target.gnu.platform.mingw.base.1085348987" name="Debug Platform" osList="win32" superClass="cdt.managedbuild.target.gnu.platform.mingw.base"/>
-                            							
-                            <builder id="cdt.managedbuild.builder.gnu.cross.1398979264" managedBuildOn="false" superClass="cdt.managedbuild.builder.gnu.cross"/>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.assembler.mingw.base.1518750006" name="GCC Assembler" superClass="cdt.managedbuild.tool.gnu.assembler.mingw.base">
-                                								
-                                <inputType id="cdt.managedbuild.tool.gnu.assembler.input.1540650047" superClass="cdt.managedbuild.tool.gnu.assembler.input"/>
-                                							
-                            </tool>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.archiver.mingw.base.909230791" name="GCC Archiver" superClass="cdt.managedbuild.tool.gnu.archiver.mingw.base"/>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base.462309889" name="GCC C++ Compiler" superClass="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base"/>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.c.compiler.mingw.base.1803672067" name="GCC C Compiler" superClass="cdt.managedbuild.tool.gnu.c.compiler.mingw.base">
-                                								
-                                <inputType id="cdt.managedbuild.tool.gnu.c.compiler.input.1946895431" superClass="cdt.managedbuild.tool.gnu.c.compiler.input"/>
-                                							
-                            </tool>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.c.linker.mingw.base.1010477471" name="MinGW C Linker" superClass="cdt.managedbuild.tool.gnu.c.linker.mingw.base">
-                                								
-                                <inputType id="cdt.managedbuild.tool.gnu.c.linker.input.1282503363" superClass="cdt.managedbuild.tool.gnu.c.linker.input">
-                                    									
-                                    <additionalInput kind="additionalinputdependency" paths="$(USER_OBJS)"/>
-                                    									
-                                    <additionalInput kind="additionalinput" paths="$(LIBS)"/>
-                                    								
-                                </inputType>
-                                							
-                            </tool>
-                            							
-                            <tool id="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base.625915771" name="MinGW C++ Linker" superClass="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base"/>
-                            						
-                        </toolChain>
-                        					
-                    </folderInfo>
-                    				
-                </configuration>
-                			
-            </storageModule>
-            			
-            <storageModule moduleId="org.eclipse.cdt.core.externalSettings"/>
-            		
-        </cconfiguration>
-        	
-    </storageModule>
-    	
-    <storageModule moduleId="cdtBuildSystem" version="4.0.0">
-        		
-        <project id="adda-master.null.1518122536" name="adda-master"/>
-        	
-    </storageModule>
-    	
-    <storageModule moduleId="scannerConfiguration">
-        		
-        <autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId=""/>
-        	
-    </storageModule>
-    	
-    <storageModule moduleId="org.eclipse.cdt.core.LanguageSettingsProviders"/>
-    	
-    <storageModule moduleId="refreshScope" versionNumber="2">
-        		
-        <configuration configurationName="Default">
-            			
-            <resource resourceType="PROJECT" workspacePath="/adda-master"/>
-            		
-        </configuration>
-        	
-    </storageModule>
-    	
-    <storageModule moduleId="org.eclipse.cdt.make.core.buildtargets">
-        		
-        <buildTargets>
-            			
-            <target name="seq" path="" targetID="org.eclipse.cdt.build.MakeTargetBuilder">
-                				
-                <buildCommand>make</buildCommand>
-                				
-                <buildArguments/>
-                				
-                <buildTarget>seq</buildTarget>
-                				
-                <stopOnError>true</stopOnError>
-                				
-                <useDefaultCommand>true</useDefaultCommand>
-                				
-                <runAllBuilders>true</runAllBuilders>
-                			
-            </target>
-            			
-            <target name="mpi" path="" targetID="org.eclipse.cdt.build.MakeTargetBuilder">
-                				
-                <buildCommand>make</buildCommand>
-                				
-                <buildArguments/>
-                				
-                <buildTarget>mpi</buildTarget>
-                				
-                <stopOnError>true</stopOnError>
-                				
-                <useDefaultCommand>true</useDefaultCommand>
-                				
-                <runAllBuilders>true</runAllBuilders>
-                			
-            </target>
-            		
-        </buildTargets>
-        	
-    </storageModule>
-    
+	<storageModule moduleId="org.eclipse.cdt.core.settings">
+		<cconfiguration id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582">
+			<storageModule buildSystemId="org.eclipse.cdt.managedbuilder.core.configurationDataProvider" id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582" moduleId="org.eclipse.cdt.core.settings" name="Default">
+				<externalSettings/>
+				<extensions>
+					<extension id="org.eclipse.cdt.core.PE" point="org.eclipse.cdt.core.BinaryParser"/>
+					<extension id="org.eclipse.cdt.core.GASErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+					<extension id="org.eclipse.cdt.core.GLDErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+					<extension id="org.eclipse.cdt.core.GCCErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+					<extension id="org.eclipse.cdt.core.GmakeErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+					<extension id="org.eclipse.cdt.core.CWDLocator" point="org.eclipse.cdt.core.ErrorParser"/>
+				</extensions>
+			</storageModule>
+			<storageModule moduleId="cdtBuildSystem" version="4.0.0">
+				<configuration buildProperties="" description="" id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582" name="Default" optionalBuildProperties="" parent="org.eclipse.cdt.build.core.emptycfg">
+					<folderInfo id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582.1127462783" name="/" resourcePath="">
+						<toolChain id="cdt.managedbuild.toolchain.gnu.mingw.base.1035458335" name="MinGW GCC" superClass="cdt.managedbuild.toolchain.gnu.mingw.base">
+							<targetPlatform archList="all" binaryParser="org.eclipse.cdt.core.PE" id="cdt.managedbuild.target.gnu.platform.mingw.base.1085348987" name="Debug Platform" osList="win32" superClass="cdt.managedbuild.target.gnu.platform.mingw.base"/>
+							<builder id="cdt.managedbuild.builder.gnu.cross.1398979264" managedBuildOn="false" superClass="cdt.managedbuild.builder.gnu.cross"/>
+							<tool id="cdt.managedbuild.tool.gnu.assembler.mingw.base.1518750006" name="GCC Assembler" superClass="cdt.managedbuild.tool.gnu.assembler.mingw.base">
+								<inputType id="cdt.managedbuild.tool.gnu.assembler.input.1540650047" superClass="cdt.managedbuild.tool.gnu.assembler.input"/>
+							</tool>
+							<tool id="cdt.managedbuild.tool.gnu.archiver.mingw.base.909230791" name="GCC Archiver" superClass="cdt.managedbuild.tool.gnu.archiver.mingw.base"/>
+							<tool id="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base.462309889" name="GCC C++ Compiler" superClass="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base"/>
+							<tool id="cdt.managedbuild.tool.gnu.c.compiler.mingw.base.1803672067" name="GCC C Compiler" superClass="cdt.managedbuild.tool.gnu.c.compiler.mingw.base">
+								<inputType id="cdt.managedbuild.tool.gnu.c.compiler.input.1946895431" superClass="cdt.managedbuild.tool.gnu.c.compiler.input"/>
+							</tool>
+							<tool id="cdt.managedbuild.tool.gnu.c.linker.mingw.base.1010477471" name="MinGW C Linker" superClass="cdt.managedbuild.tool.gnu.c.linker.mingw.base">
+								<inputType id="cdt.managedbuild.tool.gnu.c.linker.input.1282503363" superClass="cdt.managedbuild.tool.gnu.c.linker.input">
+									<additionalInput kind="additionalinputdependency" paths="$(USER_OBJS)"/>
+									<additionalInput kind="additionalinput" paths="$(LIBS)"/>
+								</inputType>
+							</tool>
+							<tool id="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base.625915771" name="MinGW C++ Linker" superClass="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base"/>
+						</toolChain>
+					</folderInfo>
+				</configuration>
+			</storageModule>
+			<storageModule moduleId="org.eclipse.cdt.core.externalSettings"/>
+		</cconfiguration>
+		<cconfiguration id="cdt.managedbuild.toolchain.gnu.mingw.base.2024424744">
+			<storageModule buildSystemId="org.eclipse.cdt.managedbuilder.core.configurationDataProvider" id="cdt.managedbuild.toolchain.gnu.mingw.base.2024424744" moduleId="org.eclipse.cdt.core.settings" name="Default">
+				<externalSettings/>
+				<extensions>
+					<extension id="org.eclipse.cdt.core.PE" point="org.eclipse.cdt.core.BinaryParser"/>
+					<extension id="org.eclipse.cdt.core.GASErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+					<extension id="org.eclipse.cdt.core.GmakeErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+					<extension id="org.eclipse.cdt.core.GLDErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+					<extension id="org.eclipse.cdt.core.CWDLocator" point="org.eclipse.cdt.core.ErrorParser"/>
+					<extension id="org.eclipse.cdt.core.GCCErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+				</extensions>
+			</storageModule>
+			<storageModule moduleId="cdtBuildSystem" version="4.0.0">
+				<configuration buildProperties="" description="" id="cdt.managedbuild.toolchain.gnu.mingw.base.2024424744" name="Default" optionalBuildProperties="" parent="org.eclipse.cdt.build.core.emptycfg">
+					<folderInfo id="cdt.managedbuild.toolchain.gnu.mingw.base.2024424744.1785269505" name="/" resourcePath="">
+						<toolChain id="cdt.managedbuild.toolchain.gnu.mingw.base.653372581" name="MinGW GCC" superClass="cdt.managedbuild.toolchain.gnu.mingw.base">
+							<targetPlatform archList="all" binaryParser="org.eclipse.cdt.core.PE" id="cdt.managedbuild.target.gnu.platform.mingw.base.2053374167" name="Debug Platform" osList="win32" superClass="cdt.managedbuild.target.gnu.platform.mingw.base"/>
+							<builder id="cdt.managedbuild.builder.gnu.cross.2064603808" managedBuildOn="false" superClass="cdt.managedbuild.builder.gnu.cross"/>
+							<tool id="cdt.managedbuild.tool.gnu.assembler.mingw.base.522448096" name="GCC Assembler" superClass="cdt.managedbuild.tool.gnu.assembler.mingw.base">
+								<inputType id="cdt.managedbuild.tool.gnu.assembler.input.1719103837" superClass="cdt.managedbuild.tool.gnu.assembler.input"/>
+							</tool>
+							<tool id="cdt.managedbuild.tool.gnu.archiver.mingw.base.1922443684" name="GCC Archiver" superClass="cdt.managedbuild.tool.gnu.archiver.mingw.base"/>
+							<tool id="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base.1187222196" name="GCC C++ Compiler" superClass="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base">
+								<inputType id="cdt.managedbuild.tool.gnu.cpp.compiler.input.2095853106" superClass="cdt.managedbuild.tool.gnu.cpp.compiler.input"/>
+							</tool>
+							<tool id="cdt.managedbuild.tool.gnu.c.compiler.mingw.base.1663302345" name="GCC C Compiler" superClass="cdt.managedbuild.tool.gnu.c.compiler.mingw.base">
+								<inputType id="cdt.managedbuild.tool.gnu.c.compiler.input.1672570293" superClass="cdt.managedbuild.tool.gnu.c.compiler.input"/>
+							</tool>
+							<tool id="cdt.managedbuild.tool.gnu.c.linker.mingw.base.19363403" name="MinGW C Linker" superClass="cdt.managedbuild.tool.gnu.c.linker.mingw.base"/>
+							<tool id="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base.103511842" name="MinGW C++ Linker" superClass="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base">
+								<inputType id="cdt.managedbuild.tool.gnu.cpp.linker.input.85834039" superClass="cdt.managedbuild.tool.gnu.cpp.linker.input">
+									<additionalInput kind="additionalinputdependency" paths="$(USER_OBJS)"/>
+									<additionalInput kind="additionalinput" paths="$(LIBS)"/>
+								</inputType>
+							</tool>
+						</toolChain>
+					</folderInfo>
+				</configuration>
+			</storageModule>
+		</cconfiguration>
+	</storageModule>
+	<storageModule moduleId="cdtBuildSystem" version="4.0.0">
+		<project id="adda-asd.null.975128964" name="adda-asd"/>
+	</storageModule>
+	<storageModule moduleId="org.eclipse.cdt.core.LanguageSettingsProviders"/>
+	<storageModule moduleId="refreshScope" versionNumber="2">
+		<configuration configurationName="Default">
+			<resource resourceType="PROJECT" workspacePath="/adda-master"/>
+		</configuration>
+	</storageModule>
+	<storageModule moduleId="org.eclipse.cdt.make.core.buildtargets">
+		<buildTargets>
+			<target name="seq" path="" targetID="org.eclipse.cdt.build.MakeTargetBuilder">
+				<buildCommand>make</buildCommand>
+				<buildArguments/>
+				<buildTarget>seq</buildTarget>
+				<stopOnError>true</stopOnError>
+				<useDefaultCommand>true</useDefaultCommand>
+				<runAllBuilders>true</runAllBuilders>
+			</target>
+			<target name="mpi" path="" targetID="org.eclipse.cdt.build.MakeTargetBuilder">
+				<buildCommand>make</buildCommand>
+				<buildArguments/>
+				<buildTarget>mpi</buildTarget>
+				<stopOnError>true</stopOnError>
+				<useDefaultCommand>true</useDefaultCommand>
+				<runAllBuilders>true</runAllBuilders>
+			</target>
+		</buildTargets>
+	</storageModule>
+	<storageModule moduleId="scannerConfiguration">
+		<autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId=""/>
+		<scannerConfigBuildInfo instanceId="cdt.managedbuild.toolchain.gnu.mingw.base.1055110387;cdt.managedbuild.toolchain.gnu.mingw.base.1055110387.763791221;cdt.managedbuild.tool.gnu.c.compiler.mingw.base.1203535434;cdt.managedbuild.tool.gnu.c.compiler.input.557581763">
+			<autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId=""/>
+		</scannerConfigBuildInfo>
+	</storageModule>
 </cproject>
diff --git a/src/.settings/language.settings.xml b/src/.settings/language.settings.xml
index a463dc28..66a6a6ee 100644
--- a/src/.settings/language.settings.xml
+++ b/src/.settings/language.settings.xml
@@ -12,4 +12,16 @@
 			<provider-reference id="org.eclipse.cdt.managedbuilder.core.MBSLanguageSettingsProvider" ref="shared-provider"/>
 		</extension>
 	</configuration>
+	<configuration id="cdt.managedbuild.toolchain.gnu.mingw.base.2024424744" name="Default">
+		<extension point="org.eclipse.cdt.core.LanguageSettingsProvider">
+			<provider copy-of="extension" id="org.eclipse.cdt.ui.UserLanguageSettingsProvider"/>
+			<provider-reference id="org.eclipse.cdt.core.ReferencedProjectsLanguageSettingsProvider" ref="shared-provider"/>
+			<provider copy-of="extension" id="org.eclipse.cdt.managedbuilder.core.GCCBuildCommandParser"/>
+			<provider class="org.eclipse.cdt.managedbuilder.internal.language.settings.providers.GCCBuiltinSpecsDetectorMinGW" console="false" env-hash="1736031386934720504" id="org.eclipse.cdt.managedbuilder.core.GCCBuiltinSpecsDetectorMinGW" keep-relative-paths="false" name="CDT GCC Built-in Compiler Settings MinGW" parameter="${COMMAND} ${FLAGS} -E -P -v -dD &quot;${INPUTS}&quot;" prefer-non-shared="true">
+				<language-scope id="org.eclipse.cdt.core.gcc"/>
+				<language-scope id="org.eclipse.cdt.core.g++"/>
+			</provider>
+			<provider-reference id="org.eclipse.cdt.managedbuilder.core.MBSLanguageSettingsProvider" ref="shared-provider"/>
+		</extension>
+	</configuration>
 </project>
diff --git a/src/GenerateB.c b/src/GenerateB.c
index eeca65e2..85cd4999 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -191,6 +191,7 @@ void InitBeam(void)
 				                       "\tCenter position: "GFORMDEF3V,tmp_str,w0,s,COMP3V(beam_center_0));
 			}
 			return;
+		case B_BESSELASD:
 		case B_BESSELCS:
 		case B_BESSELGEN:
 		case B_BESSELLE:
@@ -216,6 +217,9 @@ void InitBeam(void)
 			// beam info
 			if (IFROOT) {
 				switch (beamtype) {
+					case B_BESSELASD:
+						tmp_str="angular spectrum decomposition)\n";
+						break;
 					case B_BESSELCS:
 						tmp_str="circularly symmetric energy density)\n";
 						break;
@@ -293,15 +297,15 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 {
 	size_t i,j;
 	doublecomplex psi0,Q,Q2;
-	doublecomplex v1[3],v2[3],v3[3],gt[6];
-	double ro,ro2,ro4;
-	double x,y,z,x2_s,xy_s,phi,arg,td1[n0+2],td2[n0+2],jn1[n0+2],p[4][2];
+	doublecomplex v1[3],v2[3],v3[3],gt[6],fint[3],sum[3];
+	double ro,ro2,ro4,r;
+	double x,y,z,x2_s,xy_s,tht,phi,arg,td1[n0+2],td2[n0+2],jn1[n0+2],p[4][2],db;
 	doublecomplex t1,t2,t3,t4,t5,t6,t7,t8,ctemp;
 	const double *ex; // coordinate axis of the beam reference frame
 	double ey[3];
 	double r1[3];
 	double jn2[2]; // for Bessel functions on n and n+1 orders
-	int n1;
+	int n1,it,N;
 	const char *fname;
 	/* TO ADD NEW BEAM
 	 * Add here all intermediate variables, which are used only inside this function. You may as well use 't1'-'t8'
@@ -504,6 +508,42 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				}
 			}
 			return;
+		case B_BESSELASD:
+			for (i=0;i<local_nvoid_Ndip;i++) {
+				j=3*i;
+				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
+				x=DotProd(r1,ex);
+				y=DotProd(r1,ey);
+				z=DotProd(r1,prop);
+				r=sqrt(x*x+y*y+z*z);	// radial distance in a spherical coordinate system
+				tht=atan2(sqrt(x*x+y*y),z);	// polar angle
+				phi=atan2(y,x);			// azimuthal angle
+
+				// Integration
+				N=10;
+				db=2.*PI/N;
+
+				Fpw(fint,n0,WaveNum,r,tht,phi,alpha0,0);
+				sum[0] = fint[0];	sum[1] = fint[1];	sum[2] = fint[2];
+
+				for (it=1;it<N;it++) {
+					Fpw(fint,n0,WaveNum,r,tht,phi,alpha0,it*db);
+					sum[0] += fint[0];
+					sum[1] += fint[1];
+					sum[2] += fint[2];
+				}
+
+				t3=sum[0]/N;	t4=sum[1]/N;	t5=sum[2]/N;
+
+				///printf("\n i: %d \t %g\t %g\t %g\t %g\t %g\t %g",i,creal(t3),cimag(t3),creal(t4),cimag(t4),creal(t5),cimag(t5));
+
+				cvMultScal_RVec(t3,ex,v1);
+				cvMultScal_RVec(t4,ey,v2);
+				cvMultScal_RVec(t5,prop,v3);
+				cvAdd2Self(v1,v2,v3);
+				cvMultScal_cmplx(1.,v1,b+j);
+			}
+			return;
 		case B_BESSELCS:
 		case B_BESSELGEN:
 		case B_BESSELLE:
diff --git a/src/const.h b/src/const.h
index 9ae5163f..c0c3db3c 100644
--- a/src/const.h
+++ b/src/const.h
@@ -285,6 +285,7 @@ enum incpol {
 
 enum beam { // beam types
 	B_BARTON5, // 5th order description of the Gaussian beam
+	B_BESSELASD, // Bessel beam (Angular spectrum decomposition)
 	B_BESSELCS, // Bessel beam with circularly symmetric energy density
 	B_BESSELGEN, // Generalized Bessel beam
 	B_BESSELLE, // Bessel beam with linearly polarized electric field
diff --git a/src/githash.h b/src/githash.h
index dc8f4e57..a8b9f2f6 100644
--- a/src/githash.h
+++ b/src/githash.h
@@ -1 +1 @@
-#define GITHASH "bb4f787"
+#define GITHASH "21b201d"
diff --git a/src/param.c b/src/param.c
index d2932cc4..79e818f2 100644
--- a/src/param.c
+++ b/src/param.c
@@ -230,6 +230,10 @@ static const struct subopt_struct beam_opt[]={
 		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
 		"(zero, by default). All arguments are in um. This is recommended option for simulation of the Gaussian beam.",
 		UNDEF,B_BARTON5},
+	{"besselASD","<order> <angle> [<x> <y> <z>]","Angular spectrum decomposition of Bessel beam. The half-cone angle "
+		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
+		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
+		UNDEF,B_BESSELASD},
 	{"besselCS","<order> <angle> [<x> <y> <z>]","Bessel beam with circularly symmetric energy density. The half-cone angle "
 		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
 		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
@@ -1024,6 +1028,7 @@ PARSE_FUNC(beam)
 			case B_LMINUS:
 			case B_DAVIS3:
 			case B_BARTON5: if (Narg!=1 && Narg!=4) NargError(Narg,"1 or 4"); break;
+			case B_BESSELASD: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
 			case B_BESSELCS: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
 			case B_BESSELGEN: if (Narg!=10 && Narg!=13) NargError(Narg,"10 or 13"); break;
 			case B_BESSELLE: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;

From 25b94612a852f9a215c074c328b2b285813be412 Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Tue, 29 Jun 2021 12:50:13 +0700
Subject: [PATCH 15/46] Added CS' type

---
 src/GenerateB.c | 12 ++++++++++--
 src/const.h     |  1 +
 src/param.c     |  5 +++++
 3 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/src/GenerateB.c b/src/GenerateB.c
index 300464dd..7c7ba987 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -192,6 +192,7 @@ void InitBeam(void)
 			}
 			return;
 		case B_BESSELCS:
+		case B_BESSELCSp:
 		case B_BESSELM:
 		case B_BESSELLE:
 		case B_BESSELLM:
@@ -218,6 +219,8 @@ void InitBeam(void)
 				switch (beamtype) {
 					case B_BESSELCS:
 						tmp_str="circularly symmetric energy density)\n";
+					case B_BESSELCSp:
+						tmp_str="circularly symmetric energy density (alternative))\n";
 						break;
 					case B_BESSELM:
 						tmp_str="generalized)\n";
@@ -505,6 +508,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 			}
 			return;
 		case B_BESSELCS:
+		case B_BESSELCSp:
 		case B_BESSELM:
 		case B_BESSELLE:
 		case B_BESSELLM:
@@ -538,8 +542,12 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				}
 				switch (beamtype) {
 					case B_BESSELCS:
-						p[0][0]=0.50; p[0][1]=0;	p[1][0]=0; p[1][1]=0;
-						p[2][0]=0; p[2][1]=0; 		p[3][0]=0.5; p[3][1]=0;
+						p[0][0]=0.5;	p[0][1]=0;		p[1][0]=0;		p[1][1]=0;
+						p[2][0]=0;		p[2][1]=0; 		p[3][0]=0.5;	p[3][1]=0;
+						break;
+					case B_BESSELCSp:
+						p[0][0]=0.5;	p[0][1]=0;		p[1][0]=0;		p[1][1]=0;
+						p[2][0]=0;		p[2][1]=0; 		p[3][0]=-0.5;	p[3][1]=0;
 						break;
 					case B_BESSELM:
 						p[0][0]=hvp[0]; p[0][1]=hvp[1];	p[1][0]=hvp[2]; p[1][1]=hvp[3];
diff --git a/src/const.h b/src/const.h
index 14373aab..a9bde470 100644
--- a/src/const.h
+++ b/src/const.h
@@ -286,6 +286,7 @@ enum incpol {
 enum beam { // beam types
 	B_BARTON5, // 5th order description of the Gaussian beam
 	B_BESSELCS, // Bessel beam with circularly symmetric energy density
+	B_BESSELCSp, // Alternative Bessel beam with circularly symmetric energy density
 	B_BESSELM, // Generalized Bessel beam
 	B_BESSELLE, // Bessel beam with linearly polarized electric field
 	B_BESSELLM, // Bessel beam with linearly polarized magnetic field
diff --git a/src/param.c b/src/param.c
index 004eaaab..adca0d14 100644
--- a/src/param.c
+++ b/src/param.c
@@ -234,6 +234,10 @@ static const struct subopt_struct beam_opt[]={
 		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
 		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
 		UNDEF,B_BESSELCS},
+	{"besselCSp","<order> <angle> [<x> <y> <z>]","Alternative Bessel beam with circularly symmetric energy density. The half-cone angle "
+		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
+		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
+		UNDEF,B_BESSELCSp},
 	{"besselM","<ReMex> <ImMex> <ReMey> <ImPey> <ReMmx> <ImMmx> <ReMmy> <ImMmy> \n\t<order> <angle> [<x> <y> <z>]",
 		"Generalized Bessel beam. The half-cone angle is measured from the z axis. The half-cone angle and beam order "
 		"are obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
@@ -1025,6 +1029,7 @@ PARSE_FUNC(beam)
 			case B_DAVIS3:
 			case B_BARTON5: if (Narg!=1 && Narg!=4) NargError(Narg,"1 or 4"); break;
 			case B_BESSELCS: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
+			case B_BESSELCSp: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
 			case B_BESSELM: if (Narg!=10 && Narg!=13) NargError(Narg,"10 or 13"); break;
 			case B_BESSELLE: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
 			case B_BESSELLM: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;

From 88f15bcb8000fcfc608ec5689e5382c6979d1e7a Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Tue, 29 Jun 2021 17:01:27 +0700
Subject: [PATCH 16/46] Improved field expressions

---
 .gitignore      |   1 +
 src/GenerateB.c | 172 ++++++++++++++++++------------------------------
 src/githash.h   |   2 +-
 3 files changed, 65 insertions(+), 110 deletions(-)

diff --git a/.gitignore b/.gitignore
index 0ca0f676..f5bafc31 100644
--- a/.gitignore
+++ b/.gitignore
@@ -21,3 +21,4 @@ src/.cproject
 src/.settings/language.settings.xml
 src/.cproject
 src/githash.h
+src/githash.h
diff --git a/src/GenerateB.c b/src/GenerateB.c
index 7c7ba987..14a4d6a4 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -73,7 +73,7 @@ static doublecomplex ktVec[3]; // k_tran/k0
 static double p0;              // amplitude of the incident dipole moment
 static int n0;                 // Bessel beam order
 static double alpha0;          // half-cone angle
-static double hvp[8];		   // Hertz vector potentials' components
+static double hvp[8];		   // Matrix M components
 /* TO ADD NEW BEAM
  * Add here all internal variables (beam parameters), which you initialize in InitBeam() and use in GenerateB()
  * afterwards. If you need local, intermediate variables, put them into the beginning of the corresponding function.
@@ -219,6 +219,7 @@ void InitBeam(void)
 				switch (beamtype) {
 					case B_BESSELCS:
 						tmp_str="circularly symmetric energy density)\n";
+						break;
 					case B_BESSELCSp:
 						tmp_str="circularly symmetric energy density (alternative))\n";
 						break;
@@ -298,13 +299,15 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 	doublecomplex psi0,Q,Q2;
 	doublecomplex v1[3],v2[3],v3[3],gt[6];
 	double ro,ro2,ro4;
-	double x,y,z,x2_s,xy_s,phi,arg,td1[n0+2],td2[n0+2],jn1[n0+2],p[4][2];
+	double x,y,z,x2_s,xy_s;
 	doublecomplex t1,t2,t3,t4,t5,t6,t7,t8,ctemp;
 	const double *ex; // coordinate axis of the beam reference frame
 	double ey[3];
 	double r1[3];
-	double jn2[2]; // for Bessel functions on n and n+1 orders
-	int n1;
+	double fn[5]; // for general functions f(n,ro,phi) of Bessel beams (fn-2, fn-1, fn, fn+1, fn+2 respectively)
+	int n1; // for Bessel beams
+	doublecomplex M[4]; // matrix M for Bessel beams
+	double phi,arg,td1[n0+2],td2[n0+2],jn1[n0+2],K,Kt,Kz; // for Bessel beams
 	const char *fname;
 	/* TO ADD NEW BEAM
 	 * Add here all intermediate variables, which are used only inside this function. You may as well use 't1'-'t8'
@@ -514,8 +517,9 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 		case B_BESSELLM:
 		case B_BESSELTEC:
 		case B_BESSELTMC:
-			t1=WaveNum*sin(alpha0);
-			t2=WaveNum*cos(alpha0);
+			K =fabs(WaveNum);
+			Kt=fabs(WaveNum)*sin(alpha0);
+			Kz=fabs(WaveNum)*cos(alpha0);
 
 			for (i=0;i<local_nvoid_Ndip;i++) {
 				j=3*i;
@@ -527,130 +531,80 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				ro=sqrt(ro2);	// radial distance in a cylindrical coordinate system
 				phi=atan2(y,x);	// angular coordinate in a cylindrical coordinate system
 				// common factor
-				ctemp=cpow(I,n0)*cexp(I*n0*phi)*cexp(I*t2*z)/WaveNum/WaveNum;
-				arg=ro*t1;
+				ctemp=cexp(I*n0*phi)*cexp(I*Kz*z)/K/K;
+				arg=kt*ro;
 				if (arg<ROUND_ERR){
-					if (n0 == 0) jn2[0]=1.0;
-					else jn2[0]=0.0;
-					jn2[1]=0.0;
+					if (n0 == 0) fn[2]=1.0;
+					else fn[2]=0.0;
+					fn[0]=0.0; fn[1]=0.0; fn[3]=0.0; fn[4]=0.0;
 				}
 				else {
-					n1=n0+1;
+					n1=n0+2;
 					bjndd_(&n1, &arg, jn1, td1, td2);
-					jn2[0]=jn1[n0];
-					jn2[1]=jn1[n0+1];
+					if (n0 == 0) {
+						fn[0] = jn1[2]*cexp(-2*I*phi);
+						fn[1] =-jn1[1]*cexp(-I*phi);
+						fn[2] = jn1[0];
+						fn[3] = jn1[1]*cexp(I*phi);
+						fn[4] = jn1[2]*cexp(2*I*phi);
+					}
+					else if (n0 == 1) {
+						fn[0] =-jn1[1]*cexp(-2*I*phi);
+						fn[1] = jn1[0]*cexp(-I*phi);
+						fn[2] = jn1[1];
+						fn[3] = jn1[2]*cexp(I*phi);
+						fn[4] = jn1[3]*cexp(2*I*phi);
+					}
+					else {
+						fn[0] = jn1[n0-2]*cexp(-2*I*phi);
+						fn[1] = jn1[n0-1]*cexp(-I*phi);
+						fn[2] = jn1[n0];
+						fn[3] = jn1[n0+1]*cexp(I*phi);
+						fn[4] = jn1[n0+2]*cexp(2*I*phi);
+					}
 				}
-				switch (beamtype) {
+				switch (beamtype) { // definition of matrix M elements ((Mex,Mey),(Mmx,Mmy))
 					case B_BESSELCS:
-						p[0][0]=0.5;	p[0][1]=0;		p[1][0]=0;		p[1][1]=0;
-						p[2][0]=0;		p[2][1]=0; 		p[3][0]=0.5;	p[3][1]=0;
+						M[0]=0.5;	M[1]=0;
+						M[2]=0;		M[3]=0.5;
 						break;
 					case B_BESSELCSp:
-						p[0][0]=0.5;	p[0][1]=0;		p[1][0]=0;		p[1][1]=0;
-						p[2][0]=0;		p[2][1]=0; 		p[3][0]=-0.5;	p[3][1]=0;
+						M[0]=0.5;	M[1]=0;
+						M[2]=0;		M[3]=-0.5;
 						break;
 					case B_BESSELM:
-						p[0][0]=hvp[0]; p[0][1]=hvp[1];	p[1][0]=hvp[2]; p[1][1]=hvp[3];
-						p[2][0]=hvp[4]; p[2][1]=hvp[5];	p[3][0]=hvp[6]; p[3][1]=hvp[7];
+						M[0]=hvp[0]+I*hvp[1];	M[1]=hvp[2]+I*hvp[3];
+						M[2]=hvp[4]+I*hvp[5];	M[3]=hvp[6]+I*hvp[7];
 						break;
 					case B_BESSELLE:
-						p[0][0]=0; p[0][1]=0;	p[1][0]=0; 	p[1][1]=0;
-						p[2][0]=0; p[2][1]=0; 	p[3][0]=1.; p[3][1]=0;
+						M[0]=0;		M[1]=0;
+						M[2]=0;		M[3]=1;
 						break;
 					case B_BESSELLM:
-						p[0][0]=0; p[0][1]=0;	p[1][0]=-1.; 	p[1][1]=0;
-						p[2][0]=0; p[2][1]=0; 	p[3][0]=0; 		p[3][1]=0;
+						M[0]=0;		M[1]=1;
+						M[2]=0;		M[3]=0;
 						break;
 					case B_BESSELTEC:
-						p[0][0]=0; p[0][1]=0; 	p[1][0]=1./sin(alpha0); p[1][1]=0;
-						p[2][0]=0; p[2][1]=0; 	p[3][0]=0; 				p[3][1]=1./tan(alpha0);
+						M[0]=-K/Kt;		M[1]=0;
+						M[2]=0;			M[3]=Kz/Kt;
 						break;
 					case B_BESSELTMC:
-						p[0][0]=0; p[0][1]=0; 	p[1][0]=0; 					p[1][1]=1./tan(alpha0);
-						p[2][0]=0; p[2][1]=0; 	p[3][0]=-1./sin(alpha0);	p[3][1]=0;
+						M[0]=0; 		M[1]=Kz/Kt;
+						M[2]=K/Kt;		M[2]=0;
 						break;
 					default: break;
 				}
-				t3 = 0; t4 = 0; t5 = 0;
-				if (ro<=ROUND_ERR) {
-					if ((fabs(p[0][0])>=ROUND_ERR) || (fabs(p[0][1])>=ROUND_ERR)) {		//Pex - LMy
-						t3 += (p[0][0]+I*p[0][1])*0.25*(
-								jn2[0]*(cpow(WaveNum,2)*(3+cos(2*alpha0)-2*cos(2*phi)*pow(sin(alpha0),2))));
-						t4 += (p[0][0]+I*p[0][1])*(
-								jn2[0]/4.*(sin(2*phi)*(-2*cpow(WaveNum,2)*pow(sin(alpha0),2))));
-						t5 += (p[0][0]+I*p[0][1])*t2*I*(
-								 n0*cexp(-I*phi));
-					}
-					if ((fabs(p[1][0])>=ROUND_ERR) || (fabs(p[1][1])>=ROUND_ERR)) {		//Pey - LMx
-						t3 += -(p[1][0]+I*p[1][1])*(
-								jn2[0]*0.5*sin(2*phi)*cpow(WaveNum,2)*pow(sin(alpha0),2));
-						t4 += -(p[1][0]+I*p[1][1])*( -
-								jn2[0]*(pow(cos(phi),2)*(cpow(WaveNum,2)) +
-									pow(sin(phi),2)*cpow(WaveNum,2)*pow(cos(alpha0),2)));
-						t5 += -(p[1][0]+I*p[1][1])*t2*(
-								n0*cexp(-I*phi));
-					}
-					if ((fabs(p[2][0])>=ROUND_ERR) || (fabs(p[2][1])>=ROUND_ERR)) { 	//Pmx - LEy
-						t3 += 0;
-						t4 += -(p[2][0]+I*p[2][1])*jn2[0]*t2*WaveNum;
-						t5 += -(p[2][0]+I*p[2][1])*WaveNum*(
-								-jn2[1]*I*t1*sin(phi) -
-								n0*cexp(-I*phi));
-					}
-					if ((fabs(p[3][0])>=ROUND_ERR) || (fabs(p[3][1])>=ROUND_ERR)) {		//Pmy - LEx
-						t3 += (p[3][0]+I*p[3][1])*jn2[0]*t2*WaveNum;
-						t4 += 0;
-						t5 += (p[3][0]+I*p[3][1])*WaveNum*I*(
-								-jn2[1]*t1*cos(phi) +
-								n0*cexp(-I*phi));
-					}
-				}
-				else {
-					if ((fabs(p[0][0])>=ROUND_ERR) || (fabs(p[0][1])>=ROUND_ERR)) {		//Pex - LMy
-						t3 += (p[0][0]+I*p[0][1])*0.25*(
-								jn2[1]*4.*t1/ro*(cos(2*phi)+I*n0*sin(2*phi)) +
-								jn2[0]*(4.*(n0-1)*n0/ro2*cexp(-2*I*phi) +
-										cpow(WaveNum,2)*(3+cos(2*alpha0)-2*cos(2*phi)*pow(sin(alpha0),2))));
-						t4 += (p[0][0]+I*p[0][1])*(
-								jn2[1]*t1/ro*(-I*n0*cos(2*phi)+sin(2*phi)) +
-								jn2[0]/4./ro2*(4.*I*(n0-1)*n0*cos(2*phi) + sin(2*phi)*(4*(n0-1)*n0 -
-									2*cpow(WaveNum*ro,2)*pow(sin(alpha0),2))));
-						t5 += (p[0][0]+I*p[0][1])*t2*I*(
-								-jn2[1]*t1*cos(phi) +
-								 jn2[0]/ro*n0*cexp(-I*phi));
-					}
-					if ((fabs(p[1][0])>=ROUND_ERR) || (fabs(p[1][1])>=ROUND_ERR)) {		//Pey - LMx
-						t3 += -(p[1][0]+I*p[1][1])*(
-								jn2[1]*t1/ro*(I*n0*cos(2*phi)-sin(2*phi)) +
-								jn2[0]/ro2*(-I*(n0-1)*n0*pow(cos(phi),2)+0.5*sin(2*phi)*(-2*(n0-1)*n0 +
-								cpow(WaveNum*ro,2)*pow(sin(alpha0),2)) + I*(n0-1)*n0*pow(sin(phi),2)));
-						t4 += -(p[1][0]+I*p[1][1])*(
-								jn2[1]*t1/ro*(cos(2*phi)+I*n0*sin(2*phi)) -
-								jn2[0]*(pow(cos(phi),2)*(-(n0-1)*n0/ro2 + cpow(WaveNum,2)) +
-									pow(sin(phi),2)*((n0-1)*n0/ro2 + cpow(WaveNum,2)*pow(cos(alpha0),2)) +
-									I*(n0-1)*n0/ro2*sin(2*phi)));
-						t5 += -(p[1][0]+I*p[1][1])*t2*(
-								jn2[1]*I*t1*sin(phi) +
-								jn2[0]/ro*n0*cexp(-I*phi));
-					}
-					if ((fabs(p[2][0])>=ROUND_ERR) || (fabs(p[2][1])>=ROUND_ERR)) { 	//Pmx - LEy
-						t3 += 0;
-						t4 += -(p[2][0]+I*p[2][1])*jn2[0]*t2*WaveNum;
-						t5 += -(p[2][0]+I*p[2][1])*WaveNum*(
-								-jn2[1]*I*t1*sin(phi) -
-								 jn2[0]*cexp(-I*phi)/ro*n0);
-					}
-					if ((fabs(p[3][0])>=ROUND_ERR) || (fabs(p[3][1])>=ROUND_ERR)) {		//Pmy - LEx
-						t3 += (p[3][0]+I*p[3][1])*jn2[0]*t2*WaveNum;
-						t4 += 0;
-						t5 += (p[3][0]+I*p[3][1])*WaveNum*I*(
-								-jn2[1]*t1*cos(phi) +
-								 jn2[0]*cexp(-I*phi)/ro*n0);
-					}
-				}
-				cvMultScal_RVec(t3,ex,v1);
-				cvMultScal_RVec(t4,ey,v2);
-				cvMultScal_RVec(t5,prop,v3);
+
+				t1 = (((K*K+Kz*Kz)/2.0*M[0] +  K*Kz*M[3])*fn[2] +
+						  Kt*Kt/4.0*((M[0]+I*M[1])*fn[0] + (M[0]-I*M[1])*fn[4]));	// Ex
+				t2 = (((K*K+Kz*Kz)/2.0*M[1] -  K*Kz*M[2])*fn[2] +
+						I*Kt*Kt/4.0*((M[0]+I*M[1])*fn[0] - (M[0]-I*M[1])*fn[4]));	// Ey
+				t3 = ((I*Kz*(M[0]+I*M[1]) + K*(M[2]+I*M[3]))*fn[1] -
+					  (I*Kz*(M[0]-I*M[1]) - K*(M[2]-I*M[3]))*fn[3])*Kt/2;			// Ez
+
+				cvMultScal_RVec(t1,ex,v1);
+				cvMultScal_RVec(t2,ey,v2);
+				cvMultScal_RVec(t3,prop,v3);
 				cvAdd2Self(v1,v2,v3);
 				cvMultScal_cmplx(ctemp,v1,b+j);
 			}
diff --git a/src/githash.h b/src/githash.h
index edf5dfcd..3693f88a 100644
--- a/src/githash.h
+++ b/src/githash.h
@@ -1 +1 @@
-#define GITHASH "3fcc7c6"
+#define GITHASH "25b9461"

From d515d92689def583c8eb7d8fbca7161e99101839 Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Thu, 1 Jul 2021 15:59:49 +0700
Subject: [PATCH 17/46] Fixed some problems

---
 src/GenerateB.c | 34 +++++++++++++---------------------
 src/githash.h   |  2 +-
 2 files changed, 14 insertions(+), 22 deletions(-)

diff --git a/src/GenerateB.c b/src/GenerateB.c
index 05f799db..d7b8db48 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -309,9 +309,9 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 	double ey[3];
 	double r1[3];
 	double fn[5]; // for general functions f(n,ro,phi) of Bessel beams (fn-2, fn-1, fn, fn+1, fn+2 respectively)
-	int n1; // for Bessel beams
-	doublecomplex M[4]; // matrix M for Bessel beams
-	double phi,arg,td1[n0+2],td2[n0+2],jn1[n0+2],K,Kt,Kz; // for Bessel beams
+	int n1,N,it; // for Bessel beams
+	doublecomplex M[4],sum[3],fint[3]; // matrix M for Bessel beams
+	double phi,arg,td1[n0+2],td2[n0+2],jn1[n0+2],K,Kt,Kz,r,tht,db; // for Bessel beams
 	const char *fname;
 	/* TO ADD NEW BEAM
 	 * Add here all intermediate variables, which are used only inside this function. You may as well use 't1'-'t8'
@@ -521,9 +521,9 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				x=DotProd(r1,ex);
 				y=DotProd(r1,ey);
 				z=DotProd(r1,prop);
-				r=sqrt(x*x+y*y+z*z);	// radial distance in a spherical coordinate system
+				r=sqrt(x*x+y*y+z*z);		// radial distance in a spherical coordinate system
 				tht=atan2(sqrt(x*x+y*y),z);	// polar angle
-				phi=atan2(y,x);			// azimuthal angle
+				phi=atan2(y,x);				// azimuthal angle
 
 				// Integration
 				N=10;
@@ -539,13 +539,11 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 					sum[2] += fint[2];
 				}
 
-				t3=sum[0]/N;	t4=sum[1]/N;	t5=sum[2]/N;
+				t1=sum[0]/N;	t2=sum[1]/N;	t3=sum[2]/N;
 
-				///printf("\n i: %d \t %g\t %g\t %g\t %g\t %g\t %g",i,creal(t3),cimag(t3),creal(t4),cimag(t4),creal(t5),cimag(t5));
-
-				cvMultScal_RVec(t3,ex,v1);
-				cvMultScal_RVec(t4,ey,v2);
-				cvMultScal_RVec(t5,prop,v3);
+				cvMultScal_RVec(t1,ex,v1);
+				cvMultScal_RVec(t2,ey,v2);
+				cvMultScal_RVec(t3,prop,v3);
 				cvAdd2Self(v1,v2,v3);
 				cvMultScal_cmplx(1.,v1,b+j);
 			}
@@ -572,7 +570,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				phi=atan2(y,x);	// angular coordinate in a cylindrical coordinate system
 				// common factor
 				ctemp=cexp(I*n0*phi)*cexp(I*Kz*z)/K/K;
-				arg=kt*ro;
+				arg=Kt*ro;
 				if (arg<ROUND_ERR){
 					if (n0 == 0) fn[2]=1.0;
 					else fn[2]=0.0;
@@ -584,24 +582,18 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 					if (n0 == 0) {
 						fn[0] = jn1[2]*cexp(-2*I*phi);
 						fn[1] =-jn1[1]*cexp(-I*phi);
-						fn[2] = jn1[0];
-						fn[3] = jn1[1]*cexp(I*phi);
-						fn[4] = jn1[2]*cexp(2*I*phi);
 					}
 					else if (n0 == 1) {
 						fn[0] =-jn1[1]*cexp(-2*I*phi);
 						fn[1] = jn1[0]*cexp(-I*phi);
-						fn[2] = jn1[1];
-						fn[3] = jn1[2]*cexp(I*phi);
-						fn[4] = jn1[3]*cexp(2*I*phi);
 					}
 					else {
 						fn[0] = jn1[n0-2]*cexp(-2*I*phi);
 						fn[1] = jn1[n0-1]*cexp(-I*phi);
-						fn[2] = jn1[n0];
-						fn[3] = jn1[n0+1]*cexp(I*phi);
-						fn[4] = jn1[n0+2]*cexp(2*I*phi);
 					}
+					fn[2] = jn1[0];
+					fn[3] = jn1[1]*cexp(I*phi);
+					fn[4] = jn1[2]*cexp(2*I*phi);
 				}
 				switch (beamtype) { // definition of matrix M elements ((Mex,Mey),(Mmx,Mmy))
 					case B_BESSELCS:
diff --git a/src/githash.h b/src/githash.h
index 3693f88a..c59cecab 100644
--- a/src/githash.h
+++ b/src/githash.h
@@ -1 +1 @@
-#define GITHASH "25b9461"
+#define GITHASH "44cd648"

From 505dd45c21f0761381249f87666ae28ac10dd262 Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Thu, 8 Jul 2021 12:59:02 +0700
Subject: [PATCH 18/46] Fixed some bugs

---
 src/GenerateB.c | 12 ++++++------
 src/githash.h   |  2 +-
 2 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/GenerateB.c b/src/GenerateB.c
index d7b8db48..f8b00020 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -308,10 +308,10 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 	const double *ex; // coordinate axis of the beam reference frame
 	double ey[3];
 	double r1[3];
-	double fn[5]; // for general functions f(n,ro,phi) of Bessel beams (fn-2, fn-1, fn, fn+1, fn+2 respectively)
+	doublecomplex fn[5]; // for general functions f(n,ro,phi) of Bessel beams (fn-2, fn-1, fn, fn+1, fn+2 respectively)
 	int n1,N,it; // for Bessel beams
 	doublecomplex M[4],sum[3],fint[3]; // matrix M for Bessel beams
-	double phi,arg,td1[n0+2],td2[n0+2],jn1[n0+2],K,Kt,Kz,r,tht,db; // for Bessel beams
+	double phi,arg,td1[n0+3],td2[n0+3],jn1[n0+3],K,Kt,Kz,r,tht,db; // for Bessel beams
 	const char *fname;
 	/* TO ADD NEW BEAM
 	 * Add here all intermediate variables, which are used only inside this function. You may as well use 't1'-'t8'
@@ -591,9 +591,9 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 						fn[0] = jn1[n0-2]*cexp(-2*I*phi);
 						fn[1] = jn1[n0-1]*cexp(-I*phi);
 					}
-					fn[2] = jn1[0];
-					fn[3] = jn1[1]*cexp(I*phi);
-					fn[4] = jn1[2]*cexp(2*I*phi);
+					fn[2] = jn1[n0];
+					fn[3] = jn1[n0+1]*cexp(I*phi);
+					fn[4] = jn1[n0+2]*cexp(2*I*phi);
 				}
 				switch (beamtype) { // definition of matrix M elements ((Mex,Mey),(Mmx,Mmy))
 					case B_BESSELCS:
@@ -632,7 +632,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				t2 = (((K*K+Kz*Kz)/2.0*M[1] -  K*Kz*M[2])*fn[2] +
 						I*Kt*Kt/4.0*((M[0]+I*M[1])*fn[0] - (M[0]-I*M[1])*fn[4]));	// Ey
 				t3 = ((I*Kz*(M[0]+I*M[1]) + K*(M[2]+I*M[3]))*fn[1] -
-					  (I*Kz*(M[0]-I*M[1]) - K*(M[2]-I*M[3]))*fn[3])*Kt/2;			// Ez
+					  (I*Kz*(M[0]-I*M[1]) - K*(M[2]-I*M[3]))*fn[3])*Kt/2.0;			// Ez
 
 				cvMultScal_RVec(t1,ex,v1);
 				cvMultScal_RVec(t2,ey,v2);
diff --git a/src/githash.h b/src/githash.h
index c59cecab..4cb0b4c2 100644
--- a/src/githash.h
+++ b/src/githash.h
@@ -1 +1 @@
-#define GITHASH "44cd648"
+#define GITHASH "d515d92"

From 93df21cbb6811af2f68c6d56d798366d6829a511 Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Wed, 21 Jul 2021 01:09:19 +0700
Subject: [PATCH 19/46] Command line changes

---
 src/GenerateB.c | 39 ++++++++++++++++++++-------------------
 src/const.h     |  6 +++---
 src/param.c     | 16 ++++++++--------
 3 files changed, 31 insertions(+), 30 deletions(-)

diff --git a/src/GenerateB.c b/src/GenerateB.c
index f8b00020..0b81973e 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -197,21 +197,22 @@ void InitBeam(void)
 		case B_BESSELM:
 		case B_BESSELLE:
 		case B_BESSELLM:
-		case B_BESSELTEC:
-		case B_BESSELTMC:
+		case B_BESSELTEL:
+		case B_BESSELTML:
 			if (surface) PrintError("Currently, Bessel incident beam is not supported for '-surf'");
 			// initialize parameters
+			n0=round(beam_pars[0]);
+			alpha0=beam_pars[1];
+			TestPositive(n0,"Bessel beam order");
 			if (beamtype==B_BESSELM) {
-				n_par = 8;
-				hvp[0] = beam_pars[0]; hvp[1] = beam_pars[1];
-				hvp[2] = beam_pars[2]; hvp[3] = beam_pars[3];
-				hvp[4] = beam_pars[4]; hvp[5] = beam_pars[5];
-				hvp[6] = beam_pars[6]; hvp[7] = beam_pars[7];
+				n_par=8;
+				hvp[0]=beam_pars[2]; hvp[1]=beam_pars[3];
+				hvp[2]=beam_pars[4]; hvp[3]=beam_pars[5];
+				hvp[4]=beam_pars[6]; hvp[5]=beam_pars[7];
+				hvp[6]=beam_pars[8]; hvp[7]=beam_pars[9];
 			}
-			else n_par = 0;
-			n0=round(beam_pars[0 + n_par]);
-			alpha0 = beam_pars[1 + n_par];
-			vCopy(beam_pars+2 + n_par,beam_center_0);
+			else n_par=0;
+			vCopy(beam_pars+2+n_par,beam_center_0);
 			beam_asym=(beam_Npars==(5 + n_par) && (beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0));
 			symR=symX=symY=symZ=FALSE;
 			if (!beam_asym) vInit(beam_center);
@@ -236,10 +237,10 @@ void InitBeam(void)
 					case B_BESSELLM:
 						tmp_str="linear magnetic field)\n";
 						break;
-					case B_BESSELTEC:
+					case B_BESSELTEL:
 						tmp_str="forming the TE Bessel beam)\n";
 						break;
-					case B_BESSELTMC:
+					case B_BESSELTML:
 						tmp_str="forming the TM Bessel beam)\n";
 						break;
 					default: LogError(ONE_POS,"Incompatibility error in GenerateB");
@@ -553,8 +554,8 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 		case B_BESSELM:
 		case B_BESSELLE:
 		case B_BESSELLM:
-		case B_BESSELTEC:
-		case B_BESSELTMC:
+		case B_BESSELTEL:
+		case B_BESSELTML:
 			K =fabs(WaveNum);
 			Kt=fabs(WaveNum)*sin(alpha0);
 			Kz=fabs(WaveNum)*cos(alpha0);
@@ -605,8 +606,8 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 						M[2]=0;		M[3]=-0.5;
 						break;
 					case B_BESSELM:
-						M[0]=hvp[0]+I*hvp[1];	M[1]=hvp[2]+I*hvp[3];
-						M[2]=hvp[4]+I*hvp[5];	M[3]=hvp[6]+I*hvp[7];
+						M[0]=hvp[0]+I*hvp[4];	M[1]=hvp[1]+I*hvp[5];
+						M[2]=hvp[2]+I*hvp[6];	M[3]=hvp[3]+I*hvp[7];
 						break;
 					case B_BESSELLE:
 						M[0]=0;		M[1]=0;
@@ -616,11 +617,11 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 						M[0]=0;		M[1]=1;
 						M[2]=0;		M[3]=0;
 						break;
-					case B_BESSELTEC:
+					case B_BESSELTEL:
 						M[0]=-K/Kt;		M[1]=0;
 						M[2]=0;			M[3]=Kz/Kt;
 						break;
-					case B_BESSELTMC:
+					case B_BESSELTML:
 						M[0]=0; 		M[1]=Kz/Kt;
 						M[2]=K/Kt;		M[2]=0;
 						break;
diff --git a/src/const.h b/src/const.h
index 67af956d..569a440c 100644
--- a/src/const.h
+++ b/src/const.h
@@ -107,7 +107,7 @@ the compilation may fail or produce wrong results. If you still want to try, ena
 // sizes of some arrays
 #define MAX_NMAT         15   // maximum number of different refractive indices (<256)
 #define MAX_N_SH_PARMS   25   // maximum number of shape parameters
-#define MAX_N_BEAM_PARMS 10   // maximum number of beam parameters
+#define MAX_N_BEAM_PARMS 13   // maximum number of beam parameters
 
 // sizes of filenames and other strings
 /* There is MAX_PATH constant that equals 260 on Windows. However, even this OS allows ways to override this limit. On
@@ -291,8 +291,8 @@ enum beam { // beam types
 	B_BESSELM, // Generalized Bessel beam
 	B_BESSELLE, // Bessel beam with linearly polarized electric field
 	B_BESSELLM, // Bessel beam with linearly polarized magnetic field
-	B_BESSELTEC, // Bessel beam forming TE Bessel beam 
-	B_BESSELTMC, // Bessel beam forming TM Bessel beam 
+	B_BESSELTEL, // Bessel beam forming TE Bessel beam
+	B_BESSELTML, // Bessel beam forming TM Bessel beam
 	B_DAVIS3,  // 3rd order description of the Gaussian beam
 	B_DIPOLE,  // field of a point dipole
 	B_LMINUS,  // 1st order description of the Gaussian beam
diff --git a/src/param.c b/src/param.c
index 5c7746e0..740dce91 100644
--- a/src/param.c
+++ b/src/param.c
@@ -242,7 +242,7 @@ static const struct subopt_struct beam_opt[]={
 		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
 		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
 		UNDEF,B_BESSELCSp},
-	{"besselM","<ReMex> <ImMex> <ReMey> <ImPey> <ReMmx> <ImMmx> <ReMmy> <ImMmy> \n\t<order> <angle> [<x> <y> <z>]",
+	{"besselM","<order> <angle> <ReMex> <ReMey> <ReMmx> <ReMmy> [<ImMex> <ImMey> <ImMmx> <ImMmy> <x> <y> <z>]",
 		"Generalized Bessel beam. The half-cone angle is measured from the z axis. The half-cone angle and beam order "
 		"are obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
 		"(zero, by default). Coordinate arguments are in um.",
@@ -255,14 +255,14 @@ static const struct subopt_struct beam_opt[]={
 		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
 		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
 		UNDEF,B_BESSELLM},
-	{"besselTEC","<order> <angle> [<x> <y> <z>]","Bessel beam forming TE Bessel beam. The half-cone angle "
+	{"besselTEL","<order> <angle> [<x> <y> <z>]","Bessel beam forming TE Bessel beam. The half-cone angle "
 		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
 		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
-		UNDEF,B_BESSELTEC},
-	{"besselTMC","<order> <angle> [<x> <y> <z>]","Bessel beam forming TM Bessel beam. The half-cone angle "
+		UNDEF,B_BESSELTEL},
+	{"besselTML","<order> <angle> [<x> <y> <z>]","Bessel beam forming TM Bessel beam. The half-cone angle "
 		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
 		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
-		UNDEF,B_BESSELTMC},
+		UNDEF,B_BESSELTML},
 	{"davis3","<width> [<x> <y> <z>]","3rd order approximation of the Gaussian beam (by Davis). The beam width is "
 		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
 		"(zero, by default). All arguments are in um.",UNDEF,B_DAVIS3},
@@ -1035,11 +1035,11 @@ PARSE_FUNC(beam)
 			case B_BESSELASD: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
 			case B_BESSELCS: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
 			case B_BESSELCSp: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
-			case B_BESSELM: if (Narg!=10 && Narg!=13) NargError(Narg,"10 or 13"); break;
+			case B_BESSELM: if (Narg!=6 && Narg!=10 && Narg!=13) NargError(Narg,"6, 10, or 13"); break;
 			case B_BESSELLE: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
 			case B_BESSELLM: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
-			case B_BESSELTEC: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
-			case B_BESSELTMC: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
+			case B_BESSELTEL: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
+			case B_BESSELTML: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
 			default: TestNarg(Narg,need); break;
 		}
 		/* TO ADD NEW BEAM

From 1df9ca2b8ffcfaf5041a4f23acd8163a23b6e06f Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Wed, 25 Aug 2021 12:53:39 +0700
Subject: [PATCH 20/46] Added -beam center

---
 .gitignore      |   1 +
 src/GenerateB.c |  29 ++++++++-----
 src/param.c     | 106 +++++++++++++++++++++++++++++-------------------
 3 files changed, 84 insertions(+), 52 deletions(-)

diff --git a/.gitignore b/.gitignore
index f5bafc31..47a20c37 100644
--- a/.gitignore
+++ b/.gitignore
@@ -22,3 +22,4 @@ src/.settings/language.settings.xml
 src/.cproject
 src/githash.h
 src/githash.h
+*.h
diff --git a/src/GenerateB.c b/src/GenerateB.c
index 0b81973e..0a426423 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -42,6 +42,8 @@ extern const double beam_pars[];
 extern const char *beam_fnameY;
 extern const char *beam_fnameX;
 extern const opt_index opt_beam;
+extern const bool use_beam_center;
+extern const bool use_beam_subopt;
 
 extern void bjndd_(int *n, double *x, double *bj, double *dj, double *fj);
 
@@ -86,7 +88,6 @@ void InitBeam(void)
 // initialize beam; produce description string
 {
 	double w0; // beam width
-	int n_par; // for besselM
 	const char *tmp_str; // temporary string
 	/* TO ADD NEW BEAM
 	 * Add here all intermediate variables, which are used only inside this function.
@@ -94,11 +95,14 @@ void InitBeam(void)
 	// initialization of global option index for error messages
 	opt=opt_beam;
 	// beam initialization
+	if (use_beam_center==true && use_beam_subopt==true) LogError(ONE_POS,"Beam center coordinates can not "
+			"be defined both in -beam and in -beam_center options. Please define in only one of the options.");
 	switch (beamtype) {
 		case B_PLANE:
 			if (IFROOT) beam_descr="plane wave";
 			beam_asym=false;
 			if (surface) {
+				if (use_beam_center==true) LogError(ONE_POS,"Plane wave currently does not support -beam_center with -surf");
 				if (prop_0[2]==0) PrintError("Ambiguous setting of beam propagating along the surface. Please specify "
 					"the incident direction to have (arbitrary) small positive or negative z-component");
 				if (msubInf && prop_0[2]>0) PrintError("Perfectly reflecting surface ('-surf ... inf') is incompatible "
@@ -142,7 +146,10 @@ void InitBeam(void)
 			}
 			return;
 		case B_DIPOLE:
-			vCopy(beam_pars,beam_center_0);
+			if (use_beam_subopt==true){
+				LogWarning(EC_WARN,ALL_POS,"Providing beam center coordinates from the -beam option will be deprecated soon. Please use -beam_center option instead.");
+				vCopy(beam_pars,beam_center_0);
+			}
 			if (surface) {
 				if (beam_center_0[2]<=-hsub)
 					PrintErrorHelp("External dipole should be placed strictly above the surface");
@@ -165,8 +172,11 @@ void InitBeam(void)
 			// initialize parameters
 			w0=beam_pars[0];
 			TestPositive(w0,"beam width");
-			vCopy(beam_pars+1,beam_center_0);
-			beam_asym=(beam_Npars==4 && (beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0));
+			if (use_beam_subopt==true){
+				LogWarning(EC_WARN,ALL_POS,"Providing beam center coordinates from the -beam option will be deprecated soon. Please use -beam_center option instead.");
+				vCopy(beam_pars+1,beam_center_0);
+			}
+			beam_asym=(beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0);
 			if (!beam_asym) vInit(beam_center);
 			s=1/(WaveNum*w0);
 			s2=s*s;
@@ -203,17 +213,14 @@ void InitBeam(void)
 			// initialize parameters
 			n0=round(beam_pars[0]);
 			alpha0=beam_pars[1];
-			TestPositive(n0,"Bessel beam order");
+			TestNonNegative(n0,"Bessel beam order");
 			if (beamtype==B_BESSELM) {
-				n_par=8;
 				hvp[0]=beam_pars[2]; hvp[1]=beam_pars[3];
 				hvp[2]=beam_pars[4]; hvp[3]=beam_pars[5];
 				hvp[4]=beam_pars[6]; hvp[5]=beam_pars[7];
 				hvp[6]=beam_pars[8]; hvp[7]=beam_pars[9];
 			}
-			else n_par=0;
-			vCopy(beam_pars+2+n_par,beam_center_0);
-			beam_asym=(beam_Npars==(5 + n_par) && (beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0));
+			beam_asym=(beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0);
 			symR=symX=symY=symZ=FALSE;
 			if (!beam_asym) vInit(beam_center);
 			// beam info
@@ -405,7 +412,9 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 			}
 			else for (i=0;i<local_nvoid_Ndip;i++) { // standard (non-surface) plane wave
 				j=3*i;
-				ctemp=imExp(WaveNum*DotProd(DipoleCoord+j,prop)); // ctemp=exp(ik*r.a)
+				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
+				ctemp=imExp(WaveNum*DotProd(r1,prop)); // ctemp=exp(ik*r.a)
+				//ctemp=imExp(WaveNum*DotProd(DipoleCoord+j,prop)); // ctemp=exp(ik*r.a)
 				cvMultScal_RVec(ctemp,ex,b+j); // b[i]=ctemp*ex
 			}
 			return;
diff --git a/src/param.c b/src/param.c
index 740dce91..8158dd9e 100644
--- a/src/param.c
+++ b/src/param.c
@@ -95,6 +95,7 @@ bool emulLinebuf;  // whether to emulate line buffering of stdout, defined as ex
 extern const char *avg_string;
 // defined and initialized in GenerateB.c
 extern const char *beam_descr;
+extern double beam_center_0[3];
 // defined and initialized in make_particle.c
 extern const bool volcor_used;
 extern const char *sh_form_str1,*sh_form_str2;
@@ -117,6 +118,8 @@ bool calc_asym;       // Calculate the asymmetry-parameter
 bool calc_mat_force;  // Calculate the scattering force by matrix-evaluation
 bool store_force;     // Write radiation pressure per dipole to file
 bool store_ampl;      // Write amplitude matrix to file
+bool use_beam_center; // Whether -beam_center argument is used or not
+bool use_beam_subopt; // Whether beam center coordinates are taken from -beam sub-option
 int phi_int_type;     // type of phi integration (each bit determines whether to calculate with different multipliers)
 // used in calculator.c
 bool avg_inc_pol;            // whether to average CC over incident polarization
@@ -230,43 +233,36 @@ static const struct subopt_struct beam_opt[]={
 		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
 		"(zero, by default). All arguments are in um. This is recommended option for simulation of the Gaussian beam.",
 		UNDEF,B_BARTON5},
-	{"besselASD","<order> <angle> [<x> <y> <z>]","Angular spectrum decomposition of Bessel beam. The half-cone angle "
-		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
-		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
-		UNDEF,B_BESSELASD},
-	{"besselCS","<order> <angle> [<x> <y> <z>]","Bessel beam with circularly symmetric energy density. The half-cone angle "
-		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
-		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
-		UNDEF,B_BESSELCS},
-	{"besselCSp","<order> <angle> [<x> <y> <z>]","Alternative Bessel beam with circularly symmetric energy density. The half-cone angle "
-		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
-		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
-		UNDEF,B_BESSELCSp},
-	{"besselM","<order> <angle> <ReMex> <ReMey> <ReMmx> <ReMmy> [<ImMex> <ImMey> <ImMmx> <ImMmy> <x> <y> <z>]",
-		"Generalized Bessel beam. The half-cone angle is measured from the z axis. The half-cone angle and beam order "
-		"are obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
-		"(zero, by default). Coordinate arguments are in um.",
+	{"besselASD","<order> <angle>","Angular spectrum decomposition of Bessel beam. The half-cone angle (in rad) "
+		"is measured from the z axis. The beam order and half-cone angle are obligatory.",
+		2,B_BESSELASD},
+	{"besselCS","<order> <angle>","Bessel beam with circularly symmetric energy density. The half-cone angle (in rad) "
+		"is measured from the z axis. The beam order and half-cone angle are obligatory.",
+		2,B_BESSELCS},
+	{"besselCSp","<order> <angle>","Alternative Bessel beam with circularly symmetric energy density. The half-cone angle (in rad) "
+		"is measured from the z axis. The beam order and half-cone angle are obligatory.",
+		2,B_BESSELCSp},
+	{"besselM","<order> <angle> <ReMex> <ReMey> <ReMmx> <ReMmy> [<ImMex> <ImMey> <ImMmx> <ImMmy>]",
+		"Generalized Bessel beam. The half-cone angle (in rad) is measured from the z axis. The beam order and half-cone angle "
+		" and 4 real components of matrix M are obligatory and 4 imaginary components of matrix M are optional "
+		"(zero, by default).",
 		UNDEF,B_BESSELM},
-	{"besselLE","<order> <angle> [<x> <y> <z>]","Bessel beam with linearly polarized electric field. The half-cone angle "
-		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
-		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
-		UNDEF,B_BESSELLE},
-	{"besselLM","<order> <angle> [<x> <y> <z>]","Bessel beam with linearly polarized magnetic field. The half-cone angle "
-		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
-		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
-		UNDEF,B_BESSELLM},
-	{"besselTEL","<order> <angle> [<x> <y> <z>]","Bessel beam forming TE Bessel beam. The half-cone angle "
-		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
-		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
-		UNDEF,B_BESSELTEL},
-	{"besselTML","<order> <angle> [<x> <y> <z>]","Bessel beam forming TM Bessel beam. The half-cone angle "
-		"is measured from the z axis. The half-cone angle and beam order are obligatory and x, y, z coordinates of the "
-		"center of the beam (in laboratory reference frame) are optional (zero, by default). Coordinate arguments are in um.",
-		UNDEF,B_BESSELTML},
+	{"besselLE","<order> <angle>","Bessel beam with linearly polarized electric field. The half-cone angle (in rad) "
+		"is measured from the z axis. The beam order and half-cone angle are obligatory.",
+		2,B_BESSELLE},
+	{"besselLM","<order> <angle>","Bessel beam with linearly polarized magnetic field. The half-cone angle (in rad) "
+		"is measured from the z axis. The beam order and half-cone angle are obligatory.",
+		2,B_BESSELLM},
+	{"besselTEL","<order> <angle>","Bessel beam forming TE Bessel beam. The half-cone angle (in rad) "
+		"is measured from the z axis. The beam order and half-cone angle are obligatory.",
+		2,B_BESSELTEL},
+	{"besselTML","<order> <angle>","Bessel beam forming TM Bessel beam. The half-cone angle (in rad) "
+		"is measured from the z axis. The beam order and half-cone angle are obligatory.",
+		2,B_BESSELTML},
 	{"davis3","<width> [<x> <y> <z>]","3rd order approximation of the Gaussian beam (by Davis). The beam width is "
 		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
 		"(zero, by default). All arguments are in um.",UNDEF,B_DAVIS3},
-	{"dipole","<x> <y> <z>","Field of a unit point dipole placed at x, y, z coordinates (in laboratory reference "
+	{"dipole","[<x> <y> <z>]","Field of a unit point dipole placed at x, y, z coordinates (in laboratory reference "
 		"frame). All arguments are in um. Orientation of the dipole is determined by -prop command line option."
 		"Implies '-scat_matr none'. If '-surf' is used, dipole position should be above the surface.",3,B_DIPOLE},
 	{"lminus","<width> [<x> <y> <z>]","Simplest approximation of the Gaussian beam. The beam width is obligatory and "
@@ -371,6 +367,7 @@ void InitBeam(void);
 PARSE_FUNC(alldir_inp);
 PARSE_FUNC(anisotr);
 PARSE_FUNC(asym);
+PARSE_FUNC(beam_center);
 PARSE_FUNC(beam);
 PARSE_FUNC(chp_dir);
 PARSE_FUNC(chp_load);
@@ -449,6 +446,10 @@ static struct opt_struct options[]={
 		"reference frame). '-m' then accepts 6 arguments per each domain. Can not be used with '-pol cldr', all SO "
 		"formulations, and '-rect_dip'.",0,NULL},
 	{PAR(asym),"","Calculate the asymmetry vector. Implies '-Csca' and '-vec'",0,NULL},
+	{PAR(beam_center),"<x> <y> <z>","Sets the center of the beam with respect to the initial point in time. "
+				"For plane, Gaussian, and Bessel field it determines the phase in space. "
+				"For a dipole and an electron it determines the position in space.\n"
+		"Default: 0 0 0",3,NULL},
 	{PAR(beam),"<type> [<args>]","Sets the incident beam, either predefined or 'read' from file. All parameters of "
 		"predefined beam types (if present) are floats.\n"
 		"Default: plane",UNDEF,beam_opt},
@@ -1011,6 +1012,14 @@ PARSE_FUNC(asym)
 	calc_vec = true;
 	calc_Csca = true;
 }
+PARSE_FUNC(beam_center)
+{
+	if (Narg!=3) NargError(Narg,"-beam_center requires 3 arguments");
+	use_beam_center = true;
+	ScanDoubleError(argv[1],&beam_center_0[0]);
+	ScanDoubleError(argv[2],&beam_center_0[1]);
+	ScanDoubleError(argv[3],&beam_center_0[2]);
+}
 PARSE_FUNC(beam)
 {
 	int i,j,need;
@@ -1031,15 +1040,22 @@ PARSE_FUNC(beam)
 		switch (beamtype) {
 			case B_LMINUS:
 			case B_DAVIS3:
-			case B_BARTON5: if (Narg!=1 && Narg!=4) NargError(Narg,"1 or 4"); break;
-			case B_BESSELASD: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
-			case B_BESSELCS: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
-			case B_BESSELCSp: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
-			case B_BESSELM: if (Narg!=6 && Narg!=10 && Narg!=13) NargError(Narg,"6, 10, or 13"); break;
-			case B_BESSELLE: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
-			case B_BESSELLM: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
-			case B_BESSELTEL: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
-			case B_BESSELTML: if (Narg!=2 && Narg!=5) NargError(Narg,"2 or 5"); break;
+			case B_BARTON5:
+				if (Narg!=1 && Narg!=4) NargError(Narg,"1 or 4");
+				if (Narg==4) use_beam_subopt=true;
+				break;
+			case B_DIPOLE:
+				if (Narg!=0 && Narg!=3) NargError(Narg,"0 or 3");
+				if (Narg==3) use_beam_subopt=true;
+				break;
+			case B_BESSELASD: if (Narg!=2) NargError(Narg,"2"); break;
+			case B_BESSELCS: if (Narg!=2) NargError(Narg,"2"); break;
+			case B_BESSELCSp: if (Narg!=2) NargError(Narg,"2"); break;
+			case B_BESSELM: if (Narg!=6 && Narg!=10) NargError(Narg,"6 or 10"); break;
+			case B_BESSELLE: if (Narg!=2) NargError(Narg,"2"); break;
+			case B_BESSELLM: if (Narg!=2) NargError(Narg,"2"); break;
+			case B_BESSELTEL: if (Narg!=2) NargError(Narg,"2"); break;
+			case B_BESSELTML: if (Narg!=2) NargError(Narg,"2"); break;
 			default: TestNarg(Narg,need); break;
 		}
 		/* TO ADD NEW BEAM
@@ -1935,6 +1951,11 @@ void InitVariables(void)
 	orient_used=false;
 	directory="";
 	lambda=TWO_PI;
+	use_beam_center=false;
+	use_beam_subopt=false;
+	beam_center_0[0]=0;
+	beam_center_0[1]=0;
+	beam_center_0[2]=0;
 	// initialize ref_index of scatterer
 	Nmat=Nmat_given=1;
 	ref_index[0]=1.5;
@@ -2471,6 +2492,7 @@ void PrintInfo(void)
 		fprintf(logfile,"Volume-equivalent size parameter: "GFORM"\n",ka_eq);
 		// log incident beam and polarization
 		fprintf(logfile,"\n---In laboratory reference frame:---\nIncident beam: %s\n",beam_descr);
+		fprintf(logfile,"Incident beam center position: "GFORMDEF3V"\n",COMP3V(beam_center_0));
 		fprintf(logfile,"Incident propagation vector: "GFORMDEF3V"\n",COMP3V(prop_0));
 		if (beamtype==B_DIPOLE) fprintf(logfile,"(dipole orientation)\n");
 		else { // polarizations are not shown for dipole incident field

From 99523dbb4d1200b6221eec59883179bb43d9b082 Mon Sep 17 00:00:00 2001
From: Stefania Glukhova <s.glukhova@g.nsu.ru>
Date: Thu, 30 Sep 2021 17:11:18 +0700
Subject: [PATCH 21/46] Added vortex phase + minor changes

Redefined a parallel polarization of BB taking into account its additional phase.
---
 src/GenerateB.c | 127 ++++++++++++++++++++++++------------------------
 1 file changed, 64 insertions(+), 63 deletions(-)

diff --git a/src/GenerateB.c b/src/GenerateB.c
index 0a426423..50d23dcf 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -75,7 +75,8 @@ static doublecomplex ktVec[3]; // k_tran/k0
 static double p0;              // amplitude of the incident dipole moment
 static int n0;                 // Bessel beam order
 static double alpha0;          // half-cone angle
-static double hvp[8];		   // Matrix M components
+static doublecomplex K,Kt,Kz;  // wave vector components
+static double M[4];		   	   // Matrix M components
 /* TO ADD NEW BEAM
  * Add here all internal variables (beam parameters), which you initialize in InitBeam() and use in GenerateB()
  * afterwards. If you need local, intermediate variables, put them into the beginning of the corresponding function.
@@ -214,11 +215,41 @@ void InitBeam(void)
 			n0=round(beam_pars[0]);
 			alpha0=beam_pars[1];
 			TestNonNegative(n0,"Bessel beam order");
-			if (beamtype==B_BESSELM) {
-				hvp[0]=beam_pars[2]; hvp[1]=beam_pars[3];
-				hvp[2]=beam_pars[4]; hvp[3]=beam_pars[5];
-				hvp[4]=beam_pars[6]; hvp[5]=beam_pars[7];
-				hvp[6]=beam_pars[8]; hvp[7]=beam_pars[9];
+			K =fabs(WaveNum);
+			Kt=fabs(WaveNum)*sin(alpha0);
+			Kz=fabs(WaveNum)*cos(alpha0);
+			switch (beamtype) { // definition of matrix M elements ((Mex,Mey),(Mmx,Mmy))
+				case B_BESSELCS:
+					M[0]=0.5;	M[1]=0;
+					M[2]=0;		M[3]=0.5;
+					break;
+				case B_BESSELCSp:
+					M[0]=0.5;	M[1]=0;
+					M[2]=0;		M[3]=-0.5;
+					break;
+				case B_BESSELM:
+					M[0]=beam_pars[2]+I*beam_pars[6];
+					M[1]=beam_pars[3]+I*beam_pars[7];
+					M[2]=beam_pars[4]+I*beam_pars[8];
+					M[3]=beam_pars[5]+I*beam_pars[9];
+					break;
+				case B_BESSELLE:
+					M[0]=0;		M[1]=0;
+					M[2]=0;		M[3]=1;
+					break;
+				case B_BESSELLM:
+					M[0]=0;		M[1]=1;
+					M[2]=0;		M[3]=0;
+					break;
+				case B_BESSELTEL:
+					M[0]=-K/Kt;		M[1]=0;
+					M[2]=0;			M[3]=Kz/Kt;
+					break;
+				case B_BESSELTML:
+					M[0]=0; 		M[1]=Kz/Kt;
+					M[2]=K/Kt;		M[2]=0;
+					break;
+				default: break;
 			}
 			beam_asym=(beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0);
 			symR=symX=symY=symZ=FALSE;
@@ -227,33 +258,33 @@ void InitBeam(void)
 			if (IFROOT) {
 				switch (beamtype) {
 					case B_BESSELASD:
-						tmp_str="angular spectrum decomposition)\n";
+						tmp_str="angular spectrum decomposition";
 						break;
 					case B_BESSELCS:
-						tmp_str="circularly symmetric energy density)\n";
+						tmp_str="circularly symmetric energy density";
 						break;
 					case B_BESSELCSp:
-						tmp_str="circularly symmetric energy density (alternative))\n";
+						tmp_str="circularly symmetric energy density (alternative)";
 						break;
 					case B_BESSELM:
-						tmp_str="generalized)\n";
+						tmp_str="generalized";
 						break;
 					case B_BESSELLE:
-						tmp_str="linear electric field)\n";
+						tmp_str="linear electric field";
 						break;
 					case B_BESSELLM:
-						tmp_str="linear magnetic field)\n";
+						tmp_str="linear magnetic field";
 						break;
 					case B_BESSELTEL:
-						tmp_str="forming the TE Bessel beam)\n";
+						tmp_str="forming the TE Bessel beam";
 						break;
 					case B_BESSELTML:
-						tmp_str="forming the TM Bessel beam)\n";
+						tmp_str="forming the TM Bessel beam";
 						break;
 					default: LogError(ONE_POS,"Incompatibility error in GenerateB");
 				}
 				beam_descr=dyn_sprintf("Bessel beam (%s)\n"
-									   "\tOrder=""%d""\n\t""Half-cone angle: "GFORMDEF"\n"
+									   "\tOrder: ""%d""\n\t""Half-cone angle: "GFORMDEF"\n"
 									   "\tCenter position: "GFORMDEF3V,tmp_str,n0,alpha0,COMP3V(beam_center_0));
 			}
 			return;
@@ -316,10 +347,11 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 	const double *ex; // coordinate axis of the beam reference frame
 	double ey[3];
 	double r1[3];
-	doublecomplex fn[5]; // for general functions f(n,ro,phi) of Bessel beams (fn-2, fn-1, fn, fn+1, fn+2 respectively)
 	int n1,N,it; // for Bessel beams
-	doublecomplex M[4],sum[3],fint[3]; // matrix M for Bessel beams
-	double phi,arg,td1[n0+3],td2[n0+3],jn1[n0+3],K,Kt,Kz,r,tht,db; // for Bessel beams
+	doublecomplex vort;  // vortex phase of Bessel beam rotated on 90 deg
+	doublecomplex fn[5]; // for general functions f(n,ro,phi) of Bessel beams (fn-2, fn-1, fn, fn+1, fn+2 respectively)
+	doublecomplex sum[3],fint[3];
+	double phi,arg,td1[n0+3],td2[n0+3],jn1[n0+3],r,tht,db; // for Bessel beams
 	const char *fname;
 	/* TO ADD NEW BEAM
 	 * Add here all intermediate variables, which are used only inside this function. You may as well use 't1'-'t8'
@@ -525,6 +557,8 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 			}
 			return;
 		case B_BESSELASD:
+			if (which==INCPOL_X) vort = cpow(I,n0);
+			else vort = 1.;
 			for (i=0;i<local_nvoid_Ndip;i++) {
 				j=3*i;
 				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
@@ -555,7 +589,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				cvMultScal_RVec(t2,ey,v2);
 				cvMultScal_RVec(t3,prop,v3);
 				cvAdd2Self(v1,v2,v3);
-				cvMultScal_cmplx(1.,v1,b+j);
+				cvMultScal_cmplx(vort,v1,b+j);
 			}
 			return;
 		case B_BESSELCS:
@@ -565,10 +599,8 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 		case B_BESSELLM:
 		case B_BESSELTEL:
 		case B_BESSELTML:
-			K =fabs(WaveNum);
-			Kt=fabs(WaveNum)*sin(alpha0);
-			Kz=fabs(WaveNum)*cos(alpha0);
-
+			if (which==INCPOL_X) vort = cpow(I,n0);
+			else vort = 1.;
 			for (i=0;i<local_nvoid_Ndip;i++) {
 				j=3*i;
 				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
@@ -579,12 +611,12 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				ro=sqrt(ro2);	// radial distance in a cylindrical coordinate system
 				phi=atan2(y,x);	// angular coordinate in a cylindrical coordinate system
 				// common factor
-				ctemp=cexp(I*n0*phi)*cexp(I*Kz*z)/K/K;
+				ctemp=cexp(I*n0*phi)*cexp(I*Kz*z)/K/K*vort;
 				arg=Kt*ro;
 				if (arg<ROUND_ERR){
-					if (n0 == 0) fn[2]=1.0;
-					else fn[2]=0.0;
-					fn[0]=0.0; fn[1]=0.0; fn[3]=0.0; fn[4]=0.0;
+					if (n0 == 0) fn[2]=1.;
+					else fn[2]=0;
+					fn[0]=0; fn[1]=0; fn[3]=0; fn[4]=0;
 				}
 				else {
 					n1=n0+2;
@@ -605,44 +637,13 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 					fn[3] = jn1[n0+1]*cexp(I*phi);
 					fn[4] = jn1[n0+2]*cexp(2*I*phi);
 				}
-				switch (beamtype) { // definition of matrix M elements ((Mex,Mey),(Mmx,Mmy))
-					case B_BESSELCS:
-						M[0]=0.5;	M[1]=0;
-						M[2]=0;		M[3]=0.5;
-						break;
-					case B_BESSELCSp:
-						M[0]=0.5;	M[1]=0;
-						M[2]=0;		M[3]=-0.5;
-						break;
-					case B_BESSELM:
-						M[0]=hvp[0]+I*hvp[4];	M[1]=hvp[1]+I*hvp[5];
-						M[2]=hvp[2]+I*hvp[6];	M[3]=hvp[3]+I*hvp[7];
-						break;
-					case B_BESSELLE:
-						M[0]=0;		M[1]=0;
-						M[2]=0;		M[3]=1;
-						break;
-					case B_BESSELLM:
-						M[0]=0;		M[1]=1;
-						M[2]=0;		M[3]=0;
-						break;
-					case B_BESSELTEL:
-						M[0]=-K/Kt;		M[1]=0;
-						M[2]=0;			M[3]=Kz/Kt;
-						break;
-					case B_BESSELTML:
-						M[0]=0; 		M[1]=Kz/Kt;
-						M[2]=K/Kt;		M[2]=0;
-						break;
-					default: break;
-				}
 
-				t1 = (((K*K+Kz*Kz)/2.0*M[0] +  K*Kz*M[3])*fn[2] +
-						  Kt*Kt/4.0*((M[0]+I*M[1])*fn[0] + (M[0]-I*M[1])*fn[4]));	// Ex
-				t2 = (((K*K+Kz*Kz)/2.0*M[1] -  K*Kz*M[2])*fn[2] +
-						I*Kt*Kt/4.0*((M[0]+I*M[1])*fn[0] - (M[0]-I*M[1])*fn[4]));	// Ey
+				t1 = (((K*K+Kz*Kz)/2.*M[0] +  K*Kz*M[3])*fn[2] +
+						  Kt*Kt/4.*((M[0]+I*M[1])*fn[0] + (M[0]-I*M[1])*fn[4]));	// Ex
+				t2 = (((K*K+Kz*Kz)/2.*M[1] -  K*Kz*M[2])*fn[2] +
+						I*Kt*Kt/4.*((M[0]+I*M[1])*fn[0] - (M[0]-I*M[1])*fn[4]));	// Ey
 				t3 = ((I*Kz*(M[0]+I*M[1]) + K*(M[2]+I*M[3]))*fn[1] -
-					  (I*Kz*(M[0]-I*M[1]) - K*(M[2]-I*M[3]))*fn[3])*Kt/2.0;			// Ez
+					  (I*Kz*(M[0]-I*M[1]) - K*(M[2]-I*M[3]))*fn[3])*Kt/2.;			// Ez
 
 				cvMultScal_RVec(t1,ex,v1);
 				cvMultScal_RVec(t2,ey,v2);

From 899eeb6e6d5b9c3333795ab47e025e33eaab8a30 Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Tue, 9 Nov 2021 15:45:50 +0700
Subject: [PATCH 22/46] minor changes

---
 .DS_Store                       | Bin 0 -> 10244 bytes
 .cproject                       |  44 +++++
 .project                        |  26 +++
 .settings/language.settings.xml |  15 ++
 src/.DS_Store                   | Bin 0 -> 14340 bytes
 src/GenerateB.c                 |  12 +-
 src/Makefile                    |  12 +-
 src/fort/bessel.f90             | 304 ++++++++++++++++++++++++++++++++
 src/githash.h                   |   2 +-
 9 files changed, 402 insertions(+), 13 deletions(-)
 create mode 100644 .DS_Store
 create mode 100644 .cproject
 create mode 100644 .project
 create mode 100644 .settings/language.settings.xml
 create mode 100644 src/.DS_Store
 create mode 100644 src/fort/bessel.f90

diff --git a/.DS_Store b/.DS_Store
new file mode 100644
index 0000000000000000000000000000000000000000..5f3237dcd1eb331f06f5e1dcfdd723e9758ace3b
GIT binary patch
literal 10244
zcmeHMU2GIp6h3F#(iunSw3Htg+AdZ>VFLw9r7F1HZH3Z8Nw=jx{FK?90VYgm%FgT-
zY#OUZV?cdWiGPU?#=pRWqUeJ!#;A!g5s@gtNMhoPzG#5Nn5gI8J6pO7zCnV?+|9jb
z&b{ZHJNKJ&=FYhb0GP-bs{x__AX8;jyPcZr6gJN4HAM<~<`6~F2XN_UgV$-hnQNrO
zju3$mfe?WZfe?WZfm;Cq+Ot`aRYAixL?A>UL|_^L_I`*`Wi%epDM9(GgBqR!5G|)}
zUg(<g0Im}aXgr`(f^t=|DY6F)R53^~P^i;*l!+6K2XsnMp$;h20fU(_$WV~aPI^%;
z4j30SY(oS>1g=GZ<?b>VU_u`JnfZI#cGEP*!l{kw%71vFD}XYRcOk>F{25XwOQb5m
z0tdz*2Y#_6)|E(BLN|0m5;|ZTq@bfj`dEo{IgFBJuXKL=vqVmTUb5H*?XZ>TO42fl
zElc}LG-i=io#e*o48tsz<rutLgn<Xy(t7}g!F8n4<K9?+)amq?ZFzoE(>avN$}477
z%9XMz?@k?X$5X!U=e&fT-O0E<*R|7yYdyWgGRH@>+NA6Fy5*Qzu3#A^iR>D%9K#(?
zxH-r0xNb@e$cn6tXbUGMn(tc^i>_&1KN*Wow61B2MVr^QOin8Dyv9`z^o|^~M;-Sl
z-8mHuUav4)@Y5}O3T1>3t=abSNwJ!;b%oWOFRVtnO;u+{`ucYa3=WNGTFx_jO<VV^
zyxFe%rZ=Khd9=9BjO%RAnt58(K*qImqYjN!XLLK0BVn`6wo}$4LOPRmZF{@xS-#~u
zLxa9~*k@zRP|?ufu;*s|BsVr_k$oXm!{+E2W6ItRGwTsmloN9nEM9W=@>R{P8xjw9
z^_;EJs%z9*b^bu!@~pIN_K#bJe_%-WGNxl#&i-M-)A6l+mYG$mF{bo6`lxxfMysw`
zct<2Mm`huSa+ZHYYm{YSt3DD{v{UjfgBG*ZHJGNsM<Vr+yJUGM>rZA)YDKrYEOM`+
z>2jY(OA{ty>PkiPl)i)XaE0n>b*-!!O24hAO<Q!esOx2|OBu+Em5I(;^+8z~%($bY
zbkm;bdnnQ-YhTEF*u>qs=l6`64$aM$kgShHhFE`_VVFj+g2?8`7FjzZ4|@mntl2Y8
z9w!WKj%<@<{uHU7S?Vw>-<=-pWrLdK<SlY$!dm#W+!%lQB6p?6_;TS=je-DhEF0rZ
zg0C%f2b6sl)Ik#@U<>S_z&rxS;CXlr-iK500el8u!#TJBzrgSC2V90L@E4ZjY^*{J
zt1*I$uny~S1vcY4Y{3L}VK;8W9_+*2xCi&5j{DHXG0dWeNAPic0-waE@Hu<|U&Q11
zI=+MN;t4#7pWx^C4W7Yo@dEycKjB6E6))jsydud`wNxX`m6l4&q$a6VN=Tce?c(00
zLMROvuSwF0zZy!xi$OYZ{ZMMyw7GLjSNAO&N<YkD!85mZ-uwko7E$Xrv`xF7@YI5H
z&UAY2=S9)M{ha$ksgF{KEm~ZsHuO^<n1@S4vk<acB@0aXER$Yxr`n)ZP^buY=`vzx
zQJ4sJMXaGglPEd`+qAkt)ygRL6t252Ml1$Q>;0;#l~WXov5j@aLck=FWQN6*e6zg!
zOE?4H!$tUwy!&q~Lm3xf6qjO*e0d|rF^TQiLH@iQdojg*dW1YWjTyAjA+J6}em#Mc
z_$W@{V|Wyw!DqQ|AIF#QWqbwSz&G(Nd>h}xQ}`jC#*gr0{1m^!@9;eST;ju9i+va`
zUG?F7D(l#;!!}dq@fGwLVbVt7i@yP`ejxB|f9B>`0pt7=p#_?YH(O+z%}hyR!xAD8
zA`l`FA`l`FB5-36C=+I)?EJsuzyJTgF_VQ>LIgqtZb<~Nygk*Ppj#_stfhC!&f23?
z_flnr$xR8$RjA>|@kIG?JTdGz{vN7KHpuPybv)>s5|pcx3|A*APV;a2p8;Y1f1{4l
L!u<b#n*aX`oOl<Q

literal 0
HcmV?d00001

diff --git a/.cproject b/.cproject
new file mode 100644
index 00000000..2e0e559b
--- /dev/null
+++ b/.cproject
@@ -0,0 +1,44 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<?fileVersion 4.0.0?><cproject storage_type_id="org.eclipse.cdt.core.XmlProjectDescriptionStorage">
+	<storageModule moduleId="org.eclipse.cdt.core.settings">
+		<cconfiguration id="org.eclipse.linuxtools.cdt.autotools.core.toolChain.465099999">
+			<storageModule buildSystemId="org.eclipse.cdt.managedbuilder.core.configurationDataProvider" id="org.eclipse.linuxtools.cdt.autotools.core.toolChain.465099999" moduleId="org.eclipse.cdt.core.settings" name="Build (GNU)">
+				<externalSettings/>
+				<extensions>
+					<extension id="org.eclipse.cdt.core.MachO64" point="org.eclipse.cdt.core.BinaryParser"/>
+					<extension id="org.eclipse.cdt.core.Cygwin_PE" point="org.eclipse.cdt.core.BinaryParser"/>
+					<extension id="org.eclipse.cdt.core.PE" point="org.eclipse.cdt.core.BinaryParser"/>
+					<extension id="org.eclipse.cdt.core.GNU_ELF" point="org.eclipse.cdt.core.BinaryParser"/>
+					<extension id="org.eclipse.cdt.core.ELF" point="org.eclipse.cdt.core.BinaryParser"/>
+					<extension id="org.eclipse.cdt.core.GCCErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
+				</extensions>
+			</storageModule>
+			<storageModule moduleId="cdtBuildSystem" version="4.0.0">
+				<configuration buildProperties="" id="org.eclipse.linuxtools.cdt.autotools.core.toolChain.465099999" name="Build (GNU)" optionalBuildProperties="" parent="org.eclipse.cdt.build.core.emptycfg">
+					<folderInfo id="org.eclipse.linuxtools.cdt.autotools.core.toolChain.465099999.574064567" name="/" resourcePath="">
+						<toolChain id="org.eclipse.linuxtools.cdt.autotools.core.toolChain.2112245766" name="GNU Autotools Toolchain" superClass="org.eclipse.linuxtools.cdt.autotools.core.toolChain">
+							<targetPlatform id="org.eclipse.linuxtools.cdt.autotools.core.toolchain.targetPlatform.1847333728" isAbstract="false" name="GNU Autotools Target Platform" superClass="org.eclipse.linuxtools.cdt.autotools.core.toolchain.targetPlatform"/>
+							<builder id="org.eclipse.linuxtools.cdt.autotools.core.toolchain.builder.1569401276" managedBuildOn="false" name="Autotools Makefile Generator.Build (GNU)" superClass="org.eclipse.linuxtools.cdt.autotools.core.toolchain.builder"/>
+							<tool id="org.eclipse.linuxtools.cdt.autotools.core.gnu.toolchain.tool.configure.1375696790" name="configure" superClass="org.eclipse.linuxtools.cdt.autotools.core.gnu.toolchain.tool.configure"/>
+							<tool id="org.eclipse.linuxtools.cdt.autotools.core.toolchain.tool.autogen.1526597061" name="autogen.sh" superClass="org.eclipse.linuxtools.cdt.autotools.core.toolchain.tool.autogen"/>
+							<tool id="org.eclipse.linuxtools.cdt.autotools.core.toolchain.tool.gcc.130554431" name="GCC C Compiler" superClass="org.eclipse.linuxtools.cdt.autotools.core.toolchain.tool.gcc">
+								<inputType id="cdt.managedbuild.tool.gnu.c.compiler.input.729455874" superClass="cdt.managedbuild.tool.gnu.c.compiler.input"/>
+							</tool>
+							<tool id="org.eclipse.linuxtools.cdt.autotools.core.toolchain.tool.gpp.2044062187" name="GCC C++ Compiler" superClass="org.eclipse.linuxtools.cdt.autotools.core.toolchain.tool.gpp"/>
+						</toolChain>
+					</folderInfo>
+				</configuration>
+			</storageModule>
+			<storageModule moduleId="org.eclipse.cdt.core.externalSettings"/>
+		</cconfiguration>
+	</storageModule>
+	<storageModule moduleId="cdtBuildSystem" version="4.0.0">
+		<project id="adda.null.1450599415" name="adda"/>
+	</storageModule>
+	<storageModule moduleId="scannerConfiguration">
+		<autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId=""/>
+	</storageModule>
+	<storageModule moduleId="org.eclipse.cdt.core.LanguageSettingsProviders"/>
+	<storageModule moduleId="refreshScope"/>
+	<storageModule moduleId="org.eclipse.cdt.make.core.buildtargets"/>
+</cproject>
\ No newline at end of file
diff --git a/.project b/.project
new file mode 100644
index 00000000..5f126b26
--- /dev/null
+++ b/.project
@@ -0,0 +1,26 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<projectDescription>
+	<name>adda</name>
+	<comment></comment>
+	<projects>
+	</projects>
+	<buildSpec>
+		<buildCommand>
+			<name>org.eclipse.cdt.managedbuilder.core.genmakebuilder</name>
+			<triggers>clean,full,incremental,</triggers>
+			<arguments>
+			</arguments>
+		</buildCommand>
+		<buildCommand>
+			<name>org.eclipse.cdt.managedbuilder.core.ScannerConfigBuilder</name>
+			<triggers>full,incremental,</triggers>
+			<arguments>
+			</arguments>
+		</buildCommand>
+	</buildSpec>
+	<natures>
+		<nature>org.eclipse.cdt.core.cnature</nature>
+		<nature>org.eclipse.cdt.managedbuilder.core.managedBuildNature</nature>
+		<nature>org.eclipse.cdt.managedbuilder.core.ScannerConfigNature</nature>
+	</natures>
+</projectDescription>
diff --git a/.settings/language.settings.xml b/.settings/language.settings.xml
new file mode 100644
index 00000000..fb867b74
--- /dev/null
+++ b/.settings/language.settings.xml
@@ -0,0 +1,15 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<project>
+	<configuration id="org.eclipse.linuxtools.cdt.autotools.core.toolChain.465099999" name="Build (GNU)">
+		<extension point="org.eclipse.cdt.core.LanguageSettingsProvider">
+			<provider copy-of="extension" id="org.eclipse.cdt.ui.UserLanguageSettingsProvider"/>
+			<provider-reference id="org.eclipse.cdt.core.ReferencedProjectsLanguageSettingsProvider" ref="shared-provider"/>
+			<provider copy-of="extension" id="org.eclipse.cdt.autotools.core.LibtoolGCCBuildCommandParser"/>
+			<provider class="org.eclipse.cdt.managedbuilder.language.settings.providers.GCCBuiltinSpecsDetector" console="false" env-hash="-1689697387348940254" id="org.eclipse.cdt.managedbuilder.core.GCCBuiltinSpecsDetector" keep-relative-paths="false" name="CDT GCC Built-in Compiler Settings" parameter="${COMMAND} ${FLAGS} -E -P -v -dD &quot;${INPUTS}&quot;" prefer-non-shared="true">
+				<language-scope id="org.eclipse.cdt.core.gcc"/>
+				<language-scope id="org.eclipse.cdt.core.g++"/>
+			</provider>
+			<provider-reference id="org.eclipse.cdt.managedbuilder.core.MBSLanguageSettingsProvider" ref="shared-provider"/>
+		</extension>
+	</configuration>
+</project>
\ No newline at end of file
diff --git a/src/.DS_Store b/src/.DS_Store
new file mode 100644
index 0000000000000000000000000000000000000000..236a333b043031bf36f5c2278a224cdae6c3e251
GIT binary patch
literal 14340
zcmeHNTWlOx89x8`HtSv6lO~}_@TRLc6>V``$4Rl>v}k<^ZAcRbZ(KW<X0w+`Jk9LR
zW@mS8<EF9@<)NiTeWK!0(Fep$1PLfayns{+fd?KSAQd4Via>=2Kq@Z*B>4U_v(8-B
zCJzWHVrDgS=A85W=lth8|2gMBXGaJ@ll9_$A%=wzDsB$71RkFdBE_NS;(WeCR~u3Y
z_hH<4*Mt}ni$_eWkT<P-2pvvPki_!s^0tH>kVk=H0!4rDU-A;786rKPBT}L(VjyB5
zVjyB5VjyDRb{OEb7nd4$!sr<>5HS!ju+9L_4=LOnrrmJO3FXv*2fOf`&n~>Y@Xl^K
zr={F5?S^Ykh#Xwxh$3`E$=za*BaZZxi%YxVniD$Wf@IAo$E}&%9SX_Xk)D!pL1`z9
zo)H5P17QYsA*oALL{3z3m#_mbcy{nSn7-lNfrrrE{XWo?44_rF>^w?uvA?Gm0{A%a
zRiTT5$cmaUpphQdiEiGOR6sZ7Vn8Y;W^r~gA*RJKghQyS7-;(hB(8c+9azEwE)T7$
z;$m1c$=2o)0j(rsUWqpFq>IabO(ah(Q28ah;-0o#%U4Xpt_=_Wij=nYj?ON%OO2~f
zWfrZaOf6Td+mpHK8IGN_EHmGH&*h&q^rft}ZOSUwaz<INN&%y&19EoWC>O1zNvmEi
z+EO;-WT-JUmeqEwt{xm68BC3gk6jr|t&Wcj52g+t_`sDbF?IXEgNJ6bm&{VxdfqWQ
zawl%l<HXmWumGGM$u^r8_h$-LsUq{VFTU)_u^UrPJKHkNcK*8A&RBOm(UY8CICc6=
zBCFliK!au~HNz^~PwG`0VOHz2(eNV$t9+uWbN+n6GV7(Xoz=D!a%Q1!=4$$cX=aR%
z>PYLe3suWBPgu6W#hhBG>B}|F3uP^wwykPyN*1<YpnM0V)op!NN1;YTpGML4w)N&Z
zFBH4ld-pwi@7p&r`bhflk>j&B`m`-~ZB1-XoCd??nsLF<tEX~yK`$4L^2NC&qgY#<
zZy2_bH}#X{TuF~@p~2XVz8yPvy|+J^bO5&mn$U%M-nd*hYAf1+s>(W2$vug)Md)<Q
zDsnAFReK%fp!R!{dy;23XR4~>S#$;NPrg5K(njM|E$0A-62pm;mtYz(&2~}_Bpyo6
znYp}f#<ZeS&sgH&<b1>7Kc*dZ5+6-$PcEQ`OK74UbJ8Y~Q^|8&?Grh>HdE2dtkQMl
zp=lr5lT4oCyoq8_Dzt0I&c5W)<S|wIxq8}O%vJT7CD`l@H~k~3D*GDgT-xEHQM1-F
z=QvX{$_)d<0p0413Uwg;@pojW45S}$I%lBSS(501^sp0;!9_`m5lk0Pi1Qf!tKvoR
zig-<YTf8ZLBz`G=EB+|n6*q~fle(yz;<Sx+(Ow#)hiH_>Xq+Z#hEC8dW#}v|l0i?C
zP0O@GtMm*#N6*s>^dh}PpQg{#tMmnWjlN3Xq;Jvd^d0&>U8kSWPw5x*HvNu%Pk*4l
z&`tU~{X=P2I+QL&RkkYqN>bUa3@hWx!^$D$xH6+GC^_Y6#Zs1?1}M!T_*AojZu$zs
z<`A?S?u4RTZ9UNXAA9`BhmYPl1MRI|IkdKIf6v{idmni4;Mk)R>n7;fY|~7=#xE`2
zH%_F*ON$6t>kT;u6T9ze4!T>z&>5C<7%KX*$|F|ma?t~ORSXra!;Ri|KcYvqPAA&G
zZ%D<k)D#&_^p6~fVen~fZgk%$qU1yphaQPx7;5cqbaxt2AtU|$(}z*abxr+m+4x)H
zZSjuytN15uyqC7p4tgIA!?GvoaXKz-J417Hj<R%~@>HY}mC2&Zu<~c<3O!3}^fB1@
zCt>BEqL=A2^jZ2GEd5LLW%>$zjlK>$|1Mpl@6j9dLwb{b>{|S9VDEpTcLO$j%x}Z=
zw_7$`vZklqMNzG`weP(4${Se7n-*TOikswC7ClSQR`!3Ia*a&2Y+7YF5!jsYKO#2V
zld`;PVMjo^DBcB|@$5R3rE?Q<v!rw4#V3Gw+%jGovyiPI#s3EjtB01g@AkMTs_Qnf
zZW}l#o8nuzCq8@^%3pyldMj<%P4S_7L><^7G%+BzD4oDXw8HlNQG|9dUp~oB(U49l
zw>jXFGFKa71NuvTUh?n*%AzY`AYve5AYwoWc6qzy9(Wqh5~f^UI6_k{PorYUGmR$1
z6tE`t>2*AFnA~-_hYn2DydMt86#{Y=T<K7Kyesy}#Zl8D>d0g9!Qz3pMhhw4OM12J
zf>a3$kSUg1pt0m^f(|Ssyy*DQohX|Z^j2pk%+{+Ow!GLtxso9-Hnv`_C3~VIE(Oj4
zm>aJIx010odLiT>@RIC9w*g%dl|Y%yg}2OZpsFa<mOnm^3H6a=<Uh#-TMK5W*TYN~
zoCEIF`bN&mCg?!fY%@M|hq!=WE9VTHY=8`w30{22c9h5#Tl4eBT=;O^z}3+w1=MfI
z-U;;#k12ZA!$n*?1}@k^<g+*)QIlcT*<O57v5<2WYy<P+t*6IzTAg~l8U{u$+s<uD
z2J2+rymhuq7Fya+OI)Bl$<?2IT(LvhWXiy7(Bhm>a^;okg%(S2rk#;nLClnLd^#EE
zQE5$HSru5G8+q1i;aE$qHp2&6#11cc@qKdky##%-7@vF|%a&7cH4OBOv^TG`iZjfd
zVCf4^tNixK{3+)={He0Gn&hp;*k<NJcpWlq`zv9qWVSZN2U`!z^5NT1Hu}S_HFM-c
z#eu4c{bC%y17cLN)Y7JILn@$=WawuehT70pu<zGM^5R9s9F(*uKDQ2OBbnJ;BA^Ld
zlH!%<aqHmTt;+eq#H@^(g4#*GypnNOlGpVO`<iX(R(+eDaYg(8X#XGW|KTY`SHwWX
zK*YeE%|M5v{%{;2zTw~K`~N$;k&*Th0}%t8GC=LqndwPDXag93YnQ@(9yeotfSWJ8
yOA$PL9|9u6pW}^5koy28&94a8oKT7)E=3Xkk3Iy9_Ww+OwEqw6y8qwy|NjPGJIR~?

literal 0
HcmV?d00001

diff --git a/src/GenerateB.c b/src/GenerateB.c
index 50d23dcf..4e972388 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -252,7 +252,7 @@ void InitBeam(void)
 				default: break;
 			}
 			beam_asym=(beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0);
-			symR=symX=symY=symZ=FALSE;
+			symR=symX=symY=symZ=false;
 			if (!beam_asym) vInit(beam_center);
 			// beam info
 			if (IFROOT) {
@@ -663,11 +663,11 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 	 * add a case above. Identifier ('B_...') should be defined inside 'enum beam' in const.h. This case should set
 	 * complex vector 'b', describing the incident field in the particle reference frame. It is set inside the cycle for
 	 * each dipole of the particle and is calculated using
-	 * 1) 'DipoleCoord' – array of dipole coordinates;
-	 * 2) 'prop' – propagation direction of the incident field;
-	 * 3) 'ex' – direction of incident polarization;
-	 * 4) 'ey' – complementary unity vector of polarization (orthogonal to both 'prop' and 'ex');
-	 * 5) 'beam_center' – beam center in the particle reference frame (automatically calculated from 'beam_center_0'
+	 * 1) 'DipoleCoord' ďż˝ array of dipole coordinates;
+	 * 2) 'prop' ďż˝ propagation direction of the incident field;
+	 * 3) 'ex' ďż˝ direction of incident polarization;
+	 * 4) 'ey' ďż˝ complementary unity vector of polarization (orthogonal to both 'prop' and 'ex');
+	 * 5) 'beam_center' ďż˝ beam center in the particle reference frame (automatically calculated from 'beam_center_0'
 	 *                    defined in InitBeam).
 	 * If the new beam type is compatible with '-surf', include here the corresponding code. For that you will need
 	 * the variables, related to surface - see vars.c after "// related to a nearby surface".
diff --git a/src/Makefile b/src/Makefile
index a1a959a8..cf2b8874 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -89,7 +89,7 @@ VALID_OPTS := DEBUG DEBUGFULL FFT_TEMPERTON PRECISE_TIMING NOT_USE_LOCK ONLY_LOC
 # Debug mode. By default, release configuration is used (no debug, no warnings, maximum optimization). DEBUG turns on
 # producing debugging symbols (-g) and warnings and brings optimization down to O1. DEBUGFULL turns off optimization 
 # completely and turns on additional diagnostic messages in the source code (debug.c/h).
-override OPTIONS += DEBUG
+#override OPTIONS += DEBUG
 #override OPTIONS += DEBUGFULL
 
 # Not clear if that is beneficial
@@ -169,14 +169,14 @@ override EXTRA_FLAGS +=
 #FFTW3_LIB_PATH := $(FFTWLIB)
 #FFTW3_INC_PATH := $(HOME)/include
 #FFTW3_LIB_PATH := $(HOME)/lib
-FFTW3_INC_PATH := "C:/fftw"
-FFTW3_LIB_PATH := "C:/fftw"
+FFTW3_INC_PATH := "/opt/homebrew/include"
+FFTW3_LIB_PATH := "/opt/homebrew/lib"
 
 # --Fortran library path--
 # If your environment does not specify search path for Fortran libraries, you may get errors during linking of ADDA.
 # For instance, this may happen on macOS. Then uncomment the following line and modify the path if needed. 
 # This variable can also be defined in the enviroment or in the command line of make (see explanation above for OPTIONS) 
-#FORT_LIB_PATH := /usr/local/gfortran/lib
+FORT_LIB_PATH := /usr/local/gfortran/lib
 
 #=======================================================================================================================
 # !!! End of control section. Everything below is not designed to be modified by user. However, advanced users may wish
@@ -192,7 +192,7 @@ CSOURCE := ADDAmain.c CalculateE.c calculator.c chebyshev.c cmplx.c comm.c cross
 # Fortran files are located in src/fort folder, other files may be added below
 FSOURCE := d07hre.f d09hre.f d113re.f d132re.f dadhre.f dchhre.f dcuhre.f dfshre.f dinhre.f drlhre.f dtrhre.f \
            propaesplibreintadda.f
-F90SOURCE := special_functions.f90 
+F90SOURCE := bessel.f90
 # C++ files are located in src/cpp folder, other files may be added below
 CPPSOURCE :=
 
@@ -385,7 +385,7 @@ ifeq ($(COMPILER),gnu)
   # Use gfortran if available (GCC 4 and later), otherwise try g77
   ifeq ($(shell which gfortran > /dev/null 2>&1 && echo 0),0)
     CF    := gfortran
-    FLIBS += -lgfortran -lquadmath
+    FLIBS += -lgfortran
   else
     # This is not expected to work for f90 sources but we keep it for now
     $(warning Cannot locate gfortran - trying to continue with g77. If any issues arise, install gfortran)
diff --git a/src/fort/bessel.f90 b/src/fort/bessel.f90
new file mode 100644
index 00000000..6609b381
--- /dev/null
+++ b/src/fort/bessel.f90
@@ -0,0 +1,304 @@
+subroutine bjndd ( n, x, bj, dj, fj )
+
+!*****************************************************************************80
+!
+!! BJNDD computes Bessel functions Jn(x) and first and second derivatives.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However,
+!    they give permission to incorporate this routine into a user program
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    11 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the order.
+!
+!    Input, real ( kind = 8 ) X, the argument.
+!
+!    Output, real ( kind = 8 ) BJ(N+1), DJ(N+1), FJ(N+1), the values of
+!    Jn(x), Jn'(x) and Jn''(x) in the last entries.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) bj(n+1)
+  real ( kind = 8 ) bs
+  real ( kind = 8 ) dj(n+1)
+  real ( kind = 8 ) f
+  real ( kind = 8 ) f0
+  real ( kind = 8 ) f1
+  real ( kind = 8 ) fj(n+1)
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) m
+  integer ( kind = 4 ) mt
+  integer ( kind = 4 ) nt
+  real ( kind = 8 ) x
+
+  do nt = 1, 900
+    mt = int ( 0.5D+00 * log10 ( 6.28D+00 * nt ) &
+      - nt * log10 ( 1.36D+00 * abs ( x ) / nt ) )
+    if ( 20 < mt ) then
+      exit
+    end if
+  end do
+
+  m = nt
+  bs = 0.0D+00
+  f0 = 0.0D+00
+  f1 = 1.0D-35
+  do k = m, 0, -1
+    f = 2.0D+00 * ( k + 1.0D+00 ) * f1 / x - f0
+    if ( k <= n ) then
+      bj(k+1) = f
+    end if
+    if ( k == 2 * int ( k / 2 ) ) then
+      bs = bs + 2.0D+00 * f
+    end if
+    f0 = f1
+    f1 = f
+  end do
+
+  do k = 0, n
+    bj(k+1) = bj(k+1) / ( bs - f )
+  end do
+
+  dj(1) = -bj(2)
+  fj(1) = -1.0D+00 * bj(1) - dj(1) / x
+  do k = 1, n
+    dj(k+1) = bj(k) - k * bj(k+1) / x
+    fj(k+1) = ( k * k / ( x * x ) - 1.0D+00 ) * bj(k+1) - dj(k+1) / x
+  end do
+
+  return
+end
+subroutine cik01 ( z, cbi0, cdi0, cbi1, cdi1, cbk0, cdk0, cbk1, cdk1 )
+
+!*****************************************************************************80
+!
+!! CIK01: modified Bessel I0(z), I1(z), K0(z) and K1(z) for complex argument.
+!
+!  Discussion:
+!
+!    This procedure computes the modified Bessel functions I0(z), I1(z),
+!    K0(z), K1(z), and their derivatives for a complex argument.
+!
+!  Licensing:
+!
+!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However,
+!    they give permission to incorporate this routine into a user program
+!    provided that the copyright is acknowledged.
+!
+!  Modified:
+!
+!    31 July 2012
+!
+!  Author:
+!
+!    Shanjie Zhang, Jianming Jin
+!
+!  Reference:
+!
+!    Shanjie Zhang, Jianming Jin,
+!    Computation of Special Functions,
+!    Wiley, 1996,
+!    ISBN: 0-471-11963-6,
+!    LC: QA351.C45.
+!
+!  Parameters:
+!
+!    Input, complex ( kind = 8 ) Z, the argument.
+!
+!    Output, complex ( kind = 8 ) CBI0, CDI0, CBI1, CDI1, CBK0, CDK0, CBK1,
+!    CDK1, the values of I0(z), I0'(z), I1(z), I1'(z), K0(z), K0'(z), K1(z),
+!    and K1'(z).
+!
+  implicit none
+
+  real ( kind = 8 ), save, dimension ( 12 ) :: a = (/ &
+    0.125D+00,           7.03125D-02,&
+    7.32421875D-02,      1.1215209960938D-01,&
+    2.2710800170898D-01, 5.7250142097473D-01,&
+    1.7277275025845D+00, 6.0740420012735D+00,&
+    2.4380529699556D+01, 1.1001714026925D+02,&
+    5.5133589612202D+02, 3.0380905109224D+03 /)
+  real ( kind = 8 ) a0
+  real ( kind = 8 ), save, dimension ( 10 ) :: a1 = (/ &
+    0.125D+00,            0.2109375D+00, &
+    1.0986328125D+00,     1.1775970458984D+01, &
+    2.1461706161499D+002, 5.9511522710323D+03, &
+    2.3347645606175D+05,  1.2312234987631D+07, &
+    8.401390346421D+08,   7.2031420482627D+10 /)
+  real ( kind = 8 ), save, dimension ( 12 ) :: b = (/ &
+   -0.375D+00,           -1.171875D-01, &
+   -1.025390625D-01,     -1.4419555664063D-01, &
+   -2.7757644653320D-01, -6.7659258842468D-01, &
+   -1.9935317337513D+00, -6.8839142681099D+00, &
+   -2.7248827311269D+01, -1.2159789187654D+02, &
+   -6.0384407670507D+02, -3.3022722944809D+03 /)
+  complex ( kind = 8 ) ca
+  complex ( kind = 8 ) cb
+  complex ( kind = 8 ) cbi0
+  complex ( kind = 8 ) cbi1
+  complex ( kind = 8 ) cbk0
+  complex ( kind = 8 ) cbk1
+  complex ( kind = 8 ) cdi0
+  complex ( kind = 8 ) cdi1
+  complex ( kind = 8 ) cdk0
+  complex ( kind = 8 ) cdk1
+  complex ( kind = 8 ) ci
+  complex ( kind = 8 ) cr
+  complex ( kind = 8 ) cs
+  complex ( kind = 8 ) ct
+  complex ( kind = 8 ) cw
+  integer ( kind = 4 ) k
+  integer ( kind = 4 ) k0
+  real ( kind = 8 ) pi
+  real ( kind = 8 ) w0
+  complex ( kind = 8 ) z
+  complex ( kind = 8 ) z1
+  complex ( kind = 8 ) z2
+  complex ( kind = 8 ) zr
+  complex ( kind = 8 ) zr2
+
+  pi = 3.141592653589793D+00
+  ci = cmplx ( 0.0D+00, 1.0D+00, kind = 8 )
+  a0 = abs ( z )
+  z2 = z * z
+  z1 = z
+
+  if ( a0 == 0.0D+00 ) then
+    cbi0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cbi1 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+    cdi0 = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+    cdi1 = cmplx ( 0.5D+00, 0.0D+00, kind = 8 )
+    cbk0 = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    cbk1 = cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    cdk0 = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    cdk1 = - cmplx ( 1.0D+30, 0.0D+00, kind = 8 )
+    return
+  end if
+
+  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
+    z1 = -z
+  end if
+
+  if ( a0 <= 18.0D+00 ) then
+
+    cbi0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 50
+      cr = 0.25D+00 * cr * z2 / ( k * k )
+      cbi0 = cbi0 + cr
+      if ( abs ( cr / cbi0 ) < 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    cbi1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 50
+      cr = 0.25D+00 * cr * z2 / ( k * ( k + 1 ) )
+      cbi1 = cbi1 + cr
+      if ( abs ( cr / cbi1 ) < 1.0D-15 ) then
+        exit
+      end if
+    end do
+
+    cbi1 = 0.5D+00 * z1 * cbi1
+
+  else
+
+    if ( a0 < 35.0D+00 ) then
+      k0 = 12
+    else if ( a0 < 50.0D+00 ) then
+      k0 = 9
+    else
+      k0 = 7
+    end if
+
+    ca = exp ( z1 ) / sqrt ( 2.0D+00 * pi * z1 )
+    cbi0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    zr = 1.0D+00 / z1
+    do k = 1, k0
+      cbi0 = cbi0 + a(k) * zr ** k
+    end do
+    cbi0 = ca * cbi0
+    cbi1 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, k0
+      cbi1 = cbi1 + b(k) * zr ** k
+    end do
+    cbi1 = ca * cbi1
+
+  end if
+
+  if ( a0 <= 9.0D+00 ) then
+
+    cs = cmplx ( 0.0D+00, 0.0D+00, kind = 8 )
+    ct = - log ( 0.5D+00 * z1 ) - 0.5772156649015329D+00
+    w0 = 0.0D+00
+    cr = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 50
+      w0 = w0 + 1.0D+00 / k
+      cr = 0.25D+00 * cr / ( k * k ) * z2
+      cs = cs + cr * ( w0 + ct )
+      if ( abs ( ( cs - cw ) / cs ) < 1.0D-15 ) then
+        exit
+      end if
+      cw = cs
+    end do
+
+    cbk0 = ct + cs
+
+  else
+
+    cb = 0.5D+00 / z1
+    zr2 = 1.0D+00 / z2
+    cbk0 = cmplx ( 1.0D+00, 0.0D+00, kind = 8 )
+    do k = 1, 10
+      cbk0 = cbk0 + a1(k) * zr2 ** k
+    end do
+    cbk0 = cb * cbk0 / cbi0
+
+  end if
+
+  cbk1 = ( 1.0D+00 / z1 - cbi1 * cbk0 ) / cbi0
+
+  if ( real ( z, kind = 8 ) < 0.0D+00 ) then
+
+    if ( imag ( z ) < 0.0D+00 ) then
+      cbk0 = cbk0 + ci * pi * cbi0
+      cbk1 = - cbk1 + ci * pi * cbi1
+    else
+      cbk0 = cbk0 - ci * pi * cbi0
+      cbk1 = - cbk1 - ci * pi * cbi1
+    end if
+
+    cbi1 = - cbi1
+
+  end if
+
+  cdi0 = cbi1
+  cdi1 = cbi0 - 1.0D+00 / z * cbi1
+  cdk0 = - cbk1
+  cdk1 = - cbk0 - 1.0D+00 / z * cbk1
+
+  return
+end
diff --git a/src/githash.h b/src/githash.h
index 4cb0b4c2..bedb0897 100644
--- a/src/githash.h
+++ b/src/githash.h
@@ -1 +1 @@
-#define GITHASH "d515d92"
+#define GITHASH "99523db"

From 1e5829244f7e045ea565adcfbf43fb629a37e3ca Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Thu, 11 Nov 2021 13:24:54 +0700
Subject: [PATCH 23/46] Added negative orders of BBs

---
 src/CalculateE.c |  2 ++
 src/GenerateB.c  | 64 ++++++++++++++++++++++++++++++++++++------------
 2 files changed, 50 insertions(+), 16 deletions(-)

diff --git a/src/CalculateE.c b/src/CalculateE.c
index 2bd43163..7460b097 100644
--- a/src/CalculateE.c
+++ b/src/CalculateE.c
@@ -197,6 +197,8 @@ void MuellerMatrix(void)
 				si=sin(alph);
 				for (i=0;i<nTheta;i++) {
 					// transform amplitude matrix, multiplying by rotation matrix (-alpha)
+					// Note, that amplitude matrix for vortex beams (Bessel beams) have to be multiplied
+					// by phase factor exp(-I*n0*alpha)
 					if (yzplane) { // here the default (alpha=0) is yz-plane, so par=Y, per=X
 						s2 =  co*ampl_alphaY[index+1] + si*ampl_alphaX[index+1]; // s2 =  co*s20 + si*s30
 						s3 = -si*ampl_alphaY[index+1] + co*ampl_alphaX[index+1]; // s3 = -si*s20 + co*s30
diff --git a/src/GenerateB.c b/src/GenerateB.c
index 4e972388..14b96fd5 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -214,7 +214,6 @@ void InitBeam(void)
 			// initialize parameters
 			n0=round(beam_pars[0]);
 			alpha0=beam_pars[1];
-			TestNonNegative(n0,"Bessel beam order");
 			K =fabs(WaveNum);
 			Kt=fabs(WaveNum)*sin(alpha0);
 			Kz=fabs(WaveNum)*cos(alpha0);
@@ -347,11 +346,11 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 	const double *ex; // coordinate axis of the beam reference frame
 	double ey[3];
 	double r1[3];
-	int n1,N,it; // for Bessel beams
+	int n1,N,it,q; // for Bessel beams
 	doublecomplex vort;  // vortex phase of Bessel beam rotated on 90 deg
 	doublecomplex fn[5]; // for general functions f(n,ro,phi) of Bessel beams (fn-2, fn-1, fn, fn+1, fn+2 respectively)
 	doublecomplex sum[3],fint[3];
-	double phi,arg,td1[n0+3],td2[n0+3],jn1[n0+3],r,tht,db; // for Bessel beams
+	double phi,arg,td1[abs(n0)+3],td2[abs(n0)+3],jn1[abs(n0)+3],r,tht,db; // for Bessel beams
 	const char *fname;
 	/* TO ADD NEW BEAM
 	 * Add here all intermediate variables, which are used only inside this function. You may as well use 't1'-'t8'
@@ -619,23 +618,56 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 					fn[0]=0; fn[1]=0; fn[3]=0; fn[4]=0;
 				}
 				else {
-					n1=n0+2;
-					bjndd_(&n1, &arg, jn1, td1, td2);
-					if (n0 == 0) {
-						fn[0] = jn1[2]*cexp(-2*I*phi);
-						fn[1] =-jn1[1]*cexp(-I*phi);
-					}
-					else if (n0 == 1) {
-						fn[0] =-jn1[1]*cexp(-2*I*phi);
-						fn[1] = jn1[0]*cexp(-I*phi);
+					n1=abs(n0)+2;
+					if (n0 <= -3) {
+						bjndd_(&n1, &arg, jn1, td1, td2);
+						if (n1 % 2 == 0) q=1;	else q=-1;
+						fn[0] =  q*jn1[-n0+2]*cexp(-2*I*phi);
+						fn[1] = -q*jn1[-n0+1]*cexp(-I*phi);
+						fn[2] =  q*jn1[-n0];
+						fn[3] = -q*jn1[-n0-1]*cexp(I*phi);
+						fn[4] =  q*jn1[-n0-2]*cexp(2*I*phi);
 					}
-					else {
+					if (n0 >= 2) {
+						bjndd_(&n1, &arg, jn1, td1, td2);
 						fn[0] = jn1[n0-2]*cexp(-2*I*phi);
 						fn[1] = jn1[n0-1]*cexp(-I*phi);
+						fn[2] = jn1[n0];
+						fn[3] = jn1[n0+1]*cexp(I*phi);
+						fn[4] = jn1[n0+2]*cexp(2*I*phi);
+					}
+					if (n0 == -2) {
+						bjndd_(&n1, &arg, jn1, td1, td2);
+						fn[0] =  jn1[4]*cexp(-2*I*phi);
+						fn[1] = -jn1[3]*cexp(-I*phi);
+						fn[2] =  jn1[2];
+						fn[3] = -jn1[1]*cexp(I*phi);
+						fn[4] =  jn1[0]*cexp(2*I*phi);
+					}
+					if (n0 == -1) {
+						bjndd_(&n1, &arg, jn1, td1, td2);
+						fn[0] = -jn1[3]*cexp(-2*I*phi);
+						fn[1] =  jn1[2]*cexp(-I*phi);
+						fn[2] = -jn1[1];
+						fn[3] =  jn1[0]*cexp(I*phi);
+						fn[4] =  jn1[1]*cexp(2*I*phi);
+					}
+					if (n0 == 0) {
+						bjndd_(&n1, &arg, jn1, td1, td2);
+						fn[0] =  jn1[2]*cexp(-2*I*phi);
+						fn[1] = -jn1[1]*cexp(-I*phi);
+						fn[2] =  jn1[0];
+						fn[3] =  jn1[1]*cexp(I*phi);
+						fn[4] =  jn1[2]*cexp(2*I*phi);
+					}
+					if (n0 == 1) {
+						bjndd_(&n1, &arg, jn1, td1, td2);
+						fn[0] = -jn1[1]*cexp(-2*I*phi);
+						fn[1] =  jn1[0]*cexp(-I*phi);
+						fn[2] =  jn1[1];
+						fn[3] =  jn1[2]*cexp(I*phi);
+						fn[4] =  jn1[3]*cexp(2*I*phi);
 					}
-					fn[2] = jn1[n0];
-					fn[3] = jn1[n0+1]*cexp(I*phi);
-					fn[4] = jn1[n0+2]*cexp(2*I*phi);
 				}
 
 				t1 = (((K*K+Kz*Kz)/2.*M[0] +  K*Kz*M[3])*fn[2] +

From bc2963db5721228a5056d6f065cc0bbc61d81543 Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Thu, 11 Nov 2021 13:45:17 +0700
Subject: [PATCH 24/46] Extracted bessel ASD

---
 src/GenerateB.c | 49 -------------------------------------------------
 src/const.h     |  1 -
 src/param.c     |  4 ----
 3 files changed, 54 deletions(-)

diff --git a/src/GenerateB.c b/src/GenerateB.c
index 14b96fd5..6f84922b 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -202,7 +202,6 @@ void InitBeam(void)
 				                       "\tCenter position: "GFORMDEF3V,tmp_str,w0,s,COMP3V(beam_center_0));
 			}
 			return;
-		case B_BESSELASD:
 		case B_BESSELCS:
 		case B_BESSELCSp:
 		case B_BESSELM:
@@ -256,9 +255,6 @@ void InitBeam(void)
 			// beam info
 			if (IFROOT) {
 				switch (beamtype) {
-					case B_BESSELASD:
-						tmp_str="angular spectrum decomposition";
-						break;
 					case B_BESSELCS:
 						tmp_str="circularly symmetric energy density";
 						break;
@@ -324,15 +320,6 @@ void InitBeam(void)
 }
 
 //======================================================================================================================
-void Fpw(doublecomplex *F,int l,doublecomplex k,double r0,double tht0, double phi0, double alph, double bet)
-{
-	doublecomplex fexp = cexp(I*l*bet + I*k*r0*(sin(alph)*sin(tht0)*cos(bet-phi0)+cos(alph)*cos(tht0)));
-	*F = (cos(alph)*cos(bet)*cos(bet)+sin(bet)*sin(bet))*fexp;
-	*(F+1) = -(1-cos(alph))*sin(bet)*cos(bet)*fexp;
-	*(F+2) = -sin(alph)*cos(bet)*fexp;
-}
-
-
 void GenerateB (const enum incpol which,   // x - or y polarized incident light
                 doublecomplex *restrict b) // the b vector for the incident field
 // generates incident beam at every dipole
@@ -555,42 +542,6 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				}
 			}
 			return;
-		case B_BESSELASD:
-			if (which==INCPOL_X) vort = cpow(I,n0);
-			else vort = 1.;
-			for (i=0;i<local_nvoid_Ndip;i++) {
-				j=3*i;
-				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
-				x=DotProd(r1,ex);
-				y=DotProd(r1,ey);
-				z=DotProd(r1,prop);
-				r=sqrt(x*x+y*y+z*z);		// radial distance in a spherical coordinate system
-				tht=atan2(sqrt(x*x+y*y),z);	// polar angle
-				phi=atan2(y,x);				// azimuthal angle
-
-				// Integration
-				N=10;
-				db=2.*PI/N;
-
-				Fpw(fint,n0,WaveNum,r,tht,phi,alpha0,0);
-				sum[0] = fint[0];	sum[1] = fint[1];	sum[2] = fint[2];
-
-				for (it=1;it<N;it++) {
-					Fpw(fint,n0,WaveNum,r,tht,phi,alpha0,it*db);
-					sum[0] += fint[0];
-					sum[1] += fint[1];
-					sum[2] += fint[2];
-				}
-
-				t1=sum[0]/N;	t2=sum[1]/N;	t3=sum[2]/N;
-
-				cvMultScal_RVec(t1,ex,v1);
-				cvMultScal_RVec(t2,ey,v2);
-				cvMultScal_RVec(t3,prop,v3);
-				cvAdd2Self(v1,v2,v3);
-				cvMultScal_cmplx(vort,v1,b+j);
-			}
-			return;
 		case B_BESSELCS:
 		case B_BESSELCSp:
 		case B_BESSELM:
diff --git a/src/const.h b/src/const.h
index 569a440c..d7cee3cf 100644
--- a/src/const.h
+++ b/src/const.h
@@ -285,7 +285,6 @@ enum incpol {
 
 enum beam { // beam types
 	B_BARTON5, // 5th order description of the Gaussian beam
-	B_BESSELASD, // Bessel beam (Angular spectrum decomposition)
 	B_BESSELCS, // Bessel beam with circularly symmetric energy density
 	B_BESSELCSp, // Alternative Bessel beam with circularly symmetric energy density
 	B_BESSELM, // Generalized Bessel beam
diff --git a/src/param.c b/src/param.c
index 8158dd9e..a49e94a3 100644
--- a/src/param.c
+++ b/src/param.c
@@ -233,9 +233,6 @@ static const struct subopt_struct beam_opt[]={
 		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
 		"(zero, by default). All arguments are in um. This is recommended option for simulation of the Gaussian beam.",
 		UNDEF,B_BARTON5},
-	{"besselASD","<order> <angle>","Angular spectrum decomposition of Bessel beam. The half-cone angle (in rad) "
-		"is measured from the z axis. The beam order and half-cone angle are obligatory.",
-		2,B_BESSELASD},
 	{"besselCS","<order> <angle>","Bessel beam with circularly symmetric energy density. The half-cone angle (in rad) "
 		"is measured from the z axis. The beam order and half-cone angle are obligatory.",
 		2,B_BESSELCS},
@@ -1048,7 +1045,6 @@ PARSE_FUNC(beam)
 				if (Narg!=0 && Narg!=3) NargError(Narg,"0 or 3");
 				if (Narg==3) use_beam_subopt=true;
 				break;
-			case B_BESSELASD: if (Narg!=2) NargError(Narg,"2"); break;
 			case B_BESSELCS: if (Narg!=2) NargError(Narg,"2"); break;
 			case B_BESSELCSp: if (Narg!=2) NargError(Narg,"2"); break;
 			case B_BESSELM: if (Narg!=6 && Narg!=10) NargError(Narg,"6 or 10"); break;

From 2cc046ff565d83c807ac91b7279df4999762afa0 Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Fri, 12 Nov 2021 14:00:05 +0700
Subject: [PATCH 25/46] Deleted misc files

---
 .DS_Store                                     | Bin 10244 -> 10244 bytes
 .cproject                                     |  44 -------
 .gitignore                                    |  10 +-
 .settings/language.settings.xml               |  15 ---
 doc/Bessel beam fields.docx                   | Bin 15899 -> 0 bytes
 src/.DS_Store                                 | Bin 14340 -> 14340 bytes
 src/.cproject                                 | 119 ------------------
 src/.gitignore                                |   6 +
 src/.project                                  |  26 ----
 src/.settings/language.settings.xml           |  27 ----
 .../org.eclipse.cdt.codan.core.prefs          |  77 ------------
 src/fort/special_functions.f90                |  91 --------------
 src/githash.h                                 |   2 +-
 13 files changed, 8 insertions(+), 409 deletions(-)
 delete mode 100644 .cproject
 delete mode 100644 .settings/language.settings.xml
 delete mode 100644 doc/Bessel beam fields.docx
 delete mode 100644 src/.cproject
 delete mode 100644 src/.project
 delete mode 100644 src/.settings/language.settings.xml
 delete mode 100644 src/.settings/org.eclipse.cdt.codan.core.prefs
 delete mode 100644 src/fort/special_functions.f90

diff --git a/.DS_Store b/.DS_Store
index 5f3237dcd1eb331f06f5e1dcfdd723e9758ace3b..ba317a80f3dc78a6c0b464467231655f5581e6fd 100644
GIT binary patch
delta 362
zcmZn(XbG6$FDTByz`)4BAi$7PoSc)CpP#d_a2or>2Eonj94s7SAXyd$J%)6KOokGe
z3Wmu%0>+XY3@Hq$3}p-@4EaEq!%z&9o@_0kHQ8Q(of9U&I5|l`SC|!OL>@x{Ln*?b
z$=w1`llKa6a==thekhPMSzM48Az&}Kk=fM9VDe`{Z-jZ9O@!>2M1W2M17!y-7(--p
zo5(5bGLzdxoF*?5e<WA}bagS%)d=@CN$3GxR}OZc8G{MTF&hgfux(~n_{E}Bl30?N
apBD_IN{cy^q1G~B*b53QFhG_83IG6YU0AXJ

delta 175
zcmZn(XbG6$FUrTjz`)4BAi%(o4}>`k#hy9&$r}?Fvu|eSVBuioo2)2cJh@OnZSpDs
zt;w$i!X}3a#!WsexR%+(+-P#GkoV@>LMBWi4jm7G<}ffQJ7|Gv24x0@$&3<Cn^Q$Q
iu*+^{lu%)uY$K_$F)bWum%=ZW&GSV4v8x4|v;Y9A)hD<B

diff --git a/.cproject b/.cproject
deleted file mode 100644
index 2e0e559b..00000000
--- a/.cproject
+++ /dev/null
@@ -1,44 +0,0 @@
-<?xml version="1.0" encoding="UTF-8" standalone="no"?>
-<?fileVersion 4.0.0?><cproject storage_type_id="org.eclipse.cdt.core.XmlProjectDescriptionStorage">
-	<storageModule moduleId="org.eclipse.cdt.core.settings">
-		<cconfiguration id="org.eclipse.linuxtools.cdt.autotools.core.toolChain.465099999">
-			<storageModule buildSystemId="org.eclipse.cdt.managedbuilder.core.configurationDataProvider" id="org.eclipse.linuxtools.cdt.autotools.core.toolChain.465099999" moduleId="org.eclipse.cdt.core.settings" name="Build (GNU)">
-				<externalSettings/>
-				<extensions>
-					<extension id="org.eclipse.cdt.core.MachO64" point="org.eclipse.cdt.core.BinaryParser"/>
-					<extension id="org.eclipse.cdt.core.Cygwin_PE" point="org.eclipse.cdt.core.BinaryParser"/>
-					<extension id="org.eclipse.cdt.core.PE" point="org.eclipse.cdt.core.BinaryParser"/>
-					<extension id="org.eclipse.cdt.core.GNU_ELF" point="org.eclipse.cdt.core.BinaryParser"/>
-					<extension id="org.eclipse.cdt.core.ELF" point="org.eclipse.cdt.core.BinaryParser"/>
-					<extension id="org.eclipse.cdt.core.GCCErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-				</extensions>
-			</storageModule>
-			<storageModule moduleId="cdtBuildSystem" version="4.0.0">
-				<configuration buildProperties="" id="org.eclipse.linuxtools.cdt.autotools.core.toolChain.465099999" name="Build (GNU)" optionalBuildProperties="" parent="org.eclipse.cdt.build.core.emptycfg">
-					<folderInfo id="org.eclipse.linuxtools.cdt.autotools.core.toolChain.465099999.574064567" name="/" resourcePath="">
-						<toolChain id="org.eclipse.linuxtools.cdt.autotools.core.toolChain.2112245766" name="GNU Autotools Toolchain" superClass="org.eclipse.linuxtools.cdt.autotools.core.toolChain">
-							<targetPlatform id="org.eclipse.linuxtools.cdt.autotools.core.toolchain.targetPlatform.1847333728" isAbstract="false" name="GNU Autotools Target Platform" superClass="org.eclipse.linuxtools.cdt.autotools.core.toolchain.targetPlatform"/>
-							<builder id="org.eclipse.linuxtools.cdt.autotools.core.toolchain.builder.1569401276" managedBuildOn="false" name="Autotools Makefile Generator.Build (GNU)" superClass="org.eclipse.linuxtools.cdt.autotools.core.toolchain.builder"/>
-							<tool id="org.eclipse.linuxtools.cdt.autotools.core.gnu.toolchain.tool.configure.1375696790" name="configure" superClass="org.eclipse.linuxtools.cdt.autotools.core.gnu.toolchain.tool.configure"/>
-							<tool id="org.eclipse.linuxtools.cdt.autotools.core.toolchain.tool.autogen.1526597061" name="autogen.sh" superClass="org.eclipse.linuxtools.cdt.autotools.core.toolchain.tool.autogen"/>
-							<tool id="org.eclipse.linuxtools.cdt.autotools.core.toolchain.tool.gcc.130554431" name="GCC C Compiler" superClass="org.eclipse.linuxtools.cdt.autotools.core.toolchain.tool.gcc">
-								<inputType id="cdt.managedbuild.tool.gnu.c.compiler.input.729455874" superClass="cdt.managedbuild.tool.gnu.c.compiler.input"/>
-							</tool>
-							<tool id="org.eclipse.linuxtools.cdt.autotools.core.toolchain.tool.gpp.2044062187" name="GCC C++ Compiler" superClass="org.eclipse.linuxtools.cdt.autotools.core.toolchain.tool.gpp"/>
-						</toolChain>
-					</folderInfo>
-				</configuration>
-			</storageModule>
-			<storageModule moduleId="org.eclipse.cdt.core.externalSettings"/>
-		</cconfiguration>
-	</storageModule>
-	<storageModule moduleId="cdtBuildSystem" version="4.0.0">
-		<project id="adda.null.1450599415" name="adda"/>
-	</storageModule>
-	<storageModule moduleId="scannerConfiguration">
-		<autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId=""/>
-	</storageModule>
-	<storageModule moduleId="org.eclipse.cdt.core.LanguageSettingsProviders"/>
-	<storageModule moduleId="refreshScope"/>
-	<storageModule moduleId="org.eclipse.cdt.make.core.buildtargets"/>
-</cproject>
\ No newline at end of file
diff --git a/.gitignore b/.gitignore
index 47a20c37..17494861 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,6 +3,7 @@
 /*/*.dll
 /*/adda*
 /*/*.o
+/*/*.obj
 /*/*.d
 /*/.*opts
 /*/*stackdump
@@ -14,12 +15,3 @@
 /*/*.geom
 /*/out
 /*/*.clstr
-
-
-src/githash.h
-src/.cproject
-src/.settings/language.settings.xml
-src/.cproject
-src/githash.h
-src/githash.h
-*.h
diff --git a/.settings/language.settings.xml b/.settings/language.settings.xml
deleted file mode 100644
index fb867b74..00000000
--- a/.settings/language.settings.xml
+++ /dev/null
@@ -1,15 +0,0 @@
-<?xml version="1.0" encoding="UTF-8" standalone="no"?>
-<project>
-	<configuration id="org.eclipse.linuxtools.cdt.autotools.core.toolChain.465099999" name="Build (GNU)">
-		<extension point="org.eclipse.cdt.core.LanguageSettingsProvider">
-			<provider copy-of="extension" id="org.eclipse.cdt.ui.UserLanguageSettingsProvider"/>
-			<provider-reference id="org.eclipse.cdt.core.ReferencedProjectsLanguageSettingsProvider" ref="shared-provider"/>
-			<provider copy-of="extension" id="org.eclipse.cdt.autotools.core.LibtoolGCCBuildCommandParser"/>
-			<provider class="org.eclipse.cdt.managedbuilder.language.settings.providers.GCCBuiltinSpecsDetector" console="false" env-hash="-1689697387348940254" id="org.eclipse.cdt.managedbuilder.core.GCCBuiltinSpecsDetector" keep-relative-paths="false" name="CDT GCC Built-in Compiler Settings" parameter="${COMMAND} ${FLAGS} -E -P -v -dD &quot;${INPUTS}&quot;" prefer-non-shared="true">
-				<language-scope id="org.eclipse.cdt.core.gcc"/>
-				<language-scope id="org.eclipse.cdt.core.g++"/>
-			</provider>
-			<provider-reference id="org.eclipse.cdt.managedbuilder.core.MBSLanguageSettingsProvider" ref="shared-provider"/>
-		</extension>
-	</configuration>
-</project>
\ No newline at end of file
diff --git a/doc/Bessel beam fields.docx b/doc/Bessel beam fields.docx
deleted file mode 100644
index e170489e0b233467df2a9d27f77e3e031c90c91a..0000000000000000000000000000000000000000
GIT binary patch
literal 0
HcmV?d00001

literal 15899
zcmeHu1$P}gvh^{<6muLiL(GgZ#>^NqGcz+YGseu!%rP@FGc((<{hi#QJ9p-Nf8f1d
zt9!Yn-gP9oN+oSo$%uo2qW~ZPPyhgc0I-oaZLSIe0N{TB06qbrK-KuIEbR>}?X~1x
ztPSimXq+v~@pHgI$+7^T!0-R>`d>T(b@3yXKj{z!9}=DsVj2~64|7T=K*P8bspXC!
z(cM55Ut<T_-a0;k$|``wz?c(~Fg~m^D)#$LEvK48Bh@>RoS<<f`ow9Puu?89>{5H_
zV|>|)r(5S8V(~U-YHP=kU;&{cs_%&%`wk=hBlm~jXXQsgBt=4$BC%@(Bd-51RL0GR
z_I0qNbrNfG>3T>kc+D*2k8w2%%pR5^gy{N9b~DOG2@?L=btoan?nkqk@$N}7(Y7mo
zb~u-jnCLvoGD?w<r}lXEOtO@N{e%ThI>lj??(*s`%~g3+QY+Y-w+i_rb<fMx0<<78
z<EyDT<;vM>8Si9}1rZ=^oPs+mI0)o1o0tHO11bN{5<HbcS0ino@^V%~k};b&h0NBV
zV~oMFUG69L7ngs8=8fCjf|%s)@bs@&nwO88Yy#+yX1p}gMCOeqAnz=)zTph+ue?}1
zf&l>U?_dC#e=|wk7|g~Cpq@zqE$$=GB(-b}%<X7ten0=u6#p07-=Df(7TaywLkIiq
z!td2@s$F)u8$DNwR&R0zeF+juO;qC3%A)DQ+biedBB;iZj_}CzOx&ca-47v$&3KJV
z%tQsa(01tgC(RzUmo{fWLO@$Sz4N^FHf-Adz2WOHktq4FUzp10&<RY4n8)Dcv93>h
z6ax2qg&$1_$tPy@h--5*Y!ntAl06x-Qt0RAO-0n)AWOIeI|6Z9#xXo$40)=P7^$P9
zey-PO^vWN{H8Dh(lHXBbn$yve{D{#lgTcIPn>u#Q?JVpI37~?`h7O^9aW_;)R((4N
z-N)czxgb!f)7rAa`k}#l19VLPX&>|YwX(Os!Jr3P4>kY_#L3E5pZ0G?qHm?=U;*@A
zzune93<d<~yMS{3cVA_(BS3`#&fNiTe#sux93C=!yXIm9EAy`aL0q09D(JD>t<Fjj
z(UVE-mP^};WV;D(mX(R_P^a)&x5BJJTg1cgO1A|H=VIK-b6!L<C9@M83iKFlHBC+P
zj7d`|@!2~cfgCouN&2Arczt$kCIjv)aoUI|zkQ~DMF<N`hcMfO11AP444DkNz6wP|
zr#t3gQ`kqm2CLNdO+QvEFm~?m1U%O7;iE@vV#+vb`XA!x#08=c1Qo?YC-K7c7z$;m
zO1g6Uio0|&N;@@bGG=Jr8u0ors*>%RRHn19A}QM&KSgC8k`YLAyFLMzGXJSHUbN0K
z9>@Rympdo`38)NzXw9GX<y1q(c4rXj)ye;&Yg371*7SUqfk@Ig9X)7eik|Du(VLif
ziV(PNVpe<QX`tQodnC-@7!`#@0YOv%2u6=mcn3TX(PUB7+Lo57mvp>ul`@;T(`#5A
zFQSc&2RYX2EbAFD)Z@{ndcEwuJ=QH<y7y$DGY+uOrdAd#{Mx#X@_O{N;kN0gO*DCl
z(1u#!&>9^;8zbGw%xqL$e;lfVz3^kkX^lMKe8lUIoU_HnEzqm2w_X)3T{*8?YHdCV
zmz?;xxrTm^)?+5r6VZu^WwDJJwwc)j@=|^kxAnZgFo&LA4vA4Wu3EVLP0`VGe6`Lm
z2qDr8!}D^=!(1is<rf1Fe1AIDn>|yy<m-a=;5{8~f3tB%)4dB*uZ^$RBkh5>d`{9M
z&nlsH(z`8IwI8o}^FCEqcXfN=5odOB{fTjRPoZ-(t(D|<7;~6cW3top3v};UEM+N3
zSQcLObSgEyms_t?D?s=sLF_x3FDL?Ie=kG9J<O$4o+wfy<D#XvrJ;AWktJ&{K4#8d
zyDH_J@+jWJ&UIA94TDw$%bHbP=IMcc*`%fgy&^HS3H1Fv|Nc!JJ%aoaX6E~?F-HY`
z>Id`>ZC2o?W_0jOeAFhI5cBrC5}G{=E_yb&$~!|7Xk(789xKfjnan$t+|64_eo`;4
zRnOP+?sS@lo{xDP=<5%VS8>u?N=klPYfIFAbnm-?wCk(rkWC+W7;xPg(W_UiSk<=T
zyu$rxJJD;y_Sq)gXEZ!dXx=S)xt%w*Gwr2&2FedzC^6Q@1RE~Dh1tDdvu9;|H4B&M
zG3AsPTk8FY_cDS<tz$su;KAP3-29nru9N2|{qBaW@BN1?#dD}mD&Io8lljI+Ph-ps
zuRX~KEl^&lMPo^@$aTRDXhx{LpsBBqYpcv$Gq1WVw3UXnf$!|B?SWgVaFkv8?3t2d
zqI$Q>n_tkCGopOD;WnHzwf3*f*qR);@7GlPQ@pdbA_{%(SJCGO(=j8ggROm~l^RGr
z)Av_R2Nf|RG2RIL^*-FV!Snjh=o2*(;;-9=_ExnJQbBx4C3O3Q<l^P1<+&)!9YFhW
z#Hh@aBL|z(Ou$z<(99YyaRSs#o0{3)ko)oUov~AN<cQ2ufw&L}JHd9iKm>MVV)%$G
zg^;Vwea8N3b#t<698dGq=2wYtHYFQ^7js#1v0`}RL1+IoTa*BOzi;@b?ojG$!fpd{
zz_h=+4L7yu?E8aOK+U?R+I&(Mk&d<%;Y%zFr+IJ0{hh^kSBIH%^))7FNt46QuM=Ak
zm$i7O*nUU_aR51}IhLPDZ*RGF7U7vmqmf>2M$)lbG>~IbRJNP8U;24sSgP9tp_BSL
zSD7REJB@A#hh8dqtZcWhS2b)w5ou#7y=dG^=R-yA&dymDk@5>xkrf%Yw>G@SnDs*_
zIdr^c=~+QZ{K`{OXsB<AQysSD27D!9-}tokhh7LG(A|E$RK9zLH6k|}Ix4zNtJO|7
zOK`4jc)cpYXB!}~YL~vQcpVFF!SsFB)nYko#Jg5}oG=p^0ge~t08Mx-c_2@WjwdUY
zW-kjoaf8j#{wTG+;bUDONJRBc2srOIKa@pB5IEb*3&G329g;;;@dPXL`eK1!%u0R8
z7w~Ep6qjgi^rdap$Lnxz7U-1dr7#$!R&<J?;R#(Ly&sCn!kV<xcYJ%lJ!$(Xx*|`0
z|A9m3#bNd)OG=rNs~=k<U{pJaf8R(+)%%9tJKX;ky!CoN;r?7Gs>O(!l|hvVrovLN
zdwD_+$qndvBa1mFL44_prK8p~-I|ZKG@ibOE`*R8Te)1fHN9OHzhVp+LDf+x7!iU!
z7r_bJK;GfEhD~5#w@^?Gk*24&5P~l!v~<~Ls@o!&4GFk~7sameIRN?kWg{fnJjPiq
zQ*S3jWVrfsx5@XtpWXJN?o^A!HcrzVN7du8d^ZPPk@{q@+4Kxwf?%K2r--Z7W#&lv
zLxRwHut{FPF^Ax6%S$*rDfU%IQ1m7F5(c~Ey7?d!p~Yi-1fQil^od@R(%xo9?RNXb
zS)<DNs@c~>UZfDQcU939G51v8<Vp4j0-eBX3q$P&C&?KQI7#8xp0T^X$`<GE#VHnB
zmfUD+=WX`Tt%((|>v+i$@`9B%#vB(TLq98o`i*->ZYv48hi?vU5)G>}>yZtsBk&j}
z)w5xiV<)it!x2yiDx{p_>lUO!qa&+U$B(EwiJu#l%Fm*&JUf^Q!Ad(=NBf~#oQV|)
zOb=C_VjBp2+2j4hzr$-HC{m66os|?q$IK)zz$^Gi3m>qVK|fj;#=9#O^l@*8i;YwT
zv+`75zKAJ&BEJhp6e%v9uGTO4bdN^vfT{c%A+Ke3{Oy_RtK#uFc~kp2Y!K<yC;Qgi
z6)qtm$3~8G@?gXCMJ)T)Pi2C@5o}pgaKS!wJotdIb}r9{)g41ncj&kfnSbagY!mH1
zBxDnPzjnSl>u@uV_>?H5s=pVLpj5=!ducrwBzI15l0PV5Jbwlcr;wlhd(1Qmsqv6N
zO<WY%6D1sez7bMOgMCatzkUpsavDPqm2$cR;jq^^8&kE{kwubA#$1JuV3m)b5v)U-
z(hL~phn2pa4ha%|59XWtmM0YR%1efU*%B8>7!M2f0aCOelH_}ORVNh5OxJQrkN7i;
zg5s(O?NjmWREUgZbb~Ippg}vdzuGK00zGH@gQ~J@UJNQ_DATmA;8I(T^I`510y_Ls
zdF+!+iF&ZFp#L`%iG;{{#3wmnlk3`ubxw>T^m(@*9`?VLub!W+xHhWAsYesb2oLFz
zQSNiDq7k0Qi0PL!BYnu^<*id9&`Y+L!*6>KMtH^7A|=lENc1vS*!cdU=!#HrGN7eb
zHbg#hJ4MtK%50|M(Bd|;sFBODv`fk_whP?7F$*Dt^lho@3c{S!8AjHYMPw=TDApF6
z%WZI#C9j)ug(1O${s}_j2I!me0|rfkYL~ywNksU2_wrX9$;crm!Y^v-m9;EsqdYP3
zk~F?E1(aSD5IwE6YD2*^*Di|o$%0)OX%ho)C#$fXA6@!{M$_Ln3q0(+w4C1_($^KF
zS#qQAX$wLV#9lVs_p1mpPhTWhI8%!}UEaroBqYe%3rZ$_U3?B*tSt*Ed_K>H@jWh)
zu=IJbMA7ScFpOnW$}3y$c_Pe$Pq7p79#I@u+rwy1%3edF#|TXJuC9TxfRd@*Nc@`o
zF+<%yfRlJpq;t27FI2hLmpg0=HxJ1%AOI7Zgi0_1+?04%oW+#b){J-<76N}QUIC!%
ztTC65@zsflU_&0xkQ6Uv+zKqMOLo8jQof3T;X`J8#vqwx@wya-O)?>}YIha2a-#|e
z<p_J<W7`QfP<Qmwx~hJ1rywVf?gT>3;^%^cqsk`)Q045&*c3eylsbc4vdK!MqIbJ*
z2CD@O*TQl7)@Nq6x-ReowDzLCb*F=+Qo=>ls4GR~M}?swDb7MZPZ$X#UNh4Su=qKc
z*y1Qs8x41K`ROU+NKhpIgnGzd^(cyA30uML+dS)`|I)iGPOzr1t#LO<bZ(>lp1<-g
zxsPYSo}evoZS%8}l!*Y8+YLLw!;7m47v%z4NZQ<{Zxb+#*yDQF+YwqD@ddM)5mV6i
z_BdqCQb7we#*PzBN7@X;xDXWSPHa>D{#*1kba@QH&#mK<+2YWkQZwQ~k6Za^lP|6m
z3RNgv35Uh;v`b{frRvfoSF`+hk!ZBNrbK0RrYrLOy1l-QI`-EwDJVk{LEpuj*04#w
z!+L=xq0*eGU7FgiJ4^KiNp;8-lf+*Rqbstz8L+E>CW8<%%2bc&gcJ%ZhN%m*3o5&k
z!coNg#aVvMMv)2a`3}=$4@-IGx3mT$TpJfP>cXpTovtny<{wHp1?qe%i{<LJh5;|l
z$5y;Nd55-=#bVE4N9=%6retx*YSS<!kZYio+fHuEzc(8wcBEe#t@ev%6s(jpu6w+M
z80HZwzy2Et9{uEj6OMz5;i*-Fn(gknm8rw=3`aXyjVZN4(<xb_yknw|gv^mb4XlBH
zhQA?fxtRtyeGw7L)65Z9=r7=)2)-?{iXfL?!-o}7eVjBx8u6jR`d$y_me1ns#E2Sc
z#=j1M+3mu)5i*D}aq}ZR<Mz1+F*132D^o=5Xm^`9FNGyt+?E-AJ$+3~$UbIbCZ~rA
z^!}Hvlig|O_}Jx0w2JwlI;g-Q8p$`>tc7E2G~$hD_pq3!fB_*cP*#=4_@2)9)Ye0P
z+7^;`21ZGBQx>ziVxH}-zA8$o^d*o~<-~HOQ_RBgGNL*mMfk$;!xR{b#JUPS<3X%2
zd0us26y=BsFDMR{7<2-^fZkx_L_&JsqBi%T{^P=z<AE?#<R~OX)w@L_@y4lLc{oj=
z!3bvWyN!Qn&3#k|ur%A94XxUop8kYUh==2;UsLLq7QMZF8J$tj9;|vb#lR-$2ZJg#
zMHW@3%nL7KYhBBs3Z8UH{M@Ke%1AxKj@&b|V&Lu2BGATFUSnR++oheZXb6_Q2=rfL
zA#3AlVx6P|CQ-G8GH*1JU)j7F1d#SFOu+S%I!ACixEm{SnlfN;Cm2u`@CMhR`tDAk
z%3~7vZQ3au_-s6weXGeTq(gAi$my%t(H3%RGGI|DP7<n667GU;N0Q8`JQCENqk|_X
z0Q7APVjC`>g@5K#j7o7cq>~1w+woli7opiJm@esrRF6My1%!@TpZ7F#HSX!pG4pF2
z$)E~-1AH%QL`KY@8kk`z%Nv;K<mlueE%WMZ<y=!V&6G6)6Yi(vV=j7ol-QNkIxOTV
zHjY(^5Jh%3$?q#DW^tn>6#6wE$T***qD{cz9sT?Ld~J$`*D1&Bi$SY|DIvXRA1Bf(
zkc26PZ32E9Fi)Lr9unKBV&t=WtY)=hWQ{BJEzJ2QgkAG(c@Nxvj_&+i7!F4Y(^m>G
zQJ(~Nh_2S13TmiU&cwuSiCHL<ei?ONNl=(1?N7&C>~iu|C^+PYA~Cc}mmCR?>DZ5|
z!_IRwuA~r2U%vr{@HJG*@7WzREWc}IE^TLSvfQ-?>NFO6QMsl)XU%lr{`mam+d+wk
z$3}t#U>85^NVncL8ZV$vni;f7GTpR<?J@%RPpM%*aG#+h3Hr1&kEBY(=>KU+zW95)
zls-R<tCE#s2Kcshs;WLy^pE-QY__f(l(?*z3!e%tle}{I1zLK}>d%^m9@52d60XI7
z>57&@jrtB-DFZPKP<0t^2UXKvJ=m)7^Oo>!b6g7L%V}QK)T5s-tpYkGs)dUZAwFAj
zGmGZL-wi%eh2kv~W7BiaIaFXXHHEjfhJzA}Xt^bnKu6AnLiy;`4{9g4l+Dv)!VYO?
zcgsMFPiY5xWC3-byUJEUu=o3c;78F=D9YjiJQ!k9+z$VjmiQsW2C%u9yxkptFX_mB
z+yVO>L8;Uh8-M{6tLpAF6!txRdL<z(5sOeZc*HMqrcK%I9hE=`&XOU;CXgs}*Lg<j
zlsL?#ulA3{(@OS_3KWXo@SO>OniOQPQX49G6*30pK|XRF@*0^zzM&-ZGWP_vr|2)k
zKqcjTofc>V;ms(*&53u{zYj&X=K_oEoqQ%_x{@!G1@4EcFfI55lox#`KVb|c7d^Z&
zg*Ic~^h;MZXGbV@r1Mr5qA)5Uo4CMr(<JExXjsZx)A`u$66O}t`5=py#(bRRK!$@g
zXYUbvne=F!u70^LPm+Tc=&=@nVuGC^cUIh+cf0Pbih5pJ=KH6<4y;pB%gObHwRs$t
z@SLuaYUOws8y!d=N5Y)(1GT!<<1lS-Bsd~QFMDb@?4E$anRA3`c;1Llu&GBZ@>4iG
znqc<?g<}&U*dG7ET{xesUd$mG{+ADmJM$RMsNj<fNcF1B2eA{<dpW4=l*4Gu93x%8
zo(B6MOR`c30$0Qof(V`|7a<>52KO1uqQ^)B8q$fz%&_PwgpFZH{Q?TCfop*8Y^gu@
z#94INTL$c{{dAG6qR=(lKkkpr;zBtoHdVXFH^ixIDTpC}h5{Cj!09<ZE4W(CH+|;6
z@e4M%qUgB$;P&g2=m$4?sf@4pJk4K&>6N20J3mCBqK!#4u2?bVfL}lscDsG4y%~rS
zdYtHBMCiD<O*}}F#>?~#`2oMk6OO&%R5mwL1xoj5KYd=cC84L=f;JXM^K#|4^H>}e
zMa%ty&WpuSYh40l3(`h5swzpxABCORp$9US_X~@8;G<9BmSz+=`R^Tpgv3(Xrj{nv
z%suTp?Qd4{Ke;OT2EA5E2ms(GCIImHA6%8av4MpF?H^D2-~8sO%3A1(5K0H_Esp;=
z&Pc;<Cds<?h~tbQEA*127|p=6a;kG4ed^VDDk4-`>3SW?^mG`+^7?H~JPlKRHq-6r
zA4bX|#xp^Oqk}cf_f2W`I8Y=k$~QOZj2k}~ZzA+H+U!wub^u>cVwy}6X_N~<^r9Zg
z;8XX<UNy5VG2?v}A(MNnOr-FcX)QY6*9EKk_|SR%RtD@pGL1!7PbpT5aIM20eqivW
zzrczn1`St=%Q__8jDCr*t~OVh(*>6?$D|K#S~+r>(JJVamJT=b1G&y>PJg=4efz{n
zfyw#f6#9aW@%et~>Q?{R{@K~}`jnfNXK!I5ubhV}<YT%F8fiaBmt-8mSzM2YbFTy#
z*s!zkOx^APm8BNdcm$oAURv$R(8Q>v;U>b!G!68#9si2ssj1ny7AT!spM%+&X(Rgs
zDM;7N<LGx9m$DhlI*xJJG_ZWZhzqIm@8sl<Ki-F7I`)DqeUq~4j4L<YxSWuBu*s;|
zQ<G<hE6O)X$fy;SE}2W`s?A_Defh$-w_uiSOFpxvonbTJKh~hGTc2u{bNbQB^sSnT
zpXuF~n9+hdiA?W6Ff4gzFKWjjVFRL8ngO|<zTr41{_X^k-z3Pa8io}oN-njo>J3DN
zpv-xrYo*dSTc(L0F=oXlgPF&onv@tJUEX$wj;?lQcC@7NIN7+~Ojzzq)(j9KU0Rbi
zyxtyiU;4Fpyl$?y&|EpkcC>yy4ux&JJ+eMXWZ&%#g$<BSbUxos;NhBXmV@8kTza7J
znyLo`^}``wL7PH&zwX{q-Sc~2qn5K};Y0is@;k4Q;nhk9z%n(l$nQ8)Ze3@CdD3;{
zBCdaoqvyxmOrVqVZuQ?}5v{XpA?zO(*1?8+?vAs;bprDSTU$JrOKjai+JF=}n1;*d
zyJ6oahXe^HU=+Z^;47kUjfh5G(AXvMj|E}0B+7-0W+8qlsw^uAm@+`QYLl=Bcj-u2
zJY8p420vMK+VlzCbpz8*7Y|OL^91z63aIwu|8&`f*UpaIT_?VZ_x|3`i1SS%yaIuI
zZb@DI3(Oj&y5X(KMqiwW;1^gphe4cgBDhNg{H)+pA|n`mI=C+cIM*aF;V1qkqKFPb
z!R!-Y!3za1sJ>z?6YDFi&9Fyk!G{>6Ez}?(EqJ8PfGm4W_31mPKBLfIv27eyQtQpZ
z-0#mZns%)CN3NSLy=@8jXO^momkvz^TaKdJxs6(l9NO4gLGGo-Sr_^*>E`bj25xJf
z>ut)kw<_z4MvWKKlDEST*I@ovxM|u={Q1-0xivZmunYv*Q+UL}`80pPRc`u%57xvW
z-qY)DX+jCPFUDdMWHBy)Fbnx#*YdHLd4$1pMmmOMHYAEI%}}xe%%{dDQp?gaC8#XQ
z=TW0f>>g@R2M12Vy{kNMkej>Zkw3$QsLne>K!2@`s4_NIo(*`Zr`k10{M>;DhyV7`
z<}@Bj%L~A-wM$+<QPX-QQTefe{jA2&6|UQXF-1{iH!)3&uo0GjvuAG~?x3Ywq?k|I
zUpGOh{OyY^wSa*rmUY>DIDf|h1-#RakL(QgWvhT@xX>!zXLcBCL{`bDG0<17c!PME
zc@QQEof^t?FMo6i*l@y*`5Tk2D_^x@^-p&0;zP`3jkLDcvC<6Kuvr81byOv7v<^9E
zT%^kKgUNC0A7A-%qXvfHy1@2k#R$E*bIfri@kpBc+Jm=a)yEogt}B;y!$3J<x=#g$
z!dzgI_P(aCauUz%sTAKW=|B63OgBrf)kX*iOEE2A<8RN-o(!aM?An!~wp3P$<-4hz
zV5ZEMbC8UC;qMkvLwqlS?#DC@Q%qQfu!6Gf8B5x4Vbq-|?7lAf3@PB4Np412$tdy;
zul0oE`NG~GE>?0G%){8Ugf~%)JUB0*5t&RcB{S1z_LX{tn!~cYgk#NDqq>}L%|ro)
zdZ0MIMQZ4{ZsfsPMj1Wfhy5w8S4Vf;(nqYNj_c_!!<MbI&cqbRPc#K&5qsikaw;w+
zaUG@f_kx`!__!&pbGDVTCUvC&Liux)i|LN-lh&nYe1*sJ?Cp^!vsmqJ1vdEIj-}hn
zbC&Hg)XkRN6{^0T?XpEnd$uDL^~V~m4pyjU+&8DG0ZP})Z;=1Z|4d}UusVPP0G+Ua
zf1Q=s8Q9yKSQ^>=_C0k<E0HTKh#s_)UUawWl@3W%y;veObLLf+q0ToT@d7Kop*i2C
z@7V?4+lj=~F9M)h;I8#e$465>2Jt_yy+AHYL?(ayxg4;kzBCWs__<WHRZUszJk-Qo
z(qF(L0&{*lz@h)AtJmv`)rC|@mz-~EGC+_LS(Uo1Jzj$$EyOg699gNXhuT}MpFH+*
z$cZuZ@ijY5G2BrkHkL^s!>Ga{XkMfTb>63ONQ6E=Z(E|O{8SRTVJ#LWif7rkv+qK?
zMt{y{TahA)F%m1-r(Rc@J$vc!-2lwGQZ#Zyd|L#o+{yNoHP21A&9lx~+_{~1KqVl+
z8!jgTKDrKV;EggzctdH^O+r@Ir&+IbZf4LAkH}gJ$shC`U64+0v^QlNQj$2eF<#%>
zQgjFj57V*?vOG3TV}y+Y3kvd>!Dsdh1^WqR%P&ejds{K~QOZSAHo^vrF;@W0XaiOV
zF@&;xlgVsKF=n{;ef%j~&g7YDj=5=@V35#ywk?qgq?j=Hl<>KT${CVyLa+NwHq4^!
zyx2Hqxl(Os^61vC_2S|bUwZC{DdP{(Dr2Mo_l)#f=29EHC7-xPv<_C8_4Li+k)%lU
zQA8<I_k{%;q6s(}{71N_(3yreXT(@QF1rN}QuhOBm&L`?r_*0+%{?E4t^o$mg5$GN
zC~!yf{&xLV%b2b^NneRpsP{L$zg3oJdq5eHDjXo7&(XDbO<$avV08=1d~AOlO`a`j
zID^pHijthnMeEgM7k9Jd`!PEXv*7QZHl`7fah8UN5Zx90Sd7OWfTZ%Ffpz}jgPg$n
z>L4ncBP#k0H1>pO#1nXPI$A%}Pco>SeCQBAvior6-~&e#4=|epOGCbWo86~uXi-0F
zW>%r-0?QwLLc~F1Ba$MhK`xg1Bm5i8D^wmF;}K6(U<-G^CnG5=(Wjcwwm~eTeY-sC
zwpqq=6Qm^_)6u#?U-QF~CB65Vyw36Web+gJT4)?9TLE#YN&Pjg$6C$Y-3JU4W=-8D
z=gaT<c4W+K>G0lJMJ6!G_n0zAlX+iq)V9l2S<QN#(AH)Bu=1^I-Q9POttdv{cTXqb
z4nuM+(dAV8u3o2N>#h@JsL_IKbIVnmC^EkVHN4sHmPjRC|3HTB5rTVB%L`1L?mN33
zF(h-GyOiXKzQlA`qgxnGudTwYSrIS96GZMXbw(?RvOS1QE~RtonuRQR9{uK~uC8B^
z$Tf9SH`+SrPJKgL^KHa8jB2)~D(P%XXv?~NqbGQ7M6<&{vPY`v&AMAFB#<ze>-f^P
z={3835g$DhOxIT860D8dT9TNvkwfnL?IaJgy2B6QGl=vhUhbK*YRzW1aT%hJTWc@F
zGSy##RIjCZgp-kJjMTJI5v2r|fly7+?9NFd{ml14Ke2g=RUE)bp%ul>2X2@~ZLPe)
z?lNMWCU+mIE;6rJ_(2zl3MBoyZ!?V*1bot-X6T}3iZ33Qn8w45G5g<a_sZlp(v03C
zgXG_Dn%)rp+Z@HZ?XIu`Jl7Wou9Jbsx_>**H3SB)$?NEv8~mQ6R^z5DSMX5+FG$aD
z5Fa9{KNVWY7cSQbrPkf)9^-l=n&)Cvu@PIYdqSS(&E&{C&^pqq)m(aQGP(!0z8I}V
zx7%lxksGt?#ETG}DyEcV@np^`vBrBJ7>;0>>GL8WAHH7i1hrbqs_yt~I)i<rhEa9f
zpos++pk@vVvB>Y%HA&yc)zU~XKKDFZrqpp5X<sf9dg70zXDI~hZx7HNk%NBf3r$b#
zAGivMgF`O&QLVSmbFj*Gn72?f3IOk7J}EdbsThTh8z29s3T@P#=;<4VVTdBj#%WNU
zpN9608$LQ6WFLQk;2I>Ri+99GtWMdzJlw&31|K>}z*>>m_sI4!B~J~#qPlH6Vwvsp
zM`~77{m^<YE0|%12E(u1JzRP-mwBRxWTxleAVf}^RPStt>P_JXP}o0AqN(l)dW=4-
z7Sq*tfS3II3C~iNg%DnSI^!z&LM&)2Vz`hQMBF2Kw{R9MAr1X8B>2Z;>OD5n*Fx^c
zu{>65!);L$=v`UI-JrQub-LK<uc?Dm!gP!{2EBsk#zY8SSj`<n?;$at7n+#ap2j^q
zc!eh?PoPx$EutTew3jm34OJHL3wH&D)qkC^TMC~93kSG=S2&}^P1fGx;iBUQOYHow
zfgy2@^P=d$ns30sDU^Sxgp+~p_dj{A_^EC&FnUCY&DKp0|J4=qFzOn6HN;|PBwi11
zrgRIx6p6t+%aa+73I!zEGwL{f?tLS}FfNEYh!n0qp{T$FMMRu(k5#7UJ(sUd^Pyo8
zW>{o=xd>gZ^qp<V4i1o|q-27gHOM5k5fxJ_a&i{1t<+h21SG-Ni*iD0d81f<ES=}m
zT}WTlehouv!5gY8eD~15CWomncd{0@3_=v&uwnp5BEOy|eVcFjUKe@IZeZI*<wED~
zV(jrtM@Z=%|CZ*{ceOy|eKuKX(U+oQX>?DYA(yU4JURomsAO#D9!URo#lzzl$vkr<
zUgD5EeTumrR~pKEdCq4iWx0-_S$h2&7YqKZ^Q$c>m>Z*u8=!6dmklVHCbbwOa1?(5
zLu?R%AvVA`2^m`}YdcyUYwO>p1&l-czpxtM$o=@fW;sKL(jmN!le1bW)lxx`a02bX
z*9uUKF>hrV7d0EJrd}ykTn}*iCIV&Y9K?w{FoY?$8LBR@@$~ZR>4%={(`=DG!nk;@
zk_q?FG<Y3d!t9EIt6IlbwY(4nbtQESxYAnycRMh?X)=NlRXuw1Q{JR!!Z}}+IA7Z$
zZ_g`u4<=E)4IF}T3pKq1^#^r~t3_{k{Zs=xP-zhR4|6FvP%{}e%?R(}su)OjPp#M5
zF;P><n5E8udv3)NQ3F2yq0Rh!X!V2|kcPoY9%cKU#?7VpSlmgs9f}D<G)6I3kp+(P
zCa6U|mUicWIU-08i}F}s$Wt0O(g4QwS%T&xV$vAzSR0r=GZcK>bXdqhdA+!f1a`3@
z@*^ZuJNJ{OH5ZmBP{=S;UrJ>?Nae8vNHI^2L*`4iHMk_%O>U|Od|#W8q)h9M8K$Q}
zuHKIFX)dSOljwVs_9-0$59_kmRZo-7My;#&+Se)1Tzx19Yjyg5+x}}BkZu!QBYRuK
zOc-hdnN2IxHp9oDbN8~=naNVzAq+~6j4Q~KWv0XvFiIADVx=0gIE1RLZIHre>`*=D
z%f<#KB^$ep7q?^Vv)*>t)}OXMH|!JRXgg=<0meR>Mb@i5T@aA%{TyFEBXp^@2OKBg
zIN_hKXuKz@aA)d2I(&4z-AaV541Wch$bYgo9AQxOrod@v6<CY(XXDYcvi-v`{h##!
zO$T^|$7)FX(E%N_<S&H0hsmGzn4na$wUkN8Y`Iqz4Mt_~Vl$5XZ|xr-KCJ~f9qe#P
zOKr^PUn!ujgVZ4<NXVii?)vC|Mq`kk8gV_^Ae>O9_)1LyO>WwiCFtl9L-)B>tS7Dl
z#h9|oIg(g%R6ev}z64#br$I*U6I+1&m}I`VsYZ!i8QIDdwza?@c9J%EVd6IGVQEZo
zq{z5X-ttKfm~~*bH*y{`8!VsuwCZI3SB^;sPcm^GtPe){{C4tQ81yhFE%3)Gqz*4Z
zj}~{2t6XzvHFu#P!^q>hl;$8RzS7xYqi;K(lFvr;wsi}9mc@*|T&VIdW48MhR4}nx
z8pnRcfb6N0nNP12mV%MekkL~*&%grtRdICaRa!37!&}#hA7+@YKN^=?_$t=Lbs)IP
z!D_E*^nh?eGE9h!lsW2QTMM82=!*O4dfk#ag$HD02jZPrvu}%b8*mtr@-}da_1_ef
z&JnSh=pz6?YYhPWp8x*{g|oAFF*o>QbJv!xVYkwP6nMcg^WHV3;1)A@ZM6M$9AhQK
zOnL`9bI_!M06A91&wn^-@wk!}N)Gvugp8)?E`eJ11<)IY*5#XbyK+HW4eNQu^ogPw
zU2+{S95ln90(od#_jc!Me=SHhdXFk3SsuC*z1)T6`E^F?{d(obC9#rZ0u)Z9=7y~e
zo%+Vzfg9IoD|Ud&tx}P53i5y=LZw2hAk1cTx={CyM*b>vPxnjS;KELipWlpZgy@UR
ztUC?gn@WJ-XxwUV)OQ+YS&}8WvKqLvW`r}9{3!|rf(ZtX>FP3P`cFfsj9($Ll>Li`
zXF0tpr3)%zc#kfJe4c0%Il7?Xt)T#g7y|@SroC)x1HTMVdbgg|2xZCBL?x#SQ4Uo<
zKyW_i&4tT9rc9_1+?2VeaOd5PJSRNa<;HS;%$QI?g}Ev+%a*O4oLw0q{zT;AUrW_F
z3U0>LMD=dMg>2Y-cb^d4YpkA_{Hlcat8cgO@Y4Eb+(E^!-z}CTY|M?*<w4JMq1V-{
zpc#!Qu_H}0(P!tmx1@9as6w-o;X|b|nZ#G~47)X1(n3fQ`Os;!AW}S5+72{>kF|tK
z4g?S~uWPykS$z)gbL}pwDPnkgH<c9b+fz&nkTgOCRImF{twHid@>mDDw^Q-O8$Yg<
zS3}9RL+-lu$qC==hT`xrq8u;YUG&(!UWJN61>U{vS?Jrp8BQf7MOTVZ9_2z)GCwIo
z3|`L!EPl59`CjWIX-cxZo%ADNN0iPbf^JTj0DdHRlzqj~@alMVtWf3yPP+o{fR)1J
zklJVaXT=Zcz*oHW5`4cWFI3{#;7)lV|31JmcVth5ab%A<@D>N&6u=wWI5Iak_iLnQ
z_&!?;xo=$Q<lM*danIeuv$fS%JAXW<_xR0$H6E}>n+JqP&(+tRR$!6!Ik3p}1z0ri
zY*{}Gb6z(V>s~doFSZvl>=J#Gw8fNYoG4mj?7WvZ@I5w;xJ#Z$jSC5(AYim@eS<$-
z^!4DTP2vEQ8DU>nHjkYZPt_*l*S4I|5J(u|7!h~@C#{@t*yHU{{DjMJT=aKGb9Unt
zXb4fH38?4&Q0hTt&XC|VD}G`Olm;BtgNc!8V&AOq15^@omnGyvEZpv&mo6J92)Y#r
zNJw=(a*uQanK@bMlDCR|x?v|^VGW&iwM~TP1eha=@=Y;i{pOf*97~@`6<YuJ!$jar
zaVD^FC3i3%WBW{DAn$#BtzLew;c?SdqK{C=6@<>crT9U@4>GYva9D99Yc;`gVEG`N
z`an$ZWHUxrY9+R4{;nWQ{iGIEl)jA@i;2R{!bRYI`8pW3VGpixv0d{^(#JZrRChzw
z(QCySOgY*asT8V`4`<em)$Yy+D;S$Xc^D~h%hljqk7~_7sQ2>FpB(G4HLG#Vn#wh!
z#Pa4!W5Da<Dco}~0<9J(Gmh&{P3Vq<M2j<A1cZO=7neMzT0HR+iPDaEg(!(9LdQ`u
zBfb_skA1k?%qWM*ob=Nt%$_<MX-$U4m@LP)#JlK(h%!|uNHOS{1XRjrlqQF(T!6ow
zk!HT87x*TzLrcvI7`choap`L>_-e-%i%<{}9vKvffDd7tI=}Cpr0ALm@Vkk)I3S3R
zhXj8|tt=6Q^l7|pdMq2j^PP*{dJW6ZSw+iXm?MH7U1k{#UFvjUb1!-+0F6!0<_TRr
z<w?!22r1}+)B3_>-ID|*B+11U|C+R^kJYqAy3!?^ep;`u^5sX8OuLJGVe6J`=Edc1
z<vw}wv<txzrZpI`SvOpC8FT{GHgPVeUJntcPERhk)=wHeXK*#!z=tS#0exL`^aNxG
zAre0ySrcvTJW$w9{sCXOPRZX7r9xjMY7i=P1s<aGw~&f!Wx5hiLv8uj(XOKB6d&2U
z+T00{%!xa~WXsU%XnBuuzG+D&(ea%GF_o4te4a7x-B2tdl*{}j`+Gfb6vdX?U%n-}
z&Bj_+Yitz>ybT%YD^RM$-w`e%8OTux)-^VySxe~Otk-+!?2ATrD>z3}?TV8SWw4JA
z;gsI&ncOM&pB$$FBlzxrQJ{`+Cet*wzOwA!YFq7o(XsMBqpd0*lV+W$tqWMY5ka{s
z$hp)BoymRcE)Zt*je3B*P(+RxjLV3r8l8EKX;rW#x-K&!rn=#u5ZRd#(oe$UuDva;
zC;H)VmuV4saOiHN(Qb^js%owzye!n<&|O=hIa?)WjS;vv2U;Y>Gtsp3k}`l3WfPO;
zTOF4+y`p3(kks9Aqm}bxiQcb(+{*0%9Q|R8uw`NJ$tb(T<E8&Y;TwX(+EKvw*sH7r
zyV>`j3VQK2jd~Yb{Sk*;=S@iMkoc@Q3nII)!f>LNVi(mzz+#bRq{Atgaj2##nEo9h
zO7sgxRo>7EV`lBon?kpm@J&d@xqRTuMPQ0Bmf*uh_^TsD(Y`Dc0$C9-z?z>Q(8r7D
zaE;{AFZAR^uIMT9{#O1Qf#~zcXUEMAPJwP1pXDZn0-)+-2|z96Yc;X8<<X-UDZ(Fs
zh)484*9CvW`b_xy(|B3lrX*Q{4;J!&FDl1nzGbBdAHewB{{n=#hr^Knt!aP%q2KM{
z`_Cq(h6R9y!|d1y1zd3p1)$*N^1=MGZGVIOer2G5dSLix>jjkF%V=d=ENe42ow(AS
zP9Hk$6_k!!U&$IH*pH)@XNSj*->H5k$Vu~__yq}n**JtmVkD1W%5hXzY;4|7gqjVQ
z;HhZMysSO~>$ETSME$AG_~CM=BSu?#uc>roB?f<p<NWx@kyzOQ*D0dIkvJJ5sue<G
zXJky0+?5@)TcaoZGpCKeQ^dR?oB4JH{W6R{^(r%inopHaYrh`lB{3P~!NL?N*UFK-
zn-@90y@PO=_5K%o2l1jgL$<*FL(0^&NhL1U?8<OUP%&vz2--5N0L8_K>p0A1SjzfN
z*){O8+2~CY=B`I^IN5bM{`kyUYwcb!IB4bKS4bn)ZgErZt0c^vw){Xcp5iU}zywU>
zDmi{o#bcjOHJ^59nFU;cI8V8rJ{(0;k*+^*1pf}=O$<-`JIGYzG8R+&7f_Z}F+qvA
zX>HhaG-iI)=SVew6`v;PC752gam6g*27N&{Lvhq@Mm1km3#I`B@djf{KCQb|{|<&0
zXfm#J^tLKX6jdG8VQEwKhS@KF??sdO5IHlA+HpK)619U^#7N?*+)hnCOR>$8T-xlL
zUu_z&m;Y0BlX<b^KYH}{Z<_P_4a6<}B;x-o|F-~OV|M@f<Lvp4`r<nW{Rngk<~J{f
z&pl7BeIpl}4Y<i6B^UVRw4kX7>w;)RhMxSzWdbtqm<q2mq6HOq^*>AKK7oltC$%J3
zy=@aKkwa#o4>;wd>N*{?JlU@~wwh(k9bhi7a+swgS*$4Z91rAa^UIes9p6=-8@^B!
zl+wq|McE#CoyUrRWt`yUl~AC!SHa{*Y1xrqsN9*<+j_}gyJ+I1V<!h~YvE)nY+USz
zOOJiq1P@P3DAt_kf!#OWKgQZPp`5KK;5IigwJYtNR9v4kyV1Ho@&c}w|F+=+0i_0V
zO#eNL_V?cA&)0v+sg)7`cLD#N^Y>?P9FT(fQwHE)f&ZQi^=Du$kQn`AW&b~<M*UUN
zUlU~hCF=;7D*T6}Kc~z575>+lg@3^lfSZs%;D3!^_^XJ&9y|R@#Am{P>{9+j<^2`@
zS4Q|>@a8XnhyNQt{8#*6>BE2FN6G$<{|lM;R|)@4oBaz90H9I;0DmRX{)+y0-r&#Z
v@6>-n|AR&NEBvp!x_=3{rTxd~{d12eBmM!X9>4QTKLWaeJcR(q@3;R4FrMz;

diff --git a/src/.DS_Store b/src/.DS_Store
index 236a333b043031bf36f5c2278a224cdae6c3e251..fb536121ee08d4e92e731b7ac5b857fb866b7e62 100644
GIT binary patch
delta 1433
zcmc&!TWlLe6rD3p<6Sz!6E{lD)@~ZRI3fh<6w=VNq=BR_lGG)Q$)hOA+Plyd_S*H@
z4y8q|P!S-YknRuS`3a%|QOrwJ;)hZm0xCf&K8g?z@c}JrzmO0@V%EC}q8~_z5B6hb
z&bc#l@7;4WM+!#@PbRVR#O{*;tg12IM}6Jv6ZS}ONY<=OHl5FBiG4J<4&C;9!4|(V
zmbzn{P1@&z2dgujmo0r%&#EP(q7SMi-I_2md2^3(pWaOV{y~2A%9Y`^t2@@+xbfy&
zw+$s10=y}>qM5NNL(|QYahIVNQ*(w^+Bd0M8Qs(j^X~DAVHxSHK4z*py$PMNTt5}M
zN>L`t>8i26Y?Kc0m?YKd$ZCb%sfj8^@|ts<#^03O1JTurve$_W6m>Cb-hp_#!p1C7
zELXja*LE^Cc8_6d-12fIx|ov6s%bsTHQCM6y@4s?6}?!sjJ(N*Jhr!)DHEA|E+?9?
zJg#qxqD(t^hgGYTEa;}F=_4=sfT(HGiQS@U^@@VLDWL37Zj<;I(v-DNE$YcRQ!g%f
z{4PnF;ek5u+_qISs-^r=bkvD*!>kx3A%>7ZOl3=oEs7B9?{Jr~EtlLy{h!LQ{)D$h
zA`!Bl43c3oON!(md7L~&j*~aY2jnz4OTHmLk&EOv0F97w1(u^3)d*U#25sm-4>qC~
zn=pvoxE-U|i&><RfrcE4D4~oBs(26&;bA<2V|W_R;yFBz7x5ZS;B}nDC-@Yf;d6Y2
z@9;f-zy<t*i@1c}X#-tG8)=BP(I}144YY^$)17pbjz{T)TRVl<!<09B6IJb|mM+SM
z9k+)6$*uOemIKuYYh5(l<wi^iOX&AXjs>}YLHKV~ILg*a!V-L$3)|T>lJEj=bYW-s
zdP&%i(>i2b;TvROGVXI>XShd}I9$-nHp{|pe7eEK5!NruoYX;hAiPx)mf_NWmeTGD
zwO0GE1G|tE3hhA()0lxObaGTOQNVs!IE4F!Qit&X9>rrgiYG8H)Otqf<*4-%UdC~}
zg17KC-od+gAE$5{AL3)7-<S9rKjLSczf6>ozeK5>32pYzf4dyl)!3Sq)c&K*FD*VY
zwbtk$>`gIw>DfVTHs<r$c03;NksK)yV{xy2KCakj;)evECmE7m;<vY-tzrd2Xh#A!
i;s0p2b}F>pKY!R?^Cy07fNt}6OYOqiIsD5$UicHmW@OL+

delta 1330
zcmchVO-vkR7{}-TLfILexG!6v+jR$;UD$pI4T6MzX|^9Uty|a%tSnHAv&>t0ahahz
z3k5;f7`%wKnmIISZByc*+C~#yYa2cEpjGtb2VRWvpwXxYJv1?Cz4-3TlE#bCi*uOC
z|9PJGeV%82|Aong$(NJpdi(GPeuRoDeTY;%(Anm62NKTZKok0$F9LNwZ6G~3G^{$m
z1?CEAK5ChL{3$j<>6FcSSys>UX|_+#GrLCm`vc{zd)75HZfa@k+!gOS*wee>r`3VA
zYOOlN4QA%~G0t*>x;@HFgPTvJPH-bXHZaX?p2@O)Q=ec;HJX(be{g;1-ms>Lf`X{H
zb7HkNJ(c0dr+9vrMrGM;vO$ZeM+`Akw`G*t7&5&gE)wmVw1_rb%IwWC@ixi_Hf#5(
z{kGUkrn*<SRc%%KpX8>YP}_^Ns~rU`mDMvWt5Cyhv`yWi4NS9~%`H=*2`~7dTC1f;
zt%(V-q^)?d-P&I5XsPcZ-OeW`nOT}?S>(iW`y-k*Sjz1-40obXaJ^qkXx%dXQXaC$
z^c+i`Fj;OTWO#{3WO;=8-9+iSE`#SSk@b?PQj&6Wn&$-@K}&q5Y&jZV_}S$Xjc@Td
zMOSgT|2i6P^|a#9U~OSZdRMw3eJp(~eJA}Q-IQ(tsDcl7;cnC*ghn)@1D)80?bw4P
z4x<-+ID#>7jKjtZW-*6(JdYQ!h?j5@r*RJFaRE!Xgm+NH6}*S*SjMOL3}4}U{D2?v
z6Mn}n+{T~#NhMiBd_*Q|NtkG)p0twfWCz(vdPtI_iB86eMP|H-3Cf#1wz^R{KI>G~
z-A@v(b;JK;UFY+<*@9Z%u<EEg9`jt85<Xxva><X>x8nLyjW)`{26RnXZrUtlf>wDl
z+_F^`o}<K-YPhXk5ze9&W!cgxBs`(++@%PQ(F2ubT^|=(az!}2uS?vsOy&Q`4@*ug
z*ueJS0D4?HeMsRbM({W?FfaiV7LE%}^LQH1;8{E;D7`2+ox&?PgR^*5u)2uX@dhsA
zO+o4^uHk)rh>vgspOl$>D~SDyo5f4PM}62*R5z?6&UmDz_;92duPsI^oZ%R)9y^$|
zMl)F}BbZQ0!lE-D>u_$z>YQ(4^Um3g0cURGb*H_y=6@c!*H`ql{!v+MYC490J?O>1
E0G+;C2LJ#7

diff --git a/src/.cproject b/src/.cproject
deleted file mode 100644
index f06ffd45..00000000
--- a/src/.cproject
+++ /dev/null
@@ -1,119 +0,0 @@
-<?xml version="1.0" encoding="UTF-8" standalone="no"?>
-<?fileVersion 4.0.0?><cproject storage_type_id="org.eclipse.cdt.core.XmlProjectDescriptionStorage">
-	<storageModule moduleId="org.eclipse.cdt.core.settings">
-		<cconfiguration id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582">
-			<storageModule buildSystemId="org.eclipse.cdt.managedbuilder.core.configurationDataProvider" id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582" moduleId="org.eclipse.cdt.core.settings" name="Default">
-				<externalSettings/>
-				<extensions>
-					<extension id="org.eclipse.cdt.core.PE" point="org.eclipse.cdt.core.BinaryParser"/>
-					<extension id="org.eclipse.cdt.core.GASErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-					<extension id="org.eclipse.cdt.core.GLDErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-					<extension id="org.eclipse.cdt.core.GCCErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-					<extension id="org.eclipse.cdt.core.GmakeErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-					<extension id="org.eclipse.cdt.core.CWDLocator" point="org.eclipse.cdt.core.ErrorParser"/>
-				</extensions>
-			</storageModule>
-			<storageModule moduleId="cdtBuildSystem" version="4.0.0">
-				<configuration buildProperties="" description="" id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582" name="Default" optionalBuildProperties="" parent="org.eclipse.cdt.build.core.emptycfg">
-					<folderInfo id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582.1127462783" name="/" resourcePath="">
-						<toolChain id="cdt.managedbuild.toolchain.gnu.mingw.base.1035458335" name="MinGW GCC" superClass="cdt.managedbuild.toolchain.gnu.mingw.base">
-							<targetPlatform archList="all" binaryParser="org.eclipse.cdt.core.PE" id="cdt.managedbuild.target.gnu.platform.mingw.base.1085348987" name="Debug Platform" osList="win32" superClass="cdt.managedbuild.target.gnu.platform.mingw.base"/>
-							<builder id="cdt.managedbuild.builder.gnu.cross.1398979264" managedBuildOn="false" superClass="cdt.managedbuild.builder.gnu.cross"/>
-							<tool id="cdt.managedbuild.tool.gnu.assembler.mingw.base.1518750006" name="GCC Assembler" superClass="cdt.managedbuild.tool.gnu.assembler.mingw.base">
-								<inputType id="cdt.managedbuild.tool.gnu.assembler.input.1540650047" superClass="cdt.managedbuild.tool.gnu.assembler.input"/>
-							</tool>
-							<tool id="cdt.managedbuild.tool.gnu.archiver.mingw.base.909230791" name="GCC Archiver" superClass="cdt.managedbuild.tool.gnu.archiver.mingw.base"/>
-							<tool id="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base.462309889" name="GCC C++ Compiler" superClass="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base"/>
-							<tool id="cdt.managedbuild.tool.gnu.c.compiler.mingw.base.1803672067" name="GCC C Compiler" superClass="cdt.managedbuild.tool.gnu.c.compiler.mingw.base">
-								<inputType id="cdt.managedbuild.tool.gnu.c.compiler.input.1946895431" superClass="cdt.managedbuild.tool.gnu.c.compiler.input"/>
-							</tool>
-							<tool id="cdt.managedbuild.tool.gnu.c.linker.mingw.base.1010477471" name="MinGW C Linker" superClass="cdt.managedbuild.tool.gnu.c.linker.mingw.base">
-								<inputType id="cdt.managedbuild.tool.gnu.c.linker.input.1282503363" superClass="cdt.managedbuild.tool.gnu.c.linker.input">
-									<additionalInput kind="additionalinputdependency" paths="$(USER_OBJS)"/>
-									<additionalInput kind="additionalinput" paths="$(LIBS)"/>
-								</inputType>
-							</tool>
-							<tool id="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base.625915771" name="MinGW C++ Linker" superClass="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base"/>
-						</toolChain>
-					</folderInfo>
-				</configuration>
-			</storageModule>
-			<storageModule moduleId="org.eclipse.cdt.core.externalSettings"/>
-		</cconfiguration>
-		<cconfiguration id="cdt.managedbuild.toolchain.gnu.mingw.base.2024424744">
-			<storageModule buildSystemId="org.eclipse.cdt.managedbuilder.core.configurationDataProvider" id="cdt.managedbuild.toolchain.gnu.mingw.base.2024424744" moduleId="org.eclipse.cdt.core.settings" name="Default">
-				<externalSettings/>
-				<extensions>
-					<extension id="org.eclipse.cdt.core.PE" point="org.eclipse.cdt.core.BinaryParser"/>
-					<extension id="org.eclipse.cdt.core.GASErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-					<extension id="org.eclipse.cdt.core.GmakeErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-					<extension id="org.eclipse.cdt.core.GLDErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-					<extension id="org.eclipse.cdt.core.CWDLocator" point="org.eclipse.cdt.core.ErrorParser"/>
-					<extension id="org.eclipse.cdt.core.GCCErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
-				</extensions>
-			</storageModule>
-			<storageModule moduleId="cdtBuildSystem" version="4.0.0">
-				<configuration buildProperties="" description="" id="cdt.managedbuild.toolchain.gnu.mingw.base.2024424744" name="Default" optionalBuildProperties="" parent="org.eclipse.cdt.build.core.emptycfg">
-					<folderInfo id="cdt.managedbuild.toolchain.gnu.mingw.base.2024424744.1785269505" name="/" resourcePath="">
-						<toolChain id="cdt.managedbuild.toolchain.gnu.mingw.base.653372581" name="MinGW GCC" superClass="cdt.managedbuild.toolchain.gnu.mingw.base">
-							<targetPlatform archList="all" binaryParser="org.eclipse.cdt.core.PE" id="cdt.managedbuild.target.gnu.platform.mingw.base.2053374167" name="Debug Platform" osList="win32" superClass="cdt.managedbuild.target.gnu.platform.mingw.base"/>
-							<builder id="cdt.managedbuild.builder.gnu.cross.2064603808" managedBuildOn="false" superClass="cdt.managedbuild.builder.gnu.cross"/>
-							<tool id="cdt.managedbuild.tool.gnu.assembler.mingw.base.522448096" name="GCC Assembler" superClass="cdt.managedbuild.tool.gnu.assembler.mingw.base">
-								<inputType id="cdt.managedbuild.tool.gnu.assembler.input.1719103837" superClass="cdt.managedbuild.tool.gnu.assembler.input"/>
-							</tool>
-							<tool id="cdt.managedbuild.tool.gnu.archiver.mingw.base.1922443684" name="GCC Archiver" superClass="cdt.managedbuild.tool.gnu.archiver.mingw.base"/>
-							<tool id="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base.1187222196" name="GCC C++ Compiler" superClass="cdt.managedbuild.tool.gnu.cpp.compiler.mingw.base">
-								<inputType id="cdt.managedbuild.tool.gnu.cpp.compiler.input.2095853106" superClass="cdt.managedbuild.tool.gnu.cpp.compiler.input"/>
-							</tool>
-							<tool id="cdt.managedbuild.tool.gnu.c.compiler.mingw.base.1663302345" name="GCC C Compiler" superClass="cdt.managedbuild.tool.gnu.c.compiler.mingw.base">
-								<inputType id="cdt.managedbuild.tool.gnu.c.compiler.input.1672570293" superClass="cdt.managedbuild.tool.gnu.c.compiler.input"/>
-							</tool>
-							<tool id="cdt.managedbuild.tool.gnu.c.linker.mingw.base.19363403" name="MinGW C Linker" superClass="cdt.managedbuild.tool.gnu.c.linker.mingw.base"/>
-							<tool id="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base.103511842" name="MinGW C++ Linker" superClass="cdt.managedbuild.tool.gnu.cpp.linker.mingw.base">
-								<inputType id="cdt.managedbuild.tool.gnu.cpp.linker.input.85834039" superClass="cdt.managedbuild.tool.gnu.cpp.linker.input">
-									<additionalInput kind="additionalinputdependency" paths="$(USER_OBJS)"/>
-									<additionalInput kind="additionalinput" paths="$(LIBS)"/>
-								</inputType>
-							</tool>
-						</toolChain>
-					</folderInfo>
-				</configuration>
-			</storageModule>
-		</cconfiguration>
-	</storageModule>
-	<storageModule moduleId="cdtBuildSystem" version="4.0.0">
-		<project id="adda-asd.null.975128964" name="adda-asd"/>
-	</storageModule>
-	<storageModule moduleId="org.eclipse.cdt.core.LanguageSettingsProviders"/>
-	<storageModule moduleId="refreshScope" versionNumber="2">
-		<configuration configurationName="Default">
-			<resource resourceType="PROJECT" workspacePath="/adda-master"/>
-		</configuration>
-	</storageModule>
-	<storageModule moduleId="org.eclipse.cdt.make.core.buildtargets">
-		<buildTargets>
-			<target name="seq" path="" targetID="org.eclipse.cdt.build.MakeTargetBuilder">
-				<buildCommand>make</buildCommand>
-				<buildArguments/>
-				<buildTarget>seq</buildTarget>
-				<stopOnError>true</stopOnError>
-				<useDefaultCommand>true</useDefaultCommand>
-				<runAllBuilders>true</runAllBuilders>
-			</target>
-			<target name="mpi" path="" targetID="org.eclipse.cdt.build.MakeTargetBuilder">
-				<buildCommand>make</buildCommand>
-				<buildArguments/>
-				<buildTarget>mpi</buildTarget>
-				<stopOnError>true</stopOnError>
-				<useDefaultCommand>true</useDefaultCommand>
-				<runAllBuilders>true</runAllBuilders>
-			</target>
-		</buildTargets>
-	</storageModule>
-	<storageModule moduleId="scannerConfiguration">
-		<autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId=""/>
-		<scannerConfigBuildInfo instanceId="cdt.managedbuild.toolchain.gnu.mingw.base.1055110387;cdt.managedbuild.toolchain.gnu.mingw.base.1055110387.763791221;cdt.managedbuild.tool.gnu.c.compiler.mingw.base.1203535434;cdt.managedbuild.tool.gnu.c.compiler.input.557581763">
-			<autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId=""/>
-		</scannerConfigBuildInfo>
-	</storageModule>
-</cproject>
diff --git a/src/.gitignore b/src/.gitignore
index d20142b6..3102371d 100644
--- a/src/.gitignore
+++ b/src/.gitignore
@@ -19,4 +19,10 @@
 /*/*.clstr
 
 
+*.DS_Store
+*.project
+*.cproject
+githash.h
+
+
 
diff --git a/src/.project b/src/.project
deleted file mode 100644
index 0fbe4c7f..00000000
--- a/src/.project
+++ /dev/null
@@ -1,26 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<projectDescription>
-	<name>adda-master</name>
-	<comment></comment>
-	<projects>
-	</projects>
-	<buildSpec>
-		<buildCommand>
-			<name>org.eclipse.cdt.managedbuilder.core.genmakebuilder</name>
-			<triggers>clean,full,incremental,</triggers>
-			<arguments>
-			</arguments>
-		</buildCommand>
-		<buildCommand>
-			<name>org.eclipse.cdt.managedbuilder.core.ScannerConfigBuilder</name>
-			<triggers>full,incremental,</triggers>
-			<arguments>
-			</arguments>
-		</buildCommand>
-	</buildSpec>
-	<natures>
-		<nature>org.eclipse.cdt.core.cnature</nature>
-		<nature>org.eclipse.cdt.managedbuilder.core.managedBuildNature</nature>
-		<nature>org.eclipse.cdt.managedbuilder.core.ScannerConfigNature</nature>
-	</natures>
-</projectDescription>
diff --git a/src/.settings/language.settings.xml b/src/.settings/language.settings.xml
deleted file mode 100644
index 66a6a6ee..00000000
--- a/src/.settings/language.settings.xml
+++ /dev/null
@@ -1,27 +0,0 @@
-<?xml version="1.0" encoding="UTF-8" standalone="no"?>
-<project>
-	<configuration id="cdt.managedbuild.toolchain.gnu.mingw.base.1965246582" name="Default">
-		<extension point="org.eclipse.cdt.core.LanguageSettingsProvider">
-			<provider copy-of="extension" id="org.eclipse.cdt.ui.UserLanguageSettingsProvider"/>
-			<provider-reference id="org.eclipse.cdt.core.ReferencedProjectsLanguageSettingsProvider" ref="shared-provider"/>
-			<provider class="org.eclipse.cdt.managedbuilder.language.settings.providers.GCCBuildCommandParser" id="org.eclipse.cdt.managedbuilder.core.GCCBuildCommandParser" keep-relative-paths="false" name="CDT GCC Build Output Parser" parameter="(g?cc)|([gc]\+\+)|(clang)" prefer-non-shared="true"/>
-			<provider class="org.eclipse.cdt.managedbuilder.internal.language.settings.providers.GCCBuiltinSpecsDetectorMinGW" console="false" env-hash="1736031386934720504" id="org.eclipse.cdt.managedbuilder.core.GCCBuiltinSpecsDetectorMinGW" keep-relative-paths="false" name="CDT GCC Built-in Compiler Settings MinGW" parameter="${COMMAND} ${FLAGS} -E -P -v -dD &quot;${INPUTS}&quot;" prefer-non-shared="true">
-				<language-scope id="org.eclipse.cdt.core.gcc"/>
-				<language-scope id="org.eclipse.cdt.core.g++"/>
-			</provider>
-			<provider-reference id="org.eclipse.cdt.managedbuilder.core.MBSLanguageSettingsProvider" ref="shared-provider"/>
-		</extension>
-	</configuration>
-	<configuration id="cdt.managedbuild.toolchain.gnu.mingw.base.2024424744" name="Default">
-		<extension point="org.eclipse.cdt.core.LanguageSettingsProvider">
-			<provider copy-of="extension" id="org.eclipse.cdt.ui.UserLanguageSettingsProvider"/>
-			<provider-reference id="org.eclipse.cdt.core.ReferencedProjectsLanguageSettingsProvider" ref="shared-provider"/>
-			<provider copy-of="extension" id="org.eclipse.cdt.managedbuilder.core.GCCBuildCommandParser"/>
-			<provider class="org.eclipse.cdt.managedbuilder.internal.language.settings.providers.GCCBuiltinSpecsDetectorMinGW" console="false" env-hash="1736031386934720504" id="org.eclipse.cdt.managedbuilder.core.GCCBuiltinSpecsDetectorMinGW" keep-relative-paths="false" name="CDT GCC Built-in Compiler Settings MinGW" parameter="${COMMAND} ${FLAGS} -E -P -v -dD &quot;${INPUTS}&quot;" prefer-non-shared="true">
-				<language-scope id="org.eclipse.cdt.core.gcc"/>
-				<language-scope id="org.eclipse.cdt.core.g++"/>
-			</provider>
-			<provider-reference id="org.eclipse.cdt.managedbuilder.core.MBSLanguageSettingsProvider" ref="shared-provider"/>
-		</extension>
-	</configuration>
-</project>
diff --git a/src/.settings/org.eclipse.cdt.codan.core.prefs b/src/.settings/org.eclipse.cdt.codan.core.prefs
deleted file mode 100644
index 73293b43..00000000
--- a/src/.settings/org.eclipse.cdt.codan.core.prefs
+++ /dev/null
@@ -1,77 +0,0 @@
-eclipse.preferences.version=1
-org.eclipse.cdt.codan.checkers.errnoreturn=Warning
-org.eclipse.cdt.codan.checkers.errnoreturn.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"No return\\")",implicit\=>false}
-org.eclipse.cdt.codan.checkers.errreturnvalue=Error
-org.eclipse.cdt.codan.checkers.errreturnvalue.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Unused return value\\")"}
-org.eclipse.cdt.codan.checkers.nocommentinside=-Error
-org.eclipse.cdt.codan.checkers.nocommentinside.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Nesting comments\\")"}
-org.eclipse.cdt.codan.checkers.nolinecomment=-Error
-org.eclipse.cdt.codan.checkers.nolinecomment.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Line comments\\")"}
-org.eclipse.cdt.codan.checkers.noreturn=Error
-org.eclipse.cdt.codan.checkers.noreturn.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"No return value\\")",implicit\=>false}
-org.eclipse.cdt.codan.internal.checkers.AbstractClassCreation=Error
-org.eclipse.cdt.codan.internal.checkers.AbstractClassCreation.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Abstract class cannot be instantiated\\")"}
-org.eclipse.cdt.codan.internal.checkers.AmbiguousProblem=Error
-org.eclipse.cdt.codan.internal.checkers.AmbiguousProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Ambiguous problem\\")"}
-org.eclipse.cdt.codan.internal.checkers.AssignmentInConditionProblem=Warning
-org.eclipse.cdt.codan.internal.checkers.AssignmentInConditionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Assignment in condition\\")"}
-org.eclipse.cdt.codan.internal.checkers.AssignmentToItselfProblem=Error
-org.eclipse.cdt.codan.internal.checkers.AssignmentToItselfProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Assignment to itself\\")"}
-org.eclipse.cdt.codan.internal.checkers.CaseBreakProblem=Warning
-org.eclipse.cdt.codan.internal.checkers.CaseBreakProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"No break at end of case\\")",no_break_comment\=>"no break",last_case_param\=>false,empty_case_param\=>false,enable_fallthrough_quickfix_param\=>false}
-org.eclipse.cdt.codan.internal.checkers.CatchByReference=Warning
-org.eclipse.cdt.codan.internal.checkers.CatchByReference.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Catching by reference is recommended\\")",unknown\=>false,exceptions\=>()}
-org.eclipse.cdt.codan.internal.checkers.CircularReferenceProblem=Error
-org.eclipse.cdt.codan.internal.checkers.CircularReferenceProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Circular inheritance\\")"}
-org.eclipse.cdt.codan.internal.checkers.ClassMembersInitialization=Warning
-org.eclipse.cdt.codan.internal.checkers.ClassMembersInitialization.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Class members should be properly initialized\\")",skip\=>true}
-org.eclipse.cdt.codan.internal.checkers.DecltypeAutoProblem=Error
-org.eclipse.cdt.codan.internal.checkers.DecltypeAutoProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid 'decltype(auto)' specifier\\")"}
-org.eclipse.cdt.codan.internal.checkers.FieldResolutionProblem=Error
-org.eclipse.cdt.codan.internal.checkers.FieldResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Field cannot be resolved\\")"}
-org.eclipse.cdt.codan.internal.checkers.FunctionResolutionProblem=Error
-org.eclipse.cdt.codan.internal.checkers.FunctionResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Function cannot be resolved\\")"}
-org.eclipse.cdt.codan.internal.checkers.InvalidArguments=Error
-org.eclipse.cdt.codan.internal.checkers.InvalidArguments.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid arguments\\")"}
-org.eclipse.cdt.codan.internal.checkers.InvalidTemplateArgumentsProblem=Error
-org.eclipse.cdt.codan.internal.checkers.InvalidTemplateArgumentsProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid template argument\\")"}
-org.eclipse.cdt.codan.internal.checkers.LabelStatementNotFoundProblem=Error
-org.eclipse.cdt.codan.internal.checkers.LabelStatementNotFoundProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Label statement not found\\")"}
-org.eclipse.cdt.codan.internal.checkers.MemberDeclarationNotFoundProblem=Error
-org.eclipse.cdt.codan.internal.checkers.MemberDeclarationNotFoundProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Member declaration not found\\")"}
-org.eclipse.cdt.codan.internal.checkers.MethodResolutionProblem=Error
-org.eclipse.cdt.codan.internal.checkers.MethodResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Method cannot be resolved\\")"}
-org.eclipse.cdt.codan.internal.checkers.NamingConventionFunctionChecker=-Info
-org.eclipse.cdt.codan.internal.checkers.NamingConventionFunctionChecker.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Name convention for function\\")",pattern\=>"^[a-z]",macro\=>true,exceptions\=>()}
-org.eclipse.cdt.codan.internal.checkers.NonVirtualDestructorProblem=Warning
-org.eclipse.cdt.codan.internal.checkers.NonVirtualDestructorProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Class has a virtual method and non-virtual destructor\\")"}
-org.eclipse.cdt.codan.internal.checkers.OverloadProblem=Error
-org.eclipse.cdt.codan.internal.checkers.OverloadProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid overload\\")"}
-org.eclipse.cdt.codan.internal.checkers.RedeclarationProblem=Error
-org.eclipse.cdt.codan.internal.checkers.RedeclarationProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid redeclaration\\")"}
-org.eclipse.cdt.codan.internal.checkers.RedefinitionProblem=Error
-org.eclipse.cdt.codan.internal.checkers.RedefinitionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Invalid redefinition\\")"}
-org.eclipse.cdt.codan.internal.checkers.ReturnStyleProblem=-Warning
-org.eclipse.cdt.codan.internal.checkers.ReturnStyleProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Return with parenthesis\\")"}
-org.eclipse.cdt.codan.internal.checkers.ScanfFormatStringSecurityProblem=-Warning
-org.eclipse.cdt.codan.internal.checkers.ScanfFormatStringSecurityProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Format String Vulnerability\\")"}
-org.eclipse.cdt.codan.internal.checkers.StatementHasNoEffectProblem=Warning
-org.eclipse.cdt.codan.internal.checkers.StatementHasNoEffectProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Statement has no effect\\")",macro\=>true,exceptions\=>()}
-org.eclipse.cdt.codan.internal.checkers.SuggestedParenthesisProblem=Warning
-org.eclipse.cdt.codan.internal.checkers.SuggestedParenthesisProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Suggested parenthesis around expression\\")",paramNot\=>false}
-org.eclipse.cdt.codan.internal.checkers.SuspiciousSemicolonProblem=Warning
-org.eclipse.cdt.codan.internal.checkers.SuspiciousSemicolonProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Suspicious semicolon\\")",else\=>false,afterelse\=>false}
-org.eclipse.cdt.codan.internal.checkers.TypeResolutionProblem=Error
-org.eclipse.cdt.codan.internal.checkers.TypeResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Type cannot be resolved\\")"}
-org.eclipse.cdt.codan.internal.checkers.UnusedFunctionDeclarationProblem=Warning
-org.eclipse.cdt.codan.internal.checkers.UnusedFunctionDeclarationProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Unused function declaration\\")",macro\=>true}
-org.eclipse.cdt.codan.internal.checkers.UnusedStaticFunctionProblem=Warning
-org.eclipse.cdt.codan.internal.checkers.UnusedStaticFunctionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Unused static function\\")",macro\=>true}
-org.eclipse.cdt.codan.internal.checkers.UnusedVariableDeclarationProblem=Warning
-org.eclipse.cdt.codan.internal.checkers.UnusedVariableDeclarationProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Unused variable declaration in file scope\\")",macro\=>true,exceptions\=>("@(\#)","$Id")}
-org.eclipse.cdt.codan.internal.checkers.UsingInHeaderProblem=-Warning
-org.eclipse.cdt.codan.internal.checkers.UsingInHeaderProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Using directive in header\\")"}
-org.eclipse.cdt.codan.internal.checkers.VariableResolutionProblem=Error
-org.eclipse.cdt.codan.internal.checkers.VariableResolutionProblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>true,RUN_ON_INC_BUILD\=>true,RUN_ON_FILE_OPEN\=>false,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>"@suppress(\\"Symbol is not resolved\\")"}
-org.eclipse.cdt.qt.core.qtproblem=Warning
-org.eclipse.cdt.qt.core.qtproblem.params={launchModes\=>{RUN_ON_FULL_BUILD\=>false,RUN_ON_INC_BUILD\=>false,RUN_ON_FILE_OPEN\=>true,RUN_ON_FILE_SAVE\=>false,RUN_AS_YOU_TYPE\=>true,RUN_ON_DEMAND\=>true},suppression_comment\=>null}
diff --git a/src/fort/special_functions.f90 b/src/fort/special_functions.f90
deleted file mode 100644
index 674d693f..00000000
--- a/src/fort/special_functions.f90
+++ /dev/null
@@ -1,91 +0,0 @@
-subroutine bjndd ( n, x, bj, dj, fj )
-
-!*****************************************************************************80
-!
-!! BJNDD computes Bessel functions Jn(x) and first and second derivatives.
-!
-!  Licensing:
-!
-!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
-!    they give permission to incorporate this routine into a user program 
-!    provided that the copyright is acknowledged.
-!
-!  Modified:
-!
-!    11 July 2012
-!
-!  Author:
-!
-!    Shanjie Zhang, Jianming Jin
-!
-!  Reference:
-!
-!    Shanjie Zhang, Jianming Jin,
-!    Computation of Special Functions,
-!    Wiley, 1996,
-!    ISBN: 0-471-11963-6,
-!    LC: QA351.C45.
-!
-!  Parameters:
-!
-!    Input, integer ( kind = 4 ) N, the order.
-!
-!    Input, real ( kind = 8 ) X, the argument.
-!
-!    Output, real ( kind = 8 ) BJ(N+1), DJ(N+1), FJ(N+1), the values of 
-!    Jn(x), Jn'(x) and Jn''(x) in the last entries.
-!
-  implicit none
-
-  integer ( kind = 4 ) n
-
-  real ( kind = 8 ) bj(n+1)
-  real ( kind = 8 ) bs
-  real ( kind = 8 ) dj(n+1)
-  real ( kind = 8 ) f
-  real ( kind = 8 ) f0
-  real ( kind = 8 ) f1
-  real ( kind = 8 ) fj(n+1)
-  integer ( kind = 4 ) k
-  integer ( kind = 4 ) m
-  integer ( kind = 4 ) mt
-  integer ( kind = 4 ) nt
-  real ( kind = 8 ) x
-
-  do nt = 1, 900
-    mt = int ( 0.5D+00 * log10 ( 6.28D+00 * nt ) &
-      - nt * log10 ( 1.36D+00 * abs ( x ) / nt ) )
-    if ( 20 < mt ) then
-      exit
-    end if
-  end do
-
-  m = nt
-  bs = 0.0D+00
-  f0 = 0.0D+00
-  f1 = 1.0D-35
-  do k = m, 0, -1
-    f = 2.0D+00 * ( k + 1.0D+00 ) * f1 / x - f0
-    if ( k <= n ) then
-      bj(k+1) = f
-    end if
-    if ( k == 2 * int ( k / 2 ) ) then
-      bs = bs + 2.0D+00 * f
-    end if
-    f0 = f1
-    f1 = f
-  end do
-
-  do k = 0, n
-    bj(k+1) = bj(k+1) / ( bs - f )
-  end do
-
-  dj(1) = -bj(2)
-  fj(1) = -1.0D+00 * bj(1) - dj(1) / x
-  do k = 1, n
-    dj(k+1) = bj(k) - k * bj(k+1) / x
-    fj(k+1) = ( k * k / ( x * x ) - 1.0D+00 ) * bj(k+1) - dj(k+1) / x
-  end do
-
-  return
-end
\ No newline at end of file
diff --git a/src/githash.h b/src/githash.h
index bedb0897..069658fb 100644
--- a/src/githash.h
+++ b/src/githash.h
@@ -1 +1 @@
-#define GITHASH "99523db"
+#define GITHASH "bc2963d"

From 945f7a74d0b2fe8a40001b00516be473da8aff86 Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Fri, 12 Nov 2021 14:39:10 +0700
Subject: [PATCH 26/46] trying to remove .DS_Store

---
 .DS_Store     | Bin 10244 -> 10244 bytes
 .gitignore    |   3 +++
 .project      |  26 --------------------------
 src/.DS_Store | Bin 14340 -> 0 bytes
 4 files changed, 3 insertions(+), 26 deletions(-)
 delete mode 100644 .project
 delete mode 100644 src/.DS_Store

diff --git a/.DS_Store b/.DS_Store
index ba317a80f3dc78a6c0b464467231655f5581e6fd..9ee372a1ddad79ba180e6a57ec7d14f4cdbea5f4 100644
GIT binary patch
delta 1123
zcmeIxTS!z<6b9h+@4TFYJKZ`*=QL@f4kenJ-KMk)VrHq4lg%_iQI2`2A=7l!hpg=4
zON3@_jED+)GU)=PL}gSEmi7=tRzwkGbRmp{pofy^Fe5=vQqS$T^)J{gzP)y<tJT#}
z2K|bwKL)zwLXU~0Y}!tKYM>p|NR?6-?V#Rnk<R2$Y?OQ%m#p%sHn(SkcO#dN6XK=S
zQkN$h14g+~?Q8Hi8HK(EBcRcr2kPZ$YhudGj5!N(mlYJ1mJP><*f_3n*=H#Rmp?5z
zWjxK6t_q*x4*2&Np?)UMRz*N{@ATJH1rys`K3@@4s;AmlX;g<ICts|HQq|jJ)Cc^v
zHKEYFd7sv)<u|*6gE;atLIXL7By_DsC54h`9u?9Ws-SvmrZzfB=ctbc=srEA*Yuu7
z=^Frsa6}*q8j@f~GE$I%*~mgRmY@(TQG{}A!e(s2R#agZYOou1XhI7P;1CYu2s$Cr
zg%dc7Zk$ICuA<+GTeyuoc!cM8gAu&NC_dv0#_)rMv2Yf_be6(WnS(jmB9_mJSvm8v
z3OOEMV)ENptu8Jp{mq{`Ilugn;5V7qS+fMUi*Qp=8P=!Srq4>_vfVnv!^IR+UJYgo
zGwobpqR7qTT!fi#5b7;YGE15$3Rc+dLJ@<CqB#B$`UQ>9M;fDX6FM3e=tx5joLFkI
zu7wNh;fBYgtw1HV1$k>t+<FAC7yC`%gC_A&wBZ;!a2%&_8fSvcJ-C32xP)toxQ-jR
viF+8p0}Nsa5Ag)A@D88wwfC-`8QB||{5?!Q({leWOX!PWl4Z&It7Z8Gs5SUV

delta 1233
zcmchVT}V@57{{Og(eNBj=Ib_gbbd@3Y1*nqDlN#yv`i;$=u8XJW}aZQ=Eqd94^EkN
z(HGT$N-Bab!agu!Sy|9U5fwy`SwtBMK{t6*q!$IzVP{=*p%;C<H}CuWpO=^S`TzcX
zzCPbEFQn_fyD5;=xhzdx#d?A0eOAB$>ZGACQ%tt_>(<vdY-nPvD<ap(p+IM_TP_cD
z$`MsDx2w5EW4a&=&XY28=NB$1a;|i*@pwm5SgJuZiR!qq5~5mQa(KmjOM$=wygw4$
zA?tm+xL9Bj!M`mSZiy+DrQ$N4wFq^gK(idur4n&D&pbkXx7-m4wuW_4dwIZgLZSGw
zxeE1@&1KRL{%~NsY;!sEDlW!v6M=ZjA_uvtiW;endgu_Hr1NxxhUg|eq-XSs#^?im
zqR%u%)AS9ANJa`6Qei;`vXG61C{j?261d?(HP*okKQ^Hen-RcPw4x0ih@c0(*oXZ%
zfTK8t)9A+qT)|Zg;u`MZ5uRfNFEEC87{>%Y;tQrQ&GB3+XW)!n9+%HKI49@kDmb71
zeGc(4Hj=u)?9>2RE7n$4d8%gt1VJ@OK@G$%X%Q2xY>wtJKbn?q$;itW)nO@H5m|!9
zMu=&}cB{w`FPtkxktJ%B^j>L}R#LohmszchXODTFxBc|?_fRM^v3Now^qMAUQe*KQ
z3E&|i2YIk-#+Sl{GL&PrX1)(KsEq+=((G@>7K9Mi5VUI$c49Xa?7?0f#9<tXf#}B>
zoW(g@!~ibgvKdhf;TCRV7<cdhPw^6O@ILxB&7O3;EhCzg^EFZF)RNyCuGO}#$e#{8
a)4a1}Px&=`|2=!E#a!`s($?^=()I)VH3Lcj

diff --git a/.gitignore b/.gitignore
index 17494861..a5a34e3a 100644
--- a/.gitignore
+++ b/.gitignore
@@ -15,3 +15,6 @@
 /*/*.geom
 /*/out
 /*/*.clstr
+
+*.project
+*.DS_Store
diff --git a/.project b/.project
deleted file mode 100644
index 5f126b26..00000000
--- a/.project
+++ /dev/null
@@ -1,26 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<projectDescription>
-	<name>adda</name>
-	<comment></comment>
-	<projects>
-	</projects>
-	<buildSpec>
-		<buildCommand>
-			<name>org.eclipse.cdt.managedbuilder.core.genmakebuilder</name>
-			<triggers>clean,full,incremental,</triggers>
-			<arguments>
-			</arguments>
-		</buildCommand>
-		<buildCommand>
-			<name>org.eclipse.cdt.managedbuilder.core.ScannerConfigBuilder</name>
-			<triggers>full,incremental,</triggers>
-			<arguments>
-			</arguments>
-		</buildCommand>
-	</buildSpec>
-	<natures>
-		<nature>org.eclipse.cdt.core.cnature</nature>
-		<nature>org.eclipse.cdt.managedbuilder.core.managedBuildNature</nature>
-		<nature>org.eclipse.cdt.managedbuilder.core.ScannerConfigNature</nature>
-	</natures>
-</projectDescription>
diff --git a/src/.DS_Store b/src/.DS_Store
deleted file mode 100644
index fb536121ee08d4e92e731b7ac5b857fb866b7e62..0000000000000000000000000000000000000000
GIT binary patch
literal 0
HcmV?d00001

literal 14340
zcmeHOYit}>6~1Tun)QzDN#fFUYo|^OL<E!CN%L?@Q@=vvHmQRjv6GZ+_A!Y^ncdm!
z?5-0+z(V3#C@Q}y9{q<vRD_3kMDPcxP#%K*fB-5&NE9LQZhr8m0tvozXV#gQt^BA^
zK{M9OoqO*&=broBbM8I&&RPgT6ZPVV5W_+U6*s54hQ|km7~s@*aXsIWs|6*5dm1<1
zbs=_(<!Q?<<SjcNp^g?PC}RFrdE3GX@k5{(hv>uqmX{FC6y+fuQIcE<0to^M0to^M
z0to_lf&j0*xYV?pCeH+c1c3yBH3WEm7{JZxn3t})shm3S;1HhcIfR!N-Z^aNvH>q0
z^U_r}MGY=;S&_P|<ZUs?Wk>mdM>poBt8VJD3z98Ej@L4II~0<wqkKS;3mS9N<e4Cl
zAP`01UKDkRipYs7?h<z31>X*yo$1T|9e9M=zuyNn^@pfcPj(*CWA^v-WQaZu`l>KQ
zL1aZun9#_G>O`;J5m!hz<wA%nC1%ADoG?s@<4AX-tzxL}<KVdNJ9S_V8+3VSRTUSa
znn|=a<_Kve5%Y7j04GCS3Th&8ilNG{I2G@-<wm|@nNDqZ_?M)#w6?W(s2yrreb?Nw
zy)swJ)#}bfu6l-Z^R{i}oA0^&Nz+)#>b;Y8xt24_MpZJHMFS*HESlw_y)t3f%SA`>
z&bbw8N=;?;tyiz^+cP{guxIq(wV{Elqx}BB-u>6ErPR9y?|*PMd(kSD?T@-fN8ZFO
zy4?KQ6BdBeBiZMoQ?T;Tj_bT4>%z!f!7f!Kx&FDQeKk&F((QW7zGl~d-Ryd*Gp%)H
z<`+&bYNxXL<_7vWQ>mGD**R%c9i&;k#{m}81-pErYH<Bx!M5t9vXj*}6>?UgZslsm
zxMj_m?>11@;}oj4Wu34clf|4`su`DSTo<WYI_=oi+N2bg)%Ch#%o>noHjF7qbe2ps
z$&9_SOSd1Cy54<v-}X1{y8nUEhbG?f*v!oyebeSGy_$9!pqFdrdDEyateC~x@~NCt
zFv>-<d||O+I%eK7=F7Q~v5AIKDap0<o=j$`o;NSm&Ds@xP*r7V|F(?wL=j3Hw~H*T
zsDDFs>33|)WX^ESWYxg4=rO!`XGWWMpsSwq2;VxSY4aCh6}sa!H9Vqa7OY&}u=HZe
zZD-$pEwk8gan>L63J>*anI(*530-l#vcnH&GH1EjV>zcbQ!&a=>4#q1lThgt*Nqp8
zQlZWIrk>2v%%iIQGxfByoU0l$D=^oaUissyD#sM%EbU0qtl4Xovs|g0<%S7Q!0@>a
zp$<0D9~|4|z79To%YBi6rUu7`JrY&)i#?brj)`;d{Hx;Q;u-Or_`3MMctQL^{8s!)
zydqvDqIODAC#9*E`sqFzpzXAa4$vqaq6cY;PS87Pmd?;Q%2R=gRH7=?s7?)fAANv6
zL?5P)&?o6r^cngrJxiabuh3WNYxEuZG5v&oN-xr{=y&uo{ht0xf1_9E7X4FcRoawx
zWvjAX*`W+7`;`OAm@=)*DvQdJtGUwjyVG7zyhO?2rRii&!<$8v>+!DC_sG%dN3~=B
zGp_Vfx9dE2z2WWw_NapojjtJ>YpqQK^_#u4^?-*+TbH&FveTPzv3vXawfmYL81~Es
zIEistWuMeLT<RU#8&x=o-sWa^YHv~D9(uc*9qQYy!Xb4<X0?&Ny(zez-r{D5`VOR2
zo!rbJ?d>Tzpx)|c`?axDN*6NIH`#YYg%j!OYh~RpiI>G6#VzqKSa&yVp{=x&hUp+3
zrla&Y&A^`LXo1dBmU6Iaw&^le=n^^f9=Zm*UZwZblk_oqiatS4!?r&S>t@^j0)3I5
zqc71n>05MzzD>{5_vi)s0sRQp{&V^b{ek{We+k*}@t_UUKW^J_$)1|>RzkJf(t6L0
zXP(FE-L&wMUEH9yvg})AwjhjI<7>=S%a&b6<bWLse+F?7la%FMi?04MF7dC@OwaK`
zSw=LG*h)quetHe`ZY;*@VHUg<lmx%3uzKiO>o#9pqI$6s>$Xl*vLSs;OcJ2)fcz`a
z#fZ~}W0L@Nm#Blb2u)1zEz8Jn8NF}<Ux&~S#w)<tE*dft<vxevP{wLq+K~PdpQn8I
z0J7vt5J(V65J(URAn-QiI^`aC3eOT|UtU8ZvoFu6Vz+Nb)x;!dE$q|lc;+zA8*&dF
znzea99O5g4_-w?}k@k339N<f%rDe2{$2x>{1aFNPF5XM}wd?>_32TuhF2_(~_1S<r
zw5IU-6QFK~Y+l>r&P*7sXMJe-X+v@)LVnuRnp|6sL`hr>odqy9eh%&>(>fT1NUXrC
zbAY-9)D=+)$z&}2GCeB)j=U3$RW#(tKR%*~44VYWFD8yB3;@8QZXZ}32pxE!>+6Lw
z8&HR2vl#`b+r)YN#f5HwX&uV2Oh6T&Y=uNN;#v?=#v-1s2`T~ePB7Oob_FP9%2AAr
zAp0J@*9TBqJOY3?rsOj__PmMcP_SJExKfdLEZi{$%im6y7w5X|_%#f9IosGBa)#Sv
zF#T<|N)%!ZE0!)KPh$1=09G7>Hjy$hYs8!<O04``-OyqM@we;Y733_*$ETQ~VU{N5
z=T$+=b12V_F|oMBY9snkk2ppqKYfp!r7uFCEc}?yZP{`Po`#{3kw)m}R&myu6U=?y
z?N!id89(K$4?k75R+G5JI6Na4p*O(84sj)Fm5f$^z6G?vH>d^oIgYC7IPe>h24hW(
zh*A9Q6$c~`v1Stx6weicT!QeT4}=zU2LK0^lwFUZ@++Bg8KoWZsdhv`iHBcElp~}Z
z+mGVs=<?d&F|Ep3!NLTMmcj~4RQ;T3kCRvZbw`*j=yrR_{$Khw`*++T0=o@-FG%+P
z$^M@wtK>=$NDxR6czq$z=BhKCMtWrZ-~Ye9luoos5J(VsO%b5hskx~Mh~xu_xQl;l
zH-P&bZl?JzZocp?S?~z_5D*#uIo?4@<UK$$#;-_M-Bhw7FIkcPmwpHsvkOc1|MLH}
Tyf2G^4Rf;phq3-Y?*IP-rjEU4


From 0f2143df61fa31a9c157e47ea76db360225cb7b8 Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Fri, 12 Nov 2021 14:39:54 +0700
Subject: [PATCH 27/46] Delete .DS_Store

---
 .DS_Store | Bin 10244 -> 0 bytes
 1 file changed, 0 insertions(+), 0 deletions(-)
 delete mode 100644 .DS_Store

diff --git a/.DS_Store b/.DS_Store
deleted file mode 100644
index 9ee372a1ddad79ba180e6a57ec7d14f4cdbea5f4..0000000000000000000000000000000000000000
GIT binary patch
literal 0
HcmV?d00001

literal 10244
zcmeHMYitx%6u#f|HDeb#Ed}aI>6WS})KXrR3h4HQlvkT>OG`o8-JOw6n9kIl*)3Yp
zs=t&FU(pz&B>qyOVq(<bBl^Rj=nsD=YB0t`jK&y@BpMT=iJm)mw(f4>pZJJ#H*?Ru
z=bm%!z27}&?%cbKF|?<(m5fCgV=_IQsv*kGlXyFSW+lnz)DQ*fGtEhw3EMVjNd}An
zfdGL3fdGL3fdGMj3j(xf^CXuG8sq^20RjO6GYIhaLxdhqqduJ$)O&SM<{bfu78Bb`
zR91O`XvC*cpH2%(EtDWsi3(NtM+^vc;zxYBs86Q_73vKB;RAlp@J}f4dMEo4Pn;nt
zXpjd81PIJVfS=uqSrgmG4CdyZ-^;R0HpbE{k=rCQjp;1ITxQeHWKOqfCljWfAX_~A
z+URNe-Ah#Bmj?y%xyFj9(Pqg46E75)@TGDUOK8Lvo1nqD`O2s*P|lIeHBiR3v2NDE
zy4VgDV_gMC4iy+FX5-YMQ#exmav{0gt`ycs-L$bzww-7bnbPvRllB#uDW$IBBsW3$
z>iM!BzDIKK&6CaTwup?R3P;R1wz=xQRASPZ@E7rTV!|{Wx4HQfNJYgZrDbxNTrS@f
z8?z^4Zrn{f?eWxZUhAjJo<z1BPwX`G$q}`>!?xVGVd*JP!O(OP*)wQZnmyTWr!CF#
zbYr4HR%B&Ft(lryyQ;Y{vZ{66!N$l`D=)8E-E#1tBF}GFvA%C)zd3H%_tD5H!QTVe
z98sUi`I`B&IS&k`lj#r>ELxkL;AhzhDwmXp=7jqPb`B1OM%1bd&7^0-HEhe-siz#G
zBWi_1Gwx2>R&Pq@?So0%Opja6h+3J9o5{2pcl9>Yj2XA-#H(<UDcdxAZO7ndb`81u
z0hhPUY8o1L?3CN#85=UlzK~MWj^3w}Q6r;wl4+-UW}cz|<=EVXi|Vgfwqi}|#`aBH
zdrnoTl~tkY(1O8?;TQ>1ADA>WcWhVON$QqnSo?+va?3StHuRKIiAJU0ijV83s?^Gg
znoGmsp>)EyC2hF3stvL%Y%LB)6!m3!k4F7(w>7S*c`f0^;mc)tH|KYxbjk%gv^0FR
zqQ>QZhbAgaG=`cK)lvHQ)A|e5m7&$Lswo3zJfWL{)e>4Kt6P=9jKEqjt3w-PWhiNn
zkJF$X!Mh>cCaWjqy}aXXamVeM&@JklPoZORIJ}GV+cZtr{27EdhquV;hw`v97EkFt
zljM}b(B|+CS@zbH_}o&LX1MlDV;^r+4J%`izti#wx0f5DQ@tMe4bf#{5gM|K;$hhk
zZ5DNfUV61`6$Sh@HcBx##SXK_*i-B!c7nabK4xFAZ`fJ(GXM!CC`CD{QHwf6P>*F;
zj%(0__2@(wHlYu@u?KrG0uAG^Fo9c;!JU}K-M9z$;vqbYNAM_);AuRAqj(Xo;|;ut
zx9|Zz#g{mPuW%OM;|H9>uTrs8B9%%tQoXc9YLHr_Yo(~vE%ix*(x@1^l#Q<8?9_aI
zoTwjN6iWWPLOOQ-P^!CebN805|D8}eJ(ma1yz2Q27DjkPt=rf(<9fnVv(B08^q!yR
zMTh6-o-Y*oD23Q%i)ur40~84Qfx^(thOAn~15-Z5rR$f3>eLbn6;Zu%DOF1;Ohk2g
zV_lspQFMxG^UAuAT12s@c)DvFsS3Z+dR-`_7E=_8w(D!D%KS=u2btk9CI404eVUzN
z-?DS;H}dYen1>oHMKfBkfqZ!fdJ#iE2FRaBkwDV(X`4Jc1qZj|4)W@|$gdCKFz&|#
zco2`{2|Vff_E9{G=kPpU!EwBb*YGw@;9Z==dw3ro;d6YA@9<-R4{y)+Vf^%`4`*U2
z%d{=N@p6wZq0bqe_Di?$bH@9e$lWh<By)F}5;p05k+iTi`TI5awv=yRMl#m`Nd+lD
zAV45MAV45M;Nl}tB)W+3`~R*B|NnpS2NLuUAP^w%k0F5K&RAzVb)P-?6^?}8wMXa~
zrH3ajH!Y~ALYa3RPt?1PrwYH0zlt6%>z|3ea@6Nd3+kzpjHgcYZ~8N!itYu1^M7#u
N=T68Il>goN{|^QpOV$7Y


From 84297f0ad2c8588f9e16ab4fb798bc419bd19e2c Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Mon, 22 Nov 2021 22:11:01 +0700
Subject: [PATCH 28/46] minor changes

---
 src/GenerateB.c | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/GenerateB.c b/src/GenerateB.c
index 6f84922b..8ab98565 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -336,7 +336,6 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 	int n1,N,it,q; // for Bessel beams
 	doublecomplex vort;  // vortex phase of Bessel beam rotated on 90 deg
 	doublecomplex fn[5]; // for general functions f(n,ro,phi) of Bessel beams (fn-2, fn-1, fn, fn+1, fn+2 respectively)
-	doublecomplex sum[3],fint[3];
 	double phi,arg,td1[abs(n0)+3],td2[abs(n0)+3],jn1[abs(n0)+3],r,tht,db; // for Bessel beams
 	const char *fname;
 	/* TO ADD NEW BEAM

From 836fa5cdac574cc4dca1081977264ad286c0bcc5 Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Sun, 5 Dec 2021 16:15:18 +0700
Subject: [PATCH 29/46] minor changes

---
 .gitignore | 23 +++++------------------
 1 file changed, 5 insertions(+), 18 deletions(-)

diff --git a/.gitignore b/.gitignore
index a5a34e3a..88756031 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,20 +1,7 @@
+# If you need some ignores, which are specific to your workflow (e.g. IDE), consider
+# including them into $GIT_DIR/info/exclude (in this repository) or globally into $XDG_CONFIG_HOME/git/ignore
+# See https://git-scm.com/docs/gitignore 
 # The same ignores apply to all compilation folders
-/*/*.exe
-/*/*.dll
-/*/adda*
-/*/*.o
-/*/*.obj
-/*/*.d
-/*/.*opts
-/*/*stackdump
-/*/ExpCount
-/*/tables/
-/*/run*/
-/*/test*/
-/*/*.dat
-/*/*.geom
-/*/out
-/*/*.clstr
 
-*.project
-*.DS_Store
+.сproject
+.project 

From 9b87dd4b83e4bed97867a2b7f857a05c7ea56be1 Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Sun, 5 Dec 2021 16:17:35 +0700
Subject: [PATCH 30/46] minor changes

---
 src/.gitignore | 9 ---------
 1 file changed, 9 deletions(-)

diff --git a/src/.gitignore b/src/.gitignore
index 3102371d..890b1e4f 100644
--- a/src/.gitignore
+++ b/src/.gitignore
@@ -17,12 +17,3 @@
 /*/*.geom
 /*/out
 /*/*.clstr
-
-
-*.DS_Store
-*.project
-*.cproject
-githash.h
-
-
-

From 34019823d5d8330d78b56b3c6346f340e35586fa Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Sun, 5 Dec 2021 16:22:06 +0700
Subject: [PATCH 31/46] minor changes

---
 src/GenerateB.c | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/src/GenerateB.c b/src/GenerateB.c
index 8ab98565..d3e450b5 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -31,6 +31,7 @@
 #include "interaction.h"
 #include "param.h"
 #include "vars.h"
+// system headers
 #include <stdio.h>
 #include <string.h>
 
@@ -93,6 +94,7 @@ void InitBeam(void)
 	/* TO ADD NEW BEAM
 	 * Add here all intermediate variables, which are used only inside this function.
 	 */
+	
 	// initialization of global option index for error messages
 	opt=opt_beam;
 	// beam initialization
@@ -320,6 +322,7 @@ void InitBeam(void)
 }
 
 //======================================================================================================================
+
 void GenerateB (const enum incpol which,   // x - or y polarized incident light
                 doublecomplex *restrict b) // the b vector for the incident field
 // generates incident beam at every dipole
@@ -646,10 +649,10 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 	 * complex vector 'b', describing the incident field in the particle reference frame. It is set inside the cycle for
 	 * each dipole of the particle and is calculated using
 	 * 1) 'DipoleCoord' ďż˝ array of dipole coordinates;
-	 * 2) 'prop' ďż˝ propagation direction of the incident field;
-	 * 3) 'ex' ďż˝ direction of incident polarization;
-	 * 4) 'ey' ďż˝ complementary unity vector of polarization (orthogonal to both 'prop' and 'ex');
-	 * 5) 'beam_center' ďż˝ beam center in the particle reference frame (automatically calculated from 'beam_center_0'
+	 * 2) 'prop' - propagation direction of the incident field;
+	 * 3) 'ex' - direction of incident polarization;
+	 * 4) 'ey' - complementary unity vector of polarization (orthogonal to both 'prop' and 'ex');
+	 * 5) 'beam_center' - beam center in the particle reference frame (automatically calculated from 'beam_center_0'
 	 *                    defined in InitBeam).
 	 * If the new beam type is compatible with '-surf', include here the corresponding code. For that you will need
 	 * the variables, related to surface - see vars.c after "// related to a nearby surface".

From bad2a81e6b2dec253250e6c673403aea652113d8 Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Sun, 5 Dec 2021 16:23:26 +0700
Subject: [PATCH 32/46] minor changes

---
 src/GenerateB.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/GenerateB.c b/src/GenerateB.c
index d3e450b5..62234dcc 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -648,7 +648,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 	 * add a case above. Identifier ('B_...') should be defined inside 'enum beam' in const.h. This case should set
 	 * complex vector 'b', describing the incident field in the particle reference frame. It is set inside the cycle for
 	 * each dipole of the particle and is calculated using
-	 * 1) 'DipoleCoord' ďż˝ array of dipole coordinates;
+	 * 1) 'DipoleCoord' - array of dipole coordinates;
 	 * 2) 'prop' - propagation direction of the incident field;
 	 * 3) 'ex' - direction of incident polarization;
 	 * 4) 'ey' - complementary unity vector of polarization (orthogonal to both 'prop' and 'ex');

From 736010c0d82d5fd688535e4582fc446fbb752d07 Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Sun, 5 Dec 2021 16:29:13 +0700
Subject: [PATCH 33/46] minor changes

---
 src/Makefile | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Makefile b/src/Makefile
index cf2b8874..8867cd3e 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -176,7 +176,7 @@ FFTW3_LIB_PATH := "/opt/homebrew/lib"
 # If your environment does not specify search path for Fortran libraries, you may get errors during linking of ADDA.
 # For instance, this may happen on macOS. Then uncomment the following line and modify the path if needed. 
 # This variable can also be defined in the enviroment or in the command line of make (see explanation above for OPTIONS) 
-FORT_LIB_PATH := /usr/local/gfortran/lib
+#FORT_LIB_PATH := /usr/local/gfortran/lib
 
 #=======================================================================================================================
 # !!! End of control section. Everything below is not designed to be modified by user. However, advanced users may wish

From e0887a4bbc1ec532df73ed10062ad2d8a612754f Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Sun, 5 Dec 2021 16:30:30 +0700
Subject: [PATCH 34/46] minor changes

---
 src/const.h | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/const.h b/src/const.h
index d7cee3cf..d832ddcc 100644
--- a/src/const.h
+++ b/src/const.h
@@ -107,7 +107,7 @@ the compilation may fail or produce wrong results. If you still want to try, ena
 // sizes of some arrays
 #define MAX_NMAT         15   // maximum number of different refractive indices (<256)
 #define MAX_N_SH_PARMS   25   // maximum number of shape parameters
-#define MAX_N_BEAM_PARMS 13   // maximum number of beam parameters
+#define MAX_N_BEAM_PARMS 10   // maximum number of beam parameters
 
 // sizes of filenames and other strings
 /* There is MAX_PATH constant that equals 260 on Windows. However, even this OS allows ways to override this limit. On

From 9d2dc6e7be0bbcd7ac5ec3b318a628f013d3a37f Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Sun, 5 Dec 2021 16:31:58 +0700
Subject: [PATCH 35/46] Delete githash.h

---
 src/githash.h | 1 -
 1 file changed, 1 deletion(-)
 delete mode 100644 src/githash.h

diff --git a/src/githash.h b/src/githash.h
deleted file mode 100644
index 069658fb..00000000
--- a/src/githash.h
+++ /dev/null
@@ -1 +0,0 @@
-#define GITHASH "bc2963d"

From b2a40b0678a2eecb5be9947ff15c4c73dafe9bbc Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Sun, 5 Dec 2021 16:36:55 +0700
Subject: [PATCH 36/46] minor changes

---
 src/ocl/Makefile | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/ocl/Makefile b/src/ocl/Makefile
index 24925d07..93ae4823 100644
--- a/src/ocl/Makefile
+++ b/src/ocl/Makefile
@@ -21,9 +21,9 @@
 # Depending on a particular OpenCL installation one may need to manually specify paths to corresponding headers and
 # libraries. Path should be absolute or relative to the location of this Makefile.
 # On Windows it is also possible to link to OpenCL.dll directly (but not if it is located in C:/Windows/System32).
-CFLAGS += -I"C:/OpenCL-Headers"
-CFLAGS += -I"C:/clFFT-2.12.2-Windows-x64/include"
-LDFLAGS += -L"C:/clFFT-2.12.2-Windows-x64/bin"
+#CFLAGS += -I"C:/msys/local/OpenCL-Headers"
+#CFLAGS += -I"C:/Program Files/NVIDIA GPU Computing Toolkit/CUDA/v3.2/include"
+#LDFLAGS += -L"C:/Program Files/NVIDIA GPU Computing Toolkit/CUDA/v3.2/lib/Win32"
 
 # This workaround is to disable linker warnings when linking against 32-bit OpenCL.dll on 64-bit Windows. The issue 
 # appeared with Nvidia library supplied with driver 301.42. Uncomment the following 3 lines to enable it.
@@ -47,7 +47,7 @@ else # the following is only for non-sparse mode
     # On Windows (as in example below) it is recommended to link to *.dll instead of *.lib
     #CFLAGS  += -I"C:/msys/local/clFFT-2.12.2/include"
     #LDFLAGS += -L"C:/msys/local/clFFT-2.12.2/bin"
-    
+  
     LDLIBS += -lclFFT
 
     # On Unix clFFT may need pthread library, which is not linked by default; if yes, uncomment the following

From bede24c16710254b342fb2d8245083ddb0ff71b3 Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Sun, 5 Dec 2021 16:42:36 +0700
Subject: [PATCH 37/46] minor changes

---
 src/parbas.h | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/parbas.h b/src/parbas.h
index 65769454..971a5e17 100644
--- a/src/parbas.h
+++ b/src/parbas.h
@@ -25,7 +25,7 @@
  * removed, then even MPI 2.0 will do.
  */
 #define MPI_VER_REQ 2
-#define MPI_SUBVER_REQ 0
+#define MPI_SUBVER_REQ 1
 // check MPI version for conformity during compilation
 #if !defined(MPI_VERSION) || !defined(MPI_SUBVERSION)
 #	error "Can not determine MPI version, hence MPI is too old."

From 1c4323eff81cbec008b39d2f0eafef0e3f06fa32 Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Sun, 5 Dec 2021 16:46:01 +0700
Subject: [PATCH 38/46] minor changes

---
 src/Makefile | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Makefile b/src/Makefile
index 8867cd3e..f23b53bd 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -169,8 +169,8 @@ override EXTRA_FLAGS +=
 #FFTW3_LIB_PATH := $(FFTWLIB)
 #FFTW3_INC_PATH := $(HOME)/include
 #FFTW3_LIB_PATH := $(HOME)/lib
-FFTW3_INC_PATH := "/opt/homebrew/include"
-FFTW3_LIB_PATH := "/opt/homebrew/lib"
+#FFTW3_INC_PATH := "$(abspath ./../lib)"
+#FFTW3_LIB_PATH := "$(abspath ./../lib)"
 
 # --Fortran library path--
 # If your environment does not specify search path for Fortran libraries, you may get errors during linking of ADDA.

From c66f1956339e0b7feb61c102c5a3b3d4caba3fcb Mon Sep 17 00:00:00 2001
From: Maxim Yurkin <yurkin@gmail.com>
Date: Tue, 7 Dec 2021 10:20:24 +0700
Subject: [PATCH 39/46] visible changes: - disables all code related to Bessel
 beams when NO_FORTRAN is used - edits a lot of help and information messages,
 including names of some Bessel beams types - beam center in laboratory
 reference frame is now specified always (even when at origin) - calculation
 of Cext through F(0) is now used only for default position of the plane wave
 - fixes processing of imaginary part of matrix M (for Bessel beams), by
 changing the type to doublecomplex - removes beam-center position in
 descriptive strings for beams (since it is printed separately in param.c) -
 plane wave in surface mode now works fine with -beam_center. Removes a lot of
 redundant code there (probably was used long ago for alternative calculation
 of Cext)

minor/stylistic changes:
- shortens define handles for Bessel beams
- changes required number of subarguments for '-beam dipole' to UNDEF
- moves beam_center below beam in lists of command line options (to be in alphabetical order)
- renames use_beam_center and use_beam_subopt into beam_center_used and deprecated_bc_used, respectively
- adds auxiliary function ScanDouble3Error() in param.c
- removes redundant checks for number of arguments for most Bessel beam types
- processing of deprecated specification of beam center as an argument to '-beam' is now in param.c
- updates instructions for adding new beams
- updates .gitignore
- removes mentioning of eIncRefl[3],eIncTran[3] from crosssec.c
- beam_center_0 is now defined in vars.c/h
---
 .gitignore       |   5 +-
 src/CalculateE.c |   6 +-
 src/GenerateB.c  | 198 ++++++++++++++++++++---------------------------
 src/const.h      |  16 ++--
 src/crosssec.c   |   8 +-
 src/param.c      | 137 ++++++++++++++++----------------
 src/vars.c       |   8 +-
 src/vars.h       |   2 +-
 8 files changed, 184 insertions(+), 196 deletions(-)

diff --git a/.gitignore b/.gitignore
index 88756031..6c3d0012 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,7 +1,10 @@
 # If you need some ignores, which are specific to your workflow (e.g. IDE), consider
 # including them into $GIT_DIR/info/exclude (in this repository) or globally into $XDG_CONFIG_HOME/git/ignore
 # See https://git-scm.com/docs/gitignore 
-# The same ignores apply to all compilation folders
 
+# for MacOS
+.DS_Store
+
+# for Eclipse
 .сproject
 .project 
diff --git a/src/CalculateE.c b/src/CalculateE.c
index 7460b097..769b0e94 100644
--- a/src/CalculateE.c
+++ b/src/CalculateE.c
@@ -197,8 +197,10 @@ void MuellerMatrix(void)
 				si=sin(alph);
 				for (i=0;i<nTheta;i++) {
 					// transform amplitude matrix, multiplying by rotation matrix (-alpha)
-					// Note, that amplitude matrix for vortex beams (Bessel beams) have to be multiplied
-					// by phase factor exp(-I*n0*alpha)
+					/* Note, that amplitude matrix for vortex beams (e.g., Bessel ones) have to be additionally
+					 * multiplied by the phase factor exp(-I*n0*alpha). However, it does not change the Mueller matrix
+					 * and we do not save the amplitude matrix in this case.
+					 */
 					if (yzplane) { // here the default (alpha=0) is yz-plane, so par=Y, per=X
 						s2 =  co*ampl_alphaY[index+1] + si*ampl_alphaX[index+1]; // s2 =  co*s20 + si*s30
 						s3 = -si*ampl_alphaY[index+1] + co*ampl_alphaX[index+1]; // s3 = -si*s20 + co*s30
diff --git a/src/GenerateB.c b/src/GenerateB.c
index 62234dcc..e1197049 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -43,28 +43,9 @@ extern const double beam_pars[];
 extern const char *beam_fnameY;
 extern const char *beam_fnameX;
 extern const opt_index opt_beam;
-extern const bool use_beam_center;
-extern const bool use_beam_subopt;
-
-extern void bjndd_(int *n, double *x, double *bj, double *dj, double *fj);
-
-
 
 // used in CalculateE.c
 double C0dipole,C0dipole_refl; // inherent cross sections of exciting dipole (in free space and addition due to surface)
-
-// used in crosssec.c
-double beam_center_0[3]; // position of the beam center in laboratory reference frame
-/* complex wave amplitudes of secondary waves (with phase relative to particle center);
- * The transmitted wave can be inhomogeneous wave (when msub is complex), then eIncTran (e) is normalized
- * counter-intuitively. Before multiplying by tc, it satisfies (e,e)=1!=||e||^2. This normalization is consistent with
- * used formulae for transmission coefficients. So this transmission coefficient is not (generally) equal to the ratio
- * of amplitudes of the electric fields. In particular, when E=E0*e, ||E||!=|E0|*||e||, where
- * ||e||^2=(e,e*)=|e_x|^2+|e_y|^2+|e_z|^2=1
- *
- * !!! TODO: determine whether they are actually needed in crosssec.c, or make them static here
- */
-doublecomplex eIncRefl[3],eIncTran[3];
 // used in param.c
 const char *beam_descr; // string for log file with beam parameters
 
@@ -74,15 +55,23 @@ static double scale_x,scale_z; // multipliers for scaling coordinates
 static doublecomplex ki,kt;    // abs of normal components of k_inc/k0, and ktran/k0
 static doublecomplex ktVec[3]; // k_tran/k0
 static double p0;              // amplitude of the incident dipole moment
+#ifndef NO_FORTRAN
 static int n0;                 // Bessel beam order
 static double alpha0;          // half-cone angle
-static doublecomplex K,Kt,Kz;  // wave vector components
-static double M[4];		   	   // Matrix M components
+static doublecomplex K,Kt,Kz;  // wave-vector components
+static doublecomplex M[4];     // Components of matrix M
+#endif
 /* TO ADD NEW BEAM
  * Add here all internal variables (beam parameters), which you initialize in InitBeam() and use in GenerateB()
  * afterwards. If you need local, intermediate variables, put them into the beginning of the corresponding function.
  * Add descriptive comments, use 'static'.
  */
+ 
+// EXTERNAL FUNCTIONS
+
+#ifndef NO_FORTRAN 
+void bjndd_(const int *n,const double *x,double *bj,double *dj,double *fj);
+#endif
 
 //======================================================================================================================
 
@@ -98,14 +87,15 @@ void InitBeam(void)
 	// initialization of global option index for error messages
 	opt=opt_beam;
 	// beam initialization
-	if (use_beam_center==true && use_beam_subopt==true) LogError(ONE_POS,"Beam center coordinates can not "
-			"be defined both in -beam and in -beam_center options. Please define in only one of the options.");
+	beam_asym=(beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0);
+	if (!beam_asym) vInit(beam_center); // not to calculate it for each orientation
 	switch (beamtype) {
 		case B_PLANE:
 			if (IFROOT) beam_descr="plane wave";
-			beam_asym=false;
 			if (surface) {
-				if (use_beam_center==true) LogError(ONE_POS,"Plane wave currently does not support -beam_center with -surf");
+				/* here we assume that prop_0 will not change further (e.g., by rotation of particle), 
+				 * i.e. prop=prop_0 in GenerateBeam() below
+				 */				
 				if (prop_0[2]==0) PrintError("Ambiguous setting of beam propagating along the surface. Please specify "
 					"the incident direction to have (arbitrary) small positive or negative z-component");
 				if (msubInf && prop_0[2]>0) PrintError("Perfectly reflecting surface ('-surf ... inf') is incompatible "
@@ -149,24 +139,17 @@ void InitBeam(void)
 			}
 			return;
 		case B_DIPOLE:
-			if (use_beam_subopt==true){
-				LogWarning(EC_WARN,ALL_POS,"Providing beam center coordinates from the -beam option will be deprecated soon. Please use -beam_center option instead.");
-				vCopy(beam_pars,beam_center_0);
-			}
 			if (surface) {
 				if (beam_center_0[2]<=-hsub)
 					PrintErrorHelp("External dipole should be placed strictly above the surface");
 				inc_scale=1; // but scaling of Mueller matrix is weird anyway
 			}
-			// in weird scenarios the dipole can be positioned exactly at the origin; reused code from Gaussian beams
-			beam_asym=(beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0);
-			if (!beam_asym) vInit(beam_center);
 			/* definition of p0 is important for scaling of many scattering quantities (that are normalized to incident
 			 * irradiance). Alternative definition is p0=1, but then the results will scale with unit of length
 			 * (breaking scale invariance)
 			 */
 			p0=1/(WaveNum*WaveNum*WaveNum);
-			if (IFROOT) beam_descr=dyn_sprintf("point dipole at "GFORMDEF3V,COMP3V(beam_center_0));
+			if (IFROOT) beam_descr="point dipole";
 			return;
 		case B_LMINUS:
 		case B_DAVIS3:
@@ -175,12 +158,6 @@ void InitBeam(void)
 			// initialize parameters
 			w0=beam_pars[0];
 			TestPositive(w0,"beam width");
-			if (use_beam_subopt==true){
-				LogWarning(EC_WARN,ALL_POS,"Providing beam center coordinates from the -beam option will be deprecated soon. Please use -beam_center option instead.");
-				vCopy(beam_pars+1,beam_center_0);
-			}
-			beam_asym=(beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0);
-			if (!beam_asym) vInit(beam_center);
 			s=1/(WaveNum*w0);
 			s2=s*s;
 			scale_x=1/w0;
@@ -200,17 +177,17 @@ void InitBeam(void)
 					default: LogError(ONE_POS,"Incompatibility error in GenerateB");
 				}
 				beam_descr=dyn_sprintf("Gaussian beam (%s)\n"
-				                       "\tWidth="GFORMDEF" (confinement factor s="GFORMDEF")\n"
-				                       "\tCenter position: "GFORMDEF3V,tmp_str,w0,s,COMP3V(beam_center_0));
+				                       "\tWidth="GFORMDEF" (confinement factor s="GFORMDEF")\n",tmp_str,w0,s);
 			}
 			return;
-		case B_BESSELCS:
-		case B_BESSELCSp:
-		case B_BESSELM:
-		case B_BESSELLE:
-		case B_BESSELLM:
-		case B_BESSELTEL:
-		case B_BESSELTML:
+#ifndef NO_FORTRAN
+		case B_BES_CS:
+		case B_BES_CSp:
+		case B_BES_M:
+		case B_BES_LE:
+		case B_BES_LM:
+		case B_BES_TEL:
+		case B_BES_TML:
 			if (surface) PrintError("Currently, Bessel incident beam is not supported for '-surf'");
 			// initialize parameters
 			n0=round(beam_pars[0]);
@@ -218,73 +195,71 @@ void InitBeam(void)
 			K =fabs(WaveNum);
 			Kt=fabs(WaveNum)*sin(alpha0);
 			Kz=fabs(WaveNum)*cos(alpha0);
-			switch (beamtype) { // definition of matrix M elements ((Mex,Mey),(Mmx,Mmy))
-				case B_BESSELCS:
+			switch (beamtype) { // definition of elements of matrix M ((Mex,Mey),(Mmx,Mmy))
+				case B_BES_CS:
 					M[0]=0.5;	M[1]=0;
 					M[2]=0;		M[3]=0.5;
 					break;
-				case B_BESSELCSp:
+				case B_BES_CSp:
 					M[0]=0.5;	M[1]=0;
 					M[2]=0;		M[3]=-0.5;
 					break;
-				case B_BESSELM:
+				case B_BES_M:
 					M[0]=beam_pars[2]+I*beam_pars[6];
 					M[1]=beam_pars[3]+I*beam_pars[7];
 					M[2]=beam_pars[4]+I*beam_pars[8];
 					M[3]=beam_pars[5]+I*beam_pars[9];
 					break;
-				case B_BESSELLE:
+				case B_BES_LE:
 					M[0]=0;		M[1]=0;
 					M[2]=0;		M[3]=1;
 					break;
-				case B_BESSELLM:
+				case B_BES_LM:
 					M[0]=0;		M[1]=1;
 					M[2]=0;		M[3]=0;
 					break;
-				case B_BESSELTEL:
+				case B_BES_TEL:
 					M[0]=-K/Kt;		M[1]=0;
 					M[2]=0;			M[3]=Kz/Kt;
 					break;
-				case B_BESSELTML:
+				case B_BES_TML:
 					M[0]=0; 		M[1]=Kz/Kt;
 					M[2]=K/Kt;		M[2]=0;
 					break;
-				default: break;
+				default: LogError(ONE_POS,"Incompatibility error in GenerateB");
 			}
-			beam_asym=(beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0);
 			symR=symX=symY=symZ=false;
-			if (!beam_asym) vInit(beam_center);
 			// beam info
 			if (IFROOT) {
 				switch (beamtype) {
-					case B_BESSELCS:
+					case B_BES_CS:
 						tmp_str="circularly symmetric energy density";
 						break;
-					case B_BESSELCSp:
-						tmp_str="circularly symmetric energy density (alternative)";
+					case B_BES_CSp:
+						tmp_str="circularly symmetric energy density, alternative type";
 						break;
-					case B_BESSELM:
+					case B_BES_M:
 						tmp_str="generalized";
 						break;
-					case B_BESSELLE:
+					case B_BES_LE:
 						tmp_str="linear electric field";
 						break;
-					case B_BESSELLM:
+					case B_BES_LM:
 						tmp_str="linear magnetic field";
 						break;
-					case B_BESSELTEL:
-						tmp_str="forming the TE Bessel beam";
+					case B_BES_TEL:
+						tmp_str="linear component of the TE";
 						break;
-					case B_BESSELTML:
-						tmp_str="forming the TM Bessel beam";
+					case B_BES_TML:
+						tmp_str="linear component of the TM";
 						break;
 					default: LogError(ONE_POS,"Incompatibility error in GenerateB");
 				}
 				beam_descr=dyn_sprintf("Bessel beam (%s)\n"
-									   "\tOrder: ""%d""\n\t""Half-cone angle: "GFORMDEF"\n"
-									   "\tCenter position: "GFORMDEF3V,tmp_str,n0,alpha0,COMP3V(beam_center_0));
+									   "\tOrder: ""%d""\n\t""Half-cone angle: "GFORMDEF"\n",tmp_str,n0,alpha0);
 			}
 			return;
+#endif // !NO_FORTRAN
 		case B_READ:
 			// the safest is to assume cancellation of all symmetries
 			symX=symY=symZ=symR=false;
@@ -293,7 +268,7 @@ void InitBeam(void)
 				if (beam_Npars==1) beam_descr=dyn_sprintf("specified by file '%s'",beam_fnameY);
 				else beam_descr=dyn_sprintf("specified by files '%s' and '%s'",beam_fnameY,beam_fnameX);
 			}
-			// we do not define beam_asym here, because beam_center is not defined anyway
+			// this type is unaffected by beam_center
 			return;
 	}
 	LogError(ONE_POS,"Unknown type of incident beam (%d)",(int)beamtype);
@@ -308,11 +283,7 @@ void InitBeam(void)
 	 *    false here. Do not set any of them to true, as they can be set to false by other factors.
 	 *    symX, symY, symZ - symmetries of reflection over planes YZ, XZ, XY respectively.
 	 *    symR - symmetry of rotation for 90 degrees over the Z axis
-	 * 4) initialize the following:
-	 *    beam_descr - descriptive string, which will appear in log file.
-	 *    beam_asym - whether beam center does not coincide with the reference frame origin. If it is set to true, then
-	 *                set also beam_center_0 - 3D radius-vector of beam center in the laboratory reference frame (it
-	 *                will be then automatically transformed to particle reference frame, if required).
+	 * 4) initialize beam_descr - descriptive string, which will appear in log file.
 	 * 5) Consider the case of surface (substrate near the particle). If the new beam type is incompatible with it, add
 	 *    an explicit exception, like "if (surface) PrintErrorHelp(...);". Otherwise, you also need to define inc_scale.
 	 * All other auxiliary variables, which are used in beam generation (GenerateB(), see below), should be defined in
@@ -330,16 +301,27 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 	size_t i,j;
 	doublecomplex psi0,Q,Q2;
 	doublecomplex v1[3],v2[3],v3[3],gt[6];
-	double ro,ro2,ro4;
+	double ro2,ro4;
 	double x,y,z,x2_s,xy_s;
 	doublecomplex t1,t2,t3,t4,t5,t6,t7,t8,ctemp;
 	const double *ex; // coordinate axis of the beam reference frame
 	double ey[3];
 	double r1[3];
-	int n1,N,it,q; // for Bessel beams
+	/* complex wave amplitudes of secondary waves (with phase relative to particle center);
+	 * The transmitted wave can be inhomogeneous wave (when msub is complex), then eIncTran (e) is normalized
+	 * counter-intuitively. Before multiplying by tc, it satisfies (e,e)=1!=||e||^2. This normalization is consistent
+	 * with used formulae for transmission coefficients. So this transmission coefficient is not (generally) equal to
+	 * the ratio of amplitudes of the electric fields. In particular, when E=E0*e, ||E||!=|E0|*||e||, where
+	 * ||e||^2=(e,e*)=|e_x|^2+|e_y|^2+|e_z|^2=1
+	 */
+	doublecomplex eIncRefl[3],eIncTran[3];
+#ifndef NO_FORTRAN
+	double ro;
+	int n1,q; // for Bessel beams
 	doublecomplex vort;  // vortex phase of Bessel beam rotated on 90 deg
 	doublecomplex fn[5]; // for general functions f(n,ro,phi) of Bessel beams (fn-2, fn-1, fn, fn+1, fn+2 respectively)
-	double phi,arg,td1[abs(n0)+3],td2[abs(n0)+3],jn1[abs(n0)+3],r,tht,db; // for Bessel beams
+	double phi,arg,td1[abs(n0)+3],td2[abs(n0)+3],jn1[abs(n0)+3]; // for Bessel beams
+#endif
 	const char *fname;
 	/* TO ADD NEW BEAM
 	 * Add here all intermediate variables, which are used only inside this function. You may as well use 't1'-'t8'
@@ -367,27 +349,23 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				 * original medium.
 				 */
 				doublecomplex rc,tc; // reflection and transmission coefficients
+				double hbeam=hsub+beam_center[2]; // height of beam center above the surface 
 				if (prop[2]>0) { // beam comes from the substrate (below)
 					//  determine amplitude of the reflected and transmitted waves; here msub is always defined
 					if (which==INCPOL_Y) { // s-polarized
-						cvBuildRe(ex,eIncRefl);
 						cvBuildRe(ex,eIncTran);
-						rc=FresnelRS(ki,kt);
 						tc=FresnelTS(ki,kt);
 					}
 					else { // p-polarized
-						vInvRefl_cr(ex,eIncRefl);
 						crCrossProd(ey,ktVec,eIncTran);
-						rc=FresnelRP(ki,kt,1/msub);
 						tc=FresnelTP(ki,kt,1/msub);
 					}
-					// phase shift due to the origin at height hsub
-					cvMultScal_cmplx(rc*cexp(-2*I*WaveNum*ki*hsub),eIncRefl,eIncRefl);
-					cvMultScal_cmplx(tc*cexp(I*WaveNum*(kt-ki)*hsub),eIncTran,eIncTran);
+					// phase shift due to the beam center relative to the origin and surface
+					cvMultScal_cmplx(tc*cexp(I*WaveNum*((kt-ki)*hbeam-crDotProd(ktVec,beam_center))),eIncTran,eIncTran);
 					// main part
 					for (i=0;i<local_nvoid_Ndip;i++) {
 						j=3*i;
-						// b[i] = eIncTran*exp(ik*kt.r)
+						// b[i] = eIncTran*exp(ik*kt.r); subtraction of beam_center is avoided by the factor above
 						cvMultScal_cmplx(cexp(I*WaveNum*crDotProd(ktVec,DipoleCoord+j)),eIncTran,b+j);
 					}
 				}
@@ -395,46 +373,38 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 					// determine amplitude of the reflected and transmitted waves
 					if (which==INCPOL_Y) { // s-polarized
 						cvBuildRe(ex,eIncRefl);
-						if (msubInf) {
-							rc=-1;
-							tc=0; // to remove compiler warnings
-						}
+						if (msubInf) rc=-1;
 						else {
 							cvBuildRe(ex,eIncTran);
 							rc=FresnelRS(ki,kt);
-							tc=FresnelTS(ki,kt);
 						}
 					}
 					else { // p-polarized
 						vInvRefl_cr(ex,eIncRefl);
-						if (msubInf) {
-							rc=1;
-							tc=0; // to remove compiler warnings
-						}
+						if (msubInf) rc=1;
 						else {
 							crCrossProd(ey,ktVec,eIncTran);
 							cvMultScal_cmplx(1/msub,eIncTran,eIncTran); // normalize eIncTran by ||ktVec||=msub
 							rc=FresnelRP(ki,kt,msub);
-							tc=FresnelTP(ki,kt,msub);
 						}
 					}
-					// phase shift due to the origin at height hsub
-					cvMultScal_cmplx(rc*imExp(2*WaveNum*creal(ki)*hsub),eIncRefl,eIncRefl); // assumes real ki
-					if (!msubInf) cvMultScal_cmplx(tc*cexp(I*WaveNum*(ki-kt)*hsub),eIncTran,eIncTran);
+					// phase shift due to the beam center relative to the surface
+					cvMultScal_cmplx(rc*imExp(2*WaveNum*creal(ki)*hbeam),eIncRefl,eIncRefl); // assumes real ki
 					// main part
 					for (i=0;i<local_nvoid_Ndip;i++) {
 						j=3*i;
+						// together with above phase shift, beam_center affects only the common phase factor
+						LinComb(DipoleCoord+j,beam_center,1,-1,r1); 
 						// b[i] = ex*exp(ik*r.a) + eIncRefl*exp(ik*prIncRefl.r)
-						cvMultScal_RVec(imExp(WaveNum*DotProd(DipoleCoord+j,prop)),ex,b+j);
-						cvLinComb1_cmplx(eIncRefl,b+j,imExp(WaveNum*DotProd(DipoleCoord+j,prIncRefl)),b+j);
+						cvMultScal_RVec(imExp(WaveNum*DotProd(r1,prop)),ex,b+j);
+						cvLinComb1_cmplx(eIncRefl,b+j,imExp(WaveNum*DotProd(r1,prIncRefl)),b+j);
 					}
 				}
 			}
 			else for (i=0;i<local_nvoid_Ndip;i++) { // standard (non-surface) plane wave
 				j=3*i;
-				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
+				LinComb(DipoleCoord+j,beam_center,1,-1,r1); // this affects only the common phase factor
 				ctemp=imExp(WaveNum*DotProd(r1,prop)); // ctemp=exp(ik*r.a)
-				//ctemp=imExp(WaveNum*DotProd(DipoleCoord+j,prop)); // ctemp=exp(ik*r.a)
 				cvMultScal_RVec(ctemp,ex,b+j); // b[i]=ctemp*ex
 			}
 			return;
@@ -544,13 +514,14 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				}
 			}
 			return;
-		case B_BESSELCS:
-		case B_BESSELCSp:
-		case B_BESSELM:
-		case B_BESSELLE:
-		case B_BESSELLM:
-		case B_BESSELTEL:
-		case B_BESSELTML:
+#ifndef NO_FORTRAN
+		case B_BES_CS:
+		case B_BES_CSp:
+		case B_BES_M:
+		case B_BES_LE:
+		case B_BES_LM:
+		case B_BES_TEL:
+		case B_BES_TML:
 			if (which==INCPOL_X) vort = cpow(I,n0);
 			else vort = 1.;
 			for (i=0;i<local_nvoid_Ndip;i++) {
@@ -637,6 +608,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 				cvMultScal_cmplx(ctemp,v1,b+j);
 			}
 			return;
+#endif // !NO_FORTRAN		
 		case B_READ:
 			if (which==INCPOL_Y) fname=beam_fnameY;
 			else fname=beam_fnameX; // which==INCPOL_X
@@ -653,7 +625,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 	 * 3) 'ex' - direction of incident polarization;
 	 * 4) 'ey' - complementary unity vector of polarization (orthogonal to both 'prop' and 'ex');
 	 * 5) 'beam_center' - beam center in the particle reference frame (automatically calculated from 'beam_center_0'
-	 *                    defined in InitBeam).
+	 *                    defined by '-beam_center' command line option).
 	 * If the new beam type is compatible with '-surf', include here the corresponding code. For that you will need
 	 * the variables, related to surface - see vars.c after "// related to a nearby surface".
 	 * If you need temporary local variables (which are used only in this part of the code), either use 't1'-'t8' or
diff --git a/src/const.h b/src/const.h
index d832ddcc..b0748e48 100644
--- a/src/const.h
+++ b/src/const.h
@@ -285,13 +285,15 @@ enum incpol {
 
 enum beam { // beam types
 	B_BARTON5, // 5th order description of the Gaussian beam
-	B_BESSELCS, // Bessel beam with circularly symmetric energy density
-	B_BESSELCSp, // Alternative Bessel beam with circularly symmetric energy density
-	B_BESSELM, // Generalized Bessel beam
-	B_BESSELLE, // Bessel beam with linearly polarized electric field
-	B_BESSELLM, // Bessel beam with linearly polarized magnetic field
-	B_BESSELTEL, // Bessel beam forming TE Bessel beam
-	B_BESSELTML, // Bessel beam forming TM Bessel beam
+#ifndef NO_FORTRAN
+	B_BES_CS,  // Bessel beam with circularly symmetric energy density
+	B_BES_CSp, // Alternative Bessel beam with circularly symmetric energy density
+	B_BES_M,   // Generalized Bessel beam
+	B_BES_LE,  // Bessel beam with linearly polarized electric field
+	B_BES_LM,  // Bessel beam with linearly polarized magnetic field
+	B_BES_TEL, // Linear component of the TE Bessel beam
+	B_BES_TML, // Linear component of the TM Bessel beam
+#endif
 	B_DAVIS3,  // 3rd order description of the Gaussian beam
 	B_DIPOLE,  // field of a point dipole
 	B_LMINUS,  // 1st order description of the Gaussian beam
diff --git a/src/crosssec.c b/src/crosssec.c
index c62b23fb..a533f66e 100644
--- a/src/crosssec.c
+++ b/src/crosssec.c
@@ -40,9 +40,6 @@ extern const doublecomplex cc[][3];
 #ifndef SPARSE
 extern doublecomplex * restrict expsX,* restrict expsY,* restrict expsZ;
 #endif
-// defined and initialized in GenerateB.c
-extern const double beam_center_0[3];
-//extern doublecomplex eIncRefl[3],eIncTran[3];
 // defined and initialized in param.c
 extern const double incPolX_0[3],incPolY_0[3];
 extern const enum scat ScatRelation;
@@ -831,7 +828,8 @@ double ExtCross(const double * restrict incPol)
 	double sum;
 	size_t i;
 
-	if (beamtype==B_PLANE && !surface) {
+	// this can be considered a legacy case, which works only for the simplest plane way centered at the particle 
+	if (beamtype==B_PLANE && !surface && !beam_asym) {
 		CalcField (ebuff,prop);
 		sum=crDotProd_Re(ebuff,incPol); // incPol is real, so no conjugate is needed
 		MyInnerProduct(&sum,double_type,1,&Timing_ScatQuanComm);
@@ -851,7 +849,7 @@ double ExtCross(const double * restrict incPol)
 		 * expected to be accurate for not very elongated dipoles and/or not very spread out incident field.
 		 *
 		 * In principle, the situation is similar for SO of full IGT, but there the correction factor depends on the
-		 * propagation direction.even for cubical dipoles
+		 * propagation direction even for cubical dipoles
 		 */
 		if (ScatRelation==SQ_IGT_SO) sum*=eta2(prop);
 	}
diff --git a/src/param.c b/src/param.c
index a49e94a3..e5767bac 100644
--- a/src/param.c
+++ b/src/param.c
@@ -95,7 +95,6 @@ bool emulLinebuf;  // whether to emulate line buffering of stdout, defined as ex
 extern const char *avg_string;
 // defined and initialized in GenerateB.c
 extern const char *beam_descr;
-extern double beam_center_0[3];
 // defined and initialized in make_particle.c
 extern const bool volcor_used;
 extern const char *sh_form_str1,*sh_form_str2;
@@ -118,8 +117,6 @@ bool calc_asym;       // Calculate the asymmetry-parameter
 bool calc_mat_force;  // Calculate the scattering force by matrix-evaluation
 bool store_force;     // Write radiation pressure per dipole to file
 bool store_ampl;      // Write amplitude matrix to file
-bool use_beam_center; // Whether -beam_center argument is used or not
-bool use_beam_subopt; // Whether beam center coordinates are taken from -beam sub-option
 int phi_int_type;     // type of phi integration (each bit determines whether to calculate with different multipliers)
 // used in calculator.c
 bool avg_inc_pol;            // whether to average CC over incident polarization
@@ -191,6 +188,8 @@ static bool orient_used;        // whether '-orient ...' was used in the command
 static bool yz_used;            // whether '-yz ...' was used in the command line
 static bool scat_plane_used;    // whether '-scat_plane ...' was used in the command line
 static bool so_buf_used;        // whether '-so_buf ...' was used in the command line
+static bool beam_center_used;   // whether '-beam_center ...' was used in the command line
+static bool deprecated_bc_used; // whether '-beam ... <x> <y> <z>' was used in the command line (deprecated option)
 
 /* TO ADD NEW COMMAND LINE OPTION
  * If you need new variables or flags to implement effect of the new command line option, define them here. If a
@@ -231,40 +230,38 @@ static const char exeusage[]="[-<opt1> [<args1>] [-<opt2> <args2>]...]]";
 static const struct subopt_struct beam_opt[]={
 	{"barton5","<width> [<x> <y> <z>]","5th order approximation of the Gaussian beam (by Barton). The beam width is "
 		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
-		"(zero, by default). All arguments are in um. This is recommended option for simulation of the Gaussian beam.",
-		UNDEF,B_BARTON5},
-	{"besselCS","<order> <angle>","Bessel beam with circularly symmetric energy density. The half-cone angle (in rad) "
-		"is measured from the z axis. The beam order and half-cone angle are obligatory.",
-		2,B_BESSELCS},
-	{"besselCSp","<order> <angle>","Alternative Bessel beam with circularly symmetric energy density. The half-cone angle (in rad) "
-		"is measured from the z axis. The beam order and half-cone angle are obligatory.",
-		2,B_BESSELCSp},
+		"(zero, by default). All arguments are in um. This is recommended option for simulation of the Gaussian beam. "
+		"Specification of coordinates here is DEPRECATED, use -beam_center instead.",UNDEF,B_BARTON5},
+#ifndef NO_FORTRAN
+	{"besselCS","<order> <angle>","Bessel beam with circularly symmetric energy density. Order is integer (of any "
+		"sign) and the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_CS},
+	{"besselCSp","<order> <angle>","Alternative Bessel beam with circularly symmetric energy density. Order is "
+		"integer (of any sign) and the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_CSp},
 	{"besselM","<order> <angle> <ReMex> <ReMey> <ReMmx> <ReMmy> [<ImMex> <ImMey> <ImMmx> <ImMmy>]",
-		"Generalized Bessel beam. The half-cone angle (in rad) is measured from the z axis. The beam order and half-cone angle "
-		" and 4 real components of matrix M are obligatory and 4 imaginary components of matrix M are optional "
-		"(zero, by default).",
-		UNDEF,B_BESSELM},
-	{"besselLE","<order> <angle>","Bessel beam with linearly polarized electric field. The half-cone angle (in rad) "
-		"is measured from the z axis. The beam order and half-cone angle are obligatory.",
-		2,B_BESSELLE},
-	{"besselLM","<order> <angle>","Bessel beam with linearly polarized magnetic field. The half-cone angle (in rad) "
-		"is measured from the z axis. The beam order and half-cone angle are obligatory.",
-		2,B_BESSELLM},
-	{"besselTEL","<order> <angle>","Bessel beam forming TE Bessel beam. The half-cone angle (in rad) "
-		"is measured from the z axis. The beam order and half-cone angle are obligatory.",
-		2,B_BESSELTEL},
-	{"besselTML","<order> <angle>","Bessel beam forming TM Bessel beam. The half-cone angle (in rad) "
-		"is measured from the z axis. The beam order and half-cone angle are obligatory.",
-		2,B_BESSELTML},
+		"Generalized Bessel beam. Order is integer (of any sign) and the half-cone angle (in degrees) is measured from "
+		"the z-axis. The beam is defined by 2x2 matrix M: (Mex, Mey, Mmx, Mmy). Real parts of these four elements are "
+		"obligatory, while imaginary parts are optional (zero, by default).",UNDEF,B_BES_M},
+	{"besselLE","<order> <angle>","Bessel beam with linearly polarized electric field. Order is integer (of any sign) "
+		"and the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_LE},
+	{"besselLM","<order> <angle>","Bessel beam with linearly polarized magnetic field. Order is integer (of any sign) "
+		"and the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_LM},
+	{"besselTEL","<order> <angle>","Linear component of the TE Bessel beam. Order is integer (of any sign) and the "
+		"half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_TEL},
+	{"besselTML","<order> <angle>","Linear component of the TM Bessel beam. Order is integer (of any sign) and the "
+		"half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_TML},
+#endif // !NO_FORTRAN
 	{"davis3","<width> [<x> <y> <z>]","3rd order approximation of the Gaussian beam (by Davis). The beam width is "
 		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "
-		"(zero, by default). All arguments are in um.",UNDEF,B_DAVIS3},
+		"(zero, by default). All arguments are in um. Specification of coordinates here is DEPRECATED, use "
+		"-beam_center instead.",UNDEF,B_DAVIS3},
 	{"dipole","[<x> <y> <z>]","Field of a unit point dipole placed at x, y, z coordinates (in laboratory reference "
 		"frame). All arguments are in um. Orientation of the dipole is determined by -prop command line option."
-		"Implies '-scat_matr none'. If '-surf' is used, dipole position should be above the surface.",3,B_DIPOLE},
+		"Implies '-scat_matr none'. If '-surf' is used, dipole position should be above the surface. Specification of "
+		"coordinates here is DEPRECATED, use -beam_center instead.",UNDEF,B_DIPOLE},
 	{"lminus","<width> [<x> <y> <z>]","Simplest approximation of the Gaussian beam. The beam width is obligatory and "
 		"x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional (zero, by"
-		" default). All arguments are in um.",UNDEF,B_LMINUS},
+		" default). All arguments are in um. Specification of coordinates here is DEPRECATED, use -beam_center "
+		"instead.",UNDEF,B_LMINUS},
 	{"plane","","Infinite plane wave",0,B_PLANE},
 	{"read","<filenameY> [<filenameX>]","Defined by separate files, which names are given as arguments. Normally two "
 		"files are required for Y- and X-polarizations respectively, but a single filename is sufficient if only "
@@ -364,8 +361,8 @@ void InitBeam(void);
 PARSE_FUNC(alldir_inp);
 PARSE_FUNC(anisotr);
 PARSE_FUNC(asym);
-PARSE_FUNC(beam_center);
 PARSE_FUNC(beam);
+PARSE_FUNC(beam_center);
 PARSE_FUNC(chp_dir);
 PARSE_FUNC(chp_load);
 PARSE_FUNC(chp_type);
@@ -443,13 +440,13 @@ static struct opt_struct options[]={
 		"reference frame). '-m' then accepts 6 arguments per each domain. Can not be used with '-pol cldr', all SO "
 		"formulations, and '-rect_dip'.",0,NULL},
 	{PAR(asym),"","Calculate the asymmetry vector. Implies '-Csca' and '-vec'",0,NULL},
-	{PAR(beam_center),"<x> <y> <z>","Sets the center of the beam with respect to the initial point in time. "
-				"For plane, Gaussian, and Bessel field it determines the phase in space. "
-				"For a dipole and an electron it determines the position in space.\n"
-		"Default: 0 0 0",3,NULL},
 	{PAR(beam),"<type> [<args>]","Sets the incident beam, either predefined or 'read' from file. All parameters of "
-		"predefined beam types (if present) are floats.\n"
+		"predefined beam types are floats except for <order> or filenames.\n"
 		"Default: plane",UNDEF,beam_opt},
+	{PAR(beam_center),"<x> <y> <z>","Sets the center of the beam in the laboratory reference frame (in um). For most "
+		"beams it corresponds to the most symmetric point with zero phase, while for a point source or a fast "
+		"electron, it determines the real position in space.\n"
+		"Default: 0 0 0",3,NULL},
 	{PAR(chp_dir),"<dirname>","Sets directory for the checkpoint (both for saving and loading).\n"
 		"Default: "FD_CHP_DIR,1,NULL},
 	{PAR(chp_load),"","Restart a simulation from a checkpoint",0,NULL},
@@ -665,7 +662,7 @@ static struct opt_struct options[]={
 		 * the next string.
 		 */
 	{PAR(shape),"<type> [<args>]","Sets shape of the particle, either predefined or 'read' from file. All parameters "
-		"of predefined shapes are floats except for filenames.\n"
+		"of predefined shapes are floats except for <n> and filenames.\n"
 		"Default: sphere",UNDEF,shape_opt},
 	{PAR(size),"<arg>","Sets the size of the computational grid along the x-axis in um, float. If default wavelength "
 		"is used, this option specifies the 'size parameter' of the computational grid. Can not be used together with "
@@ -887,6 +884,16 @@ static void ScanDoubleError(const char * restrict str,double *res)
 
 //======================================================================================================================
 
+static void ScanDouble3Error(char **argv,double res[static 3])
+// scans an option argument (3D vector of doubles) and checks for errors
+{
+	ScanDoubleError(argv[0],res);
+	ScanDoubleError(argv[1],res+1);
+	ScanDoubleError(argv[2],res+2);
+}
+
+//======================================================================================================================
+
 static void ScanIntError(const char * restrict str,int *res)
 // scanf an option argument and checks for errors
 {
@@ -1009,14 +1016,6 @@ PARSE_FUNC(asym)
 	calc_vec = true;
 	calc_Csca = true;
 }
-PARSE_FUNC(beam_center)
-{
-	if (Narg!=3) NargError(Narg,"-beam_center requires 3 arguments");
-	use_beam_center = true;
-	ScanDoubleError(argv[1],&beam_center_0[0]);
-	ScanDoubleError(argv[2],&beam_center_0[1]);
-	ScanDoubleError(argv[3],&beam_center_0[2]);
-}
 PARSE_FUNC(beam)
 {
 	int i,j,need;
@@ -1033,25 +1032,21 @@ PARSE_FUNC(beam)
 		beam_Npars=Narg;
 		opt_beam=opt;
 		need=beam_opt[i].narg;
-		// check number of arguments
+		// check number of arguments and process deprecated ones
 		switch (beamtype) {
 			case B_LMINUS:
 			case B_DAVIS3:
 			case B_BARTON5:
 				if (Narg!=1 && Narg!=4) NargError(Narg,"1 or 4");
-				if (Narg==4) use_beam_subopt=true;
+				if (Narg==4) deprecated_bc_used=true;
 				break;
 			case B_DIPOLE:
 				if (Narg!=0 && Narg!=3) NargError(Narg,"0 or 3");
-				if (Narg==3) use_beam_subopt=true;
+				if (Narg==3) deprecated_bc_used=true;
 				break;
-			case B_BESSELCS: if (Narg!=2) NargError(Narg,"2"); break;
-			case B_BESSELCSp: if (Narg!=2) NargError(Narg,"2"); break;
-			case B_BESSELM: if (Narg!=6 && Narg!=10) NargError(Narg,"6 or 10"); break;
-			case B_BESSELLE: if (Narg!=2) NargError(Narg,"2"); break;
-			case B_BESSELLM: if (Narg!=2) NargError(Narg,"2"); break;
-			case B_BESSELTEL: if (Narg!=2) NargError(Narg,"2"); break;
-			case B_BESSELTML: if (Narg!=2) NargError(Narg,"2"); break;
+#ifndef NO_FORTRAN
+			case B_BES_M: if (Narg!=6 && Narg!=10) NargError(Narg,"6 or 10"); break;
+#endif
 			default: TestNarg(Narg,need); break;
 		}
 		/* TO ADD NEW BEAM
@@ -1063,10 +1058,20 @@ PARSE_FUNC(beam)
 			for (j=0;j<Narg;j++) ScanDoubleError(argv[j+2],beam_pars+j);
 		// stop search
 		found=true;
+		if (deprecated_bc_used) {
+			LogWarning(EC_WARN,ONE_POS,
+				"Providing beam-center coordinates as arguments to '-beam' is deprecated. Use '-beam_center' instead.");
+			vCopy(beam_pars+Narg-3,beam_center_0);
+		}
 		break;
 	}
 	if(!found) NotSupported("Beam type",argv[1]);
 }
+PARSE_FUNC(beam_center)
+{
+	ScanDouble3Error(argv+1,beam_center_0);
+	beam_center_used = true;
+}
 PARSE_FUNC(chp_dir)
 {
 	chp_dir=ScanStrError(argv[1],MAX_DIRNAME);
@@ -1193,6 +1198,10 @@ PARSE_FUNC(h)
 #ifdef SPARSE
 						if (strcmp(options[i].name,"shape")==0)
 							printf("!!! Most of the shape options are disabled in sparse mode\n");
+#endif
+#ifdef NO_FORTRAN
+						if (strcmp(options[i].name,"beam")==0)
+							printf("!!! Bessel beams rely on Fortran sources that were disabled at compile time.\n");
 #endif
 					}
 				}
@@ -1448,9 +1457,7 @@ PARSE_FUNC(prop)
 {
 	double tmp;
 
-	ScanDoubleError(argv[1],prop_0);
-	ScanDoubleError(argv[2],prop_0+1);
-	ScanDoubleError(argv[3],prop_0+2);
+	ScanDouble3Error(argv+1,prop_0);
 	tmp=DotProd(prop_0,prop_0);
 	if (tmp==0) PrintErrorHelp("Given propagation vector is null");
 	vMultScal(1/sqrt(tmp),prop_0,prop_0);
@@ -1947,11 +1954,9 @@ void InitVariables(void)
 	orient_used=false;
 	directory="";
 	lambda=TWO_PI;
-	use_beam_center=false;
-	use_beam_subopt=false;
-	beam_center_0[0]=0;
-	beam_center_0[1]=0;
-	beam_center_0[2]=0;
+	beam_center_used=false;
+	deprecated_bc_used=false;
+	vInit(beam_center_0);
 	// initialize ref_index of scatterer
 	Nmat=Nmat_given=1;
 	ref_index[0]=1.5;
@@ -2133,6 +2138,9 @@ void VariablesInterconnect(void)
 	/* TO ADD NEW INTERACTION FORMULATION
 	 * If the new Green's tensor is non-symmetric (which is very unlikely) add it to the definition of reduced_FFT
 	 */
+	
+	if (deprecated_bc_used && beam_center_used) LogError(ONE_POS,"Beam center coordinates can not be specified as "
+		"arguments to both '-beam' and '-beam_center'. Use only the latter.");
 	if (calc_Csca || calc_vec) all_dir = true;
 	// by default, one of the scattering options is activated
 	if (store_scat_grid || phi_integr) scat_grid = true;
@@ -2513,8 +2521,7 @@ void PrintInfo(void)
 			if (alph_deg!=0 || bet_deg!=0 || gam_deg!=0) {
 				fprintf(logfile,"Particle orientation (deg): alpha="GFORMDEF", beta="GFORMDEF", gamma="GFORMDEF"\n\n"
 					"---In particle reference frame:---\n",alph_deg,bet_deg,gam_deg);
-				if (beam_asym) fprintf(logfile,"Incident Beam center position: "GFORMDEF3V"\n",
-					beam_center[0],beam_center[1],beam_center[2]);
+				fprintf(logfile,"Incident beam center position: "GFORMDEF3V"\n",COMP3V(beam_center_0));
 				fprintf(logfile,"Incident propagation vector: "GFORMDEF3V"\n",COMP3V(prop));
 				if (beamtype==B_DIPOLE) fprintf(logfile,"(dipole orientation)\n");
 				else { // polarizations are not shown for dipole incident field
diff --git a/src/vars.c b/src/vars.c
index 7d54d7bb..347772b9 100644
--- a/src/vars.c
+++ b/src/vars.c
@@ -63,12 +63,16 @@ double propAlongZ;  // equal 0 for general incidence, and +-1 for incidence alon
 bool rectDip;       // whether using rectangular-cuboid (non-cubical) dipoles
 
 // 3D vectors (in particle reference frame)
-double prop_0[3],prop[3];     // incident direction (in laboratory and particle reference frame)
-double incPolX[3],incPolY[3]; // incident polarizations (in particle RF)
+double prop[3];               // incident direction
+double incPolX[3],incPolY[3]; // incident polarizations
 double beam_center[3];        // coordinates of the beam center
 double box_origin_unif[3];    /* coordinates of the center of the first dipole in the local computational box (after
                                  uniform distribution of non-void dipoles among all processors) */
 
+// 3D vectors (in laboratory reference frame)
+double prop_0[3];             // incident direction 
+double beam_center_0[3];      // coordinates of the beam center
+
 // file info
 const char * restrict directory; // directory to save data in
 FILE * restrict logfile;         // file where all the information about the run is saved
diff --git a/src/vars.h b/src/vars.h
index a7fcc267..356f1c7b 100644
--- a/src/vars.h
+++ b/src/vars.h
@@ -47,7 +47,7 @@ extern bool prognosis,yzplane,scat_plane,store_mueller,all_dir,scat_grid,phi_int
 extern double propAlongZ;
 
 // 3D vectors
-extern double prop_0[3],prop[3],incPolX[3],incPolY[3],beam_center[3],box_origin_unif[3];
+extern double prop_0[3],prop[3],incPolX[3],incPolY[3],beam_center_0[3],beam_center[3],box_origin_unif[3];
 
 // file info
 extern const char * restrict directory;

From 192db9b21711380b96b94ac1e588ca48b33bbd7a Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Sat, 11 Dec 2021 15:54:28 +0700
Subject: [PATCH 40/46] minor changes

---
 .project        |  26 ++++++++++++++++++++++++++
 src/.DS_Store   | Bin 0 -> 14340 bytes
 src/ExpCount    |   1 +
 src/GenerateB.c |  16 ++++++++++++++--
 src/Makefile    |   4 +++-
 src/param.c     |  33 ++++++++++++++++++++-------------
 6 files changed, 64 insertions(+), 16 deletions(-)
 create mode 100644 .project
 create mode 100644 src/.DS_Store
 create mode 100644 src/ExpCount

diff --git a/.project b/.project
new file mode 100644
index 00000000..5f126b26
--- /dev/null
+++ b/.project
@@ -0,0 +1,26 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<projectDescription>
+	<name>adda</name>
+	<comment></comment>
+	<projects>
+	</projects>
+	<buildSpec>
+		<buildCommand>
+			<name>org.eclipse.cdt.managedbuilder.core.genmakebuilder</name>
+			<triggers>clean,full,incremental,</triggers>
+			<arguments>
+			</arguments>
+		</buildCommand>
+		<buildCommand>
+			<name>org.eclipse.cdt.managedbuilder.core.ScannerConfigBuilder</name>
+			<triggers>full,incremental,</triggers>
+			<arguments>
+			</arguments>
+		</buildCommand>
+	</buildSpec>
+	<natures>
+		<nature>org.eclipse.cdt.core.cnature</nature>
+		<nature>org.eclipse.cdt.managedbuilder.core.managedBuildNature</nature>
+		<nature>org.eclipse.cdt.managedbuilder.core.ScannerConfigNature</nature>
+	</natures>
+</projectDescription>
diff --git a/src/.DS_Store b/src/.DS_Store
new file mode 100644
index 0000000000000000000000000000000000000000..fb536121ee08d4e92e731b7ac5b857fb866b7e62
GIT binary patch
literal 14340
zcmeHOYit}>6~1Tun)QzDN#fFUYo|^OL<E!CN%L?@Q@=vvHmQRjv6GZ+_A!Y^ncdm!
z?5-0+z(V3#C@Q}y9{q<vRD_3kMDPcxP#%K*fB-5&NE9LQZhr8m0tvozXV#gQt^BA^
zK{M9OoqO*&=broBbM8I&&RPgT6ZPVV5W_+U6*s54hQ|km7~s@*aXsIWs|6*5dm1<1
zbs=_(<!Q?<<SjcNp^g?PC}RFrdE3GX@k5{(hv>uqmX{FC6y+fuQIcE<0to^M0to^M
z0to_lf&j0*xYV?pCeH+c1c3yBH3WEm7{JZxn3t})shm3S;1HhcIfR!N-Z^aNvH>q0
z^U_r}MGY=;S&_P|<ZUs?Wk>mdM>poBt8VJD3z98Ej@L4II~0<wqkKS;3mS9N<e4Cl
zAP`01UKDkRipYs7?h<z31>X*yo$1T|9e9M=zuyNn^@pfcPj(*CWA^v-WQaZu`l>KQ
zL1aZun9#_G>O`;J5m!hz<wA%nC1%ADoG?s@<4AX-tzxL}<KVdNJ9S_V8+3VSRTUSa
znn|=a<_Kve5%Y7j04GCS3Th&8ilNG{I2G@-<wm|@nNDqZ_?M)#w6?W(s2yrreb?Nw
zy)swJ)#}bfu6l-Z^R{i}oA0^&Nz+)#>b;Y8xt24_MpZJHMFS*HESlw_y)t3f%SA`>
z&bbw8N=;?;tyiz^+cP{guxIq(wV{Elqx}BB-u>6ErPR9y?|*PMd(kSD?T@-fN8ZFO
zy4?KQ6BdBeBiZMoQ?T;Tj_bT4>%z!f!7f!Kx&FDQeKk&F((QW7zGl~d-Ryd*Gp%)H
z<`+&bYNxXL<_7vWQ>mGD**R%c9i&;k#{m}81-pErYH<Bx!M5t9vXj*}6>?UgZslsm
zxMj_m?>11@;}oj4Wu34clf|4`su`DSTo<WYI_=oi+N2bg)%Ch#%o>noHjF7qbe2ps
z$&9_SOSd1Cy54<v-}X1{y8nUEhbG?f*v!oyebeSGy_$9!pqFdrdDEyateC~x@~NCt
zFv>-<d||O+I%eK7=F7Q~v5AIKDap0<o=j$`o;NSm&Ds@xP*r7V|F(?wL=j3Hw~H*T
zsDDFs>33|)WX^ESWYxg4=rO!`XGWWMpsSwq2;VxSY4aCh6}sa!H9Vqa7OY&}u=HZe
zZD-$pEwk8gan>L63J>*anI(*530-l#vcnH&GH1EjV>zcbQ!&a=>4#q1lThgt*Nqp8
zQlZWIrk>2v%%iIQGxfByoU0l$D=^oaUissyD#sM%EbU0qtl4Xovs|g0<%S7Q!0@>a
zp$<0D9~|4|z79To%YBi6rUu7`JrY&)i#?brj)`;d{Hx;Q;u-Or_`3MMctQL^{8s!)
zydqvDqIODAC#9*E`sqFzpzXAa4$vqaq6cY;PS87Pmd?;Q%2R=gRH7=?s7?)fAANv6
zL?5P)&?o6r^cngrJxiabuh3WNYxEuZG5v&oN-xr{=y&uo{ht0xf1_9E7X4FcRoawx
zWvjAX*`W+7`;`OAm@=)*DvQdJtGUwjyVG7zyhO?2rRii&!<$8v>+!DC_sG%dN3~=B
zGp_Vfx9dE2z2WWw_NapojjtJ>YpqQK^_#u4^?-*+TbH&FveTPzv3vXawfmYL81~Es
zIEistWuMeLT<RU#8&x=o-sWa^YHv~D9(uc*9qQYy!Xb4<X0?&Ny(zez-r{D5`VOR2
zo!rbJ?d>Tzpx)|c`?axDN*6NIH`#YYg%j!OYh~RpiI>G6#VzqKSa&yVp{=x&hUp+3
zrla&Y&A^`LXo1dBmU6Iaw&^le=n^^f9=Zm*UZwZblk_oqiatS4!?r&S>t@^j0)3I5
zqc71n>05MzzD>{5_vi)s0sRQp{&V^b{ek{We+k*}@t_UUKW^J_$)1|>RzkJf(t6L0
zXP(FE-L&wMUEH9yvg})AwjhjI<7>=S%a&b6<bWLse+F?7la%FMi?04MF7dC@OwaK`
zSw=LG*h)quetHe`ZY;*@VHUg<lmx%3uzKiO>o#9pqI$6s>$Xl*vLSs;OcJ2)fcz`a
z#fZ~}W0L@Nm#Blb2u)1zEz8Jn8NF}<Ux&~S#w)<tE*dft<vxevP{wLq+K~PdpQn8I
z0J7vt5J(V65J(URAn-QiI^`aC3eOT|UtU8ZvoFu6Vz+Nb)x;!dE$q|lc;+zA8*&dF
znzea99O5g4_-w?}k@k339N<f%rDe2{$2x>{1aFNPF5XM}wd?>_32TuhF2_(~_1S<r
zw5IU-6QFK~Y+l>r&P*7sXMJe-X+v@)LVnuRnp|6sL`hr>odqy9eh%&>(>fT1NUXrC
zbAY-9)D=+)$z&}2GCeB)j=U3$RW#(tKR%*~44VYWFD8yB3;@8QZXZ}32pxE!>+6Lw
z8&HR2vl#`b+r)YN#f5HwX&uV2Oh6T&Y=uNN;#v?=#v-1s2`T~ePB7Oob_FP9%2AAr
zAp0J@*9TBqJOY3?rsOj__PmMcP_SJExKfdLEZi{$%im6y7w5X|_%#f9IosGBa)#Sv
zF#T<|N)%!ZE0!)KPh$1=09G7>Hjy$hYs8!<O04``-OyqM@we;Y733_*$ETQ~VU{N5
z=T$+=b12V_F|oMBY9snkk2ppqKYfp!r7uFCEc}?yZP{`Po`#{3kw)m}R&myu6U=?y
z?N!id89(K$4?k75R+G5JI6Na4p*O(84sj)Fm5f$^z6G?vH>d^oIgYC7IPe>h24hW(
zh*A9Q6$c~`v1Stx6weicT!QeT4}=zU2LK0^lwFUZ@++Bg8KoWZsdhv`iHBcElp~}Z
z+mGVs=<?d&F|Ep3!NLTMmcj~4RQ;T3kCRvZbw`*j=yrR_{$Khw`*++T0=o@-FG%+P
z$^M@wtK>=$NDxR6czq$z=BhKCMtWrZ-~Ye9luoos5J(VsO%b5hskx~Mh~xu_xQl;l
zH-P&bZl?JzZocp?S?~z_5D*#uIo?4@<UK$$#;-_M-Bhw7FIkcPmwpHsvkOc1|MLH}
Tyf2G^4Rf;phq3-Y?*IP-rjEU4

literal 0
HcmV?d00001

diff --git a/src/ExpCount b/src/ExpCount
new file mode 100644
index 00000000..56a6051c
--- /dev/null
+++ b/src/ExpCount
@@ -0,0 +1 @@
+1
\ No newline at end of file
diff --git a/src/GenerateB.c b/src/GenerateB.c
index e1197049..43dbdc50 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -190,39 +190,50 @@ void InitBeam(void)
 		case B_BES_TML:
 			if (surface) PrintError("Currently, Bessel incident beam is not supported for '-surf'");
 			// initialize parameters
-			n0=round(beam_pars[0]);
-			alpha0=beam_pars[1];
+			ConvertToInteger(beam_pars[0],"beam order",n0);
+			TestRangeII(abs(n0),"beam order (might cause the incorrect calculation of Bessel function)",0,11);
+			/* Current realization of Bessel function J(n0,arg) has problems
+			 * for |n0|>11 and arg in the vicinity of 0
+			 */
+			alpha0 = Deg2Rad(beam_pars[1]);
 			K =fabs(WaveNum);
 			Kt=fabs(WaveNum)*sin(alpha0);
 			Kz=fabs(WaveNum)*cos(alpha0);
 			switch (beamtype) { // definition of elements of matrix M ((Mex,Mey),(Mmx,Mmy))
 				case B_BES_CS:
+					TestRangeII(beam_pars[1],"half-cone angle",0,90);
 					M[0]=0.5;	M[1]=0;
 					M[2]=0;		M[3]=0.5;
 					break;
 				case B_BES_CSp:
+					TestRangeII(beam_pars[1],"half-cone angle",0,90);
 					M[0]=0.5;	M[1]=0;
 					M[2]=0;		M[3]=-0.5;
 					break;
 				case B_BES_M:
+					TestRangeII(beam_pars[1],"half-cone angle",0,90);
 					M[0]=beam_pars[2]+I*beam_pars[6];
 					M[1]=beam_pars[3]+I*beam_pars[7];
 					M[2]=beam_pars[4]+I*beam_pars[8];
 					M[3]=beam_pars[5]+I*beam_pars[9];
 					break;
 				case B_BES_LE:
+					TestRangeII(beam_pars[1],"half-cone angle",0,90);
 					M[0]=0;		M[1]=0;
 					M[2]=0;		M[3]=1;
 					break;
 				case B_BES_LM:
+					TestRangeII(beam_pars[1],"half-cone angle",0,90);
 					M[0]=0;		M[1]=1;
 					M[2]=0;		M[3]=0;
 					break;
 				case B_BES_TEL:
+					TestRangeNN(beam_pars[1],"half-cone angle for TEL type",0,90);
 					M[0]=-K/Kt;		M[1]=0;
 					M[2]=0;			M[3]=Kz/Kt;
 					break;
 				case B_BES_TML:
+					TestRangeNN(beam_pars[1],"half-cone angle for TML type",0,90);
 					M[0]=0; 		M[1]=Kz/Kt;
 					M[2]=K/Kt;		M[2]=0;
 					break;
@@ -559,6 +570,7 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 						fn[2] = jn1[n0];
 						fn[3] = jn1[n0+1]*cexp(I*phi);
 						fn[4] = jn1[n0+2]*cexp(2*I*phi);
+
 					}
 					if (n0 == -2) {
 						bjndd_(&n1, &arg, jn1, td1, td2);
diff --git a/src/Makefile b/src/Makefile
index f23b53bd..80f3e8ca 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -171,12 +171,14 @@ override EXTRA_FLAGS +=
 #FFTW3_LIB_PATH := $(HOME)/lib
 #FFTW3_INC_PATH := "$(abspath ./../lib)"
 #FFTW3_LIB_PATH := "$(abspath ./../lib)"
+FFTW3_INC_PATH := "/opt/homebrew/include"
+FFTW3_LIB_PATH := "/opt/homebrew/lib"
 
 # --Fortran library path--
 # If your environment does not specify search path for Fortran libraries, you may get errors during linking of ADDA.
 # For instance, this may happen on macOS. Then uncomment the following line and modify the path if needed. 
 # This variable can also be defined in the enviroment or in the command line of make (see explanation above for OPTIONS) 
-#FORT_LIB_PATH := /usr/local/gfortran/lib
+FORT_LIB_PATH := /usr/local/gfortran/lib
 
 #=======================================================================================================================
 # !!! End of control section. Everything below is not designed to be modified by user. However, advanced users may wish
diff --git a/src/param.c b/src/param.c
index e5767bac..a7e5fd7a 100644
--- a/src/param.c
+++ b/src/param.c
@@ -234,21 +234,28 @@ static const struct subopt_struct beam_opt[]={
 		"Specification of coordinates here is DEPRECATED, use -beam_center instead.",UNDEF,B_BARTON5},
 #ifndef NO_FORTRAN
 	{"besselCS","<order> <angle>","Bessel beam with circularly symmetric energy density. Order is integer (of any "
-		"sign) and the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_CS},
+		"sign, but it works correctly only for |order|<12) and the half-cone angle (in degrees) is measured "
+		"from the z-axis.",2,B_BES_CS},
 	{"besselCSp","<order> <angle>","Alternative Bessel beam with circularly symmetric energy density. Order is "
-		"integer (of any sign) and the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_CSp},
+		"integer (of any sign, but it works correctly only for |order|<12) and the half-cone angle (in degrees) "
+		"is measured from the z-axis.",2,B_BES_CSp},
 	{"besselM","<order> <angle> <ReMex> <ReMey> <ReMmx> <ReMmy> [<ImMex> <ImMey> <ImMmx> <ImMmy>]",
-		"Generalized Bessel beam. Order is integer (of any sign) and the half-cone angle (in degrees) is measured from "
-		"the z-axis. The beam is defined by 2x2 matrix M: (Mex, Mey, Mmx, Mmy). Real parts of these four elements are "
-		"obligatory, while imaginary parts are optional (zero, by default).",UNDEF,B_BES_M},
-	{"besselLE","<order> <angle>","Bessel beam with linearly polarized electric field. Order is integer (of any sign) "
-		"and the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_LE},
-	{"besselLM","<order> <angle>","Bessel beam with linearly polarized magnetic field. Order is integer (of any sign) "
-		"and the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_LM},
-	{"besselTEL","<order> <angle>","Linear component of the TE Bessel beam. Order is integer (of any sign) and the "
-		"half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_TEL},
-	{"besselTML","<order> <angle>","Linear component of the TM Bessel beam. Order is integer (of any sign) and the "
-		"half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_TML},
+		"Generalized Bessel beam. Order is integer (of any sign, but it works correctly only for |order|<12) and "
+		"the half-cone angle (in degrees) is measured from the z-axis. The beam is defined by 2x2 matrix M: "
+		"(Mex, Mey, Mmx, Mmy). Real parts of these four elements are obligatory, while imaginary parts are optional "
+		"(zero, by default).",UNDEF,B_BES_M},
+	{"besselLE","<order> <angle>","Bessel beam with linearly polarized electric field. Order is integer "
+		"(of any sign, but it works correctly only for |order|<12) and the half-cone angle (in degrees) is "
+		"measured from the z-axis.",2,B_BES_LE},
+	{"besselLM","<order> <angle>","Bessel beam with linearly polarized magnetic field. Order is integer "
+		"(of any sign, but it works correctly only for |order|<12) and the half-cone angle (in degrees) is "
+		"measured from the z-axis.",2,B_BES_LM},
+	{"besselTEL","<order> <angle>","Linear component of the TE Bessel beam. Order is integer (of any sign, but it "
+		"works correctly only for |order|<12) and the half-cone angle (in degrees) is measured from the z-axis.",
+		2,B_BES_TEL},
+	{"besselTML","<order> <angle>","Linear component of the TM Bessel beam. Order is integer (of any sign, but it "
+		"works correctly only for |order|<12) and the half-cone angle (in degrees) is measured from the z-axis.",
+		2,B_BES_TML},
 #endif // !NO_FORTRAN
 	{"davis3","<width> [<x> <y> <z>]","3rd order approximation of the Gaussian beam (by Davis). The beam width is "
 		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "

From f59da279341cba1f7403b769b3a5d3fece914d84 Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Wed, 15 Dec 2021 12:29:24 +0700
Subject: [PATCH 41/46] minor changes

---
 src/CalculateE.c | 15 +++++++++------
 src/GenerateB.c  | 25 +++++++++++++++----------
 src/param.c      | 29 +++++++++++------------------
 3 files changed, 35 insertions(+), 34 deletions(-)

diff --git a/src/CalculateE.c b/src/CalculateE.c
index 769b0e94..faa9a770 100644
--- a/src/CalculateE.c
+++ b/src/CalculateE.c
@@ -44,6 +44,7 @@ extern const Parms_1D phi_sg;
 extern const double ezLab[3],exSP[3];
 // defined and initialized in GenerateB.c
 extern const double C0dipole,C0dipole_refl;
+extern int vorticity;
 // defined and initialized in param.c
 extern const bool store_int_field,store_dip_pol,store_beam,store_scat_grid,calc_Cext,calc_Cabs,
 	calc_Csca,calc_vec,calc_asym,calc_mat_force,store_force,store_ampl;
@@ -172,6 +173,7 @@ void MuellerMatrix(void)
 	double matrix[4][4];
 	double theta,phi,ph,max_err,max_err_c2,max_err_s2,max_err_c4,max_err_s4;
 	doublecomplex s1,s2,s3,s4;
+	doublecomplex vort;
 	char fname[MAX_FNAME];
 	int i;
 	size_t index,index1,k_or,j,n,ind;
@@ -198,8 +200,8 @@ void MuellerMatrix(void)
 				for (i=0;i<nTheta;i++) {
 					// transform amplitude matrix, multiplying by rotation matrix (-alpha)
 					/* Note, that amplitude matrix for vortex beams (e.g., Bessel ones) have to be additionally
-					 * multiplied by the phase factor exp(-I*n0*alpha). However, it does not change the Mueller matrix
-					 * and we do not save the amplitude matrix in this case.
+					 * multiplied by the phase factor exp(-I*vorticity*alpha). However, it does not change the
+					 * Mueller matrix and we do not save the amplitude matrix in this case.
 					 */
 					if (yzplane) { // here the default (alpha=0) is yz-plane, so par=Y, per=X
 						s2 =  co*ampl_alphaY[index+1] + si*ampl_alphaX[index+1]; // s2 =  co*s20 + si*s30
@@ -334,15 +336,16 @@ void MuellerMatrix(void)
 					if (angles.type==SG_GRID) phi=angles.phi.val[j];
 					else phi=angles.phi.val[ind]; // angles.type==SG_PAIRS
 					ph=Deg2Rad(phi);
+					vort=cexp(-I*vorticity*ph);
 					// rather complicated (but general) approach to determine rotation angle from XY to scattering plane
 					SetScatPlane(cthet,sthet,ph,tmp3,incPolper);
 					co=-DotProd(incPolper,incPolY);
 					si=DotProd(incPolper,incPolX);
 					// transform the amplitude matrix, multiplying by rotation matrix from per-par to X-Y
-					s2 = co*EgridX[index+1] + si*EgridY[index+1]; // s2 =  co*s20 + si*s30
-					s3 = si*EgridX[index+1] - co*EgridY[index+1]; // s3 =  si*s20 - co*s30
-					s4 = co*EgridX[index] + si*EgridY[index]; // s4 =  co*s40 + si*s10
-					s1 = si*EgridX[index] - co*EgridY[index]; // s1 =  si*s40 - co*s10
+					s2 = vort*(co*EgridX[index+1] + si*EgridY[index+1]); // s2 =  co*s20 + si*s30
+					s3 = vort*(si*EgridX[index+1] - co*EgridY[index+1]); // s3 =  si*s20 - co*s30
+					s4 = vort*(co*EgridX[index] + si*EgridY[index]); // s4 =  co*s40 + si*s10
+					s1 = vort*(si*EgridX[index] - co*EgridY[index]); // s1 =  si*s40 - co*s10
 					index+=2;
 
 					if (store_mueller) ComputeMuellerMatrix(matrix,s1,s2,s3,s4,theta);
diff --git a/src/GenerateB.c b/src/GenerateB.c
index 43dbdc50..48b9990c 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -57,6 +57,7 @@ static doublecomplex ktVec[3]; // k_tran/k0
 static double p0;              // amplitude of the incident dipole moment
 #ifndef NO_FORTRAN
 static int n0;                 // Bessel beam order
+int vorticity;				   // Vorticity of vortex beams (n0 for Bessel beams)
 static double alpha0;          // half-cone angle
 static doublecomplex K,Kt,Kz;  // wave-vector components
 static doublecomplex M[4];     // Components of matrix M
@@ -89,6 +90,7 @@ void InitBeam(void)
 	// beam initialization
 	beam_asym=(beam_center_0[0]!=0 || beam_center_0[1]!=0 || beam_center_0[2]!=0);
 	if (!beam_asym) vInit(beam_center); // not to calculate it for each orientation
+	vorticity = 0;
 	switch (beamtype) {
 		case B_PLANE:
 			if (IFROOT) beam_descr="plane wave";
@@ -190,11 +192,9 @@ void InitBeam(void)
 		case B_BES_TML:
 			if (surface) PrintError("Currently, Bessel incident beam is not supported for '-surf'");
 			// initialize parameters
-			ConvertToInteger(beam_pars[0],"beam order",n0);
-			TestRangeII(abs(n0),"beam order (might cause the incorrect calculation of Bessel function)",0,11);
-			/* Current realization of Bessel function J(n0,arg) has problems
-			 * for |n0|>11 and arg in the vicinity of 0
-			 */
+			ConvertToInteger(beam_pars[0],"beam order",&n0);
+			TestRangeII(abs(n0),"beam order (might cause the incorrect calculation of Bessel function)",0,899);
+			vorticity = n0;
 			alpha0 = Deg2Rad(beam_pars[1]);
 			K =fabs(WaveNum);
 			Kt=fabs(WaveNum)*sin(alpha0);
@@ -212,10 +212,16 @@ void InitBeam(void)
 					break;
 				case B_BES_M:
 					TestRangeII(beam_pars[1],"half-cone angle",0,90);
-					M[0]=beam_pars[2]+I*beam_pars[6];
-					M[1]=beam_pars[3]+I*beam_pars[7];
-					M[2]=beam_pars[4]+I*beam_pars[8];
-					M[3]=beam_pars[5]+I*beam_pars[9];
+					if (beam_Npars==6) {
+						M[0]=beam_pars[2];	M[1]=beam_pars[3];
+						M[2]=beam_pars[4];	M[3]=beam_pars[5];
+					}
+					else {
+						M[0]=beam_pars[2]+I*beam_pars[6];
+						M[1]=beam_pars[3]+I*beam_pars[7];
+						M[2]=beam_pars[4]+I*beam_pars[8];
+						M[3]=beam_pars[5]+I*beam_pars[9];
+					}
 					break;
 				case B_BES_LE:
 					TestRangeII(beam_pars[1],"half-cone angle",0,90);
@@ -570,7 +576,6 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 						fn[2] = jn1[n0];
 						fn[3] = jn1[n0+1]*cexp(I*phi);
 						fn[4] = jn1[n0+2]*cexp(2*I*phi);
-
 					}
 					if (n0 == -2) {
 						bjndd_(&n1, &arg, jn1, td1, td2);
diff --git a/src/param.c b/src/param.c
index a7e5fd7a..6e2b5c8b 100644
--- a/src/param.c
+++ b/src/param.c
@@ -234,28 +234,21 @@ static const struct subopt_struct beam_opt[]={
 		"Specification of coordinates here is DEPRECATED, use -beam_center instead.",UNDEF,B_BARTON5},
 #ifndef NO_FORTRAN
 	{"besselCS","<order> <angle>","Bessel beam with circularly symmetric energy density. Order is integer (of any "
-		"sign, but it works correctly only for |order|<12) and the half-cone angle (in degrees) is measured "
-		"from the z-axis.",2,B_BES_CS},
+		"sign) and the half-cone angle (in degrees)is measured from the z-axis.",2,B_BES_CS},
 	{"besselCSp","<order> <angle>","Alternative Bessel beam with circularly symmetric energy density. Order is "
-		"integer (of any sign, but it works correctly only for |order|<12) and the half-cone angle (in degrees) "
-		"is measured from the z-axis.",2,B_BES_CSp},
+		"integer (of any sign) and the half-cone angle (in degrees)is measured from the z-axis.",2,B_BES_CSp},
 	{"besselM","<order> <angle> <ReMex> <ReMey> <ReMmx> <ReMmy> [<ImMex> <ImMey> <ImMmx> <ImMmy>]",
-		"Generalized Bessel beam. Order is integer (of any sign, but it works correctly only for |order|<12) and "
-		"the half-cone angle (in degrees) is measured from the z-axis. The beam is defined by 2x2 matrix M: "
-		"(Mex, Mey, Mmx, Mmy). Real parts of these four elements are obligatory, while imaginary parts are optional "
-		"(zero, by default).",UNDEF,B_BES_M},
+		"Generalized Bessel beam. Order is integer (of any sign) and the half-cone angle (in degrees) "
+		"is measured from the z-axis. The beam is defined by 2x2 matrix M: (Mex, Mey, Mmx, Mmy). "
+		"Real parts of these four elements are obligatory, while imaginary parts are optional (zero, by default).",UNDEF,B_BES_M},
 	{"besselLE","<order> <angle>","Bessel beam with linearly polarized electric field. Order is integer "
-		"(of any sign, but it works correctly only for |order|<12) and the half-cone angle (in degrees) is "
-		"measured from the z-axis.",2,B_BES_LE},
+		"(of any sign) and the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_LE},
 	{"besselLM","<order> <angle>","Bessel beam with linearly polarized magnetic field. Order is integer "
-		"(of any sign, but it works correctly only for |order|<12) and the half-cone angle (in degrees) is "
-		"measured from the z-axis.",2,B_BES_LM},
-	{"besselTEL","<order> <angle>","Linear component of the TE Bessel beam. Order is integer (of any sign, but it "
-		"works correctly only for |order|<12) and the half-cone angle (in degrees) is measured from the z-axis.",
-		2,B_BES_TEL},
-	{"besselTML","<order> <angle>","Linear component of the TM Bessel beam. Order is integer (of any sign, but it "
-		"works correctly only for |order|<12) and the half-cone angle (in degrees) is measured from the z-axis.",
-		2,B_BES_TML},
+		"(of any sign) and the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_LM},
+	{"besselTEL","<order> <angle>","Linear component of the TE Bessel beam. Order is integer (of any sign) and "
+		"the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_TEL},
+	{"besselTML","<order> <angle>","Linear component of the TM Bessel beam. Order is integer (of any sign) and "
+		"the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_TML},
 #endif // !NO_FORTRAN
 	{"davis3","<width> [<x> <y> <z>]","3rd order approximation of the Gaussian beam (by Davis). The beam width is "
 		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "

From 4ea4e1a9363abe2c9992f719e26cb74eecff95d2 Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Wed, 15 Dec 2021 15:30:40 +0700
Subject: [PATCH 42/46] minor changes

---
 .gitignore     |  1 +
 src/ExpCount   |  1 -
 src/crosssec.c |  2 +-
 src/param.c    | 26 +++++++++++++-------------
 4 files changed, 15 insertions(+), 15 deletions(-)
 delete mode 100644 src/ExpCount

diff --git a/.gitignore b/.gitignore
index 6c3d0012..4d2cdded 100644
--- a/.gitignore
+++ b/.gitignore
@@ -8,3 +8,4 @@
 # for Eclipse
 .сproject
 .project 
+src/.DS_Store
diff --git a/src/ExpCount b/src/ExpCount
deleted file mode 100644
index 56a6051c..00000000
--- a/src/ExpCount
+++ /dev/null
@@ -1 +0,0 @@
-1
\ No newline at end of file
diff --git a/src/crosssec.c b/src/crosssec.c
index a533f66e..31499acc 100644
--- a/src/crosssec.c
+++ b/src/crosssec.c
@@ -848,7 +848,7 @@ double ExtCross(const double * restrict incPol)
 		 * independent of propagation or scattering direction. For rectangular dipoles, it is only approximate but
 		 * expected to be accurate for not very elongated dipoles and/or not very spread out incident field.
 		 *
-		 * In principle, the situation is similar for SO of full IGT, but there the correction factor depends on the
+		 * In principle, the situation is similar for full IGT, but there the correction factor depends on the
 		 * propagation direction even for cubical dipoles
 		 */
 		if (ScatRelation==SQ_IGT_SO) sum*=eta2(prop);
diff --git a/src/param.c b/src/param.c
index 6e2b5c8b..e5767bac 100644
--- a/src/param.c
+++ b/src/param.c
@@ -234,21 +234,21 @@ static const struct subopt_struct beam_opt[]={
 		"Specification of coordinates here is DEPRECATED, use -beam_center instead.",UNDEF,B_BARTON5},
 #ifndef NO_FORTRAN
 	{"besselCS","<order> <angle>","Bessel beam with circularly symmetric energy density. Order is integer (of any "
-		"sign) and the half-cone angle (in degrees)is measured from the z-axis.",2,B_BES_CS},
+		"sign) and the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_CS},
 	{"besselCSp","<order> <angle>","Alternative Bessel beam with circularly symmetric energy density. Order is "
-		"integer (of any sign) and the half-cone angle (in degrees)is measured from the z-axis.",2,B_BES_CSp},
+		"integer (of any sign) and the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_CSp},
 	{"besselM","<order> <angle> <ReMex> <ReMey> <ReMmx> <ReMmy> [<ImMex> <ImMey> <ImMmx> <ImMmy>]",
-		"Generalized Bessel beam. Order is integer (of any sign) and the half-cone angle (in degrees) "
-		"is measured from the z-axis. The beam is defined by 2x2 matrix M: (Mex, Mey, Mmx, Mmy). "
-		"Real parts of these four elements are obligatory, while imaginary parts are optional (zero, by default).",UNDEF,B_BES_M},
-	{"besselLE","<order> <angle>","Bessel beam with linearly polarized electric field. Order is integer "
-		"(of any sign) and the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_LE},
-	{"besselLM","<order> <angle>","Bessel beam with linearly polarized magnetic field. Order is integer "
-		"(of any sign) and the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_LM},
-	{"besselTEL","<order> <angle>","Linear component of the TE Bessel beam. Order is integer (of any sign) and "
-		"the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_TEL},
-	{"besselTML","<order> <angle>","Linear component of the TM Bessel beam. Order is integer (of any sign) and "
-		"the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_TML},
+		"Generalized Bessel beam. Order is integer (of any sign) and the half-cone angle (in degrees) is measured from "
+		"the z-axis. The beam is defined by 2x2 matrix M: (Mex, Mey, Mmx, Mmy). Real parts of these four elements are "
+		"obligatory, while imaginary parts are optional (zero, by default).",UNDEF,B_BES_M},
+	{"besselLE","<order> <angle>","Bessel beam with linearly polarized electric field. Order is integer (of any sign) "
+		"and the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_LE},
+	{"besselLM","<order> <angle>","Bessel beam with linearly polarized magnetic field. Order is integer (of any sign) "
+		"and the half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_LM},
+	{"besselTEL","<order> <angle>","Linear component of the TE Bessel beam. Order is integer (of any sign) and the "
+		"half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_TEL},
+	{"besselTML","<order> <angle>","Linear component of the TM Bessel beam. Order is integer (of any sign) and the "
+		"half-cone angle (in degrees) is measured from the z-axis.",2,B_BES_TML},
 #endif // !NO_FORTRAN
 	{"davis3","<width> [<x> <y> <z>]","3rd order approximation of the Gaussian beam (by Davis). The beam width is "
 		"obligatory and x, y, z coordinates of the center of the beam (in laboratory reference frame) are optional "

From 57915307599e52ecb0b425181a0aea648bf3fbf7 Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Wed, 15 Dec 2021 16:21:26 +0700
Subject: [PATCH 43/46] minor changes

---
 .project        |  26 --------------------------
 src/.DS_Store   | Bin 14340 -> 0 bytes
 src/GenerateB.c |   2 +-
 3 files changed, 1 insertion(+), 27 deletions(-)
 delete mode 100644 .project
 delete mode 100644 src/.DS_Store

diff --git a/.project b/.project
deleted file mode 100644
index 5f126b26..00000000
--- a/.project
+++ /dev/null
@@ -1,26 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<projectDescription>
-	<name>adda</name>
-	<comment></comment>
-	<projects>
-	</projects>
-	<buildSpec>
-		<buildCommand>
-			<name>org.eclipse.cdt.managedbuilder.core.genmakebuilder</name>
-			<triggers>clean,full,incremental,</triggers>
-			<arguments>
-			</arguments>
-		</buildCommand>
-		<buildCommand>
-			<name>org.eclipse.cdt.managedbuilder.core.ScannerConfigBuilder</name>
-			<triggers>full,incremental,</triggers>
-			<arguments>
-			</arguments>
-		</buildCommand>
-	</buildSpec>
-	<natures>
-		<nature>org.eclipse.cdt.core.cnature</nature>
-		<nature>org.eclipse.cdt.managedbuilder.core.managedBuildNature</nature>
-		<nature>org.eclipse.cdt.managedbuilder.core.ScannerConfigNature</nature>
-	</natures>
-</projectDescription>
diff --git a/src/.DS_Store b/src/.DS_Store
deleted file mode 100644
index fb536121ee08d4e92e731b7ac5b857fb866b7e62..0000000000000000000000000000000000000000
GIT binary patch
literal 0
HcmV?d00001

literal 14340
zcmeHOYit}>6~1Tun)QzDN#fFUYo|^OL<E!CN%L?@Q@=vvHmQRjv6GZ+_A!Y^ncdm!
z?5-0+z(V3#C@Q}y9{q<vRD_3kMDPcxP#%K*fB-5&NE9LQZhr8m0tvozXV#gQt^BA^
zK{M9OoqO*&=broBbM8I&&RPgT6ZPVV5W_+U6*s54hQ|km7~s@*aXsIWs|6*5dm1<1
zbs=_(<!Q?<<SjcNp^g?PC}RFrdE3GX@k5{(hv>uqmX{FC6y+fuQIcE<0to^M0to^M
z0to_lf&j0*xYV?pCeH+c1c3yBH3WEm7{JZxn3t})shm3S;1HhcIfR!N-Z^aNvH>q0
z^U_r}MGY=;S&_P|<ZUs?Wk>mdM>poBt8VJD3z98Ej@L4II~0<wqkKS;3mS9N<e4Cl
zAP`01UKDkRipYs7?h<z31>X*yo$1T|9e9M=zuyNn^@pfcPj(*CWA^v-WQaZu`l>KQ
zL1aZun9#_G>O`;J5m!hz<wA%nC1%ADoG?s@<4AX-tzxL}<KVdNJ9S_V8+3VSRTUSa
znn|=a<_Kve5%Y7j04GCS3Th&8ilNG{I2G@-<wm|@nNDqZ_?M)#w6?W(s2yrreb?Nw
zy)swJ)#}bfu6l-Z^R{i}oA0^&Nz+)#>b;Y8xt24_MpZJHMFS*HESlw_y)t3f%SA`>
z&bbw8N=;?;tyiz^+cP{guxIq(wV{Elqx}BB-u>6ErPR9y?|*PMd(kSD?T@-fN8ZFO
zy4?KQ6BdBeBiZMoQ?T;Tj_bT4>%z!f!7f!Kx&FDQeKk&F((QW7zGl~d-Ryd*Gp%)H
z<`+&bYNxXL<_7vWQ>mGD**R%c9i&;k#{m}81-pErYH<Bx!M5t9vXj*}6>?UgZslsm
zxMj_m?>11@;}oj4Wu34clf|4`su`DSTo<WYI_=oi+N2bg)%Ch#%o>noHjF7qbe2ps
z$&9_SOSd1Cy54<v-}X1{y8nUEhbG?f*v!oyebeSGy_$9!pqFdrdDEyateC~x@~NCt
zFv>-<d||O+I%eK7=F7Q~v5AIKDap0<o=j$`o;NSm&Ds@xP*r7V|F(?wL=j3Hw~H*T
zsDDFs>33|)WX^ESWYxg4=rO!`XGWWMpsSwq2;VxSY4aCh6}sa!H9Vqa7OY&}u=HZe
zZD-$pEwk8gan>L63J>*anI(*530-l#vcnH&GH1EjV>zcbQ!&a=>4#q1lThgt*Nqp8
zQlZWIrk>2v%%iIQGxfByoU0l$D=^oaUissyD#sM%EbU0qtl4Xovs|g0<%S7Q!0@>a
zp$<0D9~|4|z79To%YBi6rUu7`JrY&)i#?brj)`;d{Hx;Q;u-Or_`3MMctQL^{8s!)
zydqvDqIODAC#9*E`sqFzpzXAa4$vqaq6cY;PS87Pmd?;Q%2R=gRH7=?s7?)fAANv6
zL?5P)&?o6r^cngrJxiabuh3WNYxEuZG5v&oN-xr{=y&uo{ht0xf1_9E7X4FcRoawx
zWvjAX*`W+7`;`OAm@=)*DvQdJtGUwjyVG7zyhO?2rRii&!<$8v>+!DC_sG%dN3~=B
zGp_Vfx9dE2z2WWw_NapojjtJ>YpqQK^_#u4^?-*+TbH&FveTPzv3vXawfmYL81~Es
zIEistWuMeLT<RU#8&x=o-sWa^YHv~D9(uc*9qQYy!Xb4<X0?&Ny(zez-r{D5`VOR2
zo!rbJ?d>Tzpx)|c`?axDN*6NIH`#YYg%j!OYh~RpiI>G6#VzqKSa&yVp{=x&hUp+3
zrla&Y&A^`LXo1dBmU6Iaw&^le=n^^f9=Zm*UZwZblk_oqiatS4!?r&S>t@^j0)3I5
zqc71n>05MzzD>{5_vi)s0sRQp{&V^b{ek{We+k*}@t_UUKW^J_$)1|>RzkJf(t6L0
zXP(FE-L&wMUEH9yvg})AwjhjI<7>=S%a&b6<bWLse+F?7la%FMi?04MF7dC@OwaK`
zSw=LG*h)quetHe`ZY;*@VHUg<lmx%3uzKiO>o#9pqI$6s>$Xl*vLSs;OcJ2)fcz`a
z#fZ~}W0L@Nm#Blb2u)1zEz8Jn8NF}<Ux&~S#w)<tE*dft<vxevP{wLq+K~PdpQn8I
z0J7vt5J(V65J(URAn-QiI^`aC3eOT|UtU8ZvoFu6Vz+Nb)x;!dE$q|lc;+zA8*&dF
znzea99O5g4_-w?}k@k339N<f%rDe2{$2x>{1aFNPF5XM}wd?>_32TuhF2_(~_1S<r
zw5IU-6QFK~Y+l>r&P*7sXMJe-X+v@)LVnuRnp|6sL`hr>odqy9eh%&>(>fT1NUXrC
zbAY-9)D=+)$z&}2GCeB)j=U3$RW#(tKR%*~44VYWFD8yB3;@8QZXZ}32pxE!>+6Lw
z8&HR2vl#`b+r)YN#f5HwX&uV2Oh6T&Y=uNN;#v?=#v-1s2`T~ePB7Oob_FP9%2AAr
zAp0J@*9TBqJOY3?rsOj__PmMcP_SJExKfdLEZi{$%im6y7w5X|_%#f9IosGBa)#Sv
zF#T<|N)%!ZE0!)KPh$1=09G7>Hjy$hYs8!<O04``-OyqM@we;Y733_*$ETQ~VU{N5
z=T$+=b12V_F|oMBY9snkk2ppqKYfp!r7uFCEc}?yZP{`Po`#{3kw)m}R&myu6U=?y
z?N!id89(K$4?k75R+G5JI6Na4p*O(84sj)Fm5f$^z6G?vH>d^oIgYC7IPe>h24hW(
zh*A9Q6$c~`v1Stx6weicT!QeT4}=zU2LK0^lwFUZ@++Bg8KoWZsdhv`iHBcElp~}Z
z+mGVs=<?d&F|Ep3!NLTMmcj~4RQ;T3kCRvZbw`*j=yrR_{$Khw`*++T0=o@-FG%+P
z$^M@wtK>=$NDxR6czq$z=BhKCMtWrZ-~Ye9luoos5J(VsO%b5hskx~Mh~xu_xQl;l
zH-P&bZl?JzZocp?S?~z_5D*#uIo?4@<UK$$#;-_M-Bhw7FIkcPmwpHsvkOc1|MLH}
Tyf2G^4Rf;phq3-Y?*IP-rjEU4

diff --git a/src/GenerateB.c b/src/GenerateB.c
index 48b9990c..682b9c71 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -193,7 +193,7 @@ void InitBeam(void)
 			if (surface) PrintError("Currently, Bessel incident beam is not supported for '-surf'");
 			// initialize parameters
 			ConvertToInteger(beam_pars[0],"beam order",&n0);
-			TestRangeII(abs(n0),"beam order (might cause the incorrect calculation of Bessel function)",0,899);
+			TestRangeII(abs(n0),"beam order (might cause the incorrect calculation of Bessel function)",0,50);
 			vorticity = n0;
 			alpha0 = Deg2Rad(beam_pars[1]);
 			K =fabs(WaveNum);

From de78d3659580175d91ecdc972d5a2e0a09df26a3 Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Wed, 15 Dec 2021 16:25:45 +0700
Subject: [PATCH 44/46] minor changes

---
 src/Makefile | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/src/Makefile b/src/Makefile
index 80f3e8ca..f23b53bd 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -171,14 +171,12 @@ override EXTRA_FLAGS +=
 #FFTW3_LIB_PATH := $(HOME)/lib
 #FFTW3_INC_PATH := "$(abspath ./../lib)"
 #FFTW3_LIB_PATH := "$(abspath ./../lib)"
-FFTW3_INC_PATH := "/opt/homebrew/include"
-FFTW3_LIB_PATH := "/opt/homebrew/lib"
 
 # --Fortran library path--
 # If your environment does not specify search path for Fortran libraries, you may get errors during linking of ADDA.
 # For instance, this may happen on macOS. Then uncomment the following line and modify the path if needed. 
 # This variable can also be defined in the enviroment or in the command line of make (see explanation above for OPTIONS) 
-FORT_LIB_PATH := /usr/local/gfortran/lib
+#FORT_LIB_PATH := /usr/local/gfortran/lib
 
 #=======================================================================================================================
 # !!! End of control section. Everything below is not designed to be modified by user. However, advanced users may wish

From 51aac9ef64468da8c2681c9fd5d9fa5e5883164f Mon Sep 17 00:00:00 2001
From: stefaniagl <stefgluhova@gmail.com>
Date: Wed, 15 Dec 2021 19:55:31 +0700
Subject: [PATCH 45/46] minor changes

---
 .gitignore | 1 -
 1 file changed, 1 deletion(-)

diff --git a/.gitignore b/.gitignore
index 4d2cdded..6c3d0012 100644
--- a/.gitignore
+++ b/.gitignore
@@ -8,4 +8,3 @@
 # for Eclipse
 .сproject
 .project 
-src/.DS_Store

From 20ee6df090fed1d2400a360ba1ff895aa9a3487e Mon Sep 17 00:00:00 2001
From: Maxim Yurkin <yurkin@gmail.com>
Date: Sun, 19 Dec 2021 14:21:59 +0700
Subject: [PATCH 46/46] - corrects additional phase factor for Y-polarization
 of incident Bessel beams - corrects accounting for beam vorticity, when
 computing amplitude matrix (for scat_plane and scat_grid) - renames variables
 for Bessel beams to avoid confusion - slightly changes alignment in the code
 and descriptive string for Bessel beams - merges two cases for Bessel beams
 in InitBeam() into one - replaces several cexp(I*...) by imExp(...) - adds
 several TODO comments for further improvement - quick tests show that
 amplitude matrix remains invariant under 90-degree rotation for symmetric
 shapes (comparing

---
 src/CalculateE.c |  27 ++++--
 src/GenerateB.c  | 233 +++++++++++++++++++++++------------------------
 src/README.md    |   1 +
 3 files changed, 130 insertions(+), 131 deletions(-)

diff --git a/src/CalculateE.c b/src/CalculateE.c
index faa9a770..c6c41a87 100644
--- a/src/CalculateE.c
+++ b/src/CalculateE.c
@@ -200,8 +200,9 @@ void MuellerMatrix(void)
 				for (i=0;i<nTheta;i++) {
 					// transform amplitude matrix, multiplying by rotation matrix (-alpha)
 					/* Note, that amplitude matrix for vortex beams (e.g., Bessel ones) have to be additionally
-					 * multiplied by the phase factor exp(-I*vorticity*alpha). However, it does not change the
-					 * Mueller matrix and we do not save the amplitude matrix in this case.
+					 * multiplied by the phase factor exp(-I*vorticity*alpha) and additional factor I^vorticity for
+					 * scat_plane (see below). However, it does not change the Mueller matrix and we do not save the
+					 * amplitude matrix here. Hence, these phase factors are ignored for orientation averaging.
 					 */
 					if (yzplane) { // here the default (alpha=0) is yz-plane, so par=Y, per=X
 						s2 =  co*ampl_alphaY[index+1] + si*ampl_alphaX[index+1]; // s2 =  co*s20 + si*s30
@@ -249,15 +250,19 @@ void MuellerMatrix(void)
 				FCloseErr(mueller,F_MUEL,ONE_POS);
 			}
 		}
-		if (scat_plane) { // par=X, per=-Y
+		if (scat_plane) { // par=X*i^n, per=-Y*i^n (n - vorticity)
 			if (store_ampl) {
 				SnprintfErr(ONE_POS,fname,MAX_FNAME,"%s/"F_AMPL,directory);
 				ampl=FOpenErr(fname,"w",ONE_POS);
 				fprintf(ampl,THETA_HEADER" "AMPL_HEADER"\n");
+				vort=cpow(I,vorticity);
 				for (i=0;i<nTheta;i++) {
 					theta=i*dtheta_deg;
-					fprintf(ampl,ANGLE_FORMAT" "AMPL_FORMAT"\n",theta,REIM(-EplaneY[2*i]),REIM(EplaneX[2*i+1]),
-						REIM(-EplaneY[2*i+1]),REIM(EplaneX[2*i]));
+					s1=-EplaneY[2*i]*vort;
+					s2=EplaneX[2*i+1]*vort;
+					s3=-EplaneY[2*i+1]*vort;
+					s4=EplaneX[2*i]*vort;
+					fprintf(ampl,ANGLE_FORMAT" "AMPL_FORMAT"\n",theta,REIM(s1),REIM(s2),REIM(s3),REIM(s4));
 				}
 				FCloseErr(ampl,F_AMPL,ONE_POS);
 			}
@@ -267,6 +272,7 @@ void MuellerMatrix(void)
 				fprintf(mueller,THETA_HEADER" "MUEL_HEADER"\n");
 				for (i=0;i<nTheta;i++) {
 					theta=i*dtheta_deg;
+					// here we ignore common phase factor in the amplitude matrix (vort above)
 					ComputeMuellerMatrix(matrix,-EplaneY[2*i],EplaneX[2*i+1],-EplaneY[2*i+1],EplaneX[2*i],theta);
 					fprintf(mueller,ANGLE_FORMAT" "MUEL_FORMAT"\n",theta,COMP44M(matrix));
 				}
@@ -278,10 +284,11 @@ void MuellerMatrix(void)
 			/* compute Mueller Matrix in full space angle.
 			 * E-fields are stored in arrays EgridX and EgridY for incoming X and Y polarized light.
 			 * It is converted to the scattering matrix elements (see e.g Bohren and Huffman) :
-			 * s2 = cos(phi)E'X'par + sin(phi)E'Y'par
-			 * s3 = sin(phi)E'X'par - cos(phi)E'Y'par
-			 * s4 = cos(phi)E'X'per + sin(phi)E'Y'per
-			 * s1 = sin(phi)E'X'per - cos(phi)E'Y'per
+			 * s2 = vort*(cos(phi)E'X'par + sin(phi)E'Y'par)
+			 * s3 = vort*(sin(phi)E'X'par - cos(phi)E'Y'par)
+			 * s4 = vort*(cos(phi)E'X'per + sin(phi)E'Y'per)
+			 * s1 = vort*(sin(phi)E'X'per - cos(phi)E'Y'per)
+			 * where additional phase factor vort=exp(I*vorticity*(PI_OVER_TWO-ph)) is for vortex beams;
 			 * from these the mueller matrix elements are computed
 			 */
 			// open files for writing
@@ -336,7 +343,7 @@ void MuellerMatrix(void)
 					if (angles.type==SG_GRID) phi=angles.phi.val[j];
 					else phi=angles.phi.val[ind]; // angles.type==SG_PAIRS
 					ph=Deg2Rad(phi);
-					vort=cexp(-I*vorticity*ph);
+					vort=imExp(vorticity*(PI_OVER_TWO-ph));
 					// rather complicated (but general) approach to determine rotation angle from XY to scattering plane
 					SetScatPlane(cthet,sthet,ph,tmp3,incPolper);
 					co=-DotProd(incPolper,incPolY);
diff --git a/src/GenerateB.c b/src/GenerateB.c
index 682b9c71..577622bd 100644
--- a/src/GenerateB.c
+++ b/src/GenerateB.c
@@ -46,6 +46,7 @@ extern const opt_index opt_beam;
 
 // used in CalculateE.c
 double C0dipole,C0dipole_refl; // inherent cross sections of exciting dipole (in free space and addition due to surface)
+int vorticity;                 // Vorticity of vortex beams (besN for Bessel beams)
 // used in param.c
 const char *beam_descr; // string for log file with beam parameters
 
@@ -56,11 +57,10 @@ static doublecomplex ki,kt;    // abs of normal components of k_inc/k0, and ktra
 static doublecomplex ktVec[3]; // k_tran/k0
 static double p0;              // amplitude of the incident dipole moment
 #ifndef NO_FORTRAN
-static int n0;                 // Bessel beam order
-int vorticity;				   // Vorticity of vortex beams (n0 for Bessel beams)
-static double alpha0;          // half-cone angle
-static doublecomplex K,Kt,Kz;  // wave-vector components
-static doublecomplex M[4];     // Components of matrix M
+static int besN;                  // Bessel beam order
+static double besAlpha;           // half-cone angle (in radians)
+static doublecomplex besKt,besKz; // wave-vector components (transverse and longitudinal)
+static doublecomplex besM[4];     // Matrix M defining the generalized Bessel beam
 #endif
 /* TO ADD NEW BEAM
  * Add here all internal variables (beam parameters), which you initialize in InitBeam() and use in GenerateB()
@@ -192,89 +192,76 @@ void InitBeam(void)
 		case B_BES_TML:
 			if (surface) PrintError("Currently, Bessel incident beam is not supported for '-surf'");
 			// initialize parameters
-			ConvertToInteger(beam_pars[0],"beam order",&n0);
-			TestRangeII(abs(n0),"beam order (might cause the incorrect calculation of Bessel function)",0,50);
-			vorticity = n0;
-			alpha0 = Deg2Rad(beam_pars[1]);
-			K =fabs(WaveNum);
-			Kt=fabs(WaveNum)*sin(alpha0);
-			Kz=fabs(WaveNum)*cos(alpha0);
+			ConvertToInteger(beam_pars[0],"beam order",&besN);
+			TestRangeII(besN,"beam order (might cause the incorrect calculation of Bessel function)",-50,50);
+			vorticity=besN;
+			besAlpha=Deg2Rad(beam_pars[1]);
+			besKt=WaveNum*sin(besAlpha);
+			besKz=WaveNum*cos(besAlpha);
 			switch (beamtype) { // definition of elements of matrix M ((Mex,Mey),(Mmx,Mmy))
 				case B_BES_CS:
 					TestRangeII(beam_pars[1],"half-cone angle",0,90);
-					M[0]=0.5;	M[1]=0;
-					M[2]=0;		M[3]=0.5;
+					besM[0]=0.5;  besM[1]=0;
+					besM[2]=0;    besM[3]=0.5;
+					if (IFROOT) tmp_str="circularly symmetric energy density";
 					break;
 				case B_BES_CSp:
 					TestRangeII(beam_pars[1],"half-cone angle",0,90);
-					M[0]=0.5;	M[1]=0;
-					M[2]=0;		M[3]=-0.5;
+					besM[0]=0.5;  besM[1]=0;
+					besM[2]=0;    besM[3]=-0.5;
+					if (IFROOT) tmp_str="circularly symmetric energy density, alternative type";
 					break;
 				case B_BES_M:
 					TestRangeII(beam_pars[1],"half-cone angle",0,90);
 					if (beam_Npars==6) {
-						M[0]=beam_pars[2];	M[1]=beam_pars[3];
-						M[2]=beam_pars[4];	M[3]=beam_pars[5];
+						besM[0]=beam_pars[2];
+						besM[1]=beam_pars[3];
+						besM[2]=beam_pars[4];
+						besM[3]=beam_pars[5];
 					}
 					else {
-						M[0]=beam_pars[2]+I*beam_pars[6];
-						M[1]=beam_pars[3]+I*beam_pars[7];
-						M[2]=beam_pars[4]+I*beam_pars[8];
-						M[3]=beam_pars[5]+I*beam_pars[9];
+						besM[0]=beam_pars[2]+I*beam_pars[6];
+						besM[1]=beam_pars[3]+I*beam_pars[7];
+						besM[2]=beam_pars[4]+I*beam_pars[8];
+						besM[3]=beam_pars[5]+I*beam_pars[9];
 					}
+					if (IFROOT) tmp_str="generalized";
 					break;
 				case B_BES_LE:
 					TestRangeII(beam_pars[1],"half-cone angle",0,90);
-					M[0]=0;		M[1]=0;
-					M[2]=0;		M[3]=1;
+					besM[0]=0;  besM[1]=0;
+					besM[2]=0;  besM[3]=1;
+					if (IFROOT) tmp_str="linear electric field";
 					break;
 				case B_BES_LM:
 					TestRangeII(beam_pars[1],"half-cone angle",0,90);
-					M[0]=0;		M[1]=1;
-					M[2]=0;		M[3]=0;
+					besM[0]=0;  besM[1]=1;
+					besM[2]=0;  besM[3]=0;
+					if (IFROOT) tmp_str="linear magnetic field";
 					break;
+				/* TODO: for the following two types, both 0 and 90 degrees should be fine, but may require some
+				 * rearrangement of formulae. Then the tests for range of alpha should be moved outside of the case
+				 */
 				case B_BES_TEL:
 					TestRangeNN(beam_pars[1],"half-cone angle for TEL type",0,90);
-					M[0]=-K/Kt;		M[1]=0;
-					M[2]=0;			M[3]=Kz/Kt;
+					besM[0]=-WaveNum/besKt;  besM[1]=0;
+					besM[2]=0;               besM[3]=besKz/besKt;
+					if (IFROOT) tmp_str="linear component of the TE";
 					break;
 				case B_BES_TML:
 					TestRangeNN(beam_pars[1],"half-cone angle for TML type",0,90);
-					M[0]=0; 		M[1]=Kz/Kt;
-					M[2]=K/Kt;		M[2]=0;
+					besM[0]=0;              besM[1]=besKz/besKt;
+					besM[2]=WaveNum/besKt;  besM[2]=0;
+					if (IFROOT) tmp_str="linear component of the TM";
 					break;
 				default: LogError(ONE_POS,"Incompatibility error in GenerateB");
 			}
+			// TODO: some symmetries can be retained in some special cases
 			symR=symX=symY=symZ=false;
 			// beam info
-			if (IFROOT) {
-				switch (beamtype) {
-					case B_BES_CS:
-						tmp_str="circularly symmetric energy density";
-						break;
-					case B_BES_CSp:
-						tmp_str="circularly symmetric energy density, alternative type";
-						break;
-					case B_BES_M:
-						tmp_str="generalized";
-						break;
-					case B_BES_LE:
-						tmp_str="linear electric field";
-						break;
-					case B_BES_LM:
-						tmp_str="linear magnetic field";
-						break;
-					case B_BES_TEL:
-						tmp_str="linear component of the TE";
-						break;
-					case B_BES_TML:
-						tmp_str="linear component of the TM";
-						break;
-					default: LogError(ONE_POS,"Incompatibility error in GenerateB");
-				}
-				beam_descr=dyn_sprintf("Bessel beam (%s)\n"
-									   "\tOrder: ""%d""\n\t""Half-cone angle: "GFORMDEF"\n",tmp_str,n0,alpha0);
-			}
+			if (IFROOT) beam_descr=dyn_sprintf("Bessel beam (%s)\n"
+				                               "\tOrder: %d, half-cone angle: "GFORMDEF" deg\n",
+				                               tmp_str,besN,beam_pars[1]);
 			return;
 #endif // !NO_FORTRAN
 		case B_READ:
@@ -333,11 +320,11 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 	 */
 	doublecomplex eIncRefl[3],eIncTran[3];
 #ifndef NO_FORTRAN
-	double ro;
-	int n1,q; // for Bessel beams
-	doublecomplex vort;  // vortex phase of Bessel beam rotated on 90 deg
-	doublecomplex fn[5]; // for general functions f(n,ro,phi) of Bessel beams (fn-2, fn-1, fn, fn+1, fn+2 respectively)
-	double phi,arg,td1[abs(n0)+3],td2[abs(n0)+3],jn1[abs(n0)+3]; // for Bessel beams
+	// for Bessel beams
+	int n1,q;
+	doublecomplex vort;  // vortex phase of Bessel beam rotated by 90 deg
+	doublecomplex fn[5]; // for general functions f(n,ro,phi) of Bessel beams (fn-2, fn-1, fn, fn+1, fn+2, respectively)
+	double phi,arg,td1[abs(besN)+3],td2[abs(besN)+3],jn1[abs(besN)+3]; // for Bessel beams
 #endif
 	const char *fname;
 	/* TO ADD NEW BEAM
@@ -539,84 +526,88 @@ void GenerateB (const enum incpol which,   // x - or y polarized incident light
 		case B_BES_LM:
 		case B_BES_TEL:
 		case B_BES_TML:
-			if (which==INCPOL_X) vort = cpow(I,n0);
-			else vort = 1.;
+			/* we assume that matrix M determines x-polarization (in the beam reference frame), while y-one is obtained
+			 * by rotation with additional phase shift
+			 */
+			vort=(which==INCPOL_Y) ? cpow(I,besN) : 1;
 			for (i=0;i<local_nvoid_Ndip;i++) {
 				j=3*i;
 				LinComb(DipoleCoord+j,beam_center,1,-1,r1);
 				x=DotProd(r1,ex);
 				y=DotProd(r1,ey);
 				z=DotProd(r1,prop);
-				ro2=x*x+y*y;
-				ro=sqrt(ro2);	// radial distance in a cylindrical coordinate system
-				phi=atan2(y,x);	// angular coordinate in a cylindrical coordinate system
-				// common factor
-				ctemp=cexp(I*n0*phi)*cexp(I*Kz*z)/K/K*vort;
-				arg=Kt*ro;
-				if (arg<ROUND_ERR){
-					if (n0 == 0) fn[2]=1.;
+				phi=atan2(y,x); // angular coordinate in a cylindrical coordinate system
+				ctemp=imExp(besN*phi)*cexp(I*besKz*z)*vort/(WaveNum*WaveNum); // common factor
+				arg=besKt*sqrt(x*x+y*y); // argument of Bessel functions
+				if (arg<ROUND_ERR) {
+					// TODO: the following seems incorrect for n=+-1 or +-2 (other fn will be non-zero)
+					if (besN==0) fn[2]=1.;
 					else fn[2]=0;
-					fn[0]=0; fn[1]=0; fn[3]=0; fn[4]=0;
+					fn[0]=fn[1]=fn[3]=fn[4]=0;
 				}
 				else {
-					n1=abs(n0)+2;
-					if (n0 <= -3) {
-						bjndd_(&n1, &arg, jn1, td1, td2);
-						if (n1 % 2 == 0) q=1;	else q=-1;
-						fn[0] =  q*jn1[-n0+2]*cexp(-2*I*phi);
-						fn[1] = -q*jn1[-n0+1]*cexp(-I*phi);
-						fn[2] =  q*jn1[-n0];
-						fn[3] = -q*jn1[-n0-1]*cexp(I*phi);
-						fn[4] =  q*jn1[-n0-2]*cexp(2*I*phi);
+					// TODO: the following looks very complicated, try to simplify
+					n1=abs(besN)+2;
+					if (besN<=-3) {
+						bjndd_(&n1,&arg,jn1,td1,td2);
+						if (n1%2==0) q=1;
+						else q=-1;
+						fn[0] =  q*jn1[-besN+2]*imExp(-2*phi);
+						fn[1] = -q*jn1[-besN+1]*imExp(-phi);
+						fn[2] =  q*jn1[-besN];
+						fn[3] = -q*jn1[-besN-1]*imExp(phi);
+						fn[4] =  q*jn1[-besN-2]*imExp(2*phi);
 					}
-					if (n0 >= 2) {
-						bjndd_(&n1, &arg, jn1, td1, td2);
-						fn[0] = jn1[n0-2]*cexp(-2*I*phi);
-						fn[1] = jn1[n0-1]*cexp(-I*phi);
-						fn[2] = jn1[n0];
-						fn[3] = jn1[n0+1]*cexp(I*phi);
-						fn[4] = jn1[n0+2]*cexp(2*I*phi);
+					if (besN >= 2) {
+						bjndd_(&n1,&arg,jn1,td1,td2);
+						fn[0] = jn1[besN-2]*imExp(-2*phi);
+						fn[1] = jn1[besN-1]*imExp(-phi);
+						fn[2] = jn1[besN];
+						fn[3] = jn1[besN+1]*imExp(phi);
+						fn[4] = jn1[besN+2]*imExp(2*phi);
 					}
-					if (n0 == -2) {
-						bjndd_(&n1, &arg, jn1, td1, td2);
-						fn[0] =  jn1[4]*cexp(-2*I*phi);
-						fn[1] = -jn1[3]*cexp(-I*phi);
+					if (besN == -2) {
+						bjndd_(&n1,&arg,jn1,td1,td2);
+						fn[0] =  jn1[4]*imExp(-2*phi);
+						fn[1] = -jn1[3]*imExp(-phi);
 						fn[2] =  jn1[2];
-						fn[3] = -jn1[1]*cexp(I*phi);
-						fn[4] =  jn1[0]*cexp(2*I*phi);
+						fn[3] = -jn1[1]*imExp(phi);
+						fn[4] =  jn1[0]*imExp(2*phi);
 					}
-					if (n0 == -1) {
-						bjndd_(&n1, &arg, jn1, td1, td2);
-						fn[0] = -jn1[3]*cexp(-2*I*phi);
-						fn[1] =  jn1[2]*cexp(-I*phi);
+					if (besN == -1) {
+						bjndd_(&n1,&arg,jn1,td1,td2);
+						fn[0] = -jn1[3]*imExp(-2*phi);
+						fn[1] =  jn1[2]*imExp(-phi);
 						fn[2] = -jn1[1];
-						fn[3] =  jn1[0]*cexp(I*phi);
-						fn[4] =  jn1[1]*cexp(2*I*phi);
+						fn[3] =  jn1[0]*imExp(phi);
+						fn[4] =  jn1[1]*imExp(2*phi);
 					}
-					if (n0 == 0) {
-						bjndd_(&n1, &arg, jn1, td1, td2);
-						fn[0] =  jn1[2]*cexp(-2*I*phi);
-						fn[1] = -jn1[1]*cexp(-I*phi);
+					if (besN == 0) {
+						bjndd_(&n1,&arg,jn1,td1,td2);
+						fn[0] =  jn1[2]*imExp(-2*phi);
+						fn[1] = -jn1[1]*imExp(-phi);
 						fn[2] =  jn1[0];
-						fn[3] =  jn1[1]*cexp(I*phi);
-						fn[4] =  jn1[2]*cexp(2*I*phi);
+						fn[3] =  jn1[1]*imExp(phi);
+						fn[4] =  jn1[2]*imExp(2*phi);
 					}
-					if (n0 == 1) {
-						bjndd_(&n1, &arg, jn1, td1, td2);
-						fn[0] = -jn1[1]*cexp(-2*I*phi);
-						fn[1] =  jn1[0]*cexp(-I*phi);
+					if (besN == 1) {
+						bjndd_(&n1,&arg,jn1,td1,td2);
+						fn[0] = -jn1[1]*imExp(-2*phi);
+						fn[1] =  jn1[0]*imExp(-phi);
 						fn[2] =  jn1[1];
-						fn[3] =  jn1[2]*cexp(I*phi);
-						fn[4] =  jn1[3]*cexp(2*I*phi);
+						fn[3] =  jn1[2]*imExp(phi);
+						fn[4] =  jn1[3]*imExp(2*phi);
 					}
 				}
-
-				t1 = (((K*K+Kz*Kz)/2.*M[0] +  K*Kz*M[3])*fn[2] +
-						  Kt*Kt/4.*((M[0]+I*M[1])*fn[0] + (M[0]-I*M[1])*fn[4]));	// Ex
-				t2 = (((K*K+Kz*Kz)/2.*M[1] -  K*Kz*M[2])*fn[2] +
-						I*Kt*Kt/4.*((M[0]+I*M[1])*fn[0] - (M[0]-I*M[1])*fn[4]));	// Ey
-				t3 = ((I*Kz*(M[0]+I*M[1]) + K*(M[2]+I*M[3]))*fn[1] -
-					  (I*Kz*(M[0]-I*M[1]) - K*(M[2]-I*M[3]))*fn[3])*Kt/2.;			// Ez
+				/* TODO: all factors before f[n] should be calculated in InitBeam beforehand
+				 * this will improve speed and allow robust calculation in the limit, e.g., of kt->0
+				 */
+				t1 = (((WaveNum*WaveNum+besKz*besKz)/2.*besM[0] +  WaveNum*besKz*besM[3])*fn[2] +
+					  besKt*besKt/4.*((besM[0]+I*besM[1])*fn[0] + (besM[0]-I*besM[1])*fn[4])); // Ex
+				t2 = (((WaveNum*WaveNum+besKz*besKz)/2.*besM[1] -  WaveNum*besKz*besM[2])*fn[2] +
+					  I*besKt*besKt/4.*((besM[0]+I*besM[1])*fn[0] - (besM[0]-I*besM[1])*fn[4])); // Ey
+				t3 = ((I*besKz*(besM[0]+I*besM[1]) + WaveNum*(besM[2]+I*besM[3]))*fn[1] -
+					  (I*besKz*(besM[0]-I*besM[1]) - WaveNum*(besM[2]-I*besM[3]))*fn[3])*besKt/2.; // Ez
 
 				cvMultScal_RVec(t1,ex,v1);
 				cvMultScal_RVec(t2,ey,v2);
diff --git a/src/README.md b/src/README.md
index 74437518..4d32ea25 100644
--- a/src/README.md
+++ b/src/README.md
@@ -1,6 +1,7 @@
 Main source of ADDA, including Makefiles and other scripts. C++ and Fortran sources of auxiliary (optional) routines are placed in separate folders. The compilation itself happens in `seq`, `mpi`, or `ocl` folder depending on the mode - object and executable files are placed there.
 * `cpp/` - C++ sources for Apple clFFT
 * `fort/` - Fortran sources
+  * `bessel.f90` - subroutines for calculating Bessel functions
   * `cfft99D.f` - source file for Temperton FFT
   * `propaesplibreintadda.f`, `d07hre.f`, `d09hre.f`, `d113re.f`, `d132re.f`, `dadhre.f`, `dchhre.f`, `dcuhre.f`, `dfshre.f`, `dinhre.f`, `drlhre.f`, `dtrhre.f` - subroutine to compute IGT and related numerical routines
 * `mpi/Makefile` - makefile for MPI version (called from the main makefile)