コード例 #1
0
ファイル: dsdcg.c プロジェクト: Rufflewind/cslatec
/* DECK DSDCG */
/* Subroutine */ int dsdcg_(integer *n, doublereal *b, doublereal *x, integer 
	*nelt, integer *ia, integer *ja, doublereal *a, integer *isym, 
	integer *itol, doublereal *tol, integer *itmax, integer *iter, 
	doublereal *err, integer *ierr, integer *iunit, doublereal *rwork, 
	integer *lenw, integer *iwork, integer *leniw)
{
    extern /* Subroutine */ int dcg_(integer *, doublereal *, doublereal *, 
	    integer *, integer *, integer *, doublereal *, integer *, U_fp, 
	    U_fp, integer *, doublereal *, integer *, integer *, doublereal *,
	     integer *, integer *, doublereal *, doublereal *, doublereal *, 
	    doublereal *, doublereal *, integer *), ds2y_(integer *, integer *
	    , integer *, integer *, doublereal *, integer *);
    static integer locd;
    extern /* Subroutine */ int dsdi_();
    static integer locp;
    extern /* Subroutine */ int dsds_(integer *, integer *, integer *, 
	    integer *, doublereal *, integer *, doublereal *);
    static integer locr, locw, locz;
    extern /* Subroutine */ int dsmv_();
    extern /* Subroutine */ int dchkw_(char *, integer *, integer *, integer *
	    , integer *, integer *, integer *, doublereal *, ftnlen);
    static integer locdz, lociw;

/* ***BEGIN PROLOGUE  DSDCG */
/* ***PURPOSE  Diagonally Scaled Conjugate Gradient Sparse Ax=b Solver. */
/*            Routine to solve a symmetric positive definite linear */
/*            system  Ax = b  using the Preconditioned Conjugate */
/*            Gradient method.  The preconditioner is diagonal scaling. */
/* ***LIBRARY   SLATEC (SLAP) */
/* ***CATEGORY  D2B4 */
/* ***TYPE      DOUBLE PRECISION (SSDCG-S, DSDCG-D) */
/* ***KEYWORDS  ITERATIVE PRECONDITION, SLAP, SPARSE, */
/*             SYMMETRIC LINEAR SYSTEM */
/* ***AUTHOR  Greenbaum, Anne, (Courant Institute) */
/*           Seager, Mark K., (LLNL) */
/*             Lawrence Livermore National Laboratory */
/*             PO BOX 808, L-60 */
/*             Livermore, CA 94550 (510) 423-3141 */
/*             [email protected] */
/* ***DESCRIPTION */

/* *Usage: */
/*     INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX */
/*     INTEGER ITER, IERR, IUNIT, LENW, IWORK(10), LENIW */
/*     DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(5*N) */

/*     CALL DSDCG(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, */
/*    $     ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) */

/* *Arguments: */
/* N      :IN       Integer. */
/*         Order of the Matrix. */
/* B      :IN       Double Precision B(N). */
/*         Right-hand side vector. */
/* X      :INOUT    Double Precision X(N). */
/*         On input X is your initial guess for solution vector. */
/*         On output X is the final approximate solution. */
/* NELT   :IN       Integer. */
/*         Number of Non-Zeros stored in A. */
/* IA     :INOUT    Integer IA(NELT). */
/* JA     :INOUT    Integer JA(NELT). */
/* A      :INOUT    Double Precision A(NELT). */
/*         These arrays should hold the matrix A in either the SLAP */
/*         Triad format or the SLAP Column format.  See "Description", */
/*         below.  If the SLAP Triad format is chosen it is changed */
/*         internally to the SLAP Column format. */
/* ISYM   :IN       Integer. */
/*         Flag to indicate symmetric storage format. */
/*         If ISYM=0, all non-zero entries of the matrix are stored. */
/*         If ISYM=1, the matrix is symmetric, and only the upper */
/*         or lower triangle of the matrix is stored. */
/* ITOL   :IN       Integer. */
/*         Flag to indicate type of convergence criterion. */
/*         If ITOL=1, iteration stops when the 2-norm of the residual */
/*         divided by the 2-norm of the right-hand side is less than TOL. */
/*         If ITOL=2, iteration stops when the 2-norm of M-inv times the */
/*         residual divided by the 2-norm of M-inv times the right hand */
/*         side is less than TOL, where M-inv is the inverse of the */
/*         diagonal of A. */
/*         ITOL=11 is often useful for checking and comparing different */
/*         routines.  For this case, the user must supply the "exact" */
/*         solution or a very accurate approximation (one with an error */
/*         much less than TOL) through a common block, */
/*             COMMON /DSLBLK/ SOLN( ) */
/*         If ITOL=11, iteration stops when the 2-norm of the difference */
/*         between the iterative approximation and the user-supplied */
/*         solution divided by the 2-norm of the user-supplied solution */
/*         is less than TOL.  Note that this requires the user to set up */
/*         the "COMMON /DSLBLK/ SOLN(LENGTH)" in the calling routine. */
/*         The routine with this declaration should be loaded before the */
/*         stop test so that the correct length is used by the loader. */
/*         This procedure is not standard Fortran and may not work */
/*         correctly on your system (although it has worked on every */
/*         system the authors have tried).  If ITOL is not 11 then this */
/*         common block is indeed standard Fortran. */
/* TOL    :INOUT    Double Precision. */
/*         Convergence criterion, as described above.  (Reset if IERR=4.) */
/* ITMAX  :IN       Integer. */
/*         Maximum number of iterations. */
/* ITER   :OUT      Integer. */
/*         Number of iterations required to reach convergence, or */
/*         ITMAX+1 if convergence criterion could not be achieved in */
/*         ITMAX iterations. */
/* ERR    :OUT      Double Precision. */
/*         Error estimate of error in final approximate solution, as */
/*         defined by ITOL. */
/* IERR   :OUT      Integer. */
/*         Return error flag. */
/*           IERR = 0 => All went well. */
/*           IERR = 1 => Insufficient space allocated for WORK or IWORK. */
/*           IERR = 2 => Method failed to converge in ITMAX steps. */
/*           IERR = 3 => Error in user input. */
/*                       Check input values of N, ITOL. */
/*           IERR = 4 => User error tolerance set too tight. */
/*                       Reset to 500*D1MACH(3).  Iteration proceeded. */
/*           IERR = 5 => Preconditioning matrix, M, is not positive */
/*                       definite.  (r,z) < 0. */
/*           IERR = 6 => Matrix A is not positive definite.  (p,Ap) < 0. */
/* IUNIT  :IN       Integer. */
/*         Unit number on which to write the error at each iteration, */
/*         if this is desired for monitoring convergence.  If unit */
/*         number is 0, no writing will occur. */
/* RWORK  :WORK     Double Precision RWORK(LENW). */
/*         Double Precision array used for workspace. */
/* LENW   :IN       Integer. */
/*         Length of the double precision workspace, RWORK.  LENW >= 5*N. */
/* IWORK  :WORK     Integer IWORK(LENIW). */
/*         Used to hold pointers into the double precision workspace, */
/*         RWORK.  Upon return the following locations of IWORK hold */
/*         information which may be of use to the user: */
/*         IWORK(9)  Amount of Integer workspace actually used. */
/*         IWORK(10) Amount of Double Precision workspace actually used. */
/* LENIW  :IN       Integer. */
/*         Length of the integer workspace, IWORK.  LENIW >= 10. */

/* *Description: */
/*       This  routine   performs preconditioned conjugate   gradient */
/*       method on  the  symmetric positive definite   linear  system */
/*       Ax=b.   The preconditioner is  M = DIAG(A), the  diagonal of */
/*       the matrix A.  This is the  simplest of preconditioners  and */
/*       vectorizes very well.   This routine is  simply a driver for */
/*       the DCG routine.  It  calls the DSDS  routine to  set up the */
/*       preconditioning  and  then  calls  DCG  with the appropriate */
/*       MATVEC and MSOLVE routines. */

/*       The Sparse Linear Algebra Package (SLAP) utilizes two matrix */
/*       data structures: 1) the  SLAP Triad  format or  2)  the SLAP */
/*       Column format.  The user can hand this routine either of the */
/*       of these data structures and SLAP  will figure out  which on */
/*       is being used and act accordingly. */

/*       =================== S L A P Triad format =================== */

/*       This routine requires that the  matrix A be   stored in  the */
/*       SLAP  Triad format.  In  this format only the non-zeros  are */
/*       stored.  They may appear in  *ANY* order.  The user supplies */
/*       three arrays of  length NELT, where  NELT is  the number  of */
/*       non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)).  For */
/*       each non-zero the user puts the row and column index of that */
/*       matrix element  in the IA and  JA arrays.  The  value of the */
/*       non-zero   matrix  element is  placed  in  the corresponding */
/*       location of the A array.   This is  an  extremely  easy data */
/*       structure to generate.  On  the  other hand it   is  not too */
/*       efficient on vector computers for  the iterative solution of */
/*       linear systems.  Hence,   SLAP changes   this  input    data */
/*       structure to the SLAP Column format  for  the iteration (but */
/*       does not change it back). */

/*       Here is an example of the  SLAP Triad   storage format for a */
/*       5x5 Matrix.  Recall that the entries may appear in any order. */

/*           5x5 Matrix      SLAP Triad format for 5x5 matrix on left. */
/*                              1  2  3  4  5  6  7  8  9 10 11 */
/*       |11 12  0  0 15|   A: 51 12 11 33 15 53 55 22 35 44 21 */
/*       |21 22  0  0  0|  IA:  5  1  1  3  1  5  5  2  3  4  2 */
/*       | 0  0 33  0 35|  JA:  1  2  1  3  5  3  5  2  5  4  1 */
/*       | 0  0  0 44  0| */
/*       |51  0 53  0 55| */

/*       =================== S L A P Column format ================== */

/*       This routine  requires that  the matrix A  be stored in  the */
/*       SLAP Column format.  In this format the non-zeros are stored */
/*       counting down columns (except for  the diagonal entry, which */
/*       must appear first in each  "column")  and are stored  in the */
/*       double precision array A.   In other words,  for each column */
/*       in the matrix put the diagonal entry in  A.  Then put in the */
/*       other non-zero  elements going down  the column (except  the */
/*       diagonal) in order.   The  IA array holds the  row index for */
/*       each non-zero.  The JA array holds the offsets  into the IA, */
/*       A arrays  for  the  beginning  of each   column.   That  is, */
/*       IA(JA(ICOL)),  A(JA(ICOL)) points   to the beginning  of the */
/*       ICOL-th   column    in    IA and   A.      IA(JA(ICOL+1)-1), */
/*       A(JA(ICOL+1)-1) points to  the  end of the   ICOL-th column. */
/*       Note that we always have  JA(N+1) = NELT+1,  where N is  the */
/*       number of columns in  the matrix and NELT  is the number  of */
/*       non-zeros in the matrix. */

/*       Here is an example of the  SLAP Column  storage format for a */
/*       5x5 Matrix (in the A and IA arrays '|'  denotes the end of a */
/*       column): */

/*           5x5 Matrix      SLAP Column format for 5x5 matrix on left. */
/*                              1  2  3    4  5    6  7    8    9 10 11 */
/*       |11 12  0  0 15|   A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 */
/*       |21 22  0  0  0|  IA:  1  2  5 |  2  1 |  3  5 |  4 |  5  1  3 */
/*       | 0  0 33  0 35|  JA:  1  4  6    8  9   12 */
/*       | 0  0  0 44  0| */
/*       |51  0 53  0 55| */

/* *Side Effects: */
/*       The SLAP Triad format (IA, JA, A) is modified internally  to */
/*       be the SLAP Column format.  See above. */

/* *Cautions: */
/*     This routine will attempt to write to the Fortran logical output */
/*     unit IUNIT, if IUNIT .ne. 0.  Thus, the user must make sure that */
/*     this logical unit is attached to a file or terminal before calling */
/*     this routine with a non-zero value for IUNIT.  This routine does */
/*     not check for the validity of a non-zero IUNIT unit number. */

/* ***SEE ALSO  DCG, DSICCG */
/* ***REFERENCES  1. Louis Hageman and David Young, Applied Iterative */
/*                  Methods, Academic Press, New York, 1981. */
/*               2. Concus, Golub and O'Leary, A Generalized Conjugate */
/*                  Gradient Method for the Numerical Solution of */
/*                  Elliptic Partial Differential Equations, in Sparse */
/*                  Matrix Computations, Bunch and Rose, Eds., Academic */
/*                  Press, New York, 1979. */
/* ***ROUTINES CALLED  DCG, DCHKW, DS2Y, DSDI, DSDS, DSMV */
/* ***REVISION HISTORY  (YYMMDD) */
/*   890404  DATE WRITTEN */
/*   890404  Previous REVISION DATE */
/*   890915  Made changes requested at July 1989 CML Meeting.  (MKS) */
/*   890921  Removed TeX from comments.  (FNF) */
/*   890922  Numerous changes to prologue to make closer to SLATEC */
/*           standard.  (FNF) */
/*   890929  Numerous changes to reduce SP/DP differences.  (FNF) */
/*   910411  Prologue converted to Version 4.0 format.  (BAB) */
/*   920407  COMMON BLOCK renamed DSLBLK.  (WRB) */
/*   920511  Added complete declaration section.  (WRB) */
/*   920929  Corrected format of references.  (FNF) */
/* ***END PROLOGUE  DSDCG */
/*     .. Parameters .. */
/*     .. Scalar Arguments .. */
/*     .. Array Arguments .. */
/*     .. Local Scalars .. */
/*     .. External Subroutines .. */
/* ***FIRST EXECUTABLE STATEMENT  DSDCG */

    /* Parameter adjustments */
    --x;
    --b;
    --a;
    --ja;
    --ia;
    --rwork;
    --iwork;

    /* Function Body */
    *ierr = 0;
    if (*n < 1 || *nelt < 1) {
	*ierr = 3;
	return 0;
    }

/*         Modify the SLAP matrix data structure to YSMP-Column. */
    ds2y_(n, nelt, &ia[1], &ja[1], &a[1], isym);

/*         Set up the work arrays. */
    lociw = 11;

    locd = 1;
    locr = locd + *n;
    locz = locr + *n;
    locp = locz + *n;
    locdz = locp + *n;
    locw = locdz + *n;

/*         Check the workspace allocations. */
    dchkw_("DSDCG", &lociw, leniw, &locw, lenw, ierr, iter, err, (ftnlen)5);
    if (*ierr != 0) {
	return 0;
    }

    iwork[4] = locd;
    iwork[9] = lociw;
    iwork[10] = locw;

/*         Compute the inverse of the diagonal of the matrix.  This */
/*         will be used as the preconditioner. */
    dsds_(n, nelt, &ia[1], &ja[1], &a[1], isym, &rwork[locd]);

/*         Do the Preconditioned Conjugate Gradient. */
    dcg_(n, &b[1], &x[1], nelt, &ia[1], &ja[1], &a[1], isym, (U_fp)dsmv_, (
	    U_fp)dsdi_, itol, tol, itmax, iter, err, ierr, iunit, &rwork[locr]
	    , &rwork[locz], &rwork[locp], &rwork[locdz], &rwork[1], &iwork[1])
	    ;
    return 0;
/* ------------- LAST LINE OF DSDCG FOLLOWS ----------------------------- */
} /* dsdcg_ */
コード例 #2
0
ファイル: dcgdrv.c プロジェクト: Electrostatics/FETK
/* ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc */
/* Subroutine */ int dcgdrv_(U_fp matvec, U_fp pcondl, U_fp pcondr, 
	doublereal *a, integer *ia, doublereal *x, doublereal *b, integer *n, 
	doublereal *q, integer *iq, doublereal *p, integer *ip, integer *
	iparam, doublereal *rparam, integer *iwork, doublereal *rwork, 
	integer *ierror)
{
    /* Format strings */
    static char fmt_100[] = "(\002 USING CGCODE:  ICG=\002,i10)";

    /* Builtin functions */
    integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);

    /* Local variables */
    extern /* Subroutine */ int dcg_(U_fp, doublereal *, integer *, 
	    doublereal *, doublereal *, integer *, integer *, doublereal *, 
	    integer *, doublereal *, doublereal *, doublereal *, doublereal *,
	     doublereal *, integer *);
    static integer icg, nce;
    extern /* Subroutine */ int dcr_(U_fp, doublereal *, integer *, 
	    doublereal *, doublereal *, integer *, integer *, doublereal *, 
	    integer *, doublereal *, doublereal *, doublereal *, doublereal *,
	     doublereal *, doublereal *, integer *), dpcg_(U_fp, U_fp, 
	    doublereal *, integer *, doublereal *, doublereal *, integer *, 
	    doublereal *, integer *, integer *, doublereal *, integer *, 
	    doublereal *, doublereal *, doublereal *, doublereal *, 
	    doublereal *, integer *);
    static integer kmax;
    extern /* Subroutine */ int dcgne_(U_fp, doublereal *, integer *, 
	    doublereal *, doublereal *, integer *, integer *, doublereal *, 
	    integer *, doublereal *, doublereal *, doublereal *, doublereal *,
	     doublereal *, integer *), dcgnr_(U_fp, doublereal *, integer *, 
	    doublereal *, doublereal *, integer *, integer *, doublereal *, 
	    integer *, doublereal *, doublereal *, doublereal *, doublereal *,
	     doublereal *, integer *), dppcg_(U_fp, U_fp, doublereal *, 
	    integer *, doublereal *, doublereal *, integer *, doublereal *, 
	    integer *, integer *, doublereal *, integer *, doublereal *, 
	    doublereal *, doublereal *, doublereal *, doublereal *, 
	    doublereal *, doublereal *, doublereal *, integer *), dpcgca_(
	    U_fp, U_fp, doublereal *, integer *, doublereal *, doublereal *, 
	    integer *, doublereal *, integer *, integer *, doublereal *, 
	    integer *, doublereal *, doublereal *, doublereal *, doublereal *,
	     doublereal *, doublereal *, doublereal *, doublereal *, integer *
	    ), dpcgne_(U_fp, U_fp, doublereal *, integer *, doublereal *, 
	    doublereal *, integer *, doublereal *, integer *, integer *, 
	    doublereal *, integer *, doublereal *, doublereal *, doublereal *,
	     doublereal *, doublereal *, doublereal *, integer *), dcrind_(
	    U_fp, doublereal *, integer *, doublereal *, doublereal *, 
	    integer *, integer *, doublereal *, integer *, doublereal *, 
	    doublereal *, doublereal *, doublereal *, doublereal *, 
	    doublereal *, doublereal *, doublereal *, integer *);
    static integer icycle;
    extern /* Subroutine */ int dpcgnr_(U_fp, U_fp, doublereal *, integer *, 
	    doublereal *, doublereal *, integer *, doublereal *, integer *, 
	    integer *, doublereal *, integer *, doublereal *, doublereal *, 
	    doublereal *, doublereal *, doublereal *, doublereal *, integer *)
	    ;
    static integer iolevl, iounit;

    /* Fortran I/O blocks */
    static cilist io___7 = { 0, 0, 0, fmt_100, 0 };


