$$$$$$$$     PN474113,ZNRC     9PA                                      0000TEMP
CALCOMP PRODUCT NUMBER 474113*8-B                                           0001
CALCOMP HCBS FOR VAX 11 AND 907 CONTROLLER.                                 0002
CALCOMP COPYRIGHT 1982 CALIFORNIA COMPUTER PRODUCTS                         0003
C            MAIN907 METRIC                                                 0004
CALCOMP DRIVER PROGRAM FOR 907 ONLINE METRIC VERSION  EBCDIC PUNCH      TABL0001
CALCOMP HCBS FOR 907 ONLINE                                SEPT, 1981 * TABL0002
C                                                                       TABL0003
C     THIS ROUTINE PRODUCES A SYMBOL TABLE, WHICH SHOWS THE CHARACTERS  TABL0004
C     AVAILABLE IN THE SYMBOL ROUTINE.                                  TABL0005
C                                                                       TABL0006
      DIMENSION ZNUM(4)                                                 TABL0007
      CHARACTER * 38 ICHR1,ICHR2                                        TABL0008
      CHARACTER * 60 ICHR3                                              TABL0009
      CHARACTER * 28 ICHR4                                              TABL0010
      CHARACTER * 1 IBCD                                                TABL0011
      DATA ZNUM /10293.84756,193.75,-204.86,-12345.6789/                TABL0012
      DATA LDEV / 6 /                                                   TABL0013
      ICHR1='CHARACTERS AVAILABLE IN SYMBOL ROUTINE'                    TABL0014
      ICHR2='   FOR CALCOMP 907 AND HOST COMPUTER  '                    TABL0015
      ICHR3='INTEGER FOR USE IN SYMBOL CALL SHOWN TO LEFT OF EACH SYMBOLTABL0016
     1'                                                                 TABL0017
      ICHR4='EXAMPLE OF NUMBER SUBROUTINE'                              TABL0018
      CALL PLOTS(0,0,LDEV)                                              TABL0019
      CALL FACTOR (2.54)                                                TABL0020
      Z=0.0                                                             TABL0021
      M=0                                                               TABL0022
      XS=0.95                                                           TABL0023
      YS=0.25                                                           TABL0024
      DO 25 IPAGE=1,3                                                   TABL0025
      CALL PLOT(0.0,11.0,2)                                             TABL0026
      CALL PLOT (8.5,11.0,2)                                            TABL0027
      CALL PLOT (8.5,0.0,2)                                             TABL0028
      CALL PLOT (0.0,0.0,2)                                             TABL0029
      CALL SYMBOL(0.5,10.50,.2,ICHR1,INTEQ,0.0,38)                      TABL0030
      CALL SYMBOL(0.5,10.25,.2,ICHR2,INTEQ,0.0,38)                      TABL0031
      CALL PLOT(8.0,10.0,3)                                             TABL0032
      CALL PLOT(0.5,10.0,2)                                             TABL0033
      CALL PLOT(0.5, 0.5,2)                                             TABL0034
      CALL PLOT(8.0, 0.5,2)                                             TABL0035
      X=0.5                                                             TABL0036
      Y=9.5                                                             TABL0037
      DO 20 IA=1,6                                                      TABL0038
      DO 10 IB=1,16                                                     TABL0039
      CALL NUMBER(X+.15,Y+.18,.14,Z,0.0,-1)                             TABL0040
      CALL SYMBOL(X+XS,Y+YS ,.4 ,IBCD,M,0.0,-1)                         TABL0041
      Z=Z+1.0                                                           TABL0042
      M=M+1                                                             TABL0043
 10   Y=Y-0.6                                                           TABL0044
      X=X+1.25                                                          TABL0045
      CALL PLOT(X,0.5,3)                                                TABL0046
      CALL PLOT(X,10.,2)                                                TABL0047
      Y=9.5                                                             TABL0048
      XS=.75                                                            TABL0049
 20   YS=.05                                                            TABL0050
      CALL SYMBOL(0.6,.25,.12,ICHR3,INTEQ,0.0,60)                       TABL0051
 25   CALL PLOT(10.0,0.0,-3)                                            TABL0052
C THE FOLLOWING TESTS THE NUMBER SUBROUTINE FOR PRECISION               TABL0053
      CALL SYMBOL(0.5,2.5,.20,ICHR4,INTEQ,90.0,28)                      TABL0054
      Y=10.0                                                            TABL0055
      DO 40 IA=1,4                                                      TABL0056
      DO 30 IB=1,11                                                     TABL0057
      CALL NUMBER(1.0,Y,.14,ZNUM(IA),0.0,IB-6)                          TABL0058
 30   Y=Y-0.2                                                           TABL0059
 40   Y=Y-0.3                                                           TABL0060
      CALL PLOT ( 5.0,0.0,-3)                                           TABL0061
      CALL PLOT(0.0,0.0,999)                                            TABL0062
      STOP                                                              TABL0063
      END                                                               TABL0064
C CALIFORNIA COMPUTER PRODUCTS SAMPLE PROGRAM NUMBER 1      V097        SAMP0065
CALCOMP  DRIVER PROGRAM METRIC VERSION           EBCDIC PUNCH           SAMP0066
CALCOMP HCBS FOR  ONLINE CONTROLLERS                       SEPT, 1981 * SAMP0067
C                                                                       SAMP0068
      DIMENSION XARRAY(62),YARRAY(62)                                   SAMP0069
      CHARACTER * 28 ICHR1                                              SAMP0070
      CHARACTER * 26 ICHR2                                              SAMP0071
      CHARACTER * 4  ICHR3,ICHR4                                        SAMP0072
      CHARACTER * 19 ICHR5,ICHR7                                        SAMP0073
      CHARACTER * 21 ICHR6                                              SAMP0074
      CHARACTER * 17 ICHR8                                              SAMP0075
      CHARACTER * 10 LBCD1,LBCD2                                        SAMP0076
      DATA LDEV / 6 /                                                   SAMP0077
      ICHR1='PLOTTED ON A CALCOMP PLOTTER'                              SAMP0078
      ICHR2='USING  Y = X -0.7*X +0.1*X'                                SAMP0079
      ICHR3='ANG='                                                      SAMP0080
      ICHR4=', H='                                                      SAMP0081
      ICHR5='ANGULAR LETTER TEST'                                       SAMP0082
      ICHR6='CAR MODEL AGE (YEARS)'                                     SAMP0083
      ICHR7='CAR VALUE (DOLLARS)'                                       SAMP0084
      ICHR8='AVERAGE CAR VALUE'                                         SAMP0085
      LBCD1='X-ABSCISSA'                                                SAMP0086
      LBCD2='Y-ORDINATE'                                                SAMP0087
      CALL PLOTS(0,0,LDEV)                                              SAMP0088
      CALL PLOT(0.0,-.5,3)                                              SAMP0089
C PLOT THREE GRAPHS ILLUSTRATING SCALE, AXIS, AND LINE                  SAMP0090
      DELTAX=0.04                                                       SAMP0091
      DO 110 I=1,3                                                      SAMP0092
        DELTAX=2.0*DELTAX                                               SAMP0093
        XARRAY(1)=DELTAX                                                SAMP0094
        DO 105 J=1,60                                                   SAMP0095
          YARRAY(J)=XARRAY(J)**2-0.7*XARRAY(J)**3+0.1*XARRAY(J)**4      SAMP0096
105       XARRAY(J+1)=XARRAY(J)+DELTAX                                  SAMP0097
        CALL SCALE(XARRAY(1),16.0,60,1)                                 SAMP0098
        CALL SCALE(YARRAY(1),25.0,60,1)                                 SAMP0099
        CALL AXIS(0.,0.,LBCD1        ,-10,16.,0.,XARRAY(61),XARRAY(62)) SAMP0100
        CALL AXIS(0.,0.,LBCD2        ,10,25.,90.,YARRAY(61),YARRAY(62)) SAMP0101
      CALL NEWPEN(I)                                                    SAMP0102
        CALL LINE(XARRAY(1),YARRAY(1),60,1,2*(I-2),I)                   SAMP0103
      CALL NEWPEN(1)                                                    SAMP0104
        CALL SYMBOL(3.3,25.,.35,ICHR1,INTEQ,0.0,28)                     SAMP0105
        CALL SYMBOL(3.3,24.,.35,ICHR2,INTEQ,0.0,26)                     SAMP0106
        CALL NUMBER(7.50,24.3,.21,2.0,0.,-1)                            SAMP0107
        CALL NUMBER(9.95,24.3,.21,3.0,0.,-1)                            SAMP0108
        CALL NUMBER(12.4,24.3,.21,4.0,0.,-1)                            SAMP0109
110     CALL PLOT(25.0,0.0,-3)                                          SAMP0110
C PLOT ANGULAR LETTER TEST                                              SAMP0111
      CALL PLOT(12.,12.,-3)                                             SAMP0112
      ANGLE=0.0                                                         SAMP0113
      HEIGHT=0.21                                                       SAMP0114
      DO 120  I=1,8                                                     SAMP0115
      CALL NEWPEN(I)                                                    SAMP0116
        RAD=0.0174533*ANGLE                                             SAMP0117
        XX=0.5*COS (RAD)                                                SAMP0118
        YY=0.5*SIN (RAD)                                                SAMP0119
        CALL SYMBOL( XX  , YY  ,HEIGHT,ICHR3,INTEQ,ANGLE, 4)            SAMP0120
        CALL NUMBER(999.0,999.0,HEIGHT,ANGLE ,ANGLE,-1)                 SAMP0121
        CALL SYMBOL(999.0,999.0,HEIGHT,ICHR4,INTEQ,ANGLE, 4)            SAMP0122
        CALL NUMBER(999.0,999.0,HEIGHT,HEIGHT,ANGLE, 3)                 SAMP0123
        HEIGHT=HEIGHT+0.070                                             SAMP0124
 120    ANGLE=ANGLE+45.0                                                SAMP0125
      CALL NEWPEN(1)                                                    SAMP0126
      CALL SYMBOL(-3.5,11.,0.35,ICHR5,INTEQ,0.0,19)                     SAMP0127
      CALL PLOT(11.0,13.0,3)                                            SAMP0128
      CALL PLOT(-11.,13.0,2)                                            SAMP0129
      CALL PLOT(-11.,-13.,2)                                            SAMP0130
      CALL PLOT(11.0,-13.,2)                                            SAMP0131
      CALL PLOT(11.0,13.0,2)                                            SAMP0132
      CALL PLOT(20.0,-12.,-3)                                           SAMP0133
C PLOT CAR VALUE CHART WITHOUT USING SCALE,AXIS,OR LINE                 SAMP0134
      X=2.0                                                             SAMP0135
C PLOT X-AXIS                                                           SAMP0136
      DO 130 I=1,7                                                      SAMP0137
        CALL PLOT(X-2.0,0.0,3)                                          SAMP0138
        CALL PLOT(X   , 0.0,2)                                          SAMP0139
        CALL PLOT(X   ,-0.2,2)                                          SAMP0140
        CALL NUMBER(X-.05,-0.50,0.21,X/2.,0.0,-1)                       SAMP0141
 130    X=X+2.0                                                         SAMP0142
      CALL SYMBOL(5.0,-1.0,0.35,ICHR6,INTEQ,0.0,21)                     SAMP0143
C PLOT Y-AXIS                                                           SAMP0144
      VALUE=1000.0                                                      SAMP0145
      DO 140  I=1,6                                                     SAMP0146
        Y=0.0040*VALUE                                                  SAMP0147
        CALL PLOT(0.0,Y-4.0,3)                                          SAMP0148
        CALL PLOT(0.0,Y-2.0,2)                                          SAMP0149
        CALL PLOT(-.2,Y-2.0,2)                                          SAMP0150
        CALL PLOT(0.0,Y-2.0,2)                                          SAMP0151
        CALL PLOT(0.0,Y    ,2)                                          SAMP0152
        CALL PLOT(-.2,Y    ,2)                                          SAMP0153
        CALL NUMBER(-1.8,Y,0.35,VALUE,0.0,-1)                           SAMP0154
 140    VALUE=VALUE+1000.0                                              SAMP0155
      CALL SYMBOL(-2.2,8.7,0.35,ICHR7,INTEQ,90.0,19)                    SAMP0156
C PLOT CURVES                                                           SAMP0157
      CALL NEWPEN(2)                                                    SAMP0158
      DO 150  I=2000,6000,500                                           SAMP0159
        VALUE=I                                                         SAMP0160
        AGE=0.0                                                         SAMP0161
        CALL PLOT(AGE,0.0040*VALUE,3)                                   SAMP0162
        DO 150  J=1,84                                                  SAMP0163
          VALUE=VALUE*0.972                                             SAMP0164
          AGE=AGE+0.08333                                               SAMP0165
 150      CALL PLOT(AGE+AGE,0.0040*VALUE,2)                             SAMP0166
      CALL NEWPEN(3)                                                    SAMP0167
      CALL SYMBOL(4.0,15.,0.50,ICHR8,INTEQ,0.0,17)                      SAMP0168
      CALL NEWPEN(1)                                                    SAMP0169
      CALL PLOT(25.,0.0,-3)                                             SAMP0170
      CALL PLOT(0.0,0.0,999)                                            SAMP0171
      STOP                                                              SAMP0172
      END                                                               SAMP0173
C CALIFORNIA COMPUTER PRODUCTS SAMPLE PROGRAM NUMBER 2      V097        SAMP0174
CALCOMP DRIVER PROGRAM METRIC VERSION            EBCDIC PUNCH           SAMP0175
CALCOMP HCBS FOR  ONLINE CONTROLLERS                       SEPT, 1981 * SAMP0176
C                                                                       SAMP0177
      CHARACTER * 10 ICHR1                                              SAMP0178
      CHARACTER * 14 ICHR2,ICHR3                                        SAMP0179
      CHARACTER * 5  ICHR4,ICHR6                                        SAMP0180
      CHARACTER * 4  ICHR5,ICHR7                                        SAMP0181
      CHARACTER * 29 ICHR8                                              SAMP0182
      CHARACTER * 32 ICHR9,ICHR10,ICHR11,ICHR12                         SAMP0183
      CHARACTER * 1 IBCD                                                SAMP0184
      DATA LDEV / 6 /                                                   SAMP0185
      ICHR1='WIDTH (FT)'                                                SAMP0186
      ICHR2='THICKNESS (IN)'                                            SAMP0187
      ICHR3='PRESSURE (PSI)'                                            SAMP0188
      ICHR4='THK= '                                                     SAMP0189
      ICHR5=' IN.'                                                      SAMP0190
      ICHR6='WTH= '                                                     SAMP0191
      ICHR7=' FT.'                                                      SAMP0192
      ICHR8='CRITICAL BUCKLING PRESSURE OF'                             SAMP0193
      ICHR9='HYPERBOLIC PARABOLOID SHELLS FOR'                          SAMP0194
      ICHR10='FIXED WIDTH VS VARYING THICKNESS'                         SAMP0195
      ICHR11='FIXED THICKNESS VS VARYING WIDTH'                         SAMP0196
      ICHR12='PREPARED ON A CALCOMP PLOTTER'                            SAMP0197
      CALL PLOTS(0,0,LDEV)                                              SAMP0198
      CALL PLOT(0.0,-1.1,3)                                             SAMP0199
C PLOT X-AXIS FOR WIDTH                                                 SAMP0200
      X=0.0                                                             SAMP0201
      DO 210  I=1,10                                                    SAMP0202
        CALL PLOT(X,0.0,3)                                              SAMP0203
        X=X+2.0                                                         SAMP0204
        CALL PLOT(X,0.0,2)                                              SAMP0205
        CALL PLOT(X,-.2,2)                                              SAMP0206
 210    CALL NUMBER(X,-0.50,0.21,5.0*X,0.0,-1)                          SAMP0207
      CALL SYMBOL(10.,-0.80,0.32,IBCD,1,0.0,-1)                         SAMP0208
      CALL SYMBOL(10.4,-1.00,0.35,ICHR1,INTEQ,0.0,10)                   SAMP0209
      CALL PLOT (0.0,1.25,-3)                                           SAMP0210
C PLOT X-AXIS FOR THICKNESS                                             SAMP0211
      X=0.0                                                             SAMP0212
      DO 220  I=1,5                                                     SAMP0213
        CALL PLOT(X,0.0,3)                                              SAMP0214
        X=X+2.0                                                         SAMP0215
        CALL PLOT(X,0.0,2)                                              SAMP0216
        CALL PLOT(X,-.2,2)                                              SAMP0217
        CALL PLOT(X,0.0,2)                                              SAMP0218
        X=X+2.0                                                         SAMP0219
        CALL PLOT(X,0.0,2)                                              SAMP0220
        CALL PLOT(X,-.2,2)                                              SAMP0221
 220    CALL NUMBER(X,-0.50,0.21,X,0.0,-1)                              SAMP0222
      CALL SYMBOL(9.5,-0.80,0.32,IBCD,7,0.0,-1)                         SAMP0223
      CALL SYMBOL(9.9,-1.00,0.35,ICHR2,INTEQ,0.0,14)                    SAMP0224
