mopac606_nbo/src/formxy.f

   1       SUBROUTINE FORMXY(W,KR,WCA,WCB,CA,NA,CB,NB)
   2       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
   3       DIMENSION W(100), WCA(NA), WCB(NB), CA(NA), CB(NB)
   4 C***********************************************************************
   5 C
   6 C    EACH OF THE NA ELEMENTS OF WCA WILL ADD ON THE NB ELECTROSTATIC
   7 C    TERMS FROM ATOM B IN CB
   8 C
   9 C    EACH OF THE NB ELEMENTS OF WCB WILL ADD ON THE NA ELECTROSTATIC
  10 C    TERMS FROM ATOM A IN CA
  11 C
  12 C    BOTH SUMS WILL INVOLVE THE NA*NB TERMS IN ARRAY W.  ONCE USED,
  13 C    W WILL BE INCREMENTED BY NA*NB.
  14 C
  15 C NA=1 IF ATOM 'A' IS A HYDROGEN, NA=10 IF ATOM 'A' IS NOT A HYDROGEN
  16 C NB=1 IF ATOM 'B' IS A HYDROGEN, NB=10 IF ATOM 'B' IS NOT A HYDROGEN
  17 C
  18 C***********************************************************************
  19       COMMON /KEYWRD/ KEYWRD
  20       COMMON /NUMCAL/ NUMCAL
  21       LOGICAL MINDO3
  22       CHARACTER KEYWRD*241
  23       DATA ICALCN/0/
  24       IF(ICALCN.NE.NUMCAL)THEN
  25          ICALCN=NUMCAL
  26          MINDO3=(INDEX(KEYWRD,'MINDO').NE.0)
  27       ENDIF
  28       IF(MINDO3)THEN
  29          W1=W(1)*0.25D0
  30 C
  31 C   CALCULATE THE TOTAL NUMBER OF ELECTRONS ON ATOMS A AND B
  32 C
  33          PA=CA(1)
  34          PB=CB(1)
  35          IF(NA.GT.1.AND.NB.GT.1)THEN
  36             PWA=(PA+CA(3)+CA(6)+CA(10))*W1
  37             PWB=(PB+CB(3)+CB(6)+CB(10))*W1
  38             WCA(1)=WCA(1)+PWB
  39             WCA(3)=WCA(3)+PWB
  40             WCA(6)=WCA(6)+PWB
  41             WCA(10)=WCA(10)+PWB
  42             WCB(1)=WCB(1)+PWA
  43             WCB(3)=WCB(3)+PWA
  44             WCB(6)=WCB(6)+PWA
  45             WCB(10)=WCB(10)+PWA
  46          ELSEIF(NA.GT.1)THEN
  47             PWB=PB*W1
  48             WCA(1)=WCA(1)+PWB
  49             WCA(3)=WCA(3)+PWB
  50             WCA(6)=WCA(6)+PWB
  51             WCA(10)=WCA(10)+PWB
  52             WCB(1)=WCB(1)+(PA+CA(3)+CA(6)+CA(10))*W1
  53          ELSEIF(NB.GT.1)THEN
  54             PWA=PA*W1
  55             WCA(1)=WCA(1)+(PB+CB(3)+CB(6)+CB(10))*W1
  56             WCB(1)=WCB(1)+PWA
  57             WCB(3)=WCB(3)+PWA
  58             WCB(6)=WCB(6)+PWA
  59             WCB(10)=WCB(10)+PWA
  60          ELSE
  61             WCA(1)=WCA(1)+PB*W1
  62             WCB(1)=WCB(1)+PA*W1
  63          ENDIF
  64          KR=KR+1
  65          RETURN
  66       ENDIF
  67       IF(NA.GT.1.AND.NB.GT.1)THEN
  68 C
  69 C   BOTH ATOMS 'A' AND 'B' ARE HEAVY ATOMS
  70 C
  71 C
  72 C  THIS COMMENTED-OUT CODE RUNS SLOWER ON A SCALAR MACHINE THAN THE
  73 C  EXPLICIT CODE ACTUALLY USED HERE.  THE CODE COMMENTED OUT IS PROVIDED
  74 C  FOR USERS WHO WANT TO VECTORIZE THE CODE
  75 C
  76 C#         IJP=0
  77 C#         DO 3 II=1,4
  78 C#         DO 4 JJ=1,II
  79 C#         IJ=IJP*10
  80 C#         IJP=IJP+1
  81 C#         KL=-10+IJP
  82 C#         SUM1=0.D0
  83 C#         SUM2=0.D0
  84 C#         JI=0
  85 C#         DO 10 I=1,4
  86 C#            DO 10 J=1,I
  87 C#               JI=JI+1
  88 C#               IJ=IJ+1
  89 C#               KL=KL+10
  90 C#               FACT=1.D0
  91 C#               IF(I.EQ.J)FACT=0.5D0
  92 C#               SUM1=SUM1+CB(JI)*W(IJ)*FACT
  93 C#   10    SUM2=SUM2+CA(JI)*W(KL)*FACT
  94 C#      IF(II.EQ.JJ)THEN
  95 C#      SUM1=SUM1*0.5D0
  96 C#      SUM2=SUM2*0.5D0
  97 C#      ENDIF
  98 C#      WCA(IJP)=WCA(IJP)+SUM1
  99 C#      WCB(IJP)=WCB(IJP)+SUM2
 100 C#   4  CONTINUE
 101 C#   3  CONTINUE
 102 C
 103 C   START OF EXPLICIT CODE
 104 C
 105          WCA(1)=WCA(1)+
 106      10.25D0*(CB(1)*W(1) + CB(3)*W(3) + CB(6)*W(6) + CB(10)*W(10)) +
 107      20.5D0*( CB(2)*W(2) + CB(4)*W(4) + CB(5)*W(5) +
 108      3        CB(7)*W(7) + CB(8)*W(8) + CB(9)*W(9))
 109          WCA(2)=WCA(2)+
 110      10.5D0*(CB(1)*W(11) + CB(3)*W(13) + CB(6)*W(16) + CB(10)*W(20)) +
 111      2CB(2)*W(12) + CB(4)*W(14) + CB(5)*W(15) +
 112      3CB(7)*W(17) + CB(8)*W(18) + CB(9)*W(19)
 113          WCA(3)=WCA(3)+
 114      10.25D0*(CB(1)*W(21) + CB(3)*W(23) + CB(6)*W(26) + CB(10)*W(30)) +
 115      20.5D0*(CB(2)*W(22) + CB(4)*W(24) + CB(5)*W(25) +
 116      3       CB(7)*W(27) + CB(8)*W(28) + CB(9)*W(29))
 117          WCA(4)=WCA(4)+
 118      10.5D0*(CB(1)*W(31) + CB(3)*W(33) + CB(6)*W(36) + CB(10)*W(40)) +
 119      2CB(2)*W(32) + CB(4)*W(34) + CB(5)*W(35) +
 120      3CB(7)*W(37) + CB(8)*W(38) + CB(9)*W(39)
 121          WCA(5)=WCA(5)+
 122      10.5D0*(CB(1)*W(41) + CB(3)*W(43) + CB(6)*W(46) + CB(10)*W(50)) +
 123      2CB(2)*W(42) + CB(4)*W(44) + CB(5)*W(45) +
 124      3CB(7)*W(47) + CB(8)*W(48) + CB(9)*W(49)
 125          WCA(6)=WCA(6)+
 126      10.25D0*(CB(1)*W(51) + CB(3)*W(53) + CB(6)*W(56) + CB(10)*W(60)) +
 127      20.5D0*(CB(2)*W(52) + CB(4)*W(54) + CB(5)*W(55) +
 128      3       CB(7)*W(57) + CB(8)*W(58) + CB(9)*W(59))
 129          WCA(7)=WCA(7)+
 130      10.5D0*(CB(1)*W(61) + CB(3)*W(63) + CB(6)*W(66) + CB(10)*W(70)) +
 131      2CB(2)*W(62) + CB(4)*W(64) + CB(5)*W(65) +
 132      3CB(7)*W(67) + CB(8)*W(68) + CB(9)*W(69)
 133          WCA(8)=WCA(8)+
 134      10.5D0*(CB(1)*W(71) + CB(3)*W(73) + CB(6)*W(76) + CB(10)*W(80)) +
 135      2CB(2)*W(72) + CB(4)*W(74) + CB(5)*W(75) +
 136      3CB(7)*W(77) + CB(8)*W(78) + CB(9)*W(79)
 137          WCA(9)=WCA(9)+
 138      10.5D0*(CB(1)*W(81) + CB(3)*W(83) + CB(6)*W(86) + CB(10)*W(90)) +
 139      2CB(2)*W(82) + CB(4)*W(84) + CB(5)*W(85) +
 140      3CB(7)*W(87) + CB(8)*W(88) + CB(9)*W(89)
 141          WCA(10)=WCA(10)+
 142      10.25D0*(CB(1)*W(91) + CB(3)*W(93) + CB(6)*W(96) + CB(10)*W(100)) +
 143      20.5D0*(CB(2)*W(92) + CB(4)*W(94) + CB(5)*W(95) +
 144      3       CB(7)*W(97) + CB(8)*W(98) + CB(9)*W(99))
 145          WCB(1)=WCB(1)+
 146      10.25D0*(CA(1)*W(1) + CA(3)*W(21) + CA(6)*W(51) + CA(10)*W(91)) +
 147      20.5D0*(CA(2)*W(11) + CA(4)*W(31) + CA(5)*W(41) +
 148      3       CA(7)*W(61) + CA(8)*W(71) + CA(9)*W(81))
 149          WCB(2)=WCB(2)+
 150      10.5D0*(CA(1)*W(2) + CA(3)*W(22) + CA(6)*W(52) + CA(10)*W(92)) +
 151      2CA(2)*W(12) + CA(4)*W(32) + CA(5)*W(42) +
 152      3CA(7)*W(62) + CA(8)*W(72) + CA(9)*W(82)
 153          WCB(3)=WCB(3)+
 154      10.25D0*(CA(1)*W(3) + CA(3)*W(23) + CA(6)*W(53) + CA(10)*W(93)) +
 155      20.5D0*(CA(2)*W(13) + CA(4)*W(33) + CA(5)*W(43) +
 156      3       CA(7)*W(63) + CA(8)*W(73) + CA(9)*W(83))
 157          WCB(4)=WCB(4)+
 158      10.5D0*(CA(1)*W(4) + CA(3)*W(24) + CA(6)*W(54) + CA(10)*W(94)) +
 159      2CA(2)*W(14) + CA(4)*W(34) + CA(5)*W(44) +
 160      3CA(7)*W(64) + CA(8)*W(74) + CA(9)*W(84)
 161          WCB(5)=WCB(5)+
 162      10.5D0*(CA(1)*W(5) + CA(3)*W(25) + CA(6)*W(55) + CA(10)*W(95)) +
 163      2CA(2)*W(15) + CA(4)*W(35) + CA(5)*W(45) +
 164      3CA(7)*W(65) + CA(8)*W(75) + CA(9)*W(85)
 165          WCB(6)=WCB(6)+
 166      10.25D0*(CA(1)*W(6) + CA(3)*W(26) + CA(6)*W(56) + CA(10)*W(96)) +
 167      20.5D0*(CA(2)*W(16) + CA(4)*W(36) + CA(5)*W(46) +
 168      3       CA(7)*W(66) + CA(8)*W(76) + CA(9)*W(86))
 169          WCB(7)=WCB(7)+
 170      10.5D0*(CA(1)*W(7) + CA(3)*W(27) + CA(6)*W(57) + CA(10)*W(97)) +
 171      2CA(2)*W(17) + CA(4)*W(37) + CA(5)*W(47) +
 172      3CA(7)*W(67) + CA(8)*W(77) + CA(9)*W(87)
 173          WCB(8)=WCB(8)+
 174      10.5D0*(CA(1)*W(8) + CA(3)*W(28) + CA(6)*W(58) + CA(10)*W(98)) +
 175      2CA(2)*W(18) + CA(4)*W(38) + CA(5)*W(48) +
 176      3CA(7)*W(68) + CA(8)*W(78) + CA(9)*W(88)
 177          WCB(9)=WCB(9)+
 178      10.5D0*(CA(1)*W(9) + CA(3)*W(29) + CA(6)*W(59) + CA(10)*W(99)) +
 179      2CA(2)*W(19) + CA(4)*W(39) + CA(5)*W(49) +
 180      3CA(7)*W(69) + CA(8)*W(79) + CA(9)*W(89)
 181          WCB(10)=WCB(10)+
 182      10.25D0*(CA(1)*W(10) + CA(3)*W(30) + CA(6)*W(60) + CA(10)*W(100)) +
 183      20.5D0*(CA(2)*W(20) + CA(4)*W(40) + CA(5)*W(50) +
 184      3       CA(7)*W(70) + CA(8)*W(80) + CA(9)*W(90))
 185 C
 186 C   END OF EXPLICIT CODE
 187 C
 188       ELSEIF(NA.GT.1)THEN
 189 C
 190 C   ATOM 'A' IS NOT A HYDROGEN, ATOM 'B' IS A HYDROGEN
 191 C
 192          SUM=0.D0
 193          IJ=0
 194          DO 20 I=1,4
 195             DO 10 J=1,I-1
 196                IJ=IJ+1
 197                SUM=SUM+CA(IJ)*W(IJ)
 198    10       WCA(IJ)=WCA(IJ)+CB(1)*W(IJ)*0.5D0
 199             IJ=IJ+1
 200             SUM=SUM+CA(IJ)*W(IJ)*0.5D0
 201    20    WCA(IJ)=WCA(IJ)+CB(1)*W(IJ)*0.25D0
 202          WCB(1) =WCB(1)+SUM*0.5D0
 203       ELSEIF(NB.GT.1)THEN
 204 C
 205          SUM=0.D0
 206          IJ=0
 207          DO 40 I=1,4
 208             DO 30 J=1,I-1
 209                IJ=IJ+1
 210                SUM=SUM+CB(IJ)*W(IJ)
 211    30       WCB(IJ)=WCB(IJ)+CA(1)*W(IJ)*0.5D0
 212             IJ=IJ+1
 213             SUM=SUM+CB(IJ)*W(IJ)*0.5D0
 214    40    WCB(IJ)=WCB(IJ)+CA(1)*W(IJ)*0.25D0
 215          WCA(1) =WCA(1)+SUM*0.5D0
 216       ELSEIF(NB.GT.1)THEN
 217 C
 218 C   ATOM 'A' IS A HYDROGEN, ATOM 'B' IS NOT A HYDROGEN
 219 C
 220       ELSE
 221 C
 222 C   BOTH ATOMS 'A' AND 'B' ARE HYDROGENS
 223 C
 224          WCB(1)=WCB(1)+CA(1)*W(1)*0.25D0
 225          WCA(1)=WCA(1)+CB(1)*W(1)*0.25D0
 226       ENDIF
 227       KR=KR+NA*NB
 228       RETURN
 229       END