garbage collect

Fraktalism/Makefile

@@ -1,12 +1,11 @@
 
 all:	voxelize evolvopick pickover julia lorentz essai
 
-GFOPT  = -Wall -Wextra -time -g -O -Imods/
+GFOPT  = -Wall -Wextra -time -g -O -Imods/ -I../Modules
 
 # ---------------------------------------------
-
-mods/spitpgm.o:		mods/spitpgm.f90 Makefile
-	gfortran $(GFOPT) -c $< -o $@
+# the module 'spitpgm' is now in $PROJECT/Modules
+#
 
 mods/points3d.o:	mods/points3d.f90 Makefile
 	gfortran $(GFOPT) -c $< -o $@
@@ -17,8 +16,7 @@ mods/xperiment.o:	mods/xperiment.f90 Makefile
 fraktals.o:	fraktals.f90 Makefile
 	gfortran $(GFOPT) -c $<
 
-OBJS  = mods/spitpgm.o mods/points3d.o mods/xperiment.o 	\
-	fraktals.o 
+OBJS  = mods/points3d.o mods/xperiment.o fraktals.o
 
 # ---------------------------------------------
 

Fraktalism/essai.f90

@@ -1,7 +1,7 @@
 !-----------------------------------------------------
 program essai
 
-  use spitpgm
+  use spitpgm            ! XXX moved in ../Modules 
   use fraktals
   use points3d
   use xperiment

Fraktalism/fraktals.f90

@@ -183,7 +183,8 @@ subroutine lorentz_0(pic, count)
 ! XXX    double precision      :: ka, kb, kc, kd
 ! XXX    integer               :: i, w, h, px, py
 
-   write(0, *) "proc lorentz_0, count is ", count
+   write(0, *) "lorentz_0, picz  is ", ubound(pic)
+   write(0, *) "lorentz_0, count is ", count
 
 end subroutine lorentz_0
 

GravityField/.gitignore

@@ -1,2 +1,10 @@
 
 essai
