1 -- Glasow Haskell 0.403 : FINITE ELEMENT PROGRAM V2
    2 -- **********************************************************************
    3 -- *                                                                    *
    4 -- * FILE NAME : assemble_stiffness.hs        DATE : 13-3-1991          *
    5 -- *                                                                    *
    6 -- * CONTENTS : Assemble the global stiffness matrix, stored in         *
    7 -- *            variable bandwidth matrix .                             *
    8 -- *                                                                    *
    9 -- **********************************************************************
   10 
   11 module Assemble_stiffness( kdd ) where
   12 
   13 import Basics
   14 import Vector
   15 import Matrix
   16 import VBmatrix
   17 import DB_interface
   18 import Degrees
   19 import Pre_assemble
   20 import Elemstif
   21 
   22 kdd :: (Array Int Int, Array Int Float) -> Vbm Float
   23 
   24 kdd s = 
   25         incrvbmat initial_value index_value_assoc_s
   26         where
   27         initial_value = makevbmat (ndgrs s) (diagadr s) (\ i -> 0.0)
   28         index_value_assoc_s = index_value_assoc s
   29 
   30 index_value_assoc s =
   31         foldl assemble_s [] [ 1 .. (nelem s)]
   32         where
   33         assemble_s = assemble s
   34 
   35 assemble s till_now_dd element =
   36         (till_now_dd++dd_this')
   37         where
   38         dd_this' = [ (         (f i, f j) ,  x i j) 
   39                      | i <- [0..n-1], j <- [0..i], f i > 0 , f j > 0 ]
   40         dgrs_list = (dgrs_list_node nodel) ++ (dgrs_list_node noder)
   41         (nodel,noder) = getenlr s element
   42         dgrs_list_node node = getndgr s node
   43         eindex_dgrs_list = zip [1..6] dgrs_list
   44         aindex_dgrs_list = filter valid_index eindex_dgrs_list
   45         valid_index (i,dgr) = (dgr /= 0)
   46         n = length aindex_dgrs_list
   47         x i j = matsub (beam2d s element)
   48                 (fst (aindex_dgrs_list !! i), fst (aindex_dgrs_list !! j))
   49         f i   = (snd (aindex_dgrs_list !!  i))
   50