Fortraneries/GravityField/essai.f90

!-----------------------------------------------------------------------
!-
!       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