static int DTPUMatCholeskyForward(void* AA, double b[], double x[], int n){
dtpumat* M=(dtpumat*) AA;
ffinteger N=M->n,INCX=1;
double *AP=M->val,*ss=M->sscale;
char UPLO=M->UPLO,TRANS='T',DIAG='N';
dtpuscalevec(1.0,ss,b,x,n);
dtpsv(&UPLO,&TRANS,&DIAG, &N, AP, x, &INCX);
return 0;
}
NLuint nlSolve_GMRES() {
NLdouble* b = nlCurrentContext->b ;
NLdouble* x = nlCurrentContext->x ;
NLdouble eps = nlCurrentContext->threshold ;
NLint max_iter = nlCurrentContext->max_iterations ;
NLint n = nlCurrentContext->n ;
NLint m = nlCurrentContext->inner_iterations ;
typedef NLdouble *NLdoubleP;
NLdouble *V = NL_NEW_ARRAY(NLdouble, n*(m+1) ) ;
NLdouble *U = NL_NEW_ARRAY(NLdouble, m*(m+1)/2 ) ;
NLdouble *r = NL_NEW_ARRAY(NLdouble, n ) ;
NLdouble *y = NL_NEW_ARRAY(NLdouble, m+1 ) ;
NLdouble *c = NL_NEW_ARRAY(NLdouble, m ) ;
NLdouble *s = NL_NEW_ARRAY(NLdouble, m ) ;
NLdouble **v = NL_NEW_ARRAY(NLdoubleP, m+1 ) ;
NLdouble * Ax = NL_NEW_ARRAY(NLdouble,nlCurrentContext->n);
NLdouble accu =0.0;
NLint i, j, io, uij, u0j ;
NLint its = -1 ;
NLdouble beta, h, rd, dd, nrm2b ;
for ( i=0; i<=m; ++i ){
v[i]=V+i*n ;
}
nrm2b=dnrm2(n,b,1);
io=0;
do { /* outer loop */
++io;
nlCurrentContext->matrix_vector_prod(x,r);
daxpy(n,-1.,b,1,r,1);
beta=dnrm2(n,r,1);
dcopy(n,r,1,v[0],1);
dscal(n,1./beta,v[0],1);
y[0]=beta;
j=0;
uij=0;
do { /* inner loop: j=0,...,m-1 */
u0j=uij;
nlCurrentContext->matrix_vector_prod(v[j],v[j+1]);
dgemv(
Transpose,n,j+1,1.,V,n,v[j+1],1,0.,U+u0j,1
);
dgemv(
NoTranspose,n,j+1,-1.,V,n,U+u0j,1,1.,v[j+1],1
);
h=dnrm2(n,v[j+1],1);
dscal(n,1./h,v[j+1],1);
for (i=0; i<j; ++i ) { /* rotiere neue Spalte */
double tmp = c[i]*U[uij]-s[i]*U[uij+1];
U[uij+1] = s[i]*U[uij]+c[i]*U[uij+1];
U[uij] = tmp;
++uij;
}
{ /* berechne neue Rotation */
rd = U[uij];
dd = sqrt(rd*rd+h*h);
c[j] = rd/dd;
s[j] = -h/dd;
U[uij] = dd;
++uij;
}
{ /* rotiere rechte Seite y (vorher: y[j+1]=0) */
y[j+1] = s[j]*y[j];
y[j] = c[j]*y[j];
}
++j;
} while (
j<m && fabs(y[j])>=eps*nrm2b
) ;
{ /* minimiere bzgl Y */
dtpsv(
UpperTriangle,
NoTranspose,
NotUnitTriangular,
j,U,y,1
);
/* correct X */
dgemv(NoTranspose,n,j,-1.,V,n,y,1,1.,x,1);
}
} while ( fabs(y[j])>=eps*nrm2b && (m*(io-1)+j) < max_iter);
/* Count the inner iterations */
its = m*(io-1)+j;
nlCurrentContext->matrix_vector_prod(x,Ax);
for(i = 0 ; i < n ; ++i)
accu+=(Ax[i]-b[i])*(Ax[i]-b[i]);
printf("in OpenNL : ||Ax-b||/||b|| = %e\n",sqrt(accu)/nrm2b);
NL_DELETE_ARRAY(Ax);
NL_DELETE_ARRAY(V) ;
NL_DELETE_ARRAY(U) ;
NL_DELETE_ARRAY(r) ;
NL_DELETE_ARRAY(y) ;
NL_DELETE_ARRAY(c) ;
NL_DELETE_ARRAY(s) ;
NL_DELETE_ARRAY(v) ;
return its;
}
