tTh/Fortraneries
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

we are on a good way, maybe...

Browse Source
This commit is contained in:
tTh
2022-12-05 13:10:40 +01:00
parent 8c9625b7df
commit 5b6df523fc
5 changed files with 104 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files

52
GravityField/animation.f90
View File

@@ -12,15 +12,16 @@ program animation
! some configuration constants
integer, parameter :: S_WIDTH = 1024
integer, parameter :: S_HEIGHT = 1024
integer, parameter :: NB_BODY = 150
integer, parameter :: NB_BODY = 82
!!! WARNING : global variables !!!
type(massbody) :: planets(NB_BODY)
! integer :: foo
call init_random()
call create_some_planets(planets, 1337e3, S_WIDTH , S_HEIGHT)
call barycentre_bodies(planets)
call print_barycentre_bodies(planets)
! STOP 'BEFORE CRASH'
call la_grande_boucle(0, 2000, planets)
@@ -39,25 +40,37 @@ subroutine la_grande_boucle(start, nbre, moons)
integer :: pass
do pass=start, start+nbre-1
! if second parameter is TRUE, use clipping,
! else use ?????ing
call deplace_les_planetes(moons, .TRUE.)
write (filename, "(a, i5.5, a)") 'WS/nanim/', pass, '.pgm'
write(0, *) filename
write(0, '(3I5, " * ", a20)') start, nbre, pass, filename
call build_and_write_a_field(S_WIDTH, S_HEIGHT, moons, filename)
call deplace_les_planetes(moons)
enddo
call print_barycentre_bodies(moons)
end subroutine
!-----------------------------------------------------------------------
subroutine deplace_les_planetes(moons)
!-
! C'est ici que se passe le deplacement des choses mouvantes
!-
! Il y a deux manieres d'aborder les bords de l'univers (non, le combo
! segfault/coredump n'en fait pas partie).
!-
subroutine deplace_les_planetes(moons, clipit)
type(massbody), intent(inout) :: moons(:)
logical, intent(in) :: clipit
integer :: foo
real :: depx, depy
integer, parameter :: EE = 45
integer :: SW = S_WIDTH - EE
integer :: SH = S_HEIGHT - EE
do foo=1, ubound(moons, 1)
! print *, "----- deplace ",foo, "serial ", moons(foo)%serial
@@ -68,15 +81,24 @@ subroutine deplace_les_planetes(moons)
!-
! ici se pose une question pertinente sur la gestion des
! bords du chanmp. Cclippin or Boucing ?
! bords du chanmp. Clipping, Toring or Boucing ?
!-
if (moons(foo)%posx .GT. S_WIDTH) moons(foo)%posx = 0.0
if (moons(foo)%posy .GT. S_HEIGHT) moons(foo)%posy = 0.0
if (moons(foo)%posx .LT. 0) moons(foo)%posx = S_WIDTH
if (moons(foo)%posy .LT. 0) moons(foo)%posy = S_HEIGHT
if (clipit) then
if (moons(foo)%posx .GT. SW) moons(foo)%posx = SW
if (moons(foo)%posy .GT. SH) moons(foo)%posy = SH
if (moons(foo)%posx .LT. EE) moons(foo)%posx = EE
if (moons(foo)%posy .LT. EE) moons(foo)%posy = EE
! STOP 'BECAUSE WE ARE TOTALY FUCKED'
else
if (moons(foo)%posx .GT. SW) moons(foo)%posx = EE
if (moons(foo)%posy .GT. SH) moons(foo)%posy = EE
if (moons(foo)%posx .LT. EE) moons(foo)%posx = SW
if (moons(foo)%posy .LT. EE) moons(foo)%posy = SH
endif
moons(foo)%heading = moons(foo)%heading + (0.08*rand())
moons(foo)%heading = moons(foo)%heading + (0.25*(rand()-0.499999))
if (moons(foo)%heading .GT. 6.2831853) moons(foo)%heading = 0.0
if (moons(foo)%heading .LT. 0.0000001) moons(foo)%heading = 0.0
enddo