REM PROGRAM: MAT
REM PROGRAMMER: D. ALLEN
REM DATE: MARCH 6, 1984
'
'    THE PURPOSE OF THIS FILE IS TO PROVIDE THE USER WITH A LIBRARY
'    OF MATRIX FUNCTIONS.  EACH ROUTINE IS A SEPARATE FUNCTION, AND
'    CAN BE USED BY A PROGRAM VIA ABASIC COPY.  CAUTION, IF YOUR
'    PROGRAM IS TO BE COMPILED, YOU WILL HAVE TO USE FIXED ARRAY
'    SIZES.
'
REM
REM     SHORT SAMPLE
REM
'
'    THIS SHORT PROGRAM SIMPLY LETS YOU TEST THE SIMEQU.
'
CLS
PRINT "SIMULTANEOUS EQUATIONS"
PRINT
DO
  GOSUB MAT.SIMEQU
  PRINT : PRINT "ANOTHER ONE ";
  INPUT D
LOOP UNTIL D=0
STOP
'
MAT.R.I.P:
'
'    THE PURPOSE OF THIS ROUTINE IS TO EITHER READ, INPUT, OR
'    PRINT A MATRIX ARRAY.
'
'    VARIABLE TABLE:
'      CMA         -  COLUMN DIMENSION OF MA()
'      FLAG        -  FLAG: 0=READ, 1=INPUT, 2=PRINT
'      I,J         -  DUMMY VARIABLES
'      MA()        -  MATRIX ARRAY
'      RMA         -  ROW DIMENSION OF MA()
'
FOR I = 1 TO RMA
  FOR J = 1 TO CMA
    SELECT CASE FLAG
    CASE 0
    :  READ MA(I,J)
    CASE 1
      PRINT "MA(";MID$(STR$(I),2);",";J;") ";
      INPUT MA(I,J)
    CASE 2
      PRINT "MA(";MID$(STR$(I),2);",";J;") =";MA(I,J)
    CASE ELSE
    END SELECT
  NEXT J
NEXT I
RETURN
'
MAT.COPY:
'
'    THE PURPOSE OF THIS ROUTINE IS TO COPY ONE MATRIX INTO
'    ANOTHER SPECIFIED MATRIX.
'
'    VARIABLE TABLE:
'      CMA         -  COLUMN DIMENSION OF MA()
'      CM1,CM2     -  COLUMN OF MA1(),MA2()
'      FLAG        -  FLAG, 1: MA1()=MA(), 2: MA2()=MA(),
'                          -1: MA()=MA1(),-2: MA()=MA2()
'      I,J         -  DUMMY VARIABLES
'      MA()        -  MATRIX ARRAY
'      MA1()       -  FIRST MATRIX ARGUMENT
'      MA2()       -  SECOND MATRIX ARGUMENT
'      RMA         -  ROW DIMENSION OF MA()
'      RM1,RM2     -  ROW OF MA1(),MA2()
'
SELECT CASE FLAG
CASE -1
: RMA=RM1 : CMA=CM1
CASE -2
: RMA=RM2 : CMA=CM2
CASE 1
: RM1=RMA : CM1=CMA
CASE 2
: RM2=RMA : CM2=CMA
CASE ELSE
END SELECT
FOR I = 1 TO RMA
  FOR J = 1 TO CMA
    SELECT CASE FLAG
    CASE -1
    : MA(I,J)=MA1(I,J)
    CASE -2
    : MA(I,J)=MA2(I,J)
    CASE 1
    : MA1(I,J)=MA(I,J)
    CASE 2
    : MA2(I,J)=MA(I,J)
    CASE ELSE
    END SELECT
  NEXT J
