sd_sro.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE sd_sro
!                   *****************
!
     &(n,ip,ia,ja,a,q,r,dflag)
!
!***********************************************************************
! BIEF   V6P1                                   21/07/2011
!***********************************************************************
!
!brief    SYMMETRIC REORDERING OF SPARSE SYMMETRIC MATRIX.
!code
!+    THE NONZERO ENTRIES OF THE MATRIX M ARE ASSUMED TO BE STORED
!+    SYMMETRICALLY IN (IA,JA,A) FORMAT (I.E., NOT BOTH M(I,J) AND M(J,I)
!+    ARE STORED IF I NE J).
!+
!+    SRO DOES NOT REARRANGE THE ORDER OF THE ROWS, BUT DOES MOVE
!+    NONZEROES FROM ONE ROW TO ANOTHER TO ENSURE THAT IF M(I,J) WILL BE
!+    IN THE UPPER TRIANGLE OF M WITH RESPECT TO THE NEW ORDERING, THEN
!+    M(I,J) IS STORED IN ROW I (AND THUS M(J,I) IS NOT STORED);  WHEREAS
!+    IF M(I,J) WILL BE IN THE STRICT LOWER TRIANGLE OF M, THEN M(J,I) IS
!+    STORED IN ROW J (AND THUS M(I,J) IS NOT STORED).
!
!note     IMPORTANT: INSPIRED FROM PACKAGE CMLIB3 - YALE UNIVERSITE-YSMP
!
!history  E. RAZAFINDRAKOTO (LNH)
!+        20/11/06
!+        V5P7
!+
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| A              |---| NONZERO ELEMENT OF MATRIX
!| DFLAG          |-->| LOGICAL VARIABLE;  IF DFLAG = .TRUE., THEN
!|                |   | STORE NONZERO DIAGONAL ELEMENTS AT THE
!|                |   | BEGINNING OF THE ROW
!| IA             |---| INTEGER ONE-DIMENSIONAL ARRAY CONTAINING
!|                |   | POINTERS TO DELIMIT ROWS IN JA AND A;
!|                |   | DIMENSION = N+1
!! IP             |-->| INTEGER ONE-DIMENSIONAL ARRAY USED TO RETURN
!|                |   | THE INVERSE OF THE PERMUTATION RETURNED IN IP;
!|                |   | DIMENSION = N
!| JA             |---| INTEGER ONE-DIMENSIONAL ARRAY CONTAINING THE
!|                |   | COLUMN INDICES CORRESPONDING TO THE ELEMENTS
!|                |   | OF A;
!| N              |-->| DIMENSION = NUMBER OF
!|                |   | NONZERO ENTRIES IN THE UPPER TRIANGLE OF M
!| Q              |<--| INTEGER ONE-DIMENSIONAL WORK ARRAY
!| R              |<--| INTEGER ONE-DIMENSIONAL WORK ARRAY
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_sd_sro => sd_sro
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN)             :: N
      INTEGER, INTENT(IN)             :: IP(*)
      INTEGER, INTENT(INOUT)          :: JA(*),R(*),Q(n),IA(*)
      DOUBLE PRECISION, INTENT(INOUT) :: A(*)
      LOGICAL, INTENT(IN)             :: DFLAG
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER I,J,K,JMIN,JMAX,ILAST,JDUMMY,JAK
      DOUBLE PRECISION AK
!
!-----------------------------------------------------------------------
!
!--PHASE 1 -- FINDS ROW IN WHICH TO STORE EACH NONZERO
!----INITIALISES COUNT OF NONZEROES TO BE STORED IN EACH ROW
!
      DO i=1,n
        q(i) = 0
      ENDDO
!
!----FOR EACH NONZERO ELEMENT A(J)
!
      DO 3 i=1,n
        jmin = ia(i)
        jmax = ia(i+1) - 1
        IF(jmin.GT.jmax)  GO TO 3
        DO 2 j=jmin,jmax
!
!--------FINDS ROW (=R(J)) AND COLUMN (=JA(J)) IN WHICH TO STORE A(J)
!
          k = ja(j)
          IF (ip(k).LT.ip(i))  ja(j) = i
          IF (ip(k).GE.ip(i))  k = i
          r(j) = k
!
!--------AND INCREMENTS COUNT OF NONZEROES (=Q(R(J)) IN THAT ROW
!
          q(k) = q(k) + 1
2       CONTINUE
3     CONTINUE
!
!--PHASE 2 -- FINDS NEW IA AND PERMUTATION TO APPLY TO (JA,A)
!----DETERMINES POINTERS TO DELIMIT ROWS IN PERMUTED (JA,A)
!
      DO 4 i=1,n
        ia(i+1) = ia(i) + q(i)
        q(i) = ia(i+1)
4     CONTINUE
!
!----DETERMINES WHERE EACH (JA(J),A(J)) IS STORED IN PERMUTED (JA,A)
!----FOR EACH NONZERO ELEMENT (IN REVERSE ORDER)
!
      ilast = 0
      jmin = ia(1)
      jmax = ia(n+1) - 1
      j = jmax
      DO 6 jdummy=jmin,jmax
        i = r(j)
        IF(.NOT.dflag .OR. ja(j).NE.i .OR. i.EQ.ilast)  GO TO 5
!
!------IF DFLAG, THEN PUTS DIAGONAL NONZERO AT BEGINNING OF ROW
!
        r(j) = ia(i)
        ilast = i
        GO TO 6
!
!------PUTS (OFF-DIAGONAL) NONZERO IN LAST UNUSED LOCATION IN ROW
!
5       q(i) = q(i) - 1
        r(j) = q(i)
!
        j = j-1
6     CONTINUE
!
!--PHASE 3 -- PERMUTES (JA,A) TO UPPER TRIANGULAR FORM (WRT NEW ORDERING)
!
      DO 8 j=jmin,jmax
7       IF (r(j).EQ.j)  GO TO 8
        k = r(j)
        r(j) = r(k)
        r(k) = k
        jak = ja(k)
        ja(k) = ja(j)
        ja(j) = jak
        ak = a(k)
        a(k) = a(j)
        a(j) = ak
        GO TO 7
8     CONTINUE
!
!-----------------------------------------------------------------------
!
      RETURN
      END