FLA_Herk_external.c File Reference

(r)


Functions

FLA_Error FLA_Herk_external (FLA_Uplo uplo, FLA_Trans trans, FLA_Obj alpha, FLA_Obj A, FLA_Obj beta, FLA_Obj C)
void FLA_F2C() fla_herk_external_f (F_INT *uplo, F_INT *trans, F_INT *alpha, F_INT *A, F_INT *beta, F_INT *C, F_INT *IERROR)

Function Documentation

FLA_Error FLA_Herk_external ( FLA_Uplo  uplo,
FLA_Trans  trans,
FLA_Obj  alpha,
FLA_Obj  A,
FLA_Obj  beta,
FLA_Obj  C 
)

References cblas_cherk(), cblas_zherk(), CblasColMajor, cherk(), FLA_Check_error_level(), FLA_Herk_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_width(), FLA_Param_map_to_blas_trans(), FLA_Param_map_to_blas_uplo(), and zherk().

Referenced by FLA_Herk(), fla_herk_external_f(), FLA_Herk_lh_task(), FLA_Herk_ln_task(), FLA_Herk_task(), FLA_Herk_uh_task(), FLA_Herk_un_task(), and FLA_Random_spd_matrix().

00036 {
00037   FLA_Datatype datatype;
00038   int          k_A;
00039   int          m_A, n_A, ldim_A;
00040   int          m_C, ldim_C;
00041 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00042   CBLAS_ORDER     cblas_order = CblasColMajor;
00043   CBLAS_UPLO      blas_uplo;
00044   CBLAS_TRANSPOSE blas_trans;
00045 #else
00046   char         blas_uplo; 
00047   char         blas_trans;
00048 #endif
00049 
00050   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00051     FLA_Herk_check( uplo, trans, alpha, A, beta, C );
00052   
00053   if ( FLA_Obj_has_zero_dim( C ) ) return FLA_SUCCESS;
00054 
00055   datatype = FLA_Obj_datatype( A );
00056 
00057   m_A      = FLA_Obj_length( A );
00058   n_A      = FLA_Obj_width( A );
00059   ldim_A   = FLA_Obj_ldim( A );
00060 
00061   m_C      = FLA_Obj_length( C );
00062   ldim_C   = FLA_Obj_ldim( C );
00063 
00064   if ( trans == FLA_NO_TRANSPOSE )
00065     k_A = n_A;
00066   else
00067     k_A = m_A;
00068 
00069   FLA_Param_map_to_blas_uplo( uplo, &blas_uplo );
00070   FLA_Param_map_to_blas_trans( trans, &blas_trans );
00071 
00072 
00073   switch( datatype ){
00074 
00075   case FLA_COMPLEX:
00076   {
00077     scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
00078     scomplex *buff_C     = ( scomplex * ) FLA_COMPLEX_PTR( C );
00079     float    *buff_alpha = ( float    * ) FLA_FLOAT_PTR( alpha );
00080     float    *buff_beta  = ( float    * ) FLA_FLOAT_PTR( beta );
00081 
00082 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00083     cblas_cherk( cblas_order,
00084                  blas_uplo, 
00085                  blas_trans,
00086                  m_C,
00087                  k_A,
00088                  *buff_alpha,
00089                  buff_A, ldim_A, 
00090                  *buff_beta,  
00091                  buff_C, ldim_C );
00092 #else
00093     FLA_C2F( cherk )( &blas_uplo, 
00094                       &blas_trans,
00095                       &m_C,
00096                       &k_A,
00097                       buff_alpha,
00098                       buff_A, &ldim_A, 
00099                       buff_beta,  
00100                       buff_C, &ldim_C );
00101 #endif
00102     break;
00103   }
00104 
00105   case FLA_DOUBLE_COMPLEX:
00106   {
00107     dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00108     dcomplex *buff_C     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( C );
00109     double   *buff_alpha = ( double   * ) FLA_DOUBLE_PTR( alpha );
00110     double   *buff_beta  = ( double   * ) FLA_DOUBLE_PTR( beta );
00111 
00112 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00113     cblas_zherk( cblas_order,
00114                  blas_uplo, 
00115                  blas_trans,
00116                  m_C,
00117                  k_A,
00118                  *buff_alpha,
00119                  buff_A, ldim_A, 
00120                  *buff_beta,  
00121                  buff_C, ldim_C );
00122 #else
00123     FLA_C2F( zherk )( &blas_uplo, 
00124                       &blas_trans,
00125                       &m_C,
00126                       &k_A,
00127                       buff_alpha,
00128                       buff_A, &ldim_A, 
00129                       buff_beta,  
00130                       buff_C, &ldim_C );
00131 #endif
00132     break;
00133   }
00134 
00135   }
00136  
00137   return FLA_SUCCESS;
00138 }

void FLA_F2C() fla_herk_external_f ( F_INT *  uplo,
F_INT *  trans,
F_INT *  alpha,
F_INT *  A,
F_INT *  beta,
F_INT *  C,
F_INT *  IERROR 
)

References FLA_Herk_external().

00142 {
00143   *IERROR = FLA_Herk_external( *( ( FLA_Uplo  * ) uplo  ),
00144                                *( ( FLA_Trans * ) trans ),
00145                                *( ( FLA_Obj   * ) alpha ),
00146                                *( ( FLA_Obj   * ) A     ),
00147                                *( ( FLA_Obj   * ) beta  ),
00148                                *( ( FLA_Obj   * ) C     ) );
00149 }


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