home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / compiler / ubasic / malm / ldiosys.ub < prev    next >
Encoding:
Text File  |  1990-08-22  |  2.5 KB  |  63 lines
  1.  2320   *LDiosys(R,C,&A(),&V(),&Soln,&Rank)
  2.  2330   ' Solve the linear Diophantine system represented by the (augmented)
  3.  2340   ' matrix A().  Matrix V() contains a record of the manipulations.
  4.  2350   ' A is R by C+1, while V is C by C.  Soln is 1 if there is a solution
  5.  2360   ' and is 0 if there is no solution.  Rank is the rank of the system.
  6.  2370   '
  7.  2380   ' NOTE - there is a GLOBAL variable J% - required to receive the value
  8.  2390   ' of the function Pivotind, which LDiosys calls.
  9.  2400   '
  10.  2410   ' 19 June 1990
  11.  2420   local K%,M%,N%,I%,Done,Te,Found,P
  12.  2430   for I%=1 to C:for K%=1 to C:V(I%,K%)=0:next K%:next I%
  13.  2440   for I%=1 to C:V(I%,I%)=1:next I%
  14.  2450   Done=0:I%=0:Soln=1
  15.  2460   while and{I%<R,I%<C,Done=0}
  16.  2470   inc I%:J%=fnPivotind(I%)
  17.  2480   if J%=0 then K%=I%:Found=0
  18.  2490   :while and{Found=0,K%<R}
  19.  2500   :inc K%:J%=fnPivotind(K%)
  20.  2510   :if J%<>0 then Found=1 endif
  21.  2520   :wend
  22.  2530   :if Found=0 then Done=1 else
  23.  2540   :for M%=1 to C+1:swap A(K%,M%),A(I%,M):next M%
  24.  2550   :endif endif
  25.  2560   if Done=0 then
  26.  2570   :repeat K%=J%:P=A(I%,J%)
  27.  2580   :for N%=I% to C
  28.  2590   :if N%<>J% then Te=A(I%,N%)\P
  29.  2600   :for M%=I% to R:A(M%,N%)-=Te*A(M%,J%):next M%
  30.  2610   :for M%=1 to C:V(M%,N%)-=Te*V(M%,J%):next M%
  31.  2620   :endif:next N%
  32.  2630   :J%=fnPivotind(I%)
  33.  2640   :until J%=K%
  34.  2650   :if I%<>J% then
  35.  2660   :for M%=I% to R:swap A(M%,I%),A(M%,J%):next M%
  36.  2670   :for M%=1 to C:swap V(M%,I%),V(M%,J%):next M%
  37.  2680   :endif
  38.  2690   :if A(I%,C+1)@A(I%,I%)<>0 then Done=1 else
  39.  2700   :A(I%,C+1)\=A(I%,I%):A(I%,I%)=1
  40.  2710   :for M%=I%+1 to R:A(M%,C+1)-=A(M%,I%)*A(I%,C+1):A(M%,I%)=0:next M%
  41.  2720   :endif
  42.  2730   :endif ' done=0
  43.  2740   wend
  44.  2750   Te=min(R,C):Rank=0
  45.  2760   for K%=1 to Te:if A(K%,K%)<>0 then inc Rank endif next K%
  46.  2770   K%=0
  47.  2780   while and{K%<Rank,Soln}:inc K%:if A(K%,K%)<>1 then Soln=0 endif wend
  48.  2790   for K%=Rank+1 to R:if A(K%,C+1)<>0 then Soln=0 endif:next K%
  49.  2800   return ' End of subroutine LDiosys.
  50.  2810   '
  51.  2820   fnPivotind(Kk%)
  52.  2830   ' Returns the column index of the smallest (in absolute value )
  53.  2840   ' non-zero entry in row Kk% of the coefficient matrix A.
  54.  2850   ' If all entries are zero, then Pivotind = 0.
  55.  2855   ' 15 June 1990
  56.  2860   local T,S,K%,J%
  57.  2870   T=abs(A(Kk%,1))
  58.  2880   if T<>0 then K%=1 else K%=0 endif
  59.  2890   for J%=2 to C
  60.  2900   S=abs(A(Kk%,J%))
  61.  2910   if and{S<>0,or{T=0,S<T}} then T=S:K%=J% endif
  62.  2920   next J%:return(K%) ' End of function Pivotind.
  63.