shacking around code lines

This commit is contained in:
tTh 2022-12-12 00:57:00 +01:00
parent 9569e1b462
commit 61382ed12a
3 changed files with 134 additions and 38 deletions

View File

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

View File

@ -9,53 +9,71 @@ program essai
implicit none 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 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' STOP 'BECAUSE YOLO'
contains 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 enddo
call spit_as_pgm_8(map, "nearest.pgm")
end subroutine end subroutine
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
!-----------------------------------------------------------------------
end program end program

View File

@ -72,7 +72,7 @@ subroutine create_some_planets(planets, coef, sx, sy)
!- !-
planets(1)%posx = sx / 2 planets(1)%posx = sx / 2
planets(1)%posy = sy / 2 planets(1)%posy = sy / 2
planets(1)%mass = 29e8 planets(1)%mass = 31e8
planets(1)%serial = 1337 planets(1)%serial = 1337
planets(1)%speed = 6.666 planets(1)%speed = 6.666
else else
@ -82,10 +82,11 @@ subroutine create_some_planets(planets, coef, sx, sy)
planets(foo)%posx = rand() * real(sx-1) planets(foo)%posx = rand() * real(sx-1)
planets(foo)%posy = rand() * real(sy-1) planets(foo)%posy = rand() * real(sy-1)
planets(foo)%mass = 7e6 + coef*foo 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 planets(foo)%serial = foo*2 + 120
endif endif
write (*, fmt) foo, planets(foo) write (*, fmt) foo, planets(foo)
enddo enddo
end subroutine end subroutine
@ -110,11 +111,29 @@ function compute_gravity(fx, fy, body)
endif endif
end function 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 ! 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. ! come from, sorry.
!- !-
subroutine compute_a_field(field, moon) subroutine compute_a_field(field, moon)
@ -158,7 +177,7 @@ subroutine build_and_write_a_field(szx, szy, moons, fname)
field = 0.0 field = 0.0
do foo=1, ubound(moons, 1) do foo=1, ubound(moons, 1)
call compute_a_field(tmpf, moons(foo)) call compute_a_field(tmpf, moons(foo))
tmpf = tmpf * 0.019 tmpf = tmpf * 0.018
field = field + tmpf field = field + tmpf
enddo enddo
@ -199,9 +218,67 @@ subroutine init_random()
! you MUST use it for initializing the initializer ! you MUST use it for initializing the initializer
do t3=1, 4 do t3=1, 4
dummy = rand() dummy = rand()
write(0, *) 'dummy ', t3, dummy write(0, '(" dummy", I4, F9.6)') t3, dummy
enddo 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 end subroutine
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
!----------------------------------------------------------------------- !-----------------------------------------------------------------------