Fortraneries/Fraktalism/mods/spitpgm.f90

74 lines
1.8 KiB
Fortran
Raw Normal View History

2022-03-21 18:28:42 +01:00
module spitpgm
implicit none
contains
!-----------------------------------------------------
subroutine spit_as_pgm(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_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