Program e04uffe ! E04UFF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: e04uff, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: objf Integer :: i, ifail, irevcm, iter, lda, ldcj, & ldr, liwork, lwork, n, nclin, ncnln, & sda, sdcjac ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: a(:,:), bl(:), bu(:), c(:), & cjac(:,:), clamda(:), objgrd(:), & r(:,:), work(:), x(:) Integer, Allocatable :: istate(:), iwork(:), needc(:) ! .. Intrinsic Procedures .. Intrinsic :: max ! .. Executable Statements .. Write (nout,*) 'E04UFF Example Program Results' Flush (nout) ! Skip heading in data file. Read (nin,*) Read (nin,*) n, nclin, ncnln liwork = 3*n + nclin + 2*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 ldr = n If (ncnln==0 .And. nclin>0) Then lwork = 2*n**2 + 21*n + 11*nclin + 2 Else If (ncnln>0 .And. nclin>=0) Then lwork = 2*n**2 + n*nclin + 2*n*ncnln + 21*n + 11*nclin + 22*ncnln + 1 Else lwork = 21*n + 2 End If Allocate (istate(n+nclin+ncnln),iwork(liwork),a(lda,sda), & bl(n+nclin+ncnln),bu(n+nclin+ncnln),c(max(1, & ncnln)),cjac(ldcj,sdcjac),clamda(n+nclin+ncnln),objgrd(n),r(ldr,n), & x(n),work(lwork),needc(max(1,ncnln))) If (nclin>0) Then Read (nin,*)(a(i,1:n),i=1,nclin) End If Read (nin,*) bl(1:(n+nclin+ncnln)) Read (nin,*) bu(1:(n+nclin+ncnln)) Read (nin,*) x(1:n) ! Set all constraint 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 ! Solve the problem. irevcm = 0 ifail = 0 revcomm: Do Call e04uff(irevcm,n,nclin,ncnln,lda,ldcj,ldr,a,bl,bu,iter,istate,c, & cjac,clamda,objf,objgrd,r,x,needc,iwork,liwork,work,lwork,ifail) ! On intermediate exit IFAIL should not have been changed ! and IREVCM should be > 0. If (irevcm==0) Then Exit revcomm End If If (irevcm==1 .Or. irevcm==3) Then ! Evaluate the objective function. objf = x(1)*x(4)*(x(1)+x(2)+x(3)) + x(3) End If If (irevcm==2 .Or. irevcm==3) Then ! Evaluate the objective gradient. objgrd(1) = x(4)*(2.0E0_nag_wp*x(1)+x(2)+x(3)) objgrd(2) = x(1)*x(4) objgrd(3) = x(1)*x(4) + 1.0E0_nag_wp objgrd(4) = x(1)*(x(1)+x(2)+x(3)) End If If (irevcm==4 .Or. irevcm==6) Then ! Evaluate the nonlinear constraint functions. If (needc(1)>0) Then c(1) = x(1)**2 + x(2)**2 + x(3)**2 + x(4)**2 End If If (needc(2)>0) Then c(2) = x(1)*x(2)*x(3)*x(4) End If End If If (irevcm==5 .Or. irevcm==6) Then ! Evaluate the constraint Jacobian. If (needc(1)>0) 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 If (needc(2)>0) 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 End Do revcomm End Program e04uffe