FLA_Copyr_external.c File Reference

(r)


Functions

FLA_Error FLA_Copyr_external (FLA_Uplo uplo, FLA_Obj A, FLA_Obj B)
void FLA_F2C() fla_copyr_external_f (F_INT *uplo, F_INT *A, F_INT *B, F_INT *IERROR)

Function Documentation

FLA_Error FLA_Copyr_external ( FLA_Uplo  uplo,
FLA_Obj  A,
FLA_Obj  B 
)

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

Referenced by FLA_Copyr(), fla_copyr_external_f(), and FLA_QR_UT_copy_task().

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   int          m_B,      inc_B, ldim_B;
00042 
00043   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00044     FLA_Copyr_check( uplo, A, B );
00045 
00046   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00047 
00048   datatype = FLA_Obj_datatype( A );
00049 
00050   m_A      = FLA_Obj_length( A );
00051   n_A      = FLA_Obj_width( A );
00052   ldim_A   = FLA_Obj_ldim( A );
00053 
00054   m_B      = FLA_Obj_length( B );
00055   ldim_B   = FLA_Obj_ldim( B );
00056 
00057   inc_A    = 1;
00058   inc_B    = 1;
00059   n_iter   = n_A;
00060 
00061 
00062   switch ( datatype ){
00063 
00064   case FLA_INT:
00065   case FLA_FLOAT:
00066   {
00067     float *buff_A = ( float * ) FLA_FLOAT_PTR( A );
00068     float *buff_B = ( float * ) FLA_FLOAT_PTR( B );
00069 
00070     if ( uplo == FLA_LOWER_TRIANGULAR )
00071     {
00072       for ( j = 0; j < n_A; ++j )
00073       {
00074         num_elem = n_A - j;
00075 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00076         cblas_scopy( num_elem,
00077                      buff_A + j*ldim_A + j, inc_A, 
00078                      buff_B + j*ldim_B + j, inc_B );
00079 #else
00080         FLA_C2F( scopy )( &num_elem,
00081                           buff_A + j*ldim_A + j, &inc_A, 
00082                           buff_B + j*ldim_B + j, &inc_B );
00083 #endif
00084       }
00085     }
00086     else
00087     {
00088       for ( j = 0; j < n_A; ++j )
00089       {
00090         num_elem = j + 1;
00091 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00092         cblas_scopy( num_elem,
00093                      buff_A + j*ldim_A, inc_A, 
00094                      buff_B + j*ldim_B, inc_B );
00095 #else
00096         FLA_C2F( scopy )( &num_elem,
00097                           buff_A + j*ldim_A, &inc_A, 
00098                           buff_B + j*ldim_B, &inc_B );
00099 #endif
00100       }
00101     }
00102 
00103     break;
00104   }
00105 
00106   case FLA_DOUBLE:
00107   {
00108     double *buff_A = ( double * ) FLA_DOUBLE_PTR( A );
00109     double *buff_B = ( double * ) FLA_DOUBLE_PTR( B );
00110 
00111     if ( uplo == FLA_LOWER_TRIANGULAR )
00112     {
00113       for ( j = 0; j < n_A; ++j )
00114       {
00115         num_elem = n_A - j;
00116 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00117         cblas_dcopy( num_elem,
00118                      buff_A + j*ldim_A + j, inc_A, 
00119                      buff_B + j*ldim_B + j, inc_B );
00120 #else
00121         FLA_C2F( dcopy )( &num_elem,
00122                           buff_A + j*ldim_A + j, &inc_A, 
00123                           buff_B + j*ldim_B + j, &inc_B );
00124 #endif
00125       }
00126     }
00127     else
00128     {
00129       for ( j = 0; j < n_A; ++j )
00130       {
00131         num_elem = j + 1;
00132 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00133         cblas_dcopy( num_elem,
00134                      buff_A + j*ldim_A, inc_A, 
00135                      buff_B + j*ldim_B, inc_B );
00136 #else
00137         FLA_C2F( dcopy )( &num_elem,
00138                           buff_A + j*ldim_A, &inc_A, 
00139                           buff_B + j*ldim_B, &inc_B );
00140 #endif
00141       }
00142     }
00143 
00144     break;
00145   }
00146 
00147   case FLA_COMPLEX:
00148   {
00149     scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
00150     scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B );
00151 
00152     if ( uplo == FLA_LOWER_TRIANGULAR )
00153     {
00154       for ( j = 0; j < n_A; ++j )
00155       {
00156         num_elem = n_A - j;
00157 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00158         cblas_ccopy( num_elem,
00159                      buff_A + j*ldim_A + j, inc_A, 
00160                      buff_B + j*ldim_B + j, inc_B );
00161 #else
00162         FLA_C2F( ccopy )( &num_elem,
00163                           buff_A + j*ldim_A + j, &inc_A, 
00164                           buff_B + j*ldim_B + j, &inc_B );
00165 #endif
00166       }
00167     }
00168     else
00169     {
00170       for ( j = 0; j < n_A; ++j )
00171       {
00172         num_elem = j + 1;
00173 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00174         cblas_ccopy( num_elem,
00175                      buff_A + j*ldim_A, inc_A, 
00176                      buff_B + j*ldim_B, inc_B );
00177 #else
00178         FLA_C2F( ccopy )( &num_elem,
00179                           buff_A + j*ldim_A, &inc_A, 
00180                           buff_B + j*ldim_B, &inc_B );
00181 #endif
00182       }
00183     }
00184 
00185     break;
00186   }
00187 
00188   case FLA_DOUBLE_COMPLEX:
00189   {
00190     dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00191     dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B );
00192 
00193     if ( uplo == FLA_LOWER_TRIANGULAR )
00194     {
00195       for ( j = 0; j < n_A; ++j )
00196       {
00197         num_elem = n_A - j;
00198 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00199         cblas_zcopy( num_elem,
00200                      buff_A + j*ldim_A + j, inc_A, 
00201                      buff_B + j*ldim_B + j, inc_B );
00202 #else
00203         FLA_C2F( zcopy )( &num_elem,
00204                           buff_A + j*ldim_A + j, &inc_A, 
00205                           buff_B + j*ldim_B + j, &inc_B );
00206 #endif
00207       }
00208     }
00209     else
00210     {
00211       for ( j = 0; j < n_A; ++j )
00212       {
00213         num_elem = j + 1;
00214 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00215         cblas_zcopy( num_elem,
00216                      buff_A + j*ldim_A, inc_A, 
00217                      buff_B + j*ldim_B, inc_B );
00218 #else
00219         FLA_C2F( zcopy )( &num_elem,
00220                           buff_A + j*ldim_A, &inc_A, 
00221                           buff_B + j*ldim_B, &inc_B );
00222 #endif
00223       }
00224     }
00225 
00226     break;
00227   }
00228 
00229   }
00230   
00231   return FLA_SUCCESS;
00232 }

void FLA_F2C() fla_copyr_external_f ( F_INT *  uplo,
F_INT *  A,
F_INT *  B,
F_INT *  IERROR 
)

References FLA_Copyr_external().

00236 {
00237   *IERROR = FLA_Copyr_external( *( ( FLA_Uplo * ) uplo ),
00238                                 *( ( FLA_Obj  * ) A    ),
00239                                 *( ( FLA_Obj  * ) B    ) );
00240 }


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