[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Zwicker Loudness
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
10 '************************************************************************
20 '* *
30 '* LAUTHEITSBERECHNUNG NACH DIN 45631 (ISO 532B) *
40 '* *
50 '* *
60 '* Technische Universit„t Mnchen *
70 '* Institut fr 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„rkepegel *
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„sentieren *
240 '* *
250 '* M$ Zeichenvariable zur Unterscheidung *
260 '* des Schallfeldtyps (frei/diffus) *
270 '* *
280 '* Ausgabe Parmeter: N Lautheit in sone G *
290 '* *
300 '* LN Lautst„rkepegel in phon G *
310 '* *
320 '* NS Daten fr Grafikausgabe *
330 '* *
340 '* *
350 '* Variablen FR Terzmittenfrequenzen *
360 '* *
370 '* RAP Terzpegelbereiche fUr Korrektur bei *
380 '* niedrigen Frequenzen entsprechend den *
390 '* Kurven gleicher Lautst„rke *
400 '* *
410 '* DLL Pegelabsenkung bei niedrigen Frequenzen *
420 '* gem„B den Kurven gleicher Lautst„rke *
430 '* *
440 '* LTQ Frequenzgruppenpegel an der Ruhehdr- *
450 '* schwelle ohne BerUcksichtigung der Uber- *
460 '* tragungscharakteristik des Ohres *
470 '* *
480 '* AD Pegelkorrektur gem†b 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†herten 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$ = "********************************"
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„rkepegel LN aus den Terzpegeln "
950 '
960 LOCATE 13, 16
970 PRINT "eines; Ger„usches. "
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„tigen 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$ = INPUT$(1)
1130 IF RE$ = 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 fr Korrektur bei niedrigen Frequenzen
1300 ' entsprechend den Kurven gleicher Lautst„rke (RAP)
1310 '
1320 DATA 45,55,65,71,80,90,100,120
1330
1340
1350 ' Terzpegelabsenkung bei niedrigen Frequenzen gem†b den
1360 ' Kurven gleicher Lautst„rke 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”rschwelle ohne
1500 ' Bercksichtigung 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„ss 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”rigen 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”herten 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 fr 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 = 1 TO 28
2360 READ FR(I)
2370 NEXT I
2380 FOR I = 1 TO 8
2390 READ RAP(I)
2400 NEXT I
2410 FOR J = 1 TO 8
2420 FOR I = 1 TO 11
2430 READ DLL(I, J)
2440 NEXT I
2450 NEXT J
2460 FOR I = 1 TO 20
2470 READ LTQ(I)
2480 NEXT I
2490 FOR I = 1 TO 20
2500 READ AO(I)
2510 NEXT I
2520 FOR I = 1 TO 20
2530 READ DDF(I)
2540 NEXT I
2550 FOR I = 1 TO 20
2560 READ DCB(I)
2570 NEXT I
2580 FOR I = 1 TO 21
2590 READ ZUP(I)
2600 NEXT I
2610 FOR I = 1 TO 18
2620 READ RNS(I)
2630 NEXT I
2640 FOR I = 1 TO 18
2650 FOR J = 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 = 5 'Ausgabezeilenz„hler am Bildschirm
2800 '
2810 FOR I = 1 TO 28
2820 X = X + 1
2830 IF X = 20 THEN CLS : X = 5
2840 LOCATE 1, 1
2850 PRINT "Geben Sie bitte die Terzpegel (Format: ***.*) ein!"
2860 PRINT "Best„tigen 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) = 0 THEN LT(I) = -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„hlen ---
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 gewnschten Kennbuchstaben ein!"
3190 LOCATE 13, 1
3200 PRINT "Sind die Terzpegel gltig fr Freies (F)"
3210 LOCATE 13, 43
3220 PRINT "oder Diffuses (D) Schallfeld? ";
3230 '
3240 M$ = INPUT$(1)
3250 '
3260 IF M$ = "F" OR M$ = "f" THEN
3270 M$ = "F"
3280 GOTO 3340
3290 END IF
3300 IF M$ = "D" OR M$ = "d" THEN
3310 M$ = "D"
3320 ELSE GOTO 3130
3330 END IF
3340 '
3350 '
3360 CLS 'Lautheitsberechnung aufrufen
3370 LOCATE 12, 30:
3380 PRINT "Berechnung l„uft ..."
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 = ";
3500 IF N <= 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„rkepegel LN = "; : 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$ = INPUT$(1)
3660 '
3670 '--- Tastenabfrage
3680 '
3690 IF PR$ = "j" OR PR$ = "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$ = INPUT$(1)
3800 '
3810 IF NE$ = "j" OR NE$ = "J" THEN 2730
3820 IF NE$ = "n" OR NE$ = "N" THEN 3830
3830 CLS
3840 SCREEN 0
3850 LOCATE 12, 34: PRINT "Programmende"
3860 '
3870 LOCATE 23, 1
3880 END
3890 '================================================================
3900 '================ UNTERPROGRAMME ===============================
3910 '================================================================
3920 '
3930 '****************************************************************
3940 '* Unterprogramm zur Ausgabe des Rechenergebnisses auf Drucker *
3950 '****************************************************************
3960 '
3970 LOCATE 17, 1: PRINT SPACE$(79) 'Zeile l”schen
3980 '
3990 LOCATE 17, 20
4000 PRINT "Drucker an ? - Papier eingelegt ? "
4010 LOCATE 19, 20
4020 PRINT "wenn bereit, dann beliebige Taste drcken"
4030 '
4040 GOSUB 4360: GOSUB 6380 'Tastenabfrage
4050 ON ERROR GOTO 6250 'Fehlerbehandlung
4060 ' bei Ger„tefehler
4070 CLS
4080 '
4090 DT1$ = MID$(DATE$, 4, 2)
4100 DT2$ = LEFT$(DATE$, 2)
4110 DT3$ = RIGHT$(DATE$, 2)
4120 DT$ = 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 = ";
4220 IF N <= 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 = "; : 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 = 1 TO 50
4370 W$ = INKEY$
4380 IF LEN(W$) = 0 THEN RETURN
4390 NEXT W
4400 '
4410 '
4420 '*************************************************
4430 '*** Unterprogramm - BERECHNUNG DER LAUTHEIT *****
4440 '*************************************************
4450 '
4460 '--- Korrektur der Terzpegel gem„ss der Kurven gleicher
4470 ' Lautst„rke (XP) und Berechnung der Intensit„ten
4480 ' fr die Terzb„nder bis 320 Hz
4490 '
4500 FOR I = 1 TO 11
4510 J = 1
4520 IF LT(I) <= RAP(J) - DLL(I, J) THEN GOTO 4570
4530 J = J + 1
4540 IF J < 8 THEN
4550 GOTO 4520
4560 END IF
4570 XP = LT(I) + DLL(I, J)
4580 TI(I) = 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) = 10 * LOG(GI(I)) / LOG(10)
4660 GI(1) = TI(1) + TI(2) + TI(3) + TI(4) + TI(5) + TI(6)
4670 GI(2) = TI(7) + TI(8) + TI(9)
4680 GI(3) = TI(10) + TI(11)
4690 '
4700 FOR I = 1 TO 3
4710 IF GI(I) > 0 THEN LCB(I) = FNGI(I)
4720 NEXT I
4730 '
4740 '
4750 '--- Berechnung der Kernlautheit NM(I)
4760 '
4770 FOR I = 1 TO 20
4780 LE(I) = LT(I + 8)
4790 IF I <= 3 THEN LE(I) = LCB(I)
4800 LE(I) = LE(I) - AO(I)
4810 NM(I) = 0
4820 IF M$ = "D" OR M$ = "d" THEN LE(I) = LE(I) + DDF(I)
4830 IF LE(I) <= LTQ(I) THEN 4940
4840 LE(I) = LE(I) - DCB(I)
4850 '
4860 S = .25 'Schwellenfaktor
4870 '
4880 MP1 = .0635 * 10 ^ (.025 * LTQ(I))
4890 MP2 = (1 - S + S * 10 ^ (.1 * (LE(I) - LTQ(I)))) ^ .25 - 1
4900 NM(I) = MP1 * MP2
4910 '
4920 IF NM(I) <= 0 THEN NM(I) = 0
4930 '
4940 NEXT I
4950 NM(21) = 0
4960 '
4970 '
4980 '--- Korrektur der spezifischen Lautheit in der untersten
4990 ' Frequenzgruppe zur Bercksichtigung des Ruheh”rschwellen-
5000 ' verlaufs innerhalb dieser Frequenzgruppe
5010 '
5020 KORRY = .4 + .32 * NM(1) ^ .2
5030 IF KORRY > 1 THEN KORRY = 1
5040 NM(1) = NM(1) * KORRY
5050 '
5060 '
5070 '--- Voreinstellung
5080 '
5090 N = 0
5100 Z1 = 0
5110 N1 = 0
5120 IZ = 1
5130 Z = .1
5140 '
5150 '
5160 '--- Schritt zur ersten und den weiteren Frequenzgruppen
5170 '
5180 FOR I = 1 TO 21
5190 '
5200 ZUP(I) = ZUP(I) + .0001
5210 '
5220 IG = I - 1
5230 IF IG > 8 THEN IG = 8
5240 '
5250 '
5260 IF N1 > NM(I) THEN
5270 GOTO 5610 'Flankenlautheit
5280 END IF
5290 IF N1 = 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 = 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 Sttzwerte NS(I) im Ab-
5440 ' stand Z=IZ*O.1 BARK
5450 '
5460 Z2 = ZUP(I)
5470 N2 = NM(I)
5480 N = N + N2 * (Z2 - Z1)
5490 '
5500 FOR K = Z TO Z2 STEP .1
5510 NS(IZ) = N2
5520 IZ = IZ + 1
5530 NEXT K
5540 Z = K
5550 GOTO 5850 'n„chstes Segment
5560 '
5570 '
5580 '--- Beitrag des Wertes N2 der spez. Lautheit an der
5590 ' Bandgrenze
5600 '
5610 N2 = RNS(J)
5620 IF N2 < NM(I) THEN N2 = NM(I)
5630 DZ = (N1 - N2) / USL(J, IG)
5640 Z2 = Z1 + DZ
5650 IF Z2 <= ZUP(I) THEN 5750
5660 Z2 = ZUP(I)
5670 DZ = Z2 - Z1
5680 N2 = N1 - DZ * USL(J, IG)
5690 '
5700 '
5710 '--- Beitrag der Flankenlautheiten zur Gesamtlautheit
5720 ' und Berechnung der zugeh”rigen Sttzwerte NS(IZ)
5730 ' im Abstand Z=IZ*O.1 BARK
5740 '
5750 N = N + DZ * (N1 + N2) / 2
5760 FOR K = Z TO Z2 STEP .1
5770 NS(IZ) = N1 - (K - Z1) * USL(J, IG)
5780 IZ = IZ + 1
5790 NEXT K
5800 Z = K
5810 '
5820 '
5830 '--- Schritt zum n„chsten Segment
5840 '
5850 IF N2 <= RNS(J) THEN
5860 IF J < 18 THEN
5870 J = J + 1
5880 GOTO 5850
5890 END IF
5900 IF J >= 18 THEN J = 18
5910 END IF
5920 Z1 = Z2
5930 N1 = N2
5940 IF Z1 < ZUP(I) THEN 5260
5950 '
5960 NEXT I
5970 '
5980 IF N < 0 THEN N = 0
5990 '
6000 IF N <= 16 THEN 'Rundung
6010 N = INT(N * 1000 + .5) / 1000
6020 ELSEIF N > 16 THEN
6030 N = INT(N * 100 + .5) / 100
6040 END IF
6050 '
6060 '
6070 '--- Berechnung der Pegellautst„rke fr LN < 40 PHON
6080 ' bzw. N < 1 SONE
6090 '
6100 LN = 40 * (N + .0005) ^ .35
6110 IF LN < 3 THEN LN = 3
6120 '
6130 '--- Berechnung der Pegellautst„rke fr LN >= 40 PHON
6140 ' bzw. N >= 1 SONE
6150 '
6160 IF N >= 1 THEN LN = 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„t ist nicht in Ordnung -"
6270 LOCATE 12, 45: PRINT " bitte berprfen !"
6280 SOUND 2000, 3
6290 LOCATE 14, 10: PRINT "Taste drcken !"
6300 GOSUB 4360: GOSUB 6380
6310 RESUME 3440
6320 '
6330 '
6340 '***********************************
6350 '* Unterprogramm zur Tastenabfrage *
6360 '***********************************
6370 '
6380 LET A$ = INKEY$
6390 WHILE A$ = "": LET A$ = INKEY$: WEND: RETURN
6400 '
6410 '
6420 '*******************************************************
6430 '*******************************************************