REM Surface Waves II .... Rev 2.0 REM A J Tooth / May 2003 Updated 21st June 2003 : HIMEM=LOMEM + 5000000 REM Set up use of Full Screen PROC_fullscreen(22) Xlim%=2048 : Ylim%=1536 : REM Enter Parameters PROC_input : DIM pnts%(Xlim%/2,stp%) : REM Read in Weights DIM Wght%(qt%) IF in$="f" THEN RESTORE PROC_read ELSE PROC_wghtcalc ENDIF : REM Further Setup COLOUR 0 : COLOUR 143 : CLS : GCOL 143 : CLG ORIGIN 0,(Ylim%/2) dk=(K-1)/qt% : REM Title PROC_title(1024,0) : REM Time Loops FOR tim%=0 TO stp% Tm=tim%*Scl%/stp% REM Calculate Waveforms PROC_trac(tim%) PROC_calc NEXT tim% : REM Display Resultant Surface Wave CLS : CLG 460 PROC_disp : a$=GET$ : IF a$="r" THEN a%=1 ELSE a%=2 ON a% GOTO 460,510 REM 510 QUIT END : REM End of Program ..................................... REM Functions and Procedures REM ======================== REM Traps Computational Range Errors ONLY 600 IF ERR=21 OR ERR=23 OR ERR=18 OR ERR=20 OR ERR=22 OR ERR=24 THEN GOTO 1040 ELSE ERROR ENDIF GOTO 1100 REM Wave Number Weights ( Fibonacci Numbers ) DATA 1,10,45,120,210,252,210,120,45,10,1 REM Read in Weights Data DEF PROC_read LOCAL p% Tot%=0 FOR p%=0 TO qt% READ Wght%(p%) Tot%=Tot%+Wght%(p%) NEXT p% ENDPROC REM Display Waves DEF PROC_disp LOCAL t%,q%,y% PROC_title(1024,500) GCOL 3 : MOVE 0,-Ylim% : PLOT 101,2048,-150 FOR t%=0 TO stp% FOR q%=0 TO (Xlim%/2) y%=pnts%(q%,t%) r%=2*q% GCOL 4 : MOVE r%,-150 : DRAW r%,y% : GCOL 15 : MOVE r%,150 : DRAW r%,y% SYS "UpdateWindow",@hwnd% NEXT q% NEXT t% ENDPROC REM Calculate Wave Points DEF PROC_calc LOCAL x%,xac,pnts,j% FOR x%=0 TO (Xlim%/2) xac=x%*Xmax*2/Xlim% pnts=0 REM Combine Fourier Integral Elements FOR j%=0 TO qt% ON ERROR LOCAL GOTO 600 1040 k=(1+(j%*dk))/2 w=SQR(10*k) pnts=pnts + dk*(Wght%(j%)/Tot%)*COS(k*xac-w*Tm) NEXT j% sg%=SGN(pnts) pnts%(x%,tim%)=sg%*INT(ABS((Ylim%/4)*pnts)) 1100 NEXT x% ENDPROC REM Enter Parameters DEF PROC_input 1150 INPUT " Read in fixed weights or calculate ( f or c. c is best. )",in$ IF (in$<>"f" AND in$<>"c") THEN GOTO 1150 IF in$="c" THEN INPUT " How many calculated weights (24)",qt% INPUT " Enter calculated weight factor (.01)",c ELSE qt%=10 ENDIF INPUT " Timescale (100) ",Scl% INPUT " Number of time-steps (360) ",stp% INPUT " Enter largest x-value (200) ";Xmax INPUT " Enter max spread of wave-number,K (3.0) [Must be >1] ";K ENDPROC REM Calculated Weights Procedure. Uses exp(-x²) function. DEF PROC_wghtcalc LOCAL p%,v Tot%=0 FOR p%=0 TO qt% v=p%-(qt%/2) Wght%(p%)=INT(1000*(EXP(-c*(v*v)))) Tot%=Tot% + Wght%(p%) NEXT p% ENDPROC REM Title DEF PROC_title(f%,g%) GCOL 4 : MOVE f%,g% : MOVE f%+300,g% : PLOT 205,f%,g%+100 GCOL 6 FOR a%=50 TO 550 STEP 2 v%=INT(5*(1+SIN(a%/4))) PLOT 69,(f%-300+a%),(g%+v%-10) NEXT a% VDU5 : GCOL 15 : MOVE f%-200,g%+50 : PRINT "SURFACE WAVES on WATER" VDU4 ENDPROC REM Tracks stage of calculation DEF PROC_trac(Tim%) PRINT TAB(5,5);" Calculating Wave for time-slot ";Tim% ENDPROC REM Set up use of Full Screen DEF PROC_fullscreen(N%) SYS "GetSystemMetrics", 0 TO xscreen% SYS "GetSystemMetrics", 1 TO yscreen% SYS "SetWindowLong",@hwnd%,-16,&16000000 SYS "SetWindowPos",@hwnd%,-1,0,0,xscreen%,yscreen%,0 MODE N% MOUSE OFF : OFF : REM Turns off the Mouse Pointer and the Cursor ENDPROC