/* PURE fio_rewind PUREGVA */
int fio_rewind( int aerr, int aunit )
{
static alist params;
params.aerr = aerr;
params.aunit = aunit;
return f_rew( ¶ms );
}
/* 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 geoutg_(integer *iprt)
{
/* Initialized data */
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";
static char type__[1*3] = "r" "a" "d";
/* System generated locals */
address a__1[3];
integer i__1, i__2[3], i__3, i__4;
doublereal d__1;
olist o__1;
alist al__1;
/* Builtin functions */
integer f_open(olist *);
double asin(doublereal);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer f_rew(alist *), s_wsfe(cilist *), do_fio(integer *, char *,
ftnlen), e_wsfe(void), s_rsfe(cilist *), e_rsfe(void), s_cmp(char
*, char *, ftnlen, ftnlen);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
integer s_wsle(cilist *), e_wsle(void);
/* Local variables */
static integer i__, j, l, nbi, nci;
extern /* Subroutine */ int xxx_(char *, integer *, integer *, integer *,
integer *, char *, ftnlen, ftnlen);
static integer igeo[360] /* was [3][120] */;
static char line[15*3*120];
static integer nopt;
static char blank[80];
static doublereal degree;
static char optdat[14*360];
static integer maxtxt;
/* Fortran I/O blocks */
static cilist io___10 = { 0, 21, 0, "(F12.6)", 0 };
static cilist io___11 = { 0, 21, 0, "(F12.6)", 0 };
static cilist io___12 = { 0, 21, 0, "(A)", 0 };
static cilist io___17 = { 0, 0, 0, "(1X,A,I4,A,I4,A,I4,A,I4)", 0 };
static cilist io___18 = { 0, 0, 0, "(1X,A,I4,A,I4,A,I4,A,I4)", 0 };
static cilist io___19 = { 0, 0, 0, "(1X,A,I4,A,I4,A,I4,A,I4)", 0 };
static cilist io___21 = { 0, 0, 0, "(1X,A,I4,A,I4,A,I4,A,I4)", 0 };
static cilist io___22 = { 0, 0, 0, 0, 0 };
static cilist io___23 = { 0, 0, 0, "(A,F12.6)", 0 };
static cilist io___24 = { 0, 0, 0, "(A,F12.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 */
/* *********************************************************************** */
/* GEOUTG WRITES OUT THE GEOMETRY IN GAUSSIAN-8X STYLE */
/* *********************************************************************** */
i__1 = geokst_1.natoms;
for (i__ = 1; i__ <= i__1; ++i__) {
for (j = 1; j <= 3; ++j) {
/* L10: */
igeo[j + i__ * 3 - 4] = -1;
}
}
i__1 = geovar_1.nvar;
for (i__ = 1; i__ <= i__1; ++i__) {
/* L20: */
igeo[geovar_1.loc[(i__ << 1) - 1] + geovar_1.loc[(i__ << 1) - 2] * 3
- 4] = -2;
}
i__1 = geosym_1.ndep;
for (i__ = 1; i__ <= i__1; ++i__) {
if (geosym_1.idepfn[i__ - 1] == 14) {
igeo[geosym_1.locdep[i__ - 1] * 3 - 1] = -geosym_1.locpar[i__ - 1]
;
} else {
if (geosym_1.idepfn[i__ - 1] > 3) {
goto L30;
}
igeo[geosym_1.idepfn[i__ - 1] + geosym_1.locdep[i__ - 1] * 3 - 4]
= geosym_1.locpar[i__ - 1];
}
L30:
;
}
o__1.oerr = 0;
o__1.ounit = 21;
o__1.ofnm = 0;
o__1.orl = 0;
o__1.osta = "SCRATCH";
o__1.oacc = 0;
o__1.ofm = 0;
o__1.oblnk = 0;
f_open(&o__1);
degree = 90. / asin(1.);
maxtxt = *(unsigned char *)atomtx_1.ltxt;
nopt = 0;
i__1 = geokst_1.natoms;
for (i__ = 1; i__ <= i__1; ++i__) {
for (j = 1; j <= 3; ++j) {
s_copy(line + (j + i__ * 3 - 4) * 15, " ", (ftnlen)15, (ftnlen)1);
if (igeo[j + i__ * 3 - 4] == -1) {
al__1.aerr = 0;
al__1.aunit = 21;
f_rew(&al__1);
if (j != 1) {
s_wsfe(&io___10);
d__1 = geom_1.geo[j + i__ * 3 - 4] * degree;
do_fio(&c__1, (char *)&d__1, (ftnlen)sizeof(doublereal));
e_wsfe();
} else {
s_wsfe(&io___11);
do_fio(&c__1, (char *)&geom_1.geo[j + i__ * 3 - 4], (
ftnlen)sizeof(doublereal));
e_wsfe();
}
al__1.aerr = 0;
al__1.aunit = 21;
f_rew(&al__1);
s_rsfe(&io___12);
do_fio(&c__1, line + (j + i__ * 3 - 4) * 15, (ftnlen)15);
e_rsfe();
} else if (igeo[j + i__ * 3 - 4] == -2) {
++nopt;
if (s_cmp(simbol_1.simbol + (nopt - 1) * 10, "---", (ftnlen)
10, (ftnlen)3) != 0) {
if (*(unsigned char *)&simbol_1.simbol[(nopt - 1) * 10] ==
'-') {
s_copy(line + ((j + i__ * 3 - 4) * 15 + 3),
simbol_1.simbol + ((nopt - 1) * 10 + 1), (
ftnlen)12, (ftnlen)9);
} else {
s_copy(line + ((j + i__ * 3 - 4) * 15 + 3),
simbol_1.simbol + (nopt - 1) * 10, (ftnlen)12,
(ftnlen)10);
}
} else {
nbi = geokst_1.nb[i__ - 1];
nci = geokst_1.nc[i__ - 1];
if (j != 3) {
nci = 0;
}
if (j == 1) {
nbi = 0;
}
xxx_(type__ + (j - 1), &i__, &geokst_1.na[i__ - 1], &nbi,
&nci, line + ((j + i__ * 3 - 4) * 15 + 3), (
ftnlen)1, (ftnlen)12);
}
s_copy(optdat + (nopt - 1) * 14, line + (j + i__ * 3 - 4) *
15, (ftnlen)14, (ftnlen)15);
} else if (igeo[j + i__ * 3 - 4] < 0) {
s_copy(line + (i__ * 3 - 1) * 15, line + (-igeo[j + i__ * 3 -
4] * 3 - 1) * 15, (ftnlen)15, (ftnlen)15);
*(unsigned char *)&line[(i__ * 3 - 1) * 15 + 2] = '-';
} else {
s_copy(line + (j + i__ * 3 - 4) * 15, line + (j + igeo[j +
i__ * 3 - 4] * 3 - 4) * 15, (ftnlen)15, (ftnlen)15);
}
/* L40: */
}
/* Writing concatenation */
i__2[0] = 2, a__1[0] = elemnt + (geokst_1.labels[i__ - 1] - 1 << 1);
i__2[1] = 8, a__1[1] = atomtx_1.txtatm + (i__ - 1 << 3);
i__2[2] = 2, a__1[2] = " ";
s_cat(blank, a__1, i__2, &c__3, (ftnlen)80);
if (geokst_1.labels[i__ - 1] == 99) {
*(unsigned char *)blank = ' ';
}
/* Computing MAX */
i__3 = 4, i__4 = maxtxt + 2;
j = max(i__3,i__4);
if (i__ == 1) {
io___17.ciunit = *iprt;
s_wsfe(&io___17);
do_fio(&c__1, blank, j);
e_wsfe();
} else if (i__ == 2) {
io___18.ciunit = *iprt;
s_wsfe(&io___18);
do_fio(&c__1, blank, j);
do_fio(&c__1, (char *)&geokst_1.na[i__ - 1], (ftnlen)sizeof(
integer));
do_fio(&c__1, line + (i__ * 3 - 3) * 15, (ftnlen)15);
e_wsfe();
} else if (i__ == 3) {
io___19.ciunit = *iprt;
s_wsfe(&io___19);
do_fio(&c__1, blank, j);
do_fio(&c__1, (char *)&geokst_1.na[i__ - 1], (ftnlen)sizeof(
integer));
do_fio(&c__1, line + (i__ * 3 - 3) * 15, (ftnlen)15);
do_fio(&c__1, (char *)&geokst_1.nb[i__ - 1], (ftnlen)sizeof(
integer));
do_fio(&c__1, line + (i__ * 3 - 2) * 15, (ftnlen)15);
e_wsfe();
} else {
l = 0;
io___21.ciunit = *iprt;
s_wsfe(&io___21);
do_fio(&c__1, blank, j);
do_fio(&c__1, (char *)&geokst_1.na[i__ - 1], (ftnlen)sizeof(
integer));
do_fio(&c__1, line + (i__ * 3 - 3) * 15, (ftnlen)15);
do_fio(&c__1, (char *)&geokst_1.nb[i__ - 1], (ftnlen)sizeof(
integer));
do_fio(&c__1, line + (i__ * 3 - 2) * 15, (ftnlen)15);
do_fio(&c__1, (char *)&geokst_1.nc[i__ - 1], (ftnlen)sizeof(
integer));
do_fio(&c__1, line + (i__ * 3 - 1) * 15, (ftnlen)15);
do_fio(&c__1, (char *)&l, (ftnlen)sizeof(integer));
e_wsfe();
}
/* L50: */
}
io___22.ciunit = *iprt;
s_wsle(&io___22);
e_wsle();
for (l = 1; l <= 3; ++l) {
i__1 = nopt;
for (i__ = 1; i__ <= i__1; ++i__) {
if (geovar_1.loc[(i__ << 1) - 1] == l) {
if (geovar_1.loc[(i__ << 1) - 1] != 1) {
io___23.ciunit = *iprt;
s_wsfe(&io___23);
do_fio(&c__1, optdat + (i__ - 1) * 14, (ftnlen)14);
d__1 = geom_1.geo[geovar_1.loc[(i__ << 1) - 1] +
geovar_1.loc[(i__ << 1) - 2] * 3 - 4] * degree;
do_fio(&c__1, (char *)&d__1, (ftnlen)sizeof(doublereal));
e_wsfe();
} else {
io___24.ciunit = *iprt;
s_wsfe(&io___24);
do_fio(&c__1, optdat + (i__ - 1) * 14, (ftnlen)14);
do_fio(&c__1, (char *)&geom_1.geo[geovar_1.loc[(i__ << 1)
- 1] + geovar_1.loc[(i__ << 1) - 2] * 3 - 4], (
ftnlen)sizeof(doublereal));
e_wsfe();
}
}
/* L60: */
}
/* L70: */
}
return 0;
} /* geoutg_ */
/* 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_ */
/* $Procedure COUNTC ( Count characters in a text file ) */
integer countc_(integer *unit, integer *bline, integer *eline, char *line,
ftnlen line_len)
{
/* System generated locals */
integer ret_val;
cilist ci__1;
alist al__1;
/* Builtin functions */
integer f_rew(alist *), s_rsfe(cilist *), do_fio(integer *, char *,
ftnlen), e_rsfe(void), s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
logical done;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer chars, linect;
extern integer lastnb_(char *, ftnlen);
extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_(
char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen);
integer iostat;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen), astrip_(
char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Count the characters in a group of lines in a text file. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* CHARACTERS */
/* FILES */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* UNIT I Logical unit connected to text file. */
/* BLINE I Beginning line number. */
/* ELINE I Ending line number. */
/* LINE I,O Workspace. */
/* COUNTC returns the number of characters. */
/* $ Detailed_Input */
/* UNIT is a logical unit that has been connected to a */
/* text file by the calling program. Use the routine */
/* TXTOPR to open the file for read access and get its */
/* logical unit. A text file is a formatted, */
/* sequential file that contains only printable */
/* characters: ASCII 32-126. */
/* BLINE, */
/* ELINE are line numbers in the text file. BLINE is */
/* the line where the count will begin, and ELINE */
/* is the line where the count will end. The */
/* number of characters in the beginning and ending */
/* lines are included in the total count. */
/* By convention, line 1 is the first line of the file. */
/* LINE on input, is an arbitrary character string whose */
/* contents are ignored. LINE is used to read lines */
/* from the file connected to UNIT; its function */
/* is to determine the maximum length of the lines */
/* that can be read from the file. Lines longer */
/* than the declared length of LINE are truncated */
/* as they are read. */
/* $ Detailed_Output */
/* LINE on output, is undefined. */
/* The function, COUNTC, returns the number of characters in the */
/* group of lines in the file beginning with BLINE and ending with */
/* ELINE. Trailing blanks on a line are not included in the count. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If an error occurs while reading from the input file, */
/* the error SPICE(FILEREADFAILED) is signalled. */
/* 2) If a non-printing ASCII character is encountered during */
/* the count, the error SPICE(INVALIDTEXT) is signalled. */
/* 3) If BLINE is greater than ELINE or if the file does not */
/* contain both of this lines, the error SPICE(CANNOTFINDGRP) */
/* is signalled. */
/* $ Files */
/* See argument UNIT. COUNTC rewinds the text file connected to */
/* UNIT and then steps through the file. The next read statement */
/* after calling COUNTC would return the line after ELINE. */
/* $ Particulars */
/* This routine counts characters in a group of lines in a text */
/* file. Using COUNTC, you can determine in advance how much space */
/* is required to store those characters. */
/* $ Examples */
/* The following code fragment opens an existing text file for */
/* read access and counts the characters that it contains in */
/* the first five lines. We'll assume that the longest line */
/* in the file is 80 characters. */
/* INTEGER COUNTC */
/* INTEGER UNIT */
/* INTEGER N */
/* CHARACTER*(80) LINE */
/* CALL TXTOPR ( 'DATA.TXT', UNIT ) */
/* N = COUNTC ( UNIT, 1, 5, LINE ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* J.E. McLean (JPL) */
/* H.A. Neilan (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */
/* Set the default function value to either 0, 0.0D0, .FALSE., */
/* or blank depending on the type of the function. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 05-APR-1991 (JEM) */
/* -& */
/* $ Index_Entries */
/* count characters in a text file */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
ret_val = 0;
return ret_val;
} else {
chkin_("COUNTC", (ftnlen)6);
ret_val = 0;
}
/* First, see if the line numbers make sense. */
if (*bline > *eline || *bline <= 0) {
setmsg_("The line numbers do not make sense: BLINE = # and ELINE ="
" #.", (ftnlen)62);
errint_("#", bline, (ftnlen)1);
errint_("#", eline, (ftnlen)1);
sigerr_("SPICE(CANNOTFINDGRP)", (ftnlen)20);
chkout_("COUNTC", (ftnlen)6);
return ret_val;
}
/* Read through the file, line by line, beginning with the first */
/* line in the file, checking for I/O errors, and counting */
/* characters in the lines between and including BLINE and ELINE. */
al__1.aerr = 0;
al__1.aunit = *unit;
f_rew(&al__1);
linect = 0;
chars = 0;
done = FALSE_;
while(! done) {
ci__1.cierr = 1;
ci__1.ciend = 1;
ci__1.ciunit = *unit;
ci__1.cifmt = "(A)";
iostat = s_rsfe(&ci__1);
if (iostat != 0) {
goto L100001;
}
iostat = do_fio(&c__1, line, line_len);
if (iostat != 0) {
goto L100001;
}
iostat = e_rsfe();
L100001:
/* An end-of-file condition is indicated by a negative value */
/* for IOSTAT. Any other non-zero value indicates some other */
/* error. If IOSTAT is zero, the read was successful. */
if (iostat > 0) {
setmsg_("Error reading text file named FILENAME.The value of IOS"
"TAT is #.", (ftnlen)64);
errint_("#", &iostat, (ftnlen)1);
errfnm_("FILENAME", unit, (ftnlen)8);
sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21);
chkout_("COUNTC", (ftnlen)6);
return ret_val;
} else if (iostat < 0) {
setmsg_("Reached end of file unexpectedly at line # in file FILE"
". BLINE = # and ELINE = #.", (ftnlen)82);
errint_("#", &linect, (ftnlen)1);
errint_("#", bline, (ftnlen)1);
errint_("#", eline, (ftnlen)1);
errfnm_("FILE", unit, (ftnlen)4);
sigerr_("SPICE(CANNOTFINDGRP)", (ftnlen)20);
chkout_("COUNTC", (ftnlen)6);
return ret_val;
} else {
/* We've read a line successfully, so add it to the line count. */
/* If this line is in the group delimited by BLINE and ELINE, */
/* count the characters in it, and if this line is ELINE, we're */
/* done. */
++linect;
if (linect >= *bline && linect <= *eline) {
/* Add the number of characters in this line to the count. */
/* If LINE is blank, LASTNB will return 0 which is just */
/* what we want. */
chars += lastnb_(line, line_len);
/* Remove the printable characters from the line. If */
/* any characters remain, signal an error. */
astrip_(line, " ", "~", line, line_len, (ftnlen)1, (ftnlen)1,
line_len);
if (s_cmp(line, " ", line_len, (ftnlen)1) != 0) {
setmsg_("Non-printing ASCII characters were found when c"
"ounting characters on line number # in file FILE"
"NAME.", (ftnlen)100);
errint_("#", &linect, (ftnlen)1);
errfnm_("FILENAME", unit, (ftnlen)8);
sigerr_("SPICE(INVALIDTEXT)", (ftnlen)18);
chkout_("COUNTC", (ftnlen)6);
return ret_val;
}
}
if (linect == *eline) {
done = TRUE_;
}
}
}
/* Assign the final character count. */
ret_val = chars;
chkout_("COUNTC", (ftnlen)6);
return ret_val;
} /* countc_ */
/* 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_ */
/* ----------------------------------------------------------------------- */
/* Main program */ int MAIN__(void)
{
/* System generated locals */
address a__1[7];
integer i__1, i__2[7], i__3, i__4;
alist al__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void),
s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(void);
/* Subroutine */ int s_stop(char *, ftnlen);
integer f_rew(alist *), s_wsfe(cilist *), e_wsfe(void), s_wsfi(icilist *),
e_wsfi(void);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
static integer i__, l, m, ld;
static char cmd[4];
static integer irc;
static real data[6];
static integer leng;
static char line[72];
static integer nred, nmem, ipos, kpos, iout;
static char type__[1];
static real work[300000];
static integer ldata;
static char aleng[6];
extern /* Subroutine */ int pdsin_(char *, char *, real *, integer *,
integer *, integer *, ftnlen, ftnlen);
static integer iomls, iotxt;
extern /* Subroutine */ int setli1_(char *, integer *, real *, integer *,
ftnlen), setli2_(char *, integer *, real *, integer *, ftnlen),
setli3_(char *, integer *, real *, integer *, ftnlen);
static char member[8], dirnam[72], memnam[8*4000];
extern /* Subroutine */ int setlin_(char *, integer *, real *, ftnlen),
memlst_(integer *, integer *, char *, ftnlen), uioset_(void),
txtlin_(integer *, integer *);
/* Fortran I/O blocks */
static cilist io___7 = { 0, 5, 0, "(A72)", 0 };
static cilist io___9 = { 0, 6, 0, 0, 0 };
static cilist io___10 = { 0, 6, 0, 0, 0 };
static cilist io___11 = { 0, 6, 0, 0, 0 };
static cilist io___13 = { 0, 0, 0, "(A72)", 0 };
static cilist io___16 = { 0, 6, 0, 0, 0 };
static cilist io___22 = { 0, 6, 0, 0, 0 };
static cilist io___23 = { 0, 6, 0, 0, 0 };
static cilist io___24 = { 0, 6, 0, 0, 0 };
static icilist io___26 = { 0, aleng, 0, "(I6)", 6, 1 };
static cilist io___27 = { 0, 0, 0, "(A72)", 0 };
static cilist io___35 = { 0, 0, 0, "(A72)", 0 };
static cilist io___36 = { 0, 0, 0, "(A72)", 0 };
static cilist io___37 = { 0, 0, 0, 0, 0 };
static cilist io___38 = { 0, 0, 0, 0, 0 };
static cilist io___39 = { 0, 0, 0, 0, 0 };
/* ----- IO DEVICE */
/* IOTXT : TEXT PDS (WRITE) */
/* IOMLS : MEMBER LIST (READ) */
/* IOUT : STANDARD OUTPUT (WRITE) */
/* 49 : DEVICE FOR PDS MEMBER, INTERNALLY OPENED AND CLOSED (READ) */
/* 5 : STANDARD INPUT FOR DIRECTORY NAME OF PDS FILE */
uioset_();
iotxt = 10;
iomls = 11;
iout = 6;
nred = 0;
s_copy(cmd, "*PUT", (ftnlen)4, (ftnlen)4);
*(unsigned char *)type__ = 'N';
/* ******************** */
/* READ INPUT DATA * */
/* ******************** */
/* DIRNAM : FULL NAME OF DIRECTORY FOR PDS */
/* EX:/DG05/UFS02/J9347/SRAC95/LIB/PDS/PFAST/PFASTJ2 */
s_rsfe(&io___7);
do_fio(&c__1, dirnam, (ftnlen)72);
e_rsfe();
if (*(unsigned char *)dirnam == ' ') {
s_wsle(&io___9);
do_lio(&c__9, &c__1, " ERROR(MAIN) : DIRECTORY NAME IS INVALID", (
ftnlen)40);
e_wsle();
s_wsle(&io___10);
do_lio(&c__9, &c__1, " THE FIRST COLUMN SHOULD BE NON-BLANK", (ftnlen)
37);
e_wsle();
s_wsle(&io___11);
do_lio(&c__9, &c__1, " DIRNAM = ", (ftnlen)10);
do_lio(&c__9, &c__1, dirnam, (ftnlen)72);
e_wsle();
s_stop("", (ftnlen)0);
}
/* ************************ */
/* WRITE HEADER IN TEXT * */
/* ************************ */
al__1.aerr = 0;
al__1.aunit = iotxt;
f_rew(&al__1);
s_copy(line, " 3 PDSEDT INPUT R/W MODE ", (ftnlen)72, (ftnlen)34)
;
io___13.ciunit = iotxt;
s_wsfe(&io___13);
do_fio(&c__1, line, (ftnlen)72);
e_wsfe();
/* ******************** */
/* READ MEMBER LIST * */
/* ******************** */
memlst_(&iomls, &nmem, memnam, (ftnlen)8);
if (nmem > 4000) {
s_wsle(&io___16);
do_lio(&c__9, &c__1, " ERROR (MAIN) : MAX OF MEMBER(MAXME=", (ftnlen)
36);
do_lio(&c__3, &c__1, (char *)&c__4000, (ftnlen)sizeof(integer));
do_lio(&c__9, &c__1, ") IS LESS THAN REQUIRED SIZE(=", (ftnlen)30);
do_lio(&c__3, &c__1, (char *)&nmem, (ftnlen)sizeof(integer));
e_wsle();
s_stop("", (ftnlen)0);
}
/* ******************** */
/* LOOP ON MEMBER * */
/* ******************** */
i__1 = nmem;
for (m = 1; m <= i__1; ++m) {
s_copy(member, memnam + (m - 1 << 3), (ftnlen)8, (ftnlen)8);
setdt_1.ntnuc1 = 0;
setdt_1.ntnuc2 = 0;
setdt_1.nzon2 = 0;
setdt_1.nzon3 = 0;
/* *************************** */
/* READ CONTENTS OF MEMBER * */
/* *************************** */
pdsin_(dirnam, member, work, &leng, &irc, &iout, (ftnlen)72, (ftnlen)
8);
if (irc != 0) {
s_wsle(&io___22);
do_lio(&c__9, &c__1, " PDS ERROR : ERROR CODE = ", (ftnlen)26);
do_lio(&c__3, &c__1, (char *)&irc, (ftnlen)sizeof(integer));
e_wsle();
s_wsle(&io___23);
do_lio(&c__9, &c__1, " MEMBER = ", (ftnlen)10);
do_lio(&c__9, &c__1, member, (ftnlen)8);
e_wsle();
s_stop("", (ftnlen)0);
} else {
++nred;
}
if (leng > 300000) {
s_wsle(&io___24);
do_lio(&c__9, &c__1, " ERROR (MAIN) : WORK AREA(MAXWK=", (ftnlen)
32);
do_lio(&c__3, &c__1, (char *)&c_b48, (ftnlen)sizeof(integer));
do_lio(&c__9, &c__1, ") IS LESS THAN REQUIRED SIZE(=", (ftnlen)30)
;
do_lio(&c__3, &c__1, (char *)&leng, (ftnlen)sizeof(integer));
do_lio(&c__9, &c__1, " IN MEMBER:", (ftnlen)11);
do_lio(&c__9, &c__1, member, (ftnlen)8);
e_wsle();
s_stop("", (ftnlen)0);
}
/* ***************** */
/* WRITE IN TEXT * */
/* ***************** */
/* ----- WRITE MEMBER NAME AND LENGTH */
s_wsfi(&io___26);
do_fio(&c__1, (char *)&leng, (ftnlen)sizeof(integer));
e_wsfi();
/* Writing concatenation */
i__2[0] = 4, a__1[0] = cmd;
i__2[1] = 1, a__1[1] = " ";
i__2[2] = 8, a__1[2] = member;
i__2[3] = 1, a__1[3] = " ";
i__2[4] = 1, a__1[4] = type__;
i__2[5] = 1, a__1[5] = " ";
i__2[6] = 6, a__1[6] = aleng;
s_cat(line, a__1, i__2, &c__7, (ftnlen)72);
io___27.ciunit = iotxt;
s_wsfe(&io___27);
do_fio(&c__1, line, (ftnlen)72);
e_wsfe();
/* ----- SET NUMBER OF LINES TO WRITE IN TEXT FOR DATA OF A MEMBER */
txtlin_(&leng, &ldata);
/* ----- SET LINE DATA AND WRITE IN TEXT */
i__3 = ldata;
for (l = 1; l <= i__3; ++l) {
kpos = (l - 1) * 6 + 1;
if (l != ldata) {
ld = 6;
} else {
ld = leng - (ldata - 1) * 6;
}
i__4 = ld;
for (i__ = 1; i__ <= i__4; ++i__) {
ipos = (l - 1) * 6 + i__;
data[i__ - 1] = work[ipos - 1];
/* L110: */
}
if (s_cmp(member + 4, "DN", (ftnlen)2, (ftnlen)2) == 0 && *(
unsigned char *)&member[7] == 'T') {
setli1_(line, &ld, data, &kpos, (ftnlen)72);
} else if (s_cmp(member + 4, "BNUP", (ftnlen)4, (ftnlen)4) == 0) {
setli2_(line, &ld, data, &kpos, (ftnlen)72);
} else if (s_cmp(member + 4, "REST", (ftnlen)4, (ftnlen)4) == 0) {
setli3_(line, &ld, data, &kpos, (ftnlen)72);
} else {
setlin_(line, &ld, data, (ftnlen)72);
}
io___35.ciunit = iotxt;
s_wsfe(&io___35);
do_fio(&c__1, line, (ftnlen)72);
e_wsfe();
/* L100: */
}
/* L1000: */
}
/* *********** */
/* FINISH * */
/* *********** */
s_copy(line, "*FIN", (ftnlen)72, (ftnlen)4);
io___36.ciunit = iotxt;
s_wsfe(&io___36);
do_fio(&c__1, line, (ftnlen)72);
e_wsfe();
io___37.ciunit = iout;
s_wsle(&io___37);
e_wsle();
io___38.ciunit = iout;
s_wsle(&io___38);
do_lio(&c__9, &c__1, " NUMBER OF MEMBERS READ FROM PDS=", (ftnlen)33);
do_lio(&c__3, &c__1, (char *)&nred, (ftnlen)sizeof(integer));
e_wsle();
io___39.ciunit = iout;
s_wsle(&io___39);
do_lio(&c__9, &c__1, " ********** JOB END **********", (ftnlen)30);
e_wsle();
s_stop("", (ftnlen)0);
return 0;
} /* MAIN__ */
