51 lines
1.1 KiB
Fortran
51 lines
1.1 KiB
Fortran
|
module spitpgm
|
||
|
|
|
||
|
|
implicit none
|
||
|
|
|
||
|
|
contains
|
||
|
|
|
||
|
|
!-----------------------------------------------------
|
||
|
|
|
||
|
|
subroutine spit_as_pgm(pic, fname)
|
||
|
|
|
||
|
|
! implicit none
|
||
|
|
|
||
|
|
integer, intent(in), dimension (:,:) :: pic
|
||
|
|
character (len=*), intent(in) :: fname
|
||
|
|
|
||
|
|
integer :: io, foo
|
||
|
|
integer :: ix, iy
|
||
|
|
real :: fk, fpix
|
||
|
|
|
||
|
|
print *, "> spit_as_pgm to ", 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
|
||
|
|
!-----------------------------------------------------
|
||
|
|
|
||
|
|
end module spitpgm
|