108 lines
2.9 KiB
Fortran
108 lines
2.9 KiB
Fortran
!-
|
|
! This module try to write PGM complient gray level files
|
|
!-
|
|
module spitpgm
|
|
|
|
implicit none
|
|
contains
|
|
|
|
!-------------------------------------------------------------------
|
|
!-
|
|
! This subroutine try to scale the values to fit the 16 bit range.
|
|
! XXX may be add a third parameter : the max value required ?
|
|
!-
|
|
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_eq 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.01
|
|
! write (0, *) " 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
|
|
!-------------------------------------------------------------------
|
|
!-
|
|
! 16 bits - 65535 levels portable grey map file
|
|
! no data conversion except upper clippin.
|
|
!-
|
|
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, '(A)') "# spit_as_pgm_16"
|
|
! write (io, '("# size:", I9)') size(pic)
|
|
write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2)
|
|
write (io, '(i0)') 65535
|
|
|
|
do iy=1,ubound(pic, 2)
|
|
do ix=1, ubound(pic, 1)
|
|
foo = pic(ix, iy)
|
|
if (foo .GT. 65535) foo = 65535
|
|
write(io, "(i0)") 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, '(A)') "# spit_as_pgm_8"
|
|
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, "(i0)") foo
|
|
enddo
|
|
enddo
|
|
close(io)
|
|
|
|
end subroutine
|
|
!-------------------------------------------------------------------
|
|
|
|
end module spitpgm
|