evac.f90

FDS为火灾动力学模拟软件源代码,该软件为开源项目,代码语言主要为FORTRAN,可在WINDOWS和LINUX下编译运行,详细说明可参考http://fire.nist.gov/fds/官方网址

       End Do PEX_Mesh3Loop
       If (ii == 0) Then
          Write(MESSAGE,'(A,A,A)') &
               'ERROR: EXIT line ',Trim(PEX%ID_NAME), &
               ' problem with XYZ, no mesh found'
          Call SHUTDOWN(MESSAGE)
       End If
       ! 
       ! Check, which fire grid and i,j,k (xyz)
       PEX_SmokeLoop: Do i = 1, nmeshes
          If (.Not. evacuation_only(i)) Then
             If ( (PEX%Zsmoke >= Meshes(i)%ZS .And. &
                  PEX%Zsmoke <= Meshes(i)%ZF).And. &
                  (PEX%Ysmoke >= Meshes(i)%YS .And. &
                  PEX%Ysmoke <= Meshes(i)%YF).And. &
                  (PEX%Xsmoke >= Meshes(i)%XS .And. &
                  PEX%Xsmoke <= Meshes(i)%XF)) Then
                PEX%FED_MESH = i
                Exit PEX_SmokeLoop
             End If
          End If
          !     No mesh found
          PEX%FED_MESH = -1
       End Do PEX_SmokeLoop
       !   No mesh found
       If (PEX%FED_MESH == 0) PEX%FED_MESH = -1

       If (PEX%FED_MESH > 0) Then 
          M => MESHES(PEX%FED_MESH)
          II = Floor(M%CELLSI(Floor((PEX%Xsmoke-M%XS)*M%RDXINT))+ 1.0_EB)
          JJ = Floor(M%CELLSJ(Floor((PEX%Ysmoke-M%YS)*M%RDYINT))+ 1.0_EB)
          KK = Floor(M%CELLSK(Floor((PEX%Zsmoke-M%ZS)*M%RDZINT))+ 1.0_EB)
          If ( M%SOLID(M%CELL_INDEX(II,JJ,KK)) ) Then
             PEX%FED_MESH = -1   ! no smoke at a solid object
             PEX%II = 0
             PEX%JJ = 0
             PEX%KK = 0
          Else
             PEX%II = II
             PEX%JJ = JJ
             PEX%KK = KK
          End If
       Else
          PEX%II = 0
          PEX%JJ = 0
          PEX%KK = 0
       End If
       !
    End Do READ_EXIT_LOOP
