Fire response of structures

COMMON /CONTROL/ ITITLE(6),IREAD(80),NIN,NOUT,NPUNCH,NUMNP,NEL1D,N
    1EL2D,NEL3D,NUMEL,MBAND,NMAT,NFBC1D,NFBC2D,NFBC3D,NBCMAT,NBCTYP  
     COMMON /EXOTH/ NINT1D,NINT2D,NINT3D,NINT,NQINT                    
     COMMON C(10000)

'-----------------------------------------------------------------------------------------------
'                               VARIABILI GLOBALI
'-----------------------------------------------------------------------------------------------
'/CONTROL/
Dim ITITLE As String * 6    'Titolo del lavoro
Dim IREAD As String * 80    'variabile scratch per input output
Dim str_tmp As String       'variabile scratch per input
Dim NIN As Integer          'handle dispositivo di input
Dim NOUT As Integer         'handle dispositivo di output
Dim NUMNP As Integer        'number of nodal points
Dim NEL1D As Integer        'number of one-dimensional elements
Dim NEL2D As Integer        'number of two-dimensional elements
Dim NEL3D As Integer        'number of three-dimensional elements
Dim NUMEL As Integer        'NEL1D + NEL2D + NEL3D
Dim MBAND As Integer        'MAXIMUM BANDWIDTH OF CONDUCTIVITY MATRIX
Dim NMAT As Integer         'number of different material types
Dim NFBC1D As Integer       'number of one-dimensional surface nodes exposed to fire
Dim NFBC2D As Integer       'number of two-dimensional surface nodes exposed to fire
Dim NFBC3D As Integer       'number of three-dimensional surface nodes exposed to fire
Dim NBCMAT As Integer       'number of different surface material types
Enum Tipo_NBCTYP              'TYPE OF FIRE B.C. ("LINEAR BC " OR "NON-LIN BC")
   LINEAR_BC = 1
   NONLIN_BC = 2
End Enum
Dim NBCTYP As Tipo_NBCTYP

'/EXOTH/
Dim NINT1D As Integer       'number of one-dimensional elements with internal heat generation
Dim NINT2D As Integer       'number of two-dimensional elements with internal heat generation
Dim NINT3D As Integer       'number of three-dimensional elements with internal heat generation
Dim NINT As Integer         'NINT1D + NINT2D + NINT3D
Dim NQINT As Integer        'number of different heating functions

'/UNNAMED/
'dim C(10000) As Double     'buffer

Dim X() As Double          'X-coordinates of nodes
Dim Y() As Double          'Y-coordinates of nodes
Dim Z() As Double          'Z-coordinates of nodes
Enum Tipo_KODE           'Indicator for type of boundary condition FLOW or TEMPERATURE "FLOW" or "TEMP"
   FLOW = 1
   TEMP = 2
End Enum
Dim KODE() As Tipo_KODE

Dim ID() As Integer        'Intermediate storage needed in calculations
Dim D() As Double          'Intermediate storage needed in calculations
Dim MA() As Integer        'Intermediate storage needed in calculations
Dim T1() As Double         'Intermediate storage needed in calculations
Dim T2() As Double         'Intermediate storage needed in calculations
Dim T3() As Double         'Intermediate storage needed in calculations

Dim LM() As Integer        'Nodal points of elements
Dim MMTYPE() As Integer    'Material types of elements
Dim BAREA() As Double      'Cross-sectional areas of one-dimensional elements
Dim THICK() As Double      'Thickness of two-dimensional elements
Dim VOLUME() As Double     'Volumes of three-dimensional elements
Dim MATL() As Integer      'Control data for material properties

Type Tipo_XYS
   X As Double
   Y As Double
   S As Double
End Type

Dim XYS() As Tipo_XYS      'Storage for material properties

Dim MAT() As Integer       'Control data for fire B.C. properties

Dim FXYS() As Tipo_XYS     'Fire B.C. properties

Dim LI() As Integer        'Nodes bounding surface segments for fire B.C.
Dim LJ() As Integer        'Nodes bounding surface segments for fire B.C.
Dim LK() As Integer        'Nodes bounding surface segments for fire B.C.
Dim LL() As Integer        'Nodes bounding surface segments for fire B.C.
Dim LMAT() As Integer      'Fire boundary type
Dim LFIRE() As Integer     'Fire number
Dim AIJKL() As Double      'Area of surface segment
Dim LELEM() As Integer     'Element bounding surface segment
Dim IEXO() As Integer      'Control data for internal heat generation curves

Dim EXYS() As Tipo_XYS     'Internal heat generation curves

Dim IEL() As Integer       'Elements with internal heating
Dim IMAT() As Integer      'Heating curve for each element
Dim VEL() As Double        'Volume of each element
Dim Q() As Double          'Heat flow vector
Dim T() As Double          'Temperature vector
Dim B() As Double          'Loading vector used in analysis
Dim AT() As Double         'Element temperatures
Dim A() As Double          'Effective conductivity matrix

'/CONRG/
Dim NCONV As Integer
Dim CONV As Double
Dim BETA As Double
Dim NCONU As Integer
Dim CONU As Double
Dim ALPHA As Double

'/SURFACE/
Dim NS1 As Integer
Dim NS2 As Integer
Dim NS3 As Integer

'Percorso e nome file .dat .out .TAPE6
Const percorso As String = "C:\Calcolo_Mappa_Termica\"
Const nomefile As String = "Colonne"

SUBROUTINE ELEMENT (X,Y,Z,LM,MMTYPE,BAREA,THICK,VOLUME)
................

Private Sub ELEMENT(X() As Double, Y() As Double, Z() As Double, LM() As Integer, _
                   MMTYPE() As Integer, BAREA() As Double, THICK() As Double, VOLUME() As Double)
'
'
'     SUBROUTINE *ELEMENT* INPUTS ELEMENT DATA
'
'
     'COMMON /CONTROL/ ITITLE(6),IREAD(80),NIN,NOUT,NPUNCH,NUMNP,NEL1D,
     'NEL2D,NEL3D,NUMEL,MBAND,NMAT,NFBC1D,NFBC2D,NFBC3D,NBCMAT,NBCTYP
     'DIMENSION X(1), Y(1), Z(1), LM(1), KX(8), MMTYPE(1), BAREA(1), THICK(1), VOLUME(1)
     'DIMENSION SI(8), TI(8), UI(8), XX(8), YY(8), ZZ(8), B(3, 8), PSTU(8), DPSTU(3, 8), CJAC(3, 3), POS(2)
     'DATA POS/-0.57735027,+0.57735027/
     'DATA SI/-1.,1.,1.,-1.,-1.,1.,1.,-1./
     'DATA TI/-1.,-1.,1.,1.,-1.,-1.,1.,1./
     'DATA UI/-1.,-1.,-1.,-1.,1.,1.,1.,1./

   Dim KX(8) As Integer
   Dim SI(8) As Double
   Dim TI(8) As Double
   Dim UI(8) As Double
   Dim XX(8) As Double
   Dim YY(8) As Double
   Dim ZZ(8) As Double
   Dim B(3, 8) As Double
   Dim PSTU(8) As Double
   Dim DPSTU(3, 8) As Double
   Dim CJAC(3, 3) As Double
   Dim POS(2) As Double
   'POS(1) = -0.57735027: POS(2) = 0.57735027
   POS(1) = -1# / Sqr(3#): POS(2) = 1# / Sqr(3#)
   SI(1) = -1#: SI(2) = 1#: SI(3) = 1#: SI(4) = -1#: SI(5) = -1#: SI(6) = 1#: SI(7) = 1#: SI(8) = -1#
   TI(1) = -1#: TI(2) = -1#: TI(3) = 1#: TI(4) = 1#: TI(5) = -1#: TI(6) = -1#: TI(7) = 1#: TI(8) = 1#
   UI(1) = -1#: UI(2) = -1#: UI(3) = -1#: UI(4) = -1#: UI(5) = 1#: UI(6) = 1#: UI(7) = 1#: UI(8) = 1#
'
'
'     O N E - D I M E N S I O N A L   E L E M E N T S
'
'
    MBAND = 0
    If NEL1D = 0 Then GoTo lab80
    Dim NLM As Integer
    Dim NUM As Integer
    NLM = 0
    NUM = 0
    Print #NOUT, ""
    Print #NOUT, ""
    Print #NOUT, ""
    Print #NOUT, "  . . . . THERE ARE ", NEL1D; "  1-D ELEMENTS . . . . "
    Print #NOUT, ""
    Print #NOUT, ""
    Print #NOUT, " ELMT    I    J  MAT      AREA"
    Print #NOUT, ""
    Dim N As Integer
    For N = 1 To NEL1D
       NLM = NLM + 2
       Select Case (NUM - N)
           Case Is < 0
               GoTo lab10
           Case Is = 0
               GoTo lab20
           Case Is > 0
               GoTo lab20
       End Select
'
'     READ ELEMENT CARD
'
lab10:
       Dim MTIPE As Integer
       Dim BA As Double
       
       '---------------------------------------------
       ' One-Dimensional Element Cards (4I5, F10.0)
       '---------------------------------------------
       Line Input #NIN, str_tmp
       NUM = Val(Mid$(str_tmp, 1, 5))          'Element Number NUM>1 and NUM<=NEL1D
       KX(1) = Val(Mid$(str_tmp, 6, 5))        'Nodal point I
       KX(2) = Val(Mid$(str_tmp, 11, 5))       'Nodal point J
       MTIPE = Val(Mid$(str_tmp, 16, 5))       'Material identification number
       BA = Val(Mid$(str_tmp, 21, 10))         'Cross-sectional area of one-dimensional element
       
       If BA = 0# Then BA = 1#
       If NUM > NEL1D Then GoTo lab40
       If N = 1 Then GoTo lab30
'
'     GENERATE LM ARRAY
'
lab20:
       LM(NLM - 1) = LM(NLM - 3) + 1
       LM(NLM) = LM(NLM - 2) + 1
       MMTYPE(N) = MMTYPE(N - 1)
       BAREA(N) = BAREA(N - 1)
lab30:
       Select Case (NUM - N)
           Case Is < 0
               GoTo lab40
           Case Is = 0
               GoTo lab50
           Case Is > 0
               GoTo lab60
       End Select
'
'     ERROR IN INPUT CARDS
'
lab40:
       Print #NOUT, ""
       Print #NOUT, ""
       Print #NOUT, " ERROR IN EL INPUT  "
       Print #NOUT, ""
       Print #NOUT, ""
       Print #NOUT, NUM, KX(1), KX(2), MTIPE, BA
       Close #NIN
       Close #NOUT
       End '<<<<<<<<
   
lab50:
       LM(NLM - 1) = KX(1)
       LM(NLM) = KX(2)
       MMTYPE(N) = MTIPE
       BAREA(N) = BA
'
'     OUTPUT
'
lab60:
       Print #NOUT, N, LM(NLM - 1), LM(NLM), MMTYPE(N), BAREA(N)
'
'     DETERMINE BANDWIDTH AND STORE IF MAXIMUM
'
       Dim J As Integer
       Dim K As Integer
       J = LM(NLM - 1) - LM(NLM) + 1
       K = LM(NLM) - LM(NLM - 1) + 1
       If J > MBAND Then MBAND = J
       If K > MBAND Then MBAND = K
   
   Next N
   
'
'
'     T W O - D I M E N S I O N A L   E L E M E N T S
'
'
lab80:
    If NEL2D = 0 Then GoTo lab180
    NLM = 2 * NEL1D
    NUM = 0
    Print #NOUT, ""
    Print #NOUT, ""
    Print #NOUT, ""
    Print #NOUT, "  . . . . THERE ARE ", NEL2D; "  2-D ELEMENTS . . . . "
    Print #NOUT, ""
    Print #NOUT, ""
    Print #NOUT, " ELMT    I    J    K    L  MAT      THICKNESS"
    Print #NOUT, ""
    For N = 1 To NEL2D
       Dim N1 As Integer
       N1 = N + NEL1D
       NLM = NLM + 4
       Select Case (NUM - N)
           Case Is < 0
               GoTo lab90
           Case Is = 0
               GoTo lab100
           Case Is > 0
               GoTo lab100
       End Select
'
'     READ ELEMENT CARD
'
lab90:
       Dim THK As Double
       
       '---------------------------------------------
       ' Two-Dimensional Element Cards (6I5, F10.0)
       '---------------------------------------------
       Line Input #NIN, str_tmp
       NUM = Val(Mid$(str_tmp, 1, 5))          'Element Number NUM>1 and NUM<=NEL2D
       KX(1) = Val(Mid$(str_tmp, 6, 5))        'Nodal point I
       KX(2) = Val(Mid$(str_tmp, 11, 5))       'Nodal point J
       KX(3) = Val(Mid$(str_tmp, 16, 5))       'Nodal point K
       KX(4) = Val(Mid$(str_tmp, 21, 5))       'Nodal point L
       MTIPE = Val(Mid$(str_tmp, 26, 5))       'Material Identification Number
       THK = Val(Mid$(str_tmp, 31, 10))        'Thickness of two-dimensional element
                                               'IF THK=0.0 THEN THK=1.0 (default used)

       If THK = 0# Then THK = 1#
       If NUM > NEL2D Then GoTo lab120
       If N = 1 Then GoTo lab110
'
'     GENERATE LM ARRAY
'
lab100:
       LM(NLM - 3) = LM(NLM - 7) + 1
       LM(NLM - 2) = LM(NLM - 6) + 1
       LM(NLM - 1) = LM(NLM - 5) + 1
       LM(NLM) = LM(NLM - 4) + 1
       MMTYPE(N1) = MMTYPE(N1 - 1)
       THICK(N) = THICK(N - 1)

lab110:
       Select Case (NUM - N)
           Case Is < 0
               GoTo lab120
           Case Is = 0
               GoTo lab130
           Case Is > 0
               GoTo lab140
       End Select
'
'     ERROR IN INPUT CARD
'
lab120:
       Print #NOUT, ""
       Print #NOUT, ""
       Print #NOUT, " ERROR IN EL INPUT  "
       Print #NOUT, ""
       Print #NOUT, ""
       Print #NOUT, NUM, KX(1), KX(2), KX(3), KX(4), MTIPE, THK
       Close #NIN
       Close #NOUT
       End '<<<<<<<<
                                                                     
lab130:
       LM(NLM - 3) = KX(1)
       LM(NLM - 2) = KX(2)
       LM(NLM - 1) = KX(3)
       LM(NLM) = KX(4)
       MMTYPE(N1) = MTIPE
       THICK(N) = THK
'
'     OUTPUT
'
lab140:
       Print #NOUT, N, LM(NLM - 3), LM(NLM - 2), LM(NLM - 1), LM(NLM), MMTYPE(N1), THICK(N)
'
'     DETERMINE BANDWIDTH AND STORE IF MAXIMUM
'
       Dim L As Integer
       Dim M As Integer
       Dim I As Integer
       For L = 1 To 4
           I = LM(NLM - 4 + L)
           For M = 1 To 4
               J = LM(NLM - 4 + M) - I + 1
               Select Case (MBAND - J)
                   Case Is < 0
                       GoTo lab150
                   Case Is = 0
                       GoTo lab160
                   Case Is > 0
                       GoTo lab160
               End Select
lab150:
               MBAND = J
lab160:
           Next M
       Next L
   Next N
   
'
'
'     T H R E E - D I M E N S I O N A L   E L E M E N T S
'
'
lab180:
     If NEL3D = 0 Then GoTo lab350
     
     'REWIND 6
     Dim TAPE6 As Integer
     TAPE6 = FreeFile
     Open percorso + nomefile + ".TAPE6" For Output As TAPE6
     
     NLM = 2 * NEL1D + 4 * NEL2D
     NUM = 0
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "  . . . . THERE ARE ", NEL3D; "  3-D ELEMENTS . . . . "
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " ELMT    I    J    K    L    M    N    O    P  MAT     "
     Print #NOUT, ""
     For N = 1 To NEL3D
       N1 = N + NEL1D + NEL2D
       NLM = NLM + 8
       Select Case (NUM - N)
           Case Is < 0
               GoTo lab190
           Case Is = 0
               GoTo lab200
           Case Is > 0
               GoTo lab200
       End Select
'
'     READ ELEMENT CARD
'
lab190:
       '---------------------------------------------
       ' Three-Dimensional Element Cards (10I5)
       '---------------------------------------------
       Line Input #NIN, str_tmp
       NUM = Val(Mid$(str_tmp, 1, 5))          'Element Number NUM>1 and NUM<=NEL2D
       KX(1) = Val(Mid$(str_tmp, 6, 5))        'Nodal point I
       KX(2) = Val(Mid$(str_tmp, 11, 5))       'Nodal point J
       KX(3) = Val(Mid$(str_tmp, 16, 5))       'Nodal point K
       KX(4) = Val(Mid$(str_tmp, 21, 5))       'Nodal point L
       KX(5) = Val(Mid$(str_tmp, 26, 5))       'Nodal point M
       KX(6) = Val(Mid$(str_tmp, 31, 5))       'Nodal point N
       KX(7) = Val(Mid$(str_tmp, 36, 5))       'Nodal point O
       KX(8) = Val(Mid$(str_tmp, 41, 5))       'Nodal point P
       MTIPE = Val(Mid$(str_tmp, 46, 5))       'Material identification number
       
       If NUM > NEL3D Then GoTo lab230
       If N = 1 Then GoTo lab220
'
'     GENERATE LM ARRAY FOR MISSING ELEMENTS
'
lab200:
     For I = 1 To 8
       LM(NLM - 8 + I) = LM(NLM - 16 + I) + 1
     Next I
       MMTYPE(N1) = MMTYPE(N1 - 1)
lab220:
       Select Case (NUM - N)
           Case Is < 0
               GoTo lab230
           Case Is = 0
               GoTo lab240
           Case Is > 0
               GoTo lab260
       End Select
'
'     ERROR IN INPUT CARDS
'
lab230:
       Print #NOUT, ""
       Print #NOUT, ""
       Print #NOUT, " ERROR IN EL INPUT  "
       Print #NOUT, ""
       Print #NOUT, ""
       Print #NOUT, NUM, KX(1), KX(2), KX(3), KX(4), KX(5), KX(6), KX(7), KX(8), MTIPE
       Close #TAPE6
       Close #NIN
       Close #NOUT
       End '<<<<<<<<
'
lab240:
       For I = 1 To 8
           LM(NLM - 8 + I) = KX(I)
       Next I
       MMTYPE(N1) = MTIPE
'
'     OUTPUT
'
lab260:
       Print #NOUT, N,
           For I = 1 To 8
               Print #NOUT, LM(NLM - 8 + I),
           Next I
       Print #NOUT, MMTYPE(N1)
'
'     DETERMINE BANDWIDTH AND STORE IF MAXIMUM
'
       For L = 1 To 8
           I = LM(NLM - 8 + L)
           For M = 1 To 8
               J = LM(NLM - 8 + M) - I + 1
               Select Case (MBAND - J)
                   Case Is < 0
                       GoTo lab270
                   Case Is = 0
                       GoTo lab280
                   Case Is > 0
                       GoTo lab280
               End Select
lab270:
               MBAND = J
lab280:
           Next M
       Next L
'
'     CALCULATE ELEMENT DATA NEEDED LATER IN ANALYSIS AND STORE ON
'     TAPE 6
'
       For I = 1 To 8
           J = LM(NLM - 8 + I)
           XX(I) = X(J)
           YY(I) = Y(J)
           ZZ(I) = Z(J)
       Next I
