function [r9pakresult,y,n]=r9pak(y,n);
r9pakresult=[];
persistent a1n210 a1n2b first firstCall nmax nmin nsum ny r9pak ; if isempty(firstCall),firstCall=1;end;
if isempty(a1n210), a1n210=0; end;
if isempty(a1n2b), a1n2b=0; end;
if isempty(r9pakresult), r9pakresult=0; end;
if isempty(nmax), nmax=0; end;
if isempty(nmin), nmin=0; end;
if isempty(nsum), nsum=0; end;
if isempty(ny), ny=0; end;
%***BEGIN PROLOGUE R9PAK
%***PURPOSE Pack a base 2 exponent into a floating point number.
%***LIBRARY SLATEC (FNLIB)
%***CATEGORY A6B
%***TYPE SINGLE PRECISION (R9PAK-S, D9PAK-D)
%***KEYWORDS FNLIB, PACK
%***AUTHOR Fullerton, W., (LANL)
%***DESCRIPTION
%
% Pack a base 2 exponent into floating point number Y. This
% routine is almost the inverse of R9UPAK. It is not exactly
% the inverse, because ABS(X) need not be between 0.5 and
% 1.0. If both R9PAK and 2.0**N were known to be in range, we
% could compute
% R9PAK = Y * 2.0**N .
%
%***REFERENCES (NONE)
%***ROUTINES CALLED I1MACH, R1MACH, R9UPAK, XERMSG
%***REVISION HISTORY (YYMMDD)
% 790801 DATE WRITTEN
% 890531 Changed all specific intrinsics to generic. (WRB)
% 890531 REVISION DATE from Version 3.2
% 891214 Prologue converted to Version 4.0 format. (BAB)
% 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
% 901009 Routine used I1MACH(7) where it should use I1MACH(10),
% Corrected (RWC)
%***end PROLOGUE R9PAK
if isempty(first), first=false; end;
if firstCall, a1n210=[3.321928094887362e0]; end;
if firstCall, first=[true]; end;
firstCall=0;
%***FIRST EXECUTABLE STATEMENT R9PAK
if( first )
a1n2b = 1.0;
if( i1mach(10)~=2 )
a1n2b = r1mach(5).*a1n210;
end;
nmin = fix(a1n2b.*i1mach(12));
nmax = fix(a1n2b.*i1mach(13));
end;
first = false;
%
r9pakresult=0.0;
[y,r9pakresult,ny]=r9upak(y,r9pakresult,ny);
%
nsum = fix(n + ny);
if( nsum<nmin )
%
xermsg('SLATEC','R9PAK','PACKED NUMBER UNDERFLOWS',1,1);
r9pakresult = 0.0;
else;
if( nsum>nmax )
xermsg('SLATEC','R9PAK','PACKED NUMBER OVERFLOWS',2,2);
end;
%
if( nsum~=0 )
if( nsum>0 )
%
while( true );
r9pakresult = 2.0.*r9pakresult;
nsum = fix(nsum - 1);
if( nsum==0 )
break;
end;
end;
else;
%
while( true );
r9pakresult = 0.5.*r9pakresult;
nsum = fix(nsum + 1);
if( nsum==0 )
break;
end;
end;
end;
end;
csnil=dbstack(1); csnil=csnil(1).name(1)~='@';
if csnil&&~isempty(inputname(1)), assignin('caller','FUntemp',y); evalin('caller',[inputname(1),'=FUntemp;']); end
if csnil&&~isempty(inputname(2)), assignin('caller','FUntemp',n); evalin('caller',[inputname(2),'=FUntemp;']); end
return;
end;
%
csnil=dbstack(1); csnil=csnil(1).name(1)~='@';
if csnil&&~isempty(inputname(1)), assignin('caller','FUntemp',y); evalin('caller',[inputname(1),'=FUntemp;']); end
if csnil&&~isempty(inputname(2)), assignin('caller','FUntemp',n); evalin('caller',[inputname(2),'=FUntemp;']); end
end %function r9pak
%DECK R9UPAK