dump.f90

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

         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(I3)') N_PART
         DO N=1,N_PART
            M%N_STRINGS = M%N_STRINGS + 1
            WRITE(M%STRING(M%N_STRINGS),'(I3)') N
         ENDDO
      ENDIF EVAC_ONLY
 
      OPEN(LU_PART(NM),FILE=FN_PART(NM),FORM='UNFORMATTED',STATUS='REPLACE')
      WRITE(LU_PART(NM)) ONE_INTEGER                ! The number ONE, to indicate file Endian-ness
      WRITE(LU_PART(NM)) NINT(VERSION_NUMBER*100.)  ! FDS version number
      EVAC_ONLY2: IF (EVACUATION_ONLY(NM)) THEN
         WRITE(LU_PART(NM)) N_EVAC
         DO N=1,N_EVAC
            WRITE(LU_PART(NM)) EVAC_N_QUANTITIES,ZERO_INTEGER  ! ZERO_INTEGER is a place holder for future INTEGER quantities
            DO NN=1,EVAC_N_QUANTITIES
               WRITE(LU_PART(NM)) OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%NAME
               WRITE(LU_PART(NM)) OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%UNITS
            ENDDO
         ENDDO
      ELSE
         WRITE(LU_PART(NM)) N_PART
         DO N=1,N_PART
            PC => PARTICLE_CLASS(N)
            WRITE(LU_PART(NM)) PC%N_QUANTITIES,ZERO_INTEGER  ! ZERO_INTEGER is a place holder for future INTEGER quantities
            DO NN=1,PC%N_QUANTITIES
               WRITE(LU_PART(NM)) OUTPUT_QUANTITY(PC%QUANTITIES_INDEX(NN))%NAME
               WRITE(LU_PART(NM)) OUTPUT_QUANTITY(PC%QUANTITIES_INDEX(NN))%UNITS
            ENDDO
         ENDDO
      ENDIF EVAC_ONLY2
 
   ENDIF APPEND_DROPLET_FILE
ENDIF DROPLET_IF

! Initialize PROFile data files (CHID_prof_nn.csv)
 
