shacking around code lines

GravityField/.gitignore

@@ -13,6 +13,7 @@ WS/data/*
 *.gif
 *.log
 *.mp4
+*.dump
 
 *.stderr
 

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
+  call essai_near_planet(9999, 4096)
-    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
 
   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)
+subroutine essai_near_planet(nbplanets, szfield)
-  type(massbody), intent(inout)     :: astres(:)
+  integer, intent(in)       :: nbplanets, szfield
-  real, intent(in)                  :: factor
 
-  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

GravityField/realfield.f90

@@ -72,7 +72,7 @@ subroutine create_some_planets(planets, coef, sx, sy)
       !-
       planets(1)%posx   = sx / 2
       planets(1)%posy   = sy / 2
-      planets(1)%mass   = 29e8
+      planets(1)%mass   = 31e8
       planets(1)%serial = 1337
       planets(1)%speed  = 6.666
     else
@@ -82,10 +82,11 @@ subroutine create_some_planets(planets, coef, sx, sy)
       planets(foo)%posx     = rand() * real(sx-1)
       planets(foo)%posy     = rand() * real(sy-1)
       planets(foo)%mass     = 7e6 + coef*foo
-      planets(foo)%heading  = 3.14159 * rand()
+      planets(foo)%heading  = 2 * 3.14159 * rand()
-      if (rand() .LT. 0.08) planets(foo)%speed = 3.14159
+      if (rand() .LT. 0.15) planets(foo)%speed = 3.14159
       planets(foo)%serial   = foo*2 + 120
     endif
+
     write (*, fmt) foo, planets(foo)
   enddo
 end subroutine
@@ -110,11 +111,29 @@ function compute_gravity(fx, fy, body)
   endif
 
 end function
+!-----------------------------------------------------------------------
+!-
+!   Export a massbody area to a text file. no error check, wtf ?
+!-
+subroutine save_bodies_to_txt_file (astres, fname)
+  type(massbody), intent(in)        :: astres(:)
+  character(len=*), intent(in)      :: fname
 
+  character(50)                     :: fmt
+  integer                           :: io, idx
+
+  write(0, "('saving planets to ', A20)") fname
+  fmt = "( 2(F9.3, ' ')   2(F9.3, '  '), F14.3,  I8)"
+  open(newunit=io, file=fname)
+  do idx = 1, ubound(astres, 1)
+    write(io, fmt) astres(idx)
+  enddo
+  close(io)
+end subroutine
 !-----------------------------------------------------------------------
 !-
 !   Compute the gravity field in a pre-allocated array relative
-!   to the massbody 'moon'. Nobody know where the magic number
+!   to the massbody 'moon'. Nobody know where the magic numbers
 !   come from, sorry.
 !-
 subroutine compute_a_field(field, moon)
@@ -158,7 +177,7 @@ subroutine build_and_write_a_field(szx, szy, moons, fname)
   field = 0.0
   do foo=1, ubound(moons, 1)
     call compute_a_field(tmpf, moons(foo))
-    tmpf = tmpf * 0.019
+    tmpf = tmpf * 0.018
     field = field + tmpf
   enddo
 
@@ -199,9 +218,67 @@ subroutine init_random()
   ! you MUST use it for initializing the initializer
   do t3=1, 4
     dummy = rand()
-    write(0, *) 'dummy ', t3, dummy
+    write(0, '("   dummy", I4, F9.6)') t3, dummy
   enddo
 
+end subroutine
+!-----------------------------------------------------------------------
+!-
+!    dump a field of reals numbers to disk - preliminary version
+!-
+subroutine dump_a_field_to_file(field, fname)
+  real, dimension(:,:), intent(in)  :: field
+  character(len=*), intent(in)      :: fname
+
+  integer                         :: header(8)
+  integer                         :: io
+
+  print *, "D) field size  ", ubound(field, 1), "W", ubound(field, 2), "H"
+  print *, "D) filename    ", fname
+
+  header     = 0
+  header(1)  = 574908040             ! magic number
+  header(2)  = 1                     ! this is a dump of real field
+  header(3)  = ubound(field, 1)
+  header(4)  = ubound(field, 2)
+  header(5)  = 666
+
+  open(newunit=io, file=fname, form='unformatted')
+  
+  write(io) header
+  write(io) field
+
+  close(io)
+
+end subroutine
+!-----------------------------------------------------------------------
+!-
+!    load a real field from file  - preliminary version
+!-
+subroutine load_a_field_from_file(field, fname)
+  real, dimension(:,:), intent(in)  :: field
+  character(len=*), intent(in)      :: fname
+
+  integer                         :: header(8)
+  integer                         :: io, foo
+
+  print *, "L) field size  ", ubound(field, 1), "W", ubound(field, 2), "H"
+
+  !-
+  ! how to check if the field array was valid ?
+  !-
+
+  open(newunit=io, file=fname, form='unformatted', status='old',     &
+                                                   action='read')
+  read(io) header
+  do foo=1, 8
+    print *, foo, header(foo)
+  enddo
+
+  STOP ' --- FUCKED UP BEYOND ALL REPAIR ---'
+
+  close(io)
+
 end subroutine
 !-----------------------------------------------------------------------
 !-----------------------------------------------------------------------