Determination of Activation Energy for Deformation


Version II: Using Sigma Transformed by Exponential Function


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