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

this part need a lot of more work !

Browse Source
This commit is contained in:
tTh
2023-02-11 17:00:58 +01:00
parent 87191666b4
commit 6c9f562c13
13 changed files with 84 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
GravityField/animation.f90
View File

@@ -13,18 +13,16 @@ program animation
implicit none
! some configuration constants
integer, parameter :: S_WIDTH = 1024
integer, parameter :: S_HEIGHT = 1024
integer, parameter :: NB_BODY = 51
integer, parameter :: S_WIDTH = 2048
integer, parameter :: S_HEIGHT = 2048
integer, parameter :: NB_BODY = 250
!!! WARNING : global variable !!!
type(massbody) :: planets(NB_BODY)
call init_random()
call create_some_planets(planets, 1664e3, S_WIDTH , S_HEIGHT)
call print_barycentre_bodies(planets)
! STOP 'BEFORE CRASH'
call print_barycentre_bodies(planets, 'begin')
call la_grande_boucle(0, 2000, planets)
@@ -33,7 +31,7 @@ program animation
!-----------------------------------------------------------------------
contains
!-
! fabrication d'une de la sequence complete
! fabrication de la sequence complete
!-
subroutine la_grande_boucle(start, nbre, moons)
integer, intent(in) :: start, nbre
@@ -47,19 +45,21 @@ subroutine la_grande_boucle(start, nbre, moons)
! else use ?????ing
call deplace_les_planetes(moons, .TRUE.)
! computing the field (used as a HF in Povray
write (filename, "(a, i5.5, a)") 'WS/nanim/', pass, '.pgm'
write(0, '(3I5, " * ", a20)') start, nbre, pass, filename
call build_and_write_a_field(S_WIDTH, S_HEIGHT, moons, filename)
write (filename, "(a, i5.5, a)") 'WS/data/', pass, '.txt'
call save_bodies_to_txt_file (planets, filename)
! save the current bodies positions (can be used in gnuplot)
! write (filename, "(a, i5.5, a)") 'WS/data/', pass, '.txt'
! call save_bodies_to_txt_file (planets, filename)
write (filename, "(a, i5.5, a)") 'WS/colmap/', pass, '.pnm'
call make_color_map(planets, filename, S_WIDTH, S_HEIGHT)
enddo
call print_barycentre_bodies(moons)
call print_barycentre_bodies(moons, 'end')
end subroutine
@@ -72,11 +72,11 @@ subroutine make_color_map(moons, fname, width, height)
character(len=*), intent(in) :: fname
integer, intent(in) :: width, height
type(t_pixrgb), dimension(:,:), allocatable :: cmap
integer :: ix, iy, near, ipl
integer :: errcode
real :: curdist, smalldist
real :: fx, fy, dx, dy
type(t_pixrgb), dimension(:,:), allocatable :: cmap
integer :: ix, iy, near, ipl
integer :: errcode
real :: curdist, smalldist
real :: fx, fy, dx, dy
write(0, *) "colmap ", ubound(moons, 1), "moons to ", trim(fname)
! write(0, *) "mapsize ", width, height
@@ -107,14 +107,14 @@ subroutine make_color_map(moons, fname, width, height)
endif
end do ! loop on all the moons, ipl index
cmap(ix, iy)%r = mod(near*13, 255)
cmap(ix, iy)%g = mod(near*14, 255)
cmap(ix, iy)%b = mod(near*15, 255)
cmap(ix, iy)%r = mod(near*3, 255)
cmap(ix, iy)%g = mod(near*4, 255)
cmap(ix, iy)%b = mod(near*5, 255)
enddo
enddo
call rgbpix_spit_as_pnm(cmap, fname)
call rgbpix_spit_as_pnm_8(cmap, fname)
deallocate(cmap)
@@ -131,9 +131,9 @@ subroutine deplace_les_planetes(moons, clipit)
logical, intent(in) :: clipit
integer :: foo
real :: depx, depy
real :: depx, depy, coef
integer, parameter :: EE = 51
integer, parameter :: EE = 100
integer :: SW = S_WIDTH - EE
integer :: SH = S_HEIGHT - EE
@@ -162,7 +162,12 @@ subroutine deplace_les_planetes(moons, clipit)
if (moons(foo)%posy .LT. EE) moons(foo)%posy = SH
endif
moons(foo)%heading = moons(foo)%heading + (0.78*(rand()-0.50))
if (rand() .LT. 0.15) then
coef = 1.63
else
coef = 0.78
endif
moons(foo)%heading = moons(foo)%heading + (coef*(rand()-0.42))
if (moons(foo)%heading .GT. 6.283185307) moons(foo)%heading = 0.0
if (moons(foo)%heading .LT. 0.000000001) moons(foo)%heading = 0.0