!**********************************************************************!
!
! File: pgmfilter.f90 (25-May-2001)
!                     (27-May-2005)
!
! Glaetten eines Schwarzweissbildes [Pixelmap im (ASCII) PGM-Format]
!
!   Jedes Pixel (Grauwert) wird durch den Mittelwert der m*m
!   Nachbarpixel ersetzt.
!
! infile....Originalbild (PGM-File mit maxgray=255 und 17 Pixel/Zeile)
! m.........Filterbreite in Pixel (ungerade)
! outfile...geglaettetes Bild
!
!**********************************************************************!

module pgmf_m

  implicit none

  public::smooth
  integer,parameter,public::short=selected_int_kind(3)

contains

!**********************************************************************!

  subroutine smooth(imgs,img,m)

!**********************************************************************!

    integer,intent(in)::m
    integer(kind=short),dimension(:,:),intent(in)::img
    integer(kind=short),dimension(:,:),intent(out)::imgs
    integer::is,ix,iy,jx,jy,k,nx,ny

    nx=size(img,1)
    ny=size(img,2)

    do ix=1,nx
      do iy=1,ny
        k=0
        is=0
        do jx=max(ix-m/2,1),min(ix+m/2,nx)
          do jy=max(iy-m/2,1),min(iy+m/2,ny)
            k=k+1
            is=is+img(jx,jy)
          end do
        end do
        imgs(ix,iy)=is/k
      end do
    end do

    return

  end subroutine smooth

end module pgmf_m

!**********************************************************************!

program pgmfilter

!**********************************************************************!

  use pgmf_m

  implicit none

  integer,parameter::iin=1,iout=2

  character(len=2)::pnm
  character(len=80)::fname
  integer::ix,iy,k,m,maxgray,nx,ny
  integer(kind=short),dimension(:,:),allocatable::img,imgs

  write(unit=*,fmt="("" infile="")",advance="no")
  read(unit=*,fmt="(a)") fname

  open(unit=iin,file=fname,status="old",action="read", &
       form="formatted")

  read(unit=iin,fmt="(a)") pnm
  read(unit=iin,fmt=*) nx,ny
  read(unit=iin,fmt=*) maxgray

  allocate(img(nx,ny),imgs(nx,ny))

  k=0
  do iy=1,ny
    do ix=1,nx
      k=k+1
      if(k<17) then
        read(unit=iin,fmt="(i3,tr1)",advance="no") img(ix,iy)
      else
        k=0
        read(unit=iin,fmt="(i3,tr1)") img(ix,iy)
      end if
    end do
  end do

  close(unit=iin)

  do
    write(unit=*,fmt="("" m="")",advance="no")
    read(unit=*,fmt=*) m
    if(modulo(m,2)==1) then
      exit
    end if
  end do

  call smooth(imgs,img,m)

  write(unit=*,fmt="("" outfile="")",advance="no")
  read(unit=*,fmt="(a)") fname

  open(unit=iout,file=fname,status="replace",action="write", &
       form="formatted")

  write(unit=iout,fmt="(a)") pnm
  write(unit=iout,fmt=*) nx,ny
  write(unit=iout,fmt=*) maxgray

  k=0
  do iy=1,ny
    do ix=1,nx
      k=k+1
      if(k<17) then
        write(unit=iout,fmt="(i3,tr1)",advance="no") imgs(ix,iy)
      else
        k=0
        write(unit=iout,fmt="(i3,tr1)") imgs(ix,iy)
      end if
    end do
  end do

  close(unit=iout)

end program pgmfilter

!**********************************************************************!