lapack_int LAPACKE_zsptrs_work( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_zsptrs( &uplo, &n, &nrhs, ap, ipiv, b, &ldb, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int ldb_t = MAX(1,n); lapack_complex_double* b_t = NULL; lapack_complex_double* ap_t = NULL; /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; LAPACKE_xerbla( "LAPACKE_zsptrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ b_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldb_t * MAX(1,nrhs) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } ap_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 ); if( ap_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } /* Transpose input matrices */ LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); LAPACKE_zsp_trans( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zsptrs( &uplo, &n, &nrhs, ap_t, ipiv, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_zsptrs_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_zsptrs_work", info ); } return info; }
lapack_int LAPACKE_dbdsdc_work( int matrix_order, char uplo, char compq, lapack_int n, double* d, double* e, double* u, lapack_int ldu, double* vt, lapack_int ldvt, double* q, lapack_int* iq, double* work, lapack_int* iwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_dbdsdc( &uplo, &compq, &n, d, e, u, &ldu, vt, &ldvt, q, iq, work, iwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int ldu_t = MAX(1,n); lapack_int ldvt_t = MAX(1,n); double* u_t = NULL; double* vt_t = NULL; /* Check leading dimension(s) */ if( ldu < n ) { info = -8; LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info ); return info; } if( ldvt < n ) { info = -10; LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info ); return info; } /* Allocate memory for temporary array(s) */ if( LAPACKE_lsame( compq, 'i' ) ) { u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,n) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } } if( LAPACKE_lsame( compq, 'i' ) ) { vt_t = (double*) LAPACKE_malloc( sizeof(double) * ldvt_t * MAX(1,n) ); if( vt_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } /* Call LAPACK function and adjust info */ LAPACK_dbdsdc( &uplo, &compq, &n, d, e, u_t, &ldu_t, vt_t, &ldvt_t, q, iq, work, iwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ if( LAPACKE_lsame( compq, 'i' ) ) { LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, u_t, ldu_t, u, ldu ); } if( LAPACKE_lsame( compq, 'i' ) ) { LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vt_t, ldvt_t, vt, ldvt ); } /* Release memory and exit */ if( LAPACKE_lsame( compq, 'i' ) ) { LAPACKE_free( vt_t ); } exit_level_1: if( LAPACKE_lsame( compq, 'i' ) ) { LAPACKE_free( u_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info ); } return info; }
lapack_int LAPACKE_dtrexc_work( int matrix_layout, char compq, lapack_int n, double* t, lapack_int ldt, double* q, lapack_int ldq, lapack_int* ifst, lapack_int* ilst, double* work ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_dtrexc( &compq, &n, t, &ldt, q, &ldq, ifst, ilst, work, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int ldq_t = MAX(1,n); lapack_int ldt_t = MAX(1,n); double* t_t = NULL; double* q_t = NULL; /* Check leading dimension(s) */ if( ldq < n ) { info = -7; LAPACKE_xerbla( "LAPACKE_dtrexc_work", info ); return info; } if( ldt < n ) { info = -5; LAPACKE_xerbla( "LAPACKE_dtrexc_work", info ); return info; } /* Allocate memory for temporary array(s) */ t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,n) ); if( t_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } if( LAPACKE_lsame( compq, 'v' ) ) { q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } /* Transpose input matrices */ LAPACKE_dge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); if( LAPACKE_lsame( compq, 'v' ) ) { LAPACKE_dge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_dtrexc( &compq, &n, t_t, &ldt_t, q_t, &ldq_t, ifst, ilst, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); if( LAPACKE_lsame( compq, 'v' ) ) { LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ if( LAPACKE_lsame( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( t_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_dtrexc_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_dtrexc_work", info ); } return info; }
lapack_int LAPACKE_sggesx( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_S_SELECT3 selctg, char sense, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, lapack_int* sdim, float* alphar, float* alphai, float* beta, float* vsl, lapack_int ldvsl, float* vsr, lapack_int ldvsr, float* rconde, float* rcondv ) { lapack_int info = 0; lapack_int liwork = -1; lapack_int lwork = -1; lapack_logical* bwork = NULL; lapack_int* iwork = NULL; float* work = NULL; lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_sggesx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { return -8; } if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) { return -10; } #endif /* Allocate memory for working array(s) */ if( LAPACKE_lsame( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } } /* Query optimal working array(s) size */ info = LAPACKE_sggesx_work( matrix_layout, jobvsl, jobvsr, sort, selctg, sense, n, a, lda, b, ldb, sdim, alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr, rconde, rcondv, &work_query, lwork, &iwork_query, liwork, bwork ); if( info != 0 ) { goto exit_level_1; } liwork = (lapack_int)iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_2; } /* Call middle-level interface */ info = LAPACKE_sggesx_work( matrix_layout, jobvsl, jobvsr, sort, selctg, sense, n, a, lda, b, ldb, sdim, alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr, rconde, rcondv, work, lwork, iwork, liwork, bwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_2: LAPACKE_free( iwork ); exit_level_1: if( LAPACKE_lsame( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_sggesx", info ); } return info; }
lapack_int LAPACKE_dormql_work( int matrix_order, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const double* a, lapack_int lda, const double* tau, double* c, lapack_int ldc, double* work, lapack_int lwork ) { lapack_int info = 0; lapack_int r; lapack_int lda_t, ldc_t; double *a_t = NULL, *c_t = NULL; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_dormql( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { r = LAPACKE_lsame( side, 'l' ) ? m : n; lda_t = MAX(1,r); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < k ) { info = -8; LAPACKE_xerbla( "LAPACKE_dormql_work", info ); return info; } if( ldc < n ) { info = -11; LAPACKE_xerbla( "LAPACKE_dormql_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_dormql( &side, &trans, &m, &n, &k, a, &lda_t, tau, c, &ldc_t, work, &lwork, &info ); return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,k) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } c_t = (double*)LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) ); if( c_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } /* Transpose input matrices */ LAPACKE_dge_trans( matrix_order, r, k, a, lda, a_t, lda_t ); LAPACKE_dge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_dormql( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_dormql_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_dormql_work", info ); } return info; }
lapack_int LAPACKE_dgejsv( int matrix_layout, char joba, char jobu, char jobv, char jobr, char jobt, char jobp, lapack_int m, lapack_int n, double* a, lapack_int lda, double* sva, double* u, lapack_int ldu, double* v, lapack_int ldv, double* stat, lapack_int* istat ) { lapack_int info = 0; lapack_int lwork = (!( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( joba, 'e' ) || LAPACKE_lsame( joba, 'g' ) ) ? MAX3(7,4*n+1,2*m+n) : ( (!( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) && ( LAPACKE_lsame( joba, 'e' ) || LAPACKE_lsame( joba, 'g' ) ) ) ? MAX3(7,4*n+n*n,2*m+n) : ( ( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) && (!( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) ) ? MAX(7,2*n+m) : ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) && (!( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) ) ? MAX(7,2*n+m) : ( ( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) && ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) && !LAPACKE_lsame( jobv, 'j' ) ? MAX(1,6*n+2*n*n) : ( ( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) && ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) && LAPACKE_lsame( jobv, 'j' ) ? MAX(7,m+3*n+n*n) : 7) ) ) ) ) ); lapack_int* iwork = NULL; double* work = NULL; lapack_int i; lapack_int nu, nv; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_dgejsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m; nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n; if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { return -10; } #endif /* Allocate memory for working array(s) */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(3,m+3*n) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } lwork = MAX3( lwork, 7, 2*m+n ); { /* FIXUP LWORK */ int want_u = LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ); int want_v = LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ); int want_sce = LAPACKE_lsame( joba, 'e' ) || LAPACKE_lsame( joba, 'g' ); if( !want_u && !want_v && !want_sce ) lwork = MAX( lwork, 4*n+1 ); // 1.1 if( !want_u && !want_v && want_sce ) lwork = MAX( lwork, n*n+4*n ); // 1.2 if( !want_u && want_v ) lwork = MAX( lwork, 4*n+1 ); // 2 if( want_u && !want_v ) lwork = MAX( lwork, 4*n+1 ); // 3 if( want_u && LAPACKE_lsame( jobv, 'v' ) ) lwork = MAX( lwork, 6*n+2*n*n ); // 4.1 if( want_u && LAPACKE_lsame( jobv, 'j' ) ) lwork = MAX3( lwork, 4*n+n*n, 2*n+n*n+6 ); // 4.2 } work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } /* Call middle-level interface */ info = LAPACKE_dgejsv_work( matrix_layout, joba, jobu, jobv, jobr, jobt, jobp, m, n, a, lda, sva, u, ldu, v, ldv, work, lwork, iwork ); /* Backup significant data from working array(s) */ for( i=0; i<7; i++ ) { stat[i] = work[i]; } for( i=0; i<3; i++ ) { istat[i] = iwork[i]; } /* Release memory and exit */ LAPACKE_free( work ); exit_level_1: LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_dgejsv", info ); } return info; }
lapack_int LAPACKE_dgges3_work( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_D_SELECT3 selctg, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, lapack_int* sdim, double* alphar, double* alphai, double* beta, double* vsl, lapack_int ldvsl, double* vsr, lapack_int ldvsr, double* work, lapack_int lwork, lapack_logical* bwork ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_dgges3( &jobvsl, &jobvsr, &sort, selctg, &n, a, &lda, b, &ldb, sdim, alphar, alphai, beta, vsl, &ldvsl, vsr, &ldvsr, work, &lwork, bwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldvsl_t = MAX(1,n); lapack_int ldvsr_t = MAX(1,n); double* a_t = NULL; double* b_t = NULL; double* vsl_t = NULL; double* vsr_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -8; LAPACKE_xerbla( "LAPACKE_dgges3_work", info ); return info; } if( ldb < n ) { info = -10; LAPACKE_xerbla( "LAPACKE_dgges3_work", info ); return info; } if( ldvsl < n ) { info = -16; LAPACKE_xerbla( "LAPACKE_dgges3_work", info ); return info; } if( ldvsr < n ) { info = -18; LAPACKE_xerbla( "LAPACKE_dgges3_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_dgges3( &jobvsl, &jobvsr, &sort, selctg, &n, a, &lda_t, b, &ldb_t, sdim, alphar, alphai, beta, vsl, &ldvsl_t, vsr, &ldvsr_t, work, &lwork, bwork, &info ); return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } if( LAPACKE_lsame( jobvsl, 'v' ) ) { vsl_t = (double*) LAPACKE_malloc( sizeof(double) * ldvsl_t * MAX(1,n) ); if( vsl_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } if( LAPACKE_lsame( jobvsr, 'v' ) ) { vsr_t = (double*) LAPACKE_malloc( sizeof(double) * ldvsr_t * MAX(1,n) ); if( vsr_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; } } /* Transpose input matrices */ LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dgges3( &jobvsl, &jobvsr, &sort, selctg, &n, a_t, &lda_t, b_t, &ldb_t, sdim, alphar, alphai, beta, vsl_t, &ldvsl_t, vsr_t, &ldvsr_t, work, &lwork, bwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); if( LAPACKE_lsame( jobvsl, 'v' ) ) { LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, ldvsl ); } if( LAPACKE_lsame( jobvsr, 'v' ) ) { LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, ldvsr ); } /* Release memory and exit */ if( LAPACKE_lsame( jobvsr, 'v' ) ) { LAPACKE_free( vsr_t ); } exit_level_3: if( LAPACKE_lsame( jobvsl, 'v' ) ) { LAPACKE_free( vsl_t ); } exit_level_2: LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_dgges3_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_dgges3_work", info ); } return info; }
lapack_int LAPACKE_dsyevx( int matrix_order, char jobz, char range, char uplo, lapack_int n, double* a, lapack_int lda, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, double* w, double* z, lapack_int ldz, lapack_int* ifail ) { lapack_int info = 0; lapack_int lwork = -1; lapack_int* iwork = NULL; double* work = NULL; double work_query; if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_dsyevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) { return -6; } if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { return -12; } if( LAPACKE_lsame( range, 'v' ) ) { if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { return -8; } } if( LAPACKE_lsame( range, 'v' ) ) { if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { return -9; } } #endif /* Allocate memory for working array(s) */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,5*n) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } /* Query optimal working array(s) size */ info = LAPACKE_dsyevx_work( matrix_order, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, &work_query, lwork, iwork, ifail ); if( info != 0 ) { goto exit_level_1; } lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } /* Call middle-level interface */ info = LAPACKE_dsyevx_work( matrix_order, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, iwork, ifail ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_1: LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_dsyevx", info ); } return info; }
lapack_int LAPACKE_cunmbr_work( int matrix_layout, char vect, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, lapack_complex_float* c, lapack_int ldc, lapack_complex_float* work, lapack_int lwork ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_cunmbr( &vect, &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nq = LAPACKE_lsame( side, 'l' ) ? m : n; lapack_int r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k); lapack_int lda_t = MAX(1,r); lapack_int ldc_t = MAX(1,m); lapack_complex_float* a_t = NULL; lapack_complex_float* c_t = NULL; /* Check leading dimension(s) */ if( lda < MIN(nq,k) ) { info = -9; LAPACKE_xerbla( "LAPACKE_cunmbr_work", info ); return info; } if( ldc < n ) { info = -12; LAPACKE_xerbla( "LAPACKE_cunmbr_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_cunmbr( &vect, &side, &trans, &m, &n, &k, a, &lda_t, tau, c, &ldc_t, work, &lwork, &info ); return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ a_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,MIN(nq,k)) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } c_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldc_t * MAX(1,n) ); if( c_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } /* Transpose input matrices */ LAPACKE_cge_trans( matrix_layout, r, MIN(nq,k), a, lda, a_t, lda_t ); LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_cunmbr( &vect, &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_cunmbr_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_cunmbr_work", info ); } return info; }
lapack_int LAPACKE_zhegst_work( int matrix_order, lapack_int itype, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* b, lapack_int ldb ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_zhegst( &itype, &uplo, &n, a, &lda, b, &ldb, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_complex_double* a_t = NULL; lapack_complex_double* b_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -6; LAPACKE_xerbla( "LAPACKE_zhegst_work", info ); return info; } if( ldb < n ) { info = -8; LAPACKE_xerbla( "LAPACKE_zhegst_work", info ); return info; } /* Allocate memory for temporary array(s) */ a_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } b_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldb_t * MAX(1,n) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } /* Transpose input matrices */ LAPACKE_zhe_trans( matrix_order, uplo, n, a, lda, a_t, lda_t ); LAPACKE_zge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhegst( &itype, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_zhegst_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_zhegst_work", info ); } return info; }
lapack_int LAPACKE_dstemr( int matrix_layout, char jobz, char range, lapack_int n, double* d, double* e, double vl, double vu, lapack_int il, lapack_int iu, lapack_int* m, double* w, double* z, lapack_int ldz, lapack_int nzc, lapack_int* isuppz, lapack_logical* tryrac ) { lapack_int info = 0; lapack_int liwork = -1; lapack_int lwork = -1; lapack_int* iwork = NULL; double* work = NULL; lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_dstemr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ if( LAPACKE_d_nancheck( n, d, 1 ) ) { return -5; } if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { return -6; } if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { return -7; } if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { return -8; } } #endif /* Query optimal working array(s) size */ info = LAPACKE_dstemr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, m, w, z, ldz, nzc, isuppz, tryrac, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { goto exit_level_0; } liwork = (lapack_int)iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } /* Call middle-level interface */ info = LAPACKE_dstemr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, m, w, z, ldz, nzc, isuppz, tryrac, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_1: LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_dstemr", info ); } return info; }
lapack_int LAPACKE_stfsm_work( int matrix_layout, char transr, char side, char uplo, char trans, char diag, lapack_int m, lapack_int n, float alpha, const float* a, float* b, lapack_int ldb ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_stfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a, b, &ldb ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int ldb_t = MAX(1,m); float* b_t = NULL; float* a_t = NULL; /* Check leading dimension(s) */ if( ldb < n ) { info = -12; LAPACKE_xerbla( "LAPACKE_stfsm_work", info ); return info; } /* Allocate memory for temporary array(s) */ b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } if( IS_S_NONZERO(alpha) ) { a_t = (float*) LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } /* Transpose input matrices */ if( IS_S_NONZERO(alpha) ) { LAPACKE_sge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); } if( IS_S_NONZERO(alpha) ) { LAPACKE_stf_trans( matrix_layout, transr, uplo, diag, n, a, a_t ); } /* Call LAPACK function and adjust info */ LAPACK_stfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t, b_t, &ldb_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ if( IS_S_NONZERO(alpha) ) { LAPACKE_free( a_t ); } exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_stfsm_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_stfsm_work", info ); } return info; }
lapack_int LAPACKE_cgesdd( int matrix_order, char jobz, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, float* s, lapack_complex_float* u, lapack_int ldu, lapack_complex_float* vt, lapack_int ldvt ) { lapack_int info = 0; lapack_int lwork = -1; /* Additional scalars declarations for work arrays */ size_t lrwork; lapack_int* iwork = NULL; float* rwork = NULL; lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_cgesdd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ if( LAPACKE_cge_nancheck( matrix_order, m, n, a, lda ) ) { return -5; } #endif /* Additional scalars initializations for work arrays */ if( LAPACKE_lsame( jobz, 'n' ) ) { lrwork = MAX(1,5*MIN(m,n)); } else { lrwork = (size_t)5*MAX(1,MIN(m,n))*MAX(1,MIN(m,n))+7*MIN(m,n); } /* Allocate memory for working array(s) */ iwork = (lapack_int*) LAPACKE_malloc( sizeof(lapack_int) * MAX(1,8*MIN(m,n)) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } rwork = (float*)LAPACKE_malloc( sizeof(float) * lrwork ); if( rwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } /* Query optimal working array(s) size */ info = LAPACKE_cgesdd_work( matrix_order, jobz, m, n, a, lda, s, u, ldu, vt, ldvt, &work_query, lwork, rwork, iwork ); if( info != 0 ) { goto exit_level_2; } lwork = LAPACK_C2INT( work_query ); /* Allocate memory for work arrays */ work = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_2; } /* Call middle-level interface */ info = LAPACKE_cgesdd_work( matrix_order, jobz, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, rwork, iwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_2: LAPACKE_free( rwork ); exit_level_1: LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_cgesdd", info ); } return info; }
lapack_int LAPACKE_zlarfb( int matrix_order, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_double* v, lapack_int ldv, const lapack_complex_double* t, lapack_int ldt, lapack_complex_double* c, lapack_int ldc ) { lapack_int info = 0; lapack_int ldwork = ( side=='l')?n:(( side=='r')?m:1); lapack_complex_double* work = NULL; lapack_int ncols_v, nrows_v; if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_zlarfb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ ncols_v = LAPACKE_lsame( storev, 'c' ) ? k : ( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'l' ) ) ? m : ( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'r' ) ) ? n : 1) ); nrows_v = ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'l' ) ) ? m : ( ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'r' ) ) ? n : ( LAPACKE_lsame( storev, 'r' ) ? k : 1) ); if( LAPACKE_zge_nancheck( matrix_order, m, n, c, ldc ) ) { return -13; } if( LAPACKE_zge_nancheck( matrix_order, k, k, t, ldt ) ) { return -11; } if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) { if( LAPACKE_ztr_nancheck( matrix_order, 'l', 'u', k, v, ldv ) ) return -9; if( LAPACKE_zge_nancheck( matrix_order, nrows_v-k, ncols_v, &v[k*ldv], ldv ) ) return -9; } else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) { if( k > nrows_v ) { LAPACKE_xerbla( "LAPACKE_zlarfb", -8 ); return -8; } if( LAPACKE_ztr_nancheck( matrix_order, 'u', 'u', k, &v[(nrows_v-k)*ldv], ldv ) ) return -9; if( LAPACKE_zge_nancheck( matrix_order, nrows_v-k, ncols_v, v, ldv ) ) return -9; } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) { if( LAPACKE_ztr_nancheck( matrix_order, 'u', 'u', k, v, ldv ) ) return -9; if( LAPACKE_zge_nancheck( matrix_order, nrows_v, ncols_v-k, &v[k], ldv ) ) return -9; } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) { if( k > ncols_v ) { LAPACKE_xerbla( "LAPACKE_zlarfb", -8 ); return -8; } if( LAPACKE_ztr_nancheck( matrix_order, 'l', 'u', k, &v[ncols_v-k], ldv ) ) return -9; if( LAPACKE_zge_nancheck( matrix_order, nrows_v, ncols_v-k, v, ldv ) ) return -9; } #endif /* Allocate memory for working array(s) */ work = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldwork * MAX(1,k) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } /* Call middle-level interface */ info = LAPACKE_zlarfb_work( matrix_order, side, trans, direct, storev, m, n, k, v, ldv, t, ldt, c, ldc, work, ldwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_zlarfb", info ); } return info; }
lapack_int LAPACKE_sbbcsd_work( int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, lapack_int m, lapack_int p, lapack_int q, float* theta, float* phi, float* u1, lapack_int ldu1, float* u2, lapack_int ldu2, float* v1t, lapack_int ldv1t, float* v2t, lapack_int ldv2t, float* b11d, float* b11e, float* b12d, float* b12e, float* b21d, float* b21e, float* b22d, float* b22e, float* work, lapack_int lwork ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_sbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q, theta, phi, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t, &ldv2t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1); lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1); lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1); lapack_int nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1); lapack_int ldu1_t = MAX(1,nrows_u1); lapack_int ldu2_t = MAX(1,nrows_u2); lapack_int ldv1t_t = MAX(1,nrows_v1t); lapack_int ldv2t_t = MAX(1,nrows_v2t); float* u1_t = NULL; float* u2_t = NULL; float* v1t_t = NULL; float* v2t_t = NULL; /* Check leading dimension(s) */ if( ldu1 < p ) { info = -13; LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info ); return info; } if( ldu2 < m-p ) { info = -15; LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info ); return info; } if( ldv1t < q ) { info = -17; LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info ); return info; } if( ldv2t < m-q ) { info = -19; LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_sbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q, theta, phi, u1, &ldu1_t, u2, &ldu2_t, v1t, &ldv1t_t, v2t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e, work, &lwork, &info ); return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ if( LAPACKE_lsame( jobu1, 'y' ) ) { u1_t = (float*)LAPACKE_malloc( sizeof(float) * ldu1_t * MAX(1,p) ); if( u1_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } } if( LAPACKE_lsame( jobu2, 'y' ) ) { u2_t = (float*) LAPACKE_malloc( sizeof(float) * ldu2_t * MAX(1,m-p) ); if( u2_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } if( LAPACKE_lsame( jobv1t, 'y' ) ) { v1t_t = (float*) LAPACKE_malloc( sizeof(float) * ldv1t_t * MAX(1,q) ); if( v1t_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } if( LAPACKE_lsame( jobv2t, 'y' ) ) { v2t_t = (float*) LAPACKE_malloc( sizeof(float) * ldv2t_t * MAX(1,m-q) ); if( v2t_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; } } /* Transpose input matrices */ if( LAPACKE_lsame( jobu1, 'y' ) ) { LAPACKE_sge_trans( matrix_layout, nrows_u1, p, u1, ldu1, u1_t, ldu1_t ); } if( LAPACKE_lsame( jobu2, 'y' ) ) { LAPACKE_sge_trans( matrix_layout, nrows_u2, m-p, u2, ldu2, u2_t, ldu2_t ); } if( LAPACKE_lsame( jobv1t, 'y' ) ) { LAPACKE_sge_trans( matrix_layout, nrows_v1t, q, v1t, ldv1t, v1t_t, ldv1t_t ); } if( LAPACKE_lsame( jobv2t, 'y' ) ) { LAPACKE_sge_trans( matrix_layout, nrows_v2t, m-q, v2t, ldv2t, v2t_t, ldv2t_t ); } /* Call LAPACK function and adjust info */ LAPACK_sbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q, theta, phi, u1_t, &ldu1_t, u2_t, &ldu2_t, v1t_t, &ldv1t_t, v2t_t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ if( LAPACKE_lsame( jobu1, 'y' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1, ldu1 ); } if( LAPACKE_lsame( jobu2, 'y' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t, u2, ldu2 ); } if( LAPACKE_lsame( jobv1t, 'y' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t, v1t, ldv1t ); } if( LAPACKE_lsame( jobv2t, 'y' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t, v2t, ldv2t ); } /* Release memory and exit */ if( LAPACKE_lsame( jobv2t, 'y' ) ) { LAPACKE_free( v2t_t ); } exit_level_3: if( LAPACKE_lsame( jobv1t, 'y' ) ) { LAPACKE_free( v1t_t ); } exit_level_2: if( LAPACKE_lsame( jobu2, 'y' ) ) { LAPACKE_free( u2_t ); } exit_level_1: if( LAPACKE_lsame( jobu1, 'y' ) ) { LAPACKE_free( u1_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info ); } return info; }
lapack_int LAPACKE_dggsvp( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double tola, double tolb, lapack_int* k, lapack_int* l, double* u, lapack_int ldu, double* v, lapack_int ldv, double* q, lapack_int ldq ) { lapack_int info = 0; lapack_int* iwork = NULL; double* tau = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_dggsvp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { return -8; } if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) { return -10; } if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) { return -12; } if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) { return -13; } #endif /* Allocate memory for working array(s) */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } tau = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) ); if( tau == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,MAX3(3*n,m,p)) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_2; } /* Call middle-level interface */ info = LAPACKE_dggsvp_work( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, tau, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_2: LAPACKE_free( tau ); exit_level_1: LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_dggsvp", info ); } return info; }
int main(void) { /* Local scalars */ char uplo, uplo_i; char trans, trans_i; char diag, diag_i; lapack_int n, n_i; lapack_int nrhs, nrhs_i; lapack_int lda, lda_i; lapack_int lda_r; lapack_int ldb, ldb_i; lapack_int ldb_r; lapack_int ldx, ldx_i; lapack_int ldx_r; lapack_int info, info_i; lapack_int i; int failed; /* Local arrays */ lapack_complex_float *a = NULL, *a_i = NULL; lapack_complex_float *b = NULL, *b_i = NULL; lapack_complex_float *x = NULL, *x_i = NULL; float *ferr = NULL, *ferr_i = NULL; float *berr = NULL, *berr_i = NULL; lapack_complex_float *work = NULL, *work_i = NULL; float *rwork = NULL, *rwork_i = NULL; float *ferr_save = NULL; float *berr_save = NULL; lapack_complex_float *a_r = NULL; lapack_complex_float *b_r = NULL; lapack_complex_float *x_r = NULL; /* Iniitialize the scalar parameters */ init_scalars_ctrrfs( &uplo, &trans, &diag, &n, &nrhs, &lda, &ldb, &ldx ); lda_r = n+2; ldb_r = nrhs+2; ldx_r = nrhs+2; uplo_i = uplo; trans_i = trans; diag_i = diag; n_i = n; nrhs_i = nrhs; lda_i = lda; ldb_i = ldb; ldx_i = ldx; /* Allocate memory for the LAPACK routine arrays */ a = (lapack_complex_float *) LAPACKE_malloc( lda*n * sizeof(lapack_complex_float) ); b = (lapack_complex_float *) LAPACKE_malloc( ldb*nrhs * sizeof(lapack_complex_float) ); x = (lapack_complex_float *) LAPACKE_malloc( ldx*nrhs * sizeof(lapack_complex_float) ); ferr = (float *)LAPACKE_malloc( nrhs * sizeof(float) ); berr = (float *)LAPACKE_malloc( nrhs * sizeof(float) ); work = (lapack_complex_float *) LAPACKE_malloc( 2*n * sizeof(lapack_complex_float) ); rwork = (float *)LAPACKE_malloc( n * sizeof(float) ); /* Allocate memory for the C interface function arrays */ a_i = (lapack_complex_float *) LAPACKE_malloc( lda*n * sizeof(lapack_complex_float) ); b_i = (lapack_complex_float *) LAPACKE_malloc( ldb*nrhs * sizeof(lapack_complex_float) ); x_i = (lapack_complex_float *) LAPACKE_malloc( ldx*nrhs * sizeof(lapack_complex_float) ); ferr_i = (float *)LAPACKE_malloc( nrhs * sizeof(float) ); berr_i = (float *)LAPACKE_malloc( nrhs * sizeof(float) ); work_i = (lapack_complex_float *) LAPACKE_malloc( 2*n * sizeof(lapack_complex_float) ); rwork_i = (float *)LAPACKE_malloc( n * sizeof(float) ); /* Allocate memory for the backup arrays */ ferr_save = (float *)LAPACKE_malloc( nrhs * sizeof(float) ); berr_save = (float *)LAPACKE_malloc( nrhs * sizeof(float) ); /* Allocate memory for the row-major arrays */ a_r = (lapack_complex_float *) LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_float) ); b_r = (lapack_complex_float *) LAPACKE_malloc( n*(nrhs+2) * sizeof(lapack_complex_float) ); x_r = (lapack_complex_float *) LAPACKE_malloc( n*(nrhs+2) * sizeof(lapack_complex_float) ); /* Initialize input arrays */ init_a( lda*n, a ); init_b( ldb*nrhs, b ); init_x( ldx*nrhs, x ); init_ferr( nrhs, ferr ); init_berr( nrhs, berr ); init_work( 2*n, work ); init_rwork( n, rwork ); /* Backup the ouptut arrays */ for( i = 0; i < nrhs; i++ ) { ferr_save[i] = ferr[i]; } for( i = 0; i < nrhs; i++ ) { berr_save[i] = berr[i]; } /* Call the LAPACK routine */ ctrrfs_( &uplo, &trans, &diag, &n, &nrhs, a, &lda, b, &ldb, x, &ldx, ferr, berr, work, rwork, &info ); /* Initialize input data, call the column-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < lda*n; i++ ) { a_i[i] = a[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b[i]; } for( i = 0; i < ldx*nrhs; i++ ) { x_i[i] = x[i]; } for( i = 0; i < nrhs; i++ ) { ferr_i[i] = ferr_save[i]; } for( i = 0; i < nrhs; i++ ) { berr_i[i] = berr_save[i]; } for( i = 0; i < 2*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { rwork_i[i] = rwork[i]; } info_i = LAPACKE_ctrrfs_work( LAPACK_COL_MAJOR, uplo_i, trans_i, diag_i, n_i, nrhs_i, a_i, lda_i, b_i, ldb_i, x_i, ldx_i, ferr_i, berr_i, work_i, rwork_i ); failed = compare_ctrrfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs ); if( failed == 0 ) { printf( "PASSED: column-major middle-level interface to ctrrfs\n" ); } else { printf( "FAILED: column-major middle-level interface to ctrrfs\n" ); } /* Initialize input data, call the column-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < lda*n; i++ ) { a_i[i] = a[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b[i]; } for( i = 0; i < ldx*nrhs; i++ ) { x_i[i] = x[i]; } for( i = 0; i < nrhs; i++ ) { ferr_i[i] = ferr_save[i]; } for( i = 0; i < nrhs; i++ ) { berr_i[i] = berr_save[i]; } for( i = 0; i < 2*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { rwork_i[i] = rwork[i]; } info_i = LAPACKE_ctrrfs( LAPACK_COL_MAJOR, uplo_i, trans_i, diag_i, n_i, nrhs_i, a_i, lda_i, b_i, ldb_i, x_i, ldx_i, ferr_i, berr_i ); failed = compare_ctrrfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs ); if( failed == 0 ) { printf( "PASSED: column-major high-level interface to ctrrfs\n" ); } else { printf( "FAILED: column-major high-level interface to ctrrfs\n" ); } /* Initialize input data, call the row-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < lda*n; i++ ) { a_i[i] = a[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b[i]; } for( i = 0; i < ldx*nrhs; i++ ) { x_i[i] = x[i]; } for( i = 0; i < nrhs; i++ ) { ferr_i[i] = ferr_save[i]; } for( i = 0; i < nrhs; i++ ) { berr_i[i] = berr_save[i]; } for( i = 0; i < 2*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { rwork_i[i] = rwork[i]; } LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 ); LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 ); LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 ); info_i = LAPACKE_ctrrfs_work( LAPACK_ROW_MAJOR, uplo_i, trans_i, diag_i, n_i, nrhs_i, a_r, lda_r, b_r, ldb_r, x_r, ldx_r, ferr_i, berr_i, work_i, rwork_i ); failed = compare_ctrrfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs ); if( failed == 0 ) { printf( "PASSED: row-major middle-level interface to ctrrfs\n" ); } else { printf( "FAILED: row-major middle-level interface to ctrrfs\n" ); } /* Initialize input data, call the row-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < lda*n; i++ ) { a_i[i] = a[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b[i]; } for( i = 0; i < ldx*nrhs; i++ ) { x_i[i] = x[i]; } for( i = 0; i < nrhs; i++ ) { ferr_i[i] = ferr_save[i]; } for( i = 0; i < nrhs; i++ ) { berr_i[i] = berr_save[i]; } for( i = 0; i < 2*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { rwork_i[i] = rwork[i]; } /* Init row_major arrays */ LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 ); LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 ); LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 ); info_i = LAPACKE_ctrrfs( LAPACK_ROW_MAJOR, uplo_i, trans_i, diag_i, n_i, nrhs_i, a_r, lda_r, b_r, ldb_r, x_r, ldx_r, ferr_i, berr_i ); failed = compare_ctrrfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs ); if( failed == 0 ) { printf( "PASSED: row-major high-level interface to ctrrfs\n" ); } else { printf( "FAILED: row-major high-level interface to ctrrfs\n" ); } /* Release memory */ if( a != NULL ) { LAPACKE_free( a ); } if( a_i != NULL ) { LAPACKE_free( a_i ); } if( a_r != NULL ) { LAPACKE_free( a_r ); } if( b != NULL ) { LAPACKE_free( b ); } if( b_i != NULL ) { LAPACKE_free( b_i ); } if( b_r != NULL ) { LAPACKE_free( b_r ); } if( x != NULL ) { LAPACKE_free( x ); } if( x_i != NULL ) { LAPACKE_free( x_i ); } if( x_r != NULL ) { LAPACKE_free( x_r ); } if( ferr != NULL ) { LAPACKE_free( ferr ); } if( ferr_i != NULL ) { LAPACKE_free( ferr_i ); } if( ferr_save != NULL ) { LAPACKE_free( ferr_save ); } if( berr != NULL ) { LAPACKE_free( berr ); } if( berr_i != NULL ) { LAPACKE_free( berr_i ); } if( berr_save != NULL ) { LAPACKE_free( berr_save ); } if( work != NULL ) { LAPACKE_free( work ); } if( work_i != NULL ) { LAPACKE_free( work_i ); } if( rwork != NULL ) { LAPACKE_free( rwork ); } if( rwork_i != NULL ) { LAPACKE_free( rwork_i ); } return 0; }
int main(void) { /* Local scalars */ char uplo, uplo_i; lapack_int n, n_i; lapack_int info, info_i; lapack_int i; int failed; /* Local arrays */ lapack_complex_float *ap = NULL, *ap_i = NULL; lapack_complex_float *ap_save = NULL; lapack_complex_float *ap_r = NULL; /* Iniitialize the scalar parameters */ init_scalars_cpptrf( &uplo, &n ); uplo_i = uplo; n_i = n; /* Allocate memory for the LAPACK routine arrays */ ap = (lapack_complex_float *) LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(lapack_complex_float) ); /* Allocate memory for the C interface function arrays */ ap_i = (lapack_complex_float *) LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(lapack_complex_float) ); /* Allocate memory for the backup arrays */ ap_save = (lapack_complex_float *) LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(lapack_complex_float) ); /* Allocate memory for the row-major arrays */ ap_r = (lapack_complex_float *) LAPACKE_malloc( n*(n+1)/2 * sizeof(lapack_complex_float) ); /* Initialize input arrays */ init_ap( (n*(n+1)/2), ap ); /* Backup the ouptut arrays */ for( i = 0; i < (n*(n+1)/2); i++ ) { ap_save[i] = ap[i]; } /* Call the LAPACK routine */ cpptrf_( &uplo, &n, ap, &info ); /* Initialize input data, call the column-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < (n*(n+1)/2); i++ ) { ap_i[i] = ap_save[i]; } info_i = LAPACKE_cpptrf_work( LAPACK_COL_MAJOR, uplo_i, n_i, ap_i ); failed = compare_cpptrf( ap, ap_i, info, info_i, n ); if( failed == 0 ) { printf( "PASSED: column-major middle-level interface to cpptrf\n" ); } else { printf( "FAILED: column-major middle-level interface to cpptrf\n" ); } /* Initialize input data, call the column-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < (n*(n+1)/2); i++ ) { ap_i[i] = ap_save[i]; } info_i = LAPACKE_cpptrf( LAPACK_COL_MAJOR, uplo_i, n_i, ap_i ); failed = compare_cpptrf( ap, ap_i, info, info_i, n ); if( failed == 0 ) { printf( "PASSED: column-major high-level interface to cpptrf\n" ); } else { printf( "FAILED: column-major high-level interface to cpptrf\n" ); } /* Initialize input data, call the row-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < (n*(n+1)/2); i++ ) { ap_i[i] = ap_save[i]; } LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r ); info_i = LAPACKE_cpptrf_work( LAPACK_ROW_MAJOR, uplo_i, n_i, ap_r ); LAPACKE_cpp_trans( LAPACK_ROW_MAJOR, uplo, n, ap_r, ap_i ); failed = compare_cpptrf( ap, ap_i, info, info_i, n ); if( failed == 0 ) { printf( "PASSED: row-major middle-level interface to cpptrf\n" ); } else { printf( "FAILED: row-major middle-level interface to cpptrf\n" ); } /* Initialize input data, call the row-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < (n*(n+1)/2); i++ ) { ap_i[i] = ap_save[i]; } /* Init row_major arrays */ LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r ); info_i = LAPACKE_cpptrf( LAPACK_ROW_MAJOR, uplo_i, n_i, ap_r ); LAPACKE_cpp_trans( LAPACK_ROW_MAJOR, uplo, n, ap_r, ap_i ); failed = compare_cpptrf( ap, ap_i, info, info_i, n ); if( failed == 0 ) { printf( "PASSED: row-major high-level interface to cpptrf\n" ); } else { printf( "FAILED: row-major high-level interface to cpptrf\n" ); } /* Release memory */ if( ap != NULL ) { LAPACKE_free( ap ); } if( ap_i != NULL ) { LAPACKE_free( ap_i ); } if( ap_r != NULL ) { LAPACKE_free( ap_r ); } if( ap_save != NULL ) { LAPACKE_free( ap_save ); } return 0; }
lapack_int LAPACKE_sposvxx_work( int matrix_order, char fact, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* af, lapack_int ldaf, char* equed, float* s, float* b, lapack_int ldb, float* x, lapack_int ldx, float* rcond, float* rpvgrw, float* berr, lapack_int n_err_bnds, float* err_bnds_norm, float* err_bnds_comp, lapack_int nparams, float* params, float* work, lapack_int* iwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_sposvxx( &fact, &uplo, &n, &nrhs, a, &lda, af, &ldaf, equed, s, b, &ldb, x, &ldx, rcond, rpvgrw, berr, &n_err_bnds, err_bnds_norm, err_bnds_comp, &nparams, params, work, iwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,n); lapack_int ldaf_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldx_t = MAX(1,n); float* a_t = NULL; float* af_t = NULL; float* b_t = NULL; float* x_t = NULL; float* err_bnds_norm_t = NULL; float* err_bnds_comp_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -7; LAPACKE_xerbla( "LAPACKE_sposvxx_work", info ); return info; } if( ldaf < n ) { info = -9; LAPACKE_xerbla( "LAPACKE_sposvxx_work", info ); return info; } if( ldb < nrhs ) { info = -13; LAPACKE_xerbla( "LAPACKE_sposvxx_work", info ); return info; } if( ldx < nrhs ) { info = -15; LAPACKE_xerbla( "LAPACKE_sposvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } af_t = (float*)LAPACKE_malloc( sizeof(float) * ldaf_t * MAX(1,n) ); if( af_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) ); if( x_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; } err_bnds_norm_t = (float*) LAPACKE_malloc( sizeof(float) * nrhs * MAX(1,n_err_bnds) ); if( err_bnds_norm_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_4; } err_bnds_comp_t = (float*) LAPACKE_malloc( sizeof(float) * nrhs * MAX(1,n_err_bnds) ); if( err_bnds_comp_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_5; } /* Transpose input matrices */ LAPACKE_spo_trans( matrix_order, uplo, n, a, lda, a_t, lda_t ); if( LAPACKE_lsame( fact, 'f' ) ) { LAPACKE_spo_trans( matrix_order, uplo, n, af, ldaf, af_t, ldaf_t ); } LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sposvxx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, rpvgrw, berr, &n_err_bnds, err_bnds_norm_t, err_bnds_comp_t, &nparams, params, work, iwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { LAPACKE_spo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); } if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { LAPACKE_spo_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); exit_level_5: LAPACKE_free( err_bnds_norm_t ); exit_level_4: LAPACKE_free( x_t ); exit_level_3: LAPACKE_free( b_t ); exit_level_2: LAPACKE_free( af_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_sposvxx_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_sposvxx_work", info ); } return info; }
lapack_int LAPACKE_chesvx_work( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, lapack_complex_float* af, lapack_int ldaf, lapack_int* ipiv, const lapack_complex_float* b, lapack_int ldb, lapack_complex_float* x, lapack_int ldx, float* rcond, float* ferr, float* berr, lapack_complex_float* work, lapack_int lwork, float* rwork ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_chesvx( &fact, &uplo, &n, &nrhs, a, &lda, af, &ldaf, ipiv, b, &ldb, x, &ldx, rcond, ferr, berr, work, &lwork, rwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,n); lapack_int ldaf_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldx_t = MAX(1,n); lapack_complex_float* a_t = NULL; lapack_complex_float* af_t = NULL; lapack_complex_float* b_t = NULL; lapack_complex_float* x_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -7; LAPACKE_xerbla( "LAPACKE_chesvx_work", info ); return info; } if( ldaf < n ) { info = -9; LAPACKE_xerbla( "LAPACKE_chesvx_work", info ); return info; } if( ldb < nrhs ) { info = -12; LAPACKE_xerbla( "LAPACKE_chesvx_work", info ); return info; } if( ldx < nrhs ) { info = -14; LAPACKE_xerbla( "LAPACKE_chesvx_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_chesvx( &fact, &uplo, &n, &nrhs, a, &lda_t, af, &ldaf_t, ipiv, b, &ldb_t, x, &ldx_t, rcond, ferr, berr, work, &lwork, rwork, &info ); return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ a_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } af_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldaf_t * MAX(1,n) ); if( af_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } b_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,nrhs) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } x_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldx_t * MAX(1,nrhs) ); if( x_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; } /* Transpose input matrices */ LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); if( LAPACKE_lsame( fact, 'f' ) ) { LAPACKE_che_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_chesvx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, &lwork, rwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ if( LAPACKE_lsame( fact, 'n' ) ) { LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: LAPACKE_free( b_t ); exit_level_2: LAPACKE_free( af_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_chesvx_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_chesvx_work", info ); } return info; }
lapack_int LAPACKE_strsen_work( int matrix_order, char job, char compq, const lapack_logical* select, lapack_int n, float* t, lapack_int ldt, float* q, lapack_int ldq, float* wr, float* wi, lapack_int* m, float* s, float* sep, float* work, lapack_int lwork, lapack_int* iwork, lapack_int liwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_strsen( &job, &compq, select, &n, t, &ldt, q, &ldq, wr, wi, m, s, sep, work, &lwork, iwork, &liwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int ldq_t = MAX(1,n); lapack_int ldt_t = MAX(1,n); float* t_t = NULL; float* q_t = NULL; /* Check leading dimension(s) */ if( ldq < n ) { info = -9; LAPACKE_xerbla( "LAPACKE_strsen_work", info ); return info; } if( ldt < n ) { info = -7; LAPACKE_xerbla( "LAPACKE_strsen_work", info ); return info; } /* Allocate memory for temporary array T */ t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,n) ); if( t_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } /* Transpose input matrix T */ LAPACKE_sge_trans( matrix_order, n, n, t, ldt, t_t, ldt_t ); /* Query optimal working array(s) size if requested */ if( liwork == -1 || lwork == -1 ) { LAPACK_strsen( &job, &compq, select, &n, t_t, &ldt_t, q, &ldq_t, wr, wi, m, s, sep, work, &lwork, iwork, &liwork, &info ); LAPACKE_free( t_t ); return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ if( LAPACKE_lsame( compq, 'v' ) ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } /* Transpose input matrices */ if( LAPACKE_lsame( compq, 'v' ) ) { LAPACKE_sge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_strsen( &job, &compq, select, &n, t_t, &ldt_t, q_t, &ldq_t, wr, wi, m, s, sep, work, &lwork, iwork, &liwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); if( LAPACKE_lsame( compq, 'v' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ if( LAPACKE_lsame( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( t_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_strsen_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_strsen_work", info ); } return info; }
lapack_int LAPACKE_zhbevd_work( int matrix_order, char jobz, char uplo, lapack_int n, lapack_int kd, lapack_complex_double* ab, lapack_int ldab, double* w, lapack_complex_double* z, lapack_int ldz, lapack_complex_double* work, lapack_int lwork, double* rwork, lapack_int lrwork, lapack_int* iwork, lapack_int liwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_zhbevd( &jobz, &uplo, &n, &kd, ab, &ldab, w, z, &ldz, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int ldab_t = MAX(1,kd+1); lapack_int ldz_t = MAX(1,n); lapack_complex_double* ab_t = NULL; lapack_complex_double* z_t = NULL; /* Check leading dimension(s) */ if( ldab < n ) { info = -7; LAPACKE_xerbla( "LAPACKE_zhbevd_work", info ); return info; } if( ldz < n ) { info = -10; LAPACKE_xerbla( "LAPACKE_zhbevd_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( liwork == -1 || lrwork == -1 || lwork == -1 ) { LAPACK_zhbevd( &jobz, &uplo, &n, &kd, ab, &ldab_t, w, z, &ldz_t, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ ab_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldab_t * MAX(1,n) ); if( ab_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } if( LAPACKE_lsame( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } /* Transpose input matrices */ LAPACKE_zhb_trans( matrix_order, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_zhbevd( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_zhb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); if( LAPACKE_lsame( jobz, 'v' ) ) { LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ if( LAPACKE_lsame( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_zhbevd_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_zhbevd_work", info ); } return info; }
lapack_int LAPACKE_chbevd_2stage( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, lapack_complex_float* ab, lapack_int ldab, float* w, lapack_complex_float* z, lapack_int ldz ) { lapack_int info = 0; lapack_int liwork = -1; lapack_int lrwork = -1; lapack_int lwork = -1; lapack_int* iwork = NULL; float* rwork = NULL; lapack_complex_float* work = NULL; lapack_int iwork_query; float rwork_query; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_chbevd_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } } #endif /* Query optimal working array(s) size */ info = LAPACKE_chbevd_2stage_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { goto exit_level_0; } liwork = (lapack_int)iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_C2INT( work_query ); /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } rwork = (float*)LAPACKE_malloc( sizeof(float) * lrwork ); if( rwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } work = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_2; } /* Call middle-level interface */ info = LAPACKE_chbevd_2stage_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_2: LAPACKE_free( rwork ); exit_level_1: LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_chbevd_2stage", info ); } return info; }
lapack_int LAPACKE_dsygvd_work( int matrix_order, lapack_int itype, char jobz, char uplo, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double* w, double* work, lapack_int lwork, lapack_int* iwork, lapack_int liwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_dsygvd( &itype, &jobz, &uplo, &n, a, &lda, b, &ldb, w, work, &lwork, iwork, &liwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); double* a_t = NULL; double* b_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -7; LAPACKE_xerbla( "LAPACKE_dsygvd_work", info ); return info; } if( ldb < n ) { info = -9; LAPACKE_xerbla( "LAPACKE_dsygvd_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( liwork == -1 || lwork == -1 ) { LAPACK_dsygvd( &itype, &jobz, &uplo, &n, a, &lda_t, b, &ldb_t, w, work, &lwork, iwork, &liwork, &info ); return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } /* Transpose input matrices */ LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t ); LAPACKE_dge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsygvd( &itype, &jobz, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, w, work, &lwork, iwork, &liwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_dsygvd_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_dsygvd_work", info ); } return info; }
lapack_int LAPACKE_cposvxx( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* af, lapack_int ldaf, char* equed, float* s, lapack_complex_float* b, lapack_int ldb, lapack_complex_float* x, lapack_int ldx, float* rcond, float* rpvgrw, float* berr, lapack_int n_err_bnds, float* err_bnds_norm, float* err_bnds_comp, lapack_int nparams, float* params ) { lapack_int info = 0; float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_cposvxx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { return -6; } if( LAPACKE_lsame( fact, 'f' ) ) { if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } if( nparams>0 ) { if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { return -23; } } if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { if( LAPACKE_s_nancheck( n, s, 1 ) ) { return -11; } } #endif /* Allocate memory for working array(s) */ rwork = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) ); if( rwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } work = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * MAX(1,2*n) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } /* Call middle-level interface */ info = LAPACKE_cposvxx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, equed, s, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_1: LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_cposvxx", info ); } return info; }
int main(void) { /* Local scalars */ char uplo, uplo_i; lapack_int n, n_i; lapack_int kd, kd_i; lapack_int nrhs, nrhs_i; lapack_int ldab, ldab_i; lapack_int ldab_r; lapack_int ldafb, ldafb_i; lapack_int ldafb_r; lapack_int ldb, ldb_i; lapack_int ldb_r; lapack_int ldx, ldx_i; lapack_int ldx_r; lapack_int info, info_i; lapack_int i; int failed; /* Local arrays */ float *ab = NULL, *ab_i = NULL; float *afb = NULL, *afb_i = NULL; float *b = NULL, *b_i = NULL; float *x = NULL, *x_i = NULL; float *ferr = NULL, *ferr_i = NULL; float *berr = NULL, *berr_i = NULL; float *work = NULL, *work_i = NULL; lapack_int *iwork = NULL, *iwork_i = NULL; float *x_save = NULL; float *ferr_save = NULL; float *berr_save = NULL; float *ab_r = NULL; float *afb_r = NULL; float *b_r = NULL; float *x_r = NULL; /* Iniitialize the scalar parameters */ init_scalars_spbrfs( &uplo, &n, &kd, &nrhs, &ldab, &ldafb, &ldb, &ldx ); ldab_r = n+2; ldafb_r = n+2; ldb_r = nrhs+2; ldx_r = nrhs+2; uplo_i = uplo; n_i = n; kd_i = kd; nrhs_i = nrhs; ldab_i = ldab; ldafb_i = ldafb; ldb_i = ldb; ldx_i = ldx; /* Allocate memory for the LAPACK routine arrays */ ab = (float *)LAPACKE_malloc( ldab*n * sizeof(float) ); afb = (float *)LAPACKE_malloc( ldafb*n * sizeof(float) ); b = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) ); x = (float *)LAPACKE_malloc( ldx*nrhs * sizeof(float) ); ferr = (float *)LAPACKE_malloc( nrhs * sizeof(float) ); berr = (float *)LAPACKE_malloc( nrhs * sizeof(float) ); work = (float *)LAPACKE_malloc( 3*n * sizeof(float) ); iwork = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) ); /* Allocate memory for the C interface function arrays */ ab_i = (float *)LAPACKE_malloc( ldab*n * sizeof(float) ); afb_i = (float *)LAPACKE_malloc( ldafb*n * sizeof(float) ); b_i = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) ); x_i = (float *)LAPACKE_malloc( ldx*nrhs * sizeof(float) ); ferr_i = (float *)LAPACKE_malloc( nrhs * sizeof(float) ); berr_i = (float *)LAPACKE_malloc( nrhs * sizeof(float) ); work_i = (float *)LAPACKE_malloc( 3*n * sizeof(float) ); iwork_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) ); /* Allocate memory for the backup arrays */ x_save = (float *)LAPACKE_malloc( ldx*nrhs * sizeof(float) ); ferr_save = (float *)LAPACKE_malloc( nrhs * sizeof(float) ); berr_save = (float *)LAPACKE_malloc( nrhs * sizeof(float) ); /* Allocate memory for the row-major arrays */ ab_r = (float *)LAPACKE_malloc( (kd+1)*(n+2) * sizeof(float) ); afb_r = (float *)LAPACKE_malloc( (kd+1)*(n+2) * sizeof(float) ); b_r = (float *)LAPACKE_malloc( n*(nrhs+2) * sizeof(float) ); x_r = (float *)LAPACKE_malloc( n*(nrhs+2) * sizeof(float) ); /* Initialize input arrays */ init_ab( ldab*n, ab ); init_afb( ldafb*n, afb ); init_b( ldb*nrhs, b ); init_x( ldx*nrhs, x ); init_ferr( nrhs, ferr ); init_berr( nrhs, berr ); init_work( 3*n, work ); init_iwork( n, iwork ); /* Backup the ouptut arrays */ for( i = 0; i < ldx*nrhs; i++ ) { x_save[i] = x[i]; } for( i = 0; i < nrhs; i++ ) { ferr_save[i] = ferr[i]; } for( i = 0; i < nrhs; i++ ) { berr_save[i] = berr[i]; } /* Call the LAPACK routine */ spbrfs_( &uplo, &n, &kd, &nrhs, ab, &ldab, afb, &ldafb, b, &ldb, x, &ldx, ferr, berr, work, iwork, &info ); /* Initialize input data, call the column-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < ldab*n; i++ ) { ab_i[i] = ab[i]; } for( i = 0; i < ldafb*n; i++ ) { afb_i[i] = afb[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b[i]; } for( i = 0; i < ldx*nrhs; i++ ) { x_i[i] = x_save[i]; } for( i = 0; i < nrhs; i++ ) { ferr_i[i] = ferr_save[i]; } for( i = 0; i < nrhs; i++ ) { berr_i[i] = berr_save[i]; } for( i = 0; i < 3*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { iwork_i[i] = iwork[i]; } info_i = LAPACKE_spbrfs_work( LAPACK_COL_MAJOR, uplo_i, n_i, kd_i, nrhs_i, ab_i, ldab_i, afb_i, ldafb_i, b_i, ldb_i, x_i, ldx_i, ferr_i, berr_i, work_i, iwork_i ); failed = compare_spbrfs( x, x_i, ferr, ferr_i, berr, berr_i, info, info_i, ldx, nrhs ); if( failed == 0 ) { printf( "PASSED: column-major middle-level interface to spbrfs\n" ); } else { printf( "FAILED: column-major middle-level interface to spbrfs\n" ); } /* Initialize input data, call the column-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < ldab*n; i++ ) { ab_i[i] = ab[i]; } for( i = 0; i < ldafb*n; i++ ) { afb_i[i] = afb[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b[i]; } for( i = 0; i < ldx*nrhs; i++ ) { x_i[i] = x_save[i]; } for( i = 0; i < nrhs; i++ ) { ferr_i[i] = ferr_save[i]; } for( i = 0; i < nrhs; i++ ) { berr_i[i] = berr_save[i]; } for( i = 0; i < 3*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { iwork_i[i] = iwork[i]; } info_i = LAPACKE_spbrfs( LAPACK_COL_MAJOR, uplo_i, n_i, kd_i, nrhs_i, ab_i, ldab_i, afb_i, ldafb_i, b_i, ldb_i, x_i, ldx_i, ferr_i, berr_i ); failed = compare_spbrfs( x, x_i, ferr, ferr_i, berr, berr_i, info, info_i, ldx, nrhs ); if( failed == 0 ) { printf( "PASSED: column-major high-level interface to spbrfs\n" ); } else { printf( "FAILED: column-major high-level interface to spbrfs\n" ); } /* Initialize input data, call the row-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < ldab*n; i++ ) { ab_i[i] = ab[i]; } for( i = 0; i < ldafb*n; i++ ) { afb_i[i] = afb[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b[i]; } for( i = 0; i < ldx*nrhs; i++ ) { x_i[i] = x_save[i]; } for( i = 0; i < nrhs; i++ ) { ferr_i[i] = ferr_save[i]; } for( i = 0; i < nrhs; i++ ) { berr_i[i] = berr_save[i]; } for( i = 0; i < 3*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { iwork_i[i] = iwork[i]; } LAPACKE_sge_trans( LAPACK_COL_MAJOR, kd+1, n, ab_i, ldab, ab_r, n+2 ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, kd+1, n, afb_i, ldafb, afb_r, n+2 ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 ); info_i = LAPACKE_spbrfs_work( LAPACK_ROW_MAJOR, uplo_i, n_i, kd_i, nrhs_i, ab_r, ldab_r, afb_r, ldafb_r, b_r, ldb_r, x_r, ldx_r, ferr_i, berr_i, work_i, iwork_i ); LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, nrhs, x_r, nrhs+2, x_i, ldx ); failed = compare_spbrfs( x, x_i, ferr, ferr_i, berr, berr_i, info, info_i, ldx, nrhs ); if( failed == 0 ) { printf( "PASSED: row-major middle-level interface to spbrfs\n" ); } else { printf( "FAILED: row-major middle-level interface to spbrfs\n" ); } /* Initialize input data, call the row-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < ldab*n; i++ ) { ab_i[i] = ab[i]; } for( i = 0; i < ldafb*n; i++ ) { afb_i[i] = afb[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b[i]; } for( i = 0; i < ldx*nrhs; i++ ) { x_i[i] = x_save[i]; } for( i = 0; i < nrhs; i++ ) { ferr_i[i] = ferr_save[i]; } for( i = 0; i < nrhs; i++ ) { berr_i[i] = berr_save[i]; } for( i = 0; i < 3*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { iwork_i[i] = iwork[i]; } /* Init row_major arrays */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, kd+1, n, ab_i, ldab, ab_r, n+2 ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, kd+1, n, afb_i, ldafb, afb_r, n+2 ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 ); info_i = LAPACKE_spbrfs( LAPACK_ROW_MAJOR, uplo_i, n_i, kd_i, nrhs_i, ab_r, ldab_r, afb_r, ldafb_r, b_r, ldb_r, x_r, ldx_r, ferr_i, berr_i ); LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, nrhs, x_r, nrhs+2, x_i, ldx ); failed = compare_spbrfs( x, x_i, ferr, ferr_i, berr, berr_i, info, info_i, ldx, nrhs ); if( failed == 0 ) { printf( "PASSED: row-major high-level interface to spbrfs\n" ); } else { printf( "FAILED: row-major high-level interface to spbrfs\n" ); } /* Release memory */ if( ab != NULL ) { LAPACKE_free( ab ); } if( ab_i != NULL ) { LAPACKE_free( ab_i ); } if( ab_r != NULL ) { LAPACKE_free( ab_r ); } if( afb != NULL ) { LAPACKE_free( afb ); } if( afb_i != NULL ) { LAPACKE_free( afb_i ); } if( afb_r != NULL ) { LAPACKE_free( afb_r ); } if( b != NULL ) { LAPACKE_free( b ); } if( b_i != NULL ) { LAPACKE_free( b_i ); } if( b_r != NULL ) { LAPACKE_free( b_r ); } if( x != NULL ) { LAPACKE_free( x ); } if( x_i != NULL ) { LAPACKE_free( x_i ); } if( x_r != NULL ) { LAPACKE_free( x_r ); } if( x_save != NULL ) { LAPACKE_free( x_save ); } if( ferr != NULL ) { LAPACKE_free( ferr ); } if( ferr_i != NULL ) { LAPACKE_free( ferr_i ); } if( ferr_save != NULL ) { LAPACKE_free( ferr_save ); } if( berr != NULL ) { LAPACKE_free( berr ); } if( berr_i != NULL ) { LAPACKE_free( berr_i ); } if( berr_save != NULL ) { LAPACKE_free( berr_save ); } if( work != NULL ) { LAPACKE_free( work ); } if( work_i != NULL ) { LAPACKE_free( work_i ); } if( iwork != NULL ) { LAPACKE_free( iwork ); } if( iwork_i != NULL ) { LAPACKE_free( iwork_i ); } return 0; }
lapack_int LAPACKE_sggbal_work( int matrix_layout, char job, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, lapack_int* ilo, lapack_int* ihi, float* lscale, float* rscale, float* work ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_sggbal( &job, &n, a, &lda, b, &ldb, ilo, ihi, lscale, rscale, work, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); float* a_t = NULL; float* b_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -5; LAPACKE_xerbla( "LAPACKE_sggbal_work", info ); return info; } if( ldb < n ) { info = -7; LAPACKE_xerbla( "LAPACKE_sggbal_work", info ); return info; } /* Allocate memory for temporary array(s) */ if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } } if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } /* Transpose input matrices */ if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); } if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); } /* Call LAPACK function and adjust info */ LAPACK_sggbal( &job, &n, a_t, &lda_t, b_t, &ldb_t, ilo, ihi, lscale, rscale, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); } /* Release memory and exit */ if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { LAPACKE_free( b_t ); } exit_level_1: if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { LAPACKE_free( a_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_sggbal_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_sggbal_work", info ); } return info; }
lapack_int LAPACKE_dorbdb( int matrix_layout, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, double* x11, lapack_int ldx11, double* x12, lapack_int ldx12, double* x21, lapack_int ldx21, double* x22, lapack_int ldx22, double* theta, double* phi, double* taup1, double* taup2, double* tauq1, double* tauq2 ) { lapack_int info = 0; lapack_int lwork = -1; double* work = NULL; double work_query; lapack_int nrows_x11, nrows_x12, nrows_x21, nrows_x22; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_dorbdb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q); nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q); nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q); nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q); if( LAPACKE_dge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) { return -7; } if( LAPACKE_dge_nancheck( matrix_layout, nrows_x12, m-q, x12, ldx12 ) ) { return -9; } if( LAPACKE_dge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) { return -11; } if( LAPACKE_dge_nancheck( matrix_layout, nrows_x22, m-q, x22, ldx22 ) ) { return -13; } #endif /* Query optimal working array(s) size */ info = LAPACKE_dorbdb_work( matrix_layout, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, phi, taup1, taup2, tauq1, tauq2, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; } lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } /* Call middle-level interface */ info = LAPACKE_dorbdb_work( matrix_layout, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, phi, taup1, taup2, tauq1, tauq2, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_dorbdb", info ); } return info; }
lapack_int LAPACKE_ztrrfs_work( int matrix_order, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* b, lapack_int ldb, const lapack_complex_double* x, lapack_int ldx, double* ferr, double* berr, lapack_complex_double* work, double* rwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_ztrrfs( &uplo, &trans, &diag, &n, &nrhs, a, &lda, b, &ldb, x, &ldx, ferr, berr, work, rwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldx_t = MAX(1,n); lapack_complex_double* a_t = NULL; lapack_complex_double* b_t = NULL; lapack_complex_double* x_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -8; LAPACKE_xerbla( "LAPACKE_ztrrfs_work", info ); return info; } if( ldb < nrhs ) { info = -10; LAPACKE_xerbla( "LAPACKE_ztrrfs_work", info ); return info; } if( ldx < nrhs ) { info = -12; LAPACKE_xerbla( "LAPACKE_ztrrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ a_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } b_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldb_t * MAX(1,nrhs) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } x_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldx_t * MAX(1,nrhs) ); if( x_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } /* Transpose input matrices */ LAPACKE_ztr_trans( matrix_order, uplo, diag, n, a, lda, a_t, lda_t ); LAPACKE_zge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t ); LAPACKE_zge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_ztrrfs( &uplo, &trans, &diag, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); if( info < 0 ) { info = info - 1; } /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_2: LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_ztrrfs_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_ztrrfs_work", info ); } return info; }
lapack_int LAPACKE_ctgsja_work( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, lapack_int k, lapack_int l, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, float tola, float tolb, float* alpha, float* beta, lapack_complex_float* u, lapack_int ldu, lapack_complex_float* v, lapack_int ldv, lapack_complex_float* q, lapack_int ldq, lapack_complex_float* work, lapack_int* ncycle ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_ctgsja( &jobu, &jobv, &jobq, &m, &p, &n, &k, &l, a, &lda, b, &ldb, &tola, &tolb, alpha, beta, u, &ldu, v, &ldv, q, &ldq, work, ncycle, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,m); lapack_int ldb_t = MAX(1,p); lapack_int ldq_t = MAX(1,n); lapack_int ldu_t = MAX(1,m); lapack_int ldv_t = MAX(1,p); lapack_complex_float* a_t = NULL; lapack_complex_float* b_t = NULL; lapack_complex_float* u_t = NULL; lapack_complex_float* v_t = NULL; lapack_complex_float* q_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -11; LAPACKE_xerbla( "LAPACKE_ctgsja_work", info ); return info; } if( ldb < n ) { info = -13; LAPACKE_xerbla( "LAPACKE_ctgsja_work", info ); return info; } if( ldq < n ) { info = -23; LAPACKE_xerbla( "LAPACKE_ctgsja_work", info ); return info; } if( ldu < m ) { info = -19; LAPACKE_xerbla( "LAPACKE_ctgsja_work", info ); return info; } if( ldv < p ) { info = -21; LAPACKE_xerbla( "LAPACKE_ctgsja_work", info ); return info; } /* Allocate memory for temporary array(s) */ a_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } b_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,n) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { u_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldu_t * MAX(1,m) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { v_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldv_t * MAX(1,p) ); if( v_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; } } if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { q_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_4; } } /* Transpose input matrices */ LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); LAPACKE_cge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); if( LAPACKE_lsame( jobu, 'u' ) ) { LAPACKE_cge_trans( matrix_layout, m, m, u, ldu, u_t, ldu_t ); } if( LAPACKE_lsame( jobv, 'v' ) ) { LAPACKE_cge_trans( matrix_layout, p, p, v, ldv, v_t, ldv_t ); } if( LAPACKE_lsame( jobq, 'q' ) ) { LAPACKE_cge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_ctgsja( &jobu, &jobv, &jobq, &m, &p, &n, &k, &l, a_t, &lda_t, b_t, &ldb_t, &tola, &tolb, alpha, beta, u_t, &ldu_t, v_t, &ldv_t, q_t, &ldq_t, work, ncycle, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); LAPACKE_cge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); } if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { LAPACKE_cge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv ); } if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_ctgsja_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_ctgsja_work", info ); } return info; }