Compare commits

..

No commits in common. "67c606db47fdc0c2eed62aefe7975c055b613042" and "d0ac316652da142f8f42008577faf9c640a14e9d" have entirely different histories.

12 changed files with 69 additions and 213 deletions

View File

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

View File

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

View File

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

View File

@ -1,16 +1,12 @@
!-
! This module try to write PNM complient files - ymmv
!-
module spitpgm module spitpgm
implicit none implicit none
contains contains
!------------------------------------------------------------------- !-----------------------------------------------------
!-
! This subroutine try to scale the values to fit the 16 bit range subroutine spit_as_pgm(pic, fname)
!
subroutine spit_as_pgm_eq(pic, fname)
integer, intent(in), dimension (:,:) :: pic integer, intent(in), dimension (:,:) :: pic
character (len=*), intent(in) :: fname character (len=*), intent(in) :: fname
@ -45,33 +41,9 @@ subroutine spit_as_pgm_eq(pic, fname)
close(io) close(io)
end subroutine end subroutine
!------------------------------------------------------------------- !-----------------------------------------------------
!-
! 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) subroutine spit_as_pgm_8(pic, fname)
integer, intent(in), dimension (:,:) :: pic integer, intent(in), dimension (:,:) :: pic
character (len=*), intent(in) :: fname character (len=*), intent(in) :: fname
@ -96,6 +68,6 @@ subroutine spit_as_pgm_8(pic, fname)
close(io) close(io)
end subroutine end subroutine
!------------------------------------------------------------------- !-----------------------------------------------------
end module spitpgm end module spitpgm

View File

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

View File

@ -1,16 +1,8 @@
# #
# Fortraneries by tTh - Gravity Field # Fortraneries by tTh - Gravity Field
# #
GFOPT = -Wall -Wextra -g -time -pg -I../Modules GFOPT = -Wall -Wextra -g -time
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 $@

View File

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

View File

@ -1,97 +1,62 @@
!-----------------------------------------------------------------------
!
! project "gravity field"
!
!-----------------------------------------------------------------------
program essai program essai
use realfield
use spitpgm ! XXX
implicit none implicit none
type(massbody) :: planet integer :: ix, iy
integer :: foo real :: fx, fy
character (len=100) :: filename real :: foo, bar, maxi, mini
planet%posx = 337.314 maxi = 0.0
planet%posy = 164.666 mini = 9e9
planet%mass = 1e8
planet%serial = 42
do foo=0, 48 do ix=1, 2000
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) fx = real(ix)
do iy=1, ubound(field, 2) do iy=1, 2000
fy = real(iy) fy = real(iy)
grav = compute_gravity(fx, fy, moon)
field(ix,iy) = grav foo = rdist(fx, fy, 222.22, 765.432)
bar = gravity(foo, 1337.0)
maxi = max(maxi, bar)
mini = min(mini, bar)
enddo enddo
enddo enddo
end subroutine 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 program end program

View File

@ -1,41 +0,0 @@
!
! 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

View File

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

View File

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

View File

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