2022-11-30 11:02:11 +11:00
|
|
|
!-
|
|
|
|
|
! This module try to write PNM complient files - ymmv
|
2022-11-30 12:31:43 +11:00
|
|
|
!-
|
2022-11-30 11:02:11 +11:00
|
|
|
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
|
|
|
|
|
!-------------------------------------------------------------------
|
2022-11-30 12:31:43 +11:00
|
|
|
!-
|
|
|
|
|
! 16 bits - 65535 levels portable grey map file
|
|
|
|
|
!-
|
2022-11-30 11:02:11 +11:00
|
|
|
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)
|
2022-11-30 12:31:43 +11:00
|
|
|
write (io, '(i0)') 65535
|
2022-11-30 11:02:11 +11:00
|
|
|
do iy=1,ubound(pic, 2)
|
|
|
|
|
do ix=1, ubound(pic, 1)
|
|
|
|
|
foo = pic(ix, iy)
|
|
|
|
|
if (foo .GT. 65535) foo = 65530
|
2022-11-30 12:31:43 +11:00
|
|
|
write(io, "(i5)") foo
|
2022-11-30 11:02:11 +11:00
|
|
|
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
|
