fraktalist: refactoring in progress

Fraktalism/fraktals.f90

@@ -1,5 +1,11 @@
 module fraktals
+
+  use points3d
+
   implicit none
+!-----------------------------------------------------
+
+!-----------------------------------------------------
   contains
 
 !-----------------------------------------------------
@@ -51,6 +57,42 @@ subroutine simple_julia(pic, cx, cy, maxiter)
     enddo 
 
 end subroutine simple_julia
+!-----------------------------------------------------
+! 
+!  d'après les pages 91/92 du livre de Roger T Stevens
+!       "Fractal programming in C"
+! 
+subroutine compute_pickover(array, coefs)
+    type(t_point3d), dimension(:)    :: array
+    double precision, dimension(4)   :: coefs
+
+    double precision      :: xa, ya, za, xb, yb, zb
+    integer               :: i
+    ! print *, "coefs ", coefs
+
+    write(0, '(1X, A18, I9)') "compute pickover ", ubound(array, 1)
+
+    xa = 0.00 ; ya = 0.00 ; za = 0.0
+
+    do i=1, ubound(array, 1)
+
+      xb = sin(coefs(1)*ya) - za*cos(coefs(2)*xa)
+      yb = za*sin(coefs(3)*xa) - cos(coefs(4)*ya)
+      zb = sin(xa)
+
+      array(i)%x   = xb
+      array(i)%y   = yb
+      array(i)%z   = zb
+      array(i)%seq = i
+
+      xa = xb ; ya = yb ; za = zb 
+
+      ! print *, xb, yb, zb
+
+    enddo
+
+end subroutine
+
 !-----------------------------------------------------
 ! 
 !  d'après les pages 91/92 du livre de Roger T Stevens
@@ -61,37 +103,60 @@ subroutine pickover_0(pic, count)
     integer, intent(inout), dimension (:,:)  ::  pic
     integer, intent(in)                      ::  count
 
-    double precision      :: xa, ya, za, xb, yb, zb
-    double precision      :: ka, kb, kc, kd
-    integer               :: i, w, h, px, py
+    type(t_point3d), dimension(:), allocatable ::   points
+    double precision, dimension(4)             ::   coefs
+    integer               :: i, w, h, px, py, errcode
 
-    ka = 2.24 ; kb = 0.43 ; kc = -0.65 ; kd = -2.43
-    xa = 0.00 ; ya = 0.00 ; za = 0.0
+    write(0, '(1X, A18 , I9)') "pickover_0 ", count
 
+    allocate(points(count), stat=errcode)
+    if (0 .NE. errcode) then
+      STOP " : NO ENOUGH MEMORY"
+    endif
+
+    coefs(1) = 2.24     ;     coefs(2) = 0.43
+    coefs(3) = -0.65    ;     coefs(4) = -2.43
+    call compute_pickover(points, coefs)
+ 
     w  = ubound(pic, 1)
-    h = ubound(pic, 2)
+    h  = ubound(pic, 2)
 
-    do i=1, count
+    do i=1, ubound(points, 1)
 
-      xb = sin(ka*ya) - za*cos(kb*xa)
-      yb = za*sin(kc*xa) - cos(kd*ya)
-      zb = sin(xa)
-
-      px = (xb * (w/4.05)) + (w / 2)
-      py = (yb * (h/4.05)) + (h / 2)
-
-      pic(px, py) = 200              ! WARNING COREDUMP
-
-      print *, xb, yb, zb
-      
-      xa = xb ; ya = yb ; za = zb 
+      px = (points(i)%x * (w/4.09)) + (w / 2)
+      py = (points(i)%y * (h/4.09)) + (h / 2)
+      pic(px, py) = 255               ! WARNING COREDUMP
 
     enddo
 
+    deallocate(points)
+
 end subroutine pickover_0
+
 !-----------------------------------------------------
+! 
+!  d'après les pages NN/NN du livre de Roger T Stevens
+!       "Fractal programming in C"
+! 
+subroutine lorentz_0(pic, count)
+    implicit none
+    integer, intent(inout), dimension (:,:)  ::  pic
+    integer, intent(in)                      ::  count
+
+! XXX    double precision      :: xa, ya, za, xb, yb, zb
+! XXX    double precision      :: ka, kb, kc, kd
+! XXX    integer               :: i, w, h, px, py
+
+
+
+end subroutine lorentz_0
+
+!-----------------------------------------------------------
 !           -- some support functions --
-!-----------------------------------------------------
+!-----------------------------------------------------------
+
+
+!-----------------------------------------------------------
 
 function dist0 (x, y)
   implicit none
@@ -100,7 +165,7 @@ function dist0 (x, y)
   dist0 = ( x*x + y*y )
 end function
 
-!-----------------------------------------------------
+!-----------------------------------------------------------
 function modulus2(pt)
   implicit none
   complex, intent(in)    ::   pt