diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index 6ce5acf32..613b4df90 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -14,3 +14,5 @@ Phil Tooley Stephan Kuschel Stuart Morris Tom Goffrey +Ujjwal Sinha (Acknowledgement: +Contributions from Ujjwal Sinha was financially supported by the PRACE project funded in part by the EU’s Horizon 2020 Research and Innovation programme (2014-2020) under grant agreement 823767.) diff --git a/README.md b/README.md index caa1afdfb..187cba18d 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,19 @@ +## EPOCH development + +**This is not the official repository for the EPOCH code.** + +This version of EPOCH is being developed within the project PiCKeX- +Particle Kinetic codes for Exascale plasma simulation, which is a +part of Work Package 8 (WP8) of PRACE-6IP. This repository has been +cloned to the Jülich Supercomputing Centre (JSC) GitLab server to +perform and publish this work. The main production version of EPOCH is +maintained by the University of Warwick. The development version found +here might not have the full functionality of the production version of +EPOCH, but includes a performance improved, refactored branch that will +be merged with the official version by the end of the project. + +Current developments include improving the efficiency of the moving window book-keeping, reducing the number MPI calls for the field boundary conditions and the particle boundary conditions. + # *** PLEASE READ THIS NOTE *** If you are obtaining this code from the github server *DO NOT* use the diff --git a/epoch2d/Makefile b/epoch2d/Makefile index fb5f4ee12..b2f37cd86 100644 --- a/epoch2d/Makefile +++ b/epoch2d/Makefile @@ -50,11 +50,11 @@ endif # Intel # ===== ifeq ($(strip $(COMPILER)),intel) - FFLAGS = -O3 -g -stand f03 + FFLAGS = -O3 -g -stand f03 -qopenmp ifeq ($(strip $(CONS)),1) FLTCONS = -pc64 -fltconsistency endif - #FFLAGS = -O3 -heap-arrays 64 -ipo -xHost # Optimised (B) + #FFLAGS = -O3 -heap-arrays 64 -qopt-report-phase=vec -qopt-report=5 -qopenmp # Optimised (B) #FFLAGS = -O3 -heap-arrays 64 -ipo -xAVX # Optimised (W) ifeq ($(strip $(MODE)),debug) FFLAGS = -O0 -fpe0 -nothreads -traceback -fltconsistency \ @@ -554,4 +554,4 @@ tokenizer_blocks.o: tokenizer_blocks.f90 strings.o utilities.o: utilities.f90 constants.o shared_data.o version_data.o: version_data.F90 $(SRCDIR)/COMMIT welcome.o: welcome.F90 shared_data.o terminal_controls.o version_data.o -window.o: window.F90 boundary.o evaluate.o partlist.o +window.o: window.F90 boundary.o evaluate.o partlist.o deck_io_block.o diff --git a/epoch2d/src/boundary.F90 b/epoch2d/src/boundary.F90 index a055479f7..4e847fdbe 100644 --- a/epoch2d/src/boundary.F90 +++ b/epoch2d/src/boundary.F90 @@ -316,6 +316,218 @@ END SUBROUTINE do_field_mpi_with_lengths + SUBROUTINE all_comp_field_bc(fieldx, fieldy, fieldz, ng, nx_local, & + ny_local) + + + ! | field_top | + !____________|____________________|____________ + ! | | + ! field_left | | field_right + !____________|____________________|____________ + ! | | + ! | field_bottom | + + INTEGER, INTENT(IN) :: ng + REAL(num), DIMENSION(1-ng:,1-ng:), INTENT(INOUT) :: fieldx, fieldy, fieldz + INTEGER, INTENT(IN) :: nx_local, ny_local + INTEGER, DIMENSION(c_ndims) :: sizes, subsizes + INTEGER :: basetype, sz, szmax, i, j, k, n + REAL(num), ALLOCATABLE :: field(:) + REAL(num), ALLOCATABLE :: temp(:) + INTEGER :: xmin, xmax, ymin, ymax, offset + + basetype = mpireal + + sizes(1) = nx_local + 2 * ng + sizes(2) = ny_local + 2 * ng + + szmax = 3 * sizes(1) * ng + sz = 3 * sizes(2) * ng + IF (sz > szmax) szmax = sz + + ALLOCATE(temp(szmax)) + ALLOCATE(field(szmax)) + + subsizes(1) = ng + subsizes(2) = sizes(2) + + sz = 3 * subsizes(1) * subsizes(2) + +! offset0 = 0 +! offset1 = subsizes(1) * subsizes(2) +! offset2 = 2 * offset1 + + offset = subsizes(1) * subsizes(2) + + xmin = 1 + xmax = ng + ymin = 1-ng + ymax = subsizes(2)-ng + + CALL load_field_boundaries_to_buffer(fieldx, field, & + xmin, xmax, ymin, ymax, 0*offset) + CALL load_field_boundaries_to_buffer(fieldy, field, & + xmin, xmax, ymin, ymax, offset) + CALL load_field_boundaries_to_buffer(fieldz, field, & + xmin, xmax, ymin, ymax, 2*offset) + + CALL MPI_SENDRECV(field, sz, basetype, proc_x_min, & + tag, temp, sz, basetype, proc_x_max, tag, comm, status, errcode) + + xmin = nx_local + 1 + xmax = subsizes(1) + nx_local + + IF (.NOT. x_max_boundary .OR. bc_field(c_bd_x_max)==c_bc_periodic) THEN + + CALL unload_field_boundaries_from_buffer(fieldx, temp, & + xmin, xmax, ymin, ymax, 0*offset) + CALL unload_field_boundaries_from_buffer(fieldy, temp, & + xmin, xmax, ymin, ymax, offset) + CALL unload_field_boundaries_from_buffer(fieldz, temp, & + xmin, xmax, ymin, ymax, 2*offset) + + END IF + + xmin = nx_local - ng + 1 + xmax = nx_local + + CALL load_field_boundaries_to_buffer(fieldx, field, & + xmin, xmax, ymin, ymax, 0*offset) + CALL load_field_boundaries_to_buffer(fieldy, field, & + xmin, xmax, ymin, ymax, offset) + CALL load_field_boundaries_to_buffer(fieldz, field, & + xmin, xmax, ymin, ymax, 2*offset) + + CALL MPI_SENDRECV(field, sz, basetype, proc_x_max, & + tag, temp, sz, basetype, proc_x_min, tag, comm, status, errcode) + + xmin = 1-ng + xmax = subsizes(1)-ng + + IF (.NOT. x_min_boundary .OR. bc_field(c_bd_x_min)==c_bc_periodic) THEN + + CALL unload_field_boundaries_from_buffer(fieldx, temp, & + xmin, xmax, ymin, ymax, 0*offset) + CALL unload_field_boundaries_from_buffer(fieldy, temp, & + xmin, xmax, ymin, ymax, offset) + CALL unload_field_boundaries_from_buffer(fieldz, temp, & + xmin, xmax, ymin, ymax, 2*offset) + + END IF + + subsizes(1) = sizes(1) + subsizes(2) = ng + sz = 3 * subsizes(1) * subsizes(2) + +! offset0 = 0 +! offset1 = subsizes(1) * subsizes(2) +! offset2 = 2 * offset1 + + offset = subsizes(1) * subsizes(2) + + xmin = 1 - ng + xmax = subsizes(1) - ng + ymin = ny_local - subsizes(2) + 1 + ymax = ny_local + + CALL load_field_boundaries_to_buffer(fieldx, field, & + xmin, xmax, ymin, ymax, 0*offset) + CALL load_field_boundaries_to_buffer(fieldy, field, & + xmin, xmax, ymin, ymax, offset) + CALL load_field_boundaries_to_buffer(fieldz, field, & + xmin, xmax, ymin, ymax, 2*offset) + + CALL MPI_SENDRECV(field, sz, basetype, proc_y_max, & + tag, temp, sz, basetype, proc_y_min, tag, comm, status, errcode) + + ymin = 1 - ng + ymax = subsizes(2) - ng + + IF (.NOT. y_min_boundary .OR. bc_field(c_bd_y_min)==c_bc_periodic) THEN + + CALL unload_field_boundaries_from_buffer(fieldx, temp, & + xmin, xmax, ymin, ymax, 0*offset) + CALL unload_field_boundaries_from_buffer(fieldy, temp, & + xmin, xmax, ymin, ymax, offset) + CALL unload_field_boundaries_from_buffer(fieldz, temp, & + xmin, xmax, ymin, ymax, 2*offset) + + END IF + + ymin = 1 + ymax = subsizes(2) + + CALL load_field_boundaries_to_buffer(fieldx, field, & + xmin, xmax, ymin, ymax, 0*offset) + CALL load_field_boundaries_to_buffer(fieldy, field, & + xmin, xmax, ymin, ymax, offset) + CALL load_field_boundaries_to_buffer(fieldz, field, & + xmin, xmax, ymin, ymax, 2*offset) + + ymin = ny_local + 1 + ymax = subsizes(2) + ny_local + + CALL MPI_SENDRECV(field, sz, basetype, proc_y_min, & + tag, temp, sz, basetype, proc_y_max, tag, comm, status, errcode) + + IF (.NOT. y_max_boundary .OR. bc_field(c_bd_y_max)==c_bc_periodic) THEN + + CALL unload_field_boundaries_from_buffer(fieldx, temp, & + xmin, xmax, ymin, ymax, 0*offset) + CALL unload_field_boundaries_from_buffer(fieldy, temp, & + xmin, xmax, ymin, ymax, offset) + CALL unload_field_boundaries_from_buffer(fieldz, temp, & + xmin, xmax, ymin, ymax, 2*offset) + + END IF + + + DEALLOCATE(field) + DEALLOCATE(temp) + + END SUBROUTINE all_comp_field_bc + + + + SUBROUTINE load_field_boundaries_to_buffer(field, buffer, & + xmin, xmax, ymin, ymax, offset) + + INTEGER, INTENT(IN) :: xmin, xmax, ymin, ymax, offset + REAL(num), DIMENSION(1-ng:, 1-ng:), INTENT(INOUT) :: field + REAL(num), DIMENSION(:), INTENT(INOUT) :: buffer + INTEGER :: i, j, n + + n = 1 + DO j = ymin, ymax + DO i = xmin, xmax + buffer(n + offset) = field(i,j) + n = n + 1 + END DO + END DO + + END SUBROUTINE load_field_boundaries_to_buffer + + SUBROUTINE unload_field_boundaries_from_buffer(field, buffer, & + xmin, xmax, ymin, ymax, offset) + + INTEGER, INTENT(IN) :: xmin, xmax, ymin, ymax, offset + REAL(num), DIMENSION(1-ng:, 1-ng:), INTENT(INOUT) :: field + REAL(num), DIMENSION(:), INTENT(INOUT) :: buffer + INTEGER :: i, j, n + + n = 1 + DO j = ymin, ymax + DO i = xmin, xmax + field(i,j) = buffer(n + offset) + n = n + 1 + END DO + END DO + + END SUBROUTINE unload_field_boundaries_from_buffer + + + SUBROUTINE do_field_mpi_with_lengths_r4(field, ng, nx_local, ny_local) INTEGER, INTENT(IN) :: ng @@ -810,9 +1022,10 @@ SUBROUTINE efield_bcs INTEGER :: i ! These are the MPI boundaries - CALL field_bc(ex, ng) - CALL field_bc(ey, ng) - CALL field_bc(ez, ng) + !CALL field_bc(ex, ng) + !CALL field_bc(ey, ng) + !CALL field_bc(ez, ng) + CALL all_comp_field_bc(ex, ey, ez, ng, nx, ny) ! Perfectly conducting boundaries DO i = c_bd_x_min, c_bd_x_max, c_bd_x_max - c_bd_x_min @@ -861,9 +1074,11 @@ SUBROUTINE bfield_bcs(mpi_only) INTEGER :: i ! These are the MPI boundaries - CALL field_bc(bx, ng) - CALL field_bc(by, ng) - CALL field_bc(bz, ng) + !CALL field_bc(bx, ng) + !CALL field_bc(by, ng) + !CALL field_bc(bz, ng) + CALL all_comp_field_bc(bx, by, bz, ng, nx, ny) + IF (mpi_only) RETURN diff --git a/epoch2d/src/deck/deck_io_block.F90 b/epoch2d/src/deck/deck_io_block.F90 index 2f354e3ca..0db4b5e49 100644 --- a/epoch2d/src/deck/deck_io_block.F90 +++ b/epoch2d/src/deck/deck_io_block.F90 @@ -1010,6 +1010,7 @@ SUBROUTINE init_io_block(io_block) io_block%name = '' io_block%dt_snapshot = -1.0_num io_block%time_prev = 0.0_num + io_block%buffer_time_prev = 0.0_num io_block%time_first = 0.0_num io_block%dt_average = -1.0_num io_block%dt_min_average = -1.0_num @@ -1017,6 +1018,7 @@ SUBROUTINE init_io_block(io_block) io_block%average_time_start = -1.0_num io_block%nstep_snapshot = -1 io_block%nstep_prev = 0 + io_block%buffer_nstep_prev = 0 io_block%nstep_first = 0 io_block%nstep_average = -1 io_block%restart = .FALSE. diff --git a/epoch2d/src/deck/strings.f90 b/epoch2d/src/deck/strings.f90 index 240f4482c..848b95cff 100644 --- a/epoch2d/src/deck/strings.f90 +++ b/epoch2d/src/deck/strings.f90 @@ -323,17 +323,15 @@ END FUNCTION lowercase - FUNCTION trim_string(string) + FUNCTION trim_string(string_in) CHARACTER(LEN=c_max_string_length) :: trim_string - CHARACTER(LEN=*) :: string - CHARACTER(LEN=:), ALLOCATABLE :: string_copy + CHARACTER(LEN=*) :: string_in + CHARACTER(LEN=LEN_TRIM(string_in)) :: string - ALLOCATE(CHARACTER(LEN=LEN(string)) :: string_copy) - - string_copy = ADJUSTL(string) - IF (LEN_TRIM(string_copy) > c_max_string_length) THEN - trim_string = string_copy(1:c_max_string_length) + string = ADJUSTL(string_in) + IF (LEN_TRIM(string) > c_max_string_length) THEN + trim_string = string(1:c_max_string_length) ELSE trim_string = TRIM(string_copy) END IF diff --git a/epoch2d/src/epoch2d.F90 b/epoch2d/src/epoch2d.F90 index a4f91bbcb..6c9eb0e4e 100644 --- a/epoch2d/src/epoch2d.F90 +++ b/epoch2d/src/epoch2d.F90 @@ -152,7 +152,7 @@ PROGRAM pic ELSE time = time + dt / 2.0_num CALL update_eb_fields_final - CALL moving_window + CALL moving_window(step) END IF ELSE dt_store = dt @@ -258,7 +258,8 @@ PROGRAM pic CALL update_eb_fields_final - CALL moving_window + CALL moving_window(step) + END DO IF (rank == 0) runtime = MPI_WTIME() - walltime_started diff --git a/epoch2d/src/housekeeping/current_smooth.F90 b/epoch2d/src/housekeeping/current_smooth.F90 index 3a8ea7cf4..66054bd54 100644 --- a/epoch2d/src/housekeeping/current_smooth.F90 +++ b/epoch2d/src/housekeeping/current_smooth.F90 @@ -30,9 +30,10 @@ SUBROUTINE current_finish CALL current_bcs - CALL field_bc(jx, jng) - CALL field_bc(jy, jng) - CALL field_bc(jz, jng) + !CALL field_bc(jx, jng) + !CALL field_bc(jy, jng) + !CALL field_bc(jz, jng) + CALL all_comp_field_bc(jx, jy, jz, jng, nx, ny) IF (smooth_currents) CALL smooth_current diff --git a/epoch2d/src/housekeeping/setup.F90 b/epoch2d/src/housekeeping/setup.F90 index d81d4e126..da62e148f 100644 --- a/epoch2d/src/housekeeping/setup.F90 +++ b/epoch2d/src/housekeeping/setup.F90 @@ -990,13 +990,17 @@ SUBROUTINE restart_data(step) END IF IF (io_block_list(i)%dt_snapshot > 0.0_num) THEN io_block_list(i)%time_prev = time + io_block_list(i)%buffer_time_prev = time ELSE io_block_list(i)%time_prev = 0.0_num + io_block_list(i)%buffer_time_prev = 0.0_num END IF IF (io_block_list(i)%nstep_snapshot > 0) THEN io_block_list(i)%nstep_prev = step + io_block_list(i)%buffer_nstep_prev = step ELSE io_block_list(i)%nstep_prev = 0 + io_block_list(i)%buffer_nstep_prev = 0 END IF io_block_list(i)%walltime_prev = time IF (ALLOCATED(io_block_list(i)%dump_at_nsteps)) THEN diff --git a/epoch2d/src/housekeeping/window.F90 b/epoch2d/src/housekeeping/window.F90 index 821d43ff7..d1c4faf7f 100644 --- a/epoch2d/src/housekeeping/window.F90 +++ b/epoch2d/src/housekeeping/window.F90 @@ -65,62 +65,87 @@ SUBROUTINE shift_window(window_shift_cells) INTEGER :: iwindow, ix REAL(num) :: xb_min - ! Shift the window round one cell at a time. - ! Inefficient, but it works + ! Shift the window round # of window shift cells at a time. DO iwindow = 1, window_shift_cells - CALL insert_particles + CALL insert_particles(window_shift_cells) - ! Shift the box around - x_grid_min = x_global(1) + dx - xb_min = xb_global(1) + dx - x_min = xb_min + dx * cpml_thickness + x_grid_min = x_global(1) + dx + xb_min = xb_global(1) + dx + x_min = xb_min + dx * cpml_thickness - ! Setup global grid - DO ix = 1-ng, nx_global + ng - x_global(ix) = x_grid_min + (ix - 1) * dx - xb_global(ix) = xb_min + (ix - 1) * dx - END DO - x_grid_max = x_global(nx_global) - x_max = xb_global(nx_global+1) - dx * cpml_thickness + ! Setup global grid + DO ix = 1-ng, nx_global + ng + x_global(ix) = x_grid_min + (ix - 1) * dx + xb_global(ix) = xb_min + (ix - 1) * dx + END DO + x_grid_max = x_global(nx_global) + x_max = xb_global(nx_global+1) - dx * cpml_thickness + END DO - CALL setup_grid_x + CALL setup_grid_x - CALL remove_particles + !CALL remove_particles - ! Shift fields around - CALL shift_fields - END DO + ! Shift fields around + CALL shift_fields(window_shift_cells) END SUBROUTINE shift_window - SUBROUTINE shift_fields + SUBROUTINE shift_fields(window_shift_cells) INTEGER :: j + INTEGER, INTENT(IN) :: window_shift_cells + + CALL shift_field(ex, ng, window_shift_cells) + CALL shift_field(ey, ng, window_shift_cells) + CALL shift_field(ez, ng, window_shift_cells) + + CALL moving_window_field_bc(ex, ey, ez, ng, nx, ny) + + CALL shift_field(bx, ng, window_shift_cells) + CALL shift_field(by, ng, window_shift_cells) + CALL shift_field(bz, ng, window_shift_cells) - CALL shift_field(ex, ng) - CALL shift_field(ey, ng) - CALL shift_field(ez, ng) + CALL moving_window_field_bc(bx, by, bz, ng ,nx, ny) - CALL shift_field(bx, ng) - CALL shift_field(by, ng) - CALL shift_field(bz, ng) + CALL shift_field(jx, jng, window_shift_cells) + CALL shift_field(jy, jng, window_shift_cells) + CALL shift_field(jz, jng, window_shift_cells) - CALL shift_field(jx, jng) - CALL shift_field(jy, jng) - CALL shift_field(jz, jng) + CALL moving_window_field_bc(jx, jy, jz, ng, nx, ny) IF (cpml_boundaries) THEN - CALL shift_field(cpml_psi_eyx, ng) - CALL shift_field(cpml_psi_ezx, ng) - CALL shift_field(cpml_psi_byx, ng) - CALL shift_field(cpml_psi_bzx, ng) - - CALL shift_field(cpml_psi_exy, ng) - CALL shift_field(cpml_psi_ezy, ng) - CALL shift_field(cpml_psi_bxy, ng) - CALL shift_field(cpml_psi_bzy, ng) + CALL shift_field(cpml_psi_eyx, ng, & + window_shift_cells) + CALL shift_field(cpml_psi_ezx, ng, & + window_shift_cells) + CALL shift_field(cpml_psi_byx, ng, & + window_shift_cells) + + CALL moving_window_field_bc(cpml_psi_eyx, & + cpml_psi_ezx, cpml_psi_byx, & + ng, nx, ny) + + CALL shift_field(cpml_psi_bzx, ng, & + window_shift_cells) + + CALL field_bc(cpml_psi_bzx, ng) + + CALL shift_field(cpml_psi_exy, ng, & + window_shift_cells) + CALL shift_field(cpml_psi_ezy, ng, & + window_shift_cells) + CALL shift_field(cpml_psi_bxy, ng, & + window_shift_cells) + CALL moving_window_field_bc(cpml_psi_exy, & + cpml_psi_ezy, cpml_psi_ezy, & + ng, nx, ny) + + CALL shift_field(cpml_psi_bzy, ng, & + window_shift_cells) + CALL field_bc(cpml_psi_bzy, ng) END IF IF (x_max_boundary) THEN @@ -160,31 +185,100 @@ END SUBROUTINE shift_fields - SUBROUTINE shift_field(field, ng) + SUBROUTINE shift_field(field, ng, window_shift_cells) - INTEGER, INTENT(IN) :: ng + INTEGER, INTENT(IN) :: ng, window_shift_cells REAL(num), DIMENSION(1-ng:,1-ng:), INTENT(INOUT) :: field INTEGER :: i, j - ! Shift field to the left by one cell + ! Shift field to the left by window_shift_cells DO j = 1-ng, ny+ng - DO i = 1-ng, nx+ng-1 - field(i,j) = field(i+1,j) + DO i = 1-ng, nx+ng-window_shift_cells + field(i,j) = field(i+window_shift_cells,j) END DO END DO - - CALL field_bc(field, ng) + !CALL field_bc(field, ng) END SUBROUTINE shift_field - SUBROUTINE insert_particles + SUBROUTINE moving_window_field_bc(fieldx, fieldy, fieldz, ng, nx_local, & + ny_local) + + INTEGER, INTENT(IN) :: ng + REAL(num), DIMENSION(1-ng:,1-ng:), INTENT(INOUT) :: fieldx, fieldy, fieldz + INTEGER, INTENT(IN) :: nx_local, ny_local + INTEGER, DIMENSION(c_ndims) :: sizes, subsizes + INTEGER :: basetype, sz, szmax, i, j, k, n + REAL(num), ALLOCATABLE :: field(:) + REAL(num), ALLOCATABLE :: temp(:) + INTEGER :: xmin, xmax, ymin, ymax, offset0, offset1, offset2 + + basetype = mpireal + + sizes(1) = nx_local + 2 * ng + sizes(2) = ny_local + 2 * ng + + szmax = 3 * sizes(1) * ng + sz = 3 * sizes(2) * ng + IF (sz > szmax) szmax = sz + + ALLOCATE(temp(szmax)) + ALLOCATE(field(szmax)) + + subsizes(1) = ng + subsizes(2) = sizes(2) + + sz = 3 * subsizes(1) * subsizes(2) + + offset0 = 0 + offset1 = subsizes(1) * subsizes(2) + offset2 = 2 * offset1 + + xmin = 1 + xmax = ng + ymin = 1-ng + ymax = subsizes(2)-ng + + CALL load_field_boundaries_to_buffer(fieldx, field, & + xmin, xmax, ymin, ymax, offset0) + CALL load_field_boundaries_to_buffer(fieldy, field, & + xmin, xmax, ymin, ymax, offset1) + CALL load_field_boundaries_to_buffer(fieldz, field, & + xmin, xmax, ymin, ymax, offset2) + + CALL MPI_SENDRECV(field, sz, basetype, proc_x_min, & + tag, temp, sz, basetype, proc_x_max, tag, comm, status, errcode) + + xmin = nx_local + 1 + xmax = subsizes(1) + nx_local + + IF (.NOT. x_max_boundary .OR. bc_field(c_bd_x_max)==c_bc_periodic) THEN + + CALL unload_field_boundaries_from_buffer(fieldx, temp, & + xmin, xmax, ymin, ymax, offset0) + CALL unload_field_boundaries_from_buffer(fieldy, temp, & + xmin, xmax, ymin, ymax, offset1) + CALL unload_field_boundaries_from_buffer(fieldz, temp, & + xmin, xmax, ymin, ymax, offset2) + + END IF + + + DEALLOCATE(field) + DEALLOCATE(temp) + + END SUBROUTINE moving_window_field_bc + + + SUBROUTINE insert_particles(window_shift_cells) TYPE(particle), POINTER :: current TYPE(particle_list) :: append_list INTEGER :: ispecies, i, iy, isuby, errcode INTEGER(i8) :: ipart, npart_per_cell, n_frac + INTEGER, INTENT(IN) :: window_shift_cells REAL(num) :: cell_frac_y, cy2 REAL(num), DIMENSION(-1:1) :: gy REAL(num), DIMENSION(c_ndirs) :: temp_local, drift_local @@ -347,11 +441,76 @@ END SUBROUTINE remove_particles - SUBROUTINE moving_window + SUBROUTINE mw_io_test(step, dump) + USE deck_io_block + + INTEGER, INTENT(IN) :: step + LOGICAL, INTENT(OUT) :: dump + INTEGER :: io, is, nstep_next = 0 + REAL(num) :: time0, time1, time_first + + dump = .FALSE. + DO io = 1, n_io_blocks + + time0 = io_block_list(io)%walltime_interval + + ! Work out the time that the next dump will occur based on the + ! current timestep + time0 = HUGE(1.0_num) + time1 = HUGE(1.0_num) + IF (io_block_list(io)%dt_snapshot >= 0.0_num) & + time0 = io_block_list(io)%buffer_time_prev + io_block_list(io)%dt_snapshot + IF (io_block_list(io)%nstep_snapshot >= 0) THEN + nstep_next = io_block_list(io)%buffer_nstep_prev & + + io_block_list(io)%nstep_snapshot + time1 = time + dt * (nstep_next - step) + END IF + + IF (time0 < time1) THEN + ! Next I/O dump based on dt_snapshot + time_first = time0 + IF (io_block_list(io)%dt_snapshot > 0 .AND. (time + dt) >= time0) THEN + ! Store the most recent output time that qualifies + DO + time0 = io_block_list(io)%buffer_time_prev + io_block_list(io)%dt_snapshot + IF (time0 > time) EXIT + io_block_list(io)%buffer_time_prev = time0 + END DO + dump = .TRUE. + END IF + ELSE + ! Next I/O dump based on nstep_snapshot + time_first = time1 + IF (io_block_list(io)%nstep_snapshot > 0 & + .AND. (step + 1) >= nstep_next) THEN + ! Store the most recent output step that qualifies + DO + nstep_next = io_block_list(io)%buffer_nstep_prev & + + io_block_list(io)%nstep_snapshot + IF (nstep_next > step) EXIT + io_block_list(io)%buffer_nstep_prev = nstep_next + END DO + dump = .TRUE. + END IF + END IF + + END DO + + END SUBROUTINE mw_io_test + + + + SUBROUTINE moving_window(step) + USE deck_io_block #ifndef PER_SPECIES_WEIGHT - REAL(num) :: window_shift_real + REAL(num) :: window_shift_real, window_shift_steps INTEGER :: window_shift_cells, errcode = 0 + INTEGER :: i, nremainder + INTEGER, INTENT(IN) :: step + LOGICAL :: dump +! INTEGER :: io, is, nstep_next = 0 +! REAL(num) :: time0, time1, time_first #endif IF (.NOT. move_window) RETURN @@ -376,14 +535,43 @@ SUBROUTINE moving_window IF (window_v_x <= 0.0_num) RETURN window_shift_fraction = window_shift_fraction + dt * window_v_x / dx window_shift_cells = FLOOR(window_shift_fraction) + + CALL mw_io_test(step, dump) + + + IF (window_shift_cells > 0 .AND. window_shift_cells < ng .AND. dump) THEN + + window_shift_real = REAL(window_shift_cells, num) + window_offset = window_offset + window_shift_real * dx + nremainder = MOD(window_shift_cells, ng) +! IF(rank == 0) THEN +! print *, "Performing alignment" +! END IF + CALL shift_window(nremainder) + nremainder = 0 + CALL setup_bc_lists + CALL particle_bcs + window_shift_fraction = window_shift_fraction - window_shift_real & + + REAL(nremainder, num) + END IF + + ! Allow for posibility of having jumped two cells at once - IF (window_shift_cells > 0) THEN + IF (window_shift_cells > ng - 1) THEN + window_shift_real = REAL(window_shift_cells, num) window_offset = window_offset + window_shift_real * dx - CALL shift_window(window_shift_cells) + nremainder = MOD(window_shift_cells, ng) + DO i = ng, window_shift_cells, ng ! CHECK IF THIS LOOP IS CALLED IF window_shift_cells < ng + CALL shift_window(ng) + END DO +! IF(rank == 0 .AND. dump) THEN +! print *, "Auto-aligned output" +! END IF CALL setup_bc_lists CALL particle_bcs - window_shift_fraction = window_shift_fraction - window_shift_real + window_shift_fraction = window_shift_fraction - window_shift_real & + + REAL(nremainder, num) END IF END IF #else diff --git a/epoch2d/src/io/diagnostics.F90 b/epoch2d/src/io/diagnostics.F90 index 1c34a4873..38ab21781 100644 --- a/epoch2d/src/io/diagnostics.F90 +++ b/epoch2d/src/io/diagnostics.F90 @@ -40,6 +40,8 @@ MODULE diagnostics PUBLIC :: cleanup_stop_files, check_for_stop_condition PUBLIC :: deallocate_file_list, count_n_zeros PUBLIC :: build_persistent_subsets + ! Needed for window_sub only + PUBLIC :: io_test, prefix_first_call CHARACTER(LEN=*), PARAMETER :: stop_file = 'STOP' CHARACTER(LEN=*), PARAMETER :: stop_file_nodump = 'STOP_NODUMP' diff --git a/epoch2d/src/particles.F90 b/epoch2d/src/particles.F90 index 473bfb314..4c185b229 100644 --- a/epoch2d/src/particles.F90 +++ b/epoch2d/src/particles.F90 @@ -780,3 +780,4 @@ SUBROUTINE rotate_p(part, cos_theta, phi, part_p) END SUBROUTINE rotate_p END MODULE particles + diff --git a/epoch2d/src/shared_data.F90 b/epoch2d/src/shared_data.F90 index 4e697672e..62902f193 100644 --- a/epoch2d/src/shared_data.F90 +++ b/epoch2d/src/shared_data.F90 @@ -308,7 +308,7 @@ MODULE shared_data TYPE io_block_type CHARACTER(LEN=string_length) :: name - REAL(num) :: dt_snapshot, time_prev, time_first + REAL(num) :: dt_snapshot, time_prev, time_first, buffer_time_prev REAL(num) :: dt_average, dt_min_average, average_time, average_time_start REAL(num) :: time_start, time_stop REAL(num) :: walltime_interval, walltime_prev @@ -316,7 +316,7 @@ MODULE shared_data REAL(num), ALLOCATABLE :: dump_at_times(:) REAL(num), ALLOCATABLE :: dump_at_walltimes(:) INTEGER, ALLOCATABLE :: dump_at_nsteps(:) - INTEGER :: nstep_snapshot, nstep_prev, nstep_first, nstep_average + INTEGER :: nstep_snapshot, nstep_prev, nstep_first, nstep_average, buffer_nstep_prev INTEGER :: nstep_start, nstep_stop, dump_cycle, prefix_index INTEGER :: dump_cycle_first_index LOGICAL :: restart, dump, any_average, dump_first, dump_last @@ -572,6 +572,7 @@ MODULE shared_data INTEGER :: bc_y_min_after_move = c_bc_null INTEGER :: bc_y_max_after_move = c_bc_null REAL(num) :: window_offset +! REAL(num) :: window_shift_fraction #ifdef PHOTONS !---------------------------------------------------------------------------- diff --git a/epoch3d/Makefile b/epoch3d/Makefile index 3f50ec536..8a873ea2f 100644 --- a/epoch3d/Makefile +++ b/epoch3d/Makefile @@ -554,4 +554,4 @@ tokenizer_blocks.o: tokenizer_blocks.f90 strings.o utilities.o: utilities.f90 constants.o shared_data.o version_data.o: version_data.F90 $(SRCDIR)/COMMIT welcome.o: welcome.F90 shared_data.o terminal_controls.o version_data.o -window.o: window.F90 boundary.o evaluate.o partlist.o +window.o: window.F90 boundary.o evaluate.o partlist.o deck_io_block.o diff --git a/epoch3d/src/boundary.F90 b/epoch3d/src/boundary.F90 index 1696f4b96..c4647a141 100644 --- a/epoch3d/src/boundary.F90 +++ b/epoch3d/src/boundary.F90 @@ -469,6 +469,50 @@ END SUBROUTINE do_field_mpi_with_lengths + SUBROUTINE load_field_boundaries_to_buffer(field, buffer, & + xmin, xmax, ymin, ymax, zmin, zmax, offset) + + INTEGER, INTENT(IN) :: xmin, xmax, ymin, ymax, zmin, zmax, offset + REAL(num), DIMENSION(1-ng:,1-ng:,1-ng:), INTENT(INOUT) :: field + REAL(num), DIMENSION(:), INTENT(INOUT) :: buffer + INTEGER :: i,j,k,n + + n = 1 + DO k = zmin, zmax + DO j = ymin, ymax + DO i = xmin, xmax + buffer(n+offset) = field(i,j,k) + n = n+1 + END DO + END DO + END DO + + END SUBROUTINE load_field_boundaries_to_buffer + + + + SUBROUTINE unload_field_boundaries_from_buffer(field, buffer, & + xmin, xmax, ymin, ymax, zmin, zmax, offset) + + INTEGER, INTENT(IN) :: xmin, xmax, ymin, ymax, zmin, zmax, offset + REAL(num), DIMENSION(1-ng:,1-ng:,1-ng:), INTENT(INOUT) :: field + REAL(num), DIMENSION(:), INTENT(INOUT) :: buffer + INTEGER :: i,j,k,n + + n = 1 + DO k = zmin, zmax + DO j = ymin, ymax + DO i = xmin, xmax + field(i,j,k) = buffer(n+offset) + n = n+1 + END DO + END DO + END DO + + END SUBROUTINE unload_field_boundaries_from_buffer + + + SUBROUTINE do_field_mpi_with_lengths_r4(field, ng, nx_local, ny_local, & nz_local) diff --git a/epoch3d/src/deck/deck_io_block.F90 b/epoch3d/src/deck/deck_io_block.F90 index 3907d15fc..5f524ad9a 100644 --- a/epoch3d/src/deck/deck_io_block.F90 +++ b/epoch3d/src/deck/deck_io_block.F90 @@ -1022,6 +1022,7 @@ SUBROUTINE init_io_block(io_block) io_block%name = '' io_block%dt_snapshot = -1.0_num io_block%time_prev = 0.0_num + io_block%buffer_time_prev = 0.0_num io_block%time_first = 0.0_num io_block%dt_average = -1.0_num io_block%dt_min_average = -1.0_num @@ -1029,6 +1030,7 @@ SUBROUTINE init_io_block(io_block) io_block%average_time_start = -1.0_num io_block%nstep_snapshot = -1 io_block%nstep_prev = 0 + io_block%buffer_nstep_prev = 0 io_block%nstep_first = 0 io_block%nstep_average = -1 io_block%restart = .FALSE. diff --git a/epoch3d/src/deck/strings.f90 b/epoch3d/src/deck/strings.f90 index 2b605fbe9..9c1b13741 100644 --- a/epoch3d/src/deck/strings.f90 +++ b/epoch3d/src/deck/strings.f90 @@ -327,17 +327,15 @@ END FUNCTION lowercase - FUNCTION trim_string(string) + FUNCTION trim_string(string_in) CHARACTER(LEN=c_max_string_length) :: trim_string - CHARACTER(LEN=*) :: string - CHARACTER(LEN=:), ALLOCATABLE :: string_copy + CHARACTER(LEN=*) :: string_in + CHARACTER(LEN=LEN_TRIM(string_in)) :: string - ALLOCATE(CHARACTER(LEN=LEN(string)) :: string_copy) - - string_copy = ADJUSTL(string) - IF (LEN_TRIM(string_copy) > c_max_string_length) THEN - trim_string = string_copy(1:c_max_string_length) + string = ADJUSTL(string_in) + IF (LEN_TRIM(string) > c_max_string_length) THEN + trim_string = string(1:c_max_string_length) ELSE trim_string = TRIM(string_copy) END IF diff --git a/epoch3d/src/housekeeping/setup.F90 b/epoch3d/src/housekeeping/setup.F90 index 57bc0db12..e4697025c 100644 --- a/epoch3d/src/housekeeping/setup.F90 +++ b/epoch3d/src/housekeeping/setup.F90 @@ -1060,13 +1060,17 @@ SUBROUTINE restart_data(step) END IF IF (io_block_list(i)%dt_snapshot > 0.0_num) THEN io_block_list(i)%time_prev = time + io_block_list(i)%buffer_time_prev = time ELSE io_block_list(i)%time_prev = 0.0_num + io_block_list(i)%buffer_time_prev = 0.0_num END IF IF (io_block_list(i)%nstep_snapshot > 0) THEN io_block_list(i)%nstep_prev = step + io_block_list(i)%buffer_nstep_prev = step ELSE io_block_list(i)%nstep_prev = 0 + io_block_list(i)%buffer_nstep_prev = 0 END IF io_block_list(i)%walltime_prev = time IF (ALLOCATED(io_block_list(i)%dump_at_nsteps)) THEN diff --git a/epoch3d/src/housekeeping/window.F90 b/epoch3d/src/housekeeping/window.F90 index 57efa48d9..75d0346db 100644 --- a/epoch3d/src/housekeeping/window.F90 +++ b/epoch3d/src/housekeeping/window.F90 @@ -82,50 +82,81 @@ SUBROUTINE shift_window(window_shift_cells) END DO x_grid_max = x_global(nx_global) x_max = xb_global(nx_global+1) - dx * cpml_thickness + END DO CALL setup_grid_x - CALL remove_particles + !CALL remove_particles ! Shift fields around - CALL shift_fields - END DO + CALL shift_fields(window_shift_cells) END SUBROUTINE shift_window - SUBROUTINE shift_fields + SUBROUTINE shift_fields(window_shift_cells) INTEGER :: j, k + INTEGER, INTENT(IN) :: window_shift_cells + + CALL shift_field(ex, ng, window_shift_cells) + CALL shift_field(ey, ng, window_shift_cells) + CALL shift_field(ez, ng, window_shift_cells) + + CALL moving_window_field_bc(ex, ey, ez, ng, nx, ny, nz) - CALL shift_field(ex, ng) - CALL shift_field(ey, ng) - CALL shift_field(ez, ng) + CALL shift_field(bx, ng, window_shift_cells) + CALL shift_field(by, ng, window_shift_cells) + CALL shift_field(bz, ng, window_shift_cells) - CALL shift_field(bx, ng) - CALL shift_field(by, ng) - CALL shift_field(bz, ng) + CALL moving_window_field_bc(bx, by, bz, ng ,nx, ny, nz) - CALL shift_field(jx, jng) - CALL shift_field(jy, jng) - CALL shift_field(jz, jng) + CALL shift_field(jx, jng, window_shift_cells) + CALL shift_field(jy, jng, window_shift_cells) + CALL shift_field(jz, jng, window_shift_cells) + + CALL moving_window_field_bc(jx, jy, jz, ng, nx, ny, nz) IF (cpml_boundaries) THEN - CALL shift_field(cpml_psi_eyx, ng) - CALL shift_field(cpml_psi_ezx, ng) - CALL shift_field(cpml_psi_byx, ng) - CALL shift_field(cpml_psi_bzx, ng) - - CALL shift_field(cpml_psi_exy, ng) - CALL shift_field(cpml_psi_ezy, ng) - CALL shift_field(cpml_psi_bxy, ng) - CALL shift_field(cpml_psi_bzy, ng) - - CALL shift_field(cpml_psi_exz, ng) - CALL shift_field(cpml_psi_eyz, ng) - CALL shift_field(cpml_psi_bxz, ng) - CALL shift_field(cpml_psi_byz, ng) + CALL shift_field(cpml_psi_eyx, ng, window_shift_cells) + CALL shift_field(cpml_psi_ezx, ng, window_shift_cells) + CALL shift_field(cpml_psi_byx, ng, window_shift_cells) + + CALL moving_window_field_bc(cpml_psi_eyx, & + cpml_psi_ezx, cpml_psi_byx, & + ng, nx, ny, nz) + + + CALL shift_field(cpml_psi_bzx, ng, window_shift_cells) + + CALL field_bc(cpml_psi_bzx, ng) + + CALL shift_field(cpml_psi_exy, ng, window_shift_cells) + CALL shift_field(cpml_psi_ezy, ng, window_shift_cells) + CALL shift_field(cpml_psi_bxy, ng, window_shift_cells) + + CALL moving_window_field_bc(cpml_psi_exy, & + cpml_psi_ezy, cpml_psi_ezy, & + ng, nx, ny, nz) + + + CALL shift_field(cpml_psi_bzy, ng, window_shift_cells) + + CALL field_bc(cpml_psi_bzy, ng) + + + CALL shift_field(cpml_psi_exz, ng, window_shift_cells) + CALL shift_field(cpml_psi_eyz, ng, window_shift_cells) + CALL shift_field(cpml_psi_bxz, ng, window_shift_cells) + + CALL moving_window_field_bc(cpml_psi_exz, & + cpml_psi_eyz, cpml_psi_bxz, & + ng, nx, ny, nz) + + CALL shift_field(cpml_psi_byz, ng, window_shift_cells) + + CALL field_bc(cpml_psi_byz, ng) END IF IF (x_max_boundary) THEN @@ -174,27 +205,103 @@ END SUBROUTINE shift_fields - SUBROUTINE shift_field(field, ng) + SUBROUTINE shift_field(field, ng, window_shift_cells) - INTEGER, INTENT(IN) :: ng + INTEGER, INTENT(IN) :: ng, window_shift_cells REAL(num), DIMENSION(1-ng:,1-ng:,1-ng:), INTENT(INOUT) :: field INTEGER :: i, j, k - ! Shift field to the left by one cell + ! Shift field to the left by window_shift_cells cells DO k = 1-ng, nz+ng DO j = 1-ng, ny+ng - DO i = 1-ng, nx+ng-1 - field(i,j,k) = field(i+1,j,k) + DO i = 1-ng, nx+ng-window_shift_cells + field(i,j,k) = field(i+ window_shift_cells,j,k) END DO END DO END DO - CALL field_bc(field, ng) + !CALL field_bc(field, ng) END SUBROUTINE shift_field + SUBROUTINE moving_window_field_bc(fieldx, fieldy, fieldz, ng, nx_local, & + ny_local, nz_local) + + INTEGER, INTENT(IN) :: ng + REAL(num), DIMENSION(1-ng:,1-ng:,1-ng:), INTENT(INOUT) :: fieldx, fieldy, fieldz + INTEGER, INTENT(IN) :: nx_local, ny_local, nz_local + INTEGER, DIMENSION(c_ndims) :: sizes, subsizes + INTEGER :: basetype, sz, szmax, i, j, k, n + REAL(num), ALLOCATABLE :: field(:) + REAL(num), ALLOCATABLE :: temp(:) + INTEGER :: xmin, xmax, ymin, ymax, zmin, zmax, offset0, offset1, offset2 + + basetype = mpireal + + sizes(1) = nx_local + 2 * ng + sizes(2) = ny_local + 2 * ng + sizes(3) = nz_local + 2 * ng + + szmax = 3 * sizes(1) * sizes(2) * ng + sz = 3 * sizes(1) * sizes(3) * ng + IF (sz > szmax) szmax = sz + sz = 3 * sizes(2) * sizes(3) * ng + IF (sz > szmax) szmax = sz + + ALLOCATE(temp(szmax)) + ALLOCATE(field(szmax)) + + subsizes(1) = ng + subsizes(2) = sizes(2) + subsizes(3) = sizes(3) + + sz = 3 * subsizes(1) * subsizes(2) * subsizes(3) + + offset0 = 0 + offset1 = subsizes(1) * subsizes(2) * subsizes(3) + offset2 = 2 * offset1 + + xmin = 1 + xmax = ng + ymin = 1-ng + ymax = subsizes(2)-ng + zmin = 1-ng + zmax = subsizes(3)-ng + + CALL load_field_boundaries_to_buffer(fieldx, field, & + xmin, xmax, ymin, ymax, zmin, zmax, offset0) + CALL load_field_boundaries_to_buffer(fieldy, field, & + xmin, xmax, ymin, ymax, zmin, zmax, offset1) + CALL load_field_boundaries_to_buffer(fieldz, field, & + xmin, xmax, ymin, ymax, zmin, zmax, offset2) + + CALL MPI_SENDRECV(field, sz, basetype, proc_x_min, & + tag, temp, sz, basetype, proc_x_max, tag, comm, status, errcode) + + xmin = nx_local + 1 + xmax = subsizes(1) + nx_local + + IF (.NOT. x_max_boundary .OR. bc_field(c_bd_x_max)==c_bc_periodic) THEN + + CALL unload_field_boundaries_from_buffer(fieldx, temp, & + xmin, xmax, ymin, ymax, zmin, zmax, offset0) + CALL unload_field_boundaries_from_buffer(fieldy, temp, & + xmin, xmax, ymin, ymax, zmin, zmax, offset1) + CALL unload_field_boundaries_from_buffer(fieldz, temp, & + xmin, xmax, ymin, ymax, zmin, zmax, offset2) + + END IF + + + DEALLOCATE(field) + DEALLOCATE(temp) + + END SUBROUTINE moving_window_field_bc + + + SUBROUTINE insert_particles TYPE(particle), POINTER :: current @@ -385,11 +492,74 @@ END SUBROUTINE remove_particles - SUBROUTINE moving_window + SUBROUTINE mw_io_test(step, dump) + USE deck_io_block + + INTEGER, INTENT(IN) :: step + LOGICAL, INTENT(OUT) :: dump + INTEGER :: io, is, nstep_next = 0 + REAL(num) :: time0, time1, time_first + + dump = .FALSE. + DO io = 1, n_io_blocks + + time0 = io_block_list(io)%walltime_interval + + ! Work out the time that the next dump will occur based on the + ! current timestep + time0 = HUGE(1.0_num) + time1 = HUGE(1.0_num) + IF (io_block_list(io)%dt_snapshot >= 0.0_num) & + time0 = io_block_list(io)%buffer_time_prev + io_block_list(io)%dt_snapshot + IF (io_block_list(io)%nstep_snapshot >= 0) THEN + nstep_next = io_block_list(io)%buffer_nstep_prev & + + io_block_list(io)%nstep_snapshot + time1 = time + dt * (nstep_next - step) + END IF + + IF (time0 < time1) THEN + ! Next I/O dump based on dt_snapshot + time_first = time0 + IF (io_block_list(io)%dt_snapshot > 0 .AND. (time + dt) >= time0) THEN + ! Store the most recent output time that qualifies + DO + time0 = io_block_list(io)%buffer_time_prev + io_block_list(io)%dt_snapshot + IF (time0 > time) EXIT + io_block_list(io)%buffer_time_prev = time0 + END DO + dump = .TRUE. + END IF + ELSE + ! Next I/O dump based on nstep_snapshot + time_first = time1 + IF (io_block_list(io)%nstep_snapshot > 0 & + .AND. (step + 1) >= nstep_next) THEN + ! Store the most recent output step that qualifies + DO + nstep_next = io_block_list(io)%buffer_nstep_prev & + + io_block_list(io)%nstep_snapshot + IF (nstep_next > step) EXIT + io_block_list(io)%buffer_nstep_prev = nstep_next + END DO + dump = .TRUE. + END IF + END IF + + END DO + + END SUBROUTINE mw_io_test + + + + SUBROUTINE moving_window(step) + USE deck_io_block #ifndef PER_SPECIES_WEIGHT REAL(num) :: window_shift_real INTEGER :: window_shift_cells, errcode = 0 + INTEGER :: i, nremainder + INTEGER, INTENT(IN) :: step + LOGICAL :: dump #endif IF (.NOT. move_window) RETURN @@ -416,14 +586,38 @@ SUBROUTINE moving_window IF (window_v_x <= 0.0_num) RETURN window_shift_fraction = window_shift_fraction + dt * window_v_x / dx window_shift_cells = FLOOR(window_shift_fraction) + + CALL mw_io_test(step, dump) + + + IF (window_shift_cells > 0 .AND. window_shift_cells < ng .AND. dump) THEN + + window_shift_real = REAL(window_shift_cells, num) + window_offset = window_offset + window_shift_real * dx + nremainder = MOD(window_shift_cells, ng) +! IF(rank == 0) THEN +! print *, "Performing alignment" +! END IF + CALL shift_window(nremainder) + nremainder = 0 + CALL setup_bc_lists + CALL particle_bcs + window_shift_fraction = window_shift_fraction - window_shift_real & + + REAL(nremainder, num) + END IF + ! Allow for posibility of having jumped two cells at once - IF (window_shift_cells > 0) THEN + IF (window_shift_cells > ng - 1) THEN window_shift_real = REAL(window_shift_cells, num) window_offset = window_offset + window_shift_real * dx - CALL shift_window(window_shift_cells) + nremainder = MOD(window_shift_cells, ng) + DO i = ng, window_shift_cells, ng + CALL shift_window(ng) + END DO CALL setup_bc_lists CALL particle_bcs - window_shift_fraction = window_shift_fraction - window_shift_real + window_shift_fraction = window_shift_fraction - window_shift_real & + + REAL(nremainder, num) END IF END IF #else diff --git a/epoch3d/src/shared_data.F90 b/epoch3d/src/shared_data.F90 index 03bfb8830..84dddde0b 100644 --- a/epoch3d/src/shared_data.F90 +++ b/epoch3d/src/shared_data.F90 @@ -309,7 +309,7 @@ MODULE shared_data TYPE io_block_type CHARACTER(LEN=string_length) :: name - REAL(num) :: dt_snapshot, time_prev, time_first + REAL(num) :: dt_snapshot, time_prev, time_first, buffer_time_prev REAL(num) :: dt_average, dt_min_average, average_time, average_time_start REAL(num) :: time_start, time_stop REAL(num) :: walltime_interval, walltime_prev @@ -317,7 +317,7 @@ MODULE shared_data REAL(num), ALLOCATABLE :: dump_at_times(:) REAL(num), ALLOCATABLE :: dump_at_walltimes(:) INTEGER, ALLOCATABLE :: dump_at_nsteps(:) - INTEGER :: nstep_snapshot, nstep_prev, nstep_first, nstep_average + INTEGER :: nstep_snapshot, nstep_prev, nstep_first, nstep_average, buffer_nstep_prev INTEGER :: nstep_start, nstep_stop, dump_cycle, prefix_index INTEGER :: dump_cycle_first_index LOGICAL :: restart, dump, any_average, dump_first, dump_last @@ -594,6 +594,7 @@ MODULE shared_data INTEGER :: bc_z_min_after_move = c_bc_null INTEGER :: bc_z_max_after_move = c_bc_null REAL(num) :: window_offset +! REAL(num) :: window_shift_fraction #ifdef PHOTONS !----------------------------------------------------------------------------