@X @~
~V7 56 2 -5
~D10
~H                    MUSS
~
~
~D 10
~H             BSC241
~D10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL
~
~
                                                            ISSUE 11~
~V9 -1
~P
~V9 1
~YBSC241
~S~M~OBASIC IMPLEMENTATION MANUAL
~S~M~OSection 24
~S~OSection 24 Matrix and String Functions
~S~O1. General Description
~BThis section contains procedures for processing matrix manipulation functions.
Matrix input and output is implemented in Sections 22 and 23 respectively.
At present, only REAL32 and REAL64
matrices are supported.  Additionally, this section handles string operations.
~S~O2. Interfaces
~S~O2.1 Section Interfaces Used
~
   Section 20 : (Run time configuration)~
   Section 21 : (Program control)~
~S~O2.2 Section Interface
~
Exported Procedures:~
   BIO.MAT.R32.CONST~
   BIO.MAT.R64.CONST~
   BIO.MAT.R32.UNARY~
   BIO.MAT.R64.UNARY~
   BIO.MAT.R32.DYADIC~
   BIO.MAT.R64.DYADIC~
   BIO.MAT.R32.SCALE~
   BIO.MAT.R64.SCALE~
   BIO.DET.R32~
   BIO.DET.R64~
   BIO.C.DET.R64~
   BIO.DOT.R32~
   BIO.DOT.R64~
   BIO.L.BOUND~
   BIO.U.BOUND~
   BIO.D.SIZE~
   BIO.SIZE~
   BIO.STR.ASS~
   BIO.STR.COMP~
   BIO.MAT.STR.ASS~
~
Configuration Parameters:~
   DET.TOL.R32~
   DET.TOL.R64~
~BIn the procedures below a pair of parameters are passed for
matrices and vectors.  The first of the pair is a bounded
pointer of matrix (vector) element type.  The
second parameter is bounded pointer to a
vector of 'address sized integer' elements
which specify the size and bounds of each
dimension of the array.  Each dimension is
described by a pair of elements, the first
of these specify the lower bound of the
dimension and the second the size
of the dimension.  Note
that the bound of this 'array descriptor'
parameter determines the
dimensionality of the array (i.e. whether it is a
vector or a matrix).
~BAll the procedures perform the necessary checks on
dimensionality and bounds checks on participating arrays.
~S11) BIO.MAT.R32.CONST(^RES.MAT,^RES.MAT.DESC,ROW,COL,CONST,
   ~GFUNCTION)~G~
~BThis procedure generates a constant matrix or vector as determined
by P5 and P6.  Bits 0-2 of P6 are encoded as:~
~T# 11 21 25
~
#FUNCTION#= 0#Zeroise all elements~
##= 1#Elements have the value 1.0~
##= 2#Main diagonal elements have a 1.0 value,~
###all other elements are zero.~
~BIf bit 4 of P6 is one then assign a matrix where
P1 and P2 specify a vector of real 32 bit elements in which the result matrix is
 to be placed.
P5 specifies a scaling value
to be applied to each element of the generated matrix,
this scaling is only performed if bit 5 of P6=1.
If bit 6=1 then P3 and P4 specify the number of rows and columns
in the matrix, otherwise the result descriptor P2 specifies
the rows and columns.
~S12) BIO.MAT.R64.CONST(^RES.MAT,^RES.MAT.DESC,ROW,COL,CONST,
   ~GFUNCTION)~G~
~BAs MAT.R32.CONST but for real 64 bit matrices.
~S13) BIO.MAT.R32.UNARY(^MAT,^MAT.DESC,^RES.MAT,^RES.MAT.DESC,
   ~GFUNCTION)~G~
~BThis procedure performs a unary matrix operation on
a matrix of real 32 bit elements specified by
P1 and P2,leaving the resultant matrix in the matrix
specified by P3 and P4.  P5 specifies the unary
operation as follows:~
~
#FUNCTION#= 0#transpose matrix~
##= 1#invert matrix.~
~
For matrix inversion, BIO.DET.R32 is called to "triangularise" the
matrix and compute its determinant.  If this value is less than
DET.TOL.R32, the matrix is considered to be singular, otherwise
the inverse matrix is then computed using back-substitution.
~BAfter a matrix inversion the determinant of the matrix
prior to inversion is maintained.
~S14) BIO.MAT.R64.UNARY(^MAT,^MAT.DESC,^RES.MAT,^RES.MAT.DESC,
   ~GFUNCTION)~G~
~BAs MAT.R32.UNARY but for matrices with real 64 bit elements.
~S15) BIO.MAT.R32.DYADIC(^MAT.1,^MAT.1.DESC,^MAT.2,^MAT.2.DESC,
   ~G^RES.MAT,^RES.DESC,FUNCTION)~G~
~BThis procedure performs a matrix operation on MAT.1 (P1, P2)
and MAT.2 (P3, P4) leaving the resultant matrix in MAT.3 (P5, P6).
The matrix operation is specified by P7 which is encoded as follows:~
~
~MP5 = 8 MAT.1 + MAT.2 => RES
~N   = 9 MAT.1 - MAT.2 => RES
~N   =11 MAT.1 * MAT.2 => RES
~S16) BIO.MAT.R64.DYADIC(^MAT,^MAT.DESC,^MAT.2,^MAT.2.DESC,~
   ~G^RES.MAT,^RES.MAT.DESC,FUNCTION)~G~
~BAs MAT.R32.DYADIC but for matrices of 64 bit real elements.
~S17) BIO.MAT.R32.SCALE(^MAT,^MAT.DESC,^RES.MAT,^RES.MAT.DESC,
   ~GSCALE.FACTOR)~G~
~BThis procedure scales all the elements of the matrix or vector
specified by P1 and P2 by the value of P5, placing the result in the
matrix specified by P3 and P4.
~S18) BIO.MAT.R64.SCALE(^MAT,^MAT.DESC,^RES.MAT,^RES.MAT.DESC,
   ~GSCALE.FACTOR)~G~
~BAs MAT.R32.SCALE but for matrices whose elements are
64 bit reals.
~S19) BIO.DET.R32(^MAT,^MAT.DESC)DET
~BThis procedure computes the determinant of the matrix specified by
P1 and P2, by the method of Gaussian Elimination with partial
pivoting.  The "triangularised" form of P1 is held in a global,
for use by the inversion procedure.
~S110) DET.R64(^MAT,^MAT.DESC)DET
~BAs DET.R32 but for matrices whose elements are 64 bit reals.
~S111) BIO.C.DET.R64()DET
~BThis procedure returns the determinant value
produced during the last matrix inversion.  The result
is a 64 bit real value.
~S112) BIO.DOT.R32(^VEC.1,^VEC.1.DESC,^VEC.2, ^VEC.2.DESC)DOT
~BThis procedure yields in the result the value of the inner
product multiplication of the two vectors specified by P1 to P4.
Both vectors contain real 32 bit elements and the result precision
is real 32 bits.
~S113) BIO.DOT.R64(^VEC.1,^VEC.1.DESC,^VEC.2,^VEC.2.DESC)DOT
~BAs DOT.R32 except vector elements are 64 bit reals and the
result precision is real 64 bits.
~S114) BIO.L.BOUND(^MAT.DESC,N)VALUE
~BThis procedure returns the lower bound of the subscript specified
by P2 of an array specified by P1.  The procedure checks that P2
is positive and not greater than the number of dimensions in the array.
~S115) BIO.U.BOUND(^MAT.DESC,N)VALUE
~BThis procedure operates in a similar manner to BIO.L.BOUND but
returns the maximum subscript value.
~S116) BIO.SIZE(^MAT.DESC,N)VALUE
~BThis procedure returns the number of permissable values for the
subscript specified by P2 of an array specified by P1.  The
procedure checks that P2 is positive and not greater than the
number of dimensions in P1.
~S117) BIO.D.SIZE(^MAT.DESC)SIZE
~BThis procedure returns the total number of elements in the array
specified by P1.
~S118) BIO.STR.ASS([STR.INFO],LHS.CNT,RHS.CNT)
~BThis procedure supports string assignation in BASIC.  P1 is a vector
of string specifiers, each element is of type STR.E which has the
following fields:~
~T# 10
~
PTR~IBounded pointer to vector of bytes for string variable.~
~
LOWER~ILower limit of substring specifier.~
~
UPPER~IUpper limit of substring specifier.~
~
P2 specifies the number of LHS string variables to be assigned from
the string expression containing P3 components.  P1 contains the
string specifiers for the LHS followed by the string specifiers
for the RHS expression.  The RHS strings are concatenated before
assignment.
~S119) BIO.STR.COMP([STR.INFO],LHS.CNT,RHS.CNT)CONDITION
~BThis procedure supports string comparison in BASIC.  P2 and P3
specify the number of components in the left and right hand side
operands respectively of the string compare operation.  P1 is a
vector of string specifiers (of type STR.E), the LHS string specifiers appear
first in the vector.  The result is zero if the strings are equal,
-1 if LHS operand is 'less than' the RHS operand, and 1 otherwise.
~S120) BIO.MAT.STR.ASS([MAT.DATA],RHS.CNT)
~BThis procedure supports matrix string assignation in BASIC.  P1 is a
bounded pointer to a vector of matrix string specifiers, each
element of this vector is of the type MAT.STR.E, with the following fields:~
~T#11 16 18 20 27
~
KIND#Bit#0#=#1~ISubstring specifier present.~
~T# 11 16 22 24 27
#Bits#1,2,3#=#0~IString array component.~
###=#1~IScalar string value component.~
###=#2~IOne-dimensional string array value component, size
given in LOWER.~
###=#3~ITwo-dimensional string array value component, size
given in LOWER and UPPER.~
###=#4~IOne-dimensional string array value, size given in MAT.DESC.~
###=#5~ITwo-dimensional string array value, size given in MAT.DESC.~
~T# 11
~
PTR~IFor string arrays and scalar string values, this field contains
a bounded pointer to a byte vector for the component.~
~
LOWER~ILower substring limit or bounds of first dimension for array value.~
~
UPPER~IUpper substring limit or bounds of second dimension for array value.~
~
MAT.DESC~IBounded pointer to array descriptor for string array components.~
~
EL.SIZE~IThe maximum size in bytes of each array element.~
~BThe first element in the vector pointed at by P1 is for the string array
being assigned to.  The following elements describe the operands in
the matrix string expression.
~S~O3.Implementation
~S~O3.1 Outline of Operation
~S11) CHK.RES.MAT(SIZE,^RES.MAT.DESC,ROW,COL,KIND)
~BThis procedure performs checks that the result matrix is compatible
with the requested redimensioning operation.  First it checks that
the required result specified in P3 and P4 matches that specified by
P5, which is encoded as:~
~
~NBit 4 = 0/1  :  Vector/Matrix
~BAt least one of P3 and P4 must be > 0.  A trap is entered if the required
result exceeds the storage allocated whose size is given by P1.  If
all parameters are compatible, the result matrix descriptor is updated.
~S~O3.2 Data Structures
~T# 20 22
~
LAST.INV.DET.R64#:~IThis holds the value of the determinant
of the most recently inverted matrix.~
~
A32#:~IA vector of Real 32 values in which the "triangularised" matrix
is computed during evaluation of a determinant.~
~
B32#:~IA vector of Real 32 values holding the transferred R.H.S. produced
during evaluation of a determinant.  At the start of the procedure,
it is initialised to be the identity matrix.~
~
A64, B64#:~ICorresponding Real 64 versions of the above.~
~
R.KEYS#:~IA vector of integers holding the position of the start
of each row in a matrix, during computation of the determinant.
It is used to keep track of any row exchanges made during the
"triangularisation" process, since this information is required
in a subsequent inversion operation.~
~Y
~V9 -1
~P
~D 15
~HFLOWCHARTS
~
~
~H                BSC241
~V9 -1
~F
///14
@TITLE BSC24(1,11)
@COL 1S-2R-3R-4R-5F
@FLOW 1-2-3-4-5
@BOX 1.0
MATRIX AND STRING FUNCTIONS
@BOX 2.0
TYPE DECLARATIONS
@BOX 3.0
VARIABLE DECLARATIONS
@BOX 4.0
PROCEDURES IN MODULE:

