/* drcout.f -- translated by f2c (version 19950314). You must link the resulting object file with the libraries: -lF77 -lI77 -lm (in that order) */ #include "f2c.h" /* Common Block Declarations */ struct { char argz[512]; } argz_; #define argz_1 argz_ struct { char keywrd[80]; } keywrd_; #define keywrd_1 keywrd_ struct { integer natoms, labels[86], na[86], nb[86], nc[86]; } geokst_; #define geokst_1 geokst_ struct { char elemnt[214]; } elemts_; #define elemts_1 elemts_ struct { integer iivar, loc[516] /* was [2][258] */, idumy; doublereal xparam[258]; } geovar_; #define geovar_1 geovar_ struct { char koment[80], title[80]; } titles_; #define titles_1 titles_ struct { integer numat, nat[86], nfirst[86], nmidle[86], nlast[86], norbs, nelecs, nalpha, nbeta, nclose, nopen, ndumy; doublereal xract; } molkst_; #define molkst_1 molkst_ /* Table of constant values */ static integer c__1 = 1; static integer c__9 = 9; static integer c__2 = 2; /* Subroutine */ int drcout_(doublereal *xyz3, doublereal *geo3, doublereal * vel3, integer *nvar, doublereal *time, doublereal *escf3, doublereal * ekin3, doublereal *gtot3, doublereal *etot3, doublereal *xtot3, integer *iloop, doublereal *charge, doublereal *fract, char *text1, char *text2, integer *ii, integer *jloop, ftnlen text1_len, ftnlen text2_len) { /* Initialized data */ static logical first = TRUE_; /* System generated locals */ address a__1[2]; integer i__1, i__2[2]; doublereal d__1, d__2; char ch__1[3]; /* Builtin functions */ integer i_indx(char *, char *, ftnlen, ftnlen), s_wsfe(cilist *), e_wsfe( void), do_fio(integer *, char *, ftnlen), s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), e_wsle(void); /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); /* Local variables */ static doublereal escf, ekin; static integer ivar, lmax; static doublereal etot, gtot, xtot; static integer i, j, k, l; static char alpha[2]; static logical large; static doublereal gg[3]; static integer ll, lu, prtkom, prtitl, prtkey; static logical drc; static doublereal vel[258] /* was [3][86] */, xyz[258] /* was [3][86] */; static integer iel1[3]; /* Fortran I/O blocks */ static cilist io___8 = { 0, 6, 0, "(//,' FEMTOSECONDS POINT POTENTIAL " "+' ,' KINETIC = TOTAL ERROR REF%')", 0 }; static cilist io___9 = { 0, 6, 0, "(//,' POINT POTENTIAL + ' " " ,'ENERGY LOST = TOTAL ERROR REF%')", 0 }; static cilist io___10 = { 0, 6, 0, "(//,' FEMTOSECONDS POINT POTENTIAL" " +' ,' KINETIC = TOTAL ERROR REF')", 0 }; static cilist io___11 = { 0, 6, 0, "(//,' POINT POTENTIAL + ' " " ,'ENERGY LOST = TOTAL ERROR REF')", 0 }; static cilist io___17 = { 0, 6, 0, "(F10.3,I8,F12.5,F11.5,F11.5, " " F10.5,' ',I5,3X,'%',A,A,I3)", 0 }; static cilist io___18 = { 0, 6, 0, "(9X,A,F9.4,A)", 0 }; static cilist io___19 = { 0, 6, 0, "(I8,F14.5,F13.5,F17.5, " " F10.5,' ',I5,3X,'%',A,A,I3)", 0 }; static cilist io___20 = { 0, 6, 0, "(9X,A,F9.4,A)", 0 }; static cilist io___21 = { 0, 6, 0, "(F10.3,I8,F12.5,F11.5,F11.5, " " F10.5,' ',I5,3X,'%',A,A,I3)", 0 }; static cilist io___22 = { 0, 6, 0, "(9X,A,F9.4,A)", 0 }; static cilist io___23 = { 0, 6, 0, "(I8,F14.5,F13.5,F17.5, " " F10.5,' ',I5,3X,'%',A,A,I3)", 0 }; static cilist io___24 = { 0, 6, 0, "(9X,A,F9.4,A)", 0 }; static cilist io___29 = { 0, 6, 0, 0, 0 }; static cilist io___30 = { 0, 6, 0, 0, 0 }; static cilist io___33 = { 0, 6, 0, "(I4,3X,A2,3F11.5,2X,3F11.1)", 0 }; static cilist io___35 = { 0, 6, 0, "(//10X,'FINAL GEOMETRY OBTAINED',33X" ",'CHARGE')", 0 }; static cilist io___36 = { 0, 6, 0, "(A)", 0 }; static cilist io___41 = { 0, 6, 0, "(2X,A2,3(F12.6,I3),I4,2I3,F13.4,I5,A)" , 0 }; static cilist io___43 = { 0, 6, 0, "(2X,A2,3(F12.6,I3),I4,2I3,13X,I5,A)", 0 }; /* COMDECK SIZES */ /************************************************************************ ****/ /* THIS FILE CONTAINS ALL THE ARRAY SIZES FOR USE IN MOPAC. **/ /* **/ /* THERE ARE ONLY PARAMETERS THAT THE PROGRAMMER NEED SET: **/ /* MAXHEV = MAXIMUM NUMBER OF HEAVY ATOMS (HEAVY: NON-HYDROGEN ATOMS) **/ /* MAXLIT = MAXIMUM NUMBER OF HYDROGEN ATOMS. **/ /* MAXTIM = DEFAULT TIME FOR A JOB. (SECONDS) **/ /* MAXDMP = DEFAULT TIME FOR AUTOMATIC RESTART FILE GENERATION (SECS) **/ /* **/ /* **/ /************************************************************************ ****/ /* **/ /* THE FOLLOWING CODE DOES NOT NEED TO BE ALTERED BY THE PROGRAMMER **/ /* **/ /************************************************************************ ****/ /* **/ /* ALL OTHER PARAMETERS ARE DERIVED FUNCTIONS OF THESE TWO PARAMETERS **/ /* **/ /* NAME DEFINITION **/ /* NUMATM MAXIMUM NUMBER OF ATOMS ALLOWED. **/ /* MAXORB MAXIMUM NUMBER OF ORBITALS ALLOWED. **/ /* MAXPAR MAXIMUM NUMBER OF PARAMETERS FOR OPTIMISATION. **/ /* N2ELEC MAXIMUM NUMBER OF TWO ELECTRON INTEGRALS ALLOWED. **/ /* MPACK AREA OF LOWER HALF TRIANGLE OF DENSITY MATRIX. **/ /* MORB2 SQUARE OF THE MAXIMUM NUMBER OF ORBITALS ALLOWED. **/ /* MAXHES AREA OF HESSIAN MATRIX **/ /************************************************************************ ****/ /************************************************************************ ****/ /* FOR SHORT VERSION USE LINE WITH NMECI=1, FOR LONG VERSION USE LINE **/ /* WITH NMECI=10 **/ /************************************************************************ ****/ /* PARAMETER (NMECI=1, NPULAY=1) */ /************************************************************************ ****/ /* DECK MOPAC */ /* next line added for Unix implementation for command line arguments */ /* ************************************************************ */ /* * */ /* DRCOUT PRINTS THE GEOMETRY, ETC. FOR A DRC AT A * */ /* POSITION DETERMINED BY FRACT. * */ /* ON INPUT XYZ3 = QUADRATIC EXPRESSION FOR THE GEOMETRY * */ /* VEL3 = QUADRATIC EXPRESSION FOR THE VELOCITY * */ /* ESCF3 = QUADRATIC EXPRESSION FOR THE P.E. * */ /* EKIN3 = QUADRATIC EXPRESSION FOR THE K.E. * */ /* * */ /* ************************************************************ */ /* Parameter adjustments */ geo3 -= 4; vel3 -= 4; xyz3 -= 4; --escf3; --ekin3; --gtot3; --etot3; --xtot3; --charge; /* Function Body */ if (first) { if (i_indx(keywrd_1.keywrd, "REST", 80L, 4L) == 0 || i_indx( keywrd_1.keywrd, "IRC=", 80L, 4L) != 0) { *jloop = 0; } first = FALSE_; for (i = 80; i >= 1; --i) { /* L10: */ if (*(unsigned char *)&keywrd_1.keywrd[i - 1] != ' ') { goto L20; } } i = 1; L20: prtkey = i; for (i = 80; i >= 1; --i) { /* L30: */ if (*(unsigned char *)&titles_1.koment[i - 1] != ' ') { goto L40; } } i = 1; L40: prtkom = i; for (i = 80; i >= 1; --i) { /* L50: */ if (*(unsigned char *)&titles_1.title[i - 1] != ' ') { goto L60; } } i = 1; L60: prtitl = i; drc = i_indx(keywrd_1.keywrd, "DRC", 80L, 3L) != 0; large = i_indx(keywrd_1.keywrd, "LARGE", 80L, 5L) != 0; if (drc) { s_wsfe(&io___8); e_wsfe(); } else { s_wsfe(&io___9); e_wsfe(); } } else { if (drc) { s_wsfe(&io___10); e_wsfe(); } else { s_wsfe(&io___11); e_wsfe(); } } ++(*jloop); /* # FRACT=0.D0 */ /* Computing 2nd power */ d__1 = *fract; escf = escf3[1] + escf3[2] * *fract + escf3[3] * (d__1 * d__1); /* Computing 2nd power */ d__1 = *fract; ekin = ekin3[1] + ekin3[2] * *fract + ekin3[3] * (d__1 * d__1); /* Computing 2nd power */ d__1 = *fract; etot = etot3[1] + etot3[2] * *fract + etot3[3] * (d__1 * d__1); /* Computing 2nd power */ d__1 = *fract; gtot = gtot3[1] + gtot3[2] * *fract + gtot3[3] * (d__1 * d__1); /* Computing 2nd power */ d__1 = *fract; xtot = xtot3[1] + xtot3[2] * *fract + xtot3[3] * (d__1 * d__1); if (*ii != 0) { if (drc) { s_wsfe(&io___17); do_fio(&c__1, (char *)&(*time), (ftnlen)sizeof(doublereal)); i__1 = *iloop - 2; do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&escf, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&ekin, (ftnlen)sizeof(doublereal)); d__1 = escf + ekin; do_fio(&c__1, (char *)&d__1, (ftnlen)sizeof(doublereal)); d__2 = escf + ekin - etot; do_fio(&c__1, (char *)&d__2, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&(*jloop), (ftnlen)sizeof(integer)); do_fio(&c__1, text1, 3L); do_fio(&c__1, text2, 2L); do_fio(&c__1, (char *)&(*ii), (ftnlen)sizeof(integer)); e_wsfe(); s_wsfe(&io___18); do_fio(&c__1, " MOVEMENT FROM START =", 22L); do_fio(&c__1, (char *)&xtot, (ftnlen)sizeof(doublereal)); do_fio(&c__1, " ANGSTROMS", 10L); e_wsfe(); } else { s_wsfe(&io___19); i__1 = *iloop - 2; do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&escf, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&ekin, (ftnlen)sizeof(doublereal)); d__1 = escf + ekin; do_fio(&c__1, (char *)&d__1, (ftnlen)sizeof(doublereal)); d__2 = escf + ekin - etot; do_fio(&c__1, (char *)&d__2, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&(*jloop), (ftnlen)sizeof(integer)); do_fio(&c__1, text1, 3L); do_fio(&c__1, text2, 2L); do_fio(&c__1, (char *)&(*ii), (ftnlen)sizeof(integer)); e_wsfe(); /* # WRITE(6,'(24X,'' INTEGRATED GRADIENT ERROR ='',G10.3, */ /* # 1'' KCALS/ANGSTROM'')')GTOT */ s_wsfe(&io___20); do_fio(&c__1, " MOVEMENT FROM START =", 22L); do_fio(&c__1, (char *)&xtot, (ftnlen)sizeof(doublereal)); do_fio(&c__1, " ANGSTROMS", 10L); e_wsfe(); } } else { if (drc) { s_wsfe(&io___21); do_fio(&c__1, (char *)&(*time), (ftnlen)sizeof(doublereal)); i__1 = *iloop - 2; do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&escf, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&ekin, (ftnlen)sizeof(doublereal)); d__1 = escf + ekin; do_fio(&c__1, (char *)&d__1, (ftnlen)sizeof(doublereal)); d__2 = escf + ekin - etot; do_fio(&c__1, (char *)&d__2, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&(*jloop), (ftnlen)sizeof(integer)); do_fio(&c__1, text1, 3L); do_fio(&c__1, text2, 2L); e_wsfe(); s_wsfe(&io___22); do_fio(&c__1, " MOVEMENT FROM START =", 22L); do_fio(&c__1, (char *)&xtot, (ftnlen)sizeof(doublereal)); do_fio(&c__1, " ANGSTROMS", 10L); e_wsfe(); } else { s_wsfe(&io___23); i__1 = *iloop - 2; do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&escf, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&ekin, (ftnlen)sizeof(doublereal)); d__1 = escf + ekin; do_fio(&c__1, (char *)&d__1, (ftnlen)sizeof(doublereal)); d__2 = escf + ekin - etot; do_fio(&c__1, (char *)&d__2, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&(*jloop), (ftnlen)sizeof(integer)); do_fio(&c__1, text1, 3L); do_fio(&c__1, text2, 2L); e_wsfe(); /* # WRITE(6,'(24X,'' INTEGRATED GRADIENT ERROR ='',F10.5, */ /* # 1'' KCALS/ANGSTROM'')')GTOT */ s_wsfe(&io___24); do_fio(&c__1, " MOVEMENT FROM START =", 22L); do_fio(&c__1, (char *)&xtot, (ftnlen)sizeof(doublereal)); do_fio(&c__1, " ANGSTROMS", 10L); e_wsfe(); } } geokst_1.natoms = *nvar / 3; l = 0; i__1 = geokst_1.natoms; for (i = 1; i <= i__1; ++i) { for (j = 1; j <= 3; ++j) { ++l; /* Computing 2nd power */ d__1 = *fract; vel[j + i * 3 - 4] = vel3[l * 3 + 1] + vel3[l * 3 + 2] * *fract + vel3[l * 3 + 3] * (d__1 * d__1); /* L70: */ /* Computing 2nd power */ d__1 = *fract; xyz[j + i * 3 - 4] = xyz3[l * 3 + 1] + xyz3[l * 3 + 2] * *fract + xyz3[l * 3 + 3] * (d__1 * d__1); } /* L80: */ } if (large) { s_wsle(&io___29); do_lio(&c__9, &c__1, " CARTESIAN GEOMETRY V" "ELOCITY (IN CM/SEC)", 65L); e_wsle(); s_wsle(&io___30); do_lio(&c__9, &c__1, " ATOM X Y Z " " X Y Z", 76L); e_wsle(); i__1 = molkst_1.numat; for (i = 1; i <= i__1; ++i) { ll = (i - 1) * 3 + 1; lu = ll + 2; s_wsfe(&io___33); do_fio(&c__1, (char *)&i, (ftnlen)sizeof(integer)); do_fio(&c__1, elemts_1.elemnt + (molkst_1.nat[i - 1] - 1 << 1), 2L); for (j = 1; j <= 3; ++j) { do_fio(&c__1, (char *)&xyz[j + i * 3 - 4], (ftnlen)sizeof( doublereal)); } for (j = 1; j <= 3; ++j) { do_fio(&c__1, (char *)&vel[j + i * 3 - 4], (ftnlen)sizeof( doublereal)); } e_wsfe(); /* L90: */ } } ivar = 1; geokst_1.na[0] = 0; l = 0; s_wsfe(&io___35); e_wsfe(); s_wsfe(&io___36); do_fio(&c__1, keywrd_1.keywrd, prtkey); do_fio(&c__1, titles_1.koment, prtkom); do_fio(&c__1, titles_1.title, prtitl); e_wsfe(); lmax = l; l = 0; i__1 = molkst_1.numat; for (i = 1; i <= i__1; ++i) { j = i / 26; *(unsigned char *)alpha = (char) ('A' + j); j = i - j * 26; *(unsigned char *)&alpha[1] = (char) ('A' + j - 1); for (j = 1; j <= 3; ++j) { /* L100: */ iel1[j - 1] = 0; } L110: if (geovar_1.loc[(ivar << 1) - 2] == i) { iel1[geovar_1.loc[(ivar << 1) - 1] - 1] = 1; ++ivar; goto L110; } if (i < 4) { iel1[2] = 0; if (i < 3) { iel1[1] = 0; if (i < 2) { iel1[0] = 0; } } } if (geokst_1.labels[i - 1] < 99) { ++l; /* Computing 2nd power */ d__1 = *fract; gg[0] = geo3[(i * 3 - 2) * 3 + 1] + geo3[(i * 3 - 2) * 3 + 2] * * fract + geo3[(i * 3 - 2) * 3 + 3] * (d__1 * d__1); /* Computing 2nd power */ d__1 = *fract; gg[1] = geo3[(i * 3 - 1) * 3 + 1] + geo3[(i * 3 - 1) * 3 + 2] * * fract + geo3[(i * 3 - 1) * 3 + 3] * (d__1 * d__1); /* Computing 2nd power */ d__1 = *fract; gg[2] = geo3[i * 9 + 1] + geo3[i * 9 + 2] * *fract + geo3[i * 9 + 3] * (d__1 * d__1); s_wsfe(&io___41); do_fio(&c__1, elemts_1.elemnt + (geokst_1.labels[i - 1] - 1 << 1), 2L); for (k = 1; k <= 3; ++k) { do_fio(&c__1, (char *)&gg[k - 1], (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&iel1[k - 1], (ftnlen)sizeof(integer)); } do_fio(&c__1, (char *)&geokst_1.na[i - 1], (ftnlen)sizeof(integer) ); do_fio(&c__1, (char *)&geokst_1.nb[i - 1], (ftnlen)sizeof(integer) ); do_fio(&c__1, (char *)&geokst_1.nc[i - 1], (ftnlen)sizeof(integer) ); do_fio(&c__1, (char *)&charge[l], (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&(*jloop), (ftnlen)sizeof(integer)); /* Writing concatenation */ i__2[0] = 2, a__1[0] = alpha; i__2[1] = 1, a__1[1] = "*"; s_cat(ch__1, a__1, i__2, &c__2, 3L); do_fio(&c__1, ch__1, 3L); e_wsfe(); } else { s_wsfe(&io___43); do_fio(&c__1, elemts_1.elemnt + (geokst_1.labels[i - 1] - 1 << 1), 2L); for (k = 1; k <= 3; ++k) { do_fio(&c__1, (char *)&gg[k - 1], (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&iel1[k - 1], (ftnlen)sizeof(integer)); } do_fio(&c__1, (char *)&geokst_1.na[i - 1], (ftnlen)sizeof(integer) ); do_fio(&c__1, (char *)&geokst_1.nb[i - 1], (ftnlen)sizeof(integer) ); do_fio(&c__1, (char *)&geokst_1.nc[i - 1], (ftnlen)sizeof(integer) ); do_fio(&c__1, (char *)&(*jloop), (ftnlen)sizeof(integer)); /* Writing concatenation */ i__2[0] = 2, a__1[0] = alpha; i__2[1] = 1, a__1[1] = "%"; s_cat(ch__1, a__1, i__2, &c__2, 3L); do_fio(&c__1, ch__1, 3L); e_wsfe(); } /* L120: */ } geokst_1.na[0] = 99; return 0; } /* drcout_ */