| [ncomp,lnfc,yhp,work,iwork,inhomo,iflag]=dvecs(ncomp,lnfc,yhp,work,iwork,inhomo,iflag); |
function [ncomp,lnfc,yhp,work,iwork,inhomo,iflag]=dvecs(ncomp,lnfc,yhp,work,iwork,inhomo,iflag);
%***BEGIN PROLOGUE DVECS
%***SUBSIDIARY
%***PURPOSE Subsidiary to DBVSUP
%***LIBRARY SLATEC
%***TYPE doubleprecision (SVECS-S, DVECS-D)
%***AUTHOR Watts, H. A., (SNLA)
%***DESCRIPTION
%
% This subroutine is used for the special structure of COMPLEX*16
% valued problems. DMGSBV is called upon to obtain LNFC vectors from an
% original set of 2*LNFC independent vectors so that the resulting
% LNFC vectors together with their imaginary product or mate vectors
% form an independent set.
%
%***SEE ALSO DBVSUP
%***ROUTINES CALLED DMGSBV
%***COMMON BLOCKS DML18J
%***REVISION HISTORY (YYMMDD)
% 750601 DATE WRITTEN
% 890831 Modified array declarations. (WRB)
% 890921 Realigned order of variables in certain COMMON blocks.
% (WRB)
% 891009 Removed unreferenced statement label. (WRB)
% 891214 Prologue converted to Version 4.0 format. (BAB)
% 900328 Added TYPE section. (WRB)
% 910722 Updated AUTHOR section. (ALS)
%***end PROLOGUE DVECS
%
persistent dum idp k kp niv ;
global dml18j_18; if isempty(dml18j_18), dml18j_18=0; end;
if isempty(idp), idp=0; end;
global dml18j_11; if isempty(dml18j_11), dml18j_11=0; end;
global dml18j_12; if isempty(dml18j_12), dml18j_12=0; end;
iwork_shape=size(iwork);iwork=reshape(iwork,1,[]);
if isempty(k), k=0; end;
if isempty(kp), kp=0; end;
global dml18j_17; if isempty(dml18j_17), dml18j_17=0; end;
global dml18j_7; if isempty(dml18j_7), dml18j_7=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 dml18j_5; if isempty(dml18j_5), dml18j_5=0; end;
if isempty(niv), niv=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 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;
if isempty(dum), dum=0; end;
global dml18j_2; if isempty(dml18j_2), dml18j_2=0; end;
global dml18j_3; if isempty(dml18j_3), dml18j_3=0; end;
work_shape=size(work);work=reshape(work,1,[]);
yhp_shape=size(yhp);yhp=reshape([yhp(:).',zeros(1,ceil(numel(yhp)./prod([ncomp])).*prod([ncomp])-numel(yhp))],ncomp,[]);
% common :: ;
%% common /dml18j/ ae , re , tol , nxpts , nic , nopg , mxnon ,ndisk , ntape , neq , indpvt , integ , nps , ntp ,neqivp , numort , lnfcc , 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 DVECS
if( lnfc~=1 )
niv = fix(lnfc);
lnfc = fix(2.*lnfc);
dml18j_17 = fix(2.*dml18j_17);
kp = fix(lnfc + 2 + dml18j_17);
idp = fix(dml18j_11);
dml18j_11 = 0;
ncomp_orig=ncomp; [ncomp,lnfc,yhp,dumvar4,niv,iflag,dumvar7,dumvar8,idumvar7,inhomo,dumvar11,dumvar12,dum]=dmgsbv(ncomp,lnfc,yhp,ncomp,niv,iflag,work(sub2ind(size(work),max(1,1)):end),work(sub2ind(size(work),max(kp,1)):end),iwork(sub2ind(size(work),max(1,1)):end),inhomo,yhp(sub2ind(size(yhp),1,lnfc+1):end),work(sub2ind(size(work),max(lnfc+2,1)):end),dum); ncomp(dumvar4~=ncomp_orig)=dumvar4(dumvar4~=ncomp_orig); dumvar7i=find((work(sub2ind(size(work),max(1,1)):end))~=(dumvar7));dumvar8i=find((work(sub2ind(size(work),max(kp,1)):end))~=(dumvar8));dumvar12i=find((work(sub2ind(size(work),max(lnfc+2,1)):end))~=(dumvar12)); work(1-1+dumvar7i)=dumvar7(dumvar7i); work(kp-1+dumvar8i)=dumvar8(dumvar8i); yhp(sub2ind(size(yhp),1,lnfc+1):end)=dumvar11; work(lnfc+2-1+dumvar12i)=dumvar12(dumvar12i);
lnfc = fix(fix(lnfc./2));
dml18j_17 = fix(fix(dml18j_17./2));
dml18j_11 = fix(idp);
if( iflag~=0 || niv~=lnfc )
iflag = 99;
else;
for k = 1 : ncomp;
yhp(k,lnfc+1) = yhp(k,dml18j_17+1);
end; k = fix(ncomp+1);
iflag = 1;
end;
else;
for k = 1 : ncomp;
yhp(k,lnfc+1) = yhp(k,dml18j_17+1);
end; k = fix(ncomp+1);
iflag = 1;
end;
iwork_shape=zeros(iwork_shape);iwork_shape(:)=iwork(1:numel(iwork_shape));iwork=iwork_shape;
work_shape=zeros(work_shape);work_shape(:)=work(1:numel(work_shape));work=work_shape;
yhp_shape=zeros(yhp_shape);yhp_shape(:)=yhp(1:numel(yhp_shape));yhp=yhp_shape;
end
%DECK DVNRMS
|
|