sd_nntc.f

Go to the documentation of this file.

!                   ******************
                    SUBROUTINE sd_nntc
!                   ******************
!
     &(n,r,c,il,jl,ijl,l,d,iu,ju,iju,u,z,b,tmp)
!
!***********************************************************************
! BIEF   V6P3                                   30/06/2013
!***********************************************************************
!
!brief NUMERIC SOLUTION OF THE TRANSPOSE OF A SPARSE NONSYMMETRIC SYSTEM
!+      OF LINEAR EQUATIONS GIVEN LU-FACTORIZATION (COMPRESSED POINTER
!+      STORAGE)
!+
!code
!+       INPUT VARIABLES..  N, R, C, IL, JL, IJL, L, D, IU, JU, IJU, U, B
!+       OUTPUT VARIABLES.. Z
!+
!+       PARAMETERS USED INTERNALLY..
!+ FIA    \ TMP   - TEMPORARY VECTOR WHICH GETS RESULT OF SOLVING UT Y = B
!+        \           SIZE = N.
!
!note     IMPORTANT : INSPIRED FROM PACKAGE CMLIB3 - YALE UNIVERSITE-YSMP
!         DON'T HESITATE TO CHANGE IN/OUTPUT VARIABLES COMMENTS
!         FOR CLARITY
!
!history  C. PEYRARD (LNHE)
!+        30/06/13
!+        V6P3
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| B              |-->| RIGHT-HAND SIDE B ;
!| C              |-->| ORDERING OF THE COLUMNS OF MATRIX
!| D              |-->| DIAGONAL FACTORIZED OF MATRIX
!| IL, JL         |-->| STRUCTURE OF LOWER FACTORISED TRIANGULAR MATRIX
!| IU, JU         |-->| STRUCTURE OF UPPER FACTORISED TRIANGULAR MATRIX
!| IJU,IJL        |-->| USED TO COMPRESS STORAGE OF JU and JL
!| L              |-->| LOWER FACTORIZED TRIANGULAR MATRIX
!| N              |-->| RANK OF MATRIX
!| R              |-->| ORDERING OF THE ROWS OF MATRIX
!| TMP            |-->| REAL ONE-DIMENSIONAL WORK ARRAY
!| U              |-->| UPPER FACTORIZED TRIANGULAR MATRIX
!| Z              |<--| SOLUTION X
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER R(*), C(*), IL(*), JL(*), IJL(*), IU(*), JU(*), IJU(*),N
      DOUBLE PRECISION L(*), D(*), U(*), B(*), Z(*), TMP(*)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER K,JMIN,JMAX,MU,J,I,ML
      DOUBLE PRECISION TMPK,SOMME
!
!  ******  SET TMP TO REORDERED B  ************************************
      DO  k=1,n
        tmp(k) = b(c(k))
      ENDDO
!  ******  SOLVE  UT Y = B  BY FORWARD SUBSTITUTION  *******************
      DO k=1,n
        jmin = iu(k)
        jmax = iu(k+1) - 1
        tmpk = -tmp(k)
        IF (jmin .GT. jmax) cycle
        mu = iju(k) - jmin
        DO j=jmin,jmax
          tmp(ju(mu+j)) = tmp(ju(mu+j)) + tmpk * u(j)
        ENDDO
      ENDDO
!  ******  SOLVE  LT X = Y  BY BACK SUBSTITUTION  **********************
      k = n
      DO i=1,n
        somme = -tmp(k)
        jmin = il(k)
        jmax = il(k+1) - 1
        IF (jmin .LE. jmax) THEN
          ml = ijl(k) - jmin
          DO j=jmin,jmax
            somme = somme + l(j) * tmp(jl(ml+j))
          ENDDO ! J
        ENDIF
        tmp(k) = -somme * d(k)
        z(r(k)) = tmp(k)
        k = k - 1
      ENDDO ! I
      RETURN
      END