Zwicker Loudness (john )


Subject: Zwicker Loudness
From:    john  <acoustic(at)I-2000.COM>
Date:    Sun, 24 Jan 1999 16:23:18 -0500

This is a multi-part message in MIME format. --------------94F2AF0FE0E265FC46563336 Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: 7bit A number of people asked that I post the responses I received to my inquiry regarding a program to calculate Zwicker Loudness. Morten Lydolf passed along a copy of the routine that implements the ISO calculation. I have attached that routine for those interested. I have received no information regarding a MATLAB routine. Thanksagain to all who responded. -- John Erdreich, Ph.D. Ostergaard Acoustical Associates 200 Executive Drive Suite 350 W. Orange, NJ 07052 Phone 973 731 7002 Fax 973 731 6680 --------------94F2AF0FE0E265FC46563336 Content-Type: text/plain; charset=iso-8859-1; name="din45.bas" Content-Disposition: inline; filename="din45.bas" Content-Transfer-Encoding: quoted-printable X-MIME-Autoconverted: from 8bit to quoted-printable by aleve.media.mit.edu id QAA17220 10 '********************************************************************= **** 20 '* = * 30 '* LAUTHEITSBERECHNUNG NACH DIN 45631 (ISO 532B) = * 40 '* = * 50 '* = * 60 '* Technische Universit=84t M=81nchen = * 70 '* Institut f=81r Elektroakustik = * 80 '* = * 90 '********************************************************************= **** 100 '* = * 110 '* Programmiersprache: Quick-BASIC 4.0 (MS-DOS) = * 120 '* = * 130 '********************************************************************= **** 140 '* = * 150 '* = * 160 '* Programmbeschreibung: Das Programm berechnet aus 28 Terzpegeln = * 170 '* die Lautheit und den Lautst=84rkepegel = * 180 '* eines Schalles = * 190 '* = * 200 '* = * 210 '* Eingabe Parameter: LT Feld von 28 Elementen, welche die Terz- = * 220 '* pegel in dB von 25 Hz bis 12,5 kHz = * 230 '* Mittenfrequenz repr=84sentieren = * 240 '* = * 250 '* M$ Zeichenvariable zur Unterscheidung = * 260 '* des Schallfeldtyps (frei/diffus) = * 270 '* = * 280 '* Ausgabe Parmeter: N Lautheit in sone G = * 290 '* = * 300 '* LN Lautst=84rkepegel in phon G = * 310 '* = * 320 '* NS Daten f=81r Grafikausgabe = * 330 '* = * 340 '* = * 350 '* Variablen FR Terzmittenfrequenzen = * 360 '* = * 370 '* RAP Terzpegelbereiche fUr Korrektur bei = * 380 '* niedrigen Frequenzen entsprechend den = * 390 '* Kurven gleicher Lautst=84rke = * 400 '* = * 410 '* DLL Pegelabsenkung bei niedrigen Frequenzen = * 420 '* gem=84B den Kurven gleicher Lautst=84rke = * 430 '* = * 440 '* LTQ Frequenzgruppenpegel an der Ruhehdr- = * 450 '* schwelle ohne BerUcksichtigung der Uber- = * 460 '* tragungscharakteristik des Ohres = * 470 '* = * 480 '* AD Pegelkorrektur gem=86b der Ubertragungs- = * 490 '* charakteristik des Ohres = * 500 '* = * 510 '* DDF Pegeldifferenz zwischen freiem und = * 520 '* diffusem Schallfeld = * 530 '* = * 540 '* DCB Anpassung der Terzpegel an die zugehdrigen= * 550 '* Frequenzgruppenpegel aufgrund unterschied-= * 560 '* licher Bandbreite = * 570 '* = * 580 '********************************************************************= **** 590 '* = * 600 '* = * 610 '* ZUP Obere Grenzen der angen=86herten Frequenz-= * 620 '* gruppen im TonheitsmaB = * 630 '* = * 640 '* RNS Wertebereich der spezifischen Lautheit, = * 650 '* der die Flankensteilheit der oberen Flan- = * 660 '* ken im spezifischen Lautheits-Tonheits- = * 670 '* Muster festlegt = * 680 '* = * 690 '* USL Flankensteilheiten der oberen Flanken = * 700 '* im spezifischen Lautheits-Tonheits-Muster = * 710 '* = * 720 '* = * 730 '* = * 740 '-------------------------- Programmvorspann ---------------------= --- 750 ' 760 CLS 770 SR1$ =3D "********************************" 780 LOCATE 3, 8 790 PRINT SR1$; SR1$ 800 LOCATE 4, 8: PRINT "*": LOCATE 4, 71: PRINT "*" 810 LOCATE 5, 8: PRINT "*": LOCATE 5, 71: PRINT "*" 820 LOCATE 5, 17: PRINT "Lautheitsberechnung nach DIN 45631 (ISO 532 B)" 830 LOCATE 6, 8: PRINT "*": LOCATE 6, 71: PRINT "*" 840 LOCATE 7, 8: 850 PRINT SR1$; SR1$ 860 ' 870 LOCATE 10, 16 880 PRINT "Dieses Programm berechnet analog zum graphischen" 890 ' 900 LOCATE 11, 16 910 PRINT "Verfahren nach Zwicker (DIN 45631) die Lautheit N" 920 ' 930 LOCATE 12, 16 940 PRINT "sowie den Lautst=84rkepegel LN aus den Terzpegeln " 950 ' 960 LOCATE 13, 16 970 PRINT "eines; Ger=84usches. " 980 ' 990 LOCATE 15, 16 1000 PRINT "Geben Sie zur Berechnung die einzelnen Terzpegel " 1010 ' 1020 LOCATE 16, 16 1030 PRINT "in dB ein und best=84tigen Sie jede Eingabe mit RETURN." 1040 ' 1050 LOCATE 23, 30 1060 PRINT " Weiter mit <RETURN> " 1070 ' 1080 GOSUB 4360 'Tastaturspeicher leeren 1090 ' 1100 ' --- Tastenabfrage --- 1110 ' 1120 LOCATE 23, 70: RE$ =3D INPUT$(1) 1130 IF RE$ =3D CHR$(13) THEN GOSUB 4360 ELSE 1050 1140 CLS 1150 ' 1160 '*******************************************************************= **** 1170 ' 1180 ' TABELLEN 1190 ' 1200 '*******************************************************************= **** 1210 ' 1220 ' Terzmittenfrequenzen (FR) 1230 ' 1240 DATA 25, 31.5, 40, 50, 63, 80, 100, 125, 160, 200 1250 DATA 250, 315, 400, 500, 630, 800, 1.0, 1.25, 1.6, 2 1260 DATA 2.5, 3.15, 4, 5, 6.3, 8, 10, 12.5 1270 ' 1280 ' 1290 ' Terzpegelbereiche f=81r Korrektur bei niedrigen Frequenzen 1300 ' entsprechend den Kurven gleicher Lautst=84rke (RAP) 1310 ' 1320 DATA 45,55,65,71,80,90,100,120 1330 1340 1350 ' Terzpegelabsenkung bei niedrigen Frequenzen gem=86b den 1360 ' Kurven gleicher Lautst=84rke in den acht durch RAP de- 1370 ' finierten Bereichen(DLL) 1380 ' 1390 DATA -32,-24,-16,-10,-5,0, -7,-3,0, -2,0 1400 DATA -29,-22,-15,-10,-4,0, -7,-2,0, -2,0 1410 DATA -27,-19,-14, -9,-4,0, -6,-2,0, -2,0 1420 DATA -25,-17,-12, -9,-3,0, -5,-2,0, -2,0 1430 DATA -23,-16,-11, -7,-3,0, -4,-1,0, -1,0 1440 DATA -20,-14,-10, -6,-3,0, -4,-1,0, -1,0 1450 DATA -18,-12, -9, -6,-2,0, -3,-1,0, -1,0 1460 DATA -15,-10, -8, -4,-2,0, -3,-1,0, -1,0 1470 ' 1480 ' 1490 ' Frequenzgruppenpegel an der Ruheh=94rschwelle ohne 1500 ' Ber=81cksichtigung der Ubertragungscharakteristik des 1510 ' Ohres (LTQ) 1520 ' 1530 DATA 30,18,12, 8, 7, 6, 5, 4 1540 DATA 3, 3, 3, 3, 3, 3, 3, 3 1550 DATA 3, 3, 3, 3 1560 ' 1570 ' 1580 ' Pegelkorrektur gem=84ss der Ubertragungscharakteristik 1590 ' des Ohres(AO) 1600 ' 1610 DATA 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 1620 DATA 0.0, 0.0,-0.5,-1.6,-3.2,-5.4,-5.6,-4.0 1630 DATA -1.5, 2.0, 5.0,12.0 1640 ' 1650 ' 1660 ' Pegeldifferenz zwischen freiem und diffusem Schall- 1670 ' feld (DDF) 1680 ' 1690 DATA 0.0, 0.0, 0.5, 0.9, 1.2, 1.6, 2.3, 2.8 1700 DATA 3.0, 2.0, 0.0,-1.4,-2.0,-1.9,-1.0, 0.5 1710 DATA 3.0, 4.0, 4.3, 4.0 1720 ' 1730 ' 1740 ' Anpassung der Terzpegel an die zugeh=94rigen Frequenz- 1750 ' gruppenpegel aufgrund unterschiedlicher Bandbreite (DCB) 1760 ' 1770 DATA -.25,-0.6,-0.8,-0.8,-0.5, 0.0, 0.5, 1.1 1780 DATA 1.5, 1.7, 1.8, 1.8, 1.7, 1.6, 1.4, 1.2 1790 DATA 0.8, 0.5, 0.0,-0.5 1800 ' 1810 ' 1820 ' Obere Grenzen der angen=94herten Frequenzgruppen im 1830 ' TonheitsmaB (ZUP) 1840 ' 1850 DATA 0.9, 1.8, 2.8, 3.5, 4.4, 5.4, 6.6, 7.9 1860 DATA 9.2, 10.6, 12.3, 13.8, 15.2, 16.7, 18.1, 19.3 1870 DATA 20.6, 21.8, 22.7, 23.6, 24.0 1880 ' 1890 ' 1900 ' Wertebereich der spezifischen Lautheit, der die Flanken- 1910 ' steilheit der oberen Flanken im spezifischen Lautheits- 1920 ' Tonheits-Muster festlegt (RNS) 1930 ' 1940 DATA 21.5, 18.0, 15.1, 11.5, 9.0, 6.1, 4.4, 3.1 1950 DATA 2.13, 1.36, 0.82, 0.42, 0.30, 0.22, 0.15, 0.10 1960 DATA 0.035, 0.0 1970 ' 1980 ' 1990 ' Flankensteilheiten der oberen Flanken im spezifischen 2000 ' Lautheits-Tonheits-Muster f=81r die Wertebereiche RNS als 2010 ' Funktion der Nummer der Frequenzgruppe (USL) 2020 ' 2030 DATA 13.00, 8.20, 6.30, 5.50, 5.50, 5.50, 5.50, 5.50 2040 DATA 9.00, 7.50, 6.00, 5.10, 4.50, 4.50, 4.50, 4.50 2050 DATA 7.80, 6.70, 5.60, 4.90, 4.40, 3.90, 3.90, 3.90 2060 DATA 6.20, 5.40, 4.60, 4.00, 3.50, 3.20, 3.20, 3.20 2070 DATA 4.50, 3.80, 3.60, 3.20, 2.90, 2.70, 2.70, 2.70 2080 DATA 3.70, 3.00, 2.80, 2.35, 2.20, 2.20, 2.20, 2.20 2090 DATA 2.90, 2.30, 2.10, 1.90, 1.80, 1.70, 1.70, 1.70 2100 DATA 2.40, 1.70, 1.50, 1.35, 1.30, 1.30, 1.30, 1.30 2110 DATA 1.95, 1.45, 1.30, 1.15, 1.10, 1.10, 1.10, 1.10 2120 DATA 1.50, 1.20, 0.94, 0.86, 0.82, 0.82, 0.82, 0.82 2130 DATA 0.72, 0.67, 0.64, 0.63, 0.62, 0.62, 0.62, 0.62 2140 DATA 0.59, 0.53, 0.51, 0.50, 0.42, 0.42, 0.42, 0.42 2150 DATA 0.40, 0.33, 0.26, 0.24, 0.22, 0.22, 0.22, 0.22 2160 DATA 0.27, 0.21, 0.20, 0.18, 0.17, 0.17, 0.17, 0.17 2170 DATA 0.16, 0.15, 0.14, 0.12, 0.11, 0.11, 0.11, 0.11 2180 DATA 0.12, 0.11, 0.10, 0.08, 0.08, 0.08, 0.08, 0.08 2190 DATA 0.09, 0.08, 0.07, 0.06, 0.06, 0.06, 0.06, 0.05 2200 DATA 0.06, 0.05, 0.03, 0.02, 0.02, 0.02, 0.02, 0.02 2210 ' 2220 ' 2230 '*******************************************************************= *** 2240 ' 2250 '--------- Dimensionierung und Belegen der Variablen -------------= --- 2260 ' 2270 OPTION BASE 1 'Feldindizes beginnen mit 1 2280 ' 2290 DIM LT(28), FR(28), CLT(28), CFR(28), GI(3), LTQ(20), LE(21) 2300 DIM LCB(3), NM(21), RAP(8), NS(240), DLL(11, 8), AO(20) 2310 DIM DCB(20), DDF(20), ZUP(21), RNS(18), USL(18, 8) 2320 DIM TI(11), KOMM$(80), XP(10), XB(10), XX(10) 2330 ' 2340 RESTORE 1240 2350 FOR I =3D 1 TO 28 2360 READ FR(I) 2370 NEXT I 2380 FOR I =3D 1 TO 8 2390 READ RAP(I) 2400 NEXT I 2410 FOR J =3D 1 TO 8 2420 FOR I =3D 1 TO 11 2430 READ DLL(I, J) 2440 NEXT I 2450 NEXT J 2460 FOR I =3D 1 TO 20 2470 READ LTQ(I) 2480 NEXT I 2490 FOR I =3D 1 TO 20 2500 READ AO(I) 2510 NEXT I 2520 FOR I =3D 1 TO 20 2530 READ DDF(I) 2540 NEXT I 2550 FOR I =3D 1 TO 20 2560 READ DCB(I) 2570 NEXT I 2580 FOR I =3D 1 TO 21 2590 READ ZUP(I) 2600 NEXT I 2610 FOR I =3D 1 TO 18 2620 READ RNS(I) 2630 NEXT I 2640 FOR I =3D 1 TO 18 2650 FOR J =3D 1 TO 8 2660 READ USL(I, J) 2670 NEXT J 2680 NEXT I 2690 ' 2700 '*******************************************************************= **** 2710 ' 2720 ' 2730 '--------------------- Ein- und Ausgabeteil ------------------= ---- 2740 ' 2750 ' --- Eingabe der Terzpegel 2760 ' 2770 CLS : GOSUB 4360 'Tastaturspeicher leeren 2780 ' 2790 X =3D 5 'Ausgabezeilenz=84hler am Bildschirm 2800 ' 2810 FOR I =3D 1 TO 28 2820 X =3D X + 1 2830 IF X =3D 20 THEN CLS : X =3D 5 2840 LOCATE 1, 1 2850 PRINT "Geben Sie bitte die Terzpegel (Format: ***.*) ein!" 2860 PRINT "Best=84tigen Sie mit 'RETURN' oder 'ENTER' !" 2870 LOCATE X, 20 2880 IF I < 17 THEN 2890 ELSE 2920 2890 PRINT "Terzpegel bei "; 2900 PRINT USING "###.#"; FR(I); : PRINT " Hz: " 2910 GOTO 2940 2920 PRINT "Terzpegel bei"; 2930 PRINT USING "##.##"; FR(I); : PRINT " kHz: " 2940 LOCATE X, 50: INPUT LT(I) 2950 LOCATE 23, 1: PRINT SPACE$(79) 2960 IF LT(I) =3D 0 THEN LT(I) =3D -60 2970 IF LT(I) < -60 OR LT(I) > 120 THEN 2980 ELSE 3040 2980 LOCATE 23, 1 2990 PRINT "Achtung! Das Programm verarbeitet nur Terzpegel" 3000 LOCATE 23, 49 3010 PRINT "zwischen -60 dB und 120 dB !": BEEP 3020 LOCATE X, 48: PRINT SPACE$(20) 3030 GOTO 2940 3040 LOCATE X, 49: PRINT USING "#####.#"; LT(I): 3050 LOCATE X, 56: PRINT " dB " 3060 ' 3070 GOSUB 4360 'Tastaturspeicher leeren 3080 ' 3090 NEXT I 3100 ' 3110 '--- Schallfeldtyp (frei/diffus) ausw=84hlen --- 3120 ' 3130 GOSUB 4360 'Tastaturspeicher leeren 3140 CLS 3150 LOCATE 11, 1 3160 PRINT "Angabe des Schallfeldtyps:" 3170 LOCATE 15, 1 3180 PRINT "Geben Sie bitte den gew=81nschten Kennbuchstaben ein!" 3190 LOCATE 13, 1 3200 PRINT "Sind die Terzpegel g=81ltig f=81r Freies (F)" 3210 LOCATE 13, 43 3220 PRINT "oder Diffuses (D) Schallfeld? "; 3230 ' 3240 M$ =3D INPUT$(1) 3250 ' 3260 IF M$ =3D "F" OR M$ =3D "f" THEN 3270 M$ =3D "F" 3280 GOTO 3340 3290 END IF 3300 IF M$ =3D "D" OR M$ =3D "d" THEN 3310 M$ =3D "D" 3320 ELSE GOTO 3130 3330 END IF 3340 ' 3350 ' 3360 CLS 'Lautheitsberechnung aufrufen 3370 LOCATE 12, 30: 3380 PRINT "Berechnung l=84uft ..." 3390 GOSUB 4500 3400 ' 3410 ' 3420 '--- Programmabschluss - Ergebnisausgabe auf Bildschirm/Drucker 3430 ' 3440 CLS 3450 LOCATE 5, 9: 3460 PRINT SR1$; SR1$ 3470 LOCATE 6, 9: PRINT "*": LOCATE 6, 72: PRINT "*" 3480 LOCATE 7, 9: PRINT "*": LOCATE 7, 23: 3490 PRINT "Lautheit N =3D "; 3500 IF N <=3D 16 THEN PRINT USING "####.##"; N; 3510 IF N > 16 THEN PRINT USING "####.#"; N; : PRINT " "; 3520 PRINT " sone G"; M$ 3530 LOCATE 7, 72: PRINT "*" 3540 LOCATE 8, 9: PRINT "*": LOCATE 8, 23: 3550 PRINT "Lautst=84rkepegel LN =3D "; : PRINT USING "###.#"; LN; 3560 PRINT " phon G"; M$ 3570 LOCATE 8, 72: PRINT "*" 3580 LOCATE 9, 9: PRINT "*": LOCATE 9, 72: PRINT "*" 3590 LOCATE 10, 9: 3600 PRINT SR1$; SR1$ 3610 ' 3620 GOSUB 4360 'Tastaturspeicher leeren 3630 ' 3640 LOCATE 17, 25: PRINT "Obige Tabelle ausdrucken? (j/n)" 3650 PR$ =3D INPUT$(1) 3660 ' 3670 '--- Tastenabfrage 3680 ' 3690 IF PR$ =3D "j" OR PR$ =3D "J" THEN 3700 GOSUB 3940 'Druckausgabe 3710 END IF 3720 ' 3730 '---Programmende 3740 ' 3750 CLS : GOSUB 4360 'Tastaturspeicher leeren 3760 ' 3770 LOCATE 12, 10 3780 PRINT " Neue Eingabe von Terzpegeln (j) oder PROGRAMMENDE (n) ?" 3790 NE$ =3D INPUT$(1) 3800 ' 3810 IF NE$ =3D "j" OR NE$ =3D "J" THEN 2730 3820 IF NE$ =3D "n" OR NE$ =3D "N" THEN 3830 3830 CLS 3840 SCREEN 0 3850 LOCATE 12, 34: PRINT "Programmende" 3860 ' 3870 LOCATE 23, 1 3880 END 3890 '=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D 3900 '=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D UNTERPROGRAMME =3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D 3910 '=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D 3920 ' 3930 '**************************************************************** 3940 '* Unterprogramm zur Ausgabe des Rechenergebnisses auf Drucker * 3950 '**************************************************************** 3960 ' 3970 LOCATE 17, 1: PRINT SPACE$(79) 'Zeile l=94schen 3980 ' 3990 LOCATE 17, 20 4000 PRINT "Drucker an ? - Papier eingelegt ? " 4010 LOCATE 19, 20 4020 PRINT "wenn bereit, dann beliebige Taste dr=81cken" 4030 ' 4040 GOSUB 4360: GOSUB 6380 'Tastenabfrage 4050 ON ERROR GOTO 6250 'Fehlerbehandlung 4060 ' bei Ger=84tefehler 4070 CLS 4080 ' 4090 DT1$ =3D MID$(DATE$, 4, 2) 4100 DT2$ =3D LEFT$(DATE$, 2) 4110 DT3$ =3D RIGHT$(DATE$, 2) 4120 DT$ =3D DT1$ + "." + DT2$ + "." + DT3$ 4130 ' 4140 LPRINT 4150 LPRINT SPACE$(10); "*** DIN - LAUTHEITSBERECHNUNG" 4160 LPRINT 4170 LPRINT SPACE$(10); 4180 LPRINT "DATUM:"; " "; DT$; " "; "ZEIT:"; " "; TIME$ 4190 LPRINT 4200 LPRINT SPACE$(10); 4210 LPRINT "N =3D "; 4220 IF N <=3D 16 THEN LPRINT USING "####.##"; N; 4230 IF N > 16 THEN LPRINT USING "####.##"; N; : LPRINT " "; 4240 LPRINT " sone G"; M$ 4250 LPRINT SPACE$(10); 4260 LPRINT "LN =3D "; : LPRINT USING "###.#"; LN; 4270 LPRINT " phon G"; M$ 4280 LPRINT 4290 RETURN 4300 ' 4310 ' 4320 '****************************************************** 4330 '* Unterprogramm zur Entleerung des Tastaturspeichers * 4340 '****************************************************** 4350 ' 4360 FOR W =3D 1 TO 50 4370 W$ =3D INKEY$ 4380 IF LEN(W$) =3D 0 THEN RETURN 4390 NEXT W 4400 ' 4410 ' 4420 '************************************************* 4430 '*** Unterprogramm - BERECHNUNG DER LAUTHEIT ***** 4440 '************************************************* 4450 ' 4460 '--- Korrektur der Terzpegel gem=84ss der Kurven gleicher 4470 ' Lautst=84rke (XP) und Berechnung der Intensit=84ten 4480 ' f=81r die Terzb=84nder bis 320 Hz 4490 ' 4500 FOR I =3D 1 TO 11 4510 J =3D 1 4520 IF LT(I) <=3D RAP(J) - DLL(I, J) THEN GOTO 4570 4530 J =3D J + 1 4540 IF J < 8 THEN 4550 GOTO 4520 4560 END IF 4570 XP =3D LT(I) + DLL(I, J) 4580 TI(I) =3D 10 ^ (.1 * XP) 4590 NEXT I 4600 ' 4610 ' 4620 '--- Bestimmung der Pegel LCB(1),LCB(2) und LCB(3) in 4630 ' den drei ersten Frequenzgruppen 4640 ' 4650 DEF FNGI (I) =3D 10 * LOG(GI(I)) / LOG(10) 4660 GI(1) =3D TI(1) + TI(2) + TI(3) + TI(4) + TI(5) + TI(6) 4670 GI(2) =3D TI(7) + TI(8) + TI(9) 4680 GI(3) =3D TI(10) + TI(11) 4690 ' 4700 FOR I =3D 1 TO 3 4710 IF GI(I) > 0 THEN LCB(I) =3D FNGI(I) 4720 NEXT I 4730 ' 4740 ' 4750 '--- Berechnung der Kernlautheit NM(I) 4760 ' 4770 FOR I =3D 1 TO 20 4780 LE(I) =3D LT(I + 8) 4790 IF I <=3D 3 THEN LE(I) =3D LCB(I) 4800 LE(I) =3D LE(I) - AO(I) 4810 NM(I) =3D 0 4820 IF M$ =3D "D" OR M$ =3D "d" THEN LE(I) =3D LE(I) + DDF(I) 4830 IF LE(I) <=3D LTQ(I) THEN 4940 4840 LE(I) =3D LE(I) - DCB(I) 4850 ' 4860 S =3D .25 'Schwellenfaktor 4870 ' 4880 MP1 =3D .0635 * 10 ^ (.025 * LTQ(I)) 4890 MP2 =3D (1 - S + S * 10 ^ (.1 * (LE(I) - LTQ(I)))) ^ .25 - 1 4900 NM(I) =3D MP1 * MP2 4910 ' 4920 IF NM(I) <=3D 0 THEN NM(I) =3D 0 4930 ' 4940 NEXT I 4950 NM(21) =3D 0 4960 ' 4970 ' 4980 '--- Korrektur der spezifischen Lautheit in der untersten 4990 ' Frequenzgruppe zur Ber=81cksichtigung des Ruheh=94rschwellen- 5000 ' verlaufs innerhalb dieser Frequenzgruppe 5010 ' 5020 KORRY =3D .4 + .32 * NM(1) ^ .2 5030 IF KORRY > 1 THEN KORRY =3D 1 5040 NM(1) =3D NM(1) * KORRY 5050 ' 5060 ' 5070 '--- Voreinstellung 5080 ' 5090 N =3D 0 5100 Z1 =3D 0 5110 N1 =3D 0 5120 IZ =3D 1 5130 Z =3D .1 5140 ' 5150 ' 5160 '--- Schritt zur ersten und den weiteren Frequenzgruppen 5170 ' 5180 FOR I =3D 1 TO 21 5190 ' 5200 ZUP(I) =3D ZUP(I) + .0001 5210 ' 5220 IG =3D I - 1 5230 IF IG > 8 THEN IG =3D 8 5240 ' 5250 ' 5260 IF N1 > NM(I) THEN 5270 GOTO 5610 'Flankenlautheit 5280 END IF 5290 IF N1 =3D NM(I) THEN 'Kernlautheit 5300 GOTO 5460 5310 END IF 5320 ' 5330 ' 5340 '--- Bestimmung der Zahl J des Bereichs der spezifischen 5350 ' Lautheit 5360 ' 5370 FOR J =3D 1 TO 18 5380 IF RNS(J) < NM(I) THEN 5460 5390 NEXT J 5400 ' 5410 ' 5420 '--- Beitrag der nichtmaskierten Kernlautheit zur Gesamt- 5430 ' lautheit und Berechnung der St=81tzwerte NS(I) im Ab- 5440 ' stand Z=3DIZ*O.1 BARK 5450 ' 5460 Z2 =3D ZUP(I) 5470 N2 =3D NM(I) 5480 N =3D N + N2 * (Z2 - Z1) 5490 ' 5500 FOR K =3D Z TO Z2 STEP .1 5510 NS(IZ) =3D N2 5520 IZ =3D IZ + 1 5530 NEXT K 5540 Z =3D K 5550 GOTO 5850 'n=84chstes Segment 5560 ' 5570 ' 5580 '--- Beitrag des Wertes N2 der spez. Lautheit an der 5590 ' Bandgrenze 5600 ' 5610 N2 =3D RNS(J) 5620 IF N2 < NM(I) THEN N2 =3D NM(I) 5630 DZ =3D (N1 - N2) / USL(J, IG) 5640 Z2 =3D Z1 + DZ 5650 IF Z2 <=3D ZUP(I) THEN 5750 5660 Z2 =3D ZUP(I) 5670 DZ =3D Z2 - Z1 5680 N2 =3D N1 - DZ * USL(J, IG) 5690 ' 5700 ' 5710 '--- Beitrag der Flankenlautheiten zur Gesamtlautheit 5720 ' und Berechnung der zugeh=94rigen St=81tzwerte NS(IZ) 5730 ' im Abstand Z=3DIZ*O.1 BARK 5740 ' 5750 N =3D N + DZ * (N1 + N2) / 2 5760 FOR K =3D Z TO Z2 STEP .1 5770 NS(IZ) =3D N1 - (K - Z1) * USL(J, IG) 5780 IZ =3D IZ + 1 5790 NEXT K 5800 Z =3D K 5810 ' 5820 ' 5830 '--- Schritt zum n=84chsten Segment 5840 ' 5850 IF N2 <=3D RNS(J) THEN 5860 IF J < 18 THEN 5870 J =3D J + 1 5880 GOTO 5850 5890 END IF 5900 IF J >=3D 18 THEN J =3D 18 5910 END IF 5920 Z1 =3D Z2 5930 N1 =3D N2 5940 IF Z1 < ZUP(I) THEN 5260 5950 ' 5960 NEXT I 5970 ' 5980 IF N < 0 THEN N =3D 0 5990 ' 6000 IF N <=3D 16 THEN 'Rundung 6010 N =3D INT(N * 1000 + .5) / 1000 6020 ELSEIF N > 16 THEN 6030 N =3D INT(N * 100 + .5) / 100 6040 END IF 6050 ' 6060 ' 6070 '--- Berechnung der Pegellautst=84rke f=81r LN < 40 PHON 6080 ' bzw. N < 1 SONE 6090 ' 6100 LN =3D 40 * (N + .0005) ^ .35 6110 IF LN < 3 THEN LN =3D 3 6120 ' 6130 '--- Berechnung der Pegellautst=84rke f=81r LN >=3D 40 PHON 6140 ' bzw. N >=3D 1 SONE 6150 ' 6160 IF N >=3D 1 THEN LN =3D 10 * LOG(N) / LOG(2) + 40 6170 ' 6180 RETURN 6190 ' 6200 ' 6210 '************************************** 6220 '* Unterprogramm zur Fehlerbehandlung * 6230 '************************************** 6240 ' 6250 CLS : LOCATE 12, 10 6260 PRINT "Ausgabeger=84t ist nicht in Ordnung -" 6270 LOCATE 12, 45: PRINT " bitte =81berpr=81fen !" 6280 SOUND 2000, 3 6290 LOCATE 14, 10: PRINT "Taste dr=81cken !" 6300 GOSUB 4360: GOSUB 6380 6310 RESUME 3440 6320 ' 6330 ' 6340 '*********************************** 6350 '* Unterprogramm zur Tastenabfrage * 6360 '*********************************** 6370 ' 6380 LET A$ =3D INKEY$ 6390 WHILE A$ =3D "": LET A$ =3D INKEY$: WEND: RETURN 6400 ' 6410 ' 6420 '******************************************************* 6430 '******************************************************* --------------94F2AF0FE0E265FC46563336--


This message came from the mail archive
http://www.auditory.org/postings/1999/
maintained by:
DAn Ellis <dpwe@ee.columbia.edu>
Electrical Engineering Dept., Columbia University