/* ***BEGIN PROLOGUE  DCGDRV */
/* ***DATE WRITTEN   860115   (YYMMDD) */
/* ***REVISION DATE  900210   (YYMMDD) */
/* ***CATEGORY NO. D2A4,D2B4 */
/* ***KEYWORDS  LINEAR SYSTEM,SPARSE,ITERATIVE,CONJUGATE GRADIENTS */
/* ***AUTHOR  ASHBY,STEVEN F., (UIUC) */
/*             UNIV. OF ILLINOIS */
/*             DEPT. OF COMPUTER SCIENCE */
/*             URBANA, IL 61801 */
/* ***AUTHOR  HOLST,MICHAEL J., (UIUC) */
/*             UNIV. OF ILLINOIS */
/*             DEPT. OF COMPUTER SCIENCE */
/*             URBANA, IL 61801 */
/*           MANTEUFFEL,THOMAS A., (LANL) */
/*             LOS ALAMOS NATIONAL LABORATORY */
/*             MAIL STOP B265 */
/*             LOS ALAMOS, NM 87545 */
/* ***PURPOSE  THIS SUBROUTINE IS AN INTERFACE TO CGCODE, A PACKAGE OF */
/*            PRECONDITIONED CONJUGATE GRADIENT CODES.  THESE CODES */
/*            WILL SOLVE BOTH SYMMETRIC AND NONSYMMETRIC LINEAR SYSTEMS, */
/*            WITH OR WITHOUT PRECONDITIONING.  PRECONDITIONING INCLUDES */
/*            USER SUPPLIED PRECONDITIONERS AND/OR OR AUTOMATIC ADAPTIVE */
/*            POLYNOMIAL PRECONDITIONING.  SEE THE FLAGS ICG=IPARAM(13) */
/*            AND IPCOND=IPARAM(7) FOR DETAILS; ALSO SEE THE INDIVIDUAL */
/*            SUBROUTINES' PROLOGUES.  THE ARGUMENT LIST OF THIS */
/*            INTERFACE SUBROUTINE CONFORMS TO THE PROPOSED STANDARD FOR */
/*            ITERATIVE LINEAR SOLVERS (SEE THE BIBLIOGRAPHY FOR MORE */
/*            INFORMATION.) */
/* ***DEDCRIPTION */

