/* moldat.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 natoms, labels[86], na[86], nb[86], nc[86]; } geokst_; #define geokst_1 geokst_ struct { doublereal htype[4]; integer nhco[80] /* was [4][20] */, nnhco, itype; logical usemm; } molmec_; #define molmec_1 molmec_ 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 keywrd[80]; } keywrd_; #define keywrd_1 keywrd_ struct { integer natorb[107]; } natorb_; #define natorb_1 natorb_ struct { doublereal core[107]; } core_; #define core_1 core_ struct { doublereal betas[107], betap[107], betad[107]; } betas_; #define betas_1 betas_ struct { doublereal uspd[215], pspd[215]; } molorb_; #define molorb_1 molorb_ struct { doublereal vs[107], vp[107], vd[107]; } vsips_; #define vsips_1 vsips_ struct { doublereal uss[107], upp[107], udd[107]; } onelec_; #define onelec_1 onelec_ struct { doublereal atheat; } atheat_; #define atheat_1 atheat_ struct { doublereal polvol[107]; } polvol_; #define polvol_1 polvol_ struct { doublereal dd[107], qq[107], am[107], ad[107], aq[107]; } multip_; #define multip_1 multip_ struct { doublereal gss[107], gsp[107], gpp[107], gp2[107], hsp[107], gsd[107], gpd[107], gdd[107]; } twoele_; #define twoele_1 twoele_ struct { doublereal guess1[1070] /* was [107][10] */, guess2[1070] /* was [107][10] */, guess3[1070] /* was [107][10] */; } ideas_; #define ideas_1 ideas_ struct { doublereal guesp1[1070] /* was [107][10] */, guesp2[1070] /* was [107][10] */, guesp3[1070] /* was [107][10] */; } ideap_; #define ideap_1 ideap_ struct { doublereal alp[107]; } alpha_; #define alpha_1 alpha_ struct { char allref[34240] /* was [107][4] */; } refs_; #define refs_1 refs_ struct { doublereal ussm[107], uppm[107], uddm[107], zsm[107], zpm[107], zdm[107], betasm[107], betapm[107], betadm[107], alpm[107], eisolm[107], ddm[107], qqm[107], amm[107], adm[107], aqm[107], gssm[107], gspm[ 107], gppm[107], gp2m[107], hspm[107], polvom[107]; } mndo_; #define mndo_1 mndo_ struct { doublereal usspm3[107], upppm3[107], uddpm3[107], zspm3[107], zppm3[107], zdpm3[107], betasp[107], betapp[107], betadp[107], alppm3[107], eisolp[107], ddpm3[107], qqpm3[107], ampm3[107], adpm3[107], aqpm3[107], gsspm3[107], gsppm3[107], gpppm3[107], gp2pm3[107], hsppm3[107], polvop[107]; } pm3_; #define pm3_1 pm3_ struct { doublereal geo[258] /* was [3][86] */; } geom_; #define geom_1 geom_ struct { doublereal rxyz[23220], xdumy[43344]; } scrach_; #define scrach_1 scrach_ struct { doublereal uss3[18], upp3[18]; } onele3_; #define onele3_1 onele3_ struct { doublereal eisol3[18], eheat3[18]; } atomi3_; #define atomi3_1 atomi3_ struct { doublereal zs3[18], zp3[18]; } expon3_; #define expon3_1 expon3_ struct { doublereal zs[107], zp[107], zd[107]; } expont_; #define expont_1 expont_ struct { doublereal eisol[107], eheat[107]; } atomic_; #define atomic_1 atomic_ /* Table of constant values */ static integer c__215 = 215; static integer c__1 = 1; static integer c_b29 = 219386; /* Subroutine */ int moldat_(void) { /* Format strings */ static char fmt_200[] = "(//,\002 ATOMS\002,i3,\002 AND\002,i3,\002 AR" "E SEPARATED BY\002,f8.4,\002 ANGSTROMS.\002,/\002 TO CONTINUE " "CALCULATION SPECIFY \"GEO-OK\"\002)"; static char fmt_210[] = "(\002 NUMBER OF REAL ATOMS:\002,i4,/,\002 N" "UMBER OF ORBITALS: \002,i4,/,\002 NUMBER OF D ORBITALS:\002,i" "4,/,\002 TOTAL NO. OF ATOMS: \002,i4)"; static char fmt_220[] = "(\002 ONE-ELECTRON DIAGONAL TERMS\002,/,10(/," "10f8.3))"; static char fmt_230[] = "(\002 INITIAL P FOR ALL ATOMIC ORBITALS\002,/" ",10(/,10f8.3))"; /* System generated locals */ integer i__1, i__2, i__3, i__4, i__5; doublereal d__1, d__2, d__3; /* Builtin functions */ integer i_indx(char *, char *, ftnlen, ftnlen); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_wsfe(cilist *), e_wsfe(void); /* Subroutine */ int s_stop(char *, ftnlen); integer do_fio(integer *, char *, ftnlen); double sqrt(doublereal); /* Local variables */ static char olde[6*20]; static logical exci, open; static doublereal rmin; static logical trip; static integer i, j; extern doublereal reada_(char *, integer *, ftnlen); static integer k, l; static logical birad; static integer ielec, m; static logical debug; static doublereal w, elecs; extern /* Subroutine */ int refer_(void); static doublereal coord[258] /* was [3][86] */; static integer iminr, jminr, iswap[40] /* was [2][20] */, k1; static logical mindo3; static integer ia, ib, ii, ni, ic, ij, kharge, newele, ndorbs; static logical am1; static integer nheavy, nlight, ilevel; static doublereal yy, xx; extern /* Subroutine */ int gmetry_(doublereal *, doublereal *); static integer ji, jk, kj, kl, lk, mk, km; extern /* Subroutine */ int vecprt_(doublereal *, integer *); static doublereal eat; static logical uhf; static integer n2el; static logical lpm3; /* Fortran I/O blocks */ static cilist io___16 = { 0, 6, 0, "(' THE HAMILTONIAN REQUESTED IS NOT" " AVAILABLE IN' ,' THIS PROGRAM')", 0 }; static cilist io___23 = { 0, 6, 0, "(//10X,'**** MAX. NUMBER OF ORBITALS" ":',I4,/ 10X,'NUMBER OF ORBITALS IN SYSTEM:'," "I4)", 0 }; static cilist io___26 = { 0, 6, 0, "(//10X,'**** MAX. NUMBER OF TWO-ELEC" "TRON INTEGRALS:',I8,/ " " 10X,'NUMBER OF TWO ELECTRON INTEGR" "ALS IN SYSTEM:', I8)", 0 }; static cilist io___30 = { 0, 6, 0, "(//10X,'C.I. NOT ALLOWED WITH UHF ')", 0 }; static cilist io___31 = { 0, 6, 0, "(//10X,'TRIPLET SPECIFIED WITH ODD N" "UMBER', ' OF ELECTRONS, CORRECT FAULT ')", 0 }; static cilist io___32 = { 0, 6, 0, "(//' TRIPLET STATE CALCULATION')", 0 } ; static cilist io___33 = { 0, 6, 0, "(//10X,'QUARTET SPECIFIED WITH EVEN " "NUMBER', ' OF ELECTRONS, CORRECT FAULT ')", 0 }; static cilist io___34 = { 0, 6, 0, "(//' QUARTET STATE CALCULATION')", 0 } ; static cilist io___35 = { 0, 6, 0, "(//10X,'QUINTET SPECIFIED WITH ODD N" "UMBER', ' OF ELECTRONS, CORRECT FAULT ')", 0 }; static cilist io___36 = { 0, 6, 0, "(//' QUINTET STATE CALCULATION')", 0 } ; static cilist io___37 = { 0, 6, 0, "(//10X,'SEXTET SPECIFIED WITH EVEN N" "UMBER', ' OF ELECTRONS, CORRECT FAULT ')", 0 }; static cilist io___38 = { 0, 6, 0, "(//' SEXTET STATE CALCULATION')", 0 }; static cilist io___39 = { 0, 6, 0, "(//10X,'UHF CALCULATION, NO. OF ALPH" "A ELECTRONS =',I3,/27X,'NO. OF BETA ELECTRONS =',I3)", 0 }; static cilist io___43 = { 0, 6, 0, "(//10X,'SYSTEM SPECIFIED WITH ODD NU" "MBER', ' OF ELECTRONS, CORRECT FAULT ')", 0 }; static cilist io___44 = { 0, 6, 0, "(//' SYSTEM IS A BIRADICAL')", 0 }; static cilist io___45 = { 0, 6, 0, "(//' TRIPLET STATE CALCULATION')", 0 } ; static cilist io___46 = { 0, 6, 0, "(//' EXCITED STATE CALCULATION')", 0 } ; static cilist io___47 = { 0, 6, 0, "(//' QUARTET STATE CALCULATION')", 0 } ; static cilist io___48 = { 0, 6, 0, "(//' QUINTET STATE CALCULATION')", 0 } ; static cilist io___49 = { 0, 6, 0, "(//' SEXTET STATE CALCULATION')", 0 }; static cilist io___50 = { 0, 6, 0, "(' IMPOSSIBLE NUMBER OF OPEN SHELL E" "LECTR ONS')", 0 }; static cilist io___51 = { 0, 6, 0, "(' THERE ARE',I3,' DOUBLY FILLED LEV" "ELS') ", 0 }; static cilist io___52 = { 0, 6, 0, "(//10X,'RHF CALCULATION, NO. OF ', " " 'DOUBLY OCCUPIED LEVELS =',I3)", 0 }; static cilist io___53 = { 0, 6, 0, "(/27X,'NO. OF SINGLY OCCUPIED LEVELS" " =',I3)", 0 }; static cilist io___54 = { 0, 6, 0, "(/27X,'NO. OF LEVELS WITH OCCUPANCY'" ",F6.3,' =',I3)", 0 }; static cilist io___73 = { 0, 6, 0, "(A)", 0 }; static cilist io___74 = { 0, 6, 0, "(A,I2,2A)", 0 }; static cilist io___75 = { 0, 6, 0, "(A)", 0 }; static cilist io___76 = { 0, 6, 0, "(A)", 0 }; static cilist io___77 = { 0, 6, 0, "(A)", 0 }; static cilist io___78 = { 0, 6, 0, "(//10X,' INTERATOMIC DISTANCES')", 0 }; static cilist io___79 = { 0, 6, 0, fmt_200, 0 }; static cilist io___80 = { 0, 6, 0, fmt_210, 0 }; static cilist io___81 = { 0, 6, 0, fmt_220, 0 }; static cilist io___82 = { 0, 6, 0, fmt_230, 0 }; static cilist io___83 = { 0, 6, 0, "(//10X,' MAXIMUM NUMBER OF ATOMIC OR" "BITALS EXCEEDED')", 0 }; static cilist io___84 = { 0, 6, 0, "( 10X,' MAXIMUM ALLOWED =',I4)", 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 */ /* COMMON BLOCKS FOR MINDO/3 */ /* END OF MINDO/3 COMMON BLOCKS */ debug = i_indx(keywrd_1.keywrd, "MOLDAT", 80L, 6L) != 0; lpm3 = i_indx(keywrd_1.keywrd, "PM3", 80L, 3L) != 0; mindo3 = i_indx(keywrd_1.keywrd, "MINDO", 80L, 5L) != 0; uhf = i_indx(keywrd_1.keywrd, "UHF", 80L, 3L) != 0; am1 = i_indx(keywrd_1.keywrd, "AM1", 80L, 3L) != 0; kharge = 0; i = i_indx(keywrd_1.keywrd, "CHARGE", 80L, 6L); if (i != 0) { kharge = (integer) reada_(keywrd_1.keywrd, &i, 80L); } elecs = (doublereal) (-kharge); ndorbs = 0; atheat_1.atheat = 0.; eat = 0.; molkst_1.numat = 0; if (! am1 && ! lpm3) { /* SWITCH IN MNDO PARAMETERS */ /* ZERO OUT GAUSSIAN 1 FOR CARBON. THIS WILL BE USED IN */ /* ROTATE TO DECIDE WHETHER OR NOT TO USE AM1-TYPE GAUSSIANS */ ideas_1.guess1[5] = 0.; for (i = 1; i <= 107; ++i) { if (! mindo3) { polvol_1.polvol[i - 1] = mndo_1.polvom[i - 1]; } expont_1.zs[i - 1] = mndo_1.zsm[i - 1]; expont_1.zp[i - 1] = mndo_1.zpm[i - 1]; expont_1.zd[i - 1] = mndo_1.zdm[i - 1]; onelec_1.uss[i - 1] = mndo_1.ussm[i - 1]; onelec_1.upp[i - 1] = mndo_1.uppm[i - 1]; onelec_1.udd[i - 1] = mndo_1.uddm[i - 1]; betas_1.betas[i - 1] = mndo_1.betasm[i - 1]; betas_1.betap[i - 1] = mndo_1.betapm[i - 1]; betas_1.betad[i - 1] = mndo_1.betadm[i - 1]; alpha_1.alp[i - 1] = mndo_1.alpm[i - 1]; atomic_1.eisol[i - 1] = mndo_1.eisolm[i - 1]; multip_1.dd[i - 1] = mndo_1.ddm[i - 1]; multip_1.qq[i - 1] = mndo_1.qqm[i - 1]; multip_1.am[i - 1] = mndo_1.amm[i - 1]; multip_1.ad[i - 1] = mndo_1.adm[i - 1]; multip_1.aq[i - 1] = mndo_1.aqm[i - 1]; twoele_1.gss[i - 1] = mndo_1.gssm[i - 1]; twoele_1.gpp[i - 1] = mndo_1.gppm[i - 1]; twoele_1.gsp[i - 1] = mndo_1.gspm[i - 1]; twoele_1.gp2[i - 1] = mndo_1.gp2m[i - 1]; twoele_1.hsp[i - 1] = mndo_1.hspm[i - 1]; /* L10: */ } } else if (! am1 && lpm3) { /* SWITCH IN MNDO-PM3 PARAMETERS */ for (i = 1; i <= 107; ++i) { for (j = 1; j <= 10; ++j) { ideas_1.guess1[i + j * 107 - 108] = ideap_1.guesp1[i + j * 107 - 108]; ideas_1.guess2[i + j * 107 - 108] = ideap_1.guesp2[i + j * 107 - 108]; /* L20: */ ideas_1.guess3[i + j * 107 - 108] = ideap_1.guesp3[i + j * 107 - 108]; } polvol_1.polvol[i - 1] = pm3_1.polvop[i - 1]; expont_1.zs[i - 1] = pm3_1.zspm3[i - 1]; expont_1.zp[i - 1] = pm3_1.zppm3[i - 1]; expont_1.zd[i - 1] = pm3_1.zdpm3[i - 1]; onelec_1.uss[i - 1] = pm3_1.usspm3[i - 1]; onelec_1.upp[i - 1] = pm3_1.upppm3[i - 1]; onelec_1.udd[i - 1] = pm3_1.uddpm3[i - 1]; betas_1.betas[i - 1] = pm3_1.betasp[i - 1]; betas_1.betap[i - 1] = pm3_1.betapp[i - 1]; betas_1.betad[i - 1] = pm3_1.betadp[i - 1]; alpha_1.alp[i - 1] = pm3_1.alppm3[i - 1]; atomic_1.eisol[i - 1] = pm3_1.eisolp[i - 1]; multip_1.dd[i - 1] = pm3_1.ddpm3[i - 1]; multip_1.qq[i - 1] = pm3_1.qqpm3[i - 1]; multip_1.am[i - 1] = pm3_1.ampm3[i - 1]; multip_1.ad[i - 1] = pm3_1.adpm3[i - 1]; multip_1.aq[i - 1] = pm3_1.aqpm3[i - 1]; twoele_1.gss[i - 1] = pm3_1.gsspm3[i - 1]; twoele_1.gpp[i - 1] = pm3_1.gpppm3[i - 1]; twoele_1.gsp[i - 1] = pm3_1.gsppm3[i - 1]; twoele_1.gp2[i - 1] = pm3_1.gp2pm3[i - 1]; twoele_1.hsp[i - 1] = pm3_1.hsppm3[i - 1]; /* L30: */ } } /* SWAP IN OLD PARAMETERS FOR ELEMENTS. OLDE CONTAINS THE */ /* CHARACTER NAME OF THE ELEMENT, AND ISWAP(1,1:NEWELE) CONTAINS */ /* THE ATOMIC NUMBER OF THE ELEMENT. ISWAP(2,1:NEWELE) CONTAINS */ /* THE STORAGE ADDRESS OF THE OLD SET OF PARAMETERS. */ newele = 2; s_copy(olde, " S1978", 6L, 6L); iswap[0] = 16; iswap[1] = 91; s_copy(olde + 6, "SI1978", 6L, 6L); iswap[2] = 14; iswap[3] = 90; i__1 = newele; for (k = 1; k <= i__1; ++k) { if (i_indx(keywrd_1.keywrd, olde + (k - 1) * 6, 80L, 6L) != 0) { i = iswap[(k << 1) - 2]; j = iswap[(k << 1) - 1]; s_copy(refs_1.allref + (i + 213) * 80, refs_1.allref + (j - 1) * 80, 80L, 80L); s_copy(refs_1.allref + (i - 1) * 80, refs_1.allref + (j - 1) * 80, 80L, 80L); expont_1.zs[i - 1] = expont_1.zs[j - 1]; expont_1.zp[i - 1] = expont_1.zp[j - 1]; expont_1.zd[i - 1] = expont_1.zd[j - 1]; onelec_1.uss[i - 1] = onelec_1.uss[j - 1]; onelec_1.upp[i - 1] = onelec_1.upp[j - 1]; onelec_1.udd[i - 1] = onelec_1.udd[j - 1]; betas_1.betas[i - 1] = betas_1.betas[j - 1]; betas_1.betap[i - 1] = betas_1.betap[j - 1]; betas_1.betad[i - 1] = betas_1.betad[j - 1]; alpha_1.alp[i - 1] = alpha_1.alp[j - 1]; atomic_1.eisol[i - 1] = atomic_1.eisol[j - 1]; multip_1.dd[i - 1] = multip_1.dd[j - 1]; multip_1.qq[i - 1] = multip_1.qq[j - 1]; multip_1.am[i - 1] = multip_1.am[j - 1]; multip_1.ad[i - 1] = multip_1.ad[j - 1]; multip_1.aq[i - 1] = multip_1.aq[j - 1]; if (twoele_1.gss[j - 1] != 0.) { twoele_1.gss[i - 1] = twoele_1.gss[j - 1]; } if (twoele_1.gpp[j - 1] != 0.) { twoele_1.gpp[i - 1] = twoele_1.gpp[j - 1]; } if (twoele_1.gsp[j - 1] != 0.) { twoele_1.gsp[i - 1] = twoele_1.gsp[j - 1]; } if (twoele_1.gp2[j - 1] != 0.) { twoele_1.gp2[i - 1] = twoele_1.gp2[j - 1]; } if (twoele_1.hsp[j - 1] != 0.) { twoele_1.hsp[i - 1] = twoele_1.hsp[j - 1]; } } /* L40: */ } if (mindo3) { for (i = 1; i <= 17; ++i) { if (i == 2 || i == 10) { goto L50; } onelec_1.uss[i - 1] = onele3_1.uss3[i - 1]; onelec_1.upp[i - 1] = onele3_1.upp3[i - 1]; atomic_1.eisol[i - 1] = atomi3_1.eisol3[i - 1]; atomic_1.eheat[i - 1] = atomi3_1.eheat3[i - 1]; expont_1.zs[i - 1] = expon3_1.zs3[i - 1]; expont_1.zp[i - 1] = expon3_1.zp3[i - 1]; L50: ; } } if (onelec_1.uss[0] > -1.) { s_wsfe(&io___16); e_wsfe(); s_stop("", 0L); } ia = 1; ib = 0; nheavy = 0; i__1 = geokst_1.natoms; for (ii = 1; ii <= i__1; ++ii) { if (geokst_1.labels[ii - 1] == 99 || geokst_1.labels[ii - 1] == 107) { goto L100; } ++molkst_1.numat; molkst_1.nat[molkst_1.numat - 1] = geokst_1.labels[ii - 1]; molkst_1.nfirst[molkst_1.numat - 1] = ia; ni = molkst_1.nat[molkst_1.numat - 1]; atheat_1.atheat += atomic_1.eheat[ni - 1]; eat += atomic_1.eisol[ni - 1]; elecs += core_1.core[ni - 1]; ib = ia + natorb_1.natorb[ni - 1] - 1; molkst_1.nmidle[molkst_1.numat - 1] = ib; if (natorb_1.natorb[ni - 1] == 9) { ndorbs += 5; } if (natorb_1.natorb[ni - 1] == 9) { molkst_1.nmidle[molkst_1.numat - 1] = ia + 3; } molkst_1.nlast[molkst_1.numat - 1] = ib; if (ia > 215) { goto L240; } molorb_1.uspd[ia - 1] = onelec_1.uss[ni - 1]; if (ia == ib) { goto L90; } k = ia + 1; k1 = ia + 3; i__2 = k1; for (j = k; j <= i__2; ++j) { if (j > 215) { goto L240; } molorb_1.uspd[j - 1] = onelec_1.upp[ni - 1]; /* L60: */ } ++nheavy; /* L70: */ if (k1 == ib) { goto L90; } k = k1 + 1; i__2 = ib; for (j = k; j <= i__2; ++j) { /* L80: */ molorb_1.uspd[j - 1] = onelec_1.udd[ni - 1]; } L90: L100: ia = ib + 1; } refer_(); atheat_1.atheat -= eat * 23.061; molkst_1.norbs = molkst_1.nlast[molkst_1.numat - 1]; if (molkst_1.norbs > 215) { s_wsfe(&io___23); do_fio(&c__1, (char *)&c__215, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&molkst_1.norbs, (ftnlen)sizeof(integer)); e_wsfe(); s_stop("", 0L); } nlight = molkst_1.numat - nheavy; n2el = nheavy * 50 * (nheavy - 1) + nheavy * 10 * nlight + nlight * ( nlight - 1) / 2; if (n2el > 219386) { s_wsfe(&io___26); do_fio(&c__1, (char *)&c_b29, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&n2el, (ftnlen)sizeof(integer)); e_wsfe(); s_stop("", 0L); } /* NOW TO CALCULATE THE NUMBER OF LEVELS OCCUPIED */ trip = i_indx(keywrd_1.keywrd, "TRIPLET", 80L, 7L) != 0; exci = i_indx(keywrd_1.keywrd, "EXCITED", 80L, 7L) != 0; birad = exci || i_indx(keywrd_1.keywrd, "BIRAD", 80L, 5L) != 0; if (i_indx(keywrd_1.keywrd, "C.I.", 80L, 4L) != 0 && uhf) { s_wsfe(&io___30); e_wsfe(); s_stop("", 0L); } /* NOW TO WORK OUT HOW MANY ELECTRONS ARE IN EACH TYPE OF SHELL */ molkst_1.nalpha = 0; molkst_1.nbeta = 0; /* PROTECT DUMB USERS FROM DUMB ERRORS! */ /* Computing MAX */ d__1 = elecs + .5; molkst_1.nelecs = (integer) max(d__1,0.); /* Computing MIN */ i__1 = molkst_1.norbs << 1; molkst_1.nelecs = min(i__1,molkst_1.nelecs); molkst_1.nclose = 0; molkst_1.nopen = 0; if (uhf) { molkst_1.fract = 1.; molkst_1.nbeta = molkst_1.nelecs / 2; if (trip) { if (molkst_1.nbeta << 1 != molkst_1.nelecs) { s_wsfe(&io___31); e_wsfe(); s_stop("", 0L); } else { s_wsfe(&io___32); e_wsfe(); --molkst_1.nbeta; } } if (i_indx(keywrd_1.keywrd, "QUART", 80L, 5L) != 0) { if (molkst_1.nbeta << 1 == molkst_1.nelecs) { s_wsfe(&io___33); e_wsfe(); s_stop("", 0L); } else { s_wsfe(&io___34); e_wsfe(); --molkst_1.nbeta; } } if (i_indx(keywrd_1.keywrd, "QUINT", 80L, 5L) != 0) { if (molkst_1.nbeta << 1 != molkst_1.nelecs) { s_wsfe(&io___35); e_wsfe(); s_stop("", 0L); } else { s_wsfe(&io___36); e_wsfe(); molkst_1.nbeta += -2; } } if (i_indx(keywrd_1.keywrd, "SEXT", 80L, 4L) != 0) { if (molkst_1.nbeta << 1 == molkst_1.nelecs) { s_wsfe(&io___37); e_wsfe(); s_stop("", 0L); } else { s_wsfe(&io___38); e_wsfe(); --molkst_1.nbeta; } } molkst_1.nalpha = molkst_1.nelecs - molkst_1.nbeta; s_wsfe(&io___39); do_fio(&c__1, (char *)&molkst_1.nalpha, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&molkst_1.nbeta, (ftnlen)sizeof(integer)); e_wsfe(); } else { /* NOW TO DETERMINE OPEN AND CLOSED SHELLS */ open = FALSE_; ielec = 0; ilevel = 0; if (trip || exci || birad) { if (molkst_1.nelecs / 2 << 1 != molkst_1.nelecs) { s_wsfe(&io___43); e_wsfe(); s_stop("", 0L); } if (birad) { s_wsfe(&io___44); e_wsfe(); } if (trip) { s_wsfe(&io___45); e_wsfe(); } if (exci) { s_wsfe(&io___46); e_wsfe(); } ielec = 2; ilevel = 2; } else if (molkst_1.nelecs / 2 << 1 != molkst_1.nelecs) { ielec = 1; ilevel = 1; } if (i_indx(keywrd_1.keywrd, "QUART", 80L, 5L) != 0) { s_wsfe(&io___47); e_wsfe(); ielec = 3; ilevel = 3; } if (i_indx(keywrd_1.keywrd, "QUINT", 80L, 5L) != 0) { s_wsfe(&io___48); e_wsfe(); ielec = 4; ilevel = 4; } if (i_indx(keywrd_1.keywrd, "SEXT", 80L, 4L) != 0) { s_wsfe(&io___49); e_wsfe(); ielec = 5; ilevel = 5; } i = i_indx(keywrd_1.keywrd, "OPEN(", 80L, 5L); if (i != 0) { ielec = (integer) reada_(keywrd_1.keywrd, &i, 80L); i__1 = i + 7; ilevel = (integer) reada_(keywrd_1.keywrd, &i__1, 80L); } molkst_1.nclose = molkst_1.nelecs / 2; molkst_1.nopen = molkst_1.nelecs - (molkst_1.nclose << 1); if (ielec != 0) { if (molkst_1.nelecs / 2 << 1 == molkst_1.nelecs != (ielec / 2 << 1 == ielec)) { s_wsfe(&io___50); e_wsfe(); s_stop("", 0L); } molkst_1.nclose -= ielec / 2; molkst_1.nopen = ilevel; molkst_1.fract = ielec * 1. / ilevel; s_wsfe(&io___51); do_fio(&c__1, (char *)&molkst_1.nclose, (ftnlen)sizeof(integer)); e_wsfe(); } s_wsfe(&io___52); do_fio(&c__1, (char *)&molkst_1.nclose, (ftnlen)sizeof(integer)); e_wsfe(); if (molkst_1.nopen != 0 && (d__1 = molkst_1.fract - 1., abs(d__1)) < 1e-4) { s_wsfe(&io___53); do_fio(&c__1, (char *)&molkst_1.nopen, (ftnlen)sizeof(integer)); e_wsfe(); } if (molkst_1.nopen != 0 && (d__1 = molkst_1.fract - 1., abs(d__1)) > 1e-4) { s_wsfe(&io___54); do_fio(&c__1, (char *)&molkst_1.fract, (ftnlen)sizeof(doublereal)) ; do_fio(&c__1, (char *)&molkst_1.nopen, (ftnlen)sizeof(integer)); e_wsfe(); } molkst_1.nopen += molkst_1.nclose; } /* # WRITE(6,'('' NOPEN,NCLOSE,NALPHA,NBETA,FRACT'',4I4,F12.5)') */ /* # 1 NOPEN, NCLOSE, NLAPHA, NBETA, FRACT */ yy = (real) kharge / (molkst_1.norbs + 1e-10); l = 0; i__1 = molkst_1.numat; for (i = 1; i <= i__1; ++i) { ni = molkst_1.nat[i - 1]; xx = 1. / (molkst_1.nlast[i - 1] - molkst_1.nfirst[i - 1] + 1 + 1e-10) ; w = core_1.core[ni - 1] * xx - yy; ia = molkst_1.nfirst[i - 1]; ic = molkst_1.nmidle[i - 1]; ib = molkst_1.nlast[i - 1]; i__2 = ic; for (j = ia; j <= i__2; ++j) { ++l; /* L110: */ molorb_1.pspd[l - 1] = w; } i__2 = ib; for (j = ic + 1; j <= i__2; ++j) { ++l; /* L120: */ molorb_1.pspd[l - 1] = 0.; } /* L130: */ } /* WRITE OUT THE INTERATOMIC DISTANCES */ gmetry_(geom_1.geo, coord); rmin = 100.; l = 0; i__1 = molkst_1.numat; for (i = 1; i <= i__1; ++i) { i__2 = i; for (j = 1; j <= i__2; ++j) { ++l; /* Computing 2nd power */ d__1 = coord[i * 3 - 3] - coord[j * 3 - 3]; /* Computing 2nd power */ d__2 = coord[i * 3 - 2] - coord[j * 3 - 2]; /* Computing 2nd power */ d__3 = coord[i * 3 - 1] - coord[j * 3 - 1]; scrach_1.rxyz[l - 1] = sqrt(d__1 * d__1 + d__2 * d__2 + d__3 * d__3); if (rmin > scrach_1.rxyz[l - 1] && i != j && (molkst_1.nat[i - 1] < 103 || molkst_1.nat[j - 1] < 103)) { iminr = i; jminr = j; rmin = scrach_1.rxyz[l - 1]; } /* L140: */ } } molmec_1.nnhco = 0; /* SET UP MOLECULAR-MECHANICS CORRECTION TO -(C=O)-(NH)- LINKAGE */ /* THIS WILL BE USED IF MMOK HAS BEEN SPECIFIED. */ molmec_1.itype = 1; if (i_indx(keywrd_1.keywrd, "AM1", 80L, 3L) != 0) { molmec_1.itype = 2; } if (i_indx(keywrd_1.keywrd, "PM3", 80L, 3L) != 0) { molmec_1.itype = 3; } if (i_indx(keywrd_1.keywrd, "MINDO", 80L, 5L) != 0) { molmec_1.itype = 4; } /* IDENTIFY O=C-N-H SYSTEMS VIA THE INTERATOMIC DISTANCES MATRIX */ i__2 = molkst_1.numat; for (i = 1; i <= i__2; ++i) { if (molkst_1.nat[i - 1] != 8) { goto L190; } i__1 = molkst_1.numat; for (j = 1; j <= i__1; ++j) { if (molkst_1.nat[j - 1] != 6) { goto L180; } ij = max(i,j); ji = i + j - ij; if (scrach_1.rxyz[ij * (ij - 1) / 2 + ji - 1] > 1.3f) { goto L180; } i__3 = molkst_1.numat; for (k = 1; k <= i__3; ++k) { if (molkst_1.nat[k - 1] != 7) { goto L170; } jk = max(j,k); kj = j + k - jk; if (scrach_1.rxyz[jk * (jk - 1) / 2 + kj - 1] > 1.6f) { goto L170; } i__4 = molkst_1.numat; for (l = 1; l <= i__4; ++l) { if (molkst_1.nat[l - 1] != 1) { goto L160; } kl = max(k,l); lk = k + l - kl; if (scrach_1.rxyz[kl * (kl - 1) / 2 + lk - 1] > 1.3f) { goto L160; } /* WE HAVE A H-N-C=O SYSTEM. THE ATOM NUMBERS ARE L-K-J -I */ /* NOW SEARCH OUT ATOM ATTACHED TO NITROGEN, THIS SPECIF IES */ /* THE SYSTEM X-N-C=O */ i__5 = molkst_1.numat; for (m = 1; m <= i__5; ++m) { if (m == k || m == l || m == j) { goto L150; } mk = max(m,k); km = m + k - mk; if (scrach_1.rxyz[mk * (mk - 1) / 2 + km - 1] > 1.7f) { goto L150; } ++molmec_1.nnhco; molmec_1.nhco[(molmec_1.nnhco << 2) - 4] = i; molmec_1.nhco[(molmec_1.nnhco << 2) - 3] = j; molmec_1.nhco[(molmec_1.nnhco << 2) - 2] = k; molmec_1.nhco[(molmec_1.nnhco << 2) - 1] = m; ++molmec_1.nnhco; molmec_1.nhco[(molmec_1.nnhco << 2) - 4] = i; molmec_1.nhco[(molmec_1.nnhco << 2) - 3] = j; molmec_1.nhco[(molmec_1.nnhco << 2) - 2] = k; molmec_1.nhco[(molmec_1.nnhco << 2) - 1] = l; goto L160; L150: ; } L160: ; } L170: ; } L180: ; } L190: ; } if (molmec_1.nnhco != 0) { if (i_indx(keywrd_1.keywrd, "MMOK", 80L, 4L) != 0) { s_wsfe(&io___73); do_fio(&c__1, " MOLECULAR MECHANICS CORRECTION APPLIED TO PEPTID" "E LINKAGE", 58L); e_wsfe(); } else if (i_indx(keywrd_1.keywrd, "NOMM", 80L, 4L) != 0) { s_wsfe(&io___74); do_fio(&c__1, " THERE ARE ", 11L); i__2 = molmec_1.nnhco / 2; do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); do_fio(&c__1, " PEPTIDE LINKAGES", 17L); do_fio(&c__1, " IDENTIFIED IN THIS SYSTEM", 26L); e_wsfe(); s_wsfe(&io___75); do_fio(&c__1, " IF YOU WANT MM CORRECTION TO THE CONH BARRIER, A" "DD THE KEY-WORD \"MMOK\"", 71L); e_wsfe(); molmec_1.nnhco = 0; } else { s_wsfe(&io___76); do_fio(&c__1, " THIS SYSTEM CONTAINS -HNCO- GROUPS.", 36L); e_wsfe(); s_wsfe(&io___77); do_fio(&c__1, " YOU MUST SPECIFY \"NOMM\" OR \"MMOK\" REGARDING " "MOLECULAR MECHANICS CORRECTION", 75L); e_wsfe(); s_stop("", 0L); } } if (i_indx(keywrd_1.keywrd, "NOINTER", 80L, 7L) == 0) { s_wsfe(&io___78); e_wsfe(); vecprt_(scrach_1.rxyz, &molkst_1.numat); } if (rmin < .8 && i_indx(keywrd_1.keywrd, "GEO-OK", 80L, 6L) == 0) { s_wsfe(&io___79); do_fio(&c__1, (char *)&iminr, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&jminr, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&rmin, (ftnlen)sizeof(doublereal)); e_wsfe(); s_stop("", 0L); } if (! debug) { return 0; } s_wsfe(&io___80); do_fio(&c__1, (char *)&molkst_1.numat, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&molkst_1.norbs, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&ndorbs, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&geokst_1.natoms, (ftnlen)sizeof(integer)); e_wsfe(); s_wsfe(&io___81); i__2 = molkst_1.norbs; for (i = 1; i <= i__2; ++i) { do_fio(&c__1, (char *)&molorb_1.uspd[i - 1], (ftnlen)sizeof( doublereal)); } e_wsfe(); s_wsfe(&io___82); i__2 = molkst_1.norbs; for (i = 1; i <= i__2; ++i) { do_fio(&c__1, (char *)&molorb_1.pspd[i - 1], (ftnlen)sizeof( doublereal)); } e_wsfe(); return 0; L240: s_wsfe(&io___83); e_wsfe(); s_wsfe(&io___84); do_fio(&c__1, (char *)&c__215, (ftnlen)sizeof(integer)); e_wsfe(); s_stop("", 0L); return 0; } /* moldat_ */