C C This program cam from my old classmate Paul Burke. C It was originally written for an IBM megamonster and I C copied the EBCDICK cards and stuffed it into RT11. C I haven't completed changing it C yet but I think GETSTR is only problem. easily fixed. C (late flash: its ok now) C Neither Paul or I guarantee its acuracy but it is fun. C If I get a chance I'll find the newer version which prints a C diagram of the box C (second late flash: it prints the diagram) C Russ Brown 22:29 5-dec-79 C Hope san Diego is fun, its cold here! C DIMENSION A(5),BLOW(5),BUP(5) LOGICAL*1 STR(6) COMMON R,W,BSLACK,SQ,SH,ACONE,CONST,T,TG,VSPR,HDUCT,REALL,SW COMMON VEFF,CVEFF,ADUCT,B 2 TYPE 4 ERR=.FALSE. 4 FORMAT(' DO YOU WANT AN EXPLANATION OF THE PROGRAM?',/, 1 ' TYPE "Y" OR "N" THEN ',$) CRT11 CALL GETSTR(5,STR,1,ERR) READ(5,2222)NCHRS,(STR(I),I=1,NCHRS) IF(ERR)WRITE(5,*)'INPUT ERROR, START AGAIN' IF(ERR)GO TO 2 IF(STR(1).EQ."116)GO TO 10 IF(STR(1).NE."131)WRITE(5,*)'INPUT ERROR, TRY AGAIN' IF(STR(1).NE."131)GO TO 2 WRITE(5,*)'THIS FORTRAN PROGRAMME WILL DESIGN A BASS REFLEX' WRITE(5,*)'SPEAKER ENCLOSURE. IT PRODUCES THE EXACT DIMENSIONS' WRITE(5,*)'FOR THE SEVEN PIECES OF WOOD AND INDICATES WHETHER' WRITE(5,*)'ALL THE PIECES CAN BE CUT FROM ONE 4 BY 8 SHEET.' WRITE(5,*)'GOOD RESULTS ARE OBTAINED WHEN THE SPEAKERS HAVE' WRITE(5,*)'OUTSIDE DIAMETERS IN THE RANGE 4 TO 10 INCHES.' WRITE(5,*)'THE DIMENSIONS OF THE ACTIVE VOLUME IN THE' WRITE(5,*)'ENCLOSURE ARE APPROXIMATELY THE RATIO 3:4:5 TO' WRITE(5,*)'MINIMIZE PANEL RESONANCES.' WRITE(5,*)'YOU WILL NEED TO KNOW THE FOLLOWING INFORMATION' WRITE(5,*)'1 THE FREE AIR RESONANCE OF THE SPEAKER; ____ HERTZ' WRITE(5,1001)' THIS CAN BE FOUND BY CONNECTING THE SPEAKER 1 TO A SINE WAVE' 1001 FORMAT(' ',100A1) WRITE(5,1001)' FUNCTION GENERATOR AND VARYING THE 1FREQUENCY UNTILL' WRITE(5,1001)' RESONANCE IS FOUND. TO FIND THIS POINT 1EASILY PUT THE' WRITE(5,1001)' SPEAKER, CONE UPWARDS, ON A TABLE 1 AND PUT A LITTLE' WRITE(5,1001)' FLOUR ON THE CONE. AT RESONANCE THE FLOUR 1 WILL BE ENTIRELY' WRITE(5,1001)' AIR BORN; CAUTION DO NOT DESTROY THE SPEAKER 1 BY APPLYING' WRITE(5,1001)' TO MUCH POWER!!!' WRITE(5,*)'2 THE EFFECTIVE CONE DIAMETER; ____ INCHES. THIS' WRITE(5,*)' IS MEASURED ACROSS THE INNERMOST RIPPLE.' WRITE(5,*)'3 THE ESIMATED VOLUME OCCUPIED BY THE SPEAKER' WRITE(5,*)' WHEN MOUNTED IN THE ENCLOSURE; ____ 1 CUBIC INCHES' WRITE(5,*)'4 THE THICKNESS OF THE WOOD; ____ INCHES' WRITE(5,*)'5 THE THICKNESS OF THE ACOUSTICAL PADDING THAT' WRITE(5,*)' WILL LINE THE BOX; ____ INCHES' WRITE(5,1001)(' 6 THE OUTSIDE OR MAXIMUM SPEAKER DIAMETER; 1 ____ INCHES') TYPE 6 6 FORMAT(' YOU CAN STOP NOW AND USE THE PRINTOUT TO RECORD',/, 1' THE INFORMATION OR IF YOU ALREADY HAVE IT.',/, 2' TO CONTINUE TYPE "Y" AND ',$) 8 ERR=.FALSE. CRT11 CALL GETSTR(5,STR,1,ERR) READ(5,2222)NCHRS,(STR(I),I=1,NCHRS) 2222 FORMAT(Q,6A1) IF(ERR)WRITE(5,*)'INPUT ERROR, TRY AGAIN' IF(ERR)GO TO 8 IF(STR(1).NE."131)GO TO 74 C300 PUT IN ACCEPTS FOR FRES,DIA,VSPR,T,TG,WMIN 10 CONTINUE TYPE 12 12 FORMAT(' TYPE THE RESONANT FREQUENCY IN HERTZ ',$) ACCEPT 14,FRES IF((FRES.LT.10.).OR.(FRES.GT.300.))GO TO 10 14 FORMAT(F6.2) 15 TYPE 16 16 FORMAT(' TYPE THE EFFECTIVE DIAMETER IN INCHES ',$) ACCEPT 14,DIA IF((DIA.LT.4.).OR.(DIA.GT.12.))GO TO 15 17 TYPE 18 18 FORMAT(' TYPE THE ESTIMATED VOLUME IN CUBIC INCHES ',$) ACCEPT 14,VSPR IF((VSPR.LT.10.).OR.(VSPR.GT.10000.))GO TO 17 19 TYPE 20 20 FORMAT(' TYPE THE WOOD THICKNESS IN INCHES ',$) ACCEPT 14,T IF((T.LT.0.25).OR.(T.GT.2.))GO TO 19 21 TYPE 22 22 FORMAT(' TYPE THE PADDING THICKNESS ',$) ACCEPT 14,TG IF((TG.LT.0.25).OR.(TG.GT.3.))GO TO 21 TYPE 24 24 FORMAT(' TYPE THE MAXIMUM DIAMETER ',$) ACCEPT 14,WMIN TG=0.1*TG ERRA=0.1 ERRD=0.01 D=0.5 PI=3.14159 ACONE=(PI*DIA**2)/4. CONST=(2150./FRES)**2 N=5 R=5. W=WMIN BSLACK=0.5 SH=10. SQ=8. SW=6. A(1)=R A(2)=W A(3)=BSLACK A(4)=SQ A(5)=SH BLOW(1)=2. BUP(1)=6. BLOW(2)=WMIN-0.01 BUP(2)=25. BLOW(3)=0. BUP(3)=1. BLOW(4)=7.5 BUP(4)=8.5 BLOW(5)=9.5 BUP(5)=10.5 CALL SEARCH(N,A,BLOW,BUP,ERRA,ERRD,D,ERF,RESF) IF(ERF.LE.0.)GO TO 30 26 TYPE 28,(A(I),I=1,N) 28 FORMAT(' SEARCH STOPPED AFTER 20 ITERATIONS',/, 1' VALUES RETURNED',3F8.2) 30 R=A(1) W=A(2) BSLACK=A(3) SQ=A(4) SH=A(5) Q=SQ*W/SW H=SH*W/SW DEXT=Q+T+TG WEXT=2.*T+W HSIDE=TG+H+T+HDUCT HBACK=HSIDE+2.*T HFRONT=H+TG TYPE 32 32 FORMAT(' THE INPUT DATA IS') TYPE 34,FRES 34 FORMAT(' THE FREE AIR RESONANCE IS ',F7.2,' HERTZ') TYPE 36,DIA 36 FORMAT(' THE EFFECTIVE DIAMETERIS ',F7.2,' INCHES') TYPE 38,T 38 FORMAT(' THE CABINET MATERIAL THICKNESS IS ',F7.2,' INCHES') TYPE40,VSPR 40 FORMAT(' THE ESTIMATED SPEAKER VOLUME IS',F7.2,' CUBIC INCHES') TG=TG*10. TYPE 42,TG 42 FORMAT(' THE FIBERGLASS PADDING IS APPROXIMATELY',F7.2, 1' INCHES THICK',//) TG=TG*.1 TYPE 44 44 FORMAT(' THE SPEAKER CABINET HAS THE FOLLOWING 1 CHARACTERISTICS',//) TYPE 46,ACONE,ADUCT 46 FORMAT(' THE SPEAKER CONE AREA IS',F10.3,' SQUARE INCHES',/, 1' AND THE DUCT AREA IS ',F10.3,' SQUARE INCHES:',/, 2' THESE SHOULD BE EQUAL',/) TYPE 48,VEFF,CVEFF 48 FORMAT(' THE ACTIVE VOLUME IS ',F10.3,' CUBIC INCHES',/, 1' AND THE THEORETICAL VOLUME SHOULD BE ',F10.3,' CUBIC 2 INCHES') TYPE 50,WEXT,DEXT 50 FORMAT(' TOP AND BOTTOM PIECES',F8.2,' INCHES WIDE BY', 1F8.2,' INCHES DEEP') TYPE 52,HSIDE,DEXT 52 FORMAT(' SIDE PIECES',F8.2,' INCHES HIGH BY ' 1,F8.2,' INCHES DEEP') TYPE 54,W,HFRONT 54 FORMAT(' FRONT PANEL ',F8.2,' INCHES WIDE BY ' 1,F7.2,' INCHES HIGH') TYPE56,WEXT,HBACK 56 FORMAT(' BACK PANEL ',F8.2,' INCHES WIDE BY ', 1F8.2,' INCHES HIGH') TYPE 58,W,REALL 58 FORMAT(' DUCT PANEL ',F8.2,' INCHES WIDE BY ', 1F8.2,' INCHES DEEP') CL1=DEXT+2.*WEXT CL2=2.*HSIDE IF(CL1.GE.48.)GO TO 62 IF(CL2.GE.48.)GO TO 62 TYPE 60 60 FORMAT(' USE ONE 4 BY 8 SHEET') GO TO 66 62 CONTINUE TYPE 64 64 FORMAT(' USE MORE THAN ONE 4 BY 8 SHEET') 66 CONTINUE 68 CONTINUE 70 TYPE 72 72 FORMAT(' ','DO YOU WANT A DIAGRAM? TYPE Y OR N '$) CRT11 CALL GETSTR(5,STR,1,ERR) READ(5,2222)NCHRS,(STR(I),I=1,NCHRS) IF(STR(1).EQ."116)GO TO 74 IF(STR(1).NE."131)GO TO 70 CALL DIAG 74 CONTINUE TYPE 76 76 FORMAT(' ',///,' **PROGRAMME TERMINATED**') STOP END SUBROUTINE SEARCH(N,A,BLOW,BUP,ERRA,ERRD,D,ERF,RESF) DIMENSION A(5),BLOW(5),BUP(5),U(5),Y(5) ERF=0. DO 2 I=1,N U(I)=A(I) 2 CONTINUE CALL FNCTN(N,A,RES,D) RESF=RES Q=0. 4 Q=Q+1. C*************************************** C WRITE(3,20) A,RESF,D TYPE 6,(A(I),I=1,5),RESF,D 6 FORMAT(' ',5F5.2,4X,F15.6,4X,F6.2) IF((Q-50.).LE.0)GO TO 10 ERF=1. RETURN 10 CALL LOCAL(N,A,RESI,BLOW,BUP,D) DO 12 I=1,N IF((ABS(A(I)-U(I))-ERRA).GT.0.)GO TO 14 12 CONTINUE D=D/2. IF((D-ERRD).LE.0.)RETURN GO TO 4 14 IF((RESI-RESF).GT.0.)GO TO 28 RESF=RESI DO 26 I=1,N Y(I)=A(I) A(I)=2.*Y(I)-U(I) IF((A(I)-BLOW(I)).GT.0.)GO TO 20 A(I)=Y(I) GO TO 24 20 IF((A(I)-BUP(I)).LT.0)GO TO 24 A(I)=Y(I) 24 U(I)=Y(I) 26 CONTINUE GO TO 4 28 DO 30 I=1,N A(I)=U(I) 30 CONTINUE GO TO 4 32 CONTINUE RETURN END SUBROUTINE LOCAL(N,A,RESI,BLOW,BUP,D) DIMENSION A(5),BLOW(5),BUP(5),A1(5) CALL FNCTN(N,A,RES,D) RESI=RES DO 2 I=1,N A1(I)=A(I) 2 CONTINUE DO 22 I=1,N A(I)=A1(I)+D IF((A(I)-BUP(I)).LT.0.)GO TO 6 A(I)=A1(I) 6 CALL FNCTN(N,A,RES,D) RA1=RES ASAVE1=A(I) A(I)=A1(I)-D IF((A(I)-BLOW(I)).GT.0.)GO TO 10 A(I)=A1(I) 10 CALL FNCTN(N,A,RES,D) RA2=RES ASAVE2=A(I) IF((RA1-RA2).GT.0.)GO TO 16 12 IF((RESI-RA1).LE.0.)GO TO 20 A(I)=ASAVE1 RESI=RA1 GO TO 22 16 IF((RESI-RA2).LE.0.)GO TO 20 A(I)=ASAVE2 RESI=RA2 GO TO 22 20 A(I)=A1(I) 22 CONTINUE RETURN END SUBROUTINE FNCTN(N,A,RES,D) DIMENSION A(5) COMMON R,W,BSLACK,SQ,SH,ACONE,CONST,T,TG,VSPR,HDUCT,REALL,SW COMMON VEFF,CVEFF,ADUCT,B R=A(1) W=A(2) BSLACK=A(3) SQ=A(4) SH=A(5) Q=SQ*W/SW H=SH*W/SW HDUCT=W/R ADUCT=HDUCT*W B=1.5*HDUCT+BSLACK REALL=Q+T-B EFFL=REALL+SQRT(ACONE) VDUCT=REALL*HDUCT*W VPANEL=(REALL-T)*W*T VTDT=W*Q*(H+T+HDUCT) VEFF=VTDT-VDUCT-VSPR-VPANEL CVEFF=CONST*ACONE*R**.12/EFFL RES=(VEFF-CVEFF)**2+100.*(ACONE-ADUCT)**2+BSLACK**2 RETURN END C C TO BE ADDED TO BASS REFLEX DESIGN PROGRAM C SUBROUTINE DIAG TYPE 28 TYPE 2 TYPE 4 TYPE 30 TYPE 6 TYPE 10 TYPE 8 TYPE 10 TYPE 10 TYPE 10 TYPE 10 TYPE 10 TYPE 10 TYPE 10 TYPE 10 TYPE 10 TYPE 10 TYPE 10 TYPE 10 TYPE 10 TYPE 10 TYPE 10 TYPE 10 TYPE 10 TYPE 10 TYPE 14 TYPE 12 TYPE 16 TYPE 32 TYPE 18 TYPE 20 TYPE 20 TYPE 20 TYPE 20 TYPE 24 TYPE 22 TYPE 4 TYPE 34 TYPE 26 2 FORMAT(' ',T3,' ____________________________________', 1T45,' ____________________________') 4 FORMAT(' ',T3,'| | |', 1T45,'| |') 6 FORMAT(' ',T3,'|_________________________________| |', 1T45,'|____________________________|') 8 FORMAT('+',T3,' XXXXXXXXXXXXXXXXXXXXXXXXXXXX', 1T45,' XXXXXXXXXXXXXXXXXXXX') 10 FORMAT(' ',T3,'| |X X| |', 1T45,'| |X X| |') 12 FORMAT('+',T3,' XXXXXXXXXXXXXX', 1T45,' XXXXXXXXXXXXXXXXXXXXXX') 14 FORMAT(' ',T3,'|__|______________ X| |', 1T45,'| |______________________| |') 16 FORMAT(' ',T3,'| | X| |', 1T45,'| | | |') 18 FORMAT(' ',T3,'|_________________| X| |', 1T45,'| |______________________| |') 20 FORMAT(' ',T3,' X| |', 1T45,'| | | |') 22 FORMAT('+',T3,' X', 1T45,' | |') 24 FORMAT(' ',T3,' _________________________________| |', 1T45,'|____________________________|') 26 FORMAT(' ',T3,'|_________________________________|__|', 1T45,'|____________________________|') 28 FORMAT(' ',T14,'SIDE SECTION',T56,'FRONT VIEW'///) 30 FORMAT('+',T20,'TOP',T59,'TOP') 32 FORMAT('+',T10,'DUCT',T58,'DUCT') 34 FORMAT('+',T15,'BOTTOM',T57,'BOTTOM') RETURN END