1 {- 2 RHS assembling functions 3 4 XZ, 24/10/91 5 -} 6 7 {- 8 Modified to adopt S_array 9 10 XZ, 19/2/92 11 -} 12 13 {- 14 Modified 15 16 XZ, 25/2/92 17 -} 18 19 module Rhs_Asb_routs ( get_rh1, get_rh2, get_rh3 ) where 20 21 import Defs 22 import S_Array -- not needed w/ proper module handling 23 import Norm -- ditto 24 import S_matrix 25 import C_matrix 26 import L_matrix 27 import Asb_routs 28 import Ix--1.3 29 30 ----------------------------------------------------------- 31 -- Calculating the right-hand-side for step 1. -- 32 -- Called in TG iteration. -- 33 ----------------------------------------------------------- 34 35 get_rh1 36 :: (My_Array Int (Frac_type,((Frac_type,Frac_type,Frac_type), 37 (Frac_type,Frac_type,Frac_type)))) 38 -> (My_Array Int [(Int,Int)]) 39 -> (My_Array Int [Int]) 40 -> (My_Array Int [Int]) 41 -> ((My_Array Int Frac_type), 42 (My_Array Int Frac_type, My_Array Int Frac_type)) 43 -> (My_Array Int Frac_type, My_Array Int Frac_type) 44 45 get_rh1 el_det_fac asb_table v_steer p_steer (p,(u1,u2)) = 46 ( 47 s_listArray n_bnds (map (sum.(map fst)) pair_list), 48 s_listArray n_bnds (map (sum.(map snd)) pair_list) 49 ) 50 where 51 pair_list = 52 [ 53 [ 54 (el_det_fac!^e) `bindTo` ( \ el_d_f -> 55 (fst el_d_f) `bindTo` ( \ det -> 56 (snd el_d_f) `bindTo` ( \ fac -> 57 (l_mat!^id) `bindTo` ( \ l_m -> 58 ((s_mat!^id) fac) `bindTo` ( \ s_m -> 59 (get_val u1 (v_steer!^e),get_val u2 (v_steer!^e)) `bindTo` ( \ u -> 60 (get_val p (p_steer!^e)) `bindTo` ( \ p_val -> 61 ((c_mat!^id) fac u) `bindTo` ( \ c_m -> 62 ( 63 ((fst u) `bindTo` ( \ u_s -> 64 ( 65 (list_match_prod u_s s_m) / (-3.0) + 66 (list_match_prod u_s c_m) / (-1260.0) + 67 (list_match_prod p_val (l_m (fst fac))) / 3.0 68 ) * det )) 69 , 70 ((snd u) `bindTo` ( \ u_s -> 71 ( 72 (list_match_prod u_s s_m) / (-3.0) + 73 (list_match_prod u_s c_m) / (-1260.0) + 74 (list_match_prod p_val (l_m (snd fac))) / 3.0 75 ) * det )) 76 ) )))))))) 77 | (e,id)<-tab_elem 78 ] 79 | tab_elem <- s_elems asb_table 80 ] 81 n_bnds = s_bounds asb_table 82 bindTo x k = k x 83 84 ----------------------------------------------------------- 85 -- Calculating the right-hand-side for step 2. -- 86 -- Called in TG iteration. -- 87 ----------------------------------------------------------- 88 89 get_rh2 90 :: (My_Array Int (Frac_type,((Frac_type,Frac_type,Frac_type), 91 (Frac_type,Frac_type,Frac_type)))) 92 -> (My_Array Int [(Int,Int)]) 93 -> (My_Array Int [Int]) 94 -> [Int] 95 -> (My_Array Int Frac_type, My_Array Int Frac_type) 96 -> (My_Array Int Frac_type) 97 98 get_rh2 el_det_fac asb_table v_steer p_fixed (u1,u2) = 99 s_def_listArray p_bnds (0::Frac_type) 100 [ 101 if ( i `elem` p_fixed ) 102 -- for fixed entry 103 then 0 104 -- otherwise 105 else 106 ( 107 sum 108 [ 109 (v_steer!^e) `bindTo` (\ v_s -> 110 (el_det_fac!^e) `bindTo` ( \ el_d_f -> 111 (fst el_d_f) `bindTo` (\ det -> 112 (snd el_d_f) `bindTo` (\ fac -> 113 (l_mat'!^id) `bindTo` (\ l_m -> 114 ( 115 (list_match_prod (get_val u1 v_s) (l_m (fst fac))) + 116 (list_match_prod (get_val u2 v_s) (l_m (snd fac))) 117 ) * det ))))) 118 | (e,id) <- asb_table!^i 119 ] 120 ) / (-3.0) 121 | i <- range p_bnds 122 ] 123 where 124 p_bnds = s_bounds asb_table 125 bindTo x k = k x 126 127 ----------------------------------------------------------- 128 -- Calculating the right-hand-side for step 3. -- 129 -- Called in TG iteration. -- 130 ----------------------------------------------------------- 131 132 get_rh3 133 :: (My_Array Int (Frac_type,((Frac_type,Frac_type,Frac_type), 134 (Frac_type,Frac_type,Frac_type)))) 135 -> (My_Array Int [(Int,Int)]) 136 -> (My_Array Int [Int]) 137 -> (My_Array Int Frac_type) 138 -> (My_Array Int Frac_type, My_Array Int Frac_type) 139 140 get_rh3 el_det_fac asb_table p_steer del_p = 141 ( 142 s_amap (\x->x/3) 143 (s_listArray n_bnds (map (sum.(map fst)) pair_list)), 144 s_amap (\x->x/3) 145 (s_listArray n_bnds (map (sum.(map snd)) pair_list)) 146 ) 147 where 148 pair_list = 149 [ 150 [ 151 (l_mat!^id) `bindTo` ( \ l_m -> 152 (get_val del_p (p_steer!^e)) `bindTo` ( \ p_val -> 153 (el_det_fac!^e) `bindTo` ( \ el_d_f -> 154 (fst el_d_f) `bindTo` ( \ det -> 155 (snd el_d_f) `bindTo` ( \ fac -> 156 ( 157 det * (list_match_prod p_val (l_m (fst fac))), 158 det * (list_match_prod p_val (l_m (snd fac))) 159 ) ))))) 160 | (e,id)<-tab_elem 161 ] 162 | tab_elem <- s_elems asb_table 163 ] 164 n_bnds = s_bounds asb_table 165 bindTo x k = k x