/* geout.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 { doublereal geo[258] /* was [3][86] */; } geom_; #define geom_1 geom_ struct { integer natoms, labels[86], na[86], nb[86], nc[86]; } geokst_; #define geokst_1 geokst_ struct { integer nvar, loc[516] /* was [2][258] */, idumy; doublereal xparam[258]; } geovar_; #define geovar_1 geovar_ struct { integer latom, lparam; doublereal react[200]; } path_; #define path_1 path_ struct { char elemnt[214]; } elemts_; #define elemts_1 elemts_ /* Table of constant values */ static doublereal c_b2 = 1.; static integer c__1 = 1; /* Subroutine */ int geout_(void) { /* Format strings */ static char fmt_20[] = "(/4x,\002ATOM\002,3x,\002CHEMICAL\002,2x,\002BON" "D LENGTH\002,4x,\002BOND ANGLE\002,4x,\002 TWIST ANGLE\002,/3x" ",\002NUMBER\002,2x,\002SYMBOL\002,4x,\002(ANGSTROMS)\002,5x,\002" "(DEGREES)\002,5x,\002 (DEGREES)\002,/4x,\002(I)\002,18x,\002NA:" "I\002,10x,\002NB:NA:I\002,5x,\002 NC:NB:NA:I\002,5x,\002NA\002,3" "x,\002NB\002,3x,\002NC\002,/)"; /* System generated locals */ integer i__1; /* Builtin functions */ integer s_wsfe(cilist *), e_wsfe(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer do_fio(integer *, char *, ftnlen); /* Local variables */ static logical cart; static integer i, j, n; static char q[1*3]; static doublereal w, x, coord[258] /* was [3][86] */; static integer ia; static doublereal degree; extern /* Subroutine */ int xyzint_(doublereal *, integer *, integer *, integer *, integer *, doublereal *, doublereal *); /* Fortran I/O blocks */ static cilist io___6 = { 0, 6, 0, fmt_20, 0 }; static cilist io___12 = { 0, 6, 0, "(3X,I4 ,5X,A2,F16.5,1X,A1,F15.5,1X,A" "1,F12.5,1X,A1,I5,2I5)", 0 }; static cilist io___13 = { 0, 6, 0, "(' 3',5X,A2,F16.5,1X,A1,F15.5,1" "X,A1,14X,2I5)", 0 }; static cilist io___14 = { 0, 6, 0, "(' 2',5X,A2,F16.5,1X,A1,31X,I5)", 0 }; static cilist io___15 = { 0, 6, 0, "(' 1',5X,A2)", 0 }; /* ********************************************************************* */ /* GEOUT PRINTS THE CURRENT GEOMETRY. IT CAN BE CALLED ANY TIME, */ /* FROM ANY POINT IN THE PROGRAM AND DOES NOT AFFECT ANYTHING. */ /* ********************************************************************* */ /* 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 */ /* *** OUTPUT THE PARAMETER DATA. */ cart = FALSE_; if (geokst_1.na[0] != 0) { cart = TRUE_; xyzint_(geom_1.geo, &geokst_1.natoms, geokst_1.na, geokst_1.nb, geokst_1.nc, &c_b2, coord); geokst_1.na[0] = 99; } else { i__1 = geokst_1.natoms; for (i = 1; i <= i__1; ++i) { for (j = 1; j <= 3; ++j) { /* L10: */ coord[j + i * 3 - 4] = geom_1.geo[j + i * 3 - 4]; } } } degree = 57.29577951; s_wsfe(&io___6); e_wsfe(); n = 1; ia = geovar_1.loc[0]; i__1 = geokst_1.natoms; for (i = 1; i <= i__1; ++i) { for (j = 1; j <= 3; ++j) { *(unsigned char *)&q[j - 1] = ' '; if (ia != i) { goto L30; } if (j != geovar_1.loc[(n << 1) - 1]) { goto L30; } *(unsigned char *)&q[j - 1] = '*'; ++n; ia = geovar_1.loc[(n << 1) - 2]; L30: ; } w = coord[i * 3 - 2] * degree; x = coord[i * 3 - 1] * degree; if (path_1.latom != i) { goto L40; } j = path_1.lparam; s_copy(q + (j - 1), "+ ", 1L, 2L); L40: if (geokst_1.labels[i - 1] != 0) { if (i > 3) { s_wsfe(&io___12); do_fio(&c__1, (char *)&i, (ftnlen)sizeof(integer)); do_fio(&c__1, elemts_1.elemnt + (geokst_1.labels[i - 1] - 1 << 1), 2L); do_fio(&c__1, (char *)&coord[i * 3 - 3], (ftnlen)sizeof( doublereal)); do_fio(&c__1, q, 1L); do_fio(&c__1, (char *)&w, (ftnlen)sizeof(doublereal)); do_fio(&c__1, q + 1, 1L); do_fio(&c__1, (char *)&x, (ftnlen)sizeof(doublereal)); do_fio(&c__1, q + 2, 1L); 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)); e_wsfe(); } else if (i == 3) { s_wsfe(&io___13); do_fio(&c__1, elemts_1.elemnt + (geokst_1.labels[2] - 1 << 1), 2L); do_fio(&c__1, (char *)&coord[6], (ftnlen)sizeof(doublereal)); do_fio(&c__1, q, 1L); do_fio(&c__1, (char *)&w, (ftnlen)sizeof(doublereal)); do_fio(&c__1, q + 1, 1L); do_fio(&c__1, (char *)&geokst_1.na[2], (ftnlen)sizeof(integer) ); do_fio(&c__1, (char *)&geokst_1.nb[2], (ftnlen)sizeof(integer) ); e_wsfe(); } else if (i == 2) { s_wsfe(&io___14); do_fio(&c__1, elemts_1.elemnt + (geokst_1.labels[1] - 1 << 1), 2L); do_fio(&c__1, (char *)&coord[3], (ftnlen)sizeof(doublereal)); do_fio(&c__1, q, 1L); do_fio(&c__1, (char *)&geokst_1.na[1], (ftnlen)sizeof(integer) ); e_wsfe(); } else { s_wsfe(&io___15); do_fio(&c__1, elemts_1.elemnt + (geokst_1.labels[0] - 1 << 1), 2L); e_wsfe(); } } /* L50: */ } return 0; } /* geout_ */