/* --- ON ENTRY --- */

/*    MATVEC   EXTERNAL SUBROUTINE MATVEC(JOB,A,IA,W,X,Y,N) */
/*             THE USER MUST PROVIDE A SUBROUTINE HAVING THE SPECIFED */
/*             PARAMETER LIST.  THE SUBROUTINE MUST RETURN THE PRODUCT */
/*             (OR A RELATED COMPUTATION; SEE BELOW) Y=A*X, WHERE A IS */
/*             THE COEFFICIENT MATRIX OF THE LINEAR SYSTEM.  THE MATRIX */
/*             A IS REPRESENTED BY THE WORK ARRAYS A AND IA, DEDCRIBED */
/*             BELOW.  THE INTEGER PARAMETER JOB SPECIFIES THE PRODUCT */
/*             TO BE COMPUTED: */
/*                  JOB=0    Y=A*X */
/*                  JOB=1    Y=AT*X */
/*                  JOB=2    Y=W - A*X */
/*                  JOB=3    Y=W - AT*X. */
/*             IN THE ABOVE, AT DENOTES A-TRANSPOSE.  NOTE THAT */
/*             ONLY THE VALUES OF JOB=0,1 ARE REQUIRED FOR CGCODE. */
/*             ALL OF THE ROUTINES IN CGCODE REQUIRE JOB=0; THE */
/*             ROUTINES DCGNR, DCGNE, DPCGNR, AND DPCGNE ALSO REQUIRE */
/*             THE VALUE OF JOB=1.  (THE VALUES OF JOB=2,3 ARE NOT */
/*             REQUIRED BY ANY OF THE ROUTINES IN CGCODE, BUT MAY BE */
/*             REQUIRED BY OTHER ITERATIVE PACKAGES CONFORMING TO THE */
/*             PROPOSED ITERATIVE STANDARD.)  THE PARAMETERS W,X,Y ARE */
/*             ALL VECTORS OF LENGTH N.  THE ONLY PARAMETER THAT MAY BE */
/*             CHANGED INSIDE THE ROUTINE IS Y.  MATVEC WILL USUALLY */
/*             SERVE AS AN INTERFACE TO THE USER'S OWN MATRIX-VECTOR */
/*             MULTIPLY SUBROUTINE. */
/*             NOTE: MATVEC MUST BE DECLARED IN AN EXTERNAL STATEMENT */
/*             IN THE CALLING PROGRAM. */

