Skip to content

Commit

Permalink
Merge remote-tracking branch 'upstream/master'
Browse files Browse the repository at this point in the history
  • Loading branch information
@cpinte
cpinte committed Aug 6, 2020
2 parents 89c8948 + 66d2013 commit 7dfc629
Show file tree
Hide file tree
Showing 9 changed files with 120 additions and 104 deletions.
2 changes: 1 addition & 1 deletion build/Makefile
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2246,7 +2246,7 @@ SRCMULT = physcon.f90 ${CONFIG} ${SRCKERNEL} io.F90 mpi_utils.F90 ${SRCFASTMATH}
viscosity.f90 options.f90 damping.f90 ${SRCEOS} \
utils_infiles.f90 utils_dumpfiles.f90 utils_summary.f90 centreofmass.f90 \
${SRCCHEM} ${DOMAIN} ${SRCPOT} ptmass.F90 ${LINKLIST} ${SRCTURB} \
prompting.f90 ${SRCDUST} ${SRCNIMHD} readwrite_infile.f90 ${MULTIRUNFILE}
checkconserved.f90 prompting.f90 ${SRCDUST} ${SRCNIMHD} readwrite_infile.f90 ${MULTIRUNFILE}
OBJM1 = ${SRCMULT:.f90=.o}
OBJMULT = ${OBJM1:.F90=.o}

