/* alarqg.f -- translated by f2c (version 20061008).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"
#include "blaswrap.h"

/* Table of constant values */

static integer c__1 = 1;

/* Subroutine */ int alarqg_(char *path, integer *nmats, logical *dotype, 
	integer *ntypes, integer *nin, integer *nout)
{
    /* Initialized data */

    static char intstr[10] = "0123456789";

    /* Format strings */
    static char fmt_9995[] = "(//\002 *** Not enough matrix types on input l"
	    "ine\002,/a79)";
    static char fmt_9994[] = "(\002 ==> Specify \002,i4,\002 matrix types on"
	    " this line or \002,\002adjust NTYPES on previous line\002)";
    static char fmt_9996[] = "(//\002 *** Invalid integer value in column"
	    " \002,i2,\002 of input\002,\002 line:\002,/a79)";
    static char fmt_9997[] = "(\002 *** Warning:  duplicate request of matri"
	    "x type \002,i2,\002 for \002,a3)";
    static char fmt_9999[] = "(\002 *** Invalid type request for \002,a3,"
	    "\002, type  \002,i4,\002: must satisfy  1 <= type <= \002,i2)";
    static char fmt_9998[] = "(/\002 *** End of file reached when trying to "
	    "read matrix \002,\002types for \002,a3,/\002 *** Check that you "
	    "are requesting the\002,\002 right number of types for each pat"
	    "h\002,/)";

    /* System generated locals */
    integer i__1;
    cilist ci__1;

    /* Builtin functions */
    integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void),
	     i_len(char *, ftnlen), s_wsfe(cilist *), e_wsfe(void), s_wsle(
	    cilist *), e_wsle(void);
    /* Subroutine */ int s_stop(char *, ftnlen);

    /* Local variables */
    integer i__, j, k;
    char c1[1];
    integer i1, ic, nt;
    char line[80];
    integer lenp, nreq[100];
    logical firstt;

    /* Fortran I/O blocks */
    static cilist io___9 = { 0, 0, 0, fmt_9995, 0 };
    static cilist io___10 = { 0, 0, 0, fmt_9994, 0 };
    static cilist io___14 = { 0, 0, 0, fmt_9996, 0 };
    static cilist io___15 = { 0, 0, 0, fmt_9994, 0 };
    static cilist io___17 = { 0, 0, 0, 0, 0 };
    static cilist io___18 = { 0, 0, 0, fmt_9997, 0 };
    static cilist io___19 = { 0, 0, 0, fmt_9999, 0 };
    static cilist io___20 = { 0, 0, 0, fmt_9998, 0 };
    static cilist io___21 = { 0, 0, 0, 0, 0 };



/*  -- LAPACK test routine (version 3.1) -- */
/*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/*     November 2006 */

/*     .. Scalar Arguments .. */
/*     .. */
/*     .. Array Arguments .. */
/*     .. */

/*  Purpose */
/*  ======= */

/*  ALARQG handles input for the LAPACK test program.  It is called */
/*  to evaluate the input line which requested NMATS matrix types for */
/*  PATH.  The flow of control is as follows: */

/*  If NMATS = NTYPES then */
/*     DOTYPE(1:NTYPES) = .TRUE. */
/*  else */
/*     Read the next input line for NMATS matrix types */
/*     Set DOTYPE(I) = .TRUE. for each valid type I */
/*  endif */

/*  Arguments */
/*  ========= */

/*  PATH    (input) CHARACTER*3 */
/*          An LAPACK path name for testing. */

/*  NMATS   (input) INTEGER */
/*          The number of matrix types to be used in testing this path. */

/*  DOTYPE  (output) LOGICAL array, dimension (NTYPES) */
/*          The vector of flags indicating if each type will be tested. */

/*  NTYPES  (input) INTEGER */
/*          The maximum number of matrix types for this path. */

/*  NIN     (input) INTEGER */
/*          The unit number for input.  NIN >= 1. */

/*  NOUT    (input) INTEGER */
/*          The unit number for output.  NOUT >= 1. */

/* ====================================================================== */

/*     .. Local Scalars .. */
/*     .. */
/*     .. Local Arrays .. */
/*     .. */
/*     .. Intrinsic Functions .. */
/*     .. */
/*     .. Data statements .. */
    /* Parameter adjustments */
    --dotype;

    /* Function Body */
