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

function [x,ix,ierror]=xadj(x,ix,ierror);
%***BEGIN PROLOGUE  XADJ
%***PURPOSE  To provide single-precision floating-point arithmetic
%            with an extended exponent range.
%***LIBRARY   SLATEC
%***CATEGORY  A3D
%***TYPE      SINGLE PRECISION (XADJ-S, DXADJ-D)
%***KEYWORDS  EXTENDED-RANGE SINGLE-PRECISION ARITHMETIC
%***AUTHOR  Lozier, Daniel W., (National Bureau of Standards)
%           Smith, John M., (NBS and George Mason University)
%***DESCRIPTION
%     REAL 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 SINGLE-PRECISION ARITHMETIC.
%
%***SEE ALSO  XSET
%***REFERENCES  (NONE)
%***ROUTINES CALLED  XERMSG
%***COMMON BLOCKS    XBLK2
%***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  XADJ

global xblk2_1; if isempty(xblk2_1), xblk2_1=0; end;
global xblk2_2; if isempty(xblk2_2), xblk2_2=0; end;
global xblk2_3; if isempty(xblk2_3), xblk2_3=0; end;
global xblk2_4; if isempty(xblk2_4), xblk2_4=0; end;
global xblk2_5; if isempty(xblk2_5), xblk2_5=0; end;
global xblk2_6; if isempty(xblk2_6), xblk2_6=0; end;
global xblk2_7; if isempty(xblk2_7), xblk2_7=0; end;
% common :: ;
%% common /xblk2 / radix , radixl , rad2l , dlg10r , l , l2 , kmax;
%% common /xblk2 / xblk2_1 , xblk2_2 , xblk2_3 , xblk2_4 , xblk2_5 , xblk2_6 , xblk2_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 XSET.
%
%***FIRST EXECUTABLE STATEMENT  XADJ
ierror = 0;
while (1);
if( x==0.0 )
ix = 0;
elseif( abs(x)>=1.0 ) ;
if( abs(x)>=xblk2_2 )
x = x./xblk2_3;
if( ix<=0 )
ix = fix(ix + xblk2_6);
return;
elseif( ix<=xblk2_7-xblk2_6 ) ;
ix = fix(ix + xblk2_6);
return;
else;
break;
end;
end;
elseif( xblk2_2.*abs(x)<1.0 ) ;
x = x.*xblk2_3;
if( ix>=0 )
ix = fix(ix - xblk2_6);
return;
elseif( ix>=-xblk2_7+xblk2_6 ) ;
ix = fix(ix - xblk2_6);
return;
else;
break;
end;
end;
if( abs(ix)<=xblk2_7 )
return;
end;
break;
end;
xermsg('SLATEC','XADJ','overflow in auxiliary index',107,1);
ierror = 107;
end %subroutine xadj
%DECK XC210