mopac606_nbo/src/h1elec.f

   1       SUBROUTINE H1ELEC(NI,NJ,XI,XJ,SMAT)
   2       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
   3       DIMENSION XI(3),XJ(3),SMAT(9,9), BI(9), BJ(9)
   4 C***********************************************************************
   5 C
   6 C  H1ELEC FORMS THE ONE-ELECTRON MATRIX BETWEEN TWO ATOMS.
   7 C
   8 C   ON INPUT    NI   = ATOMIC NO. OF FIRST ATOM.
   9 C               NJ   = ATOMIC NO. OF SECOND ATOM.
  10 C               XI   = COORDINATES OF FIRST ATOM.
  11 C               XJ   = COORDINATES OF SECOND ATOM.
  12 C
  13 C   ON OUTPUT   SMAT = MATRIX OF ONE-ELECTRON INTERACTIONS.
  14 C
  15 C***********************************************************************
  16       COMMON /BETAS / BETAS(107),BETAP(107),BETAD(107)
  17       COMMON /MOLMEC/ HTYPE(4),NHCO(4,20),NNHCO,ITYPE
  18       COMMON /BETA3 / BETA3(153)
  19       COMMON /KEYWRD/ KEYWRD
  20       COMMON /EULER / TVEC(3,3), ID
  21       COMMON /VSIPS / VS(107),VP(107),VD(107)
  22       COMMON /NATORB/ NATORB(107)
  23       COMMON /NUMCAL/ NUMCAL
  24       COMMON /UCELL / L1L,L2L,L3L,L1U,L2U,L3U
  25       SAVE SBITS, XJUC
  26       DIMENSION SBITS(9,9), LIMS(3,2), XJUC(3)
  27       CHARACTER*241 KEYWRD
  28       EQUIVALENCE (L1L,LIMS(1,1))
  29       DATA ICALCN/0/
  30       IF(NI.EQ.102.OR.NJ.EQ.102)THEN
  31          IF(SQRT((XI(1)-XJ(1))**2+
  32      1        (XI(2)-XJ(2))**2+
  33      2        (XI(3)-XJ(3))**2) .GT.1.8)THEN
  34             DO 10 I=1,9
  35                DO 10 J=1,9
  36    10       SMAT(I,J)=0.D0
  37             RETURN
  38          ENDIF
  39       ENDIF
  40       IF(ID.EQ.0) THEN
  41          IF (ICALCN.NE.NUMCAL) ICALCN=NUMCAL
  42          CALL DIAT(NI,NJ,XI,XJ,SMAT)
  43       ELSE
  44          IF (ICALCN.NE.NUMCAL) THEN
  45             ICALCN=NUMCAL
  46             DO 20 I=1,ID
  47                LIMS(I,1)=-1
  48    20       LIMS(I,2)= 1
  49             DO 30 I=ID+1,3
  50                LIMS(I,1)=0
  51    30       LIMS(I,2)=0
  52          ENDIF
  53          DO 40 I=1,9
  54             DO 40 J=1,9
  55    40    SMAT(I,J)=0
  56          DO 70 I=L1L,L1U
  57             DO 70 J=L2L,L2U
  58                DO 70 K=L3L,L3U
  59                   DO 50 L=1,3
  60    50             XJUC(L)=XJ(L)+TVEC(L,1)*I+TVEC(L,2)*J+TVEC(L,3)*K
  61                   CALL DIAT(NI,NJ,XI,XJUC,SBITS)
  62                   DO 60 L=1,9
  63                      DO 60 M=1,9
  64    60             SMAT(L,M)=SMAT(L,M)+SBITS(L,M)
  65    70    CONTINUE
  66       ENDIF
  67       IF(ITYPE.NE.4) GOTO 80
  68 C
  69 C     START OF MNDO, AM1, OR PM3 OPTION
  70 C
  71       II=MAX(NI,NJ)
  72       NBOND=(II*(II-1))/2+NI+NJ-II
  73       IF(NBOND.GT.153)GOTO 90
  74       BI(1)=BETA3(NBOND)*VS(NI)
  75       BI(2)=BETA3(NBOND)*VP(NI)
  76       BI(3)=BI(2)
  77       BI(4)=BI(2)
  78       BJ(1)=BETA3(NBOND)*VS(NJ)
  79       BJ(2)=BETA3(NBOND)*VP(NJ)
  80       BJ(3)=BJ(2)
  81       BJ(4)=BJ(2)
  82       GOTO 90
  83    80 CONTINUE
  84       BI(1)=BETAS(NI)*0.5D0
  85       BI(2)=BETAP(NI)*0.5D0
  86       BI(3)=BI(2)
  87       BI(4)=BI(2)
  88       BI(5)=BETAD(NI)*0.5D0
  89       BI(6)=BI(5)
  90       BI(7)=BI(5)
  91       BI(8)=BI(5)
  92       BI(9)=BI(5)
  93       BJ(1)=BETAS(NJ)*0.5D0
  94       BJ(2)=BETAP(NJ)*0.5D0
  95       BJ(3)=BJ(2)
  96       BJ(4)=BJ(2)
  97       BJ(5)=BETAD(NJ)*0.5D0
  98       BJ(6)=BJ(5)
  99       BJ(7)=BJ(5)
 100       BJ(8)=BJ(5)
 101       BJ(9)=BJ(5)
 102    90 CONTINUE
 103       NORBI=NATORB(NI)
 104       NORBJ=NATORB(NJ)
 105       IF(NORBI.EQ.9.OR.NORBJ.EQ.9) THEN
 106 C
 107 C    IN THE CALCULATION OF THE ONE-ELECTRON TERMS THE GEOMETRIC MEAN
 108 C    OF THE TWO BETA VALUES IS BEING USED IF ONE OF THE ATOMS
 109 C    CONTAINS D-ORBITALS.
 110          DO 100 J=1,NORBJ
 111             DO 100 I=1,NORBI
 112   100    SMAT(I,J)=-2.0D0*SMAT(I,J)*SQRT(BI(I)*BJ(J))
 113       ELSE
 114          DO 110 J=1,NORBJ
 115             DO 110 I=1,NORBI
 116   110    SMAT(I,J)=SMAT(I,J)*(BI(I)+BJ(J))
 117       ENDIF
 118       RETURN
 119       END