Program f11zcfe

!     F11ZCF Example Program Text

!     Mark 30.3 Release. nAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: f11zcf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: tmpa
      Integer                          :: bnnz, cnnz, i, ifail, m, n, nnz,     &
                                          store, tmprow
      Character (1)                    :: dup, zer
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: a(:), b(:), c(:)
      Integer, Allocatable             :: bcol(:), brow(:), ccol(:), crow(:),  &
                                          icol(:), irow(:), istc(:)
!     .. Executable Statements ..

      Write (nout,*) 'F11ZCF Example Program Results'
      Write (nout,*)
!     Skip heading in data file
      Read (nin,*)

!     Read dimensions of matrices and number of nonzero entries of B

      Read (nin,*) m
      Read (nin,*) n
      Read (nin,*) bnnz

      Allocate (b(bnnz),bcol(bnnz),brow(bnnz))

!     Read the non-zero elements of B

      Do i = 1, bnnz
        Read (nin,*) b(i), brow(i), bcol(i)
      End Do

!     Read number of non-zero entries of C
      Read (nin,*) cnnz

      Allocate (c(cnnz),ccol(cnnz),crow(cnnz))

!     Read the non-zero elements of C

      Do i = 1, cnnz
        Read (nin,*) c(i), crow(i), ccol(i)
      End Do

!     Output the original non-zero elements

      Write (nout,*) 'Elements of B'
      Write (nout,99999) bnnz
      Write (nout,99997) 'B', 'BROW', 'BCOL'
      Do i = 1, bnnz
        Write (nout,99998) i, b(i), brow(i), bcol(i)
      End Do
      Write (nout,*)

      Write (nout,*) 'Elements of C'
      Write (nout,99999) cnnz
      Write (nout,99997) 'C', 'CROW', 'CCOL'
      Do i = 1, cnnz
        Write (nout,99998) i, c(i), crow(i), ccol(i)
      End Do
      Write (nout,*)

!     Set initial size for resulting array a
      nnz = bnnz + cnnz

      Allocate (a(nnz),icol(nnz),irow(nnz),istc(n+1))

!     Concatenate sparse matrices B and C to form A

      a(1:bnnz) = b
      a(bnnz+1:nnz) = c

      irow(1:bnnz) = brow
      irow(bnnz+1:nnz) = crow

      icol(1:bnnz) = bcol
      icol(bnnz+1:nnz) = ccol

!     A is in Coordinate Storage (CS) format

      store = 1

!     Reorder along columns, sum duplicates and remove zeros

      dup = 'S'
      zer = 'R'

!     ifail: behaviour on error exit
!             =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft
      ifail = 0

      Call f11zcf(m,n,nnz,a,irow,icol,istc,store,dup,zer,ifail)

!     Output results

      Write (nout,*) 'Summed and reordered elements of A = B + C, ',           &
        'along columns first'
      Write (nout,99999) nnz
      Write (nout,99997) 'A', 'IROW', 'ICOL'
      Do i = 1, nnz
        Write (nout,99998) i, a(i), irow(i), icol(i)
      End Do
      Write (nout,*)

!     Output results in Compressed Column Storage (CCS) format

      Write (nout,*) 'Same matrix in CCS format'
      Write (nout,99999) nnz
      Write (nout,99997) 'A', 'IROW', 'ISTC'
      Do i = 1, nnz
        If (i<=n+1) Then
          Write (nout,99998) i, a(i), irow(i), istc(i)
        Else
          Write (nout,99998) i, a(i), irow(i)
        End If
      End Do
      Write (nout,*)

!     Reorder some rows within columns

!     1,1 <--> 3,1 at i=1,2
      tmpa = a(1)
      tmprow = irow(1)
      a(1) = a(2)
      irow(1) = irow(2)
      a(2) = tmpa
      irow(2) = tmprow

!     1,3 <--> 3,3 at i=5,7
      tmpa = a(5)
      tmprow = irow(5)
      a(5) = a(7)
      irow(5) = irow(7)
      a(7) = tmpa
      irow(7) = tmprow

!     Output (in CCS format) the matrix being converted

      Write (nout,*) 'Same matrix with some rows put out of order'
      Write (nout,99999) nnz
      Write (nout,99997) 'A', 'IROW', 'ISTC'
      Do i = 1, nnz
        If (i<=n+1) Then
          Write (nout,99998) i, a(i), irow(i), istc(i)
        Else
          Write (nout,99998) i, a(i), irow(i)
        End If
      End Do
      Write (nout,*)

!     Set up for conversion back to CS

      icol(1:nnz) = 0
      store = 2
      dup = 'F'
      zer = 'F'
      ifail = 0

      Call f11zcf(m,n,nnz,a,irow,icol,istc,store,dup,zer,ifail)

!     Output in CS format to compare to original

      Write (nout,*)                                                           &
        'Rows reordered and matrix converted from CCS to CS format'
      Write (nout,99999) nnz
      Write (nout,99997) 'A', 'IROW', 'ICOL'
      Do i = 1, nnz
        Write (nout,99998) i, a(i), irow(i), icol(i)
      End Do
      Write (nout,*)

!     Use CS format to pass transpose of A

      istc(1:n+1) = 0
      store = 1
      ifail = 0

!     Pass icol/irow and m/n in opposite order.

      Call f11zcf(n,m,nnz,a,icol,irow,istc,store,dup,zer,ifail)

!     Output result in CS format.

      Write (nout,*) 'Transpose of this matrix passed to get row-major order'
      Write (nout,99999) nnz
      Write (nout,99997) 'A', 'IROW', 'ICOL'
      Do i = 1, nnz
        Write (nout,99998) i, a(i), irow(i), icol(i)
      End Do
      Write (nout,*)

99999 Format (1X,'NNZ = ',I4)
99998 Format (1X,I8,1P,E16.4,2I8)
99997 Format (24X,A,4X,A,4X,A)

    End Program f11zcfe