trials.f90: buffering is good for the planet

Modules/Makefile

@@ -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 $@
 

Modules/README.md

@@ -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.

Modules/chkpixels.f90

@@ -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
 

Modules/spitpgm.f90

@@ -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

Modules/trials.f90

@@ -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