Merge pull request #14071 from marcosvanella/master

FDS Source : Add option to do POSIX write of .smv file.

Author: marcosvanella

Source/cons.f90

@@ -196,6 +196,7 @@ MODULE GLOBAL_CONSTANTS
 LOGICAL :: SETUP_ONLY=.FALSE.               !< Indicates that the calculation should be stopped before time-stepping
 LOGICAL :: CHECK_MESH_ALIGNMENT=.FALSE.     !< Indicates that the user wants to check the mesh alignment and then stop
 LOGICAL :: SMOKE3D=.TRUE.                   !< Indicates that the 3D smoke and fire output is desired
+LOGICAL :: SMV_PARALLEL_WRITE=.TRUE.        !< If true, the CHID.smv file is written in parallel using MPI-IO.
 LOGICAL :: STATUS_FILES=.FALSE.             !< Produce an output file CHID.notready which is deleted if the simulation completes
 LOGICAL :: LOCK_TIME_STEP=.FALSE.           !< Do not allow time step to change for diagnostic purposes
 LOGICAL :: RESTRICT_TIME_STEP=.TRUE.        !< Do not let the time step increase above its intial value

Source/dump.f90

@@ -1543,6 +1543,9 @@ SUBROUTINE WRITE_SMOKEVIEW_FILE
 CHARACTER(LEN=:), ALLOCATABLE :: SMVSTR
 INTEGER :: OFFSET=0, SMVSTR_T_LEN=0, SMVSTR_USE_LEN=0, IERR
 TYPE (PATCH_TYPE), POINTER :: EP
+INTEGER :: STR_GATHER_LEN
+INTEGER, ALLOCATABLE, DIMENSION(:) :: RECV_USE_LEN,RECV_USE_OFF,RECV_COUNTS
+CHARACTER(LEN=:), ALLOCATABLE :: STR_GATHER
 
 ! If this is a RESTART case but an old .smv file does not exist, shutdown with an ERROR.
 
@@ -2454,13 +2457,65 @@ SUBROUTINE WRITE_SMOKEVIEW_FILE
 
 ! Write the .smv file
 
+SMV_PARALLEL_WRITE_IF : IF( SMV_PARALLEL_WRITE ) THEN
+
+! Write using MPI-IO:
 CALL MPI_FILE_DELETE(FN_SMV, MPI_INFO_NULL, IERR)
 CALL MPI_EXSCAN(SMVSTR_USE_LEN,OFFSET,1,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR)
 CALL MPI_FILE_OPEN(MPI_COMM_WORLD,FN_SMV,MPI_MODE_WRONLY+MPI_MODE_CREATE,MPI_INFO_NULL,SMVFILE_HANDLE,IERR)
 CALL MPI_FILE_WRITE_AT_ALL(SMVFILE_HANDLE,INT(OFFSET,MPI_OFFSET_KIND),SMVSTR,SMVSTR_USE_LEN,MPI_CHARACTER,STATUS,IERR)
 CALL MPI_FILE_SYNC(SMVFILE_HANDLE,IERR)
 CALL MPI_FILE_CLOSE(SMVFILE_HANDLE,IERR)
 
