Program d06ccfe ! D06CCF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. 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 Procedures .. 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 100 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 100 Continue 99999 Format (1X,A,I6) 99998 Format (1X,2I10) 99997 Format (2(2X,E13.6)) 99996 Format (1X,4I10) End Program d06ccfe