FLA_Nrm2_external.c File Reference

(r)


Functions

FLA_Error FLA_Nrm2_external (FLA_Obj x, FLA_Obj norm_x)
void FLA_F2C() fla_nrm2_external_f (F_INT *x, F_INT *norm_x, F_INT *IERROR)

Function Documentation

FLA_Error FLA_Nrm2_external ( FLA_Obj  x,
FLA_Obj  norm_x 
)

References cblas_dnrm2(), cblas_dznrm2(), cblas_scnrm2(), cblas_snrm2(), dnrm2(), dznrm2(), FLA_Check_error_level(), FLA_Nrm2_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_set_to_scalar(), FLA_Obj_vector_dim(), FLA_ZERO, scnrm2(), and snrm2().

Referenced by FLA_Nrm2(), and fla_nrm2_external_f().

00036 {
00037   FLA_Datatype datatype;
00038   int          num_elem;
00039   int          m_x, inc_x, ldim_x;
00040 
00041   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00042     FLA_Nrm2_check( x, norm_x );
00043 
00044   if ( FLA_Obj_has_zero_dim( x ) )
00045   {
00046     FLA_Obj_set_to_scalar( FLA_ZERO, norm_x );
00047     return FLA_SUCCESS;
00048   }
00049 
00050   datatype = FLA_Obj_datatype( x );
00051 
00052   m_x      = FLA_Obj_length( x );
00053   ldim_x   = FLA_Obj_ldim( x );
00054 
00055   inc_x    = ( m_x == 1 ? ldim_x : 1 );
00056   num_elem = FLA_Obj_vector_dim( x );
00057 
00058 
00059   switch ( datatype ){
00060 
00061   case FLA_FLOAT:
00062   {
00063     float *buff_x      = ( float * ) FLA_FLOAT_PTR( x );
00064     float *buff_norm_x = ( float * ) FLA_FLOAT_PTR( norm_x );
00065 
00066 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00067     *buff_norm_x = cblas_snrm2( num_elem, buff_x, inc_x );
00068 #else
00069     *buff_norm_x = FLA_C2F( snrm2 ) ( &num_elem, buff_x, &inc_x );
00070 #endif
00071 
00072     break;
00073   }
00074 
00075   case FLA_DOUBLE:
00076   {
00077     double *buff_x      = ( double * ) FLA_DOUBLE_PTR( x );
00078     double *buff_norm_x = ( double * ) FLA_DOUBLE_PTR( norm_x );
00079 
00080 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00081     *buff_norm_x = cblas_dnrm2( num_elem, buff_x, inc_x );
00082 #else
00083     *buff_norm_x = FLA_C2F( dnrm2 ) ( &num_elem, buff_x, &inc_x );
00084 #endif
00085 
00086     break;
00087   }
00088 
00089   case FLA_COMPLEX:
00090   {
00091     scomplex *buff_x      = ( scomplex * ) FLA_COMPLEX_PTR( x );
00092     float    *buff_norm_x = ( float    * ) FLA_COMPLEX_PTR( norm_x );
00093 
00094 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00095     *buff_norm_x = cblas_scnrm2( num_elem, buff_x, inc_x );
00096 #else
00097     *buff_norm_x = FLA_C2F( scnrm2 ) ( &num_elem, buff_x, &inc_x );
00098 #endif
00099 
00100     break;
00101   }
00102 
00103   case FLA_DOUBLE_COMPLEX:
00104   {
00105     dcomplex *buff_x      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00106     double   *buff_norm_x = ( double   * ) FLA_DOUBLE_COMPLEX_PTR( norm_x );
00107 
00108 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00109     *buff_norm_x = cblas_dznrm2( num_elem, buff_x, inc_x );
00110 #else
00111     *buff_norm_x = FLA_C2F( dznrm2 ) ( &num_elem, buff_x, &inc_x );
00112 #endif
00113 
00114     break;
00115   }
00116 
00117   }
00118   
00119   return FLA_SUCCESS;
00120 }

void FLA_F2C() fla_nrm2_external_f ( F_INT *  x,
F_INT *  norm_x,
F_INT *  IERROR 
)

References FLA_Nrm2_external().

00125 {
00126   *IERROR = FLA_Nrm2_external( *( ( FLA_Obj * ) x      ),
00127                                *( ( FLA_Obj * ) norm_x ) );
00128 }


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