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

release of voxel-2

Browse Source
This commit is contained in:
tth
2022-04-10 01:41:42 +02:00
parent 85d6b57eee
commit 694066169c
4 changed files with 35 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
Fraktalism/voxelize.f90
View File

@@ -7,23 +7,25 @@
program voxelize
use fraktals
implicit none
integer, parameter :: DIM = 100
integer, dimension(:,:,:), allocatable :: cube
type(t_point3d), dimension(:), allocatable :: points
integer :: errcode, foo
integer :: ix, iy, iz
double precision, dimension(4) :: coefs
integer :: nbr_points
double precision, dimension(4) :: coefs, KB
double precision :: dval
! XXX foo = (DIM*DIM*DIM) / (1024)
! XXX PRINT *, "memory request for cube (in Kwords) ", foo
write(0, *) "--- start of voxelize"
allocate (cube(DIM,DIM,DIM), stat=errcode)
if (0 .NE. errcode) then
STOP " : NO ENOUGH MEMORY FOR CUBE"
endif
nbr_points = 3100000
nbr_points = 2800000
allocate(points(nbr_points), stat=errcode)
if (0 .NE. errcode) then
STOP " : NO ENOUGH MEMORY FOR POINTS"
@@ -31,7 +33,10 @@ program voxelize
coefs(1) = 2.23 ; coefs(2) = 0.42
coefs(3) = -0.64 ; coefs(4) = -2.42
call compute_pickover(points, coefs)
KB(1) = 1.51 ; KB(2) = -1.89
KB(3) = 1.69 ; KB(4) = 0.79
call compute_pickover(points, KB)
call clear_cube(cube)
@@ -46,7 +51,7 @@ program voxelize
enddo
dval = DBLE(MAXVAL(cube))
write(0, *) "--- cube maximum = ", dval
write(0, *) "--- maximum of the cube= ", dval
do foo=1, nbr_points
call fcoor2icoor(points(foo)%x, ix)
@@ -57,6 +62,9 @@ program voxelize
DBLE(cube(ix,iy,iz)) / dval
enddo
dval = DBLE(MAXVAL(cube))
write(0, *) "--- end of voxelize"
!-----------------------------------------------------
contains
!-----------------------------------------------------
@@ -76,7 +84,7 @@ subroutine fcoor2icoor(in, out)
if (outvalue .GE. DIM) out = DIM-1
end subroutine
!-----------------------------------------------------
!------------------------------------------------------------
subroutine clear_cube(cube)
type(integer), dimension(:,:,:), intent(out) :: cube
@@ -91,7 +99,7 @@ subroutine clear_cube(cube)
enddo
end subroutine
!-----------------------------------------------------
!------------------------------------------------------------
subroutine spit_cube_as_union(fname, datas, notused)
character(*) :: fname
type(integer), dimension(:,:,:), intent(in) :: datas
@@ -106,6 +114,7 @@ subroutine spit_cube_as_union(fname, datas, notused)
STOP ' : SPITUNION : FAIL OPEN OUTPUT FILE'
endif
close(fd)
end subroutine