FLA_Scalc_external.c File Reference

(r)


Functions

FLA_Error FLA_Scalc_external (FLA_Conj conjalpha, FLA_Obj alpha, FLA_Obj A)
void FLA_F2C() fla_scalc_external_f (F_INT *conjalpha, F_INT *alpha, F_INT *A, F_INT *IERROR)

Function Documentation

FLA_Error FLA_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_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_set_to_scalar(), FLA_Obj_vector_dim(), FLA_Obj_width(), FLA_ONE, FLA_Scalc_check(), FLA_ZERO, dcomplex::imag, scomplex::imag, sscal(), zdscal(), and zscal().

Referenced by FLA_Scalc(), fla_scalc_external_f(), FLA_Trmm_llh_unb_var1(), FLA_Trmm_llh_unb_var2(), FLA_Trmm_luh_unb_var1(), FLA_Trmm_luh_unb_var2(), FLA_Trmm_rlh_unb_var1(), FLA_Trmm_rlh_unb_var2(), FLA_Trmm_ruh_unb_var1(), and FLA_Trmm_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_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_ZERO ) )
00052   {
00053     FLA_Obj_set_to_scalar( FLA_ZERO, A );
00054     return FLA_SUCCESS;
00055   }
00056   else if ( FLA_Obj_equals( alpha, FLA_MINUS_ONE ) )
00057   {
00058     FLA_Negate( A );
00059     return FLA_SUCCESS;
00060   }
00061 
00062   dt_alpha = FLA_Obj_datatype( alpha );
00063   datatype = FLA_Obj_datatype( A );
00064 
00065   m_A      = FLA_Obj_length( A );
00066   n_A      = FLA_Obj_width( A );
00067   ldim_A   = FLA_Obj_ldim( A );
00068 
00069   if ( FLA_Obj_is_vector( A ) )
00070   {
00071     inc_A    = ( m_A == 1 ? ldim_A : 1 );
00072     n_iter   = 1;
00073     num_elem = FLA_Obj_vector_dim( A );
00074   }
00075   else
00076   {
00077     inc_A    = 1;
00078     n_iter   = n_A;
00079     num_elem = m_A;
00080   }
00081 
00082 
00083   switch ( datatype ){
00084 
00085   case FLA_FLOAT:
00086   {
00087     float *buff_A     = ( float * ) FLA_FLOAT_PTR( A );
00088     float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );
00089 
00090     for ( j = 0; j < n_iter; ++j )
00091     {
00092 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00093       cblas_sscal( num_elem,
00094                    *buff_alpha,
00095                    buff_A + j*ldim_A, inc_A );
00096 #else
00097       FLA_C2F( sscal )( &num_elem,
00098                         buff_alpha,
00099                         buff_A + j*ldim_A, &inc_A );
00100 #endif
00101     }
00102 
00103     break;
00104   }
00105 
00106   case FLA_DOUBLE:
00107   {
00108     double *buff_A     = ( double * ) FLA_DOUBLE_PTR( A );
00109     double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );
00110 
00111     for ( j = 0; j < n_iter; ++j )
00112     {
00113 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00114       cblas_dscal( num_elem,
00115                    *buff_alpha,
00116                    buff_A + j*ldim_A, inc_A );
00117 #else
00118       FLA_C2F( dscal )( &num_elem,
00119                         buff_alpha,
00120                         buff_A + j*ldim_A, &inc_A );
00121 #endif
00122     }
00123 
00124     break;
00125   }
00126 
00127   case FLA_COMPLEX:
00128   {
00129     if ( dt_alpha == FLA_COMPLEX )
00130     {
00131       scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
00132       scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00133       scomplex  temp_alpha = *buff_alpha;
00134 
00135       if ( conjalpha == FLA_CONJUGATE )
00136         temp_alpha.imag *= -1.0F;
00137 
00138       for ( j = 0; j < n_iter; ++j )
00139       {
00140 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00141         cblas_cscal( num_elem,
00142                      &temp_alpha,
00143                      buff_A + j*ldim_A, inc_A );
00144 #else
00145         FLA_C2F( cscal )( &num_elem,
00146                           &temp_alpha,
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 
00156       for ( j = 0; j < n_iter; ++j )
00157       {
00158 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00159         cblas_csscal( num_elem,
00160                       *buff_alpha,
00161                       buff_A + j*ldim_A, inc_A );
00162 #else
00163         FLA_C2F( csscal )( &num_elem,
00164                            buff_alpha,
00165                            buff_A + j*ldim_A, &inc_A );
00166 #endif
00167       }
00168     }
00169 
00170     break;
00171   }
00172 
00173   case FLA_DOUBLE_COMPLEX:
00174   {
00175     if ( dt_alpha == FLA_DOUBLE_COMPLEX )
00176     {
00177       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00178       dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00179       dcomplex  temp_alpha = *buff_alpha;
00180 
00181       if ( conjalpha == FLA_CONJUGATE )
00182         temp_alpha.imag *= -1.0;
00183 
00184       for ( j = 0; j < n_iter; ++j )
00185       {
00186 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00187         cblas_zscal( num_elem,
00188                      &temp_alpha,
00189                      buff_A + j*ldim_A, inc_A );
00190 #else
00191         FLA_C2F( zscal )( &num_elem,
00192                           &temp_alpha,
00193                           buff_A + j*ldim_A, &inc_A );
00194 #endif
00195       }
00196     }
00197     else if ( dt_alpha == FLA_DOUBLE )
00198     {
00199       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00200       double   *buff_alpha = ( double   * ) FLA_DOUBLE_PTR( alpha );
00201 
00202       for ( j = 0; j < n_iter; ++j )
00203       {
00204 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00205         cblas_zdscal( num_elem,
00206                       *buff_alpha,
00207                       buff_A + j*ldim_A, inc_A );
00208 #else
00209         FLA_C2F( zdscal )( &num_elem,
00210                            buff_alpha,
00211                            buff_A + j*ldim_A, &inc_A );
00212 #endif
00213       }
00214     }
00215 
00216     break;
00217   }
00218 
00219   }
00220 
00221   return FLA_SUCCESS;
00222 }

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

References FLA_Scalc_external().

00226 {
00227   *IERROR = FLA_Scalc_external( *( ( FLA_Conj * ) conjalpha ),
00228                                 *( ( FLA_Obj  * ) alpha     ),
00229                                 *( ( FLA_Obj  * ) A         ) );
00230 }


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