10 '
20 '***** normative calculation program for clay minerals ****x by T.Igarashi.1983
30 '
40 OPTION BASE 1
50 CONSOLE 0,25,0,1
60 'WIDTH 40,25
70 '
80 '
90 DIM A$(22),DMY$(22),AA$(22),B1$(31),M$(8),L$(8)
100 DIM A(8,22),A1(22),A2(22),B(31),B0(8,31),C9(31),TOTAL(2,8)
110 GOSUB *INIT.1
120 ON ERROR GOTO 5000
130 GOSUB *ENTER
140 FOR QQ=1 TO NN
150 GOSUB *INIT.2
160 IF KORF=1 THEN GOSUB *FILE ELSE GOSUB *KEYBOARD
170 GOSUB *STORE
180 GOSUB *CALC
190 GOSUB *OUTPUT
200 NEXT QQ
210 'GOSUB *PRINTOUT
220 GOTO 130
230 '
240 '
250 '
260 *INIT.1
270 RESTORE 290
280 FOR I=1 TO 22 : READ AA$(I) : READ A2(I) : NEXT
290 DATA SiO2,60.085,TiO2,79.899,Al2O3,101.961,Fe2O3,159.692,FeO,71.846,MnO,70.937,MgO,40.304,CaO,56.079,Na2O,61.979,K2O,94.195
300 DATA P2O5,141.943,Cl,35.453,SO3,80.57,S,32.6,Cr2O3,151.989,ZrO2,123.218,F,18.99,CO2,44.9,H2O+,18,H2O-,1,Ig.loss,1,Others,1
310 RESTORE 330
320 FOR I=1 TO 31 : READ B1$(I) : NEXT
330 DATA Q,C,ad,mi,ab,an,ka,se,ch,gi,mo,pp,dp,al,Z,hl,th,cc,mg,sd,li,mt,he,cm,pr,il,ru,ap,fr,en,ot
340 C9(1)=A2(1) : C9(2)=A2(3) : C9(3)=A2(1)+A2(3) : C9(4)=A2(10)+A2(3)+A2(1)*6 : C9(5)=A2(9)+A2(3)+A2(1)*6 : C9(6)=A2(8)+A2(3)+A2(1)*2 : C9(7)=A2(3)+A2(1)*2+A2(19)*2
350 C9(8)=A2(10)+A2(3)*3+A2(1)*6+A2(19)*2 : C9(9)=A2(7)*5+A2(3)+A2(1)*3+A2(19)*4 : C9(10)=A2(3)+A2(19)*3 : C9(11)=A2(9)*0.33+A2(3)+A2(7)+A2(1)*4+A2(19)*4 : C9(12)=A2(3)+A2(1)*4+A2(19)
360 C9(13)=A2(3)+A2(19) : C9(14)=A2(10)+A2(3)*3+A2(13)*4+A2(19)*6 : C9(15)=A2(1)+A2(16) : C9(16)=(A2(9)-16)/2+A2(12) : C9(17)=A2(9)+A2(13) : C9(18)=A2(8)+A2(18) : C9(19)=A2(7)+A2(18) : C9(20)=A2(5)+A2(18)
370 C9(21)=A2(4)+A2(19) : C9(22)=A2(4)+A2(5) : C9(23)=A2(4) : C9(24)=A2(5)+A2(15) : C9(25)=A2(5)-16+A2(14)*2 : C9(26)=A2(2)+A2(5) : C9(27)=A2(2) : C9(28)=A2(8)*10+A2(11)*3+A2(19)
380 C9(29)=A2(8)-A2(17)*2 : C9(30)=A2(1)+A2(7) : C9(31)=1 : DD=0
390 FOR I=1 TO 31 : B(I)=0 : NEXT
400 RETURN
410 '
420 '
430 '
440 *ENTER
450 C=0 : KORF=0 : SCREEN 3,3 : CLS 3 : SCREEN 3,0 : LINE(0,0)-(639,199),6,BF : COLOR 2
460 LOCATE 0,5 : PRINT "How many samples (Max 8 samples)";: INPUT NN
470 IF NN>8 THEN CLS 1 : GOTO 460
480 IF NN=8 THEN GOTO *PROEND
490 COLOR 2 : LOCATE 0,8 : PRINT "Input data from Keyboard or File or End : K/F/E"
500 Y$=INKEY$
510 IF Y$="" THEN 490
520 IF Y$="e" OR Y$="E" THEN GOTO *PROEND
530 IF Y$="k" OR Y$="K" THEN KORF=0 : RETURN
540 IF Y$<>"f" AND Y$<>"F" THEN 490
550 KORF=1
560 RETURN
570 '
580 '
590 '
600 *INIT.2
610 CLS 1
620 FOR I=1 TO 22 : A(QQ,I)=0 : NEXT I
630 FOR I=1 TO 31 : B(I)=0 : B0(QQ,I)=0 : NEXT I
640 RETURN
650 '
660 '
670 '
680 *FILE
690 OPEN "data.1" AS #1
700 FIELD #1,40 AS MINERAL$,40 AS LI$
710 FOR I=1 TO 22 : FIELD #I,(I-1)*4+80 AS DMY$(I),4 AS A$(I) : NEXT
720 MAX=LOF(1) : IF MAX=0 THEN RETURN 440
730 LOCATE 1,2 : PRINT MAX;"records are filing."
740 IF DD=1 THEN 800
750 LOCATE 2,5 : PRINT "You need list (Y/N)?": Y$=INKEY$
760 IF Y$="" THEN 750
770 IF Y$= "N" OR Y$="n" THEN 800
780 IF Y$="Y" OR Y$="y" THEN GOSUB *NAME.LIST : GOTO 800
790 GOTO 750
800 LOCATE 2,10 : INPUT "Record No.";N
810 IF N>MAX THEN CLS 1 : GOTO 730
820 GET #1,N
830 M$=MINERAL$ : L$=L1$
840 FOR I=1 TO 11 : A(QQ,I)=CVS(A$(I)) : A(QQ,I+11)=CVS(A$(I+11)) : NEXT
850 CLOSE #1 : DD=1
860 LOCATE 2,15 : PRINT "Correct data : Y/N"; : Y$=INKEY$
870 IF Y$=" " THEN 860 '
880 IF Y$="Y" OR Y$="y" THEN C=1 : GOTO 1120
890 IF Y$="N" OR Y$="n" THEN RETURN 180
900 GOTO 860
910 '
920 '
930 '
940 *NAME.LIST
950 LPRINT
960 LPRINT CHR$(27);"V0960";CHR$(&H8)
970 LPRINT "Sample Name"; TAB(40); "Locality"
980 LPRINT CHR$(27);"V0960";CHR$(&H8)
990 FOR II=1 TO MAX
1000 GET #1,II
1010 M$=MINERAL$ : L$=L1$
1020 LPRINT M$; TAB(40); L$
1030 NEXT
1040 LPRINT CHR$(27);"V0960";CHR$(&H8)
1050 LPRINT CHR$(12)
1060 RETURN
1070 '
1080 '
1090 '
1100 *KEYBOARD
1110 M$="" : L$="" : FOR I=1 TO 22 : A(QQ,I)=0 : NEXT I
1120 SCREEN 3,3 : CLS 3 : SCREEN 3,0 : LINE(0,0)-(639,79),5,BF
1130 'WIDTH 80,25 : COLOR 2
1135 COLOR 2
1140 LOCATE 2,1 : PRINT "Sample Name :";M$ ;: INPUT MM$
1150 IF LEN(MM$)>0 THEN M$=MM$
1160 LOCATE 2,3 : PRINT "Locality :";L$ ;: INPUT LL$
1170 IF LEN(LL$)>0 THEN L$=LL$
1180 LINE(0,80)-(639,279),6,BF
1190 COLOR 1
1200 SUM=0 : FOR I=1 TO 22
1210 IF A(QQ,I)=0 THEN CH$="" ELSE CH$=STR$(A(QQ,I))
1220 IF I<12 THEN LOCATE 2,I+5 ELSE LOCATE 42,I-6
1230 PRINT USING "&    &";AA$(I);: PRINT " = ";CH$;: INPUT CHEM$
1240 IF CHEM$<>"" THEN A(QQ,I)=VAL(CHEM$)
1250 SUM=SUM+A(QQ,I)
1260 NEXT
1270 LINE(0,280)-(639,399),7,BF
1280 COLOR 1
1290 LOCATE 5,18 : PRINT "Total = ";SUM
1300 LOCATE 2,21 : PRINT "Is there any mistake ":Y$=INKEY$
1310 IF Y$="" THEN 1300
1320 'IF Y$="n" OR Y$="N" THEN WIDTH 40,25 : RETURN
1325 IF Y$="n" OR Y$="N" THEN RETURN
1330 IF Y$="y" OR Y$="Y" THEN *CORRECT
1340 GOTO 1300
1350 '
1360 '
1370 '
1380 *CORRECT
1390 GOTO 1120
1400 *STORE
1410 CLS 1
1420 LOCATE 2,2 : PRINT "Store data : Y/N":Y$=INKEY$
1430 IF Y$="" THEN 1420
1440 IF Y$="N" OR Y$="n" THEN RETURN
1450 IF Y$<>"Y" AND Y$<>"y" THEN 1420
1460 OPEN "data.1" AS #1
1470 FIELD #1,40 AS MINERAL$,40 AS L1$
1480 FOR I=1 TO 22 : FIELD #1,(I-1)*4+80 AS DMY$,4 AS A$(I) : NEXT
1490 LSET MINERAL$=M$ : LSET L1$=L$
1500 FOR I=1 TO 11 ; LSET A$(I)=MKS$(A(QQ,I)) ; LSET A$(I+11)=MKS$(A(QQ,I+11)) ; NEXT
1510 IF C=0 THEN N=LOF(1)+1
1520 PUT #1,N
1530 CLOSE #1 : C=0
1540 RETURN
1550 '
1560 '
1570 '
1580 *CALC
1590 GOSUB *PRECALC
1600 GOSUB *HALITE
1610 GOSUB *ALUNITE
1620 GOSUB *THERNARDITE
1630 GOSUB *APATITE
1640 GOSUB *PYRITE
1650 GOSUB *CHROMITE
1660 GOSUB *ILMENITE
1670 GOSUB *FLUORITE
1680 GOSUB *ZIRCON
1690 GOSUB *CALCITE
1700 GOSUB *SERICITE
1710 GOSUB *CHLORITE
1720 GOSUB *MONTMOLL
1730 GOSUB *MICROCLINE
1740 GOSUB *ALBITE
1750 GOSUB *ANORTHITE
1760 GOSUB *PYROPHYLLITE
1770 GOSUB *KAOLINE
1780 GOSUB *ENSTATITE
1790 GOSUB *GIBBSITE
1800 GOSUB *DIASPORE
1810 GOSUB *CORUNDUM
1820 GOSUB *ANDALUSITE
1830 GOSUB *MAGNETITE
1840 GOSUB *OTHERS
1850 RETURN
1860 '
1870 '
1880 '
1890 *PRECALC
1900 SCREEN,3,3 : CLS 3 : SCREEN,3,0 : LINE(0,0)-(639,199),7,BF
1910 COLOR 3 : LOCATE 1,1 : PRINT "Condition by x-ray diffraction."
1920 K1=0 : K2=0 : K3=0 : K4=0
1930 LOCATE 2,3 : PRINT "Pyrophyllite : Y/N"
1940 Y$=INKEY$
1950 IF Y$="" THEN 1940
1960 IF Y$="Y" OR Y$="y" THEN K1=1 : K4=1 : GOTO 2010
1970 LOCATE 2,5 : PRINT "Sericite : Y/N"
1980 Y$=INKEY$
1990 IF Y$="" THEN 1980
2000 IF Y$="Y" OR Y$="y" THEN K1=1
2010 LOCATE 2,7 : PRINT "Chlorite/Montmorillonite/none :" : LOCATE 2,8 : PRINT "C/M/N"
2020 Y$=INKEY$
2030 IF Y$="" THEN 2020
2040 IF Y$="C" OR Y$="c" THEN K2=1
2050 IF Y$="M" OR Y$="m" THEN K2=2
2060 LOCATE 2,10 : PRINT "Calcite : Y/N"
2070 Y$=INKEY$
2080 IF Y$="" THEN 2070
2090 IF Y$="Y" OR Y$="y" THEN K3=1
2100 FOR I=1 TO 19 : A1(I)=A(QQ,I)/A2(I) : NEXT
2110 F5=A(QQ,5)+A(QQ,6) : IF F5>0 THEN A2(5)=A(QQ,5)/F5*A2(5)+A(QQ,6)/F5*A2(6) : A1(5)=F5/A2(5) : A1(6)=0
2120 IF A(QQ,19)=0 AND A(QQ,21)>0 THEN A1(19)=A2(21)/A2(19)
2130 RETURN
2140 '
2150 '
2160 *HALITE
2170 IF A1(12)=0 THEN RETURN
2180 B(16)=A1(12)/2 : A1(9)=A1(9)-B(16) : A1(12)=0 : RETURN
2190 '
2200 '
2210 *ALUNITE
2220 IF A1(13)=0 THEN RETURN
2230 B(14)=A1(13)/4 : A1(10)=A1(10)-B(14) : A1(3)=A1(3)-B(14)*3 : A1(19)=A1(19)-B(14)*6 : RETURN
2240 '
2250 '
2260 *THERNARDITE
2270 IF A1(13)=0 THEN RETURN
2280 B(17)=A1(13)/4 : A1(9)=A1(9)-A1(13) : A1(13)=0 : RETURN
2290 '
2300 '
2310 *APATITE
2320 IF A1(11)=0 OR A1(8)=0 THEN RETURN
2330 IF A1(8)/10<A1(11)/3 THEN 2350
2340 B(28)=A1(11)/3 : A1(8)=A1(8)-B(28)*10 : A1(11)=0 : GOTO 2360
2350 B(28)=A1(8)/10 : A1(11)=A1(11)-B(28)*3 : A1(8)=0
2360 A1(19)=A1(19)-B(28) : RETURN
2370 '
2380 '
2390 *PYRITE
2400 IF A1(5)=0 OR A1(14)=0 THEN RETURN
2410 IF A1(5)<A1(14)/2 THEN B(25)=A1(5) : A1(14)=A1(14)-B(25)*2 : A1(5)=0 : RETURN
2420 B(25)=A1(14)/2 : A1(5)=A1(5)-B(25) : A1(14)=0 : RETURN
2430 '
2440 '
2450 *CHROMITE
2460 IF A1(15)=0 THEN RETURN
2470 B(24)=A1(15) : A1(5)=A1(5)-A1(15) : A1(15)=0 : RETURN
2480 '
2490 '
2500 *ILMENITE
2510 IF A1(2)=0 THEN 2560
2520 IF A1(2)>A1(5) THEN 2540
2530 B(26)=A1(2) : A1(5)=A1(5)-B(26) :GOTO 2560
2540 IF A1(5)=0 THEN B(27)=A1(2) : GOTO 2560
2550 B(26)=A1(5) : B(27)=A1(2)-B(26) : A1(5)=0
2560 A1(2)=0 : RETURN
2570 '
2580 '
2590 *FLUORITE
2600 IF A1(17)=0 THEN RETURN
2610 B(29)=A1(17)/2 : A1(8)=A1(8)-B(29) : A1(17)=0 : RETURN
2620 '
2630 '
2640 *ZIRCON
2650 IF A1(16)=0 THEN RETURN
2660 B(15)=A1(16) : A1(1)=A1(1)-B(15) : A1(16)=0 : RETURN
2670 '
2680 '
2690 *CALCITE
2700 IF A1(18)=0 THEN 2730
2710 IF A1(8)<A1(18) THEN 2770
2720 B(18)=A1(8) : A1(8)=A1(8)-B(18) : A1(18)=0
2730 IF K3=0 THEN RETURN
2740 IF A1(21)=0 THEN RETURN
2750 A1(18)=A1(19)/A2(18) : B(18)=B(18)+A1(8) : A1(18)=A1(18)-A1(8) : A1(8)=0
2760 A1(19)=A1(18)*A2(18)/A2(19) : GOTO 2840
2770 B(18)=A1(8) : A1(18)=A1(18)-A1(8) : A1(8)=0
2780 IF A1(5)=0 THEN RETURN
2790 IF A1(18)>A1(5) THEN 2820
2800 B(20)=A1(18) : A1(5)-B(20) : GOTO 2840
2810 B(20)=A1(5) : A1(18)=A1(18)-B(20) : A1(5)=0
2820 IF A1(18)>A1(7) THEN 2850
2830 B(19)=A1(18) : A1(7)=A1(7)-B(19)
2840 A1(18)=0 : RETURN
2850 B(19)=A1(7) : A1(18)=A1(18)-B(19) : A1(7)=0 : RETURN
2860 '
2870 '
2880 *MICROCLINE
2890 IF A1(1)=0 OR A1(3)=0 OR A1(10)=0 THEN RETURN
2900 B(4)=A1(10) : A1(3)=A1(3)-B(4) : A1(1)=A1(1)-B(4)*6 : A1(10)=0 : RETURN
2910 '
2920 '
2930 *SERICITE
2940 IF K1=0 OR A1(1)=0 OR A1(3)=0 OR A1(10)=0 OR A1(19)=0 THEN RETURN
2950 IF A1(10)>A1(19)/2 THEN 2970
2960 B(8)=A1(10) : A1(10)=0 : A1(19)=A1(19)-B(8)*2 : GOTO 2980
2970 B(8)=A1(19)/2 : A1(19)=0 : A1(10)=A1(10)-B(8)
2980 A1(1)=A1(1)-B(8)*6 : A1(3)=A1(3)-B(8)*3 : RETURN
2990 '
3000 '
3010 *CHLORITE
3020 IF K2<>1 OR A1(7)=0 OR A1(19)=0 THEN RETURN
3030 IF A1(7)/5>A1(19)/4 THEN 3050
3040 B(9)=A1(7)/5 : A1(7)=0 : A1(19)=A1(19)-B(9)*4 : GOTO 3060
3050 B(9)=A1(19)/4 : A1(19)=0 : A1(7)=A1(7)-B(9)*5
3060 A1(3)=A1(3)-B(9) : A1(1)=A1(1)-B(9)*3 : RETURN
3070 '
3080 '
3090 *MONTMOLL
3100 IF K2<>2 OR A1(7)=0 OR A1(9)=0 OR A1(19)=0 THEN RETURN
3110 IF A1(9)<A1(7)/3 THEN 3170
3120 IF A1(19)<A1(7)*4 THEN 3140
3130 B(11)=A1(7) : A1(7)=0 : A1(19)=A1(19)-B(11)*4 : GOTO 3150
3140 B(11)=A1(19)/4 : A1(7)=A1(7)-B(11) : A1(19)=0
3150 A1(9)=A1(9)-B(11)/3
3160 A1(1)=A1(1)-B(11)*4 : A1(3)=A1(3)-B(11) : RETURN
3170 IF A1(19)<A1(9)*12 THEN 3190
3180 B(11)=A1(9)*3 : A1(7)=A1(7)-B(11) : A1(9)=0 : A1(19)=A1(19)-B(11)*4 : GOTO 3160
3190 B(11)=A1(19)/4 : A1(3)=A1(3)-B(11) : A1(7)=A1(7)-B(11) : A1(9)=A1(9)-B(11)/3 : A1(19)=0
3200 RETURN
3210 '
3220 '
3230 *ALBITE
3240 IF A1(1)=0 OR A1(3)=0 OR A1(9)=0 THEN RETURN
3250 B(5)=A1(9) : A1(3)=A1(3)-B(5) : A1(1)=A1(1)-B(5)*6 : A1(9)=0 : RETURN
3260 '
3270 '
3280 *ANORTHITE
3290 IF A1(1)/2>A1(3) OR A1(1)/2>A1(8) THEN 3310
3300 B(6)=A1(1)/2 : A1(3)=A1(3)-B(6) : A1(8)=A1(8)-B(6) : A1(1)=0 : RETURN
3310 IF A1(3)>A1(8) THEN B(6)=A1(8) : A1(3)=A1(3)-B(6) : A1(1)=A1(1)-B(6)*2 : A1(8)=0 : RETURN
3320 B(6)=A1(3) : A1(1)=A1(1)-B(6)*2 : A1(8)=A1(8)-B(6) : A1(3)=0 : RETURN
3330 '
3340 '
3350 *PYROPHYLLITE
3360 IF K4=0 OR A1(1)=0 THEN RETURN
3370 IF A1(3)>A1(1)/4 THEN 3410
3380 IF A1(3)>A1(19) THEN B(12)=A1(19) : A1(3)=A1(3)-B(12) : A1(19)=0 : GOTO 3400
3390 B(12)=A1(3) : A1(19)=A1(19)-B(12) : A1(3)=0
3400 A1(1)=A1(1)-B(12)*4 : RETURN
3410 IF A1(1)/4>A1(19) THEN 3470
3420 B(12)=A1(1)/4 : A1(19)=A1(19)-B(12) : A1(3)=A1(3)-B(12) : A1(1)=0
3430 IF A1(3)>A1(19) THEN 3460
3440 IF A1(19)/3>A1(3) THEN RETURN
3450 B(10)=(A1(19)-A1(3))/2 : B(13)=A1(3)-B(10) : A1(3)=0 : A1(19)=0 : RETURN
3460 B(13)=A1(19) : A1(3)=A1(3)-B(13) : A1(19)=0 : RETURN
3470 B(12)=A1(19) : A1(1)=A1(1)-B(12)*4 : A1(19)=0 : A1(3)=A1(3)-B(12) : RETURN
3480 '
3490 '
3500 *KAOLINE
3510 IF A1(3)*2>A1(19) THEN 3580
3520 IF A1(3)*2>A1(1) THEN 3550
3530 B(7)=A1(3) : A1(1)=A1(1)-B(7)*2 : A1(19)=A1(19)-B(7)*2 : A1(3)=0 : RETURN
3540 A1(19)=A1(18)*A2(18)/A2(19) : A1(18)=0
3550 B(7)=A1(1)/2 : A1(3)=A1(3)-B(7) : A1(19)=A1(19)-B(7)*2 : A1(1)=0
3560 IF A1(3)*3>A1(19) THEN B(10)=A1(19)/3 : A1(3)=A1(3)-B(10) : A1(19)=0 : RETURN
3570 B(10)=A1(3) : A1(19)=A1(19)-B(10)*3 : A1(3)=0 1 RETURN
3580 IF A1(19)<A1(1) THEN B(7)=A1(19)/2 : A1(1)=A1(1)-B(7)*2 : A1(3)=A1(3)-B(7) : GOTO 3610
3590 B(7)=A1(1)/2 : A1(19)=A1(19)-B(7)*2 : A1(3)=A1(3)-B(7)
3600 B(10)=A1(19)/3 : A1(3)=A1(3)-B(10) : A1(1)=0
3610 A1(19)=0 : RETURN
3620 '
3630 '
3640 *GIBBSITE
3650 IF B(10)=0 AND B(12)=0 THEN RETURN
3660 IF B(10)<B(12) THEN B(7)=B(7)+B(10)*2 : B(12)=B(12)-B(10) : B(10)=0 : RETURN
3670 B(7)=B(7)+B(12)*2 : B(10)=B(10)-B(12) : B(12)=0 : RETURN
3680 '
3690 '
3700 *ENSTATITE
3710 IF A1(1)=0 OR A1(7)=0 THEN RETURN
3720 IF A1(1)>A1(7) THEN B(30)=A1(7) : A1(1)=A1(1)-B(30) : A1(7)=0 : RETURN
3730 B(30)=A1(1) : A1(7)=A1(7)-B(30) : A1(1)=0 : RETURN
3740 '
3750 '
3760 *DIASPORE
3770 IF B(10)=0 OR B(12)=0 OR A1(19)=0 THEN RETURN
3780 IF B(10)>B(12) THEN 3820
3790 IF A1(19)/2>B(10) THEN 3810
3800 B(7)=B(7)+A1(19) : B(10)=B(10)-A1(19)/2 : B(12)=B(12)-A1(19)/2 : A1(19)=0 : RETURN
3810 B(7)=B(7)+B(10)*2 : B(12)=B(12)-B(10) : A1(19)=A1(19)-B(10)*2 : B(10)=0 2 RETURN
3820 IF A1(19)/2>B(12) THEN 3830 ELSE 3800
3830 B(7)=B(7)+B(12)*2 : B(10)=B(10)-B(12) : A1(19)=A1(19)-B(12)*2 : B(2)=0 : RETURN
3840 '
3850 '
3860 *CORUNDUM
3870 IF A1(3)=0 OR B(10)=0 THEN RETURN
3880 IF A1(3)/2>B(10) THEN B(13)=B(13)+B(10)*3 : A1(3)=A1(3)-B(10)*2 : B(10)=0 : RETURN
3890 B(13)=B(13)+A1(3)*3/2 : B(10)=B(10)-A1(3)/2 : A1(3)=0 : RETURN
3900 B(3)=A1(1) : A1(3)=A1(3)-B(3) : A1(1)=0
3910 B(1)=A1(1) : B(2)=A1(3) : A1(1)=0 : A1(3)=0 : RETURN
3920 '
3930 '
3940 *ANDALUSITE
3950 IF A1(1)=0 OR A1(3)=0 THEN 3980
3960 IF A1(1)>A1(3) THEN B(3)=A1(3) : A1(1)=A1(1)-B(3) : A1(3)=0 : GOTO 3980
3970 B(3)=A1(1) : A1(3)=A1(3)-B(3) : A1(1)=0
3980 B(1)=A1(1) : B(2)=A1(3) : A1(1)=0 : A1(3)=0 : RETURN
3990 '
4000 '
4010 *MAGNETITE
4020 IF A1(4)=0 THEN RETURN
4030 IF A1(19)=0 THEN 4080
4040 IF A1(4)>A1(19) THEN 4070
4050 B(21)=A1(4) : A1(19)=A1(19)-B(21)
4060 A1(4)=0 : RETURN
4070 B(21)=A1(19) : A1(4)=A1(4)-B(21) : A1(19)=0
4080 IF A1(5)=0 THEN 4110
4090 IF A1(4)<A1(5) THEN B(22)=A1(4) : A1(5)=A1(5)-B(22) : GOTO 4060
4100 B(22)=A1(5) : A1(4)=A1(4)-B(22)
4110 B(23)=A1(4) : A1(5)=0 : GOTO 4060
4120 '
4130 '
4140 *OTHERS
4150 COLOR 4
4160 A9=0 : FOR I=1 TO 19 : A9=A9+A1(I)*A2(I) : NEXT
4170 B(31)=B(31)+A(QQ,22)+A(QQ,20)+A9
4180 RETURN
4190 '
4200 '
4210 '
4220 *OUTPUT
4230 'WIDTH 80,25
4240 SCREEN,3,3 : CLS 3 : SCREEN,3,0 : LINE(0,0)-(639,399),0,BF : COLOR 4
4250 LOCATE 2,2 : PRINT "Sample Name : ";M$
4260 LOCATE 2,4 : PRINT "Locality : ";L$
4270 LOCATE 2,6 : PRINT "Normative Minerals(wt%)"
4280 TOTAL(1,QQ)=0 : T1=0 : FOR I=1 TO 31 : B0(QQ,I)=B(I)*C9(I) : TOTAL(1,QQ)=TOTAL(1,QQ)+B0(QQ,I) : NEXT
4290 FOR I=1 TO 31 : B1=0
4300 IF B0(QQ,I)=0 THEN 4360
4310 B1=B0(QQ,I)/TOTAL(1,QQ)*100 : T1=T1+B1
4320 IF I<12 THEN LOCATE 2,I+7
4330 IF I>11 AND I<23 THEN LOCATE 28,I-2
4340 IF I>22 THEN LOCATE 54,I-13
4350 PRINT USING "&&";B1$(I);: PRINT " = ";: PRINT USING "##.##"; B0(QQ,I)
4360 NEXT
4370 LOCATE 54,20 : PRINT "Total = ";:PRINT USING "##.##";TOTAL(1,QQ)
4380 LOCATE 2,23 : PRINT "Hit any key!!"
4390 Y$=INPUT$(1)
4400 'WIDTH 40,25
4410 RETURN 200
4420 '
4430 '
4440 *PRINTOUT
4450 GOSUB 4800
4460 GOSUB 4920
4470 FOR I=1 TO NN
4480 TOTAL(1,I)=0 : TOTAL(2,I)=0 : LPRINT TAB(3+I*9);I;
4490 NEXT I
4500 LPRINT : GOSUB 4920
4510 FOR I=1 TO 22
4520 LPRINT AA$(I):
4530 FOR J=1 TO NN
4540 IF A(J,I)=0 THEN 4560 ELSE TOTAL(1,J)=TOTAL(1,J)+A(J,I)
4550 LPRINT TAB(1+J*9) USING "###.###";A(J,I);
4560 NEXT J
4570 LPRINT
4580 NEXT I
4590 GOSUB 4920 : LPRINT "Total";
4600 FOR I=1 TO NN
4610 LPRINT TAB(1+I*9) USING "###.###";TOTAL(1,I);
4620 NEXT I
4630 LPRINT : GOSUB 4920 : LPRINT
4640 FOR I=I TO 31
4650 LPRINT B1$(I);
4660 FOR J=1 TO NN
4670 IF B0(J,I)=0 THEN 4690 ELSE TOTAL(2,J)=TOTAL(2,J)+B0(J,I)
4680 LPRINT TAB(1+J*9) USING "###.##";B0(J,I);
4690 NEXT J
4700 LPRINT
4710 NEXT I
4720 GOSUB 4920 : LPRINT "Total";
4730 FOR I=1 TO NN
4740 LPRINT TAB(1+I*9) USING "###.##";TOTAL(2,I);
4750 NEXT I
4760 LPRINT : GOSUB 4920 : LPRINT CHR$(12)
4770 RETURN
4780 '
4790 '
4800 IF NN=I THEN TL$="V0204" : GOTO 4880
4810 IF NN=2 THEN TL$="V0312" : GOTO 4880
4820 IF NN=3 THEN TL$="V0420" : GOTO 4880
4830 IF NN=4 THEN TL$="V0528" : GOTO 4880
4840 IF NN=5 THEN TL$="V0636" : GOTO 4880
4850 IF NN=6 THEN TL$="V0744" : GOTO 4880
4860 IF NN=7 THEN TL$="V0852" : GOTO 4880
4870 IF NN=8 THEN TL$="V0960"
4880 RETURN
4890 '
4900 '
4910 '
4920 LPRINT CHR$(27);TL$;CHR$(&H8) : RETURN
4930 '
4940 '
4950 '
4960 *PROEND
4970 CLS 1 : CLOSE #1
4980 LOCATE 8,5 : PRINT "Program End"
4990 END
5000 'ERROR
5010 CLS 1
5020 PRINT "ERROR ON LINE=";ERL
5030 PRINT "ERROR MESSAGE=";ERR
5040 END