FLA_Syrk_external.c File Reference

(r)


Functions

FLA_Error FLA_Syrk_external (FLA_Uplo uplo, FLA_Trans trans, FLA_Obj alpha, FLA_Obj A, FLA_Obj beta, FLA_Obj C)
void FLA_F2C() fla_syrk_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_Syrk_external ( FLA_Uplo  uplo,
FLA_Trans  trans,
FLA_Obj  alpha,
FLA_Obj  A,
FLA_Obj  beta,
FLA_Obj  C 
)

References cblas_csyrk(), cblas_dsyrk(), cblas_ssyrk(), cblas_zsyrk(), CblasColMajor, csyrk(), dsyrk(), FLA_Check_error_level(), 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(), FLA_Syrk_check(), ssyrk(), and zsyrk().

Referenced by FLA_Random_spd_matrix(), FLA_Syrk(), fla_syrk_external_f(), FLA_Syrk_ln_task(), FLA_Syrk_lt_task(), FLA_Syrk_task(), FLA_Syrk_un_task(), and FLA_Syrk_ut_task().

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_Syrk_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_FLOAT:
00076   {
00077     float *buff_A     = ( float * ) FLA_FLOAT_PTR( A );
00078     float *buff_C     = ( float * ) FLA_FLOAT_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_ssyrk( 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( ssyrk )( &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:
00106   {
00107     double *buff_A     = ( double * ) FLA_DOUBLE_PTR( A );
00108     double *buff_C     = ( double * ) FLA_DOUBLE_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_dsyrk( 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( dsyrk )( &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   case FLA_COMPLEX:
00136   {
00137     scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
00138     scomplex *buff_C     = ( scomplex * ) FLA_COMPLEX_PTR( C );
00139     scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00140     scomplex *buff_beta  = ( scomplex * ) FLA_COMPLEX_PTR( beta );
00141 
00142 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00143     cblas_csyrk( cblas_order,
00144                  blas_uplo, 
00145                  blas_trans,
00146                  m_C,
00147                  k_A, 
00148                  buff_alpha,
00149                  buff_A, ldim_A, 
00150                  buff_beta,  
00151                  buff_C, ldim_C );
00152 #else
00153     FLA_C2F( csyrk )( &blas_uplo, 
00154                       &blas_trans,
00155                       &m_C,
00156                       &k_A, 
00157                       buff_alpha,
00158                       buff_A, &ldim_A, 
00159                       buff_beta,  
00160                       buff_C, &ldim_C );
00161 #endif
00162     break;
00163   }
00164 
00165   case FLA_DOUBLE_COMPLEX:
00166   {
00167     dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00168     dcomplex *buff_C     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( C );
00169     dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00170     dcomplex *buff_beta  = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( beta );
00171 
00172 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00173     cblas_zsyrk( cblas_order,
00174                  blas_uplo, 
00175                  blas_trans,
00176                  m_C,
00177                  k_A, 
00178                  buff_alpha,
00179                  buff_A, ldim_A, 
00180                  buff_beta,  
00181                  buff_C, ldim_C );
00182 #else
00183     FLA_C2F( zsyrk )( &blas_uplo, 
00184                       &blas_trans,
00185                       &m_C,
00186                       &k_A, 
00187                       buff_alpha,
00188                       buff_A, &ldim_A, 
00189                       buff_beta,  
00190                       buff_C, &ldim_C );
00191 #endif
00192     break;
00193   }
00194 
00195   }
00196   
00197   return FLA_SUCCESS;
00198 }

void FLA_F2C() fla_syrk_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_Syrk_external().

00202 {
00203   *IERROR = FLA_Syrk_external( *( ( FLA_Uplo  * ) uplo  ),
00204                                *( ( FLA_Trans * ) trans ), 
00205                                *( ( FLA_Obj   * ) alpha ),
00206                                *( ( FLA_Obj   * ) A     ),
00207                                *( ( FLA_Obj   * ) beta  ),
00208                                *( ( FLA_Obj   * ) C     ) );
00209 }


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