// Computes the condition number of complex N x N matrix A.
// The condition number is defined as the ratio of the largest to the smallest
// singular values. Uses LAPACK.
// Note: may need to append _ to name of LAPACK functions.
double ccondit_num (double complex **A, int N)
{
double complex *a, *cwork = NULL;
double kappa, rcond, anorm;
double *rwork = NULL;
char NORM = '1';
int info;
// Convert A for LAPACK functions
a = cmat_to_fortran (A, N, N);
// Allocate work, rwork for zgecon (work is not used in anorm with NORM='1')
cwork = c_allocvector (2 * N);
if (cwork == NULL) throwMemErr ("cwork", "ccondit_num");
rwork = allocvector (2 * N);
if (rwork == NULL) throwMemErr ("rwork", "ccondit_num");
// Compute 1-norm of A
anorm = zlange_ (&NORM, &N, &N, a, &N, rwork);
// Compute reciprocal of condition number
zgecon_ (&NORM, &N, a, &N, &anorm, &rcond, cwork, rwork, &info);
kappa = 1. / rcond;
if (info != 0)
throwErr ("Illegal argument to zgecon", "ccondit_num");
free (a);
free (cwork);
free (rwork);
return kappa;
}
/* xlNewString - allocate and initialize a new string */
xlEXPORT xlValue xlNewString(xlFIXTYPE size)
{
xlValue val;
if (size < 0) xlError("string length negative",xlMakeFixnum(size));
val = allocvector(xlSTRING,xlByteToWordSize(size + 1));
xlGetString(val)[size] = '\0'; /* in case we need to use it as a c string */
val->value.vector.size = size;
return val;
}
/* xlMakeSymbol - convert a string to a symbol */
xlEXPORT xlValue xlMakeSymbol(xlValue pname)
{
xlValue val;
xlCPush(pname);
val = allocvector(xlSYMBOL,xlSYMBOLSIZE);
xlSetValue(val,xlUnboundObject);
xlSetPName(val,xlPop());
xlSetPList(val,xlNil);
return val;
}
/* xlNewUStream - create a new unnamed stream */
xlEXPORT xlValue xlNewUStream(void)
{
xlValue val;
xlCPush(allocvector(xlVECTOR,xlUSTRSIZE));
val = xlNewStream(xlUSTREAM,xlpfINPUT | xlpfOUTPUT | xlpfBOL);
xlSetSData(val,xlPop());
xlSetStrHead(val,xlNil);
xlSetStrTail(val,xlNil);
xlSetStrIPtr(val,xlMakeSmallFixnum(0));
xlSetStrOPtr(val,xlMakeSmallFixnum(0));
return val;
}
//------------------------------------------------------------------------------
// Converts A into a (m x n)-length vector. The entries of A are added to the
// vector first by row, then by column, i.e. it adds first A[0][0], A[0][1],
// A[0][2], ... , A[1][0], A[1][1], etc.
//------------------------------------------------------------------------------
double * matrixToVector (double **A, int m, int n)
{
int i, j;
double *v = NULL;
v = allocvector(m * n);
if (v == NULL) throwMemErr("v", "matrixToVector");
for (i = 0; i < m; i++)
for (j = 0; j < n; j++)
v[i*m+j] = A[i][j];
return v;
}
//------------------------------------------------------------------------------
// Returns a copy of a vector
//------------------------------------------------------------------------------
double * copyv (double *v, int N)
{
double *copy = NULL;
int i;
copy = allocvector(N);
if (copy == NULL)
throwMemErr("copy", "copyv");
for (i = 0; i < N; i++)
copy[i] = v[i];
return copy;
}
double * zerosv(int N)
{
int i;
double *x;
x = allocvector(N);
if (x == NULL)
throwMemErr("x", "zerosv");
for(i = 0; i < N; i++)
x[i] = 0.;
return x;
}
/* xlNewPackage - create a new package */
xlEXPORT xlValue xlNewPackage(char *name)
{
xlValue pack;
if (xlFindPackage(name) != xlNil)
xlError("duplicate package name",xlMakeCString(name));
pack = allocvector(xlPACKAGE,xlPACKAGESIZE);
xlCPush(pack);
xlSetNames(pack,xlCons(xlMakeCString(name),xlNil));
xlSetExtern(pack,xlNewVector(xlHSIZE));
xlSetIntern(pack,xlNewVector(xlHSIZE));
xlSetUses(pack,xlNil);
xlSetUsedBy(pack,xlNil);
xlSetNextPackage(pack,xlPackages);
xlPackages = pack;
return xlPop();
}
/* xlNewContinuation - create a new continuation object */
xlEXPORT xlValue xlNewContinuation(xlFIXTYPE size)
{
return allocvector(xlCONTINUATION,size);
}
/* xlNewCode - create a new code object */
xlEXPORT xlValue xlNewCode(xlFIXTYPE nlits)
{
return allocvector(xlCODE,nlits);
}
/* xlNewTable - allocate and initialize a new table */
xlEXPORT xlValue xlNewTable(xlFIXTYPE size)
{
if (size < 0) xlError("vector length negative",xlMakeFixnum(size));
return allocvector(xlTABLE,size);
}
