C
C Parallel Sparse BLAS v2.0
C (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
C Alfredo Buttari University of Rome Tor Vergata
C
C Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions
C are met:
C 1. Redistributions of source code must retain the above copyright
C notice, this list of conditions and the following disclaimer.
C 2. Redistributions in binary form must reproduce the above copyright
C notice, this list of conditions, and the following disclaimer in the
C documentation and/or other materials provided with the distribution.
C 3. The name of the PSBLAS group or the names of its contributors may
C not be used to endorse or promote products derived from this
C software without specific written permission.
C
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
C TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
C PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
C BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
C CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
C SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
C INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
C CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
C ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
C POSSIBILITY OF SUCH DAMAGE.
C
C
* SUBROUTINE DESYM(NROW,A,JA,IA,AS,JAS,IAS,IAW,NNZERO) *
* *
* Purpose *
* ======= *
* Utility routine to convert from symmetric storage *
* to full format (CSR mode). *
* *
* Parameter *
* ========= *
* INPUT= *
* *
* SYMBOLIC NAME: NROW *
* POSITION: Parameter No.1 *
* ATTRIBUTES: INTEGER *
* VALUES: NROW>0 *
* DESCRIPTION: On entry NROW specifies the number of rows of the *
* input sparse matrix. The number of column of the input *
* sparse matrix mest be the same. *
* Unchanged on exit. *
* *
* SYMBOLIC NAME: A *
* POSITION: Parameter No.2 *
* ATTRIBUTES: DOUBLE PRECISION ARRAY of Dimension (NNZERO) *
* VALUES: *
* DESCRIPTION: A specifies the values of the input sparse matrix. *
* This matrix is stored in CSR mode *
* Unchanged on exit. *
* *
* SYMBOLIC NAME: JA *
* POSITION: Parameter No. 3 *
* ATTRIBUTES: INTEGER ARRAY(IA(NNZERO)) *
* VALUES: > 0 *
* DESCRIPTION: Column indices stored by rows refered to the input *
* sparse matrix. *
* Unchanged on exit. *
* *
* SYMBOLIC NAME: IA *
* POSITION: Parameter No. 4 *
* ATTRIBUTES: INTEGER ARRAY(NROW+1) *
* VALUES: >0; increasing. *
* DESCRIPTION: Row pointer array: it contains the starting *
* position of each row of A in array JA. *
* Unchanged on exit. *
* *
* SYMBOLIC NAME: IAW *
* POSITION: Parameter No. 7 *
* ATTRIBUTES: INTEGER ARRAY of Dimension (NROW+1) *
* VALUES: >0; *
* DESCRIPTION: Work Area. *
* *
* SYMBOLIC NAME: WORK *
* POSITION: Parameter No. 8 *
* ATTRIBUTES: REAL*8 ARRAY of Dimension (NROW+1) *
* VALUES: >0; *
* DESCRIPTION: Work Area. *
* *
* SYMBOLIC NAME: NNZERO *
* POSITION: Parameter No. 9 *
* ATTRIBUTES: INTEGER *
* VALUES: >0; *
* DESCRIPTION: On entry contains: the number of the non zero *
* entry of the input matrix. *
* Unchanged on exit. *
* OUTPUT== *
* *
* *
* SYMBOLIC NAME: AS *
* POSITION: Parameter No.5 *
* ATTRIBUTES: DOUBLE PRECISION ARRAY of Dimension (*) *
* VALUES: *
* DESCRIPTION: On exit A specifies the values of the output sparse *
* matrix. *
* This matrix correspondes to A rapresented in FULL-CSR *
* mode *
* *
* SYMBOLIC NAME: JAS *
* POSITION: Parameter No. 6 *
* ATTRIBUTES: INTEGER ARRAY(IAS(NROW+1)-1) *
* VALUES: > 0 *
* DESCRIPTION: Column indices stored by rows refered to the output *
* sparse matrix. *
* *
* SYMBOLIC NAME: IAS *
* POSITION: Parameter No. S *
* ATTRIBUTES: INTEGER ARRAY(NROW+1) *
* VALUES: >0; increasing. *
* DESCRIPTION: Row pointer array: it contains the starting *
* position of each row of AS in array JAS. *
*****************************************************************************
C
SUBROUTINE DESYM(NROW,A,JA,IA,AS,JAS,IAS,AUX,WORK,NNZERO,
+ PTR, NZR, VALUE)
IMPLICIT NONE
C .. Scalar Arguments ..
INTEGER NROW,NNZERO,VALUE,INDEX,PTR, NZR
C .. Array Arguments ..
DOUBLE PRECISION A(*),AS(*),WORK(*)
INTEGER IA(*),IAS(*),JAS(*),JA(*),AUX(*)
C .. Local Scalars ..
INTEGER I,IAW1,IAW2,IAWT,J,JPT,K,KPT,LDIM,NZL,JS,IRET,NEL,DIAGEL
C REAL*8 BUF
C ..
NEL = 0
DIAGEL=0
DO I=1, NNZERO
IF(JA(I).LE.IA(I)) THEN
NEL = NEL+1
AS(I) = A(I)
JAS(I) = JA(I)
IAS(I) = IA(I)
IF(JA(I).NE.IA(I)) THEN !This control avoids malfunctions in the cases
! where the matrix is declared symmetric but all
!his elements are explicitly stored
! see young1c.mtx from "Matrix Market"
AS(NNZERO+I) = A(I)
JAS(NNZERO+I) = IA(I)
IAS(NNZERO+I) = JA(I)
ELSE
DIAGEL = DIAGEL+1
END IF
END IF
END DO
C .... Order with key IAS ...
CALL MRGSRT(2*NNZERO,IAS,AUX,IRET)
IF (IRET.EQ.0) CALL REORDVN(2*NNZERO,AS,IAS,JAS,AUX)
C .... Order with key JAS ...
I = 1
J = I
DO WHILE (I.LE.(2*NNZERO))
DO WHILE ((IAS(J).EQ.IAS(I)).AND.
+ (J.LE.2*NNZERO))
J = J+1
ENDDO
NZL = J - I
CALL MRGSRT(NZL,JAS(I),AUX,IRET)
IF (IRET.EQ.0) CALL REORDVN(NZL,AS(I),IAS(I),JAS(I),
+ AUX)
I = J
ENDDO
NZR = NEL*2 - DIAGEL
PTR = 2*NNZERO-NZR+1
RETURN
END