tTh/Fortraneries
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

cleanup + add a 0 func

Browse Source
This commit is contained in:
tTh 2022-12-24 22:13:17 +01:00
parent ab601629e5
commit 8ea11d110b
2 changed files with 19 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
Modules/chkpixels.f90
View File

@ -18,6 +18,8 @@ program chkpixels
contains contains
!------------------------------------------------------------------- !-------------------------------------------------------------------
!-
! exerciser for the 'pixrgb' module
!- !-
subroutine test_spit_rgb(sz) subroutine test_spit_rgb(sz)
integer, intent(in) :: sz integer, intent(in) :: sz
@ -27,20 +29,15 @@ contains
print *, "test spit rgb", sz print *, "test spit rgb", sz
allocate(pixrgb(sz, sz)) allocate(pixrgb(sz, sz))
! pixrgb = 0 call rgbpix_set_to_zero(pixrgb)
do ix=1, sz do ix=1, sz
do iy=1, sz do iy=1, sz
pixrgb(ix, iy)%r = ix pixrgb(ix, iy)%r = ix
pixrgb(ix, iy)%g = 0 pixrgb(ix, iy)%g = 0
pixrgb(ix, iy)%b = iy pixrgb(ix, iy)%b = iy
end do end do
end do end do
call rgbpix_spit_as_pnm_8(pixrgb, "rgb.pnm") call rgbpix_spit_as_pnm_8(pixrgb, "rgb.pnm")
deallocate(pixrgb) deallocate(pixrgb)
end subroutine end subroutine
@ -60,12 +57,10 @@ contains
value = value + increment value = value + increment
enddo enddo
enddo enddo
call spit_as_pgm_16 (greymap, 'a.pgm') call spit_as_pgm_16 (greymap, 'a.pgm')
call spit_as_pgm_eq (greymap, 'b.pgm') call spit_as_pgm_eq (greymap, 'b.pgm')
call spit_as_pgm_8 (greymap, 'c.pgm') call spit_as_pgm_8 (greymap, 'c.pgm')
call new_spit_a (greymap, 'x.pgm') call new_spit_a (greymap, 'x.pgm')
end subroutine end subroutine
end program end program

24
Modules/pixrgb.f90
View File

@ -15,8 +15,20 @@ end type
contains contains
!------------------------------------------------------------------- !-------------------------------------------------------------------
!- !-
subroutine rgbpix_set_to_zero(pic)
type(t_pixrgb), intent(out) :: pic(:,:)
integer :: ix, iy
do iy=1, ubound(pic, 2)
do ix=1, ubound(pic, 1)
pic(ix, iy)%r = 0
pic(ix, iy)%g = 0
pic(ix, iy)%b = 0
enddo
enddo
end subroutine
!-------------------------------------------------------------------
!-
subroutine rgbpix_spit_as_pnm_8(pic, fname) subroutine rgbpix_spit_as_pnm_8(pic, fname)
type(t_pixrgb), intent(in) :: pic(:,:) type(t_pixrgb), intent(in) :: pic(:,:)
character (len=*), intent(in) :: fname character (len=*), intent(in) :: fname
@ -25,14 +37,12 @@ subroutine rgbpix_spit_as_pnm_8(pic, fname)
open(newunit=io, file=fname) open(newunit=io, file=fname)
write (io, '(a2)') "P3" write (io, '(a2)') "P3"
write (io, '("# rgbpix_spit_as_pnm_8")') write (io, '("# rgbpix_spit_as_pnm_8")')
write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2) write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2)
write (io, '(i0)') 255 write (io, '(i0)') 255
do iy=1, ubound(pic, 2) do iy=1, ubound(pic, 2)
do ix=1, ubound(pic, 1) do ix=1, ubound(pic, 1)
write(io, "(3I12)") pic(ix, iy)%r, pic(ix, iy)%g, pic(ix, iy)%b
write(io, "(3I4)") pic(ix, iy)%r, pic(ix, iy)%g, pic(ix, iy)%b
enddo enddo
enddo enddo
close(unit=io) close(unit=io)
@ -55,9 +65,7 @@ subroutine rgbpix_spit_as_pnm_16(pic, fname)
do iy=1, ubound(pic, 2) do iy=1, ubound(pic, 2)
do ix=1, ubound(pic, 1) do ix=1, ubound(pic, 1)
write(io, "(3I6)") pic(ix, iy)%r, pic(ix, iy)%g, pic(ix, iy)%b
write(io, "(3I6)") pic(ix, iy)%r, pic(ix, iy)%g, pic(ix, iy)%b
enddo enddo
enddo enddo
close(unit=io) close(unit=io)