first real run, make a gif89a, need more tweaking

This commit is contained in:
tTh 2022-11-30 02:52:16 +01:00
parent fa8b28daae
commit b68207631c
5 changed files with 86 additions and 37 deletions

View File

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

View File

@ -2,7 +2,8 @@
# 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 all: essai
@ -10,6 +11,6 @@ realfield.o: realfield.f90 Makefile
gfortran $(GFOPT) -c $< gfortran $(GFOPT) -c $<
essai: essai.f90 Makefile realfield.o essai: essai.f90 Makefile realfield.o
gfortran $(GFOPT) $< realfield.o -o $@ gfortran $(GFOPT) $< realfield.o $(MODOBJ) -o $@

View File

@ -1,54 +1,97 @@
!-----------------------------------------------------------------------
! !
! project "gravity field" ! project "gravity field"
! !
!-----------------------------------------------------------------------
program essai program essai
use realfield use realfield
use spitpgm ! XXX
implicit none implicit none
type(massbody) :: planet type(massbody) :: planet
integer :: foo integer :: foo
planet%posx = 1337.314 character (len=100) :: filename
planet%posy = 1664.666
planet%mass = 1e4
do foo=1, 10 planet%posx = 337.314
call build_a_field(800, 600, planet) planet%posy = 164.666
planet%posy = planet%posy + 51.45 planet%mass = 1e8
planet%serial = 42
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 enddo
STOP 'YOLO' STOP 'YOLO'
contains !------------------------------------------ contains
! !-----------------------------------------------------------------------
subroutine build_a_field(szx, szy, moon) !-
! 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 integer, intent(in) :: szx, szy
type(massbody), intent(in) :: moon type(massbody), intent(in) :: moon
character (len=*), intent(in) :: fname
integer :: ix, iy real :: maxi, mini
real :: fx, fy
real :: grav, maxi, mini
integer :: errcode integer :: errcode
real, dimension(:,:), allocatable :: field real, dimension(:,:), allocatable :: field
integer, dimension(:,:), allocatable :: greymap
allocate(field(szx, szy), stat=errcode) allocate(field(szx, szy), stat=errcode)
do ix=1, szx call compute_a_field(field, moon)
fx = real(ix)
do iy=1, szy
fy = real(iy)
grav = compute_gravity(ix, iy, moon) / 2180800.0
field(ix,iy) = grav
enddo
enddo
maxi = maxval(field) maxi = maxval(field)
mini = minval(field) mini = minval(field)
print *, "field: ", mini, maxi, maxi-mini 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(field)
deallocate(greymap)
end subroutine 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, ubound(field, 2)
fy = real(iy)
grav = compute_gravity(fx, fy, moon)
field(ix,iy) = grav
enddo
enddo
end subroutine
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
end program end program

View File

@ -6,7 +6,8 @@ module realfield
implicit none implicit none
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
! definition of structures
!
type massbody type massbody
real :: posx, posy real :: posx, posy
real :: mass = 1.0 real :: mass = 1.0
@ -17,23 +18,20 @@ end type
contains contains
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
function compute_gravity(ix, iy, body) function compute_gravity(fx, fy, body)
real, intent(in) :: fx, fy
integer, intent(in) :: ix, iy
type(massbody), intent(in) :: body type(massbody), intent(in) :: body
real :: compute_gravity real :: compute_gravity
real :: rx, ry, dist real :: rx, ry, dist
rx = real(ix) - body%posx rx = fx - body%posx
ry = real(iy) - body%posy ry = fy - body%posy
dist = sqrt( (rx*rx) + (ry*ry) ) dist = sqrt( (rx*rx) + (ry*ry) )
if (dist .LT. 0.15) then if (dist .LT. 4.50) then
write (0, *) "dist too small ", dist write (0, *) "dist too small ", dist
compute_gravity = 0e0 compute_gravity = 0e0
endif endif
compute_gravity = body%mass / (dist ** 2)
compute_gravity = body%mass * (dist ** 2)
end function end function

View File

@ -4,4 +4,7 @@ set -e # stop on error
make essai make essai
time ./essai ./essai
convert -delay 10 WS/*.pgm foo.gif