diff options
author | Alberto Ruiz <aruiz@um.es> | 2009-12-28 17:59:18 +0000 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2009-12-28 17:59:18 +0000 |
commit | 3d15dffe52629fd621ad548b671c3043caefb0d0 (patch) | |
tree | 63fed8084a74482b74199cc3ec91136aa110c79e /lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c | |
parent | b2715e91d7aef5cee1b64b641b8f173167a7145a (diff) |
additional eig functions
Diffstat (limited to 'lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c')
-rw-r--r-- | lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c | 41 |
1 files changed, 23 insertions, 18 deletions
diff --git a/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c b/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c index db94cc6..06c2479 100644 --- a/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c +++ b/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c | |||
@@ -274,19 +274,20 @@ int svd_l_Cdd(KCMAT(a),CMAT(u), DVEC(s),CMAT(v)) { | |||
274 | 274 | ||
275 | //////////////////// general complex eigensystem //////////// | 275 | //////////////////// general complex eigensystem //////////// |
276 | 276 | ||
277 | int eig_l_C(KCMAT(a),CMAT(u), CVEC(s),CMAT(v)) { | 277 | int eig_l_C(KCMAT(a), CMAT(u), CVEC(s),CMAT(v)) { |
278 | integer n = ar; | 278 | integer n = ar; |
279 | REQUIRES(n>=2 && ac==n && (ur==1 || (ur==n && uc==n)) && sn==n && (vr==1 || (vr==n && vc==n)),BAD_SIZE); | 279 | REQUIRES(ac==n && sn==n, BAD_SIZE); |
280 | REQUIRES(up==NULL || ur==n && uc==n, BAD_SIZE); | ||
281 | char jobvl = up==NULL?'N':'V'; | ||
282 | REQUIRES(vp==NULL || vr==n && vc==n, BAD_SIZE); | ||
283 | char jobvr = vp==NULL?'N':'V'; | ||
280 | DEBUGMSG("eig_l_C"); | 284 | DEBUGMSG("eig_l_C"); |
281 | double *B = (double*)malloc(2*n*n*sizeof(double)); | 285 | doublecomplex *B = (doublecomplex*)malloc(n*n*sizeof(doublecomplex)); |
282 | CHECK(!B,MEM); | 286 | CHECK(!B,MEM); |
283 | memcpy(B,ap,n*n*2*sizeof(double)); | 287 | memcpy(B,ap,n*n*sizeof(doublecomplex)); |
284 | |||
285 | double *rwork = (double*) malloc(2*n*sizeof(double)); | 288 | double *rwork = (double*) malloc(2*n*sizeof(double)); |
286 | CHECK(!rwork,MEM); | 289 | CHECK(!rwork,MEM); |
287 | integer lwork = -1; | 290 | integer lwork = -1; |
288 | char jobvl = ur==1?'N':'V'; | ||
289 | char jobvr = vr==1?'N':'V'; | ||
290 | integer res; | 291 | integer res; |
291 | // ask for optimal lwork | 292 | // ask for optimal lwork |
292 | doublecomplex ans; | 293 | doublecomplex ans; |
@@ -301,7 +302,7 @@ int eig_l_C(KCMAT(a),CMAT(u), CVEC(s),CMAT(v)) { | |||
301 | &res); | 302 | &res); |
302 | lwork = ceil(ans.r); | 303 | lwork = ceil(ans.r); |
303 | //printf("ans = %d\n",lwork); | 304 | //printf("ans = %d\n",lwork); |
304 | doublecomplex * work = (doublecomplex*)malloc(lwork*2*sizeof(double)); | 305 | doublecomplex * work = (doublecomplex*)malloc(lwork*sizeof(doublecomplex)); |
305 | CHECK(!work,MEM); | 306 | CHECK(!work,MEM); |
306 | //printf("zgeev\n"); | 307 | //printf("zgeev\n"); |
307 | zgeev_ (&jobvl,&jobvr, | 308 | zgeev_ (&jobvl,&jobvr, |
@@ -325,14 +326,16 @@ int eig_l_C(KCMAT(a),CMAT(u), CVEC(s),CMAT(v)) { | |||
325 | 326 | ||
326 | int eig_l_R(KDMAT(a),DMAT(u), CVEC(s),DMAT(v)) { | 327 | int eig_l_R(KDMAT(a),DMAT(u), CVEC(s),DMAT(v)) { |
327 | integer n = ar; | 328 | integer n = ar; |
328 | REQUIRES(n>=2 && ac == n && (ur==1 || (ur==n && uc==n)) && sn==n && (vr==1 || (vr==n && vc==n)),BAD_SIZE); | 329 | REQUIRES(ac==n && sn==n, BAD_SIZE); |
330 | REQUIRES(up==NULL || ur==n && uc==n, BAD_SIZE); | ||
331 | char jobvl = up==NULL?'N':'V'; | ||
332 | REQUIRES(vp==NULL || vr==n && vc==n, BAD_SIZE); | ||
333 | char jobvr = vp==NULL?'N':'V'; | ||
329 | DEBUGMSG("eig_l_R"); | 334 | DEBUGMSG("eig_l_R"); |
330 | double *B = (double*)malloc(n*n*sizeof(double)); | 335 | double *B = (double*)malloc(n*n*sizeof(double)); |
331 | CHECK(!B,MEM); | 336 | CHECK(!B,MEM); |
332 | memcpy(B,ap,n*n*sizeof(double)); | 337 | memcpy(B,ap,n*n*sizeof(double)); |
333 | integer lwork = -1; | 338 | integer lwork = -1; |
334 | char jobvl = ur==1?'N':'V'; | ||
335 | char jobvr = vr==1?'N':'V'; | ||
336 | integer res; | 339 | integer res; |
337 | // ask for optimal lwork | 340 | // ask for optimal lwork |
338 | double ans; | 341 | double ans; |
@@ -366,13 +369,14 @@ int eig_l_R(KDMAT(a),DMAT(u), CVEC(s),DMAT(v)) { | |||
366 | //////////////////// symmetric real eigensystem //////////// | 369 | //////////////////// symmetric real eigensystem //////////// |
367 | 370 | ||
368 | 371 | ||
369 | int eig_l_S(KDMAT(a),DVEC(s),DMAT(v)) { | 372 | int eig_l_S(int wantV,KDMAT(a),DVEC(s),DMAT(v)) { |
370 | integer n = ar; | 373 | integer n = ar; |
371 | REQUIRES(n>=2 && ac == n && sn==n && (vr==1 || (vr==n && vc==n)),BAD_SIZE); | 374 | REQUIRES(ac==n && sn==n, BAD_SIZE); |
375 | REQUIRES(vr==n && vc==n, BAD_SIZE); | ||
376 | char jobz = wantV?'V':'N'; | ||
372 | DEBUGMSG("eig_l_S"); | 377 | DEBUGMSG("eig_l_S"); |
373 | memcpy(vp,ap,n*n*sizeof(double)); | 378 | memcpy(vp,ap,n*n*sizeof(double)); |
374 | integer lwork = -1; | 379 | integer lwork = -1; |
375 | char jobz = vr==1?'N':'V'; | ||
376 | char uplo = 'U'; | 380 | char uplo = 'U'; |
377 | integer res; | 381 | integer res; |
378 | // ask for optimal lwork | 382 | // ask for optimal lwork |
@@ -399,15 +403,16 @@ int eig_l_S(KDMAT(a),DVEC(s),DMAT(v)) { | |||
399 | 403 | ||
400 | //////////////////// hermitian complex eigensystem //////////// | 404 | //////////////////// hermitian complex eigensystem //////////// |
401 | 405 | ||
402 | int eig_l_H(KCMAT(a),DVEC(s),CMAT(v)) { | 406 | int eig_l_H(int wantV,KCMAT(a),DVEC(s),CMAT(v)) { |
403 | integer n = ar; | 407 | integer n = ar; |
404 | REQUIRES(n>=2 && ac==n && sn==n && (vr==1 || (vr==n && vc==n)),BAD_SIZE); | 408 | REQUIRES(ac==n && sn==n, BAD_SIZE); |
409 | REQUIRES(vr==n && vc==n, BAD_SIZE); | ||
410 | char jobz = wantV?'V':'N'; | ||
405 | DEBUGMSG("eig_l_H"); | 411 | DEBUGMSG("eig_l_H"); |
406 | memcpy(vp,ap,2*n*n*sizeof(double)); | 412 | memcpy(vp,ap,2*n*n*sizeof(double)); |
407 | double *rwork = (double*) malloc((3*n-2)*sizeof(double)); | 413 | double *rwork = (double*) malloc((3*n-2)*sizeof(double)); |
408 | CHECK(!rwork,MEM); | 414 | CHECK(!rwork,MEM); |
409 | integer lwork = -1; | 415 | integer lwork = -1; |
410 | char jobz = vr==1?'N':'V'; | ||
411 | char uplo = 'U'; | 416 | char uplo = 'U'; |
412 | integer res; | 417 | integer res; |
413 | // ask for optimal lwork | 418 | // ask for optimal lwork |
@@ -421,7 +426,7 @@ int eig_l_H(KCMAT(a),DVEC(s),CMAT(v)) { | |||
421 | &res); | 426 | &res); |
422 | lwork = ceil(ans.r); | 427 | lwork = ceil(ans.r); |
423 | //printf("ans = %d\n",lwork); | 428 | //printf("ans = %d\n",lwork); |
424 | doublecomplex * work = (doublecomplex*)malloc(lwork*2*sizeof(double)); | 429 | doublecomplex * work = (doublecomplex*)malloc(lwork*sizeof(doublecomplex)); |
425 | CHECK(!work,MEM); | 430 | CHECK(!work,MEM); |
426 | zheev_ (&jobz,&uplo, | 431 | zheev_ (&jobz,&uplo, |
427 | &n,(doublecomplex*)vp,&n, | 432 | &n,(doublecomplex*)vp,&n, |