Program f11yefe
! F11YEF Example Program Text
! Mark 25 Release. NAG Copyright 2014.
! .. Use Statements ..
Use nag_library, Only: f11yef, nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Integer, Parameter :: nin = 5, nout = 6
Logical, Parameter :: plotdata = .False.
! .. Local Scalars ..
Integer :: ifail, n, nnz
Logical :: bw_after, bw_before, check_sym, &
do_cm, use_mask
! .. Local Arrays ..
Integer, Allocatable :: icolzp(:), irowix(:), mask(:), perm(:)
Integer :: info(4)
Logical :: lopts(5)
! .. Executable Statements ..
Write (nout,*) 'F11YEF Example Program Results'
! Skip heading in data file
Read (nin,*)
! Size of the matrix
Read (nin,*) n
! Number of non-zero elements
Read (nin,*) nnz
Allocate (icolzp(n+1),irowix(nnz),mask(n),perm(n))
! Read in data
Read (nin,*) irowix(1:nnz)
Read (nin,*) icolzp(1:n+1)
! Set options
use_mask = .False.
do_cm = .False.
check_sym = .True.
bw_before = .True.
bw_after = .True.
lopts(1:5) = (/use_mask,do_cm,check_sym,bw_before,bw_after/)
! ifail: behaviour on error exit
! =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft
ifail = 0
Call f11yef(n,nnz,icolzp,irowix,lopts,mask,perm,info,ifail)
! Print results
Write (nout,'(A)') 'Permutation (perm):'
Write (nout,99999) perm(1:n)
Write (nout,*)
Write (nout,'(A)') 'Statistics:'
Write (nout,'(A,I6)') ' Before: Bandwidth = ', info(1)
Write (nout,'(A,I6)') ' Before: Profile = ', info(2)
Write (nout,'(A,I6)') ' After : Bandwidth = ', info(3)
Write (nout,'(A,I6)') ' After : Profile = ', info(4)
! Print matrix entries and permuted entries in form suitable for printing
If (plotdata) Then
Call plot(n,nnz)
End If
99999 Format (6(4X,I3))
Contains
Subroutine uncompress(n,nnz,icolzp,icol)
! .. Implicit None Statement ..
Implicit None
! .. Scalar Arguments ..
Integer, Intent (In) :: n, nnz
! .. Array Arguments ..
Integer, Intent (Out) :: icol(nnz)
Integer, Intent (In) :: icolzp(n+1)
! .. Local Scalars ..
Integer :: col_beg, col_end, i
! .. Executable Statements ..
Do i = 1, n
col_end = icolzp(i+1) - 1
col_beg = icolzp(i)
If (col_end>=col_beg) Then
icol(col_beg:col_end) = i
End If
End Do
Return
End Subroutine uncompress
Subroutine plot(n,nnz)
! Put data, suitable for plotting matrix structure, in data file
! .. Use Statements ..
Use nag_library, Only: f11zaf
! .. Implicit None Statement ..
Implicit None
! .. Scalar Arguments ..
Integer, Intent (In) :: n, nnz
! .. Local Scalars ..
Integer :: i, ifail, nnz2
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable :: a(:)
Integer, Allocatable :: icolix(:), ipcolix(:), iperm(:), &
iprowix(:), istr(:), iwork(:)
! .. Executable Statements ..
Allocate (icolix(nnz),ipcolix(nnz),iprowix(nnz))
Allocate (iperm(n),a(nnz),istr(n+1),iwork(n))
! Decompress icolzp to full set of column indices and invert perm
Call uncompress(n,nnz,icolzp,icolix)
Do i = 1, n
iperm(perm(i)) = i
End Do
! Give some nice values, encoding original position
Do i = 1, nnz
a(i) = icolix(i)*.01_nag_wp + 1.0_nag_wp*irowix(i)
End Do
! Original matrix structure
Write (*,'(I8,4X,I8,4X,F8.2)')(irowix(i),icolix(i),a(i),i=1,nnz)
Write (*,'(/)')
! Permute
Do i = 1, nnz
a(i) = icolix(i)*.01_nag_wp + 1.0_nag_wp*irowix(i)
ipcolix(i) = iperm(icolix(i))
iprowix(i) = iperm(irowix(i))
End Do
! Reorder (in exit: istr contains new CCS icolzp)
nnz2 = nnz
ifail = 0
Call f11zaf(n,nnz2,a,ipcolix,iprowix,'F','K',istr,iwork,ifail)
! Permuted matrix structure
Write (*,'(I8,4X,I8,4X,F8.2)')(iprowix(i),ipcolix(i),a(i),i=1,nnz2)
Deallocate (icolix,ipcolix,iprowix,iperm,a,istr,iwork)
Return
End Subroutine plot
End Program f11yefe