FLA_Herc_external.c File Reference

(r)


Functions

FLA_Error FLA_Herc_external (FLA_Uplo uplo, FLA_Conj conjx, FLA_Obj alpha, FLA_Obj x, FLA_Obj A)
void FLA_F2C() fla_herc_external_f (F_INT *uplo, F_INT *conjx, F_INT *alpha, F_INT *x, F_INT *A, F_INT *IERROR)

Function Documentation

FLA_Error FLA_Herc_external ( FLA_Uplo  uplo,
FLA_Conj  conjx,
FLA_Obj  alpha,
FLA_Obj  x,
FLA_Obj  A 
)

References cblas_cher(), cblas_zher(), CblasColMajor, cher(), FLA_Check_error_level(), FLA_Copyt_external(), FLA_Herc_check(), FLA_Obj_create_conf_to(), FLA_Obj_datatype(), FLA_Obj_free(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Param_map_to_blas_uplo(), and zher().

Referenced by FLA_Chol_u_unb_var3(), FLA_Herc(), fla_herc_external_f(), FLA_Herk_lh_unb_var5(), FLA_Herk_lh_unb_var6(), FLA_Herk_uh_unb_var5(), FLA_Herk_uh_unb_var6(), and FLA_Ttmm_l_unb_var1().

00036 {
00037   FLA_Datatype datatype;
00038   int          m_A, ldim_A;
00039   int          m_x, ldim_x, inc_x; 
00040 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00041   CBLAS_ORDER  cblas_order = CblasColMajor;
00042   CBLAS_UPLO   blas_uplo;   
00043 #else
00044   char         blas_uplo;
00045 #endif
00046   FLA_Obj      x_copy;
00047 
00048   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00049     FLA_Herc_check( uplo, conjx, alpha, x, A );
00050 
00051   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00052 
00053   datatype = FLA_Obj_datatype( A );
00054 
00055   m_A      = FLA_Obj_length( A );
00056   ldim_A   = FLA_Obj_ldim( A );
00057 
00058   m_x      = FLA_Obj_length( x );
00059   ldim_x   = FLA_Obj_ldim( x );
00060 
00061   inc_x    = ( m_x == 1 ? ldim_x : 1 );
00062 
00063   if ( conjx == FLA_CONJUGATE )
00064   {
00065     FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, x, &x_copy );
00066     FLA_Copyt_external( FLA_CONJ_NO_TRANSPOSE, x, x_copy );
00067 
00068     m_x    = FLA_Obj_length( x_copy );
00069     ldim_x = FLA_Obj_ldim( x_copy );
00070     inc_x  = ( m_x == 1 ? ldim_x : 1 );
00071   }
00072   else
00073   {
00074     x_copy = x;
00075   }
00076 
00077   FLA_Param_map_to_blas_uplo( uplo, &blas_uplo );
00078 
00079 
00080   switch( datatype ){
00081 
00082   case FLA_COMPLEX:
00083   {
00084     scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
00085     scomplex *buff_x     = ( scomplex * ) FLA_COMPLEX_PTR( x_copy );
00086     float    *buff_alpha = ( float    * ) FLA_FLOAT_PTR( alpha );
00087 
00088 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00089     cblas_cher( cblas_order,
00090                 blas_uplo,
00091                 m_A,
00092                 buff_alpha->real,
00093                 buff_x, inc_x,
00094                 buff_A, ldim_A ); 
00095 #else
00096     FLA_C2F( cher )( &blas_uplo,
00097                      &m_A,
00098                      buff_alpha,
00099                      buff_x, &inc_x,
00100                      buff_A, &ldim_A ); 
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_x     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x_copy );
00109     double   *buff_alpha = ( double   * ) FLA_DOUBLE_PTR( alpha );
00110 
00111 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00112     cblas_zher( cblas_order,
00113                 blas_uplo,
00114                 m_A,
00115                 buff_alpha->real,
00116                 buff_x, inc_x,
00117                 buff_A, ldim_A ); 
00118 #else
00119     FLA_C2F( zher )( &blas_uplo,
00120                      &m_A,
00121                      buff_alpha,
00122                      buff_x, &inc_x,
00123                      buff_A, &ldim_A ); 
00124 #endif
00125     break;
00126   }
00127 
00128   }
00129 
00130   if ( conjx == FLA_CONJUGATE )
00131     FLA_Obj_free( &x_copy );
00132   
00133   return FLA_SUCCESS;
00134 }

void FLA_F2C() fla_herc_external_f ( F_INT *  uplo,
F_INT *  conjx,
F_INT *  alpha,
F_INT *  x,
F_INT *  A,
F_INT *  IERROR 
)

References FLA_Herc_external().

00139 {
00140   *IERROR = FLA_Herc_external( *( ( FLA_Uplo * ) uplo  ), 
00141                                *( ( FLA_Conj * ) conjx ), 
00142                                *( ( FLA_Obj  * ) alpha ), 
00143                                *( ( FLA_Obj  * ) x     ), 
00144                                *( ( FLA_Obj  * ) A     ) );
00145 }


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