FLA_Scalr_external.c File Reference

(r)


Functions

FLA_Error FLA_Scalr_external (FLA_Uplo uplo, FLA_Obj alpha, FLA_Obj A)
void FLA_F2C() fla_scalr_external_f (F_INT *uplo, F_INT *alpha, F_INT *A, F_INT *IERROR)

Function Documentation

FLA_Error FLA_Scalr_external ( FLA_Uplo  uplo,
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_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_width(), FLA_Scalr_check(), sscal(), zdscal(), and zscal().

Referenced by FLA_Her2k_lh_unb_var10(), FLA_Her2k_lh_unb_var9(), FLA_Her2k_ln_unb_var10(), FLA_Her2k_ln_unb_var9(), FLA_Her2k_uh_unb_var10(), FLA_Her2k_uh_unb_var9(), FLA_Her2k_un_unb_var10(), FLA_Her2k_un_unb_var9(), FLA_Herk_lh_unb_var1(), FLA_Herk_lh_unb_var2(), FLA_Herk_lh_unb_var3(), FLA_Herk_lh_unb_var4(), FLA_Herk_lh_unb_var5(), FLA_Herk_lh_unb_var6(), FLA_Herk_ln_unb_var1(), FLA_Herk_ln_unb_var2(), FLA_Herk_ln_unb_var3(), FLA_Herk_ln_unb_var4(), FLA_Herk_ln_unb_var5(), FLA_Herk_ln_unb_var6(), FLA_Herk_uh_unb_var1(), FLA_Herk_uh_unb_var2(), FLA_Herk_uh_unb_var3(), FLA_Herk_uh_unb_var4(), FLA_Herk_uh_unb_var5(), FLA_Herk_uh_unb_var6(), FLA_Herk_un_unb_var1(), FLA_Herk_un_unb_var2(), FLA_Herk_un_unb_var3(), FLA_Herk_un_unb_var4(), FLA_Herk_un_unb_var5(), FLA_Herk_un_unb_var6(), FLA_Scalr(), fla_scalr_external_f(), FLA_Syr2k_ln_unb_var10(), FLA_Syr2k_ln_unb_var9(), FLA_Syr2k_lt_unb_var10(), FLA_Syr2k_lt_unb_var9(), FLA_Syr2k_un_unb_var10(), FLA_Syr2k_un_unb_var9(), FLA_Syr2k_ut_unb_var10(), FLA_Syr2k_ut_unb_var9(), FLA_Syrk_ln_unb_var1(), FLA_Syrk_ln_unb_var2(), FLA_Syrk_ln_unb_var3(), FLA_Syrk_ln_unb_var4(), FLA_Syrk_ln_unb_var5(), FLA_Syrk_ln_unb_var6(), FLA_Syrk_lt_unb_var1(), FLA_Syrk_lt_unb_var2(), FLA_Syrk_lt_unb_var3(), FLA_Syrk_lt_unb_var4(), FLA_Syrk_lt_unb_var5(), FLA_Syrk_lt_unb_var6(), FLA_Syrk_un_unb_var1(), FLA_Syrk_un_unb_var2(), FLA_Syrk_un_unb_var3(), FLA_Syrk_un_unb_var4(), FLA_Syrk_un_unb_var5(), FLA_Syrk_un_unb_var6(), FLA_Syrk_ut_unb_var1(), FLA_Syrk_ut_unb_var2(), FLA_Syrk_ut_unb_var3(), FLA_Syrk_ut_unb_var4(), FLA_Syrk_ut_unb_var5(), and FLA_Syrk_ut_unb_var6().

00036 {
00037   FLA_Datatype datatype, dt_alpha;
00038   int          j, i_one = 1;
00039   int          num_elem;
00040   int          n_A, ldim_A;
00041 
00042   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00043     FLA_Scalr_check( uplo, alpha, A );
00044 
00045   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00046 
00047   dt_alpha = FLA_Obj_datatype( alpha );
00048   datatype = FLA_Obj_datatype( A );
00049 
00050   n_A      = FLA_Obj_width( A );
00051   ldim_A   = FLA_Obj_ldim( A );
00052 
00053   switch ( datatype ){
00054 
00055   case FLA_FLOAT:
00056   {
00057     float *buff_A     = ( float * ) FLA_FLOAT_PTR( A );
00058     float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );
00059 
00060     if ( uplo == FLA_LOWER_TRIANGULAR )
00061     {
00062       for ( j = 0; j < n_A; ++j )
00063       {
00064         num_elem = n_A - j;
00065 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00066         cblas_sscal( num_elem, 
00067                      *buff_alpha,
00068                      buff_A + j*ldim_A + j, i_one );
00069 #else
00070         FLA_C2F( sscal )( &num_elem,
00071                           buff_alpha,
00072                           buff_A + j*ldim_A + j, &i_one );
00073 #endif
00074       }
00075     }
00076     else
00077     {
00078       for ( j = 0; j < n_A; ++j )
00079       {
00080         num_elem = j + 1;
00081 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00082         cblas_sscal( num_elem, 
00083                      *buff_alpha,
00084                      buff_A + j*ldim_A, i_one );
00085 #else
00086         FLA_C2F( sscal )( &num_elem,
00087                           buff_alpha,
00088                           buff_A + j*ldim_A, &i_one );
00089 #endif
00090       }
00091     }
00092 
00093     break;
00094   }
00095 
00096   case FLA_DOUBLE:
00097   {
00098     double *buff_A     = ( double * ) FLA_DOUBLE_PTR( A );
00099     double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );
00100 
00101     if ( uplo == FLA_LOWER_TRIANGULAR )
00102     {
00103       for ( j = 0; j < n_A; ++j )
00104       {
00105         num_elem = n_A - j;
00106 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00107         cblas_dscal( num_elem,
00108                      *buff_alpha,
00109                      buff_A + j*ldim_A + j, i_one );
00110 #else
00111         FLA_C2F( dscal )( &num_elem,
00112                           buff_alpha,
00113                           buff_A + j*ldim_A + j, &i_one );
00114 #endif
00115       }
00116     }
00117     else
00118     {
00119       for ( j = 0; j < n_A; ++j )
00120       {
00121         num_elem = j + 1;
00122 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00123         cblas_dscal( num_elem,
00124                      *buff_alpha,
00125                      buff_A + j*ldim_A, i_one );
00126 #else
00127         FLA_C2F( dscal )( &num_elem,
00128                           buff_alpha,
00129                           buff_A + j*ldim_A, &i_one );
00130 #endif
00131       }
00132     }
00133 
00134     break;
00135   }
00136 
00137   case FLA_COMPLEX:
00138   {
00139     if ( dt_alpha == FLA_COMPLEX )
00140     {
00141       scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
00142       scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00143   
00144       if ( uplo == FLA_LOWER_TRIANGULAR )
00145       {
00146         for ( j = 0; j < n_A; ++j )
00147         {
00148           num_elem = n_A - j;
00149 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00150           cblas_cscal( num_elem,
00151                        buff_alpha,
00152                        buff_A + j*ldim_A + j, i_one );
00153 #else
00154           FLA_C2F( cscal )( &num_elem,
00155                             buff_alpha,
00156                             buff_A + j*ldim_A + j, &i_one );
00157 #endif
00158         }
00159       }
00160       else
00161       {
00162         for ( j = 0; j < n_A; ++j )
00163         {
00164           num_elem = j + 1;
00165 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00166           cblas_cscal( num_elem,
00167                        buff_alpha,
00168                        buff_A + j*ldim_A, i_one );
00169 #else
00170           FLA_C2F( cscal )( &num_elem,
00171                             buff_alpha,
00172                             buff_A + j*ldim_A, &i_one );
00173 #endif
00174         }
00175       }
00176     }
00177     else if ( dt_alpha == FLA_FLOAT )
00178     {
00179       scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
00180       float    *buff_alpha = ( float    * ) FLA_FLOAT_PTR( alpha );
00181 
00182       if ( uplo == FLA_LOWER_TRIANGULAR )
00183       {
00184         for ( j = 0; j < n_A; ++j )
00185         {
00186           num_elem = n_A - j;
00187 #ifdef FLA_ENABLE_CBLAS_INTERFACE 
00188           cblas_csscal( num_elem,
00189                         *buff_alpha,
00190                         buff_A + j*ldim_A + j, i_one );
00191 #else
00192           FLA_C2F( csscal )( &num_elem,
00193                              buff_alpha,
00194                              buff_A + j*ldim_A + j, &i_one );
00195 #endif
00196         }
00197       }
00198       else
00199       {
00200         for ( j = 0; j < n_A; ++j )
00201         {
00202           num_elem = j + 1;
00203 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00204           cblas_csscal( num_elem,
00205                         *buff_alpha,
00206                         buff_A + j*ldim_A, i_one );
00207 #else
00208           FLA_C2F( csscal )( &num_elem,
00209                              buff_alpha,
00210                              buff_A + j*ldim_A, &i_one );
00211 #endif
00212         }
00213       }
00214     }
00215 
00216     break;
00217   }
00218 
00219   case FLA_DOUBLE_COMPLEX:
00220   {
00221     if ( dt_alpha == FLA_DOUBLE_COMPLEX )
00222     {
00223       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00224       dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00225   
00226       if ( uplo == FLA_LOWER_TRIANGULAR )
00227       {
00228         for ( j = 0; j < n_A; ++j )
00229         {
00230           num_elem = n_A - j;
00231 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00232           cblas_zscal( num_elem,
00233                        buff_alpha,
00234                        buff_A + j*ldim_A + j, i_one );
00235 #else
00236           FLA_C2F( zscal )( &num_elem,
00237                             buff_alpha,
00238                             buff_A + j*ldim_A + j, &i_one );
00239 #endif
00240         }
00241       }
00242       else
00243       {
00244         for ( j = 0; j < n_A; ++j )
00245         {
00246           num_elem = j + 1;
00247 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00248           cblas_zscal( num_elem,
00249                        buff_alpha,
00250                        buff_A + j*ldim_A, i_one );
00251 #else
00252           FLA_C2F( zscal )( &num_elem,
00253                             buff_alpha,
00254                             buff_A + j*ldim_A, &i_one );
00255 #endif
00256         }
00257       }
00258     }
00259     else if ( dt_alpha == FLA_DOUBLE )
00260     {
00261       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00262       double   *buff_alpha = ( double   * ) FLA_DOUBLE_PTR( alpha );
00263   
00264       if ( uplo == FLA_LOWER_TRIANGULAR )
00265       {
00266         for ( j = 0; j < n_A; ++j )
00267         {
00268           num_elem = n_A - j;
00269 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00270           cblas_zdscal( num_elem,
00271                         *buff_alpha,
00272                         buff_A + j*ldim_A + j, i_one );
00273 #else
00274           FLA_C2F( zdscal )( &num_elem,
00275                              buff_alpha,
00276                              buff_A + j*ldim_A + j, &i_one );
00277 #endif
00278         }
00279       }
00280       else
00281       {
00282         for ( j = 0; j < n_A; ++j )
00283         {
00284           num_elem = j + 1;
00285 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00286           cblas_zdscal( num_elem,
00287                         *buff_alpha,
00288                         buff_A + j*ldim_A, i_one );
00289 #else
00290           FLA_C2F( zdscal )( &num_elem,
00291                              buff_alpha,
00292                              buff_A + j*ldim_A, &i_one );
00293 #endif
00294         }
00295       }
00296     }
00297 
00298     break;
00299   }
00300 
00301   }
00302 
00303   return FLA_SUCCESS;
00304 }

void FLA_F2C() fla_scalr_external_f ( F_INT *  uplo,
F_INT *  alpha,
F_INT *  A,
F_INT *  IERROR 
)

References FLA_Scalr_external().

00308 {
00309   *IERROR = FLA_Scalr_external( *( ( FLA_Uplo * ) uplo  ),
00310                                 *( ( FLA_Obj  * ) alpha ),
00311                                 *( ( FLA_Obj  * ) A     ) );
00312 }


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