1 /*
2
3 Copyright (C) 2014, The University of Texas at Austin
4
5 This file is part of libflame and is available under the 3-Clause
6 BSD license, which can be found in the LICENSE file at the top-level
7 directory, or at http://opensource.org/licenses/BSD-3-Clause
8
9 */
10
11 #include "FLAME.h"
12
FLA_Trinv_blk_external(FLA_Uplo uplo,FLA_Diag diag,FLA_Obj A)13 FLA_Error FLA_Trinv_blk_external( FLA_Uplo uplo, FLA_Diag diag, FLA_Obj A )
14 {
15 FLA_Error r_val = FLA_SUCCESS;
16 #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES
17 int info;
18 FLA_Datatype datatype;
19 int m_A, cs_A;
20 char blas_uplo;
21 char blas_diag;
22
23 if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
24 FLA_Trinv_check( uplo, diag, A );
25
26 if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
27
28 datatype = FLA_Obj_datatype( A );
29
30 m_A = FLA_Obj_length( A );
31 cs_A = FLA_Obj_col_stride( A );
32
33 FLA_Param_map_flame_to_netlib_uplo( uplo, &blas_uplo );
34 FLA_Param_map_flame_to_netlib_diag( diag, &blas_diag );
35
36
37 switch( datatype ){
38
39 case FLA_FLOAT:
40 {
41 float *buff_A = ( float * ) FLA_FLOAT_PTR( A );
42
43 F77_strtri( &blas_uplo,
44 &blas_diag,
45 &m_A,
46 buff_A, &cs_A,
47 &info );
48
49 break;
50 }
51
52 case FLA_DOUBLE:
53 {
54 double *buff_A = ( double * ) FLA_DOUBLE_PTR( A );
55
56 F77_dtrtri( &blas_uplo,
57 &blas_diag,
58 &m_A,
59 buff_A, &cs_A,
60 &info );
61
62 break;
63 }
64
65 case FLA_COMPLEX:
66 {
67 scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
68
69 F77_ctrtri( &blas_uplo,
70 &blas_diag,
71 &m_A,
72 buff_A, &cs_A,
73 &info );
74
75 break;
76 }
77
78 case FLA_DOUBLE_COMPLEX:
79 {
80 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
81
82 F77_ztrtri( &blas_uplo,
83 &blas_diag,
84 &m_A,
85 buff_A, &cs_A,
86 &info );
87
88 break;
89 }
90
91 }
92
93 // Convert to zero-based indexing, if an index was reported.
94 if ( info > 0 ) r_val = info - 1;
95 else r_val = FLA_SUCCESS;
96
97 #else
98 FLA_Check_error_code( FLA_EXTERNAL_LAPACK_NOT_IMPLEMENTED );
99 #endif
100
101 return r_val;
102 }
103
FLA_Trinv_ln_blk_ext(FLA_Obj A)104 FLA_Error FLA_Trinv_ln_blk_ext( FLA_Obj A )
105 {
106 return FLA_Trinv_blk_external( FLA_LOWER_TRIANGULAR, FLA_NONUNIT_DIAG, A );
107 }
108
FLA_Trinv_lu_blk_ext(FLA_Obj A)109 FLA_Error FLA_Trinv_lu_blk_ext( FLA_Obj A )
110 {
111 return FLA_Trinv_blk_external( FLA_LOWER_TRIANGULAR, FLA_UNIT_DIAG, A );
112 }
113
FLA_Trinv_un_blk_ext(FLA_Obj A)114 FLA_Error FLA_Trinv_un_blk_ext( FLA_Obj A )
115 {
116 return FLA_Trinv_blk_external( FLA_UPPER_TRIANGULAR, FLA_NONUNIT_DIAG, A );
117 }
118
FLA_Trinv_uu_blk_ext(FLA_Obj A)119 FLA_Error FLA_Trinv_uu_blk_ext( FLA_Obj A )
120 {
121 return FLA_Trinv_blk_external( FLA_UPPER_TRIANGULAR, FLA_UNIT_DIAG, A );
122 }
123
124