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