diff --git a/GravityField/.gitignore b/GravityField/.gitignore index fbb7838..f04cd67 100644 --- a/GravityField/.gitignore +++ b/GravityField/.gitignore @@ -13,6 +13,7 @@ WS/data/* *.gif *.log *.mp4 +*.dump *.stderr diff --git a/GravityField/essai.f90 b/GravityField/essai.f90 index 5b55988..4bf5ea4 100644 --- a/GravityField/essai.f90 +++ b/GravityField/essai.f90 @@ -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 diff --git a/GravityField/realfield.f90 b/GravityField/realfield.f90 index cc2f361..d43d72e 100644 --- a/GravityField/realfield.f90 +++ b/GravityField/realfield.f90 @@ -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 !----------------------------------------------------------------------- !-----------------------------------------------------------------------