SUBROUTINE EIGEN3 (A,PROB,U,DF,S) C ****************************************************************** C * * C * SUBROUTINE 'EIGEN3' COMPUTES THE EIGEN VALUES AND * C * EIGEN VECTORS FOR A 3-D CASE. * C * NOTE: THE IMSL SUBROUTINE MDFI USES REAL*4 PARAMETERS * C * * C * INPUT: * C * A - THE VARIANCE CO-VARIANCE MATRIX * C * PROB - IS THE PROBABILITY REQUESTED IN THE * C * EXCLUSIVE RANGE (0,1), * C * U & DF - ARE THE FIRST & SECOND DEGREES OF FREEDOM * C * RESPECTIVELY, * C * * C * OUTPUT: * C * A - AN ARRAY CONTAINING THE EIGEN VECTORS, * C * NOTE: THE VARIANCE CO-VARIANCE MATRIX IS * C * DESTROYED, * C * S - THE SEMI MAJOR AXES. * C * * C * IFLAG - THOUGH NOT AN INPUT/OUTPUT PARAMETER OF * C * EIGEN3 IT IS USED AS AN INPUT/OUTPUT ERROR * C * PARAMETER IN MDFI. EXPLANITION- * C * TERMINAL ERROR = 128 + N * C * WARNING ERROR = 32 + N * C * N=1 MEANS THAT AN ERROR OCCURED IN * C * MDBETI * C * N=2 MEANS PROB WAS NOT IN THE EXCLUSIVE * C * RANGE (0,1) * C * N=3 MEANS THE COMPUTED VALUE OF TVAL * C * WOULD PRODUCE AN OVERFLOW. TVAL IS * C * SET TO MACHINE INFINITY. * C * * C * * C * BY: H. MONIWA (1973) * C * MODIFIED BY: R. CALDWELL (1976) * C * * C ****************************************************************** IMPLICIT REAL*8 (A-H,O-Z), INTEGER*4 (I-N) C C PROGRAM FOR THE ANALYSIS OF ERROR ELLIPSOID C DIMENSION A(3,3),R(9),EV(3),WS(6),S(3),B(3,3) REAL*4 TVAL,D1,D2,PROB INTEGER*4 XYZ(3)/'X','Y','Z'/ EQUIVALENCE (R(1),B(1)) C C C A(2,1)=A(1,2) A(3,1)=A(1,3) A(3,2)=A(2,3) C C CALCULATING THE EXPANDING FACTOR C IF( PROB .EQ. 0.0E0 ) GOTO 40 D1 = U D2 = DF CALL MDFI (PROB,D1,D2,TVAL,IFLAG) C C CHECKING THE SUBROUTINE FOR ERRORS C IF( IFLAG .GT.0 ) WRITE(6,20) IFLAG TTVAL = TVAL CBAR = DSQRT( 3.0D0 * TTVAL ) 40 CONTINUE C SUMA=0.0 DO 50 I=1,3 50 SUMA=SUMA+A(I,I) C WRITE(6,11) WRITE(6,12) ((A(I,J),J=1,3),I=1,3) C C EIGENVALUES AND EIGENVECTORS C CALL EIGENZ(A,R,EV,WS,3,3,0) C SUMS=0.0 NEG=1 DO 60 I=1,3 IF(EV(I).LT.0.0) NEG=-1 SUMS=SUMS+EV(I) S(I)=DSQRT(DABS(EV(4-I))) DO 60 J=1,3 60 A(I,J)=R(9-I*3+J) C WRITE(6,13) (EV(4-I),(A(I,J),J=1,3),I=1,3) C DO 65 I=1,3 DO 65 J=1,3 B(I,J)=0.0 DO 65 K=1,3 65 B(I,J)=B(I,J)+A(K,I)*A(K,J) C PAI=3.1415926535898 DO 70 I=1,3 DO 70 J=1,3 70 A(I,J)=DARCOS(A(I,J))*180.0D0/PAI C IF(NEG.EQ.-1) GO TO 100 C WRITE(6,14) WRITE(6,17) WRITE(6,15) (XYZ(I),S(I),XYZ(I),(A(I,J),J=1,3),I=1,3) IF( PROB .EQ. 0.0E0 ) GOTO 115 C C CALCULATING THE INCREASED CONFIDENCE REGION C DO 90 I = 1,3 90 S(I) = CBAR * S(I) WRITE(6,16) ((B(I,J),J=1,3),I=1,3) GO TO 110 C 110 WRITE(6,19) PROB WRITE(6,15) (XYZ(I),S(I),XYZ(I),(A(I,J),J=1,3),I=1,3) GOTO 115 100 WRITE(6,18) C 115 RETURN 11 FORMAT(1H1,//, T35,'*********************************',/, * T35,'* *',/, * T35,'* ANALYSIS OF ERROR-ELLIPSOID *',/, * T35,'* *',/, * T35,'*********************************',///) 12 FORMAT(1H0, 5X, '(1) READ-IN COVARIANCE MATRIX:',//,(T10,3D16.6)) 13 FORMAT(1H0,/,6X,'(2) EIGENVALUES AND EIGENVECTORS OF COVARIANCE ', * 'MATRIX:',// ,T14,'EIGENVALUES',T41,'EIGENVECTORS (DIRECTI', * 'ON COSINES)',//,(T9, F15.6,T34,F15.6,2F12.6)) 14 FORMAT(1H0,/, 6X,'(3) PARAMETERS OF STANDARD ERROR-ELLIPSOID (19', * '.9% CONFIDENCE REGION):') 15 FORMAT(1H0,T41,'SPATIAL ANGLES (IN DEGREES) BETWEEN AXES',//, * T14,'SEMI-MAJOR AXES', T53,'X(MODEL)', 2X,'Y(MODEL)', 2X, * 'Z(MODEL)',//,(T14,A1,' =',F12.6,T41,A1,'(ELLIPSOID)', * F7.2,2F10.2)) 16 FORMAT(1H0,/, 6X,'(4) ORTHOGONALITY TEST',11H (M'M = I):,//, * (T10,3F16.6)) 17 FORMAT(1H+,T25,'________') 18 FORMAT(1H0,//,6X,'***(ERROR)*** NEGATIVE EIGENVALUE(S) DETECTED', * //,20X,'CHECK INPUT DATA FOR ROUND-OFF ERRORS') 19 FORMAT (1H0,/,6X,'(5) PARAMETERS OF THE ERROR-ELLIPSOID', * ' INCREASED TO A PROBABILITY OF',2X,F5.3,'% CONFIDENCE', * ' REGION:') 20 FORMAT ( 5(/),T30,'ERROR IN MDFI INPUT PARAMETERS. IFLAG IS',I5) END