//Square Matrix ^ Scalar
int iPowerRealSquareMatrixByRealScalar(
double* _pdblReal1, int _iRows1, int _iCols1,
double _dblReal2,
double* _pdblRealOut, double* _pdblImgOut, int *_iComplex)
{
int iInv = 0;
int iExpRef = (int)_dblReal2;
if (iExpRef < 0)
{
//call matrix invetion
iInv = 1;
iExpRef = -iExpRef;
}
if ((int)_dblReal2 == _dblReal2) //integer exponent
{
if (iExpRef == 1)
{
int iSize = _iRows1 * _iCols1;
int iOne = 1;
C2F(dcopy)(&iSize, _pdblReal1, &iOne, _pdblRealOut, &iOne);
}
else if (iExpRef == 0)
{
int iSize = _iRows1 * _iCols1;
int iOne = 1;
double dblOne = 1;
double dblZero = 0;
int iRowp1 = _iRows1 + 1;
if (C2F(dasum)(&iSize, _pdblReal1, &iOne) == 0)
{
//Invalid exponent
return 1;
}
C2F(dset)(&iSize, &dblZero, _pdblRealOut, &iOne);
C2F(dset)(&_iRows1, &dblOne, _pdblRealOut, &iRowp1);
}
else
{
int iExp = 0;
int iRow = 0;
int iCol = 0;
int iSize = _iRows1 * _iCols1;
int iOne = 1;
/*temporary work space*/
double *pWork2 = (double*)malloc(sizeof(double) * iSize);
double *pWork3 = (double*)malloc(sizeof(double) * _iRows1);
C2F(dcopy)(&iSize, _pdblReal1, &iOne, _pdblRealOut, &iOne);
C2F(dcopy)(&iSize, _pdblReal1, &iOne, pWork2, &iOne);
//l1 -> l2
for (iExp = 1 ; iExp < iExpRef ; iExp++)
{
for (iCol = 0 ; iCol < _iCols1 ; iCol++)
{
double *pPtr = _pdblRealOut + iCol * _iCols1;
C2F(dcopy)(&_iRows1, pPtr, &iOne, pWork3, &iOne);
//ls -> l3
for (iRow = 0 ; iRow < _iRows1 ; iRow++)
{
int iOffset = iRow + iCol * _iRows1;
pPtr = pWork2 + iRow;
_pdblRealOut[iOffset] = C2F(ddot)(&_iRows1, pPtr, &_iRows1, pWork3, &iOne);
}//for
}//for
}//for
free(pWork2);
free(pWork3);
}//if(iExpRef != 1 && != 0)
}
else
{
//floating point exponent
return -1; // manage by overload
}
if (iInv)
{
double dblRcond;
int ret = iInvertMatrixM(_iRows1, _iCols1, _pdblRealOut, 0/* is complex*/, &dblRcond);
if (ret == -1)
{
if (getWarningMode())
{
sciprint(_("Warning :\n"));
sciprint(_("matrix is close to singular or badly scaled. rcond = %1.4E\n"), dblRcond);
sciprint(_("computing least squares solution. (see lsq).\n"));
}
}
}
*_iComplex = 0;
return 0;
}
int iPowerComplexSquareMatrixByRealScalar(
double* _pdblReal1, double* _pdblImg1, int _iRows1, int _iCols1,
double _dblReal2,
double* _pdblRealOut, double* _pdblImgOut)
{
int iInv = 0;
int iExpRef = (int)_dblReal2;
if (iExpRef < 0)
{
//call matrix invetion
iInv = 1;
iExpRef = -iExpRef;
}
if ((int)_dblReal2 == _dblReal2) //integer exponent
{
if (iExpRef == 1)
{
int iSize = _iRows1 * _iCols1;
int iOne = 1;
C2F(dcopy)(&iSize, _pdblReal1, &iOne, _pdblRealOut, &iOne);
C2F(dcopy)(&iSize, _pdblImg1, &iOne, _pdblImgOut, &iOne);
}
else if (iExpRef == 0)
{
int iSize = _iRows1 * _iCols1;
int iOne = 1;
double dblOne = 1;
double dblZero = 0;
int iRowp1 = _iRows1 + 1;
if (C2F(dasum)(&iSize, _pdblReal1, &iOne) == 0)
{
//Invalid exponent
return 1;
}
C2F(dset)(&iSize, &dblZero, _pdblRealOut, &iOne);
C2F(dset)(&_iRows1, &dblOne, _pdblRealOut, &iRowp1);
}
else
{
int iSize = _iRows1 * _iCols1;
int iExp = 0;
int iRow = 0;
int iCol = 0;
int iOne = 1;
//temporary work space
double *pWorkReal2 = (double*)malloc(sizeof(double) * iSize);
double *pWorkImg2 = (double*)malloc(sizeof(double) * iSize);
double *pWorkReal3 = (double*)malloc(sizeof(double) * _iRows1);
double *pWorkImg3 = (double*)malloc(sizeof(double) * _iRows1);
//copy In to Out
C2F(dcopy)(&iSize, _pdblReal1, &iOne, _pdblRealOut, &iOne);
C2F(dcopy)(&iSize, _pdblImg1, &iOne, _pdblImgOut, &iOne);
C2F(dcopy)(&iSize, _pdblReal1, &iOne, pWorkReal2, &iOne);
C2F(dcopy)(&iSize, _pdblImg1, &iOne, pWorkImg2, &iOne);
//l1 -> l2
for (iExp = 1 ; iExp < iExpRef ; iExp++)
{
for (iCol = 0 ; iCol < _iCols1 ; iCol++)
{
double *pPtrReal = _pdblRealOut + iCol * _iCols1;
double *pPtrImg = _pdblImgOut + iCol * _iCols1;
C2F(dcopy)(&_iRows1, pPtrReal, &iOne, pWorkReal3, &iOne);
C2F(dcopy)(&_iRows1, pPtrImg, &iOne, pWorkImg3, &iOne);
//ls -> l3
for (iRow = 0 ; iRow < _iRows1 ; iRow++)
{
int iOffset = iRow + iCol * _iRows1;
pPtrReal = pWorkReal2 + iRow;
pPtrImg = pWorkImg2 + iRow;
_pdblRealOut[iOffset] = C2F(ddot)(&_iRows1, pPtrReal, &_iRows1, pWorkReal3, &iOne)
- C2F(ddot)(&_iRows1, pPtrImg, &_iRows1, pWorkImg3, &iOne);
_pdblImgOut[iOffset] = C2F(ddot)(&_iRows1, pPtrReal, &_iRows1, pWorkImg3, &iOne)
+ C2F(ddot)(&_iRows1, pPtrImg, &_iRows1, pWorkReal3, &iOne);
}//for
}//for
}//for
free(pWorkReal2);
free(pWorkImg2);
free(pWorkReal3);
free(pWorkImg3);
}//if(iExpRef != 1 && != 0)
}
else
{
//floating point exponent
return -1; // manage by overload
}
if (iInv)
{
double dblRcond;
double* pData = (double*)oGetDoubleComplexFromPointer(_pdblRealOut, _pdblImgOut, _iRows1 * _iCols1);
int ret = iInvertMatrixM(_iRows1, _iCols1, pData, 1/* is complex*/, &dblRcond);
if (ret == -1)
{
if (getWarningMode())
{
sciprint(_("Warning :\n"));
sciprint(_("matrix is close to singular or badly scaled. rcond = %1.4E\n"), dblRcond);
sciprint(_("computing least squares solution. (see lsq).\n"));
}
}
vGetPointerFromDoubleComplex((doublecomplex*)pData, _iRows1 * _iCols1, _pdblRealOut, _pdblImgOut);
vFreeDoubleComplexFromPointer((doublecomplex*)pData);
}
return 0;
}
types::Function::ReturnValue sci_inv(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
types::Double* pDbl = NULL;
double* pData = NULL;
int ret = 0;
if (in.size() != 1)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "inv", 1);
return types::Function::Error;
}
if ((in[0]->isDouble() == false))
{
std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_inv";
return Overload::call(wstFuncName, in, _iRetCount, out);
}
pDbl = in[0]->getAs<types::Double>()->clone()->getAs<types::Double>(); // input data will be modified
if (pDbl->getRows() != pDbl->getCols())
{
Scierror(20, _("%s: Wrong type for argument %d: Square matrix expected.\n"), "inv", 1);
return types::Function::Error;
}
if (pDbl->getRows() == 0)
{
out.push_back(types::Double::Empty());
return types::Function::OK;
}
if (pDbl->isComplex())
{
/* c -> z */
pData = (double*)oGetDoubleComplexFromPointer( pDbl->getReal(), pDbl->getImg(), pDbl->getSize());
}
else
{
pData = pDbl->getReal();
}
if (pDbl->getCols() == -1)
{
pData[0] = 1. / pData[0];
}
else
{
double dblRcond;
ret = iInvertMatrixM(pDbl->getRows(), pDbl->getCols(), pData, pDbl->isComplex(), &dblRcond);
if (pDbl->isComplex())
{
/* z -> c */
vGetPointerFromDoubleComplex((doublecomplex*)pData, pDbl->getSize(), pDbl->getReal(), pDbl->getImg());
vFreeDoubleComplexFromPointer((doublecomplex*)pData);
}
if (ret == -1)
{
if (getWarningMode())
{
sciprint(_("Warning :\n"));
sciprint(_("matrix is close to singular or badly scaled. rcond = %1.4E\n"), dblRcond);
}
}
}
if (ret == 19)
{
Scierror(19, _("%s: Problem is singular.\n"), "inv");
return types::Function::Error;
}
out.push_back(pDbl);
return types::Function::OK;
}
