perm filename WRIST.SAI[1,VDS] blob sn#277834 filedate 1977-04-22 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00009 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "WRIST"
C00005 00003	STRING PROCEDURE GETTIM
C00007 00004	⊃ MATRIX SOLVERS:  DECOMPOSE, SOLVE
C00014 00005	⊃ MISC ROUTINES:  SOLVER, TYPEFORCE
C00016 00006	⊃ MATRIX INVERSION ROUTINES: INVERT, PINVERSE
C00019 00007	⊃ START OF MAIN PROGRAM, INITIALIZE KEY VARIABLES
C00023 00008	⊃ ASK WHAT WE ARE TO DO WITH THE DATA
C00027 00009	⊃ SAVE DATA ON DISK FILE
C00031 ENDMK
C⊗;
BEGIN "WRIST"

COMMENT - THIS PROGRAM IS USED TO CALIBRATE THE SCHEINMAN FORCE SENSING
	  WRIST.;

DEFINE ⊃="COMMENT",CR="'15",LF="'12",CRLF="('15&'12)",FF="'14";
DEFINE NSAMPS=10;

INTEGER I,J,K,DSET;
INTEGER DUM,CHAN,CCHAN,FLAG,ERR;
BOOLEAN TERSE,ASKAGAIN;
BOOLEAN ISCAL,DONTSTOP;
STRING COM1;
STRING ANS,MES,LINED;
STRING STOPIT,OUTBUF,OUTBUF2,OUTBUF3;
REAL DX,DY,DZ;

SAFE INTEGER ARRAY PS[1:50];
INTEGER ARRAY READINGS[1:NSAMPS,1:8];
INTEGER ARRAY IBASE[1:8];
REAL ARRAY AVER[1:8],CAVER[1:8],BASE[1:8],SD[1:8];

PRELOAD_WITH 	1.0, 0.0, 0.0, 0.0, 0.0, 0.0,
                0.0, 1.0, 0.0, 0.0, 0.0, 0.0,
                0.0, 0.0, 1.0, 0.0, 0.0, 0.0,
                0.0, 0.0, 0.0, 1.0, 0.0, 0.0,
                0.0, 0.0, 0.0, 0.0, 1.0, 0.0,
                0.0, 0.0, 0.0, 0.0, 0.0, 1.0;
REAL ARRAY MPRIME[1:6,1:6];
	
PRELOAD_WITH
       10.0, 0.0, 0.0,  0.0, -7.5,  0.0,
	0.0,10.0, 0.0,  7.5,  0.0,  0.0,
       10.0, 0.0, 0.0,  0.0,-71.5,  0.0,
	0.0, 5.0, 0.0,35.75,  0.0,  0.0,
	0.0, 0.0, 4.4,  0.0,  0.0,  0.0,
	0.0,10.0, 0.0,  7.5,  0.0,-40.0;
OWN REAL ARRAY F[1:6,1:6];

PRELOAD_WITH
-124.0, -7.0,   -1.8,   53.0,   115.6,  -12.5,  -8.0,   -65.20,
20.0,   82.0,   134.7,  -9.0,   14.0,   -83.0,  -111.0, 1.00,
-115.0, 8.00,   8.00,   791.0,  119.0,  -21.0,  -43.0,  -789.20,
25.0,   409.0,  58.0,   -19.1,  23.0,   -398.5, -64.0,  15.1,
3.00,   39.10, 0.00,   35.00,   -3.20,  45.00,  2.30,   47.00,
-265.0, 83.0,  -138.90, 13.0,  -255.20, -73.00, -396.00,  -12.00;
OWN REAL ARRAY EPS[1:6,1:8];

REAL ARRAY M[1:6,1:8],MI[1:8,1:6];


EXTERNAL INTEGER PROCEDURE TLKEF6(INTEGER ARRAY READINGS);
REQUIRE "TLKEF6.REL" LOAD_MODULE;
STRING PROCEDURE GETTIM;

