FLA_Apply_Q_blk_external.c File Reference

(r)


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)

Function Documentation

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 }


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