sd_nnsc.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\sd_nnsc.f
00002 !
00049                      SUBROUTINE SD_NNSC
00050 !                    ******************
00051 !
00052      &(N,R,C,IL,JL,IJL,L,D,IU,JU,IJU,U,Z,B,TMP)
00053 !
00054 !***********************************************************************
00055 ! BIEF   V6P3                                   21/08/2010
00056 !***********************************************************************
00057 !
00058 !
00059 !         DON'T HESITATE TO CHANGE IN/OUTPUT VARIABLES COMMENTS
00060 !         FOR CLARITY
00061 !
00062 !
00063 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00064 !| B              |-->| RIGHT-HAND SIDE B ;
00065 !| C              |-->| ORDERING OF THE COLUMNS OF MATRIX
00066 !| D              |-->| DIAGONAL FACTORIZED OF MATRIX
00067 !| IL, JL         |-->| STRUCTURE OF LOWER FACTORISED TRIANGULAR MATRIX
00068 !| IU, JU         |-->| STRUCTURE OF UPPER FACTORISED TRIANGULAR MATRIX
00069 !| IJU,IJL        |-->| USED TO COMPRESS STORAGE OF JU and JL
00070 !| L              |-->| LOWER FACTORIZED TRIANGULAR MATRIX
00071 !| N              |-->| RANK OF MATRIX
00072 !| R              |-->| ORDERING OF THE ROWS OF MATRIX
00073 !| TMP            |-->| REAL ONE-DIMENSIONAL WORK ARRAY
00074 !| U              |-->| UPPER FACTORIZED TRIANGULAR MATRIX
00075 !| Z              |<--| SOLUTION X
00076 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00077 !
00078       IMPLICIT NONE
00079       INTEGER LNG,LU
00080       COMMON/INFO/LNG,LU
00081 !
00082 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00083 !
00084       INTEGER R(*), C(*), IL(*), JL(*), IJL(*), IU(*), JU(*), IJU(*),N
00085       DOUBLE PRECISION  L(*), D(*), U(*), B(*), Z(*), TMP(*)
00086 !
00087 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00088 !
00089       INTEGER K,JMIN,JMAX,ML,J,MU,I
00090       DOUBLE PRECISION TMPK,SUM
00091 !
00092 !-----------------------------------------------------------------------
00093 !
00094 !     SET TMP TO REORDERED B
00095 !
00096       DO K=1,N
00097         TMP(K) = B(R(K))
00098       ENDDO
00099 !
00100 !     SOLVE  LY = B  BY FORWARD SUBSTITUTION
00101 !
00102       DO K=1,N
00103         JMIN = IL(K)
00104         JMAX = IL(K+1) - 1
00105         TMPK = -D(K) * TMP(K)
00106         TMP(K) = -TMPK
00107         IF (JMIN .GT. JMAX) CYCLE
00108         ML = IJL(K) - JMIN
00109         DO J=JMIN,JMAX
00110           TMP(JL(ML+J)) = TMP(JL(ML+J)) + TMPK * L(J)
00111         ENDDO
00112       ENDDO ! K
00113 !
00114 !     SOLVE  UX = Y  BY BACK SUBSTITUTION
00115 !
00116       K = N
00117       DO I=1,N
00118         SUM = -TMP(K)
00119         JMIN = IU(K)
00120         JMAX = IU(K+1) - 1
00121         IF (JMIN .GT. JMAX) GO TO 5
00122         MU = IJU(K) - JMIN
00123         DO J=JMIN,JMAX
00124           SUM = SUM + U(J) * TMP(JU(MU+J))
00125         ENDDO
00126    5    TMP(K) = -SUM
00127         Z(C(K)) = -SUM
00128         K = K - 1
00129       ENDDO
00130 !
00131 !-----------------------------------------------------------------------
00132 !
00133       RETURN
00134       END

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