/* * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab * Copyright (C) 2008-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 * */ /* * 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 * Thanks to Tom Fairgrieve */ #include "lapack.h" #include "asin.h" #include "atan.h" #include "sqrt.h" #include "abs.h" #include "log.h" #include "log1p.h" #include "min.h" #include "max.h" floatComplex casins(floatComplex z) { static float sdblPi_2 = 1.5707963267948966192313216f; static float sdblLn2 = 0.6931471805599453094172321f; static float sdblAcross = 1.5f; static float sdblBcross = 0.6417f; float dblLsup = ssqrts((float) getOverflowThreshold())/ 8.0f; float dblLinf = 4.0f * ssqrts((float) getUnderflowThreshold()); float dblEpsm = ssqrts((float) getRelativeMachinePrecision()); float _dblReal = creals(z); float _dblImg = cimags(z); float dblAbsReal = sabss(_dblReal); float dblAbsImg = sabss(_dblImg); float iSignReal = _dblReal < 0 ? -1.0f : 1.0f; float iSignImg = _dblImg < 0 ? -1.0f : 1.0f; float dblR = 0, dblS = 0, dblA = 0, dblB = 0; float dblTemp = 0; float _pdblReal = 0; float _pdblImg = 0; if( min(dblAbsReal, dblAbsImg) > dblLinf && max(dblAbsReal, dblAbsImg) <= dblLsup) { /* we are in the safe region */ dblR = ssqrts( (dblAbsReal + 1) * (dblAbsReal + 1) + dblAbsImg * dblAbsImg); dblS = ssqrts( (dblAbsReal - 1) * (dblAbsReal - 1) + dblAbsImg * dblAbsImg); dblA = (float) 0.5 * ( dblR + dblS ); dblB = dblAbsReal / dblA; /* compute the real part */ if(dblB <= sdblBcross) _pdblReal = sasins(dblB); else if( dblAbsReal <= 1) _pdblReal = satans(dblAbsReal / ssqrts( 0.5f * (dblA + dblAbsReal) * ( (dblAbsImg * dblAbsImg) / (dblR + (dblAbsReal + 1)) + (dblS + (1 - dblAbsReal))))); else _pdblReal = satans(dblAbsReal / (dblAbsImg * ssqrts( 0.5f * ((dblA + dblAbsReal) / (dblR + (dblAbsReal + 1)) + (dblA + dblAbsReal) / (dblS + (dblAbsReal-1)))))); /* compute the imaginary part */ if(dblA <= sdblAcross) { float dblImg1 = 0; if(dblAbsReal < 1) /* Am1 = 0.5d0*((y**2)/(R+(x+1.d0))+(y**2)/(S+(1.d0-x))) */ dblImg1 = 0.5f * (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.5f * (dblAbsImg * dblAbsImg / (dblR + (dblAbsReal + 1)) + (dblS + (dblAbsReal - 1))); /* ai = logp1(Am1 + sqrt(Am1*(A+1.d0))) */ dblTemp = dblImg1 + ssqrts(dblImg1 * (dblA + 1)); _pdblImg = slog1ps(dblTemp); } else /* ai = log(A + sqrt(A**2 - 1.d0)) */ _pdblImg = slogs(dblA + ssqrts(dblA * dblA - (float) 1.0)); } else { /* evaluation in the special regions ... */ if(dblAbsImg <= dblEpsm * dabss(dblAbsReal - 1)) { if(dblAbsReal < 1) { _pdblReal = sasins(dblAbsReal); _pdblImg = dblAbsImg / ssqrts((1 + dblAbsReal) * (1 - dblAbsReal)); } else { _pdblReal = sdblPi_2; if(dblAbsReal <= dblLsup) { dblTemp = (dblAbsReal - 1) + ssqrts((dblAbsReal - 1) * (dblAbsReal + 1)); _pdblImg = slog1ps(dblTemp); } else _pdblImg = sdblLn2 + slogs(dblAbsReal); } } else if(dblAbsImg < dblLinf) { _pdblReal = sdblPi_2 - ssqrts(dblAbsImg); _pdblImg = ssqrts(dblAbsImg); } else if((dblEpsm * dblAbsImg - 1 >= dblAbsReal)) { _pdblReal = dblAbsReal * dblAbsImg; _pdblImg = sdblLn2 + slogs(dblAbsReal); } else if(dblAbsReal > 1) { _pdblReal = satans(dblAbsReal / dblAbsImg); dblTemp = (dblAbsReal / dblAbsImg) * (dblAbsReal / dblAbsImg); _pdblImg = sdblLn2 + slogs(dblAbsReal) + 0.5f * slog1ps(dblTemp); } else { float dblTemp2 = ssqrts(1 + dblAbsImg * dblAbsImg); _pdblReal = dblAbsReal / dblTemp2; dblTemp = 2.0f * dblAbsImg * (dblAbsImg + dblTemp2); _pdblImg = 0.5f * slog1ps(dblTemp); } } _pdblReal *= iSignReal; _pdblImg *= iSignImg; return (FloatComplex(_pdblReal, _pdblImg)); }