Program e04mgae ! E04MGA Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: e04mfa, e04mga, e04mha, e04wbf, nag_wp, x04abf, & x04acf, x04baf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: iset = 1, lcwsav = 1, liwsav = 610, & llwsav = 120, lrwsav = 475, nin = 5, & ninopt = 7, nout = 6 Character (*), Parameter :: fname = 'e04mgae.opt' ! .. Local Scalars .. Real (Kind=nag_wp) :: obj Integer :: i, ifail, inform, iter, j, lda, & liwork, lwork, mode, n, nclin, & outchn, sda Character (80) :: rec ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: a(:,:), ax(:), bl(:), bu(:), & clamda(:), cvec(:), work(:), x(:) Real (Kind=nag_wp) :: rwsav(lrwsav) Integer, Allocatable :: istate(:), iwork(:) Integer :: iwsav(liwsav) Logical :: lwsav(llwsav) Character (80) :: cwsav(lcwsav) ! .. Intrinsic Procedures .. Intrinsic :: max ! .. Executable Statements .. Write (rec,*) 'E04MGA Example Program Results' Call x04baf(nout,rec) ! Skip heading in data file Read (nin,*) Read (nin,*) n, nclin liwork = 2*n + 3 ! The minimum LWORK for an LP problem: If (0=n) Then lwork = 2*n**2 + 7*n + 5*nclin Else lwork = 7*n + 1 End If lda = max(1,nclin) If (nclin>0) Then sda = n Else sda = 1 End If Allocate (istate(n+nclin),iwork(liwork),a(lda,sda),bl(n+nclin), & bu(n+nclin),cvec(n),x(n),ax(max(1,nclin)),clamda(n+nclin),work(lwork)) Read (nin,*) cvec(1:n) Read (nin,*)(a(i,1:sda),i=1,nclin) Read (nin,*) bl(1:(n+nclin)) Read (nin,*) bu(1:(n+nclin)) Read (nin,*) x(1:n) ! Set the unit number for advisory messages to OUTCHN outchn = nout Call x04abf(iset,outchn) ! Initialise E04MFA using E04WBF ifail = 0 Call e04wbf('E04MFA',cwsav,lcwsav,lwsav,llwsav,iwsav,liwsav,rwsav, & lrwsav,ifail) ! Set two options using E04MHA Call e04mha(' Check Frequency = 10 ',lwsav,iwsav,rwsav,inform) If (inform==0) Then Call e04mha(' Infinite Bound Size = 1.0D+25 ',lwsav,iwsav,rwsav, & inform) End If If (inform/=0) Then Write (rec,99999) 'E04MHA terminated with INFORM = ', inform Call x04baf(nout,rec) Go To 100 End If ! Open the options file for reading mode = 0 ifail = 0 Call x04acf(ninopt,fname,mode,ifail) ! Read the options file for the remaining options Call e04mga(ninopt,lwsav,iwsav,rwsav,inform) If (inform/=0) Then Write (rec,99999) 'E04MGA terminated with INFORM = ', inform Call x04baf(nout,rec) Go To 100 End If ! Solve the problem ifail = -1 Call e04mfa(n,nclin,a,lda,bl,bu,cvec,istate,x,iter,obj,ax,clamda,iwork, & liwork,work,lwork,lwsav,iwsav,rwsav,ifail) Select Case (ifail) Case (0:5,7:) Write (rec,'()') Call x04baf(nout,rec) Write (rec,99998) Call x04baf(nout,rec) Write (rec,'()') Call x04baf(nout,rec) Do i = 1, n Write (rec,99997) i, istate(i), x(i), clamda(i) Call x04baf(nout,rec) End Do If (nclin>0) Then Write (rec,'()') Call x04baf(nout,rec) Write (rec,'()') Call x04baf(nout,rec) Write (rec,99996) Call x04baf(nout,rec) Write (rec,'()') Call x04baf(nout,rec) Do i = n + 1, n + nclin j = i - n Write (rec,99995) j, istate(i), ax(j), clamda(i) Call x04baf(nout,rec) End Do End If Write (rec,'()') Call x04baf(nout,rec) Write (rec,'()') Call x04baf(nout,rec) Write (rec,99994) obj Call x04baf(nout,rec) Write (rec,'()') Call x04baf(nout,rec) Write (rec,'()') Call x04baf(nout,rec) Write (rec,99993) iter Call x04baf(nout,rec) End Select 100 Continue 99999 Format (1X,A,I5) 99998 Format (1X,'Varbl',2X,'Istate',3X,'Value',8X,'Lagr Mult') 99997 Format (1X,'V',2(1X,I3),2X,1P,G14.6,2X,1P,G12.4) 99996 Format (1X,'L Con',2X,'Istate',3X,'Value',8X,'Lagr Mult') 99995 Format (1X,'L',2(1X,I3),2X,1P,G14.6,2X,1P,G12.4) 99994 Format (1X,'Final objective value = ',G15.7) 99993 Format (1X,'Exit from problem after',1X,I6,1X,'iterations.') End Program e04mgae