Expand Down
5 changes: 2 additions & 3 deletions src/main/dens.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -125,7 +125,7 @@ subroutine densityiterate(icall,npart,nactive,xyzh,vxyzu,divcurlv,divcurlB,Bevol
mhd_nonideal,nalpha,use_dust
use io, only:iprint,fatal,iverbose,id,master,real4,warning,error,nprocs
use linklist, only:ifirstincell,ncells,get_neighbour_list,get_hmaxcell,&
get_cell_location,set_hmaxcell,sync_hmax_mpi
listneigh,get_cell_location,set_hmaxcell,sync_hmax_mpi
use part, only:mhd,rhoh,dhdrho,rhoanddhdrho,&
ll,get_partinfo,iactive,&
hrho,iphase,igas,idust,iamgas,periodic,&
Expand Down Expand Up @@ -162,9 +162,8 @@ subroutine densityiterate(icall,npart,nactive,xyzh,vxyzu,divcurlv,divcurlB,Bevol
real, intent(in) :: rad(:,:)
real, intent(inout) :: radprop(:,:)

integer, save :: listneigh(maxneigh)
real, save :: xyzcache(isizecellcache,3)
!$omp threadprivate(xyzcache,listneigh)
!$omp threadprivate(xyzcache)

integer :: i,icell
integer :: nneigh,np
Expand Down
5 changes: 2 additions & 3 deletions src/main/force.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -161,7 +161,7 @@ subroutine force(icall,npart,xyzh,vxyzu,fxyzu,divcurlv,divcurlB,Bevol,dBevol,&

use dim, only:maxvxyzu,maxneigh,mhd,mhd_nonideal,lightcurve
use io, only:iprint,fatal,iverbose,id,master,real4,warning,error,nprocs
use linklist, only:ncells,get_neighbour_list,get_hmaxcell,get_cell_location
use linklist, only:ncells,get_neighbour_list,get_hmaxcell,get_cell_location,listneigh
use options, only:iresistive_heating
use part, only:rhoh,dhdrho,rhoanddhdrho,alphaind,iactive,gradh,&
hrho,iphase,igas,maxgradh,dvdx,eta_nimhd,deltav,poten,iamtype
Expand Down Expand Up @@ -226,8 +226,7 @@ subroutine force(icall,npart,xyzh,vxyzu,fxyzu,divcurlv,divcurlB,Bevol,dBevol,&
real, intent(in) :: dens(:), metrics(:,:,:,:)

real, save :: xyzcache(maxcellcache,4)
integer, save :: listneigh(maxneigh)
!$omp threadprivate(xyzcache,listneigh)
!$omp threadprivate(xyzcache)
integer :: i,icell,nneigh
integer :: nstokes,nsuper,ndrag,ndustres
real :: dtmini,dtohm,dthall,dtambi,dtvisc
Expand Down
11 changes: 9 additions & 2 deletions src/main/linklist_kdtree.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,8 @@ module linklist
type(kdnode), allocatable :: nodeglobal(:)
type(kdnode), public, allocatable :: node(:)
integer, allocatable :: nodemap(:)

integer, public , allocatable :: listneigh(:)
!$omp threadprivate(listneigh)
integer(kind=8), public :: ncells
real, public :: dxcell
real, public :: dcellx = 0.,dcelly = 0.,dcellz = 0.
Expand All @@ -54,13 +55,17 @@ module linklist
subroutine allocate_linklist
use allocutils, only:allocate_array
use kdtree, only:allocate_kdtree
use dim, only:maxneigh

call allocate_array('cellatid', cellatid, ncellsmax+1)
call allocate_array('ifirstincell', ifirstincell, ncellsmax+1)
call allocate_array('nodeglobal', nodeglobal, ncellsmax+1)
call allocate_array('node', node, ncellsmax+1)
call allocate_array('nodemap', nodemap, ncellsmax+1)
call allocate_kdtree()
!$omp parallel
call allocate_array('listneigh',listneigh,maxneigh)
!$omp end parallel

end subroutine allocate_linklist

Expand All @@ -72,7 +77,9 @@ subroutine deallocate_linklist
if (allocated(nodeglobal)) deallocate(nodeglobal)
if (allocated(node)) deallocate(node)
if (allocated(nodemap)) deallocate(nodemap)

!$omp parallel
if (allocated(listneigh)) deallocate(listneigh)
!$omp end parallel
call deallocate_kdtree()

end subroutine deallocate_linklist
Expand Down
183 changes: 91 additions & 92 deletions src/main/readwrite_dumps.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -59,109 +59,108 @@ subroutine init_readwrite_dumps()
dt_read_in => dt_read_in_fortran
#endif


return

end subroutine init_readwrite_dumps

!--------------------------------------------------------------------
!+
! subroutine to write output to full dump file
! in GADGET format
!+
!-------------------------------------------------------------------
subroutine write_gadgetdump(dumpfile,t,xyzh,particlemass,vxyzu,rho,utherm,npart)
use io, only:iprint,idump,real4
!--------------------------------------------------------------------
!+
! subroutine to write output to full dump file
! in GADGET format
!+
!-------------------------------------------------------------------
subroutine write_gadgetdump(dumpfile,t,xyzh,particlemass,vxyzu,rho,utherm,npart)
use io, only:iprint,idump,real4
#ifdef PERIODIC
use boundary, only:dxbound
use boundary, only:dxbound
#endif
real, intent(in) :: t,particlemass,utherm
character(len=*), intent(in) :: dumpfile
integer, intent(in) :: npart
real, intent(in) :: xyzh(:,:),vxyzu(:,:)
real, intent(in) :: rho(:)

integer(kind=4) :: particleid(size(rho))
integer :: npartoftype(6),nall(6),ncrap(6)
real(kind=8) :: massoftype(6)
real(kind=8) :: time,boxsize
real(kind=8), parameter :: dumz = 0.d0
real(kind=4) :: unused(15)
integer, parameter :: iflagsfr = 0, iflagfeedback = 0, iflagcool = 0
integer, parameter :: nfiles = 1
integer :: ierr,i,j
!
!--open dumpfile
!
write(iprint,"(/,/,'--------> TIME = ',f12.4,"// &
"': full dump written to file ',a,' <--------',/)") t,trim(dumpfile)

write(iprint,*) 'writing to unit ',idump
open(unit=idump,file=dumpfile,status='replace',form='unformatted',iostat=ierr)
if (ierr /= 0) then
write(iprint,*) 'error: can''t create new dumpfile ',trim(dumpfile)
stop
endif

npartoftype(:) = 0
npartoftype(1) = npart
nall(:) = npartoftype(:)
ncrap(:) = 0
time = t
real, intent(in) :: t,particlemass,utherm
character(len=*), intent(in) :: dumpfile
integer, intent(in) :: npart
real, intent(in) :: xyzh(:,:),vxyzu(:,:)
real, intent(in) :: rho(:)

integer(kind=4) :: particleid(size(rho))
integer :: npartoftype(6),nall(6),ncrap(6)
real(kind=8) :: massoftype(6)
real(kind=8) :: time,boxsize
real(kind=8), parameter :: dumz = 0.d0
real(kind=4) :: unused(15)
integer, parameter :: iflagsfr = 0, iflagfeedback = 0, iflagcool = 0
integer, parameter :: nfiles = 1
integer :: ierr,i,j
!
!--open dumpfile
!
write(iprint,"(/,/,'--------> TIME = ',f12.4,"// &
"': full dump written to file ',a,' <--------',/)") t,trim(dumpfile)

write(iprint,*) 'writing to unit ',idump
open(unit=idump,file=dumpfile,status='replace',form='unformatted',iostat=ierr)
if (ierr /= 0) then
write(iprint,*) 'error: can''t create new dumpfile ',trim(dumpfile)
stop
endif

npartoftype(:) = 0
npartoftype(1) = npart
nall(:) = npartoftype(:)
ncrap(:) = 0
time = t
#ifdef PERIODIC
boxsize = dxbound
boxsize = dxbound
#else
boxsize = 0.
boxsize = 0.
#endif

massoftype(:) = 0.
massoftype(1) = particlemass
unused(:) = 0

do i=1,npart
particleid(i) = i
enddo
write(idump,iostat=ierr) npartoftype(1:6),massoftype(1:6),time,dumz, &
iflagsfr,iflagfeedback,nall(1:6),iflagcool,nfiles,boxsize, &
dumz,dumz,dumz,iflagsfr,iflagsfr,ncrap(1:6),iflagsfr,unused(:)
massoftype(:) = 0.
massoftype(1) = particlemass
unused(:) = 0

do i=1,npart
particleid(i) = i
enddo
write(idump,iostat=ierr) npartoftype(1:6),massoftype(1:6),time,dumz, &
iflagsfr,iflagfeedback,nall(1:6),iflagcool,nfiles,boxsize, &
dumz,dumz,dumz,iflagsfr,iflagsfr,ncrap(1:6),iflagsfr,unused(:)

write(idump,iostat=ierr) ((real4(xyzh(j,i)),j=1,3),i=1,npart)
if (ierr /= 0) then
print*,' error writing positions'
return
endif
write(idump,iostat=ierr) ((real4(vxyzu(j,i)),j=1,3),i=1,npart)
if (ierr /= 0) then
print*,' error writing velocities'
return
endif
write(idump,iostat=ierr) (particleid(i),i=1,npart)
if (ierr /= 0) then
print*,' error writing particle ID'
return
endif
if (size(vxyzu(:,1)) >= 4) then
write(idump,iostat=ierr) (real4(vxyzu(4,i)),i=1,npart)
else
write(idump,iostat=ierr) (real4(utherm),i=1,npart)
endif
if (ierr /= 0) then
print*,' error writing utherm'
return
endif
write(idump,iostat=ierr) (real4(rho(i)),i=1,npart)
if (ierr /= 0) then
print*,' error writing rho'
return
endif
write(idump,iostat=ierr) (real4(xyzh(4,i)),i=1,npart)
if (ierr /= 0) then
print*,' error writing h'
return
endif
print*,' finished writing file -- OK'

write(idump,iostat=ierr) ((real4(xyzh(j,i)),j=1,3),i=1,npart)
if (ierr /= 0) then
print*,' error writing positions'
return
endif
write(idump,iostat=ierr) ((real4(vxyzu(j,i)),j=1,3),i=1,npart)
if (ierr /= 0) then
print*,' error writing velocities'
return
endif
write(idump,iostat=ierr) (particleid(i),i=1,npart)
if (ierr /= 0) then
print*,' error writing particle ID'
return
endif
if (size(vxyzu(:,1)) >= 4) then
write(idump,iostat=ierr) (real4(vxyzu(4,i)),i=1,npart)
else
write(idump,iostat=ierr) (real4(utherm),i=1,npart)
endif
if (ierr /= 0) then
print*,' error writing utherm'
return
endif
write(idump,iostat=ierr) (real4(rho(i)),i=1,npart)
if (ierr /= 0) then
print*,' error writing rho'
return
endif
write(idump,iostat=ierr) (real4(xyzh(4,i)),i=1,npart)
if (ierr /= 0) then
print*,' error writing h'
return
endif
print*,' finished writing file -- OK'

return
end subroutine write_gadgetdump
end subroutine write_gadgetdump

end module readwrite_dumps
5 changes: 3 additions & 2 deletions src/main/readwrite_dumps_fortran.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1458,10 +1458,11 @@ subroutine unfill_header(hdr,phantomdump,got_tags,nparttot, &
if (use_dust) then
call extract('ndustsmall',ndustsmall,hdr,ierrs(1))
call extract('ndustlarge',ndustlarge,hdr,ierrs(2))
ndusttypes = ndustsmall + ndustlarge
if (any(ierrs(1:2) /= 0)) then
write(*,*) 'ERROR reading number of small/large grain types from file header'
call extract('ndustfluids',ndustsmall,hdr,ierrs(1)) ! for backwards compatibility
if (ierrs(1) /= 0) write(*,*) 'ERROR reading number of small/large grain types from file header'
endif
ndusttypes = ndustsmall + ndustlarge
endif
!
!--units
Expand Down
4 changes: 4 additions & 0 deletions src/main/utils_cpuinfo.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -81,6 +81,10 @@ subroutine get_cpuinfo(ncpu,ncpureal,cpuspeed,cpumodel,cachesize,ierr)
!
ierr = 0
ncpu = 0
ncpureal = 0
cpuspeed = 0.
cpumodel = ''
cachesize = ''
inquire(file='/proc/cpuinfo',exist=iexist)
if (iexist) then
open(unit=iunit,file='/proc/cpuinfo',status='old',iostat=ierr)
Expand Down
7 changes: 6 additions & 1 deletion src/tests/test_link.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -70,11 +70,15 @@ subroutine test_link(ntests,npass)
integer :: nfailed(8)
logical :: iactivei,iactivej,activecell
real, allocatable :: xyzcache(:,:)
integer :: listneigh(maxneigh)
integer, allocatable :: listneigh(:)
character(len=1), dimension(3), parameter :: xlabel = (/'x','y','z'/)

if (id==master) write(*,"(a,/)") '--> TESTING LINKLIST / NEIGHBOUR FINDING'
!
!--allocate memory for neighbour list
!
allocate(listneigh(maxneigh))
!
!--set up a random particle distribution
!
npart = 0
Expand Down Expand Up @@ -436,6 +440,7 @@ subroutine test_link(ntests,npass)
enddo

if (allocated(xyzcache)) deallocate(xyzcache)
deallocate(listneigh)

if (id==master) write(*,"(/,a,/)") '<-- LINKLIST TEST COMPLETE'

Expand Down
2 changes: 2 additions & 0 deletions src/tests/test_step.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -125,6 +125,8 @@ subroutine test_step(ntests,npass)
call checkval(nerror,0,0,nfailed(1),'no errors in setup')
call update_test_scores(ntests,nfailed,npass)

fxyzu = 0.
fext = 0.
call get_derivs_global()
call init_step(npart,t,dtmax)

Expand Down

0 comments on commit 7dfc629

Please sign in to comment.