Program f11yefe

!     F11YEF Example Program Text

!     Mark 30.1 Release. NAG Copyright 2024.

!     .. 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 nonzero 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