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_dbdsdc_work( int matrix_order, char uplo, char compq,
00038 lapack_int n, double* d, double* e, double* u,
00039 lapack_int ldu, double* vt, lapack_int ldvt,
00040 double* q, lapack_int* iq, double* work,
00041 lapack_int* iwork )
00042 {
00043 lapack_int info = 0;
00044 if( matrix_order == LAPACK_COL_MAJOR ) {
00045
00046 LAPACK_dbdsdc( &uplo, &compq, &n, d, e, u, &ldu, vt, &ldvt, q, iq, work,
00047 iwork, &info );
00048 if( info < 0 ) {
00049 info = info - 1;
00050 }
00051 } else if( matrix_order == LAPACK_ROW_MAJOR ) {
00052 lapack_int ldu_t = MAX(1,n);
00053 lapack_int ldvt_t = MAX(1,n);
00054 double* u_t = NULL;
00055 double* vt_t = NULL;
00056
00057 if( ldu < n ) {
00058 info = -8;
00059 LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info );
00060 return info;
00061 }
00062 if( ldvt < n ) {
00063 info = -10;
00064 LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info );
00065 return info;
00066 }
00067
00068 if( LAPACKE_lsame( compq, 'i' ) ) {
00069 u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,n) );
00070 if( u_t == NULL ) {
00071 info = LAPACK_TRANSPOSE_MEMORY_ERROR;
00072 goto exit_level_0;
00073 }
00074 }
00075 if( LAPACKE_lsame( compq, 'i' ) ) {
00076 vt_t = (double*)
00077 LAPACKE_malloc( sizeof(double) * ldvt_t * MAX(1,n) );
00078 if( vt_t == NULL ) {
00079 info = LAPACK_TRANSPOSE_MEMORY_ERROR;
00080 goto exit_level_1;
00081 }
00082 }
00083
00084 LAPACK_dbdsdc( &uplo, &compq, &n, d, e, u_t, &ldu_t, vt_t, &ldvt_t, q,
00085 iq, work, iwork, &info );
00086 if( info < 0 ) {
00087 info = info - 1;
00088 }
00089
00090 if( LAPACKE_lsame( compq, 'i' ) ) {
00091 LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, u_t, ldu_t, u, ldu );
00092 }
00093 if( LAPACKE_lsame( compq, 'i' ) ) {
00094 LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vt_t, ldvt_t, vt, ldvt );
00095 }
00096
00097 if( LAPACKE_lsame( compq, 'i' ) ) {
00098 LAPACKE_free( vt_t );
00099 }
00100 exit_level_1:
00101 if( LAPACKE_lsame( compq, 'i' ) ) {
00102 LAPACKE_free( u_t );
00103 }
00104 exit_level_0:
00105 if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
00106 LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info );
00107 }
00108 } else {
00109 info = -1;
00110 LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info );
00111 }
00112 return info;
00113 }