[d9pakresult,y,n]=d9pak(y,n);

function [d9pakresult,y,n]=d9pak(y,n);
d9pakresult=[];
persistent a1n210 a1n2b first firstCall gt nmax nmin nsum ny ; if isempty(firstCall),firstCall=1;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  D9PAK
%***PURPOSE  Pack a base 2 exponent into a floating point number.
%***LIBRARY   SLATEC (FNLIB)
%***CATEGORY  A6B
%***TYPE      doubleprecision (R9PAK-S, D9PAK-D)
%***KEYWORDS  FNLIB, PACK
%***AUTHOR  Fullerton, W., (LANL)
%***DESCRIPTION
%
% Pack a base 2 exponent into floating point number X.  This routine is
% almost the inverse of D9UPAK.  It is not exactly the inverse, because
% ABS(X) need not be between 0.5 and 1.0.  If both D9PAK and 2.0d0**N
% were known to be in range we could compute
%               D9PAK = X *2.0d0**N
%
%***REFERENCES  (NONE)
%***ROUTINES CALLED  D1MACH, D9UPAK, I1MACH, XERMSG
%***REVISION HISTORY  (YYMMDD)
%   790801  DATE WRITTEN
%   890531  Changed all specific intrinsics to generic.  (WRB)
%   890911  Removed unnecessary intrinsics.  (WRB)
%   891009  Corrected error when XERROR called.  (WRB)
%   891009  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  D9PAK
if isempty(a1n2b), a1n2b=0; end;
if isempty(a1n210), a1n210=0; end;
if isempty(gt), gt=0; end;
if isempty(first), first=false; end;
if firstCall,   a1n210=[3.321928094887362347870319429489d0];  end;
if firstCall,   first=[true];  end;
firstCall=0;
%***FIRST EXECUTABLE STATEMENT  D9PAK
if( first )
a1n2b = 1.0d0;
if( i1mach(10)~=2 )
a1n2b = d1mach(5).*a1n210;
end;
nmin = fix(a1n2b.*i1mach(15));
nmax = fix(a1n2b.*i1mach(16));
end;
first = false;
%
[y,gt,ny]=d9upak(y,gt,ny);
d9pakresult=gt;
%
nsum = fix(n + ny);
if( nsum<nmin )
%
xermsg('SLATEC','D9PAK','PACKED NUMBER UNDERFLOWS',1,1);
d9pakresult = 0.0d0;
else;
if( nsum>nmax )
xermsg('SLATEC','D9PAK','PACKED NUMBER OVERFLOWS',1,2);
end;
%
if( nsum~=0 )
if( nsum>0 )
%
while( true );
d9pakresult = 2.0d0.*d9pakresult;
nsum = fix(nsum - 1);
if( nsum==0 )
break;
end;
end;
else;
%
while( true );
d9pakresult = 0.5d0.*d9pakresult;
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 d9pak
%DECK D9UPAK