resize Subroutine

private pure elemental subroutine resize(this, new_height, new_width)

Resizes the image to specified dimensions.

Type Bound

format_pnm

Arguments

Type IntentOptional Attributes Name
class(format_pnm), intent(inout) :: this
integer, intent(in) :: new_height
integer, intent(in) :: new_width

Calls

proc~~resize~~CallsGraph proc~resize format_pnm%resize proc~allocate_pixels format_pnm%allocate_pixels proc~resize->proc~allocate_pixels proc~set_height format_pnm%set_height proc~resize->proc~set_height proc~set_pixels format_pnm%set_pixels proc~resize->proc~set_pixels proc~set_width format_pnm%set_width proc~resize->proc~set_width proc~check_pixel_range format_pnm%check_pixel_range proc~set_pixels->proc~check_pixel_range

Called by

proc~~resize~~CalledByGraph proc~resize format_pnm%resize program~demo_ppm demo_ppm program~demo_ppm->proc~resize program~test25 test25 program~test25->proc~resize

Source Code

   elemental pure subroutine resize(this, new_height, new_width)
      class(format_pnm), intent(inout)         :: this
      integer,           intent(in)            :: new_width, new_height
      integer(ik), dimension(:,:), allocatable :: resized_pixels
      integer                                  :: i_out, j_out, i_in, j_in, channel
      real(rk)                                 :: width_scale, height_scale

      select case (this%file_format)
       case ('pbm', 'pgm')

         allocate(resized_pixels(new_height, new_width))

         width_scale  = real(this%width, kind=rk) / real(new_width, kind=rk)
         height_scale = real(this%height, kind=rk) / real(new_height, kind=rk)

         do i_out = 1, new_height
            do j_out = 1, new_width
               i_in = min(this%height, max(1, int((real(i_out, kind=rk) - 0.5_rk) * height_scale) + 1))
               j_in = min(this%width,  max(1, int((real(j_out, kind=rk) - 0.5_rk) * width_scale)  + 1))

               resized_pixels(i_out, j_out) = this%pixels(i_in, j_in)
            end do
         end do

       case ('ppm')

         allocate(resized_pixels(new_height, 3*new_width))

         width_scale  = real(this%width, kind=rk) / real(new_width, kind=rk)
         height_scale = real(this%height, kind=rk) / real(new_height, kind=rk)

         do i_out = 1, new_height
            do j_out = 1, new_width
               i_in = min(this%height,  max(1, int((real(i_out, kind=rk) - 0.5_rk) * height_scale) + 1))
               j_in = min(3*this%width, max(1, int((real(j_out, kind=rk) - 0.5_rk) * width_scale)  + 1))

               do channel = 1, 3
                  resized_pixels(i_out, 3*(j_out-1) + channel) = this%pixels(i_in, 3*(j_in-1)+channel)
               end do
            end do
         end do

      end select

      call this%set_height(new_height)
      call this%set_width(new_width)
      deallocate(this%pixels)
      call this%allocate_pixels()
      call this%set_pixels(resized_pixels)

      deallocate(resized_pixels)
   end subroutine resize