99 lines
2.6 KiB
Fortran
99 lines
2.6 KiB
Fortran
|
!-
|
||
|
|
! This module try to write PNM complient files - ymmv
|
||
|
|
!
|
||
|
|
module spitpgm
|
||
|
|
|
||
|
|
implicit none
|
||
|
|
contains
|
||
|
|
|
||
|
|
!-------------------------------------------------------------------
|
||
|
|
!-
|
||
|
|
! This subroutine try to scale the values to fit the 16 bit range
|
||
|
|
!
|
||
|
|
subroutine spit_as_pgm_eq(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_16(pic, fname)
|
||
|
|
integer, intent(in), dimension (:,:) :: pic
|
||
|
|
character (len=*), intent(in) :: fname
|
||
|
|
|
||
|
|
integer :: io, foo
|
||
|
|
integer :: ix, iy
|
||
|
|
|
||
|
|
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. 65535) foo = 65530
|
||
|
|
write(io, "(i3)") foo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
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
|