Program f11zafe

!     F11ZAF Example Program Text

!     Mark 30.0 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: f11mlf, f11zaf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: anorm
      Integer                          :: bnnz, cnnz, i, ifail, j, n, nnz
      Character (1)                    :: dup, norm, zer
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: a(:), b(:), c(:)
      Integer, Allocatable             :: bcol(:), brow(:), ccol(:), crow(:),  &
                                          icol(:), icol2(:), irow(:), istr(:), &
                                          iwork(:), trcol(:), trrow(:)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: all
!     .. Executable Statements ..
      Write (nout,*) 'F11ZAF Example Program Results'
      Write (nout,*)
!     Skip heading in data file
      Read (nin,*)

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

      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,*) '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

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

      Allocate (a(nnz),icol(nnz),irow(nnz),istr(n+1),iwork(n))

!     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

!     Reorder along rows, 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 f11zaf(n,nnz,a,irow,icol,dup,zer,istr,iwork,ifail)

!     Output results

      Write (nout,*) 'Summed and reordered elements of A = B + C, ',           &
        'along rows 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

!     Reorder down columns, fail on duplicates or zeros.
!     Creates CCS storage format as side-effect

      dup = 'F'
      zer = 'F'
      ifail = 0

      Call f11zaf(n,nnz,a,icol,irow,dup,zer,istr,iwork,ifail)

!     Output reordered results

      Write (nout,*) 'Reordered elements, 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

!     Output results in Compressed Column Storage format

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

!     Calculate 1-norm from Compressed Column Storage format

      norm = '1'
      Call f11mlf(norm,anorm,n,istr,irow,a,ifail)

!     Output norm

      Write (nout,99995) anorm

!     Convert CCS format back to Coordinate Storage

      Allocate (icol2(nnz))

      Do i = 1, n
        Do j = istr(i), istr(i+1) - 1
          icol2(j) = i
        End Do
      End Do

!     Check that result matches original Coordinate Storage data

      If (all(icol(1:nnz)==icol2(1:nnz))) Then
        Write (nout,*) 'Converted CCS format back to CS format, ',             &
          'result matches original'
      Else
        Write (nout,*) 'Converted CCS format back to CS format, ',             &
          'result differs from original!'
      End If

!     Swap the row and column vectors to obtain transpose of A

      Allocate (trrow(nnz),trcol(nnz))

      trrow(:) = icol(1:nnz)
      trcol(:) = irow(1:nnz)

!     Output transposed results

      Write (nout,*) 'Transpose of summed and reordered elements, ',           &
        'along rows first'
      Write (nout,99999) nnz
      Write (nout,99997) 'A', 'IROW', 'ICOL'
      Do i = 1, nnz
        Write (nout,99998) i, a(i), trrow(i), trcol(i)
      End Do

99999 Format (1X,'NNZ = ',I4)
99998 Format (1X,I8,1P,E16.4,2I8)
99997 Format (24X,A,4X,A,4X,A)
99996 Format (24X,'a',2X,'IROWIX',2X,'ICOLZP')
99995 Format (1X,'One-norm ',1P,E16.4)
    End Program f11zafe