Fortraneries/Modules/spitpgm.f90

108 lines
2.9 KiB
Fortran
Raw Normal View History

2022-11-30 01:02:11 +01:00
!-
2022-12-16 19:26:54 +01:00
! This module try to write PGM complient gray level files
2022-11-30 02:31:43 +01:00
!-
2022-11-30 01:02:11 +01:00
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 ?
!-
2022-11-30 01:02:11 +01:00
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)
2022-11-30 01:02:11 +01:00
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
2022-12-01 12:03:22 +01:00
fk = float(foo) / 65535.01
! write (0, *) " max pix value", foo, " fk ", fk
2022-11-30 01:02:11 +01:00
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 02:31:43 +01:00
!-
! 16 bits - 65535 levels portable grey map file
! no data conversion except upper clippin.
2022-11-30 02:31:43 +01:00
!-
2022-11-30 01:02:11 +01: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"
2023-01-07 10:40:29 +01:00
write (io, '(A)') "# spit_as_pgm_16"
! write (io, '("# size:", I9)') size(pic)
2022-11-30 01:02:11 +01:00
write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2)
2022-11-30 02:31:43 +01:00
write (io, '(i0)') 65535
2022-12-01 12:03:22 +01:00
2022-11-30 01:02:11 +01:00
do iy=1,ubound(pic, 2)
do ix=1, ubound(pic, 1)
foo = pic(ix, iy)
2022-12-01 12:03:22 +01:00
if (foo .GT. 65535) foo = 65535
write(io, "(i0)") foo
2022-11-30 01:02:11 +01: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"
2022-12-17 12:09:57 +01:00
write (io, '(A)') "# spit_as_pgm_8"
2022-11-30 01:02:11 +01:00
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
2022-12-01 12:03:22 +01:00
write(io, "(i0)") foo
2022-11-30 01:02:11 +01:00
enddo
enddo
close(io)
end subroutine
!-------------------------------------------------------------------
end module spitpgm