Cacher is the code snippet organizer for pro developers

  !------------------------------------------------------------------------
! 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