Functions | |
FLA_Error | FLA_Copy_external (FLA_Obj A, FLA_Obj B) |
void FLA_F2C() | fla_copy_external_f (F_INT *A, F_INT *B, F_INT *IERROR) |
References cblas_ccopy(), cblas_dcopy(), cblas_scopy(), cblas_zcopy(), ccopy(), dcopy(), FLA_Check_error_level(), FLA_Copy_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_is_vector(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Obj_width(), scopy(), and zcopy().
Referenced by FLA_Accum_T_UT_fc_unb_var1(), FLA_Apply_househ2_UT(), FLA_Axpys_external(), FLA_Copy(), fla_copy_external_f(), FLA_Copy_internal(), FLA_Copy_task(), FLA_LQ_UT_Accum_T_blk_var1(), FLA_LQ_UT_blk_var2(), FLA_LQ_UT_recover_tau_submatrix(), FLA_LU_piv_copy_task(), FLA_QR_UT_Accum_T_blk_var1(), FLA_QR_UT_blk_var2(), FLA_QR_UT_recover_tau_submatrix(), FLA_SA_LU_unb(), FLA_Trmmsx_external(), FLA_Trmvsx_external(), FLA_Trsmsx_external(), FLA_Trsvsx_external(), FLASH_Copy_hierarchy_r(), and FLASH_Obj_exec_parallel().
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_Copy_check( A, B ); 00045 00046 if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS; 00047 00048 // It is important that we get the datatype of B and not A, since A could 00049 // be an FLA_CONSTANT. 00050 datatype = FLA_Obj_datatype( B ); 00051 00052 m_A = FLA_Obj_length( A ); 00053 n_A = FLA_Obj_width( A ); 00054 ldim_A = FLA_Obj_ldim( A ); 00055 00056 m_B = FLA_Obj_length( B ); 00057 ldim_B = FLA_Obj_ldim( B ); 00058 00059 if ( FLA_Obj_is_vector( A ) ) 00060 { 00061 inc_A = ( m_A == 1 ? ldim_A : 1 ); 00062 inc_B = ( m_B == 1 ? ldim_B : 1 ); 00063 n_iter = 1; 00064 num_elem = FLA_Obj_vector_dim( A ); 00065 } 00066 else 00067 { 00068 inc_A = 1; 00069 inc_B = 1; 00070 n_iter = n_A; 00071 num_elem = m_A; 00072 } 00073 00074 switch ( datatype ){ 00075 00076 case FLA_INT: 00077 case FLA_FLOAT: 00078 { 00079 float *buff_A = ( float * ) FLA_FLOAT_PTR( A ); 00080 float *buff_B = ( float * ) FLA_FLOAT_PTR( B ); 00081 00082 for ( j = 0; j < n_iter; ++j ) 00083 { 00084 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00085 cblas_scopy( num_elem, 00086 buff_A + j*ldim_A, inc_A, 00087 buff_B + j*ldim_B, inc_B ); 00088 #else 00089 FLA_C2F( scopy )( &num_elem, 00090 buff_A + j*ldim_A, &inc_A, 00091 buff_B + j*ldim_B, &inc_B ); 00092 #endif 00093 } 00094 00095 break; 00096 } 00097 00098 case FLA_DOUBLE: 00099 { 00100 double *buff_A = ( double * ) FLA_DOUBLE_PTR( A ); 00101 double *buff_B = ( double * ) FLA_DOUBLE_PTR( B ); 00102 00103 for ( j = 0; j < n_iter; ++j ) 00104 { 00105 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00106 cblas_dcopy( num_elem, 00107 buff_A + j*ldim_A, inc_A, 00108 buff_B + j*ldim_B, inc_B ); 00109 #else 00110 FLA_C2F( dcopy )( &num_elem, 00111 buff_A + j*ldim_A, &inc_A, 00112 buff_B + j*ldim_B, &inc_B ); 00113 #endif 00114 } 00115 00116 break; 00117 } 00118 00119 case FLA_COMPLEX: 00120 { 00121 scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); 00122 scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B ); 00123 00124 for ( j = 0; j < n_iter; ++j ) 00125 { 00126 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00127 cblas_ccopy( num_elem, 00128 buff_A + j*ldim_A, inc_A, 00129 buff_B + j*ldim_B, inc_B ); 00130 #else 00131 FLA_C2F( ccopy )( &num_elem, 00132 buff_A + j*ldim_A, &inc_A, 00133 buff_B + j*ldim_B, &inc_B ); 00134 #endif 00135 } 00136 00137 break; 00138 } 00139 00140 case FLA_DOUBLE_COMPLEX: 00141 { 00142 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); 00143 dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B ); 00144 00145 for ( j = 0; j < n_iter; ++j ) 00146 { 00147 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00148 cblas_zcopy( num_elem, 00149 buff_A + j*ldim_A, inc_A, 00150 buff_B + j*ldim_B, inc_B ); 00151 #else 00152 FLA_C2F( zcopy )( &num_elem, 00153 buff_A + j*ldim_A, &inc_A, 00154 buff_B + j*ldim_B, &inc_B ); 00155 #endif 00156 } 00157 00158 break; 00159 } 00160 00161 } 00162 00163 return FLA_SUCCESS; 00164 }
void FLA_F2C() fla_copy_external_f | ( | F_INT * | A, | |
F_INT * | B, | |||
F_INT * | IERROR | |||
) |
References FLA_Copy_external().
00168 { 00169 *IERROR = FLA_Copy_external( *( ( FLA_Obj * ) A ), 00170 *( ( FLA_Obj * ) B ) ); 00171 }