(INTERFACE PROCEDURES)               (INTERNAL PROCEDURES)
BIO.MAT.R32.CONST [BSC24.1]
BIO.MAT.R64.CONST [BSC24.2]
                                               CHK.RES.MAT[BSC24.20]
BIO.MAT.R32.UNARY [BSC24.3]
BIO.MAT.R64.UNARY [BSC24.4]
BIO.MAT.R32.DYADIC [BSC24.5]
BIO.MAT.R64.DYADIC [BSC24.6]
BIO.MAT.R32.SCALE [BSC24.7]
BIO.MAT.R64.SCALE [BSC24.8]
BIO.DET.R32 [BSC24.9]
BIO.DET.R64 [BSC24.10]
BIO.C.DET.R64 [BSC24.12]
BIO.DOT.R32 [BSC24.13]
BIO.DOT.R64 [BSC24.14]
BIO.SIZE [BSC24.29]
BIO.L.BOUND [BSC24.30]
BIO.U.BOUND [BSC24.31]
BIO.D.SIZE [BSC24.32]
BIO.STR.ASS [BSC24.33]
BIO.STR.COMP [BSC24.34]
BIO.MAT.STR.ASS [BSC24.35]
@BOX 5.0
END
@BOX 1.1
#BSC24/1
MODULE(BIO.MAT.R32.CONST, BIO.MAT.R64.CONST, BIO.MAT.R32.UNARY,
BIO.MAT.R64.UNARY, BIO.MAT.R32.DYADIC, BIO.MAT.R64.DYADIC,
BIO.MAT.R32.SCALE, BIO.MAT.R64.SCALE,BIO.DET.R32, BIO.DET.R64,
BIO.C.DET.R64, BIO.DOT.R32, BIO.DOT.R64, BIO.L.BOUND,STR.E,MAT.STR.E,
 BIO.U.BOUND, BIO.SIZE,BIO.D.SIZE, BIO.STR.ASS, BIO.STR.COMP, BIO.MAT.STR.ASS);
@BOX 2.1
TYPE STR.E IS ADDR[$LO8]PTR
              $IN16 LOWER,UPPER;
TYPE MAT.STR.E IS $LO8 KIND
              ADDR[$LO8]PTR
                  ADDR LOWER,UPPER
                  ADDR[ADDR]MAT.DESC
                 $IN16 EL.SZ;
@BOX 3.1
*GLOBAL 2;
$LI/ADDR [$LO8] NIL.L8 =;
$LI/ADDR [$RE32] NIL.R32 =;
$LI/ADDR [$RE64] NIL.R64 =;
$RE64 LAST.INV.DET.R64;
$RE32[100]A32,B32;
$RE64[100]A64,B64;
$IN[10]R.KEYS;
@BOX 4.1
*GLOBAL 0;
LSPEC BIO.MAT.R32.CONST (ADDR [$RE32], ADDR [ADDR], ADDR, ADDR, $RE32, $IN16);
LSPEC BIO.MAT.R64.CONST (ADDR [$RE64], ADDR [ADDR], ADDR, ADDR, $RE64, $IN16);
LSPEC BIO.MAT.R32.UNARY (ADDR [$RE32], ADDR [ADDR], ADDR [$RE32],
                   ADDR [ADDR], $IN16);
LSPEC BIO.MAT.R64.UNARY (ADDR [$RE64], ADDR [ADDR], ADDR [$RE64],
                   ADDR [ADDR], $IN16);
LSPEC BIO.MAT.R32.DYADIC (ADDR [$RE32], ADDR [ADDR], ADDR [$RE32],
                    ADDR [ADDR], ADDR [$RE32], ADDR [ADDR],
                    $IN16);
LSPEC BIO.MAT.R64.DYADIC (ADDR [$RE64], ADDR [ADDR], ADDR [$RE64],
                    ADDR [ADDR], ADDR [$RE64], ADDR [ADDR],
                    $IN16);
LSPEC BIO.MAT.R32.SCALE (ADDR [$RE32], ADDR [ADDR],
                   ADDR [$RE32], ADDR [ADDR], $RE32);
LSPEC BIO.MAT.R64.SCALE (ADDR [$RE64], ADDR [ADDR],
                   ADDR [$RE64], ADDR [ADDR], $RE64);
LSPEC BIO.DET.R32 (ADDR [$RE32], ADDR [ADDR]) / $RE32;
LSPEC BIO.DET.R64 (ADDR [$RE64], ADDR [ADDR]) / $RE64;
LSPEC BIO.C.DET.R64 () / $RE64;
LSPEC BIO.DOT.R32 (ADDR [$RE32], ADDR [ADDR],
             ADDR [$RE32], ADDR [ADDR]) / $RE32;
LSPEC BIO.DOT.R64 (ADDR [$RE64], ADDR [ADDR],
             ADDR [$RE64], ADDR [ADDR]) / $RE64;
$PS CHK.RES.MAT ($IN, ADDR [ADDR], $IN, $IN, $LO8);
LSPEC BIO.SIZE(ADDR[ADDR])/ADDR;
LSPEC BIO.L.BOUND(ADDR[ADDR],$IN16)/ADDR;
LSPEC BIO.U.BOUND(ADDR[ADDR],$IN16)/ADDR;
LSPEC BIO.D.SIZE(ADDR[ADDR],$IN16)/ADDR;
LSPEC BIO.STR.ASS(ADDR[STR.E],$IN16,$IN16);
LSPEC BIO.STR.COMP(ADDR[STR.E],$IN16,$IN16)/$IN16;
LSPEC BIO.MAT.STR.ASS(ADDR[MAT.STR.E],$IN16);
PSPEC ABS.R32($RE32)/$RE32;
PSPEC ABS.R64($RE64)/$RE64;
#BSC24/2
#BSC24.1
#BSC24.2
#BSC24.3
#BSC24.4
#BSC24.5
#BSC24.6
#BSC24.7
#BSC24.8
#BSC24.9
#BSC24.10
#BSC24.12
#BSC24.13
#BSC24.14
#BSC24.20
#BSC24.29
#BSC24.30
#BSC24.31
#BSC24.32
#BSC24.33
#BSC24.34
#BSC24.35
@BOX 5.1
*END
@END
///4
@TITLE BSC24/1(1,11)
@COL 1S
@BOX 1.0
EXTERNAL ENVIRONMENT
@BOX 1.1
$IM $LI $RE32 DET.TOL.R32;
$IM $LI $RE64 DET.TOL.R64;
$IM $LI R32.VEC.Z, R64.VEC.Z,MAX.STR.Z;
$PS BIO.EXCEPTION($IN16);
@END
///17 15-AUG-83
@TITLE BSC24/2(1,11)
@COL 1S-2R-3R
@FLOW 1-2-3
@BOX 1.0
UTILITY ROUTINES
@BOX 2.0
ABS.R32(X) - RETURNS ABS VALUE OF X
@BOX 3.0
ABS.R64(X) - RETURNS ABS VALUE OF X
@BOX 1.1
@BOX 2.1
PROC ABS.R32(X);
IF X < 0.0 THEN
   0.0 - X => ABS.R32;
ELSE
   X => ABS.R32;
FI
END
@BOX 3.1
PROC ABS.R64(X);
IF X < 0.0 THEN
   0.0 - X => ABS.R64;
ELSE
   X => ABS.R64;
FI
END
@END
///15
@TITLE BSC24.1(1,11)
@COL 11R
@COL 1S-15R-2T-3T-4R-5R-8R-9R-10F
@COL 12T-13R-14C
@ROW 11-4
@ROW 3-12
@ROW 8-14
@FLOW 1-15-2N-3N-4-5-8-9-10
@FLOW 2Y-12N-13-5
@FLOW 12Y-14
@FLOW 3Y-11-5
@BOX 1.0
BIO.MAT.R32.CONST (^RES, ^RES.DESC, ROW, COL, CONST, FN)
FUNCTION = 0 ZERO ALL ELEMENTS
         = 1 ALL ELEMENTS 1.0
         = 2 MAIN DIAGONAL ELEMENTS 1.0, REST 0.0
           (SUBJECT TO SCALING)
@BOX 2.0
IDENTITY FUNCTION?
@BOX 3.0
ZERO FUNCTION?
@BOX 4.0
SET ELEMENT VALUES TO 1.0
@BOX 5.0
SCALE ELEMENT VALUES IF NECESSARY
@BOX 8.0
PERFORM RESULT MATRIX
CHECKS AND REDIMENSION
[BSC24.20]
@BOX 9.0
STORE MATRIX VALUE
IN RESULT MATRIX
@BOX 10.0
END
@BOX 11.0
SET ELEMENT VALUES TO 0.0
@BOX 12.0
NOT A SQUARE MATRIX?
@BOX 13.0
SET DIAGONAL ELEMENT
VALUE TO 1.0
SET NON-DIAGONAL ELEMENT
VALUE TO 0.0
@BOX 14.0
EXCEPTION
@BOX 15.0
GET DIMENSIONS OF RESULT
@BOX 1.1
PROC BIO.MAT.R32.CONST (RES.MAT, RES.MAT.DESC, ROW, COL, SCALE, FN);
$IN F,K;
$RE32 D.EL, ND.EL;
$IN R, C, E.I,R1,C1;
@BOX 2.1
FN & %10 => K;
IF FN & %7 => F = 2
@BOX 3.1
IF F = 0
@BOX 4.1
1.0 => D.EL => ND.EL;
@BOX 5.1
IF FN & %20 /= 0 THEN
   SCALE *> D.EL;
   SCALE *> ND.EL;
FI;
@BOX 8.1
CHK.RES.MAT (SIZE (RES.MAT), RES.MAT.DESC, R, C, K);
@BOX 9.1
-1 => E.I;
FOR R1 < R DO
   FOR C1 < C DO
      1 +> E.I;
      IF R1 = C1 THEN
         D.EL => RES.MAT^ [E.I]
      ELSE
         ND.EL => RES.MAT^ [E.I]
      FI
   OD
OD
@BOX 10.1
END
@BOX 11.1
0.0 => D.EL => ND.EL;
@BOX 12.1
IF R /= C
@BOX 13.1
1.0 => D.EL;
0.0 => ND.EL;
@BOX 14.1
BIO.EXCEPTION(%6);
@BOX 15.1
IF FN & %40 = 0 THEN
   RES.MAT.DESC^[1] => R;
   IF FN & %10 /= 0 THEN
      RES.MAT.DESC^[3] => C;
   ELSE 1 => C;
   FI;
ELSE
   ROW => R; COL => C;
FI
@END
///15
@TITLE BSC24.2(1,11)
@COL 11R
@COL 1S-15R-2T-3T-4R-5R-8R-9R-10F
@COL 12T-13R-14C
@ROW 11-4
@ROW 3-12
@ROW 8-14
@FLOW 1-15-2N-3N-4-5-8-9-10
@FLOW 2Y-12N-13-5
@FLOW 12Y-14
@FLOW 3Y-11-5
@BOX 1.0
BIO.MAT.R64.CONST (^RES, ^RES.DESC, ROW, COL, CONST, FN)
FUNCTION = 0 ZERO ALL ELEMENTS
         = 1 ALL ELEMENTS 1.0
         = 2 MAIN DIAGONAL ELEMENTS 1.0, REST 0.0
           (SUBJECT TO SCALING)