/*    PCONDL   EXTERNAL SUBROUTINE PCONDL(JOB,Q,IQ,W,X,Y,N) */
/*             PCONDL IMPLEMENTS A USER SUPPLIED LEFT-PRECONDITIONER. */
/*             IF PRECONDITIONING IS SPECIFIED BY THE USER, THEN THE */
/*             USER MUST PROVIDE A SUBROUTINE HAVING THE SPECIFED */
/*             PARAMETER LIST.  THE SUBROUTINE MUST RETURN THE PRODUCT */
/*             (OR A RELATED COMPUTATION; SEE BELOW) Y=C*X, WHERE C */
/*             IS A PRECONDITIONING MATRIX.  THE MATRIX C IS */
/*             REPRESENTED BY THE WORK ARRAYS Q AND IQ, DEDCRIBED */
/*             BELOW.  THE INTEGER PARAMETER JOB SPECIFIES THE PRODUCT */
/*             TO BE COMPUTED: */
/*                  JOB=0    Y=C*X */
/*                  JOB=1    Y=CT*X */
/*                  JOB=2    Y=W - C*X */
/*                  JOB=3    Y=W - CT*X. */
/*             IN THE ABOVE, CT DENOTES C-TRANSPOSE.  NOTE THAT */
/*             ONLY THE VALUES OF JOB=0,1 ARE REQUIRED FOR CGCODE. */
/*             THE ROUTINES DPCG, DPCGNR, DPCGNE, DPPCG, AND DPCGCA IN */
/*             CGCODE REQUIRE JOB=0; THE ROUTINES DPCGNR AND DPCGNE ALSO */
/*             REQUIRE THE VALUE OF JOB=1.  (THE VALUES OF JOB=2,3 ARE */
/*             NOT REQUIRED BY ANY OF THE ROUTINES IN CGCODE, BUT MAY BE */
/*             REQUIRED BY OTHER ITERATIVE PACKAGES CONFORMING TO THE */
/*             PROPOSED ITERATIVE STANDARD.)  THE PARAMETERS W,X,Y ARE */
/*             ALL VECTORS OF LENGTH N.  THE ONLY PARAMETER THAT MAY BE */
/*             CHANGED INSIDE THE ROUTINE IS Y.  PCONDL WILL USUALLY */
/*             SERVE AS AN INTERFACE TO THE USER'S OWN PRECONDITIONING */
/*             NOTE: PCONDL MUST BE DECLARED IN AN EXTERNAL STATEMENT */
/*             IN THE CALLING PROGRAM.  IF NO PRE-CONDITIONING IS BEING */
/*             DONE, PCONDL IS A DUMMY ARGUMENT. */

/*    PCONDR   DUMMY ARGUMENT (MANDATED BY PROPOSED STANDARD.) */

/*    A        DBLE ARRAY ADDRESS. */
/*             THE BASE ADDRESS OF THE USER'S DBLE WORK ARRAY, USUALLY */
/*             THE MATRIX A.  SINCE A IS ONLY ACCESSED BY CALLS TO SUBR */
/*             MATVEC, IT MAY BE A DUMMY ADDRESS. */

/*    IA       INTEGER ARRAY ADDRESS. */
/*             THE BASE ADDRESS OF THE USER'S INTEGER WORK ARRAY.  THIS */
/*             USUALLY CONTAINS ADDITIONAL INFORMATION ABOUT A NEEDED BY */
/*             MATVEC.  SINCE IA IS ONLY ACCESSED BY CALLS TO MATVEC, IT */
/*             MAY BE A DUMMY ADDRESS. */

/*    X        DBLE(N). */
/*             THE INITIAL GUESS VECTOR, X0. */
/*             (ON EXIT, X IS OVERWRITTEN WITH THE APPROXIMATE SOLUTION */
/*             OF A*X=B.) */

/*    B        DBLE(N). */
/*             THE RIGHT-HAND SIDE VECTOR OF THE LINEAR SYSTEM AX=B. */
/*             NOTE: B IS CHANGED BY THE SOLVER. */