/*     .. */
/*     .. Executable Statements .. */

    if (*nmats >= *ntypes) {

/*        Test everything if NMATS >= NTYPES. */

	i__1 = *ntypes;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    dotype[i__] = TRUE_;
/* L10: */
	}
    } else {
	i__1 = *ntypes;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    dotype[i__] = FALSE_;
/* L20: */
	}
	firstt = TRUE_;

/*        Read a line of matrix types if 0 < NMATS < NTYPES. */

	if (*nmats > 0) {
	    ci__1.cierr = 0;
	    ci__1.ciend = 1;
	    ci__1.ciunit = *nin;
	    ci__1.cifmt = "(A80)";
	    i__1 = s_rsfe(&ci__1);
	    if (i__1 != 0) {
		goto L90;
	    }
	    i__1 = do_fio(&c__1, line, (ftnlen)80);
	    if (i__1 != 0) {
		goto L90;
	    }
	    i__1 = e_rsfe();
	    if (i__1 != 0) {
		goto L90;
	    }
	    lenp = i_len(line, (ftnlen)80);
	    i__ = 0;
	    i__1 = *nmats;
	    for (j = 1; j <= i__1; ++j) {
		nreq[j - 1] = 0;
		i1 = 0;
L30:
		++i__;
		if (i__ > lenp) {
		    if (j == *nmats && i1 > 0) {
			goto L60;
		    } else {
			io___9.ciunit = *nout;
			s_wsfe(&io___9);
			do_fio(&c__1, line, (ftnlen)80);
			e_wsfe();
			io___10.ciunit = *nout;
			s_wsfe(&io___10);
			do_fio(&c__1, (char *)&(*nmats), (ftnlen)sizeof(
				integer));
			e_wsfe();
			goto L80;
		    }
		}
		if (*(unsigned char *)&line[i__ - 1] != ' ' && *(unsigned 
			char *)&line[i__ - 1] != ',') {
		    i1 = i__;
		    *(unsigned char *)c1 = *(unsigned char *)&line[i1 - 1];

/*              Check that a valid integer was read */

		    for (k = 1; k <= 10; ++k) {
			if (*(unsigned char *)c1 == *(unsigned char *)&intstr[
				k - 1]) {
			    ic = k - 1;
			    goto L50;
			}
/* L40: */
		    }
		    io___14.ciunit = *nout;
		    s_wsfe(&io___14);
		    do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
		    do_fio(&c__1, line, (ftnlen)80);
		    e_wsfe();
		    io___15.ciunit = *nout;
		    s_wsfe(&io___15);
		    do_fio(&c__1, (char *)&(*nmats), (ftnlen)sizeof(integer));
		    e_wsfe();
		    goto L80;
L50:
		    nreq[j - 1] = nreq[j - 1] * 10 + ic;
		    goto L30;
		} else if (i1 > 0) {
		    goto L60;
		} else {
		    goto L30;
		}
L60:
		;
	    }
	}
	i__1 = *nmats;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    nt = nreq[i__ - 1];
	    if (nt > 0 && nt <= *ntypes) {
		if (dotype[nt]) {
		    if (firstt) {
			io___17.ciunit = *nout;
			s_wsle(&io___17);
			e_wsle();
		    }
		    firstt = FALSE_;
		    io___18.ciunit = *nout;
		    s_wsfe(&io___18);
		    do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
		    do_fio(&c__1, path, (ftnlen)3);
		    e_wsfe();
		}
		dotype[nt] = TRUE_;
	    } else {
		io___19.ciunit = *nout;
		s_wsfe(&io___19);
		do_fio(&c__1, path, (ftnlen)3);
		do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
		do_fio(&c__1, (char *)&(*ntypes), (ftnlen)sizeof(integer));
		e_wsfe();
	    }
/* L70: */
	}
L80:
	;
    }
    return 0;

L90:
    io___20.ciunit = *nout;
    s_wsfe(&io___20);
    do_fio(&c__1, path, (ftnlen)3);
    e_wsfe();
    io___21.ciunit = *nout;
    s_wsle(&io___21);
    e_wsle();
    s_stop("", (ftnlen)0);

/*     End of ALARQG */

    return 0;
} /* alarqg_ */
