FLA_Inv_scal_external.c File Reference

(r)


Functions

FLA_Error FLA_Inv_scal_external (FLA_Obj alpha, FLA_Obj A)
void FLA_F2C() fla_inv_scal_external_f (F_INT *alpha, F_INT *A, F_INT *IERROR)

Function Documentation

FLA_Error FLA_Inv_scal_external ( FLA_Obj  alpha,
FLA_Obj  A 
)

References cblas_cscal(), cblas_csscal(), cblas_dscal(), cblas_sscal(), cblas_zdscal(), cblas_zscal(), cscal(), csscal(), dscal(), FLA_Check_error_level(), FLA_Inv_scal_check(), FLA_MINUS_ONE, FLA_Negate(), FLA_Obj_datatype(), FLA_Obj_equals(), FLA_Obj_has_zero_dim(), FLA_Obj_is_vector(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Obj_width(), FLA_ONE, dcomplex::imag, scomplex::imag, dcomplex::real, scomplex::real, sscal(), zdscal(), and zscal().

Referenced by FLA_Chol_l_unb_var2(), FLA_Chol_l_unb_var3(), FLA_Chol_u_unb_var2(), FLA_Chol_u_unb_var3(), FLA_Inv_scal(), fla_inv_scal_external_f(), FLA_LU_nopiv_unb_var3(), FLA_LU_nopiv_unb_var4(), FLA_LU_nopiv_unb_var5(), FLA_LU_piv_unb_var3(), FLA_LU_piv_unb_var3b(), FLA_LU_piv_unb_var4(), FLA_LU_piv_unb_var5(), FLA_Trsm_lln_unb_var1(), FLA_Trsm_lln_unb_var2(), FLA_Trsm_llt_unb_var1(), FLA_Trsm_llt_unb_var2(), FLA_Trsm_lun_unb_var1(), FLA_Trsm_lun_unb_var2(), FLA_Trsm_lut_unb_var1(), FLA_Trsm_lut_unb_var2(), FLA_Trsm_rln_unb_var1(), FLA_Trsm_rln_unb_var2(), FLA_Trsm_rlt_unb_var1(), FLA_Trsm_rlt_unb_var2(), FLA_Trsm_run_unb_var1(), FLA_Trsm_run_unb_var2(), FLA_Trsm_rut_unb_var1(), and FLA_Trsm_rut_unb_var2().

00036 {
00037   FLA_Datatype datatype, dt_alpha;
00038   int          j, n_iter;
00039   int          num_elem;
00040   int          m_A, n_A, inc_A, ldim_A;
00041 
00042   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00043     FLA_Inv_scal_check( alpha, A );
00044  
00045   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00046 
00047   if ( FLA_Obj_equals( alpha, FLA_ONE ) )
00048   {
00049     return FLA_SUCCESS;
00050   }
00051   else if ( FLA_Obj_equals( alpha, FLA_MINUS_ONE ) )
00052   {
00053     FLA_Negate( A );
00054     return FLA_SUCCESS;
00055   }
00056 
00057   dt_alpha = FLA_Obj_datatype( alpha );
00058   datatype = FLA_Obj_datatype( A );
00059 
00060   m_A      = FLA_Obj_length( A );
00061   n_A      = FLA_Obj_width( A );
00062   ldim_A   = FLA_Obj_ldim( A );
00063 
00064   if ( FLA_Obj_is_vector( A ) )
00065   {
00066     inc_A    = ( m_A == 1 ? ldim_A : 1 );
00067     n_iter   = 1;
00068     num_elem = FLA_Obj_vector_dim( A );
00069   }
00070   else
00071   {
00072     inc_A    = 1;
00073     n_iter   = n_A;
00074     num_elem = m_A;
00075   }
00076 
00077   switch ( datatype ){
00078 
00079   case FLA_FLOAT:
00080   {
00081     float *buff_A     = ( float * ) FLA_FLOAT_PTR( A );
00082     float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );
00083     float  alpha_inv  =             1.0F / (*buff_alpha);
00084 
00085     for ( j = 0; j < n_iter; ++j )
00086     {
00087 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00088       cblas_sscal( num_elem,
00089                    alpha_inv,   
00090                    buff_A + j*ldim_A, inc_A );
00091 #else
00092       FLA_C2F( sscal )( &num_elem,
00093                         &alpha_inv,   
00094                         buff_A + j*ldim_A, &inc_A );
00095 #endif
00096     }
00097 
00098     break;
00099   }
00100 
00101   case FLA_DOUBLE:
00102   {
00103     double *buff_A     = ( double * ) FLA_DOUBLE_PTR( A );
00104     double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );
00105     double  alpha_inv  =              1.0 / (*buff_alpha);
00106 
00107     for ( j = 0; j < n_iter; ++j )
00108     {
00109 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00110       cblas_dscal( num_elem,
00111                    alpha_inv,   
00112                    buff_A + j*ldim_A, inc_A );
00113 #else
00114       FLA_C2F( dscal )( &num_elem,
00115                         &alpha_inv,   
00116                         buff_A + j*ldim_A, &inc_A );
00117 #endif
00118     }
00119 
00120     break;
00121   }
00122 
00123   case FLA_COMPLEX:
00124   {
00125     if ( dt_alpha == FLA_COMPLEX )
00126     {
00127       scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
00128       scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00129       scomplex  alpha_inv;
00130       float     temp;
00131 
00132       temp = 1.0F / ( buff_alpha->real * buff_alpha->real +
00133                       buff_alpha->imag * buff_alpha->imag );
00134 
00135       alpha_inv.real = buff_alpha->real *  temp;
00136       alpha_inv.imag = buff_alpha->imag * -temp;
00137 
00138       for ( j = 0; j < n_iter; ++j )
00139       {
00140 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00141         cblas_cscal( num_elem,
00142                      alpha_inv,   
00143                      buff_A + j*ldim_A, inc_A );
00144 #else
00145         FLA_C2F( cscal )( &num_elem,
00146                           &alpha_inv,   
00147                           buff_A + j*ldim_A, &inc_A );
00148 #endif
00149       }
00150     }
00151     else if ( dt_alpha == FLA_FLOAT )
00152     {
00153       scomplex *buff_A     = ( scomplex * ) FLA_FLOAT_PTR( A );
00154       float    *buff_alpha = ( float    * ) FLA_FLOAT_PTR( alpha );
00155       float     alpha_inv  =                1.0F / (*buff_alpha);
00156 
00157       for ( j = 0; j < n_iter; ++j )
00158       {
00159 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00160         cblas_csscal( num_elem,
00161                       alpha_inv,
00162                       buff_A + j*ldim_A, inc_A );
00163 #else
00164         FLA_C2F( csscal )( &num_elem,
00165                            &alpha_inv,
00166                            buff_A + j*ldim_A, &inc_A );
00167 #endif
00168       }
00169     }
00170 
00171     break;
00172   }
00173 
00174   case FLA_DOUBLE_COMPLEX:
00175   { 
00176     if ( dt_alpha == FLA_DOUBLE_COMPLEX )
00177     {
00178       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00179       dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00180       dcomplex  alpha_inv;
00181       double    temp;
00182 
00183       temp = 1.0 / ( buff_alpha->real * buff_alpha->real +
00184                      buff_alpha->imag * buff_alpha->imag );
00185 
00186       alpha_inv.real = buff_alpha->real *  temp;
00187       alpha_inv.imag = buff_alpha->imag * -temp;
00188  
00189       for ( j = 0; j < n_iter; ++j )
00190       {
00191 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00192         cblas_zscal( num_elem,
00193                      alpha_inv,   
00194                      buff_A + j*ldim_A, inc_A );
00195 #else
00196         FLA_C2F( zscal )( &num_elem,
00197                           &alpha_inv,   
00198                           buff_A + j*ldim_A, &inc_A );
00199 #endif
00200       }
00201     }
00202     else if ( dt_alpha == FLA_DOUBLE )
00203     {
00204       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00205       double   *buff_alpha = ( double   * ) FLA_DOUBLE_PTR( alpha );
00206       double    alpha_inv  =                1.0 / (*buff_alpha);
00207 
00208       for ( j = 0; j < n_iter; ++j )
00209       {
00210 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00211         cblas_zdscal( num_elem,
00212                       alpha_inv,   
00213                       buff_A + j*ldim_A, inc_A );
00214 #else
00215         FLA_C2F( zdscal )( &num_elem,
00216                            &alpha_inv,   
00217                            buff_A + j*ldim_A, &inc_A );
00218 #endif
00219       }
00220     }
00221 
00222     break;
00223   }
00224 
00225   }
00226   
00227   return FLA_SUCCESS;
00228 }

void FLA_F2C() fla_inv_scal_external_f ( F_INT *  alpha,
F_INT *  A,
F_INT *  IERROR 
)

References FLA_Inv_scal_external().

00232 {
00233   *IERROR = FLA_Inv_scal_external( *( ( FLA_Obj * ) alpha ),
00234                                    *( ( FLA_Obj * ) A     ) );
00235 }


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