lib/clib/ssvdc.c
Go to the documentation of this file.
1 /*
2  Singular value decomposition
3  interfacing with linpack
4 */
5 
6 #include "eus.h"
7 
8 #define ismatrix(p) ((isarray(p) && \
9  p->c.ary.rank==makeint(2) && \
10  elmtypeof(p->c.ary.entity)==ELM_FLOAT))
11 #define rowsize(p) (intval(p->c.ary.dim[0]))
12 #define colsize(p) (intval(p->c.ary.dim[1]))
13 
14 
15 /* int r_sign; */
16 
17 pointer SSVDC(ctx,n,argv)
18 context *ctx;
19 int n;
20 register pointer argv[];
21 { pointer a=argv[0];
22  float *amat,e[10],work[10];
23  int col,row,ucol,urow,vcol,vrow,flag=11,info;
24  pointer s,u,v;
25  numunion nu;
26 
27  ckarg(4);
28  if (!ismatrix(a)) error(E_NOARRAY);
29  amat=a->c.ary.entity->c.fvec.fv;
30  col=colsize(a); row=rowsize(a);
31 
32  if (debug) printf("ssvdc: row=%d col=%d\n",row,col);
33 
34  s=argv[1];
35  if (!isfltvector(s)) error(E_FLOATVECTOR);
36  if (vecsize(s)<col) error(E_VECINDEX);
37 
38  u=argv[2];
39  if (!ismatrix(u)) error(E_NOARRAY);
40  ucol=colsize(u); urow=rowsize(u);
41  if (ucol!=col || urow!=col) error(E_VECINDEX);
42 
43  v=argv[3];
44  if (!ismatrix(v)) error(E_NOARRAY);
45  vcol=colsize(v); vrow=rowsize(v);
46  if (vcol!=row || vrow!=row) error(E_VECINDEX);
47 
48  ssvdc_(amat, &col, &col, &row, s->c.fvec.fv,
49  e,
50  u->c.ary.entity->c.fvec.fv,
51  &col,
52  v->c.ary.entity->c.fvec.fv,
53  &row,
54  work,
55  &flag, &info);
56  return(makeint(info));
57  }
58 
59 ssvdc(ctx,n,argv)
60 context *ctx;
61 int n;
62 pointer argv[];
63 {
64  defun(ctx,"SSVDC",argv[0],SSVDC,NULL);}
65 
numunion
Definition: eus.h:428
E_FLOATVECTOR
@ E_FLOATVECTOR
Definition: eus.h:981
defun
defun("ADR_TO_STRING", mod, ADR_TO_STRING)
makeint
#define makeint(v)
Definition: sfttest.c:2
context
Definition: eus.h:524
s
short s
Definition: structsize.c:2
floatvector::fv
eusfloat_t fv[1]
Definition: eus.h:309
eus.h
cell::cellunion::ary
struct arrayheader ary
Definition: eus.h:413
cell::c
union cell::cellunion c
ssvdc_
ssvdc_()
NULL
#define NULL
Definition: transargv.c:8
SSVDC
pointer SSVDC(context *ctx, int n, argv)
Definition: lib/clib/ssvdc.c:17
error
pointer error(enum errorcode ec,...) pointer error(va_alist) va_dcl
Definition: eus.c:297
colsize
#define colsize(p)
Definition: matrix.c:735
E_NOARRAY
@ E_NOARRAY
Definition: eus.h:995
cell
Definition: eus.h:381
E_VECINDEX
@ E_VECINDEX
Definition: eus.h:983
rowsize
#define rowsize(p)
Definition: matrix.c:734
ssvdc
ssvdc(context *ctx, int n, argv)
Definition: lib/clib/ssvdc.c:59
arrayheader::entity
pointer entity
Definition: eus.h:313
ismatrix
#define ismatrix(p)
Definition: matrix.c:731
a
char a[26]
Definition: freq.c:4
cell::cellunion::fvec
struct floatvector fvec
Definition: eus.h:415
n
GLfloat n[6][3]
Definition: cube.c:15
v
GLfloat v[8][3]
Definition: cube.c:21
ckarg
ckarg(2)


euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 15 2023 02:06:43