*COMDECK FSCALE 
          CTEXT  FSCALE - FLOATING DP CONVERSION. 
  
  
**        FSCALE  -  CONVERT INTEGER CONSTANT WITH OR WITHOUT 
*                    FLOATING CONSTANT. 
*                    EXPONENT TO SINGLE OR DOUBLE PRECISION 
* 
*         RICK JAMES.   (AUTHOR). 
* 
*         ENTRY  (X0) = HIGH ORDER PART OF INTEGER CONSTANT 
*                       IN BITS 58-00.
*                (X1) = LOW ORDER PART OF INTEGER CONSTANT
*                       IN BITS 54-00.
*                (X5) = 1RX WHERE X = + OR - (SIGN OF RESULT).
*                (B1) = 1.
*                (B3) = POWER OF 10.
*                (B4) = 0, SINGLE PRECISION.
*                (B4) = 1, DOUBLE PRECISION.
* 
*         EXIT   (X1) = HIGH ORDER BITS DP CONSTANT.
*                (X2) = LOW ORDER BITS DP CONSTANT. 
*                (B1) = 1.
*                (B4) = 0, CONVERSION OK. 
*                (B4) = -1, ERROR OVERFLOW. 
* 
*         ACTION 1.  CONVERT INTEGER TO TRIPLE PRECISION
*                    FLOATING POINT.
*                2.  SCALE BY BIG POWER OF 5 OR 10 (TRIPLE
*                    MULTIPLY, X432 * X017).
*                3.  MULTIPLY BY 1E20 AS NEEDED.
*                4.  FINISH CONVERSION BY MULTIPLYING BY N
*                    WHERE 1E20 .GE. N .LE. 1.
*                5.  ROUND RESULT.
*                6.  SET SIGN.
*                7.  ADJUST BY POWER OF 2 AND CHECK.
* 
*         USES   A. -,-,-,3,4,-,-,- 
*                B. -,-,2,3,4,5,-,7 
*                X. 0,1,2,3,4,5,6,7 
  
 FSCALE   SUBR               ENTRY/EXIT 
          MX7    -18
          BX4    -X7*X1      BOT
          SB2    18 
          PX4    B0,X4
          SB7    B4 
          SB4    B0          CLEAR ERROR FLAG 
          AX1    18          LOW MID
          ZR     X0,CIF      IF NO HIGH ORDER BITS
          MX7    -11
          BX2    -X7*X0      HI MID 
          NX4    B0,X4
          SB5    66 
          LX2    37 
          AX0    11          TOP
          BX1    X1+X2       MID
          PX0    X0,B5
          PX1    B2 
          NX0    B0,X0       TOP
          NX1    B0,X1
          DX2    X0+X1
          FX0    X0+X1       UPPER
          DX7    X2+X4       LOWER
          FX1    X2+X4       MIDDLE 
          EQ     CIF1 
  
 CIF      PX1    B2,X1
          NO
          NX4    B0,X4
          NX1    B0,X1
          FX0    X1+X4       UPPER
          DX1    X1+X4       MIDDLE 
          NO
          DX7    X1+X1       LOWER (PACKED ZERO)
  
 CIF1     SB2    B7-B1
          ZR     B2,CIF2     IF DOUBLE PRECISION
          MX7    0           TO INDICATE ONLY SINGLE NEEDED 
  
 CIF2     SX4    B3 
          SX3    B3+320 
          AX4    8
          NZ     X4,CIF16    IF NOT WITHIN 1E-256 TO 1E+256 
          AX3    6           EXP/64+4 
          SB7    B0 
          SA4    CIFB+X3
          ZR     X4,CIF5     IF EXP IS 0 TO 64
          BX3    -X3
          SB3    B3+320 
          LX3    6
          SB3    B3+X3
  
*         TRIPLE OR DOUBLE MULTIPLY.
  
 CIF3     SB5    10 
          SA3    A4+10       M
          ZR     X7,CIF4     IF ONLY SINGLE PRECISION 
          SA2    A3+B5       L
          FX7    X4*X7       L=U*L
          FX2    X2*X0       L=L*U
          FX7    X7+X2       L
          DX2    X3*X0       L=M*U
          DX6    X4*X1       L=U*M
          FX7    X2+X7       L
          FX2    X3*X1       L=M*M
          FX7    X7+X6       L
          FX7    X2+X7       LOWER
  
 CIF4     FX3    X3*X0       M=M*U
          FX2    X4*X1       M=U*M
          DX6    X4*X0       M=U*U
          FX0    X4*X0       UPPER
          FX4    X3+X2       M
          FX1    X6+X4       MIDDLE 
          ZR     X7,CIF5     IF ONLY SINGLE PRECISION 
          DX3    X3+X2       L
          DX6    X6+X4       L
          FX7    X7+X3       L
          FX7    X7+X6       LOWER
  
*         MULTIPLY BY 1E20 AS NEEDED. 
  
 CIF5     SA4    CIFA+20
          SB2    20 
          LT     B3,B2,CIF8  IF NO NEED TO MULTIPLY BY 1E20 
  
*         1 * 3 OR 1 * 2 MULTIPLY.
  
 CIF6     FX3    X4*X1       M=U*M
          DX2    X4*X0       M=U*U
          ZR     X7,CIF7     IF ONLY SINGLE NEEDED
          FX7    X4*X7       L=U*L
          DX6    X3+X2       L
          DX1    X4*X1       L=U*M
          NO
          FX7    X7+X6       L
          SB0    0
          FX7    X7+X1       LOWER
  
 CIF7     FX1    X3+X2       MIDDLE 
          FX0    X4*X0       UPPER
          SB3    B3-B2
          NO
          GE     B3,B2,CIF6  IF NEED TO MULTIPLY BY 1E20 AGAIN
  