26  Rewind(LU_INPUT)
    !
    ! Read the DOOR lines
    !
    READ_DOOR_LOOP: Do N = 1, N_DOORS
       PDX=>EVAC_DOORS(N)
       !
       ID            = 'null'
       XB            = 0.0_EB
       IOR           = 0
       FLOW_FIELD_ID = 'null'
       VENT_FFIELD   = 'null'
       EVAC_MESH     = 'null'
       TO_NODE       = 'null'
       CHECK_FLOW    = .False.
       EXIT_SIGN     = .False.
       MAX_FLOW      = 0.0_EB
       WIDTH         = 0.0_EB
       XYZ(:)        = Huge(XYZ)
       XYZ_SMOKE(:)  = Huge(XYZ_SMOKE)
       COLOR_INDEX   = 0
       KEEP_XY       = .False.
       !
       Call CHECKREAD('DOOR',LU_INPUT,IOS)
       If (IOS == 1) Exit READ_DOOR_LOOP
       Read(LU_INPUT,DOOR,End=27,IOSTAT=IOS)
       !
       Do I=1,5,2
          If (XB(I) > XB(I+1)) Then
             DUMMY   = XB(I)
             XB(I)   = XB(I+1)
             XB(I+1) = DUMMY
          End If
       End Do
       !
       PDX%X1 = XB(1)
       PDX%X2 = XB(2)
       PDX%Y1 = XB(3)
       PDX%Y2 = XB(4)
       PDX%Z1 = XB(5)
       PDX%Z2 = XB(6)
       PDX%IOR        = IOR
       PDX%ID_NAME    = ID
       PDX%GRID_NAME  = FLOW_FIELD_ID
       PDX%VENT_FFIELD= VENT_FFIELD
       PDX%CHECK_FLOW = CHECK_FLOW
       PDX%EXIT_SIGN  = EXIT_SIGN
       PDX%KEEP_XY    = KEEP_XY
       PDX%TO_NODE    = TO_NODE
       PDX%INODE      = 0
       PDX%INODE2     = 0
       PDX%T_first    = 0.0_EB
       PDX%T_last     = 0.0_EB
       PDX%ICOUNT     = 0
       PDX%Flow_max   = 0.0_EB
       If (CHECK_FLOW) PDX%Flow_max   = MAX_FLOW

       PDX%COLOR_INDEX = Mod(Max(0,COLOR_INDEX),8) ! 0-7 always

       PDX%FED_MESH = 0
       If (XYZ(1) < Huge(XYZ)) Then
          PDX%X = XYZ(1)
          PDX%Y = XYZ(2)
          PDX%Z = XYZ(3)
       Else
          PDX%X = 0.5_EB*(XB(1)+XB(2))
          PDX%Y = 0.5_EB*(XB(3)+XB(4))
          PDX%Z = 0.5_EB*(XB(5)+XB(6))
       End If

       If (XYZ_SMOKE(1) < Huge(XYZ_SMOKE)) Then
          PDX%Xsmoke = XYZ(1)
          PDX%Ysmoke = XYZ(2)
          PDX%Zsmoke = XYZ(3)
       Else
          PDX%Xsmoke = PDX%X
          PDX%Ysmoke = PDX%Y
          PDX%Zsmoke = PDX%Z
       End If

       Select Case (IOR)
       Case (-1,+1)
          If (WIDTH <= 0.0_EB) Then
             PDX%Width = XB(4) - XB(3)
          Else
             PDX%Width = WIDTH
          End If
       Case (-2,+2)
          If (WIDTH <= 0.0_EB) Then
             PDX%Width = XB(2) - XB(1)
          Else
             PDX%Width = WIDTH
          End If
       Case (-3)
          If ( (XB(4)-XB(3)) <= 0.0_EB .Or. (XB(2)-XB(1)) <= 0.0_EB) Then
             Write(MESSAGE,'(A,I4,A)') &
                  'ERROR: DOOR',N,' IOR=-3 but not 3-dim object'
             Call SHUTDOWN(MESSAGE)
          End If
       Case (0)
          If ( (XB(4)-XB(3)) <= 0.0_EB .Or. (XB(2)-XB(1)) <= 0.0_EB) Then
             Write(MESSAGE,'(A,I4,A)') &
                  'ERROR: DOOR',N,' no IOR but not 3-dim object'
             Call SHUTDOWN(MESSAGE)
          End If
       Case Default
          Write(MESSAGE,'(A,I4,A)') &
               'ERROR: DOOR',N,' problem with IOR'
          Call SHUTDOWN(MESSAGE)
       End Select
       ! 
       ! Check which evacuation floor
       ! Now there may be overlapping meshes.
       ii = 0
       PDX_MeshLoop: Do i = 1, nmeshes
          If (evacuation_only(i) .And. evacuation_grid(i)) Then
             If ( (PDX%Z1 >= Meshes(i)%ZS .And. PDX%Z2 <= Meshes(i)%ZF).And. &
                  (PDX%Y1 >= Meshes(i)%YS .And. PDX%Y2 <= Meshes(i)%YF).And. &
                  (PDX%X1 >= Meshes(i)%XS .And. PDX%X2 <= Meshes(i)%XF)) Then
                If (Trim(EVAC_MESH) == 'null' .Or. &
                     Trim(EVAC_MESH) == Trim(MESH_NAME(i))) Then
                   ii = ii + 1
                   PDX%IMESH = i
                End If
             End If
          End If
       End Do PDX_MeshLoop
       If (PDX%IMESH == 0) Then
          Write(MESSAGE,'(A,A,A)') &
               'ERROR: DOOR line ',Trim(PDX%ID_NAME), &
               ' problem with IMESH, no mesh found'
          Call SHUTDOWN(MESSAGE)
       End If
       If (ii > 1) Then
          Write(MESSAGE,'(A,A,A)') &
               'ERROR: DOOR line ',Trim(PDX%ID_NAME), &
               ' not an unique mesh found '
          Call SHUTDOWN(MESSAGE)
       End If
       ! 
       ! Check which vent field. If VENT_FFIELD is not found, use
       ! the main evac grid.
       PDX%I_VENT_FFIELD = 0
       PDX_Mesh2Loop: Do i = 1, nmeshes
          If ( evacuation_only(i) .And. &
               (Trim(MESH_NAME(i)) == Trim(PDX%VENT_FFIELD)) ) Then
             If ( (PDX%Z1 >= Meshes(i)%ZS .And. PDX%Z2 <= Meshes(i)%ZF).And. &
                  (PDX%Y1 >= Meshes(i)%YS .And. PDX%Y2 <= Meshes(i)%YF).And. &
                  (PDX%X1 >= Meshes(i)%XS .And. PDX%X2 <= Meshes(i)%XF)) Then
                PDX%I_VENT_FFIELD = i
                Exit PDX_Mesh2Loop
             End If
          End If
       End Do PDX_Mesh2Loop
       ! If no vent field is given, then use the main evac grid.
       If (PDX%I_VENT_FFIELD == 0) Then
          PDX%I_VENT_FFIELD = PDX%IMESH
          PDX%VENT_FFIELD = Trim(MESH_NAME(PDX%IMESH))
       End If

       ! Check which evacuation floor
       ii = 0
       PDX_Mesh3Loop: Do i = 1, nmeshes
          If (evacuation_only(i) .And. evacuation_grid(i)) Then
             If ( (PDX%Z >= Meshes(i)%ZS .And. PDX%Z <= Meshes(i)%ZF).And. &
                  (PDX%Y >= Meshes(i)%YS .And. PDX%Y <= Meshes(i)%YF).And. &
                  (PDX%X >= Meshes(i)%XS .And. PDX%X <= Meshes(i)%XF)) Then
                If (PDX%IMESH == i ) ii = ii + 1
             End If
          End If
       End Do PDX_Mesh3Loop
       If (ii == 0) Then
          Write(MESSAGE,'(A,A,A)') &
               'ERROR: DOOR line ',Trim(PDX%ID_NAME), &
               ' problem with XYZ, no mesh found'
          Call SHUTDOWN(MESSAGE)
       End If
       ! 
       ! Check, which fire grid and i,j,k (xyz)
       PDX_SmokeLoop: Do i = 1, nmeshes
          If (.Not. evacuation_only(i)) Then
             If ( (PDX%Zsmoke >= Meshes(i)%ZS .And. &
                  PDX%Zsmoke <= Meshes(i)%ZF).And. &
                  (PDX%Ysmoke >= Meshes(i)%YS .And. &
                  PDX%Ysmoke <= Meshes(i)%YF).And. &
                  (PDX%Xsmoke >= Meshes(i)%XS .And. &
                  PDX%Xsmoke <= Meshes(i)%XF)) Then
                PDX%FED_MESH = i
                Exit PDX_SmokeLoop
             End If
          End If
          !     No mesh found
          PDX%FED_MESH = -1
       End Do PDX_SmokeLoop
       !   No mesh found
       If (PDX%FED_MESH == 0) PDX%FED_MESH = -1

       If (PDX%FED_MESH > 0) Then 
          M => MESHES(PDX%FED_MESH)
          II = Floor(M%CELLSI(Floor((PDX%Xsmoke-M%XS)*M%RDXINT))+ 1.0_EB)
          JJ = Floor(M%CELLSJ(Floor((PDX%Ysmoke-M%YS)*M%RDYINT))+ 1.0_EB)
          KK = Floor(M%CELLSK(Floor((PDX%Zsmoke-M%ZS)*M%RDZINT))+ 1.0_EB)
          If ( M%SOLID(M%CELL_INDEX(II,JJ,KK)) ) Then
             PDX%FED_MESH = -1   ! no smoke at a solid object
             PDX%II = 0
             PDX%JJ = 0
             PDX%KK = 0
          Else
             PDX%II = II
             PDX%JJ = JJ
             PDX%KK = KK
          End If
       Else
          PDX%II = 0
          PDX%JJ = 0
          PDX%KK = 0
       End If
       ! 
    End Do READ_DOOR_LOOP
