[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 Mnchen                             *
70  '*           Institut fr 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 fr 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 fr 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 '    Bercksichtigung 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 fr 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 gewnschten Kennbuchstaben ein!"
3190 LOCATE 13, 1
3200 PRINT "Sind die Terzpegel gltig fr 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 drcken"
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 '    fr 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 Bercksichtigung 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 Sttzwerte 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 Sttzwerte 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 fr 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 fr 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 berprfen !"
6280 SOUND 2000, 3
6290 LOCATE 14, 10: PRINT "Taste drcken !"
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 '*******************************************************