diff --git a/Modules/Makefile b/Modules/Makefile new file mode 100644 index 0000000..af1edae --- /dev/null +++ b/Modules/Makefile @@ -0,0 +1,10 @@ +# +# * Fortraneries * +# +# Makefile for the general purpose moduls +# + +GFOPT = -Wall -Wextra -time -g -O + +spitpgm.o: spitpgm.f90 Makefile + gfortran $(GFOPT) -c $< -o $@ diff --git a/Modules/README.md b/Modules/README.md index cfd6897..0833a74 100644 --- a/Modules/README.md +++ b/Modules/README.md @@ -1,3 +1,4 @@ -# General pupose modules +# General purpose modules +* spitpgm diff --git a/Modules/spitpgm.f90 b/Modules/spitpgm.f90 new file mode 100644 index 0000000..b838221 --- /dev/null +++ b/Modules/spitpgm.f90 @@ -0,0 +1,98 @@ +!- +! This module try to write PNM complient files - ymmv +! +module spitpgm + + implicit none + contains + +!------------------------------------------------------------------- +!- +! This subroutine try to scale the values to fit the 16 bit range +! +subroutine spit_as_pgm_eq(pic, fname) + + integer, intent(in), dimension (:,:) :: pic + character (len=*), intent(in) :: fname + + integer :: io, foo + integer :: ix, iy + real :: fk, fpix + + write(0, '(1X, A)') "> spit_as_pgm to " // trim(fname) + + open(newunit=io, file=fname) + write (io, '(a2)') "P2" + write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2) + write (io, '(i0)') 65535 + + foo = MAXVAL(pic) + if (foo .EQ. 0) then + print *, " IS SOMETHING WRONG GOING TO HAPPEN ?" + do ix = 1, size(pic) + write (io, "(i0)") 0 + enddo + else + fk = float(foo) / 65535.0 + print *, " max pix value", foo, " fk = ", fk + do iy = 1, ubound(pic, 2) + do ix = 1, ubound(pic, 1) + fpix = float(pic(ix, iy)) / fk + write (io, "(i0)") int(fpix) + end do + end do + endif + close(io) + +end subroutine +!------------------------------------------------------------------- +subroutine spit_as_pgm_16(pic, fname) + integer, intent(in), dimension (:,:) :: pic + character (len=*), intent(in) :: fname + + integer :: io, foo + integer :: ix, iy + + open(newunit=io, file=fname) + write (io, '(a2)') "P2" + write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2) + write (io, '(i0)') 255 + do iy=1,ubound(pic, 2) + do ix=1, ubound(pic, 1) + foo = pic(ix, iy) + if (foo .GT. 65535) foo = 65530 + write(io, "(i3)") foo + enddo + enddo + close(io) + +end subroutine +!------------------------------------------------------------------- +subroutine spit_as_pgm_8(pic, fname) + integer, intent(in), dimension (:,:) :: pic + character (len=*), intent(in) :: fname + + integer :: io, foo + integer :: ix, iy + + ! XXX print *, "> spit_as_pgm_8 to ", fname + foo = MAXVAL(pic) + ! XXX print *, " max = ", foo + open(newunit=io, file=fname) + write (io, '(a2)') "P2" + write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2) + write (io, '(i0)') 255 + + do iy=1,ubound(pic, 2) + do ix=1, ubound(pic, 1) + foo = pic(ix, iy) + if (foo .GT. 255) foo = 255 + write(io, "(i3)") foo + enddo + enddo + close(io) + +end subroutine +!------------------------------------------------------------------- + +end module spitpgm