static int pmatmult(void *MM, double x[], double y[], int n){
plapackM* ctx=(plapackM*)MM;
double d_one=1.0,drank=1.0/ctx->nprocs;
int i,info;
DSDPFunctionBegin;
info=PLA_Obj_set_to_zero(ctx->vVec);DSDPCHKERR(info);
info=PLA_Obj_set_to_zero(ctx->wVec);DSDPCHKERR(info);
info=PLA_API_begin();DSDPCHKERR(info);
info=PLA_Obj_API_open(ctx->vVec);DSDPCHKERR(info);
info=PLA_API_axpy_vector_to_global(n, &d_one, x, 1,
ctx->vVec, 0); DSDPCHKERR(info);
/* Copy solution from PLAPACK vector to DSDPVector */
info=PLA_Obj_API_close(ctx->vVec); DSDPCHKERR(info);
info=PLA_API_end(); DSDPCHKERR(info);
PLA_Symv( PLA_LOWER_TRIANGULAR, ctx->one, ctx->AMat, ctx->vVec, ctx->zero, ctx->wVec );
/* Copy solution from PLAPACK vector to DSDPVector */
memset((void*)y,0,n*sizeof(double));
info=PLA_API_begin();
info=PLA_Obj_API_open(ctx->wVec);
info=PLA_API_axpy_global_to_vector(n, &d_one, ctx->wVec, 0,
y, 1); DSDPCHKERR(info);
info=PLA_Obj_API_close(ctx->wVec); DSDPCHKERR(info);
info=PLA_API_end(); DSDPCHKERR(info);
for (i=0;i<n;i++){ y[i]*=drank;} /* Should be in PLA_API_axpy_vector_to_global */
DSDPFunctionReturn(0);
}
int PLA_Local_dot( PLA_Obj x, PLA_Obj y, PLA_Obj alpha )
{
int
local_length_x, local_width_x,
local_length_y, local_width_y,
ldim_x, ldim_y,
istride_x, istride_y;
char
*buf_x, *buf_y, *buf_alpha;
MPI_Datatype
datatype;
PLA_Obj_set_to_zero( alpha );
PLA_Obj_local_length( x, &local_length_x);
PLA_Obj_local_width ( x, &local_width_x);
PLA_Obj_local_ldim ( x, &ldim_x );
PLA_Obj_local_length( y, &local_length_y);
PLA_Obj_local_width ( y, &local_width_y);
PLA_Obj_local_ldim ( y, &ldim_y );
if ( local_length_x * local_width_x != 0 ){
if ( local_length_x == 1 ){
istride_x = ldim_x;
local_length_x = local_width_x;
}
else
istride_x = 1;
if ( local_length_y == 1 ){
istride_y = ldim_y;
local_length_y = local_width_y;
}
else
istride_y = 1;
PLA_Obj_datatype( x, &datatype );
PLA_Obj_local_buffer(x, ( void ** ) &buf_x);
PLA_Obj_local_buffer(y, ( void ** ) &buf_y);
PLA_Obj_local_buffer(alpha, ( void ** ) &buf_alpha);
if ( datatype == MPI_DOUBLE ){
*( ( double * ) buf_alpha ) =
PLA_ddot( &local_length_x, ( double *) buf_x, &istride_x,
( double *) buf_y, &istride_y );
}
/* else if ( datatype == MPI_FLOAT ){
*( ( float * ) buf_alpha ) =
PLA_sdot( &local_length_x, ( float *) buf_x, &istride_x,
( float *) buf_y, &istride_y );
} */
else {
PLA_Abort( "datatype not yet supported", __LINE__, __FILE__ );
}
}
return PLA_SUCCESS;
}
int PLA_Obj_set_to_identity( PLA_Obj A )
{
int length, width;
PLA_Obj A11 = NULL, ABR = NULL;
PLA_Obj_global_length( A, &length );
PLA_Obj_global_width( A, &width );
if ( length != width ){
printf("PLA_Obj_set_to_identity() error: object not square\n");
exit ( 0 );
}
PLA_Obj_set_to_zero( A );
PLA_Obj_view_all( A, &ABR );
while ( TRUE ){
PLA_Obj_global_length( ABR, &length );
if ( 0 == length ) break;
PLA_Obj_split_4( ABR, 1, 1, &A11, PLA_DUMMY,
PLA_DUMMY, &ABR );
PLA_Obj_set_to_one( A11 );
}
PLA_Obj_free( &A11 );
PLA_Obj_free( &ABR );
return PLA_SUCCESS;
}
static int pmatreduce(void*MM,double *v, int m){
plapackM* ctx=(plapackM*)MM;
double d_one=1.0;
int info;
int i;
DSDPFunctionBegin;
/*
Copy vec from DSDPVector to PLAPACK vector. This assumes the entries in the local
DSDP Vectors are not duplicated on multiple processors. It adds the first element of
each vector together, second element, ...
*/
info=PLA_Obj_set_to_zero(ctx->vVec);DSDPCHKERR(info);
info=PLA_API_begin();DSDPCHKERR(info);
info=PLA_Obj_API_open(ctx->vVec);DSDPCHKERR(info);
info=PLA_API_axpy_vector_to_global(m, &d_one, v , 1,
ctx->vVec, 0); DSDPCHKERR(info);
info=PLA_Obj_API_close(ctx->vVec); DSDPCHKERR(info);
/* Copy solution from PLAPACK vector to DSDPVector */
memset((void*)v,0,m*sizeof(double));
info=PLA_Obj_API_open(ctx->vVec);DSDPCHKERR(info);
info=PLA_API_axpy_global_to_vector(m, &d_one, ctx->vVec, 0,
v, 1); DSDPCHKERR(info);
info=PLA_Obj_API_close(ctx->vVec); DSDPCHKERR(info);
info=PLA_API_end(); DSDPCHKERR(info);
DSDPFunctionReturn(0);
}
static int pmatfactor(void*MM, int *flag){
plapackM* ctx=(plapackM*)MM;
int info,dummy;
double ddxerror;
DSDPFunctionBegin;
wallclock(&ctx->t1);
info=PLA_Obj_set_to_one(ctx->wVec);DSDPCHKERR(info);
info=PLA_Obj_set_to_zero(ctx->vVec);DSDPCHKERR(info);
info=PLA_Symv( PLA_LOWER_TRIANGULAR, ctx->one, ctx->AMat, ctx->wVec, ctx->zero, ctx->vVec ); DSDPCHKERR(info);
*flag=0;
info = PLA_Chol(PLA_LOWER_TRIANGULAR, ctx->AMat); DSDPCHKERR(info);
if (info!=0) {
*flag=1;
printf("PLAPACK WARNING: Non positive-definite Matrix M : Row: %d\n",info);
}
info = PLA_Trsv(PLA_LOWER_TRIANGULAR, PLA_NO_TRANSPOSE, PLA_NONUNIT_DIAG, ctx->AMat, ctx->vVec);DSDPCHKERR(info);
info = PLA_Trsv(PLA_LOWER_TRIANGULAR, PLA_TRANSPOSE, PLA_NONUNIT_DIAG, ctx->AMat,ctx->vVec); DSDPCHKERR(info);
info=PLA_Obj_set_to_minus_one(ctx->wVec);DSDPCHKERR(info);
info=PLA_Axpy( ctx->one, ctx->vVec, ctx->wVec );DSDPCHKERR(info);
info=PLA_Nrm2( ctx->wVec, ctx->dxerror );DSDPCHKERR(info);
PLA_Obj_get_local_contents( ctx->dxerror, PLA_NO_TRANS, &dummy, &dummy,
&ddxerror, 1, 1 );
if (ddxerror/sqrt(1.0*ctx->global_size) > 0.1){
*flag=1;
if (ctx->rank==-1){
printf("PDSDPPLAPACK: Non positive-definite Matrix. %4.2e\n",ddxerror);
}
}
wallclock(&ctx->t2);
ctx->tsolve+=ctx->t2-ctx->t1;
PPDSDPPrintTime(ctx->rank,"PLAPACK: Factor M",ctx->t2-ctx->t1,ctx->tsolve);
PPDSDPPrintTime(ctx->rank,"Subtotal Time",0,ctx->t2-ctx->t1);
DSDPFunctionReturn(0);
}
static int pmatzero(void*MM){
plapackM* ctx=(plapackM*)MM;
DSDPFunctionBegin;
wallclock(&ctx->t1);
PLA_Obj_set_to_zero(ctx->AMat);
PLA_API_begin();
PLA_Obj_API_open(ctx->AMat);
DSDPFunctionReturn(0);
}
PLA_Copy_sym_tridiag_to_msc( int uplo, PLA_Obj A, PLA_Obj tridiag )
{
int
size;
PLA_Obj
A_BR = NULL, A_11 = NULL, A_21 = NULL, A_21_1 = NULL,
temp = NULL,
diag_1 = NULL, diag_B = NULL,
subdiag_1 = NULL, subdiag_B = NULL;
if ( uplo != PLA_LOWER_TRIANGULAR )
PLA_Abort( "uplo != PLA_LOWER_TRIANGULAR not yet implemented",
__LINE__, __FILE__ );
PLA_Mscalar_create_conf_to( tridiag, PLA_ALL_ROWS, PLA_ALL_COLS,
&temp );
PLA_Obj_set_to_zero( temp );
PLA_Obj_view_all( A, &A_BR );
PLA_Obj_vert_split_2( temp, 1, &diag_B, &subdiag_B );
while ( TRUE ) {
PLA_Obj_global_length( A_BR, &size );
if ( size == 0 ) break;
PLA_Obj_split_4( A_BR, 1, 1, &A_11, PLA_DUMMY,
&A_21, &A_BR );
PLA_Obj_horz_split_2( diag_B, 1, &diag_1,
&diag_B );
PLA_Obj_horz_split_2( subdiag_B, 1, &subdiag_1,
&subdiag_B );
PLA_Local_copy( A_11, diag_1 );
if ( size > 1 ) {
PLA_Obj_horz_split_2( A_21, 1, &A_21_1,
PLA_DUMMY );
PLA_Local_copy( A_21_1, subdiag_1 );
}
}
PLA_Reduce( temp, MPI_SUM, tridiag );
PLA_Obj_free( &A_BR );
PLA_Obj_free( &A_11 );
PLA_Obj_free( &A_21 );
PLA_Obj_free( &A_21_1 );
PLA_Obj_free( &temp );
PLA_Obj_free( &diag_1 );
PLA_Obj_free( &diag_B );
PLA_Obj_free( &subdiag_1 );
PLA_Obj_free( &subdiag_B );
return PLA_SUCCESS;
}
int PLA_Local_asum( PLA_Obj x, PLA_Obj alpha )
{
int
local_length, local_width,
ldim_x, istride;
char
*buf_x, *buf_alpha;
MPI_Datatype
datatype;
PLA_Obj_set_to_zero( alpha );
PLA_Obj_local_length( x, &local_length);
PLA_Obj_local_width ( x, &local_width);
PLA_Obj_local_ldim ( x, &ldim_x );
if ( local_length * local_width != 0 ){
if ( local_length == 1 ){
istride = ldim_x;
local_length = local_width;
}
else
istride = 1;
PLA_Obj_datatype( x, &datatype );
PLA_Obj_local_buffer(x, ( void ** ) &buf_x);
PLA_Obj_local_buffer(alpha, ( void ** ) &buf_alpha);
if ( datatype == MPI_DOUBLE ){
*( ( double * ) buf_alpha ) =
PLA_dasum( &local_length, ( double *) buf_x, &istride );
}
else if ( datatype == MPI_FLOAT ){
*( ( float * ) buf_alpha ) =
PLA_sasum( &local_length, ( float *) buf_x, &istride );
}
else if ( datatype == MPI_DOUBLE_COMPLEX ){
*( ( double * ) buf_alpha ) =
PLA_dzasum( &local_length, ( PLA_DOUBLE_COMPLEX *) buf_x, &istride );
}
else if ( datatype == MPI_COMPLEX ){
*( ( float * ) buf_alpha ) =
PLA_scasum( &local_length, ( PLA_COMPLEX *) buf_x, &istride );
}
}
return PLA_SUCCESS;
}
static int pmatsolve(void* MM, double bb[], double xx[], int n){
plapackM* ctx=(plapackM*)MM;
double d_one=1.0,drank=1.0/ctx->nprocs;
int i,info;
DSDPFunctionBegin;
wallclock(&ctx->t1);
/*
Copy RHS from DSDPVector to PLAPACK vector. This assumes the entries in the local
DSDP Vectors are not duplicated on multiple processors. It adds the first element of
each vector together, second element, ...
*/
info=PLA_Obj_set_to_zero(ctx->vVec);DSDPCHKERR(info);
info=PLA_API_begin();DSDPCHKERR(info);
info=PLA_Obj_API_open(ctx->vVec);DSDPCHKERR(info);
info=PLA_API_axpy_vector_to_global(n, &d_one, bb , 1,
ctx->vVec, 0); DSDPCHKERR(info);
info=PLA_Obj_API_close(ctx->vVec); DSDPCHKERR(info);
info=PLA_API_end(); DSDPCHKERR(info);
/* Assuming the matrix is already factored, solve the equations. */
info = PLA_Trsv(PLA_LOWER_TRIANGULAR, PLA_NO_TRANSPOSE, PLA_NONUNIT_DIAG, ctx->AMat, ctx->vVec);DSDPCHKERR(info);
info = PLA_Trsv(PLA_LOWER_TRIANGULAR, PLA_TRANSPOSE, PLA_NONUNIT_DIAG, ctx->AMat,ctx->vVec); DSDPCHKERR(info);
/* Copy solution from PLAPACK vector to DSDPVector */
memset((void*)xx,0,n*sizeof(double));
info=PLA_API_begin();
info=PLA_Obj_API_open(ctx->vVec);
info=PLA_API_axpy_global_to_vector(n, &d_one, ctx->vVec, 0,
xx, 1); DSDPCHKERR(info);
info=PLA_Obj_API_close(ctx->vVec); DSDPCHKERR(info);
info=PLA_API_end(); DSDPCHKERR(info);
for (i=0;i<n;i++){xx[i]*=drank;}
wallclock(&ctx->t2);
ctx->tsolve+=ctx->t2-ctx->t1;
/* PPDSDPPrintTime(ctx->rank,"Solve M",ctx->t2-ctx->t1,ctx->tsolve);*/
DSDPFunctionReturn(0);
}
int pmatsetup(void *MM, int m){
plapackM* ctx=(plapackM*)MM;
MPI_Comm rowcomm,colcomm;
int itmp,nprocs,info;
DSDPFunctionBegin;
ctx->global_size=m;
info = MPI_Comm_size(ctx->mpi_comm,&nprocs); DSDPCHKERR(info);
itmp=(m-nprocs+1)/nprocs;
itmp=DSDPMax(2,itmp);
ctx->nb_distr=DSDPMin(ctx->nb_distr,itmp);
info = PLA_Comm_1D_to_2D_ratio(ctx->mpi_comm,ctx->ratio,&ctx->plapack_comm); DSDPCHKERR(info);
info = PLA_Init(ctx->plapack_comm); DSDPCHKERR(info);
info = PLA_Temp_create(ctx->nb_distr, 0, &ctx->templ); DSDPCHKERR(info);
info=PLA_Matrix_create(MPI_DOUBLE, m, m, ctx->templ,
PLA_ALIGN_FIRST, PLA_ALIGN_FIRST, &ctx->AMat);DSDPCHKERR(info);
info=PLA_Mvector_create(MPI_DOUBLE, m, 1, ctx->templ, PLA_ALIGN_FIRST, &ctx->vVec);DSDPCHKERR(info);
info=PLA_Mvector_create(MPI_DOUBLE, m, 1, ctx->templ, PLA_ALIGN_FIRST, &ctx->wVec);DSDPCHKERR(info);
info=PLA_Mscalar_create( MPI_DOUBLE, PLA_ALL_ROWS, PLA_ALL_COLS, 1, 1, ctx->templ, &ctx->dxerror );DSDPCHKERR(info);
info=PLA_Mscalar_create( MPI_DOUBLE, PLA_ALL_ROWS, PLA_ALL_COLS, 1, 1, ctx->templ, &ctx->one );DSDPCHKERR(info);
info=PLA_Mscalar_create( MPI_DOUBLE, PLA_ALL_ROWS, PLA_ALL_COLS, 1, 1, ctx->templ, &ctx->zero );DSDPCHKERR(info);
info=PLA_Obj_set_to_one(ctx->one);DSDPCHKERR(info);
info=PLA_Obj_set_to_zero(ctx->zero);DSDPCHKERR(info);
info = MPI_Comm_rank(ctx->plapack_comm,&ctx->rank); DSDPCHKERR(info);
info = MPI_Comm_size(ctx->plapack_comm,&ctx->nprocs); DSDPCHKERR(info);
info = PLA_Temp_comm_col_info(ctx->templ, &rowcomm, &ctx->rowrank, &ctx->numrownodes); DSDPCHKERR(info);
info = PLA_Temp_comm_row_info(ctx->templ, &colcomm, &ctx->colrank, &ctx->numcolnodes); DSDPCHKERR(info);
ctx->t0=0;ctx->t1=0;ctx->t2=0;
ctx->thessian=0;ctx->tsolve=0;
wallclock(&ctx->t0);
DSDPFunctionReturn(0);
}
int PLA_Obj_set_to_zero_below_diagonal( PLA_Obj A )
{
PLA_Obj
A_BR = NULL, a_21 = NULL;
int
size;
PLA_Obj_view_all( A, &A_BR );
while( TRUE ){
PLA_Obj_global_length( A_BR, &size );
if ( size == 0 ) break;
PLA_Obj_split_4( A_BR, 1, 1, PLA_DUMMY, PLA_DUMMY,
&a_21, &A_BR );
PLA_Obj_set_to_zero( a_21 );
}
PLA_Obj_free( &A_BR );
PLA_Obj_free( &a_21 );
return PLA_SUCCESS;
}
int PLA_Triangular_invert_lower( PLA_Obj A )
{
int
nb_alg, size, value = PLA_SUCCESS;
PLA_Obj
A_BR = NULL, A_11 = NULL, A_21 = NULL, A_21_dup = NULL, A_11_msc = NULL,
Ainv = NULL, Ainv_BL = NULL, Ainv_10_11 = NULL, Ainv_10_11_dup = NULL,
minus_one = NULL, zero = NULL, one = NULL;
PLA_Template
templ;
PLA_Obj_template( A, &templ );
PLA_Environ_nb_alg( PLA_OP_PAN_PAN, templ, &nb_alg );
PLA_Create_constants_conf_to( A, &minus_one, &zero, &one );
PLA_Obj_vert_split_2( A, 0, &Ainv_BL, &A_BR );
while( TRUE ){
PLA_Obj_global_length( A_BR, &size );
if ( 0 == ( size = min( size, nb_alg ) ) ) break;
PLA_Obj_split_4( A_BR, size, size, &A_11, PLA_DUMMY,
&A_21, &A_BR );
PLA_Obj_view_shift( Ainv_BL, 0,
0, size,
0 );
PLA_Obj_horz_split_2( Ainv_BL, size, &Ainv_10_11,
&Ainv_BL );
PLA_Mscalar_create_conf_to( A_11, PLA_ALL_ROWS, PLA_ALL_COLS,
&A_11_msc );
PLA_Copy( A_11, A_11_msc );
PLA_Obj_set_orientation( Ainv_10_11, PLA_PROJ_ONTO_ROW );
PLA_Pmvector_create_conf_to( Ainv_BL, PLA_PROJ_ONTO_ROW, PLA_ALL_ROWS,
size, &Ainv_10_11_dup );
PLA_Pmvector_create_conf_to( Ainv_BL, PLA_PROJ_ONTO_COL, PLA_ALL_COLS,
size, &A_21_dup );
/* PLA_Trsm( PLA_SIDE_LEFT, PLA_LOWER_TRIANGULAR,
PLA_NO_TRANSPOSE, PLA_NONUNIT_DIAG,
one, A_11, Ainv_10_11 ); */
PLA_Obj_set_to_identity( A_11 );
PLA_Copy( Ainv_10_11, Ainv_10_11_dup );
PLA_Local_trsm( PLA_SIDE_LEFT, PLA_LOWER_TRIANGULAR,
PLA_NO_TRANSPOSE, PLA_NONUNIT_DIAG,
one, A_11_msc, Ainv_10_11_dup );
PLA_Copy( A_21, A_21_dup );
PLA_Obj_set_to_zero( A_21 );
PLA_Local_gemm( PLA_NO_TRANS, PLA_NO_TRANS,
minus_one, A_21_dup, Ainv_10_11_dup,
one, Ainv_BL );
PLA_Copy( Ainv_10_11_dup, Ainv_10_11 );
}
PLA_Obj_free( &A_BR );
PLA_Obj_free( &A_11 );
PLA_Obj_free( &A_21 );
PLA_Obj_free( &Ainv );
PLA_Obj_free( &Ainv_BL );
PLA_Obj_free( &Ainv_10_11 );
PLA_Obj_free( &minus_one );
PLA_Obj_free( &zero );
PLA_Obj_free( &one );
return PLA_SUCCESS;
}
int PLA_Triangular_Lt_L( PLA_Obj A )
{
int
nb_alg, size, value = PLA_SUCCESS;
PLA_Obj
A_TL = NULL, A_BL = NULL, A_10_11 = NULL, A_11 = NULL,
A_10_11_dpmv_rows = NULL, A_10_11_dpmv_cols = NULL,
one = NULL;
PLA_Template
templ;
PLA_Obj_template( A, &templ );
PLA_Environ_nb_alg( PLA_OP_PAN_PAN, templ, &nb_alg );
PLA_Create_constants_conf_to( A, NULL, NULL, &one );
PLA_Obj_split_4( A, 0, 0, &A_TL, PLA_DUMMY,
&A_BL, PLA_DUMMY );
while( TRUE ){
PLA_Obj_global_length( A_BL, &size );
if ( 0 == ( size = min( size, nb_alg ) ) ) break;
PLA_Obj_view_shift( A_TL, 0,
0, size,
size );
PLA_Obj_view_shift( A_BL, 0,
0, size,
0 );
PLA_Obj_horz_split_2( A_BL, size, &A_10_11,
&A_BL );
PLA_Obj_vert_split_2( A_10_11, -size, PLA_DUMMY, &A_11 );
PLA_Set_triang_to_zero( PLA_LOWER_TRIANGULAR, PLA_NONUNIT_DIAG, A_11 );
PLA_Obj_set_orientation( A_10_11, PLA_PROJ_ONTO_ROW );
PLA_Pmvector_create_conf_to( A_TL, PLA_PROJ_ONTO_COL, PLA_ALL_COLS,
size, &A_10_11_dpmv_cols );
PLA_Pmvector_create_conf_to( A_TL, PLA_PROJ_ONTO_ROW, PLA_ALL_ROWS,
size, &A_10_11_dpmv_rows );
PLA_Copy( A_10_11, A_10_11_dpmv_rows );
/*
{
PLA_Obj
A_10_11_mv = NULL;
PLA_Mvector_create_conf_to( A_10_11, 1, &A_10_11_mv );
PLA_Copy( A_10_11_dpmv_rows, A_10_11_mv );
PLA_Copy( A_10_11_mv, A_10_11_dpmv_cols );
PLA_Obj_free( &A_10_11_mv );
}
*/
PLA_Copy( A_10_11, A_10_11_dpmv_cols );
PLA_Obj_set_to_zero( A_10_11 );
PLA_Syrk_perform_local_part( PLA_LOWER_TRIANGULAR,
one, A_10_11_dpmv_cols, A_10_11_dpmv_rows,
one, A_TL );
}
PLA_Obj_free( &A_TL );
PLA_Obj_free( &A_BL );
PLA_Obj_free( &A_10_11 );
PLA_Obj_free( &A_11 );
PLA_Obj_free( &A_10_11_dpmv_rows );
PLA_Obj_free( &A_10_11_dpmv_cols );
PLA_Obj_free( &one );
return PLA_SUCCESS;
}
int PLA_Symm_enter( int side, int uplo,
PLA_Obj alpha, PLA_Obj A, PLA_Obj B,
PLA_Obj beta, PLA_Obj C )
{
int
value = PLA_SUCCESS,
size, length_A, width_A, length_B, width_B, length_C, width_C,
objtype;
char
routine_name[ 35 ] = "PLA_Symm";
PLA_Routine_stack_push( routine_name );
PLA_Routine_stack_push( "PLA_Symm_enter" );
old_size_malloced = PLA_Total_size_malloced( );
if ( PLA_CHECK_PARAMETERS ){
/* Check if side and uplo parameters are valid */
if ( !PLA_Valid_side_parameter( side ) ){
PLA_Warning( "Invalid parameter side" );
value--;
}
if ( !PLA_Valid_uplo_parameter( uplo ) ){
PLA_Warning( "Invalid parameter uplo" );
value--;
}
/* Check if alpha is valid multiscalar of size 1x1 */
if ( alpha == NULL || !PLA_Valid_object( alpha ) ) {
PLA_Warning( "Invalid object alpha" );
value--;
}
PLA_Obj_objtype( alpha, &objtype );
if ( objtype != PLA_MSCALAR ){
PLA_Warning( "Invalid objtype for alpha" );
value--;
}
PLA_Obj_global_length( alpha, &size );
if ( size != 1 ){
PLA_Warning( "Invalid global length for alpha" );
value--;
}
PLA_Obj_global_width( alpha, &size );
if ( size != 1 ){
PLA_Warning( "Invalid global width for alpha" );
value--;
}
/* Check if A is valid matrix */
if ( A == NULL || !PLA_Valid_object( A ) ) {
PLA_Warning( "Invalid object A" );
value--;
}
PLA_Obj_objtype( A, &objtype );
if ( objtype != PLA_MATRIX ){
PLA_Warning( "Invalid objtype for A" );
value--;
}
/* Check if B is valid matrix */
if ( B == NULL || !PLA_Valid_object( B ) ) {
PLA_Warning( "Invalid object B" );
value--;
}
PLA_Obj_objtype( B, &objtype );
if ( objtype != PLA_MATRIX ){
PLA_Warning( "Invalid objtype for B" );
value--;
}
/* Check if beta is valid multiscalar of size 1x1 */
if ( beta == NULL || !PLA_Valid_object( beta ) ) {
PLA_Warning( "Invalid object beta" );
value--;
}
PLA_Obj_objtype( beta, &objtype );
if ( objtype != PLA_MSCALAR ){
PLA_Warning( "Invalid objtype for beta" );
value--;
}
PLA_Obj_global_length( beta, &size );
if ( size != 1 ){
PLA_Warning( "Invalid global length for beta" );
value--;
}
PLA_Obj_global_width( beta, &size );
if ( size != 1 ){
PLA_Warning( "Invalid global width for beta" );
value--;
}
/* Check if C is valid matrix */
if ( C == NULL || !PLA_Valid_object( C ) ) {
PLA_Warning( "Invalid object C" );
value--;
}
PLA_Obj_objtype( C, &objtype );
if ( objtype != PLA_MATRIX ){
PLA_Warning( "Invalid objtype for C" );
value--;
}
/* Check if matrix dimensions match */
PLA_Obj_global_length( A, &length_A );
PLA_Obj_global_width( A, &width_A );
PLA_Obj_global_length( B, &length_B );
PLA_Obj_global_width( B, &width_B );
PLA_Obj_global_length( C, &length_C );
PLA_Obj_global_width( C, &width_C );
if ( length_A != width_A ){
PLA_Warning( "A is not square" );
value--;
}
if ( side == PLA_SIDE_LEFT ){
if ( length_A != length_C ){
PLA_Warning( "length of A does not match length of C" );
value--;
}
}
else /* side == PLA_SIDE_LEFT */{
if ( length_A != width_C ){
PLA_Warning( "length of A does not match width of C" );
value--;
}
}
if ( length_B != length_C ){
PLA_Warning( "length of B does not match length of C" );
value--;
}
if ( width_B != width_C ){
PLA_Warning( "width of B does not match width of C" );
value--;
}
}
if ( PLA_CHECK_AGAINST_SEQUENTIAL ){
PLA_Mscalar_create_conf_to(
alpha, PLA_ALL_ROWS, PLA_ALL_COLS, &alpha_cpy );
PLA_Mscalar_create_conf_to(
A, PLA_ALL_ROWS, PLA_ALL_COLS, &A_cpy );
PLA_Mscalar_create_conf_to(
B, PLA_ALL_ROWS, PLA_ALL_COLS, &B_cpy );
PLA_Mscalar_create_conf_to(
beta, PLA_ALL_ROWS, PLA_ALL_COLS, &beta_cpy );
PLA_Mscalar_create_conf_to(
C, PLA_ALL_ROWS, PLA_ALL_COLS, &C_cpy );
PLA_Copy( alpha, alpha_cpy );
PLA_Copy( A, A_cpy );
PLA_Copy( B, B_cpy );
PLA_Copy( beta, beta_cpy );
if ( PLA_Local_equal_zero( beta_cpy ) )
PLA_Obj_set_to_zero( C_cpy );
else
PLA_Copy( C, C_cpy );
}
PLA_Routine_stack_pop( routine_name );
return value;
}
int PLA_Tri_red( int uplo, PLA_Obj A, PLA_Obj s, PLA_Obj Q )
/*
PLA_Tri_red
Purpose: Reduce symmetric matrix A to tridiagonal form using
Householder similarity transformations.
input:
uplo indicates whether A is stored in upper or
lower triangular part
A MATRIX to be reduced
output:
A Reduced matrix A. Householder vectors used
to reduce A are stored below first subdiagonal
of A.
s Scaling factors for the Householder transforms
computed to reduce A.
Q if Q != NULL, Q equals the accumulation of
Householder transforms.
*/
{
PLA_Obj
u = NULL, u_B = NULL,
beta_B = NULL, beta_1 = NULL, beta_1_dup = NULL,
A_BR = NULL, a_21 = NULL, A_21 = NULL,
q_11 = NULL, q_12 = NULL, q_21 = NULL, Q_22 = NULL;
int
size, value = PLA_SUCCESS;
double time;
if ( PLA_ERROR_CHECKING ) /* Perform parameter and error checking */
value = PLA_Tri_red_enter( uplo, A, s, Q );
if ( uplo != PLA_LOWER_TRIANGULAR )
PLA_Abort( "only uplo == PLA_LOWER_TRIANGULAR currently supported",
__LINE__, __FILE__ );
/* Create a vector in which to compute the Householder vector */
PLA_Mvector_create_conf_to( A, 1, &u );
/* Create a duplicated multiscalar in which to hold the scaling factor
for the Householder transform being computed */
PLA_Obj_horz_split_2( s, 1, &beta_1,
PLA_DUMMY );
PLA_Mscalar_create_conf_to( beta_1, PLA_ALL_ROWS, PLA_ALL_COLS,
&beta_1_dup );
/* Track the active parts of A, s, and u */
PLA_Obj_view_all( A, &A_BR );
PLA_Obj_view_all( s, &beta_B );
PLA_Obj_view_all( u, &u_B );
while ( TRUE ){
PLA_Obj_global_length( A_BR, &size );
if ( 1 == size ) break;
/* Partition A_BR = / alpha_11 * \
\ a_21 A_BR / where alpha_11 is 1x1 */
PLA_Obj_split_4( A_BR, 1, 1, PLA_DUMMY, PLA_DUMMY,
&a_21, &A_BR );
/* Split of the current element of vector s */
PLA_Obj_horz_split_2( beta_B, 1, &beta_1,
&beta_B );
/* View the part of u in which to compute the Householder vector */
PLA_Obj_horz_split_2( u_B, 1, PLA_DUMMY,
&u_B );
/* Redistributed a_21 as a vector and compute Householder transform */
PLA_Copy( a_21, u_B );
PLA_Compute_House_v( u_B, beta_1_dup );
/* Place data back in A and s */
PLA_Copy( u_B, a_21 );
PLA_Local_copy( beta_1_dup, beta_1 );
/* Update A_BR <- ( I - beta_1 u_B u_B^T ) A_BR ( I - beta_1 u_B u_B^T ) */
PLA_Apply_sym_House( uplo, A_BR, u_B, beta_1_dup );
}
time = MPI_Wtime ();
if ( Q != NULL ){
/* Compute the orthogonal matrix */
PLA_Obj_split_4( Q, 1, 1, &q_11, &q_12,
&q_21, &Q_22 );
PLA_Obj_set_to_one ( q_11 );
PLA_Obj_set_to_zero( q_12 );
PLA_Obj_set_to_zero( q_21 );
PLA_Obj_split_4( A, 1, -1, PLA_DUMMY, PLA_DUMMY,
&A_21, PLA_DUMMY );
PLA_Form_Q( PLA_NO_TRANSPOSE, A_21, s, Q_22 );
}
time = MPI_Wtime () - time;
printf( " Form_Q = %f\n", time );
/* Free the temporary objects */
PLA_Obj_free( &u );
PLA_Obj_free( &u_B );
PLA_Obj_free( &beta_B );
PLA_Obj_free( &beta_1 );
PLA_Obj_free( &beta_1_dup );
PLA_Obj_free( &A_BR );
PLA_Obj_free( &a_21 );
PLA_Obj_free( &A_21 );
PLA_Obj_free( &q_11 );
PLA_Obj_free( &q_12 );
PLA_Obj_free( &q_21 );
PLA_Obj_free( &Q_22 );
if ( PLA_ERROR_CHECKING )
value = PLA_Tri_red_exit( uplo, A, s, Q );
return PLA_SUCCESS;
}
int main(int argc, char *argv[])
{
MPI_Comm
comm = MPI_COMM_NULL;
MPI_Datatype
datatype;
PLA_Template
templ = NULL;
PLA_Obj
A_orig = NULL, A = NULL, Q = NULL, diag = NULL, B = NULL,
minus_one = NULL, zero = NULL, one = NULL;
int
n,
nb_distr, nb_alg,
error, parameters, sequential,
me, nprocs, nprows, npcols,
itype;
double
time,
flops,
d_abs_max,
PLA_Local_abs_max();
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &me);
MPI_Comm_size(MPI_COMM_WORLD, &nprocs);
if (me==0) {
printf("enter mesh size:\n");
scanf("%d%d", &nprows, &npcols );
printf("mesh size = %d x %d \n", nprows, npcols );
printf("enter distr. block size:\n");
scanf("%d", &nb_distr );
printf("nb_distr = %d\n", nb_distr );
printf("enter alg. block size:\n");
scanf("%d", &nb_alg );
printf("nb_alg = %d\n", nb_alg );
printf("turn on error checking? (0 = NO, 1 = YES):\n");
scanf("%d", &error );
printf("error checking = %d\n", error );
printf("turn on parameter checking? (0 = NO, 1 = YES):\n");
scanf("%d", ¶meters );
printf("parameter checking = %d\n", parameters );
printf("turn on sequential checking? (0 = NO, 1 = YES):\n");
scanf("%d", &sequential );
printf("sequential checking = %d\n", sequential );
}
MPI_Bcast(&nprows, 1, MPI_INT, 0, MPI_COMM_WORLD);
MPI_Bcast(&npcols, 1, MPI_INT, 0, MPI_COMM_WORLD);
MPI_Bcast(&nb_distr, 1, MPI_INT, 0, MPI_COMM_WORLD);
MPI_Bcast(&nb_alg, 1, MPI_INT, 0, MPI_COMM_WORLD);
MPI_Bcast(&error, 1, MPI_INT, 0, MPI_COMM_WORLD);
MPI_Bcast(¶meters, 1, MPI_INT, 0, MPI_COMM_WORLD);
MPI_Bcast(&sequential, 1, MPI_INT, 0, MPI_COMM_WORLD);
pla_Environ_set_nb_alg( PLA_OP_ALL_ALG, nb_alg );
PLA_Set_error_checking( error, parameters, sequential, FALSE );
/* PLA_Comm_1D_to_2D_ratio(MPI_COMM_WORLD, 1.0, &comm); */
PLA_Comm_1D_to_2D(MPI_COMM_WORLD, nprows, npcols, &comm);
PLA_Init(comm);
PLA_Temp_create( nb_distr, 0, &templ );
while ( TRUE ){
if (me==0) {
printf("enter datatype:\n");
printf("-1 = quit\n");
printf(" 0 = float\n");
printf(" 1 = double\n");
printf(" 2 = complex\n");
printf(" 3 = double complex\n");
scanf("%d", &itype );
printf("itype = %d\n", itype );
}
MPI_Bcast(&itype, 1, MPI_INT, 0, MPI_COMM_WORLD);
if ( itype == -1 ) break;
switch( itype ){
case 0:
datatype = MPI_FLOAT;
break;
case 1:
datatype = MPI_DOUBLE;
break;
case 2:
datatype = MPI_COMPLEX;
break;
case 3:
datatype = MPI_DOUBLE_COMPLEX;
break;
default:
PLA_Abort( "unknown datatype", __LINE__, __FILE__ );
}
if (me==0) {
printf("enter n:\n");
scanf("%d", &n );
printf("n = %d\n", n );
}
MPI_Bcast(&n, 1, MPI_INT, 0, MPI_COMM_WORLD);
PLA_Matrix_create( datatype,
n,
n,
templ,
PLA_ALIGN_FIRST,
PLA_ALIGN_FIRST,
&A_orig );
PLA_Matrix_create_conf_to( A_orig, &Q );
PLA_Matrix_create_conf_to( A_orig, &A );
PLA_Mvector_create( datatype,
n,
1,
templ,
PLA_ALIGN_FIRST,
&diag );
PLA_Create_constants_conf_to( A, &minus_one, &zero, &one );
create_diag( diag );
PLA_Create_sym_eigenproblem( PLA_LOWER_TRIANGULAR, 3, diag, A_orig, Q );
PLA_Copy( A_orig, A );
MPI_Barrier( MPI_COMM_WORLD );
time = MPI_Wtime ();
PLA_Spectral_decomp( PLA_LOWER_TRIANGULAR, A, Q, diag );
MPI_Barrier( MPI_COMM_WORLD );
time = MPI_Wtime () - time;
/******* Check answer *******/
/* Make A_orig symmetric */
PLA_Symmetrize( PLA_LOWER_TRIANGULAR, A_orig );
PLA_Matrix_create_conf_to( A_orig, &B );
PLA_Obj_set_to_zero( A );
PLA_Obj_set_diagonal( A, diag );
/* A_orig = A_orig - Q diag Q^T */
PLA_Gemm( PLA_NO_TRANSPOSE, PLA_NO_TRANSPOSE,
one, Q, A, zero, B );
PLA_Gemm( PLA_NO_TRANSPOSE, PLA_TRANSPOSE,
minus_one, B, Q, one, A_orig );
/* Extract absolute value of entry with largest absolute value in A_orig */
d_abs_max = PLA_Local_abs_max( A_orig );
if ( d_abs_max > 0.000000001 )
printf( "large error detected: %le\n", d_abs_max );
flops = 4.0/3.0 * n * n * n;
if ( me == 0 )
printf("%d time = %f, MFLOPS/node = %10.4lf \n", n, time,
flops / time * 1.0e-6 / nprocs );
PLA_Obj_free( &A_orig );
PLA_Obj_free( &A );
PLA_Obj_free( &Q );
PLA_Obj_free( &diag );
PLA_Obj_free( &B );
PLA_Obj_free( &minus_one );
PLA_Obj_free( &zero );
PLA_Obj_free( &one );
}
PLA_Temp_free(&templ);
PLA_Finalize( );
MPI_Finalize( );
}
int PLA_Local_matrix_infinity_norm( PLA_Obj A, PLA_Obj alpha )
{
int
length_A, width_A,
length_alpha, width_alpha,
lda;
MPI_Datatype
datatype;
PLA_Obj_local_length( A, &length_A );
PLA_Obj_local_width( A, &width_A );
PLA_Obj_local_length( alpha, &length_alpha );
PLA_Obj_local_width ( alpha, &width_alpha );
if ( length_alpha == 0 || width_alpha == 0 )
return PLA_SUCCESS;
if ( length_A == 0 || width_A == 0 ){
PLA_Obj_set_to_zero( alpha );
return PLA_SUCCESS;
}
PLA_Obj_local_ldim( A, &lda );
PLA_Obj_datatype ( A, &datatype );
if ( datatype == MPI_DOUBLE ){
double
*buff_A, *buff_alpha,
row_nrm1;
int
i;
PLA_Obj_local_buffer( A, (void **) &buff_A );
PLA_Obj_local_buffer( alpha, (void **) &buff_alpha );
*buff_alpha = 0.0;
for ( i=0; i<length_A; i++ ){
row_nrm1 = PLA_dasum( &width_A, buff_A + i, &lda );
*buff_alpha = max( *buff_alpha, row_nrm1 );
}
}
else if ( datatype == MPI_FLOAT ){
float
*buff_A, *buff_alpha,
row_nrm1;
int
i;
PLA_Obj_local_buffer( A, (void **) &buff_A );
PLA_Obj_local_buffer( alpha, (void **) &buff_alpha );
*buff_alpha = 0.0;
for ( i=0; i<length_A; i++ ){
row_nrm1 = PLA_sasum( &width_A, buff_A + i, &lda );
*buff_alpha = max( *buff_alpha, row_nrm1 );
}
}
else if ( datatype == MPI_DOUBLE_COMPLEX ){
PLA_DOUBLE_COMPLEX
*buff_A;
double
*buff_alpha, row_nrm1;
int
i;
PLA_Obj_local_buffer( A, (void **) &buff_A );
PLA_Obj_local_buffer( alpha, (void **) &buff_alpha );
*buff_alpha = 0.0;
for ( i=0; i<length_A; i++ ){
row_nrm1 = PLA_dzasum( &width_A, buff_A + i, &lda );
*buff_alpha = max( *buff_alpha, row_nrm1 );
}
}
else if ( datatype == MPI_COMPLEX ){
PLA_COMPLEX
*buff_A;
float
*buff_alpha, row_nrm1;
int
i;
PLA_Obj_local_buffer( A, (void **) &buff_A );
PLA_Obj_local_buffer( alpha, (void **) &buff_alpha );
*buff_alpha = 0.0;
for ( i=0; i<length_A; i++ ){
row_nrm1 = PLA_scasum( &width_A, buff_A + i, &lda );
*buff_alpha = max( *buff_alpha, row_nrm1 );
}
}
else
PLA_Warning( "PLA_Local_matrix_infinity_norm: datatype not yet implemented" );
return PLA_SUCCESS;
}
void PLA_JVTrsv_lt( int diag, PLA_Obj A, PLA_Obj b )
{
PLA_Obj A_TL = NULL, A_BL = NULL,
A_10 = NULL, A_11 = NULL,
A_20 = NULL, A_21 = NULL,
br = NULL, xc = NULL,
b_1 = NULL, b_L = NULL,
br_1 = NULL, br_L = NULL,
xc_T = NULL,
xc_1 = NULL, xc_2 = NULL,
minus_one = NULL, one = NULL;
PLA_Template templ = NULL;
int nb_distr, nb_out, nprocs, size;
PLA_Obj_template( A, &templ );
PLA_Temp_nb( templ, &nb_distr );
PLA_Temp_comm_all_size( templ, &nprocs );
nb_out = nprocs * nb_distr;
/* nb_out = 10000; */
PLA_Pmvector_create_conf_to(A, PLA_PROJ_ONTO_COL, PLA_ALL_COLS, 1, &xc );
PLA_Pmvector_create_conf_to(A, PLA_PROJ_ONTO_ROW, PLA_ALL_ROWS, 1, &br );
PLA_Obj_set_to_zero( br );
PLA_Obj_set_to_zero( xc );
PLA_Create_constants_conf_to( A, &minus_one, NULL, &one );
PLA_Obj_global_length( A, &size );
PLA_Obj_horz_split_2( A, size, &A_TL,
&A_BL );
PLA_Obj_horz_split_2( xc, size, &xc_T,
&xc_2 );
PLA_Obj_view_all( br, &br_L );
PLA_Obj_view_all( b, &b_L );
while( TRUE ) {
PLA_Obj_global_length( A_TL, &size );
if ( 0 == ( size = min( size, nb_out ) ) ) break;
PLA_Obj_vert_split_2( A_BL, -size, &A_20, &A_21 );
PLA_Obj_split_4( A_TL, -size, -size, &A_TL, PLA_DUMMY,
&A_10, &A_11 );
PLA_Obj_horz_split_2( b_L, -size, &b_L,
&b_1 );
PLA_Obj_vert_split_2( br_L, -size, &br_L, &br_1 );
PLA_Obj_horz_split_2( xc_T, -size, &xc_T, &xc_1 );
PLA_Local_gemv( PLA_TRANS, minus_one, A_21, xc_2, one, br_1 );
PLA_JVTrsv_sub_lt( diag, A_11, b_1, br_1, xc_1 );
PLA_Obj_view_shift( A_BL, -size,
0, -size,
0 );
PLA_Obj_view_shift( xc_2, -size,
0, 0,
0 );
}
PLA_Obj_free(&A_TL); PLA_Obj_free(&A_BL);
PLA_Obj_free(&A_10); PLA_Obj_free(&A_11);
PLA_Obj_free(&A_20); PLA_Obj_free(&A_21);
PLA_Obj_free(&b_1); PLA_Obj_free(&b_L);
PLA_Obj_free(&br);
PLA_Obj_free(&br_1); PLA_Obj_free(&br_L);
PLA_Obj_free(&xc); PLA_Obj_free(&xc_T);
PLA_Obj_free(&xc_1); PLA_Obj_free(&xc_2);
PLA_Obj_free(&minus_one); PLA_Obj_free(&one);
return;
}
int PLA_Compute_WY( PLA_Obj A_mv, PLA_Obj s, PLA_Obj W_mv, PLA_Obj Y_mv )
/* to use this routine, we need to modify the calling of
* PLA_QR_right
*/
/*
Purpose: Compute WY transform from Householder vectors stored
in A and s.
Note: Utility routine used as part of computation of QR factorization
of a matrix.
Input: A_mv -- General mxn matrix A
(PLA_MVECTOR)
s -- vector of scaling factors
(MSCALAR of width=n, duplicated to all nodes)
W_mv, Y_mv
-- matrices for storing W and Y which define the
WY transform.
(PLA_MVECTOR of width n)
Output: W_mv, Y_mv
-- W and Y which define the WY transform.
Assumptions: n<=m
Return value: PLA_SUCCESS unless input parameter error is detected.
*/
{
PLA_Obj a_B1 = NULL, A_mv_BR = NULL,
s_cur = NULL, beta = NULL,
W_L = NULL, w_1 = NULL, W_R = NULL,
W_BR = NULL, w_B1 = NULL,
Y_BL = NULL, y_B1 = NULL, Y_BR = NULL,
y_11 = NULL, u_loc = NULL, u = NULL,
u_loc_L = NULL, u_L = NULL,
minus_one = NULL, zero = NULL, one = NULL;
int global_width;
PLA_Create_constants_conf_to( A_mv, &minus_one, &zero, &one );
PLA_Obj_set_to_zero( W_mv );
PLA_Obj_set_to_zero( Y_mv );
/* A_mv_BR tracks the active part of A_mv */
PLA_Obj_view_all( A_mv, &A_mv_BR );
/* s_cur tracks the active part of s */
PLA_Obj_view_all( s, &s_cur );
/* W_L tracks the part of W already computed, W_R the part yet to be
computed. Ditto for W_BR, Y_BL and Y_BR */
PLA_Obj_vert_split_2( W_mv, 0, &W_L, &W_R );
PLA_Obj_vert_split_2( W_mv, 0, PLA_DUMMY, &W_BR );
PLA_Obj_vert_split_2( Y_mv, 0, &Y_BL, &Y_BR );
/* Create duplicated multiscalar to hold u and local contributions to u */
PLA_Mscalar_create_conf_to( s, PLA_ALL_ROWS, PLA_ALL_COLS, &u );
PLA_Mscalar_create_conf_to( s, PLA_ALL_ROWS, PLA_ALL_COLS, &u_loc );
/* u_L and u_loc_L tracks the part of u and u_loc
corresponding to Y_BL and Y_BR, respectively */
PLA_Obj_horz_split_2( u, 0, &u_L, PLA_DUMMY );
PLA_Obj_horz_split_2( u_loc, 0, &u_loc_L, PLA_DUMMY );
while( TRUE ){
PLA_Obj_global_width( A_mv_BR, &global_width );
if ( 0 == global_width ) break;
/* Split off next column of A_mv_BR and columns of W and Y
to be computed */
PLA_Obj_vert_split_2( A_mv_BR, 1, &a_B1, PLA_DUMMY );
PLA_Obj_vert_split_2( W_R, 1, &w_1, &W_R );
PLA_Obj_vert_split_2( W_BR, 1, &w_B1, PLA_DUMMY );
PLA_Obj_vert_split_2( Y_BR, 1, &y_B1, PLA_DUMMY );
/* Split off current scaling factor beta */
PLA_Obj_horz_split_2( s_cur, 1, &beta,
&s_cur );
/* y_B1 = a_B1 with first element set to 1 */
PLA_Local_copy( a_B1, y_B1 );
PLA_Obj_horz_split_2( y_B1, 1, &y_11,
PLA_DUMMY );
PLA_Obj_set_to_one( y_11 );
/* w_1 = - beta ( / 0 \
\ y_B1 / + W_L Y_BL y_B1 ) */
PLA_Local_copy( y_B1, w_B1 );
PLA_Local_gemv( PLA_TRANS, one, Y_BL, y_B1, zero, u_loc_L );
PLA_Reduce( u_loc_L, MPI_SUM, u_L );
PLA_Obj_global_width( W_L, &global_width );
if ( global_width > 0 )
PLA_Local_gemv( PLA_NO_TRANS, one, W_L, u_L, one, w_1 );
PLA_Local_scal( beta, w_1 );
/* PLA_Local_scal( minus_one, w_1 ); */
/* Update views */
PLA_Obj_view_shift( W_L, 0,
0, 1,
0 );
PLA_Obj_view_shift( Y_BL, 1,
0, 1,
0 );
PLA_Obj_view_shift( u_L, 0,
0, 0,
1 );
PLA_Obj_view_shift( u_loc_L, 0,
0, 0,
1 );
PLA_Obj_split_4( A_mv_BR, 1, 1, PLA_DUMMY, PLA_DUMMY,
PLA_DUMMY, &A_mv_BR);
PLA_Obj_split_4( Y_BR, 1, 1, PLA_DUMMY, PLA_DUMMY,
PLA_DUMMY, &Y_BR );
PLA_Obj_split_4( W_BR, 1, 1, PLA_DUMMY, PLA_DUMMY,
PLA_DUMMY, &W_BR );
}
/* Clean up temporary objects */
PLA_Obj_free( &a_B1 ); PLA_Obj_free( &A_mv_BR );
PLA_Obj_free( &s_cur ); PLA_Obj_free( &beta );
PLA_Obj_free( &W_L ); PLA_Obj_free( &w_1 ); PLA_Obj_free( &W_R );
PLA_Obj_free( &W_BR ); PLA_Obj_free( &w_B1 );
PLA_Obj_free( &Y_BL ); PLA_Obj_free( &y_B1 ); PLA_Obj_free( &Y_BR );
PLA_Obj_free( &y_11 );
PLA_Obj_free( &u ); PLA_Obj_free( &u_loc );
PLA_Obj_free( &u_L ); PLA_Obj_free( &u_loc_L );
PLA_Obj_free( &minus_one );
PLA_Obj_free( &zero ); PLA_Obj_free( &one );
return PLA_SUCCESS;
}
int PLA_Symv_enter( int uplo,
PLA_Obj alpha, PLA_Obj A, PLA_Obj x,
PLA_Obj beta, PLA_Obj y )
{
int
value = PLA_SUCCESS,
size, length_A, width_A, length_x, width_x, length_y, width_y,
objtype, proj_onto;
char
routine_name[ 35 ] = "PLA_Symv";
PLA_Routine_stack_push( routine_name );
PLA_Routine_stack_push( "PLA_Symv_enter" );
old_size_malloced = PLA_Total_size_malloced( );
if ( PLA_CHECK_PARAMETERS ) {
/* Check if uplo parameters are valid */
if ( !PLA_Valid_uplo_parameter( uplo ) ) {
PLA_Warning( "Invalid parameter uplo" );
value--;
}
/* Check if alpha is valid multiscalar of size 1x1 */
if ( alpha == NULL || !PLA_Valid_object( alpha ) ) {
PLA_Warning( "Invalid object alpha" );
value--;
}
PLA_Obj_objtype( alpha, &objtype );
if ( objtype != PLA_MSCALAR ) {
PLA_Warning( "Invalid objtype for alpha" );
value--;
}
PLA_Obj_global_length( alpha, &size );
if ( size != 1 ) {
PLA_Warning( "Invalid global length for alpha" );
value--;
}
PLA_Obj_global_width( alpha, &size );
if ( size != 1 ) {
PLA_Warning( "Invalid global width for alpha" );
value--;
}
/* Check if A is valid matrix */
if ( A == NULL || !PLA_Valid_object( A ) ) {
PLA_Warning( "Invalid object A" );
value--;
}
PLA_Obj_objtype( A, &objtype );
if ( objtype != PLA_MATRIX ) {
PLA_Warning( "Invalid objtype for A" );
value--;
}
PLA_Obj_global_length( A, &length_A );
PLA_Obj_global_width ( A, &width_A );
if ( length_A != width_A ) {
PLA_Warning( "A is not square" );
value--;
}
/* Check if x is valid vector */
if ( x == NULL || !PLA_Valid_object( x ) ) {
PLA_Warning( "Invalid object x" );
value--;
}
PLA_Obj_objtype( x, &objtype );
if ( objtype != PLA_MATRIX && objtype != PLA_MVECTOR
&& objtype != PLA_PMVECTOR ) {
PLA_Warning( "Invalid objtype for x" );
value--;
}
PLA_Obj_project_onto( x, &proj_onto );
if ( proj_onto == PLA_PROJ_ONTO_COL ) {
PLA_Obj_global_length( x, &length_x );
PLA_Obj_global_width( x, &width_x );
}
else {
PLA_Obj_global_width( x, &length_x );
PLA_Obj_global_length( x, &width_x );
}
if ( width_x != 1 ) {
PLA_Warning( "x is not of width 1" );
value--;
}
/* Check if beta is valid multiscalar of size 1x1 */
if ( beta == NULL || !PLA_Valid_object( beta ) ) {
PLA_Warning( "Invalid object beta" );
value--;
}
PLA_Obj_objtype( beta, &objtype );
if ( objtype != PLA_MSCALAR ) {
PLA_Warning( "Invalid objtype for beta" );
value--;
}
PLA_Obj_global_length( beta, &size );
if ( size != 1 ) {
PLA_Warning( "Invalid global length for beta" );
value--;
}
PLA_Obj_global_width( beta, &size );
if ( size != 1 ) {
PLA_Warning( "Invalid global width for beta" );
value--;
}
/* Check if y is valid vector */
if ( y == NULL || !PLA_Valid_object( y ) ) {
PLA_Warning( "Invalid object y" );
value--;
}
PLA_Obj_objtype( y, &objtype );
if ( objtype != PLA_MATRIX && objtype != PLA_MVECTOR
&& objtype != PLA_PMVECTOR ) {
PLA_Warning( "Invalid objtype for y" );
value--;
}
PLA_Obj_project_onto( y, &proj_onto );
if ( proj_onto == PLA_PROJ_ONTO_COL ) {
PLA_Obj_global_length( y, &length_y );
PLA_Obj_global_width( y, &width_y );
}
else {
PLA_Obj_global_width( y, &length_y );
PLA_Obj_global_length( y, &width_y );
}
if ( width_y != 1 ) {
PLA_Warning( "y is not of width 1" );
value--;
}
/* Check if dimensions match */
if ( length_A != length_y ) {
PLA_Warning( "length of A does not match length of y" );
value--;
}
if ( width_A != length_x ) {
PLA_Warning( "width of A does not match length of x" );
value--;
}
}
if ( PLA_CHECK_AGAINST_SEQUENTIAL ) {
PLA_Mscalar_create_conf_to(
alpha, PLA_ALL_ROWS, PLA_ALL_COLS, &alpha_cpy );
PLA_Mscalar_create_conf_to(
A, PLA_ALL_ROWS, PLA_ALL_COLS, &A_cpy );
PLA_Mscalar_create_conf_to(
x, PLA_ALL_ROWS, PLA_ALL_COLS, &x_cpy );
PLA_Mscalar_create_conf_to(
beta, PLA_ALL_ROWS, PLA_ALL_COLS, &beta_cpy );
PLA_Mscalar_create_conf_to(
y, PLA_ALL_ROWS, PLA_ALL_COLS, &y_cpy );
PLA_Copy( alpha, alpha_cpy );
PLA_Copy( A, A_cpy );
PLA_Copy( x, x_cpy );
PLA_Copy( beta, beta_cpy );
if ( PLA_Local_equal_zero( beta_cpy ) )
PLA_Obj_set_to_zero( y_cpy );
else
PLA_Copy( y, y_cpy );
}
PLA_Routine_stack_pop( routine_name );
return value;
}