dump.f90

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

         DO I=1,N
            SEG=>SEGMENT(I)
            IF (XX==SEG%X1 .AND. XX==SEG%X2 .AND.Y1==SEG%Y1 .AND. YY==SEG%Y2 .AND.ZZ==SEG%Z1 .AND. ZZ==SEG%Z2) THEN
               Y1 = YY
               CYCLE YLOOP2
            ENDIF
         ENDDO
         IF (N+1>N_SEGMENTS_MAX) CALL RE_ALLOCATE_SEGMENTS
         N = N+1
         SEG=>SEGMENT(N)
         SEG%X1 = XX 
         SEG%X2 = XX
         SEG%Y1 = Y1 
         SEG%Y2 = YY
         SEG%Z1 = ZZ 
         SEG%Z2 = ZZ
         Y1 = YY
      ENDDO YLOOP2
   ENDDO ZLOOP2
ENDDO XLOOP2
 
ZLOOP3: DO NZ=1,2*NMESHES
   MZ => MESHES(INT((NZ+1)/2))
   IF (MOD(NZ,2)/=0) ZZ = MZ%ZS
   IF (MOD(NZ,2)==0) ZZ = MZ%ZF
   YLOOP3: DO NY=1,2*NMESHES
      MY => MESHES(INT((NY+1)/2))
      IF (MOD(NY,2)/=0) YY = MY%YS
      IF (MOD(NY,2)==0) YY = MY%YF
      IF ((ZZ<MY%ZS .OR. ZZ>MY%ZF) .OR.(YY<MZ%YS .OR. YY>MZ%YF)) CYCLE YLOOP3
      X1 = MAX(MZ%XS,MY%XS)
      X2 = MIN(MZ%XF,MY%XF)
      IF (X1>=X2) CYCLE YLOOP3
      XLOOP3: DO NX=1,NXL
         XX = XLEVEL(NX)
         IF (XX<=X1) CYCLE XLOOP3
         IF (XX>X2) CYCLE YLOOP3
         XA = (X1+XX)/2._EB
         NIN = 0
         DO I=1,4
            IF (INTERIOR(XA,YY+PERT1(I),ZZ+PERT2(I))) NIN = NIN+1
         ENDDO
         IF (NIN/=1 .AND. NIN/=3) THEN
            X1 = XX
            CYCLE XLOOP3
            ENDIF
         DO I=1,N
            SEG=>SEGMENT(I)
            IF (X1==SEG%X1 .AND. XX==SEG%X2 .AND.YY==SEG%Y1 .AND. YY==SEG%Y2 .AND.ZZ==SEG%Z1 .AND. ZZ==SEG%Z2) THEN
               X1 = XX
               CYCLE XLOOP3
            ENDIF
         ENDDO
         IF (N+1>N_SEGMENTS_MAX) CALL RE_ALLOCATE_SEGMENTS
         N = N+1
         SEG=>SEGMENT(N)
         SEG%X1 = X1 
         SEG%X2 = XX
         SEG%Y1 = YY 
         SEG%Y2 = YY
         SEG%Z1 = ZZ 
         SEG%Z2 = ZZ
         X1 = XX
      ENDDO XLOOP3
   ENDDO YLOOP3
ENDDO ZLOOP3
 
WRITE(LU_SMV,'(/A)') 'OUTLINE'
WRITE(LU_SMV,'(I4)') N
DO I=1,N
   SEG=>SEGMENT(I)
   WRITE(LU_SMV,'(6F12.4)') SEG%X1,SEG%Y1,SEG%Z1,SEG%X2,SEG%Y2,SEG%Z2
ENDDO
 
DEALLOCATE(SEGMENT)
 
! Spatial offset for texture maps 
 
WRITE(LU_SMV,'(/A)') 'TOFFSET'
WRITE(LU_SMV,'(3F13.5)') (TEX_ORI(I),I=1,3)
 
! Write grid info for each block
 
