*DECK C$RTOI
          IDENT  C$RTOI 
          TITLE  CBRTOI - REAL ** INTEGER 
  
          MACHINE  ANY,I
          COMMENT  REAL ** INTEGER
 CBRTOI   SPACE  4
**        C.RTOI - REAL ** INTEGER
* 
*         INPUT 
*                X1   BASE
*                X3   EXPONENT
* 
*         OUTPUT
*                X5   RESULT
*                B3   ERROR FLAG
* 
*         SAVES 
*                B1 
* 
*         CALLS-
*                FORTRAN OBJECT LIBRARY ROUTINE *XTOI.* 
  
          ENTRY  C.RTOI 
 C.RTOI   DATA   0
          SB3    B0          ZERO ERROR FLAG
          ZR     X1,C.RTOI2 
          ZR     X3,C.RTOI1 
          RJ     =XXTOI.
          BX5    X6 
          SB1    1
          SB3    B0 
          EQ     C.RTOI 
  
 C.RTOI1  SA5    =XC.FP1     X**0 = 1 
          EQ     C.RTOI 
  
 C.RTOI2  NG     X3,C.RTOI3  0**(-X) UNDEFINED
          ZR     X3,C.RTOI3  0**0    UNDEFINED
          MX5    0           0**X = 0 
          EQ     C.RTOI 
  
 C.RTOI3  SB3    B1          ERROR
          EQ     C.RTOI 
          TITLE  XTOI. - FORTRAN 5 REAL ** INTEGER
**        XTOI - FORTRAN 5 REAL ** INTEGER
* 
*         XTOI. COMPUTES X**I, X REAL, I INTEGER. 
* 
*         ENTRY: (X1) = X . 
*                (X3) = I . 
* 
*         EXIT:  (X6) = X**I .
* 
*         METHOD: 
*                ARGUMENT RANGE:  ALL (X,I) WHERE X IS A VALID
*                FLOATING-POINT NUMBER, I IS AN INTEGER, AND THE
*                FOLLOWING CONDITIONS HOLD: 
*                       WHEN X=0, I>0 
*                       ABS(X**I) IS IN [2'-976,2'1070) 
*                NOTE THAT PARTIAL UNDERFLOW IS A VALID RESULT. 
* 
*                IF ABS(LOG2(I))+ABS(LOG2(ABS(LOG2(X)))) IS SMALL, NO 
*                SCALING IS DONE, ELSE SCALING IS DONE AS FOLLOWS:  
*                X IS SCALED TO [.75,1.5) INITIALLY.  THE MULTIPLIER
*                IS NOT RESCALED;  THE RUNNING PRODUCT IS RESCALED AFTER
*                EACH 10 BITS OF I ARE PROCESSED.  THE APPROPRIATE
*                EXPONENT AND SIGN ARE GIVEN THE PRODUCT BEFORE EXIT. 
  
*                THE OPERATION Y**IABS(I) IS COMPUTED BY THE BINARY 
*                METHOD (KNUTH VOL.2 P.399), WHICH STARTS WITH Y AND
*                SCANS THE BINARY REPRESENTATION OF I FROM LEFT TO RIGHT
*                STARTING WITH THE SECOND BIT, SQUARING THE RESULT AT 
*                EACH STEP AND MULTIPLYING BY Y IF THE CURRENT BIT IS 1.
* 
  
*         COPYRIGHT CONTROL DATA CORP 1978,1979,1980,1981,1982
* 
*         CONTROL DATA PROPRIETARY PRODUCT
  
  
          EJECT 
  
*         SCALE RUNNING PRODUCT 
  
 SCALE    ZR,B4  INVERT2     IF DONE
          UX0    X6,B2       B2 = EXP(PROD) 
          LX6    12 
          AX6    -2          -0 IN [.75,1), -1 IN [1,1.5) 
          BX4    -X6
          SB1    X4-48       EXP(SCALED X)
          SX4    B2-B1       SCALE FACTOR 
          PX6    X0,B1       SCALED PRODUCT 
          AX0    X4,B4       SCALED SCALE FACTOR
          SB4    B4+10
          IX7    X7+X0       TOTAL SCALING SO FAR 
  
*         SET UP ANOTHER LOOP 
  
 CHUNK    MX0    1           SET TOP BIT
          BX0    X5+X0
          BX5    -X2*X5      CLEAR USED BITS
          LX5    10 
          BX4    X2*X0       1/1, 10/TOP OF I, 49/0 
          LX4    11 
          BX0    X2*X0
          NG,B4  SQUARE0     IF NOT LAST TIME 
          AX4    X4,B4       RIGHT-JUSTIFY I
          SB4    B0 
          EQ     SQUARE0
  
*         INVERT IF I < 0  (SCALED CASE)
  
 INVERT2  PL,X3  FINISH 
          SX4    1.0/1S42 
          LX4    42          1.0
          FX6    X4/X6
          BX7    -X7         NEGATE SCALING 
  
