Fortraneries/Fraktalism/voxelize.f90

204 lines
6.3 KiB
Fortran
Raw Normal View History

2022-03-31 22:14:11 +02:00
!-----------------------------------------------------
! VOXELIZE
! ========
2022-04-03 06:44:24 +02:00
! this is the main program, see also mkvoxvidz.sh
! showvoxels.pov and vox2inc.awk
2022-03-31 22:14:11 +02:00
!-----------------------------------------------------
program voxelize
use fraktals
2022-04-10 01:41:42 +02:00
implicit none
2022-10-28 21:53:57 +02:00
integer, parameter :: DIMC = 320
2022-03-31 22:14:11 +02:00
integer, dimension(:,:,:), allocatable :: cube
type(t_point3d), dimension(:), allocatable :: points
2022-04-15 17:13:07 +02:00
integer :: errcode, foo, argc
2022-03-31 22:14:11 +02:00
integer :: ix, iy, iz
2022-04-15 17:13:07 +02:00
integer :: nbr_points, maxcube
double precision, dimension(4) :: KA, KB, KM
double precision :: dmaxcube, delta
character(200) :: filename, string
2022-03-31 22:14:11 +02:00
2022-04-10 01:41:42 +02:00
write(0, *) "--- start of voxelize"
2022-03-31 22:14:11 +02:00
2022-04-15 17:13:07 +02:00
argc = IARGC()
if (2 .NE. argc) then
STOP ": VOXELIZE NEED PARAMETERS !"
endif
call getarg(1, filename)
call getarg(2, string) ; read (string, *) delta
write(0, "( ' --- delta = ', F11.6)") delta
allocate (cube(DIMC,DIMC,DIMC), stat=errcode)
2022-03-31 22:14:11 +02:00
if (0 .NE. errcode) then
STOP " : NO ENOUGH MEMORY FOR CUBE"
endif
2022-10-28 21:53:57 +02:00
nbr_points = 9000000
2022-03-31 22:14:11 +02:00
allocate(points(nbr_points), stat=errcode)
if (0 .NE. errcode) then
STOP " : NO ENOUGH MEMORY FOR POINTS"
endif
2022-04-15 17:13:07 +02:00
KA(1) = -1.3402 ; KA(2) = 1.5245
KA(3) = 1.0966 ; KA(4) = -2.3423
KB(1) = -1.2100 ; KB(2) = 1.3685
2022-04-17 12:44:43 +02:00
KB(3) = 1.3237 ; KB(4) = -2.3992
2022-04-15 17:13:07 +02:00
call interp4dp(KA, KB, KM, delta)
write(0, "(' --- coefs = ', 4F11.6)") KM
call compute_pickover(points, KM)
2022-03-31 22:14:11 +02:00
call clear_cube(cube)
2022-04-15 17:13:07 +02:00
!
2022-04-03 06:44:24 +02:00
! and now, we loop over all the pre-computed
! points of the attractor
!
2022-03-31 22:14:11 +02:00
do foo=1, nbr_points
2022-04-03 06:44:24 +02:00
call fcoor2icoor(points(foo)%x, ix)
call fcoor2icoor(points(foo)%y, iy)
call fcoor2icoor(points(foo)%z, iz)
cube(ix,iy,iz) = cube(ix,iy,iz) + 1
2022-03-31 22:14:11 +02:00
enddo
2022-04-03 06:44:24 +02:00
2022-04-15 17:13:07 +02:00
maxcube = MAXVAL(cube)
dmaxcube = DBLE(maxcube)
write(0, *) "--- maxval(cube) = ", maxcube
2022-04-03 06:44:24 +02:00
2022-04-15 17:13:07 +02:00
call spit_cube_as_union(filename, cube, &
2022-04-17 12:44:43 +02:00
maxcube/2000, dble(9000.00))
2022-04-03 06:44:24 +02:00
2022-04-10 01:41:42 +02:00
write(0, *) "--- end of voxelize"
2022-03-31 22:14:11 +02:00
!-----------------------------------------------------
contains
!-----------------------------------------------------
2022-04-03 06:44:24 +02:00
! or maybe, we can write a function ?
subroutine fcoor2icoor(in, out)
double precision, intent(in) :: in
integer, intent(out) :: out
double precision :: invalue
integer :: outvalue
invalue = (in + 2.0) / 2.0
2022-04-15 17:13:07 +02:00
outvalue = int(invalue * real(DIMC/2))
2022-04-03 06:44:24 +02:00
! add molly-guard here
out = outvalue
if (outvalue .LT. 1) out = 1
2022-04-15 17:13:07 +02:00
if (outvalue .GE. DIMC) out = DIMC-1
2022-04-03 06:44:24 +02:00
end subroutine
2022-04-10 01:41:42 +02:00
!------------------------------------------------------------
2022-04-15 17:13:07 +02:00
! USELESS USE OF LOOPS !
2022-04-03 06:44:24 +02:00
subroutine clear_cube(cube)
type(integer), dimension(:,:,:), intent(out) :: cube
integer :: i, j, k
do i=lbound(cube, 1), ubound(cube, 1)
do j=lbound(cube, 2), ubound(cube, 2)
do k=lbound(cube, 3), ubound(cube, 3)
cube(i, j, k) = 0
enddo
enddo
enddo
2022-04-05 05:46:51 +02:00
end subroutine
2022-04-10 01:41:42 +02:00
!------------------------------------------------------------
2022-04-15 17:13:07 +02:00
subroutine print_cube(cube, points, scaling)
type(integer), dimension(:,:,:), intent(in) :: cube
type(t_point3d), dimension(:), intent(in) :: points
double precision, intent(in) :: scaling
2022-04-05 05:46:51 +02:00
2022-04-15 17:13:07 +02:00
integer :: foo
2022-04-05 05:46:51 +02:00
2022-04-15 17:13:07 +02:00
do foo=1, nbr_points
call fcoor2icoor(points(foo)%x, ix)
call fcoor2icoor(points(foo)%y, iy)
call fcoor2icoor(points(foo)%z, iz)
print *, ix, iy, iz, &
cube(ix,iy,iz), &
DBLE(cube(ix,iy,iz)) / scaling
enddo
end subroutine
!------------------------------------------------------------
! generation Povray STL source file !
subroutine spit_cube_as_union(fname, voxels, limit, scaling)
character(*), intent(in) :: fname
type(integer), dimension(:,:,:), intent(in) :: voxels
integer, intent(in) :: limit
double precision, intent(in) :: scaling
integer :: fd, errcode
integer :: ix, iy, iz, maxv
integer :: nbrvox = 0
double precision :: bx, by, bz, valeur
character(200) :: chaine
! molly-guard
maxv = limit
if (maxv .LT. 2) maxv = 2
open (newunit=fd, file=trim(fname), &
status='replace', &
2022-04-05 05:46:51 +02:00
action='write', iostat=errcode)
if (0 .NE. errcode) then
2022-04-15 17:13:07 +02:00
STOP ' : SPIT UNION, FAIL OPEN OUTPUT FILE'
2022-04-05 05:46:51 +02:00
endif
2022-04-15 17:13:07 +02:00
write(fd, *) "// generated file, don't touch it bastard !"
write(fd, *) "// version 2.09"
write(fd, *) "#declare DIMC = ", DIMC, ";"
write(fd, *) "#declare Voxels = object {"
write(fd, *) "union {"
bx = 0.0 ; by = 0.0 ; bz = 0.0
do ix=lbound(voxels,1), ubound(voxels,1)
do iy=lbound(voxels,2), ubound(voxels,2)
do iz=lbound(voxels,3), ubound(voxels,3)
if (cube(ix,iy,iz) .LT. maxv) then
! print *, "foo = ", foo, cube(ix,iy,iz)
cycle ! REDO FROM START
endif
nbrvox = nbrvox + 1
bx = bx + dble(ix)
by = by + dble(iy)
bz = bz + dble(iz)
valeur = DBLE(cube(ix,iy,iz)) / scaling
! XXX
2022-04-17 12:44:43 +02:00
if (valeur .GT. 1.5) then
valeur = 1.5
2022-04-15 17:13:07 +02:00
endif
write(chaine, "( 'translate <', I4, ',', I4, ',', I4, '> ' )") &
ix, iy, iz
write(unit=fd, &
fmt="( 'object { VOXEL scale ', F11.6, 1X, A, ' }' )", &
iostat=errcode) &
valeur, trim(chaine)
enddo
enddo
enddo
write(fd, *) "} }"
write(fd, *) "// limit = ", limit
write(fd, "( '#declare NbrVox = ', I9, ';' )") nbrvox
write(fd, "( '#declare Bary_X = ', F11.6, ';' )") bx / dble(nbrvox)
write(fd, "( '#declare Bary_Y = ', F11.6, ';' )") by / dble(nbrvox)
write(fd, "( '#declare Bary_Z = ', F11.6, ';' )") bz / dble(nbrvox)
2022-04-10 01:41:42 +02:00
2022-04-05 05:46:51 +02:00
close(fd)
2022-04-03 06:44:24 +02:00
end subroutine
2022-03-31 22:14:11 +02:00
!-----------------------------------------------------
end program voxelize
!-----------------------------------------------------