/*    N        INTEGER. */
/*             THE ORDER OF THE MATRIX A IN THE LINEAR SYSTEM AX=B. */

/*    Q        DBLE ARRAY ADDRESS. */
/*             THE BASE ADDRESS OF THE USER'S LEFT-PRECONDITIONING ARRAY, */
/*             Q.  SINCE Q IS ONLY ACCESSED BY CALLS TO PCONDL, IT MAY BE */
/*             A DUMMY ADDRESS.  IF NO LEFT-PRECONDITIONING IS BEING */
/*             DONE, THIS IS A DUMMY ARGUMENT. */

/*    IQ       INTEGER ARRAY ADDRESS. */
/*             THE BASE ADDRESS OF AN INTEGER WORK ARRAY ASSOCIATED WITH */
/*             Q.  THIS PROVIDES THE USER WITH A WAY OF PASSING INTEGER */
/*             INFORMATION ABOUT Q TO PCONDL.  SINCE IQ IS ONLY ACCESSED */
/*             BY CALLS TO PCONDL, IT MAY BE A DUMMY ADDRESS.  IF NO */
/*             LEFT-PRECONDITIONING IS BEING DONE, THIS IS A DUMMY */
/*             ARGUMENT. */

/*    P        DUMMY ARGUMENT (MANDATED BY PROPOSED STANDARD.) */

/*    IP       DUMMY ARGUMENT (MANDATED BY PROPOSED STANDARD.) */

/*    IPARAM   INTEGER(40). */
/*             AN ARRAY OF INTEGER INPUT PARAMETERS: */
/*                NOTE: IPARAM(1) THROUGH IPARAM(10) ARE MANDATED BY THE */
/*                PROPOSED STANDARD; IPARAM(11) THROUGH IPARAM(30) ARE */
/*                RESERVED FOR EXPANSION OF THE PROPOSED STANDARD; */
/*                IPARAM(31) THROUGH IPARAM(34) ARE ADDITIONAL */
/*                PARAMETERS, SPECIFIC TO CGCODE. */

/*             IPARAM(1) = NIPAR */
/*             LENGTH OF THE IPARAM ARRAY. */

/*             IPARAM(2) = NRPAR */
/*             LENGTH OF THE RPARAM ARRAY. */

/*             IPARAM(3) = NIWK */
/*             LENGTH OF THE IWORK ARRAY. */

/*             IPARAM(4) = NRWK */
/*             LENGTH OF THE RWORK ARRAY. */

/*             IPARAM(5) = IOUNIT */
/*             IF (IOUNIT > 0) THEN ITERATION INFORMATION (AS */
/*             SPECIFIED BY IOLEVL; SEE BELOW) IS SENT TO UNIT=IOUNIT, */
/*             WHICH MUST BE OPENED IN THE CALLING PROGRAM. */
/*             IF (IOUNIT <= 0) THEN THERE IS NO OUTPUT. */

/*             IPARAM(6) = IOLEVL */
/*             SPECIFIES THE AMOUNT AND TYPE OF INFORMATION TO BE */
/*             OUTPUT IF (IOUNIT > 0): */
/*                IOLEVL = 0   OUTPUT ERROR MESSAGES ONLY */
/*                IOLEVL = 1   OUTPUT INPUT PARAMETERS AND LEVEL 0 INFO */
/*                IOLEVL = 2   OUTPUT STPTST (SEE BELOW) AND LEVEL 1 INFO */
/*                IOLEVL = 3   OUTPUT LEVEL 2 INFO AND MORE DETAILS */

/*             IPARAM(7) = IPCOND */
/*             PRECONDITIONING FLAG, SPECIFIED AS: */
/*                IPCOND = 0   NO PRECONDITIONING */
/*                IPCOND = 1   LEFT PRECONDITIONING */
/*                IPCOND = 2   RIGHT PRECONDITIONING */
/*                IPCOND = 3   BOTH LEFT AND RIGHT PRECONDITIONING */
/*             NOTE:  RIGHT PRECONDITIONING IS A MANDATED OPTION OF THE */
/*             PROPOSED STANDARD, BUT NOT IMPLEMENTED IN CGCODE. */

/*             IPARAM(8) = ISTOP */
/*             STOPPING CRITERION FLAG, INTERPRETED AS: */
/*                ISTOP = 0  ||E||/||E0||      <= ERRTOL  (DEFAULT) */
/*                ISTOP = 1  ||R||             <= ERRTOL */
/*                ISTOP = 2  ||R||/||B||       <= ERRTOL */
/*                ISTOP = 3  ||C*R||           <= ERRTOL */
/*                ISTOP = 4  ||C*R||/||C*B||   <= ERRTOL */
/*             WHERE E=ERROR, R=RESIDUAL, B=RIGHT HAND SIDE OF A*X=B, */
/*             AND C IS THE PRECONDITIONING MATRIX OR PRECONDITIONING */
/*             POLYNOMIAL (OR BOTH.) */
/*             NOTE: IF ISTOP=0 IS SELECTED BY THE USER, THEN ERRTOL */
/*             IS THE AMOUNT BY WHICH THE INITIAL ERROR IS TO BE */
/*             REDUCED.  BY ESTIMATING THE CONDITION NUMBER OF THE */
/*             ITERATION MATRIX, THE CODE ATTEMPTS TO GUARANTEE THAT */
/*             THE FINAL RELATIVE ERROR IS .LE. ERRTOL.  SEE THE LONG */
/*             DEDCRIPTION BELOW FOR DETAILS. */

/*             IPARAM(9) = ITMAX */
/*             THE MAXIMUM NUMBER OF ITERATIVE STEPS TO BE TAKEN. */
/*             IF SOLVER IS UNABLE TO SATISFY THE STOPPING CRITERION */
/*             WITHIN ITMAX ITERATIONS, IT RETURNS TO THE CALLING */
/*             PROGRAM WITH IERROR=-1000. */

/*             IPARAM(31) = ICYCLE */
/*             THE FREQUENCY WITH WHICH A CONDITION NUMBER ESTIMATE IS */
/*             COMPUTED; SEE THE LONG DEDCRIPTION BELOW. */

/*             IPARAM(32) = NCE */
/*             THE MAXIMUM NUMBER OF CONDITION NUMBER ESTIMATES TO BE */
/*             COMPUTED.  IF NCE = 0 NO ESTIMATES ARE COMPUTED.  SEE */
/*             THE LONG DEDCRIPTION BELOW. */

