Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Qbasic calculation

Status
Not open for further replies.

bond306

Technical User
Mar 30, 2011
4
GB
I've made this one program as shown below. This is originally from GW basic, i modified abit for the reason where i can match any gases i want as shown in line 508


1 CLEAR
2 CLS
10 REM INERT GAS RECHARGE TEMPERATURE CALCULATION PROGRAM
15 REM QBASIC
40 V = 1
60 DIM G(6, 600), T(6, 600), W(600), SD(600), E(6, 600), P(600), S(6, 600), CI(600)
70 PRINT "Is an altitude correction needed? Y or N"
80 INPUT A$
90 IF A$ = "y" OR A$ = "Y" THEN GOTO 110
100 CORR = 1: GOTO 170
110 PRINT "Input altitude of recharge (m)"
120 INPUT Alt
130 PRINT "Input Mean Annual Sea-level Air Temperature, MASAT (deg.C)"
140 INPUT Masat
150 Masat = Masat + 273.15
160 CORR = 1 * EXP(-.032 * Alt / Masat)
165 GOTO 175
170 Alt = 0: Masat = 0
175 PRINT "TYPE OF ATER - FRESH OR SALINE? ENTER F or S"
180 INPUT S$
190 IF S$ = "f" OR S$ = "F" THEN GOTO 240
200 PRINT "Input SALINITY (parts per thousand)"
210 INPUT Sal
220 LET MOL = Sal / 64.113
230 V = 0
240 GOSUB 1000

250 PRINT "Sample name?"
260 INPUT N$
270 PRINT "Sample reference number?"
280 INPUT R$
290 PRINT "Set upper charge temperature limit, deg.C"
300 INPUT Lim


330 PRINT "Enter He*1E8": G(1, 1) = 0
340 INPUT G(1, 1)
345 HEI = G(1, 1)
350 G(1, 1) = G(1, 1) * 1E-08
360 PRINT "Enter Ne*1E7": G(2, 1) = 0
370 INPUT G(2, 1)
275 NEI = G(2, 1)
380 G(2, 1) = G(2, 1) * .0000001
390 PRINT "Enter Ar*1E4": G(3, 1) = 0
400 INPUT G(3, 1)
405 ARI = G(3, 1)
410 G(3, 1) = G(3, 1) * .0001
420 PRINT "Ar correction by Ar40/Ar36 or by radiogenic He? AR or HE"
421 INPUT Q$
422 IF Q$ = "AR" OR Q$ = "ar" THEN GOTO 425
423 G(3, 1) = G(3, 1) - (.14 * RAD)
424 GOTO 450
425 PRINT "Enter Ar40/Ar36 ratio, Y or N (default N is 295.5)": Rat = 295.5
426 INPUT U$
427 IF U$ = "N" OR U$ = "n" THEN GOTO 429
428 INPUT Rat
429 G(3, 1) = G(3, 1) * 296.5 / (1 + Rat): ARCORR = G(3, 1) * 10000!
450 PRINT "Enter Kr*1E8": G(4, 1) = 0
460 INPUT G(4, 1)
465 KRI = G(4, 1)
470 G(4, 1) = G(4, 1) * 1E-08
480 PRINT "Enter Xe*1E8": G(5, 1) = 0
490 INPUT G(5, 1)
495 XEI = G(5, 1)
500 G(5, 1) = G(5, 1) * 1E-08
501 PRINT "Enter N2*1E2, ie ccSTP/ccH2O": G(6, 1) = 0
502 INPUT G(6, 1)
503 N2I = G(6, 1)
504 PRINT "Corrections to N2 (equivalent N2*1E2) - n.b. 0.0893meq NO3 equivalent to 1ml N2": N2EQ = 0
505 INPUT N2EQ
506 G(6, 1) = G(6, 1) - N2EQ
507 G(6, 1) = G(6, 1) * .01: N2CORR = G(6, 1) * 100!

