summaryrefslogtreecommitdiff
path: root/src/c/elementaryFunctions/acos
diff options
context:
space:
mode:
Diffstat (limited to 'src/c/elementaryFunctions/acos')
-rw-r--r--src/c/elementaryFunctions/acos/cacoss.c294
-rw-r--r--src/c/elementaryFunctions/acos/zacoss.c294
2 files changed, 294 insertions, 294 deletions
diff --git a/src/c/elementaryFunctions/acos/cacoss.c b/src/c/elementaryFunctions/acos/cacoss.c
index 97420313..6e12ed8a 100644
--- a/src/c/elementaryFunctions/acos/cacoss.c
+++ b/src/c/elementaryFunctions/acos/cacoss.c
@@ -1,147 +1,147 @@
-/*
- * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
- * Copyright (C) 2007-2008 - INRIA - Bruno JOFRET
- * Copyright (C) Bruno Pincon
- *
- * This file must be used under the terms of the CeCILL.
- * This source file is licensed as described in the file COPYING, which
- * you should have received as part of this distribution. The terms
- * are also available at
- * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
- *
- */
-
-/*
- * This fonction is a translation of fortran wacos write by Bruno Pincon <Bruno.Pincon@iecn.u-nancy.fr>
- * REFERENCE
- * This is a Fortran-77 translation of an algorithm by
- * T.E. Hull, T. F. Fairgrieve and P.T.P. Tang which
- * appears in their article :
- * "Implementing the Complex Arcsine and Arccosine
- * Functions Using Exception Handling", ACM, TOMS,
- * Vol 23, No. 3, Sept 1997, p. 299-335
- */
-
-#include "acos.h"
-#include "atan.h"
-#include "log.h"
-#include "log1p.h"
-#include "sqrt.h"
-#include "abs.h"
-#include "lapack.h"
-#include "min.h"
-#include "max.h"
-
-#define localSign(x) (x>0 ? 1.0f : -1.0f)
-
-floatComplex cacoss(floatComplex z) {
- static float sfltPi = 3.1415926535897932384626433f;
- static float sfltPi_2 = 1.5707963267948966192313216f;
- static float sfltLn2 = 0.6931471805599453094172321f;
- static float sfltAcross = 1.5f;
- static float sfltBcross = 0.6417f;
-
- float fltLsup = ssqrts((float) getOverflowThreshold())/8.0f;
- float fltLinf = 4.0f * ssqrts((float) getUnderflowThreshold());
- float fltEpsm = ssqrts((float) getRelativeMachinePrecision());
-
- float fltAbsReal = sabss(creals(z));
- float fltAbsImg = sabss(cimags(z));
- float fltSignReal = localSign(creals(z));
- float fltSignImg = localSign(cimags(z));
-
- float fltR = 0, fltS = 0, fltA = 0, fltB = 0;
-
- float fltTemp = 0;
-
- float _pfltReal = 0;
- float _pfltImg = 0;
-
- if( min(fltAbsReal, fltAbsImg) > fltLinf && max(fltAbsReal, fltAbsImg) <= fltLsup)
- {/* we are in the safe region */
- fltR = ssqrts( (fltAbsReal + 1 )*(fltAbsReal + 1 ) + fltAbsImg*fltAbsImg);
- fltS = ssqrts( (fltAbsReal - 1 )*(fltAbsReal - 1 ) + fltAbsImg*fltAbsImg);
- fltA = 0.5f * ( fltR + fltS );
- fltB = fltAbsReal / fltA;
-
-
- /* compute the real part */
- if(fltB <= sfltBcross)
- _pfltReal = sacoss(fltB);
- else if( fltAbsReal <= 1)
- _pfltReal = satans(ssqrts(0.5f * (fltA + fltAbsReal) * (fltAbsImg*fltAbsImg / (fltR + (fltAbsReal + 1)) + (fltS + (1 - fltAbsReal)))) / fltAbsReal);
- else
- _pfltReal = satans((fltAbsImg * ssqrts(0.5f * ((fltA + fltAbsReal) / (fltR + (fltAbsReal + 1)) + (fltA + fltAbsReal) / (fltS + (fltAbsReal - 1))))) / fltAbsReal);
-
- /* compute the imaginary part */
- if(fltA <= sfltAcross)
- {
- float fltImg1 = 0;
-
- if(fltAbsReal < 1)
- /* Am1 = 0.5d0*((y**2)/(R+(x+1.d0))+(y**2)/(S+(1.d0-x))) */
- fltImg1 = 0.5f * (fltAbsImg*fltAbsImg / (fltR + (fltAbsReal + 1)) + fltAbsImg*fltAbsImg / (fltS + (1 - fltAbsReal)));
- else
- /* Am1 = 0.5d0*((y**2)/(R+(x+1.d0))+(S+(x-1.d0))) */
- fltImg1 = 0.5f * (fltAbsImg*fltAbsImg / (fltR + (fltAbsReal + 1)) + (fltS + (fltAbsReal - 1)));
- /* ai = logp1(Am1 + sqrt(Am1*(A+1.d0))) */
- fltTemp = fltImg1 + ssqrts(fltImg1 *( fltA + 1));
- _pfltImg = slog1ps(fltTemp);
- }
- else
- /* ai = log(A + sqrt(A**2 - 1.d0)) */
- _pfltImg = slogs(fltA + ssqrts(fltA*fltA - 1));
- }
- else
- {/* evaluation in the special regions ... */
- if(fltAbsImg <= fltEpsm * sabss(fltAbsReal - 1))
- {
- if(fltAbsReal < 1)
- {
- _pfltReal = sacoss(fltAbsReal);
- _pfltImg = fltAbsImg / ssqrts((1 + fltAbsReal) * (1 - fltAbsReal));
- }
- else
- {
- _pfltReal = 0;
- if(fltAbsReal <= fltLsup)
- {
- fltTemp = (fltAbsReal - 1) + ssqrts((fltAbsReal - 1) * (fltAbsReal + 1));
- _pfltImg = slog1ps(fltTemp);
- }
- else
- _pfltImg = sfltLn2 + slogs(fltAbsReal);
- }
- }
- else if(fltAbsImg < fltLinf)
- {
- _pfltReal = ssqrts(fltAbsImg);
- _pfltImg = _pfltReal;
- }
- else if((fltEpsm * fltAbsImg - 1 >= fltAbsReal))
- {
- _pfltReal = sfltPi_2;
- _pfltImg = sfltLn2 + slogs(fltAbsImg);
- }
- else if(fltAbsReal > 1)
- {
- _pfltReal = satans(fltAbsImg / fltAbsReal);
- fltTemp = (fltAbsReal / fltAbsImg)*(fltAbsReal / fltAbsImg);
- _pfltImg = sfltLn2 + slogs(fltAbsImg) + 0.5f * slog1ps(fltTemp);
- }
- else
- {
- float fltTemp2 = ssqrts(1 + fltAbsImg*fltAbsImg);
- _pfltReal = sfltPi_2;
- fltTemp = 2 * fltAbsImg * (fltAbsImg + fltTemp2);
- _pfltImg = 0.5f * slog1ps(fltTemp);
- }
- }
- if(fltSignReal < 0)
- _pfltReal = sfltPi - _pfltReal;
-
- if(fltAbsImg != 0 || fltSignReal < 0)
- _pfltImg = - fltSignImg * _pfltImg;
-
- return FloatComplex(_pfltReal, _pfltImg);
-}
+/*
+ * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+ * Copyright (C) 2007-2008 - INRIA - Bruno JOFRET
+ * Copyright (C) Bruno Pincon
+ *
+ * This file must be used under the terms of the CeCILL.
+ * This source file is licensed as described in the file COPYING, which
+ * you should have received as part of this distribution. The terms
+ * are also available at
+ * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
+ *
+ */
+
+/*
+ * This fonction is a translation of fortran wacos write by Bruno Pincon <Bruno.Pincon@iecn.u-nancy.fr>
+ * REFERENCE
+ * This is a Fortran-77 translation of an algorithm by
+ * T.E. Hull, T. F. Fairgrieve and P.T.P. Tang which
+ * appears in their article :
+ * "Implementing the Complex Arcsine and Arccosine
+ * Functions Using Exception Handling", ACM, TOMS,
+ * Vol 23, No. 3, Sept 1997, p. 299-335
+ */
+
+#include "acos.h"
+#include "atan.h"
+#include "log.h"
+#include "log1p.h"
+#include "sqrt.h"
+#include "abs.h"
+#include "lapack.h"
+#include "min.h"
+#include "max.h"
+
+#define localSign(x) (x>0 ? 1.0f : -1.0f)
+
+floatComplex cacoss(floatComplex z) {
+ static float sfltPi = 3.1415926535897932384626433f;
+ static float sfltPi_2 = 1.5707963267948966192313216f;
+ static float sfltLn2 = 0.6931471805599453094172321f;
+ static float sfltAcross = 1.5f;
+ static float sfltBcross = 0.6417f;
+
+ float fltLsup = ssqrts((float) getOverflowThreshold())/8.0f;
+ float fltLinf = 4.0f * ssqrts((float) getUnderflowThreshold());
+ float fltEpsm = ssqrts((float) getRelativeMachinePrecision());
+
+ float fltAbsReal = sabss(creals(z));
+ float fltAbsImg = sabss(cimags(z));
+ float fltSignReal = localSign(creals(z));
+ float fltSignImg = localSign(cimags(z));
+
+ float fltR = 0, fltS = 0, fltA = 0, fltB = 0;
+
+ float fltTemp = 0;
+
+ float _pfltReal = 0;
+ float _pfltImg = 0;
+
+ if( min(fltAbsReal, fltAbsImg) > fltLinf && max(fltAbsReal, fltAbsImg) <= fltLsup)
+ {/* we are in the safe region */
+ fltR = ssqrts( (fltAbsReal + 1 )*(fltAbsReal + 1 ) + fltAbsImg*fltAbsImg);
+ fltS = ssqrts( (fltAbsReal - 1 )*(fltAbsReal - 1 ) + fltAbsImg*fltAbsImg);
+ fltA = 0.5f * ( fltR + fltS );
+ fltB = fltAbsReal / fltA;
+
+
+ /* compute the real part */
+ if(fltB <= sfltBcross)
+ _pfltReal = sacoss(fltB);
+ else if( fltAbsReal <= 1)
+ _pfltReal = satans(ssqrts(0.5f * (fltA + fltAbsReal) * (fltAbsImg*fltAbsImg / (fltR + (fltAbsReal + 1)) + (fltS + (1 - fltAbsReal)))) / fltAbsReal);
+ else
+ _pfltReal = satans((fltAbsImg * ssqrts(0.5f * ((fltA + fltAbsReal) / (fltR + (fltAbsReal + 1)) + (fltA + fltAbsReal) / (fltS + (fltAbsReal - 1))))) / fltAbsReal);
+
+ /* compute the imaginary part */
+ if(fltA <= sfltAcross)
+ {
+ float fltImg1 = 0;
+
+ if(fltAbsReal < 1)
+ /* Am1 = 0.5d0*((y**2)/(R+(x+1.d0))+(y**2)/(S+(1.d0-x))) */
+ fltImg1 = 0.5f * (fltAbsImg*fltAbsImg / (fltR + (fltAbsReal + 1)) + fltAbsImg*fltAbsImg / (fltS + (1 - fltAbsReal)));
+ else
+ /* Am1 = 0.5d0*((y**2)/(R+(x+1.d0))+(S+(x-1.d0))) */
+ fltImg1 = 0.5f * (fltAbsImg*fltAbsImg / (fltR + (fltAbsReal + 1)) + (fltS + (fltAbsReal - 1)));
+ /* ai = logp1(Am1 + sqrt(Am1*(A+1.d0))) */
+ fltTemp = fltImg1 + ssqrts(fltImg1 *( fltA + 1));
+ _pfltImg = slog1ps(fltTemp);
+ }
+ else
+ /* ai = log(A + sqrt(A**2 - 1.d0)) */
+ _pfltImg = slogs(fltA + ssqrts(fltA*fltA - 1));
+ }
+ else
+ {/* evaluation in the special regions ... */
+ if(fltAbsImg <= fltEpsm * sabss(fltAbsReal - 1))
+ {
+ if(fltAbsReal < 1)
+ {
+ _pfltReal = sacoss(fltAbsReal);
+ _pfltImg = fltAbsImg / ssqrts((1 + fltAbsReal) * (1 - fltAbsReal));
+ }
+ else
+ {
+ _pfltReal = 0;
+ if(fltAbsReal <= fltLsup)
+ {
+ fltTemp = (fltAbsReal - 1) + ssqrts((fltAbsReal - 1) * (fltAbsReal + 1));
+ _pfltImg = slog1ps(fltTemp);
+ }
+ else
+ _pfltImg = sfltLn2 + slogs(fltAbsReal);
+ }
+ }
+ else if(fltAbsImg < fltLinf)
+ {
+ _pfltReal = ssqrts(fltAbsImg);
+ _pfltImg = _pfltReal;
+ }
+ else if((fltEpsm * fltAbsImg - 1 >= fltAbsReal))
+ {
+ _pfltReal = sfltPi_2;
+ _pfltImg = sfltLn2 + slogs(fltAbsImg);
+ }
+ else if(fltAbsReal > 1)
+ {
+ _pfltReal = satans(fltAbsImg / fltAbsReal);
+ fltTemp = (fltAbsReal / fltAbsImg)*(fltAbsReal / fltAbsImg);
+ _pfltImg = sfltLn2 + slogs(fltAbsImg) + 0.5f * slog1ps(fltTemp);
+ }
+ else
+ {
+ float fltTemp2 = ssqrts(1 + fltAbsImg*fltAbsImg);
+ _pfltReal = sfltPi_2;
+ fltTemp = 2 * fltAbsImg * (fltAbsImg + fltTemp2);
+ _pfltImg = 0.5f * slog1ps(fltTemp);
+ }
+ }
+ if(fltSignReal < 0)
+ _pfltReal = sfltPi - _pfltReal;
+
+ if(fltAbsImg != 0 || fltSignReal < 0)
+ _pfltImg = - fltSignImg * _pfltImg;
+
+ return FloatComplex(_pfltReal, _pfltImg);
+}
diff --git a/src/c/elementaryFunctions/acos/zacoss.c b/src/c/elementaryFunctions/acos/zacoss.c
index de6f3fe9..10da477c 100644
--- a/src/c/elementaryFunctions/acos/zacoss.c
+++ b/src/c/elementaryFunctions/acos/zacoss.c
@@ -1,147 +1,147 @@
-/*
- * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
- * Copyright (C) 2007-2008 - INRIA - Bruno JOFRET
- * Copyright (C) Bruno Pincon
- *
- * This file must be used under the terms of the CeCILL.
- * This source file is licensed as described in the file COPYING, which
- * you should have received as part of this distribution. The terms
- * are also available at
- * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
- *
- */
-
-/*
- * This fonction is a translation of fortran wacos write by Bruno Pincon <Bruno.Pincon@iecn.u-nancy.fr>
- * REFERENCE
- * This is a Fortran-77 translation of an algorithm by
- * T.E. Hull, T. F. Fairgrieve and P.T.P. Tang which
- * appears in their article :
- * "Implementing the Complex Arcsine and Arccosine
- * Functions Using Exception Handling", ACM, TOMS,
- * Vol 23, No. 3, Sept 1997, p. 299-335
- */
-
-#include "acos.h"
-#include "atan.h"
-#include "log.h"
-#include "log1p.h"
-#include "sqrt.h"
-#include "abs.h"
-#include "lapack.h"
-#include "min.h"
-#include "max.h"
-
-#define localSign(x) (x>0 ? 1 : -1)
-
-doubleComplex zacoss(doubleComplex z) {
- static double sdblPi = 3.1415926535897932384626433;
- static double sdblPi_2 = 1.5707963267948966192313216;
- static double sdblLn2 = 0.6931471805599453094172321;
- static double sdblAcross = 1.5;
- static double sdblBcross = 0.6417;
-
- double dblLsup = dsqrts(getOverflowThreshold())/8.0;
- double dblLinf = 4.0 * dsqrts(getUnderflowThreshold());
- double dblEpsm = dsqrts(getRelativeMachinePrecision());
-
- double dblAbsReal = dabss(zreals(z));
- double dblAbsImg = dabss(zimags(z));
- double dblSignReal = localSign(zreals(z));
- double dblSignImg = localSign(zimags(z));
-
- double dblR = 0, dblS = 0, dblA = 0, dblB = 0;
-
- double dblTemp = 0;
-
- double _pdblReal = 0;
- double _pdblImg = 0;
-
- if( min(dblAbsReal, dblAbsImg) > dblLinf && max(dblAbsReal, dblAbsImg) <= dblLsup)
- {/* we are in the safe region */
- dblR = dsqrts( (dblAbsReal + 1 )*(dblAbsReal + 1 ) + dblAbsImg*dblAbsImg);
- dblS = dsqrts( (dblAbsReal - 1 )*(dblAbsReal - 1 ) + dblAbsImg*dblAbsImg);
- dblA = 0.5 * ( dblR + dblS );
- dblB = dblAbsReal / dblA;
-
-
- /* compute the real part */
- if(dblB <= sdblBcross)
- _pdblReal = dacoss(dblB);
- else if( dblAbsReal <= 1)
- _pdblReal = datans(dsqrts(0.5 * (dblA + dblAbsReal) * (dblAbsImg*dblAbsImg / (dblR + (dblAbsReal + 1)) + (dblS + (1 - dblAbsReal)))) / dblAbsReal);
- else
- _pdblReal = datans((dblAbsImg * dsqrts(0.5 * ((dblA + dblAbsReal) / (dblR + (dblAbsReal + 1)) + (dblA + dblAbsReal) / (dblS + (dblAbsReal - 1))))) / dblAbsReal);
-
- /* compute the imaginary part */
- if(dblA <= sdblAcross)
- {
- double dblImg1 = 0;
-
- if(dblAbsReal < 1)
- /* Am1 = 0.5d0*((y**2)/(R+(x+1.d0))+(y**2)/(S+(1.d0-x))) */
- dblImg1 = 0.5 * (dblAbsImg*dblAbsImg / (dblR + (dblAbsReal + 1)) + dblAbsImg*dblAbsImg / (dblS + (1 - dblAbsReal)));
- else
- /* Am1 = 0.5d0*((y**2)/(R+(x+1.d0))+(S+(x-1.d0))) */
- dblImg1 = 0.5 * (dblAbsImg*dblAbsImg / (dblR + (dblAbsReal + 1)) + (dblS + (dblAbsReal - 1)));
- /* ai = logp1(Am1 + sqrt(Am1*(A+1.d0))) */
- dblTemp = dblImg1 + dsqrts(dblImg1 *( dblA + 1));
- _pdblImg = dlog1ps(dblTemp);
- }
- else
- /* ai = log(A + sqrt(A**2 - 1.d0)) */
- _pdblImg = dlogs(dblA + dsqrts(dblA*dblA - 1));
- }
- else
- {/* evaluation in the special regions ... */
- if(dblAbsImg <= dblEpsm * dabss(dblAbsReal - 1))
- {
- if(dblAbsReal < 1)
- {
- _pdblReal = dacoss(dblAbsReal);
- _pdblImg = dblAbsImg / dsqrts((1 + dblAbsReal) * (1 - dblAbsReal));
- }
- else
- {
- _pdblReal = 0;
- if(dblAbsReal <= dblLsup)
- {
- dblTemp = (dblAbsReal - 1) + dsqrts((dblAbsReal - 1) * (dblAbsReal + 1));
- _pdblImg = dlog1ps(dblTemp);
- }
- else
- _pdblImg = sdblLn2 + dlogs(dblAbsReal);
- }
- }
- else if(dblAbsImg < dblLinf)
- {
- _pdblReal = dsqrts(dblAbsImg);
- _pdblImg = _pdblReal;
- }
- else if((dblEpsm * dblAbsImg - 1 >= dblAbsReal))
- {
- _pdblReal = sdblPi_2;
- _pdblImg = sdblLn2 + dlogs(dblAbsImg);
- }
- else if(dblAbsReal > 1)
- {
- _pdblReal = datans(dblAbsImg / dblAbsReal);
- dblTemp = (dblAbsReal / dblAbsImg)*(dblAbsReal / dblAbsImg);
- _pdblImg = sdblLn2 + dlogs(dblAbsImg) + 0.5 * dlog1ps(dblTemp);
- }
- else
- {
- double dblTemp2 = dsqrts(1 + dblAbsImg*dblAbsImg);
- _pdblReal = sdblPi_2;
- dblTemp = 2 * dblAbsImg * (dblAbsImg + dblTemp2);
- _pdblImg = 0.5 * dlog1ps(dblTemp);
- }
- }
- if(dblSignReal < 0)
- _pdblReal = sdblPi - _pdblReal;
-
- if(dblAbsImg != 0 || dblSignReal < 0)
- _pdblImg = - dblSignImg * _pdblImg;
-
- return DoubleComplex(_pdblReal, _pdblImg);
-}
+/*
+ * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+ * Copyright (C) 2007-2008 - INRIA - Bruno JOFRET
+ * Copyright (C) Bruno Pincon
+ *
+ * This file must be used under the terms of the CeCILL.
+ * This source file is licensed as described in the file COPYING, which
+ * you should have received as part of this distribution. The terms
+ * are also available at
+ * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
+ *
+ */
+
+/*
+ * This fonction is a translation of fortran wacos write by Bruno Pincon <Bruno.Pincon@iecn.u-nancy.fr>
+ * REFERENCE
+ * This is a Fortran-77 translation of an algorithm by
+ * T.E. Hull, T. F. Fairgrieve and P.T.P. Tang which
+ * appears in their article :
+ * "Implementing the Complex Arcsine and Arccosine
+ * Functions Using Exception Handling", ACM, TOMS,
+ * Vol 23, No. 3, Sept 1997, p. 299-335
+ */
+
+#include "acos.h"
+#include "atan.h"
+#include "log.h"
+#include "log1p.h"
+#include "sqrt.h"
+#include "abs.h"
+#include "lapack.h"
+#include "min.h"
+#include "max.h"
+
+#define localSign(x) (x>0 ? 1 : -1)
+
+doubleComplex zacoss(doubleComplex z) {
+ static double sdblPi = 3.1415926535897932384626433;
+ static double sdblPi_2 = 1.5707963267948966192313216;
+ static double sdblLn2 = 0.6931471805599453094172321;
+ static double sdblAcross = 1.5;
+ static double sdblBcross = 0.6417;
+
+ double dblLsup = dsqrts(getOverflowThreshold())/8.0;
+ double dblLinf = 4.0 * dsqrts(getUnderflowThreshold());
+ double dblEpsm = dsqrts(getRelativeMachinePrecision());
+
+ double dblAbsReal = dabss(zreals(z));
+ double dblAbsImg = dabss(zimags(z));
+ double dblSignReal = localSign(zreals(z));
+ double dblSignImg = localSign(zimags(z));
+
+ double dblR = 0, dblS = 0, dblA = 0, dblB = 0;
+
+ double dblTemp = 0;
+
+ double _pdblReal = 0;
+ double _pdblImg = 0;
+
+ if( min(dblAbsReal, dblAbsImg) > dblLinf && max(dblAbsReal, dblAbsImg) <= dblLsup)
+ {/* we are in the safe region */
+ dblR = dsqrts( (dblAbsReal + 1 )*(dblAbsReal + 1 ) + dblAbsImg*dblAbsImg);
+ dblS = dsqrts( (dblAbsReal - 1 )*(dblAbsReal - 1 ) + dblAbsImg*dblAbsImg);
+ dblA = 0.5 * ( dblR + dblS );
+ dblB = dblAbsReal / dblA;
+
+
+ /* compute the real part */
+ if(dblB <= sdblBcross)
+ _pdblReal = dacoss(dblB);
+ else if( dblAbsReal <= 1)
+ _pdblReal = datans(dsqrts(0.5 * (dblA + dblAbsReal) * (dblAbsImg*dblAbsImg / (dblR + (dblAbsReal + 1)) + (dblS + (1 - dblAbsReal)))) / dblAbsReal);
+ else
+ _pdblReal = datans((dblAbsImg * dsqrts(0.5 * ((dblA + dblAbsReal) / (dblR + (dblAbsReal + 1)) + (dblA + dblAbsReal) / (dblS + (dblAbsReal - 1))))) / dblAbsReal);
+
+ /* compute the imaginary part */
+ if(dblA <= sdblAcross)
+ {
+ double dblImg1 = 0;
+
+ if(dblAbsReal < 1)
+ /* Am1 = 0.5d0*((y**2)/(R+(x+1.d0))+(y**2)/(S+(1.d0-x))) */
+ dblImg1 = 0.5 * (dblAbsImg*dblAbsImg / (dblR + (dblAbsReal + 1)) + dblAbsImg*dblAbsImg / (dblS + (1 - dblAbsReal)));
+ else
+ /* Am1 = 0.5d0*((y**2)/(R+(x+1.d0))+(S+(x-1.d0))) */
+ dblImg1 = 0.5 * (dblAbsImg*dblAbsImg / (dblR + (dblAbsReal + 1)) + (dblS + (dblAbsReal - 1)));
+ /* ai = logp1(Am1 + sqrt(Am1*(A+1.d0))) */
+ dblTemp = dblImg1 + dsqrts(dblImg1 *( dblA + 1));
+ _pdblImg = dlog1ps(dblTemp);
+ }
+ else
+ /* ai = log(A + sqrt(A**2 - 1.d0)) */
+ _pdblImg = dlogs(dblA + dsqrts(dblA*dblA - 1));
+ }
+ else
+ {/* evaluation in the special regions ... */
+ if(dblAbsImg <= dblEpsm * dabss(dblAbsReal - 1))
+ {
+ if(dblAbsReal < 1)
+ {
+ _pdblReal = dacoss(dblAbsReal);
+ _pdblImg = dblAbsImg / dsqrts((1 + dblAbsReal) * (1 - dblAbsReal));
+ }
+ else
+ {
+ _pdblReal = 0;
+ if(dblAbsReal <= dblLsup)
+ {
+ dblTemp = (dblAbsReal - 1) + dsqrts((dblAbsReal - 1) * (dblAbsReal + 1));
+ _pdblImg = dlog1ps(dblTemp);
+ }
+ else
+ _pdblImg = sdblLn2 + dlogs(dblAbsReal);
+ }
+ }
+ else if(dblAbsImg < dblLinf)
+ {
+ _pdblReal = dsqrts(dblAbsImg);
+ _pdblImg = _pdblReal;
+ }
+ else if((dblEpsm * dblAbsImg - 1 >= dblAbsReal))
+ {
+ _pdblReal = sdblPi_2;
+ _pdblImg = sdblLn2 + dlogs(dblAbsImg);
+ }
+ else if(dblAbsReal > 1)
+ {
+ _pdblReal = datans(dblAbsImg / dblAbsReal);
+ dblTemp = (dblAbsReal / dblAbsImg)*(dblAbsReal / dblAbsImg);
+ _pdblImg = sdblLn2 + dlogs(dblAbsImg) + 0.5 * dlog1ps(dblTemp);
+ }
+ else
+ {
+ double dblTemp2 = dsqrts(1 + dblAbsImg*dblAbsImg);
+ _pdblReal = sdblPi_2;
+ dblTemp = 2 * dblAbsImg * (dblAbsImg + dblTemp2);
+ _pdblImg = 0.5 * dlog1ps(dblTemp);
+ }
+ }
+ if(dblSignReal < 0)
+ _pdblReal = sdblPi - _pdblReal;
+
+ if(dblAbsImg != 0 || dblSignReal < 0)
+ _pdblImg = - dblSignImg * _pdblImg;
+
+ return DoubleComplex(_pdblReal, _pdblImg);
+}
generated by cgit (git 2.34.1) at 2025-03-12 18:43:08 +0000