Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap2_198111 - decus/20-0026/rslmc.ssp
There are 2 other files named rslmc.ssp in the archive. Click here to see a list.
C                                                                       RSLM  10
C     ..................................................................RSLM  20
C                                                                       RSLM  30
C        SUBROUTINE RSLMC                                               RSLM  40
C                                                                       RSLM  50
C        PURPOSE                                                        RSLM  60
C           SOLUTION OF A SYSTEM OF LINEAR EQUATIONS AX=B               RSLM  70
C                                                                       RSLM  80
C        USAGE                                                          RSLM  90
C           CALL RSLMC(A,AF,B,X,N,EPSI,IER,IA,V,PER)                    RSLM 100
C                                                                       RSLM 110
C        DESCRIPTION OF PARAMETERS                                      RSLM 120
C           A      INPUT MATRIX                                         RSLM 130
C           AF     ARRAY OF THE FACTORIZATION OF THE ORIGINAL MATRIX    RSLM 140
C           B      RIGHT HAND SIDE VECTOR                               RSLM 150
C           X      VECTOR CONTAINING THE SOLUTION ON RETURN             RSLM 160
C           N      ORDER OF THE SYSTEM                                  RSLM 170
C           EPSI   RELATIVE PRECISION INDICATOR(REQUIRED INPUT)         RSLM 180
C           IER    ERROR INDICATOR                                      RSLM 190
C                     =0 IF EACH COMPONENT OF X MEETS THE PRECISION EPSIRSLM 200
C                     =1 IF ONLY THE NORM OF X MEETS THIS PRECISION     RSLM 210
C                     =2 IF THE PRECISION IN THE NORM OF THE COMPUTED   RSLM 220
C                        SOLUTION IS LOWER THAN EPSI                    RSLM 230
C                     =3 IF THE SOLUTION OBTAINED HAS NO MEANING AT ALL RSLM 240
C                     =4 IF A DIAGONAL TERM OF THE UPPER TRIANGULAR     RSLM 250
C                        FACTOR IS ZERO                                 RSLM 260
C           IA     SIZE OF THE FIRST DIMENSION ASSIGNED TO THE ARRAY A  RSLM 270
C                  IN THE CALLING PROGRAM WHEN THE MATRIX IS IN DOUBLE  RSLM 280
C                  SUBSCRIPTED DATA STORAGE MODE.  IA=N WHEN THE MATRIX RSLM 290
C                  IS IN SSP VECTOR STORAGE MODE.                       RSLM 300
C           V      WORKING STORAGE VECTOR                               RSLM 310
C                  DIMENSION OF V MUST BE GREATER THAN OR EQUAL TO N    RSLM 320
C           PER    VECTOR WHERE PERMUTATIONS OF ROWS OF THE MATRIX ARE  RSLM 330
C                  STORED                                               RSLM 340
C                  DIMENSION OF PER MUST BE GREATER THAN OR EQUAL TO N  RSLM 350
C                                                                       RSLM 360
C        REMARKS                                                        RSLM 370
C           THE MATRIX OF THE SYSTEM MAY BE FACTORIZED BY THE SUBROUTINERSLM 380
C           FACTR IN THE ARRAY AF PRIOR TO ENTRY TO THIS SUBROUTINE.    RSLM 390
C           THE LOWER TRIANGULAR FACTOR MUST HAVE AN UNIT DIAGONAL.     RSLM 400
C           EPSI IS MODIFIED WHEN IER=2                                 RSLM 410
C                                                                       RSLM 420
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED                  RSLM 430
C           NONE                                                        RSLM 440
C                                                                       RSLM 450
C        METHOD                                                         RSLM 460
C           A TRIAL SOLUTION IS FIRST COMPUTED.  THEN CORRECTIONS ARE   RSLM 470
C           CALCULATED FROM RESIDUAL VECTORS.                           RSLM 480
C                                                                       RSLM 490
C        REFERENCES                                                     RSLM 500
C           J. H. WILKINSON - THE ALGEBRAIC EIGENVALUE PROBLEM -        RSLM 510
C           CLARENDON PRESS OXFORD, 1965.  H. J. BOWDLER, R. S. MARTIN, RSLM 520
C           G. PETERS, AND J. H. WILKINSON.  'SOLUTION OF REAL AND      RSLM 530
C           COMPLEX SYSTEMS OF LINEAR EQUATIONS', NUMERISCHE MATHEMATIK,RSLM 540
C           VOL. 8, NO. 3, 1966, 217-234.                               RSLM 550
C                                                                       RSLM 560
C     ..................................................................RSLM 570
C                                                                       RSLM 580
      SUBROUTINE RSLMC (A,AF,B,X,N,EPSI,IER,IA,V,PER)                   RSLM 590
      DIMENSION A(1),AF(1),B(1),X(1),V(1),PER(1)                        RSLM 600
      DOUBLE PRECISION DP                                               RSLM 610
