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) |
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 }