508 CLS: REM CHOOSING GASES
510 PRINT "Number of gases to be matched. 2,3,4 or 5"
511 INPUT QUANT%
512 IF QUANT% = 2 THEN GOTO 518
513 IF QUANT% = 3 THEN GOTO 536
514 IF QUANT% = 4 THEN GOTO 564
515 IF QUANT% = 5 THEN GOTO 610
516 IF QUANT% = 1 THEN GOTO 510
517 IF QUANT% <> 5 THEN GOTO 510

518 PRINT "Ne = 2, Ar = 3, Kr = 4, Xe = 5, N2 = 6, 2-6"

519 PRINT "Gas 1"
520 INPUT GASA%

522 IF GASA% < 1 or GASA% > 6 THEN GOTO 519


527 PRINT "Gas 2"
528 INPUT GASB%
529 IF GASB% = GASA% THEN GOTO 527

532 IF GASB% < 1 or GASB% > 6 THEN GOTO 527
535 GOTO 610

536 PRINT "Ne = 2, Ar = 3, Kr = 4, Xe = 5, N2 = 6, 2-6"

537 PRINT "Gas 1"
538 INPUT GASA%

542 IF GASA% < 1 or GASA% > 6 THEN GOTO 537


545 PRINT "Gas 2"
546 INPUT GASB%
547 IF GASB% = GASA% THEN GOTO 545

552 IF GASB% < 1 or GASB% > 6 THEN GOTO 545


554 PRINT "Gas 3"
555 INPUT GASC%
556 IF GASC% = GASA% THEN GOTO 554
557 IF GASC% = GASB% THEN GOTO 554

562 IF GASC% < 1 or GASC% > 6 THEN GOTO 554
563 GOTO 610

564 PRINT "Ne = 2, Ar = 3, Kr = 4, Xe = 5, N2 = 6, 2-6"

565 PRINT "Gas 1"
566 INPUT GASA%

572 IF GASA% < 1 or GASA% > 6 THEN GOTO 565

573 PRINT "Gas 2"
574 INPUT GASB%
575 IF GASB% = GASA% THEN GOTO 573

581 IF GASB% < 1 or GASB% > 6 THEN GOTO 573


582 PRINT "Gas 3"
583 INPUT GASC%
584 IF GASC% = GASA% THEN GOTO 582
585 IF GASC% = GASB% THEN GOTO 582

591 IF GASC% < 1 or GASC% > 6 THEN GOTO 582


592 PRINT "Gas 4"
593 INPUT GASD%
594 IF GASD% = GASA% THEN GOTO 592
595 IF GASD% = GASB% THEN GOTO 592
596 IF GASD% = GASC% THEN GOTO 592

602 IF GASD% < 1 or GASD% > 6 THEN GOTO 592
603 GOTO 610

610 Ne = G(2, 1): Ar = G(3, 1): KR = G(4, 1): XE = G(5, 1): N2 = G(6, 1): HE = G(1, 1)
611 IF G(2, 1) <> 0 THEN GOTO 621
612 IF G(3, 1) < .0004997 GOTO 629: REM based on Ar:REM large bubble based on Ar
613 CC = G(3, 1) - .0004997
614 G(3, 1) = G(3, 1) - CC
615 G(1, 1) = G(1, 1) - .000560920779# * CC
616 G(2, 1) = G(2, 1) - .001946466809# * CC
617 G(4, 1) = G(4, 1) - .0001219486081# * CC
618 G(5, 1) = G(5, 1) - .000009207708779# * CC
619 G(6, 1) = G(6, 1) - 83.54389722000001# * CC
620 GOTO 629
621 IF G(2, 1) < 2.295E-07 THEN GOTO 629: REM large bubble based on Ne
622 CC = G(2, 1) - 2.295E-07
623 G(2, 1) = G(2, 1) - CC
624 G(1, 1) = G(1, 1) - .2881738174# * CC
625 G(3, 1) = G(3, 1) - 513.7514 * CC
626 G(4, 1) = G(4, 1) - .062651265# * CC
627 G(5, 1) = G(5, 1) - .0047830473# * CC
628 G(6, 1) = G(6, 1) - 4290.79208# * CC

