FLA_util_base_prototypes.h File Reference

(r)

Go to the source code of this file.

Functions

float FLA_random_float (void)
double FLA_random_double (void)
scomplex FLA_random_scomplex (void)
dcomplex FLA_random_dcomplex (void)
FLA_Error FLA_Absolute_square (FLA_Obj alpha)
double FLA_Clock (void)
FLA_Error FLA_Conjugate (FLA_Obj A)
FLA_Error FLA_Conjugate_r (FLA_Uplo uplo, FLA_Obj A)
FLA_Error FLA_Hermitianize (FLA_Uplo uplo, FLA_Obj A)
FLA_Error FLA_Invert (FLA_Obj alpha)
FLA_Error FLA_Max_abs_value (FLA_Obj A, FLA_Obj amax)
double FLA_Max_elemwise_diff (FLA_Obj A, FLA_Obj B)
FLA_Error FLA_FLA_Mult_add (FLA_Obj alpha, FLA_Obj beta, FLA_Obj gamma)
FLA_Error FLA_Negate (FLA_Obj x)
FLA_Error FLA_Norm1 (FLA_Obj A, FLA_Obj norm)
FLA_Error FLA_Norm_inf (FLA_Obj A, FLA_Obj norm)
FLA_Error FLA_Random_matrix (FLA_Obj A)
FLA_Error FLA_Random_herm_matrix (FLA_Uplo uplo, FLA_Obj A)
FLA_Error FLA_Random_spd_matrix (FLA_Uplo uplo, FLA_Obj A)
FLA_Error FLA_Random_tri_matrix (FLA_Uplo uplo, FLA_Diag diag, FLA_Obj A)
FLA_Error FLA_Shift_pivots_to_check (FLA_Pivot_type ptype, FLA_Obj ipiv)
FLA_Error FLA_Sqrt (FLA_Obj alpha)
FLA_Error FLA_Symmetrize (FLA_Uplo uplo, FLA_Obj A)
FLA_Error FLA_Triangularize (FLA_Uplo uplo, FLA_Diag diag, FLA_Obj A)
FLA_Error FLA_Transpose (FLA_Obj A)
void FLA_F2C() fla_absolute_square_f (F_INT *alpha, F_INT *IERROR)
double FLA_F2C() fla_clock_f (void)
void FLA_F2C() fla_conjugate_f (F_INT *A, F_INT *IERROR)
void FLA_F2C() fla_conjugate_r_f (F_INT *uplo, F_INT *A, F_INT *IERROR)
void FLA_F2C() fla_hermitianize_f (F_INT *uplo, F_INT *A, F_INT *IERROR)
void FLA_F2C() fla_invert_f (F_INT *alpha, F_INT *IERROR)
void FLA_F2C() fla_max_abs_value_f (F_INT *A, F_INT *amax, F_INT *IERROR)
double FLA_F2C() fla_max_elemwise_diff_f (F_INT *A, F_INT *B)
void FLA_F2C() fla_mult_add_f (F_INT *alpha, F_INT *beta, F_INT *gamma, F_INT *IERROR)
void FLA_F2C() fla_negate_f (F_INT *x, F_INT *IERROR)
void FLA_F2C() fla_norm1_f (F_INT *A, F_INT *norm, F_INT *IERROR)
void FLA_F2C() fla_norm_inf_f (F_INT *A, F_INT *norm, F_INT *IERROR)
void FLA_F2C() fla_random_matrix_f (F_INT *A, F_INT *IERROR)
void FLA_F2C() fla_random_herm_matrix_f (F_INT *uplo, F_INT *A, F_INT *IERROR)
void FLA_F2C() fla_random_spd_matrix_f (F_INT *uplo, F_INT *A, F_INT *IERROR)
void FLA_F2C() fla_random_tri_matrix_f (F_INT *uplo, F_INT *diag, F_INT *A, F_INT *IERROR)
void FLA_F2C() fla_sqrt_f (F_INT *alpha, F_INT *IERROR)
void FLA_F2C() fla_symmetrize_f (F_INT *uplo, F_INT *A, F_INT *IERROR)
void FLA_F2C() fla_triangularize_f (F_INT *uplo, F_INT *diag, F_INT *A, F_INT *IERROR)
void FLA_F2C() fla_transpose_f (F_INT *A, F_INT *IERROR)
FLA_Error FLA_Absolute_square_check (FLA_Obj alpha)
FLA_Error FLA_Conjugate_check (FLA_Obj A)
FLA_Error FLA_Conjugate_r_check (FLA_Uplo uplo, FLA_Obj A)
FLA_Error FLA_Hermitianize_check (FLA_Uplo uplo, FLA_Obj A)
FLA_Error FLA_Invert_check (FLA_Obj alpha)
FLA_Error FLA_Max_abs_value_check (FLA_Obj A, FLA_Obj amax)
FLA_Error FLA_Max_elemwise_diff_check (FLA_Obj A, FLA_Obj B)
FLA_Error FLA_Mult_add_check (FLA_Obj alpha, FLA_Obj beta, FLA_Obj gamma)
FLA_Error FLA_Negate_check (FLA_Obj x)
FLA_Error FLA_Norm1_check (FLA_Obj A, FLA_Obj norm)
FLA_Error FLA_Norm_inf_check (FLA_Obj A, FLA_Obj norm)
FLA_Error FLA_Random_matrix_check (FLA_Obj A)
FLA_Error FLA_Random_herm_matrix_check (FLA_Uplo uplo, FLA_Obj A)
FLA_Error FLA_Random_spd_matrix_check (FLA_Uplo uplo, FLA_Obj A)
FLA_Error FLA_Random_tri_matrix_check (FLA_Uplo uplo, FLA_Diag diag, FLA_Obj A)
FLA_Error FLA_Sqrt_check (FLA_Obj alpha)
FLA_Error FLA_Symmetrize_check (FLA_Uplo uplo, FLA_Obj A)
FLA_Error FLA_Triangularize_check (FLA_Uplo uplo, FLA_Diag diag, FLA_Obj A)
FLA_Error FLA_Transpose_check (FLA_Obj A)
FLA_Error FLA_Transpose_blk_var1 (FLA_Obj A, fla_tpose_t *cntl)
FLA_Error FLA_Transpose_blk_var2 (FLA_Obj A, fla_tpose_t *cntl)
FLA_Error FLA_Transpose_unb_var1 (FLA_Obj A)
FLA_Error FLA_Transpose_unb_var2 (FLA_Obj A)
FLA_Error FLA_Swap_t_blk_var1 (FLA_Obj A, FLA_Obj B, fla_swap_t *cntl)
FLA_Error FLA_Swap_t_blk_var2 (FLA_Obj A, FLA_Obj B, fla_swap_t *cntl)


Function Documentation

FLA_Error FLA_Absolute_square ( FLA_Obj  alpha  ) 

References FLA_Absolute_square_check(), FLA_Check_error_level(), FLA_Obj_datatype(), dcomplex::imag, scomplex::imag, dcomplex::real, and scomplex::real.

Referenced by fla_absolute_square_f(), FLA_Ttmm_l_unb_var1(), FLA_Ttmm_l_unb_var2(), FLA_Ttmm_l_unb_var3(), FLA_Ttmm_u_unb_var1(), FLA_Ttmm_u_unb_var2(), and FLA_Ttmm_u_unb_var3().

00036 {
00037   FLA_Datatype datatype;
00038 
00039   if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
00040     FLA_Absolute_square_check( alpha );
00041 
00042   datatype = FLA_Obj_datatype( alpha );
00043   
00044   switch ( datatype ){
00045 
00046   case FLA_FLOAT:
00047   {
00048     float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );
00049 
00050     *buff_alpha = (*buff_alpha) * (*buff_alpha);
00051 
00052     break;
00053   }
00054 
00055   case FLA_DOUBLE:
00056   {
00057     double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );
00058 
00059     *buff_alpha = (*buff_alpha) * (*buff_alpha);
00060 
00061     break;
00062   }
00063 
00064   case FLA_COMPLEX:
00065   {
00066     scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00067 
00068     buff_alpha->real = buff_alpha->real * buff_alpha->real + 
00069                        buff_alpha->imag * buff_alpha->imag; 
00070     buff_alpha->imag = 0.0F; 
00071 
00072     break;
00073   }
00074 
00075   case FLA_DOUBLE_COMPLEX:
00076   {
00077     dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00078 
00079     buff_alpha->real = buff_alpha->real * buff_alpha->real + 
00080                        buff_alpha->imag * buff_alpha->imag; 
00081     buff_alpha->imag = 0.0; 
00082 
00083     break;
00084   }
00085 
00086   }
00087 
00088   return FLA_SUCCESS;
00089 }

FLA_Error FLA_Absolute_square_check ( FLA_Obj  alpha  ) 

References FLA_Check_floating_object(), FLA_Check_if_scalar(), and FLA_Check_nonconstant_object().

Referenced by FLA_Absolute_square().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( alpha );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( alpha );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_if_scalar( alpha );
00046   FLA_Check_error_code( e_val );
00047 
00048   return FLA_SUCCESS;
00049 }

void FLA_F2C() fla_absolute_square_f ( F_INT *  alpha,
F_INT *  IERROR 
)

References FLA_Absolute_square().

00093 {
00094   *IERROR = FLA_Absolute_square( *( ( FLA_Obj * ) alpha ) );
00095 }

double FLA_Clock ( void   ) 

double FLA_F2C() fla_clock_f ( void   ) 

References FLA_Clock().

00048 {
00049   return FLA_Clock();
00050 }

FLA_Error FLA_Conjugate ( FLA_Obj  A  ) 

References cblas_dscal(), cblas_sscal(), dscal(), FLA_Check_error_level(), FLA_Conjugate_check(), FLA_MINUS_ONE, FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_is_real(), FLA_Obj_is_vector(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Obj_width(), and sscal().

Referenced by fla_conjugate_f(), FLA_Copyt_external(), and FLA_Swapt_external().

00036 {
00037   FLA_Datatype datatype;
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_MIN_ERROR_CHECKING ) 
00043     FLA_Conjugate_check( A );
00044 
00045   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00046 
00047   if ( FLA_Obj_is_real( A ) ) return FLA_SUCCESS;
00048 
00049   datatype = FLA_Obj_datatype( A );
00050 
00051   m_A      = FLA_Obj_length( A );
00052   n_A      = FLA_Obj_width( A );
00053   ldim_A   = FLA_Obj_ldim( A );
00054 
00055   if ( FLA_Obj_is_vector( A ) )
00056   {
00057     inc_A    = ( m_A == 1 ? 2*ldim_A : 2 );
00058     n_iter   = 1;
00059     num_elem = FLA_Obj_vector_dim( A );
00060   }
00061   else
00062   {
00063     inc_A    = 2;
00064     n_iter   = n_A;
00065     num_elem = m_A;
00066   }
00067 
00068   switch ( datatype ){
00069 
00070   case FLA_COMPLEX:
00071   {
00072     float *buff_A     = ( float * ) FLA_COMPLEX_PTR( A );
00073     float *buff_alpha = ( float * ) FLA_FLOAT_PTR( FLA_MINUS_ONE );
00074 
00075     for ( j = 0; j < n_iter; ++j )
00076     {
00077 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00078       cblas_sscal( num_elem,
00079                    *buff_alpha,
00080                    buff_A+1 + j*2*ldim_A, inc_A );
00081 #else
00082       FLA_C2F( sscal )( &num_elem,
00083                         buff_alpha,
00084                         buff_A+1 + j*2*ldim_A, &inc_A );
00085 #endif
00086     }
00087 
00088     break;
00089   }
00090 
00091   case FLA_DOUBLE_COMPLEX:
00092   { 
00093     double *buff_A     = ( double * ) FLA_DOUBLE_COMPLEX_PTR( A );
00094     double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( FLA_MINUS_ONE );
00095 
00096     for ( j = 0; j < n_iter; ++j )
00097     {
00098 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00099       cblas_dscal( num_elem,
00100                    *buff_alpha,
00101                    buff_A+1 + j*2*ldim_A, inc_A );
00102 #else
00103       FLA_C2F( dscal )( &num_elem,
00104                         buff_alpha,
00105                         buff_A+1 + j*2*ldim_A, &inc_A );
00106 #endif
00107     }
00108 
00109     break;
00110   }
00111 
00112   }
00113   
00114   return FLA_SUCCESS;
00115 }