⊃ DETERMINES THE CURRENT DAY AND TIME, CONVERTS THEM TO ASC STRING
CONSTANTS AND RETURNS THE COMPOSITE STRING.;

	BEGIN "GETTIM"
	INTEGER DAY,HOUR,T,WID,DIG,YEAR,MON;
	PRELOAD_WITH "JAN","FEB","MAR","APR","MAY","JUNE","JULY",
		     "AUG","SEPT","OCT","NOV","DEC";
	OWN STRING ARRAY MONTHS[1:12];
	STRING TIME;

	⊃ GET THE CURRENT TIME;

	GETFORMAT(WID,DIG);
	SETFORMAT(-2,0);
	TIME←"CURRENT TIME AND DATE: ";
	QUICK_CODE
		'47540400101;
		HLRZ	'14,'13;
		HRRZ	'13,'13;
		MOVEM	'13,HOUR;
		MOVEM	'14,DAY;
	END;

	⊃ COMPUTE AND CONVERT THE TIME OF DAY;

	T←HOUR/60;
	HOUR←T/60;
	T←T-HOUR*60;
	TIME←TIME&CVS(HOUR)&":"&CVS(T)&"  ";

	⊃ COMPUTE AND CONVERT THE DAY OF THE YEAR;

	MON←DAY/31;
	DAY←(DAY MOD 31)+1;
	YEAR←(MON/12)+64;
	MON←(MON MOD 12)+1;
	TIME←TIME&CVS(DAY)&MONTHS[MON]&CVS(YEAR)&CRLF;

	SETFORMAT(WID,DIG);
	RETURN(TIME);
	END "GETTIM";
⊃ MATRIX SOLVERS:  DECOMPOSE, SOLVE;

PROCEDURE DECOMPOSE(INTEGER N;SAFE REAL ARRAY A,LU);

