/*This module contributed by Doug Heisterkamp Modified by Jim Hugunin */ #include"Python.h" #include"arrayobject.h" typedef struct { float r, i; } f2c_complex; typedef struct { double r, i; } f2c_doublecomplex; typedef long int (*L_fp)(); static PyObject *ErrorObject; static PyObject *LapackError() { if (! ErrorObject) ErrorObject = PyString_FromString("LapackError"); Py_INCREF(ErrorObject); return ErrorObject; } static PyObject *ErrorReturn(char *mes) { if (!ErrorObject) ErrorObject = PyString_FromString("LapackError"); PyErr_SetString(ErrorObject,mes); return NULL; } #define TRY(E) if( ! (E)) return NULL static int lapack_lite_CheckObject(PyObject *ob, int t, char *obname, char *tname, char *funname) { char buf[255]; if (! PyArray_Check(ob)) { sprintf(buf,"Expected an array for parameter %s in lapack_dge.%s",obname, funname); ErrorReturn(buf); return 0; } if (!(((PyArrayObject *)ob)->flags & CONTIGUOUS)) { sprintf(buf,"Parameter %s is not contiguous in lapack_dge.%s",obname, funname); ErrorReturn(buf); return 0; } if (!(((PyArrayObject *)ob)->descr->type_num == t)) { sprintf(buf,"Parameter %s is not of type %s in lapack_lite.%s",obname,tname, funname); ErrorReturn(buf); return 0; } return 1; } #define LDATA(p) ((long int *) (((PyArrayObject *)p)->data)) #define CHDATA(p) ((char *) (((PyArrayObject *)p)->data)) #define SHDATA(p) ((short int *) (((PyArrayObject *)p)->data)) #define DDATA(p) ((double *) (((PyArrayObject *)p)->data)) #define FDATA(p) ((float *) (((PyArrayObject *)p)->data)) #define CDATA(p) ((f2c_complex *) (((PyArrayObject *)p)->data)) #define ZDATA(p) ((f2c_doublecomplex *) (((PyArrayObject *)p)->data)) static PyObject *lapack_lite_dgeev(PyObject *self, PyObject *args) { int lapack_lite_status__; char jobvl; char jobvr; long int n; PyObject *a; long int lda; PyObject *wr; PyObject *wi; PyObject *vl; long int ldvl; PyObject *vr; long int ldvr; PyObject *work; long int lwork; long int info; TRY(PyArg_ParseTuple(args,"cclOlOOOlOlOll",&jobvl,&jobvr,&n,&a,&lda,&wr,&wi,&vl,&ldvl,&vr,&ldvr,&work,&lwork,&info)); TRY(lapack_lite_CheckObject(a,PyArray_DOUBLE,"a","PyArray_DOUBLE","dgeev")); TRY(lapack_lite_CheckObject(wr,PyArray_DOUBLE,"wr","PyArray_DOUBLE","dgeev")); TRY(lapack_lite_CheckObject(wi,PyArray_DOUBLE,"wi","PyArray_DOUBLE","dgeev")); TRY(lapack_lite_CheckObject(vl,PyArray_DOUBLE,"vl","PyArray_DOUBLE","dgeev")); TRY(lapack_lite_CheckObject(vr,PyArray_DOUBLE,"vr","PyArray_DOUBLE","dgeev")); TRY(lapack_lite_CheckObject(work,PyArray_DOUBLE,"work","PyArray_DOUBLE","dgeev")); #if defined(NO_APPEND_FORTRAN) lapack_lite_status__ = dgeev(&jobvl,&jobvr,&n,DDATA(a),&lda,DDATA(wr),DDATA(wi),DDATA(vl),&ldvl,DDATA(vr),&ldvr,DDATA(work),&lwork,&info); #else lapack_lite_status__ = dgeev_(&jobvl,&jobvr,&n,DDATA(a),&lda,DDATA(wr),DDATA(wi),DDATA(vl),&ldvl,DDATA(vr),&ldvr,DDATA(work),&lwork,&info); #endif return Py_BuildValue("{s:l,s:c,s:c,s:l,s:l,s:l,s:l,s:l,s:l}","dgeev_",lapack_lite_status__,"jobvl",jobvl,"jobvr",jobvr,"n",n,"lda",lda,"ldvl",ldvl,"ldvr",ldvr,"lwork",lwork,"info",info); } static PyObject *lapack_lite_dgelss(PyObject *self, PyObject *args) { int lapack_lite_status__; long int m; long int n; long int nrhs; PyObject *a; long int lda; PyObject *b; long int ldb; PyObject *s; double rcond; long int rank; PyObject *work; long int lwork; long int info; TRY(PyArg_ParseTuple(args,"lllOlOlOdlOll",&m,&n,&nrhs,&a,&lda,&b,&ldb,&s,&rcond,&rank,&work,&lwork,&info)); TRY(lapack_lite_CheckObject(a,PyArray_DOUBLE,"a","PyArray_DOUBLE","dgelss")); TRY(lapack_lite_CheckObject(b,PyArray_DOUBLE,"b","PyArray_DOUBLE","dgelss")); TRY(lapack_lite_CheckObject(s,PyArray_DOUBLE,"s","PyArray_DOUBLE","dgelss")); TRY(lapack_lite_CheckObject(work,PyArray_DOUBLE,"work","PyArray_DOUBLE","dgelss")); #if defined(NO_APPEND_FORTRAN) lapack_lite_status__ = dgelss(&m,&n,&nrhs,DDATA(a),&lda,DDATA(b),&ldb,DDATA(s),&rcond,&rank,DDATA(work),&lwork,&info); #else lapack_lite_status__ = dgelss_(&m,&n,&nrhs,DDATA(a),&lda,DDATA(b),&ldb,DDATA(s),&rcond,&rank,DDATA(work),&lwork,&info); #endif return Py_BuildValue("{s:l,s:l,s:l,s:l,s:l,s:l,s:d,s:l,s:l,s:l}","dgelss_",lapack_lite_status__,"m",m,"n",n,"nrhs",nrhs,"lda",lda,"ldb",ldb,"rcond",rcond,"rank",rank,"lwork",lwork,"info",info); } static PyObject *lapack_lite_dgesv(PyObject *self, PyObject *args) { int lapack_lite_status__; long int n; long int nrhs; PyObject *a; long int lda; PyObject *ipiv; PyObject *b; long int ldb; long int info; TRY(PyArg_ParseTuple(args,"llOlOOll",&n,&nrhs,&a,&lda,&ipiv,&b,&ldb,&info)); TRY(lapack_lite_CheckObject(a,PyArray_DOUBLE,"a","PyArray_DOUBLE","dgesv")); TRY(lapack_lite_CheckObject(ipiv,PyArray_LONG,"ipiv","PyArray_LONG","dgesv")); TRY(lapack_lite_CheckObject(b,PyArray_DOUBLE,"b","PyArray_DOUBLE","dgesv")); #if defined(NO_APPEND_FORTRAN) lapack_lite_status__ = dgesv(&n,&nrhs,DDATA(a),&lda,LDATA(ipiv),DDATA(b),&ldb,&info); #else lapack_lite_status__ = dgesv_(&n,&nrhs,DDATA(a),&lda,LDATA(ipiv),DDATA(b),&ldb,&info); #endif return Py_BuildValue("{s:l,s:l,s:l,s:l,s:l,s:l}","dgesv_",lapack_lite_status__,"n",n,"nrhs",nrhs,"lda",lda,"ldb",ldb,"info",info); } static PyObject *lapack_lite_dgesvd(PyObject *self, PyObject *args) { int lapack_lite_status__; char jobu; char jobvt; long int m; long int n; PyObject *a; long int lda; PyObject *s; PyObject *u; long int ldu; PyObject *vt; long int ldvt; PyObject *work; long int lwork; long int info; TRY(PyArg_ParseTuple(args,"ccllOlOOlOlOll",&jobu,&jobvt,&m,&n,&a,&lda,&s,&u,&ldu,&vt,&ldvt,&work,&lwork,&info)); TRY(lapack_lite_CheckObject(a,PyArray_DOUBLE,"a","PyArray_DOUBLE","dgesvd")); TRY(lapack_lite_CheckObject(s,PyArray_DOUBLE,"s","PyArray_DOUBLE","dgesvd")); TRY(lapack_lite_CheckObject(u,PyArray_DOUBLE,"u","PyArray_DOUBLE","dgesvd")); TRY(lapack_lite_CheckObject(vt,PyArray_DOUBLE,"vt","PyArray_DOUBLE","dgesvd")); TRY(lapack_lite_CheckObject(work,PyArray_DOUBLE,"work","PyArray_DOUBLE","dgesvd")); #if defined(NO_APPEND_FORTRAN) lapack_lite_status__ = dgesvd(&jobu,&jobvt,&m,&n,DDATA(a),&lda,DDATA(s),DDATA(u),&ldu,DDATA(vt),&ldvt,DDATA(work),&lwork,&info); #else lapack_lite_status__ = dgesvd_(&jobu,&jobvt,&m,&n,DDATA(a),&lda,DDATA(s),DDATA(u),&ldu,DDATA(vt),&ldvt,DDATA(work),&lwork,&info); #endif return Py_BuildValue("{s:l,s:c,s:c,s:l,s:l,s:l,s:l,s:l,s:l,s:l}","dgesvd_",lapack_lite_status__,"jobu",jobu,"jobvt",jobvt,"m",m,"n",n,"lda",lda,"ldu",ldu,"ldvt",ldvt,"lwork",lwork,"info",info); } static PyObject *lapack_lite_dgetrf(PyObject *self, PyObject *args) { int lapack_lite_status__; long int m; long int n; PyObject *a; long int lda; PyObject *ipiv; long int info; TRY(PyArg_ParseTuple(args,"llOlOl",&m,&n,&a,&lda,&ipiv,&info)); TRY(lapack_lite_CheckObject(a,PyArray_DOUBLE,"a","PyArray_DOUBLE","dgetrf")); TRY(lapack_lite_CheckObject(ipiv,PyArray_LONG,"ipiv","PyArray_LONG","dgetrf")); #if defined(NO_APPEND_FORTRAN) lapack_lite_status__ = dgetrf(&m,&n,DDATA(a),&lda,LDATA(ipiv),&info); #else lapack_lite_status__ = dgetrf_(&m,&n,DDATA(a),&lda,LDATA(ipiv),&info); #endif return Py_BuildValue("{s:l,s:l,s:l,s:l,s:l}","dgetrf_",lapack_lite_status__,"m",m,"n",n,"lda",lda,"info",info); } static PyObject *lapack_lite_zgeev(PyObject *self, PyObject *args) { int lapack_lite_status__; char jobvl; char jobvr; long int n; PyObject *a; long int lda; PyObject *w; PyObject *vl; long int ldvl; PyObject *vr; long int ldvr; PyObject *work; long int lwork; PyObject *rwork; long int info; TRY(PyArg_ParseTuple(args,"cclOlOOlOlOlOl",&jobvl,&jobvr,&n,&a,&lda,&w,&vl,&ldvl,&vr,&ldvr,&work,&lwork,&rwork,&info)); TRY(lapack_lite_CheckObject(a,PyArray_CDOUBLE,"a","PyArray_CDOUBLE","zgeev")); TRY(lapack_lite_CheckObject(w,PyArray_CDOUBLE,"w","PyArray_CDOUBLE","zgeev")); TRY(lapack_lite_CheckObject(vl,PyArray_CDOUBLE,"vl","PyArray_CDOUBLE","zgeev")); TRY(lapack_lite_CheckObject(vr,PyArray_CDOUBLE,"vr","PyArray_CDOUBLE","zgeev")); TRY(lapack_lite_CheckObject(work,PyArray_CDOUBLE,"work","PyArray_CDOUBLE","zgeev")); TRY(lapack_lite_CheckObject(rwork,PyArray_DOUBLE,"rwork","PyArray_DOUBLE","zgeev")); #if defined(NO_APPEND_FORTRAN) lapack_lite_status__ = zgeev(&jobvl,&jobvr,&n,ZDATA(a),&lda,ZDATA(w),ZDATA(vl),&ldvl,ZDATA(vr),&ldvr,ZDATA(work),&lwork,DDATA(rwork),&info); #else lapack_lite_status__ = zgeev_(&jobvl,&jobvr,&n,ZDATA(a),&lda,ZDATA(w),ZDATA(vl),&ldvl,ZDATA(vr),&ldvr,ZDATA(work),&lwork,DDATA(rwork),&info); #endif return Py_BuildValue("{s:l,s:c,s:c,s:l,s:l,s:l,s:l,s:l,s:l}","zgeev_",lapack_lite_status__,"jobvl",jobvl,"jobvr",jobvr,"n",n,"lda",lda,"ldvl",ldvl,"ldvr",ldvr,"lwork",lwork,"info",info); } static PyObject *lapack_lite_zgelss(PyObject *self, PyObject *args) { int lapack_lite_status__; long int m; long int n; long int nrhs; PyObject *a; long int lda; PyObject *b; long int ldb; PyObject *s; double rcond; long int rank; PyObject *work; long int lwork; PyObject *rwork; long int info; TRY(PyArg_ParseTuple(args,"lllOlOlOdlOlOl",&m,&n,&nrhs,&a,&lda,&b,&ldb,&s,&rcond,&rank,&work,&lwork,&rwork,&info)); TRY(lapack_lite_CheckObject(a,PyArray_CDOUBLE,"a","PyArray_CDOUBLE","zgelss")); TRY(lapack_lite_CheckObject(b,PyArray_CDOUBLE,"b","PyArray_CDOUBLE","zgelss")); TRY(lapack_lite_CheckObject(s,PyArray_DOUBLE,"s","PyArray_DOUBLE","zgelss")); TRY(lapack_lite_CheckObject(work,PyArray_CDOUBLE,"work","PyArray_CDOUBLE","zgelss")); TRY(lapack_lite_CheckObject(rwork,PyArray_DOUBLE,"rwork","PyArray_DOUBLE","zgelss")); #if defined(NO_APPEND_FORTRAN) lapack_lite_status__ = zgelss(&m,&n,&nrhs,ZDATA(a),&lda,ZDATA(b),&ldb,DDATA(s),&rcond,&rank,ZDATA(work),&lwork,DDATA(rwork),&info); #else lapack_lite_status__ = zgelss_(&m,&n,&nrhs,ZDATA(a),&lda,ZDATA(b),&ldb,DDATA(s),&rcond,&rank,ZDATA(work),&lwork,DDATA(rwork),&info); #endif return Py_BuildValue("{s:l,s:l,s:l,s:l,s:l,s:l,s:l,s:l,s:l}","zgelss_",lapack_lite_status__,"m",m,"n",n,"nrhs",nrhs,"lda",lda,"ldb",ldb,"rank",rank,"lwork",lwork,"info",info); } static PyObject *lapack_lite_zgesv(PyObject *self, PyObject *args) { int lapack_lite_status__; long int n; long int nrhs; PyObject *a; long int lda; PyObject *ipiv; PyObject *b; long int ldb; long int info; TRY(PyArg_ParseTuple(args,"llOlOOll",&n,&nrhs,&a,&lda,&ipiv,&b,&ldb,&info)); TRY(lapack_lite_CheckObject(a,PyArray_CDOUBLE,"a","PyArray_CDOUBLE","zgesv")); TRY(lapack_lite_CheckObject(ipiv,PyArray_LONG,"ipiv","PyArray_LONG","zgesv")); TRY(lapack_lite_CheckObject(b,PyArray_CDOUBLE,"b","PyArray_CDOUBLE","zgesv")); #if defined(NO_APPEND_FORTRAN) lapack_lite_status__ = zgesv(&n,&nrhs,ZDATA(a),&lda,LDATA(ipiv),ZDATA(b),&ldb,&info); #else lapack_lite_status__ = zgesv_(&n,&nrhs,ZDATA(a),&lda,LDATA(ipiv),ZDATA(b),&ldb,&info); #endif return Py_BuildValue("{s:l,s:l,s:l,s:l,s:l,s:l}","zgesv_",lapack_lite_status__,"n",n,"nrhs",nrhs,"lda",lda,"ldb",ldb,"info",info); } static PyObject *lapack_lite_zgesvd(PyObject *self, PyObject *args) { int lapack_lite_status__; char jobu; char jobvt; long int m; long int n; PyObject *a; long int lda; PyObject *s; PyObject *u; long int ldu; PyObject *vt; long int ldvt; PyObject *work; long int lwork; PyObject *rwork; long int info; TRY(PyArg_ParseTuple(args,"ccllOlOOlOlOlOl",&jobu,&jobvt,&m,&n,&a,&lda,&s,&u,&ldu,&vt,&ldvt,&work,&lwork,&rwork,&info)); TRY(lapack_lite_CheckObject(a,PyArray_CDOUBLE,"a","PyArray_CDOUBLE","zgesvd")); TRY(lapack_lite_CheckObject(s,PyArray_DOUBLE,"s","PyArray_DOUBLE","zgesvd")); TRY(lapack_lite_CheckObject(u,PyArray_CDOUBLE,"u","PyArray_CDOUBLE","zgesvd")); TRY(lapack_lite_CheckObject(vt,PyArray_CDOUBLE,"vt","PyArray_CDOUBLE","zgesvd")); TRY(lapack_lite_CheckObject(work,PyArray_CDOUBLE,"work","PyArray_CDOUBLE","zgesvd")); TRY(lapack_lite_CheckObject(rwork,PyArray_DOUBLE,"rwork","PyArray_DOUBLE","zgesvd")); #if defined(NO_APPEND_FORTRAN) lapack_lite_status__ = zgesvd(&jobu,&jobvt,&m,&n,ZDATA(a),&lda,DDATA(s),ZDATA(u),&ldu,ZDATA(vt),&ldvt,ZDATA(work),&lwork,DDATA(rwork),&info); #else lapack_lite_status__ = zgesvd_(&jobu,&jobvt,&m,&n,ZDATA(a),&lda,DDATA(s),ZDATA(u),&ldu,ZDATA(vt),&ldvt,ZDATA(work),&lwork,DDATA(rwork),&info); #endif return Py_BuildValue("{s:l,s:c,s:c,s:l,s:l,s:l,s:l,s:l,s:l,s:l}","zgesvd_",lapack_lite_status__,"jobu",jobu,"jobvt",jobvt,"m",m,"n",n,"lda",lda,"ldu",ldu,"ldvt",ldvt,"lwork",lwork,"info",info); } static PyObject *lapack_lite_zgetrf(PyObject *self, PyObject *args) { int lapack_lite_status__; long int m; long int n; PyObject *a; long int lda; PyObject *ipiv; long int info; TRY(PyArg_ParseTuple(args,"llOlOl",&m,&n,&a,&lda,&ipiv,&info)); TRY(lapack_lite_CheckObject(a,PyArray_CDOUBLE,"a","PyArray_CDOUBLE","zgetrf")); TRY(lapack_lite_CheckObject(ipiv,PyArray_LONG,"ipiv","PyArray_LONG","zgetrf")); #if defined(NO_APPEND_FORTRAN) lapack_lite_status__ = zgetrf(&m,&n,ZDATA(a),&lda,LDATA(ipiv),&info); #else lapack_lite_status__ = zgetrf_(&m,&n,ZDATA(a),&lda,LDATA(ipiv),&info); #endif return Py_BuildValue("{s:l,s:l,s:l,s:l,s:l}","zgetrf_",lapack_lite_status__,"m",m,"n",n,"lda",lda,"info",info); } static struct PyMethodDef lapack_lite_module_methods[] = { {"dgeev",lapack_lite_dgeev,1}, {"dgelss",lapack_lite_dgelss,1}, {"dgesv",lapack_lite_dgesv,1}, {"dgesvd",lapack_lite_dgesvd,1}, {"dgetrf",lapack_lite_dgetrf,1}, {"zgeev",lapack_lite_zgeev,1}, {"zgelss",lapack_lite_zgelss,1}, {"zgesv",lapack_lite_zgesv,1}, {"zgesvd",lapack_lite_zgesvd,1}, {"zgetrf",lapack_lite_zgetrf,1}, { NULL,NULL,0} }; static PyObject *lapack_liteError; void initlapack_lite() { PyObject *m,*d; m = Py_InitModule("lapack_lite",lapack_lite_module_methods); import_array(); d = PyModule_GetDict(m); ErrorObject = LapackError(); PyDict_SetItemString(d,"LapackError",ErrorObject); }