evac.f90

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

         VEL_MEAN,VEL_PARA,VEL_PARA2,VEL_LOW,VEL_HIGH, &
         DIA_MEAN,DIA_PARA,DIA_PARA2,DIA_LOW,DIA_HIGH, &
         PRE_MEAN,PRE_PARA,PRE_PARA2,PRE_LOW,PRE_HIGH, &
         DET_MEAN,DET_PARA,DET_PARA2,DET_LOW,DET_HIGH, &
         TAU_MEAN,TAU_PARA,TAU_PARA2,TAU_LOW,TAU_HIGH, &
         FCONST_A,FCONST_B,L_NON_SP, &
         C_YOUNG,GAMMA,KAPPA, GROUP_DENS, &
         FAC_A_WALL, FAC_B_WALL, LAMBDA_WALL, &
         NOISEME, NOISETH, NOISECM, &
         I_FRIC_SW, GROUP_EFF, RADIUS_COMPLETE_0, &
         RADIUS_COMPLETE_1, DEFAULT_PROPERTIES, &
         NOT_RANDOM, FED_DOOR_CRIT, COLOR_METHOD, &
         TDET_SMOKE_DENS, DENS_INIT, EVAC_DT_MAX, EVAC_DT_MIN, &
         D_TORSO_MEAN, D_SHOULDER_MEAN, TAU_ROT, M_INERTIA, &
         FC_DAMPING, V_MAX, V_ANGULAR_MAX, V_ANGULAR
    !
    NPPS = 30000 ! Number Persons Per Set (dump to a file)
    !
    EVAC_DT = EVAC_DT_FLOWFIELD     ! Initialize the clock
    EVAC_CLOCK = 0.0_EB    ! clock for the CHID_evac.csv file

    EVAC_N_QUANTITIES = 0

    i33 = 0
    ilh = 0

    Allocate(Tsteps(NMESHES),STAT=IZERO)
    Call ChkMemErr('READ','Tsteps',IZERO) 
    Tsteps(:) = EVAC_DT_FLOWFIELD

    !
    ! I_EVAC: 'binary' index:
    ! These are just initialization. Later it is checked if files
    ! exists. If EFF/FED file does not exists, then it is calculated 
    ! (and saved).
    I_EVAC = 16*0 + 8*0 + 4*0 + 2*0 + 1*0 ! do not save soot,fed files
    If (.Not. All(EVACUATION_ONLY) ) Then
       ! There are fire grids ==> save fed and evac flow fields
       I_EVAC = 16*1 + 8*0 + 4*0 + 2*1 + 1*1
    Else
       ! There are no fire grids ==> try to read fed and evac flow fields
       I_EVAC = 16*0 + 8*1 + 4*1 + 2*0 + 1*0
    End If
    !
    ! Every human has an identification number, ILABEL_last is
    ! the last used number, so next human will have an
    ! identification number, which is ILABEL_last + 1
    ILABEL_last = 0
    !
    !
    ! Determine total number of EVAC lines in the input file
    !
    Open(LU_INPUT,File=FN_INPUT)

    NPC_EVAC = 0
    COUNT_EVAC_LOOP: Do
       Call CHECKREAD('EVAC',LU_INPUT,IOS) 
       If (IOS == 1) Exit COUNT_EVAC_LOOP
       Read(LU_INPUT,NML=EVAC,End=219,ERR=220,IOSTAT=IOS)
       NPC_EVAC = NPC_EVAC + 1
220    If (IOS > 0) Call SHUTDOWN('ERROR: Problem with EVAC line')
    End Do COUNT_EVAC_LOOP
219 Rewind(LU_INPUT)
    !
    ! Determine total number of PERS lines in the input file
    !
    NPC_PERS = 0
    COUNT_PERS_LOOP: Do
       Call CHECKREAD('PERS',LU_INPUT,IOS) 
       If (IOS == 1) Exit COUNT_PERS_LOOP
       Read(LU_INPUT,NML=PERS,End=221,ERR=222,IOSTAT=IOS)
       NPC_PERS = NPC_PERS + 1
222    If (IOS > 0) Call SHUTDOWN('ERROR: Problem with PERS line')
    End Do COUNT_PERS_LOOP
221 Rewind(LU_INPUT)
    !
    ! Determine total number of EXIT lines in the input file
    !
    N_EXITS = 0
    COUNT_EXITS_LOOP: Do
       Call CHECKREAD('EXIT',LU_INPUT,IOS) 
       If (IOS == 1) Exit COUNT_EXITS_LOOP
       Read(LU_INPUT,NML=Exit,End=223,ERR=224,IOSTAT=IOS)
       N_EXITS = N_EXITS + 1