629 J = 2
630 G(3, J) = G(3, J - 1): G(4, J) = G(4, J - 1)
631 G(1, J) = G(1, J - 1): G(2, J) = G(2, J - 1)
632 G(3, J) = G(3, J - 1): G(4, 1) = G(4, J - 1)
633 G(5, J) = G(5, J - 1): G(6, J) = G(6, J - 1)
640 GOSUB 700
641 GOSUB 800
642 FOR J = 3 TO 600
643 G(1, J) = G(1, J - 1) - 1.8010864D-10: REM small air bubble in air ratios
644 G(2, J) = G(2, J - 1) - 6.25E-10
645 G(3, J) = G(3, J - 1) - 3.211E-07
646 G(4, J) = G(4, J - 1) - 3.9157044D-11
647 G(5, J) = G(5, J - 1) - 2.956544E-12
648 G(6, J) = G(6, J - 1) - .000026825495#
649 CI(J) = (NEI * .0000001) / G(2, J)
652 GOSUB 700
653 GOSUB 800
654 IF J > MI + 10 THEN GOTO 3000
655 NEXT J

700 REM SUBROUTINE TO COMPARE G(K,J) WITH S(K,J) TO FIND CORRESPONDING T(K,J)
710 FOR K = 2 TO 6
720 FOR I = 1 TO 600
730 T(K, J) = P(I) - 273.18
740 IF G(K, J) < S(K, I) THEN GOTO 760
750 IF G(K, J) > S(K, I) THEN GOTO 770
760 NEXT I
770 NEXT K
780 RETURN

800 REM SUBROUTINE TO CALCULATE MEAN RECAHRGE TEMPERATURE AND STANDARD DEVIATION (SD)
801 IF QUANT% = 2 THEN SD(J) = T(GASA%, J) + T(GASB%, J): SD(J) = SD(J) / 2: GOTO 810
802 IF QUANT% = 3 THEN SD(J) = T(GASA%, J) + T(GASB%, J) + T(GASC%, J): SD(J) = SD(J) / 3: GOTO 810
803 IF QUANT% = 4 THEN SD(J) = T(GASA%, J) + T(GASB%, J) + T(GASC%, J) + T(GASD%, J): SD(J) = SD(J) / 4: GOTO 810
804 IF QUANT% = 5 THEN SD(J) = T(2, J) + T(3, J) + T(4, J) + T(5, J) + T(6, J): SD(J) = SD(J) / 5: GOTO 810

810 FOR I = 1 TO 6
811 D(I) = (T(I, J) - SD(J)) * (T(I, J) - SD(J))
812 NEXT I

820 IF QUANT% = 2 THEN DI = D(GASA%) + D(GASB%): W(J) = SQR(DI): GOTO 860
821 IF QUANT% = 3 THEN DI = D(GASA%) + D(GASB%) + D(GASC%): W(J) = SQR(DI / 2): GOTO 860
822 IF QUANT% = 4 THEN DI = D(GASA%) + D(GASB%) + D(GASC%) + D(GASD%): W(J) = SQR(DI / 3): GOTO 860
823 IF QUANT% = 5 THEN DI = D(2) + D(3) + D(4) + D(5) + D(6): W(J) = SQR(DI / 4): GOTO 860

860 IF J = 2 THEN GOTO 880
870 IF W(J) > LSD THEN GOTO 900
880 LSD = W(J)
890 MI = J
900 RETURN

1000 REM CACLCULATE Ne, Ar, Kr, Xe Solubilities in 0.1 deg. intervals from -10 to 50 deg.C
1010 X = 263.08: Y = 36.855: Z = 1244.142
1020 FOR K = 2 TO 6
1030 READ H(K), L(K), N(K), A(K), B(K), C(K), D(K)
1040 NEXT K
1050 DATA 142.50,41.667,1.818E-5,-0.3022,3.6278,-13.6641,16.8309
1060 DATA 168.87,40.404,9.34E-3,-0.4050,3.8471,-12.3389,13.6921
1070 DATA 179.21,39.781,1.139E-6,-0.1124,1.3282,-5.1423,6.8403
1080 DATA 188.78,39.273,8.60E-8,-0.1611,1.9007,-7.3019,9.5072
1081 DATA 162.02,41.712,0.7803,-0.2427,2.1504,-6.6100,7.4294
1090 FOR K = 2 TO 6
1100 Q = X
1110 FOR I = 1 TO 600
1120 Q = Q + .1
1130 P(I) = Q
1140 TE = H(K) / P(I) - 1
1150 S(K, I) = L(K) * TE + Y * TE * TE
1160 S(K, I) = EXP(S(K, I))
1170 S(K, I) = S(K, I) * N(K) * Z
1180 IF V = 0 THEN GOSUB 2000
1185 S(K, I) = S(K, I) * PP
1190 S(K, I) = S(K, I) * CORR
1200 NEXT I: NEXT K
1210 RETURN

