Code covered by the BSD License  

Highlights from
slatec

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

[u,v,yhp,inout,stowa]=stway(u,v,yhp,inout,stowa);
function [u,v,yhp,inout,stowa]=stway(u,v,yhp,inout,stowa);
persistent j k ko ks ksj ; 

global ml18jr_1; if isempty(ml18jr_1), ml18jr_1=0; end;
global ml8sz_1; if isempty(ml8sz_1), ml8sz_1=0; end;
global ml15to_2; if isempty(ml15to_2), ml15to_2=0; end;
global ml15to_1; if isempty(ml15to_1), ml15to_1=0; end;
global ml18jr_2; if isempty(ml18jr_2), ml18jr_2=0; end;
global ml15to_3; if isempty(ml15to_3), ml15to_3=0; end;
global ml18jr_3; if isempty(ml18jr_3), ml18jr_3=0; end;
global ml15to_4; if isempty(ml15to_4), ml15to_4=0; end;
global ml15to_5; if isempty(ml15to_5), ml15to_5=0; end;
global ml15to_6; if isempty(ml15to_6), ml15to_6=0; end;
global ml15to_8; if isempty(ml15to_8), ml15to_8=0; end;
global ml15to_7; if isempty(ml15to_7), ml15to_7=0; end;
global ml8sz_2; if isempty(ml8sz_2), ml8sz_2=0; end;
global ml18jr_18; if isempty(ml18jr_18), ml18jr_18=0; end;
global ml8sz_3; if isempty(ml8sz_3), ml8sz_3=0; end;
global ml18jr_11; if isempty(ml18jr_11), ml18jr_11=0; end;
global ml15to_9; if isempty(ml15to_9), ml15to_9=zeros(1,15); end;
global ml8sz_4; if isempty(ml8sz_4), ml8sz_4=0; end;
global ml18jr_12; if isempty(ml18jr_12), ml18jr_12=0; end;
global ml15to_10; if isempty(ml15to_10), ml15to_10=0; end;
global ml8sz_5; if isempty(ml8sz_5), ml8sz_5=0; end;
if isempty(j), j=0; end;
if isempty(k), k=0; end;
global ml15to_11; if isempty(ml15to_11), ml15to_11=0; end;
if isempty(ko), ko=0; end;
global ml15to_12; if isempty(ml15to_12), ml15to_12=0; end;
if isempty(ks), ks=0; end;
if isempty(ksj), ksj=0; end;
global ml15to_13; if isempty(ml15to_13), ml15to_13=0; end;
global ml15to_14; if isempty(ml15to_14), ml15to_14=0; end;
global ml18jr_7; if isempty(ml18jr_7), ml18jr_7=0; end;
global ml8sz_6; if isempty(ml8sz_6), ml8sz_6=0; end;
global ml18jr_8; if isempty(ml18jr_8), ml18jr_8=0; end;
global ml18jr_10; if isempty(ml18jr_10), ml18jr_10=0; end;
global ml18jr_15; if isempty(ml18jr_15), ml18jr_15=0; end;
global ml8sz_7; if isempty(ml8sz_7), ml8sz_7=0; end;
global ml18jr_17; if isempty(ml18jr_17), ml18jr_17=0; end;
global ml18jr_5; if isempty(ml18jr_5), ml18jr_5=0; end;
global ml18jr_6; if isempty(ml18jr_6), ml18jr_6=0; end;
global ml18jr_13; if isempty(ml18jr_13), ml18jr_13=0; end;
global ml15to_15; if isempty(ml15to_15), ml15to_15=0; end;
global ml18jr_9; if isempty(ml18jr_9), ml18jr_9=0; end;
global ml18jr_14; if isempty(ml18jr_14), ml18jr_14=0; end;
global ml18jr_16; if isempty(ml18jr_16), ml18jr_16=0; end;
global ml18jr_4; if isempty(ml18jr_4), ml18jr_4=0; end;
%***BEGIN PROLOGUE  STWAY
%***SUBSIDIARY
%***PURPOSE  Subsidiary to BVSUP
%***LIBRARY   SLATEC
%***TYPE      SINGLE PRECISION (STWAY-S, DSTWAY-D)
%***AUTHOR  Watts, H. A., (SNLA)
%***DESCRIPTION
%
%  This subroutine stores (recalls) integration data in the event
%  that a restart is needed (the homogeneous solution vectors become
%  too dependent to continue)
%
%***SEE ALSO  BVSUP
%***ROUTINES CALLED  STOR1
%***COMMON BLOCKS    ML15TO, ML18JR, ML8SZ
%***REVISION HISTORY  (YYMMDD)
%   750601  DATE WRITTEN
%   890921  Realigned order of variables in certain COMMON blocks.
%           (WRB)
%   891214  Prologue converted to Version 4.0 format.  (BAB)
%   900328  Added TYPE section.  (WRB)
%   910722  Updated AUTHOR section.  (ALS)
%***end PROLOGUE  STWAY
%
u_shape=size(u);u=reshape(u,1,[]);
v_shape=size(v);v=reshape(v,1,[]);
yhp_shape=size(yhp);yhp=reshape(yhp,1,[]);
stowa_shape=size(stowa);stowa=reshape(stowa,1,[]);
%
% common :: ;
%% common /ml8sz / c , xsav , igofx , inhomo , ivp , ncomp , nfc;
%% common /ml8sz / ml8sz_1 , ml8sz_2 , ml8sz_3 , ml8sz_4 , ml8sz_5 , ml8sz_6 , ml8sz_7;
% common :: ;
%% common /ml15to/ px , pwcnd , tnd , x , xbeg , xend , xot , xop ,info(15) , istkop , knswot , kop , lotjp ,mnswot , nswot;
%% common /ml15to/ ml15to_1 , ml15to_2 , ml15to_3 , ml15to_4 , ml15to_5 , ml15to_6 , ml15to_7 , ml15to_8 ,ml15to_9(15) , ml15to_10 , ml15to_11 , ml15to_12 , ml15to_13 ,ml15to_14 , ml15to_15;
% common :: ;
%% common /ml18jr/ ae , re , tol , nxpts , nic , nopg , mxnon ,ndisk , ntape , neq , indpvt , integ , nps , ntp ,neqivp , numort , nfcc , icoco;
%% common /ml18jr/ ml18jr_1 , ml18jr_2 , ml18jr_3 , ml18jr_4 , ml18jr_5 , ml18jr_6 , ml18jr_7 ,ml18jr_8 , ml18jr_9 , ml18jr_10 , ml18jr_11 , ml18jr_12 , ml18jr_13 , ml18jr_14 ,ml18jr_15 , ml18jr_16 , ml18jr_17 , ml18jr_18;
%
%***FIRST EXECUTABLE STATEMENT  STWAY
if( inout==1 )
%
%     RECALL FROM STOWA ARRAY AND ISTKOP
%
ks = fix(ml8sz_7.*ml8sz_6);
[yhp,stowa,dumvar3,dumvar4]=stor1(yhp,stowa,yhp(sub2ind(size(yhp),max(ks+1,1)):end),stowa(sub2ind(size(stowa),max(ks+1,1)):end),1,0,0);   dumvar3i=find((yhp(sub2ind(size(yhp),max(ks+1,1)):end))~=(dumvar3));dumvar4i=find((stowa(sub2ind(size(stowa),max(ks+1,1)):end))~=(dumvar4));   yhp(ks+1-1+dumvar3i)=dumvar3(dumvar3i); stowa(ks+1-1+dumvar4i)=dumvar4(dumvar4i); 
ks = fix(ks + ml8sz_6);
if( ml18jr_15~=0 )
for j = 1 : ml18jr_15;
ksj = fix(ks + j);
yhp(ksj) = stowa(ksj);
end; j = fix(ml18jr_15+1);
end;
ks = fix(ks + ml18jr_15);
ml15to_4 = stowa(ks+1);
ml15to_9(1) = 0;
ko = fix(ml15to_12 - ml15to_10);
ml15to_12 = fix(ml15to_10);
if( ml18jr_8==0 || ko==0 )
u_shape=zeros(u_shape);u_shape(:)=u(1:numel(u_shape));u=u_shape;
v_shape=zeros(v_shape);v_shape(:)=v(1:numel(v_shape));v=v_shape;
yhp_shape=zeros(yhp_shape);yhp_shape(:)=yhp(1:numel(yhp_shape));yhp=yhp_shape;
stowa_shape=zeros(stowa_shape);stowa_shape(:)=stowa(1:numel(stowa_shape));stowa=stowa_shape;
return;
end;
for k = 1 : ko;
backspace ml18jr_9;
end; k = fix(ko+1);
else;
%
%     SAVE IN STOWA ARRAY AND ISTKOP
%
ks = fix(ml8sz_7.*ml8sz_6);
[stowa,u,dumvar3,v]=stor1(stowa,u,stowa(sub2ind(size(stowa),max(ks+1,1)):end),v,1,0,0);   dumvar3i=find((stowa(sub2ind(size(stowa),max(ks+1,1)):end))~=(dumvar3));   stowa(ks+1-1+dumvar3i)=dumvar3(dumvar3i); 
ks = fix(ks + ml8sz_6);
if( ml18jr_15~=0 )
for j = 1 : ml18jr_15;
ksj = fix(ks + j);
stowa(ksj) = yhp(ksj);
end; j = fix(ml18jr_15+1);
end;
ks = fix(ks + ml18jr_15);
stowa(ks+1) = ml15to_4;
ml15to_10 = fix(ml15to_12);
if( ml15to_8==ml15to_4 )
ml15to_10 = fix(ml15to_12 + 1);
end;
u_shape=zeros(u_shape);u_shape(:)=u(1:numel(u_shape));u=u_shape;
v_shape=zeros(v_shape);v_shape(:)=v(1:numel(v_shape));v=v_shape;
yhp_shape=zeros(yhp_shape);yhp_shape(:)=yhp(1:numel(yhp_shape));yhp=yhp_shape;
stowa_shape=zeros(stowa_shape);stowa_shape(:)=stowa(1:numel(stowa_shape));stowa=stowa_shape;
return;
end;
u_shape=zeros(u_shape);u_shape(:)=u(1:numel(u_shape));u=u_shape;
v_shape=zeros(v_shape);v_shape(:)=v(1:numel(v_shape));v=v_shape;
yhp_shape=zeros(yhp_shape);yhp_shape(:)=yhp(1:numel(yhp_shape));yhp=yhp_shape;
stowa_shape=zeros(stowa_shape);stowa_shape(:)=stowa(1:numel(stowa_shape));stowa=stowa_shape;
end
%DECK SUDS

Contact us at files@mathworks.com