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 original Sellars-Tegart equation.
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.
This program uses a Simplex method to fit the Sellars-Tegart equation, so it eventually can demand a lot of time to run. During the fitting process some explanatory messages will appear in the screen, so don't worry - the program must be running well! If, for some reason, you must to abort the fitting process, you only need to press any key in the keyboard.
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 SELLARS-TEGART ORIGINAL EXPRESSION REM *** StrainRate = A [sinh(Alpha SigmaMax)] ^ n exp[(Q / (RT)] REM REM REM *** Antonio Augusto Gorni --- September 25, 1995 REM REM REM *** Definition of Variables. REM 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 FUNCTION SINH (X) DECLARE SUB SIMPLEX (DT(), MI, NV, M, NP) DECLARE SUB LINEAR (ARGX(), YCALC(), NP, A, B) DECLARE SUB PEARSON (REAL(), CALC(), NP, R, EPE) DECLARE FUNCTION F () COMMON SHARED TEMP(), VELDEF(), DEFMAX(), SIGMAX(), NROTEMP, NROVEL, XX() COMMON SHARED NV, NROCAS, XXBACK(), FBACK, NEPER, PRECISAO 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), XX(20) DIM REAL(20), CALC(20), XXBACK(20), XDADO(5, 3), YCALC(5, 3) DIM XFUNC(20), YFUNC(20), ARGX(20) DIM LETRA$(125), GRAPHICS(9940) CLS PRECISAO = .0001: NEPER = LOG(10): FBACK = 9999 FOR I = 1 TO 5 FOR J = 1 TO 5 DT(I, J) = 0 NEXT J NEXT I 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 REM REM *** Data Input. REM 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 VIEW PRINT 4 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 + NROVEL + 3 XX(I) = 1 NEXT XX(NROTEMP + 1) = 4: XX(NROTEMP + NROVEL + 2) = 2: XX(NROTEMP + NROVEL + 3) = .01 REM REM *** First Step of Function Fitting. REM LOCATE 12 PRINT "Processing First Step of Function Fitting..." SIMPLEX DT(), 15000, 1, NROTEMP + NROVEL + 3, 1 FLAG1 = 0: CONTADOR = 1 REM REM *** Fits Function Until Reach Minimum Precision Convergence. REM DO WHILE FLAG1 = 0 FOR I = 1 TO NROTEMP + NROVEL + 3 XXBACK1(I) = XXBACK(I) XX(I) = XXBACK(I) NEXT FBACK1 = FBACK CONTADOR = CONTADOR + 1 CLS : LOCATE 11 PRINT "Processing Step "; CONTADOR; "of Function Fitting..." LOCATE 13 PRINT "Error: "; FBACK SIMPLEX DT(), 15000, 1, NROTEMP + NROVEL + 3, 1 IF FBACK1 = FBACK OR FBACK < PRECISAO THEN FLAG1 = 1 ELSE FBACK1 = FBACK LOOP FOR I = 1 TO NROTEMP + NROVEL + 3 IF FBACK1 > FBACK THEN XX(I) = XXBACK(I) ELSE XX(I) = XXBACK1(I): FBACK = FBACK1 END IF NEXT I IF FBACK1 < FBACK THEN FBACK = FBACK1 CLS : BEEP: LOCATE 5 REM REM *** Print Partial Relatory about the Graphics: REM *** . Log(Sinh(Alpha SigMax) x StrainRate REM *** . Log(Sinh(Alpha SigMax) x 1/T. REM FOR I = 1 TO NROTEMP + NROVEL + 3 IF I <= NROTEMP THEN PRINT "Intercept {T},"; I; " = "; XX(I) IF I = NROTEMP + 1 THEN PRINT "Slope {T} = "; XX(NROTEMP + 1): PRINT IF I > NROTEMP + 1 AND I < NROTEMP + NROVEL + 2 THEN PRINT "Intercept {StrainRate},"; I - NROTEMP - 1; " = "; XX(I) END IF IF I = NROTEMP + NROVEL + 2 THEN PRINT "Slope {StrainRate} = "; XX(NROTEMP + NROVEL + 2): PRINT END IF IF I = NROTEMP + NROVEL + 3 THEN PRINT "Alpha = "; XX(I) NEXT I LOCATE 23: INPUT "to Continue...", BF$ REM REM *** Prepares Data for Linear Regression. REM DECL1 = XX(NROTEMP + 1) NLINHA = DECL1 DECL2 = XX(NROTEMP + NROVEL + 2) ALFA = XX(NROTEMP + NROVEL + 3) FOR I = 1 TO NROCAS J = I MOD NROTEMP IF J = 0 THEN J = NROTEMP K = INT(I / NROTEMP) IF I MOD NROTEMP <> 0 THEN K = K + 1 ARGX(I) = LOG(SINH(ALFA * SIGMAX(I))) / NEPER XDADO(J, K) = ARGX(I) REAL(I) = LOG(VELDEF(I)) / NEPER CALC(I) = XX(J) + DECL1 * ARGX(I) YCALC(J, K) = CALC(I) NEXT I PEARSON REAL(), CALC(), NROCAS, R1, EPE1 REM REM *** Plots Graphic Log(Sinh(Alpha SigMax) x Log(Strain Rate). REM CLS CALL INITGRAPH FLAG1 = 0 BEEP DO WHILE FLAG1 = 0 NAXIS$ = "Graphic StrainRate versus Log[Sinh(Alpha * Sigmax)]" CALL INITAXIS(ARGX(), REAL(), NROCAS, NAXIS$) XA$ = "Log[Sinh(Alpha * SigMax)] - " + LEFT$(ACO$, LEN(ACO$) - 4) YA$ = "Log(StrRate) [1/s]" CALL AXIS CALL PLOTPOINT(ARGX(), REAL(), NROCAS, 1) FOR J = 1 TO NROTEMP FOR I = 1 TO NROVEL XFUNC(I) = XDADO(J, I) YFUNC(I) = YCALC(J, I) NEXT I CALL PLOTLINE(XFUNC(), YFUNC(), NROVEL) NEXT J FLAG2 = 0 DO WHILE FLAG2 = 0 CLS : SCREEN 0 BF$ = "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 REM REM *** Prepares Data for Linear Regression. REM FOR I = 1 TO NROCAS J = I MOD NROTEMP IF J = 0 THEN J = NROTEMP K = INT(I / NROTEMP) IF I MOD NROTEMP <> 0 THEN K = K + 1 ARGX(I) = 1000 / TEMP(I) XDADO(J, K) = ARGX(I) REAL(I) = LOG(SINH(ALFA * SIGMAX(I))) / NEPER CALC(I) = XX(NROTEMP + 1 + K) + DECL2 * ARGX(I) YCALC(J, K) = CALC(I) NEXT I PEARSON REAL(), CALC(), NROCAS, R2, EPE2 REM REM *** Plots Graphic Log(Sinh(Alpha SigMax) x Log(Strain Rate). REM CLS FLAG1 = 0 DO WHILE FLAG1 = 0 NAXIS$ = "Graphic Log[Sinh(Alpha * SigMax)] versus 1/T" CALL INITAXIS(ARGX(), REAL(), NROCAS, NAXIS$) XA$ = "1000 / T [1/K] - " + LEFT$(ACO$, LEN(ACO$) - 4) YA$ = "Log[Sinh(Alpha * SigMax)]" CALL AXIS CALL PLOTPOINT(ARGX(), REAL(), NROCAS, 1) FOR J = 1 TO NROVEL FOR I = 1 TO NROTEMP XFUNC(I) = XDADO(I, J) YFUNC(I) = YCALC(I, J) NEXT I CALL PLOTLINE(XFUNC(), YFUNC(), NROTEMP) NEXT J FLAG2 = 0 DO WHILE FLAG2 = 0 SCREEN 0 BF$ = "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 REM REM *** Prepares Data for Linear Regression. REM CLS : SCREEN 0 DELTAQ = 2.3 * 1.99 * DECL1 * DECL2 * 1000 FOR I = 1 TO NROCAS ARGX(I) = LOG(VELDEF(I) * EXP(DELTAQ / 1.99 / TEMP(I))) / NEPER REAL(I) = LOG(SINH(ALFA * SIGMAX(I))) / NEPER NEXT I LINEAR ARGX(), REAL(), NROCAS, A3, B3 FOR I = 1 TO NROCAS CALC(I) = A3 + B3 * ARGX(I) NEXT I PEARSON REAL(), CALC(), NROCAS, R3, EPE3 REM REM *** Plots Graphic Log(Z) x Log[Sinh(Alpha * SigMax)]. REM A = 10 ^ (-A3 / B3) CLS FLAG1 = 0 DO WHILE FLAG1 = 0 NAXIS$ = "Log(Z) versus Log(Sinh[Alpha * Sigmax)]" CALL INITAXIS(ARGX(), REAL(), NROCAS, NAXIS$) XA$ = "Log(Z) - " + LEFT$(ACO$, LEN(ACO$) - 4) YA$ = "Log[Sinh(Alpha * SigMax)]" CALL AXIS CALL PLOTPOINT(ARGX(), REAL(), NROCAS, 1) CALL PLOTLINE(ARGX(), CALC(), NROCAS) FLAG2 = 0 DO WHILE FLAG2 = 0 SCREEN 0 BF$ = "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 REM REM *** Screen Output of the Zener-Hollomon Equation Parameters. REM CLS LOCATE 5 PRINT LEFT$(ACO$, LEN(ACO$) - 4) PRINT : PRINT PRINT "Alpha = "; ALFA; "[1/MPa]" PRINT PRINT "n' = "; NLINHA; "[1/s]" PRINT PRINT "Delta Q = "; s; "[cal/mol] *** "; DELTAQ * .004186; "[kJ/mol]" PRINT PRINT "A = "; A; "[1/s]" PRINT PRINT "Average Pearson Coefficients:" PRINT R1, R2, R3 PRINT PRINT "Minimization Error: "; FBACK FLAG3 = 0 REM REM *** Printer Output of the Zener-Hollomon Equation Parameters. REM 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$ LPRINT "CALCULATION OF THE ZENER-HOLLOMON EQUATION PARAMETERS" LPRINT : LPRINT : LPRINT LPRINT LEFT$(ACO$, LEN(ACO$) - 4), DATE$, TIME$ LPRINT : LPRINT LPRINT "Alpha = "; ALFA; "[1/MPa]" LPRINT LPRINT "n' = "; NLINHA; "[1/s]" LPRINT LPRINT "Delta Q = "; DELTAQ; "[cal/mol] *** "; DELTAQ * .004186; "[kJ/mol]" LPRINT LPRINT "A = "; A; "[1/s]" LPRINT LPRINT "Average Pearson Coefficients:" LPRINT R1, R2, R3 LPRINT LPRINT "Minimization Error: "; FBACK LPRINT : LPRINT LPRINT "Additional Information:" LPRINT FOR I = 1 TO NROTEMP + NROVEL + 3 IF I <= NROTEMP THEN LPRINT "Intercept {T},"; I; " = "; XX(I) IF I = NROTEMP + 1 THEN LPRINT "Slope {T} = "; XX(NROTEMP + 1): LPRINT IF I > NROTEMP + 1 AND I < NROTEMP + NROVEL + 2 THEN LPRINT "Intercept {StrainRate},"; I - NROTEMP - 1; " = "; XX(I) END IF IF I = NROTEMP + NROVEL + 2 THEN LPRINT "Slope {StrainRate} = "; XX(NROTEMP + NROVEL + 2): LPRINT END IF NEXT I LPRINT CHR$(12) END IF IF BF$ = "N" OR BF$ = "n" THEN FLAG3 = 1 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 FUNCTION F ERRO1 = 0: ERRO2 = 0 FOR I = 1 TO NROCAS J = I MOD NROTEMP IF J = 0 THEN J = NROTEMP ERRO1 = ERRO1 + (LOG(VELDEF(I)) / NEPER - XX(J) - XX(NROTEMP + 1) * LOG(ABS(SINH(XX(NROTEMP + NROVEL + 3) * SIGMAX(I)))) / NEPER) ^ 2 NEXT I FOR I = 1 TO NROCAS K = INT(I / NROTEMP) IF I MOD NROTEMP <> 0 THEN K = K + 1 ERRO2 = ERRO2 + (LOG(ABS(SINH(XX(NROTEMP + NROVEL + 3) * SIGMAX(I)))) / NEPER - XX(NROTEMP + 1 + K) - XX(NROTEMP + NROVEL + 2) * 1000 / TEMP(I)) ^ 2 NEXT I AUX = SQR((ERRO1 + ERRO2) / NROCAS) IF AUX < FBACK THEN FBACK = AUX FOR I = 1 TO NROTEMP + NROVEL + 3 XXBACK(I) = XX(I) NEXT END IF F = AUX END FUNCTION 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) IF R > 1 THEN R = 1 / R 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 SUB SHOWGRAPH SCREEN 11: PUT (0, 0), GRAPHICS, PSET A$ = "" WHILE A$ = "" A$ = INKEY$ WEND END SUB SUB SIMPLEX (DT(), MI, NV, M, NP) REM REM *** SIMPLEX Subroutine: REM *** Function Fitting using the Simplex Algorithm. REM DIM ST(20), s(20, 20), MN(20), H(20), L(20), CT(20), EO(20), ME(20) DIM P(20), Q(20), NX(20), STALL(4) FOR I = 1 TO 4 STALL(I) = I * 1000 NEXT I N = M + 1: AL = 1: BE = .5: GA = 2 FOR I = 1 TO M s(1, I) = XX(I) ST(I) = ABS(s(1, I) / 10) NEXT FOR I = 1 TO N ME(I) = PRECISAO NEXT s(1, N) = 0 FOR I = 1 TO NP IK = I s(1, N) = s(1, N) + (F - DT(NV, I)) ^ 2 NEXT I FOR I = 1 TO M P(I) = ST(I) * (SQR(N) + M - 1) / (M * SQR(2)) Q(I) = ST(I) * (SQR(N) - 1) / (M * SQR(2)) NEXT I FOR I = 2 TO N FOR J = 1 TO M s(I, J) = s(1, J) + Q(J) NEXT J s(I, I - 1) = s(1, I - 1) + P(I - 1) s(I, N) = 0 FOR kJ = 1 TO M XX(kJ) = s(I, kJ) NEXT kJ FOR K = 1 TO NP IK = K s(I, N) = s(I, N) + (F - DT(NV, K)) ^ 2 NEXT K NEXT I FOR I = 1 TO N L(I) = 1: H(I) = 1 NEXT I FOR J = 1 TO N FOR I = 1 TO N IF s(I, J) < s(L(J), J) THEN L(J) = I IF s(I, J) > s(H(J), J) THEN H(J) = I NEXT I NEXT J NI = 0 FLAG = 1 DO WHILE FLAG = 1 AND NI < MI NI = NI + 1 ERRMED = 0 FOR I = 1 TO M + 1 ERRMED = ERRMED + EO(I) NEXT IF ERRMED = 0 THEN ERRMED = 9999 LOCATE 20 PRINT "Iteraction: "; NI; TAB(20); "Average Error: "; PRINT USING "##.#######"; ERRMED STALL((NI - 1) MOD 4 + 1) = ERRMED IF STALL(1) = STALL(3) AND STALL(2) = STALL(4) THEN EXIT SUB IF INKEY$ <> "" THEN LOCATE 22: INPUT "Do You Want to Terminate Fitting (Y/N)"; R$ IF R$ = "Y" OR R$ = "y" THEN EXIT SUB LOCATE 22: PRINT STRING$(70, " ") END IF FOR I = 1 TO N CT(I) = 0 NEXT I FOR I = 1 TO N IF I <> H(N) THEN FOR J = 1 TO M CT(J) = CT(J) + s(I, J) NEXT J END IF NEXT I FOR I = 1 TO N CT(I) = CT(I) / M NX(I) = (1 + AL) * CT(I) - AL * s(H(N), I) NEXT I NX(N) = 0 FOR J = 1 TO M XX(J) = NX(J) NEXT J FOR I = 1 TO NP IK = I: NX(N) = NX(N) + (F - DT(NV, I)) ^ 2 NEXT I IF NX(N) > s(L(N), N) THEN IF NX(N) <= s(H(N), N) THEN FOR I = 1 TO N s(H(N), I) = NX(I) NEXT I ELSE FOR I = 1 TO M NX(I) = BE * s(H(N), I) + (1 - BE) * CT(I) NEXT I NX(N) = 0 FOR J = 1 TO M XX(J) = NX(J) NEXT J FOR I = 1 TO NP IK = I: NX(N) = NX(N) + (F - DT(NV, I)) ^ 2 NEXT I IF NX(N) <= s(H(N), N) THEN FOR I = 1 TO N s(H(N), I) = NX(I) NEXT I ELSE FOR I = 1 TO N FOR J = 1 TO M s(I, J) = (s(I, J) + s(L(N), J)) * BE NEXT J s(I, N) = 0 FOR J = 1 TO M XX(J) = s(I, J) NEXT J FOR J = 1 TO NP IK = J s(I, N) = s(I, N) + (F - DT(NV, J)) ^ 2 NEXT J NEXT I END IF END IF ELSE FOR I = 1 TO N s(H(N), I) = NX(I) NEXT I FOR I = 1 TO M NX(I) = GA * s(H(N), I) + (1 - GA) * CT(I) NEXT I NX(N) = 0 FOR J = 1 TO M XX(J) = NX(J) NEXT J FOR I = 1 TO NP IK = I: NX(N) = NX(N) + (F - DT(NV, I)) ^ 2 NEXT I IF NX(N) <= s(L(N), N) THEN FOR I = 1 TO N: s(H(N), I) = NX(I): NEXT I END IF FOR J = 1 TO N FOR I = 1 TO N IF s(I, J) < s(L(J), J) THEN L(J) = I IF s(I, J) > s(H(J), J) THEN H(J) = I NEXT I NEXT J FLAG = 0 FOR J = 1 TO N EO(J) = (s(H(J), J) - s(L(J), J)) / s(H(J), J) IF ABS(EO(J)) > ABS(ME(J)) THEN FLAG = 1 NEXT J LOOP FOR I = 1 TO N MN(I) = 0 FOR J = 1 TO N MN(I) = MN(I) + s(J, I) NEXT J MN(I) = MN(I) / N NEXT I FOR I = 1 TO M XX(I) = MN(I) NEXT END SUB FUNCTION SINH (X) SINH = (EXP(X) - EXP(-X)) / 2 END FUNCTION
***** End of Program Listing ******
Return to the Software Menu.
 |
Last Update: 07 December 1997 | |
| © Antonio Augusto Gorni |