FLA_Error FLA_Conjugate_check ( FLA_Obj  A  ) 

References FLA_Check_floating_object(), and FLA_Check_nonconstant_object().

Referenced by FLA_Conjugate().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( A );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   return FLA_SUCCESS;
00046 }

void FLA_F2C() fla_conjugate_f ( F_INT *  A,
F_INT *  IERROR 
)

References FLA_Conjugate().

00119 {
00120   *IERROR = FLA_Conjugate( *( ( FLA_Obj * ) A ) );
00121 }

FLA_Error FLA_Conjugate_r ( FLA_Uplo  uplo,
FLA_Obj  A 
)

References FLA_Check_error_level(), FLA_Conjugate_r_check(), FLA_MINUS_ONE, FLA_Obj_datatype(), FLA_Obj_is_real(), FLA_Obj_ldim(), FLA_Obj_length(), and FLA_Obj_width().

Referenced by fla_conjugate_r_f(), and FLA_Hermitianize().

00036 {
00037   FLA_Datatype datatype;
00038   int          i, j;
00039   int          m_A, n_A, ldim_A;
00040 
00041   if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
00042     FLA_Conjugate_r_check( uplo, A );
00043 
00044   if ( FLA_Obj_is_real( A ) ) return FLA_SUCCESS;
00045 
00046   datatype = FLA_Obj_datatype( A );
00047 
00048   m_A      = FLA_Obj_length( A );
00049   n_A      = FLA_Obj_width( A );
00050   ldim_A   = FLA_Obj_ldim( A );
00051 
00052   switch ( datatype ){
00053 
00054   case FLA_COMPLEX:
00055   {
00056     scomplex *buff_A  = ( scomplex * ) FLA_COMPLEX_PTR( A );
00057     float    *buff_n1 = ( float    * ) FLA_FLOAT_PTR( FLA_MINUS_ONE );
00058 
00059     if ( uplo == FLA_LOWER_TRIANGULAR )
00060     {
00061       for ( j = 0; j < n_A; j++ )
00062       {
00063         for ( i = j; i < m_A; i++ )
00064           buff_A[ j*ldim_A + i ].imag *= *buff_n1;
00065       } 
00066     }
00067     else if ( uplo == FLA_UPPER_TRIANGULAR ) 
00068     {
00069       for ( j = 0; j < n_A; j++ )
00070       {
00071         for ( i = 0; i < j + 1; i++ )
00072           buff_A[ j*ldim_A + i ].imag *= *buff_n1;
00073       } 
00074     }
00075 
00076     break;
00077   }
00078 
00079   case FLA_DOUBLE_COMPLEX:
00080   {
00081     dcomplex *buff_A  = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00082     double   *buff_n1 = ( double   * ) FLA_DOUBLE_PTR( FLA_MINUS_ONE );
00083 
00084     if ( uplo == FLA_LOWER_TRIANGULAR )
00085     {
00086       for ( j = 0; j < n_A; j++ )
00087       {
00088         for ( i = j; i < m_A; i++ )
00089           buff_A[ j*ldim_A + i ].imag *= *buff_n1;
00090       } 
00091     }
00092     else if ( uplo == FLA_UPPER_TRIANGULAR ) 
00093     {
00094       for ( j = 0; j < n_A; j++ )
00095       {
00096         for ( i = 0; i < j + 1; i++ )
00097           buff_A[ j*ldim_A + i ].imag *= *buff_n1;
00098       } 
00099     }
00100 
00101     break;
00102   }
00103 
00104   }
00105 
00106   return FLA_SUCCESS;
00107 }

FLA_Error FLA_Conjugate_r_check ( FLA_Uplo  uplo,
FLA_Obj  A 
)

References FLA_Check_floating_object(), FLA_Check_nonconstant_object(), and FLA_Check_valid_uplo().

Referenced by FLA_Conjugate_r().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_uplo( uplo );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_floating_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_nonconstant_object( A );
00046   FLA_Check_error_code( e_val );
00047 
00048   return FLA_SUCCESS;
00049 }

void FLA_F2C() fla_conjugate_r_f ( F_INT *  uplo,
F_INT *  A,
F_INT *  IERROR 
)

References FLA_Conjugate_r().

00111 {
00112   *IERROR = FLA_Conjugate_r( *( ( FLA_Uplo * ) uplo ),
00113                              *( ( FLA_Obj  * ) A    ) );
00114 }

FLA_Error FLA_FLA_Mult_add ( FLA_Obj  alpha,
FLA_Obj  beta,
FLA_Obj  gamma 
)

FLA_Error FLA_Hermitianize ( FLA_Uplo  uplo,
FLA_Obj  A 
)

References FLA_Check_error_level(), FLA_Conjugate_r(), FLA_Hermitianize_check(), FLA_Obj_datatype(), FLA_Obj_is_real(), FLA_Obj_ldim(), FLA_Obj_width(), FLA_Symmetrize(), FLA_ZERO, dcomplex::imag, and scomplex::imag.

Referenced by fla_hermitianize_f(), and FLA_Random_herm_matrix().

00036 {
00037   FLA_Datatype datatype;
00038   int          j;
00039   int          n_A, ldim_A;
00040 
00041   if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
00042     FLA_Hermitianize_check( uplo, A );
00043 
00044   FLA_Symmetrize( uplo, A );
00045 
00046   if ( FLA_Obj_is_real( A ) ) return FLA_SUCCESS;
00047 
00048   if ( uplo == FLA_LOWER_TRIANGULAR )
00049     FLA_Conjugate_r( FLA_UPPER_TRIANGULAR, A );
00050   else
00051     FLA_Conjugate_r( FLA_LOWER_TRIANGULAR, A );
00052 
00053 
00054   datatype = FLA_Obj_datatype( A );
00055 
00056   n_A      = FLA_Obj_width( A );
00057   ldim_A   = FLA_Obj_ldim( A );
00058 
00059   switch ( datatype ){
00060 
00061   case FLA_COMPLEX:
00062   {
00063     scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
00064     scomplex *buff_0 = ( scomplex * ) FLA_COMPLEX_PTR( FLA_ZERO );
00065 
00066     for ( j = 0; j < n_A; j++ )
00067       buff_A[ j*ldim_A + j ].imag = buff_0->imag;
00068 
00069     break;
00070   }
00071 
00072   case FLA_DOUBLE_COMPLEX:
00073   {
00074     dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00075     dcomplex *buff_0 = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( FLA_ZERO );
00076 
00077     for ( j = 0; j < n_A; j++ )
00078       buff_A[ j*ldim_A + j ].imag = buff_0->imag;
00079 
00080     break;
00081   }
00082 
00083   }
00084 
00085   return FLA_SUCCESS;
00086 }

FLA_Error FLA_Hermitianize_check ( FLA_Uplo  uplo,
FLA_Obj  A 
)

References FLA_Check_floating_object(), FLA_Check_nonconstant_object(), FLA_Check_square(), and FLA_Check_valid_uplo().

Referenced by FLA_Hermitianize().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_uplo( uplo );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_floating_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_nonconstant_object( A );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_square( A );
00049   FLA_Check_error_code( e_val );
00050 
00051   return FLA_SUCCESS;
00052 }

void FLA_F2C() fla_hermitianize_f ( F_INT *  uplo,
F_INT *  A,
F_INT *  IERROR 
)

References FLA_Hermitianize().

00090 {
00091   *IERROR = FLA_Hermitianize( *( ( FLA_Uplo * ) uplo ),
00092                               *( ( FLA_Obj  * ) A    ) );
00093 }

FLA_Error FLA_Invert ( FLA_Obj  alpha  ) 

References FLA_Check_error_level(), FLA_Invert_check(), FLA_Obj_datatype(), dcomplex::imag, scomplex::imag, dcomplex::real, and scomplex::real.

Referenced by fla_invert_f(), FLA_Trinv_l_unb_var1(), FLA_Trinv_l_unb_var2(), FLA_Trinv_l_unb_var3(), FLA_Trinv_l_unb_var4(), FLA_Trinv_u_unb_var1(), FLA_Trinv_u_unb_var2(), FLA_Trinv_u_unb_var3(), and FLA_Trinv_u_unb_var4().

00036 {
00037   FLA_Datatype datatype;
00038 
00039   if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
00040     FLA_Invert_check( alpha );
00041 
00042   datatype = FLA_Obj_datatype( alpha );
00043   
00044   switch ( datatype ){
00045 
00046   case FLA_FLOAT:
00047   {
00048     float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );
00049 
00050     *buff_alpha = 1.0F / *buff_alpha;
00051 
00052     break;
00053   }
00054 
00055   case FLA_DOUBLE:
00056   {
00057     double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );
00058 
00059     *buff_alpha = 1.0 / *buff_alpha;
00060 
00061     break;
00062   }
00063 
00064   case FLA_COMPLEX:
00065   {
00066     scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00067     float     temp;
00068 
00069     temp = 1.0F / ( buff_alpha->real * buff_alpha->real + 
00070                     buff_alpha->imag * buff_alpha->imag );
00071 
00072     buff_alpha->real = buff_alpha->real *  temp; 
00073     buff_alpha->imag = buff_alpha->imag * -temp; 
00074 
00075     break;
00076   }
00077 
00078   case FLA_DOUBLE_COMPLEX:
00079   {
00080     dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00081     double    temp;
00082 
00083     temp = 1.0 / ( buff_alpha->real * buff_alpha->real + 
00084                    buff_alpha->imag * buff_alpha->imag );
00085 
00086     buff_alpha->real = buff_alpha->real *  temp; 
00087     buff_alpha->imag = buff_alpha->imag * -temp; 
00088 
00089     break;
00090   }
00091 
00092   }
00093 
00094   return FLA_SUCCESS;
00095 }

FLA_Error FLA_Invert_check ( FLA_Obj  alpha  ) 

References FLA_Check_floating_object(), FLA_Check_if_scalar(), and FLA_Check_nonconstant_object().

Referenced by FLA_Invert().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( alpha );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( alpha );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_if_scalar( alpha );
00046   FLA_Check_error_code( e_val );
00047 
00048   return FLA_SUCCESS;
00049 }

void FLA_F2C() fla_invert_f ( F_INT *  alpha,
F_INT *  IERROR 
)

References FLA_Invert().

00099 {
00100   *IERROR = FLA_Invert( *( ( FLA_Obj * ) alpha ) );
00101 }

FLA_Error FLA_Max_abs_value ( FLA_Obj  A,
FLA_Obj  amax 
)

