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_dsyevx( int matrix_order, char jobz, char range, char uplo,
00038 lapack_int n, double* a, lapack_int lda, double vl,
00039 double vu, lapack_int il, lapack_int iu,
00040 double abstol, lapack_int* m, double* w, double* z,
00041 lapack_int ldz, lapack_int* ifail )
00042 {
00043 lapack_int info = 0;
00044 lapack_int lwork = -1;
00045 lapack_int* iwork = NULL;
00046 double* work = NULL;
00047 double work_query;
00048 if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
00049 LAPACKE_xerbla( "LAPACKE_dsyevx", -1 );
00050 return -1;
00051 }
00052 #ifndef LAPACK_DISABLE_NAN_CHECK
00053
00054 if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
00055 return -6;
00056 }
00057 if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
00058 return -12;
00059 }
00060 if( LAPACKE_lsame( range, 'v' ) ) {
00061 if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
00062 return -8;
00063 }
00064 }
00065 if( LAPACKE_lsame( range, 'v' ) ) {
00066 if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
00067 return -9;
00068 }
00069 }
00070 #endif
00071
00072 iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,5*n) );
00073 if( iwork == NULL ) {
00074 info = LAPACK_WORK_MEMORY_ERROR;
00075 goto exit_level_0;
00076 }
00077
00078 info = LAPACKE_dsyevx_work( matrix_order, jobz, range, uplo, n, a, lda, vl,
00079 vu, il, iu, abstol, m, w, z, ldz, &work_query,
00080 lwork, iwork, ifail );
00081 if( info != 0 ) {
00082 goto exit_level_1;
00083 }
00084 lwork = (lapack_int)work_query;
00085
00086 work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
00087 if( work == NULL ) {
00088 info = LAPACK_WORK_MEMORY_ERROR;
00089 goto exit_level_1;
00090 }
00091
00092 info = LAPACKE_dsyevx_work( matrix_order, jobz, range, uplo, n, a, lda, vl,
00093 vu, il, iu, abstol, m, w, z, ldz, work, lwork,
00094 iwork, ifail );
00095
00096 LAPACKE_free( work );
00097 exit_level_1:
00098 LAPACKE_free( iwork );
00099 exit_level_0:
00100 if( info == LAPACK_WORK_MEMORY_ERROR ) {
00101 LAPACKE_xerbla( "LAPACKE_dsyevx", info );
00102 }
00103 return info;
00104 }