10 '       *  PHASERES.BAS - MULTIPHONIC FLUTE RESONANCE - WITH LOSSES  *
15 '  NO TAPER IN HEADJOINT - MOUTH HOLE HEIGHT & POSITION SET IN  LINE 210
16 '  MOUTH HOLE HEIGHT CONSTANT, CORK CAVITY ADDED.
20 '  GIVES MOUTH HOLE CURRENT ANGLE REL TO JET CURRENT FOR ANY FREQUENCY LEVEL.        18 '
30 '     LINE 90  SHOWS FINGERING. EDIT USING 0 FOR OPEN, 1 FOR CLOSED
40 '          AND 2 FOR MISSING.
50 SCREEN 12: KEY OFF: CLS
60 PRINT "                              A     G#             D#"
70 PRINT "               C# C#    B  A#          G  F# F  E     D  C# C  B"
80 PRINT "        TR1 TR2      C           G#"
90 DATA            1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 2
100 '
110 DATA MH ,TR1,TR2,C#1,C#2,C,B,A#,A,G#1,G#2,G,F#,F,E,D#,D,C#,C,B
120 DIM A$(19), B(19), C(20, 3): ' INCLUDES 0
130 FOR K = 1 TO 19: READ B(K): NEXT K
140 PRINT "        ";
150 FOR K = 1 TO 19: PRINT B(K); : NEXT K: PRINT : PRINT
160 FOR K = 0 TO 19: READ A$(K): NEXT K
170 FOR K = 0 TO 19
180      FOR P = 0 TO 1
190 READ C(K, P)
200 NEXT P, K
210 DATA -327.7,50 : ' MOUTH HOLE POSITION AND HEIGHT
220 DATA -128,55,-112,55
230 DATA -94.5,60,-70.1,1E5
240 DATA -61.2,31,-43.2,28.3
250 DATA-22.4,28.3,0,28.3
260 DATA 22.3,28.3,23.4,28.3
270 DATA 48.3,26.2,72.9,26.2
280 DATA 100.1,26.2,130.1,26.2
290 DATA 164.1,20.5,197.4,20.5
300 DATA 232.1,20.5,275.2,5.8
310 DATA 275.2,5.8
312 CK = 16.5: REM CORK DISTANCE
314
320 INPUT "DO YOU WANT TO REVIEW PARAMETERS (Y OR N)"; F$
330 IF F$ = "Y" OR F$ = "y" THEN GOSUB 820
470 CLS : VIEW (3, 1)-(636, 460), , 1: WINDOW (0, 0)-(2584, 270)
472 LOCATE 5, 1: PRINT "PHASE";
480 LOCATE 30, 1
490 PRINT "        C E G   C D E   G  A    C   D    E F    G     A     B   C   C#  D   D#";
495 FOR FL = 48 TO 87: F = 16.3515 * EXP(FL / 17.3123): PSET (F, 1): PSET (F, 2): NEXT FL
500 FOR ANG = 30 TO 85 STEP 5: Y = 300 * TAN(ANG / 57.295)
510 LINE (0, 0)-(2584, Y), 1: NEXT ANG
515 LOCATE 23, 1: PRINT "AMPLITUDE";
540 FOR F = 261 TO 2584: FL = 17.3123 * LOG(F / 16.35147)
550 GOSUB 580
560 PSET (F, PH + 270): ' 270 DEGREES ADDED TO MATCH EXTRAPOLATED JET LINES
565 PSET (F, MI)
570 NEXT F
575 WHILE INKEY$ = "": WEND
576 END
580 PI = 3.14159
590 K = F * 2 * PI / 345000
600 AL = .0014 * SQR(K)
610 R = 1: TH = PI: G = 0: B = 0

620 FOR J = 19 TO -.3 STEP -1
630 IF B(J) <> 0 THEN 720
635 IF J = 0 THEN 790: ' Leaves before adding mouth hole admittance
640 G = G + 22.6 / (C(J, 1)) ^ 2
650 B = B - 1 / K / C(J, 1)
670 RD = (B ^ 2 + (1 - G) ^ 2) / (B ^ 2 + (1 + G) ^ 2)
680 R = SQR(RD)
690 DN = 1 - G ^ 2 - B ^ 2
700 TH = ATN(2 * B / DN)
710 IF DN > 0 THEN TH = TH + PI
720 X = C(J, 0) - C(J - 1, 0)
730 R = R * EXP(-2 * AL * X)
740 TH = TH + 2 * K * X
750 D2 = 1 + R ^ 2 - 2 * R * COS(TH)
760 G = (1 - R ^ 2) / D2
770 B = -2 * R * SIN(TH) / D2
780 NEXT J
790 B = B + TAN(K * CK): REM ADDS SUSC OF CORK CAVITY
792 ' G and B now represent the admmittance before adding that of the mouth hole
793 H = C(0, 1): 'MOUTH HOLE HEIGHT
795 RT = G / (G * G + B * B): 'RESISTANCE LOOKING INTO TUBE + CORK CAVITY
796 XT = -B / (G * G + B * B): 'REACTANCE LOOKING INTO TUBE + CORK CAVITY
797 RM = 22.56 * K * K: 'RADIATION RESISTANCE OF MOUTH HOLE
798 PHNUMERATOR = ATN((XT + .4 * K * H) / (RM + RT))
799 PHDENOM = ATN((XT + K * H) / (RM + RT))
800 PH = 57.2958 * (PHNUMERATOR - PHDENOM): 'PHASE ANGLE IN DEGREES

805 H = C(0, 1): 'MOUTH HOLE HEIGHT
807 DEN2 = (22.6 * K ^ 2 + G / (G ^ 2 + B ^ 2)) ^ 2 + (K * H - B / (G ^ 2 + B ^ 2)) ^ 2
810 MI = K * H / SQR(DEN2): ' MOUTH CURRENT /JET CURRENT, MAGNITUDE
812 MI = 10 * MI: 'ADJUST FOR PROPER HEIGHT ON GRAPH
815 RETURN

820 PRINT TAB(5); "KEY"; TAB(11); "POSITION"; TAB(25); "H"
830 FOR K = 0 TO 19
840 PRINT TAB(5); A$(K);
850 PRINT TAB(15); C(K, 0); TAB(23); C(K, 1)
860 NEXT K
863 PRINT "CORK DISTANCE ="; CK
865 WHILE INKEY$ = "": WEND
870 RETURN