@BOX 2.0
IDENTIFY FUNCTION?
@BOX 3.0
ZERO FUNCTION?
@BOX 4.0
SET ELEMENT VALUES TO 1.0
@BOX 5.0
SCALE ELEMENT VALUES IF NECESSARY
@BOX 8.0
PERFORM RESULT MATRIX
CHECKS AND REDIMENSION
[BSC24.20]
@BOX 9.0
STORE MATRIX VALUE
IN RESULT MATRIX
@BOX 10.0
END
@BOX 11.0
SET ELEMENT VALUES TO 0.0
@BOX 12.0
NOT A SQUARE MATRIX?
@BOX 13.0
SET DIAGONAL ELEMENT
VALUE TO 1.0
SET NON-DIAGONAL ELEMENT
VALUE TO 0.0
@BOX 14.0
EXCEPTION
@BOX 15.0
GET DIMENSIONS OF RESULT
@BOX 1.1
PROC BIO.MAT.R64.CONST (RES.MAT, RES.MAT.DESC, ROW, COL, SCALE, FN);
$IN F,K;
$RE64 D.EL, ND.EL;
$IN R, C, E.I,R1,C1;
@BOX 2.1
FN & %10 => K;
IF FN & %7 => F = 2
@BOX 3.1
IF F = 0
@BOX 4.1
1.0 => D.EL => ND.EL;
@BOX 5.1
IF FN & %20 /= 0 THEN
   SCALE *> D.EL;
   SCALE *> ND.EL;
FI;
@BOX 8.1
CHK.RES.MAT (SIZE (RES.MAT), RES.MAT.DESC, R, C, K);
@BOX 9.1
-1 => E.I;
FOR R1 < R DO
   FOR C1 < C DO
      1 +> E.I;
      IF R1 = C1 THEN
         D.EL => RES.MAT^ [E.I]
      ELSE
         ND.EL => RES.MAT^ [E.I]
      FI
   OD
OD
@BOX 10.1
END
@BOX 11.1
0.0 => D.EL => ND.EL;
@BOX 12.1
IF R /= C
@BOX 13.1
1.0 => D.EL;
0.0 => ND.EL;
@BOX 14.1
BIO.EXCEPTION(%6);
@BOX 15.1
IF FN & %40 = 0 THEN
   RES.MAT.DESC^[1] => R;
   IF FN & %10 /= 0 THEN
      RES.MAT.DESC^[3] => C;
   ELSE 1 => C;
   FI
ELSE
   ROW => R; COL => C;
FI
@END
///17 15-AUG-83
@TITLE BSC24.3(1,11)
@COL 1S-5T-6R-7R-8F
@COL 15C-14R
@COL 16T-10R-11T-12R-13R
@ROW 6-16
@ROW 15-10
@ROW 14-12
@ROW 8-13
@FLOW 1-5N-6-7-8
@FLOW 5Y-16N-10-11N-12-13-8
@FLOW 16Y-15
@FLOW 11Y-14-8
@BOX 1.0
BIO.MAT.R32.UNARY (^IN.MAT, ^IN.MAT.DESC, ^RES.MAT, ^RES.MAT.DESC, FN)
FUNCTION: = 0 TRANSPOSE MATRIX
          = 1 INVERT MATRIX
@BOX 5.0
FUNCTION INVERSE?
@BOX 6.0
PERFORM RESULT MATRIX DIMENSION
CHECKS AND REDIMENSION
[BSC24.20]
@BOX 7.0
COMPUTE TRANSPOSE OF MATRIX
AND PLACE IN RESULT MATRIX
@BOX 8.0
END
@BOX 10.0
COMPUTE DETERMINANT OF
MATRIX [BSC24.9]
@BOX 11.0
DETERMINANT CLOSE TO OR = ZERO?
@BOX 12.0
PERFORM RESULT MATRIX
DIMENSION CHECKS AND
REDIMENSION
[BSC24.20]
@BOX 13.0
COMPUTE INVERSE OF MATRIX
AND PLACE IN RESULT MATRIX
@BOX 14.0
MAKE DETERMINANT ZERO
@BOX 15.0
EXCEPTION
@BOX 16.0
NOT A SQUARE MATRIX?
@BOX 1.1
PROC BIO.MAT.R32.UNARY (IN.MAT, IN.MAT.DESC, RES.MAT, RES.MAT.DESC, FN);
$IN[10]RKS;
$IN E.I, R, C, ROW,COL,I,J,K,N,RI,RJ,RN,NN,KEY;
$RE32 TOP,EL;
@BOX 5.1
IN.MAT.DESC ^[1] => ROW;
IN.MAT.DESC ^[3] => COL;
IF FN = 1
@BOX 6.1
CHK.RES.MAT (SIZE (RES.MAT), RES.MAT.DESC, COL,ROW, %10);
@BOX 7.1
-1 => E.I;
FOR R < ROW DO
   FOR C < COL DO
      1 +> E.I;
      IN.MAT^ [EI] => RES.MAT^ [C * (ROW) + R]
   OD
OD
@BOX 8.1
END
@BOX 10.1
BIO.DET.R32(IN.MAT,IN.MAT.DESC);
@BOX 11.1
IF ABSR64(LAST.INV.DET.R64) < DET.TOL.R64
@BOX 12.1
CHK.RES.MAT(SIZE(RES.MAT),RES.MAT.DESC,ROW,COL,%10);
@BOX 13.1
0 => KEY;
ROW => N;
FOR I < N DO
   KEY => RKS[I];
   N +> KEY;
OD
N-1 => NN;
R.KEYS[NN] => RN;
IF A32[R.KEYS[NN]+NN] => EL /= 0.0 THEN
FOR J < N DO
   R.KEYS[J] => RJ;
   B32[RN+J]/EL=>RES.MAT^[RKS[NN]+J];
   N => I;
   WHILE 1 -> I >= 0 DO
      R.KEYS[I] => RI;
      B32[RI+J] => TOP;
      I => K;
      WHILE 1 +> K < N DO
         TOP-(A32[RI+K]*RES.MAT^[RKS[K]+J]) => TOP;
      OD
      TOP / A32[RI+I] => RES.MAT^[RKS[I]+J];
   OD
OD
ELSE
   0.0 => LAST.INV.DET.R64;
FI
@BOX 14.1
0.0 => LAST.INV.DET.R64;
@BOX 15.1
BIO.EXCEPTION(%5);
@BOX 16.1
IF ROW /= COL
@END
///17 15-AUG-83
@TITLE BSC24.4(1,11)
@COL 1S-5T-6R-7R-8F
@COL 15C-14R
@COL 16T-10R-11T-12R-13R
@ROW 14-12
@ROW 6-16
@ROW 15-10
@ROW 8-13
@FLOW 1-5N-6-7-8
@FLOW 5Y-16N-10-11N-12-13-8
@FLOW 16Y-15
@FLOW 11Y-14-8
@BOX 1.0
BIO.MAT.R64.UNARY (^IN.MAT, ^IN.MAT.DESC, ^RES.MAT, ^RES.MAT.DESC, FN)
FUNCTION: = 0 TRANSPOSE MATRIX
          = 1 INVERT MATRIX
@BOX 5.0
FUNCTION INVERSE?
@BOX 6.0
PERFORM RESULT MATRIX DIMENSION
CHECKS AND REDIMENSION
[BSC24.20]
@BOX 7.0
COMPUTE TRANSPOSE OF MATRIX
AND PLACE IN RESULT MATRIX
@BOX 8.0
END
@BOX 10.0
COMPUTE DETERMINANT OF
MATRIX [BSC24.9]
@BOX 11.0
DETERMINANT CLOSE TO OR = ZERO?
@BOX 12.0
PERFORM RESULT MATRIX
DIMENSION CHECKS AND
REDIMENSION
[BSC24.20]
@BOX 13.0
COMPUTE INVERSE OF MATRIX
AND PLACE IN RESULT MATRIX
@BOX 14.0
MAKE DETERMINANT ZERO
@BOX 15.0
EXCEPTION
@BOX 16.0
NOT A SQUARE MATRIX?
@BOX 1.1
PROC BIO.MAT.R64.UNARY (IN.MAT, IN.MAT.DESC, RES.MAT, RES.MAT.DESC, FN);
$IN[10]RKS;
$IN E.I, R, C, ROW,COL,I,J,K,N,RJ,RI,RN,NN,KEY;
$RE64 TOP,EL;
@BOX 5.1
IN.MAT.DESC ^[1] => ROW;
IN.MAT.DESC ^[3] => COL;
IF FN = 1
@BOX 6.1
CHK.RES.MAT (SIZE (RES.MAT), RES.MAT.DESC, COL,ROW, %10);
@BOX 7.1
-1 => E.I;
FOR R < ROW DO
   FOR C < COL DO
      1 +> E.I;
      IN.MAT^ [EI] => RES.MAT^ [C * (ROW) + R]
   OD
OD
@BOX 8.1
END
@BOX 10.1
BIO.DET.R64(IN.MAT,IN.MAT.DESC);
@BOX 11.1
IF ABSR64(LAST.INV.DET.R64) < DET.TOL.R64
@BOX 12.1
CHK.RES.MAT(SIZE(RES.MAT),RES.MAT.DESC,ROW,COL,%10);
@BOX 13.1
0 => KEY;
ROW => N;
FOR I < N DO
   KEY => RKS[I];
   N +> KEY;
OD
N-1 => NN;
R.KEYS[NN] => RN;
IF A64[R.KEYS[NN]+NN] => EL /= 0.0 THEN
FOR J < N DO
   R.KEYS[J] => RJ;
   B64[RN+J]/EL=>RES.MAT^[RKS[NN]+J];
   N => I;
   WHILE 1 -> I >= 0 DO
      R.KEYS[I] => RI;
      B64[RI+J] => TOP;
      I => K;
      WHILE 1 +> K < N DO
         TOP-(A64[RI+K]*RES.MAT^[RKS[K]+J]) => TOP;
      OD
      TOP / A64[RI+I] => RES.MAT^[RKS[I]+J];
   OD
OD
ELSE
   0.0 => LAST.INV.DET.R64;
FI
@BOX 14.1
0.0 => LAST.INV.DET.R64;
@BOX 15.1
BIO.EXCEPTION(%5);
@BOX 16.1
IF ROW /= COL
@END
///15
@TITLE BSC24.5(1,11)
@COL 11C
@COL 1S-2R-3T-4T-7R-8T-9R-10F
@COL 13T-14T-15C-17R
@ROW 11-7-15
@ROW 4-13
@ROW 9-17
@FLOW 1-2-3N-4N-7-8N-9-10
@FLOW 3Y-13N-14Y-7
@FLOW 4Y-11
@FLOW 8Y-17-10
@FLOW 13Y-15
@FLOW 14N-15
@BOX 1.0
BIO.MAT.R32.DYADIC (^MAT1, ^MAT1.DESC, ^MAT2, ^MAT2.DESC, ^RES.MAT,
                ^RES.MAT.DESC, FN)
FN = 8 MAT1 + MAT2 => RES
   = 9 MAT1 - MAT2 => RES
   =11 MAT1 * MAT2 => RES
