/* matout.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 { char elemnt[214]; } elemts_; #define elemts_1 elemts_ /* Table of constant values */ static integer c__1 = 1; /* Subroutine */ int matout_(doublereal *a, doublereal *b, integer *nc, integer *nr, integer *ndim) { /* Initialized data */ static char atorbs[2*9] = " S" "PX" "PY" "PZ" "X2" "XZ" "Z2" "YZ" "XY"; /* Format strings */ static char fmt_100[] = "(////,3x,\002 ROOT NO.\002,i5,9i12)"; static char fmt_110[] = "(/8x,10f12.5)"; static char fmt_120[] = "(\002 \002)"; static char fmt_130[] = "(2(1x,a2),i4,f10.5,10f12.5)"; static char fmt_140[] = "(\0021\002)"; /* System generated locals */ integer a_dim1, a_offset, i__1, i__2; /* Builtin functions */ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void), s_cmp(char *, char *, ftnlen, ftnlen); /* Local variables */ static integer i, j, k, l, natom[215]; static char itext[2*215], jtext[2*215]; static integer ka, kb, kc, la, lc, lb, jhi, jlo; /* Fortran I/O blocks */ static cilist io___14 = { 0, 6, 0, fmt_100, 0 }; static cilist io___15 = { 0, 6, 0, fmt_110, 0 }; static cilist io___16 = { 0, 6, 0, fmt_120, 0 }; static cilist io___20 = { 0, 6, 0, fmt_120, 0 }; static cilist io___21 = { 0, 6, 0, fmt_130, 0 }; static cilist io___22 = { 0, 6, 0, fmt_140, 0 }; static cilist io___23 = { 0, 6, 0, fmt_140, 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 */ /* ********************************************************************** */ /* MATOUT PRINTS A SQUARE MATRIX OF EIGENVECTORS AND EIGENVALUES */ /* ON INPUT A CONTAINS THE MATRIX TO BE PRINTED. */ /* B CONTAINS THE EIGENVALUES. */ /* NC NUMBER OF MOLECULAR ORBITALS TO BE PRINTED. */ /* NR IS THE SIZE OF THE SQUARE ARRAY TO BE PRINTED. */ /* NDIM IS THE ACTUAL SIZE OF THE SQUARE ARRAY "A". */ /* NFIRST AND NLAST CONTAIN ATOM ORBITAL COUNTERS. */ /* NAT = ARRAY OF ATOMIC NUMBERS OF ATOMS. */ /* *********************************************************************** */ /* Parameter adjustments */ --b; a_dim1 = *ndim; a_offset = a_dim1 + 1; a -= a_offset; /* Function Body */ if (molkst_1.numat == 0) { goto L30; } if (molkst_1.nlast[molkst_1.numat - 1] != *nr) { goto L30; } i__1 = molkst_1.numat; for (i = 1; i <= i__1; ++i) { jlo = molkst_1.nfirst[i - 1]; jhi = molkst_1.nlast[i - 1]; l = molkst_1.nat[i - 1]; k = 0; i__2 = jhi; for (j = jlo; j <= i__2; ++j) { ++k; s_copy(itext + (j - 1 << 1), atorbs + (k - 1 << 1), 2L, 2L); s_copy(jtext + (j - 1 << 1), elemts_1.elemnt + (l - 1 << 1), 2L, 2L); natom[j - 1] = i; /* L10: */ } /* L20: */ } goto L50; L30: *nr = abs(*nr); i__1 = *nr; for (i = 1; i <= i__1; ++i) { s_copy(itext + (i - 1 << 1), " ", 2L, 2L); s_copy(jtext + (i - 1 << 1), " ", 2L, 2L); /* L40: */ natom[i - 1] = i; } L50: ka = 1; kc = 6; L60: kb = min(kc,*nc); s_wsfe(&io___14); i__1 = kb; for (i = ka; i <= i__1; ++i) { do_fio(&c__1, (char *)&i, (ftnlen)sizeof(integer)); } e_wsfe(); if (b[1] != 0.) { s_wsfe(&io___15); i__1 = kb; for (i = ka; i <= i__1; ++i) { do_fio(&c__1, (char *)&b[i], (ftnlen)sizeof(doublereal)); } e_wsfe(); } s_wsfe(&io___16); e_wsfe(); la = 1; lc = 40; L70: lb = min(lc,*nr); i__1 = lb; for (i = la; i <= i__1; ++i) { if (s_cmp(itext + (i - 1 << 1), " S", 2L, 2L) == 0) { s_wsfe(&io___20); e_wsfe(); } s_wsfe(&io___21); do_fio(&c__1, itext + (i - 1 << 1), 2L); do_fio(&c__1, jtext + (i - 1 << 1), 2L); do_fio(&c__1, (char *)&natom[i - 1], (ftnlen)sizeof(integer)); i__2 = kb; for (j = ka; j <= i__2; ++j) { do_fio(&c__1, (char *)&a[i + j * a_dim1], (ftnlen)sizeof( doublereal)); } e_wsfe(); /* L80: */ } if (lb == *nr) { goto L90; } la = lc + 1; lc += 40; s_wsfe(&io___22); e_wsfe(); goto L70; L90: if (kb == *nc) { return 0; } ka = kc + 1; kc += 6; if (*nr > 25) { s_wsfe(&io___23); e_wsfe(); } goto L60; } /* matout_ */