PROGRAM DRIVR(INPUT,OUTPUT,TAPE6=OUTPUT,TAPE9) DRVR0001 CALCOMP HCBS PN 54S711000 FOR CDC 6000 SERIES JUNE 2 1970 DRVR0002 COPYRIGHT 1970 CALIFORNIA COMPUTER PRODUCTS INC. DRVR0003 LDEV=9 DRVR0004 CALL PLOTS(0,0,LDEV) DRVR0005 CALL TABLE DRVR0006 CALL SAMP1 DRVR0007 CALL SAMP2 DRVR0008 CALL PLOT(0.0,0.0,999) DRVR0009 STOP DRVR0010 END DRVR0011 SUBROUTINE TABLE TABL0001 CALCOMP HCBS PN 54S711000 FOR CDC 6000 SERIES JUNE 2 1970 TABL0002 COPYRIGHT 1970 CALIFORNIA COMPUTER PRODUCTS INC. TABL0003 IZERO=27 TABL0004 CALL PLOT(0.0,11.,3) TABL0005 CALL PLOT(8.5,11.,2) TABL0006 CALL PLOT(8.5,0.0,2) TABL0007 CALL PLOT(0.0,0.0,2) TABL0008 CALL PLOT(0.0,11.,2) TABL0009 CALL SYMBOL(1.6,10.7,.14,38HCHARACTERS AVAILABLE IN SYMBOL ROUTINETABL0010 1,0.0,38) TABL0011 CALL SYMBOL(2.2,10.4,.14,28HFOR CALCOMP 900 AND CDC 6600,0.0,28) TABL0012 CALL SYMBOL(2.4,10.1,.10,38HINTERNAL EQUIVALENT ON LEFT OF SYMBOL TABL0013 1,0.0,38) TABL0014 CALL PLOT(8.25,10.0,3) TABL0015 CALL PLOT(0.25,10.0,2) TABL0016 CALL PLOT(0.25,0.25,2) TABL0017 CALL PLOT(8.25,0.25,2) TABL0018 X=0.25 TABL0019 IC=0 TABL0020 IA=IZERO-1 TABL0021 DO 200 I=1,4 TABL0022 Y=9.4 TABL0023 DO 100 J=1,2 TABL0024 IA=IA+1 TABL0025 IB=IZERO-1 TABL0026 DO 100 K=1,8 TABL0027 IB=IB+1 TABL0028 CALL SYMBOL(X+.50,Y+.2,.14,IA,0.0,0) TABL0029 CALL SYMBOL(X+.65,Y+.2,.14,IB,0.0,0) TABL0030 CALL SYMBOL(X+1.25,Y ,.49,IC,0.0,0) TABL0031 IC=IC+1 TABL0032 100 Y=Y-.6 TABL0033 X=X+2.0 TABL0034 CALL PLOT(X,0.25,3) TABL0035 200 CALL PLOT(X,10.0,2) TABL0036 CALL PLOT(10.0,0.0,-3) TABL0037 CALL PLOT(0.0,11.0,3) TABL0038 CALL PLOT(8.5,11.0,2) TABL0039 CALL PLOT(8.5, 0.0,2) TABL0040 CALL PLOT(0.0, 0.0,2) TABL0041 CALL PLOT(0.0,11.0,2) TABL0042 CALL SYMBOL(.75,10.5,0.14,50HASCII CHARACTERS AVAILABLE WITH THE STABL0043 1YMBOL ROUTINE,0.0,50) TABL0044 CALL SYMBOL(.8,10.2,0.1,69HCODE NEXT TO EACH SYMBOL IS INTEGER CODTABL0045 1E USED IN SPECIAL SYMBOL CALL.,0.0,69) TABL0046 CALL PLOT(8.25,10.0,3) TABL0047 CALL PLOT(0.25,10.0,2) TABL0048 CALL PLOT(0.25,0.25,2) TABL0049 CALL PLOT(8.25,0.25,2) TABL0050 X = 0.35 TABL0051 M = 0 TABL0052 DO 50 I=1,8 TABL0053 Y = 9.4 TABL0054 DO 40 J=1,16 TABL0055 Z = M TABL0056 CALL NUMBER(X,Y+.2,0.1,Z,0.0,-1) TABL0057 IF(M - 15)10,10,20 TABL0058 10 CALL SYMBOL(X+.6,Y+.25,0.4,M,0.0,-1) TABL0059 GO TO 30 TABL0060 20 CALL SYMBOL(X+.4,Y,0.42,M,0.0,-1) TABL0061 30 M = M + 1 TABL0062 40 Y = Y - 0.6 TABL0063 CALL PLOT(X+.9,.25,3) TABL0064 CALL PLOT(X+.9,10.0,2) TABL0065 50 X = X + 1.0 TABL0066 CALL PLOT(10.0,0.0,-3) TABL0067 RETURN TABL0068 END TABL0069 SUBROUTINE SAMP1 SAMP1001 CALCOMP HCBS PN 54S711000 FOR CDC 6000 SERIES JUNE 2 1970 SAMP1002 COPYRIGHT 1970 CALIFORNIA COMPUTER PRODUCTS INC. SAMP1003 C SAMPLE ROUTINE NUMBER 1 SAMP1004 C SAMPLE PROGRAM NUMBER 1 SAMP1005 DIMENSION XARRAY(62),YARRAY(62) SAMP1006 CALL PLOT(0.0,-.5,3) SAMP1007 C PLOT FOUR GRAPHS ILLUSTRATING SCALE,AXIS,AND LINE SAMP1008 DELTAX=0.02 SAMP1009 DO 110 I=1,4 SAMP1010 DELTAX=2.0*DELTAX SAMP1011 XARRAY(1)=DELTAX SAMP1012 DO 105 J=1,60 SAMP1013 YARRAY(J)=XARRAY(J)**2-0.7*XARRAY(J)**3+0.1*XARRAY(J)**4 SAMP1014 105 XARRAY(J+1)=XARRAY(J)+DELTAX SAMP1015 CALL SCALE(XARRAY(1), 6.5,60,1) SAMP1016 CALL SCALE(YARRAY(1),10.0,60,1) SAMP1017 CALL AXIS(0.0,0.0,16HX-AXIS(ABSCISSA),-16, 6.5, 0.0,XARRAY(61), SAMP1018 1 XARRAY(62)) SAMP1019 CALL AXIS(0.0,0.0,16HY-AXIS(ORDINATE), 16,10.0,90.0,YARRAY(61), SAMP1020 1 YARRAY(62)) SAMP1021 CALL NEWPEN(I) SAMP1022 CALL LINE(XARRAY(1),YARRAY(1),60,1,2*(I-3),I) SAMP1023 CALL NEWPEN(1) SAMP1024 CALL SYMBOL(0.25,10.0,0.14,43HTHIS GRAPH WAS PLOTTED ON A CALCOMSAMP1025 1P PLOTTER,0.0,43) SAMP1026 CALL SYMBOL(0.40, 9.7,0.14,40HTHE EQUATION USED IS Y = X -0.7*X SAMP1027 1+0.1*X,0.0,40) SAMP1028 CALL NUMBER(4.04,9.8,0.1,2.0,0.0,-1) SAMP1029 CALL NUMBER(5.02,9.8,0.1,3.0,0.0,-1) SAMP1030 CALL NUMBER(6.0 ,9.8,0.1,4.0,0.0,-1) SAMP1031 110 CALL PLOT(10.0,0.0,-3) SAMP1032 C PLOT ANGULAR LETTER TEST SAMP1033 CALL PLOT(4.5,5.5,-3) SAMP1034 THETA=0.0 SAMP1035 HEIGHT=0.105 SAMP1036 DO 120 I=1,8 SAMP1037 CALL NEWPEN(I) SAMP1038 RAD=0.0174533*THETA SAMP1039 XX=0.5*COS (RAD) SAMP1040 YY=0.5*SIN (RAD) SAMP1041 CALL SYMBOL(XX ,YY ,HEIGHT,4HTH= ,THETA, 4) SAMP1042 CALL NUMBER(999.0,999.0,HEIGHT,THETA ,THETA,-1) SAMP1043 CALL SYMBOL(999.0,999.0,HEIGHT,4H, H=,THETA, 4) SAMP1044 CALL NUMBER(999.0,999.0,HEIGHT,HEIGHT,THETA, 3) SAMP1045 HEIGHT=HEIGHT+0.035 SAMP1046 120 THETA=THETA+45.0 SAMP1047 CALL NEWPEN(1) SAMP1048 CALL SYMBOL(-1.4,4.0,0.14,19HANGULAR LETTER TEST,0.0,19) SAMP1049 CALL PLOT( 4.5, 5.0,3) SAMP1050 CALL PLOT(-4.5, 5.0,2) SAMP1051 CALL PLOT(-4.5,-5.5,2) SAMP1052 CALL PLOT( 4.5,-5.5,2) SAMP1053 CALL PLOT( 4.5, 5.0,2) SAMP1054 CALL PLOT( 6.5,-5.5,-3) SAMP1055 C PLOT CAR VALUE CHART WITHOUT USING SCALE,AXIS,OR LINE SAMP1056 X=1.0 SAMP1057 C PLOT X-AXIS SAMP1058 DO 130 I=1,7 SAMP1059 CALL PLOT(X-1.0,0.0,3) SAMP1060 CALL PLOT(X , 0.0,2) SAMP1061 CALL PLOT(X ,-0.1,2) SAMP1062 CALL NUMBER(X-.02,-0.25,0.1,X,0.0,-1) SAMP1063 130 X=X+1.0 SAMP1064 CALL SYMBOL(2.0,-0.5,0.14,21HCAR MODEL AGE (YEARS),0.0,21) SAMP1065 C PLOT Y-AXIS SAMP1066 VALUE=1000.0 SAMP1067 DO 140 I=1,6 SAMP1068 Y=0.0015*VALUE SAMP1069 CALL PLOT(0.0,Y-1.5,3) SAMP1070 CALL PLOT(0.0,Y-.75,2) SAMP1071 CALL PLOT(-.1,Y-.75,2) SAMP1072 CALL PLOT(0.0,Y-.75,2) SAMP1073 CALL PLOT(0.0,Y ,2) SAMP1074 CALL PLOT(-.1,Y ,2) SAMP1075 CALL NUMBER(-0.7,Y,0.14,VALUE,0.0,-1) SAMP1076 140 VALUE=VALUE+1000.0 SAMP1077 CALL SYMBOL(-0.8,3.1,0.14,19HCAR VALUE (DOLLARS),90.0,19) SAMP1078 C PLOT CURVES SAMP1079 CALL NEWPEN(2) SAMP1080 DO 150 I=2000,6000,500 SAMP1081 VALUE=I SAMP1082 AGE=0.0 SAMP1083 CALL PLOT(AGE,0.0015*VALUE,3) SAMP1084 DO 150 J=1,84 SAMP1085 VALUE=VALUE*0.972 SAMP1086 AGE=AGE+0.08333 SAMP1087 150 CALL PLOT(AGE,0.0015*VALUE,2) SAMP1088 CALL NEWPEN(3) SAMP1089 CALL SYMBOL(3.0,6.0,0.21,17HAVERAGE CAR VALUE,0.0,17) SAMP1090 CALL NEWPEN(1) SAMP1091 CALL PLOT(9.0,0.0,-3) SAMP1092 RETURN SAMP1093 END SAMP1094 SUBROUTINE SAMP2 SAMP2001 CALCOMP HCBS PN 54S711000 FOR CDC 6000 SERIES JUNE 2 1970 SAMP2002 COPYRIGHT 1970 CALIFORNIA COMPUTER PRODUCTS INC. SAMP2003 C SAMPLE ROUTINE NUMBER 2 SAMP2004 C SAMPLE PROGRAM NUMBER 2 SAMP2005 CALL PLOT(0.0,-0.5,3) SAMP2006 C PLOT X-AXIS FOR WIDTH SAMP2007 X=0.0 SAMP2008 DO 210 I=1,10 SAMP2009 CALL PLOT(X,0.0,3) SAMP2010 X=X+1.0 SAMP2011 CALL PLOT(X,0.0,2) SAMP2012 CALL PLOT(X,-.1,2) SAMP2013 210 CALL NUMBER(X,-0.25,0.1,5.0*X,0.0,-1) SAMP2014 CALL SYMBOL(4.0,-0.40,0.12,1,0.0,-1) SAMP2015 CALL SYMBOL(4.2,-0.45,0.14,10HWIDTH (FT),0.0,10) SAMP2016 CALL PLOT (0.0,0.5,-3) SAMP2017 C PLOT X-AXIS FOR THICKNESS SAMP2018 X=0.0 SAMP2019 DO 220 I=1,5 SAMP2020 CALL PLOT(X,0.0,3) SAMP2021 X=X+1.0 SAMP2022 CALL PLOT(X,0.0,2) SAMP2023 CALL PLOT(X,-.1,2) SAMP2024 CALL PLOT(X,0.0,2) SAMP2025 X=X+1.0 SAMP2026 CALL PLOT(X,0.0,2) SAMP2027 CALL PLOT(X,-.1,2) SAMP2028 220 CALL NUMBER(X,-0.25,0.1,X,0.0,-1) SAMP2029 CALL SYMBOL(3.7,-0.40,0.12,7,0.0,-1) SAMP2030 CALL SYMBOL(4.0,-0.45,0.14,14HTHICKNESS (IN),0.0,14) SAMP2031 C PLOT Y-AXIS SAMP2032 Y=0.0 SAMP2033 DO 230 I=1,9 SAMP2034 CALL PLOT(0.0,Y,3) SAMP2035 Y=Y+1.0 SAMP2036 CALL PLOT(0.0,Y,2) SAMP2037 CALL PLOT(-.1,Y,2) SAMP2038 230 CALL NUMBER(-.15,Y-.2,0.1,1000.*Y,90.0,0) SAMP2039 CALL SYMBOL(-0.30,3.5,0.14,14HPRESSURE (PSI),90.0,14) SAMP2040 THICK=3.0 SAMP2041 WIDTH=25.0 SAMP2042 DO 260 I=1,3 SAMP2043 TSQR=THICK*THICK SAMP2044 WSQR=WIDTH*WIDTH SAMP2045 PSI=100.99*TSQR SAMP2046 CALL SYMBOL(0.6,PSI/1000.0,0.1,5HTHK= ,0.0,5) SAMP2047 CALL NUMBER(999.0,999.0,0.10,THICK,0.0,0) SAMP2048 CALL SYMBOL(999.0,999.0,0.10,4H IN.,0.0,4) SAMP2049 CALL SYMBOL( 2.0 ,999.0,0.12,1,0.0,-1) SAMP2050 DO 240 J=10,50 SAMP2051 WX=J SAMP2052 PSI=10099.0*TSQR/(WX*WX) SAMP2053 240 CALL PLOT(WX/5.0,PSI/1000.0,2) SAMP2054 PSI=10099.0*81.0/WSQR SAMP2055 CALL SYMBOL(9.2,PSI/1000.0,0.1,5HWTH= ,0.0,5) SAMP2056 CALL NUMBER(999.0,999.0,0.10,WIDTH,0.0,0) SAMP2057 CALL SYMBOL(999.0,999.0,0.10,4H FT.,0.0,4) SAMP2058 CALL SYMBOL( 9.0 ,999.0,0.12,7,0.0,-1) SAMP2059 DO 250 J=5,50 SAMP2060 TX=J SAMP2061 TX=(50.0-TX)/5.0 SAMP2062 PSI=10099.0*TX*TX/WSQR SAMP2063 250 CALL PLOT(TX,PSI/1000.0,2) SAMP2064 THICK=THICK+3.0 SAMP2065 260 WIDTH=WIDTH-5.0 SAMP2066 CALL SYMBOL(3.3 ,8.5 ,0.14,31HCRITICAL BUCKLING PRESSURE OF A SAMP2067 1,0.0,31) SAMP2068 CALL SYMBOL(3.0 ,8.2 ,0.14,36HHYPERBOLIC PARABOLOID STEEL SHELL OFSAMP2069 1,0.0,36) SAMP2070 CALL SYMBOL(3.0 ,7.9 ,0.14,36HFIXED WIDTH AND VARYING THICKNESS ORSAMP2071 1,0.0,36) SAMP2072 CALL SYMBOL(3.15,7.6 ,0.14,33HFIXED THICKNESS AND VARYING WIDTH SAMP2073 1,0.0,33) SAMP2074 CALL SYMBOL(3.45,7.0 ,0.14,29HPREPARED ON A CALCOMP PLOTTER SAMP2075 1,0.0,29) SAMP2076 CALL PLOT(12.0,-0.5,-3) SAMP2077 RETURN SAMP2078 END SAMP2079 SUBROUTINE SCALE (ARRAY,AXLEN,NPTS,INC) SCAL0001 CALCOMP HCBS PN 54S711000 FOR CDC 6000 SERIES JUNE 2 1970 SCAL0002 COPYRIGHT 1970 CALIFORNIA COMPUTER PRODUCTS INC. SCAL0003 C..... ARRAY NAME OF ARRAY CONTAINING VALUES TO BE SCALED. SCAL0004 C..... AXLEN LENGTH IN INCHES OVER WHICH ARRAY IS TO BE SCALED. SCAL0005 C..... NPTS NUMBER OF POINTS TO BE SCALED. SCAL0006 C..... INC INCREMENT OF LOCATION OF SUCCESSIVE POINTS. SCAL0007 DIMENSION ARRAY(1),SAVE(7) SCAL0008 SAVE(1)=1.0 SCAL0009 SAVE(2)=2.0 SCAL0010 SAVE(3)=4.0 SCAL0011 SAVE(4)=5.0 SCAL0012 SAVE(5)=8.0 SCAL0013 SAVE(6)=10.0 SCAL0014 SAVE(7)=20. SCAL0015 FAD=0.01 SCAL0016 K=IABS(INC) SCAL0017 N=NPTS*K SCAL0018 Y0=ARRAY(1) SCAL0019 YN=Y0 SCAL0020 DO 25 I=1,N,K SCAL0021 YS=ARRAY(I) SCAL0022 IF (Y0-YS) 22,22,21 SCAL0023 21 Y0=YS SCAL0024 GO TO 25 SCAL0025 22 IF (YS-YN) 25,25,24 SCAL0026 24 YN=YS SCAL0027 25 CONTINUE SCAL0028 FIRSTV=Y0 SCAL0029 IF (Y0) 34,35,35 SCAL0030 34 FAD=FAD-1.0 SCAL0031 35 DELTAV=(YN-FIRSTV)/AXLEN SCAL0032 IF (DELTAV) 70,70,40 SCAL0033 40 I=ALOG10(DELTAV)+1000.0 SCAL0034 P=10.0**(I-1000) SCAL0035 DELTAV=DELTAV/P-0.01 SCAL0036 DO 45 I=1,6 SCAL0037 IS=I SCAL0038 IF (SAVE(I)-DELTAV) 45,50,50 SCAL0039 45 CONTINUE SCAL0040 50 DELTAV=SAVE(IS)*P SCAL0041 FIRSTV=DELTAV*AINT(Y0/DELTAV+FAD) SCAL0042 T=FIRSTV+(AXLEN+0.01)*DELTAV SCAL0043 IF (T-YN) 55,57,57 SCAL0044 55 FIRSTV=P*AINT(Y0/P+FAD) SCAL0045 T=FIRSTV+(AXLEN+.01)*DELTAV SCAL0046 IF (T-YN) 56,57,57 SCAL0047 56 IS=IS+1 SCAL0048 GO TO 50 SCAL0049 57 FIRSTV=FIRSTV-AINT((AXLEN+(FIRSTV-YN)/DELTAV)/2.0)*DELTAV SCAL0050 IF (Y0*FIRSTV) 58,58,59 SCAL0051 58 FIRSTV=0.0 SCAL0052 59 IF (INC) 61,61,65 SCAL0053 61 FIRSTV=FIRSTV+AINT(AXLEN+.5)*DELTAV SCAL0054 DELTAV=-DELTAV SCAL0055 65 N=N+1 SCAL0056 ARRAY(N)=FIRSTV SCAL0057 N=N+K SCAL0058 ARRAY(N)=DELTAV SCAL0059 67 RETURN SCAL0060 70 DELTAV=2.0*FIRSTV SCAL0061 DELTAV=ABS(DELTAV/AXLEN)+1. SCAL0062 GO TO 40 SCAL0063 END SCAL0064 SUBROUTINE LINE (XARRAY,YARRAY,NPTS,INC,LINTYP,INTEQ) LINE0001 CALCOMP HCBS PN 54S711000 FOR CDC 6000 SERIES JUNE 2 1970 LINE0002 COPYRIGHT 1970 CALIFORNIA COMPUTER PRODUCTS INC. LINE0003 C..... XARRAY NAME OF ARRAY CONTAINING ABSCISSA OR X VALUES. LINE0004 C..... YARRAY NAME OF ARRAY CONTAINING ORDINATE OR Y VALUES. LINE0005 C..... NPTS NUMBER OF POINTS TO BE PLOTTED. LINE0006 C..... INC INCREMENT OF LOCATION OF SUCCESSIVE POINTS. LINE0007 C..... LINTYP CONTROL TYPE OF LINE--SYMBOLS, LINE, OR COMBINATION. LINE0008 C..... INTEQ INTEGER EQUIVALENT OF SYMBOL TO BE USED, IF ANY. LINE0009 DIMENSION XARRAY(1),YARRAY(1) LINE0010 LMIN = NPTS*INC+1 LINE0011 LDX = LMIN+INC LINE0012 NL = LMIN-INC LINE0013 FIRSTX = XARRAY(LMIN) LINE0014 DELTAX = XARRAY(LDX) LINE0015 FIRSTY = YARRAY(LMIN) LINE0016 DELTAY = YARRAY(LDX) LINE0017 CALL WHERE (XN,YN,DF) LINE0018 DF=AMAX1(ABS((XARRAY( 1)-FIRSTX)/DELTAX-XN), LINE0019 1 ABS((YARRAY( 1)-FIRSTY)/DELTAY-YN) ) LINE0020 DL=AMAX1(ABS((XARRAY(NL)-FIRSTX)/DELTAX-XN), LINE0021 1 ABS((YARRAY(NL)-FIRSTY)/DELTAY-YN) ) LINE0022 IPEN = 3 LINE0023 ICODE = -1 LINE0024 NT =IABS(LINTYP) LINE0025 IF (LINTYP) 7,6,7 LINE0026 6 NT = 1 LINE0027 7 IF (DF-DL) 9,9,8 LINE0028 8 NF = NL LINE0029 NA = ((NPTS-1)/NT)*NT+NT-(NPTS-1) LINE0030 KK = -INC LINE0031 GO TO 10 LINE0032 9 NF = 1 LINE0033 NA = NT LINE0034 KK = INC LINE0035 10 IF (LINTYP) 11,12,13 LINE0036 11 IPENA = 3 LINE0037 ICODEA = -1 LINE0038 LSW = 1 LINE0039 GO TO 15 LINE0040 12 NA=LDX LINE0041 13 IPENA = 2 LINE0042 ICODEA = -2 LINE0043 LSW=0 LINE0044 15 DO 30 I =1,NPTS LINE0045 XN = (XARRAY(NF)-FIRSTX)/DELTAX LINE0046 YN = (YARRAY(NF)-FIRSTY)/DELTAY LINE0047 IF (NA-NT) 20,21,22 LINE0048 20 IF (LSW) 23,22,23 LINE0049 21 CALL SYMBOL (XN,YN,0.2,INTEQ,0.0,ICODE) LINE0050 NA = 1 LINE0051 GO TO 25 LINE0052 22 CALL PLOT (XN,YN,IPEN) LINE0053 23 NA = NA + 1 LINE0054 25 NF = NF+KK LINE0055 ICODE = ICODEA LINE0056 30 IPEN = IPENA LINE0057 RETURN LINE0058 END LINE0059 SUBROUTINE AXIS(XPAGE,YPAGE,IBCD,NCHAR,AXLEN,ANGLE,FIRSTV,DELTAV) AXIS0001 CALCOMP HCBS PN 54S711000 FOR CDC 6000 SERIES JUNE 2 1970 AXIS0002 COPYRIGHT 1970 CALIFORNIA COMPUTER PRODUCTS INC. AXIS0003 C..... XPAGE,YPAGE COORDINATES OF STARTING POINT OF AXIS, IN CM AXIS0004 C..... IBCD AXIS TITLE. AXIS0005 C..... NCHAR NUMBER OF CHARACTERS IN TITLE. + FOR C.C-W SIDE.AXIS0006 C..... AXLEN FLOATING POINT AXIS LENGTH IN CM . AXIS0007 C..... ANGLE ANGLE OF AXIS FROM THE X-DIRECTION, IN DEGREES. AXIS0008 C..... FIRSTV SCALE VALUE AT THE FIRST TIC MARK. AXIS0009 C..... DELTAV CHANGE IN SCALE BETWEEN TIC MARKS ONE CM APARTAXIS0010 DIMENSION IBCD(2) AXIS0011 KN=NCHAR AXIS0012 A=1.0 AXIS0013 IF (KN) 1,2,2 AXIS0014 1 A=-A AXIS0015 KN=-KN AXIS0016 2 EX=0.0 AXIS0017 ADX= ABS (DELTAV) AXIS0018 IF (ADX) 3,7,3 AXIS0019 3 IF (ADX- 99.0) 6,4,4 AXIS0020 4 ADX=ADX/10.0 AXIS0021 EX=EX+1.0 AXIS0022 GO TO 3 AXIS0023 5 ADX=ADX*10.0 AXIS0024 EX=EX-1.0 AXIS0025 6 IF (ADX-0.01) 5,7,7 AXIS0026 7 XVAL=FIRSTV*10.0**(-EX) AXIS0027 ADX= DELTAV*10.0**(-EX) AXIS0028 STH=ANGLE*0.0174533 AXIS0029 CTH=COS(STH) AXIS0030 STH=SIN(STH) AXIS0031 DXB=-0.25 AXIS0032 DYB=0.375*A-0.125 AXIS0033 XN=XPAGE+DXB*CTH-DYB*STH AXIS0034 YN=YPAGE+DYB*CTH+DXB*STH AXIS0035 NTIC=AXLEN+1.0 AXIS0036 NT=NTIC/4 AXIS0037 DO 20 I=1,NTIC,2 AXIS0038 CALL NUMBER(XN,YN,0.21,XVAL,ANGLE,2) AXIS0039 XVAL=XVAL+ADX*2. AXIS0040 XN=XN+CTH*2.0 AXIS0041 YN=YN+STH*2.0 AXIS0042 IF (NT) 20,11,20 AXIS0043 11 Z=KN AXIS0044 IF (EX) 12,13,12 AXIS0045 12 Z=Z+7.0 AXIS0046 13 DXB=AXLEN*0.5-0.175*Z AXIS0047 DYB=0.8*A-0.2 AXIS0048 XT=XPAGE+DXB*CTH-DYB*STH AXIS0049 YT=YPAGE+DYB*CTH+DXB*STH AXIS0050 CALL SYMBOL(XT,YT,0.35,IBCD(1),ANGLE,KN) AXIS0051 IF (EX) 14,20,14 AXIS0052 14 Z=KN+2 AXIS0053 XT=XT+Z*CTH*0.35 AXIS0054 YT=YT+Z*STH*0.35 AXIS0055 CALL SYMBOL(XT,YT,0.35,3H*10,ANGLE,3) AXIS0056 XT=XT+(3.0*CTH-0.8*STH)*0.35 AXIS0057 YT=YT+(3.0*STH+0.8*CTH)*0.35 AXIS0058 CALL NUMBER(XT,YT,0.21,EX,ANGLE,-1) AXIS0059 20 NT=NT-1 AXIS0060 CALL PLOT(XPAGE+AXLEN*CTH,YPAGE+AXLEN*STH,3) AXIS0061 DXB=-0.21*A*STH AXIS0062 DYB=+0.21*A*CTH AXIS0063 A=NTIC-1 AXIS0064 XN=XPAGE+A*CTH AXIS0065 YN=YPAGE+A*STH AXIS0066 DO 30 I=1,NTIC AXIS0067 CALL PLOT(XN,YN,2) AXIS0068 CALL PLOT(XN+DXB,YN+DYB,2) AXIS0069 CALL PLOT(XN,YN,2) AXIS0070 XN=XN-CTH AXIS0071 YN=YN-STH AXIS0072 30 CONTINUE AXIS0073 RETURN AXIS0074 END AXIS0075 CALCOMP HCBS PN 54S711000 FOR CDC 6000 SERIES JUNE 2 1970 SYMB0002 COPYRIGHT 1970 CALIFORNIA COMPUTER PRODUCTS INC. SYMB0003 DIMENSION IBCD(1) SYMB0004 DATA OLDTH,OLDFT/2*999.0/,XO,YO,XNC/3*0.0/,ICENT/15/ SYMB0005 C SYMB0006 C ((2**NBC-1)/NCW)*NCW NCS/NCW SYMB0007 C V V SYMB0008 SINTH=SIN(TH1) SYMB0040 COSTH=COS(TH1) SYMB0041 425 OLDFT=FCT SYMB0042 SUBROUTINE SYMBOL (XPAGE,YPAGE,HEIGH,IBCD,ANGLE,NCHAR) SYMB0001 445 ICNT=NC+8 SYMB0048 CALL BUFF(ICNT,ICNT,-1) SYMB0049 CALL PLOT(XA,YA,IC) SYMB0050 IF (NT) 500,450,470 SYMB0051 450 NCNT=-1 SYMB0052 GO TO 500 SYMB0053 470 NCNT=NC SYMB0054 IF (NT-1000) 500,450,480 SYMB0055 480 NCNT=-NC SYMB0056 500 CALL BUFF (IBCD(II),NCNT,1) SYMB0057 NT=NT-NC SYMB0058 IF (NT) 600,600,510 SYMB0059 510 IF(NT-1000)530,600,520 SYMB0060 520 II=II+NCS SYMB0061 NC=NT-1000 SYMB0062 GO TO 430 SYMB0063 530 II=II+NWS SYMB0064 NC=NT SYMB0065 GO TO 430 SYMB0066 600 RETURN SYMB0067 END SYMB0068 SUBROUTINE WHERE(XPAGE,YPAGE,RFACT) WHER0001 CALCOMP HCBS PN 54S711000 FOR CDC 6000 SERIES JUNE 2 1970 WHER0002 COPYRIGHT 1970 CALIFORNIA COMPUTER PRODUCTS INC. WHER0003 CALL PLOT(XPAGE,YPAGE,1001) WHER0004 CALL PLOT(RFACT,RFACT,1002) WHER0005 RETURN WHER0006 END WHER0007 SUBROUTINE NUMBER (XPAGE,YPAGE,HEIGHT,FPN,ANGLE,NDEC) NUMB0001 CALCOMP HCBS PN 54S711000 FOR CDC 6000 SERIES JUNE 2 1970 NUMB0002 COPYRIGHT 1970 CALIFORNIA COMPUTER PRODUCTS, INC. NUMB0003 C..... XPAGE,YPAGE COORDINATES OF LOWER LEFT CORNER OF NUMBER. NUMB0004 C..... HEIGHT HEIGHT OF PLOTTED NUMBER. NUMB0005 C..... FPN FLOATING POINT NUMBER TO BE PLOTTED. NUMB0006 C..... ANGLE ANGLE AT WHICH NUMBER IS PLOTTED, IN DEGREES. NUMB0007 C..... NDEC NUMBER OF DECIMAL PLACES TO BE DRAWN. NUMB0008 C..... THIS VERSION OF NUMBER REQUIRES THE SYMBOL VERSION WITH NUMB0009 C..... 999. X, Y FEATURE, AND NC = 0 FEATURE. NUMB0010 DIMENSION NUM(20) NUMB0011 DATA MINUS/38/,IPER/47/,IZERO/27/ NUMB0012 II=0 NUMB0013 FPV = FPN NUMB0014 N = NDEC NUMB0015 MAXN = 9 NUMB0016 IF (N - MAXN) 11, 11, 10 NUMB0017 10 N = MAXN NUMB0018 11 IF (N + MAXN) 12, 20, 20 NUMB0019 12 N = -MAXN NUMB0020 20 IF (FPV) 21, 30, 30 NUMB0021 21 II=II+1 NUMB0022 NUM(II)=MINUS NUMB0023 30 MN = -N NUMB0024 IF (N) 31, 32, 32 NUMB0025 31 MN = MN - 1 NUMB0026 32 FPV = ABS(FPV) + (0.5 * 10. ** MN) NUMB0027 I = ALOG10(FPV) + 1.0 NUMB0028 ILP = I NUMB0029 IF (N + 1) 40, 41, 41 NUMB0030 40 ILP = ILP + N + 1 NUMB0031 41 IF (ILP) 50, 50, 51 NUMB0032 50 II=II+1 NUMB0033 NUM(II)=IZERO NUMB0034 GO TO 61 NUMB0035 51 IF (ILP+N-18) 54,54,52 NUMB0036 52 N=-1 NUMB0037 IF (ILP-19) 54,54,53 NUMB0038 53 ILP=19 NUMB0039 54 DO 60 J=1,ILP NUMB0040 K = FPV * 10. ** (J - I) NUMB0041 II=II+1 NUMB0042 NUM(II)=K+IZERO NUMB0043 FPV = FPV - (FLOAT(K) * 10. ** (I - J)) NUMB0044 60 CONTINUE NUMB0045 61 IF (N) 99, 70, 70 NUMB0046 70 II=II+1 NUMB0047 NUM(II)=IPER NUMB0048 IF (N) 99, 99, 80 NUMB0049 80 DO 90 J = 1, N NUMB0050 K = FPV * 10. NUMB0051 II=II+1 NUMB0052 NUM(II)=K+IZERO NUMB0053 90 FPV = FPV * 10. - FLOAT(K) NUMB0054 99 CALL SYMBOL (XPAGE,YPAGE,HEIGHT,NUM,ANGLE,II+1000) NUMB0055 RETURN NUMB0056 END NUMB0057 SUBROUTINE FACTOR(FACT) FACT0001 CALCOMP HCBS PN 54S711000 FOR CDC 6000 SERIES JUNE 2 1970 FACT0002 COPYRIGHT 1970 CALIFORNIA COMPUTER PRODUCTS INC. FACT0003 CALL PLOT (FACT,FACT,1000) FACT0004 RETURN FACT0005 END FACT0006 SUBROUTINE NEWPEN(INP) NEWP0001 CALCOMP HCBS PN 54S711000 FOR CDC 6000 SERIES JUNE 2 1970 NEWP0002 COPYRIGHT 1970 CALIFORNIA COMPUTER PRODUCTS INC. NEWP0003 C THIS SUBROUTINE SELECTS A PEN ON 718/7180 PLOTTERS. NEWP0004 DATA IOLDPN/1/ NEWP0005 INP1 = INP NEWP0006 IF (INP - IOLDPN) 15,99,15 NEWP0007 15 INP1 = MOD(INP1,9) NEWP0008 IF (INP1) 20,99,25 NEWP0009 20 INP1 = -INP1 NEWP0010 25 IOLDPN = INP1 NEWP0011 CALL BUFF(0,2,-1) NEWP0012 CALL BUFF(4,1,0) NEWP0013 CALL BUFF(INP1,1,0) NEWP0014 99 RETURN NEWP0015 END NEWP0016 SUBROUTINE PLOTS (I,J,LDEV) PLTS0001 CALCOMP HCBS PN 54S711000 FOR CDC 6000 SERIES JUNE 2 1970 PLTS0002 COPYRIGHT 1970 CALIFORNIA COMPUTER PRODUCTS INC. PLTS0003 IDENT=1110 PLTS0004 IDENT2=9941 PLTS0005 CALL BUFF (LDEV,1,-2) PLTS0006 CALL BUFF (IDENT,3,0) PLTS0007 CALL BUFF(IDENT2,3,0) PLTS0008 CALL BUFF (1000,1000,-1) PLTS0009 CALL BUFF (1,1,0) PLTS0010 CALL BUFF (1,3,0) PLTS0011 RETURN PLTS0012 END PLTS0013 SUBROUTINE PLOT(XPAGE,YPAGE,IPEN) PLOT0001 CALCOMP HCBS PN 54S711000 FOR CDC 6000 SERIES JUNE 2 1970 PLOT0002 COPYRIGHT 1970 CALIFORNIA COMPUTER PRODUCTS INC. PLOT0003 C***IS(1) SHOULD BE 2**(NBC-1)-1 WHERE NBC IS THE NO. OF BITS/CHARACTER.PLOT0004 C***IS(3) WILL BE 2**(NBA-1)-1 WHERE NBA IS THE NO. OF BITS/TWO WORDS PLOT0005 C***IN 900. PLOT0006 C*** SIGN(X,Y) = X*(Y/ABS(Y)) PLOT0007 DIMENSION IS(3) PLOT0008 DATA IS(1),IS(2),IS(3)/31,2047,131071/ PLOT0009 DATA MAX/500/,IOLDX,IOLDY,IOPEN,ICFLG/4*0/,MAXDX/32768/ PLOT0010 DATA IBLK,IFFLAG/2*1/,FACT/1.0/,STEPS/800.0/,STEPS1/800.0/ PLOT0011 DATA ISFLG,MDX,MDY/3*0/ PLOT0012 DATA MZE /O777777777777/ PLOT0013 20 INEWP=IPEN PLOT0014 ICOD1=16 PLOT0015 ICOD=2 PLOT0016 IF(INEWP-IOPEN) 25,40,25 PLOT0017 25 IF(INEWP-2) 27,37,31 PLOT0018 27 IF(INEWP) 29,40,40 PLOT0019 29 ISFLG=-1 PLOT0020 INEWP=-INEWP PLOT0021 GO TO 25 PLOT0022 31 IF(INEWP-999) 35,33,1000 PLOT0023 33 ICFLG=-1 PLOT0024 IBLK=9998 PLOT0025 ISFLG=-1 PLOT0026 35 IF(IOPEN-3) 36,40,36 PLOT0027 36 INEWP=3 PLOT0028 ICOD=3 PLOT0029 37 CALL BUFF(ICOD,1,0) PLOT0030 IOPEN=INEWP PLOT0031 40 IX=XPAGE*STEPS+SIGN(0.5,XPAGE) PLOT0032 IDX=IX-IOLDX PLOT0033 IADX=IABS(IDX) PLOT0034 IOLDX=IX PLOT0035 IY=YPAGE*STEPS+SIGN(0.5,YPAGE) PLOT0036 IDY=IY-IOLDY PLOT0037 IADY=IABS(IDY) PLOT0038 IOLDY=IY PLOT0039 49 IF(IADX-IADY) 50,51,51 PLOT0040 50 NDIV=IADY/MAXDX PLOT0041 GO TO 52 PLOT0042 51 NDIV=IADX/MAXDX PLOT0043 52 IF(NDIV) 44,44,152 PLOT0044 152 NA=NDIV PLOT0045 NT=NA+NA PLOT0046 NB=NA PLOT0047 NDIV=NB+1 PLOT0048 ISX=ISIGN(1,IDX) PLOT0049 ISY=ISIGN(1,IDY) PLOT0050 IDX=IDX/NDIV PLOT0051 IDY=IDY/NDIV PLOT0052 NR=2*(IADX-IABS(IDX)*NDIV) PLOT0053 NS=2*(IADY-IABS(IDY)*NDIV) PLOT0054 IMFLG=0 PLOT0055 43 IADX=IABS(IDX+MDX) PLOT0056 IADY=IABS(IDY+MDY) PLOT0057 44 IXCNT=0 PLOT0058 IYCNT=0 PLOT0059 IF(IADX) 62,62,61 PLOT0060 61 IXCNT=IXCNT+1 PLOT0061 IF(IADX-IS(IXCNT)) 62,161,61 PLOT0062 161 IMFLG=1 PLOT0063 62 IF(IADY) 64,64,63 PLOT0064 63 IYCNT=IYCNT+1 PLOT0065 IF(IADY-IS(IYCNT)) 64,163,63 PLOT0066 163 IMFLG=1 PLOT0067 64 ICOD=IXCNT+IYCNT+1 PLOT0068 CALL BUFF(ICOD,ICOD,-1) PLOT0069 ICOD=IXCNT*4+IYCNT+ICOD1 PLOT0070 CALL BUFF(ICOD,1,0) PLOT0071 IT=IDX+MDX PLOT0072 IF (IT) 140,170,160 PLOT0073 140 IT=IT+1 PLOT0074 IF (IT) 160,150,160 PLOT0075 150 IT=MZE PLOT0076 160 CALL BUFF (IT,IXCNT,0) PLOT0077 170 IT=IDY+MDY PLOT0078 IF (IT) 180,190,200 PLOT0079 180 IT=IT+1 PLOT0080 IF (IT) 200,210,200 PLOT0081 210 IT=MZE PLOT0082 200 CALL BUFF (IT,IYCNT,0) PLOT0083 190 CONTINUE PLOT0084 MDX=0 PLOT0085 MDY=0 PLOT0086 NDIV=NDIV-1 PLOT0087 IF (NDIV) 70,70,53 PLOT0088 53 NA=NA-NR PLOT0089 NB=NB-NS PLOT0090 IF (NA) 54,55,55 PLOT0091 54 MDX=ISX PLOT0092 NA=NA+NT PLOT0093 55 IF (NB) 56,57,57 PLOT0094 56 MDY=ISY PLOT0095 NB=NB+NT PLOT0096 57 IF(IMFLG) 64,64,43 PLOT0097 70 IF (ISFLG) 75,999,999 PLOT0098 75 CALL BUFF(MAX,MAX,-1) PLOT0099 ISFLG=0 PLOT0100 IOLDX=0 PLOT0101 IOLDY=0 PLOT0102 IOPEN=0 PLOT0103 IBLK=IBLK+1 PLOT0104 CALL BUFF(1,1,0) PLOT0105 CALL BUFF(IBLK,3,0) PLOT0106 IFFLG=1 PLOT0107 IF(ICFLG) 80,999,999 PLOT0108 80 CALL BUFF(MAX,MAX,-1) PLOT0109 ICFLG=0 PLOT0110 999 RETURN PLOT0111 1000 IF(IPEN-1001) 1010,1020,1030 PLOT0112 1010 FACT=XPAGE PLOT0113 STEPS=STEPS1*FACT PLOT0114 IFFLG=1 PLOT0115 RETURN PLOT0116 1020 XPAGE=FLOAT(IOLDX)/STEPS PLOT0117 YPAGE=FLOAT(IOLDY)/STEPS PLOT0118 RETURN PLOT0119 1030 IF (IPEN-1003) 1032,1040,1050 PLOT0120 1032 XPAGE=FACT PLOT0121 RETURN PLOT0122 1040 IDX=XPAGE*STEPS+SIGN(0.5,XPAGE) PLOT0123 IDY=YPAGE*STEPS+SIGN(0.5,YPAGE) PLOT0124 XPAGE=FLOAT(IDX)/STEPS PLOT0125 YPAGE=FLOAT(IDY)/STEPS PLOT0126 IADX=IABS(IDX) PLOT0127 IADY=IABS(IDY) PLOT0128 NDIV=1 PLOT0129 IFFLG=0 PLOT0130 ICOD1=32 PLOT0131 IF(3*MAX0(IADX,IADY)-MAXDX) 44,44,1051 PLOT0132 1050 IF (IFFLG) 1040,1051,1040 PLOT0133 1051 IDX=0 PLOT0134 IDY=0 PLOT0135 IADX=0 PLOT0136 IADY=0 PLOT0137 IXCNT=0 PLOT0138 IYCNT=0 PLOT0139 ICOD1=32 PLOT0140 NDIV=1 PLOT0141 GO TO 64 PLOT0142 END PLOT0143 SUBROUTINE BUFF(LOC,NCNT,ICNT) BUFF0001 CALCOMP HCBS PN 54S711000 FOR CDC 6000 SERIES JUNE 2 1970 BUFF0002 COPYRIGHT 1970 CALIFORNIA COMPUTER PRODUCTS INC. BUFF0003 DIMENSION IBUFF(80),ISH(6),LOC(1),ITAB(64) BUFF0004 DATA ISH/1073741824,16777216,262144,4096,64,1/ BUFF0005 DATA JMAX/48/,IBUFF(1)/O37313137/,ILOC2,J/0,2/ BUFF0006 DATA JSH/10/,NCW,NCWP/10,11/ BUFF0007 DATA ITAB/0,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,BUFF0008 X51,52,53,54,55,56,57,58,16,17,18,19,20,21,22,23,24,25,11,13,10,15,BUFF0009 X8,9,4,29,0,12,14,2,59,61,26,1,3,5,62,6,7,28,30,31,32,63,27/ BUFF0010 20 JCNT=IABS(NCNT) BUFF0011 IF (ICNT) 40,200,2000 BUFF0012 40 IF (ICNT+2) 99,60,100 BUFF0013 60 LTAPE=LOC(1) BUFF0014 99 RETURN BUFF0015 100 IF((JMAX-J)*NCW+JSH-JCNT) 120,120,99 BUFF0016 120 JCNT=0 BUFF0017 ILOC1=15 BUFF0018 GO TO 1000 BUFF0019 140 IF(JSH-NCW) 1000,160,1000 BUFF0020 160 JCNT=1 BUFF0021 IF(J-2) 99,99,1030 BUFF0022 200 IF(JCNT)210,99,210 BUFF0023 210 K=NCWP-JCNT BUFF0024 IPF=0 BUFF0025 ILOC=LOC(1) BUFF0026 500 CALL PACK1(ILOC,ILOC1,K) BUFF0027 IF (IPF) 570,1000,570 BUFF0028 570 ILOC1=ITAB(ILOC1+1) BUFF0029 1000 CALL PACK(ILOC1,ILOC2,10,JSH) BUFF0030 JSH=JSH-1 BUFF0031 IF(JSH-1) 1040,1010,1100 BUFF0032 1010 IF(J-JMAX) 1100,1020,1100 BUFF0033 1020 CALL PACK(15,ILOC2,K,JSH) BUFF0034 IBUFF(J)=ILOC2 BUFF0035 1030 WRITE(LTAPE) (IBUFF(I),I=1,JMAX) BUFF0036 J=2 BUFF0037 GO TO 1050 BUFF0038 1040 IBUFF(J)=ILOC2 BUFF0039 J=J+1 BUFF0040 1050 ILOC2=0 BUFF0041 JSH=NCW BUFF0042 1100 JCNT=JCNT-1 BUFF0043 IF(JCNT) 140,99,1120 BUFF0044 1120 K=K+1 BUFF0045 IF(K-NCWP) 500,2240,2200 BUFF0046 2000 K=NCWP BUFF0047 ILOC1=JCNT BUFF0048 JCNT=JCNT+1 BUFF0049 IF(ILOC1)1000,2020,1000 BUFF0050 2020 JCNT=2 BUFF0051 NK=LOC(1) BUFF0052 2030 IF(NK-32) 1000,2040,2040 BUFF0053 2040 IF(NK-96) 2050,2060,2060 BUFF0054 2050 NK=NK-32 BUFF0055 ILOC1=1 BUFF0056 GO TO 1000 BUFF0057 2060 IF(NK-128) 2070,2080,2080 BUFF0058 2070 NK=NK-64 BUFF0059 GO TO 1000 BUFF0060 2080 NK=MOD(NK,128) BUFF0061 GO TO 2030 BUFF0062 2200 IPF=0 BUFF0063 IF(NCNT) 2220,2210,2230 BUFF0064 2210 ILOC1=NK BUFF0065 GO TO 1000 BUFF0066 2220 NK=NCW BUFF0067 GO TO 2240 BUFF0068 2230 NK=1 BUFF0069 2240 K=NK BUFF0070 IPF=IPF+1 BUFF0071 ILOC=LOC(IPF) BUFF0072 GO TO 500 BUFF0073 END BUFF0074 IDENT PACK PACK0001 *CALCOMP HCBS PN 54S711000 FOR CDC 6000 SERIES JUNE 2 1970 PACK0002 *COPYRIGHT 1970 CALIFORNIA COMPUTER PRODUCTS INC. PACK0003 ENTRY PACK PACK0004 PACK DATA 0 PACK0005 SX6 A0 SA6 TEMPA0 SA2 A1 SB1 X2 SA2 A1+1 SB2 X2 SA2 A1+2 SB3 X2 SA2 A1+3 SB4 X2 SX5 77B SET MASK PACK0006 SA1 B1 GET ILOC IN X1(CODE TO BE STORED) PACK0007 SA2 B2 GET ILOC2(PART WORD) IN X2 PACK0008 BX7 X2 SAVE PART WORD PACK0009 SA3 B3 GET K IN X3 PACK0010 SA4 B4 GET JSH IN X4 PACK0011 SB3 54 INITIALIZE INPUT WORD SHIFT PACK0012 SB4 0 INITIALIZE OUTPUT WORD SHIFT PACK0013 PK1 SX3 X3-1 TEST K PACK0014 ZR X3,PK2 PACK0015 SB3 B3-6 GET CORRECT SHIFT FOR INPUT WORD PACK0016 EQ B0,B0,PK1 PACK0017 PK2 SX4 X4-1 TEST JSH PACK0018 ZR X4,PK3 PACK0019 SB4 B4+6 GET CORRECT SHIFT FOR OUTPUT WORD PACK0020 EQ B0,B0,PK2 PACK0021 PK3 AX1 B3,X1 ISOLATE CHAR. TO BE STORED PACK0022 BX1 X1*X5 MASK IT PACK0023 LX1 B4,X1 SHIFT TO PROPER POSITION PACK0024 BX7 X1+X2 COMBINE WITH PART WORD PACK0025 SA7 B2 STORE PART WORD PACK0026 SA4 TEMPA0 SA0 X4 JP PACK RETURN PACK0027 TEMPA0 DATA 0 END PACK0028 IDENT PACK1 PCK10001 *CALCOMP HCBS PN 54S711000 FOR CDC 6000 SERIES JUNE 2 1970 PCK10002 *COPYRIGHT 1970 CALIFORNIA COMPUTER PRODUCTS INC. PCK10003 ENTRY PACK1 PCK10004 PACK1 DATA 0 PCK10005 SX6 A0 SA6 TEMPA0 SA2 A1 SB1 X2 SA2 A1+1 SB2 X2 SA2 A1+2 SB3 X2 SA1 B1 IJ IN X1 PCK10006 SA3 B3 K IN X3 PCK10007 SB3 54 INITIALIZE SHIFT COUNT PCK10008 SX5 77B PCK10009 PK1 SX3 X3-1 TEST K PCK10010 ZR X3,PK2 PCK10011 SB3 B3-6 GET CORRECT SHIFT PCK10012 EQ B0,B0,PK1 PCK10013 PK2 AX1 B3,X1 ISOLATE CHAR. RIGHT JUSTIFIED PCK10014 BX7 X1*X5 MASK IT PCK10015 SA7 B2 STORE IK PCK10016 SA4 TEMPA0 SA0 X4 JP PACK1 RETURN PCK10017 TEMPA0 DATA 0 END PCK10018