[project @ 1996-01-08 20:13:28 by partain]
[nofib.git] / spectral / hartel / wave4main / Main2.hs
1 module Main (main) -- wave4main
2 where {
3
4 #include "../Fast2haskell2.hs"
5
6 f_benchmark_main a_n=(++) (f_sumcode (f_output_print (f_solution a_n))) "\n";
7 f_sumcode::[Char] -> [Char];
8 f_sumcode a_xs=
9 let {
10 f_sumcode' [] a_sum a_n=(++) (show (((+) :: (Int -> Int -> Int)) a_sum a_n)) ((:) '/' (show a_n));
11 f_sumcode' (a_x:a_xs) a_sum a_n=f_sumcode' a_xs (((+) :: (Int -> Int -> Int)) a_sum (ord a_x)) (((+) :: (Int -> Int -> Int)) a_n (1 :: Int))
12 } in f_sumcode' a_xs (0 :: Int) (0 :: Int);
13 type
14 T_matrix t1=Array_type (Array_type t1);
15 f_descr_print::Descr_type -> [Char];
16 f_descr_print a_d=
17 let {
18 r_low=lowbound a_d;
19 r_up=upbound a_d
20 } in (++) "[" ((++) (show r_low) ((++) ".." ((++) (show r_up) "]")));
21 f_array_print::(t1 -> [Char]) -> Char -> (Array_type t1) -> [Char];
22 f_array_print a_pr a_sep a_arr=(++) (f_descr_print (bounds a_arr)) (f_concat [(:) a_sep (a_pr a_n)|a_n<-
23 elems a_arr]);
24 f_matrix_print::(t1 -> [Char]) -> Char -> (T_matrix t1) -> [Char];
25 f_matrix_print a_pr a_sep a_mat=(++) (f_descr_print (bounds a_mat)) (f_concat [(:) a_sep (f_array_print a_pr ',' a_a)|a_a<-
26 elems a_mat]);
27 f_tabulate2::(Int -> Int -> t1) -> Descr_type -> Descr_type -> T_matrix t1;
28 f_tabulate2 a_f a_di a_dj=
29 let {
30 f_tabhulp a_f a_dj a_i=tabulate (a_f a_i) a_dj
31 } in tabulate (f_tabhulp a_f a_dj) a_di;
32 f_getdescr2::(T_matrix t1) -> (Descr_type,Descr_type);
33 f_getdescr2 a_arr=
34 let {
35 r_dx=bounds a_arr;
36 r_dy=bounds ((!) a_arr (lowbound r_dx))
37 } in (r_dx,r_dy);
38 f_subscript2::T_double_matrix -> Int -> Int -> Double; -- partain:sig changed
39 f_subscript2 a_a a_i a_j=(!) ((!) a_a a_i) a_j;
40 f_transpose2::(T_matrix Double) -> T_matrix Double; -- partain: sig changed
41 f_transpose2 a_arr=
42 let {
43 (r_dx,r_dy)=f_getdescr2 a_arr;
44 f_subhulp a_arr a_j a_i=f_subscript2 a_arr a_i a_j
45 } in f_tabulate2 (f_subhulp a_arr) r_dy r_dx;
46 f_updaterange::(T_matrix Double) -> (T_matrix Double) -> T_matrix Double; --partain: sig changed
47 f_updaterange a_a a_b=
48 let {
49 (r_dax,r_day)=f_getdescr2 a_a
50 } in f_tabulate2 (f_updatehulp a_a a_b) r_dax r_day;
51 f_updatehulp::(T_matrix Double) -> (T_matrix Double) -> Int -> Int -> Double; -- partain: sig changed
52 f_updatehulp a_a a_b a_i a_j=
53 let {
54 r_in_bx=f_indexindescr a_i r_dbx;
55 r_in_by=f_indexindescr a_j r_dby;
56 (r_dbx,r_dby)=f_getdescr2 a_b
57 } in
58 if (
59 if r_in_bx
60 then r_in_by
61 else
62 False)
63 then (f_subscript2 a_b a_i a_j)
64 else
65 (f_subscript2 a_a a_i a_j);
66 f_getleftcol::(T_matrix t1) -> Array_type t1;
67 f_getleftcol a_arr=f_getfirstel a_arr;
68 f_getrightcol::(T_matrix t1) -> Array_type t1;
69 f_getrightcol a_arr=f_getlastel a_arr;
70 f_getbottomrow::(T_matrix t1) -> Array_type t1;
71 f_getbottomrow a_arr=
72 let {
73 f_getbottomhulp a_arr a_i=f_getfirstel ((!) a_arr a_i)
74 } in tabulate (f_getbottomhulp a_arr) (bounds a_arr);
75 f_gettoprow::(T_matrix t1) -> Array_type t1;
76 f_gettoprow a_arr=
77 let {
78 f_gettophulp a_arr a_i=f_getlastel ((!) a_arr a_i)
79 } in tabulate (f_gettophulp a_arr) (bounds a_arr);
80 f_prependcol::(T_matrix Double) -> (Array_type Double) -> T_matrix Double; -- partain: sig change
81 f_prependcol a_arr a_col=f_prependel a_arr a_col;
82 f_appendcol::(T_matrix Double) -> (Array_type Double) -> T_matrix Double; -- partain: sig changed
83 f_appendcol a_arr a_col=f_appendel a_arr a_col;
84 f_prependrow::(T_matrix t1) -> (Array_type t1) -> T_matrix t1;
85 f_prependrow a_arr a_row=
86 let {
87 f_prependhulp a_arr a_row a_i=f_prependel ((!) a_arr a_i) ((!) a_row a_i)
88 } in tabulate (f_prependhulp a_arr a_row) (bounds a_arr);
89 f_appendrow::(T_matrix t1) -> (Array_type t1) -> T_matrix t1;
90 f_appendrow a_arr a_row=
91 let {
92 f_appendhulp a_arr a_row a_i=f_appendel ((!) a_arr a_i) ((!) a_row a_i)
93 } in tabulate (f_appendhulp a_arr a_row) (bounds a_arr);
94 f_indexindescr::Int -> Descr_type -> Bool;
95 f_indexindescr a_i a_d=
96 if (((>=) :: (Int -> Int -> Bool)) a_i (lowbound a_d))
97 then (((<=) :: (Int -> Int -> Bool)) a_i (upbound a_d))
98 else
99 False;
100 f_getfirstel::(Array_type t1) -> t1;
101 f_getfirstel a_arr=(!) a_arr (lowbound (bounds a_arr));
102 f_getlastel::(Array_type t1) -> t1;
103 f_getlastel a_arr=(!) a_arr (upbound (bounds a_arr));
104 f_prependel::(Array_type t1) -> t1 -> Array_type t1;
105 f_prependel a_ar a_x=
106 let {
107 r_lu=bounds a_ar;
108 r_l=lowbound r_lu;
109 r_u=upbound r_lu;
110 f_generate a_i=
111 if (((<) :: (Int -> Int -> Bool)) a_i r_l)
112 then a_x
113 else
114 ((!) a_ar a_i)
115 } in tabulate f_generate (descr (((-) :: (Int -> Int -> Int)) r_l (1 :: Int)) r_u);
116 f_appendel::(Array_type t1) -> t1 -> Array_type t1;
117 f_appendel a_ar a_x=
118 let {
119 r_lu=bounds a_ar;
120 r_l=lowbound r_lu;
121 r_u=upbound r_lu;
122 f_generate a_i=
123 if (((>) :: (Int -> Int -> Bool)) a_i r_u)
124 then a_x
125 else
126 ((!) a_ar a_i)
127 } in tabulate f_generate (descr r_l (((+) :: (Int -> Int -> Int)) r_u (1 :: Int)));
128 c_imax,c_jmax,c_imax1,c_jmax1,c_imid,c_imid1,c_jmid,c_jmid1::Int;
129 c_imax=(7 :: Int);
130 c_jmax=(7 :: Int);
131 c_imax1=((+) :: (Int -> Int -> Int)) c_imax (1 :: Int);
132 c_jmax1=((+) :: (Int -> Int -> Int)) c_jmax (1 :: Int);
133 c_imid=((-) :: (Int -> Int -> Int)) (((div) :: (Int -> Int -> Int)) c_imax1 (2 :: Int)) (1 :: Int);
134 c_imid1=((+) :: (Int -> Int -> Int)) c_imid (1 :: Int);
135 c_jmid=((-) :: (Int -> Int -> Int)) (((div) :: (Int -> Int -> Int)) c_jmax1 (2 :: Int)) (1 :: Int);
136 c_jmid1=((+) :: (Int -> Int -> Int)) c_jmid (1 :: Int);
137 c_deltax,c_deltay,c_deltat,c_fcr,c_gam,c_psi,c_gr,c_lbd,c_vwn::Double;
138 c_deltax=(10000.0 :: Double);
139 c_deltay=(10000.0 :: Double);
140 c_deltat=(800.000 :: Double);
141 c_fcr=(0.000125000 :: Double);
142 c_gam=(3.20000e-06 :: Double);
143 c_psi=(0.00000 :: Double);
144 c_gr=(9.80000 :: Double);
145 c_lbd=(0.00240000 :: Double);
146 c_vwn=(0.00000 :: Double);
147 type
148 T_mat=T_matrix Double;
149 type
150 T_col=Array_type Double;
151 type
152 T_row=Array_type Double;
153 type
154 T_triplet=(T_mat,T_mat,T_mat);
155 f_u0::Int -> Int -> Double;
156 f_u0 a_i a_j=(0.00000 :: Double);
157 f_v0::Int -> Int -> Double;
158 f_v0 a_i a_j=(0.00000 :: Double);
159 f_h0::Int -> Int -> Double;
160 f_h0 a_i a_j=((/) :: (Double -> Double -> Double)) (fromIntegral (((*) :: (Int -> Int -> Int)) (3 :: Int) a_i)) (fromIntegral c_imax);
161 f_d::Int -> Int -> Double;
162 f_d a_i a_j=(30.0000 :: Double);
163 c_cux,c_cuy,c_ccr,c_cfr,c_windx,c_windy,c_chx,c_chy::Double;
164 c_cux=((*) :: (Double -> Double -> Double)) c_gr (((/) :: (Double -> Double -> Double)) c_deltat (((*) :: (Double -> Double -> Double)) (2.00000 :: Double) c_deltax));
165 c_cuy=((*) :: (Double -> Double -> Double)) c_gr (((/) :: (Double -> Double -> Double)) c_deltat (((*) :: (Double -> Double -> Double)) (2.00000 :: Double) c_deltay));
166 c_ccr=((*) :: (Double -> Double -> Double)) c_fcr (((/) :: (Double -> Double -> Double)) c_deltat (4.00000 :: Double));
167 c_cfr=((*) :: (Double -> Double -> Double)) (2.00000 :: Double) c_deltat;
168 c_windx=((*) :: (Double -> Double -> Double)) c_gam (((*) :: (Double -> Double -> Double)) c_vwn (((*) :: (Double -> Double -> Double)) c_vwn (((cos) :: (Double -> Double)) c_psi)));
169 c_windy=((*) :: (Double -> Double -> Double)) c_gam (((*) :: (Double -> Double -> Double)) c_vwn (((*) :: (Double -> Double -> Double)) c_vwn (((sin) :: (Double -> Double)) c_psi)));
170 c_chx=((/) :: (Double -> Double -> Double)) c_deltat (((*) :: (Double -> Double -> Double)) (4.00000 :: Double) c_deltax);
171 c_chy=((/) :: (Double -> Double -> Double)) c_deltat (((*) :: (Double -> Double -> Double)) (4.00000 :: Double) c_deltay);
172 f_updu::T_mat -> T_mat -> T_mat -> Int -> Int -> Double;
173 f_updu a_u a_v a_h a_i a_j=
174 let {
175 r_height=((*) :: (Double -> Double -> Double)) c_cux (((-) :: (Double -> Double -> Double)) (f_subscript2 a_h a_i a_j) (f_subscript2 a_h (((-) :: (Int -> Int -> Int)) a_i (1 :: Int)) a_j));
176 r_coriolis=
177 let {
178 r_v1=f_subscript2 a_v (((-) :: (Int -> Int -> Int)) a_i (1 :: Int)) a_j;
179 r_v2=f_subscript2 a_v (((-) :: (Int -> Int -> Int)) a_i (1 :: Int)) (((+) :: (Int -> Int -> Int)) a_j (1 :: Int));
180 r_v3=f_subscript2 a_v a_i a_j;
181 r_v4=f_subscript2 a_v a_i (((+) :: (Int -> Int -> Int)) a_j (1 :: Int))
182 } in ((*) :: (Double -> Double -> Double)) c_ccr (((+) :: (Double -> Double -> Double)) r_v1 (((+) :: (Double -> Double -> Double)) r_v2 (((+) :: (Double -> Double -> Double)) r_v3 r_v4)));
183 r_friction=((*) :: (Double -> Double -> Double)) c_cfr (((/) :: (Double -> Double -> Double)) (((-) :: (Double -> Double -> Double)) r_bodem c_windx) (((+) :: (Double -> Double -> Double)) (f_d a_i a_j) (f_d a_i
184 (((+) :: (Int -> Int -> Int)) a_j (1 :: Int)))));
185 r_bodem=((*) :: (Double -> Double -> Double)) c_lbd (f_subscript2 a_u a_i a_j)
186 } in
187 if (((==) :: (Int -> Int -> Bool)) a_i (0 :: Int))
188 then (0.00000 :: Double)
189 else
190 if (((==) :: (Int -> Int -> Bool)) a_i c_imax1)
191 then (0.00000 :: Double)
192 else
193 (((+) :: (Double -> Double -> Double)) (((-) :: (Double -> Double -> Double)) (f_subscript2 a_u a_i a_j) r_height) (((-) :: (Double -> Double -> Double)) r_coriolis r_friction));
194 f_updv::T_mat -> T_mat -> T_mat -> Int -> Int -> Double;
195 f_updv a_u a_v a_h a_i a_j=
196 let {
197 r_height=((*) :: (Double -> Double -> Double)) c_cuy (((-) :: (Double -> Double -> Double)) (f_subscript2 a_h a_i a_j) (f_subscript2 a_h a_i (((-) :: (Int -> Int -> Int)) a_j (1 :: Int))));
198 r_coriolis=
199 let {
200 r_u1=f_subscript2 a_u a_i (((-) :: (Int -> Int -> Int)) a_j (1 :: Int));
201 r_u2=f_subscript2 a_u (((+) :: (Int -> Int -> Int)) a_i (1 :: Int)) (((-) :: (Int -> Int -> Int)) a_j (1 :: Int));
202 r_u3=f_subscript2 a_u a_i a_j;
203 r_u4=f_subscript2 a_u (((+) :: (Int -> Int -> Int)) a_i (1 :: Int)) a_j
204 } in ((*) :: (Double -> Double -> Double)) c_ccr (((+) :: (Double -> Double -> Double)) r_u1 (((+) :: (Double -> Double -> Double)) r_u2 (((+) :: (Double -> Double -> Double)) r_u3 r_u4)));
205 r_friction=((*) :: (Double -> Double -> Double)) c_cfr (((/) :: (Double -> Double -> Double)) (((-) :: (Double -> Double -> Double)) r_bodem c_windy) (((+) :: (Double -> Double -> Double)) (f_d a_i a_j) (f_d
206 (((+) :: (Int -> Int -> Int)) a_i (1 :: Int)) a_j)));
207 r_bodem=((*) :: (Double -> Double -> Double)) c_lbd (f_subscript2 a_v a_i a_j)
208 } in
209 if (((==) :: (Int -> Int -> Bool)) a_j (0 :: Int))
210 then (0.00000 :: Double)
211 else
212 if (((==) :: (Int -> Int -> Bool)) a_j c_jmax1)
213 then (0.00000 :: Double)
214 else
215 (((-) :: (Double -> Double -> Double)) (((-) :: (Double -> Double -> Double)) (f_subscript2 a_v a_i a_j) r_height) (((+) :: (Double -> Double -> Double)) r_coriolis r_friction));
216 f_updh::T_mat -> T_mat -> T_mat -> Int -> Int -> Double;
217 f_updh a_u a_v a_h a_i a_j=
218 let {
219 r_d1=((*) :: (Double -> Double -> Double)) (((+) :: (Double -> Double -> Double)) (f_d (((+) :: (Int -> Int -> Int)) a_i (1 :: Int)) a_j) (f_d (((+) :: (Int -> Int -> Int)) a_i (1 :: Int))
220 (((+) :: (Int -> Int -> Int)) a_j (1 :: Int)))) (f_subscript2 a_u (((+) :: (Int -> Int -> Int)) a_i (1 :: Int)) a_j);
221 r_d2=((*) :: (Double -> Double -> Double)) (((+) :: (Double -> Double -> Double)) (f_d a_i a_j) (f_d a_i (((+) :: (Int -> Int -> Int)) a_j (1 :: Int)))) (f_subscript2 a_u a_i a_j);
222 r_d3=((*) :: (Double -> Double -> Double)) (((+) :: (Double -> Double -> Double)) (f_d a_i (((+) :: (Int -> Int -> Int)) a_j (1 :: Int))) (f_d (((+) :: (Int -> Int -> Int)) a_i (1 :: Int))
223 (((+) :: (Int -> Int -> Int)) a_j (1 :: Int)))) (f_subscript2 a_v a_i (((+) :: (Int -> Int -> Int)) a_j (1 :: Int)));
224 r_d4=((*) :: (Double -> Double -> Double)) (((+) :: (Double -> Double -> Double)) (f_d a_i a_j) (f_d (((+) :: (Int -> Int -> Int)) a_i (1 :: Int)) a_j)) (f_subscript2 a_v a_i a_j)
225 } in ((-) :: (Double -> Double -> Double)) (((-) :: (Double -> Double -> Double)) (f_subscript2 a_h a_i a_j) (((*) :: (Double -> Double -> Double)) c_chx (((-) :: (Double -> Double -> Double)) r_d1 r_d2))) (((*) :: (Double -> Double -> Double)) c_chy
226 (((-) :: (Double -> Double -> Double)) r_d3 r_d4));
227 f_printall::[T_triplet] -> [Char];
228 f_printall a_trips=
229 let {
230 (r_us,r_vs,r_hs)=f_unzip3 a_trips
231 } in f_printtrip (f_join r_us,f_join r_vs,f_join r_hs);
232 f_printtrip::T_triplet -> [Char];
233 f_printtrip (a_u,a_v,a_h)=
234 let {
235 r_us=f_matrix_print (f_showfix (3 :: Int)) '\o012' (f_transpose2 a_u);
236 r_vs=f_matrix_print (f_showfix (3 :: Int)) '\o012' (f_transpose2 a_v);
237 r_hs=f_matrix_print (f_showfix (3 :: Int)) '\o012' (f_transpose2 a_h)
238 } in f_concat ((:) r_us ((:) ((:) '\o012' []) ((:) r_vs ((:)
239 ((:) '\o012' []) ((:) r_hs ((:) ((:) '\o012' []) []))))));
240 f_showfix::Int -> Double -> [Char];
241 f_showfix a_w a_x=
242 let {
243 r_sign=
244 if (((<) :: (Double -> Double -> Bool)) a_x (0.00000 :: Double))
245 then '-'
246 else
247 ' ';
248 r_i=floor (entier (((+) :: (Double -> Double -> Double)) (0.500000 :: Double) (f_abs (((*) :: (Double -> Double -> Double)) a_x (100.000 :: Double)))));
249 r_d3_c=chr (((+) :: (Int -> Int -> Int)) (ord '0') (((rem) :: (Int -> Int -> Int)) r_i (10 :: Int)));
250 r_d2_c=chr (((+) :: (Int -> Int -> Int)) (ord '0') (((rem) :: (Int -> Int -> Int)) (((div) :: (Int -> Int -> Int)) r_i (10 :: Int)) (10 :: Int)));
251 r_d1_c=chr (((+) :: (Int -> Int -> Int)) (ord '0') (((rem) :: (Int -> Int -> Int)) (((div) :: (Int -> Int -> Int)) r_i (100 :: Int)) (10 :: Int)))
252 } in
253 if (((>) :: (Int -> Int -> Bool)) r_i (999 :: Int))
254 then "*****"
255 else
256 ((:) r_sign ((:) r_d1_c ((:) '.' ((:) r_d2_c ((:) r_d3_c [])))));
257 f_join::[T_mat] -> T_mat;
258 f_join a_ranges=
259 let {
260 r_arr=f_tabulate2 f_zero2 (descr (0 :: Int) c_imax) (descr (0 :: Int) c_jmax)
261 } in f_foldl f_updaterange r_arr a_ranges;
262 f_zero2::Int -> Int -> Double;
263 f_zero2 a_i a_j=(0.00000 :: Double);
264 f_unzip3::[(t1,t2,t3)] -> ([t1],[t2],[t3]);
265 f_unzip3 []=([],[],[]);
266 f_unzip3 ((a_u,a_v,a_h):a_ts)=
267 let {
268 (r_us,r_vs,r_hs)=f_unzip3 a_ts
269 } in ((:) a_u r_us,(:) a_v r_vs,(:) a_h r_hs);
270 type
271 T_double_matrix=T_matrix Double;
272 type
273 T_double_array=Array_type Double;
274 type
275 T_double_matrix_triple=(T_double_matrix,T_double_matrix,T_double_matrix);
276 type
277 T_double_array_tuple=(T_double_array,T_double_array);
278 type
279 T_double_matrix_triple_pair=(T_double_matrix_triple,T_double_matrix_triple);
280 f_matrix_first_col a_m=f_getleftcol a_m;
281 f_matrix_last_col a_m=f_getrightcol a_m;
282 -- partain: sig
283 f_matrix_tab ::(Int -> Int -> Double) -> (Descr_type, Descr_type) -> T_double_matrix;
284 f_matrix_tab a_f (a_dx,a_dy)=f_tabulate2 a_f a_dx a_dy;
285 f_matrix_append_col a_m a_c=f_appendcol a_m a_c;
286 f_matrix_prepend_col a_m a_c=f_prependcol a_m a_c;
287 f_matrix_sub a_m a_i a_j=f_subscript2 a_m a_i a_j;
288 f_solution::Int -> T_double_matrix_triple_pair;
289 f_solution a_n=f_prog c_mf0 c_mg0 (f_first_borders c_mg0) a_n;
290 f_prog::T_double_matrix_triple -> T_double_matrix_triple -> T_double_array_tuple -> Int -> T_double_matrix_triple_pair;
291 f_prog a_mfh a_mgh a_mghds 0=(a_mfh,a_mgh);
292 f_prog a_mfh a_mgh a_mghds a_n=
293 let {
294 r_mfh'=f_fvh r_mfu;
295 r_mghds'=f_first_borders r_mgh';
296 r_mgh'=f_gvh r_mgu r_mfulst;
297 r_mfulst=f_last_borders r_mfu;
298 r_mfu=f_fu a_mfh a_mghds;
299 r_mgu=f_gu a_mgh
300 } in f_prog r_mfh' r_mgh' r_mghds' (((-) :: (Int -> Int -> Int)) a_n (1 :: Int));
301 c_mf0,c_mg0::T_double_matrix_triple;
302 c_mf0=(c_ul0,c_vl0,c_hl0);
303 c_mg0=(c_ur0,c_vr0,c_hr0);
304 f_fvh::T_double_matrix_triple -> T_double_matrix_triple;
305 f_fvh a_mfu=f_fh (f_fv a_mfu);
306 f_gvh::T_double_matrix_triple -> T_double_array -> T_double_matrix_triple;
307 f_gvh a_mgu a_mfulst=f_gh (f_gv a_mgu a_mfulst) a_mfulst;
308 f_first_borders::T_double_matrix_triple -> T_double_array_tuple;
309 f_first_borders (a_u,a_v,a_h)=(f_matrix_first_col a_v,f_matrix_first_col a_h);
310 f_last_borders::T_double_matrix_triple -> T_double_array;
311 f_last_borders (a_u,a_v,a_h)=f_matrix_last_col a_u;
312 f_fu::T_double_matrix_triple -> T_double_array_tuple -> T_double_matrix_triple;
313 f_fu (a_u,a_v,a_h) (a_vc,a_hc)=
314 let {
315 r_u1=f_matrix_tab (f_updu a_u (f_matrix_append_col a_v a_vc) (f_matrix_append_col a_h a_hc)) c_dul
316 } in (r_u1,a_v,a_h);
317 f_fv::T_double_matrix_triple -> T_double_matrix_triple;
318 f_fv (a_u,a_v,a_h)=
319 let {
320 r_v1=f_matrix_tab (f_updv a_u a_v a_h) c_dvl
321 } in (a_u,r_v1,a_h);
322 f_fh::T_double_matrix_triple -> T_double_matrix_triple;
323 f_fh (a_u,a_v,a_h)=
324 let {
325 r_h1=f_matrix_tab (f_updh a_u a_v a_h) c_dhl
326 } in (a_u,a_v,r_h1);
327 f_gu::T_double_matrix_triple -> T_double_matrix_triple;
328 f_gu (a_u,a_v,a_h)=
329 let {
330 r_u1=f_matrix_tab (f_updu a_u a_v a_h) c_dur
331 } in (r_u1,a_v,a_h);
332 f_gv::T_double_matrix_triple -> T_double_array -> T_double_matrix_triple;
333 f_gv (a_u,a_v,a_h) a_uc=
334 let {
335 r_v1=f_matrix_tab (f_updv (f_matrix_prepend_col a_u a_uc) a_v a_h) c_dvr
336 } in (a_u,r_v1,a_h);
337 f_gh::T_double_matrix_triple -> T_double_array -> T_double_matrix_triple;
338 f_gh (a_u,a_v,a_h) a_uc=
339 let {
340 r_h1=f_matrix_tab (f_updh (f_matrix_prepend_col a_u a_uc) a_v a_h) c_dhr
341 } in (a_u,a_v,r_h1);
342 c_k::Int;
343 c_k=((div) :: (Int -> Int -> Int)) c_imax1 (2 :: Int);
344 c_dul,c_dvl,c_dhl,c_dur,c_dvr,c_dhr::(Descr_type,Descr_type);
345 c_dul=(descr (0 :: Int) c_k,descr (0 :: Int) c_jmax);
346 c_dvl=(descr (0 :: Int) (((-) :: (Int -> Int -> Int)) c_k (1 :: Int)),descr (0 :: Int) c_jmax1);
347 c_dhl=(descr (0 :: Int) (((-) :: (Int -> Int -> Int)) c_k (1 :: Int)),descr (0 :: Int) c_jmax);
348 c_dur=(descr (((+) :: (Int -> Int -> Int)) c_k (1 :: Int)) c_imax1,descr (0 :: Int) c_jmax);
349 c_dvr=(descr c_k c_imax,descr (0 :: Int) c_jmax1);
350 c_dhr=(descr c_k c_imax,descr (0 :: Int) c_jmax);
351 c_ul0,c_vl0,c_hl0,c_ur0,c_vr0,c_hr0::T_double_matrix;
352 c_ul0=f_matrix_tab f_u0 c_dul;
353 c_vl0=f_matrix_tab f_v0 c_dvl;
354 c_hl0=f_matrix_tab f_h0 c_dhl;
355 c_ur0=f_matrix_tab f_u0 c_dur;
356 c_vr0=f_matrix_tab f_v0 c_dvr;
357 c_hr0=f_matrix_tab f_h0 c_dhr;
358 f_output_print::T_double_matrix_triple_pair -> [Char];
359 f_output_print ((a_lu,a_lv,a_lh),(a_ru,a_rv,a_rh))=f_concat [(++) (f_matrix_print (f_showfix (2 :: Int)) '\o012' a_m) "\n"|a_m<-(:) a_lu ((:) a_ru
360 ((:) a_lv ((:) a_rv ((:) a_lh ((:) a_rh [])))))];
361 f_abs::Double -> Double;
362 f_abs a_x=
363 if (((<=) :: (Double -> Double -> Bool)) a_x (0.00000 :: Double))
364 then (((negate) :: (Double -> Double)) a_x)
365 else
366 a_x;
367 f_and::[Bool] -> Bool;
368 f_and a_xs=f_foldr (&&) True a_xs;
369 f_cjustify::Int -> [Char] -> [Char];
370 f_cjustify a_n a_s=
371 let {
372 r_margin=((-) :: (Int -> Int -> Int)) a_n (length a_s);
373 r_lmargin=((div) :: (Int -> Int -> Int)) r_margin (2 :: Int);
374 r_rmargin=((-) :: (Int -> Int -> Int)) r_margin r_lmargin
375 } in (++) (f_spaces r_lmargin) ((++) a_s (f_spaces r_rmargin));
376 f_concat::[[t1]] -> [t1];
377 f_concat a_xs=f_foldr (++) [] a_xs;
378 f_const::t1 -> t2 -> t1;
379 f_const a_x a_y=a_x;
380 f_digit::Char -> Bool;
381 f_digit a_x=
382 if (((<=) :: (Int -> Int -> Bool)) (ord '0') (ord a_x))
383 then (((<=) :: (Int -> Int -> Bool)) (ord a_x) (ord '9'))
384 else
385 False;
386 f_drop::Int -> [t1] -> [t1];
387 f_drop 0 a_x=a_x;
388 f_drop a_n (a_a:a_x)=f_drop (((-) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x;
389 f_drop a_n a_x=[];
390 f_dropwhile::(t1 -> Bool) -> [t1] -> [t1];
391 f_dropwhile a_f []=[];
392 f_dropwhile a_f (a_a:a_x)=
393 if (a_f a_a)
394 then (f_dropwhile a_f a_x)
395 else
396 ((:) a_a a_x);
397 c_e::Double;
398 c_e=((exp) :: (Double -> Double)) (1.00000 :: Double);
399 f_filter::(t1 -> Bool) -> [t1] -> [t1];
400 f_filter a_f a_x=[a_a|a_a<-a_x,a_f a_a];
401 f_foldl::(t1 -> t2 -> t1) -> t1 -> [t2] -> t1;
402 f_foldl a_op a_r []=a_r;
403 f_foldl a_op a_r (a_a:a_x)=
404 let {
405 f_strict a_f a_x=seq a_x (a_f a_x)
406 } in f_foldl a_op (f_strict a_op a_r a_a) a_x;
407 f_foldl1::(t1 -> t1 -> t1) -> [t1] -> t1;
408 f_foldl1 a_op (a_a:a_x)=f_foldl a_op a_a a_x;
409 f_foldr::(t1 -> t2 -> t2) -> t2 -> [t1] -> t2;
410 f_foldr a_op a_r []=a_r;
411 f_foldr a_op a_r (a_a:a_x)=a_op a_a (f_foldr a_op a_r a_x);
412 f_foldr1::(t1 -> t1 -> t1) -> [t1] -> t1;
413 f_foldr1 a_op (a_a:[])=a_a;
414 f_foldr1 a_op (a_a:a_b:a_x)=a_op a_a (f_foldr1 a_op ((:) a_b a_x));
415 f_fst::(t1,t2) -> t1;
416 f_fst (a_a,a_b)=a_a;
417 f_id::t1 -> t1;
418 f_id a_x=a_x;
419 f_index::[t1] -> [Int];
420 f_index a_x=
421 let {
422 f_f a_n []=[];
423 f_f a_n (a_a:a_x)=(:) a_n (f_f (((+) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x)
424 } in f_f (0 :: Int) a_x;
425 f_init::[t1] -> [t1];
426 f_init (a_a:a_x)=
427 if (null a_x)
428 then []
429 else
430 ((:) a_a (f_init a_x));
431 f_iterate::(t1 -> t1) -> t1 -> [t1];
432 f_iterate a_f a_x=(:) a_x (f_iterate a_f (a_f a_x));
433 f_last::[t1] -> t1;
434 f_last a_x=(!!) a_x (((-) :: (Int -> Int -> Int)) (length a_x) (1 :: Int));
435 f_lay::[[Char]] -> [Char];
436 f_lay []=[];
437 f_lay (a_a:a_x)=(++) a_a ((++) "\n" (f_lay a_x));
438 f_layn::[[Char]] -> [Char];
439 f_layn a_x=
440 let {
441 f_f a_n []=[];
442 f_f a_n (a_a:a_x)=(++) (f_rjustify (4 :: Int) (show a_n)) ((++) ") " ((++) a_a ((++) "\n"
443 (f_f (((+) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x))))
444 } in f_f (1 :: Int) a_x;
445 f_letter::Char -> Bool;
446 f_letter a_c=
447 if (
448 if (((<=) :: (Int -> Int -> Bool)) (ord 'a') (ord a_c))
449 then (((<=) :: (Int -> Int -> Bool)) (ord a_c) (ord 'z'))
450 else
451 False)
452 then True
453 else
454 if (((<=) :: (Int -> Int -> Bool)) (ord 'A') (ord a_c))
455 then (((<=) :: (Int -> Int -> Bool)) (ord a_c) (ord 'Z'))
456 else
457 False;
458 f_limit::[Double] -> Double;
459 f_limit (a_a:a_b:a_x)=
460 if (((==) :: (Double -> Double -> Bool)) a_a a_b)
461 then a_a
462 else
463 (f_limit ((:) a_b a_x));
464 f_lines::[Char] -> [[Char]];
465 f_lines []=[];
466 f_lines (a_a:a_x)=
467 let {
468 r_xs=
469 if (pair a_x)
470 then (f_lines a_x)
471 else
472 ((:) [] [])
473 } in
474 if (((==) :: (Int -> Int -> Bool)) (ord a_a) (ord '\o012'))
475 then ((:) [] (f_lines a_x))
476 else
477 ((:) ((:) a_a (head r_xs)) (tail r_xs));
478 f_ljustify::Int -> [Char] -> [Char];
479 f_ljustify a_n a_s=(++) a_s (f_spaces (((-) :: (Int -> Int -> Int)) a_n (length a_s)));
480 f_map::(t1 -> t2) -> [t1] -> [t2];
481 f_map a_f a_x=[a_f a_a|a_a<-a_x];
482 f_map2::(t1 -> t2 -> t3) -> [t1] -> [t2] -> [t3];
483 f_map2 a_f a_x a_y=[a_f a_a a_b|(a_a,a_b)<-f_zip2 a_x a_y];
484 f_max::[Int] -> Int;
485 f_max a_xs=f_foldl1 f_max2 a_xs;
486 f_max2::Int -> Int -> Int;
487 f_max2 a_a a_b=
488 if (((>=) :: (Int -> Int -> Bool)) a_a a_b)
489 then a_a
490 else
491 a_b;
492 f_member::[Int] -> Int -> Bool;
493 f_member a_x a_a=f_or (f_map (flip ((==) :: (Int -> Int -> Bool)) a_a) a_x);
494 f_merge::[Int] -> [Int] -> [Int];
495 f_merge [] a_y=a_y;
496 f_merge (a_a:a_x) []=(:) a_a a_x;
497 f_merge (a_a:a_x) (a_b:a_y)=
498 if (((<=) :: (Int -> Int -> Bool)) a_a a_b)
499 then ((:) a_a (f_merge a_x ((:) a_b a_y)))
500 else
501 ((:) a_b (f_merge ((:) a_a a_x) a_y));
502 f_min::[Int] -> Int;
503 f_min a_xs=f_foldl1 f_min2 a_xs;
504 f_min2::Int -> Int -> Int;
505 f_min2 a_a a_b=
506 if (((>) :: (Int -> Int -> Bool)) a_a a_b)
507 then a_b
508 else
509 a_a;
510 f_mkset::[Int] -> [Int];
511 f_mkset []=[];
512 f_mkset (a_a:a_x)=(:) a_a (f_filter (flip ((/=) :: (Int -> Int -> Bool)) a_a) (f_mkset a_x));
513 f_or::[Bool] -> Bool;
514 f_or a_xs=f_foldr (||) False a_xs;
515 c_pi::Double;
516 c_pi=((*) :: (Double -> Double -> Double)) (4.00000 :: Double) (((atan) :: (Double -> Double)) (1.00000 :: Double));
517 f_postfix::t1 -> [t1] -> [t1];
518 f_postfix a_a a_x=(++) a_x ((:) a_a []);
519 f_product::[Int] -> Int;
520 f_product a_xs=f_foldl ((*) :: (Int -> Int -> Int)) (1 :: Int) a_xs;
521 f_rep::Int -> t1 -> [t1];
522 f_rep a_n a_x=f_take a_n (f_repeat a_x);
523 f_repeat::t1 -> [t1];
524 f_repeat a_x=(:) a_x (f_repeat a_x);
525 f_reverse::[t1] -> [t1];
526 f_reverse a_xs=f_foldl (flip (:)) [] a_xs;
527 f_rjustify::Int -> [Char] -> [Char];
528 f_rjustify a_n a_s=(++) (f_spaces (((-) :: (Int -> Int -> Int)) a_n (length a_s))) a_s;
529 f_scan::(t1 -> t2 -> t1) -> t1 -> [t2] -> [t1];
530 f_scan a_op=
531 let {
532 f_g a_r []=(:) a_r [];
533 f_g a_r (a_a:a_x)=(:) a_r (f_g (a_op a_r a_a) a_x)
534 } in f_g;
535 f_snd::(t1,t2) -> t2;
536 f_snd (a_a,a_b)=a_b;
537 f_sort::[Int] -> [Int];
538 f_sort a_x=
539 let {
540 r_n=length a_x;
541 r_n2=((div) :: (Int -> Int -> Int)) r_n (2 :: Int)
542 } in
543 if (((<=) :: (Int -> Int -> Bool)) r_n (1 :: Int))
544 then a_x
545 else
546 (f_merge (f_sort (f_take r_n2 a_x)) (f_sort (f_drop r_n2 a_x)));
547 f_spaces::Int -> [Char];
548 f_spaces a_n=f_rep a_n ' ';
549 f_subtract::Int -> Int -> Int;
550 f_subtract a_x a_y=((-) :: (Int -> Int -> Int)) a_y a_x;
551 f_sum::[Int] -> Int;
552 f_sum a_xs=f_foldl ((+) :: (Int -> Int -> Int)) (0 :: Int) a_xs;
553 data
554 T_sys_message=F_Stdout [Char] | F_Stderr [Char] | F_Tofile [Char] [Char] | F_Closefile [Char] | F_Appendfile [Char] | F_System [Char] | F_Exit Int;
555 f_take::Int -> [t1] -> [t1];
556 f_take 0 a_x=[];
557 f_take a_n (a_a:a_x)=(:) a_a (f_take (((-) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x);
558 f_take a_n a_x=[];
559 f_takewhile::(t1 -> Bool) -> [t1] -> [t1];
560 f_takewhile a_f []=[];
561 f_takewhile a_f (a_a:a_x)=
562 if (a_f a_a)
563 then ((:) a_a (f_takewhile a_f a_x))
564 else
565 [];
566 f_transpose::[[t1]] -> [[t1]];
567 f_transpose a_x=
568 let {
569 r_x'=f_takewhile pair a_x
570 } in
571 if (null r_x')
572 then []
573 else
574 ((:) (f_map head r_x') (f_transpose (f_map tail r_x')));
575 f_until::(t1 -> Bool) -> (t1 -> t1) -> t1 -> t1;
576 f_until a_f a_g a_x=
577 if (a_f a_x)
578 then a_x
579 else
580 (f_until a_f a_g (a_g a_x));
581 f_zip2::[t1] -> [t2] -> [(t1,t2)];
582 f_zip2 (a_a:a_x) (a_b:a_y)=(:) (a_a,a_b) (f_zip2 a_x a_y);
583 f_zip2 a_x a_y=[];
584 f_zip3 (a_a:a_x) (a_b:a_y) (a_c:a_z)=(:) (a_a,a_b,a_c) (f_zip3 a_x a_y a_z);
585 f_zip3 a_x a_y a_z=[];
586 f_zip4 (a_a:a_w) (a_b:a_x) (a_c:a_y) (a_d:a_z)=(:) (a_a,a_b,a_c,a_d) (f_zip4 a_w a_x a_y a_z);
587 f_zip4 a_w a_x a_y a_z=[];
588 f_zip5 (a_a:a_v) (a_b:a_w) (a_c:a_x) (a_d:a_y) (a_e:a_z)=(:) (a_a,a_b,a_c,a_d,a_e) (f_zip5 a_v a_w a_x a_y a_z);
589 f_zip5 a_v a_w a_x a_y a_z=[];
590 f_zip6 (a_a:a_u) (a_b:a_v) (a_c:a_w) (a_d:a_x) (a_e:a_y) (a_f:a_z)=(:) (a_a,a_b,a_c,a_d,a_e,a_f) (f_zip6 a_u a_v a_w a_x a_y a_z);
591 f_zip6 a_u a_v a_w a_x a_y a_z=[];
592 f_zip::([t1],[t2]) -> [(t1,t2)];
593 f_zip (a_x,a_y)=f_zip2 a_x a_y;
594 f_main a_x=f_benchmark_main a_x;
595 c_input=(4000 :: Int);
596 main r = [AppendChan "stdout" (f_main c_input)]
597 }