wohhie
11/7/2018 - 12:11 PM
Assignment 7
!------------------------------------------------------------------------
! The fortran subroutine CSRorCSC(R,C,V, n, nz) which converts
! the CSR representation of a sparse matrix to its CSC representation
!-------------------------------------------------------------------------
! Also a program which enters a sparse matrix (in the COO format) and
! creates its CSR Representation, invokes the CSRorCSC Subroutine and
! output the result.
!-------------------------------------------------------------------------
PROGRAM A7Q1
IMPLICIT NONE
! DECLARE VARIABLES
INTEGER, DIMENSION(:,:), ALLOCATABLE :: A
INTEGER, DIMENSION(3) :: B
INTEGER :: i, j, size, m, n, check, k, rowIndex, loop, columnIndex, temp
INTEGER :: zero, nonzero
! R, C, V
INTEGER, DIMENSION(:), ALLOCATABLE :: D
INTEGER, DIMENSION(:), ALLOCATABLE :: R
INTEGER, DIMENSION(:), ALLOCATABLE :: C
INTEGER, DIMENSION(:), ALLOCATABLE :: V
INTEGER, DIMENSION(:), ALLOCATABLE :: R1
INTEGER, DIMENSION(:), ALLOCATABLE :: C1
INTEGER, DIMENSION(:), ALLOCATABLE :: V1
! GET THE SPARSE MATRIX IN COO FORMAT
DO
PRINT *, "ENTER THE (SIZE OF MATRIX) m and n (OR 0 0 to END): "
READ *, m ,n
IF (m .eq. 0 .or. n .eq. 0) STOP
IF (m .lt. 0 .or. n .lt. 0) THEN
PRINT *, "NEGATIVE NUMBER OF ELEMENTS: "
ELSE
! ALLOCATE THE ARRAY A
ALLOCATE(A(m,n))
PRINT "(1X, 'ENTER THE MATRIX VALUES OF A', I3, '*', I3, ' ELEMENTS:')", m, n
READ *, ((A(i, j), i = 1, m), j = 1, n)
! DISPLAY USER INPUT (LATER WE WILL USE THE FORMATTING.)
PRINT *, "COO FORMAT : "
DO i = 1,m
PRINT "(5X,15I5)", A(i,1:n)
END DO
! CSRorCSC FORMAT
size = 1
DO i = 1, m
DO j = i, n
IF (A(i, j) /= 0) THEN
size = size + 1
END IF
END DO
END DO
PRINT *, size ! 8 for demo sparse matrix
! ALLOCATING R, C, V
ALLOCATE(D(m), STAT = check)
ALLOCATE(R(size), STAT = check)
ALLOCATE(C(size), STAT = check)
ALLOCATE(V(size), STAT = check)
ALLOCATE(C1(m), STAT = check)
ALLOCATE(R1(size), STAT = check)
ALLOCATE(V1(size), STAT = check)
! GETTING THE R,C,V FOR CSR
k = 1
rowIndex = 0
nonzero = 0
zero = 0
DO i = 1, m
DO j = 1, n
IF (A(i, j) /= 0) THEN
R(k) = i
rowIndex = rowIndex + 1
C(k) = j
V(k) = A(i, j)
k = k + 1
END IF
END DO
D(i) = rowIndex
END DO
PRINT *, "CSR FORMAT: "
PRINT *, "R: ", D
PRINT *, "C: ", C
PRINT *, "V: ", V
CALL CSRorCSC(R, C, V, size, nonzero);
END IF
END DO
CONTAINS
SUBROUTINE CSRorCSC (R,C,V,n,nz)
INTEGER, DIMENSION(n), INTENT(INOUT) :: R
INTEGER, DIMENSION(n), INTENT(INOUT) :: C
INTEGER, DIMENSION(n), INTENT(INOUT) :: V
INTEGER, INTENT(IN) :: n, nz
PRINT *, "CSC FORMAT: "
!-------------------------------------------------
columnIndex = 0
k = 1
DO i = 1, m
DO j = 1, size
IF(i .eq. C(j)) THEN
V1(k) = V(j)
columnIndex = columnIndex + 1
R1(k) = R(j)
k = k + 1
END IF
END DO
C1(i) = columnIndex
END DO
PRINT *,"C: ", C1
PRINT *,"R: ", R1
PRINT *,"V: ", V1
PRINT *, "CSR FORMAT: "
!-------------------------------------------------
rowIndex = 0
k = 1
DO i = 1, m
DO j = 1, size
IF(i .eq. R(j)) THEN
V(k) = V1(j)
rowIndex = rowIndex + 1
R(k) = R1(j)
k = k + 1
END IF
END DO
D(i) = rowIndex
END DO
PRINT *,"R: ", D
PRINT *,"C: ", C
PRINT *,"V: ", V
END SUBROUTINE CSRorCSC
END PROGRAM A7Q1
PROGRAM A7Q2
IMPLICIT NONE
INTEGER, DIMENSION(:), ALLOCATABLE :: R1,C1,V1,R2,C2,V2,R3,C3,V3
INTEGER ::n,nz1,nz2,n3,myresult
n=-1
nz1=-1
nz2=-1
n3=-1
DO WHILE (n<1) !-- Keeps asking for positive array size
PRINT *, "Enter the size of matrix n*n, n: "
READ *, n
END DO
DO WHILE ((nz1<1).or.(nz1.gt.(n*n))) !-- nz1 should be less than n*n
PRINT *, "For matrix 1 enter the number of non-zero elements , nz1: "
READ *, nz1
END DO
DO WHILE ((nz2<0).or.(nz2.gt.(n*n))) !-- nz1 should be less than n*n
PRINT *, "For matrix 2 enter the number of non-zero elements , nz2: "
READ *, nz2
END DO
DO WHILE (n3<0) !-- Keeps asking for positive array size
PRINT *, "For matrix 3 enter your estimation, n3: "
READ *, n3
END DO
ALLOCATE(R1(n),R2(n),R3(n))
ALLOCATE(C1(nz1),C2(nz2),C3(n3))
ALLOCATE(V1(nz1),V2(nz2),V3(n3))
!-Reading matrices
PRINT *," ========== Enter matrices in CSR format ==========="
PRINT *,"For matrix 1, enter row index: "
READ *, R1
PRINT *,"For matrix 1, enter column index: "
READ *, C1
PRINT *,"For matrix 1, enter value array: "
READ *, V1
PRINT *,"For matrix 2, enter row index: "
READ *, R2
PRINT *,"For matrix 2, enter column index: "
READ *, C2
PRINT *,"For matrix 2, enter value array: "
READ *, V2
PRINT *," ========== The result in CSR format ==========="
myresult=SparseAdd(R1,C1,V1,R2,C2,V2,R3,C3,V3,n,nz1,nz2,n3)
IF (myresult.gt.0) THEN
PRINT *," The matrix C row index is:",R3
PRINT *," The matrix C column index is:", C3(1:myresult)
PRINT *," The matrix C value array is:", V3(1:myresult)
ELSE IF(myresult.eq.0) THEN
PRINT *," The matrix C has no none-zero element"
ELSE
PRINT *," The matrix C is too small for the result"
END IF
DEALLOCATE(R1,C1,V1,R2,C2,V2,R3,C3,V3)
CONTAINS
!-- the main function
INTEGER FUNCTION SparseAdd(R1,C1,V1,R2,C2,V2,R3,C3,V3,n,nz1,nz2,n3)
INTEGER, DIMENSION(:), INTENT(INOUT)::R3,C3,V3
INTEGER, DIMENSION(:), INTENT(INOUT)::R1,C1,V1,R2,C2,V2
INTEGER, DIMENSION(n,n)::BigC3 !-- a n*n matrix which stores the whole matrix C
INTEGER, DIMENSION(nz1)::RCOO1 !-- Row index for matrix 1 in COO format
INTEGER, DIMENSION(nz2)::RCOO2 !-- Row index for matrix 2 in COO format
INTEGER, DIMENSION(n3)::RCOO3 !-- Row index for matrix 3 in COO format
INTEGER, INTENT(IN):: n,nz1,nz2,n3
INTEGER :: i,j,k
SparseAdd=0
R3=0
C3=0
V3=0
!-- Converting CSR format to COO to add them
CALL CSRtoCOO(RCOO1,R1,n,nz1)
CALL CSRtoCOO(RCOO2,R2,n,nz2)
BigC3=0
!-- Adding two matrices to make BigC3 which is a 2D matrix
DO i=1, nz1
BigC3(RCOO1(i),C1(i))=BigC3(RCOO1(i),C1(i))+ V1(i)
END DO
DO i=1, nz2
BigC3(RCOO2(i),C2(i))=BigC3(RCOO2(i),C2(i))+ V2(i)
END DO
!-- Checking to see if none-zero elements of BigC3 exceeds n3 or not
DO i=1,n
Do j=1,n
IF (BigC3(i,j).ne.0) SparseAdd=SparseAdd+1
END DO
END DO
IF (SparseAdd.le.n3) THEN
!- Making CSR out of BigC3
!-- Forming R
DO i=1,n
IF(i.ne.1) R3(i)=R3(i-1)
Do j=1,n
IF (BigC3(i,j).ne.0) R3(i)=R3(i)+1
END DO
END DO
!-- Creating C3
k=0
DO i=1,n
DO j=1,n
IF (BigC3(i,j).ne.0) THEN
k=k+1
C3(k)=j
END IF
END DO
END DO
!-- Producing V3
k=0
DO i=1,n
DO j=1,n
IF (BigC3(i,j).ne.0) THEN
k=k+1
V3(k)=BigC3(i,j)
END IF
END DO
END DO
ELSE
SparseAdd=-1
END IF
END FUNCTION SparseAdd
!-------------------------------------------------------
!-- helper subroutine to convert CSR to COO
SUBROUTINE CSRtoCOO(RowCOO,RowCSR,n,nz)
INTEGER, DIMENSION(:), INTENT(INOUT) :: RowCOO,RowCSR
INTEGER, INTENT(IN):: n ,nz
INTEGER :: i, j, b
DO j=1,n
IF (j==1) THEN
b=1
ELSE
b=RowCSR(j-1)+1
END IF
DO i = b, RowCSR(j)
RowCOO(i)=j
END DO
END DO
END SUBROUTINE CSRtoCOO
END PROGRAM A7Q2