2000 REM SUBROUTINE TO MODIFY SOLUBILITIES FOR SALINE RECHARGE WATER
2010 VIN = P(I) / 100
2020 XY = A(K) * VIN * VIN * VIN + B(K) * VIN * VIN + C(K) * VIN + D(K)
2030 S(K, I) = S(K, I) / EXP(MOL / XY)
2040 RETURN

3000 REM SUBROUTINE TO PRINT TITLES AND INITIAL GAS CONTENTS
3010 CLS
3030 PRINT "RECHARGE TEMPERATURE CALCULATION"
3050 PRINT "SAMPLE NAME:"; N$
3060 PRINT "SAMPLE REF. NO.:"; R$
3070 PRINT "Ar-40/Ar-36 RATIO ="; Rat
3080 PRINT "UPPER RECHARGE LIMIT ="; Lim
3090 IF V = 1 THEN GOTO 3110
3100 PRINT "SALINITY (ppt)="; Sal
3110 PRINT "ALTITUDE OF RECHARGE ZONE (m)="; Alt
3112 PRINT "MEAN ANNUAL SEA-LEVEL TEMP. OVER RECHARGE ZONE ="; Masat
3113 J = MI
3114 IF J <= 1 THEN GOTO 6000
3160 GOSUB 4000
3161 PRINT "He(i,E-8)="; HEI; "He(f,E-8)="; E(1, J); "Ne(i,E-7)="; NEI; "Ne(f,E-7)="; E(2, J)
3162 PRINT "Ar(i,E-4)="; ARI; "Ar(f,E-4)="; E(3, J)
3163 PRINT "Kr(i,E-8)="; KRI; "Kr(f,E-8)="; E(4, J); "Xe(i,E-8)="; XEI; "Xe(f,E-8)="; E(5, J)
3164 PRINT "N2(i,E-2)="; N2I; "N2(f,E-2)="; E(6, J)
3165 PRINT "T(He)="; T(1, J); "T(Ne)="; T(2, J); "T(Ar)="; T(3, J)
3166 PRINT "T(Kr)="; T(4, J); "T(Xe)="; T(5, J); "T(N2)="; T(6, J)
3167 PRINT "J="; J; "T AVG="; SD(J); "T SD="; W(J); "CI(Ne)="; CI(J)

3170 PRINT "ANOTHER CALCULATION ON SAME DATA (Y OR N)": INPUT C$
3171 IF C$ = "N" OR C$ = "n" THEN GOTO 3200
3172 REM G(1, 1) = HEI * E - 8: G(2, 1) = NEI * E - 7: G(3, 1) = ARI * E - 4: G(4, 1) = KRI * E - 8: G(5, 1) = XEI * E - 8: G(6, 1) = N2I * E - 2
3173 GOTO 508

3200 PRINT
3210 PRINT "NEW SAMPLE (Y OR N)": INPUT D$
3220 IF D$ = "Y" OR D$ = "y" THEN GOTO 1
3230 END


4000 REM SUBROUTINE TO MULTIPLY UP GAS CONTENTS FOR PRINTING
4010 E(1, J) = G(1, J) * 1E+08
4020 E(2, J) = G(2, J) * 1E+07
4030 E(3, J) = G(3, J) * 10000!
4040 E(4, J) = G(4, J) * 1E+08
4050 E(5, J) = G(5, J) * 1E+08
4051 E(6, J) = G(6, J) * 100!
4060 RETURN


