/* keysrc.f -- translated by f2c (version of 3 February 1990  3:36:42).
   You must link the resulting object file with the libraries:
	-lF77 -lI77 -lm -lc   (in that order)
*/

#include "f2c.h"

/* Table of constant values */

static integer c__8 = 8;
static integer c__1 = 1;

/*<       subroutine keysrc(keytab,lentab,tstwrd,index) >*/
/* Subroutine */ int keysrc_(keytab, lentab, tstwrd, index)
doublereal *keytab;
integer *lentab;
doublereal *tstwrd;
integer *index;
{
    /* Initialized data */

    static struct {
	char e_1[8];
	doublereal e_2;
	} equiv_7 = { {' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };

#define ablnk (*(doublereal *)&equiv_7)


    static doublereal akey;
    extern /* Subroutine */ int move_();
    extern integer xxor_();
    static integer i;
    static doublereal achar;
    static integer lenwrd;
    static doublereal tstchr;

    /* Parameter adjustments */
    --keytab;

    /* Function Body */
/*<       implicit double precision (a-h,o-z) >*/
/*<       double precision keytab >*/

/*     this routine searches the keyword table 'keytab' for the possible 
*/
/* entry 'tstwrd'.  abbreviations are considered as matches. */

/*<       dimension keytab(lentab) >*/
/*<       integer xxor >*/
/*<       data ablnk / 1h  / >*/


/*<       index=0 >*/
    *index = 0;
/*<       lenwrd=0 >*/
    lenwrd = 0;
/*<       achar=ablnk >*/
    achar = ablnk;
/*<       do 10 i=1,8 >*/
    for (i = 1; i <= 8; ++i) {
/*<       call move(achar,8,tstwrd,i,1) >*/
	move_(&achar, &c__8, tstwrd, &i, &c__1);
/*<       if (achar.eq.ablnk) go to 20 >*/
	if (achar == ablnk) {
	    goto L20;
	}
/*<       lenwrd=lenwrd+1 >*/
	++lenwrd;
/*<    10 continue >*/
/* L10: */
    }

/*<    20 if (lenwrd.eq.0) go to 40 >*/
L20:
    if (lenwrd == 0) {
	goto L40;
    }
/*<       tstchr=ablnk >*/
    tstchr = ablnk;
/*<       call move(tstchr,8,tstwrd,1,1) >*/
    move_(&tstchr, &c__8, tstwrd, &c__1, &c__1);
/*<    30 index=index+1 >*/
L30:
    ++(*index);
/*<       if (index.gt.lentab) go to 40 >*/
    if (*index > *lentab) {
	goto L40;
    }
/*<       akey=ablnk >*/
    akey = ablnk;
/*<       call move(akey,1,keytab(index),1,lenwrd) >*/
    move_(&akey, &c__1, &keytab[*index], &c__1, &lenwrd);
/*<       if (xxor(akey,tstwrd).eq.0) go to 50 >*/
    if (xxor_(&akey, tstwrd) == 0) {
	goto L50;
    }
/*<       go to 30 >*/
    goto L30;

/*<    40 index=-1 >*/
L40:
    *index = -1;
/*<    50 return >*/
L50:
    return 0;
/*<       end >*/
} /* keysrc_ */

#undef ablnk


