diff --git a/SDF b/SDF index 330c692e7..4c895c7fe 160000 --- a/SDF +++ b/SDF @@ -1 +1 @@ -Subproject commit 330c692e7c89efe75c4b396b8fa877409e4dc220 +Subproject commit 4c895c7fe848f27aa47da2787b26b5e470f0da0c diff --git a/epoch1d/src/epoch1d.F90 b/epoch1d/src/epoch1d.F90 index d1fc5f3e2..b1a67fcc3 100644 --- a/epoch1d/src/epoch1d.F90 +++ b/epoch1d/src/epoch1d.F90 @@ -138,7 +138,7 @@ PROGRAM pic END DO ! .TRUE. to over_ride balance fraction check - IF (npart_global > 0) CALL balance_workload(.TRUE.) + IF (npart_global > 0 .AND. use_pre_balance) CALL balance_workload(.TRUE.) IF (use_current_correction) CALL calc_initial_current CALL setup_bc_lists diff --git a/epoch1d/src/io/diagnostics.F90 b/epoch1d/src/io/diagnostics.F90 index e547ed74b..d6eb62088 100644 --- a/epoch1d/src/io/diagnostics.F90 +++ b/epoch1d/src/io/diagnostics.F90 @@ -874,7 +874,7 @@ SUBROUTINE output_routines(step, force_write) ! step = step index END IF #ifndef NO_PARTICLE_PROBES - IF (IAND(iomask(c_dump_probes), code) /= 0) THEN + IF (IAND(iomask(c_dump_probes), code) /= 0 .OR. restart_flag) THEN CALL write_probes(sdf_handle, code, iomask(c_dump_probes)) END IF #endif diff --git a/epoch1d/src/parser/evaluator_blocks.F90 b/epoch1d/src/parser/evaluator_blocks.F90 index 9ff7a54ee..b40f37b8c 100644 --- a/epoch1d/src/parser/evaluator_blocks.F90 +++ b/epoch1d/src/parser/evaluator_blocks.F90 @@ -195,7 +195,7 @@ SUBROUTINE do_constant(opcode, simplify, parameters, err) IF (opcode == c_const_xb) THEN IF (parameters%use_grid_position) THEN - CALL push_on_eval(xb(parameters%pack_ix)) + CALL push_on_eval(xb(parameters%pack_ix) + dx) ELSE CALL push_on_eval(parameters%pack_pos) END IF diff --git a/epoch2d/src/epoch2d.F90 b/epoch2d/src/epoch2d.F90 index a9f7f9704..273525b53 100644 --- a/epoch2d/src/epoch2d.F90 +++ b/epoch2d/src/epoch2d.F90 @@ -138,7 +138,7 @@ PROGRAM pic END DO ! .TRUE. to over_ride balance fraction check - IF (npart_global > 0) CALL balance_workload(.TRUE.) + IF (npart_global > 0 .AND. use_pre_balance) CALL balance_workload(.TRUE.) IF (use_current_correction) CALL calc_initial_current CALL setup_bc_lists diff --git a/epoch2d/src/io/diagnostics.F90 b/epoch2d/src/io/diagnostics.F90 index ba2aad54a..c82a4e088 100644 --- a/epoch2d/src/io/diagnostics.F90 +++ b/epoch2d/src/io/diagnostics.F90 @@ -906,7 +906,7 @@ SUBROUTINE output_routines(step, force_write) ! step = step index END IF #ifndef NO_PARTICLE_PROBES - IF (IAND(iomask(c_dump_probes), code) /= 0) THEN + IF (IAND(iomask(c_dump_probes), code) /= 0 .OR. restart_flag) THEN CALL write_probes(sdf_handle, code, iomask(c_dump_probes)) END IF #endif diff --git a/epoch2d/src/parser/evaluator_blocks.F90 b/epoch2d/src/parser/evaluator_blocks.F90 index fc5b9b4ef..e7dccbd30 100644 --- a/epoch2d/src/parser/evaluator_blocks.F90 +++ b/epoch2d/src/parser/evaluator_blocks.F90 @@ -195,7 +195,7 @@ SUBROUTINE do_constant(opcode, simplify, parameters, err) IF (opcode == c_const_xb) THEN IF (parameters%use_grid_position) THEN - CALL push_on_eval(xb(parameters%pack_ix)) + CALL push_on_eval(xb(parameters%pack_ix) + dx) ELSE CALL push_on_eval(parameters%pack_pos(1)) END IF @@ -221,7 +221,7 @@ SUBROUTINE do_constant(opcode, simplify, parameters, err) IF (opcode == c_const_yb) THEN IF (parameters%use_grid_position) THEN - CALL push_on_eval(yb(parameters%pack_iy)) + CALL push_on_eval(yb(parameters%pack_iy) + dy) ELSE CALL push_on_eval(parameters%pack_pos(2)) END IF diff --git a/epoch2d/src/physics_packages/file_injectors.F90 b/epoch2d/src/physics_packages/file_injectors.F90 index c91ae219d..d61bf80b7 100644 --- a/epoch2d/src/physics_packages/file_injectors.F90 +++ b/epoch2d/src/physics_packages/file_injectors.F90 @@ -235,6 +235,7 @@ SUBROUTINE run_file_injection(injector) REAL(num) :: next_time, time_to_bdy REAL(num) :: vx, vy, gamma, inv_gamma_mass, iabs_p REAL(num) :: x_start, y_start + REAL(num) :: low_in, high_in TYPE(particle), POINTER :: new TYPE(particle_list) :: plist LOGICAL :: no_particles_added, skip_processor @@ -375,13 +376,25 @@ SUBROUTINE run_file_injection(injector) ! particle IF (boundary == c_bd_x_min .OR. boundary == c_bd_x_max) THEN ! Skip all processors which are at the wrong y position - IF (y_in <= y_min_local .OR. y_in > y_max_local) THEN + low_in = y_grid_mins(y_coords) - 0.5_num * dy + IF (y_coords == nprocy-1) THEN + high_in = y_grid_maxs(y_coords) + 0.5_num * dy + ELSE + high_in = y_grid_mins(y_coords+1) - 0.5_num * dy + END IF + IF (y_in <= low_in .OR. y_in > high_in) THEN skip_processor = .TRUE. END IF ELSE IF (boundary == c_bd_y_min .OR. boundary == c_bd_y_max) THEN ! Skip all processors which are at the wrong x position - IF (x_in <= x_min_local .OR. x_in > x_max_local) THEN + low_in = x_grid_mins(x_coords) - 0.5_num * dx + IF (x_coords == nprocx-1) THEN + high_in = x_grid_maxs(x_coords) + 0.5_num * dx + ELSE + high_in = x_grid_mins(x_coords+1) - 0.5_num * dx + END IF + IF (x_in <= low_in .OR. x_in > high_in) THEN skip_processor = .TRUE. END IF END IF diff --git a/epoch3d/src/epoch3d.F90 b/epoch3d/src/epoch3d.F90 index 3dddbd0ed..6e2b05668 100644 --- a/epoch3d/src/epoch3d.F90 +++ b/epoch3d/src/epoch3d.F90 @@ -138,7 +138,7 @@ PROGRAM pic END DO ! .TRUE. to over_ride balance fraction check - IF (npart_global > 0) CALL balance_workload(.TRUE.) + IF (npart_global > 0 .AND. use_pre_balance) CALL balance_workload(.TRUE.) IF (use_current_correction) CALL calc_initial_current CALL setup_bc_lists diff --git a/epoch3d/src/io/diagnostics.F90 b/epoch3d/src/io/diagnostics.F90 index ec4c64066..3a277df33 100644 --- a/epoch3d/src/io/diagnostics.F90 +++ b/epoch3d/src/io/diagnostics.F90 @@ -940,7 +940,7 @@ SUBROUTINE output_routines(step, force_write) ! step = step index END IF #ifndef NO_PARTICLE_PROBES - IF (IAND(iomask(c_dump_probes), code) /= 0) THEN + IF (IAND(iomask(c_dump_probes), code) /= 0 .OR. restart_flag) THEN CALL write_probes(sdf_handle, code, iomask(c_dump_probes)) END IF #endif diff --git a/epoch3d/src/parser/evaluator_blocks.F90 b/epoch3d/src/parser/evaluator_blocks.F90 index cc968c31d..082059a87 100644 --- a/epoch3d/src/parser/evaluator_blocks.F90 +++ b/epoch3d/src/parser/evaluator_blocks.F90 @@ -195,7 +195,7 @@ SUBROUTINE do_constant(opcode, simplify, parameters, err) IF (opcode == c_const_xb) THEN IF (parameters%use_grid_position) THEN - CALL push_on_eval(xb(parameters%pack_ix)) + CALL push_on_eval(xb(parameters%pack_ix) + dx) ELSE CALL push_on_eval(parameters%pack_pos(1)) END IF @@ -221,7 +221,7 @@ SUBROUTINE do_constant(opcode, simplify, parameters, err) IF (opcode == c_const_yb) THEN IF (parameters%use_grid_position) THEN - CALL push_on_eval(yb(parameters%pack_iy)) + CALL push_on_eval(yb(parameters%pack_iy) + dy) ELSE CALL push_on_eval(parameters%pack_pos(2)) END IF @@ -247,7 +247,7 @@ SUBROUTINE do_constant(opcode, simplify, parameters, err) IF (opcode == c_const_zb) THEN IF (parameters%use_grid_position) THEN - CALL push_on_eval(zb(parameters%pack_iz)) + CALL push_on_eval(zb(parameters%pack_iz) + dz) ELSE CALL push_on_eval(parameters%pack_pos(3)) END IF diff --git a/epoch3d/src/physics_packages/file_injectors.F90 b/epoch3d/src/physics_packages/file_injectors.F90 index 05fbc2836..b83857572 100644 --- a/epoch3d/src/physics_packages/file_injectors.F90 +++ b/epoch3d/src/physics_packages/file_injectors.F90 @@ -256,6 +256,7 @@ SUBROUTINE run_file_injection(injector) REAL(num) :: next_time, time_to_bdy REAL(num) :: vx, vy, vz, gamma, inv_gamma_mass, iabs_p REAL(num) :: x_start, y_start, z_start + REAL(num) :: low_in, high_in TYPE(particle), POINTER :: new TYPE(particle_list) :: plist LOGICAL :: no_particles_added, skip_processor @@ -419,31 +420,67 @@ SUBROUTINE run_file_injection(injector) ! particle IF (boundary == c_bd_x_min .OR. boundary == c_bd_x_max) THEN ! Skip all processors which are at the wrong y position - IF (y_in <= y_min_local .OR. y_in > y_max_local) THEN + low_in = y_grid_mins(y_coords) - 0.5_num * dy + IF (y_coords == nprocy-1) THEN + high_in = y_grid_maxs(y_coords) + 0.5_num * dy + ELSE + high_in = y_grid_mins(y_coords+1) - 0.5_num * dy + END IF + IF (y_in <= low_in .OR. y_in > high_in) THEN skip_processor = .TRUE. END IF ! Skip all processors which are at the wrong z position - IF (z_in <= z_min_local .OR. z_in > z_max_local) THEN + low_in = z_grid_mins(z_coords) - 0.5_num * dz + IF (z_coords == nprocz-1) THEN + high_in = z_grid_maxs(z_coords) + 0.5_num * dz + ELSE + high_in = z_grid_mins(z_coords+1) - 0.5_num * dz + END IF + IF (z_in <= low_in .OR. z_in > high_in) THEN skip_processor = .TRUE. END IF ELSE IF (boundary == c_bd_y_min .OR. boundary == c_bd_y_max) THEN ! Skip all processors which are at the wrong x position - IF (x_in <= x_min_local .OR. x_in > x_max_local) THEN + low_in = x_grid_mins(x_coords) - 0.5_num * dx + IF (x_coords == nprocx-1) THEN + high_in = x_grid_maxs(x_coords) + 0.5_num * dx + ELSE + high_in = x_grid_mins(x_coords+1) - 0.5_num * dx + END IF + IF (x_in <= low_in .OR. x_in > high_in) THEN skip_processor = .TRUE. END IF ! Skip all processors which are at the wrong z position - IF (z_in <= z_min_local .OR. z_in > z_max_local) THEN + low_in = z_grid_mins(z_coords) - 0.5_num * dz + IF (z_coords == nprocz-1) THEN + high_in = z_grid_maxs(z_coords) + 0.5_num * dz + ELSE + high_in = z_grid_mins(z_coords+1) - 0.5_num * dz + END IF + IF (z_in <= low_in .OR. z_in > high_in) THEN skip_processor = .TRUE. END IF ELSE IF (boundary == c_bd_z_min .OR. boundary == c_bd_z_max) THEN ! Skip all processors which are at the wrong x position - IF (x_in <= x_min_local .OR. x_in > x_max_local) THEN + low_in = x_grid_mins(x_coords) - 0.5_num * dx + IF (x_coords == nprocx-1) THEN + high_in = x_grid_maxs(x_coords) + 0.5_num * dx + ELSE + high_in = x_grid_mins(x_coords+1) - 0.5_num * dx + END IF + IF (x_in <= low_in .OR. x_in > high_in) THEN skip_processor = .TRUE. END IF ! Skip all processors which are at the wrong y position - IF (y_in <= y_min_local .OR. y_in > y_max_local) THEN + low_in = y_grid_mins(y_coords) - 0.5_num * dy + IF (y_coords == nprocy-1) THEN + high_in = y_grid_maxs(y_coords) + 0.5_num * dy + ELSE + high_in = y_grid_mins(y_coords+1) - 0.5_num * dy + END IF + IF (y_in <= low_in .OR. y_in > high_in) THEN skip_processor = .TRUE. END IF