lapack_int LAPACKE_ztrexc( int matrix_order, char compq, lapack_int n, lapack_complex_double* t, lapack_int ldt, lapack_complex_double* q, lapack_int ldq, lapack_int ifst, lapack_int ilst ) { if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_ztrexc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ if( LAPACKE_lsame( compq, 'v' ) ) { if( LAPACKE_zge_nancheck( matrix_order, n, n, q, ldq ) ) { return -6; } } if( LAPACKE_zge_nancheck( matrix_order, n, n, t, ldt ) ) { return -4; } #endif return LAPACKE_ztrexc_work( matrix_order, compq, n, t, ldt, q, ldq, ifst, ilst ); }
int main(void) { /* Local scalars */ char compq, compq_i; lapack_int n, n_i; lapack_int ldt, ldt_i; lapack_int ldt_r; lapack_int ldq, ldq_i; lapack_int ldq_r; lapack_int ifst, ifst_i; lapack_int ilst, ilst_i; lapack_int info, info_i; lapack_int i; int failed; /* Local arrays */ lapack_complex_double *t = NULL, *t_i = NULL; lapack_complex_double *q = NULL, *q_i = NULL; lapack_complex_double *t_save = NULL; lapack_complex_double *q_save = NULL; lapack_complex_double *t_r = NULL; lapack_complex_double *q_r = NULL; /* Iniitialize the scalar parameters */ init_scalars_ztrexc( &compq, &n, &ldt, &ldq, &ifst, &ilst ); ldt_r = n+2; ldq_r = n+2; compq_i = compq; n_i = n; ldt_i = ldt; ldq_i = ldq; ifst_i = ifst; ilst_i = ilst; /* Allocate memory for the LAPACK routine arrays */ t = (lapack_complex_double *) LAPACKE_malloc( ldt*n * sizeof(lapack_complex_double) ); q = (lapack_complex_double *) LAPACKE_malloc( ldq*n * sizeof(lapack_complex_double) ); /* Allocate memory for the C interface function arrays */ t_i = (lapack_complex_double *) LAPACKE_malloc( ldt*n * sizeof(lapack_complex_double) ); q_i = (lapack_complex_double *) LAPACKE_malloc( ldq*n * sizeof(lapack_complex_double) ); /* Allocate memory for the backup arrays */ t_save = (lapack_complex_double *) LAPACKE_malloc( ldt*n * sizeof(lapack_complex_double) ); q_save = (lapack_complex_double *) LAPACKE_malloc( ldq*n * sizeof(lapack_complex_double) ); /* Allocate memory for the row-major arrays */ t_r = (lapack_complex_double *) LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_double) ); q_r = (lapack_complex_double *) LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_double) ); /* Initialize input arrays */ init_t( ldt*n, t ); init_q( ldq*n, q ); /* Backup the ouptut arrays */ for( i = 0; i < ldt*n; i++ ) { t_save[i] = t[i]; } for( i = 0; i < ldq*n; i++ ) { q_save[i] = q[i]; } /* Call the LAPACK routine */ ztrexc_( &compq, &n, t, &ldt, q, &ldq, &ifst, &ilst, &info ); /* Initialize input data, call the column-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < ldt*n; i++ ) { t_i[i] = t_save[i]; } for( i = 0; i < ldq*n; i++ ) { q_i[i] = q_save[i]; } info_i = LAPACKE_ztrexc_work( LAPACK_COL_MAJOR, compq_i, n_i, t_i, ldt_i, q_i, ldq_i, ifst_i, ilst_i ); failed = compare_ztrexc( t, t_i, q, q_i, info, info_i, compq, ldq, ldt, n ); if( failed == 0 ) { printf( "PASSED: column-major middle-level interface to ztrexc\n" ); } else { printf( "FAILED: column-major middle-level interface to ztrexc\n" ); } /* Initialize input data, call the column-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < ldt*n; i++ ) { t_i[i] = t_save[i]; } for( i = 0; i < ldq*n; i++ ) { q_i[i] = q_save[i]; } info_i = LAPACKE_ztrexc( LAPACK_COL_MAJOR, compq_i, n_i, t_i, ldt_i, q_i, ldq_i, ifst_i, ilst_i ); failed = compare_ztrexc( t, t_i, q, q_i, info, info_i, compq, ldq, ldt, n ); if( failed == 0 ) { printf( "PASSED: column-major high-level interface to ztrexc\n" ); } else { printf( "FAILED: column-major high-level interface to ztrexc\n" ); } /* Initialize input data, call the row-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < ldt*n; i++ ) { t_i[i] = t_save[i]; } for( i = 0; i < ldq*n; i++ ) { q_i[i] = q_save[i]; } LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, t_i, ldt, t_r, n+2 ); if( LAPACKE_lsame( compq, 'v' ) ) { LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_i, ldq, q_r, n+2 ); } info_i = LAPACKE_ztrexc_work( LAPACK_ROW_MAJOR, compq_i, n_i, t_r, ldt_r, q_r, ldq_r, ifst_i, ilst_i ); LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, n, t_r, n+2, t_i, ldt ); if( LAPACKE_lsame( compq, 'v' ) ) { LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, n, q_r, n+2, q_i, ldq ); } failed = compare_ztrexc( t, t_i, q, q_i, info, info_i, compq, ldq, ldt, n ); if( failed == 0 ) { printf( "PASSED: row-major middle-level interface to ztrexc\n" ); } else { printf( "FAILED: row-major middle-level interface to ztrexc\n" ); } /* Initialize input data, call the row-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < ldt*n; i++ ) { t_i[i] = t_save[i]; } for( i = 0; i < ldq*n; i++ ) { q_i[i] = q_save[i]; } /* Init row_major arrays */ LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, t_i, ldt, t_r, n+2 ); if( LAPACKE_lsame( compq, 'v' ) ) { LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_i, ldq, q_r, n+2 ); } info_i = LAPACKE_ztrexc( LAPACK_ROW_MAJOR, compq_i, n_i, t_r, ldt_r, q_r, ldq_r, ifst_i, ilst_i ); LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, n, t_r, n+2, t_i, ldt ); if( LAPACKE_lsame( compq, 'v' ) ) { LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, n, q_r, n+2, q_i, ldq ); } failed = compare_ztrexc( t, t_i, q, q_i, info, info_i, compq, ldq, ldt, n ); if( failed == 0 ) { printf( "PASSED: row-major high-level interface to ztrexc\n" ); } else { printf( "FAILED: row-major high-level interface to ztrexc\n" ); } /* Release memory */ if( t != NULL ) { LAPACKE_free( t ); } if( t_i != NULL ) { LAPACKE_free( t_i ); } if( t_r != NULL ) { LAPACKE_free( t_r ); } if( t_save != NULL ) { LAPACKE_free( t_save ); } if( q != NULL ) { LAPACKE_free( q ); } if( q_i != NULL ) { LAPACKE_free( q_i ); } if( q_r != NULL ) { LAPACKE_free( q_r ); } if( q_save != NULL ) { LAPACKE_free( q_save ); } return 0; }