References FLA_Check_error_level(), FLA_Max_abs_value_check(), FLA_Obj_datatype(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_width(), dcomplex::imag, scomplex::imag, dcomplex::real, and scomplex::real.

Referenced by fla_max_abs_value_f(), FLA_Norm1(), and FLA_Norm_inf().

00036 {
00037   FLA_Datatype datatype;
00038   int          m_A, n_A, ldim_A;
00039   int          i, j;
00040 
00041   if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
00042     FLA_Max_abs_value_check( A, amax );
00043 
00044   m_A    = FLA_Obj_length( A );
00045   n_A    = FLA_Obj_width( A );
00046   ldim_A = FLA_Obj_ldim( A );
00047 
00048   datatype = FLA_Obj_datatype( A );
00049   
00050   switch ( datatype ){
00051 
00052   case FLA_FLOAT:
00053   {
00054     float *buff_A     = ( float * ) FLA_FLOAT_PTR( A );
00055     float *buff_amax  = ( float * ) FLA_FLOAT_PTR( amax );
00056     float  curr_amax;
00057     float  temp_amax;
00058 
00059     // Initialize the search with the absolute value of the first element.
00060     curr_amax = ( float ) fabs( buff_A[0] );
00061 
00062     // Inspect each element, saving values in curr_amax that are larger than
00063     // the previous elements.
00064     for( j = 0; j < n_A; j++ )
00065     {
00066       for( i = 0; i < m_A; i++ )
00067       {
00068         temp_amax = ( float ) fabs( buff_A[ j * ldim_A + i ] );
00069 
00070         if ( curr_amax < temp_amax )
00071           curr_amax = temp_amax;
00072       }
00073     }
00074 
00075     // Copy the result into the amax object buffer.
00076     *buff_amax = curr_amax;
00077 
00078     break;
00079   }
00080 
00081   case FLA_DOUBLE:
00082   {
00083     double *buff_A     = ( double * ) FLA_DOUBLE_PTR( A );
00084     double *buff_amax  = ( double * ) FLA_DOUBLE_PTR( amax );
00085     double  curr_amax;
00086     double  temp_amax;
00087 
00088     // Initialize the search with the absolute value of the first element.
00089     curr_amax = ( double ) fabs( buff_A[0] );
00090 
00091     // Inspect each element, saving values in curr_amax that are larger than
00092     // the previous elements.
00093     for( j = 0; j < n_A; j++ )
00094     {
00095       for( i = 0; i < m_A; i++ )
00096       {
00097         temp_amax = ( double ) fabs( buff_A[ j * ldim_A + i ] );
00098 
00099         if ( curr_amax < temp_amax )
00100           curr_amax = temp_amax;
00101       }
00102     }
00103 
00104     // Copy the result into the amax object buffer.
00105     *buff_amax = curr_amax;
00106 
00107 
00108     break;
00109   }
00110 
00111   case FLA_COMPLEX:
00112   {
00113     scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
00114     float    *buff_amax  = ( float    * ) FLA_FLOAT_PTR( amax );
00115     scomplex *curr_value;
00116     scomplex *temp_value;
00117     float     curr_amax;
00118     float     temp_amax;
00119 
00120     curr_value = buff_A;
00121 
00122     // Initialize the search with the absolute value of the first element.
00123     curr_amax = ( float ) sqrt( curr_value->real * curr_value->real + 
00124                                 curr_value->imag * curr_value->imag ); 
00125 
00126     // Inspect each element, saving values in curr_amax that are larger than
00127     // the previous elements.
00128     for( j = 0; j < n_A; j++ )
00129     {
00130       for( i = 0; i < m_A; i++ )
00131       {
00132         temp_value = buff_A + j * ldim_A + i;
00133 
00134         temp_amax = ( float ) sqrt( temp_value->real * temp_value->real + 
00135                                     temp_value->imag * temp_value->imag ); 
00136 
00137         if ( curr_amax < temp_amax )
00138           curr_amax = temp_amax;
00139       }
00140     }
00141 
00142     // Copy the result into the amax object buffer.
00143     *buff_amax = curr_amax;
00144 
00145     break;
00146   }
00147 
00148   case FLA_DOUBLE_COMPLEX:
00149   {
00150     dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00151     double   *buff_amax  = ( double   * ) FLA_DOUBLE_PTR( amax );
00152     dcomplex *curr_value;
00153     dcomplex *temp_value;
00154     double    curr_amax;
00155     double    temp_amax;
00156 
00157     curr_value = buff_A;
00158 
00159     // Initialize the search with the absolute value of the first element.
00160     curr_amax = ( double ) sqrt( curr_value->real * curr_value->real + 
00161                                  curr_value->imag * curr_value->imag ); 
00162 
00163     // Inspect each element, saving values in curr_amax that are larger than
00164     // the previous elements.
00165     for( j = 0; j < n_A; j++ )
00166     {
00167       for( i = 0; i < m_A; i++ )
00168       {
00169         temp_value = buff_A + j * ldim_A + i;
00170 
00171         temp_amax = ( double ) sqrt( temp_value->real * temp_value->real + 
00172                                      temp_value->imag * temp_value->imag ); 
00173 
00174         if ( curr_amax < temp_amax )
00175           curr_amax = temp_amax;
00176       }
00177     }
00178 
00179     // Copy the result into the amax object buffer.
00180     *buff_amax = curr_amax;
00181 
00182     break;
00183   }
00184 
00185   }
00186 
00187   return FLA_SUCCESS;
00188 }

FLA_Error FLA_Max_abs_value_check ( FLA_Obj  A,
FLA_Obj  amax 
)

References FLA_Check_floating_object(), FLA_Check_identical_object_precision(), FLA_Check_if_scalar(), FLA_Check_nonconstant_object(), and FLA_Check_real_object().

Referenced by FLA_Max_abs_value().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( A );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_real_object( amax );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_identical_object_precision( A, amax );
00049   FLA_Check_error_code( e_val );
00050   
00051   e_val = FLA_Check_if_scalar( amax );
00052   FLA_Check_error_code( e_val );
00053   
00054   return FLA_SUCCESS;
00055 }

void FLA_F2C() fla_max_abs_value_f ( F_INT *  A,
F_INT *  amax,
F_INT *  IERROR 
)

References FLA_Max_abs_value().

00192 {
00193   *IERROR = FLA_Max_abs_value( *( ( FLA_Obj * ) A    ),
00194                                *( ( FLA_Obj * ) amax ) );
00195 }

double FLA_Max_elemwise_diff ( FLA_Obj  A,
FLA_Obj  B 
)

References FLA_Check_error_level(), FLA_Max_elemwise_diff_check(), FLA_Obj_datatype(), FLA_Obj_ldim(), FLA_Obj_length(), and FLA_Obj_width().

Referenced by fla_max_elemwise_diff_f(), and FLASH_Max_elemwise_diff().

00036 {
00037   int
00038     i, j,
00039     m, n,
00040     lda, ldb;
00041   double
00042     diff,
00043     d_max = 0.0;
00044 
00045   if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
00046     FLA_Max_elemwise_diff_check( A, B );
00047 
00048   m   = FLA_Obj_length( A );
00049   n   = FLA_Obj_width( A );
00050   lda = FLA_Obj_ldim( A );
00051   ldb = FLA_Obj_ldim( B );
00052   
00053   switch( FLA_Obj_datatype( A ) ){
00054 
00055   case FLA_FLOAT:
00056   {
00057     float *buff_a = ( float * ) FLA_FLOAT_PTR( A );
00058     float *buff_b = ( float * ) FLA_FLOAT_PTR( B );
00059 
00060     for( j = 0; j < n; j++ )
00061     {
00062       for( i = 0; i < m; i++ )
00063       {
00064         diff = ( double ) ( buff_a[ j*lda + i ] - buff_b[ j*ldb + i ] );
00065 
00066         if( fabs(diff) > d_max )
00067           d_max = fabs(diff);
00068       }
00069     }
00070 
00071     break;
00072   }
00073 
00074   case FLA_DOUBLE:
00075   {
00076     double *buff_a = ( double * ) FLA_DOUBLE_PTR( A );
00077     double *buff_b = ( double * ) FLA_DOUBLE_PTR( B );
00078 
00079     for( j = 0; j < n; j++ )
00080     {
00081       for( i = 0; i < m; i++ )
00082       {
00083         diff = ( double ) ( buff_a[ j*lda + i ] - buff_b[ j*ldb + i ] );
00084 
00085         if( fabs(diff) > d_max )
00086           d_max = fabs(diff);
00087       }
00088     }
00089 
00090     break;
00091   }
00092 
00093   case FLA_COMPLEX:
00094   {
00095     scomplex *buff_a = ( scomplex * ) FLA_COMPLEX_PTR( A );
00096     scomplex *buff_b = ( scomplex * ) FLA_COMPLEX_PTR( B );
00097 
00098     for( j = 0; j < n; j++ )
00099     {
00100       for( i = 0; i < m; i++ )
00101       {
00102         diff = ( double ) ( buff_a[ j*lda + i ].real - buff_b[ j*ldb + i ].real );
00103 
00104         if( fabs(diff) > d_max )
00105           d_max = fabs(diff);
00106 
00107         diff = ( double ) ( buff_a[ j*lda + i ].imag - buff_b[ j*ldb + i ].imag );
00108 
00109         if( fabs(diff) > d_max )
00110           d_max = fabs(diff);
00111       }
00112     }
00113 
00114     break;
00115   }
00116 
00117   case FLA_DOUBLE_COMPLEX:
00118   {
00119     dcomplex *buff_a = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00120     dcomplex *buff_b = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B );
00121 
00122     for( j = 0; j < n; j++ )
00123     {
00124       for( i = 0; i < m; i++ )
00125       {
00126         diff = ( double ) ( buff_a[ j*lda + i ].real - buff_b[ j*ldb + i ].real );
00127 
00128         if( fabs(diff) > d_max )
00129           d_max = fabs(diff);
00130 
00131         diff = ( double ) ( buff_a[ j*lda + i ].imag - buff_b[ j*ldb + i ].imag );
00132 
00133         if( fabs(diff) > d_max )
00134           d_max = fabs(diff);
00135       }
00136     }
00137 
00138     break;
00139   }
00140 
00141   }
00142 
00143   
00144   return d_max;
00145 }

FLA_Error FLA_Max_elemwise_diff_check ( FLA_Obj  A,
FLA_Obj  B 
)

References FLA_Check_conformal_dims(), FLA_Check_floating_object(), FLA_Check_identical_object_datatype(), and FLA_Check_nonconstant_object().

Referenced by FLA_Max_elemwise_diff().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( A );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_identical_object_datatype( A, B );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_conformal_dims( FLA_NO_TRANSPOSE, A, B );
00049   FLA_Check_error_code( e_val );
00050 
00051   return FLA_SUCCESS;
00052 }

double FLA_F2C() fla_max_elemwise_diff_f ( F_INT *  A,
F_INT *  B 
)

References FLA_Max_elemwise_diff().

00149 {
00150   return FLA_Max_elemwise_diff( *( ( FLA_Obj * ) A ), *( ( FLA_Obj * ) B ) );
00151 }

FLA_Error FLA_Mult_add_check ( FLA_Obj  alpha,
FLA_Obj  beta,
FLA_Obj  gamma 
)

References FLA_Check_floating_object(), FLA_Check_if_scalar(), and FLA_Check_nonconstant_object().

