evac.f90

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

          Write(MESSAGE,'(A,I4,A)') &
               'ERROR: CORR',N,' FAC_SPEED < 0'
          Call SHUTDOWN(MESSAGE)
       Else
          If (FAC_SPEED == 0.0_EB) FAC_SPEED = 0.6_EB
          PCX%Fac_Speed = FAC_SPEED
       End If

       PCX%Flow_max   = 0.0_EB
       If (CHECK_FLOW) PCX%Flow_max   = MAX_FLOW

       PCX%Width = Max( Abs(XB(4)-XB(3)) , Abs(XB(2)-XB(1)) )

       PCX%Eff_Width = 0.0_EB
       If (EFF_WIDTH > 0.0_EB ) Then
          PCX%Eff_Width = EFF_WIDTH
       Else
          PCX%Eff_Width = PCX%Width
       End If

       PCX%Eff_Length = 0.0_EB
       If (EFF_LENGTH > 0.0_EB ) Then
          PCX%Eff_Length = EFF_LENGTH
       Else
          Write(MESSAGE,'(A,I4,A)') &
               'ERROR: CORR',N,' EFF_LENGTH <= 0'
          Call SHUTDOWN(MESSAGE)
       End If
       PCX%Eff_Area = PCX%Eff_Length*PCX%Eff_Width

       PCX%Width1 = WIDTH1
       PCX%Width2 = WIDTH2
       If (WIDTH1*WIDTH2 <= 0.0_EB) Then
          PCX%Width1 = PCX%Width
          PCX%Width2 = PCX%Width
       End If
       ! 
       PCX_MeshLoop: Do i = 1, nmeshes
          If (.Not. evacuation_only(i) .And. PCX%FED_MESH >= 0) Then
             If ( (PCX%Z1 >= Meshes(i)%ZS .And. PCX%Z1 <= Meshes(i)%ZF).And. &
                  (PCX%Y1 >= Meshes(i)%YS .And. PCX%Y1 <= Meshes(i)%YF).And. &
                  (PCX%X1 >= Meshes(i)%XS .And. PCX%X1 <= Meshes(i)%XF)) Then
                PCX%FED_MESH = i
                Exit PCX_MeshLoop
             End If
          End If
          !     No mesh found
          PCX%FED_MESH = -1
       End Do PCX_MeshLoop
       !   No mesh found
       If (PCX%FED_MESH == 0) PCX%FED_MESH = -1

       If (PCX%FED_MESH > 0) Then 
          M => MESHES(PCX%FED_MESH)
          II = Floor( M%CELLSI(Floor((PCX%X1-M%XS)*M%RDXINT)) + 1.0_EB  )
          JJ = Floor( M%CELLSJ(Floor((PCX%Y1-M%YS)*M%RDYINT)) + 1.0_EB  )
          KK = Floor( M%CELLSK(Floor((PCX%Z1-M%ZS)*M%RDZINT)) + 1.0_EB  )
          If ( M%SOLID(M%CELL_INDEX(II,JJ,KK)) ) Then
             PCX%FED_MESH = -1   ! no smoke at a solid object
             PCX%II(1) = 0
             PCX%JJ(1) = 0
             PCX%KK(1) = 0
          Else
             PCX%II(1) = II
             PCX%JJ(1) = JJ
             PCX%KK(1) = KK
          End If
       Else
          PCX%II(1) = 0
          PCX%JJ(1) = 0
          PCX%KK(1) = 0
       End If

       PCX_MeshLoop2: Do i = 1, nmeshes
          If (.Not. evacuation_only(i) .And. PCX%FED_MESH2 >= 0) Then
             If ( (PCX%Z2 >= Meshes(i)%ZS .And. PCX%Z2 <= Meshes(i)%ZF).And. &
                  (PCX%Y2 >= Meshes(i)%YS .And. PCX%Y2 <= Meshes(i)%YF).And. &
                  (PCX%X2 >= Meshes(i)%XS .And. PCX%X2 <= Meshes(i)%XF)) Then
                PCX%FED_MESH2 = i
                Exit PCX_MeshLoop2
             End If
          End If
       End Do PCX_MeshLoop2
       !   No mesh found
       If (PCX%FED_MESH2 == 0) PCX%FED_MESH2 = -1

       If (PCX%FED_MESH2 > 0) Then 
          M => MESHES(PCX%FED_MESH2)
          II = Floor( M%CELLSI(Floor((PCX%X2-M%XS)*M%RDXINT)) + 1.0_EB  )
          JJ = Floor( M%CELLSJ(Floor((PCX%Y2-M%YS)*M%RDYINT)) + 1.0_EB  )
          KK = Floor( M%CELLSK(Floor((PCX%Z2-M%ZS)*M%RDZINT)) + 1.0_EB  )
          If ( M%SOLID(M%CELL_INDEX(II,JJ,KK)) ) Then
             PCX%FED_MESH2 = -1   ! no smoke at a solid object
             PCX%II(2) = 0
             PCX%JJ(2) = 0
             PCX%KK(2) = 0
          Else
             PCX%II(2) = II
             PCX%JJ(2) = JJ
             PCX%KK(2) = KK
          End If
       Else
          PCX%II(2) = 0
          PCX%JJ(2) = 0
          PCX%KK(2) = 0
       End If

       ! 
       n_max_in_corrs = Max(n_max_in_corrs,PCX%MAX_HUMANS_INSIDE)

       ! Initialize the linked lists of persons who are inside corridors.
       PCX%n_inside = 0
       Nullify(PCX%First)
       !
    End Do READ_CORR_LOOP
