COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001	   VALID 00005 PAGES
C00002 00002	BEGIN "TENSOR"
C00003 00003	SUBR METH1
C00005 00004	
C00007 00005		SCALE ←  80
C00009 ENDMK
C⊗;
BEGIN "TENSOR"
	REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
	REQUIRE "DPYIII[SYS,BGB]" SOURCE_FILE;
	SAFE ITG ARRAY DPYBUF[0:600];
	PRELOAD_WITH 0,4.0,-2.0, 2.9;REAL ARRAY XWC[0:3];
	PRELOAD_WITH 0,3.5, 2.0,-3.9;REAL ARRAY YWC[0:3];
	REAL SCALE,AA,BB,C,S;

SUBR METH1;
BEGIN "METH1"
	ITG I;
	REAL R1,C1,R2,C2,DR,DC;
	REAL MX,MY,PR,A,B,X,Y;
	REAL MXX0,MYY0,PXY0,A0,X0,Y0,PXY1;
	REAL PHI;
	MXX0←MYY0←PXY0←A0←X0←Y0←0;
	R2 ← 5-YWC[3];
	C2 ← XWC[3]-5;

FOR I←1 THRU 3 DO
BEGIN
	R1←R2; C1←C2;
	R2 ← 5-YWC[I];
	C2 ← XWC[I]-5;
	DC ← C2-C1;
	DR ← R1-R2;

α TRIANGULAR PORTION;
	A ← DC*DR/2;
	X ← (2*C2 + C1)/3;
	Y ← (2*R1 + R2)/3;
	MX ← A*DR*DR/18;
	MY ← A*DC*DC/18;
	PR ← -A*A/18;

α ACCUMULATE PORTIONS;
	A0 ← A0 + A;
	X0 ← X0 + X*A;
	Y0 ← Y0 + Y*A;
	MYY0 ← MYY0 + MY + X*X*A;
	MXX0 ← MXX0 + MX + Y*Y*A;
	PXY0 ← PXY0 + PR - X*Y*A;

α RECTANGULAR PORTION;
	A ← DC*R1;
	X ← (C1+C2)/2;
	Y ← R1/2;
	MX ← A*R1*R1/12;
	MY ← A*DC*DC/12;

α ACCUMULATE PORTIONS;
	A0 ← A0 + A;
	X0 ← X0 + X*A;
	Y0 ← Y0 + Y*A;
	MYY0 ← MYY0 + MY + X*X*A;
	MXX0 ← MXX0 + MX + Y*Y*A;
	PXY0 ← PXY0 + PR - X*Y*A;
END;

α COMPUTE TENSOR WITH RESPECT TO CENTER OF MASS;
	X ← X0/A0; XWC[0] ← X-5;
	Y ← Y0/A0; YWC[0] ← 5-Y;
	MX ← MXX0 - Y*Y*A0;
	MY ← MYY0 - X*X*A0;
	PR ← PXY0 + X*Y*A0;

	OUTSTR(" MX = "&CVG(MX)&" MY = "&CVG(MY)&" PR = "&CVG(PR)&↓);
 	PHI ← 0.5 * ATAN2(2*PR,MY-MX);
	C ← COS(PHI); S ← SIN(PHI);
	PXY0 ← (C*C-S*S)*PR + C*S*(MX-MY);
	MXX0 ← C*C*MX + S*S*MY + 2*C*S*PR;
	MYY0 ← C*C*MY + S*S*MX - 2*C*S*PR;
	OUTSTR("	PHI = "&CVS(180*PHI/π)&"	PXY0 = "&CVG(PXY0)&↓);

	MXX0←MXX0*12;
	MYY0←MYY0*12;
	AA← A ← SQRT(MXX0/A0);
	BB← B ← SQRT(MYY0/A0);

DO BEGIN
	AA ← SQRT(MXX0/(A*B));
	BB ← SQRT(MYY0/(A*B));
	A ← (A+AA)/2;
	B ← (B+BB)/2;
END UNTIL ABS(A-AA)≤1@-5 ∧ ABS(B-BB)≤1@-5;
	AA ← A/2;BB ← B/2;

END "METH1";
	SCALE ←  80;

	DPYSET(DPYBUF);
	AIVECT(-400,-400);
	AVECT(400,-400);AVECT(400,400);
	AVECT(-400,400);AVECT(-400,-400);

	AIVECT(XWC[1]*SCALE,YWC[1]*SCALE);
	AVECT(XWC[2]*SCALE,YWC[2]*SCALE);
	AVECT(XWC[3]*SCALE,YWC[3]*SCALE);
	AVECT(XWC[1]*SCALE,YWC[1]*SCALE);

	METH1;

	AIVECT(XWC[0]*SCALE-20,YWC[0]*SCALE);
	AVECT(XWC[0]*SCALE+20,YWC[0]*SCALE);
	AIVECT(XWC[0]*SCALE,YWC[0]*SCALE-20);
	AVECT(XWC[0]*SCALE,YWC[0]*SCALE+20);

	OUTSTR("	AA = "&CVG(AA)&"	BB = "&CVG(BB)&↓);
	AA ← SCALE*AA;
	BB ← SCALE*BB;

	AIVECT(SCALE*XWC[0]-AA*S+BB*C,SCALE*YWC[0]+AA*C+BB*S);
	AVECT(SCALE*XWC[0]-AA*S-BB*C,SCALE*YWC[0]+AA*C-BB*S);
	AVECT(SCALE*XWC[0]+AA*S-BB*C,SCALE*YWC[0]-AA*C-BB*S);
	AVECT(SCALE*XWC[0]+AA*S+BB*C,SCALE*YWC[0]-AA*C+BB*S);
	AVECT(SCALE*XWC[0]-AA*S+BB*C,SCALE*YWC[0]+AA*C+BB*S);

	DPYOUT(0);
	WHILE TRUE DO INCHRW;
END "TENSOR";