[k,z,j,ierror]=dxc210(k,z,j,ierror);

function [k,z,j,ierror]=dxc210(k,z,j,ierror);
persistent i ic id ii it ja ka ka1 ka2 m nm1 np1 ; 

if isempty(i), i=0; end;
if isempty(ic), ic=0; end;
if isempty(id), id=0; end;
if isempty(ii), ii=0; end;
if isempty(it), it=0; end;
if isempty(ja), ja=0; end;
if isempty(ka), ka=0; end;
if isempty(ka1), ka1=0; end;
if isempty(ka2), ka2=0; end;
if isempty(m), m=0; end;
if isempty(nm1), nm1=0; end;
if isempty(np1), np1=0; end;
%***BEGIN PROLOGUE  DXC210
%***PURPOSE  To provide double-precision floating-point arithmetic
%            with an extended exponent range.
%***LIBRARY   SLATEC
%***CATEGORY  A3D
%***TYPE      doubleprecision (XC210-S, DXC210-D)
%***KEYWORDS  EXTENDED-RANGE DOUBLE-PRECISION ARITHMETIC
%***AUTHOR  Lozier, Daniel W., (National Bureau of Standards)
%           Smith, John M., (NBS and George Mason University)
%***DESCRIPTION
%     INTEGER K, J
%     doubleprecision Z
%
%                  GIVEN K THIS SUBROUTINE COMPUTES J AND Z
%                  SUCH THAT  RADIX**K = Z*10**J, WHERE Z IS IN
%                  THE RANGE 1/10 .LE. Z .LT. 1.
%                  THE VALUE OF Z WILL BE ACCURATE TO FULL
%                  DOUBLE-PRECISION PROVIDED THE NUMBER
%                  OF DECIMAL PLACES IN THE LARGEST
%                  INTEGER PLUS THE NUMBER OF DECIMAL
%                  PLACES CARRIED IN DOUBLE-PRECISION DOES NOT
%                  EXCEED 60. DXC210 IS CALLED BY SUBROUTINE
%                  DXCON WHEN NECESSARY. THE USER SHOULD
%                  NEVER NEED TO CALL DXC210 DIRECTLY.
%
%***SEE ALSO  DXSET
%***REFERENCES  (NONE)
%***ROUTINES CALLED  XERMSG
%***COMMON BLOCKS    DXBLK3
%***REVISION HISTORY  (YYMMDD)
%   820712  DATE WRITTEN
%   890126  Revised to meet SLATEC CML recommendations.  (DWL and JMS)
%   901019  Revisions to prologue.  (DWL and WRB)
%   901106  Changed all specific intrinsics to generic.  (WRB)
%           Corrected order of sections in prologue and added TYPE
%           section.  (WRB)
%           CALLs to XERROR changed to CALLs to XERMSG.  (WRB)
%   920127  Revised PURPOSE section of prologue.  (DWL)
%***end PROLOGUE  DXC210
global dxblk3_1; if isempty(dxblk3_1), dxblk3_1=0; end;
global dxblk3_2; if isempty(dxblk3_2), dxblk3_2=0; end;
global dxblk3_3; if isempty(dxblk3_3), dxblk3_3=zeros(1,21); end;
% common :: ;
%% common /dxblk3/ nlg102 , mlg102 , lg102(21);
%% common /dxblk3/ dxblk3_1 , dxblk3_2 , dxblk3_3(21);
% save :: ;
% save ::       ;
%
%   THE CONDITIONS IMPOSED ON NLG102, MLG102, AND LG102 BY
% THIS SUBROUTINE ARE
%
%     (1) NLG102 .GE. 2
%
%     (2) MLG102 .GE. 1
%
%     (3) 2*MLG102*(MLG102 - 1) .LE. 2**NBITS - 1
%
% THESE CONDITIONS MUST BE MET BY APPROPRIATE CODING
% IN SUBROUTINE DXSET.
%
%***FIRST EXECUTABLE STATEMENT  DXC210
ierror = 0;
if( k==0 )
j = 0;
z = 1.0d0;
else;
m = fix(dxblk3_2);
ka = fix(abs(k));
ka1 = fix(fix(ka./m));
ka2 = fix(rem(ka,m));
if( ka1>=m )
%   THIS ERROR OCCURS IF K EXCEEDS  MLG102**2 - 1  IN MAGNITUDE.
%
xermsg('SLATEC','DXC210','K too large',208,1);
ierror = 208;
return;
else;
nm1 = fix(dxblk3_1 - 1);
np1 = fix(dxblk3_1 + 1);
it = fix(ka2.*dxblk3_3(np1));
ic = fix(fix(it./m));
id = fix(rem(it,m));
z = id;
if( ka1>0 )
for ii = 1 : nm1;
i = fix(np1 - ii);
it = fix(ka2.*dxblk3_3(i) + ka1.*dxblk3_3(i+1) + ic);
ic = fix(fix(it./m));
id = fix(rem(it,m));
z = z./m + id;
end; ii = fix(nm1+1);
ja = fix(ka.*dxblk3_3(1) + ka1.*dxblk3_3(2) + ic);
else;
for ii = 1 : nm1;
i = fix(np1 - ii);
it = fix(ka2.*dxblk3_3(i) + ic);
ic = fix(fix(it./m));
id = fix(rem(it,m));
z = z./m + id;
end; ii = fix(nm1+1);
ja = fix(ka.*dxblk3_3(1) + ic);
end;
z = z./m;
if( k>0 )
j = fix(ja + 1);
z = 10.0d0.^(z-1.0d0);
else;
j = fix(-ja);
z = 10.0d0.^(-z);
end;
end;
end;
end
%DECK DXCON