FLA_Inv_scalc_external.c File Reference

(r)


Functions

FLA_Error FLA_Inv_scalc_external (FLA_Conj conjalpha, FLA_Obj alpha, FLA_Obj A)
void FLA_F2C() fla_inv_scalc_external_f (F_INT *conjalpha, F_INT *alpha, F_INT *A, F_INT *IERROR)

Function Documentation

FLA_Error FLA_Inv_scalc_external ( FLA_Conj  conjalpha,
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_scalc_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_Apply_househ2_UT(), FLA_Inv_scalc(), fla_inv_scalc_external_f(), FLA_Trsm_llh_unb_var1(), FLA_Trsm_llh_unb_var2(), FLA_Trsm_luh_unb_var1(), FLA_Trsm_luh_unb_var2(), FLA_Trsm_rlh_unb_var1(), FLA_Trsm_rlh_unb_var2(), FLA_Trsm_ruh_unb_var1(), and FLA_Trsm_ruh_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_scalc_check( conjalpha, 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       if ( conjalpha == FLA_CONJUGATE )
00136       {
00137         alpha_inv.real = buff_alpha->real * temp; 
00138         alpha_inv.imag = buff_alpha->imag * temp; 
00139       }
00140       else
00141       {
00142         alpha_inv.real = buff_alpha->real * temp; 
00143         alpha_inv.imag = buff_alpha->imag * -temp; 
00144       }
00145 
00146       for ( j = 0; j < n_iter; ++j )
00147       {
00148 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00149         cblas_cscal( num_elem,
00150                      alpha_inv,   
00151                      buff_A + j*ldim_A, inc_A );
00152 #else
00153         FLA_C2F( cscal )( &num_elem,
00154                           &alpha_inv,   
00155                           buff_A + j*ldim_A, &inc_A );
00156 #endif
00157       }
00158     }
00159     else if ( dt_alpha == FLA_FLOAT )
00160     {
00161       scomplex *buff_A     = ( scomplex * ) FLA_FLOAT_PTR( A );
00162       float    *buff_alpha = ( float    * ) FLA_FLOAT_PTR( alpha );
00163       float     alpha_inv  =                1.0F / (*buff_alpha);
00164 
00165       for ( j = 0; j < n_iter; ++j )
00166       {
00167 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00168         cblas_csscal( num_elem,
00169                       alpha_inv,
00170                       buff_A + j*ldim_A, inc_A );
00171 #else
00172         FLA_C2F( csscal )( &num_elem,
00173                            &alpha_inv,
00174                            buff_A + j*ldim_A, &inc_A );
00175 #endif
00176       }
00177     }
00178 
00179     break;
00180   }
00181 
00182   case FLA_DOUBLE_COMPLEX:
00183   { 
00184     if ( dt_alpha == FLA_DOUBLE_COMPLEX )
00185     {
00186       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00187       dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00188       dcomplex  alpha_inv;
00189       double    temp;
00190 
00191       temp = 1.0 / ( buff_alpha->real * buff_alpha->real +
00192                      buff_alpha->imag * buff_alpha->imag );
00193 
00194       if ( conjalpha == FLA_CONJUGATE )
00195       {
00196         alpha_inv.real = buff_alpha->real * temp; 
00197         alpha_inv.imag = buff_alpha->imag * temp; 
00198       }
00199       else
00200       {
00201         alpha_inv.real = buff_alpha->real * temp; 
00202         alpha_inv.imag = buff_alpha->imag * -temp; 
00203       }
00204  
00205       for ( j = 0; j < n_iter; ++j )
00206       {
00207 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00208         cblas_zscal( num_elem,
00209                      alpha_inv,   
00210                      buff_A + j*ldim_A, inc_A );
00211 #else
00212         FLA_C2F( zscal )( &num_elem,
00213                           &alpha_inv,   
00214                           buff_A + j*ldim_A, &inc_A );
00215 #endif
00216       }
00217     }
00218     else if ( dt_alpha == FLA_DOUBLE )
00219     {
00220       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00221       double   *buff_alpha = ( double   * ) FLA_DOUBLE_PTR( alpha );
00222       double    alpha_inv  =                1.0 / (*buff_alpha);
00223 
00224       for ( j = 0; j < n_iter; ++j )
00225       {
00226 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00227         cblas_zdscal( num_elem,
00228                       alpha_inv,   
00229                       buff_A + j*ldim_A, inc_A );
00230 #else
00231         FLA_C2F( zdscal )( &num_elem,
00232                            &alpha_inv,   
00233                            buff_A + j*ldim_A, &inc_A );
00234 #endif
00235       }
00236     }
00237 
00238     break;
00239   }
00240 
00241   }
00242   
00243   return FLA_SUCCESS;
00244 }

void FLA_F2C() fla_inv_scalc_external_f ( F_INT *  conjalpha,
F_INT *  alpha,
F_INT *  A,
F_INT *  IERROR 
)

References FLA_Inv_scalc_external().

00248 {
00249   *IERROR = FLA_Inv_scalc_external( *( ( FLA_Conj * ) conjalpha ),
00250                                     *( ( FLA_Obj  * ) alpha     ),
00251                                     *( ( FLA_Obj  * ) A         ) );
00252 }


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