home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l196 / 3.ddi / MATBA.BA$ / MATBA.bin
Encoding:
Text File  |  1990-06-24  |  21.6 KB  |  665 lines
  1. '*** MATBA.BAS - Matrix Math Routines for the Alt-Math Matrix Math Toolbox in
  2. '           Microsoft BASIC 7.1, Professional Development System
  3. '              Copyright (C) 1987-1990, Microsoft Corporation
  4. '
  5. '  NOTE:  This sample source code toolbox is intended to demonstrate some
  6. '  of the extended capabilities of Microsoft BASIC 7.1 Professional Development
  7. '  system that can help to leverage the professional developer's time more
  8. '  effectively.  While you are free to use, modify, or distribute the routines
  9. '  in this module in any way you find useful, it should be noted that these are
  10. '  examples only and should not be relied upon as a fully-tested "add-on"
  11. '  library.
  12. '
  13. '  Purpose:  These are the same matrix math routines found in MATB.BAS
  14. '  with the exclusion of currency datatype routines, to allow the routines
  15. '  to be compiled with the BC /FPa alternate math pack option.
  16. '
  17. '**************************************************************************
  18. '
  19. '$INCLUDE: 'matba.bi'
  20. DECLARE FUNCTION matbsD% (A() AS DOUBLE, b() AS DOUBLE, x() AS DOUBLE)
  21. DECLARE FUNCTION matbsS% (A() AS SINGLE, b() AS SINGLE, x() AS SINGLE)
  22. DECLARE FUNCTION matluD% (A() AS DOUBLE)
  23. DECLARE FUNCTION matluS% (A() AS SINGLE)
  24. DIM SHARED lo AS INTEGER, up AS INTEGER
  25. DIM SHARED continue AS INTEGER, count AS INTEGER
  26. DIM SHARED rpvt(lo TO up) AS INTEGER, cpvt(lo TO up) AS INTEGER
  27. END
  28.  
  29. FUNCTION MatAddD% (Alpha() AS DOUBLE, Beta() AS DOUBLE)
  30. ON LOCAL ERROR GOTO dadderr: MatAddD% = 0
  31. IF (LBOUND(Alpha, 1) <> LBOUND(Beta, 1)) OR (UBOUND(Alpha, 1) <> UBOUND(Beta, 1)) OR (LBOUND(Alpha, 2) <> LBOUND(Beta, 2)) OR (UBOUND(Alpha, 2) <> UBOUND(Beta, 2)) THEN ERROR 196
  32. FOR row% = LBOUND(Alpha, 1) TO UBOUND(Alpha, 1)
  33.         FOR col% = LBOUND(Alpha, 2) TO UBOUND(Alpha, 2)
  34.                 Alpha(row%, col%) = Alpha(row%, col%) + Beta(row%, col%)
  35.         NEXT col%
  36. NEXT row%
  37. daddexit:
  38. EXIT FUNCTION
  39. dadderr:
  40.         MatAddD% = (ERR + 5) MOD 200 - 5
  41.         RESUME daddexit
  42. END FUNCTION
  43.  
  44. FUNCTION MatAddI% (Alpha() AS INTEGER, Beta() AS INTEGER)
  45. ON LOCAL ERROR GOTO iadderr: MatAddI% = 0
  46. IF (LBOUND(Alpha, 1) <> LBOUND(Beta, 1)) OR (UBOUND(Alpha, 1) <> UBOUND(Beta, 1)) OR (LBOUND(Alpha, 2) <> LBOUND(Beta, 2)) OR (UBOUND(Alpha, 2) <> UBOUND(Beta, 2)) THEN ERROR 196
  47. FOR row% = LBOUND(Alpha, 1) TO UBOUND(Alpha, 1)
  48.         FOR col% = LBOUND(Alpha, 2) TO UBOUND(Alpha, 2)
  49.                 Alpha(row%, col%) = Alpha(row%, col%) + Beta(row%, col%)
  50.         NEXT col%
  51. NEXT row%
  52. iaddexit:
  53. EXIT FUNCTION
  54. iadderr:
  55.         MatAddI% = (ERR + 5) MOD 200 - 5
  56.         RESUME iaddexit
  57. END FUNCTION
  58.  
  59. FUNCTION MatAddL% (Alpha() AS LONG, Beta() AS LONG)
  60. ON LOCAL ERROR GOTO ladderr: MatAddL% = 0
  61. IF (LBOUND(Alpha, 1) <> LBOUND(Beta, 1)) OR (UBOUND(Alpha, 1) <> UBOUND(Beta, 1)) OR (LBOUND(Alpha, 2) <> LBOUND(Beta, 2)) OR (UBOUND(Alpha, 2) <> UBOUND(Beta, 2)) THEN ERROR 196
  62. FOR row% = LBOUND(Alpha, 1) TO UBOUND(Alpha, 1)
  63.         FOR col% = LBOUND(Alpha, 2) TO UBOUND(Alpha, 2)
  64.                 Alpha(row%, col%) = Alpha(row%, col%) + Beta(row%, col%)
  65.         NEXT col%
  66. NEXT row%
  67. laddexit:
  68. EXIT FUNCTION
  69. ladderr:
  70.         MatAddL% = (ERR + 5) MOD 200 - 5
  71.         RESUME laddexit
  72. END FUNCTION
  73.  
  74. FUNCTION MatAddS% (Alpha() AS SINGLE, Beta() AS SINGLE)
  75. ON LOCAL ERROR GOTO sadderr: MatAddS% = 0
  76. IF (LBOUND(Alpha, 1) <> LBOUND(Beta, 1)) OR (UBOUND(Alpha, 1) <> UBOUND(Beta, 1)) OR (LBOUND(Alpha, 2) <> LBOUND(Beta, 2)) OR (UBOUND(Alpha, 2) <> UBOUND(Beta, 2)) THEN ERROR 196
  77. FOR row% = LBOUND(Alpha, 1) TO UBOUND(Alpha, 1)
  78.         FOR col% = LBOUND(Alpha, 2) TO UBOUND(Alpha, 2)
  79.                 Alpha(row%, col%) = Alpha(row%, col%) + Beta(row%, col%)
  80.         NEXT col%
  81. NEXT row%
  82. saddexit:
  83. EXIT FUNCTION
  84. sadderr:
  85.         MatAddS% = (ERR + 5) MOD 200 - 5
  86.         RESUME saddexit
  87. END FUNCTION
  88.  
  89. FUNCTION matbsD% (A() AS DOUBLE, b() AS DOUBLE, x() AS DOUBLE)
  90. ON LOCAL ERROR GOTO dbserr: matbsD% = 0
  91. FOR pvt% = lo TO (up - 1)
  92.         c% = cpvt(pvt%)
  93.         FOR row% = (pvt% + 1) TO up
  94.                 r% = rpvt(row%)
  95.                 b(r%) = b(r%) + A(r%, c%) * b(rpvt(pvt%))
  96.         NEXT row%
  97. NEXT pvt%
  98. FOR row% = up TO lo STEP -1
  99.         c% = cpvt(row%)
  100.         r% = rpvt(row%)
  101.         x(c%) = b(r%)
  102.         FOR col% = (row% + 1) TO up
  103.                 x(c%) = x(c%) - A(r%, cpvt(col%)) * x(cpvt(col%))
  104.         NEXT col%
  105.         x(c%) = x(c%) / A(r%, c%)
  106. NEXT row%
  107. dbsexit:
  108. EXIT FUNCTION
  109. dbserr:
  110.         matbsD% = ERR
  111.         RESUME dbsexit
  112. END FUNCTION
  113.  
  114. FUNCTION matbsS% (A() AS SINGLE, b() AS SINGLE, x() AS SINGLE)
  115. ON LOCAL ERROR GOTO sbserr: matbsS% = 0
  116. FOR pvt% = lo TO (up - 1)
  117.         c% = cpvt(pvt%)
  118.         FOR row% = (pvt% + 1) TO up
  119.                 r% = rpvt(row%)
  120.                 b(r%) = b(r%) + A(r%, c%) * b(rpvt(pvt%))
  121.         NEXT row%
  122. NEXT pvt%
  123. FOR row% = up TO lo STEP -1
  124.         c% = cpvt(row%)
  125.         r% = rpvt(row%)
  126.         x(c%) = b(r%)
  127.         FOR col% = (row% + 1) TO up
  128.                 x(c%) = x(c%) - A(r%, cpvt(col%)) * x(cpvt(col%))
  129.         NEXT col%
  130.         x(c%) = x(c%) / A(r%, c%)
  131. NEXT row%
  132. sbsexit:
  133. EXIT FUNCTION
  134. sbserr:
  135.         matbsS% = ERR
  136.         RESUME sbsexit
  137. END FUNCTION
  138.  
  139. FUNCTION MatDetD% (A() AS DOUBLE, det#)
  140. ON LOCAL ERROR GOTO ddeterr: errcode% = 0
  141. lo = LBOUND(A, 1)
  142. up = UBOUND(A, 1)
  143. REDIM rpvt(lo TO up) AS INTEGER, cpvt(lo TO up) AS INTEGER
  144. errcode% = matluD%(A())
  145. IF NOT continue THEN
  146.    IF errcode% = 199 THEN det# = 0#
  147.    ERROR errcode%
  148. ELSE
  149.    det# = 1#
  150.    FOR pvt% = lo TO up
  151.         det# = det# * A(rpvt(pvt%), cpvt(pvt%))
  152.    NEXT pvt%
  153.    det# = (-1) ^ count * det#
  154.    IF errcode% THEN ERROR errcode%
  155. END IF
  156. ddetexit:             
  157. ERASE rpvt, cpvt
  158. MatDetD% = errcode%
  159. EXIT FUNCTION
  160. ddeterr:
  161.         errcode% = (ERR + 5) MOD 200 - 5
  162.         RESUME ddetexit
  163. END FUNCTION
  164.  
  165. FUNCTION MatDetI% (A() AS INTEGER, det%)
  166. ON LOCAL ERROR GOTO ideterr: errcode% = 0
  167. lo = LBOUND(A, 1)
  168. up = UBOUND(A, 1)
  169. REDIM rpvt(lo TO up) AS INTEGER, cpvt(lo TO up) AS INTEGER
  170. DIM Tmp(lo TO up, LBOUND(A, 2) TO UBOUND(A, 2)) AS SINGLE
  171. FOR row% = lo TO up
  172.         FOR col% = LBOUND(A, 2) TO UBOUND(A, 2)
  173.                 Tmp(row%, col%) = CSNG(A(row%, col%))
  174.         NEXT col%
  175. NEXT row%
  176. errcode% = matluS%(Tmp())
  177. IF NOT continue THEN
  178.    IF errcode% = 199 THEN det% = 0
  179.    ERROR errcode%
  180. ELSE
  181.    detS! = 1!
  182.    FOR pvt% = lo TO up
  183.         detS! = detS! * Tmp(rpvt(pvt%), cpvt(pvt%))
  184.    NEXT pvt%
  185.    det% = (-1) ^ count * CINT(detS!)
  186.    IF errcode% THEN ERROR errcode%
  187. END IF
  188. idetexit:
  189. ERASE rpvt, cpvt, Tmp
  190. MatDetI% = errcode%
  191. EXIT FUNCTION
  192. ideterr:
  193.         errcode% = (ERR + 5) MOD 200 - 5
  194.         RESUME idetexit
  195. END FUNCTION
  196.  
  197. FUNCTION MatDetL% (A() AS LONG, det&)
  198. ON LOCAL ERROR GOTO ldeterr: errcode% = 0
  199. lo = LBOUND(A, 1)
  200. up = UBOUND(A, 1)
  201. REDIM rpvt(lo TO up) AS INTEGER, cpvt(lo TO up) AS INTEGER
  202. DIM Tmp(lo TO up, LBOUND(A, 2) TO UBOUND(A, 2)) AS DOUBLE
  203. FOR row% = lo TO up
  204.         FOR col% = LBOUND(A, 2) TO UBOUND(A, 2)
  205.                 Tmp(row%, col%) = CDBL(A(row%, col%))
  206.         NEXT col%
  207. NEXT row%
  208. errcode% = matluD%(Tmp())
  209. IF NOT continue THEN
  210.    IF errcode% = 199 THEN det& = 0&
  211.    ERROR errcode%
  212. ELSE
  213.    detD# = 1#
  214.    FOR pvt% = lo TO up
  215.         detD# = detD# * Tmp(rpvt(pvt%), cpvt(pvt%))
  216.    NEXT pvt%
  217.    det& = (-1&) ^ count * CLNG(detD#)
  218.    IF errcode% THEN ERROR errcode%
  219. END IF
  220. ldetexit:
  221. ERASE rpvt, cpvt, Tmp
  222. MatDetL% = errcode%
  223. EXIT FUNCTION
  224. ldeterr:
  225.         errcode% = (ERR + 5) MOD 200 - 5
  226.         RESUME ldetexit
  227. END FUNCTION
  228.  
  229. FUNCTION MatDetS% (A() AS SINGLE, det!)
  230. ON LOCAL ERROR GOTO sdeterr: errcode% = 0
  231. lo = LBOUND(A, 1)
  232. up = UBOUND(A, 1)
  233. REDIM rpvt(lo TO up) AS INTEGER, cpvt(lo TO up) AS INTEGER
  234. errcode% = matluS%(A())
  235. IF NOT continue THEN
  236.    IF errcode% = 199 THEN det! = 0!
  237.    ERROR errcode%
  238. ELSE
  239.    det! = 1!
  240.    FOR pvt% = lo TO up
  241.         det! = det! * A(rpvt(pvt%), cpvt(pvt%))
  242.    NEXT pvt%
  243.    det! = (-1) ^ count * det!
  244.    IF errcode% THEN ERROR errcode%
  245. END IF
  246. sdetexit:
  247. ERASE rpvt, cpvt
  248. MatDetS% = errcode%
  249. EXIT FUNCTION
  250. sdeterr:
  251.         errcode% = (ERR + 5) MOD 200 - 5
  252.         RESUME sdetexit
  253. END FUNCTION
  254.  
  255. FUNCTION MatInvD% (A() AS DOUBLE)
  256. ON LOCAL ERROR GOTO dinverr: errcode% = 0
  257. lo = LBOUND(A, 1)
  258. up = UBOUND(A, 1)
  259. DIM Ain(lo TO up, lo TO up) AS DOUBLE
  260. DIM e(lo TO up) AS DOUBLE, x(lo TO up) AS DOUBLE
  261. REDIM rpvt(lo TO up) AS INTEGER, cpvt(lo TO up) AS INTEGER
  262. errcode% = matluD%(A())
  263. IF NOT continue THEN ERROR errcode%
  264. FOR col% = lo TO up
  265.         e(col%) = 1#
  266.         bserrcode% = matbsD%(A(), e(), x())
  267.         IF bserrcode% THEN ERROR bserrcode%
  268.         FOR row% = lo TO up
  269.                 Ain(row%, col%) = x(row%)
  270.                 e(row%) = 0#
  271.         NEXT row%
  272. NEXT col%
  273. FOR col% = lo TO up
  274.         FOR row% = lo TO up
  275.                 A(row%, col%) = Ain(row%, col%)
  276.         NEXT row%
  277. NEXT col%
  278. IF errcode% THEN ERROR errcode%
  279. dinvexit:
  280. ERASE e, x, Ain, rpvt, cpvt
  281. MatInvD% = errcode%
  282. EXIT FUNCTION
  283. dinverr:
  284.         errcode% = (ERR + 5) MOD 200 - 5
  285.         RESUME dinvexit
  286. END FUNCTION
  287.  
  288. FUNCTION MatInvS% (A() AS SINGLE)
  289. ON LOCAL ERROR GOTO sinverr: errcode% = 0
  290. lo = LBOUND(A, 1)
  291. up = UBOUND(A, 1)
  292. DIM Ain(lo TO up, lo TO up) AS SINGLE
  293. DIM e(lo TO up) AS SINGLE, x(lo TO up) AS SINGLE
  294. REDIM rpvt(lo TO up) AS INTEGER, cpvt(lo TO up) AS INTEGER
  295. errcode% = matluS%(A())
  296. IF NOT continue THEN ERROR errcode%
  297. FOR col% = lo TO up
  298.         e(col%) = 1!
  299.         bserrcode% = matbsS%(A(), e(), x())
  300.         IF bserrcode% THEN ERROR bserrcode%
  301.         FOR row% = lo TO up
  302.                 Ain(row%, col%) = x(row%)
  303.                 e(row%) = 0!
  304.         NEXT row%
  305. NEXT col%
  306. FOR col% = lo TO up
  307.         FOR row% = lo TO up
  308.                 A(row%, col%) = Ain(row%, col%)
  309.         NEXT row%
  310. NEXT col%
  311. IF errcode% THEN ERROR errcode%
  312. sinvexit:
  313. ERASE e, x, Ain, rpvt, cpvt
  314. MatInvS% = errcode%
  315. EXIT FUNCTION
  316. sinverr:
  317.         errcode% = (ERR + 5) MOD 200 - 5
  318.         RESUME sinvexit
  319. END FUNCTION
  320.  
  321. FUNCTION matluD% (A() AS DOUBLE)
  322. ON LOCAL ERROR GOTO dluerr: errcode% = 0
  323. IF NOT (lo = LBOUND(A, 2) AND up = UBOUND(A, 2)) THEN ERROR 198
  324. DIM rownorm(lo TO up) AS DOUBLE
  325. count = 0
  326. continue = -1
  327. FOR row% = lo TO up
  328.         rpvt(row%) = row%
  329.         cpvt(row%) = row%
  330.         rownorm(row%) = 0#
  331.         FOR col% = lo TO up
  332.                 rownorm(row%) = rownorm(row%) + ABS(A(row%, col%))
  333.         NEXT col%
  334.         IF rownorm(row%) = 0# THEN
  335.                 continue = 0
  336.                 ERROR 199
  337.         END IF
  338. NEXT row%
  339. FOR pvt% = lo TO (up - 1)
  340.         max# = 0#
  341.         FOR row% = pvt% TO up
  342.                 r% = rpvt(row%)
  343.                 FOR col% = pvt% TO up
  344.                         c% = cpvt(col%)
  345.                         temp# = ABS(A(r%, c%)) / rownorm(r%)
  346.                         IF temp# > max# THEN
  347.                                 max# = temp#
  348.                                 bestrow% = row%
  349.                                 bestcol% = col%
  350.                         END IF
  351.                 NEXT col%
  352.         NEXT row%
  353.         IF max# = 0# THEN
  354.                 continue = 0
  355.                 ERROR 199
  356.         ELSEIF pvt% > 1 THEN
  357.                 IF max# < (deps# * oldmax#) THEN errcode% = 199
  358.         END IF
  359.         oldmax# = max#
  360.         IF rpvt(pvt%) <> rpvt(bestrow%) THEN
  361.                 count = count + 1
  362.                 SWAP rpvt(pvt%), rpvt(bestrow%)
  363.         END IF
  364.         IF cpvt(pvt%) <> cpvt(bestcol%) THEN
  365.                 count = count + 1
  366.                 SWAP cpvt(pvt%), cpvt(bestcol%)
  367.         END IF
  368.         rp% = rpvt(pvt%)
  369.         cp% = cpvt(pvt%)
  370.         FOR row% = (pvt% + 1) TO up
  371.                 r% = rpvt(row%)
  372.                 A(r%, cp%) = -A(r%, cp%) / A(rp%, cp%)
  373.                 FOR col% = (pvt% + 1) TO up
  374.                         c% = cpvt(col%)
  375.                         A(r%, c%) = A(r%, c%) + A(r%, cp%) * A(rp%, c%)
  376.                 NEXT col%
  377.         NEXT row%
  378. NEXT pvt%
  379. IF A(rpvt(up), cpvt(up)) = 0# THEN
  380.         continue = 0
  381.         ERROR 199
  382. ELSEIF (ABS(A(rpvt(up), cpvt(up))) / rownorm(rpvt(up))) < (deps# * oldmax#) THEN
  383.         errcode% = 199
  384. END IF
  385. IF errcode% THEN ERROR errcode%
  386. dluexit:
  387. matluD% = errcode%
  388. EXIT FUNCTION
  389. dluerr:
  390.         IF errcode% < 199 THEN continue = 0
  391.         errcode% = ERR
  392.         RESUME dluexit
  393. END FUNCTION
  394.  
  395. FUNCTION matluS% (A() AS SINGLE)
  396. ON LOCAL ERROR GOTO sluerr: errcode% = 0
  397. IF NOT (lo = LBOUND(A, 2) AND up = UBOUND(A, 2)) THEN ERROR 198
  398. DIM rownorm(lo TO up) AS SINGLE
  399. count = 0
  400. continue = -1
  401. FOR row% = lo TO up
  402.         rpvt(row%) = row%
  403.         cpvt(row%) = row%
  404.         rownorm(row%) = 0!
  405.         FOR col% = lo TO up
  406.                 rownorm(row%) = rownorm(row%) + ABS(A(row%, col%))
  407.         NEXT col%
  408.         IF rownorm(row%) = 0! THEN
  409.                 continue = 0
  410.                 ERROR 199
  411.         END IF
  412. NEXT row%
  413. FOR pvt% = lo TO (up - 1)
  414.         max! = 0!
  415.         FOR row% = pvt% TO up
  416.                 r% = rpvt(row%)
  417.                 FOR col% = pvt% TO up
  418.                         c% = cpvt(col%)
  419.                         temp! = ABS(A(r%, c%)) / rownorm(r%)
  420.                         IF temp! > max! THEN
  421.                                 max! = temp!
  422.                                 bestrow% = row%
  423.                                 bestcol% = col%
  424.                         END IF
  425.                 NEXT col%
  426.         NEXT row%
  427.         IF max! = 0! THEN
  428.                 continue = 0
  429.                 ERROR 199
  430.         ELSEIF pvt% > 1 THEN
  431.                 IF max! < (seps! * oldmax!) THEN errcode% = 199
  432.         END IF
  433.         oldmax! = max!
  434.         IF rpvt(pvt%) <> rpvt(bestrow%) THEN
  435.                 count = count + 1
  436.                 SWAP rpvt(pvt%), rpvt(bestrow%)
  437.         END IF
  438.         IF cpvt(pvt%) <> cpvt(bestcol%) THEN
  439.                 count = count + 1
  440.                 SWAP cpvt(pvt%), cpvt(bestcol%)
  441.         END IF
  442.         rp% = rpvt(pvt%)
  443.         cp% = cpvt(pvt%)
  444.         FOR row% = (pvt% + 1) TO up
  445.                 r% = rpvt(row%)
  446.                 A(r%, cp%) = -A(r%, cp%) / A(rp%, cp%)
  447.                 FOR col% = (pvt% + 1) TO up
  448.                         c% = cpvt(col%)
  449.                         A(r%, c%) = A(r%, c%) + A(r%, cp%) * A(rp%, c%)
  450.                 NEXT col%
  451.         NEXT row%
  452. NEXT pvt%
  453. IF A(rpvt(up), cpvt(up)) = 0! THEN
  454.         continue = 0
  455.         ERROR 199
  456. ELSEIF (ABS(A(rpvt(up), cpvt(up))) / rownorm(rpvt(up))) < (seps! * oldmax!) THEN
  457.         errcode% = 199
  458. END IF
  459. IF errcode% THEN ERROR errcode%
  460. sluexit:
  461. matluS% = errcode%
  462. EXIT FUNCTION
  463. sluerr:
  464.         errcode% = ERR
  465.         IF errcode% < 199 THEN continue = 0
  466.         RESUME sluexit
  467. END FUNCTION
  468.  
  469. FUNCTION MatMultD% (Alpha() AS DOUBLE, Beta() AS DOUBLE, Gamma() AS DOUBLE)
  470. ON LOCAL ERROR GOTO dmulterr: MatMultD% = 0
  471. IF (LBOUND(Alpha, 2) <> LBOUND(Beta, 1)) OR (UBOUND(Alpha, 2) <> UBOUND(Beta, 1)) THEN
  472.         ERROR 197
  473. ELSEIF (LBOUND(Alpha, 1) <> LBOUND(Gamma, 1)) OR (UBOUND(Alpha, 1) <> UBOUND(Gamma, 1)) OR (LBOUND(Beta, 2) <> LBOUND(Gamma, 2)) OR (UBOUND(Beta, 2) <> UBOUND(Gamma, 2)) THEN
  474.         ERROR 195
  475. END IF
  476. FOR row% = LBOUND(Gamma, 1) TO UBOUND(Gamma, 1)
  477.     FOR col% = LBOUND(Gamma, 2) TO UBOUND(Gamma, 2)
  478.         Gamma(row%, col%) = 0#
  479.         FOR inside% = LBOUND(Alpha, 2) TO UBOUND(Alpha, 2)
  480.            Gamma(row%, col%) = Gamma(row%, col%) + Alpha(row%, inside%) * Beta(inside%, col%)
  481.         NEXT inside%
  482.     NEXT col%
  483. NEXT row%
  484. dmultexit:
  485. EXIT FUNCTION
  486. dmulterr:
  487.         MatMultD% = (ERR + 5) MOD 200 - 5
  488.         RESUME dmultexit
  489. END FUNCTION
  490.  
  491. FUNCTION MatMultI% (Alpha() AS INTEGER, Beta() AS INTEGER, Gamma() AS INTEGER)
  492. ON LOCAL ERROR GOTO imulterr: MatMultI% = 0
  493. IF (LBOUND(Alpha, 2) <> LBOUND(Beta, 1)) OR (UBOUND(Alpha, 2) <> UBOUND(Beta, 1)) THEN
  494.         ERROR 197
  495. ELSEIF (LBOUND(Alpha, 1) <> LBOUND(Gamma, 1)) OR (UBOUND(Alpha, 1) <> UBOUND(Gamma, 1)) OR (LBOUND(Beta, 2) <> LBOUND(Gamma, 2)) OR (UBOUND(Beta, 2) <> UBOUND(Gamma, 2)) THEN
  496.         ERROR 195
  497. END IF
  498. FOR row% = LBOUND(Gamma, 1) TO UBOUND(Gamma, 1)
  499.     FOR col% = LBOUND(Gamma, 2) TO UBOUND(Gamma, 2)
  500.         Gamma(row%, col%) = 0
  501.         FOR inside% = LBOUND(Alpha, 2) TO UBOUND(Alpha, 2)
  502.            Gamma(row%, col%) = Gamma(row%, col%) + Alpha(row%, inside%) * Beta(inside%, col%)
  503.         NEXT inside%
  504.     NEXT col%
  505. NEXT row%
  506. imultexit:
  507. EXIT FUNCTION
  508. imulterr:
  509.         MatMultI% = (ERR + 5) MOD 200 - 5
  510.         RESUME imultexit
  511. END FUNCTION
  512.  
  513. FUNCTION MatMultL% (Alpha() AS LONG, Beta() AS LONG, Gamma() AS LONG)
  514. ON LOCAL ERROR GOTO lmulterr: MatMultL% = 0
  515. IF (LBOUND(Alpha, 2) <> LBOUND(Beta, 1)) OR (UBOUND(Alpha, 2) <> UBOUND(Beta, 1)) THEN
  516.         ERROR 197
  517. ELSEIF (LBOUND(Alpha, 1) <> LBOUND(Gamma, 1)) OR (UBOUND(Alpha, 1) <> UBOUND(Gamma, 1)) OR (LBOUND(Beta, 2) <> LBOUND(Gamma, 2)) OR (UBOUND(Beta, 2) <> UBOUND(Gamma, 2)) THEN
  518.         ERROR 195
  519. END IF
  520. FOR row% = LBOUND(Gamma, 1) TO UBOUND(Gamma, 1)
  521.     FOR col% = LBOUND(Gamma, 2) TO UBOUND(Gamma, 2)
  522.         Gamma(row%, col%) = 0&
  523.         FOR inside% = LBOUND(Alpha, 2) TO UBOUND(Alpha, 2)
  524.            Gamma(row%, col%) = Gamma(row%, col%) + Alpha(row%, inside%) * Beta(inside%, col%)
  525.         NEXT inside%
  526.     NEXT col%
  527. NEXT row%
  528. lmultexit:
  529. EXIT FUNCTION
  530. lmulterr:
  531.         MatMultL% = (ERR + 5) MOD 200 - 5
  532.         RESUME lmultexit
  533. END FUNCTION
  534.  
  535. FUNCTION MatMultS% (Alpha() AS SINGLE, Beta() AS SINGLE, Gamma() AS SINGLE)
  536. ON LOCAL ERROR GOTO smulterr: MatMultS% = 0
  537. IF (LBOUND(Alpha, 2) <> LBOUND(Beta, 1)) OR (UBOUND(Alpha, 2) <> UBOUND(Beta, 1)) THEN
  538.         ERROR 197
  539. ELSEIF (LBOUND(Alpha, 1) <> LBOUND(Gamma, 1)) OR (UBOUND(Alpha, 1) <> UBOUND(Gamma, 1)) OR (LBOUND(Beta, 2) <> LBOUND(Gamma, 2)) OR (UBOUND(Beta, 2) <> UBOUND(Gamma, 2)) THEN
  540.         ERROR 195
  541. END IF
  542. FOR row% = LBOUND(Gamma, 1) TO UBOUND(Gamma, 1)
  543.     FOR col% = LBOUND(Gamma, 2) TO UBOUND(Gamma, 2)
  544.         Gamma(row%, col%) = 0!
  545.         FOR inside% = LBOUND(Alpha, 2) TO UBOUND(Alpha, 2)
  546.            Gamma(row%, col%) = Gamma(row%, col%) + Alpha(row%, inside%) * Beta(inside%, col%)
  547.         NEXT inside%
  548.     NEXT col%
  549. NEXT row%
  550. smultexit:
  551. EXIT FUNCTION
  552. smulterr:
  553.         MatMultS% = (ERR + 5) MOD 200 - 5
  554.         RESUME smultexit
  555. END FUNCTION
  556.  
  557. FUNCTION MatSEqnD% (A() AS DOUBLE, b() AS DOUBLE)
  558. ON LOCAL ERROR GOTO dseqnerr: errcode% = 0
  559. lo = LBOUND(A, 1)
  560. up = UBOUND(A, 1)
  561. DIM x(lo TO up) AS DOUBLE
  562. REDIM rpvt(lo TO up) AS INTEGER, cpvt(lo TO up) AS INTEGER
  563. errcode% = matluD%(A())
  564. IF NOT continue THEN ERROR errcode%
  565. IF (lo <> LBOUND(b)) OR (up <> UBOUND(b)) THEN ERROR 197
  566. bserrcode% = matbsD%(A(), b(), x())
  567. IF bserrcode% THEN ERROR bserrcode%
  568. FOR row% = lo TO up
  569.         b(row%) = x(row%)
  570. NEXT row%
  571. IF errcode% THEN ERROR errcode%
  572. dseqnexit:
  573. ERASE x, rpvt, cpvt
  574. MatSEqnD% = errcode%
  575. EXIT FUNCTION
  576. dseqnerr:
  577.         errcode% = (ERR + 5) MOD 200 - 5
  578.         RESUME dseqnexit
  579. END FUNCTION
  580.  
  581. FUNCTION MatSEqnS% (A() AS SINGLE, b() AS SINGLE)
  582. ON LOCAL ERROR GOTO sseqnerr: errcode% = 0
  583. lo = LBOUND(A, 1)
  584. up = UBOUND(A, 1)
  585. DIM x(lo TO up) AS SINGLE
  586. REDIM rpvt(lo TO up) AS INTEGER, cpvt(lo TO up) AS INTEGER
  587. errcode% = matluS%(A())
  588. IF NOT continue THEN ERROR errcode%
  589. IF (lo <> LBOUND(b)) OR (up <> UBOUND(b)) THEN ERROR 197
  590. bserrcode% = matbsS%(A(), b(), x())
  591. IF bserrcode% THEN ERROR bserrcode%
  592. FOR row% = lo TO up
  593.         b(row%) = x(row%)
  594. NEXT row%
  595. IF errcode% THEN ERROR errcode%
  596. sseqnexit:
  597. ERASE x, rpvt, cpvt
  598. MatSEqnS% = errcode%
  599. EXIT FUNCTION
  600. sseqnerr:
  601.         errcode% = (ERR + 5) MOD 200 - 5
  602.         RESUME sseqnexit
  603. END FUNCTION
  604.  
  605. FUNCTION MatSubD% (Alpha() AS DOUBLE, Beta() AS DOUBLE)
  606. ON LOCAL ERROR GOTO dsuberr: MatSubD% = 0
  607. IF (LBOUND(Alpha, 1) <> LBOUND(Beta, 1)) OR (UBOUND(Alpha, 1) <> UBOUND(Beta, 1)) OR (LBOUND(Alpha, 2) <> LBOUND(Beta, 2)) OR (UBOUND(Alpha, 2) <> UBOUND(Beta, 2)) THEN ERROR 196
  608. FOR row% = LBOUND(Alpha, 1) TO UBOUND(Alpha, 1)
  609.         FOR col% = LBOUND(Alpha, 2) TO UBOUND(Alpha, 2)
  610.                 Alpha(row%, col%) = Alpha(row%, col%) - Beta(row%, col%)
  611.         NEXT col%
  612. NEXT row%
  613. dsubexit:
  614. EXIT FUNCTION
  615. dsuberr:
  616.         MatSubD% = (ERR + 5) MOD 200 - 5
  617.         RESUME dsubexit:
  618. END FUNCTION
  619.  
  620. FUNCTION MatSubI% (Alpha() AS INTEGER, Beta() AS INTEGER)
  621. ON LOCAL ERROR GOTO isuberr: MatSubI% = 0
  622. IF (LBOUND(Alpha, 1) <> LBOUND(Beta, 1)) OR (UBOUND(Alpha, 1) <> UBOUND(Beta, 1)) OR (LBOUND(Alpha, 2) <> LBOUND(Beta, 2)) OR (UBOUND(Alpha, 2) <> UBOUND(Beta, 2)) THEN ERROR 196
  623. FOR row% = LBOUND(Alpha, 1) TO UBOUND(Alpha, 1)
  624.         FOR col% = LBOUND(Alpha, 2) TO UBOUND(Alpha, 2)
  625.                 Alpha(row%, col%) = Alpha(row%, col%) - Beta(row%, col%)
  626.         NEXT col%
  627. NEXT row%
  628. isubexit:
  629. EXIT FUNCTION
  630. isuberr:
  631.         MatSubI% = (ERR + 5) MOD 200 - 5
  632.         RESUME isubexit:
  633. END FUNCTION
  634.  
  635. FUNCTION MatSubL% (Alpha() AS LONG, Beta() AS LONG)
  636. ON LOCAL ERROR GOTO lsuberr: MatSubL% = 0
  637. IF (LBOUND(Alpha, 1) <> LBOUND(Beta, 1)) OR (UBOUND(Alpha, 1) <> UBOUND(Beta, 1)) OR (LBOUND(Alpha, 2) <> LBOUND(Beta, 2)) OR (UBOUND(Alpha, 2) <> UBOUND(Beta, 2)) THEN ERROR 196
  638. FOR row% = LBOUND(Alpha, 1) TO UBOUND(Alpha, 1)
  639.         FOR col% = LBOUND(Alpha, 2) TO UBOUND(Alpha, 2)
  640.                 Alpha(row%, col%) = Alpha(row%, col%) - Beta(row%, col%)
  641.         NEXT col%
  642. NEXT row%
  643. lsubexit:
  644. EXIT FUNCTION
  645. lsuberr:
  646.         MatSubL% = (ERR + 5) MOD 200 - 5
  647.         RESUME lsubexit:
  648. END FUNCTION
  649.  
  650. FUNCTION MatSubS% (Alpha() AS SINGLE, Beta() AS SINGLE)
  651. ON LOCAL ERROR GOTO ssuberr: MatSubS% = 0
  652. IF (LBOUND(Alpha, 1) <> LBOUND(Beta, 1)) OR (UBOUND(Alpha, 1) <> UBOUND(Beta, 1)) OR (LBOUND(Alpha, 2) <> LBOUND(Beta, 2)) OR (UBOUND(Alpha, 2) <> UBOUND(Beta, 2)) THEN ERROR 196
  653. FOR row% = LBOUND(Alpha, 1) TO UBOUND(Alpha, 1)
  654.         FOR col% = LBOUND(Alpha, 2) TO UBOUND(Alpha, 2)
  655.                 Alpha(row%, col%) = Alpha(row%, col%) - Beta(row%, col%)
  656.         NEXT col%
  657. NEXT row%
  658. ssubexit:
  659. EXIT FUNCTION
  660. ssuberr:
  661.         MatSubS% = (ERR + 5) MOD 200 - 5
  662.         RESUME ssubexit:
  663. END FUNCTION
  664.  
  665.