C ****************************************************************** C ****************************************************************** subroutine algencan(epsfeas,epsopt,iprint,ncomp,n,x,l,u,m,lambda, +equatn,linear,coded,checkder,f,cnorm,snorm,nlpsupn,inform,nbv,niv, +variableTypes) implicit none C SCALAR ARGUMENTS logical checkder integer inform,iprint,m,n,ncomp,nbv,niv double precision cnorm,epsfeas,epsopt,f,nlpsupn,snorm C ARRAY ARGUMENTS logical coded(10),equatn(m),linear(m) double precision l(n),lambda(m),u(n),x(n) integer variableTypes(n) #include "dim.par" #include "machconst.com" #include "algconst.par" #include "counters.com" #include "outtyp.com" #include "algparam.com" #include "scaling.com" #include "slacks.com" #include "fixvar.com" C LOCAL SCALARS logical constf integer alinfo,geninfo,i,iter,j,maxit,nwcalls,nwtotit,outiter, + solinfo,totiter,msqcalls,msqtotit,minlpinfo double precision cnormu,fu real time C LOCAL ARRAYS double precision nl(nmax),c(mmax),rho(mmax) real dum(2) C DATA STATEMENTS data dum/0.0,0.0/ C EXTERNAL FUNCTIONS AND SUBROUTINES external fparam,checkd,auglag,gencan C ================================================================== C Initialization C ================================================================== C Open output file open(10,file='algencan.out') C Set machine-dependent constants bignum = 1.0d+99 macheps = 1.0d-16 macheps12 = sqrt( macheps ) macheps13 = macheps ** ( 1.0d0 / 3.0d0 ) macheps23 = macheps ** ( 2.0d0 / 3.0d0 ) C Set global counters fcnt = 0 fccnt = 0 gcnt = 0 gjccnt = 0 hcnt = 0 hlcnt = 0 hlpcnt = 0 do j = 1,m ccnt(j) = 0 jccnt(j) = 0 hccnt(j) = 0 end do C ================================================================== C Set default values for algoritmic parameters C ================================================================== C This is a temporary (experimental) setting constf = .false. C Set user-provided subroutines indicators fcoded = coded(1) gcoded = coded(2) hcoded = coded(3) ccoded = coded(4) jaccoded = coded(5) hccoded = coded(6) fccoded = coded(7) gjaccoded = coded(8) hlcoded = coded(9) hlpcoded = coded(10) innercall = .false. useustp = .false. C Set indicator of whether the true Hessian of the Lagrangian can be C computed or not truehl = .false. if ( hlcoded .or. ( hcoded .and. ( hccoded .or. m .eq. 0 ) )) then truehl = .true. end if C Hessian-vector product strategy: HAPPRO, INCQUO or TRUEHL (TRUEHL C is the default option. If the proper subroutines were not coded by C the user, then HAPPRO is used instead.) if ( truehl .or. hlpcoded ) then hptype = 'TRUEHL' else hptype = 'HAPPRO' end if C Inner-to-the-face minimization algorithm (CG is the default option) avoidds = .true. C Skip acceleration step skipacc = .true. C Scaling of linear systems sclsys = .false. C Slacks for inequality constraints slacks = .false. C Remove fixed variables (with identical lower and upper bounds) rmfixv = .true. C Scale objective function and constraints scale = .false. C ================================================================== C Set solver arguments using the specification file C ================================================================== call fparam(epsfeas,epsopt,iprint,ncomp) C Output detail parameters iprintout = iprint / 10 iprintinn = mod( iprint, 10 ) iprintctl(1) = .true. iprintctl(2) = .true. iprintctl(3) = .true. C Error tracker inform = 0 C ================================================================== C Initialize problem data structures C ================================================================== call sinip(n,x,l,u,m,lambda,equatn,linear,coded,checkder,inform) if ( inform .lt. 0 ) return nprint = min( n, ncomp ) mprint = min( m, ncomp ) C ================================================================== C Call the solver C ================================================================== time = dtime(dum) C ALGENCAN for PNL problems if ( .not. constf .and. m .gt. 0 ) then call auglag(n,x,l,u,m,lambda,equatn,linear,epsfeas,epsopt,f,c, + cnorm,snorm,nl,nlpsupn,fu,cnormu,outiter,totiter,nwcalls, + nwtotit,msqcalls,msqtotit,alinfo,inform,nbv,niv,variableTypes, + minlpinfo) solinfo = alinfo C GENCAN for box-constrained problems else maxit = 1000 C Used in feasibility problems (constf=true). With lambda=0 and C rho=1, to minimize 1/2 of the squared infeasibility coincides C with minimizing the augmented Lagrangian. do j = 1,m lambda(j) = 0.0d0 rho(j) = 1.0d0 end do if ( nbv + niv .eq. 0 ) then call gencan(n,x,l,u,m,lambda,equatn,linear,rho,constf, + epsfeas,epsopt,maxit,iter,f,nl,nlpsupn,cnorm,cnormu, + geninfo,inform) else call minlp_solver(n,x,l,u,m,lambda,equatn,linear,rho, + constf,epsfeas,epsopt,maxit,iter,f,nl,nlpsupn,cnorm, + cnormu,geninfo,inform,nbv,niv,variableTypes,minlpinfo) end if solinfo = geninfo outiter = 0 totiter = iter nwcalls = 0 nwtotit = 0 msqcalls = 0 msqtotit = 0 if ( scale ) then fu = f * sf else fu = f end if end if if ( inform .lt. 0 ) return time = dtime(dum) time = dum(1) C Close output file close(10) C ================================================================== C End problem data structures C ================================================================== call sendp(n,x,l,u,m,lambda,equatn,linear,inform) if ( inform .lt. 0 ) return C ================================================================== C Write statistics C ================================================================== C write(*,9050) time open(10,file='algencan-tabline.out') write(10,9040) fu,cnormu,f,cnorm,nlpsupn,inform,solinfo,n,m, + outiter,totiter,fcnt,nwcalls,nwtotit,msqcalls, + msqtotit,time close(10) C ================================================================== C NON-EXECUTABLE STATEMENTS C ================================================================== 9040 format(1X,1P,1PE30.20,1X,1P,D7.1,1X,1P,1PE30.20,1X,1P,D7.1,1X,1P, + D7.1,1X,I3,1X,I1,1X,I6,1X,I6,1X,I2,1X,I7,1X,I7,1X,I2,1X,I7, + 1X,I7,1X,I7,0P,F8.2) 9050 format(/,1X,'Total CPU time in seconds: ',F8.2) end