| [u,v,yhp,inout,stowa]=dstway(u,v,yhp,inout,stowa); |
function [u,v,yhp,inout,stowa]=dstway(u,v,yhp,inout,stowa);
%***BEGIN PROLOGUE DSTWAY
%***SUBSIDIARY
%***PURPOSE Subsidiary to DBVSUP
%***LIBRARY SLATEC
%***TYPE doubleprecision (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 DBVSUP
%***ROUTINES CALLED DSTOR1
%***COMMON BLOCKS DML15T, DML18J, DML8SZ
%***REVISION HISTORY (YYMMDD)
% 750601 DATE WRITTEN
% 890831 Modified array declarations. (WRB)
% 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 DSTWAY
%
persistent j k ko ks ksj ;
global dml18j_18; if isempty(dml18j_18), dml18j_18=0; end;
global dml8sz_3; if isempty(dml8sz_3), dml8sz_3=0; end;
global dml18j_11; if isempty(dml18j_11), dml18j_11=0; end;
global dml15t_9; if isempty(dml15t_9), dml15t_9=zeros(1,15); end;
global dml8sz_4; if isempty(dml8sz_4), dml8sz_4=0; end;
global dml18j_12; if isempty(dml18j_12), dml18j_12=0; end;
global dml15t_10; if isempty(dml15t_10), dml15t_10=0; end;
global dml8sz_5; if isempty(dml8sz_5), dml8sz_5=0; end;
if isempty(j), j=0; end;
if isempty(k), k=0; end;
global dml15t_11; if isempty(dml15t_11), dml15t_11=0; end;
if isempty(ko), ko=0; end;
global dml15t_12; if isempty(dml15t_12), dml15t_12=0; end;
if isempty(ks), ks=0; end;
if isempty(ksj), ksj=0; end;
global dml15t_13; if isempty(dml15t_13), dml15t_13=0; end;
global dml15t_14; if isempty(dml15t_14), dml15t_14=0; end;
global dml18j_7; if isempty(dml18j_7), dml18j_7=0; end;
global dml8sz_6; if isempty(dml8sz_6), dml8sz_6=0; end;
global dml18j_8; if isempty(dml18j_8), dml18j_8=0; end;
global dml18j_10; if isempty(dml18j_10), dml18j_10=0; end;
global dml18j_15; if isempty(dml18j_15), dml18j_15=0; end;
global dml8sz_7; if isempty(dml8sz_7), dml8sz_7=0; end;
global dml18j_17; if isempty(dml18j_17), dml18j_17=0; end;
global dml18j_5; if isempty(dml18j_5), dml18j_5=0; end;
global dml18j_6; if isempty(dml18j_6), dml18j_6=0; end;
global dml18j_13; if isempty(dml18j_13), dml18j_13=0; end;
global dml15t_15; if isempty(dml15t_15), dml15t_15=0; end;
global dml18j_9; if isempty(dml18j_9), dml18j_9=0; end;
global dml18j_14; if isempty(dml18j_14), dml18j_14=0; end;
global dml18j_16; if isempty(dml18j_16), dml18j_16=0; end;
global dml18j_4; if isempty(dml18j_4), dml18j_4=0; end;
global dml18j_1; if isempty(dml18j_1), dml18j_1=0; end;
global dml8sz_1; if isempty(dml8sz_1), dml8sz_1=0; end;
global dml15t_2; if isempty(dml15t_2), dml15t_2=0; end;
global dml15t_1; if isempty(dml15t_1), dml15t_1=0; end;
global dml18j_2; if isempty(dml18j_2), dml18j_2=0; end;
stowa_shape=size(stowa);stowa=reshape(stowa,1,[]);
global dml15t_3; if isempty(dml15t_3), dml15t_3=0; end;
global dml18j_3; if isempty(dml18j_3), dml18j_3=0; end;
u_shape=size(u);u=reshape(u,1,[]);
v_shape=size(v);v=reshape(v,1,[]);
global dml15t_4; if isempty(dml15t_4), dml15t_4=0; end;
global dml15t_5; if isempty(dml15t_5), dml15t_5=0; end;
global dml15t_6; if isempty(dml15t_6), dml15t_6=0; end;
global dml15t_8; if isempty(dml15t_8), dml15t_8=0; end;
global dml15t_7; if isempty(dml15t_7), dml15t_7=0; end;
global dml8sz_2; if isempty(dml8sz_2), dml8sz_2=0; end;
yhp_shape=size(yhp);yhp=reshape(yhp,1,[]);
%
% common :: ;
%% common /dml8sz/ c , xsav , igofx , inhomo , ivp , ncomp , nfc;
%% common /dml8sz/ dml8sz_1 , dml8sz_2 , dml8sz_3 , dml8sz_4 , dml8sz_5 , dml8sz_6 , dml8sz_7;
% common :: ;
%% common /dml15t/ px , pwcnd , tnd , x , xbeg , xend , xot , xop ,info(15) , istkop , knswot , kop , lotjp ,mnswot , nswot;
%% common /dml15t/ dml15t_1 , dml15t_2 , dml15t_3 , dml15t_4 , dml15t_5 , dml15t_6 , dml15t_7 , dml15t_8 ,dml15t_9(15) , dml15t_10 , dml15t_11 , dml15t_12 , dml15t_13 ,dml15t_14 , dml15t_15;
% common :: ;
%% common /dml18j/ ae , re , tol , nxpts , nic , nopg , mxnon ,ndisk , ntape , neq , indpvt , integ , nps , ntp ,neqivp , numort , nfcc , icoco;
%% common /dml18j/ dml18j_1 , dml18j_2 , dml18j_3 , dml18j_4 , dml18j_5 , dml18j_6 , dml18j_7 ,dml18j_8 , dml18j_9 , dml18j_10 , dml18j_11 , dml18j_12 , dml18j_13 , dml18j_14 ,dml18j_15 , dml18j_16 , dml18j_17 , dml18j_18;
%
%***FIRST EXECUTABLE STATEMENT DSTWAY
if( inout==1 )
%
% RECALL FROM STOWA ARRAY AND ISTKOP
%
ks = fix(dml8sz_7.*dml8sz_6);
[yhp,stowa,dumvar3,dumvar4]=dstor1(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 + dml8sz_6);
if( dml18j_15>=1 )
for j = 1 : dml18j_15;
ksj = fix(ks + j);
yhp(ksj) = stowa(ksj);
end; j = fix(dml18j_15+1);
end;
ks = fix(ks + dml18j_15);
dml15t_4 = stowa(ks+1);
dml15t_9(1) = 0;
ko = fix(dml15t_12 - dml15t_10);
dml15t_12 = fix(dml15t_10);
if( dml18j_8~=0 && ko~=0 )
for k = 1 : ko;
backspace dml18j_9;
end; k = fix(ko+1);
end;
else;
%
% SAVE IN STOWA ARRAY AND ISTKOP
%
ks = fix(dml8sz_7.*dml8sz_6);
[stowa,u,dumvar3,v]=dstor1(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 + dml8sz_6);
if( dml18j_15>=1 )
for j = 1 : dml18j_15;
ksj = fix(ks + j);
stowa(ksj) = yhp(ksj);
end; j = fix(dml18j_15+1);
end;
ks = fix(ks + dml18j_15);
stowa(ks+1) = dml15t_4;
dml15t_10 = fix(dml15t_12);
if( dml15t_8==dml15t_4 )
dml15t_10 = fix(dml15t_12 + 1);
end;
end;
stowa_shape=zeros(stowa_shape);stowa_shape(:)=stowa(1:numel(stowa_shape));stowa=stowa_shape;
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;
end
%DECK DSUDS
|
|