diff --git a/src/base/base_module.f90 b/src/base/base_module.f90 index dba0e5f68..b85547cfd 100644 --- a/src/base/base_module.f90 +++ b/src/base/base_module.f90 @@ -277,4 +277,41 @@ subroutine reset_storage(self) return end subroutine reset_storage + + + subroutine util_exit(code) + !! author: David A. Minton + !! + !! Print termination message and exit program + !! + !! Adapted from David E. Kaufmann's Swifter routine: util_exit.f90 + !! Adapted from Hal Levison's Swift routine util_exit.f + implicit none + ! Arguments + integer(I4B), intent(in) :: code + ! Internals + character(*), parameter :: BAR = '("------------------------------------------------")' + character(*), parameter :: SUCCESS_MSG = '(/, "Normal termination of Swiftest (version ", f3.1, ")")' + character(*), parameter :: FAIL_MSG = '(/, "Terminating Swiftest (version ", f3.1, ") due to error!!")' + character(*), parameter :: USAGE_MSG = '("Usage: swiftest [bs|helio|ra15|rmvs|symba|tu4|whm] [standard|compact|progress|NONE]")' + character(*), parameter :: HELP_MSG = USAGE_MSG + + select case(code) + case(SUCCESS) + write(*, SUCCESS_MSG) VERSION_NUMBER + write(*, BAR) + case(USAGE) + write(*, USAGE_MSG) + case(HELP) + write(*, HELP_MSG) + case default + write(*, FAIL_MSG) VERSION_NUMBER + write(*, BAR) + error stop + end select + + stop + + end subroutine util_exit + end module base diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index c734cb4fa..04fac5524 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -191,7 +191,7 @@ module subroutine collision_netcdf_io_initialize_output(self, param) 667 continue write(*,*) "Error creating fragmentation output file. " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end subroutine collision_netcdf_io_initialize_output diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 03b26bbef..d04a07207 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -283,8 +283,13 @@ module function collision_resolve_merge(system, param, t) result(status) integer(I4B) :: status !! Status flag assigned to this outcome end function collision_resolve_merge - - + module subroutine collision_resolve_mergeaddsub(system, param, t, status) + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions + real(DP), intent(in) :: t !! Time of collision + integer(I4B), intent(in) :: status !! Status flag to assign to adds + end subroutine collision_resolve_mergeaddsub + module subroutine collision_resolve_plpl(self, system, param, t, dt, irec) implicit none diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index 56292a586..ec3f8b67a 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -411,7 +411,7 @@ module subroutine collision_resolve_make_impactors_pl(pl, idx) end subroutine collision_resolve_make_impactors_pl - subroutine collision_resolve_mergeaddsub(system, param, t, status) + module subroutine collision_resolve_mergeaddsub(system, param, t, status) !! author: David A. Minton !! !! Fills the pl_discards and pl_adds with removed and added bodies @@ -638,7 +638,7 @@ subroutine collision_resolve_list(plpl_collision , system, param, t) plpl_collision%status(i) = collision_resolve_merge(system, param, t) case default write(*,*) "Error in swiftest_collision, unrecognized collision regime" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select call collision_history%take_snapshot(param,system, t, "after") call impactors%reset() diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 11d99dfc9..47a341f61 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -215,7 +215,7 @@ module subroutine collision_util_get_energy_momentum(self, system, param, lbefo if (.not.allocated(tmpsys)) then write(*,*) "Error in collision_util_get_energy_momentum. " // & " This must be called with lbefore=.true. at least once before calling it with lbefore=.false." - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end if select type(tmpsys) class is (swiftest_nbody_system) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 1e1baae7c..2f7534b2e 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -146,7 +146,7 @@ module subroutine encounter_netcdf_io_initialize_output(self, param) 667 continue write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end subroutine encounter_netcdf_io_initialize_output diff --git a/src/netcdf_io/netcdf_io_implementations.f90 b/src/netcdf_io/netcdf_io_implementations.f90 index d08771203..d93b3dfb6 100644 --- a/src/netcdf_io/netcdf_io_implementations.f90 +++ b/src/netcdf_io/netcdf_io_implementations.f90 @@ -24,7 +24,7 @@ module subroutine netcdf_io_check(status, call_identifier) if(status /= nf90_noerr) then if (present(call_identifier)) write(*,*) "NetCDF error in ",trim(call_identifier) write(*,*) trim(nf90_strerror(status)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end if return diff --git a/src/rmvs/rmvs_step.f90 b/src/rmvs/rmvs_step.f90 index c6f4bbab1..7c602a20b 100644 --- a/src/rmvs/rmvs_step.f90 +++ b/src/rmvs/rmvs_step.f90 @@ -117,7 +117,7 @@ subroutine rmvs_interp_out(cb, pl, dt) write(*, *) xtmp(:,i) write(*, *) vtmp(:,i) write(*, *) " STOPPING " - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end if end do end if @@ -139,7 +139,7 @@ subroutine rmvs_interp_out(cb, pl, dt) write(*, *) xtmp(:,i) write(*, *) vtmp(:,i) write(*, *) " STOPPING " - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end if end do end if @@ -284,7 +284,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) write(*, *) xtmp(:,i) write(*, *) vtmp(:,i) write(*, *) " STOPPING " - call swiftest_util_exit(failure) + call util_exit(failure) end if end do end if @@ -308,7 +308,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) write(*, *) xtmp(:,i) write(*, *) vtmp(:,i) write(*, *) " STOPPING " - call swiftest_util_exit(failure) + call util_exit(failure) end if end do end if diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index d39eeeddc..79e36e40b 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -39,7 +39,7 @@ module subroutine rmvs_util_append_pl(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class rmvs_pl or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select return @@ -68,7 +68,7 @@ module subroutine rmvs_util_append_tp(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class rmvs_tp or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select return @@ -174,7 +174,7 @@ module subroutine rmvs_util_fill_pl(self, inserts, lfill_list) call whm_util_fill_pl(keeps, inserts, lfill_list) class default write(*,*) "Invalid object passed to the fill method. Source must be of class rmvs_pl or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate @@ -275,7 +275,7 @@ module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) call swiftest_util_fill_tp(keeps, inserts, lfill_list) ! Note: whm_tp does not have its own fill method, so we skip back to the base class class default write(*,*) "Invalid object passed to the fill method. Source must be of class rmvs_tp or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate @@ -482,7 +482,7 @@ module subroutine rmvs_util_spill_pl(self, discards, lspill_list, ldestructive) call whm_util_spill_pl(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class rmvs_pl or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate @@ -513,7 +513,7 @@ module subroutine rmvs_util_spill_tp(self, discards, lspill_list, ldestructive) call swiftest_util_spill_tp(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class rmvs_tp or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate diff --git a/src/swiftest/swiftest_driver.f90 b/src/swiftest/swiftest_driver.f90 index b581cd666..b83583ed4 100644 --- a/src/swiftest/swiftest_driver.f90 +++ b/src/swiftest/swiftest_driver.f90 @@ -166,5 +166,5 @@ program swiftest_driver end associate end associate - call swiftest_util_exit(SUCCESS) + call util_exit(SUCCESS) end program swiftest_driver diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index ac56c5714..0f6dec806 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -179,7 +179,7 @@ module subroutine swiftest_io_conservation_report(self, param, lterminal) param%ioutput = param%ioutput + 1 call self%write_frame(nc, param) call nc%close() - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end if end if end associate @@ -188,7 +188,7 @@ module subroutine swiftest_io_conservation_report(self, param, lterminal) 667 continue write(*,*) "Error writing energy and momentum tracking file: " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end subroutine swiftest_io_conservation_report @@ -219,7 +219,7 @@ module subroutine swiftest_io_dump_param(self, param_file_name) 667 continue write(*,*) "Error opening parameter dump file " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end subroutine swiftest_io_dump_param @@ -329,21 +329,21 @@ module subroutine swiftest_io_get_args(integrator, param_file_name, display_styl do i = 1,narg call get_command_argument(i, arg(i), status = ierr(i)) end do - if (any(ierr /= 0)) call swiftest_util_exit(USAGE) + if (any(ierr /= 0)) call util_exit(USAGE) else - call swiftest_util_exit(USAGE) + call util_exit(USAGE) end if if (narg == 1) then if (arg(1) == '-v' .or. arg(1) == '--version') then call swiftest_util_version() else if (arg(1) == '-h' .or. arg(1) == '--help') then - call swiftest_util_exit(HELP) + call util_exit(HELP) else - call swiftest_util_exit(USAGE) + call util_exit(USAGE) end if else if (narg >= 2) then - call io_toupper(arg(1)) + call swiftest_io_toupper(arg(1)) select case(arg(1)) case('INT_BS') integrator = INT_BS @@ -364,7 +364,7 @@ module subroutine swiftest_io_get_args(integrator, param_file_name, display_styl case default integrator = UNKNOWN_INTEGRATOR write(*,*) trim(adjustl(arg(1))) // ' is not a valid integrator.' - call swiftest_util_exit(USAGE) + call util_exit(USAGE) end select param_file_name = trim(adjustl(arg(2))) end if @@ -372,10 +372,10 @@ module subroutine swiftest_io_get_args(integrator, param_file_name, display_styl if (narg == 2) then display_style = "STANDARD" else if (narg == 3) then - call io_toupper(arg(3)) + call swiftest_io_toupper(arg(3)) display_style = trim(adjustl(arg(3))) else - call swiftest_util_exit(USAGE) + call util_exit(USAGE) end if return @@ -742,7 +742,7 @@ module subroutine swiftest_io_netcdf_initialize_output(self, param) 667 continue write(*,*) "Error creating NetCDF output file. " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end subroutine swiftest_io_netcdf_initialize_output @@ -929,19 +929,19 @@ module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ier if (npl_check /= npl) then write(*,*) "Error reading in NetCDF file: The recorded value of npl does not match the number of active massive bodies" - call swiftest_util_exit(failure) + call util_exit(failure) end if if (ntp_check /= ntp) then write(*,*) "Error reading in NetCDF file: The recorded value of ntp does not match the number of active test particles" - call swiftest_util_exit(failure) + call util_exit(failure) end if if (param%lmtiny_pl) then nplm_check = count(pack(rtemp,plmask) > param%GMTINY ) if (nplm_check /= pl%nplm) then write(*,*) "Error reading in NetCDF file: The recorded value of nplm does not match the number of active fully interacting massive bodies" - call swiftest_util_exit(failure) + call util_exit(failure) end if end if @@ -1760,7 +1760,7 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i ! Read the pair of tokens. The first one is the parameter name, the second is the value. param_name = swiftest_io_get_token(line_trim, ifirst, ilast, iostat) if (param_name == '') cycle ! No parameter name (usually because this line is commented out) - call io_toupper(param_name) + call swiftest_io_toupper(param_name) ifirst = ilast + 1 param_value = swiftest_io_get_token(line_trim, ifirst, ilast, iostat) select case (param_name) @@ -1784,28 +1784,28 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i case ("NC_IN") param%in_netcdf = param_value case ("IN_TYPE") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%in_type = param_value case ("IN_FORM") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%in_form = param_value case ("ISTEP_OUT") read(param_value, *) param%istep_out case ("BIN_OUT") param%outfile = param_value case ("OUT_TYPE") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%out_type = param_value case ("OUT_FORM") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%out_form = param_value case ("OUT_STAT") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%out_stat = param_value case ("DUMP_CADENCE") read(param_value, *, err = 667, iomsg = iomsg) param%dump_cadence case ("CHK_CLOSE") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T') param%lclose = .true. case ("CHK_RMIN") read(param_value, *, err = 667, iomsg = iomsg) param%rmin @@ -1816,7 +1816,7 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i case ("CHK_QMIN") read(param_value, *, err = 667, iomsg = iomsg) param%qmin case ("CHK_QMIN_COORD") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%qmin_coord = param_value case ("CHK_QMIN_RANGE") read(param_value, *, err = 667, iomsg = iomsg) param%qmin_alo @@ -1824,13 +1824,13 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i param_value = swiftest_io_get_token(line, ifirst, ilast, iostat) read(param_value, *, err = 667, iomsg = iomsg) param%qmin_ahi case ("EXTRA_FORCE") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T') param%lextra_force = .true. case ("BIG_DISCARD") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T' ) param%lbig_discard = .true. case ("RHILL_PRESENT") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T' ) param%lrhill_present = .true. case ("MU2KG") read(param_value, *, err = 667, iomsg = iomsg) param%MU2KG @@ -1839,35 +1839,35 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i case ("DU2M") read(param_value, *, err = 667, iomsg = iomsg) param%DU2M case ("ENERGY") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T') param%lenergy = .true. case ("GR") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T') param%lgr = .true. case ("ROTATION") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T') param%lrotation = .true. case ("TIDES") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T') param%ltides = .true. case ("INTERACTION_LOOPS") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%interaction_loops = param_value case ("ENCOUNTER_CHECK_PLPL") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%encounter_check_plpl = param_value case ("ENCOUNTER_CHECK_PLTP") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%encounter_check_pltp = param_value case ("ENCOUNTER_CHECK") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%encounter_check_plpl = param_value param%encounter_check_pltp = param_value case ("FIRSTKICK") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "NO" .or. param_value == 'F') param%lfirstkick = .false. case ("FIRSTENERGY") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "NO" .or. param_value == 'F') param%lfirstenergy = .false. case("EORBIT_ORIG") read(param_value, *, err = 667, iomsg = iomsg) param%Eorbit_orig @@ -1912,14 +1912,14 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i case ("MAXID_COLLISION") read(param_value, *, err = 667, iomsg = iomsg) param%maxid_collision case ("FRAGMENTATION") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "YES" .or. param_value == "T") self%lfragmentation = .true. case ("GMTINY") read(param_value, *) param%GMTINY case ("MIN_GMFRAG") read(param_value, *) param%min_GMfrag case ("ENCOUNTER_SAVE") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) read(param_value, *) param%encounter_save case("SEED") read(param_value, *) nseeds_from_file @@ -2562,7 +2562,7 @@ module subroutine swiftest_io_read_in_cb(self, param) 667 continue write(*,*) "Error reading central body file: " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end subroutine swiftest_io_read_in_cb @@ -2601,7 +2601,7 @@ module subroutine swiftest_io_read_in_system(self, param) end if ierr = self%read_frame(tmp_param%system_history%nc, tmp_param) deallocate(tmp_param) - if (ierr /=0) call swiftest_util_exit(FAILURE) + if (ierr /=0) call util_exit(FAILURE) end if param%loblatecb = ((self%cb%j2rp2 /= 0.0_DP) .or. (self%cb%j4rp4 /= 0.0_DP)) @@ -2715,7 +2715,7 @@ module function swiftest_io_read_frame_body(self, iu, param) result(ierr) class default write(*,*) "Error reading body file: " // trim(adjustl(errmsg)) end select - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end function swiftest_io_read_frame_body @@ -2747,7 +2747,7 @@ module subroutine swiftest_io_read_in_param(self, param_file_name) 667 continue write(self%display_unit,*) "Error reading parameter file: " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end subroutine swiftest_io_read_in_param @@ -2773,7 +2773,7 @@ module subroutine swiftest_io_set_display_param(self, display_style) self%log_output = .true. case default write(*,*) display_style, " is an unknown display style" - call swiftest_util_exit(USAGE) + call util_exit(USAGE) end select self%display_style = display_style @@ -2782,7 +2782,7 @@ module subroutine swiftest_io_set_display_param(self, display_style) 667 continue write(*,*) "Error opening swiftest log file: " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end subroutine swiftest_io_set_display_param @@ -2884,7 +2884,7 @@ module subroutine swiftest_io_write_frame_system(self, param) 667 continue write(*,*) "Error writing system frame: " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end subroutine swiftest_io_write_frame_system end submodule s_io diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index 347096476..8f5eb039d 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -1231,10 +1231,10 @@ module subroutine swiftest_util_dealloc_tp(self) class(swiftest_tp), intent(inout) :: self end subroutine swiftest_util_dealloc_tp - module subroutine swiftest_util_exit(code) + module subroutine util_exit(code) implicit none integer(I4B), intent(in) :: code !! Failure exit code - end subroutine swiftest_util_exit + end subroutine util_exit module subroutine swiftest_util_fill_body(self, inserts, lfill_list) implicit none diff --git a/src/swiftest/swiftest_setup.f90 b/src/swiftest/swiftest_setup.f90 index 6a6439a0e..2e6ff3851 100644 --- a/src/swiftest/swiftest_setup.f90 +++ b/src/swiftest/swiftest_setup.f90 @@ -111,7 +111,7 @@ module subroutine swiftest_setup_construct_system(system, param) write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' case default write(*,*) 'Unkown integrator',param%integrator - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end select diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 8393b1d70..ea7a33bb8 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -293,7 +293,7 @@ module subroutine swiftest_util_append_pl(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_pl or its descendents" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select return @@ -322,7 +322,7 @@ module subroutine swiftest_util_append_tp(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_tp or its descendents" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select return @@ -743,7 +743,6 @@ module subroutine swiftest_util_dealloc_kin(self) end subroutine swiftest_util_dealloc_kin - module subroutine swiftest_util_dealloc_pl(self) !! author: David A. Minton !! @@ -804,42 +803,6 @@ module subroutine swiftest_util_dealloc_tp(self) end subroutine swiftest_util_dealloc_tp - module subroutine swiftest_util_exit(code) - !! author: David A. Minton - !! - !! Print termination message and exit program - !! - !! Adapted from David E. Kaufmann's Swifter routine: util_exit.f90 - !! Adapted from Hal Levison's Swift routine util_exit.f - implicit none - ! Arguments - integer(I4B), intent(in) :: code - ! Internals - character(*), parameter :: BAR = '("------------------------------------------------")' - character(*), parameter :: SUCCESS_MSG = '(/, "Normal termination of Swiftest (version ", f3.1, ")")' - character(*), parameter :: FAIL_MSG = '(/, "Terminating Swiftest (version ", f3.1, ") due to error!!")' - character(*), parameter :: USAGE_MSG = '("Usage: swiftest [bs|helio|ra15|rmvs|symba|tu4|whm] [standard|compact|progress|NONE]")' - character(*), parameter :: HELP_MSG = USAGE_MSG - - select case(code) - case(SUCCESS) - write(*, SUCCESS_MSG) VERSION_NUMBER - write(*, BAR) - case(USAGE) - write(*, USAGE_MSG) - case(HELP) - write(*, HELP_MSG) - case default - write(*, FAIL_MSG) VERSION_NUMBER - write(*, BAR) - error stop - end select - - stop - - end subroutine swiftest_util_exit - - module subroutine swiftest_util_fill_arr_char_string(keeps, inserts, lfill_list) !! author: David A. Minton !! @@ -4204,7 +4167,7 @@ module subroutine swiftest_util_valid_id_system(self, param) if (idarr(i) == idarr(i+1)) then write(*, *) "Swiftest error:" write(*, *) " more than one body/particle has id = ", idarr(i) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end if end do param%maxid = max(param%maxid, maxval(idarr)) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index accb9659b..274dc5279 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -200,7 +200,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) write(*, *) "SWIFTEST Warning:" write(*, *) " In symba_step_recur_system, local time step is too small" write(*, *) " Roundoff error will be important!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) END IF irecp = ireci + 1 if (ireci == 0) then diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index a374f9540..18bbbdfdb 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -32,7 +32,7 @@ module subroutine symba_util_append_pl(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class symba_pl or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select return @@ -60,7 +60,7 @@ module subroutine symba_util_append_tp(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class symba_tp or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select return @@ -136,7 +136,7 @@ module subroutine symba_util_fill_pl(self, inserts, lfill_list) call swiftest_util_fill_pl(keeps, inserts, lfill_list) ! Note: helio_pl does not have its own fill method, so we skip back to the base class class default write(*,*) "Invalid object passed to the fill method. Source must be of class symba_pl or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate @@ -166,7 +166,7 @@ module subroutine symba_util_fill_tp(self, inserts, lfill_list) call swiftest_util_fill_tp(keeps, inserts, lfill_list) ! Note: helio_tp does not have its own fill method, so we skip back to the base class class default write(*,*) "Invalid object passed to the fill method. Source must be of class symba_tp or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate @@ -439,7 +439,7 @@ module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) call swiftest_util_spill_pl(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class symba_pl or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate @@ -471,7 +471,7 @@ module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) call swiftest_util_spill_tp(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class symba_tp or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate diff --git a/src/whm/whm_drift.f90 b/src/whm/whm_drift.f90 index 5565ea8e8..31d041505 100644 --- a/src/whm/whm_drift.f90 +++ b/src/whm/whm_drift.f90 @@ -48,7 +48,7 @@ module subroutine whm_drift_pl(self, system, param, dt) WRITE(*, *) " STOPPING " end if end do - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end if end associate diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index 28c61f437..6ce3ce8df 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -35,7 +35,7 @@ module subroutine whm_util_append_pl(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class whm_pl or its descendents" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select return @@ -87,7 +87,7 @@ module subroutine whm_util_fill_pl(self, inserts, lfill_list) call swiftest_util_fill_pl(keeps, inserts, lfill_list) class default write(*,*) "Invalid object passed to the fill method. Inserts must be of class whm_pl or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate @@ -237,7 +237,7 @@ module subroutine whm_util_spill_pl(self, discards, lspill_list, ldestructive) call swiftest_util_spill_pl(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class whm_pl or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate