PROGRAM d06ccfe

!      D06CCF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. Use Statements ..
       USE nag_library, ONLY : d06cbf, d06ccf, nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER              :: nin = 5, nout = 6
!      .. Local Scalars ..
       INTEGER                         :: i, i1, ifail, itrace, k, liwork,     &
                                          lrwork, nedge, nelt, nnz, nnzmax,    &
                                          nv, reftk
       CHARACTER (1)                   :: pmesh
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE :: coor(:,:), rwork(:)
       INTEGER, ALLOCATABLE            :: conn(:,:), edge(:,:), icol(:),       &
                                          irow(:), iwork(:)
!      .. Intrinsic Functions ..
       INTRINSIC                          max
!      .. Executable Statements ..
       WRITE (nout,*) 'D06CCF Example Program Results'
       FLUSH (nout)

!      Skip heading in data file
       READ (nin,*)

!      Reading of the geometry

       READ (nin,*) nv, nelt, nedge
       nnzmax = nv**2
       liwork = max(nnzmax,20*nv)
       lrwork = nv
       ALLOCATE (conn(3,nelt),irow(nnzmax),icol(nnzmax),edge(3,nedge), &
          iwork(liwork),coor(2,nv),rwork(lrwork))

       DO i = 1, nv
          READ (nin,*) coor(1,i), coor(2,i)
       END DO

       DO k = 1, nelt
          READ (nin,*) conn(1,k), conn(2,k), conn(3,k), reftk
       END DO

       DO i = 1, nedge
          READ (nin,*) i1, edge(1,i1), edge(2,i1), edge(3,i1)
       END DO

!      Compute the sparsity of the FE matrix
!      from the input geometry

       ifail = 0
       CALL d06cbf(nv,nelt,nnzmax,conn,nnz,irow,icol,ifail)

       WRITE (nout,*)

       READ (nin,*) pmesh

       SELECT CASE (pmesh)
       CASE ('N')
          WRITE (nout,*) 'The Matrix Sparsity characteristics'
          WRITE (nout,*) 'before the renumbering'
          WRITE (nout,99999) 'NV  =', nv
          WRITE (nout,99999) 'NNZ =', nnz
       CASE ('Y')

!         Output the sparsity of the mesh

          WRITE (nout,99998) nv, nnz

          DO i = 1, nnz
             WRITE (nout,99998) irow(i), icol(i)
          END DO

       CASE DEFAULT
          WRITE (nout,*) 'Problem with the printing option Y or N'
          GO TO 20
       END SELECT

       FLUSH (nout)

!      Call the renumbering routine and get the new sparsity

       itrace = 1

       ifail = 0
       CALL d06ccf(nv,nelt,nedge,nnzmax,nnz,coor,edge,conn,irow,icol,itrace, &
          iwork,liwork,rwork,lrwork,ifail)

       SELECT CASE (pmesh)
       CASE ('N')
          WRITE (nout,*)
          WRITE (nout,*) 'The Matrix Sparsity characteristics'
          WRITE (nout,*) 'after the renumbering'
          WRITE (nout,99999) 'NV   =', nv
          WRITE (nout,99999) 'NNZ  =', nnz
          WRITE (nout,99999) 'NELT =', nelt
       CASE ('Y')

!         Output the sparsity of the renumbered mesh

          WRITE (nout,99998) nv, nnz

          DO i = 1, nnz
             WRITE (nout,99998) irow(i), icol(i)
          END DO

!         Output the renumbered mesh

          WRITE (nout,99998) nv, nelt

          DO i = 1, nv
             WRITE (nout,99997) coor(1,i), coor(2,i)
          END DO

          reftk = 0

          DO k = 1, nelt
             WRITE (nout,99996) conn(1,k), conn(2,k), conn(3,k), reftk
          END DO

       END SELECT

20     CONTINUE

99999  FORMAT (1X,A,I6)
99998  FORMAT (1X,2I10)
99997  FORMAT (2(2X,E13.6))
99996  FORMAT (1X,4I10)
    END PROGRAM d06ccfe