Language: QBasic.
Objective: This program calculates, using results got from a set of hot forming tests, the Activation Energy for Hot Deformation Q and other quantitative parameters related to hot strength of a metal, like que Zener-Hollomon parameter Z. It also includes graphical output, showing the relationship between these parameters. They are calculated through the fitting of experimental data using the simplified Sellars- Tegart equation, transforming hot strength through an exponential function.
Instructions: Data from the hot forming tests - for example, hot torsion tests - are input to this program through a disk file. It must have the following format:
Number of Test Temperatures,Number of Test Strain Rates
Temperature #1,Strain Rate #1,Strain at Maximum Stress #1,Maximum Stress #1
Temperature #2,Strain Rate #2,Strain at Maximum Stress #2,Maximum Stress #2
Temperature #3,Strain Rate #3,Strain at Maximum Stress #3,Maximum Stress #3
................
Temperature #n,Strain_Rate #n,Strain_at_Maximum_Stress #n,Maximum_Stress #n
where n is the total number of tests, which normally is equal to the product of Number of Test Temperatures times Number of Test Strain Rates.
Use the following units:
The file can have any name, but must be saved with the suffix .ZEN. For example, Steel_26.ZEN.
Note: This program requires that the file TABFORM.VGA is in the same directory of the BASIC program. So, you need to create this file using the same procedure as described for the copy of the BASIC programs. The file TABFORM.VGA is listed below, copy-and-paste its contents in a word processor (EDITOR [DOS] or WORD recommended!) and then save it with this name and in "text" format!
***** Begin of the TABFORM.VGA File *****
P1,0BL2D1R4U2L4D1 P1,0L4R8L4U2D4 P1,0BD2L2R4H3G3R1 P1,0BU2L2R4G3H3R1 P1,0 P1,0BR3U1BU2U3 P1,0BR1BU5U1BR3D1 P1,0BR2U6BR3D6U4R2L7BD2R7 P1,0BR4U6D1R2L4G1F1R4F1G1L4 P1,0BR1BU6D1R1U1BD6BR4U1L1D1BL4E6 P1,0BR6H5E1R2F1G4F1R2E2 P1,0BR3BU6D2 P1,0BR4H2U2E2 P1,0BR1E2U2H2 P1,0BU3R6L3U2D4U2H2F4H2E2G4 P1,0BU3R6L3U2D4 P1,0BR2E1U1L1 P1,0BU3R5 P1,0BR2U1R1D1 P1,0E6 P1,0R3E1U4H1L3G1D4E4 P1,0BR1R4L2U6G1 P1,0R5L5E5H1L3G1 P1,0BU1F1R3E1U1H2E2L5 P1,0BR4U6G4R5 P1,0BU1F1R3E1U2H1L4U2R5 P1,0BR1R3E1U1BD1G1L3BL1BU1U1BE1R3BL3BL1BE1E2 P1,0BR2U2E4L6 P1,0BR1R3E1U1H1L3BG1D1U1E1H1U1E1R3F1D1 P1,0BR1E4BU1H1L3G1D1F1R2BR1 P1,0BR2BU1U1R1D1L1BU3U1R1D1 P1,0BR2E1U1L1BU2U1R1D1 P1,0BU3F3H3E3 P1,0BU2R5BU2L5 P1,0BR5BU3H3F3G3 P1,0BR3U1BU2E2H1L3G1 P1,0BU1U1E1R1D3L1R3E1U4H1L3G1 P1,0U5BU1BR1R3BR1BD1D5BL5BU3R5 P1,0U6R4BR1BD1D1BD1D2BD1BL1L4U3R4 P1,0BU1U4BU1BR1R3F1BD4G1L3 P1,0U6R3F1F1D2G1G1L3 P1,0U6R5BD3BL4R3BD3BL4R5 P1,0U6R5BD3BL4R3 P1,0BU1U4BU1BR1R3F1BD2L2BR2D3L4 P1,0U6D3R5U3D6 P1,0BR2R2L1U6L1R2 P1,0BU1U1BF2L1R3BR1BU1U5BL1R2 P1,0U6D3R2E3G3F3 P1,0U6D6R5 P1,0U6F3D1U1E3D6 P1,0U6BD1R1BD1R1BD1R1BD1R1BD1R1BD1R1U6 P1,0BU1U4E1R3F1D4G1L3 P1,0U6R4F1D1G1L3 P1,0BU1U4BE1R3BF1D2G3L1BR2BU3F3 P1,0U6R4BF1D1BG1L3R1F3 P1,0BU1F1R3E1U1H1L3H1U1E1R3F1 P1,0BR2U6L3R6 P1,0BU1U5D5F1R3E1U5 P1,0BU3U3D3F3E3U3 P1,0U6D6E3U1D1F3U6 P1,0E6G3H3F6 P1,0BR3U3H3F3E3 P1,0R5L5E5U1L5 P1,0BR1R2L2U6R2 P1,0BU6F6 P1,0BR2R2U6L2 P1,0BR3U6F3H3G3 P1,0R6 P1,0BU6BR3D1G1 P1,0BR1H1E1R4D2L4R4U3H1L3 P1,0BR1R3E1U2H1L2G2D1U5 P1,0BR1R3E1G1L3H1U2E1R3 P1,0BR1R4U6D4H2L2G1D2 P1,0BR1R3L3H1U2E1R3F1D1L5 P1,0BR2U3L1R2L1U2E1R1F1 P1,0BR1R3E1U3L4G1F1R4 P1,0U6D4E2R2F1D3 P1,0BR1R2L1U4BU2L1BR1BD2L1 P1,0BU1F1R2E1U3BU2L1 P1,0BR1U6D4R2E2G2F2 P1,0BR2R2L1U6L1 P1,0U4R1R1F1D3U3E1R1F1D3 P1,0U4D2E2R2F1D3 P1,0BR1R3E1U2H1L3G1D2 P1,0U4R5F1G1L5 P1,0BR5U4L5G1F1R5 P1,0BR1U4D2E2R2 P1,0R4E1H1L3H1E1R4 P1,0BR2R1E1G1BL1BU1U4D1L1R2 P1,0BU1U3D3F1R2E3U1D4 P1,0BU3U1D1F3E3U1 P1,0BU1U3D3F1R1E1U1D1F1R1E1U3 P1,0E2R1E2G2L1H2F2R1F2 P1,0R2E3U1D1G1L2H2 P1,0R5L5BU1R1BR1BU1R1BU1BR1R1BU1L5 P1,0BR3R1L1H1U1H1L1R1E1U1E1R1 P1,0BR3U2BU2U2 P1,0BR2R1E1U1E1R1L1H1U1H1L1***** End of the TABFORM.VGA File *****
***** Begin of Program Listing *****
REM REM *** DETERMINATION OF: ACTIVATION ENERGY FOR HOT DEFORMATION REM REM *** VERSION USING EXPONENTIAL EXPRESSION REM *** StrainRate Exp [Q / (RT)] = A Exp (Beta * SigmaMax) REM REM REM *** Antonio Augusto Gorni --- October 8, 1995 REM DECLARE FUNCTION PRECISAO (X(), NP) DECLARE SUB INITGRAPH () DECLARE SUB INITAXIS (X(), Y(), N, NAXIS$) DECLARE SUB CARTESIAN (X, Y, PX, PY) DECLARE SUB NOTEXP (EXPO, VAR, POV) DECLARE SUB LABEL (A$, PX, PY) DECLARE SUB AXIS () DECLARE SUB PLOTPOINT (X(), Y(), N, SM) DECLARE SUB PLOTLINE (X(), Y(), N) DECLARE SUB GRID () DECLARE SUB HARDCOPY () DECLARE SUB SHOWGRAPH () DECLARE SUB LINEAR (ARGX(), YCALC(), NP, A, B) DECLARE SUB PEARSON (REAL(), CALC(), NPO, R, EPE) COMMON SHARED X0, X1, Y0, Y1, NX, NY, XA$, YA$, EX, EY, XRESOL, YRESOL COMMON SHARED GRAPHICS(), LETRA$(), XMARGMIN, YMARGMIN, XMARGMAX, YMARGMAX OPTION BASE 1 DIM DT(5, 5), TEMP(20), VELDEF(20), DEFMAX(20), SIGMAX(20) DIM LVELDEF(15), LSIGMAX(15), TINV(15) DIM MX(5, 5), MY(5, 5), X(5), Y(5), CONT(5), Q(15), CALC(5), REAL(5) DIM LETRA$(125), GRAPHICS(9940) CLS BEEP BF$ = "Be Sure to Activate GRAPHICS DESKJET Before Running this Program!!" PRINT TAB((80 - LEN(BF$)) / 2 + 1); : LOCATE 12 COLOR 0, 7: PRINT BF$; : COLOR 7, 0 DO WHILE INKEY$ = "" LOOP BF$ = "CALCULATION OF THE ZENER-HOLLOMON EQUATION PARAMETERS" CLS PRINT TAB((80 - LEN(BF$)) / 2 + 1); : COLOR 0, 7: PRINT BF$: COLOR 7, 0 PRINT BF$ = "Sigma Transformed Using Exponential Function" PRINT TAB((80 - LEN(BF$)) / 2 + 1); BF$ VIEW PRINT 6 TO 24 LOCATE 12 INPUT "Steel"; ACO$: ACO$ = ACO$ + ".ZEN" OPEN ACO$ FOR INPUT AS #1 INPUT #1, NROTEMP, NROVEL: NROCAS = NROTEMP * NROVEL FOR I = 1 TO NROCAS INPUT #1, TEMP(I), VELDEF(I), DEFMAX(I), SIGMAX(I) TEMP(I) = TEMP(I) + 273 SIGMAX(I) = SIGMAX(I) * 9.8 NEXT I CLOSE #1 FOR I = 1 TO NROTEMP CONT(I) = 0 NEXT I FOR I = 1 TO NROCAS J = I MOD NROTEMP IF J = 0 THEN J = NROTEMP CONT(J) = CONT(J) + 1 SREAL(J, CONT(J)) = SIGMAX(I) VREAL(J, CONT(J)) = LOG(VELDEF(I)) NEXT I FOR I = 1 TO NROTEMP FOR J = 1 TO NROVEL X(J) = SREAL(I, J): Y(J) = VREAL(I, J) NEXT J LINEAR X(), Y(), NROVEL, AT(I), BT(I) NEXT I RTMED = 0 FOR I = 1 TO NROTEMP FOR J = 1 TO NROVEL YREAL(J) = VREAL(I, J) YCALC(J) = AT(I) + BT(I) * SREAL(I, J) VCALC(I, J) = YCALC(J) NEXT J PEARSON YREAL(), YCALC(), NROVEL, RT(I), EPET(I) RTMED = RTMED + RT(I) NEXT I RTMED = RTMED / NROTEMP MMED = 0 FOR I = 1 TO NROTEMP MMED = MMED + BT(I) NEXT MMED = MMED / NROTEMP FOR I = 1 TO NROVEL CONT(I) = 0 NEXT I FOR I = 1 TO NROCAS K = INT(I / NROTEMP) IF I MOD NROTEMP <> 0 THEN K = K + 1 CONT(K) = CONT(K) + 1 S2REAL(K, CONT(K)) = SIGMAX(I) TIREAL(K, CONT(K)) = 1 / TEMP(I) NEXT I FOR I = 1 TO NROVEL FOR J = 1 TO NROTEMP X(J) = TIREAL(I, J): Y(J) = S2REAL(I, J) NEXT J LINEAR X(), Y(), NROTEMP, AV(I), BV(I) NEXT I FOR I = 1 TO NROVEL FOR J = 1 TO NROTEMP YREAL(J) = S2REAL(I, J) YCALC(J) = AV(I) + BV(I) * TIREAL(I, J) S2CALC(I, J) = YCALC(J) NEXT J PEARSON YREAL(), YCALC(), NROTEMP, RV(I), EPEV(I) RVMED = RVMED + RV(I) NEXT I RVMED = RVMED / NROVEL QMED = 0 CONTADOR = 0 FOR I = 1 TO NROVEL FOR J = 1 TO NROTEMP CONTADOR = CONTADOR + 1 Q(CONTADOR) = BV(I) * 1.99 * BT(J) QMED = QMED + Q(CONTADOR) NEXT J NEXT I QMED = QMED / CONTADOR RANGE = PRECISAO(Q(), CONTADOR) AMED = 0 FOR I = 1 TO NROVEL AMED=AMED+VELDEF(I)/EXP(MMED*AV(I)) NEXT I AMED = AMED/NROVEL CLS LOCATE 7 PRINT LEFT$(ACO$, LEN(ACO$) - 4) PRINT : PRINT PRINT "Beta = "; MMED PRINT PRINT "A = "; AMED PRINT PRINT "Delta Q = "; INT(QMED); "+/-"; INT(RANGE); "[cal/mol] *** "; PRINT INT(QMED * .004186); "+/-"; INT(RANGE * .004186); "[kJ/mol]" PRINT PRINT "Average Pearson Coefficients:" PRINT RTMED, RVMED PRINT FLAG3 = 0 DO WHILE FLAG3 = 0 LOCATE 23: INPUT "Do You Want to Print the Results (Y/N)"; BF$ IF BF$ = "Y" OR BF$ = "y" THEN FLAG3 = 1 CLS : BEEP LOCATE 12 INPUT "Prepare Printer; Press!", BF$ BF$ = "SIMPLIFIED CALCULATION OF THE ZENER-HOLLOMON EQUATION PARAMETERS" LPRINT BF$ BF$ = "Sigma Transformed Using Exponential Function" LPRINT LPRINT BF$ LPRINT : LPRINT : LPRINT LPRINT LEFT$(ACO$, LEN(ACO$) - 4), DATE$, TIME$ LPRINT : LPRINT LPRINT "Beta = "; MMED LPRINT LPRINT "A = "; AMED LPRINT LPRINT "Delta Q = "; INT(QMED); "+/-"; INT(RANGE); "[cal/mol] *** "; LPRINT INT(QMED * .004186); "+/-"; INT(RANGE * .004186); "[kJ/mol]" LPRINT : LPRINT LPRINT "Average Pearson Coefficients:" LPRINT RTMED, RVMED LPRINT CHR$(12) END IF IF BF$ = "N" OR BF$ = "n" THEN FLAG3 = 1 LOOP CLS CALL INITGRAPH FLAG1 = 0 BEEP DO WHILE FLAG1 = 0 FOR I = 1 TO NROCAS LVELDEF(I) = LOG(VELDEF(I)) LSIGMAX(I) = SIGMAX(I) NEXT I NAXIS$ = "Graphic Log(StrainRate) versus SigMax" CALL INITAXIS(LSIGMAX(), LVELDEF(), NROCAS, NAXIS$) XA$ = "SigMax - " + LEFT$(ACO$, LEN(ACO$) - 4) YA$ = "Log(StrainRate)" CALL AXIS CALL PLOTPOINT(LSIGMAX(), LVELDEF(), NROCAS, 1) FOR J = 1 TO NROTEMP FOR I = 1 TO NROVEL XFUNC(I) = SREAL(J, I) YFUNC(I) = VCALC(J, I) NEXT I CALL PLOTLINE(XFUNC(), YFUNC(), NROVEL) NEXT J FLAG2 = 0 DO WHILE FLAG2 = 0 CLS : SCREEN 0 BF$ = "SIMPLIFIED CALCULATION OF THE ZENER-HOLLOMON EQUATION PARAMETERS" CLS PRINT TAB((80 - LEN(BF$)) / 2 + 1); : COLOR 0, 7: PRINT BF$: COLOR 7, 0 VIEW PRINT 4 TO 24 FLAG3 = 0 DO WHILE FLAG3 = 0 LOCATE 12 INPUT "Do You Want to Repeat the Graphic (Y/N)"; BF$ IF BF$ = "N" OR BF$ = "n" THEN FLAG1 = 1: FLAG2 = 1: FLAG3 = 1 ELSE IF BF$ = "Y" OR BF$ = "y" THEN FLAG2 = 1: FLAG3 = 1 END IF END IF LOOP LOOP LOOP CLS FLAG1 = 0 DO WHILE FLAG1 = 0 FOR I = 1 TO NROCAS TINV(I) = 100000 / TEMP(I) NEXT I NAXIS$ = "Graphic SigMax versus 1/T" CALL INITAXIS(TINV(), LSIGMAX(), NROCAS, NAXIS$) XA$ = "100000 / T [1/K] - " + LEFT$(ACO$, LEN(ACO$) - 4) YA$ = "SigMax" CALL AXIS CALL PLOTPOINT(TINV(), LSIGMAX(), NROCAS, 1) FOR J = 1 TO NROVEL FOR I = 1 TO NROTEMP XFUNC(I) = TIREAL(J, I) * 100000 YFUNC(I) = S2CALC(J, I) NEXT I CALL PLOTLINE(XFUNC(), YFUNC(), NROTEMP) NEXT J FLAG2 = 0 DO WHILE FLAG2 = 0 SCREEN 0 BF$ = "SIMPLIFIED CALCULATION OF THE ZENER-HOLLOMON EQUATION PARAMETERS" CLS PRINT TAB((80 - LEN(BF$)) / 2 + 1); : COLOR 0, 7: PRINT BF$: COLOR 7, 0 VIEW PRINT 4 TO 24 FLAG3 = 0 DO WHILE FLAG3 = 0 LOCATE 12 INPUT "Do You Want to Repeat the Graphic (Y/N)"; BF$ IF BF$ = "N" OR BF$ = "n" THEN FLAG1 = 1: FLAG2 = 1: FLAG3 = 1 ELSE IF BF$ = "Y" OR BF$ = "y" THEN FLAG2 = 1: FLAG3 = 1 END IF LOOP LOOP LOOP END REM REM *** Subrotina AXIS REM *** REM *** Traca eixos coordenados na tela a partir da informacao gerada REM *** atraves da execucao previa da Subrotina INITAXIS. REM SUB AXIS SCREEN 11: X$ = XA$: Y$ = YA$ XMARGMIN = XRESOL / 12.549: XMARGMAX = XRESOL / 1.002 YMARGMIN = YRESOL / 16.667: YMARGMAX = YRESOL / 1.13 LINE (XMARGMIN, YMARGMIN)-(XMARGMAX, YMARGMIN) LINE (XMARGMAX, YMARGMIN)-(XMARGMAX, YMARGMAX) LINE (XMARGMIN, YMARGMAX)-(XMARGMAX, YMARGMAX) LINE (XMARGMIN, YMARGMAX)-(XMARGMIN, YMARGMIN) SX = (X1 - X0) / NX: SY = (Y1 - Y0) / NY FOR I = X0 TO X1 STEP SX CARTESIAN I, 0!, PX, PY LINE (PX, YMARGMIN)-(PX, YRESOL / 10.526) LINE (PX, YMARGMAX)-(PX, YRESOL / 1.176) NEXT FOR I = Y0 TO Y1 STEP SY CARTESIAN 0!, I, PX, PY LINE (XMARGMIN, PY)-(XRESOL / 9.552, PY) LINE (XMARGMAX, PY)-(XRESOL / 1.029, PY) NEXT VAR = X0 NOTEXP EX, VAR, PIV VAR = X1 NOTEXP EX, VAR, POV: IF ABS(PIV) < ABS(POV) THEN PIV = POV FOR K = X0 TO X1 STEP SX CARTESIAN K, 0!, PX, PY IF PX < XRESOL / 1.061 THEN VAR = K NOTEXP EX, VAR, POV IF POV <> PIV THEN VAR = VAR * 10 ^ (3 * (POV - PIV)) IF ABS(VAR) < .001 THEN VAR = 0 IF PIV <> 0 THEN VAR = INT(VAR + .5) P$ = LEFT$(STR$(VAR), 5): Y = YRESOL / 1.07 X = PX - 6 * LEN(P$) LABEL P$, X, Y END IF NEXT EX = PIV VAR = Y0 NOTEXP EY, VAR, PIV VAR = Y1 NOTEXP EY, VAR, POV: IF ABS(PIV) > ABS(POV) THEN PIV = POV FOR K = Y0 TO Y1 STEP SY CARTESIAN 0, K, PX, PY IF PY >= YRESOL / 10 THEN Y = PY + 2 VAR = K NOTEXP EY, VAR, POV IF POV <> PIV THEN VAR = VAR * 10 ^ (3 * (POV - PIV)) IF ABS(VAR) < .001 THEN VAR = 0 IF PIV <> 0 THEN VAR = INT(VAR + .5) P$ = LEFT$(STR$(VAR), 5): X = XMARGMIN - XRESOL / 64 * LEN(P$) LABEL P$, X, Y END IF NEXT EY = PIV IF X0 * X1 <= 0 THEN CARTESIAN 0!, Y, PX, PY LINE (PX, YMARGMIN)-(PX, YMARGMAX) END IF IF Y0 * Y1 < 0 THEN CARTESIAN X, 0!, PX, PY LINE (XMARGMIN, PY)-(XMARGMAX, PY) END IF IF EX <> 0 THEN IF EX > 0 THEN OFS = 1 ELSE OFS = 0 EX$ = "(x10^" + RIGHT$(STR$(3 * EX), LEN(STR$(3 * EX)) - OFS) + ")" X$ = X$ + " " + EX$ END IF IF EY <> 0 THEN IF EY > 0 THEN OFS = 1 ELSE OFS = 0 EY$ = "(x10^" + RIGHT$(STR$(3 * EY), LEN(STR$(3 * EY)) - OFS) + ")" Y$ = Y$ + " " + EY$ END IF X = XMARGMIN + INT(XRESOL / 1.21 - XRESOL / 64 * LEN(X$)) / 2 Y = YRESOL / 1.01 LABEL X$, X, Y X = XMARGMIN: Y = YRESOL / 25 LABEL Y$, X, Y END SUB REM REM *** Subrotina CARTESIAN REM *** REM *** Parametros de Entrada: REM *** X -> Abcissa do ponto a ser plotado; REM *** Y -> Ordenada do ponto a ser plotado. REM *** REM *** Parametros de Saida: REM *** PX -> Abcissa na matriz da tela correspondente a X; REM *** PY -> Ordenada na matriz da tela correspondente a Y. REM REM *** Converte as coordenadas dos dados a serem plotados em valores REM *** correspondentes na matriz da tela. REM SUB CARTESIAN (X, Y, PX, PY) PX = XMARGMIN + XRESOL / 1.088 * (X - X0) / (X1 - X0) PY = YMARGMIN + YRESOL / 1.212 * (Y1 - Y) / (Y1 - Y0) END SUB REM REM *** Subrotina GRID REM REM *** Gera uma tela sobre o grafico tracado. REM SUB GRID REM REM *** Use SCREEN 2 se o monitor for CGA! REM SCREEN 11: PUT (0, 0), GRAPHICS, PSET PU = XRESOL / 1.09 / NX: PA = YRESOL / 1.212 / NY FOR X = XMARGMIN TO XMARGMAX - 10 STEP PU FOR Y = YMARGMIN TO YMARGMAX STEP PA / 5 PSET (X, Y) NEXT NEXT FOR Y = YMARGMIN TO YMARGMAX STEP PA FOR X = XMARGMIN TO XMARGMAX STEP PU / 5 PSET (X, Y) NEXT NEXT GET (0, 0)-(XRESOL - 1, YRESOL - 1), GRAPHICS A$ = "" WHILE A$ = "" A$ = INKEY$ WEND END SUB REM REM *** Subrotina HARDCOPY REM REM *** Imprime o grafico da tela numa impressora EPSON. REM SUB HARDCOPY STATIC FLAGPRINTER LOCATE 11: PRINT "Prepare Printer; " PRINT : INPUT "Press to Continue! ", R$ SCREEN 11: PUT (0, 0), GRAPHICS, PSET IF FLAGPRINTER = 0 THEN FLAGPRINTER = 1 OPEN "LPT1:" FOR RANDOM AS #3: WIDTH #3, 255 PRINT #3, CHR$(24); : PRINT #3, CHR$(27); "A"; CHR$(8); DEF SEG = &HB800 FOR A = 0 TO 79: PRINT #3, CHR$(27); "K"; CHR$(144); CHR$(1); B = A + &H1EF0 FOR C = 1 TO 100: D = PEEK(B): EPRT = PEEK(B + &H2000): PRINT #3, CHR$(EPRT); CHR$(EPRT); CHR$(D); CHR$(D); B = B - 80: NEXT C PRINT #3, CHR$(13); CHR$(10); NEXT PRINT #3, CHR$(13); CHR$(24); CHR$(27); CHR$(50); LPRINT CHR$(12) END SUB REM REM *** Subrotina INITAXIS REM REM *** Parametros de Entrada: REM *** X() -> Vetor dos valores das abcissas dos dados; REM *** Y() -> Vetor dos valores das ordenadas dos dados; REM *** N -> Numero de pontos; REM *** NAXIS$ -> Mensagem explicativa para tela. REM REM *** Define o posicionamento dos eixos coordenados. Deve ser executada REM *** antes do tracado do grafico. REM SUB INITAXIS (X(), Y(), N, NAXIS$) X0 = X(1): X1 = X(1): Y0 = Y(1): Y1 = Y(1) FOR I = 2 TO N IF X0 > X(I) THEN X0 = X(I) IF X1 < X(I) THEN X1 = X(I) IF Y0 > Y(I) THEN Y0 = Y(I) IF Y1 < Y(I) THEN Y1 = Y(I) NEXT I VIEW PRINT 1 TO 24: CLS : SCREEN 0 BF$ = "AXIS AND GRAPHICAL PARAMETERS DEFINITION": PRINT TAB((80 - LEN(BF$)) / 2 + 1); COLOR 0, 7: PRINT BF$: COLOR 7, 0: VIEW PRINT 4 TO 24 LOCATE 5 PRINT NAXIS$ LOCATE 7 PRINT "Xmin: "; X0; : INPUT " - New: ", S$ IF S$ <> "" THEN X0 = VAL(S$) LOCATE 9 PRINT "Xmax: "; X1; : INPUT " - New: ", S$ IF S$ <> "" THEN X1 = VAL(S$) LOCATE 11 PRINT "Ymin: "; Y0; : INPUT " - New: ", S$ IF S$ <> "" THEN Y0 = VAL(S$) LOCATE 13 PRINT "Ymax: "; Y1; : INPUT " - New: ", S$ IF S$ <> "" THEN Y1 = VAL(S$) LOCATE 16 PRINT "Number of Ticks in X Axis: "; NX INPUT "New: ", S$: IF S$ <> "" THEN NX = VAL(S$) LOCATE 19 PRINT "Number of Ticks in Y Axis: "; NY INPUT "New: ", S$: IF S$ <> "" THEN NY = VAL(S$) END SUB REM REM *** Subrotina INITGRAPH REM REM *** Inicializa o computador para o tracado do grafico. Deve ser REM *** executada antes de qualquer outra rotina grafica. REM SUB INITGRAPH REM REM *** Use YRESOL = 180 para Monitor CGA! NX = 5: NY = 5: XRESOL = 640: YRESOL = 480 OPEN "TABFORM.VGA" FOR INPUT AS #1 FOR I = 28 TO 125: LINE INPUT #1, LETRA$(I): NEXT CLOSE #1 END SUB REM REM *** Subrotina LABEL REM REM *** Parametros de Entrada: REM *** P$ -> Mensagem a ser escrita no grafico; REM *** X -> Abcissa do ponto inicial da mensagem no grafico; REM *** Y -> Ordenada do ponto inicial da mensagem no grafico. REM REM *** Escreve uma mensagem no grafico, em coordenadas definidas. REM SUB LABEL (P$, X, Y) FOR I = 1 TO LEN(P$) PA$ = MID$(P$, I, 1) IF PA$ <> " " THEN AP = ASC(PA$) PSET (X + (I - 1) * 10, Y), 0: DRAW LETRA$(AP) END IF NEXT END SUB SUB LINEAR (ARGX(), REAL(), N, A, B) P = 0: S1 = 0: S2 = 0: S3 = 0 FOR K = 1 TO N P = ARGX(K) * REAL(K) + P S1 = ARGX(K) + S1 S2 = REAL(K) + S2 S3 = ARGX(K) * ARGX(K) + S3 NEXT K M1 = S1 / N: M2 = S2 / N B = (P - S1 * M2) / (S3 - S1 * M1) A = M2 - B * M1 END SUB SUB NOTEXP (EXPO, VAR, POV) POV = 0 SI = 1: IF VAR < 0 THEN SI = -1 VAR = ABS(VAR) IF VAR < 10 ^ -(EXPO + 3) THEN VAR = 0 ELSE WHILE VAR > 999 OR VAR < 1 IF VAR > 999 THEN VAR = VAR / 1000: POV = POV + 1 IF VAR < 1 THEN VAR = VAR * 1000: POV = POV - 1 WEND END IF VAR$ = STR$(SI * VAR) VAR$ = LEFT$(VAR$, 5) VAR = VAL(VAR$) END SUB SUB PEARSON (REAL(), CALC(), NP, R, EPE) YM = 0 FOR I = 1 TO NP YM = YM + REAL(I) NEXT YM = YM / NP S1 = 0: S2 = 0: S3 = 0 FOR I = 1 TO NP S1 = S1 + (CALC(I) - YM) ^ 2 S2 = S2 + (REAL(I) - YM) ^ 2 S3 = S3 + (REAL(I) - CALC(I)) ^ 2 NEXT R = SQR(S1 / S2) EPE = SQR(S3 / NP) END SUB SUB PLOTLINE (X(), Y(), N) PTOINIC = 0 FOR I = 1 TO N CARTESIAN X(I), Y(I), PX, PY IF PY < YMARGMIN OR PY > YMARGMAX OR PX < XMARGMIN OR PX > XMARGMAX THEN PTOINIC = 0 ELSE IF PTOINIC = 0 THEN PTOINIC = 1: PX1 = PX: PY1 = PY ELSE IF I <> 1 THEN LINE (PX1, PY1)-(PX, PY) PX1 = PX: PY1 = PY END IF END IF NEXT GET (0, 0)-(XRESOL - 1, YRESOL - 1), GRAPHICS A$ = "" WHILE A$ = "" A$ = INKEY$ WEND END SUB SUB PLOTPOINT (X(), Y(), N, SM) FOR I = 1 TO N CARTESIAN X(I), Y(I), PX, PY IF PY >= YMARGMIN AND PY <= YMARGMAX THEN IF PX >= XMARGMIN AND PX <= XMARGMAX THEN IF SM = 1 THEN CIRCLE (PX, PY), 2.25 ELSE PSET (PX, PY), 0 DRAW LETRA$(SM + 26) END IF END IF NEXT GET (0, 0)-(XRESOL - 1, YRESOL - 1), GRAPHICS A$ = "" WHILE A$ = "" A$ = INKEY$ WEND END SUB FUNCTION PRECISAO (X(), NP) MEDIA = 0 FOR I = 1 TO NP MEDIA = MEDIA + X(I) NEXT MEDIA = MEDIA / NP DP = 0 FOR I = 1 TO NP DP = DP + (X(I) - MEDIA) ^ 2 NEXT I DP = SQR(DP / (NP - 1)) PRECISAO = 1.96 * DP / SQR(NP) END FUNCTION SUB SHOWGRAPH SCREEN 11: PUT (0, 0), GRAPHICS, PSET A$ = "" WHILE A$ = "" A$ = INKEY$ WEND END SUB
***** End of Program Listing ******
Return to the Software Menu.
 |
Last Update: 15 December 1997 | |
| © Antonio Augusto Gorni |