NEXT I
RETURN
'
MAT.ADD.SUBTRACT:
'
'    THE PURPOSE OF THIS ROUTINE IS TO ADD/SUBTRACT TWO MATRIES
'    WITH THE RESULTING MATRIX IN MA().
'
'    VARIABLE TABLE:
'      CMA         -  COLUMN DIMENSION OF MA()
'      FLAG        -  FLAG: 0=ADD, 1=SUBTRACT
'      I,J         -  DUMMY VARIABLES
'      MA()        -  MATRIX ARRAY
'      MA1()       -  FIRST ARGUMENT MATRIX
'      MA2()       -  SECOND ARGUMENT MATRIX
'      RMA         -  ROW DIMENSION OF MA()
'
FOR I = 1 TO RMA
  FOR J = 1 TO CMA
    SELECT CASE FLAG
    CASE 0
    :  MA(I,J)=MA1(I,J)+MA2(I,J)
    CASE 1
    :  MA(I,J)=MA1(I,J)-MA2(I,J)
    CASE ELSE
    END SELECT
  NEXT J
NEXT I
RETURN
'
MAT.MULT:
'
'    THE PURPOSE OF THIS ROUTINE IS TO MULTIPLY TWO MATRIES
'    WITH THE RESULTING MATRIX IN MA().
'
'    VARIABLE TABLE:
'      CM1,CM2     -  COLUMN DIMENSION OF MA1(),MA2()
'      CMA         -  COLUMN DIMENSION OF MA()
'      D           -  SUMMATION VARIABLE
'      FLAG        -  FLAG: 0=ADD, 1=SUBTRACT
'      I,J,K       -  DUMMY VARIABLES
'      MA()        -  MATRIX ARRAY
'      MA1()       -  FIRST ARGUMENT MATRIX
'      MA2()       -  SECOND ARGUMENT MATRIX
'      RM1,RM2     -  ROW DIMENSION OF MA1(),MA2()
'      RMA         -  ROW DIMENSION OF MA()
'
RMA=RM1 : CMA=CM2
FOR I = 1 TO RM1
  FOR J = 1 TO CM2
    D=0
    FOR K = 1 TO CM1
      D = D + MA1(I,K)*MA2(K,J)
    NEXT K
    MA(I,J)=D
  NEXT J
NEXT I
RETURN
'
MAT.ZER:
'
'    THE PURPOSE OF THIS ROUTINE IS TO ZERO OUT A MATRIX.
'
'    VARIABLE TABLE:
'      CMA         -  COLUMN DIMENSION OF MA()
'      I,J         -  DUMMY VARIABLES
'      MA()        -  MATRIX ARRAY
'      RMA         -  ROW DIMENSION OF MA()
'
FOR I = 1 TO RMA
  FOR J = 1 TO CMA
    MA(I,J)=0
  NEXT J
NEXT I
RETURN
'
MAT.CON:
'
'    THE PURPOSE OF THIS ROUTINE IS TO SET MA TO A CONSTANT.
'
'    VARIABLE TABLE:
'      CMA         -  COLUMN DIMENSION OF MA()
'      I,J         -  DUMMY VARIABLES
'      MA()        -  MATRIX ARRAY
'      RMA         -  ROW DIMENSION OF MA()
'
FOR I = 1 TO RMA
  FOR J = 1 TO CMA
    MA(I,J)=1
  NEXT J
NEXT I
RETURN
'
MAT.IDN:
'
'    THE PURPOSE OF THIS ROUTINE IS TO PRODUCE THE INDENTITY
'    MATRIX.
'
'    VARIABLE TABLE:
'      CMA         -  COLUMN DIMENSION OF MA()
'      I,J         -  DUMMY VARIABLES
'      MA()        -  MATRIX ARRAY
'      RMA         -  ROW DIMENSION OF MA()
'
'    SUBROUTINES:
'      MAT.ZER\
'
GOSUB MAT.ZER
FOR I = 1 TO RMA
  J=I
  MA(I,J)=1
NEXT I
RETURN
'
MAT.TRN:
'
'    THE PURPOSE OF THIS ROUTINE IS TO TRANSPOSE A MATRIX.
'
'    VARIABLE TABLE:
'      CMA         -  COLUMN DIMENSION OF MA()
'      I,J         -  DUMMY VARIABLES
'      MA()        -  MATRIX ARRAY
'      MA1()       -  FIRST ARGUMENT MATRIX
'      RMA         -  ROW DIMENSION OF MA()
'
FOR I = 1 TO RMA
  FOR J = 1 TO CMA
    MA(J,I)=MA1(I,J)
  NEXT J
