/* Subroutine */ int deriv_(doublereal *geo, doublereal *grad)
{
/* Initialized data */
static integer icalcn = 0;
/* System generated locals */
integer i__1, i__2, i__3, i__4;
doublereal d__1, d__2;
char ch__1[80];
olist o__1;
alist al__1;
/* Builtin functions */
integer i_indx(char *, char *, ftnlen, ftnlen), f_open(olist *), f_rew(
alist *), s_rsfe(cilist *), do_fio(integer *, char *, ftnlen),
e_rsfe(void), s_wsfe(cilist *), e_wsfe(void);
/* Subroutine */ int s_stop(char *, ftnlen);
integer s_rsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_rsle(void);
double pow_di(doublereal *, integer *), sqrt(doublereal);
integer s_wsle(cilist *), e_wsle(void);
/* Local variables */
static integer i__, j;
static logical ci;
static integer ii, ij, il, jl, kl, ll, kk;
static logical aic;
extern doublereal dot_(doublereal *, doublereal *, integer *);
static logical int__;
extern /* Subroutine */ int mxm_(doublereal *, integer *, doublereal *,
integer *, doublereal *, integer *);
static doublereal sum;
static logical scf1;
static char line[80];
static integer ncol;
static doublereal xjuc[3], step;
static logical slow;
static integer icapa;
static logical halfe, debug;
extern /* Subroutine */ int dcart_(doublereal *, doublereal *);
static integer iline;
static logical geook;
static doublereal grlim;
static integer ilowa;
static doublereal gnorm;
extern /* Subroutine */ int geout_(integer *);
static integer ilowz;
static doublereal change[3], aidref[360];
static integer idelta;
extern /* Character */ VOID getnam_(char *, ftnlen, char *, ftnlen);
static logical precis, noanci, aifrst;
extern /* Subroutine */ int dernvo_(doublereal *, doublereal *), jcarin_(
doublereal *, doublereal *, doublereal *, logical *, doublereal *,
integer *), gmetry_(doublereal *, doublereal *), deritr_(
doublereal *, doublereal *), symtry_(void);
/* Fortran I/O blocks */
static cilist io___14 = { 0, 5, 0, "(A)", 0 };
static cilist io___17 = { 1, 5, 1, "(A)", 0 };
static cilist io___19 = { 0, 6, 0, "(//,A)", 0 };
static cilist io___20 = { 0, 6, 0, "(A)", 0 };
static cilist io___21 = { 0, 6, 0, "(//,A)", 0 };
static cilist io___22 = { 0, 6, 0, "(A)", 0 };
static cilist io___23 = { 0, 6, 0, "(6F12.6)", 0 };
static cilist io___25 = { 1, 5, 1, 0, 0 };
static cilist io___26 = { 0, 6, 0, "(/,A,/)", 0 };
static cilist io___27 = { 0, 6, 0, "(5F12.6)", 0 };
static cilist io___28 = { 0, 6, 0, "(/,A,/)", 0 };
static cilist io___29 = { 0, 6, 0, "(5F12.6)", 0 };
static cilist io___31 = { 0, 6, 0, "(/,A,/)", 0 };
static cilist io___32 = { 0, 6, 0, "(5F12.6)", 0 };
static cilist io___37 = { 0, 6, 0, "(' GEO AT START OF DERIV')", 0 };
static cilist io___38 = { 0, 6, 0, "(F19.5,2F12.5)", 0 };
static cilist io___42 = { 0, 6, 0, 0, 0 };
static cilist io___43 = { 0, 6, 0, 0, 0 };
static cilist io___54 = { 0, 6, 0, "(//,3(A,/),I3,A)", 0 };
static cilist io___55 = { 0, 6, 0, "(//,A)", 0 };
static cilist io___56 = { 0, 6, 0, 0, 0 };
static cilist io___57 = { 0, 6, 0, "(' GRADIENTS')", 0 };
static cilist io___58 = { 0, 6, 0, "(10F8.3)", 0 };
static cilist io___59 = { 0, 6, 0, "(' ERROR FUNCTION')", 0 };
static cilist io___60 = { 0, 6, 0, "(10F8.3)", 0 };
static cilist io___61 = { 0, 6, 0, "(' COSINE OF SEARCH DIRECTION =',F30"
".6)", 0 };
/* COMDECK SIZES */
/* *********************************************************************** */
/* THIS FILE CONTAINS ALL THE ARRAY SIZES FOR USE IN MOPAC. */
/* THERE ARE ONLY 5 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) */
/* ISYBYL = 1 IF MOPAC IS TO BE USED IN THE SYBYL PACKAGE, =0 OTHERWISE */
/* SEE ALSO NMECI, NPULAY AND MESP AT THE END OF THIS FILE */
/* *********************************************************************** */
/* 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 */
/* MAXALL LARGER THAN MAXORB OR MAXPAR. */
/* *********************************************************************** */
/* *********************************************************************** */
/* DECK MOPAC */
/* *********************************************************************** */
/* DERIV CALCULATES THE DERIVATIVES OF THE ENERGY WITH RESPECT TO THE */
/* INTERNAL COORDINATES. THIS IS DONE BY FINITE DIFFERENCES. */
/* THE MAIN ARRAYS IN DERIV ARE: */
/* LOC INTEGER ARRAY, LOC(1,I) CONTAINS THE ADDRESS OF THE ATOM */
/* INTERNAL COORDINATE LOC(2,I) IS TO BE USED IN THE */
/* DERIVATIVE CALCULATION. */
/* GEO ARRAY \GEO\ HOLDS THE INTERNAL COORDINATES. */
/* GRAD ON EXIT, CONTAINS THE DERIVATIVES */
/* *********************************************************************** */
/* Parameter adjustments */
--grad;
geo -= 4;
/* Function Body */
if (icalcn != numcal_1.numcal) {
aifrst = i_indx(keywrd_1.keywrd, "RESTART", (ftnlen)241, (ftnlen)7) ==
0;
debug = i_indx(keywrd_1.keywrd, "DERIV", (ftnlen)241, (ftnlen)5) != 0;
precis = i_indx(keywrd_1.keywrd, "PREC", (ftnlen)241, (ftnlen)4) != 0;
int__ = i_indx(keywrd_1.keywrd, " XYZ", (ftnlen)241, (ftnlen)4) == 0;
geook = i_indx(keywrd_1.keywrd, "GEO-OK", (ftnlen)241, (ftnlen)6) !=
0;
ci = i_indx(keywrd_1.keywrd, "C.I.", (ftnlen)241, (ftnlen)4) != 0;
scf1 = i_indx(keywrd_1.keywrd, "1SCF", (ftnlen)241, (ftnlen)4) != 0;
aic = i_indx(keywrd_1.keywrd, "AIDER", (ftnlen)241, (ftnlen)5) != 0;
icapa = 'A';
ilowa = 'a';
ilowz = 'z';
if (aic && aifrst) {
o__1.oerr = 0;
o__1.ounit = 5;
o__1.ofnmlen = 80;
getnam_(ch__1, (ftnlen)80, "FOR005", (ftnlen)6);
o__1.ofnm = ch__1;
o__1.orl = 0;
o__1.osta = "OLD";
o__1.oacc = 0;
o__1.ofm = 0;
o__1.oblnk = "ZERO";
f_open(&o__1);
al__1.aerr = 0;
al__1.aunit = 5;
f_rew(&al__1);
/* ISOK IS SET FALSE: ONLY ONE SYSTEM ALLOWED */
okmany_1.isok = FALSE_;
for (i__ = 1; i__ <= 3; ++i__) {
/* L10: */
s_rsfe(&io___14);
do_fio(&c__1, line, (ftnlen)80);
e_rsfe();
}
for (j = 1; j <= 1000; ++j) {
i__1 = s_rsfe(&io___17);
if (i__1 != 0) {
goto L40;
}
i__1 = do_fio(&c__1, line, (ftnlen)80);
if (i__1 != 0) {
goto L40;
}
i__1 = e_rsfe();
if (i__1 != 0) {
goto L40;
}
/* *********************************************************************** */
for (i__ = 1; i__ <= 80; ++i__) {
iline = *(unsigned char *)&line[i__ - 1];
if (iline >= ilowa && iline <= ilowz) {
*(unsigned char *)&line[i__ - 1] = (char) (iline +
icapa - ilowa);
}
/* L20: */
}
/* *********************************************************************** */
/* L30: */
if (i_indx(line, "AIDER", (ftnlen)80, (ftnlen)5) != 0) {
goto L60;
}
}
L40:
s_wsfe(&io___19);
do_fio(&c__1, " KEYWORD \"AIDER\" SPECIFIED, BUT NOT", (ftnlen)35)
;
e_wsfe();
s_wsfe(&io___20);
do_fio(&c__1, " PRESENT AFTER Z-MATRIX. JOB STOPPED", (ftnlen)37)
;
e_wsfe();
s_stop("", (ftnlen)0);
L50:
s_wsfe(&io___21);
do_fio(&c__1, " FAULT IN READ OF AB INITIO DERIVATIVES", (ftnlen)
40);
e_wsfe();
s_wsfe(&io___22);
do_fio(&c__1, " DERIVATIVES READ IN ARE AS FOLLOWS", (ftnlen)36);
e_wsfe();
s_wsfe(&io___23);
i__1 = i__;
for (j = 1; j <= i__1; ++j) {
do_fio(&c__1, (char *)&aidref[j - 1], (ftnlen)sizeof(
doublereal));
}
e_wsfe();
s_stop("", (ftnlen)0);
L60:
if (geokst_1.natoms > 2) {
j = geokst_1.natoms * 3 - 6;
} else {
j = 1;
}
i__1 = s_rsle(&io___25);
if (i__1 != 0) {
goto L50;
}
i__2 = j;
for (i__ = 1; i__ <= i__2; ++i__) {
i__1 = do_lio(&c__5, &c__1, (char *)&aidref[i__ - 1], (ftnlen)
sizeof(doublereal));
if (i__1 != 0) {
goto L50;
}
}
i__1 = e_rsle();
if (i__1 != 0) {
goto L50;
}
s_wsfe(&io___26);
do_fio(&c__1, " AB-INITIO DERIVATIVES IN KCAL/MOL/(ANGSTROM OR R"
"ADIAN)", (ftnlen)55);
e_wsfe();
s_wsfe(&io___27);
i__1 = j;
for (i__ = 1; i__ <= i__1; ++i__) {
do_fio(&c__1, (char *)&aidref[i__ - 1], (ftnlen)sizeof(
doublereal));
}
e_wsfe();
i__1 = geovar_1.nvar;
for (i__ = 1; i__ <= i__1; ++i__) {
if (geovar_1.loc[(i__ << 1) - 2] > 3) {
j = geovar_1.loc[(i__ << 1) - 2] * 3 + geovar_1.loc[(i__
<< 1) - 1] - 9;
} else if (geovar_1.loc[(i__ << 1) - 2] == 3) {
j = geovar_1.loc[(i__ << 1) - 1] + 1;
} else {
j = 1;
}
/* L70: */
aidref[i__ - 1] = aidref[j - 1];
}
s_wsfe(&io___28);
do_fio(&c__1, " AB-INITIO DERIVATIVES FOR VARIABLES", (ftnlen)36);
e_wsfe();
s_wsfe(&io___29);
i__1 = geovar_1.nvar;
for (i__ = 1; i__ <= i__1; ++i__) {
do_fio(&c__1, (char *)&aidref[i__ - 1], (ftnlen)sizeof(
doublereal));
}
e_wsfe();
if (geosym_1.ndep != 0) {
i__1 = geovar_1.nvar;
for (i__ = 1; i__ <= i__1; ++i__) {
sum = aidref[i__ - 1];
i__2 = geosym_1.ndep;
for (j = 1; j <= i__2; ++j) {
if (geovar_1.loc[(i__ << 1) - 2] == geosym_1.locpar[j
- 1] && (geovar_1.loc[(i__ << 1) - 1] ==
geosym_1.idepfn[j - 1] || geovar_1.loc[(i__ <<
1) - 1] == 3 && geosym_1.idepfn[j - 1] == 14)
) {
aidref[i__ - 1] += sum;
}
/* L80: */
}
/* L90: */
}
s_wsfe(&io___31);
do_fio(&c__1, " AB-INITIO DERIVATIVES AFTER SYMMETRY WEIGHTI"
"NG", (ftnlen)47);
e_wsfe();
s_wsfe(&io___32);
i__1 = geovar_1.nvar;
for (j = 1; j <= i__1; ++j) {
do_fio(&c__1, (char *)&aidref[j - 1], (ftnlen)sizeof(
doublereal));
}
e_wsfe();
}
}
icalcn = numcal_1.numcal;
if (i_indx(keywrd_1.keywrd, "RESTART", (ftnlen)241, (ftnlen)7) == 0) {
i__1 = geovar_1.nvar;
for (i__ = 1; i__ <= i__1; ++i__) {
/* L100: */
errfn_1.errfn[i__ - 1] = 0.;
}
}
grlim = .01;
if (precis) {
grlim = 1e-4;
}
halfe = molkst_1.nopen > molkst_1.nclose && molkst_1.fract != 2. &&
molkst_1.fract != 0. || ci;
idelta = -7;
/* IDELTA IS A MACHINE-PRECISION DEPENDANT INTEGER */
change[0] = pow_di(&c_b70, &idelta);
change[1] = pow_di(&c_b70, &idelta);
change[2] = pow_di(&c_b70, &idelta);
/* CHANGE(I) IS THE STEP SIZE USED IN CALCULATING THE DERIVATIVES. */
/* FOR "CARTESIAN" DERIVATIVES, CALCULATED USING DCART,AN */
/* INFINITESIMAL STEP, HERE 0.000001, IS ACCEPTABLE. IN THE */
/* HALF-ELECTRON METHOD A QUITE LARGE STEP IS NEEDED AS FULL SCF */
/* CALCULATIONS ARE NEEDED, AND THE DIFFERENCE BETWEEN THE TOTAL */
/* ENERGIES IS USED. THE STEP CANNOT BE VERY LARGE, AS THE SECOND */
/* DERIVITIVE IN FLEPO IS CALCULATED FROM THE DIFFERENCES OF TWO */
/* FIRST DERIVATIVES. CHANGE(1) IS FOR CHANGE IN BOND LENGTH, */
/* (2) FOR ANGLE, AND (3) FOR DIHEDRAL. */
}
if (geovar_1.nvar == 0) {
return 0;
}
if (debug) {
s_wsfe(&io___37);
e_wsfe();
s_wsfe(&io___38);
i__1 = geokst_1.natoms;
for (i__ = 1; i__ <= i__1; ++i__) {
for (j = 1; j <= 3; ++j) {
do_fio(&c__1, (char *)&geo[j + i__ * 3], (ftnlen)sizeof(
doublereal));
}
}
e_wsfe();
}
gnorm = 0.;
i__1 = geovar_1.nvar;
for (i__ = 1; i__ <= i__1; ++i__) {
genral_1.gold[i__ - 1] = grad[i__];
genral_1.xparam[i__ - 1] = geo[geovar_1.loc[(i__ << 1) - 1] +
geovar_1.loc[(i__ << 1) - 2] * 3];
/* L110: */
/* Computing 2nd power */
d__1 = grad[i__];
gnorm += d__1 * d__1;
}
gnorm = sqrt(gnorm);
slow = FALSE_;
noanci = FALSE_;
if (halfe) {
noanci = i_indx(keywrd_1.keywrd, "NOANCI", (ftnlen)241, (ftnlen)6) !=
0 || molkst_1.nopen == molkst_1.norbs;
slow = noanci && (gnorm < grlim || scf1);
}
if (geosym_1.ndep != 0) {
symtry_();
}
gmetry_(&geo[4], genral_1.coord);
/* COORD NOW HOLDS THE CARTESIAN COORDINATES */
if (halfe && ! noanci) {
if (debug) {
s_wsle(&io___42);
do_lio(&c__9, &c__1, "DOING ANALYTICAL C.I. DERIVATIVES", (ftnlen)
33);
e_wsle();
}
dernvo_(genral_1.coord, xyzgra_1.dxyz);
} else {
if (debug) {
s_wsle(&io___43);
do_lio(&c__9, &c__1, "DOING VARIATIONALLY OPIMIZED DERIVATIVES", (
ftnlen)40);
e_wsle();
}
dcart_(genral_1.coord, xyzgra_1.dxyz);
}
ij = 0;
i__1 = molkst_1.numat;
for (ii = 1; ii <= i__1; ++ii) {
i__2 = ucell_1.l1u;
for (il = ucell_1.l1l; il <= i__2; ++il) {
i__3 = ucell_1.l2u;
for (jl = ucell_1.l2l; jl <= i__3; ++jl) {
i__4 = ucell_1.l3u;
for (kl = ucell_1.l3l; kl <= i__4; ++kl) {
/* $DOIT ASIS */
for (ll = 1; ll <= 3; ++ll) {
/* L120: */
xjuc[ll - 1] = genral_1.coord[ll + ii * 3 - 4] +
euler_1.tvec[ll - 1] * il + euler_1.tvec[ll +
2] * jl + euler_1.tvec[ll + 5] * kl;
}
++ij;
/* $DOIT ASIS */
for (kk = 1; kk <= 3; ++kk) {
genral_1.cold[kk + ij * 3 - 4] = xjuc[kk - 1];
/* L130: */
}
/* L140: */
}
}
}
/* L150: */
}
step = change[0];
jcarin_(genral_1.coord, genral_1.xparam, &step, &precis, work3_1.work2, &
ncol);
mxm_(work3_1.work2, &geovar_1.nvar, xyzgra_1.dxyz, &ncol, &grad[1], &c__1)
;
if (precis) {
step = .5 / step;
} else {
step = 1. / step;
}
i__1 = geovar_1.nvar;
for (i__ = 1; i__ <= i__1; ++i__) {
/* L160: */
grad[i__] *= step;
}
/* NOW TO ENSURE THAT INTERNAL DERIVATIVES ACCURATELY REFLECT CARTESIAN */
/* DERIVATIVES */
if (int__ && ! geook && geovar_1.nvar >= molkst_1.numat * 3 - 6 &&
euler_1.id == 0) {
/* NUMBER OF VARIABLES LOOKS O.K. */
sum = dot_(&grad[1], &grad[1], &geovar_1.nvar);
i__1 = molkst_1.numat * 3;
/* Computing MAX */
d__1 = 4., d__2 = sum * 4.;
if (sum < 2. && dot_(xyzgra_1.dxyz, xyzgra_1.dxyz, &i__1) > max(d__1,
d__2)) {
/* OOPS, LOOKS LIKE AN ERROR. */
i__1 = geovar_1.nvar;
for (i__ = 1; i__ <= i__1; ++i__) {
j = (integer) (genral_1.xparam[i__ - 1] / 3.141);
if (geovar_1.loc[(i__ << 1) - 1] == 2 && geovar_1.loc[(i__ <<
1) - 2] > 3 && (d__1 = genral_1.xparam[i__ - 1] - j *
3.1415926, abs(d__1)) < .005) {
/* ERROR LOCATED, BUT CANNOT CORRECT IN THIS RUN */
s_wsfe(&io___54);
do_fio(&c__1, " INTERNAL COORDINATE DERIVATIVES DO NOT R"
"EFLECT", (ftnlen)47);
do_fio(&c__1, " CARTESIAN COORDINATE DERIVATIVES", (
ftnlen)33);
do_fio(&c__1, " TO CORRECT ERROR, INCREASE DIHEDRAL OF A"
"TOM", (ftnlen)44);
do_fio(&c__1, (char *)&geovar_1.loc[(i__ << 1) - 2], (
ftnlen)sizeof(integer));
do_fio(&c__1, " BY 90 DEGREES", (ftnlen)14);
e_wsfe();
s_wsfe(&io___55);
do_fio(&c__1, " CURRENT GEOMETRY", (ftnlen)21);
e_wsfe();
geout_(&c__6);
s_stop("", (ftnlen)0);
}
/* L170: */
}
}
}
/* THIS CODE IS ONLY USED IF THE KEYWORD NOANCI IS SPECIFIED */
if (slow) {
if (debug) {
s_wsle(&io___56);
do_lio(&c__9, &c__1, "DOING FULL SCF DERIVATIVES", (ftnlen)26);
e_wsle();
}
deritr_(errfn_1.errfn, &geo[4]);
/* THE ARRAY ERRFN HOLDS THE EXACT DERIVATIVES MINUS THE APPROXIMATE */
/* DERIVATIVES */
i__1 = geovar_1.nvar;
for (i__ = 1; i__ <= i__1; ++i__) {
/* L180: */
errfn_1.errfn[i__ - 1] -= grad[i__];
}
}
gravec_1.cosine = dot_(&grad[1], genral_1.gold, &geovar_1.nvar) / sqrt(
dot_(&grad[1], &grad[1], &geovar_1.nvar) * dot_(genral_1.gold,
genral_1.gold, &geovar_1.nvar) + 1e-20);
i__1 = geovar_1.nvar;
for (i__ = 1; i__ <= i__1; ++i__) {
/* L190: */
grad[i__] += errfn_1.errfn[i__ - 1];
}
if (aic) {
if (aifrst) {
aifrst = FALSE_;
i__1 = geovar_1.nvar;
for (i__ = 1; i__ <= i__1; ++i__) {
/* L200: */
errfn_1.aicorr[i__ - 1] = -aidref[i__ - 1] - grad[i__];
}
}
/* # WRITE(6,'('' GRADIENTS BEFORE AI CORRECTION'')') */
/* # WRITE(6,'(10F8.3)')(GRAD(I),I=1,NVAR) */
i__1 = geovar_1.nvar;
for (i__ = 1; i__ <= i__1; ++i__) {
/* L210: */
grad[i__] += errfn_1.aicorr[i__ - 1];
}
}
/* L220: */
if (debug) {
s_wsfe(&io___57);
e_wsfe();
s_wsfe(&io___58);
i__1 = geovar_1.nvar;
for (i__ = 1; i__ <= i__1; ++i__) {
do_fio(&c__1, (char *)&grad[i__], (ftnlen)sizeof(doublereal));
}
e_wsfe();
if (slow) {
s_wsfe(&io___59);
e_wsfe();
s_wsfe(&io___60);
i__1 = geovar_1.nvar;
for (i__ = 1; i__ <= i__1; ++i__) {
do_fio(&c__1, (char *)&errfn_1.errfn[i__ - 1], (ftnlen)sizeof(
doublereal));
}
e_wsfe();
}
}
if (debug) {
s_wsfe(&io___61);
do_fio(&c__1, (char *)&gravec_1.cosine, (ftnlen)sizeof(doublereal));
e_wsfe();
}
return 0;
} /* deriv_ */
/* Subroutine */ int mullik_(doublereal *c__, doublereal *h__, doublereal *f,
integer *norbs, doublereal *vecs, doublereal *store)
{
/* System generated locals */
integer i__1, i__2, i__3, i__4;
doublereal d__1;
char ch__1[80];
olist o__1;
/* Builtin functions */
integer i_indx(char *, char *, ftnlen, ftnlen);
double sqrt(doublereal);
integer f_open(olist *), s_wsue(cilist *), do_uio(integer *, char *,
ftnlen), e_wsue(void);
/* Local variables */
static integer i__, j, k;
static doublereal bi, bj;
static integer if__, jf, ii, ij, jj, il, jl, im1;
extern /* Subroutine */ int rsp_(doublereal *, integer *, integer *,
doublereal *, doublereal *);
static doublereal sum, xyz[360] /* was [3][120] */, eigs[300];
extern /* Subroutine */ int mult_(doublereal *, doublereal *, doublereal *
, integer *);
static doublereal summ;
static integer ifact[300];
static logical graph;
extern /* Character */ VOID getnam_(char *, ftnlen, char *, ftnlen);
static integer linear;
extern /* Subroutine */ int densit_(doublereal *, integer *, integer *,
integer *, integer *, doublereal *, doublereal *, integer *),
vecprt_(doublereal *, integer *), gmetry_(doublereal *,
doublereal *);
/* Fortran I/O blocks */
static cilist io___19 = { 0, 13, 0, 0, 0 };
static cilist io___20 = { 0, 13, 0, 0, 0 };
static cilist io___21 = { 0, 13, 0, 0, 0 };
static cilist io___23 = { 0, 13, 0, 0, 0 };
static cilist io___24 = { 0, 13, 0, 0, 0 };
/* COMDECK SIZES */
/* *********************************************************************** */
/* THIS FILE CONTAINS ALL THE ARRAY SIZES FOR USE IN MOPAC. */
/* THERE ARE ONLY 5 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) */
/* ISYBYL = 1 IF MOPAC IS TO BE USED IN THE SYBYL PACKAGE, =0 OTHERWISE */
/* SEE ALSO NMECI, NPULAY AND MESP AT THE END OF THIS FILE */
/* *********************************************************************** */
/* 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 */
/* MAXALL LARGER THAN MAXORB OR MAXPAR. */
/* *********************************************************************** */
/* *********************************************************************** */
/* DECK MOPAC */
/* ********************************************************************* */
/* MULLIK DOES A MULLIKEN POPULATION ANALYSIS */
/* ON INPUT C = SQUARE ARRAY OF EIGENVECTORS. */
/* H = PACKED ARRAY OF ONE-ELECTRON MATRIX */
/* F = WORKSTORE OF SIZE AT LEAST NORBS*NORBS */
/* VECS = WORKSTORE OF SIZE AT LEAST NORBS*NORBS */
/* STORE = WORKSTORE OF SIZE AT LEAST (NORBS*(NORBS+1))/2 */
/* ********************************************************************* */
/* ********************************************************************* */
/* FIRST, RE-CALCULATE THE OVERLAP MATRIX */
/* ********************************************************************* */
/* Parameter adjustments */
--store;
--vecs;
--f;
--h__;
--c__;
/* Function Body */
graph = i_indx(keywrd_1.keywrd, "GRAPH", (ftnlen)241, (ftnlen)5) != 0;
i__1 = *norbs;
for (i__ = 1; i__ <= i__1; ++i__) {
/* L10: */
ifact[i__ - 1] = i__ * (i__ - 1) / 2;
}
ifact[*norbs] = *norbs * (*norbs + 1) / 2;
i__1 = molkst_1.numat;
for (i__ = 1; i__ <= i__1; ++i__) {
if__ = molkst_1.nfirst[i__ - 1];
il = molkst_1.nlast[i__ - 1];
im1 = i__ - 1;
bi = betas_1.betas[molkst_1.nat[i__ - 1] - 1];
i__2 = il;
for (k = if__; k <= i__2; ++k) {
ii = k * (k - 1) / 2;
i__3 = im1;
for (j = 1; j <= i__3; ++j) {
jf = molkst_1.nfirst[j - 1];
jl = molkst_1.nlast[j - 1];
bj = betas_1.betas[molkst_1.nat[j - 1] - 1];
i__4 = jl;
for (jj = jf; jj <= i__4; ++jj) {
ij = ii + jj;
h__[ij] = h__[ij] * 2. / (bi + bj) + 1e-14;
/* THE +1.D-14 IS TO PREVENT POSSIBLE ERRORS IN THE DIAGONALIZATION. */
store[ij] = h__[ij];
/* L20: */
bj = betas_1.betap[molkst_1.nat[j - 1] - 1];
}
/* L30: */
}
i__3 = k;
for (jj = if__; jj <= i__3; ++jj) {
ij = ii + jj;
store[ij] = 0.;
/* L40: */
h__[ij] = 0.;
}
/* L50: */
bi = betas_1.betap[molkst_1.nat[i__ - 1] - 1];
}
}
i__2 = *norbs;
for (i__ = 1; i__ <= i__2; ++i__) {
store[ifact[i__]] = 1.;
/* L60: */
h__[ifact[i__]] = 1.;
}
rsp_(&h__[1], norbs, norbs, eigs, &vecs[1]);
i__2 = *norbs;
for (i__ = 1; i__ <= i__2; ++i__) {
/* L70: */
eigs[i__ - 1] = 1. / sqrt((d__1 = eigs[i__ - 1], abs(d__1)));
}
ij = 0;
i__2 = *norbs;
for (i__ = 1; i__ <= i__2; ++i__) {
i__1 = i__;
for (j = 1; j <= i__1; ++j) {
++ij;
sum = 0.;
i__3 = *norbs;
for (k = 1; k <= i__3; ++k) {
/* L80: */
sum += vecs[i__ + (k - 1) * *norbs] * eigs[k - 1] * vecs[j + (
k - 1) * *norbs];
}
f[i__ + (j - 1) * *norbs] = sum;
/* L90: */
f[j + (i__ - 1) * *norbs] = sum;
}
}
if (graph) {
gmetry_(geom_1.geo, xyz);
/* WRITE TO DISK THE FOLLOWING DATA FOR GRAPHICS CALCULATION, IN ORDER: */
/* NUMBER OF ATOMS, ORBITAL, ELECTRONS */
/* ALL ATOMIC COORDINATES */
/* ORBITAL COUNTERS */
/* ORBITAL EXPONENTS, S, P, AND D, AND ATOMIC NUMBERS */
/* EIGENVECTORS (M.O.S NOT RE-NORMALIZED) */
/* INVERSE-SQUARE ROOT OF THE OVERLAP MATRIX. */
o__1.oerr = 1;
o__1.ounit = 13;
o__1.ofnmlen = 80;
getnam_(ch__1, (ftnlen)80, "FOR013", (ftnlen)6);
o__1.ofnm = ch__1;
o__1.orl = 0;
o__1.osta = "NEW";
o__1.oacc = 0;
o__1.ofm = "UNFORMATTED";
o__1.oblnk = 0;
i__1 = f_open(&o__1);
if (i__1 != 0) {
goto L31;
}
goto L32;
L31:
o__1.oerr = 0;
o__1.ounit = 13;
o__1.ofnmlen = 80;
getnam_(ch__1, (ftnlen)80, "FOR013", (ftnlen)6);
o__1.ofnm = ch__1;
o__1.orl = 0;
o__1.osta = "OLD";
o__1.oacc = 0;
o__1.ofm = "UNFORMATTED";
o__1.oblnk = 0;
f_open(&o__1);
L32:
s_wsue(&io___19);
do_uio(&c__1, (char *)&molkst_1.numat, (ftnlen)sizeof(integer));
do_uio(&c__1, (char *)&(*norbs), (ftnlen)sizeof(integer));
do_uio(&c__1, (char *)&molkst_1.nelecs, (ftnlen)sizeof(integer));
for (i__ = 1; i__ <= 3; ++i__) {
i__1 = molkst_1.numat;
for (j = 1; j <= i__1; ++j) {
do_uio(&c__1, (char *)&xyz[i__ + j * 3 - 4], (ftnlen)sizeof(
doublereal));
}
}
e_wsue();
s_wsue(&io___20);
i__1 = molkst_1.numat;
for (i__ = 1; i__ <= i__1; ++i__) {
do_uio(&c__1, (char *)&molkst_1.nlast[i__ - 1], (ftnlen)sizeof(
integer));
do_uio(&c__1, (char *)&molkst_1.nfirst[i__ - 1], (ftnlen)sizeof(
integer));
}
e_wsue();
s_wsue(&io___21);
i__1 = molkst_1.numat;
for (i__ = 1; i__ <= i__1; ++i__) {
do_uio(&c__1, (char *)&expont_1.zs[molkst_1.nat[i__ - 1] - 1], (
ftnlen)sizeof(doublereal));
}
i__2 = molkst_1.numat;
for (i__ = 1; i__ <= i__2; ++i__) {
do_uio(&c__1, (char *)&expont_1.zp[molkst_1.nat[i__ - 1] - 1], (
ftnlen)sizeof(doublereal));
}
i__3 = molkst_1.numat;
for (i__ = 1; i__ <= i__3; ++i__) {
do_uio(&c__1, (char *)&expont_1.zd[molkst_1.nat[i__ - 1] - 1], (
ftnlen)sizeof(doublereal));
}
i__4 = molkst_1.numat;
for (i__ = 1; i__ <= i__4; ++i__) {
do_uio(&c__1, (char *)&molkst_1.nat[i__ - 1], (ftnlen)sizeof(
integer));
}
e_wsue();
linear = *norbs * *norbs;
s_wsue(&io___23);
i__1 = linear;
for (i__ = 1; i__ <= i__1; ++i__) {
do_uio(&c__1, (char *)&c__[i__], (ftnlen)sizeof(doublereal));
}
e_wsue();
s_wsue(&io___24);
i__1 = linear;
for (i__ = 1; i__ <= i__1; ++i__) {
do_uio(&c__1, (char *)&f[i__], (ftnlen)sizeof(doublereal));
}
e_wsue();
if (i_indx(keywrd_1.keywrd, "MULLIK", (ftnlen)241, (ftnlen)6) == 0) {
return 0;
}
}
/* OTHERWISE PERFORM MULLIKEN ANALYSIS */
mult_(&c__[1], &f[1], &vecs[1], norbs);
i__ = -1;
densit_(&vecs[1], norbs, norbs, &molkst_1.nclose, &molkst_1.nopen, &
molkst_1.fract, &c__[1], &c__2);
linear = *norbs * (*norbs + 1) / 2;
i__1 = linear;
for (i__ = 1; i__ <= i__1; ++i__) {
/* L100: */
c__[i__] *= store[i__];
}
summ = 0.;
i__1 = *norbs;
for (i__ = 1; i__ <= i__1; ++i__) {
sum = 0.;
i__2 = i__;
for (j = 1; j <= i__2; ++j) {
/* L110: */
sum += c__[ifact[i__ - 1] + j];
}
i__2 = *norbs;
for (j = i__ + 1; j <= i__2; ++j) {
/* L120: */
sum += c__[ifact[j - 1] + i__];
}
summ += sum;
/* L130: */
c__[ifact[i__]] = sum;
}
vecprt_(&c__[1], norbs);
return 0;
} /* mullik_ */
/* Subroutine */ int gettxt_()
{
/* System generated locals */
integer i__1;
char ch__1[80];
olist o__1;
alist al__1;
/* Builtin functions */
/* Subroutine */ int s_copy();
integer s_rsfe(), do_fio(), e_rsfe(), i_indx(), f_open(), f_rew(), s_wsfe(
), e_wsfe(), s_cmp();
/* Subroutine */ int s_stop();
/* Local variables */
static integer i__, j;
static char filen[50], ch[1];
static integer is[3];
extern /* Character */ VOID getnam_();
extern /* Subroutine */ int upcase_();
static char oldkey[80], ch2[1];
/* Fortran I/O blocks */
static cilist io___2 = { 1, 5, 1, "(A)", 0 };
static cilist io___7 = { 1, 4, 1, "(A)", 0 };
static cilist io___8 = { 1, 4, 1, "(A)", 0 };
static cilist io___9 = { 1, 5, 1, "(A)", 0 };
static cilist io___10 = { 1, 5, 1, "(A)", 0 };
static cilist io___11 = { 1, 4, 1, "(A)", 0 };
static cilist io___12 = { 1, 5, 1, "(A)", 0 };
static cilist io___13 = { 1, 5, 1, "(A)", 0 };
static cilist io___14 = { 1, 5, 1, "(A)", 0 };
static cilist io___15 = { 1, 4, 1, "(A)", 0 };
static cilist io___16 = { 1, 5, 1, "(A)", 0 };
static cilist io___17 = { 1, 5, 1, "(A)", 0 };
static cilist io___18 = { 1, 5, 1, "(A)", 0 };
static cilist io___19 = { 1, 5, 1, "(A)", 0 };
static cilist io___20 = { 0, 6, 0, "(A)", 0 };
static cilist io___23 = { 0, 6, 0, "(A,I2,A)", 0 };
static cilist io___24 = { 0, 6, 0, "(A)", 0 };
static cilist io___25 = { 0, 6, 0, "(A)", 0 };
is[0] = 161;
is[1] = 81;
is[2] = 1;
s_copy(keywrd_1.keywrd, " ", (ftnlen)241, (ftnlen)1);
s_copy(titles_1.koment, " NULL ", (ftnlen)81, (ftnlen)10);
s_copy(titles_1.title, " NULL ", (ftnlen)81, (ftnlen)10);
i__1 = s_rsfe(&io___2);
if (i__1 != 0) {
goto L100001;
}
i__1 = do_fio(&c__1, keywrd_1.keywrd, (ftnlen)80);
if (i__1 != 0) {
goto L100001;
}
i__1 = e_rsfe();
L100001:
if (i__1 < 0) {
goto L100;
}
if (i__1 > 0) {
goto L90;
}
s_copy(oldkey, keywrd_1.keywrd, (ftnlen)80, (ftnlen)241);
upcase_(keywrd_1.keywrd, (ftnlen)80);
if (i_indx(keywrd_1.keywrd, "SETUP", (ftnlen)241, (ftnlen)5) != 0) {
i__ = i_indx(keywrd_1.keywrd, "SETUP=", (ftnlen)241, (ftnlen)6);
if (i__ != 0) {
j = i_indx(keywrd_1.keywrd + (i__ - 1), " ", 241 - (i__ - 1), (
ftnlen)1);
i__1 = i__ + 5;
s_copy(filen, oldkey + i__1, (ftnlen)50, i__ + j - 1 - i__1);
} else {
s_copy(filen, "SETUP", (ftnlen)50, (ftnlen)5);
}
o__1.oerr = 0;
o__1.ounit = 4;
o__1.ofnmlen = 80;
getnam_(ch__1, (ftnlen)80, filen, (ftnlen)50);
o__1.ofnm = ch__1;
o__1.orl = 0;
o__1.osta = "UNKNOWN";
o__1.oacc = 0;
o__1.ofm = "FORMATTED";
o__1.oblnk = 0;
f_open(&o__1);
al__1.aerr = 0;
al__1.aunit = 4;
f_rew(&al__1);
i__1 = s_rsfe(&io___7);
if (i__1 != 0) {
goto L40;
}
i__1 = do_fio(&c__1, keywrd_1.keywrd + 80, (ftnlen)80);
if (i__1 != 0) {
goto L40;
}
i__1 = e_rsfe();
if (i__1 != 0) {
goto L40;
}
upcase_(keywrd_1.keywrd + 80, (ftnlen)80);
i__1 = s_rsfe(&io___8);
if (i__1 != 0) {
goto L10;
}
i__1 = do_fio(&c__1, keywrd_1.keywrd + 160, (ftnlen)80);
if (i__1 != 0) {
goto L10;
}
i__1 = e_rsfe();
if (i__1 != 0) {
goto L10;
}
upcase_(keywrd_1.keywrd + 160, (ftnlen)80);
L10:
i__1 = s_rsfe(&io___9);
if (i__1 != 0) {
goto L100002;
}
i__1 = do_fio(&c__1, titles_1.koment, (ftnlen)81);
if (i__1 != 0) {
goto L100002;
}
i__1 = do_fio(&c__1, titles_1.title, (ftnlen)81);
if (i__1 != 0) {
goto L100002;
}
i__1 = e_rsfe();
L100002:
if (i__1 < 0) {
goto L100;
}
if (i__1 > 0) {
goto L90;
}
} else if (i_indx(keywrd_1.keywrd, " +", (ftnlen)80, (ftnlen)2) != 0) {
/* READ SECOND KEYWORD LINE */
i__1 = s_rsfe(&io___10);
if (i__1 != 0) {
goto L100003;
}
i__1 = do_fio(&c__1, keywrd_1.keywrd + 80, (ftnlen)80);
if (i__1 != 0) {
goto L100003;
}
i__1 = e_rsfe();
L100003:
if (i__1 < 0) {
goto L100;
}
if (i__1 > 0) {
goto L90;
}
s_copy(oldkey, keywrd_1.keywrd + 80, (ftnlen)80, (ftnlen)80);
upcase_(keywrd_1.keywrd + 80, (ftnlen)80);
if (i_indx(keywrd_1.keywrd + 80, "SETUP", (ftnlen)80, (ftnlen)5) != 0)
{
i__ = i_indx(keywrd_1.keywrd, "SETUP=", (ftnlen)241, (ftnlen)6);
if (i__ != 0) {
j = i_indx(keywrd_1.keywrd + (i__ - 1), " ", 241 - (i__ - 1),
(ftnlen)1);
i__1 = i__ - 75;
s_copy(filen, oldkey + i__1, (ftnlen)50, i__ + j - 80 - i__1);
} else {
s_copy(filen, "SETUP", (ftnlen)50, (ftnlen)5);
}
o__1.oerr = 0;
o__1.ounit = 4;
o__1.ofnmlen = 80;
getnam_(ch__1, (ftnlen)80, filen, (ftnlen)50);
o__1.ofnm = ch__1;
o__1.orl = 0;
o__1.osta = "UNKNOWN";
o__1.oacc = 0;
o__1.ofm = "FORMATTED";
o__1.oblnk = 0;
f_open(&o__1);
al__1.aerr = 0;
al__1.aunit = 4;
f_rew(&al__1);
i__1 = s_rsfe(&io___11);
if (i__1 != 0) {
goto L20;
}
i__1 = do_fio(&c__1, keywrd_1.keywrd + 160, (ftnlen)80);
if (i__1 != 0) {
goto L20;
}
i__1 = e_rsfe();
if (i__1 != 0) {
goto L20;
}
upcase_(keywrd_1.keywrd + 160, (ftnlen)80);
L20:
;
} else if (i_indx(keywrd_1.keywrd + 80, " +", (ftnlen)80, (ftnlen)2)
!= 0) {
/* READ THIRD KEYWORD LINE */
i__1 = s_rsfe(&io___12);
if (i__1 != 0) {
goto L100004;
}
i__1 = do_fio(&c__1, keywrd_1.keywrd + 160, (ftnlen)80);
if (i__1 != 0) {
goto L100004;
}
i__1 = e_rsfe();
L100004:
if (i__1 < 0) {
goto L100;
}
if (i__1 > 0) {
goto L90;
}
upcase_(keywrd_1.keywrd + 160, (ftnlen)80);
}
/* READ TITLE LINE */
i__1 = s_rsfe(&io___13);
if (i__1 != 0) {
goto L100005;
}
i__1 = do_fio(&c__1, titles_1.koment, (ftnlen)81);
if (i__1 != 0) {
goto L100005;
}
i__1 = do_fio(&c__1, titles_1.title, (ftnlen)81);
if (i__1 != 0) {
goto L100005;
}
i__1 = e_rsfe();
L100005:
if (i__1 < 0) {
goto L100;
}
if (i__1 > 0) {
goto L90;
}
} else if (i_indx(keywrd_1.keywrd, "&", (ftnlen)80, (ftnlen)1) != 0) {
i__1 = s_rsfe(&io___14);
if (i__1 != 0) {
goto L100006;
}
i__1 = do_fio(&c__1, keywrd_1.keywrd + 80, (ftnlen)80);
if (i__1 != 0) {
goto L100006;
}
i__1 = e_rsfe();
L100006:
if (i__1 < 0) {
goto L100;
}
if (i__1 > 0) {
goto L90;
}
s_copy(oldkey, keywrd_1.keywrd + 80, (ftnlen)80, (ftnlen)80);
upcase_(keywrd_1.keywrd + 80, (ftnlen)80);
if (i_indx(keywrd_1.keywrd + 80, "SETUP", (ftnlen)80, (ftnlen)5) != 0)
{
i__ = i_indx(keywrd_1.keywrd, "SETUP=", (ftnlen)241, (ftnlen)6);
if (i__ != 0) {
j = i_indx(keywrd_1.keywrd + (i__ - 1), " ", 241 - (i__ - 1),
(ftnlen)1);
i__1 = i__ - 75;
s_copy(filen, oldkey + i__1, (ftnlen)50, i__ + j - 80 - i__1);
/* write(*,*)' <'//FILEN//'>' */
/* stop */
} else {
s_copy(filen, "SETUP", (ftnlen)50, (ftnlen)5);
}
o__1.oerr = 0;
o__1.ounit = 4;
o__1.ofnmlen = 80;
getnam_(ch__1, (ftnlen)80, filen, (ftnlen)50);
o__1.ofnm = ch__1;
o__1.orl = 0;
o__1.osta = "UNKNOWN";
o__1.oacc = 0;
o__1.ofm = "FORMATTED";
o__1.oblnk = 0;
f_open(&o__1);
al__1.aerr = 0;
al__1.aunit = 4;
f_rew(&al__1);
i__1 = s_rsfe(&io___15);
if (i__1 != 0) {
goto L30;
}
i__1 = do_fio(&c__1, keywrd_1.keywrd + 160, (ftnlen)80);
if (i__1 != 0) {
goto L30;
}
i__1 = e_rsfe();
if (i__1 != 0) {
goto L30;
}
upcase_(keywrd_1.keywrd + 160, (ftnlen)80);
i__1 = s_rsfe(&io___16);
if (i__1 != 0) {
goto L100007;
}
i__1 = do_fio(&c__1, titles_1.title, (ftnlen)81);
if (i__1 != 0) {
goto L100007;
}
i__1 = e_rsfe();
L100007:
if (i__1 < 0) {
goto L100;
}
if (i__1 > 0) {
goto L90;
}
L30:
;
} else if (i_indx(keywrd_1.keywrd + 80, "&", (ftnlen)80, (ftnlen)1) !=
0) {
i__1 = s_rsfe(&io___17);
if (i__1 != 0) {
goto L100008;
}
i__1 = do_fio(&c__1, keywrd_1.keywrd + 160, (ftnlen)80);
if (i__1 != 0) {
goto L100008;
}
i__1 = e_rsfe();
L100008:
if (i__1 < 0) {
goto L100;
}
if (i__1 > 0) {
goto L90;
}
} else {
i__1 = s_rsfe(&io___18);
if (i__1 != 0) {
goto L100009;
}
i__1 = do_fio(&c__1, titles_1.title, (ftnlen)81);
if (i__1 != 0) {
goto L100009;
}
i__1 = e_rsfe();
L100009:
if (i__1 < 0) {
goto L100;
}
if (i__1 > 0) {
goto L90;
}
}
} else {
i__1 = s_rsfe(&io___19);
if (i__1 != 0) {
goto L100010;
}
i__1 = do_fio(&c__1, titles_1.koment, (ftnlen)81);
if (i__1 != 0) {
goto L100010;
}
i__1 = do_fio(&c__1, titles_1.title, (ftnlen)81);
if (i__1 != 0) {
goto L100010;
}
i__1 = e_rsfe();
L100010:
if (i__1 < 0) {
goto L100;
}
if (i__1 > 0) {
goto L90;
}
}
goto L50;
L40:
s_wsfe(&io___20);
do_fio(&c__1, " SETUP FILE MISSING OR CORRUPT", (ftnlen)30);
e_wsfe();
L50:
for (j = 1; j <= 3; ++j) {
i__1 = is[j - 1] - 1;
if (s_cmp(keywrd_1.keywrd + i__1, " ", is[j - 1] - i__1, (ftnlen)1) !=
0) {
i__1 = is[j - 1] - 1;
s_copy(ch, keywrd_1.keywrd + i__1, (ftnlen)1, is[j - 1] - i__1);
i__1 = is[j - 1] - 1;
s_copy(keywrd_1.keywrd + i__1, " ", is[j - 1] - i__1, (ftnlen)1);
for (i__ = is[j - 1] + 1; i__ <= 239; ++i__) {
*(unsigned char *)ch2 = *(unsigned char *)&keywrd_1.keywrd[
i__ - 1];
*(unsigned char *)&keywrd_1.keywrd[i__ - 1] = *(unsigned char
*)ch;
*(unsigned char *)ch = *(unsigned char *)ch2;
i__1 = i__;
if (s_cmp(keywrd_1.keywrd + i__1, " ", i__ + 2 - i__1, (
ftnlen)2) == 0) {
i__1 = i__;
s_copy(keywrd_1.keywrd + i__1, ch, i__ + 1 - i__1, (
ftnlen)1);
goto L70;
}
/* L60: */
}
s_wsfe(&io___23);
do_fio(&c__1, " LINE", (ftnlen)5);
do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer));
do_fio(&c__1, " OF KEYWORDS DOES NOT HAVE ENOUGH", (ftnlen)33);
e_wsfe();
s_wsfe(&io___24);
do_fio(&c__1, " SPACES FOR PARSING. PLEASE CORRECT LINE.", (
ftnlen)42);
e_wsfe();
s_stop("", (ftnlen)0);
L70:
;
}
/* L80: */
}
return 0;
L90:
s_wsfe(&io___25);
do_fio(&c__1, " ERROR IN READ OF FIRST THREE LINES", (ftnlen)35);
e_wsfe();
L100:
s_stop("", (ftnlen)0);
} /* gettxt_ */
/* Subroutine */ int forsav_(doublereal *time, doublereal *deldip, integer *
ipt, doublereal *fmatrx, doublereal *coord, integer *nvar, doublereal
*refh, doublereal *evecs, integer *jstart, doublereal *fconst)
{
/* System generated locals */
integer i__1, i__2;
char ch__1[80];
olist o__1;
cllist cl__1;
alist al__1;
/* Builtin functions */
integer f_open(olist *), f_rew(alist *), s_rsue(cilist *), do_uio(integer
*, char *, ftnlen), e_rsue(void), s_wsue(cilist *), e_wsue(void),
f_clos(cllist *), s_wsfe(cilist *), e_wsfe(void);
/* Subroutine */ int s_stop(char *, ftnlen);
/* Local variables */
static integer i__, j, n33, ir, iw;
extern /* Character */ VOID getnam_(char *, ftnlen, char *, ftnlen);
static integer linear;
/* Fortran I/O blocks */
static cilist io___3 = { 1, 0, 1, 0, 0 };
static cilist io___5 = { 0, 0, 0, 0, 0 };
static cilist io___7 = { 1, 0, 1, 0, 0 };
static cilist io___8 = { 0, 0, 0, 0, 0 };
static cilist io___11 = { 0, 0, 0, 0, 0 };
static cilist io___12 = { 0, 0, 0, 0, 0 };
static cilist io___13 = { 0, 0, 0, 0, 0 };
static cilist io___14 = { 0, 0, 0, 0, 0 };
static cilist io___15 = { 0, 0, 0, 0, 0 };
static cilist io___16 = { 0, 0, 0, 0, 0 };
static cilist io___17 = { 0, 0, 0, 0, 0 };
static cilist io___18 = { 0, 0, 0, 0, 0 };
static cilist io___19 = { 0, 10, 0, 0, 0 };
static cilist io___20 = { 0, 10, 0, 0, 0 };
static cilist io___21 = { 0, 6, 0, "(10X,'INSUFFICIENT DATA ON DISK FILE"
"S FOR A FORCE ', 'CALCULATION',/10X,'RESTART. PERHAPS THIS STA"
"RTED OF AS A ', 'FORCE CALCULATION ')", 0 };
static cilist io___22 = { 0, 6, 0, "(10X,'BUT THE GEOMETRY HAD TO BE OPT"
"IMIZED FIRST, ', 'IN WHICH CASE ',/10X,'REMOVE THE KEY-WORD \""
"FORCE\".')", 0 };
static cilist io___23 = { 0, 6, 0, "(//10X,'NO RESTART FILE EXISTS!')", 0
};
/* COMDECK SIZES */
/* *********************************************************************** */
/* THIS FILE CONTAINS ALL THE ARRAY SIZES FOR USE IN MOPAC. */
/* THERE ARE ONLY 5 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) */
/* ISYBYL = 1 IF MOPAC IS TO BE USED IN THE SYBYL PACKAGE, =0 OTHERWISE */
/* SEE ALSO NMECI, NPULAY AND MESP AT THE END OF THIS FILE */
/* *********************************************************************** */
/* 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 */
/* MAXALL LARGER THAN MAXORB OR MAXPAR. */
/* *********************************************************************** */
/* *********************************************************************** */
/* DECK MOPAC */
/* *********************************************************************** */
/* FORSAV SAVES AND RESTORES DATA USED IN THE FORCE CALCULATION. */
/* ON INPUT TIME = TOTAL TIME ELAPSED SINCE THE START OF THE CALCULATION. */
/* IPT = LINE OF FORCE MATRIX REACHED, IF IN WRITE MODE, */
/* = 0 IF IN READ MODE. */
/* FMATRX = FORCE MATRIX */
/* *********************************************************************** */
/* Parameter adjustments */
--fconst;
--evecs;
--coord;
--fmatrx;
deldip -= 4;
/* Function Body */
o__1.oerr = 0;
o__1.ounit = 9;
o__1.ofnmlen = 80;
getnam_(ch__1, (ftnlen)80, "FOR009", (ftnlen)6);
o__1.ofnm = ch__1;
o__1.orl = 0;
o__1.osta = "UNKNOWN";
o__1.oacc = 0;
o__1.ofm = "UNFORMATTED";
o__1.oblnk = 0;
f_open(&o__1);
al__1.aerr = 0;
al__1.aunit = 9;
f_rew(&al__1);
o__1.oerr = 0;
o__1.ounit = 10;
o__1.ofnmlen = 80;
getnam_(ch__1, (ftnlen)80, "FOR010", (ftnlen)6);
o__1.ofnm = ch__1;
o__1.orl = 0;
o__1.osta = "UNKNOWN";
o__1.oacc = 0;
o__1.ofm = "UNFORMATTED";
o__1.oblnk = 0;
f_open(&o__1);
al__1.aerr = 0;
al__1.aunit = 10;
f_rew(&al__1);
ir = 9;
iw = 9;
if (*ipt == 0) {
/* READ IN FORCE DATA */
io___3.ciunit = ir;
i__1 = s_rsue(&io___3);
if (i__1 != 0) {
goto L20;
}
i__1 = do_uio(&c__1, (char *)&(*time), (ftnlen)sizeof(doublereal));
if (i__1 != 0) {
goto L20;
}
i__1 = do_uio(&c__1, (char *)&(*ipt), (ftnlen)sizeof(integer));
if (i__1 != 0) {
goto L20;
}
i__1 = do_uio(&c__1, (char *)&(*refh), (ftnlen)sizeof(doublereal));
if (i__1 != 0) {
goto L20;
}
i__1 = e_rsue();
if (i__1 != 0) {
goto L20;
}
linear = *nvar * (*nvar + 1) / 2;
io___5.ciunit = ir;
s_rsue(&io___5);
i__1 = *nvar;
for (i__ = 1; i__ <= i__1; ++i__) {
do_uio(&c__1, (char *)&coord[i__], (ftnlen)sizeof(doublereal));
}
e_rsue();
io___7.ciunit = ir;
i__1 = s_rsue(&io___7);
if (i__1 != 0) {
goto L10;
}
i__2 = linear;
for (i__ = 1; i__ <= i__2; ++i__) {
i__1 = do_uio(&c__1, (char *)&fmatrx[i__], (ftnlen)sizeof(
doublereal));
if (i__1 != 0) {
goto L10;
}
}
i__1 = e_rsue();
if (i__1 != 0) {
goto L10;
}
io___8.ciunit = ir;
s_rsue(&io___8);
i__1 = *ipt;
for (i__ = 1; i__ <= i__1; ++i__) {
for (j = 1; j <= 3; ++j) {
do_uio(&c__1, (char *)&deldip[j + i__ * 3], (ftnlen)sizeof(
doublereal));
}
}
e_rsue();
n33 = *nvar * *nvar;
io___11.ciunit = ir;
s_rsue(&io___11);
i__1 = n33;
for (i__ = 1; i__ <= i__1; ++i__) {
do_uio(&c__1, (char *)&evecs[i__], (ftnlen)sizeof(doublereal));
}
e_rsue();
io___12.ciunit = ir;
s_rsue(&io___12);
do_uio(&c__1, (char *)&(*jstart), (ftnlen)sizeof(integer));
i__1 = *nvar;
for (i__ = 1; i__ <= i__1; ++i__) {
do_uio(&c__1, (char *)&fconst[i__], (ftnlen)sizeof(doublereal));
}
e_rsue();
return 0;
} else {
/* WRITE FORCE DATA */
al__1.aerr = 0;
al__1.aunit = iw;
f_rew(&al__1);
if (*time > 1e6) {
*time += -1e6;
}
io___13.ciunit = iw;
s_wsue(&io___13);
do_uio(&c__1, (char *)&(*time), (ftnlen)sizeof(doublereal));
do_uio(&c__1, (char *)&(*ipt), (ftnlen)sizeof(integer));
do_uio(&c__1, (char *)&(*refh), (ftnlen)sizeof(doublereal));
e_wsue();
linear = *nvar * (*nvar + 1) / 2;
io___14.ciunit = iw;
s_wsue(&io___14);
i__1 = *nvar;
for (i__ = 1; i__ <= i__1; ++i__) {
do_uio(&c__1, (char *)&coord[i__], (ftnlen)sizeof(doublereal));
}
e_wsue();
io___15.ciunit = iw;
s_wsue(&io___15);
i__1 = linear;
for (i__ = 1; i__ <= i__1; ++i__) {
do_uio(&c__1, (char *)&fmatrx[i__], (ftnlen)sizeof(doublereal));
}
e_wsue();
io___16.ciunit = iw;
s_wsue(&io___16);
i__1 = *ipt;
for (i__ = 1; i__ <= i__1; ++i__) {
for (j = 1; j <= 3; ++j) {
do_uio(&c__1, (char *)&deldip[j + i__ * 3], (ftnlen)sizeof(
doublereal));
}
}
e_wsue();
n33 = *nvar * *nvar;
io___17.ciunit = ir;
s_wsue(&io___17);
i__1 = n33;
for (i__ = 1; i__ <= i__1; ++i__) {
do_uio(&c__1, (char *)&evecs[i__], (ftnlen)sizeof(doublereal));
}
e_wsue();
io___18.ciunit = ir;
s_wsue(&io___18);
do_uio(&c__1, (char *)&(*jstart), (ftnlen)sizeof(integer));
i__1 = *nvar;
for (i__ = 1; i__ <= i__1; ++i__) {
do_uio(&c__1, (char *)&fconst[i__], (ftnlen)sizeof(doublereal));
}
e_wsue();
linear = molkst_1.norbs * (molkst_1.norbs + 1) / 2;
s_wsue(&io___19);
i__1 = linear;
for (i__ = 1; i__ <= i__1; ++i__) {
do_uio(&c__1, (char *)&densty_1.pa[i__ - 1], (ftnlen)sizeof(
doublereal));
}
e_wsue();
if (molkst_1.nalpha != 0) {
s_wsue(&io___20);
i__1 = linear;
for (i__ = 1; i__ <= i__1; ++i__) {
do_uio(&c__1, (char *)&densty_1.pb[i__ - 1], (ftnlen)sizeof(
doublereal));
}
e_wsue();
}
cl__1.cerr = 0;
cl__1.cunit = 9;
cl__1.csta = 0;
f_clos(&cl__1);
cl__1.cerr = 0;
cl__1.cunit = 10;
cl__1.csta = 0;
f_clos(&cl__1);
}
return 0;
L10:
s_wsfe(&io___21);
e_wsfe();
s_wsfe(&io___22);
e_wsfe();
s_stop("", (ftnlen)0);
L20:
s_wsfe(&io___23);
e_wsfe();
s_stop("", (ftnlen)0);
return 0;
} /* forsav_ */
