' program kplib.bas ' EQUILIBRIUM CONSTANT written by Ingemar Bjerle 2002 'nomainwin 'Equilibrium calculations DIM A$(200):DIM C(200,7):DIM KP(30):DIM T(30):DIM S(30):DIM B$(200) P=138: PP3=22 REM "PP3+1=Number of lines in the component matrix" CLS OPEN "c:\kpdat" FOR OUTPUT AS #1 WindowWidth = 570 : WindowHeight = 500'470 270 ' left top length hight StaticText #w.1, "A:" ,140, 10, 45, 20 StaticText #w.2, "B:" ,200, 10, 45, 20 StaticText #w.3, "C:" ,260, 10, 45, 20 StaticText #w.4, "D:" ,320, 10, 45, 20 STATICTEXT #w.5, "E:" ,380, 10, 45, 20 staticText #w.6, "Xstart:" ,380, 85, 40, 20 StaticText #w.7, "Ystart:" ,380, 115 ,40, 20 StaticText #w.8, "dY/dX:" ,380, 145 ,40, 20 StaticText #w.9, "Xend:" ,470, 85, 30, 20 StaticText #w.10, "Runge Step:" ,160, 120, 40, 30 StaticText #w.status1, "", 60, 50 , 350, 20'diffeq StaticText #w.status3, "", 10, 30, 40, 40'START HERE StaticText #w.status5, "", 400, 175, 200, 20'recnum StaticText #w.status6, "", 5, 175, 70, 20'recnum StaticText #w.status9, "", 10, 70, 100, 30 TextBox #w.eq, 100, 90, 250, 20 TextBox #w.n, 120, 30, 50, 20 TextBox #w.n1, 180, 30, 50, 20 TextBox #w.t, 240, 30, 50, 20 TextBox #w.xx, 300, 30, 50, 20 TextBox #w.comp1, 360, 30, 50, 20 ' TextBox #w.mol1, 460, 65, 30, 20 TextBox #w.comp2, 420, 80, 40, 20 TextBox #w.mol2, 420, 110, 40, 20 TextBox #w.comp3, 420, 140, 40, 20 TextBox #w.mol3, 500, 80, 40, 20 TextBox #w.mol4, 200, 120, 30, 20 ' TextBox #w.comp4, 580, 65, 30, 20 ' TextBox #w.comp5, 620, 35, 30, 20 ' TextBox #w.mol5, 620, 65, 30, 20 ' TextBox #w.comp6, 660, 35, 30, 20 ' TextBox #w.mol6, 660, 65, 30, 20 Button #w.c1, "Reset", [reset], UL, 30, 10, 50, 30 ' Button #w.c1, "Continue1", [continue1], UL, 355, 30, 60, 30 ' Button #w.c2, "Continue2", [continue2], UL, 695, 30, 60, 30 Button #w.c3, "Calc", [calc], UL, 280,120, 60, 30 Button #w.exit, "Close", [close.w], UL, 500,20, 40, 30 Button #w.add, "Add New at end", [add.rec], UL, 80,170, 90, 25 Button #w.upd, "Update present", [update.rec], UL, 180,170, 90, 25 Button #w.prv, "Previous", [prev.rec], UL, 280,170, 50, 25 Button #w.next, "Next", [next.rec], UL, 340,170, 50, 25 TEXTEDITOR #w.res, 10,200, 550,250'HEIGHT ' TEXTeditor #w.conf, 400,90, 280, 70'HEIGHT ' TEXTeditor #w.form, 10, 80, 370, 80'HEIGHT open "DIFFERENTIAL EQUATION INTIAL VALUE" for dialog as #w print #w, "trapclose [close.w]" print #w.n, "!setfocus" 'print #w.status3,"START HERE" ' **** Adress file **** axx=6 'prompt " Choose Indata file(kplib) number (1-10)";axx open "DIFFEQ";axx;".dat" for random as #vcl len=128 print #w.status9, "Indata file: DIFFEQ";axx;".dat " print #w.status1,"D2Y/DX2 + A*DY/DX + B*Y + C*Y*X^D + E = 0" Field #vcl, _ 60 as EQ$, _ 5 as A11, _ 5 as B11, _ 5 as C11, _ 5 as D11, _ 5 as mol1,_ 6 as YS,_ 5 as XE,_ 5 as N1,_ 5 as mol5,_ 5 as mol6,_ 5 as E11,_ 5 as XS,_ 6 as DER,_ 1 as RES, rec= lof(#vcl) / 128 print #w.status6, "Next add at ";rec+1 for I=1 to rec get #vcl,I print #w.res, " ";EQ$ next I print #w.eq,"!font Times_New_Roman 10 bold" print #w.n,"!font Times_New_Roman 10 bold" print #w.n1,"!font Times_New_Roman 10 bold" print #w.t,"!font Times_New_Roman 10 bold" print #w.xx,"!font Times_New_Roman 10 bold" print #w.comp1,"!font Times_New_Roman 10 bold" print #w.comp2,"!font Times_New_Roman 10 bold" print #w.comp3,"!font Times_New_Roman 10 bold" print #w.mol2,"!font Times_New_Roman 10 bold" print #w.mol3,"!font Times_New_Roman 10 bold" 'print #w.res,"!font Courier_New 8 bold " print #w.res,"!font Times_New_Roman 12 bold" goto [reset] goto [loop] PRINT" " [validate]'subroutine valid = 1 print #w.eq, "!contents?" input #w.eq, EQ$ if len(EQ$)>60 then notice "Error!" +chr$(13)+"Allowed string=60, Actual=";len(EQ$) valid=0 return end if print #w.n, "!contents?" input #w.n, A11 print #w.n1, "!contents?" input #w.n1, B11 print #w.t, "!contents?" input #w.t, C11 print #w.xx, "!contents?" input #w.xx, D11 print #w.comp1, "!contents?" input #w.comp1,E11 print #w.comp2, "!contents?" input #w.comp2,XS print #w.comp3, "!contents?" input #w.comp3,DER 'print #w.comp4, "!contents?" 'input #w.comp4,comp4 'print #w.comp5, "!contents?" 'input #w.comp5,comp5 'print #w.comp6, "!contents?" 'input #w.comp6,comp6 'print #w.mol1, "!contents?" 'input #w.mol1,mol1 print #w.mol2, "!contents?" input #w.mol2,YS print #w.mol3, "!contents?" input #w.mol3,XE print #w.mol4, "!contents?" input #w.mol4,N1 'print #w.mol5, "!contents?" 'input #w.mol5,mol5 'print #w.mol6, "!contents?" 'input #w.mol6,mol6 return [add.rec] gosub [validate] if valid = 0 then [loop] recNum = lof(#vcl) / 128 + 1 ' calc location of next record put #vcl, recNum print #w.res, "!cls" print #w.status5, " recNum:"; recNum;" has been added at ";recNum rec= lof(#vcl) / 128 print #w.status6, "Next add at ";rec+1 goto [loop] [update.rec] gosub [validate] if valid = 0 then [loop] put #vcl, recNum 'print #w.res, "!cls" print #w.status5, " recNum: ";recNum;" has been updated at ";recNum goto [loop] [display.rec]'subroutine print #w.eq,EQ$ print #w.n, A11 print #w.n1,B11 print #w.t, C11 print #w.xx,D11 'print #w.mol1,mol1 print #w.mol2,YS print #w.mol3,XE print #w.mol4,N1 'print #w.mol5,mol5 'print #w.mol6,mol6 print #w.comp1,E11 print #w.comp2,XS print #w.comp3,DER 'print #w.comp4,comp4 'print #w.comp5,comp5 'print #w.comp6,comp6 return [prev.rec] if recNum > 1 then recNum = recNum - 1 get #vcl, recNum yy1=lof(#vcl) / 128 print #w.status5, "record-Nr=";recNum;": End of file at ";yy1 else print #w.status5, " Start of file: End of file at ";yy1 end if gosub [display.rec] goto [loop] [next.rec] if recNum < lof(#vcl) / 128 then recNum = recNum + 1 get #vcl, recNum yy=lof(#vcl) / 128 print #w.status5, "record-Nr=";recNum;": End of file at ";yy else print #w.status5, "End of file: Next add at ";recNum+1 end if gosub [display.rec] 'print #w.conf, "press next again or cont1" goto [loop] [reset] print #w.n, "0"; print #w.n1, "0" ; print #w.t, "0" ; print #w.xx, "0" ; print #w.comp1, "0" ; 'print #w.mol1, "0" ; print #w.comp2, "0" ; print #w.mol2, "0" ; print #w.comp3, "0" ; print #w.mol3, "0" ; 'print #w.comp4, "0" ; print #w.mol4, "0" ; 'print #w.comp5, "0" ; 'print #w.mol5, "0" ; 'print #w.comp6, "0" ; 'print #w.mol6, "0" ; 'print #w.conf, "!cls" ; ' print #w.form, "!cls" ; print #w.eq, " " ; print #w.res," Start: Press next to get saved data" print #w.res," Change or insert new data, followed by UPDATE or ADD" print #w.res," ADD places the data at the end of the file" print #w.res," Play with the buttons so you learn how to preserve your data" 'print #w.status1," NOT READY" yy5=0:yy9=0:K=1:yyx=0 C0=0:C1=0:C2=0:C3=0:C4=0:C5=0:C6=0 P0=0:P1=0:P2=0:P3=0:P4=0:P5=0:P6=0 B$="" 'print #w.conf,"Press Next or Insert new data" goto [loop] [calc] [START] PRINT #w.res,"" print #w.res,EQ$ print #w.res,"XSTART= ";XS;" XEND= ";XE;" YSTART =";YS;" DY/DX= ";DER 'STEP = ";N N=N1 PRint #w.res,"RUNGE KUTTA STEPS= ";N XIN=XS XEND=XE YIN=YS UIN=DER print #w.res," X Y DY/DX" NN=20 DX=(XEND-XIN)/N/NN X=XIN: Y=YIN: U=UIN: Z=ZIN PRINT" ";X;" ";Y;" ";U PRINT #w.res," ";X;" ";Y;" ";U FOR KA=1 TO NN X=XIN: Y=YIN: U=UIN: Z=ZIN FOR I=1 TO N GOSUB [RUNGE] NEXT I PRINT" ";X;" ";Y;" ";U PRINT #w.res," ";X;" ";Y;" ";U XIN=XIN+XEND/NN YIN=Y UIN=U XIN=X NEXT KA GOTO [loop] [EQ] ' SUBROUTINE EQUATIONS REM WRITTEN AS TWO FIRST ORDER: A=U: B=(A11*U+Y*B11+C11*Y*X^D11+E11)*(-1) REM BOUNDARY CONDITIONS: XIN=0: XEND=10: Y(5)=71.9429: Y(10)=0 'A=DY B=DU D=DZ '************************************** A=U B=(A11*U+Y*B11+C11*Y*X^D11 +E11)*(-1) '************************************** RETURN [RUNGE] ' SUBROUTINE RUNGE rem VARIABLES IN SUBROUTINE: INDEPENTENT: X DEPENDENT: Y, U AND Z X=X: Y=Y: U=U: Z=Z GOSUB [EQ] K1=A*DX: L1=B*DX: F1=D*DX X=X+DX/2: Y=Y+K1/2: U=U+L1/2: Z=Z+F1/2 GOSUB [EQ] K2=A*DX: L2=B*DX: F2=D*DX X=X-DX/2: Y=Y-K1/2: U=U-L1/2 :Z=Z-F1/2 X=X+DX/2: Y=Y+K2/2: U=U+L2/2 :Z=Z+F2/2 GOSUB [EQ] K3=A*DX: L3=B*DX: F3=D*DX X=X-DX/2: Y=Y-K2/2: U=U-L2/2 :Z=Z-F2/2 X=X+DX: Y=Y+K3: U=U+L3 :Z=Z+F3 GOSUB [EQ] K4=A*DX: L4=B*DX: F4=D*DX X=X-DX: Y=Y-K3: U=U-L3 :Z=Z-F3 X=X+DX Y=Y+K1/6+K2/3+K3/3+K4/6: U=U+L1/6+L2/3+L3/3+L4/6 Z=Z+F1/6+F2/3+F3/3+F4/6 RETURN goto [loop] [loop] input var$ goto [loop] [close.w] close #w :CLOSE #1:close #vcl print" press ENTER to close" input r$ print" *** end ***" end