COMCCFD 
COMMON
          CTEXT  COMCCFD - CONSTANT TO F10.3 CONVERSION.
          SPACE  4
          IF     -DEF,QUAL$,1 
          QUAL   COMCCFD
          BASE   D
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 CFD      SPACE  4
***       CFD - CONSTANT TO F10.3 DISPLAY CODE CONVERSION.
*         J.C. BOHNHOFF. 71/08/15.
*         ADAPTED FROM SUBROUTINE *RJA* IN CPUMTR.
          SPACE  4
***       *CFD* CONVERTS A 30 BIT INTEGER TO DISPLAY CODE IN *FORTRAN*
*         *F10.3* FORMAT.  THE VALUE RETURNED IS EQUAL TO THE INPUT 
*         VALUE DIVIDED BY 1000D.  THE RESULT IS RETURNED BOTH LEFT 
*         AND RIGHT JUSTIFIED AND LEADING ZEROS IN THE INTEGER PORTION
*         ARE SUPPRESSED.  IF THE 30 BIT NUMBER EXCEEDS 999999.999
*         (INPUT EXCEEDS 7346544777B) THE RESULT WILL BE **********.
*         AN INPUT VALUE GREATER THAN 30 BITS IS TRUNCATED TO THE 
*         LOWER 30 BITS.
* 
*         ENTRY  (X1)= INTEGER TO BE CONVERTED. 
*                (B1)= 1. 
* 
*         EXIT   (X6)= CONVERSION RIGHT JUSTIFIED.
*                (X4)= CONVERSION LEFT JUSTIFIED. 
*                (B3) = - (NUMBER OF BLANK CHARACTERS * 6). 
* 
*         USES   B - 2, 3, 4, 5.
*                A - 2, 3, 4. 
*                X - 1, 2, 3, 4, 6, 7.
  
  
 CFD3     SA4    CFDC        GET OVERFLOW CONVERSION
          SB3    B0 
          BX6    X4 
 CFD      PS                 ENTRY/EXIT 
          SA2    CFDA        =.1P48+1 
          SA3    CFDB        =10.0P 
          SA4    A2+B1
          MX6    -30
          SB5    6
          BX6    -X6*X1      DISCARD UPPER BITS 
          SX7    1000 
          IX4    X4-X6
          SB4    1R0-1R      (B4)= CONVERSION 
          NG     X4,CFD3     IF INPUT .GT. 999999.999 
          SA4    A3+B1       (X4)= BACKGROUND 
          PX1    X6 
          IX7    X6-X7
          SB2    -B5
          PL     X7,CFD1     IF INTEGER PRESENT 
          SB4    B0 
          SA4    A4+B1
 CFD1     DX6    X2*X1       EXTRACT REMAINDER
          FX1    X2*X1
          UX7    X1          CHECK QUOTIENT 
          LX4    -6          SHIFT ASSEMBLY 
          SB2    B2+B5       ADVANCE SHIFT COUNT
          FX6    X3*X6       EXTRACT DIGIT
          SX6    X6+B4       CONVERT DIGIT
          IX4    X6+X4
          NZ     X7,CFD1     LOOP TO ZERO QUOTIENT
          SX3    1R.         INSERT DECIMAL POINT 
          MX2    -18         FRACTION MASK
          LX6    X4,B2       RIGHT JUSTIFY ASSEMBLY 
          SB2    B2+12       CALCULATE SHIFT TO LEFT JUSTIFY
          LX3    18 
          BX1    -X2*X6      EXTRACT FRACTION 
          SB3    6*5
          IX7    X1+X3       ADD DECIMAL POINT
          BX4    X2*X6       EXTRACT INTEGER
          LX4    6
          IX6    X4+X7       ADD INTEGER INTO RESULT
          LT     B2,B3,CFD2  LEFT JUSTIFY RESULT
          SB3    B2+
 CFD2     SB3    B3-60
          AX4    X6,B3
          EQ     CFD         **RETURN 
  
 CFDA     CON    0.1P48+1 
          CON    7346544777B OVERFLOW BOUNDARY
 CFDB     CON    10.0P
          CON    9L 
          CON    9L     0000
 CFDC     DATA   10R**********
          SPACE  4
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 CFD      EQU    /COMCCFD/CFD 
 QUAL$    ENDIF 
          ENDX
