comparison funm_files/swap.c @ 0:8f23314345f4 draft

Create local repository for matrix toolboxes. Step #0 done.
author Antonio Pino Robles <data.script93@gmail.com>
date Wed, 06 May 2015 14:56:53 +0200
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:8f23314345f4
1 /*
2 * C mex file for MATLAB that implements LAPACK ctrexc_ for
3 * reordering the complex Schur decomposition A = UTU^* such that
4 * T is in block form. This program combines Cswap and Crealswap
5 * which deal with the complex and the real case respectively.
6 *
7 * Input matrices 'U' and 'T' are those from Schur decompositon
8 *
9 * Called by [U,T] = swap(U,T,M)
10 *
11 * The matrix M is produced using the m-files
12 * >> m = blocking(T,noplot,delta); where delta is some tolerance
13 * default: delta = 0.1;
14 * >> [n,M,ind,totalswaps] = swapping5(m);
15 *
16 * Output matrices 'U' and 'T' are the updated Schur decomposition
17 *
18 */
19
20 #include "mex.h"
21 #include "matrix.h"
22 #include "fort.h" /* defines mat2fort and fort2mat */
23
24 void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[])
25 {
26
27 /* compq=V then the matrix of Schur vectors is updated */
28
29 char *compq = "V", msg[80];
30 int n, ldt, ldq, i, info, ifst, ilst, lengthm;
31 double *t, *q, *m, *work;
32 mxArray *mm;
33
34 /* expect 3 inputs and 2 outputs */
35 if ((nrhs != 3) || (nlhs != 2)){
36 mexErrMsgTxt("Expected 3 inputs and 2 outputs");
37 }
38
39 /* Sizes of stuff */
40
41 n = mxGetN( prhs[0] );
42 ldt = n;
43 ldq = n;
44 lengthm = mxGetM( prhs[2] );
45
46 /* Copy input and output matrices to stuff */
47
48 mm = mxDuplicateArray( prhs[2] );
49 m = mxGetPr(mm);
50
51 if (mxIsComplex( prhs[1] )) {
52
53 /* Convert complex input to complex FORTRAN format */
54
55 q = mat2fort( prhs[0], ldq, n );
56 t = mat2fort( prhs[1], ldt, n ); }
57
58 else {
59
60 plhs[0] = mxCreateDoubleMatrix(n,n,mxREAL);
61 plhs[1] = mxCreateDoubleMatrix(n,n,mxREAL);
62
63 plhs[1] = mxDuplicateArray( prhs[1] );
64 t = mxGetPr(plhs[1]);
65 plhs[0] = mxDuplicateArray( prhs[0] );
66 q = mxGetPr(plhs[0]);
67 }
68
69 /* Allocate workspace */
70
71 work = (double *)mxCalloc(n,sizeof(double));
72
73 /* Do the loop */
74
75 for ( i = 0; i < lengthm; i++) {
76 info = 0;
77 ifst = m[lengthm + i];
78 ilst = m[i];
79 if (mxIsComplex( prhs[1] )) {
80 ztrexc(compq,&n,t,&ldt,q,&ldq,&ifst,&ilst,&info); }
81 else {
82 dtrexc(compq,&n,t,&ldt,q,&ldq,&ifst,&ilst,work,&info);
83 }
84 if (info < 0){
85 sprintf(msg, "The routine DTREXC has detected an error");
86 mexErrMsgTxt(msg);
87 }
88 }
89
90 /* Convert output to MATLAB format */
91
92 if (mxIsComplex( prhs[1] )) {
93 plhs[0] = fort2mat( q, ldq, ldq, n );
94 plhs[1] = fort2mat( t, ldt, ldt, n );
95 }
96
97 /* Free up memory */
98
99 mxFree(work);
100 }
101