Skip to content
This repository was archived by the owner on Aug 28, 2024. It is now read-only.

Commit

Permalink
Merge branch 'debug' into IntelAdvisor
Browse files Browse the repository at this point in the history
  • Loading branch information
@daminton
daminton committed Nov 5, 2021
2 parents 1381c23 + e59395e commit 0390f7b
Showing 1 changed file with 12 additions and 42 deletions.
54 changes: 12 additions & 42 deletions src/netcdf/netcdf.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -690,21 +689,14 @@ 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
character(len=NAMELEN), dimension(:), allocatable :: ctemp
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))
Expand Down Expand Up @@ -873,9 +865,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)

Expand Down Expand Up @@ -987,17 +978,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)
Expand All @@ -1011,25 +997,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]) )
Expand All @@ -1056,25 +1034,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]) )
Expand Down

0 comments on commit 0390f7b

Please sign in to comment.