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