! G05YMF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module g05ymfe_mod ! G05YMF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. Use nag_library, Only: nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 Contains Function ifun(x,lx) ! Function being integrated, in this example ! ABS(4.0 X - 2) ! .. Function Return Value .. Real (Kind=nag_wp) :: ifun ! .. Scalar Arguments .. Integer, Intent (In) :: lx ! .. Array Arguments .. Real (Kind=nag_wp), Intent (In) :: x(lx) ! .. Local Scalars .. Integer :: d ! .. Intrinsic Procedures .. Intrinsic :: abs ! .. Executable Statements .. ifun = 1.0E0_nag_wp Do d = 1, lx ifun = ifun*abs(4.0E0_nag_wp*x(d)-2.0E0_nag_wp) End Do End Function ifun End Module g05ymfe_mod Program g05ymfe ! G05YMF Example Main Program ! .. Use Statements .. Use nag_library, Only: g05ylf, g05ymf, nag_wp, x04caf Use g05ymfe_mod, Only: ifun, nin, nout ! .. Implicit None Statement .. Implicit None ! .. Local Scalars .. Real (Kind=nag_wp) :: sum, vsbl Integer :: dn, genid, i, idim, ifail, & iskip, ldquas, liref, n, rcord Character (80) :: title ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: quas(:,:) Integer, Allocatable :: iref(:) ! .. Intrinsic Procedures .. Intrinsic :: real ! .. Executable Statements .. Write (nout,*) 'G05YMF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Fix the RCORD = 1, so QUAS(IDIM,N). As we ! are accessing each dimension in turn for a given variate ! when evaluating the function, this is more efficient rcord = 1 ! Read in the generator to use Read (nin,*) genid ! Read in the problem size Read (nin,*) n, idim, iskip If (genid==4) Then liref = 407 Else liref = 32*idim + 7 End If ldquas = idim Allocate (quas(ldquas,n),iref(liref)) ! Initialize the generator ifail = 0 Call g05ylf(genid,idim,iref,liref,iskip,ifail) ! Generate N quasi-random variates ifail = 0 Call g05ymf(n,rcord,quas,ldquas,iref,ifail) ! Evaluate the function, and sum sum = 0.0E0_nag_wp Do i = 1, n sum = sum + ifun(quas(1:idim,i),idim) End Do ! Convert sum to mean value vsbl = sum/real(n,kind=nag_wp) Write (nout,*) Write (nout,99999) 'Value of integral = ', vsbl ! Read in number of variates to display Read (nin,*) dn ! Display the first DN variates Write (nout,*) Write (title,99998) 'First ', dn, ' variates for all ', idim, & ' dimensions' Flush (nout) ifail = 0 Call x04caf('General',' ',idim,dn,quas,ldquas,title,ifail) 99999 Format (1X,A,F8.4) 99998 Format (A,I0,A,I0,A) End Program g05ymfe