/*iRightDivisionRealMatrixByComplexMatrix*/
int iRightDivisionRealMatrixByComplexMatrix(
double *_pdblReal1, int _iInc1,
double *_pdblReal2, double *_pdblImg2, int _iInc2,
double *_pdblRealOut, double *_pdblImgOut, int _iIncOut, int _iSize)
{
int iErr = 0;
int iIndex = 0; //Main loop index
int iIndex1 = 0; //Loop index on left operand
int iIndex2 = 0; //Loop index on right operand
int iIndexOut = 0; //Lopp index on result matrix
if (_iInc2 == 0)
{
if ((getieee() == 0) && (dabss(_pdblReal2[iIndex2]) + dabss(_pdblImg2[iIndex2]) == 0))
{
return 3;
}
}
for (iIndex = 0 ; iIndex < _iSize ; iIndex++)
{
iErr = iRightDivisionRealByComplex(_pdblReal1[iIndex1], _pdblReal2[iIndex2], _pdblImg2[iIndex2], &_pdblRealOut[iIndexOut], &_pdblImgOut[iIndexOut]);
iIndexOut += _iIncOut;
iIndex1 += _iInc1;
iIndex2 += _iInc2;
}
return iErr;
}
/*iRightDivisionComplexByComplex*/
int iRightDivisionComplexByComplex(
double _dblReal1, double _dblImg1,
double _dblReal2, double _dblImg2,
double *_pdblRealOut, double *_pdblImgOut)
{
int iErr = 0;
if (_dblImg2 == 0)
{
if (_dblReal2 == 0)
{
//got NaN + i NaN
iErr = 10;
*_pdblRealOut = _dblImg2 / _dblReal2;
*_pdblImgOut = *_pdblRealOut;
}
else
{
*_pdblRealOut = _dblReal1 / _dblReal2;
*_pdblImgOut = _dblImg1 / _dblReal2;
}
}
else if (_dblReal2 == 0)
{
*_pdblRealOut = _dblImg1 / _dblImg2;
*_pdblImgOut = (-_dblReal1) / _dblImg2;
}
else
{
//Generic division algorithm
if (dabss(_dblReal2) >= dabss(_dblImg2))
{
double dblRatio2 = _dblImg2 / _dblReal2;
double dblSum = _dblReal2 + dblRatio2 * _dblImg2;
*_pdblRealOut = (_dblReal1 + _dblImg1 * dblRatio2) / dblSum;
*_pdblImgOut = (_dblImg1 - _dblReal1 * dblRatio2) / dblSum;
}
else
{
double dblRatio2 = _dblReal2 / _dblImg2;
double dblSum = _dblImg2 + dblRatio2 * _dblReal2;
*_pdblRealOut = (_dblReal1 * dblRatio2 + _dblImg1) / dblSum;
*_pdblImgOut = (_dblImg1 * dblRatio2 - _dblReal1) / dblSum;
}
}
return iErr;
}
/*wwpowe*/
int iPowerComplexScalarByComplexScalar(
double _dblReal1, double _dblImg1,
double _dblReal2, double _dblImg2,
double* _pdblRealOut, double* _pdblImgOut)
{
if (_dblImg2 == 0)
{
//C ^ R
iPowerComplexScalarByRealScalar(
_dblReal1, _dblImg1,
_dblReal2,
_pdblRealOut, _pdblImgOut);
}
else
{
//C ^ C
if (dabss(_dblReal1) + dabss(_dblImg1) != 0)
{
// ! 0 ^ C
double dblRealTemp = 0;
double dblImgTemp = 0;
wlog(_dblReal1, _dblImg1, &dblRealTemp, &dblImgTemp);
C2F(wmul)(&dblRealTemp, &dblImgTemp, &_dblReal2, &_dblImg2, &dblRealTemp, &dblImgTemp);
dblRealTemp = dexps(dblRealTemp);
*_pdblRealOut = dblRealTemp * dcoss(dblImgTemp);
*_pdblImgOut = dblRealTemp * dsins(dblImgTemp);
}
else
{
// 0 ^ C
//FIXME : ieee
//generate +Inf
double dblZero = 0.0;
*_pdblRealOut = 1.0 / (dblZero);
*_pdblImgOut = 0;
}
}
return 0;
}
/*iRightDivisionRealByComplex*/
int iRightDivisionRealByComplex(
double _dblReal1,
double _dblReal2, double _dblImg2,
double *_pdblRealOut, double *_pdblImgOut)
{
int iErr = 0;
if (_dblImg2 == 0)
{
*_pdblRealOut = _dblReal1 / _dblReal2;
*_pdblImgOut = 0;
}
else if (_dblReal2 == 0)
{
*_pdblRealOut = 0;
*_pdblImgOut = -_dblReal1 / _dblImg2;
}
else
{
double dblAbsSum = dabss(_dblReal2) + dabss(_dblImg2);
if (dblAbsSum == 0)
{
iErr = 10;
*_pdblRealOut = _dblReal1 / dblAbsSum;
*_pdblImgOut = 0;
}
else
{
double dblReal1Sum = _dblReal1 / dblAbsSum;
double dblReal2Sum = _dblReal2 / dblAbsSum;
double dblImg2Sum = _dblImg2 / dblAbsSum;
double dblSum = pow(dblReal2Sum, 2) + pow(dblImg2Sum, 2);
*_pdblRealOut = (dblReal1Sum * dblReal2Sum) / dblSum;
*_pdblImgOut = (-dblReal1Sum * dblImg2Sum) / dblSum;
}
}
return iErr;
}
/*wdpowe*/
int iPowerComplexScalarByRealScalar(
double _dblReal1, double _dblImg1,
double _dblReal2,
double* _pdblRealOut, double* _pdblImgOut)
{
if ((int)_dblReal2 == _dblReal2)
{
//C ^ Z
if (_dblReal2 == 0)
{
//C ^ 0
*_pdblRealOut = 1;
*_pdblImgOut = 0;
}
else if (_dblReal2 < 0)
{
//C ^ Z*-
if (dabss(_dblReal1) + dabss(_dblImg1) != 0) //_dblReal1 != 0 || _dblImg1 != 0 ?
{
int i = 0;
double dblOne = 1;
double dblZero = 0;
double dblRealTemp = 0;
double dblImgTemp = 0;
C2F(wdiv)(&dblOne, &dblZero, &_dblReal1, &_dblImg1, _pdblRealOut, _pdblImgOut);
dblRealTemp = *_pdblRealOut;
dblImgTemp = *_pdblImgOut;
for (i = 2 ; i <= dabss(_dblReal2) ; i++)
{
C2F(wmul)(&dblRealTemp, &dblImgTemp, _pdblRealOut, _pdblImgOut, _pdblRealOut, _pdblImgOut);
}
}
else
{
//FIXME : ieee
//generate +Inf
double dblZero = 0.0;
*_pdblRealOut = 1.0 / (dblZero);
*_pdblImgOut = 0;
}
}
else
{
//C ^ Z*+
int i = 0;
double dblRealTemp = 0;
double dblImgTemp = 0;
*_pdblRealOut = _dblReal1;
*_pdblImgOut = _dblImg1;
dblRealTemp = *_pdblRealOut;
dblImgTemp = *_pdblImgOut;
for (i = 2 ; i <= dabss(_dblReal2) ; i++)
{
C2F(wmul)(&dblRealTemp, &dblImgTemp, _pdblRealOut, _pdblImgOut, _pdblRealOut, _pdblImgOut);
}
}
}
else
{
if (dabss(_dblReal1) + dabss(_dblImg1) != 0)
{
//C ^ R
double dblRealTemp = 0;
double dblImgTemp = 0;
wlog(_dblReal1, _dblImg1, &dblRealTemp, &dblImgTemp);
dblRealTemp = dexps(dblRealTemp * _dblReal2);
dblImgTemp = dblImgTemp * _dblReal2;
*_pdblRealOut = dblRealTemp * dcoss(dblImgTemp);
*_pdblImgOut = dblRealTemp * dsins(dblImgTemp);
}
else
{
if (_dblReal2 > 0)
{
//0 ^ R*+
*_pdblRealOut = 0;
*_pdblImgOut = 0;
}
else if (_dblReal2 < 0)
{
//0 ^ R*-
//FIXME : ieee
//generate +Inf
double dblZero = 0.0;
*_pdblRealOut = 1.0 / (dblZero);
*_pdblImgOut = 0;
}
else
{
//0 ^ 0
*_pdblRealOut = 1;
*_pdblImgOut = 0;
}
}
}
return 0;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_abs(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
if (in.size() != 1)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "abs", 1);
return types::Function::Error;
}
if (_iRetCount > 1)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), "abs", 1);
return types::Function::Error;
}
switch (in[0]->getType())
{
case types::InternalType::ScilabDouble:
{
api_scilab::Double* pDblIn = api_scilab::getAsDouble(in[0]);
api_scilab::Double* pDblOut = new api_scilab::Double(pDblIn->getDims(), pDblIn->getDimsArray());
double* pdblInR = pDblIn->get();
double* pdblInI = pDblIn->getImg();
double* pdblOut = pDblOut->get();
int size = pDblIn->getSize();
if (pDblIn->isComplex())
{
for (int i = 0; i < size; i++)
{
if (ISNAN(pdblInR[i]))
{
pdblOut[i] = pdblInR[i];
}
else if (ISNAN(pdblInI[i]))
{
pdblOut[i] = pdblInI[i];
}
else
{
pdblOut[i] = dabsz(pdblInR[i], pdblInI[i]);
}
}
}
else
{
for (int i = 0; i < size; i++)
{
if (ISNAN(pdblInR[i]))
{
pdblOut[i] = pdblInR[i];
}
else
{
pdblOut[i] = std::fabs(pdblInR[i]);
}
}
}
out.push_back(api_scilab::getReturnVariable(pDblOut));
delete pDblOut;
delete pDblIn;
break;
}
case types::InternalType::ScilabPolynom:
{
types::Polynom* pPolyIn = in[0]->getAs<types::Polynom>();
types::Polynom* pPolyOut = new types::Polynom(pPolyIn->getVariableName(), pPolyIn->getDims(), pPolyIn->getDimsArray());
double* data = NULL;
if (pPolyIn->isComplex())
{
for (int i = 0; i < pPolyIn->getSize(); i++)
{
int rank = pPolyIn->get(i)->getRank();
types::SinglePoly* pSP = new types::SinglePoly(&data, rank);
for (int j = 0; j < rank + 1; j++)
{
data[j] = dabsz(pPolyIn->get(i)->get()[j], pPolyIn->get(i)->getImg()[j]);
}
pPolyOut->set(i, pSP);
delete pSP;
pSP = NULL;
}
}
else
{
for (int i = 0; i < pPolyIn->getSize(); i++)
{
int rank = pPolyIn->get(i)->getRank();
types::SinglePoly* pSP = new types::SinglePoly(&data, rank);
for (int j = 0; j < rank + 1; j++)
{
data[j] = dabss(pPolyIn->get(i)->get()[j]);
}
pPolyOut->set(i, pSP);
delete pSP;
pSP = NULL;
}
}
out.push_back(pPolyOut);
break;
}
case types::InternalType::ScilabInt8:
{
out.push_back(absInt(in[0]->getAs<types::Int8>()));
break;
}
case types::InternalType::ScilabInt16:
{
out.push_back(absInt(in[0]->getAs<types::Int16>()));
break;
}
case types::InternalType::ScilabInt32:
{
out.push_back(absInt(in[0]->getAs<types::Int32>()));
break;
}
case types::InternalType::ScilabInt64:
{
out.push_back(absInt(in[0]->getAs<types::Int64>()));
break;
}
case types::InternalType::ScilabUInt8:
case types::InternalType::ScilabUInt16:
case types::InternalType::ScilabUInt32:
case types::InternalType::ScilabUInt64:
{
out.push_back(in[0]);
break;
}
default:
{
std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_abs";
return Overload::call(wstFuncName, in, _iRetCount, out);
}
}
return types::Function::OK;
}
void dabsa(double *in, int size, double* out){
int i = 0;
for (i = 0; i < size; ++i) {
out[i] = dabss(in[i]);
}
}
floatComplex catans(floatComplex z) {
static float sSlim = 0.2f;
/* .
** / \ WARNING : this algorithm was based on double precision
** / ! \ using float truncate the value to 0.
** `----'
**
** static float sAlim = 1E-150f;
*/
static float sAlim = 0.0f;
static float sTol = 0.3f;
static float sLn2 = 0.6931471805599453094172321f;
float RMax = (float) getOverflowThreshold();
float Pi_2 = 2.0f * satans(1);
float _inReal = creals(z);
float _inImg = cimags(z);
float _outReal = 0;
float _outImg = 0;
/* Temporary variables */
float R2 = 0;
float S = 0;
if(_inImg == 0)
{
_outReal = satans(_inReal);
_outImg = 0;
}
else
{
R2 = _inReal * _inReal + _inImg * _inImg; /* Oo */
if(R2 > RMax)
{
if( dabss(_inImg) > RMax)
S = 0;
else
S = 1.0f / (((0.5f * _inReal) / _inImg) * _inReal + 0.5f * _inImg );
}
else
S = (2 * _inImg) / (1+R2);
if(dabss(S) < sSlim)
{
/*
s is small: |s| < SLIM <=> |z| outside the following disks:
D+ = D(center = [0; 1/slim], radius = sqrt(1/slim**2 - 1)) if b > 0
D- = D(center = [0; -1/slim], radius = sqrt(1/slim**2 - 1)) if b < 0
use the special evaluation of log((1+s)/(1-s)) (5)
*/
_outImg = slnp1m1s(S) * 0.25f;
}
else
{
if(sabss(S) == 1 && sabss(_inReal) <= sAlim)
{
/* |s| >= SLIM => |z| is inside D+ or D- */
_outImg = _sign(0.5f,_inImg) * ( sLn2 - logf(sabss(_inReal)));
}
else
{
_outImg = 0.25f * logf((powf(_inReal,2) + powf((_inImg + 1.0f),2)) / (powf(_inReal,2) + powf((_inImg - 1.0f),2)));
}
}
if(_inReal == 0)
{/* z is purely imaginary */
if( dabss(_inImg) > 1)
{/* got sign(b) * pi/2 */
_outReal = _sign(1, _inImg) * Pi_2;
}
else if( dabss(_inImg) == 1)
{/* got a Nan with 0/0 */
_outReal = (_inReal - _inReal) / (_inReal - _inReal); /* Oo */
}
else
_outReal = 0;
}
else if(R2 > RMax)
{/* _outImg is necessarily very near sign(a)* pi/2 */
_outReal = _sign(1, _inReal) * Pi_2;
}
else if(sabss(1 - R2) + sabss(_inReal) <= sTol)
{/* |b| is very near 1 (and a is near 0) some cancellation occur in the (next) generic formula */
_outReal = 0.5f * atan2f(2.0f * _inReal, (1.0f - _inImg) * (1.0f + _inImg) - powf(_inReal,2.0f));
}
else
_outReal = 0.5f * atan2f(2.0f * _inReal, 1.0f - R2);
}
return FloatComplex(_outReal, _outImg);
}
floatComplex csqrts(floatComplex in) {
float RMax = (float) getOverflowThreshold();
float BRMin = 2.0f * (float) getUnderflowThreshold();
float RealIn = creals(in);
float ImgIn = cimags(in);
float RealOut = 0;
float ImgOut = 0;
if(RealIn == 0)
{/* pure imaginary case */
if(dabss(ImgIn >= BRMin))
RealOut = ssqrts(0.5f * sabss(ImgIn));
else
RealOut = ssqrts(sabss(ImgIn)) * ssqrts(0.5);
ImgOut = _sign(1, ImgIn) * RealOut;
}
else if( sabss(RealIn) <= RMax && sabss(ImgIn) <= RMax)
{/* standard case : a (not zero) and b are finite */
float Temp = ssqrts(2.0f * (sabss(RealIn) + spythags(RealIn, ImgIn)));
/* overflow test */
if(Temp > RMax)
{/* handle (spurious) overflow by scaling a and b */
float RealTemp = RealIn / 16.0f;
float ImgTemp = ImgIn / 16.0f;
Temp = ssqrts(2.0f * (sabss(RealIn) + spythags(RealIn, ImgTemp)));
if(RealTemp >= 0)
{
RealOut = 2 * Temp;
ImgOut = 4 * ImgTemp / Temp;
}
else
{
RealOut = 4 * sabss(ImgIn) / Temp;
ImgOut = _sign(2, ImgIn) * Temp;
}
}
else if(RealIn >= 0) /* classic switch to get the stable formulas */
{
RealOut = 0.5f * Temp;
ImgOut = ImgIn / Temp;
}
else
{
RealOut = sabss(ImgIn) / Temp;
ImgOut = (_sign(0.5f, ImgIn)) * Temp;
}
}
else
{
/*
//Here we treat the special cases where a and b are +- 00 or NaN.
//The following is the treatment recommended by the C99 standard
//with the simplification of returning NaN + i NaN if the
//the real part or the imaginary part is NaN (C99 recommends
//something more complicated)
*/
if(isnan(RealIn) == 1 || isnan(ImgIn) == 1)
{/* got NaN + i NaN */
RealOut = RealIn + ImgIn;
ImgOut = RealOut;
}
else if( dabss(ImgIn) > RMax)
{/* case a +- i oo -> result must be +oo +- i oo for all a (finite or not) */
RealOut = sabss(ImgIn);
ImgOut = ImgIn;
}
else if(RealIn < -RMax)
{/* here a is -Inf and b is finite */
RealOut = 0;
ImgOut = _sign(1, ImgIn) * sabss(RealIn);
}
else
{/* here a is +Inf and b is finite */
RealOut = RealIn;
ImgOut = 0;
}
}
return FloatComplex(RealOut, ImgOut);
}
/*
* PURPOSE
* computes sqrt(a^2 + b^2) with accuracy and
* without spurious underflow / overflow problems
*
* MOTIVATION
* This work was motivated by the fact that the original Scilab
* PYTHAG, which implements Moler and Morrison's algorithm is slow.
* Some tests showed that the Kahan's algorithm, is superior in
* precision and moreover faster than the original PYTHAG. The speed
* gain partly comes from not calling DLAMCH.
*
* REFERENCE
* This is a Fortran-77 translation of an algorithm by William Kahan,
* which appears in his article "Branch cuts for complex elementary
* functions, or much ado about nothing's sign bit",
* Editors: Iserles, A. and Powell, M. J. D.
* in "States of the Art in Numerical Analysis"
* Oxford, Clarendon Press, 1987
* ISBN 0-19-853614-3
** AUTHOR
* Bruno Pincon <*****@*****.**>,
* Thanks to Lydia van Dijk <*****@*****.**>
*/
ELEMENTARY_FUNCTIONS_IMPEXP double dpythags(double _dblVal1, double _dblVal2)
{
double dblSqrt2 = 1.41421356237309504;
double dblSqrt2p1 = 2.41421356237309504;
double dblEsp = 1.25371671790502177E-16;
double dblRMax = getOverflowThreshold();
double dblAbs1 = 0;
double dblAbs2 = 0;
double dblTemp = 0;
if (ISNAN(_dblVal1) == 1)
{
return _dblVal2;
}
if (ISNAN(_dblVal2) == 1)
{
return _dblVal1;
}
dblAbs1 = dabss(_dblVal1);
dblAbs2 = dabss(_dblVal2);
//Order x and y such that 0 <= y <= x
if (dblAbs1 < dblAbs2)
{
dblTemp = dblAbs1;
dblAbs1 = dblAbs2;
dblAbs2 = dblTemp;
}
//Test for overflowing x
if ( dblAbs1 >= dblRMax)
{
return dblAbs1;
}
//Handle generic case
dblTemp = dblAbs1 - dblAbs2;
if (dblTemp != dblAbs1)
{
double dblS = 0;
if (dblTemp > dblAbs2)
{
dblS = dblAbs1 / dblAbs2;
dblS += dsqrts(1 + dblS * dblS);
}
else
{
dblS = dblTemp / dblAbs2;
dblTemp = (2 + dblS) * dblS;
dblS = ((dblEsp + dblTemp / (dblSqrt2 + dsqrts(2 + dblTemp))) + dblS) + dblSqrt2p1;
}
return dblAbs1 + dblAbs2 / dblS;
}
else
{
return dblAbs1;
}
}
double dcoshs(double x) {
double y = dexps(dabss(x));
return (0.5 * (y + 1.0/y));
}
