HCubeCplx.Mod 19 KB

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