Program d06aafe ! D06AAF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: d06aaf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: coef, power Integer :: i, i1, ifail, itrace, k, liwork, & lrwork, nedge, nelt, nv, nvb, nvmax, & reftk Logical :: smooth Character (1) :: pmesh ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: bspace(:), coor(:,:), rwork(:) Integer, Allocatable :: conn(:,:), edge(:,:), iwork(:) ! .. Intrinsic Procedures .. Intrinsic :: max ! .. Executable Statements .. Write (nout,*) 'D06AAF Example Program Results' ! Skip heading in data file Read (nin,*) ! Reading of the geometry ! Coordinates of the boundary mesh vertices and ! edges references. Read (nin,*) nvb, nvmax, nedge lrwork = nvmax liwork = 16*nvmax + 2*nedge + max(4*nvmax+2,nedge-14) Allocate (bspace(nvb),coor(2,nvmax),rwork(lrwork),conn(3,2*(nvmax- & 1)),edge(3,nedge),iwork(liwork)) Do i = 1, nvb Read (nin,*) i1, coor(1,i1), coor(2,i1) End Do ! Boundary edges Do i = 1, nedge Read (nin,*) i1, edge(1,i1), edge(2,i1), edge(3,i1) End Do ! Initialise mesh control parameters bspace(1:nvb) = 0.05E0_nag_wp smooth = .True. itrace = 0 coef = 0.75E0_nag_wp power = 0.25E0_nag_wp ! Call to the mesh generator ifail = 0 Call d06aaf(nvb,nvmax,nedge,edge,nv,nelt,coor,conn,bspace,smooth,coef, & power,itrace,rwork,lrwork,iwork,liwork,ifail) Write (nout,*) Read (nin,*) pmesh Select Case (pmesh) Case ('N') Write (nout,99999) 'NV =', nv Write (nout,99999) 'NELT =', nelt Case ('Y') ! Output the 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 Case Default Write (nout,*) 'Problem with the printing option Y or N' End Select 99999 Format (1X,A,I6) 99998 Format (1X,2I10) 99997 Format (2(2X,E13.6)) 99996 Format (1X,4I10) End Program d06aafe