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_zhegvd( int matrix_order, lapack_int itype, char jobz,
00038 char uplo, lapack_int n, lapack_complex_double* a,
00039 lapack_int lda, lapack_complex_double* b,
00040 lapack_int ldb, double* w )
00041 {
00042 lapack_int info = 0;
00043 lapack_int liwork = -1;
00044 lapack_int lrwork = -1;
00045 lapack_int lwork = -1;
00046 lapack_int* iwork = NULL;
00047 double* rwork = NULL;
00048 lapack_complex_double* work = NULL;
00049 lapack_int iwork_query;
00050 double rwork_query;
00051 lapack_complex_double work_query;
00052 if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
00053 LAPACKE_xerbla( "LAPACKE_zhegvd", -1 );
00054 return -1;
00055 }
00056 #ifndef LAPACK_DISABLE_NAN_CHECK
00057
00058 if( LAPACKE_zge_nancheck( matrix_order, n, n, a, lda ) ) {
00059 return -6;
00060 }
00061 if( LAPACKE_zge_nancheck( matrix_order, n, n, b, ldb ) ) {
00062 return -8;
00063 }
00064 #endif
00065
00066 info = LAPACKE_zhegvd_work( matrix_order, itype, jobz, uplo, n, a, lda, b,
00067 ldb, w, &work_query, lwork, &rwork_query,
00068 lrwork, &iwork_query, liwork );
00069 if( info != 0 ) {
00070 goto exit_level_0;
00071 }
00072 liwork = (lapack_int)iwork_query;
00073 lrwork = (lapack_int)rwork_query;
00074 lwork = LAPACK_Z2INT( work_query );
00075
00076 iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
00077 if( iwork == NULL ) {
00078 info = LAPACK_WORK_MEMORY_ERROR;
00079 goto exit_level_0;
00080 }
00081 rwork = (double*)LAPACKE_malloc( sizeof(double) * lrwork );
00082 if( rwork == NULL ) {
00083 info = LAPACK_WORK_MEMORY_ERROR;
00084 goto exit_level_1;
00085 }
00086 work = (lapack_complex_double*)
00087 LAPACKE_malloc( sizeof(lapack_complex_double) * lwork );
00088 if( work == NULL ) {
00089 info = LAPACK_WORK_MEMORY_ERROR;
00090 goto exit_level_2;
00091 }
00092
00093 info = LAPACKE_zhegvd_work( matrix_order, itype, jobz, uplo, n, a, lda, b,
00094 ldb, w, work, lwork, rwork, lrwork, iwork,
00095 liwork );
00096
00097 LAPACKE_free( work );
00098 exit_level_2:
00099 LAPACKE_free( rwork );
00100 exit_level_1:
00101 LAPACKE_free( iwork );
00102 exit_level_0:
00103 if( info == LAPACK_WORK_MEMORY_ERROR ) {
00104 LAPACKE_xerbla( "LAPACKE_zhegvd", info );
00105 }
00106 return info;
00107 }