Referenced by FLA_Mult_add().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( alpha );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_floating_object( beta );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_floating_object( gamma );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_if_scalar( alpha );
00049   FLA_Check_error_code( e_val );
00050 
00051   e_val = FLA_Check_if_scalar( beta );
00052   FLA_Check_error_code( e_val );
00053 
00054   e_val = FLA_Check_if_scalar( gamma );
00055   FLA_Check_error_code( e_val );
00056 
00057   e_val = FLA_Check_nonconstant_object( gamma );
00058   FLA_Check_error_code( e_val );
00059 
00060   return FLA_SUCCESS;
00061 }

void FLA_F2C() fla_mult_add_f ( F_INT *  alpha,
F_INT *  beta,
F_INT *  gamma,
F_INT *  IERROR 
)

References FLA_Mult_add().

00113 {
00114   *IERROR = FLA_Mult_add( *( ( FLA_Obj * ) alpha ),
00115                           *( ( FLA_Obj * ) beta  ),
00116                           *( ( FLA_Obj * ) gamma ) );
00117 }

FLA_Error FLA_Negate ( FLA_Obj  x  ) 

References FLA_Check_error_level(), FLA_MINUS_ONE, FLA_Negate_check(), and FLA_Scal_external().

Referenced by FLA_Inv_scal_external(), FLA_Inv_scalc_external(), fla_negate_f(), and FLA_Scalc_external().

00036 {
00037   if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
00038     FLA_Negate_check( x );
00039 
00040   return FLA_Scal_external( FLA_MINUS_ONE, x );
00041 }

FLA_Error FLA_Negate_check ( FLA_Obj  x  ) 

References FLA_Check_floating_object(), and FLA_Check_nonconstant_object().

Referenced by FLA_Negate().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( x );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( x );
00043   FLA_Check_error_code( e_val );
00044 
00045   return FLA_SUCCESS;
00046 }

void FLA_F2C() fla_negate_f ( F_INT *  x,
F_INT *  IERROR 
)

References FLA_Negate().

00045 {
00046   *IERROR = FLA_Negate( *( ( FLA_Obj * ) x ) );
00047 }

FLA_Error FLA_Norm1 ( FLA_Obj  A,
FLA_Obj  norm 
)

References FLA_Asum_external(), FLA_Check_error_level(), FLA_Cont_with_1x3_to_1x2(), FLA_Max_abs_value(), FLA_Norm1_check(), FLA_Obj_create(), FLA_Obj_datatype(), FLA_Obj_free(), FLA_Obj_width(), FLA_Part_1x2(), and FLA_Repart_1x2_to_1x3().

Referenced by fla_norm1_f(), and FLASH_Norm1().

00036 {
00037   FLA_Obj AL,   AR,       A0,  a1,  A2;
00038 
00039   FLA_Obj b;
00040   FLA_Obj bL,   bR,       b0,  beta1,  b2;
00041 
00042   if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
00043     FLA_Norm1_check( A, norm );
00044 
00045   FLA_Obj_create( FLA_Obj_datatype( A ), 1, FLA_Obj_width( A ), &b );
00046 
00047   FLA_Part_1x2( A,    &AL,  &AR,      0, FLA_LEFT );
00048 
00049   FLA_Part_1x2( b,    &bL,  &bR,      0, FLA_LEFT );
00050 
00051   while ( FLA_Obj_width( AL ) < FLA_Obj_width( A ) ){
00052 
00053     FLA_Repart_1x2_to_1x3( AL,  /**/ AR,        &A0, /**/ &a1, &A2,
00054                            1, FLA_RIGHT );
00055 
00056     FLA_Repart_1x2_to_1x3( bL,  /**/ bR,        &b0, /**/ &beta1, &b2,
00057                            1, FLA_RIGHT );
00058 
00059     /*------------------------------------------------------------*/
00060 
00061     FLA_Asum_external( a1, beta1 );
00062 
00063     /*------------------------------------------------------------*/
00064 
00065     FLA_Cont_with_1x3_to_1x2( &AL,  /**/ &AR,        A0, a1, /**/ A2,
00066                               FLA_LEFT );
00067 
00068     FLA_Cont_with_1x3_to_1x2( &bL,  /**/ &bR,        b0, beta1, /**/ b2,
00069                               FLA_LEFT );
00070   }
00071 
00072   FLA_Max_abs_value( b, norm );
00073 
00074   FLA_Obj_free( &b );
00075 
00076   return FLA_SUCCESS;
00077 }

FLA_Error FLA_Norm1_check ( FLA_Obj  A,
FLA_Obj  norm 
)

References FLA_Check_floating_object(), FLA_Check_identical_object_precision(), FLA_Check_if_scalar(), FLA_Check_nonconstant_object(), and FLA_Check_real_object().

Referenced by FLA_Norm1().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( A );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_real_object( norm );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_identical_object_precision( A, norm );
00049   FLA_Check_error_code( e_val );
00050   
00051   e_val = FLA_Check_if_scalar( norm );
00052   FLA_Check_error_code( e_val );
00053 
00054   return FLA_SUCCESS;
00055 }

void FLA_F2C() fla_norm1_f ( F_INT *  A,
F_INT *  norm,
F_INT *  IERROR 
)

References FLA_Norm1().

00081 {
00082   *IERROR = FLA_Norm1( *( ( FLA_Obj * ) A    ),
00083                        *( ( FLA_Obj * ) norm ) );
00084 }

FLA_Error FLA_Norm_inf ( FLA_Obj  A,
FLA_Obj  norm 
)

References FLA_Asum_external(), FLA_Check_error_level(), FLA_Cont_with_3x1_to_2x1(), FLA_Max_abs_value(), FLA_Norm_inf_check(), FLA_Obj_create(), FLA_Obj_datatype(), FLA_Obj_free(), FLA_Obj_length(), FLA_Part_2x1(), and FLA_Repart_2x1_to_3x1().

Referenced by fla_norm_inf_f().

00036 {
00037   FLA_Obj AT,              A0,
00038           AB,              a1t,
00039                            A2;
00040 
00041   FLA_Obj bT,              b0,
00042           bB,              beta1,
00043                            b2;
00044   FLA_Obj b;
00045 
00046   if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
00047     FLA_Norm_inf_check( A, norm );
00048 
00049   FLA_Obj_create( FLA_Obj_datatype( A ), FLA_Obj_length( A ), 1, &b );
00050 
00051   FLA_Part_2x1( A,    &AT, 
00052                       &AB,            0, FLA_TOP );
00053 
00054   FLA_Part_2x1( b,    &bT, 
00055                       &bB,            0, FLA_TOP );
00056 
00057   while ( FLA_Obj_length( AT ) < FLA_Obj_length( A ) ){
00058 
00059     FLA_Repart_2x1_to_3x1( AT,                &A0, 
00060                         /* ** */            /* *** */
00061                                               &a1t, 
00062                            AB,                &A2,        1, FLA_BOTTOM );
00063 
00064     FLA_Repart_2x1_to_3x1( bT,                &b0, 
00065                         /* ** */            /* ***** */
00066                                               &beta1, 
00067                            bB,                &b2,        1, FLA_BOTTOM );
00068 
00069     /*------------------------------------------------------------*/
00070 
00071     FLA_Asum_external( a1t, beta1 );
00072 
00073     /*------------------------------------------------------------*/
00074 
00075     FLA_Cont_with_3x1_to_2x1( &AT,                A0, 
00076                                                   a1t, 
00077                             /* ** */           /* *** */
00078                               &AB,                A2,     FLA_TOP );
00079 
00080     FLA_Cont_with_3x1_to_2x1( &bT,                b0, 
00081                                                   beta1, 
00082                             /* ** */           /* ***** */
00083                               &bB,                b2,     FLA_TOP );
00084 
00085   }
00086 
00087   FLA_Max_abs_value( b, norm );
00088 
00089   FLA_Obj_free( &b );
00090 
00091   return FLA_SUCCESS;
00092 }

FLA_Error FLA_Norm_inf_check ( FLA_Obj  A,
FLA_Obj  norm 
)

References FLA_Check_floating_object(), FLA_Check_identical_object_precision(), FLA_Check_if_scalar(), FLA_Check_nonconstant_object(), and FLA_Check_real_object().

Referenced by FLA_Norm_inf().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( A );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_real_object( norm );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_identical_object_precision( A, norm );
00049   FLA_Check_error_code( e_val );
00050   
00051   e_val = FLA_Check_if_scalar( norm );
00052   FLA_Check_error_code( e_val );
00053 
00054   return FLA_SUCCESS;
00055 }

void FLA_F2C() fla_norm_inf_f ( F_INT *  A,
F_INT *  norm,
F_INT *  IERROR 
)

References FLA_Norm_inf().

00096 {
00097   *IERROR = FLA_Norm_inf( *( ( FLA_Obj * ) A    ),
00098                           *( ( FLA_Obj * ) norm ) );
00099 }

dcomplex FLA_random_dcomplex ( void   ) 

References FLA_random_double(), dcomplex::imag, and dcomplex::real.

Referenced by FLA_Random_matrix(), and FLA_Random_tri_matrix().

00056 {
00057   dcomplex z;
00058 
00059   z.real = FLA_random_double();
00060   z.imag = FLA_random_double();
00061 
00062   return z;
00063 }

double FLA_random_double ( void   ) 

Referenced by FLA_random_dcomplex(), FLA_Random_matrix(), and FLA_Random_tri_matrix().

00041 {
00042   return ( ( double ) rand() / ( double ) RAND_MAX ) * 2.0 - 1.0;
00043 }

float FLA_random_float ( void   ) 

Referenced by FLA_Random_matrix(), FLA_random_scomplex(), and FLA_Random_tri_matrix().

00036 {
00037   return ( float )( ( ( double ) rand() / ( double ) RAND_MAX ) * 2.0 - 1.0 );
00038 }

FLA_Error FLA_Random_herm_matrix ( FLA_Uplo  uplo,
FLA_Obj  A 
)

References FLA_Check_error_level(), FLA_Hermitianize(), FLA_Random_herm_matrix_check(), and FLA_Random_tri_matrix().

Referenced by fla_random_herm_matrix_f().

00036 {
00037   if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
00038     FLA_Random_herm_matrix_check( uplo, A );
00039 
00040   FLA_Random_tri_matrix( uplo, FLA_NONUNIT_DIAG, A );
00041 
00042   FLA_Hermitianize( uplo, A );
00043 
00044   return FLA_SUCCESS;
00045 }

FLA_Error FLA_Random_herm_matrix_check ( FLA_Uplo  uplo,
FLA_Obj  A 
)

References FLA_Check_complex_object(), FLA_Check_nonconstant_object(), FLA_Check_square(), and FLA_Check_valid_uplo().

Referenced by FLA_Random_herm_matrix().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_uplo( uplo );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_complex_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_nonconstant_object( A );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_square( A );
00049   FLA_Check_error_code( e_val );
00050 
00051   return FLA_SUCCESS;
00052 }

void FLA_F2C() fla_random_herm_matrix_f ( F_INT *  uplo,
F_INT *  A,
F_INT *  IERROR 
)

References FLA_Random_herm_matrix().

00049 {
00050   *IERROR = FLA_Random_herm_matrix( *( ( FLA_Uplo * ) uplo ),
00051                                     *( ( FLA_Obj  * ) A    ) );
00052 }

FLA_Error FLA_Random_matrix ( FLA_Obj  A  ) 