27  Rewind(LU_INPUT)
    !
    ! Read the CORR line
    !
    n_max_in_corrs = 0
    READ_CORR_LOOP: Do N = 1, N_CORRS
       PCX=>EVAC_CORRS(N)
       !
       ID            = 'null'
       XB            = Huge(XB)
       XB1           = Huge(XB1)
       XB2           = Huge(XB2)
       IOR           = 0
       FLOW_FIELD_ID = 'null'
       TO_NODE       = 'null'
       CHECK_FLOW    = .False.
       MAX_FLOW      = 0.0_EB
       WIDTH         = 0.0_EB
       WIDTH1        = 0.0_EB
       WIDTH2        = 0.0_EB
       FAC_SPEED     = 0.0_EB
       EFF_WIDTH     = 0.0_EB
       EFF_LENGTH    = 0.0_EB
       MAX_HUMANS_INSIDE = 0
       !
       Call CHECKREAD('CORR',LU_INPUT,IOS)
       If (IOS == 1) Exit READ_CORR_LOOP
       Read(LU_INPUT,CORR,End=29,IOSTAT=IOS)
       !
       !
       Do I=1,5,2
          If (XB(I) > XB(I+1)) Then
             DUMMY   = XB(I)
             XB(I)   = XB(I+1)
             XB(I+1) = DUMMY
          End If
       End Do
       Do I=1,5,2
          If (XB1(I) > XB1(I+1)) Then
             DUMMY   = XB1(I)
             XB1(I)   = XB1(I+1)
             XB1(I+1) = DUMMY
          End If
       End Do
       Do I=1,5,2
          If (XB2(I) > XB2(I+1)) Then
             DUMMY   = XB2(I)
             XB2(I)   = XB2(I+1)
             XB2(I+1) = DUMMY
          End If
       End Do
       !
       ! Position, where smoke etc. is saved.
       ! If both XB and XB1 are given, use XB1
       If ( XB(1) < Huge(XB) ) Then
          PCX%FED_MESH = 0
          PCX%X1 = 0.5_EB*( XB(1) +  XB(2))
          PCX%Y1 = 0.5_EB*( XB(3) +  XB(4))
          PCX%Z1 = 0.5_EB*( XB(5) +  XB(6))
       Else
          PCX%FED_MESH = -1
          PCX%X1 = 0.0_EB
          PCX%Y1 = 0.0_EB
          PCX%Z1 = 0.0_EB
       End If
       If ( XB1(1) < Huge(XB1) ) Then
          PCX%FED_MESH = 0
          PCX%X1 = 0.5_EB*( XB1(1) +  XB1(2))
          PCX%Y1 = 0.5_EB*( XB1(3) +  XB1(4))
          PCX%Z1 = 0.5_EB*( XB1(5) +  XB1(6))
       Else If (XB(1) == Huge(XB) ) Then
          PCX%FED_MESH = -1
          PCX%X1 = 0.0_EB
          PCX%Y1 = 0.0_EB
          PCX%Z1 = 0.0_EB
       End If
       If ( XB2(1) < Huge(XB2) ) Then
          PCX%FED_MESH2 = 0
          PCX%X2 = 0.5_EB*(XB2(1) + XB2(2))
          PCX%Y2 = 0.5_EB*(XB2(3) + XB2(4))
          PCX%Z2 = 0.5_EB*(XB2(5) + XB2(6))
       Else
          PCX%FED_MESH2 = -1
          PCX%X2 = 0.0_EB
          PCX%Y2 = 0.0_EB
          PCX%Z2 = 0.0_EB
       End If

       PCX%IOR        = IOR
       PCX%ID_NAME    = ID
       PCX%GRID_NAME  = FLOW_FIELD_ID
       PCX%CHECK_FLOW = CHECK_FLOW
       PCX%TO_NODE    = TO_NODE
       PCX%INODE      = 0
       PCX%INODE2     = 0
       PCX%T_first    = 0.0_EB
       PCX%T_last     = 0.0_EB
       PCX%ICOUNT     = 0

       PCX%MAX_HUMANS_INSIDE = 0
       If (MAX_HUMANS_INSIDE > 0 ) Then
          PCX%MAX_HUMANS_INSIDE = MAX_HUMANS_INSIDE
       Else
          Write(MESSAGE,'(A,I4,A)') &
               'ERROR: CORR',N,' MAX_HUMANS_INSIDE <= 0'
          Call SHUTDOWN(MESSAGE)
       End If

       If (FAC_SPEED < 0 ) Then