/*             IPARAM(33) = ICG */
/*             A FLAG SPECIFYING THE METHOD TO BE USED.  BELOW C IS */
/*             THE USER'S PRECONDITIONING MATRIX, CT ITS TRANSPOSE, */
/*             AND AT IS THE TRANSPOSE OF A. */
/*                ICG=1 : CG    : CONJUGATE GRADIENTS ON A, A SPD (CGHS) */
/*                ICG=2 : CR    : CONJUGATE RESIDUALS ON A, A SPD */
/*                ICG=3 : CRIND : CR ON A, A SYMMETRIC */
/*                ICG=4 : PCG   : PRECONITIONED CG ON A, A AND C SPD */
/*                ICG=5 : CGNR  : CGHS ON AT*A, A ARBITRARY */
/*                ICG=6 : CGNE  : CGHS ON A*AT, A ARBITRARY */
/*                ICG=7 : PCGNR : CGNR ON A*C, A AND C ARBITRARY */
/*                ICG=8 : PCGNE : CGNE ON C*A, A AND C ARBITRARY */
/*                ICG=8 : PPCG  : POLYNOMIAL PCG ON A, A AND C SPD */
/*                ICG=10: PCGCA : CGHS ON C(A)*A, A AND C SPD */
/*             IF (1 .LT. ICG) OR (ICG .GT. 10) THEN ICG=1 IS ASSUMED. */

/*             IPARAM(34) = NDEG */
/*             WHEN USING THE CONJUGATE GRADIENT ROUTINES DPPCG AND */
/*             DPCGCA, NDEG SPECIFIES THE DEGREE OF THE PRECONDITIONING */
/*             POLYNOMIAL TO BE USED IN THE ADAPTIVE POLYNOMIAL */
/*             PRECONDITIONING ROUTINES. */

/*             NOTE:  KMAX = ICYCLE*NCE IS THE ORDER OF THE LARGEST */
/*             ORTHOGONAL SECTION OF C*A USED TO COMPUTE A CONDITION */
/*             NUMBER ESTIMATE.  THIS ESTIMATE IS ONLY USED IN THE */
/*             STOPPING CRITERION.  AS SUCH, KMAX SHOULD BE MUCH LESS */
/*             THAN N.  OTHERWISE THE CODE WILL HAVE EXCESSIVE STORAGE */
/*             AND WORK REQUIREMENTS. */

/*    RPARAM   DBLE(40). */
/*             AN ARRAY OF DBLE INPUT PARAMETERS: */
/*                NOTE: RPARAM(1) AND RPARAM(2) ARE MANDATED BY THE */
/*                PROPOSED STANDARD; RPARAM(3) THROUGH RPARAM(30) ARE */
/*                RESERVED FOR EXPANSION OF THE PROPOSED STANDARD; */
/*                RPARAM(31) THROUGH RPARAM(34) ARE ADDITIONAL */
/*                PARAMETERS, SPECIFIC TO CGCODE. */

/*             RPARAM(1) = ERRTOL */
/*             USER PROVIDED ERROR TOLERANCE; SEE ISTOP ABOVE, AND THE */
/*             LONG DEDCRIPTION BELOW. */

/*             RPARAM(31) = CONDES */
/*             AN INITIAL ESTIMATE FOR THE COND NUMBER OF THE ITERATION */
/*             MATRIX; SEE THE INDIVIDUAL SUBROUTINE'S PROLOGUE. AN */
/*             ACCEPTABLE INITIAL VALUE IS 1.0. */

/*             RPARAM(32) = AA */
/*             INITIAL ESTIMATE OF THE SMALLEST EIGENVALUE OF THE */
/*             SYSTEM MATRIX.  WHEN USING THE CONJUGATE GRADIENT */
/*             ROUTINES DPPCG AND DPCGCA, AA IS USED IN THE ADAPTIVE */
/*             POLYNOMIAL PRECONDITIONING ROUTINES FOR FORMING THE */
/*             OPTIMAL PRECONDITIONING POLYNOMIAL. */

/*             RPARAM(33) = BB */
/*             INITIAL ESTIMATE OF THE LARGEST EIGENVALUE OF THE */
/*             SYSTEM MATRIX.  WHEN USING THE CONJUGATE GRADIENT */
/*             ROUTINES DPPCG AND DPCGCA, BB IS USED IN THE ADAPTIVE */
/*             POLYNOMIAL PRECONDITIONING ROUTINES FOR FORMING THE */
/*             OPTIMAL PRECONDITIONING POLYNOMIAL. */

/*    RWORK    DBLE(N1+N2). */
/*             WORK ARRAY, WHERE N1 AND N2 ARE INTEGERS SUCH THAT: */
/*                N1 .GE. 2*N               FOR DCG, DPCG, DCGNR, DCGNE. */
/*                N1 .GE. 3*N               FOR DCR, DPCGNR, DPCGNE. */
/*                N1 .GE. 5*N               FOR DCRIND */
/*                N1 .GE. 6*N               FOR DPPCG, DPCGCA. */
/*                N2 .GE. 2*ICYCLE*NCE+2    FOR DPPCG, DPCGCA */
/*                N2 .GE. 4*ICYCLE*NCE+2    FOR DCG, DCR, DPCG, DCGNR, */
/*                                              DCGNE, DPCGNR, DPCGNE, */
/*                                              DCRIND */
/*             THE N2 SPACE IS FOR COMPUTING CONDITION NUMBER ESTIMATES; */
/*             THE N1 SPACE IS FOR TEMPORARY VECTORS.  TO SAVE STORAGE */
/*             AND WORK, ICYCLE*NCE SHOULD BE MUCH LESS THAN N.  NOTE */
/*             THAT IF NCE = 0, N2 MAY BE SET TO ZERO. */

/*    IWORK    INTEGER(ICYCLE*NCE) */
/*             INTEGER WORK ARRAY FOR COMPUTING COND NUMBER ESTIMATES. */
/*             IF NCE = 0, THIS MAY BE A DUMMY ADDRESS. */

/* --- ON RETURN --- */

/*    IPARAM   THE FOLLOWING ITERATION INFO IS RETURNED VIA THIS ARRAY: */

/*             IPARAM(10) = ITERS */
/*             THE NUMBER OF ITERATIONS TAKEN.  IF IERROR=0, THEN X_ITERS */
/*             SATISFIES THE SPECIFIED STOPPING CRITERION.  IF */
/*             IERROR=-1000, CGCODE WAS UNABLE TO CONVERGE WITHIN ITMAX */
/*             ITERATIONS, AND X_ITERS IS CGCODE'S BEST APPROXIMATION TO */
/*             THE SOLUTION OF A*X=B. */

/*    RPARAM   THE FOLLOWING ITERATION INFO IS RETURNED VIA THIS ARRAY: */

/*             RPARAM(2) = STPTST */
/*             FINAL QUANTITY USED IN THE STOPPING CRITERION; SEE ISTOP */
/*             ABOVE, AND THE LONG DEDCRIPTION BELOW. */

/*             RPARAM(31) = CONDES */
/*             CONDITION NUMBER ESTIMATE; FINAL ESTIMATE USED IN THE */
/*             STOPPING CRITERION; SEE ISTOP ABOVE, AND THE LONG */
/*             DEDCRIPTION BELOW. */

/*             RPARAM(34) = DCRLRS */
/*             THE SCALED RELATIVE RESIDUAL USING THE LAST COMPUTED */
/*             RESIDUAL. */

/*    X        THE COMPUTED SOLUTION OF THE LINEAR SYSTEM AX=B. */