6000 REM SUBROUTINE TO PRINT OUT FULL DATASET
6070 LET J = 2
6080 GOSUB 4000
6081 PRINT "He(i,E-8)="; HEI; "He(f,E-8)="; E(1, J); "Ne(i,E-7)="; NEI; "Ne(f,E-7)="; E(2, J)
6082 PRINT "Ar(i,E-4)="; ARI; "Ar(f,E-4)="; E(3, J)
6083 PRINT "Kr(i,E-8)="; KRI; "Kr(f,E-8)="; E(4, J); "Xe(i,E-8)="; XEI; "Xe(f,E-8)="; E(5, J)
6084 PRINT "N2(i,E-2)="; N2I; "N2(f,E-2)="; E(6, J)
6085 PRINT "T(He)="; T(1, J); "T(Ne)="; T(2, J); "T(Ar)="; T(3, J)
6086 PRINT "T(Kr)="; T(4, J); "T(Xe)="; T(5, J); "T(N2)="; T(6, J)
6087 PRINT "J="; J; "T AVG="; SD(J); "T SD="; W(J); "CI(Ne)="; CI(J)

6090 PRINT "ANOTHER CALCULATION ON SAME DATA (Y OR N)": INPUT C$
6091 IF C$ = "N" OR C$ = "n" THEN GOTO 7000
6092 REM G(1, 1) = HEI * E - 8: G(2, 1) = NEI * E - 7: G(3, 1) = ARI * E - 4: G(4, 1) = KRI * E - 8: G(5, 1) = XEI * E - 8: G(6, 1) = N2I * E - 2
6093 GOTO 508

7000 PRINT
7001 PRINT "NEW SAMPLE (Y OR N)": INPUT D$
7002 IF D$ = "Y" OR D$ = "y" THEN GOTO 1
7003 END

7050 J = MI
7060 T = T(3, J) + 273.15
7070 L = 41.667 * (142.5 / T - 1) + 36.855 * (142.5 / T - 1) * (142.5 / T - 1)
7080 K = EXP(L)
7090 S = 124.4142 * 1.818 * .00001 * K * 10
8000 S = S * CORR
8010 IF V = 0 GOTO 8097
8020 Z = T / 100
8030 KS = -.3022 * Z * Z * Z + 3.6278 * Z * Z - 13.6641 * Z + 16.8309
8095 S = S / EXP(MOL * KS)
8097 CI = NEI / (S * 1E+07)
8100 PRINT "J="; J, "Ne="; S, "CI(Ar)="; CI;
8120 RETURN

But my problem is, i ran this program, it does not calculate well as it supposed to run in GW basic. Then i've checked it may be this part (below)

1000 REM CACLCULATE Ne, Ar, Kr, Xe Solubilities in 0.1 deg. intervals from -10 to 50 deg.C
1010 X = 263.08: Y = 36.855: Z = 1244.142
1020 FOR K = 2 TO 6
1030 READ H(K), L(K), N(K), A(K), B(K), C(K), D(K)
1040 NEXT K
1050 DATA 142.50,41.667,1.818E-5,-0.3022,3.6278,-13.6641,16.8309
1060 DATA 168.87,40.404,9.34E-3,-0.4050,3.8471,-12.3389,13.6921
1070 DATA 179.21,39.781,1.139E-6,-0.1124,1.3282,-5.1423,6.8403
1080 DATA 188.78,39.273,8.60E-8,-0.1611,1.9007,-7.3019,9.5072
1081 DATA 162.02,41.712,0.7803,-0.2427,2.1504,-6.6100,7.4294
1090 FOR K = 2 TO 6
1100 Q = X
1110 FOR I = 1 TO 600
1120 Q = Q + .1
1130 P(I) = Q
1140 TE = H(K) / P(I) - 1
1150 S(K, I) = L(K) * TE + Y * TE * TE
1160 S(K, I) = EXP(S(K, I))
1170 S(K, I) = S(K, I) * N(K) * Z
1180 IF V = 0 THEN GOSUB 2000
1185 S(K, I) = S(K, I) * PP
1190 S(K, I) = S(K, I) * CORR
1200 NEXT I: NEXT K
1210 RETURN

