# Hot Rolling Load, Torque and Power Determination

Languages: Fortran IV (Fist Version) or Excel/Visual Basic (Second Version).

Objective: Calculation of hot rolling load, torque, power and energy. The load is calculated according to the methods of Orowan, Sims, Ekelund, Orowan-Pascoe, Tselikov and Alexander-Ford.

***** Begin of FORTRAN Program Listing *****

```C
C ***
C ***          CALCULATION OF LOAD, TORQUE, POWER AND WORK IN THE
C ***                    HOT ROLLING OF STEEL FLATS
C ***
C ***
C ***   References:
C ***
C ***      - SILVA, A.M.S.: Analise do Processo de Laminacao a Quente;
C ***        CPGEM/UFMG; Belo Horizonte; 1978.
C ***
C ***      - BUCKLEY, G.W. et alii: Dynamic Analysis and Performance
C ***        of Hot Rolling Mills; Metals Technology; July 1978.
C ***
C ***      - PLAUT, R.L.: Laminacao dos Acos - Topicos Avancados;
C ***        Associacao Brasileira dos Metais; Sao Paulo; 1984.
C ***
C ***      - WUSATOWSKI, Z.: Fundamentals of Rolling; Pergamon Press;
C ***        Katowice; 1969.
C ***
C ***      - ROBERTS, W.L.: The Hot Rolling of Steel; Marcel Dekker
C ***        Inc.; New York; 1983.
C ***
C ***
C ***
C ***
C ***                Antonio Augusto Gorni - July 23, 1990
C ***
C
\$NOFLOATCALLS
\$STORAGE:2
\$DO66
\$INCLUDE:'FOREXEC.INC'
SUBROUTINE SPEAK(IMEM,VEC,N)
INTEGER*2 SYSTEM
DIMENSION VEC(1)
WRITE(*,2)IMEM
2 FORMAT(' ',A2)
DO 1 I=1,N,4
1 WRITE(*,*)VEC(I),VEC(I+1),VEC(I+2),VEC(I+3)
RETURN
END
C
C ***      FUNCAO ARCOS(X): Arco-cosseno de X, em radianos.
C
FUNCTION ARCOS(X)
ARCOS=ATAN(SQRT(1.-X*X)/X)
RETURN
END
C
C ***      FUNCAO FUN(X,Y,XK): Calculo da Tensao Horizontal para a
C ***                          Saida.
C
FUNCTION FUN(X,Y,XK)
COMMON HI,HF,D,RI,XM,TLAM,XKA(101)
TANG=SIN(X)/COS(X)
IF(X)1,1,2
1 YM=0.5
GOTO 3
2 YM=0.7853982*SIN(X)-0.5*((1./X)-1./TANG)*SIN(X)+0.5*COS(X)
3 A=HF+D*(1.-COS(X))
FUN=(Y*D/A)*SIN(X)+D*XK*YM
RETURN
END
C
C ***      FUNCAO FEN(X,Y,XK): Calculo da Tensao Horizontal para a
C
FUNCTION FEN(X,Y,XK)
COMMON HI,HF,D,RI,XM,TLAM,XKA(101)
A=HF+D*(1.-COS(X))
I=101.-IFIX(X*101./XM)
IF(I)4,4,5
4 I=1
5 XA=XKA(I)
Z=XM-X
TANG=SIN(Z)/COS(Z)
IF(Z)1,1,2
1 YM=-0.5
GOTO 3
2 YM=0.7853982*SIN(Z)+0.5*((1./Z)-1./TANG)*SIN(Z)-0.5*COS(Z)
3 FEN=(Y*D/A)*SIN(Z)+D*XA*YM
FEN=-FEN
RETURN
END
C
C ***      FUNCAO SUN(X,Y,XK): Calculo da Tensao Vertical para a
C ***                          Saida.
C
FUNCTION SUN(X,Y,XK)
COMMON HI,HF,D,RI,XM,TLAM,XKA(101)
A=HF+D*(1.-COS(X))
TANG=SIN(X)/COS(X)
IF(X)1,1,2
1 SUN=Y/A+XK*0.7853982
GOTO 3
2 SUN=Y/A+XK*0.7853982-0.5*((1./X)-1./TANG)*XK
3 RETURN
END
C
C ***      FUNCAO SEN(X,Y,XK): Calculo da Tensao Vertical para a
C
FUNCTION SEN(X,Y,XK)
COMMON HI,HF,D,RI,XM,TLAM,XKA(101)
A=HF+D*(1.-COS(X))
TANG=SIN(X)/COS(X)
IF(X)1,1,2
1 SEN=Y/A+XK*0.7853982
GOTO 3
2 SEN=Y/A+XK*0.7853982+0.5*((1./X)-1./TANG)*XK
3 RETURN
END
C
C ***      SUBROTINA QSF: Integracao de Pontos Discretos por Simpson.
C
SUBROUTINE QSF(H,Y,Z,NDIM)
DIMENSION Y(1),Z(1)
COMMON HI,HF,D,RI,XM,TLAM,XKA(101)
HT=.3333333*H
L1=1
L2=2
L3=3
L4=4
L5=5
L6=6
IF(NDIM-5)7,8,1
1 SUM1=Y(L2)+Y(L2)
SUM1=SUM1+SUM1
SUM1=HT*(Y(L1)+SUM1+Y(L3))
AUX1=Y(L4)+Y(L4)
AUX1=AUX1+AUX1
AUX1=SUM1+HT*(Y(L3)+AUX1+Y(L5))
AUX2=HT*(Y(L1)+3.875*(Y(L2)+Y(L5))+2.825*(Y(L3)+Y(L4))+Y(L6))
SUM2=Y(L5)+Y(L5)
SUM2=SUM2+SUM2
SUM2=AUX2-HT*(Y(L4)+SUM2+Y(L6))
Z(L1)=0.
AUX=Y(L3)+Y(L3)
AUX=AUX+AUX
Z(L2)=SUM2-HT*(Y(L2)+AUX+Y(L4))
Z(L3)=SUM1
Z(L4)=SUM2
IF(NDIM-6)5,5,2
2 DO 4 I=7,NDIM,2
SUM1=AUX1
SUM2=AUX2
AUX1=Y(I-1)+Y(I-1)
AUX1=AUX1+AUX1
AUX1=SUM1+HT*(Y(I-2)+AUX1+Y(I))
Z(I-2)=SUM1
IF(I-NDIM)3,6,6
3 AUX2=Y(I)+Y(I)
AUX2=AUX2+AUX2
AUX2=SUM2+HT*(Y(I-1)+AUX2+Y(I+1))
4 Z(I-1)=SUM2
5 Z(NDIM-1)=AUX1
Z(NDIM)=AUX2
RETURN
6 Z(NDIM-1)=SUM2
Z(NDIM)=AUX1
RETURN
7 IF(NDIM-3)12,11,8
8 SUM2=1.125*HT*(Y(L1)+Y(L2)+Y(L2)+Y(L2)+Y(L3)+Y(3)+Y(L3)+Y(L4))
SUM1=Y(L2)+Y(L2)
SUM1=SUM1+SUM1
SUM1=HT*(Y(L1)+SUM1+Y(L3))
Z(L1)=0.
AUX1=Y(L3)+Y(L3)
AUX1=AUX1+AUX1
Z(L2)=SUM2-HT*(Y(L2)+AUX1+Y(L4))
IF(NDIM-5)10,9,9
9 AUX1=Y(L4)+Y(L4)
AUX1=AUX1+AUX1
Z(L5)=SUM1+HT*(Y(L3)+AUX1+Y(L5))
10 Z(L3)=SUM1
Z(L4)=SUM2
RETURN
11 SUM1=HT*(1.25*Y(L1)+Y(L2)+Y(L2)-0.25*Y(L3))
SUM2=Y(L2)+Y(L2)
SUM2=SUM2+SUM2
Z(L3)=HT*(Y(L1)+SUM2+Y(L3))
Z(L1)=0.
Z(L2)=SUM1
12 RETURN
END
C
C ***      SUBROTINA RK(FUN,H,XI,YI,K,N,VEC): Resolucao de Equacao
C ***                  Diferencial pelo Metodo de Runge-Kutta.
C
SUBROUTINE RK(FUN,H,XI,YI,K,N,VEC)
DIMENSION VEC(1)
COMMON HI,HF,D,RI,XM,TLAM,XKA(101)
H2=H/2.
X=XI
Y=YI
DO 2 I=1,N
XK=XKA(I)
DO 1 J=1,K
T1=H*FUN(X,Y,XK)
T2=H*FUN(X+H2,Y+T1/2.,XK)
T3=H*FUN(X+H2,Y+T2/2.,XK)
T4=H*FUN(X+H,Y+T3,XK)
Y=Y+(T1+2.*T2+2.*T3+T4)/6.
1 X=X+H
VEC(I)=Y
2 CONTINUE
RETURN
END
C
C ***      PROGRAMA PRINCIPAL.
C
PROGRAM RCALC
LOGICAL FLAG,FLAG1,FLAG2
EXTERNAL FUN,FEN,SUN,SEN
INTEGER*2 SYSTEM
DIMENSION P(101),H(101),SS(101),SE(101),DEF(101),VD(101)
DIMENSION A(101),B(101),S(101),X(101),IBF(40)
DIMENSION CLE(7),HFD(7),TLI(7),TLF(7),TQE(7),VPER(7)
COMMON HI,HF,D,RI,XM,TLAM,XKA(101)
DATA VRE/6.0/,IBELL/7/,CFATR/0.01/,CTRANS/0.95/,RMOT/0.95/
OPEN(1,FILE='CON:')
OPEN(2,FILE='PRN:')
300 WRITE(*,1210)IBELL
IDUMMY=SYSTEM('CLS'C)
WRITE(*,189)
189 FORMAT(' CALCULATION OF HOT ROLLING LOAD, TORQUE AND POWER ',
>,///' IDENTIFICATION MESSAGE? ')
1000 FORMAT(40A2)
WRITE(*,1010)
1010 FORMAT(/,' HOT STRENGTH GRADE? ',\)
1205 FORMAT(A2)
WRITE(*,1050)
1050 FORMAT(/,' INITIAL THICKNESS (MM)? ',\)
WRITE(*,1070)
1070 FORMAT(/,' WORK ROLL DIAMETER (MM)? ',\)
WRITE(*,1080)
1080 FORMAT(/,' ROLLING STOCK WIDTH (MM)? ',\)
WRITE(*,1090)
1090 FORMAT(/,' ROLLING STOCK LENGTH (MM)? ',\)
WRITE(*,1100)
1100 FORMAT(/,' NUMBER OF ROLLING PASSES? ',\)
WRITE(*,1110)
1110 FORMAT(/,' ROLL GAP OF EACH PASS (MM)? ')
DO 1120 I=1,JC
WRITE(*,2000)I
2000 FORMAT(1X,'PASS NO. ',I2,' = ',\)
WRITE(*,1130)
1130 FORMAT(/,' INITIAL TEMPERATURES OF EACH PASS (.C)? ')
DO 1140 I=1,JC
WRITE(*,2000)I
WRITE(*,1150)
1150 FORMAT(/,' FINAL TEMPERATURES OF EACH PASS (.C)? ')
DO 1160 I=1,JC
WRITE(*,2000)I
WRITE(*,1170)
1170 FORMAT(/,' WORK ROLL PERIPHERICAL SPEED (M/MIN)? ')
DO 1180 I=1,JC
WRITE(*,2000)I
WRITE(*,3000)
3000 FORMAT(/,' DO YOU WANT CORRECTION BY HITCHCOCK (T/F)? ',\)
3010 FORMAT(L1)
WRITE(*,3146)
3146 FORMAT(/,' DO YOU WANT PRINTING OF THE RESULTS (T/F)? ',\)
IDUMMY=SYSTEM('CLS'C)
NA=100
NB=10
NN=0
Z=2.1517E-4
DA=D
R=D/2
RI=R
DO 30 KC=1,JC
HIO=HI
HF=HFD(KC)
CF=CI*HI/HF
RLA=RI*SIN(ARCOS(1.-(HI-HF)/(2.*RI)))
IF((HI+HF)/2..LT.RLA)GO TO 57
HI=RLA+(HI-HF)/2.
HF=RLA-(HIO-HF)/2.
C
C *** ANOTHER PATCH IN THE WALL!
C
WRITE(*,9845)HI,HF
9845 FORMAT(F9.2,F9.2)
57 RE=(HI-HF)/HI
TLAM=(TLI(KC)+TLF(KC))/2.
7 FACT=(1.-(HI-HF)/D)**2.
RPM=VPER(KC)/(6.28318E-3*RI)
XM=ATAN(SQRT((1.0/FACT)-1.0))
XITL=1./TLAM
KK=1
N=NA+1
STEP1=XM/(N*NB)
STEP2=STEP1*NB
X(1)=STEP2
IF(IRES.EQ.'MR')GOTO 4340
IF(IRES.EQ.'AR')GOTO 4341
TERM1=10.
GOTO 4342
4340 TERM1=11.1
4342 TERM2=12.231
TERM3=0.0025
TERM4=1.494
TERM5=0.174
TERM6=0.726
TERM7=0.139
GOTO 4345
4341 TERM1=11.9
TERM2=18.170
TERM3=0.0028
TERM4=1.516
TERM5=0.181
TERM6=0.750
TERM7=0.124
4345 DO 14 I=1,NA
14  X(I+1)=X(I)+STEP2
ICHAR='X'
CALL SPEAK(ICHAR,X,NA)
DO 15 I=1,N
H(I)=HF+2.*RI*(1.-COS(X(I)))
VD(I)=0.2094395*RPM*RI*SIN(X(I))/H(I)
DEF(I)=ALOG(HI/H(I))
IF(DEF(I).LE.0.)DEF(I)=0.01
XKA(I)=(TERM1*TERM2*
>EXP(-TERM3*TLAM)*TERM4*DEF(I)**TERM5*TERM6*VD(I)**TERM7)*1.155
C     IF(XKA(I)-VRE)42,42,15
C  42 XKA(I)=VRE
15 CONTINUE
ICHAR='H'
CALL SPEAK(ICHAR,H,N)
ICHAR='VD'
CALL SPEAK(ICHAR,VD,N)
ICHAR='DEF'
CALL SPEAK(ICHAR,DEF,N)
ICHAR='XKA'
CALL SPEAK(ICHAR,XKA,N)
C     JE=0
C     DO 32 I=1,N
C     IF(DEF(I)-50.)34,34,35
C  34 IF(VD(I)-1.5)35,35,32
C  35 JE=JE+1
C  32 CONTINUE
C     JF=JE+1
C     DO 33 I=1,JE
C  33 XKA(I)=XKA(JF)
REMED=0.67*ALOG(HI/HF)
VDMED=0.1047197*RPM*RI*SQRT(1./(RI*(HI-HF)))*ALOG(HI/HF)
XKMED=(TERM1*TERM2*
>EXP(-TERM3*TLAM)*TERM4*REMED**TERM5*TERM6*VDMED**TERM7)*1.155
ICHAR='**** XKMED ****'
WRITE(*,4859)ICHAR,XKMED
4859 FORMAT(' ',A30,F8.2)
XS=STEP1
FS=0.0
CALL RK(FUN,STEP1,XS,FS,NB,N,A)
XE=STEP1
FE=0.0
CALL RK(FEN,STEP1,XE,FE,NB,N,B)
DO 60 J=1,N
L=N-J+1
E=X(J)
XKB=XKA(J)
FSAI=A(J)
SS(J)=SUN(E,FSAI,XKB)
FENT=B(L)
SE(J)=SEN(E,FENT,XKB)
IF(SE(J)-SS(J))10,10,11
11 S(J)=SS(J)
GOTO 60
10 IF(KK-1)13,12,13
12 KK=KK+1
XN=X(J)
HN=H(J)
13 S(J)=SE(J)
60 CONTINUE
ICHAR='SS'
CALL SPEAK(ICHAR,SS,N)
ICHAR='SE'
CALL SPEAK(ICHAR,SE,N)
CALL QSF(STEP2,S,P,N)
ICHAR='P'
CALL SPEAK(ICHAR,P,N)
CL=P(N)*D/2.
QP=SQRT((1.-RE)/RE)*(1.5707965*ATAN(SQRT(RE/(1.-RE)))-SQRT
>(RI/HF)*ALOG(HN/HF)+0.5*SQRT(RI/HF)*ALOG(1./(1.-RE)))-0.7853982
CLS=XKMED*SQRT(RI*(HI-HF))*QP
QWP=(3.1415929+SQRT(RI*(HI-HF))/HF)/4.
PWP=XKMED*QWP*SQRT(RI*(HI-HF))
YMI=0.8*(1.05-0.0005*TLAM)*(1.15-0.26*ALOG(VPER(KC)/60.))
YQEK=1.+(1.6*YMI*SQRT(RI*(HI-HF))-1.2*(HI-HF))/(HI+HF)
PEK=XKMED*YQEK*SQRT(RI*(HI-HF))
DELTA=YMI*SQRT(4.*RI/(HI-HF))
RH=((1.+SQRT(1.+(DELTA**2.-1.)*(HI/HF)**DELTA))/(DELTA+1.))**(1./
>DELTA)
PTSEL=SQRT(RI*(HI-HF))*XKMED*2.*RH*HF/((HI-HF)*(DELTA-1.))*(RH**
>DELTA-1.)
PFORD=0.5*XKMED*SQRT(RI*(HI-HF))*(1.570796+SQRT(RI*(HI-HF))/(HI+
>HF))
T=XKMED*R*RI*((XM/2.)-XN)*2.
HP=T*RPM*1.0273E-6
WP=(T*9.81)/(RI*HN*COS(XN))
RA=RI
RN=R*(1.+(Z*CL)/(HI-HF))
RI=RN
D=2.*RN
NN=NN+1
KK=1
IF(FLAG1)GO TO 1246
IS=1
GO TO 1946
1246 IS=2
WRITE(*,1210)IBELL
WRITE(*,1295)
1295 FORMAT(//,' PREPARE PRINTER AND PRESS ENTER!')
1946 WRITE(*,1210)IBELL
WRITE(IS,101)
101 FORMAT(12X,' CALCULATION OF HOT ROLLING LOAD, TORQUE AND POWER',
>/)
IF(.NOT.FLAG1)GO TO 4698
WRITE(IS,9289)IBF
9289 FORMAT(31X,'VERSION IV, JULY 1990',//,31X,'ANTONIO AUGUSTO GORNI'
>,////,' ',40A2,////)
4698 IF(NN.LE.1)GOTO 130
WRITE(IS,140)
140 FORMAT(' === CORRECTION FOR NEW WORK ROLL RADIUS ACCORDING ',
>'TO HITCHCOCK ===',/)
130 WRITE(IS,211)IRES,HIO,HFD(KC)
211 FORMAT(' HOT STRENGTH GRADE: ',A2,/,' INITIAL THICKNESS (MM): ',
>F4.0,20X,'FINAL THICKNESS (MM): ',F4.0)
WRITE(IS,103)W,RA,VPER(KC),TLI(KC),TLF(KC)
103 FORMAT(' ROLLING STOCK WIDTH (MM): ',F5.0,/,' WORK ROLL RADIUS ',
>'(MM): ',F4.0,/,' WORK ROLL PERIPHERICAL SPEED (M/MIN): ',
>F5.1,/,' ROLLING STOCK ENTRY TEMPERATURE (.C): ',F5.0,/,' ROLLING ',
>'STOCK EXIT TEMPERATURE (.C): ',F5.0)
WRITE(IS,213)CI,CF
213 FORMAT(' INITIAL ROLLING STOCK LENGTH (MM): ',F8.2,/,
>' FINAL ROLLING STOCK LENGTH (MM): ',F8.2,///)
AUX1=W/1000.
CLORW=CL*AUX1
CLSIM=CLS*AUX1
CLEKE=PEK*AUX1
CLOPA=PWP*AUX1
CLTSE=PTSEL*AUX1
CLFORD=PFORD*AUX1
AUX1=9.E-4*SQRT(RI*(HI-HF))
TORW=T*W/1.E6
TSIM=CLSIM*AUX1
TEKE=CLEKE*AUX1
TOPA=CLOPA*AUX1
TOTSE=CLTSE*AUX1
TOFORD=XKMED/2.E6*W*RI*(HI-HF)*(1.6+0.91*SQRT(RI*(HI-HF))/(HI+HF))
ATRORW=CLORW*2.*RI*CFATR/1000.
TSIMT=CLSIM*2.*RI*CFATR/1000.+TSIM
TEKET=CLEKE*2.*RI*CFATR/1000.+TEKE
TOTAP=CLOPA*2.*RI*CFATR/1000.+TOPA
TOTSET=CLTSE*2.*RI*CFATR/1000.+TOTSE
TOFORT=CLFORD*2.*RI*CFATR/1000.+TOFORD
RENDTR=(1./CTRANS-1.)
ATRORW=(TORW+ATRORW)*RENDTR+ATRORW
TORWT=TORW+ATRORW
TSIMT=TSIMT*RENDTR+TSIMT
TEKET=TEKET*RENDTR+TEKET
TOTAP=TOTAP*RENDTR+TOTAP
TOTSET=TOTSET*RENDTR+TOTSET
TOFORT=TOFORT*RENDTR+TOFORT
AUX1=RPM*1.0439972
HPORW=(HP*W+ATRORW*AUX1)/RMOT
HPSIM=TSIMT*AUX1/RMOT
HPEKE=TEKET*AUX1/RMOT
HPOPA=TOTAP*AUX1/RMOT
HPTSE=TOTSET*AUX1/RMOT
HPFORD=TOFORT*AUX1/RMOT
AUX1=9.81E6*HI*CI/(RA*HN*COS(XN))
WORW=TORWT*AUX1
WSIM=TSIMT*AUX1
WEKE=TEKET*AUX1
WOPA=TOTAP*AUX1
WTSE=TOTSET*AUX1
WFORD=TOFORT*AUX1
IF(IS.NE.1)GO TO 5839
WRITE(*,1200)IBELL
1200 FORMAT(/,1X,A2,'PRESS ENTER TO CONTINUE. ')
1210 FORMAT(1X,A2)
5839 WRITE(IS,107)
107 FORMAT(' CALCULATION BY:',10X,'CALCULATION BY',
>' SIMS:',/)
WRITE(IS,108)CLORW,CLSIM,TORW,TSIM,TORWT,TSIMT,HPORW,HPSIM,WORW,WS
>IM
108 FORMAT(' CARGA TOTAL (T): ',F5.0,18X,'TOTAL LOAD (T): ',F5.0,/,
>' ROLLING TORQUE (T.M): ',F7.2,12X,'ROLLING TORQUE (T.M): ',F7.2,/,
>' TOTAL TORQUE (T.M): ',F7.2,13X,'TOTAL TORQUE (T.M): ',F7.2,/,
>' TOTAL POWER (KW): ',F6.0,12X,' TOTAL POWER (KW): ',F6.0,/,
>' TOTAL WORK (KJ): ',E9.3,10X,'TOTAL WORK (KJ): ',E9.3,
>//)
WRITE(IS,110)
110 FORMAT(//,' CALCULATION BY EKELUND:',9X,'CALCULATION BY ',
>'OROWAN-PASCOE:',/)
WRITE(IS,108)CLEKE,CLOPA,TEKE,TOPA,TEKET,TOTAP,HPEKE,HPOPA,WEKE,WO
>PA
WRITE(IS,120)
120 FORMAT(//,' CALCULATION BY TSELIKOV:',8X,'CALCULATION BY ',
>'ALEXANDER-FORD:',/)
WRITE(IS,108)CLTSE,CLFORD,TOTSE,TOFORD,TOTSET,TOFORT,HPTSE,HPFORD,
>WTSE,WFORD
WRITE(IS,2947)
2947 FORMAT(10X)
IF(IS.NE.1)GO TO 9387
WRITE(*,1200)IBELL
9387 IDUMMY=SYSTEM('CLS'C)
IF(NN.LE.1.AND.FLAG)GOTO 7
20 HI=HFD(KC)
CI=CF
RI=R
NN=0
30 CONTINUE
WRITE(*,9426)
9426 FORMAT(/,' DO YOU WANT TO CONTINUE (T/F)? ')
IF(FLAG2)GO TO 300
22 END
```

