* E04VKF 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, NFMAX, LENAMX, LENGMX PARAMETER (NMAX=100,NFMAX=100,LENAMX=300,LENGMX=300) INTEGER LENCW, LENIW, LENRW PARAMETER (LENCW=600,LENIW=600,LENRW=600) * .. Local Scalars .. DOUBLE PRECISION BNDINF, FEATOL, OBJADD, SINF INTEGER ELMODE, I, IFAIL, LENA, LENG, N, NEA, NEG, NF, + NFNAME, NINF, NS, NXNAME, OBJROW, START CHARACTER*8 PROB * .. Local Arrays .. DOUBLE PRECISION A(LENAMX), F(NFMAX), FLOW(NFMAX), FMUL(NFMAX), + FUPP(NFMAX), RUSER(1), RW(LENRW), X(NMAX), + XLOW(NMAX), XMUL(NMAX), XUPP(NMAX) INTEGER FSTATE(NFMAX), IAFUN(LENAMX), IGFUN(LENGMX), + IUSER(1), IW(LENIW), JAVAR(LENAMX), + JGVAR(LENGMX), XSTATE(NMAX) CHARACTER*8 CUSER(1), CW(LENCW), FNAMES(NFMAX), XNAMES(NMAX) * .. External Subroutines .. EXTERNAL E04VGF, E04VHF, E04VKF, E04VLF, E04VMF, E04VNF, + E04VRF, E04VSF, USRFUN * .. Intrinsic Functions .. INTRINSIC MAX * .. Executable Statements .. WRITE (NOUT,*) 'E04VKF Example Program Results' * * This program demonstrates the use of routines to set and * get values of optional parameters associated with E04VHF. * * Skip heading in data file READ (NIN,*) READ (NIN,*) N, NF READ (NIN,*) NEA, NEG, OBJROW, START * IF (N.LE.NMAX .AND. NF.LE.NFMAX .AND. NEA.LE.LENAMX .AND. NEG.LE. + LENGMX) THEN LENA = MAX(1,NEA) LENG = MAX(1,NEG) NXNAME = N NFNAME = NF OBJADD = 0.0D0 PROB = ' ' * * Read the variable names XNAMES READ (NIN,*) (XNAMES(I),I=1,NXNAME) * Read the function names FNAMES READ (NIN,*) (FNAMES(I),I=1,NFNAME) * * Read the sparse matrix A, the linear part of F DO 20 I = 1, NEA * For each element read row, column, A(row,column) READ (NIN,*) IAFUN(I), JAVAR(I), A(I) 20 CONTINUE * * Read the structure of sparse matrix G, the nonlinear part of F DO 40 I = 1, NEG * For each element read row, column READ (NIN,*) IGFUN(I), JGVAR(I) 40 CONTINUE * * Read the lower and upper bounds on the variables DO 60 I = 1, N READ (NIN,*) XLOW(I), XUPP(I) 60 CONTINUE * * Read the lower and upper bounds on the functions DO 80 I = 1, NF READ (NIN,*) FLOW(I), FUPP(I) 80 CONTINUE * * Initialise X, XSTATE, XMUL, F, FSTATE, FMUL READ (NIN,*) (X(I),I=1,N) READ (NIN,*) (XSTATE(I),I=1,N) READ (NIN,*) (XMUL(I),I=1,N) READ (NIN,*) (F(I),I=1,NF) READ (NIN,*) (FSTATE(I),I=1,NF) READ (NIN,*) (FMUL(I),I=1,NF) * * Call E04VGF to initialise E04VHF. IFAIL = 1 CALL E04VGF(CW,LENCW,IW,LENIW,RW,LENRW,IFAIL) * IF (IFAIL.NE.0) THEN WRITE (NOUT,99999) IFAIL GO TO 100 END IF * * 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) * * Use E04VKF to read some options from the end of the input * data file. IFAIL = 0 CALL E04VKF(NIN,CW,IW,RW,IFAIL) WRITE (NOUT,*) * * Use E04VRF to find the value of integer-valued option * 'Elastic mode'. IFAIL = 0 CALL E04VRF('Elastic mode',ELMODE,CW,IW,RW,IFAIL) WRITE (NOUT,99998) ELMODE * * Use E04VNF to set the value of real-valued option * 'Infinite bound size'. BNDINF = 1.0D10 IFAIL = 0 CALL E04VNF('Infinite bound size',BNDINF,CW,IW,RW,IFAIL) * * Use E04VSF to find the value of real-valued option * 'Feasibility tolerance'. IFAIL = 0 CALL E04VSF('Feasibility tolerance',FEATOL,CW,IW,RW,IFAIL) WRITE (NOUT,99997) FEATOL * * Use E04VLF to set the option 'Major iterations limit'. IFAIL = 0 CALL E04VLF('Major iterations limit 50',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) * WRITE (NOUT,*) WRITE (NOUT,99996) IFAIL IF (IFAIL.EQ.0) THEN WRITE (NOUT,99995) F(OBJROW) WRITE (NOUT,99994) (X(I),I=1,N) END IF * ELSE WRITE (NOUT,99993) END IF 100 CONTINUE * 99999 FORMAT (1X,/1X,' ** E04VGF 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 E04VHF, IFAIL = ',I5) 99995 FORMAT (1X,'Final objective value = ',F11.1) 99994 FORMAT (1X,'Optimal X = ',7F9.2) 99993 FORMAT (1X,'At least one of N, NF, NEA or NEG is too large') END * SUBROUTINE USRFUN(STATUS,N,X,NEEDF,NF,F,NEEDG,LENG,G,CUSER,IUSER, + RUSER) * .. Implicit None Statement .. IMPLICIT NONE * .. Scalar Arguments .. INTEGER LENG, N, NEEDF, NEEDG, NF, STATUS * .. Array Arguments .. DOUBLE PRECISION F(NF), G(LENG), RUSER(*), X(N) INTEGER IUSER(*) CHARACTER*8 CUSER(*) * .. Intrinsic Functions .. INTRINSIC COS, SIN * .. Executable Statements .. IF (NEEDF.GT.0) THEN * The nonlinear components of f_i(x) need to be assigned, * for i = 1 to NF F(1) = 1000.0D+0*SIN(-X(1)-0.25D+0) + 1000.0D+0*SIN(-X(2) + -0.25D+0) F(2) = 1000.0D+0*SIN(X(1)-0.25D+0) + 1000.0D+0*SIN(X(1)-X(2) + -0.25D+0) F(3) = 1000.0D+0*SIN(X(2)-X(1)-0.25D+0) + 1000.0D+0*SIN(X(2) + -0.25D+0) * N.B. in this example there is no need to assign for the wholly * linear components f_4(x) and f_5(x). F(6) = 1.0D-6*X(3)**3 + 2.0D-6*X(4)**3/3.0D+0 END IF * IF (NEEDG.GT.0) THEN * The derivatives of the function f_i(x) need to be assigned. * G(k) should be set to partial derivative df_i(x)/dx_j where * i = IGFUN(k) and j = IGVAR(k), for k = 1 to LENG. G(1) = -1000.0D+0*COS(-X(1)-0.25D+0) G(2) = -1000.0D+0*COS(-X(2)-0.25D+0) G(3) = 1000.0D+0*COS(X(1)-0.25D+0) + 1000.0D+0*COS(X(1)-X(2) + -0.25D+0) G(4) = -1000.0D+0*COS(X(1)-X(2)-0.25D+0) G(5) = -1000.0D+0*COS(X(2)-X(1)-0.25D+0) G(6) = 1000.0D+0*COS(X(2)-X(1)-0.25D+0) + 1000.0D+0*COS(X(2) + -0.25D+0) G(7) = 3.0D-6*X(3)**2 G(8) = 2.0D-6*X(4)**2 END IF * RETURN END