@BOX 2.0
OBTAIN DIMENSIONALITY AND
DIMENSION SIZE OF MATRIX OPERANDS
@BOX 3.0
ADD OR SUBTRACT FUNCTIONS?
@BOX 4.0
MATRIX OPERANDS NOT COMPATIBLE?
@BOX 7.0
PERFORM DIMENSION CHECKS ON
RESULT MATRIX AND REDIMENSION
[BSC24.20]
@BOX 8.0
ADD OR SUBTRACT?
@BOX 9.0
COMPUTE MAT1 x MAT2
AND STORE TO RESULT
@BOX 10.0
END
@BOX 11.0
EXCEPTION
@BOX 13.0
ROWS NOT EQUAL?
@BOX 14.0
COLS EQUAL?
@BOX 15.0
EXCEPTION
@BOX 17.0
ADD/SUBTRACT MATRICES
AND STORE TO RESULT
@BOX 1.1
PROC BIO.MAT.R32.DYADIC (M1, M1.DESC, M2, M2.DESC, RES.MAT, RES.MAT.DESC, FN);
$IN M1.K, M1.R, M1.C, M2.K, M2.R, M2.C, E.I,TYP; $LO8 FAULT;
@BOX 2.1
IF SIZE (M1.DESC) => M1.K = 4 THEN
   M1.DESC^ [1] => M1.R;
   M1.DESC^ [3] => M1.C
ELSE
   M1.DESC^ [1] => M1.R;
   1 => M1.C
FI;
IF SIZE (M2.DESC) => M2.K = 4 THEN
   M2.DESC^ [1] => M2.R;
   M2.DESC^ [3] => M2.C;
ELSE
   M2.DESC^ [1] => M2.R;
   1 => M2.C
FI;
IF M1.K=4 THEN %10 => TYP ELSE 0 => TYP FI;
@BOX 3.1
IF FN = 8 OR FN = 9
@BOX 4.1
0 => FAULT;
IF M1.K /= 2 OR M2.K /= 2 THEN
  IF M1.K = 2 AND M2.K = 4 THEN
    IF M1.R /= M2.R THEN 1 => FAULT FI
  ELSE
    IF M2.K = 2 AND M1.K = 4 THEN
       IF M2.R /= M1.R THEN 1 => FAULT FI
    ELSE
       IF M1.C /= M2.R THEN 1 => FAULT FI
    FI
 FI
ELSE 1 => FAULT
FI;
IF FAULT = 1
@BOX 7.1
CHK.RES.MAT (SIZE(RES.MAT), RES.MAT.DESC, M1R, M2C, TYP);
@BOX 8.1
IF FN = 8 OR FN = 9
@BOX 9.1
$IN I,K,M1.I,R.I,S;
$RE32 SUM;
-1 => R.I;
FOR I < M1.R DO
   FOR K < M2.C DO
      0.0 => SUM;
      I * M1.C => M1.I;
      FOR S < M1.C DO
         M1^[S+M1.I]*M2^[S*M2.C+K] +> SUM;
      OD
      SUM => RES.MAT^[1+>R.I]
   OD
OD
@BOX 10.1
END
@BOX 11.1
BIO.EXCEPTION(%3);
@BOX 13.1
IF M1.R /= M2.R
@BOX 14.1
IF M1.C = M2.C
@BOX 15.1
BIO.EXCEPTION(%3);
@BOX 17.1
-1 => E.I;
FOR M1.R DO
   FOR M1.C DO
      1 +> E.I;
      IF FN = 9 THEN
         M1^[E.I] - M2^[E.I] => RES.MAT^[E.I]
      ELSE
         M1^[E.I] + M2^[E.I] => RES.MAT^[E.I]
      FI
   OD
OD
@END
///15
@TITLE BSC24.6(1,11)
@COL 11C
@COL 1S-2R-3T-4T-7R-8T-9R-10F
@COL 13T-14T-15C-17R
@ROW 11-7-15
@ROW 4-13
@ROW 9-17
@FLOW 1-2-3N-4N-7-8N-9-10
@FLOW 3Y-13N-14Y-7
@FLOW 4Y-11
@FLOW 8Y-17-10
@FLOW 13Y-15
@FLOW 14N-15
@BOX 1.0
BIO.MAT.R64.DYADIC (^MAT1, ^MAT1.DESC, ^MAT2, ^MAT2.DESC, ^RES.MAT,
                ^RES.MAT.DESC, FN)
FN = 8 MAT1 + MAT2 => RES
   = 9 MAT1 - MAT2 => RES
   =11 MAT1 * MAT2 => RES
@BOX 2.0
OBTAIN DIMENSIONALITY AND
DIMENSION SIZE OF MATRIX OPERANDS
@BOX 3.0
ADD OR SUBTRACT FUNCTIONS?
@BOX 4.0
MATRIX OPERANDS NOT COMPATIBLE?
@BOX 7.0
PERFORM DIMENSION CHECKS ON
RESULT MATRIX AND REDIMENSION
[BSC24.20]
@BOX 8.0
ADD OR SUBTRACT?
@BOX 9.0
COMPUTE MAT1 x MAT2
AND STORE TO RESULT
@BOX 10.0
END
@BOX 11.0
EXCEPTION
@BOX 13.0
ROWS NOT EQUAL?
@BOX 14.0
COLS EQUAL?
@BOX 15.0
EXCEPTION
@BOX 17.0
ADD/SUBTRACT MATRICES
AND STORE TO RESULT
@BOX 1.1
PROC BIO.MAT.R64.DYADIC (M1, M1.DESC, M2, M2.DESC, RES.MAT, RES.MAT.DESC, FN);
$IN M1.K, M1.R, M1.C, M2.K, M2.R, M2.C, E.I,TYP; $LO8 FAULT;
@BOX 2.1
IF SIZE (M1.DESC) => M1.K = 4 THEN
   M1.DESC^ [1] => M1.R;
   M1.DESC^ [3] => M1.C
ELSE
   M1.DESC^ [1] => M1.R;
   1 => M1.C
FI;
IF SIZE (M2.DESC) => M2.K = 4 THEN
   M2.DESC^ [1] => M2.R;
   M2.DESC^ [3] => M2.C;
ELSE
   M2.DESC^ [1] => M2.R;
   1 => M2.C
FI;
IF M1.K=4 THEN %10 => TYP ELSE 0 => TYP FI;
@BOX 3.1
IF FN = 8 OR FN = 9
@BOX 4.1
0 => FAULT;
IF M1.K /= 2 OR M2.K /= 2 THEN
  IF M1.K = 2 AND M2.K = 4 THEN
      IF M1.R /= M2.R THEN 1 => FAULT FI
   ELSE
      IF M2.K = 2 AND M1.K = 4 THEN
         IF M2.R /= M1.R THEN 1 => FAULT FI
      ELSE
         IF M1.C /= M2.R THEN 1 => FAULT FI
      FI
   FI
   ELSE 1 => FAULT
FI;
IF FAULT = 1
@BOX 7.1
CHK.RES.MAT (SIZE(RES.MAT), RES.MAT.DESC, M1R, M2C, TYP);
@BOX 8.1
IF FN = 8 OR FN = 9
@BOX 9.1
$IN I,K,M1.I,R.I,S;
$RE64 SUM;
-1 => R.I;
FOR I < M1.R DO
   FOR K < M2.C DO
      0.0 => SUM;
      I * M1.C => M1.I;
      FOR S < M1.C DO
         M1^[S+M1.I]*M2^[S*M2.C+K] +> SUM;
      OD
      SUM => RES.MAT^[1+>R.I];
   OD
OD
@BOX 10.1
END
@BOX 11.1
BIO.EXCEPTION(%3);
@BOX 13.1
IF M1.R /= M2.R
@BOX 14.1
IF M1.C = M2.C
@BOX 15.1
BIO.EXCEPTION(%3);
@BOX 17.1
-1 => E.I;
FOR M1.R DO
   FOR M1.C DO
      1 +> E.I;
      IF FN = 9 THEN
         M1^[E.I] - M2^[E.I] => RES.MAT^[E.I]
      ELSE
         M1^[E.I] + M2^[E.I] => RES.MAT^[E.I]
      FI
   OD
OD
@END
///15
@TITLE BSC24.7(1,11)
@COL 1S-7R-4R-5R-6F
@FLOW 1-7-4-5-6
@BOX 1.0
BIO.MAT.R32.SCALE (^MAT, ^MAT.DESC, ^RES.MAT, ^RES.MAT.DESC, SCALE)
@BOX 4.0
CHECK DIMENSION IF RESULT
MATRIX AND REDIMENSION
[BSC24.20]
@BOX 5.0
SCALE ELEMENTS OF MATRIX
AND PLACE IN RESULT MATRIX
@BOX 6.0
END
@BOX 7.0
DETERMINE IF MATRIX OR VECTOR
@BOX 1.1
PROC BIO.MAT.R32.SCALE (IN.MAT, IN.MAT.DESC, RES.MAT, RES.MAT.DESC, SCALE);
$LO8 K; $IN ROW, COL, E.I,SZ,TOT;
@BOX 4.1
IN.MAT.DESC ^[1] => ROW;
IF SZ = 4 THEN
   IN.MAT.DESC ^[3] => COL;
ELSE
   1 => COL;
FI
CHK.RES.MAT (SIZE (RES.MAT), RES.MAT.DESC, ROW, COL, K);
@BOX 5.1
ROW * COL => TOT;
FOR EI < TOT DO
   IN.MAT ^[E.I] * SCALE => RES.MAT ^[E.I];
OD
@BOX 6.1
END
@BOX 7.1
IF SIZE (IN.MAT.DESC) => SZ /= 4 THEN 0 => K
ELSE %10 => K FI;
@END
///15
@TITLE BSC24.8(1,11)
@COL 1S-7R-4R-5R-6F
@FLOW 1-7-4-5-6
@BOX 1.0
BIO.MAT.R64.SCALE (^MAT, ^MAT.DESC, ^RES.MAT, ^RES.MAT.DESC, SCALE)
@BOX 4.0
CHECK DIMENSION IF RESULT
MATRIX AND REDIMENSION
[BSC24.20]
@BOX 5.0
SCALE ELEMENTS OF MATRIX
AND PLACE IN RESULT MATRIX
@BOX 6.0
END
@BOX 7.0
DETERMINE IF MATRIX OR VECTOR
@BOX 1.1
PROC BIO.MAT.R64.SCALE (IN.MAT, IN.MAT.DESC, RES.MAT, RES.MAT.DESC, SCALE);
$LO8 K;$IN  ROW, COL, E.I,SZ,TOT;
@BOX 4.1
IN.MAT.DESC ^[1] => ROW;
IF SZ = 4 THEN
   IN.MAT.DESC ^[3] => COL;
ELSE
   1 => COL
FI
CHK.RES.MAT (SIZE (RES.MAT), RES.MAT.DESC, ROW, COL, K);
@BOX 5.1
ROW * COL => TOT;
FOR EI < TOT DO
   IN.MAT ^[E.I] * SCALE => RES.MAT ^[E.I];
