sd_nroc.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\sd_nroc.f
00002 !
00039                      SUBROUTINE SD_NROC
00040 !                    ******************
00041 !
00042      &(N, IC, IA, JA, A, JAR, AR, P, FLAG)
00043 !
00044 !***********************************************************************
00045 ! BIEF   V6P3                                   30/06/2013
00046 !***********************************************************************
00047 !
00048 !                  REORDERS ROWS OF A, LEAVING ROW ORDER UNCHANGED
00049 !
00050 !  REORDERS ROWS OF A, LEAVING ROW ORDER UNCHANGED
00051 !
00052 !
00053 !        PARAMETERS USED INTERNALLY..
00054 !  NIA     P     - AT THE KTH STEP, P IS A LINKED LIST OF THE REORDERED
00055 !                    COLUMN INDICES OF THE KTH ROW OF A.  P(N+1) POINTS
00056 !                    TO THE FIRST ENTRY IN THE LIST.
00057 !                    SIZE = N+1.
00058 !  NIA     JAR   - AT THE KTH STEP,JAR CONTAINS THE ELEMENTS OF THE
00059 !                    REORDERED COLUMN INDICES OF A.
00060 !                    SIZE = N.
00061 !  FIA     AR    - AT THE KTH STEP, AR CONTAINS THE ELEMENTS OF THE
00062 !                    REORDERED ROW OF A.
00063 !                    SIZE = N.
00064 !
00065 !
00066 !         DON'T HESITATE TO CHANGE IN/OUTPUT VARIABLES COMMENTS
00067 !         FOR CLARITY
00068 !
00069 !
00070 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00071 !| A              |-->|NONZERO ENTRIES OF THE COEFFICIENT MATRIX M,
00072 !|                |   |STORED BY ROWS
00073 !| IA ,JA         |-->|POINTERS TO DELIMIT THE ROWS IN A ; SIZE = N+1
00074 !| IL, JL         |-->| STRUCTURE OF LOWER FACTORISED TRIANGULAR MATRIX
00075 !| IU, JU         |-->| STRUCTURE OF UPPER FACTORISED TRIANGULAR MATRIX
00076 !| IJU,IJL        |-->| USED TO COMPRESS STORAGE OF JU and JL
00077 !| IC             |-->|INVERSE OF THE ORDERING OF THE COLUMNS OF MATRIX
00078 !| N              |-->| RANK OF MATRIX
00079 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00080 !
00081       IMPLICIT NONE
00082       INTEGER LNG,LU
00083       COMMON/INFO/LNG,LU
00084 !
00085 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00086 !
00087       INTEGER  IC(*), IA(*), JA(*), JAR(*), P(*), FLAG
00088       INTEGER  K,N,JMAX,J,NEWJ,I,JMIN
00089       DOUBLE PRECISION  A(*), AR(*)
00090 !
00091 !  ******  FOR EACH NONEMPTY ROW  *******************************
00092       DO K=1,N
00093         JMIN = IA(K)
00094         JMAX = IA(K+1) - 1
00095         IF(JMIN .GT. JMAX) CYCLE
00096         P(N+1) = N + 1
00097 !  ******  INSERT EACH ELEMENT IN THE LIST  *********************
00098         DO J=JMIN,JMAX
00099           NEWJ = IC(JA(J))
00100           I = N + 1
00101           DO
00102             IF(P(I) .GE. NEWJ) EXIT
00103             I = P(I)
00104           ENDDO
00105           IF(P(I) .EQ. NEWJ) THEN
00106 ! ** ERROR.. DUPLICATE ENTRY IN A
00107             FLAG = N + K
00108             RETURN
00109           ENDIF
00110           P(NEWJ) = P(I)
00111           P(I) = NEWJ
00112           JAR(NEWJ) = JA(J)
00113           AR(NEWJ) = A(J)
00114         ENDDO ! J
00115 !  ******  REPLACE OLD ROW IN JA AND A  *************************
00116         I = N + 1
00117         DO J=JMIN,JMAX
00118           I = P(I)
00119           JA(J) = JAR(I)
00120           A(J) = AR(I)
00121         ENDDO ! J
00122       ENDDO ! K
00123       FLAG = 0
00124 !
00125       RETURN
00126 !
00127       END

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