Language: GWBasic.
Objective: This program is part of a Quantitative Metallography Package. Given a set of data about the number of intercepts between a test line and grain boundaries of a monophasic microstructure, it makes the necessary calculations requerired for the determination of its grain size and specific volume, including a simple statistical analysis of the results.
***** Begin of Program Listing *****
10 REM
12 REM *** QUANTITATIVE METALLOGRAPHY PACKAGE
14 REM ***
16 REM *** Grain Size Calculation of a Monophasic Alloy
18 REM ***
20 REM *** References:
21 REM ***
22 REM *** - UNDERWOOD, N. Quantitative Stereology. Addison-
24 REM *** Wesley, Reading, 1970.
26 REM ***
28 REM ***
30 REM ***
32 REM *** Authors: Osvaldo Branchini & Antonio Gorni.
33 REM *** COSIPA - I.ME - C.P. 11
34 REM *** 11573-900 Cubatao SP Brazil
35 REM ***
36 REM *** October 31, 1988
38 REM ***
100 SCREEN 1: SCREEN 0: OPTION BASE 1: KEY OFF: DIM NI(300), DG(300, 2), NV(300, 2), VS(300): B$ = CHR$(7): ON ERROR GOTO 1700
110 VIEW PRINT 1 TO 24: CLS : BF$ = "GRAIN SIZE": PRINT TAB((40 - LEN(BF$)) / 2 + 1); : COLOR 0, 7: PRINT BF$: COLOR 7, 0: PRINT : PRINT : LOCATE 5
120 LOCATE , 10: PRINT "<1> Data Input": PRINT
130 LOCATE , 10: PRINT "<2> Data Correction": PRINT
140 LOCATE , 10: PRINT "<3> Data Suppression": PRINT
150 LOCATE , 10: PRINT "<4> Data Listing": PRINT
160 LOCATE , 10: PRINT "<5> Data Saving": PRINT
170 LOCATE , 10: PRINT "<6> Output of Results"
180 PRINT : LOCATE , 10: PRINT "<7> End"
190 LOCATE 23: BF$ = "(c) 1988, by": PRINT TAB((40 - LEN(BF$)) / 2 + 1); BF$: BF$ = "OSVALDO BRANCHINI & ANTONIO GORNI": PRINT TAB((40 - LEN(BF$)) / 2 + 1); BF$;
200 LOCATE 20: LOCATE , 10: INPUT "Your Choice"; RR
210 IF RR > 7 OR RR < 1 THEN PRINT B$: GOTO 110
220 ON RR GOTO 230, 520, 570, 670, 1050, 1170, 1500
230 CLS : BF$ = "DATA INPUT": PRINT TAB((40 - LEN(BF$)) / 2 + 1); : COLOR 0, 7: PRINT BF$: COLOR 7, 0
240 VIEW PRINT 4 TO 24: LOCATE 8: LOCATE , 13: PRINT "<1> New Data": LOCATE 13: LOCATE , 13: PRINT "<2> More Data": LOCATE 22: LOCATE , 13: INPUT "Sua Opcao"; RF: IF RF < 1 OR RF > 2 THEN PRINT B$: GOTO 240
250 R$ = ""
260 IF FS <> 0 AND RF = 1 THEN CLS : LOCATE 8: BF$ = "DATA NOT SAVED YET!": PRINT TAB((40 - LEN(BF$)) / 2 + 1); : COLOR 31, 0 ELSE 280
270 PRINT B$; BF$: COLOR 7, 0: LOCATE 20: INPUT "Do you really want to enter new data (Y/N)"; R$: IF R$ <> "Y" AND R$ <> "N" THEN PRINT B$: GOTO 260
280 IF R$ = "N" THEN 110
290 IF RF = 1 THEN NP = 0: FS = 0: AQ$ = ""
300 IF RF = 2 THEN FS = -1
310 VIEW PRINT 1 TO 24: CLS : BF$ = "INPUT OPTION": PRINT TAB((40 - LEN(BF$)) / 2 + 1); : COLOR 0, 7: PRINT BF$: COLOR 7, 0: LOCATE 8, 14: PRINT "<1> Keyboard"
320 LOCATE 13, 14: PRINT "<2> Disk": LOCATE 20, 14: INPUT "Your Choice"; RE: IF RE < 1 OR RE > 2 THEN PRINT B$: GOTO 310
330 ON RE GOTO 340, 460
340 CLS : BF$ = "Input via Keyboard": PRINT TAB((40 - LEN(BF$)) / 2 + 1); : COLOR 0, 7: PRINT BF$: COLOR 7, 0: VIEW PRINT 2 TO 24: LOCATE 10: FS = -1
350 IF RF = 2 THEN PRINT "Length of the Test Line (microns) = "; LT: PRINT : PRINT "Magnification (x) = "; M: GOTO 380
360 INPUT "Length of the Test Line (microns)"; LT
370 PRINT : INPUT "Magnification"; M
380 PRINT : PRINT
390 PRINT "Now Enter the Number of Intercepts;"; : PRINT "Enter END to finish."
400 NP = NP + 1: PRINT : PRINT "----------------------------------------"
410 PRINT "A-A ("; NP; ")? ";
420 INPUT "", B1$: IF B1$ = "FIM" THEN NP = NP - 1: GOTO 110
430 NI(NP) = VAL(B1$)
440 DG(NP, 1) = LT / (NI(NP) * M): DG(NP, 2) = 2 * NI(NP) / LT
450 GOTO 400
460 CLS : BF$ = "INPUT VIA DISK": PRINT TAB((40 - LEN(BF$)) / 2 + 1); : COLOR 0, 7: PRINT BF$: COLOR 7, 0
470 VIEW PRINT 2 TO 24: LOCATE 10: PRINT "Input File (? to List Directory)? ": PRINT : INPUT "", AQ$
480 IF AQ$ = "?" THEN CLS : LOCATE 6: INPUT "Directory Listing"; DD$: FILES DD$ + "*.TGM": PRINT : INPUT "Press to Continue...", R$: CLS : GOTO 470
490 AQ$ = AQ$ + ".TGM": LOCATE 20: COLOR 31, 0: PRINT "READING "; AQ$: COLOR 7, 0: OPEN "I", #1, AQ$: INPUT #1, NR: INPUT #1, LT: INPUT #1, M: FOR I = NP + 1 TO NR + NP: INPUT #1, NI(I): NEXT I
500 FOR I = NP + 1 TO NP + NR: DG(I, 1) = LT / (NI(I) * M): DG(I, 2) = 2 * NI(I) / LT: NEXT I
510 CLOSE #1: NP = NP + NR: COLOR 7, 0: GOTO 110
520 CLS : BF$ = "DATA CORRECTION": PRINT TAB((40 - LEN(BF$)) / 2 + 1); : COLOR 0, 7: PRINT BF$: COLOR 7, 0
530 PRINT : PRINT : VIEW PRINT 2 TO 24: LOCATE 6: PRINT "Length of Test Line:"; LT; " micr.": PRINT : PRINT "Magnification: "; M; "x."
540 PRINT : PRINT "----------------------------------------": INPUT "Index of Field (END to finish)? ", BF$: IF BF$ = "END" THEN FS = -1: GOTO 110
550 IC = VAL(BF$): PRINT : PRINT "A-A="; : PRINT " "; NI(IC); TAB(20); : INPUT ""; NI(IC)
560 DG(IC, 1) = LT / (NI(IC) * M): DG(IC, 2) = 2 * NI(IC) / LT: GOTO 540
570 CLS : BF$ = "DATA SUPRESSION": PRINT TAB((40 - LEN(BF$)) / 2 + 1); : COLOR 0, 7: PRINT BF$: COLOR 7, 0: VIEW PRINT 2 TO 24: LOCATE 10: ISA = 0
580 LOCATE 7: INPUT "Index of Field (END to Finish)? ", BF$: IF BF$ = "FIM" THEN 630
590 IC = VAL(BF$): PRINT : PRINT : PRINT NI(IC): PRINT DG(IC, 1); TAB(14); DG(IC, 2)
600 LOCATE 14: PRINT B$; : INPUT "Confirm (Y/N)! ", BF$: IF BF$ = "N" THEN CLS : GOTO 580
610 IF BF$ <> "Y" THEN 600
620 CLS : ISA = ISA + 1: VS(ISA) = IC: GOTO 580
630 IF ISA = 0 THEN 110
640 LOCATE 16: COLOR 31, 0: PRINT "MAKING SUPPRESSIONS...": COLOR 7, 0: FOR I = 1 TO ISA - 1: FOR J = I + 1 TO ISA: IF VS(J) > VS(I) THEN IA = VS(J): VS(J) = VS(I): VS(I) = IA
650 NEXT J, I: FS = -1
660 FOR J = 1 TO ISA: FOR I = VS(J) TO NP - 1: NI(I) = NI(I + 1): FOR K = 1 TO 2: DG(I, K) = DG(I + 1, K): NEXT K: NEXT I: NP = NP - 1: NEXT J: CLS : GOTO 110
670 CLS : BF$ = "DATA LISTING": PRINT TAB((40 - LEN(BF$)) / 2 + 1); : COLOR 0, 7: PRINT BF$: COLOR 7, 0: VIEW PRINT 2 TO 24: CL = 0
680 VIEW PRINT 2 TO 24: LOCATE 8, 13: PRINT "<1> Screen": LOCATE 13, 13: PRINT "<2> Printer": LOCATE 22, 13: INPUT "Your Choice"; RE: IF RE < 1 OR RE > 2 THEN PRINT B$: GOTO 680
690 CLS : IF RE = 2 THEN 1720
700 LOCATE 8: PRINT "Data were determined with:": PRINT : PRINT
710 PRINT "Length of Test Line ="; LT; " microns": PRINT
720 PRINT "Magnification = "; M; " x": LOCATE 22
730 INPUT "Press to begin listing.", BF$: CLS
740 FOR I = 1 TO NP
750 PRINT : PRINT : PRINT "#"; I: PRINT : PRINT "A-A = "; NI(I): PRINT "GS = "; DG(I, 1): PRINT "Sv = "; DG(I, 2): CL = CL + 1
760 IF CL >= 3 AND I < NP THEN PRINT : PRINT "Press to continue... ", : CL = 0: INPUT "", R$: CLS
770 GOTO 800
780 PRINT "Point #"; I; TAB(10); NI(I): CL = CL + 1
790 IF CL >= 57 THEN PRINT CHR$(12): CL = 0
800 NEXT
810 PRINT : INPUT "Press to continue...", BF$
820 FOR NK = 1 TO 2
830 IF NK = 1 THEN MASC$ = "###.#" ELSE MASC$ = ".#####"
840 CLS : LOCATE 12: PRINT "Crunching Numbers... Please Wait for a While!"
850 FOR I = 1 TO 5: VM(I) = 0: VI(I) = 2000: NEXT I
860 FOR I = 1 TO NP: IF DG(I, NK) > VM(5) THEN GOSUB 890
870 IF DG(I, NK) < VI(5) THEN GOSUB 910
880 NEXT I: GOTO 930
890 VM(5) = DG(I, NK): V1(5) = I: FOR K = 1 TO 4: FOR J = K + 1 TO 5: IF VM(J) > VM(K) THEN IA = VM(K): VM(K) = VM(J): VM(J) = IA: IA = V1(K): V1(K) = V1(J): V1(J) = IA
900 NEXT J, K: RETURN
910 VI(5) = DG(I, NK): V2(5) = I: FOR K = 1 TO 4: FOR J = K + 1 TO 5: IF VI(J) < VI(K) THEN IA = VI(K): VI(K) = VI(J): VI(J) = IA: IA = V2(K): V2(K) = V2(J): V2(J) = IA
920 NEXT J, K: RETURN
930 FOR I = 1 TO 5: IF VM(I) = 0 THEN VM(I) = -1
940 IF VI(I) = 2000 THEN VI(I) = -1
950 NEXT I
960 IF NK = 1 THEN BF$ = "GRAIN DIAMETER"
970 IF NK = 2 THEN BF$ = "SPECIFIC SURFACE - Sv"
980 CLS : PRINT : PRINT TAB((40 - LEN(BF$)) / 2 + 1); : PRINT BF$: LOCATE 8: PRINT "The 5 Lowest Points Are:": PRINT
990 PRINT USING MASC$; VI(1); : LOCATE , 8: PRINT USING MASC$; VI(2); : LOCATE , 16: PRINT USING MASC$; VI(3); : LOCATE , 24: PRINT USING MASC$; VI(4); : LOCATE , 32: PRINT USING MASC$; VI(5)
1000 PRINT "("; V2(1); ")"; TAB(8); "("; V2(2); ")"; TAB(16); "("; V2(3); ")"; TAB(24); "("; V2(4); ")"; TAB(32); "("; V2(5); ")": PRINT : PRINT : PRINT
1010 PRINT "The 5 Highest Points Are:": PRINT
1020 PRINT USING MASC$; VM(1); : LOCATE , 8: PRINT USING MASC$; VM(2); : LOCATE , 16: PRINT USING MASC$; VM(3); : LOCATE , 24: PRINT USING MASC$; VM(4); : LOCATE , 32: PRINT USING MASC$; VM(5)
1030 PRINT "("; V1(1); ")"; TAB(8); "("; V1(2); ")"; TAB(16); "("; V1(3); ")"; TAB(24); "("; V1(4); ")"; TAB(32); "("; V1(5); ")": LOCATE 22: INPUT "Aperte para continuar...", BF$
1040 NEXT NK: GOTO 110
1050 VIEW PRINT 1 TO 24: CLS : BF$ = "DATA SAVING ON DISK": PRINT TAB((40 - LEN(BF$)) / 2 + 1); : COLOR 0, 7: PRINT BF$: COLOR 7, 0: VIEW PRINT 2 TO 24
1060 IF AQ$ = "" OR AQ$ = "?" THEN 1110
1070 LOCATE 10: PRINT "The Current File is "; LEFT$(AQ$, LEN(AQ$) - 3)
1080 LOCATE 12: INPUT "Keep it (Y/N)"; R$: IF R$ <> "Y" AND R$ <> "N" THEN PRINT B$: GOTO 1080
1090 IF R$ = "Y" THEN 1140
1100 CLS
1110 LOCATE 10: PRINT "File Name (? for Directory Listing)? ": PRINT : INPUT "", AQ$
1120 IF AQ$ = "?" THEN CLS : LOCATE 6: INPUT "Directory"; DD$: PRINT : FILES DD$ + "*.TGM": PRINT : PRINT : INPUT "Press to Continue...", R$: CLS : GOTO 1110
1130 AQ$ = AQ$ + ".TGM"
1140 LOCATE 20: COLOR 31, 0: PRINT "SAVING IN "; AQ$: COLOR 7, 0
1150 OPEN "O", #1, AQ$: PRINT #1, NP: PRINT #1, LT: PRINT #1, M: FOR I = 1 TO NP: PRINT #1, NI(I): NEXT I: CLOSE #1: FS = 0
1160 GOTO 110
1170 CLS : B2$ = "RESULTS OUTPUT": PRINT TAB((40 - LEN(B2$)) / 2 + 1); : COLOR 0, 7: PRINT B2$: COLOR 7, 0: VIEW PRINT 2 TO 24
1180 LOCATE 8: LOCATE , 14: PRINT "<1> Screen": LOCATE 14: LOCATE , 14: PRINT "<2> Printer": LOCATE 21: LOCATE , 14: INPUT "Your Choice"; RE: IF RE < 1 OR RE > 2 THEN PRINT B$: GOTO 1180
1190 FOR I = 1 TO NP: FOR J = 1 TO 2
1200 NV(I, J) = DG(I, J): NEXT J, I
1210 IF RE = 2 THEN 1810
1220 FOR NK = 1 TO 2
1230 IF NK = 1 THEN B1$ = B2$ + " - GRAIN SIZE": B3$ = "***** Grain Size *****": B4$ = "Grain Size": F1 = 6: F2 = 7: F3 = 5: MASC$ = "###.#"
1240 IF NK = 2 THEN B1$ = B2$ + " - SV": B3$ = "***** Superficie Especifica - Sv *****": B4$ = "Specific Surface - Sv": F1 = 8: F2 = 9: F3 = 4: MASC$ = ".#####"
1250 CLS : IF NK = 2 THEN 1300
1260 LOCATE 8: PRINT "Number of Points = "; NP: PRINT : PRINT
1270 PRINT "Magnification = "; M; "x": PRINT : PRINT
1280 PRINT "Length of Test Line = "; LT; " microns": PRINT : PRINT
1290 LOCATE 22: INPUT "Press to Continue...", BF$: CLS
1300 CL = 6: VIEW PRINT 1 TO 24: CLS : PRINT TAB((40 - LEN(B1$)) / 2 + 1); : COLOR 0, 7: PRINT B1$: COLOR 7, 0: VIEW PRINT 4 TO 24: LOCATE 6
1310 PRINT "Data from "; B4$
1320 FOR I = 1 TO NP STEP F3 + 1: FOR J = 0 TO F3: IF I + J > NP THEN 1370
1330 PRINT USING MASC$; NV(I + J, NK); : IF J < F3 THEN PRINT TAB(J * F1 + F2);
1340 NEXT J: PRINT : CL = CL + 1
1350 IF CL >= 22 AND I < NP - 5 THEN PRINT : INPUT "Press to Continue...", R$: CLS : LOCATE 6: CL = 6: PRINT "Data from "; B4$
1360 NEXT
1370 PRINT : PRINT : INPUT "Press to Continue...", R$: CLS
1380 GOSUB 1550
1390 PRINT : BF$ = "=> Statistical Analysis <=": PRINT TAB((40 - LEN(BF$)) / 2 + 1); BF$: PRINT : LOCATE 10
1400 PRINT "Mean = "; : PRINT USING MASC$; MD
1410 IF NK = 1 THEN PRINT "ASTM Grain Size = "; : PRINT USING "##.##"; -10 - 6.64 * LOG(MD / 10000) / 2.30258409#
1420 PRINT "Standard Deviation = "; : PRINT USING MASC$; DP
1430 PRINT : PRINT "N(1%)= "; INT(NM(1) + .5); TAB(14); "N(3%) = "; INT(NM(3) + .5); TAB(28); "N(5%) = "; INT(NM(5) + .5): PRINT
1440 PRINT "Real Precision = "; : PRINT USING "##.##"; PRE; : PRINT " %"
1450 PRINT "Precision of the Mean = "; : PRINT USING MASC$; MD * PRE / 100
1460 PRINT "Mean Amplitude = "; : PRINT USING MASC$; MD; : PRINT " +/- "; : PRINT USING MASC$; MD * PRE / 100
1470 LOCATE 22: INPUT "Press to Continue...", BF$
1480 NEXT NK
1490 GOTO 110
1500 CLS : BF$ = "END OF PROGRAM RUN": PRINT TAB((40 - LEN(BF$)) / 2 + 1); : COLOR 0, 7: PRINT BF$: COLOR 7, 0: VIEW PRINT 2 TO 24: IF FS = 0 THEN 1540
1510 LOCATE 8: BF$ = "DATA NOT SAVED YET!": PRINT TAB((40 - LEN(BF$)) / 2 + 1); : COLOR 31, 0: PRINT B$; BF$: COLOR 7, 0
1520 LOCATE 20: INPUT "Do you Really Want to Quit (Y/N)"; R$: IF R$ <> "Y" AND R$ <> "N" THEN PRINT B$: GOTO 1510
1530 IF R$ = "N" THEN 110
1540 VIEW PRINT 1 TO 24: SCREEN 0: SCREEN 2: SCREEN 0: CLS : KEY ON: END
1550 REM SUB-ROTINA PARA CALCULAR MEDIA, DESVIO PADRAO E ERRO DA MEDIA
1560 HP = 0: TX = 0
1570 REM HP- SOMATORIA DE DG; TX- SOMATORIA DE DG^2; MD- MEDIA DE DG; DP- DESVIO PADRAO DE DG.
1580 FOR I = 1 TO NP
1590 HP = HP + DG(I, NK)
1600 TX = TX + (DG(I, NK) ^ 2)
1610 NEXT I
1620 MD = HP / NP
1630 DP = ((TX - (HP ^ 2 / NP)) / (NP - 1))
1640 DP = SQR(DP)
1650 FOR KJ = 1 TO 5 STEP 2
1660 NM(KJ) = (200 * DP / (KJ * MD)) ^ 2
1670 NEXT KJ
1680 PRE = 200 * DP / MD / SQR(NP)
1690 RETURN
1700 CLS : LOCATE 12: COLOR 31, 0: IF ERR = 53 THEN PRINT "File not Finded!" ELSE PRINT : PRINT B$; "ERROR #"; ERR; " AT LINE"; ERL; "!"
1710 COLOR 7, 0: LOCATE 22: INPUT "Press to Continue...", BF$: RESUME 110
1720 LOCATE 10: PRINT "Prepare Printer;": PRINT "Mark Start of Report.": PRINT : PRINT : PRINT
1730 PRINT "Explanatory Message to be Printed? ": PRINT : LINE INPUT "", BF$: LPRINT "DATA FOR GRAIN SIZE - "; BF$: LPRINT DATE$, TIME$: LPRINT : LPRINT : CL = 6
1740 LPRINT "Length of Test Line ="; LT; " microns": IF RE = 1 THEN PRINT
1750 LPRINT "Magnification = "; M; " x"
1760 LPRINT
1770 FOR I = 1 TO NP
1780 LPRINT "#"; I; TAB(10); NI(I): CL = CL + 1
1790 IF CL >= 57 THEN LPRINT CHR$(12): CL = 0
1800 NEXT: LPRINT CHR$(12): GOTO 110
1810 CLS : LOCATE 8: PRINT "Prepare Printer!": PRINT : PRINT "Now Enter with the Explanatory Message to be Printed"; : PRINT "in the Beginning of Report.": PRINT : LINE INPUT ""; BF$
1820 LPRINT "GRAIN SIZE - "; BF$: LPRINT DATE$, TIME$: LPRINT : LPRINT
1830 FOR NK = 1 TO 2
1840 IF NK = 1 THEN B1$ = B2$ + " - GRAIN SIZE": B3$ = "***** Grain Size *****": B4$ = "Grain Size": F1 = 6: F2 = 7: F3 = 10: MASC$ = "###.#"
1850 IF NK = 2 THEN B1$ = B2$ + " - SV": B3$ = "***** Specific Surface - Sv *****": B4$ = "Specific Surface - Sv": F1 = 8: F2 = 9: F3 = 8: MASC$ = ".#####"
1860 CLS : IF NK = 2 THEN 1900
1870 LPRINT "Number of Points = "; NP
1880 LPRINT "Magnification = "; M; "x"
1890 LPRINT "Length of Test Line = "; LT; " microns": LPRINT : LPRINT : LPRINT
1900 LPRINT B3$: LPRINT : LPRINT
1910 LPRINT "Data from "; B4$
1920 FOR I = 1 TO NP STEP F3 + 1: FOR J = 0 TO F3: IF I + J > NP THEN 1960
1930 LPRINT USING MASC$; NV(I + J, NK); : IF J < F3 THEN LPRINT TAB(J * F1 + F2);
1940 NEXT J: LPRINT : CL = CL + 1
1950 NEXT
1960 LPRINT : LPRINT
1970 GOSUB 1550
1980 LPRINT : BF$ = "=> Statistical Analysis <=": LPRINT TAB((40 - LEN(BF$)) / 2 + 1); BF$: LPRINT
1990 LPRINT "Mean = "; : LPRINT USING MASC$; MD
2000 IF NK = 1 THEN LPRINT "ASTM Grain Size = "; : LPRINT USING "##.##"; -10 - 6.64 * LOG(MD / 10000) / 2.30258409#
2010 LPRINT "Standard Deviation = "; : LPRINT USING MASC$; DP
2020 LPRINT : LPRINT "N(1%)= "; INT(NM(1) + .5); TAB(14); "N(3%) = "; INT(NM(3) + .5); TAB(28); "N(5%) = "; INT(NM(5) + .5): LPRINT
2030 LPRINT "Real Precision = "; : LPRINT USING "##.##"; PRE; : LPRINT " %"
2040 LPRINT "Precision of the Mean = "; : LPRINT USING MASC$; MD * PRE / 100
2050 LPRINT "Mean Amplitude = "; : LPRINT USING MASC$; MD; : LPRINT " +/- "; : LPRINT USING MASC$; MD * PRE / 100
2060 LPRINT : LPRINT : LPRINT
2070 NEXT NK
2080 LPRINT CHR$(12): GOTO 110
***** End of Program Listing ******
Return to the Software Menu.
 |
Last Update: 27 June 1996 | |
| © Antonio Augusto Gorni |