00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034 #include "lapacke.h"
00035 #include "lapacke_utils.h"
00036
00037 lapack_int LAPACKE_ctgevc( int matrix_order, char side, char howmny,
00038 const lapack_logical* select, lapack_int n,
00039 const lapack_complex_float* s, lapack_int lds,
00040 const lapack_complex_float* p, lapack_int ldp,
00041 lapack_complex_float* vl, lapack_int ldvl,
00042 lapack_complex_float* vr, lapack_int ldvr,
00043 lapack_int mm, lapack_int* m )
00044 {
00045 lapack_int info = 0;
00046 float* rwork = NULL;
00047 lapack_complex_float* work = NULL;
00048 if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
00049 LAPACKE_xerbla( "LAPACKE_ctgevc", -1 );
00050 return -1;
00051 }
00052 #ifndef LAPACK_DISABLE_NAN_CHECK
00053
00054 if( LAPACKE_cge_nancheck( matrix_order, n, n, p, ldp ) ) {
00055 return -8;
00056 }
00057 if( LAPACKE_cge_nancheck( matrix_order, n, n, s, lds ) ) {
00058 return -6;
00059 }
00060 if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
00061 if( LAPACKE_cge_nancheck( matrix_order, n, mm, vl, ldvl ) ) {
00062 return -10;
00063 }
00064 }
00065 if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
00066 if( LAPACKE_cge_nancheck( matrix_order, n, mm, vr, ldvr ) ) {
00067 return -12;
00068 }
00069 }
00070 #endif
00071
00072 rwork = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n) );
00073 if( rwork == NULL ) {
00074 info = LAPACK_WORK_MEMORY_ERROR;
00075 goto exit_level_0;
00076 }
00077 work = (lapack_complex_float*)
00078 LAPACKE_malloc( sizeof(lapack_complex_float) * MAX(1,2*n) );
00079 if( work == NULL ) {
00080 info = LAPACK_WORK_MEMORY_ERROR;
00081 goto exit_level_1;
00082 }
00083
00084 info = LAPACKE_ctgevc_work( matrix_order, side, howmny, select, n, s, lds,
00085 p, ldp, vl, ldvl, vr, ldvr, mm, m, work,
00086 rwork );
00087
00088 LAPACKE_free( work );
00089 exit_level_1:
00090 LAPACKE_free( rwork );
00091 exit_level_0:
00092 if( info == LAPACK_WORK_MEMORY_ERROR ) {
00093 LAPACKE_xerbla( "LAPACKE_ctgevc", info );
00094 }
00095 return info;
00096 }