MESH_LOOP: DO NM=1,NMESHES

   M => MESHES(NM)
   T => TRANS(NM)
 
   WRITE(LU_SMV,'(/A)') 'OFFSET'
   WRITE(LU_SMV,'(3F13.5)') 0.,0.,0.

   WRITE(LU_SMV,'(/A,3X,A)') 'GRID',TRIM(MESH_NAME(NM))
   IF (.NOT.EVACUATION_GRID(NM)) EVAC_CODE=0
   IF (     EVACUATION_GRID(NM)) EVAC_CODE=1
   WRITE(LU_SMV,'(4I5)') M%IBAR,M%JBAR,M%KBAR,EVAC_CODE

   WRITE(LU_SMV,'(/A)') 'PDIM'
   WRITE(LU_SMV,'(9F13.5)') M%XS,M%XF,M%YS,M%YF,M%ZS,M%ZF,(REAL(M%RGB(I),FB)/255._FB,I = 1,3)

   WRITE(LU_SMV,'(/A)') 'TRNX'
   WRITE(LU_SMV,'(I5)') T%NOC(1)
   DO N=1,T%NOC(1)
      WRITE(LU_SMV,'(I5,2F12.5)') T%IDERIVSTORE(N,1),T%CCSTORE(N,1),T%PCSTORE(N,1)
   ENDDO
   DO I=0,M%IBAR
      WRITE(LU_SMV,'(I5,F12.5)') I,M%X(I)
   ENDDO

   WRITE(LU_SMV,'(/A)') 'TRNY'
   WRITE(LU_SMV,'(I5)') T%NOC(2)
   DO N=1,T%NOC(2)
      WRITE(LU_SMV,'(I5,2F12.5)') T%IDERIVSTORE(N,2),T%CCSTORE(N,2),T%PCSTORE(N,2)
   ENDDO
   DO J=0,M%JBAR
      WRITE(LU_SMV,'(I5,F12.5)') J,M%Y(J)
   ENDDO

   WRITE(LU_SMV,'(/A)') 'TRNZ'
   WRITE(LU_SMV,'(I5)') T%NOC(3)
   DO N=1,T%NOC(3)
      WRITE(LU_SMV,'(I5,2F12.5)') T%IDERIVSTORE(N,3),T%CCSTORE(N,3),T%PCSTORE(N,3)
   ENDDO
   DO K=0,M%KBAR
      WRITE(LU_SMV,'(I5,F12.5)') K,M%Z(K)
   ENDDO
 
   ! Write obstacle info to .smv file
 
   WRITE(LU_SMV,'(/A)') 'OBST'
   WRITE(LU_SMV,*) M%N_OBST
   DO N=1,M%N_OBST
      OB=>M%OBSTRUCTION(N)
      IF (OB%TEXTURE(1)==-999._EB) THEN
         WRITE(LU_SMV,'(6F12.5,I7,6I4)') OB%X1,OB%X2,OB%Y1,OB%Y2,OB%Z1,OB%Z2,OB%ORDINAL, &
                                    OB%IBC(-1),OB%IBC(1),OB%IBC(-2),OB%IBC(2),OB%IBC(-3),OB%IBC(3)
      ELSE
         WRITE(LU_SMV,'(6F12.5,I7,6I4,3F13.5)') OB%X1,OB%X2,OB%Y1,OB%Y2,OB%Z1,OB%Z2,OB%ORDINAL, &
            OB%IBC(-1),OB%IBC(1),OB%IBC(-2),OB%IBC(2),OB%IBC(-3),OB%IBC(3), OB%TEXTURE(1),OB%TEXTURE(2),OB%TEXTURE(3)
      ENDIF
   ENDDO
   DO N=1,M%N_OBST
      OB=>M%OBSTRUCTION(N)
      IF (OB%BCI/=-3) THEN
         WRITE(LU_SMV,'(8I5)') OB%I1,OB%I2,OB%J1,OB%J2,OB%K1,OB%K2,OB%BCI,OB%BTI
      ELSE
         WRITE(LU_SMV,'(8I5,4F13.5)') OB%I1,OB%I2,OB%J1,OB%J2,OB%K1,OB%K2,OB%BCI,OB%BTI, REAL(OB%RGB,FB)/255._FB, OB%TRANSPARENCY
      ENDIF
   ENDDO
 
   DO N=1,M%N_OBST
      OB=>M%OBSTRUCTION(N)
      IF (OB%HIDDEN) THEN
         WRITE(LU_SMV,'(A,I3)') 'HIDE_OBST',NM
         WRITE(LU_SMV,'(I6,F13.5)') N,0.
      ENDIF
   ENDDO

   ! Figure out the number of "dummy" vents for Smokeview to draw solid exterior boundaries

   NDV = 0
   NDVDIM = 1000
   ALLOCATE(IDV1(NDVDIM))
   ALLOCATE(IDV2(NDVDIM))
   ALLOCATE(JDV1(NDVDIM))
   ALLOCATE(JDV2(NDVDIM))
   ALLOCATE(KDV1(NDVDIM))
   ALLOCATE(KDV2(NDVDIM))
 
   ALLOCATE(WALL_DUMMY(M%JBAR,M%KBAR))

   WALL_DUMMY = 0
   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%I1==0 .AND. VT%I2==0) WALL_DUMMY(VT%J1+1:VT%J2,VT%K1+1:VT%K2) = -1
   ENDDO
   DO K=1,M%KBAR
      DO J=1,M%JBAR
         XX = M%X(0) - 0.001_EB*M%DX(0)
         YY = 0.5_EB*(M%Y(J)+M%Y(J-1))
         ZZ = 0.5_EB*(M%Z(K)+M%Z(K-1))
         IF (INTERIOR(XX,YY,ZZ)) WALL_DUMMY(J,K) = -1
      ENDDO
   ENDDO
   NDVOLD = NDV
   CALL DUMMY_VENTS(WALL_DUMMY,M%JBAR,M%KBAR,NDVDIM,NDV,JDV1,JDV2,KDV1,KDV2)
   IDV1(NDVOLD+1:NDV) = 0
   IDV2(NDVOLD+1:NDV) = 0

   WALL_DUMMY = 0
   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%I1==M%IBAR .AND. VT%I2==M%IBAR) WALL_DUMMY(VT%J1+1:VT%J2,VT%K1+1:VT%K2) = -1
   ENDDO
   DO K=1,M%KBAR
      DO J=1,M%JBAR
         XX = M%X(M%IBAR) + 0.001_EB*M%DX(M%IBAR)
         YY = 0.5_EB*(M%Y(J)+M%Y(J-1))
         ZZ = 0.5_EB*(M%Z(K)+M%Z(K-1))
         IF (INTERIOR(XX,YY,ZZ)) WALL_DUMMY(J,K) = -1
      ENDDO
   ENDDO
   NDVOLD = NDV
   CALL DUMMY_VENTS(WALL_DUMMY,M%JBAR,M%KBAR,NDVDIM,NDV,JDV1,JDV2,KDV1,KDV2)
   IDV1(NDVOLD+1:NDV) = M%IBAR
   IDV2(NDVOLD+1:NDV) = M%IBAR
   DEALLOCATE(WALL_DUMMY)

   ALLOCATE(WALL_DUMMY(M%IBAR,M%KBAR))

   WALL_DUMMY = 0
   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%J1==0 .AND. VT%J2==0) WALL_DUMMY(VT%I1+1:VT%I2,VT%K1+1:VT%K2) = -1
   ENDDO
   DO K=1,M%KBAR
      DO I=1,M%IBAR
         YY = M%Y(0) - 0.001_EB*M%DY(0)
         XX = 0.5_EB*(M%X(I)+M%X(I-1))
         ZZ = 0.5_EB*(M%Z(K)+M%Z(K-1))
         IF (INTERIOR(XX,YY,ZZ)) WALL_DUMMY(I,K) = -1
      ENDDO
   ENDDO
   NDVOLD = NDV
   CALL DUMMY_VENTS(WALL_DUMMY,M%IBAR,M%KBAR,NDVDIM, NDV,IDV1,IDV2,KDV1,KDV2)
   JDV1(NDVOLD+1:NDV) = 0
   JDV2(NDVOLD+1:NDV) = 0
   WALL_DUMMY = 0
   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%J1==M%JBAR .AND. VT%J2==M%JBAR) WALL_DUMMY(VT%I1+1:VT%I2,VT%K1+1:VT%K2) = -1
   ENDDO
   DO K=1,M%KBAR
      DO I=1,M%IBAR
         YY = M%Y(M%JBAR) + 0.001_EB*M%DY(M%JBAR)
         XX = 0.5_EB*(M%X(I)+M%X(I-1))
         ZZ = 0.5_EB*(M%Z(K)+M%Z(K-1))
         IF (INTERIOR(XX,YY,ZZ)) WALL_DUMMY(I,K) = -1
      ENDDO
   ENDDO
   NDVOLD = NDV
   CALL DUMMY_VENTS(WALL_DUMMY,M%IBAR,M%KBAR,NDVDIM, NDV,IDV1,IDV2,KDV1,KDV2)
   JDV1(NDVOLD+1:NDV) = M%JBAR
   JDV2(NDVOLD+1:NDV) = M%JBAR

   DEALLOCATE(WALL_DUMMY)

   ALLOCATE(WALL_DUMMY(M%IBAR,M%JBAR))

   WALL_DUMMY = 0
   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%K1==0 .AND. VT%K2==0) WALL_DUMMY(VT%I1+1:VT%I2,VT%J1+1:VT%J2) = -1
   ENDDO
   DO J=1,M%JBAR
      DO I=1,M%IBAR
         ZZ = M%Z(0) - 0.001_EB*M%DZ(0)
         XX = 0.5_EB*(M%X(I)+M%X(I-1))
         YY = 0.5_EB*(M%Y(J)+M%Y(J-1))
         IF (INTERIOR(XX,YY,ZZ)) WALL_DUMMY(I,J) = -1
      ENDDO
   ENDDO
   NDVOLD = NDV
   CALL DUMMY_VENTS(WALL_DUMMY,M%IBAR,M%JBAR,NDVDIM, NDV,IDV1,IDV2,JDV1,JDV2)
   KDV1(NDVOLD+1:NDV) = 0
   KDV2(NDVOLD+1:NDV) = 0

   WALL_DUMMY = 0
   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%K1==M%KBAR .AND. VT%K2==M%KBAR) WALL_DUMMY(VT%I1+1:VT%I2,VT%J1+1:VT%J2) = -1
   ENDDO
   DO J=1,M%JBAR
      DO I=1,M%IBAR
         ZZ = M%Z(M%KBAR) + 0.001_EB*M%DZ(M%KBAR)
         XX = 0.5_EB*(M%X(I)+M%X(I-1))
         YY = 0.5_EB*(M%Y(J)+M%Y(J-1))
         IF (INTERIOR(XX,YY,ZZ)) WALL_DUMMY(I,J) = -1
      ENDDO
   ENDDO
   NDVOLD = NDV
   CALL DUMMY_VENTS(WALL_DUMMY,M%IBAR,M%JBAR,NDVDIM, NDV,IDV1,IDV2,JDV1,JDV2)
   KDV1(NDVOLD+1:NDV) = M%KBAR
   KDV2(NDVOLD+1:NDV) = M%KBAR

   DEALLOCATE(WALL_DUMMY)

   ! Write out information about vents

   WRITE(LU_SMV,'(/A)') 'VENT'
   WRITE(LU_SMV,'(2I5)') M%N_VENT+NDV,NDV

   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%TEXTURE(1)==-999._EB) THEN
         WRITE(LU_SMV,'(6F12.5,I6,I4)')  VT%X1,VT%X2,VT%Y1,VT%Y2,VT%Z1,VT%Z2,VT%ORDINAL,VT%IBC
      ELSE
         WRITE(LU_SMV,'(6F12.5,I6,I4,3F13.5)') VT%X1,VT%X2,VT%Y1,VT%Y2,VT%Z1,VT%Z2,VT%ORDINAL,VT%IBC, &
                                           VT%TEXTURE(1),VT%TEXTURE(2),VT%TEXTURE(3)
      ENDIF
   ENDDO

   DO N=1,NDV
      WRITE(LU_SMV,'(6F12.5,I6,I4)') M%X(IDV1(N)),M%X(IDV2(N)),M%Y(JDV1(N)),M%Y(JDV2(N)),  &
                                  M%Z(KDV1(N)),M%Z(KDV2(N)),M%N_VENT+N,DEFAULT_SURF_INDEX
   ENDDO

   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%BOUNDARY_TYPE==OPEN_BOUNDARY) INDX = -VT%VCI
      IF (VT%BOUNDARY_TYPE/=OPEN_BOUNDARY) INDX =  VT%VCI
      IF (VT%RGB(1)<0) THEN
         WRITE(LU_SMV,'(8I5)') VT%I1,VT%I2,VT%J1,VT%J2,VT%K1,VT%K2,INDX,VT%VTI
      ELSE
         WRITE(LU_SMV,'(8I5,4F13.5)') VT%I1,VT%I2,VT%J1,VT%J2,VT%K1,VT%K2,INDX,VT%VTI, REAL(VT%RGB,FB)/255._FB,VT%TRANSPARENCY
      ENDIF
   ENDDO
   DO N=1,NDV
      INDX = 99
      WRITE(LU_SMV,'(8I5)') IDV1(N),IDV2(N),JDV1(N),JDV2(N),KDV1(N),KDV2(N),INDX,0
   ENDDO

   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (.NOT.VT%ACTIVATED) THEN
         WRITE(LU_SMV,'(/A,I3)') 'CLOSE_VENT',NM
         WRITE(LU_SMV,'(I4,F13.5)') N,0.
      ENDIF
   ENDDO

   DEALLOCATE(IDV1)
   DEALLOCATE(IDV2)
   DEALLOCATE(JDV1)
   DEALLOCATE(JDV2)
   DEALLOCATE(KDV1)
   DEALLOCATE(KDV2)