*         SCALE FINAL PRODUCT 
  
 FINISH   UX5    X6,B2       FINAL PRODUCT
          BX0    X3 
          SA4    A6          SGN(X) 
          SX2    X7+B2       TIMES SCALE FACTOR 
          LX0    -1 
          SB2    X2 
          AX2    10 
          BX5    X0-X3       - IF I ODD, + IF EVEN
          PX7    X6,B2       ABS(RESULT)
          BX4    X4*X5       - IF I ODD AND X NEG 
          NZ,X2  OFLUFL      IF EXP EXCEEDS 10 BITS 
          AX4    59          SIGN OF RESULT 
          OR,X7  OFLUFL      IF PARTIAL OVERFLOW
          BX6    X7-X4       SIGNED RESULT
          EJECT 
 XTOI.    DATA   0           ENTRY/EXIT WORD
          UX2    X1,B3       B3 = EXP(X)
          SB2    -48
          PX5    X3 
          SX7    B3-B2       SCALE FACTOR 
          ID,X1  ERROR       IF X INDEF 
          NX5    X5,B4       B4 = 48 - (NO. BITS IN I)
          ZR,X3  IZERO       IF I = 0 
          NX4    X7,B7       B7 = 48 - (NO. BITS IN SCALE FACTOR) 
          SB1    -B4
          LX0    X3,B2       SGN(I) MAYBE 
          SB1    B1+96-8     48 + (NO. BITS IN I) - 8 
          NZ,X0  BIG1        ABS(I) .GT. 2'48 
          GT     B1,B7,BIG2  (NO. BITS IN I) + (NO. BITS IN SCALE) > 8
  
*         QUICK VERSION, SURE NO OFL/UFL. (X INF,ZERO TRAPPED WITH OFL) 
  
          LX5    12          LEFT-JUST I
          BX4    X3-X0       ABS(I) 
          BX6    X1          RUNNING PRODUCT
          BX0    X5-X0       ABS(I), LEFT-JUST
 SQUARE0  LX4    -1 
          OR,X0  ONEBIT      IF JUST ONE BIT SET IN I 
  
*         COMMON MULTIPLY LOOP
  
 SQUARE   LX0    1           SQUARE FOR EACH BIT
          RX6    X6*X6
          PL,X0  SQUARE 
          RX6    X6*X1       MULTIPLY FOR EACH 1 BIT
          IR,X0  SQUARE      IF NOT LAST BIT
 ONEBIT   BSS    0
          ID,X0  SQUARE      FALSE ALARM
          NG,X4  INVERT      IF NO TRAILING ZEROES
 TRAIL    LX4    -1 
          RX6    X6*X6       SQUARE FOR EACH TRAILING ZERO
          PL,X4  TRAIL
  
*         INVERT IF I < 0   (NO SCALING CASE ONLY)
  
 INVERT   NG,B1  SCALE       IF SCALED CASE 
          PL,X3  XTOI.       IF I > 0 
          SX4    1.0/1S42 
          LX4    42          1.0
          FX6    X4/X6       1.0/(X**(-I)) = X**I 
          EQ     XTOI.       EXIT 
  
*         SLOW VERSION
  
 BIG1     NX7    X0,B1       I .GE. 2'48, FIND LENGTH 
          SB4    B1-48       48 - (NO. BITS IN I) 
          AX0    59          SGN(I) 
 BIG2     ZR,X1  XZERO       IF X = 0 
          OR,X1  ERROR       IF X INFINITE
          LX6    X2,B2       SGN(X) 
          LX1    12 
          SB1    B4+12       60 - (NO. BITS IN I) 
          BX0    X3-X0       ABS(I) 
          AX1    -2 
          BX4    -X1-X6      0 IN [.75,1), 1 IN [1,1.5) 
          LX5    X0,B1       LEFT-JUST I
          SB1    B2+X4       SCALED EXP 
          BX1    X2-X6       ABS(COEF(X)) 
          SA6    SGNX        SAVE SIGN OF X 
          MX2    11 
          SB4    B4-37       10 - (NO. BITS IN I BELOW TOP BIT) 
          SX7    B3-B1       SCALE FACTOR 
          PX1    X1,B1       SCALED ABS(X)
          BX6    X1          MULTIPLIER 
          ZR,X7  CHUNK       IF NO SCALING YET
          IX0    X7*X0       ABS(I)*SCALE 
          BX7    X0 
          AX0    12 
          ZR,X0  CHUNK       IF ABS(I)*SCALE < 4096 
          BX2    X0-X3       ATTACH SGN(I) TO SCALE FACTOR
  
*         OVERFLOW AND UNDERFLOW
  
 OFLUFL   SA4    A6          RECONSTRUCT X... SGN(X)
          PX0    X1,B3       ABS(X) 
          BX1    X0-X4       X
          SX6    B0 
*         VISA   ERR34,EXP.UFL,,1  *UNDERFLOW*
          NG,X2  RJT
*         VISA   ERR34,EXP.OFL,,1  *OVERFLOW* 
          EQ     OFL
  
 SGNX     DATA   0
  
*         X = 0  AND/OR  I = 0    (AND MISC)
  
 XZERO    SX6    0
          PL,X3  XTOI.       0**(+) 
*         VISA   ERR34,EXP.0NP,,1  *ZERO TO THE NEGATIVE POWER* 
 OFL      SX6    3777B       PREPARE FOR POSITIVE INFINITE
          EQ     RJT
 IZERO    SX6    1.0/1S42 
          LX6    42          1.0
          OR,X1  ERROR       WASNT CAUGHT EARLIER 
          NZ,X1  XTOI.
 ERROR    BSS    0
*         VISA   ERR34,EXP.00P,,1  *ZERO TO THE ZERO POWER*  AND MISC 
          SX6    1777B       PREPARE FOR POSITIVE INDEFINITE
 RJT      BSS    0
          BX6    X5          RETURN SPECIAL VALUE 
          LX6    48 
          EQ     XTOI.
          END 
