subroutine conjgrad (mvprod,n,x,b,a,xx,bb,two,epsneg,epsrel,iter, 4,1
& imp,
& io,imode,mode,w,nw,
& preco,pmat0,npmat0,m0,ilm0,nilm0,wlm0,nwlm0,
& bfgsb,pmat1,npmat1,m1,ilm1,nilm1,wlm1,nwlm1,select,
& izs,rzs,dzs)
c
external mvprod
logical two
integer n,iter,imp,io,imode(3),mode,nw,
& preco,npmat0,m0,nilm0,ilm0(nilm0),nwlm0,
& bfgsb,npmat1,m1,nilm1,ilm1(nilm1),nwlm1,select,
& izs(1)
real rzs(1)
double precision x(n),b(n),xx(n),bb(n),a(1),epsneg,epsrel,w(5*n),
& pmat0(n,n),wlm0(nwlm0),
& pmat1(n,n),wlm1(nwlm1),
& dzs(1)
c
c----
c
c This routine solves for x the linear system
c
c A x = b, (LS)
c
c by a possibly preconditioned Fletcher-Reeves conjugate gradient
c (CG) algorithm. In this system, the matrix A and the vector b are
c supposed known. To solve the linear system completely, the matrix
c A must be symmetric positive definite. The way A is actually
c stored is irrelevant for N1CG1, since the algorithm requires only
c products Av of A times various vectors v and since this operation
c is supposed to be made in the user-supplied routine MVPROD.
c
c The CG iterations can be preconditioned by a full positive
c definite matrix strored in PMAT0 in the standard way (when
c preco=1) or by a limited memory BFGS (l-BFGS) matrix stored in
c the structure (M0, ILM0, NILM0, WLM0, NWLM0) (when preco=2). The
c latter may be particularly appropriate when the dimension N of the
c LS is very large. The l-BFGS structure, or even PMAT0, may be
c filled in by a previous call to N1CG1. This routine has indeed the
c feature (when BFGSB is nonzero) to build a preconditioning matrix
c using pairs (Av,v), where v are the generated conjugate
c directions. This preconditioning matrix can then be used to
c speed-up another CG run for a system having a matrix not too
c different from A.
c
c If two is .true. the routine also solves in parallel the linear
c system
c
c A xx = bb, (LS')
c
c with the same matrix A and another right hand side bb, using
c the conjugate directions generated by the CG iterations for
c solving (LS). This feature is useful for the truncated SQP
c algorithm in constrained optimization. There is no stopping test
c based on the behavior of CG on (LS'). If (LS') is solved before
c finding the approximate solution of (LS), xx is modified by adding
c terms that should be close to zero.
c
c
c Input
c ^^^^^
c
c mvprod, external: routine making the products A*v, where v is
c an arbitrary vector; it must be defined as follows:
c subroutine mvprod (n,a,v,av,izs,rzs,dzs)
c where, n (I), a (I), and izs (I), rzs (I), dzs (I) have the
c same meanings as below, v(n) (I) is a double precision vector
c and av(n) (O) is a double precision vector containing the
c product A*v
c n, integer: dimension of the LS to solve
c x(n), double precision: initial guess for x
c b(n), double precision: RHS of (LS)
c a(), double precision: address of the matrix A, it is passed
c to MVPROD and is not used in N1CG1
c xx(n), double precision: initial guess for xx (solution of
c (LS'))
c bb(n), double precision: RHS of (LS')
c two, logical; if .false. only (LS) is solved and xx and bb are
c not used; if .true. (LS') is also solved by the conjugate
c direction algorithm, using the conjugate direction generated
c when solving (LS)
c epsneg, double precision: if during CG iterations, a Rayleigh
c quotient v'Av/v'v less than a threshold is encountered, the
c algorithm stops, since the matrix A is not considered to be
c positive definite; epsneg must be nonnegative. The threshold
c depends on the value of epsneg and imode(3) (see this
c argument).
c epsrel, double precision: if during CG iterations, the relative
c norm of the residual |Ax-b|/|Ax_0-b| is less than epsrel, the
c algorithm stops, since (LS) is considered to be solved by
c the current x with enough precision
c iter, integer: max number of iterations accepted
c imp, integer: printing level
c =0: no printings
c >=1: printings on input and output, and error messages
c >=2: one line at each CG iteration, giving
c - iter: iteration counter
c - cost: the cost (1/2) x^T A x - b^T x
c - |r|/|r0|: the relative norm of the residual (controlled
c by epsrel)
c - <(r,Pr): angle between the residual r=Ax-b and the
c preconditioned residual Pr (will be 0 if preco=0)
c - (Av,v)/|v|^2: Rayleigh quotient of A along the
c conjugate directions
c - conj: cosine of the angle between 2 succesive
c residuals (for the scalar product defined by the
c preconditioning matrix P)
c - alpha: step-size
c - |x|: norm of the current approxinate solution x
c - S: selection flag; if select >=1, 'S' means that the
c pair (Av,v) has been selected, '-' means that it has
c not been selected;
c if two=.true., "cost" and "|r|/|r0|" is also printed for
c (LS')
c io, integer: output channel for printings
c imode, integer: input mode of N1CG1
c imode(1)=0: the initial iterate x is 0 (and x is set to 0)
c =1: the initial iterate x may not be 0
c imode(2)=0: the initial iterate xx is 0 (and xx is set to 0)
c =1: the initial iterate xx may not be 0
c imode(3)=0: use epsneg as the threshold of the Rayleigh
c quotient for stopping the CG iterations
c =1: use as threshold of the Rayleigh quotient for
c stopping the CG iterations:
c epsneg*max_Rayleigh_quatient_encoutered
c w(nw), double precision: working area
c nw, integer: dimension of w,
c must be >= 5*n+m0 if two=.false.
c must be >= 6*n+m0 if two=.true.
c preco, integer: specifies the type of preconditioning matrix
c made available to precondition the current CG run
c =0: no preconditioning
c =1: a full symmetric positive definite preconditioning matrix
c of order n is available in the structure (pmat0,npmat0)
c =2: a limited memory BFGS preconditioning matrix is available
c in the l-BFGS structure (m0,ilm0,nilm0,wlm0,nwlm0), built
c up by a previous called to n1cg1
c (pmat0,npmat0): if preco=1, this structure must contain
c preconditioning information (not used otherwise)
c . pmat0(npmat0), double precision: must contain an order n
c symmetric positive definite matrix approximating the
c inverse of A
c . npmat0, integer: dimension of pmat0, must be >= n**2
c (m0,ilm0,nilm0,wlm0,nwlm0): if preco=2, must contain an l-BFGS
c preconditioning structure (not used otherwise)
c . m0, integer: number of (y,s) pairs stored in the structure,
c . ilm0(nilm0), integer
c . nilm0, integer: dimension of ilm0
c . wlm0(nwlm0), double precision: contains the (y,s) pairs
c . nwlm0, integer: dimension of wlm0, must be >= m0*(2*n+1)+1
c bfgsb, integer: specifies the type of BFGS preconditioning
c matrix to build during the CG iterations,
c =0: don't build any preconditioning matrix
c =1: build a full BFGS preconditioning matrix in the BFGS
c structure (pmat1,npmat1); if pmat1(1)=0 the updates start
c from scratch, otherwise pmat1 is updated
c =2: build a limited memory BFGS preconditioning matrix in the
c l-BFGS structure (m1,nys1,jmin1,jmax1,ybar1,sbar1,size1)
c>>>>>> (FOR THE WHILE, THE UPDATES START FROM SCRATCH AT EACH NEW
c>>>>>> CG RUN)
c select, in the case when bfgsb=2, it monitors the selection of
c the pairs (Av,v) to build the l-BFGS preconditioning matrix,
c with the following meanings:
c =0: no particular selection, FIFO policy
c>>>>>> (TO DATE, THIS SEEMS TO BE THE BEST CHOICE)
c =1: mexican selection (the pairs are distributed uniformely
c according to the iteration counter for a particular CG
c run)
c =2: by the Rayleigh quotient (it is tried to have pairs with a
c Rayleigh quotient distributed as uniformely as possible
c on the logarithmic scale)
c
c
c Output
c ^^^^^^
c
c epsneg: value of the last Rayleigh quotient v'Av/v'v
c encountered.
c iter: number of iterations actually performed; iter also serves
c as the iteration counter during the run, so that the user can
c know the iteration number when MVPROD is called
c mode: output mode of N1CG1
c =0: normal terminaison (stop on epsrel)
c =1: a dimension argument has a wrong value
c =2:
c =3: A is probably indefinite (Rayleigh quotient less than
c epsneg),
c =4: maximum number of iterations reached
c =5:
c =6: the initial residual is zero
c =7: error in the routine dysave, this may be due to a wrong
c value of select, a scalar product (y,s)<0 (rounding
c error ?), or a negative value of m1
c =8: the large increase of the cost, due to rounding errors
c (pmat1,npmat1): if bfgsb=1, will contain the plain BFGS
c preconditioning structure (not used otherwise)
c . pmat1(npmat1), double precision: will contain the matrix
c . npmat1, integer: dimension of pmat1, must be >= n**2
c (m1,ilm1,nilm1,wlm1,nwlm1): if bfgsb=2, will contain the l-BFGS
c preconditioning structure (not used otherwise)
c . m1, integer: number of (y,s) pairs to store,
c . ilm1(nilm1), integer
c . nilm1, integer: dimension of ilm1
c . wlm1(nwlm1), double precision: contains the (y,s) pairs
c . nwlm1, integer: dimension of wlm1, must be >= m1*(2*n+1)+1
c
c
c Other arguments
c ^^^^^^^^^^^^^^^
c
c izs() [integer], rzs() [real], and dzs() [double precision]:
c these variables are not used by N1CG1, they are just passed
c to the user-supplied routine mvprod
c
c
c Author
c ^^^^^^
c
c Version 1.1c: J.Ch. Gilbert, Inria, August 1999
c
c
c----
c
integer nq,nv,nr,nrr,nrm,naux,nrho,
& nybar0,nsbar0,nsize0,
& nybar1,nsbar1,nsize1,nol1
double precision eps2
c
c---- initial printings and check the arguments
c
if (imp.ge.1) then
write (io,900) n,epsneg,epsrel,iter,imp
if (preco.eq.0) then
write (io,901)
elseif (preco.eq.1) then
write (io,902)
elseif (preco.eq.2) then
write (io,903) m1
endif
if (bfgsb.eq.0) then
write (io,904)
elseif (bfgsb.eq.1) then
write (io,905)
elseif (bfgsb.eq.2) then
write (io,906) m0
endif
if (two) write (io,907)
if (imp.ge.2) write (io,910)
endif
900 format (/" n1cg1 (Version 1.1c, August 1999): entry point"/
& 4x,"dimension of the problem (n):",i14/
& 4x,"Rayleigh quotient threshold (epsneg):",4x,1pd9.2/
& 4x,"relative precision on residual (epsrel):",4x,d9.2/
& 4x,"maximal number of iterations (iter):",i7/
& 4x,"printing level (imp):",i22)
901 format (/4x,"Plain CG iterations")
902 format (/4x,"Preconditionned CG iterations")
903 format (/4x,"l-BFGS preconditioned CG iterations, with",i3,
& " pairs")
904 format (4x,"No preconditioning matrix is built")
905 format (4x,"A full BFGS preconditioning matrix is built")
906 format (4x,"An l-BFGS preconditioning matrix is built, with",i3,
& " pairs")
907 format (4x,"Two linear systems are solved simultaneously")
910 format (/1x,79("-"))
c
write(io,*) n,iter,epsneg,epsrel,two,nw,m0,npmat1,
& nwlm0,nwlm1,m1,imode(1),imode(2),imode(3),select
if (n.le.0 .or. iter.le.0
& .or. (.not.two .and. nw.lt.5*n+m0)
& .or. (two .and. nw.lt.6*n+m0)
C & .or. npmat1.lt.n**2.
& .or. nwlm0.lt.m0*(2*n+1)+1 .or. nwlm1.lt.m1*(2*n+1)+1
& .or. imode(1).lt.0 .or. imode(1).gt.1
& .or. imode(2).lt.0 .or. imode(2).gt.1
& .or. imode(3).lt.0 .or. imode(3).gt.1
& .or. select.lt.0 .or. select.gt.2) then
mode=1
if (imp.ge.1) write (io,920) n,iter,epsneg,epsrel,nw
return
endif
920 format (/" >>> n1cg1: inconsistent call ")
c
nq=1
nr=nq+n
nrr=nr
if (two) nrr=nr+n
nv=nrr+n
nrm=nv+n
naux=nrm+n
nrho=naux+n
c
nybar0=1
nsbar0=nybar0+n*m0
nsize0=nsbar0+n*m0
nybar1=1
nsbar1=nybar1+n*m1
nsize1=nsbar1+n*m1
nol1=nsize1+1
eps2=epsrel*epsrel
c
c call n1cga (mvprod,n,x,b,a,xx,bb,two,w(nq),w(nr),w(nrr),w(nv),
call cg
(mvprod,n,x,b,a,xx,bb,two,w(nq),w(nr),w(nrr),w(nv),
& w(nrm),epsneg,eps2,iter,imp,io,imode,mode,
& preco,pmat0,
& m0,ilm0(1),ilm0(2),ilm0(3),wlm0(nybar0),
& wlm0(nsbar0),wlm0(nsize0),
& bfgsb,
& pmat1,
& m1,ilm1(1),ilm1(2),ilm1(3),ilm1(4),wlm1(nybar1),
& wlm1(nsbar1),wlm1(nsize1),wlm1(nol1),select,
& w(nrho),w(naux),izs,rzs,dzs)
c
return
end
c
c--------0---------0---------0---------0---------0---------0---------0--
c