evac.f90

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

                DIA_LOW  = 0.50_EB
                DIA_HIGH = 0.58_EB
                D_TORSO_MEAN    = 0.32_EB
                D_SHOULDER_MEAN = 0.20_EB
             End If
             If (TAU_EVAC_DIST < 0) Then
                TAU_EVAC_DIST = 1
                TAU_MEAN = 1.00_EB
                TAU_PARA = 0.10_EB
                TAU_LOW  = 0.80_EB
                TAU_HIGH = 1.20_EB
             End If
          Case ('Female','female','FEMALE')
             If (VELOCITY_DIST < 0) Then
                VELOCITY_DIST = 1
                VEL_MEAN = 1.15_EB
                VEL_PARA = 0.20_EB
                VEL_LOW  = 0.95_EB
                VEL_HIGH = 1.35_EB
             End If
             If (DIAMETER_DIST < 0) Then
                DIAMETER_DIST = 1
                DIA_MEAN = 0.48_EB
                DIA_PARA = 0.04_EB
                DIA_LOW  = 0.44_EB
                DIA_HIGH = 0.52_EB
                D_TORSO_MEAN    = 0.28_EB
                D_SHOULDER_MEAN = 0.18_EB
             End If
             If (TAU_EVAC_DIST < 0) Then
                TAU_EVAC_DIST = 1
                TAU_MEAN = 1.00_EB
                TAU_PARA = 0.10_EB
                TAU_LOW  = 0.80_EB
                TAU_HIGH = 1.20_EB
             End If
          Case ('Child','child','CHILD')
             If (VELOCITY_DIST < 0) Then
                VELOCITY_DIST = 1
                VEL_MEAN = 0.90_EB
                VEL_PARA = 0.30_EB
                VEL_LOW  = 0.60_EB
                VEL_HIGH = 1.20_EB
             End If
             If (DIAMETER_DIST < 0) Then
                DIAMETER_DIST = 1
                DIA_MEAN = 0.42_EB
                DIA_PARA = 0.03_EB
                DIA_LOW  = 0.39_EB
                DIA_HIGH = 0.45_EB
                D_TORSO_MEAN    = 0.24_EB
                D_SHOULDER_MEAN = 0.14_EB
             End If
             If (TAU_EVAC_DIST < 0) Then
                TAU_EVAC_DIST = 1
                TAU_MEAN = 1.00_EB
                TAU_PARA = 0.10_EB
                TAU_LOW  = 0.80_EB
                TAU_HIGH = 1.20_EB
             End If
          Case ('Elderly','elderly','ELDERLY')
             If (VELOCITY_DIST < 0) Then
                VELOCITY_DIST = 1
                VEL_MEAN = 0.80_EB
                VEL_PARA = 0.30_EB
                VEL_LOW  = 0.50_EB
                VEL_HIGH = 1.10_EB
             End If
             If (DIAMETER_DIST < 0) Then
                DIAMETER_DIST = 1
                DIA_MEAN = 0.50_EB
                DIA_PARA = 0.04_EB
                DIA_LOW  = 0.46_EB
                DIA_HIGH = 0.54_EB
                D_TORSO_MEAN    = 0.30_EB
                D_SHOULDER_MEAN = 0.18_EB
             End If
             If (TAU_EVAC_DIST < 0) Then
                TAU_EVAC_DIST = 1
                TAU_MEAN = 1.00_EB
                TAU_PARA = 0.10_EB
                TAU_LOW  = 0.80_EB
                TAU_HIGH = 1.20_EB
             End If
          Case ('null')
             ! Do nothing, use the defaults
          Case Default
             Write(MESSAGE,'(A,I4,A)') &
                  'ERROR: PERS',N,' problem with DEFAULT_PROPERTIES'
             Call SHUTDOWN(MESSAGE)
          End Select

       End If

       DIAMETER_DIST = Max(0,DIAMETER_DIST)
       VELOCITY_DIST = Max(0,VELOCITY_DIST)
       TAU_EVAC_DIST = Max(0,TAU_EVAC_DIST)
       !
       !
       ! 
       PCP%ID_NAME = ID
       !
       PCP%D_mean = DIA_MEAN
       PCP%I_DIA_DIST  = DIAMETER_DIST
       PCP%D_low  = DIA_LOW
       PCP%D_high = DIA_HIGH
       PCP%D_para = DIA_PARA
       PCP%D_para2 = DIA_PARA2
       !
       PCP%V_mean = VEL_MEAN
       PCP%I_VEL_DIST  = VELOCITY_DIST
       PCP%V_low  = VEL_LOW
       PCP%V_high = VEL_HIGH
       PCP%V_para = VEL_PARA
       PCP%V_para2 = VEL_PARA2
       !
       PCP%Tau_mean = TAU_MEAN
       PCP%I_TAU_DIST  = TAU_EVAC_DIST
       PCP%Tau_low  = TAU_LOW
       PCP%Tau_high = TAU_HIGH
       PCP%Tau_para = TAU_PARA
       PCP%Tau_para2 = TAU_PARA2
       ! 
       PCP%Tpre_mean  = PRE_MEAN
       PCP%I_PRE_DIST = PRE_EVAC_DIST
       PCP%Tpre_low   = PRE_LOW
       PCP%Tpre_high  = PRE_HIGH
       PCP%Tpre_para  = PRE_PARA
       PCP%Tpre_para2  = PRE_PARA2
       ! 
       PCP%Tdet_mean  = DET_MEAN
       PCP%I_DET_DIST = DET_EVAC_DIST
       PCP%Tdet_low   = DET_LOW
       PCP%Tdet_high  = DET_HIGH
       PCP%Tdet_para  = DET_PARA
       PCP%Tdet_para2  = DET_PARA2
       !
       PCP%A       = FCONST_A
       PCP%B       = FCONST_B
       PCP%Lambda  = L_NON_SP
       PCP%C_Young = C_YOUNG
       PCP%Gamma   = GAMMA
       PCP%Kappa   = KAPPA
       !
       PCP%r_torso    = 0.5_EB*D_TORSO_MEAN
       PCP%r_shoulder = 0.5_EB*D_SHOULDER_MEAN
       PCP%Tau_iner   = TAU_ROT  ! s
       If (M_INERTIA < 0.0_EB ) Then
          PCP%m_iner = -M_INERTIA*(0.25_EB*PCP%D_mean**2+PCP%r_torso**2)**2 / &
               (0.27_EB**2+0.16_EB**2)**2
       Else
          PCP%m_iner = M_INERTIA  ! kg m2
       End If
       !
    End Do READ_PERS_LOOP
