tTh/Fortraneries
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

moving a file

Browse Source
This commit is contained in:
tth 2022-03-21 18:28:42 +01:00
parent ac284a5764
commit e4afd2777d
2 changed files with 81 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
Fraktalism/Makefile
View File

@ -3,23 +3,26 @@ GFOPT = -Wall -Wextra -time -g -Imods/
# --------------------------------------------- # ---------------------------------------------
spitpgm.o: spitpgm.f90 Makefile mods/spitpgm.o: mods/spitpgm.f90 Makefile
gfortran $(GFOPT) -c $< gfortran $(GFOPT) -c $< -o $@
fraktals.o: fraktals.f90 Makefile fraktals.o: fraktals.f90 Makefile
gfortran $(GFOPT) -c $< gfortran $(GFOPT) -c $<
OBJS = spitpgm.o fraktals.o OBJS = mods/spitpgm.o fraktals.o
DOT_O = mods/points3d.o DOT_O = mods/points3d.o
# --------------------------------------------- # ---------------------------------------------
julia: julia.f90 Makefile $(OBJS) julia: julia.f90 Makefile $(OBJS)
gfortran $(GFOPT) $< $(OBJS) -o $@ gfortran $(GFOPT) $< $(OBJS) -o $@
pickover: pickover.f90 Makefile $(OBJS) pickover: pickover.f90 Makefile $(OBJS) $(DOT_O)
gfortran $(GFOPT) $< $(OBJS) $(DOT_O) -o $@ gfortran $(GFOPT) $< $(OBJS) $(DOT_O) -o $@
voxelize: voxelize.f90 Makefile $(OBJS)
gfortran $(GFOPT) $< $(OBJS) -o $@
lorentz: lorentz.f90 Makefile $(OBJS) lorentz: lorentz.f90 Makefile $(OBJS)
gfortran $(GFOPT) $< $(OBJS) -o $@ gfortran $(GFOPT) $< $(OBJS) -o $@

73
Fraktalism/mods/spitpgm.f90 Normal file
View File

@ -0,0 +1,73 @@
module spitpgm
implicit none
contains
!-----------------------------------------------------
subroutine spit_as_pgm(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_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