NEXT I
RETURN
'
MAT.INV:
'
'    THE PURPOSE OF THIS ROUTINE IS TO PRODUCE THE INVERSE OF
'    A SQUARE MATRIX.  THIS ROUTINE USES INVERSION IN PLACE.
'
'    VARIABLE TABLE:
'      I,J,K       -  DUMMY VARIABLES
'      MA()        -  MATRIX ARRAY
'      RMA         -  ROW DIMENSION OF MA()
'
FOR K = 1 TO RMA
  FOR I = 1 TO RMA
    IF I<>K THEN MA(K,I) = MA(K,I)/MA(K,K)
  NEXT I
  MA(K,K)=1/MA(K,K)
  FOR I = 1 TO RMA
    IF I<>K THEN
      FOR J = 1 TO RMA
        IF J<>K THEN MA(I,J)=MA(I,J) - MA(K,J)*MA(I,K)
      NEXT J
    END IF
  NEXT I
  FOR I = 1 TO RMA
    IF I<>K THEN MA(I,K)=-MA(I,K)*MA(K,K)
  NEXT I
NEXT K
RETURN
'
MAT.DET:
'
'    THE PURPOSE OF THIS ROUTINE IS TO FIND THE DETERMINANT OF
'    A SQUARE MATRIX.
'
'    VARIABLE TABLE:
'      D           -  DUMMY VARIABLE
'      I,J,K       -  DUMMY VARIABLES
'      MA()        -  MATRIX ARRAY
'      RMA         -  ROW DIMENSION OF MA()
'      S           -  SAVED VALUE OF DETERMINANT
'
FOR I = 1 TO RMA-1
  FOR J = I+1 TO RMA
    D=MA(J,I)/MA(I,I)
    FOR K = 1 TO RMA
      MA(J,K)=MA(J,K)-D*MA(I,K)
    NEXT K
  NEXT J
NEXT I
S=1
FOR I = 1 TO RMA
  S=S*MA(I,I)
NEXT I
RETURN
'
MAT.SIMEQU:
'
'    THE PURPOSE OF THIS ROUTINE IS TO SOLVE SIMULTANEOUS
'    EQUATIONS.
'
'    VARIABLE TABLE:
'      CM1         -  COLUMN DIMENSION OF MA1()
'      CMA         -  COLUMN DIMENSION OF MA()
'      D           -  SUMMATION VARIABLE
'      FLAG        -  FLAG: 0=ADD, 1=SUBTRACT
'      FLG         -  SAVED VALUE OF FLAG
'      I,J,K       -  DUMMY VARIABLES
'      MA()        -  MATRIX ARRAY
'      MA1()       -  FIRST ARGUMENT MATRIX
'      MA2()       -  SECOND ARGUMENT MATRIX
'      RMA         -  ROW DIMENSION OF MA()
'
'    SUBROUTINES:
'      MAT.COPY\
'      MAT.INV\
'      MAT.MULT\
'      MAT.R.I.P\
'
PRINT "NUMBER OF UNKNOWN VARIABLES ";
INPUT CMA
PRINT
PRINT "NUMBER OF UNKNOWN EQUATIONS ";
INPUT RMA
'DIM MA(RMA,CMA)
'DIM MA1(RMA,CMA),MA2(RMA,1)
PRINT
PRINT "INPUT DATA (READ=0, INPUT=1) ";
INPUT FLAG : GOSUB MAT.R.I.P
FLG=FLAG
FLAG=1 : GOSUB MAT.COPY
CMA=1
FLAG=FLG : GOSUB MAT.R.I.P
FLAG=2 : GOSUB MAT.COPY
FLAG=-1 : GOSUB MAT.COPY
GOSUB MAT.INV
FLAG=1 : GOSUB MAT.COPY
GOSUB MAT.MULT
PRINT
FOR I = 1 TO RMA
  PRINT "X";MID$(STR$(I),2);" =";MA(I,1)
NEXT I
RETURN
END