Code covered by the BSD License  

Highlights from
slatec

from slatec by Ben Barrowes
The slatec library converted into matlab functions.

[cofx,cofy,idmn,usol,grhs]=defer(cofx,cofy,idmn,usol,grhs);
function [cofx,cofy,idmn,usol,grhs]=defer(cofx,cofy,idmn,usol,grhs);
persistent ai bi ci dj ej fj i j tx ty uxxx uxxxx uyyy uyyyy xi yj ; 

if isempty(ai), ai=0; end;
global splpcm_5; if isempty(splpcm_5), splpcm_5=0; end;
if isempty(bi), bi=0; end;
global splpcm_6; if isempty(splpcm_6), splpcm_6=0; end;
if isempty(ci), ci=0; end;
global splpcm_7; if isempty(splpcm_7), splpcm_7=0; end;
global splpcm_8; if isempty(splpcm_8), splpcm_8=0; end;
if isempty(dj), dj=0; end;
global splpcm_15; if isempty(splpcm_15), splpcm_15=0; end;
global splpcm_19; if isempty(splpcm_19), splpcm_19=0; end;
global splpcm_16; if isempty(splpcm_16), splpcm_16=0; end;
global splpcm_20; if isempty(splpcm_20), splpcm_20=0; end;
if isempty(ej), ej=0; end;
if isempty(fj), fj=0; end;
global splpcm_17; if isempty(splpcm_17), splpcm_17=0; end;
global splpcm_18; if isempty(splpcm_18), splpcm_18=0; end;
if isempty(tx), tx=0; end;
if isempty(ty), ty=0; end;
if isempty(uxxx), uxxx=0; end;
if isempty(uxxxx), uxxxx=0; end;
if isempty(uyyy), uyyy=0; end;
if isempty(uyyyy), uyyyy=0; end;
if isempty(xi), xi=0; end;
if isempty(yj), yj=0; end;
if isempty(i), i=0; end;
global splpcm_11; if isempty(splpcm_11), splpcm_11=0; end;
if isempty(j), j=0; end;
global splpcm_13; if isempty(splpcm_13), splpcm_13=0; end;
global splpcm_3; if isempty(splpcm_3), splpcm_3=0; end;
global splpcm_1; if isempty(splpcm_1), splpcm_1=0; end;
global splpcm_2; if isempty(splpcm_2), splpcm_2=0; end;
global splpcm_4; if isempty(splpcm_4), splpcm_4=0; end;
global splpcm_9; if isempty(splpcm_9), splpcm_9=0; end;
global splpcm_12; if isempty(splpcm_12), splpcm_12=0; end;
global splpcm_10; if isempty(splpcm_10), splpcm_10=0; end;
global splpcm_14; if isempty(splpcm_14), splpcm_14=0; end;
%***BEGIN PROLOGUE  DEFER
%***SUBSIDIARY
%***PURPOSE  Subsidiary to SEPELI
%***LIBRARY   SLATEC
%***TYPE      SINGLE PRECISION (DEFER-S)
%***AUTHOR  (UNKNOWN)
%***DESCRIPTION
%
%     This subroutine first approximates the truncation error given by
%     TRUN1(X,Y)=DLX**2*TX+DLY**2*TY where
%     TX=AFUN(X)*UXXXX/12.0+BFUN(X)*UXXX/6.0 on the interior and
%     at the boundaries if periodic (here UXXX,UXXXX are the third
%     and fourth partial derivatives of U with respect to X).
%     TX splpcm_11 of the form AFUN(X)/3.0*(UXXXX/4.0+UXXX/DLX)
%     at X=A or X=B if the boundary condition there splpcm_11 mixed.
%     TX=0.0 along specified boundaries.  TY has symmetric form
%     in Y with X,AFUN(X),BFUN(X) replaced by Y,DFUN(Y),EFUN(Y).
%     The second order solution in USOL splpcm_11 used to approximate
%     (via second order finite differencing) the truncation error
%     and the result splpcm_11 added to the right hand side in GRHS
%     and then transferred to USOL to be used as a new right
%     hand side when calling BLKTRI for a fourth order solution.
%
%***SEE ALSO  SEPELI
%***ROUTINES CALLED  DX, DY
%***COMMON BLOCKS    SPLPCM
%***REVISION HISTORY  (YYMMDD)
%   801001  DATE WRITTEN
%   890531  Changed all specific intrinsics to generic.  (WRB)
%   891214  Prologue converted to Version 4.0 format.  (BAB)
%   900402  Added TYPE section.  (WRB)
%***end PROLOGUE  DEFER
%
% common :: ;
%% common /splpcm/ kswx , kswy , k , l , ait , bit , cit , dit ,mit , nit , is , ms , js , ns , dlx , dly ,tdlx3 , tdly3 , dlx4 , dly4;
%% common /splpcm/ splpcm_1 , splpcm_2 , splpcm_3 , splpcm_4 , splpcm_5 , splpcm_6 , splpcm_7 , splpcm_8 ,splpcm_9 , splpcm_10 , splpcm_11 , splpcm_12 , splpcm_13 , splpcm_14 , splpcm_15 , splpcm_16 ,splpcm_17 , splpcm_18 , splpcm_19 , splpcm_20;
grhs_shape=size(grhs);grhs=reshape([grhs(:).',zeros(1,ceil(numel(grhs)./prod([idmn])).*prod([idmn])-numel(grhs))],idmn,[]);
usol_shape=size(usol);usol=reshape([usol(:).',zeros(1,ceil(numel(usol)./prod([idmn])).*prod([idmn])-numel(usol))],idmn,[]);
%***FIRST EXECUTABLE STATEMENT  DEFER
for j = splpcm_13 : splpcm_14;
yj = splpcm_7 +(j-1).*splpcm_16;
[yj,dj,ej,fj]=cofy(yj,dj,ej,fj);
for i = splpcm_11 : splpcm_12;
xi = splpcm_5 +(i-1).*splpcm_15;
[xi,ai,bi,ci]=cofx(xi,ai,bi,ci);
%
%     COMPUTE PARTIAL DERIVATIVE APPROXIMATIONS AT (XI,YJ)
%
[usol,idmn,i,j,uxxx,uxxxx]=dx(usol,idmn,i,j,uxxx,uxxxx);
[usol,idmn,i,j,uyyy,uyyyy]=dy(usol,idmn,i,j,uyyy,uyyyy);
tx = ai.*uxxxx./12.0 + bi.*uxxx./6.0;
ty = dj.*uyyyy./12.0 + ej.*uyyy./6.0;
%
%     RESET FORM OF TRUNCATION IF AT BOUNDARY WHICH IS NON-PERIODIC
%
if( ~(splpcm_1==1 ||(i>1 && i<splpcm_3)) )
tx = ai./3.0.*(uxxxx./4.0+uxxx./splpcm_15);
end;
if( ~(splpcm_2==1 ||(j>1 && j<splpcm_4)) )
ty = dj./3.0.*(uyyyy./4.0+uyyy./splpcm_16);
end;
grhs(i,j) = grhs(i,j) + splpcm_15.^2.*tx + splpcm_16.^2.*ty;
end; i = fix(splpcm_12+1);
end; j = fix(splpcm_14+1);
%
%     RESET THE RIGHT HAND SIDE IN USOL
%
for i = splpcm_11 : splpcm_12;
for j = splpcm_13 : splpcm_14;
usol(i,j) = grhs(i,j);
end; j = fix(splpcm_14+1);
end; i = fix(splpcm_12+1);
grhs_shape=zeros(grhs_shape);grhs_shape(:)=grhs(1:numel(grhs_shape));grhs=grhs_shape;
usol_shape=zeros(usol_shape);usol_shape(:)=usol(1:numel(usol_shape));usol=usol_shape;
end
%DECK DEI

Contact us