10  REM *** ERHARD KETELSEN *** ENGINEERING, DELCON DIV. HP ***
15  REM  KSWEEP, HP 36771A, 2/74
20  DIM W[110],T[100],R[100],I[100]
30  DIM D[100],E[56],F[56],G[100],H[100]
40  READ E,P1,K,S,A,L
50  DATA 1,3.14159,1,0,0,1
60  PRINT "EXPLANATIONS ?    YES(1)  NO(0)  ";
70  INPUT S6
80  IF S6=0 THEN 220
90  PRINT LIN(1),"THIS PROGRAM LISTS AND PLOTS THE FREQUENCY"
100  PRINT "RESPONSE OF POLES AND ZEROS IN THE COMPLEX PLANE."
110  PRINT "THE NUMERATOR AND DENOMINATOR OF THE FUNCTION MUST BE"
120  PRINT "REDUCED TO SIMPLE, MULTIPLE, OR COMPLEX ROOTS."
130  PRINT "THE ROOTS MAY BE OBTAINED BY USING THE B.A.E.D.P."
140  PRINT "TIME SHARE $ROOTER PROGRAM."
150  GOTO 220
160  REM ***** HZ OR RADIANS *****
170  PRINT 
180  PRINT "IF THE ROOTS OF THE POLYNOMIAL ARE IN RADIANS TYPE 2."
190  PRINT "THE ROOTS MAY BE NORMALIZED TO BE IN HZ."
200  PRINT "THIS MAKES IT CONVINIENT TO RELATE RESPONSE WITH"
210  PRINT "THE SWEEP FREQUENCY WHICH WILL ALSO BE IN HZ."
220  PRINT LIN(1),"HZ(1) OR RADIANS(2)  HELP(8)  ";
230  INPUT F1
240  GOTO F1 OF 280,270,250,250,250,250,250,160
250  PRINT "INCORRECT ENTRY. SELECT AGAIN.  ";
260  GOTO 230
270  LET F1=2*P1
280  REM ***** POLE & ZERO LOCATION *****
290  PRINT 
300  GOTO S+1 OF 430,490
310  GOSUB 520
320  PRINT LIN(1),"POLE AND ZERO MODIFICATION"
330  PRINT "ADD(1)  MOVE(2)  DELETE(3)  HELP(8)  ";
340  INPUT S6
350  PRINT 
360  GOTO S6 OF 430,2850,2580,370,370,370,370,390
370  PRINT "INCORRECT ENTRY. SELECT AGAIN.";
380  GOTO 340
390  PRINT "ADD, PREMITS THE ENTRY OF ADDITIONAL POLES AND ZEROS."
400  PRINT "MOVE, PERMITS THE CHANGE OF AN EXISTING POLE OR ZERO."
410  PRINT "DELETE, IS USED TO ELIMINATE AN EXISTING POLE OR ZERO."
420  GOTO 320
430  PRINT "POLE(1)  ZERO(0)  STOP(5)  HELP(8)  "
440  LET A=A+1
450  LET J=A
460  GOSUB 790
470  GOTO 440
480  LET A=A-1
490  IF S#1 AND S#3 THEN 910
500  GOSUB 520
510  GOTO 910
520  IF F1=1 THEN 550
530  PRINT "THE POLES & ZEROS IN RADIANS ARE:"
540  GOTO 560
550  PRINT "THE POLES & ZEROS IN HZ ARE:"
560  PRINT 
570  FOR J=1 TO A
580  LET R=F1*R[J]
590  LET I=F1*I[J]
600  IF T[J]=1 THEN 640
610  PRINT J;"ZERO AT ";R;" +-J ";I;
620  IF R <= 0 THEN 670
630  GOTO 660
640  PRINT J;"POLE AT ";R;" +-J ";I;
650  IF R <= 0 THEN 670
660  PRINT "IT'S IN THE RIGHT HALF PLANE !";
670  PRINT 
680  NEXT J
690  PRINT 
700  RETURN 
710  REM ***** INPUT OF POLES & ZEROS SUBROUTINE *****
720  PRINT 
730  PRINT "ENTER ONLY THE POLES AND ZEROS WHICH ARE LOCATED ON AND"
740  PRINT "ABOVE THE SIGMA AXIS. I.E. ENTER ONLY THE POSITIVE PART"
750  PRINT "OF THE COMPLEX POLE OR ZERO."
760  PRINT "FOR THE POLES OR ZEROS TO BE IN THE LEFT HALF PLANE,"
770  PRINT "THE REAL PART MUST BE NEGATIVE."
780  PRINT "WHEN ALL POLES AND ZEROS HAVE BEEN ENTERED TYPE 5."LIN(1)
790  PRINT "POLE OR ZERO ";
800  INPUT T[J]
810  GOTO T[J]+1 OF 840,840,820,820,820,480,820,820,710
820  PRINT "INCORRECT ENTRY. SELECT AGAIN.";
830  GOTO 800
840  PRINT "REAL PART";
850  INPUT R
860  LET R[J]=R/F1
870  PRINT "IMAGINARY PART";
880  INPUT I
890  LET I[J]=ABS(I/F1)
900  RETURN 
910  REM ***** SWEEP SELECTION *****
920  IF S#0 AND S#2 THEN 1280
930  PRINT LIN(1),"SWEEP SELECTION"
940  PRINT "LINEAR(1)  QUASI LOG(2)  TRUE LOG(3)"
950  PRINT "SPECIFIC FREQUENCIES(4)  HELP(8)    ";
960  INPUT S6
970  LET B=1
980  GOTO S6 OF 1090,1090,1090,1650,990,990,990,1010
990  PRINT "INCORRECT ENTRY. SELECT AGAIN.  ";
1000  GOTO 960
1010  PRINT LIN(1),"LINEAR SWEEP IS USED FOR A SWEEP WITH SPECIFIC"
1020  PRINT "STEPS OVER THE SELECTED FREQUENCY RANGE."
1030  PRINT "QUASI LOG SWEEP IS IN GROUPS OF 1,2,4,7 PER DECADE."
1040  PRINT "TRUE LOG SWEEP IS USED MAINLY FOR THE PLOT ROUTINE."
1050  PRINT "SPECIFIC FREQUENCY SWEEP IS USED WHEN ONLY THE "
1060  PRINT "RESPONSE AT PARTICULAR FREQUENCIES IS NEEDED."
1070  PRINT "THE SWEEP MAY BE CHANGED LATER IN THE PROGRAM."
1080  GOTO 930
1090  PRINT "ENTER THE LOWEST AND HIGHEST FREQUENCIES IN HZ. ";
1100  INPUT W1,W2
1110  W[1]=W1=ABS(W1)
1120  LET W2=ABS(W2)
1130  IF W1<W2 THEN 1170
1140  W5=W1
1150  W[1]=W1=W2
1160  W2=W5
1170  GOTO S6 OF 1180,1320,1530
1180  REM ***** LINEAR SWEEP *****
1190  PRINT LIN(1),"IN STEPS OF ";
1200  INPUT W3
1210  IF (W2-W1)/W3 <= 100 THEN 1240
1220  PRINT "INCREASE STEP SIZE. TRY AGAIN.  ";
1230  GOTO 1190
1240  LET B=B+1
1250  W[B]=W[B-1]+ABS(W3)
1260  IF W[B]<W2 THEN 1240
1270  W[B]=W2
1280  IF S6#1 OR S#1 AND S#2 THEN 1460
1290  PRINT 
1300  PRINT "LINEAR SWEEP FROM";W1;"TO";W2;"IN STEPS OF";ABS(W3);"HZ."
1310  GOTO 1740
1320  REM ***** QUASI LOG SWEEP *****
1330  IF W[1]#0 THEN 1350
1340  W[1]=W1=1
1350  LET S4=10^INT(LOG(W[1])/LOG(10))
1360  LET B=2
1370  FOR J=1 TO 3
1380  LET W[B]=2^(J-1)*S4
1390  GOSUB 1490
1400  NEXT J
1410  LET W[B]=7*S4
1420  GOSUB 1490
1430  LET S4=10*S4
1440  GOTO 1370
1450  W[B]=W2
1460  IF S6#2 OR S#1 AND S#2 THEN 1620
1470  PRINT LIN(1),"QUASI LOG SWEEP FROM";W1;"TO";W2;"HZ."
1480  GOTO 1740
1490  IF W[B] <= W1 THEN 1520
1500  IF W[B] >= W2 THEN 1450
1510  LET B=B+1
1520  RETURN 
1530  REM ***** TRUE LOG SWEEP *****
1540  IF W1#0 AND W2#0 THEN 1570
1550  PRINT "IN LOG SWEEP THE FREQUENCY CAN NOT BE 0."
1560  GOTO 1090
1570  PRINT "IN HOW MANY STEPS ";
1580  INPUT B
1590  FOR K=1 TO B
1600  W[K]=EXP(LOG(W2/W1)*(K-1)/(B-1)+LOG(W1))
1610  NEXT K
1620  IF S6#3 OR S#1 AND S#2 THEN 1720
1630  PRINT "TRUE LOG SWEEP FROM";W1;"TO";W2;"HZ IN";B;"STEPS."
1640  GOTO 1740
1650  REM ***** SPECIFIC FREQUENCY SWEEP *****
1660  PRINT LIN(1)"LIST EACH FREQUENCY IN HZ. TO STOP TYPE -1."
1670  INPUT W[B]
1680  IF W[B]<0 OR B=100 THEN 1710
1690  LET B=B+1
1700  GOTO 1670
1710  LET B=B-1
1720  IF S6#4 OR S#1 AND S#2 THEN 1740
1730  PRINT LIN(1),"SPECIFIC FREQUENCIES OF";B;"POINTS."
1740  REM ***** REFERENCE FREQUENCY *****
1750  IF S#0 AND S#7 THEN 1850
1760  PRINT 
1770  IF S=7 THEN 1800
1780  PRINT "ENTER THE FREQUENCY AT WHICH THE GAIN SHALL BE 0 DB.  ";
1790  GOTO 1810
1800  PRINT "ENTER THE NEW 0 DB REFERENCE FREQUENCY.  ";
1810  INPUT W9
1820  W=ABS(W9)
1830  GOSUB 2270
1840  E=G
1850  IF S#1 AND S#7 THEN 1870
1860  PRINT LIN(1),"THE 0 DB REFERENCE FREQUENCY IS";ABS(W9);"HZ."
1870  IF S>0 THEN 1970
1880  S=1
1890  GOTO 280
1900  PRINT 
1910  PRINT "*** TABLE OF INPUT PARAMETERS ***"
1920  PRINT "NO CHANGES .................. 0"
1930  PRINT "LIST OF ALL INPUT PARAMETERS  1"
1940  PRINT "TYPE OR RANGE OF SWEEP ...... 2"
1950  PRINT "POLE & ZERO MODIFICATION .... 3"
1960  PRINT "0 DB REFERENCE FREQUENCY .... 7"
1970  PRINT LIN(1),"MODIFY PARAMETER ?   HELP(8)  ";
1980  INPUT S
1990  GOTO S+1 OF 2020,280,920,280,2000,2000,2000,1760,1900
2000  PRINT "NO SUCH PARAMETER. SELECT AGAIN.  ";
2010  GOTO 1980
2020  REM ***** SWEEP ROUTINE *****
2030  PRINT LIN(1),"LIST(1)  PLOT(2)  HELP(8)  ";
2040  INPUT S1
2050  GOTO S1 OF 2120,2940,2060,2060,2060,2060,2060,2080
2060  PRINT "INCORRECT ENTRY. SELECT AGAIN ";
2070  GOTO 2040
2080  PRINT "LIST, WILL PRODUCE A LIST OF GAIN AND PHASE VERSUS FREQ."
2090  PRINT "PLOT, WILL PRODUCE A GRAPH WITH THE GAIN AND PHASE"
2100  PRINT "SCALING OPTIMIZED."
2110  GOTO 2030
2120  PRINT 
2130  PRINT LIN(2),"FREQUENCY        GAIN          PHASE"
2140  PRINT "  (HZ)           (DB)        (DEGREES)"
2142  W=ABS(W9)
2144  GOSUB 2270
2146  E=G
2150  FOR K=1 TO B
2160  LET W=W[K]
2170  GOSUB 2270
2180  G=INT(20000*LOG(G/E)/LOG(10)+.5)/1000
2190  H=INT(ATN(TAN(H))*180/P1*1000+.5)/1000
2200  PRINT W;
2210  PRINT  USING "4D.3D,11D.3D";TAB(14),G,H
2220  NEXT K
2230  PRINT LIN(1),"FOR ANY CHANGES(1)  FOR A PLOT(2)  STOP(0)  ";
2240  INPUT S1
2250  GOTO S1+1 OF 2260,1970,2940
2260  STOP 
2270  REM ***** SWEEP SUBROUTINE *****
2280  LET G=1
2290  LET H=0
2300  FOR J=1 TO A
2310  LET X=-R[J]
2320  LET Y=W-I[J]
2330  IF Y#0 OR X#0 THEN 2370
2340  LET M=1.E-15
2350  LET P=0
2360  GOTO 2430
2370  LET M=SQR(X^2+Y^2)
2380  IF X#0 THEN 2400
2390  LET X=ABS(Y/1.E+08)
2400  LET P=ATN(Y/X)
2410  IF R[J] <= 0 THEN 2430
2420  LET P=P+P1
2430  IF I[J]=0 THEN 2510
2440  LET Y=W+I[J]
2450  LET M=M*SQR(X^2+Y^2)
2460  IF X#0 THEN 2480
2470  LET X=ABS(Y/1.E+08)
2480  LET P=P+ATN(Y/X)
2490  IF R[J] <= 0 THEN 2510
2500  LET P=P+P1
2510  IF T[J]=0 THEN 2540
2520  LET M=1/M
2530  LET P=-P
2540  LET G=G*M
2550  LET H=H+P
2560  NEXT J
2570  RETURN 
2580  REM ***** POLE OR ZERO DELETION *****
2590  PRINT "TYPE THE NUMBER OF THE POLE OR ZERO TO BE DELETED.  ";
2600  PRINT "TO STOP TYPE 0.  ";
2610  INPUT C[L]
2620  IF C[L]=0 THEN 2660
2630  LET L=L+1
2640  PRINT "NEXT POLES OR ZERO TO BE DELETED ";
2650  GOTO 2610
2660  LET L=L-1
2670  LET N1=0
2680  FOR N=1 TO L-1
2690  IF C[N] >= C[N+1] THEN 2740
2700  LET N1=1
2710  LET N2=C[N]
2720  LET C[N]=C[N+1]
2730  LET C[N+1]=N2
2740  NEXT N
2750  IF N1=1 THEN 2670
2760  FOR N=1 TO L
2770  LET A=A-1
2780  FOR J=C[N] TO A
2790  LET T[J]=T[J+1]
2800  LET R[J]=R[J+1]
2810  LET I[J]=I[J+1]
2820  NEXT J
2830  NEXT N
2840  GOTO 2920
2850  REM ***** POLE OR ZERO MOVEMENT *****
2860  PRINT "WHICH POLE OR ZERO ";
2870  INPUT J
2875  PRINT "POLE(1)  ZERO(0)  STOP(5)  HELP(8)  ";
2880  GOSUB 790
2890  PRINT "TO CHANGE ANOTHER POLE OR ZERO, TYPE (1). IF NOT (0).  ";
2900  INPUT S1
2910  IF S1=1 THEN 2860
2920  PRINT 
2930  GOTO 500
2940  REM ***** PLOT ROUTINE *****
2950  M1=R1=1000
2960  M2=R2=-1000
2962  W=ABS(W9)
2964  GOSUB 2270
2966  E=G
2970  FOR K=1 TO B
2980  W=W[K]
2990  GOSUB 2270
3000  G[K]=20*LOG(G/E)/LOG(10)
3010  H[K]=ATN(TAN(H))*180/P1
3020  IF G[K]>M1 THEN 3040
3030  M1=G[K]
3040  IF G[K]<M2 THEN 3060
3050  M2=G[K]
3060  IF H[K]>R1 THEN 3080
3070  R1=H[K]
3080  IF H[K]<R2 THEN 3100
3090  R2=H[K]
3100  NEXT K
3110  M3=(M2-M1)/47
3120  M4=R4=.001
3130  IF M4 >= M3 THEN 3200
3140  M4=2*M4
3150  IF M4 >= M3 THEN 3200
3160  M4=2.5*M4
3170  IF M4 >= M3 THEN 3200
3180  M4=2*M4
3190  GOTO 3130
3200  R3=(R2-R1)/47
3210  IF R4 >= R3 THEN 3280
3220  R4=2*R4
3230  IF R4 >= R3 THEN 3280
3240  R4=2.5*R4
3250  IF R4 >= R3 THEN 3280
3260  R4=2*R4
3270  GOTO 3210
3280  M1=INT(M1/10/M4)*10*M4
3290  R1=INT(R1/10/R4)*10*R4
3300  FOR J=1 TO 56
3310  E[J]=M1+(J-1)*M4
3320  F[J]=R1+(J-1)*R4
3330  NEXT J
3340  PRINT LIN(2)
3350  PRINT  USING 3360;M4
3360  IMAGE "   FREQ.",18X,"GAIN (DB) IN",3D.3D," DB INCREMENTS"
3370  PRINT  USING 3380;E[1],E[11],E[21],E[31],E[41],E[51]
3380  IMAGE"   (HZ)  ",6(6D.3D)
3390  PRINT  USING 3400
3400  IMAGE15X,11("^...."),"^"
3410  FOR J=1 TO B
3420  PRINT W[J];TAB(15);
3430  MAT D=ZER
3440  FOR K=1 TO 56
3450  IF G[J]>E[K]+M4/2 THEN 3480
3460  D[K]=1
3470  GOTO 3490
3480  NEXT K
3490  FOR K=1 TO 56
3500  IF H[J]>F[K]+R4/2 THEN 3530
3510  D[K]=D[K]+2
3520  GOTO 3540
3530  NEXT K
3540  FOR K=1 TO 56
3550  GOTO D[K]+1 OF 3560,3610,3630,3650
3560  IF (K-1)/5=INT((K-1)/5) THEN 3590
3570  PRINT " ";
3580  GOTO 3660
3590  PRINT ".";
3600  GOTO 3660
3610  PRINT "G";
3620  GOTO 3660
3630  PRINT "0";
3640  GOTO 3660
3650  PRINT "B";
3660  NEXT K
3670  PRINT 
3680  NEXT J
3690  PRINT  USING 3400
3700  PRINT  USING "9X,6(6D.3D)";F[1],F[11],F[21],F[31],F[41],F[51]
3710  PRINT  USING 3720;R4
3720  IMAGE 21X,"PHASE (DEGREES) IN",3D.3D," DEGREE INCREMENTS"
3730  PRINT LIN(2),"FOR ANY CHANGES(1)  FOR A LIST(2)  STOP(0)  ";
3740  INPUT S1
3750  GOTO S1+1 OF 3760,1970,2120
3760  END 
