examples/between_languages/fortran_supercollider.scd

   1
   2
   3 // Fortran
   4 // http://en.wikibooks.org/wiki/Fortran/Fortran_examples
   5 /*
   6 function gauss_sparse(num_iter, tol, b, A, x, actual_iter)
   7
   8 !  This function solves a system of equations (Ax = b) by using the Gauss-Seidel Method
   9
  10    implicit none
  11
  12    real ::  gauss_sparse
  13
  14 !  Input: its value cannot be modified from within the function
  15    integer, intent(in) :: num_iter
  16    real, intent(in) :: tol
  17    real, intent(in), dimension(1:) :: b
  18    real, intent(in), dimension(1:,1:) :: A
  19
  20 !  Input/Output: its input value is used within the function, and can be modified
  21    real, intent(inout), dimension(1:) :: x
  22
  23 !  Output: its value is modified from within the function, only if the argument is required
  24    integer, optional, intent(out) :: actual_iter
  25
  26 !  Locals
  27    integer :: i, n, iter
  28    real :: tol_max, xk
  29
  30 !  Initialize values
  31    n = ubound(b, dim = 1)  ! Size of array, obtained using ubound intrinsic function
  32    tol_max = 2. * tol
  33    iter = 0
  34
  35 !  Compute solution until convergence
  36    convergence_loop: do while (tol_max >= tol .and. iter < num_iter); iter = iter + 1
  37
  38       tol_max = -1.  ! Reset the tolerance value
  39
  40 !     Compute solution for the k-th iteration
  41       iteration_loop: do i = 1, n
  42
  43 !        Compute the current x-value
  44          xk = (b(i) - dot_product(A(i,1:i-1),x(1:i-1)) - dot_product(A(i,i+1:n),x(i+1:n))) / A(i, i)
  45
  46 !        Compute the error of the solution
  47 !        dot_product(a,v)=a'b
  48          tol_max = max((abs(x(i) - xk)/(1. + abs(xk))) ** 2, abs(A(i, i) * (x(i) - xk)), tol_max)
  49          x(i) = xk
  50       end do iteration_loop
  51    end do convergence_loop
  52
  53    if (present(actual_iter)) actual_iter = iter
  54    gauss_sparse = tol_max
  55
  56 end function gauss_sparse
  57
  58
  59 */
  60
  61 (
  62 var dot_product = { |a, b| (a * b).sum };
  63 var gauss_sparse = { | num_iter, tol, b, a, x |
  64         var gauss_sparse;
  65         // Locals
  66         var i, n, iter;
  67         var tol_max, xk;
  68         // Initialize values
  69         tol_max = 2.0 * tol;
  70         iter = 0;
  71         // Compute solution until convergence
  72         while { (tol_max >= tol) and: (iter < num_iter) }
  73         {
  74                 iter = iter + 1;
  75
  76                 tol_max = -1.0;  // Reset the tolerance value
  77                 // Compute solution for the k-th iteration
  78                 i = 1;
  79                 n.do {
  80                         //        Compute the current x-value
  81                         xk = (b[i] - dot_product(a[i][i-1], x[i-1]) - dot_product(a[i][i+1], x[i+1])) / a[i][i];
  82                         //       Compute the error of the solution
  83                         //        dot_product(a,v)=a'b
  84                         tol_max = max((abs(x[i] - xk)/(1.0 + abs(xk))) ** 2, abs(a[i][i] * (x[i] - xk)), tol_max);
  85                         x[i] = xk;
  86                 }
  87
  88         };
  89         tol_max
  90 };
  91 gauss_sparse.(8, 2, [0, 1, 2, 3, 4], [[0, 1, 2], [1, 2, 3]], [0, 1, 2, 3, 4]);
  92 )
  93