+
+WS/*.pgm
+
+*.gif
+
+foo.pgm
+bar.pgm
+

GravityField/Makefile

@@ -1,8 +1,16 @@
 #
-# Fortraneries by tTh - Gravity Field
+#    Fortraneries by tTh - Gravity Field
 #
 
-GFOPT = -Wall -Wextra -g -time 
+GFOPT   = -Wall -Wextra -g -time -pg -I../Modules
+MODOBJ  = '../Modules/spitpgm.o'
+
+all:	essai
+
+realfield.o:	realfield.f90 Makefile
+	gfortran $(GFOPT) -c $<
+
+essai:	essai.f90  Makefile realfield.o
+	gfortran $(GFOPT) $< realfield.o $(MODOBJ) -o $@
+
 
-essai:	essai.f90  Makefile
-	gfortran $(GFOPT) $<  -o $@

GravityField/WS/README.md

@@ -0,0 +1 @@
+# this is just a worspace

GravityField/essai.f90

@@ -1,62 +1,97 @@
+!-----------------------------------------------------------------------
+!
+!       project "gravity field"
+!
+!-----------------------------------------------------------------------
 program essai
+  use realfield
+  use spitpgm               ! XXX
+
   implicit none
 
-  integer                 :: ix, iy
-  real                    :: fx, fy
-  real                    :: foo, bar, maxi, mini
+  type(massbody)          :: planet
+  integer                 :: foo
+  character (len=100)     :: filename
 
-  maxi = 0.0
-  mini = 9e9
+  planet%posx   = 337.314
+  planet%posy   = 164.666
+  planet%mass   = 1e8
+  planet%serial = 42
 
-  do ix=1, 2000
+  do foo=0, 48
+    write (filename, "(a, i5.5, a)") 'WS/', foo, '.pgm'
+    call build_and_write_a_field(800, 600, planet, filename)
+    planet%posx = planet%posx + 6.99
+    planet%posy = planet%posy + 2.55
+  enddo
+
+  STOP 'YOLO'
+
+contains
+!-----------------------------------------------------------------------
+!-
+!   compute a field with only one body; and write pic file
+!-
+subroutine build_and_write_a_field(szx, szy, moon, fname)
+  integer, intent(in)                :: szx, szy
+  type(massbody), intent(in)         :: moon
+  character (len=*), intent(in)      :: fname
+
+  real                               :: maxi, mini
+  integer                            :: errcode
+  real,    dimension(:,:), allocatable  :: field
+  integer, dimension(:,:), allocatable  :: greymap
+
+  allocate(field(szx, szy), stat=errcode)
+
+  call compute_a_field(field, moon)
+  maxi = maxval(field)
+  mini = minval(field)
+  print *, "field: ", mini, maxi, maxi-mini
+
+  allocate(greymap(szx, szy), stat=errcode)
+  greymap = 65535
+  ! 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
+
+!-----------------------------------------------------------------------
+!-
+!   Compute the gravity field in a pre-allocated array relative
+!   to the massbody 'moon'. Nobody know where the magic number
+!   come from, sorry.
+!-
+subroutine compute_a_field(field, moon)
+  real, dimension(:,:), intent(out)  :: field
+  type(massbody), intent(in)         :: moon
+
+  integer                            :: ix, iy
+  real                               :: fx, fy
+  real                               :: grav
+
+  ! print *, "pic size  ", ubound(field, 1), "W", ubound(field, 2), "H"
+  ! print *, "mass body ", moon
+
+  do ix=1, ubound(field, 1)
     fx = real(ix)
-    do iy=1, 2000
+    do iy=1, ubound(field, 2)
       fy = real(iy)
-
-      foo = rdist(fx, fy, 222.22, 765.432)
-      bar = gravity(foo, 1337.0)
-
-      maxi = max(maxi, bar)
-      mini = min(mini, bar)
-
+      grav = compute_gravity(fx, fy, moon)
+      field(ix,iy) = grav
     enddo
   enddo
 
-  print *, "dist : ", mini, maxi
-
-contains        !------------------------------------------
-
-function gravity(distance, masse)
-  real, intent(in)      :: distance, masse
-  real                  :: gravity
-  real                  :: computed
-
-  if (distance .LT.  0.010) then
-    computed = 0.0
-  else
-    computed = masse / (distance ** 2)
-  endif
-
-  gravity = computed
-
-end function
-
-                !------------------------------------------
-
-function rdist(ax, ay, bx, by)
-  real, intent(in)       :: ax, ay, bx, by
-  real                      :: rdist
-  real                      :: rx, ry
-
-  rx = real(ax-bx)
-  ry = real(ay-by)
-
-  rdist = sqrt( (rx*rx) + (ry*ry) )
-
-end function
-
-
-                !------------------------------------------
-                !------------------------------------------
+end subroutine
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
 
 end program

GravityField/realfield.f90

@@ -0,0 +1,41 @@
+!
+!       project "gravity field"
+!
+!-----------------------------------------------------------------------
+module realfield
+  implicit none
+
+!-----------------------------------------------------------------------
+!      definition of structures
+!
+type massbody
+  real                  :: posx, posy
+  real                  :: mass          = 1.0
+  integer               :: serial        = 666
+end type
+
+!-----------------------------------------------------------------------
+contains
+!-----------------------------------------------------------------------
+
+function compute_gravity(fx, fy, body)
+  real, intent(in)              :: fx, fy
+  type(massbody), intent(in)    :: body
+  real                          :: compute_gravity
+  real                          :: rx, ry, dist
+
+  rx = fx - body%posx
+  ry = fy - body%posy
+  dist = sqrt( (rx*rx) + (ry*ry) )
+  if (dist .LT. 4.50) then
+    write (0, *) "dist too small ", dist
+    compute_gravity = 0e0
+  endif
+  compute_gravity = body%mass / (dist ** 2)
+
+end function
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+
+end module

GravityField/runme.sh

@@ -0,0 +1,10 @@
+#!/bin/bash
+
+set -e				# stop on error
+
+make essai
+
+./essai
+
+convert -delay 10 WS/*.pgm foo.gif
+

Modules/Makefile

@@ -0,0 +1,10 @@
+#
+#		* Fortraneries *
+#
+#	Makefile for the general purpose moduls
+#
+
+GFOPT  = -Wall -Wextra -time -g -O 
+
+spitpgm.o:		spitpgm.f90 Makefile
+	gfortran $(GFOPT) -c $< -o $@

Modules/README.md

@@ -0,0 +1,4 @@
+# General purpose modules
+
+
+* spitpgm

Modules/spitpgm.f90

@@ -1,12 +1,16 @@
+!-
+!	This module try to write PNM complient files - ymmv
+!-
 module spitpgm
 
     implicit none
-
     contains
 
-!-----------------------------------------------------
-
-subroutine spit_as_pgm(pic, fname)
+!-------------------------------------------------------------------
+!-
+!   This subroutine try to scale the values to fit the 16 bit range
+!
+subroutine spit_as_pgm_eq(pic, fname)
 
     integer, intent(in), dimension (:,:)  ::  pic
     character (len=*), intent(in)         ::  fname
@@ -41,9 +45,33 @@ subroutine spit_as_pgm(pic, fname)
     close(io)
 
 end subroutine
-!-----------------------------------------------------
-subroutine spit_as_pgm_8(pic, fname)
+!-------------------------------------------------------------------
+!-
+!     16 bits - 65535 levels portable grey map file
+!-
+subroutine spit_as_pgm_16(pic, fname)
+    integer, intent(in), dimension (:,:)  ::  pic
+    character (len=*), intent(in)         ::  fname
 
+    integer   :: io, foo
+    integer   :: ix, iy
+
+    open(newunit=io, file=fname)
+    write (io, '(a2)') "P2"
+    write (io, '(i0," ",i0)')  size(pic, 1), size(pic, 2)
+    write (io, '(i0)') 65535
+    do iy=1,ubound(pic, 2)
+      do ix=1, ubound(pic, 1)
+        foo = pic(ix, iy)
+        if (foo .GT. 65535)  foo = 65530
+        write(io, "(i5)") foo
+      enddo
+    enddo
+    close(io)
+
+end subroutine
+!-------------------------------------------------------------------
+subroutine spit_as_pgm_8(pic, fname)
     integer, intent(in), dimension (:,:)  ::  pic
     character (len=*), intent(in)         ::  fname
 
@@ -68,6 +96,6 @@ subroutine spit_as_pgm_8(pic, fname)
     close(io)
 
 end subroutine
-!-----------------------------------------------------
+!-------------------------------------------------------------------
 
 end module spitpgm