Fortraneries/Modules/spitpgm.f90

107 lines
2.8 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, '("# 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