! C05QSF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module c05qsfe_mod ! C05QSF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. Use nag_library, Only: nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: n = 9, nout = 6 Contains Subroutine fcn(n,lindf,indf,x,fvec,iuser,ruser,iflag) ! .. Parameters .. Real (Kind=nag_wp), Parameter :: one = 1.0E0_nag_wp Real (Kind=nag_wp), Parameter :: three = 3.0E0_nag_wp Real (Kind=nag_wp), Parameter :: two = 2.0E0_nag_wp Real (Kind=nag_wp), Parameter :: alpha = (one/two)**7 ! .. Scalar Arguments .. Integer, Intent (Inout) :: iflag Integer, Intent (In) :: lindf, n ! .. Array Arguments .. Real (Kind=nag_wp), Intent (Out) :: fvec(n) Real (Kind=nag_wp), Intent (Inout) :: ruser(*) Real (Kind=nag_wp), Intent (In) :: x(n) Integer, Intent (In) :: indf(lindf) Integer, Intent (Inout) :: iuser(*) ! .. Local Scalars .. Real (Kind=nag_wp) :: theta Integer :: i, ind ! .. Intrinsic Procedures .. Intrinsic :: real ! .. Executable Statements .. iflag = 0 theta = real(iuser(1),kind=nag_wp)*alpha Do ind = 1, lindf i = indf(ind) fvec(i) = (three-(two+theta)*x(i))*x(i) + one If (i>1) Then fvec(i) = fvec(i) - x(i-1) End If If (i