OD
@BOX 6.1
END
@BOX 7.1
IF SIZE (IN.MAT.DESC) => SZ /= 4 THEN 0 => K
ELSE %10 => K FI;
@END
///17 12-AUG-83
@TITLE BSC24.9(1,11)
@COL 17C-15R
@COL 1S-16T-2R-3R-4R-5R-6T-18R-7R-8R-9R-10R-11T-12T-13R-14F
@ROW 17-4
@ROW 15-8
@FLOW 1-16N-2-3-4-5-6N-18-7-8-9-10-11N-12N-13-14
@FLOW 16Y-17
@FLOW 6Y-15-14
@FLOW 11Y-7
@FLOW 12Y-4
@BOX 1.0
BIO.DET.R32(MAT,MAT.DESC)DET
@BOX 2.0
COPY MAT TO TEMP MATRIX
INITIALISE VECTOR OF ROW POINTERS
INITIALISE RHS TO IDENTITY MATRIX
@BOX 3.0
INITIALISE I,J
NOTE SIGN OF DETERMINANT POSITIVE
@BOX 4.0
SELECT Jth ROW
@BOX 5.0
FIND LARGEST PIVOT ELEMENT
FROM Jth COLUMN
@BOX 6.0
PIVOT < EPSILON?
@BOX 7.0
SELECT NEXT ROW
@BOX 8.0
GET MULTIPLIER
@BOX 9.0
SUBTRACT MULT*PIVOTAL ROW
FROM Ith ROW
@BOX 10.0
UPDATE RHS
@BOX 11.0
MORE ROWS TO BE UPDATED?
@BOX 12.0
MORE ROWS LEFT?
@BOX 13.0
COMPUTE DETERMINANT
AND STORE IN GLOBAL
@BOX 14.0
END
@BOX 15.0
MATRIX IS SINGULAR
@BOX 16.0
MATRIX NOT SQUARE?
@BOX 17.0
EXCEPTION
@BOX 18.0
INTERCHANGE ROWS
AND REVERSE SIGN OF DETERMINANT
IF NECESSARY
@BOX 1.1
PROC BIO.DET.R32(M,MD);
$IN I,J,K,T,MAX,TEMP,N,KEY,IND,TOT;
$RE32 PIVOT,MULT,SSIGN;
@BOX 2.1
N *> TOT;
0 => KEY;
FOR T < TOT DO
   M^[T] => A32[T];
   0.0 => B32[T];
OD
FOR T < N DO
   KEY => R.KEYS[T];
   N +> KEY;
OD
FOR T < N DO
   1.0 => B32[R.KEYS[T]+T];
OD
@BOX 3.1
0 => I => J;
1.0 => SSIGN;
@BOX 4.1
J => MAX => K;
@BOX 5.1
WHILE 1 +> K < N DO
   IF ABSR32(A32[R.KEYS[K]+J]) > ABSR32(A32[R.KEYS[MAX]+J]) THEN
      K => MAX;
   FI
OD
@BOX 6.1
A32[R.KEYS[MAX]+J] => PIVOT;
IF ABSR32(PIVOT) < DET.TOL.R32
@BOX 7.1
R.KEYS[I] + J => IND;
@BOX 8.1
A32[IND] / PIVOT => MULT;
@BOX 9.1
$IN T1,T2;
J => K;
R.KEYS[I] => T1; R.KEYS[J] => T2;
WHILE 1 +> K < N DO
   A32[T1+K] - (MULT*A32[T2+K]) => A32[T1+K];
OD
@BOX 10.1
FOR K < N DO
   B32[T1+K] - (MULT*B32[T2+K]) => B32[T1+K];
OD
@BOX 11.1
IF 1 +> I < N
@BOX 12.1
IF 1 +> J < N-1
@BOX 13.1
1.0 => BIO.DET.R32;
FOR I < N DO
   A32[R.KEYS[I]+I] *> BIO.DET.R32;
OD
SSIGN *> BIO.DET.R32;
BIO.DET.R32 => LAST.INV.DET.R64;
@BOX 14.1
END
@BOX 15.1
0.0 => BIO.DET.R32;
@BOX 16.1
IF MD^[1] => N /= MD^[3] => TOT
@BOX 17.1
BIO.EXCEPTION(%4);
@BOX 18.1
IF MAX /= J THEN
   R.KEYS[J] => TEMP;
   R.KEYS[MAX] => R.KEYS[J];
   TEMP => R.KEYS[MAX];
   0.0 - SSIGN => SSIGN;
FI
J + 1 => I;
@END
///17 11-AUG-83
@TITLE BSC24.10(1,11)
@COL 17C-15R
@COL 1S-16T-2R-3R-4R-5R-6T-18R-7R-8R-9R-10R-11T-12T-13R-14F
@ROW 17-4
@ROW 15-8
@FLOW 1-16N-2-3-4-5-6N-18-7-8-9-10-11N-12N-13-14
@FLOW 16Y-17
@FLOW 6Y-15-14
@FLOW 11Y-7
@FLOW 12Y-4
@BOX 1.0
BIO.DET.R64(MAT,MAT.DESC)DET
@BOX 2.0
COPY MAT TO TEMP MATRIX
INITIALISE VECTOR OF ROW POINTERS
INITIALISE RHS TO IDENTITY MATRIX
@BOX 3.0
INITIALISE I,J
NOTE SIGN OF DETERMINANT POSITIVE
@BOX 4.0
SELECT Jth ROW
@BOX 5.0
FIND LARGEST PIVOT ELEMENT
FROM Jth COLUMN
@BOX 6.0
PIVOT < EPSILON?
@BOX 7.0
SELECT NEXT ROW
@BOX 8.0
GET MULTIPLIER
@BOX 9.0
SUBTRACT MULT*PIVOTAL ROW
FROM Ith ROW
@BOX 10.0
UPDATE RHS
@BOX 11.0
MORE ROWS TO BE UPDATED?
@BOX 12.0
MORE ROWS LEFT?
@BOX 13.0
COMPUTE DETERMINANT
AND STORE IN GLOBAL
@BOX 14.0
END
@BOX 15.0
MATRIX IS SINGULAR
@BOX 16.0
MATRIX NOT SQUARE?
@BOX 17.0
EXCEPTION
@BOX 18.0
INTERCHANGE ROWS
AND REVERSE SIGN OF DETERMINANT
IF NECESSARY
@BOX 1.1
PROC BIO.DET.R64(M,MD);
$IN I,J,K,T,MAX,TEMP,N,KEY,IND,TOT;
$RE64 PIVOT,MULT,SSIGN;
@BOX 2.1
N *> TOT;
0 => KEY;
FOR T < TOT DO
   M^[T] => A64[T];
   0.0 => B64[T];
OD
FOR T < N DO
   KEY => R.KEYS[T];
   N +> KEY;
OD
FOR T < N DO
   1.0 => B64[R.KEYS[T]+T];
OD
@BOX 3.1
0 => I => J;
1.0 => SSIGN;
@BOX 4.1
J => MAX => K;
@BOX 5.1
WHILE 1 +> K < N DO
   IF ABSR64(A64[R.KEYS[K]+J]) > ABSR64(A64[R.KEYS[MAX]+J]) THEN
      K => MAX;
   FI
OD
@BOX 6.1
A64[R.KEYS[MAX]+J] => PIVOT;
IF ABSR64(PIVOT) < DET.TOL.R64
@BOX 7.1
R.KEYS[I] + J => IND;
@BOX 8.1
A64[IND] / PIVOT => MULT;
@BOX 9.1
$IN T1,T2;
J => K;
R.KEYS[I] => T1; R.KEYS[J] => T2;
WHILE 1 +> K < N DO
   A64[T1+K] - (MULT*A64[T2+K]) => A64[T1+K];
OD
@BOX 10.1
FOR K < N DO
   B64[T1+K] - (MULT*B64[T2+K]) => B64[T1+K];
OD
@BOX 11.1
IF 1 +> I < N
@BOX 12.1
IF 1 +> J < N-1
@BOX 13.1
1.0 => BIO.DET.R64;
FOR I < N DO
   A64[R.KEYS[I]+I] *> BIO.DET.R64;
OD
SSIGN *> BIO.DET.R64;
BIO.DET.R64 => LAST.INV.DET.R64;
@BOX 14.1
END
@BOX 15.1
0.0 => BIO.DET.R64;
@BOX 16.1
IF MD^[1] => N /= MD^[3] => TOT
@BOX 17.1
BIO.EXCEPTION(%4);
@BOX 18.1
IF MAX /= J THEN
   R.KEYS[J] => TEMP;
   R.KEYS[MAX] => R.KEYS[J];
   TEMP => R.KEYS[MAX];
   0.0 - SSIGN => SSIGN;
