* E04WEF Example Program Text * Mark 21 Release. NAG Copyright 2004. * .. Implicit None Statement .. IMPLICIT NONE * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER NMAX, NCLMAX, NCNMAX PARAMETER (NMAX=10,NCLMAX=10,NCNMAX=10) INTEGER LDA, LDCJ, LDH PARAMETER (LDA=NCLMAX,LDCJ=NCNMAX,LDH=NMAX) INTEGER LENIW, LENRW PARAMETER (LENIW=600,LENRW=600) * .. Local Scalars .. DOUBLE PRECISION BNDINF, FEATOL, OBJF INTEGER ELMODE, I, IFAIL, J, MAJITS, N, NCLIN, NCNLN * .. Local Arrays .. DOUBLE PRECISION A(LDA,NMAX), BL(NMAX+NCLMAX+NCNMAX), + BU(NMAX+NCLMAX+NCNMAX), CCON(NCNMAX), + CJAC(LDCJ,NMAX), CLAMDA(NMAX+NCLMAX+NCNMAX), + GRAD(NMAX), HESS(LDH,NMAX), RUSER(1), RW(LENRW), + X(NMAX) INTEGER ISTATE(NMAX+NCLMAX+NCNMAX), IUSER(1), IW(LENIW) * .. External Subroutines .. EXTERNAL CONFUN, E04WCF, E04WDF, E04WEF, E04WFF, E04WGF, + E04WHF, E04WKF, E04WLF, OBJFUN * .. Executable Statements .. WRITE (NOUT,*) 'E04WEF Example Program Results' * * This program demonstrates the use of routines to set and * get values of optional parameters associated with E04WDF. * * Skip heading in data file READ (NIN,*) READ (NIN,*) N, NCLIN, NCNLN IF (N.LE.NMAX .AND. NCLIN.LE.NCLMAX .AND. NCNLN.LE.NCNMAX) THEN * * Read A, BL, BU and X from data file IF (NCLIN.GT.0) READ (NIN,*) ((A(I,J),J=1,N),I=1,NCLIN) READ (NIN,*) (BL(I),I=1,N+NCLIN+NCNLN) READ (NIN,*) (BU(I),I=1,N+NCLIN+NCNLN) READ (NIN,*) (X(I),I=1,N) * * Call E04WCF to initialise E04WDF. IFAIL = 1 CALL E04WCF(IW,LENIW,RW,LENRW,IFAIL) * IF (IFAIL.NE.0) THEN WRITE (NOUT,99999) IFAIL GO TO 20 END IF * * By default E04WDF does not print monitoring information. * Use E04WGF to set the integer-valued option 'Print file' * unit number to get information. IFAIL = 0 CALL E04WGF('Print file',NOUT,IW,RW,IFAIL) * * Use E04WEF to read some options from the end of the input * data file. IFAIL = 0 CALL E04WEF(NIN,IW,RW,IFAIL) WRITE (NOUT,*) * * Use E04WKF to find the value of integer-valued option * 'Elastic mode'. IFAIL = 0 CALL E04WKF('Elastic mode',ELMODE,IW,RW,IFAIL) WRITE (NOUT,99998) ELMODE * * Use E04WHF to set the value of real-valued option * 'Infinite bound size'. BNDINF = 1.0D10 IFAIL = 0 CALL E04WHF('Infinite bound size',BNDINF,IW,RW,IFAIL) * * Use E04WLF to find the value of real-valued option * 'Feasibility tolerance'. IFAIL = 0 CALL E04WLF('Feasibility tolerance',FEATOL,IW,RW,IFAIL) WRITE (NOUT,99997) FEATOL * * Use E04WFF to set the option 'Major iterations limit'. IFAIL = 0 CALL E04WFF('Major iterations limit 50',IW,RW,IFAIL) * * Solve the problem. IFAIL = -1 CALL E04WDF(N,NCLIN,NCNLN,LDA,LDCJ,LDH,A,BL,BU,CONFUN,OBJFUN, + MAJITS,ISTATE,CCON,CJAC,CLAMDA,OBJF,GRAD,HESS,X,IW, + LENIW,RW,LENRW,IUSER,RUSER,IFAIL) * WRITE (NOUT,*) WRITE (NOUT,99996) IFAIL IF (IFAIL.EQ.0) THEN WRITE (NOUT,99995) OBJF WRITE (NOUT,99994) (X(I),I=1,N) END IF * ELSE WRITE (NOUT,99993) END IF * 20 CONTINUE * 99999 FORMAT (1X,/1X,' ** E04WCF returned with IFAIL = ',I5) 99998 FORMAT (1X,'Option ''Elastic mode'' has the value ',I3,'.') 99997 FORMAT (1X,'Option ''Feasibility tolerance'' has the value ',1P, + E13.5,'.') 99996 FORMAT (1X,'On exit from E04WDF, IFAIL = ',I5) 99995 FORMAT (1X,'Final objective value = ',F11.3) 99994 FORMAT (1X,'Optimal X = ',7F9.2) 99993 FORMAT (1X,'At least one of N, NCLIN or NCNLN is too large') END * SUBROUTINE OBJFUN(MODE,N,X,OBJF,GRAD,NSTATE,IUSER,RUSER) * Routine to evaluate objective function and its 1st derivatives. * .. Parameters .. DOUBLE PRECISION ONE, TWO PARAMETER (ONE=1.0D0,TWO=2.0D0) * .. Scalar Arguments .. DOUBLE PRECISION OBJF INTEGER MODE, N, NSTATE * .. Array Arguments .. DOUBLE PRECISION GRAD(N), RUSER(*), X(N) INTEGER IUSER(*) * .. Executable Statements .. IF (MODE.EQ.0 .OR. MODE.EQ.2) OBJF = X(1)*X(4)*(X(1)+X(2)+X(3)) + + X(3) * IF (MODE.EQ.1 .OR. MODE.EQ.2) THEN GRAD(1) = X(4)*(TWO*X(1)+X(2)+X(3)) GRAD(2) = X(1)*X(4) GRAD(3) = X(1)*X(4) + ONE GRAD(4) = X(1)*(X(1)+X(2)+X(3)) END IF * RETURN END * SUBROUTINE CONFUN(MODE,NCNLN,N,LDCJ,NEEDC,X,CCON,CJAC,NSTATE, + IUSER,RUSER) * Routine to evaluate the nonlinear constraints and their 1st * derivatives. * .. Parameters .. DOUBLE PRECISION ZERO, TWO PARAMETER (ZERO=0.0D0,TWO=2.0D0) * .. Scalar Arguments .. INTEGER LDCJ, MODE, N, NCNLN, NSTATE * .. Array Arguments .. DOUBLE PRECISION CCON(*), CJAC(LDCJ,*), RUSER(*), X(N) INTEGER IUSER(*), NEEDC(*) * .. Local Scalars .. INTEGER I, J * .. Executable Statements .. IF (NSTATE.EQ.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). DO 40 J = 1, N DO 20 I = 1, NCNLN CJAC(I,J) = ZERO 20 CONTINUE 40 CONTINUE END IF * IF (NEEDC(1).GT.0) THEN IF (MODE.EQ.0 .OR. MODE.EQ.2) CCON(1) = X(1)**2 + X(2)**2 + + X(3)**2 + X(4)**2 IF (MODE.EQ.1 .OR. MODE.EQ.2) THEN CJAC(1,1) = TWO*X(1) CJAC(1,2) = TWO*X(2) CJAC(1,3) = TWO*X(3) CJAC(1,4) = TWO*X(4) END IF END IF * IF (NEEDC(2).GT.0) THEN IF (MODE.EQ.0 .OR. MODE.EQ.2) CCON(2) = X(1)*X(2)*X(3)*X(4) IF (MODE.EQ.1 .OR. MODE.EQ.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