Compare commits

...

3 Commits

Author SHA1 Message Date
tTh 4c13892c9d need more tests 2024-01-14 09:42:09 +01:00
tTh 3b4726fb2a modules: rename a function 2024-01-10 11:11:34 +01:00
tTh d040b305f8 using my module collection 2024-01-07 05:58:05 +01:00
3 changed files with 54 additions and 12 deletions

View File

@ -6,8 +6,9 @@ all: genbloubs movebloubs exportbloubs mergebloubs \
# ------------------------------------------------------------
GFOPT = -Wall -Wextra -g -time
GFOPT = -Wall -Wextra -g -time -I../Modules
OBJS = bloubspace.o povstuff.o mathstuff.o
MYLIB = '../Modules/libtth90modules.a'
# ------------------------------------------------------------
@ -42,7 +43,7 @@ mathstuff.o: mathstuff.f90 Makefile
# ------------------------------------------------------------
genbloubs: genbloubs.f90 Makefile $(OBJS)
gfortran $(GFOPT) $< $(OBJS) -o $@
gfortran $(GFOPT) $< $(OBJS) $(MYLIB) -o $@
movebloubs: movebloubs.f90 Makefile $(OBJS)
gfortran $(GFOPT) $< $(OBJS) -o $@

View File

@ -1,7 +1,7 @@
program genbloubs
use bloubspace
use mathstuff
use mathstuff2
integer :: nbbloubs
integer :: i

View File

@ -3,17 +3,15 @@
!-
module trials
use pixrgb
implicit none
!-----------------------------------------------------------------------
!-------------------------------------------------------------------
contains
!-----------------------------------------------------------------------
!-
!-------------------------------------------------------------------
subroutine new_spit_a(pic, fname)
! please write the same thing for RGB 16bits pictures !
subroutine new_spit_gray(pic, fname)
integer, intent(in), dimension (:,:) :: pic
character (len=*), intent(in) :: fname
@ -27,7 +25,7 @@ subroutine new_spit_a(pic, fname)
open(newunit=io, file=fname)
write (io, '(a2)') "P2"
write (io, '("# new_spit_a")')
write (io, '("# new_spit_gray")')
write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2)
write (io, '(i0)') 65535
@ -51,5 +49,48 @@ subroutine new_spit_a(pic, fname)
end subroutine
!-------------------------------------------------------------------
!-
! CAUTION: there was NO out-of-bounds check !
!-
subroutine new_spit_rgb16(pic, fname)
end module
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, "(12(' ', 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