trials.f90: buffering is good for the planet
This commit is contained in:
tTh
parent
5b6df523fc
commit
cc71a55ccb
|
|
@ -4,15 +4,21 @@
|
|||
# Makefile for the general purpose moduls
|
||||
#
|
||||
|
||||
GFOPT = -Wall -Wextra -time -g -O
|
||||
GFOPT = -Wall -Wextra -time -g
|
||||
|
||||
all: chkpixels
|
||||
|
||||
|
||||
spitpgm.o: spitpgm.f90 Makefile
|
||||
gfortran $(GFOPT) -c $< -o $@
|
||||
|
||||
trials.o: trials.f90 Makefile
|
||||
gfortran $(GFOPT) -c $< -o $@
|
||||
|
||||
#
|
||||
# programmes de testouille
|
||||
#
|
||||
|
||||
chkpixels: chkpixels.f90 Makefile spitpgm.o
|
||||
gfortran $(GFOPT) $< spitpgm.o -o $@
|
||||
chkpixels: chkpixels.f90 Makefile trials.o spitpgm.o
|
||||
gfortran $(GFOPT) $< spitpgm.o trials.o -o $@
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,10 @@
|
|||
# General purpose modules
|
||||
|
||||
|
||||
* spitpgm
|
||||
## spitpgm
|
||||
|
||||
Write gray level 2d buffer (aka picture) to disk in the NetPNM format.
|
||||
|
||||
## trials
|
||||
|
||||
Experimental WIPs from hell.
|
||||
|
|
|
|||
|
|
@ -1,20 +1,25 @@
|
|||
!-------------------------------------------------------------------
|
||||
!-
|
||||
|
||||
program chkpixels
|
||||
|
||||
use spitpgm
|
||||
use spitpgm ! main module
|
||||
use trials ! experiments, ymmv.
|
||||
|
||||
implicit none
|
||||
|
||||
|
||||
write(0, *) "------ CHKPIXELS ------"
|
||||
call test_alpha()
|
||||
call test_alpha(3)
|
||||
|
||||
STOP 'BECAUSE NO CPU AVAILABLE'
|
||||
|
||||
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 :: ix, iy, value
|
||||
|
||||
|
|
@ -22,12 +27,14 @@ contains
|
|||
do iy=1, SZ
|
||||
do ix=1, SZ
|
||||
greymap(ix, iy) = value
|
||||
value = value + 1
|
||||
value = value + increment
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call spit_as_pgm_16 (greymap, 'a.pgm')
|
||||
call spit_as_pgm_eq (greymap, 'b.pgm')
|
||||
call spit_as_pgm_8 (greymap, 'c.pgm')
|
||||
call new_spit_a (greymap, 'x.pgm')
|
||||
|
||||
end subroutine
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
integer, intent(in), dimension (:,:) :: pic
|
||||
|
|
@ -19,7 +20,7 @@ subroutine spit_as_pgm_eq(pic, fname)
|
|||
integer :: ix, iy
|
||||
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)
|
||||
write (io, '(a2)') "P2"
|
||||
|
|
@ -34,7 +35,7 @@ subroutine spit_as_pgm_eq(pic, fname)
|
|||
enddo
|
||||
else
|
||||
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 ix = 1, ubound(pic, 1)
|
||||
fpix = float(pic(ix, iy)) / fk
|
||||
|
|
@ -48,6 +49,7 @@ end subroutine
|
|||
!-------------------------------------------------------------------
|
||||
!-
|
||||
! 16 bits - 65535 levels portable grey map file
|
||||
! no data conversion except upper clippin.
|
||||
!-
|
||||
subroutine spit_as_pgm_16(pic, fname)
|
||||
integer, intent(in), dimension (:,:) :: pic
|
||||
|
|
|
|||
|
|
@ -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
|
||||
Loading…
Reference in New Issue