Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0026/hsbg.ssp
There are 2 other files named hsbg.ssp in the archive. Click here to see a list.
C                                                                       HSBG  10
C     ..................................................................HSBG  20
C                                                                       HSBG  30
C        SUBROUTINE HSBG                                                HSBG  40
C                                                                       HSBG  50
C        PURPOSE                                                        HSBG  60
C           TO REDUCE A REAL MATRIX INTO UPPER ALMOST TRIANGULAR FORM   HSBG  70
C                                                                       HSBG  80
C        USAGE                                                          HSBG  90
C           CALL HSBG(N,A,IA)                                           HSBG 100
C                                                                       HSBG 110
C        DESCRIPTION OF THE PARAMETERS                                  HSBG 120
C           N      ORDER OF THE MATRIX                                  HSBG 130
C           A      THE INPUT MATRIX, N BY N                             HSBG 140
C           IA     SIZE OF THE FIRST DIMENSION ASSIGNED TO THE ARRAY    HSBG 150
C                  A IN THE CALLING PROGRAM WHEN THE MATRIX IS IN       HSBG 160
C                  DOUBLE SUBSCRIPTED DATA STORAGE MODE.  IA=N WHEN     HSBG 170
C                  THE MATRIX IS IN SSP VECTOR STORAGE MODE.            HSBG 180
C                                                                       HSBG 190
C        REMARKS                                                        HSBG 200
C           THE HESSENBERG FORM REPLACES THE ORIGINAL MATRIX IN THE     HSBG 210
C           ARRAY A.                                                    HSBG 220
C                                                                       HSBG 230
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED                  HSBG 240
C           NONE                                                        HSBG 250
C                                                                       HSBG 260
C        METHOD                                                         HSBG 270
C           SIMILARITY TRANSFORMATIONS USING ELEMENTARY ELIMINATION     HSBG 280
C           MATRICES, WITH PARTIAL PIVOTING.                            HSBG 290
C                                                                       HSBG 300
C        REFERENCES                                                     HSBG 310
C           J.H. WILKINSON - THE ALGEBRAIC EIGENVALUE PROBLEM -         HSBG 320
C           CLARENDON PRESS, OXFORD, 1965.                              HSBG 330
C                                                                       HSBG 340
C     ..................................................................HSBG 350
C                                                                       HSBG 360
      SUBROUTINE HSBG(N,A,IA)                                           HSBG 370
      DIMENSION A(1)                                                    HSBG 380
      DOUBLE PRECISION S                                                HSBG 390
      L=N                                                               HSBG 400
      NIA=L*IA                                                          HSBG 410
      LIA=NIA-IA                                                        HSBG 420
C                                                                       HSBG 430
C        L IS THE ROW INDEX OF THE ELIMINATION                          HSBG 440
C                                                                       HSBG 450
   20 IF(L-3) 360,40,40                                                 HSBG 460
   40 LIA=LIA-IA                                                        HSBG 470
      L1=L-1                                                            HSBG 480
      L2=L1-1                                                           HSBG 490
C                                                                       HSBG 500
C        SEARCH FOR THE PIVOTAL ELEMENT IN THE LTH ROW                  HSBG 510
C                                                                       HSBG 520
      ISUB=LIA+L                                                        HSBG 530
      IPIV=ISUB-IA                                                      HSBG 540
      PIV=ABS(A(IPIV))                                                  HSBG 550
      IF(L-3) 90,90,50                                                  HSBG 560
   50 M=IPIV-IA                                                         HSBG 570
      DO 80 I=L,M,IA                                                    HSBG 580
      T=ABS(A(I))                                                       HSBG 590
      IF(T-PIV) 80,80,60                                                HSBG 600
   60 IPIV=I                                                            HSBG 610
      PIV=T                                                             HSBG 620
   80 CONTINUE                                                          HSBG 630
   90 IF(PIV) 100,320,100                                               HSBG 640
  100 IF(PIV-ABS(A(ISUB))) 180,180,120                                  HSBG 650
C                                                                       HSBG 660
C        INTERCHANGE THE COLUMNS                                        HSBG 670
C                                                                       HSBG 680
  120 M=IPIV-L                                                          HSBG 690
      DO 140 I=1,L                                                      HSBG 700
      J=M+I                                                             HSBG 710
      T=A(J)                                                            HSBG 720
      K=LIA+I                                                           HSBG 730
      A(J)=A(K)                                                         HSBG 740
  140 A(K)=T                                                            HSBG 750
C                                                                       HSBG 760
C        INTERCHANGE THE ROWS                                           HSBG 770
C                                                                       HSBG 780
      M=L2-M/IA                                                         HSBG 790
      DO 160 I=L1,NIA,IA                                                HSBG 800
      T=A(I)                                                            HSBG 810
      J=I-M                                                             HSBG 820
      A(I)=A(J)                                                         HSBG 830
  160 A(J)=T                                                            HSBG 840
C                                                                       HSBG 850
C        TERMS OF THE ELEMENTARY TRANSFORMATION                         HSBG 860
C                                                                       HSBG 870
  180 DO 200 I=L,LIA,IA                                                 HSBG 880
  200 A(I)=A(I)/A(ISUB)                                                 HSBG 890
C                                                                       HSBG 900
C        RIGHT TRANSFORMATION                                           HSBG 910
C                                                                       HSBG 920
      J=-IA                                                             HSBG 930
      DO 240 I=1,L2                                                     HSBG 940
      J=J+IA                                                            HSBG 950
      LJ=L+J                                                            HSBG 960
      DO 220 K=1,L1                                                     HSBG 970
      KJ=K+J                                                            HSBG 980
      KL=K+LIA                                                          HSBG 990
  220 A(KJ)=A(KJ)-A(LJ)*A(KL)                                           HSBG1000
  240 CONTINUE                                                          HSBG1010
C                                                                       HSBG1020
C        LEFT TRANSFORMATION                                            HSBG1030
C                                                                       HSBG1040
      K=-IA                                                             HSBG1050
      DO 300 I=1,N                                                      HSBG1060
      K=K+IA                                                            HSBG1070
      LK=K+L1                                                           HSBG1080
      S=A(LK)                                                           HSBG1090
      LJ=L-IA                                                           HSBG1100
      DO 280 J=1,L2                                                     HSBG1110
      JK=K+J                                                            HSBG1120
      LJ=LJ+IA                                                          HSBG1130
  280 S=S+A(LJ)*A(JK)*1.0D0                                             HSBG1140
  300 A(LK)=S                                                           HSBG1150
C                                                                       HSBG1160
C        SET THE LOWER PART OF THE MATRIX TO ZERO                       HSBG1170
C                                                                       HSBG1180
      DO 310 I=L,LIA,IA                                                 HSBG1190
  310 A(I)=0.0                                                          HSBG1200
  320 L=L1                                                              HSBG1210
      GO TO 20                                                          HSBG1220
  360 RETURN                                                            HSBG1230
      END                                                               HSBG1240