[n,dx,ifmt,idigit]=dvout(n,dx,ifmt,idigit);

function [n,dx,ifmt,idigit]=dvout(n,dx,ifmt,idigit);
%***BEGIN PROLOGUE  DVOUT
%***SUBSIDIARY
%***PURPOSE  Subsidiary to DSPLP
%***LIBRARY   SLATEC
%***TYPE      doubleprecision (SVOUT-S, DVOUT-D)
%***AUTHOR  Hanson, R. J., (SNLA)
%           Wisniewski, J. A., (SNLA)
%***DESCRIPTION
%
%     doubleprecision VECTOR OUTPUT ROUTINE.
%
%  INPUT..
%
%  N,DX(*) PRINT THE doubleprecision ARRAY DX(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 DX(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 DX(*). (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.
%
%     doubleprecision COSTS(100)
%     N = 100
%     IDIGIT = -6
%     CALL DVOUT(N,COSTS,'(''1COSTS OF PURCHASES'')',IDIGIT)
%
%***SEE ALSO  DSPLP
%***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)
%   910403  Updated AUTHOR section.  (WRB)
%***end PROLOGUE  DVOUT
persistent i k1 k2 lout ndigit ; 

if isempty(i), i=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;
dx_shape=size(dx);dx=reshape(dx,1,[]);
%***FIRST EXECUTABLE STATEMENT  DVOUT
[lout ]=i1mach(2);
disp({});
if( n<=0 )
dx_shape=zeros(dx_shape);dx_shape(:)=dx(1:numel(dx_shape));dx=dx_shape;
return;
end;
ndigit = fix(idigit);
if( idigit==0 )
ndigit = 6;
end;
if( idigit<0 )
%
ndigit = fix(-idigit);
if( 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 ,dx(i)); end;
end; k1 = fix(n +1);
dx_shape=zeros(dx_shape);dx_shape(:)=dx(1:numel(dx_shape));dx=dx_shape;
return;
%
elseif( ndigit<=14 ) ;
%
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('%22.13f',1,5) ' \n'], k1 , k2 ,dx(i)); end;
end; k1 = fix(n +1);
dx_shape=zeros(dx_shape);dx_shape(:)=dx(1:numel(dx_shape));dx=dx_shape;
return;
%
elseif( ndigit>20 ) ;
%
for k1 = 1 : n;
k2 = fix(k1);
for i=(k1):(k2), writef(lout,[repmat(' ',1,1),'%4i',' - ','%4i',repmat(' ',1,1),repmat('%f',1,1),repmat('%36.27f',1,3) ' \n'], k1 , k2 ,dx(i)); end;
end; k1 = fix(n+1);
dx_shape=zeros(dx_shape);dx_shape(:)=dx(1:numel(dx_shape));dx=dx_shape;
return;
else;
%
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('%28.19f',1,4) ' \n'], k1 , k2 ,dx(i)); end;
end; k1 = fix(n +1);
dx_shape=zeros(dx_shape);dx_shape(:)=dx(1:numel(dx_shape));dx=dx_shape;
return;
end;
%
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 ,dx(i)); end;
end; k1 = fix(n +1);
dx_shape=zeros(dx_shape);dx_shape(:)=dx(1:numel(dx_shape));dx=dx_shape;
return;
%
elseif( ndigit<=14 ) ;
%
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('%22.13f',1,5) ' \n'], k1 , k2 ,dx(i)); end;
end; k1 = fix(n +1);
dx_shape=zeros(dx_shape);dx_shape(:)=dx(1:numel(dx_shape));dx=dx_shape;
return;
%
elseif( ndigit>20 ) ;
%
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('%36.27f',1,3) ' \n'], k1 , k2 ,dx(i)); end;
end; k1 = fix(n +1);
dx_shape=zeros(dx_shape);dx_shape(:)=dx(1:numel(dx_shape));dx=dx_shape;
return;
else;
%
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('%28.19f',1,4) ' \n'], k1 , k2 ,dx(i)); end;
end; k1 = fix(n +1);
dx_shape=zeros(dx_shape);dx_shape(:)=dx(1:numel(dx_shape));dx=dx_shape;
return;
end;
%format (1X,i4,' - ',i4,1X,1P,8D14.5);
%format (1X,i4,' - ',i4,1X,1P,5D22.13);
%format (1X,i4,' - ',i4,1X,1P,4D28.19);
%format (1X,i4,' - ',i4,1X,1P,3D36.27);
dx_shape=zeros(dx_shape);dx_shape(:)=dx(1:numel(dx_shape));dx=dx_shape;
end
%DECK DWNLIT