MAT *mmtr_mlt(const MAT *A, const MAT *B, MAT *OUT)
#endif
{
int i, j, limit;
/* Real *A_row, *B_row, sum; */
if ( ! A || ! B )
error(E_NULL,"mmtr_mlt");
if ( A == OUT || B == OUT )
error(E_INSITU,"mmtr_mlt");
if ( A->n != B->n )
error(E_SIZES,"mmtr_mlt");
if ( ! OUT || OUT->m != A->m || OUT->n != B->m )
OUT = m_resize(OUT,A->m,B->m);
limit = A->n;
for ( i = 0; i < A->m; i++ )
for ( j = 0; j < B->m; j++ )
{
OUT->me[i][j] = __ip__(A->me[i],B->me[j],(int)limit);
/**************************************************
sum = 0.0;
A_row = A->me[i];
B_row = B->me[j];
for ( k = 0; k < limit; k++ )
sum += (*A_row++)*(*B_row++);
OUT->me[i][j] = sum;
**************************************************/
}
return OUT;
}
VEC *mv_mlt(const MAT *A, const VEC *b, VEC *out)
#endif
{
unsigned int i, m, n;
Real **A_v, *b_v /*, *A_row */;
/* register Real sum; */
if ( A==(MAT *)NULL || b==(VEC *)NULL )
error(E_NULL,"mv_mlt");
if ( A->n != b->dim )
error(E_SIZES,"mv_mlt");
if ( b == out )
error(E_INSITU,"mv_mlt");
if ( out == (VEC *)NULL || out->dim != A->m )
out = v_resize(out,A->m);
m = A->m; n = A->n;
A_v = A->me; b_v = b->ve;
for ( i=0; i<m; i++ )
{
/* for ( j=0; j<n; j++ )
sum += A_v[i][j]*b_v[j]; */
out->ve[i] = __ip__(A_v[i],b_v,(int)n);
/**************************************************
A_row = A_v[i]; b_v = b->ve;
for ( j=0; j<n; j++ )
sum += (*A_row++)*(*b_v++);
out->ve[i] = sum;
**************************************************/
}
return out;
}
static VEC *Umlt(const MAT *U, const VEC *x, VEC *out)
#endif
{
int i, limit;
if ( U == MNULL || x == VNULL )
error(E_NULL,"Umlt");
limit = min(U->m,U->n);
if ( limit != x->dim )
error(E_SIZES,"Umlt");
if ( out == VNULL || out->dim < limit )
out = v_resize(out,limit);
for ( i = 0; i < limit; i++ )
out->ve[i] = __ip__(&(x->ve[i]),&(U->me[i][i]),limit - i);
return out;
}
VEC *Usolve(const MAT *matrix, const VEC *b, VEC *out, double diag)
{
unsigned int dim /* , j */;
int i, i_lim;
MatrixReal **mat_ent, *mat_row, *b_ent, *out_ent, *out_col, sum, tiny;
if ( matrix==MNULL || b==VNULL )
error(E_NULL,"Usolve");
dim = mat_min(matrix->m,matrix->n);
if ( b->dim < dim ){
printf("b->dim = %d; dim = %d\n", b->dim, dim);
error(E_SIZES,"Usolve");
}
if ( out==VNULL || out->dim < dim )
out = v_resize(out,matrix->n);
mat_ent = matrix->me; b_ent = b->ve; out_ent = out->ve;
tiny = (10.0/HUGE_VAL);
for ( i=dim-1; i>=0; i-- )
if ( b_ent[i] != 0.0 )
break;
else
out_ent[i] = 0.0;
i_lim = i;
for ( ; i>=0; i-- )
{
sum = b_ent[i];
mat_row = &(mat_ent[i][i+1]);
out_col = &(out_ent[i+1]);
sum -= __ip__(mat_row,out_col,i_lim-i);
if ( diag==0.0 )
{
if ( fabs(mat_ent[i][i]) <= tiny*fabs(sum) )
error(E_SING,"Usolve");
else
out_ent[i] = sum/mat_ent[i][i];
}
else
out_ent[i] = sum/diag;
}
return (out);
}
VEC *Lsolve(const MAT *matrix, const VEC *b, VEC *out, double diag)
{
unsigned int dim, i, i_lim /* , j */;
MatrixReal **mat_ent, *mat_row, *b_ent, *out_ent, *out_col, sum, tiny;
if ( matrix==(MAT *)NULL || b==(VEC *)NULL )
error(E_NULL,"Lsolve");
dim = mat_min(matrix->m,matrix->n);
if ( b->dim < dim )
error(E_SIZES,"Lsolve");
if ( out==(VEC *)NULL || out->dim < dim )
out = v_resize(out,matrix->n);
mat_ent = matrix->me; b_ent = b->ve; out_ent = out->ve;
for ( i=0; i<dim; i++ )
if ( b_ent[i] != 0.0 )
break;
else
out_ent[i] = 0.0;
i_lim = i;
tiny = (10.0/HUGE_VAL);
for ( ; i<dim; i++ )
{
sum = b_ent[i];
mat_row = &(mat_ent[i][i_lim]);
out_col = &(out_ent[i_lim]);
sum -= __ip__(mat_row,out_col,(int)(i-i_lim));
if ( diag==0.0 )
{
if ( fabs(mat_ent[i][i]) <= tiny*fabs(sum) )
error(E_SING,"Lsolve");
else
out_ent[i] = sum/mat_ent[i][i];
}
else
out_ent[i] = sum/diag;
}
return (out);
}
MAT *hhtrrows(MAT *M, unsigned int i0, unsigned int j0,
const VEC *hh, double beta)
#endif
{
Real ip, scale;
int i /*, j */;
if ( M==MNULL || hh==VNULL )
error(E_NULL,"hhtrrows");
if ( M->n != hh->dim )
error(E_RANGE,"hhtrrows");
if ( i0 > M->m || j0 > M->n )
error(E_BOUNDS,"hhtrrows");
if ( beta == 0.0 ) return (M);
/* for each row ... */
for ( i = i0; i < M->m; i++ )
{ /* compute inner product */
ip = __ip__(&(M->me[i][j0]),&(hh->ve[j0]),(int)(M->n-j0));
/**************************************************
ip = 0.0;
for ( j = j0; j < M->n; j++ )
ip += M->me[i][j]*hh->ve[j];
**************************************************/
scale = beta*ip;
if ( scale == 0.0 )
continue;
/* do operation */
__mltadd__(&(M->me[i][j0]),&(hh->ve[j0]),-scale,
(int)(M->n-j0));
/**************************************************
for ( j = j0; j < M->n; j++ )
M->me[i][j] -= scale*hh->ve[j];
**************************************************/
}
return (M);
}
/* _in_prod -- inner product of two vectors from i0 downwards */
double _in_prod(VEC *a,VEC *b,u_int i0)
{
u_int limit;
/* Real *a_v, *b_v; */
/* register Real sum; */
if ( a==(VEC *)NULL || b==(VEC *)NULL )
error(E_NULL,"_in_prod");
limit = min(a->dim,b->dim);
if ( i0 > limit )
error(E_BOUNDS,"_in_prod");
return __ip__(&(a->ve[i0]),&(b->ve[i0]),(int)(limit-i0));
/*****************************************
a_v = &(a->ve[i0]); b_v = &(b->ve[i0]);
for ( i=i0; i<limit; i++ )
sum += a_v[i]*b_v[i];
sum += (*a_v++)*(*b_v++);
return (double)sum;
******************************************/
}
VEC *mv_mltadd(const VEC *v1, const VEC *v2, const MAT *A,
double alpha, VEC *out)
#endif
{
/* register int j; */
int i, m, n;
Real *v2_ve, *out_ve;
if ( ! v1 || ! v2 || ! A )
error(E_NULL,"mv_mltadd");
if ( out == v2 )
error(E_INSITU,"mv_mltadd");
if ( v1->dim != A->m || v2->dim != A->n )
error(E_SIZES,"mv_mltadd");
tracecatch(out = v_copy(v1,out),"mv_mltadd");
v2_ve = v2->ve; out_ve = out->ve;
m = A->m; n = A->n;
if ( alpha == 0.0 )
return out;
for ( i = 0; i < m; i++ )
{
out_ve[i] += alpha*__ip__(A->me[i],v2_ve,(int)n);
/**************************************************
A_e = A->me[i];
sum = 0.0;
for ( j = 0; j < n; j++ )
sum += A_e[j]*v2_ve[j];
out_ve[i] = v1->ve[i] + alpha*sum;
**************************************************/
}
return out;
}
