main()
{
int i,j,n=N,info;
float **aa;
aa = alloc2float(n,n);
for (i=0; i<n; i++)
for (j=0; j<n; j++)
aa[i][j] = 0.0;
for (i=0; i<n; i++) {
aa[i][i] = b[i] = 10*(i+1);
if (i>0) aa[i][i-1] = c[i-1] = i-1;
if (i<n-1) aa[i][i+1] = a[i+1] = i+1;
x[i] = r[i] = i;
}
sgefa(aa,n,ipvt,&info);
sgesl(aa,n,ipvt,x,0);
tridif(n,a,b,c,r,u);
for (i=0; i<n; i++)
printf("x[%d] = %g u[%d] = %g\n",i,x[i],i,u[i]);
}
int volt_step(double *y, double t, double dt, int neq, double *yg, double *yp,
double *yp2, double *ytemp, double *errvec, double *jac) {
int i0, iend, ishift, i, iter = 0, info, ipivot[MAXODE1], j, ind;
int n1 = NODE + 1;
double dt2 = .5 * dt, err;
double del, yold, fac, delinv;
i0 = MAX(0, CurrentPoint - MaxPoints);
iend = MIN(CurrentPoint - 1, MaxPoints - 1);
ishift = i0 % MaxPoints;
init_sums(T0, CurrentPoint, dt, i0, iend,
ishift); /* initialize all the sums */
KnFlag = 0;
for (i = 0; i < neq; i++) {
set_ivar(i + 1, y[i]);
yg[i] = y[i];
}
for (i = NODE; i < NODE + NMarkov; i++)
set_ivar(i + 1 + FIX_VAR, y[i]);
set_ivar(0, t - dt);
for (i = NODE; i < NODE + FIX_VAR; i++)
set_ivar(i + 1, evaluate(my_ode[i]));
for (i = 0; i < NODE; i++) {
if (!EqType[i])
yp2[i] = y[i] + dt2 * evaluate(my_ode[i]);
else
yp2[i] = 0.0;
}
KnFlag = 1;
while (1) {
get_kn(yg, t);
for (i = NODE; i < NODE + FIX_VAR; i++)
set_ivar(i + 1, evaluate(my_ode[i]));
for (i = 0; i < NODE; i++) {
yp[i] = evaluate(my_ode[i]);
/* plintf(" yp[%d]=%g\n",i,yp[i]); */
if (EqType[i])
errvec[i] = -yg[i] + yp[i];
else
errvec[i] = -yg[i] + dt2 * yp[i] + yp2[i];
}
/* Compute Jacobian */
for (i = 0; i < NODE; i++) {
del = NEWT_ERR * MAX(NEWT_ERR, fabs(yg[i]));
yold = yg[i];
yg[i] += del;
delinv = 1. / del;
get_kn(yg, t);
for (j = NODE; j < NODE + FIX_VAR; j++)
set_ivar(j + 1, evaluate(my_ode[j]));
for (j = 0; j < NODE; j++) {
fac = delinv;
if (!EqType[j])
fac *= dt2;
jac[j * NODE + i] = (evaluate(my_ode[j]) - yp[j]) * fac;
}
yg[i] = yold;
}
for (i = 0; i < NODE; i++)
jac[n1 * i] -= 1.0;
sgefa(jac, NODE, NODE, ipivot, &info);
if (info != -1) {
return (-1); /* Jacobian is singular */
}
err = 0.0;
sgesl(jac, NODE, NODE, ipivot, errvec, 0);
for (i = 0; i < NODE; i++) {
err = MAX(fabs(errvec[i]), err);
yg[i] -= errvec[i];
}
if (err < EulTol)
break;
iter++;
if (iter > MaxEulIter)
return (-2); /* too many iterates */
}
/* We have a good point; lets save it */
get_kn(yg, t);
/* for(i=NODE;i<NODE+FIX_VAR;i++)
set_ivar(i+1,evaluate(my_ode[i])); */
for (i = 0; i < NODE; i++)
y[i] = yg[i];
ind = CurrentPoint % MaxPoints;
for (i = 0; i < NODE + FIX_VAR + NMarkov; i++)
Memory[i][ind] = get_ivar(i + 1);
CurrentPoint++;
return (0);
}
void bvshoot(double *y, double *yend, double err, double eps, int maxit,
int *iret, int n, int ishow, int iper, int ipar, int ivar,
double sect) {
double *jac, *f, *fdev, *y0, *y1;
double dev, error, ytemp;
int ntot = n;
int i, istart = 1, j;
int ipvt[MAXODE1];
char esc;
int info, niter = 0;
double dt = DELTA_T, t;
double t0 = T0;
double t1 = T0 + TEND * dt / fabs(dt);
if (iper)
ntot = n + 1;
jac = (double *)malloc(ntot * ntot * sizeof(double));
f = (double *)malloc(ntot * sizeof(double));
fdev = (double *)malloc(ntot * sizeof(double));
y0 = (double *)malloc(ntot * sizeof(double));
y1 = (double *)malloc(ntot * sizeof(double));
for (i = 0; i < n; i++)
y0[i] = y[i];
if (iper)
get_val(upar_names[ipar], &y0[n]);
/* dt=(t1-t0)/nt; */
while (1) {
esc = my_abort();
{
if (esc == ESC) {
*iret = ABORT;
break;
}
if (esc == '/') {
*iret = ABORT_ALL;
break;
}
}
t = t0;
istart = 1;
if (iper)
set_val(upar_names[ipar], y0[n]);
if (ishow) {
integrate(&t, y, TEND, DELTA_T, 1, NJMP, &istart);
} else {
if (ode_int(y, &t, &istart) == 0) {
*iret = -4;
goto bye;
}
}
for (i = 0; i < n; i++) {
y1[i] = y[i];
/* plintf("%f \n",y[i]); */
}
do_bc(y0, t0, y1, t1, f, n);
if (iper)
f[n] = y1[ivar] - sect;
error = 0.0;
for (i = 0; i < ntot; i++)
error += fabs(f[i]);
if (error < err) {
for (i = 0; i < n; i++)
y[i] = y0[i]; /* Good values .... */
if (iper) {
set_val(upar_names[ipar], y0[n]);
redraw_params();
}
for (i = 0; i < n; i++)
yend[i] = y1[i];
*iret = GOODSHOT;
goto bye;
}
/* plintf("err1 = %f tol= %f \n",error,err); */
niter++;
if (niter > maxit) {
*iret = -2;
goto bye;
} /* Too many iterates */
/* create the Jacobian matrix ... */
for (j = 0; j < ntot; j++) {
for (i = 0; i < n; i++)
y[i] = y0[i];
if (fabs(y0[j]) < eps)
dev = eps * eps;
else
dev = eps * fabs(y0[j]);
if (j < n)
y[j] = y[j] + dev;
ytemp = y0[j];
y0[j] = y0[j] + dev;
if (j == n)
set_val(upar_names[ipar], y0[j]);
t = t0;
istart = 1;
if (ode_int(y, &t, &istart) == 0) {
*iret = -4;
goto bye;
}
do_bc(y0, t0, y, t1, fdev, n);
if (iper)
fdev[n] = y[ivar] - sect;
y0[j] = ytemp;
for (i = 0; i < ntot; i++)
jac[j + i * ntot] = (fdev[i] - f[i]) / dev;
}
sgefa(jac, ntot, ntot, ipvt, &info);
if (info != -1) {
*iret = -3;
goto bye;
}
for (i = 0; i < ntot; i++)
fdev[i] = f[i];
sgesl(jac, ntot, ntot, ipvt, fdev, 0);
error = 0.0;
for (i = 0; i < ntot; i++) {
y0[i] = y0[i] - fdev[i];
error += fabs(fdev[i]);
}
for (i = 0; i < n; i++)
y[i] = y0[i];
/* plintf("error2 = %f \n",error); */
if (error < 1.e-10) {
for (i = 0; i < n; i++)
yend[i] = y1[i];
*iret = 2;
goto bye;
}
}
bye:
free(f);
free(y1);
free(y0);
free(jac);
free(fdev);
}
void test03 ( int n )
/******************************************************************************/
/*
Purpose:
TEST03 runs the revised version of SGEFA in sequential mode.
Modified:
07 April 2008
Author:
John Burkardt
*/
{
float *a;
float *b;
float err;
int i;
int info;
int *ipvt;
int job;
int lda;
double wtime;
float *x;
/*
Generate the linear system A * x = b.
*/
lda = n;
a = ( float * ) malloc ( lda * n * sizeof ( float ) );
b = ( float * ) malloc ( n * sizeof ( float ) );
x = ( float * ) malloc ( n * sizeof ( float ) );
matgen ( lda, n, a, x, b );
/*
Factor the linear system.
*/
ipvt = ( int * ) malloc ( n * sizeof ( int ) );
wtime = omp_get_wtime ( );
info = msgefa2 ( a, lda, n, ipvt );
wtime = omp_get_wtime ( ) - wtime;
if ( info != 0 )
{
printf ( "\n" );
printf ( "TEST03 - Fatal error!\n" );
printf ( " MSGEFA2 reports the matrix is singular.\n" );
exit ( 1 );
}
/*
Solve the linear system.
*/
job = 0;
sgesl ( a, lda, n, ipvt, b, job );
err = 0.0;
for ( i = 0; i < n; i++ )
{
err = err + fabs ( x[i] - b[i] );
}
printf ( " Revised Sequential %8d %10.4e \n", n, err );
free ( a );
free ( b );
free ( ipvt );
free ( x );
return;
}