/*@ PetscDTGaussQuadrature - create Gauss quadrature Not Collective Input Arguments: + npoints - number of points . a - left end of interval (often-1) - b - right end of interval (often +1) Output Arguments: + x - quadrature points - w - quadrature weights Level: intermediate References: Golub and Welsch, Calculation of Quadrature Rules, Math. Comp. 23(106), 221--230, 1969. .seealso: PetscDTLegendreEval() @*/ PetscErrorCode PetscDTGaussQuadrature(PetscInt npoints,PetscReal a,PetscReal b,PetscReal *x,PetscReal *w) { PetscErrorCode ierr; PetscInt i; PetscReal *work; PetscScalar *Z; PetscBLASInt N,LDZ,info; PetscFunctionBegin; /* Set up the Golub-Welsch system */ for (i=0; i<npoints; i++) { x[i] = 0; /* diagonal is 0 */ if (i) w[i-1] = 0.5 / PetscSqrtReal(1 - 1./PetscSqr(2*i)); } ierr = PetscRealView(npoints-1,w,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); ierr = PetscMalloc2(npoints*npoints,PetscScalar,&Z,PetscMax(1,2*npoints-2),PetscReal,&work);CHKERRQ(ierr); ierr = PetscBLASIntCast(npoints,&N);CHKERRQ(ierr); LDZ = N; ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); PetscStackCall("LAPACKsteqr",LAPACKsteqr_("I",&N,x,w,Z,&LDZ,work,&info)); ierr = PetscFPTrapPop();CHKERRQ(ierr); if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"xSTEQR error"); for (i=0; i<(npoints+1)/2; i++) { PetscReal y = 0.5 * (-x[i] + x[npoints-i-1]); /* enforces symmetry */ x[i] = (a+b)/2 - y*(b-a)/2; x[npoints-i-1] = (a+b)/2 + y*(b-a)/2; w[i] = w[npoints-1-i] = (b-a)*PetscSqr(0.5*PetscAbsScalar(Z[i*npoints] + Z[(npoints-i-1)*npoints])); } ierr = PetscFree2(Z,work);CHKERRQ(ierr); PetscFunctionReturn(0); }
static PetscErrorCode GLLStuffs(DomainData dd, GLLData *glldata) { PetscErrorCode ierr; PetscReal *M,si; PetscScalar x,z0,z1,z2,Lpj,Lpr,rhoGLj,rhoGLk; PetscBLASInt pm1,lierr; PetscInt i,j,n,k,s,r,q,ii,jj,p=dd.p; PetscInt xloc,yloc,zloc,xyloc,xyzloc; PetscFunctionBeginUser; /* Gauss-Lobatto-Legendre nodes zGL on [-1,1] */ ierr = PetscMalloc1(p+1,&glldata->zGL);CHKERRQ(ierr); ierr = PetscMemzero(glldata->zGL,(p+1)*sizeof(*glldata->zGL));CHKERRQ(ierr); glldata->zGL[0]=-1.0; glldata->zGL[p]= 1.0; if (p > 1) { if (p == 2) glldata->zGL[1]=0.0; else { ierr = PetscMalloc1(p-1,&M);CHKERRQ(ierr); for (i=0; i<p-1; i++) { si = (PetscReal)(i+1.0); M[i]=0.5*PetscSqrtReal(si*(si+2.0)/((si+0.5)*(si+1.5))); } pm1 = p-1; ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); PetscStackCallBLAS("LAPACKsteqr",LAPACKsteqr_("N",&pm1,&glldata->zGL[1],M,&x,&pm1,M,&lierr)); if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in STERF Lapack routine %d",(int)lierr); ierr = PetscFPTrapPop();CHKERRQ(ierr); ierr = PetscFree(M);CHKERRQ(ierr); } } /* Weights for 1D quadrature */ ierr = PetscMalloc1(p+1,&glldata->rhoGL);CHKERRQ(ierr); glldata->rhoGL[0]=2.0/(PetscScalar)(p*(p+1.0)); glldata->rhoGL[p]=glldata->rhoGL[0]; z2 = -1; /* Dummy value to avoid -Wmaybe-initialized */ for (i=1; i<p; i++) { x = glldata->zGL[i]; z0 = 1.0; z1 = x; for (n=1; n<p; n++) { z2 = x*z1*(2.0*n+1.0)/(n+1.0)-z0*(PetscScalar)(n/(n+1.0)); z0 = z1; z1 = z2; } glldata->rhoGL[i]=2.0/(p*(p+1.0)*z2*z2); } /* Auxiliary mat for laplacian */ ierr = PetscMalloc1(p+1,&glldata->A);CHKERRQ(ierr); ierr = PetscMalloc1((p+1)*(p+1),&glldata->A[0]);CHKERRQ(ierr); for (i=1; i<p+1; i++) glldata->A[i]=glldata->A[i-1]+p+1; for (j=1; j<p; j++) { x =glldata->zGL[j]; z0=1.0; z1=x; for (n=1; n<p; n++) { z2=x*z1*(2.0*n+1.0)/(n+1.0)-z0*(PetscScalar)(n/(n+1.0)); z0=z1; z1=z2; } Lpj=z2; for (r=1; r<p; r++) { if (r == j) { glldata->A[j][j]=2.0/(3.0*(1.0-glldata->zGL[j]*glldata->zGL[j])*Lpj*Lpj); } else { x = glldata->zGL[r]; z0 = 1.0; z1 = x; for (n=1; n<p; n++) { z2=x*z1*(2.0*n+1.0)/(n+1.0)-z0*(PetscScalar)(n/(n+1.0)); z0=z1; z1=z2; } Lpr = z2; glldata->A[r][j]=4.0/(p*(p+1.0)*Lpj*Lpr*(glldata->zGL[j]-glldata->zGL[r])*(glldata->zGL[j]-glldata->zGL[r])); } } } for (j=1; j<p+1; j++) { x = glldata->zGL[j]; z0 = 1.0; z1 = x; for (n=1; n<p; n++) { z2=x*z1*(2.0*n+1.0)/(n+1.0)-z0*(PetscScalar)(n/(n+1.0)); z0=z1; z1=z2; } Lpj = z2; glldata->A[j][0]=4.0*PetscPowRealInt(-1.0,p)/(p*(p+1.0)*Lpj*(1.0+glldata->zGL[j])*(1.0+glldata->zGL[j])); glldata->A[0][j]=glldata->A[j][0]; } for (j=0; j<p; j++) { x = glldata->zGL[j]; z0 = 1.0; z1 = x; for (n=1; n<p; n++) { z2=x*z1*(2.0*n+1.0)/(n+1.0)-z0*(PetscScalar)(n/(n+1.0)); z0=z1; z1=z2; } Lpj=z2; glldata->A[p][j]=4.0/(p*(p+1.0)*Lpj*(1.0-glldata->zGL[j])*(1.0-glldata->zGL[j])); glldata->A[j][p]=glldata->A[p][j]; } glldata->A[0][0]=0.5+(p*(p+1.0)-2.0)/6.0; glldata->A[p][p]=glldata->A[0][0]; /* compute element matrix */ xloc = p+1; yloc = p+1; zloc = p+1; if (dd.dim<2) yloc=1; if (dd.dim<3) zloc=1; xyloc = xloc*yloc; xyzloc = xloc*yloc*zloc; ierr = MatCreate(PETSC_COMM_SELF,&glldata->elem_mat);CHKERRQ(ierr); ierr = MatSetSizes(glldata->elem_mat,xyzloc,xyzloc,xyzloc,xyzloc);CHKERRQ(ierr); ierr = MatSetType(glldata->elem_mat,MATSEQAIJ);CHKERRQ(ierr); ierr = MatSeqAIJSetPreallocation(glldata->elem_mat,xyzloc,NULL);CHKERRQ(ierr); /* overestimated */ ierr = MatZeroEntries(glldata->elem_mat);CHKERRQ(ierr); ierr = MatSetOption(glldata->elem_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr); for (k=0; k<zloc; k++) { if (dd.dim>2) rhoGLk=glldata->rhoGL[k]; else rhoGLk=1.0; for (j=0; j<yloc; j++) { if (dd.dim>1) rhoGLj=glldata->rhoGL[j]; else rhoGLj=1.0; for (i=0; i<xloc; i++) { ii = k*xyloc+j*xloc+i; s = k; r = j; for (q=0; q<xloc; q++) { jj = s*xyloc+r*xloc+q; ierr = MatSetValue(glldata->elem_mat,jj,ii,glldata->A[i][q]*rhoGLj*rhoGLk,ADD_VALUES);CHKERRQ(ierr); } if (dd.dim>1) { s=k; q=i; for (r=0; r<yloc; r++) { jj = s*xyloc+r*xloc+q; ierr = MatSetValue(glldata->elem_mat,jj,ii,glldata->A[j][r]*glldata->rhoGL[i]*rhoGLk,ADD_VALUES);CHKERRQ(ierr); } } if (dd.dim>2) { r=j; q=i; for (s=0; s<zloc; s++) { jj = s*xyloc+r*xloc+q; ierr = MatSetValue(glldata->elem_mat,jj,ii,glldata->A[k][s]*rhoGLj*glldata->rhoGL[i],ADD_VALUES);CHKERRQ(ierr); } } } } } ierr = MatAssemblyBegin(glldata->elem_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd (glldata->elem_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); #if DEBUG { Vec lvec,rvec; PetscReal norm; ierr = MatCreateVecs(glldata->elem_mat,&lvec,&rvec);CHKERRQ(ierr); ierr = VecSet(lvec,1.0);CHKERRQ(ierr); ierr = MatMult(glldata->elem_mat,lvec,rvec);CHKERRQ(ierr); ierr = VecNorm(rvec,NORM_INFINITY,&norm);CHKERRQ(ierr); printf("Test null space of elem mat % 1.14e\n",norm); ierr = VecDestroy(&lvec);CHKERRQ(ierr); ierr = VecDestroy(&rvec);CHKERRQ(ierr); } #endif PetscFunctionReturn(0); }