module spitpgm implicit none contains !----------------------------------------------------- subroutine spit_as_pgm(pic, fname) integer, intent(in), dimension (:,:) :: pic character (len=*), intent(in) :: fname integer :: io, foo integer :: ix, iy real :: fk, fpix write(0, '(1X, A)') "> spit_as_pgm to " // trim(fname) open(newunit=io, file=fname) write (io, '(a2)') "P2" write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2) write (io, '(i0)') 65535 foo = MAXVAL(pic) if (foo .EQ. 0) then print *, " IS SOMETHING WRONG GOING TO HAPPEN ?" do ix = 1, size(pic) write (io, "(i0)") 0 enddo else fk = float(foo) / 65535.0 print *, " max pix value", foo, " fk = ", fk do iy = 1, ubound(pic, 2) do ix = 1, ubound(pic, 1) fpix = float(pic(ix, iy)) / fk write (io, "(i0)") int(fpix) end do end do endif close(io) end subroutine !----------------------------------------------------- subroutine spit_as_pgm_8(pic, fname) integer, intent(in), dimension (:,:) :: pic character (len=*), intent(in) :: fname integer :: io, foo integer :: ix, iy ! XXX print *, "> spit_as_pgm_8 to ", fname foo = MAXVAL(pic) ! XXX print *, " max = ", foo open(newunit=io, file=fname) write (io, '(a2)') "P2" write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2) write (io, '(i0)') 255 do iy=1,ubound(pic, 2) do ix=1, ubound(pic, 1) foo = pic(ix, iy) if (foo .GT. 255) foo = 255 write(io, "(i3)") foo enddo enddo close(io) end subroutine !----------------------------------------------------- end module spitpgm