Functions | |
FLA_Error | FLA_Apply_Q_blk_external (FLA_Side side, FLA_Trans trans, FLA_Store storev, FLA_Obj A, FLA_Obj t, FLA_Obj B) |
void FLA_F2C() | fla_apply_q_blk_external_f (F_INT *side, F_INT *trans, F_INT *storev, F_INT *A, F_INT *t, F_INT *B, F_INT *IERROR) |
FLA_Error FLA_Apply_Q_blk_external | ( | FLA_Side | side, | |
FLA_Trans | trans, | |||
FLA_Store | storev, | |||
FLA_Obj | A, | |||
FLA_Obj | t, | |||
FLA_Obj | B | |||
) |
References cunmlq(), cunmqr(), dormlq(), dormqr(), FLA_Apply_Q_check(), FLA_Check_error_level(), FLA_Obj_create(), FLA_Obj_datatype(), FLA_Obj_free(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Obj_width(), FLA_Param_map_to_blas_side(), FLA_Param_map_to_blas_trans(), FLA_Query_blocksize(), sormlq(), sormqr(), zunmlq(), and zunmqr().
Referenced by fla_apply_q_blk_external_f().
00036 { 00037 FLA_Datatype datatype; 00038 int m_A, n_A, ldim_A; 00039 int m_B, n_B, ldim_B; 00040 int k_t; 00041 int lwork, info; 00042 char blas_side; 00043 char blas_trans; 00044 FLA_Obj work_obj; 00045 00046 if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 00047 FLA_Apply_Q_check( side, trans, storev, A, t, B ); 00048 00049 if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS; 00050 00051 datatype = FLA_Obj_datatype( A ); 00052 00053 m_A = FLA_Obj_length( A ); 00054 n_A = FLA_Obj_width( A ); 00055 ldim_A = FLA_Obj_ldim( A ); 00056 00057 m_B = FLA_Obj_length( B ); 00058 n_B = FLA_Obj_width( B ); 00059 ldim_B = FLA_Obj_ldim( B ); 00060 00061 k_t = FLA_Obj_vector_dim( t ); 00062 00063 FLA_Param_map_to_blas_side( side, &blas_side ); 00064 FLA_Param_map_to_blas_trans( trans, &blas_trans ); 00065 00066 if ( side == FLA_LEFT ) 00067 lwork = n_A * FLA_Query_blocksize( datatype, FLA_DIMENSION_MIN ); 00068 else 00069 lwork = m_A * FLA_Query_blocksize( datatype, FLA_DIMENSION_MIN ); 00070 00071 FLA_Obj_create( datatype, lwork, 1, &work_obj ); 00072 00073 00074 switch( datatype ){ 00075 00076 case FLA_FLOAT: 00077 { 00078 float *buff_A = ( float * ) FLA_FLOAT_PTR( A ); 00079 float *buff_t = ( float * ) FLA_FLOAT_PTR( t ); 00080 float *buff_B = ( float * ) FLA_FLOAT_PTR( B ); 00081 float *buff_work = ( float * ) FLA_FLOAT_PTR( work_obj ); 00082 00083 if ( storev == FLA_COLUMNWISE ) 00084 FLA_C2F( sormqr )( &blas_side, 00085 &blas_trans, 00086 &m_B, 00087 &n_B, 00088 &k_t, 00089 buff_A, &ldim_A, 00090 buff_t, 00091 buff_B, &ldim_B, 00092 buff_work, &lwork, 00093 &info ); 00094 else // storev == FLA_ROWWISE 00095 FLA_C2F( sormlq )( &blas_side, 00096 &blas_trans, 00097 &m_B, 00098 &n_B, 00099 &k_t, 00100 buff_A, &ldim_A, 00101 buff_t, 00102 buff_B, &ldim_B, 00103 buff_work, &lwork, 00104 &info ); 00105 00106 break; 00107 } 00108 00109 case FLA_DOUBLE: 00110 { 00111 double *buff_A = ( double * ) FLA_DOUBLE_PTR( A ); 00112 double *buff_t = ( double * ) FLA_DOUBLE_PTR( t ); 00113 double *buff_B = ( double * ) FLA_DOUBLE_PTR( B ); 00114 double *buff_work = ( double * ) FLA_DOUBLE_PTR( work_obj ); 00115 00116 if ( storev == FLA_COLUMNWISE ) 00117 FLA_C2F( dormqr )( &blas_side, 00118 &blas_trans, 00119 &m_B, 00120 &n_B, 00121 &k_t, 00122 buff_A, &ldim_A, 00123 buff_t, 00124 buff_B, &ldim_B, 00125 buff_work, &lwork, 00126 &info ); 00127 else // storev == FLA_ROWWISE 00128 FLA_C2F( dormlq )( &blas_side, 00129 &blas_trans, 00130 &m_B, 00131 &n_B, 00132 &k_t, 00133 buff_A, &ldim_A, 00134 buff_t, 00135 buff_B, &ldim_B, 00136 buff_work, &lwork, 00137 &info ); 00138 00139 break; 00140 } 00141 00142 case FLA_COMPLEX: 00143 { 00144 scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); 00145 scomplex *buff_t = ( scomplex * ) FLA_COMPLEX_PTR( t ); 00146 scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B ); 00147 scomplex *buff_work = ( scomplex * ) FLA_COMPLEX_PTR( work_obj ); 00148 00149 if ( storev == FLA_COLUMNWISE ) 00150 FLA_C2F( cunmqr )( &blas_side, 00151 &blas_trans, 00152 &m_B, 00153 &n_B, 00154 &k_t, 00155 buff_A, &ldim_A, 00156 buff_t, 00157 buff_B, &ldim_B, 00158 buff_work, &lwork, 00159 &info ); 00160 else // storev == FLA_ROWWISE 00161 FLA_C2F( cunmlq )( &blas_side, 00162 &blas_trans, 00163 &m_B, 00164 &n_B, 00165 &k_t, 00166 buff_A, &ldim_A, 00167 buff_t, 00168 buff_B, &ldim_B, 00169 buff_work, &lwork, 00170 &info ); 00171 00172 break; 00173 } 00174 00175 case FLA_DOUBLE_COMPLEX: 00176 { 00177 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); 00178 dcomplex *buff_t = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( t ); 00179 dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B ); 00180 dcomplex *buff_work = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( work_obj ); 00181 00182 if ( storev == FLA_COLUMNWISE ) 00183 FLA_C2F( zunmqr )( &blas_side, 00184 &blas_trans, 00185 &m_B, 00186 &n_B, 00187 &k_t, 00188 buff_A, &ldim_A, 00189 buff_t, 00190 buff_B, &ldim_B, 00191 buff_work, &lwork, 00192 &info ); 00193 else // storev == FLA_ROWWISE 00194 FLA_C2F( zunmlq )( &blas_side, 00195 &blas_trans, 00196 &m_B, 00197 &n_B, 00198 &k_t, 00199 buff_A, &ldim_A, 00200 buff_t, 00201 buff_B, &ldim_B, 00202 buff_work, &lwork, 00203 &info ); 00204 00205 break; 00206 } 00207 00208 } 00209 00210 FLA_Obj_free( &work_obj ); 00211 00212 return info; 00213 }
void FLA_F2C() fla_apply_q_blk_external_f | ( | F_INT * | side, | |
F_INT * | trans, | |||
F_INT * | storev, | |||
F_INT * | A, | |||
F_INT * | t, | |||
F_INT * | B, | |||
F_INT * | IERROR | |||
) |
References FLA_Apply_Q_blk_external().
00217 { 00218 *IERROR = FLA_Apply_Q_blk_external( *( ( FLA_Side * ) side ), 00219 *( ( FLA_Trans * ) trans ), 00220 *( ( FLA_Store * ) storev ), 00221 *( ( FLA_Obj * ) A ), 00222 *( ( FLA_Obj * ) t ), 00223 *( ( FLA_Obj * ) B ) ); 00224 }