Добавил:
Upload
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:
/* file dif6.cpp */
//#include <process.h>
//#include <conio.h>
//#include <alloc.h>
#include <stdlib.h>
#include <stdio.h>
#include <math.h>
//#include <graphics.h>
#include "dif6.h"
static double xi[6];/*defines spatial lattice point,
may be used in user's functions*/
static double hm[6];/*defines spatial lattice step-back:
may be used in user's functions*/
static double hp[6];/*defines spatial lattice step-forward:
may be used in user's functions*/
static double tminus,tplus,delt;/*define accordingly initial time value,
final time value and time step: may be used in user's functions*/
static int multiindex[6];/*defines multiindex, corresponding to vector
xi[6], may be used in user's functions*/
static double al[6][3],be[6][3],alt[3],bet[3],xbound[6][2],*solution,
(*pfunc)(int nbound,int i,double x[],int n,double t),
(*pfund)(int nbound,int i,double x[],int n,double t),
(*pfune)(int nbound,int i,double x[],int n,double t),
(*pfuna)(int i,double x[],int n,double t,double xi[],double hm[],double hp[],
int multiindex[],double tminus,double tplus);
static int ng[6],nt,ix[6],ifunp[8][6],ifunq[8][6],ig[2],nbound,d0,d1,d2,d3,d4;
void dif6(double (*funk)(int i,double x[],int n,double t,double xi[],
double hm[],double hp[],int multiindex[],double tminus,
double tplus),
double (*funa)(int i,double x[],int n,double t,
double xi[],double hm[],double hp[],int multiindex[],
double tminus,double tplus),
double (*funb)(int i,double x[],int n,double t,
double xi[],double hm[],double hp[],int multiindex[],
double tminus,double tplus),
double (*fung)(int i,double x[],int n,double t,
double xi[],double hm[],double hp[],int multiindex[],
double tminus,double tplus),
double (*funf)(int i,double x[],int n,double t,
double xi[],double hm[],double hp[],int multiindex[],
double tminus,double tplus),
double (*func)(int nbound,int i,double x[],int n,double t),
double (*fund)(int nbound,int i,double x[],int n,double t),
double (*fune)(int nbound,int i,double x[],int n,double t),
double (*funu0)(int i,double x[],int n,double t,
double xi[],double hm[],double hp[],int multiindex[],
double tminus,double tplus),
void (*out)(int iter,int noftau,double t1,double *dt,
int n,int mi[],double solution[],double xmi[],int *iterm),
void (*inform)(int *ind,int ifunk[][6],int ifuna[][6],int ifunb[][6],
int ifung[][6],int ifunf[][6]),
int n,int mi[],double xmi[],double t0,int noftau,double sig[],
int ntime,int nspace[],int nappr,int ind,double tau,int *iterm)
// НАЗНАЧЕНИЕ: В n-мерном пространственном параллелепипеде найти решение
// нестационарной задачи общего параболического типа.
// ВХОДНЫЕ ПАРАМЕТРЫ
// double (*funk)(),(*funa)(),(*funb)(),(*fung)(),(*funf)();
//внешние имена задаваемых пользователем функций для вычисления функциональных
// коэффициентов уравнения. Эти функции могут иметь любые имена, но у каждой
// список параметров должен включать входные параметры i,x,n,t, где i-индекс
// функции(индексирование начинается с i=0),
// x[n]-векторный аргумент функции,n-размерность вектора x, t-скалярный
// аргумент функции, xi[n] - текущая точка в прострастве параметров,
// hm[n] - шаг назад из точки xi, hp[n] - шаг вперед из точки xi,
// multiindex[n] - мультииндекс, компоненты этого вектора определяют индексы
// компонент вектора xi, tminus - точка на оси времени, в которой
// решение было вычислено на предыдущем шаге, tplus - точка на оси времени,
// в которой решение вычисляется на текущем шаге,
// Для функций funk,funf,fung параметр i является пустым.
// Спецификация каждой функции имеет вид:
// double fun(int i,double x[],int n,double t,
// double xi[],double hm[],double hp[],int multiindex[],
// double tminus,double tplus)
// int i; ( index of function )
// int n; ( dimension of spatial parameter space )
// double x[];(point in parameter space,input vector of lenth n)
// double t; (time point )
// double xi[];(knot point in parameter space,input vector of lenth n)
// double hm[];(spatial lattice step-back from knot point xi[],
// input vector of lenth n)
// double hp[];(spatial lattice step-forward from knot point xi[],
// input vector of lenth n)
// int multiindex[];(indices of spatial knots corresponding to
// components of vector xi[],
// input vector of lenth n)
// double tminus; initial time value
// double tplus; final time value
//
//
// double (*func)(),(*fund)(),(*fune)();
//внешние имена задаваемых пользователем функций для вычисления функциональных
// коэффициентов, определяющих граничные условия. Эти функции могут иметь
// любые имена. У каждой функции список параметров должен включать входные
// параметры nbound,i,x,n,t, где nbound -
// индекс границы(nbound=0 - левая граница, nbound=1 - правая граница),
// остальные параметры имеют тот же смысл, что и в специ-
// фикации функций funk,funa,funf
// Спецификация каждой функции имеет вид:
// double fun(int nbound,int i,double x[],int n,double t)
// double (*funu0)();
// внешнее имя задаваемой пользователем функции для вычисления функционального
// коэффициента, определяющего начальное условие. Эта функция может иметь
// любое имя. Список параметров должен включать те же параметры,
// что и в спецификации функций funk,funa,funf, причем параметры i и t явля-
// ются пустыми
// Спецификация функции имеет вид:
// double funu0(int i,double x[],int n,double t,
// double xi[],double hm[],double hp[],int multiindex[],
// double tminus,double tplus)
// void (*out)();
// внешнее имя задаваемой пользователем подпрограммы для обработки
// массивов данных, полученных на фиксированном временном слое.
// Спецификация функции имеет вид:
// void out(int iter,int noftau,double t1,double *dt,
// int n,int mi[],double solution[],double xmi[],int *iterm)
// int iter; ( number of time iterations )
// int noftau; ( maximal number of time iterations )
// double t1; (time point )
// double *dt; (time step used to reach time point t1, value of *dt
// may be changed by function out)
// int n; ( dimension of spatial parameter space )
// int mi[]; ( description of parameter see lower )
// double solution[];(represent solution of equation at time t1,
// 6-dimensional vector is represented in
// linear form on rows)
// double xmi[];( description of parameter see lower)
// int *iterm;( description of parameter see lower)
//
// void (*inform)();
// внешнее имя задаваемой пользователем подпрограммы для задания информации
// о функциональной зависимости коэффициентов уравнения.
// Спецификация функции имеет вид:
// void inform(int *ind,int ifunk[8][6],int ifuna[8][6],int ifunb[][6],
// int ifung[][6],int ifunf[8][6])
// int *ind; ( indicator for information about functional dependence of
// functional coefficients of equation:
// *ind=1 means, that this information must be prepared by user;
// *ind=0 means, that this information is not given by user, in this
// case the body of function must contain only operator: *ind=0; )
// int ifunk[][6],ifuna[][6],ifunb[][6],ifung[][6],ifunf[][6];
// ( Name of each massive corresponds to the name of appropriate input
// function. The second index of massive means the index of function.
// The first index of massive defines the functional dependence of
// function by following rules:
// ifun[7][i]=0 means,that i-st function,named fun,does't depend on time;
// ifun[7][i]=1 means,that i-st function,named fun, depends on time;
// ifun[6][i]=0 means,that i-st function,named fun,does't depend on
// all spatial variables;
// ifun[6][i]=1 means,that i-st function,named fun, depends on
// all spatial variables;
// If ifun[6][i]=1,user must characterize the functional dependence of
// function on each spatial variable by following rules:
// ifun[j][i]=0 means,that i-st function,named fun,does't depend on
// j-st spatial variable;
// ifun[j][i]=1 means,that i-st function,named fun, depends on
// j-st spatial variables;
//
// int n; размерность пространства, 1<=n<=6.
// int mi[]; вектор длины 6, входное значение mi[i] есть число узловых
// значений i-ой пространственной переменной.
// double xmi[]; вектор длины mi[0]+...+mi(n)+(6-n) - представляет в
// линейной форме узловые значения по каждой пространственной переменной.
// double t0; начальное значение времени
// int noftau; максимально допустимое число шагов по времени.
// double sig[]; вектор длины n, вес разностной схемы, используемый при
// дискретизации по i-ой пространственной переменной;
// sig=0.5 - схема Кранка-Николсона;
// sig=1. - чисто неявная схема ;
// допускаются также любые значения в интервале (0,1).
// int ntime; порядок квадратурной формулы Гаусса при интегрировании по
// времени. Допускаются значения ntime=1,2,3.
// int nspace[]; вектор длины n. Значение nspace[i] - порядок
// квадратурной формулы Гаусса при интегрировании по i-ой пространственной
// переменной. Допускаются значения nspace[i]=1,2,3.
// int nappr; порядок разностной аппроксимации дифференциального оператора
// по пространственным переменным;
// nappr=1 - решается нестационарная задача;
// nappr=2 - решается стационарная задача;
// int ind; параметр, характеризующий гладкость начальных данных по простран-
//ственным переменным;ind=0-данные непрерывны;ind=1-данные кусочно непрерывны;
//double tau; начальный шаг по времени.
// ВЫХОДНЫЕ ПАРАМЕТРЫ
// int *iterm; код возврата после завершения итераций, указывает на условие
// окончания, которое вызвало остановку алгоритма:
// *iterm=1: выполнение программы прекращено из-за того,что превышено
// допустимое число шагов по времени;
// *iterm=2: выполнение программы прекращено подпрограммой out;
// МЕТОД:Уравнение решается разностным методом
{
double *h,*z,*bp,*bm,*e,*f,*g,*v,x[6],t,t1,dt;
int ifunu0[8][6],l1,l2,m,i,j,i0,i1,i2,i3,i4,i5,iter;
int ifunk[8][6],ifuna[8][6],ifunf[8][6],ifunb[8][6],ifung[8][6];
i=0;for(m=0;m<n;m++)i=i>mi[m]?i:mi[m];
//extern void (*_new_handler)(); _new_handler = n_enough_memory;
h=new double[i];z=new double[i];bp=new double[i];
bm=new double[i];e=new double[i];f=new double[i];
g=new double[i];v=new double[i];
pfune=fune; pfund=fund; pfunc=func; pfuna=funa;
for(i=0;i<8;i++)for(j=0;j<6;j++){ifunk[i][j]=1;ifunf[i][j]=1;ifuna[i][j]=1;
ifunb[i][j]=1;ifung[i][j]=1;}
(*inform)(&m,ifunk,ifuna,ifunb,ifung,ifunf);
if(m==0){for(i=0;i<8;i++)for(j=0;j<6;j++)
{ifunk[i][j]=1;ifunf[i][j]=1;ifuna[i][j]=1;ifunb[i][j]=1;ifung[i][j]=1;}}
gauss(ntime,nspace,n);
for(m=n;m<6;mi[m]=1,m++);
d0=mi[1]*mi[2]*mi[3]*mi[4]*mi[5]; d1=mi[2]*mi[3]*mi[4]*mi[5];
d2=mi[3]*mi[4]*mi[5]; d3=mi[4]*mi[5];d4=mi[5];
solution=new double[d0*mi[0]];
ix[0]=0; for(m=1;m<6;ix[m]=ix[m-1]+mi[m-1],m++);
/* Form the boundary data. */
for(i=0;i<n;i++)
{l1=ix[i];l2=ix[i]+mi[i]-1;xbound[i][0]=xmi[l1];xbound[i][1]=xmi[l2];
for(j=0;j<8;j++)
{ifunu0[j][i] =1;if(i==j) ifunq[j][i]=0;else {ifunq[j][i]=1;}
if(i==j) ifunp[j][i]=0; else {ifunp[j][i]=1;}
}
}
/* Form the initial data. */
for(i5=0;i5<mi[5];i5++){wsp(5,i5,xmi,mi);
for(i4=0;i4<mi[4];i4++){wsp(4,i4,xmi,mi);
for(i3=0;i3<mi[3];i3++){wsp(3,i3,xmi,mi);
for(i2=0;i2<mi[2];i2++){wsp(2,i2,xmi,mi);
for(i1=0;i1<mi[1];i1++){wsp(1,i1,xmi,mi);
for(i0=0;i0<mi[0];i0++){wsp(0,i0,xmi,mi);
if(ind==1) solution[i0*d0+i1*d1+i2*d2+i3*d3+i4*d4+i5]=
tksi(funu0,0,t0,n,ifunu0,0,5,x,xi,hm,hp,multiindex,tminus,tplus);
else solution[i0*d0+i1*d1+i2*d2+i3*d3+i4*d4+i5]=
(*funu0)(i,xi,n,t0,xi,hm,hp,multiindex,t0,t0+dt);}}}}}}
/* Time iteration . */ iter=n;
iter=0; t1=t0;dt=tau;*iterm=0;
while(*iterm==0) {iter=iter+1;t=t1;
tstep(funk,funa,funb,fung,funf,ifunk,ifuna,ifunb,ifung,ifunf,
n,mi,xmi,t,dt,sig,nappr,x,h,z,bp,bm,e,f,g,v); t1=t+dt;
/* Time step performed. Examine the results. */
(*out)(iter,noftau,t1,&dt,n,mi,solution,xmi,iterm);}
delete h;delete z;delete bp;delete bm;delete e;
delete f;delete g;delete v;delete solution;
}
static void tstep(double (*funk)(int i,double x[],int n,double t,
double xi[],double hm[],double hp[],int multiindex[],
double tminus,double tplus),
double (*funa)(int i,double x[],int n,double t,
double xi[],double hm[],double hp[],int multiindex[],
double tminus,double tplus),
double (*funb)(int i,double x[],int n,double t,
double xi[],double hm[],double hp[],int multiindex[],
double tminus,double tplus),
double (*fung)(int i,double x[],int n,double t,
double xi[],double hm[],double hp[],int multiindex[],
double tminus,double tplus),
double (*funf)(int i,double x[],int n,double t,
double xi[],double hm[],double hp[],int multiindex[],
double tminus,double tplus),
int ifunk[][6],int ifuna[][6],int ifunb[][6],
int ifung[][6],int ifunf[][6],
int n,int mi[],double xmi[],double t0,double tau,
double sig[],int nappr,double x[],double h[],double z[],
double bp[],double bm[],double e[],double f[],
double g[],double v[])
{double q[2],ro[2];
int mm,ii,l,m,i,j,i0,i1,i2,i3,i4,i5,ii0,ii1,ii2,ii3,ii4,ii5;
char *pm; pm=(char*)calloc(21,sizeof(char));
tminus = t0;tplus=t0+tau;delt = tau;
for(i=0;i<n;i++) { /*spacial iteration. */
for(m=0;m<6;m++)if(m==i)ix[m]=1;else ix[m]=mi[m];
ii0=ix[0];ii1=ix[1];ii2=ix[2]; ii3=ix[3];ii4=ix[4];ii5=ix[5];ix[0]=0;
for(m=1;m<6;m++)ix[m]=ix[m-1]+mi[m-1];ii=mi[i];
for(j=1;j<ii;j++){l=ix[i]+j;h[j]=xmi[l]-xmi[l-1];}
for(i5=0;i5<ii5;i5++){wsp(5,i5,xmi,mi);
for(i4=0;i4<ii4;i4++){wsp(4,i4,xmi,mi);
for(i3=0;i3<ii3;i3++){wsp(3,i3,xmi,mi);
for(i2=0;i2<ii2;i2++){wsp(2,i2,xmi,mi);
for(i1=0;i1<ii1;i1++){wsp(1,i1,xmi,mi);
for(i0=0;i0<ii0;i0++){wsp(0,i0,xmi,mi);
mm=mi[i]; for(m=0;m<mm;m++)
{wsp(i,m,xmi,mi);/* The lattice vector argument now computed together with
vector step - plus and vector step - minus. */
if(i==0) v[m]=solution[m*d0+i1*d1+i2*d2+i3*d3+i4*d4+i5];
else if(i==1)v[m]=solution[i0*d0+m*d1+i2*d2+i3*d3+i4*d4+i5];
else if(i==2)v[m]=solution[i0*d0+i1*d1+m*d2+i3*d3+i4*d4+i5];
else if(i==3)v[m]=solution[i0*d0+i1*d1+i2*d2+m*d3+i4*d4+i5];
else if(i==4)v[m]=solution[i0*d0+i1*d1+i2*d2+i3*d3+m*d4+i5];
else v[m]=solution[i0*d0+i1*d1+i2*d2+i3*d3+i4*d4+m];
/* Compute the eliminal coefficients. */
e[m]=progco(funk,i,n,ifunk,t0,tau,i,5,x,xi,hm,hp,multiindex,tminus,tplus);
if(i==0)
{f[m]=progco(funf,i,n,ifunf,t0,tau,i,5,x,xi,hm,hp,multiindex,tminus,tplus);
g[m]=progco(fung,i,n,ifung,t0,tau,i,5,x,xi,hm,hp,multiindex,tminus,tplus);}
else{g[m]=0.;f[m]=0.;}
if(m!=0) {
z[m]=progco(funa,i,n,ifuna,t0,tau,i,3,x,xi,hm,hp,multiindex,tminus,tplus);
if(nappr==2)z[m]+=0.5*h[m]*
progco(fung,i,n,ifung,t0,tau,i,4,x,xi,hm,hp,multiindex,tminus,tplus);
bm[m]=progco(funb,i,n,ifunb,t0,tau,i,1,x,xi,hm,hp,multiindex,tminus,tplus);
}
if(m!=mm-1)
bp[m]=progco(funb,i,n,ifunb,t0,tau,i,2,x,xi,hm,hp,multiindex,tminus,tplus);
/* Compute the boundary conditions */
if(m==0){nbound=0;
q[0]=progco(funq,i,n,ifunq,t0,tau,i,5,x,xi,hm,hp,multiindex,tminus,tplus);
ro[0]=progco(funp,i,n,ifunp,t0,tau,i,5,x,xi,hm,hp,multiindex,tminus,tplus);}
if(m==mm-1){nbound=1;
q[1]=progco(funq,i,n,ifunq,t0,tau,i,5,x,xi,hm,hp,multiindex,tminus,tplus);
ro[1]=progco(funp,i,n,ifunp,t0,tau,i,5,x,xi,hm,hp,multiindex,tminus,tplus);}
}
/* The eliminal coefficients are now computed. */
raz1(mm,h,ig,sig[i],tau,q,ro,e,z,bp,bm,g,f,v);
/* One-dimensional approximation is performed. */
switch(i)
{case 0:for(m=0;m<mm;solution[m*d0+i1*d1+i2*d2+i3*d3+i4*d4+i5]=v[m],m++);break;
case 1:for(m=0;m<mm;solution[i0*d0+m*d1+i2*d2+i3*d3+i4*d4+i5]=v[m],m++);break;
case 2:for(m=0;m<mm;solution[i0*d0+i1*d1+m*d2+i3*d3+i4*d4+i5]=v[m],m++);break;
case 3:for(m=0;m<mm;solution[i0*d0+i1*d1+i2*d2+m*d3+i4*d4+i5]=v[m],m++);break;
case 4:for(m=0;m<mm;solution[i0*d0+i1*d1+i2*d2+i3*d3+m*d4+i5]=v[m],m++);break;
case 5:for(m=0;m<mm;solution[i0*d0+i1*d1+i2*d2+i3*d3+i4*d4+m]=v[m],m++);break;
default: break;}
} } } } } } }
free((void*)pm); } /*return for tstep */
static void wsp(int nc,int ind,double xmi[],int mi[])
{int l;if(mi[nc]==1)return;l=ix[nc]+ind; xi[nc]=xmi[l];multiindex[nc]=ind;
if(ind!=0) hm[nc]=xi[nc]-xmi[l-1]; else hm[nc]=0.;
if(ind!=mi[nc]-1) hp[nc]=xmi[l+1]-xi[nc]; else hp[nc]=0.;
} /* return for wsp */
static double funq(int i,double x[],int n,double t,
double xi[],double hm[],double hp[],int multiindex[],
double tminus,double tplus)
{double s,ZERO=0.; x[i]=xbound[i][nbound];s=(*pfund)(nbound,i,x,n,t);
if(s!=ZERO){ig[nbound]=1;
s=(*pfuna)(i,x,n,t,xi,hm,hp,multiindex,tminus,tplus)*
(*pfune)(nbound,i,x,n,t)/s;}
else {ig[nbound]=0;s=(*pfune)(nbound,i,x,n,t);}return s; }
static double funp(int i,double x[],int n,double t,
double xi[],double hm[],double hp[],int multiindex[],
double tminus,double tplus)
{double s,ZERO=0.; x[i]=xbound[i][nbound];s=(*pfund)(nbound,i,x,n,t);
if(s!=ZERO){
s=(*pfuna)(i,x,n,t,xi,hm,hp,multiindex,tminus,tplus)*
(*pfunc)(nbound,i,x,n,t)/s;}
else {s=(*pfunc)(nbound,i,x,n,t);}return s; }
static void gauss(int ntime,int nspace[],int n)
{int i;nt=ntime; wgauss(ntime,alt,bet);
for(i=0;i<n;i++){ wgauss(nspace[i],al[i],be[i]);ng[i]=nspace[i];}}
static void wgauss(int n,double ak[],double sk[])
{switch(n){case 0:ak[0]=1.;sk[0]=0.5;break;case 1:ak[0]=1.;sk[0]=0.5;break;
case 2:ak[0]=0.5;ak[1]=ak[0];sk[0]=0.78867515;sk[1]=0.21132485;break;
case 3:ak[0]=4./9.;ak[1]=5./18.;ak[2]=5./18.;sk[0]=0.5;
sk[1]=0.88729835;sk[2]=0.11270165;break;default:break;}}
static double funfi(double t) {return 1./delt;}
static double progco(double (*fun)(int i,double x[],int n,double t,
double xi[],double hm[],double hp[],int multiindex[],
double tminus,double tplus),
int i,int n,int ifun[][6],double t0,double tau,int j,int k,double x[],
double xi[],double hm[],double hp[],int multiindex[],
double tminus,double tplus)
{int m;double res,argt,s1;
if(nt==0)
return tksi(fun,i,t0+tau,n,ifun,j,k,x,xi,hm,hp,multiindex,tminus,tplus);
if(ifun[6][i]==0&&ifun[7][i]==0)
/* Fun does not depend on spacial and time variables. */
{res=(*fun)(i,x,n,t0,xi,hm,hp,multiindex,tminus,tplus);
return((k==4)?(-res*hm[j]*0.3333333):res);}
if(ifun[7][i]==0)
return tksi(fun,i,t0+tau,n,ifun,j,k,x,xi,hm,hp,multiindex,tminus,tplus);
/* Fun does not depend on time variable. */
res=0.;for(m=0;m<nt;m++){argt=t0+tau*bet[m];
if(ifun[6][i]!=0)
s1=tksi(fun,i,argt,n,ifun,j,k,x,xi,hm,hp,multiindex,tminus,tplus);
else
s1=(*fun)(i,x,n,argt,xi,hm,hp,multiindex,tminus,tplus);
res+=alt[m]*s1*funfi(argt);}
res*=tau; return((k==4&&ifun[6][i]==0)?(-res*hm[j]*0.3333333):res);
}
static double tksi(double (*fun)(int i,double x[],int n,double t,
double xi[],double hm[],double hp[],int multiindex[],
double tminus,double tplus),
int i,double t,int n,int ifun[][6],int j,int k,double x[],double xi[],
double hm[],double hp[],int multiindex[],double tminus,double tplus)
{int njj,l;double res;
if(k==5)return tjksi(0,fun,i,t,n,ifun,-1,x,xi,hm,hp,multiindex,tminus,tplus);
if(ifun[j][i]==0) {x[j]=xi[j];
return tjksi(0,fun,i,t,n,ifun,j,x,xi,hm,hp,multiindex,tminus,tplus);}
res=0.;if(ng[j]==0) njj=1; else njj=ng[j];
for(l=0;l<njj;l++)
{x[j]=xi[j]-hm[j]*be[j][l];
res+=al[j][l]*tjksi(0,fun,i,t,n,ifun,j,x,xi,hm,hp,multiindex,tminus,tplus);}
return res; }
static double tjksi(int nvar,double (*fun)(int i,double x[],int n,double t,
double xi[],double hm[],double hp[],int multiindex[],
double tminus,double tplus),
int i,double t,int n,int ifun[][6],int j,double x[],double xi[],double hm[],
double hp[],int multiindex[],double tminus,double tplus)
{int nj,l;double res,a,am,ap,s1,s2,ZERO=0.;
if(j==nvar||ifun[nvar][i]==0)
{if(nvar>=n-1)res=(*fun)(i,x,n,t,xi,hm,hp,multiindex,tminus,tplus);
else
res=tjksi(nvar+1,fun,i,t,n,ifun,j,x,xi,hm,hp,multiindex,tminus,tplus);
return res;}
res=0.;a=1./(hm[nvar]+hp[nvar]);nj=ng[nvar];
am=hm[nvar]*a;ap=hp[nvar]*a;
for(l=0;l<nj;l++)
{s1=0.;if(hp[nvar]!=ZERO)
{x[nvar]=xi[nvar]+hp[nvar]*be[nvar][l];
if(nvar<n-1)
s1=ap*tjksi(nvar+1,fun,i,t,n,ifun,j,x,xi,hm,hp,multiindex,tminus,tplus);
else s1=ap*(*fun)(i,x,n,t,xi,hm,hp,multiindex,tminus,tplus);}
s2=0.;if(hm[nvar]!=ZERO)
{x[nvar]=xi[nvar]-hm[nvar]*be[nvar][l];
if(nvar<n-1)
s2=am*tjksi(nvar+1,fun,i,t,n,ifun,j,x,xi,hm,hp,multiindex,tminus,tplus);
else s2=am*(*fun)(i,x,n,t,xi,hm,hp,multiindex,tminus,tplus);}
res+=(s1+s2)*al[nvar][l]*(1.-be[nvar][l]);
} return 2.*res; }
static void raz1(int mm,double h[],int ig[],double sig,double tau,
double q[],double ro[],double rk[],double z[],
double bp[],double bm[],double g[],double f[],double v[])
{int m; double x,a1,g1,am,gm;
x=2./h[1];a1=x*sig*ro[0];g1=x*(q[0]+(sig-1.)*ro[0]*v[0]);x=2./h[mm-1];
am=x*sig*ro[1]; gm=x*(q[1]+(sig-1.)*ro[1]*v[mm-1]);
for(m=0; m<mm;rk[m]/=tau,f[m]+=rk[m]*v[m],rk[m]+=sig*g[m],m++);
if(sig<1.){for(m=0;m<mm;f[m]-=(1.-sig)*g[m]*v[m],m++);
lv(mm,z,h,v,g);for(m=0;m<mm;f[m]+=(1.-sig)*g[m],m++);
betav(mm,bp,bm,h,v,g);for(m=0;m<mm;f[m]+=(1.-sig)*g[m],m++); }
betay(mm,bp,bm,h,bm,v,bp);for(m=0;m<mm;rk[m]-=sig*v[m],m++);
ly(mm,z,h,v,z,g);for(m=0;m<mm;m++){rk[m]-=sig*z[m];
bm[m]=-sig*(bm[m]+v[m]);v[m]=f[m];bp[m]=-sig*(bp[m]+g[m]);}
bp[0]*=(double)ig[0];rk[0]=a1+(double)ig[0]*rk[0];
v[0]=g1+(double)ig[0]*v[0];bm[mm-1]*=(double)ig[1];
rk[mm-1]=am+(double)ig[1]*rk[mm-1];v[mm-1]=gm+(double)ig[1]*v[mm-1];
progon(mm,bm,rk,bp,v); }
static void ly(int mm,double z[],double h[],double c[],double a[],double b[])
{int m;double x;for(m=1;m<mm;a[m]=2.*z[m]/h[m],m++);b[0]=a[1]/h[1],a[0]=-b[0];
for(m=1; m<mm-1; m++)
{x=1./(h[m]+h[m+1]); b[m]=a[m+1]*x;c[m]=a[m]*x; a[m]=-b[m]-c[m];}
c[mm-1]=a[mm-1]/h[mm-1]; a[mm-1]=-c[mm-1]; }/*return for ly*/
static void lv(int mm,double z[],double h[],double v[],double a[])
{int m; for(m=1; m<mm; a[m]=z[m]*(v[m]-v[m-1])*2./h[m],m++);a[0]=a[1]/h[1];
for(m=1; m<mm-1; a[m]=(a[m+1]-a[m])/(h[m+1]+h[m]),m++);a[mm-1]/=(-h[mm-1]);
}/*return for lv*/
static void betay(int mm,double bp[],double bm[],double h[],
double c[],double a[],double b[])
{ int m; double r; b[0]=bp[0]/h[1];a[0]=-b[0];
for(m=1; m<mm-1;r=1./(h[m]+h[m+1]),b[m]*=r,c[m]=-bm[m]*r,
a[m]=-b[m]-c[m],m++);a[mm-1]=bm[mm-1]/h[mm-1];c[mm-1]=-a[mm-1]; }
static void betav(int mm,double bp[],double bm[],double h[],
double v[],double a[])
{ int m;for(m=1; m<mm-1;a[m]=v[m]-v[m-1],m++);a[0]=bp[0]*a[1]/h[1];
for(m=1; m<mm-1;a[m]=(bp[m]*a[m+1]+bm[m]*a[m])/(h[m+1]+h[m]),m++);
a[mm-1]=bm[mm-1]*a[mm-1]/h[mm-1]; }
static void progon(int n,double c[],double a[],double b[],double g[])
// /*solves a linear tridiagonal system
// by eliminal*/
// int n;/*order of matrix */
// double c[];/*input vector of lenth n, the matrix elements behind diagonal,
// c[0] never used */
// double a[];/*input vector of lenth n, the diagonal matrix elements
// destroyed in computation */
// double b[];/*input vector of lenth n,the matrix elements ahead of diagonal,
// b[n-1] never used */
// double g[];/*input vector of lenth n, the right hand side of a system,
// destroyed in computation and replaced by resultant solution */
{int i,i1;double r;
for(i=1; i<n; i++){i1=i-1;r=c[i]/a[i1]; a[i]-=r*b[i1]; g[i]-=r*g[i1];}
g[n-1]/=a[n-1];for(i=n-2;i>=0;g[i]=(g[i]-b[i]*g[i+1])/a[i],i--); }
// void n_enough_memory(void)
// {printf("NOT ENOUGH MEMORY !");getch();exit(0);}