/* bonds.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 { integer numat, nat[86], nfirst[86], nmidle[86], nlast[86], norbs, nelecs, nalpha, nbeta, nclose, nopen, ndumy; doublereal fract; } molkst_; #define molkst_1 molkst_ struct { doublereal b[46225] /* was [215][215] */, bondab[20339]; } scrach_; #define scrach_1 scrach_ /* Table of constant values */ static integer c__20339 = 20339; static integer c__1 = 1; /* Subroutine */ int bonds_(doublereal *p) { /* Format strings */ static char fmt_10[] = "(//20x,\002BOND ORDERS AND VALENCIES\002,//)"; /* System generated locals */ integer i__1, i__2, i__3, i__4; /* Builtin functions */ integer s_wsfe(cilist *), e_wsfe(void); /* Local variables */ static integer i, j, k, l; static doublereal x; static integer ih, ij, kk, il, ll; extern /* Subroutine */ int mpcbds_(doublereal *, integer *, integer *), vecprt_(doublereal *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 6, 0, fmt_10, 0 }; /* THIS SUBROUTINE WAS MODIFIED BY VIC L. TO ADD A CALL TO */ /* SUBROUTINE MPC_BONDS. THIS SUBROUTINE WRITES OUT THE BOND */ /* INDICES TO THE SYBYL OUTPUT FILE *.SYB. (29JULY86) */ /* 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 */ /* *********************************************************************** */ /* CALCULATES, AND PRINTS, THE BOND INDICES AND VALENCIES OF ATOMS */ /* FOR REFERENCE, SEE "BOND INDICES AND VALENCY", J. C. S. DALTON, */ /* ARMSTRONG, D.R., PERKINS, P.G., AND STEWART, J.J.P., 838 (1973) */ /* ON INPUT */ /* P = DENSITY MATRIX, LOWER HALF TRIANGLE, PACKED. */ /* P IS NOT ALTERED BY BONDS. */ /* *********************************************************************** */ /* Parameter adjustments */ --p; /* Function Body */ s_wsfe(&io___1); e_wsfe(); k = 0; i__1 = molkst_1.norbs; for (i = 1; i <= i__1; ++i) { i__2 = i; for (j = 1; j <= i__2; ++j) { ++k; scrach_1.b[i + j * 215 - 216] = p[k]; /* L20: */ scrach_1.b[j + i * 215 - 216] = p[k]; } } ij = 0; i__2 = molkst_1.numat; for (i = 1; i <= i__2; ++i) { l = molkst_1.nfirst[i - 1]; ll = molkst_1.nlast[i - 1]; i__1 = i; for (j = 1; j <= i__1; ++j) { ++ij; k = molkst_1.nfirst[j - 1]; kk = molkst_1.nlast[j - 1]; x = 0.f; i__3 = ll; for (il = l; il <= i__3; ++il) { i__4 = kk; for (ih = k; ih <= i__4; ++ih) { /* L30: */ x += scrach_1.b[il + ih * 215 - 216] * scrach_1.b[il + ih * 215 - 216]; } } /* L40: */ scrach_1.bondab[ij - 1] = x; } x = -scrach_1.bondab[ij - 1]; i__1 = ll; for (j = l; j <= i__1; ++j) { /* L50: */ x += scrach_1.b[j + j * 215 - 216] * 2.; } scrach_1.bondab[ij - 1] = x; /* L60: */ } vecprt_(scrach_1.bondab, &molkst_1.numat); /* THIS SUBROUTINE CALL ADDED BY VIC L. TO WRITE OUT THE BOND INDICES */ /* TO THE SYBYL MOPAC OUTPUT FILE *.SYB. (29JULY86) */ /* SUBROUTINE MPC_BONDS IS IN MODULE WRITE.FOR. */ mpcbds_(scrach_1.bondab, &molkst_1.numat, &c__20339); return 0; } /* bonds_ */ /* Subroutine */ int mpcbds_(doublereal *bondab, integer *numat, integer * natms2) { /* System generated locals */ integer i__1, i__2, i__3; /* Builtin functions */ integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Local variables */ static integer indf, inds, i, j, ithree; /* Fortran I/O blocks */ static cilist io___13 = { 1, 16, 0, "(I4)", 0 }; static cilist io___17 = { 1, 16, 0, "(10F8.4)", 0 }; static cilist io___19 = { 0, 6, 0, "(A)", 0 }; static cilist io___20 = { 0, 6, 0, "(A)", 0 }; /* THIS SUBROUTINE IS CALLED FROM SUBROUTINE BONDS(P). IT WRITES OUT */ /* THE BOND INDICES TO THE SYBYL OUTPUT FILE ASSIGNED TO LUN 16. */ /* ADDED BY VIC L. (29JULY86). */ /* Parameter adjustments */ --bondab; /* Function Body */ ithree = 3; i__1 = s_wsfe(&io___13); if (i__1 != 0) { goto L999; } i__1 = do_fio(&c__1, (char *)&ithree, (ftnlen)sizeof(integer)); if (i__1 != 0) { goto L999; } i__1 = e_wsfe(); if (i__1 != 0) { goto L999; } i__1 = *numat; for (i = 1; i <= i__1; ++i) { inds = i * (i - 1) / 2 + 1; indf = inds + i - 1; /* L10: */ i__2 = s_wsfe(&io___17); if (i__2 != 0) { goto L999; } i__3 = indf; for (j = inds; j <= i__3; ++j) { i__2 = do_fio(&c__1, (char *)&bondab[j], (ftnlen)sizeof( doublereal)); if (i__2 != 0) { goto L999; } } i__2 = e_wsfe(); if (i__2 != 0) { goto L999; } } return 0; L999: s_wsfe(&io___19); do_fio(&c__1, " Error Writing Bond Indices Output", 34L); e_wsfe(); return 0; /* L1000: */ s_wsfe(&io___20); do_fio(&c__1, "Error Opening Bond Indices Output File", 38L); e_wsfe(); return 0; } /* mpcbds_ */