├── doc ├── manual.pdf ├── geometry.pdf ├── tutorial.pdf ├── README └── tutorial.tex ├── gallery ├── lenses.png ├── rf_45modes.png ├── mpspack-logo.gif ├── sqscatt2_cut.png ├── hewett_uk_modes.png └── hny2014_perrin_cut.png ├── @utils ├── inpolyc.mexa64 ├── gslbesselj.mexa64 ├── gslbesseljnu.mexa64 ├── insidepoly_dblengine.mexw32 ├── insidepoly_dblengine.mexw64 ├── insidepoly_sglengine.mexw32 ├── insidepoly_sglengine.mexw64 ├── greengardrokhlinhank103.mexa64 ├── greengardrokhlinhank106.mexa64 ├── insidepoly_dblengine.m ├── insidepoly_sglengine.m ├── lowestn.m ├── monochrome.m ├── README ├── isin.m ├── merge.m ├── baryeval.m ├── baryweights.m ├── goodcaxis.m ├── inpolyc.m ├── copy.m ├── baryprojs.m ├── unique.m ├── arrow.m ├── regeig.m ├── Makefile ├── insidepoly_license.txt ├── trigpolyzeros.m ├── utils.m ├── fundsol.m ├── gslbesselj.c ├── greengardrokhlinhank103.c ├── minsingvalvecs.m ├── greengardrokhlinhank106.c └── gslbesseljnu.c ├── circulant.m ├── circle.m ├── @quadr ├── traprule.m ├── peritrap.m ├── perispecdiffrow.m ├── kress_Rjn.m ├── gauss.m ├── smoothedstep.m ├── clencurt.m ├── test_kapurtrap_Gimbutas.m ├── QuadNodesIntervalSeq.m ├── quadr.m ├── test_Alpert_Pataki.m ├── interptrig.m ├── kapurtrap.m └── QuadNodesInterval.m ├── @domain ├── setrefractiveindex.m ├── addepwbasis.m ├── addrpwbasis.m ├── addregfbbasis.m ├── approxpolygon.m ├── showdomains.m ├── addmfsbasis.m ├── addnufbbasis.m ├── stackquadpts.m ├── addqprayleighbasis.m ├── showsegments.m ├── addlayerpot.m ├── evalbases.m ├── addcornerbases.m └── plot.m ├── test ├── testperispecdiff.m ├── testbaryinterp.m ├── testinterptrig.m ├── testintervalrootsboyd.m ├── testmodeserrors.m ├── testsmoothfourierz.m ├── testbasisdomain.m ├── testqpbstlayerpot.m ├── testminsingvalvecs.m ├── testclasstimings.m ├── testscattering_fmm.m ├── testbordering.m ├── testextrap.m ├── testqprayleighbasis.m ├── testfbbasis.m ├── testbvp_fmm.m ├── testproblemevalbases.m ├── testalpertquadr.m ├── testsegment.m ├── testcirclescatt.m ├── testrecurrencebesselJ.m ├── testdielscatrokh.m ├── testbvpbyhand.m ├── testlayerpotevalfty.m ├── testevpms.m ├── testiterparabolafit.m ├── testinvertZparam.m ├── testcornerquad.m ├── testgratingdir.m ├── testlayerpot.m └── testevp.m ├── examples ├── neumann_inclusion │ ├── test_gsvd.m │ ├── fig_Gh.m │ ├── Cennenbach.m │ ├── genrefsetneu.m │ ├── README │ ├── fig_tsweeps.m │ └── fig_intromodes.m ├── tut_fmmlayer.m ├── twodieldiscspointsrcscat.m ├── gasketevp.m ├── hewett_uk_eigs.m ├── dielscatrokh.m ├── tut_lap.m ├── tut_discarray.m ├── tut_scatt.m ├── ridgeguide.m ├── tut_conv.m ├── tut_ext.m ├── smoothdrummodesboyd.m ├── tut_layer.m ├── tut_square.m ├── dielscatrokhcornerskress.m ├── larrycup.m ├── lenses.m └── smoothdrummodesNtD.m ├── Makefile ├── polyeig_companion.m ├── tsubplot.m ├── @pointset ├── plot.m └── pointset.m ├── @layerpot ├── Skernel.m ├── DTkernel.m ├── Dkernel.m ├── Tkernel.m ├── fundsol.m ├── QBXbox.m └── fundsol_deriv.m ├── @evp ├── para_fit.m ├── intnormmatrix.m ├── solvebetaodeneu.m ├── weylcountcheck.m ├── NtDspectrum.m ├── solvebetaode.m ├── spectralfiltermatrix.m └── filteredDtNspectrum.m ├── @segment ├── smoothstar.m ├── smoothnonsym.m ├── QBXgammaconst.m ├── dielectriccoeffs.m ├── polyseglist.m ├── addinoutlayerpots.m ├── radialfunc.m ├── smoothfourier.m ├── smoothfourierz.m └── plot.m ├── showmatpoly.m ├── @scattering ├── gridfarfield.m ├── pointfarfield.m └── showfarfield.m ├── diagind.m ├── make.inc ├── showfields.m ├── num2cellstr.m ├── showfield.m ├── @qpunitcell └── datawrapR.m ├── @mfsbasis └── evalfarfield.m └── INSTALL /doc/manual.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ahbarnett/mpspack/HEAD/doc/manual.pdf -------------------------------------------------------------------------------- /doc/geometry.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ahbarnett/mpspack/HEAD/doc/geometry.pdf -------------------------------------------------------------------------------- /doc/tutorial.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ahbarnett/mpspack/HEAD/doc/tutorial.pdf -------------------------------------------------------------------------------- /gallery/lenses.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ahbarnett/mpspack/HEAD/gallery/lenses.png -------------------------------------------------------------------------------- /@utils/inpolyc.mexa64: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ahbarnett/mpspack/HEAD/@utils/inpolyc.mexa64 -------------------------------------------------------------------------------- /gallery/rf_45modes.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ahbarnett/mpspack/HEAD/gallery/rf_45modes.png -------------------------------------------------------------------------------- /@utils/gslbesselj.mexa64: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ahbarnett/mpspack/HEAD/@utils/gslbesselj.mexa64 -------------------------------------------------------------------------------- /gallery/mpspack-logo.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ahbarnett/mpspack/HEAD/gallery/mpspack-logo.gif -------------------------------------------------------------------------------- /gallery/sqscatt2_cut.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ahbarnett/mpspack/HEAD/gallery/sqscatt2_cut.png -------------------------------------------------------------------------------- /@utils/gslbesseljnu.mexa64: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ahbarnett/mpspack/HEAD/@utils/gslbesseljnu.mexa64 -------------------------------------------------------------------------------- /gallery/hewett_uk_modes.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ahbarnett/mpspack/HEAD/gallery/hewett_uk_modes.png -------------------------------------------------------------------------------- /gallery/hny2014_perrin_cut.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ahbarnett/mpspack/HEAD/gallery/hny2014_perrin_cut.png -------------------------------------------------------------------------------- /@utils/insidepoly_dblengine.mexw32: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ahbarnett/mpspack/HEAD/@utils/insidepoly_dblengine.mexw32 -------------------------------------------------------------------------------- /@utils/insidepoly_dblengine.mexw64: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ahbarnett/mpspack/HEAD/@utils/insidepoly_dblengine.mexw64 -------------------------------------------------------------------------------- /@utils/insidepoly_sglengine.mexw32: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ahbarnett/mpspack/HEAD/@utils/insidepoly_sglengine.mexw32 -------------------------------------------------------------------------------- /@utils/insidepoly_sglengine.mexw64: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ahbarnett/mpspack/HEAD/@utils/insidepoly_sglengine.mexw64 -------------------------------------------------------------------------------- /@utils/greengardrokhlinhank103.mexa64: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ahbarnett/mpspack/HEAD/@utils/greengardrokhlinhank103.mexa64 -------------------------------------------------------------------------------- /@utils/greengardrokhlinhank106.mexa64: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ahbarnett/mpspack/HEAD/@utils/greengardrokhlinhank106.mexa64 -------------------------------------------------------------------------------- /@utils/insidepoly_dblengine.m: -------------------------------------------------------------------------------- 1 | function insidepoly_dblengine 2 | 3 | error('Please compile MEX files by runing insidepoly_install'); -------------------------------------------------------------------------------- /@utils/insidepoly_sglengine.m: -------------------------------------------------------------------------------- 1 | function insidepoly_sglengine 2 | 3 | error('Please compile MEX files by runing insidepoly_install'); -------------------------------------------------------------------------------- /@utils/lowestn.m: -------------------------------------------------------------------------------- 1 | function y = lowestn(x,n) 2 | % LOWESTN return smallest n items in a list of numbers. 3 | y = sort(x,'ascend'); 4 | y = y(1:n); 5 | -------------------------------------------------------------------------------- /circulant.m: -------------------------------------------------------------------------------- 1 | function A = circulant(x) 2 | % function A = circulant(x) 3 | % 4 | % return square circulant matrix with first row x 5 | % barnett 2/5/08 6 | 7 | x = x(:); 8 | A = toeplitz([x(1); x(end:-1:2)], x); 9 | -------------------------------------------------------------------------------- /circle.m: -------------------------------------------------------------------------------- 1 | function circle(cx, cy, r, linetype); 2 | 3 | N = 150; 4 | x = zeros(1,N+1); 5 | y = zeros(1,N+1); 6 | for n=1:N+1 7 | x(n) = cx + r*cos(2*pi*n/N); 8 | y(n) = cy + r*sin(2*pi*n/N); 9 | end 10 | hold on; plot(x, y, linetype); hold off; 11 | -------------------------------------------------------------------------------- /@quadr/traprule.m: -------------------------------------------------------------------------------- 1 | function [x w] = traprule(N) 2 | % TRAPRULE quadrature points and weights for composite N+1-point trapezoid 3 | % rule 4 | 5 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 6 | 7 | x = 2*(0:N)'/N - 1; 8 | w = (2/N)*ones(1, N+1); 9 | w(1) = 1/N; w(N+1) = w(1); 10 | -------------------------------------------------------------------------------- /@domain/setrefractiveindex.m: -------------------------------------------------------------------------------- 1 | function setrefractiveindex(doms, n) 2 | % SETREFRACTIVEINDEX - sets n for a list of domains 3 | % 4 | % setrefractiveindex(doms, n) sets refractive index of a list of domains 5 | 6 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 7 | 8 | for d=doms 9 | d.refr_ind = n; 10 | end 11 | -------------------------------------------------------------------------------- /@utils/monochrome.m: -------------------------------------------------------------------------------- 1 | % MONOCHROME - make array of graphics handles go one color 2 | % 3 | function monochrome(h, c) 4 | hl = [findall(h,'Type', 'line'); findall(h,'Type', 'text'); ... 5 | findall(h, 'Type', 'marker')]; set(hl, 'color', c); 6 | hp = findall(h,'Type', 'patch'); set(hp, 'FaceColor', c, 'Edgecolor', c); 7 | -------------------------------------------------------------------------------- /@quadr/peritrap.m: -------------------------------------------------------------------------------- 1 | function [x w] = peritrap(N) 2 | % PERITRAP - trapezoid quadrature rule for periodic functions 3 | 4 | % Copyright (C) 2008 - 2012, Alex Barnett, Timo Betcke 5 | 6 | %x = 2*(1:N)'/N - 1; % original, unsymmetric 7 | x = 2*(1:N)'/N - 1 - 1/N; % shifts half a grid-point back, symmetric about .5 8 | w = 2*ones(1,N)/N; 9 | -------------------------------------------------------------------------------- /test/testperispecdiff.m: -------------------------------------------------------------------------------- 1 | % test periodic spectral differentiation matrix 2 | % Barnett 1/21/09 3 | 4 | clear all classes 5 | N = 50; 6 | tj = 2*pi/N*(1:N)'; 7 | f = sin(3*tj); fp = 3*cos(3*tj); % trial function 8 | D = circulant(quadr.perispecdiffrow(N)); 9 | %figure; imagesc(D); 10 | %figure; plot(tj, [fp D*f], '+-'); 11 | norm(D*f - fp) 12 | 13 | -------------------------------------------------------------------------------- /@quadr/perispecdiffrow.m: -------------------------------------------------------------------------------- 1 | function D = perispecdiffrow(N) 2 | % PERISPECDIFFROW - row 1 of N-pt spectral 2pi-periodic differentiation matrix 3 | 4 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 5 | if mod(N,2)==1, error 'perispecdiffrow: N must be even!', end 6 | tj = 2*pi/N*(0:N-1); 7 | D = (-1).^(1:N) .* cot(tj/2) / 2; % note overall - sgn due to 1st row not col 8 | D(1) = 0; % kill the Inf 9 | -------------------------------------------------------------------------------- /doc/README: -------------------------------------------------------------------------------- 1 | Docs for MPSpack 2 | 3 | The tex files here can be compiled but require EPS figures in the figs/ 4 | directory. Some of these can be created by running examples/*.m codes. 5 | However, since the full set of EPS files is over 60 MB, I have not 6 | included them in this repo. Thus if you chose to try latex compilation 7 | you would get a ton of errors and a figure-free manual and tutorial. 8 | 9 | Alex Barnett 4/12/16 10 | -------------------------------------------------------------------------------- /@utils/README: -------------------------------------------------------------------------------- 1 | Notes on MPSpack utilities class. 2 | 3 | * insidepoly by Bruno Luong: 4 | With the suggestion by Peter Simon, since 2012 we include this, taken from 5 | http://www.mathworks.com/matlabcentral/fileexchange/27840-2d-polygon-interior-detection 6 | And we ship MEX executables for a64, w64, and w32, from Peter Simon. 7 | Please use the above fileexchange to create executables for other OSes. 8 | Also please see insidepoly_license.txt 9 | -------------------------------------------------------------------------------- /@utils/isin.m: -------------------------------------------------------------------------------- 1 | function i = isin(b, c) 2 | % ISIN - returns true if first argument is in cell or array given by second arg 3 | % 4 | % Note: works on arbitrary cell elements. Takes O(N) time. Now allows c to 5 | % be a non-cell array. 6 | i = 0; 7 | if isempty(b), return; end 8 | if ~iscell(c), c = num2cell(c); end % insure it's a cell object 9 | for j=1:numel(c) 10 | t = c{j}; 11 | if isequal(t, b), i=1; return; end 12 | end 13 | -------------------------------------------------------------------------------- /examples/neumann_inclusion/test_gsvd.m: -------------------------------------------------------------------------------- 1 | % understanding GSVD and it's two forms of X output. Matlab vs G-vL, etc. 2 | % Barnett 12/7/15 3 | clear 4 | N = 1e2; 5 | A = rand(N); 6 | B = rand(N); 7 | [UU VV X C S] = gsvd(A,B); 8 | t = sqrt(diag(C'*C)./diag(S'*S)); 9 | X = inv(X'); % crucial, since Matlab's X defined differently! 10 | l = find(t==min(t)); t = t(l); x = X(:,l); % l=index of min gsingval 11 | 12 | t 13 | norm(A*x)/norm(B*x) 14 | % are equal 15 | -------------------------------------------------------------------------------- /@utils/merge.m: -------------------------------------------------------------------------------- 1 | function s = merge(s1,s2) 2 | % MERGE - Merges structures together 3 | % 4 | % s = MERGE(s1,s2) returns a struct that contains all fields 5 | % from the structs s1 and s2. If s1 and s2 have a field with 6 | % the same name s1 has preference. 7 | 8 | s=s1; 9 | names=fieldnames(s2); 10 | for j=1:length(names), 11 | field=names{j}; 12 | if ~isfield(s,field), 13 | s=setfield(s,field,getfield(s2,field)); 14 | end 15 | end 16 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # GNU Makefile for MPSpack tweaks only. 2 | # Compiles fortran/MEX codes, FMM interface, etc. 3 | # Note that MPSpack can work without them. 4 | # 5 | # Tested on linux only. 6 | # Bare-bones for git 4/12/16 7 | # (C) 2008 - 2016 Alex Barnett 8 | 9 | include make.inc 10 | 11 | .PHONY: all tar clean 12 | 13 | default: all 14 | 15 | all: 16 | (cd @utils; make) 17 | 18 | tar: 19 | (cd ..; tar zcvf mpspack.tgz mpspack) 20 | 21 | clean: 22 | (cd @utils; make clean) 23 | -------------------------------------------------------------------------------- /polyeig_companion.m: -------------------------------------------------------------------------------- 1 | function [X E] = polyeig_companion(varargin) 2 | % hack simple first companion matrix form for PEP (Mehrmann's 2004 article) 3 | % barnett 8/20/08 4 | k = numel(varargin)-1; 5 | n = size(varargin{1},1); 6 | A = -eye(n*k); B = diag(-ones(1,n*(k-1)), n); 7 | A(1:n,1:n) = -varargin{k+1}; 8 | for i=0:k-1 9 | B((1:n)+(k-1-i)*n,1:n) = varargin{i+1}; 10 | end 11 | if nargout==1 12 | X = eig(B,A); 13 | else 14 | [X,E] = eig(B,A); 15 | X = X(1:n,:); 16 | end 17 | -------------------------------------------------------------------------------- /tsubplot.m: -------------------------------------------------------------------------------- 1 | function h = tsubplot(m,n,j) 2 | % TSUBPLOT - basic subplot variant that places axes closer together and larger 3 | % 4 | % h = TSUBPLOT(m, n, j) returns handle of axes created at j^th position in 5 | % m-by-n rectangular grid. 6 | 7 | hfac = 0.95; % if 1, completely filled. 8 | vfac = 0.9; % if 1, completely filled. 9 | hgap = 0.5 * (1-hfac); vgap = 0.4 * (1-vfac); 10 | h = axes('position',[(hgap+mod(j-1,n))/n 1-(-vgap+ceil(j/n))/m hfac/n vfac/m]); 11 | -------------------------------------------------------------------------------- /test/testbaryinterp.m: -------------------------------------------------------------------------------- 1 | % test for @utils/bary*.m Lagrange barycentric intepolation 2 | % barnett 1/27/11 3 | 4 | sc = 1.0; %1e10; % scale (causes underflow, etc...?) 5 | x = (1:10)/sc; % interp nodes 6 | gx = (2:0.1:9)/sc; % evaluation checking nodes 7 | f = @(x) sin(x*sc); 8 | w = utils.baryweights(x); 9 | y = f(x); gy = f(gx); 10 | %y = 0*y; y(5) = 1; % extract 5th col of L 11 | u = utils.baryeval(x, w, y, gx); 12 | figure; plot(x, y, '+'); hold on; plot(gx, [gy; u], '-'); 13 | figure; plot(gx, gy - u, '-'); title('difference'); 14 | 15 | -------------------------------------------------------------------------------- /@pointset/plot.m: -------------------------------------------------------------------------------- 1 | function h = plot(pts) 2 | % PLOT - plot a pointset 3 | % 4 | % h = PLOT(pts) plots a pointset with normals, on current figure, returning 5 | % the graphics handle. 6 | % 7 | % See also: POINTSET 8 | 9 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 10 | 11 | g = gcf; 12 | figure(g); hold on; 13 | h = plot(real(pts.x), imag(pts.x), '.'); 14 | if ~isempty(pts.nx) % show normals... 15 | l = 0.1; % length of normals 16 | h = [h; plot([pts.x(:).'; (pts.x(:)+l*pts.nx(:)).'], 'k-')]; 17 | end -------------------------------------------------------------------------------- /test/testinterptrig.m: -------------------------------------------------------------------------------- 1 | % test trig interpolation for upsampling by FFT. Barnett 3/9/12 2 | % The key convention is the 0.5-gridpoint offset of both grids. 3 | 4 | clear; n = 50; t = 2*pi*((1:n)-0.5)/n; % original grid 5 | f = @(t) exp(2*sin(t)); % real analytic periodic 6 | N = 3*n; 7 | g = quadr.interptrig(f(t), N); 8 | tn = 2*pi*((1:N)-0.5)/N; % new grid 9 | norm(g-f(tn)) 10 | figure; plot(t, f(t), '+'); hold on; plot(tn, g, '-'); 11 | 12 | % now test dense matrix for same thing: 13 | A = quadr.interptrig(eye(n), N); 14 | g = A * f(t).'; 15 | norm(g-f(tn).') 16 | 17 | -------------------------------------------------------------------------------- /@utils/baryeval.m: -------------------------------------------------------------------------------- 1 | function u = baryeval(x, w, y, t) 2 | % u = baryeval(x, w, y, t) evaluates at the list of values t, the barycentric 3 | % interpolation formula using nodes x and weights w (found using 4 | % baryweights(x)), and with data y=f(x). Algorithm is O(NM) 5 | % 6 | % Based upon Berrut-Trefethen SIREV 2004, formula (4.2), 2nd true barycentric 7 | % 8 | % See also: BARYWEIGHTS, BARYPROJS 9 | 10 | % Copyright (C) 2011 Alex Barnett 11 | 12 | L = utils.baryprojs(x, w, t); % matrix 13 | u = L * y(:); % gives a col vec 14 | u = reshape(u, size(t)); 15 | -------------------------------------------------------------------------------- /@utils/baryweights.m: -------------------------------------------------------------------------------- 1 | function w = baryweights(x) 2 | % w = baryweights(x) computes barycentric Lagrange weights for interpolation 3 | % x is an input vector of interpolation nodes, w is output of weights, same 4 | % size as x. The algorithm is O(N^2). No attempt to prevent over/underflow. 5 | % 6 | % Based on Berrut-Trefethen SIREV 2004 paper 7 | % 8 | % See also: BARYEVAL 9 | 10 | % Copyright (C) 2011 Alex Barnett 11 | x = x(:); % make a column vector 12 | N = numel(x); 13 | X = repmat(x, [1 N]); 14 | w = 1./prod(X - X.' + eye(N), 1); 15 | w = reshape(w, size(x)); 16 | -------------------------------------------------------------------------------- /@domain/addepwbasis.m: -------------------------------------------------------------------------------- 1 | function addepwbasis(d, varargin) 2 | % ADDEPWBASIS - create a real plane wave basis object in a domain 3 | % 4 | % ADDEPWBASIS(d, N, opts) creates a real-valued plane wave basis 5 | % object within a domain object whose handle is d. 6 | % The rest of the argument list is discussed in RPWBASIS 7 | % 8 | % See also: RPWBASIS 9 | 10 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 11 | 12 | 13 | d.bas = {d.bas{:}, epwbasis(varargin{:})}; % append cell arr of basis handles 14 | 15 | d.bas{end}.doms = d; % tell this basis it affects this domain 16 | -------------------------------------------------------------------------------- /@domain/addrpwbasis.m: -------------------------------------------------------------------------------- 1 | function addrpwbasis(d, varargin) 2 | % ADDRPWBASIS - create a real plane wave basis object in a domain 3 | % 4 | % ADDRPWBASIS(d, N, opts) creates a real-valued plane wave basis 5 | % object within a domain object whose handle is d. 6 | % The rest of the argument list is discussed in RPWBASIS 7 | % 8 | % See also: RPWBASIS 9 | 10 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 11 | 12 | 13 | d.bas = {d.bas{:}, rpwbasis(varargin{:})}; % append cell arr of basis handles 14 | 15 | d.bas{end}.doms = d; % tell this basis it affects this domain 16 | -------------------------------------------------------------------------------- /@quadr/kress_Rjn.m: -------------------------------------------------------------------------------- 1 | function Rjn = kress_Rjn(n) 2 | % function Rjn = kress_Rjn(n) 3 | % 4 | % return 2n length vector of R_j^(n) for j=0...2n-1. Takes O(n ln n) work 5 | % and O(n) storage, using fft for the trig sum. 6 | % Note the full R_{|i-j|}^(n) matrix is then circulant(kress_Rjn(N/2)). 7 | % See Kress MCM 1991 paper or Lin Int Eqn book p. 210 8 | % barnett 2/6/08 9 | 10 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 11 | 12 | 13 | if mod(2*n,2)==1, disp('kress_Rjn: N=2n must be even!'); return; end 14 | 15 | m = 1:n-1; 16 | Rjn = -2*pi*ifft([0 1./m 1/n 1./m(end:-1:1)]); 17 | 18 | -------------------------------------------------------------------------------- /examples/tut_fmmlayer.m: -------------------------------------------------------------------------------- 1 | % Example codes from MPSpack tutorial, also generates EPS figures for this doc 2 | % FMM ACCELERATED LAYER POTENTIALS, for exterior Dirichlet demo. Barnett 3/12/11 3 | 4 | clear; s = segment.smoothstar(400, 0.3, 9); 5 | d = domain([], [], s, -1); d.k = 10; 6 | d.addlayerpot(s, 'D'); % adds DLP to segment s 7 | f = @(z) besselh(0,d.k * abs(z-0.3-0.2i)); % known exterior field 8 | s.setbc(1, 'D', [], @(t) f(s.Z(t))); % its Dirichlet data 9 | p = bvp(d); 10 | 11 | 12 | p.solvecoeffs; 13 | 14 | z = 1+1.2i; err = abs(f(z) - p.pointsolution(pointset(z))) 15 | -------------------------------------------------------------------------------- /@utils/goodcaxis.m: -------------------------------------------------------------------------------- 1 | function c = goodcaxis(u) 2 | % GOODCAXIS - use quantile of array to choose a good symm caxis for wave images 3 | % 4 | % Based on idea from code imgs_smart_caxis of B. Gustavsson 2005-02-09 5 | 6 | % Copyright (C) 2010 - 2011, Alex Barnett 7 | alpha = 0.95; % upper quantile (out of 1) 8 | v = abs(u(find(~isnan(u)))); v = v(:); 9 | [b x] = hist(v, unique(v)); 10 | ch = cumsum(b)/numel(v); 11 | ic = find(ch > alpha); 12 | if isempty(ic), caxis([-1 1]); warning('entire array has same value'); % give up 13 | else, c = x(ic(1)); 14 | caxis(c*[-1 1]); 15 | end 16 | -------------------------------------------------------------------------------- /@layerpot/Skernel.m: -------------------------------------------------------------------------------- 1 | function u = Skernel(k, x, nx, y, ny) 2 | % SKERNEL - Kernel function for the S (single-layer potential value) operator 3 | % 4 | % u = Skernel(k, x, nx, y, ny) 5 | % single-layer kernel function k(x,y), 6 | % without speed factor due to parametrization. 7 | % y, ny are source location and normal vector (as C-#s), x, nx are same for 8 | % target. All may be lists (or matrices) of same size. 9 | % k is omega the wavenumber. 10 | % returned kernel is K(x,y) = (i/4) H_0^{(1)}(k.|x-y|) 11 | if k==0 12 | u = (-1/(2*pi))*log(abs(x-y)); 13 | else 14 | u = (1i/4) * besselh(0,k*abs(x-y)); 15 | end 16 | -------------------------------------------------------------------------------- /@quadr/gauss.m: -------------------------------------------------------------------------------- 1 | function [x,w] = gauss(N) 2 | % GAUSS nodes x (Legendre points) and weights w 3 | % for Gauss quadrature 4 | 5 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 6 | persistent xstore wstore Nstore 7 | if N==Nstore, 8 | x=xstore; w=wstore; 9 | return 10 | end 11 | if N>300 12 | fprintf('warning: finding >300 gauss quadr pts slow O(M^3)!\n'); 13 | end 14 | beta = .5./sqrt(1-(2*(1:N-1)).^(-2)); 15 | T = diag(beta,1) + diag(beta,-1); 16 | [V,D] = eig(T); 17 | x = diag(D); [x,i] = sort(x); 18 | w = 2*V(1,i).^2; 19 | Nstore=N; wstore=w; xstore=x; 20 | -------------------------------------------------------------------------------- /@domain/addregfbbasis.m: -------------------------------------------------------------------------------- 1 | function addregfbbasis(d, varargin) 2 | % ADDREGFBBASIS - create a regular Fourier-Bessel basis object in a domain 3 | % 4 | % ADDREGFBBASIS(d, origin, N, opts) creates a regular FB basis 5 | % object within a domain object whose handle is d. 6 | % The rest of the argument list is discussed in REGFBBASIS 7 | % 8 | % See also: REGFBBASIS 9 | 10 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 11 | 12 | 13 | d.bas = {d.bas{:}, regfbbasis(varargin{:})}; % append cell arr of basis handles 14 | 15 | d.bas{end}.doms = d; % tell this basis it affects this domain 16 | -------------------------------------------------------------------------------- /@evp/para_fit.m: -------------------------------------------------------------------------------- 1 | function [A,B,C] = para_fit(e, f) 2 | % function [A,B,C] = para_fit(e, f) 3 | % 4 | % given e array of 3 ordinates, f array of corresp func values 5 | % returns parameters in f = A + C(x-B)^2 6 | % 7 | % Barnett 2011-ish 8 | % Tried to stop possibility of NaN, 12/6/15 9 | 10 | x = e(2)-e(1); w = e(3)-e(2); 11 | y = f(1)-f(2); z = f(3)-f(2); 12 | C = (x*z + w*y)/(x*w*(e(3)-e(1))); % solve para coeffs: f = A + C(x-B)^2 13 | if C==0 || isnan(C) 14 | j = find(f==min(f)); j=j(1); B = e(j); A = f(j); % simply the best of 3 15 | else 16 | B = (e(3)+e(2) - z/(w*C))/2; 17 | A = f(2) - C*(e(2)-B)^2; 18 | end 19 | -------------------------------------------------------------------------------- /@layerpot/DTkernel.m: -------------------------------------------------------------------------------- 1 | function u = DTkernel(k, x, nx, y, ny) 2 | % DTKERNEL - Kernel function for the D^T (single-layer potential n-deriv) op 3 | % 4 | % u = DTkernel(k, x, nx, y, ny) 5 | % deriv of single-layer kernel k(x,y), 6 | % without speed factor due to parametrization. 7 | % y, ny are source location and normal vector (as C-#s), x, nx are same for 8 | % target. All may be lists (or matrices) of same size. 9 | % k is omega the wavenumber. 10 | % K(s,t) = (ik/4) H_1^{(1)}(k.|x-y|). cos(angle(x-y, -n_x)) 11 | % Is adjoint of Dkernel 12 | d = y - x; r = abs(d); 13 | u = (1i*k/4) * besselh(1,k*r) .* real(conj(nx) .* d) ./ r; 14 | 15 | -------------------------------------------------------------------------------- /@segment/smoothstar.m: -------------------------------------------------------------------------------- 1 | function s = smoothstar(M, a, w, p) 2 | % SMOOTHSTAR - single-freq oscillatory radial function closed segment 3 | % 4 | % s = smoothstar(M, a, w) generates a smooth closed radial function segment 5 | % with M discretization pts, amplitude a, and frequency w (integer) 6 | % 7 | % s = smoothstar(M, a, w, p) rotates it by an angle offset of p radians. 8 | 9 | % Copyright (C) 2008 - 2012, Alex Barnett, Timo Betcke 10 | 11 | if nargin<4, p = 0; end % default angle offset 12 | s = segment.radialfunc(M, {@(t) 1 + a*cos(w*(t-p)), @(t) -w*a*sin(w*(t-p)), ... 13 | @(t) -w^2*a*cos(w*(t-p))}); 14 | -------------------------------------------------------------------------------- /@domain/approxpolygon.m: -------------------------------------------------------------------------------- 1 | function v = approxpolygon(s, pm) 2 | % APPROXPOLYGON - stack together approximating polygon vertices of segment list 3 | % 4 | % v = APPROXPOLYGON(seg, pm) returns a column vector of vertices (as 5 | % C-numbers) for the approximating polygon of a segment list seg and sign 6 | % list pm. If the segment list is not closed, v should not be interpreted 7 | % as a closed polygon. 8 | 9 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 10 | 11 | 12 | v = []; 13 | for j=1:length(s) 14 | if pm(j)==1 15 | v = [v; s(j).approxv(1:end-1)]; % drop the last point 16 | else 17 | v = [v; s(j).approxv(end:-1:2)]; 18 | end 19 | end 20 | -------------------------------------------------------------------------------- /@layerpot/Dkernel.m: -------------------------------------------------------------------------------- 1 | function u = Dkernel(k, x, nx, y, ny) 2 | % DKERNEL - Kernel function for the D (double-layer potential value) operator 3 | % 4 | % u = Dkernel(k, x, nx, y, ny) 5 | % double-layer kernel function k(x,y), 6 | % without speed factor due to parametrization. 7 | % y, ny are source location and normal vector (as C-#s), x, nx are same for 8 | % target. All may be lists (or matrices) of same size. 9 | % k is omega the wavenumber. 10 | % K(s,t) = (ik/4) H_1^{(1)}(k.|x-y|). cos(angle(x-y, n_y)) 11 | d = x - y; r = abs(d); 12 | if k>0 13 | u = (1i*k/4) * besselh(1,k*r) .* real(conj(ny) .* d) ./ r; % real(..)=dot prod 14 | else 15 | u = (1/2/pi) * real(conj(ny) .* d) ./ r.^2; 16 | end 17 | -------------------------------------------------------------------------------- /@quadr/smoothedstep.m: -------------------------------------------------------------------------------- 1 | function f = smoothedstep(t, opts) 2 | % f = smoothedstep(t) returns a set of values of a smoothed step function 3 | % (roll-off, or, really roll-up) given array of arguments t. The returned f 4 | % has the same size as t. 5 | % The default function is integral of a Gaussian: f(t) = (1+erf(chi(t-1/2)))/2 6 | % The graph has inversion symmetry about the point (1/2,1/2). 7 | % 8 | % f = smoothedstep(t, opts) allows options to be set, including: 9 | % opts.chi : determines steepness parameter chi (default 10) 10 | 11 | % Copyright (C) 2011, Alex Barnett 12 | if nargin<2, opts = []; end 13 | if ~isfield(opts, 'chi'), opts.chi = 10.0; end 14 | f = (erf(opts.chi * (t-1/2)) + 1)/2; 15 | -------------------------------------------------------------------------------- /@utils/inpolyc.m: -------------------------------------------------------------------------------- 1 | % INPOLYC - MEX interface to fast inpolygon implementation code by W.R.Franklin 2 | % 3 | % i = inpolyc(p, v) returns a column vector with entries 0 or 1, of int32 type, 4 | % specifying whether each point in the complex column vector p is inside the 5 | % polygon with vertices given in the complex column vector v. 6 | % 7 | % p and v may be of real rather than complex type, in which case zero imag 8 | % part is assumed. 9 | % 10 | % See also: UTILS.INPOLYWRAPPER, TEST/TESTINPOLYWRAPPER 11 | 12 | % Copyright (C) 2008, 2009, Timo Betcke, Alex Barnett 13 | 14 | % Original C-code acknowledgments: (see inpolyc.c for full statement) 15 | % Copyright (c) 1970-2003, Wm. Randolph Franklin 16 | -------------------------------------------------------------------------------- /@domain/showdomains.m: -------------------------------------------------------------------------------- 1 | function h = showdomains(dlist, opts) 2 | % SHOWDOMAINS - plot all domains on current figure using a color for each 3 | % 4 | % h=showdomains(dlist, opts) plots all domains on the current figure using 5 | % a color for each. opts is in optional structure identical to the options 6 | % structure in domains.plot 7 | % 8 | % See also: domains/PLOT 9 | 10 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 11 | 12 | 13 | if nargin<2, opts = []; end 14 | h = []; 15 | i = 0; 16 | for d=dlist 17 | hd = d.plot(opts); 18 | % use binary RGB sequence (repeats after 7)... 19 | utils.monochrome(hd, [mod(floor(i/4),2), mod(floor(i/2),2), mod(i,2)]); 20 | i = mod(i+1,7); 21 | h = [h; hd]; 22 | end 23 | -------------------------------------------------------------------------------- /test/testintervalrootsboyd.m: -------------------------------------------------------------------------------- 1 | % test Boyd spectral rootfinding 2 | % Barnett 7/28/2010, 8/13/10 3 | 4 | f = @(x) sin(pi*x); 5 | 6 | disp('high accuracy request...') 7 | [x e y u ier] = utils.intervalrootsboyd(f, [0 10]); x, max(e) 8 | figure; plot(y, u, '-'); hold on; plot(x, 0*x, 'rx'); title('intervalrootsboyd') 9 | 10 | disp('low accuracy request...') 11 | [x e y u ier] = utils.intervalrootsboyd(f, [0 10], struct('Ftol',1e-6)); x, max(e) 12 | size(u) 13 | 14 | disp('taxing one...') 15 | [x e y u ier] = utils.intervalrootsboyd(f, [0 100]); x, max(e) 16 | % note that errors e are too pessimistic near endpoints of interval - why? 17 | 18 | disp('should fail gracefully...') 19 | [x e y u ier] = utils.intervalrootsboyd(f, [0 1e3]); ier 20 | -------------------------------------------------------------------------------- /@segment/smoothnonsym.m: -------------------------------------------------------------------------------- 1 | function s = smoothnonsym(M, a, b, w, varargin) 2 | % SMOOTHNONSYM - non-symmetric oscillatory radial function closed segment 3 | % 4 | % s = smoothnonsym(M, a, b, w) generates a smooth closed radial function 5 | % segment with M discretization pts, amplitude a, non-symmetry parameter 6 | % b, and frequency w (which must be integer). 7 | 8 | % Copyright (C) 2011, Alex Barnett, Timo Betcke 9 | 10 | s = segment.radialfunc(M, {@(q) 1 + a*cos(w*(q+b*cos(q))), ... 11 | @(q) -a*sin(w*(q+b*cos(q))).*w.*(1-b*sin(q)), ... 12 | @(q) -a*cos(w*(q+b*cos(q))).*w^2.*(1-b*sin(q)).^2 + ... 13 | a*sin(w*(q+b*cos(q))).*w.*b.*cos(q)}, varargin{:}); 14 | % includes curvature 15 | -------------------------------------------------------------------------------- /test/testmodeserrors.m: -------------------------------------------------------------------------------- 1 | % test the evp.modeserrors function. Barnett 12/21/11 2 | clear all classes 3 | kwin = [30 31]; N = 300; 4 | s = segment.smoothstar(N, 0.3, 5); % pentafoil 5 | d = domain(s, 1); % create an interior domain 6 | s.setbc(-1, 'D'); % Dirichlet BC's applied on inside: note -1 7 | p = evp(d); % sets up eigenvalue problem object 8 | q = utils.copy(p); 9 | 10 | o.modes = 1; o.khat = 'r'; o.fhat = 's'; % compare two NtD-scaling method runs 11 | o.eps = 0.1; p.solvespectrum(kwin, 'ntd', o); 12 | o.eps = 0.2; q.solvespectrum(kwin, 'ntd', o); 13 | 14 | p.kj-q.kj % compare wavenumbers 15 | o = []; o.wei = 1; p.modeserrors(q,o); % compare modes (some zero, some 1e-3) 16 | -------------------------------------------------------------------------------- /@domain/addmfsbasis.m: -------------------------------------------------------------------------------- 1 | function addmfsbasis(d, varargin) 2 | % ADDMFSBASIS - Add an MFS (fundamental solutions) basis to a domain 3 | % 4 | % d.ADDMFSBASIS(args) where d is a domain, adds an MFS basis to the domain. 5 | % The argument list args are exactly as in MFSBASIS. 6 | % 7 | % See also: MFSBASIS 8 | 9 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 10 | 11 | b=mfsbasis(varargin{:}); 12 | d.bas={d.bas{:},b}; % append basis to domain's list 13 | d.bas{end}.doms = d; % tell this basis it affects this domain 14 | n_ins = numel(find(d.inside(b.y))); 15 | if n_ins>0 % if any MFS pts inside domain 16 | fprintf('warning: %d MFS points are inside domain!\n', n_ins) 17 | end 18 | 19 | -------------------------------------------------------------------------------- /@segment/QBXgammaconst.m: -------------------------------------------------------------------------------- 1 | function gam = QBXgammaconst(s, t, R, opts) 2 | % 3 | % gam = QBXgammaconst(seg, t, R) returns the gamma constant for the 4 | % segment seg, at the complex [0,1]-scaled parameter location 5 | % t, for radius R. (R is just a multiplicative factor.) It does this by 6 | % crudely sampling distances to a range of complexified segments. 7 | % 8 | % Barnett 9/25/12 9 | 10 | n = numel(s.t) * 10; % napproxv 11 | nd = 20; % how many distances to sample 12 | al0 = imag(t); 13 | maxaoverd = 0; % max alpha-dist over actual dist 14 | for i=1:nd, al = (i-1)/nd*al0; % imag dist, for [0,1] scaled seg 15 | dist = min(abs(s.Z(t) - s.Z((1:n)/n + 1i*al))); 16 | maxaoverd = max(maxaoverd, (al0-al)/dist); 17 | end 18 | gam = maxaoverd * R / al0; 19 | -------------------------------------------------------------------------------- /@quadr/clencurt.m: -------------------------------------------------------------------------------- 1 | function [x,w] = clencurt(N) 2 | % CLENCURT nodes x (Chebyshev points) and weights w 3 | % for Clenshaw-Curtis quadrature. FFT version. 4 | % 5 | % (was: Trefethen book, modified by Barnett to return x in increasing order) 6 | % 7 | % Now: FFT version using Fourier series for |sin(theta)|, by Barnett 8 | 9 | % Copyright (C) 2008, 2009, 2010, Alex Barnett, Timo Betcke 10 | 11 | theta = pi*(N:-1:0)'/N; x = cos(theta); % note order opposite to Trefethen 12 | W = kron(-1./((1:floor(N/2)).^2-1/4), [0 1]); % works for even or odd 13 | if mod(N,2)==1, W = [W 0]; end % include extra pi-freq term if odd 14 | w = ifft([4 W W(end-1:-1:1)]); % 4 is the zero-freq term 15 | w = [w(1)/2 w(2:N) w(1)/2]; % endpoints get 1/2 weight since want 1/2 circle 16 | -------------------------------------------------------------------------------- /@segment/dielectriccoeffs.m: -------------------------------------------------------------------------------- 1 | function [a b] = dielectriccoeffs(pol, np, nm) % ...diel matching coeffs 2 | % DIELECTRICCOEFFS - give a and b coeff pairs (1-by-2) from refractive indices 3 | % 4 | % [a b] = dielectriccoeffs(pol, np, nm). np and nm are indices on + and - 5 | % sides respectively 6 | 7 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 8 | 9 | 10 | epsp = np^2; epsm = nm^2; % epsilon (permittivity) 11 | if pol=='tm' | pol=='TM' % u represents Ez 12 | a = [1 -1]; b = [1 -1]; % note opposing signs, for continuity! 13 | elseif pol=='te' | pol=='TE' % u represents Hz 14 | a = [1 -1]; b = [1/epsp -1/epsm]; % 1/n^2 u_n is continuous (Wiersig '02) 15 | else 16 | error('polarization must be TM or TE'); 17 | end 18 | -------------------------------------------------------------------------------- /@domain/addnufbbasis.m: -------------------------------------------------------------------------------- 1 | function addnufbbasis(d, varargin) 2 | % ADDNUFBBASIS - create a fractional-order Fourier-Bessel basis set (corner exp) 3 | % 4 | % ADDNUFBBASIS(d, origin, nu, offset, branch, N, opts) creates a basis of fractional- 5 | % order Fourier-Bessel functions appropriate for expansion of the Helmholtz 6 | % equation in a wedge of angle pi/nu > 0. The orders are nu*(1:N) (for sine 7 | % angular functions) or nu*(0:N) (for cosine angular functions). For a 8 | % full description see NUFBBASIS 9 | % 10 | % See also: NUFBBASIS 11 | 12 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 13 | 14 | d.bas = {d.bas{:}, nufbbasis(varargin{:})}; % append cell arr of basis handles 15 | 16 | d.bas{end}.doms = d; % tell this basis it affects this domain 17 | -------------------------------------------------------------------------------- /@domain/stackquadpts.m: -------------------------------------------------------------------------------- 1 | function [x nx] = stackquadpts(s, pm) 2 | % STACKQUADPTS - helper routine, ordered quad pts from signed connected seg list 3 | % 4 | % [x nx] = DOMAIN.STACKQUADPTS(segs, pm) returns list of x quadr pts in correct 5 | % order for a signed connected segment list, and optionally, nx normals 6 | % (with signs correct for the segment list). 7 | 8 | % Copyright (C) 2008 - 2010, Alex Barnett, Timo Betcke 9 | 10 | x = []; nx = []; 11 | for j=1:numel(s) 12 | if pm(j)==1 13 | x = [x; s(j).x]; 14 | if nargout>1, nx = [nx; s(j).nx]; end % added Alex 8/13/10 15 | else % reverse order since flipped seg 16 | x = [x; s(j).x(end:-1:1)]; 17 | if nargout>1, nx = [nx; -s(j).nx(end:-1:1)]; end % note minus sign ! 18 | end 19 | end 20 | -------------------------------------------------------------------------------- /@layerpot/Tkernel.m: -------------------------------------------------------------------------------- 1 | function u = Tkernel(k, x, nx, y, ny) 2 | % TKERNEL - Kernel function for the T (double-layer potential n-deriv) operator 3 | % 4 | % u = Tkernel(k, x, nx, y, ny) 5 | % deriv of double-layer kernel k(x,y), 6 | % without speed factor due to parametrization. 7 | % y, ny are source location and normal vector (as C-#s), x, nx are same for 8 | % target. All may be lists (or matrices) of same size. 9 | % k is omega the wavenumber. 10 | % K(s,t) = yukky stuff, see the code. 11 | d = y - x; r = abs(d); 12 | csrx = conj(nx).*d; % (code taken from above) 13 | csry = conj(ny).*d; % cos src normals 14 | cc = real(csry).*real(csrx) ./ (r.*r); % cos phi cos th 15 | cdor = real(csry.*csrx) ./ (r.*r.*r); % cos(phi-th) / r 16 | u = (1i*k/4)*besselh(1,k*r) .* (-cdor) + (1i*k*k/4)*cc.*besselh(0,k*r); 17 | -------------------------------------------------------------------------------- /showmatpoly.m: -------------------------------------------------------------------------------- 1 | function showmatpoly(M, name) 2 | % SHOWMATPOLY - show subplots containing matrix polynomial coeffs & alpha powers 3 | % 4 | % Currently all plots are set to the same, symmetric, color axis, and only 5 | % real part is shown. Precisely-zero values are highlighted as NaNs (care!) 6 | c = max(abs(M(:))); 7 | g = gcf; figure(g); if nargin>1, set(g, 'name', name); end 8 | P = size(M,3); % polynomial order + 1 9 | ind3 = ceil((P-1)/2)+1; % formula from basis/evalunitcellcopies for offset 10 | for i=1:P 11 | tsubplot(1,P,i); 12 | Mkillzeros = zeros(size(M(:,:,i))); Mkillzeros(find(M(:,:,i)==0))=NaN; 13 | imagesc(real(M(:,:,i))+Mkillzeros); caxis(c*[-1 1]); colormap(jet(256)); 14 | if i==P, title(sprintf('\\alpha^{%d} caxis=%.2g', i-ind3, c)); else 15 | title(sprintf('\\alpha^{%d}', i-ind3)); end 16 | end 17 | -------------------------------------------------------------------------------- /@quadr/test_kapurtrap_Gimbutas.m: -------------------------------------------------------------------------------- 1 | 2 | % 3 | % ... construct the trapezoidal quadrature formula and apply end 4 | % correction formula and verify Kapur-Rokhlin's corrections. 5 | % 6 | 7 | n=100; m=10; 8 | [x,w]=kapurtrap(n,m); 9 | % 10 | 11 | sum(w)-1 12 | 13 | % 14 | nmax=m-1; 15 | rints_exact=1./(1:(nmax+1))'; 16 | 17 | %% Test non-periodic functions 18 | 19 | % 20 | % ... integrate polynomials up to degree nmax 21 | % 22 | rints=zeros(nmax+1,1); 23 | for i=0:nmax 24 | f=x.^i; 25 | rints(i+1)=sum(w.*f); 26 | end 27 | errs=rints-rints_exact 28 | 29 | % 30 | % ... integrate exp(x) 31 | % 32 | rint_exact=exp(1)-exp(0); 33 | f=exp(x); 34 | rint=sum(w.*f); 35 | err=rint-rint_exact 36 | 37 | %% Test periodic functions 38 | 39 | a=0; 40 | b=2*pi; 41 | 42 | x=x*(b-a)+a; 43 | w=w*(b-a); 44 | 45 | rint_exact=0; 46 | f=cos(x); 47 | rint=sum(w.*f); 48 | err=rint-rint_exact 49 | -------------------------------------------------------------------------------- /@quadr/QuadNodesIntervalSeq.m: -------------------------------------------------------------------------------- 1 | function [Ax, Aw] = QuadNodesIntervalSeq(Apoints, AcorrL, AcorrR, h, order) 2 | % Return quadrature nodes and weights on a piecewise linear contour given in Apoints 3 | % ACorrL, ACorrR are the arrays the same size as Apoints, giving the endpoint correctiong to be used 4 | % on the left and right side of each point (the first ACorrL and the last ACorrR values are ignored): 5 | % 0: none 6 | % 1: smooth function 7 | % 2: square root singularity 8 | % 3: log singularity 9 | % order: is the order of the endpoint corrections used 10 | % The nodes (Ax) and the weights (Aw) are returned 11 | 12 | NI = length(Apoints) - 1; 13 | Ax = []; 14 | Aw = []; 15 | 16 | for j=1:NI 17 | [Ax1, Aw1] = QuadNodesInterval(Apoints(j), Apoints(j+1), 0, h, AcorrR(j), AcorrL(j+1), order); 18 | Ax = [Ax; Ax1]; 19 | Aw = [Aw; Aw1]; 20 | end 21 | 22 | %end 23 | -------------------------------------------------------------------------------- /@scattering/gridfarfield.m: -------------------------------------------------------------------------------- 1 | % GRIDFARFIELD - setup a grid and compute the far field on the grid. 2 | % 3 | % u = p.gridfarfield(opts) computes the far field u for the scattering problem 4 | % p. The grid spacing is specified by opts.dx. 5 | % 6 | % [u, theta] = p.gridfarfield(opts) also returns the grid points. 7 | % 8 | % Copyright (C) 2014 Stuart C. Hawkins 9 | 10 | function [u theta] = gridfarfield(self,opts) 11 | 12 | %----------------------------------- 13 | % setup the grid... this is a set 14 | % of points on the unit circle parametrised 15 | % by theta 16 | %----------------------------------- 17 | 18 | % set theta points 19 | theta = linspace(0,2*pi,ceil(2*pi/opts.dx)); 20 | 21 | % get complex values points on the unit circle 22 | z = exp(1i*theta); 23 | 24 | %----------------------------------- 25 | % compute the far field 26 | %----------------------------------- 27 | 28 | u = self.pointfarfield(z); -------------------------------------------------------------------------------- /test/testsmoothfourierz.m: -------------------------------------------------------------------------------- 1 | % test smoothfourierz 2 | % Barnett 7/22/20 3 | clear 4 | 5 | % band-limited, should be exact 6 | n = 10; 7 | s0 = segment.smoothstar(n,0.3,3); 8 | z = s0.x; 9 | s = segment.smoothfourierz(100,z); 10 | figure; plot(s0.x,'.','markersize',20); hold on; s.plot; 11 | s1 = segment.smoothstar(100,0.3,3); 12 | 13 | 14 | % lens, not C^1. all terms. Induces Gibbs ringing 15 | n = 40; 16 | z = exp(2i*pi*(-n/4:n/4-1)/(2*n)) - sqrt(.5); 17 | z = [z -z]; 18 | s = segment.smoothfourierz(200,z); 19 | figure; s.plot; hold on; plot(z,'.','markersize',20); title('lens, Gibbs') 20 | 21 | % smooth roll-off of Fourier coeffs, localizes the ringing 22 | s = segment.smoothfourierz(200,z,n/2,1e-6); 23 | figure; s.plot; hold on; plot(z,'.','markersize',20); title('lens, rolloff'); 24 | % haven't tested how accurate the spatial localization is, ie how well 25 | % fits distant points in locally high-order-smooth region. 26 | 27 | 28 | -------------------------------------------------------------------------------- /@utils/copy.m: -------------------------------------------------------------------------------- 1 | % COPY - Make a deep copy of a handle object 2 | % 3 | % b = copy(a) supposedly makes b a deep copy of handle object a 4 | % 5 | % author: Doug M. Schwarz, 6/16/08 6 | % http://www.mathworks.com/matlabcentral/newsreader/view_thread/171019#438411 7 | % Also see 8 | % http://www.mathworks.com/matlabcentral/newsreader/view_thread/172147 9 | % 10 | % Note: this is quite slow (the copy properties loop), eg takes 3 ms to copy 11 | % a segment object, even when N is tiny. 12 | 13 | function new = copy(this) 14 | 15 | % Instantiate new object of the same class. 16 | new = feval(class(this)); 17 | 18 | if numel(this)==1 19 | % Copy all non-hidden properties. 20 | p = properties(this); 21 | for i = 1:length(p) 22 | new.(p{i}) = this.(p{i}); 23 | end 24 | else 25 | for j=1:numel(this) 26 | p = properties(this(j)); 27 | for i = 1:length(p) 28 | new(j).(p{i}) = this(j).(p{i}); 29 | end 30 | end 31 | end 32 | -------------------------------------------------------------------------------- /@segment/polyseglist.m: -------------------------------------------------------------------------------- 1 | function s = polyseglist(M, p, qtype, opts) 2 | % POLYSEGLIST - create closed list of segment objects from CCW polygon vertices 3 | % 4 | % s = POLYSEGLIST(M, p) creates segment objects with s a list of pointers to 5 | % them, corresponding to a closed polygon with vertices in the list p. An 6 | % equal number M of quadrature points are used per edge. If sense is CCW then 7 | % normals of segments point outwards. 8 | % 9 | % s = POLYSEGLIST(M, p, qtype) or s = POLYSEGLIST(M, p, qtype, opts) uses 10 | % specified quadrature type (see SEGMENT). 11 | 12 | % Copyright (C) 2008 - 2012, Alex Barnett, Timo Betcke 13 | 14 | p = reshape(p, [1 numel(p)]); 15 | nextp = circshift(p, [0 -1]); 16 | for j=1:numel(p) 17 | if nargin==2 18 | s(j) = segment(M, [p(j) nextp(j)]); 19 | elseif nargin==3 20 | s(j) = segment(M, [p(j) nextp(j)], qtype); 21 | else 22 | s(j) = segment(M, [p(j) nextp(j)], qtype, opts); 23 | end 24 | end 25 | -------------------------------------------------------------------------------- /examples/twodieldiscspointsrcscat.m: -------------------------------------------------------------------------------- 1 | % demo point source incident wave scattering from two dielectric discs. 2 | % For Hakan Tureci. Barnett 12/17/11 3 | clear all classes; 4 | 5 | M=70; R=0.8; n=2.0; k=9.8; % R=radius. 4M total unknowns 6 | s = [segment(M, [-1 R 0 2*pi]), segment(M, [1 R 0 2*pi])]; % discs at +-1 7 | d(1) = domain(s(1), 1); d(1).setrefractiveindex(n); 8 | d(2) = domain(s(2), 1); d(2).setrefractiveindex(n); 9 | e = domain([], [], {s(1) s(2)}, {-1 -1}); 10 | s.setmatch('diel','tm'); 11 | o.quad = 'm'; % choose Kress spectral quadrature 12 | s.addinoutlayerpots('d', o); s.addinoutlayerpots('s', o); 13 | p = scattering(e,d); 14 | p.setoverallwavenumber(k); 15 | x0 = 0; p.setincidentwave(x0, 'pt'); % point src @ x0 16 | %p.setincidentwave(pi/3); % plane wave 17 | tic; p.solvecoeffs; toc 18 | p.pointsolution(pointset(0.2+1i)) % eval scatt field at a pt (M=70: 1e-7 err) 19 | tic; o.bb = [-1 5 -1 3]; o.dx=0.03; o.sepfigs=1; p.showthreefields(o); toc 20 | -------------------------------------------------------------------------------- /diagind.m: -------------------------------------------------------------------------------- 1 | function i = diagind(A, d) 2 | % DIAGIND - diagonal (or sub- or super-diagonal) indices of general matrix. 3 | % 4 | % return diagonal indices of a general matrix, useful for changing a diagonal 5 | % in O(N) effort, rather than O(N^2) if add a matrix to A using matlab diag() 6 | % 7 | % i = diagind(A) returns diagonal indices of square or rectangular matrix A. 8 | % 9 | % i = diagind(A, d) returns indices of d'th subdiagonal (d may be negative) 10 | % 11 | % barnett 2/6/08, generalized to rectangular matrices 2/23/10 12 | 13 | if nargin<2, d = 0; end 14 | M = size(A,1); N = size(A,2); P = min(N,M); 15 | if N==M 16 | if d>=0 17 | i = sub2ind(size(A), 1+d:P, 1:P-d); 18 | else 19 | i = sub2ind(size(A), 1:P-abs(d), 1+abs(d):P); 20 | end 21 | else % rectangular case 22 | if d>=0 23 | n = min(N,M-d); i = sub2ind(size(A), d+(1:n), 1:n); 24 | else 25 | n = min(M,N-abs(d)); i = sub2ind(size(A), 1:n, abs(d)+(1:n)); 26 | end 27 | end -------------------------------------------------------------------------------- /@utils/baryprojs.m: -------------------------------------------------------------------------------- 1 | function L = baryprojs(x, w, t) 2 | % L = baryprojs(x, w, t) returns a M-by-N matrix whose rows are the vectors 3 | % against which a data vector y could be inner producted to give its 4 | % interpolant at each of M target locations t. The N interpolation pts are in x 5 | % and the N barycentric weights in w. Vectorized for multiple t. 6 | % In other words, j^th col of L is the j^th Lagrange basis function eval at t. 7 | % O(NM) 8 | % 9 | % Based upon Berrut-Trefethen SIREV 2004, formula (4.2), 2nd true barycentric 10 | % 11 | % See also: BARYWEIGHTS, BARYEVAL 12 | 13 | % Copyright (C) 2011 Alex Barnett 14 | 15 | M = numel(t); N = numel(x); 16 | diffs = repmat(t(:), [1 N]) - repmat(x(:).', [M 1]); % M-by-N matrix 17 | wpoles = repmat(w(:).', [M 1]) ./ diffs; % " 18 | denom = sum(wpoles, 2); % col vector for each t value 19 | L = repmat(1./denom, [1 N]) .* wpoles; % " 20 | L(find(diffs==0)) = 1; % fix cases where infinity in numerator and denom 21 | -------------------------------------------------------------------------------- /@utils/unique.m: -------------------------------------------------------------------------------- 1 | function u = unique(c) 2 | % UNIQUE - remove duplicates from cell array of arbitrary objects 3 | % 4 | % u = UNIQUE(c) where c is a cell array returns a cell row array u which has 5 | % all duplicates removed. The elements of c may be arbitrary class instances, 6 | % including user-defined classes. 7 | % 8 | % Notes: 9 | % 1) algorithm is currently O(N^2) since no known way to fast sort arbitrary 10 | % class instances. A fix would be to use sort() on doubles which uniquely 11 | % identify various class instances, as with graphics handles. 12 | % 2) this is needed since built-in unique only handles sort-able cell arrays, 13 | % ie string cell arrays 14 | 15 | % alex barnett 8/13/08 16 | 17 | if isempty(c), u = {}; return; end 18 | 19 | u = {c{1}}; 20 | for i=2:numel(c) 21 | t = c{i}; tc = class(t); 22 | isnew = 1; 23 | for j=1:numel(u) 24 | if isa(u{j}, tc) & size(u{j})==size(t) & isequal(u{j}, t), isnew = 0; end 25 | end 26 | if isnew, u = {u{:} t}; end 27 | end 28 | -------------------------------------------------------------------------------- /@domain/addqprayleighbasis.m: -------------------------------------------------------------------------------- 1 | function addqprayleighbasis(d, seg, pm, varargin) %....................... 2 | % ADDQPRAYLEIGHBASIS - add Rayleigh basis to a domain, eg half-strip 3 | % 4 | % ADDREGQPRAYLEIGHBASIS(d, seg, pm, N) adds Rayleigh basis with order N, 5 | % to domain d, radiative into the sense of the segment seg given by 6 | % pm (=+-1). 7 | % For a qpstrip, if seg=pm=[], this is automatically into the 8 | % half-strip's infinite direction. 9 | if isempty(seg), seg = d.seg; pm = d.pm; end % get T,B from half-strip 10 | d.bas = {d.bas{:}, qprayleighbasis(seg, pm, varargin{:})}; 11 | d.bas{end}.doms = d; % tell basis it affects this domain 12 | %if isprop(d,'a') % **** fails even when a is a property of domain! 13 | d.bas{end}.a = d.a; % inherit Bloch phase (domain should have one) 14 | %else, warning('weird that domain does not have a Bloch phase'); end 15 | d.setupbasisdofs; % ok since d will be some kind of unitcell 16 | end 17 | 18 | -------------------------------------------------------------------------------- /examples/neumann_inclusion/fig_Gh.m: -------------------------------------------------------------------------------- 1 | % accessibility figure 1 for neumann paper, 10/28/15 2 | k = 100; 3 | h = 1/k; 4 | chi1 = @(t) (1+erf(5*(t-1.5)))/2; % effectively smooth cutoff 5 | %chi2 = @(t) sqrt(1-chi1(t).^2); 6 | %figure; t = 0:0.01:3; plot(t,[chi1(t);chi2(t)], '-'); title('\chi_1, \chi_2') 7 | chi2 = @(t) 1 - chi1(t); 8 | posqrt = @(s) sqrt(s).*(s>=0); 9 | Gh = @(s) sqrt(s).*chi1(s/h^(2/3)) + h^(1/3)*chi2(s/h^(2/3)); 10 | smax = 5.0*h^(2/3); s = smax*(-.5:0.01:1.5); 11 | figure; subplot(2,1,1); plot(s,posqrt(s), 'k--', 'linewidth', 2); hold on; 12 | plot(s,Gh(s),'k-', 'linewidth', 2); axis tight; xlabel('\sigma'); 13 | legend('(\sigma)^{1/2}_+','G_h(\sigma)','location','northeast'); 14 | text(-0.4*smax,.5,'(c)'); 15 | x = -1.3:0.01:1.7; 16 | subplot(2,1,2); plot(x,posqrt(1-x.^2), 'k--', 'linewidth', 2); hold on; 17 | plot(x,Gh(1-x.^2), 'k-', 'linewidth', 2); 18 | xlabel('\xi'''); axis tight; 19 | legend('(1-\xi''^2)^{1/2}_+','G_h(1-\xi''^2)'); 20 | text(-1.2,.8,'(d)'); 21 | set(gcf,'paperposition',[0 0 5 4]); 22 | print -depsc2 cutoff.eps 23 | -------------------------------------------------------------------------------- /@segment/addinoutlayerpots.m: -------------------------------------------------------------------------------- 1 | function bas = addinoutlayerpots(seg, varargin) 2 | % ADDINOUTLAYERPOTS - add Rokhlin-style layer-potentials both sides of segment 3 | % 4 | % ADDINOUTLAYERPOTS(segs, a) adds a mixture of SLP + DLP (coeffs given 5 | % by 1-by-2 array a) with densities lying on the segment handles segs, to 6 | % affect the domains lying *both* side of each segment. If any segment in the 7 | % list segs is not connected on both sides, an error results. 8 | % 9 | % See also LAYERPOT, SEGMENT, DOMAIN.ADDLAYERPOT 10 | 11 | % Copyright (C) 2010, Alex Barnett, Timo Betcke 12 | 13 | bas = {}; 14 | for s=seg 15 | d1 = s.dom{1}; d2 = s.dom{2}; % the connected domains 16 | if isempty(d1) | isempty(d2) 17 | error('each segment must be connected to domains on both sides!'); end 18 | b = layerpot(s, varargin{:}); 19 | b.doms = [d1 d2]; % array, not cell array (bkwd-compat) 20 | bas = {bas{:}, b}; % append cell arr of basis handles 21 | d1.bas = {d1.bas{:}, b}; 22 | d2.bas = {d2.bas{:}, b}; 23 | end 24 | -------------------------------------------------------------------------------- /test/testbasisdomain.m: -------------------------------------------------------------------------------- 1 | % test insertion of basis sets within domains, and plotting inside domains 2 | % barnett 7/8/08. converted to k-free basis creator 8/18/09. 3 | 4 | clear classes 5 | M = 20; s = segment.polyseglist(M, [1 1i exp(4i*pi/3)]); % CCW tri from INCL 6 | d = domain(s, 1); 7 | k = 10; d.k = k; opts.real = 1; opts.fast = 0; 8 | d.addregfbbasis(0, 10, opts); 9 | d.addrpwbasis(10, opts); 10 | js = 1:d.Nf; % which basis func indices to plot 11 | 12 | [zz ii gx gy] = d.grid(0.01); % set up grid then evaluate 13 | A = d.evalbases(pointset(zz)); 14 | 15 | n = numel(js); % ... now show the basis sets 16 | nh = floor(sqrt(1.8*n)); nv = ceil(n/nh); % how many across and down, subplot 17 | figure('name', 'reg FB basis: Re[u_j(x)]'); c = .5; % caxis range 18 | for i=1:numel(js) 19 | tsubplot(nv, nh, i); u = NaN*ones(numel(gy), numel(gx)); % prepare plot grid 20 | u(ii) = A(:,js(i)); imagesc(gx, gy, real(u)); 21 | caxis(c*[-1 1]); set(gca, 'ydir', 'normal'); axis off equal tight; 22 | end 23 | d.plot; 24 | -------------------------------------------------------------------------------- /test/testqpbstlayerpot.m: -------------------------------------------------------------------------------- 1 | % test qp bounded strip layer-potential basis. Barnett 3/12/10 2 | clear all classes; v=1; % verbosity 3 | thi = -pi/5; om = 10; %7.76644415490187; %(t.a=1) % inc ang, overall freq 4 | M = 35; Mt = 25; 5 | d = 1; yB = -1; yT = 1; % strip & box geom 6 | B = segment(Mt, 1i*yB+[-d/2,d/2], 'g'); T = segment(Mt, 1i*yT+[d/2,-d/2], 'g'); 7 | t = boundedqpstrip([B T], om, struct('M', M)); 8 | kvec = om*exp(1i*thi); ui = @(x) exp(1i*real(conj(kvec) .* x)); 9 | a = exp(1i*real(conj(kvec) * d)); t.setbloch(a); 10 | t.addqpbstlayerpots; 11 | co = kron([0;1], ones(t.bas{1}.Nf,1)); 12 | 13 | if v, dx = 0.025; ep=1e-3; x = -1.5+ep:dx:1.5; y = -2:dx:2;% plot grid (shifted) 14 | [xx yy] = meshgrid(x,y); p = pointset(xx(:)+1i*yy(:)); 15 | ug = reshape(t.evalbases(p) * co, size(xx)); 16 | figure; imagesc(x, y, real(ug)); set(gca,'ydir','normal'); axis tight equal; 17 | caxis([-1 1]); colormap(jet(256)); colorbar; t.showbasesgeom; 18 | end 19 | 20 | Q = t.evalbasesdiscrep; 21 | %figure; imagesc(real(Q)); axis equal tight; colormap(jet(256)); colorbar; 22 | 23 | -------------------------------------------------------------------------------- /test/testminsingvalvecs.m: -------------------------------------------------------------------------------- 1 | % test routine for iterative alg util.minsingvalvecs on square matrix svd 2 | % barnett 8/16/10 3 | 4 | N = 700; iscomplex = 1; % choose size, and 0 or 1 here 5 | A = rand(N) - 0.5 + iscomplex*1i*(rand(N)-0.5); 6 | fprintf('wait for dense order-%d svd...\n',N) 7 | tic; [U S V] = svd(A); v0 = V(:,end); u0 = U(:,end); s0 = S(end,end); toc 8 | if v0(1)<0, v0 = -v0; u0 = -u0; end % ensure positive real first entry 9 | fprintf('s true=%.16g\n',s0) 10 | 11 | disp('testing minsingvalvecs...') 12 | for i=1:4, o=[]; if i>2; o.tol=1e-6; fprintf('opts.tol=%.3g...\n',o.tol), end 13 | tic; [u s v info] = utils.minsingvalvecs(A,o); toc 14 | fprintf('s=%.16g (err=%.3g), info.flag=%d, info.its=%d\n', s, s-s0, ... 15 | info.flag, info.its) 16 | fprintf('norm(A*v-s*u)=%.3g, norm(A''*u-s*v)=%.3g\n',... 17 | norm(A*v-s*u), norm(A'*u-s*v)) 18 | fprintf('u errnorm=%.3g, v errnorm=%.3g, v proj err=%.3g\n\n', norm(u-u0),... 19 | norm(v-v0), norm(v-(v0'*v)*v0)) % subspace angle error (ignores phase) 20 | end 21 | -------------------------------------------------------------------------------- /test/testclasstimings.m: -------------------------------------------------------------------------------- 1 | % test constructors, how slow, eg for segments 2 | % barnett 8/11/08. changed for k-free interface 8/18/09 3 | 4 | clear classes; N = 10; n = 300; 5 | x = rand(100,1); nx = rand(100,1); 6 | tic; 7 | for i=1:n 8 | p(i) = pointset(x, nx); 9 | end 10 | fprintf('pointset create: %.2g ms\n', toc*1000/n); 11 | tic; 12 | for i=1:n 13 | s(i) = segment(N, [0 1+1i]); 14 | end 15 | fprintf('segment create: %.2g ms\n', toc*1000/n); 16 | tic; 17 | for i=1:n % note may exceed recursion depth on s.Z etc func handles 18 | s(i).translate(1-2i); 19 | end 20 | fprintf('segment translate: %.2g ms\n', toc*1000/n); 21 | tic; 22 | %profile clear; profile on; 23 | for i=1:n 24 | t = s(i).translate(1-2i); 25 | end 26 | %profile off; profile viewer 27 | fprintf('segment translate making new: %.2g ms\n', toc*1000/n); 28 | tic; 29 | for i=1:n 30 | lp = layerpot(s(i), 's'); 31 | end 32 | fprintf('layerpot create: %.2g ms\n', toc*1000/n); 33 | c = cell(1, n); for i=1:n, c{i} = s(i); end 34 | tic; utils.isin(s(floor(n/2)), c); 35 | fprintf('utils.isin (isequal): %.2g ms\n', toc*1000/n); 36 | -------------------------------------------------------------------------------- /@evp/intnormmatrix.m: -------------------------------------------------------------------------------- 1 | function [G An] = intnormmatrix(s, k, A, Dx, Dy) 2 | % G = intnormmatrix(d), s is a segment, A is basis value matrix, Dx, Dy the 3 | % basis deriv matrices (rectangular). 4 | % G = interior norm matrix quadratic form, PSD 5 | % [G An] = ... returns normal-deriv matrix 6 | % 7 | % For use by tensionsq & tension - move into github when done 8 | % Barnett 12/7/15 9 | 10 | N = size(A,2); % # basis funcs (or rotated basis) 11 | xn = real(conj(s.x) .* s.nx); % x.n weight factor on bdry 12 | E = k^2; 13 | 14 | An = repmat(real(s.nx), [1 N]).*Dx + repmat(imag(s.nx), [1 N]).*Dy; 15 | W = repmat(s.w.'.*xn, [1 N]); % x.n as elementwise mult to right 16 | G = A' * (W .* A) * E; 17 | G = G - Dx' * (W .* Dx) - Dy' * (W .* Dy); 18 | W = repmat(s.w.', [1 N]); % 1 as elementwise mult to right 19 | Ddil = repmat(real(s.x), [1 N]).*Dx + repmat(imag(s.x), [1 N]).*Dy; 20 | B = Ddil'*(W.*An); 21 | G = G + B + B'; % conjugate saves another mat mult 22 | G = (G+G')/(4*E); % rescale and make symm 23 | -------------------------------------------------------------------------------- /examples/gasketevp.m: -------------------------------------------------------------------------------- 1 | % low eigenvalues of non-simply connected domain via Fredholm determinant method 2 | % Barnett 2011, w/ Braxton Osting. 3 | 4 | clear % one analytic segment, periodic radial function 5 | a = 0.3; w = 3; 6 | M = 240; 7 | R = @(t) 1 + a*cos(w*t); Rt = @(t) -w*a*sin(w*t); Rtt = @(t) -w^2*a*cos(w*t); 8 | s = []; 9 | s{1} = segment.radialfunc(M, {R, Rt, Rtt}); % easier than you 10 | s{2} = segment(30, [.5+0.0i, .3, 0, 2*pi], 'p'); % note I added to s not si 11 | d = domain(s{1},1, s{2}, -1); 12 | %figure (1); d.plot; drawnow; 13 | 14 | % note +-1 is wrt segment's natural sense, not their sense with domain list: 15 | s{1}.setbc(-1, 'D'); s{2}.setbc(1, 'D'); 16 | 17 | % note if you don't supply Rtt above, Alpert quad has to be used not Kress: 18 | for ii=1:numel(s); d.addlayerpot(s{ii}, 'd'); d.bas{ii}.quad = 'm'; end 19 | 20 | p = evp(d); 21 | opts = struct('modes',1,'verb',1,'tol',1e-12,'iter',1); 22 | tic; p.solvespectrum([2 12], 'fd', opts); toc 23 | figure; p.weylcountcheck(p.kj(1),p.kj,d.perim,d.area); 24 | figure; p.showmodes 25 | % problem is degeneracies only one mode per eigenspace computed. 26 | -------------------------------------------------------------------------------- /@quadr/quadr.m: -------------------------------------------------------------------------------- 1 | % static class of quadrature rules. 2 | 3 | % Copyright (C) 2008 - 2011, Alex Barnett, Timo Betcke 4 | 5 | classdef quadr 6 | methods(Static) 7 | [x w] = peritrap(N) 8 | [x w] = traprule(N) 9 | [x w] = gauss(N) 10 | [x w] = clencurt(N) 11 | [x,w,cs,ier]=kapurtrap(n,m) 12 | Rjn = kress_Rjn(n) 13 | D = perispecdiffrow(N) 14 | [g] = interptrig(f, N); 15 | 16 | % the following are Alpert quadrature endpoint correction rules 17 | % (from Andras Pataki): test_Alpert_Pataki.m to test 18 | [ExtraNodes, ExtraWeights, NodesToSkip] = QuadLogExtraPtNodes(order) 19 | [Ax, Aw] = QuadNodesInterval(a, b, N, h, corra, corrb, order) 20 | [Ax, Aw] = QuadNodesIntervalSeq(Apoints, AcorrL, AcorrR, h, order) 21 | [ExtraNodes, ExtraWeights, NodesToSkip] = QuadSmoothExtraPtNodes(order) 22 | [ExtraNodes, ExtraWeights, NodesToSkip] = QuadSqrtExtraPtNodes(order) 23 | A = alpertizeselfmatrix(A, k, s, kerfun, opts) 24 | 25 | % roll-off functions 26 | f = smoothedstep(t, opts) 27 | end 28 | end 29 | -------------------------------------------------------------------------------- /test/testscattering_fmm.m: -------------------------------------------------------------------------------- 1 | % test MPSpack iterative Helmholtz sound-soft scattering with LP2D/HFMM2D. 2 | % Adjust the o.* options below to choose the experiment. 3 | % Barnett 3/24/11 4 | clear; addpath /home/alex/physics/leslie/gimbutas/lp2d/ 5 | 6 | N=1e3; k=10; verb=1; % # qpadr pts, wavenumber, and verbosity. 7 | s = segment.smoothstar(N,0.3,7); % actually has tight inside curvature, tricky! 8 | %aj = zeros(1,50); bj = aj; aj(4) = -0.2; bj(end)=0.2; 9 | %s = segment.smoothfourier(N,aj,bj); 10 | de = domain([], [], s, -1); % exterior 11 | de.addlayerpot(s, [-1i*k 1], struct('quad','a','ord',8)); % CFIE, Alpert order 12 | s.setbc(1, 'd', []); 13 | p = scattering(de, []); p.setoverallwavenumber(k); 14 | p.setincidentwave(pi/2 - pi/20); % if just angle given, it's a plane wave 15 | 16 | fprintf('testing N=%d; please wait about %g min...\n', N, N/1e4); 17 | o.FMM = 1; o.meth = 'iter'; %o.meth = 'direct'; 18 | tic; p.solvecoeffs(o); fprintf('solve done in %.3g sec\n', toc) 19 | p.pointsolution(pointset(-1.5-1.5i)) 20 | if verb, figure; tic; p.showthreefields(o); % Note FMM also used here! 21 | fprintf('solution field eval in %.3g sec\n', toc), end 22 | 23 | -------------------------------------------------------------------------------- /@segment/radialfunc.m: -------------------------------------------------------------------------------- 1 | function s = radialfunc(M, fs, varargin) 2 | % RADIALFUNC - closed segment from radial function r=f(theta) and derivatives 3 | % 4 | % s = radialfunc(M, {f fp}) generates a smooth closed radial function segment 5 | % with M discretization pts, using periodic trapezoid quadrature. f and fp 6 | % are function handles to the radius function f(t) and its derivative, for 7 | % angle t in [0,2pi]. 8 | % 9 | % s = radialfunc(M, {f fp fpp}) also includes 2nd-derivative, enabling 10 | % curvature information to be created in the segment (for spectral quadr) 11 | % 12 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 13 | 14 | f = fs{1}; 15 | Z = @(s) exp(2i*pi*s).*f(2*pi*s); % note conversion from 0 kstar-x 12 | op = odeset('abstol',1e-14,'events',@ev); %'initialstep',0.5*kstar*abs(beo)); 13 | [x,b,xev,bev,iev] = ode45(F, [0 1.0], real(beo), op); % 1.0>eps 14 | kh = kstar - xev; % k for the event happening (stopping-point) 15 | %figure; plot(x,b,'+-'); % debug 16 | if isempty(kh), warning(sprintf('solvebetaodeneu failed to find intersection event! beo=%g x(end)=%g b(end)=%g\n', beo, x(end), b(end))); 17 | kh = kstar + beo/kstar; % back to standard 1st-order approx 18 | end 19 | 20 | function [v,ist,dir] = ev(x,b) % event func for ode45 stopping 21 | v = b; ist = 1; dir = +1; % if b were complex, need v=real(b) 22 | -------------------------------------------------------------------------------- /examples/neumann_inclusion/Cennenbach.m: -------------------------------------------------------------------------------- 1 | function C = Cennenbach(p) 2 | % CENNENBACH - compute const (in small u_n norm limit) for Thm 7, Ennenbach '95 3 | % 4 | % C = Cennenbach(p) where p is evp object containing domain with single segment 5 | % bdry. Star-shaped case only for now. 6 | % 7 | % Barnett 12/6/15 8 | 9 | s = p.segs; d = p.doms; 10 | xn = real(conj(s.x).*s.nx); 11 | R = max(abs(s.x)); r = min(abs(s.x)); h = min(xn); 12 | xi2LB = (r*h/R^3)/(R^4/r/h + R^2); % lower bnd on xi_2, Stekloff, Ennen (3.5) 13 | xnnrmsq = sum(s.w'.*xn.^2); % terms needed in beta 14 | o = p.gridboundingbox; % build grid for interior norms of geom funcs 15 | n = floor((o.bb(2)-o.bb(1))/o.dx); gx = o.bb(1) + o.dx*(0:n); % grids 16 | n = floor((o.bb(4)-o.bb(3))/o.dx); gy = o.bb(3) + o.dx*(0:n); 17 | [xx yy] = meshgrid(gx, gy); zz = xx(:) + 1i*yy(:); % keep zz rect array 18 | di = d.inside(zz); 19 | r2int = o.dx^2*sum(abs(zz).^2.*di); 20 | r4int = o.dx^2*sum(abs(zz).^4.*di); 21 | beta = (sqrt(d.perim)/2/d.area)*( 1/sqrt(xi2LB)*sqrt(xnnrmsq - 4*d.area^2/d.perim) + .5*sqrt(r4int - r2int/d.area) ); % beta defined in Ennen Lemma 6 22 | C = sqrt(1/xi2LB + beta^2); % around 7.4 for rfn 23 | -------------------------------------------------------------------------------- /@utils/arrow.m: -------------------------------------------------------------------------------- 1 | function h = arrow(x, y, varargin) 2 | % ARROW - draw a 2D arrow from (x1,y1) to (x2,y2). 3 | % 4 | % h = arrow(x, y) where x and y are 2-element arrays puts head at the 5 | % second element. 6 | % 7 | % h = arrow(x, y, P1, P2, ....) passes params to plot line drawing command. 8 | % 9 | % h = arrow(x, y, opts, P1, P2, ...) passes P1, P2, etc to plot command, but 10 | % where opts is a struct, also controls the following options: 11 | % opts.headalong : fraction of the way along to place the head (default 1). 12 | % opts.headsize : fractional size of head (default 0.2) 13 | 14 | % Copyright (C) 2010 - 2011, Alex Barnett 15 | z = x+1i*y; 16 | d = x(2)-x(1) + 1i*(y(2)-y(1)); 17 | l = 0.2; % size of head 18 | headalong = 1.0; % location of head, default 19 | argptr = 1; opts = []; 20 | if numel(varargin)>0 & isstruct(varargin{1}) 21 | argptr = 2; opts = varargin{1}; end 22 | if ~isempty(opts) & isfield(opts,'headsize'), l = opts.headsize; end 23 | if ~isempty(opts) & isfield(opts,'headalong'), headalong = opts.headalong; end 24 | h = plot([z(1) z(2) z(1)+(z(2)-z(1))*headalong+l*d*[0 -1+.7i, 0 , -1-.7i]], varargin{argptr:end}); 25 | -------------------------------------------------------------------------------- /make.inc: -------------------------------------------------------------------------------- 1 | # make.inc: common compiler and library locations for MPSpack makefiles for 2 | # optional tweaks and fast algorithm usage. 3 | # Barnett. Cleaned up 4/13/16 4 | 5 | CC = gcc 6 | FC = gfortran 7 | FFLAGS = -fPIC -O3 # PIC needed for MEX to link against .o 8 | 9 | # LIBRARY LOCATIONS... 10 | GSL = -lgsl # Adapt to the location of your GSL library 11 | 12 | # Set the location of the BLAS libraries on your system 13 | # If you have ATLAS installed uncomment one of the following and 14 | # change path if necessary 15 | BLAS = -lblas # Generic blas package (if installed) 16 | # Multithreaded version 17 | # BLAS = -L/usr/lib64/atlas -lptf77blas -lptcblas -latlas 18 | # Singlethreaded version 19 | # BLAS = -L/usr/lib64/atlas -lf77blas -lcblas -latlas 20 | 21 | # Fast algorithm libs: (be sure to install both as openmp or neither) 22 | # point to your FMM installation 23 | FMM2D = /usr/local/fmmlib2d 24 | # (get from http://www.cims.nyu.edu/cmcl/fmm2dlib/fmm2dlib.html ) 25 | 26 | # your LP2D installation (not actually used by Makefile currently) 27 | LP2D = /usr/local/lp2d 28 | # (get from https://math.dartmouth.edu/~ahb/software/lp2d.tgz ) 29 | -------------------------------------------------------------------------------- /@utils/regeig.m: -------------------------------------------------------------------------------- 1 | function [d V] = regeig(F, G, opts) 2 | % REGEIG - solve Fix-Heiberger (Vergini) style regularized generalized EVP 3 | % 4 | % [d V] = REGEIG(F, G) 5 | % 6 | % [d V] = REGEIG(F, G, opts) 7 | 8 | if nargin<3, opts = []; end 9 | if ~isfield(opts, 'eps'), opts.eps = 1e-14; end % defaults 10 | if ~isfield(opts, 'v'), opts.v = 0; end 11 | 12 | N = size(F,1); 13 | [V,D] = eig(G); D = diag(D); i = find(D>opts.eps*max(D)); % indices to keep 14 | clear G 15 | r = numel(i); % rank 16 | if opts.v, fprintf('\tN=%d, eps = %g, rank = %d\n', N, opts.eps, r); end 17 | V = V(:,i) .* repmat(1./sqrt(D(i)).', [N 1]); % compute V*L (rescale evecs) 18 | tF = V'*F*V; % projects out numerical Nul(G) 19 | clear F 20 | tF = (tF + tF')/2; % make Hermitian 21 | if nargout>1 % want eigvecs too 22 | [W, L] = eig(tF); 23 | d = diag(L); 24 | V = V*W; % transform evecs back to gevecs of (F,G) 25 | %figure; imagesc(log10(abs(V'*G*V - eye(r)))); title('V''GV');colorbar;caxis ([-16 0]); 26 | %figure; imagesc(log10(abs(V'*F*V - diag(l)))); title('V''FV');colorbar;caxis([-16 0]); 27 | else % just eigvals 28 | d = eig(tF); 29 | end 30 | -------------------------------------------------------------------------------- /@domain/showsegments.m: -------------------------------------------------------------------------------- 1 | function h = showsegments(segs, pm, o) 2 | % SHOWSEGMENTS - plot signed segment list to current figure (domain helper) 3 | % 4 | % h = SHOWSEGMENTS(s, pm) plots segment pointers s with senses pm to 5 | % current figure. h is a column vector of handles to all objects plotted. 6 | % 7 | % h = SHOWSEGMENTS(s, pm, opts) allows options in opts, namely 8 | % opts.arrow: if true, put an arrow on each segment (default true) 9 | % opts.label: if true, label each seg with its number in list (default true) 10 | % 11 | % See also: domain/PLOT, segment/PLOT 12 | 13 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 14 | 15 | if nargin<3, o = []; end 16 | if nargin<2, pm = ones(size(segs)); end % default is + 17 | if numel(pm)==1, pm = pm*ones(size(segs)); end 18 | if ~isfield(o, 'label'), o.label = 1; end % default is label 19 | 20 | h = []; 21 | for j=1:numel(segs) 22 | s = segs(j); 23 | h = [h; plot(s, pm(j), o)]; hold on; % pass opts to segment.plot 24 | if o.label 25 | xm = s.Z(1/2); % label at location half way along seg 26 | h = [h; text(real(xm), imag(xm), sprintf('%d',j),'Fontsize',14,'Fontweight','demi')]; 27 | end 28 | end 29 | -------------------------------------------------------------------------------- /showfields.m: -------------------------------------------------------------------------------- 1 | % SHOWFIELDS - show multiple 2D gridded data as set of subplot images 2 | % 3 | % SHOWFIELDS(g, h, u, c, name) plots figure with subplot image j from the 4 | % 2D grid data u(:,:,j) with x-grid g and y-grid h. name gives the figure 5 | % title name, and c the size of the symmetric caxis scale. If u is complex, 6 | % shows Re and Im part separately. Uses tsubplot to maximize size 7 | % 8 | % See also SHOWFIELD. 9 | 10 | function showfields(g, h, u, c, name) 11 | n = size(u, 3); % # fields or subplots 12 | re = isreal(u); % true if only Re needed 13 | nh = floor(sqrt(1.8*n)); nv = ceil(n/nh); % how many across and down, subplot 14 | if re, figure('name', name); else, figure('name', sprintf('%s, Re', name)); end 15 | for j=1:n, tsubplot(nv, nh, j); imagesc(g, h, real(squeeze(u(:,:,j)))); 16 | caxis(c*[-1 1]); set(gca, 'ydir', 'normal'); axis equal tight; % off; 17 | colormap(jet(256)); 18 | end 19 | if ~re 20 | figure('name', sprintf('%s, Im', name)); 21 | for j=1:n, tsubplot(nv, nh, j); imagesc(g, h, imag(squeeze(u(:,:,j)))); 22 | caxis(c*[-1 1]); set(gca, 'ydir', 'normal'); axis equal tight; % off; 23 | colormap(jet(256)); 24 | end 25 | end 26 | -------------------------------------------------------------------------------- /@domain/addlayerpot.m: -------------------------------------------------------------------------------- 1 | function bas = addlayerpot(d, seg, varargin) 2 | % ADDLAYERPOT - create a layer-potential basis set object in a domain 3 | % 4 | % ADDLAYERPOT(d, segs, a) adds a mixture of SLP + DLP (coeffs given 5 | % in 1-by-2 array a) with densities lying on the segment handles segs, to 6 | % domain d. Note that segs may be segments not on the boundary of d. 7 | % If segs is empty, the boundary of d will be assumed. The mixture is fixed 8 | % across segments; if you wish to choose different mixtures, use multiple 9 | % calls to addlayerpotbasis. 10 | % 11 | % ADDLAYERPOT(d, segs, a, opts) passes options, see opts in LAYERPOT. 12 | % 13 | % bas = ADDLAYERPOTBASIS(...) returns cell array of handle(s) of created 14 | % basis object(s). 15 | % 16 | % See also LAYERPOT, SEGMENT 17 | 18 | % Copyright (C) 2008-2010, Alex Barnett, Timo Betcke 19 | 20 | if isempty(seg), seg = d.seg; end 21 | bas = {}; 22 | for s=seg 23 | b = layerpot(s, varargin{:}); 24 | bas = {bas{:}, b}; % append cell arr of basis handles 25 | end 26 | d.bas = {d.bas{:}, bas{:}}; % append to domain's referred bases 27 | for i=1:numel(seg) 28 | d.bas{end+1-i}.doms = d; % tell bases they affect this domain 29 | end -------------------------------------------------------------------------------- /num2cellstr.m: -------------------------------------------------------------------------------- 1 | % 2 | % NUM2CELLSTR convert array of floating-point numbers to cell array of strings 3 | % NUM2CELLSTR(X) converts array X to cell array of strings. 4 | % If X is a two- or multi-dimensional array, it will be 5 | % flattened (all elements will still be included). 6 | % 7 | % NUM2CELLSTR(X, P) is the same but uses precision P, where P is an integer. 8 | % 9 | % NUM2CELLSTR(X, P, S) same as above but includes a prefix string to 10 | % each cell. 11 | % 12 | % This clumsy routine would be unnecessary if Matlab provided something 13 | % like python's string.strip() function. 14 | % 15 | % See also SPRINTF, CELLSTR 16 | % 17 | % Alex Barnett 12/5/02 18 | 19 | function [c] = num2cellstr(a, prec, prefix) 20 | 21 | if nargin==1 22 | prec = 4; % default precision 23 | else 24 | if prec<1 25 | error('precision must be at least 1.') 26 | end 27 | if prec>16 28 | error('precision cannot exceed 16.') 29 | end 30 | end 31 | if nargin<3 32 | prefix = ''; % default prefix 33 | end 34 | 35 | l = 25; % max number of characters for representing a number 36 | n = numel(a); 37 | 38 | % build printf format string 39 | f = sprintf('%%-%d.%dg', l, round(prec)); 40 | 41 | c = cellstr([repmat(prefix, [n 1]) reshape(sprintf(f, a),[l, n])']); 42 | -------------------------------------------------------------------------------- /showfield.m: -------------------------------------------------------------------------------- 1 | % SHOWFIELD - show 2D gridded data as Re and Im images 2 | % 3 | % SHOWFIELD(g, h, u, c, name) plots figure with 4 | % 2D grid data u(:,:) with x-grid g and y-grid h. name gives the figure 5 | % title name, and c the size of the symmetric caxis scale. If u is complex, 6 | % shows Re and Im part as separate figures. If c = [], sensibel colorscales 7 | % are chosen 8 | % 9 | % barnett 8/6/08 10 | 11 | function showfield(g, h, u, c, name) 12 | cfac = 1.5; 13 | choosec = isempty(c); 14 | re = isreal(u); % true if only Re needed 15 | if re, figure('name', name); else, figure('name', sprintf('%s, Re', name)); end 16 | imagesc(g, h, real(u)); set(gca, 'ydir', 'normal'); axis equal tight; 17 | if choosec % use L4 norm to choose sensible caxis 18 | ug = u(find(isfinite(u))); 19 | c = cfac * (sum((real(ug(:)).^2).^2)/numel(ug)).^(1/4); 20 | end 21 | caxis(c*[-1 1]); colormap(jet(256)); colorbar; 22 | if ~re 23 | figure('name', sprintf('%s, Im', name)); 24 | imagesc(g, h, imag(u)+0./~isnan(u)); % hack needed since imag(NaN)=0 ! 25 | set(gca, 'ydir', 'normal'); axis equal tight; 26 | if choosec 27 | c = cfac * (sum((imag(ug(:)).^2).^2)/numel(ug)).^(1/4); 28 | end 29 | caxis(c*[-1 1]); colormap(jet(256)); colorbar; 30 | end 31 | -------------------------------------------------------------------------------- /test/testbordering.m: -------------------------------------------------------------------------------- 1 | % test segment-domain bordering 2 | % 7/10/08 3 | 4 | clear classes 5 | verb = 1; 6 | % one analytic segment, periodic radial function 7 | a = 0.3; w = 3; 8 | M = 100; 9 | R = @(t) 1 + a*cos(w*t); Rt = @(t) -w*a*sin(w*t); 10 | Z = @(s) exp(2i*pi*s).*R(2*pi*s); 11 | sa = segment(M, {Z, @(s) 2*pi*(1i*Z(s) + exp(2i*pi*s).*Rt(2*pi*s))}, 'p'); 12 | sq = segment.polyseglist(10, -1.7-0.5i + 0.5*[0 1i 1+1i 1]); % CW square 13 | sc = segment(30, [1+1.5i, 0.5, 0, 2*pi], 'p'); % CCW circle 14 | d = domain([], [], {sa sq sc}, {-1 1 -1}); 15 | % connect up some interior domains with the above exterior domain 16 | da = domain(sa, 1); dq = domain(sq(end:-1:1), -1); dc = domain(sc, 1); 17 | if verb, figure; opts.gridinside=0.1; h=domain.showdomains([d da dq dc], opts); 18 | axis equal; title('test domain connections: ext w/ holes & 3 interior'); end 19 | s = [sa sq sc]; 20 | disp('There should have been no errors, and the following should show two domain objects in each cell array:') 21 | s.dom % list each segment - how identify/distinguish domains ? 22 | % by name? give symbol to each? 23 | disp('The plot should show 3 interior and 1 exterior domain, of different colors. There should be one color of normal vector showing with each sense on each boundary') 24 | -------------------------------------------------------------------------------- /@layerpot/fundsol.m: -------------------------------------------------------------------------------- 1 | function A = fundsol(r, k) 2 | % function A = fundsol(r, k) 3 | % 4 | % Returns matrix of fundamental solns A given dist matrix r, and wavenumber k. 5 | % Uses Matlab built-in hankels, and 6 | % uses symmetry (since zero argument is fast) if r appears symm (based on 7 | % flagging all diag vals with an impossible flag value). 8 | % 9 | % See also LAYERPOT 10 | 11 | % Copyright (C) 2008 - 2012, Alex Barnett and Timo Betcke 12 | 13 | symmflagval = -999; % all diag vals of this signifies symmetric - a hack 14 | 15 | %fprintf('min r = %g\n', min(r(:))) 16 | if k==0 17 | A = -(1/2/pi) * log(r); % laplace 18 | else 19 | % if self-interactions (square & dummy diag), assume symm, do upper tri only 20 | if size(r,1)==size(r,2) & norm(diag(r)-symmflagval)<1e-14 % hack! 21 | %disp(sprintf('fundsol symm: diag(r)=%g, N=%d', r(1,1), size(r,1))); 22 | A = (1i/4) * triu(besselh(0, 1, k*triu(r,1)),1); % helmholtz 23 | A = A.' + A; 24 | A(diagind(A)) = (1i/4) * besselh(0, 1, k*diag(r)); 25 | else % do the usual thing which works for distant nonsymm interactions... 26 | %disp(sprintf('fundsol unsymm: r(1,1)=%g, M=%d, N=%d', r(1,1), size(r,1),... 27 | %size(r,2))); 28 | A = (1i/4) * besselh(0, 1, k*r); % helmholtz 29 | end 30 | end 31 | -------------------------------------------------------------------------------- /test/testextrap.m: -------------------------------------------------------------------------------- 1 | % test extrap: Richardson-type extrapolation to eval f(0). Barnett 3/15/10 2 | 3 | clear all 4 | fs{1} = @(x) 1./(1+x).^3; % has vaguely-near pole singularity (x=-1) 5 | fs{2} = @(x) exp(x); % entire, better 6 | fs{3} = @(x) 1+tan(pi/2 * x); % pole at x=-1 7 | fs{4} = @(x) exp(-(x+1).^-2); % essential sing at x=-1 ...worse! 8 | % (this is bad because f(0) << f(hmax) so 4 digits are lost there to roundoff) 9 | fs{5} = @(x) sin(100*x+1); % oscillatory (use hmax =< 0.03 for this) 10 | fs{6} = @(x) sin((10:10:100)*x+1); % row vector test case (same as above) 11 | 12 | hmax = 0.1; 13 | 14 | for i=1:numel(fs) % for each function, test 3 calling modes... 15 | f = fs{i}; fprintf('\n%s:\n', char(f)) 16 | disp('default...'); 17 | [f0 err N] = utils.extrap(f, hmax); 18 | fprintf('actual err = %.3g, pred err = %.3g, N = %d.\n', ... 19 | max(abs(f0-f(0))), max(err), N) 20 | disp('fix reltol=1e-6...'); 21 | [f0 err N] = utils.extrap(f, hmax, struct('reltol', 1e-6)); 22 | fprintf('actual err = %.3g, pred err = %.3g, N = %d.\n', ... 23 | max(abs(f0-f(0))), max(err), N) 24 | disp('fix N=10...'); 25 | [f0 err N] = utils.extrap(f, hmax, struct('N', 10)); 26 | fprintf('actual err = %.3g, pred err = %.3g, N = %d.\n', ... 27 | max(abs(f0-f(0))), max(err), N) 28 | end 29 | -------------------------------------------------------------------------------- /test/testqprayleighbasis.m: -------------------------------------------------------------------------------- 1 | % test the Rayleigh basis in a half-strip (qpstrip) 2 | % Barnett 3/9/10 3 | 4 | clear all classes; v = 1; % verbosity 5 | thi = -pi/5; om = 10; %7.76644415490187; %(t.a=1) % inc ang, overall freq 6 | %om = 10; thi = -acos(1 - 2*pi/om); % 'single' Wood's anomaly (generic Bloch a) 7 | 8 | kvec = om*exp(1i*thi); 9 | d = 1; yT = 1; T = segment([], 1i*yT+[d/2,-d/2], 'g'); up = -1; 10 | tt = qpstrip(d, om, struct('seg',T, 'pm',-up)); % semi-bounded strip (-1 is up) 11 | tt.setbloch(exp(1i*real(conj(kvec) * tt.e))); % Bloch 12 | a = exp(1i*real(conj(kvec) * d)); tt.addqprayleighbasis(4); b = tt.bas{1}; 13 | %figure; tt.plot(struct('gridinside', .1)); tt.showbasesgeom; 14 | 15 | if v, gx = -d/2:.01:d/2; gy = yT + (-2:0.04:2); % plotting region 16 | [xx yy] = meshgrid(gx, gy); 17 | p = pointset([xx(:) + 1i*yy(:)], 1i*ones(size(xx(:)))); % set up n for y-derivs 18 | [A An] = b.eval(p); 19 | figure; 20 | for j=1:b.Nf, subplot(3,3,j); % show a bunch of them 21 | co = zeros(size(A,2),1); co(j) = 1; u = reshape(A*co, size(xx)); % eval field 22 | imagesc(gx, gy, real(u)); caxis([-1 1]); set(gca, 'ydir', 'normal'); 23 | colormap(jet(256)); axis tight equal; tt.plot; hold on; 24 | n=100; for i=-n:n, cn = cos(thi)+i*2*pi/d/om; % cos used to get Bragg angs 25 | if abs(cn)<=1,plot([0 cn],[0 up*sqrt(1-cn^2)],'m-','linewidth',3);end,end 26 | end 27 | end 28 | -------------------------------------------------------------------------------- /@segment/smoothfourier.m: -------------------------------------------------------------------------------- 1 | function s = smoothfourier(M, aj, bj, varargin) 2 | % SMOOTHFOURIER - general Fourier series radial function closed segment 3 | % 4 | % s = SMOOTHFOURIER(M, aj, bj) generates a smooth closed radial function 5 | % segment with M discretization pts, Fourier cos amplitudes aj and Fourier 6 | % sin amplitudes bj. The zero-freq term is 1, and aj and bj are the coeffs 7 | % of indices 1...n. aj and bj may be row or col vectors, but numel(bj) 8 | % must be at least numel(aj) 9 | % 10 | % s = SMOOTHFOURIER(M, aj, bj, opts) allowed control of options: 11 | % opts.napproxv = number of approximating vertices, see segment. 12 | 13 | % Copyright (C) 2008 - 2012, Alex Barnett, Timo Betcke 14 | 15 | n = numel(aj); 16 | if numel(bj)~=n, error('bj must have n=numel(aj) elements!'); end 17 | aj = aj(:).'; bj = bj(:).'; % make row vecs 18 | j = (1:n).'; % col vec of indices 19 | if n==0, s = segment.radialfunc(M, {@(t) 1+0*t, @(t) 0*t, @(t) 0*t}, varargin{:}); 20 | else % now use outer products inside the trig funcs... 21 | s = segment.radialfunc(M, {@(t) 1 + reshape(aj*cos(j*t(:).') + bj*sin(j*t(:).'),size(t)), ... 22 | @(t) reshape(-(j'.*aj)*sin(j*t(:).') +(j'.*bj)*cos(j*t(:).'),size(t)), ... 23 | @(t) reshape(-(j'.^2.*aj)*cos(j*t(:).') - (j'.^2.*bj)*sin(j*t(:).') ,size(t))}, varargin{:}); 24 | end 25 | -------------------------------------------------------------------------------- /@utils/Makefile: -------------------------------------------------------------------------------- 1 | # GNU Makefile for MEX compilation for MPSpack MATLAB toolbox's @utils directory 2 | # 3 | # These are only needed for tweaks to accelerate math libraries; MPSpack 4 | # will run without them. Tested on linux only. 5 | # 6 | # Simplified version 4/12/16. 7 | # (C) 2008-2016 Alex Barnett 8 | 9 | include ../make.inc 10 | 11 | default: all 12 | 13 | all: gslbesselj gslbesseljnu greengardrokhlinhank103 greengardrokhlinhank106 inpolyc fmm2d 14 | 15 | .PHONY: all clean 16 | 17 | gslbesselj: gslbesselj.c 18 | mex gslbesselj.c $(GSL) $(BLAS) 19 | 20 | gslbesseljnu: gslbesseljnu.c 21 | mex gslbesseljnu.c $(GSL) $(BLAS) 22 | 23 | greengardrokhlinhank103: greengardrokhlinhank103.c hank103.o 24 | mex greengardrokhlinhank103.c hank103.o LD=$(FC) 25 | 26 | greengardrokhlinhank106: greengardrokhlinhank106.c hank103.o hank106.o 27 | mex greengardrokhlinhank106.c hank103.o hank106.o LD=$(FC) 28 | 29 | hank103.o: hank103.f 30 | $(FC) $(FFLAGS) -c hank103.f 31 | 32 | hank106.o: hank106.f 33 | $(FC) $(FFLAGS) -c hank106.f 34 | 35 | inpolyc: inpolyc.c 36 | mex inpolyc.c 37 | 38 | # set up the link only 39 | fmm2d: 40 | ln -sf $(FMM2D)/matlab/hfmm2dpart.m hfmm2dparttarg.m 41 | 42 | # remember not to delete the shipped Luong MEX executables (!): 43 | clean: 44 | rm -f *.o greengardrokhlinhank103.mex* greengardrokhlinhank106.mex* gslbesseljnu.mex* gslbesselj.mex* inpolyc.mex* 45 | -------------------------------------------------------------------------------- /@quadr/test_Alpert_Pataki.m: -------------------------------------------------------------------------------- 1 | % 2 | % Test the QuadNodeInterval function 3 | % 4 | 5 | IN = { 6 | % smooth functions 7 | @(x) exp(x), 0.0, 1.0, 1,1, 1.7182818284590452354, 8 | @(x) exp(-x.^2), 0.0, 10.0, 1,0, 0.88622692545275801365, 9 | @(x) exp(-x.^2), -10.0, 10.0, 0,0, 2*0.88622692545275801365, 10 | % square root singularities 11 | @(x) 1./sqrt(x), 0.0, 1.0, 2,1, 2.0, 12 | @(x) 1./sqrt(x.*(1-x)), 0.0, 1.0, 2,2, 3.1415926535897932385, 13 | @(x) exp(-x.^2)./sqrt(x), 0.0, 10.0, 2,1, 1.8128049541109541559, 14 | % log singularities 15 | @(x) log(x) 0.0, 1.0, 3,1, -1.0, 16 | @(x) exp(x).*log(x) 0.0, 1.0, 3,1, -1.3179021514544038949, 17 | @(x) exp(-x.^2).*log(x) 0.0, 10.0, 3,1, -.87005772672831550673, 18 | % mixed ones 19 | @(x) log(x)./sqrt(1-x) 0.0, 1.0, 3,2, -1.2274112777602187623, 20 | }; 21 | 22 | 23 | N = 40; 24 | order = 10; 25 | Kmax = size(IN,1); 26 | 27 | for K=1:Kmax 28 | 29 | fn = IN{K,1}; 30 | a = IN{K,2}; 31 | b = IN{K,3}; 32 | corra = IN{K,4}; 33 | corrb = IN{K,5}; 34 | Iexact = IN{K,6}; 35 | 36 | [Ax, Aw] = QuadNodesInterval(a, b, N, 0, corra, corrb, order) 37 | I = sum(fn(Ax).*Aw); 38 | Ierr = I - Iexact; 39 | fprintf('Case:%02d, I=%23.16e, Iexact=%23.16e, Ierr=%13.6e\n', K, I, Iexact, Ierr); 40 | 41 | end 42 | -------------------------------------------------------------------------------- /examples/hewett_uk_eigs.m: -------------------------------------------------------------------------------- 1 | % Compute Dirichlet eigenvalues of a 40-sided polygonal approximation to the UK 2 | % Dave Hewett 3/11/16, tweaked by Alex Barnett. 3 | % based on tut_evp.m from mpspack examples. Needs hewett_ukmap_points.m 4 | 5 | % Note by Barnett: due to nasty corners, this is not a terribly impressive 6 | % demo of MPSpack, but we include it for educational purposes. 7 | % It takes around 10 minutes to compute 7 eigenvalues to around 4-5 digit 8 | % accuracy. Partly this is due to MATLAB overhead in the 40^2 segment 9 | % interactions; partly due to needing a large number of points per segment 10 | % due to non-geometric corner quadratures. 11 | clear all classes; verb = 0; 12 | o.kressq = 6; % corner-packing parameter for Kress reparametrization 13 | uk_pts = flipud(hewett_ukmap_points(40)).'; 14 | n = 60; 15 | s = segment.polyseglist(n, uk_pts, 'pc', o); % UK 16 | d = domain(s, 1); % create an interior domain 17 | s.setbc(-1, 'D'); % Dirichlet BC's applied on inside of segment 18 | p = evp(d); % sets up eigenvalue problem object 19 | d.addlayerpot(s, 'd'); % DLP basis set appropriate for Dir BC 20 | 21 | %profile clear; profile on 22 | o.tol = 1e-2; o.modes = 1; tic; p.solvespectrum([5 15], 'fd', o); toc 23 | %profile off; profile viewer 24 | 25 | o = []; o.dx = 0.01; o.FMM=1; tic; p.showmodes(o); toc 26 | %print -dpng ../gallery/hewett_uk_modes.png 27 | -------------------------------------------------------------------------------- /test/testfbbasis.m: -------------------------------------------------------------------------------- 1 | % Test regular Fourier-Bessel basis. Timo's early code. 2 | % Fixed up, Barnett 7/16/09. Also see cases 1:3 in testbasis.m 3 | 4 | k=2; 5 | N=5; 6 | 7 | % Create a bunch of random points plus normal direction 8 | 9 | M=10; 10 | z=randn(M,1)+1i*randn(M,1); 11 | nz=randn(M,1)+1i*randn(M,1); nz=nz./abs(nz); 12 | pts=pointset(z,nz); 13 | 14 | % Create the matrix of Fourier-Bessel fct. up to order 15 | R=abs(z); T=angle(z); 16 | A=[besselj(0,k*R),besselj(1:N,k*R).*cos(T*(1:N)),besselj(1:N,k*R).*sin(T*(1:N))]; 17 | 18 | % Now perturb z slightly in the x and y directions to get approximate 19 | % derivatives 20 | 21 | zx=z+1E-8*ones(size(z)); 22 | zy=z+1i*1E-8*ones(size(z)); 23 | Rx=abs(zx); Tx=angle(zx); 24 | Ax=[besselj(0,k*Rx),besselj(1:N,k*Rx).*cos(Tx*(1:N)),besselj(1:N,k*Rx).*sin(Tx*(1:N))]; 25 | Ax=(Ax-A)/(1E-8); 26 | Ry=abs(zy); Ty=angle(zy); 27 | Ay=[besselj(0,k*Ry),besselj(1:N,k*Ry).*cos(Ty*(1:N)),besselj(1:N,k*Ry).*sin(Ty*(1:N))]; 28 | Ay=(Ay-A)/(1E-8); 29 | nx1=real(nz); nx2=imag(nz); 30 | An=repmat(nx1,1,2*N+1).*Ax+repmat(nx2,1,2*N+1).*Ay; 31 | 32 | % Compare with output from regfbbasis.eval 33 | % The following edited by Alex for updated interface, 7/16/09: 34 | opts.real=1; 35 | opts.besselcode='r'; 36 | b = regfbbasis(0,N,opts); b.doms = domain(); b.doms.k = k; 37 | [AA AAx AAy]=b.eval(pts); 38 | % I assume this is what you wanted... 39 | norm(A-AA), norm(Ax-AAx), norm(Ay-AAy) 40 | -------------------------------------------------------------------------------- /@utils/insidepoly_license.txt: -------------------------------------------------------------------------------- 1 | Copyright (c) 2010, Bruno Luong 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are 6 | met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in 12 | the documentation and/or other materials provided with the distribution 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 15 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 16 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 17 | ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE 18 | LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 19 | CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 20 | SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 21 | INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 22 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 23 | ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 24 | POSSIBILITY OF SUCH DAMAGE. 25 | -------------------------------------------------------------------------------- /examples/dielscatrokh.m: -------------------------------------------------------------------------------- 1 | % dielectric transmission scattering with Rokhlin hypersingular-cancel scheme 2 | % Barnett 6/18/10 3 | 4 | clear all classes; verb = 1; % verbosity 5 | k = 30; % overall (ext) wavenumber 6 | n = 1.5; % interior refractive index 7 | M = 330; % gives 13 digit acc at k=30 8 | s = segment.smoothstar(M, 0.3, 3); % smooth closed segment 9 | di = domain(s, 1); di.setrefractiveindex(n); % interior 10 | de = domain([], [], s, -1); % exterior 11 | o.quad = 'm'; % Kress spectral quadr 12 | s.addinoutlayerpots('d', o); % new double-sided layerpot 13 | s.addinoutlayerpots('s', o); % " 14 | setmatch(s, 'diel', 'TM'); 15 | pr = scattering(de, di); 16 | if verb, figure; di.plot; hold on; de.plot; axis equal; end 17 | 18 | pr.setoverallwavenumber(k); 19 | pr.setincidentwave(pi/6); % if just angle given, it's a plane wave 20 | pr.fillquadwei; pr.setupbasisdofs; 21 | pr.fillrighthandside; 22 | pr.fillbcmatrix; 23 | pr.linsolve; 24 | pr.pointsolution(pointset(1+1i)) % check u_scatt at one exterior pt 25 | if verb, opts.dx = 0.03; opts.bb = [-2 2 -2 2]; figure; 26 | tic; pr.showthreefields(opts); fprintf('\tgrid eval in %.2g sec\n', toc); 27 | end 28 | -------------------------------------------------------------------------------- /@quadr/interptrig.m: -------------------------------------------------------------------------------- 1 | function [g] = interptrig(f, N) 2 | % INTERPTRIG - regular interpolate periodic function w/ trig poly's and FFT 3 | % 4 | % [g] = interptrig(f, N). f is a row or col vec, or stack of col vecs. 5 | % In the last case, interp is done to each col vec separately. 6 | % N is new number of points. Cannot be less than numel(f), currently. 7 | % Key convention is that points are spaced at the half-integers 8 | % ie, t = 2*pi*((1:n)-0.5)/n 9 | % 10 | % See also: MATLAB's polyfun/interpft.m which doesn't allow grid sliding 11 | % TESTINTERPTRIG shows how to construct the dense interp matrix. 12 | 13 | % Copyright (C) 2012 - 2013, Alex Barnett 14 | 15 | row=(size(f,1)==1); if row, f = f.'; end, ncols = size(f,2); n = size(f,1); 16 | F = fft(f,[],1); % fft down the col(s) 17 | nyqst = ceil((n+1)/2); % following few lines from MATLAB's interpft.m 18 | G = [F(1:nyqst,:) ; zeros(N-n,ncols) ; F(nyqst+1:n,:)]; 19 | if rem(n,2) == 0 20 | G(nyqst,:) = G(nyqst,:)/2; 21 | G(nyqst+N-n,:) = G(nyqst,:); 22 | end 23 | sh = 0.5 * 2*pi*(1/n - 1/N); % now do the shift to 1/2-centered grid.. 24 | if mod(N,2)==0, ks = [0:N/2 -N/2+1:-1]; else, ks = [0:(N-1)/2 -(N-1)/2:-1]; end 25 | G = G .* repmat(exp(-1i*sh*ks'), [1 ncols]); % ks is k-grid 26 | % xform back (again from MATLAB's interpft.m) 27 | g = ifft(G,[],1); 28 | if isreal(f), g = real(g); end 29 | if row, g = g.'; end % make row vec if f was 30 | g = g * N/n; 31 | -------------------------------------------------------------------------------- /examples/neumann_inclusion/genrefsetneu.m: -------------------------------------------------------------------------------- 1 | % generate reference set of eigenvalues and eigenfunctions, rf shape, Neu 2 | % Barnett 1/12/14 based on example codes from SCA paper, and 3 | % mpspack/examples/smoothdrummodesboyd.m 4 | % reused 12/8/15 5 | clear; 6 | %N = 160; % ok for k<10 7 | %N = 200; % ok for k<20 8 | N = 450; % ok k=40 9 | %N = 720; % ok for k<100 10 | %N = 2100; % ok for k<300 11 | s = segment.smoothnonsym(N, 0.3, 0.2, 3); % create a closed curve 12 | %s = segment.smoothnonsym(N, 0, 0, 3); % disc 13 | if 0, k=20; Ns = 160:20:240; for i=1:numel(Ns), s.requadrature(Ns(i)); 14 | min(eig(eye(Ns(i)) + 2*layerpot.D(k, s))), end, end % check N convergence 15 | d = domain(s, 1); % create an interior domain 16 | s.setbc(-1, 'N'); % Neumann BCs on inside 17 | d.addlayerpot(s, 's'); % SLP representation 18 | p = evp(d); % create eigenvalue problem 19 | o.modes = 1; 20 | 21 | o.tol = 1e-6; p.solvespectrum([40 41], 'fd', o); 22 | save rf_neu_ref40k41_N450_p_bdry 23 | p.showmodes(struct('fmm',1)); % for fun 24 | 25 | 26 | %o.maxslope=1.5; o.tol = 1e-12; p.solvespectrum([10 20], 'ms', o); p.showmodes; 27 | %save disc_neu_ref10k20_N220ms_p_bdry % 'ms' since disc has double EVs 28 | 29 | %p.solvespectrum([90 100], 'fd', o); save rf_neu_ref90k100_N720_p_bdry 30 | %p.solvespectrum([300 302], 'fd', o); save rf_neu_ref300k302_N2100_p_bdry 31 | 32 | %p.solvespectrum([10 20], 'fd', o); %p.showmodes; 33 | 34 | -------------------------------------------------------------------------------- /examples/tut_lap.m: -------------------------------------------------------------------------------- 1 | % Example codes from MPSpack tutorial, also generates EPS figures for this doc 2 | % SECTION 2: LAPLACE 3 | 4 | clear all classes; verb = 0; % if verb>0, generates EPS figures 5 | 6 | s = segment([], [0 1 0 2*pi]); 7 | d = domain(s, +1); 8 | d.k = 0; 9 | d.addregfbbasis([], 8); 10 | %f = @(z) real(exp(z)); % gives 1/n! coeffs in the real part 11 | f = @(z) log(abs(z-2-3i)); % boundary data function of z=(x,y) 12 | %d.k = 1; f = @(z) bessely(0,abs(z-1-2i)); % Helmholtz 13 | s.setbc(-1, 'd', [], @(t) f(s.Z(t))); 14 | % f = @(x,y) exp(x).*cos(y); s.setbc(-1, 'd', [], f); % another way to pass in f 15 | p = bvp(d); 16 | p.solvecoeffs; 17 | p.bcresidualnorm 18 | p.showsolution; 19 | figure; opts.comparefunc = f; p.showsolution(opts); 20 | 21 | if verb, % generate f:sd 22 | figure; set(gca,'fontsize', 14); s.plot; 23 | print -depsc2 ../doc/figs/seg.eps 24 | figure; set(gca,'fontsize', 14); opts.gridinside=0.05; d.plot(opts); axis off 25 | print -depsc2 ../doc/figs/dom.eps 26 | % generate f:u 27 | figure; set(gca,'fontsize', 14); p.showsolution; axis off; 28 | h=colorbar; set(h,'fontsize',20); 29 | print -depsc2 -painters ../doc/figs/u.eps 30 | figure; set(gca,'fontsize', 14); p.showsolution(opts); axis off 31 | h=colorbar; set(h,'fontsize',20); 32 | print -depsc2 -painters ../doc/figs/uerr.eps 33 | % problem: -painters stops the transparency being correctly rendered. 34 | close all 35 | end 36 | 37 | -------------------------------------------------------------------------------- /@qpunitcell/datawrapR.m: -------------------------------------------------------------------------------- 1 | % DATAWRAPR - trial wrapping-over-R-wall of mat data, eg a cell item in dB 2 | % 3 | % used by testblochwrap.m in the 1xUC scheme. Moves rows of each matrix in d.B 4 | % to one higher alpha-power. (Tries not to create too many new 5 | % entries in copylist? - no, just doubles everything... fine for now!) 6 | % 7 | % d = uc.datawrapR(d, i) d is data struc, i is list of indices to wrap 8 | function d = datawrapR(uc, d, i) 9 | c = d.copylist; 10 | c.apow = [c.apow c.apow+1]; % increase alpha power by 1 11 | c.bpow = [c.bpow c.bpow]; c.t = [c.t c.t]; c.remph = [c.remph c.remph]; 12 | n = size(d.B,3); % original size of copylist 13 | d.B(:,:,n+(1:n)) = 0; % new empty matrix blocks 14 | d.B(i,:,n+(1:n)) = d.B(i,:,1:n); % rows to move 15 | d.B(i,:,1:n) = 0; % kill the rows which moved out 16 | d.copylist = c; 17 | end 18 | 19 | % More ambitious sorting code, not finished, would create less data... 20 | % [c.apow j] = sort(c.apow, 'descend'); % work from largest to smallest a pows 21 | % c.bpow c.bpow(j); c.t = c.t(j); c.remph = c.remph(j); % shuffle 22 | % no = size(d.B,3); % original size of copylist 23 | % n = no; % current size 24 | % for k=1:n 25 | % ap = c.apow(k)+1; % new apow 26 | % if ~isempty(find(c.apow+1==)) % sth already at that (a,b)-pow, so add to it 27 | % 28 | % else 29 | % 30 | % end 31 | % end 32 | % d.copylist = c; 33 | %end -------------------------------------------------------------------------------- /examples/tut_discarray.m: -------------------------------------------------------------------------------- 1 | % Scattering from 3x3 array of discs, as in Tutorial section 10. 2 | % pasted from tutorial.pdf by Barnett 8/2/17 3 | 4 | N1=3; N2=3; % Number of scatterers in each direction 5 | r=1; % Radii of circles 6 | a=3; % Distance of midpoints of neighboring circles in each dimension 7 | k=10; % Wavenumber 8 | M=300; % Number of points on each circle 9 | N=150; % Number of MFS basis fct. in each circle 10 | Rmfs=0.8*r; % Radius of fundamental solutions inside circles 11 | 12 | y0=0; 13 | s=segment.empty(N1*N2,0); 14 | for i=1:N1, 15 | x0=0; 16 | for j=1:N2 17 | seg=segment(M,[x0+1i*y0 r 0 2*pi],'p'); 18 | seg.setbc(1,'D',[]); 19 | s((i-1)*N2+j)=seg; 20 | x0=x0+a; 21 | end 22 | y0=y0+a; 23 | end 24 | 25 | seg.setbc(1,'D',[]); 26 | o.normals=0; 27 | plot(s,1,o); 28 | 29 | d=domain([],[],num2cell(s),num2cell(-1*ones(N1*N2,1))); 30 | 31 | x0=0; y0=0; opts.fast=1; 32 | for i=1:N1, 33 | x0=0; 34 | for j=1:N2 35 | Z=@(w) Rmfs*exp(2i*pi*w)+x0+1i*y0; 36 | Zp=@(w) Rmfs*2i*pi*exp(2i*pi*w); 37 | d.addmfsbasis({Z,Zp},N,opts); 38 | x0=x0+a; 39 | end 40 | y0=y0+a; 41 | end 42 | 43 | pr=scattering(d,[]); 44 | pr.setoverallwavenumber(k); 45 | pr.setincidentwave(-pi/3); 46 | 47 | tic; pr.solvecoeffs; fprintf('\tcoeffs done in %.2g sec\n', toc) 48 | fprintf('\tL2 bdry error norm = %g, coeff norm = %g\n', ... 49 | pr.bcresidualnorm, norm(pr.co)); 50 | 51 | o.bb=[-a N2*a -a N1*a]; 52 | o.dx=0.05; 53 | o.sepfigs=1; 54 | pr.showthreefields(o); 55 | -------------------------------------------------------------------------------- /test/testbvp_fmm.m: -------------------------------------------------------------------------------- 1 | % test MPSpack iterative Helmholtz BVP demo with FMMLIB2D/LP2D 2 | % Barnett 3/21/11, tweaked 10/17/12. FMM iprec 4/11/19. 3 | % See set-up notes in Manual Sec. 4.1, for FMM and for LP2D codes. 4 | 5 | clear 6 | N=1e3; k=10; verb=1; % interior Dirichlet BVP for Helmholtz; try N=1e4... 7 | s = segment.smoothstar(N,0.3,7); % actually has tight inside curvature, tricky! 8 | d = domain(s, 1); % interior 9 | d.addlayerpot(s, [0 1], struct('quad','a','ord',8)); % DLP, Alpert quad 10 | f = @(z) besselh(0,k*abs(z-2-3i)); % solution function giving bdry data 11 | s.setbc(-1, 'd', [], @(t) f(s.Z(t))); 12 | p = bvp(d); p.setoverallwavenumber(k); 13 | 14 | % Solve stage: 15 | % here you can switch from direct to FMM+LP2D for applying BIO (1/2+D) for iter: 16 | %o.FMM = 0; o.meth='direct'; % 0 for dense solve (1 requires LP2D Alpert codes) 17 | o.FMM = 1; o.meth = 'iter'; % FMM w/ GMRES for iterative soln, for large N 18 | d.bas{1}.iprec = 4; % shows how to control FMM tol, via basis property 19 | o.eps = 1e-12; % ho set GMRES tol 20 | fprintf('testing N=%d; please wait about %g min...\n', N, N/60000); 21 | tic; p.solvecoeffs(o); fprintf('solve done in %.3g sec\n', toc) 22 | 23 | % Evaluate stage: 24 | % independently, select o.FMM 0 or 1 here to switch potential evaluation: 25 | figure; o.FMM=1; o.dx=0.01; o.comparefunc=f; o.logabs=1; tic; p.showsolution(o); 26 | fprintf('solution difference field eval in %.3g sec\n', toc) 27 | % even at N=1e3, dx=0.01, FMM is 20x faster than direct evaluation. 28 | -------------------------------------------------------------------------------- /test/testproblemevalbases.m: -------------------------------------------------------------------------------- 1 | % use Dirichlet and diel. Rokh scatt as examples. Also tests domainindices 2 | % barnett 6/10/10 3 | 4 | clear all classes; sys = 't'; % system 'd' or 't' for scattering 5 | k = 8; % overall (ext) wavenumber 6 | n = 1.4; % interior refractive index 7 | M = 100; s = segment.smoothstar(M, 0.2, 3); % smooth closed segment 8 | de = domain([], [], s, -1); % exterior 9 | if sys=='d' 10 | de.addlayerpot(s, [-1i*k 1]); s.setbc(1, 'D', []); % Dir BCs and CFIE form 11 | pr = scattering(de, []); 12 | elseif sys=='t' 13 | di = domain(s, 1); di.setrefractiveindex(n); % interior 14 | s.addinoutlayerpots('d'); % new double-sided layerpot 15 | s.addinoutlayerpots('s'); % " 16 | setmatch(s, 'diel', 'TM'); pr = scattering(de, di); 17 | end 18 | pr.setoverallwavenumber(k); 19 | pr.setincidentwave(pi/2 - pi/20); % if just angle given, it's a plane wave 20 | pr.solvecoeffs; 21 | p = pointset([1+1i;0+.3i]); pr.pointsolution(p) % u_scatt at ext & int pts 22 | A = pr.evalbases(p); u = A*pr.co % note get zero rather than NaN 23 | disp('u should agree with the direct pointsolution case'); 24 | p.nx = [1;1]; [A Ax Ay] = pr.evalbases(p); % check handles normals too 25 | pr.domainindices(p) % domain indices should be 1,2 (ext, int) 26 | 27 | % test the opts.dom override (for sys='t')... 28 | [A Ax Ay] = pr.evalbases(p, struct('dom', de)); u = A*pr.co 29 | 30 | -------------------------------------------------------------------------------- /examples/neumann_inclusion/README: -------------------------------------------------------------------------------- 1 | This directory contains codes for Neumann inclusion bounds used in the 2 | paper arxiv:1512.04165 (codename "ninc"), "Comparable upper and lower 3 | bounds for boundary values of Neumann eigenfunctions and tight 4 | inclusion of eigenvalues", by A H Barnett, A Hassell, and M Tacy. 5 | 6 | Barnett 4/13/16 7 | 8 | This uses MFS (exterior point sources) and plain recursive search in k 9 | (not a scaling-type method) for high-accuracy Neumann eigenvalues and 10 | their bounds, for a smooth domain. The tightness of the bounds is the 11 | main point, not the efficiency of locating candidate eigenvalues. 12 | 13 | Codes: 14 | 15 | tbl_mfsgsvdincl.m : make sweep data, min sing val search, inclusion 16 | bnd data for Table 1, and mode of Figure 3. 17 | This is the main driver script. 18 | fig_Gh.m : make Figure 1(c-d) showing filter function. 19 | fig_intromodes.m : compute modes and make Figure 1(a-b). 20 | fig_tsweeps.m : make Figure 2 using data from swp=1 in tbl_mfsgsvdincl.m 21 | genrefsetneu.m : use Fred det method to make reference sets of Neumann EVs. 22 | test_gsvd.m : checking MATLAB's GSVD definition, not same as Golub & van Loan. 23 | Cennenbach.m : estimate constant C in prior literature (Ennenbach '95) 24 | 25 | Also needed for this work, codes which I decided to bring in as @evp/ methods 26 | (since they are helpers for EVPs, even though they don't act on an evp object): 27 | 28 | ../../@evp/spectralfiltermatrix.m 29 | ../../@evp/gsvdtension.m 30 | ../../@evp/intnormmatrix.m 31 | ../../@utils/lowestn.m 32 | -------------------------------------------------------------------------------- /@layerpot/QBXbox.m: -------------------------------------------------------------------------------- 1 | function [box i] = QBXbox(b, t, h, p, o) 2 | % 3 | % box = QBXbox(b, t, h) returns in box.v vertices of approximating polygon for 4 | % a QBX close-eval box centered a param t, on the left side of a segment. 5 | % h>0 is the box scale, in [0,1]-scaled segment parameter. 6 | % If h has 2 elements, then first is real-half-width, second is imag-height, 7 | % allowing aspect ratio to change from 2x1. 8 | % 9 | % box = QBXbox(b, t, h, [], o) controls opts .... 10 | % o.nospill : if exists, don't include a "spill" to catch poor polygon approx 11 | % of boundary. 12 | % 13 | % [box i] = QBXbox(b, t, h, p, o) also returns logical array i corresponding 14 | % to whether each element of list of complex numbers p is inside the box. 15 | % 16 | % TO DO: 17 | % Make sure QBX knows which side of the domain the box is, do 2-sided case. 18 | % 19 | % Barnett 9/25/12 20 | 21 | if nargin<5, o = []; end 22 | s = b.seg; 23 | nv = 10; l = (1:nv)/nv; % polygonal approx to box, nv verts on each of 4 sides 24 | hx = h(1); hy = h(1); if numel(h)==2, hy = h(2); end 25 | hy = 1i*hy; % make go in imag direction 26 | spill = 0.1*hy; % how much to spill down below the real line to make sure 27 | % all points collected even if inpolygon of s not good 28 | if isfield(o,'nospill'), spill = 0; end 29 | b = [2*hx*l-spill 2*hx-spill+(hy+spill)*l 2*hx+hy-2*hx*l hy-(hy+spill)*l].' - hx; % vertex list in t-plane relative to center parameter value t 30 | box.v = s.Z(t + b); 31 | 32 | if nargout>1 % want inside-box testing... (returns [] if p=[]) 33 | i = utils.inpolywrapper(p, box.v); 34 | end 35 | -------------------------------------------------------------------------------- /examples/tut_scatt.m: -------------------------------------------------------------------------------- 1 | % Example codes from MPSpack tutorial, also generates EPS figures for this doc 2 | % SECTION 6: SCATTERING 3 | 4 | clear all classes; verb = 0; % if verb>0, generates EPS figures 5 | 6 | tref = segment.radialfunc(250, {@(q) 1 + 0.3*cos(3*q), @(q) -0.9*sin(3*q)}); 7 | d = domain([], [], tref, -1); % overwrites previous d 8 | tref.setbc(1, 'D', []); % homogeneous Dirichlet BCs: sound-soft 9 | opts.tau = 0.05; d.addmfsbasis(tref, 200, opts); % basis set for ext domain 10 | p = scattering(d, []); 11 | k=30; p.setoverallwavenumber(k); 12 | p.setincidentwave(pi/6); % incident plane wave with given angle 13 | tic; p.solvecoeffs; toc; % fills matrices, does least-squares soln 14 | p.bcresidualnorm 15 | p.showthreefields; 16 | 17 | if verb % generate f:soft 18 | figure; o.dx=0.01; o.bb = 2*[-1 1 -1 1]; 19 | p.showthreefields(o); %set(gca,'fontsize',20); 20 | print -depsc2 ../doc/figs/soft.eps 21 | end 22 | 23 | tref.setbc(1, 'N', []); % homogeneous Neumann: sound-hard 24 | tref.setbc(1, 1i*k, 1); % homogeneous Robin: impedance 25 | 26 | % transmission problem 27 | di = domain(tref, 1); di.refr_ind = 1.5; 28 | opts.tau = -0.03; di.addmfsbasis(tref, 220, opts); 29 | tref.setmatch('diel', 'TM'); 30 | p = scattering(d, di); p.setoverallwavenumber(k); p.setincidentwave(pi/6); 31 | %figure; p.plot; 32 | p.solvecoeffs; p.bcresidualnorm, p.showthreefields; 33 | 34 | if verb % generate f:diel 35 | figure; o.dx=0.01; o.bb = 2*[-1 1 -1 1]; 36 | p.showthreefields(o); %set(gca,'fontsize',20); 37 | print -depsc2 ../doc/figs/diel.eps 38 | end 39 | -------------------------------------------------------------------------------- /test/testalpertquadr.m: -------------------------------------------------------------------------------- 1 | % test Alpert log-quadratures on periodic log singularity's Fourier coeffs 2 | % barnett 1/29/11, added Alpert's osc*log quadr 12/16/13 3 | clear 4 | ords = [2,3,4,5,6,8,10,12,14,16,pi,Inf]; % order "pi" is 2013 new quadr 5 | P = 2*pi; % period 6 | m = 10; % Kress periodized log * m^th Fourier mode (incr m for more challenge) 7 | f = @(t) log(4*sin(t/2).^2) .* cos(2*pi*m*t/P)/P; 8 | Iex = 0; if m~=0, Iex = -1/abs(m); end % exact answer (Kress LIE book) 9 | Ns = 10:2:70; % #s of periodic nodes to try (even for Kress to work) 10 | IN = nan(numel(Ns), numel(ords)); 11 | 12 | for j=1:numel(ords), ord = ords(j); fprintf('\n ord = %d:\n', ord); 13 | for i=1:numel(Ns), N = Ns(i); h = P/N; 14 | if isinf(ord) % check Kress for kicks (f func is log sing times sth) 15 | t = h*(0:N-1); w = quadr.kress_Rjn(N/2); % h is already in w 16 | IN(i,j) = sum(w .* cos(2*pi*m*t/P)/P); % explicitly removed f's log sing 17 | else % Alpert 18 | [tex,wex,nskip] = quadr.QuadLogExtraPtNodes(ord); % extra nodes 19 | if N>2*nskip 20 | t = [tex; (nskip:(N-nskip))'; N-tex(end:-1:1)] * h; % nodes 21 | w = [wex; ones(N-2*nskip+1, 1); wex(end:-1:1)] * h; % weights 22 | IN(i,j) = sum(f(t).*w); 23 | end 24 | end 25 | fprintf('N=%d: err = %g\n', N, abs(IN(i,j)-Iex)) 26 | end 27 | end 28 | figure; loglog(Ns, abs(IN-Iex), '+-'); legnum(ords); hold on; 29 | plot(Ns, repmat(Ns.'/m, [1 numel(ords)]).^-repmat(ords, [numel(Ns) 1]), '--'); 30 | xlabel('N'); ylabel('error'); title('Alpert log endpoint correction errors'); 31 | axis([min(Ns) max(Ns) 1e-16 1]); 32 | -------------------------------------------------------------------------------- /@evp/weylcountcheck.m: -------------------------------------------------------------------------------- 1 | % WEYLCOUNTCHECK - basic Weyl law check for missing Dirichlet eigenwavenumbers 2 | % 3 | % function [k_weyl] = weylchoutcheck(k_lo, ks, perim, area {, dkfig {, j_lo}}) 4 | % 5 | % test (new figure) array of wavenumbers against the Weyl law (first 2 terms). 6 | % k_lo is where the sequence started. perim term for Dirichlet BCs. 7 | % k_weyl is sequence of Weyl-computed k values, assuming lowest is j_lo 8 | % 9 | % Copied from old Weyl code from Courant days. 10 | % barnett 11/24/03 11 | % 2/1/04 included figure for talk: dkfig causes to show N(k), N_weyl(k). 12 | % 4/12/06 added k_weyl 13 | 14 | function [k_weyl] = weylcountcheck(k_lo, k, perim, area, dkfig) 15 | 16 | i = reshape(1:length(k), size(k)); 17 | a = area/(4*pi); 18 | b = -perim/(4*pi); 19 | 20 | %figure; 21 | plot(k, a*k.*k + b*k - i+0.5); 22 | avg = mean(a*k.*k + b*k - i+0.5); 23 | %hold on; hline(avg-2); hline(avg-1); hline(avg); hline(avg+1); hline(avg+2); 24 | hold off; 25 | %title('Weyl test of k sequence (jump up = missed state)'); 26 | set(gca, 'fontsize', 14); 27 | xlabel('k'); ylabel('N_{Weyl}(k) - N(k)'); 28 | 29 | if nargin>4 && dkfig>0 30 | figure; 31 | ks = k_lo:dkfig/200:k_lo+dkfig; 32 | for i=1:length(ks) 33 | kf = ks(i); 34 | Nk(i) = length(find(kkslvalid(1) & kswp0.01; % valid for slopes 39 | sl = tmins(ii)./nearEs(ii); % slopes for not-too-close cases 40 | fprintf('E tension slope range = [%.3g, %.3g]\n',min(sl),max(sl)) 41 | %[0.646, 0.676] 42 | Cest = 1/min(sl) % estimate for const in our theorem: 1.6 43 | 44 | 45 | -------------------------------------------------------------------------------- /examples/tut_conv.m: -------------------------------------------------------------------------------- 1 | % Example codes from MPSpack tutorial, also generates EPS figures for this doc 2 | % SECTION 3: CONVERGENCE 3 | 4 | clear all classes; verb = 0; % if verb>0, generates EPS figures 5 | 6 | % code from previous section used for set-up... 7 | s = segment([], [0 1 0 2*pi]); 8 | d = domain(s, +1); 9 | d.k = 0; 10 | d.addregfbbasis([], 8); 11 | f = @(z) log(abs(z-2-3i)); % boundary data function of z=(x,y) 12 | s.setbc(-1, 'd', [], @(t) f(s.Z(t))); 13 | p = bvp(d); 14 | 15 | % new code 16 | s.requadrature(50); p.solvecoeffs; p.bcresidualnorm 17 | 18 | % convergence plot 19 | for N=1:15, 20 | p.updateN(N); p.solvecoeffs; r(N) = p.bcresidualnorm; 21 | end 22 | figure; semilogy(r, '+-'); xlabel('N'); ylabel('bdry err norm'); 23 | 24 | if verb, % generate f:conv 25 | figure; set(gca,'fontsize', 20); semilogy(r, '+-'); 26 | xlabel('N'); ylabel('bdry err norm'); print -depsc2 ../doc/figs/N.eps 27 | end 28 | 29 | % radial function star-shaped domain 30 | s = segment.radialfunc(50, {@(q) 1 + 0.3*cos(3*q), @(q) -3*0.3*sin(3*q)}); 31 | d = domain(s, +1); 32 | d.k = 0; 33 | d.addregfbbasis([], 8); 34 | s.setbc(-1, 'd', [], @(t) f(s.Z(t))); 35 | % f = @(x,y) exp(x).*cos(y); s.setbc(-1, 'd', [], f); % another way to pass in f 36 | p = bvp(d); 37 | p.solvecoeffs; p.bcresidualnorm 38 | figure; opts.comparefunc = f; p.showsolution(opts); 39 | if verb % generate f:radfunc 40 | h=colorbar; set(h,'fontsize',20); hold on; s.plot; axis off; 41 | print -depsc2 -painters ../doc/figs/radfunc.eps 42 | end 43 | 44 | % general analytic domain: crescent 45 | a = 0.2; b = 0.8; w = @(t) exp(2i*pi*t); 46 | s = segment(100, {@(t) w(t)-a./(w(t)+b), ... 47 | @(t) 2i*pi*w(t).*(1 + a./(w(t) + b).^2)}, 'p'); 48 | figure; s.plot; % kill the arrow maybe 49 | 50 | -------------------------------------------------------------------------------- /@scattering/pointfarfield.m: -------------------------------------------------------------------------------- 1 | % POINTFARFIELD - evaluate far field from all bases at specified points 2 | % 3 | % u = p.pointfarfield(pts) computes the farfield u at the points pts. 4 | % 5 | % Copyright (C) 2014 Stuart C. Hawkins 6 | 7 | function u = pointfarfield(self,pts) 8 | 9 | % Note: no blocking implemented... typically number of points is much 10 | % smaller than for two dimensional plots of the solution because the far 11 | % field is computed in one dimension 12 | 13 | % initialise the field 14 | u = zeros(length(pts),1); 15 | 16 | % set up points object for evalfarfield 17 | points = struct('x',pts); 18 | 19 | % loop through the domains 20 | for n=1:numel(self.doms) 21 | 22 | % check if the domain is an exterior domain... non-exterior domains do 23 | % not contribute to the far field 24 | if self.doms(n).exterior 25 | 26 | % get hold of the domain 27 | dom = self.doms(n); 28 | 29 | % loop through bases 30 | for i=1:numel(self.bas) 31 | 32 | % get hold of the basis 33 | basis = self.bas{i}; 34 | 35 | % check that the basis corresponds to the domain 36 | if utils.isin(basis,dom.bas); 37 | 38 | % evaluate the far field from the basis 39 | A = basis.evalfarfield(points); 40 | 41 | % get the coefficients 42 | cof = self.co(self.basnoff(i)+(1:basis.Nf),:); 43 | 44 | % add contribution to the far field 45 | u = u + A*cof; 46 | 47 | end 48 | 49 | end % end loop through bases 50 | 51 | end 52 | 53 | end % end loop through domains -------------------------------------------------------------------------------- /test/testrecurrencebesselJ.m: -------------------------------------------------------------------------------- 1 | % test accuracy of my fast Bessel code. Barnett Feb 2008. 2 | % brought into mpspack, 7/23/09 3 | 4 | clear all classes 5 | if 1 % test small argument problems ............. 6 | x = [0 1e-18 1e-16 1.1e-16 1e-15 1e-10 1e-5 1 200]'; % note 100 makes nst>100 7 | M = 30; %M = max(x); 8 | Jex = besselj(repmat(0:M, size(x)), repmat(x, size(0:M))); 9 | J = utils.recurrencebesselJ(M, x); 10 | max(abs(J(:)-Jex(:))./Jex(:)) 11 | end 12 | 13 | % test speed ............... 14 | Ms = [5 10 20 50 100 200]; 15 | for M = Ms; 16 | disp(sprintf('M = %d .........................', M)); 17 | x = M*sort(rand(1e4,1)); % as in app, use arguments out to largest order 18 | tic; Jex = besselJ(0:M, x); tex = toc; 19 | tic; J = utils.recurrencebesselJ(M, x); t = toc; 20 | nmev = (M+1)*numel(x)/1e6; % how many time 1e6 bessel evals were done 21 | disp(sprintf('time (us per eval), matlab:%.3g, me:%.3g', tex/nmev, t/nmev)); 22 | disp(sprintf('speedup factor %g\nmax error %g',tex/t,max(max(abs(J-Jex))))); 23 | end 24 | % I believe these errors are limited by matlab's besselj not my recurrence. 25 | 26 | figure; imagesc(x,0:M,log10(abs(J-Jex)).'); xlabel('x'); ylabel('n'); 27 | caxis([-17 -14]); colormap(jet(256)); colorbar; set(gca,'ydir','normal'); 28 | title('abs err between matlab besselj and my fast one, on -log10 scale'); 29 | 30 | 31 | if 0 % .......... detailed timing, profiler 32 | M = 200; x = M*sort(rand(1e4,1)); 33 | profile clear; profile on; J = utils.recurrencebesselJ(M, x); profile off; 34 | profile viewer; 35 | end 36 | 37 | if 0, figure; 38 | subplot(1,2,1); imagesc(x, n, Jex.'); xlabel('x'); ylabel('n'); 39 | caxis([-.1 .1]); set(gca,'ydir','normal'); 40 | subplot(1,2,2); imagesc(x, n, J.'); xlabel('x'); ylabel('n'); 41 | caxis([-.1 .1]); set(gca,'ydir','normal'); 42 | end 43 | 44 | -------------------------------------------------------------------------------- /examples/neumann_inclusion/fig_intromodes.m: -------------------------------------------------------------------------------- 1 | % accessibility modes in Fig.1 w/ Tacy, Hassell. Barnett 10/28/15 2 | % Uses Fred det method. Takes 1 min to run. 3 | clear 4 | 5 | if 1 % ------ disc 6 | M = 400; 7 | s = segment(M,[0 1.0 0 2*pi], 'p'); 8 | d = domain(s, 1); % create an interior domain 9 | p = evp(d); % sets up eigenvalue problem object 10 | s.setbc(-1, 'N'); 11 | d.addlayerpot(s, 's'); % SLP set appropriate for Neu BC 12 | n = 30; 13 | kn = fzero(@(x) besselj(n-1,x) - n*besselj(n,x)./x, n) % root of Jn' 14 | %k = 32.5342235567901 15 | o.tol = 1e-7; % degenerate, so the tolerance needs to be loosened... (sadly) 16 | o.modes = 1; p.solvespectrum(kn+0.05*[-1 1], 'fd', o); 17 | o.inds = 1; o.dx = 0.003; p.showmodes(o); 18 | text(-1,1,'(a)'); set (gcf,'paperposition',[0 0 2.5 2.5]) 19 | print -depsc2 disc_tataru.eps 20 | end 21 | 22 | if 1 %----- generic smooth 23 | M = 450; % 1000 to check converged 24 | a = 0.3; b = 0.2; w = 3; % shape params (default for BNDS: a=.3 b=.2 w=3) 25 | s = segment.radialfunc(M, {@(q) 1 + a*cos(w*(q+b*cos(q))), ... 26 | @(q) -a*sin(w*(q+b*cos(q))).*w.*(1-b*sin(q)), ... 27 | @(q) -a*cos(w*(q+b*cos(q))).*w^2.*(1-b*sin(q)).^2 + a*sin(w*(q+b*cos(q))).*w.*b.*cos(q)}); % includes curvature. 200 28 | d = domain(s, 1); % create an interior domain 29 | p = evp(d); % sets up eigenvalue problem object 30 | s.setbc(-1, 'N'); 31 | d.addlayerpot(s, 's'); % SLP set appropriate for Neu BC 32 | k = 40; 33 | o.modes = 1; p.solvespectrum([40.5 40.52], 'fd', o); 34 | o = []; o.inds = 1; o.dx = 0.005; p.showmodes(o); 35 | %k=40.51282199500848 (M=450) 36 | % 40.51282199500847 (M=1e3) 37 | text(-1,1.2,'(b)'); set (gcf,'paperposition',[0 0 3 3]) 38 | print -depsc2 neu_mode.eps 39 | end 40 | 41 | -------------------------------------------------------------------------------- /@quadr/kapurtrap.m: -------------------------------------------------------------------------------- 1 | function [x,w,cs,ier]=kapurtrap(n,m) 2 | %function [x,w,cs,ier]=kapurtrap(n,m) 3 | % 4 | % Construct the nodes and weights of n-point corrected trapezoidal 5 | % quadrature formula on the interval [0,1]. 6 | % Kapur-Rokhlin's correction formula. 7 | % 8 | % Periodic functions only! 9 | % 10 | % Input parameters: 11 | % 12 | % n - the number of quadrature points 13 | % m - the order of correction, valid values 2, 6, 10 14 | % 15 | % Output parameters: 16 | % 17 | % n - integration nodes 18 | % w - integration weights 19 | % cs = end-point correction weights 20 | % 21 | % ier - the error code 22 | % ier = 0 normal execution 23 | % ier = 8 m is not 2, 6, 10 24 | % ier = 16 n < m 25 | % 26 | 27 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 28 | 29 | ier=0; 30 | 31 | T{1} = [1.825748064736159 -1.325748064736159]; 32 | T{2} = [4.967362978287758 -16.20501504859126 25.85153761832639 ... 33 | -22.22599466791883 9.930104998037539 -1.817995878141594]; 34 | T{3} = [7.832432020568779 -4.565161670374749e+1 1.452168846354677e+2 ... 35 | -2.901348302886379e+2 3.870862162579900e+2 -3.523821383570681e+2 ... 36 | 2.172421547519342e+2 -8.707796087382991e+1 2.053584266072635e+1 ... 37 | -2.166984103403823]; 38 | 39 | 40 | x=(0:(n-1))'/(n-1); 41 | w=ones(n,1); 42 | %%w(1)=1/2; 43 | %%w(n)=1/2; 44 | w(1)=0; % punctured trapezoidal formula 45 | w(n)=0; % punctured trapezoidal formula 46 | 47 | if( ~(m == 2 || m == 6 || m == 10 ) ) 48 | ier = 8; 49 | w=w/(n-1); 50 | return 51 | end 52 | 53 | if( m > n ) 54 | ier = 16; 55 | w=w/(n-1); 56 | return 57 | end 58 | 59 | if( m == 2 ) cs = T{1}; end 60 | if( m == 6 ) cs = T{2}; end 61 | if( m == 10 ) cs = T{3}; end 62 | 63 | 64 | k=length(cs); 65 | for j=1:k 66 | w(j+1)=w(j+1)+cs(j); 67 | w(n-j+1-1)=w(n-j+1-1)+cs(j); 68 | end 69 | 70 | w=w/(n-1); 71 | 72 | -------------------------------------------------------------------------------- /INSTALL: -------------------------------------------------------------------------------- 1 | INSTALLATION INSTRUCTIONS FOR MPSPACK - version 1.33 of 10/24/13 2 | 3 | The project is hosted at the repository http://code.google.com/p/mpspack 4 | 5 | Requirements: Matlab version 7.6 (2008a) or newer is needed, since we 6 | make heavy use of recent object-oriented programming features. No 7 | other Matlab toolboxes are needed. The package should work out of the 8 | box, although some aspects may be unnecessarily slow; see below. 9 | 10 | You should now add the MPSPACK directory to your MATLAB path, for 11 | instance by adding the line 12 | 13 | addpath 'path/to/mpspack'; 14 | 15 | to your MATLAB startup.m file. You are now ready to use MPSPACK ! 16 | 17 | Tweaks & speedups: 18 | 19 | 1) If you want to use faster inside-polygon checking, and you 20 | have a 64-bit linux or 32/64-bit Windows environment, try the following: 21 | edit the file @utils/inpolywrapper.m as follows: 22 | comment out the first code line labelled "Matlab's native inpolygon", 23 | and uncomment the last line. This will use Bruno Luong's inpolygon 24 | MEX files (which are 100x faster than MATLAB 2012a or earlier). 25 | You may test it works by running test/testdomain.m without errors. 26 | 27 | 2) If you wish to use faster regular Bessel functions you may want to 28 | install the GNU Scientific Library. http://www.gnu.org/software/gsl/ 29 | There are also some optional fast basis and other math libraries (C 30 | and Fortran with MEX interfaces) included in MPSPACK, that you might 31 | want to benefit from. These should be compiled in a UNIX environment 32 | as follows: Edit the file "make.inc" in the MPSPACK directory, 33 | changing the locations of GSL and BLAS librares to match those on your 34 | system. Then from this directory type "make". 35 | 36 | For further info see the documentation and tutorial in MPSPACK/doc/ 37 | 38 | (C) 2008 - 2013 Alex Barnett. 39 | (C) 2008 - 2009 Alex Barnett and Timo Betcke. 40 | -------------------------------------------------------------------------------- /@domain/evalbases.m: -------------------------------------------------------------------------------- 1 | % EVALBASES - evaluate all basis sets in a domain object, on a pointset 2 | % 3 | % A = EVALBASES(d, p) returns matrix A whose jth column is the jth basis 4 | % function in domain d evaluated on the pointset p. 5 | % 6 | % [A An] = EVALBASES(d, p) returns also the normal derivatives using the 7 | % normals associated with the pointset. 8 | % 9 | % [A Ax Ay] = EVALBASES(d, p) returns A and the basis x- and y-partial 10 | % derivatives, ignoring the normals associated with the pointset 11 | % 12 | % Notes: 1) This routine is no longer used to fill problem, BVP, etc, matrices, 13 | % since they use ordering of basis degrees-of-freedom derived from the bas 14 | % objects in the problem. Basis objects in a problem do not reside inside 15 | % domains, so the dof ordering returned by this routine won't in general 16 | % match those in problem, BVP, etc. It may become obsolete. 17 | % 2) For layer potential basis sets, and if p is also a segment 18 | % object, jump relations will be taken into account, corresponding to 19 | % evaluation on the interior (limit approaching from inside) of the domain. 20 | 21 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 22 | 23 | 24 | function [A Ax Ay] = evalbases(d, p, opts) 25 | 26 | A = []; Ax = []; Ay = []; % matrices will be stacked as columns 27 | 28 | if nargin<3, opts = []; end 29 | for b=d.bas % loop over only basis set objects in domain 30 | bas = b{1}; % ugly, extracts object from cell 31 | opts.dom = d; % pass in which domain we're in (for jump rels) 32 | if nargout==1 33 | [bA] = bas.eval(p, opts); A = [A bA]; % stack as blocks of columns 34 | elseif nargout==2 35 | [bA bAn] = bas.eval(p, opts); A = [A bA]; Ax = [Ax bAn]; 36 | elseif nargout==3 37 | [bA bAx bAy] = bas.eval(p, opts); 38 | A = [A bA]; Ax = [Ax bAx]; Ay = [Ay bAy]; 39 | end 40 | end 41 | -------------------------------------------------------------------------------- /examples/tut_ext.m: -------------------------------------------------------------------------------- 1 | % Example codes from MPSpack tutorial, also generates EPS figures for this doc 2 | % SECTION 4: EXTERIOR MFS 3 | 4 | clear all classes; verb = 0; % if verb>0, generates EPS figures 5 | % exterior domain 6 | tref = segment.radialfunc(100, {@(q) 1 + 0.3*cos(3*q), @(q) -0.9*sin(3*q)}); 7 | d = domain([], [], tref, -1); 8 | d.k = 10; f = @(z) besselh(0,d.k * abs(z-0.3-0.2i)); % a radiative Helm soln 9 | tref.setbc(1, 'd', [], @(t) f(tref.Z(t))); % exterior Dirichlet data 10 | % MFS 11 | %d.addmfsbasis(tref.scale(0.8)); % rescaled segment copy 12 | opts.tau = 0.06; d.addmfsbasis(tref, [], opts); 13 | p = bvp(d); 14 | % convergence plot 15 | for N=5:5:80, 16 | p.updateN(N); p.solvecoeffs; r(N) = p.bcresidualnorm; 17 | end 18 | figure; semilogy(r, '+-'); xlabel('N'); ylabel('bdry err norm'); 19 | 20 | opts.comparefunc = f; figure; p.showsolution(opts); 21 | 22 | if verb 23 | figure; set(gca,'fontsize', 20); 24 | semilogy(r, '+-'); xlabel('N'); ylabel('bdry err norm'); 25 | print -depsc2 ../doc/figs/extconv.eps 26 | figure; set(gca,'fontsize', 20); 27 | d.plot; p.showbasesgeom; p.showsolution; axis off; 28 | print -depsc2 ../doc/figs/extgeom.eps 29 | end 30 | 31 | % multiply-connected domains. 1 hole... 32 | tref.disconnect; % clears any domains from segment 33 | c = segment([], [0.5 0.4 0 2*pi]); % new circular segment 34 | d = domain(tref, 1, c, -1); 35 | % 2 holes... 36 | tref.disconnect; c.disconnect; 37 | smtref = tref.scale(0.3); % create new rescaled copy of tref 38 | smtref.translate(-0.3+0.5i); % move the segment smtref 39 | d = domain(tref, 1, {c smtref}, {-1 -1}); 40 | if verb % generate f:doms a 41 | figure; set(gca, 'fontsize', 14); opts.gridinside=0.05; d.plot(opts);axis off; 42 | print -depsc2 ../doc/figs/twoholes.eps 43 | end 44 | 45 | % maybe solve MFS in multiply-connected case? Timo... 46 | -------------------------------------------------------------------------------- /test/testdielscatrokh.m: -------------------------------------------------------------------------------- 1 | % Dielectric transmission scattering via Rokhlin hypersingular-cancelling scheme 2 | % Comparing Kress hypersingular spectral vs Kapur-Rokhlin & Alpert quadratures. 3 | % 1/12/09, updated for many doms per bas object, 6/2/10, Alpert 1/29/11 4 | % Alex Barnett 5 | clear all classes; verb = 1; % verbosity (0=text, 1=plot) 6 | k = 8; % overall (ext) wavenumber 7 | n = 1.4; % interior refractive index 8 | M = 110; s = segment.smoothstar(M, 0.2, 3); % smooth closed segment 9 | di = domain(s, 1); di.setrefractiveindex(n); % interior 10 | de = domain([], [], s, -1); % exterior 11 | %o.quad = 'a'; o.ord=16; % Alpert quadr scheme & order 12 | o.quad = 'm'; % ..or Kress quadr scheme 13 | s.addinoutlayerpots('d', o); % new double-sided layerpot 14 | s.addinoutlayerpots('s', o); % " 15 | setmatch(s, 'diel', 'TM'); 16 | pr = scattering(de, di); 17 | if verb, figure; di.plot; hold on; de.plot; axis equal; end 18 | 19 | pr.setoverallwavenumber(k); 20 | pr.setincidentwave(pi/2 - pi/20); % if just angle given, it's a plane wave 21 | pr.fillquadwei; pr.setupbasisdofs; 22 | pr.fillrighthandside; 23 | pr.fillbcmatrix; 24 | pr.linsolve; 25 | fprintf('resid = %.3g, coeff nrm = %.3g\n', pr.bcresidualnorm, norm(pr.co)) 26 | u = pr.pointsolution(pointset(1+1i)) % check u_scatt at one ext pt 27 | ugood = 1.176452635715030 - 0.798366817843056i % (Kress M=110 to 1e-15) 28 | fprintf('error at one point = %.3g\n', abs(u-ugood)) 29 | % Note Kapur-Rokh needs N=600 to get ans to 1e-8, N=400 to 1e-6. Terrible. 30 | % Alpert 16th gets 1e-11 at N=110 (where Kress is 1e-15). Not bad. 31 | if verb, opts.dx = 0.05; opts.bb = [-3 3 -3 3]; figure; 32 | tic; pr.showthreefields(opts); fprintf('\tgrid eval in %.2g sec\n', toc); 33 | end 34 | -------------------------------------------------------------------------------- /@domain/addcornerbases.m: -------------------------------------------------------------------------------- 1 | function addcornerbases(d, N, opts) 2 | % ADDCORNERBASES - add irreg Fourier-Bessel basis to each corner of a domain 3 | % 4 | % ADDCORNERBASES(d, N) adds one irregular fractional-order wedge FB basis 5 | % set at each corner of domain handle d, of total degree N (total # degrees 6 | % of freedom is 2*N). Degree of each corner is proportional to angle. 7 | % 8 | % ADDCORNERBASES(d, N, opts) is as above, but allows options to be chosen: 9 | % opts.cornermultipliers = nmultipliers (basis size proportions) for each 10 | % corner. If zero for a corner, no basis is added there. 11 | % (default is all equal to 1 for valid corners) 12 | % opts.type = 's', 'c', or 'cs', chooses angular sin/cos type as in nufbbasis 13 | % (default is 'cs') 14 | % opts.nproportional={0,1} If 1 then N is scaled proportional to the 15 | % angle of the corner (default 0) 16 | % Other opts fields are passed to nufbbasis. 17 | % 18 | % See also: NUFBBASIS, ADDNUFBBASIS 19 | 20 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 21 | 22 | 23 | if nargin<3, opts = []; end 24 | if ~isfield(opts, 'cornermultipliers') % default: 1 for each valid corner... 25 | opts.cornermultipliers = ones(size(d.cloc)) .* ~isnan(d.cloc); 26 | end 27 | % ...as default, might be better with d.cang/pi instead of 1 ? 28 | if ~isfield(opts,'nproportional') 29 | nproportional=0; 30 | else 31 | nproportional=opts.nproportional; 32 | end 33 | 34 | for j=1:numel(d.cloc) 35 | bra = -d.cangoff(j) * exp(1i*d.cang(j)/2); % choose branch cut facing away 36 | if opts.cornermultipliers(j)>0 37 | opts.nmultiplier = opts.cornermultipliers(j); 38 | if nproportional, 39 | np=ceil(N*d.cang(j)/pi); 40 | else 41 | np=N; 42 | end 43 | d.addnufbbasis(d.cloc(j), pi/d.cang(j), d.cangoff(j), bra, np, opts); 44 | end 45 | end 46 | 47 | -------------------------------------------------------------------------------- /test/testbvpbyhand.m: -------------------------------------------------------------------------------- 1 | % try basic interior BVP 'by hand' in order to see best way to do bvp class. 2 | % also see testbasisdomain.m 3 | % barnett 7/10/08. Now somewhat obsolete. changed to k-free interface 8/18/09 4 | 5 | clear all classes 6 | verb = 1; 7 | M = 40; s = segment.polyseglist(M, [1 1i exp(4i*pi/3)]); % CCW tri from INCL 8 | d = domain(s, 1); 9 | k = 10; N = 30; 10 | d.k = k; opts.real = 1; d.addrpwbasis(N, opts); 11 | 12 | % set up BCs... 13 | %dirfunc = @(x) besselj(0, k*abs(x - 0.3 + .2i)); % boundary Dirichlet data 14 | dirfunc = @(x) bessely(0, k*abs(x - 1.3 + 1.2i)); % boundary Dirichlet data 15 | for j=1:numel(s) 16 | s(j).a = [0 1]; s(j).f = dirfunc(s(j).x); % set BC for each seg 17 | end 18 | f = vertcat(s.f); if verb>1, figure; plot([real(f) imag(f)]); end % view data 19 | % NB, simple since only M discrep vals per seg (no continuity conditions) 20 | 21 | % fill A matrix for each domain (here there's only 1) 22 | A = []; 23 | for j=1:numel(s) 24 | seg = s(j); 25 | As = d.evalbases(seg); 26 | A = [A; As]; 27 | end 28 | 29 | alpha = A \ f; % solve least-squares 30 | 31 | % show and check solution on interior grid... 32 | dx = 0.01; [zz ii g h] = d.grid(dx); 33 | fd = dirfunc(zz); % true solution 34 | Ad = d.evalbases(pointset(zz)); % evaluation matrix for this domain grid 35 | uNd = Ad * alpha; % our solution eval on grid 36 | r = dx * norm(uNd - fd); % L2 interior error norm (est on grid) 37 | fprintf('coeff l2 norm = %g, residual L2 norm in domain = %g\n', norm(alpha),r); 38 | if verb 39 | uN = NaN*zeros(size(ii)); uN(ii) = uNd; % write uN to a grid 40 | figure; subplot(1,2,1); imagesc(g, h, uN); colorbar; axis equal tight; 41 | title('uN'); 42 | e = NaN*zeros(size(ii)); e(ii) = uNd - fd; % write pointwise err to grid 43 | subplot(1,2,2); imagesc(g, h, e); colorbar; axis equal tight; 44 | title('uN - u_{exact}'); 45 | end 46 | 47 | % convergence plot ? etc... 48 | -------------------------------------------------------------------------------- /@utils/trigpolyzeros.m: -------------------------------------------------------------------------------- 1 | function [r derr] = trigpolyzeros(F, opts) 2 | % TRIGPOLYZEROS - return list of zeros of complex 2pi-periodic trig poly 3 | % 4 | % r = trigpolyzeros(F) returns list r of roots in (-pi, pi] of 2pi-periodic 5 | % function given by trigonometric polynomial with Fourier series coeff vector 6 | % F. The ordering of F is as returned by fftshift(fft(fftshift(f))), where f 7 | % samples the 2pi-periodic function at -pi+2*pi*(0:N-1)/N, ie complex 8 | % exponentials from frequency -N/2 to N/2-1, where N=length(F). The trig 9 | % poly's highest freq is chosen to be real (cos(N/2 t)) as in Trefethen, 10 | % Spectral Methods in Matlab book. Effort scales as O(N^3) 11 | % 12 | % r = trigpolyzeros(F, opts) passes in options including the following: 13 | % opts.tol: tolerance for how small in abs value must be to count as a zero 14 | % (default 1e-8). Note opts.tol>=1 collects the origin, is junky 15 | % opts.real: if true, assumes coeffs come from real func, keeps only UHP roots 16 | % (default false) 17 | % opts.realaxis: if true, assumes zeros on real axis, kills imag part 18 | % (default true) 19 | % 20 | % [r derr] = trigpolyzeros(...) also returns distances of roots from unit circle 21 | 22 | % (C) 2009 - 2011 Alex Barnett. 23 | if nargin<2, opts = []; end 24 | if ~isfield(opts, 'tol'), opts.tol = 1e-8; end 25 | if ~isfield(opts, 'real'), opts.real = 0; end 26 | if ~isfield(opts, 'realaxis'), opts.realaxis = 1; end 27 | F = F(:); % make col vector 28 | r = roots([F(1)/2; F(end:-1:2); F(1)/2]); % degree-doubling a la Boyd 2002 29 | %figure; plot(r, '+'); hold on; plot(exp(1i*(0:.01:2*pi)),'-r'); axis equal 30 | derr = abs(abs(r)-1); 31 | % keep only close to unit circle, if real only those in upper half plane... 32 | ii = find(derr<=opts.tol & (~opts.real | imag(r)>=0)); 33 | if opts.realaxis, r = angle(r(ii)); % was only real part of angle 34 | else r = log(r(ii))./1i; end % complex part of angle too! 35 | derr = derr(ii); 36 | 37 | -------------------------------------------------------------------------------- /@utils/utils.m: -------------------------------------------------------------------------------- 1 | classdef utils 2 | % UTILS - class of utility routines for mpspack. 3 | 4 | % Copyright (C) 2008 - 2011, Timo Betcke, Alex Barnett 5 | 6 | methods(Static) 7 | 8 | % math libraries which evaluate special functions... 9 | [res,err]=gslbesselj(nmin,nmax,x); 10 | [res,err]=gslbesseljnu(v,x); 11 | J=recurrencebesselJ(M,x); 12 | [F0 F1 F2] = fundsol(r, k, orders, fast) 13 | [B radderivs] = fundsol_deriv(r, cosphi, k, radderivs) 14 | [H0 H1] = greengardrokhlinhank103(z); 15 | [H0 H1] = greengardrokhlinhank106(z); 16 | 17 | % Greengard-Gimbutas HFMM2D library... 18 | [U]=hfmm2dparttarg(iprec,zk,nsource,source,ifcharge,charge,ifdipole,... 19 | dipstr,dipvec,ifpot,iffld,ifhess,ntarget,target,... 20 | ifpottarg,iffldtarg,ifhesstarg); 21 | [pot,fld,hess,ier]=hfmm2dpart(iprec,zk,nsource,source,ifcharge,charge,... 22 | ifdipole,dipstr,dipvec); 23 | 24 | % inpolygon replacements... 25 | [cn,on] = inpoly(p,node,edge,TOL) 26 | i = inpolyc(p,v) 27 | i = inpolywrapper(p, v) 28 | i = insidepoly(p1, p2, v1, v2) % this & next 2 are Bruno Luong's insidepoly 29 | [in on] = insidepoly_dblengine(x, y, Px1, Py1, Px2, Py2, ontol, first, last) 30 | [in on] = insidepoly_sglengine(x, y, Px1, Py1, Px2, Py2, ontol, first, last) 31 | 32 | % other helper routines... 33 | b = copy(a) 34 | monochrome(h, c) 35 | u = unique(c) 36 | i = isin(b, c) 37 | s = merge(s1,s2) 38 | [f0 err N] = extrap(f, hmax, opts) 39 | c = goodcaxis(u) 40 | h = arrow(x, y, varargin) 41 | y = lowestn(x,n) 42 | 43 | % rootfinding and linear algebra helpers... 44 | [x e y u ier] = intervalrootsboyd(f, int, o) 45 | [r e] = trigpolyzeros(F, opts) 46 | [u s v info] = minsingvalvecs(A, opts) 47 | [t X] = regeig(G,F, opts) 48 | 49 | % interpolation... 50 | w = baryweights(x) 51 | L = baryprojs(x, w, t) 52 | u = baryeval(x, w, y, t) 53 | end 54 | 55 | end 56 | -------------------------------------------------------------------------------- /@utils/fundsol.m: -------------------------------------------------------------------------------- 1 | function [F0 F1 F2] = fundsol(r, k,orders, opts) 2 | % FUNDSOL - Compute fundamental solutions 3 | % 4 | % [F0 F1 F2] = FUNDSOL(r, k, orders, fast) computes given a wavenumber k 5 | % a matrix of distances r the matrix of fundamental solutions F0, its 6 | % first r-derivative F1 and its second r-derivative F2. 7 | % 8 | % If k>0 then F0=(1i/4)*besselh(0,k*r). 9 | % If k=0 then F0=-(1/2/pi)*log(r). 10 | % 11 | % opts is a structure that can contain various options. Currently 12 | % supported is o.fast. If o.fast>0 use fast Hankel routines by Rokhlin and 13 | % Greengard. 14 | % 15 | % 16 | % The string orders can take the following values: 17 | % 18 | % orders = '0' - Evaluate only F0 19 | % orders = '1' - Evaluate only F1 20 | % orders = '01' - Evaluate F0 and F1 21 | % orders = '012' - Evaluate F0, F1 and F2 22 | % orders = '12' - Evaluate F1 and F2 23 | % 24 | 25 | fast=opts.fast; 26 | F0=[]; F1=[]; F2=[]; 27 | 28 | if abs(k)>0, 29 | % Helmholtz case 30 | if fast==2 31 | [F0 F1]=utils.greengardrokhlinhank106(k*r); 32 | elseif fast==1 33 | [F0 F1]=utils.greengardrokhlinhank103(k*r); 34 | else 35 | if strcmp(orders,'0'), 36 | F0=besselh(0,k*r); 37 | elseif strcmp(orders,'1'), 38 | F1=besselh(1,k*r); 39 | else 40 | F0=besselh(0,k*r); F1=besselh(1,k*r); 41 | end 42 | end 43 | F0=(1i/4)*F0; F1=-k*(1i/4)*F1; 44 | if orders(end)=='2', F2=-k^2*F0-F1./r; end 45 | if orders(1)~='0', F0=[]; end % Delete F0 again since it is not asked 46 | % for (only important for order='12') 47 | else 48 | % Laplace case 49 | switch orders, 50 | case '0', F0=-(1/2/pi)*log(r); 51 | case '1', F1=-(1/2/pi)./r; 52 | case '01', F0=-(1/2/pi)*log(r); F1=-(1/2/pi)./r; 53 | case '012', F0=-(1/2/pi)*log(r); F1=-(1/2/pi)./r; F2=-F1./r; 54 | case '12', F1=-(1/2/pi)./r; F2=-F1./r; 55 | end 56 | end 57 | 58 | 59 | 60 | 61 | 62 | -------------------------------------------------------------------------------- /examples/smoothdrummodesboyd.m: -------------------------------------------------------------------------------- 1 | % Example of computing a reference set of Laplacian eigenvalues and eigenmodes 2 | % of a smooth 2D drum using BIE and Boyd rootfinding. Dirichlet & Neumann case. 3 | % Barnett 6/10/11. Also see ../test/testevp.m for plotting methods 4 | 5 | clear; a = 0.3; b = 0.2; w = 3; % shape params for generic smooth drum 6 | N = 160; % # quadrature nodes good up to k=11 7 | s = segment.radialfunc(N, {@(q) 1 + a*cos(w*(q+b*cos(q))), ... 8 | @(q) -a*sin(w*(q+b*cos(q))).*w.*(1-b*sin(q)), ... 9 | @(q) -a*cos(w*(q+b*cos(q))).*w^2.*(1-b*sin(q)).^2 + ... 10 | a*sin(w*(q+b*cos(q))).*w.*b.*cos(q)}); % includes curvature 11 | d = domain(s,1); % create an interior domain 12 | if 1 % for homog Dirichlet BCs use... 13 | s.setbc(-1, 'D'); % BC's applied on inside: note -1 14 | d.addlayerpot(s, 'd'); % DLP representation 15 | else % for homog Neumann BCs use... 16 | s.setbc(-1, 'N'); % BC's applied on inside: note -1 17 | d.addlayerpot(s, 's'); % SLP representation 18 | end 19 | p = evp(d); % sets up eigenvalue problem object 20 | 21 | % choose a correction scheme for the periodic quadrature... 22 | d.bas{1}.quad = 'm'; % Kress (default, slower to fill, most accurate) 23 | %d.bas{1}.quad = 'a'; d.bas{1}.ord = 16; % 16th-order Alpert band-diagonal 24 | 25 | % Solve all modes in 21; 15 | symmflagval = -999; % all diag vals of this signifies symmetric - a hack 16 | 17 | if nargin>3 % reuse radderivs 18 | B = radderivs .* cosphi; % note covers all k 19 | 20 | else % compute from scratch 21 | if k==0 % ........ laplace 22 | if wantrad 23 | radderivs = (1/2/pi) ./ r; 24 | B = radderivs .* cosphi; 25 | else 26 | B = (1/2/pi) * cosphi ./ r; 27 | end 28 | else % ......... helmholtz 29 | % if self-interactions (square & diag flagged), then symm, do upper tri only 30 | if size(r,1)==size(r,2) & norm(diag(r)-symmflagval)<1e-14 31 | %disp(sprintf('self, diag(r)=%g', r(1,1))); 32 | B = triu(besselh(1, 1, k*triu(r,1)),1); 33 | B = B.' + B; 34 | B(diagind(B)) = besselh(1, 1, k*diag(r)); % always dummy 35 | else % do the usual thing which works for distant nonsymm interactions... 36 | B = besselh(1, 1, k*r); 37 | end 38 | % currently B contains radderivs without the ik/4 prefactor 39 | if wantrad 40 | radderivs = (1i*k/4) * B; 41 | B = radderivs .* cosphi; 42 | else 43 | B = (1i*k/4) * B .* cosphi; 44 | end 45 | end 46 | end 47 | -------------------------------------------------------------------------------- /@utils/gslbesselj.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | 7 | void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) 8 | { 9 | 10 | int i; 11 | int m; 12 | int n; 13 | int nmin; 14 | int nmax; 15 | double* x; 16 | mxArray* besMatrix; 17 | double* besData; 18 | double* err; 19 | 20 | /* Check input and output data */ 21 | 22 | 23 | if (nrhs!=3) 24 | mexErrMsgIdAndTxt("Utils:gslbesselj:nrhs", 25 | "Wrong number of input arguments"); 26 | 27 | if (!mxIsDouble(prhs[0]) || 28 | mxGetNumberOfElements(prhs[1])!=1) 29 | mexErrMsgIdAndTxt("Utils:gslbesselj:notscalar", 30 | "First input must be a scalar"); 31 | 32 | if (!mxIsDouble(prhs[1]) || 33 | mxGetNumberOfElements(prhs[1])!=1) 34 | mexErrMsgIdAndTxt("Utils:gslbesselj:notscalar", 35 | "Second input must be a scalar"); 36 | 37 | if (mxGetN(prhs[2])!=1) 38 | mexErrMsgIdAndTxt("Utils:gslbesselj:columnvector", 39 | "Expected a column vector as input"); 40 | 41 | /* Main routine */ 42 | 43 | 44 | nmin=(int)mxGetScalar(prhs[0]); 45 | nmax=(int)mxGetScalar(prhs[1]); 46 | 47 | if (nmin<0) 48 | mexErrMsgIdAndTxt("Utils:gslbesselj:nmin", 49 | "nmin must be a nonnegative integer"); 50 | 51 | if (nmax<0) 52 | mexErrMsgIdAndTxt("Utils:gslbesselj:nmax", 53 | "nmax must be a nonegative integer"); 54 | 55 | if (nmax=nmin required"); 58 | 59 | 60 | x=mxGetPr(prhs[2]); 61 | m=mxGetM(prhs[2]); 62 | 63 | n=nmax-nmin+1; 64 | 65 | besMatrix=mxCreateDoubleMatrix(n,m,mxREAL); 66 | besData=mxGetPr(besMatrix); 67 | 68 | plhs[1]=mxCreateDoubleMatrix(m,1,mxREAL); 69 | err=mxGetPr(plhs[1]); 70 | 71 | gsl_set_error_handler_off(); 72 | 73 | for (i=0; i3 % smooth rolloff 27 | wid = nterms/2 / sqrt(log(1/tol)); 28 | rolloff = erfc((-nterms/2:nterms/2-1)/wid)/2; 29 | rolloff = rolloff(1:n/2); 30 | zhat = zhat .* [rolloff rolloff(end:-1:1)].'; 31 | nterms = min(2*nterms, n); 32 | end 33 | zhat = [zhat(1:nterms/2); zhat(end-nterms/2+1:end)]; % keep lowest nterms 34 | s = segment(N,{@(t) fourierZ(zhat,t), @(t) fourierZp(zhat,t), @(t) fourierZpp(zhat,t)},'p'); 35 | 36 | % analytic formulae for a Fourier segment -------------- 37 | function z = fourierZ(zhat,t) % must work on vector of t's 38 | t = 2*pi*t; 39 | N = numel(zhat); % even 40 | z = 0*t; 41 | for k=0:N/2 42 | z = z + zhat(k+1)*exp(1i*k*t); 43 | end 44 | for k=-N/2:-1 45 | z = z + zhat(k+1+N)*exp(1i*k*t); 46 | end 47 | 48 | function zp = fourierZp(zhat,t); % deriv func Z' 49 | N = numel(zhat); 50 | zp = 2*pi*fourierZ(zhat.*[0 1i*(1:N/2-1) 0 1i*(-N/2+1:-1)].', t); 51 | 52 | function zpp = fourierZpp(zhat,t); % deriv func Z'' 53 | N = numel(zhat); 54 | zpp = 2*pi*fourierZp(zhat.*[0 1i*(1:N/2-1) 0 1i*(-N/2+1:-1)].', t); 55 | -------------------------------------------------------------------------------- /@segment/plot.m: -------------------------------------------------------------------------------- 1 | function h = plot(s, pm, o) 2 | % PLOT - plots a directed segment on current figure, using its quadrature pts 3 | % 4 | % h = PLOT(seg) plots a segment, quadrature points, etc. Also plots an array 5 | % of segment handles with their natural senses, and number labels. 6 | % 7 | % h = PLOT(seg, pm) plots segment if pm=1, or its reversal if pm=-1. 8 | % 9 | % h = PLOT(s, pm, opts) allows various options in opts, namely 10 | % opts.arrow: if true, show direction via an arrow (default true) 11 | % opts.normals: if true, show directions of the normals (default true) 12 | % opts.blobs: if true, show quadrature pt blobs (default true) 13 | % 14 | % See also: pointset/PLOT, domain/SHOWSEGMENTS 15 | 16 | % 3/16/13 Arrow changed to not use complexification of Z(t) 17 | 18 | % Copyright (C) 2008 - 2013, Alex Barnett, Timo Betcke 19 | 20 | if nargin<2, pm = 1; end % default sense is positive 21 | if nargin<3, o = []; end 22 | if ~isfield(o, 'arrow'), o.arrow = 1; end % default is show arrow 23 | if ~isfield(o,'normals'), o.normals=1; end % default is show normals 24 | lt = '.-'; % default is show quad pt blobs 25 | if isfield(o,'blobs') && ~o.blobs, lt='-'; end % switch off blobs 26 | if numel(s)==1, 27 | closed = (abs(s.Z(0)-s.Z(1))<1e-15); % hack to tell if segment is closed 28 | end 29 | 30 | g = gcf; 31 | figure(g); hold on; 32 | 33 | if numel(s)>1 % vectorize using domain routine 34 | h = domain.showsegments(s, pm, o); 35 | else % just one seg, plot it! 36 | if closed, h = plot(real([s.x; s.x(1)]), imag([s.x; s.x(1)]), lt); 37 | else h = plot(real(s.x), imag(s.x), lt); 38 | end 39 | if o.normals, 40 | l = 0.1; % show normals... length 41 | h = [h; plot([s.x(:).'; (s.x(:)+l*pm*s.nx(:)).'], 'k-')]; % uses sign from pm 42 | end 43 | 44 | if o.arrow 45 | t = 0.54; z = s.Z(t); zp = s.Zp(t); 46 | z = z + zp*pm*(0.02*[-2+1i, 0, -2-1i].'); 47 | h = [h; plot(z, '-')]; % avoids complex arguments for s.Z param 48 | end 49 | end 50 | axis equal; 51 | hold off; 52 | -------------------------------------------------------------------------------- /test/testlayerpotevalfty.m: -------------------------------------------------------------------------------- 1 | % test layerpot.evalfty by computing coeffs for y-slice lp rep in half-space, 2 | % for some layerpot source on the other half-space. 3 | % ............ relies on ftylayerpot.eval being correct 4 | % barnett 2/24/10 5 | 6 | clear all classes 7 | src = 'd'; % 's' or 'd' for the source density type 8 | rep = 's'; % 's' or 'd' for testing the half-space rep type by y-ray LP 9 | side = -1; % +-1, which side of x=0 the source is to be 10 | om = 10; % overall frequency 11 | b = ftylayerpot(0, rep, struct('omega', om)); % make basis set to be tested 12 | e = domain(); e.k = om; b.doms = e; % hook to an R^2 domain 13 | s = segment([], [side*0.8 side*1.0+0.3i]); % make horiz or vert to debug nx,ny 14 | l = layerpot(s, src); l.doms = e; % to R^2 15 | co = (6+24*(src=='s'))*ones(size(s.x)); % scale so u field is O(1) 16 | dx = 0.03; x = -1:dx:1.5; y = -3:dx:3; [xx yy] = meshgrid(x,y); 17 | p = pointset(xx(:)+1i*yy(:)); 18 | A = l.eval(p); u = reshape(A*co, size(xx)); % show only refl src 19 | o=[]; %o.side = -sign(real(p.x)); % force the FTyLP evaluation side 20 | [F Fx] = l.evalfty(b); E = b.eval(p,o); % get the FTy u & u_n eval matrices 21 | if rep=='d' 22 | ulp = -2*side*reshape(E*(F*co), size(xx)); % use FTy-DLP with tau = 2u 23 | else ulp = 2*side*reshape(E*(Fx*co), size(xx)); end % or Fty-DLP, sig = -2u_n 24 | 25 | figure; subplot(1,3,1); imagesc(x, y, real(u)); set(gca, 'ydir', 'normal'); 26 | axis equal tight; caxis([-1 1]); colorbar; b.showgeom; 27 | xlabel('x'); ylabel('y');title(['LP src val: ' src]); colormap(jet(256)); 28 | subplot(1,3,2); imagesc(x, y, real(ulp)); set(gca, 'ydir', 'normal'); 29 | caxis([-1 1]); axis equal tight; colorbar; b.showgeom; 30 | xlabel('x'); ylabel('y');title(['FTy val: ' rep]); colormap(jet(256)); 31 | subplot(1,3,3); imagesc(x, y, log10(abs(u-ulp))); set(gca, 'ydir', 'normal'); 32 | axis equal tight; xlabel('x');ylabel('y');title('log_{10} abs err'); 33 | caxis([-16 0]); colormap(jet(256)); colorbar; 34 | 35 | %set(gcf, 'paperposition', [0 0 8 5]); print -depsc2 test_FTyDLP_refl.eps 36 | % src=s,rep=d, sent to Leslie 2/24/10 37 | 38 | 39 | -------------------------------------------------------------------------------- /@evp/NtDspectrum.m: -------------------------------------------------------------------------------- 1 | function [d V] = NtDspectrum(p, k, o) 2 | % NTDSPECTRUM - return eigenvalues/eigenfunctions of (weighted) NtD bdry op 3 | % 4 | % d = NtDspectrum(p, kstar) returns all eigenvalues d of the weighted 5 | % Neumann-to-Dirichlet operator Theta(kstar), at wavenumber kstar. 6 | % 7 | % [d V] = NtDspectrum(p, kstar) also returns all eigenvectors 8 | % 9 | % [d ...] = NtDspectrum(p, kstar, opts) controls options including: 10 | % opts.quad: quadrature correction scheme for segment later-potentials 11 | % (default is 'm', Kress scheme; other option is 'a', Alpert) 12 | % opts.ord: order for Alpert quadrature correction (4,8,16, etc). 13 | % opts.cayley: if true (default), use Cayley transform, otherwise naive way. 14 | % opts.wei: if present, overrides the vector of weights 1/(x.n) at nodes 15 | % 16 | % Notes: 17 | % 1) Currently only support a domain bounded by a single closed segment 18 | % 2) Dense linear algebra is used. 19 | % 3) Typical imag part of returned eigenvalues serves as a discretization error 20 | % overall estimate. 21 | % 22 | % See also: EVP 23 | 24 | % Copyright (C) 2011, Alex Barnett 25 | 26 | if numel(p.segs)~=1, error('evp object must contain exactly 1 segment!'); end 27 | s = p.segs(1); % get the one segment 28 | 29 | if nargin<3, o = []; end % process options 30 | if ~isfield(o, 'quad'), o.quad = 'm'; end % default layerpot quadrature corrn 31 | if ~isfield(o, 'cayley'), o.cayley = 1; end 32 | eta = k; % inverse scale param in Cayley xform 33 | if isfield(o, 'wei'), w = o.wei; else w = 1./real(conj(s.x).*s.nx); end % 1/x.n 34 | 35 | N = numel(s.x); 36 | HpD = eye(N)/2 + layerpot.D(k, s, [], o); % 1/2 + D 37 | Sw = layerpot.S(k, s, [], o) .* repmat(w(:).', [N 1]); % S (x.n)^{-1} 38 | 39 | if ~o.cayley 40 | wNtD = inv(HpD) * Sw; 41 | else 42 | wNtD = inv(HpD - 1i*eta*Sw) * (-HpD - 1i*eta*Sw); 43 | end 44 | clear Sw HpD 45 | 46 | if nargout==1 47 | d = eig(wNtD); % eigenvalues only: dense 48 | else 49 | [V D] = eig(wNtD); % eigenvectors also: dense 50 | d = diag(D); 51 | end 52 | 53 | if o.cayley, d = (1i/eta) .* (1+d)./(1-d); end % undo Cayley xform each eigval 54 | -------------------------------------------------------------------------------- /test/testevpms.m: -------------------------------------------------------------------------------- 1 | % Test and demo routine for EVP solvespectrum 'ms' in MPSpack. Barnett 8/23/11 2 | 3 | clear all classes; 4 | s = segment.smoothnonsym(160, 0.3, 0.2, 3); % create a closed segment 5 | d = domain(s, 1); % create an interior domain 6 | s.setbc(-1, 'D'); % put Dirichlet BCs on inside 7 | p = evp(d); % create eigenvalue problem 8 | d.addlayerpot(s, 'd'); % needed for 'fd' and 'ms' but not 'ntd' 9 | kint = [2.5 20]; tic; p.solvespectrum(kint, 'fd'); toc, kjgood = p.kj; % ref 10 | 11 | if 0, ks = 100:0.005:100.1; % check slopes of sing vals of (1/2-D): max is 1.5 12 | for i=1:numel(ks), ss(:,i)=svd(p.fillfredholmop(ks(i))); ss(end,i), end 13 | figure; plot(ks, ss, '+-'); end 14 | 15 | o.maxslope = @(k) 1.5; o.verb = 0; 16 | tic; p.solvespectrum(kint, 'ms', o); toc, fe = p.err.mininfo.fevals; 17 | fprintf('fevals = %d (%g per min found)\n', fe, fe/numel(p.kj)) 18 | p.kj - kjgood 19 | p.err.ej 20 | 21 | stop 22 | 23 | % data on oliver: 492 eigs [90,100] in 24 | % 4023 secs (fd) 25 | % 792 s (ntd) 26 | % 26030 s (ms) 27 | 28 | 29 | % to use... 30 | 31 | %tic; p.solvespectrum([2.5 9], [], struct('modes',1)); toc % solve everything 32 | 33 | figure; imagesc(cumsum(s.w), 1:numel(p.kj), real(p.ndj)'); % image bdry funcs 34 | colormap(jet(256)); caxis([-1 1]*max(abs(caxis))); colorbar; 35 | xlabel('s'); ylabel('j'); title('boundary functions \partial_n \phi_j (s)'); 36 | figure; plot(cumsum(s.w), real(p.ndj), '+-'); % plot them as overlayed graphs 37 | xlabel('s'); ylabel('\partial_n \phi_j (s)'); 38 | 39 | if 0, evp.weylcountcheck(p.kwin(1), p.kj, d.perim, d.area); end % check missing? 40 | 41 | tic; p.showmodes; toc % compute and plot all modes 42 | 43 | if 0, p.showmodes(struct('inds',[1 16 2])); % test choosing modes, by index... 44 | p.showmodes(struct('kwin',[7 8])); % ...and by wavenumber window 45 | end 46 | 47 | if 0, [uj gx gy di] = p.showmodes; % check output and normalization (GRF eval) 48 | for j=1:numel(p.kj); u=uj(:,:,j); sum(u(find(di==1)).^2)*(gx(2)-gx(1))^2, end 49 | end % squared L2-norms shown should be within O(grid spacing) of unity 50 | 51 | -------------------------------------------------------------------------------- /@pointset/pointset.m: -------------------------------------------------------------------------------- 1 | % POINTSET - create a pointset object with locations and normal vectors as 2 | % complex numbers. 3 | % 4 | % A pointset is simple object containing a list of points in 2D, plus possibly 5 | % associated normal directions. It is used to store quadrature points on a 6 | % segment, and also evaluation point lists. Coordinates are stored as 7 | % complex numbers. 8 | % 9 | % p = POINTSET() creates an empty object 10 | % 11 | % p = POINTSET(x) where x is m-by-1 array, creates pointset with m points, where 12 | % the ith point has Cartesian coordinates (Re x(i), Im x(i)). 13 | % 14 | % p = POINTSET(x, nx) where x is above and nx has same size as x, creates 15 | % pointset with coordinates x (interpreted as above) and associated normals 16 | % nx (interpreted in the same way). The Euclidean lengths of the vectors in 17 | % nx are not required to be, nor changed to, unity. 18 | % 19 | % p = POINTSET(s) where s is a segment or array of segments makes a pointset 20 | % by stacking the points and normals in the segments. 21 | % 22 | % See also: POINTSET/plot, SEGMENT which builds on POINTSET 23 | 24 | % Copyright (C) 2008-2010, Alex Barnett, Timo Betcke 25 | 26 | 27 | classdef pointset < handle 28 | 29 | properties 30 | x % complex quadrature points (col vec) 31 | nx % (optional) outward unit normals as complex numbers (col vec) 32 | 33 | end 34 | 35 | methods 36 | function pts = pointset(x,nx) % creator for pointset object 37 | pts.x=[]; pts.nx=[]; 38 | if nargin>0 39 | if isa(x, 'segment') % it's a segment (array) so get x,nx 40 | pts.x = vertcat(x.x); pts.nx = vertcat(x.nx); 41 | else 42 | pts.x = x; 43 | if ~isempty(x) && size(x,2)~=1, error('x must be m-by-1'); end 44 | end 45 | end 46 | if nargin>1 && ~isempty(nx) 47 | if size(nx)==size(x), pts.nx=nx; 48 | else error('nx must be same size as x'); end 49 | end 50 | end 51 | 52 | % external functions... 53 | h = plot(pts) 54 | end 55 | end 56 | -------------------------------------------------------------------------------- /test/testiterparabolafit.m: -------------------------------------------------------------------------------- 1 | % test the EVP local minimization routine against MATLAB's fminbnd 2 | % Barnett 8/23/11. minor fixes & reporting 10/15/13 3 | 4 | clear; e = 0; % number of failures 5 | x = [-1 0 1]; % used throughout 6 | 7 | f = @(x) x.^2; % the vanilla minimum 8 | [xb fb] = fminbnd(f, x(1), x(3), optimset('display','iter')) % matlab 9 | o.xtol = 1e-12; o.verb = 1; for i=1:3, y(i) = f(x(i)); end % setup input 10 | [xm fm] = evp.iterparabolafit(f, x, y, o) % mine 11 | if isempty(xm), warning('xm empty!'); e = e+1; end 12 | 13 | f = @(x) (exp(x)-1).^2; % skew minimum 14 | [xb fb] = fminbnd(f, x(1), x(3), optimset('display','iter')) 15 | o.xtol = 1e-12; o.verb = 1; for i=1:3, y(i) = f(x(i)); end 16 | [xm fm i] = evp.iterparabolafit(f, x, y, o) 17 | if isempty(xm), warning('xm empty!'); e = e+1; end 18 | 19 | f = @(x) (exp(x)).^2; % minimum beyond left of interval 20 | [xb fb] = fminbnd(f, x(1), x(3), optimset('display','iter')) 21 | o.xtol = 1e-12; o.verb = 1; for i=1:3, y(i) = f(x(i)); end 22 | [xm fm i] = evp.iterparabolafit(f, x, y, o) 23 | if ~isempty(xm), warning('xm should not be found!'); e = e+1; end 24 | 25 | f = @(x) -x + 1e-8*x.^2; % minimum to right of interval, weak curvature 26 | [xb fb] = fminbnd(f, x(1), x(3), optimset('display','iter')) 27 | o.xtol = 1e-12; o.verb = 1; for i=1:3, y(i) = f(x(i)); end 28 | [xm fm] = evp.iterparabolafit(f, x, y, o) 29 | if ~isempty(xm), warning('xm should not be found!'); e = e+1; end 30 | 31 | f = @(x) [x^2; 1+x.^2]; % vanilla w/ vectorial func for f 32 | [xb fb] = fminbnd(@(x) min(f(x)), x(1), x(3), optimset('display','iter')) 33 | clear y; o.xtol = 1e-12; o.verb = 1; for i=1:3, y(:,i) = f(x(i)); end 34 | [xm fm] = evp.iterparabolafit(f, x, y, o) 35 | if isempty(xm), warning('xm empty!'); e = e+1; end 36 | 37 | % need to test cases where eps is as large as the interval, etc ! 38 | f = @(x) (exp(x)-1).^2; % skew minimum 39 | [xb fb] = fminbnd(f, x(1), x(3), optimset('display','iter')) 40 | clear y; o.xtol = 1; o.verb = 1; for i=1:3, y(i) = f(x(i)); end 41 | [xm fm i] = evp.iterparabolafit(f, x, y, o) 42 | if isempty(xm), warning('xm empty!'); e = e+1; end 43 | 44 | fprintf('number of evp.iterparabolafit failures: %d\n',e) 45 | -------------------------------------------------------------------------------- /@evp/solvebetaode.m: -------------------------------------------------------------------------------- 1 | function kh = solvebetaode(kstar, beo, A, B, C, Ap, Bp, Cp) 2 | % SOLVEBETAODE - helper routine for higher-order khat in NtD scaling method 3 | % 4 | % kh = SOLVEBETAODE(kstar, beo, A, B) solves the ODE 5 | % db/dk = (1 - B.b + A.b^2)/k, with IC b(kstar) = beo, 6 | % returning the wavenumber value kh at which b(kh) = 0. 7 | % 8 | % This is used to give a better khat prediction. 9 | % kstar = starting k, beo = starting beta, 10 | % A=kstar^2.||x_t f||^2 - ||x_t f_t||^2, B = Re, kh = predicted \hat{k} 11 | % 12 | % kh = SOLVEBETAODE(kstar, beo, A, B, C) solves the ODE 13 | % db/dk = (1 - Bb + (k^2.C - A)b^2)/k, with IC b(kstar) = beo, 14 | % returning the wavenumber value kh at which b(kh) = 0. 15 | % 16 | % This is a slightly different way to better khat prediction. 17 | % kstar = starting k, beo = starting beta, A=||x_t f_t||^2, B = Re, 18 | % C = ||x_t f||^2. kh = predicted \hat{k} 19 | % 20 | % kh = SOLVEBETAODE(kstar, beo, A, B, C, Ap, Bp, Cp) uses a linear approximation 21 | % instead of frozen values. Ap,Bp,Cp are derivatives A,B,C taken wrt k. 22 | % This seems to offer little improvement. 23 | % 24 | % Notes: 25 | % Andrew's fixed ODE, 6/12/11. Alex's attempt to use lin approx for f, 6/13/11 26 | % Frozen kstar 10/5/11 27 | 28 | % x = k - kstar, is indep var of ODE (more accurate than using k): 29 | if nargin==4 30 | F = @(x,b) (1 - B*b + A.*b.*b)./(kstar+x); 31 | elseif nargin==5 32 | F = @(x,b) (1 - B*b + ((kstar+x).^2*C-A).*b.*b)./(kstar+x); 33 | elseif nargin==8 34 | F = @(x,b) (1 - (B + Bp*x).*b + ((kstar+x).^2*(C+Cp*x)-(A+Ap*x)).*b.*b)./(kstar+x); % Alex linear approx 35 | end 36 | op = odeset('abstol',1e-14,'events',@ev); %'initialstep',0.5*kstar*abs(beo)); 37 | [x,b,xev,bev,iev] = ode45(F, [0 1.0], real(beo), op); % 1.0>eps 38 | kh = xev + kstar; % k for the event happening (stopping-point) 39 | %figure; plot(x,b,'+-'); % debug 40 | if isempty(kh), warning(sprintf('solvebetaode failed to find intersection event! beo=%g x(end)=%g b(end)=%g\n', beo, x(end), b(end))); 41 | kh = kstar/(1+beo); % back to standard 1st-order approx 42 | end 43 | 44 | function [v,ist,dir] = ev(x,b) % event func for ode45 stopping 45 | v = b; ist = 1; dir = +1; % if b were complex, need v=real(b) 46 | -------------------------------------------------------------------------------- /examples/tut_layer.m: -------------------------------------------------------------------------------- 1 | % Example codes from MPSpack tutorial, also generates EPS figures for this doc 2 | % SECTION 6: LAYER POTENTIALS 3 | 4 | clear all classes; verb = 1; % if verb>0, generates EPS figures 5 | tref = segment.radialfunc([], {@(q) 1 + 0.3*cos(3*q), @(q) -0.9*sin(3*q),... 6 | @(q) -2.7*cos(3*q)}); 7 | d = domain([], [], tref, -1); d.k = 10; 8 | d.addlayerpot(tref, 'D'); % adds DLP to tref segment 9 | f = @(z) besselh(0,d.k * abs(z-0.3-0.2i)); % known exterior field 10 | tref.setbc(1, 'D', [], @(t) f(tref.Z(t))); % its Dirichlet data 11 | p = bvp(d); 12 | Ns = 5:5:80; for i=1:numel(Ns) 13 | p.updateN(Ns(i)); p.solvecoeffs; N(i) = p.N; 14 | e(i) = abs(f(2) - p.pointsolution(pointset(2))); 15 | end 16 | cond(p.A) 17 | figure; semilogy(N, e, '+-'); xlabel('N'); ylabel('error in u(2)'); 18 | if verb, % generate f.lp a,b 19 | g=figure; set(gca,'fontsize', 20); semilogy(N, e, '+-'); axis tight; 20 | xlabel('N'); ylabel('abs error in u(2)'); 21 | set(gcf,'paperposition', [.25 .25 6 8]); 22 | print -depsc2 ../doc/figs/lpconv.eps 23 | figure; plot(eig(diag(1./p.sqrtwei)*p.A), '+'); set(gca,'fontsize', 20); 24 | axis([-.1 1.1 -.6 .6]); axis equal; 25 | hold on; t=0:0.01:2*pi; plot(0.5 + 0.5*exp(1i*t), 'r-'); 26 | xlabel('Re[\lambda(1/2+D)]'); ylabel('Im[\lambda(1/2+D)]'); 27 | set(gcf,'paperposition', [.25 .25 6 8]); 28 | print -depsc2 ../doc/figs/lpeig.eps 29 | end 30 | 31 | % Demo BWLP combined-field... (note I changed -ikS sign on Timo's suggestion) 32 | p.bas{1}.a = [-1i*d.k 1]; % sneaky way to change SLP,DLP coeffs 33 | p.fillbcmatrix; 34 | cond(p.A) 35 | if verb, % regenerate f.lp a, and generate f.lp c 36 | Ns = 5:5:80; for i=1:numel(Ns) 37 | p.updateN(Ns(i)); p.solvecoeffs; N(i) = p.N; 38 | e(i) = abs(f(2) - p.pointsolution(pointset(2))); 39 | end 40 | figure(g); hold on; semilogy(N, e, 'go--'); axis tight; 41 | print -depsc2 ../doc/figs/lpconv.eps 42 | figure; plot(eig(diag(1./p.sqrtwei)*p.A), '+'); set(gca,'fontsize', 20); 43 | hold on; t=0:0.01:2*pi; plot(0.5 + 0.5*exp(1i*t), 'r-'); 44 | axis equal tight; axis(1.05*axis); 45 | xlabel('Re[\lambda(1/2+D-ikS)]'); ylabel('Im[\lambda(1/2+D-ikS)]'); 46 | set(gcf,'paperposition', [.25 .25 6 8]); 47 | print -depsc2 ../doc/figs/lpeig_bwlp.eps 48 | end 49 | -------------------------------------------------------------------------------- /test/testinvertZparam.m: -------------------------------------------------------------------------------- 1 | % test the segment method invertZparam. Barnett 3/9/12 2 | 3 | clear; N = 100; s = segment.smoothnonsym(N, 0.3, 0.3, 3); 4 | d = domain(s, 1); % for inside test 5 | 6 | % test pts: grid of interior pts... 7 | g = -1.3:0.02:1.3; [xx yy] = meshgrid(g); zg = xx(:)+1i*yy(:); % col, so z is 8 | ii=d.inside(zg); z = zg(ii); 9 | 10 | % line of pts fixed complex displacement from bdry... 11 | %m = 1000; z = s.Z((1:m)/m + 0.4i/(2*pi)); % Im + is inside, - outside 12 | 13 | % single point at known t value... 14 | %to = (0 - 0.1i)/(2*pi); z = s.Z(to); 15 | 16 | tic; t = s.invertZparam(z); toc % do it (5 secs for grid dx=.05, n=100) 17 | 18 | if size(t,2)==1, t*2*pi, end % compare against number in to defn 19 | 20 | figure; subplot(1,2,1); title('z plane (red dots should hit black ones)'); 21 | s.plot; hold on; plot(real(z),imag(z), 'ko'); 22 | plot(s.Z(t(find(~isnan(t)))), 'r.'); axis(1.5*[-1 1 -1 1]); 23 | subplot(1,2,2); plot(2*pi*t, 'r.'); hold on; plot(2*pi*s.t, 0*s.t, '.-'); 24 | axis([0 2*pi -1 1]); %axis equal; 25 | title('s = 2.pi.t plane'); 26 | 27 | if exist('xx') % do an interior contour plot of min imag part of s... 28 | t(find(imag(t)<0)) = nan+1i*nan; mis = nan*xx; % note nan for im crucial 29 | mis(ii) = min(imag(t), [], 1); 30 | figure; contour(g,g,mis); colorbar; hold on; s.plot; 31 | end 32 | 33 | 34 | 35 | % ======================= 36 | % independent test of domain.showimagparam: 37 | clear; N = 100; s = segment.smoothnonsym(N, 0.3, 0.3, 3); 38 | d = domain(s, 1); 39 | o = []; o.levels = 0:0.02:0.12; [c h mis gx gy] = d.showimagparam(o); 40 | 41 | % harder domain... with a bump, requires fine-tuning the o.to : 42 | clear; N = 100; 43 | a=.3;b=.3;w=3; a1=0.1; a2=0.1; t0=3*pi/4; % smoothnonsym w/ gaussian bump @ t0 44 | s = segment.radialfunc(N, {@(q) 1 + a*cos(w*(q+b*cos(q))) - a1*exp(-0.5*((q-t0)/a2).^2), @(q) -a*sin(w*(q+b*cos(q))).*w.*(1-b*sin(q)) + (a1/a2^2)*(q-t0).*exp(-0.5*((q-t0)/a2).^2) }); 45 | d = domain(s, 1); 46 | o = []; o.levels = 0:0.01:0.05; %o.dx = 0.1; % reduce grid density for speed 47 | % following clusters start pts for invertZparam around gaussian bump... 48 | n=10; no=10; o.to = [((1:n)-.5)/n, (t0+2*a2*(-no:2:no)/no)/(2*pi)] + 0.05i; 49 | figure; [c h mis gx gy] = d.showimagparam(o); 50 | figure; imagesc(gx,gy,mis); colorbar; set(gca,'ydir', 'normal'); 51 | hold on; s.plot; 52 | -------------------------------------------------------------------------------- /examples/tut_square.m: -------------------------------------------------------------------------------- 1 | % TUT_SQUARE - Exponentially accurate computation of 2 | % time-harmonic scattering on the unit square. 3 | 4 | % Parameters of the problem 5 | % ------------------------- 6 | 7 | k = 50; % Wavenumber 8 | r = 1.0; % Radius of outer circle 9 | M = 200; % Number of quadrature points on segments 10 | N=100; % Number of basis fct. in each subdomain 11 | a=.5; % Half-Size of the square 12 | rmfs=0.8*r; % Radius of the fundamental solutions curve 13 | 14 | % Definition of the mesh 15 | % ---------------------- 16 | 17 | % Define all segments 18 | 19 | s = segment.polyseglist(M, [1i*r 1i*a a+1i*a a r]); 20 | s=[s(1:3) segment(2*M, [0 r 0 pi/2])]; 21 | s = [s rotate(s, pi/2) rotate(s, pi) rotate(s, 3*pi/2)]; 22 | 23 | 24 | sdecomp=s([1 4 5 8 9 12 13 16]); % All artificial boundaries 25 | extlist=s([4 8 12 16]); % Segments forming the outer circle 26 | 27 | % Define the domains 28 | d=domain.empty(4,0); 29 | for j=1:4, d(j)=domain(s(1+mod(4*(j-1)+[0 1 2 12 3],16)),[1 1 1 -1 1]); end 30 | ext = domain([], [],extlist(end:-1:1), -1); 31 | 32 | % Boundary conditions between elements 33 | % ------------------------------------ 34 | 35 | sdecomp.setmatch([k -k],[1 -1]); 36 | 37 | 38 | % Define the basis functions 39 | % -------------------------- 40 | 41 | nuopts=struct('type','s','cornermultipliers',[0 0 1 0 0],'rescale_rad',1); 42 | for j=1:4, d(j).addcornerbases(N,nuopts); end 43 | 44 | % Fundamental Solutions 45 | Z=@(t) rmfs*exp(2i*pi*t); Zp=@(t) 2i*pi*rmfs*exp(2i*pi*t); 46 | opts=struct('eta',k,'fast',2,'nmultiplier',2.0); 47 | ext.addmfsbasis({Z, Zp},N,opts); 48 | 49 | 50 | % Setup the problem class 51 | % ----------------------- 52 | 53 | pr=scattering(ext,d); 54 | pr.setoverallwavenumber(k); 55 | pr.setincidentwave(-pi/4); 56 | 57 | % Solve and plot solution 58 | % ----------------------- 59 | 60 | tic; pr.solvecoeffs; fprintf('\tcoeffs done in %.2g sec\n', toc) 61 | fprintf('\tL2 bdry error norm = %g, coeff norm = %g\n', ... 62 | pr.bcresidualnorm, norm(pr.co)) 63 | o.bb=[-1.5 1.5 -1.5 1.5]; 64 | o.dx=0.02; 65 | 66 | tic; [ui gx gy] = pr.gridincidentwave(o); 67 | u = pr.gridsolution(o); toc 68 | 69 | figure; 70 | imagesc(gx, gy, real(ui+u)); title('Full Field (Real Part)'); 71 | c = caxis; caxis([-1 1]*max(c)); 72 | axis equal tight; 73 | colorbar; 74 | set(gca,'ydir','normal'); 75 | -------------------------------------------------------------------------------- /@utils/greengardrokhlinhank103.c: -------------------------------------------------------------------------------- 1 | /* MEX interface to Greengard-Rokhlin fortran codes for Hankels. 2 | 3 | Must be linked to hank103.o which is compiled by gfortran hank103.f -c -O3 4 | Compilation in matlab: 5 | mex greengardrokhlinhank103.c hank103.o LD=gfortran 6 | See Makefile 7 | 8 | barnett 9/5/08 9 | */ 10 | 11 | #include 12 | #include 13 | 14 | extern void hank103_(double *a, double *b, double *c, int *d); 15 | 16 | void mexFunction(int nlhs, mxArray *plhs[], 17 | int nrhs, const mxArray *prhs[]) 18 | { 19 | int n, m, j; 20 | double *zr, *zi, *H0r, *H0i, *H1r, *H1i; /* ptrs to real/imag array parts */ 21 | double z[2], H0[2], H1[2]; /* non-array I/O registers */ 22 | int ifexpon = 1; /* if 1 unscaled; 0 hank103 scales by e^{-i \cdot z} */ 23 | 24 | if (nrhs != 1) 25 | mexErrMsgTxt("greengardrokhlinhank103: must have one input argument"); 26 | if (nlhs > 2) 27 | mexErrMsgTxt("greengardrokhlinhank103: must have no more than two output arguments"); 28 | if (mxIsClass(prhs[0],"sparse") || mxIsChar(prhs[0])) 29 | mexErrMsgTxt("greengardrokhlinhank103: input must be full and nonstring"); 30 | 31 | zr = mxGetPr(prhs[0]); zi = mxGetPi(prhs[0]); /* pointer to input (RHS) */ 32 | 33 | /* allocate output (LHS) arrays and H?? as pointers to them... */ 34 | m = mxGetM(prhs[0]); n = mxGetN(prhs[0]); 35 | plhs[0] = mxCreateDoubleMatrix(m, n, mxCOMPLEX); 36 | plhs[1] = mxCreateDoubleMatrix(m, n, mxCOMPLEX); 37 | H0r = mxGetPr(plhs[0]); H0i = mxGetPi(plhs[0]); 38 | H1r = mxGetPr(plhs[1]); H1i = mxGetPi(plhs[1]); 39 | 40 | if (!mxIsComplex(prhs[0])) /* input is real, has no imag part */ 41 | for (j=0;j 0) 53 | Ax = [a+ExtraNodesL*h; Ax(NodesToSkipL+1:length(Aw)) ]; 54 | Aw = [ExtraWeightsL*h; Aw(NodesToSkipL+1:length(Aw)) ]; 55 | end 56 | 57 | % Add the right endpoint corrections 58 | if (NodesToSkipR > 0) 59 | Ax = [ Ax(1:length(Ax)-NodesToSkipR); flipud(b-ExtraNodesR*h) ]; 60 | Aw = [ Aw(1:length(Aw)-NodesToSkipR); flipud(ExtraWeightsR*h) ]; 61 | end 62 | 63 | %end 64 | -------------------------------------------------------------------------------- /test/testcornerquad.m: -------------------------------------------------------------------------------- 1 | % develop corner quadratures in MPSpack 2 | 3 | if 0 % Prelim testing of the reparam funcs. Map (6.3) from Kress '91: 4 | s = 0:0.001:1; w=@(s) exp(-1./s)./(exp(-1./s)+exp(-1./(1-s))); 5 | figure; plot(s,w(s),'-'); 6 | 7 | % map from Kress '91 which is more successful: 8 | q = 8; v=@(s) (1/q-1/2)*(1-s).^3 + (s-1)/q + 1/2; 9 | w = @(s) v(s).^q ./ (v(s).^q + v(1-s).^q); 10 | s = 0:0.01:1; figure; plot(s,w(s), 'r-'); 11 | figure; plot(s,v(s),'-'); hold on; plot(s,v(s).^q,'g-'); 12 | end 13 | 14 | clear all classes; % MPSpack segment 'pc' corner quad 15 | N = 50; s = segment(N, [0 1], 'pc'); 16 | %figure; s.plot; 17 | 18 | % Helmholtz BVP convergence... (interior or exterior, with pt src or const data) 19 | o.kressq=4; s=segment.polyseglist(50, [1, exp(3i*pi/8), exp(5i*pi/4)], 'pc', o); 20 | k = 100; % choose wave# 21 | inout = -1; % choose expt: +1 for exterior (nasty corners), -1 for interior 22 | ftype = 0; % choose bdry data type: ftype=0: f=H0; ftype=1: f=1 23 | z0in = 0; z0out=1+1i; if inout==1, t=z0in; z0in=z0out; z0out=t; end % test pts 24 | f = @(z) besselh(0,k*abs(z-z0out)); if ftype==1, f = @(z) 0*z + 1; end 25 | if inout==-1, tri = domain(s, 1); else tri = domain([],[],s(end:-1:1),-1); end 26 | for i=1:3, s(i).setbc(inout, 'd', [], @(t) f(s(i).Z(t))); end % f bdry data 27 | tri.addlayerpot([], 'd'); % one layerpot per segment 28 | p = bvp(tri); tri.k = k; Ns = 30:10:200; % 30:10:150 29 | u = nan*Ns; 30 | for i=1:numel(Ns), N=Ns(i); p.updateN(N); % convergence 31 | %min(abs(diff(vertcat(s.x)))) % too close? 32 | p.solvecoeffs; u(i) = p.pointsolution(pointset(z0in)); 33 | fprintf('N=%d: u(0) = %.16g + %.16gi\n',N,real(u(i)),imag(u(i))) 34 | end 35 | if ftype==0, e = u-f(z0in); else % decide ptwise error measure for u(z0in) 36 | if inout==-1, e = imag(u); else, e = u-u(end); end, end 37 | figure; loglog(Ns,abs(e),'+-');hold on;plot(Ns,(Ns/10).^-4,'r-');axis tight; 38 | plot(Ns,Ns.^-3,'m-'); 39 | 40 | %figure; imagesc(log10(abs(p.A))); colorbar % show A 41 | if 0, figure; o = []; if ftype==0, o.comparefunc = f; end, p.showsolution(o); 42 | p.plot; hold on; plot([z0in z0out], '+'); caxis(1e-12*[-1 1]); 43 | end 44 | 45 | if 0 % plot solution density two ways: wrt arclength, and wrt node index... 46 | ww = vertcat(s.w)'; figure; subplot(2,1,1); 47 | plot(cumsum(ww(:)), abs(p.co), '+-'); subplot(2,1,2); plot(abs(p.co),'+-'); 48 | end 49 | -------------------------------------------------------------------------------- /@utils/minsingvalvecs.m: -------------------------------------------------------------------------------- 1 | function [u s v info] = minsingvalvecs(A, opts) 2 | % MINSINGVALVECS - iterative estimate of minimum singular value of square matrix 3 | % 4 | % [u s v info] = MINSINGVALVECS(A) returns left- and right-singular vectors u,v 5 | % and corresponding singular value s which is the minimum one for A. 6 | % info.flag = 0 indicates success, 1 failure. info.its = # its used (large 7 | % indicates s_{N-1} and s_{N} are close to each other, and results inaccurate. 8 | % For well-separated singular values, <10 its is enough, <3 if v. separated). 9 | % 10 | % [u s v info] = MINSINGVALVECS(A, opts) allows control of method parameters: 11 | % opts.maxits : maximum number of iterations (default 100) 12 | % opts.tol : acceptable relative tolerance in singular value (default 1e-14) 13 | % 14 | % Uses inverse iteration on A'*A, performed by alternating solves with A and A'. 15 | % The algorithm (Loef version) is outlined in Calderon-Guizar et al, 16 | % IEEE Power Engineering Review, 19 (9), 55-56 (1999). It needs one LU-decomp 17 | % of A which is O(N^3) but overall up to 30 times faster than dense complex svd! 18 | % 19 | % Notes/issues: 20 | % * When s is small (close to 1e-16) the phase angle of u relative to v 21 | % becomes inaccurate. This may be an intrinsic property of SVD? 22 | % * Explore rectangular A variant (do LU of A' also, doubling the cost?) 23 | % * Make a block version to handle subspace of several small sing vals? 24 | % 25 | % See also: SVD, TEST/TESTMINSINGVALVEC 26 | 27 | % Copyright (C) 2010, Alex Barnett 28 | if nargin<2, opts = []; end 29 | if ~isfield(opts, 'maxits'), opts.maxits = 100; end 30 | if ~isfield(opts, 'tol'), opts.tol = 1e-14; end 31 | N = size(A,1); if N~=size(A,2), error('A must be square!'); end 32 | 33 | [L U] = lu(A); LT = L'; UT = U'; % the slow part; replace with permuted? 34 | v = rand(N,1) - 0.5; % starting vector (real if A is) 35 | if ~isreal(A), v = v + 1i*(rand(N,1) + 0.5); end % complex starting choice 36 | s = nan; % dummy starting for min sing val 37 | for i=1:opts.maxits, os = s; % store the old value of s 38 | z=UT\v; u=LT\z; u=u/norm(u); z=L\u; v=U\z; s=1/norm(v); v=s*v; 39 | if abs((s-os)/os)1, figure; plot([s.t; 1+s.t], abs([c; c]), '+-'); % abs(dens) is periodic 37 | title(sprintf('P=%d Z=%d',o.nei,o.buf)); end 38 | 39 | de.cloc = nan; % needed to tell de.inside its grating, exclude lower halfplane: 40 | if v, tic; [u gx gy di] = p.showfullfield(struct('ymax', 1.3)); toc, end 41 | -------------------------------------------------------------------------------- /@domain/plot.m: -------------------------------------------------------------------------------- 1 | function h = plot(d, o) 2 | % PLOT - show domain (or list of domains) on current figure 3 | % 4 | % h = PLOT(d) draws many geometry features of a domain onto the current figure. 5 | % h is a column vector of handles to all objects plotted. 6 | % 7 | % h = PLOT(d, opts) modifies this by options given by opts struct, including, 8 | % opts.approxp: if true, show approx polygons for each piece (default true) 9 | % opts.gridinside: only if >0, show gridpoints inside domain (default 0) 10 | % 11 | % Also all options in SHOWSEGMENTS have effect. 12 | % 13 | % Also see: DOMAIN.SHOWDOMAINS which is the correct code for domain lists 14 | 15 | % Copyright (C) 2008, 2009, Alex Barnett, Timo Betcke 16 | 17 | if nargin<2, o = []; end 18 | if numel(d)>1, h = domain.showdomains(d, o); return; end 19 | % the rest of code handles a single domain object... 20 | 21 | if ~isfield(o, 'gridinside'), o.gridinside=0; end % default no grid 22 | if ~isfield(o, 'approxp'), o.approxp = 1; end % default show polygon 23 | if ~isfield(o, 'filled'), o.filled=0; end % to show domains as solid ?? to do 24 | 25 | h = domain.showsegments(d.seg, d.pm, o); % show all segments 26 | 27 | if o.approxp 28 | for piece=0:max(d.spiece) % show approx poly for each connected piece 29 | js = find(d.spiece==piece); 30 | v = domain.approxpolygon(d.seg(js), d.pm(js)); 31 | if ~isempty(v), h = [h; plot(real([v; v(1)]), imag([v; v(1)]), '--r')]; end 32 | end 33 | end 34 | 35 | l = 0.1; % show corner fans: radius 36 | for j=find(~isnan(d.cloc)) % show list of valid corners only 37 | x = real(d.cloc(j)); y = imag(d.cloc(j)); 38 | h = [h; plot(x, y, '.g', 'markersize', 20)]; 39 | angfrac = 0:.05:1; 40 | %t = d.cangoff(j) * d.cang(j).^angfrac; % when cang was on unit circle 41 | t = d.cangoff(j) * exp(1i*d.cang(j).*angfrac); 42 | h = [h; patch([x+l*real(t) x], [y+l*imag(t) y], 'k')]; % filled polygon patch 43 | end 44 | 45 | if o.gridinside>0 % want grid of pts inside the domain? 46 | [zz] = d.grid(o.gridinside); 47 | h = [h; plot(real(zz), imag(zz), '.', 'markersize', 1)]; 48 | end 49 | 50 | % show stats... the 1,1 are in case d.x=[] which happens for the entire plane 51 | h = [h; text(max([real(d.x); 1]), max([imag(d.x); 1]), ... 52 | sprintf('area = %g\nperim = %g', d.area, d.perim))]; 53 | 54 | if d.refr_ind ~= 1.0 55 | h = [h; text(real(d.center), imag(d.center), sprintf('n=%.3g', d.refr_ind))]; 56 | end 57 | -------------------------------------------------------------------------------- /@utils/greengardrokhlinhank106.c: -------------------------------------------------------------------------------- 1 | /* MEX interface to Greengard-Rokhlin precomputed Chebychev lookup for Hankels. 2 | 3 | Based on greengardrokhlinhank103.c 4 | Must be linked to hank103.o and hank106.o; see Makefile. 5 | 6 | barnett 9/5/08 7 | */ 8 | 9 | #include 10 | #include 11 | 12 | extern void hank103_(double *a, double *b, double *c, int *d); 13 | extern void hank106_(double *a, double *b, double *c, int *d); 14 | extern void hank106datagen_(double *rk, int *ier); 15 | 16 | void mexFunction(int nlhs, mxArray *plhs[], 17 | int nrhs, const mxArray *prhs[]) 18 | { 19 | int n, m, j; 20 | double *zr, *zi, *H0r, *H0i, *H1r, *H1i; /* ptrs to real/imag array parts */ 21 | double z[2], H0[2], H1[2]; /* non-array I/O registers */ 22 | double rk[2] = {1.0,0.0}; /* fake wavenumber for datagen */ 23 | int ier, ifexpon = 1; /* if 1 unscaled; 0 hank103 scales by e^{-i \cdot z} */ 24 | 25 | if (nrhs != 1) 26 | mexErrMsgTxt("greengardrokhlinhank106: must have one input argument"); 27 | if (nlhs > 2) 28 | mexErrMsgTxt("greengardrokhlinhank106: must have no more than two output arguments"); 29 | if (mxIsClass(prhs[0],"sparse") || mxIsChar(prhs[0])) 30 | mexErrMsgTxt("greengardrokhlinhank106: input must be full and nonstring"); 31 | 32 | zr = mxGetPr(prhs[0]); zi = mxGetPi(prhs[0]); /* pointer to input (RHS) */ 33 | 34 | /* allocate output (LHS) arrays and H?? as pointers to them... */ 35 | m = mxGetM(prhs[0]); n = mxGetN(prhs[0]); 36 | plhs[0] = mxCreateDoubleMatrix(m, n, mxCOMPLEX); 37 | plhs[1] = mxCreateDoubleMatrix(m, n, mxCOMPLEX); 38 | H0r = mxGetPr(plhs[0]); H0i = mxGetPi(plhs[0]); 39 | H1r = mxGetPr(plhs[1]); H1i = mxGetPi(plhs[1]); 40 | 41 | hank106datagen_(rk, &ier); /* generate lookup table (in static arrays) */ 42 | 43 | if (!mxIsComplex(prhs[0])) /* input is real, has no imag part */ 44 | for (j=0;j 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | 8 | void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) 9 | { 10 | 11 | int i; 12 | int vsize; 13 | int xsize; 14 | 15 | double* v; 16 | double* x; 17 | double* err; 18 | double* besData; 19 | double* pr; 20 | 21 | mxArray* rhs[3]; 22 | 23 | 24 | /* Check input and output data */ 25 | 26 | 27 | /* if (nrhs!=3) */ 28 | /* mexErrMsgIdAndTxt("Utils:gslbesselj:nrhs", */ 29 | /* "Wrong number of input arguments"); */ 30 | 31 | /* if (!mxIsDouble(prhs[0]) || */ 32 | /* mxGetNumberOfElements(prhs[1])!=1) */ 33 | /* mexErrMsgIdAndTxt("Utils:gslbesselj:notscalar", */ 34 | /* "First input must be a scalar"); */ 35 | 36 | /* if (!mxIsDouble(prhs[1]) || */ 37 | /* mxGetNumberOfElements(prhs[1])!=1) */ 38 | /* mexErrMsgIdAndTxt("Utils:gslbesselj:notscalar", */ 39 | /* "Second input must be a scalar"); */ 40 | 41 | /* if (mxGetN(prhs[2])!=1) */ 42 | /* mexErrMsgIdAndTxt("Utils:gslbesselj:columnvector", */ 43 | /* "Expected a column vector as input"); */ 44 | 45 | /* Main routine */ 46 | 47 | 48 | vsize=(int)mxGetN(prhs[0]); 49 | xsize=(int)mxGetM(prhs[1]); 50 | 51 | /* if (nmin<0) */ 52 | /* mexErrMsgIdAndTxt("Utils:gslbesselj:nmin", */ 53 | /* "nmin must be a nonnegative integer"); */ 54 | 55 | /* if (nmax<0) */ 56 | /* mexErrMsgIdAndTxt("Utils:gslbesselj:nmax", */ 57 | /* "nmax must be a nonegative integer"); */ 58 | 59 | /* if (nmax=nmin required"); */ 62 | 63 | 64 | v=mxGetPr(prhs[0]); 65 | x=mxGetPr(prhs[1]); 66 | 67 | /* Fill up besData with copies of x */ 68 | 69 | /* for (i=0; i1/3 otherwise not smooth to emach 6 | b = pi/6; % controls approx opening angle in radians (keep small for resonant) 7 | 8 | N = ceil(N/2); 9 | s = ((1:N)-0.5)/N * pi; % note half-offset, needed for easy reflection abt z 10 | r = 1 - a*erf((s-pi/2)/a); % radius: starts at 1+a, ends at 1-a 11 | c = a; %*(1-b/pi); % is theta rounding scale 12 | sabs = @(x) exp(-(x/c).^2)*c/sqrt(pi)+x.*erf(x/c); % c-smoothed absval 13 | th = b-a + 2*(1-(b-a)/pi)*sabs(s-pi/2); 14 | %th = b + sqrt(log(exp((2*(1-b/pi)*(s-pi/2)).^2) + exp(c^2))); % theta 15 | 16 | % coords in (rho,z) plane: 17 | rho = r.*sin(th); z = r.*cos(th); % theta down from z axis as in 3D cyl coords 18 | 19 | z = z*1.2; % vert stretch! makes ellipse cavity 20 | 21 | s = segment(); 22 | Z = [rho -rho(end:-1:1)] + 1i*[z z(end:-1:1)]; % complex coords of full curve 23 | N = numel(Z); 24 | % (appropriate for half-integer offset 25 | %figure; semilogy(abs(fft(Z))); title('Fourier coeff decay, to close to emach?') 26 | %Z = Z(end:-1:1); 27 | zhat = fft(Z(:))/N; 28 | 29 | s = segment(N,{@(t) fourierZ(zhat,t), @(t) fourierZp(zhat,t), @(t) fourierZpp(zhat,t)},'p'); 30 | 31 | %figure; plot(Z,'k.'); hold on; l=0.1; plot([Z;Z+l*Zn],'b-'); % show it 32 | %axis equal xy tight; 33 | 34 | 35 | 36 | % analytic formulae for a Fourier segment -------------- 37 | 38 | function z = fourierZ(zhat,t) % must work on vector of t's 39 | t = 2*pi*t; 40 | N =numel(zhat); % even 41 | z = 0*t; 42 | for k=0:N/2 43 | z = z + zhat(k+1)*exp(1i*k*t); 44 | end 45 | for k=-N/2:-1 46 | z = z + zhat(k+1+N)*exp(1i*k*t); 47 | end 48 | 49 | function zp = fourierZp(zhat,t); % deriv func Z' 50 | N = numel(zhat); 51 | zp = 2*pi*fourierZ(zhat.*[0 1i*(1:N/2-1) 0 1i*(-N/2+1:-1)].', t); 52 | 53 | function zpp = fourierZpp(zhat,t); % deriv func Z'' 54 | N = numel(zhat); 55 | zpp = 2*pi*fourierZp(zhat.*[0 1i*(1:N/2-1) 0 1i*(-N/2+1:-1)].', t); 56 | 57 | % --------------------- 58 | 59 | function g = perispecdiff(f) 60 | % PERISPECDIFF - use FFT to take periodic spectral differentiation of vector 61 | % 62 | % g = PERISPECDIFF(f) returns g the derivative of the spectral interpolant 63 | % of f, which is assumed to be the values of a smooth 2pi-periodic function 64 | % at the N gridpoints 2.pi.j/N, for j=1,..,N (or any translation of such 65 | % points). 66 | % 67 | % Barnett 2/18/14 68 | N = numel(f); 69 | if mod(N,2)==0 % even 70 | g = ifft(fft(f(:)).*[0 1i*(1:N/2-1) 0 1i*(-N/2+1:-1)].'); 71 | else 72 | g = ifft(fft(f(:)).*[0 1i*(1:(N-1)/2) 1i*((1-N)/2:-1)].'); 73 | end 74 | g = reshape(g,size(f)); 75 | -------------------------------------------------------------------------------- /@evp/spectralfiltermatrix.m: -------------------------------------------------------------------------------- 1 | function Fh = spectralfiltermatrix(s,k,opts) 2 | % SPECTRALFILTERMATRIX fill M*M boundary matrix applying func of surf Laplacian 3 | % 4 | % Fh = spectralfiltermatrix(s,k,opts) returns square matrix spectrally-accurate 5 | % discretization of a certain function of the surface Laplacian Delta, ie 6 | % 7 | % F_h = max [ (1 - Delta)_+^{1/2}, c/k^{1/3} ] 8 | % 9 | % where (...)_+ indicates the positive part, c is a build-in constant, and 10 | % k is the overall wavenumber. This is a helper for filtered DtN method 11 | % for Neumann MPS bounds. See our paper arxiv:1512.04165 12 | % 13 | % Inputs: 14 | % s - segment 15 | % k - wavenumber 16 | % opts.verb - verbosity 17 | % 18 | % Switched to method that uses multiple of identity to handle the high-freq 19 | % limit, and use Fourier projection for only the difference from this limit. 20 | 21 | % Barnett 12/8/15. Brought in as @evp method 4/12/16. 22 | 23 | if nargin==0, test_spectralfiltermatrix; return; end 24 | if nargin<3, opts = []; end 25 | if ~isfield(opts,'verb'), opts.verb = 0; end 26 | 27 | L = sum(s.w); % perim 28 | M = numel(s.x); 29 | arcl = real(ifft(-1i*fft(s.speed).*[0 1./(1:M/2-1) 0 -1./(M/2-1:-1:1)]')); 30 | 31 | % spectral approx to sampled cumulative arclength 32 | arcl = arcl'/2/pi + L*s.t'; % add back in growing component (const irrelevant) 33 | maxm = ceil(M/4); % can't make this big since get osc crap 34 | %maxm = ceil(M/2)-1; 35 | ns = -maxm:maxm; P = exp((-2i*pi/L)*ns'*arcl); % ns=freqs. Dense DFT mat 36 | Pt = P'; PW = P.*repmat(s.w/L,[numel(ns) 1]); % Pt takes Fou coeffs to vals on pO 37 | %norm(Pt*PW) % close to Id, so close-ish to 1. 38 | if opts.verb 39 | fprintf('test PW.1 should be zero apart from mode m=0 which is 1:\n') 40 | sum(PW,2) 41 | end 42 | 43 | % now stuff specific to filter func... 44 | xin = 2*pi/L/k*ns; % freq xi grid (wavenumber scaled so k=1) 45 | c = 1.0; 46 | if 0 % crude way that kills freqs > nmax (bad for use in tension) 47 | gk = max(real(sqrt(1-xin.^2)),c*k^(-1/3)); % hard h^{1/3} cutoff 48 | fk = 1./gk; 49 | Fh = Pt*(diag(fk)*PW); % discrete inverse op, ie F_h 50 | else % use Id as the h^{1/3} shift, so high freqs handled correctly 51 | cut = c*k^(-1/3); % cutoff and use as shift 52 | fk = 1./max(real(sqrt(1-xin.^2)),cut) - 1/cut; % shift 53 | Fh = (1/cut)*eye(M) + Pt*(diag(fk)*PW); 54 | end 55 | Fh = real(Fh); % matrix supposed to be real-valued 56 | %%%%% 57 | 58 | function test_spectralfiltermatrix 59 | M=400; 60 | s = segment.smoothnonsym(M, 0.3, 0.2, 3); 61 | k = 30; 62 | f = sin(k*real(s.x)); % some osc func going up to freqs k, but far from Nyq 63 | Fh = evp.spectralfiltermatrix(s,k); 64 | g = Fh*f; 65 | figure; plot(cumsum(s.w), [f g], '.-'); 66 | %keyboard 67 | -------------------------------------------------------------------------------- /examples/lenses.m: -------------------------------------------------------------------------------- 1 | % Helmholtz scattering through many lenses. For ommatidium eye project. 2 | % (Ali Simons, Leslie Greengard, Charlie Epstein.) 3 | % Alex Barnett 7/22/20 4 | clear; clear all classes; addpath .. 5 | verb = 1; 6 | shape = 'connectdots'; 7 | 8 | switch shape 9 | case 'ellipse' % analytic ellipses, semiaxes a,b 10 | a = 0.3; b = 1; 11 | pp = 2*pi; 12 | Z = @(t) a*cos(pp*t)+1i*b*sin(pp*t); 13 | Zp = @(t) pp*(-a*sin(pp*t)+1i*b*cos(pp*t)); 14 | Zpp = @(t) pp^2*(-a*cos(pp*t)-1i*b*sin(pp*t)); 15 | n = 160; % discr nodes for 10 digits (check conv of soln at test pt!) 16 | s0 = segment(n,{Z,Zp,Zpp},'p'); 17 | case 'connectdots' % arbitrary, connect the dots 18 | np = 40; % # dots (shoudl be multiple of 4) 19 | z = exp(2i*pi*(-np/4:np/4-1)/(4*np)) - cos(pi/8); % a pi/8 angle lens 20 | z = [z -z]; % some points, replace w/ yours 21 | z = 3*z; 22 | n = 160; % discr nodes for 5 digits. 23 | s0 = segment.smoothfourierz(n,z,n/2,1e-4); % see help for this command 24 | case 'twoarcs' 25 | % *** this would have corners. I can easily do this if you need. 26 | end 27 | 28 | % make 3 lenses... (cell array since separate objects) 29 | s{1} = s0; 30 | s{2} = translate(s0,1); 31 | s{3} = translate(s0.scale(0.5),2); 32 | % interior domains, refr indices... 33 | di(1) = domain(s{1}, 1); di(1).setrefractiveindex(1.3); 34 | di(2) = domain(s{2}, 1); di(2).setrefractiveindex(1.5); 35 | di(3) = domain(s{3}, 1); di(3).setrefractiveindex(2.0); 36 | de = domain([], [], s, {-1 -1 -1}); % exterior (cell arr -> discon) 37 | if verb, figure; di.plot; hold on; de.plot; axis equal; drawnow; title('geom'); 38 | end 39 | 40 | % rep... 41 | o.quad = 'm'; % Kress spectral quadr 42 | for k=1:numel(s) % add Kress-Roach rep... 43 | s{k}.addinoutlayerpots('d', o); % rep affects both sides. 44 | s{k}.addinoutlayerpots('s', o); % " 45 | setmatch(s{k}, 'diel', 'TM'); % matching conds: [u]=0, [u_n]=0 46 | end 47 | pr = scattering(de, di); % set up scattering BVP 48 | 49 | k=20; pr.setoverallwavenumber(k); 50 | pr.setincidentwave(-0.05*pi); % if just angle given, it's a plane wave 51 | % compute... 52 | pr.fillquadwei; pr.setupbasisdofs; 53 | pr.fillrighthandside; 54 | pr.fillbcmatrix; 55 | pr.linsolve; 56 | 57 | ptest = pointset(2.5+0.1i); 58 | utot = pr.pointsolution(ptest) + pr.pointincidentwave(ptest); 59 | fprintf('total potential at test point:\t%.10g + %.10g i\n',real(utot),imag(utot)) 60 | 61 | if verb, figure; opts.dx = 0.02; opts.bb = [-1 3 -2 2]; 62 | % opts.FMM=1; % if you have compiled MEX interface to FMMLIB2D 63 | tic; pr.showthreefields(opts); fprintf('\tgrid eval in %.2g sec\n', toc); 64 | hold on; plot(ptest.x,'.','markersize',20); % test pt 65 | end 66 | -------------------------------------------------------------------------------- /test/testevp.m: -------------------------------------------------------------------------------- 1 | % Test and demo routine for EVP class in MPSpack. Barnett 8/17/10 2 | % Finds lowest 16 Dirichlet modes of smooth domain to 13 digits in 13 secs... 3 | % then plots them on a grid. See end for demo of finding more modes. 4 | 5 | clear all classes; a = 0.3; b = 0.2; w = 3; % shape params, smooth closed curve 6 | s = segment.radialfunc(160, {@(q) 1 + a*cos(w*(q+b*cos(q))), ... 7 | @(q) -a*sin(w*(q+b*cos(q))).*w.*(1-b*sin(q)), ... 8 | @(q) -a*cos(w*(q+b*cos(q))).*w^2.*(1-b*sin(q)).^2 + ... 9 | a*sin(w*(q+b*cos(q))).*w.*b.*cos(q)}); % includes curvature 10 | d = domain(s,1); 11 | s.setbc(-1, 'D'); % homog dirichlet BCs (on inside: note -1) 12 | d.addlayerpot(s, 'd'); 13 | p = evp(d); % sets up problem object 14 | tic; p.solvespectrum([2.5 9], [], struct('modes',1)); toc % solve everything 15 | 16 | figure; imagesc(cumsum(s.w), 1:numel(p.kj), real(p.ndj)'); % image bdry funcs 17 | colormap(jet(256)); caxis([-1 1]*max(abs(caxis))); colorbar; 18 | xlabel('s'); ylabel('j'); title('boundary functions \partial_n \phi_j (s)'); 19 | figure; plot(cumsum(s.w), real(p.ndj), '+-'); % plot them as overlayed graphs 20 | xlabel('s'); ylabel('\partial_n \phi_j (s)'); 21 | 22 | if 0, evp.weylcountcheck(p.kwin(1), p.kj, d.perim, d.area); end % check missing? 23 | 24 | tic; p.showmodes; toc % compute and plot all modes 25 | 26 | if 0, p.showmodes(struct('inds',[1 16 2])); % test choosing modes, by index... 27 | p.showmodes(struct('kwin',[7 8])); % ...and by wavenumber window 28 | end 29 | 30 | if 0, [uj gx gy di] = p.showmodes; % check output and normalization (GRF eval) 31 | for j=1:numel(p.kj); u=uj(:,:,j); sum(u(find(di==1)).^2)*(gx(2)-gx(1))^2, end 32 | end % squared L2-norms shown should be within O(grid spacing) of unity 33 | 34 | 35 | % More impressive demo: same shape, modes 1-93 found and plotted in 100 seconds 36 | tic; p.solvespectrum([2.5 20], [], struct('modes',1)); toc 37 | tic; p.showmodes; toc 38 | max(p.err.minsigj) % since N=160 still, see some deterioration approaching k=20 39 | 40 | 41 | 42 | 43 | % =========== NtD scaling method test taken from smoothdrummodesNtD.m ======= 44 | 45 | clear all classes; N = 300; % # quadrature nodes good up to k=30 46 | s = segment.smoothnonsym(N, 0.3, 0.2, 3); % closed smooth non-symm segment 47 | d = domain(s, 1); % create an interior domain 48 | s.setbc(-1, 'D'); % Dirichlet BC's applied on inside: note -1 49 | p = evp(d); % sets up eigenvalue problem object 50 | 51 | % NtD spectrum with keeping a dat object... 52 | tic; [kj err coj ndj dat] = p.solvespectrum([30 31], 'ntd', struct('eps',0.1,'khat','o','modes',0,'fhat','f')); toc; 53 | 54 | % check reusing this dat object... (should be v fast) 55 | tic; [kj err] = p.solvespectrum([30 31], 'ntd', struct('eps',0.1,'khat','l','dat',dat)); toc; 56 | -------------------------------------------------------------------------------- /@evp/filteredDtNspectrum.m: -------------------------------------------------------------------------------- 1 | function [d V] = filteredDtNspectrum(p, k, o) 2 | % FILTEREDDTNSPECTRUM - eigenvalues/eigenfunctions of filtered DtN bdry op 3 | % 4 | % d = filteredDtNspectrum(p, kstar) returns all eigenvalues d of the weighted 5 | % Dirichlet-to-Neumann operator Theta(kstar), at wavenumber kstar, used 6 | % for Neumann scaling-type method. 7 | % 8 | % Currently the k used for spectral filter can only be fixed as a hack. 9 | % 10 | % See NtDspectrum for other notes; some code from neuscaling.m 11 | 12 | % Copyright (C) 2014, Alex Barnett, based on NtDspectrum 13 | 14 | if numel(p.segs)~=1, error('evp object must contain exactly 1 segment!'); end 15 | s = p.segs(1); % get the one segment 16 | M = numel(s.w); L = sum(s.w); % # pts, perimeter 17 | arcl = real(ifft(-1i*fft(s.speed).*[0 1./(1:M/2-1) 0 -1./(M/2-1:-1:1)]')); 18 | % spectral approx to sampled cumulative arclength 19 | arcl = arcl'/2/pi + L*s.t'; % add back in growing component (const irrelevant) 20 | 21 | if nargin<3, o = []; end % process options - from NtDspectrum 22 | if ~isfield(o, 'quad'), o.quad = 'm'; end % default layerpot quadrature corrn 23 | if ~isfield(o, 'cayley'), o.cayley = 0; end 24 | eta = k; % inverse scale param in Cayley xform 25 | if isfield(o, 'wei'), w = o.wei; else w = 1./real(conj(s.x).*s.nx); end % 1/x.n 26 | 27 | N = numel(s.x); 28 | HpD = eye(N)/2 + layerpot.D(k, s, [], o); % 1/2 + D 29 | S = layerpot.S(k, s, [], o); % S 30 | 31 | if ~o.cayley 32 | DtN = inv(S) * HpD; 33 | else, error('cayley not implemented'); end 34 | clear Sw HpD 35 | 36 | % set up Fourier filter on bdry; see neuscaling... 37 | persistent PW Pt kicknull % only compute once (indep of k) 38 | ns = -N/4:N/4; %ns = -N/2+1:N/2; % don't go out to all freqs where quadr inacc 39 | if isempty(PW) 40 | P = exp((-2i*pi/L)*ns'*arcl); % ns=freqs. Dense DFT mat 41 | Pt = P'; PW = P.*repmat(s.w/L,[numel(ns) 1]); % Pt takes F coeffs to vals on pO 42 | [U S V] = svd(PW); nulP = V(:,numel(ns)+1:end); % null PW 43 | kicknull = 1e1*nulP*nulP'; clear U S V nulP % kick nullspace eigvals up to big 44 | end 45 | 46 | kfilt = k; %301; % or k, filter wavenumber 47 | xin = 2*pi/L/kfilt*ns; % freq xi grid (wavenumber scaled so k=1) 48 | %Fk = max(real(sqrt(1-xin.^2)),0.5*kfilt^(-1/3)); % freq filter vs xi, default 49 | Fk = max(real(sqrt(1-xin.^2)),0.1*kfilt^(-1/3)); % freq filter vs xi 50 | %Fk = Fk .* (1 - (1-1e-2)*(abs(ns)>N/4)); % truncate in freq, so iF large 51 | iF = Pt*(diag(Fk.^-1)*PW) + kicknull; % high freqs kicked to big EVs 52 | %iFk = max(real(1./sqrt(1-xin.^2))); iFk(isinf(iFk)) = 0; % inv of freq filter 53 | %iF = Pt*(diag(iFk)*PW); % fails? 54 | wDtN = iF * (DtN * (iF .* repmat(w(:).', [N 1]))); % A^-1 * DtN * A^-1 * xn^-1 55 | 56 | if nargout==1 57 | d = eig(wDtN); % eigenvalues only: dense 58 | else 59 | [V D] = eig(wDtN); % eigenvectors also: dense 60 | d = diag(D); 61 | end 62 | -------------------------------------------------------------------------------- /examples/smoothdrummodesNtD.m: -------------------------------------------------------------------------------- 1 | % Examples of computing Laplacian Dirichlet eigenvalues and eigenmodes 2 | % of a smooth 2D drum using the weighted-Neumann-to-Dirichlet scaling method 3 | % published by Barnett-Hassell CPAM 2014 (see this paper for algorithm). 4 | % Barnett 6/10/11, cleaned up 4/13/16 5 | 6 | clear all classes; N = 300; % # quadrature nodes good up to k=30 7 | s = segment.smoothnonsym(N, 0.3, 0.2, 3); % closed smooth non-symm segment 8 | d = domain(s, 1); % create an interior domain 9 | s.setbc(-1, 'D'); % Dirichlet BC's applied on inside: note -1 10 | p = evp(d); % sets up eigenvalue problem object 11 | p.set 12 | 13 | % clean up this file by moving to expt_*.m 14 | 15 | if 0 % check operator spectrum and timing at a single k: 16 | tic; l = p.NtDspectrum(30); toc, min(l) % test 17 | tic; ll = p.NtDspectrum(30, struct('quad','a','ord',16)); toc, min(ll) 18 | tic; ll = p.NtDspectrum(30, struct('quad','m')); toc, min(ll) 19 | end 20 | 21 | %o.khat='l'; o.fhat='f'; p.solvespectrum([30 31], 'ntd', o); % linear, worse 22 | %o.khat='o'; o.fhat='f'; p.solvespectrum([30 31], 'ntd', o); % 2nd order, best 23 | 24 | % solve eigenvalues only 25 | %p.solvespectrum([30 31], 'ntd', struct('eps',0.1,'khat','o','fhat','s')); 26 | 27 | % solve with modes & show them 28 | p.solvespectrum([30 31], 'ntd', struct('eps',0.1,'khat','o','fhat','s','modes',1)); 29 | p.kj % eigenwavenumbers found 30 | p.showmodes; 31 | 32 | 33 | if 0 % try higher k range now, medium-scale calc...... 34 | s.requadrature(720); 35 | tic; p.solvespectrum([90 100], 'ntd', struct('eps',0.1,'khat','l')); toc; 36 | % 1271 sec for eigfreqs only (21 mins) 37 | % 12.25 sec per kstar eval, ie 2.5 sec per eigfreq found. 38 | % 1804 sec with eigfuncs (30 mins, ie 1.5 times longer). 39 | tic; p.solvespectrum([90 100], 'ntd', struct('eps',0.1,'khat','l','modes',1,'fhat','f')); toc; 40 | %save solvespec_90k100_khatl_fhatf.mat p 41 | end 42 | 43 | if 0 % timings of aspects and other methods at this medium k..... 44 | d.addlayerpot(s, 'd'); % basis for Dir 45 | tic; p.solvespectrum([90 90.1], 'fd'); toc; 46 | %ratio 5 evals per mode found 47 | % 428 sec for 90 to 91, so 4300 sec = 72 mins, just eigvals 48 | % 1.65 sec per fred det eval, 8.7 sec per eigval found. 49 | tic; p.solvespectrum([90 100], 'fd', struct('modes',1)); toc; 50 | % If want eigvecs and use dense svd, extra 15 sec per eigvec found. 51 | % If want eigvecs and use iter=1 w/ lu, only extra 1.8 sec per eigvec found. 52 | tic; ll = p.NtDspectrum(90, struct('quad','m')); toc % 12 sec 53 | % dominated by 8.5 sec for complex eig (vs 0.4 for complex det or lu). 54 | % 14.5 s if want eigvecs too. complex inv is only 1.2 sec, complex svd 3.1 sec 55 | % or more like 15 if want U and V. 56 | profile clear; profile on; ll = p.NtDspectrum(90, struct('quad','m')); profile off; profile viewer 57 | end 58 | --------------------------------------------------------------------------------