first video -> big commit :)

GravityField/realfield.f90

@@ -1,15 +1,20 @@
-!
-!       project "gravity field"
-!
+!-----------------------------------------------------------------------
+!-
+!      some functions for the project "gravity field" 
+!-
 !-----------------------------------------------------------------------
 module realfield
+  use spitpgm               ! XXX
+
   implicit none
 
 !-----------------------------------------------------------------------
 !      definition of structures
-!
+!-
 type massbody
   real                  :: posx, posy
+  real                  :: heading       = 33.21
+  real                  :: speed         = 1.007
   real                  :: mass          = 1.0
   integer               :: serial        = 666
 end type
@@ -17,6 +22,57 @@ end type
 !-----------------------------------------------------------------------
 contains
 !-----------------------------------------------------------------------
+subroutine barycentre_bodies(astres)
+  type(massbody), intent(in)     :: astres(:)
+
+  real                           :: cx, cy
+  integer                        :: foo
+
+  !-
+  !   May be we have to use DOUBLE RPECSION here ?
+  !-
+  cx = 0.0
+  cy = 0.0
+  do foo=1, ubound(astres, 1)
+    cx = cx + astres(foo)%posx
+    cy = cy + astres(foo)%posy
+  enddo
+  cx = cx / real(ubound(astres, 1))
+  cy = cy / real(ubound(astres, 1))
+  print *, cx, cy
+
+end subroutine
+!-----------------------------------------------------------------------
+!-
+!     make a few solid body to play with...
+!-
+subroutine create_some_planets(planets, coef, sx, sy)
+  type(massbody), intent(inout)     :: planets(:)
+  real, intent(in)                  :: coef
+  integer, intent(in)               :: sx, sy
+
+  integer                           :: foo
+  character(100)                    :: fmt
+
+  fmt = "(I4, '  | ', 2(F10.2, '  '), ' | ', 2F9.3, '  ', e12.3, I7)"
+
+  do foo=1, ubound(planets, 1)
+    if (foo .EQ. 1) then
+      planets(1)%posx   = 10
+      planets(1)%posy   = 10
+      planets(1)%mass   = 7e8
+      planets(1)%serial = 1337
+    else
+      planets(foo)%posx     = rand() * real(sx-1)
+      planets(foo)%posy     = rand() * real(sy-1)
+      planets(foo)%mass     = 7e6 + coef*foo
+      planets(foo)%serial   = foo
+    endif
+    write (*, fmt) foo, planets(foo)
+  enddo
+
+end subroutine
+!-----------------------------------------------------------------------
 
 function compute_gravity(fx, fy, body)
   real, intent(in)              :: fx, fy
@@ -62,6 +118,71 @@ subroutine compute_a_field(field, moon)
     enddo
   enddo
 
+end subroutine
+!-----------------------------------------------------------------------
+!-
+!   compute a field with only one body; and write a pic file
+!-
+subroutine build_and_write_a_field(szx, szy, moons, fname)
+  integer, intent(in)                :: szx, szy
+  type(massbody), intent(in)         :: moons(:)
+  character(len=*), intent(in)       :: fname
+
+  real                                  :: maxi, mini
+  integer                               :: errcode, foo
+  real,    dimension(:,:), allocatable  :: field, tmpf
+  integer, dimension(:,:), allocatable  :: greymap
+
+  allocate(field(szx, szy), stat=errcode)
+  allocate(tmpf(szx, szy), stat=errcode)
+
+  field = 0.0
+  do foo=1, ubound(moons, 1)
+    call compute_a_field(tmpf, moons(foo))
+    tmpf = tmpf * 0.019
+    field = field + tmpf
+  enddo
+
+  maxi = maxval(field)
+  mini = minval(field)
+  ! print *, "field: ", mini, maxi, maxi-mini
+
+  allocate(greymap(szx, szy), stat=errcode)
+  greymap = 65533
+  ! convert from real value to 16 bits int values
+  where (field < 65530.0)
+    greymap = int(field)
+  end where
+
+  call spit_as_pgm_16(greymap, trim(fname))
+
+  ! make valgrind happy
+  deallocate(field)
+  deallocate(greymap)
+
+end subroutine
+
+!-----------------------------------------------------------------------
+!-
+!    Yes, I know, this is a disturbing kluge, but I like it :}
+!    May be, it's time to read the doc of modern Fortran
+!-
+subroutine init_random()
+
+  integer, dimension(3) :: tarray
+  integer               :: t3
+  real                  :: dummy
+  call itime(tarray)
+  t3 = 8971*tarray(1) + 443*tarray(2) + tarray(3)
+  write(0, '(A,3I3,A,I6)') "sranding: ", tarray, " --> ", t3
+  call srand(t3)
+  ! after initializing the random generator engine,
+  ! you MUST use it for initializing the initializer
+  do t3=1, 4
+    dummy = rand()
+    write(0, *) 'dummy ', t3, dummy
+  enddo
+
 end subroutine
 !-----------------------------------------------------------------------
 !-----------------------------------------------------------------------