FLA_Trmm_external.c File Reference

(r)


Functions

FLA_Error FLA_Trmm_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_trmm_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)

Function Documentation

FLA_Error FLA_Trmm_external ( FLA_Side  side,
FLA_Uplo  uplo,
FLA_Trans  trans,
FLA_Diag  diag,
FLA_Obj  alpha,
FLA_Obj  A,
FLA_Obj  B 
)

References cblas_ctrmm(), cblas_dtrmm(), cblas_strmm(), cblas_ztrmm(), CblasColMajor, ctrmm(), dtrmm(), 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_Trmm_check(), strmm(), and ztrmm().

Referenced by FLA_LQ_UT_Accum_T_blk_var1(), FLA_LQ_UT_blk_var2(), FLA_QR_UT_Accum_T_blk_var1(), FLA_QR_UT_blk_var2(), FLA_Trmm(), fla_trmm_external_f(), FLA_Trmm_llh_task(), FLA_Trmm_lln_task(), FLA_Trmm_llt_task(), FLA_Trmm_luh_task(), FLA_Trmm_lun_task(), FLA_Trmm_lut_task(), FLA_Trmm_rlh_task(), FLA_Trmm_rln_task(), FLA_Trmm_rlt_task(), FLA_Trmm_ruh_task(), FLA_Trmm_run_task(), FLA_Trmm_rut_task(), FLA_Trmm_task(), and FLA_Trmmsx_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_Trmm_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_strmm( 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( strmm )( &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_dtrmm( 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( dtrmm )( &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_ctrmm( 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( ctrmm )( &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 
00181   case FLA_DOUBLE_COMPLEX:
00182   {
00183     dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A_copy );
00184     dcomplex *buff_B     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B );
00185     dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00186 
00187 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00188     cblas_ztrmm( cblas_order,
00189                  blas_side,
00190                  blas_uplo, 
00191                  blas_trans,
00192                  blas_diag,
00193                  m_B,
00194                  n_B,
00195                  buff_alpha,
00196                  buff_A, ldim_A, 
00197                  buff_B, ldim_B );
00198 #else
00199     FLA_C2F( ztrmm )( &blas_side,
00200                       &blas_uplo, 
00201                       &blas_trans,
00202                       &blas_diag,
00203                       &m_B,
00204                       &n_B,
00205                       buff_alpha,
00206                       buff_A, &ldim_A, 
00207                       buff_B, &ldim_B );
00208 #endif
00209     break;
00210   }
00211 
00212   }
00213 
00214   if ( trans == FLA_CONJ_NO_TRANSPOSE )
00215     FLA_Obj_free( &A_copy );
00216   
00217   return FLA_SUCCESS;
00218 }

void FLA_F2C() fla_trmm_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_Trmm_external().

00222 {
00223   *IERROR = FLA_Trmm_external( *( ( FLA_Side  * ) side  ),
00224                                *( ( FLA_Uplo  * ) uplo  ),
00225                                *( ( FLA_Trans * ) trans ),
00226                                *( ( FLA_Diag  * ) diag  ),
00227                                *( ( FLA_Obj   * ) alpha ), 
00228                                *( ( FLA_Obj   * ) A     ),
00229                                *( ( FLA_Obj   * ) B     ) );
00230 }


Generated on Mon Jul 6 05:45:53 2009 for libflame by  doxygen 1.5.9