int Rossler::Jacobian (long int N, DenseMat J, realtype t, N_Vector x, N_Vector fy, void *jac_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { #endif #ifdef CVODE26 int Rossler::Jacobian (int N, realtype t, N_Vector x, N_Vector fy, DlsMat J, void *jac_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { #endif realtype a, b, c; realtype x1, x2, x3; Parameters * parameters; x1 = Ith (x, 0); x2 = Ith (x, 1); x3 = Ith (x, 2); parameters = (Parameters *) jac_data; a = parameters->At(0); b = parameters->At(1); c = parameters->At(2); IJth (J, 0, 0) = 0.0; IJth (J, 0, 1) = -1.0; IJth (J, 0, 2) = -1.0; IJth (J, 1, 0) = 1.0; IJth (J, 1, 1) = a; IJth (J, 1, 2) = 0.0; IJth (J, 2, 0) = x3; IJth (J, 2, 1) = 0.0; IJth (J, 2, 2) = x1-c; return CV_SUCCESS; }
static void SetSource(ProblemData d) { int *l_m, *m_start; realtype *xmin, *xmax, *dx; realtype x[DIM], g, *pdata; int i[DIM]; l_m = d->l_m; m_start = d->m_start; xmin = d->xmin; xmax = d->xmax; dx = d->dx; pdata = NV_DATA_P(d->p); for(i[0]=0; i[0]<l_m[0]; i[0]++) { x[0] = xmin[0] + (m_start[0]+i[0]) * dx[0]; for(i[1]=0; i[1]<l_m[1]; i[1]++) { x[1] = xmin[1] + (m_start[1]+i[1]) * dx[1]; #ifdef USE3D for(i[2]=0; i[2]<l_m[2]; i[2]++) { x[2] = xmin[2] + (m_start[2]+i[2]) * dx[2]; g = G1_AMPL * SUNRexp( -SUNSQR(G1_X-x[0])/SUNSQR(G1_SIGMA) ) * SUNRexp( -SUNSQR(G1_Y-x[1])/SUNSQR(G1_SIGMA) ) * SUNRexp( -SUNSQR(G1_Z-x[2])/SUNSQR(G1_SIGMA) ); g += G2_AMPL * SUNRexp( -SUNSQR(G2_X-x[0])/SUNSQR(G2_SIGMA) ) * SUNRexp( -SUNSQR(G2_Y-x[1])/SUNSQR(G2_SIGMA) ) * SUNRexp( -SUNSQR(G2_Z-x[2])/SUNSQR(G2_SIGMA) ); if( g < G_MIN ) g = ZERO; IJth(pdata, i) = g; } #else g = G1_AMPL * SUNRexp( -SUNSQR(G1_X-x[0])/SUNSQR(G1_SIGMA) ) * SUNRexp( -SUNSQR(G1_Y-x[1])/SUNSQR(G1_SIGMA) ); g += G2_AMPL * SUNRexp( -SUNSQR(G2_X-x[0])/SUNSQR(G2_SIGMA) ) * SUNRexp( -SUNSQR(G2_Y-x[1])/SUNSQR(G2_SIGMA) ); if( g < G_MIN ) g = ZERO; IJth(pdata, i) = g; #endif } } }
static void SetIC(N_Vector u, UserData data) { int i, j; realtype x, y, dx, dy; realtype *udata; /* Extract needed constants from data */ dx = data->dx; dy = data->dy; /* Set pointer to data array in vector u. */ udata = N_VGetArrayPointer_Serial(u); /* Load initial profile into u vector */ for (j=1; j <= MY; j++) { y = j*dy; for (i=1; i <= MX; i++) { x = i*dx; IJth(udata,i,j) = x*(XMAX - x)*y*(YMAX - y)*SUNRexp(FIVE*x*y); } } }
static void PrintOutput(N_Vector u) { int i, j; realtype dx, dy, x, y; realtype *udata; dx = ONE/(NX+1); dy = ONE/(NY+1); udata = NV_DATA_S(u); printf(" "); for (i=1; i<=NX; i+= SKIP) { x = i*dx; #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%-8.5Lf ", x); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%-8.5f ", x); #else printf("%-8.5f ", x); #endif } printf("\n\n"); for (j=1; j<=NY; j+= SKIP) { y = j*dy; #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%-8.5Lf ", y); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%-8.5f ", y); #else printf("%-8.5f ", y); #endif for (i=1; i<=NX; i+= SKIP) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%-8.5Lf ", IJth(udata,i,j)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%-8.5f ", IJth(udata,i,j)); #else printf("%-8.5f ", IJth(udata,i,j)); #endif } printf("\n"); } }
static int JacB(int NB, realtype t, N_Vector y, N_Vector yB, N_Vector fyB, DlsMat JB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) { UserData data; realtype y1, y2, y3; realtype p1, p2, p3; data = (UserData) user_dataB; /* The p vector */ p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; /* The y vector */ y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); /* Load JB */ IJth(JB,1,1) = p1; IJth(JB,1,2) = -p1; IJth(JB,2,1) = -p2*y3; IJth(JB,2,2) = p2*y3+2.0*p3*y2; IJth(JB,2,3) = RCONST(-2.0)*p3*y2; IJth(JB,3,1) = -p2*y2; IJth(JB,3,2) = p2*y2; return(0); }
static int Jac(realtype t, N_Vector y, N_Vector fy, SUNMatrix J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype y2, y3; UserData data; realtype p1, p2, p3; y2 = Ith(y,2); y3 = Ith(y,3); data = (UserData) user_data; p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; IJth(J,1,1) = -p1; IJth(J,1,2) = p2*y3; IJth(J,1,3) = p2*y2; IJth(J,2,1) = p1; IJth(J,2,2) = -p2*y3-2*p3*y2; IJth(J,2,3) = -p2*y2; IJth(J,3,1) = ZERO; IJth(J,3,2) = 2*p3*y2; IJth(J,3,3) = ZERO; return(0); }
static void Load_yext(realtype *src, ProblemData d) { int i[DIM], l_m[DIM], dim; FOR_DIM l_m[dim] = d->l_m[dim]; /* copy local segment */ #ifdef USE3D for (i[2]=0; i[2]<l_m[2]; i[2]++) #endif for(i[1]=0; i[1]<l_m[1]; i[1]++) for(i[0]=0; i[0]<l_m[0]; i[0]++) IJth_ext(d->y_ext, i) = IJth(src, i); }
int jacrob(long int Neq, realtype tt, realtype cj, N_Vector yy, N_Vector yp, N_Vector resvec, DlsMat JJ, void *user_data, N_Vector tempv1, N_Vector tempv2, N_Vector tempv3) { realtype *yval; yval = NV_DATA_S(yy); IJth(JJ,1,1) = RCONST(-0.04) - cj; IJth(JJ,2,1) = RCONST(0.04); IJth(JJ,3,1) = ONE; IJth(JJ,1,2) = RCONST(1.0e4)*yval[2]; IJth(JJ,2,2) = RCONST(-1.0e4)*yval[2] - RCONST(6.0e7)*yval[1] - cj; IJth(JJ,3,2) = ONE; IJth(JJ,1,3) = RCONST(1.0e4)*yval[1]; IJth(JJ,2,3) = RCONST(-1.0e4)*yval[1]; IJth(JJ,3,3) = ONE; return(0); }
static int jacE(int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *jac_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype y1, y2, y3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); IJth(J,1,1) = RCONST(-0.04); IJth(J,1,2) = RCONST(1.0e4)*y3; IJth(J,1,3) = RCONST(1.0e4)*y2; IJth(J,2,1) = RCONST(0.04); IJth(J,2,2) = RCONST(-1.0e4)*y3-RCONST(6.0e7)*y2; IJth(J,2,3) = RCONST(-1.0e4)*y2; IJth(J,3,1) = ZERO; IJth(J,3,2) = RCONST(6.0e7)*y2; IJth(J,3,3) = ZERO; return(0); }
static void Jac(long int N, DenseMat J, realtype t, N_Vector y, N_Vector fy, void *jac_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype y1, y2, y3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); IJth(J,1,1) = RCONST(-0.04); IJth(J,1,2) = RCONST(1.0e4)*y3; IJth(J,1,3) = RCONST(1.0e4)*y2; IJth(J,2,1) = RCONST(0.04); IJth(J,2,2) = RCONST(-1.0e4)*y3-RCONST(6.0e7)*y2; IJth(J,2,3) = RCONST(-1.0e4)*y2; IJth(J,3,2) = RCONST(6.0e7)*y2; }
static void Jac(long int N, DenseMat J, realtype t, N_Vector y, N_Vector fy, void *jac_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype y1, y2, y3; UserData data; realtype p1, p2, p3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); data = (UserData) jac_data; p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; IJth(J,1,1) = -p1; IJth(J,1,2) = p2*y3; IJth(J,1,3) = p2*y2; IJth(J,2,1) = p1; IJth(J,2,2) = -p2*y3-2*p3*y2; IJth(J,2,3) = -p2*y2; IJth(J,3,2) = 2*p3*y2; }
int Jac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype y1, y2, y3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); IJth(J,1,1) = RCONST(-0.04); IJth(J,1,2) = RCONST(1.0e4)*y3; IJth(J,1,3) = RCONST(1.0e4)*y2; IJth(J,2,1) = RCONST(0.04); IJth(J,2,2) = RCONST(-1.0e4)*y3-RCONST(6.0e7)*y2; IJth(J,2,3) = RCONST(-1.0e4)*y2; IJth(J,3,2) = RCONST(6.0e7)*y2; return(0); }
static void PrintOutput(N_Vector uB, UserData data) { realtype *uBdata, uBij, uBmax, x, y, dx, dy; int i, j; x = y = ZERO; dx = data->dx; dy = data->dy; uBdata = N_VGetArrayPointer(uB); uBmax = ZERO; for(j=1; j<= MY; j++) { for(i=1; i<=MX; i++) { uBij = IJth(uBdata, i, j); if (SUNRabs(uBij) > uBmax) { uBmax = uBij; x = i*dx; y = j*dy; } } } printf("\nMaximum sensitivity\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" lambda max = %Le\n", uBmax); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" lambda max = %e\n", uBmax); #else printf(" lambda max = %e\n", uBmax); #endif printf("at\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" x = %Le\n y = %Le\n", x, y); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" x = %e\n y = %e\n", x, y); #else printf(" x = %e\n y = %e\n", x, y); #endif }
static int func(N_Vector u, N_Vector f, void *user_data) { realtype dx, dy, hdiff, vdiff; realtype hdc, vdc; realtype uij, udn, uup, ult, urt; realtype *udata, *fdata; realtype x,y; int i, j; dx = ONE/(NX+1); dy = ONE/(NY+1); hdc = ONE/(dx*dx); vdc = ONE/(dy*dy); udata = NV_DATA_S(u); fdata = NV_DATA_S(f); for (j=1; j <= NY; j++) { y = j*dy; for (i=1; i <= NX; i++) { x = i*dx; /* Extract u at x_i, y_j and four neighboring points */ uij = IJth(udata, i, j); udn = (j == 1) ? ZERO : IJth(udata, i, j-1); uup = (j == NY) ? ZERO : IJth(udata, i, j+1); ult = (i == 1) ? ZERO : IJth(udata, i-1, j); urt = (i == NX) ? ZERO : IJth(udata, i+1, j); /* Evaluate diffusion components */ hdiff = hdc*(ult - TWO*uij + urt); vdiff = vdc*(uup - TWO*uij + udn); /* Set residual at x_i, y_j */ IJth(fdata, i, j) = hdiff + vdiff + uij - uij*uij*uij + 2.0; } } return(0); }
static int fB(realtype tB, N_Vector u, N_Vector uB, N_Vector uBdot, void *user_dataB) { UserData data; realtype *uBdata, *duBdata; realtype hordc, horac, verdc; realtype uBij, uBdn, uBup, uBlt, uBrt; realtype hdiffB, hadvB, vdiffB; int i, j; uBdata = N_VGetArrayPointer(uB); duBdata = N_VGetArrayPointer(uBdot); /* Extract needed constants from data */ data = (UserData) user_dataB; hordc = data->hdcoef; horac = data->hacoef; verdc = data->vdcoef; /* Loop over all grid points. */ for (j=1; j <= MY; j++) { for (i=1; i <= MX; i++) { /* Extract u at x_i, y_j and four neighboring points */ uBij = IJth(uBdata, i, j); uBdn = (j == 1) ? ZERO : IJth(uBdata, i, j-1); uBup = (j == MY) ? ZERO : IJth(uBdata, i, j+1); uBlt = (i == 1) ? ZERO : IJth(uBdata, i-1, j); uBrt = (i == MX) ? ZERO : IJth(uBdata, i+1, j); /* Set diffusion and advection terms and load into udot */ hdiffB = hordc*(- uBlt + TWO*uBij - uBrt); hadvB = horac*(uBrt - uBlt); vdiffB = verdc*(- uBup + TWO*uBij - uBdn); IJth(duBdata, i, j) = hdiffB + hadvB + vdiffB - ONE; } } return(0); }
static int f(realtype t, N_Vector u,N_Vector udot, void *user_data) { realtype uij, udn, uup, ult, urt, hordc, horac, verdc, hdiff, hadv, vdiff; realtype *udata, *dudata; int i, j; UserData data; udata = N_VGetArrayPointer_Serial(u); dudata = N_VGetArrayPointer_Serial(udot); /* Extract needed constants from data */ data = (UserData) user_data; hordc = data->hdcoef; horac = data->hacoef; verdc = data->vdcoef; /* Loop over all grid points. */ for (j=1; j <= MY; j++) { for (i=1; i <= MX; i++) { /* Extract u at x_i, y_j and four neighboring points */ uij = IJth(udata, i, j); udn = (j == 1) ? ZERO : IJth(udata, i, j-1); uup = (j == MY) ? ZERO : IJth(udata, i, j+1); ult = (i == 1) ? ZERO : IJth(udata, i-1, j); urt = (i == MX) ? ZERO : IJth(udata, i+1, j); /* Set diffusion and advection terms and load into udot */ hdiff = hordc*(ult - TWO*uij + urt); hadv = horac*(urt - ult); vdiff = verdc*(uup - TWO*uij + udn); IJth(dudata, i, j) = hdiff + hadv + vdiff; } } return(0); }
static int fB_local(long int NlocalB, realtype t, N_Vector y, N_Vector yB, N_Vector dyB, void *user_dataB) { realtype *YBdata, *dyBdata, *ydata; realtype dx[DIM], c, v[DIM], cl[DIM], cr[DIM]; realtype adv[DIM], diff[DIM]; realtype xmin[DIM], xmax[DIM], x[DIM], x1; int i[DIM], l_m[DIM], m_start[DIM], nbr_left[DIM], nbr_right[DIM], id; ProblemData d; int dim; d = (ProblemData) user_dataB; /* Extract stuff from data structure */ id = d->myId; FOR_DIM { xmin[dim] = d->xmin[dim]; xmax[dim] = d->xmax[dim]; l_m[dim] = d->l_m[dim]; m_start[dim] = d->m_start[dim]; dx[dim] = d->dx[dim]; nbr_left[dim] = d->nbr_left[dim]; nbr_right[dim] = d->nbr_right[dim]; } dyBdata = NV_DATA_P(dyB); ydata = NV_DATA_P(y); /* Copy local segment of yB to y_ext */ Load_yext(NV_DATA_P(yB), d); YBdata = d->y_ext; /* Velocity components in x1 and x2 directions (Poiseuille profile) */ v[1] = ZERO; #ifdef USE3D v[2] = ZERO; #endif /* local domain is [xmin+(m_start)*dx, xmin+(m_start+l_m-1)*dx] */ #ifdef USE3D for(i[2]=0; i[2]<l_m[2]; i[2]++) { x[2] = xmin[2] + (m_start[2]+i[2])*dx[2]; #endif for(i[1]=0; i[1]<l_m[1]; i[1]++) { x[1] = xmin[1] + (m_start[1]+i[1])*dx[1]; /* Velocity component in x0 direction (Poiseuille profile) */ x1 = x[1] - xmin[1] - L; v[0] = V_COEFF * (L + x1) * (L - x1); for(i[0]=0; i[0]<l_m[0]; i[0]++) { x[0] = xmin[0] + (m_start[0]+i[0])*dx[0]; c = IJth_ext(YBdata, i); /* Source term for adjoint PDE */ IJth(dyBdata, i) = -IJth(ydata, i); FOR_DIM { i[dim]+=1; cr[dim] = IJth_ext(YBdata, i); i[dim]-=2; cl[dim] = IJth_ext(YBdata, i); i[dim]+=1; /* Boundary conditions for the adjoint variables */ if( i[dim]==l_m[dim]-1 && nbr_right[dim]==id) cr[dim] = cl[dim]-(TWO*dx[dim]*v[dim]/DIFF_COEF)*c; else if( i[dim]==0 && nbr_left[dim]==id ) cl[dim] = cr[dim]+(TWO*dx[dim]*v[dim]/DIFF_COEF)*c; adv[dim] = v[dim] * (cr[dim]-cl[dim]) / (TWO*dx[dim]); diff[dim] = DIFF_COEF * (cr[dim]-TWO*c+cl[dim]) / SUNSQR(dx[dim]); IJth(dyBdata, i) -= (diff[dim] + adv[dim]); } } } #ifdef USE3D } #endif return(0); }
static void f_comm(long int N_local, realtype t, N_Vector y, void *user_data) { int id, n[DIM], proc_cond[DIM], nbr[DIM][2]; ProblemData d; realtype *yextdata, *ydata; int l_m[DIM], dim; int c, i[DIM], l[DIM-1]; realtype *buf_send, *buf_recv; MPI_Status stat; MPI_Comm comm; int dir, size = 1, small = INT_MAX; d = (ProblemData) user_data; comm = d->comm; id = d->myId; /* extract data from domain*/ FOR_DIM { n[dim] = d->num_procs[dim]; l_m[dim] = d->l_m[dim]; } yextdata = d->y_ext; ydata = NV_DATA_P(y); /* Calculate required buffer size */ FOR_DIM { size *= l_m[dim]; if( l_m[dim] < small) small = l_m[dim]; } size /= small; /* Adjust buffer size if necessary */ if( d->buf_size < size ) { d->buf_send = (realtype*) realloc( d->buf_send, size * sizeof(realtype)); d->buf_recv = (realtype*) realloc( d->buf_recv, size * sizeof(realtype)); d->buf_size = size; } buf_send = d->buf_send; buf_recv = d->buf_recv; /* Compute the communication pattern; who sends first? */ /* if proc_cond==1 , process sends first in this dimension */ proc_cond[0] = (id%n[0])%2; proc_cond[1] = ((id/n[0])%n[1])%2; #ifdef USE3D proc_cond[2] = (id/n[0]/n[1])%2; #endif /* Compute the actual communication pattern */ /* nbr[dim][0] is first proc to communicate with in dimension dim */ /* nbr[dim][1] the second one */ FOR_DIM { nbr[dim][proc_cond[dim]] = d->nbr_left[dim]; nbr[dim][!proc_cond[dim]] = d->nbr_right[dim]; } /* Communication: loop over dimension and direction (left/right) */ FOR_DIM { for (dir=0; dir<=1; dir++) { /* If subdomain at boundary, no communication in this direction */ if (id != nbr[dim][dir]) { c=0; /* Compute the index of the boundary (right or left) */ i[dim] = (dir ^ proc_cond[dim]) ? (l_m[dim]-1) : 0; /* Loop over all other dimensions and copy data into buf_send */ l[0]=(dim+1)%DIM; #ifdef USE3D l[1]=(dim+2)%DIM; for(i[l[1]]=0; i[l[1]]<l_m[l[1]]; i[l[1]]++) #endif for(i[l[0]]=0; i[l[0]]<l_m[l[0]]; i[l[0]]++) buf_send[c++] = IJth(ydata, i); if ( proc_cond[dim] ) { /* Send buf_send and receive into buf_recv */ MPI_Send(buf_send, c, PVEC_REAL_MPI_TYPE, nbr[dim][dir], 0, comm); MPI_Recv(buf_recv, c, PVEC_REAL_MPI_TYPE, nbr[dim][dir], 0, comm, &stat); } else { /* Receive into buf_recv and send buf_send*/ MPI_Recv(buf_recv, c, PVEC_REAL_MPI_TYPE, nbr[dim][dir], 0, comm, &stat); MPI_Send(buf_send, c, PVEC_REAL_MPI_TYPE, nbr[dim][dir], 0, comm); } c=0; /* Compute the index of the boundary (right or left) in yextdata */ i[dim] = (dir ^ proc_cond[dim]) ? l_m[dim] : -1; /* Loop over all other dimensions and copy data into yextdata */ #ifdef USE3D for(i[l[1]]=0; i[l[1]]<l_m[l[1]]; i[l[1]]++) #endif for(i[l[0]]=0; i[l[0]]<l_m[l[0]]; i[l[0]]++) IJth_ext(yextdata, i) = buf_recv[c++]; } } /* end loop over direction */ } /* end loop over dimension */ }
int main() { realtype fnormtol, fnorm; N_Vector y, scale; int flag; void *kmem; y = scale = NULL; kmem = NULL; /* ------------------------- * Print problem description * ------------------------- */ printf("\n2D elliptic PDE on unit square\n"); printf(" d^2 u / dx^2 + d^2 u / dy^2 = u^3 - u + 2.0\n"); printf(" + homogeneous Dirichlet boundary conditions\n\n"); printf("Solution method: Anderson accelerated Picard iteration with band linear solver.\n"); printf("Problem size: %2ld x %2ld = %4ld\n", (long int) NX, (long int) NY, (long int) NEQ); /* -------------------------------------- * Create vectors for solution and scales * -------------------------------------- */ y = N_VNew_Serial(NEQ); if (check_flag((void *)y, "N_VNew_Serial", 0)) return(1); scale = N_VNew_Serial(NEQ); if (check_flag((void *)scale, "N_VNew_Serial", 0)) return(1); /* ---------------------------------------------------------------------------------- * Initialize and allocate memory for KINSOL, set parametrs for Anderson acceleration * ---------------------------------------------------------------------------------- */ kmem = KINCreate(); if (check_flag((void *)kmem, "KINCreate", 0)) return(1); /* y is used as a template */ /* Use acceleration with up to 3 prior residuals */ flag = KINSetMAA(kmem, 3); if (check_flag(&flag, "KINSetMAA", 1)) return(1); flag = KINInit(kmem, func, y); if (check_flag(&flag, "KINInit", 1)) return(1); /* ------------------- * Set optional inputs * ------------------- */ /* Specify stopping tolerance based on residual */ fnormtol = FTOL; flag = KINSetFuncNormTol(kmem, fnormtol); if (check_flag(&flag, "KINSetFuncNormTol", 1)) return(1); /* ------------------------- * Attach band linear solver * ------------------------- */ flag = KINBand(kmem, NEQ, NX, NX); if (check_flag(&flag, "KINBand", 1)) return(1); flag = KINDlsSetBandJacFn(kmem, jac); if (check_flag(&flag, "KINDlsBandJacFn", 1)) return(1); /* ------------- * Initial guess * ------------- */ N_VConst_Serial(ZERO, y); IJth(NV_DATA_S(y), 2, 2) = ONE; /* ---------------------------- * Call KINSol to solve problem * ---------------------------- */ /* No scaling used */ N_VConst_Serial(ONE,scale); /* Call main solver */ flag = KINSol(kmem, /* KINSol memory block */ y, /* initial guess on input; solution vector */ KIN_PICARD, /* global strategy choice */ scale, /* scaling vector, for the variable cc */ scale); /* scaling vector for function values fval */ if (check_flag(&flag, "KINSol", 1)) return(1); /* ------------------------------------ * Print solution and solver statistics * ------------------------------------ */ /* Get scaled norm of the system function */ flag = KINGetFuncNorm(kmem, &fnorm); if (check_flag(&flag, "KINGetfuncNorm", 1)) return(1); printf("\nComputed solution (||F|| = %g):\n\n",fnorm); PrintOutput(y); PrintFinalStats(kmem); /* ----------- * Free memory * ----------- */ N_VDestroy_Serial(y); N_VDestroy_Serial(scale); KINFree(&kmem); return(0); }
static void OutputGradient(int myId, N_Vector qB, ProblemData d) { FILE *fid; char filename[20]; int *l_m, *m_start, i[DIM],ip; realtype *xmin, *xmax, *dx; realtype x[DIM], *pdata, p, *qBdata, g; sprintf(filename,"grad%03d.m",myId); fid = fopen(filename,"w"); l_m = d->l_m; m_start = d->m_start; xmin = d->xmin; xmax = d->xmax; dx = d->dx; qBdata = NV_DATA_P(qB); pdata = NV_DATA_P(d->p); /* Write matlab files with solutions from each process */ for(i[0]=0; i[0]<l_m[0]; i[0]++) { x[0] = xmin[0] + (m_start[0]+i[0]) * dx[0]; for(i[1]=0; i[1]<l_m[1]; i[1]++) { x[1] = xmin[1] + (m_start[1]+i[1]) * dx[1]; #ifdef USE3D for(i[2]=0; i[2]<l_m[2]; i[2]++) { x[2] = xmin[2] + (m_start[2]+i[2]) * dx[2]; g = IJth(qBdata, i); p = IJth(pdata, i); #if defined(SUNDIALS_EXTENDED_PRECISION) fprintf(fid,"x%d(%d,1) = %Le; \n", myId, i[0]+1, x[0]); fprintf(fid,"y%d(%d,1) = %Le; \n", myId, i[1]+1, x[1]); fprintf(fid,"z%d(%d,1) = %Le; \n", myId, i[2]+1, x[2]); fprintf(fid,"p%d(%d,%d,%d) = %Le; \n", myId, i[1]+1, i[0]+1, i[2]+1, p); fprintf(fid,"g%d(%d,%d,%d) = %Le; \n", myId, i[1]+1, i[0]+1, i[2]+1, g); #elif defined(SUNDIALS_DOUBLE_PRECISION) fprintf(fid,"x%d(%d,1) = %le; \n", myId, i[0]+1, x[0]); fprintf(fid,"y%d(%d,1) = %le; \n", myId, i[1]+1, x[1]); fprintf(fid,"z%d(%d,1) = %le; \n", myId, i[2]+1, x[2]); fprintf(fid,"p%d(%d,%d,%d) = %le; \n", myId, i[1]+1, i[0]+1, i[2]+1, p); fprintf(fid,"g%d(%d,%d,%d) = %le; \n", myId, i[1]+1, i[0]+1, i[2]+1, g); #else fprintf(fid,"x%d(%d,1) = %e; \n", myId, i[0]+1, x[0]); fprintf(fid,"y%d(%d,1) = %e; \n", myId, i[1]+1, x[1]); fprintf(fid,"z%d(%d,1) = %e; \n", myId, i[2]+1, x[2]); fprintf(fid,"p%d(%d,%d,%d) = %e; \n", myId, i[1]+1, i[0]+1, i[2]+1, p); fprintf(fid,"g%d(%d,%d,%d) = %e; \n", myId, i[1]+1, i[0]+1, i[2]+1, g); #endif } #else g = IJth(qBdata, i); p = IJth(pdata, i); #if defined(SUNDIALS_EXTENDED_PRECISION) fprintf(fid,"x%d(%d,1) = %Le; \n", myId, i[0]+1, x[0]); fprintf(fid,"y%d(%d,1) = %Le; \n", myId, i[1]+1, x[1]); fprintf(fid,"p%d(%d,%d) = %Le; \n", myId, i[1]+1, i[0]+1, p); fprintf(fid,"g%d(%d,%d) = %Le; \n", myId, i[1]+1, i[0]+1, g); #elif defined(SUNDIALS_DOUBLE_PRECISION) fprintf(fid,"x%d(%d,1) = %e; \n", myId, i[0]+1, x[0]); fprintf(fid,"y%d(%d,1) = %e; \n", myId, i[1]+1, x[1]); fprintf(fid,"p%d(%d,%d) = %e; \n", myId, i[1]+1, i[0]+1, p); fprintf(fid,"g%d(%d,%d) = %e; \n", myId, i[1]+1, i[0]+1, g); #else fprintf(fid,"x%d(%d,1) = %e; \n", myId, i[0]+1, x[0]); fprintf(fid,"y%d(%d,1) = %e; \n", myId, i[1]+1, x[1]); fprintf(fid,"p%d(%d,%d) = %e; \n", myId, i[1]+1, i[0]+1, p); fprintf(fid,"g%d(%d,%d) = %e; \n", myId, i[1]+1, i[0]+1, g); #endif #endif } } fclose(fid); /* Write matlab driver */ if (myId == 0) { fid = fopen("grad.m","w"); #ifdef USE3D fprintf(fid,"clear;\nfigure;\nhold on\n"); fprintf(fid,"trans = 0.7;\n"); fprintf(fid,"ecol = 'none';\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) fprintf(fid,"xp=[%Lf %Lf];\n",G1_X,G2_X); fprintf(fid,"yp=[%Lf %Lf];\n",G1_Y,G2_Y); fprintf(fid,"zp=[%Lf %Lf];\n",G1_Z,G2_Z); #else fprintf(fid,"xp=[%f %f];\n",G1_X,G2_X); fprintf(fid,"yp=[%f %f];\n",G1_Y,G2_Y); fprintf(fid,"zp=[%f %f];\n",G1_Z,G2_Z); #endif fprintf(fid,"ns = length(xp)*length(yp)*length(zp);\n"); for (ip=0; ip<d->npes; ip++) { fprintf(fid,"\ngrad%03d;\n",ip); fprintf(fid,"[X,Y,Z]=meshgrid(x%d,y%d,z%d);\n",ip,ip,ip); fprintf(fid,"s%d=slice(X,Y,Z,g%d,xp,yp,zp);\n",ip,ip); fprintf(fid,"for i = 1:ns\n"); fprintf(fid," set(s%d(i),'FaceAlpha',trans);\n",ip); fprintf(fid," set(s%d(i),'EdgeColor',ecol);\n",ip); fprintf(fid,"end\n"); } fprintf(fid,"view(3)\n"); fprintf(fid,"\nshading interp\naxis equal\n"); #else fprintf(fid,"clear;\nfigure;\n"); fprintf(fid,"trans = 0.7;\n"); fprintf(fid,"ecol = 'none';\n"); for (ip=0; ip<d->npes; ip++) { fprintf(fid,"\ngrad%03d;\n",ip); fprintf(fid,"\nsubplot(1,2,1)\n"); fprintf(fid,"s=surf(x%d,y%d,g%d);\n",ip,ip,ip); fprintf(fid,"set(s,'FaceAlpha',trans);\n"); fprintf(fid,"set(s,'EdgeColor',ecol);\n"); fprintf(fid,"hold on\n"); fprintf(fid,"axis tight\n"); fprintf(fid,"box on\n"); fprintf(fid,"\nsubplot(1,2,2)\n"); fprintf(fid,"s=surf(x%d,y%d,p%d);\n",ip,ip,ip); fprintf(fid,"set(s,'CData',g%d);\n",ip); fprintf(fid,"set(s,'FaceAlpha',trans);\n"); fprintf(fid,"set(s,'EdgeColor',ecol);\n"); fprintf(fid,"hold on\n"); fprintf(fid,"axis tight\n"); fprintf(fid,"box on\n"); } #endif fclose(fid); } }
/* Preconditioner setup routine. Generate and preprocess P. */ static int Precond(realtype tn, N_Vector u, N_Vector fu, booleantype jok, booleantype *jcurPtr, realtype gamma, void *P_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype c1, c2, cydn, cyup, diag, ydn, yup, q4coef, dely, verdco, hordco; realtype **(*P)[MYSUB], **(*Jbd)[MYSUB]; long int nvmxsub, *(*pivot)[MYSUB], ier, offset; int lx, ly, jx, jy, isubx, isuby; realtype *udata, **a, **j; PreconData predata; UserData data; /* Make local copies of pointers in P_data, pointer to u's data, and PE index pair */ predata = (PreconData) P_data; data = (UserData) (predata->f_data); P = predata->P; Jbd = predata->Jbd; pivot = predata->pivot; udata = NV_DATA_P(u); isubx = data->isubx; isuby = data->isuby; nvmxsub = data->nvmxsub; if (jok) { /* jok = TRUE: Copy Jbd to P */ for (ly = 0; ly < MYSUB; ly++) for (lx = 0; lx < MXSUB; lx++) dencopy(Jbd[lx][ly], P[lx][ly], NVARS, NVARS); *jcurPtr = FALSE; } else { /* jok = FALSE: Generate Jbd from scratch and copy to P */ /* Make local copies of problem variables, for efficiency */ q4coef = data->q4; dely = data->dy; verdco = data->vdco; hordco = data->hdco; /* Compute 2x2 diagonal Jacobian blocks (using q4 values computed on the last f call). Load into P. */ for (ly = 0; ly < MYSUB; ly++) { jy = ly + isuby*MYSUB; ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); diag = -(cydn + cyup + RCONST(2.0)*hordco); for (lx = 0; lx < MXSUB; lx++) { jx = lx + isubx*MXSUB; offset = lx*NVARS + ly*nvmxsub; c1 = udata[offset]; c2 = udata[offset+1]; j = Jbd[lx][ly]; a = P[lx][ly]; IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag; IJth(j,1,2) = -Q2*c1 + q4coef; IJth(j,2,1) = Q1*C3 - Q2*c2; IJth(j,2,2) = (-Q2*c1 - q4coef) + diag; dencopy(j, a, NVARS, NVARS); } } *jcurPtr = TRUE; } /* Scale by -gamma */ for (ly = 0; ly < MYSUB; ly++) for (lx = 0; lx < MXSUB; lx++) denscale(-gamma, P[lx][ly], NVARS, NVARS); /* Add identity matrix and do LU decompositions on blocks in place */ for (lx = 0; lx < MXSUB; lx++) { for (ly = 0; ly < MYSUB; ly++) { denaddI(P[lx][ly], NVARS); ier = denGETRF(P[lx][ly], NVARS, NVARS, pivot[lx][ly]); if (ier != 0) return(1); } } return(0); }
static int Precond(realtype tn, N_Vector u, N_Vector fu, booleantype jok, booleantype *jcurPtr, realtype gamma, void *P_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype c1, c2, cydn, cyup, diag, ydn, yup, q4coef, dely, verdco, hordco; realtype **(*P)[MY], **(*Jbd)[MY]; long int *(*pivot)[MY], ier; int jx, jy; realtype *udata, **a, **j; UserData data; /* Make local copies of pointers in P_data, and of pointer to u's data */ data = (UserData) P_data; P = data->P; Jbd = data->Jbd; pivot = data->pivot; udata = NV_DATA_S(u); if (jok) { /* jok = TRUE: Copy Jbd to P */ for (jy=0; jy < MY; jy++) for (jx=0; jx < MX; jx++) dencopy(Jbd[jx][jy], P[jx][jy], NUM_SPECIES); *jcurPtr = FALSE; } else { /* jok = FALSE: Generate Jbd from scratch and copy to P */ /* Make local copies of problem variables, for efficiency. */ q4coef = data->q4; dely = data->dy; verdco = data->vdco; hordco = data->hdco; /* Compute 2x2 diagonal Jacobian blocks (using q4 values computed on the last f call). Load into P. */ for (jy=0; jy < MY; jy++) { ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*exp(RCONST(0.2)*ydn); cyup = verdco*exp(RCONST(0.2)*yup); diag = -(cydn + cyup + TWO*hordco); for (jx=0; jx < MX; jx++) { c1 = IJKth(udata,1,jx,jy); c2 = IJKth(udata,2,jx,jy); j = Jbd[jx][jy]; a = P[jx][jy]; IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag; IJth(j,1,2) = -Q2*c1 + q4coef; IJth(j,2,1) = Q1*C3 - Q2*c2; IJth(j,2,2) = (-Q2*c1 - q4coef) + diag; dencopy(j, a, NUM_SPECIES); } } *jcurPtr = TRUE; } /* Scale by -gamma */ for (jy=0; jy < MY; jy++) for (jx=0; jx < MX; jx++) denscale(-gamma, P[jx][jy], NUM_SPECIES); /* Add identity matrix and do LU decompositions on blocks in place. */ for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { denaddI(P[jx][jy], NUM_SPECIES); ier = gefa(P[jx][jy], NUM_SPECIES, pivot[jx][jy]); if (ier != 0) return(1); } } return(0); }
static int Precond(realtype tn, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *P_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype c1, c2, czdn, czup, diag, zdn, zup, q4coef, delz, verdco, hordco; realtype **(*P)[MZ], **(*Jbd)[MZ]; long int *(*pivot)[MZ]; int ier, jx, jz; realtype *ydata, **a, **j; UserData data; realtype Q1, Q2, C3, A3, A4, KH, VEL, KV0; /* Make local copies of pointers in P_data, and of pointer to y's data */ data = (UserData) P_data; P = data->P; Jbd = data->Jbd; pivot = data->pivot; ydata = NV_DATA_S(y); /* Load problem coefficients and parameters */ Q1 = data->p[0]; Q2 = data->p[1]; C3 = data->p[2]; A3 = data->p[3]; A4 = data->p[4]; KH = data->p[5]; VEL = data->p[6]; KV0 = data->p[7]; if (jok) { /* jok = TRUE: Copy Jbd to P */ for (jz=0; jz < MZ; jz++) for (jx=0; jx < MX; jx++) dencopy(Jbd[jx][jz], P[jx][jz], NUM_SPECIES); *jcurPtr = FALSE; } else { /* jok = FALSE: Generate Jbd from scratch and copy to P */ /* Make local copies of problem variables, for efficiency. */ q4coef = data->q4; delz = data->dz; verdco = data->vdco; hordco = data->hdco; /* Compute 2x2 diagonal Jacobian blocks (using q4 values computed on the last f call). Load into P. */ for (jz=0; jz < MZ; jz++) { zdn = ZMIN + (jz - RCONST(0.5))*delz; zup = zdn + delz; czdn = verdco*EXP(RCONST(0.2)*zdn); czup = verdco*EXP(RCONST(0.2)*zup); diag = -(czdn + czup + RCONST(2.0)*hordco); for (jx=0; jx < MX; jx++) { c1 = IJKth(ydata,1,jx,jz); c2 = IJKth(ydata,2,jx,jz); j = Jbd[jx][jz]; a = P[jx][jz]; IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag; IJth(j,1,2) = -Q2*c1 + q4coef; IJth(j,2,1) = Q1*C3 - Q2*c2; IJth(j,2,2) = (-Q2*c1 - q4coef) + diag; dencopy(j, a, NUM_SPECIES); } } *jcurPtr = TRUE; } /* Scale by -gamma */ for (jz=0; jz < MZ; jz++) for (jx=0; jx < MX; jx++) denscale(-gamma, P[jx][jz], NUM_SPECIES); /* Add identity matrix and do LU decompositions on blocks in place. */ for (jx=0; jx < MX; jx++) { for (jz=0; jz < MZ; jz++) { denaddI(P[jx][jz], NUM_SPECIES); ier = gefa(P[jx][jz], NUM_SPECIES, pivot[jx][jz]); if (ier != 0) return(1); } } return(0); }
static int jac(N_Vector y, N_Vector f,SUNMatrix J, void *user_data, N_Vector tmp1, N_Vector tmp2) { int i; realtype *yd; realtype x1, x2, x3, x4, x5, x6, x7, x8; yd = N_VGetArrayPointer_Serial(y); x1 = yd[0]; x2 = yd[1]; x3 = yd[2]; x4 = yd[3]; x5 = yd[4]; x6 = yd[5]; x7 = yd[6]; x8 = yd[7]; /* Nonlinear equations */ /* - 0.1238*x1 + x7 - 0.001637*x2 - 0.9338*x4 + 0.004731*x1*x3 - 0.3578*x2*x3 - 0.3571 */ IJth(J,1,1) = - 0.1238 + 0.004731*x3; IJth(J,1,2) = - 0.001637 - 0.3578*x3; IJth(J,1,3) = 0.004731*x1 - 0.3578*x2; IJth(J,1,4) = - 0.9338; IJth(J,1,7) = 1.0; /* 0.2638*x1 - x7 - 0.07745*x2 - 0.6734*x4 + 0.2238*x1*x3 + 0.7623*x2*x3 - 0.6022 */ IJth(J,2,1) = 0.2638 + 0.2238*x3; IJth(J,2,2) = - 0.07745 + 0.7623*x3; IJth(J,2,3) = 0.2238*x1 + 0.7623*x2; IJth(J,2,4) = - 0.6734; IJth(J,2,7) = -1.0; /* 0.3578*x1 + 0.004731*x2 + x6*x8 */ IJth(J,3,1) = 0.3578; IJth(J,3,2) = 0.004731; IJth(J,3,6) = x8; IJth(J,3,8) = x6; /* - 0.7623*x1 + 0.2238*x2 + 0.3461 */ IJth(J,4,1) = - 0.7623; IJth(J,4,2) = 0.2238; /* x1*x1 + x2*x2 - 1 */ IJth(J,5,1) = 2.0*x1; IJth(J,5,2) = 2.0*x2; /* x3*x3 + x4*x4 - 1 */ IJth(J,6,3) = 2.0*x3; IJth(J,6,4) = 2.0*x4; /* x5*x5 + x6*x6 - 1 */ IJth(J,7,5) = 2.0*x5; IJth(J,7,6) = 2.0*x6; /* x7*x7 + x8*x8 - 1 */ IJth(J,8,7) = 2.0*x7; IJth(J,8,8) = 2.0*x8; /* Lower bounds ( l_i = 1 + x_i >= 0) l_i - 1.0 - x_i */ for(i=1;i<=8;i++) { IJth(J,8+i,i) = -1.0; IJth(J,8+i,8+i) = 1.0; } /* Upper bounds ( u_i = 1 - x_i >= 0) u_i - 1.0 + x_i */ for(i=1;i<=8;i++) { IJth(J,16+i,i) = 1.0; IJth(J,16+i,16+i) = 1.0; } return(0); }