!----------------------------------------------------------------------- !- ! test program for the 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 !----------------------------------------------------------------------- !----------------------------------------------------------------------- end program