Language: Excel/VisualBasic.
Objective: This spreadsheet calculates the evolution of temperature profile along the thickness of a rolling stock being rolled in a plate mill, including the influence of descaling and the broadsizing phase. A graphical output of the results is available. Input data can be changed according to the specific conditions of the user.
Click here to download the Excel file or use the Visual Basic for Applications listing below.
***** Begin of Program Listing *****
'
' CALCULATION OF THE THERMAL EVOLUTION OF STEEL FLATS DURING HOT ROLLING
'
' Semi-Finite Rolling Stock, Calculation Using the Method of Finite Diferences
' The calculation of the surface temperature considers:
' - Radiation
' - Convection from Descaling/Roll Cooling
' - Conduction for the Work Rolls
'
' Bibliographical References:
'
' - DEVADAS, C. et al.: "Heat Transfer during Hot Rolling of Steel Strip", Ironmaking and
' Steelmaking, 6, 1986, 311-321
'
' - KREITH, F.: "Princípios da Transmissão de Calor", Editora Edgard Blücher Ltda., 1977,
' pág. 144-164
'
' - SEREDYNSKI, F.: "Prediction of Plate Cooling during Rolling-Mill Operation", JISI,
' March 1973, 197-202
'
'
'
' Developed by:
' Antonio Augusto Gorni
' - GWBasic Version: 08.01.1992
' - Visual Basic Version: 25.05.2004
'
Option Explicit
Option Base 0
Const Pi = 3.1416
Dim i, iLine, iPasse, j, NroPasses, NroDivEsp, iTom As Integer
Dim Aux, C, E, Deltat_i, ST, DeltaT_SupNucl, Deltat_Reversao, TAgua, TCT As Single
Dim Deltat_AL, TMediaEsboco, DeltatRoll, Deltat_Stop, f01, f02, f03, dh As Single
Dim KAtual, CPAtual, RoAtual, VelCil, dx, Deltat_Max, Emissiv, EAnt, TExterna As Single
Dim Hi, Hf, Comprimento, Largura, RaioCT, TAmb, Deltat_Chegada, CoefAlarg As Single
Dim ForwardSlip, CoefDescPrim, CoefDescSec, CoefRefrCT, CoefCondCT As Single
Dim Deltat_DescPrim, Larg_DescPrim, Deltat_LCG, Larg_DescSec, Larg_RefrCT As Single
Dim Deltat_Rev, Sigma, VelDef, DeltaTEps, tFimPasse, Vel_DescPrim, H_Prime As Single
Dim VelPerif, tInicioPasse, Deform, NeoEAnt, NeoE, DeltatContato As Single
Dim DistDescLCG, DistRefrLCG, RPM, tFimPasseAnt, Deltat_Out, DeltaT_Adb As Single
Dim Deltat_Alarg As Single
Dim Evento, EventoPassado As String
Dim FlagAut, Descamacao, Descarep As Boolean
Dim iTM As Integer
Dim Tx(30) As Single, K(30) As Single, CP(30) As Single, Ro(30) As Single
Dim T(2, 50) As Single
Dim iLineDebug As Integer
Dim Aux1, Aux2 As Single
Dim FlagDebug, FirstDebug As Boolean
Dim Flag1, Flag2 As Boolean
Sub EvolTemp()
Application.ScreenUpdating = False
Sheets("Constantes").Select
TAmb = [H3]
TAgua = [H4]
TCT = [H5]
Emissiv = [H6]
CoefDescPrim = [H7]
CoefDescSec = [H8]
CoefRefrCT = [H9]
CoefCondCT = [H10]
Larg_DescPrim = [L3]
Vel_DescPrim = [L4]
DistDescLCG = [L5]
Larg_DescSec = [L6]
DistRefrLCG = [L7]
Larg_RefrCT = [L8]
Deltat_Rev = [L9]
Deltat_Alarg = [L10]
ForwardSlip = [L11]
CoefAlarg = 1
i = 5
Do While Cells(i, "A") <> ""
Tx(i - 5) = Cells(i, "A")
K(i - 5) = Cells(i, "B")
CP(i - 5) = Cells(i, "C")
Ro(i - 5) = Cells(i, "D")
i = i + 1
Loop
iTM = i - 6
Sheets("Esquema Passes").Select
Hi = [D4]
Largura = [D5]
Comprimento = [D6]
C = [D7]
RaioCT = [D8]
NroDivEsp = [H4]
Deltat_i = [H5]
Deltat_DescPrim = [H18]
If Cells(18, "D") = "YES" Then Descarep = True Else Descarep = False
TMediaEsboco = 0
For i = 0 To NroDivEsp / 2
T(0, i) = Cells(13, i + 1)
TMediaEsboco = TMediaEsboco + T(0, i)
Next i
TMediaEsboco = TMediaEsboco / (NroDivEsp / 2 + 1)
i = 19
If [F19] = "" Then FlagAut = True Else FlagAut = False
If FlagAut Then
Do While Cells(i, "B") <> ""
Hf = Cells(i, "B")
If Cells(i, "C") = "STA" Then
Aux = Comprimento
Comprimento = Largura
Largura = Aux
End If
Largura = CoefAlarg * Largura
Cells(i, "F") = Largura
Comprimento = Comprimento * Hi / Hf / CoefAlarg
If i = 19 Then Comprimento = Comprimento * 0.9
Cells(i, "G") = Comprimento
If i > 19 Then
Cells(i, "H") = Cells(i - 1, "H") + Cells(i - 1, "G") * 30 / (Pi * RaioCT * (Cells(i - 1, "E")) * ForwardSlip) + Cells(i, "G") * 30 / (Pi * RaioCT * (Cells(i, "E")) * ForwardSlip) + Deltat_Reversao
If Cells(i, "C") <> "" Then Cells(i, "H") = Cells(i, "H") + Deltat_Alarg
End If
Hi = Hf
If Cells(i, "C") = "END" Then
Aux = Comprimento
Comprimento = Largura
Largura = Aux
End If
i = i + 1
Loop
End If
NroPasses = 0
Do While Cells(NroPasses + 19, "B") <> ""
NroPasses = NroPasses + 1
Loop
Sheets("Evolução Térmica").Select
Range("C6:IV10").Select
Selection.ClearContents
Range("A8:IV65536").Select
Selection.ClearContents
For i = 0 To NroDivEsp / 2
Cells(6, i + 3) = i / NroDivEsp
Next i
Cells(6, NroDivEsp / 2 + 4) = "Média"
Cells(7, NroDivEsp / 2 + 4) = "[°C]"
Cells(2, "AH").Select
Selection.Copy
Cells(6, NroDivEsp / 2 + 5).Select
ActiveSheet.Paste
Cells(7, NroDivEsp / 2 + 5) = "[°C]"
Sheets("Tomografia").Select
Range("A4:G65536").Select
Selection.ClearContents
Sheets("Esquema Passes").Select
iPasse = 19
EAnt = [D4]
E = Cells(iPasse, "B")
If Cells(iPasse, "D") <> "" Then
Descamacao = True
Else
Descamacao = False
End If
RPM = Cells(iPasse, "E")
Comprimento = Cells(iPasse, "G")
VelPerif = 2 * Pi * RaioCT * RPM / 60
tInicioPasse = Cells(iPasse, "H")
tFimPasse = tInicioPasse + Sqr(RaioCT * (EAnt - E)) / VelPerif
tFimPasseAnt = tFimPasse
Deltat_Stop = Cells(NroPasses + 18, "H") + 30
iLine = 8
Deltat_AL = Deltat_i
Deltat_Out = 0
Flag1 = True
Flag2 = True
iTom = 4
For DeltatRoll = 0 To Deltat_Stop Step Deltat_AL
H_Prime = 0
Evento = ""
If Descarep And DeltatRoll >= Deltat_DescPrim And DeltatRoll <= Deltat_DescPrim + Larg_DescPrim / (Vel_DescPrim * 1000) Then
H_Prime = CoefDescPrim
Evento = "Desc Prim"
End If
If Descamacao And DeltatRoll >= tInicioPasse - DistDescLCG / VelPerif And DeltatRoll <= tInicioPasse - (DistDescLCG - Larg_DescSec) / VelPerif Then
H_Prime = CoefDescSec
Evento = "Desc Sec"
End If
If DeltatRoll >= tInicioPasse - DistRefrLCG / VelPerif And DeltatRoll <= tInicioPasse - (DistRefrLCG - Larg_RefrCT) / VelPerif Then
H_Prime = CoefRefrCT
Evento = "Refr CT"
End If
If DeltatRoll >= tInicioPasse And DeltatRoll <= tFimPasse Then
H_Prime = CoefCondCT
Evento = "Arco Contato"
End If
Sheets("Esquema Passes").Select
If DeltatRoll > tFimPasse And Cells(iPasse, "B") <> "" Then
Aux = RaioCT * Sin(ArCos(1 - (EAnt - E) / (2 * RaioCT)))
If ((EAnt + E) / 2 >= Aux) Then
NeoEAnt = Aux + (EAnt - E) / 2
NeoE = Aux - (EAnt - E) / 2
Else
NeoEAnt = EAnt
NeoE = E
End If
Deform = Log(NeoEAnt / NeoE)
VelDef = 0.1047197 * RPM * RaioCT * Sqr(1# / (RaioCT * (NeoEAnt - NeoE))) * Deform
Sigma = Exp(0.126 - 1.75 * C + 0.594 * C ^ 2 + (2851 + 2968 * C - 1120 * C ^ 2) / (TMediaEsboco + 273)) * Deform ^ 0.21 * VelDef ^ 0.13
For i = 0 To NroDivEsp / 2
dh = E - i * E / NroDivEsp
If dh >= E - (NeoEAnt - NeoE) / (2 * EAnt / E) Then
CPAtual = (Lagrange(Tx, CP, T(0, i), iTM))
RoAtual = (Lagrange(Tx, Ro, T(0, i), iTM))
DeltaT_Adb = Sigma * Log(NeoEAnt / NeoE) / (CPAtual * RoAtual) * 9.8 * 1000000#
Aux = T(0, i)
T(0, i) = T(0, i) + DeltaT_Adb
Evento = "Delta Q " & i
Tomografia
End If
Next i
Sheets("Esquema Passes").Select
iPasse = iPasse + 1
If Cells(iPasse, "B") <> "" Then
EAnt = E
E = Cells(iPasse, "B")
If Cells(iPasse, "D") <> "" Then
Descamacao = True
Else
Descamacao = False
End If
RPM = Cells(iPasse, "E")
Comprimento = Cells(iPasse, "G")
VelPerif = 2 * Pi * RaioCT * RPM / 60 * ForwardSlip
tInicioPasse = Cells(iPasse, "H")
tFimPasseAnt = tFimPasse
DeltatContato = Sqr(RaioCT * (EAnt - E)) / VelPerif
tFimPasse = tInicioPasse + DeltatContato
End If
End If
If iPasse > 19 And DeltatRoll >= tFimPasseAnt + DistRefrLCG / (VelPerif * ForwardSlip) And DeltatRoll <= tFimPasseAnt + (DistRefrLCG + Larg_RefrCT) / (VelPerif * ForwardSlip) Then
H_Prime = CoefRefrCT
Evento = "Refr CT"
End If
If H_Prime = 0 Then
H_Prime = Emissiv * 5.674 * (((T(0, 0) + 273) / 100) ^ 4 - ((TAmb + 273) / 100) ^ 4) / (T(0, 0) - TAmb)
Evento = "Ar"
End If
If DeltatRoll < tInicioPasse Then
dx = EAnt / NroDivEsp / 1000
Else
dx = E / NroDivEsp / 1000
End If
If Evento = "Ar" Then TExterna = TAmb
If Evento = "Desc Prim" Or Evento = "Desc Sec" Or Evento = "Refr CT" Then TExterna = TAgua
If Evento = "Arco Contato" Then TExterna = TCT
Tomografia
KAtual = Lagrange(Tx, K, T(0, 0), iTM)
CPAtual = Lagrange(Tx, CP, T(0, 0), iTM)
RoAtual = Lagrange(Tx, Ro, T(0, 0), iTM)
Deltat_Max = 0.5 * dx ^ 2 / (KAtual / CPAtual / RoAtual) / (1 + (H_Prime * dx / KAtual))
Do While Deltat_AL > Deltat_Max
DeltatRoll = DeltatRoll - Deltat_AL
Deltat_AL = Deltat_Max * 0.8
DeltatRoll = DeltatRoll + Deltat_AL
Deltat_Max = 0.5 * dx ^ 2 / (KAtual / CPAtual / RoAtual) / (1 + (H_Prime * dx / KAtual))
Loop
f01 = T(0, 0) * (1 - 2 * Deltat_AL / (CPAtual * RoAtual * dx) * (KAtual / dx + H_Prime))
f02 = 2 * H_Prime * Deltat_AL / (CPAtual * RoAtual * dx) * TExterna
f03 = 2 * KAtual * Deltat_AL / (CPAtual * RoAtual * dx ^ 2) * T(0, 1)
T(1, 0) = f01 + f02 + f03
ST = T(1, 0)
For j = 1 To NroDivEsp / 2 - 1
KAtual = (Lagrange(Tx, K, T(0, j), iTM))
CPAtual = (Lagrange(Tx, CP, T(0, j), iTM))
RoAtual = (Lagrange(Tx, Ro, T(0, j), iTM))
f01 = KAtual * Deltat_AL / (CPAtual * RoAtual * dx ^ 2) * T(0, j - 1)
f02 = (1 - 2 * KAtual * Deltat_AL / (CPAtual * RoAtual * dx ^ 2)) * T(0, j)
f03 = KAtual * Deltat_AL / (CPAtual * RoAtual * dx ^ 2) * T(0, j + 1)
T(1, j) = f01 + f02 + f03
ST = ST + T(1, j)
Next j
Aux1 = 2 * KAtual / (CPAtual * RoAtual * dx ^ 2)
Aux2 = 0
If FlagDebug And j = 1 Then
Sheets("Tomografia").Select
If FirstDebug Then
iLineDebug = 3
Range("A" & iLineDebug) = "t_Burn"
Range("B" & iLineDebug) = "TExterna"
Range("C" & iLineDebug) = "T(0, 1)"
Range("D" & iLineDebug) = "TF-T"
Range("E" & iLineDebug) = "Aux1"
Range("F" & iLineDebug) = "f01"
Range("G" & iLineDebug) = "f03"
Range("H" & iLineDebug) = "H_Prime"
Range("I" & iLineDebug) = "KAtual"
Range("J" & iLineDebug) = "CPAtual"
Range("K" & iLineDebug) = "RoAtual"
Range("L" & iLineDebug) = "dx"
iLineDebug = 2
FirstDebug = False
End If
Range("A" & iLineDebug) = DeltatRoll
Range("B" & iLineDebug) = TExterna
Range("C" & iLineDebug) = T(0, 1)
Range("D" & iLineDebug) = TExterna - T(0, 0)
Range("E" & iLineDebug) = Aux1
Range("F" & iLineDebug) = f01
Range("G" & iLineDebug) = f03
Range("H" & iLineDebug) = H_Prime
Range("I" & iLineDebug) = KAtual
Range("J" & iLineDebug) = CPAtual
Range("K" & iLineDebug) = RoAtual
Range("L" & iLineDebug) = dx
iLineDebug = iLineDebug + 1
Sheets("Perfil Térmico").Select
If DeltatRoll > 6000 Then End
End If
KAtual = Lagrange(Tx, K, T(0, NroDivEsp / 2), iTM)
CPAtual = Lagrange(Tx, CP, T(0, NroDivEsp / 2), iTM)
RoAtual = Lagrange(Tx, Ro, T(0, NroDivEsp / 2), iTM)
f01 = KAtual * Deltat_AL / (CPAtual * RoAtual * dx ^ 2) * T(0, NroDivEsp / 2 - 1)
f02 = (1 - 2 * KAtual * Deltat_AL / (CPAtual * RoAtual * dx ^ 2)) * T(0, NroDivEsp / 2)
T(1, NroDivEsp / 2) = 2 * f01 + f02
ST = ST + T(1, NroDivEsp / 2)
TMediaEsboco = ST / (NroDivEsp / 2 + 1)
DeltaT_SupNucl = T(1, 0) - T(1, NroDivEsp / 2)
For j = 0 To NroDivEsp / 2
T(0, j) = T(1, j)
Next j
Deltat_Out = Deltat_Out + Deltat_AL
If Deltat_Out >= 0.1 Then
Sheets("Evolução Térmica").Select
Cells(iLine, 1) = DeltatRoll
If DeltatRoll < tInicioPasse Then
Cells(iLine, 2) = EAnt
Else
Cells(iLine, 2) = E
End If
For i = 0 To NroDivEsp / 2
Cells(iLine, i + 3) = T(1, i)
Next i
Cells(iLine, NroDivEsp / 2 + 4) = TMediaEsboco
Cells(iLine, NroDivEsp / 2 + 5) = DeltaT_SupNucl
iLine = iLine + 1
Deltat_Out = 0
End If
Next DeltatRoll
Range("A3").Select
End Sub
Function ArCos(X As Single) As Single
ArCos = Atn(Sqr(1# - X * X) / X)
End Function
Function Lagrange(X() As Single, y() As Single, z As Single, n As Integer) As Single
Dim i, j As Integer
Dim c1, m, s As Single
Dim X1(10), Y1(10) As Single
i = 0
If z >= X(n) Then Lagrange = y(n): Exit Function
While z > X(i)
i = i + 1
Wend
If i < 2 Then
For j = 0 To 3
X1(j) = X(j): Y1(j) = y(j)
Next
Else
If i > n - 1 Then
c1 = n - 2
For j = -1 To 2
X1(j + 1) = X(c1 + j): Y1(j + 1) = y(c1 + j)
Next
Else
c1 = i - 1
For j = -1 To 2
X1(j + 1) = X(c1 + j): Y1(j + 1) = y(c1 + j)
Next
End If
End If
s = 0
For i = 0 To 3
m = 1
For j = 0 To 3
If j <> i Then m = m * (z - X1(j)) / (X1(i) - X1(j))
Next j
s = s + m * Y1(i)
Next i
Lagrange = s
End Function
Sub Tomografia()
If DeltatRoll = 0 Or Evento <> EventoPassado Then
Sheets("Tomografia").Select
Cells(iTom, "A") = iPasse - 18
Cells(iTom, "B") = DeltatRoll
Cells(iTom, "C") = Evento
Cells(iTom, "D") = TExterna
If Left(Evento, 7) = "Delta Q" Then
Cells(iTom, "E") = dh
Cells(iTom, "F") = Aux
Cells(iTom, "G") = DeltaT_Adb
End If
EventoPassado = Evento
iTom = iTom + 1#
End If
End Sub
***** End of Program Listing ******
Return to the Software Menu.
 |
Last Update: 28 August 2006 | |
| © Antonio Augusto Gorni |