C PLOT Y-AXIS                                                           SAMP0225
      Y=0.0                                                             SAMP0226
      DO 230  I=1,9                                                     SAMP0227
        CALL PLOT(0.0,Y,3)                                              SAMP0228
        Y=Y+1.0                                                         SAMP0229
        CALL PLOT(0.0,Y,2)                                              SAMP0230
        CALL PLOT(-.2,Y,2)                                              SAMP0231
        CALL PLOT(0.0,Y,2)                                              SAMP0232
        Y = Y+1.0                                                       SAMP0233
        CALL PLOT(0.0,Y,2)                                              SAMP0234
        CALL PLOT(-.2,Y,2)                                              SAMP0235
 230    CALL NUMBER(-.30,Y-.5,0.21, 500.*Y,90.0,0)                      SAMP0236
      CALL SYMBOL(-0.65,7.0,0.35,ICHR3,INTEQ,90.0,14)                   SAMP0237
      THICK=3.0                                                         SAMP0238
      WIDTH=25.0                                                        SAMP0239
      DO 260  I=1,3                                                     SAMP0240
        TSQR=THICK*THICK                                                SAMP0241
        WSQR=WIDTH*WIDTH                                                SAMP0242
        PSI=100.99*TSQR                                                 SAMP0243
        CALL SYMBOL(1.5,PSI/ 500.0,0.21,ICHR4,INTEQ,0.0,5)              SAMP0244
        CALL NUMBER(999.0,999.0,0.21,THICK,0.0,0)                       SAMP0245
        CALL SYMBOL(999.0,999.0,0.21,ICHR5,INTEQ,0.0,4)                 SAMP0246
        CALL SYMBOL( 4.0 ,999.0,0.20,IBCD,1,0.0,-1)                     SAMP0247
        DO 240 J=10,50                                                  SAMP0248
          WX=J                                                          SAMP0249
          PSI=10099.0*TSQR/(WX*WX)                                      SAMP0250
 240      CALL PLOT(WX/2.5,PSI/ 500.0,2)                                SAMP0251
        PSI=10099.0*81.0/WSQR                                           SAMP0252
        CALL SYMBOL(18.5,PSI/500.0,0.21,ICHR6,INTEQ,0.0,5)              SAMP0253
        CALL NUMBER(999.0,999.0,0.21,WIDTH,0.0,0)                       SAMP0254
        CALL SYMBOL(999.0,999.0,0.21,ICHR7,INTEQ,0.0,4)                 SAMP0255
        CALL SYMBOL(18.0 ,999.0,0.20,IBCD,7,0.0,-1)                     SAMP0256
        DO 250 J=5,50                                                   SAMP0257
          TX=J                                                          SAMP0258
          TX=(50.0-TX)/5.0                                              SAMP0259
          PSI=10099.0*TX*TX/WSQR                                        SAMP0260
 250      CALL PLOT(2.*TX,PSI/ 500.0,2)                                 SAMP0261
        THICK=THICK+3.0                                                 SAMP0262
 260    WIDTH=WIDTH-5.0                                                 SAMP0263
      CALL SYMBOL(6.6,17.,.35,ICHR8,INTEQ,0.,29)                        SAMP0264
      CALL SYMBOL(6.0,16.4,.35,ICHR9,INTEQ,0.,32)                       SAMP0265
      CALL SYMBOL(6.0,15.8,.35,ICHR10,INTEQ,0.,32)                      SAMP0266
      CALL SYMBOL(6.0,15.2,.35,ICHR11,INTEQ,0.,32)                      SAMP0267
      CALL SYMBOL(6.6,14.0,.35,ICHR12,INTEQ,0.,29)                      SAMP0268
      CALL PLOT(30.0,-1.25,-3)                                          SAMP0269
      CALL PLOT(0.0,0.0,999)                                            SAMP0270
      STOP                                                              SAMP0271
      END                                                               SAMP0272
CALIFORNIA COMPUTER PRODUCTS SAMPLE PROGRAM NUMBER 3                    SAMP0273
CALCOMP HCBS FOR 907 CONTROLLER                             SEPT, 1981* SAMP0274
C                                                                       SAMP0275
      DIMENSION ARRAY(17),ISYM(19)                                      SAMP0276
      CHARACTER * 42 ICHR1,ICHR2,ICHR3,ICHR4,ICHR5,ICHR6,ICHR7,ICHR8    SAMP0277
      CHARACTER * 42 ICHR9,ICHR10,ICHR11,ICHR12,ICHR13,ICHR14,ICHR15    SAMP0278
      CHARACTER * 42 ICHR16                                             SAMP0279
      CHARACTER * 21 MESS                                               SAMP0280
      CHARACTER * 1 IBCD                                                SAMP0281
      DATA ISYM/1515, 306, 405, 604, 804,1005,1106,                     SAMP0282
     1 1500, 408, 409, 509, 508, 408, 1500, 908, 909,1009,1008, 908/    SAMP0283
      DATA LDEV / 6 /                                                       0284
      ICHR1='     MODE  =              +1            -1'                SAMP0285
      ICHR2='     MODE  =              +2            -2'                SAMP0286
      ICHR3='     MODE  =              +3            -3'                SAMP0287
      ICHR4='     MODE  =              +2            -2'                SAMP0288
      ICHR5='     MODE  =              +3            -3'                SAMP0289
      ICHR6='     MODE  =              +2            -2'                SAMP0290
      ICHR7='     MODE  =              +3            -3'                SAMP0291
      ICHR8='     MODE  =              +2            -2'                SAMP0292
      ICHR9='     MODE  =              +3            -3'                SAMP0293
      ICHR10='     MODE  =              +4            -4'               SAMP0294
      ICHR11='     MODE  =              +5            +5'               SAMP0295
      ICHR12='     MODE  =              +6            -6'               SAMP0296
      ICHR13='     MODE  =              +7            +7'               SAMP0297
      ICHR14='DASH MODE  =              +1            -1'               SAMP0298
      ICHR15='DASH MODE2 =              +1            -1'               SAMP0299
      ICHR16='     MODE  =              +1            -1'               SAMP0300
      MESS = 'OPERATOR MESSAGE TEST'                                    SAMP0301
      CALL PLOTS(0,0,LDEV)                                              SAMP0302
      CALL FACTOR(2.54)                                                 SAMP0303
      R=0.8                                                             SAMP0304
C              ESTABLISH CENTER POINTS FOR CIRCLES                      SAMP0305
      XC1=4.0                                                           SAMP0306
      XC2=6.0                                                           SAMP0307
      YC=8.80                                                           SAMP0308
      YS=2.25                                                           SAMP0309
      X=0.25                                                            SAMP0310
      Y=8.73                                                            SAMP0311
      CALL SYMBOL (0.,0.,0.1,IBCD,3,0.,-1)                              SAMP0312
      CALL SYMBOL(X,Y,0.14,ICHR1,INTEQ,0.0,42)                          SAMP0313
      CALL CIRCLE(XC1-R,YC,XC1,YC,XDUM,+1)                              SAMP0314
      CALL CIRCLE(XC2-R,YC,XC2,YC,XDUM,-1)                              SAMP0315
      Y=Y-YS                                                            SAMP0316
      YC=YC-YS                                                          SAMP0317
C              MODE = +/-2        SLOPED CHORD (DELTA Y > 0)            SAMP0318
      CALL SYMBOL(X,Y,0.14,ICHR2,INTEQ,0.0,42)                          SAMP0319
      CALL CIRCLE(XC1+R,YC,XC1,YC+R,R,+2)                               SAMP0320
      CALL CIRCLE(XC2,YC-R,XC2-R,YC,R,-2)                               SAMP0321
      Y=Y-YS                                                            SAMP0322
      YC=YC-YS                                                          SAMP0323
C               MODE = +/-3   SLOPED CHORD                              SAMP0324
      CALL SYMBOL(X,Y,0.14,ICHR3,INTEQ,0.0,42)                          SAMP0325
      CALL CIRCLE(XC1,YC-R,XC1-R,YC,R,+3)                               SAMP0326
      CALL CIRCLE(XC2+R,YC,XC2,YC+R,R,-3)                               SAMP0327
      Y=Y-YS                                                            SAMP0328
      YC=YC-YS                                                          SAMP0329
C               MODE = +/-2   SLOPED CHORD (DELTA Y < 0)                SAMP0330
      CALL SYMBOL(X,Y,0.14,ICHR4,INTEQ,0.0,42)                          SAMP0331
      CALL CIRCLE(XC1-R,YC,XC1,YC-R,R,+2)                               SAMP0332
      CALL CIRCLE(XC2,YC+R,XC2+R,YC,R,-2)                               SAMP0333
C               NEW PAGE                                                SAMP0334
      CALL SYMBOL (0.,0.,0.1,IBCD,4,0.,-1)                              SAMP0335
      CALL PLOT( 8.5,0.0,-3)                                            SAMP0336
      CALL SYMBOL (0.,0.,0.1,IBCD,3,0.,-1)                              SAMP0337
      Y = Y + 3.0*YS                                                    SAMP0338
      YC= YC + 3.0*YS                                                   SAMP0339
C               MODE = +/-3   SLOPED CHORD                              SAMP0340
      CALL SYMBOL(X,Y,0.14,ICHR5,INTEQ,0.0,42)                          SAMP0341
      CALL CIRCLE(XC1,YC+R,XC1+R,YC,R,+3)                               SAMP0342
      CALL CIRCLE(XC2-R,YC,XC2,YC-R,R,-3)                               SAMP0343
      Y=Y-YS                                                            SAMP0344
      YC=YC-YS                                                          SAMP0345
C               MODE = +/-2   VERTICAL CHORD                            SAMP0346
      CALL SYMBOL(X,Y,0.14,ICHR6,INTEQ,0.0,42)                          SAMP0347
      CALL CIRCLE(XC1-R*.7071,YC+R*.7071,XC1-R*.7071,YC-R*.7071,R,+2)   SAMP0348
      CALL CIRCLE(XC2+R*.7071,YC+R*.7071,XC2+R*.7070,YC-R*.7071,R,-2)   SAMP0349
      Y=Y-YS                                                            SAMP0350
      YC=YC-YS                                                          SAMP0351
C               MODE = +/-3   VERTICAL CHORD                            SAMP0352
      CALL SYMBOL(X,Y,0.14,ICHR7,INTEQ,0.0,42)                          SAMP0353
      CALL CIRCLE(XC1+R*.7071,YC+R*.7071,XC1+R*.7071,YC-R*.7071,R,+3)   SAMP0354
      CALL CIRCLE(XC2-R*.7071,YC+R*.7071,XC2-R*.7071,YC-R*.7071,R,-3)   SAMP0355
      Y=Y-YS                                                            SAMP0356
      YC=YC-YS                                                          SAMP0357
C                MODE = +/-2   HORIZONTAL CHORD                         SAMP0358
      CALL SYMBOL(X,Y,0.14,ICHR8,INTEQ ,0.0,42)                         SAMP0359
      CALL CIRCLE(XC1-R*.7071,YC-R*.7071,XC1+R*.7071,YC-R*.7071,R,+2)   SAMP0360
      CALL CIRCLE(XC2-R*.7071,YC+R*.7071,XC2+R*.7071,YC+R*.7071,R,-2)   SAMP0361
C                NEW PAGE                                               SAMP0362
      CALL SYMBOL (0.,0.,0.1,IBCD,4,0.,-1)                              SAMP0363
      CALL PLOT( 8.5,0.0,-3)                                            SAMP0364
      CALL SYMBOL (0.,0.,0.1,IBCD,3,0.,-1)                              SAMP0365
      Y = Y + 3.0*YS                                                    SAMP0366
      YC= YC + 3.0*YS                                                   SAMP0367
C                MODE = +/-3   HORIZONTAL CHORD                         SAMP0368
      CALL SYMBOL(X,Y,0.14,ICHR9,INTEQ,0.0,42)                          SAMP0369
      CALL CIRCLE(XC1-R*.7071,YC+R*.7071,XC1+R*.7071,YC+R*.7071,R,+3)   SAMP0370
      CALL CIRCLE(XC2-R*.7071,YC-R*.7071,XC2+R*.7071,YC-R*.7071,R,-3)   SAMP0371
      Y=Y-YS                                                            SAMP0372
      YC=YC-YS                                                          SAMP0373
C                 MODE = +/-4                                           SAMP0374
      CALL SYMBOL(X,Y,0.14,ICHR10,INTEQ,0.0,42)                         SAMP0375
      CALL CIRCLE(XC1-R,YC,180.0,XDUM,R,+4)                             SAMP0376
      CALL CIRCLE(XC2-R,YC,180.0,XDUM,R,-4)                             SAMP0377
      Y=Y-YS                                                            SAMP0378
      YC=YC-YS                                                          SAMP0379
C               MODE = +5                                               SAMP0380
      CALL SYMBOL(X,Y,0.14,ICHR11,INTEQ,0.0,42)                         SAMP0381
      CALL CIRCLE(XC1,YC+R,90.0,270.0,R,+5)                             SAMP0382
      CALL CIRCLE(XC2,YC+R,90.0,-90.0,R,+5)                             SAMP0383
      Y=Y-YS                                                            SAMP0384
      YC=YC-YS                                                          SAMP0385
C                MODE = +/-6                                            SAMP0386
      CALL SYMBOL(X,Y,0.14,ICHR12,INTEQ,0.0,42)                         SAMP0387
      CALL CIRCLE(XC1,YC,90.0,XDUM,R,+6)                                SAMP0388
      CALL CIRCLE(XC2,YC,90.0,XDUM,R,-6)                                SAMP0389
C                NEW PAGE                                               SAMP0390
      CALL SYMBOL (0.,0.,0.1,IBCD,4,0.,-1)                              SAMP0391
      CALL PLOT( 8.5,0.0,-3)                                            SAMP0392
      CALL SYMBOL (0.,0.,0.1,IBCD,3,0.,-1)                              SAMP0393
      Y = Y + 3.0*YS                                                    SAMP0394
      YC= YC + 3.0*YS                                                   SAMP0395
C                MODE = +7                                              SAMP0396
      CALL SYMBOL(X,Y,0.14,ICHR13,INTEQ,0.0,42)                         SAMP0397
      CALL CIRCLE(XC1,YC,0.0,180.0,R,+7)                                SAMP0398
      CALL CIRCLE(XC2,YC,360.0,180.0,R,+7)                              SAMP0399
      Y=Y-YS                                                            SAMP0400
      YC=YC-YS                                                          SAMP0401
C                                                                       SAMP0402
C                TEST DASHLINE                                          SAMP0403
C                                                                       SAMP0404
      CALL DASHS(ARRAY,+1)                                              SAMP0405
      CALL SYMBOL(X,Y,0.14,ICHR14,INTEQ,0.0,42)                         SAMP0406
      CALL CIRCLE(XC1-R,YC,XC1,YC,XDUM,+1)                              SAMP0407
      CALL CIRCLE(XC2-R,YC,XC2,YC,XDUM,-1)                              SAMP0408
      Y=Y-YS                                                            SAMP0409
      YC=YC-YS                                                          SAMP0410
C                GET PREVIOUS DASHLINE PATTERN - APPEND LONGER DASHES   SAMP0411
      CALL DASHS(ARRAY,-16)                                             SAMP0412
      ICNT=IFIX(ARRAY(17))                                              SAMP0413
      ARRAY(ICNT+1)=ARRAY(1)*2.0                                        SAMP0414
      ARRAY(ICNT+2)=ARRAY(2)*2.0                                        SAMP0415
      ICNT=ICNT+2                                                       SAMP0416
      CALL DASHS(ARRAY,ICNT)                                            SAMP0417
      CALL SYMBOL(X,Y,0.14,ICHR15,INTEQ,0.0,42)                         SAMP0418
      CALL CIRCLE(XC1-R,YC,XC1,YC,XDUM,+1)                              SAMP0419
      CALL CIRCLE(XC2-R,YC,XC2,YC,XDUM,-1)                              SAMP0420
      Y=Y-YS                                                            SAMP0421
      YC=YC-YS                                                          SAMP0422
C                TURN OFF DASHLINE MODE                                 SAMP0423
      CALL DASHS(ARRAY,0)                                               SAMP0424
      CALL SYMBOL(X,Y,0.14,ICHR16,INTEQ,0.0,42)                         SAMP0425
      CALL CIRCLE(XC1-R,YC,XC1,YC,XDUM,+1)                              SAMP0426
      CALL CIRCLE(XC2-R,YC,XC2,YC,XDUM,-1)                              SAMP0427
      CALL SYMBOL (0.,0.,0.1,IBCD,4,0.,-1)                              SAMP0428
      CALL PLOT( 8.5,0.0,-3)                                            SAMP0429
