Program d06abfe ! D06ABF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: d06abf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: dnvint Integer :: i, i1, ifail, itrace, j, k, liwork, & lrwork, nedge, nelt, npropa, nv, & nvb, nvint, nvmax, reftk Character (1) :: pmesh ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: coor(:,:), rwork(:), weight(:) Integer, Allocatable :: conn(:,:), edge(:,:), iwork(:) ! .. Intrinsic Procedures .. Intrinsic :: real ! .. Executable Statements .. Write (nout,*) 'D06ABF 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, nvint, nvmax, nedge lrwork = 12*nvmax + 15 liwork = 6*nedge + 32*nvmax + 2*nvb + 78 Allocate (coor(2,nvmax),rwork(lrwork),weight(nvint),conn(3,2*nvmax+5), & edge(3,nedge),iwork(liwork)) Do i = 1, nvb Read (nin,*) i1, coor(1,i), coor(2,i) End Do ! Boundary edges Do i = 1, nedge Read (nin,*) i1, edge(1,i), edge(2,i), edge(3,i) End Do Read (nin,*) pmesh ! Initialise mesh control parameters itrace = 0 ! Generation of interior vertices on the ! RAE airfoil's wake dnvint = 2.5E0_nag_wp/real(nvint+1,kind=nag_wp) Do i = 1, nvint i1 = nvb + i coor(1,i1) = 1.38E0_nag_wp + real(i,kind=nag_wp)*dnvint coor(2,i1) = -0.27E0_nag_wp*coor(1,i1) + 0.2E0_nag_wp End Do weight(1:nvint) = 0.01E0_nag_wp Write (nout,*) ! Loop on the propagation coef pcoef: Do j = 1, 4 Select Case (j) Case (1) npropa = -5 Case (2) npropa = -1 Case (3) npropa = 1 Case Default npropa = 5 End Select ! Call to the 2D Delaunay-Voronoi mesh generator ifail = 0 Call d06abf(nvb,nvint,nvmax,nedge,edge,nv,nelt,coor,conn,weight, & npropa,itrace,rwork,lrwork,iwork,liwork,ifail) Select Case (pmesh) Case ('N') Write (nout,99999) 'Mesh characteristics with NPROPA =', npropa 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' Exit pcoef End Select End Do pcoef 99999 Format (1X,A,I6) 99998 Format (1X,2I10) 99997 Format (2(2X,E13.6)) 99996 Format (1X,4I10) End Program d06abfe