/*    IERROR   INTEGER. */
/*             ERROR FLAG (NEGATIVE ERRORS ARE FATAL): */
/*             (BELOW, A=SYSTEM MATRIX, Q=LEFT PRECONDITIONING MATRIX.) */
/*             IERROR =  0      NORMAL RETURN: ITERATION CONVERGED */
/*             IERROR =  -1000  METHOD FAILED TO CONVERGE IN ITMAX STEPS */
/*             IERROR = +-2000  ERROR IN USER INPUT */
/*             IERROR = +-3000  METHOD BREAKDOWN */
/*             IERROR =  -6000  A DOES NOT SATISTY ASSUMPTIONS OF METHOD */
/*             IERROR =  -7000  Q DOES NOT SATISTY ASSUMPTIONS OF METHOD */

/* ***LONG DEDCRIPTION */

/*    EACH CG ALGORITHM IN THE PACKAGE IS AN INSTANCE OF AN ORTHOGONAL */
/*    ERROR METHOD.  THE GENERAL FORM OF SUCH A METHOD IS: */

/*                   P0 = S0 = C*R0 */
/*                   ALPHA = <B*E,P>/<B*P,P> */
/*                   XNEW = X + ALPHA*P */
/*                   RNEW = R - ALPHA*(A*P) */
/*                   SNEW = C*RNEW */
/*                   BETA = <B*SNEW,P>/<B*P,P> */
/*                   PNEW = SNEW - BETA*P */

/*    WHERE B IS A SYMMETRIC POSITIVE DEFINITE MATRIX AND C IS A */
/*    PRECONDITIONING MATRIX.  THE FOLLOWING CHOICES OF B AND C GIVE THE */
/*    ALGORITHMS IN THE PACKAGE.  THE QUANTITY MINIMIZED AT EACH STEP IS */
/*    ALSO LISTED. */

/*       ROUTINE        B MATRIX      C MATRIX     QUANTITY MINIMIZED */

/*        DCG              A             I             <A*E E> */
/*        DCR             A*A            I              <R, R> */
/*        DCRIND          A*A            I              <R, R> */
/*        DPCG             A             C             <A*E, E> */
/*        DCGNR           AT*A           AT             <R, R> */
/*        DCGNE            I             AT             <E, E> */
/*        DPCGNR          AT*A         C*CT*AT          <R, R> */
/*        DPCGNE           I           AT*CT*C          <E, E> */
/*        DPPCG            A           C(A)*C          <A*E, E> */
/*        DPCGCA         C(A)*A          C           <C(A)*A*E, E> */

/*    FOR SPECIFIC ALGORITHMS AND IMPLEMENTATION DETAILS SEE THE ROUTINE */
/*    OF INTEREST.  FOR MORE ON ORTHOGONAL ERROR METHODS SEE THE SECOND */
/*    REFERENCE BELOW. */

/*    WHEN THE USER SELECTS THE STOPPING CRITERION OPTION ISTOP=0, THEN */
/*    THE CODES ALL ATTEMPT TO GUARANTEE THAT */

/*            (FINAL ERROR) / (INITIAL ERROR)  .LE.  ERRTOL     (1) */

/*    THAT IS, THE CODES ATTEMPT TO REDUCE THE INITIAL ERROR BY ERRTOL. */
/*    (IF X0=0, THEN ERRTOL IS ALSO A BOUND FOR THE RELATIVE ERROR IN */
/*    THE COMPUTED SOLUTION, X.) TO SEE HOW (1) IS SATISFIED, CONSIDER */
/*    THE SCALED SYSTEM C*AX = C*P.   IF E(K) IS THE ERROR AT THE KTH */
/*    STEP, THEN WE HAVE */

/*                 E(K)/E(0)  .LE.  COND(CA) * S(K)/S(0) */

/*    WHERE S(K) = C*R(K) IS THE KTH SCALED RESIDUAL.  THE S VECTORS ARE */
/*    AVAILABLE FROM THE ITERATION.  IF WE CAN ESTIMATE COND(CA), THEN */
/*    EQUATION (1) IS SATISFIED WHEN */

/*                 COND(CA) * S(K)/S(0)  .LE.  ERRTOL. */

/*    AN ESTIMATE FOR COND(CA) IS OBTAINED BY COMPUTING THE MIN AND MAX */
/*    EIGENVALUES OF AN ORTHOGONAL SECTION OF C*A.  THIS IS DONE EVERY */
/*    ICYCLE STEPS.  THE LARGEST ORTHOG SECTION HAS ORDER ICYCLE*NCE, */
/*    WHERE NCE IS THE MAXIMUM NUMBER OF CONDITION ESTIMATES.  TO SAVE */
/*    STORAGE AND WORK, ICYCLE*NCE SHOULD BE MUCH LESS THAN N. IF NCE=0, */
/*    NO CONDITION ESTIMATES ARE COMPUTED.  IN THIS CASE, THE CODE STOPS */
/*    WHEN S(K)/S(0) .LE. ERRTOL.  SEE THE INDIVIDUAL SUBROUTINES' LONG */
/*    DEDCRIPTIONS FOR DETAILS. */

/*    THIS STOPPING CRITERION WAS IMPLEMENTED BY A.J. ROBERTSON, III */
/*    (DEPT. OF MATHEMATICS, UNIV. OF COLORADO AT DENVER).  QUESTIONS */
/*    MAY BE DIRECTED TO HIM OR TO ONE OF THE AUTHORS. */

/* ***REFERENCES  HOWARD C. ELMAN, "ITERATIVE METHODS FOR LARGE, SPARSE, */
/*                 NONSYMMETRIC SYSTEMS OF LINEAR EQUATIONS", YALE UNIV. */
/*                 DCS RESEARCH REPORT NO. 229 (APRIL 1982). */
/*               VANCE FABER AND THOMAS MANTEUFFEL, "NECESSARY AND */
/*                 SUFFICIENT CONDITIONS FOR THE EXISTENCE OF A */
/*                 CONJUGATE GRADIENT METHODS", SIAM J. NUM ANAL 21(2), */
/*                 PP. 352-362, 1984. */
/*               S. ASHBY, T. MANTEUFFEL, AND P. SAYLOR, "A TAXONOMY FOR */
/*                 CONJUGATE GRADIENT METHODS", SIAM J. NUM ANAL 27(6), */
/*                 PP. 1542-1568, 1990. */
/*               S. ASHBY, M. HOLST, T. MANTEUFFEL, AND P. SAYLOR, */
/*                 THE ROLE OF THE INNER PRODUCT IN STOPPING CRITERIA */
/*                 FOR CONJUGATE GRADIENT ITERATIONS", BIT 41(1), */
/*                 PP. 26-53, 2001. */
/*               M. HOLST, "CGCODE: SOFTWARE FOR SOLVING LINEAR SYSTEMS */
/*                 WITH CONJUGATE GRADIENT METHODS", M.S. THESIS, UNIV. */
/*                 OF ILLINOIS DCS RESEARCH REPORT (MAY 1990). */
/*               S. ASHBY, "POLYNOMIAL PRECONDITIONG FOR CONJUGATE */
/*                 GRADIENT METHODS", PH.D. THESIS, UNIV. OF ILLINOIS */
/*                 DCS RESEARCH REPORT NO. R-87-1355 (DECEMBER 1987). */
/*               S. ASHBY, M. SEAGER, "A PROPOSED STANDARD FOR ITERATIVE */
/*                 LINEAR SOLVERS", LAWRENCE LIVERMORE NATIONAL */
/*                 LABORATORY REPORT (TO APPEAR). */

