Program f11zafe

!     F11ZAF Example Program Text

!     Mark 27.0 Release. NAG Copyright 2019.

!     .. 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 order of matrices and number of nonzero entries of B

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

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