Program f11zcfe
! F11ZCF Example Program Text
! Mark 28.6 Release. NAG Copyright 2022.
! .. 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