| [n,sx,ifmt,idigit]=svout(n,sx,ifmt,idigit); |
function [n,sx,ifmt,idigit]=svout(n,sx,ifmt,idigit);
persistent i j k1 k2 lout ndigit ;
if isempty(i), i=0; end;
if isempty(j), j=0; end;
if isempty(k1), k1=0; end;
if isempty(k2), k2=0; end;
if isempty(lout), lout=0; end;
if isempty(ndigit), ndigit=0; end;
%***BEGIN PROLOGUE SVOUT
%***SUBSIDIARY
%***PURPOSE Subsidiary to SPLP
%***LIBRARY SLATEC
%***TYPE SINGLE PRECISION (SVOUT-S, DVOUT-D)
%***AUTHOR (UNKNOWN)
%***DESCRIPTION
%
% SINGLE PRECISION VECTOR OUTPUT ROUTINE.
%
% INPUT..
%
% N,SX(*) PRINT THE SINGLE PRECISION ARRAY SX(I),I=1,...,N, ON
% OUTPUT UNIT LOUT. THE HEADING IN THE FORTRAN FORMAT
% STATEMENT IFMT(*), DESCRIBED BELOW, IS PRINTED AS A FIRST
% STEP. THE COMPONENTS SX(I) ARE INDEXED, ON OUTPUT,
% IN A PLEASANT FORMAT.
% IFMT(*) A FORTRAN FORMAT STATEMENT. THIS IS PRINTED ON OUTPUT
% UNIT LOUT WITH THE VARIABLE FORMAT FORTRAN STATEMENT
% WRITE(LOUT,IFMT)
% IDIGIT PRINT AT LEAST ABS(IDIGIT) DECIMAL DIGITS PER NUMBER.
% THE SUBPROGRAM WILL CHOOSE THAT INTEGER 4,6,10 OR 14
% WHICH WILL PRINT AT LEAST ABS(IDIGIT) NUMBER OF
% PLACES. IF IDIGIT.LT.0, 72 PRINTING COLUMNS ARE UTILIZED
% TO WRITE EACH LINE OF OUTPUT OF THE ARRAY SX(*). (THIS
% CAN BE USED ON MOST TIME-SHARING TERMINALS). IF
% IDIGIT.GE.0, 133 PRINTING COLUMNS ARE UTILIZED. (THIS CAN
% BE USED ON MOST LINE PRINTERS).
%
% EXAMPLE..
%
% PRINT AN ARRAY CALLED (COSTS OF PURCHASES) OF LENGTH 100 SHOWING
% 6 DECIMAL DIGITS PER NUMBER. THE USER IS RUNNING ON A TIME-SHARING
% SYSTEM WITH A 72 COLUMN OUTPUT DEVICE.
%
% DIMENSION COSTS(100)
% N = 100
% IDIGIT = -6
% CALL SVOUT(N,COSTS,'(''1COSTS OF PURCHASES'')',IDIGIT)
%
%***SEE ALSO SPLP
%***ROUTINES CALLED I1MACH
%***REVISION HISTORY (YYMMDD)
% 811215 DATE WRITTEN
% 890531 Changed all specific intrinsics to generic. (WRB)
% 891107 Added comma after 1P edit descriptor in FORMAT
% statements. (WRB)
% 891214 Prologue converted to Version 4.0 format. (BAB)
% 900328 Added TYPE section. (WRB)
%***end PROLOGUE SVOUT
sx_shape=size(sx);sx=reshape(sx,1,[]);
%
% GET THE UNIT NUMBER WHERE OUTPUT WILL BE WRITTEN.
%***FIRST EXECUTABLE STATEMENT SVOUT
j = 2;
[lout ,j]=i1mach(j);
disp({});
if( n<=0 )
sx_shape=zeros(sx_shape);sx_shape(:)=sx(1:numel(sx_shape));sx=sx_shape;
return;
end;
ndigit = fix(idigit);
if( idigit==0 )
ndigit = 4;
end;
if( idigit<0 )
%
ndigit = fix(-idigit);
if( ndigit<=4 )
%
for k1 = 1 : 5: n ;
k2 = fix(min(n,k1+4));
for i=(k1):(k2), writef(lout,[repmat(' ',1,1),'%4i',' - ','%4i',repmat('%f',1,1),repmat('%12.3f',1,10) ' \n'], k1 , k2 ,sx(i)); end;
end; k1 = fix(n +1);
sx_shape=zeros(sx_shape);sx_shape(:)=sx(1:numel(sx_shape));sx=sx_shape;
return;
%
elseif( ndigit<=6 ) ;
%
for k1 = 1 : 4: n ;
k2 = fix(min(n,k1+3));
for i=(k1):(k2), writef(lout,[repmat(' ',1,1),'%4i',' - ','%4i',repmat(' ',1,1),repmat('%f',1,1),repmat('%14.5f',1,8) ' \n'], k1 , k2 ,sx(i)); end;
end; k1 = fix(n +1);
sx_shape=zeros(sx_shape);sx_shape(:)=sx(1:numel(sx_shape));sx=sx_shape;
return;
%
elseif( ndigit>10 ) ;
%
for k1 = 1 : 2: n ;
k2 = fix(min(n,k1+1));
for i=(k1):(k2), writef(lout,[repmat(' ',1,1),'%4i',' - ','%4i',repmat(' ',1,1),repmat('%f',1,1),repmat('%24.13f',1,5) ' \n'], k1 , k2 ,sx(i)); end;
end; k1 = fix(n +1);
sx_shape=zeros(sx_shape);sx_shape(:)=sx(1:numel(sx_shape));sx=sx_shape;
return;
else;
%
for k1 = 1 : 3: n ;
k2 = fix(min(n,k1+2));
for i=(k1):(k2), writef(lout,[repmat(' ',1,1),'%4i',' - ','%4i',repmat(' ',1,1),repmat('%f',1,1),repmat('%18.9f',1,6) ' \n'], k1 , k2 ,sx(i)); end;
end; k1 = fix(n +1);
sx_shape=zeros(sx_shape);sx_shape(:)=sx(1:numel(sx_shape));sx=sx_shape;
return;
end;
%
elseif( ndigit<=4 ) ;
%
for k1 = 1 : 10: n ;
k2 = fix(min(n,k1+9));
for i=(k1):(k2), writef(lout,[repmat(' ',1,1),'%4i',' - ','%4i',repmat('%f',1,1),repmat('%12.3f',1,10) ' \n'], k1 , k2 ,sx(i)); end;
end; k1 = fix(n +1);
sx_shape=zeros(sx_shape);sx_shape(:)=sx(1:numel(sx_shape));sx=sx_shape;
return;
%
elseif( ndigit<=6 ) ;
%
for k1 = 1 : 8: n ;
k2 = fix(min(n,k1+7));
for i=(k1):(k2), writef(lout,[repmat(' ',1,1),'%4i',' - ','%4i',repmat(' ',1,1),repmat('%f',1,1),repmat('%14.5f',1,8) ' \n'], k1 , k2 ,sx(i)); end;
end; k1 = fix(n +1);
sx_shape=zeros(sx_shape);sx_shape(:)=sx(1:numel(sx_shape));sx=sx_shape;
return;
%
elseif( ndigit>10 ) ;
%
for k1 = 1 : 5: n ;
k2 = fix(min(n,k1+4));
for i=(k1):(k2), writef(lout,[repmat(' ',1,1),'%4i',' - ','%4i',repmat(' ',1,1),repmat('%f',1,1),repmat('%24.13f',1,5) ' \n'], k1 , k2 ,sx(i)); end;
end; k1 = fix(n +1);
sx_shape=zeros(sx_shape);sx_shape(:)=sx(1:numel(sx_shape));sx=sx_shape;
return;
else;
%
for k1 = 1 : 6: n ;
k2 = fix(min(n,k1+5));
for i=(k1):(k2), writef(lout,[repmat(' ',1,1),'%4i',' - ','%4i',repmat(' ',1,1),repmat('%f',1,1),repmat('%18.9f',1,6) ' \n'], k1 , k2 ,sx(i)); end;
end; k1 = fix(n +1);
sx_shape=zeros(sx_shape);sx_shape(:)=sx(1:numel(sx_shape));sx=sx_shape;
return;
end;
%format (1X,i4,' - ',i4,1P,10E12.3);
%format (1X,i4,' - ',i4,1X,1P,8E14.5);
%format (1X,i4,' - ',i4,1X,1P,6E18.9);
%format (1X,i4,' - ',i4,1X,1P,5E24.13);
sx_shape=zeros(sx_shape);sx_shape(:)=sx(1:numel(sx_shape));sx=sx_shape;
end
%DECK SWRITP
|
|