*         MULTIPLY BY LESS THAN 1E20 IF NECESSARY.
  
 CIF8     SA4    CIFA+B3
          GT     B3,CIF6     IF NECESSARY MULTIPLY BY .LT. 1E20 
          LX5    -2 
          AX5    60 
  
*         DOUBLE COMBINE. 
  
          ZR     X7,CIF10    IF ONLY SINGLE NEEDED
          DX4    X1+X7
          FX1    X1+X7
          NO
          DX3    X0+X1
          FX0    X0+X1
          RX1    X3+X4
          NO
          FX3    X0+X1
          NO
          BX7    X5-X3       UPPER SIGN FOR T.DBL 
          DX0    X0+X1
          BX1    X1-X1
          UX3    B0,X0
          ZR     X3,CIF9     IF LOW ORDER DP MANTISSA .EQ. 0
          BX1    X5-X0       LOWER SIGN FOR T.DBL 
  
 CIF9     ZR     B7,CIF18    IF NO UNDER/OVERFLOW CHECK NECESSARY 
          EQ     CIF11
  
*         SINGLE COMBINE. 
  
 CIF10    DX4    X0+X1
          FX0    X0+X1
          RX3    X0+X4
          BX7    X5-X3       SIGN FOR T.REL 
          ZR     B7,CIF18    IF NO UNDER/OVERFLOW CHECK NECESSARY 
  
  
*         CHECK FOR UNDER FLOW. 
  
 CIF11    PL     B7,CIF13 
          SB5    -1777B 
          UX1    B2,X1
          SB2    B2+B7
          NO
          PX1    B2,X1
          GE     B2,B5,CIF12 IF NOT UNDERFLOW 
          MX1    0           CLEAR LOW ORDER REGISTER 
  
 CIF12    UX7    B2,X7
          SB2    B2+B7
          NO
          PX7    B2,X7
          GE     B2,B5,CIF18 IF NO UNDERFLOW
          SX7    0
          EQ     CIF18
  
*         CHECK FOR OVERFLOW. 
  
 CIF13    UX7    B2,X7
          SB5    1777B
          SB2    B2+B7
          GE     B2,B5,CIF15 IF OVERFLOW
          PX7    B2,X7
          UX1    B2,X1
          SB2    B2+B7
          PX1    B2,X1
          EQ     CIF18
  
 CIF14    SB2    B3-324 
          SA4    CIFB+9      MULTIPLY BY 5**256 
          SB7    +256 
          NO
          SB3    B3-B7
          MI     B2,CIF3
  
 CIF15    SB4    -1          ERROR RETURN ON OVERFLOW 
          EQ     EXIT.
  
 CIF16    PL     B3,CIF14 
          SB2    B3+325 
          MI     B2,CIF17 
          SA4    CIFB 
          SB7    -325 
          NO
          SB3    B3-B7
          EQ     CIF3 
  
 CIF17    SX7    0
          SX1    0
  
 CIF18    BX2    X1 
          BX1    X7 
          EQ     EXIT.
  
*         WORKING CONSTANTS.
  
 CIFA     BSS    0           1.0EN  WHERE N = 0 TO 20 INCLUSIVE 
 CIFA1    SET    0
          DUP    21,3 
 CIFA2    DECMIC CIFA1
          DATA   1.0E"CIFA2"
 CIFA1    SET    CIFA1+1
  
 CIFB     BSS    0
          CON    03355134732416677076B   5**-325          UPPER 
          CON    01756003050311261572B  10**-256          UPPER 
          CON    05224437760335652043B  10**-192          UPPER 
          CON    10466735010637062274B  10**-128          UPPER 
          CON    13735207775211722471B  10** -64          UPPER 
          CON    0
          CON    22456047403722377717B  10**  64          UPPER 
          CON    25724473510762300351B  10** 128          UPPER 
          CON    31167007036743234447B  10** 192          UPPER 
          CON    30435247735376716771B   5** 256          UPPER 
  
          CON    02554430410147521675B   5**-325         MIDDLE 
          CON    01150623477244210525B  10**-256         MIDDLE 
          CON    04426300317330603243B  10**-192         MIDDLE 
          CON    07667112025437131766B  10**-128         MIDDLE 
          CON    13137232247710714327B  10** -64         MIDDLE 
          CON    0
          CON    21655155247457665561B  10**  64         MIDDLE 
          CON    25124315770633631554B  10** 128         MIDDLE 
          CON    30362526520556761123B  10** 192         MIDDLE 
          CON    27636750673556710033B   5** 256         MIDDLE 
  
          CON    01751523413613350414B   5**-325          LOWER 
          CON    00357757552302120270B  10**-256          LOWER 
          CON    03622142373563615574B  10**-192          LOWER 
          CON    07066405673367560600B  10**-128          LOWER 
          CON    12332173154211024710B  10** -64          LOWER 
          CON    0
          CON    21056166544576650371B  10**  64          LOWER 
          CON    24321553040115601066B  10** 128          LOWER 
          CON    27567507542405607432B  10** 192          LOWER 
          CON    27034617735255702442B   5** 256          LOWER 
  
  
 FSCALE   ENDX