C                                                                       SAMP0430
C                TEST USER-DEFINED SYMBOLS                              SAMP0431
C FIRST PLOT CIRCLE                                                     SAMP0432
       CALL CIRCLE(1.4,2.0,2.0,2.0,XDUM,+1)                             SAMP0433
C DEFINE FACE FEATURES                                                  SAMP0434
       CALL USRSYM(288, ISYM, 19)                                       SAMP0435
       CALL SYMBOL(2.0, 2.0, 1.4, IBCD,288, 0.0, -1)                    SAMP0436
C                ERASE USER SYMBOL & TRY TO PLOT IT                     SAMP0437
       CALL USRSYM(0,0,-1001)                                           SAMP0438
       CALL SYMBOL(4.0, 2.0, 1.4, IBCD,288, 0.0, -1)                    SAMP0439
       CALL PLOT(8.5,0.0,-3)                                            SAMP0440
C                                                                       SAMP0441
C       TEST OPERATOR MESSAGE                                           SAMP0442
C                                                                       SAMP0443
C               WRITE MESSAGE AND PAUSE                                 SAMP0444
      CALL OPMES(21,MESS)                                               SAMP0445
C               THAT'S ALL FOLKS                                     SAMP0446
      CALL PLOT(0.0,0.0,999)                                            SAMP0447
      STOP                                                              SAMP0448
      END                                                               SAMP0449
C            AXIS 907 METRIC                                                0006
      SUBROUTINE AXIS(XPAGE,YPAGE,IBCD,NCHAR,AXLEN,ANGLE,FIRSTV,DELTAV) AXIS0001
CALCOMP  AXIS SUBROUTINE METRIC VERSION                                 AXIS0002
CALCOMP HCBS FOR  ALL CONTROLLERS                          SEPT, 1981 * AXIS0003
C             PROPRIETARY SOFTWARE NOTIFICATION                         AXIS0004
C  THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF        AXIS0005
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON THE  AXIS0006
C    DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED AND      AXIS0007
C    CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT PRIOR AXIS0008
C    WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.              AXIS0009
C  IF SUPPLIED UNDER A GOVERNMENT CONTRACT, THE FOLLOWING APPLIES:      AXIS0010
C                 RESTRICTED RIGHTS LEGEND                              AXIS0011
C  USE, DUPLICATION OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT TO       AXIS0012
C    RESTRICTIONS AS SET FORTH IN PARAGRAPH (B)(3)(B) OF THE RIGHTS     AXIS0013
C    IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE IN DAR 7-104.9      AXIS0014
C    (A).  CALIFORNIA COMPUTER PRODUCTS, INC., 2411 WEST LAPALMA        AXIS0015
C    AVENUE, ANAHEIM, CALIFORNIA 92803.                                 AXIS0016
C MODIFIED FOR METRIC MEASURE                                           AXIS0017
C.....     XPAGE,YPAGE  COORDINATES OF STARTING POINT OF AXIS, IN CM    AXIS0018
C.....     IBCD         AXIS TITLE.                                     AXIS0019
C.....     NCHAR        NUMBER OF CHARACTERS IN TITLE. + FOR C.C-W SIDE.AXIS0020
C.....     AXLEN        FLOATING POINT AXIS LENGTH IN CM.               AXIS0021
C.....     ANGLE        ANGLE OF AXIS FROM THE X-DIRECTION, IN DEGREES. AXIS0022
C.....     FIRSTV       SCALE VALUE AT THE FIRST TIC MARK.              AXIS0023
C.....     DELTAV       CHANGE IN SCALE BETWEEN TIC MARKS ONE CM APART  AXIS0024
      CHARACTER * (*) IBCD                                              AXIS0025
      CHARACTER * 3 NBCD                                                AXIS0026
      NBCD = '*10'                                                      AXIS0027
      KN=NCHAR                                                          AXIS0028
      A=1.0                                                             AXIS0029
      IF (KN) 1,2,2                                                     AXIS0030
  1   A=-A                                                              AXIS0031
      KN=-KN                                                            AXIS0032
  2   EX=0.0                                                            AXIS0033
      ADX= ABS  (DELTAV)                                                AXIS0034
      IF (ADX) 3,7,3                                                    AXIS0035
  3   IF (ADX- 99.0) 6,4,4                                              AXIS0036
  4   ADX=ADX/10.0                                                      AXIS0037
      EX=EX+1.0                                                         AXIS0038
      GO TO 3                                                           AXIS0039
  5   ADX=ADX*10.0                                                      AXIS0040
      EX=EX-1.0                                                         AXIS0041
  6   IF (ADX-0.01) 5,7,7                                               AXIS0042
  7   XVAL=FIRSTV*10.0**(-EX)                                           AXIS0043
      ADX=2.0* DELTAV*10.0**(-EX)                                       AXIS0044
      STH=ANGLE*0.0174533                                               AXIS0045
      CTH=COS(STH)                                                      AXIS0046
      STH=SIN(STH)                                                      AXIS0047
      CTH2=CTH+CTH                                                      AXIS0048
      STH2=STH+STH                                                      AXIS0049
      DXB=-0.254                                                        AXIS0050
      DYB=0.38*A-0.127                                                  AXIS0051
      XN=XPAGE+DXB*CTH-DYB*STH                                          AXIS0052
      YN=YPAGE+DYB*CTH+DXB*STH                                          AXIS0053
      NTIC=AXLEN+1.0                                                    AXIS0054
      NTC=(NTIC+1)/2                                                    AXIS0055
      NT=NTC/2                                                          AXIS0056
      DO  20  I=1,NTC                                                   AXIS0057
        CALL NUMBER(XN,YN,0.210,XVAL,ANGLE,2)                           AXIS0058
      IF (I-1) 10,10,105                                                AXIS0059
10    XN=XPAGE+2.0*DXB*CTH-DYB*STH                                      AXIS0060
      YN=YPAGE+2.0*DXB*STH+DYB*CTH                                      AXIS0061
105     XVAL=XVAL+ADX                                                   AXIS0062
        XN=XN+CTH2                                                      AXIS0063
        YN=YN+STH2                                                      AXIS0064
        IF (NT) 20,11,20                                                AXIS0065
 11       Z=KN                                                          AXIS0066
          IF (EX)  12,13,12                                             AXIS0067
 12       Z=Z+7.0                                                       AXIS0068
 13       DXB=-.14*Z+AXLEN*0.5                                          AXIS0069
          DYB=0.825*A-0.190                                             AXIS0070
          XT=XPAGE+DXB*CTH-DYB*STH                                      AXIS0071
          YT=YPAGE+DYB*CTH+DXB*STH                                      AXIS0072
          CALL SYMBOL(XT,YT,0.28,IBCD,INTEQ,ANGLE,KN)                   AXIS0073
          IF (EX)  14,20,14                                             AXIS0074
 14         Z=KN+2                                                      AXIS0075
            XT=XT+Z*CTH*0.28                                            AXIS0076
            YT=YT+Z*STH*0.28                                            AXIS0077
            CALL SYMBOL(XT,YT,0.28,NBCD,INTEQ,ANGLE,3)                  AXI 0078
            XT=XT+(3.0*CTH-0.8*STH)*0.28                                AXIS0079
            YT=YT+(3.0*STH+0.8*CTH)*0.28                                AXIS0080
            CALL NUMBER(XT,YT,0.21,EX,ANGLE,-1)                         AXIS0081
 20   NT=NT-1                                                           AXIS0082
      CALL PLOT(XPAGE+AXLEN*CTH,YPAGE+AXLEN*STH,3)                      AXIS0083
      DXB=-0.178*A*STH                                                  AXIS0084
      DYB=+0.178*A*CTH                                                  AXIS0085
      A=NTIC-1                                                          AXIS0086
      XN=XPAGE+A*CTH                                                    AXIS0087
      YN=YPAGE+A*STH                                                    AXIS0088
      DO  30  I=1,NTIC                                                  AXIS0089
        CALL PLOT(XN,YN,2)                                              AXIS0090
        CALL PLOT(XN+DXB,YN+DYB,2)                                      AXIS0091
        CALL PLOT(XN,YN,2)                                              AXIS0092
        XN=XN-CTH                                                       AXIS0093
        YN=YN-STH                                                       AXIS0094
 30   CONTINUE                                                          AXIS0095
      RETURN                                                            AXIS0096
      END                                                               AXIS0097
C            LINE METRIC                                                    0008
      SUBROUTINE LINE (XARRAY,YARRAY,NPTS,INC,LINTYP,INTEQ)             LINE0001
CALCOMP  LINE SUBROUTINE FOR FORTRAN 77.                                LINE0002
CALCOMP HCBS FOR  ALL CONTROLLERS                          SEPT, 1981 * LINE0003
C             PROPRIETARY SOFTWARE NOTIFICATION                         LINE0004
C  THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF        LINE0005
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON THE  LINE0006
C    DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED AND      LINE0007
C    CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT PRIOR LINE0008
C    WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.              LINE0009
C  IF SUPPLIED UNDER A GOVERNMENT CONTRACT, THE FOLLOWING APPLIES:      LINE0010
C                 RESTRICTED RIGHTS LEGEND                              LINE0011
C  USE, DUPLICATION OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT TO       LINE0012
C    RESTRICTIONS AS SET FORTH IN PARAGRAPH (B)(3)(B) OF THE RIGHTS     LINE0013
C    IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE IN DAR 7-104.9      LINE0014
C    (A).  CALIFORNIA COMPUTER PRODUCTS, INC., 2411 WEST LAPALMA        LINE0015
C    AVENUE, ANAHEIM, CALIFORNIA 92803.                                 LINE0016
C.....     XARRAY  NAME OF ARRAY CONTAINING ABSCISSA OR X VALUES.       LINE0017
C.....     YARRAY  NAME OF ARRAY CONTAINING ORDINATE OR Y VALUES.       LINE0018
C.....     NPTS    NUMBER OF POINTS TO BE PLOTTED.                      LINE0019
C.....     INC     INCREMENT OF LOCATION OF SUCCESSIVE POINTS.          LINE0020
C.....     LINTYP  CONTROL TYPE OF LINE--SYMBOLS, LINE, OR COMBINATION. LINE0021
C.....     INTEQ   INTEGER EQUIVALENT OF SYMBOL TO BE USED, IF ANY.     LINE0022
      CHARACTER *  1  IBCD                                              LINE0023
      DIMENSION XARRAY(1),YARRAY(1)                                     LINE0024
      LMIN = NPTS*INC+1                                                 LINE0025
      LDX  = LMIN+INC                                                   LINE0026
      NL   = LMIN-INC                                                   LINE0027
      FIRSTX = XARRAY(LMIN)                                             LINE0028
      DELTAX = XARRAY(LDX)                                              LINE0029
      FIRSTY = YARRAY(LMIN)                                             LINE0030
      DELTAY = YARRAY(LDX)                                              LINE0031
      CALL WHERE (XN,YN,DF)                                             LINE0032
      DF=AMAX1(ABS((XARRAY( 1)-FIRSTX)/DELTAX-XN),                      LINE0033
     1         ABS((YARRAY( 1)-FIRSTY)/DELTAY-YN) )                     LINE0034
      DL=AMAX1(ABS((XARRAY(NL)-FIRSTX)/DELTAX-XN),                      LINE0035
     1         ABS((YARRAY(NL)-FIRSTY)/DELTAY-YN) )                     LINE0036
      IPEN = 3                                                          LINE0037
      ICODE = -1                                                        LINE0038
      NT =IABS(LINTYP)                                                  LINE0039
      IF (LINTYP) 7,6,7                                                 LINE0040
    6 NT = 1                                                            LINE0041
    7 IF (DF-DL) 9,9,8                                                  LINE0042
    8 NF = NL                                                           LINE0043
      NA = ((NPTS-1)/NT)*NT+NT-(NPTS-1)                                 LINE0044
      KK = -INC                                                         LINE0045
      GO TO 10                                                          LINE0046
    9 NF = 1                                                            LINE0047
      NA = NT                                                           LINE0048
      KK = INC                                                          LINE0049
   10 IF (LINTYP) 11,12,13                                              LINE0050
   11 IPENA = 3                                                         LINE0051
      ICODEA = -1                                                       LINE0052
      LSW = 1                                                           LINE0053
      GO TO 15                                                          LINE0054
   12 NA=LDX                                                            LINE0055
   13 IPENA = 2                                                         LINE0056
      ICODEA = -2                                                       LINE0057
      LSW=0                                                             LINE0058
   15 DO 30 I =1,NPTS                                                   LINE0059
      XN = (XARRAY(NF)-FIRSTX)/DELTAX                                   LINE0060
      YN = (YARRAY(NF)-FIRSTY)/DELTAY                                   LINE0061
      IF (NA-NT) 20,21,22                                               LINE0062
   20 IF (LSW) 23,22,23                                                 LINE0063
   21 CALL SYMBOL (XN,YN,0.20,IBCD,INTEQ,0.0,ICODE)                     LINE0064
      NA = 1                                                            LINE0065
      GO TO 25                                                          LINE0066
   22 CALL PLOT (XN,YN,IPEN)                                            LINE0067
   23 NA = NA + 1                                                       LINE0068
   25 NF = NF+KK                                                        LINE0069
      ICODE = ICODEA                                                    LINE0070
   30 IPEN = IPENA                                                      LINE0071
      RETURN                                                            LINE0072
      END                                                               LINE0073
C            SCALE METRIC                                                   0010
      SUBROUTINE  SCALE   (ARRAY,AXLEN,NPTS,INC)                        SCAL0001
CALCOMP  SCALE SUBROUTINE                                               SCAL0002
CALCOMP HCBS FOR  925 AND 906/907 CONTROLLERS              SEPT, 1981 * SCAL0003
C             PROPRIETARY SOFTWARE NOTIFICATION                         SCAL0004
C  THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF        SCAL0005
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON THE  SCAL0006
C    DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED AND      SCAL0007
C    CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT PRIOR SCAL0008
C    WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.              SCAL0009
C  IF SUPPLIED UNDER A GOVERNMENT CONTRACT, THE FOLLOWING APPLIES:      SCAL0010
C                 RESTRICTED RIGHTS LEGEND                              SCAL0011
C  USE, DUPLICATION OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT TO       SCAL0012
C    RESTRICTIONS AS SET FORTH IN PARAGRAPH (B)(3)(B) OF THE RIGHTS     SCAL0013
C    IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE IN DAR 7-104.9      SCAL0014
C    (A).  CALIFORNIA COMPUTER PRODUCTS, INC., 2411 WEST LAPALMA        SCAL0015
C    AVENUE, ANAHEIM, CALIFORNIA 92803.                                 SCAL0016
C.....     ARRAY   NAME OF ARRAY CONTAINING VALUES TO BE SCALED.        SCAL0017
C.....     AXLEN   LENGTH IN IN./CM. OVER WHICH ARRAY IS TO BE SCALED.  SCAL0018
C.....     NPTS    NUMBER OF POINTS TO BE SCALED.                       SCAL0019
C.....     INC     INCREMENT OF LOCATION OF SUCCESSIVE POINTS.          SCAL0020
      DIMENSION  ARRAY(1),SAVE(7)                                       SCAL0021
      SAVE(1)=1.0                                                       SCAL0022
      SAVE(2)=2.0                                                       SCAL0023
      SAVE(3)=4.0                                                       SCAL0024
      SAVE(4)=5.0                                                       SCAL0025
      SAVE(5)=8.0                                                       SCAL0026
      SAVE(6)=10.0                                                      SCAL0027
      SAVE(7)=20.                                                       SCAL0028
      FAD=0.01                                                          SCAL0029
      K=IABS(INC)                                                       SCAL0030
      N=NPTS*K                                                          SCAL0031
      Y0=ARRAY(1)                                                       SCAL0032
      YN=Y0                                                             SCAL0033
      DO  25  I=1,N,K                                                   SCAL0034
      YS=ARRAY(I)                                                       SCAL0035
      IF  (Y0-YS)  22,22,21                                             SCAL0036
21    Y0=YS                                                             SCAL0037
      GO  TO  25                                                        SCAL0038
22    IF  (YS-YN)  25,25,24                                             SCAL0039
24    YN=YS                                                             SCAL0040
25    CONTINUE                                                          SCAL0041
      FIRSTV=Y0                                                         SCAL0042
      IF  (Y0)  34,35,35                                                SCAL0043
34    FAD=FAD-1.0                                                       SCAL0044
35    DELTAV=(YN-FIRSTV)/AXLEN                                          SCAL0045
      IF (DELTAV) 70,70,40                                              SCAL0046
