sd_nroc.f

Go to the documentation of this file.

!                   ******************
                    SUBROUTINE sd_nroc
!                   ******************
!
     &(n, ic, ia, ja, a, jar, ar, p, flag)
!
!***********************************************************************
! BIEF   V6P3                                   30/06/2013
!***********************************************************************
!
!brief   SPARSE MATRIX PACKAGE - NONSYMMETRIC CODES
!                  REORDERS ROWS OF A, LEAVING ROW ORDER UNCHANGED
!
!  REORDERS ROWS OF A, LEAVING ROW ORDER UNCHANGED
!
!
!        PARAMETERS USED INTERNALLY..
!  NIA     P     - AT THE KTH STEP, P IS A LINKED LIST OF THE REORDERED
!                    COLUMN INDICES OF THE KTH ROW OF A.  P(N+1) POINTS
!                    TO THE FIRST ENTRY IN THE LIST.
!                    SIZE = N+1.
!  NIA     JAR   - AT THE KTH STEP,JAR CONTAINS THE ELEMENTS OF THE
!                    REORDERED COLUMN INDICES OF A.
!                    SIZE = N.
!  FIA     AR    - AT THE KTH STEP, AR CONTAINS THE ELEMENTS OF THE
!                    REORDERED ROW OF A.
!                    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
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| A              |-->|NONZERO ENTRIES OF THE COEFFICIENT MATRIX M,
!|                |   |STORED BY ROWS
!| IA ,JA         |-->|POINTERS TO DELIMIT THE ROWS IN A ; SIZE = N+1
!| 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
!| IC             |-->|INVERSE OF THE ORDERING OF THE COLUMNS OF MATRIX
!| N              |-->| RANK OF MATRIX
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER  IC(*), IA(*), JA(*), JAR(*), P(*), FLAG
      INTEGER  K,N,JMAX,J,NEWJ,I,JMIN
      DOUBLE PRECISION  A(*), AR(*)
!
!  ******  FOR EACH NONEMPTY ROW  *******************************
      DO k=1,n
        jmin = ia(k)
        jmax = ia(k+1) - 1
        IF(jmin .GT. jmax) cycle
        p(n+1) = n + 1
!  ******  INSERT EACH ELEMENT IN THE LIST  *********************
        DO j=jmin,jmax
          newj = ic(ja(j))
          i = n + 1
          DO
            IF(p(i) .GE. newj) EXIT
            i = p(i)
          ENDDO
          IF(p(i) .EQ. newj) THEN
! ** ERROR.. DUPLICATE ENTRY IN A
            flag = n + k
            RETURN
          ENDIF
          p(newj) = p(i)
          p(i) = newj
          jar(newj) = ja(j)
          ar(newj) = a(j)
        ENDDO ! J
!  ******  REPLACE OLD ROW IN JA AND A  *************************
        i = n + 1
        DO j=jmin,jmax
          i = p(i)
          ja(j) = jar(i)
          a(j) = ar(i)
        ENDDO ! J
      ENDDO ! K
      flag = 0
!
      RETURN
!
      END