/*--------------------------------------------------------------------------*/
int sci_zneupd(char *fname, unsigned long fname_len)
{
SciErr sciErr;
int* piAddrpRVEC = NULL;
int* pRVEC = NULL;
int* piAddrpHOWMANY = NULL;
char* pHOWMANY = NULL;
int* piAddrpSELECT = NULL;
int* pSELECT = NULL;
int* piAddrpBMAT = NULL;
char* pBMAT = NULL;
int* piAddrpN = NULL;
int* pN = NULL;
int* piAddrpWHICH = NULL;
char* pWHICH = NULL;
int* piAddrpNEV = NULL;
int* pNEV = NULL;
int* piAddrpTOL = NULL;
double* pTOL = NULL;
int* piAddrpNCV = NULL;
int* pNCV = NULL;
int* piAddrpIPARAM = NULL;
int* pIPARAM = NULL;
int* piAddrpIPNTR = NULL;
int* pIPNTR = NULL;
int* piAddrpRWORK = NULL;
double* pRWORK = NULL;
int* piAddrpINFO = NULL;
int* pINFO = NULL;
int* piAddrpD = NULL;
doublecomplex* pD = NULL;
int* piAddrpZ = NULL;
doublecomplex* pZ = NULL;
int* piAddrpSIGMA = NULL;
doublecomplex* pSIGMA = NULL;
int* piAddrpWORKev = NULL;
doublecomplex* pWORKev = NULL;
int* piAddrpRESID = NULL;
doublecomplex* pRESID = NULL;
int* piAddrpWORKD = NULL;
doublecomplex* pV = NULL;
int* piAddrpV = NULL;
doublecomplex* pWORKD = NULL;
int* piAddrpWORKL = NULL;
doublecomplex* pWORKL = NULL;
int mRVEC, nRVEC;
int mHOWMANY, nHOWMANY;
int mSELECT, nSELECT;
int D, mD, nD;
int Z, mZ, nZ;
int mSIGMA, nSIGMA;
int mWORKev, nWORKev;
int mBMAT, nBMAT;
int mN, nN;
int mWHICH, nWHICH;
int mNEV, nNEV;
int mTOL, nTOL;
int RESID, mRESID, nRESID;
int mNCV, nNCV;
int mV, nV;
int IPARAM, mIPARAM, nIPARAM;
int IPNTR, mIPNTR, nIPNTR;
int WORKD, mWORKD, nWORKD;
int WORKL, mWORKL, nWORKL;
int RWORK, mRWORK, nRWORK;
int INFO, mINFO, nINFO;
int minlhs = 1, minrhs = 21, maxlhs = 9, maxrhs = 21;
int LDZ, LDV, LWORKL;
int sizeWORKL = 0;
CheckInputArgument(pvApiCtx, minrhs, maxrhs);
CheckOutputArgument(pvApiCtx, minlhs, maxlhs);
/* VARIABLE = NUMBER */
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrpRVEC);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpRVEC, &mRVEC, &nRVEC, &pRVEC);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 1);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddrpSELECT);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 3.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpSELECT, &mSELECT, &nSELECT, &pSELECT);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 3);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 4, &piAddrpD);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 4.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpD, &mD, &nD, &pD);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 4);
return 1;
}
D = 4;
sciErr = getVarAddressFromPosition(pvApiCtx, 5, &piAddrpZ);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 5.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpZ, &mZ, &nZ, &pZ);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 5);
return 1;
}
Z = 5;
sciErr = getVarAddressFromPosition(pvApiCtx, 6, &piAddrpSIGMA);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 6.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpSIGMA, &mSIGMA, &nSIGMA, &pSIGMA);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 6);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 7, &piAddrpWORKev);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 7.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpWORKev, &mWORKev, &nWORKev, &pWORKev);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 7);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 9, &piAddrpN);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 9.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpN, &mN, &nN, &pN);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 9);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 11, &piAddrpNEV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 11.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpNEV, &mNEV, &nNEV, &pNEV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 11);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 12, &piAddrpTOL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 12.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrpTOL, &mTOL, &nTOL, &pTOL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 12);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 13, &piAddrpRESID);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 13.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpRESID, &mRESID, &nRESID, &pRESID);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 13);
return 1;
}
RESID = 13;
sciErr = getVarAddressFromPosition(pvApiCtx, 14, &piAddrpNCV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 14.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpNCV, &mNCV, &nNCV, &pNCV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 14);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 15, &piAddrpV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 15.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpV, &mV, &nV, &pV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 15);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 16, &piAddrpIPARAM);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 16.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpIPARAM, &mIPARAM, &nIPARAM, &pIPARAM);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 16);
return 1;
}
IPARAM = 16;
sciErr = getVarAddressFromPosition(pvApiCtx, 17, &piAddrpIPNTR);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 17.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpIPNTR, &mIPNTR, &nIPNTR, &pIPNTR);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 17);
return 1;
}
IPNTR = 17;
sciErr = getVarAddressFromPosition(pvApiCtx, 18, &piAddrpWORKD);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 18.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpWORKD, &mWORKD, &nWORKD, &pWORKD);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 18);
return 1;
}
WORKD = 18;
sciErr = getVarAddressFromPosition(pvApiCtx, 19, &piAddrpWORKL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 19.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpWORKL, &mWORKL, &nWORKL, &pWORKL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 19);
return 1;
}
WORKL = 19;
sciErr = getVarAddressFromPosition(pvApiCtx, 20, &piAddrpRWORK);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 20.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrpRWORK, &mRWORK, &nRWORK, &pRWORK);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 20);
return 1;
}
RWORK = 20;
sciErr = getVarAddressFromPosition(pvApiCtx, 21, &piAddrpINFO);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 21.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpINFO, &mINFO, &nINFO, &pINFO);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 21);
return 1;
}
INFO = 21;
LWORKL = mWORKL * nWORKL;
LDV = Max(1, pN[0]);
LDZ = LDV;
/* Check some sizes */
if (mIPARAM*nIPARAM != 11)
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPARAM", 11);
return 1;
}
if (mIPNTR*nIPNTR != 14)
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPNTR", 14);
return 1;
}
if (mRESID*nRESID != pN[0])
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "RESID", pN[0]);
return 1;
}
if (mWORKD * nWORKD < 3 * pN[0])
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKD", 3 * pN[0]);
return 1;
}
if (mSELECT*nSELECT != pNCV[0])
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "SELECT", pNCV[0]);
return 1;
}
if (mD*nD != (pNEV[0] + 1))
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "D", pNEV[0] + 1);
return 1;
}
if ((mZ != pN[0]) || (nZ != pNEV[0]))
{
Scierror(999, _("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "Z", pN[0], pNEV[0]);
return 1;
}
if (mWORKev*nWORKev != 2 * pNCV[0])
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKev", 2 * pNCV[0]);
return 1;
}
if ((mV != pN[0]) || (nV != pNCV[0]))
{
Scierror(999, _("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "V", pN[0], pNCV[0]);
return 1;
}
sizeWORKL = 3 * pNCV[0] * pNCV[0] + 5 * pNCV[0];
if ((mWORKL * nWORKL < sizeWORKL))
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKL", sizeWORKL);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrpHOWMANY);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 2.
if (getAllocatedSingleString(pvApiCtx, piAddrpHOWMANY, &pHOWMANY))
{
Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 2);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 8, &piAddrpBMAT);
if (sciErr.iErr)
{
freeAllocatedSingleString(pHOWMANY);
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 8.
if (getAllocatedSingleString(pvApiCtx, piAddrpBMAT, &pBMAT))
{
freeAllocatedSingleString(pHOWMANY);
Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 8);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 10, &piAddrpWHICH);
if (sciErr.iErr)
{
freeAllocatedSingleString(pHOWMANY);
freeAllocatedSingleString(pBMAT);
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 10.
if (getAllocatedSingleString(pvApiCtx, piAddrpWHICH, &pWHICH))
{
freeAllocatedSingleString(pHOWMANY);
freeAllocatedSingleString(pBMAT);
Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 10);
return 1;
}
C2F(zneupd)(pRVEC, pHOWMANY, pSELECT, pD,
pZ, &LDZ, pSIGMA, pWORKev,
pBMAT, pN, pWHICH, pNEV,
pTOL, pRESID, pNCV, pV,
&LDV, pIPARAM, pIPNTR, pWORKD,
pWORKL, &LWORKL, pRWORK, pINFO);
freeAllocatedSingleString(pHOWMANY);
freeAllocatedSingleString(pBMAT);
freeAllocatedSingleString(pWHICH);
if (pINFO[0] < 0)
{
C2F(errorinfo)("zneupd", pINFO, 6L);
return 0;
}
AssignOutputVariable(pvApiCtx, 1) = D;
AssignOutputVariable(pvApiCtx, 2) = Z;
AssignOutputVariable(pvApiCtx, 3) = RESID;
AssignOutputVariable(pvApiCtx, 4) = IPARAM;
AssignOutputVariable(pvApiCtx, 5) = IPNTR;
AssignOutputVariable(pvApiCtx, 6) = WORKD;
AssignOutputVariable(pvApiCtx, 7) = WORKL;
AssignOutputVariable(pvApiCtx, 8) = RWORK;
AssignOutputVariable(pvApiCtx, 9) = INFO;
ReturnArguments(pvApiCtx);
return 0;
}
int sci_eigs(char *fname, void* pvApiCtx)
{
SciErr sciErr;
int *piAddressVarOne = NULL;
int iRowsOne = 0;
int iColsOne = 0;
double elemt1 = 0;
double elemt2 = 0;
double* Areal = NULL;
doublecomplex* Acplx = NULL;
int Asym = 1;
int Acomplex = 0;
int N = 0;
int *piAddressVarTwo = NULL;
int iTypeVarTwo = 0;
int iRowsTwo = 0;
int iColsTwo = 0;
double* Breal = NULL;
doublecomplex* Bcplx = NULL;
int Bcomplex = 0;
int matB = 0;
int *piAddressVarThree = NULL;
double dblNEV = 0;
int iNEV = 0;
int *piAddressVarFour = NULL;
int iTypeVarFour = 0;
int iRowsFour = 0;
int iColsFour = 0;
char* pstData = NULL;
doublecomplex SIGMA;
int *piAddressVarFive = NULL;
double dblMAXITER = 0;
int *piAddressVarSix = NULL;
double dblTOL = 0;
int *piAddressVarSeven = NULL;
int TypeVarSeven = 0;
int RowsSeven = 0;
int ColsSeven = 0;
double* dblNCV = NULL;
int *piAddressVarEight = NULL;
int iTypeVarEight = 0;
double dblCHOLB = 0;
int iCHOLB = 0;
int *piAddressVarNine = NULL;
int iTypeVarNine = 0;
int iRowsNine = 0;
int iColsNine = 0;
double* RESID = NULL;
doublecomplex* RESIDC = NULL;
int *piAddressVarTen = NULL;
int iINFO = 0;
int RVEC = 0;
// Output arguments
double* eigenvalue = NULL;
double* eigenvector = NULL;
doublecomplex* eigenvalueC = NULL;
doublecomplex* eigenvectorC = NULL;
double* mat_eigenvalue = NULL;
doublecomplex* mat_eigenvalueC = NULL;
int INFO_EUPD = 0;
int error = 0;
int iErr = 0;
int i = 0;
int j = 0;
CheckInputArgument(pvApiCtx, 1, 10);
CheckOutputArgument(pvApiCtx, 0, 2);
/****************************************
* First variable : A *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 1;
}
sciErr = getVarDimension(pvApiCtx, piAddressVarOne, &iRowsOne, &iColsOne);
//check if A is a square matrix
if (iRowsOne * iColsOne == 1 || iRowsOne != iColsOne)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A square matrix expected.\n"), "eigs", 1);
return 1;
}
N = iRowsOne;
//check if A is complex
if (isVarComplex(pvApiCtx, piAddressVarOne))
{
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddressVarOne, &iRowsOne, &iColsOne, &Acplx);
Acomplex = 1;
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarOne, &iRowsOne, &iColsOne, &Areal);
for (i = 0; i < iColsOne; i++)
{
for (j = 0; j < i; j++)
{
elemt1 = Areal[j + i * iColsOne];
elemt2 = Areal[j * iColsOne + i];
if (fabs(elemt1 - elemt2) > 0)
{
Asym = 0;
break;
}
}
if (Asym == 0)
{
break;
}
}
}
/****************************************
* Second variable : B *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 1;
}
sciErr = getVarType(pvApiCtx, piAddressVarTwo, &iTypeVarTwo);
if (sciErr.iErr || iTypeVarTwo != sci_matrix)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong type for input argument #%d: An empty matrix or full or sparse square matrix expected.\n"), "eigs", 2);
return 1;
}
sciErr = getVarDimension(pvApiCtx, piAddressVarTwo, &iRowsTwo, &iColsTwo);
matB = iRowsTwo * iColsTwo;
if (matB && (iRowsTwo != iRowsOne || iColsTwo != iColsOne))
{
Scierror(999, _("%s: Wrong dimension for input argument #%d: B must have the same size as A.\n"), "eigs", 2);
return 1;
}
if (isVarComplex(pvApiCtx, piAddressVarTwo))
{
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddressVarTwo, &iRowsTwo, &iColsTwo, &Bcplx);
Bcomplex = 1;
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarTwo, &iRowsTwo, &iColsTwo, &Breal);
}
if (matB != 0)
{
if (Acomplex && !Bcomplex)
{
Bcplx = (doublecomplex*)MALLOC(N * N * sizeof(doublecomplex));
memset(Bcplx, 0, N * N * sizeof(doublecomplex));
Bcomplex = 1;
for (i = 0 ; i < N * N ; i++)
{
Bcplx[i].r = Breal[i];
}
}
if (!Acomplex && Bcomplex)
{
Acplx = (doublecomplex*)MALLOC(N * N * sizeof(doublecomplex));
memset(Acplx, 0, N * N * sizeof(doublecomplex));
Acomplex = 1;
for (i = 0 ; i < N * N ; i++)
{
Acplx[i].r = Areal[i];
}
}
}
/****************************************
* NEV *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddressVarThree);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 3);
FREE_AB;
return 1;
}
iErr = getScalarDouble(pvApiCtx, piAddressVarThree, &dblNEV);
if (iErr)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "eigs", 3);
FREE_AB;
return 1;
}
if (isVarComplex(pvApiCtx, piAddressVarThree))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "eigs", 3);
FREE_AB;
return 1;
}
if (dblNEV != floor(dblNEV) || (dblNEV <= 0))
{
Scierror(999, _("%s: Wrong type for input argument #%d: k must be a positive integer.\n"), "eigs", 3);
FREE_AB;
return 1;
}
if (!finite(dblNEV))
{
Scierror(999, _("%s: Wrong value for input argument #%d: k must be in the range 1 to N.\n"), "eigs", 3);
FREE_AB;
return 1;
}
iNEV = (int)dblNEV;
/****************************************
* SIGMA AND WHICH *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 4, &piAddressVarFour);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 4);
FREE_AB;
return 1;
}
sciErr = getVarType(pvApiCtx, piAddressVarFour, &iTypeVarFour);
if (sciErr.iErr || (iTypeVarFour != sci_matrix && iTypeVarFour != sci_strings))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "eigs", 4);
FREE_AB;
return 1;
}
if (iTypeVarFour == sci_strings)
{
int iErr = getAllocatedSingleString(pvApiCtx, piAddressVarFour, &pstData);
if (iErr)
{
FREE_AB;
return 1;
}
if (strcmp(pstData, "LM") != 0 && strcmp(pstData, "SM") != 0 && strcmp(pstData, "LR") != 0 && strcmp(pstData, "SR") != 0 && strcmp(pstData, "LI") != 0
&& strcmp(pstData, "SI") != 0 && strcmp(pstData, "LA") != 0 && strcmp(pstData, "SA") != 0 && strcmp(pstData, "BE") != 0)
{
if (!Acomplex && Asym)
{
Scierror(999, _("%s: Wrong value for input argument #%d: Unrecognized sigma value.\n Sigma must be one of '%s', '%s', '%s', '%s' or '%s'.\n" ),
"eigs", 4, "LM", "SM", "LA", "SA", "BE");
freeAllocatedSingleString(pstData);
return 1;
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: Unrecognized sigma value.\n Sigma must be one of '%s', '%s', '%s', '%s', '%s' or '%s'.\n " ),
"eigs", 4, "LM", "SM", "LR", "SR", "LI", "SI");
FREE_AB;
freeAllocatedSingleString(pstData);
return 1;
}
}
if ((Acomplex || !Asym) && (strcmp(pstData, "LA") == 0 || strcmp(pstData, "SA") == 0 || strcmp(pstData, "BE") == 0))
{
Scierror(999, _("%s: Invalid sigma value for complex or non symmetric problem.\n"), "eigs", 4);
FREE_AB;
freeAllocatedSingleString(pstData);
return 1;
}
if (!Acomplex && Asym && (strcmp(pstData, "LR") == 0 || strcmp(pstData, "SR") == 0 || strcmp(pstData, "LI") == 0 || strcmp(pstData, "SI") == 0))
{
Scierror(999, _("%s: Invalid sigma value for real symmetric problem.\n"), "eigs", 4);
freeAllocatedSingleString(pstData);
return 1;
}
SIGMA.r = 0;
SIGMA.i = 0;
}
if (iTypeVarFour == sci_matrix)
{
sciErr = getVarDimension(pvApiCtx, piAddressVarFour, &iRowsFour, &iColsFour);
if (iRowsFour * iColsFour != 1)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "eigs", 4);
FREE_AB;
return 1;
}
if (getScalarComplexDouble(pvApiCtx, piAddressVarFour, &SIGMA.r, &SIGMA.i))
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 4);
FREE_AB;
return 1;
}
if (C2F(isanan)(&SIGMA.r) || C2F(isanan)(&SIGMA.i))
{
Scierror(999, _("%s: Wrong type for input argument #%d: sigma must be a real.\n"), "eigs", 4);
FREE_AB;
return 1;
}
pstData = "LM";
}
/****************************************
* MAXITER *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 5, &piAddressVarFive);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 5);
FREE_AB;
FREE_PSTDATA;
return 0;
}
iErr = getScalarDouble(pvApiCtx, piAddressVarFive, &dblMAXITER);
if (iErr)
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be a scalar.\n"), "eigs", 5, "opts.maxiter");
FREE_AB;
FREE_PSTDATA;
return 1;
}
if ((dblMAXITER != floor(dblMAXITER)) || (dblMAXITER <= 0))
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be an integer positive value.\n"), "eigs", 5, "opts.maxiter");
FREE_AB;
FREE_PSTDATA;
return 1;
}
/****************************************
* TOL *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 6, &piAddressVarSix);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 6);
FREE_AB;
FREE_PSTDATA;
return 1;
}
iErr = getScalarDouble(pvApiCtx, piAddressVarSix, &dblTOL);
if (iErr)
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be a real scalar.\n"), "eigs", 6, "opts.tol");
FREE_AB;
FREE_PSTDATA;
return 1;
}
if (C2F(isanan)(&dblTOL))
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be a real scalar.\n"), "eigs", 6, "opts.tol");
FREE_AB;
FREE_PSTDATA;
return 1;
}
/****************************************
* NCV *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 7, &piAddressVarSeven);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 7);
FREE_AB;
FREE_PSTDATA;
return 1;
}
sciErr = getVarType(pvApiCtx, piAddressVarSeven, &TypeVarSeven);
if (sciErr.iErr || TypeVarSeven != sci_matrix)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be an integer scalar.\n"), "eigs", 7, "opts.ncv");
FREE_AB;
FREE_PSTDATA;
return 1;
}
else
{
if (isVarComplex(pvApiCtx, piAddressVarSeven))
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be an integer scalar.\n"), "eigs", 7, "opts.ncv");
}
else
{
sciErr = getVarDimension(pvApiCtx, piAddressVarSeven, &RowsSeven, &ColsSeven);
if (RowsSeven * ColsSeven > 1)
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be an integer scalar.\n"), "eigs", 7, "opts.ncv");
FREE_AB;
FREE_PSTDATA;
return 1;
}
if (RowsSeven * ColsSeven == 1)
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarSeven, &RowsSeven, &ColsSeven, &dblNCV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 7);
FREE_AB;
FREE_PSTDATA;
return 1;
}
if (dblNCV[0] != floor(dblNCV[0]))
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be an integer scalar.\n"), "eigs", 7, "opts.ncv");
FREE_AB;
FREE_PSTDATA;
return 1;
}
}
}
}
/****************************************
* CHOLB *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 8, &piAddressVarEight);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 8);
FREE_AB;
FREE_PSTDATA;
return 1;
}
sciErr = getVarType(pvApiCtx, piAddressVarEight, &iTypeVarEight);
if (sciErr.iErr || (iTypeVarEight != sci_matrix && iTypeVarEight != sci_boolean))
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be an integer scalar or a boolean.\n"), "eigs", 8, "opts.cholB");
FREE_AB;
FREE_PSTDATA;
return 1;
}
if (iTypeVarEight == sci_boolean)
{
iErr = getScalarBoolean(pvApiCtx, piAddressVarEight, &iCHOLB);
if (iErr)
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be an integer scalar or a boolean.\n"), "eigs", 8, "opts.cholB");
FREE_AB;
FREE_PSTDATA;
return 1;
}
if (iCHOLB != 1 && iCHOLB != 0)
{
Scierror(999, _("%s: Wrong value for input argument #%d: %s must be %s or %s.\n"), "eigs", 8, "opts.cholB", "%f", "%t");
FREE_AB;
FREE_PSTDATA;
return 1;
}
dblCHOLB = (double) iCHOLB;
}
if (iTypeVarEight == sci_matrix)
{
iErr = getScalarDouble(pvApiCtx, piAddressVarEight, &dblCHOLB);
if (iErr)
{
Scierror(999, _("%s: Wrong type for input argument #%d: %s must be an integer scalar or a boolean.\n"), "eigs", 8, "opts.cholB");
FREE_AB;
FREE_PSTDATA;
return 1;
}
if (dblCHOLB != 1 && dblCHOLB != 0)
{
Scierror(999, _("%s: Wrong value for input argument #%d: %s must be %s or %s.\n"), "eigs", 8, "opts.cholB", "%f", "%t");
FREE_AB;
FREE_PSTDATA;
return 1;
}
}
if ( dblCHOLB ) // check that B is upper triangular with non zero element on the diagonal
{
if (!Bcomplex)
{
for (i = 0; i < N; i++)
{
for (j = 0; j <= i; j++)
{
if (i == j && Breal[i + j * N] == 0)
{
Scierror(999, _("%s: B is not positive definite. Try with sigma='SM' or sigma=scalar.\n"), "eigs");
FREE_PSTDATA;
return 0;
}
else
{
if ( j < i && Breal[i + j * N] != 0 )
{
Scierror(999, _("%s: If opts.cholB is true, B should be upper triangular.\n"), "eigs");
FREE_PSTDATA;
return 0;
}
}
}
}
}
else
{
for (i = 0; i < N; i++)
{
for (j = 0; j <= i; j++)
{
if (i == j && Bcplx[i + i * N].r == 0 && Bcplx[i + i * N].i == 0)
{
Scierror(999, _("%s: B is not positive definite. Try with sigma='SM' or sigma=scalar.\n"), "eigs");
FREE_AB;
FREE_PSTDATA;
return 0;
}
else
{
if ( j < i && (Bcplx[i + j * N].r != 0 || Bcplx[i + j * N].i != 0) )
{
Scierror(999, _("%s: If opts.cholB is true, B should be upper triangular.\n"), "eigs");
FREE_AB;
FREE_PSTDATA;
return 0;
}
}
}
}
}
}
/****************************************
* RESID *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 9, &piAddressVarNine);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 9);
FREE_AB;
FREE_PSTDATA;
return 1;
}
sciErr = getVarType(pvApiCtx, piAddressVarNine, &iTypeVarNine);
if (sciErr.iErr || iTypeVarNine != sci_matrix)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong type for input argument #%d: A real or complex matrix expected.\n"), "eigs", 9);
FREE_AB;
FREE_PSTDATA;
return 1;
}
else
{
sciErr = getVarDimension(pvApiCtx, piAddressVarNine, &iRowsNine, &iColsNine);
if (iRowsNine * iColsNine == 1 || iRowsNine * iColsNine != N)
{
Scierror(999, _("%s: Wrong dimension for input argument #%d: Start vector %s must be N by 1.\n"), "eigs", 9, "opts.resid");
FREE_AB;
FREE_PSTDATA;
return 1;
}
}
if (!Acomplex && !Bcomplex)
{
if (isVarComplex(pvApiCtx, piAddressVarNine))
{
Scierror(999, _("%s: Wrong type for input argument #%d: Start vector %s must be real for real problems.\n"), "eigs", 9, "opts.resid");
FREE_PSTDATA;
return 1;
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarNine, &iRowsNine, &iColsNine, &RESID);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), "eigs", 9);
FREE_PSTDATA;
return 1;
}
}
}
else
{
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddressVarNine, &iRowsNine, &iColsNine, &RESIDC);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), "eigs", 9);
FREE_AB;
FREE_PSTDATA;
return 1;
}
}
/****************************************
* INFO *
*****************************************/
sciErr = getVarAddressFromPosition(pvApiCtx, 10, &piAddressVarTen);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), "eigs", 9);
FREE_AB;
FREE_PSTDATA;
return 1;
}
iErr = getScalarInteger32(pvApiCtx, piAddressVarTen, &iINFO);
if (iErr)
{
Scierror(999, _("%s: Wrong type for input argument #%d: An integer expected.\n"), "eigs", 1);
FREE_AB;
FREE_PSTDATA;
return 1;
}
// Initialization output arguments
if (nbOutputArgument(pvApiCtx) > 1)
{
RVEC = 1;
}
if (Acomplex || Bcomplex || !Asym)
{
eigenvalueC = (doublecomplex*)CALLOC((iNEV + 1), sizeof(doublecomplex));
if (RVEC)
{
eigenvectorC = (doublecomplex*)CALLOC(N * (iNEV + 1), sizeof(doublecomplex));
}
}
else
{
eigenvalue = (double*)CALLOC(iNEV, sizeof(double));
/* we should allocate eigenvector only if RVEC is true, but dseupd segfaults
if Z is not allocated even when RVEC is false, contrary to the docs.*/
eigenvector = (double*)CALLOC(iNEV * N, sizeof(double));
}
error = eigs(Areal, Acplx, N, Acomplex, Asym, Breal, Bcplx, Bcomplex, matB, iNEV, SIGMA, pstData, &dblMAXITER,
&dblTOL, dblNCV, RESID, RESIDC, &iINFO, &dblCHOLB, INFO_EUPD, eigenvalue, eigenvector, eigenvalueC, eigenvectorC, RVEC);
FREE_AB;
FREE_PSTDATA;
switch (error)
{
case -1 :
if (Asym && !Acomplex && !Bcomplex)
{
Scierror(999, _("%s: Wrong value for input argument #%d: For real symmetric problems, NCV must be k < NCV <= N.\n"), "eigs", 7);
}
else
{
if (!Asym && !Acomplex && !Bcomplex)
{
Scierror(999, _("%s: Wrong value for input argument #%d: For real non symmetric problems, NCV must be k + 2 < NCV <= N.\n"), "eigs", 7);
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: For complex problems, NCV must be k + 1 < NCV <= N.\n"), "eigs", 7);
}
}
ReturnArguments(pvApiCtx);
return 1;
case -2 :
if (Asym && !Acomplex && !Bcomplex)
{
Scierror(999, _("%s: Wrong value for input argument #%d: For real symmetric problems, k must be an integer in the range 1 to N - 1.\n"), "eigs", 3);
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: For real non symmetric or complex problems, k must be an integer in the range 1 to N - 2.\n"), "eigs", 3);
}
ReturnArguments(pvApiCtx);
return 1;
case -3 :
Scierror(999, _("%s: Error with input argument #%d: B is not positive definite. Try with sigma='SM' or sigma=scalar.\n"), "eigs", 2);
ReturnArguments(pvApiCtx);
return 0;
case -4 :
if (!Acomplex && !Bcomplex)
{
if (Asym)
{
Scierror(999, _("%s: Error with %s: info = %d \n"), "eigs", "DSAUPD", iINFO);
}
else
{
Scierror(999, _("%s: Error with %s: info = %d \n"), "eigs", "DNAUPD", iINFO);
}
}
else
{
Scierror(999, _("%s: Error with %s: info = %d \n"), "eigs", "ZNAUPD", iINFO);
}
ReturnArguments(pvApiCtx);
return 1;
case -5 :
if (!Acomplex && !Bcomplex)
{
if (Asym)
{
Scierror(999, _("%s: Error with %s: unknown mode returned.\n"), "eigs", "DSAUPD");
}
else
{
Scierror(999, _("%s: Error with %s: unknown mode returned.\n"), "eigs", "DNAUPD");
}
}
else
{
Scierror(999, _("%s: Error with %s: unknown mode returned.\n"), "eigs", "ZNAUPD");
}
ReturnArguments(pvApiCtx);
return 1;
case -6 :
if (!Acomplex && !Bcomplex)
{
if (Asym)
{
Scierror(999, _("%s: Error with %s: info = %d \n"), "eigs", "DSEUPD", INFO_EUPD);
}
else
{
Scierror(999, _("%s: Error with %s: info = %d \n"), "eigs", "DNEUPD", INFO_EUPD);
}
}
else
{
Scierror(999, _("%s: Error with %s: info = %d \n"), "eigs", "ZNEUPD", INFO_EUPD);
}
ReturnArguments(pvApiCtx);
FREE(mat_eigenvalue);
return 1;
}
if (nbOutputArgument(pvApiCtx) <= 1)
{
if (eigenvalue)
{
sciErr = createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, iNEV, 1, eigenvalue);
FREE(eigenvalue);
FREE(eigenvector);
}
else if (eigenvalueC)
{
sciErr = createComplexZMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, iNEV, 1, eigenvalueC);
FREE(eigenvalueC);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
}
else
{
// create a matrix which contains the eigenvalues
if (eigenvalue)
{
mat_eigenvalue = (double*)CALLOC(iNEV * iNEV, sizeof(double));
for (i = 0; i < iNEV; i++)
{
mat_eigenvalue[i * iNEV + i] = eigenvalue[i];
}
sciErr = createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, iNEV, iNEV, mat_eigenvalue);
FREE(eigenvalue);
FREE(mat_eigenvalue);
}
else if (eigenvalueC)
{
mat_eigenvalueC = (doublecomplex*)CALLOC(iNEV * iNEV, sizeof(doublecomplex));
for (i = 0; i < iNEV; i++)
{
mat_eigenvalueC[i * iNEV + i] = eigenvalueC[i];
}
sciErr = createComplexZMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, iNEV, iNEV, mat_eigenvalueC);
FREE(eigenvalueC);
FREE(mat_eigenvalueC);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
if (eigenvector)
{
sciErr = createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 2, N, iNEV, eigenvector);
FREE(eigenvector);
}
else if (eigenvectorC)
{
sciErr = createComplexZMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 2, N, iNEV, eigenvectorC);
FREE(eigenvectorC);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
AssignOutputVariable(pvApiCtx, 2) = nbInputArgument(pvApiCtx) + 2;
}
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_znaupd(char *fname, void *pvApiCtx)
{
SciErr sciErr;
int* piAddrpIDO = NULL;
int* pIDO = NULL;
int* piAddrpBMAT = NULL;
char* pBMAT = NULL;
int* piAddrpN = NULL;
int* pN = NULL;
int* piAddrpWHICH = NULL;
char* pWHICH = NULL;
int* piAddrpNEV = NULL;
int* pNEV = NULL;
int* piAddrpTOL = NULL;
double* pTOL = NULL;
int* piAddrpNCV = NULL;
int* pNCV = NULL;
int* piAddrpIPARAM = NULL;
int* pIPARAM = NULL;
int* piAddrpIPNTR = NULL;
int* pIPNTR = NULL;
int* piAddrpRWORK = NULL;
double* pRWORK = NULL;
int* piAddrpINFO = NULL;
int* pINFO = NULL;
int* piAddrpV = NULL;
doublecomplex* pV = NULL;
int* piAddrpRESID = NULL;
doublecomplex* pRESID = NULL;
int* piAddrpWORKD = NULL;
doublecomplex* pWORKD = NULL;
int* piAddrpWORKL = NULL;
doublecomplex* pWORKL = NULL;
int IDO, mIDO, nIDO;
int mN, nN;
int mNEV, nNEV;
int mTOL, nTOL;
int RESID, mRESID, nRESID;
int mNCV, nNCV;
int V, mV, nV;
int IPARAM, mIPARAM, nIPARAM;
int IPNTR, mIPNTR, nIPNTR;
int WORKD, mWORKD, nWORKD;
int WORKL, mWORKL, nWORKL;
int RWORK, mRWORK, nRWORK;
int INFO, mINFO, nINFO;
int minlhs = 1, minrhs = 15, maxlhs = 9, maxrhs = 15;
int LDV, LWORKL;
int sizeWORKL = 0;
CheckInputArgument(pvApiCtx, minrhs, maxrhs);
CheckOutputArgument(pvApiCtx, minlhs, maxlhs);
/* VARIABLE = NUMBER */
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrpIDO);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpIDO, &mIDO, &nIDO, &pIDO);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
return 1;
}
IDO = 1;
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddrpN);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 3.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpN, &mN, &nN, &pN);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 3);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 5, &piAddrpNEV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 5.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpNEV, &mNEV, &nNEV, &pNEV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 5);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 6, &piAddrpTOL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 6.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrpTOL, &mTOL, &nTOL, &pTOL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 6);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 7, &piAddrpRESID);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 7.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpRESID, &mRESID, &nRESID, &pRESID);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 7);
return 1;
}
RESID = 7;
sciErr = getVarAddressFromPosition(pvApiCtx, 8, &piAddrpNCV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 8.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpNCV, &mNCV, &nNCV, &pNCV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 8);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 9, &piAddrpV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 9.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpV, &mV, &nV, &pV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 9);
return 1;
}
V = 9;
sciErr = getVarAddressFromPosition(pvApiCtx, 10, &piAddrpIPARAM);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 10.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpIPARAM, &mIPARAM, &nIPARAM, &pIPARAM);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 10);
return 1;
}
IPARAM = 10;
sciErr = getVarAddressFromPosition(pvApiCtx, 11, &piAddrpIPNTR);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 11.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpIPNTR, &mIPNTR, &nIPNTR, &pIPNTR);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 11);
return 1;
}
IPNTR = 11;
sciErr = getVarAddressFromPosition(pvApiCtx, 12, &piAddrpWORKD);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 12.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpWORKD, &mWORKD, &nWORKD, &pWORKD);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 12);
return 1;
}
WORKD = 12;
sciErr = getVarAddressFromPosition(pvApiCtx, 13, &piAddrpWORKL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 13.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpWORKL, &mWORKL, &nWORKL, &pWORKL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 13);
return 1;
}
WORKL = 13;
sciErr = getVarAddressFromPosition(pvApiCtx, 14, &piAddrpRWORK);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 14.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrpRWORK, &mRWORK, &nRWORK, &pRWORK);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 14);
return 1;
}
RWORK = 14;
sciErr = getVarAddressFromPosition(pvApiCtx, 15, &piAddrpINFO);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 15.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpINFO, &mINFO, &nINFO, &pINFO);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 15);
return 1;
}
INFO = 15;
LWORKL = mWORKL * nWORKL;
LDV = Max(1, pN[0]);
/* Don't call dnaupd if ido == 99 */
if (pIDO[0] == 99)
{
Scierror(999, _("%s: the computation is already terminated\n"), fname);
return 0;
}
/* Check some sizes */
if (mIPARAM * nIPARAM != 11)
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPARAM", 11);
return 0;
}
if (mIPNTR * nIPNTR != 14)
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPNTR", 14);
return 0;
}
if (mRESID * nRESID != pN[0])
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "RESID", pN[0]);
return 0;
}
if ((mV != pN[0]) || (nV != pNCV[0]))
{
Scierror(999, _("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "V", pN[0], pNCV[0]);
return 0;
}
if (mWORKD * nWORKD < 3 * pN[0])
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKD", 3 * pN[0]);
return 0;
}
sizeWORKL = 3 * pNCV[0] * pNCV[0] + 5 * pNCV[0];
if (mWORKL * nWORKL < sizeWORKL)
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKL", sizeWORKL);
return 0;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrpBMAT);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 2.
if (getAllocatedSingleString(pvApiCtx, piAddrpBMAT, &pBMAT))
{
Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 2);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 4, &piAddrpWHICH);
if (sciErr.iErr)
{
freeAllocatedSingleString(pBMAT);
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 4.
if (getAllocatedSingleString(pvApiCtx, piAddrpWHICH, &pWHICH))
{
freeAllocatedSingleString(pBMAT);
Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 4);
return 1;
}
C2F(znaupd)(pIDO, pBMAT, pN,
pWHICH, pNEV, pTOL,
pRESID, pNCV, pV, &LDV,
pIPARAM, pIPNTR, pWORKD,
pWORKL, &LWORKL, pRWORK, pINFO);
freeAllocatedSingleString(pBMAT);
freeAllocatedSingleString(pWHICH);
if (pINFO[0] < 0)
{
Scierror(998, _("%s: internal error, info=%d.\n"), fname, *pINFO);
return 0;
}
AssignOutputVariable(pvApiCtx, 1) = IDO;
AssignOutputVariable(pvApiCtx, 2) = RESID;
AssignOutputVariable(pvApiCtx, 3) = V;
AssignOutputVariable(pvApiCtx, 4) = IPARAM;
AssignOutputVariable(pvApiCtx, 5) = IPNTR;
AssignOutputVariable(pvApiCtx, 6) = WORKD;
AssignOutputVariable(pvApiCtx, 7) = WORKL;
AssignOutputVariable(pvApiCtx, 8) = RWORK;
AssignOutputVariable(pvApiCtx, 9) = INFO;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_norm(char *fname, void* pvApiCtx)
{
SciErr sciErr;
// Arguments' addresses
int *pAAddr = NULL;
int *pflagAddr = NULL;
// Arguments' values
double *pA = NULL;
char *pflagChar = NULL;
doublecomplex *pAC = NULL;
double flagVal = 0;
// Arguments' properties (type, dimensions, length)
int iLen = 0;
int iType = 0;
int iRows = 0;
int iCols = 0;
// Return value
double ret = 0;
double RowsColsTemp = 0;
int i = 0;
int isMat = 0;
int isComplex = 0;
CheckInputArgument(pvApiCtx, 1, 2);
CheckOutputArgument(pvApiCtx, 1, 1);
// Checking A.
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &pAAddr); // Retrieving A address.
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
printError(&sciErr, 0);
return 0;
}
sciErr = getVarType(pvApiCtx, pAAddr, &iType); // Retrieving A type.
if (iType != sci_matrix)
{
OverLoad(1);
return 0;
}
if (isVarComplex(pvApiCtx, pAAddr))
{
sciErr = getComplexZMatrixOfDouble(pvApiCtx, pAAddr, &iRows, &iCols, &pAC);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: Real or complex matrix expected.\n"), fname, 1);
return 0;
}
isComplex = 1;
for (i = 0; i < iRows * iCols; ++i) // Checking A for %inf, which is not supported by Lapack.
{
if (la_isinf(pAC[i].r) != 0 || la_isinf(pAC[i].i) != 0 || ISNAN(pAC[i].r) || ISNAN(pAC[i].i))
{
Scierror(264, _("%s: Wrong value for argument #%d: Must not contain NaN or Inf.\n"), fname, 1);
return 0;
}
}
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, pAAddr, &iRows, &iCols, &pA);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: Real or complex matrix expected.\n"), fname, 1);
return 0;
}
for (i = 0 ; i < iRows * iCols ; i++) // Checking A for %inf, which is not supported by Lapack.
{
if (la_isinf(pA[i]) != 0 || ISNAN(pA[i]))
{
Scierror(264, _("%s: Wrong value for argument #%d: Must not contain NaN or Inf.\n"), fname, 1);
return 0;
}
}
}
if (iRows == 0) // A = [] => returning 0.
{
createScalarDouble(pvApiCtx, Rhs + 1, 0);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
return 0;
}
if (iRows > 1 && iCols > 1) // If A is a matrix, only 1, 2 and %inf are allowed as second argument.
{
isMat = 1;
}
if (iRows == 1) // If iRows == 1, then transpose A to consider it like a vector.
{
RowsColsTemp = iRows;
iRows = iCols;
iCols = (int)RowsColsTemp;
}
if (Rhs == 1) // One argument => returning norm 2.
{
// Call normP() or normPC().
if (isComplex)
{
ret = normPC(pAC, iRows, iCols, 2); // if A is a complex matrix, call the complex function.
}
else
{
ret = normP(pA, iRows, iCols, 2);
}
createScalarDouble(pvApiCtx, Rhs + 1, ret);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
return 0;
}
// Checking flag.
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &pflagAddr); // Retrieving flag address.
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = getVarType(pvApiCtx, pflagAddr, &iType); // Retrieving flag type.
if (iType != sci_strings && iType != sci_matrix)
{
Scierror(999, _("%s: Wrong type for input argument #%d: String or integer expected.\n"), fname, 2);
return 0;
}
if (iType == sci_strings)
{
if (getAllocatedSingleString(pvApiCtx, pflagAddr, &pflagChar)) // Retrieving flag dimensions.
{
Scierror(205, _("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 2);
return 0;
}
iLen = (int)strlen(pflagChar);
if (iLen != 3 && iLen != 1)
{
Scierror(116, _("%s: Wrong value for input argument #%d: %s, %s, %s, or %s expected.\n"), fname, 2, "i", "inf", "f", "fro");
freeAllocatedSingleString(pflagChar);
return 0;
}
if (strcmp(pflagChar, "inf") != 0 && strcmp(pflagChar, "i") != 0 &&
strcmp(pflagChar, "fro") != 0 && strcmp(pflagChar, "f") != 0) // flag must be = "inf", "i", "fro" or "f".
{
Scierror(116, _("%s: Wrong value for input argument #%d: %s, %s, %s or %s expected.\n"), fname, 2, "i", "inf", "f", "fro");
freeAllocatedSingleString(pflagChar);
return 0;
}
if (isComplex)
{
ret = normStringC(pAC, iRows, iCols, pflagChar); // if A is a complex matrix, call the complex function.
}
else
{
ret = normString(pA, iRows, iCols, pflagChar); // flag is a string => returning the corresponding norm.
}
createScalarDouble(pvApiCtx, Rhs + 1, ret);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
freeAllocatedSingleString(pflagChar);
return 0;
}
else
{
if (isVarComplex(pvApiCtx, pflagAddr))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A real expected.\n"), fname, 2);
return 0;
}
if (getScalarDouble(pvApiCtx, pflagAddr, &flagVal)) // Retrieving flag value & dimensions as a double.
{
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), fname, 2);
return 0;
}
// Call the norm functions.
if (la_isinf(flagVal) == 1 && flagVal > 0) // flag = %inf
{
if (isComplex)
{
ret = normStringC(pAC, iRows, iCols, "inf"); // if A is a complex matrix, call the complex function.
}
else
{
ret = normString(pA, iRows, iCols, "inf"); // The infinite norm is computed by normString().
}
createScalarDouble(pvApiCtx, Rhs + 1, ret);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
return 0;
}
else
{
if (isMat == 1 && flagVal != 1 && flagVal != 2 && la_isinf(flagVal) == 0)
{
Scierror(116, _("%s: Wrong value for input argument #%d: %s, %s, %s or %s expected.\n"), fname, 2, "1", "2", "inf", "-inf");
return 0;
}
if (isComplex)
{
ret = normPC(pAC, iRows, iCols, flagVal); // if A is a complex matrix, call the complex function.
}
else
{
ret = normP(pA, iRows, iCols, flagVal); // flag is an integer => returning the corresponding norm.
}
createScalarDouble(pvApiCtx, Rhs + 1, ret);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
return 0;
}
}
return 0;
}
