lapack_int LAPACKE_ssptrs( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* ap, const lapack_int* ipiv, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_ssptrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ if( LAPACKE_ssp_nancheck( n, ap ) ) { return -5; } if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif return LAPACKE_ssptrs_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); }
int main(void) { /* Local scalars */ char uplo, uplo_i; lapack_int n, n_i; lapack_int nrhs, nrhs_i; lapack_int ldb, ldb_i; lapack_int ldb_r; lapack_int info, info_i; lapack_int i; int failed; /* Local arrays */ float *ap = NULL, *ap_i = NULL; lapack_int *ipiv = NULL, *ipiv_i = NULL; float *b = NULL, *b_i = NULL; float *b_save = NULL; float *ap_r = NULL; float *b_r = NULL; /* Iniitialize the scalar parameters */ init_scalars_ssptrs( &uplo, &n, &nrhs, &ldb ); ldb_r = nrhs+2; uplo_i = uplo; n_i = n; nrhs_i = nrhs; ldb_i = ldb; /* Allocate memory for the LAPACK routine arrays */ ap = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) ); ipiv = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) ); b = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) ); /* Allocate memory for the C interface function arrays */ ap_i = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) ); ipiv_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) ); b_i = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) ); /* Allocate memory for the backup arrays */ b_save = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) ); /* Allocate memory for the row-major arrays */ ap_r = (float *)LAPACKE_malloc( n*(n+1)/2 * sizeof(float) ); b_r = (float *)LAPACKE_malloc( n*(nrhs+2) * sizeof(float) ); /* Initialize input arrays */ init_ap( (n*(n+1)/2), ap ); init_ipiv( n, ipiv ); init_b( ldb*nrhs, b ); /* Backup the ouptut arrays */ for( i = 0; i < ldb*nrhs; i++ ) { b_save[i] = b[i]; } /* Call the LAPACK routine */ ssptrs_( &uplo, &n, &nrhs, ap, ipiv, b, &ldb, &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[i]; } for( i = 0; i < n; i++ ) { ipiv_i[i] = ipiv[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b_save[i]; } info_i = LAPACKE_ssptrs_work( LAPACK_COL_MAJOR, uplo_i, n_i, nrhs_i, ap_i, ipiv_i, b_i, ldb_i ); failed = compare_ssptrs( b, b_i, info, info_i, ldb, nrhs ); if( failed == 0 ) { printf( "PASSED: column-major middle-level interface to ssptrs\n" ); } else { printf( "FAILED: column-major middle-level interface to ssptrs\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[i]; } for( i = 0; i < n; i++ ) { ipiv_i[i] = ipiv[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b_save[i]; } info_i = LAPACKE_ssptrs( LAPACK_COL_MAJOR, uplo_i, n_i, nrhs_i, ap_i, ipiv_i, b_i, ldb_i ); failed = compare_ssptrs( b, b_i, info, info_i, ldb, nrhs ); if( failed == 0 ) { printf( "PASSED: column-major high-level interface to ssptrs\n" ); } else { printf( "FAILED: column-major high-level interface to ssptrs\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[i]; } for( i = 0; i < n; i++ ) { ipiv_i[i] = ipiv[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b_save[i]; } LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 ); info_i = LAPACKE_ssptrs_work( LAPACK_ROW_MAJOR, uplo_i, n_i, nrhs_i, ap_r, ipiv_i, b_r, ldb_r ); LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, nrhs, b_r, nrhs+2, b_i, ldb ); failed = compare_ssptrs( b, b_i, info, info_i, ldb, nrhs ); if( failed == 0 ) { printf( "PASSED: row-major middle-level interface to ssptrs\n" ); } else { printf( "FAILED: row-major middle-level interface to ssptrs\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[i]; } for( i = 0; i < n; i++ ) { ipiv_i[i] = ipiv[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b_save[i]; } /* Init row_major arrays */ LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 ); info_i = LAPACKE_ssptrs( LAPACK_ROW_MAJOR, uplo_i, n_i, nrhs_i, ap_r, ipiv_i, b_r, ldb_r ); LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, nrhs, b_r, nrhs+2, b_i, ldb ); failed = compare_ssptrs( b, b_i, info, info_i, ldb, nrhs ); if( failed == 0 ) { printf( "PASSED: row-major high-level interface to ssptrs\n" ); } else { printf( "FAILED: row-major high-level interface to ssptrs\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( ipiv != NULL ) { LAPACKE_free( ipiv ); } if( ipiv_i != NULL ) { LAPACKE_free( ipiv_i ); } if( b != NULL ) { LAPACKE_free( b ); } if( b_i != NULL ) { LAPACKE_free( b_i ); } if( b_r != NULL ) { LAPACKE_free( b_r ); } if( b_save != NULL ) { LAPACKE_free( b_save ); } return 0; }