⊃ Both A and LU are [1:N, 1:N].  Uses global array PS.  Computes
triangular matrices L and U and permutation matrix PS so that LU=PA.
Stores (L-I) and U both in LU.  The call DECOMPOSE(N,A,A) will
overwrite A with LU. ;
 
	BEGIN "decompose"
	INTEGER I, J, K, PIVOTINDEX;
	REAL NORMROW, PIVOT, SIZE, BIGGEST, MULT;
	SAFE OWN REAL ARRAY R[1:50];

        SIMPLE PROCEDURE ILOOP(INTEGER UL;REFERENCE REAL R1,R2);
	    ⊃  Machine-coded for efficiency;
            START_CODE
	    LABEL LP,EU;
                    MOVE 1,-1('17);
                    MOVE 2,-2('17);
                    MOVE 3,-3('17);
                    SUB 3,K;
                    JUMPLE 3,EU;
            LP:     AOJ 1,;
                    AOJ 2,;
                    MOVN 4,MULT;
                    FMPR 4,(1);
                    FADRM 4,(2);
                    SOJG 3,LP;
            EU:     END;

	IF N > 50
	THEN USERERR(0,1,"DECOMPOSE can't handle a matrix as large as" & CVS(N));

	⊃  Initialize PS,LU and R;
        FOR I←1 STEP 1 UNTIL N DO
            BEGIN
            PS[I]←I;
            NORMROW←0;
            FOR J←1 STEP 1 UNTIL N DO
                BEGIN
                LU[I,J]←A[I,J];
                IF (NORMROW<ABS(LU[I,J])) THEN NORMROW←ABS(LU[I,J]);
                END;
	    IF (NORMROW≠0)
	    THEN R[I]←1/NORMROW
	    ELSE BEGIN
		R[I]←0; 
		USERERR(0,1,"Zero row in DECOMPOSE");
		END;
	    END;

	⊃ Gaussian elimination with partial pivoting;
	FOR K←1 STEP 1 UNTIL N-1 DO
	    BEGIN "kloop";
            BIGGEST ← 0;
            FOR I ← K STEP 1 UNTIL N DO
                BEGIN
                SIZE←ABS(LU[PS[I],K])*R[PS[I]];
                IF (BIGGEST<SIZE)
		THEN BEGIN
		    BIGGEST←SIZE;
		    PIVOTINDEX←I;
		    END;
                END;
            IF BIGGEST = 0
	    THEN BEGIN 
                USERERR(0,1,"Singular matrix in DECOMPOSE");
                DONE "kloop";
		END;
	    IF PIVOTINDEX ≠ K
	    THEN BEGIN
                J←PS[K];
		PS[K]←PS[PIVOTINDEX];
		PS[PIVOTINDEX]←J;
                END;
            PIVOT←LU[PS[K],K];
            FOR I←K+1 STEP 1 UNTIL N DO
		BEGIN
                LU[PS[I],K]←MULT←(LU[PS[I],K]/PIVOT);
                IF MULT ≠ 0
		THEN ILOOP(N,LU[PS[I],K],LU[PS[K],K]);
                    ⊃ The following is the result of the machine code:
                        FOR J ← K+1 STEP 1 UNTIL N DO
                            LU[PS[I],J]←LU[PS[I],J]-MULT*LU[PS[K],J];
                END;
	    END "kloop";
        IF (LU[PS[N],N]=0)
	THEN USERERR(0,1,"Singular matrix in DECOMPOSE");
        END "decompose";



SIMPLE PROCEDURE SOLVE(INTEGER N;SAFE REAL ARRAY LU,B,X);

⊃ Arrays LU[1:N,1:N], B[1:N], X[1:N].  Uses global safe integer array
PS.  Solves AX=B using LU from DECOMPOSE.  ;

        BEGIN "solve"
        INTEGER I,J;
        REAL DOT;

        SIMPLE PROCEDURE ILOOP(INTEGER LL,UL;REFERENCE REAL R1,R2);
	    ⊃ Machine-coded for efficiency;
            START_CODE
	    LABEL LP,EU;
                    MOVE 1,-1('17);
                    MOVE 2,-2('17);
                    MOVE 3,-3('17);
                    SUB 3,-4('17);
                    SETZ 4,;
                    JUMPL 3,EU;
            LP:     MOVE 5,(1);
                    FMPR 5,(2);
                    FADR 4,5;
                    AOJ 1,;
                    AOJ 2,;
                    SOJGE 3,LP;
            EU:     MOVEM 4,DOT;
            END;

        FOR I ← 1 STEP 1 UNTIL N DO
            BEGIN
	    ILOOP(1,I-1,LU[PS[I],1],X[1]);
	    ⊃ Has this effect:
		DOT←0 
	        FOR J←1 STEP 1 UNTIL I-1 DO
                    DOT←DOT+LU[PS[I],J]*X[J];
            X[I]←B[PS[I]]-DOT;
            END;

        X[N] ← X[N] / LU[PS[N],N];
        FOR I ← N-1 STEP -1 UNTIL 1 DO
            BEGIN  ⊃ RF: I changed loop upper index from N, to avoid 
		subscript errors;
            ILOOP(I+1,N,LU[PS[I],I+1],X[I+1]);
	    ⊃  Has this effect:
		DOT←0
		FOR J←I+1 STEP 1 UNTIL N DO
		    DOT←DOT+LU[PS[I],J]*X[J];
            X[I]←(X[I]-DOT)/LU[PS[I],I];
            END;
	END "solve";
⊃ MISC ROUTINES:  SOLVER, TYPEFORCE;

PROCEDURE SOLVER(REAL ARRAY MI,EPS,F);

	BEGIN "SOLVER"
	INTEGER I,J,K;
	REAL ARRAY LU[1:6,1:6],E[1:6],M[1:6];

	⊃ TRIANGULARIZE THE FORCE MATRIX;

	DECOMPOSE(6,F,LU);

	⊃ COPY THE SIX READINGS FOR EACH GAGE AND SOLVE FOR A 
	  ROW OF THE INVERSE CALIBRATION MATRIX.  REPEAT FOR
	  ALL EIGHT STRAIN GAGE PAIRS.;

	FOR I ← 1 STEP 1 UNTIL 8 DO 
		BEGIN "SOLOOP"
		FOR J ← 1 STEP 1 UNTIL 6 DO E[J]←EPS[J,I];
		SOLVE(6,LU,E,M);
		FOR J ← 1 STEP 1 UNTIL 6 DO MI[I,J]←M[J];
		END "SOLOOP";

	END "SOLVER";


PROCEDURE TYPEFORCE(REAL ARRAY F);
	
	BEGIN "TYPEFORCE"
	REAL MAG;
	OUTSTR(CRLF&"THE RESULTING FORCE VECTOR IS ("&CVF(F[1])&
		","&CVF(F[2])&","&CVF(F[3])&")"&CRLF&
	       "THE RESULTING MOMENT VECTOR IS("&CVF(F[4])&
		","&CVF(F[5])&","&CVF(F[6])&")"&CRLF);
	MAG← ( F[1]↑2 + F[2]↑2 + F[3]↑2 )↑0.5;
	OUTSTR("THE MAGNITUDE OF THE FORCE IS "&CVF(MAG)&CRLF);
	END "TYPEFORCE";
⊃ MATRIX INVERSION ROUTINES: INVERT, PINVERSE;


PROCEDURE INVERT (INTEGER N; REAL ARRAY A );

⊃ COMPUTES THE INVERSE OF THE NxN MATRIX "A" AND RETURNS THE INVERTED
MATRIX IN "A".  THE PROCEDURES "SOLVE" AND "DECOMPOSE" ARE USED TO
COMPUTE THE INDIVIDUAL ROWS OF THE INVERSE MATRIX.;
 
	BEGIN "INVERT"
	INTEGER I,J;
	REAL ARRAY LU[1:N,1:N],IDENT[1:N],X[1:N];

	⊃ COPY THE ARRAY AND TRIANGULARIZE IT;

	ARRTRAN(LU,A);
	DECOMPOSE(N,LU,LU);
	
	⊃ COMPUTE THE ROWS OF THE INVERSE ONE BY ONE;

	FOR I ← 2 STEP 1 UNTIL N DO IDENT[I]←0.0;
	FOR I ← 1 STEP 1 UNTIL N DO
		BEGIN "INVLOOP"
		IDENT[I]←1.0;
		SOLVE(N,LU,IDENT,X);
		FOR J ← 1 STEP 1 UNTIL N DO A[J,I]←X[J];
		IDENT[I]←0.0;
		END "INVLOOP";
	END "INVERT";



PROCEDURE PINVERSE(REAL ARRAY M,MI);

⊃ COMPUTES THE PSUEDO INVERSE OF A NON-SQUARE 6x8 MATRIX, MI, AND 
RETURNS THE INVERTED 8x6 MATRIX IN M.  THE EQUATION IMPLEMENTED BY
THIS ROUTINE IS	AS FOLLOWS:

		        T      -1    T
		M ← ( MI * MI )  * MI

WHERE THE "*" DENOTES MATRIX MULTIPLICATION;

	BEGIN "PINVERSE"
	REAL ARRAY A[1:6,1:6];
	REAL STOTAL;
	INTEGER I,J,K;

	⊃ COMPUTE THE PRODUCT OF MI AND ITS TRANSPOSE;

	FOR I ← 1 STEP 1 UNTIL 6 DO 
	   FOR J ← 1 STEP 1 UNTIL 6 DO
		BEGIN "PMULT"
		STOTAL←0.0;
		FOR K ← 1 STEP 1 UNTIL 8 DO
			STOTAL←STOTAL+MI[K,I]*MI[K,J];
		A[I,J]←STOTAL;
		END "PMULT";

	⊃ INVERT THE PRODUCT AND MULTIPLY BY THE TRANSPOSE AGAIN;

	INVERT(6,A);
	FOR I ← 1 STEP 1 UNTIL 6 DO
	   FOR J ← 1 STEP 1 UNTIL 8 DO
		BEGIN "FMULT"
		STOTAL←0.0;
		FOR K ←1 STEP 1 UNTIL 6 DO
			STOTAL←STOTAL+A[I,K]*MI[J,K];
		M[I,J]←STOTAL;
		END "FMULT";

	END "PINVERSE";
⊃ START OF MAIN PROGRAM, INITIALIZE KEY VARIABLES;

OUTSTR(CRLF&CRLF&"*** FORCE BALANCE RESOLUTION PROGRAM ***"&CRLF);
DX← DY← DZ ← 0.0;
TERSE←TRUE;
LINED←""; COM1←"";

⊃ READ IN THE CALIBRATION TABLE IF IT EXISTS, AND TYPE AN APPROPRIATE
  MESSAGE.;

CCHAN←1;
OPEN(CCHAN,"DSK",0,2,0,DUM,DUM,DUM);
LOOKUP(CCHAN,"FORCAL.CAL",FLAG);
IF FLAG=0 THEN BEGIN
	FOR I ← 1 STEP 1 UNTIL 6 DO
	   FOR J ←1 STEP 1 UNTIL 8 DO M[I,J]←REALIN(CCHAN);
	OUTSTR("CALIBRATION TABLE READ FROM DISK"&CRLF);
	ISCAL←TRUE;
   END ELSE BEGIN
	OUTSTR("NO CALIBRATION DATA FOUND ON DISK"&CRLF);
	ISCAL←FALSE;
	END;
RELEASE(CCHAN);

⊃ MAIN LOOP, CHECK FOR TERMINATION OR WAIT TO TAKE READING;

DONTSTOP←TRUE;
WHILE DONTSTOP DO
	BEGIN "MAIN"
	ERR←1;
	WHILE ERR≠0 DO
		BEGIN
	       	OUTSTR(CRLF&"Type CR to read strain gages: ");
		INCHWL;
	        ERR←TLKEF6(READINGS);
		END;

⊃ COMPUTE STATISTICS FOR READINGS.;


	FOR I←1 STEP 1 UNTIL 8 DO 
		BEGIN
		AVER[I]←0.0;
		SD[I]←0.0;
		END;
	FOR I←1 STEP 1 UNTIL NSAMPS DO 
	   FOR J←1 STEP 1 UNTIL 8 DO 
		BEGIN
		AVER[J]←AVER[J]+READINGS[I,J];
		SD[J]←SD[J]+READINGS[I,J]↑2;
		END;
	FOR I←1 STEP 1 UNTIL 8 DO 
		BEGIN
		AVER[I]←AVER[I]/NSAMPS;
		CAVER[I]←AVER[I]-BASE[I];
		SD[I]←((SD[I]-NSAMPS*AVER[I]↑2)/(NSAMPS-1))↑0.5;
		END;

⊃ PRINT THE DATA.  SAVE OUTPUT STRING FOR LATER.;

	SETFORMAT(9,2);
	OUTBUF←GETTIM&
               "Strain Gage Readings: Mean, Corrected Mean, Standard Dev."&
		CRLF;
	OUTBUF2←OUTBUF3←"";
	FOR I ← 1 STEP 1 UNTIL 8 DO
		BEGIN
		OUTBUF←OUTBUF&CVF(AVER[I]);
		OUTBUF2←OUTBUF2&CVF(CAVER[I]);
		OUTBUF3←OUTBUF3&CVF(SD[I]);
		END;
	OUTBUF←OUTBUF&CRLF&OUTBUF2&CRLF&OUTBUF3&CRLF&CRLF;
	OUTSTR(OUTBUF);
	IF ¬TERSE THEN 
		BEGIN
		OUTBUF2←"Raw Data:"&CRLF;
		FOR I ←1 STEP 1 UNTIL NSAMPS DO
			BEGIN
		   	FOR J ← 1 STEP 1 UNTIL 8 DO 
				OUTBUF2←OUTBUF2&CVS(READINGS[I,J])&"  ";
			OUTBUF2←OUTBUF2&CRLF;
			END;
		OUTSTR(OUTBUF2&CRLF);
		END;
⊃ ASK WHAT WE ARE TO DO WITH THE DATA;

	ASKAGAIN←TRUE;
	WHILE ASKAGAIN DO
		BEGIN "DATALOOP"
		OUTSTR("What do you want to do? (A,B,C,D,G,R,S,T,X,CR,?)= ");
		LODED(LINED&CR);
		LINED ← INCHWL;
		IF EQU(LINED,"?") THEN 
			OUTSTR( "  A - Print all data collected"&CRLF&
				"  B - Set new data base offset"&CRLF&
			        "  C - Use data for calibration"&CRLF&
				"  D - Halt execution of WRIST"&CRLF&
				"  G - Go read strain gages again"&CRLF&
				"  R - Resolve forces and moments"&CRLF&
				"  S - Save data set on disk"&CRLF&
				"  T - Terse output"&CRLF&
				"  X - Resolve at external location"&CRLF&
				"  ? - Print this message"&CRLF)
		ELSE IF EQU(LINED,"G") THEN ASKAGAIN←FALSE
		ELSE IF EQU(LINED,"D") THEN ASKAGAIN←DONTSTOP←FALSE

⊃ SET OUTPUT TERSE/FULL MODE;

		ELSE IF EQU(LINED,"A") THEN TERSE←FALSE
		ELSE IF EQU(LINED,"T") THEN TERSE←TRUE

⊃ USER WANTS TO SET NEW DATA OFFSET;

		ELSE IF EQU(LINED,"B") THEN 
			BEGIN
			FOR I←1 STEP 1 UNTIL 8 DO 
				BEGIN
				BASE[I]←AVER[I];
				IBASE[I]←READINGS[1,I];
				END;
			OUTSTR("New data base offset set"&CRLF);
			ASKAGAIN←FALSE;
			END

⊃ RESOLVE FORCES AND MOMENTS AT AN EXTERNAL LOCATION;

		ELSE IF EQU(LINED,"X") THEN
			BEGIN
			OUTSTR("Type Dx,Dy,Dz = ");
			ANS ← INCHWL;
			DX ← REALSCAN(ANS,DUM);
			DY ← REALSCAN(ANS,DUM);
			DZ ← REALSCAN(ANS,DUM);
			MPRIME[4,2]←-DZ;
			MPRIME[4,3]←DY;
			MPRIME[5,1]←DZ;
			MPRIME[5,3]←-DX;
			MPRIME[6,1]←-DY;
			MPRIME[6,2]←DX;
			END

⊃ FORCE AND MOMENT COMPUTATION;

		ELSE IF EQU(LINED,"R") THEN
		    IF ¬ISCAL THEN 
			OUTSTR("NO CALIBRATION DATA"&CRLF)
		    ELSE BEGIN "RESOLVE"
			REAL ARRAY F[1:6],FPRIME[1:6];
			SETFORMAT(8,2);
			FOR I←1 STEP 1 UNTIL 6 DO 
				BEGIN
				F[I]←0.0;
				FOR J←1 STEP 1 UNTIL 8 DO 
				   F[I]←F[I]+M[I,J]*(READINGS[1,J]-IBASE[J]);
				END;
			TYPEFORCE(F);
			FOR I←1 STEP 1 UNTIL 6 DO
				BEGIN
				FPRIME[I]←0.0;
				FOR J←1 STEP 1 UNTIL 6 DO
				   FPRIME[I]←FPRIME[I]+MPRIME[I,J]*F[J];
				END;
			OUTSTR(CRLF&"FORCE/MOMENTS RECOMPUTED AT ("&CVF(DX)&
				","&CVF(DY)&","&CVF(DZ)&")"&CRLF);
			TYPEFORCE(FPRIME);
			ASKAGAIN←FALSE;
			END "RESOLVE"
⊃ SAVE DATA ON DISK FILE;

		ELSE IF EQU(LINED,"S") THEN
			BEGIN "SAVEIT"
			INTEGER CHAN;
			OUTSTR("OUTPUT COMMENT =");
			LODED(COM1&CR);
 			COM1←INCHWL;
			CHAN←3;
			OPEN(CHAN,"DSK",0,2,2,DUM,DUM,DUM);
			LOOKUP(CHAN,"FORCAL.DAT",DUM);
			ENTER(CHAN,"FORCAL.DAT",DUM);
			QUICK_CODE
				UGETF	3,DUM;
			END;
			OUT(CHAN,COM1&CRLF&OUTBUF&CRLF&FF);
			RELEASE(CHAN);
			END "SAVEIT"

⊃ USE DATA FOR FORCE CALIBRATION, PRINT CURRENT DATA;

		ELSE IF EQU(LINED,"C") THEN
			BEGIN "CALIB"
			OUTSTR("CURRENT CALIBRATION DATA:"&CRLF&
			  " TEST #         FORCES AND MOMENTS"&CRLF);
			SETFORMAT(8,3);
			FOR I ← 1 STEP 1 UNTIL 6 DO 
				BEGIN
				ANS←CVS(I)&"  ";
				FOR J ← 1 STEP 1 UNTIL 6 DO
					ANS←ANS&CVF(F[I,J]);
				OUTSTR(ANS&CRLF);
				END;

⊃ REPLACE OLD DATA WITH NEW;

			OUTSTR("REPLACE DATA SET (0=NONE) = ");
			ANS ← INCHWL;
			DSET←INTSCAN(ANS,DUM);
			IF DSET≠0 THEN
				BEGIN
				ANS←"";
				FOR I ← 1 STEP 1 UNTIL 6 DO
					ANS←ANS&CVF(F[DSET,I]);
				OUTSTR("NEW FORCES/MOMENTS =");
				LODED(ANS&CR);
				ANS ←INCHWL;
				FOR I ← 1 STEP 1 UNTIL 6 DO 
					F[DSET,I]←REALSCAN(ANS,DUM);
				FOR I ← 1 STEP 1 UNTIL 8 DO 
					EPS[DSET,I]←CAVER[I];
				END;
			
⊃ ASK IF THE CALIBRATION MATRIX IS TO BE COMPUTED;
			
			OUTSTR("COMPUTE NEW CALIBRATION MATRIX (Y,N)? ");
			ANS←INCHWL;
			IF EQU(ANS,"Y") THEN
				BEGIN
				SOLVER(MI,EPS,F);
				PINVERSE(M,MI);
				ISCAL←TRUE;
				END;

⊃ SAVE NEW CALIBRATION ON THE DISK?;

			OUTSTR("SAVE NEW MATRIX ON THE DISK (Y,N)? ");
			ANS←INCHWL;
			IF EQU(ANS,"Y") THEN
				BEGIN
				CHAN←3;
				OPEN(CHAN,"DSK",0,0,2,120,DUM,DUM);
				ENTER(CHAN,"FORCAL.CAL",DUM);
				SETFORMAT(15,7);
				FOR I←1 STEP 1 UNTIL 6 DO 
				   FOR J ← 1 STEP 4 UNTIL 5 DO
					BEGIN "PLINE"
					MES←"";
					FOR K ← J STEP 1 UNTIL J+3 DO 	
 						MES←MES&CVE(M[I,K])&"  ";
					OUT(CHAN,MES&CRLF);
					END "PLINE";
				OUT(CHAN,CRLF&CRLF&"CALIBRATION MATRIX: "&GETTIM);
				RELEASE(CHAN);
				END;
			END "CALIB";
		END "DATALOOP";
	END "MAIN";

⊃ EXIT CLEANLY;

OUTSTR("I SURE HOPE THE #@!## IS CALIBRATED!!!!"&CRLF);

END "WRIST"