From: raphael couturier Date: Thu, 14 Aug 2014 06:43:23 +0000 (+0200) Subject: ex49 X-Git-Url: https://bilbo.iut-bm.univ-fcomte.fr/and/gitweb/GMRES2stage.git/commitdiff_plain/1ecb79e1234256ff879d1a787113c41fca16a7cc?ds=inline ex49 --- diff --git a/code/ex49.c b/code/ex49.c new file mode 100644 index 0000000..b875dd3 --- /dev/null +++ b/code/ex49.c @@ -0,0 +1,1812 @@ +// /home/couturie/work/petsc-3.5.1/arch-linux2-c-debug/bin/mpirun -np 4 ./ex49 -mx 900 -my 900 -ksp_type fgmres + + +static char help[] = " Solves the compressible plane strain elasticity equations in 2d on the unit domain using Q1 finite elements. \n\ + Material properties E (Youngs moduls) and nu (Poisson ratio) may vary as a function of space. \n\ + The model utilisse boundary conditions which produce compression in the x direction. \n\ +Options: \n\ + -mx : number elements in x-direciton \n\ + -my : number elements in y-direciton \n\ + -c_str : indicates the structure of the coefficients to use. \n\ + -c_str 0 => Setup for an isotropic material with constant coefficients. \n\ + Parameters: \n\ + -iso_E : Youngs modulus \n\ + -iso_nu : Poisson ratio \n\ + -c_str 1 => Setup for a step function in the material properties in x. \n\ + Parameters: \n\ + -step_E0 : Youngs modulus to the left of the step \n\ + -step_nu0 : Poisson ratio to the left of the step \n\ + -step_E1 : Youngs modulus to the right of the step \n\ + -step_n1 : Poisson ratio to the right of the step \n\ + -step_xc : x coordinate of the step \n\ + -c_str 2 => Setup for a checkerboard material with alternating properties. \n\ + Repeats the following pattern throughout the domain. For example with 4 materials specified, we would heve \n\ + -------------------------\n\ + | D | A | B | C |\n\ + ------|-----|-----|------\n\ + | C | D | A | B |\n\ + ------|-----|-----|------\n\ + | B | C | D | A |\n\ + ------|-----|-----|------\n\ + | A | B | C | D |\n\ + -------------------------\n\ + \n\ + Parameters: \n\ + -brick_E : a comma seperated list of Young's modulii \n\ + -brick_nu : a comma seperated list of Poisson ratio's \n\ + -brick_span : the number of elements in x and y each brick will span \n\ + -c_str 3 => Setup for a sponge-like material with alternating properties. \n\ + Repeats the following pattern throughout the domain \n\ + -----------------------------\n\ + | [background] |\n\ + | E0,nu0 |\n\ + | ----------------- |\n\ + | | [inclusion] | |\n\ + | | E1,nu1 | |\n\ + | | | |\n\ + | | <---- w ----> | |\n\ + | | | |\n\ + | | | |\n\ + | ----------------- |\n\ + | |\n\ + | |\n\ + -----------------------------\n\ + <-------- t + w + t ------->\n\ + \n\ + Parameters: \n\ + -sponge_E0 : Youngs moduls of the surrounding material \n\ + -sponge_E1 : Youngs moduls of the inclusio \n\ + -sponge_nu0 : Poisson ratio of the surrounding material \n\ + -sponge_nu1 : Poisson ratio of the inclusio \n\ + -sponge_t : the number of elements defining the border around each inclusion \n\ + -sponge_w : the number of elements in x and y each inclusion will span\n\ + -use_gp_coords : Evaluate the Youngs modulus, Poisson ratio and the body force at the global coordinates of the quadrature points.\n\ + By default, E, nu and the body force are evaulated at the element center and applied as a constant over the entire element.\n\ + -use_nonsymbc : Option to use non-symmetric boundary condition imposition. This choice will use less memory."; + +/* Contributed by Dave May */ + +#include +#include +#include + +static PetscErrorCode DMDABCApplyCompression(DM,Mat,Vec); +static PetscErrorCode DMDABCApplySymmetricCompression(DM elas_da,Mat A,Vec f,IS *dofs,Mat *AA,Vec *ff); + + +#define NSD 2 /* number of spatial dimensions */ +#define NODES_PER_EL 4 /* nodes per element */ +#define U_DOFS 2 /* degrees of freedom per displacement node */ +#define GAUSS_POINTS 4 + + + + +int KrylovMinimize(Mat A, Vec b, Vec x) { + + + //Variables + + PetscScalar gamma, alpha, oldgamma, beta; + PetscReal norm=20, Eprecision=1e-8, cgprec=1e-40; + PetscInt giter=0, ColS=8, col=0, Emaxiter=50000000, iter=0, iterations=15, Iiter=0; + PetscErrorCode ierr; + PetscScalar T1, T2; + KSP ksp; + PetscInt total=0; + PetscInt size; + PetscInt Istart,Iend; + PetscInt i,its; + Vec x_old, residu; + Mat S, AS; + PetscScalar *array; + PetscInt *ind_row; + Vec Alpha, p, ss, vect, r, q, Ax; + + + PetscInt first=1; + + ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr); + ierr = KSPSetOperators(ksp,A,A);CHKERRQ(ierr); + ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr); + + + + + VecGetSize(b,&size); + + ierr = PetscPrintf(PETSC_COMM_WORLD, "Size of vector %D\n", size); CHKERRQ(ierr); + + PetscInt aa,bb; + MatGetOwnershipRange(A,&aa,&bb); + + // ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD, "%D %D\n", aa,bb); CHKERRQ(ierr); + //PetscSynchronizedFlush(PETSC_COMM_WORLD); + + + ierr = MatCreate(PETSC_COMM_WORLD, &S);CHKERRQ(ierr); + ierr = MatSetSizes(S, bb-aa, PETSC_DECIDE, size, ColS); CHKERRQ(ierr); + ierr = MatSetType(S, MATMPIDENSE); CHKERRQ(ierr); + ierr = MatSetUp(S); CHKERRQ(ierr); + + ierr = MatGetOwnershipRange(S, &Istart, &Iend); CHKERRQ(ierr); + + ierr = VecCreate(PETSC_COMM_WORLD, &Alpha); CHKERRQ(ierr); + ierr = VecSetSizes(Alpha, PETSC_DECIDE, ColS); CHKERRQ(ierr); + ierr = VecSetFromOptions(Alpha); CHKERRQ(ierr); + ierr = VecDuplicate(Alpha, &vect); CHKERRQ(ierr); + ierr = VecDuplicate(Alpha, &p); CHKERRQ(ierr); + ierr = VecDuplicate(Alpha, &ss); CHKERRQ(ierr); + ierr = VecDuplicate(b, &r); CHKERRQ(ierr); + ierr = VecDuplicate(b, &q); CHKERRQ(ierr); + ierr = VecDuplicate(b, &Ax); CHKERRQ(ierr); + + ierr = VecDuplicate(b,&x_old);CHKERRQ(ierr); + ierr = VecDuplicate(b,&residu);CHKERRQ(ierr); + + + + //indexes of row (these indexes are global) + ind_row = (PetscInt*)malloc(sizeof(PetscInt)*(Iend-Istart)); + for(i=0; iEprecision ){ + for(col=0; colEprecision; col++){ + + + //Solve + ierr = KSPSolve(ksp, b, x); CHKERRQ(ierr); + + ierr = KSPGetIterationNumber(ksp, &its); CHKERRQ(ierr); + total += its; Iiter ++; + + + + //Build S' + ierr = VecGetArray(x, &array); + ierr = MatSetValues(S, Iend-Istart, ind_row, 1, &col, array, INSERT_VALUES); + VecRestoreArray(x, &array); + + + + KSPGetResidualNorm(ksp,&norm); + + /* //Error + ierr = VecCopy(x, residu); CHKERRQ(ierr); + ierr = VecAXPY(residu, -1, x_old); CHKERRQ(ierr); + ierr = VecNorm(residu, NORM_INFINITY, &norm); CHKERRQ(ierr); + */ + + + ierr = PetscPrintf(PETSC_COMM_WORLD, "Norm of error %g, outer iteration %D\n", norm, giter); CHKERRQ(ierr); + ierr = VecCopy(x, x_old); CHKERRQ(ierr); + + + } + + + //minimization step + if( norm>Eprecision) { + + MatAssemblyBegin(S, MAT_FINAL_ASSEMBLY); + MatAssemblyEnd(S, MAT_FINAL_ASSEMBLY); + + + //Build AS + if(first) { + MatMatMult(A,S, MAT_INITIAL_MATRIX,PETSC_DEFAULT,&AS); + first=0; + } + else + MatMatMult(A,S, MAT_REUSE_MATRIX,PETSC_DEFAULT,&AS); + + + + + //Minimization with CGLS + MatMult(AS, Alpha, r); VecAYPX(r, -1, b); //r_0 = b-AS*x_0 + + + MatMultTranspose(AS, r, p); //p_0 = AS'*r_0 + + + + + ierr = VecCopy(p, ss); CHKERRQ(ierr); //p_0 = s_0 + VecNorm(ss, NORM_2, &gamma); gamma = gamma * gamma; //gamma = norm2(s)^2 + while(gamma>cgprec && iterEprecision ){ + for(col=0; colEprecision; col++){ + + + //Solve + ierr = KSPSolve(ksp, b, x); CHKERRQ(ierr); + + ierr = KSPGetIterationNumber(ksp, &its); CHKERRQ(ierr); + total += its; Iiter ++; + + + + //Build S' + ierr = VecGetArray(x, &array); + ierr = MatSetValues(S, Iend-Istart, ind_row, 1, &col, array, INSERT_VALUES); + VecRestoreArray(x, &array); + + + + KSPGetResidualNorm(ksp,&norm); + /* + //Error + ierr = VecCopy(x, residu); CHKERRQ(ierr); + ierr = VecAXPY(residu, -1, x_old); CHKERRQ(ierr); + ierr = VecNorm(residu, NORM_INFINITY, &norm); CHKERRQ(ierr); + */ + + + ierr = PetscPrintf(PETSC_COMM_WORLD, "Norm of error %g, outer iteration %D\n", norm, giter); CHKERRQ(ierr); + ierr = VecCopy(x, x_old); CHKERRQ(ierr); + + + } + + + //minimization step + if( norm>Eprecision) { + + MatAssemblyBegin(S, MAT_FINAL_ASSEMBLY); + MatAssemblyEnd(S, MAT_FINAL_ASSEMBLY); + + + + + //Build AS + if(first) { + MatMatMult(A,S, MAT_INITIAL_MATRIX,PETSC_DEFAULT,&AS); + + first=0; + } + else + MatMatMult(A,S, MAT_REUSE_MATRIX,PETSC_DEFAULT,&AS); + + + + + + //LSQR + //LSQR + //LSQR + + + + PetscScalar n2b,tolb,normr,c,s,phibar,normar,norma,thet,rhot,rho,phi; + PetscInt stag; + tolb = tol * n2b; + VecNorm(b, NORM_2, &n2b); //n2b = norm(b); + ierr = VecCopy(b, u); CHKERRQ(ierr); //u=b + VecNorm(u, NORM_2, &beta); // beta=norm(u) + normr=beta; + if (beta != 0) { + VecAYPX(u,1/beta,zero_long); // u = u / beta; + } + c=1; + s=0; + phibar=beta; + MatMultTranspose(AS, u, v); //v=A'*u + ierr = VecSet(x_lsqr,0);CHKERRQ(ierr); + VecNorm(v, NORM_2, &alpha); // alpha=norm(v) + if (alpha != 0) { + VecAYPX(v,1/alpha,zero_short); // v = v / alpha; + } + ierr = VecSet(d,0);CHKERRQ(ierr); + normar = alpha * beta; + norma=0; + //stag=0; + for(i=0;i PetscRealPart(opts_xc)) { + element_props[j][i].E[p] = opts_E1; + element_props[j][i].nu[p] = opts_nu1; + } + + element_props[j][i].fx[p] = 0.0; + element_props[j][i].fy[p] = 0.0; + } + } else if (coefficient_structure == 2) { /* brick */ + PetscReal values_E[10]; + PetscReal values_nu[10]; + PetscInt nbricks,maxnbricks; + PetscInt index,span; + PetscInt jj; + + flg = PETSC_FALSE; + maxnbricks = 10; + ierr = PetscOptionsGetRealArray(NULL, "-brick_E",values_E,&maxnbricks,&flg);CHKERRQ(ierr); + nbricks = maxnbricks; + if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"User must supply a list of E values for each brick");CHKERRQ(ierr); + + flg = PETSC_FALSE; + maxnbricks = 10; + ierr = PetscOptionsGetRealArray(NULL, "-brick_nu",values_nu,&maxnbricks,&flg);CHKERRQ(ierr); + if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"User must supply a list of nu values for each brick");CHKERRQ(ierr); + if (maxnbricks != nbricks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"User must supply equal numbers of values for E and nu");CHKERRQ(ierr); + + span = 1; + ierr = PetscOptionsGetInt(NULL,"-brick_span",&span,&flg);CHKERRQ(ierr); + + /* cycle through the indices so that no two material properties are repeated in lines of x or y */ + jj = (j/span)%nbricks; + index = (jj+i/span)%nbricks; + /*printf("j=%d: index = %d \n", j,index); */ + + for (p = 0; p < GAUSS_POINTS; p++) { + element_props[j][i].E[p] = values_E[index]; + element_props[j][i].nu[p] = values_nu[index]; + } + } else if (coefficient_structure == 3) { /* sponge */ + PetscScalar opts_E0,opts_nu0; + PetscScalar opts_E1,opts_nu1; + PetscInt opts_t,opts_w; + PetscInt ii,jj,ci,cj; + + opts_E0 = opts_E1 = 1.0; + opts_nu0 = opts_nu1 = 0.333; + ierr = PetscOptionsGetScalar(NULL,"-sponge_E0",&opts_E0,&flg);CHKERRQ(ierr); + ierr = PetscOptionsGetScalar(NULL,"-sponge_nu0",&opts_nu0,&flg);CHKERRQ(ierr); + ierr = PetscOptionsGetScalar(NULL,"-sponge_E1",&opts_E1,&flg);CHKERRQ(ierr); + ierr = PetscOptionsGetScalar(NULL,"-sponge_nu1",&opts_nu1,&flg);CHKERRQ(ierr); + + opts_t = opts_w = 1; + ierr = PetscOptionsGetInt(NULL,"-sponge_t",&opts_t,&flg);CHKERRQ(ierr); + ierr = PetscOptionsGetInt(NULL,"-sponge_w",&opts_w,&flg);CHKERRQ(ierr); + + ii = (i)/(opts_t+opts_w+opts_t); + jj = (j)/(opts_t+opts_w+opts_t); + + ci = i - ii*(opts_t+opts_w+opts_t); + cj = j - jj*(opts_t+opts_w+opts_t); + + for (p = 0; p < GAUSS_POINTS; p++) { + element_props[j][i].E[p] = opts_E0; + element_props[j][i].nu[p] = opts_nu0; + } + if ((ci >= opts_t) && (ci < opts_t+opts_w)) { + if ((cj >= opts_t) && (cj < opts_t+opts_w)) { + for (p = 0; p < GAUSS_POINTS; p++) { + element_props[j][i].E[p] = opts_E1; + element_props[j][i].nu[p] = opts_nu1; + } + } + } + + } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Unknown coefficient_structure"); + } + } + ierr = DMDAVecRestoreArray(prop_cda,prop_coords,&_prop_coords);CHKERRQ(ierr); + + ierr = DMDAVecRestoreArray(vel_cda,vel_coords,&_vel_coords);CHKERRQ(ierr); + + ierr = DMDAVecRestoreArray(da_prop,l_properties,&element_props);CHKERRQ(ierr); + ierr = DMLocalToGlobalBegin(da_prop,l_properties,ADD_VALUES,properties);CHKERRQ(ierr); + ierr = DMLocalToGlobalEnd(da_prop,l_properties,ADD_VALUES,properties);CHKERRQ(ierr); + + ierr = PetscOptionsGetBool(NULL,"-no_view",&no_view,NULL);CHKERRQ(ierr); + if (!no_view) { + ierr = DMDAViewCoefficientsGnuplot2d(da_prop,properties,"Coeffcients for elasticity eqn.","properties");CHKERRQ(ierr); + ierr = DMDACoordViewGnuplot2d(elas_da,"mesh");CHKERRQ(ierr); + } + + /* Generate a matrix with the correct non-zero pattern of type AIJ. This will work in parallel and serial */ + ierr = DMSetMatType(elas_da,MATAIJ);CHKERRQ(ierr); + ierr = DMCreateMatrix(elas_da,&A);CHKERRQ(ierr); + ierr = DMGetCoordinates(elas_da,&vel_coords);CHKERRQ(ierr); + ierr = MatNullSpaceCreateRigidBody(vel_coords,&matnull);CHKERRQ(ierr); + ierr = MatSetNearNullSpace(A,matnull);CHKERRQ(ierr); + ierr = MatNullSpaceDestroy(&matnull);CHKERRQ(ierr); + ierr = MatGetVecs(A,&f,&X);CHKERRQ(ierr); + + /* assemble A11 */ + ierr = MatZeroEntries(A);CHKERRQ(ierr); + ierr = VecZeroEntries(f);CHKERRQ(ierr); + + ierr = AssembleA_Elasticity(A,elas_da,da_prop,properties);CHKERRQ(ierr); + /* build force vector */ + ierr = AssembleF_Elasticity(f,elas_da,da_prop,properties);CHKERRQ(ierr); + + + ierr = KSPCreate(PETSC_COMM_WORLD,&ksp_E);CHKERRQ(ierr); + ierr = KSPSetOptionsPrefix(ksp_E,"elas_");CHKERRQ(ierr); /* elasticity */ + + ierr = PetscOptionsGetBool(NULL,"-use_nonsymbc",&use_nonsymbc,&flg);CHKERRQ(ierr); + /* solve */ + if (!use_nonsymbc) { + Mat AA; + Vec ff,XX; + IS is; + VecScatter scat; + + ierr = DMDABCApplySymmetricCompression(elas_da,A,f,&is,&AA,&ff);CHKERRQ(ierr); + ierr = VecDuplicate(ff,&XX);CHKERRQ(ierr); + + ierr = KSPSetOperators(ksp_E,AA,AA);CHKERRQ(ierr); + ierr = KSPSetFromOptions(ksp_E);CHKERRQ(ierr); + + ierr = KSPSetFromOptions(ksp_E);CHKERRQ(ierr); + + PetscScalar T1,T2; + ierr = KSPSetTolerances(ksp_E, 1e-9, 1e-9, PETSC_DEFAULT, 50000000); CHKERRQ(ierr); + T1 = MPI_Wtime(); + + ierr = KSPSolve(ksp_E,ff,XX);CHKERRQ(ierr); + T2 = MPI_Wtime(); + + Mat A; + Vec sol; + PetscScalar norm; + Vec X2; + + VecDuplicate(ff,&sol); + VecDuplicate(ff,&X2); + VecCopy(ff,X2); + + + KSPGetOperators(ksp_E,&A,NULL); + MatMult(A,XX,sol); + VecAXPY(sol,-1,ff); + VecNorm(sol, NORM_2, &norm); + + + ierr = PetscPrintf(PETSC_COMM_WORLD, "\t\t\t -- Norm of error : %g\n", (double)norm); CHKERRQ(ierr); + ierr = PetscPrintf(PETSC_COMM_WORLD, "\t\t\t -- Execution time : %g (s)\n", T2-T1); CHKERRQ(ierr); + PetscInt total; + ierr = KSPGetIterationNumber(ksp_E, &total); CHKERRQ(ierr); + ierr = PetscPrintf(PETSC_COMM_WORLD, "\t\t\t -- Total number of iterations : %D\n", total); CHKERRQ(ierr); + + + + + KrylovMinimize(A, ff, X2); + MatMult(A,X2,sol); + + + VecAXPY(sol,-1,ff); + VecNorm(sol, NORM_2, &norm); + ierr = PetscPrintf(PETSC_COMM_WORLD, "Error2 %g\n",norm); + + + + + VecCopy(ff,X2); + KrylovMinimizeLSQR(A, ff, X2); + MatMult(A,X2,sol); + + + VecAXPY(sol,-1,ff); + VecNorm(sol, NORM_2, &norm); + ierr = PetscPrintf(PETSC_COMM_WORLD, "ErrorLSQR %g\n",norm); + + + + /* push XX back into X */ + ierr = DMDABCApplyCompression(elas_da,NULL,X);CHKERRQ(ierr); + + ierr = VecScatterCreate(XX,NULL,X,is,&scat);CHKERRQ(ierr); + ierr = VecScatterBegin(scat,XX,X,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); + ierr = VecScatterEnd(scat,XX,X,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); + ierr = VecScatterDestroy(&scat);CHKERRQ(ierr); + + ierr = MatDestroy(&AA);CHKERRQ(ierr); + ierr = VecDestroy(&ff);CHKERRQ(ierr); + ierr = VecDestroy(&XX);CHKERRQ(ierr); + ierr = ISDestroy(&is);CHKERRQ(ierr); + } else { + ierr = DMDABCApplyCompression(elas_da,A,f);CHKERRQ(ierr); + + ierr = KSPSetOperators(ksp_E,A,A);CHKERRQ(ierr); + ierr = KSPSetFromOptions(ksp_E);CHKERRQ(ierr); + + ierr = KSPSolve(ksp_E,f,X);CHKERRQ(ierr); + } + + if (!no_view) {ierr = DMDAViewGnuplot2d(elas_da,X,"Displacement solution for elasticity eqn.","X");CHKERRQ(ierr);} + ierr = KSPDestroy(&ksp_E);CHKERRQ(ierr); + + ierr = VecDestroy(&X);CHKERRQ(ierr); + ierr = VecDestroy(&f);CHKERRQ(ierr); + ierr = MatDestroy(&A);CHKERRQ(ierr); + + ierr = DMDestroy(&elas_da);CHKERRQ(ierr); + ierr = DMDestroy(&da_prop);CHKERRQ(ierr); + + ierr = VecDestroy(&properties);CHKERRQ(ierr); + ierr = VecDestroy(&l_properties);CHKERRQ(ierr); + PetscFunctionReturn(0); +} + +#undef __FUNCT__ +#define __FUNCT__ "main" +int main(int argc,char **args) +{ + PetscErrorCode ierr; + PetscInt mx,my; + + ierr = PetscInitialize(&argc,&args,(char*)0,help);CHKERRQ(ierr); + + mx = my = 10; + ierr = PetscOptionsGetInt(NULL,"-mx",&mx,NULL);CHKERRQ(ierr); + ierr = PetscOptionsGetInt(NULL,"-my",&my,NULL);CHKERRQ(ierr); + + ierr = solve_elasticity_2d(mx,my);CHKERRQ(ierr); + + ierr = PetscFinalize();CHKERRQ(ierr); + return 0; +} + +/* -------------------------- helpers for boundary conditions -------------------------------- */ + +#undef __FUNCT__ +#define __FUNCT__ "BCApply_EAST" +static PetscErrorCode BCApply_EAST(DM da,PetscInt d_idx,PetscScalar bc_val,Mat A,Vec b) +{ + DM cda; + Vec coords; + PetscInt si,sj,nx,ny,i,j; + PetscInt M,N; + DMDACoor2d **_coords; + const PetscInt *g_idx; + PetscInt *bc_global_ids; + PetscScalar *bc_vals; + PetscInt nbcs; + PetscInt n_dofs; + PetscErrorCode ierr; + ISLocalToGlobalMapping ltogm; + + PetscFunctionBeginUser; + /* enforce bc's */ + ierr = DMGetLocalToGlobalMapping(da,<ogm);CHKERRQ(ierr); + ierr = ISLocalToGlobalMappingGetIndices(ltogm,&g_idx);CHKERRQ(ierr); + + ierr = DMGetCoordinateDM(da,&cda);CHKERRQ(ierr); + ierr = DMGetCoordinatesLocal(da,&coords);CHKERRQ(ierr); + ierr = DMDAVecGetArray(cda,coords,&_coords);CHKERRQ(ierr); + ierr = DMDAGetGhostCorners(cda,&si,&sj,0,&nx,&ny,0);CHKERRQ(ierr); + ierr = DMDAGetInfo(da,0,&M,&N,0,0,0,0,&n_dofs,0,0,0,0,0);CHKERRQ(ierr); + + /* --- */ + + ierr = PetscMalloc(sizeof(PetscInt)*ny*n_dofs,&bc_global_ids);CHKERRQ(ierr); + ierr = PetscMalloc(sizeof(PetscScalar)*ny*n_dofs,&bc_vals);CHKERRQ(ierr); + + /* init the entries to -1 so VecSetValues will ignore them */ + for (i = 0; i < ny*n_dofs; i++) bc_global_ids[i] = -1; + + i = nx-1; + for (j = 0; j < ny; j++) { + PetscInt local_id; + PETSC_UNUSED PetscScalar coordx,coordy; + + local_id = i+j*nx; + + bc_global_ids[j] = g_idx[n_dofs*local_id+d_idx]; + + coordx = _coords[j+sj][i+si].x; + coordy = _coords[j+sj][i+si].y; + + bc_vals[j] = bc_val; + } + ierr = ISLocalToGlobalMappingRestoreIndices(ltogm,&g_idx);CHKERRQ(ierr); + nbcs = 0; + if ((si+nx) == (M)) nbcs = ny; + + if (b) { + ierr = VecSetValues(b,nbcs,bc_global_ids,bc_vals,INSERT_VALUES);CHKERRQ(ierr); + ierr = VecAssemblyBegin(b);CHKERRQ(ierr); + ierr = VecAssemblyEnd(b);CHKERRQ(ierr); + } + if (A) { + ierr = MatZeroRows(A,nbcs,bc_global_ids,1.0,0,0);CHKERRQ(ierr); + } + + ierr = PetscFree(bc_vals);CHKERRQ(ierr); + ierr = PetscFree(bc_global_ids);CHKERRQ(ierr); + + ierr = DMDAVecRestoreArray(cda,coords,&_coords);CHKERRQ(ierr); + PetscFunctionReturn(0); +} + +#undef __FUNCT__ +#define __FUNCT__ "BCApply_WEST" +static PetscErrorCode BCApply_WEST(DM da,PetscInt d_idx,PetscScalar bc_val,Mat A,Vec b) +{ + DM cda; + Vec coords; + PetscInt si,sj,nx,ny,i,j; + PetscInt M,N; + DMDACoor2d **_coords; + const PetscInt *g_idx; + PetscInt *bc_global_ids; + PetscScalar *bc_vals; + PetscInt nbcs; + PetscInt n_dofs; + PetscErrorCode ierr; + ISLocalToGlobalMapping ltogm; + + PetscFunctionBeginUser; + /* enforce bc's */ + ierr = DMGetLocalToGlobalMapping(da,<ogm);CHKERRQ(ierr); + ierr = ISLocalToGlobalMappingGetIndices(ltogm,&g_idx);CHKERRQ(ierr); + + ierr = DMGetCoordinateDM(da,&cda);CHKERRQ(ierr); + ierr = DMGetCoordinatesLocal(da,&coords);CHKERRQ(ierr); + ierr = DMDAVecGetArray(cda,coords,&_coords);CHKERRQ(ierr); + ierr = DMDAGetGhostCorners(cda,&si,&sj,0,&nx,&ny,0);CHKERRQ(ierr); + ierr = DMDAGetInfo(da,0,&M,&N,0,0,0,0,&n_dofs,0,0,0,0,0);CHKERRQ(ierr); + + /* --- */ + + ierr = PetscMalloc(sizeof(PetscInt)*ny*n_dofs,&bc_global_ids);CHKERRQ(ierr); + ierr = PetscMalloc(sizeof(PetscScalar)*ny*n_dofs,&bc_vals);CHKERRQ(ierr); + + /* init the entries to -1 so VecSetValues will ignore them */ + for (i = 0; i < ny*n_dofs; i++) bc_global_ids[i] = -1; + + i = 0; + for (j = 0; j < ny; j++) { + PetscInt local_id; + PETSC_UNUSED PetscScalar coordx,coordy; + + local_id = i+j*nx; + + bc_global_ids[j] = g_idx[n_dofs*local_id+d_idx]; + + coordx = _coords[j+sj][i+si].x; + coordy = _coords[j+sj][i+si].y; + + bc_vals[j] = bc_val; + } + ierr = ISLocalToGlobalMappingRestoreIndices(ltogm,&g_idx);CHKERRQ(ierr); + nbcs = 0; + if (si == 0) nbcs = ny; + + if (b) { + ierr = VecSetValues(b,nbcs,bc_global_ids,bc_vals,INSERT_VALUES);CHKERRQ(ierr); + ierr = VecAssemblyBegin(b);CHKERRQ(ierr); + ierr = VecAssemblyEnd(b);CHKERRQ(ierr); + } + if (A) { + ierr = MatZeroRows(A,nbcs,bc_global_ids,1.0,0,0);CHKERRQ(ierr); + } + + ierr = PetscFree(bc_vals);CHKERRQ(ierr); + ierr = PetscFree(bc_global_ids);CHKERRQ(ierr); + + ierr = DMDAVecRestoreArray(cda,coords,&_coords);CHKERRQ(ierr); + PetscFunctionReturn(0); +} + +#undef __FUNCT__ +#define __FUNCT__ "DMDABCApplyCompression" +static PetscErrorCode DMDABCApplyCompression(DM elas_da,Mat A,Vec f) +{ + PetscErrorCode ierr; + + PetscFunctionBeginUser; + ierr = BCApply_EAST(elas_da,0,-1.0,A,f);CHKERRQ(ierr); + ierr = BCApply_EAST(elas_da,1, 0.0,A,f);CHKERRQ(ierr); + ierr = BCApply_WEST(elas_da,0,1.0,A,f);CHKERRQ(ierr); + ierr = BCApply_WEST(elas_da,1,0.0,A,f);CHKERRQ(ierr); + PetscFunctionReturn(0); +} + +#undef __FUNCT__ +#define __FUNCT__ "DMDABCApplySymmetricCompression" +static PetscErrorCode DMDABCApplySymmetricCompression(DM elas_da,Mat A,Vec f,IS *dofs,Mat *AA,Vec *ff) +{ + PetscErrorCode ierr; + PetscInt start,end,m; + PetscInt *unconstrained; + PetscInt cnt,i; + Vec x; + PetscScalar *_x; + IS is; + VecScatter scat; + + PetscFunctionBeginUser; + /* push bc's into f and A */ + ierr = VecDuplicate(f,&x);CHKERRQ(ierr); + ierr = BCApply_EAST(elas_da,0,-1.0,A,x);CHKERRQ(ierr); + ierr = BCApply_EAST(elas_da,1, 0.0,A,x);CHKERRQ(ierr); + ierr = BCApply_WEST(elas_da,0,1.0,A,x);CHKERRQ(ierr); + ierr = BCApply_WEST(elas_da,1,0.0,A,x);CHKERRQ(ierr); + + /* define which dofs are not constrained */ + ierr = VecGetLocalSize(x,&m);CHKERRQ(ierr); + ierr = PetscMalloc(sizeof(PetscInt)*m,&unconstrained);CHKERRQ(ierr); + ierr = VecGetOwnershipRange(x,&start,&end);CHKERRQ(ierr); + ierr = VecGetArray(x,&_x);CHKERRQ(ierr); + cnt = 0; + for (i = 0; i < m; i++) { + PetscReal val; + + val = PetscRealPart(_x[i]); + if (fabs(val) < 0.1) { + unconstrained[cnt] = start + i; + cnt++; + } + } + ierr = VecRestoreArray(x,&_x);CHKERRQ(ierr); + + ierr = ISCreateGeneral(PETSC_COMM_WORLD,cnt,unconstrained,PETSC_COPY_VALUES,&is);CHKERRQ(ierr); + ierr = PetscFree(unconstrained);CHKERRQ(ierr); + + /* define correction for dirichlet in the rhs */ + ierr = MatMult(A,x,f);CHKERRQ(ierr); + ierr = VecScale(f,-1.0);CHKERRQ(ierr); + + /* get new matrix */ + ierr = MatGetSubMatrix(A,is,is,MAT_INITIAL_MATRIX,AA);CHKERRQ(ierr); + /* get new vector */ + ierr = MatGetVecs(*AA,NULL,ff);CHKERRQ(ierr); + + ierr = VecScatterCreate(f,is,*ff,NULL,&scat);CHKERRQ(ierr); + ierr = VecScatterBegin(scat,f,*ff,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); + ierr = VecScatterEnd(scat,f,*ff,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); + + { /* Constrain near-null space */ + PetscInt nvecs; + const Vec *vecs; + Vec *uvecs; + PetscBool has_const; + MatNullSpace mnull,unull; + ierr = MatGetNearNullSpace(A,&mnull);CHKERRQ(ierr); + ierr = MatNullSpaceGetVecs(mnull,&has_const,&nvecs,&vecs);CHKERRQ(ierr); + ierr = VecDuplicateVecs(*ff,nvecs,&uvecs);CHKERRQ(ierr); + for (i=0; i