/* datin.f -- translated by f2c (version 19950314).
   You must link the resulting object file with the libraries:
	-lF77 -lI77 -lm   (in that order)
*/

#include "f2c.h"

/* Common Block Declarations */

struct {
    char argz[512];
} argz_;

#define argz_1 argz_

struct {
    doublereal atheat;
} atheat_;

#define atheat_1 atheat_

struct {
    integer numat, nat[86], nfirst[86], nmidle[86], nlast[86], norbs, nelecs, 
	    nalpha, nbeta, nclose, nopen, ndumy;
    doublereal fract;
} molkst_;

#define molkst_1 molkst_

struct {
    doublereal eisol[107], eheat[107];
} atomic_;

#define atomic_1 atomic_

struct {
    char keywrd[80];
} keywrd_;

#define keywrd_1 keywrd_

/* Table of constant values */

static integer c__1 = 1;
static integer c__2 = 2;
static integer c__3 = 3;
static integer c__9 = 9;

/* Subroutine */ int am1_(void)
{
    /* Initialized data */

    static char numbrs[1*10] = " " "1" "2" "3" "4" "5" "6" "7" "8" "9";
    static char partyp[5*25] = "USS  " "UPP  " "UDD  " "ZS   " "ZP   " "ZD   "
	     "BETAS" "BETAP" "BETAD" "GSS  " "GSP  " "GPP  " "GP2  " "HSP  " 
	    "AM1  " "EXPC " "GAUSS" "ALP  " "GSD  " "GPD  " "GDD  " "FN1  " 
	    "FN2  " "FN3  " "ORB  ";
    static char elemnt[2*107] = "H " "HE" "LI" "BE" "B " "C " "N " "O " "F " 
	    "NE" "NA" "MG" "AL" "SI" "P " "S " "CL" "AR" "K " "CA" "SC" "TI" 
	    "V " "CR" "MN" "FE" "CO" "NI" "CU" "ZN" "GA" "GE" "AS" "SE" "BR" 
	    "KR" "RB" "SR" "Y " "ZR" "NB" "MO" "TC" "RU" "RH" "PD" "AG" "CD" 
	    "IN" "SN" "SB" "TE" "I " "XE" "CS" "BA" "LA" "CE" "PR" "ND" "PM" 
	    "SM" "EU" "GD" "TB" "DY" "HO" "ER" "TM" "YB" "LU" "HF" "TA" "W " 
	    "RE" "OS" "IR" "PT" "AU" "HG" "TL" "PB" "BI" "PO" "AT" "RN" "FR" 
	    "RA" "AC" "TH" "PA" "U " "NP" "PU" "AM" "CM" "BK" "CF" "XX" "FM" 
	    "MD" "CB" "++" "+ " "--" "- " "TV";

    /* System generated locals */
    address a__1[2], a__2[3];
    integer i__1, i__2[2], i__3[3];
    char ch__1[3], ch__2[66], ch__3[6];
    olist o__1;
    cllist cl__1;

    /* Builtin functions */
    integer i_indx(char *, char *, ftnlen, ftnlen);
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer s_wsfe(cilist *), e_wsfe(void), f_open(olist *), s_rsfe(cilist *),
	     do_fio(integer *, char *, ftnlen), e_rsfe(void), s_cmp(char *, 
	    char *, ftnlen, ftnlen);
    /* Subroutine */ int s_stop(char *, ftnlen), s_cat(char *, char **, 
	    integer *, integer *, ftnlen);
    integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), 
	    e_wsle(void), f_clos(cllist *);

    /* Local variables */
    static char text[50];
    static integer i, j, k;
    extern doublereal reada_(char *, integer *, ftnlen);
    static integer icapa, iline;
    static doublereal param;
    static char files[64];
    static integer ilowa, lpars;
    static char dummy[50];
    static integer ilowz, ni, it;
    extern /* Subroutine */ int calpar_(void);
    static integer iparam;
    extern /* Subroutine */ int moldat_(void), update_(integer *, integer *, 
	    doublereal *, integer *, integer *);
    static integer ijpars[2500]	/* was [5][500] */;
    static doublereal parsij[500];
    static integer ielmnt;
    static char txtnew[50];
    static integer kfn;
    static doublereal eth;
    static integer ios;

    /* Fortran I/O blocks */
    static cilist io___7 = { 0, 6, 0, "(//5X,' PARAMETER TYPE      ELEMENT  "
	    "  PARAMETER')", 0 };
    static cilist io___9 = { 1, 14, 1, "(A40)", 0 };
    static cilist io___17 = { 0, 6, 0, "('  FAULTY LINE:',A)", 0 };
    static cilist io___18 = { 0, 6, 0, "('  FAULTY LINE:',A)", 0 };
    static cilist io___19 = { 0, 6, 0, "('   NAME NOT FOUND')", 0 };
    static cilist io___24 = { 0, 6, 0, "(' ELEMENT NOT FOUND ')", 0 };
    static cilist io___25 = { 0, 6, 0, 0, 0 };
    static cilist io___31 = { 0, 6, 0, "(10X,A6,11X,A2,F17.6)", 0 };
    static cilist io___32 = { 0, 6, 0, "(10X,A6,11X,A2,F17.6)", 0 };