29  Rewind(LU_INPUT)


    ! Now exits, doors, and corrs are already read in
    If (n_nodes > 0 ) Then
       n_tmp = 0
       Do n = 1, nmeshes
          If (evacuation_only(n).And.evacuation_grid(n)) Then
             n_tmp = n_tmp + 1
             EVAC_Node_List(n_tmp)%Node_Index = n_tmp
             EVAC_Node_List(n_tmp)%Node_Type  = 'Floor'
             EVAC_Node_List(n_tmp)%ID_NAME    = MESH_NAME(n)
             EVAC_Node_List(n_tmp)%GRID_NAME  = MESH_NAME(n)
             EVAC_Node_List(n_tmp)%Mesh_index = n
          End If
       End Do
       Do n = 1, n_entrys
          n_tmp = n_tmp + 1
          evac_entrys(n)%INODE             = n_tmp 
          EVAC_Node_List(n_tmp)%Node_Index = n
          EVAC_Node_List(n_tmp)%Node_Type  = 'Entry'
       End Do
       Do n = 1, n_doors
          n_tmp = n_tmp + 1
          evac_doors(n)%INODE              = n_tmp 
          EVAC_Node_List(n_tmp)%Node_Index = n
          EVAC_Node_List(n_tmp)%Node_Type  = 'Door'
          EVAC_Node_List(n_tmp)%ID_NAME    = EVAC_DOORS(n)%ID_NAME
          EVAC_Node_List(n_tmp)%Mesh_Index = EVAC_DOORS(n)%IMESH
       End Do
       Do n = 1, n_exits
          n_tmp = n_tmp + 1
          evac_exits(n)%INODE              = n_tmp 
          EVAC_Node_List(n_tmp)%Node_Index = n
          EVAC_Node_List(n_tmp)%Node_Type  = 'Exit'
          EVAC_Node_List(n_tmp)%ID_NAME    = EVAC_EXITS(n)%ID_NAME
          EVAC_Node_List(n_tmp)%Mesh_Index = EVAC_EXITS(n)%IMESH
       End Do
       Do n = 1, n_corrs
          n_tmp = n_tmp + 1
          evac_corrs(n)%INODE              = n_tmp 
          EVAC_Node_List(n_tmp)%Node_Index = n
          EVAC_Node_List(n_tmp)%Node_Type  = 'Corr'
          EVAC_Node_List(n_tmp)%ID_NAME    = EVAC_CORRS(n)%ID_NAME
       End Do
    End If

    !
    ! Read the ENTR lines
    !
    READ_ENTR_LOOP: Do N = 1, N_ENTRYS
       PNX=>EVAC_ENTRYS(N)
       !
       ID            = 'null'
       XB            = 0.0_EB
       IOR           = 0
       FLOW_FIELD_ID = 'null'
       EVAC_MESH     = 'null'
       TO_NODE       = 'null'
       PERS_ID       = 'null'
       QUANTITY      = 'null'
       MAX_FLOW      = 0.0_EB
       WIDTH         = 0.0_EB
       AFTER_REACTION_TIME      = .False.
       T_START                  = -99.0_EB
       T_STOP                   = -99.0_EB
       KNOWN_DOOR_NAMES         = 'null'
       KNOWN_DOOR_PROBS         = 1.0_EB
       !
       !
       Call CHECKREAD('ENTR',LU_INPUT,IOS)
       If (IOS == 1) Exit READ_ENTR_LOOP
       Read(LU_INPUT,ENTR,End=28,IOSTAT=IOS)

       If (Trim(KNOWN_DOOR_NAMES(51)) /= 'null') Then
          Write(MESSAGE,'(A,A,A)') &
               'ERROR: EVAC line ',Trim(HPT%ID_NAME), &
               ' problem with KNOWN_DOOR_NAMES'
          Call SHUTDOWN(MESSAGE)
       End If
       If (Trim(KNOWN_DOOR_NAMES(1)) == 'null') Then
          i = 0 ! no doors given
       Else
          i = 50 ! known door names given
          Do While ( Trim(KNOWN_DOOR_NAMES(i)) == 'null' .And. &
               i > 0)
             i = i-1
          End Do
       End If
       PNX%N_VENT_FFIELDS = i
       Allocate(PNX%I_DOOR_NODES(0:i),STAT=IZERO)
       Call ChkMemErr('Read_Evac','PNX%I_DOOR_NODES',IZERO) 
       Allocate(PNX%I_VENT_FFIELDS(0:i),STAT=IZERO)
       Call ChkMemErr('Read_Evac','PNX%I_VENT_FFIELDS',IZERO) 
       Allocate(PNX%P_VENT_FFIELDS(0:i),STAT=IZERO)
       Call ChkMemErr('Read_Evac','PNX%P_VENT_FFIELDS',IZERO) 
       !
       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
       !
       PNX%X1 = XB(1)
       PNX%X2 = XB(2)
       PNX%Y1 = XB(3)
       PNX%Y2 = XB(4)
       PNX%Z1 = XB(5)
       PNX%Z2 = XB(6)
       PNX%IOR = IOR
       ! 
       PNX%COLOR_INDEX = 0
       If (QUANTITY == 'BLACK')    PNX%COLOR_INDEX = 0
       If (QUANTITY == 'YELLOW')   PNX%COLOR_INDEX = 1
       If (QUANTITY == 'BLUE')     PNX%COLOR_INDEX = 2
       If (QUANTITY == 'RED')      PNX%COLOR_INDEX = 3
       If (QUANTITY == 'GREEN')    PNX%COLOR_INDEX = 4
       If (QUANTITY == 'MAGENTA')  PNX%COLOR_INDEX = 5
       If (QUANTITY == 'CYAN')     PNX%COLOR_INDEX = 6
       If (QUANTITY == 'WHITE')    PNX%COLOR_INDEX = 7
       ! 
       PNX%ID_NAME    = ID
       PNX%CLASS_NAME = PERS_ID

       PNX%IPC = 0
       Do ipc= 1, npc_pers
          pcp => evac_person_classes(ipc)
          If ( pcp%id_name == PERS_ID ) PNX%IPC = IPC
       End Do
       PNX%TO_NODE    = TO_NODE
       PNX%T_first    = 0.0_EB
       PNX%T_last     = 0.0_EB
       PNX%ICOUNT     = 0
       PNX%Flow       = MAX_FLOW

       Select Case (IOR)
       Case (-1,+1)
          If (WIDTH <= 0.0_EB) Then
             PNX%Width = XB(4) - XB(3)
          Else
             PNX%Width = WIDTH
          End If
       Case (-2,+2)
          If (WIDTH <= 0.0_EB) Then
             PNX%Width = XB(2) - XB(1)
          Else
             PNX%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: ENTR',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: ENTR',N,' no IOR but not 3-dim object'
             Call SHUTDOWN(MESSAGE)
          End If
       Case Default
          Write(MESSAGE,'(A,I4,A)') &
               'ERROR: ENTR',N,' problem with IOR'
          Call SHUTDOWN(MESSAGE)
       End Select
       ! 
       ! Check which evacuation floor
       ii = 0
       n_tmp = 0
       PNX_MeshLoop: Do i = 1, nmeshes
          If (evacuation_only(i) .And. evacuation_grid(i)) Then
             n_tmp = n_tmp + 1
             If ( (PNX%Z1 >= Meshes(i)%ZS .And. PNX%Z2 <= Meshes(i)%ZF).And. &
                  (PNX%Y1 >= Meshes(i)%YS .And. PNX%Y2 <= Meshes(i)%YF).And. &
                  (PNX%X1 >= Meshes(i)%XS .And. PNX%X2 <= Meshes(i)%XF)) Then
                If (Trim(EVAC_MESH) == 'null' .Or. &
                     Trim(EVAC_MESH) == Trim(MESH_NAME(i))) Then
                   ii = ii + 1
                   PNX%IMESH = i
                   PNX%TO_INODE = n_tmp
                   PNX%TO_NODE  = MESH_NAME(i)
                End If
             End If
          End If
       End Do PNX_MeshLoop
       If (PNX%IMESH == 0) Then
          Write(MESSAGE,'(A,A,A)') &
               'ERROR: ENTR line ',Trim(PNX%ID_NAME), &
               ' problem with IMESH, no mesh found'
          Call SHUTDOWN(MESSAGE)
       End If
       If (ii > 1) Then
          Write(MESSAGE,'(A,A,A)') &
               'ERROR: ENTR line ',Trim(PNX%ID_NAME), &
               ' not an unique mesh found '
          Call SHUTDOWN(MESSAGE)
       End If

       ! Use the main_evac_grid flow field if none is given
       If (Trim(FLOW_FIELD_ID) == 'null') Then
          PNX%GRID_NAME  = Trim(PNX%TO_NODE)
       Else
          PNX%GRID_NAME  = FLOW_FIELD_ID
       End If

       Do i = 1, PNX%N_VENT_FFIELDS
          PNX%P_VENT_FFIELDS(i) = KNOWN_DOOR_PROBS(i)
          PNX%I_VENT_FFIELDS(i) = 0
          PNX%I_DOOR_NODES(i) = 0
          Do j = 1, n_exits
             If ( Trim(EVAC_EXITS(j)%ID_NAME) == &
                  Trim(KNOWN_DOOR_NAMES(i)) ) Then
                PNX%I_VENT_FFIELDS(i) = EVAC_EXITS(j)%I_VENT_FFIELD
                PNX%I_DOOR_NODES(i)   = EVAC_EXITS(j)%INODE
             End If
          End Do
          Do j = 1, n_doors
             If ( Trim(EVAC_DOORS(j)%ID_NAME) == &
                  Trim(KNOWN_DOOR_NAMES(i)) ) Then
                PNX%I_VENT_FFIELDS(i) = EVAC_DOORS(j)%I_VENT_FFIELD
                PNX%I_DOOR_NODES(i)   = EVAC_DOORS(j)%INODE
             End If
          End Do
          If ( PNX%I_VENT_FFIELDS(i)*PNX%I_DOOR_NODES(i) == 0 ) Then
             Write(MESSAGE,'(A,A,A,A,A)') &
                  'ERROR: ENTR line ',Trim(PNX%ID_NAME), &
                  ' problem with door/exit names, ', &
                  Trim(KNOWN_DOOR_NAMES(i)),' not found'
             Call SHUTDOWN(MESSAGE)
          End If
       End Do
       !
       ! No known doors given, use the flow_field_id value
       ! 
       PNX%P_VENT_FFIELDS(0) = 1.0_EB
       PNX%I_VENT_FFIELDS(0) = 0
       PNX%I_DOOR_NODES(0) = 0
       PNX_Mesh2Loop: Do i = 1, nmeshes
          If ( evacuation_only(i) .And. Trim(PNX%GRID_NAME) == &
               Trim(MESH_NAME(i)) ) Then
             PNX%I_VENT_FFIELDS(0) = i
             Exit PNX_Mesh2Loop
          End If
       End Do PNX_Mesh2Loop
       If ( PNX%I_VENT_FFIELDS(0) == 0 ) Then
          Write(MESSAGE,'(A,A,A,A,A)') &
               'ERROR: ENTR line ',Trim(PNX%ID_NAME), &
               ' problem with flow field name, ', &
               Trim(PNX%GRID_NAME),' not found'
          Call SHUTDOWN(MESSAGE)
       End If
       !
       ! 
    End Do READ_ENTR_LOOP
28  Rewind(LU_INPUT)

    If (n_nodes > 0 ) Then
       n_tmp = n_egrids
       Do n = 1, n_entrys