224    If (IOS > 0) Call SHUTDOWN('ERROR: Problem with EXIT line')
    End Do COUNT_EXITS_LOOP
223 Rewind(LU_INPUT)
    !
    ! Determine total number of DOOR lines in the input file
    !
    N_DOORS = 0
    COUNT_DOORS_LOOP: Do
       Call CHECKREAD('DOOR',LU_INPUT,IOS) 
       If (IOS == 1) Exit COUNT_DOORS_LOOP
       Read(LU_INPUT,NML=DOOR,End=225,ERR=226,IOSTAT=IOS)
       N_DOORS = N_DOORS + 1
226    If (IOS > 0) Call SHUTDOWN('ERROR: Problem with DOOR line')
    End Do COUNT_DOORS_LOOP
225 Rewind(LU_INPUT)
    !
    ! Determine total number of ENTR lines in the input file
    !
    N_ENTRYS = 0
    COUNT_ENTRYS_LOOP: Do
       Call CHECKREAD('ENTR',LU_INPUT,IOS) 
       If (IOS == 1) Exit COUNT_ENTRYS_LOOP
       Read(LU_INPUT,NML=ENTR,End=227,ERR=228,IOSTAT=IOS)
       N_ENTRYS = N_ENTRYS + 1
228    If (IOS > 0) Call SHUTDOWN('ERROR: Problem with ENTR line')
    End Do COUNT_ENTRYS_LOOP
227 Rewind(LU_INPUT)
    !
    ! Determine total number of CORR lines in the input file
    !
    N_CORRS = 0
    COUNT_CORRS_LOOP: Do
       Call CHECKREAD('CORR',LU_INPUT,IOS) 
       If (IOS == 1) Exit COUNT_CORRS_LOOP
       Read(LU_INPUT,NML=CORR,End=229,ERR=230,IOSTAT=IOS)
       N_CORRS = N_CORRS + 1
230    If (IOS > 0) Call SHUTDOWN('ERROR: Problem with CORR line')
    End Do COUNT_CORRS_LOOP
229 Rewind(LU_INPUT)
    !
    ! Determine total number of EVHO lines in the input file
    !
    N_HOLES = 0
    COUNT_EVHO_LOOP: Do
       Call CHECKREAD('EVHO',LU_INPUT,IOS) 
       If (IOS == 1) Exit COUNT_EVHO_LOOP
       Read(LU_INPUT,NML=EVHO,End=231,ERR=232,IOSTAT=IOS)
       N_HOLES = N_HOLES + 1
232    If (IOS > 0) Call SHUTDOWN('ERROR: Problem with EVHO line')
    End Do COUNT_EVHO_LOOP
231 Rewind(LU_INPUT)
    !
    ! Determine total number of EVSS lines in the input file
    !
    N_SSTANDS = 0
    COUNT_EVSS_LOOP: Do
       Call CHECKREAD('EVSS',LU_INPUT,IOS) 
       If (IOS == 1) Exit COUNT_EVSS_LOOP
       Read(LU_INPUT,NML=EVSS,End=233,ERR=234,IOSTAT=IOS)
       N_SSTANDS = N_SSTANDS + 1
234    If (IOS > 0) Call SHUTDOWN('ERROR: Problem with EVSS line')
    End Do COUNT_EVSS_LOOP