***** End of Program Listing ******

***** Begin of Program Listing *****

```'
'          PROGRAMA PARA CÁLCULO DA CARGA DE LAMINAÇÃO A QUENTE CONFORME OS MODELOS DE
'               OROWAN, SIMS, EKELUND, OROWAN-PASCOE, TSELIKOV E ALEXANDER-FORD
'
'
' Referências Bibliográficas Fundamentais:
'
' - SILVA, A.M.S. Análise do Processo de Laminação a Quente, CPGEM/UFMG, Belo Horizonte,
'   1978.
'
' - ROBERTS, W.L. The Hot Rolling of Steel, Marcel Dekker, Inc., New York, 1983.
'
' - WUSATOWSKI, Z. Fundamentals of Rolling, Pergamon Press, Katowice, 1969.
'
' - BUCKLEY, G.W. et al. Dynamic Analysis and Performance of Hot Rolling Mills, Metals
'   Technology, July 1978.
'
' - ANON. Automatisation du Préréglage des Trains Continus a Larges Bandes, Rapport Final
'   EUR 5712FR, IRSID/USINOR/Commission des Communautes Européenes, Septembre 1976.
'
' - PLAUT, R.L. Laminação dos Aços - Tópicos Avançados, Associação Brasileira de Metais,
'   São Paulo, 1984.
'
'
'
'                         Desenvolvido por Antonio Augusto Gorni
'                                    www.gorni.eng.br
'
'                       - Versão MBasic (TRS-80 III):   15.06.1984
'                       - Versão Fortran IV (IBM 4340): 22.09.1984
'                       - Versão Fortran 80 (CP/M):     10.07.1985
'                       - Versão Fortran 80 (IBM-PC):   23.10.1990
'                       - Versão GWBasic:               12.07.1992
'                       - Versão VisualBasic:           17.06.2004
'

Option Explicit
Option Base 1
Const Pi = 3.1415929

Dim a(101) As Single
Dim b(101) As Single
Dim C As Single
Dim CargaLQ(6) As Single
Dim CoefAtrito As Single
Dim Compr As Single
Dim D As Single
Dim Def(101) As Single
Dim DefConv As Single
Dim DefMed As Single
Dim EficMec As Single
Dim EficElec As Single
Dim FatorBracoAlav As Single
Dim H(101) As Single
Dim Hct As Single
Dim Hi As Single
Dim Hf As Single
Dim Hn As Single
Dim n As Integer
Dim nb As Integer
Dim NroPasses As Integer
Dim P(101) As Single
Dim PenetDef As Single
Dim Potencia(6) As Single
Dim R As Single
Dim Ri As Single
Dim RPM As Single
Dim S(101) As Single
Dim SE(101) As Single
Dim Sigma(101) As Single
Dim SigmaMed As Single
Dim SS(101) As Single
Dim Step1 As Single
Dim Step2 As Single
Dim TLam As Single
Dim TorqueLQ(6) As Single
Dim TorqueTotal(6) As Single
Dim Trabalho(6) As Single
Dim VelDef(101) As Single
Dim VelDefMed As Single
Dim W As Single
Dim X(101) As Single
Dim Xm As Single

Dim i, iP, j, kk, l, na, nn As Integer
Dim Da, Delta, Hio, Factor, Qek, Qp, Qwp, Rh, Xn As Single

Application.ScreenUpdating = False
na = 100
nb = 10
n = na + 1
Hi = [D4]
Hf = [D5]
W = [D6]
Compr = [D7]
TLam = [D8]
RPM = [D9]
D = [D10]
C = [I4]
FatorBracoAlav = [I5]
EficMec = [I6] / 100
EficElec = [I7] / 100
nn = 0
Da = D
R = D / 2
Ri = R
Hio = Hi
PenetDef = Ri * Sin(ArCos(1# - (Hi - Hf) / (2# * Ri)))
If (Hi + Hf) / 2 > PenetDef Then
Hi = PenetDef + (Hi - Hf) / 2#
Hf = PenetDef - (Hio - Hf) / 2#
End If
DefConv = (Hi - Hf) / Hi
TLam = TLam + 0.77 * 0.0000000566 * (TLam + 273) ^ 4 * Hi / (1000 * 6 * 26.4)
Factor = (1# - (Hi - Hf) / D) ^ 2#
Xm = Atn(Sqr((1# / Factor) - 1#))
kk = 1
Step1 = Xm / (n * nb)
Step2 = Step1 * nb
X(1) = Step2
For i = 1 To na
X(i + 1) = X(i) + Step2
Next i
For i = 1 To n
H(i) = Hf + 2# * Ri * (1# - Cos(X(i)))
Def(i) = Log(Hi / H(i))
If Def(i) < 0 Then Def(i) = 0
VelDef(i) = 0.2094395 * RPM * Ri * Sin(X(i)) / H(i)
Sigma(i) = 1.155 * Misaka(C, TLam, Def(i), VelDef(i))
Next i
DefMed = Log(Hi / Hf)
VelDefMed = 0.1047197 * RPM * Ri * Sqr(1# / (Ri * (Hi - Hf))) * Log(Hi / Hf)
SigmaMed = 1.155 * Misaka(C, TLam, DefMed, VelDefMed)
Call RungeKutta_Fun(Step1, Step1, 0, nb, n, a)
Call RungeKutta_Fen(Step1, Step1, 0, nb, n, b)
For j = 1 To n
l = n - j + 1
SS(j) = Sun(X(j), a(j), Sigma(j))
SE(j) = Sen(X(j), b(l), Sigma(j))
If SE(j) > SS(j) Then
S(j) = SS(j)
Else
If kk = 1 Then
kk = kk + 1
Xn = X(j)
Hn = H(j)
Else
S(j) = SE(j)
End If
End If
Next j
Call QSF(Step2, S, P, n)
CargaLQ(1) = P(n) * D / 2# * W / 1000
Qp = Sqr((1# - DefConv) / DefConv) * (1.5707965 * Atn(Sqr(DefConv / (1# - DefConv))) - _
Sqr(Ri / Hf) * Log(Hn / Hf) + 0.5 * Sqr(Ri / Hf) * Log(1# / (1# - DefConv))) - _
0.7853982
CargaLQ(2) = SigmaMed * Sqr(Ri * (Hi - Hf)) * Qp * W / 1000
Qwp = (Pi + Sqr(Ri * (Hi - Hf)) / Hf) / 4#
CargaLQ(3) = SigmaMed * Qwp * Sqr(Ri * (Hi - Hf)) * W / 1000
CoefAtrito = 0.8 * (1.05 - 0.0005 * TLam)
Qek = 1# + (1.6 * CoefAtrito * Sqr(Ri * (Hi - Hf)) - 1.2 * (Hi - Hf)) / (Hi + Hf)
CargaLQ(4) = SigmaMed * Qek * Sqr(Ri * (Hi - Hf)) * W / 1000
Delta = CoefAtrito * Sqr(4# * Ri / (Hi - Hf))
Rh = ((1# + Sqr(1# + (Delta ^ 2# - 1#) * (Hi / Hf) ^ Delta)) / (Delta + 1#)) ^ _
(1# / Delta)
CargaLQ(5) = Sqr(Ri * (Hi - Hf)) * SigmaMed * 2# * Rh * Hf / ((Hi - Hf) * _
(Delta - 1#)) * (Rh ^ Delta - 1#) * W / 1000
CargaLQ(6) = 0.5 * SigmaMed * Sqr(Ri * (Hi - Hf)) * (Pi / 2 + Sqr(Ri * _
(Hi - Hf)) / (Hi + Hf)) * W / 1000
TorqueLQ(1) = SigmaMed * R * Ri * ((Xm / 2#) - Xn) * 2# * W / 1000000
For j = 2 To 5
TorqueLQ(j) = 2 * CargaLQ(j) * FatorBracoAlav * Sqr(Ri * (Hi - Hf) / 1000000)
Next j
TorqueLQ(6) = SigmaMed / 2000000# * W * Ri * (Hi - Hf) * (1.6 + 0.91 * Sqr(Ri * (Hi - Hf)) / (Hi + Hf))
For j = 1 To 6
TorqueTotal(j) = TorqueLQ(j) / EficMec
Potencia(j) = TorqueTotal(j) * RPM * 1.02666 / EficElec
Trabalho(j) = TorqueTotal(j) * 9.81 * Hi * Compr / (Ri * Hn * Cos(Xn))
Next j
For j = 4 To 9
Cells(14, j) = CargaLQ(j - 3)
Cells(15, j) = TorqueLQ(j - 3)
Cells(16, j) = TorqueTotal(j - 3)
Cells(17, j) = Potencia(j - 3)
Cells(18, j) = Trabalho(j - 3)
Next j

End Sub

Function Misaka(C As Single, T As Single, Def As Single, VelDef As Single) As Single
Misaka = Exp(0.126 - 1.75 * C + 0.594 * C ^ 2 + (2851 + 2968 * C - 1120 * C ^ 2) / (T + 273)) * Def ^ 0.21 * VelDef ^ 0.13
End Function

Function ArCos(X As Single) As Single
ArCos = Atn(Sqr(1# - X * X) / X)
End Function

Function Fun(X As Single, Y As Single, XK As Single) As Single
Dim Tang, a, Ym As Single
Tang = Sin(X) / Cos(X)
If X <= 0 Then
Ym = 0.5
Else
Ym = 0.7853982 * Sin(X) - 0.5 * ((1# / X) - 1# / Tang) * Sin(X) + 0.5 * Cos(X)
End If
a = Hf + D * (1# - Cos(X))
Fun = (Y * D / a) * Sin(X) + D * XK * Ym
End Function

Function Fen(X As Single, Y As Single, XK As Single) As Single
Dim a, xa, z, Tang, Ym As Single
a = Hf + D * (1# - Cos(X))
i = 101# - Int(X * 101# / Xm)
If i <= 0 Then i = 1
xa = Sigma(i)
z = Xm - X
Tang = Sin(z) / Cos(z)
If z <= 0 Then
Ym = 0.5
Else
Ym = 0.7853982 * Sin(z) + 0.5 * ((1# / z) - 1# / Tang) * Sin(z) - 0.5 * Cos(z)
End If
Fen = (Y * D / a) * Sin(z) + D * xa * Ym
Fen = -Fen

End Function

Function Sun(X As Single, Y As Single, XK As Single) As Single
Dim a, Tang As Single
a = Hf + D * (1# - Cos(X))
Tang = Sin(X) / Cos(X)
If X <= 0 Then
Sun = Y / a + XK * 0.7853982
Else
Sun = Y / a + XK * 0.7853982 - 0.5 * ((1# / X) - 1# / Tang) * XK
End If
End Function

Function Sen(X As Single, Y As Single, XK As Single) As Single
Dim a, Tang As Single
a = Hf + D * (1# - Cos(X))
Tang = Sin(X) / Cos(X)
If X <= 0 Then
Sen = Y / a + XK * 0.7853982
Else
Sen = Y / a + XK * 0.7853982 + 0.5 * ((1# / X) - 1# / Tang) * XK
End If
End Function

Sub QSF(H As Single, Y() As Single, z() As Single, NDim As Integer)
Dim l1, l2, l3, l4, l5, l6 As Integer
Dim Ht, Sum1, Sum2, Aux, Aux1, Aux2 As Single
Ht = 0.3333333 * H
l1 = 1
l2 = 2
l3 = 3
l4 = 4
l5 = 5
l6 = 6
If NDim > 5 Then
Sum1 = Y(l2) + Y(l2)
Sum1 = Sum1 + Sum1
Sum1 = Ht * (Y(l1) + Sum1 + Y(l3))
Aux1 = Y(l4) + Y(l4)
Aux1 = Aux1 + Aux1
Aux1 = Sum1 + Ht * (Y(l3) + Aux1 + Y(l5))
Aux2 = Ht * (Y(l1) + 3.875 * (Y(l2) + Y(l5)) + 2.825 * (Y(l3) + Y(l4)) + Y(l6))
Sum2 = Y(l5) + Y(l5)
Sum2 = Sum2 + Sum2
Sum2 = Aux2 - Ht * (Y(l4) + Sum2 + Y(l6))
z(l1) = 0#
Aux = Y(l3) + Y(l3)
Aux = Aux + Aux
z(l2) = Sum2 - Ht * (Y(l2) + Aux + Y(l4))
z(l3) = Sum1
z(l4) = Sum2
If NDim > 6 Then
For i = 7 To NDim Step 2
Sum1 = Aux1
Sum2 = Aux2
Aux1 = Y(i - 1) + Y(i - 1)
Aux1 = Aux1 + Aux1
Aux1 = Sum1 + Ht * (Y(i - 2) + Aux1 + Y(i))
z(i - 2) = Sum1
If i < NDim Then
Aux2 = Y(i) + Y(i)
Aux2 = Aux2 + Aux2
Aux2 = Sum2 + Ht * (Y(i - 1) + Aux2 + Y(i + 1))
z(i - 1) = Sum2
Else
z(NDim - 1) = Sum2
z(NDim) = Aux1
Exit Sub
End If
Next i
End If
z(NDim - 1) = Aux1
z(NDim) = Aux2
Exit Sub
Else
If NDim > 3 Then
Sum2 = 1.125 * Ht * (Y(l1) + Y(l2) + Y(l2) + Y(l2) + Y(l3) + Y(3) + Y(l3) + Y(l4))
Sum1 = Y(l2) + Y(l2)
Sum1 = Sum1 + Sum1
Sum1 = Ht * (Y(l1) + Sum1 + Y(l3))
z(l1) = 0#
Aux1 = Y(l3) + Y(l3)
Aux1 = Aux1 + Aux1
z(l2) = Sum2 - Ht * (Y(l2) + Aux1 + Y(l4))
If NDim >= 5 Then
Aux1 = Y(l4) + Y(l4)
Aux1 = Aux1 + Aux1
z(l5) = Sum1 + Ht * (Y(l3) + Aux1 + Y(l5))
End If
z(l3) = Sum1
z(l4) = Sum2
Exit Sub
Else
If NDim = 3 Then
Sum1 = Ht * (1.25 * Y(l1) + Y(l2) + Y(l2) - 0.25 * Y(l3))
Sum2 = Y(l2) + Y(l2)
Sum2 = Sum2 + Sum2
z(l3) = Ht * (Y(l1) + Sum2 + Y(l3))
z(l1) = 0#
z(l2) = Sum1
End If
End If
End If
End Sub

Sub RungeKutta_Fun(H As Single, XI As Single, YI As Single, _
k As Integer, n As Integer, Vec() As Single)
Dim i, j As Integer
Dim X As Single
Dim Y As Single
Dim XK As Single
Dim h2, t1, t2, t3, t4 As Single
h2 = H / 2#
X = XI
Y = YI
For i = 1 To n
XK = Sigma(i)
For j = 1 To k
t1 = H * Fun(X, Y, XK)
t2 = H * Fun(X + h2, Y + t1 / 2#, XK)
t3 = H * Fun(X + h2, Y + t2 / 2#, XK)
t4 = H * Fun(X + H, Y + t3, XK)
Y = Y + (t1 + 2# * t2 + 2# * t3 + t4) / 6#
X = X + H
Next j
Vec(i) = Y
Next i
End Sub

Sub RungeKutta_Fen(H As Single, XI As Single, YI As Single, _
k As Integer, n As Integer, Vec() As Single)
Dim i, j As Integer
Dim X As Single
Dim Y As Single
Dim XK As Single
Dim h2, t1, t2, t3, t4 As Single
h2 = H / 2#
X = XI
Y = YI
For i = 1 To n
XK = Sigma(i)
For j = 1 To k
t1 = H * Fen(X, Y, XK)
t2 = H * Fen(X + h2, Y + t1 / 2#, XK)
t3 = H * Fen(X + h2, Y + t2 / 2#, XK)
t4 = H * Fen(X + H, Y + t3, XK)
Y = Y + (t1 + 2# * t2 + 2# * t3 + t4) / 6#
X = X + H
Next j
Vec(i) = Y
Next i
End Sub
```

***** End of Program Listing ******