/*--------------------------------------------------------------------------*/ fint zos_forward_(fint* ftag, fint* fm, fint* fn, fint* fk, fdouble* fbase, fdouble* fvalue) { int rc=-1; int tag=*ftag, m=*fm, n=*fn, k=*fk; double* base=myalloc1(n); double* value = myalloc1(m); spread1(n,fbase,base); rc=zos_forward(tag,m,n,k,base,value); pack1(m,value,fvalue); free((char*)base); free((char*)value); return rc; }
int tensor_eval( int tag, int m, int n, int d, int p, double* x, double **tensor, double **S ) { static int bd,dim; static int dold,pold; static struct item *coeff_list; int i,j,k,dimten,ctr; int **jm, jmbd=0; int *it = (int*) malloc(d*sizeof(int)); double *y = (double*) malloc(m*sizeof(double)); double*** X; double*** Y; struct item *ptr[10]; int rc = 3; dimten=binomi(p+d,d); for (i=0; i<m; i++) for (j=0; j<dimten; j++) tensor[i][j] = 0; if (d == 0) { MINDEC(rc,zos_forward(1,m,n,0,x,y)); } else { if ((d != dold) || (p != pold)) { if (pold) { dim = binomi(pold+dold-1,dold); freecoefflist(dim,coeff_list); free((char*) coeff_list); } dim = binomi(p+d-1,d); if (dim < 10) bd = dim; else bd = 10; coeff_list = (struct item *) malloc(sizeof(struct item)*dim); coeff(p,d, coeff_list); dold = d; pold = p; } jmbd = bd; jm = (int **) malloc(jmbd*sizeof(int*)); for (i=0; i<jmbd; i++) jm[i] = (int *) malloc(p*sizeof(int)); if (d == 1) { X = myalloc3(1,n,bd); Y = myalloc3(1,m,bd); ctr = 0; it[0] = 0; for (i=0; i<dim; i++) /* sum over all multiindices jm with |jm| = d */ { it[0] = it[0]+1; convert(p,d,it,jm[ctr]); ptr[ctr] = &coeff_list[i]; if (ctr < bd-1) ctr += 1; else { multma2vec2(n,p,bd,X[0],S,jm); MINDEC(rc,fov_forward(tag,m,n,bd,x,X[0],y,Y[0])); for (k=0; k<bd; k++) do { for (j=0; j<m; j++) tensor[j][ptr[k]->a] += Y[0][j][k]*ptr[k]->c; ptr[k] = ptr[k]->next; } while (ptr[k] != NULL); if (dim-i < bd) bd = dim-i-1; ctr = 0; } } } else { X = myalloc3(n,bd,d); Y = myalloc3(m,bd,d); ctr = 0; for (i=0; i<d-1; i++) it[i] = 1; it[d-1] = 0; for (i=0; i<dim; i++) /* sum over all multiindices jm with |jm| = d */ { it[d-1] = it[d-1]+1; for (j=d-2; j>=0; j--) it[j] = it[j] + it[j+1]/(p+1); for (j=1; j<d; j++) if (it[j] > p) it[j] = it[j-1]; convert(p,d,it,jm[ctr]); ptr[ctr] = &coeff_list[i]; if (ctr < bd-1) ctr += 1; else { multma3vec2(n,p,d,bd,X,S,jm); MINDEC(rc,hov_forward(tag,m,n,d,bd,x,X,y,Y)); for (k=0; k<bd; k++) do { for (j=0; j<m; j++) tensor[j][ptr[k]->a] += Y[j][k][ptr[k]->b-1]*ptr[k]->c; ptr[k] = ptr[k]->next; } while (ptr[k] != NULL); if (dim-i < bd) bd = dim-i-1; ctr = 0; } } } for (i=0; i<jmbd; i++) free((char*) *(jm+i)); free((char*) jm); free((char*) **X); free((char*) *X); free((char*) X); free((char*) **Y); free((char*) *Y); free((char*) Y); } for(i=0;i<m;i++) tensor[i][0] = y[i]; bd = jmbd; free((char*) y); free((char*) it); return rc; }
int inverse_tensor_eval( int tag, int n, int d, int p, double *x, double **tensor, double** S ) { static int dim; static int dold,pold; static struct item *coeff_list; int i,j,dimten; int *it = (int*) malloc(d*sizeof(int)); double** X; double** Y; int *jm; double *y = (double*) malloc(n*sizeof(double)); struct item *ptr; int rc = 3; dimten=binomi(p+d,d); for(i=0;i<n;i++) for(j=0;j<dimten;j++) tensor[i][j] = 0; MINDEC(rc,zos_forward(1,n,n,0,x,y)); if (d > 0) { if ((d != dold) || (p != pold)) { if (pold) { /* olvo 980728 */ dim = binomi(pold+dold-1,dold); freecoefflist(dim,coeff_list); free((char*) coeff_list); } dim = binomi(p+d-1,d); coeff_list = (struct item *) malloc(sizeof(struct item)*dim); coeff(p,d, coeff_list); dold = d; pold = p; } jm = (int *)malloc(sizeof(int)*p); X = myalloc2(n,d+1); Y = myalloc2(n,d+1); for (i=0; i<n; i++) { X[i][0] = x[i]; for (j=1; j<d; j++) X[i][j] = 0; Y[i][0] = y[i]; } if (d == 1) { it[0] = 0; for (i=0; i<dim; i++) /* sum over all multiindices jm with |jm| = d */ { it[0] = it[0]+1; convert(p,d,it,jm); ptr = &coeff_list[i]; multma2vec1(n,p,d,Y,S,jm); MINDEC(rc,inverse_Taylor_prop(tag,n,d,Y,X)); if (rc == -3) return -3; do { for(j=0;j<n;j++) tensor[j][ptr->a] += X[j][ptr->b]*ptr->c; ptr = ptr->next; } while (ptr != NULL); } } else { for (i=0; i<d-1; i++) it[i] = 1; it[d-1] = 0; for (i=0; i<dim; i++) /* sum over all multiindices jm with |jm| = d */ { it[d-1] = it[d-1]+1; for (j=d-2; j>=0; j--) it[j] = it[j] + it[j+1]/(p+1); for (j=1; j<d; j++) if (it[j] > p) it[j] = it[j-1]; convert(p,d,it,jm); multma2vec1(n,p,d,Y,S,jm); /* Store S*jm in Y */ MINDEC(rc,inverse_Taylor_prop(tag,n,d,Y,X)); if (rc == -3) return -3; ptr = &coeff_list[i]; do { for(j=0;j<n;j++) tensor[j][ptr->a] += X[j][ptr->b]*ptr->c; ptr = ptr->next; } while (ptr != NULL); } } free((char*) jm); free((char*) *X); free((char*) X); free((char*) *Y); free((char*) Y); } for(i=0;i<n;i++) tensor[i][0] = x[i]; free((char*) y); free((char*) it); return rc; }
int jac_solv( unsigned short tag, int n, double* x, double* b, unsigned short sparse, unsigned short mode ) { static double **J; static double **I; static double *y; static double *xold; static int* ri; static int* ci; static int nax,tagold,modeold,cgd; int i,j; int rc = 3; if ((n != nax) || (tag != tagold)) { if (nax) { free(*J); free(J); free(*I); free(I); free(xold); free(ri); free(ci); free(y); } J = myalloc2(n,n); I = myalloc2(n,n); y = myalloc1(n); xold = myalloc1(n); ri = (int*)malloc(n*sizeof(int)); ci = (int*)malloc(n*sizeof(int)); for (i=0; i<n; i++) { xold[i] = 0; for (j=0;j<n;j++) I[i][j]=(i==j)?1.0:0.0; } cgd = 1; modeold = 0; nax = n; tagold = tag; } if (cgd == 0) for (i=0; i<n; i++) if (x[i] != xold[i]) cgd = 1; if (cgd == 1) for (i=0; i<n; i++) xold[i] = x[i]; switch(mode) { case 0: MINDEC(rc,zos_forward(tag,n,n,1,x,y)); MINDEC(rc,fov_reverse(tag,n,n,n,I,J)); break; case 1: if ((modeold == 0) || (cgd == 1)) { MINDEC(rc,zos_forward(tag,n,n,1,x,y)); MINDEC(rc,fov_reverse(tag,n,n,n,I,J)); } if (LUFactorization(J,n,ri,ci) < 0) return -3; modeold = 1; break; case 2: if ((modeold < 1) || (cgd == 1)) { MINDEC(rc,zos_forward(tag,n,n,1,x,y)); MINDEC(rc,fov_reverse(tag,n,n,n,I,J)); if (LUFactorization(J,n,ri,ci) < 0) return -3; } GauszSolve(J,n,ri,ci,b); modeold = 2; break; } cgd = 0; return rc; }
BEGIN_C_DECLS /****************************************************************************/ /* DRIVERS FOR ODEs */ /*--------------------------------------------------------------------------*/ /* forodec */ /* forodec(tag, n, tau, dold, dnew, X[n][d+1]) */ int forodec(short tag, /* tape identifier */ int n, /* space dimension */ double tau, /* scaling defaults to 1.0 */ int dol, /* previous degree defaults to zero */ int deg, /* New degree of consistency */ double** Y) /* Taylor series */ { /********************************************************************* This is assumed to be the autonomous case. Here we are just going around computing the vectors y[][j] for dol < j <= deg by successive calls to forward that works on the tape identified by tag. This tape (array of file) must obviously have been generated by a the execution of an active section between trace_on and trace_off with n independent and n dependent variables y must have been set up as pointer to an array of n pointers to double arrays containing at least deg+1 components. The scaling by tau is sometimes necessary to avoid overflow. **********************************************************************/ int rc= 3; int i, j, k; double taut; ADOLC_OPENMP_THREAD_NUMBER; ADOLC_OPENMP_GET_THREAD_NUMBER; if ( n > ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_nax || deg > ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_dax ) { if (ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_nax) { myfree1(ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_y); myfree1(ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_z); myfree2(ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_Z); } ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_Z = myalloc2(n, deg); ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_z = myalloc1(n); ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_y = myalloc1(n); ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_nax = n; ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_dax = deg; } for (i = 0; i < n; ++i) { ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_y[i] = Y[i][0]; /*printf("y[%i] = %f\n",i,y[i]);*/ for (k = 0; k < deg; ++k) { Y[i][k] = Y[i][k+1]; /*printf("Y[%i][%i] = %f\n",i,k,Y[i][k]);*/ } } /****** Here we get going ********/ if (dol == 0) { j = dol; /* j = 0 */ k = (deg) * (j == deg-1 ) ; /* keep death values in prepration */ MINDEC(rc, zos_forward(tag, n, n, k, ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_y, ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_z)); /* for reverse called by jacode */ if(rc < 0) return rc; taut = tau / (1 + j); /* only the last time through. */ for (i = 0; i < n; ++i) Y[i][j] = taut * ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_z[i]; dol++; /* !!! */ } for (j = dol; j < deg; ++j) { k = (deg)*(j == deg-1) ; /* keep death values in prepration */ MINDEC(rc, hos_forward(tag, n, n, j, k, ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_y, Y, ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_z, ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_Z)); /* for reverse called by jacode */ if( rc < 0) return rc; taut = tau / (1 + j); /* only the last time through. */ for (i = 0; i < n; ++i) Y[i][j] = taut * ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_Z[i][j-1]; } /****** Done ********/ for (i = 0; i < n; ++i) { for (k = deg; k > 0; --k) { Y[i][k] = Y[i][k-1]; /*printf("Y[%i][%i] = %f\n",i,k,Y[i][k]);*/ } Y[i][0] = ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_y[i]; /*printf("Y[%i][0] = %f\n",i,Y[i][0]);*/ } return rc; }