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_cunmbr( int matrix_order, char vect, char side, char trans,
00038 lapack_int m, lapack_int n, lapack_int k,
00039 const lapack_complex_float* a, lapack_int lda,
00040 const lapack_complex_float* tau,
00041 lapack_complex_float* c, lapack_int ldc )
00042 {
00043 lapack_int info = 0;
00044 lapack_int lwork = -1;
00045 lapack_complex_float* work = NULL;
00046 lapack_complex_float work_query;
00047 if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
00048 LAPACKE_xerbla( "LAPACKE_cunmbr", -1 );
00049 return -1;
00050 }
00051 #ifndef LAPACK_DISABLE_NAN_CHECK
00052
00053 lapack_int nq = LAPACKE_lsame( side, 'l' ) ? m : n;
00054 lapack_int r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k);
00055 if( LAPACKE_cge_nancheck( matrix_order, r, MIN(nq,k), a, lda ) ) {
00056 return -8;
00057 }
00058 if( LAPACKE_cge_nancheck( matrix_order, m, n, c, ldc ) ) {
00059 return -11;
00060 }
00061 if( LAPACKE_c_nancheck( MIN(nq,k), tau, 1 ) ) {
00062 return -10;
00063 }
00064 #endif
00065
00066 info = LAPACKE_cunmbr_work( matrix_order, vect, side, trans, m, n, k, a,
00067 lda, tau, c, ldc, &work_query, lwork );
00068 if( info != 0 ) {
00069 goto exit_level_0;
00070 }
00071 lwork = LAPACK_C2INT( work_query );
00072
00073 work = (lapack_complex_float*)
00074 LAPACKE_malloc( sizeof(lapack_complex_float) * lwork );
00075 if( work == NULL ) {
00076 info = LAPACK_WORK_MEMORY_ERROR;
00077 goto exit_level_0;
00078 }
00079
00080 info = LAPACKE_cunmbr_work( matrix_order, vect, side, trans, m, n, k, a,
00081 lda, tau, c, ldc, work, lwork );
00082
00083 LAPACKE_free( work );
00084 exit_level_0:
00085 if( info == LAPACK_WORK_MEMORY_ERROR ) {
00086 LAPACKE_xerbla( "LAPACKE_cunmbr", info );
00087 }
00088 return info;
00089 }