shacking around code lines

GravityField/essai.f90

@@ -9,53 +9,71 @@ program essai
 
   implicit none
 
-  ! some configuration constants
-  integer, parameter      :: S_WIDTH  = 800
-  integer, parameter      :: S_HEIGHT = 600
-  integer, parameter      :: NB_BODY  = 51
-
-  type(massbody)          :: planets(NB_BODY)
-  integer                 :: foo
-  character(len=100)      :: filename
-
   call init_random()
-  call create_some_planets(planets, 45e5, S_WIDTH, S_HEIGHT)
 
-  do foo=0, 1999
-    write (filename, "(a, i5.5, a)") 'WS/field/', foo, '.pgm'
-    call build_and_write_a_field(S_WIDTH, S_HEIGHT, planets, filename)
-    ! print *, trim(filename)
-    ! OMG! two magic numbers, wtf?
-    planets(1)%posx = planets(1)%posx + 3 + (4.5*rand())
-    planets(1)%posy = planets(1)%posy + 3 + (2.1*rand())
-    if (planets(1)%posx .GT. S_WIDTH)   planets(1)%posx = 0.0
-    if (planets(1)%posy .GT. S_HEIGHT)  planets(1)%posy = 0.0
-
-    call boulegue_les_astres(planets, 2.21)
-
-  enddo
+  call essai_near_planet(9999, 4096)
 
   STOP 'BECAUSE YOLO'
 
 contains
 !-----------------------------------------------------------------------
 !-
-!    Et si on bougeait un peu tous ces corps planétaires ?
+!     computation of thr nearest planet
 !-
-subroutine boulegue_les_astres(astres, factor)
-  type(massbody), intent(inout)     :: astres(:)
-  real, intent(in)                  :: factor
+subroutine essai_near_planet(nbplanets, szfield)
+  integer, intent(in)       :: nbplanets, szfield
 
-  integer                           :: foo
+  integer, dimension(:,:), allocatable     :: map
+  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(map(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  
+
+      map(ix, iy) = mod(near, 255)
+
+    enddo
+
+    write(0, *) "row", ix, "     on", szfield
 
-  do foo = 2, ubound(astres, 1)
-      astres(foo)%posx = astres(foo)%posx + factor*(rand() - 0.5)
-      astres(foo)%posy = astres(foo)%posy + factor*(rand() - 0.5)
   enddo
 
+  call spit_as_pgm_8(map, "nearest.pgm")
 
 end subroutine
 !-----------------------------------------------------------------------
-!-----------------------------------------------------------------------
 
 end program