10 '       *  MULTPHON - MULTIPHONIC FLUTE RESONANCE - WITH LOSSES  *
12 '                    John W. Coltman
15 '  NO TAPER IN HEADJOINT - MOUTH HOLE HEIGHT & POSITION FIXED LINE 215
16 '  MOUTH HOLE HEIGHT CONSTANT, CORK CAVITY ADDED. NO KEY CAVITY CORRECTIONS
20 '  PLOTS EITHER MOUTH OR COLUMN CURRENT / EXCITING CURRENT FOR ANY FREQUENCY LEVEL.        18 '
22 '  SEE LINE 797 TO SELECT WHICH CURRENT IS DISPLAYED
23 '  LABELS ON PEAKS SHOW FREQUENCY LEVEL FOR THE PEAK MAXIMUM
24 '  DATA DESCRIBING THE FLUTE ARE  IN LINES  215 TO 312. HOLE CENTER
25 '  POSITIONS ARE IN MM DISTANCE FROM A HOLE.  HOLE HEIGHTS ARE IN MM
26 '  AND EXPRESS THE HOLE IMPEDANCE IN TERMS OF EQUIVALENT LENGTHS OF TUBE
27 '  HAVING DIAMETER SAME AS BORE.  SEE KEYPARAM.BAS
30 '     LINE 90  SHOWS FINGERING. CHOOSE FINGERING BY EDITING LINE 90,
35 '     USING 0 FOR OPEN, 1 FOR CLOSED,  AND 2 FOR ABSENT KEY HOLE.
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, 0, 1, 0, 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 REM ** THESE KEY DATA FOR WIMBERLY BENNETT SCALE
212 REM * POS.  H 
215 DATA -330.8,50        :      'MOUTH HOLE POSITION AND HEIGHT
220 DATA -129.6,51        :      'TR1
225 DATA -113.8,51        :      'TR2
230 DATA -96,58           :      'C# VENT
235 DATA -82.6,1E5        :      'C# EXTRA
240 DATA -63.7,22.6       :      'C THUMB
245 DATA -44,24.3         :      'B
250 DATA -22,21.3         :      'B FLAT
255 DATA 0,21.3           :      'A REFERENCE POSITION
260 DATA 21.6,24.3        :      'G# BACK
265 DATA 22.1,25.5        :      'G# TOP
270 DATA 45.6,22.8        :      'G
275 DATA 72,19.8          :      'F#
280 DATA 100.,19.8        :      'F
285 DATA 128.9,19.8       :      'E
290 DATA 158.8,17.9       :      'D SHARP
295 DATA 192.3,17.9       :      'D
300 DATA 225.8,17.9       :      'C#
305 DATA 272.0,5.8        :      'C (FOR END USE H=5.8)
310 DATA 272.0,1E5        :      'B FOOT NOT PRESENT    
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 (48, 0)-(87.65, 10)
FOR I = 1 TO 10: LINE (0, I)-(87.65, I), 1: NEXT I
480 LOCATE 30, 1
490 PRINT "C   D   E F   G   A   B C   D   E F   G   A   B C   D   E F   G   A   B C   D ";
495 FOR X = 48 TO 87: PSET (X, .01): PSET (X, .02): NEXT X
540 FOR F1% = 4800 TO 8765: FL = F1% / 100
544 XL = 2 * FL - 97
550 GOSUB 580
560 PSET (FL, .9 * MI)
561 IF MIB > MIA AND MI < MIB THEN LOCATE 54 / (93 - FL), XL: PRINT USING "##.##"; FL - .01
563 MIA = MIB
564 MIB = MI
570 NEXT F1%
575 WHILE INKEY$ = "": WEND
576 END
580 PI = 3.14159
590 K = .000296 * EXP(FL / 17.3123)
600 AL = .0014 * SQR(K)
610 R = 1: TH = PI: G = 0: B = 0

620 FOR J = 19 TO 1 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
REM 797 MI = 1 / SQR((K * H * G) ^ 2 + (1 - K * H * B) ^ 2): REM MAGNITUDE OF MOUTH CURRENT/JET CURRENT
797 MI = SQR(G ^ 2 + B ^ 2) / SQR(G ^ 2 + (1 / K / H - B) ^ 2): REM MAG OF PIPE CURRENT/JET CURRENT

798 MI = 1 * MI: 'ADJUST FOR PROPER HEIGHT ON GRAPH
800 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