Fortraneries/Modules/spitpgm.f90

!-
!	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, '(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