40    I=ALOG10(DELTAV)+1000.0                                           SCAL0047
      P=10.0**(I-1000)                                                  SCAL0048
      DELTAV=DELTAV/P-0.01                                              SCAL0049
      DO  45  I=1,6                                                     SCAL0050
      IS=I                                                              SCAL0051
      IF  (SAVE(I)-DELTAV)  45,50,50                                    SCAL0052
45    CONTINUE                                                          SCAL0053
50    DELTAV=SAVE(IS)*P                                                 SCAL0054
      FIRSTV=DELTAV*AINT(Y0/DELTAV+FAD)                                 SCAL0055
      T=FIRSTV+(AXLEN+0.01)*DELTAV                                      SCAL0056
      IF (T-YN)  55,57,57                                               SCAL0057
 55   FIRSTV=P*AINT(Y0/P+FAD)                                           SCAL0058
      T=FIRSTV+(AXLEN+.01)*DELTAV                                       SCAL0059
      IF (T-YN) 56,57,57                                                SCAL0060
 56   IS=IS+1                                                           SCAL0061
      GO  TO  50                                                        SCAL0062
57    FIRSTV=FIRSTV-AINT((AXLEN+(FIRSTV-YN)/DELTAV)/2.0)*DELTAV         SCAL0063
      IF (Y0*FIRSTV) 58,58,59                                           SCAL0064
58    FIRSTV=0.0                                                        SCAL0065
59    IF  (INC) 61,61,65                                                SCAL0066
 61   FIRSTV=FIRSTV+AINT(AXLEN+.5)*DELTAV                               SCAL0067
      DELTAV=-DELTAV                                                    SCAL0068
65    N=N+1                                                             SCAL0069
      ARRAY(N)=FIRSTV                                                   SCAL0070
      N=N+K                                                             SCAL0071
      ARRAY(N)=DELTAV                                                   SCAL0072
67    RETURN                                                            SCAL0073
 70   DELTAV=2.0*FIRSTV                                                 SCAL0074
      DELTAV=ABS(DELTAV/AXLEN)+1.                                       SCAL0075
      GO TO 40                                                          SCAL0076
      END                                                               SCAL0077
C            NUMBER METRIC                                                  0012
      SUBROUTINE NUMBER (XPAGE,YPAGE,HEIGHT,FPN,ANGLE,NDEC)             NMBR0001
CALCOMP  NUMBER SUBROUTINE FOR FORTRAN 77        EBCDIC PUNCH           NMBR0002
CALCOMP HCBS FOR  ALL CONTROLLERS                          SEPT, 1981 * NMBR0003
C             PROPRIETARY SOFTWARE NOTIFICATION                         NUMB0004
C  THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF        NUMB0005
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON THE  NUMB0006
C    DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED AND      NUMB0007
C    CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT PRIOR NUMB0008
C    WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.              NUMB0009
C  IF SUPPLIED UNDER A GOVERNMENT CONTRACT, THE FOLLOWING APPLIES:      NUMB0010
C                 RESTRICTED RIGHTS LEGEND                              NUMB0011
C  USE, DUPLICATION OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT TO       NUMB0012
C    RESTRICTIONS AS SET FORTH IN PARAGRAPH (B)(3)(B) OF THE RIGHTS     NUMB0013
C    IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE IN DAR 7-104.9      NUMB0014
C    (A).  CALIFORNIA COMPUTER PRODUCTS, INC., 2411 WEST LAPALMA        NUMB0015
C    AVENUE, ANAHEIM, CALIFORNIA 92803.                                 NUMB0016
C.....     XPAGE,YPAGE COORDINATES OF LOWER LEFT CORNER OF NUMBER.      NMBR0017
C.....     HEIGHT   HEIGHT OF PLOTTED NUMBER.                           NMBR0018
C.....     FPN      FLOATING POINT NUMBER TO BE PLOTTED.                NMBR0019
C.....     ANGLE    ANGLE AT WHICH NUMBER IS PLOTTED, IN DEGREES.       NMBR0020
C.....     NDEC     NUMBER OF DECIMAL PLACES TO BE DRAWN.               NMBR0021
C.....     THIS VERSION OF NUMBER REQUIRES THE SYMBOL VERSION WITH      NMBR0022
C.....     999. X, Y FEATURE, AND  NC = 0 FEATURE.                      NMBR0023
      CHARACTER *(1) NUM(20)                                            NMBR0024
      CHARACTER * 1 MINUS,IZERO,IPOINT                                  NMBR0025
      DATA MINUS /'-'/,IZERO/'0'/,IPOINT/'.'/                           NMBR0026
C     IZERO='0'                                                         NMBR0027
      II=0                                                              NMBR0028
      FPV = FPN                                                         NMBR0029
      N = NDEC                                                          NMBR0030
      MAXN = 9                                                          NMBR0031
      IF (N - MAXN) 11, 11, 10                                          NMBR0032
   10 N = MAXN                                                          NMBR0033
   11 IF (N + MAXN) 12, 20, 20                                          NMBR0034
   12 N = -MAXN                                                         NMBR0035
   20 IF (FPV) 21, 30, 30                                               NMBR0036
21    II=II+1                                                           NMBR0037
      NUM(II)=MINUS                                                     NMBR0038
   30 MN = -N                                                           NMBR0039
      IF (N) 31, 32, 32                                                 NMBR0040
   31 MN = MN - 1                                                       NMBR0041
   32 FPV = ABS(FPV) + (0.5 * 10. ** MN)                                NMBR0042
      I = ALOG10(FPV)+1.0                                               NMBR0043
      ILP = I                                                           NMBR0044
      IF (N + 1)  40, 41, 41                                            NMBR0045
   40 ILP = ILP + N + 1                                                 NMBR0046
   41 IF (ILP)  50, 50, 51                                              NMBR0047
50    II=II+1                                                           NMBR0048
      NUM(II)=IZERO                                                     NMBR0049
      GO TO 61                                                          NMBR0050
51    IF (ILP+N-18) 54,54,52                                            NMBR0051
52    N=-1                                                              NMBR0052
      IF (ILP-19) 54,54,53                                              NMBR0053
53    ILP=19                                                            NMBR0054
54    DO 60 J=1,ILP                                                     NMBR0055
        K = FPV * 10. ** (J - I)                                        NMBR0056
      IF (K-9) 57,57,55                                                 NMBR0057
   55   K = 9                                                           NMBR0058
   57 II=II+1                                                           NMBR0059
      KK = ICHAR(IZERO) + K                                             NMBR0060
      NUM(II)=CHAR(KK)                                                  NMBR0061
        FPV = FPV - (FLOAT(K) * 10. ** (I - J))                         NMBR0062
60    CONTINUE                                                          NMBR0063
   61 IF (N) 99, 70, 70                                                 NMBR0064
70    II=II+1                                                           NMBR0065
      NUM(II)=IPOINT                                                    NMBR0066
      IF (N)  99, 99, 80                                                NMBR0067
   80 DO 90 J = 1, N                                                    NMBR0068
        K = FPV * 10.                                                   NMBR0069
      IF (K-9) 84,84,82                                                 NMBR0070
   82   K = 9                                                           NMBR0071
   84 II=II+1                                                           NMBR0072
      KK = ICHAR(IZERO) + K                                             NMBR0073
      NUM(II)=CHAR(KK)                                                  NMBR0074
   90   FPV = FPV * 10. - FLOAT(K)                                      NMBR0075
99    CALL SYMBOL (XPAGE,YPAGE,HEIGHT,NUM,INTEQ,ANGLE,II+1000)          NMBR0076
      RETURN                                                            NMBR0077
      END                                                               NMBR0078
C            907 SYMBOL METRIC                                              0014
      SUBROUTINE SYMBOL(XPAGE,YPAGE,HEIGH,IBCD,INTEQ,ANGLE,NCHAR)       SYMB0001
CALCOMP SYMBOL SUBROUTINE FOR 907 CONTROLLER     EBCDIC PUNCH           SYMB0002
CALCOMP HCBS FOR 907 CONTROLLER                            SEPT, 1981 * SYMB0003
C             PROPRIETARY SOFTWARE NOTIFICATION                         SYMB0004
C  THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF        SYMB0005
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON THE  SYMB0006
C    DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED AND      SYMB0007
C    CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT PRIOR SYMB0008
C    WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.              SYMB0009
C  IF SUPPLIED UNDER A GOVERNMENT CONTRACT, THE FOLLOWING APPLIES:      SYMB0010
C                 RESTRICTED RIGHTS LEGEND                              SYMB0011
C  USE, DUPLICATION OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT TO       SYMB0012
C    RESTRICTIONS AS SET FORTH IN PARAGRAPH (B)(3)(B) OF THE RIGHTS     SYMB0013
C    IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE IN DAR 7-104.9      SYMB0014
C    (A).  CALIFORNIA COMPUTER PRODUCTS, INC., 2411 WEST LAPALMA        SYMB0015
C    AVENUE, ANAHEIM, CALIFORNIA 92803.                                 SYMB0016
      SAVE                                                              SYMB0017
      CHARACTER * (*) IBCD                                              SYMB0018
      DATA FCTMX/16383.0/                                               SYMB0019
      DATA XP,YP/2*0.0/,IOXA,IOYA/2*0/                                  SYMB0020
      DATA ICENT/16/,IMIN/1000/,ICTRSY/288/,IASCII/95/                  SYMB0021
C                                                                       SYMB0022
      IF(HEIGH ) 5,999,5                                                SYMB0023
    5 IPEN=3                                                            SYMB0024
      NT=NCHAR                                                          SYMB0025
      NC=1                                                              SYMB0026
      XO=XPAGE                                                          SYMB0027
      IF(ABS(XO-999.0)-0.1)10,20,20                                     SYMB0028
   10 XO=XP                                                             SYMB0029
   20 YO=YPAGE                                                          SYMB0030
      IF(ABS(YO-999.0)-0.1)50,60,60                                     SYMB0031
   50 YO=YP                                                             SYMB0032
   60 TH=ANGLE*0.017453                                                 SYMB0033
      SINTH=SIN(TH )                                                    SYMB0034
      COSTH=COS(TH )                                                    SYMB0035
      IF(NT) 61,80,70                                                   SYMB0036
  61  IF(NT+1) 62,63,63                                                 SYMB0037
  62  IPEN=2                                                            SYMB0038
C                 SPECIAL (-1) SYMBOL CALL                              SYMB0039
  63  K =INTEQ    - ICENT                                               SYMB0040
      XNC = 1.0                                                         SYMB0041
      IF ( K ) 66,85,64                                                 SYMB0042
  64  IF (K-ICTRSY+ICENT) 85, 65, 65                                    SYMB0043
C                 USER-DEFINED SYMBOLS ARE CENTERED SYMBOLS             SYMB0044
  65  K = K + ICENT                                                     SYMB0045
      XNC = 0.0                                                         SYMB0046
      GO TO 85                                                          SYMB0047
  66  K = K + ICTRSY                                                    SYMB0048
      XNC = 0.0                                                         SYMB0049
      GO TO 85                                                          SYMB0050
   70 NC=MOD(NT,1000)                                                   SYMB0051
   80 XNC=NC                                                            SYMB0052
C                                                                       SYMB0053
   85 CALL PLOT(XO,YO,IPEN)                                             SYMB0054
      CALL PLOT(STEPS,SCL,1005)                                         SYMB0055
      IF (SCL.LT.1.0) SCL = 1.0                                         SYMB0056
      ISCL = SCL                                                        SYMB0057
      FCT=HEIGH*STEPS                                                   SYMB0058
      FCTMXX = FLOAT ( IFIX ( FCTMX/SCL ) )                             SYMB0059
      IF(FCT-FCTMXX)100,100,90                                          SYMB0060
   90 FCT=FCTMXX                                                        SYMB0061
  100 XA=FCT*COSTH                                                      SYMB0062
      YA=FCT*SINTH                                                      SYMB0063
      IXA=XA+SIGN(0.5,XA)                                               SYMB0064
      IYA=YA+SIGN(0.5,YA)                                               SYMB0065
      IADD = 0                                                          SYMB0066
      IF (IXA .GT. 0) IADD = 14                                         SYMB0067
      IXA = IXA + (IXA + IADD)/15                                       SYMB0068
      IADD = 0                                                          SYMB0069
      IF (IYA .GT. 0) IADD = 14                                         SYMB0070
      IYA = IYA + (IYA + IADD)/15                                       SYMB0071
C          CHECK IF NEED TO SEND SIZE INFORMATION                       SYMB0072
      IF (IXA-IOXA) 104,102,104                                         SYMB0073
102   IF (IYA-IOYA) 104,108,104                                         SYMB0074
104   CALL BUFF (8,0,6,IBCD)                                            SYMB0075
      CALL BUFF(6,1,0,IBCD)                                             SYMB0076
      CALL BUFF (IXA,IYA,2,IBCD)                                        SYMB0077
      IOXA = IXA                                                        SYMB0078
      IOYA = IYA                                                        SYMB0079
108   IF (NT) 110,120,130                                               SYMB0080
C                   SPECIAL SYMBOL CALL - DECIDE HOW TO CALL IT         SYMB0081
  110 IF (K-IASCII) 119,119,111                                         SYMB0082
C             OUTPUT SPECIAL EXTENDED SYMBOL CALL                       SYMB0083
  111 CALL BUFF ( 4,0,6 ,IBCD)                                          SYMB0084
      CALL BUFF ( 14,1,0 ,IBCD)                                         SYMB0085
      CALL BUFF ( 15,1,0 ,IBCD)                                         SYMB0086
      K1 = K / 16                                                       SYMB0087
      CALL BUFF ( K1,1,0 ,IBCD)                                         SYMB0088
      K1 = MOD ( K, 16 )                                                SYMB0089
      CALL BUFF ( K1,1,0 ,IBCD)                                         SYMB0090
      GO TO 900                                                         SYMB0091
  119 CALL BUFF(K+IMIN ,1,4,IBCD)                                       SYMB0092
      GO TO 900                                                         SYMB0093
  120 CALL BUFF(IDUM,NC,3,IBCD)                                         SYMB0094
      GO TO 900                                                         SYMB0095
  130 IF(NT-1000)140,140,150                                            SYMB0096
  140 CALL BUFF(IDUM   ,NC,3,IBCD)                                      SYMB0097
      GO TO 900                                                         SYMB0098
  150 CALL BUFF(IDUM    ,NC,3,IBCD)                                     SYMB0099
C                   ADJUST FINAL POSITION                               SYMB0100
  900 PX = 0.0                                                          SYMB0101
      PY = 0.0                                                          SYMB0102
      XADD = 0.0                                                        SYMB0103
      IF (IXA) 910,930,920                                              SYMB0104
  910 XADD = -15.0                                                      SYMB0105
  920 PX = XNC * FLOAT(IFIX((XADD+15.*FLOAT(IXA))/16.))                 SYMB0106
  930 XADD = 0.0                                                        SYMB0107
      IF (IYA) 940,960,950                                              SYMB0108
  940 XADD = -15.0                                                      SYMB0109
  950 PY = XNC * FLOAT(IFIX((XADD+15.*FLOAT(IYA))/16.))                 SYMB0110
  960 CONTINUE                                                          SYMB0111
C THE FOLLOWING CALL UPDATES OLDX & OLDY  IN PLOT ROUTINE               SYMB0112
      CALL PLOT(PX,PY,1006)                                             SYMB0113
C THE FOLLOWING CALL GETS THE OLDX & OLDY VALUE FROM PLOT ROUTINE.      SYMB0114
      CALL PLOT(XP,YP,1002)                                             SYMB0115
  999 RETURN                                                            SYMB0116
      END                                                               SYMB0117
C            907 PLOT METRIC                                                0016
      SUBROUTINE PLOT(XPAG ,YPAG ,IPEN)                                 PLOT0001
CALCOMP  PLOT SUBROUTINE FOR 907 CONTROLLER      EBCDIC PUNCH           PLOT0002
CALCOMP HCBS FOR 907 CONTROLLER                            SEPT, 1981 * PLOT0003
C             PROPRIETARY SOFTWARE NOTIFICATION                         PLOT0004
C  THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF        PLOT0005
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON THE  PLOT0006
C    DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED AND      PLOT0007
C    CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT PRIOR PLOT0008
C    WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.              PLOT0009
C  IF SUPPLIED UNDER A GOVERNMENT CONTRACT, THE FOLLOWING APPLIES:      PLOT0010
C                 RESTRICTED RIGHTS LEGEND                              PLOT0011
C  USE, DUPLICATION OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT TO       PLOT0012
C    RESTRICTIONS AS SET FORTH IN PARAGRAPH (B)(3)(B) OF THE RIGHTS     PLOT0013
C    IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE IN DAR 7-104.9      PLOT0014
C    (A).  CALIFORNIA COMPUTER PRODUCTS, INC., 2411 WEST LAPALMA        PLOT0015
C    AVENUE, ANAHEIM, CALIFORNIA 92803.                                 PLOT0016
      SAVE                                                              PLOT0017
      CHARACTER * 1 IBCD                                                PLOT0018
      DATA IOP,ISA,IPFG,INDEX/3,2,0,0/                                  PLOT0019
      DATA DPX/32767.0/,XSTP,YSTP,STEPS/ 508.0, 508.0, 508.0/           PLOT0020
      DATA XOX,YOY/0.0,0.0/                                             PLOT0021
      DATA N/1/                                                         PLOT0022
