/* read.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" #include "stdio.h" /* Common Block Declarations */ struct { char argz[512]; } argz_; #define argz_1 argz_ struct { char keywrd[80]; } keywrd_; #define keywrd_1 keywrd_ struct { char koment[80], title[80]; } titles_; #define titles_1 titles_ 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 { integer latom1, lpara1, latom2, lpara2; } mesh_; #define mesh_1 mesh_ struct { char elemnt[214]; } elemts_; #define elemts_1 elemts_ struct { doublereal ams[107]; } istope_; #define istope_1 istope_ 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 ndep, locpar[258], idepfn[258], locdep[258]; } geosym_; #define geosym_1 geosym_ /* Table of constant values */ static integer c__1 = 1; static integer c__5 = 5; static doublereal c_b56 = 5.; static integer c__43 = 43; /* Subroutine */ int read_(void) { /* Initialized data */ static char space[1] = " "; static char space2[2] = " "; /* System generated locals */ integer i__1, i__2; doublereal d__1; alist al__1; /* Builtin functions */ integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void), i_indx(char *, char *, ftnlen, ftnlen), f_rew(alist *), s_wsfe( cilist *), e_wsfe(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_cmp(char *, char *, ftnlen, ftnlen); /* Subroutine */ int s_stop(char *, ftnlen); double asin(doublereal); /* Local variables */ static integer iend; static char line[80]; static integer mvar; #define keys ((char *)&keywrd_1) static integer lopt[258] /* was [3][86] */; static doublereal sumx, sumy, sumz; static integer i, j, l, icapa, iflag; extern /* Subroutine */ int fdate_(char *, ftnlen); static char idate[24]; static integer iline; static doublereal coord[258] /* was [3][86] */; static integer ilowa; static doublereal value[40]; extern /* Subroutine */ int geout_(void); static integer numat, ilowz; static char ch[1]; static integer ij; static doublereal degree; static char banner[80]; static integer ireact; extern /* Subroutine */ int getgeo_(integer *, integer *, doublereal *, integer *, integer *, integer *, integer *, doublereal *, integer *, logical *); static integer nreact; extern /* Subroutine */ int nuchar_(char *, doublereal *, integer *, ftnlen); static char ch2[2]; extern /* Subroutine */ int gmetry_(doublereal *, doublereal *), getsym_( void); static doublereal convrt; extern /* Subroutine */ int wrtkey_(char *, ftnlen), symtry_(void); static logical int__; static doublereal dum1, dum2; /* Fortran I/O blocks */ static cilist io___4 = { 0, 5, 0, "(A)", 0 }; static cilist io___10 = { 0, 5, 1, "(A)", 0 }; static cilist io___12 = { 0, 6, 0, "(1X,A)", 0 }; static cilist io___13 = { 0, 6, 0, "('1')", 0 }; static cilist io___14 = { 0, 5, 0, "(A)", 0 }; static cilist io___17 = { 0, 6, 0, "(//10X,'WARNING-THE LAST KEYWORD MAY" " BE CORRUPTED')", 0 }; static cilist io___18 = { 0, 6, 0, "(//1X,A)", 0 }; static cilist io___19 = { 0, 6, 0, "(//1X,A)", 0 }; static cilist io___23 = { 0, 6, 0, "(1X,15('*****'),'****')", 0 }; static cilist io___25 = { 0, 6, 0, "(A)", 0 }; static cilist io___26 = { 0, 6, 0, "(1X,79('*'))", 0 }; static cilist io___28 = { 0, 6, 0, "(/29X,A,' CALCULATION RESULTS',28X,/" "//1X,15('*****') ,'****' )", 0 }; static cilist io___29 = { 0, 6, 0, "(' *',10X,'MOPAC: VERSION ',F5.2, " " 15X,'CALC''D. ',A24)", 0 }; static cilist io___30 = { 0, 6, 0, "(' ATOMIC NUMBER OF ',I3,' ?')", 0 }; static cilist io___31 = { 0, 6, 0, "(' ATOM NUMBER ',I3,' IS ILLDEFINED')" , 0 }; static cilist io___32 = { 0, 6, 0, "(1X,14('*****'),'*',I3.3,'BY',I3.3)", 0 }; static cilist io___36 = { 0, 6, 0, "(' ONLY ONE REACTION COORDINATE PERM" "ITTED')", 0 }; static cilist io___38 = { 0, 6, 0, "(A)", 0 }; static cilist io___39 = { 0, 6, 0, "(A)", 0 }; static cilist io___40 = { 0, 5, 1, "(A)", 0 }; static cilist io___44 = { 0, 6, 0, "(///,' ONLY TWO HUNDRED POINTS AL" "LOWED IN REACTION',' COORDINATE')", 0 }; static cilist io___47 = { 0, 6, 0, "(///,' TWO ADJACENT POINTS ARE IDENT" "ICAL: ', F7.3,2X,F7.3,/,' THIS IS NOT ALLOWED IN A PATH CAL" "CULATION')", 0 }; static cilist io___49 = { 0, 6, 0, "(//10X,' NO POINTS SUPPLIED FOR REAC" "TION PATH')", 0 }; static cilist io___50 = { 0, 6, 0, "(//10X,' GEOMETRY AS READ IN IS AS F" "OLLOWS')", 0 }; static cilist io___51 = { 0, 6, 0, "(//10X,' POINTS ON REACTION COORDINA" "TE')", 0 }; static cilist io___52 = { 0, 6, 0, "(10X,8F8.2)", 0 }; static cilist io___54 = { 0, 6, 0, "(A)", 0 }; static cilist io___56 = { 0, 6, 0, "(//10X,'CARTESIAN COORDINATES ',/)", 0 }; static cilist io___57 = { 0, 6, 0, "(4X,'NO.',7X,'ATOM',9X,'X', " " 9X,'Y',9X,'Z',/)", 0 }; static cilist io___59 = { 0, 6, 0, "(I6,8X,A2,4X,3F10.4)", 0 }; static cilist io___60 = { 0, 6, 0, "(//10X,' INTERNAL COORDINATES READ I" "N, AND SYMMETRY' ,/10X,' SPECIFIED, BUT CALCULATION TO BE RUN " "IN CARTESIAN ' ,'COORDINATES')", 0 }; static cilist io___61 = { 0, 6, 0, "(//10X,' INTERNAL COORDINATES READ I" "N, AND', ' CALCULATION ',/10X,'TO BE RUN IN CARTESIAN " "COORDINATES, ', /10X,'BUT NOT ALL COORDINATES MARKED FOR OPTIMI" "SATION')", 0 }; static cilist io___62 = { 0, 6, 0, "(//10X,' THIS INVOLVES A LOGICALLLY " "ABSURD CHOICE ',/10X,' SO THE CALCULATION IS TERMINATED AT THIS " "POINT')", 0 }; static cilist io___67 = { 0, 6, 0, "(//10X,' CARTESIAN COORDINATES READ " "IN, AND SYMMETRY' ,/10X,' SPECIFIED, BUT CALCULATION TO BE RUN " "IN INTERNAL ' ,'COORDINATES')", 0 }; static cilist io___68 = { 0, 6, 0, "(//10X,' CARTESIAN COORDINATES READ " "IN, AND', ' CALCULATION ',/10X,'TO BE RUN IN INTERNAL C" "OORDINATES, ', /10X,'BUT NOT ALL COORDINATES MARKED FOR OPTIMI" "SATION')", 0 }; static cilist io___69 = { 0, 6, 0, "(//10X,'MOPAC, BY DEFAULT, USES INTE" "RNAL COORDINATES',/10X,'TO SPECIFY CARTESIAN COORDINATES USE KEY" "-WORD :XYZ:')", 0 }; static cilist io___70 = { 0, 6, 0, "(10X,'YOUR CURRENT CHOICE OF KEY-WOR" "DS INVOLVES A ','LOGICALLLY ', " " /10X,'ABSURD CHOICE SO THE CALCULATION IS TERMINATE" "D AT THIS ' ,'POINT')", 0 }; /* MODULE TO READ IN GEOMETRY FILE, OUTPUT IT TO THE USER, */ /* AND CHECK THE DATA TO SEE IF IT IS REASONABLE. */ /* EXIT IF NECESSARY. */ /* ON EXIT NATOMS = NUMBER OF ATOMS PLUS DUMMY ATOMS (IF ANY). */ /* KEYWRD = KEYWORDS TO CONTROL CALCULATION */ /* KOMENT = COMMENT CARD */ /* TITLE = TITLE CARD */ /* LABELS = ARRAY OF ATOMIC LABELS INCLUDING DUMMY ATOMS. */ /* GEO = ARRAY OF INTERNAL COORDINATES. */ /* LOPT = FLAGS FOR OPTIMIZATION OF MOLECULE */ /* NA = ARRAY OF LABELS OF ATOMS, BOND LENGTHS. */ /* NB = ARRAY OF LABELS OF ATOMS, BOND ANGLES. */ /* NC = ARRAY OF LABELS OF ATOMS, DIHEDRAL ANGLES. */ /* LATOM = LABEL OF ATOM OF REACTION COORDINATE. */ /* LPARAM = RC: 1 FOR LENGTH, 2 FOR ANGLE, AND 3 FOR DIHEDRAL */ /* REACT(200)= REACTION COORDINATE PARAMETERS */ /* LOC(1,I) = LABEL OF ATOM TO BE OPTIMIZED. */ /* LOC(2,I) = 1 FOR LENGTH, 2 FOR ANGLE, AND 3 FOR DIHEDRAL. */ /* NVAR = NUMBER OF PARAMETERS TO BE OPTIMIZED. */ /* XPARAM = STARTING VALUE OF PARAMETERS TO BE OPTIMIZED. */ /* *********************************************************************** */ /* *** INPUT THE TRIAL GEOMETRY \IE. KGEOM=0\ */ /* LABEL(I) = THE ATOMIC NUMBER OF ATOM\I\. */ /* = 99, THEN THE I-TH ATOM IS A DUMMY ATOM USED ONLY TO */ /* SIMPLIFY THE DEFINITION OF THE MOLECULAR GEOMETRY. */ /* GEO(1,I) = THE INTERNUCLEAR SEPARATION \IN ANGSTROMS\ BETWEEN ATOMS */ /* NA(I) AND (I). */ /* GEO(2,I) = THE ANGLE NB(I):NA(I):(I) INPUT IN DEGREES; STORED IN */ /* RADIANS. */ /* GEO(3,I) = THE ANGLE BETWEEN THE VECTORS NC(I):NB(I) AND NA(I):(I) */ /* INPUT IN DEGREES - STORED IN RADIANS. */ /* LOPT(J,I) = -1 IF GEO(J,I) IS THE REACTION COORDINATE. */ /* = +1 IF GEO(J,I) IS A PARAMETER TO BE OPTIMIZED */ /* = 0 OTHERWISE. */ /* *** NOTE: MUCH OF THIS DATA IS NOT INCLUDED FOR THE FIRST 3 ATOMS. */ /* ATOM1 INPUT LABELS(1) ONLY. */ /* ATOM2 INPUT LABELS(2) AND GEO(1,2) SEPARATION BETWEEN ATOMS 1+2 */ /* ATOM3 INPUT LABELS(3), GEO(1,3) SEPARATION BETWEEN ATOMS 2+3 */ /* AND GEO(2,3) ANGLE ATOM1 : ATOM2 : ATOM3 */ /* *********************************************************************** */ /* 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 */ s_rsfe(&io___4); do_fio(&c__1, keywrd_1.keywrd, 80L); do_fio(&c__1, titles_1.koment, 80L); do_fio(&c__1, titles_1.title, 80L); e_rsfe(); ilowa = 'a'; ilowz = 'z'; icapa = 'A'; /* *********************************************************************** */ for (i = 1; i <= 80; ++i) { iline = *(unsigned char *)&keywrd_1.keywrd[i - 1]; if (iline >= ilowa && iline <= ilowz) { *(unsigned char *)&keywrd_1.keywrd[i - 1] = (char) (iline + icapa - ilowa); } /* L10: */ } /* *********************************************************************** */ if (i_indx(keywrd_1.keywrd, "ECHO", 80L, 4L) != 0) { al__1.aerr = 0; al__1.aunit = 5; f_rew(&al__1); for (i = 1; i <= 1000; ++i) { i__1 = s_rsfe(&io___10); if (i__1 != 0) { goto L40; } i__1 = do_fio(&c__1, keywrd_1.keywrd, 80L); if (i__1 != 0) { goto L40; } i__1 = e_rsfe(); if (i__1 != 0) { goto L40; } for (j = 80; j >= 2; --j) { /* L20: */ if (*(unsigned char *)&keywrd_1.keywrd[j - 1] != ' ') { goto L30; } } j = 1; L30: s_wsfe(&io___12); do_fio(&c__1, keywrd_1.keywrd, j); e_wsfe(); } } L40: al__1.aerr = 0; al__1.aunit = 5; f_rew(&al__1); if (i_indx(keywrd_1.keywrd, "ECHO", 80L, 4L) != 0) { s_wsfe(&io___13); e_wsfe(); } s_rsfe(&io___14); do_fio(&c__1, keywrd_1.keywrd, 80L); do_fio(&c__1, titles_1.koment, 80L); do_fio(&c__1, titles_1.title, 80L); e_rsfe(); /* *********************************************************************** */ for (i = 1; i <= 80; ++i) { iline = *(unsigned char *)&keywrd_1.keywrd[i - 1]; if (iline >= ilowa && iline <= ilowz) { *(unsigned char *)&keywrd_1.keywrd[i - 1] = (char) (iline + icapa - ilowa); } /* L50: */ } /* *********************************************************************** */ if (*(unsigned char *)keywrd_1.keywrd != *(unsigned char *)&space[0]) { *(unsigned char *)ch = *(unsigned char *)keywrd_1.keywrd; *(unsigned char *)keywrd_1.keywrd = *(unsigned char *)&space[0]; for (i = 2; i <= 78; ++i) { s_copy(ch2, keywrd_1.keywrd + (i - 1), 2L, 1L); *(unsigned char *)&keywrd_1.keywrd[i - 1] = *(unsigned char *)ch; s_copy(ch, ch2, 1L, 2L); i__1 = i; if (s_cmp(keywrd_1.keywrd + i__1, space2, i + 2 - i__1, 2L) == 0) { i__1 = i; s_copy(keywrd_1.keywrd + i__1, ch, i + 1 - i__1, 1L); goto L70; } /* L60: */ } if (*(unsigned char *)&keywrd_1.keywrd[79] != *(unsigned char *)& space[0]) { s_wsfe(&io___17); e_wsfe(); } *(unsigned char *)&keywrd_1.keywrd[79] = *(unsigned char *)ch; L70: ; } if (*(unsigned char *)titles_1.koment != *(unsigned char *)&space[0]) { *(unsigned char *)ch = *(unsigned char *)titles_1.koment; *(unsigned char *)titles_1.koment = *(unsigned char *)&space[0]; for (i = 2; i <= 78; ++i) { s_copy(ch2, titles_1.koment + (i - 1), 2L, 1L); *(unsigned char *)&titles_1.koment[i - 1] = *(unsigned char *)ch; s_copy(ch, ch2, 1L, 2L); i__1 = i; if (s_cmp(titles_1.koment + i__1, space2, i + 2 - i__1, 2L) == 0) { i__1 = i; s_copy(titles_1.koment + i__1, ch, i + 1 - i__1, 1L); goto L90; } /* L80: */ } if (*(unsigned char *)&titles_1.koment[79] != *(unsigned char *)& space[0]) { s_wsfe(&io___18); do_fio(&c__1, "WARNING-THE LAST WORD IN FIRST COMMENT LINE MAY B" "E CORRUPTED", 60L); e_wsfe(); } *(unsigned char *)&titles_1.koment[79] = *(unsigned char *)ch; L90: ; } if (*(unsigned char *)titles_1.title != *(unsigned char *)&space[0]) { *(unsigned char *)ch = *(unsigned char *)titles_1.title; *(unsigned char *)titles_1.title = *(unsigned char *)&space[0]; for (i = 2; i <= 78; ++i) { s_copy(ch2, titles_1.title + (i - 1), 2L, 1L); *(unsigned char *)&titles_1.title[i - 1] = *(unsigned char *)ch; s_copy(ch, ch2, 1L, 2L); i__1 = i; if (s_cmp(titles_1.title + i__1, space2, i + 2 - i__1, 2L) == 0) { i__1 = i; s_copy(titles_1.title + i__1, ch, i + 1 - i__1, 1L); goto L110; } /* L100: */ } if (*(unsigned char *)&titles_1.title[79] != *(unsigned char *)&space[ 0]) { s_wsfe(&io___19); do_fio(&c__1, "WARNING-THE LAST WORD IN SECOND COMMENT LINE MAY " "BE CORRUPTED", 61L); e_wsfe(); } *(unsigned char *)&titles_1.title[79] = *(unsigned char *)ch; L110: ; } getgeo_(&c__5, geokst_1.labels, geom_1.geo, lopt, geokst_1.na, geokst_1.nb, geokst_1.nc, istope_1.ams, &geokst_1.natoms, &int__); /* OUTPUT FILE TO UNIT 6 */ /* WRITE HEADER */ s_copy(idate, " ", 24L, 1L); fdate_(idate, 24L); s_wsfe(&io___23); e_wsfe(); /* CHANGE THE FOLLOWING LINE TO SUIT LOCAL ENVIRONMENT, IF DESIRED */ s_copy(banner, " ** FRANK J. SEILER RES. LAB., U.S. AIR FORCE ACADEMY, C" "OLO. SPGS., CO. 80840 **", 80L, 80L); s_wsfe(&io___25); do_fio(&c__1, banner, 80L); e_wsfe(); /* THE BANNER DOES NOT APPEAR ANYWHERE ELSE. */ s_wsfe(&io___26); e_wsfe(); s_copy(line, " MNDO", 80L, 7L); if (i_indx(keywrd_1.keywrd, "MINDO", 80L, 5L) != 0) { s_copy(line, "MINDO/3", 80L, 7L); } if (i_indx(keywrd_1.keywrd, "AM1", 80L, 3L) != 0) { s_copy(line, " AM1", 80L, 7L); } if (i_indx(keywrd_1.keywrd, "PM3", 80L, 3L) != 0) { s_copy(line, " PM3", 80L, 7L); } s_wsfe(&io___28); do_fio(&c__1, line, 7L); e_wsfe(); s_wsfe(&io___29); do_fio(&c__1, (char *)&c_b56, (ftnlen)sizeof(doublereal)); do_fio(&c__1, idate, 24L); e_wsfe(); /**** Messaggio di Copyright ****/ puts(" * AmigaDOS porting by Alessandro Pedretti"); #ifdef mc68020 puts(" * 68020/68881 version"); #endif #ifdef mc68030 puts(" * 68030/68881 version"); #endif #ifdef mc68040 puts(" * 68040 version"); #endif /* CHECK DATA */ i__1 = geokst_1.natoms; for (i = 1; i <= i__1; ++i) { if (geokst_1.labels[i - 1] <= 0) { s_wsfe(&io___30); do_fio(&c__1, (char *)&geokst_1.labels[i - 1], (ftnlen)sizeof( integer)); e_wsfe(); s_stop("", 0L); } if (geokst_1.na[i - 1] >= i || geokst_1.nb[i - 1] >= i || geokst_1.nc[ i - 1] >= i || geokst_1.na[i - 1] == geokst_1.nb[i - 1] && i > 1 || (geokst_1.na[i - 1] == geokst_1.nc[i - 1] || geokst_1.nb[i - 1] == geokst_1.nc[i - 1]) && i > 2 || geokst_1.na[i - 1] * geokst_1.nb[i - 1] * geokst_1.nc[i - 1] == 0 && i > 3) { s_wsfe(&io___31); do_fio(&c__1, (char *)&i, (ftnlen)sizeof(integer)); e_wsfe(); s_stop("", 0L); } /* L120: */ } /* WRITE KEYWORDS BACK TO USER AS FEEDBACK */ wrtkey_(keywrd_1.keywrd, 80L); s_wsfe(&io___32); do_fio(&c__1, (char *)&c__43, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&c__43, (ftnlen)sizeof(integer)); e_wsfe(); /* CONVERT ANGLES TO RADIANS */ i__1 = geokst_1.natoms; for (i = 1; i <= i__1; ++i) { for (j = 2; j <= 3; ++j) { geom_1.geo[j + i * 3 - 4] = geom_1.geo[j + i * 3 - 4] * 2. * asin( 1.) / 180.; /* L130: */ } } /* FILL IN GEO MATRIX IF NEEDED */ geosym_1.ndep = 0; if (i_indx(keywrd_1.keywrd, "SYM", 80L, 3L) != 0) { getsym_(); } if (geosym_1.ndep != 0) { symtry_(); } /* INITIALIZE FLAGS FOR OPTIMIZE AND PATH */ iflag = 0; geovar_1.nvar = 0; path_1.latom = 0; numat = 0; i__1 = geokst_1.natoms; for (i = 1; i <= i__1; ++i) { if (geokst_1.labels[i - 1] != 99 && geokst_1.labels[i - 1] != 107) { ++numat; } for (j = 1; j <= 3; ++j) { if ((i__2 = lopt[j + i * 3 - 4]) < 0) { goto L140; } else if (i__2 == 0) { goto L160; } else { goto L150; } /* FLAG FOR PATH */ L140: convrt = 1.; if (iflag != 0) { if (i_indx(keywrd_1.keywrd, "STEP1", 80L, 5L) != 0) { mesh_1.lpara1 = path_1.lparam; mesh_1.latom1 = path_1.latom; mesh_1.lpara2 = j; mesh_1.latom2 = i; path_1.latom = 0; iflag = 0; goto L160; } else { s_wsfe(&io___36); e_wsfe(); s_stop("", 0L); } } path_1.latom = i; path_1.lparam = j; if (j > 1) { convrt = .01745329252; } path_1.react[0] = geom_1.geo[j + i * 3 - 4]; ireact = 1; iflag = 1; goto L160; /* FLAG FOR OPTIMIZE */ L150: ++geovar_1.nvar; geovar_1.loc[(geovar_1.nvar << 1) - 2] = i; geovar_1.loc[(geovar_1.nvar << 1) - 1] = j; geovar_1.xparam[geovar_1.nvar - 1] = geom_1.geo[j + i * 3 - 4]; L160: ; } } /* READ IN PATH VALUES */ if (iflag == 0) { goto L200; } if (i_indx(keywrd_1.keywrd, "NLLSQ", 80L, 5L) != 0) { s_wsfe(&io___38); do_fio(&c__1, " NLLSQ USED WITH REACTION PATH; THIS OPTION IS NOT AL" "LOWED", 58L); e_wsfe(); s_stop("", 0L); } if (i_indx(keywrd_1.keywrd, "SIGMA", 80L, 5L) != 0) { s_wsfe(&io___39); do_fio(&c__1, " SIGMA USED WITH REACTION PATH; THIS OPTION IS NOT AL" "LOWED", 58L); e_wsfe(); s_stop("", 0L); } L170: i__1 = s_rsfe(&io___40); if (i__1 != 0) { goto L190; } i__1 = do_fio(&c__1, line, 80L); if (i__1 != 0) { goto L190; } i__1 = e_rsfe(); if (i__1 != 0) { goto L190; } nuchar_(line, value, &nreact, 80L); i__1 = nreact; for (i = 1; i <= i__1; ++i) { ij = ireact + i; if (ij > 200) { s_wsfe(&io___44); e_wsfe(); s_stop("", 0L); } path_1.react[ij - 1] = value[i - 1] * convrt; if ((d__1 = path_1.react[ij - 1] - path_1.react[ij - 2], abs(d__1)) < 1e-5) { dum1 = path_1.react[ij - 1] / convrt; dum2 = path_1.react[ij - 2] / convrt; s_wsfe(&io___47); do_fio(&c__1, (char *)&dum1, (ftnlen)sizeof(doublereal)); do_fio(&c__1, (char *)&dum2, (ftnlen)sizeof(doublereal)); e_wsfe(); s_stop("", 0L); } /* L180: */ } ireact += nreact; goto L170; L190: degree = 1.; if (path_1.lparam > 1) { degree = 90. / asin(1.); } if (ireact <= 1) { s_wsfe(&io___49); e_wsfe(); s_wsfe(&io___50); e_wsfe(); geout_(); s_stop("", 0L); } else { s_wsfe(&io___51); e_wsfe(); s_wsfe(&io___52); i__1 = ireact; for (i = 1; i <= i__1; ++i) { d__1 = path_1.react[i - 1] * degree; do_fio(&c__1, (char *)&d__1, (ftnlen)sizeof(doublereal)); } e_wsfe(); } iend = ireact + 1; path_1.react[iend - 1] = -1e12; /* OUTPUT GEOMETRY AS FEEDBACK */ L200: s_wsfe(&io___54); do_fio(&c__1, keywrd_1.keywrd, 80L); do_fio(&c__1, titles_1.koment, 80L); do_fio(&c__1, titles_1.title, 80L); e_wsfe(); geout_(); gmetry_(geom_1.geo, coord); if (i_indx(keywrd_1.keywrd, "NOXYZ", 80L, 5L) == 0) { s_wsfe(&io___56); e_wsfe(); s_wsfe(&io___57); e_wsfe(); l = 0; i__1 = geokst_1.natoms; for (i = 1; i <= i__1; ++i) { if (geokst_1.labels[i - 1] == 99 || geokst_1.labels[i - 1] == 107) { goto L210; } ++l; s_wsfe(&io___59); do_fio(&c__1, (char *)&l, (ftnlen)sizeof(integer)); do_fio(&c__1, elemts_1.elemnt + (geokst_1.labels[i - 1] - 1 << 1), 2L); for (j = 1; j <= 3; ++j) { do_fio(&c__1, (char *)&coord[j + l * 3 - 4], (ftnlen)sizeof( doublereal)); } e_wsfe(); L210: ; } } if (i_indx(keywrd_1.keywrd, " XYZ", 80L, 4L) != 0) { if (geovar_1.nvar != 0 && int__ && (geosym_1.ndep != 0 || geovar_1.nvar < numat * 3 - 6)) { if (geosym_1.ndep != 0) { s_wsfe(&io___60); e_wsfe(); } if (geovar_1.nvar < numat * 3 - 6) { s_wsfe(&io___61); e_wsfe(); } s_wsfe(&io___62); e_wsfe(); s_stop("", 0L); } sumx = 0.; sumy = 0.; sumz = 0.; i__1 = numat; for (j = 1; j <= i__1; ++j) { sumx += coord[j * 3 - 3]; sumy += coord[j * 3 - 2]; /* L220: */ sumz += coord[j * 3 - 1]; } sumx /= numat; sumy /= numat; sumz /= numat; i__1 = numat; for (j = 1; j <= i__1; ++j) { geom_1.geo[j * 3 - 3] = coord[j * 3 - 3] - sumx; geom_1.geo[j * 3 - 2] = coord[j * 3 - 2] - sumy; /* L230: */ geom_1.geo[j * 3 - 1] = coord[j * 3 - 1] - sumz; } geokst_1.na[0] = 99; j = 0; mvar = 1; geovar_1.nvar = 1; i__1 = geokst_1.natoms; for (i = 1; i <= i__1; ++i) { if (geokst_1.labels[i - 1] != 99) { ++j; L240: if (geovar_1.loc[(mvar << 1) - 2] == i) { geovar_1.xparam[geovar_1.nvar - 1] = geom_1.geo[ geovar_1.loc[(geovar_1.nvar << 1) - 1] + j * 3 - 4]; geovar_1.loc[(geovar_1.nvar << 1) - 2] = j; ++mvar; ++geovar_1.nvar; goto L240; } geokst_1.labels[j - 1] = geokst_1.labels[i - 1]; } else { L250: if (geovar_1.loc[(mvar << 1) - 2] == i) { ++mvar; goto L250; } } /* L260: */ } --geovar_1.nvar; geokst_1.natoms = numat; } else { if (geovar_1.nvar == 0) { return 0; } if (! int__ && (geosym_1.ndep != 0 || geovar_1.nvar < numat * 3 - 6)) { if (geosym_1.ndep != 0) { s_wsfe(&io___67); e_wsfe(); } if (geovar_1.nvar < numat * 3 - 6) { s_wsfe(&io___68); e_wsfe(); } s_wsfe(&io___69); e_wsfe(); s_wsfe(&io___70); e_wsfe(); s_stop("", 0L); } } return 0; } /* read_ */ #undef keys