rgbpix: buffered write un production

Modules/Makefile

@@ -1,7 +1,7 @@
 #
 #		* Fortraneries from tTh *
 #
-#	Makefile for the general purpose moduls
+#	Makefile for the general purpose modules
 #
 
 GFOPT  =  -Wall -Wextra -g -I.

Modules/README.md

@@ -1,8 +1,5 @@
 # General purpose modules
 
-## Compiler un module
-
-Mmmmm...
 
 ## Modules disponibles
 
@@ -13,7 +10,9 @@ Write gray level 2d buffer (aka picture) to disk in the NetPNM format.
 
 ### pixrgb
 
-Write 8 bits RGB pictures to PNM format.
+Write 8 bits or 16 bits RGB pictures to PNM format.
+
+**Warning!** The width of the picture MUST be a multiple of 4 !
 
 ### trials
 
@@ -21,8 +20,16 @@ Experimental WIPs from hell.
 
 ### dummy
 
-A "do nothing" useless module. But you cas use it to fool an optimizing
+A "do nothing" useless module.
-compiler, or have a sane place to put a breakpoint with gdb
+But you cas use it to fool an optimizing compiler,
+or have a sane place to put a breakpoint with gdb
+
+## Compiler un module
+
+You can use the same options as for a main program.
+And when you use the module, you have to specify the paths
+for the .mod and the .o to the linker.
+See [Makefile](./Makefile) for an example.
 
 ## TODO
 

Modules/chkpixels.f90

@@ -11,8 +11,8 @@ program chkpixels
   implicit none
 
   write(0, *)  "------ CHKPIXELS ------"
-  call test_spit_as(3)
+  ! call test_spit_gray(3)
-  call test_spit_rgb(128, 222)
+  call test_spit_rgb16(1100, 512)
 
   STOP 'BECAUSE NO CPU AVAILABLE'
 
@@ -21,7 +21,7 @@ contains
 !-
 !     exerciser for the 'pixrgb' module
 !-
-  subroutine test_spit_rgb(sz, kg)
+  subroutine test_spit_rgb16(sz, kg)
     integer, intent(in)    :: sz, kg
 
     type(t_pixrgb), allocatable  :: pixrgb(:,:)
@@ -30,15 +30,17 @@ contains
     print *, "test spit rgb", sz
     allocate(pixrgb(sz, sz))
     call rgbpix_set_to_zero(pixrgb)
+
     do ix=1, sz
       do iy=1, sz
-        pixrgb(ix, iy)%r = ix
+        pixrgb(ix, iy)%r = mod(ix * iy, 65000)
-        pixrgb(ix, iy)%g = mod(ix*iy, kg)
+        if (ix.EQ.iy) pixrgb(ix, iy)%g = 65000
-        pixrgb(ix, iy)%b = iy
+        pixrgb(ix, iy)%b = mod ((ix*iy) * 13, 65000)
       end do
     end do
-    call rgbpix_spit_as_pnm_8(pixrgb,  "rgb8.pnm")
+    call rgbpix_spit_as_pnm_16  (pixrgb, "current-rgb16.pnm")
-    call rgbpix_spit_as_pnm_16(pixrgb, "rgb16.pnm")
+    call new_spit_rgb16         (pixrgb, "experiment-rgb16.pnm")
+
     deallocate(pixrgb)
 
   end subroutine

Modules/pixrgb.f90

@@ -16,6 +16,8 @@ end type
 contains
 !-------------------------------------------------------------------
 !-
+!	try FORALL here
+!-
 subroutine rgbpix_set_to_zero(pic)
   type(t_pixrgb), intent(out)       ::  pic(:,:)
   integer                           ::  ix, iy
@@ -88,7 +90,7 @@ end subroutine
 !-
 !          CAUTION: there was NO out-of-bounds check !
 !-
-subroutine rgbpix_spit_as_pnm_16(pic, fname)
+subroutine rgbpix_spit_as_pnm_16_old(pic, fname)
 
   type(t_pixrgb), intent(in)       ::  pic(:,:)
   character (len=*), intent(in)    ::  fname
@@ -111,4 +113,51 @@ subroutine rgbpix_spit_as_pnm_16(pic, fname)
 
 end subroutine
 !-------------------------------------------------------------------
+!-
+!          CAUTION: there was NO out-of-bounds check !
+!-
+subroutine rgbpix_spit_as_pnm_16(pic, fname)
+
+  type(t_pixrgb), intent(in)       ::  pic(:,:)
+  character (len=*), intent(in)    ::  fname
+
+  integer                          ::  io, ix, iy, ik
+  integer                          ::  buffer(3*4), ptr
+
+  ! write(0, *) ">>> subroutine rgbpix_spit_as_pnm_16"
+
+  open(newunit=io, file=fname)
+  write (io, '(a2)') "P3"
+  write (io, '("# rgbpix_spit_as_pnm_16")')
+  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)
+
+      buffer(ptr)   = pic(ix, iy)%r
+      buffer(ptr+1) = pic(ix, iy)%g
+      buffer(ptr+2) = pic(ix, iy)%b
+      ptr = ptr + 3
+
+      if (ptr .EQ. 13) then
+        write(io, "(i0, 11(' ', i0))") buffer
+        ptr = 1
+      endif
+    enddo    ! write(io, *) " fin iy=", iy
+  enddo
+
+!   may be we have to flush the buffer ?
+
+  close(unit=io)
+
+end subroutine
+
+!-------------------------------------------------------------------
+
 end module
+
+

Modules/trials.f90

@@ -94,3 +94,4 @@ end subroutine
 !-------------------------------------------------------------------
 
 end module
+