| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667 |
- *DECK R9PAK
- FUNCTION R9PAK (Y, N)
- C***BEGIN PROLOGUE R9PAK
- C***PURPOSE Pack a base 2 exponent into a floating point number.
- C***LIBRARY SLATEC (FNLIB)
- C***CATEGORY A6B
- C***TYPE SINGLE PRECISION (R9PAK-S, D9PAK-D)
- C***KEYWORDS FNLIB, PACK
- C***AUTHOR Fullerton, W., (LANL)
- C***DESCRIPTION
- C
- C Pack a base 2 exponent into floating point number Y. This
- C routine is almost the inverse of R9UPAK. It is not exactly
- C the inverse, because ABS(X) need not be between 0.5 and
- C 1.0. If both R9PAK and 2.0**N were known to be in range, we
- C could compute
- C R9PAK = Y * 2.0**N .
- C
- C***REFERENCES (NONE)
- C***ROUTINES CALLED I1MACH, R1MACH, R9UPAK, XERMSG
- C***REVISION HISTORY (YYMMDD)
- C 790801 DATE WRITTEN
- C 890531 Changed all specific intrinsics to generic. (WRB)
- C 890531 REVISION DATE from Version 3.2
- C 891214 Prologue converted to Version 4.0 format. (BAB)
- C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
- C 901009 Routine used I1MACH(7) where it should use I1MACH(10),
- C Corrected (RWC)
- C***END PROLOGUE R9PAK
- LOGICAL FIRST
- SAVE NMIN, NMAX, A1N210, FIRST
- DATA A1N210 / 3.321928094 887362 E0/
- DATA FIRST /.TRUE./
- C***FIRST EXECUTABLE STATEMENT R9PAK
- IF (FIRST) THEN
- A1N2B = 1.0
- IF (I1MACH(10).NE.2) A1N2B = R1MACH(5)*A1N210
- NMIN = A1N2B*I1MACH(12)
- NMAX = A1N2B*I1MACH(13)
- ENDIF
- FIRST = .FALSE.
- C
- CALL R9UPAK(Y,R9PAK,NY)
- C
- NSUM = N + NY
- IF (NSUM.LT.NMIN) GO TO 40
- IF (NSUM .GT. NMAX) CALL XERMSG ('SLATEC', 'R9PAK',
- + 'PACKED NUMBER OVERFLOWS', 2, 2)
- C
- IF (NSUM.EQ.0) RETURN
- IF (NSUM.GT.0) GO TO 30
- C
- 20 R9PAK = 0.5*R9PAK
- NSUM = NSUM + 1
- IF(NSUM.NE.0) GO TO 20
- RETURN
- C
- 30 R9PAK = 2.0*R9PAK
- NSUM = NSUM - 1
- IF(NSUM.NE.0) GO TO 30
- RETURN
- C
- 40 CALL XERMSG ('SLATEC', 'R9PAK', 'PACKED NUMBER UNDERFLOWS', 1, 1)
- R9PAK = 0.0
- RETURN
- C
- END
|
