52 lines
1.2 KiB
Fortran
52 lines
1.2 KiB
Fortran
!-
|
|
! This module try to write PNM complient files - ymmv
|
|
!-
|
|
module trials
|
|
|
|
implicit none
|
|
|
|
contains
|
|
!-------------------------------------------------------------------
|
|
! please write the same thing for RGB 16bits pictures !
|
|
|
|
subroutine new_spit_gray(pic, fname)
|
|
|
|
integer, intent(in), dimension (:,:) :: pic
|
|
character (len=*), intent(in) :: fname
|
|
|
|
integer :: foo, io, ix, iy
|
|
integer :: buffer(8), ptr
|
|
|
|
! print *, "newspit a, largeur ", size(pic, 1), ubound(pic, 1)
|
|
! print *, "newspit a, hauteur ", size(pic, 2), ubound(pic, 2)
|
|
! print *, "newspit a, buffer ", size(buffer, 1)
|
|
|
|
open(newunit=io, file=fname)
|
|
write (io, '(a2)') "P2"
|
|
write (io, '("# new_spit_gray")')
|
|
write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2)
|
|
write (io, '(i0)') 65535
|
|
|
|
buffer = 0
|
|
ptr = 1
|
|
|
|
do iy=1, ubound(pic, 2)
|
|
do ix=1, ubound(pic, 1)
|
|
foo = pic(ix, iy)
|
|
if (foo .GT. 65535) foo = 65535
|
|
buffer(ptr) = foo
|
|
ptr = ptr + 1
|
|
if (ptr .EQ. size(buffer, 1)+1) then
|
|
write(io, "(8(' ',i0))") buffer
|
|
ptr = 1
|
|
endif
|
|
enddo
|
|
enddo
|
|
|
|
close(io)
|
|
|
|
end subroutine
|
|
!-------------------------------------------------------------------
|
|
|
|
end module
|