diff --git a/Modules/Makefile b/Modules/Makefile index 6c89703..77ccaa2 100644 --- a/Modules/Makefile +++ b/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. diff --git a/Modules/README.md b/Modules/README.md index 5d37577..715e45e 100644 --- a/Modules/README.md +++ b/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 -compiler, or have a sane place to put a breakpoint with gdb +A "do nothing" useless module. +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 diff --git a/Modules/chkpixels.f90 b/Modules/chkpixels.f90 index 4022fca..1541fb9 100644 --- a/Modules/chkpixels.f90 +++ b/Modules/chkpixels.f90 @@ -11,8 +11,8 @@ program chkpixels implicit none write(0, *) "------ CHKPIXELS ------" - call test_spit_as(3) - call test_spit_rgb(128, 222) + ! call test_spit_gray(3) + 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)%g = mod(ix*iy, kg) - pixrgb(ix, iy)%b = iy + pixrgb(ix, iy)%r = mod(ix * iy, 65000) + if (ix.EQ.iy) pixrgb(ix, iy)%g = 65000 + 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, "rgb16.pnm") + call rgbpix_spit_as_pnm_16 (pixrgb, "current-rgb16.pnm") + call new_spit_rgb16 (pixrgb, "experiment-rgb16.pnm") + deallocate(pixrgb) end subroutine diff --git a/Modules/pixrgb.f90 b/Modules/pixrgb.f90 index b74222c..e7f82e8 100644 --- a/Modules/pixrgb.f90 +++ b/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 !------------------------------------------------------------------- -end module \ No newline at end of file +!- +! 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 + + diff --git a/Modules/trials.f90 b/Modules/trials.f90 index 0a455db..9f176e7 100644 --- a/Modules/trials.f90 +++ b/Modules/trials.f90 @@ -94,3 +94,4 @@ end subroutine !------------------------------------------------------------------- end module +