C     SAVE INPUT                                                        PLOT0023
      IP=IPEN                                                           PLOT0024
C     CHECK FOR SPECIAL ENTRANCE                                        PLOT0025
      IF(IABS(IP)-999)100,150,600                                       PLOT0026
  100 IPFG=0                                                            PLOT0027
C     CHECK FOR VARIOUS IPEN FUNCTIONS                                  PLOT0028
      IF(IP)110,120,120                                                 PLOT0029
C     IF IPEN NEGATIVE  REORIGIN                                        PLOT0030
  110 IP=-IP                                                            PLOT0031
      IPFG=-10                                                          PLOT0032
C     CHECK FOR IPEN BETWEEN 30 & 39                                    PLOT0033
  120 IF (IP-30)  200,130,130                                           PLOT0034
  130 IF (IP-40)  140,200,200                                           PLOT0035
  140 IP = IP-30                                                        PLOT0036
      IPFG = IPFG-1                                                     PLOT0037
      GO TO 200                                                         PLOT0038
C     ASSUME IPEN IS 999                                                PLOT0039
  150 IP=3                                                              PLOT0040
      IPFG = -99                                                        PLOT0041
      ISA = 999                                                         PLOT0042
C     CHECK FOR PEN CHANGE                                              PLOT0043
  200 IF(IP-IOP)210,290,210                                             PLOT0044
C     CHECK FOR PEN DOWN                                                PLOT0045
  210 IF(IP-2)290,220,230                                               PLOT0046
C     PEN DOWN                                                          PLOT0047
  220 IOP=2                                                             PLOT0048
      CALL BUFF(2,1,0,IBCD)                                             PLOT0049
      GO TO 290                                                         PLOT0050
C     PEN UP                                                            PLOT0051
  230 IOP=3                                                             PLOT0052
      CALL BUFF(3,1,0,IBCD)                                             PLOT0053
  290 XP=XPAG*XSTP                                                      PLOT0054
      YP=YPAG*YSTP                                                      PLOT0055
300   XDX=XP-XOX                                                        PLOT0056
      YDY=YP-YOY                                                        PLOT0057
      XDX=XDX+SIGN(.5,XDX)                                              PLOT0058
      YDY=YDY+SIGN(.5,YDY)                                              PLOT0059
      ADX=ABS(XDX)                                                      PLOT0060
      ADY=ABS(YDY)                                                      PLOT0061
      IF(ADX-DPX) 350,350,310                                           PLOT0062
  310 IF(ADX-ADY) 320,320,330                                           PLOT0063
  320 DIV=ADY/DPX                                                       PLOT0064
      GO TO 340                                                         PLOT0065
  330 DIV=ADX/DPX                                                       PLOT0066
  340 IDX=XDX/DIV                                                       PLOT0067
      IDY=YDY/DIV                                                       PLOT0068
C          SEND OUT PART OF THE REQUESTED MOVE                          PLOT0069
      CALL BUFF(IDX,IDY,2,IBCD)                                         PLOT0070
      XOX = XOX + FLOAT(IDX)                                            PLOT0071
      YOY = YOY + FLOAT(IDY)                                            PLOT0072
      GO TO 300                                                         PLOT0073
C     SEND OUT LAST PART OF LINE                                        PLOT0074
  350 IF (ADY-DPX) 360,360,320                                          PLOT0075
  360 IDX=XDX                                                           PLOT0076
      IDY=YDY                                                           PLOT0077
      CALL BUFF(IDX,IDY,2,IBCD)                                         PLOT0078
      XOX = XOX + FLOAT(IDX)                                            PLOT0079
      YOY = YOY + FLOAT(IDY)                                            PLOT0080
C     CHECK AT END FOR VARIOUS IPEN FUNCTIONS                           PLOT0081
  450 IF(IPFG+1) 460,470,999                                            PLOT0082
C     REORIGN, DUMP BUFFER, AND OUTPUT S.A.                             PLOT0083
  460 XOX=0.0                                                           PLOT0084
      YOY=0.0                                                           PLOT0085
C     CHECK FOR OUTPUT OF INDEX COMMAND                                 PLOT0086
      IF (INDEX-1)  490,480,470                                         PLOT0087
  470 IF (IPFG+99)  490,480,490                                         PLOT0088
C     OUTPUT INDEX COMMAND                                              PLOT0089
  480 CALL BUFF(3,0,6,IBCD)                                             PLOT0090
      CALL BUFF(11,1,0,IBCD)                                            PLOT0091
      CALL BUFF(0,1,0,IBCD)                                             PLOT0092
      CALL BUFF(6,1,0,IBCD)                                             PLOT0093
C     DUMP BUFFER AND WRITE NEXT S.A.                                   PLOT0094
  490 CALL BUFF(0,0,5,IBCD)                                             PLOT0095
      CALL BUFF(1,1,0,IBCD)                                             PLOT0096
      CALL BUFF(ISA,3,7,IBCD)                                           PLOT0097
      ISA = ISA+1                                                       PLOT0098
C     CHECK FOR IPEN = 999                                              PLOT0099
      IF (IPFG+99) 999,500,999                                          PLOT0100
  500 CALL BUFF(0,0,1,IBCD)                                             PLOT0101
  999 RETURN                                                            PLOT0102
C                              CHECK FOR SPECIAL PLOT ENTRIES           PLOT0103
  600 IP=IP-1000                                                        PLOT0104
      IF(IP-7)610,610,999                                               PLOT0105
  610 GO TO(1001,1002,1003,1004,1005,1006,1007),IP                      PLOT0106
C                                                       FACTOR          PLOT0107
 1001 XSTP=XPAG*STEPS                                                   PLOT0108
      YSTP=YPAG*STEPS                                                   PLOT0109
      GO TO 999                                                         PLOT0110
C                                                       WHERE           PLOT0111
 1002 XPAG=XOX/XSTP                                                     PLOT0112
      YPAG=YOY/YSTP                                                     PLOT0113
      GO TO 999                                                         PLOT0114
 1003 XPAG=XSTP/STEPS                                                   PLOT0115
      YPAG=YSTP/STEPS                                                   PLOT0116
      GO TO 999                                                         PLOT0117
C                                                        NEWPEN         PLOT0118
 1004 IOP = 3                                                           PLOT0119
      GO TO 999                                                         PLOT0120
C                                         SYMBOL FIND STEP SIZE         PLOT0121
 1005 XPAG=XSTP                                                         PLOT0122
      YPAG= N                                                           PLOT0123
      GO TO 999                                                         PLOT0124
C                           SYMBOL ADVANCE CURRENT PEN POSITION         PLOT0125
 1006 XOX=XOX+XPAG                                                      PLOT0126
      YOY=YOY+YPAG                                                      PLOT0127
      IOP=3                                                             PLOT0128
      GO TO 999                                                         PLOT0129
C                                                        PLOTS          PLOT0130
 1007 IF (XPAG) 1027,1027,1017                                          PLOT0131
 1017 N = MIN0(32,IFIX(XPAG))                                           PLOT0132
      STEPS = STEPS/N                                                   PLOT0133
      XSTP = STEPS                                                      PLOT0134
      YSTP = STEPS                                                      PLOT0135
      DPX = DPX  / N                                                    PLOT0136
      CALL BUFF(2,0,6,IBCD)                                             PLOT0137
      CALL BUFF(9,1,0,IBCD)                                             PLOT0138
      CALL BUFF(N,1,0,IBCD)                                             PLOT0139
 1027 IF (YPAG)  999, 999,1037                                          PLOT0140
 1037 INDEX = YPAG                                                      PLOT0141
      GO TO 480                                                         PLOT0142
      END                                                               PLOT0143
C            FACTOR                                                         0018
      SUBROUTINE FACTOR(FCT)                                            FACT0001
CALCOMP  FACTOR SUBROUTINE FOR FORTRAN 77        EBCDIC PUNCH           FACT0002
CALCOMP HCBS FOR 906 AND 907 CONTROLLER                    SEPT, 1981 * FACT0003
C             PROPRIETARY SOFTWARE NOTIFICATION                         FACT0004
C  THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF        FACT0005
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON THE  FACT0006
C    DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED AND      FACT0007
C    CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT PRIOR FACT0008
C    WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.              FACT0009
C  IF SUPPLIED UNDER A GOVERNMENT CONTRACT, THE FOLLOWING APPLIES:      FACT0010
C                 RESTRICTED RIGHTS LEGEND                              FACT0011
C  USE, DUPLICATION OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT TO       FACT0012
C    RESTRICTIONS AS SET FORTH IN PARAGRAPH (B)(3)(B) OF THE RIGHTS     FACT0013
C    IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE IN DAR 7-104.9      FACT0014
C    (A).  CALIFORNIA COMPUTER PRODUCTS, INC., 2411 WEST LAPALMA        FACT0015
C    AVENUE, ANAHEIM, CALIFORNIA 92803.                                 FACT0016
      CALL PLOT(FCT,FCT,1001)                                           FACT0017
      RETURN                                                            FACT0018
      END                                                               FACT0019
C            WHERE                                                          0020
      SUBROUTINE WHERE(XPAG,YPAG,FCT)                                   WHER0001
CALCOMP  WHERE SUBROUTINE FOR FORTRAN 77         EBCDIC PUNCH           WHER0002
CALCOMP HCBS FOR 906 AND 907 CONTROLLER                    SEPT, 1981 * WHER0003
C             PROPRIETARY SOFTWARE NOTIFICATION                         WHER0004
C  THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF        WHER0005
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON THE  WHER0006
C    DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED AND      WHER0007
C    CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT PRIOR WHER0008
C    WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.              WHER0009
C  IF SUPPLIED UNDER A GOVERNMENT CONTRACT, THE FOLLOWING APPLIES:      WHER0010
C                 RESTRICTED RIGHTS LEGEND                              WHER0011
C  USE, DUPLICATION OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT TO       WHER0012
C    RESTRICTIONS AS SET FORTH IN PARAGRAPH (B)(3)(B) OF THE RIGHTS     WHER0013
C    IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE IN DAR 7-104.9      WHER0014
C    (A).  CALIFORNIA COMPUTER PRODUCTS, INC., 2411 WEST LAPALMA        WHER0015
C    AVENUE, ANAHEIM, CALIFORNIA 92803.                                 WHER0016
      CALL PLOT(X,Y,1002)                                               WHER0017
      XPAG=X                                                            WHER0018
      YPAG=Y                                                            WHER0019
      CALL PLOT(X,Y,1003)                                               WHER0020
      FCT=X                                                             WHER0021
      RETURN                                                            WHER0022
      END                                                               WHER0023
C            NEWPEN                                                         0022
      SUBROUTINE NEWPEN(INPN)                                           NEWP0001
CALCOMP  NEWPEN SUBROUTINE FOR FORTRAN 77        EBCDIC PUNCH           NEWP0002
CALCOMP HCBS FOR 906 AND 907 CONTROLLER                    SEPT, 1981 * NEWP0003
C             PROPRIETARY SOFTWARE NOTIFICATION                         NEWP0004
C  THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF        NEWP0005
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON THE  NEWP0006
C    DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED AND      NEWP0007
C    CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT PRIOR NEWP0008
C    WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.              NEWP0009
C  IF SUPPLIED UNDER A GOVERNMENT CONTRACT, THE FOLLOWING APPLIES:      NEWP0010
C                 RESTRICTED RIGHTS LEGEND                              NEWP0011
C  USE, DUPLICATION OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT TO       NEWP0012
C    RESTRICTIONS AS SET FORTH IN PARAGRAPH (B)(3)(B) OF THE RIGHTS     NEWP0013
C    IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE IN DAR 7-104.9      NEWP0014
C    (A).  CALIFORNIA COMPUTER PRODUCTS, INC., 2411 WEST LAPALMA        NEWP0015
C    AVENUE, ANAHEIM, CALIFORNIA 92803.                                 NEWP0016
C                                                                       NEWP0017
      CHARACTER * 1 IBCD                                                NEWP0018
      CALL BUFF (2,0,6,IBCD)                                            NEWP0019
      CALL BUFF (4,1,0,IBCD)                                            NEWP0020
      CALL BUFF (MOD(INPN,32),1,0,IBCD)                                 NEWP0021
      CALL PLOT(0.,0.,1004)                                             NEWP0022
   90 RETURN                                                            NEWP0023
      END                                                               NEWP0024
C            PLOTS                                                          0024
      SUBROUTINE PLOTS(ISF,INDEX,LDEV)                                  PLTS0001
CALCOMP  PLOTS SUBROUTINE FOR FORTRAN 77         EBCDIC PUNCH           PLTS0002
CALCOMP HCBS FOR 906 AND 907 CONTROLLER                    SEPT, 1981 * PLTS0003
C             PROPRIETARY SOFTWARE NOTIFICATION                         PLTS0004
C  THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF        PLTS0005
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON THE  PLTS0006
C    DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED AND      PLTS0007
C    CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT PRIOR PLTS0008
C    WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.              PLTS0009
C  IF SUPPLIED UNDER A GOVERNMENT CONTRACT, THE FOLLOWING APPLIES:      PLTS0010
C                 RESTRICTED RIGHTS LEGEND                              PLTS0011
C  USE, DUPLICATION OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT TO       PLTS0012
C    RESTRICTIONS AS SET FORTH IN PARAGRAPH (B)(3)(B) OF THE RIGHTS     PLTS0013
C    IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE IN DAR 7-104.9      PLTS0014
C    (A).  CALIFORNIA COMPUTER PRODUCTS, INC., 2411 WEST LAPALMA        PLTS0015
C    AVENUE, ANAHEIM, CALIFORNIA 92803.                                 PLTS0016
      CHARACTER * 1 IBCD                                                PLTS0017
      DIMENSION ARRAY(2)                                                PLTS0018
C                                                                       PLTS0019
      DATA ARRAY /-0.1,0.1/                                             PLTS0020
C                  CALL BUFF WITH "SET-UP" PARAMETERS                   PLTS0021
      CALL BUFF (LDEV,0,1,IBCD)                                         PLTS0022
      CALL PLOT (FLOAT(-ISF),FLOAT(-INDEX),1007)                        PLTS0023
C          DEFINE DEFAULT DASHLINE LENGTH                               PLTS0024
      CALL DASHS(ARRAY,2)                                               PLTS0025
      CALL DASHS(ARRAY,0)                                               PLTS0026
      RETURN                                                            PLTS0027
      END                                                               PLTS0028
C            OPMES                                                          0026
      SUBROUTINE OPMES(NCT,MESG)                                        OPMS0001
CALCOMP  OPMES SUBROUTINE FOR FORTRAN 77         EBCDIC PUNCH           OPMS0002
CALCOMP HCBS FOR 906 AND 907 CONTROLLER                    SEPT, 1981 * OPMS0003
C             PROPRIETARY SOFTWARE NOTIFICATION                         OPMS0004
C  THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF        OPMS0005
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON THE  OPMS0006
C    DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED AND      OPMS0007
C    CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT PRIOR OPMS0008
C    WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.              OPMS0009
C  IF SUPPLIED UNDER A GOVERNMENT CONTRACT, THE FOLLOWING APPLIES:      OPMS0010
C                 RESTRICTED RIGHTS LEGEND                              OPMS0011
C  USE, DUPLICATION OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT TO       OPMS0012
C    RESTRICTIONS AS SET FORTH IN PARAGRAPH (B)(3)(B) OF THE RIGHTS     OPMS0013
C    IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE IN DAR 7-104.9      OPMS0014
C    (A).  CALIFORNIA COMPUTER PRODUCTS, INC., 2411 WEST LAPALMA        OPMS0015
C    AVENUE, ANAHEIM, CALIFORNIA 92803.                                 OPMS0016
C                                                                       OPMS0017
      CHARACTER * (*) MESG                                              OPMS0018
      INCT=IABS(NCT)                                                    OPMS0019
      CALL BUFF(INCT+3,0,6,MESG)                                        OPMS0020
      IF (NCT) 30, 10, 20                                               OPMS0021
C               PAUSE PLOTTER ONLY                                      OPMS0022
   10 CALL BUFF(10, 1, 0,MESG)                                          OPMS0023
      GO TO 99                                                          OPMS0024
C               PAUSE PLOTTER AND WRITE MESSAGE                         OPMS0025
   20 CALL BUFF(14, 1, 0,MESG)                                          OPMS0026
      CALL BUFF(7, 1, 0,MESG)                                           OPMS0027
      CALL BUFF(IDUM   , INCT, 8,MESG )                                 OPMS0028
      GO TO 99                                                          OPMS0029
