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_FILEENDIF 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),*)    ENDIFENDDO PROF_LOOPTUSED(7,NM) = TUSED(7,NM) + SECOND() - TNOWEND SUBROUTINE INITIALIZE_MESH_DUMPS  SUBROUTINE WRITE_SMOKEVIEW_FILEUSE MATH_FUNCTIONS, ONLY: EVALUATE_RAMP USE MEMORY_FUNCTIONS, ONLY : CHKMEMERRUSE COMP_FUNCTIONS, ONLY: SHUTDOWNINTEGER :: N,NN,I,J,K,NM,NX,NY,NZ,NIN,NXL,NYL,NZL,NDV,NDVOLD,NDVDIM,N_TICKS,INDX,IZERO,EVAC_CODEINTEGER, ALLOCATABLE, DIMENSION(:) ::IDV1,IDV2,JDV1,JDV2,KDV1,KDV2INTEGER, ALLOCATABLE, DIMENSION(:,:) :: WALL_DUMMYREAL(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_INTTYPE SEGMENT_TYPEREAL(EB) :: X1,X2,Y1,Y2,Z1,Z2END TYPE SEGMENT_TYPETYPE (SEGMENT_TYPE), ALLOCATABLE, TARGET, DIMENSION(:) :: SEGMENTTYPE (SEGMENT_TYPE), POINTER :: SEGINTEGER :: N_SEGMENTS_MAXTYPE (MESH_TYPE), POINTER :: MX,MY,MZTYPE (TRAN_TYPE), POINTER :: TREAL(EB), ALLOCATABLE, DIMENSION(:) :: XLEVEL,YLEVEL,ZLEVELCHARACTER(30) LABELLOGICAL :: EXCHARACTER(100) :: MESSAGE ! Open up the Smokeview ".smv" fileINQUIRE(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')   RETURNENDIF 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_INTEGERCLOSE(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 CHIDWRITE(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 surfacesWRITE(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_MAPENDDO ! Write out info about particle typesEVAC_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   ENDDOENDIF EVAC_ONLY3! Write out info about human types for evacuationEVAC_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   ENDDOENDIF EVAC_ONLY4! Tick Marks XMIN = 10000._EBXMAX =-10000._EBYMIN = 10000._EBYMAX =-10000._EBZMIN = 10000._EBZMAX =-10000._EBDO 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._EBTICK_WIDTH  = 2.N_TICKS     = 5X_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-axisWRITE(LU_SMV,'(6F13.5,I3)') XMIN,YMIN,ZMIN,XMAX,YMIN,ZMIN,N_TICKSWRITE(LU_SMV,'(6F13.5)') TICK_LENGTH,-2.,-1.,-1.,-1.,TICK_WIDTHWRITE(LU_SMV,'(A)') 'TICKS'WRITE(LU_SMV,'(6F13.5,I3)') XMIN,YMIN,ZMIN,XMIN,YMIN,ZMIN,1WRITE(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-axisWRITE(LU_SMV,'(6F13.5,I3)') XMIN,YMIN,ZMIN,XMIN,YMAX,ZMIN,N_TICKSWRITE(LU_SMV,'(6F13.5)') TICK_LENGTH,-1.,-1.,-1.,-1.,TICK_WIDTHWRITE(LU_SMV,'(A)') 'TICKS'WRITE(LU_SMV,'(6F10.2,I3)') XMIN,YMIN,ZMIN,XMIN,YMIN,ZMIN,1WRITE(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-axisWRITE(LU_SMV,'(6F13.5,I3)') XMIN,YMIN,ZMIN,XMIN,YMIN,ZMAX,N_TICKSWRITE(LU_SMV,'(6F13.5)') TICK_LENGTH,-1.,-1.,-1.,-1.,TICK_WIDTHWRITE(LU_SMV,'(A)') 'TICKS'WRITE(LU_SMV,'(6F13.5,I3)') XMIN,YMIN,ZMIN,XMIN,YMIN,ZMIN,1WRITE(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_EBPERT1(2) = -.001_EB PERT2(2) = 0.001_EBPERT1(3) = -.001_EB PERT2(3) = -.001_EBPERT1(4) = 0.001_EB PERT2(4) = -.001_EB ALLOCATE(XLEVEL(0:2*NMESHES)) XLEVEL = -100000._EBALLOCATE(YLEVEL(0:2*NMESHES))YLEVEL = -100000._EBALLOCATE(ZLEVEL(0:2*NMESHES)) ZLEVEL = -100000._EB NXL = 0 NYL = 0 NZL = 0DO 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   ENDIFENDDO N_SEGMENTS_MAX = 100ALLOCATE(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 YLOOP1ENDDO 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