PROF_LOOP: DO N=1,N_PROF
   IF (PROFILE(N)%MESH /= NM) CYCLE PROF_LOOP
   IF (APPEND) THEN
      OPEN(LU_PROF(N),FILE=FN_PROF(N),FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')
   ELSE
      OPEN(LU_PROF(N),FILE=FN_PROF(N),FORM='FORMATTED',STATUS='REPLACE')
      WRITE(LU_PROF(N),'(A)') PROFILE(N)%ID
      WRITE(LU_PROF(N),'(A)') "Time(s), Npoints, Npoints x Depth (mm), Npoints x Value"
      WRITE(LU_PROF(N),*) 
   ENDIF
ENDDO PROF_LOOP

TUSED(7,NM) = TUSED(7,NM) + SECOND() - TNOW
END SUBROUTINE INITIALIZE_MESH_DUMPS
 
 
SUBROUTINE WRITE_SMOKEVIEW_FILE

USE MATH_FUNCTIONS, ONLY: EVALUATE_RAMP 
USE MEMORY_FUNCTIONS, ONLY : CHKMEMERR
USE COMP_FUNCTIONS, ONLY: SHUTDOWN
INTEGER :: N,NN,I,J,K,NM,NX,NY,NZ,NIN,NXL,NYL,NZL,NDV,NDVOLD,NDVDIM,N_TICKS,INDX,IZERO,EVAC_CODE
INTEGER, ALLOCATABLE, DIMENSION(:) ::IDV1,IDV2,JDV1,JDV2,KDV1,KDV2
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: WALL_DUMMY
REAL(EB) :: X1,Y1,Z1,X2,Y2,Z2,XX,YY,ZZ,PERT1(4),PERT2(4),XMIN,YMIN,ZMIN,XMAX,YMAX,ZMAX,XA,YA,ZA, &
            TICK_LENGTH,TICK_WIDTH,X_INT,Y_INT,Z_INT
TYPE SEGMENT_TYPE
REAL(EB) :: X1,X2,Y1,Y2,Z1,Z2
END TYPE SEGMENT_TYPE
TYPE (SEGMENT_TYPE), ALLOCATABLE, TARGET, DIMENSION(:) :: SEGMENT
TYPE (SEGMENT_TYPE), POINTER :: SEG
INTEGER :: N_SEGMENTS_MAX
TYPE (MESH_TYPE), POINTER :: MX,MY,MZ
TYPE (TRAN_TYPE), POINTER :: T
REAL(EB), ALLOCATABLE, DIMENSION(:) :: XLEVEL,YLEVEL,ZLEVEL
CHARACTER(30) LABEL
LOGICAL :: EX
CHARACTER(100) :: MESSAGE
 
! Open up the Smokeview ".smv" file

INQUIRE(FILE=FN_SMV,EXIST=EX)
IF (.NOT.EX .AND. APPEND) THEN
   WRITE(MESSAGE,'(A,A,A)') "ERROR: The file, ",TRIM(FN_SMV),", does not exist. Set RESTART=.FALSE."
   CALL SHUTDOWN(MESSAGE)
ENDIF
 
IF (APPEND) THEN
   OPEN(LU_SMV,FILE=FN_SMV,FORM='FORMATTED', STATUS='OLD',POSITION='APPEND')
   RETURN
ENDIF
 
OPEN(LU_SMV,FILE=FN_SMV,FORM='FORMATTED',STATUS='REPLACE')
 
! Write out TITLE
 
WRITE(LU_SMV,'(A)') 'TITLE'
WRITE(LU_SMV,'(A)')  TITLE
 
! Record the version and endian-ness in .smv file
 
WRITE(LU_SMV,'(/A)') 'VERSION'
WRITE(LU_SMV,'(F5.1,2X,A)') VERSION_NUMBER,VERSION_STRING

! Indicate the "endian-ness" of the output files
 
OPEN(LU_END,FILE=FN_END,FORM='UNFORMATTED',STATUS='REPLACE')
WRITE(LU_END) ONE_INTEGER
CLOSE(LU_END)

WRITE(LU_SMV,'(/A)') 'ENDF'
WRITE(LU_SMV,'(A)') TRIM(CHID)//'.end'

! Write out the name of the input file
 
WRITE(LU_SMV,'(/A)') 'INPF'
WRITE(LU_SMV,'(A)') TRIM(FN_INPUT)

! Write out the CHID
WRITE(LU_SMV,'(/A)') 'CHID'
WRITE(LU_SMV,'(A)') TRIM(CHID)


! Number of meshes
 
WRITE(LU_SMV,'(/A)') 'NMESHES'
WRITE(LU_SMV,'(I3)') NMESHES

! Information used for touring in Smokeview
 
WRITE(LU_SMV,'(/A)') 'VIEWTIMES'
WRITE(LU_SMV,'(2F10.2,I6)') 0.0_EB,MAX(0.01_EB,T_END),MAX(2,NFRAMES)
 
! Auxilliary CAD geometry via dxf2fds
 
IF (RENDER_FILE/='null') THEN
   WRITE(LU_SMV,'(/A)') 'CADGEOM'
   WRITE(LU_SMV,'(A)') TRIM(RENDER_FILE)
ENDIF

! Write out info about surfaces

WRITE(LU_SMV,'(/A)') 'SURFDEF'
WRITE(LU_SMV,'(A,A)') ' ',SURF_NAME(DEFAULT_SURF_INDEX)
 
DO N=0,N_SURF
   SF => SURFACE(N)
   WRITE(LU_SMV,'(/A)') 'SURFACE'
   WRITE(LU_SMV,'(A,A)') ' ',SURF_NAME(N)
   IF (SF%THERMALLY_THICK) THEN
      ML => MATERIAL(SF%LAYER_MATL_INDEX(1,1))
      WRITE(LU_SMV,'(2F8.2)') TMPM,ML%EMISSIVITY
   ELSE
      WRITE(LU_SMV,'(2F8.2)') 5000.,1.0
   ENDIF
   WRITE(LU_SMV,'(I2,6F13.5)') SF%SURF_TYPE,SF%TEXTURE_WIDTH,SF%TEXTURE_HEIGHT,REAL(SF%RGB,FB)/255._FB,SF%TRANSPARENCY
   WRITE(LU_SMV,'(A,A)') ' ',SF%TEXTURE_MAP
ENDDO
 
! Write out info about particle types

EVAC_ONLY3: IF (.NOT. ALL(EVACUATION_ONLY)) THEN
   DO N=1,N_PART
      PC => PARTICLE_CLASS(N)
      WRITE(LU_SMV,'(/A)') 'CLASS_OF_PARTICLES'
      WRITE(LU_SMV,'(A,A)') ' ',PC%ID
      WRITE(LU_SMV,'(3F13.5)') REAL(PC%RGB,FB)/255._FB
      WRITE(LU_SMV,'(I3)') PC%N_QUANTITIES
      DO NN=1,PC%N_QUANTITIES
         WRITE(LU_SMV,'(A)') OUTPUT_QUANTITY(PC%QUANTITIES_INDEX(NN))%NAME
         WRITE(LU_SMV,'(A)') OUTPUT_QUANTITY(PC%QUANTITIES_INDEX(NN))%SHORT_NAME
         WRITE(LU_SMV,'(A)') OUTPUT_QUANTITY(PC%QUANTITIES_INDEX(NN))%UNITS
      ENDDO
   ENDDO
ENDIF EVAC_ONLY3

! Write out info about human types for evacuation

EVAC_ONLY4: IF (ANY(EVACUATION_GRID)) THEN
   DO N=1,N_EVAC
      WRITE(LU_SMV,'(/A)') 'CLASS_OF_HUMANS'
      WRITE(LU_SMV,'(A,A)') ' ',EVAC_CLASS_NAME(N)
      WRITE(LU_SMV,'(3F13.5)') REAL(EVAC_CLASS_RGB(:,N),FB)/255._EB
      WRITE(LU_SMV,'(I3)') EVAC_N_QUANTITIES
      DO NN=1,EVAC_N_QUANTITIES
         WRITE(LU_SMV,'(A)') OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%NAME
         WRITE(LU_SMV,'(A)') OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%SHORT_NAME
         WRITE(LU_SMV,'(A)') OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%UNITS
      ENDDO
   ENDDO
ENDIF EVAC_ONLY4

! Tick Marks
 
XMIN = 10000._EB
XMAX =-10000._EB
YMIN = 10000._EB
YMAX =-10000._EB
ZMIN = 10000._EB
ZMAX =-10000._EB
DO NM=1,NMESHES
   M => MESHES(NM)
   XMIN = MIN(M%XS,XMIN) 
   XMAX = MAX(M%XF,XMAX)
   YMIN = MIN(M%YS,YMIN)  
   YMAX = MAX(M%YF,YMAX)
   ZMIN = MIN(M%ZS,ZMIN) 
   ZMAX = MAX(M%ZF,ZMAX)
ENDDO
 
TICK_LENGTH = (XMAX-XMIN)/50._EB
TICK_WIDTH  = 2.
N_TICKS     = 5
X_INT       = (XMAX-XMIN)/(N_TICKS-1._EB)
Y_INT       = (YMAX-YMIN)/(N_TICKS-1._EB)
Z_INT       = (ZMAX-ZMIN)/(N_TICKS-1._EB)
 
WRITE(LU_SMV,'(/A)') 'TICKS'  ! x-axis
WRITE(LU_SMV,'(6F13.5,I3)') XMIN,YMIN,ZMIN,XMAX,YMIN,ZMIN,N_TICKS
WRITE(LU_SMV,'(6F13.5)') TICK_LENGTH,-2.,-1.,-1.,-1.,TICK_WIDTH
WRITE(LU_SMV,'(A)') 'TICKS'
WRITE(LU_SMV,'(6F13.5,I3)') XMIN,YMIN,ZMIN,XMIN,YMIN,ZMIN,1
WRITE(LU_SMV,'(6F13.5)') XMAX-XMIN,1.,-1.,-1.,-1.,TICK_WIDTH
 
DO I=0,N_TICKS-1
   WRITE(LU_SMV,'(A)') 'LABEL'
   WRITE(LU_SMV,'(8F13.5)') XMIN+I*X_INT,YMIN-2._EB*TICK_LENGTH,ZMIN,-1.,-1.,-1.,0._EB,T_END
   CALL TRIM_LABEL(XMIN+I*X_INT,LABEL)
   WRITE(LU_SMV,'(A)') TRIM(LABEL)
ENDDO
 
WRITE(LU_SMV,'(/A)') 'TICKS'  ! y-axis
WRITE(LU_SMV,'(6F13.5,I3)') XMIN,YMIN,ZMIN,XMIN,YMAX,ZMIN,N_TICKS
WRITE(LU_SMV,'(6F13.5)') TICK_LENGTH,-1.,-1.,-1.,-1.,TICK_WIDTH
WRITE(LU_SMV,'(A)') 'TICKS'
WRITE(LU_SMV,'(6F10.2,I3)') XMIN,YMIN,ZMIN,XMIN,YMIN,ZMIN,1
WRITE(LU_SMV,'(6F10.3)') YMAX-YMIN,2.,-1.,-1.,-1.,TICK_WIDTH
 
DO I=0,N_TICKS-1
   WRITE(LU_SMV,'(A)') 'LABEL'
   WRITE(LU_SMV,'(8F13.5)') XMIN-2._EB*TICK_LENGTH,YMIN+I*Y_INT,ZMIN,-1.,-1.,-1.,0.,T_END
   CALL TRIM_LABEL(YMIN+I*Y_INT,LABEL)
   WRITE(LU_SMV,'(A)') TRIM(LABEL)
ENDDO
 
WRITE(LU_SMV,'(/A)') 'TICKS'  ! z-axis
WRITE(LU_SMV,'(6F13.5,I3)') XMIN,YMIN,ZMIN,XMIN,YMIN,ZMAX,N_TICKS
WRITE(LU_SMV,'(6F13.5)') TICK_LENGTH,-1.,-1.,-1.,-1.,TICK_WIDTH
WRITE(LU_SMV,'(A)') 'TICKS'
WRITE(LU_SMV,'(6F13.5,I3)') XMIN,YMIN,ZMIN,XMIN,YMIN,ZMIN,1
WRITE(LU_SMV,'(6F10.3)') ZMAX-ZMIN,3.,-1.,-1.,-1.,TICK_WIDTH
 
DO I=0,N_TICKS-1
   WRITE(LU_SMV,'(A)') 'LABEL'
   WRITE(LU_SMV,'(8F13.5)') XMIN-2._EB*TICK_LENGTH,YMIN,ZMIN+I*Z_INT, -1.,-1.,-1.,0.,T_END
   CALL TRIM_LABEL(ZMIN+I*Z_INT,LABEL)
   WRITE(LU_SMV,'(A)') TRIM(LABEL)
ENDDO
 
! Figure out the outline for multiblock cases
 
PERT1(1) = 0.001_EB 
PERT2(1) = 0.001_EB
PERT1(2) = -.001_EB 
PERT2(2) = 0.001_EB
PERT1(3) = -.001_EB 
PERT2(3) = -.001_EB
PERT1(4) = 0.001_EB 
PERT2(4) = -.001_EB
 
ALLOCATE(XLEVEL(0:2*NMESHES)) 
XLEVEL = -100000._EB
ALLOCATE(YLEVEL(0:2*NMESHES))
YLEVEL = -100000._EB
ALLOCATE(ZLEVEL(0:2*NMESHES)) 
ZLEVEL = -100000._EB
 
NXL = 0 
NYL = 0 
NZL = 0
DO NM=1,2*NMESHES
   XMIN = 100000._EB 
   YMIN = 100000._EB 
   ZMIN = 100000._EB
   DO N=1,2*NMESHES
      M => MESHES(INT((N+1)/2))
      IF (MOD(N,2)/=0) XX = M%XS
      IF (MOD(N,2)==0) XX = M%XF
      IF (MOD(N,2)/=0) YY = M%YS
      IF (MOD(N,2)==0) YY = M%YF
      IF (MOD(N,2)/=0) ZZ = M%ZS
      IF (MOD(N,2)==0) ZZ = M%ZF
      IF (XX>XLEVEL(NXL)) XMIN = MIN(XX,XMIN)
      IF (YY>YLEVEL(NYL)) YMIN = MIN(YY,YMIN)
      IF (ZZ>ZLEVEL(NZL)) ZMIN = MIN(ZZ,ZMIN)
   ENDDO
   IF (XMIN>XLEVEL(NXL)) THEN
      NXL = NXL + 1
      XLEVEL(NXL) = XMIN
   ENDIF
   IF (YMIN>YLEVEL(NYL)) THEN
      NYL = NYL + 1
      YLEVEL(NYL) = YMIN
   ENDIF
   IF (ZMIN>ZLEVEL(NZL)) THEN
      NZL = NZL + 1
      ZLEVEL(NZL) = ZMIN
   ENDIF
ENDDO
 
N_SEGMENTS_MAX = 100
ALLOCATE(SEGMENT(1:N_SEGMENTS_MAX),STAT=IZERO)
CALL ChkMemErr('DUMP','SEGMENT',IZERO)
 
N = 0
 
XLOOP1: DO NX=1,2*NMESHES
   MX => MESHES(INT((NX+1)/2))
   IF (MOD(NX,2)/=0) XX = MX%XS
   IF (MOD(NX,2)==0) XX = MX%XF
   YLOOP1: 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 ((XX<MY%XS .OR. XX>MY%XF) .OR.(YY<MX%YS .OR. YY>MX%YF)) CYCLE YLOOP1
      Z1 = MAX(MX%ZS,MY%ZS)
      Z2 = MIN(MX%ZF,MY%ZF)
      IF (Z1>=Z2) CYCLE YLOOP1
      ZLOOP1: DO NZ=1,NZL
         ZZ = ZLEVEL(NZ)
         IF (ZZ<=Z1) CYCLE ZLOOP1
         IF (ZZ>Z2) CYCLE YLOOP1
         ZA = (Z1+ZZ)/2._EB
         NIN = 0
         DO I=1,4
            IF (INTERIOR(XX+PERT1(I),YY+PERT2(I),ZA)) NIN = NIN+1
         ENDDO
         IF (NIN/=1 .AND. NIN/=3) THEN
            Z1 = ZZ
            CYCLE ZLOOP1
            ENDIF
         DO I=1,N
            SEG=>SEGMENT(I)
            IF (XX==SEG%X1 .AND. XX==SEG%X2 .AND.YY==SEG%Y1 .AND. YY==SEG%Y2 .AND.Z1==SEG%Z1 .AND. ZZ==SEG%Z2) THEN
               Z1 = ZZ
               CYCLE ZLOOP1
            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 = YY 
         SEG%Y2 = YY
         SEG%Z1 = Z1 
         SEG%Z2 = ZZ
         Z1 = ZZ
      ENDDO ZLOOP1
   ENDDO YLOOP1
ENDDO XLOOP1
 
XLOOP2: DO NX=1,2*NMESHES
   MX => MESHES(INT((NX+1)/2))
   IF (MOD(NX,2)/=0) XX = MX%XS
   IF (MOD(NX,2)==0) XX = MX%XF
   ZLOOP2: 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
      IF ((XX<MZ%XS .OR. XX>MZ%XF) .OR.(ZZ<MX%ZS .OR. ZZ>MX%ZF)) CYCLE ZLOOP2
      Y1 = MAX(MX%YS,MZ%YS)
      Y2 = MIN(MX%YF,MZ%YF)
      IF (Y1>=Y2) CYCLE ZLOOP2
      YLOOP2: DO NY=1,NYL
         YY = YLEVEL(NY)
         IF (YY<=Y1) CYCLE YLOOP2
         IF (YY>Y2) CYCLE ZLOOP2
         YA = (Y1+YY)/2._EB
         NIN = 0
         DO I=1,4
            IF (INTERIOR(XX+PERT1(I),YA,ZZ+PERT2(I))) NIN = NIN+1
         ENDDO
         IF (NIN/=1 .AND. NIN/=3) THEN
            Y1 = YY
            CYCLE YLOOP2
            ENDIF