lab290:
       Dim VOL As Double
       Dim III As Integer
       Dim JJJ As Integer
       Dim KKK As Integer
       VOL = 0#
       For III = 1 To 2
           For JJJ = 1 To 2
               For KKK = 1 To 2
                   Dim SE As Double
                   Dim TE As Double
                   Dim UE As Double
                   SE = POS(III)
                   TE = POS(JJJ)
                   UE = POS(KKK)
                   For I = 1 To 8
                       PSTU(I) = (1# + SE * SI(I)) * (1# + TE * TI(I)) * (1# + UE * UI(I)) / 8#
                       DPSTU(1, I) = SI(I) * (1# + TE * TI(I)) * (1# + UE * UI(I)) / 8#
                       DPSTU(2, I) = TI(I) * (1# + SE * SI(I)) * (1# + UE * UI(I)) / 8#
                       DPSTU(3, I) = UI(I) * (1# + SE * SI(I)) * (1# + TE * TI(I)) / 8#
                   Next I
lab300:
                   For I = 1 To 3
                       CJAC(I, 1) = 0#
                       CJAC(I, 2) = 0#
                       CJAC(I, 3) = 0#
                       For J = 1 To 8
                           CJAC(I, 1) = CJAC(I, 1) + DPSTU(I, J) * XX(J)
                           CJAC(I, 2) = CJAC(I, 2) + DPSTU(I, J) * YY(J)
                           CJAC(I, 3) = CJAC(I, 3) + DPSTU(I, J) * ZZ(J)
                       Next J
                   Next I
                   
                   Dim DETJ As Double
                   Call INVMAT(CJAC(), DETJ, 3)
                   VOL = VOL + DETJ
                   For I = 1 To 3
                       For J = 1 To 8
                           B(I, J) = 0#
                           For K = 1 To 3
                                  B(I, J) = B(I, J) + CJAC(I, K) * DPSTU(K, J)
                           Next K
                       Next J
                   Next I
                   
                   Print #TAPE6, DETJ,
                   For I = 1 To 8
                       Print #TAPE6, PSTU(I),
                   Next I
                   Print #TAPE6, ""
                   For J = 1 To 8
                       For I = 1 To 3
                           Print #TAPE6, B(I, J),
                       Next I
                       Print #TAPE6, ""
                   Next J
                   'Print #TAPE6, ""

               Next KKK
           Next JJJ
       Next III
       VOLUME(N) = VOL
   Next N
   Close #TAPE6
'
'
'     PRINT THE MAXIMUM BANDWIDTH
'
'
lab350:
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, "    . . . MAXIMUM BANDWIDTH IS "; MBAND; " . . ."
     
'
'
'
'

End Sub

C                                                                      
C     DETERMINE BANDWIDTH AND STORE IF MAXIMUM                          
C                                                                      
     DO 280 L=1,8                                                      
     I=LM(NLM-8+L)                                                    
     DO 280 M=1,8                                                      
     J=LM(NLM-8+M)-I+1                                                
     IF (MBAND-J) 270,280,280                                          
 270 MBAND=J                                                          
 280 CONTINUE

'
'     DETERMINE BANDWIDTH AND STORE IF MAXIMUM
'
       For L = 1 To 8
           I = LM(NLM - 8 + L)
           For M = 1 To 8
               J = LM(NLM - 8 + M) - I + 1
               Select Case (MBAND - J)
                   Case Is < 0
                       GoTo lab270
                   Case Is = 0
                       GoTo lab280
                   Case Is > 0
                       GoTo lab280
               End Select
lab270:
               MBAND = J
lab280:
           Next M
       Next L

SUBROUTINE INVMAT (A,DETJ,NDIM)
     ........................................................

Private Sub INVMAT(CJAC() As Double, DETJ As Double, NDIM As Integer)
'
'
'     SUBROUTINE *INVMAT* INVERTS THE JACOBIAN MATRIX
'
'
'      DIMENSION CJAC(3, 3), COFTR(3, 3)
'
'
'
'
     Dim COFTR(3, 3) As Double
     'Dim CJAC(3, 3) As Double
   
     Dim I As Integer
     Dim J As Integer
     
     If NDIM = 3 Then GoTo lab20
'
'     2-D JACOBIAN
'
     DETJ = CJAC(1, 1) * CJAC(2, 2) - CJAC(1, 2) * CJAC(2, 1)
     COFTR(1, 1) = CJAC(2, 2)
     COFTR(1, 2) = -CJAC(2, 1)
     COFTR(2, 1) = -CJAC(1, 2)
     COFTR(2, 2) = CJAC(1, 1)
     For I = 1 To 2
           For J = 1 To 2
             CJAC(I, J) = COFTR(J, I) / DETJ
           Next J
     Next I
     Exit Sub
'
'     3-D JACOBIAN
'
lab20:
     DETJ = CJAC(1, 1) * (CJAC(2, 2) * CJAC(3, 3) - CJAC(2, 3) * CJAC(3, 2)) - _
            CJAC(1, 2) * (CJAC(2, 1) * CJAC(3, 3) - CJAC(2, 3) * CJAC(3, 1)) + _
            CJAC(1, 3) * (CJAC(2, 1) * CJAC(3, 2) - CJAC(2, 2) * CJAC(3, 1))
     COFTR(1, 1) = CJAC(2, 2) * CJAC(3, 3) - CJAC(2, 3) * CJAC(3, 2)
     COFTR(1, 2) = -CJAC(2, 1) * CJAC(3, 3) + CJAC(2, 3) * CJAC(3, 1)
     COFTR(1, 3) = CJAC(2, 1) * CJAC(3, 2) - CJAC(2, 2) * CJAC(3, 1)
     COFTR(2, 1) = -CJAC(1, 2) * CJAC(3, 3) + CJAC(1, 3) * CJAC(3, 2)
     COFTR(2, 2) = CJAC(1, 1) * CJAC(3, 3) - CJAC(1, 3) * CJAC(3, 1)
     COFTR(2, 3) = -CJAC(1, 1) * CJAC(3, 2) + CJAC(1, 2) * CJAC(3, 1)
     COFTR(3, 1) = CJAC(1, 2) * CJAC(2, 3) - CJAC(1, 3) * CJAC(2, 2)
     COFTR(3, 2) = -CJAC(1, 1) * CJAC(2, 3) + CJAC(1, 3) * CJAC(2, 1)
     COFTR(3, 3) = CJAC(1, 1) * CJAC(2, 2) - CJAC(1, 2) * CJAC(2, 1)
     For I = 1 To 3
           For J = 1 To 3
               CJAC(I, J) = COFTR(J, I) / DETJ
           Next J
     Next I
End Sub

SUBROUTINE MATRIAL (MATL,XYS,NSTORE)

Private Sub MATRIAL(MATL() As Integer, XYS() As Tipo_XYS, NSTORE As Integer)
'
'
'     SUBROUTINE *MATRIAL* INPUTS THE NECESSARY MATERIAL PROPERTIES.
'     THE VALUES OF THESE PROPERTIES ARE EITHER IN THE FORM OF A
'     CONSTANT OR A LINEARIZED FUNCTION OF TEMPERATURE.
'     NSTORE CONTAINS THE STARTING LOCATION FOR STORING THE LINEARIZED
'     MATERIAL PROPERTY FUNCTIONS AND ALSO RETURNS THE REQUIRED STORAGE
'     FOR XYS TO FIRES-T3.
'
'
     'COMMON /CONTROL/ ITITLE(6),IREAD(80),NIN,NOUT,NPUNCH,NUMNP,NEL1D,
     'NEL2D , NEL3D, NUMEL, MBAND, NMAT, NFBC1D, NFBC2D, NFBC3D, NBCMAT, NBCTYP
     'DIMENSION MATL(1), XYS(1)

 'Dim MATL(1)
 'Dim XYS(1)
 
 NSTORE = 1
 
'
'     OUTPUT PAGE HEADING
'
     Print #NOUT, "6"
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " ************************************************************"
     Print #NOUT, ""
     Print #NOUT, "     FIRES-T3  -  FIRE RESPONSE OF STRUCTURES - THERMAL"
     Print #NOUT, ""
     Print #NOUT, " "; ITITLE
     Print #NOUT, ""
     Print #NOUT, "     THERMAL PROPERTIES OF SYSTEM TO BE ANALYZED"
     Print #NOUT, ""
     Print #NOUT, "     THERE ARE "; NMAT; " DIFFERENT MATERIALS"
     Print #NOUT, ""
     Print #NOUT, " ************************************************************"
     
     
     
'
     Dim M As Integer
     For M = 1 To NMAT
       Print #NOUT, ""
       Print #NOUT, ""
       Print #NOUT, ""
       Print #NOUT, ""
       Print #NOUT, "  . . . . MATERIAL NUMBER "; M; "  . . . ."
'
'     READ IN CONTROL VARIABLES. IF INTEGER VARIABLE IS ZERO THAN
'     MATERIAL VALUE IS CONSTANT, IF INTEGER CONSTANT IS GREATER THAN
'     2  THEN IT IS THE NUMBER OF POINTS REQUIRED TO DESCRIBE THE
'     LINEARIZED TEMPERATURE DEPENDENT FUNCTION
'
       Dim MK As Integer
       Dim MCP As Integer
       Dim MD As Integer
       
       '---------------------------------------------
       ' Material Data control Card (3I5)
       '---------------------------------------------
       Line Input #NIN, str_tmp
       MK = Val(Mid$(str_tmp, 1, 5))       'Number of points used to define heat conductivity function,
                                           'MK=0 for constant conductivity
       MCP = Val(Mid$(str_tmp, 6, 5))      'Number of points used to define specific heat capacity function,
                                           'MCP=0 for constant heat capacity
       MD = Val(Mid$(str_tmp, 11, 5))      'Number of points used to define density function,
                                           'MD=0 for constant density
       Dim MS As Integer
       MS = (M - 1) * 6
'
'     INPUT CONDUCTIVITY DATA
'
       Print #NOUT, ""
       Print #NOUT, ""
       Print #NOUT, "        . . . CONDUCTIVITY . . ."
       Print #NOUT, ""
       MATL(MS + 1) = NSTORE
       MATL(MS + 2) = MK
       If MK > 0 Then                                          '------------tex
           ReDim Preserve XYS(NSTORE + MK - 1)                 '------------tex
           Call MATIN(NSTORE, MK, XYS())                       '------------tex
           NSTORE = NSTORE + MK                                '------------tex
       Else                                                    '------------tex
           ReDim Preserve XYS(NSTORE)                          '------------tex
           Call MATIN(NSTORE, MK, XYS())                       '------------tex
           NSTORE = NSTORE + 1                                 '------------tex
       End If                                                  '------------tex
       'Call MATIN(MK, XYS(NSTORE), XYS(NSTORE + MK), XYS(NSTORE + MK + MK))
       'NSTORE = NSTORE + 3 * MK
       'If MK = 0 Then NSTORE = NSTORE + 1
'
'     INPUT SPECIFIC HEAT DATA
'
       Print #NOUT, ""
       Print #NOUT, ""
       Print #NOUT, "        . . . SPECIFIC HEAT . . ."
       Print #NOUT, ""
       MATL(MS + 3) = NSTORE
       MATL(MS + 4) = MCP
       If MCP > 0 Then                                         '------------tex
           ReDim Preserve XYS(NSTORE + MCP - 1)                '------------tex
           Call MATIN(NSTORE, MCP, XYS())                      '------------tex
           NSTORE = NSTORE + MCP                               '------------tex
       Else                                                    '------------tex
           ReDim Preserve XYS(NSTORE)                          '------------tex
           Call MATIN(NSTORE, MCP, XYS())                      '------------tex
           NSTORE = NSTORE + 1                                 '------------tex
       End If                                                  '------------tex
       'Call MATIN(MCP, XYS(NSTORE), XYS(NSTORE + MCP), XYS(NSTORE + MCP + MCP))
       'NSTORE = NSTORE + 3 * MCP
       'If MCP = 0 Then NSTORE = NSTORE + 1
'
'     INPUT DENSITY DATA
'
       Print #NOUT, ""
       Print #NOUT, ""
       Print #NOUT, "        . . . DENSITY . . ."
       Print #NOUT, ""
       MATL(MS + 5) = NSTORE
       MATL(MS + 6) = MD
       If MD > 0 Then                                          '------------tex
           ReDim Preserve XYS(NSTORE + MD - 1)                 '------------tex
           Call MATIN(NSTORE, MD, XYS())                       '------------tex
           NSTORE = NSTORE + MD                                '------------tex
       Else                                                    '------------tex
           ReDim Preserve XYS(NSTORE)                          '------------tex
           Call MATIN(NSTORE, MD, XYS())                       '------------tex
           NSTORE = NSTORE + 1                                 '------------tex
       End If                                                  '------------tex
       'Call MATIN(MD, XYS(NSTORE), XYS(NSTORE + MD), XYS(NSTORE + MD + MD))
       'NSTORE = NSTORE + 3 * MD
       'If MD = 0 Then NSTORE = NSTORE + 1
'
   Next M
'
End Sub

SUBROUTINE MATIN (K,X,Y,S)

Private Sub MATIN(NSTORE As Integer, K As Integer, XYS() As Tipo_XYS)
'
'
'     SUBROUTINE *MATIN* INPUTS FOR EACH MATERIAL ITS TEMPERATURE-
'     DEPENDENT PROPERTIES, CALCULATES SLOPES, AND PRINTS THE DATA.
'
'
     'COMMON /CONTROL/ ITITLE(6),IREAD(80),NIN,NOUT,NPUNCH,NUMNP,NEL1D,
     'NEL2D , NEL3D, NUMEL, MBAND, NMAT, NFBC1D, NFBC2D, NFBC3D, NBCMAT, NBCTYP
     'DIMENSION X(1), Y(1), S(1)
'
     'Dim X(1) As Double
     'Dim Y(1) As Double
     'Dim S(1) As Double
'
     If K <> 0 Then GoTo lab10
'
'     INPUT CONSTANT VALUE FUNCTION
'
     'Heat Conductivity constant (E10.0) or
     'Specific Heat Capacity constant (E10.0) or
     'Density constant (E10.0)
     Line Input #NIN, str_tmp
     XYS(NSTORE).X = Val(Mid$(str_tmp, 1, 10))
     Print #NOUT, "  MATERIAL PARAMETER OF CONSTANT VALUE "; XYS(NSTORE).X
     Exit Sub
'
'     INPUT VARIABLE VALUE FUNCTION
'
lab10:
'
'     CHECK K FOR AN ALLOWABLE NUMBER OF POINTS IN MATERIAL FUNCTION
'
     If K = 1 Or K < 0 Then GoTo lab40
     'Heat Conductivity (8E10.0) or
     'Specific Heat Capacity (8E10.0) or
     'Density (8E10.0)
     'define max 4 points for card
     Dim I As Integer
     For I = 1 To K Step 4
       Line Input #NIN, str_tmp
       
       If I > K Then Exit For
       XYS(NSTORE + I - 1).X = Val(Mid$(str_tmp, 1, 10))       'Temperature of point I
       XYS(NSTORE + I - 1).Y = Val(Mid$(str_tmp, 11, 10))      'Value of conductivity function at point I or
                                                               'Value of heat capacity function at point I or
                                                               'Value of density function at point I
       If I + 1 > K Then Exit For
       XYS(NSTORE + I - 1 + 1).X = Val(Mid$(str_tmp, 21, 10))
       XYS(NSTORE + I - 1 + 1).Y = Val(Mid$(str_tmp, 31, 10))
       
       If I + 2 > K Then Exit For
       XYS(NSTORE + I - 1 + 2).X = Val(Mid$(str_tmp, 41, 10))
       XYS(NSTORE + I - 1 + 2).Y = Val(Mid$(str_tmp, 51, 10))
       
       If I + 3 > K Then Exit For
       XYS(NSTORE + I - 1 + 3).X = Val(Mid$(str_tmp, 61, 10))
       XYS(NSTORE + I - 1 + 3).Y = Val(Mid$(str_tmp, 71, 10))
       
     Next I
     Dim M As Integer
     M = K - 1
'
'     DETERMINE THE SLOPES OF THE LINEAR SEGMENTS OF THE MATERIAL
'     FUNCTIONS
'
     For I = 1 To M
       XYS(NSTORE + I - 1).S = (XYS(NSTORE + I).Y - XYS(NSTORE + I - 1).Y) / (XYS(NSTORE + I).X - XYS(NSTORE + I - 1).X)
     Next I
     
     Print #NOUT, ""
     Print #NOUT, "     NODE    TEMPERATURE      VALUE       SLOPE"
     Print #NOUT, ""
'
'     OUTPUT THE FUNCTION IF IT IS VARIABLE
'
     For I = 1 To M
       Print #NOUT, I, XYS(NSTORE + I - 1).X; "      "; XYS(NSTORE + I - 1).Y
       Print #NOUT, "                                      "; XYS(NSTORE + I - 1).S
     Next I
     
     Print #NOUT, K, XYS(NSTORE + K - 1).X; "      "; XYS(NSTORE + K - 1).Y
     
     Exit Sub
'
'
lab40:
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "  ------------PROGRAM TERMINATED------------"
     Print #NOUT, ""
     Print #NOUT, "  INPUT ERROR"
     Print #NOUT, ""
     Print #NOUT, "   CONTROL CONSTANT IS "; K; " AND IT MUST BE EITHER"
     Print #NOUT, ""
     Print #NOUT, "   0 OR GREATER THAN OR EQUAL TO 2"
     Close #NIN
     Close #NOUT
     End '<<<<<<<<
'
'
End Sub

FUNCTION VMAT (K,X,Y,S,T,NAME)

Private Function VMAT(NSTORE As Integer, K As Integer, XYS() As Tipo_XYS, T As Double, NAME As String) As Double
'
'
'     FUNCTION *VMAT* CALCULATES THE VALUE OF THE TEMPERATURE-DEPENDENT
'     VARIABLES REQUIRED IN THE THERMAL ANALYSIS
'
'
     'COMMON /CONTROL/ ITITLE(6),IREAD(80),NIN,NOUT,NPUNCH,NUMNP,NEL1D,
     'NEL2D , NEL3D, NUMEL, MBAND, NMAT, NFBC1D, NFBC2D, NFBC3D, NBCMAT, NBCTYP
     'DIMENSION X(1), Y(1), S(1)

     'Dim X(1) As Double
     'Dim Y(1) As Double
     'Dim S(1) As Double
'
     If K <> 0 Then GoTo lab10
     VMAT = XYS(NSTORE).X
     Exit Function
'
lab10:
     Dim I As Integer
     I = 0
lab20:
     I = I + 1
     If I > K Then GoTo lab50
     Select Case (T - XYS(NSTORE + I - 1).X)
         Case Is < 0
             GoTo lab40    'T < XYS(NSTORE + I - 1).X
         Case Is = 0
             GoTo lab30    'T = XYS(NSTORE + I - 1).X
         Case Is > 0
             GoTo lab20    'T > XYS(NSTORE + I - 1).X
     End Select
lab30:
     VMAT = XYS(NSTORE + I - 1).Y
     Exit Function
'
lab40:
     If I = 1 Then GoTo lab50
     VMAT = XYS(NSTORE + I - 2).Y + XYS(NSTORE + I - 2).S * (T - XYS(NSTORE + I - 2).X)
     Exit Function
'
'
lab50:
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, "  -------------PROGRAM TERMINATED --------------"
   Print #NOUT, ""
   Print #NOUT, "    BOUNDS OF CURVE DESCRIBING MATERIAL PARAMETER "; NAME; " HAVE BEEN EXCEEDED"
   Print #NOUT, ""
   Print #NOUT, "   THE TEMPERATURE WAS "; T; " THE LOWER BOUND IS "; XYS(NSTORE).X; " AND THE UPPER BOUND IS "; XYS(NSTORE + K - 1).X
   Close #NIN
   Close #NOUT
   End '<<<<<<
'
'
'
End Function

Private Sub CONVERG()
'Private Sub CONVERG(NTOTAL As Integer)
'
'
'     SUBROUTINE *CONVERG* INPUTS THE CONVERGENCE CRITERIA CONTROLLING
'     THE NATURE OF THE THERMAL ANALYSIS.  THE PROGRAM CONTAINS THE
'     THE CAPABILITIES FOR ITERATIVE SOLUTIONS DEALING WITH  THE ENTIRE
'     SYSTEM AND/OR THE FIRE BOUNDARY CONDITIONS
'
'

     'COMMON /CONTROL/ ITITLE(6),IREAD(80),NIN,NOUT,NPUNCH,NUMNP,NEL1D,NEL2D,
     'NEL3D , NUMEL, MBAND, NMAT, NFBC1D, NFBC2D, NFBC3D, NBCMAT, NBCTYP
     'COMMON /CONRG/ NCONV,CONV,BETA,NCONU,CONU,ALPHA

     'Dim NCONV As Integer
     'Dim CONV As Double
     'Dim BETA As Double
     'Dim NCONU As Integer
     'Dim CONU As Double
     'Dim ALPHA As Double

'
'     OUTPUT PAGE HEADING
'
   Print #NOUT, "6"
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, " ************************************************************"
   Print #NOUT, ""
   Print #NOUT, "     FIRES-T3  -  FIRE RESPONSE OF STRUCTURES - THERMAL "
   Print #NOUT, ""
   Print #NOUT, " "; ITITLE
   Print #NOUT, ""
   Print #NOUT, "     INFORMATION RELEVANT TO THE ANALYSIS PROCEDURE"
   Print #NOUT, ""
   Print #NOUT, " ************************************************************"
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, "  . . . . CONVERGENCE CRITERIA . . . ."
   
'
'     CONVERGENCE DETERMINED WHEN
'
'        2*ABS(T(I)-T(I-1)/T(I)+T(I-1) .LESS THAN. CONV OR CONU
'
'     AND IF CONVERGENCE IS NOT ACHIEVED THE NEXT ESTIMATE OF THE
'     SYSTEMS TEMPERATURES IS OBTAINED THROUGH
'
'        T(I+1) = T(I) + BETA (OR ALPHA) *(T(I)-T(I-1))
'
'        WHERE     SYSTEM         FIRE BC
'                  CRITERIA       CRITERIA
'
'                    NCONU          NCONV   - NUMBER OF PERMISSIBLE
'                                             ITERATIONS(0-IF PARTICULAR
'                                             ITERATION IS NOT DESIRED)
'                    CONU           CONV    - PERMISSIBLE RELATIVE ERROR
'                    ALPHA          BETA    - OVER RELAXATION FACTOR
'
'     INPUT CONVERGENCE CRITERIA
'

     '-------------------------------------------------
     ' Convergence criteria card (I5,2F10.0,I5,2F10.0)
     '-------------------------------------------------
     Line Input #NIN, str_tmp
     NCONV = Val(Mid$(str_tmp, 1, 5))      'Maximum number of iterations permitted
                                           'for fire B.C. solution
     CONV = Val(Mid$(str_tmp, 6, 10))      'Permissible relative error for fire B.C.
                                           'iteration
     BETA = Val(Mid$(str_tmp, 16, 10))     'Overconvergence factor for fire B.C.
                                           'iteration
     NCONU = Val(Mid$(str_tmp, 26, 5))     'Maximum number of iterations permitted
                                           'for system solution in each time step
                                           'if NCONU=0, linear solution - no iteration
     CONU = Val(Mid$(str_tmp, 31, 10))     'Permissible relative error for system
                                           'iteration
     ALPHA = Val(Mid$(str_tmp, 41, 10))    'Overconvergence factor for system
                                           'iteration
     If NCONU = 0 Then GoTo lab10
'
'     OUTPUT SYSTEM CONVERGENCE CRITERIA
'
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "  CONVERGENCE CRITERIA FOR ENTIRE SYSTEM"
     Print #NOUT, ""
     Print #NOUT, "     PERMISSIBLE ERROR ="; CONU
     Print #NOUT, "     MAXIMUM NUMBER OF ITERATIONS ="; NCONU
     Print #NOUT, "     ALPHA ="; ALPHA
     
lab10:
'
'     OUTPUT FIRE BOUNDARY CONDITION CONVERGENCE CRITERIA
'
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "  CONVERGENCE CRITERIA FOR BOUNDARY CONDITIONS"
     Print #NOUT, ""
     Print #NOUT, "     PERMISSIBLE ERROR ="; CONV
     Print #NOUT, "     MAXIMUM NUMBER OF ITERATIONS ="; NCONV
     Print #NOUT, "     BETA ="; BETA
'
'     DIVIDE PERMISSBLE ERROR BY TWO
'
     CONV = CONV * 0.5
     CONU = CONU * 0.5
'
'
'     STORAGE REQUIREMENT FOR BLANK COMMON IS NOW PRINTED
'
'
     'Print #NOUT, ""
     'Print #NOUT, ""
     'Print #NOUT, ""
     'Print #NOUT, ""
     'Print #NOUT, "  . . . . STORAGE REQUIREMENT FOR BLANK COMMON . . . ."
     'Print #NOUT, ""
     'Print #NOUT, "     SIZE BLANK COMMON = ", NTOTAL; " (DECIMAL)"
     'Print #NOUT, "                       = ", Oct(NTOTAL); " (OCTAL)"
'
'

End Sub

Private Sub HEATFLO(X() As Double, Y() As Double, Z() As Double, KODE() As Tipo_KODE, _
                   D() As Double, MA() As Integer, T1() As Double, T2() As Double, T3() As Double, _
                   LM() As Integer, MMTYPE() As Integer, BAREA() As Double, THICK() As Double, _
                   MATL() As Integer, XYS() As Tipo_XYS, MAT() As Integer, FXYS() As Tipo_XYS, _
                   LI() As Integer, LJ() As Integer, LK() As Integer, LL() As Integer, _
                   LMAT() As Integer, LFIRE() As Integer, AIJKL() As Double, LELEM() As Integer, _
                   IEXO() As Integer, EXYS() As Tipo_XYS, IEL() As Integer, IMAT() As Integer, VEL() As Double, _
                   Q() As Double, T() As Double, B() As Double, AT() As Double, A() As Double, VOLUME() As Double, _
                   NUMNP As Integer, NUMFBC As Integer)
'
'
'     SUBROUTINE *HEATFLO* IS THE THERMAL ANALYSIS CONTROLLER
'
'
     'COMMON /CONTROL/ ITITLE(6),IREAD(80),NIN,NOUT,NPUNCH,NUMNP,NEL1D,
     'NEL2D , NEL3D, NUMEL, MBAND, NMAT, NFBC1D, NFBC2D, NFBC3D, NBCMAT, NBCTYP
     'COMMON /EXOTH/ NINT1D,NINT2D,NINT3D,NINT,NQINT
     'COMMON /CONRG/ NCONV,CONV,BETA,NCONU,CONU,ALPHA
     'DIMENSION X(1), Y(1), Z(1), KODE(1), LM(1), MMTYPE(1), LELEM(1), MATL(1),
     'XYS(1), MAT(1), FXYS(1), LI(1), LJ(1), LK(1), LL(1), LMAT(1), LFIRE(1),
     'AIJKL(1), Q(1), T(1), B(1), AT(1), A(NP, 1), D(1), MA(1), T1(1), T2(1),
     'T3(1), THICK(1), BAREA(1), IEXO(1), EXYS(1), IEL(1), IMAT(1), VEL(1), VOLUME(1)
     'DIMENSION TFIRE(4)
     
     'ReDim A(NUMNP, 1) As Double '-----------?????
     Dim TFIRE(4) As Double
'
'     INITIALIZE THE SYSTEM
'
     Dim MAIN As Integer
     MAIN = 0 '------------------tex
     
     Dim IP1 As Integer
     Dim IP2 As Integer
     Dim SDT As Double
     Dim DS As Double
     
     IP1 = 0
     IP2 = 0
     SDT = 0#
     DS = 0#
'
'     INPUT INITIAL TIME STEP CARD
'     WHERE   IA - CONTROL WORD (STEP)
'             MDT - SEQUENCE COUNTER - INITIAL VALUE
'             TIME - SYSTEM CLOCK - INITIAL VALUE
'             TEMP - INDICATOR FOR INITIAL TEMPERATURE - IF NON-ZERO
'                    THEN TAKEN AS UNIFORM INITIAL TEMPERATURE OF SYSTEM
'             JP - IDENTIFIER FOR PUNCHED OUTPUT
'
     Dim IA As String * 4
     Dim MDT As Integer
     Dim TIME As Double
     Dim TEMP As Double
     Dim JP As String * 3
     Dim blank2 As String * 2

     '-----------------------------------------------------
     ' Initial time step control card (A4,I6,2F10.0,2X,A3)
     '-----------------------------------------------------
     Line Input #NIN, str_tmp
     IA = Mid$(str_tmp, 1, 4)              'Enter the word "STEP"
     MDT = Val(Mid$(str_tmp, 5, 6))        'Initial number in sequencing of time
                                           'steps
     TIME = Val(Mid$(str_tmp, 11, 10))     'Initial time (i.e., base time)
     TEMP = Val(Mid$(str_tmp, 21, 10))     'Uniform initial temperature
                                           '(If initial temperature is nonuniform,
                                           'leave cols. 21-30 blank and input nodal
                                           'temperatures on the data card below)
     blank2 = Mid$(str_tmp, 31, 2)         'blank
     JP = Mid$(str_tmp, 33, 3)             '3-symbol alphanumeric code that will
                                           'appear in columns 74-76 of punched output.
     
'
'     OUTPUT HEADING FOR INITIAL TIME STEP
'
     Print #NOUT, "6"
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " ************************************************************"
     Print #NOUT, ""
     Print #NOUT, "     FIRES-T3  -  FIRE RESPONSE OF STRUCTURES - THERMAL"
     Print #NOUT, ""
     Print #NOUT, " "; ITITLE
'
     If IA <> "STEP" Then GoTo lab40
'
     Print #NOUT, ""
     Print #NOUT, " INITIAL SEQUENCE NUMBER IS "; MDT; " AND INITIAL TIME IS "; TIME
     Print #NOUT, ""
     Print #NOUT, " ************************************************************"
'
'     INITIALIZE TEMPERATURES
'
     If TEMP <> 0# Then GoTo lab10
     
     Dim I As Integer
     Dim blank4 As String * 4

     '-----------------------------------------------------
     ' Initial Temperature Distribution Data (7(4X,F6.1))
     '-----------------------------------------------------
     For I = 1 To NUMNP Step 7
       Line Input #NIN, str_tmp
       
       If I > NUMNP Then Exit For
       blank4 = Mid$(str_tmp, 1, 4)            'blank
       T(I) = Val(Mid$(str_tmp, 5, 6))         'Initial temperature at node I
       
       If I + 1 > NUMNP Then Exit For
       blank4 = Mid$(str_tmp, 11, 4)
       T(I + 1) = Val(Mid$(str_tmp, 15, 6))
       
       If I + 2 > NUMNP Then Exit For
       blank4 = Mid$(str_tmp, 21, 4)
       T(I + 2) = Val(Mid$(str_tmp, 25, 6))
       
       If I + 3 > NUMNP Then Exit For
       blank4 = Mid$(str_tmp, 31, 4)
       T(I + 3) = Val(Mid$(str_tmp, 35, 6))
       
       If I + 4 > NUMNP Then Exit For
       blank4 = Mid$(str_tmp, 41, 4)
       T(I + 4) = Val(Mid$(str_tmp, 45, 6))
       
       If I + 5 > NUMNP Then Exit For
       blank4 = Mid$(str_tmp, 51, 4)
       T(I + 5) = Val(Mid$(str_tmp, 55, 6))
       
       If I + 6 > NUMNP Then Exit For
       blank4 = Mid$(str_tmp, 61, 4)
       T(I + 6) = Val(Mid$(str_tmp, 65, 6))
     Next I
     GoTo lab30
lab10:
     For I = 1 To NUMNP
       T(I) = TEMP         'Uniform initial temperature at node I
     Next I
'
'     OUTPUT INITIAL TEMPERATURES
'
lab30:
     Dim NCON As Integer
     Call PROUT(4, T(), AT(), LM(), T1(), B(), MAIN, NCON, 1)
     GoTo lab50
'
lab40:
'
'     TERMINATE PROGRAM - INITIAL TIME STEP CARD ERROR
'
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " - - - - PROGRAM TERMINATED - ERROR IN INITIAL TIME STEP CARD - - - -"
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " "; IA, MDT, TIME, TEMP, "  "; JP
     Close #NIN
     Close #NOUT
     End '<<<<<<<<<
'
lab50:
'
'     READ TIME STEP CARD
'     WHERE   IA - CONTROL WORD (STEP)
'             NDT - SEQUENCE NUMBER
'             DT - TIME STEP INTERVAL
'             ITOF - NUMBER OF NON-ZERO TEMPERATURE OR FLOW B.C.
'             TFIRE(I) - TEMPERATURE OF FIRE FOR CURRENT TIME STEP
'                        I CAN VARY FROM 1 TO 4
'             I1 - PRINTED OUTPUT OPTION
'                  0 - NO PRINTED OUTPUT
'                  1 - OUTPUT NODAL POINT TEMPERATURES
'                  2 - OUTPUT ELEMENT TEMPERATURES
'                  3 - OUTPUT BOTH NODAL AND ELEMENT TEMPERATURES
'             I2 - PUNCHED OUTPUT OPTION
'                  CODE SAME AS FOR PRINTED DATA
'             I6 - DEBUGGING OUTPUT OPTION
'             I7 - CHANGE OF FIRE SURFACE ELEMENTS OPTION
'
lab60:
     'Dim IA As String * 4
     Dim NDT As Integer
     Dim DT As Double
     Dim ITOF As Integer
     'Dim TFIRE(4) As Double
     Dim I1 As Integer
     Dim I2 As Integer
     Dim I6 As Integer
     Dim I7 As Integer
     
     '-----------------------------------------------------
     ' Time Step Control Card (A4,I6,F10.0,I5,4F10.0,4I3)
     '-----------------------------------------------------
     Line Input #NIN, str_tmp
     IA = Mid$(str_tmp, 1, 4)                  'Enter the word "STEP"
     NDT = Val(Mid$(str_tmp, 5, 6))            'Time step number
     DT = Val(Mid$(str_tmp, 11, 10))           'Time step interval
     ITOF = Val(Mid$(str_tmp, 21, 5))          'Number of non-zero flow or
                                               'temperature boundary conditions
     TFIRE(1) = Val(Mid$(str_tmp, 26, 10))     'Temperature of fire 1
     TFIRE(2) = Val(Mid$(str_tmp, 36, 10))     'Temperature of fire 2
     TFIRE(3) = Val(Mid$(str_tmp, 46, 10))     'Temperature of fire 3
     TFIRE(4) = Val(Mid$(str_tmp, 56, 10))     'Temperature of fire 4
     I1 = Val(Mid$(str_tmp, 66, 3))            'Printed output desired for this time step
                                               'If I1=0, no output
                                               'If I1=1, nodal temperatures
                                               'If I1=2, element temperatures
                                               'If I1=3, both nodal and element temperatures
     I2 = Val(Mid$(str_tmp, 69, 3))            'Punched output desired for this time step
                                               'If I2=0, no punched output
                                               'If I2=1, nodal temperatures
                                               'If I2=2, element temperatures
                                               'If I2=3, both nodal and element temperatures
     I6 = Val(Mid$(str_tmp, 72, 3))            'Intermediate printed output for debugging purposes
                                               'If I6=0, no printout
                                               'If I6=1, debugging printout
     I7 = Val(Mid$(str_tmp, 75, 3))            'Fire boundary condition flag
                                               'If I7=0, continue with same fire B.C.
                                               'surfaces previously defined
                                               'If i7=1, input new fire B.C. surface in
                                               'Data Block below
     MAIN = 0
     MDT = MDT + 1
'
'     CHECK SEQUENCING OF TIME STEP CARD
'
     If NDT = MDT And IA = "STEP" Then GoTo lab90
'
'     PROGRAM TERMINATED IF SEQUENCING ERROR
'
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "  TIME STEP CARD OUT OF SEQUENCE - CARD NO."; 0 'valore arbitrario indefinito
     Print #NOUT, ""
     Print #NOUT, "  INPUT CARD"
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "  - - - - PROGRAM TERMINATED - TIME STEP CARD WAS - - - -"
lab70:
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " "; IA, NDT, DT, ITOF, TFIRE(1), TFIRE(2), TFIRE(3), TFIRE(4), I1, I2, I6, I7
     Close #NIN
     Close #NOUT
     End '<<<<<<<<

lab80:
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "  NO TIME INTERVAL ESTABLISHED"
     
     GoTo lab70
'
'     ESTABLISH TIME INTERVAL DT
'
lab90:
     Select Case (DT)
         Case Is < 0#
             GoTo lab100
         Case Is = 0#
             GoTo lab110
         Case Is > 0#
             GoTo lab120
     End Select

lab100:
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "  PROBLEM COMPLETED"
     Exit Sub
'
lab110:
     If DS = 0# Then GoTo lab80
     DT = DS
     GoTo lab130
lab120:
     DS = DT
lab130:

'
     TIME = TIME + DT
'
'     OUTPUT HEADING FOR TIME STEP
'
     Print #NOUT, "6"
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " ************************************************************"
     Print #NOUT, ""
     Print #NOUT, "     FIRES-T3  -  FIRE RESPONSE OF STRUCTURES - THERMAL"
     Print #NOUT, ""
     Print #NOUT, " "; ITITLE
     Print #NOUT, ""
     Print #NOUT, "  TIME STEP NUMBER "; NDT; " - TIME "; TIME; " - TIME STEP "; DT
     Print #NOUT, ""
     Print #NOUT, " ************************************************************"
     Print #NOUT, ""
     Print #NOUT, "      NUMBER OF NON-ZERO FLOW OR TEMPERATURE CONDITIONS"; ITOF
     
     If NUMFBC = 0 Then GoTo lab140
     Print #NOUT, ""
     Print #NOUT, "      FIRE BOUNDARY CONDITION"
     For I = 1 To 4
           Print #NOUT, ""
           Print #NOUT, "       FIRE("; I; ") = "; TFIRE(I);
     Next I
     Print #NOUT, ""
     
lab140:
     Dim DT2 As Double
     DT2 = 1# / DT
'
'
'     B E G I N N I N G   O F   S Y S T E M   I T E R A T I O N
'
'
lab150:
     MAIN = MAIN + 1
'
'     SAVE THE INITIALLY ASSUMED TEMPERATURES IN VECTOR T1
'
     Dim N As Integer
     For N = 1 To NUMNP
       T1(N) = T(N)
     Next N
     If I6 <> 0 Then Call PROUT(1, T(), AT(), LM(), T1(), B(), MAIN, NCON, I1)
'
'     FORM CONDUCTIVITY MATRIX AND STORE IN MATRIX A, AND ALSO FORM
'     THE HEAT CAPACITY MATRIX AND STORE IN VECTOR Q
'
     Call HCONDC(AT(), A(), NUMNP, MATL(), XYS(), T(), Q(), LM(), MMTYPE(), BAREA(), THICK(), X(), Y(), Z(), VOLUME())
'
'     INITIALIZE HEAT LOAD VECTOR TO 0.0 - VECTOR B
'
     For I = 1 To NUMNP
       B(I) = 0#
     Next I
'
'     ADD INTERNAL HEAT GENERATION TO VECTOR B
'
     If NINT = 0 Then GoTo lab180
     Call QEXO(LM(), IEL(), IMAT(), IEXO(), EXYS(), AT(), MATL(), VEL(), MMTYPE(), B(), XYS(), TIME)
'
'     INPUT ANY NON-ZERO TEMPERATURE AND FLOW BOUNDARY CONDITONS
'     AND ADD THE RELATED TERMS TO MATRIX A AND VECTOR B
'
lab180:
     Call HATEMP(ITOF, D(), KODE(), B(), A(), NUMNP, MAIN, T3(), Q())
'
'     ADD CAPACITY TERMS TO CONDUCTIVITY MATRIX A
'
     For N = 1 To NUMNP
       'If KODE(N) = "TEMP" Then GoTo lab200
       If KODE(N) = TEMP Then GoTo lab200
       Select Case (Q(N))
         Case Is < 0#
             GoTo lab190
         Case Is = 0#
             GoTo lab200
         Case Is > 0#
             GoTo lab190
       End Select
lab190:
       A(N, 1) = A(N, 1) + Q(N) * DT2
lab200:
     Next N
'
'     TRIANGULARIZE THE MODIFIED CONDUCTIVITY MATRIX
'
     Call MSYM(1, B(), MA(), A(), NUMNP)
'
     If MAIN <> 1 Then GoTo lab220
'
'     CALCULATE EFFECTIVE LOAD VECTOR B
'
'     CALCULATE CAPACITY MATRIX CONTRIBUTION TO THE EFFECTIVE LOAD
'     AND SAVE IN VECTOR T2
'
     Dim II As Integer
     For II = 1 To NUMNP
       'If KODE(II) = "TEMP" Then GoTo lab210
       If KODE(II) = TEMP Then GoTo lab210
       T2(II) = Q(II) * T(II) * DT2
lab210:
     Next II
lab220:
     For II = 1 To NUMNP
       'If KODE(II) = "TEMP" Then GoTo lab230
       If KODE(II) = TEMP Then GoTo lab230
       B(II) = B(II) + T2(II)
lab230:
       Q(II) = B(II)
     Next II
     NCON = 0
     If NUMFBC = 0 Then GoTo lab260
'
'     IF FIRE BOUNDARY CONDITION SURFACE CONFIGURATION IS TO BE CHANGED
'     ON THIS TIME STEP, INPUT THE NEW DATA
'
     If I7 = 0 Then GoTo lab250
     Call FIREBC(X(), Y(), Z(), KODE(), BAREA(), THICK(), LI(), LJ(), LK(), LL(), LMAT(), LFIRE(), AIJKL(), LELEM())
'
'
'     B E G I N N I N G   O F   F I R E   B.   C.   I T E R A T I O N
'
'
lab240:
'
'     CALCULATE THE HEAT FLOW RELATED TO THE FIRE B.C.
'
lab250:
     Call FIRE(LI(), LJ(), LK(), LL(), LMAT(), LFIRE(), AIJKL(), MAT(), FXYS(), T(), TFIRE(), B())
     NCON = NCON + 1
'
'     CALCULATE THE TEMPERATURES THROUGH BACK SUBSTITUTION
'
lab260:
     Call MSYM(2, B(), MA(), A(), NUMNP)
'
     If NUMFBC = 0 Then GoTo lab280
     If NCONV = 0 Then GoTo lab280
     If I6 <> 0 Then Call PROUT(2, T(), AT(), LM(), T1(), B(), MAIN, NCON, I1)
'
'     CHECK FOR CONVERGENCE OF FIRE B.C. CYCLE AGAINST PERMISSIBLE ERROR
'
     Dim DX As Double
     Dim DY As Double
     For N = 1 To NUMNP
       DX = Abs(B(N) - T(N))
       DY = CONV * Abs(B(N) + T(N))
       If DX > DY Then GoTo lab300
     Next N
lab280:
     For N = 1 To NUMNP
       T(N) = B(N)
     Next N
     GoTo lab320
'
'     IF CONVERGENCE NOT OBTAINED CHECK FOR POSSIBILITY OF EXCEEDING
'     PERMISSIBLE NUMBER OF CYCLES FOR FIRE B.C.
'
lab300:
     If NCON > NCONV Then Call PROUT(3, T(), AT(), LM(), T1(), B(), MAIN, NCON, I1)
'
'     ESTIMATE NEW APPROXIMATION OF TEMPERATURES FOR FIRE B.C.
'
     Dim JJ As Integer
     For JJ = 1 To NUMNP
       DX = B(JJ) - T(JJ)
       T(JJ) = B(JJ) + BETA * DX
       B(JJ) = Q(JJ)
     Next JJ
     GoTo lab240
'
lab320:
     If NCONU = 0 Then GoTo lab360
'
'     CHECK CONVERGENCE OF SYSTEM CYCLE AGAINST PERMISSIBLE ERROR
'
     For N = 1 To NUMNP
       DX = Abs(T(N) - T1(N))
       DY = CONU * Abs(T(N) + T1(N))
       If DX > DY Then GoTo lab340
     Next N
     GoTo lab360
'
'     CHECK TO SEE IF NUMBER OF SYSTEM ITERATIONS HAS EXCEEDED
'     PERMISSIBLE NUMBER OF ITERATIONS
'
lab340:
     If MAIN > NCONU Then Call PROUT(3, T(), AT(), LM(), T1(), B(), MAIN, NCON, I1)
'
'     ESTIMATE NEW APPROXIMATION OF SYSTEMS TEMPERATURES
'
     For N = 1 To NUMNP
       DX = T(N) - T1(N)
       T(N) = T(N) + ALPHA * DX
     Next N
     GoTo lab150
lab360:
'
'     CHECK FOR DESIRED OUTPUT
'
     If I1 <> 0 Then Call PROUT(4, T(), AT(), LM(), T1(), B(), MAIN, NCON, I1)
     If I2 <> 0 Then Call PUOUT(I1, I2, T(), AT(), X(), Y(), Z(), TIME, IP1, IP2, LM(), JP)
     Dim NC As Integer
     Dim NS As Integer
     NC = NCON - 1
     NS = MAIN - 1
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, NS; " SYSTEM ITERATIONS WERE PERFORMED"
     Print #NOUT, NC; " B. C. ITERATIONS WERE PERFORMED"
     GoTo lab60
'
'
'
End Sub

Private Sub HCONDC(AT() As Double, A() As Double, NUMNP As Integer, MATL() As Integer, XYS() As Tipo_XYS, _
                  T() As Double, Q() As Double, LM() As Integer, MMTYPE() As Integer, BAREA() As Double, THICK() As Double, _
                  X() As Double, Y() As Double, Z() As Double, VOLUME() As Double)
'
'
'     SUBROUTINE *HCONDC* FORMS CONDUCTIVITY AND HEAT CAPACITY MATRICES
'
'
     'DIMENSION AT(1), A(NP,1), MATL(1), XYS(1), T(1), Q(1),
     'S(8,8), LM(1), PSTU(8), B(3,8), MMTYPE(1), BAREA(1), THICK(1),
     'X(1), Y(1), Z(1), POS(2), SI(4), TI(4), XX(4), YY(4), DPSTU(2,4), CJAC(3,3), VOLUME (1)

     'DATA POS/-0.57735027,+0.57735027/
     'DATA SI/-1.,1.,1.,-1./
     'DATA TI/-1.,-1.,1.,1./

     'Gaussian integration
     '------------------------------------------------------------
     'Number of points (n)  Location (ri)             Weight (wi)
     '      2               +/-0.577350269189626      1.0
     '------------------------------------------------------------
       Dim POS(2) As Double
       POS(1) = -0.577350269189626
       POS(2) = 0.577350269189626
       
       Dim SI(4) As Double
       SI(1) = -1#
       SI(2) = 1#
       SI(3) = 1#
       SI(4) = -1#
       
       Dim TI(4) As Double
       TI(1) = -1#
       TI(2) = -1#
       TI(3) = 1#
       TI(4) = 1#

       'ReDim A(NUMNP, 1) As Double '-----------?????
       Dim S(8, 8) As Double
       Dim PSTU(8) As Double
       Dim B(3, 8) As Double
       Dim XX(4) As Double
       Dim YY(4) As Double
       Dim DPSTU(2, 4) As Double
       Dim CJAC(3, 3) As Double

'
'
'     INITIALIZE THE SYSTEMS CONDUCTIVITY MATRIX TO 0.0
'     AND THE SYSTEMS HEAT CAPACITY MATRIX TO 0.0
'
       Dim I As Integer
       Dim J As Integer
       'ReDim Q(NUMNP) As Double            '---------tex
       For I = 1 To NUMNP
           Q(I) = 0#
       Next I
       'Dim MB As Integer
       'MB = MBAND * NUMNP
       'For I = 1 To MB
       '    A(I) = 0#
       'Next I
       'ReDim A(NUMNP, MBAND) As Double     '---------tex
       For I = 1 To NUMNP                  '---------tex
           For J = 1 To MBAND              '---------tex
               A(I, J) = 0#                '---------tex
           Next J                          '---------tex
       Next I                              '---------tex

'
'
'     O N E - D I M E N S I O N A L   E L E M E N T S
'
'
   If NEL1D = 0 Then GoTo lab50
   Dim NLM As Integer
   NLM = 0
   Dim N As Integer
   For N = 1 To NEL1D
       NLM = NLM + 2
       For I = 1 To 2
           For J = 1 To 2
               S(I, J) = 0#
           Next J
       Next I
       Dim II As Integer
       Dim KK As Integer
       Dim AA As Double
       Dim BB As Double
       Dim CC As Double
       Dim XL As Double
       II = LM(NLM - 1)
       KK = LM(NLM)
       AA = X(II) - X(KK)
       BB = Y(II) - Y(KK)
       CC = Z(II) - Z(KK)
       XL = Sqr(AA * AA + BB * BB + CC * CC)
       AT(N) = 0.5 * (T(II) + T(KK))
       Dim TEMP As Double
       Dim MS As Integer
       Dim K As Integer
       TEMP = AT(N)
       MS = MMTYPE(N)
       MS = (MS - 1) * 6
       J = MATL(MS + 1)
       K = MATL(MS + 2)
       Dim COND As Double
       'COND = VMAT(K, XYS(J), XYS(J + K), XYS(J + K + K), TEMP, "   K(T)   ")
       COND = VMAT(J, K, XYS(), TEMP, "   K(T)   ")    '---------tex
       J = MATL(MS + 3)
       K = MATL(MS + 4)
       Dim SPHT As Double
       'SPHT = VMAT(K, XYS(J), XYS(J + K), XYS(J + K + K), TEMP, "   CP(T)  ")
       SPHT = VMAT(J, K, XYS(), TEMP, "   CP(T)  ")    '---------tex
       J = MATL(MS + 5)
       K = MATL(MS + 6)
       Dim DENS As Double
       'DENS = VMAT(K, XYS(J), XYS(J + K), XYS(J + K + K), TEMP, "    D(T)  ")
       DENS = VMAT(J, K, XYS(), TEMP, "    D(T)  ")    '---------tex
       S(1, 1) = BAREA(N) * COND / XL
       S(1, 2) = -S(1, 1)
       S(2, 1) = S(1, 2)
       S(2, 2) = S(1, 1)
       Dim QSTORE As Double
       QSTORE = SPHT * DENS * XL * BAREA(N) / 2#
'
'     ADD ELEMENT CONDUCTIVITY AND CAPACITY TO SYSTEM MATRICES
'
       Q(II) = Q(II) + QSTORE
       Q(KK) = Q(KK) + QSTORE
       A(II, 1) = A(II, 1) + S(1, 1)
       Dim JJ As Integer
       JJ = KK - II + 1
       If JJ > 0 Then A(II, JJ) = A(II, JJ) + S(1, 2)
       JJ = II - KK + 1
       If JJ > 0 Then A(KK, JJ) = A(KK, JJ) + S(1, 2)
       A(KK, 1) = A(KK, 1) + S(2, 2)
   Next N
'
'
'     T W O - D I M E N S I O N A L   E L E M E N T S
'
'
lab50:
   If NEL2D = 0 Then GoTo lab270
   NLM = 2 * NEL1D
   Dim N1 As Integer
   Dim LL1 As Integer
   Dim LL2 As Integer
   Dim LL3 As Integer
   Dim LL4 As Integer
   For N = 1 To NEL2D
       N1 = N + NEL1D
       NLM = NLM + 4
       For I = 1 To 4
           For J = 1 To 4
               S(I, J) = 0#
           Next J
       Next I
       LL1 = LM(NLM - 3)
       LL2 = LM(NLM - 2)
       LL3 = LM(NLM - 1)
       LL4 = LM(NLM)
       AT(N1) = 0.25 * (T(LL1) + T(LL2) + T(LL3) + T(LL4))
'
'     TEST FOR ORIENTATION OF 2-D ELEMENT  -  X-Y, X-Z, OR Y-Z PLANE
'
       Dim J0 As Integer
       Dim ZZZ As Double
       Dim DZ As Double
       J0 = LM(NLM - 3)
       ZZZ = Z(J0)
       For I = 1 To 3
           J = LM(NLM - 3 + I)
           DZ = Abs(ZZZ - Z(J))
           If DZ > 0.00001 Then GoTo lab90
       Next I
       For I = 1 To 4
           J = LM(NLM - 4 + I)
           XX(I) = X(J)
           YY(I) = Y(J)
       Next I
     GoTo lab160
lab90:
     Dim YYY As Double
     Dim DY As Double
     YYY = Y(J0)
     For I = 1 To 3
       J = LM(NLM - 3 + I)
       DY = Abs(YYY - Y(J))
       If DY > 0.00001 Then GoTo lab120
     Next I
     For I = 1 To 4
       J = LM(NLM - 4 + I)
       XX(I) = X(J)
       YY(I) = Z(J)
     Next I
     GoTo lab160
lab120:
     Dim XXX As Double
     Dim DX As Double
     XXX = X(J0)
     For I = 1 To 3
       J = LM(NLM - 3 + I)
       DX = Abs(XXX - X(J))
       If DX > 0.00001 Then GoTo lab150
     Next I
     For I = 1 To 4
       J = LM(NLM - 4 + I)
       XX(I) = Y(J)
       YY(I) = Z(J)
     Next I
     GoTo lab160
lab150:
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " STOP-ERROR IN 2-D ELEMENT NO. "; N
     Print #NOUT, ""
     Print #NOUT, " NOT IN X-Y, X-Z, OR Y-Z PLANE"
     Close #NIN
     Close #NOUT
     End '<<<<<<<
lab160:
     Dim VOL As Double
     VOL = 0#
     Dim III As Integer
     Dim JJJ As Integer
     Dim SE As Double
     Dim TE As Double
     For III = 1 To 2
       For JJJ = 1 To 2
           SE = POS(III)
           TE = POS(JJJ)
           For I = 1 To 4
               PSTU(I) = (1# + SE * SI(I)) * (1# + TE * TI(I)) / 4#
               DPSTU(1, I) = SI(I) * (1# + TE * TI(I)) / 4#
               DPSTU(2, I) = TI(I) * (1# + SE * SI(I)) / 4#
           Next I
           For I = 1 To 2
               CJAC(I, 1) = 0#
               CJAC(I, 2) = 0#
               For J = 1 To 4
                   CJAC(I, 1) = CJAC(I, 1) + DPSTU(I, J) * XX(J)
                   CJAC(I, 2) = CJAC(I, 2) + DPSTU(I, J) * YY(J)
               Next J
           Next I
           Dim DETJ As Double
           Call INVMAT(CJAC(), DETJ, 2)
           VOL = VOL + DETJ * THICK(N)
           For I = 1 To 2
               For J = 1 To 4
                   B(I, J) = 0#
                   For K = 1 To 2
                       B(I, J) = B(I, J) + CJAC(I, K) * DPSTU(K, J)
                   Next K
               Next J
           Next I
           Dim ATT As Double
           ATT = 0#
           Dim L As Integer
           For I = 1 To 4
               L = LM(NLM - 4 + I)
               ATT = ATT + PSTU(I) * T(L)
           Next I
           TEMP = ATT
           MS = MMTYPE(N1)
           MS = (MS - 1) * 6
           J = MATL(MS + 1)
           K = MATL(MS + 2)
           'COND = VMAT(K, XYS(J), XYS(J + K), XYS(J + K + K), TEMP, "   K(T)   ")
           COND = VMAT(J, K, XYS(), TEMP, "   K(T)   ")    '---------tex
           J = MATL(MS + 3)
           K = MATL(MS + 4)
           'SPHT = VMAT(K, XYS(J), XYS(J + K), XYS(J + K + K), TEMP, "   CP(T)  ")
           SPHT = VMAT(J, K, XYS(), TEMP, "   CP(T)  ")    '---------tex
           J = MATL(MS + 5)
           K = MATL(MS + 6)
           'DENS = VMAT(K, XYS(J), XYS(J + K), XYS(J + K + K), TEMP, "    D(T)  ")
           DENS = VMAT(J, K, XYS(), TEMP, "    D(T)  ")    '---------tex
           Dim DETCON As Double
           DETCON = DETJ * COND * THICK(N)
           For I = 1 To 4
               For J = 1 To 4
                   For K = 1 To 2
                       S(I, J) = S(I, J) + DETCON * B(K, I) * B(K, J)
                   Next K
               Next J
           Next I
       Next JJJ
     Next III
     QSTORE = DENS * SPHT * VOL / 4#
'
'     ADD ELEMENT CAPACITY MATRIX TO SYSTEM CAPACITY MATRIX
'
     For L = 1 To 4
       I = LM(NLM - 4 + L)
       Q(I) = Q(I) + QSTORE
     Next L
'
'     ADD ELEMENT CONDUCTIVITY TO SYSTEM CONDUCTIVITY MATRIX
'
       Dim M As Integer
       For L = 1 To 4
           I = LM(NLM - 4 + L)
           For M = 1 To 4
               J = LM(NLM - 4 + M) - I + 1
               Select Case (J)
                   Case Is < 0
                       GoTo lab250
                   Case Is = 0
                       GoTo lab250
                   Case Is > 0
                       GoTo lab240
               End Select
lab240:
               A(I, J) = A(I, J) + S(L, M)
lab250:
           Next M
       Next L
   Next N
lab260:
'
'
'     T H R E E - D I M E N S I O N A L   E L E M E N T S
'
'
lab270:
   If NEL3D = 0 Then GoTo lab360
   'REWIND 6
   Dim TAPE6 As Integer
   TAPE6 = FreeFile
   Open percorso + nomefile + ".TAPE6" For Input As TAPE6
     
   NLM = 2 * NEL1D + 4 * NEL2D
   For N = 1 To NEL3D
       N1 = N + NEL1D + NEL2D
       NLM = NLM + 8
       For I = 1 To 8
           For J = 1 To 8
               S(I, J) = 0#
           Next J
       Next I
       Dim LL5 As Integer
       Dim LL6 As Integer
       Dim LL7 As Integer
       Dim LL8 As Integer
       LL1 = LM(NLM - 7)
       LL2 = LM(NLM - 6)
       LL3 = LM(NLM - 5)
       LL4 = LM(NLM - 4)
       LL5 = LM(NLM - 3)
       LL6 = LM(NLM - 2)
       LL7 = LM(NLM - 1)
       LL8 = LM(NLM)
       AT(N1) = 0.125 * (T(LL1) + T(LL2) + T(LL3) + T(LL4) + T(LL5) + T(LL6) + T(LL7) + T(LL8))
       Dim KKK As Integer
       For III = 1 To 2
           For JJJ = 1 To 2
               For KKK = 1 To 2
                   Input #TAPE6, DETJ
                   For I = 1 To 8
                       Input #TAPE6, PSTU(I)
                   Next I
                   For J = 1 To 8
                       For I = 1 To 3
                           Input #TAPE6, B(I, J)
                       Next I
                   Next J

                   ATT = 0#
                   For I = 1 To 8
                       L = LM(NLM - 8 + I)
                       ATT = ATT + PSTU(I) * T(L)
                   Next I
                   TEMP = ATT
                   MS = MMTYPE(N1)
                   MS = (MS - 1) * 6
                   J = MATL(MS + 1)
                   K = MATL(MS + 2)
                   'COND = VMAT(K, XYS(J), XYS(J + K), XYS(J + K + K), TEMP, "   K(T)   ")
                   COND = VMAT(J, K, XYS(), TEMP, "   K(T)   ")    '---------tex
                   J = MATL(MS + 3)
                   K = MATL(MS + 4)
                   'SPHT = VMAT(K, XYS(J), XYS(J + K), XYS(J + K + K), TEMP, "   CP(T)  ")
                   SPHT = VMAT(J, K, XYS(), TEMP, "   CP(T)  ")    '---------tex
                   J = MATL(MS + 5)
                   K = MATL(MS + 6)
                   'DENS = VMAT(K, XYS(J), XYS(J + K), XYS(J + K + K), TEMP, "    D(T)  ")
                   DENS = VMAT(J, K, XYS(), TEMP, "    D(T)  ")    '---------tex
                   DETCON = DETJ * COND
                   For I = 1 To 8
                       For J = 1 To 8
                           For K = 1 To 3
                               S(I, J) = S(I, J) + DETCON * B(K, I) * B(K, J)
                           Next K
                       Next J
                   Next I
               Next KKK
           Next JJJ
       Next III
       VOL = VOLUME(N)
       QSTORE = DENS * SPHT * VOL / 8#
'
'     ADD ELEMENT CAPACITY MATRIX TO SYSTEM CAPACITY MATRIX
'
       For L = 1 To 8
           I = LM(NLM - 8 + L)
           Q(I) = Q(I) + QSTORE
       Next L
'
'     ADD ELEMENT CONDUCTIVITY TO THE SYSTEMS CONDUCTIVITY MATRIX - A
'
       For L = 1 To 8
       I = LM(NLM - 8 + L)
           For M = 1 To 8
               J = LM(NLM - 8 + M) - I + 1
               Select Case (J)
                   Case Is < 0
                       GoTo lab340
                   Case Is = 0
                       GoTo lab340
                   Case Is > 0
                       GoTo lab330
               End Select
lab330:
               A(I, J) = A(I, J) + S(L, M)
lab340:
           Next M
       Next L
   Next N
Close #TAPE6
'
lab360:
'
'
End Sub

Private Sub HATEMP(ITOF As Integer, D() As Double, KODE() As Tipo_KODE, B() As Double, A() As Double, _
                  NUMNP As Integer, MAIN As Integer, T3() As Double, Q() As Double)
'
'
'     SUBROUTINE *HATEMP* APPLIES THE FIXED TEMPERATURE OR FLOW
'     BOUNDARY CONDITIONS
'
'
     'COMMON /CONTROL/ ITITLE(6),IREAD(80),NIN,NOUT,NPUNCH,NUMNP,NEL1D,_
     'NEL2D , NEL3D, NUMEL, MBAND, NMAT, NFBC1D, NFBC2D, NFBC3D, NBCMAT, NBCTYP
     'DIMENSION D(1), KODE(1), B(1), A(NUMNP, 1), T3(1), Q(1)
     
     'ReDim A(NUMNP, 1) As Double '-----------?????
     If MAIN <> 1 Then GoTo lab30
'
'     INITIALIZE TEMPERATURE AND FLOW B.C. TO 0.0
'
     Dim I As Integer
     For I = 1 To NUMNP
       D(I) = 0#
     Next I
'
     If ITOF = 0 Then GoTo lab30
'
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "     HVALUES OF TEMPERATURES OR FLOWS"
     Print #NOUT, ""
     Print #NOUT, "          FOR NON-ZERO BOUNDARY CONDITIONS"
     
'
'     INPUT NON-ZERO TEMPERATURE AND FLOW B.C.
'
     '-----------------------------------------------------
     ' Nonzero Boundary Condition Data (5(I5,F10.0))
     '-----------------------------------------------------
     For I = 1 To ITOF Step 5
       Line Input #NIN, str_tmp
       
       If I > ITOF Then Exit For
       Q(I) = Val(Mid$(str_tmp, 1, 5))             'Node number
       T3(I) = Val(Mid$(str_tmp, 6, 10))           'Specified temperature or flow at that node
       
       If I + 1 > ITOF Then Exit For
       Q(I + 1) = Val(Mid$(str_tmp, 16, 5))
       T3(I + 1) = Val(Mid$(str_tmp, 21, 10))
       
       If I + 2 > ITOF Then Exit For
       Q(I + 2) = Val(Mid$(str_tmp, 31, 5))
       T3(I + 2) = Val(Mid$(str_tmp, 36, 10))
       
       If I + 3 > ITOF Then Exit For
       Q(I + 3) = Val(Mid$(str_tmp, 46, 5))
       T3(I + 3) = Val(Mid$(str_tmp, 51, 10))
       
       If I + 4 > ITOF Then Exit For
       Q(I + 4) = Val(Mid$(str_tmp, 61, 5))
       T3(I + 4) = Val(Mid$(str_tmp, 66, 10))
     Next I

     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "    NODE       TYPE          VALUE"
     
'
'     OUTPUT THE NON-ZERO BOUNDARY CONDITIONS AND STORE IN MATRIX D
'
     Dim II As Integer
     Dim JJ As Tipo_KODE
     For I = 1 To ITOF
           II = Q(I)
           D(II) = T3(I)
           JJ = KODE(II)
           Print #NOUT, II; "       "; JJ; "     "; D(II)
     Next I
'
lab30:
     Dim N As Integer
     For N = 1 To NUMNP
'
'     MODIFY MATRIX B FOR FLOW B.C.
'
       B(N) = B(N) + D(N)
       'If KODE(N) = "FLOW" Then GoTo lab90
       If KODE(N) = FLOW Then GoTo lab90
'
'     MODIFY A AND B MATRIX FOR TEMPERATURE B.C.
'
       Dim M As Integer
       Dim K As Integer
       For M = 2 To MBAND
           K = N - M + 1
           Select Case (K)
                   Case Is < 0
                       GoTo lab50
                   Case Is = 0
                       GoTo lab50
                   Case Is > 0
                       GoTo lab40
           End Select
lab40:
           B(K) = B(K) - A(K, M) * D(N)
           A(K, M) = 0#
lab50:
           Dim L As Integer
           L = N + M - 1
           Select Case (NUMNP - L)
                   Case Is < 0
                       GoTo lab70
                   Case Is = 0
                       GoTo lab60
                   Case Is > 0
                       GoTo lab60
           End Select
lab60:
           B(L) = B(L) - A(N, M) * D(N)
lab70:
           A(N, M) = 0#
       Next M

       A(N, 1) = 1#
       B(N) = D(N)
lab90:
     Next N
'
'
'
End Sub

GO TO (10,70), KKK

Select Case KKK
           Case 1
               GoTo lab10
           Case 2
               GoTo lab70
       End Select

Private Sub MSYM(KKK As Integer, B() As Double, MA() As Integer, A() As Double, NUMNP As Integer)
'
'
'     SUBROUTINE *MSYM* IS AN EQUATION SOLVER
'     BASED ON A MODIFIED SYMSOL - VARIABLE BANDWIDTH WITH ZEROS IN BAND
'
'
     'COMMON /CONTROL/ ITITLE(6),IREAD(80),NIN,NOUT,NPUNCH,NUMNP,NEL1D,NEL2D,
     'NEL3D,NUMEL,MBAND,NMAT,NFBC1D,NFBC2D,NFBC3D,NBCMAT,NBCTYP
     'DIMENSION B(1), MA(1), A(NP, 1)
'
       'ReDim A(NP, 1) As Double '-----------?????
       Dim NEQ As Integer
       NEQ = NUMNP
'
       Select Case KKK
           Case 1
               GoTo lab10
           Case 2
               GoTo lab70
       End Select
'
'     ****************************************************************
'
'     REDUCE MATRIX..... A
'
'     ****************************************************************
'
lab10:
       Dim NEQQ As Integer
       Dim N As Integer
       Dim M As Integer
       Dim I As Integer
       Dim L As Integer
       Dim CC As Double
       Dim J As Integer
       Dim K As Integer
       NEQQ = NEQ - 1
       For N = 1 To NEQQ
'
           M = MBAND
           For I = 2 To MBAND
               If A(N, M) <> 0# Then GoTo lab30
               M = M - 1
           Next I
lab30:
           MA(N) = M
'
           I = N
           For L = 2 To M
               I = I + 1
               CC = A(N, L) / A(N, 1)
               If CC = 0# Then GoTo lab50
               J = 0
               For K = L To M
                   J = J + 1
                   A(I, J) = A(I, J) - CC * A(N, K)
               Next K
               A(N, L) = CC
lab50:
           Next L
       Next N
       GoTo lab120
'
'     ****************************************************************
'
'     REDUCE VECTOR..... B AND BACKSUBSTITUTE
'
'     ****************************************************************
'
lab70:
       For N = 1 To NEQQ
           CC = B(N)
           If CC = 0# Then GoTo lab90
           M = MA(N)
           I = N
           For L = 2 To M
               I = I + 1
               B(I) = B(I) - CC * A(N, L)
           Next L
           B(N) = CC / A(N, 1)
lab90:
       Next N
       B(NEQ) = B(NEQ) / A(NEQ, 1)
'
       Dim NN As Integer
       NN = NEQ
       For N = 1 To NEQQ
           NN = NN - 1
           M = MA(NN)
           I = NN
           For K = 2 To M
               I = I + 1
               B(NN) = B(NN) - A(NN, K) * B(I)
           Next K
       Next N
lab120:
End Sub

GO TO (10,20,30,40), K

Select Case K
       Case 1
           GoTo lab10
       Case 2
           GoTo lab20
       Case 3
           GoTo lab30
       Case 4
           GoTo lab40
     End Select

Private Sub PROUT(K As Integer, T() As Double, AT() As Double, LM() As Integer, T1() As Double, B() As Double, _
                 MAIN As Integer, NCON As Integer, I1 As Integer)
'
'
'     SUBROUTINE *PROUT* PRINTS TEMPERATURE DISTRIBUTIONS
'       ( BOTH NODAL AND ELEMENT )
'
'
     'COMMON /CONTROL/ ITITLE(6),IREAD(80),NIN,NOUT,NPUNCH,NUMNP,NEL1D,
     'NEL2D , NEL3D, NUMEL, MBAND, NMAT, NFBC1D, NFBC2D, NFBC3D, NBCMAT, NBCTYP
     'DIMENSION T(1), AT(1), T1(1), B(1), LM(1)
'
'
     Select Case K
       Case 1
           GoTo lab10
       Case 2
           GoTo lab20
       Case 3
           GoTo lab30
       Case 4
           GoTo lab40
     End Select
'
lab10:
'
'     DEBUGGING OUTPUT FOR TEMPERATURES AT BEGINNING OF SYSTEM CYCLE
'
     Print #NOUT, ""
     Print #NOUT, "  NODAL POINT TEMPERATURES AT BEGINNING OF SYSTEM CYCLE NUMBER"; MAIN
     Dim N As Integer
     For N = 1 To NUMNP
       Print #NOUT, N, T(N),
       If N Mod 4 = 0 Then Print #NOUT, ""
     Next N
       Print #NOUT, ""
     Exit Sub
'
lab20:
'
'     DEBUGGING OUTPUT TEMPERATURES FOR FIRE B.C. CYCLE
'
     Print #NOUT, ""
     Print #NOUT, "  NODAL POINT TEMPERATURE FOR B.C. CYCLE"; NCON
     For N = 1 To NUMNP
       Print #NOUT, N, B(N),
       If N Mod 4 = 0 Then Print #NOUT, ""
     Next N
       Print #NOUT, ""
     Exit Sub
'
lab30:
'
'     OUTPUT DATA FOR DUMP WHEN PROBLEM HAS NOT CONVERGED AFTER
'     PERMISSIBLE NUMBER OF CYCLES
'
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "  PROGRAM TERMINATED"
     Print #NOUT, ""
     Print #NOUT, "  CONVERGENCE NOT OBTAINED IN REQUIRED NUMBER OF ITERATIONS"
     Print #NOUT, ""
     Print #NOUT, "  SYSTEM CYCLE "; MAIN; " AND B.C. CYCLE "; NCON
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "  SYSTEM NODAL POINT TEMPERATURES"
     For N = 1 To NUMNP
       Print #NOUT, N, T1(N),
       If N Mod 4 = 0 Then Print #NOUT, ""
     Next N
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "  NODAL POINT TEMPERATURES AT BEGINNING OF B.C. CYCLE"
     For N = 1 To NUMNP
       Print #NOUT, N, T(N),
       If N Mod 4 = 0 Then Print #NOUT, ""
     Next N
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "  NODAL POINT TEMPERATURES AT END OF B.C. CYCLE"
     For N = 1 To NUMNP
       Print #NOUT, N, B(N),
       If N Mod 4 = 0 Then Print #NOUT, ""
     Next N
     Print #NOUT, ""
     Close #NIN
     Close #NOUT
     End '<<<<<<<<
'
lab40:
'
'     OUTPUT OF RESULTS FOR A TIME STEP
'
     Select Case (I1 = 1 Or I1 = 3)
       Case True
           GoTo lab50
       Case False
           GoTo lab60
     End Select
lab50:
'
'     OUTPUT NODAL POINT TEMPERTURES
'
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " ------------ NODAL POINT TEMPERATURES ---------------"
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "     N    TEMP.     N    TEMP.     N    TEMP.     N    TEMP. "
     For N = 1 To NUMNP
       Print #NOUT, N, T(N),
       If N Mod 4 = 0 Then Print #NOUT, ""
     Next N
     Print #NOUT, ""
lab60:
     Select Case (I1 = 2 Or I1 = 3)
       Case True
           GoTo lab70
       Case False
           GoTo lab130
     End Select

'
'     OUTPUT ELEMENT TEMPERATURES
'
'     ONE-DIMENSIONAL ELEMENTS
'
lab70:
     If NEL1D = 0 Then GoTo lab90
     Dim NLM As Integer
     NLM = 0
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " -------------- TEMPERATURE OF 1-D ELEMENTS -------------"
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "     N    TEMP.     N    TEMP.     N    TEMP.     N    TEMP. "
     Dim LL1 As Integer
     Dim LL2 As Integer
     For N = 1 To NEL1D
       NLM = NLM + 2
       LL1 = LM(NLM - 1)
       LL2 = LM(NLM)
       AT(N) = 0.5 * (T(LL1) + T(LL2))
     Next N
     For N = 1 To NEL1D
       Print #NOUT, N, AT(N),
       If N Mod 4 = 0 Then Print #NOUT, ""
     Next N
     Print #NOUT, ""
'
'     TWO-DIMENSIONAL ELEMENTS
'
lab90:
     If NEL2D = 0 Then GoTo lab110
     NLM = 2 * NEL1D
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " -------------- TEMPERATURE OF 2-D ELEMENTS -------------"
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "     N    TEMP.     N    TEMP.     N    TEMP.     N    TEMP. "
     Dim LL3 As Integer
     Dim LL4 As Integer
     For N = 1 To NEL2D
       NLM = NLM + 4
       LL1 = LM(NLM - 3)
       LL2 = LM(NLM - 2)
       LL3 = LM(NLM - 1)
       LL4 = LM(NLM)
       AT(N + NEL1D) = 0.25 * (T(LL1) + T(LL2) + T(LL3) + T(LL4))
     Next N
     For N = 1 To NEL2D
       Print #NOUT, N, AT(N + NEL1D),
       If N Mod 4 = 0 Then Print #NOUT, ""
     Next N
     Print #NOUT, ""
'
'     THREE-DIMENSIONAL ELEMENTS
'
lab110:
     If NEL3D = 0 Then GoTo lab130
     NLM = 2 * NEL1D + 4 * NEL2D
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " -------------- TEMPERATURE OF 3-D ELEMENTS -------------"
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "     N    TEMP.     N    TEMP.     N    TEMP.     N    TEMP. "
     Dim LL5 As Integer
     Dim LL6 As Integer
     Dim LL7 As Integer
     Dim LL8 As Integer
     Dim N1 As Integer
     Dim N2 As Integer
     For N = 1 To NEL3D
       NLM = NLM + 8
       LL1 = LM(NLM - 7)
       LL2 = LM(NLM - 6)
       LL3 = LM(NLM - 5)
       LL4 = LM(NLM - 4)
       LL5 = LM(NLM - 3)
       LL6 = LM(NLM - 2)
       LL7 = LM(NLM - 1)
       LL8 = LM(NLM)
       N1 = N + NEL1D + NEL2D
       AT(N1) = 0.125 * (T(LL1) + T(LL2) + T(LL3) + T(LL4) + T(LL5) + T(LL6) + T(LL7) + T(LL8))
     Next N
     N2 = NEL1D + NEL2D
     For N = 1 To NEL3D
       Print #NOUT, N, AT(N + N2),
       If N Mod 4 = 0 Then Print #NOUT, ""
     Next N
     Print #NOUT, ""
'
lab130:
'
'
End Sub

Private Sub PUOUT(I1 As Integer, I2 As Integer, T() As Double, AT() As Double, _
                 X() As Double, Y() As Double, Z() As Double, TIME As Double, _
                 IP1 As Integer, IP2 As Integer, LM() As Integer, JP As String)
'
'
'     SUBROUTINE *PUOUT* PUNCHES THE TEMPERATURE DISTRIBUTIONS THAT
'     RESULT FROM THE ANALYSIS DONE IN THE PROGRAM.
'        JP - IDENTIFIER TO BE USED IN LAST 8 COLUMNS
'        IP1 - COUNTER FOR NODAL DATA CARDS PUNCHED
'        IP2 - COUNTER FOR ELEMENT DATA CARDS PUNCHED
'
'
     'COMMON /CONTROL/ ITITLE(6),IREAD(80),NIN,NOUT,NPUNCH,NUMNP,NEL1D,
     'NEL2D , NEL3D, NUMEL, MBAND, NMAT, NFBC1D, NFBC2D, NFBC3D, NBCMAT, NBCTYP
     'DIMENSION T(1), AT(1), X(1), Y(1), Z(1), LM(1)

'-------------------------------------
'DISPOSITIVO DI PERFORAZIONE NASTRO
'NON IMPLEMENTABILE HARDWARE OBSOLETO
'-------------------------------------

       Print #NOUT, ""
       Print #NOUT, ""
       Print #NOUT, "  . . . PUNCHING NOT IMPLEMENTED  . . ."
       Print #NOUT, "  . . . . OBSOLETE HARDWARE . . . . . ."
       
End Sub

Private Sub FIREMAT(MAT() As Integer, FXYS() As Tipo_XYS, NSTORE As Integer)
'
'
'     SUBROUTINE *FIREMAT* INPUTS THE VARIABLES REQUIRED IN THE
'     ASSESSMENT OF THE HEAT FLOW ASSOCIATED WITH BOTH LINEAR AND
'     NON-LINEAR FIRE BOUNDARY CONDITIONS
'
'
     'COMMON /CONTROL/ ITITLE(6),IREAD(80),NIN,NOUT,NPUNCH,NUMNP,NEL1D,
     'NEL2D,NEL3D,NUMEL,MBAND,NMAT,NFBC1D,NFBC2D,NFBC3D,NBCMAT,NBCTYP
     'DIMENSION MAT(1), FXYS(1)
'
'     OUTPUT PAGE HEADING
'
     Print #NOUT, "6"
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " ************************************************************"
     Print #NOUT, ""
     Print #NOUT, "     FIRES-T3  -  FIRE RESPONSE OF STRUCTURES - THERMAL"
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " "; ITITLE
'
     'If NBCTYP = "LINEAR BC " Then GoTo lab20
     If NBCTYP = LINEAR_BC Then GoTo lab20
'
'     NON-LINEAR FIRE BOUNDARY CONDITION
'
     Print #NOUT, ""
     Print #NOUT, "     NON-LINEAR FIRE BOUNDARY CONDITION"
     Print #NOUT, ""
     Print #NOUT, " ************************************************************"
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " Q=A*(TF-TS)**N+SB*V*(AB*EF*(TF+TSHIFT)**4-ES*(TS+TSHIFT)**4)"
     
     Dim SB As Double
     Dim TSHIFT As Double
     
     '-----------------------------------------------------
     ' Constant Data Card (2E10.0)
     '-----------------------------------------------------
     Line Input #NIN, str_tmp
     SB = Val(Mid$(str_tmp, 1, 10))        'Stephan - Boltzman constant
     TSHIFT = Val(Mid$(str_tmp, 11, 10))   'Shift for absolute temperature

     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " WHERE"
     Print #NOUT, ""
     Print #NOUT, "      TF - PSUEDO FIRE TEMPERATURE"
     Print #NOUT, "      TS - SURFACE TEMPERATURE"
     Print #NOUT, "      SB - STEFAN BOLZTMANN CONSTANT = "; SB
     Print #NOUT, "      TSHIFT - SHIFT TO ABSOLUTE TEMPERATURE SCALE = "; TSHIFT
     Print #NOUT, ""
     Print #NOUT, " AND"
     Print #NOUT, ""
     Print #NOUT, " MAT  CONVECT  CONVECT     VIEW  ABSORBT     FIRE  SURFACE"
     Print #NOUT, " NUM   FACTOR    POWER   FACTOR           EMISSIV  EMISSIV"
     Print #NOUT, "          (A)      (N)      (V)     (AB)     (EF)     (ES)"

     ReDim FXYS(1 To 2) As Tipo_XYS  '-------------tex
'
     FXYS(1).X = SB                        'SB - STEFAN BOLZTMANN CONSTANT
     FXYS(2).X = TSHIFT                    'TSHIFT - SHIFT TO ABSOLUTE TEMPERATURE SCALE
     NSTORE = 3
'
'     INPUT DIFFERENT MATERIAL PROPERTIES FOR FIRE BC
'
     Dim I As Integer
     Dim A As Double
     Dim P As Double
     Dim V As Double
     Dim AB As Double
     Dim EF As Double
     Dim ES As Double
     
     For I = 1 To NBCMAT
       MAT(I) = NSTORE
       
      '-----------------------------------------------------
      ' Material Data Card (6E10.0)
      '-----------------------------------------------------
       Line Input #NIN, str_tmp
       A = Val(Mid$(str_tmp, 1, 10))       'Convection factor
       P = Val(Mid$(str_tmp, 11, 10))      'Power of convection factor
       V = Val(Mid$(str_tmp, 21, 10))      'View factor for radiation term
       AB = Val(Mid$(str_tmp, 31, 10))     'Absorption of surface
       EF = Val(Mid$(str_tmp, 41, 10))     'Emissivity of flame
       ES = Val(Mid$(str_tmp, 51, 10))     'Emissivity of surface

       Print #NOUT, I, A, P, V, AB, EF, ES
       
       ReDim Preserve FXYS(1 To NSTORE + 5) As Tipo_XYS '-------------tex
       FXYS(NSTORE).X = A                  'CONVECT FACTOR
       FXYS(NSTORE + 1).X = P              'CONVECT POWER
       FXYS(NSTORE + 2).X = V              'VIEW FACTOR
       FXYS(NSTORE + 3).X = AB             'ABSORBT
       FXYS(NSTORE + 4).X = EF             'FIRE EMISSIV
       FXYS(NSTORE + 5).X = ES             'SURFACE EMISSIV
       NSTORE = NSTORE + 6
       
     Next I
     Exit Sub
'
lab20:
'
'     LINEAR FIRE BOUNDARY CONDITION
'
     Print #NOUT, ""
     Print #NOUT, "     LINEAR FIRE BOUNDARY CONDITION"
     Print #NOUT, ""
     Print #NOUT, " ************************************************************"
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "         Q = H(T)*(TF-TS)"
     Print #NOUT, ""
     Print #NOUT, "          WHERE"
     Print #NOUT, "               H(T) - HEAT TRANSFER COEFFICENT"
     Print #NOUT, "               TF - PSUEDO FIRE TEMPERATURE"
     Print #NOUT, "               TS - SURFACE TEMPERATURE"
     Print #NOUT, "               T - AVERAGE TEMPERATUTE (TF+TS)/2"
     Print #NOUT, ""
'
     NSTORE = 1
     Dim K As Integer
     Dim MS As Integer
     For I = 1 To NBCMAT
       Print #NOUT, ""
       Print #NOUT, ""
       Print #NOUT, "   . . . MATERIAL NUMBER "; I; " . . ."
       Input #NIN, K
       MS = (I - 1) * 2
       MAT(MS + 1) = NSTORE
       MAT(MS + 2) = K
'
       If K > 0 Then                                               '------------tex
           ReDim Preserve FXYS(1 To NSTORE + K - 1) As Tipo_XYS         '------------tex
           Call MATIN(NSTORE, K, FXYS())                           '------------tex
           NSTORE = NSTORE + K                                     '------------tex
       Else                                                        '------------tex
           ReDim Preserve FXYS(1 To NSTORE) As Tipo_XYS                 '------------tex
           Call MATIN(NSTORE, K, FXYS())                           '------------tex
           NSTORE = NSTORE + 1                                     '------------tex
       End If                                                      '------------tex
       'Call MATIN(K, FXYS(NSTORE), FXYS(NSTORE + K), FXYS(NSTORE + K + K))
'
       'NSTORE = NSTORE + 3 * K
       'If K = 0 Then NSTORE = NSTORE + 1
       
     Next I
lab30:
'
End Sub

Private Sub FIREBC(X() As Double, Y() As Double, Z() As Double, KODE() As Tipo_KODE, BAREA() As Double, _
                 THICK() As Double, LI() As Integer, LJ() As Integer, LK() As Integer, LL() As Integer, _
                 LMAT() As Integer, LFIRE() As Integer, AIJKL() As Double, LELEM() As Integer)
'
'
'     SUBROUTINE *FIREBC* INPUTS THE GEOMETRIC DESCRIPTION OF THE
'     SURFACE OF THE SYSTEM THAT WILL BE DIRECTLY EXPOSED TO THE
'     FIRE ENVIRONMENT
'
'
     'COMMON /CONTROL/ ITITLE(6),IREAD(80),NIN,NOUT,NPUNCH,NUMNP,NEL1D,
     'NEL2D , NEL3D, NUMEL, MBAND, NMAT, NFBC1D, NFBC2D, NFBC3D, NBCMAT, NBCTYP
     'COMMON /SURFACE/ NS1,NS2,NS3
     'DIMENSION X(1), Y(1), KODE(1), LI(1), LJ(1), LMAT(1), LFIRE(1),
     'Z(1), LK(1), LL(1), AIJKL(1), BAREA(1), THICK(1), LELEM(1)
'
'     INPUT CONTROL CARD
'
     Input #NIN, IREAD
     'If Mid$(IREAD, 1, 1) = Chr$(23) Then GoTo lab10
     If InStr(IREAD, "SURFACE") > 0 Then GoTo lab10 'HACK <<<<<<<
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " - - - PROGRAM TERMINATED - INPUT ERROR - - -"
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " "; IREAD
     Close #NIN
     Close #NOUT
     End '<<<<<<<
lab10:
     Dim N As Integer
     N = 1
     'NS1 = NUMBER(N)
     'NS2 = NUMBER(N)
     'NS3 = NUMBER(N)
     Input #NIN, NS1 'HACK <<<<<<<
     Input #NIN, NS2 'HACK <<<<<<<
     Input #NIN, NS3 'HACK <<<<<<<
     
'
'     O N E - D I M E N S I O N A L   E L E M E N T S
'
     If NS1 = 0 Then GoTo lab60
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " . . . THERE ARE"; NS1; " 1-D SURFACE NODES EXPOSED TO FIRE . . ."
     
'
'     INPUT FIRE SURFACE DATA - 4 ELEMENTS PER CARD
'
     '---------------------------------------------------------
     ' Description of One-Dimensional Fire Surface Nodes (16I5)
     '---------------------------------------------------------
     Dim I As Integer
     For I = 1 To NS1 Step 4
       Line Input #NIN, str_tmp
       
       If I > NS1 Then Exit For
       LI(I) = Val(Mid$(str_tmp, 1, 5))            'Node number of first boundary surface node
       LMAT(I) = Val(Mid$(str_tmp, 6, 5))          'Material type for this surface node <=NBCMAT
       LFIRE(I) = Val(Mid$(str_tmp, 11, 5))        'Fire number for this surface node
       LELEM(I) = Val(Mid$(str_tmp, 16, 5))        'Element number of one-dimensional isoparametric
                                                   'bar element adjacent to this surface node
       If I + 1 > NS1 Then Exit For
       LI(I + 1) = Val(Mid$(str_tmp, 21, 5))
       LMAT(I + 1) = Val(Mid$(str_tmp, 26, 5))
       LFIRE(I + 1) = Val(Mid$(str_tmp, 31, 5))
       LELEM(I + 1) = Val(Mid$(str_tmp, 36, 5))
       
       If I + 2 > NS1 Then Exit For
       LI(I + 2) = Val(Mid$(str_tmp, 41, 5))
       LMAT(I + 2) = Val(Mid$(str_tmp, 46, 5))
       LFIRE(I + 2) = Val(Mid$(str_tmp, 51, 5))
       LELEM(I + 2) = Val(Mid$(str_tmp, 56, 5))
       
       If I + 3 > NS1 Then Exit For
       LI(I + 3) = Val(Mid$(str_tmp, 61, 5))
       LMAT(I + 3) = Val(Mid$(str_tmp, 66, 5))
       LFIRE(I + 3) = Val(Mid$(str_tmp, 71, 5))
       LELEM(I + 3) = Val(Mid$(str_tmp, 76, 5))
       
     Next I
'
'     CHECK VALIDITY OF MATERIAL REQUIREMENTS AND PREVIOUSLY DECLARED
'     BOUNDARY CONDITIONS.  FOR A SURFACE TO BE CONSIDERED A FIRE B.C.
'     IT MUST BE BOUNDED BY NODES THAT HAVE A DECLARED FLOW B.C.
'
     Dim II As Integer
     For I = 1 To NS1
       If LMAT(I) > NBCMAT Then GoTo lab30
       II = LI(I)
       'If KODE(II) = "TEMP" Then GoTo lab30
       If KODE(II) = TEMP Then GoTo lab30
     Next I
     GoTo lab40
lab30:
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "  - - - PROGRAM TERMINATED - FIRE BC INPUT ERROR - - - "; _
                  I, LI(I), LMAT(I), LFIRE(I), LELEM(I)
     Close #NIN
     Close #NOUT
     End '<<<<<<<
'
'     CALCULATE AREA OF EACH FIRE B.C. SURFACE
'
lab40:
     For I = 1 To NS1
       II = LELEM(I)
       AIJKL(I) = BAREA(II)
     Next I
'
'     OUTPUT SURFACE ELEMENT DATA
'
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "DESCRIPTION OF SURFACE DIRECTLY EXPOSED TO FIRE"
     Print #NOUT, ""
     Print #NOUT, " FIREBC   NODE    MAT   FIRE      AREA"
     Print #NOUT, " SURFACE     I   TYPE   TYPE"
     Print #NOUT, ""
     For I = 1 To NS1
       Print #NOUT, I, LI(I), LMAT(I), LFIRE(I), AIJKL(I)
     Next I
'
'     T W O - D I M E N S I O N A L   E L E M E N T S
'
lab60:
     If NS2 = 0 Then GoTo lab120
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " . . . THERE ARE"; NS2; " 2-D SURFACE ELEMENTS EXPOSED TO FIRE . ."
     
'
'     INPUT SURFACE ELEMENT DATA - THREE ELEMENTS PER CARD
'
     '------------------------------------------------------------
     ' Description of Two-Dimensional Fire Surface Segments (15I5)
     '------------------------------------------------------------
     Dim I1 As Integer
     Dim I2 As Integer
     I1 = NFBC1D + 1
     I2 = NFBC1D + NS2
     For I = I1 To I2 Step 3
       Line Input #NIN, str_tmp
       
       If I > I2 Then Exit For
       LI(I) = Val(Mid$(str_tmp, 1, 5))                'Node number of segment end I for first surface segment
       LJ(I - NFBC1D) = Val(Mid$(str_tmp, 6, 5))       'Node number of segment end J for first surface segment
       LMAT(I) = Val(Mid$(str_tmp, 11, 5))             'Material type for this surface segment <=NBCMAT
       LFIRE(I) = Val(Mid$(str_tmp, 16, 5))            'Fire number for this surface segment
       LELEM(I) = Val(Mid$(str_tmp, 21, 5))            'Element number of two-dimensional quadrilateral or
                                                       'triangular element adjacent to this surface segment
       If I + 1 > I2 Then Exit For
       LI(I + 1) = Val(Mid$(str_tmp, 26, 5))
       LJ(I - NFBC1D + 1) = Val(Mid$(str_tmp, 31, 5))
       LMAT(I + 1) = Val(Mid$(str_tmp, 36, 5))
       LFIRE(I + 1) = Val(Mid$(str_tmp, 41, 5))
       LELEM(I + 1) = Val(Mid$(str_tmp, 46, 5))
       
       If I + 2 > I2 Then Exit For
       LI(I + 2) = Val(Mid$(str_tmp, 51, 5))
       LJ(I - NFBC1D + 2) = Val(Mid$(str_tmp, 56, 5))
       LMAT(I + 2) = Val(Mid$(str_tmp, 61, 5))
       LFIRE(I + 2) = Val(Mid$(str_tmp, 66, 5))
       LELEM(I + 2) = Val(Mid$(str_tmp, 71, 5))
       
     Next I
'
'     CHECK VALIDITY OF MATERIAL REQUIREMENTS AND PREVIOUSLY DECLARED
'     BOUNDARY CONDITIONS.  FOR A SURFACE TO BE CONSIDERED A FIRE B.C.
'     IT MUST BE BOUNDED BY NODES THAT HAVE A DECLARED FLOW B.C.
'
     Dim JJ As Integer
     For I = I1 To I2
       If LMAT(I) > NBCMAT Then GoTo lab80
       II = LI(I)
       JJ = LJ(I - NFBC1D)
       'If KODE(II) = "TEMP" Or KODE(JJ) = "TEMP" Then GoTo lab80
       If KODE(II) = TEMP Or KODE(JJ) = TEMP Then GoTo lab80
     Next I
     GoTo lab90
'
lab80:
     Dim I0 As Integer
     I0 = I - NFBC1D
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "  - - - PROGRAM TERMINATED - FIRE BC INPUT ERROR - - - "; _
                  I0, LI(I), LJ(I0), LMAT(I), LFIRE(I), LELEM(I)
     Close #NIN
     Close #NOUT
     End '<<<<<<<<
'
'     CALCULATE AREA OF FIRE B.C. SURFACE ELEMENT
'
lab90:
     Dim DX As Double
     Dim DY As Double
     Dim DZ As Double
     Dim D As Double
     Dim IK As Integer
     For I = I1 To I2
       II = LI(I)
       JJ = LJ(I - NFBC1D)
       DX = X(II) - X(JJ)
       DY = Y(II) - Y(JJ)
       DZ = Z(II) - Z(JJ)
       D = DX * DX + DY * DY + DZ * DZ
       IK = LELEM(I)
       AIJKL(I) = Sqr(D) * THICK(IK)
     Next I
'
'     OUTPUT SURFACE ELEMENT DATA
'
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "         DESCRIPTION OF SURFACE DIRECTLY EXPOSED TO FIRE"
     Print #NOUT, ""
     Print #NOUT, " FIREBC   NODE   NODE    MAT   FIRE      AREA"
     Print #NOUT, " SURFACE     I      J   TYPE   TYPE"
     Print #NOUT, ""
     For I = 1 To NS2
       Print #NOUT, I, LI(I + NFBC1D), LJ(I), LMAT(I + NFBC1D), LFIRE(I + NFBC1D), AIJKL(I + NFBC1D)
     Next I
'
'     REDUCE AREA TO 1/2 FOR FUTURE CALCULATIONS
'
     For I = I1 To I2
       AIJKL(I) = AIJKL(I) / 2#
     Next I
'
'     T H R E E - D I M E N S I O N A L   E L E M E N T S
'
lab120:
     If NS3 = 0 Then GoTo lab190
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " . . . THERE ARE"; NS3; " 3-D SURFACE ELEMENTS EXPOSED TO FIRE . ."
'
'     INPUT FIRE B.C. DATA  -  TWO ELEMENTS PER CARD
'
     '------------------------------------------------------------
     ' Description of Three-Dimensional Fire Surface Areas (12I5)
     '------------------------------------------------------------
     I1 = NFBC1D + NFBC2D + 1
     I2 = NFBC1D + NFBC2D + NS3
     Dim N1 As Integer
     N1 = NFBC1D + NFBC2D
     For I = I1 To I2 Step 2
       Line Input #NIN, str_tmp
       
       If I > I2 Then Exit For
       LI(I) = Val(Mid$(str_tmp, 1, 5))                'Node number of corner I for first surface element
       LJ(I - NFBC2D) = Val(Mid$(str_tmp, 6, 5))       'Node number of corner J for first surface element
       LK(I - N1) = Val(Mid$(str_tmp, 11, 5))          'Node number of corner K for first surface element
       LL(I - N1) = Val(Mid$(str_tmp, 16, 5))          'Node number of corner L for first surface element
       LMAT(I) = Val(Mid$(str_tmp, 21, 5))             'Material type for this surface element <=NBCMAT
       LFIRE(I) = Val(Mid$(str_tmp, 26, 5))            'Fire number for this surface element

       If I + 1 > I2 Then Exit For
       LI(I + 1) = Val(Mid$(str_tmp, 31, 5))
       LJ(I - NFBC2D + 1) = Val(Mid$(str_tmp, 36, 5))
       LK(I - N1 + 1) = Val(Mid$(str_tmp, 41, 5))
       LL(I - N1 + 1) = Val(Mid$(str_tmp, 46, 5))
       LMAT(I + 1) = Val(Mid$(str_tmp, 51, 5))
       LFIRE(I + 1) = Val(Mid$(str_tmp, 56, 5))

      Next I
     
'
'     CHECK VALIDITY OF MATERIAL REQUIREMENTS AND PREVIOUSLY DECLARED
'     BOUNDARY CONDITIONS.  FOR A SURFACE TO BE CONSIDERED A FIRE B.C.
'     IT MUST BE BOUNDED BY NODES THAT HAVE A DECLARED FLOW B.C.
'
     Dim KK As Integer
     Dim LLL As Integer
     For I = 1 To NS3
       If LMAT(I + N1) > NBCMAT Then GoTo lab140
       II = LI(I + N1)
       JJ = LJ(I + NFBC2D)
       KK = LK(I)
       LLL = LL(I)
       'If KODE(II) = "TEMP" Or KODE(JJ) = "TEMP" Then GoTo lab140
       'If KODE(KK) = "TEMP" Or KODE(LLL) = "TEMP" Then GoTo lab140
       If KODE(II) = TEMP Or KODE(JJ) = TEMP Then GoTo lab140
       If KODE(KK) = TEMP Or KODE(LLL) = TEMP Then GoTo lab140
     Next I
     GoTo lab150
'
lab140:
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "  - - - PROGRAM TERMINATED - FIRE BC INPUT ERROR - - - "; _
                  I, LI(I + N1), LJ(I + NFBC2D), LK(I), LL(I), LMAT(I + N1), LFIRE(I + N1)
     Close #NIN
     Close #NOUT
     End '<<<<<<<<
'
'     CALCULATE THE  AREA  OF THE FIRE BC SURFACE ELEMENTS
'
lab150:
     Dim XL1 As Double
     Dim XL2 As Double
     For I = 1 To NS3
       II = LI(I + N1)
       JJ = LJ(NFBC2D + I)
       KK = LK(I)
       DX = X(II) - X(JJ)
       DY = Y(II) - Y(JJ)
       DZ = Z(II) - Z(JJ)
       D = DX * DX + DY * DY + DZ * DZ
       XL1 = Sqr(D)
       DX = X(JJ) - X(KK)
       DY = Y(JJ) - Y(KK)
       DZ = Z(JJ) - Z(KK)
       D = DX * DX + DY * DY + DZ * DZ
       XL2 = Sqr(D)
       AIJKL(I + N1) = XL1 * XL2
       Select Case (LK(I) - LL(I))
           Case Is < 0
               GoTo lab170
           Case Is = 0
               GoTo lab160
           Case Is > 0
               GoTo lab170
       End Select
lab160:
       AIJKL(I + N1) = 0.5 * AIJKL(I + N1)
lab170:
     Next I
'
'     OUTPUT SURFACE ELEMENT DATA
'
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "         DESCRIPTION OF SURFACE DIRECTLY EXPOSED TO FIRE"
     Print #NOUT, ""
     Print #NOUT, " FIREBC   NODE   NODE   NODE   NODE    MAT   FIRE      AREA"
     Print #NOUT, " SURFACE     I      J      K      L   TYPE   TYPE"
     Print #NOUT, ""
     For I = 1 To NS3
       Print #NOUT, I, LI(I + N1), LJ(I + NFBC2D), LK(I), LL(I), LMAT(I + N1), LFIRE(I + N1), AIJKL(I + N1)
     Next I
'
'     REDUCE THE SURFACE  AREA  BY 1/4 TO AID IN FUTURE COMPUTATION
'
     For I = I1 To I2
       AIJKL(I) = 0.25 * AIJKL(I)
     Next I
'
lab190:
'
'
'
End Sub

Private Sub FIRE(LI() As Integer, LJ() As Integer, LK() As Integer, LL() As Integer, _
               LMAT() As Integer, LFIRE() As Integer, AIJKL() As Double, MAT() As Integer, _
               FXYS() As Tipo_XYS, T() As Double, TFIRE() As Double, B() As Double)
'
'
'     SUBROUTINE *FIRE* CALCULATES THE HEAT FLOW ASSOCIATED WITH A FIRE
'     REPRESENTED THROUGH TEMPERATURES TFIRE(I).  THESE HEAT FLOWS
'     ARE DETERMINED UPON THE BASIS OF THE ASSUMED TEMPERATURE VECTOR T.
'
'
     'COMMON /CONTROL/ ITITLE(6),IREAD(80),NIN,NOUT,NPUNCH,NUMNP,NEL1D,
     'NEL2D , NEL3D, NUMEL, MBAND, NMAT, NFBC1D, NFBC2D, NFBC3D, NBCMAT, NBCTYP
     'COMMON /SURFACE/ NS1,NS2,NS3
     'DIMENSION LI(1), LJ(1), LMAT(1), LFIRE(1), AIJKL(1), MAT(1), FXYS(1),
     'T(1), TFIRE(1), TF4(4), B(1), LK(1), LL(1)
'
'     IF BOUNDARY CONDITION IS NONLINEAR TAKE FIRE TEMPERATURES TO
'     THEIR FOURTH POWERS
'
     Dim TF4(4) As Double
     Dim SB As Double
     Dim TSHIFT As Double
     Dim TF As Double
                                               'TFIRE(I) - TEMPERATURE OF FIRE FOR CURRENT TIME STEP, I CAN VARY FROM 1 TO 4
     
     'If NBCTYP = "LINEAR BC " Then GoTo lab20
     If NBCTYP = LINEAR_BC Then GoTo lab20
     SB = FXYS(1).X                            'SB - STEFAN BOLZTMANN CONSTANT
     TSHIFT = FXYS(2).X                        'TSHIFT - SHIFT TO ABSOLUTE TEMPERATURE SCALE
     Dim I As Integer
     For I = 1 To 4
       TF = TFIRE(I) + TSHIFT                  'TF4(I)=(TFIRE+TSHIFT)^4, I CAN VARY FROM 1 TO 4
       TF = TF * TF
       TF4(I) = TF * TF
     Next I
'
'     O N E - D I M E N S I O N A L   E L E M E N T S
'
lab20:
     If NS1 = 0 Then GoTo lab40
     Dim N As Integer
     For N = 1 To NS1
'
'     ESTABLISH BASIC FIRE B.C. VARIABLES FOR THIS SURFACE ELEMENT
'
       Dim N3 As Integer
       Dim M As Integer
       Dim LF As Integer
       Dim TS As Double
       Dim Q As Double
       
       N3 = N
       I = LI(N)
       M = LMAT(N)
       LF = LFIRE(N)
       TF = TFIRE(LF)
       TS = T(I)
'
'     FIND HEAT FLOW DUE TO FIRE B.C.
'
        Q = QFIRE(TF, TS, LF, NBCTYP, M, N3, TSHIFT, SB, TF4(), MAT(), FXYS(), AIJKL())
'
'     ADD HEAT FLOW TO NODES BOUNDING SURFACE ELEMENT
'
       B(I) = B(I) + Q
     Next N
'
'     T W O - D I M E N S I O N A L   E L E M E N T S
'
lab40:
     If NS2 = 0 Then GoTo lab60
     Dim J As Integer
     For N = 1 To NS2
'
'     ESTABLISH BASIC FIRE B.C. VARIABLES FOR THIS SURFACE ELEMENT
'
       N3 = N + NFBC1D
       I = LI(N3)
       J = LJ(N)
       M = LMAT(N3)
       LF = LFIRE(N3)
       TF = TFIRE(LF)
       TS = 0.5 * (T(I) + T(J))
'
'     FIND HEAT FLOW DUE TO FIRE B.C.
'
       Q = QFIRE(TF, TS, LF, NBCTYP, M, N3, TSHIFT, SB, TF4(), MAT(), FXYS(), AIJKL())
'
'     ADD HEAT FLOW TO NODES BOUNDING SURFACE ELEMENT
'
       B(I) = B(I) + Q
       B(J) = B(J) + Q
     Next N
'
'     T H R E E - D I M E N S I O N A L   E L E M E N T S
'
lab60:
     If NS3 = 0 Then GoTo lab80
     
     Dim NK As Integer
     Dim NL As Integer
     
     For N = 1 To NS3
'
'     ESTABLISH BASIC FIRE B.C. VARIABLES FOR THIS SURFACE ELEMENT
'
       N3 = N + NFBC1D + NFBC2D
       I = LI(N3)
       J = LJ(N + NFBC2D)
       NK = LK(N)
       NL = LL(N)
       M = LMAT(N3)
       LF = LFIRE(N3)
       TF = TFIRE(LF)
       TS = 0.25 * (T(I) + T(J) + T(NK) + T(NL))
'
'     FIND HEAT FLOW DUE TO FIRE B.C.
'
       Q = QFIRE(TF, TS, LF, NBCTYP, M, N3, TSHIFT, SB, TF4(), MAT(), FXYS(), AIJKL())
'
'     ADD HEAT FLOW TO NODES BOUNDING SURFACE ELEMENT
'
       B(I) = B(I) + Q
       B(J) = B(J) + Q
       B(NK) = B(NK) + Q
       B(NL) = B(NL) + Q
     Next N
'
lab80:
End Sub

Private Function QFIRE(TF As Double, TS As Double, LF As Integer, NBCTYP As Tipo_NBCTYP, M As Integer, N3 As Integer, TSHIFT As Double, _
                       SB As Double, TF4() As Double, MAT() As Integer, FXYS() As Tipo_XYS, AIJKL() As Double) As Double
'
'
'     FUNCTION *QFIRE* FINDS HEAT FLOW DUE TO FIRE ON SURFACE ELEMENT
'
'
     'DIMENSION TF4(1), MAT(1), FXYS(1), AIJKL(1)
'
'
     Dim DT As Double
     DT = TF - TS
     'If NBCTYP = "NON-LIN BC" Then GoTo lab10
     If NBCTYP = NONLIN_BC Then GoTo lab10
'
'     LINEAR FIRE BOUNDARY CONDITION
'
     Dim JJ As Integer
     Dim K As Integer
     Dim TA As Double
     Dim H As Double
     Dim Q As Double

     M = (M - 1) * 2
     JJ = MAT(M + 1)
     K = MAT(M + 2)
     TA = 0.5 * (TF + TS)
     
     'H = VMAT(K, FXYS(JJ), FXYS(JJ + K), FXYS(JJ + K + K), TA, "  H(T)    ")
     H = VMAT(JJ, K, FXYS(), TA, "  H(T)    ")    '---------tex
     Q = AIJKL(N3) * H * DT
     GoTo lab50
'
lab10:
'
'     NON-LINEAR FIRE BOUNDARY CONDITION
'
     Dim A As Double
     Dim QC As Double
     Dim P As Double
     Dim SIGN As Double
     Dim V As Double
     Dim QR As Double
     Dim AB As Double
     Dim EF As Double
     Dim ES As Double

     K = MAT(M)
     A = FXYS(K).X                                 'CONVECT FACTOR
     QC = 0#
     If A = 0# Then GoTo lab30
'
'     CALCULATE CONVECTION TERM - QC
'
     P = FXYS(K + 1).X                             'CONVECT POWER
     If P = 1# Then GoTo lab20
     SIGN = 1#
     If DT < 0# Then SIGN = -1#
     DT = SIGN * DT
     QC = SIGN * A * DT ^ P                        'QC=A*(TF-TS)^P
     GoTo lab30
lab20:
     QC = A * DT
lab30:
     V = FXYS(K + 2).X                             'VIEW FACTOR
     QR = 0#
     If V = 0# Then GoTo lab40
'
'     CALCULATE RADIATION TERM - QR
'
     TS = TS + TSHIFT                              'TS=(TS+TSHIFT)^4
     TS = TS * TS
     TS = TS * TS
     AB = FXYS(K + 3).X                            'ABSORBT
     EF = FXYS(K + 4).X                            'FIRE EMISSIV
     ES = FXYS(K + 5).X                            'SURFACE EMISSIV
     QR = SB * V * (AB * EF * TF4(LF) - ES * TS)   'QR=SB*V*(AB*EF*(TFIRE+TSHIFT)^4-ES*(TS+TSHIFT)^4)
lab40:
     Q = AIJKL(N3) * (QC + QR)
lab50:
     QFIRE = Q
'
End Function

Private Sub EXOELS(X() As Double, Y() As Double, Z() As Double, LM() As Integer, _
                   BAREA() As Double, THICK() As Double, VOLUME() As Double, _
                   IEL() As Integer, IMAT() As Integer, VEL() As Double)
'
'
'     SUBROUTINE *EXOELS* INPUTS DATA DESCRIBING ALL ELEMENTS WHICH HAVE
'     INTERNAL HEAT GENERATION
'
'
     'COMMON /CONTROL/ ITITLE(6),IREAD(80),NIN,NOUT,NPUNCH,NUMNP,NEL1D,
     'NEL2D , NEL3D, NUMEL, MBAND, NMAT, NFBC1D, NFBC2D, NFBC3D, NBCMAT, NBCTYP
     'COMMON /EXOTH/ NINT1D,NINT2D,NINT3D,NINT,NQINT
     'DIMENSION X(1), Y(1), Z(1), LM(1), BAREA(1), THICK(1), VOLUME(1),IEL (1), IMAT(1), VEL(1)
'
'     O N E - D I M E N S I O N A L   E L E M E N T S
'
     If NINT1D = 0 Then GoTo lab20
'
'     INPUT 1-D ELEMENTS WITH INTERNAL HEAT GENERATION - 8 ELEMENTS/CARD
'
     '------------------------------------------------------------
     ' Data for One-Dimensional Elements (16I5)
     '------------------------------------------------------------
     Dim I As Integer
     For I = 1 To NINT1D Step 8
       Line Input #NIN, str_tmp
       
       If I > NINT1D Then Exit For
       IEL(I) = Val(Mid$(str_tmp, 1, 5))           'Element number of first one-dimensional bar element undergoing internal heating
       IMAT(I) = Val(Mid$(str_tmp, 6, 5))          'Heat function for first element
       
       If I + 1 > NINT1D Then Exit For
       IEL(I + 1) = Val(Mid$(str_tmp, 11, 5))
       IMAT(I + 1) = Val(Mid$(str_tmp, 16, 5))

       If I + 2 > NINT1D Then Exit For
       IEL(I + 2) = Val(Mid$(str_tmp, 21, 5))
       IMAT(I + 2) = Val(Mid$(str_tmp, 26, 5))

       If I + 3 > NINT1D Then Exit For
       IEL(I + 3) = Val(Mid$(str_tmp, 31, 5))
       IMAT(I + 3) = Val(Mid$(str_tmp, 36, 5))

       If I + 4 > NINT1D Then Exit For
       IEL(I + 4) = Val(Mid$(str_tmp, 41, 5))
       IMAT(I + 4) = Val(Mid$(str_tmp, 46, 5))

       If I + 5 > NINT1D Then Exit For
       IEL(I + 5) = Val(Mid$(str_tmp, 51, 5))
       IMAT(I + 5) = Val(Mid$(str_tmp, 56, 5))

       If I + 6 > NINT1D Then Exit For
       IEL(I + 6) = Val(Mid$(str_tmp, 61, 5))
       IMAT(I + 6) = Val(Mid$(str_tmp, 66, 5))

       If I + 7 > NINT1D Then Exit For
       IEL(I + 7) = Val(Mid$(str_tmp, 71, 5))
       IMAT(I + 7) = Val(Mid$(str_tmp, 76, 5))
     Next I
'
'     FIND VOLUME OF ELEMENTS AND OUTPUT DATA
'
     Dim N As Integer
     Dim IE As Integer
     Dim II As Integer
     Dim JJ As Integer
     Dim DX As Double
     Dim DY As Double
     Dim DZ As Double
     Dim DL As Double
     For N = 1 To NINT1D
       IE = IEL(N)
       II = LM(2 * IE - 1)
       JJ = LM(2 * IE)
       DX = X(II) - X(JJ)
       DY = Y(II) - Y(JJ)
       DZ = Z(II) - Z(JJ)
       DL = Sqr(DX * DX + DY * DY + DZ * DZ)
       VEL(N) = DL * BAREA(IE)
     Next N

     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "         . . . THERE ARE "; NINT1D; " 1-D EXOTHERMIC ELEMENTS . ."
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "         N   EL  FUN    VOLUME         N   EL  FUN    VOLUME"
     For I = 1 To NINT1D
       Print #NOUT, I, IEL(I), IMAT(I), VEL(I),
       If I Mod 2 = 0 Then Print #NOUT, ""
     Next I
     Print #NOUT, ""
'
'     T W O - D I M E N S I O N A L   E L E M E N T S
'
lab20:
     If NINT2D = 0 Then GoTo lab40
'
'     INPUT 2-D ELEMENTS WITH INTERNAL HEAT GENERATION - 8 ELEMENTS/CARD
'
     '------------------------------------------------------------
     ' Data for Two-Dimensional Elements (16I5)
     '------------------------------------------------------------
     Dim I1 As Integer
     Dim I2 As Integer
     I1 = NINT1D + 1
     I2 = NINT1D + NINT2D
     For I = I1 To I2
       Line Input #NIN, str_tmp
       
       If I > I2 Then Exit For
       IEL(I) = Val(Mid$(str_tmp, 1, 5))           'Element number of first two-dimensional line element undergoing internal heating
       IMAT(I) = Val(Mid$(str_tmp, 6, 5))          'Heat function for first element
       
       If I + 1 > I2 Then Exit For
       IEL(I + 1) = Val(Mid$(str_tmp, 11, 5))
       IMAT(I + 1) = Val(Mid$(str_tmp, 16, 5))

       If I + 2 > I2 Then Exit For
       IEL(I + 2) = Val(Mid$(str_tmp, 21, 5))
       IMAT(I + 2) = Val(Mid$(str_tmp, 26, 5))

       If I + 3 > I2 Then Exit For
       IEL(I + 3) = Val(Mid$(str_tmp, 31, 5))
       IMAT(I + 3) = Val(Mid$(str_tmp, 36, 5))

       If I + 4 > I2 Then Exit For
       IEL(I + 4) = Val(Mid$(str_tmp, 41, 5))
       IMAT(I + 4) = Val(Mid$(str_tmp, 46, 5))

       If I + 5 > I2 Then Exit For
       IEL(I + 5) = Val(Mid$(str_tmp, 51, 5))
       IMAT(I + 5) = Val(Mid$(str_tmp, 56, 5))

       If I + 6 > I2 Then Exit For
       IEL(I + 6) = Val(Mid$(str_tmp, 61, 5))
       IMAT(I + 6) = Val(Mid$(str_tmp, 66, 5))

       If I + 7 > I2 Then Exit For
       IEL(I + 7) = Val(Mid$(str_tmp, 71, 5))
       IMAT(I + 7) = Val(Mid$(str_tmp, 76, 5))
     Next I
'
'     FIND VOLUME OF ELEMENTS AND OUTPUT DATA
'
     Dim IARG As Integer
     Dim KK As Integer
     Dim LL As Integer
     Dim AJ As Double
     Dim AK As Double
     Dim BJ As Double
     Dim BK As Double
     Dim AREA As Double
     For N = I1 To I2
       IE = IEL(N)
       IARG = 2 * NEL1D + 4 * IE - 3
       II = LM(IARG)
       JJ = LM(IARG + 1)
       KK = LM(IARG + 2)
       LL = LM(IARG + 3)
       AJ = X(JJ) - X(II)
       AK = X(KK) - X(II)
       BJ = Y(JJ) - Y(II)
       BK = Y(KK) - Y(II)
       AREA = (AJ * BK - AK * BJ) / 2#
       AJ = X(KK) - X(II)
       AK = X(LL) - X(II)
       BJ = Y(KK) - Y(II)
       BK = Y(LL) - Y(II)
       AREA = AREA + (AJ * BK - AK * BJ) / 2#
       VEL(N) = AREA * THICK(IE)
     Next N

     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "         . . . THERE ARE "; NINT2D; " 2-D EXOTHERMIC ELEMENTS . ."
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "         N   EL  FUN    VOLUME         N   EL  FUN    VOLUME"
     For I = 1 To NINT2D
       Print #NOUT, I, IEL(I + NINT1D), IMAT(I + NINT1D), VEL(I + NINT1D),
       If I Mod 2 = 0 Then Print #NOUT, ""
     Next I
     Print #NOUT, ""
'
'     T H R E E - D I M E N S I O N A L   E L E M E N T S
'
lab40:
     If NINT3D = 0 Then GoTo lab60
'
'     INPUT 3-D ELEMENTS WITH INTERNAL HEAT GENERATION - 8 ELEMENTS/CARD
'
     '------------------------------------------------------------
     ' Data for Three-Dimensional Elements (16I5)
     '------------------------------------------------------------
     I1 = NINT1D + NINT2D + 1
     I2 = NINT
     For I = I1 To I2 Step 8
       Line Input #NIN, str_tmp
       
       If I > I2 Then Exit For
       IEL(I) = Val(Mid$(str_tmp, 1, 5))           'Element number of first three-dimensional corner element undergoing internal heating
       IMAT(I) = Val(Mid$(str_tmp, 6, 5))          'Heat function for first element
       
       If I + 1 > I2 Then Exit For
       IEL(I + 1) = Val(Mid$(str_tmp, 11, 5))
       IMAT(I + 1) = Val(Mid$(str_tmp, 16, 5))

       If I + 2 > I2 Then Exit For
       IEL(I + 2) = Val(Mid$(str_tmp, 21, 5))
       IMAT(I + 2) = Val(Mid$(str_tmp, 26, 5))

       If I + 3 > I2 Then Exit For
       IEL(I + 3) = Val(Mid$(str_tmp, 31, 5))
       IMAT(I + 3) = Val(Mid$(str_tmp, 36, 5))

       If I + 4 > I2 Then Exit For
       IEL(I + 4) = Val(Mid$(str_tmp, 41, 5))
       IMAT(I + 4) = Val(Mid$(str_tmp, 46, 5))

       If I + 5 > I2 Then Exit For
       IEL(I + 5) = Val(Mid$(str_tmp, 51, 5))
       IMAT(I + 5) = Val(Mid$(str_tmp, 56, 5))

       If I + 6 > I2 Then Exit For
       IEL(I + 6) = Val(Mid$(str_tmp, 61, 5))
       IMAT(I + 6) = Val(Mid$(str_tmp, 66, 5))

       If I + 7 > I2 Then Exit For
       IEL(I + 7) = Val(Mid$(str_tmp, 71, 5))
       IMAT(I + 7) = Val(Mid$(str_tmp, 76, 5))
     Next I
'
'     FIND VOLUME OF ELEMENTS AND OUTPUT DATA
'
     For N = I1 To I2
       IE = IEL(N)
       VEL(N) = VOLUME(IE)
     Next N
     Dim N1 As Integer
     N1 = NINT1D + NINT2D
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "         . . . THERE ARE "; NINT3D; " 3-D EXOTHERMIC ELEMENTS . ."
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "         N   EL  FUN    VOLUME         N   EL  FUN    VOLUME"
     For I = 1 To NINT2D
       Print #NOUT, I, IEL(I + N1), IMAT(I + N1),
       If I Mod 2 = 0 Then Print #NOUT, ""
     Next I
     Print #NOUT, ""
'
'
lab60:
'
'
'
'
End Sub

Private Sub EXOFUN(IEXO() As Integer, EXYS() As Tipo_XYS, NSTORE As Integer)
'
'
'     SUBROUTINE *EXOFUN* INPUTS THE EXOTHERMIC HEAT GENERATION CURVE
'     AS A LINEARIZED FUNCTION OF TIME
'
'
     'COMMON /CONTROL/ ITITLE(6),IREAD(80),NIN,NOUT,NPUNCH,NUMNP,NEL1D,
     'NEL2D , NEL3D, NUMEL, MBAND, NMAT, NFBC1D, NFBC2D, NFBC3D, NBCMAT, NBCTYP
     'COMMON /EXOTH/ NINT1D,NINT2D,NINT3D,NINT,NQINT
     'DIMENSION IEXO(1), EXYS(1)
     NSTORE = 1
'
'     OUTPUT PAGE HEADING
'
     Print #NOUT, "6"
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " ************************************************************"
     Print #NOUT, ""
     Print #NOUT, "     FIRES-T3  -  FIRE RESPONSE OF STRUCTURES - THERMAL"
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, " "; ITITLE
     Print #NOUT, ""
     Print #NOUT, "     INTERNAL HEAT GENERATION INFORMATION"
     Print #NOUT, ""
     Print #NOUT, ""
     Print #NOUT, "     THERE ARE"; NQINT; " DIFFERENT HEAT FUNCTIONS"
     Print #NOUT, ""
     Print #NOUT, " ************************************************************"

'
     Dim N As Integer
     For N = 1 To NQINT
'
'     READ CONTROL CARD
'
'        NSTORE = IEXO(1) - STARTING POINT FOR FUNCTION N IN EXYS
'        MK = IEXO(2) - NUMBER OF POINTS IN INPUT HEATING CURVE
'        MT = IEXO(3) - TYPE OF INPUT HEATING DATA
'                       EQ. 0 - HEAT RATE PER UNIT VOLUME
'                       EQ. 1 - HEAT RATE PER UNIT MASS
'
       Print #NOUT, ""
       Print #NOUT, ""
       Print #NOUT, ""
       Print #NOUT, ""
       Print #NOUT, "  . . . . FUNCTION NUMBER "; N; "  . . . ."
       Print #NOUT, ""
     
       Dim MK As Integer
       Dim MT As Integer
       Dim MS As Integer

       '------------------------------------------------------------
       ' Control Card (2I5)
       '------------------------------------------------------------
       Line Input #NIN, str_tmp
       MK = Val(Mid$(str_tmp, 1, 5))       'Number of points used to define heating function
                                           'MK>=2
       MT = Val(Mid$(str_tmp, 6, 5))       'Type of heating curve input
                                           'If MT=0, heat flow per unit volume
                                           'If MT=1, heat flow per unit mass
       MS = (N - 1) * 3
       IEXO(MS + 1) = NSTORE
       IEXO(MS + 2) = MK
       IEXO(MS + 3) = MT
'
'     INPUT HEATING FUNCTION
'
       '------------------------------------------------------------
       ' Heat function (8E10.0)
       '------------------------------------------------------------
       Dim I As Integer
       Dim M As Integer
       ReDim Preserve EXYS(1 To NSTORE + MK - 1) As Tipo_XYS
       For I = 1 To MK Step 4
           Line Input #NIN, str_tmp
           
           If I > MK Then Exit For
           EXYS(NSTORE + I - 1).X = Val(Mid$(str_tmp, 1, 10))          'Time of point 1
           EXYS(NSTORE + I - 1).Y = Val(Mid$(str_tmp, 11, 10))         'Value of heat rate at point 1
           
           If I + 1 > MK Then Exit For
           EXYS(NSTORE + I - 1 + 1).X = Val(Mid$(str_tmp, 21, 10))
           EXYS(NSTORE + I - 1 + 1).Y = Val(Mid$(str_tmp, 31, 10))
         
           If I + 2 > MK Then Exit For
           EXYS(NSTORE + I - 1 + 2).X = Val(Mid$(str_tmp, 41, 10))
           EXYS(NSTORE + I - 1 + 2).Y = Val(Mid$(str_tmp, 51, 10))
         
           If I + 3 > MK Then Exit For
           EXYS(NSTORE + I - 1 + 3).X = Val(Mid$(str_tmp, 61, 10))
           EXYS(NSTORE + I - 1 + 3).Y = Val(Mid$(str_tmp, 71, 10))
       Next I
       M = MK - 1
'
'     DETERMINE SLOPES AND PRINT HEATING FUNCTION
'
       For I = 1 To M
           EXYS(NSTORE + I - 1).S = (EXYS(NSTORE + I).Y - EXYS(NSTORE + I - 1).Y) / (EXYS(NSTORE + I).X - EXYS(NSTORE + I - 1).X)
       Next I
       
       Print #NOUT, ""
       Print #NOUT, "     NODE           TIME       HEAT       SLOPE"
       Print #NOUT, ""
       
       For I = 1 To M
           Print #NOUT, I, EXYS(NSTORE + I - 1).X; "      "; EXYS(NSTORE + I - 1).Y
           Print #NOUT, "                                       "; EXYS(NSTORE + I - 1).S
           Print #NOUT, ""
       Next I
       
       Print #NOUT, MK, EXYS(NSTORE + MK - 1).X; "      "; EXYS(NSTORE + MK - 1).Y
       
       NSTORE = NSTORE + MK
   Next N
'
'
'
'
End Sub


Private Sub QEXO(LM() As Integer, IEL() As Integer, IMAT() As Integer, IEXO() As Integer, _
                EXYS() As Tipo_XYS, AT() As Double, MATL() As Integer, VEL() As Double, _
                MMTYPE() As Integer, B() As Double, XYS() As Tipo_XYS, TIME As Double)
'
'
'     SUBROUTINE *QEXO* COMPUTES NODAL HEAT FLOW DUE TO EXOTHERMIC
'     REACTION WITHIN ELEMENTS
'
'
     'COMMON /CONTROL/ ITITLE(6),IREAD(80),NIN,NOUT,NPUNCH,NUMNP,NEL1D,
     'NEL2D , NEL3D, NUMEL, MBAND, NMAT, NFBC1D, NFBC2D, NFBC3D, NBCMAT, NBCTYP
     'COMMON /EXOTH/ NINT1D,NINT2D,NINT3D,NINT,NQINT
     'DIMENSION LM(1), IEL(1), IMAT(1), IEXO(1), EXYS(1), AT(1), MATL(1), VEL(1), MMTYPE(1), B(1), XYS(1)
'
'     O N E - D I M E N S I O N A L   E L E M E N T S
'
     If NINT1D = 0 Then GoTo lab30
     
     Dim N As Integer
     Dim IE As Integer
     Dim II As Integer
     Dim JJ As Integer
     Dim MS As Integer
     Dim J As Integer
     Dim K As Integer
     Dim LTYPE As Integer
     Dim Q As Double
     Dim TEMP As Double
     Dim DENS As Double
     Dim QADD As Double
       
     For N = 1 To NINT1D
       IE = IEL(N)
       II = LM(2 * IE - 1)
       JJ = LM(2 * IE)
       MS = IMAT(N)
       MS = 3 * (MS - 1)
       J = IEXO(MS + 1)
       K = IEXO(MS + 2)
       LTYPE = IEXO(MS + 3)
       'Q = VMAT(K, EXYS(J), EXYS(J + K), EXYS(J + K + K), TIME, "HEAT FUNCT")
       Q = VMAT(J, K, EXYS(), TIME, "HEAT FUNCT")     '---------tex
       If LTYPE = 0 Then GoTo lab10
       TEMP = AT(IE)
       MS = MMTYPE(IE)
       MS = (MS - 1) * 6
       J = MATL(MS + 5)
       K = MATL(MS + 6)
       'DENS = VMAT(K, XYS(J), XYS(J + K), XYS(J + K + K), TEMP, "      DENS")
       DENS = VMAT(J, K, XYS(), TEMP, "      DENS")     '---------tex
       Q = Q * DENS
lab10:
       QADD = Q * VEL(N) / 2#
       B(II) = B(II) + QADD
       B(JJ) = B(JJ) + QADD
     Next N
'
'     T W O - D I M E N S I O N A L   E L E M E N T S
'
lab30:
     If NINT2D = 0 Then GoTo lab60
     
     Dim I1 As Integer
     Dim I2 As Integer
     Dim N1 As Integer
     Dim KK As Integer
     Dim LL As Integer
     
     I1 = NINT1D + 1
     I2 = NINT1D + NINT2D
     For N = I1 To I2
       IE = IEL(N)
       N1 = 2 * NEL1D + 4 * IE
       II = LM(N1 - 3)
       JJ = LM(N1 - 2)
       KK = LM(N1 - 1)
       LL = LM(N1)
       MS = IMAT(N)
       MS = 3 * (MS - 1)
       J = IEXO(MS + 1)
       K = IEXO(MS + 2)
       LTYPE = IEXO(MS + 3)
       'Q = VMAT(K, EXYS(J), EXYS(J + K), EXYS(J + K + K), TIME, "HEAT FUNCT")
       Q = VMAT(J, K, EXYS(), TIME, "HEAT FUNCT")    '---------tex
       If LTYPE = 0 Then GoTo lab40
       TEMP = AT(NEL1D + IE)
       MS = MMTYPE(NEL1D + IE)
       MS = (MS - 1) * 6
       J = MATL(MS + 5)
       K = MATL(MS + 6)
       'DENS = VMAT(K, XYS(J), XYS(J + K), XYS(J + K + K), TEMP, "      DENS")
       DENS = VMAT(J, K, XYS(), TEMP, "      DENS")    '---------tex
       Q = Q * DENS
lab40:
       QADD = Q * VEL(N) / 4#
       B(II) = B(II) + QADD
       B(JJ) = B(JJ) + QADD
       B(KK) = B(KK) + QADD
       B(LL) = B(LL) + QADD
     Next N
'
'     T H R E E - D I M E N S I O N A L   E L E M E N T S
'
lab60:
     If NINT3D = 0 Then GoTo lab90
     
     Dim III As Integer
     Dim JJJ As Integer
     Dim KKK As Integer
     Dim LLL As Integer
     
     I1 = NINT1D + NINT2D + 1
     I2 = NINT
     For N = I1 To I2
       IE = IEL(N)
       N1 = 2 * NEL1D + 4 * NEL2D + 8 * IE
       II = LM(N1 - 7)
       JJ = LM(N1 - 6)
       KK = LM(N1 - 5)
       LL = LM(N1 - 4)
       III = LM(N1 - 3)
       JJJ = LM(N1 - 2)
       KKK = LM(N1 - 1)
       LLL = LM(N1)
       MS = IMAT(N)
       MS = (MS - 1) * 3
       J = IEXO(MS + 1)
       K = IEXO(MS + 2)
       LTYPE = IEXO(MS + 3)
       'Q = VMAT(K, EXYS(J), EXYS(J + K), EXYS(J + K + K), TIME, "HEAT FUNCT")
       Q = VMAT(J, K, EXYS(), TIME, "HEAT FUNCT")     '---------tex
       If LTYPE = 0 Then GoTo lab70
       TEMP = AT(NEL1D + NEL2D + IE)
       MS = MMTYPE(NEL1D + NEL2D + IE)
       MS = (MS - 1) * 6
       K = MATL(MS + 6)
       J = MATL(MS + 5)
       'DENS = VMAT(K, XYS(J), XYS(J + K), XYS(J + K + K), TEMP, "      DENS")
       DENS = VMAT(J, K, XYS(), TEMP, "      DENS")     '---------tex
       Q = Q * DENS
lab70:
       QADD = Q * VEL(N) / 8#
       B(II) = B(II) + QADD
       B(JJ) = B(JJ) + QADD
       B(KK) = B(KK) + QADD
       B(LL) = B(LL) + QADD
       B(III) = B(III) + QADD
       B(JJJ) = B(JJJ) + QADD
       B(KKK) = B(KKK) + QADD
       B(LLL) = B(LLL) + QADD
     Next N
'
lab90:

End Sub

Private Sub NODE(X() As Double, Y() As Double, Z() As Double, KODE() As Tipo_KODE, ID() As Integer, NTBC As Integer)
'
'
'     SUBROUTINE *NODE* INPUTS NODAL COORDINATES AND SETS
'     THE FLOW AND TEMPERATURE BOUNDARY CONDITIONS
'
'
     'COMMON /CONTROL/ ITITLE(6),IREAD(80),NIN,NOUT,NPUNCH,NUMNP,NEL1D,
     'NEL2D , NEL3D, NUMEL, MBAND, NMAT, NFBC1D, NFBC2D, NFBC3D, NBCMAT, NBCTYP
     'DIMENSION X(1), Y(1), Z(1), KODE(1), ID(1)
'
'     OUTPUT PAGE HEADING
'
Print #NOUT, "6"
Print #NOUT, ""
Print #NOUT, ""
Print #NOUT, ""
Print #NOUT, ""
Print #NOUT, ""
Print #NOUT, " ************************************************************"
Print #NOUT, ""
Print #NOUT, "     FIRES-T3  -  FIRE RESPONSE OF STRUCTURES - THERMAL"
Print #NOUT, ""
Print #NOUT, ITITLE
Print #NOUT, ""
Print #NOUT, "       GEOMETRIC DESCRIPTION OF SYSTEM TO BE ANALYZED"
Print #NOUT, ""
Print #NOUT, " ************************************************************"
Print #NOUT, ""
Print #NOUT, ""
Print #NOUT, "  . . . . THERE ARE ", NUMNP; " NODAL POINTS . . . ."
Print #NOUT, ""
Print #NOUT, ""
Print #NOUT, " NODAL                        COORDINATES            BOUNDARY"
Print #NOUT, " POINT         X              Y              Z      CONDITION"
Print #NOUT, ""

'
'     INITIALIZE BOUNDARY CONDITIONS TO FLOW
'
  Dim I As Integer
  For I = 1 To NUMNP
   'KODE(I) = "FLOW"
   KODE(I) = FLOW
  Next I

'
'     INPUT NODAL COORDINATES
'
  Dim N As Integer
  Dim L As Integer
  L = 1
lab20:
  'dato che la Y e la Z sono opzionali per evitare che passi a leggere
  'la riga successiva mi tocca fare un input più complesso
  'nota: in un nuovo formato dati di input conviene mettere sempre
  'il campo z pari a zero anche quando non serve definirlo oppure
  'pensare ad un tag che indichi se si tratta di geometria 1D,2D,3D
  'ed agire in funzione dello stesso, oppure fill con zeri

  '------------------------------------
  ' Nodal Cards (I5,3E10.0)
  '------------------------------------
  Line Input #NIN, str_tmp
  N = Val(Mid$(str_tmp, 1, 5))         'Nodal point number
  X(N) = Val(Mid$(str_tmp, 6, 10))     'X-coordinate
  Y(N) = Val(Mid$(str_tmp, 16, 10))    'Y-coordinate
  Z(N) = Val(Mid$(str_tmp, 26, 10))    'Z-coordinate

  If N >= L Then GoTo lab40

lab30:
  Print #NOUT, N, X(N), Y(N), Z(N)
  Close #NIN
  Close #NOUT
  End '<<<<<<<
 
lab40:
  If N = L Then GoTo lab60
  If L = 1 Then GoTo lab30
'
'     WHEN N .GE. L THE PROGRAM GENERATES INTERMEDIATE NODES
'     AT INTERVALS OF DX, DY, AND DZ
'
  Dim DIFF As Double
  Dim DX As Double
  Dim DY As Double
  Dim DZ As Double
    DIFF = N + 1 - L
    DX = (X(N) - X(L - 1)) / DIFF
    DY = (Y(N) - Y(L - 1)) / DIFF
    DZ = (Z(N) - Z(L - 1)) / DIFF
   
lab50:
    X(L) = X(L - 1) + DX
    Y(L) = Y(L - 1) + DY
    Z(L) = Z(L - 1) + DZ
    L = L + 1
    If N > L Then GoTo lab50
   
lab60:
    L = L + 1
    If N < NUMNP Then GoTo lab20
    If N <> NUMNP Then GoTo lab30
    If NTBC = 0 Then GoTo lab80

'
'     INPUT KNOWN TEMPERATURE BOUNDARY CONDITIONS
'
  '------------------------------------
  ' Specified Temperature Nodes (16I5)
  '------------------------------------
  Dim J As Integer
  For I = 1 To NTBC Step 16
       Line Input #NIN, str_tmp
       
       If I > NTBC Then Exit For
       ID(I) = Val(Mid$(str_tmp, 1, 5))            'Node number of first node in which
                                                   'temperature is fixed as a boundary condition
       If I + 1 > NTBC Then Exit For
       ID(I + 1) = Val(Mid$(str_tmp, 6, 5))
       
       If I + 2 > NTBC Then Exit For
       ID(I + 2) = Val(Mid$(str_tmp, 11, 5))
       
       If I + 3 > NTBC Then Exit For
       ID(I + 3) = Val(Mid$(str_tmp, 16, 5))
       
       If I + 4 > NTBC Then Exit For
       ID(I + 4) = Val(Mid$(str_tmp, 21, 5))
       
       If I + 5 > NTBC Then Exit For
       ID(I + 5) = Val(Mid$(str_tmp, 26, 5))
       
       If I + 6 > NTBC Then Exit For
       ID(I + 6) = Val(Mid$(str_tmp, 31, 5))
       
       If I + 7 > NTBC Then Exit For
       ID(I + 7) = Val(Mid$(str_tmp, 36, 5))
       
       If I + 8 > NTBC Then Exit For
       ID(I + 8) = Val(Mid$(str_tmp, 41, 5))
       
       If I + 9 > NTBC Then Exit For
       ID(I + 9) = Val(Mid$(str_tmp, 46, 5))
       
       If I + 10 > NTBC Then Exit For
       ID(I + 10) = Val(Mid$(str_tmp, 51, 5))
       
       If I + 11 > NTBC Then Exit For
       ID(I + 11) = Val(Mid$(str_tmp, 56, 5))
       
       If I + 12 > NTBC Then Exit For
       ID(I + 12) = Val(Mid$(str_tmp, 61, 5))
       
       If I + 13 > NTBC Then Exit For
       ID(I + 13) = Val(Mid$(str_tmp, 66, 5))
       
       If I + 14 > NTBC Then Exit For
       ID(I + 14) = Val(Mid$(str_tmp, 71, 5))
       
       If I + 15 > NTBC Then Exit For
       ID(I + 15) = Val(Mid$(str_tmp, 76, 5))
  Next I
  For I = 1 To NTBC
       J = ID(I)
       If J <= 0 Or J > NUMNP Then GoTo lab90
       'KODE(J) = "TEMP"
       KODE(J) = TEMP
  Next I

'
'     OUTPUT NODAL COORDINATES AND BOUNDARY CONDITION CODE
'
lab80:
   For I = 1 To NUMNP
       'Print #NOUT, I, X(I), Y(I), Z(I); "       "; KODE(I)
       If KODE(I) = TEMP Then
           Print #NOUT, I, X(I), Y(I), Z(I); "       TEMP"
       ElseIf KODE(I) = FLOW Then
           Print #NOUT, I, X(I), Y(I), Z(I); "       FLOW"
       End If
   Next I
   Exit Sub

lab90:
   Print #NOUT, ""
   Print #NOUT, "  - - - PROGRAM TERMINATED - - - "
   Print #NOUT, ""
   Print #NOUT, "  ERROR IN TEMPERATURE BOUNDARY CONDITION INPUT"
   Close #NIN
   Close #NOUT
   End '<<<<<<<<
End Sub

'ENTRY POINT
Public Sub CALCTEMP()

   'prelevo il percorso ed il nome del file
   percorso = Range("B45")
   'aggiungo backslash finale al percorso se mancante
   If Mid$(percorso, Len(percorso), 1) <> "\" Then percorso = percorso + "\"
   nomefile = Range("B48")

   'apertura files
   NIN = FreeFile
   Open percorso + nomefile + ".dat" For Input As NIN
   
   NOUT = FreeFile
   Open percorso + nomefile + ".out" For Output As NOUT
   
   'limite massimo dati nel buffer C(10000)
   'Dim NALLOW As Integer
   'NALLOW = 10000
   
'
'     INPUT TITLE
'
lab10:
   On Error GoTo esci:
   Input #NIN, ITITLE
   
'
'     INPUT OF PROBLEM DESCRIPTION DONE ON BASIS OF ALPHA-NUMERIC
'     CONTROL CARDS IN WHICH THE FIRST LETTER OF THE CONTROL
'     WORD IS CHECKED FOR PROPER INPUT SEQUENCE
'
'     INPUT CONTROL CARD * NODES *
'

   Input #NIN, IREAD
   If InStr(IREAD, "NODES") = 0 Then
       'ERROR WAS DETECTED IN CONTROL WORD OR CONTROL VARIABLE
       'HAS IMPROPER VALUE AND PROGRAM IS TERMINATED
       MsgBox "Errore nel file di input", vbOKOnly + vbInformation, "Errore!!!"
       Print #NOUT, " - - - PROGRAM TERMINATED - INPUT ERROR - - - "; IREAD
       Close #NIN
       Close #NOUT
       Exit Sub
   End If
   
   Dim N As Integer
   N = 1
   
'
'     OUTPUT TITLE PAGE
'
   Print #NOUT, "6"
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, " ************************************************************"
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, "     FFFFF  I  RRRRR  EEEEE  SSSSS         TTTTT  33333"
   Print #NOUT, "     F      I  R   R  E      S               T       3"
   Print #NOUT, "     F      I  R   R  E      S               T      3"
   Print #NOUT, "     F      I  R   R  E      S               T     3"
   Print #NOUT, "     FFF    I  RRRRR  EEE    SSSSS  =====    T    3333"
   Print #NOUT, "     F      I  RR     E          S           T        3"
   Print #NOUT, "     F      I  R R    E          S           T        3"
   Print #NOUT, "     F      I  R  R   E          S           T        3"
   Print #NOUT, "     F      I  R   R  EEEEE  SSSSS           T    33333"
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, "       A THERMAL ANALYZER FOR THREE-DIMENSIONAL SYSTEMS,"
   Print #NOUT, "       WITH TEMPERATURE-DEPENDENT THERMAL PROPERTIES,"
   Print #NOUT, "       SUBJECTED TO A FIRE ENVIRONMENT"
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, " ************************************************************"
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, "              - - - TITLE OF RUN - - -"
   Print #NOUT, ""
   Print #NOUT, ITITLE
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, ""
   Print #NOUT, " ************************************************************"

                                                                         
'
'     INPUT OF NODAL DATA
'
'        NUMNP - NUMBER OF NODAL POINTS
'        NTBC - NUMBER OF KNOWN TEMPERATURE BOUNDARY CONDITIONS
'        X(1)=C(N1) - X COORDINATE OF NODAL POINT
'        Y(1)=C(N2) - Y COORDINATE OF NODAL POINT
'        Z(1)=C(N3) - Z COORDINATE OF NODAL POINT
'        KODE(1)=C(ND0) - INDICATES TYPE OF BOUNDARY CONDITION
'                         FLOW - HEAT FLOW IS KNOWN
'                         TEMP - TEMPERATURE IS KNOWN
'        DUMI(1)=C(NDI) - DUMMY VARIABLES REQUIRED IN CALCULATION
'                         I VARIES FROM 1 TO 5
'
                                                                     
   Input #NIN, IREAD
       NUMNP = CInt(IREAD)
   If NUMNP <= 0 Then
       'ERROR WAS DETECTED IN CONTROL WORD OR CONTROL VARIABLE
       'HAS IMPROPER VALUE AND PROGRAM IS TERMINATED
       MsgBox "Errore nel file di input", vbOKOnly + vbInformation, "Errore!!!"
       Print #NOUT, " - - - PROGRAM TERMINATED - INPUT ERROR - - - "; IREAD
       Close #NIN
       Close #NOUT
       Exit Sub
   End If

   Input #NIN, IREAD
       Dim NTBC As Integer
       NTBC = CInt(IREAD)
   If NTBC >= NUMNP Then
       'ERROR WAS DETECTED IN CONTROL WORD OR CONTROL VARIABLE
       'HAS IMPROPER VALUE AND PROGRAM IS TERMINATED
       MsgBox "Errore nel file di input", vbOKOnly + vbInformation, "Errore!!!"
       Print #NOUT, " - - - PROGRAM TERMINATED - INPUT ERROR - - - "; IREAD
       Close #NIN
       Close #NOUT
       Exit Sub
   End If

   'Dim N1 As Integer
   'Dim N2 As Integer
   'Dim N3 As Integer
   'Dim ND0 As Integer
   'Dim ND1 As Integer
   'Dim ND2 As Integer
   'Dim ND3 As Integer
   'Dim ND4 As Integer
   'Dim ND5 As Integer
   'Dim N4 As Integer
   
   'N1 = 1                      '->X(NUMNP)
   'N2 = N1 + NUMNP             '->Y(NUMNP)
   'N3 = N2 + NUMNP             '->Z(NUMNP)
   'ND0 = N3 + NUMNP            '->KODE(NUMNP)
   'ND1 = ND0 + NUMNP           '->ID(NUMNP)
   'ND2 = ND1 + NUMNP           '->MA(NUMNP)
   'ND3 = ND2 + NUMNP           '->T1(NUMNP)
   'ND4 = ND3 + NUMNP           '->T2(NUMNP)
   'ND5 = ND4 + NUMNP           '->T3(NUMNP)
   'N4 = ND5 + NUMNP            '->LM(2 * NEL1D + 4 * NEL2D + 8 * NEL3D)
   
   ReDim X(NUMNP) As Double
   ReDim Y(NUMNP) As Double
   ReDim Z(NUMNP) As Double
   'ReDim KODE(NUMNP) As String * 4
   ReDim KODE(NUMNP) As Tipo_KODE
   ReDim ID(NUMNP) As Integer
   ReDim MA(NUMNP) As Integer
   ReDim T1(NUMNP) As Double
   ReDim T2(NUMNP) As Double
   ReDim T3(NUMNP) As Double
   
   ReDim D(NUMNP) As Double 'ID OR D (tex)

   '
   'Call NODE(C(N1), C(N2), C(N3), C(ND0), C(ND1), NTBC)
   Call NODE(X(), Y(), Z(), KODE(), ID(), NTBC)
   
'
'     INPUT CONROL CARD * ELEMENTS *
'
   Input #NIN, IREAD
   If InStr(IREAD, "ELEMENTS") = 0 Then
       'ERROR WAS DETECTED IN CONTROL WORD OR CONTROL VARIABLE
       'HAS IMPROPER VALUE AND PROGRAM IS TERMINATED
       MsgBox "Errore nel file di input", vbOKOnly + vbInformation, "Errore!!!"
       Print #NOUT, " - - - PROGRAM TERMINATED - INPUT ERROR - - - "; IREAD
       Close #NIN
       Close #NOUT
       Exit Sub
   End If
   N = 1
   
                                                                       
'
'     INPUT OF ELEMENT DATA
'
'        NEL1D - NUMBER OF 1-D ELEMENTS
'        NEL2D - NUMBER OF 2-D ELEMENTS
'        NEL3D - NUMBER OF 3-D ELEMENTS
'        NUMEL - TOTAL NUMBER OF ELEMENTS
'        MBAND - MAXIMUM BANDWIDTH OF CONDUCTIVITY MATRIX
'        LM(1)=C(N4) - ELEMENT NODAL POINT CONFIGURATION ARRAY
'        MMTYPE(1)=C(N5) - MATERIAL TYPE
'        BAREA(1)=C(N6) - BAR AREA ( FOR 1-D ELEMENTS )
'        THICK(1)=C(N7) - ELEMENT THICKNESS ( FOR 2-D ELEMENTS )
'        VOLUME(1)=C(NV) - ELEMENT VOLUME ( FOR 3-D ELEMENTS )
'

   Input #NIN, IREAD
   NEL1D = CInt(IREAD)
   Input #NIN, IREAD
   NEL2D = CInt(IREAD)
   Input #NIN, IREAD
   NEL3D = CInt(IREAD)
   NUMEL = NEL1D + NEL2D + NEL3D
   If NUMEL <= 0 Then
      'ERROR WAS DETECTED IN CONTROL WORD OR CONTROL VARIABLE
      'HAS IMPROPER VALUE AND PROGRAM IS TERMINATED
      MsgBox "Errore nel file di input", vbOKOnly + vbInformation, "Errore!!!"
      Print #NOUT, " - - - PROGRAM TERMINATED - INPUT ERROR - - - "; IREAD
      Close #NIN
      Close #NOUT
      Exit Sub
   End If
   
   'Dim N5 As Integer
   'Dim N6 As Integer
   'Dim N7 As Integer
   'Dim NV As Integer
   'Dim N8 As Integer
   
   'N5 = N4 + 2 * NEL1D + 4 * NEL2D + 8 * NEL3D '->MMTYPE(NUMEL)
   'N6 = N5 + NUMEL                             '->BAREA(NEL1D)
   'N7 = N6 + NEL1D                             '->THICK(NEL2D)
   'NV = N7 + NEL2D                             '->VOLUME(NEL3D)
   'N8 = NV + NEL3D                             '->MATL(6*NMAT)

   ReDim LM(2 * NEL1D + 4 * NEL2D + 8 * NEL3D) As Integer
   ReDim MMTYPE(NUMEL) As Integer
   If NEL1D > 0 Then ReDim BAREA(NEL1D) As Double
   If NEL2D > 0 Then ReDim THICK(NEL2D) As Double
   If NEL3D > 0 Then ReDim VOLUME(NEL3D) As Double

'
   'Call ELEMENT(C(N1), C(N2), C(N3), C(N4), C(N5), C(N6), C(N7), C(NV))
   Call ELEMENT(X(), Y(), Z(), LM(), MMTYPE(), BAREA(), THICK(), VOLUME())
'
'     INPUT CONTROL CARD * MATERIALS *
'
   Input #NIN, IREAD
   If InStr(IREAD, "MATERIALS") = 0 Then
       'ERROR WAS DETECTED IN CONTROL WORD OR CONTROL VARIABLE
       'HAS IMPROPER VALUE AND PROGRAM IS TERMINATED
       MsgBox "Errore nel file di input", vbOKOnly + vbInformation, "Errore!!!"
       Print #NOUT, " - - - PROGRAM TERMINATED - INPUT ERROR - - - "; IREAD
       Close #NIN
       Close #NOUT
       Exit Sub
   End If
   N = 1
                                                                     
'
'     INPUT OF THERMAL PROPERTIES FOR DIFFERENT MATERIALS
'
'        NMAT - NUMBER OF DIFFERENT MATERIALS
'        MATL(1)=C(N8) - CONTROL DATA REQUIRED FOR CALCULATION OF
'                        THERMAL PROPERTIES
'        XYS(1)=C(N9) - FUNCTION VALUES FOR THERMAL PROPERTIES
'                       CONTAINS  X COORDINATE - TEMPERATURE
'                                 Y COORDINATE - FUNCTION VALUE
'                                 S - SLOPE OF LINES CONNECTING X,Y PAIR
'
   Input #NIN, IREAD
   NMAT = CInt(IREAD)
   If NMAT <= 0 Then
       'ERROR WAS DETECTED IN CONTROL WORD OR CONTROL VARIABLE
       'HAS IMPROPER VALUE AND PROGRAM IS TERMINATED
       MsgBox "Errore nel file di input", vbOKOnly + vbInformation, "Errore!!!"
       Print #NOUT, " - - - PROGRAM TERMINATED - INPUT ERROR - - - "; IREAD
       Close #NIN
       Close #NOUT
       Exit Sub
   End If
   
   'Dim N9 As Integer
   'N9 = N8 + 6 * NMAT              '->XYS(NSTORE)
   
   ReDim MATL(6 * NMAT) As Integer
   
'
   'Call MATRIAL(C(N8), C(N9), N)
   Call MATRIAL(MATL(), XYS(), N)

   'ReDim XYS(N) As double 'NSTORE ritornato da MATRIAL() in N

   'Dim N10 As Integer
   'N10 = N9 + N                    '->MAT(NBCMAT)

   'ReDim MAT(NBCMAT) As Integer
   
'
'     INPUT CONTROL CARD * FIRE *
'
   Input #NIN, IREAD
   If InStr(IREAD, "FIRE") = 0 Then
       'ERROR WAS DETECTED IN CONTROL WORD OR CONTROL VARIABLE
       'HAS IMPROPER VALUE AND PROGRAM IS TERMINATED
       MsgBox "Errore nel file di input", vbOKOnly + vbInformation, "Errore!!!"
       Print #NOUT, " - - - PROGRAM TERMINATED - INPUT ERROR - - - "; IREAD
       Close #NIN
       Close #NOUT
       Exit Sub
   End If
   N = 1
'
'     INPUT OF FIRE BOUNDARY CONDITION DATA
'
'        NFBC1D - NUMBER OF FIRE B.C. SURFACE NODES (FOR 1-D ELEMENTS)
'        NFBC2D - NUMBER OF FIRE B.C. SURFACE ELMTS (FOR 2-D ELEMENTS)
'        NFBC3D - NUMBER OF FIRE B.C. SURFACE ELMTS (FOR 3-D ELEMENTS)
'          ( THESE ARE MAXIMUMS IN ORDER TO ALLOT STORAGE )
'        NBCMAT - NUMBER OF DIFFERENT MATERIALS FOR FIRE B.C.
'        NBCTYP - TYPE OF FIRE B.C.
'        MAT(1)=C(N10)  - CONTROL DATA REQUIRED FOR CALCULATION OF FIRE
'                         BOUNDARY CONDITION PROPERTIES
'        FXYS(1)=C(N11) - CONTAINS FUNCTIONS OF FIRE B.C. PROPERTIES
'                         STRUCTURED SAME AS XYS
'

   Input #NIN, IREAD
   NFBC1D = CInt(IREAD)
   Input #NIN, IREAD
   NFBC2D = CInt(IREAD)
   Input #NIN, IREAD
   NFBC3D = CInt(IREAD)
   Dim NUMFBC As Integer
   NUMFBC = NFBC1D + NFBC2D + NFBC3D
   If NUMFBC = 0 Then GoTo lab40
   Input #NIN, IREAD
   NBCMAT = CInt(IREAD)
   ReDim MAT(NBCMAT) As Integer
   Input #NIN, IREAD
   If InStr(IREAD, "NONLINEAR") > 0 Then GoTo lab20
'
'     LINEAR FIRE BOUNDARY CONDITION
'
'        Q = H(T)*(TF-TS)  WHERE
'                          H(T) - SURFACE HEAT TRANSFER COEFFICENT
'                          TF - PSUEDO-FIRE TEMPERATURE (INPUT DATA)
'                          TS - SURFACE TEMPERATURE OF SYSTEM
'                          T = (TF + TS) / 2
'

   'NBCTYP = "LINEAR BC "
   NBCTYP = LINEAR_BC
   
   'Dim N11 As Integer
   'N11 = N10 + 2 * NBCMAT          '->FXYS(NSTORE)
   
   'ReDim FXYS(N) As Double
   
   GoTo lab30
'
lab20:
   If InStr(IREAD, "LINEAR") = 0 Then
       'ERROR WAS DETECTED IN CONTROL WORD OR CONTROL VARIABLE
       'HAS IMPROPER VALUE AND PROGRAM IS TERMINATED
       MsgBox "Errore nel file di input", vbOKOnly + vbInformation, "Errore!!!"
       Print #NOUT, " - - - PROGRAM TERMINATED - INPUT ERROR - - - "; IREAD
       Close #NIN
       Close #NOUT
       Exit Sub
   End If
'
'     NON-LINEAR FIRE BOUNDARY CONDITION
'
'        Q = A*(TF-TS)**N + V*SB*(AB*EF*ATF**4-ES*ATS**4)
'
'        WHERE  A - CONVECTION FACTOR
'               N - POWER OF CONVECTION TERM
'               V - VIEW FACTOR FOR RADIATION TERM
'               SB - STEFANN BOLTZMANN CONSTANT
'               AB - ABSORBTION FACTOR OF FIRE
'               EF - EMISSIVITY OF FIRE
'               ES - EMISSIVITY OF SURFACE
'               ATF - ABSOLUTE TEMPERATURE OF PSUEDO FIRE
'               ATS - ABSOLUTE TEMPERATURE OF SURFACE OF SYSTEM
'
    'NBCTYP = "NON-LIN BC"
    NBCTYP = NONLIN_BC
   
    'N11 = N10 + NBCMAT             '->FXYS(NSTORE)

    'ReDim FXYS(N) As Double

lab30:
   'Call FIREMAT(C(N10), C(N11), N)
   Call FIREMAT(MAT(), FXYS(), N)
       
'
'     INPUT OF GEOMETRIC DESCRIPTION OF FIRE BOUNDARY
'
'         LI(1)=C(N12) - FIRST  NODE THAT BOUNDS FIRE SURFACE ELEM
'                        ( 1-D, 2-D, AND 3-D ELEMENTS )
'         LJ(1)=C(N13) - SECOND NODE THAT BOUNDS FIRE SURFACE ELEM
'                        ( 2-D AND 3-D ELEMENTS ONLY )
'         LK(1)=C(N14) - THIRD  NODE THAT BOUNDS FIRE SURFACE ELEM
'                        ( 3-D ELEMENTS ONLY )
'         LL(1)=C(N15) - FOURTH NODE THAT BOUNDS FIRE SURFACE ELEM
'                        ( 3-D ELEMENTS ONLY )
'        LMAT(1)=C(N16) - FIRE BOUNDARY CONDITION TYPE (MATERIAL)
'        LFIRE(1)=C(N17) - NUMBER OF FIRE ACTIVE ON SURFACE I, I-J,
'                          OR I-J-K-L
'        AIJKL(1)=C(N18) - AREA OF SURFACE I, I-J, OR I-J-K-L
'        LELEM(1)=C(N19) - NUMBER OF FINITE ELEMENT ADJACENT TO THE
'                          FIRE SURFACE ( 1-D AND 2-D ONLY )
'

   'Dim N12 As Integer
   'Dim N13 As Integer
   'Dim N14 As Integer
   'Dim N15 As Integer
   'Dim N16 As Integer
   'Dim N17 As Integer
   'Dim N18 As Integer
   'Dim N19 As Integer
   'Dim N20 As Integer
 
   'N12 = N11 + N                   '->LI(NUMFBC)
   'N13 = N12 + NUMFBC              '->LJ(NFBC2D + NFBC3D)
   'N14 = N13 + NFBC2D + NFBC3D     '->LK(NFBC3D)
   'N15 = N14 + NFBC3D              '->LL(NFBC3D)
   'N16 = N15 + NFBC3D              '->LMAT(NUMFBC)
   'N17 = N16 + NUMFBC              '->LFIRE(NUMFBC)
   'N18 = N17 + NUMFBC              '->AIJKL(NUMFBC)
   'N19 = N18 + NUMFBC              '->LELEM(NFBC1D + NFBC2D)
   'N20 = N19 + NFBC1D + NFBC2D     '->IEXO(3 * NQINT)

   If NUMFBC > 0 Then ReDim LI(NUMFBC) As Integer
   If (NFBC2D + NFBC3D) > 0 Then ReDim LJ(NFBC2D + NFBC3D) As Integer
   If NFBC3D > 0 Then ReDim LK(NFBC3D) As Integer
   If NFBC3D > 0 Then ReDim LL(NFBC3D) As Integer
   If NUMFBC > 0 Then ReDim LMAT(NUMFBC) As Integer
   If NUMFBC > 0 Then ReDim LFIRE(NUMFBC) As Integer
   If NUMFBC > 0 Then ReDim AIJKL(NUMFBC) As Double
   If (NFBC1D + NFBC2D) > 0 Then ReDim LELEM(NFBC1D + NFBC2D) As Integer
   If NQINT > 0 Then ReDim IEXO(3 * NQINT) As Integer

   'Call FIREBC(C(N1), C(N2), C(N3), C(ND0), C(N6), C(N7), C(N12), C(N13), C(N14), C(N15), C(N16), C(N17), C(N18), C(N19))
   Call FIREBC(X(), Y(), Z(), KODE(), BAREA(), THICK(), LI(), LJ(), LK(), LL(), LMAT(), LFIRE(), AIJKL(), LELEM())
   GoTo lab50

lab40:

'
'     WHEN NO FIRE B.C. IS SPECIFIED, INITIALIZE N11 - N20
'
   'N11 = N10              '->FXYS()    = ->MAT(NBCMAT)
   'N12 = N10              '->LI()      = ->MAT(NBCMAT)
   'N13 = N10              '->LJ()      = ->MAT(NBCMAT)
   'N14 = N10              '->LK()      = ->MAT(NBCMAT)
   'N15 = N10              '->LL()      = ->MAT(NBCMAT)
   'N16 = N10              '->LMAT()    = ->MAT(NBCMAT)
   'N17 = N10              '->LFIRE()   = ->MAT(NBCMAT)
   'N18 = N10              '->AIJKL()   = ->MAT(NBCMAT)
   'N19 = N10              '->LELEM()   = ->MAT(NBCMAT)
   'N20 = N10              '->IEXO()    = ->MAT(NBCMAT)
   
   'ReDim FXYS(1) As Double
   'ReDim LI(1) As Integer
   'ReDim LJ(1) As Integer
   'ReDim LK(1) As Integer
   'ReDim LL(1) As Integer
   'ReDim LMAT(1) As Integer
   'ReDim LFIRE(1) As Integer
   'ReDim AIJKL(1) As Double
   'ReDim LELEM(1) As Integer
   'ReDim IEXO(1) As Integer
   
'
'     INPUT CONTROL CARD * EXOTHERMIC *
'
lab50:
   Input #NIN, IREAD
   If InStr(IREAD, "EXOTHERMIC") = 0 Then
       'ERROR WAS DETECTED IN CONTROL WORD OR CONTROL VARIABLE
       'HAS IMPROPER VALUE AND PROGRAM IS TERMINATED
       MsgBox "Errore nel file di input", vbOKOnly + vbInformation, "Errore!!!"
       Print #NOUT, " - - - PROGRAM TERMINATED - INPUT ERROR - - - "; IREAD
       Close #NIN
       Close #NOUT
       Exit Sub
   End If
   N = 1

'
'     INPUT OF DATA DESCRIBING INTERNAL EXOTHERMIC HEAT GENERATION
'
'        NINT1D - NUMBER OF 1-D ELEMENTS WITH INTERNAL HEAT GENERATION
'        NINT2D - NUMBER OF 2-D ELEMENTS WITH INTERNAL HEAT GENERATION
'        NINT3D - NUMBER OF 3-D ELEMENTS WITH INTERNAL HEAT GENERATION
'        NINT - TOTAL NUMBER OF ELEMENTS WITH HEAT GENERATION
'        NQINT - NUMBER OF DIFFERENT HEATING CURVES
'        IEXO(1)=C(N20) - CONTROL DATA FOR HEATING CURVES
'        EXYS(1)=C(N21) - CONTAINS FUNCTION VALUES FOR HEATING CURVE
'                         X - COORDINATE - TIME
'                         Y - COORDINATE - HEAT RATE
'                         S - SLOPE OF LINES CONNECTING X,Y PAIRS
'        IEL(1)=C(N22) - ELEMENT NUMBER OF EACH ELEMENT UNDERGOING
'                        EXOTHERMIC HEATING
'        IMAT(1)=C(N23) - HEATING CURVE OF EACH ELEMENT UNDERGOING
'                         EXOTHERMIC HEATING
'        VEL(1)=C(N24) - VOLUME OF EACH ELEMENT
'

   Input #NIN, IREAD
   NINT1D = CInt(IREAD)
   Input #NIN, IREAD
   NINT2D = CInt(IREAD)
   Input #NIN, IREAD
   NINT3D = CInt(IREAD)
   NINT = NINT1D + NINT2D + NINT3D
   If NINT <> 0 Then GoTo lab60
   
   'Dim N21 As Integer
   'Dim N22 As Integer
   'Dim N23 As Integer
   'Dim N24 As Integer
   'Dim N25 As Integer

   'N21 = N20   '->EXYS()   = ->IEXO(3 * NQINT)
   'N22 = N20   '->IEL()    = ->IEXO(3 * NQINT)
   'N23 = N20   '->IMAT()   = ->IEXO(3 * NQINT)
   'N24 = N20   '->VEL()    = ->IEXO(3 * NQINT)
   'N25 = N20   '->Q()      = ->IEXO(3 * NQINT)

   'ReDim EXYS(1) As Double
   'ReDim IEL(1) As Integer
   'ReDim IMAT(1) As Integer
   'ReDim VEL(1) As Double
   'ReDim Q(1) As Integer

   Input #NIN, IREAD 'INSERITO ARBITRARIAMENTE in quanto "EXOTHERMIC,0,0,0,0" -------------tex

   GoTo lab70
   
lab60:
   Input #NIN, IREAD
   NQINT = CInt(IREAD)
   'N21 = N20 + NQINT * 3           '->EXYS(NSTORE)
   
   'Call EXOFUN(C(N20), C(N21), N)
   Call EXOFUN(IEXO(), EXYS(), N)

   'ReDim Preserve EXYS_X(N) As Double   'NSTORE ritornato da EXOFUN() in N
   'ReDim Preserve EXYS_Y(N) As Double   'NSTORE ritornato da EXOFUN() in N
   'ReDim Preserve EXYS_S(N) As Double   'NSTORE ritornato da EXOFUN() in N
   
   'N22 = N21 + N                   '->IEL(NINT)
   'N23 = N22 + NINT                '->IMAT(NINT)
   'N24 = N23 + NINT                '->VEL(NINT)
   'N25 = N24 + NINT                '->Q(NUMNP)

   ReDim IEL(NINT) As Integer
   ReDim IMAT(NINT) As Integer
   ReDim VEL(NINT) As Double

   'Call EXOELS(C(N1), C(N2), C(N3), C(N4), C(N6), C(N7), C(NV), C(N22), C(N23), C(N24))
   Call EXOELS(X(), Y(), Z(), LM(), BAREA(), THICK(), VOLUME(), IEL(), IMAT(), VEL())

'
'     ESTABLISH ADDITIONAL DYNAMICALLY DIMENSIONED VARIABLES REQUIRED
'     IN THE HEAT FLOW ANALYSIS
'
'        Q(1)=C(N25) - FLOW VECTOR
'        T(1)=C(N26) - TEMPERATURE VECTOR
'        B(1)=C(N27) - HEAT LOAD (FLOW) VECTOR USED IN ANALYSIS
'        AT(1)=C(N28) - ELEMENT TEMPERATURES
'        A(1,1)=C(N29) - MODIFIED CONDUCTIVITY MATRIX
'        NTOTAL - TOTAL AMOUNT OF STORAGE REQUIRED FOR BLANK COMMON
'
lab70:

   'Dim N26 As Integer
   'Dim N27 As Integer
   'Dim N28 As Integer
   'Dim N29 As Integer

   'N26 = N25 + NUMNP                   '->T(NUMNP)
   'N27 = N26 + NUMNP                   '->B(NUMNP)
   'N28 = N27 + NUMNP                   '->AT(NUMEL)
   'N29 = N28 + NUMEL                   '->A(NUMNP * MBAND)
   
   ReDim Q(NUMNP) As Double
   ReDim T(NUMNP) As Double
   ReDim B(NUMNP) As Double
   ReDim AT(NUMEL) As Double
   ReDim A(NUMNP, MBAND) As Double

   'Dim NTOTAL As Integer
   'NTOTAL = N29 + NUMNP * MBAND        'NTOTAL
   'If NTOTAL <= NALLOW Then GoTo lab80
   
   'MsgBox "Errore nel file di input", vbOKOnly + vbInformation, "Errore!!!"
   'Print #NOUT, " STOP - INCREASE BLANK COMMON SIZE TO"; NTOTAL
   'chiusura files
   'Close #NIN
   'Close #NOUT
   'Exit Sub
   
'
'     INPUT CONTROL CARD * CONVERGENCE *
'
lab80:
   Input #NIN, IREAD
   If InStr(IREAD, "CONVERGENCE") = 0 Then
       'ERROR WAS DETECTED IN CONTROL WORD OR CONTROL VARIABLE
       'HAS IMPROPER VALUE AND PROGRAM IS TERMINATED
       MsgBox "Errore nel file di input", vbOKOnly + vbInformation, "Errore!!!"
       Print #NOUT, " - - - PROGRAM TERMINATED - INPUT ERROR - - - "; IREAD
       Close #NIN
       Close #NOUT
       Exit Sub
   End If
   N = 1

'
'     INPUT CONVERGENCE CONTROL DATA FOR ITERATIVE PROCESS
'
   'Call CONVERG(NTOTAL)
   Call CONVERG


'
'     TRANSFER CONTROL OF PROGRAM TO HEAT FLOW ANALYSIS ROUTINE
'     IN ORDER TO CARRY OUT STEP-BY-STEP TIME INTEGRATION
'
   'Call HEATFLO(C(N1), C(N2), C(N3), C(ND0), C(ND1), C(ND2), C(ND3), C(ND4), C(ND5), C(N4), _
   '          C(N5), C(N6), C(N7), C(N8), C(N9), C(N10), C(N11), C(N12), C(N13), C(N14), _
   '          C(N15), C(N16), C(N17), C(N18), C(N19), C(N20), C(N21), C(N22), C(N23), _
   '          C(N24), C(N25), C(N26), C(N27), C(N28), C(N29), C(NV), NUMNP, NUMFBC)
   Call HEATFLO(X(), Y(), Z(), KODE(), D(), MA(), T1(), T2(), T3(), LM(), _
                   MMTYPE(), BAREA(), THICK(), MATL(), XYS(), MAT(), FXYS(), LI(), LJ(), LK(), _
                   LL(), LMAT(), LFIRE(), AIJKL(), LELEM(), IEXO(), EXYS(), IEL(), IMAT(), _
                   VEL(), Q(), T(), B(), AT(), A(), VOLUME(), NUMNP, NUMFBC)
   GoTo lab10

esci:
       Close #NIN
       Close #NOUT
End Sub

*** INTERIOR BASEMENT COLUMN - BLDG STUDY - ASTM FIRE ***                      
NODES,96,0                                                                      
   1        0.        0.                                                      
   3   .333333        0.                                                      
   6   .583333        0.                                                      
   7   .614154        0.                                                      
   8   .666667        0.                                                      
   9   .708333        0.                                                      
  10   .750000        0.                                                      
  11   .833333        0.                                                      
  12   .614154   .047086                                                      
  13   .666667   .047086                                                      
  14   .708333   .047086                                                      
  15        0.   .166667                                                      
  17   .333333   .166667                                                      
  23   .833333   .166667                                                      
  24        0.   .333333                                                      
  26   .333333   .333333                                                      
  32   .833333   .333333                                                      
  33        0.   .416667                                                      
  35   .333333   .416667                                                      
  41   .833333   .416667                                                      
  42        0.   .500000                                                      
  44   .333333   .500000                                                      
  50   .833333   .500000                                                      
  51        0.   .583333                                                      
  53   .333333   .583333                                                      
  55   .500000   .583333                                                      
  56   .520834   .614154                                                      
  57   .583333   .583333                                                      
  58   .583333   .614154                                                      
  59   .666667   .583333                                                      
  60   .666667   .614154                                                      
  61   .708333   .614154                                                      
  62   .750000   .583333                                                      
  63   .833333   .583333                                                      
  64        0.   .666667                                                      
  66   .333333   .666667                                                      
  68   .500000   .666667                                                      
  69   .520834   .666667                                                      
  70   .583333   .666667                                                      
  71   .666667   .666667                                                      
  72   .708333   .666667                                                      
  73   .750000   .666667                                                      
  74   .833333   .666667                                                      
  75        0.   .750000                                                      
  77   .333333   .750000                                                      
  79   .500000   .750000                                                      
  80   .520834   .708333                                                      
  81   .583333   .750000                                                      
  82   .583333   .708333                                                      
  83   .666667   .750000                                                      
  84   .666667   .708333                                                      
  85   .708333   .708333                                                      
  86   .750000   .750000                                                      
  87   .833333   .750000                                                      
  88        0.   .833333                                                      
  90   .333333   .833333                                                      
  96   .833333   .833333                                                      
ELEMENTS,0,78,0                                                                
   1    1    2   16   15    1       1.0                                        
   6    6    7   12   20    1       1.0                                        
   7    7    8   13   12    2       1.0                                        
   9    9   10   22   14    1       1.0                                        
  10   10   11   23   22    1       1.0                                        
  11   12   13   21   20    1       1.0                                        
  12   13   14   22   21    1       1.0                                        
  13   15   16   25   24    1       1.0                                        
  21   24   25   34   33    1       1.0                                        
  29   33   34   43   42    1       1.0                                        
  37   42   43   52   51    1       1.0                                        
  41   46   47   57   55    1       1.0                                        
  42   47   48   59   57    1       1.0                                        
  43   48   49   62   59    1       1.0                                        
  44   49   50   63   62    1       1.0                                        
  45   51   52   65   64    1       1.0                                        
  50   55   57   58   56    1       1.0                                        
  51   57   59   60   58    1       1.0                                        
  52   59   62   61   60    1       1.0                                        
  53   61   62   73   72    1       1.0                                        
  54   62   63   74   73    1       1.0                                        
  55   56   58   70   69    2       1.0                                        
  56   58   60   71   70    2       1.0                                        
  57   60   61   72   71    2       1.0                                        
  58   69   70   82   80    2       1.0                                        
  59   70   71   84   82    2       1.0                                        
  60   71   72   85   84    2       1.0                                        
  61   64   65   76   75    1       1.0                                        
  66   80   82   81   79    1       1.0                                        
  67   82   84   83   81    1       1.0                                        
  68   84   85   86   83    1       1.0                                        
  69   72   73   86   85    1       1.0                                        
  71   75   76   89   88    1       1.0                                        
  75   79   81   93   92    1       1.0                                        
  76   81   83   94   93    1       1.0                                        
  77   83   86   95   94    1       1.0                                        
  78   86   87   96   95    1       1.0                                        
MATERIALS,2                                                                    
   4    0    0                                                                
      0.0      1.01     390.0      1.01    1650.0     0.506    3000.0    0.506
    0.272                                                                      
    150.0                                                                      
   3    4    0                                                                
      0.0     30.00    1100.0     19.90    3000.0     19.90                    
      0.0     0.107     750.0     0.144    1100.0     0.172    3000.0     0.172
    480.0                                                                      
FIRE,0,16,0,1                                                                  
NONLINEAR                                                                      
   1.7E-9     460.0                                                            
      .27      1.25       1.0       0.9       0.3       0.9                    
SURFACE,0,16,0                                                                  
  11   23    1    1   10   23   32    1    1   20   32   41    1    1   28    
  41   50    1    1   36   50   63    1    1   44   63   74    1    1   54    
  74   87    1    1   70   87   96    1    1   78   96   95    1    1   78    
  95   94    1    1   77   94   93    1    1   76   93   92    1    1   75    
  92   91    1    1   74   91   90    1    1   73   90   89    1    1   72    
  89   88    1    1   71                                                      
EXOTHERMIC,0,0,0,0                                                              
CONVERGENCE                                                                    
  15      .005      -.25                                                      
STEP     0       0.0      68.0                                                  
STEP     1      .025        347.600                                3  2        
STEP     2      .025        627.200                                3  2        
STEP     3      .025        906.800                                3  2        
STEP     4      .025       1060.000                                3            
STEP     5      .025       1150.000                                3            
STEP     6    -1.

C           -------------------PROVA1-------------------------

         PRINT *, '***************************************'
         PRINT *, '*          PROGRAM  PROVA1            *'
         PRINT *, '*             by TEX                  *'
         PRINT *, '***************************************'
         
         DO 100,I=1,5
         IF (I.EQ.3) GO TO 100
         PRINT *, I,'pippo1'
100   CONTINUE
     PRINT *,'------'
       
         DO 200,I=1,5
         IF (I.EQ.3) GO TO 150
         PRINT *, I,'pippo2'
150   CONTINUE
200   CONTINUE
     PRINT *,'------'

         DO 300,I=1,5
         IF (I.EQ.3) GO TO 300
300          PRINT *, I,'pippo3'
     PRINT *,'------'

         END

'-------------------PROVA1-------------------------

PRINT  "***************************************"
PRINT  "*          PROGRAM  PROVA1            *"
PRINT  "*             by TEX                  *"
PRINT  "***************************************"

DIM I%

       FOR I=1 TO 5
         IF (I=3) THEN GOTO lab100
         PRINT I,"pippo1"
lab100:
       NEXT I
       PRINT "------"

       FOR I=1 TO 5
         IF (I=3) THEN GOTO lab150
         PRINT I,"pippo2"
lab150:
       NEXT I
       PRINT "------"

       FOR I=1 TO 5
         IF (I=3) THEN GOTO lab300
lab300:
         PRINT I,"pippo3"
       NEXT I
       PRINT "------"