/* COMDECK SIZES */
/************************************************************************
****/
/*  THIS FILE CONTAINS ALL THE ARRAY SIZES FOR USE IN MOPAC.              
**/
/*                                                                        
**/
/*    THERE ARE ONLY  PARAMETERS THAT THE PROGRAMMER NEED SET:            
**/
/*    MAXHEV = MAXIMUM NUMBER OF HEAVY ATOMS (HEAVY: NON-HYDROGEN ATOMS)  
**/
/*    MAXLIT = MAXIMUM NUMBER OF HYDROGEN ATOMS.                          
**/
/*    MAXTIM = DEFAULT TIME FOR A JOB. (SECONDS)                          
**/
/*    MAXDMP = DEFAULT TIME FOR AUTOMATIC RESTART FILE GENERATION (SECS)  
**/
/*                                                                        
**/
/*                                                                        
**/
/************************************************************************
****/
/*                                                                        
**/
/*  THE FOLLOWING CODE DOES NOT NEED TO BE ALTERED BY THE PROGRAMMER      
**/
/*                                                                        
**/
/************************************************************************
****/
/*                                                                        
**/
/*   ALL OTHER PARAMETERS ARE DERIVED FUNCTIONS OF THESE TWO PARAMETERS   
**/
/*                                                                        
**/
/*     NAME                   DEFINITION                                  
**/
/*    NUMATM         MAXIMUM NUMBER OF ATOMS ALLOWED.                     
**/
/*    MAXORB         MAXIMUM NUMBER OF ORBITALS ALLOWED.                  
**/
/*    MAXPAR         MAXIMUM NUMBER OF PARAMETERS FOR OPTIMISATION.       
**/
/*    N2ELEC         MAXIMUM NUMBER OF TWO ELECTRON INTEGRALS ALLOWED.    
**/
/*    MPACK          AREA OF LOWER HALF TRIANGLE OF DENSITY MATRIX.       
**/
/*    MORB2          SQUARE OF THE MAXIMUM NUMBER OF ORBITALS ALLOWED.    
**/
/*    MAXHES         AREA OF HESSIAN MATRIX                               
**/
/************************************************************************
****/
/************************************************************************
****/
/*  FOR SHORT VERSION USE LINE WITH NMECI=1, FOR LONG VERSION USE LINE    
**/
/*  WITH NMECI=10                                                         
**/
/************************************************************************
****/
/*     PARAMETER (NMECI=1,   NPULAY=1) */
/************************************************************************
****/
/* DECK MOPAC */
/* next line added for Unix implementation for command line arguments */

    i = i_indx(keywrd_1.keywrd, "EXTERNAL=", 80L, 9L) + 9;
    j = i_indx(keywrd_1.keywrd + (i - 1), " ", 80 - (i - 1), 1L) + i - 1;
    s_copy(files, keywrd_1.keywrd + (i - 1), 64L, j - (i - 1));
    s_wsfe(&io___7);
    e_wsfe();
    o__1.oerr = 0;
    o__1.ounit = 14;
    o__1.ofnmlen = 64;
    o__1.ofnm = files;
    o__1.orl = 0;
    o__1.osta = "OLD";
    o__1.oacc = 0;
    o__1.ofm = 0;
    o__1.oblnk = 0;
    f_open(&o__1);
    i = 0;
L10:
    ios = s_rsfe(&io___9);
    if (ios != 0) {
	goto L100001;
    }
    ios = do_fio(&c__1, text, 50L);
    if (ios != 0) {
	goto L100001;
    }
    ios = e_rsfe();
L100001:
    if (ios > 0) {
	goto L90;
    }
    if (s_cmp(text, " ", 50L, 1L) == 0) {
	goto L90;
    }
    if (i_indx(text, "END", 50L, 3L) != 0) {
	goto L90;
    }
    ilowa = 'a';
    ilowz = 'z';
    icapa = 'A';
/* ***********************************************************************
 */
    for (i = 1; i <= 50; ++i) {
	iline = *(unsigned char *)&text[i - 1];
	if (iline >= ilowa && iline <= ilowz) {
	    *(unsigned char *)&text[i - 1] = (char) (iline + icapa - ilowa);
	}
/* L20: */
    }
/* ***********************************************************************
 */
    if (i_indx(text, "END", 50L, 3L) != 0) {
	goto L90;
    }
    for (j = 1; j <= 25; ++j) {
	if (j > 21) {
	    it = i_indx(text, "FN", 50L, 2L);
	    s_copy(txtnew, text, 50L, it + 2);
	    if (i_indx(txtnew, partyp + (j - 1) * 5, 50L, 5L) != 0) {
		goto L40;
	    }
	}
	if (i_indx(text, partyp + (j - 1) * 5, 50L, 5L) != 0) {
	    goto L40;
	}
/* L30: */
    }
    s_wsfe(&io___17);
    do_fio(&c__1, txtnew, 50L);
    e_wsfe();
    s_wsfe(&io___18);
    do_fio(&c__1, text, 50L);
    e_wsfe();
    s_wsfe(&io___19);
    e_wsfe();
    s_stop("", 0L);
