SUBROUTINE DORTHE(NM,N,LOW,IGH,A,ORT) C INTEGER I,J,M,N,II,JJ,LA,MP,NM,IGH,KP1,LOW DOUBLE PRECISION A(NM,N),ORT(IGH) DOUBLE PRECISION F,G,H,SCALE DOUBLE PRECISION DSQRT C C THIS IS A DOUBLE-PRECISION VERSION OF THE C EISPACK SINGLE-PRECISION ROUTINE ORTHES. C IT WAS ADAPTED BY PHYLLIS FOX, MAY 28, 1975. C C ORTHES IS A TRANSLATION OF THE ALGOL PROCEDURE ORTHES, C NUM. MATH. 12, 349-368(1968) BY MARTIN AND WILKINSON. C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 339-358(1971). C C GIVEN A REAL (DOUBLE PRECISION) GENERAL MATRIX, THIS SUBROUTINE C REDUCES A SUBMATRIX SITUATED IN ROWS AND COLUMNS C LOW THROUGH IGH TO UPPER HESSENBERG FORM BY C ORTHOGONAL SIMILARITY TRANSFORMATIONS. C C ON INPUT- C C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM C DIMENSION STATEMENT, C C N IS THE ORDER OF THE MATRIX, C C LOW AND IGH ARE INTEGERS DETERMINED BY THE BALANCING C SUBROUTINE BALANC. IF BALANC HAS NOT BEEN USED, C SET LOW=1, IGH=N, C C A CONTAINS THE INPUT MATRIX. C C ON OUTPUT- C C A CONTAINS THE HESSENBERG MATRIX. INFORMATION ABOUT C THE ORTHOGONAL TRANSFORMATIONS USED IN THE REDUCTION C IS STORED IN THE REMAINING TRIANGLE UNDER THE C HESSENBERG MATRIX, C C ORT CONTAINS FURTHER INFORMATION ABOUT THE TRANSFORMATIONS. C ONLY ELEMENTS LOW THROUGH IGH ARE USED. C C C ------------------------------------------------------------------ C LA = IGH - 1 KP1 = LOW + 1 IF (LA .LT. KP1) GO TO 200 C DO 180 M = KP1, LA H = 0.0D0 ORT(M) = 0.0D0 SCALE = 0.0D0 C ********** SCALE COLUMN (ALGOL TOL THEN NOT NEEDED) ********** DO 90 I = M, IGH 90 SCALE = SCALE + DABS(A(I,M-1)) C IF (SCALE .EQ. 0.0D0) GO TO 180 MP = M + IGH C ********** FOR I=IGH STEP -1 UNTIL M DO -- ********** DO 100 II = M, IGH I = MP - II ORT(I) = A(I,M-1) / SCALE H = H + ORT(I) * ORT(I) 100 CONTINUE C G = -DSIGN(DSQRT(H),ORT(M)) H = H - ORT(M) * G ORT(M) = ORT(M) - G C ********** FORM (I-(U*UT)/H) * A ********** DO 130 J = M, N F = 0.0D0 C ********** FOR I=IGH STEP -1 UNTIL M DO -- ********** DO 110 II = M, IGH I = MP - II F = F + ORT(I) * A(I,J) 110 CONTINUE C F = F / H C DO 120 I = M, IGH 120 A(I,J) = A(I,J) - F * ORT(I) C 130 CONTINUE C ********** FORM (I-(U*UT)/H)*A*(I-(U*UT)/H) ********** DO 160 I = 1, IGH F = 0.0D0 C ********** FOR J=IGH STEP -1 UNTIL M DO -- ********** DO 140 JJ = M, IGH J = MP - JJ F = F + ORT(J) * A(I,J) 140 CONTINUE C F = F / H C DO 150 J = M, IGH 150 A(I,J) = A(I,J) - F * ORT(J) C 160 CONTINUE C ORT(M) = SCALE * ORT(M) A(M,M-1) = SCALE * G 180 CONTINUE C 200 RETURN C ********** LAST CARD OF DORTHE ********** END .