home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
QBAS
/
CHAOSEXE.ZIP
/
XPENDSIC.TRU
< prev
next >
Wrap
Text File
|
1980-01-01
|
3KB
|
94 lines
!PROGRAM TITLE - "XPENDSIC"
CLEAR
PRINT" ***PENDULUM - SENSITIVITY TO INITIAL CONDITIONS***"
PRINT"THIS PROGRAM DISPLAYS THE 2-DIMENSIONAL PHASE DIAGRAM "
PRINT"FOR TWO DIFFERENT SETS OF INTIAL CONDITIONS OF THE PENDULUM."
PRINT"THE OBJECT IS TO ILLUSTRATE SENSITIVITY TO INITIAL CONDITIONS."
!
LIBRARY "SGLIB.TRC"
DECLARE DEF ACCEL
DIM A(1), B(1),XINT(2),VINT(2)
!INPUT STATEMENTS
INPUT PROMPT"INPUT DRIVING FORCE STRENGTH:":g
INPUT PROMPT"INPUT DAMPING (IF NO DAMPING THEN INPUT 9999999):":q
FOR I=1 TO 2
INPUT PROMPT"INPUT: INITIAL ANGLE , ANGULAR VELOCITY:":XINT(I),VINT(I)
NEXT I
INPUT PROMPT"INPUT: MINUMUM TIME , MAXIMUM TIME:":TMIN,TMAX
CALL PARAMS(W,EPS,TSTEP,XMIN,XMAX,YMIN,YMAX) !SETS MISC AND GRAPH PARAMETERS
CALL SETXSCALE(XMIN,XMAX) !FROM SGLIB
CALL SETYSCALE(YMIN,YMAX) !FROM SGLIB
CALL SETTEXT("PENDULUM - 2-D PHASE DIAGRAM","ANGLE","ANGULAR VELOCITY")
CALL RESERVELEGEND !FROM SGLIB , SAVES SPACE FOR LEGENDS
DATA 0,0
CALL DATAGRAPH(A,B,1,0,"RED") !FROM SGLIB - PLOTS INITIAL POINT
FOR J=1 TO 2
LET T=0
LET X=XINT(J)
LET V=VINT(J)
CALL GOTOCANVAS !SETS SCREEN FOR GRAPH
!
!CALCULATION AND GRAPHNG BLOCK
FOR I=1 TO 10000000
CALL RK4(X,V,TSTEP,XNEW,VNEW,T,W,G,Q) !CALL RUNGE-KUTTA, STEP = TSTEP
LET TSHALF=TSTEP/2 ! SPLIT INTERVAL
CALL RK4(X,V,TSHALF,XNH,VNH,T,W,G,Q) ! DO TWO HALF STEPS
CALL RK4(XNH,VNH,TSHALF,XN,VN,T+TSHALF,W,G,Q)
LET D1=ABS(XN-XNEW)
LET D2=ABS(VN-VNEW)
LET DELTA=MAX(D1,D2)
IF DELTA<EPS THEN
IF T>TMIN THEN
! IF ABS(X)>PI THEN LET X=X-2*PI*ABS(X)/X
IF J=1 THEN CALL GRAPHPOINT(X,V,3)
IF J=2 THEN CALL GRAPHPOINT(X,V,10)
END IF
LET X=XNEW
LET V=VNEW
LET T=T+TSTEP
LET TSTEP=TSTEP*.95*(EPS/DELTA)^.25
! IF ABS(X)>PI THEN LET X=X-2*PI*ABS(X)/X
ELSE
LET TSTEP=TSTEP*.95*(EPS/DELTA)^.2 !REDUCE STEP SIZE
END IF
IF T>TMAX THEN LET I=10000001
NEXT I
NEXT J
CALL ADDLEGEND("G="&STR$(G)&" Q="&STR$(Q),0,1,"WHITE")
CALL DRAWLEGEND !ADDS G AND Q VALUES TO LEGEND
get key variable
clear
print"press <esc> key to finish"
END
!
SUB RK4(X,V,TSTEP,XNEW,VNEW,T,W,G,Q) !RUNGE-KUTTA INTEGRATOR
DECLARE DEF ACCEL
LET XK1=TSTEP*V
LET VK1=TSTEP*ACCEL(X,V,T,W,G,Q)
LET XK2=TSTEP*(V+VK1/2)
LET VK2=TSTEP*ACCEL(X+XK1/2,V+VK1/2,T+TSTEP/2,W,G,Q)
LET XK3=TSTEP*(V+VK2/2)
LET VK3=TSTEP*ACCEL(X+XK2/2,V+VK2/2,T+TSTEP/2,W,G,Q)
LET XK4=TSTEP*(V+VK3)
LET VK4=TSTEP*ACCEL(X+XK3,V+VK3,T+TSTEP,W,G,Q)
LET VNEW=V+(VK1+2*VK2+2*VK3+VK4)/6
LET XNEW=X+(XK1+2*XK2+2*XK3+XK4)/6
END SUB
!
DEF ACCEL(X,V,T,W,G,Q)
LET DAMP=1/Q
LET ACCEL=-SIN(X)-DAMP*V+G*COS(W*T)
END DEF
!
SUB PARAMS(W,EPS,TSTEP,XMIN,XMAX,YMIN,YMAX)
LET W=0.66666666
LET EPS=1.0E-6
LET TSTEP=0.5
LET XMIN=-6
LET XMAX=6
LET YMIN=-4
LET YMAX=4
END SUB