write_header Subroutine

private subroutine write_header(this, nunit)

Writes the header of the PNM image to a file. Required before writing the pixels to the file.

Arguments

Type IntentOptional Attributes Name
type(format_pnm), intent(in) :: this
integer, intent(in) :: nunit

Called by

proc~~write_header~~CalledByGraph proc~write_header write_header proc~export_pnm format_pnm%export_pnm proc~export_pnm->proc~write_header proc~save color%save proc~save->proc~export_pnm program~demo_ppm demo_ppm program~demo_ppm->proc~export_pnm program~test test program~test->proc~export_pnm program~test1 test1 program~test1->proc~export_pnm program~test10 test10 program~test10->proc~export_pnm program~test11 test11 program~test11->proc~export_pnm program~test12 test12 program~test12->proc~export_pnm program~test13 test13 program~test13->proc~export_pnm program~test14 test14 program~test14->proc~export_pnm program~test17 test17 program~test17->proc~export_pnm program~test18 test18 program~test18->proc~export_pnm program~test19 test19 program~test19->proc~export_pnm program~test2 test2 program~test2->proc~export_pnm program~test20 test20 program~test20->proc~export_pnm program~test21 test21 program~test21->proc~export_pnm program~test22 test22 program~test22->proc~export_pnm program~test23 test23 program~test23->proc~export_pnm program~test24 test24 program~test24->proc~export_pnm program~test25 test25 program~test25->proc~export_pnm program~test3 test3 program~test3->proc~export_pnm program~test4 test4 program~test4->proc~export_pnm program~test6 test6 program~test6->proc~export_pnm program~test7 test7 program~test7->proc~export_pnm program~test8 test8 program~test8->proc~export_pnm program~test9 test9 program~test9->proc~export_pnm

Source Code

   subroutine write_header(this, nunit)
      type(format_pnm), intent(in) :: this
      integer, intent(in)           :: nunit
      integer :: i, k

      ! Write magic number
      write(nunit,'(a)') this%magic_number

      ! Write comments
      k = ceiling(real(len(adjustl(this%comment)))/70.0)
      if (len(adjustl(this%comment)) /=0 .and. len(adjustl(this%comment)) <= 70) then
         write(nunit,'(a,a)') '# ',trim(adjustl(this%comment))
      else if (len(adjustl(this%comment)) /=0 .and. len(adjustl(this%comment)) > 70 ) then
         do i = 1, k-1
            write(nunit,'(a,a)') '# ',adjustl(this%comment(70*(i-1)+1:70*(i-1)+70))
         end do
         write(nunit,'(a,a)') '# ',trim(adjustl(this%comment(70*(k-1)+1:)))
      end if

      ! Write width, height and max_color
      write(nunit, '(g0,1x,g0)') this%width, this%height
      if (this%file_format /= 'pbm') write(nunit,'(g0)') this%max_color
   end subroutine write_header