References FLA_Check_error_level(), FLA_Obj_datatype(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_width(), FLA_random_dcomplex(), FLA_random_double(), FLA_random_float(), FLA_Random_matrix_check(), and FLA_random_scomplex().

Referenced by fla_random_matrix_f(), FLA_Random_spd_matrix(), and FLASH_Random_matrix().

00036 {
00037   FLA_Datatype datatype;
00038   int          i, j;
00039   int          m_A, n_A, ldim_A;
00040 
00041   if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
00042     FLA_Random_matrix_check( A );
00043 
00044   datatype = FLA_Obj_datatype( A );
00045 
00046   m_A      = FLA_Obj_length( A );
00047   n_A      = FLA_Obj_width( A );
00048   ldim_A   = FLA_Obj_ldim( A );
00049 
00050   switch( datatype ){
00051 
00052   case FLA_FLOAT:
00053   {
00054     float *buff_A = ( float * ) FLA_FLOAT_PTR( A );
00055 
00056     for ( j = 0; j < n_A; j++ )
00057     {
00058       for ( i = 0; i < m_A; i++ )
00059       {
00060         buff_A[ j*ldim_A + i ] = FLA_random_float();
00061       }
00062     }
00063 
00064     break;
00065   }
00066 
00067   case FLA_DOUBLE:
00068   {
00069     double *buff_A = ( double * ) FLA_DOUBLE_PTR( A );
00070 
00071     for ( j = 0; j < n_A; j++ )
00072     {
00073       for ( i = 0; i < m_A; i++ )
00074       {
00075         buff_A[ j*ldim_A + i ] = FLA_random_double();
00076       }
00077     }
00078 
00079     break;
00080   }
00081 
00082   case FLA_COMPLEX:
00083   {
00084     scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
00085 
00086     for ( j = 0; j < n_A; j++ )
00087     {
00088       for ( i = 0; i < m_A; i++ )
00089       {
00090         buff_A[ j*ldim_A + i ] = FLA_random_scomplex();
00091       }
00092     }
00093 
00094     break;
00095   }
00096 
00097   case FLA_DOUBLE_COMPLEX:
00098   {
00099     dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00100 
00101     for ( j = 0; j < n_A; j++ )
00102     {
00103       for ( i = 0; i < m_A; i++ )
00104       {
00105         buff_A[ j*ldim_A + i ] = FLA_random_dcomplex();
00106       }
00107     }
00108 
00109     break;
00110   }
00111 
00112   }
00113 
00114   return FLA_SUCCESS;
00115 }

FLA_Error FLA_Random_matrix_check ( FLA_Obj  A  ) 

References FLA_Check_floating_object(), and FLA_Check_nonconstant_object().

Referenced by FLA_Random_matrix().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( A );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   return FLA_SUCCESS;
00046 }

void FLA_F2C() fla_random_matrix_f ( F_INT *  A,
F_INT *  IERROR 
)

References FLA_Random_matrix().

00119 {
00120   *IERROR = FLA_Random_matrix( *( ( FLA_Obj * ) A ) );
00121 }

scomplex FLA_random_scomplex ( void   ) 

References FLA_random_float(), scomplex::imag, and scomplex::real.

Referenced by FLA_Random_matrix(), and FLA_Random_tri_matrix().

00046 {
00047   scomplex z;
00048 
00049   z.real = FLA_random_float();
00050   z.imag = FLA_random_float();
00051 
00052   return z;
00053 }

FLA_Error FLA_Random_spd_matrix ( FLA_Uplo  uplo,
FLA_Obj  A 
)

References FLA_Check_error_level(), FLA_Herk_external(), FLA_Obj_create_conf_to(), FLA_Obj_free(), FLA_Obj_is_real(), FLA_ONE, FLA_Random_matrix(), FLA_Random_spd_matrix_check(), FLA_Symmetrize(), FLA_Syrk_external(), and FLA_ZERO.

Referenced by fla_random_spd_matrix_f(), and FLASH_Random_spd_matrix().

00036 {
00037   FLA_Obj R;
00038 
00039   if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
00040     FLA_Random_spd_matrix_check( uplo, A );
00041 
00042   // Create a temporary object R conformal to A.
00043   FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, A, &R );
00044 
00045   if ( FLA_Obj_is_real( A ) )
00046   {
00047     // Fill R with random real entries.
00048     FLA_Random_matrix( R );
00049     
00050     // A = R * R';
00051     FLA_Syrk_external( uplo, FLA_NO_TRANSPOSE, FLA_ONE, R, FLA_ZERO, A );
00052   }
00053   else
00054   {
00055     // Fill R with random complex entries.
00056     FLA_Random_matrix( R );
00057     
00058     // A = R * conjg( R' );
00059     FLA_Herk_external( uplo, FLA_NO_TRANSPOSE, FLA_ONE, R, FLA_ZERO, A );
00060   }
00061 
00062   // Free R.
00063   FLA_Obj_free( &R );
00064 
00065   // Make A symmetric, preserving the uplo triangle.
00066   FLA_Symmetrize( uplo, A );
00067 
00068   return FLA_SUCCESS;
00069 }

FLA_Error FLA_Random_spd_matrix_check ( FLA_Uplo  uplo,
FLA_Obj  A 
)

References FLA_Check_floating_object(), FLA_Check_nonconstant_object(), FLA_Check_square(), and FLA_Check_valid_uplo().

Referenced by FLA_Random_spd_matrix().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_uplo( uplo );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_floating_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_nonconstant_object( A );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_square( A );
00049   FLA_Check_error_code( e_val );
00050 
00051   return FLA_SUCCESS;
00052 }

void FLA_F2C() fla_random_spd_matrix_f ( F_INT *  uplo,
F_INT *  A,
F_INT *  IERROR 
)

References FLA_Random_spd_matrix().

00073 {
00074   *IERROR = FLA_Random_spd_matrix( *( ( FLA_Uplo * ) uplo ),
00075                                    *( ( FLA_Obj  * ) A    ) );
00076 }

FLA_Error FLA_Random_tri_matrix ( FLA_Uplo  uplo,
FLA_Diag  diag,
FLA_Obj  A 
)

References FLA_Check_error_level(), FLA_Obj_datatype(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_width(), FLA_ONE, FLA_random_dcomplex(), FLA_random_double(), FLA_random_float(), FLA_random_scomplex(), FLA_Random_tri_matrix_check(), and FLA_ZERO.

Referenced by FLA_Random_herm_matrix(), and fla_random_tri_matrix_f().

00036 {
00037   FLA_Datatype datatype;
00038   int          i, j;
00039   int          m_A, n_A, ldim_A;
00040 
00041   if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
00042     FLA_Random_tri_matrix_check( uplo, diag, A );
00043 
00044   datatype = FLA_Obj_datatype( A );
00045 
00046   m_A      = FLA_Obj_length( A );
00047   n_A      = FLA_Obj_width( A );
00048   ldim_A   = FLA_Obj_ldim( A );
00049 
00050   switch( datatype ){
00051 
00052   case FLA_FLOAT:
00053   {
00054     float *buff_A = ( float * ) FLA_FLOAT_PTR( A );
00055     float *buff_0 = ( float * ) FLA_FLOAT_PTR( FLA_ZERO );
00056     float *buff_1 = ( float * ) FLA_FLOAT_PTR( FLA_ONE );
00057 
00058     if ( uplo == FLA_LOWER_TRIANGULAR )
00059     {
00060       for ( j = 0; j < n_A; j++ )
00061       {
00062         for ( i = 0; i < j; i++ )
00063           buff_A[ j*ldim_A + i ] = *buff_0;
00064 
00065         if      ( diag == FLA_UNIT_DIAG )
00066           buff_A[ j*ldim_A + j ] = *buff_1;
00067         else if ( diag == FLA_ZERO_DIAG )
00068           buff_A[ j*ldim_A + j ] = *buff_0;
00069         else
00070           buff_A[ j*ldim_A + j ] = FLA_random_float();
00071 
00072         for ( i = j + 1; i < m_A; i++ )
00073           buff_A[ j*ldim_A + i ] = FLA_random_float();
00074       } 
00075     }
00076     else if ( uplo == FLA_UPPER_TRIANGULAR ) 
00077     {
00078       for ( j = 0; j < n_A; j++ )
00079       {
00080         for ( i = 0; i < j; i++ )
00081           buff_A[ j*ldim_A + i ] = FLA_random_float();
00082 
00083         if      ( diag == FLA_UNIT_DIAG )
00084           buff_A[ j*ldim_A + j ] = *buff_1;
00085         else if ( diag == FLA_ZERO_DIAG )
00086           buff_A[ j*ldim_A + j ] = *buff_0;
00087         else
00088           buff_A[ j*ldim_A + j ] = FLA_random_float();
00089 
00090         for ( i = j + 1; i < m_A; i++ )
00091           buff_A[ j*ldim_A + i ] = *buff_0;
00092       } 
00093     }
00094 
00095     break;
00096   }
00097 
00098   case FLA_DOUBLE:
00099   {
00100     double *buff_A = ( double * ) FLA_DOUBLE_PTR( A );
00101     double *buff_0 = ( double * ) FLA_DOUBLE_PTR( FLA_ZERO );
00102     double *buff_1 = ( double * ) FLA_DOUBLE_PTR( FLA_ONE );
00103 
00104     if ( uplo == FLA_LOWER_TRIANGULAR )
00105     {
00106       for ( j = 0; j < n_A; j++ )
00107       {
00108         for ( i = 0; i < j; i++ )
00109           buff_A[ j*ldim_A + i ] = *buff_0;
00110 
00111         if      ( diag == FLA_UNIT_DIAG )
00112           buff_A[ j*ldim_A + j ] = *buff_1;
00113         else if ( diag == FLA_ZERO_DIAG )
00114           buff_A[ j*ldim_A + j ] = *buff_0;
00115         else
00116           buff_A[ j*ldim_A + j ] = FLA_random_double();
00117 
00118         for ( i = j + 1; i < m_A; i++ )
00119           buff_A[ j*ldim_A + i ] = FLA_random_double();
00120       } 
00121     }
00122     else if ( uplo == FLA_UPPER_TRIANGULAR ) 
00123     {
00124       for ( j = 0; j < n_A; j++ )
00125       {
00126         for ( i = 0; i < j; i++ )
00127           buff_A[ j*ldim_A + i ] = FLA_random_double();
00128 
00129         if      ( diag == FLA_UNIT_DIAG )
00130           buff_A[ j*ldim_A + j ] = *buff_1;
00131         else if ( diag == FLA_ZERO_DIAG )
00132           buff_A[ j*ldim_A + j ] = *buff_0;
00133         else
00134           buff_A[ j*ldim_A + j ] = FLA_random_double();
00135 
00136         for ( i = j + 1; i < m_A; i++ )
00137           buff_A[ j*ldim_A + i ] = *buff_0;
00138       } 
00139     }
00140 
00141     break;
00142   }
00143 
00144   case FLA_COMPLEX:
00145   {
00146     scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
00147     scomplex *buff_0 = ( scomplex * ) FLA_COMPLEX_PTR( FLA_ZERO );
00148     scomplex *buff_1 = ( scomplex * ) FLA_COMPLEX_PTR( FLA_ONE );
00149 
00150     if ( uplo == FLA_LOWER_TRIANGULAR )
00151     {
00152       for ( j = 0; j < n_A; j++ )
00153       {
00154         for ( i = 0; i < j; i++ )
00155           buff_A[ j*ldim_A + i ] = *buff_0;
00156 
00157         if      ( diag == FLA_UNIT_DIAG )
00158           buff_A[ j*ldim_A + j ] = *buff_1;
00159         else if ( diag == FLA_ZERO_DIAG )
00160           buff_A[ j*ldim_A + j ] = *buff_0;
00161         else
00162           buff_A[ j*ldim_A + j ] = FLA_random_scomplex();
00163 
00164         for ( i = j + 1; i < m_A; i++ )
00165           buff_A[ j*ldim_A + i ] = FLA_random_scomplex();
00166       } 
00167     }
00168     else if ( uplo == FLA_UPPER_TRIANGULAR ) 
00169     {
00170       for ( j = 0; j < n_A; j++ )
00171       {
00172         for ( i = 0; i < j; i++ )
00173           buff_A[ j*ldim_A + i ] = FLA_random_scomplex();
00174 
00175         if      ( diag == FLA_UNIT_DIAG )
00176           buff_A[ j*ldim_A + j ] = *buff_1;
00177         else if ( diag == FLA_ZERO_DIAG )
00178           buff_A[ j*ldim_A + j ] = *buff_0;
00179         else
00180           buff_A[ j*ldim_A + j ] = FLA_random_scomplex();
00181 
00182         for ( i = j + 1; i < m_A; i++ )
00183           buff_A[ j*ldim_A + i ] = *buff_0;
00184       } 
00185     }
00186 
00187     break;
00188   }
00189 
00190   case FLA_DOUBLE_COMPLEX:
00191   {
00192     dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00193     dcomplex *buff_0 = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( FLA_ZERO );
00194     dcomplex *buff_1 = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( FLA_ONE );
00195 
00196     if ( uplo == FLA_LOWER_TRIANGULAR )
00197     {
00198       for ( j = 0; j < n_A; j++ )
00199       {
00200         for ( i = 0; i < j; i++ )
00201           buff_A[ j*ldim_A + i ] = *buff_0;
00202 
00203         if      ( diag == FLA_UNIT_DIAG )
00204           buff_A[ j*ldim_A + j ] = *buff_1;
00205         else if ( diag == FLA_ZERO_DIAG )
00206           buff_A[ j*ldim_A + j ] = *buff_0;
00207         else
00208           buff_A[ j*ldim_A + j ] = FLA_random_dcomplex();
00209 
00210         for ( i = j + 1; i < m_A; i++ )
00211           buff_A[ j*ldim_A + i ] = FLA_random_dcomplex();
00212       } 
00213     }
00214     else if ( uplo == FLA_UPPER_TRIANGULAR ) 
00215     {
00216       for ( j = 0; j < n_A; j++ )
00217       {
00218         for ( i = 0; i < j; i++ )
00219           buff_A[ j*ldim_A + i ] = FLA_random_dcomplex();
00220 
00221         if      ( diag == FLA_UNIT_DIAG )
00222           buff_A[ j*ldim_A + j ] = *buff_1;
00223         else if ( diag == FLA_ZERO_DIAG )
00224           buff_A[ j*ldim_A + j ] = *buff_0;
00225         else
00226           buff_A[ j*ldim_A + j ] = FLA_random_dcomplex();
00227 
00228         for ( i = j + 1; i < m_A; i++ )
00229           buff_A[ j*ldim_A + i ] = *buff_0;
00230       } 
00231     }
00232 
00233     break;
00234   }
00235 
00236   }
00237 
00238   return FLA_SUCCESS;
00239 }

FLA_Error FLA_Random_tri_matrix_check ( FLA_Uplo  uplo,
FLA_Diag  diag,
FLA_Obj  A 
)

References FLA_Check_floating_object(), FLA_Check_nonconstant_object(), FLA_Check_square(), FLA_Check_valid_diag(), and FLA_Check_valid_uplo().

Referenced by FLA_Random_tri_matrix().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_uplo( uplo );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_valid_diag( diag );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_floating_object( A );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_nonconstant_object( A );
00049   FLA_Check_error_code( e_val );
00050 
00051   e_val = FLA_Check_square( A );
00052   FLA_Check_error_code( e_val );
00053 
00054   return FLA_SUCCESS;
00055 }

