lubksb.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\lubksb.f
00002 !
00056                      SUBROUTINE LUBKSB
00057 !                    *****************
00058 !
00059      &(A,N,NP,INDX,B)
00060 !
00061 !***********************************************************************
00062 ! BIEF   V6P1                                  21/08/2010
00063 !***********************************************************************
00064 !
00065 !
00066 !
00067 !
00068 !
00069 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00070 !| A              |-->| MATRIX OF THE SYSTEM
00071 !| B              |<->| RIGHT-HAND SIDE, THEN SOLUTION
00072 !| INDX           |-->| ADDRESS IN RIGHT-HAND SIDE
00073 !| N              |-->| SIZE OF B
00074 !| NP             |-->| RANK OF MATRIX A
00075 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00076 !
00077       IMPLICIT NONE
00078       INTEGER LNG,LU
00079       COMMON/INFO/LNG,LU
00080 !
00081 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00082 !
00083       INTEGER, INTENT(IN) :: N,NP
00084       INTEGER, INTENT(IN) :: INDX(N)
00085       DOUBLE PRECISION, INTENT(INOUT) :: B(N)
00086       DOUBLE PRECISION, INTENT(IN)    :: A(NP,NP)
00087 !
00088 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00089 !
00090       INTEGER I,II,J,LL
00091       DOUBLE PRECISION XSOM
00092 !
00093 !-----------------------------------------------------------------------
00094 !
00095       II=0 ! WHEN II HAS A POSITIVE VALUE, IT WILL BECOME THE INDEX
00096            ! OF THE FIRST NONVANISHING ELEMENT OF B.
00097            ! DOES THE FORWARD SUBSTITUTION, EQUATION (2.3.6). THE ONLY
00098            ! NEW WRINKLE IS TO UNSCRAMBLE THE PERMUTATION AS WE GO.
00099 !
00100       DO I=1,N
00101         LL=INDX(I)
00102         XSOM=B(LL)
00103         B(LL)=B(I)
00104         IF(II.NE.0) THEN
00105           DO J=II,I-1
00106            XSOM=XSOM-A(I,J)*B(J)
00107           ENDDO
00108         ELSEIF(XSOM.NE.0.D0) THEN
00109           II=I
00110           ! A NONZERO ELEMENT WAS ENCOUNTERED, SO FROM NOW ON
00111           ! WILL HAVE TO DO THE SUMS IN THE ABOVE LOOP
00112         ENDIF
00113         B(I)=XSOM
00114       ENDDO
00115       DO I=N,1,-1 ! DOES THE BACKSUBSTITUTION, EQUATION (2.3.7)
00116         XSOM=B(I)
00117         DO J=I+1,N
00118           XSOM=XSOM-A(I,J)*B(J)
00119         ENDDO
00120         B(I)=XSOM/A(I,I) ! STORES A COMPONENT OF THE SOLUTION VECTOR X
00121       ENDDO
00122 !
00123 !-----------------------------------------------------------------------
00124 !
00125       RETURN
00126       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0