C                                                                       RSLM 620
C        INITIALIZATION                                                 RSLM 630
C                                                                       RSLM 640
      D0=0.                                                             RSLM 650
      IER=0                                                             RSLM 660
      ITE=0                                                             RSLM 670
      DO 10 I=1,N                                                       RSLM 680
      V(I)=B(I)                                                         RSLM 690
   10 X(I)=0.                                                           RSLM 700
   20 ITE=ITE+1                                                         RSLM 710
C                                                                       RSLM 720
C        THE PERMUTATIONS OF ROWS OF A ARE APPLIED TO V                 RSLM 730
C                                                                       RSLM 740
      DO 30 I=1,N                                                       RSLM 750
      K=PER(I)                                                          RSLM 760
      IF (K-I)25,30,25                                                  RSLM 770
   25 D1=V(K)                                                           RSLM 780
      V(K)=V(I)                                                         RSLM 790
      V(I)=D1                                                           RSLM 800
   30 CONTINUE                                                          RSLM 810
C                                                                       RSLM 820
C        SOLUTION OF THE LOWER TRIANGULAR SYSTEM                        RSLM 830
C                                                                       RSLM 840
      DO 50 I=2,N                                                       RSLM 850
      IM1=I-1                                                           RSLM 860
      DP=V(I)                                                           RSLM 870
      IK=I                                                              RSLM 880
      DO 40 K=1,IM1                                                     RSLM 890
      DP=DP-1.D0*AF(IK)*V(K)                                            RSLM 900
   40 IK=IK+IA                                                          RSLM 910
   50 V(I)=DP                                                           RSLM 920
C                                                                       RSLM 930
C        SOLUTION OF THE UPPER TRIANGULAR SYSTEM                        RSLM 940
C                                                                       RSLM 950
      IF(AF(IK)) 58,54,58                                               RSLM 960
   54 IER=4                                                             RSLM 970
      GO TO 82                                                          RSLM 980
   58 V(N)=DP/AF(IK)                                                    RSLM 990
      DO 70 I=2,N                                                       RSLM1000
      IM1=N-I+1                                                         RSLM1010
      INF=IM1+1                                                         RSLM1020
      DP=V(IM1)                                                         RSLM1030
      IK=(IM1-1)*IA+IM1                                                 RSLM1040
      D1=AF(IK)                                                         RSLM1050
      DO 60 K=INF,N                                                     RSLM1060
      IK=IK+IA                                                          RSLM1070
   60 DP=DP-1.D0*AF(IK)*V(K)                                            RSLM1080
   70 V(IM1)=DP/D1                                                      RSLM1090
C                                                                       RSLM1100
C        TEST OF PRECISION                                              RSLM1110
C                                                                       RSLM1120
      D1=0.                                                             RSLM1130
      D2=0.                                                             RSLM1140
      KLE=0                                                             RSLM1150
      DO 80 I=1,N                                                       RSLM1160
      D1=D1+ABS(V(I))                                                   RSLM1170
      D2=D2+ABS(X(I))                                                   RSLM1180
      IF (ABS(V(I))-EPSI*ABS(X(I))) 80,80,75                            RSLM1190
   75 KLE=1                                                             RSLM1200
   80 CONTINUE                                                          RSLM1210
      IF (KLE)140,82,85                                                 RSLM1220
   82 RETURN                                                            RSLM1230
   85 IF (ITE-1)140,90,87                                               RSLM1240
C                                                                       RSLM1250
C        ITERATIONS ARE STOPPED WHEN THE NORM OF THE CORRECTION IS MORE RSLM1260
C        THAN HALF OF THE ONE OF THE FORMER                             RSLM1270
C                                                                       RSLM1280
   87 IF (D0-2.*D1)120,90,90                                            RSLM1290
   90 DO 95 I=1,N                                                       RSLM1300
   95 X(I)=X(I)+V(I)                                                    RSLM1310
      DO 110 I=1,N                                                      RSLM1320
      DP=B(I)                                                           RSLM1330
      IK=I                                                              RSLM1340
      DO 100 K=1,N                                                      RSLM1350
      DP=DP-1.D0*A(IK)*X(K)                                             RSLM1360
  100 IK=IK+IA                                                          RSLM1370
  110 V(I)=DP                                                           RSLM1380
      D0=D1                                                             RSLM1390
      GO TO 20                                                          RSLM1400
  120 IF(ITE-2)140,140,125                                              RSLM1410
  125 IF (D1-EPSI*D2)127,127,130                                        RSLM1420
  127 IER=1                                                             RSLM1430
      RETURN                                                            RSLM1440
  130 IER=2                                                             RSLM1450
      EPSI=D1/D2                                                        RSLM1460
      RETURN                                                            RSLM1470
  140 IER=3                                                             RSLM1480
      RETURN                                                            RSLM1490
      END                                                               RSLM1500