' ****************************************************************** ' * * ' * DIFFDAT * ' * Interactive creation of data files for KINAL (program DIFF) * ' * * ' ****************************************************************** ' ' DIFFDAT is an extension to KINAL, a program package for the ' analysis of kinetic reaction mechanisms ' '----------------------------------------------------------------------- ' ' written by Prof. G. Huybrechts and S. Merdjan ' Faculteit der toegepaste wetenschappen ' Laboratorium voor fysische scheikunde ' Vrije Universiteit Brussel ' Pleinlaan 2, 1050 Brussel ' Belgium ' ' modified by T. Turanyi ' Department of Physical Chemistry ' Eotvos University ' H-1518 Budapest-112, P.O.Box 32, Hungary ' DIM formula$(56), Y(50), P(90), TA(60), eql%(200), eqr%(300), spl%(200) DIM spr%(300), scl%(200), scr(300), LOGA(90), E(90) COLOR 7, 8 FA$ = "#####": FB$ = ".###^^^^": FC$ = "##.##" EQS = 1 B = 0 xx = 0 zz = 0 FOR i% = 1 TO 200 eql%(i%) = 0 spl%(i%) = 0 scl%(i%) = 0 NEXT i% FOR i% = 1 TO 300 eqr%(i%) = 0 spr%(i%) = 0 scr(i%) = 0! NEXT i% ' ' ' GOSUB 35000: REM +++ RUNNING HEAD +++ PRINT " NEW OR OLD DATA INPUT (N/O) : "; INPUT "", RSD$: IF RSD$ = "O" OR RSD$ = "o" THEN 36016 GOSUB 35000: REM +++ RUNNING HEAD +++ PRINT " ENTER NEW DATA FILENAME (WITHOUT EXTENSION) : " PRINT INPUT " ", FILE$: FILE$ = FILE$ + ".DAT": FL = 1: GOTO 20 36016 GOSUB 35000: REM +++ RUNNING HEAD +++ PRINT " ENTER OLD FILENAME (WITHOUT EXTENSION) : "; INPUT "", FILE$: FILE$ = FILE$ + ".DAT" GOSUB 36000: REM +++ READING OF OLD DATA FILE +++ PRINT PRINT "ENTER THE NAME OF THE NEW DATAFILE : " PRINT " (PLEASE USE A DIFFERENT NAME) " PRINT INPUT AFILE$ IF AFILE$ = "" THEN AFILE$ = "NONAME" FILE$ = AFILE$ + ".DAT" ' 20 GOSUB 35000: REM +++ RUNNING HEAD +++ IF FL = 1 THEN FL = 0: INPUT "ENTER TITLE (70 CHAR MAX) : ", ATIT$: GOTO 13605 PRINT "TITLE : " + TIT$ PRINT "ENTER NEW TITLE (RETURN TO KEEP OLD ONE) " PRINT INPUT ATIT$ 13605 IF ATIT$ = "" THEN 13800 TIT$ = ATIT$ + " " + DATE$ TIT$ = TIT$ + SPACE$(80 - LEN(TIT$)) 13800 GOSUB 35000: REM +++ RUNNING HEAD +++ PRINT PRINT "NBR OF SPECIES (MAX 50) : "; PRINT USING FA$; ny; VAR = ny: GOSUB 28900: ny = VAR PRINT "NBR OF REACTIONS (MAX 90) : "; PRINT USING FA$; nr; VAR = nr: GOSUB 28900: nr = VAR PRINT "NBR OF TIME POINTS (MAX 60) : "; PRINT USING FA$; NT; VAR = NT: GOSUB 28900: NT = VAR PRINT "MODE : 0 = Output onto disc is forbidden " PRINT " 1 = Output onto disc " PRINT " 2 = Check of a reduced model "; PRINT USING FA$; MODE; VAR = MODE: GOSUB 28900: MODE = VAR 15300 LOCATE 15, 56 IF lis = 0 THEN PRINT "N" ELSE PRINT "Y" LOCATE 15, 1 PRINT "LISTING OF REACTIONS (Y/N) : " LOCATE 15, 66: INPUT "", rep$ IF rep$ = "" THEN 15600 IF rep$ = "N" OR rep$ = "n" THEN lis = 0: GOTO 15600 IF rep$ = "Y" OR rep$ = "y" THEN lis = 1: GOTO 15600 GOTO 15300 15600 IF zz = 0 THEN zz = 1 IF xx = 0 THEN xx = 1 GOSUB 29400: REM +++ QUERY ROUTINE +++ IF CP$ <> "Y" AND CP$ <> "y" THEN 13800 GOSUB 24000: REM +++ SAVING +++ 15900 GOSUB 35000: REM +++ RUNNING HEAD +++ PRINT FOR i = 1 TO ny PRINT "NAME OF SPECIES("; i; ") (MAX 8 CHARS) : "; PRINT formula$(i); LOCATE CSRLIN, 66: INPUT "", FORM$ IF FORM$ = "" THEN 16500 formula$(i) = FORM$: FORM$ = "" formula$(i) = SPACE$(8 - LEN(formula$(i))) + formula$(i) 16500 PRINT "CONCENTRATION("; i; ") : "; PRINT USING FB$; Y(i); : VAR = Y(i): GOSUB 28900: Y(i) = VAR PRINT NEXT i GOSUB 29400: REM +++ QUERY ROUTINE +++ IF CP$ <> "Y" AND CP$ <> "y" THEN 15900 GOSUB 24000: REM +++ SAVING +++ 17120 GOSUB 35000: REM +++ RUNNING HEAD +++ PRINT PRINT PRINT PRINT " Rate coefficients or Arrhenius parameters (R/A)"; 17130 a$ = INKEY$ IF a$ = "R" OR a$ = "r" THEN 17140 IF a$ = "A" OR a$ = "a" THEN 17150 GOTO 17130 17140 GOSUB 35000: REM +++ RUNNING HEAD +++ FOR g = 1 TO nr PRINT " K("; g; ") = : "; PRINT USING FB$; P(g); : VAR = P(g): GOSUB 28900: P(g) = VAR NEXT g GOSUB 29400: REM +++ QUERY ROUTINE +++ IF CP$ <> "Y" AND CP$ <> "y" THEN 17140 GOTO 17900 17150 GOSUB 35000: REM +++ RUNNING HEAD +++ PRINT " ********************* ARRHENIUS PARAMETERS ***********************" PRINT " -------------------- " PRINT " [A (##.##) in L, mole, s units and E (###.###) in kcal/mole] " PRINT : PRINT 58000 PRINT " Temperature (K) : "; LOCATE CSRLIN, 66: INPUT ""; TK IF TK = 0 THEN 58000 PRINT FOR g = 1 TO nr PRINT " Log A("; g; ") (If <0 then rate coeff. = 0) : "; PRINT USING FC$; LOGA(g); : VAR = LOGA(g): GOSUB 28900: LOGA(g) = VAR PRINT " E("; g; ") : "; PRINT USING "###.###"; E(g); : VAR = E(g): GOSUB 28900: E(g) = VAR IF LOGA(g) < 0 THEN P(g) = 0: GOTO 58465 PP = 10 ^ (LOGA(g) - (1000 * E(g) / (4.576 * TK))) P(g) = PP 58465 PRINT " K("; g; ") = : "; PRINT USING FB$; P(g) PRINT NEXT g 17800 GOSUB 29400: REM +++ QUERY ROUTINE +++ IF CP$ <> "Y" AND CP$ <> "y" THEN 17150 17900 GOSUB 35000: REM +++ RUNNING HEAD +++ PRINT PRINT "INITIAL STEPSIZE : "; PRINT USING FB$; H; : VAR = H: GOSUB 28900: H = VAR PRINT "MAXIMAL STEPSIZE : "; PRINT USING FB$; HMAX; : VAR = HMAX: GOSUB 28900: HMAX = VAR PRINT "REL. ERR. TOL. (.0001 "Y" AND CP$ <> "y" THEN 17900 CLS 27500 REM ************* TIME POINTS CALCULATION ********************* GOSUB 35000: REM +++ RUNNING HEAD +++ PRINT " AUTOMATIC OR MANUAL INPUT OF TIMES (A/M) : "; INPUT "", IT$ IF IT$ = "M" OR IT$ = "m" THEN 19100 IF IT$ = "A" OR IT$ = "a" THEN 28000 GOTO 27500 28000 PRINT : PRINT : PRINT PRINT " ENTER START TIME : "; LOCATE CSRLIN, 66: INPUT "", STM PRINT " ENTER INCREMENT : "; LOCATE CSRLIN, 66: INPUT "", INC PRINT : PRINT REM INC = (ETM-STM)/(NT-1) FOR V = 1 TO NT TA(V) = STM + INC * (V - 1) PRINT " TIME POINT Nø ("; V; ") : "; PRINT USING FB$; TA(V) NEXT V GOSUB 29400: REM +++ QUERY ROUTINE +++ IF CP$ <> "Y" AND CP$ <> "y" THEN 28000 GOTO 19900 19100 GOSUB 35000: REM +++ RUNNING HEAD +++ PRINT FOR MM = 1 TO NT PRINT "TIME POINT Nø("; MM; ") : "; PRINT USING FB$; TA(MM); VAR = TA(MM): GOSUB 28900: TA(MM) = VAR NEXT MM GOSUB 29400: REM +++ QUERY ROUTINE +++ IF CP$ <> "Y" AND CP$ <> "y" THEN 19100 19900 GOSUB 35000: REM +++ RUNNING HEAD +++ GOSUB 24000: REM +++ SAVING +++ IF RSD$ = "o" OR RSD$ = "O" THEN PRINT PRINT "DO YOU WISH TO RETYPE THE CHEMICAL EQUATIONS ? (Y/N) "; INPUT "", rep$ IF rep$ = "N" OR rep$ = "n" THEN PRINT PRINT "Warning: DIFFDAT sometimes can not copy the description of" PRINT "chemical equations into the new file. Please always check" PRINT "the description of chemical equations in the new file and" PRINT "you may have to use a word processor for the transfer of the" PRINT "data for chemical equations." PRINT GOTO 20040 END IF END IF CLS COLOR 7, 8 PRINT " CHEMICAL EQUATIONS" PRINT PRINT "Highlight the species by arrows and press !" PRINT "Press if you made a mistake !" PRINT "Press if the left-hand side is ready !" PRINT PRINT "1st equation :" ' Table of species im1% = (ny - .1) / 8 'number of rows -1 ju% = ny - im1% * 8 'length of the last row FOR i% = 0 TO im1% FOR j% = 1 TO 8 iy% = i% * 8 + j% il% = 13 + i% jl% = (j% - 1) * 10 + 1 LOCATE il%, jl%: PRINT formula$(iy%) NEXT j% NEXT i% ' ia% = 1 ja% = 1 COLOR 8, 7 il% = 13 jl% = 1 LOCATE il%, jl%: PRINT formula$(1) COLOR 7, 8 '--------------------------------------------------------------- DIM sv(50) bl% = 0 br% = 0 fside% = 0 eql$ = "" FOR ire% = 1 TO nr LOCATE 7, 1 IF ire% = 2 THEN PRINT "2nd equation :" IF ire% = 3 THEN PRINT "3rd equation :" IF ire% > 3 THEN PRINT ire%; "th equation :" ' Searcing for a species 20000 a$ = INKEY$ IF a$ = "" THEN 20000 IF a$ = CHR$(13) THEN 20010 ' IF RIGHT$(a$, 1) = "S" THEN 20020 ' IF a$ = CHR$(27) THEN 20030 ' jr% = ja% ir% = ia% ' IF RIGHT$(a$, 1) = "M" THEN 'right arrow ja% = ja% + 1 IF ja% > 8 THEN ja% = 1: ia% = ia% + 1: IF ia% > im1% + 1 THEN ia% = 1 IF ia% = im1% + 1 AND ja% > ju% THEN ja% = 1 END IF ' IF RIGHT$(a$, 1) = "K" THEN 'left arrow ja% = ja% - 1 IF ja% < 1 THEN ja% = 8: ia% = ia% - 1: IF ia% < 1 THEN ia% = 1 IF ia% = im1% + 1 AND ja% < 1 THEN ja% = ju% END IF ' IF RIGHT$(a$, 1) = "P" THEN 'down arrow ia% = ia% + 1 IF ia% > im1% + 1 THEN ia% = 1 IF ja% > ju% AND ia% > im1% THEN ia% = 1 END IF ' IF RIGHT$(a$, 1) = "H" THEN 'up arrow ia% = ia% - 1 IF ia% < 1 THEN ia% = im1% + 1: IF ja% > ju% THEN ia% = im1% END IF COLOR 7, 8: LOCATE ir% + 12, (jr% - 1) * 10 + 1: PRINT formula$((ir% - 1) * 8 + jr%) COLOR 8, 7: LOCATE ia% + 12, (ja% - 1) * 10 + 1: PRINT formula$((ia% - 1) * 8 + ja%) COLOR 7, 8 GOTO 20000 ' ' A species is selected ' 20010 iy% = (ia% - 1) * 8 + ja% IF fside% = 0 THEN sv(iy%) = sv(iy%) + 1 IF fside% = 1 THEN LOCATE 11, 1 INPUT "Stoichiometric number (press if one) : "; sv(iy%) IF sv(iy%) = 0! THEN sv(iy%) = 1! LOCATE 11, 1: PRINT " " END IF eq$ = "" flag% = 0 FOR i% = 1 TO ny IF sv(i%) = 0 THEN 20011 IF flag% = 1 THEN eq$ = eq$ + " + " IF sv(i%) = 1! THEN eq$ = eq$ + RTRIM$(LTRIM$(formula$(i%))) IF sv(i%) <> 1! THEN eq$ = eq$ + STR$(sv(i%)) + " " + RTRIM$(LTRIM$(formula$(i%))) + " " flag% = 1 20011 NEXT i% LOCATE 9, 1: PRINT eql$; eq$ GOTO 20000 ' ' Erase of input 20020 FOR i% = 1 TO ny sv(i%) = 0 NEXT i% LOCATE 9, 1: PRINT " " LOCATE 9, 1: PRINT eql$ GOTO 20000 ' ' One side is accepted 20030 FOR i% = 1 TO ny IF sv(i%) = 0 THEN 20031 IF fside% = 0 THEN bl% = bl% + 1 eql%(bl%) = ire% spl%(bl%) = i% scl%(bl%) = sv(i%) ELSE br% = br% + 1 eqr%(br%) = ire% spr%(br%) = i% scr(br%) = sv(i%) END IF sv(i%) = 0 20031 NEXT i% eql$ = eq$ + " ---> " eq$ = "" ' Change of side ' fside% = 0 left side ' fside% = 1 right side LOCATE 9, 1 PRINT eql$ LOCATE 5, 1 IF fside% = 0 THEN fside% = 1 PRINT "Press if the right-hand side is ready !" GOTO 20000 ELSE fside% = 0 PRINT "Press if the left-hand side is ready !" END IF eql$ = "" LOCATE 9, 1: PRINT " " PRINT " " NEXT ire% zz = bl% + 1 xx = br% + 1 ' GOSUB 35000: REM +++ RUNNING HEAD +++ GOSUB 24000: REM +++ SAVING +++ 20040 PRINT PRINT PRINT PRINT PRINT PRINT " End of data file creation. Goodbye !" END ' ' Routines ' 24000 REM ****************** CREATION OF DATA FILE ********************* OPEN "O", 1, FILE$ PRINT #1, TIT$ PRINT #1, USING FA$; ny; nr; NT; MODE; lis FOR i = 1 TO ny PRINT #1, formula$(i) + " "; PRINT #1, USING FB$; Y(i) NEXT i FOR g = 1 TO nr PRINT #1, " "; PRINT #1, USING FB$; P(g); IF g - ((g \ 8) * 8) = 0 THEN PRINT #1, NEXT g PRINT #1, PRINT #1, " "; PRINT #1, USING FB$; H; PRINT #1, " "; PRINT #1, USING FB$; HMAX; PRINT #1, " "; PRINT #1, USING FB$; TOL FOR MM = 1 TO NT PRINT #1, " "; PRINT #1, USING FB$; TA(MM); IF MM - ((MM \ 8) * 8) = 0 THEN PRINT #1, NEXT MM PRINT #1, FOR Z = 1 TO zz PRINT #1, USING FA$; eql%(Z); spl%(Z); PRINT #1, USING FA$; scl%(Z); PRINT #1, NEXT Z FOR X = 1 TO xx PRINT #1, USING FA$; eqr%(X); spr%(X); PRINT #1, USING FC$; scr(X) NEXT X FOR SM = 1 TO nr PRINT #1, USING "##.##"; LOGA(SM); PRINT #1, USING "###.###"; E(SM); PRINT #1, " "; NEXT SM PRINT #1, 27100 CLOSE #1 PRINT : PRINT "DATA STORED ON FILE : "; FILE$ RETURN ' 28900 REM **************** DATA INPUT ROUTINE ********************** LOCATE CSRLIN, 66: INPUT "", INTER IF INTER = 0 THEN 29300 VAR = INTER INTER = 0 29300 RETURN 29400 REM ***************** VERIFY ROUTINE ************************* 29410 PRINT : PRINT : PRINT " IS THIS SET OF DATA CORRECT (Y/N)? "; INPUT "", CP$ IF CP$ <> "Y" AND CP$ <> "y" AND CP$ <> "N" AND CP$ <> "n" THEN 29410 RETURN 35000 REM ********************** SCREEN HEADER ********************** CLS : PRINT " ************ DATAFILE CREATION FOR KINAL PROGRAM (DIFF) ************" PRINT " ------------------------------------------ " PRINT : PRINT : PRINT RETURN 36000 REM ***************** READ DATA FILE ********************** 36020 OPEN "O", #3, "SEQDIFF.DAT", 1: T = 1 OPEN "R", #1, FILE$, 1 WIDTH #3, 255 FIELD #1, 1 AS C$ 36040 GET #1, T: IF C$ <> CHR$(13) AND C$ <> CHR$(10) AND C$ <> CHR$(26) THEN PRINT #3, C$; T = T + 1: IF NOT EOF(1) THEN 36040 CLOSE 3: CLOSE 1 OPEN "R", #2, "SEQDIFF.DAT", 5 FIELD #2, 5 AS a$ k = 0: V = 0: w = 0: Q = 0: D = 0 FOR i = 1 TO 16 GET #2, i TIT$ = TIT$ + a$ NEXT i TIT$ = LEFT$(TIT$, 80) GET #2, i: ny = VAL(a$): GET #2, i + 1: nr = VAL(a$) GET #2, i + 2: NT = VAL(a$): GET #2, i + 3: MODE = VAL(a$) GET #2, i + 4: lis = VAL(a$): i = i + 5 FOR M = i TO i + 4 * (ny - 1) STEP 4 k = k + 1 GET #2, M: formula$(k) = a$: GET #2, M + 1: formula$(k) = formula$(k) + a$ formula$(k) = LEFT$(formula$(k), 8) GET #2, M + 2: Y$ = a$: GET #2, M + 3: Y$ = Y$ + a$ Y$ = RIGHT$(Y$, 8): Y(k) = VAL(Y$) NEXT M FOR g = M TO M + 2 * (nr - 1) STEP 2 D = D + 1 GET #2, g: P$ = a$: GET #2, g + 1: P$ = P$ + a$: P(D) = VAL(P$) NEXT g GET #2, g: H$ = a$: GET #2, g + 1: H$ = H$ + a$: H = VAL(H$) GET #2, g + 2: HMAX$ = a$: GET #2, g + 3: HMAX$ = HMAX$ + a$: HMAX = VAL(HMAX$) GET #2, g + 4: TOL$ = a$: GET #2, g + 5: TOL$ = TOL$ + a$: TOL = VAL(TOL$) g = g + 6 FOR Z = g TO g + 2 * (NT - 1) STEP 2 V = V + 1: GET #2, Z: TA$ = a$: GET #2, Z + 1: TA$ = TA$ + a$: TA(V) = VAL(TA$) NEXT Z 50730 w = w + 1 GET #2, Z: eql%(w) = VAL(a$) GET #2, Z + 1: spl%(w) = VAL(a$) GET #2, Z + 2: scl%(w) = VAL(a$) Z = Z + 3 IF eql%(w) <> 0 THEN 50730 zz = w 50800 Q = Q + 1 GET #2, Z: eqr%(Q) = VAL(a$) GET #2, Z + 1: spr%(Q) = VAL(a$) GET #2, Z + 2: scr(Q) = VAL(a$) Z = Z + 3 IF eqr%(Q) <> 0 THEN 50800 xx = Q w = 0 FOR SM = Z TO Z + 3 * (nr - 1) STEP 3 w = w + 1 GET #2, SM: LOGA(w) = VAL(a$) GET #2, SM + 1: EA$ = a$: GET #2, SM + 2: EA$ = EA$ + a$ E(w) = VAL(LEFT$(EA$, 7)) NEXT SM CLOSE #2 RETURN