trials.f90: buffering is good for the planet

This commit is contained in:
tTh 2022-12-06 01:49:45 +01:00
parent 5b6df523fc
commit cc71a55ccb
5 changed files with 84 additions and 14 deletions

View File

@ -4,15 +4,21 @@
# Makefile for the general purpose moduls # Makefile for the general purpose moduls
# #
GFOPT = -Wall -Wextra -time -g -O GFOPT = -Wall -Wextra -time -g
all: chkpixels
spitpgm.o: spitpgm.f90 Makefile spitpgm.o: spitpgm.f90 Makefile
gfortran $(GFOPT) -c $< -o $@ gfortran $(GFOPT) -c $< -o $@
trials.o: trials.f90 Makefile
gfortran $(GFOPT) -c $< -o $@
# #
# programmes de testouille # programmes de testouille
# #
chkpixels: chkpixels.f90 Makefile spitpgm.o chkpixels: chkpixels.f90 Makefile trials.o spitpgm.o
gfortran $(GFOPT) $< spitpgm.o -o $@ gfortran $(GFOPT) $< spitpgm.o trials.o -o $@

View File

@ -1,4 +1,10 @@
# General purpose modules # General purpose modules
* spitpgm ## spitpgm
Write gray level 2d buffer (aka picture) to disk in the NetPNM format.
## trials
Experimental WIPs from hell.

View File

@ -1,20 +1,25 @@
!-------------------------------------------------------------------
!-
program chkpixels program chkpixels
use spitpgm use spitpgm ! main module
use trials ! experiments, ymmv.
implicit none implicit none
write(0, *) "------ CHKPIXELS ------" write(0, *) "------ CHKPIXELS ------"
call test_alpha() call test_alpha(3)
STOP 'BECAUSE NO CPU AVAILABLE' STOP 'BECAUSE NO CPU AVAILABLE'
contains contains
!------------------------------------------------------------------- !-------------------------------------------------------------------
!- !-
subroutine test_alpha() subroutine test_alpha(increment)
integer, intent(in) :: increment
integer, parameter :: SZ = 32 integer, parameter :: SZ = 40
integer, dimension(SZ, SZ) :: greymap integer, dimension(SZ, SZ) :: greymap
integer :: ix, iy, value integer :: ix, iy, value
@ -22,12 +27,14 @@ contains
do iy=1, SZ do iy=1, SZ
do ix=1, SZ do ix=1, SZ
greymap(ix, iy) = value greymap(ix, iy) = value
value = value + 1 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')
end subroutine end subroutine

View File

@ -8,8 +8,9 @@ module spitpgm
!------------------------------------------------------------------- !-------------------------------------------------------------------
!- !-
! This subroutine try to scale the values to fit the 16 bit range ! 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) subroutine spit_as_pgm_eq(pic, fname)
integer, intent(in), dimension (:,:) :: pic integer, intent(in), dimension (:,:) :: pic
@ -19,7 +20,7 @@ subroutine spit_as_pgm_eq(pic, fname)
integer :: ix, iy integer :: ix, iy
real :: fk, fpix real :: fk, fpix
write(0, '(1X, A)') "> spit_as_pgm_eq to " // trim(fname) ! write(0, '(1X, A)') " spit_as_pgm_eq to " // trim(fname)
open(newunit=io, file=fname) open(newunit=io, file=fname)
write (io, '(a2)') "P2" write (io, '(a2)') "P2"
@ -34,7 +35,7 @@ subroutine spit_as_pgm_eq(pic, fname)
enddo enddo
else else
fk = float(foo) / 65535.01 fk = float(foo) / 65535.01
write (0, *) " max pix value", foo, " fk ", fk ! write (0, *) " max pix value", foo, " fk ", fk
do iy = 1, ubound(pic, 2) do iy = 1, ubound(pic, 2)
do ix = 1, ubound(pic, 1) do ix = 1, ubound(pic, 1)
fpix = float(pic(ix, iy)) / fk fpix = float(pic(ix, iy)) / fk
@ -48,6 +49,7 @@ end subroutine
!------------------------------------------------------------------- !-------------------------------------------------------------------
!- !-
! 16 bits - 65535 levels portable grey map file ! 16 bits - 65535 levels portable grey map file
! no data conversion except upper clippin.
!- !-
subroutine spit_as_pgm_16(pic, fname) subroutine spit_as_pgm_16(pic, fname)
integer, intent(in), dimension (:,:) :: pic integer, intent(in), dimension (:,:) :: pic

49
Modules/trials.f90 Normal file
View File

@ -0,0 +1,49 @@
!-
! This module try to write PNM complient files - ymmv
!-
module trials
implicit none
contains
!-------------------------------------------------------------------
subroutine new_spit_a(pic, fname)
integer, intent(in), dimension (:,:) :: pic
character (len=*), intent(in) :: fname
integer :: foo, io, ix, iy
integer :: buffer(8), ptr
! print *, "newspit a, largeur ", size(pic, 1), ubound(pic, 1)
! print *, "newspit a, hauteur ", size(pic, 2), ubound(pic, 2)
! print *, "newspit a, buffer ", size(buffer, 1)
open(newunit=io, file=fname)
write (io, '(a2)') "P2"
write (io, '("# new_spit_a")')
write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2)
write (io, '(i0)') 65535
buffer = 0
ptr = 1
do iy=1, ubound(pic, 2)
do ix=1, ubound(pic, 1)
foo = pic(ix, iy)
if (foo .GT. 65535) foo = 65535
buffer(ptr) = foo
ptr = ptr + 1
if (ptr .EQ. size(buffer, 1)+1) then
write(io, "(8(' ',i0))") buffer
ptr = 1
endif
enddo
enddo
close(io)
end subroutine
!-------------------------------------------------------------------
end module