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_dhsein( int matrix_order, char job, char eigsrc, char initv,
00038 lapack_logical* select, lapack_int n,
00039 const double* h, lapack_int ldh, double* wr,
00040 const double* wi, double* vl, lapack_int ldvl,
00041 double* vr, lapack_int ldvr, lapack_int mm,
00042 lapack_int* m, lapack_int* ifaill,
00043 lapack_int* ifailr )
00044 {
00045 lapack_int info = 0;
00046 double* work = NULL;
00047 if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
00048 LAPACKE_xerbla( "LAPACKE_dhsein", -1 );
00049 return -1;
00050 }
00051 #ifndef LAPACK_DISABLE_NAN_CHECK
00052
00053 if( LAPACKE_dge_nancheck( matrix_order, n, n, h, ldh ) ) {
00054 return -7;
00055 }
00056 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
00057 if( LAPACKE_dge_nancheck( matrix_order, n, mm, vl, ldvl ) ) {
00058 return -11;
00059 }
00060 }
00061 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
00062 if( LAPACKE_dge_nancheck( matrix_order, n, mm, vr, ldvr ) ) {
00063 return -13;
00064 }
00065 }
00066 if( LAPACKE_d_nancheck( n, wi, 1 ) ) {
00067 return -10;
00068 }
00069 if( LAPACKE_d_nancheck( n, wr, 1 ) ) {
00070 return -9;
00071 }
00072 #endif
00073
00074 work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) * MAX(1,n+2) );
00075 if( work == NULL ) {
00076 info = LAPACK_WORK_MEMORY_ERROR;
00077 goto exit_level_0;
00078 }
00079
00080 info = LAPACKE_dhsein_work( matrix_order, job, eigsrc, initv, select, n, h,
00081 ldh, wr, wi, vl, ldvl, vr, ldvr, mm, m, work,
00082 ifaill, ifailr );
00083
00084 LAPACKE_free( work );
00085 exit_level_0:
00086 if( info == LAPACK_WORK_MEMORY_ERROR ) {
00087 LAPACKE_xerbla( "LAPACKE_dhsein", info );
00088 }
00089 return info;
00090 }