/* ***ROUTINES CALLED  DCG,DCRIND,DPCG,DCGNR,DCGNE,DPCGNR,DPCGNE, */
/*                    DPPCG,DPCGCA */
/* ***END PROLOGUE  DCGDRV */

/*     *** DECLARATIONS *** */

/* ***FIRST EXECUTABLE STATEMENT  DCGDRV */
    /* Parameter adjustments */
    --rwork;
    --iwork;
    --rparam;
    --iparam;
    --ip;
    --p;
    --iq;
    --q;
    --b;
    --x;
    --ia;
    --a;

    /* Function Body */
/* L1: */

/*     *** DECODE METHOD PARAMETER AND RWORK PARSING PARAMETERS *** */
    iounit = iparam[5];
    iolevl = iparam[6];
    icg = iparam[33];
    icycle = iparam[31];
    nce = iparam[32];
    kmax = icycle * nce;

/*     *** CALL THE APPROPRIATE CGCODE SUBROUTINE *** */
    if (iounit > 0 && iolevl > 0) {
	io___7.ciunit = iounit;
	s_wsfe(&io___7);
	do_fio(&c__1, (char *)&icg, (ftnlen)sizeof(integer));
	e_wsfe();
    }
    switch (icg) {
	case 1:  goto L11;
	case 2:  goto L12;
	case 3:  goto L13;
	case 4:  goto L14;
	case 5:  goto L15;
	case 6:  goto L16;
	case 7:  goto L17;
	case 8:  goto L18;
	case 9:  goto L19;
	case 10:  goto L20;
    }

L11:
    dcg_((U_fp)matvec, &a[1], &ia[1], &x[1], &b[1], n, &iparam[1], &rparam[1],
	     &iwork[1], &rwork[1], &rwork[*n + 1], &rwork[(*n << 1) + 1], &
	    rwork[(*n << 1) + kmax + 2], &rwork[(*n << 1) + (kmax << 1) + 3], 
	    ierror);
    goto L99;

L12:
    dcr_((U_fp)matvec, &a[1], &ia[1], &x[1], &b[1], n, &iparam[1], &rparam[1],
	     &iwork[1], &rwork[1], &rwork[*n + 1], &rwork[(*n << 1) + 1], &
	    rwork[*n * 3 + 1], &rwork[*n * 3 + kmax + 2], &rwork[*n * 3 + (
	    kmax << 1) + 3], ierror);
    goto L99;

L13:
    dcrind_((U_fp)matvec, &a[1], &ia[1], &x[1], &b[1], n, &iparam[1], &rparam[
	    1], &iwork[1], &rwork[1], &rwork[*n + 1], &rwork[(*n << 1) + 1], &
	    rwork[*n * 3 + 1], &rwork[(*n << 2) + 1], &rwork[*n * 5 + 1], &
	    rwork[*n * 5 + kmax + 2], &rwork[*n * 5 + (kmax << 1) + 3], 
	    ierror);
    goto L99;

L14:
    dpcg_((U_fp)matvec, (U_fp)pcondl, &a[1], &ia[1], &x[1], &b[1], n, &q[1], &
	    iq[1], &iparam[1], &rparam[1], &iwork[1], &rwork[1], &rwork[*n + 
	    1], &rwork[(*n << 1) + 1], &rwork[(*n << 1) + kmax + 2], &rwork[(*
	    n << 1) + (kmax << 1) + 3], ierror);
    goto L99;

L15:
    dcgnr_((U_fp)matvec, &a[1], &ia[1], &x[1], &b[1], n, &iparam[1], &rparam[
	    1], &iwork[1], &rwork[1], &rwork[*n + 1], &rwork[(*n << 1) + 1], &
	    rwork[(*n << 1) + kmax + 2], &rwork[(*n << 1) + (kmax << 1) + 3], 
	    ierror);
    goto L99;

L16:
    dcgne_((U_fp)matvec, &a[1], &ia[1], &x[1], &b[1], n, &iparam[1], &rparam[
	    1], &iwork[1], &rwork[1], &rwork[*n + 1], &rwork[(*n << 1) + 1], &
	    rwork[(*n << 1) + kmax + 2], &rwork[(*n << 1) + (kmax << 1) + 3], 
	    ierror);
    goto L99;

L17:
    dpcgnr_((U_fp)matvec, (U_fp)pcondl, &a[1], &ia[1], &x[1], &b[1], n, &q[1],
	     &iq[1], &iparam[1], &rparam[1], &iwork[1], &rwork[1], &rwork[*n 
	    + 1], &rwork[(*n << 1) + 1], &rwork[*n * 3 + 1], &rwork[*n * 3 + 
	    kmax + 2], &rwork[*n * 3 + (kmax << 1) + 3], ierror);
    goto L99;

L18:
    dpcgne_((U_fp)matvec, (U_fp)pcondl, &a[1], &ia[1], &x[1], &b[1], n, &q[1],
	     &iq[1], &iparam[1], &rparam[1], &iwork[1], &rwork[1], &rwork[*n 
	    + 1], &rwork[(*n << 1) + 1], &rwork[*n * 3 + 1], &rwork[*n * 3 + 
	    kmax + 2], &rwork[*n * 3 + (kmax << 1) + 3], ierror);
    goto L99;

L19:
    dppcg_((U_fp)matvec, (U_fp)pcondl, &a[1], &ia[1], &x[1], &b[1], n, &q[1], 
	    &iq[1], &iparam[1], &rparam[1], &iwork[1], &rwork[1], &rwork[*n + 
	    1], &rwork[(*n << 1) + 1], &rwork[*n * 3 + 1], &rwork[(*n << 2) + 
	    1], &rwork[*n * 5 + 1], &rwork[*n * 6 + 1], &rwork[*n * 6 + kmax 
	    + 2], ierror);
    goto L99;

L20:
    dpcgca_((U_fp)matvec, (U_fp)pcondl, &a[1], &ia[1], &x[1], &b[1], n, &q[1],
	     &iq[1], &iparam[1], &rparam[1], &iwork[1], &rwork[1], &rwork[*n 
	    + 1], &rwork[(*n << 1) + 1], &rwork[*n * 3 + 1], &rwork[(*n << 2) 
	    + 1], &rwork[*n * 5 + 1], &rwork[*n * 6 + 1], &rwork[*n * 6 + 
	    kmax + 2], ierror);

/*     *** RETURN *** */
L99:

    return 0;
} /* dcgdrv_ */