2000 REM SUBROUTINE TO MODIFY SOLUBILITIES FOR SALINE RECHARGE WATER
2010 VIN = P(I) / 100
2020 XY = A(K) * VIN * VIN * VIN + B(K) * VIN * VIN + C(K) * VIN + D(K)
2030 S(K, I) = S(K, I) / EXP(MOL / XY)
2040 RETURN

and maybe this part (below)

610 Ne = G(2, 1): Ar = G(3, 1): KR = G(4, 1): XE = G(5, 1): N2 = G(6, 1): HE = G(1, 1)
611 IF G(2, 1) <> 0 THEN GOTO 621
612 IF G(3, 1) < .0004997 GOTO 629: REM based on Ar:REM large bubble based on Ar
613 CC = G(3, 1) - .0004997
614 G(3, 1) = G(3, 1) - CC
615 G(1, 1) = G(1, 1) - .000560920779# * CC
616 G(2, 1) = G(2, 1) - .001946466809# * CC
617 G(4, 1) = G(4, 1) - .0001219486081# * CC
618 G(5, 1) = G(5, 1) - .000009207708779# * CC
619 G(6, 1) = G(6, 1) - 83.54389722000001# * CC
620 GOTO 629
621 IF G(2, 1) < 2.295E-07 THEN GOTO 629: REM large bubble based on Ne
622 CC = G(2, 1) - 2.295E-07
623 G(2, 1) = G(2, 1) - CC
624 G(1, 1) = G(1, 1) - .2881738174# * CC
625 G(3, 1) = G(3, 1) - 513.7514 * CC
626 G(4, 1) = G(4, 1) - .062651265# * CC
627 G(5, 1) = G(5, 1) - .0047830473# * CC
628 G(6, 1) = G(6, 1) - 4290.79208# * CC

629 J = 2
630 G(3, J) = G(3, J - 1): G(4, J) = G(4, J - 1)
631 G(1, J) = G(1, J - 1): G(2, J) = G(2, J - 1)
632 G(3, J) = G(3, J - 1): G(4, 1) = G(4, J - 1)
633 G(5, J) = G(5, J - 1): G(6, J) = G(6, J - 1)
640 GOSUB 700
641 GOSUB 800
642 FOR J = 3 TO 600
643 G(1, J) = G(1, J - 1) - 1.8010864D-10: REM small air bubble in air ratios
644 G(2, J) = G(2, J - 1) - 6.25E-10
645 G(3, J) = G(3, J - 1) - 3.211E-07
646 G(4, J) = G(4, J - 1) - 3.9157044D-11
647 G(5, J) = G(5, J - 1) - 2.956544E-12
648 G(6, J) = G(6, J - 1) - .000026825495#
649 CI(J) = (NEI * .0000001) / G(2, J)
652 GOSUB 700
653 GOSUB 800
654 IF J > MI + 10 THEN GOTO 3000
655 NEXT J

doesn't calculate as it is supposed to. but this part i totally just copied from the originally GW basic program. can anybody tell me what is wrong with it? Thank tou very much
 
The code you posted is difficult to read (GW Basic code is). Can you specify the calculation you are trying to do? It will REALLY help us help you.

-Geates

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live."
- Martin Golding

"There are seldom good technological solutions to behavioral problems."
- Ed Crowley, Exchange guru and technology curmudgeon
 
ouh... ahaha i figured that much, i mean difficult... anyway, before i ask more about the calculation what does # and ! mean???
 
type definition

# = double percision (15 decimals)
Pi# = 3.141592653589793

! = single percision (7 decimals)
Pi! = 3.1415926

-Geates


"I hope I can feel and see the change - stop the bleed inside a feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer
 
ouh thanks =D... so this program runs when im running it, but it gives the same value when i enter different data... gaaah... i dont know why... all i did was copying almost all of the gw basic code into this and modify abit...
 
all i did was copying almost all of the gw basic code into this and modify abit...
Have you tried running the unaltered code?

The answer is "42"
 
yea ive tried but it keeps pn saying subscript out of range... btw i got this working already =D apparently i missed something...

anyway if u could help, what does lsd stand for here? is it just a variable or is it something specified such as least significant digit???
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top