+ELSE SMV_PARALLEL_WRITE_IF
+
+! Gather strings in rank 0, which does a POSIX write:
+IF(N_MPI_PROCESSES>1) THEN
+   ALLOCATE(RECV_USE_LEN(0:N_MPI_PROCESSES-1),RECV_USE_OFF(0:N_MPI_PROCESSES-1),RECV_COUNTS(0:N_MPI_PROCESSES-1))
+   RECV_USE_LEN=0; RECV_USE_LEN(MY_RANK)=SMVSTR_USE_LEN; RECV_USE_OFF=0
+   RECV_COUNTS=1; DO I=0,N_MPI_PROCESSES-1; RECV_USE_OFF(I)=I; ENDDO
+   IF(MY_RANK==0) THEN
+      ! Gather string sizes from all Processes in rank 0:
+      CALL MPI_GATHERV(MPI_IN_PLACE,0,MPI_DATATYPE_NULL, &
+                       RECV_USE_LEN(0),RECV_COUNTS(0:N_MPI_PROCESSES-1),RECV_USE_OFF(0:N_MPI_PROCESSES-1), &
+                       MPI_INTEGER,0,MPI_COMM_WORLD,IERR)
+      ! Recompute offset for gather string:
+      RECV_USE_OFF=0
+      DO I=1,N_MPI_PROCESSES-1
+           RECV_USE_OFF(I) = RECV_USE_OFF(I-1) + RECV_USE_LEN(I-1)
+      ENDDO
+      ! Gather strings from all Processes in rank 0:
+      STR_GATHER_LEN = SUM(RECV_USE_LEN(0:N_MPI_PROCESSES-1))
+      ALLOCATE(CHARACTER(LEN=STR_GATHER_LEN)::STR_GATHER); STR_GATHER(1:SMVSTR_USE_LEN)=SMVSTR(1:SMVSTR_USE_LEN)
+      CALL MPI_GATHERV(MPI_IN_PLACE,0,MPI_DATATYPE_NULL, &
+                       STR_GATHER,RECV_USE_LEN(0:N_MPI_PROCESSES-1),RECV_USE_OFF(0:N_MPI_PROCESSES-1), &
+                       MPI_CHARACTER,0,MPI_COMM_WORLD,IERR)
+      ! Process 0 writes SMV file:
+      OPEN(UNIT=LU_SMV,FILE=FN_SMV,FORM='formatted')
+      WRITE(LU_SMV,'(A)') STR_GATHER(1:STR_GATHER_LEN)
+      CLOSE(LU_SMV)
+   ELSE
+      ! Gather string sizes from all Processes in rank 0:
+      CALL MPI_GATHERV(SMVSTR_USE_LEN,1,MPI_INTEGER, &
+                       RECV_USE_LEN(0),RECV_COUNTS(0:N_MPI_PROCESSES-1),RECV_USE_OFF(0:N_MPI_PROCESSES-1), &
+                       MPI_INTEGER,0,MPI_COMM_WORLD,IERR)
+      ! Gather strings from all Processes in rank 0:
+      ALLOCATE(CHARACTER(LEN=1)::STR_GATHER); ! Dummy allocation.
+      CALL MPI_GATHERV(SMVSTR,SMVSTR_USE_LEN,MPI_CHARACTER, &
+                       STR_GATHER,RECV_USE_LEN(0:N_MPI_PROCESSES-1),RECV_USE_OFF(0:N_MPI_PROCESSES-1), &
+                       MPI_CHARACTER,0,MPI_COMM_WORLD,IERR)
+   ENDIF
+   DEALLOCATE(RECV_USE_LEN,RECV_USE_OFF,RECV_COUNTS,STR_GATHER)
+ELSE
+   ! Signle MPI process job : Process 0 writes SMV file.
+   OPEN(UNIT=LU_SMV,FILE=FN_SMV,FORM='formatted')
+   WRITE(LU_SMV,'(A)') SMVSTR(1:SMVSTR_USE_LEN)
+   CLOSE(LU_SMV)
+ENDIF
+
+ENDIF SMV_PARALLEL_WRITE_IF
+
+
 DEALLOCATE(SMVSTR)
 
 CONTAINS

Source/read.f90

@@ -2328,8 +2328,8 @@ SUBROUTINE READ_DUMP
                 NFRAMES,PLOT3D_PART_ID,PLOT3D_QUANTITY,PLOT3D_SPEC_ID,PLOT3D_VELO_INDEX,&
                 RAMP_BNDF,RAMP_CPU,RAMP_CTRL,RAMP_DEVC,RAMP_FLUSH,RAMP_HRR,RAMP_HVAC,RAMP_ISOF,RAMP_MASS,&
                 RAMP_PART,RAMP_PL3D,RAMP_PROF,RAMP_RADF,RAMP_RESTART,RAMP_SLCF,RAMP_SL3D,RAMP_SMOKE3D,&
-                RAMP_SPEC,RAMP_TMP,RAMP_UVW,RENDER_FILE,RESULTS_DIR,SIG_FIGS,SIG_FIGS_EXP,SMOKE3D,STATUS_FILES,&
-                SUPPRESS_DIAGNOSTICS,TURB_INIT_CLOCK,VELOCITY_ERROR_FILE,WRITE_XYZ
+                RAMP_SPEC,RAMP_TMP,RAMP_UVW,RENDER_FILE,RESULTS_DIR,SIG_FIGS,SIG_FIGS_EXP,SMOKE3D,SMV_PARALLEL_WRITE,&
+                STATUS_FILES,SUPPRESS_DIAGNOSTICS,TURB_INIT_CLOCK,VELOCITY_ERROR_FILE,WRITE_XYZ
 
 ! Set defaults