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_LOOP24  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