void FLA_F2C() fla_random_tri_matrix_f ( F_INT *  uplo,
F_INT *  diag,
F_INT *  A,
F_INT *  IERROR 
)

References FLA_Random_tri_matrix().

00243 {
00244   *IERROR = FLA_Random_tri_matrix( *( ( FLA_Uplo * ) uplo ),
00245                                    *( ( FLA_Diag * ) diag ),
00246                                    *( ( FLA_Obj  * ) A    ) );
00247 }

FLA_Error FLA_Shift_pivots_to_check ( FLA_Pivot_type  ptype,
FLA_Obj  ipiv 
)

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_pivot_type( ptype );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_int_object( ipiv );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_nonconstant_object( ipiv );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_if_vector( ipiv );
00049   FLA_Check_error_code( e_val );
00050 
00051   e_val = FLA_Check_vector_length( ipiv, FLA_Obj_length( ipiv ) ); 
00052   FLA_Check_error_code( e_val );
00053 
00054   return FLA_SUCCESS;
00055 }

FLA_Error FLA_Sqrt ( FLA_Obj  alpha  ) 

References FLA_Check_error_level(), FLA_Obj_datatype(), FLA_Sqrt_check(), dcomplex::real, and scomplex::real.

Referenced by FLA_Chol_l_unb_var1(), FLA_Chol_l_unb_var2(), FLA_Chol_l_unb_var3(), FLA_Chol_u_unb_var1(), FLA_Chol_u_unb_var2(), FLA_Chol_u_unb_var3(), and fla_sqrt_f().

00036 {
00037   FLA_Datatype datatype;
00038   int          r_val = FLA_SUCCESS;
00039 
00040   if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
00041     FLA_Sqrt_check( alpha );
00042 
00043   datatype = FLA_Obj_datatype( alpha );
00044   
00045   switch ( datatype ){
00046 
00047   case FLA_FLOAT:
00048   {
00049     float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );
00050 
00051     if ( *buff_alpha < 0.0F )
00052       r_val = FLA_FAILURE;
00053     else
00054       *buff_alpha = ( float ) sqrt( *buff_alpha );
00055     
00056     break;
00057   }
00058 
00059   case FLA_DOUBLE:
00060   {
00061     double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );
00062 
00063     if ( *buff_alpha < 0.0 )
00064       r_val = FLA_FAILURE;
00065     else
00066       *buff_alpha = ( double ) sqrt( *buff_alpha );
00067     
00068     break;
00069   }
00070 
00071   case FLA_COMPLEX:
00072   {
00073     scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00074 
00075     if ( buff_alpha->real < 0.0F )
00076       r_val = FLA_FAILURE;
00077     else
00078       buff_alpha->real = ( float ) sqrt( buff_alpha->real );
00079     
00080     break;
00081   }
00082 
00083   case FLA_DOUBLE_COMPLEX:
00084   {
00085     dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00086 
00087     if ( buff_alpha->real < 0.0 )
00088       r_val = FLA_FAILURE;
00089     else
00090       buff_alpha->real = ( double ) sqrt( buff_alpha->real );
00091     
00092     break;
00093   }
00094 
00095   }
00096 
00097   return r_val;
00098 }

FLA_Error FLA_Sqrt_check ( FLA_Obj  alpha  ) 

References FLA_Check_floating_object(), FLA_Check_if_scalar(), and FLA_Check_nonconstant_object().

Referenced by FLA_Sqrt().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( alpha );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( alpha );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_if_scalar( alpha );
00046   FLA_Check_error_code( e_val );
00047 
00048   return FLA_SUCCESS;
00049 }

void FLA_F2C() fla_sqrt_f ( F_INT *  alpha,
F_INT *  IERROR 
)

References FLA_Sqrt().

00102 {
00103   *IERROR = FLA_Sqrt( *( ( FLA_Obj * ) alpha ) );
00104 }

FLA_Error FLA_Swap_t_blk_var1 ( FLA_Obj  A,
FLA_Obj  B,
fla_swap_t cntl 
)

References FLA_Cont_with_1x3_to_1x2(), FLA_Cont_with_3x1_to_2x1(), FLA_Determine_blocksize(), FLA_Obj_width(), FLA_Part_1x2(), FLA_Part_2x1(), FLA_Repart_1x2_to_1x3(), FLA_Repart_2x1_to_3x1(), and FLA_Swapt_external().

Referenced by FLA_Transpose_blk_var1().

00036 {
00037   FLA_Obj AL,    AR,       A0,  A1,  A2;
00038 
00039   FLA_Obj BT,              B0,
00040           BB,              B1,
00041                            B2;
00042 
00043   dim_t b;
00044 
00045   FLA_Part_1x2( A,    &AL,  &AR,      0, FLA_LEFT );
00046 
00047   FLA_Part_2x1( B,    &BT, 
00048                       &BB,            0, FLA_TOP );
00049 
00050   while ( FLA_Obj_width( AL ) < FLA_Obj_width( A ) ){
00051 
00052     b = FLA_Determine_blocksize( AR, FLA_RIGHT, FLA_Cntl_blocksize( cntl ) );
00053 
00054     FLA_Repart_1x2_to_1x3( AL,  /**/ AR,        &A0, /**/ &A1, &A2,
00055                            b, FLA_RIGHT );
00056 
00057     FLA_Repart_2x1_to_3x1( BT,                &B0, 
00058                         /* ** */            /* ** */
00059                                               &B1, 
00060                            BB,                &B2,        b, FLA_BOTTOM );
00061 
00062     /*------------------------------------------------------------*/
00063 
00064     FLA_Swapt_external( FLA_TRANSPOSE, A1, B1 );
00065 
00066     /*------------------------------------------------------------*/
00067 
00068     FLA_Cont_with_1x3_to_1x2( &AL,  /**/ &AR,        A0, A1, /**/ A2,
00069                               FLA_LEFT );
00070 
00071     FLA_Cont_with_3x1_to_2x1( &BT,                B0, 
00072                                                   B1, 
00073                             /* ** */           /* ** */
00074                               &BB,                B2,     FLA_TOP );
00075 
00076   }
00077 
00078   return FLA_SUCCESS;
00079 }

FLA_Error FLA_Swap_t_blk_var2 ( FLA_Obj  A,
FLA_Obj  B,
fla_swap_t cntl 
)

References FLA_Cont_with_1x3_to_1x2(), FLA_Cont_with_3x1_to_2x1(), FLA_Determine_blocksize(), FLA_Obj_length(), FLA_Part_1x2(), FLA_Part_2x1(), FLA_Repart_1x2_to_1x3(), FLA_Repart_2x1_to_3x1(), and FLA_Swapt_external().

Referenced by FLA_Transpose_blk_var2().

