83 lines
2.2 KiB
Fortran
83 lines
2.2 KiB
Fortran
!-----------------------------------------------------------------------
|
|
!-
|
|
! test program for the project "gravity field"
|
|
!-
|
|
!-----------------------------------------------------------------------
|
|
program essai
|
|
use realfield
|
|
use spitpgm ! XXX
|
|
use pixrgb
|
|
|
|
implicit none
|
|
|
|
call init_random()
|
|
|
|
call essai_near_planet(2048, 2048)
|
|
|
|
STOP 'BECAUSE YOLO'
|
|
|
|
contains
|
|
!-----------------------------------------------------------------------
|
|
!-
|
|
! computation of thr nearest planet
|
|
!-
|
|
subroutine essai_near_planet(nbplanets, szfield)
|
|
integer, intent(in) :: nbplanets, szfield
|
|
|
|
type(t_pixrgb), dimension(:,:), allocatable :: cmap
|
|
integer :: ix, iy
|
|
real :: fx, fy, dx, dy
|
|
integer :: near, ipl, errcode
|
|
real :: curdist, smalldist
|
|
type(massbody) :: planets(nbplanets)
|
|
|
|
print *, "near planets test", nbplanets, szfield
|
|
|
|
allocate(cmap(szfield, szfield), stat=errcode)
|
|
! map = -1
|
|
|
|
! create some random bodies
|
|
do ipl=1, nbplanets
|
|
planets(ipl)%posx = rand() * szfield
|
|
planets(ipl)%posy = rand() * szfield
|
|
planets(ipl)%serial = ipl
|
|
end do
|
|
! call save_bodies_to_txt_file(planets, "planets.txt")
|
|
|
|
! loop over all the location of the field
|
|
do ix=1, szfield
|
|
fx = real(ix)
|
|
do iy=1, szfield
|
|
fy = real(iy)
|
|
|
|
near = -1
|
|
smalldist = 1e37
|
|
! loop over all the planet's bodies
|
|
do ipl=1, nbplanets
|
|
! compute the "fake" distance
|
|
dx = fx - planets(ipl)%posx
|
|
dy = fy - planets(ipl)%posy
|
|
curdist = (dx*dx) + (dy*dy)
|
|
if (curdist .LT. smalldist) then
|
|
near = ipl
|
|
smalldist = curdist
|
|
endif
|
|
end do ! loop on ipl
|
|
|
|
cmap(ix, iy)%r = mod(near*4, 255)
|
|
cmap(ix, iy)%g = mod(near*7, 255)
|
|
cmap(ix, iy)%b = mod(near*11, 255)
|
|
|
|
enddo
|
|
|
|
write(0, *) "row", ix, " on", szfield
|
|
|
|
enddo
|
|
|
|
call rgbpix_spit_as_pnm_8(cmap, "rgb.pnm")
|
|
|
|
end subroutine
|
|
!-----------------------------------------------------------------------
|
|
|
|
end program
|