/* grid.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 nvar, loc[516] /* was [2][258] */, idumy; doublereal xparam[258]; } geovar_; #define geovar_1 geovar_ struct { doublereal grad[258], gnorm; } gradnt_; #define gradnt_1 gradnt_ struct { doublereal cosine; } gravec_; #define gravec_1 gravec_ struct { integer latom1, lpara1, latom2, lpara2; } mesh_; #define mesh_1 mesh_ struct { char keywrd[80]; } keywrd_; #define keywrd_1 keywrd_ /* Table of constant values */ static integer c__1 = 1; /* Subroutine */ int grid_(void) { /* System generated locals */ integer i__1, i__2; doublereal d__1, d__2; /* Builtin functions */ integer i_indx(char *, char *, ftnlen, ftnlen), s_wsfe(cilist *), e_wsfe( void), do_fio(integer *, char *, ftnlen); /* Local variables */ static doublereal escf; static integer ione, npts; static doublereal step1, step2; static integer npts2, i, j; extern doublereal reada_(char *, integer *, ftnlen); extern /* Subroutine */ int flepo_(doublereal *, integer *, doublereal *); static integer iloop; static doublereal c1, c2; static integer jloop, jloop1; static doublereal start1, start2, degree, surfac[121] /* was [11][ 11] */; /* Fortran I/O blocks */ static cilist io___11 = { 0, 6, 0, "(' FIRST VARIABLE SECOND VARIABL" "E FUNCTION')", 0 }; static cilist io___17 = { 0, 6, 0, "(' :',F16.5,F16.5,F13.6)", 0 }; static cilist io___18 = { 0, 6, 0, "(/10X,'HORIZONTAL: VARYING SECOND PA" "RAMETER,', /10X,'VERTICAL: VARYING FIRST PAR" "AMETER')", 0 }; static cilist io___19 = { 0, 6, 0, "(/10X,'WHOLE OF GRID, SUITABLE FOR P" "LOTTING',//)", 0 }; static cilist io___21 = { 0, 6, 0, "(11F7.2)", 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 */ /* *********************************************************************** */ /* GRID CALCULATES THE ENERGY-SURFACE RESULTING FROM VARIATION OF */ /* TWO COORDINATES. THE STEP-SIZE IS STEP1 AND STEP2, AND A 11 */ /* BY 11 GRID OF POINTS IS GENERATED */ /* *********************************************************************** */ i__1 = i_indx(keywrd_1.keywrd, "STEP1", 80L, 5L) + 6; step1 = reada_(keywrd_1.keywrd, &i__1, 80L); i__1 = i_indx(keywrd_1.keywrd, "STEP2", 80L, 5L) + 6; step2 = reada_(keywrd_1.keywrd, &i__1, 80L); /* THE CENTRAL VALUE OF THE FIRST AND SECOND DIMENSIONS ARE */ /* GEO(LPARA1,LATOM1) AND GEO(LPARA2,LATOM2) */ npts = 11; /* NPTS MUST BE ODD, IN ORDER TO HAVE A CENTER POINT. */ npts2 = npts / 2; degree = 57.29577951307855; if (mesh_1.lpara1 != 1) { step1 /= degree; } if (mesh_1.lpara2 != 1) { step2 /= degree; } start1 = geom_1.geo[mesh_1.lpara1 + mesh_1.latom1 * 3 - 4] - (npts2 + 1) * step1; start2 = geom_1.geo[mesh_1.lpara2 + mesh_1.latom2 * 3 - 4] - (npts2 + 1) * step2; /* NOW TO SWEEP THROUGH THE GRID OF POINTS LEFT TO RIGHT THEN RIGHT */ /* TO LEFT. THIS SHOULD AVOID THE GEOMETRY OR SCF GETTING MESSED UP. */ geom_1.geo[mesh_1.lpara1 + mesh_1.latom1 * 3 - 4] = start1; geom_1.geo[mesh_1.lpara2 + mesh_1.latom2 * 3 - 4] = start2; ione = -1; if (mesh_1.lpara1 != 1) { c1 = degree; } else { c1 = 1.; } if (mesh_1.lpara2 != 1) { c2 = degree; } else { c2 = 1.; } s_wsfe(&io___11); e_wsfe(); i__1 = npts; for (iloop = 1; iloop <= i__1; ++iloop) { geom_1.geo[mesh_1.lpara1 + mesh_1.latom1 * 3 - 4] += step1; ione = -ione; jloop1 = 0; if (ione < 0) { jloop1 = npts + 1; } i__2 = npts; for (jloop = 1; jloop <= i__2; ++jloop) { jloop1 += ione; geom_1.geo[mesh_1.lpara2 + mesh_1.latom2 * 3 - 4] += step2 * ione; flepo_(geovar_1.xparam, &geovar_1.nvar, &escf); surfac[iloop + jloop1 * 11 - 12] = escf; s_wsfe(&io___17); d__1 = geom_1.geo[mesh_1.lpara1 + mesh_1.latom1 * 3 - 4] * c1; do_fio(&c__1, (char *)&d__1, (ftnlen)sizeof(doublereal)); d__2 = geom_1.geo[mesh_1.lpara2 + mesh_1.latom2 * 3 - 4] * c2; do_fio(&c__1, (char *)&d__2, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&escf, (ftnlen)sizeof(doublereal)); e_wsfe(); /* L10: */ } geom_1.geo[mesh_1.lpara2 + mesh_1.latom2 * 3 - 4] += step2 * ione; /* L20: */ } s_wsfe(&io___18); e_wsfe(); s_wsfe(&io___19); e_wsfe(); i__1 = npts; for (i = 1; i <= i__1; ++i) { /* L30: */ s_wsfe(&io___21); i__2 = npts; for (j = 1; j <= i__2; ++j) { do_fio(&c__1, (char *)&surfac[j + i * 11 - 12], (ftnlen)sizeof( doublereal)); } e_wsfe(); } return 0; } /* grid_ */