C               WRITE THE MESSAGE                                       OPMS0030
   30 CALL BUFF(14, 1, 0,MESG)                                          OPMS0031
      CALL BUFF(6, 1, 0,MESG)                                           OPMS0032
      CALL BUFF(IDUM   , INCT, 8,MESG )                                 OPMS0033
   99 RETURN                                                            OPMS0034
      END                                                               OPMS0035
C            CIRCLE                                                         0028
      SUBROUTINE CIRCLE (P1, P2, P3, P4, RADIUS, MODE)                  CIRC0001
CALCOMP  CIRCLE SUBROUTINE FOR FORTRAN 77        EBCDIC PUNCH           CIRC0002
CALCOMP HCBS FOR 907 CONTROLLER                             SEPT, 1981  CIRC0003
C             PROPRIETARY SOFTWARE NOTIFICATION                         CIRC0004
C  THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF        CIRC0005
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON THE  CIRC0006
C    DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED AND      CIRC0007
C    CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT PRIOR CIRC0008
C    WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.              CIRC0009
C  IF SUPPLIED UNDER A GOVERNMENT CONTRACT, THE FOLLOWING APPLIES:      CIRC0010
C                 RESTRICTED RIGHTS LEGEND                              CIRC0011
C  USE, DUPLICATION OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT TO       CIRC0012
C    RESTRICTIONS AS SET FORTH IN PARAGRAPH (B)(3)(B) OF THE RIGHTS     CIRC0013
C    IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE IN DAR 7-104.9      CIRC0014
C    (A).  CALIFORNIA COMPUTER PRODUCTS, INC., 2411 WEST LAPALMA        CIRC0015
C    AVENUE, ANAHEIM, CALIFORNIA 92803.                                 CIRC0016
C  THIS SUBROUTINE WILL DRAW CIRCLES OR CIRCULAR ARCS                   CIRC0017
C  THE MEANINGS OF PARAMETERS P1 - P4 WILL VARY DEPENDING ON            CIRC0018
C  THE VALUE OF MODE                                                    CIRC0019
C                                                                       CIRC0020
      CHARACTER * 1 IBCD                                                CIRC0021
      DATA DMAX /32767.0/                                               CIRC0022
C                                                                       CIRC0023
      CALL PLOT (STEPS, YDUM, 1005)                                     CIRC0024
      AS = 0.0                                                          CIRC0025
      AE = 0.0                                                          CIRC0026
      ARCANG = 0.0                                                      CIRC0027
      IMODE = IABS(MODE)                                                CIRC0028
C               1 <= IMODE <= 7                                         CIRC0029
      IF (IMODE) 9000, 9000, 10                                         CIRC0030
   10 IF (IMODE-7) 20, 20, 9000                                         CIRC0031
   20 GO TO (100, 200, 200, 400, 500, 600, 700),IMODE                   CIRC0032
C                                                                       CIRC0033
  100 XS = P1                                                           CIRC0034
      YS = P2                                                           CIRC0035
      XC = P3                                                           CIRC0036
      YC = P4                                                           CIRC0037
      GO TO 1000                                                        CIRC0038
C                                                                       CIRC0039
  200 XS = P1                                                           CIRC0040
      YS = P2                                                           CIRC0041
      XE = P3                                                           CIRC0042
      YE = P4                                                           CIRC0043
      GO TO 1000                                                        CIRC0044
C                                                                       CIRC0045
  400 XS = P1                                                           CIRC0046
      YS = P2                                                           CIRC0047
      AS = P3                                                           CIRC0048
      GO TO 1000                                                        CIRC0049
C                                                                       CIRC0050
  500 XS = P1                                                           CIRC0051
      YS = P2                                                           CIRC0052
      AS = P3                                                           CIRC0053
      AE = P4                                                           CIRC0054
      GO TO 1000                                                        CIRC0055
C                                                                       CIRC0056
  600 XC = P1                                                           CIRC0057
      YC = P2                                                           CIRC0058
      AS = P3                                                           CIRC0059
      GO TO 1000                                                        CIRC0060
C                                                                       CIRC0061
  700 XC = P1                                                           CIRC0062
      YC = P2                                                           CIRC0063
      AS = P3                                                           CIRC0064
      AE = P4                                                           CIRC0065
C                                                                       CIRC0066
C                                                                       CIRC0067
 1000 GO TO (1100, 1100, 1100, 1030, 1010, 1030, 1010),IMODE            CIRC0068
C               REDUCE ANGLES TO +/- 180 DEGREES                        CIRC0069
 1010 I = IFIX(AE /360.0)                                               CIRC0070
      RAE = AE - FLOAT(I * 360)                                         CIRC0071
      IF (RAE - 180.0) 1025, 1025, 1020                                 CIRC0072
 1020 RAE = RAE - 360.0                                                 CIRC0073
 1025 RAE = 0.017453 * RAE                                              CIRC0074
 1030 I = IFIX(AS/360.0)                                                CIRC0075
      RAS = AS - FLOAT(I * 360)                                         CIRC0076
      IF (RAS -180.0) 1050, 1050, 1040                                  CIRC0077
 1040 RAS = RAS - 360.0                                                 CIRC0078
C                CONVERT ANGLES TO RADIANS                              CIRC0079
 1050 RAS = 0.017453 * RAS                                              CIRC0080
C                                                                       CIRC0081
C                                                                       CIRC0082
 1100 GO TO (1200, 1110, 1110, 1110, 1110, 1110, 1110),IMODE            CIRC0083
C               CHECK RADIUS FOR TOO LARGE                              CIRC0084
 1110 R = RADIUS                                                        CIRC0085
      R2 = R * STEPS                                                    CIRC0086
      IF (R2 -DMAX) 1200, 1200, 1120                                    CIRC0087
 1120 R = DMAX/STEPS                                                    CIRC0088
C                                                                       CIRC0089
C                                                                       CIRC0090
 1200 GO TO (1220, 1250, 1250, 1210, 1210, 1210, 1210),IMODE            CIRC0091
C               COMPUTE DISTANCE FROM CENTER TO START                   CIRC0092
 1210 DXC = R * COS(RAS)                                                CIRC0093
      DYC = R * SIN(RAS)                                                CIRC0094
      GO TO 1300                                                        CIRC0095
 1220 DXC = XS - XC                                                     CIRC0096
      DYC = YS - YC                                                     CIRC0097
C               CHECK RADIUS TOO LARGE                                  CIRC0098
      R = SQRT(DXC**2 + DYC**2)                                         CIRC0099
      R2 = R * STEPS                                                    CIRC0100
      IF (R2 - DMAX) 1300, 1300, 1230                                   CIRC0101
 1230 RMAX = DMAX/STEPS                                                 CIRC0102
      DXC = RMAX * DXC / R                                              CIRC0103
      DYC = RMAX * DYC / R                                              CIRC0104
      GO TO 1300                                                        CIRC0105
C                                                                       CIRC0106
C               FIND MIDPOINT OF CHORD                                  CIRC0107
 1250 XM = (XS-XE) / 2 + XE                                             CIRC0108
      YM = (YS-YE) / 2 + YE                                             CIRC0109
      SDIST = (XS-XM)**2 + (YS-YM)**2                                   CIRC0110
C               LENGTH OF PERPENDICULAR TO CHORD                        CIRC0111
      PDIST = R**2 - SDIST                                              CIRC0112
      SLOPE = 0.0                                                       CIRC0113
      IF (YS-YE) 1255, 1256, 1255                                       CIRC0114
C               FIND SLOPE OF PERPENDICULAR TO CHORD                    CIRC0115
 1255 SLOPE = - (XS-XE) / (YS-YE)                                       CIRC0116
C               CHECK FOR RADIUS TOO SHORT                              CIRC0117
 1256 IF (PDIST) 1260, 1270, 1270                                       CIRC0118
 1260 R = SQRT(SDIST)                                                   CIRC0119
      XC = XM                                                           CIRC0120
      YC = YM                                                           CIRC0121
      GO TO 1290                                                        CIRC0122
C                                                                       CIRC0123
 1270 SQ = SQRT(PDIST / (SLOPE**2 + 1))                                 CIRC0124
      IF (YS-YE) 1271, 1280, 1275                                       CIRC0125
 1271 IF (MODE+2) 1272, 1277, 1272                                      CIRC0126
 1272 IF (MODE-3) 1278, 1277, 1278                                      CIRC0127
 1275 IF (MODE-2) 1276, 1277, 1276                                      CIRC0128
 1276 IF (MODE+3) 1278, 1277, 1278                                      CIRC0129
 1277 XC = SQ + XM                                                      CIRC0130
      GO TO 1279                                                        CIRC0131
 1278 XC = -SQ + XM                                                     CIRC0132
 1279 YC = (XC-XM) * SLOPE + YM                                         CIRC0133
      GO TO 1290                                                        CIRC0134
C                                                                       CIRC0135
C               SPECIAL CASE WHERE CHORD IS HORIZONTAL                  CIRC0136
C                                (SLOPE OF PERPENDICULAR IS UNDEFINED)  CIRC0137
 1280 XC = XM                                                           CIRC0138
      IF (XS-XE) 1281, 9000, 1285                                       CIRC0139
 1281 IF (MODE+2) 1282, 1287, 1282                                      CIRC0140
 1282 IF (MODE-3) 1288, 1287, 1288                                      CIRC0141
 1285 IF (MODE-2) 1286, 1287, 1286                                      CIRC0142
 1286 IF (MODE+3) 1288, 1287, 1288                                      CIRC0143
 1287 YC = YM - SQ                                                      CIRC0144
      GO TO 1290                                                        CIRC0145
 1288 YC = YM + SQ                                                      CIRC0146
C               FIND DXC, DYC, DXE, DYE                                 CIRC0147
 1290 DXC = XS - XC                                                     CIRC0148
      DYC = YS - YC                                                     CIRC0149
      DXE = XE - XC                                                     CIRC0150
      DYE = YE - YC                                                     CIRC0151
C                                                                       CIRC0152
C                                                                       CIRC0153
 1300 GO TO (1310, 1310, 1310, 1310, 1310, 1320, 1320),IMODE            CIRC0154
C               MOVE TO START POSITION WITH PEN UP                      CIRC0155
 1310 CALL PLOT (XS, YS, 3)                                             CIRC0156
      GO TO 1400                                                        CIRC0157
C                                                                       CIRC0158
 1320 CALL PLOT (XC+DXC, YC+DYC, 3)                                     CIRC0159
C                                                                       CIRC0160
C                                                                       CIRC0161
 1400 CONTINUE                                                          CIRC0162
C               COMPUTE NO. OF STEPS FROM START TO CENTER               CIRC0163
 1410 DXC = -DXC * STEPS                                                CIRC0164
      DYC = -DYC * STEPS                                                CIRC0165
C               CONVERT TO INTEGER AND ROUND DELTAS                     CIRC0166
      IDXC = DXC + SIGN(0.5, DXC)                                       CIRC0167
      IDYC = DYC + SIGN(0.5, DYC)                                       CIRC0168
C               CHECK FOR ZERO RADIUS                                   CIRC0169
      IF (IDXC) 1500, 1420, 1500                                        CIRC0170
 1420 IF (IDYC) 1500, 9000, 1500                                        CIRC0171
C                                                                       CIRC0172
C                                                                       CIRC0173
 1500 GO TO (3000, 1525, 1525, 3000, 1510, 3000, 1510),IMODE            CIRC0174
C               COMPUTE INCLUDED ANGLE OF REQUESTED ARC                 CIRC0175
 1510 ARCANG = AE -AS                                                   CIRC0176
      ABSARC = ABS(ARCANG)                                              CIRC0177
      IF (ABSARC - 360.0) 1520, 3000, 3000                              CIRC0178
C               FIND DELTA TO END OF ARC                                CIRC0179
 1520 DXE = R * COS(RAE)                                                CIRC0180
      DYE = R * SIN(RAE)                                                CIRC0181
C                                                                       CIRC0182
 1525 DXE = DXE * STEPS                                                 CIRC0183
      DYE = DYE * STEPS                                                 CIRC0184
      IDXE = DXE + SIGN(0.5, DXE)                                       CIRC0185
      IDYE = DYE + SIGN(0.5, DYE)                                       CIRC0186
      IDX = IDXC + IDXE                                                 CIRC0187
      IDY = IDYC + IDYE                                                 CIRC0188
C               IS ARC NON-ZERO LENGTH?                                 CIRC0189
      IF (ARCANG-180.0) 1530, 2000, 2000                                CIRC0190
 1530 IF (IDX) 2000, 1540, 2000                                         CIRC0191
 1540 IF (IDY) 2000, 9000, 2000                                         CIRC0192
C                                                                       CIRC0193
C       GENERATE ARC COMMAND SEQUENCE                                   CIRC0194
C                                                                       CIRC0195
 2000 KMD = 0                                                           CIRC0196
      IF (MODE) 2040, 9000, 2010                                        CIRC0197
 2010 IF (MODE-3) 2030, 2030, 2020                                      CIRC0198
 2020 IF (ARCANG) 2040, 2040, 2030                                      CIRC0199
 2030 KMD = 1                                                           CIRC0200
C               CALL BUFF TO STUFF CIRCLE COMMAND                       CIRC0201
 2040 CALL BUFF(16, 0, 6,IBCD)                                          CIRC0202
      CALL BUFF(12, 1, 0,IBCD)                                          CIRC0203
      CALL BUFF(KMD, 1, 0,IBCD)                                         CIRC0204
      CALL BUFF(IDXC, IDYC, 2,IBCD)                                     CIRC0205
      CALL BUFF(IDXE, IDYE, 2,IBCD)                                     CIRC0206
C               ADJUST PEN POSITION TO FINAL                            CIRC0207
      CALL PLOT(FLOAT(IDX), FLOAT(IDY), 1006)                           CIRC0208
      GO TO 9000                                                        CIRC0209
C                                                                       CIRC0210
C       GENERATE FULL CIRCLE COMMAND                                    CIRC0211
C                                                                       CIRC0212
 3000 KMD = 4                                                           CIRC0213
      IF (MODE) 3020, 9000, 3010                                        CIRC0214
 3010 KMD = 5                                                           CIRC0215
C               CALL BUFF TO STUFF CIRCLE COMMAND                       CIRC0216
 3020 CALL BUFF(9, 0, 6,IBCD)                                           CIRC0217
      CALL BUFF(12, 1, 0,IBCD)                                          CIRC0218
      CALL BUFF(KMD, 1, 0,IBCD)                                         CIRC0219
      CALL BUFF(IDXC, IDYC, 2,IBCD)                                     CIRC0220
C                       (PEN RETURNS TO START POINT)                    CIRC0221
C                                                                       CIRC0222
C       ALL DONE                                                        CIRC0223
C                                                                       CIRC0224
 9000 RETURN                                                            CIRC0225
      END                                                               CIRC0226
C            USERSYM 907 METRIC                                             0030
         SUBROUTINE USRSYM ( ISYMB, IARRAY, ICNT )                      USYM0001
CALCOMP  USRSYM SUBROUTINE FOR 907 CONTROLLER  EBCDIC PUNCH             USYM0002
CALCOMP HCBS FOR 907 CONTROLLER                             SEPT, 1981  USYM0003
C             PROPRIETARY SOFTWARE NOTIFICATION                         USYM0004
C  THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF        USYM0005
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON THE  USYM0006
C    DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED AND      USYM0007
C    CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT PRIOR USYM0008
C    WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.              USYM0009
C  IF SUPPLIED UNDER A GOVERNMENT CONTRACT, THE FOLLOWING APPLIES:      USYM0010
C                 RESTRICTED RIGHTS LEGEND                              USYM0011
C  USE, DUPLICATION OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT TO       USYM0012
C    RESTRICTIONS AS SET FORTH IN PARAGRAPH (B)(3)(B) OF THE RIGHTS     USYM0013
C    IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE IN DAR 7-104.9      USYM0014
C    (A).  CALIFORNIA COMPUTER PRODUCTS, INC., 2411 WEST LAPALMA        USYM0015
C    AVENUE, ANAHEIM, CALIFORNIA 92803.                                 USYM0016
C                                                                       USYM0017
C    ISYMB.....INTEGER CODE FOR SYMBOL TO BE DEFINED.  SAME AS IN       USYM0018
C              SYMBOL ROUTINE -1 CALL.  MUST BE IN RANGE 288-479.       USYM0019
C    IARRAY....INTEGER ARRAY OF OFFSETS, X*100+Y                        USYM0020
C    ICNT......COUNT OF OFFSETS DEFINING THIS SYMBOL IN IARRAY.         USYM0021
C              IF ICNT = -1001, ERASE USER SET 1 (CHARS 288-383)        USYM0022
C              IF ICNT = -1002, ERASE USER SET 2 (CHARS 384-479)        USYM0023
C                                                                       USYM0024
       CHARACTER * 1 IBCD                                               USYM0025
       DIMENSION IARRAY(1)                                              USYM0026
