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_dhgeqz( int matrix_order, char job, char compq, char compz,
00038 lapack_int n, lapack_int ilo, lapack_int ihi,
00039 double* h, lapack_int ldh, double* t, lapack_int ldt,
00040 double* alphar, double* alphai, double* beta,
00041 double* q, lapack_int ldq, double* z,
00042 lapack_int ldz )
00043 {
00044 lapack_int info = 0;
00045 lapack_int lwork = -1;
00046 double* work = NULL;
00047 double work_query;
00048 if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
00049 LAPACKE_xerbla( "LAPACKE_dhgeqz", -1 );
00050 return -1;
00051 }
00052 #ifndef LAPACK_DISABLE_NAN_CHECK
00053
00054 if( LAPACKE_dge_nancheck( matrix_order, n, n, h, ldh ) ) {
00055 return -8;
00056 }
00057 if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
00058 if( LAPACKE_dge_nancheck( matrix_order, n, n, q, ldq ) ) {
00059 return -15;
00060 }
00061 }
00062 if( LAPACKE_dge_nancheck( matrix_order, n, n, t, ldt ) ) {
00063 return -10;
00064 }
00065 if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
00066 if( LAPACKE_dge_nancheck( matrix_order, n, n, z, ldz ) ) {
00067 return -17;
00068 }
00069 }
00070 #endif
00071
00072 info = LAPACKE_dhgeqz_work( matrix_order, job, compq, compz, n, ilo, ihi, h,
00073 ldh, t, ldt, alphar, alphai, beta, q, ldq, z,
00074 ldz, &work_query, lwork );
00075 if( info != 0 ) {
00076 goto exit_level_0;
00077 }
00078 lwork = (lapack_int)work_query;
00079
00080 work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
00081 if( work == NULL ) {
00082 info = LAPACK_WORK_MEMORY_ERROR;
00083 goto exit_level_0;
00084 }
00085
00086 info = LAPACKE_dhgeqz_work( matrix_order, job, compq, compz, n, ilo, ihi, h,
00087 ldh, t, ldt, alphar, alphai, beta, q, ldq, z,
00088 ldz, work, lwork );
00089
00090 LAPACKE_free( work );
00091 exit_level_0:
00092 if( info == LAPACK_WORK_MEMORY_ERROR ) {
00093 LAPACKE_xerbla( "LAPACKE_dhgeqz", info );
00094 }
00095 return info;
00096 }