shacking around code lines
This commit is contained in:
tTh
parent
9569e1b462
commit
61382ed12a
|
|
@ -13,6 +13,7 @@ WS/data/*
|
|||
*.gif
|
||||
*.log
|
||||
*.mp4
|
||||
*.dump
|
||||
|
||||
*.stderr
|
||||
|
||||
|
|
|
|||
|
|
@ -9,53 +9,71 @@ program essai
|
|||
|
||||
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 create_some_planets(planets, 45e5, S_WIDTH, S_HEIGHT)
|
||||
|
||||
do foo=0, 1999
|
||||
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
|
||||
call essai_near_planet(9999, 4096)
|
||||
|
||||
STOP 'BECAUSE YOLO'
|
||||
|
||||
contains
|
||||
!-----------------------------------------------------------------------
|
||||
!-
|
||||
! Et si on bougeait un peu tous ces corps planétaires ?
|
||||
! computation of thr nearest planet
|
||||
!-
|
||||
subroutine boulegue_les_astres(astres, factor)
|
||||
type(massbody), intent(inout) :: astres(:)
|
||||
real, intent(in) :: factor
|
||||
subroutine essai_near_planet(nbplanets, szfield)
|
||||
integer, intent(in) :: nbplanets, szfield
|
||||
|
||||
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
|
||||
|
||||
call spit_as_pgm_8(map, "nearest.pgm")
|
||||
|
||||
end subroutine
|
||||
!-----------------------------------------------------------------------
|
||||
!-----------------------------------------------------------------------
|
||||
|
||||
end program
|
||||
|
|
|
|||
|
|
@ -72,7 +72,7 @@ subroutine create_some_planets(planets, coef, sx, sy)
|
|||
!-
|
||||
planets(1)%posx = sx / 2
|
||||
planets(1)%posy = sy / 2
|
||||
planets(1)%mass = 29e8
|
||||
planets(1)%mass = 31e8
|
||||
planets(1)%serial = 1337
|
||||
planets(1)%speed = 6.666
|
||||
else
|
||||
|
|
@ -82,10 +82,11 @@ subroutine create_some_planets(planets, coef, sx, sy)
|
|||
planets(foo)%posx = rand() * real(sx-1)
|
||||
planets(foo)%posy = rand() * real(sy-1)
|
||||
planets(foo)%mass = 7e6 + coef*foo
|
||||
planets(foo)%heading = 3.14159 * rand()
|
||||
if (rand() .LT. 0.08) planets(foo)%speed = 3.14159
|
||||
planets(foo)%heading = 2 * 3.14159 * rand()
|
||||
if (rand() .LT. 0.15) planets(foo)%speed = 3.14159
|
||||
planets(foo)%serial = foo*2 + 120
|
||||
endif
|
||||
|
||||
write (*, fmt) foo, planets(foo)
|
||||
enddo
|
||||
end subroutine
|
||||
|
|
@ -110,11 +111,29 @@ function compute_gravity(fx, fy, body)
|
|||
endif
|
||||
|
||||
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
|
||||
! to the massbody 'moon'. Nobody know where the magic number
|
||||
! to the massbody 'moon'. Nobody know where the magic numbers
|
||||
! come from, sorry.
|
||||
!-
|
||||
subroutine compute_a_field(field, moon)
|
||||
|
|
@ -158,7 +177,7 @@ subroutine build_and_write_a_field(szx, szy, moons, fname)
|
|||
field = 0.0
|
||||
do foo=1, ubound(moons, 1)
|
||||
call compute_a_field(tmpf, moons(foo))
|
||||
tmpf = tmpf * 0.019
|
||||
tmpf = tmpf * 0.018
|
||||
field = field + tmpf
|
||||
enddo
|
||||
|
||||
|
|
@ -199,9 +218,67 @@ subroutine init_random()
|
|||
! you MUST use it for initializing the initializer
|
||||
do t3=1, 4
|
||||
dummy = rand()
|
||||
write(0, *) 'dummy ', t3, dummy
|
||||
write(0, '(" dummy", I4, F9.6)') t3, dummy
|
||||
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
|
||||
!-----------------------------------------------------------------------
|
||||
!-----------------------------------------------------------------------
|
||||
|
|
|
|||
Loading…
Reference in New Issue