CubeCplx.Mod 18 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537
  1. (* CAPO - Computational Analysis Platform for Oberon - by Alan Freed and Felix Friedrich. *)
  2. (* Version 1, Update 2 *)
  3. MODULE CubeCplx; (** AUTHOR "fof"; PURPOSE "3D matrix object of type Real."; *)
  4. IMPORT SYSTEM, NbrInt, ArrayXdBytes, ArrayXd := ArrayXdCplx, NbrCplx,DataErrors, NbrRat, NbrRe,
  5. CubeInt, CubeRat, CubeRe, DataIO;
  6. CONST
  7. (** The version number used when reading/writing a cube to file. *)
  8. VERSION* = 1;
  9. TYPE
  10. Value* = ArrayXd.Value; Index* = LONGINT; Array* = ArrayXd.Array; IntValue = ArrayXd.IntValue;
  11. RatValue = NbrRat.Rational; ReValue = NbrRe.Real; ArrayC* = ArrayXd.Array3; Map* = ArrayXd.Map;
  12. (** Type Cube is DataIO registered, instances of it can therefore be made persistent. *)
  13. Cube* = OBJECT (ArrayXd.Array)
  14. VAR lenx-, leny-, lenz-: LONGINT; (* lenx = nr.Columns, leny = nr.Rows *)
  15. ox-, oy-, oz-: LONGINT;
  16. Get-: PROCEDURE {DELEGATE} ( x, y, z: Index ): Value;
  17. (* override *)
  18. PROCEDURE AlikeX*( ): ArrayXdBytes.Array;
  19. VAR copy: Cube;
  20. BEGIN
  21. NEW( copy, origin[0], len[0], origin[1], len[1], origin[2], len[2] ); RETURN copy;
  22. END AlikeX;
  23. PROCEDURE NewRangeX*( neworigin, newlen:ArrayXdBytes.IndexArray; copydata: BOOLEAN );
  24. BEGIN
  25. IF LEN( newlen ) # 3 THEN HALT( 1001 ) END;
  26. NewRangeX^( neworigin, newlen, copydata );
  27. END NewRangeX;
  28. PROCEDURE ValidateCache*;
  29. BEGIN
  30. ValidateCache^;
  31. IF dim # 3 THEN HALT( 100 ) END;
  32. lenx := len[0]; leny := len[1]; lenz := len[2]; ox := origin[0]; oy := origin[1]; oz := origin[2];
  33. END ValidateCache;
  34. PROCEDURE SetBoundaryCondition*( c: SHORTINT ); (* called by new, load and directly *)
  35. BEGIN
  36. SetBoundaryCondition^( c );
  37. CASE c OF
  38. ArrayXd.StrictBoundaryC:
  39. Get := Get3;
  40. | ArrayXd.AbsorbingBoundaryC:
  41. Get := Get3BAbsorbing;
  42. | ArrayXd.PeriodicBoundaryC:
  43. Get := Get3BPeriodic;
  44. | ArrayXd.SymmetricOnBoundaryC:
  45. Get := Get3BSymmetricOnB
  46. | ArrayXd.SymmetricOffBoundaryC:
  47. Get := Get3BSymmetricOffB
  48. | ArrayXd.AntisymmetricOnBoundaryC:
  49. Get := Get3BAntisymmetricOnB
  50. | ArrayXd.AntisymmetricOffBoundaryC:
  51. Get := Get3BAntisymmetricOffB
  52. END;
  53. END SetBoundaryCondition;
  54. (** new *)
  55. PROCEDURE & New*( ox, w, oy, h, oz, d: LONGINT );
  56. BEGIN
  57. NewXdB( ArrayXdBytes.Array3( ox, oy, oz ), ArrayXdBytes.Array3( w, h, d ) );
  58. END New;
  59. PROCEDURE Alike*( ): Cube;
  60. VAR copy: ArrayXdBytes.Array;
  61. BEGIN
  62. copy := AlikeX(); RETURN copy( Cube );
  63. END Alike;
  64. PROCEDURE NewRange*( ox, w, oy, h, oz, d: LONGINT; copydata: BOOLEAN );
  65. BEGIN
  66. IF (w # len[0]) OR (h # len[1]) OR (d # len[2]) OR (ox # origin[0]) OR (oy # origin[1]) OR (oz # origin[2]) THEN
  67. NewRangeX^( ArrayXdBytes.Array3( ox, oy, oz ), ArrayXdBytes.Array3( w, h, d ), copydata )
  68. END;
  69. END NewRange;
  70. PROCEDURE Copy*( ): Cube;
  71. VAR res: ArrayXdBytes.Array;
  72. BEGIN
  73. res := CopyX(); RETURN res( Cube );
  74. END Copy;
  75. PROCEDURE Set*( x, y, z: Index; v: Value );
  76. BEGIN
  77. ArrayXdBytes.Set3( SELF, x, y, z, v );
  78. END Set;
  79. (** copy methods using the current boundary condition SELF.bc*)
  80. PROCEDURE CopyToVec*( dest: Array; dim: Index; srcx, srcy, srcz, destx, len: Index );
  81. VAR slen: ArrayXdBytes.IndexArray;
  82. BEGIN
  83. IF (dest.dim # 1) THEN HALT( 1003 ) END;
  84. slen := ArrayXdBytes.Index3( 1, 1, 1 ); slen[dim] := len;
  85. CopyToArray( dest, ArrayXdBytes.Index3( srcx, srcy, srcz ), slen, ArrayXdBytes.Index1( destx ),
  86. ArrayXdBytes.Index1( len ) );
  87. END CopyToVec;
  88. PROCEDURE CopyToMtx*( dest: Array; dimx, dimy: Index; srcx, srcy, srcz, destx, desty, lenx, leny: Index );
  89. VAR slen: ArrayXdBytes.IndexArray;
  90. BEGIN
  91. IF (dest.dim # 2) OR (dimx >= dimy) THEN HALT( 1005 ) END;
  92. slen := ArrayXdBytes.Index3( 1, 1, 1 ); slen[dimx] := lenx; slen[dimy] := leny;
  93. CopyToArray( dest, ArrayXdBytes.Index3( srcx, srcy, srcz ), slen, ArrayXdBytes.Index2( destx, desty ),
  94. ArrayXdBytes.Index2( lenx, leny ) );
  95. END CopyToMtx;
  96. PROCEDURE CopyToCube*( dest: Array; srcx, srcy, srcz, destx, desty, destz, lenx, leny, lenz: Index );
  97. VAR slen: ArrayXdBytes.IndexArray;
  98. BEGIN
  99. IF (dest.dim # 3) THEN HALT( 1005 ) END;
  100. slen := ArrayXdBytes.Index3( lenx, leny, lenz );
  101. CopyToArray( dest, ArrayXdBytes.Index3( srcx, srcy, srcz ), slen, ArrayXdBytes.Index3( destx, desty, destz ), slen );
  102. END CopyToCube;
  103. PROCEDURE CopyToHCube*( dest: Array; dimx, dimy, dimz: Index;
  104. srcx, srcy, srcz, destx, desty, destz, destt, lenx, leny, lenz: Index );
  105. VAR slen: ArrayXdBytes.IndexArray;
  106. BEGIN
  107. IF (dest.dim # 4) OR (dimx >= dimy) OR (dimy >= dimz) THEN HALT( 1005 ) END;
  108. slen := ArrayXdBytes.Index4( 1, 1, 1, 1 ); slen[dimx] := lenx; slen[dimy] := leny; slen[dimz] := lenz;
  109. CopyToArray( dest, ArrayXdBytes.Index3( srcx, srcy, srcz ), ArrayXdBytes.Index3( lenx, leny, lenz ),
  110. ArrayXdBytes.Index4( destx, desty, destz, destt ), slen );
  111. END CopyToHCube;
  112. PROCEDURE CopyTo1dArray*( VAR dest: ARRAY OF Value; sx, sy, sz, slenx, sleny, slenz: Index; dpos, dlen: LONGINT );
  113. VAR destm: ArrayXdBytes.ArrayMemoryStructure;
  114. BEGIN
  115. destm :=
  116. ArrayXdBytes.MakeMemoryStructure( 1, ArrayXdBytes.Index1( 0 ), ArrayXdBytes.Index1( LEN( dest ) ), SIZEOF( Value ),
  117. ADDRESSOF( dest[0] ) );
  118. ArrayXd.CopyArrayToArrayPartB( SELF, destm, bc, ArrayXdBytes.Index3( sx, sy, sz ),
  119. ArrayXdBytes.Index3( slenx, sleny, slenz ), ArrayXdBytes.Index1( dpos ),
  120. ArrayXdBytes.Index1( dlen ) );
  121. END CopyTo1dArray;
  122. PROCEDURE CopyTo2dArray*( VAR dest: ARRAY OF ARRAY OF Value; sx, sy, sz, slenx, sleny, slenz: Index;
  123. dposx, dposy, dlenx, dleny: LONGINT );
  124. VAR destm: ArrayXdBytes.ArrayMemoryStructure;
  125. BEGIN
  126. destm :=
  127. ArrayXdBytes.MakeMemoryStructure( 2, ArrayXdBytes.Index2( 0, 0 ), ArrayXdBytes.Index2( LEN( dest, 1 ), LEN( dest, 0 ) ),
  128. SIZEOF( Value ), ADDRESSOF( dest[0, 0] ) );
  129. ArrayXd.CopyArrayToArrayPartB( SELF, destm, bc, ArrayXdBytes.Index3( sx, sy, sz ),
  130. ArrayXdBytes.Index3( slenx, sleny, slenz ), ArrayXdBytes.Index2( dposx, dposy ),
  131. ArrayXdBytes.Index2( dlenx, dleny ) );
  132. END CopyTo2dArray;
  133. PROCEDURE CopyTo3dArray*( VAR dest: ARRAY OF ARRAY OF ARRAY OF Value; sx, sy, sz, slenx, sleny, slenz: Index;
  134. dposx, dposy, dposz, dlenx, dleny, dlenz: LONGINT );
  135. VAR destm: ArrayXdBytes.ArrayMemoryStructure;
  136. BEGIN
  137. destm :=
  138. ArrayXdBytes.MakeMemoryStructure( 3, ArrayXdBytes.Index3( 0, 0, 0 ),
  139. ArrayXdBytes.Index3( LEN( dest, 2 ), LEN( dest, 1 ), LEN( dest, 0 ) ), SIZEOF( Value ),
  140. ADDRESSOF( dest[0, 0, 0] ) );
  141. ArrayXd.CopyArrayToArrayPartB( SELF, destm, bc, ArrayXdBytes.Index3( sx, sy, sz ),
  142. ArrayXdBytes.Index3( slenx, sleny, slenz ),
  143. ArrayXdBytes.Index3( dposx, dposy, dposz ),
  144. ArrayXdBytes.Index3( dlenx, dleny, dlenz ) );
  145. END CopyTo3dArray;
  146. PROCEDURE CopyTo4dArray*( VAR dest: ARRAY OF ARRAY OF ARRAY OF ARRAY OF Value; sx, sy, sz, slenx, sleny, slenz: Index;
  147. dposx, dposy, dposz, dpost, dlenx, dleny, dlenz, dlent: LONGINT );
  148. VAR destm: ArrayXdBytes.ArrayMemoryStructure;
  149. BEGIN
  150. destm :=
  151. ArrayXdBytes.MakeMemoryStructure( 4, ArrayXdBytes.Index4( 0, 0, 0, 0 ),
  152. ArrayXdBytes.Index4( LEN( dest, 3 ), LEN( dest, 2 ), LEN( dest, 1 ), LEN( dest, 0 ) ), SIZEOF( Value ),
  153. ADDRESSOF( dest[0, 0, 0, 0] ) );
  154. ArrayXd.CopyArrayToArrayPartB( SELF, destm, bc, ArrayXdBytes.Index3( sx, sy, sz ),
  155. ArrayXdBytes.Index3( slenx, sleny, slenz ),
  156. ArrayXdBytes.Index4( dposx, dposy, dposz, dpost ),
  157. ArrayXdBytes.Index4( dlenx, dleny, dlenz, dlent ) );
  158. END CopyTo4dArray;
  159. (** copy from without boundary conditions *)
  160. PROCEDURE CopyFrom1dArray*( VAR src: ARRAY OF Value; spos, slen: Index; dx, dy, dz, dlenx, dleny, dlenz: Index );
  161. VAR srcm: ArrayXdBytes.ArrayMemoryStructure;
  162. BEGIN
  163. srcm :=
  164. ArrayXdBytes.MakeMemoryStructure( 1, ArrayXdBytes.Index1( 0 ), ArrayXdBytes.Index1( LEN( src ) ), SIZEOF( Value ),
  165. ADDRESSOF( src[0] ) );
  166. ArrayXdBytes.CopyArrayPartToArrayPart( srcm, SELF, ArrayXdBytes.Index1( spos ), ArrayXdBytes.Index1( slen ),
  167. ArrayXdBytes.Index3( dx, dy, dz ),
  168. ArrayXdBytes.Index3( dlenx, dleny, dlenz ) );
  169. END CopyFrom1dArray;
  170. PROCEDURE CopyFrom2dArray*( VAR src: ARRAY OF ARRAY OF Value; sposx, spoxy, slenx, sleny: Index;
  171. dx, dy, dz, dlenx, dleny, dlenz: Index );
  172. VAR srcm: ArrayXdBytes.ArrayMemoryStructure;
  173. BEGIN
  174. srcm :=
  175. ArrayXdBytes.MakeMemoryStructure( 2, ArrayXdBytes.Index2( 0, 0 ), ArrayXdBytes.Index2( LEN( src, 1 ), LEN( src, 0 ) ),
  176. SIZEOF( Value ), ADDRESSOF( src[0, 0] ) );
  177. ArrayXdBytes.CopyArrayPartToArrayPart( srcm, SELF, ArrayXdBytes.Index2( sposx, spoxy ),
  178. ArrayXdBytes.Index2( slenx, sleny ), ArrayXdBytes.Index3( dx, dy, dz ),
  179. ArrayXdBytes.Index3( dlenx, dleny, dlenz ) );
  180. END CopyFrom2dArray;
  181. PROCEDURE CopyFrom3dArray*( VAR src: ARRAY OF ARRAY OF ARRAY OF Value; sposx, spoxy, sposz, slenx, sleny, slenz: Index;
  182. dx, dy, dz, dlenx, dleny, dlenz: Index );
  183. VAR srcm: ArrayXdBytes.ArrayMemoryStructure;
  184. BEGIN
  185. srcm :=
  186. ArrayXdBytes.MakeMemoryStructure( 3, ArrayXdBytes.Index3( 0, 0, 0 ),
  187. ArrayXdBytes.Index3( LEN( src, 2 ), LEN( src, 1 ), LEN( src, 0 ) ), SIZEOF( Value ),
  188. ADDRESSOF( src[0, 0, 0] ) );
  189. ArrayXdBytes.CopyArrayPartToArrayPart( srcm, SELF, ArrayXdBytes.Index3( sposx, spoxy, sposz ),
  190. ArrayXdBytes.Index3( slenx, sleny, slenz ),
  191. ArrayXdBytes.Index3( dx, dy, dz ),
  192. ArrayXdBytes.Index3( dlenx, dleny, dlenz ) );
  193. END CopyFrom3dArray;
  194. PROCEDURE CopyFrom4dArray*( VAR src: ARRAY OF ARRAY OF ARRAY OF ARRAY OF Value;
  195. sposx, spoxy, sposz, spost, slenx, sleny, slenz, slent: Index;
  196. dx, dy, dz, dlenx, dleny, dlenz: Index );
  197. VAR srcm: ArrayXdBytes.ArrayMemoryStructure;
  198. BEGIN
  199. srcm :=
  200. ArrayXdBytes.MakeMemoryStructure( 4, ArrayXdBytes.Index4( 0, 0, 0, 0 ),
  201. ArrayXdBytes.Index4( LEN( src, 3 ), LEN( src, 2 ), LEN( src, 1 ), LEN( src, 0 ) ), SIZEOF( Value ),
  202. ADDRESSOF( src[0, 0, 0, 0] ) );
  203. ArrayXdBytes.CopyArrayPartToArrayPart( srcm, SELF, ArrayXdBytes.Index4( sposx, spoxy, sposz, spost ),
  204. ArrayXdBytes.Index4( slenx, sleny, slenz, slent ),
  205. ArrayXdBytes.Index3( dx, dy, dz ),
  206. ArrayXdBytes.Index3( dlenx, dleny, dlenz ) );
  207. END CopyFrom4dArray;
  208. END Cube;
  209. OPERATOR ":="*( VAR l: Cube; VAR r: ARRAY OF ARRAY OF ARRAY OF Value );
  210. BEGIN
  211. (* IF r = NIL THEN l := NIL; RETURN END; *)
  212. IF l = NIL THEN NEW( l, 0, LEN( r, 2 ), 0, LEN( r, 1 ), 0, LEN( r, 0 ) ); ELSE l.NewRange( 0, LEN( r, 2 ), 0, LEN( r, 1 ), 0, LEN( r, 0 ), FALSE ); END;
  213. ArrayXdBytes.CopyMemoryToArrayPart( ADDRESSOF( r[0, 0, 0] ), l, LEN( r, 0 ) * LEN( r, 1 ) * LEN( r, 2 ), NIL , NIL );
  214. END ":=";
  215. OPERATOR ":="*( VAR l: Cube; r: CubeInt.Cube );
  216. VAR i, last: LONGINT;
  217. BEGIN
  218. IF r = NIL THEN l := NIL ELSE
  219. IF l = NIL THEN NEW( l, r.origin[0], r.len[0], r.origin[1], r.len[1], r.origin[2], r.len[2] ); END;
  220. last := LEN( r.data ) - 1;
  221. FOR i := 0 TO last DO l.data[i] := r.data[i]; END;
  222. END;
  223. END ":=";
  224. OPERATOR ":="*( VAR l: Cube; r: CubeRat.Cube );
  225. VAR i, last: LONGINT;
  226. BEGIN
  227. IF r = NIL THEN l := NIL ELSE
  228. IF l = NIL THEN NEW( l, r.origin[0], r.len[0], r.origin[1], r.len[1], r.origin[2], r.len[2] ); END;
  229. last := LEN( r.data ) - 1;
  230. FOR i := 0 TO last DO l.data[i] := r.data[i]; END;
  231. END;
  232. END ":=";
  233. OPERATOR ":="*( VAR l: Cube; r: CubeRe.Cube );
  234. VAR i, last: LONGINT;
  235. BEGIN
  236. IF r = NIL THEN l := NIL ELSE
  237. IF l = NIL THEN NEW( l, r.origin[0], r.len[0], r.origin[1], r.len[1], r.origin[2], r.len[2] ); END;
  238. last := LEN( r.data ) - 1;
  239. FOR i := 0 TO last DO l.data[i] := r.data[i]; END;
  240. END;
  241. END ":=";
  242. OPERATOR ":="*( VAR l: Cube; r: Value );
  243. BEGIN
  244. IF l # NIL THEN ArrayXd.Fill( l, r ); END;
  245. END ":=";
  246. OPERATOR ":="*( VAR l: Cube; r: ReValue );
  247. VAR r1: Value;
  248. BEGIN
  249. r1 := r; l := r1;
  250. END ":=";
  251. OPERATOR ":="*( VAR l: Cube; r: RatValue );
  252. VAR r1: Value;
  253. BEGIN
  254. r1 := r; l := r1;
  255. END ":=";
  256. OPERATOR ":="*( VAR l: Cube; r: IntValue );
  257. VAR r1: Value;
  258. BEGIN
  259. r1 := r; l := r1;
  260. END ":=";
  261. OPERATOR "+"*( l, r: Cube ): Cube;
  262. VAR res: Cube;
  263. BEGIN
  264. res := l.Alike(); ArrayXd.Add( l, r, res ); RETURN res;
  265. END "+";
  266. OPERATOR "-"*( l, r: Cube ): Cube;
  267. VAR res: Cube;
  268. BEGIN
  269. res := l.Alike(); ArrayXd.Sub( l, r, res ); RETURN res;
  270. END "-";
  271. OPERATOR "+"*( l: Cube; r: Value ): Cube;
  272. VAR res: Cube;
  273. BEGIN
  274. res := l.Alike(); ArrayXd.AddAV( l, r, res ); RETURN res;
  275. END "+";
  276. OPERATOR "+"*( l: Cube; r: IntValue ): Cube;
  277. VAR res: Cube; r1: Value;
  278. BEGIN
  279. res := l.Alike(); r1 := r; ArrayXd.AddAV( l, r1, res ); RETURN res;
  280. END "+";
  281. OPERATOR "+"*( l: Cube; r: RatValue ): Cube;
  282. VAR res: Cube; r1: Value;
  283. BEGIN
  284. res := l.Alike(); r1 := r; ArrayXd.AddAV( l, r1, res ); RETURN res;
  285. END "+";
  286. OPERATOR "+"*( l: Cube; r: ReValue ): Cube;
  287. VAR res: Cube; r1: Value;
  288. BEGIN
  289. res := l.Alike(); r1 := r; ArrayXd.AddAV( l, r1, res ); RETURN res;
  290. END "+";
  291. OPERATOR "+"*( l: Value; r: Cube ): Cube;
  292. BEGIN
  293. RETURN r + l
  294. END "+";
  295. OPERATOR "+"*( l: ReValue; r: Cube ): Cube;
  296. BEGIN
  297. RETURN r + l
  298. END "+";
  299. OPERATOR "+"*( l: RatValue; r: Cube ): Cube;
  300. BEGIN
  301. RETURN r + l
  302. END "+";
  303. OPERATOR "+"*( l: IntValue; r: Cube ): Cube;
  304. BEGIN
  305. RETURN r + l
  306. END "+";
  307. OPERATOR "-"*( l: Cube; r: Value ): Cube;
  308. VAR res: Cube;
  309. BEGIN
  310. res := l.Alike(); ArrayXd.SubAV( l, r, res ); RETURN res;
  311. END "-";
  312. OPERATOR "-"*( l: Cube; r: ReValue ): Cube;
  313. VAR res: Cube; r1: Value;
  314. BEGIN
  315. res := l.Alike(); r1 := r; ArrayXd.SubAV( l, r1, res ); RETURN res;
  316. END "-";
  317. OPERATOR "-"*( l: Cube; r: RatValue ): Cube;
  318. VAR res: Cube; r1: Value;
  319. BEGIN
  320. res := l.Alike(); r1 := r; ArrayXd.SubAV( l, r1, res ); RETURN res;
  321. END "-";
  322. OPERATOR "-"*( l: Cube; r: IntValue ): Cube;
  323. VAR res: Cube; r1: Value;
  324. BEGIN
  325. res := l.Alike(); r1 := r; ArrayXd.SubAV( l, r1, res ); RETURN res;
  326. END "-";
  327. OPERATOR "-"*( l: Value; r: Cube ): Cube;
  328. VAR res: Cube;
  329. BEGIN
  330. res := r.Alike(); ArrayXd.SubVA( l, r, res ); RETURN res;
  331. END "-";
  332. OPERATOR "-"*( l: ReValue; r: Cube ): Cube;
  333. VAR res: Cube; l1: Value;
  334. BEGIN
  335. res := r.Alike(); l1 := l; ArrayXd.SubVA( l1, r, res ); RETURN res;
  336. END "-";
  337. OPERATOR "-"*( l: RatValue; r: Cube ): Cube;
  338. VAR res: Cube; l1: Value;
  339. BEGIN
  340. res := r.Alike(); l1 := l; ArrayXd.SubVA( l1, r, res ); RETURN res;
  341. END "-";
  342. OPERATOR "-"*( l: IntValue; r: Cube ): Cube;
  343. VAR res: Cube; l1: Value;
  344. BEGIN
  345. res := r.Alike(); l1 := l; ArrayXd.SubVA( l1, r, res ); RETURN res;
  346. END "-";
  347. OPERATOR "-"*( l: Cube ): Cube;
  348. BEGIN
  349. RETURN 0 - l;
  350. END "-";
  351. OPERATOR "*"*( l: Cube; r: Value ): Cube;
  352. VAR res: Cube;
  353. BEGIN
  354. res := l.Alike(); ArrayXd.MulAV( l, r, res ); RETURN res;
  355. END "*";
  356. OPERATOR "*"*( l: Cube; r: ReValue ): Cube;
  357. VAR res: Cube; r1: Value;
  358. BEGIN
  359. res := l.Alike(); r1 := r; ArrayXd.MulAV( l, r1, res ); RETURN res;
  360. END "*";
  361. OPERATOR "*"*( l: Cube; r: RatValue ): Cube;
  362. VAR res: Cube; r1: Value;
  363. BEGIN
  364. res := l.Alike(); r1 := r; ArrayXd.MulAV( l, r1, res ); RETURN res;
  365. END "*";
  366. OPERATOR "*"*( l: Cube; r: IntValue ): Cube;
  367. VAR res: Cube; r1: Value;
  368. BEGIN
  369. res := l.Alike(); r1 := r; ArrayXd.MulAV( l, r1, res ); RETURN res;
  370. END "*";
  371. OPERATOR "*"*( l: Value; r: Cube ): Cube;
  372. BEGIN
  373. RETURN r * l;
  374. END "*";
  375. OPERATOR "*"*( l: ReValue; r: Cube ): Cube;
  376. BEGIN
  377. RETURN r * l;
  378. END "*";
  379. OPERATOR "*"*( l: RatValue; r: Cube ): Cube;
  380. BEGIN
  381. RETURN r * l;
  382. END "*";
  383. OPERATOR "*"*( l: IntValue; r: Cube ): Cube;
  384. BEGIN
  385. RETURN r * l;
  386. END "*";
  387. OPERATOR "/"*( l: Cube; r: Value ): Cube;
  388. VAR res: Cube;
  389. BEGIN
  390. res := l.Alike(); ArrayXd.DivAV( l, r, res ); RETURN res;
  391. END "/";
  392. OPERATOR "/"*( l: Cube; r: ReValue ): Cube;
  393. VAR res: Cube; r1: Value;
  394. BEGIN
  395. res := l.Alike(); r1 := r; ArrayXd.DivAV( l, r1, res ); RETURN res;
  396. END "/";
  397. OPERATOR "/"*( l: Cube; r: RatValue ): Cube;
  398. VAR res: Cube; r1: Value;
  399. BEGIN
  400. res := l.Alike(); r1 := r; ArrayXd.DivAV( l, r1, res ); RETURN res;
  401. END "/";
  402. OPERATOR "/"*( l: Cube; r: IntValue ): Cube;
  403. VAR res: Cube; r1: Value;
  404. BEGIN
  405. res := l.Alike(); r1 := r; ArrayXd.DivAV( l, r1, res ); RETURN res;
  406. END "/";
  407. OPERATOR "/"*( l: Value; r: Cube ): Cube;
  408. VAR res: Cube;
  409. BEGIN
  410. res := r.Alike(); ArrayXd.DivVA( l, r, res ); RETURN res;
  411. END "/";
  412. OPERATOR "/"*( l: ReValue; r: Cube ): Cube;
  413. VAR res: Cube; l1: Value;
  414. BEGIN
  415. res := r.Alike(); l1 := l; ArrayXd.DivVA( l1, r, res ); RETURN res;
  416. END "/";
  417. OPERATOR "/"*( l: RatValue; r: Cube ): Cube;
  418. VAR res: Cube; l1: Value;
  419. BEGIN
  420. res := r.Alike(); l1 := l; ArrayXd.DivVA( l1, r, res ); RETURN res;
  421. END "/";
  422. OPERATOR "/"*( l: IntValue; r: Cube ): Cube;
  423. VAR res: Cube; l1: Value;
  424. BEGIN
  425. res := r.Alike(); l1 := l; ArrayXd.DivVA( l1, r, res ); RETURN res;
  426. END "/";
  427. (* The procedures needed to register type Cube so that its instances can be made persistent. *)
  428. PROCEDURE LoadCube( R: DataIO.Reader; VAR obj: OBJECT );
  429. VAR a: Cube; version: SHORTINT; ver: NbrInt.Integer;
  430. BEGIN
  431. R.RawSInt( version );
  432. IF version = -1 THEN
  433. obj := NIL (* Version tag is -1 for NIL. *)
  434. ELSIF version = VERSION THEN NEW( a, 0, 0, 0, 0, 0, 0 ); a.Read( R ); obj := a
  435. ELSE ver := version; DataErrors.IntError( ver, "Alien version number encountered." ); HALT( 1000 )
  436. END
  437. END LoadCube;
  438. PROCEDURE StoreCube( W: DataIO.Writer; obj: OBJECT );
  439. VAR a: Cube;
  440. BEGIN
  441. IF obj = NIL THEN W.RawSInt( -1 ) ELSE W.RawSInt( VERSION ); a := obj( Cube ); a.Write( W ) END
  442. END StoreCube;
  443. PROCEDURE Register;
  444. VAR a: Cube;
  445. BEGIN
  446. NEW( a, 0, 0, 0, 0, 0, 0 ); DataIO.PlugIn( a, LoadCube, StoreCube )
  447. END Register;
  448. (** Load and Store are procedures for external use that read/write an instance of Cube from/to a file. *)
  449. PROCEDURE Load*( R: DataIO.Reader; VAR obj: Cube );
  450. VAR ptr: OBJECT;
  451. BEGIN
  452. R.Object( ptr ); obj := ptr( Cube )
  453. END Load;
  454. PROCEDURE Store*( W: DataIO.Writer; obj: Cube );
  455. BEGIN
  456. W.Object( obj )
  457. END Store;
  458. BEGIN
  459. Register
  460. END CubeCplx.