! E04VJF Example Program Text ! Mark 23 Release. NAG Copyright 2011. MODULE e04vjfe_mod ! E04VJF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. USE nag_library, ONLY : nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: lencw = 600, leniw = 600, & lenrw = 600, nin = 5, nout = 6 CONTAINS SUBROUTINE usrfun(status,n,x,needf,nf,f,needg,leng,g,cuser,iuser,ruser) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Scalar Arguments .. INTEGER, INTENT (IN) :: leng, n, needf, needg, nf INTEGER, INTENT (INOUT) :: status ! .. Array Arguments .. REAL (KIND=nag_wp), INTENT (INOUT) :: f(nf), g(leng), ruser(*) REAL (KIND=nag_wp), INTENT (IN) :: x(n) INTEGER, INTENT (INOUT) :: iuser(*) CHARACTER (8), INTENT (INOUT) :: cuser(*) ! .. Intrinsic Functions .. INTRINSIC sin ! .. Executable Statements .. IF (needf>0) THEN f(1) = 1000.0E+0_nag_wp*sin(-x(1)-0.25E+0_nag_wp) + & 1000.0E+0_nag_wp*sin(-x(2)-0.25E+0_nag_wp) - x(3) f(2) = 1000.0E+0_nag_wp*sin(x(1)-0.25E+0_nag_wp) + & 1000.0E+0_nag_wp*sin(x(1)-x(2)-0.25E+0_nag_wp) - x(4) f(3) = 1000.0E+0_nag_wp*sin(x(2)-x(1)-0.25E+0_nag_wp) + & 1000.0E+0_nag_wp*sin(x(2)-0.25E+0_nag_wp) f(4) = -x(1) + x(2) f(5) = x(1) - x(2) f(6) = 1.0E-6_nag_wp*x(3)**3 + 2.0E-6_nag_wp*x(4)**3/ & 3.0E+0_nag_wp + 3.0E0_nag_wp*x(3) + 2.0E0_nag_wp*x(4) END IF RETURN END SUBROUTINE usrfun END MODULE e04vjfe_mod PROGRAM e04vjfe ! E04VJF Example Main Program ! .. Use Statements .. USE nag_library, ONLY : e04vgf, e04vhf, e04vjf, e04vlf, e04vmf, nag_wp USE e04vjfe_mod, ONLY : lencw, leniw, lenrw, nin, nout, usrfun ! .. Implicit None Statement .. IMPLICIT NONE ! .. Local Scalars .. REAL (KIND=nag_wp) :: objadd, sinf INTEGER :: i, ifail, lena, leng, n, nea, & neg, nf, nfname, ninf, ns, & nxname, objrow, start CHARACTER (8) :: prob ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: a(:), f(:), flow(:), fmul(:), & fupp(:), x(:), xlow(:), xmul(:), & xupp(:) REAL (KIND=nag_wp) :: ruser(1), rw(lenrw) INTEGER, ALLOCATABLE :: fstate(:), iafun(:), igfun(:), & javar(:), jgvar(:), xstate(:) INTEGER :: iuser(1), iw(leniw) CHARACTER (8) :: cuser(1), cw(lencw) CHARACTER (8), ALLOCATABLE :: fnames(:), xnames(:) ! .. Executable Statements .. WRITE (nout,*) 'E04VJF Example Program Results' ! Skip heading in data file READ (nin,*) READ (nin,*) n, nf lena = 300 leng = 300 nxname = 1 nfname = 1 ALLOCATE (iafun(lena),javar(lena),igfun(leng),jgvar(leng),xstate(n), & fstate(nf),a(lena),xlow(n),xupp(n),flow(nf),fupp(nf),x(n),xmul(n), & f(nf),fmul(nf),xnames(nxname),fnames(nfname)) ! Call E04VGF to initialise E04VJF. ifail = 0 CALL e04vgf(cw,lencw,iw,leniw,rw,lenrw,ifail) ! Read the bounds on the variables. DO i = 1, n READ (nin,*) xlow(i), xupp(i) END DO x(1:n) = 0.0E0_nag_wp ! Determine the Jacobian structure. ifail = 0 CALL e04vjf(nf,n,usrfun,iafun,javar,a,lena,nea,igfun,jgvar,leng,neg,x, & xlow,xupp,cw,lencw,iw,leniw,rw,lenrw,cuser,iuser,ruser,ifail) ! Print the Jacobian structure. WRITE (nout,*) WRITE (nout,99999) nea WRITE (nout,99998) WRITE (nout,99997) DO i = 1, nea WRITE (nout,99996) i, iafun(i), javar(i), a(i) END DO WRITE (nout,*) WRITE (nout,99995) neg WRITE (nout,99994) WRITE (nout,99993) DO i = 1, neg WRITE (nout,99992) i, igfun(i), jgvar(i) FLUSH (nout) END DO ! Now that we have the determined the structure of the ! Jacobian, set up the information necessary to solve ! the optimization problem. start = 0 prob = ' ' objadd = 0.0E0_nag_wp x(1:n) = 0.0E0_nag_wp xstate(1:n) = 0 xmul(1:n) = 0.0E0_nag_wp f(1:nf) = 0.0E0_nag_wp fstate(1:nf) = 0 fmul(1:nf) = 0.0E0_nag_wp ! The row containing the objective function. READ (nin,*) objrow ! Read the bounds on the functions. DO i = 1, nf READ (nin,*) flow(i), fupp(i) END DO ! By default E04VHF does not print monitoring ! information. Set the print file unit or the summary ! file unit to get information. ifail = 0 CALL e04vmf('Print file',nout,cw,iw,rw,ifail) ! Tell E04VHF that we supply no derivatives in USRFUN. ifail = 0 CALL e04vlf('Derivative option 0',cw,iw,rw,ifail) ! Solve the problem. ifail = -1 CALL e04vhf(start,nf,n,nxname,nfname,objadd,objrow,prob,usrfun,iafun, & javar,a,lena,nea,igfun,jgvar,leng,neg,xlow,xupp,xnames,flow,fupp, & fnames,x,xstate,xmul,f,fstate,fmul,ns,ninf,sinf,cw,lencw,iw,leniw, & rw,lenrw,cuser,iuser,ruser,ifail) SELECT CASE (ifail) CASE (0,4) WRITE (nout,*) WRITE (nout,99991) f(objrow) WRITE (nout,99990) (x(i),i=1,n) END SELECT 99999 FORMAT (1X,'NEA (the number of non-zero entries in A) = ',I3) 99998 FORMAT (1X,' I IAFUN(I) JAVAR(I) A(I)') 99997 FORMAT (1X,'---- -------- -------- -----------') 99996 FORMAT (1X,I3,2I10,1P,E18.4) 99995 FORMAT (1X,'NEG (the number of non-zero entries in G) = ',I3) 99994 FORMAT (1X,' I IGFUN(I) JGVAR(I)') 99993 FORMAT (1X,'---- -------- --------') 99992 FORMAT (1X,I3,2I10) 99991 FORMAT (1X,'Final objective value = ',F11.1) 99990 FORMAT (1X,'Optimal X = ',7F9.2) END PROGRAM e04vjfe