! E04WDF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module e04wdfe_mod ! E04WDF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. Use nag_library, Only: nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: leniw = 600, lenrw = 600, & nin = 5, nout = 6 Contains Subroutine objfun(mode,n,x,objf,grad,nstate,iuser,ruser) ! Routine to evaluate objective function and its 1st derivatives. ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (Out) :: objf Integer, Intent (Inout) :: mode Integer, Intent (In) :: n, nstate ! .. Array Arguments .. Real (Kind=nag_wp), Intent (Inout) :: grad(n), ruser(*) Real (Kind=nag_wp), Intent (In) :: x(n) Integer, Intent (Inout) :: iuser(*) ! .. Executable Statements .. If (mode==0 .Or. mode==2) Then objf = x(1)*x(4)*(x(1)+x(2)+x(3)) + x(3) End If If (mode==1 .Or. mode==2) Then grad(1) = x(4)*(2.0E0_nag_wp*x(1)+x(2)+x(3)) grad(2) = x(1)*x(4) grad(3) = x(1)*x(4) + 1.0E0_nag_wp grad(4) = x(1)*(x(1)+x(2)+x(3)) End If Return End Subroutine objfun Subroutine confun(mode,ncnln,n,ldcj,needc,x,ccon,cjac,nstate,iuser, & ruser) ! Routine to evaluate the nonlinear constraints and their 1st ! derivatives. ! .. Scalar Arguments .. Integer, Intent (In) :: ldcj, n, ncnln, nstate Integer, Intent (Inout) :: mode ! .. Array Arguments .. Real (Kind=nag_wp), Intent (Out) :: ccon(max(1,ncnln)) Real (Kind=nag_wp), Intent (Inout) :: cjac(ldcj,n), ruser(*) Real (Kind=nag_wp), Intent (In) :: x(n) Integer, Intent (Inout) :: iuser(*) Integer, Intent (In) :: needc(ncnln) ! .. Intrinsic Procedures .. Intrinsic :: max ! .. Executable Statements .. If (nstate==1) Then ! First call to CONFUN. Set all Jacobian elements to zero. ! Note that this will only work when 'Derivative Level = 3' ! (the default; see Section 11.2). cjac(1:ncnln,1:n) = 0.0E0_nag_wp End If If (needc(1)>0) Then If (mode==0 .Or. mode==2) Then ccon(1) = x(1)**2 + x(2)**2 + x(3)**2 + x(4)**2 End If If (mode==1 .Or. mode==2) Then cjac(1,1) = 2.0E0_nag_wp*x(1) cjac(1,2) = 2.0E0_nag_wp*x(2) cjac(1,3) = 2.0E0_nag_wp*x(3) cjac(1,4) = 2.0E0_nag_wp*x(4) End If End If If (needc(2)>0) Then If (mode==0 .Or. mode==2) Then ccon(2) = x(1)*x(2)*x(3)*x(4) End If If (mode==1 .Or. mode==2) Then cjac(2,1) = x(2)*x(3)*x(4) cjac(2,2) = x(1)*x(3)*x(4) cjac(2,3) = x(1)*x(2)*x(4) cjac(2,4) = x(1)*x(2)*x(3) End If End If Return End Subroutine confun End Module e04wdfe_mod Program e04wdfe ! E04WDF Example Main Program ! .. Use Statements .. Use nag_library, Only: e04wcf, e04wdf, e04wgf, nag_wp Use e04wdfe_mod, Only: confun, leniw, lenrw, nin, nout, objfun ! .. Implicit None Statement .. Implicit None ! .. Local Scalars .. Real (Kind=nag_wp) :: objf Integer :: i, ifail, lda, ldcj, ldh, & majits, n, nclin, ncnln, sda, & sdcjac ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: a(:,:), bl(:), bu(:), ccon(:), & cjac(:,:), clamda(:), grad(:), & h(:,:), x(:) Real (Kind=nag_wp) :: ruser(1), rw(lenrw) Integer, Allocatable :: istate(:) Integer :: iuser(1), iw(leniw) ! .. Intrinsic Procedures .. Intrinsic :: max ! .. Executable Statements .. Write (nout,*) 'E04WDF Example Program Results' Flush (nout) ! Skip heading in data file Read (nin,*) Read (nin,*) n, nclin, ncnln lda = max(1,nclin) If (nclin>0) Then sda = n Else sda = 1 End If ldcj = max(1,ncnln) If (ncnln>0) Then sdcjac = n Else sdcjac = 1 End If ldh = n Allocate (istate(n+nclin+ncnln),a(lda,sda),bl(n+nclin+ncnln), & bu(n+nclin+ncnln),ccon(max(1,ncnln)),cjac(ldcj,sdcjac),clamda(n+nclin+ & ncnln),grad(n),h(ldh,n),x(n)) If (nclin>0) Then Read (nin,*)(a(i,1:sda),i=1,nclin) End If Read (nin,*) bl(1:(n+nclin+ncnln)) Read (nin,*) bu(1:(n+nclin+ncnln)) Read (nin,*) x(1:n) ! Call E04WCF to initialise E04WDF. ifail = 0 Call e04wcf(iw,leniw,rw,lenrw,ifail) ! By default E04WDF does not print monitoring ! information. Set the print file unit or the summary ! file unit to get information. ifail = 0 Call e04wgf('Print file',nout,iw,rw,ifail) ! Solve the problem. ifail = 0 Call e04wdf(n,nclin,ncnln,lda,ldcj,ldh,a,bl,bu,confun,objfun,majits, & istate,ccon,cjac,clamda,objf,grad,h,x,iw,leniw,rw,lenrw,iuser,ruser, & ifail) Write (nout,*) Write (nout,99999) objf Write (nout,99998) x(1:n) 99999 Format (1X,'Final objective value = ',F11.3) 99998 Format (1X,'Optimal X = ',7F9.2) End Program e04wdfe