C                                                                       USYM0027
       DATA ICMAX / 60 /                                                USYM0028
C                                                                       USYM0029
       IF ( ICNT ) 500, 100, 100                                        USYM0030
 100   IF ( ICNT - ICMAX ) 110, 110, 900                                USYM0031
 110   IF ( ISYMB - 288 )  900, 120, 120                                USYM0032
 120   IF ( ISYMB - 479 )  130, 130, 900                                USYM0033
C             ISYMB AND ICNT ARE OK, SELECT SYMBOL SET                  USYM0034
 130   ISET = ISYMB/96 + 8                                              USYM0035
       CALL BUFF ( 2, 0, 6 ,IBCD)                                       USYM0036
       CALL BUFF ( 14, 1, 0 ,IBCD)                                      USYM0037
       CALL BUFF ( ISET, 1, 0 ,IBCD)                                    USYM0038
C             SEND DEFINITION                                           USYM0039
       I = 5 + 2*(ICNT+3)                                               USYM0040
       CALL BUFF ( I, 0, 6 ,IBCD)                                       USYM0041
       CALL BUFF ( 14, 1, 0 ,IBCD)                                      USYM0042
       CALL BUFF ( 13, 1, 0 ,IBCD)                                      USYM0043
       I =  MOD ( ISYMB, 96 ) / 16                                      USYM0044
       CALL BUFF ( I, 1, 0 ,IBCD)                                       USYM0045
       I = MOD ( ISYMB, 16 )                                            USYM0046
       CALL BUFF ( I, 1, 0 ,IBCD)                                       USYM0047
       IF (ICNT) 135, 135, 137                                          USYM0048
  135  CALL BUFF (ICNT, 1, 0,IBCD)                                      USYM0049
       GO TO 900                                                        USYM0050
  137  CALL BUFF (ICNT+3, 1, 0,IBCD)                                    USYM0051
C                                                                       USYM0052
 140  IFFLAG = 0                                                        USYM0053
      DO 150 I = 1,ICNT                                                 USYM0054
        IX = MOD( IARRAY(I)/100,16)                                     USYM0055
        IY = MOD( MOD( IARRAY(I),100),16)                               USYM0056
C TEST FOR IX=15 SPECIAL OFFSET                                         USYM0057
        IF (IX-15)      149,141,149                                     USYM0058
C TEST FOR IY=0  PEN UP OFFSET                                          USYM0059
 141    IF (IY)         149,149,143                                     USYM0060
 143    IFFLAG = 1                                                      USYM0061
C TEST FOR IY=15 SPECIAL REORIGIN OFFSET                                USYM0062
C          IY=1-14 SPECIAL Y REORIGIN OFFSET                            USYM0063
        IF (IY-15)      147,145,147                                     USYM0064
C CHECK THAT REORIGIN OFSET IS FIRST IN THE ARRAY                       USYM0065
 145    IF (I-1)        147,149,147                                     USYM0066
C IGNORE NON SUPPORTED OFFSET VALUES                                    USYM0067
 147    GO TO 150                                                       USYM0068
C REPLACE ABOVE WITH FOLLOWING IF OTHER OFFSET VALUES ARE TO  BE ALLOWEDUSYM0069
 149    CALL BUFF(IX,1,0,IBCD)                                          USYM0070
        CALL BUFF(IY,1,0,IBCD)                                          USYM0071
 150  CONTINUE                                                          USYM0072
      IF (IFFLAG-1)     160,170,900                                     USYM0073
 160  CALL BUFF(15,1,0,IBCD)                                            USYM0074
      CALL BUFF( 0,1,0,IBCD)                                            USYM0075
      CALL BUFF( 0,1,0,IBCD)                                            USYM0076
      CALL BUFF( 0,1,0,IBCD)                                            USYM0077
 165  CALL BUFF(15,1,0,IBCD)                                            USYM0078
      CALL BUFF(15,1,0,IBCD)                                            USYM0079
      GO TO 900                                                         USYM0080
 170  CALL BUFF(15,1,0,IBCD)                                            USYM0081
      CALL BUFF( 0,1,0,IBCD)                                            USYM0082
      CALL BUFF( 7,1,0,IBCD)                                            USYM0083
      CALL BUFF( 7,1,0,IBCD)                                            USYM0084
      GO TO 165                                                         USYM0085
C                                                                       USYM0086
C            ERASE USER SYMBOL SET                                      USYM0087
 500   IF ( 1001+ICNT ) 501, 502, 900                                   USYM0088
 501   IF ( 1002+ICNT ) 900, 502, 900                                   USYM0089
C            SEND ERASE COMMAND                                         USYM0090
 502   CALL BUFF ( 4, 0, 6 ,IBCD)                                       USYM0091
       CALL BUFF ( 14, 1, 0 ,IBCD)                                      USYM0092
       II = IABS(ICNT) - 990                                            USYM0093
       CALL BUFF ( II, 1, 0 ,IBCD)                                      USYM0094
       CALL BUFF ( 14, 1, 0 ,IBCD)                                      USYM0095
       CALL BUFF ( 14, 1, 0 ,IBCD)                                      USYM0096
C            RETURN TO SYMBOL SET 0, RETURN                             USYM0097
 900   CALL BUFF ( 2, 0, 6 ,IBCD)                                       USYM0098
       CALL BUFF ( 14, 1, 0 ,IBCD)                                      USYM0099
       CALL BUFF ( 8, 1, 0 ,IBCD)                                       USYM0100
       RETURN                                                           USYM0101
       END                                                              USYM0102
C            DASHS METRIC                                                   0032
      SUBROUTINE DASHS(ARRAY,ICTR)                                      DASH0001
CALCOMP  DASHS SUBROUTINE FOR FORTRAN 77          EBCDIC PUNCH          DASH0002
CALCOMP HCBS FOR 907 CONTROLLER                             SEPT, 1981  DASH0003
C             PROPRIETARY SOFTWARE NOTIFICATION                         DASH0004
C  THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF        DASH0005
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON THE  DASH0006
C    DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED AND      DASH0007
C    CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT PRIOR DASH0008
C    WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.              DASH0009
C  IF SUPPLIED UNDER A GOVERNMENT CONTRACT, THE FOLLOWING APPLIES:      DASH0010
C                 RESTRICTED RIGHTS LEGEND                              DASH0011
C  USE, DUPLICATION OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT TO       DASH0012
C    RESTRICTIONS AS SET FORTH IN PARAGRAPH (B)(3)(B) OF THE RIGHTS     DASH0013
C    IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE IN DAR 7-104.9      DASH0014
C    (A).  CALIFORNIA COMPUTER PRODUCTS, INC., 2411 WEST LAPALMA        DASH0015
C    AVENUE, ANAHEIM, CALIFORNIA 92803.                                 DASH0016
C                                                                       DASH0017
C    ARRAY - ARRAY OF FLOATING POINT VALUES WHICH DEFINE THE            DASH0018
C            PATTERN FOR THE DASHLINE                                   DASH0019
C                                                                       DASH0020
C    ICTR  - +2 TO +16  COUNT OF ELEMENTS IN ARRAY                      DASH0021
C            -2 TO -16  RETURN LAST ELEMENTS STORED                     DASH0022
C                0      TURN OFF DASHLINE MODE                          DASH0023
C               +1      RETURN TO DASHLINE MODE                         DASH0024
C                                                                       DASH0025
      CHARACTER * 1 IBCD                                                DASH0026
      DIMENSION ARRAY(1),SARRAY(16)                                     DASH0027
      DATA MAXDEL/4095/, LSTCNT/2/                                      DASH0028
      DATA SARRAY/-0.1,0.1, 14*0.0/                                     DASH0029
C                                                                       DASH0030
C           SAVE INPUT ICTR                                             DASH0031
      ICNT = ICTR                                                       DASH0032
      IF (ICNT) 500,100,200                                             DASH0033
C            TURN OFF DASHLINE MODE                                     DASH0034
 100  CALL BUFF(2,0,6,IBCD)                                             DASH0035
      CALL BUFF(13,1,0,IBCD)                                            DASH0036
      CALL BUFF(1,1,0,IBCD)                                             DASH0037
      GO TO 900                                                         DASH0038
C                                                                       DASH0039
 200  IF (ICNT-1) 900,300,400                                           DASH0040
C            RETURN TO DASHLINE MODE                                    DASH0041
 300  CALL BUFF(2,0,6,IBCD)                                             DASH0042
      CALL BUFF(13,1,0,IBCD)                                            DASH0043
      CALL BUFF(0,1,0,IBCD)                                             DASH0044
      GO TO 900                                                         DASH0045
C            DEFINE DASHLINE PATTERN                                    DASH0046
 400  IF (ICNT-16) 420,420,410                                          DASH0047
 410  ICNT=16                                                           DASH0048
 420  ILIM=2+7*((ICNT+1)/2)                                             DASH0049
      CALL BUFF(ILIM,0,6,IBCD)                                          DASH0050
      CALL BUFF(13,1,0,IBCD)                                            DASH0051
      CALL BUFF(ICNT,1,0,IBCD)                                          DASH0052
      CALL PLOT(STEPS,SCL,1005)                                         DASH0053
      IF (SCL-1.0) 421,422,422                                          DASH0054
 421  SCL=1.0                                                           DASH0055
C            SAVE ARRAY AND ICNT                                        DASH0056
 422  LSTCNT=ICNT                                                       DASH0057
      DO 425 I=1,ICNT                                                   DASH0058
 425  SARRAY(I)=ARRAY(I)                                                DASH0059
      JCNT=ICNT+1                                                       DASH0060
      IF (JCNT-16) 428, 428, 430                                        DASH0061
 428  DO 429 I=JCNT,16                                                  DASH0062
 429  SARRAY(I)=0.0                                                     DASH0063
C            THE SEGMENT DELTAS ARE IN THE STANDARD 906 DELTA FORMAT    DASH0064
 430  DO 440 I=1,ICNT,2                                                 DASH0065
      IDX=ARRAY(I)*STEPS*SCL                                            DASH0066
      IF (IDX-MAXDEL) 432,432,431                                       DASH0067
 431  IDX=MAXDEL                                                        DASH0068
      SARRAY(I)=MAXDEL/STEPS/SCL                                        DASH0069
 432  IF (I-ICNT) 435,434,434                                           DASH0070
 434  IDY=0                                                             DASH0071
      GO TO 440                                                         DASH0072
 435  IDY=ARRAY(I+1)*STEPS*SCL                                          DASH0073
      IF (IDY-MAXDEL) 440,440,438                                       DASH0074
 438  IDY=MAXDEL                                                        DASH0075
      SARRAY(I+1)=MAXDEL/STEPS/SCL                                      DASH0076
 440  CALL BUFF(IDX,IDY,2,IBCD)                                         DASH0077
      GO TO 900                                                         DASH0078
C              RETURN THE VALUES IN ARRAY TO THE USER                   DASH0079
 500  JCNT=IABS(ICNT)                                                   DASH0080
      IF (JCNT-1) 900, 900, 510                                         DASH0081
 510  IF (JCNT-16) 520, 520, 515                                        DASH0082
 515  JCNT=16                                                           DASH0083
 520  DO 530 I=1,JCNT                                                   DASH0084
 530  ARRAY(I)=SARRAY(I)                                                DASH0085
      JCNT=JCNT+1                                                       DASH0086
      IF (JCNT-16) 540, 540, 560                                        DASH0087
 540  DO 550 I=JCNT,16                                                  DASH0088
 550  ARRAY(I)=0.0                                                      DASH0089
 560  ARRAY(JCNT)=LSTCNT                                                DASH0090
C              RETURN TO THE USER                                       DASH0091
 900  RETURN                                                            DASH0092
      END                                                               DASH0093
      SUBROUTINE BUFF(IDX ,IDY,MODE,IDXX)                               BUFF0034
C    THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF      BUFF0035
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON      BUFF0036
C    THE DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED      BUFF0037
C    AND CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT   BUFF0038
C    PRIOR WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.        BUFF0039
CALCOMP  PRODUCT NUMBER  474113*8-A              EBCDIC PUNCH           BUFF0040
CALCOMP HCBS FOR    VAX 11 VMS   AND RS232 907 OPC ON-LINE  JUNE,1982 * BUFF0041
C     IF MODE=0     IDX=DIRECT CODE;    IDY=REPEAT COUNT                BUFF0042
C     IF MODE=1     IDX=LDEV FOR SETUP, =0 FOR RESET;  IDY=DUMMY        BUFF0043
C     IF MODE=2     IDX=MULTI-PREC. DX; IDY=MULTI-PREC. DY              BUFF0044
C     IF MODE=3     IDX(1)=SYMB STRING; IDY=NO.OF CHARS LEFT-JUSTIFIED  BUFF0045
C     IF MODE=4     IDX(1)=SYMB STRING; IDY=NO.OF CHARS RIGHT-JUSTIFIED BUFF0046
C     IF MODE=5     IDX=IDY=DUMMY   SPECIAL CALL TO FORCE DUMP          BUFF0047
C     IF MODE=6     IDX=# OF CODES NEEDED IN BUFFER; IDY=DUMMY          BUFF0048
C     IF MODE=7     IDX=MULTI-PREC NUM; IDY=# OF CHARS TO OUTPUT        BUFF0049
C     IF MODE=8     IDX(1)=SYMB STRING; IDY=COUNT(NO STRING CMD SENT)   BUFF0050
      CHARACTER * (*) IDXX                                              BUFF0051
      DIMENSION IDX(1),IBUF(125)                                        BUFF0052
      DIMENSION IXX(3),IYY(3)                                           BUFF0053
      DIMENSION ISETUP(37),IRESET(8)                                    BUFF0054
C INITIALIZE 907 SET SEARCH ADDRESS TO 001                              BUFF0055
C     SET RADIX; ENABLE DOUBLE BUFFERRING; SUPPRESS 40                  BUFF0056
C     ECHO CHARACTERS; DELAY 0 MS; SET OK RESPONSE=0,DC3; SET NEGATIVE  BUFF0057
C     RESPONSE=1,DC3; SET RESPONSE TRIGGER=BEL; SELECT PEN 1            BUFF0058
C     SET SCALING 1 TO 1                                                BUFF0059
      DATA ISETUP /1001,1000,1000,1001,                                 BUFF0060
     +             1007,0, 1008,1010, 1008,1002,1005, 1008,1003,1000,   BUFF0061
     +1008,1004,1002,1003,1000,1000,1013,1008,1005,1002,1003,1001,1000, BUFF0062
     +1013,1008,1006,1001,1003,1014, 1004,1001,1009,1001/               BUFF0063
      DATA ISCNT  /38/                                                  BUFF0064
C RESET 907 --SET SEARCH ADDRESS TO 9999;SELECT PEN 1;                  BUFF0065
C     DISABLE MULTI BUFFERRING                                          BUFF0066
      DATA IRESET /1001,0,0,0,1004,1001,1008,1000/                      BUFF0067
      DATA IRCNT  /9/                                                   BUFF0068
C SET RADIX AND RADIX SQUARED                                           BUFF0069
      DATA N1,N2 / 95,9025 /                                            BUFF0070
      DATA J/0/,JMAX/125/                                               BUFF0071
C                                                                       BUFF0072
      IX=IDX(1)                                                         BUFF0073
      IY=IDY                                                            BUFF0074
      IF (MODE-1) 5,100,5                                               BUFF0075
    5 IF (J) 998,998,10                                                 BUFF0076
   10 IF(MODE)998,20,60                                                 BUFF0077
C  ----- STUFF CODE INTO BUFFER WITH OFFSET FLAG (+1000)                BUFF0078
   20 IBUF(J)=IX+1000                                                   BUFF0079
      IY=IY-1                                                           BUFF0080
      J=J+1                                                             BUFF0081
      IF(J-JMAX)30,30,25                                                BUFF0082
   25 CALL PDMP(IBUF,J)                                                 BUFF0083
      J=1                                                               BUFF0084
   30 IF(IY) 40,40,20                                                   BUFF0085
40    RETURN                                                            BUFF0086
C                                                                       BUFF0087
C  ----- DISPATCH FOR NON-ZERO MODES                                    BUFF0088
   60 GO TO(100,200,300,400,500,600,700,800),MODE                       BUFF0089
C            1   2   3   4   5   6   7   8                              BUFF0090
C                                                                       BUFF0091
C  ----- CALL TO SET UP RADIX FOR DELTAS, AND ALLOW OTHER CALLS         BUFF0092
C  --- BY SETTING 'J' TO A VALID VALUE (+1)                             BUFF0093
C  --- CALLED BY PLOTS UPON INITIALIZATION                              BUFF0094
100   IF (IX) 150,150,110                                               BUFF0095
C                          SETUP - CALL PDMP WITH LDEV                  BUFF0096
  110 J=1                                                               BUFF0097
      CALL PDMP(IX,-1)                                                  BUFF0098