24  Rewind(LU_INPUT)

    If (GROUP_DENS .Le. 0.01_EB) GROUP_DENS = 0.25_EB
    If (GROUP_DENS .Gt. 3.50_EB) GROUP_DENS = 3.50_EB
    DENS_INIT = Max(GROUP_DENS,DENS_INIT)
    If (TDET_SMOKE_DENS < 0.0_EB) TDET_SMOKE_DENS = Huge(TDET_SMOKE_DENS)

    If (.Not. NOT_RANDOM ) Then    ! Initialize the generator randomly
       Call Random_Seed(size=size_rnd)
       Allocate(seed_rnd(size_rnd),STAT=IZERO)
       Call ChkMemErr('READ_EVAC','seed_rnd',IZERO)
       Call Date_and_Time(values = t_rnd)
       seed_rnd = 100.0_EB*t_rnd(7) + t_rnd(8)/10.0_EB
       Call Random_Seed(put=seed_rnd)
       Deallocate(seed_rnd)
    End If

    ! Add the number of the evacuation classes
    Select Case (COLOR_METHOD)
    Case (0:6,8)
       N_EVAC = 7
    Case (7)
       N_EVAC = 3
    Case Default
       N_EVAC = 3
    End Select

    Allocate(EVAC_CLASS_NAME(N_EVAC),STAT=IZERO)
    Call ChkMemErr('READ_EVAC','EVAC_CLASS_NAME',IZERO)
    Allocate(EVAC_CLASS_RGB(3,N_EVAC),STAT=IZERO)
    Call ChkMemErr('READ_EVAC','EVAC_CLASS_RGB',IZERO)

    Select Case (COLOR_METHOD)
    Case (0:6,8)
       EVAC_CLASS_NAME(1) = 'HumanBlk'
       EVAC_CLASS_NAME(2) = 'HumanYel'
       EVAC_CLASS_NAME(3) = 'HumanBlu'
       EVAC_CLASS_NAME(4) = 'HumanRed'
       EVAC_CLASS_NAME(5) = 'HumanGre'
       EVAC_CLASS_NAME(6) = 'HumanMag'
       EVAC_CLASS_NAME(7) = 'HumanCya'
       EVAC_CLASS_RGB(1:3,1) = (/  0,  0,  0/)  ! black
       EVAC_CLASS_RGB(1:3,2) = (/255,255,  0/)  ! yellow
       EVAC_CLASS_RGB(1:3,3) = (/  0,  0,255/)  ! blue
       EVAC_CLASS_RGB(1:3,4) = (/255,  0,  0/)  ! red
       EVAC_CLASS_RGB(1:3,5) = (/  0,255,  0/)  ! green
       EVAC_CLASS_RGB(1:3,6) = (/255,  0,255/)  ! magenta
       EVAC_CLASS_RGB(1:3,7) = (/  0,255,255/)  ! cyan
    Case (7)
       EVAC_CLASS_NAME(1) = 'HumanR'
       EVAC_CLASS_NAME(2) = 'HumanL'
       EVAC_CLASS_NAME(3) = 'HumanC'
       EVAC_CLASS_RGB(1:3,1) = (/  0,255,  0/)  ! green
       EVAC_CLASS_RGB(1:3,2) = (/255,  0,  0/)  ! red
       EVAC_CLASS_RGB(1:3,3) = (/  0,  0,  0/)  ! black
    End Select
    !
    ! Read the EXIT lines
    !
    READ_EXIT_LOOP: Do N = 1, N_EXITS
       PEX=>EVAC_EXITS(N)
       !
       ID            = 'null'
       XB            = 0.0_EB
       IOR           = 0
       FLOW_FIELD_ID = 'null'
       VENT_FFIELD   = 'null'
       EVAC_MESH     = 'null'
       CHECK_FLOW    = .False.
       COUNT_ONLY    = .False.
       MAX_FLOW      = 0.0_EB
       WIDTH         = 0.0_EB
       XYZ(:)        = Huge(XYZ)
       XYZ_SMOKE(:)  = Huge(XYZ_SMOKE)
       COLOR_INDEX   = 0
       !
       Call CHECKREAD('EXIT',LU_INPUT,IOS)
       If (IOS == 1) Exit READ_EXIT_LOOP
       Read(LU_INPUT,Exit,End=26,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
       !
       PEX%X1 = XB(1)
       PEX%X2 = XB(2)
       PEX%Y1 = XB(3)
       PEX%Y2 = XB(4)
       PEX%Z1 = XB(5)
       PEX%Z2 = XB(6)
       PEX%IOR = IOR
       PEX%ID_NAME    = Trim(ID)
       PEX%GRID_NAME  = Trim(FLOW_FIELD_ID)
       PEX%CHECK_FLOW = CHECK_FLOW
       PEX%VENT_FFIELD= VENT_FFIELD
       PEX%INODE      = 0
       PEX%T_first    = 0.0_EB
       PEX%T_last     = 0.0_EB
       PEX%ICOUNT     = 0
       PEX%Flow_max   = 0.0_EB
       If (CHECK_FLOW) PEX%Flow_max   = MAX_FLOW
       PEX%COUNT_ONLY = .False.
       If (COUNT_ONLY) PEX%COUNT_ONLY = .True.

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

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

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

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