Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/benchmarks/programs/b-hut/load.sml
ViewVC logotype

Annotation of /sml/trunk/benchmarks/programs/b-hut/load.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 193 - (view) (download)

1 : monnier 193 (* load.sml
2 :     *
3 :     * COPYRIGHT (c) 1993, AT&T Bell Laboratories.
4 :     *
5 :     * Code to build the tree from a list of bodies.
6 :     *)
7 :    
8 :     signature LOAD =
9 :     sig
10 :    
11 :     structure S : SPACE
12 :     structure V : VECTOR
13 :     sharing S.V = V
14 :    
15 :     val makeTree : (S.body list * real V.vec * real) -> S.space
16 :    
17 :     end; (* LOAD *)
18 :    
19 :     functor Load (S : SPACE) : LOAD =
20 :     struct
21 :    
22 :     structure S = S
23 :     structure V = S.V
24 :    
25 :     exception NotIntCoord
26 :    
27 :     fun rshift (n, k) = Word.toInt(Word.~>>(Word.fromInt n, Word.fromInt k))
28 :    
29 :     val IMAX = 0x20000000 (* 2^29 *)
30 :     val IMAXrs1 = rshift(IMAX, 1)
31 :     val rIMAX = real IMAX
32 :    
33 :     (* compute integerized coordinates. Raises the NotIntCoord exception,
34 :     * if rp is out of bounds.
35 :     *)
36 :     fun intcoord (rp, rmin, rsize) = let
37 :     val xsc = V.divvs (V.subv(rp, rmin), rsize)
38 :     fun cvt x = if ((0.0 <= x) andalso (x < 1.0))
39 :     then floor(rIMAX * x)
40 :     else raise NotIntCoord
41 :     in
42 :     V.mapv cvt xsc
43 :     end
44 :    
45 :     (* determine which subcell to select. *)
46 :     fun subindex (iv, l) = let
47 :     fun aux (v, (i, k)) = if (Word.andb(Word.fromInt v, Word.fromInt l) <> 0w0)
48 :     then (i + rshift(S.nsub, k+1), k+1)
49 :     else (i, k+1)
50 :     in
51 :     #1 (V.foldv aux iv (0, 0))
52 :     end
53 :    
54 :     (* enlarge cubical "box", salvaging existing tree structure. *)
55 :     fun expandBox (nd as S.Body{pos, ...}, box as S.Space{rmin, rsize, root}) = (
56 :     (intcoord (!pos, rmin, rsize); box)
57 :     handle NotIntCoord => let
58 :     val rmid = V.addvs (rmin, 0.5 * rsize)
59 :     val rmin' = V.map3v (fn (x,y,z) =>
60 :     if x < y then z - rsize else z) (!pos, rmid, rmin)
61 :     val rsize' = 2.0 * rsize
62 :     fun mksub (v, r) = let
63 :     val x = intcoord (v, rmin', rsize')
64 :     val k = subindex (x, IMAXrs1)
65 :     val cell = S.mkCell ()
66 :     in
67 :     S.putCell (cell, k, r); cell
68 :     end
69 :     val box = (case root
70 :     of S.Empty => S.Space{rmin=rmin', rsize=rsize', root=root}
71 :     | _ => S.Space{
72 :     rmin = rmin',
73 :     rsize = rsize',
74 :     root = S.mkCellNode (mksub (rmid, root))
75 :     }
76 :     (* end case *))
77 :     in
78 :     expandBox (nd, box)
79 :     end)
80 :    
81 :    
82 :     (* insert a single node into the tree *)
83 :     fun loadTree (body as S.Body{pos=posp, ...}, S.Space{rmin, rsize, root}) = let
84 :     val xp = intcoord (!posp, rmin, rsize)
85 :     fun insert (S.Empty, _) = S.mkBodyNode body
86 :     | insert (n as S.Node{cell=S.BodyCell _, pos=posq, ...}, l) = let
87 :     val xq = intcoord (!posq, rmin, rsize)
88 :     val k = subindex (xq, l)
89 :     val a = S.mkCell()
90 :     in
91 :     S.putCell(a, k, n);
92 :     insert (S.mkCellNode a, l)
93 :     end
94 :     | insert (n as S.Node{cell, ...}, l) = let
95 :     val k = subindex (xp, l)
96 :     val subtree = insert (S.getCell (cell, k), rshift(l, 1))
97 :     in
98 :     S.putCell (cell, k, subtree);
99 :     n
100 :     end
101 :     in
102 :     S.Space{rmin = rmin, rsize = rsize, root = insert (root, IMAXrs1)}
103 :     end
104 :    
105 :     (* descend tree finding center-of-mass coordinates. *)
106 :     fun hackCofM S.Empty = ()
107 :     | hackCofM (S.Node{cell = S.BodyCell _, ...}) = ()
108 :     | hackCofM (S.Node{cell = S.Cell subcells, mass, pos}) = let
109 :     fun sumMass (i, totMass, cofm) = if (i < S.nsub)
110 :     then (case Array.sub(subcells, i)
111 :     of S.Empty => sumMass (i+1, totMass, cofm)
112 :     | (nd as S.Node{mass, pos, ...}) => let
113 :     val _ = hackCofM nd
114 :     val m = !mass
115 :     in
116 :     sumMass (i+1, totMass + m, V.addv(cofm, V.mulvs(!pos, m)))
117 :     end
118 :     (* end case *))
119 :     else (
120 :     mass := totMass;
121 :     pos := V.divvs(cofm, totMass))
122 :     in
123 :     sumMass (0, 0.0, V.zerov)
124 :     end
125 :    
126 :     (* initialize tree structure for hack force calculation. *)
127 :     fun makeTree (bodies, rmin, rsize) = let
128 :     fun build ([], space) = space
129 :     | build ((body as S.Body{mass, ...}) :: r, space) =
130 :     if Real.==(mass, 0.0) then build (r, space)
131 :     else let
132 :     val box = expandBox (body, space)
133 :     val box = loadTree(body, box)
134 :     in build (r, box)
135 :     end
136 :     val (space as S.Space{root, ...}) =
137 :     build (bodies, S.Space{rmin=rmin, rsize=rsize, root=S.Empty})
138 :     in
139 :     hackCofM root;
140 :     space
141 :     end
142 :    
143 :     end; (* functor Load *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0