ENDDO MESH_LOOP
 
! Write out threshold value for HRRPUV
 
WRITE(LU_SMV,'(/A)') 'HRRPUVCUT'
WRITE(LU_SMV,'(I5)') NMESHES
DO NM=1,NMESHES
WRITE(LU_SMV,'(F13.5)') HRRPUA_SHEET/(7._EB*MESHES(NM)%DXMIN)
ENDDO
 
! Write out RAMP info to .smv file
 
WRITE(LU_SMV,'(/A)') 'RAMP'
WRITE(LU_SMV,'(I5)') N_RAMP
DO N=1,N_RAMP
   WRITE(LU_SMV,'(A,A)')  'RAMP: ',RAMP_ID(N)
   WRITE(LU_SMV,'(I5)') RAMPS(N)%NUMBER_DATA_POINTS
   DO I=1,RAMPS(N)%NUMBER_DATA_POINTS
      WRITE(LU_SMV,'(6F12.5)') RAMPS(N)%INDEPENDENT_DATA(I),RAMPS(N)%DEPENDENT_DATA(I)
   ENDDO
ENDDO
 
! Write out DEVICE info to .smv file
 
DO N=1,N_DEVC
   DV => DEVICE(N)
   WRITE(LU_SMV,'(/A)') 'DEVICE'
   WRITE(LU_SMV,'(A)') TRIM(PROPERTY(DV%PROP_INDEX)%SMOKEVIEW_ID)
   WRITE(LU_SMV,'(3F12.5,F13.5)') DV%X,DV%Y,DV%Z,DV%ORIENTATION(1:3)
ENDDO
 
! Flush the .smv file

CLOSE(LU_SMV)
OPEN(LU_SMV,FILE=FN_SMV,FORM='FORMATTED', STATUS='OLD',POSITION='APPEND')


CONTAINS

LOGICAL FUNCTION INTERIOR(XX,YY,ZZ)

INTEGER NM
REAL(EB), INTENT(IN) :: XX,YY,ZZ

INTERIOR = .FALSE.

DO NM=1,NMESHES
   IF (XX>MESHES(NM)%XS .AND. XX<MESHES(NM)%XF .AND. &