Functions | |
FLA_Error | FLA_Trsm_external (FLA_Side side, FLA_Uplo uplo, FLA_Trans trans, FLA_Diag diag, FLA_Obj alpha, FLA_Obj A, FLA_Obj B) |
void FLA_F2C() | fla_trsm_external_f (F_INT *side, F_INT *uplo, F_INT *trans, F_INT *diag, F_INT *alpha, F_INT *A, F_INT *B, F_INT *IERROR) |
FLA_Error FLA_Trsm_external | ( | FLA_Side | side, | |
FLA_Uplo | uplo, | |||
FLA_Trans | trans, | |||
FLA_Diag | diag, | |||
FLA_Obj | alpha, | |||
FLA_Obj | A, | |||
FLA_Obj | B | |||
) |
References cblas_ctrsm(), cblas_dtrsm(), cblas_strsm(), cblas_ztrsm(), CblasColMajor, ctrsm(), dtrsm(), FLA_Check_error_level(), FLA_Copyt_external(), FLA_Obj_create_conf_to(), FLA_Obj_datatype(), FLA_Obj_free(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_width(), FLA_Param_map_to_blas_diag(), FLA_Param_map_to_blas_side(), FLA_Param_map_to_blas_trans(), FLA_Param_map_to_blas_uplo(), FLA_Trsm_check(), strsm(), and ztrsm().
Referenced by FLA_LQ_UT_Accum_T_blk_var1(), FLA_LQ_UT_blk_var2(), FLA_LU_nopiv_blk_var1(), FLA_LU_nopiv_blk_var2(), FLA_LU_nopiv_blk_var3(), FLA_LU_nopiv_unb_var1(), FLA_LU_nopiv_unb_var2(), FLA_LU_nopiv_unb_var3(), FLA_LU_piv_blk_var3(), FLA_LU_piv_unb_var3(), FLA_LU_piv_unb_var3b(), FLA_QR_UT_Accum_T_blk_var1(), FLA_QR_UT_blk_var2(), FLA_SA_FS_blk(), FLA_SA_LU_blk(), FLA_Trsm(), fla_trsm_external_f(), FLA_Trsm_llh_task(), FLA_Trsm_lln_task(), FLA_Trsm_llt_task(), FLA_Trsm_luh_task(), FLA_Trsm_lun_task(), FLA_Trsm_lut_task(), FLA_Trsm_piv_task(), FLA_Trsm_rlh_task(), FLA_Trsm_rln_task(), FLA_Trsm_rlt_task(), FLA_Trsm_ruh_task(), FLA_Trsm_run_task(), FLA_Trsm_rut_task(), FLA_Trsm_task(), and FLA_Trsmsx_external().
00036 { 00037 FLA_Datatype datatype; 00038 int ldim_A; 00039 int m_B, n_B, ldim_B; 00040 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00041 CBLAS_ORDER cblas_order = CblasColMajor; 00042 CBLAS_SIDE blas_side; 00043 CBLAS_UPLO blas_uplo; 00044 CBLAS_TRANSPOSE blas_trans; 00045 CBLAS_DIAG blas_diag; 00046 #else 00047 char blas_side; 00048 char blas_uplo; 00049 char blas_trans; 00050 char blas_diag; 00051 #endif 00052 FLA_Obj A_copy; 00053 00054 if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 00055 FLA_Trsm_check( side, uplo, trans, diag, alpha, A, B ); 00056 00057 if ( FLA_Obj_has_zero_dim( B ) ) return FLA_SUCCESS; 00058 00059 datatype = FLA_Obj_datatype( A ); 00060 00061 ldim_A = FLA_Obj_ldim( A ); 00062 00063 m_B = FLA_Obj_length( B ); 00064 n_B = FLA_Obj_width( B ); 00065 ldim_B = FLA_Obj_ldim( B ); 00066 00067 if ( trans == FLA_CONJ_NO_TRANSPOSE ) 00068 { 00069 FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, A, &A_copy ); 00070 FLA_Copyt_external( FLA_CONJ_NO_TRANSPOSE, A, A_copy ); 00071 00072 ldim_A = FLA_Obj_ldim( A_copy ); 00073 } 00074 else 00075 { 00076 A_copy = A; 00077 } 00078 00079 FLA_Param_map_to_blas_side( side, &blas_side ); 00080 FLA_Param_map_to_blas_uplo( uplo, &blas_uplo ); 00081 FLA_Param_map_to_blas_trans( trans, &blas_trans ); 00082 FLA_Param_map_to_blas_diag( diag, &blas_diag ); 00083 00084 00085 switch( datatype ){ 00086 00087 case FLA_FLOAT: 00088 { 00089 float *buff_A = ( float * ) FLA_FLOAT_PTR( A ); 00090 float *buff_B = ( float * ) FLA_FLOAT_PTR( B ); 00091 float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha ); 00092 00093 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00094 cblas_strsm( cblas_order, 00095 blas_side, 00096 blas_uplo, 00097 blas_trans, 00098 blas_diag, 00099 m_B, 00100 n_B, 00101 *buff_alpha, 00102 buff_A, ldim_A, 00103 buff_B, ldim_B ); 00104 #else 00105 FLA_C2F( strsm )( &blas_side, 00106 &blas_uplo, 00107 &blas_trans, 00108 &blas_diag, 00109 &m_B, 00110 &n_B, 00111 buff_alpha, 00112 buff_A, &ldim_A, 00113 buff_B, &ldim_B ); 00114 #endif 00115 break; 00116 } 00117 00118 case FLA_DOUBLE: 00119 { 00120 double *buff_A = ( double * ) FLA_DOUBLE_PTR( A ); 00121 double *buff_B = ( double * ) FLA_DOUBLE_PTR( B ); 00122 double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha ); 00123 00124 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00125 cblas_dtrsm( cblas_order, 00126 blas_side, 00127 blas_uplo, 00128 blas_trans, 00129 blas_diag, 00130 m_B, 00131 n_B, 00132 *buff_alpha, 00133 buff_A, ldim_A, 00134 buff_B, ldim_B ); 00135 #else 00136 FLA_C2F( dtrsm )( &blas_side, 00137 &blas_uplo, 00138 &blas_trans, 00139 &blas_diag, 00140 &m_B, 00141 &n_B, 00142 buff_alpha, 00143 buff_A, &ldim_A, 00144 buff_B, &ldim_B ); 00145 #endif 00146 break; 00147 } 00148 00149 case FLA_COMPLEX: 00150 { 00151 scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A_copy ); 00152 scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B ); 00153 scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha ); 00154 00155 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00156 cblas_ctrsm( cblas_order, 00157 blas_side, 00158 blas_uplo, 00159 blas_trans, 00160 blas_diag, 00161 m_B, 00162 n_B, 00163 buff_alpha, 00164 buff_A, ldim_A, 00165 buff_B, ldim_B ); 00166 #else 00167 FLA_C2F( ctrsm )( &blas_side, 00168 &blas_uplo, 00169 &blas_trans, 00170 &blas_diag, 00171 &m_B, 00172 &n_B, 00173 buff_alpha, 00174 buff_A, &ldim_A, 00175 buff_B, &ldim_B ); 00176 #endif 00177 break; 00178 } 00179 00180 case FLA_DOUBLE_COMPLEX: 00181 { 00182 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A_copy ); 00183 dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B ); 00184 dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha ); 00185 00186 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00187 cblas_ztrsm( cblas_order, 00188 blas_side, 00189 blas_uplo, 00190 blas_trans, 00191 blas_diag, 00192 m_B, 00193 n_B, 00194 buff_alpha, 00195 buff_A, ldim_A, 00196 buff_B, ldim_B ); 00197 #else 00198 FLA_C2F( ztrsm )( &blas_side, 00199 &blas_uplo, 00200 &blas_trans, 00201 &blas_diag, 00202 &m_B, 00203 &n_B, 00204 buff_alpha, 00205 buff_A, &ldim_A, 00206 buff_B, &ldim_B ); 00207 #endif 00208 break; 00209 } 00210 00211 } 00212 00213 if ( trans == FLA_CONJ_NO_TRANSPOSE ) 00214 FLA_Obj_free( &A_copy ); 00215 00216 return FLA_SUCCESS; 00217 }
void FLA_F2C() fla_trsm_external_f | ( | F_INT * | side, | |
F_INT * | uplo, | |||
F_INT * | trans, | |||
F_INT * | diag, | |||
F_INT * | alpha, | |||
F_INT * | A, | |||
F_INT * | B, | |||
F_INT * | IERROR | |||
) |
References FLA_Trsm_external().
00221 { 00222 *IERROR = FLA_Trsm_external( *( ( FLA_Side * ) side ), 00223 *( ( FLA_Uplo * ) uplo ), 00224 *( ( FLA_Trans * ) trans ), 00225 *( ( FLA_Diag * ) diag ), 00226 *( ( FLA_Obj * ) alpha ), 00227 *( ( FLA_Obj * ) A ), 00228 *( ( FLA_Obj * ) B ) ); 00229 }