0  'ACOUSTIC.BAS ++ Calculate Room Acoustics ++
5 'By Ronald F. Balonis  on about February 2, 1989
10 '
12 'RROM: BROADCAST MANAGEMENT ENGINEERING
15 '      JUNE 1989, COMPUTE  page 118
30 RESTORE:READ COEFS:CLR$=SPACE$(80)
40 DIM SURF$(COEFS),COEF(COEFS,6),S(10),SC(10),A(3),A$(3)
50 TLE$="          +++ Calculate Room Acoustics +++"
95 '
100 CLS:PRINT "ACOUSTIC.BAS  ";TLE$:PRINT
105 KR=CSRLIN:GOSUB 600:'--Save Place then show Surfaces & Coefs
150 '
200 LOCATE KR,1:HWL$="":PRINT "DIMENSIONS <H:W:L> (Feet): ";
205 LINE INPUT HWL$
210  IF HWL$="" THEN STOP
215   H=VAL(HWL$)
220    I=INSTR(HWL$,":"):    IF I=0 THEN RUN 0:'--- Restart on
225   W=VAL(RIGHT$(HWL$,LEN(HWL$)-I))
230    I=INSTR(I+1,HWL$,":"):IF I=0 THEN RUN 0:'--- an Error
235   L=VAL(RIGHT$(HWL$,LEN(HWL$)-I))
240   IF H<=0 OR W<=0 OR L<=0 THEN RUN 0
245    A$(1)="CEILING":A(1)=W*L      :VOL=H*W*L
250    A$(2)="WALL   ":A(2)=2*H*(L+W):RT=.15*LOG(VOL)/LOG(10)-.15
255    A$(3)="FLOOR  ":A(3)=W*L      :AREA=A(1)+A(2)+A(3)
260    LOCATE CSRLIN-1,44
265    PRINT USING"VOLUME=#####.#  AREA=#####.#";VOL;AREA
270    PRINT TAB(44);USING"OPTIMAL REVERB TIME=##.## S.";RT
275 '
300 KR=CSRLIN:S=0:'-Get surface types on Ceiling, Walls, & Floor
305 PRINT"Surface  Tot.Area  S.Area#  Percent  <Type>   Surface"
310 FOR I=1 TO 3
315  SUM=0:PRINT USING"\      \ #####.# ";A$(I);A(I);
320  S=S+1:PRCNT$=""
325  LOCATE KR+S,18:PRINT USING"    [##]    ";S;
330  LINE INPUT PRCNT$:PRCNT=VAL(PRCNT$)
335   IF PRCNT$="" THEN PRCNT=100-100*SUM/A(I):'-- Null = % left
340   IF 3-I+S=9   THEN PRCNT=100-100*SUM/A(I):'-- 9    = % left
345   IF PRCNT=<0 THEN RUN 0:'------- Restart on Nothing or Less
350    SA(S)=A(I)*PRCNT/100:SUM=SUM+SA(S)
355    LOCATE KR+S,26
360    PRINT USING"    ###.#     ";100*SA(S)/A(I);
365    LINE INPUT TYPE$
370    IF TYPE$="" THEN 355 ELSE S(S)=VAL(TYPE$)
375     IF S(S)<1 OR S(S)>COEFS THEN 355 ELSE LOCATE CSRLIN-1,38
380      PRINT USING"< ## >  ";S(S);:PRINT SURF$(S(S))
385      IF SUM<A(I) THEN 320
390 NEXT I
395 '
400 GOSUB 500:'--- Calculate, Display, & Prompt What To Do Next
405 LOCATE CSRLIN-1,1:PRINT CLR$:LOCATE CSRLIN-1,1:X$=""
410 LINE INPUT "<C>hange a Surface's TYPE or <R>estart: ";X$
415  IF X$="R" OR X$="" THEN RUN 0 ELSE IF X$<>"C" THEN 405
420   LOCATE CSRLIN-1,46:N$=""
425   LINE INPUT "Surface Area # : ";N$
430    IF N$="" THEN 405 ELSE N=VAL(N$)
435     IF N<1 OR N>S THEN 405 ELSE GOSUB 600
440 '
445 LOCATE KR+N,38:PRINT "       ";:LOCATE KR+N,40:TYPE$=""
450 LINE INPUT TYPE$
455  IF TYPE$="" THEN 445 ELSE S(N)=VAL(TYPE$)
460   IF S(N)<1 OR S(N)>COEFS THEN 445 ELSE LOCATE CSRLIN-1,38
465    PRINT USING"< ## >  ";S(N);:PRINT SURF$(S(N)):GOTO 400
470 '
500 '------------ Calculate and Display Reverb TX by Octaves
505 FOR I=15 TO 23:LOCATE I,1:PRINT CLR$;:NEXT I:' CLEAR SCRN
510 LOCATE 16,1:PRINT STRING$(71,"+"):PRINT
515 PRINT "OCTAVE BAND    (Hertz): ";:FRQ=125/2
520 FOR I=1 TO 6
525  SC=0:SC(I)=0:FRQ=FRQ*2:PRINT USING"  ##### ";FRQ;
530  FOR II=1 TO S
535   J=S(II):SC=SC+SA(II)*COEF(J,I):'-- Average Coefficient
540  NEXT II:SC(I)=SC/AREA
545 NEXT I:PRINT
550 PRINT "REVERB. TIME  (Sabine): ";
555 FOR I=1 TO 6:
560  PRINT USING"  ##.## ";.05*VOL/(AREA*SC(I));
565 NEXT I:PRINT
570 PRINT "REVERB. TIME  (Eyring): ";
575 FOR I=1 TO 6:
580  PRINT USING"  ##.## ";.05*VOL/(-AREA*LOG(1-SC(I)));
585 NEXT I:PRINT:PRINT:PRINT:RETURN
590 '
600 '---------- Display Surfaces to Select Sound Coeficients
605 LOCATE 15,1:RESTORE:READ COEFS
610 PRINT STRING$(34,"+");" Surfaces ";STRING$(34,"+")
615 FOR I=1 TO COEFS
620  READ SURF$(I):PRINT USING" <##> ";I;:PRINT SURF$(I);
625  FOR II=1 TO 6:READ COEF(I,II):NEXT II
630 NEXT I:RETURN
700 '------- Surface ---- Sound Absorption Coefficients
710 DATA 31:'Octave Band= 125  250  500  1000 2000 4000
712 DATA "Acoustic-tile ",.050,.220,.520,.560,.450,.320
714 DATA "Fiberglass-2in",.220,.820,.990,.990,.990,.990
716 DATA "F.Glass-rll2in",.170,.550,.800,.900,.850,.800
718 DATA "Tile/drop ceil",.700,.660,.720,.920,.880,.750
720 DATA "Fbr spryon.5in",.050,.150,.450,.700,.800,.800
722 DATA "Fbr spryon.7in",.100,.300,.600,.900,.900,.950
724 DATA "Fbr spryon 1in",.160,.450,.700,.900,.900,.850
726 DATA "Brick-unpaintd",.030,.030,.030,.040,.050,.070
728 DATA "Brick-painted ",.010,.010,.020,.020,.020,.030
730 DATA "Con. Blk-unpnt",.360,.440,.310,.290,.390,.250
732 DATA "Con. Blk-paint",.100,.050,.060,.070,.090,.080
734 DATA "Plaster/brick ",.013,.015,.020,.030,.040,.050
736 DATA "Plaster/lath  ",.020,.030,.040,.050,.040,.030
738 DATA "Gypsum board  ",.290,.100,.050,.040,.070,.090
740 DATA "Paneling-3/8  ",.280,.220,.170,.090,.100,.110
742 DATA "Sonex-2in     ",.060,.250,.560,.810,.900,.910
744 DATA "Sonex-3in     ",.120,.440,.965,.975,.980,.990
746 DATA "Sonex-4in     ",.210,.740,.980,.980,.980,.990
748 DATA "Glass-plate   ",.180,.060,.040,.030,.020,.020
750 DATA "Glass-window  ",.350,.250,.180,.120,.070,.040
752 DATA "Glazed-tile   ",.010,.010,.010,.010,.020,.020
754 DATA "Fabric/Drapes ",.030,.040,.110,.170,.240,.350
756 DATA "Drapes-medium ",.070,.310,.490,.750,.700,.600
758 DATA "Drapes-heavy  ",.140,.350,.550,.720,.700,.650
760 DATA "PolyUFoam-.5in",.090,.110,.220,.600,.880,.940
762 DATA "PolyUFoam-1in ",.130,.220,.680,1.00,.920,.970
764 DATA "Concrete      ",.010,.010,.015,.020,.020,.020
766 DATA "Wood          ",.015,.011,.010,.070,.060,.070
768 DATA "Tile-lin/asph ",.020,.030,.030,.030,.030,.020
770 DATA "Carpet on con.",.020,.060,.140,.370,.600,.650
772 DATA "Carpet on foam",.080,.024,.057,.690,.710,.730
775 '---- End of Sound Absorption data and the Program.