00036 {
00037   FLA_Obj AT,              A0,
00038           AB,              A1,
00039                            A2;
00040 
00041   FLA_Obj BL,    BR,       B0,  B1,  B2;
00042 
00043   dim_t b;
00044 
00045   FLA_Part_2x1( A,    &AT, 
00046                       &AB,            0, FLA_TOP );
00047 
00048   FLA_Part_1x2( B,    &BL,  &BR,      0, FLA_LEFT );
00049 
00050   while ( FLA_Obj_length( AT ) < FLA_Obj_length( A ) ){
00051 
00052     b = FLA_Determine_blocksize( AB, FLA_BOTTOM, FLA_Cntl_blocksize( cntl ) );
00053 
00054     FLA_Repart_2x1_to_3x1( AT,                &A0, 
00055                         /* ** */            /* ** */
00056                                               &A1, 
00057                            AB,                &A2,        b, FLA_BOTTOM );
00058 
00059     FLA_Repart_1x2_to_1x3( BL,  /**/ BR,        &B0, /**/ &B1, &B2,
00060                            b, FLA_RIGHT );
00061 
00062     /*------------------------------------------------------------*/
00063 
00064     FLA_Swapt_external( FLA_TRANSPOSE, A1, B1 );
00065 
00066     /*------------------------------------------------------------*/
00067 
00068     FLA_Cont_with_3x1_to_2x1( &AT,                A0, 
00069                                                   A1, 
00070                             /* ** */           /* ** */
00071                               &AB,                A2,     FLA_TOP );
00072 
00073     FLA_Cont_with_1x3_to_1x2( &BL,  /**/ &BR,        B0, B1, /**/ B2,
00074                               FLA_LEFT );
00075 
00076   }
00077 
00078   return FLA_SUCCESS;
00079 }

FLA_Error FLA_Symmetrize ( FLA_Uplo  uplo,
FLA_Obj  A 
)

References cblas_ccopy(), cblas_dcopy(), cblas_scopy(), cblas_zcopy(), ccopy(), dcopy(), FLA_Check_error_level(), FLA_Obj_datatype(), FLA_Obj_ldim(), FLA_Obj_width(), FLA_Symmetrize_check(), scopy(), and zcopy().

Referenced by FLA_Hermitianize(), FLA_Random_spd_matrix(), and fla_symmetrize_f().

00036 {
00037   FLA_Datatype datatype;
00038   int          j;
00039   int          n_A, ldim_A;
00040   int          ldim_src, inc_src;
00041   int          ldim_dst, inc_dst;
00042 
00043   if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
00044     FLA_Symmetrize_check( uplo, A );
00045 
00046   datatype = FLA_Obj_datatype( A );
00047 
00048   n_A      = FLA_Obj_width( A );
00049   ldim_A   = FLA_Obj_ldim( A );
00050 
00051   if ( uplo == FLA_LOWER_TRIANGULAR )
00052   {
00053     ldim_src = 1;
00054     ldim_dst = ldim_A;
00055     inc_src  = ldim_A;
00056     inc_dst  = 1;
00057   }
00058   else
00059   {
00060     ldim_src = ldim_A;
00061     ldim_dst = 1;
00062     inc_src  = 1;
00063     inc_dst  = ldim_A;
00064   }
00065 
00066   switch ( datatype ){
00067 
00068   case FLA_FLOAT:
00069   {
00070     float *buff_A = ( float * ) FLA_FLOAT_PTR( A );
00071 
00072     for ( j = 1; j < n_A; j++ )
00073     {
00074 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00075       cblas_scopy( j,
00076                    buff_A + j*ldim_src, inc_src,
00077                    buff_A + j*ldim_dst, inc_dst );
00078 #else
00079       FLA_C2F( scopy )( &j,
00080                         buff_A + j*ldim_src, &inc_src,
00081                         buff_A + j*ldim_dst, &inc_dst );
00082 #endif
00083     }
00084 
00085     break;
00086   }
00087 
00088   case FLA_DOUBLE:
00089   {
00090     double *buff_A = ( double * ) FLA_DOUBLE_PTR( A );
00091 
00092     for ( j = 1; j < n_A; j++ )
00093     {
00094 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00095       cblas_dcopy( j,
00096                    buff_A + j*ldim_src, inc_src,
00097                    buff_A + j*ldim_dst, inc_dst );
00098 #else
00099       FLA_C2F( dcopy )( &j,
00100                         buff_A + j*ldim_src, &inc_src,
00101                         buff_A + j*ldim_dst, &inc_dst );
00102 #endif
00103     }
00104 
00105     break;
00106   }
00107 
00108   case FLA_COMPLEX:
00109   {
00110     scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
00111 
00112     for ( j = 1; j < n_A; j++ )
00113     {
00114 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00115       cblas_ccopy( j,
00116                    buff_A + j*ldim_src, inc_src,
00117                    buff_A + j*ldim_dst, inc_dst );
00118 #else
00119       FLA_C2F( ccopy )( &j,
00120                         buff_A + j*ldim_src, &inc_src,
00121                         buff_A + j*ldim_dst, &inc_dst );
00122 #endif
00123     }
00124 
00125     break;
00126   }
00127 
00128   case FLA_DOUBLE_COMPLEX:
00129   {
00130     dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00131 
00132     for ( j = 1; j < n_A; j++ )
00133     {
00134 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00135       cblas_zcopy( j,
00136                    buff_A + j*ldim_src, inc_src,
00137                    buff_A + j*ldim_dst, inc_dst );
00138 #else
00139       FLA_C2F( zcopy )( &j,
00140                         buff_A + j*ldim_src, &inc_src,
00141                         buff_A + j*ldim_dst, &inc_dst );
00142 #endif
00143     }
00144 
00145     break;
00146   }
00147 
00148   }
00149 
00150   return FLA_SUCCESS;
00151 }

FLA_Error FLA_Symmetrize_check ( FLA_Uplo  uplo,
FLA_Obj  A 
)

References FLA_Check_floating_object(), FLA_Check_nonconstant_object(), FLA_Check_square(), and FLA_Check_valid_uplo().

Referenced by FLA_Symmetrize().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_uplo( uplo );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_floating_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_nonconstant_object( A );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_square( A );
00049   FLA_Check_error_code( e_val );
00050 
00051   return FLA_SUCCESS;
00052 }

void FLA_F2C() fla_symmetrize_f ( F_INT *  uplo,
F_INT *  A,
F_INT *  IERROR 
)

References FLA_Symmetrize().

00155 {
00156   *IERROR = FLA_Symmetrize( *( ( FLA_Uplo * ) uplo ),
00157                             *( ( FLA_Obj  * ) A    ) );
00158 }

FLA_Error FLA_Transpose ( FLA_Obj  A  ) 

References FLA_Check_error_level(), FLA_Transpose_blk_var2(), and FLA_Transpose_check().

Referenced by fla_transpose_f().

00038 {
00039   FLA_Error r_val;
00040 
00041   if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
00042     FLA_Transpose_check( A );
00043 
00044   r_val = FLA_Transpose_blk_var2( A, fla_tpose_cntl );
00045 
00046   return r_val;
00047 }

FLA_Error FLA_Transpose_blk_var1 ( FLA_Obj  A,
fla_tpose_t cntl 
)

References FLA_Cont_with_3x3_to_2x2(), FLA_Determine_blocksize(), FLA_Obj_length(), FLA_Part_2x2(), FLA_Repart_2x2_to_3x3(), FLA_Swap_t_blk_var1(), and FLA_Transpose_unb_var1().

00036 {
00037   FLA_Obj ATL,   ATR,      A00, A01, A02, 
00038           ABL,   ABR,      A10, A11, A12,
00039                            A20, A21, A22;
00040 
00041   dim_t b;
00042 
00043   FLA_Part_2x2( A,    &ATL, &ATR,
00044                       &ABL, &ABR,     0, 0, FLA_TL );
00045 
00046   while ( FLA_Obj_length( ATL ) < FLA_Obj_length( A ) ){
00047 
00048     b = FLA_Determine_blocksize( ABR, FLA_BR, FLA_Cntl_blocksize( cntl ) );
00049 
00050     FLA_Repart_2x2_to_3x3( ATL, /**/ ATR,       &A00, /**/ &A01, &A02,
00051                         /* ************* */   /* ******************** */
00052                                                 &A10, /**/ &A11, &A12,
00053                            ABL, /**/ ABR,       &A20, /**/ &A21, &A22,
00054                            b, b, FLA_BR );
00055 
00056     /*------------------------------------------------------------*/
00057 
00058     FLA_Transpose_unb_var1( A11 );
00059 
00060     FLA_Swap_t_blk_var1( A10, A01,
00061                          FLA_Cntl_sub_swap( cntl ) );
00062 
00063     /*------------------------------------------------------------*/
00064 
00065     FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR,       A00, A01, /**/ A02,
00066                                                      A10, A11, /**/ A12,
00067                             /* ************** */  /* ****************** */
00068                               &ABL, /**/ &ABR,       A20, A21, /**/ A22,
00069                               FLA_TL );
00070 
00071   }
00072 
00073   return FLA_SUCCESS;
00074 }

FLA_Error FLA_Transpose_blk_var2 ( FLA_Obj  A,
fla_tpose_t cntl 
)

References FLA_Cont_with_3x3_to_2x2(), FLA_Determine_blocksize(), FLA_Obj_length(), FLA_Part_2x2(), FLA_Repart_2x2_to_3x3(), FLA_Swap_t_blk_var2(), and FLA_Transpose_unb_var2().

Referenced by FLA_Transpose().

00036 {
00037   FLA_Obj ATL,   ATR,      A00, A01, A02, 
00038           ABL,   ABR,      A10, A11, A12,
00039                            A20, A21, A22;
00040 
00041   dim_t b;
00042 
00043   FLA_Part_2x2( A,    &ATL, &ATR,
00044                       &ABL, &ABR,     0, 0, FLA_TL );
00045 
00046   while ( FLA_Obj_length( ATL ) < FLA_Obj_length( A ) ){
00047 
00048     b = FLA_Determine_blocksize( ABR, FLA_BR, FLA_Cntl_blocksize( cntl ) );
00049 
00050     FLA_Repart_2x2_to_3x3( ATL, /**/ ATR,       &A00, /**/ &A01, &A02,
00051                         /* ************* */   /* ******************** */
00052                                                 &A10, /**/ &A11, &A12,
00053                            ABL, /**/ ABR,       &A20, /**/ &A21, &A22,
00054                            b, b, FLA_BR );
00055 
00056     /*------------------------------------------------------------*/
00057 
00058     FLA_Transpose_unb_var2( A11 );
00059 
00060     FLA_Swap_t_blk_var2( A21, A12,
00061                          FLA_Cntl_sub_swap( cntl ) );
00062 
00063     /*------------------------------------------------------------*/
00064 
00065     FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR,       A00, A01, /**/ A02,
00066                                                      A10, A11, /**/ A12,
00067                             /* ************** */  /* ****************** */
00068                               &ABL, /**/ &ABR,       A20, A21, /**/ A22,
00069                               FLA_TL );
00070 
00071   }
00072 
00073   return FLA_SUCCESS;
00074 }

FLA_Error FLA_Transpose_check ( FLA_Obj  A  ) 

References FLA_Check_floating_object(), FLA_Check_nonconstant_object(), and FLA_Check_square().

Referenced by FLA_Transpose().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_floating_object( A );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_nonconstant_object( A );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_square( A );
00046   FLA_Check_error_code( e_val );
00047 
00048   return FLA_SUCCESS;
00049 }

void FLA_F2C() fla_transpose_f ( F_INT *  A,
F_INT *  IERROR 
)

References FLA_Transpose().

00051 {
00052   *IERROR = FLA_Transpose( *( ( FLA_Obj * ) A ) );
00053 }

FLA_Error FLA_Transpose_unb_var1 ( FLA_Obj  A  ) 

References FLA_Cont_with_3x3_to_2x2(), FLA_Obj_length(), FLA_Part_2x2(), FLA_Repart_2x2_to_3x3(), and FLA_Swapt_external().

Referenced by FLA_Transpose_blk_var1().

