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_ssbgst_work( int matrix_order, char vect, char uplo,
00038 lapack_int n, lapack_int ka, lapack_int kb,
00039 float* ab, lapack_int ldab, const float* bb,
00040 lapack_int ldbb, float* x, lapack_int ldx,
00041 float* work )
00042 {
00043 lapack_int info = 0;
00044 if( matrix_order == LAPACK_COL_MAJOR ) {
00045
00046 LAPACK_ssbgst( &vect, &uplo, &n, &ka, &kb, ab, &ldab, bb, &ldbb, x,
00047 &ldx, work, &info );
00048 if( info < 0 ) {
00049 info = info - 1;
00050 }
00051 } else if( matrix_order == LAPACK_ROW_MAJOR ) {
00052 lapack_int ldab_t = MAX(1,ka+1);
00053 lapack_int ldbb_t = MAX(1,kb+1);
00054 lapack_int ldx_t = MAX(1,n);
00055 float* ab_t = NULL;
00056 float* bb_t = NULL;
00057 float* x_t = NULL;
00058
00059 if( ldab < n ) {
00060 info = -8;
00061 LAPACKE_xerbla( "LAPACKE_ssbgst_work", info );
00062 return info;
00063 }
00064 if( ldbb < n ) {
00065 info = -10;
00066 LAPACKE_xerbla( "LAPACKE_ssbgst_work", info );
00067 return info;
00068 }
00069 if( ldx < n ) {
00070 info = -12;
00071 LAPACKE_xerbla( "LAPACKE_ssbgst_work", info );
00072 return info;
00073 }
00074
00075 ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
00076 if( ab_t == NULL ) {
00077 info = LAPACK_TRANSPOSE_MEMORY_ERROR;
00078 goto exit_level_0;
00079 }
00080 bb_t = (float*)LAPACKE_malloc( sizeof(float) * ldbb_t * MAX(1,n) );
00081 if( bb_t == NULL ) {
00082 info = LAPACK_TRANSPOSE_MEMORY_ERROR;
00083 goto exit_level_1;
00084 }
00085 if( LAPACKE_lsame( vect, 'v' ) ) {
00086 x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,n) );
00087 if( x_t == NULL ) {
00088 info = LAPACK_TRANSPOSE_MEMORY_ERROR;
00089 goto exit_level_2;
00090 }
00091 }
00092
00093 LAPACKE_ssb_trans( matrix_order, uplo, n, ka, ab, ldab, ab_t, ldab_t );
00094 LAPACKE_ssb_trans( matrix_order, uplo, n, kb, bb, ldbb, bb_t, ldbb_t );
00095
00096 LAPACK_ssbgst( &vect, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t,
00097 x_t, &ldx_t, work, &info );
00098 if( info < 0 ) {
00099 info = info - 1;
00100 }
00101
00102 LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab,
00103 ldab );
00104 if( LAPACKE_lsame( vect, 'v' ) ) {
00105 LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, x_t, ldx_t, x, ldx );
00106 }
00107
00108 if( LAPACKE_lsame( vect, 'v' ) ) {
00109 LAPACKE_free( x_t );
00110 }
00111 exit_level_2:
00112 LAPACKE_free( bb_t );
00113 exit_level_1:
00114 LAPACKE_free( ab_t );
00115 exit_level_0:
00116 if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
00117 LAPACKE_xerbla( "LAPACKE_ssbgst_work", info );
00118 }
00119 } else {
00120 info = -1;
00121 LAPACKE_xerbla( "LAPACKE_ssbgst_work", info );
00122 }
00123 return info;
00124 }