diff --git a/Makefile.Defines b/Makefile.Defines index 443284a86..c943d55d5 100644 --- a/Makefile.Defines +++ b/Makefile.Defines @@ -45,10 +45,7 @@ COLLRESOLVE_HOME = $(ROOT_DIR)/collresolve/ # DO NOT include in FFLAGS the "-c" option to compile object only # this is done explicitly as needed in the Makefile -ADVIXE_DIR = /apps/cent7/intel/advisor_2019 ADVIXE_FLAGS = -g -O2 -qopt-report=5 -vecabi=cmdtarget -simd -shared-intel -debug inline-debug-info -DTBB_DEBUG -DTBB_USE_THREADING_TOOLS -xhost -traceback - -VTUNE_FLAGS = -g -O2 -qopt-report=5 -simd -shared-intel -qopenmp -debug inline-debug-info -parallel-source-info=2 -parallel -DTBB_DEBUG -DTBB_USE_THREADING_TOOLS -qopenmp -fp-model no-except -mp1 -xhost -traceback #Be sure to set the environment variable KMP_FORKJOIN_FRAMES=1 for OpenMP debuging in vtune IDEBUG = -O0 -init=snan,arrays -nogen-interfaces -no-pie -no-ftz -fpe-all=0 -g -traceback -mp1 -fp-model strict -fpe0 -debug all -align all -pad -ip -prec-div -prec-sqrt -assume protect-parens -CB -no-wrap-margin diff --git a/src/io/io.f90 b/src/io/io.f90 index 62e77e38b..ebdd68531 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -2151,7 +2151,6 @@ module subroutine io_write_frame_system(self, param) errmsg = param%outfile // " not found! You must specify OUT_STAT = NEW, REPLACE, or UNKNOWN" goto 667 end if - call param%nciu%open(param) case('NEW') if (fileExists) then errmsg = param%outfile // " Alread Exists! You must specify OUT_STAT = APPEND, REPLACE, or UNKNOWN" diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 5fdb43c8b..d4e1f2dc8 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -123,6 +123,8 @@ program swiftest_driver end do end associate + call nbody_system%dealloc() + call util_exit(SUCCESS) stop diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 9ad4e38be..b99188855 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -457,7 +457,6 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) integer(I4B) :: ierr !! Error code: returns 0 if the read is successful ! Internals integer(I4B) :: dim, i, j, tslot, idmax, npl_check, ntp_check - character(len=:), allocatable :: charstring real(DP), dimension(:), allocatable :: rtemp integer(I4B), dimension(:), allocatable :: itemp logical, dimension(:), allocatable :: validmask, tpmask, plmask @@ -650,8 +649,6 @@ module subroutine netcdf_read_hdr_system(self, iu, param) tslot = int(param%ioutput, kind=I4B) + 1 - call check( nf90_open(param%outfile, NF90_NOWRITE, iu%ncid) ) - call check( nf90_get_var(iu%ncid, iu%time_varid, param%t, start=[tslot]) ) call check( nf90_get_var(iu%ncid, iu%npl_varid, self%pl%nbody, start=[tslot]) ) call check( nf90_get_var(iu%ncid, iu%ntp_varid, self%tp%nbody, start=[tslot]) ) @@ -690,10 +687,7 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma logical, dimension(:), intent(in) :: plmask !! Logical array indicating which index values belong to massive bodies logical, dimension(:), intent(in) :: tpmask !! Logical array indicating which index values belong to test particles ! Internals - integer(I4B) :: i, j, tslot, strlen, idslot, old_mode, idmax - character(len=:), allocatable :: charstring - character(len=NAMELEN) :: emptystr, lenstr - character(len=:), allocatable :: fmtlabel + integer(I4B) :: i, j, tslot, idslot, old_mode, idmax real(DP), dimension(:), allocatable :: rtemp real(DP), dimension(:,:), allocatable :: rtemp_arr integer(I4B), dimension(:), allocatable :: itemp @@ -701,10 +695,6 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma integer(I4B), dimension(:), allocatable :: plind, tpind ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables - write(lenstr, *) NAMELEN - fmtlabel = "(A" // trim(adjustl(lenstr)) // ")" - write(emptystr, fmtlabel) " " - idmax = size(plmask) allocate(rtemp(idmax)) allocate(rtemp_arr(NDIM,idmax)) @@ -873,9 +863,8 @@ module subroutine netcdf_write_frame_base(self, iu, param) class(netcdf_parameters), intent(inout) :: iu !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: i, j, tslot, strlen, idslot, old_mode + integer(I4B) :: i, j, tslot, idslot, old_mode integer(I4B), dimension(:), allocatable :: ind - character(len=:), allocatable :: charstring call self%write_particle_info(iu, param) @@ -987,17 +976,12 @@ module subroutine netcdf_write_particle_info_base(self, iu, param) class(netcdf_parameters), intent(inout) :: iu !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: i, j, tslot, strlen, idslot, old_mode + integer(I4B) :: i, j, tslot, idslot, old_mode integer(I4B), dimension(:), allocatable :: ind - character(len=:), allocatable :: charstring - character(len=NAMELEN) :: emptystr, lenstr - character(len=:), allocatable :: fmtlabel + character(len=NAMELEN) :: charstring ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables call check( nf90_set_fill(iu%ncid, nf90_nofill, old_mode) ) - write(lenstr, *) NAMELEN - fmtlabel = "(A" // trim(adjustl(lenstr)) // ")" - write(emptystr, fmtlabel) " " select type(self) class is (swiftest_body) @@ -1011,25 +995,17 @@ module subroutine netcdf_write_particle_info_base(self, iu, param) call check( nf90_put_var(iu%ncid, iu%id_varid, self%id(j), start=[idslot]) ) charstring = trim(adjustl(self%info(j)%name)) - strlen = len(charstring) - call check( nf90_put_var(iu%ncid, iu%name_varid, emptystr, start=[1, idslot], count=[NAMELEN, 1]) ) - call check( nf90_put_var(iu%ncid, iu%name_varid, charstring, start=[1, idslot], count=[strlen, 1]) ) + call check( nf90_put_var(iu%ncid, iu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]) ) charstring = trim(adjustl(self%info(j)%particle_type)) - strlen = len(charstring) - call check( nf90_put_var(iu%ncid, iu%ptype_varid, emptystr, start=[1, idslot], count=[NAMELEN, 1]) ) - call check( nf90_put_var(iu%ncid, iu%ptype_varid, charstring, start=[1, idslot], count=[strlen, 1]) ) + call check( nf90_put_var(iu%ncid, iu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]) ) charstring = trim(adjustl(self%info(j)%status)) - strlen = len(charstring) - call check( nf90_put_var(iu%ncid, iu%status_varid, emptystr, start=[1, idslot], count=[NAMELEN, 1]) ) - call check( nf90_put_var(iu%ncid, iu%status_varid, charstring, start=[1, idslot], count=[strlen, 1]) ) + call check( nf90_put_var(iu%ncid, iu%status_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]) ) if (param%lclose) then charstring = trim(adjustl(self%info(j)%origin_type)) - strlen = len(charstring) - call check( nf90_put_var(iu%ncid, iu%origin_type_varid, emptystr, start=[1, idslot], count=[NAMELEN, 1]) ) - call check( nf90_put_var(iu%ncid, iu%origin_type_varid, charstring, start=[1, idslot], count=[strlen, 1]) ) + call check( nf90_put_var(iu%ncid, iu%origin_type_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]) ) call check( nf90_put_var(iu%ncid, iu%origin_time_varid, self%info(j)%origin_time, start=[idslot]) ) call check( nf90_put_var(iu%ncid, iu%origin_xhx_varid, self%info(j)%origin_xh(1), start=[idslot]) ) call check( nf90_put_var(iu%ncid, iu%origin_xhy_varid, self%info(j)%origin_xh(2), start=[idslot]) ) @@ -1056,25 +1032,17 @@ module subroutine netcdf_write_particle_info_base(self, iu, param) call check( nf90_put_var(iu%ncid, iu%id_varid, self%id, start=[idslot]) ) charstring = trim(adjustl(self%info%name)) - strlen = len(charstring) - call check( nf90_put_var(iu%ncid, iu%name_varid, emptystr, start=[1, idslot], count=[NAMELEN, 1]) ) - call check( nf90_put_var(iu%ncid, iu%name_varid, charstring, start=[1, idslot], count=[strlen, 1]) ) + call check( nf90_put_var(iu%ncid, iu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]) ) charstring = trim(adjustl(self%info%particle_type)) - strlen = len(charstring) - call check( nf90_put_var(iu%ncid, iu%ptype_varid, emptystr, start=[1, idslot], count=[NAMELEN, 1]) ) - call check( nf90_put_var(iu%ncid, iu%ptype_varid, charstring, start=[1, idslot], count=[strlen, 1]) ) + call check( nf90_put_var(iu%ncid, iu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]) ) charstring = trim(adjustl(self%info%status)) - strlen = len(charstring) - call check( nf90_put_var(iu%ncid, iu%status_varid, emptystr, start=[1, idslot], count=[NAMELEN, 1]) ) - call check( nf90_put_var(iu%ncid, iu%status_varid, charstring, start=[1, idslot], count=[strlen, 1]) ) + call check( nf90_put_var(iu%ncid, iu%status_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]) ) if (param%lclose) then charstring = trim(adjustl(self%info%origin_type)) - strlen = len(charstring) - call check( nf90_put_var(iu%ncid, iu%origin_type_varid, emptystr, start=[1, idslot], count=[NAMELEN, 1]) ) - call check( nf90_put_var(iu%ncid, iu%origin_type_varid, charstring, start=[1, idslot], count=[strlen, 1]) ) + call check( nf90_put_var(iu%ncid, iu%origin_type_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]) ) call check( nf90_put_var(iu%ncid, iu%origin_time_varid, self%info%origin_time, start=[idslot]) ) call check( nf90_put_var(iu%ncid, iu%origin_xhx_varid, self%info%origin_xh(1), start=[idslot]) ) @@ -1117,8 +1085,6 @@ module subroutine netcdf_write_hdr_system(self, iu, param) tslot = int(param%ioutput, kind=I4B) + 1 - call check( nf90_open(param%outfile, nf90_write, iu%ncid) ) - call check( nf90_put_var(iu%ncid, iu%time_varid, param%t, start=[tslot]) ) call check( nf90_put_var(iu%ncid, iu%npl_varid, self%pl%nbody, start=[tslot]) ) call check( nf90_put_var(iu%ncid, iu%ntp_varid, self%tp%nbody, start=[tslot]) ) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index f429b74b7..d38106705 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -251,6 +251,8 @@ module subroutine symba_util_dealloc_pl(self) implicit none ! Arguments class(symba_pl), intent(inout) :: self !! SyMBA massive body object + ! Internals + integer(I4B) :: i if (allocated(self%lcollision)) deallocate(self%lcollision) if (allocated(self%lencounter)) deallocate(self%lencounter) @@ -262,7 +264,13 @@ module subroutine symba_util_dealloc_pl(self) if (allocated(self%isperi)) deallocate(self%isperi) if (allocated(self%peri)) deallocate(self%peri) if (allocated(self%atp)) deallocate(self%atp) - if (allocated(self%kin)) deallocate(self%kin) + + if (allocated(self%kin)) then + do i = 1, self%nbody + call self%kin(i)%dealloc() + end do + deallocate(self%kin) + end if call util_dealloc_pl(self) @@ -408,7 +416,7 @@ module subroutine symba_util_flatten_eucl_plpl(self, param) if (param%lflatten_interactions) then if (allocated(self%k_plpl)) deallocate(self%k_plpl) ! Reset the index array if it's been set previously allocate(self%k_plpl(2, nplpl), stat=err) - if (err /=0) then ! An error occurred trying to allocate this big array. This probably means it's too big to fit in memory, and so we will force the run back into triangular mode + if (err /= 0) then ! An error occurred trying to allocate this big array. This probably means it's too big to fit in memory, and so we will force the run back into triangular mode param%lflatten_interactions = .false. else do concurrent (i=1:npl, j=1:npl, j>i)