00036 {
00037   FLA_Obj ATL,   ATR,      A00,  a01,     A02, 
00038           ABL,   ABR,      a10t, alpha11, a12t,
00039                            A20,  a21,     A22;
00040 
00041   FLA_Part_2x2( A,    &ATL, &ATR,
00042                       &ABL, &ABR,     0, 0, FLA_TL );
00043 
00044   while ( FLA_Obj_length( ATL ) < FLA_Obj_length( A ) ){
00045 
00046     FLA_Repart_2x2_to_3x3( ATL, /**/ ATR,       &A00,  /**/ &a01,     &A02,
00047                         /* ************* */   /* ************************** */
00048                                                 &a10t, /**/ &alpha11, &a12t,
00049                            ABL, /**/ ABR,       &A20,  /**/ &a21,     &A22,
00050                            1, 1, FLA_BR );
00051 
00052     /*------------------------------------------------------------*/
00053 
00054     FLA_Swapt_external( FLA_TRANSPOSE, a10t, a01 );
00055 
00056     /*------------------------------------------------------------*/
00057 
00058     FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR,       A00,  a01,     /**/ A02,
00059                                                      a10t, alpha11, /**/ a12t,
00060                             /* ************** */  /* ************************ */
00061                               &ABL, /**/ &ABR,       A20,  a21,     /**/ A22,
00062                               FLA_TL );
00063 
00064   }
00065 
00066   return FLA_SUCCESS;
00067 }

FLA_Error FLA_Transpose_unb_var2 ( FLA_Obj  A  ) 

References FLA_Cont_with_3x3_to_2x2(), FLA_Obj_length(), FLA_Part_2x2(), FLA_Repart_2x2_to_3x3(), and FLA_Swapt_external().

Referenced by FLA_Transpose_blk_var2().

00036 {
00037   FLA_Obj ATL,   ATR,      A00,  a01,     A02, 
00038           ABL,   ABR,      a10t, alpha11, a12t,
00039                            A20,  a21,     A22;
00040 
00041   FLA_Part_2x2( A,    &ATL, &ATR,
00042                       &ABL, &ABR,     0, 0, FLA_TL );
00043 
00044   while ( FLA_Obj_length( ATL ) < FLA_Obj_length( A ) ){
00045 
00046     FLA_Repart_2x2_to_3x3( ATL, /**/ ATR,       &A00,  /**/ &a01,     &A02,
00047                         /* ************* */   /* ************************** */
00048                                                 &a10t, /**/ &alpha11, &a12t,
00049                            ABL, /**/ ABR,       &A20,  /**/ &a21,     &A22,
00050                            1, 1, FLA_BR );
00051 
00052     /*------------------------------------------------------------*/
00053 
00054     FLA_Swapt_external( FLA_TRANSPOSE, a21, a12t );
00055 
00056     /*------------------------------------------------------------*/
00057 
00058     FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR,       A00,  a01,     /**/ A02,
00059                                                      a10t, alpha11, /**/ a12t,
00060                             /* ************** */  /* ************************ */
00061                               &ABL, /**/ &ABR,       A20,  a21,     /**/ A22,
00062                               FLA_TL );
00063 
00064   }
00065 
00066   return FLA_SUCCESS;
00067 }

FLA_Error FLA_Triangularize ( FLA_Uplo  uplo,
FLA_Diag  diag,
FLA_Obj  A 
)

References FLA_Check_error_level(), FLA_Obj_datatype(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_width(), FLA_ONE, FLA_Triangularize_check(), and FLA_ZERO.

Referenced by FLA_SA_LU_unb(), fla_triangularize_f(), and FLASH_Triangularize().

00036 {
00037   FLA_Datatype datatype;
00038   int          i, j;
00039   int          m_A, n_A, ldim_A;
00040 
00041   if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
00042     FLA_Triangularize_check( uplo, diag, A );
00043 
00044   datatype = FLA_Obj_datatype( A );
00045 
00046   m_A      = FLA_Obj_length( A );
00047   n_A      = FLA_Obj_width( A );
00048   ldim_A   = FLA_Obj_ldim( A );
00049 
00050   switch ( datatype ){
00051 
00052   case FLA_FLOAT:
00053   {
00054     float *buff_A = ( float * ) FLA_FLOAT_PTR( A );
00055     float *buff_0 = ( float * ) FLA_FLOAT_PTR( FLA_ZERO );
00056     float *buff_1 = ( float * ) FLA_FLOAT_PTR( FLA_ONE );
00057 
00058     if ( uplo == FLA_LOWER_TRIANGULAR )
00059     {
00060       for ( j = 0; j < n_A; j++ )
00061       {
00062         for ( i = 0; i < j; i++ )
00063           buff_A[ j*ldim_A + i ] = *buff_0;
00064 
00065         if      ( diag == FLA_UNIT_DIAG )
00066           buff_A[ j*ldim_A + j ] = *buff_1;
00067         else if ( diag == FLA_ZERO_DIAG )
00068           buff_A[ j*ldim_A + j ] = *buff_0;
00069       } 
00070     }
00071     else if ( uplo == FLA_UPPER_TRIANGULAR ) 
00072     {
00073       for ( j = 0; j < n_A; j++ )
00074       {
00075         if      ( diag == FLA_UNIT_DIAG )
00076           buff_A[ j*ldim_A + j ] = *buff_1;
00077         else if ( diag == FLA_ZERO_DIAG )
00078           buff_A[ j*ldim_A + j ] = *buff_0;
00079 
00080         for ( i = j + 1; i < m_A; i++ )
00081           buff_A[ j*ldim_A + i ] = *buff_0;
00082       } 
00083     }
00084 
00085     break;
00086   }
00087 
00088   case FLA_DOUBLE:
00089   {
00090     double *buff_A = ( double * ) FLA_DOUBLE_PTR( A );
00091     double *buff_0 = ( double * ) FLA_DOUBLE_PTR( FLA_ZERO );
00092     double *buff_1 = ( double * ) FLA_DOUBLE_PTR( FLA_ONE );
00093 
00094     if ( uplo == FLA_LOWER_TRIANGULAR )
00095     {
00096       for ( j = 0; j < n_A; j++ )
00097       {
00098         for ( i = 0; i < j; i++ )
00099           buff_A[ j*ldim_A + i ] = *buff_0;
00100 
00101         if      ( diag == FLA_UNIT_DIAG )
00102           buff_A[ j*ldim_A + j ] = *buff_1;
00103         else if ( diag == FLA_ZERO_DIAG )
00104           buff_A[ j*ldim_A + j ] = *buff_0;
00105       } 
00106     }
00107     else if ( uplo == FLA_UPPER_TRIANGULAR ) 
00108     {
00109       for ( j = 0; j < n_A; j++ )
00110       {
00111         if      ( diag == FLA_UNIT_DIAG )
00112           buff_A[ j*ldim_A + j ] = *buff_1;
00113         else if ( diag == FLA_ZERO_DIAG )
00114           buff_A[ j*ldim_A + j ] = *buff_0;
00115 
00116         for ( i = j + 1; i < m_A; i++ )
00117           buff_A[ j*ldim_A + i ] = *buff_0;
00118       } 
00119     }
00120 
00121     break;
00122   }
00123 
00124   case FLA_COMPLEX:
00125   {
00126     scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
00127     scomplex *buff_0 = ( scomplex * ) FLA_COMPLEX_PTR( FLA_ZERO );
00128     scomplex *buff_1 = ( scomplex * ) FLA_COMPLEX_PTR( FLA_ONE );
00129 
00130     if ( uplo == FLA_LOWER_TRIANGULAR )
00131     {
00132       for ( j = 0; j < n_A; j++ )
00133       {
00134         for ( i = 0; i < j; i++ )
00135           buff_A[ j*ldim_A + i ] = *buff_0;
00136 
00137         if      ( diag == FLA_UNIT_DIAG )
00138           buff_A[ j*ldim_A + j ] = *buff_1;
00139         else if ( diag == FLA_ZERO_DIAG )
00140           buff_A[ j*ldim_A + j ] = *buff_0;
00141       } 
00142     }
00143     else if ( uplo == FLA_UPPER_TRIANGULAR ) 
00144     {
00145       for ( j = 0; j < n_A; j++ )
00146       {
00147         if      ( diag == FLA_UNIT_DIAG )
00148           buff_A[ j*ldim_A + j ] = *buff_1;
00149         else if ( diag == FLA_ZERO_DIAG )
00150           buff_A[ j*ldim_A + j ] = *buff_0;
00151 
00152         for ( i = j + 1; i < m_A; i++ )
00153           buff_A[ j*ldim_A + i ] = *buff_0;
00154       } 
00155     }
00156 
00157     break;
00158   }
00159 
00160   case FLA_DOUBLE_COMPLEX:
00161   {
00162     dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00163     dcomplex *buff_0 = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( FLA_ZERO );
00164     dcomplex *buff_1 = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( FLA_ONE );
00165 
00166     if ( uplo == FLA_LOWER_TRIANGULAR )
00167     {
00168       for ( j = 0; j < n_A; j++ )
00169       {
00170         for ( i = 0; i < j; i++ )
00171           buff_A[ j*ldim_A + i ] = *buff_0;
00172 
00173         if      ( diag == FLA_UNIT_DIAG )
00174           buff_A[ j*ldim_A + j ] = *buff_1;
00175         else if ( diag == FLA_ZERO_DIAG )
00176           buff_A[ j*ldim_A + j ] = *buff_0;
00177       } 
00178     }
00179     else if ( uplo == FLA_UPPER_TRIANGULAR ) 
00180     {
00181       for ( j = 0; j < n_A; j++ )
00182       {
00183         if      ( diag == FLA_UNIT_DIAG )
00184           buff_A[ j*ldim_A + j ] = *buff_1;
00185         else if ( diag == FLA_ZERO_DIAG )
00186           buff_A[ j*ldim_A + j ] = *buff_0;
00187 
00188         for ( i = j + 1; i < m_A; i++ )
00189           buff_A[ j*ldim_A + i ] = *buff_0;
00190       } 
00191     }
00192 
00193     break;
00194   }
00195 
00196   }
00197 
00198   return FLA_SUCCESS;
00199 }

FLA_Error FLA_Triangularize_check ( FLA_Uplo  uplo,
FLA_Diag  diag,
FLA_Obj  A 
)

References FLA_Check_floating_object(), FLA_Check_nonconstant_object(), FLA_Check_square(), FLA_Check_valid_diag(), and FLA_Check_valid_uplo().

Referenced by FLA_Triangularize().

00036 {
00037   FLA_Error e_val;
00038 
00039   e_val = FLA_Check_valid_uplo( uplo );
00040   FLA_Check_error_code( e_val );
00041 
00042   e_val = FLA_Check_valid_diag( diag );
00043   FLA_Check_error_code( e_val );
00044 
00045   e_val = FLA_Check_floating_object( A );
00046   FLA_Check_error_code( e_val );
00047 
00048   e_val = FLA_Check_nonconstant_object( A );
00049   FLA_Check_error_code( e_val );
00050 
00051   e_val = FLA_Check_square( A );
00052   FLA_Check_error_code( e_val );
00053 
00054   return FLA_SUCCESS;
00055 }

void FLA_F2C() fla_triangularize_f ( F_INT *  uplo,
F_INT *  diag,
F_INT *  A,
F_INT *  IERROR 
)

References FLA_Triangularize().

00203 {
00204   *IERROR = FLA_Triangularize( *( ( FLA_Uplo * ) uplo ),
00205                                *( ( FLA_Diag * ) diag ),
00206                                *( ( FLA_Obj  * ) A    ) );
00207 }


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