!----------------------------------------------------------------------- ! ! project "gravity field" ! !----------------------------------------------------------------------- program essai use realfield use spitpgm ! XXX implicit none type(massbody) :: planet integer :: foo character (len=100) :: filename planet%posx = 337.314 planet%posy = 164.666 planet%mass = 1e8 planet%serial = 42 do foo=0, 48 write (filename, "(a, i5.5, a)") 'WS/', foo, '.pgm' call build_and_write_a_field(800, 600, planet, filename) planet%posx = planet%posx + 6.99 planet%posy = planet%posy + 2.55 enddo STOP 'YOLO' contains !----------------------------------------------------------------------- !- ! compute a field with only one body; and write pic file !- subroutine build_and_write_a_field(szx, szy, moon, fname) integer, intent(in) :: szx, szy type(massbody), intent(in) :: moon character (len=*), intent(in) :: fname real :: maxi, mini integer :: errcode real, dimension(:,:), allocatable :: field integer, dimension(:,:), allocatable :: greymap allocate(field(szx, szy), stat=errcode) call compute_a_field(field, moon) maxi = maxval(field) mini = minval(field) print *, "field: ", mini, maxi, maxi-mini allocate(greymap(szx, szy), stat=errcode) greymap = 65535 ! convert from real value to 16 bits int values where (field < 65530.0) greymap = int(field) end where call spit_as_pgm_16(greymap, trim(fname)) ! make valgrind happy deallocate(field) deallocate(greymap) end subroutine !----------------------------------------------------------------------- !- ! Compute the gravity field in a pre-allocated array relative ! to the massbody 'moon'. Nobody know where the magic number ! come from, sorry. !- subroutine compute_a_field(field, moon) real, dimension(:,:), intent(out) :: field type(massbody), intent(in) :: moon integer :: ix, iy real :: fx, fy real :: grav ! print *, "pic size ", ubound(field, 1), "W", ubound(field, 2), "H" ! print *, "mass body ", moon do ix=1, ubound(field, 1) fx = real(ix) do iy=1, ubound(field, 2) fy = real(iy) grav = compute_gravity(fx, fy, moon) field(ix,iy) = grav enddo enddo end subroutine !----------------------------------------------------------------------- !----------------------------------------------------------------------- end program