[x,ix,ierror]=dxadj(x,ix,ierror);

function [x,ix,ierror]=dxadj(x,ix,ierror);
%***BEGIN PROLOGUE  DXADJ
%***PURPOSE  To provide double-precision floating-point arithmetic
%            with an extended exponent range.
%***LIBRARY   SLATEC
%***CATEGORY  A3D
%***TYPE      doubleprecision (XADJ-S, DXADJ-D)
%***KEYWORDS  EXTENDED-RANGE DOUBLE-PRECISION ARITHMETIC
%***AUTHOR  Lozier, Daniel W., (National Bureau of Standards)
%           Smith, John M., (NBS and George Mason University)
%***DESCRIPTION
%     doubleprecision X
%     INTEGER IX
%
%                  TRANSFORMS (X,IX) SO THAT
%                  RADIX**(-L) .LE. ABS(X) .LT. RADIX**L.
%                  ON MOST COMPUTERS THIS TRANSFORMATION DOES
%                  NOT CHANGE THE MANTISSA OF X PROVIDED RADIX IS
%                  THE NUMBER BASE OF DOUBLE-PRECISION ARITHMETIC.
%
%***SEE ALSO  DXSET
%***REFERENCES  (NONE)
%***ROUTINES CALLED  XERMSG
%***COMMON BLOCKS    DXBLK2
%***REVISION HISTORY  (YYMMDD)
%   820712  DATE WRITTEN
%   881020  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  DXADJ

global dxblk2_1; if isempty(dxblk2_1), dxblk2_1=0; end;
global dxblk2_2; if isempty(dxblk2_2), dxblk2_2=0; end;
global dxblk2_3; if isempty(dxblk2_3), dxblk2_3=0; end;
global dxblk2_4; if isempty(dxblk2_4), dxblk2_4=0; end;
global dxblk2_5; if isempty(dxblk2_5), dxblk2_5=0; end;
global dxblk2_6; if isempty(dxblk2_6), dxblk2_6=0; end;
global dxblk2_7; if isempty(dxblk2_7), dxblk2_7=0; end;
% common :: ;
%% common /dxblk2/ radix , radixl , rad2l , dlg10r , l , l2 , kmax;
%% common /dxblk2/ dxblk2_1 , dxblk2_2 , dxblk2_3 , dxblk2_4 , dxblk2_5 , dxblk2_6 , dxblk2_7;
% save :: ;
% save ::       ;
%
%   THE CONDITION IMPOSED ON L AND KMAX BY THIS SUBROUTINE
% IS
%     2*L .LE. KMAX
%
% THIS CONDITION MUST BE MET BY APPROPRIATE CODING
% IN SUBROUTINE DXSET.
%
%***FIRST EXECUTABLE STATEMENT  DXADJ
ierror = 0;
while (1);
if( x==0.0d0 )
ix = 0;
elseif( abs(x)>=1.0d0 ) ;
if( abs(x)>=dxblk2_2 )
x = x./dxblk2_3;
if( ix<=0 )
ix = fix(ix + dxblk2_6);
return;
elseif( ix<=dxblk2_7-dxblk2_6 ) ;
ix = fix(ix + dxblk2_6);
return;
else;
break;
end;
end;
elseif( dxblk2_2.*abs(x)<1.0d0 ) ;
x = x.*dxblk2_3;
if( ix>=0 )
ix = fix(ix - dxblk2_6);
return;
elseif( ix>=-dxblk2_7+dxblk2_6 ) ;
ix = fix(ix - dxblk2_6);
return;
else;
break;
end;
end;
if( abs(ix)<=dxblk2_7 )
return;
end;
break;
end;
xermsg('SLATEC','DXADJ','overflow in auxiliary index',207,1);
ierror = 207;
end %subroutine dxadj
%DECK DXC210