Program d06cafe ! D06CAF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: d06caf, g05kff, g05sqf, nag_wp, x01aaf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: delta, hx, hy, pi2, r, rad, sk, & theta, x1, x2, x3, y1, y2, y3 Integer :: genid, i, ifail, imax, ind, itrace, & j, jmax, k, liwork, lrwork, lseed, & lstate, me1, me2, me3, nedge, nelt, & nqint, nv, nvfix, reftk, subid Character (1) :: pmesh ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: coor(:,:), rwork(:), variates(:) Integer, Allocatable :: conn(:,:), edge(:,:), iwork(:), & numfix(:), seed(:), state(:) ! .. Intrinsic Procedures .. Intrinsic :: cos, min, real, sin ! .. Executable Statements .. Write (nout,*) 'D06CAF Example Program Results' Flush (nout) ! Skip heading in data file Read (nin,*) ! Read IMAX and JMAX, the number of vertices ! in the x and y directions respectively. Read (nin,*) imax, jmax nv = imax*jmax nelt = 2*(imax-1)*(jmax-1) nedge = 2*(imax-1) + 2*(jmax-1) liwork = 8*nelt + 2*nv lrwork = 2*nv + nelt ! The array VARIATES will be used when distorting the mesh Allocate (variates(2*nv),coor(2,nv),conn(3,nelt),edge(3,nedge), & iwork(liwork),rwork(lrwork)) ! Read distortion percentage and calculate radius ! of distortion neighbourhood so that cross-over ! can only occur at 100% or greater. Read (nin,*) delta hx = 1.0E0_nag_wp/real(imax-1,kind=nag_wp) hy = 1.0E0_nag_wp/real(jmax-1,kind=nag_wp) rad = 0.005E0_nag_wp*delta*min(hx,hy) pi2 = 2.0E0_nag_wp*x01aaf(pi2) ! GENID identifies the base generator genid = 1 subid = 1 ! For GENID = 1 only one seed is required ! The initialiser is first called in query mode to get the value of ! LSTATE for the chosen base generator lseed = 1 lstate = -1 Allocate (seed(lseed),state(lstate)) ! Initialise the seed seed(1:lseed) = (/1762541/) ifail = 0 Call g05kff(genid,subid,seed,lseed,state,lstate,ifail) Deallocate (state) Allocate (state(lstate)) ! Initialise the generator to a repeatable sequence ifail = 0 Call g05kff(genid,subid,seed,lseed,state,lstate,ifail) ! Generate two sets of uniform random variates ifail = 0 Call g05sqf(nv,0.0E0_nag_wp,rad,state,variates,ifail) ifail = 0 Call g05sqf(nv,0.0E0_nag_wp,pi2,state,variates(nv+1),ifail) ! Generate a simple uniform mesh and then distort it ! randomly within the distortion neighbourhood of each ! node. k = 0 ind = 0 Do j = 1, jmax Do i = 1, imax k = k + 1 r = variates(k) theta = variates(nv+k) If (i==1 .Or. i==imax .Or. j==1 .Or. j==jmax) Then r = 0.E0_nag_wp End If coor(1,k) = real(i-1,kind=nag_wp)*hx + r*cos(theta) coor(2,k) = real(j-1,kind=nag_wp)*hy + r*sin(theta) If (i