L40:
    iparam = j;
    if (iparam > 21) {
	i = i_indx(text, "FN", 50L, 2L);
	i__1 = i + 3;
	kfn = (integer) reada_(text, &i__1, 50L);
    } else {
	kfn = 0;
	i = i_indx(text, partyp + (j - 1) * 5, 50L, 5L);
    }
    k = i_indx(text + (i - 1), " ", 50 - (i - 1), 1L) + 1;
    s_copy(dummy, text + (k - 1), 50L, 50 - (k - 1));
    s_copy(text, dummy, 50L, 50L);
    for (j = 1; j <= 107; ++j) {
/* L50: */
/* Writing concatenation */
	i__2[0] = 1, a__1[0] = " ";
	i__2[1] = 2, a__1[1] = elemnt + (j - 1 << 1);
	s_cat(ch__1, a__1, i__2, &c__2, 3L);
	if (i_indx(text, ch__1, 50L, 3L) != 0) {
	    goto L60;
	}
    }
    s_wsfe(&io___24);
    e_wsfe();
    s_wsle(&io___25);
/* Writing concatenation */
    i__3[0] = 15, a__2[0] = " FAULTY LINE: \"";
    i__3[1] = 50, a__2[1] = text;
    i__3[2] = 1, a__2[2] = "\"";
    s_cat(ch__2, a__2, i__3, &c__3, 66L);
    do_lio(&c__9, &c__1, ch__2, 66L);
    e_wsle();
    s_stop("", 0L);
L60:
    ielmnt = j;
    i__1 = i_indx(text, elemnt + (j - 1 << 1), 50L, 2L);
    param = reada_(text, &i__1, 50L);
    i__1 = lpars;
    for (i = 1; i <= i__1; ++i) {
	if (ijpars[i * 5 - 5] == kfn && ijpars[i * 5 - 4] == ielmnt && ijpars[
		i * 5 - 3] == iparam) {
	    goto L80;
	}
/* L70: */
    }
    ++lpars;
    i = lpars;
L80:
    ijpars[i * 5 - 5] = kfn;
    ijpars[i * 5 - 4] = ielmnt;
    ijpars[i * 5 - 3] = iparam;
    parsij[i - 1] = param;
    goto L10;
L90:
    cl__1.cerr = 0;
    cl__1.cunit = 14;
    cl__1.csta = 0;
    f_clos(&cl__1);
    for (j = 1; j <= 107; ++j) {
	for (k = 1; k <= 25; ++k) {
	    i__1 = lpars;
	    for (i = 1; i <= i__1; ++i) {
		iparam = ijpars[i * 5 - 3];
		kfn = ijpars[i * 5 - 5];
		ielmnt = ijpars[i * 5 - 4];
		if (iparam != k) {
		    goto L100;
		}
		if (ielmnt != j) {
		    goto L100;
		}
		param = parsij[i - 1];
		if (kfn != 0) {
		    s_wsfe(&io___31);
/* Writing concatenation */
		    i__3[0] = 3, a__2[0] = partyp + (iparam - 1) * 5;
		    i__3[1] = 1, a__2[1] = numbrs + kfn;
		    i__3[2] = 2, a__2[2] = "  ";
		    s_cat(ch__3, a__2, i__3, &c__3, 6L);
		    do_fio(&c__1, ch__3, 6L);
		    do_fio(&c__1, elemnt + (ielmnt - 1 << 1), 2L);
		    do_fio(&c__1, (char *)&param, (ftnlen)sizeof(doublereal));
		    e_wsfe();
		} else {
		    s_wsfe(&io___32);
/* Writing concatenation */
		    i__2[0] = 5, a__1[0] = partyp + (iparam - 1) * 5;
		    i__2[1] = 1, a__1[1] = numbrs + kfn;
		    s_cat(ch__3, a__1, i__2, &c__2, 6L);
		    do_fio(&c__1, ch__3, 6L);
		    do_fio(&c__1, elemnt + (ielmnt - 1 << 1), 2L);
		    do_fio(&c__1, (char *)&param, (ftnlen)sizeof(doublereal));
		    e_wsfe();
		}
		update_(&iparam, &ielmnt, &param, &c__1, &kfn);
L100:
		;
	    }
/* L110: */
	}
/* L120: */
    }
    moldat_();
    calpar_();
    atheat_1.atheat = 0.;
    eth = 0.;
    i__1 = molkst_1.numat;
    for (i = 1; i <= i__1; ++i) {
	ni = molkst_1.nat[i - 1];
	atheat_1.atheat += atomic_1.eheat[ni - 1];
/* L130: */
	eth += atomic_1.eisol[ni - 1];
    }
    atheat_1.atheat -= eth * 23.061;
    return 0;
} /* am1_ */

