home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / LLSQ.ZIP / BNDSOL.FOR < prev    next >
Encoding:
Text File  |  1984-02-23  |  5.6 KB  |  71 lines
  1.       SUBROUTINE BNDSOL (MODE,G,MDG,NB,IP,IR,X,N,RNORM)                 BSL00100
  2. C     C.L.LAWSON AND R.J.HANSON, JET PROPULSION LABORATORY, 1973 JUN 12 BSL00200
  3. C     TO APPEAR IN 'SOLVING LEAST SQUARES PROBLEMS', PRENTICE-HALL, 1974BSL00300
  4. C          SEQUENTIAL SOLUTION OF A BANDED LEAST SQUARES PROBLEM..      BSL00400
  5. C          SOLUTION PHASE.   FOR THE ACCUMULATION PHASE USE BNDACC.     BSL00500
  6. C                                                                       BSL00600
  7. C     MODE = 1     SOLVE R*X=Y   WHERE R AND Y ARE IN THE G( ) ARRAY    BSL00700
  8. C                  AND X WILL BE STORED IN THE X( ) ARRAY.              BSL00800
  9. C            2     SOLVE (R**T)*X=Y   WHERE R IS IN G( ),               BSL00900
  10. C                  Y IS INITIALLY IN X( ), AND X REPLACES Y IN X( ),    BSL01000
  11. C            3     SOLVE R*X=Y   WHERE R IS IN G( ).                    BSL01100
  12. C                  Y IS INITIALLY IN X( ), AND X REPLACES Y IN X( ).    BSL01200
  13. C                                                                       BSL01300
  14. C     THE SECOND SUBSCRIPT OF G( ) MUST BE DIMENSIONED AT LEAST         BSL01400
  15. C     NB+1 IN THE CALLING PROGRAM.                                      BSL01500
  16.       DIMENSION G(MDG,1),X(N)                                           BSL01600
  17.       ZERO=0.                                                           BSL01700
  18. C                                                                       BSL01800
  19.       RNORM=ZERO                                                        BSL01900
  20.       GO TO (10,90,50), MODE                                            BSL02000
  21. C                                   ********************* MODE = 1      BSL02100
  22. C                                   ALGC STEP 26                        BSL02200
  23.    10      DO 20 J=1,N                                                  BSL02300
  24.    20      X(J)=G(J,NB+1)                                               BSL02400
  25.       RSQ=ZERO                                                          BSL02500
  26.       NP1=N+1                                                           BSL02600
  27.       IRM1=IR-1                                                         BSL02700
  28.       IF (NP1.GT.IRM1) GO TO 40                                         BSL02800
  29.            DO 30 J=NP1,IRM1                                             BSL02900
  30.    30      RSQ=RSQ+G(J,NB+1)**2                                         BSL03000
  31.       RNORM=SQRT(RSQ)                                                   BSL03100
  32.    40 CONTINUE                                                          BSL03200
  33. C                                   ********************* MODE = 3      BSL03300
  34. C                                   ALG. STEP 27                        BSL03400
  35.    50      DO 80 II=1,N                                                 BSL03500
  36.            I=N+1-II                                                     BSL03600
  37. C                                   ALG. STEP 28                        BSL03700
  38.            S=ZERO                                                       BSL03800
  39.            L=MAX0(0,I-IP)                                               BSL03900
  40. C                                   ALG. STEP 29                        BSL04000
  41.            IF (I.EQ.N) GO TO 70                                         BSL04100
  42. C                                   ALG. STEP 30                        BSL04200
  43.            IE=MIN0(N+1-I,NB)                                            BSL04300
  44.                 DO 60 J=2,IE                                            BSL04400
  45.                 JG=J+L                                                  BSL04500
  46.                 IX=I-1+J                                                BSL04600
  47.    60           S=S+G(I,JG)*X(IX)                                       BSL04700
  48. C                                   ALG. STEP 31                        BSL04800
  49.    70      IF (G(I,L+1)) 80,130,80                                      BSL04900
  50.    80      X(I)=(X(I)-S)/G(I,L+1)                                       BSL05000
  51. C                                   ALG. STEP 32                        BSL05100
  52.       RETURN                                                            BSL05200
  53. C                                   ********************* MODE = 2      BSL05300
  54.    90      DO 120 J=1,N                                                 BSL05400
  55.            S=ZERO                                                       BSL05500
  56.            IF (J.EQ.1) GO TO 110                                        BSL05600
  57.            I1=MAX0(1,J-NB+1)                                            BSL05700
  58.            I2=J-1                                                       BSL05800
  59.                 DO 100 I=I1,I2                                          BSL05900
  60.                 L=J-I+1+MAX0(0,I-IP)                                    BSL06000
  61.   100           S=S+X(I)*G(I,L)                                         BSL06100
  62.   110      L=MAX0(0,J-IP)                                               BSL06200
  63.            IF (G(J,L+1)) 120,130,120                                    BSL06300
  64.   120      X(J)=(X(J)-S)/G(J,L+1)                                       BSL06400
  65.       RETURN                                                            BSL06500
  66. C                                                                       BSL06600
  67.   130 WRITE (6,140) MODE,I,J,L                                          BSL06700
  68.       STOP                                                              BSL06800
  69.   140 FORMAT (30H0ZERO DIAGONAL TERM IN BNDSOL.,12H MODE,I,J,L=,4I6)    BSL06900
  70.       END                                                               BSL07000
  71.