C             NOW SET UP RADIX IN INITIALIZATION STREAM                 BUFF0099
      ISETUP(6) = N1-1 +1000                                            BUFF0100
      CALL PDMP(ISETUP,ISCNT)                                           BUFF0101
      RETURN                                                            BUFF0102
C                      RESET - CALL PDMP, RESET I/O PARAMETERS          BUFF0103
  150 J=0                                                               BUFF0104
      IRESET(2) = 9999 / N2 + 1000                                      BUFF0105
      IRESET(3) = MOD(9999 / N1, N1) + 1000                             BUFF0106
      IRESET(4) = MOD(9999, N1) + 1000                                  BUFF0107
      CALL PDMP(IRESET,IRCNT)                                           BUFF0108
C                         WAIT TILL ALL SHUT DOWN                       BUFF0109
      CALL PDMP(0,0)                                                    BUFF0110
      RETURN                                                            BUFF0111
C                                                                       BUFF0112
C     MULTI-PRECISION DELTA MODE                                        BUFF0113
200   KMD = 16                                                          BUFF0114
      IXC = 3                                                           BUFF0115
      IYC = 3                                                           BUFF0116
C  ----- CHECK SIGN OF X-DELTA                                          BUFF0117
      IF (IX)  202,201,204                                              BUFF0118
  201 IF (IY)  206,270,210                                              BUFF0119
  202 IX  = -IX                                                         BUFF0120
      KMD = 17                                                          BUFF0121
C  ----- CHECK SIGN OF Y-DELTA                                          BUFF0122
  204 IF (IY) 206,210,210                                               BUFF0123
  206 IY  = -IY                                                         BUFF0124
      KMD = KMD + 2                                                     BUFF0125
C  ----- SET UP DELTA PARTS USING CURRENT RADIX                         BUFF0126
  210 IXX(1) =  IX/N2                                                   BUFF0127
      IXX(2) = MOD( (IX/N1) , N1 )                                      BUFF0128
      IXX(3) = MOD( IX , N1 )                                           BUFF0129
      IYY(1) =  IY/N2                                                   BUFF0130
      IYY(2) = MOD( (IY/N1) , N1 )                                      BUFF0131
      IYY(3) = MOD( IY , N1 )                                           BUFF0132
C  ----- NOW CHECK FOR 1 2 OR 3 CHARACTER DELTA                         BUFF0133
      IF (IXX(1)+IYY(1)) 220,212,220                                    BUFF0134
  212 IF (IXX(2)+IYY(2)) 214,216,214                                    BUFF0135
  214 KMD = KMD + 4                                                     BUFF0136
      IXC = 2                                                           BUFF0137
      IYC = 2                                                           BUFF0138
      GO TO 220                                                         BUFF0139
  216 KMD = KMD + 8                                                     BUFF0140
      IXC = 1                                                           BUFF0141
      IYC = 1                                                           BUFF0142
C  ----- NOW CHECK FOR ZERO COMPONENT OF DELTA                          BUFF0143
  220 IF (IX) 224,222,224                                               BUFF0144
  222 KMD = KMD + 12 + MOD(KMD,4)/2                                     BUFF0145
      IXC = 0                                                           BUFF0146
      GO TO 250                                                         BUFF0147
  224 IF (IY) 230,226,230                                               BUFF0148
  226 KMD = KMD + 14 - MOD(KMD,4)*2                                     BUFF0149
      IYC = 0                                                           BUFF0150
      GO TO 250                                                         BUFF0151
C  ----- NOW CHECK FOR DIFFERENT LENGTH DELTAS                          BUFF0152
  230 IF (IXC-2) 250,240,231                                            BUFF0153
  231 IF (IXX(1)) 232,233,232                                           BUFF0154
  232 IF (IYY(1)) 250,234,250                                           BUFF0155
  233 IF (IXX(2)) 235,236,235                                           BUFF0156
  234 IF (IYY(2)) 237,238,237                                           BUFF0157
  235 IXC = 2                                                           BUFF0158
      KMD = KMD + 24                                                    BUFF0159
      GO TO 250                                                         BUFF0160
  236 IXC = 1                                                           BUFF0161
      KMD = KMD + 28                                                    BUFF0162
      GO TO 250                                                         BUFF0163
  237 IYC = 2                                                           BUFF0164
      KMD = KMD + 32                                                    BUFF0165
      GO TO 250                                                         BUFF0166
  238 IYC = 1                                                           BUFF0167
      KMD = KMD + 36                                                    BUFF0168
      GO TO 250                                                         BUFF0169
  240 IF (IXX(2)) 242,243,242                                           BUFF0170
  242 IF (IYY(2)) 250,244,250                                           BUFF0171
  243 IXC = 1                                                           BUFF0172
      KMD = KMD + 36                                                    BUFF0173
      GO TO 250                                                         BUFF0174
  244 IYC = 1                                                           BUFF0175
      KMD = KMD + 40                                                    BUFF0176
C                                                                       BUFF0177
C  ----- STUFF THE PROPER NUMBER OF CHARACTERS INTO 'IBUF'              BUFF0178
C               MAKE SURE THE ENTIRE DELTA WILL FIT IN THIS BUFFER      BUFF0179
  250 IF(J+1+IXC+IYC-JMAX) 254,254,252                                  BUFF0180
  252 CALL PDMP(IBUF,J)                                                 BUFF0181
      J = 1                                                             BUFF0182
  254 IBUF(J) = KMD + 1000                                              BUFF0183
      J = J + 1                                                         BUFF0184
C           NOW STUFF X-DELTA, MOST SIGNIFICANT FIRST                   BUFF0185
      IF (IXC) 998,260,256                                              BUFF0186
  256 K1 = 4 - IXC                                                      BUFF0187
      DO 258 K=K1,3                                                     BUFF0188
      IBUF(J) = IXX(K) + 1000                                           BUFF0189
  258 J = J + 1                                                         BUFF0190
C          NOW STUFF Y-DELTA, MOST SIGNIFICANT FIRST                    BUFF0191
  260 IF (IYC) 998,270,262                                              BUFF0192
  262 K1 = 4 - IYC                                                      BUFF0193
      DO 264 K=K1,3                                                     BUFF0194
      IBUF(J) = IYY(K) + 1000                                           BUFF0195
  264 J = J + 1                                                         BUFF0196
C         ALL DONE - NOW RETURN                                         BUFF0197
  270 RETURN                                                            BUFF0198
C                                                                       BUFF0199
C     SYMBOL MODE                                                       BUFF0200
  300 CONTINUE                                                          BUFF0201
  400 K = IY                                                            BUFF0202
      K1 = 1                                                            BUFF0203
C  ----- FIRST MAKE SURE THERE IS ROOM FOR COMMAND CODE, AND CHARACTER  BUFF0204
C  --- COUNT, AND THE FIRST CHARACTER IN THE BUFFER                     BUFF0205
  401 IF (J+2-JMAX) 410,410,405                                         BUFF0206
C  ----- FLUSH THE BUFFER TO MAKE ROOM                                  BUFF0207
  405 CALL PDMP(IBUF,J)                                                 BUFF0208
      J = 1                                                             BUFF0209
  410 IF (K-(N1-1)) 420,420,415                                         BUFF0210
  415 K = N1-1                                                          BUFF0211
  420 IF (J+K+1-JMAX) 430,430,425                                       BUFF0212
  425 K = JMAX - J - 1                                                  BUFF0213
C  ----- NOW STUFF COMMAND CODE AND CHARACTER COUNT                     BUFF0214
  430 IBUF(J) = 5 + 1000                                                BUFF0215
      J = J + 1                                                         BUFF0216
  431 IBUF(J) = K + 1000                                                BUFF0217
      J = J + 1                                                         BUFF0218
      K2 = K + K1 - 1                                                   BUFF0219
C                            NOW LOOP STUFFING CHARACTERS               BUFF0220
      DO 460 I=K1,K2                                                    BUFF0221
      IF (MODE-4) 438,440,438                                           BUFF0222
  438 IBUF(J) = ICHAR(IDXX(I:I))                                        BUFF0223
      GO TO 450                                                         BUFF0224
  440 IBUF(J) = IDX(I)                                                  BUFF0225
  450 J = J+1                                                           BUFF0226
      IF (J-JMAX) 460,460,455                                           BUFF0227
C                    IF BUFFER FULL, DUMP IT                            BUFF0228
  455 CALL PDMP(IBUF,J)                                                 BUFF0229
      J = 1                                                             BUFF0230
  460 CONTINUE                                                          BUFF0231
      IF (K2-IY) 470,999,999                                            BUFF0232
  470 K1 = K2 + 1                                                       BUFF0233
      K = IY - K2                                                       BUFF0234
      GO TO 401                                                         BUFF0235
C                                                                       BUFF0236
C FLUSH BUFFER                                                          BUFF0237
  500 IF (J-1) 999,999,510                                              BUFF0238
  510 CALL PDMP(IBUF,J)                                                 BUFF0239
      J = 1                                                             BUFF0240
      GO TO 999                                                         BUFF0241
C                                                                       BUFF0242
C       TEST FOR ENOUGH ROOM IN THE BUFFER                              BUFF0243
 600  IF (J+IX-JMAX)  999,999,510                                       BUFF0244
C                                                                       BUFF0245
C               STORE IX IN IY WORDS OF BUFFER                          BUFF0246
 700  IXX(1)=IX/N2                                                      BUFF0247
      IXX(2)=MOD((IX/N1),N1)                                            BUFF0248
      IXX(3)=MOD(IX,N1)                                                 BUFF0249
      IF (J+IY-JMAX) 720,720,710                                        BUFF0250
 710  CALL PDMP(IBUF,J)                                                 BUFF0251
      J = 1                                                             BUFF0252
 720  K = 4-IY                                                          BUFF0253
      DO 725 I=K,3                                                      BUFF0254
      IBUF(J) = 1000 + IXX(I)                                           BUFF0255
 725  J = J+1                                                           BUFF0256
      GO TO 999                                                         BUFF0257
C                                                                       BUFF0258
C               HANDLE OPERATOR MESSAGE                                 BUFF0259
 800  K = IY                                                            BUFF0260
C               FORCE LENGTH OF MESSAGE <= RADIX                        BUFF0261
      IF(K-N1) 820, 820, 810                                            BUFF0262
 810  K = N1                                                            BUFF0263
 820  K1 = 1                                                            BUFF0264
      GO TO 431                                                         BUFF0265
C  STANDARD EXIT                                                        BUFF0266
 999  RETURN                                                            BUFF0267
C                                                                       BUFF0268
C *****  THIS EXIT SHOULD NOT BE TAKEN (AN INVALID RETURN)              BUFF0269
998   RETURN                                                            BUFF0270
      END                                                               BUFF0271
      SUBROUTINE PDMP (IBUF,JCNT)                                       PDMP0272
C    THIS SOFTWARE IS THE PROPRIETARY AND CONFIDENTIAL PROPERTY OF      PDMP0273
C    CALIFORNIA COMPUTER PRODUCTS, INC. AND IS LICENSED FOR USE ON      PDMP0274
C    THE DESIGNATED EQUIPMENT ON WHICH IT WAS ORIGINALLY INSTALLED      PDMP0275
C    AND CANNOT BE MODIFIED, DUPLICATED OR COPIED IN ANY FORM WITHOUT   PDMP0276
C    PRIOR WRITTEN CONSENT OF CALIFORNIA COMPUTER PRODUCTS, INC.        PDMP0277
CALCOMP  PRODUCT NUMBER  474112*0-A                 EBCDIC PUNCH        PDMP0278
CALCOMP HCBS FOR VAX-11/VMS   907/EM RS-232 ONLINE          NOV, 1981 * PDMP0279
C     IF JCNT<0  THEN IBUF(1) CONTAINS   'LDEV' FOR 907                 PDMP0280
C     IF JCNT=0  THEN  CHECK LAST TRANSMISSION AND FINISH               PDMP0281
C     IF JCNT>1  THEN  SEND IBUF ARRAY TO 907 AFTER TRANSLATION         PDMP0282
C                      JCNT-1 IS NUMBER OF ELEMENTS TO TRANSMIT         PDMP0283
      DIMENSION IBUF(1)                                                 PDMP0284
      DIMENSION ISYNC(2),IOBUFF(125),IEOB(2)                            PDMP0285
      DIMENSION ICOD(96)                                                PDMP0286
C     DIMENSION IASC(128)                                               PDMP0287
      DATA LDEVI,LDEVO,ICNT,ITS/1,1,1,0/                                PDMP0288
C      ISYNC=SYNC CODE,BIAS CODE;  IOBUFF=DATA;  IEOB=END PLOT CODE     PDMP0289
      DATA ISYNC/ 2, 32 / , IOBUFF / 125*32 / , IEOB / 0, 3 /           PDMP0290
C                                                                       PDMP0291
C THE FOLLOWING TABLE IS DATA TRANSLATION TABLE                         PDMP0292
      DATA ICOD / 32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,      PDMP0293
     + 48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,                 PDMP0294
     + 64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,                 PDMP0295
     + 80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,                 PDMP0296
     + 96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,     PDMP0297
     + 112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127/ PDMP0298
C THE FOLLOWING DATA IS SYMBOL TRANSLATION TABLE IF NECESSARY           PDMP0299
C     DATA IASC/  /                                                     PDMP0300
C                                                                       PDMP0301
      IF (JCNT) 100,200,200                                             PDMP0302
C                SET LDEV FOR FUTURE OPERATONS                          PDMP0303
100   LDEVO= IBUF(1)                                                    PDMP0304
      LDEVI=LDEVO                                                       PDMP0305
      RETURN                                                            PDMP0306
C                                                                       PDMP0307
  200 IF(ITS) 300,300,250                                               PDMP0308
C                 READ STATUS OF PREVIOUS TRANSFER                      PDMP0309
  250 CONTINUE                                                          PDMP0310
C OUTPUT TRIGGER RESPONSE IF NECESSARY                                  PDMP0311
      WRITE (LDEVO,252)                                                 PDMP0312
  252 FORMAT(' >')                                                      PDMP0313
      READ (LDEVI,251) ISTAT                                            PDMP0314
  251 FORMAT (I1)                                                       PDMP0315
      ITS = -1                                                          PDMP0316
      IF (ISTAT) 260,300,260                                            PDMP0317
C                  ERROR:  RE-TRANSMIT                                  PDMP0318
  260 WRITE (LDEVO,1000) ISYNC,(IOBUFF(I),I=1,ICNT),IEOB                PDMP0319
      GO TO 250                                                         PDMP0320
C                                                                       PDMP0321
C                 STUFF THE BUFFER, TRANSLATING MARKED CHARS.           PDMP0322
300   CONTINUE                                                          PDMP0323
      IF(JCNT-1) 400,400,310                                            PDMP0324
  310 ICNT = JCNT-1                                                     PDMP0325
      ICKSUM = 0                                                        PDMP0326
      DO 350 I=1,ICNT                                                   PDMP0327
      NCD = IBUF(I)                                                     PDMP0328
C     IF (NCD-999) 330,330,320     USED IF SYMBOL TRANSLATION NEEDED    PDMP0329
      IF (NCD-999) 340,340,320                                          PDMP0330
C                   OFFSET TO CHARACTER PARTITION                       PDMP0331
  320 NCD  = ICOD( MOD( NCD-1000,96 ) + 1 )                             PDMP0332
      GO TO 340                                                         PDMP0333
C 330 NCD  = IASC ( MOD (NCD,128) + 1 ) IF SYMBOL TRANSLATION NEEDED    PDMP0334
  340 IOBUFF(I) = NCD                                                   PDMP0335
      ICKSUM = ICKSUM + NCD                                             PDMP0336
  350 CONTINUE                                                          PDMP0337
      IEOB(1) = 96 - MOD (ICKSUM,32)                                    PDMP0338
C                      NOW WRITE THE BUFFER                             PDMP0339
      WRITE (LDEVO,1000) ISYNC,(IOBUFF(I),I=1,ICNT),IEOB                PDMP0340
      IF (ITS) 390,360,400                                              PDMP0341
  360 WRITE (LDEVO,1001)                                                PDMP0342
C             *** ALSO FOR VAX-11/VMS  , FORCE O.S. BUFFER OUT  ******  PDMP0343
C     REWIND LDEVO                                                      PDMP0344
  390 ITS = 1                                                           PDMP0345
C                                                                       PDMP0346
  400 RETURN                                                            PDMP0347
C                                                                       PDMP0348
 1000 FORMAT (' ',131A1)                                                PDMP0349
 1001 FORMAT ('  PLOTTING BEGINS -----')                                PDMP0350
      END                                                               PDMP0351