233 Rewind(LU_INPUT)
    !
    ! Allocate quantities for EVAC, PERS, EXIT types
    !
    If (npc_evac > 0 ) Then
       Allocate(EVACUATION(NPC_EVAC),STAT=IZERO)
       Call ChkMemErr('READ','EVACUATION',IZERO) 
    End If

    If (n_holes > 0 ) Then
       Allocate(EVAC_HOLES(N_HOLES),STAT=IZERO)
       Call ChkMemErr('READ','EVAC_HOLES',IZERO) 
    End If

    If (n_sstands > 0 ) Then
       Allocate(EVAC_SSTANDS(N_SSTANDS),STAT=IZERO)
       Call ChkMemErr('READ','EVAC_SSTANDS',IZERO) 
    End If

    If (n_exits > 0 ) Then
       Allocate(EVAC_EXITS(N_EXITS),STAT=IZERO)
       Call ChkMemErr('READ','EVAC_EXITS',IZERO) 
    End If

    If (n_doors > 0 ) Then
       Allocate(EVAC_DOORS(N_DOORS),STAT=IZERO)
       Call ChkMemErr('READ','EVAC_DOORS',IZERO) 
    End If

    If (n_entrys > 0 ) Then
       Allocate(EVAC_ENTRYS(N_ENTRYS),STAT=IZERO)
       Call ChkMemErr('READ','EVAC_ENTRYS',IZERO) 
    End If

    If (n_corrs > 0 ) Then
       Allocate(EVAC_CORRS(N_CORRS),STAT=IZERO)
       Call ChkMemErr('READ','EVAC_CORRS',IZERO) 
    End If

    Allocate(EVAC_PERSON_CLASSES(0:NPC_PERS),STAT=IZERO)
    Call ChkMemErr('READ','EVAC_PERSON_CLASSES',IZERO) 

    n_egrids = 0
    Do n = 1, nmeshes
       If (evacuation_only(n) .And. evacuation_grid(n) ) Then
          n_egrids = n_egrids + 1
       End If
    End  Do

    n_nodes = n_entrys + n_exits + n_doors + n_corrs + n_egrids
    If (n_nodes > 0 ) Then
       Allocate(EVAC_Node_List(1:n_nodes),STAT=IZERO)
       Call ChkMemErr('READ','EVAC_NODE_LIST',IZERO) 
    End If

    If (npc_evac > 0 ) Then
       EVACUATION(1:NPC_EVAC)%COLOR_INDEX = 0
       EVACUATION(1:NPC_EVAC)%GRID_NAME   = 'null'
       EVACUATION(1:NPC_EVAC)%CLASS_NAME  = 'null'
       EVACUATION(1:NPC_EVAC)%IMESH       = 0
       EVACUATION(1:NPC_EVAC)%ID_NAME     = 'null'
    End If
    If (n_holes > 0 ) Then
       EVAC_HOLES(1:N_HOLES)%GRID_NAME   = 'null'
       EVAC_HOLES(1:N_HOLES)%PERS_ID     = 'null'
       EVAC_HOLES(1:N_HOLES)%EVAC_ID     = 'null'
       EVAC_HOLES(1:N_HOLES)%IMESH       = 0
       EVAC_HOLES(1:N_HOLES)%ID_NAME     = 'null'
    End If

    EVAC_PERSON_CLASSES(0:NPC_PERS)%ID_NAME = 'null'

    If (n_exits > 0 ) Then
       EVAC_EXITS(1:N_EXITS)%ID_NAME   = 'null'
       EVAC_EXITS(1:N_EXITS)%TO_NODE   = 'null'
       EVAC_EXITS(1:N_EXITS)%GRID_NAME = 'null'
       EVAC_EXITS(1:N_EXITS)%IMESH     = 0
       EVAC_EXITS(1:N_EXITS)%COLOR_INDEX = 0
    End If

    If (n_doors > 0 ) Then
       EVAC_DOORS(1:N_DOORS)%ID_NAME   = 'null'
       EVAC_DOORS(1:N_DOORS)%TO_NODE   = 'null'
       EVAC_DOORS(1:N_DOORS)%GRID_NAME = 'null'
       EVAC_DOORS(1:N_DOORS)%IMESH     = 0
       EVAC_DOORS(1:N_DOORS)%IMESH2    = 0
       EVAC_DOORS(1:N_DOORS)%COLOR_INDEX = 0
    End If

    If (n_corrs > 0 ) Then
       EVAC_CORRS(1:N_CORRS)%ID_NAME   = 'null'
       EVAC_CORRS(1:N_CORRS)%TO_NODE   = 'null'
       EVAC_CORRS(1:N_CORRS)%GRID_NAME = 'null'
       EVAC_CORRS(1:N_CORRS)%IMESH     = 0
       EVAC_CORRS(1:N_CORRS)%IMESH2    = 0
    End If

    If (n_entrys > 0 ) Then
       EVAC_ENTRYS(1:N_ENTRYS)%ID_NAME     = 'null'
       EVAC_ENTRYS(1:N_ENTRYS)%TO_NODE     = 'null'
       EVAC_ENTRYS(1:N_ENTRYS)%GRID_NAME   = 'null'
       EVAC_ENTRYS(1:N_ENTRYS)%CLASS_NAME  = 'null'
       EVAC_ENTRYS(1:N_ENTRYS)%IMESH       = 0
       EVAC_ENTRYS(1:N_ENTRYS)%COLOR_INDEX = 0
    End If

    !
    ! NEXT PARAMETERS ARE SAME FOR ALL HUMANS. THE LAST
    ! VALUES READ IN FROM 'PERS' LINES ARE VALID.
    FAC_A_WALL  = 1.0_EB
    FAC_B_WALL  = 0.5_EB
    LAMBDA_WALL = 0.2_EB
    NOISEME     = 0.0_EB
    NOISETH     = 0.01_EB
    NOISECM     = 3.0_EB
    I_FRIC_SW   = 1
    FC_DAMPING    = 500.0_EB
    V_MAX         = 20.0_EB
    V_ANGULAR_MAX = 8.0_EB  ! rps
    V_ANGULAR     = 2.0_EB  ! rps
    GROUP_EFF     = 0.0_EB
    RADIUS_COMPLETE_0 = 0.2_EB
    RADIUS_COMPLETE_1 = 0.5_EB
    NOT_RANDOM = .False.
    ! Which doors are 'smoke free'
    FED_DOOR_CRIT = 0.000001_EB
    ! How to color humans?
    COLOR_METHOD = 0 ! Default is the evac-line value
    ! Smoke is detected, when its density is larger than, e.g. 1 mg/m3
    ! Default is no detection due to smoke.
    TDET_SMOKE_DENS = -999.9_EB  ! 
    DENS_INIT = 0.0_EB
    EVAC_DT_MAX  = 0.01_EB
    EVAC_DT_MIN  = 0.001_EB
    GROUP_DENS = 0.0_EB
    ! 
    ! Read the PERS lines (no read for default n=0 case)
    !
    READ_PERS_LOOP: Do N=0,NPC_PERS
       PCP=>EVAC_PERSON_CLASSES(N)
       !
       ID  = 'null'
       ! Default: No distributions for human properties
       DEFAULT_PROPERTIES = 'null'
       DIAMETER_DIST = -1
       VELOCITY_DIST = -1
       TAU_EVAC_DIST = -1
       PRE_EVAC_DIST = 0
       DET_EVAC_DIST = 0
       VEL_PARA = 0.0_EB
       DIA_PARA = 0.0_EB
       PRE_PARA = 0.0_EB
       DET_PARA = 0.0_EB
       TAU_PARA = 0.0_EB
       VEL_PARA2 = 0.0_EB
       DIA_PARA2 = 0.0_EB
       PRE_PARA2 = 0.0_EB
       DET_PARA2 = 0.0_EB
       TAU_PARA2 = 0.0_EB
       VEL_LOW = 0.0_EB
       DIA_LOW = 0.0_EB
       PRE_LOW = 0.0_EB
       DET_LOW = 0.0_EB
       TAU_LOW = 0.0_EB
       VEL_HIGH = 999.0_EB
       DIA_HIGH = 999.0_EB
       PRE_HIGH = Huge(PRE_HIGH)
       DET_HIGH = Huge(PRE_HIGH)
       TAU_HIGH = 999.0_EB
       ! Default values for persons
       VEL_MEAN = 1.25_EB
       DIA_MEAN = 0.51_EB
       PRE_MEAN = 10.0_EB
       DET_MEAN = 0.0_EB
       TAU_MEAN = 1.0_EB
       FCONST_A = 2000.0_EB
       FCONST_B = 0.08_EB
       L_NON_SP = 0.5_EB
       C_YOUNG  = 120000.0_EB
       GAMMA    = 16000.0_EB
       KAPPA    = 40000.0_EB
       ! Rotational freedom constants
       D_TORSO_MEAN = 0.30_EB
       D_SHOULDER_MEAN = 0.19_EB
       TAU_ROT   = 0.2_EB
       M_INERTIA = -4.0_EB
       !
       ! No read for default values
       If ( N > 0 ) Then
          Call CHECKREAD('PERS',LU_INPUT,IOS)
          If (IOS == 1) Exit READ_PERS_LOOP
          Read(LU_INPUT,PERS,End=24,IOSTAT=IOS)

          ! Check if some default human group is given.
          Select Case (Trim(DEFAULT_PROPERTIES))
          Case ('Adult','adult','ADULT')
             If (VELOCITY_DIST < 0) Then
                VELOCITY_DIST = 1
                VEL_MEAN = 1.25_EB
                VEL_PARA = 0.30_EB
                VEL_LOW  = 0.95_EB
                VEL_HIGH = 1.55_EB
             End If
             If (DIAMETER_DIST < 0) Then
                DIAMETER_DIST = 1
                DIA_MEAN = 0.51_EB
                DIA_PARA = 0.07_EB
                DIA_LOW  = 0.44_EB
                DIA_HIGH = 0.58_EB
                D_TORSO_MEAN    = 0.30_EB
                D_SHOULDER_MEAN = 0.19_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 ('Male','male','MALE')
             If (VELOCITY_DIST < 0) Then
                VELOCITY_DIST = 1
                VEL_MEAN = 1.35_EB
                VEL_PARA = 0.20_EB
                VEL_LOW  = 1.15_EB
                VEL_HIGH = 1.55_EB
             End If
             If (DIAMETER_DIST < 0) Then
                DIAMETER_DIST = 1
                DIA_MEAN = 0.54_EB
                DIA_PARA = 0.04_EB