Fortraneries/GravityField/essai.f90

!-----------------------------------------------------------------------
!
!       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