FI
J + 1 => I;
@END
///4
@TITLE BSC24.12(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
BIO.C.DET.R64 () DET
@BOX 2.0
RETURN DETERMINANT OF LAST
MATRIX PRIOR TO INVERSION
@BOX 3.0
END
@BOX 1.1
PROC BIO.C.DET.R64;
@BOX 2.1
LAST.INV.DET.R64 => BIO.C.DET.R64;
@BOX 3.1
END
@END
///15
@TITLE BSC24.13(1,11)
@COL 1S-3T-4R-5F
@COL 7C
@ROW 4-7
@FLOW 1-3N-4-5
@FLOW 3Y-7
@BOX 1.0
BIO.DOT.R32 (^V1, ^V1.DESC, ^V2, ^V2.DESC) DOT
@BOX 3.0
V1 NOT SAME SIZE AS V2?
@BOX 4.0
COMPUTE DOT PRODUCT
@BOX 5.0
END
@BOX 6.0
EXCEPTION
@BOX 7.0
EXCEPTION
@BOX 1.1
PROC BIO.DOT.R32 (VEC1, VEC1.DESC, VEC2, VEC2.DESC);
$IN V1.SZ, V2.SZ,I;
@BOX 3.1
IF VEC1.DESC^ [1] => V1.SZ /=
   VEC2.DESC^ [1] => V2.SZ
@BOX 4.1
0.0 => BIO.DOT.R32;
FOR I < V1.SZ DO
   VEC1^[I] * VEC2^[I] +> BIO.DOT.R32;
OD
@BOX 5.1
END
@BOX 6.1
BIO.EXCEPTION(%2A);
@BOX 7.1
BIO.EXCEPTION(%4);
@END
///15
@TITLE BSC24.14(1,11)
@COL 1S-3T-4R-5F
@COL 7C
@ROW 4-7
@FLOW 1-3N-4-5
@FLOW 3Y-7
@BOX 1.0
BIO.DOT.R64 (^V1, ^V1.DESC, ^V2, ^V2.DESC) DOT
@BOX 3.0
V1 NOT SAME SIZE AS V2?
@BOX 4.0
COMPUTE DOT PRODUCT
@BOX 5.0
END
@BOX 6.0
EXCEPTION
@BOX 7.0
EXCEPTION
@BOX 1.1
PROC BIO.DOT.R64 (VEC1, VEC1.DESC, VEC2, VEC2.DESC);
$IN V1.SZ, V2.SZ,I;
@BOX 3.1
IF VEC1.DESC^ [1] => V1.SZ /=
   VEC2.DESC^ [1] => V2.SZ
@BOX 4.1
0.0 => BIO.DOT.R64;
FOR I < V1.SZ DO
   VEC1^[I] * VEC2^[I] +> BIO.DOT.R64;
OD
@BOX 5.1
END
@BOX 6.1
BIO.EXCEPTION(%2A);
@BOX 7.1
BIO.EXCEPTION(%4);
@END
///15
@TITLE BSC24.20(1,11)
@COL 10T-12C
@COL 1S-2T-3T-4T-5T-6R-7T-8R-9F
@COL 14C
@ROW 6-14
@ROW 10-4
@ROW 12-8
@FLOW 1S-2T-3T-4T-5T-6R-7T-8-9
@FLOW 2Y-10N-12
@FLOW 3Y-12
@FLOW 4Y-14
@FLOW 5Y-14
@FLOW 7Y-12
@FLOW 10Y-5
@BOX 1.0
CHK.RES.MAT (SIZE, ^RES.MAT.DESC, ROW, COL, KIND)
@BOX 2.0
VECTOR VALUE REQUIRED?
@BOX 3.0
NOT MATRIX STORAGE?
@BOX 4.0
COL =< 0?
@BOX 5.0
ROW =< 0?
@BOX 6.0
COMPUTE TOTAL NUMBER
OF ELEMENTS REQUIRED
@BOX 7.0
NOT ENOUGH STORAGE?
@BOX 8.0
UPDATE RESULT DESCRIPTOR
@BOX 9.0
END
@BOX 10.0
VECTOR STORAGE?
@BOX 12.0
EXCEPTION
@BOX 14.0
EXCEPTION
@BOX 1.1
PROC CHK.RES.MAT (SZ, RES.DESC, ROW, COL, KIND);
$IN TOT.EL;
@BOX 2.1
IF KIND & %10 = 0
@BOX 3.1
IF SIZE (RES.DESC) /= 4
@BOX 4.1
IF COL =< 0
@BOX 5.1
IF ROW =< 0
@BOX 6.1
ROW * COL => TOT.EL;
@BOX 7.1
IF TOT.EL > SZ
@BOX 8.1
ROW => RES.DESC ^[1];
IF KIND & %10 /= 0 THEN
   COL => RES.DESC ^[3];
FI
@BOX 9.1
END
@BOX 10.1
IF SIZE (RES.DESC) = 2
@BOX 12.1
BIO.EXCEPTION(%7);
@BOX 14.1
BIO.EXCEPTION(%2B);
@END
///15
@TITLE BSC24.29(1,11)
@COL 1S-2R-3R-4F
@FLOW 1-2-3-4
@BOX 1.0
BIO.SIZE(M.DESC)SIZE
@BOX 2.0
DETERMINE DIMENSIONALITY OF ARRAY
@BOX 3.0
COMPUTE TOTAL NUMBER
OF VALUES IN ARRAY
@BOX 4.0
END
@BOX 1.1
PROC BIO.SIZE(DESC);
$IN D1,D2;
@BOX 2.1
DESC^[1] => D1;
IF SIZE(DESC) = 4 THEN
   DESC^[3] => D2;
ELSE
   1 => D2;
FI
@BOX 3.1
D1 * D2 => BIO.SIZE;
@BOX 4.1
END
@END
//15
@TITLE BSC24.30(1,11)
@COL 6C
@COL 1S-2T-3T-4R-5F
@COL 7C
@ROW 6-4-7
@FLOW 1-2N-3N-4-5
@FLOW 2Y-6
@FLOW 3Y-7
@BOX 1.0
BIO.L.BOUND(MAT.DESC,N) VALUE
@BOX 2.0
N < 1?
@BOX 3.0
GET DIMENSIONALITY FROM
MATRIX DESCRIPTOR
N > NO. OF DIMENSIONS?
@BOX 4.0
DETERMINE LOWER BOUND
@BOX 5.0
END
@BOX 6.0
EXCEPTION
@BOX 7.0
EXCEPTION
@BOX 1.1
PROC BIO.L.BOUND (M.DESC,N);
$IN SZ;
@BOX 2.1
IF N  <1
@BOX 3.1
SIZE (M.DESC) => SZ;
IF N > SZ ->> 1
@BOX 4.1
IF N = 1 THEN
   M.DESC^[0] => BIO.L.BOUND
ELSE
   M.DESC^[2] => BIO.L.BOUND
FI
@BOX 5.1
END
@BOX 6.1
BIO.EXCEPTION(%30);
@BOX 7.1
BIO.EXCEPTION(%31);
@END
//15
@TITLE BSC24.31(1,11)
@COL 6C
@COL 1S-2T-3T-4R-5F
@COL 7C
@ROW 6-4-7
@FLOW 1-2N-3N-4-5
@FLOW 2Y-6
@FLOW 3Y-7
@BOX 1.0
BIO.U.BOUND (MAT.DESC,N) VALUE
@BOX 2.0
N < 1?
@BOX 3.0
GET DIMENSIONALITY FROM
MATRIX DESCRIPTOR
N > NO. OF DIMENSIONS?
@BOX 4.0
DETERMINE UPPER BOUND
@BOX 5.0
END
@BOX 6.0
EXCEPTION
@BOX 7.0
EXCEPTION
@BOX 1.1
PROC BIO.U.BOUND (M.DESC,N);
$IN SZ;
@BOX 2.1
IF N < 1
@BOX 3.1
SIZE(M.DESC) => SZ;
IF N > SZ ->> 1
@BOX 4.1
IF N = 1 THEN
   M.DESC^[0] + M.DESC^[1]-1 => BIO.U.BOUND
ELSE
   M.DESC^[2] + M.DESC^[3]-1 => BIO.U.BOUND
FI
@BOX 5.1
END
@BOX 6.1
BIO.EXCEPTION(%32);
@BOX 7.1
BIO.EXCEPTION(%33);
@END
///15
@TITLE BSC24.32(1,11)
@COL 6C
@COL 1S-2T-3T-4R-5F
@COL 7C
@ROW 6-4-7
@FLOW 1-2N-3N-4-5
@FLOW 2Y-6
@FLOW 3Y-7
@BOX 1.0
BIO.D.SIZE(MAT.DESC,N)VALUE
@BOX 2.0
N < 1?
@BOX 3.0
DETERMINE DIMENSIONALITY OF
MATRIX
N > NO. OF DIMS?
@BOX 4.0
DETERMINE NUMBER OF
PERMISSABLE VALUES
@BOX 5.0
END
@BOX 6.0
EXCEPTION
@BOX 7.0
EXCEPTION
@BOX 1.1
PROC BIO.D.SIZE(M.DESC,N);
$IN SZ;
@BOX 2.1
IF N < 1
@BOX 3.1
SIZE(M.DESC) => SZ;
IF N > SZ ->> 1
@BOX 4.1
IF N = 1 THEN
   M.DESC^[1] => BIO.D.SIZE
ELSE
   M.DESC^[3] => BIO.D.SIZE
FI
@BOX 5.1
END
@BOX 6.1
BIO.EXCEPTION(%34);
@BOX 7.1
BIO.EXCEPTION(%35);
@END
///14
@TITLE BSC24.33(1,11)
@COL 19R
@COL 1S-15R-2T-14T-3T-4R-6T-20R-7R-8T-16T-17R-9R-18R-10R-11T-12F
@COL 13C
@ROW 19-9
@ROW 10-13
@FLOW 1-15-2N-14N-3N-4-2Y-6N-20-7-8N-16N-17-9-18-10-11N-12
@FLOW 6Y-7
@FLOW 16Y-19-10
@FLOW 14Y-2
@FLOW 3Y-2
@FLOW 8Y-13
@FLOW 11Y-6
@BOX 1.0
BIO.STR.ASS([STR.INFO],LHS.CNT,RHS.CNT)
@BOX 2.0
NO MORE R.H.S ITEMS?
@BOX 3.0
NORMALISE SUBSTRING SPECIFIERS
NULL SUBSTRING?
@BOX 4.0
EXTRACT SUBSTRING AND
ACCUMULATE IN TEMP VECTOR
@BOX 6.0
GET LHS ITEM
SET SIZE TO STORAGE FOR STR
NOT SUBSTRING OF STR STORAGE?
@BOX 7.0
NORMALISE SUBSTRING SPECIFIERS
@BOX 8.0
SIZE OF RHS RESULT >
SIZE OF LHS STORAGE?
@BOX 9.0
COPY RHS RESULT TO LHS ITEM
@BOX 10.0
UPDATE BOUND OF LHS ITEM
@BOX 11.0
MORE LHS ITEMS?
@BOX 12.0
END
@BOX 13.0
EXCEPTION
@BOX 14.0
GET RHS ITEM
NULL ITEM?
@BOX 15.0
INITIALISATION
@BOX 16.0
APPENDING TO END
OF STRING ?
@BOX 17.0
SAVE REMAINDER OF STRING
AFTER SUBSTRING IN TEMP VEC
@BOX 18.0
APPEND REMAINDER OF STRING
@BOX 19.0
APPEND STRING TO LHS
@BOX 20.0
SET SIZE TO STR VALUE
@BOX 1.1
PROC BIO.STR.ASS(STR.VEC,L.CNT,R.CNT);
$LO8 CH; ::DEBUG
$IN L.I, R.I, L.SZ, R.SZ, S.I, M, N, VEC.Z, I,
    J, K, T.I, NEW.SZ;
$LO8 [256] T.STR, T2;
@BOX 2.1
IF 1 +> R.I = VEC.Z
@BOX 3.1
LOWER OF STR.VEC ^[R.I] => M;
UPPER OF STR.VEC ^[R.I] => N;
IF M < 1 THEN 1 => M FI;
IF N > R.SZ THEN R.SZ => N FI;
IF M > N
@BOX 4.1
WHILE M =< N DO
   PTR^[M] OF STR.VEC ^[R.I] => CH  => T.STR[1+>S.I];
   1 +> M;
OD;
@BOX 6.1
SELECT STR.VEC ^[L.I];
LOWER => M;
UPPER => N;
SIZE(PTR) - 1 => L.SZ;
IF M =< 1 AND N >= L.SZ
@BOX 7.1
IF M < 1 THEN 1 => M FI;
IF N > L.SZ THEN L.SZ => N FI;
IF M>N THEN
   IF M =< L.SZ THEN M => N
   ELSE L.SZ+1 => M => N
   FI
FI
@BOX 8.1
IF L.SZ -(N-M)+S.I => NEW.SZ > SIZE(PTR)
@BOX 9.1
M - 1 => J;
FOR K < S.I + 1 DO
   T.STR [K] => PTR ^[1 +> J];
OD;
@BOX 10.1
NEW.SZ => PTR ^[0];
@BOX 11.1
IF 1 +> L.I < L.CNT
@BOX 12.1
END
@BOX 13.1
BIO.EXCEPTION(%4D);
@BOX 14.1
IF PTR^[0] OF STR.VEC ^[R.I] => R.SZ = 0
@BOX 15.1
L.CNT + R.CNT => VEC.Z;
L.CNT-1 => R.I;
0 => L.I;
-1  => S.I;
@BOX 16.1
IF M = N = L.SZ+1
@BOX 17.1
N => I;  -1 => T.I;
WHILE 1 +> I =< L.SZ DO
   PTR^ [I] => CH => T2 [1 +> T.I];
OD
@BOX 18.1
FOR K < T.I + 1 DO
   T2 [K] => CH => PTR^ [1 +> J];
OD;
@BOX 19.1
L.SZ => J;
FOR K < S.I + 1 DO
   T.STR [K] => CH => PTR ^[1 +> J];
OD
1 +> NEW.SZ;
@BOX 20.1
PTR ^[0] => L.SZ;
@END
///10
@TITLE BSC24.34(1,11)
@COL 1S-2R-3R-4T-5T-6R-20T-7R-8T-9T-10R-21T-11R-12T-13R-14F
@COL 22T-15T-16R-23T-17T-18R
@ROW 6-22
@ROW 10-23
@FLOW 1-2-3-4N-5N-6-20N-7-8N-9N-10-21N-11-12N-13-14
@FLOW 20Y-5
@FLOW 21Y-9
@FLOW 4Y-7
@FLOW 5Y-22N-15N-16-13
@FLOW 8Y-11
@FLOW 9Y-23N-17N-18-13
@FLOW 22Y-16
@FLOW 23Y-18
@FLOW 12Y-4
@FLOW 15Y-13
@FLOW 17Y-13
@BOX 1.0
BIO.STR.COMP([STR.INFO],LHS.CNT,RHS.CNT) COND
   RETURNS  0 IF L.STR = R.STR
           -1 IF L.STR < R.STR

            1 OTHERWISE
@BOX 2.0
SET RESULT TO =
GET TOTAL NO. OF
LHS AND RHS ITEMS
@BOX 3.0
SET SUBSTRINGS FOR FIRST LHS & RHS ITEMS
@BOX 4.0
MORE CHARS IN CURRENT
L.H.S. ITEM?
@BOX 5.0
NO MORE L.H.S. ITEMS?
@BOX 6.0
GET NEXT ITEM AND
NORMALISE SUBSTRING
@BOX 7.0
GET NEXT LHS CHAR
@BOX 8.0
MORE CHARS IN CURRENT
R.H.S. ITEM?
@BOX 9.0
NO MORE R.H.S. ITEMS?
@BOX 10.0
GET NEXT ITEM &
NORMALISE SUBSTRINGS
@BOX 11.0
GET NEXT RHS CHAR
@BOX 12.0
COMPARE CHARACTERS
EQUAL?
@BOX 13.0
RETURN RESULT
@BOX 14.0
END
@BOX 15.0
NO MORE NON-NULL
RHS CHARS LEFT?
@BOX 16.0
MAKE RESULT <
@BOX 17.0
NO MORE NON-NULL
L.H.S. CHARS LEFT?
@BOX 18.0
MAKE RESULT >
@BOX 20.0
NULL SUBSTRING ?
@BOX 21.0
NULL SUBSTRING ?
@BOX 22.0
MORE RHS CHARS IN
CURRENT ITEM ?
@BOX 23.0
MORE LHS CHARS IN
CURRENT ITEM ?
@BOX 1.1
PROC BIO.STR.COMP (STR.VEC, L.CNT, R.CNT);
$IN L.I, R.I, L.M, L.N, R.M, R.N,
    L.SZ, R.SZ, VEC.SZ;
$IN16 RES;
$LO8 L.CH, R.CH, CHARS;
@BOX 2.1
0 => RES; L.CNT + R.CNT => VEC.SZ;
@BOX 3.1
0 => L.I; L.CNT => R.I;
BEGIN
   SELECT STR.VEC ^[L.I];
   LOWER => L.M; UPPER => L.N;
   PTR ^[0] => L.SZ;
   IF L.M < 1 THEN 1 => L.M FI;
   IF L.N > L.SZ THEN L.SZ => L.N FI;
END
BEGIN
   SELECT STR.VEC ^[R.I];
   LOWER => R.M; UPPER => R.N;
   PTR ^[0] => R.SZ;
   IF R.M < 1 THEN 1 => R.M FI;
   IF R.N > R.SZ THEN R.SZ => R.N FI;
END
@BOX 4.1
IF L.M =< L.N
@BOX 5.1
IF 1 +> L.I = L.CNT
@BOX 6.1
BEGIN
   SELECT STR.VEC^ [L.I];
   PTR ^[0] => L.SZ;
   LOWER => L.M; UPPER => L.N;
    IF L.M < 1 THEN 1 => L.M FI;
    IF L.N > L.SZ THEN L.SZ => L.N FI;
END
@BOX 7.1
PTR ^[L.M] OF STR.VEC ^[L.I] => L.CH;
1 +> L.M;
@BOX 8.1
IF R.M =< R.N
@BOX 9.1
IF 1 +> R.I = VEC.SZ
@BOX 10.1
BEGIN
   SELECT STR.VEC ^[R.I];
   PTR ^[0] => R.SZ;
   LOWER => R.M; UPPER => R.N;
   IF R.M < 1 THEN 1 => R.M FI;
   IF R.N > R.SZ THEN R.SZ => R.N FI;
END
@BOX 11.1
PTR ^[R.M] OF STR.VEC ^[R.I] => R.CH;
1 +> R.M;
@BOX 12.1
IF L.CH = R.CH THEN 0 => RES
ELSE
   IF L.CH < R.CH THEN -1 => RES
   ELSE 1 => RES
   FI
FI
IF RES = 0
@BOX 13.1
RES => BIO.STR.COMP;
@BOX 14.1
END
::OF BIO.STR.COMP
@BOX 15.1
0 => CHARS;
WHILE 1 +> R.I < VEC.SZ AND CHARS = 0 DO
   BEGIN
   SELECT STR.VEC ^[R.I];
   PTR ^[0] => R.SZ;
   LOWER => R.M; UPPER => R.N;
   IF R.M < 1 THEN 1 => R.M FI;
   IF R.N > R.SZ THEN R.SZ => R.N FI;
   IF R.M =< R.N THEN 1 => CHARS FI
   END
OD
IF CHARS = 0
@BOX 16.1
-1 => RES;
@BOX 17.1
0 => CHARS;
WHILE 1 +> L.I <  L.CNT AND CHARS = 0 DO
   BEGIN
   SELECT STR.VEC ^[L.I];
   PTR ^[0] => L.SZ;
   LOWER => L.M;  UPPER => L.N;
   IF L.M < 1 THEN 1 => L.M FI;
   IF L.N > L.SZ THEN L.SZ => L.N FI;
   IF L.M =< L.N THEN 1 => CHARS FI;
   END
OD
IF CHARS = 0
@BOX 18.1
1 => RES;
@BOX 20.1
IF L.M > L.N
@BOX 21.1
IF R.M > R.N
@BOX 22.1
IF R.M =< R.N
@BOX 23.1
IF L.M =< L.N
@END
///15
@TITLE BSC24.35(1,11)
@COL 14R-27R
@COL 1S-2T-3R-4T-6T-7T-26R-8R-10R-28T-30F
@COL 23C
@COL 24R
@ROW 14-3
@ROW 7-24
@ROW 27-8
@ROW 26-23
@FLOW 1-2N-3-4N-6N-7N-26-8-10-28N-30
@FLOW 2Y-14-4Y-24-30
@FLOW 6Y-27-30
@FLOW 7Y-23
@FLOW 28Y-8
@BOX 1.0
BIO.MAT.STR.ASS ([MAT.DATA], RHS.CNT)
@BOX 2.0
LHS WITHOUT SUBSTR ?
@BOX 3.0
GET LHS SUBSTRING SPEC
@BOX 4.0
MORE THAN ONE RHS ITEM ?
@BOX 6.0
STRING ARRAY VALUE ?
@BOX 7.0
(MUST BE S.A.P.)
GET RHS SUBSTRING SPEC
REDIMENSION
ERROR ?
@BOX 8.0
EXTRACT OPTIONAL SUBSTRING
FROM RHS ELEMENT
@BOX 10.0
ASSIGN RHS STRING TO
SUBSTRING OF LHS ELEMENT
[BSC24.35.3]
@BOX 13.0
EXCEPTION
@BOX 14.0
SET SPECIFIER FOR
WHOLE STR
@BOX 23.0
EXCEPTION
@BOX 24.0
PROCESS TWO RHS ITEMS
[BSC24.35.1]
@BOX 26.0
UPDATE RESULT
ARRAY DESCRIPTOR
INIT ARRAY INDEX
@BOX 27.0
PROCESS STRING ARRAY VALUE
ASSIGNMENT
[BSC24.35.0]
@BOX 28.0
NOT END ?
@BOX 29.0
@BOX 30.0
END
@BOX 31.0
EXCEPTION
@BOX 1.1
PROC BIO.MAT.STR.ASS (MD, R.CNT);
ADDR [$LO8] R.PTR;
$LO8 [MAX.STR.Z] TEMP, TMP2;
$IN L.SZ, L.K, L.M, L.N, L.DIM,
    R1.K, R1.M, R1.N,L.R,L.C,L.TOT,
    R2.K, R2.M, R2.N,R.STR.Z,
    I, J, P, Q, LIMIT, T.I, NEW.Z, CNT,
    R,C,D,M,N,L.SUBS;
@BOX 2.1
BEGIN
SELECT MD^[0];
KIND => L.K;
1 => L.C;
MAT.DESC^[1] => L.R;
IF SIZE(MAT.DESC) => L.DIM = 4 THEN
   MAT.DESC^[3] => L.C;
FI
L.R * L.C => L.TOT;
SIZE(PTR) / EL.SZ => L.SZ;
END
IF L.K & %1 => L.SUBS = 0
@BOX 3.1
BEGIN
SELECT MD^[0];
LOWER => L.M;
UPPER => L.N;
IF L.M < 1 THEN 1 => L.M FI;
END
@BOX 4.1
IF R.CNT > 1
@BOX 6.1
IF KIND OF MD^[1] => R1.K
   & %E >= 4
@BOX 7.1
BEGIN
SELECT MD^[1];
IF R1.K & %1 /= 0 THEN
   LOWER => R1.M;
   UPPER => R1.N;
ELSE
   1 => R1.M;
   EL.SZ => R1.N;
FI;
IF R1.M < 1 THEN 1 => R1.M FI;
1 => C;
MAT.DESC ^[1] => R;
IF L.DIM = 4 THEN
   MAT.DESC^[3] => C;
FI;
END
IF C * R => LIMIT > L.SZ
@BOX 8.1
BEGIN
R1.M => M; R1.N => N;
SELECT MD ^[1];
IF N > PTR^[J]  => R.STR.Z THEN
   R.STR.Z => N FI;
IF M > N THEN NIL.L8 => R.PTR
ELSE PART(PTR,J+M,J+N) => R.PTR
FI;
END
@BOX 10.1
#BSC24.35.3
@BOX 14.1
1 => L.M;
EL.SZ OF MD^[0] => L.N;
@BOX 23.1
BIO.EXCEPTION(%7);
@BOX 24.1
#BSC24.35.1
@BOX 25.1
@BOX 26.1
BEGIN
SELECT MD^[0];
R => MAT.DESC^[1];
IF L.DIM = 4 THEN
   C => MAT.DESC^[3];
FI
END
0 => CNT => J;
@BOX 27.1
#BSC24.35.0
@BOX 28.1
IF 1 +> CNT < LIMIT
@BOX 30.1
END
@BOX 31.1
BIO.EXCEPTION(%40);
@END
///15
@TITLE BSC24.35.0(1,11)
@COL 9C
@COL 1S-2T-3T-10R-4R-6R-7T-8F
@ROW 9-4
@FLOW 1-2N-3N-10-4-6-7N-8
@FLOW 2Y-4
@FLOW 3Y-9
@FLOW 7Y-6
@BOX 1.0
PROCESS RHS CONSISTING OF
STRING ARRAY VALUE(NULL) WITH
OPTIONAL SCALAR STRING VALUE
@BOX 2.0
NO EXPLICIT INDECES SPECIFIED FOR RHS ARRAY ?
@BOX 3.0
PICK UP SPECIFIED DIMENSIONS
OF RHS AND REDIMENSION
ERROR ?
@BOX 4.0
INITIALISE ARRAY INDEX
@BOX 6.0
ASSIGN OPTIONAL SSV
TO LHS ELEMENT
[BSC24.35.3]
@BOX 7.0
NOT END ?
@BOX 8.0
END
@BOX 9.0
EXCEPTION
@BOX 10.0
UPDATE RESULT MATRIX DESCRIPTOR
@BOX 1.1
BEGIN
SELECT MD^[0];
@BOX 2.1
L.TOT => LIMIT;
IF R1.K & %E  > 6
@BOX 3.1
1 => C;
LOWER OF MD^[1] => R;
IF R1.K & %E = %6 THEN
   UPPER OF MD^[1] => C;
FI;
IF C * R => LIMIT > L.SZ
@BOX 4.1
0 => CNT => J;
PART(PTR OF MD^[1],1,PTR^[0] OF MD^[1]) => R.PTR;
@BOX 6.1
#BSC24.35.3
@BOX 7.1
IF 1 +> CNT < LIMIT
@BOX 9.1
BIO.EXCEPTION(%7);
@BOX 8.1
END
@BOX 10.1
R => MAT.DESC^[1];
IF L.DIM = 4 THEN
   C => MAT.DESC^[3];
FI
@END
///16
@TITLE BSC24.35.1(1,11)
@COL 16C
@COL 1S-2T-3R-4R-5T-22R-7R-8R-9R-12R-13T-14F
@COL 21R
@ROW 5-21
@ROW 16-22
@FLOW 1-2N-3-4-5N-22-7-8-9-12-13N-14
@FLOW 13Y-8
@FLOW 2Y-21-14
@FLOW 5Y-16
@BOX 1.0
PROCESS TWO RHS ITEMS
@BOX 2.0
BOTH RHS ITEMS STRING-
ARRAY PRIMARIES ?
@BOX 3.0
(NOW HAVE SSV & SAP OR SAP & SSV)
SELECT RHS ITEM WHICH
IS STRING-ARRAY-PRIMARY
@BOX 4.0
GET SIZE OF RHS ITEM
AND KIND
@BOX 5.0
REDIMENSION
ERROR ?
@BOX 7.0
GET SUBSTRING SPEC OF STRING-
ARRAY-PRIMARY
@BOX 8.0
EXTRACT OPTIONAL SUBSTRING
FROM RHS ELEMENT
@BOX 9.0
PREFIX OR SUFFIX STRING-
ARRAY-VALUE
@BOX 12.0
ASSIGN TO LHS ELEMENT
[BSC24.35.3]
@BOX 13.0
NOT END ?
@BOX 14.0
END
@BOX 16.0
EXCEPTION
@BOX 21.0
PROCESS RHS CONSISTING
OF TWO STRING-ARRAY-
PRIMARIES
[BSC24.35.2]
@BOX 22.0
UPDATE RESULT
MATRIX DESCRIPTOR
@BOX 1.1
ADDR [$LO8] SSV;
$IN A,B,T,TST,SSV.Z,S,LIM,JA;
@BOX 2.1
IF KIND OF MD^[1] => R1.K & %E => T  = 0 AND
   KIND OF MD^[2] => R2.K & %E  = 0
@BOX 3.1
IF T /= 2 THEN ::IE NOT SSV
   1 => A; 2 => B;
ELSE
   2 => A; 1 => B;
FI
@BOX 4.1
SIZE(MAT.DESC OF MD^[A]) => TST;
@BOX 5.1
BEGIN
SELECT MD^[A];
1 => C;
MAT.DESC^[1] => R;
IF TST = 4 THEN
   MAT.DESC^[3] => C
FI
END
IF R * C => LIMIT > L.SZ
@BOX 7.1
BEGIN
SELECT MD^[A];
IF KIND & %1 /= 0 THEN
   LOWER => R1.M;
   UPPER => R1.N;
ELSE
   1 => R1.M; EL.SZ => R1.N
FI
IF R1.M < 1 THEN 1 => R1.M FI;
PTR ^[0] OF MD^[B] => SSV.Z;
PART (PTR OF MD^[B],1,SSV.Z) => SSV;
END
0 => J => JA => CNT;
@BOX 8.1
BEGIN
R1.M => M; R1.N => N;
SELECT MD^[A];
IF N > PTR^[JA] => R.STR.Z THEN
   R.STR.Z => N FI;
SSV.Z - 1 => T.I;
M + JA => I; T.I + 1 => S;
WHILE M =< N DO
PTR^[I] => TEMP[1 +> T.I];
1 +> I; 1 +> M;
OD
EL.SZ +> JA;
END
@BOX 9.1
IF A = 2 THEN
   TI => LIM; -1 => TI;
   0 => S;
ELSE SSV.Z + T.I => LIM
FI
FOR I < SSV.Z DO
   SSV ^[I] => TEMP [1 +> T.I]
OD
PART(^TEMP, S, LIM) => R.PTR;
@BOX 12.1
#BSC24.35.3
@BOX 13.1
IF 1 +> CNT < LIMIT
@BOX 14.1
::END
@BOX 16.1
BIO.EXCEPTION(%7);
@BOX 21.1
#BSC24.35.2
@BOX 22.1
BEGIN
SELECT MD^[0];
R => MAT.DESC^[1];
IF L.DIM=4 THEN
C => MAT.DESC^[3];
FI
END
@END
///15
@TITLE BSC24.35.2(1,11)
@COL 1S-3T-4T-17R-5R-16R-6R-15R-9R-10T-14F
@COL 12C-13C
@ROW 12-4
@FLOW 1-3N-4N-17-5-16-6-15-9-10N-14
@FLOW 3Y-12
@FLOW 4Y-13
@FLOW 10Y-6
@BOX 1.0
PROCESS RHS CONSISTING OF TWO
STRING-ARRAY-PRIMARIES
@BOX 3.0
NOT SAME SIZE IN
EACH DIMENSION
@BOX 4.0
REDIMENSION
ERROR ?
@BOX 5.0
GET SUBSTRING SPECIFIERS
FOR EACH ARRAY
@BOX 6.0
EXTRACT SUBSTRING FROM
FIRST RHS ARRAY AND STORE
IN TEMP VECTOR
@BOX 9.0
ASSIGN TO LHS ELEMENT
[BSC24.35.2]
@BOX 10.0
NOT END ?
@BOX 12.0
EXCEPTION
@BOX 13.0
EXCEPTION
@BOX 14.0
END
@BOX 15.0
EXTRACT SUBSTRING FROM 2ND
RHS ARRAY AND APPEND TO TEMP VECTOR
@BOX 16.0
INITIALISE ARRAY INDECES
@BOX 17.0
UPDATE RESULT
MATRIX DESCRIPTOR
@BOX 1.1
::BEGIN
$IN OK,JR1,JR2;
@BOX 3.1
1 => OK => C;
IF MAT.DESC^[1] OF MD^[1] => R /=
   MAT.DESC^[1] OF MD^[2] THEN
      0 => OK
FI
IF OK = 1 AND L.DIM = 4 THEN
   IF MAT.DESC^[3] OF MD^[1] => C /=
      MAT.DESC^[3] OF MD^[2] THEN
         0 => OK
   FI
FI
IF OK = 0
@BOX 4.1
IF C * R => LIMIT > L.SZ
@BOX 5.1
IF R1.K & %1 /= 0 THEN
   IF LOWER OF MD^[1] => R1.M < 1 THEN 1 => R1.M FI;
   UPPER OF MD^[1] => R1.N;
ELSE
   1 => R1.M; EL.SZ OF MD^[1] => R1.N;
FI
IF R2.K & %1 /= 0 THEN
   IF LOWER OF MD^[2] => R2.M < 1 THEN 1 => R2.M FI;
   UPPER OF MD^[2] => R2.N;
ELSE
   1 => R2.M; EL.SZ OF MD^[2] => R2.N;
FI
@BOX 6.1
BEGIN
R1.N => N; R1.M => M;
SELECT MD^[1];
IF N > PTR^[JR1] => R.STR.Z THEN
   R.STR.Z => N FI;
-1 => TI; M + JR1 => I;
WHILE M =< N DO
   PTR^[I] => TEMP [1+>T.I];
   1 +> M; 1 +> I;
OD
EL.SZ +> JR1;
END
@BOX 15.1
BEGIN
R2.M => M; R2.N => N;
SELECT MD^[2];
IF N > PTR^[JR2] => R.STR.Z THEN
   R.STR.Z => N FI;
M + JR2 => I;
WHILE M =< N DO
   PTR^[I] => TEMP [1+>T.I];
   1 +> M;  1 +> I;
OD
EL.SZ +> JR2;
END
@BOX 9.1
PART (^TEMP,0,T.I) => R.PTR;
#BSC24.35.3
@BOX 10.1
IF 1 +> CNT < LIMIT
@BOX 12.1
BIO.EXCEPTION(%3);
@BOX 13.1
BIO.EXCEPTION(%7);
@BOX 14.1
::END
@BOX 16.1
0 => J => CNT => JR1 => JR2;
@BOX 17.1
BEGIN
SELECT MD^[0];
R => MAT.DESC^[1];
IF L.DIM=4 THEN
   C => MAT.DESC^[3];
FI
END
@END
///16
@TITLE BSC24.35.3(1,11)
@COL 8R
@COL 1S-2R-3T-4T-9T-10R-5R-6F
@COL 7C-11R
@ROW 4-7
@ROW 8-9
@ROW 10-11
@FLOW 1-2-3N-4N-9N-10-5-6
@FLOW 3Y-7
@FLOW 4Y-8-5
@FLOW 9Y-11-5
@BOX 1.0
ASSIGN STRING POINTED TO BY BOUNDED POINTER "R.PTR"
TO CURRENT LHS ARRAY ELEMENT(PTR), INDEXED BY J,
 WITH SUBSTRING SPECIFIED BY L.M AND L.N
@BOX 2.0
EXTRACT SUBSTRING FROM LHS ELEMENT
@BOX 3.0
PICK UP SIZE OF LHS ELEMENT,EITHER
FROM BYTE 0 IF SUBSTRING PRESENT,
OR MAX ELEMENT SIZE
WILL ASSIGMENT CAUSE
STRING OVERFLOW ?
@BOX 4.0
APPENDING TO LHS ELEMENT ?
@BOX 5.0
UPDATE BYTE COUNT OF
LHS ELEMENT
@BOX 6.0
END
@BOX 7.0
EXCEPTION
@BOX 8.0
APPEND
@BOX 9.0
WHOLE OF LHS ELEMENT SPECIFIED ?
@BOX 10.0
ASSIGN TO SUBSTRING
@BOX 11.0
ASSIGN TO ENTIRE ELEMENT
@BOX 1.1
BEGIN
$IN LE.Z;
L.N => N; L.M => M;
SELECT MD ^[0];
@BOX 2.1
IF L.SUBS = 0 THEN
   EL.SZ => LE.Z
ELSE
   PTR^[J] => LE.Z
FI
IF N > LE.Z THEN
   LE.Z => N FI;
IF M > N THEN
   IF M =< LE.Z THEN M => N
   ELSE LE.Z+1 => M  => N
   FI
FI
@BOX 3.1
IF LE.Z - (N-M) - 1 +
   SIZE(R.PTR) => NEW.Z > EL.SZ
@BOX 4.1
IF M = N = LE.Z + 1
@BOX 8.1
J +LE.Z => P;
FOR Q < SIZE(R.PTR) DO
R.PTR^[Q] => PTR^[1+>P];
OD;
1 +> NEW.Z;
@BOX 10.1
 -1 => T.I;
WHILE 1 +> N =< LE.Z DO
   PTR^[J+N] => TMP2[1+>T.I];
OD;
J + M - 1 => P;
FOR Q < SIZE (R.PTR) DO
R.PTR^[Q] => PTR^[1+>P];
OD;
FOR Q < T.I + 1 DO
   TMP2[Q] => PTR^[1 +> P];
OD;
@BOX 5.1
NEW.Z => PTR^[J] ;
EL.SZ +> J;
@BOX 6.1
END
@BOX 7.1
BIO.EXCEPTION(%40);
@BOX 9.1
IF M = 1 AND N = LE.Z
@BOX 11.1
J => I;
FOR Q < SIZE(R.PTR) => NEW.Z DO
   R.PTR ^[Q] => PTR ^[1+>I];
OD;
@END
