Seq # *Modification Id* Act
----------------------------+
00001 M00S00001.comccfd +++| CTEXT COMCCFD - CONSTANT TO F10.3 CONVERSION.
00002 M00S00002.comccfd +++| SPACE 4
00003 M00S00003.comccfd +++| IF -DEF,QUAL$,1
00004 M00S00004.comccfd +++| QUAL COMCCFD
00005 M00S00005.comccfd +++| BASE D
| Line S00006 Modification History |
M01 (Removed by) | 281l803 |
Seq # *Modification Id* Act
----------------------------+
00006 M01S00006.281l803 ---|* COMMENT COPYRIGHT CONTROL DATA CORP. 1971.
| Line S00001 Modification History |
M01 (Added by) | 281l803 |
Seq # *Modification Id* Act
----------------------------+
00007 M01S00001.281l803 +++|* COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
00008 M00S00007.comccfd +++| CFD SPACE 4
00009 M00S00008.comccfd +++|*** CFD - CONSTANT TO F10.3 DISPLAY CODE CONVERSION.
00010 M00S00009.comccfd +++|* J.C. BOHNHOFF. 71/08/15.
00011 M00S00010.comccfd +++|* ADAPTED FROM SUBROUTINE *RJA* IN CPUMTR.
00012 M00S00011.comccfd +++| SPACE 4
00013 M00S00012.comccfd +++|*** *CFD* CONVERTS A 30 BIT INTEGER TO DISPLAY CODE IN *FORTRAN*
00014 M00S00013.comccfd +++|* *F10.3* FORMAT. THE VALUE RETURNED IS EQUAL TO THE INPUT
00015 M00S00014.comccfd +++|* VALUE DIVIDED BY 1000D. THE RESULT IS RETURNED BOTH LEFT
00016 M00S00015.comccfd +++|* AND RIGHT JUSTIFIED AND LEADING ZEROS IN THE INTEGER PORTION
00017 M00S00016.comccfd +++|* ARE SUPPRESSED. IF THE 30 BIT NUMBER EXCEEDS 999999.999
00018 M00S00017.comccfd +++|* (INPUT EXCEEDS 7346544777B) THE RESULT WILL BE **********.
00019 M00S00018.comccfd +++|* AN INPUT VALUE GREATER THAN 30 BITS IS TRUNCATED TO THE
00020 M00S00019.comccfd +++|* LOWER 30 BITS.
00021 M00S00020.comccfd +++|*
00022 M00S00021.comccfd +++|* ENTRY (X1)= INTEGER TO BE CONVERTED.
00023 M00S00022.comccfd +++|* (B1)= 1.
00024 M00S00023.comccfd +++|*
00025 M00S00024.comccfd +++|* EXIT (X6)= CONVERSION RIGHT JUSTIFIED.
00026 M00S00025.comccfd +++|* (X4)= CONVERSION LEFT JUSTIFIED.
00027 M00S00026.comccfd +++|* (B3) = - (NUMBER OF BLANK CHARACTERS * 6).
00028 M00S00027.comccfd +++|*
00029 M00S00028.comccfd +++|* USES B - 2, 3, 4, 5.
00030 M00S00029.comccfd +++|* A - 2, 3, 4.
00031 M00S00030.comccfd +++|* X - 1, 2, 3, 4, 6, 7.
00032 M00S00031.comccfd +++|
00033 M00S00032.comccfd +++|
00034 M00S00033.comccfd +++| CFD3 SA4 CFDC GET OVERFLOW CONVERSION
00035 M00S00034.comccfd +++| SB3 B0
00036 M00S00035.comccfd +++| BX6 X4
00037 M00S00036.comccfd +++| CFD PS ENTRY/EXIT
00038 M00S00037.comccfd +++| SA2 CFDA =.1P48+1
00039 M00S00038.comccfd +++| SA3 CFDB =10.0P
00040 M00S00039.comccfd +++| SA4 A2+B1
00041 M00S00040.comccfd +++| MX6 -30
00042 M00S00041.comccfd +++| SB5 6
00043 M00S00042.comccfd +++| BX6 -X6*X1 DISCARD UPPER BITS
00044 M00S00043.comccfd +++| SX7 1000
00045 M00S00044.comccfd +++| IX4 X4-X6
00046 M00S00045.comccfd +++| SB4 1R0-1R (B4)= CONVERSION
00047 M00S00046.comccfd +++| NG X4,CFD3 IF INPUT .GT. 999999.999
00048 M00S00047.comccfd +++| SA4 A3+B1 (X4)= BACKGROUND
00049 M00S00048.comccfd +++| PX1 X6
00050 M00S00049.comccfd +++| IX7 X6-X7
00051 M00S00050.comccfd +++| SB2 -B5
00052 M00S00051.comccfd +++| PL X7,CFD1 IF INTEGER PRESENT
00053 M00S00052.comccfd +++| SB4 B0
00054 M00S00053.comccfd +++| SA4 A4+B1
00055 M00S00054.comccfd +++| CFD1 DX6 X2*X1 EXTRACT REMAINDER
00056 M00S00055.comccfd +++| FX1 X2*X1
00057 M00S00056.comccfd +++| UX7 X1 CHECK QUOTIENT
00058 M00S00057.comccfd +++| LX4 -6 SHIFT ASSEMBLY
00059 M00S00058.comccfd +++| SB2 B2+B5 ADVANCE SHIFT COUNT
00060 M00S00059.comccfd +++| FX6 X3*X6 EXTRACT DIGIT
00061 M00S00060.comccfd +++| SX6 X6+B4 CONVERT DIGIT
00062 M00S00061.comccfd +++| IX4 X6+X4
00063 M00S00062.comccfd +++| NZ X7,CFD1 LOOP TO ZERO QUOTIENT
00064 M00S00063.comccfd +++| SX3 1R. INSERT DECIMAL POINT
00065 M00S00064.comccfd +++| MX2 -18 FRACTION MASK
00066 M00S00065.comccfd +++| LX6 X4,B2 RIGHT JUSTIFY ASSEMBLY
00067 M00S00066.comccfd +++| SB2 B2+12 CALCULATE SHIFT TO LEFT JUSTIFY
00068 M00S00067.comccfd +++| LX3 18
00069 M00S00068.comccfd +++| BX1 -X2*X6 EXTRACT FRACTION
00070 M00S00069.comccfd +++| SB3 6*5
00071 M00S00070.comccfd +++| IX7 X1+X3 ADD DECIMAL POINT
00072 M00S00071.comccfd +++| BX4 X2*X6 EXTRACT INTEGER
00073 M00S00072.comccfd +++| LX4 6
00074 M00S00073.comccfd +++| IX6 X4+X7 ADD INTEGER INTO RESULT
00075 M00S00074.comccfd +++| LT B2,B3,CFD2 LEFT JUSTIFY RESULT
00076 M00S00075.comccfd +++| SB3 B2+
00077 M00S00076.comccfd +++| CFD2 SB3 B3-60
00078 M00S00077.comccfd +++| AX4 X6,B3
00079 M00S00078.comccfd +++| EQ CFD **RETURN
00080 M00S00079.comccfd +++|
00081 M00S00080.comccfd +++| CFDA CON 0.1P48+1
00082 M00S00081.comccfd +++| CON 7346544777B OVERFLOW BOUNDARY
00083 M00S00082.comccfd +++| CFDB CON 10.0P
00084 M00S00083.comccfd +++| CON 9L
00085 M00S00084.comccfd +++| CON 9L 0000
00086 M00S00085.comccfd +++| CFDC DATA 10R**********
00087 M00S00086.comccfd +++| SPACE 4
00088 M00S00087.comccfd +++| BASE *
00089 M00S00088.comccfd +++| QUAL$ IF -DEF,QUAL$
00090 M00S00089.comccfd +++| QUAL *
00091 M00S00090.comccfd +++| CFD EQU /COMCCFD/CFD
00092 M00S00091.comccfd +++| QUAL$ ENDIF
00093 M00S00092.comccfd +++| ENDX