1 {- 2 Some subroutines 3 4 XZ, 24/10/91 5 -} 6 7 {- 8 Modified to employ S_array. 9 10 XZ, 7/2/92 11 -} 12 13 module Asb_routs 14 ( get_asb_table, get_val, list_inner_prod, list_match_prod, add_mat, add_u, mult ) 15 where 16 17 import Defs 18 import S_Array -- not needed w/ proper module handling 19 import Norm -- ditto 20 import Ix--1.3 21 22 ----------------------------------------------------------- 23 -- Generating a lookup table for assembling a system -- 24 -- matrix using a corresponging steering vector. -- 25 -- The result is an array of tuple list. -- 26 -- The ith entry of the array contains all elements -- 27 -- which have node i on their edges. -- 28 -- The 1st item of the tuples is the element identity -- 29 -- and the 2nd is the node local number. -- 30 -- Called at the data setup stage. -- 31 ----------------------------------------------------------- 32 33 get_asb_table :: Int -> Int -> Int -> (My_Array Int [Int]) -> 34 (My_Array Int [(Int,Int)]) 35 36 get_asb_table total e_total nodel steer = 37 s_accumArray (++) [] (1,total) 38 ( 39 concat 40 [ zipWith f1 (steer!^e) (map (\z->[(e,z)]) range_nodel) 41 | e <- range (1,e_total) 42 ] 43 ) 44 where 45 range_nodel = range (1,nodel) 46 f1 = \x y->(x,y) 47 48 ----------------------------------------------------------- 49 -- syntaxes for generating velocity and pressure -- 50 -- assembling table: -- 51 -- v_asb_table = -- 52 -- get_asb_table n_total e_total v_nodel v_steer -- 53 -- p_asb_table = -- 54 -- get_asb_table p_total e_total p_nodel p_steer -- 55 -- Selecting some values from an array and putting them -- 56 -- into a list. Used mainly for assembling RHS and -- 57 -- Jacobi iteration. -- 58 ----------------------------------------------------------- 59 60 get_val :: (My_Array Int Frac_type) -> [Int] -> [Frac_type] 61 get_val arr steer = [arr!^n|n<-steer] 62 63 ----------------------------------------------------------- 64 -- Inner-production of 2 list vectors. Used mainly for -- 65 -- assembling RHS, Choleski decomposition and Jacobi -- 66 -- iteration. -- 67 -- Two versions: 1: lazy; -- 68 -- 2: 2nd arg forced, possibly save -- 69 -- some calculation. -- 70 ----------------------------------------------------------- 71 72 list_inner_prod :: [Frac_type] -> [Frac_type] -> Frac_type 73 list_inner_prod = \x y -> sum (zipWith (*) x y) 74 75 list_match_prod :: [Frac_type] -> [Frac_type] -> Frac_type 76 list_match_prod = 77 \x y -> sum (zipWith mult x y) 78 79 ----------------------------------------------------------- 80 -- modified (*): check first if the 2nd arg is 0 -- 81 ----------------------------------------------------------- 82 83 mult _ 0 = 0 84 mult x y = x * y 85 86 ----------------------------------------------------------- 87 -- adding 2 vectors. Used mainly in the TG iteration. -- 88 ----------------------------------------------------------- 89 90 add_mat 91 :: (My_Array Int Frac_type) -> (My_Array Int Frac_type) 92 -> (My_Array Int Frac_type) 93 add_mat a b = 94 s_listArray (s_bounds a) (zipWith (+) (s_elems a) (s_elems b)) 95 96 ----------------------------------------------------------- 97 -- Adding 2 vector pairs. Used in TG iteration and -- 98 -- Jacobi iteration. -- 99 ----------------------------------------------------------- 100 101 add_u 102 :: (My_Array Int Frac_type,My_Array Int Frac_type) 103 -> (My_Array Int Frac_type,My_Array Int Frac_type) 104 -> (My_Array Int Frac_type,My_Array Int Frac_type) 105 add_u = \ a b -> 106 ( 107 add_mat (fst a) (fst b), 108 add_mat (snd a) (snd b) 109 )