hdiff output

r32452/benzgenrigid.f90 2017-05-02 18:30:26.176493064 +0100 r32451/benzgenrigid.f90 2017-05-02 18:30:29.704538940 +0100
  1: ! dj337: Anisotropic potential for polycyclic aromatic hydrocarbons.  1: svn: E195012: Unable to find repository location for 'svn+ssh://svn.ch.private.cam.ac.uk/groups/wales/trunk/GMIN/source/benzgenrigid.f90' in revision 32451
  2: ! Long-range electrostatic interactions are computed using Ewald summation. 
  3: ! Implemented within the GENRIGID framework. 
  4:  
  5:       SUBROUTINE BENZGENRIGIDEWALD(X, G, ENERGY, GTEST) 
  6:  
  7:       USE COMMONS, ONLY: NATOMS, NCARBON, RBSTLA, RHOCC0, RHOCC10, RHOCC20, & 
  8:      &                   RHOHH0, RHOHH10, RHOHH20, RHOCH0, RHOC10H, RHOCH10, RHOC20H, & 
  9:      &                   RHOCH20, ALPHACC, ALPHAHH, ALPHACH, DC6CC, DC6HH, DC6CH, KKJ 
 10:  
 11:       ! dj337: PAHA adapted to the genrigid framework 
 12:       USE GENRIGID, ONLY: NRIGIDBODY, ATOMRIGIDCOORDT, TRANSFORMCTORIGID, NSITEPERBODY, & 
 13:      &                    MAXSITE, SITESRIGIDBODY, TRANSFORMRIGIDTOC, TRANSFORMGRAD 
 14:  
 15:       ! dj337: use Ewald summation to compute electrostatics 
 16:       USE EWALD 
 17:  
 18:       IMPLICIT NONE 
 19:  
 20:       INTEGER          :: I, J, K, J1, J2, J3, J4, J5, J6, J7, J8, OFFSET, FCT(6)  
 21:       DOUBLE PRECISION :: X(3*NATOMS) 
 22:       DOUBLE PRECISION, INTENT(OUT) :: G(3*NATOMS) 
 23:       DOUBLE PRECISION :: XR(3*NATOMS), XC(3*NATOMS), G3C(3*NATOMS), G3(3*NATOMS), graddum(3*natoms) 
 24:       DOUBLE PRECISION, INTENT(OUT) :: ENERGY 
 25:       DOUBLE PRECISION :: R2, R6, ABSRIJ, DVDR, ENERGY1, ENERGY2, ENERGY3, diff, eplus, eminus 
 26:       DOUBLE PRECISION :: DMPFCT_SHIFT, EXPFCT_SHIFT, VSHIFT1, VSHIFT2, EWALDREALC2 
 27:       DOUBLE PRECISION :: RI(3), RSS(3), RSSMIN(3), NR(3), P(3), EI(3), EJ(3), FRIJ(3), TIJ(3), TJI(3)  
 28:       DOUBLE PRECISION :: R(MAXSITE*NRIGIDBODY,3), E(3*MAXSITE*NRIGIDBODY,3) 
 29:       DOUBLE PRECISION :: DR1(MAXSITE*NRIGIDBODY,3), DR2(MAXSITE*NRIGIDBODY,3), DR3(MAXSITE*NRIGIDBODY,3) 
 30:       DOUBLE PRECISION :: DE1(3*MAXSITE*NRIGIDBODY,3), DE2(3*MAXSITE*NRIGIDBODY,3), DE3(3*MAXSITE*NRIGIDBODY,3) 
 31:       DOUBLE PRECISION :: RMI(3,3), DRMI1(3,3), DRMI2(3,3), DRMI3(3,3), DCADR(3), DCBDR(3) 
 32:       DOUBLE PRECISION :: RHOCC, RHOHH, RHOCH, COSTA, COSTB, DMPFCT, DDMPDR, EXPFCT  
 33:       DOUBLE PRECISION :: DRIJDPI(3), DRIJDPJ(3), DCADPI(3), DCBDPI(3), DCADPJ(3), DCBDPJ(3) 
 34:       DOUBLE PRECISION, PARAMETER :: B = 1.6485D0 
 35:       LOGICAL          :: GTEST 
 36:  
 37:       ! factorials 
 38:       FCT(1) = 1; FCT(2) = 2; FCT(3) = 6; FCT(4) = 24; FCT(5) = 120; FCT(6) = 720 
 39:       ! initialize energy values 
 40:       ! energy1 is due to short-range anisotropic interactions 
 41:       ! energy2 is due to damped dispersion 
 42:       ! energy3 is due to long-range electrostatics (computed using Ewald) 
 43:       ENERGY = 0.D0; ENERGY1 = 0.D0; ENERGY2 = 0.D0; ENERGY3 = 0.D0 
 44:  
 45:       ! initialize gradient if GTEST true 
 46:       IF (GTEST) G(:) = 0.D0 
 47:       IF (GTEST) G3C(:) = 0.D0 
 48:  
 49:       ! dj337: check if input coordinates are cartesian 
 50:       ! assumes ATOMRIGIDCOORDT is correct 
 51:       IF (ATOMRIGIDCOORDT) THEN ! if input is cartesian 
 52:          ! convert to rigidbody coordinates 
 53:          XR(:) = 0.D0 
 54:          CALL TRANSFORMCTORIGID(X, XR) 
 55:          X(:) = XR(:) 
 56:       ENDIF 
 57:  
 58:       EWALDREALC2 = EWALDREALC**2 
 59:  
 60:       ! OFFSET is number of CoM coords (3*NRIGIDBODY) 
 61:       OFFSET     = 3*NRIGIDBODY 
 62:  
 63:       ! Computing Cartesian coordinates for the system.   
 64:       DO J1 = 1, NRIGIDBODY 
 65:  
 66:          J3 = 3*J1 
 67:          J5 = OFFSET + J3 
 68:          ! CoM coords for rigid body J1 
 69:          RI = X(J3-2:J3) 
 70:          ! AA coords for rigid body J1 
 71:          P  = X(J5-2:J5) 
 72:  
 73:          ! calculates rotation matrix (RMI) 
 74:          ! also calculates derivatives if GTEST is true 
 75:          CALL RMDRVT(P, RMI, DRMI1, DRMI2, DRMI3, GTEST) 
 76:  
 77:          ! loop over sites in the rigid body 
 78:          DO J2 = 1, NSITEPERBODY(J1) 
 79:  
 80:             ! J4 is index for site J2 relative to a complete list of all sites in all rigid bodies 
 81:             ! dj337: assumes that same number of sites per rigid body (i.e. NSITEPERBODY(J1) == MAXSITE) 
 82:             J4      = MAXSITE*(J1-1) + J2 
 83:             ! R(J4,:) contains Cartesian coordinates for site J4 
 84:             R(J4,:) = RI(:) + MATMUL(RMI(:,:),SITESRIGIDBODY(J2,:,J1)) 
 85:             ! E(J4,:) contains Z-axis in local axis system for site J4  
 86:             E(J4,:) = MATMUL(RMI(:,:),RBSTLA(J2,:)) 
 87:  
 88:             IF (GTEST) THEN 
 89:  
 90:                ! calculate derivative wrt coordinates 
 91:                DR1(J4,:) = MATMUL(DRMI1(:,:),SITESRIGIDBODY(J2,:,J1)) 
 92:                DR2(J4,:) = MATMUL(DRMI2(:,:),SITESRIGIDBODY(J2,:,J1)) 
 93:                DR3(J4,:) = MATMUL(DRMI3(:,:),SITESRIGIDBODY(J2,:,J1)) 
 94:  
 95:                ! calculate derivative wrt local axis 
 96:                DE1(J4,:) = MATMUL(DRMI1(:,:),RBSTLA(J2,:)) 
 97:                DE2(J4,:) = MATMUL(DRMI2(:,:),RBSTLA(J2,:)) 
 98:                DE3(J4,:) = MATMUL(DRMI3(:,:),RBSTLA(J2,:)) 
 99:  
100:             ENDIF 
101:  
102:          ENDDO 
103:  
104:       ENDDO 
105:  
106:       ! Now compute the actual potential. 
107:       ! loop over rigid bodies (A) 
108:       DO J1 = 1, NRIGIDBODY - 1 
109:  
110:          J3 = 3*J1 
111:          J5 = OFFSET + J3 
112:          ! CoM coords for rigid body J1 
113:          RI(:)  = X(J3-2:J3) 
114:  
115:          ! loop over sites in the rigid body J1 
116:          DO I = 1, NSITEPERBODY(J1) 
117:  
118:             ! J7 is index for site I 
119:             J7    = MAXSITE*(J1-1) + I 
120:             ! EI is Z-axis for site I 
121:             EI(:) = E(J7,:) 
122:  
123:             ! loop over rigid bodies (B)    
124:             DO J2 = J1 + 1, NRIGIDBODY 
125:  
126:                J4 = 3*J2 
127:                J6 = OFFSET + J4 
128:  
129:                ! loop over sites in the rigid body J2 
130:                DO J = 1, NSITEPERBODY(J2) 
131:  
132:                   ! J8 is index for site J 
133:                   J8     = MAXSITE*(J2-1) + J 
134:                   ! EJ is Z-axis for site J 
135:                   EJ(:)  = E(J8,:) 
136:                   RSS(:) = R(J7,:) - R(J8,:) 
137:                   ! minimum image convention 
138:                   RSSMIN(1) = RSS(1) - BOXLX*ANINT(RSS(1)/BOXLX) 
139:                   RSSMIN(2) = RSS(2) - BOXLY*ANINT(RSS(2)/BOXLY) 
140:                   RSSMIN(3) = RSS(3) - BOXLZ*ANINT(RSS(3)/BOXLZ) 
141:                   R2     = DOT_PRODUCT(RSSMIN(:),RSSMIN(:)) 
142:                   ! check if distance within cutoff 
143:                   IF (R2 < EWALDREALC2) THEN 
144:                      !print *, j7, j8 
145:                      !print *, 'r: ', rss(:3) 
146:                      !print *, 'rmin: ', rssmin(:3) 
147:                      ! ABSRIJ is site-site separation between I and J 
148:                      ABSRIJ = DSQRT(R2) 
149:                      ! NR is unit site-site vector from sites I to J 
150:                      NR(:)  = RSSMIN(:)/ABSRIJ 
151:                      R2     = 1.D0/R2 
152:                      R6     = R2*R2*R2 
153:     
154: !     CALCULATE THE DISPERSION DAMPING FACTOR 
155:     
156:                      ! initialize sum for the damping function and vertical shift 
157:                      DMPFCT = 1.D0 
158:                      DMPFCT_SHIFT = 1.D0 
159:                      ! initialize sum for the derivative of damping function 
160:                      DDMPDR = B 
161:     
162:                      ! calculate sums 
163:                      DO K = 1, 6 
164:     
165:                         DMPFCT = DMPFCT + (B*ABSRIJ)**K/FLOAT(FCT(K)) 
166:                         DMPFCT_SHIFT = DMPFCT_SHIFT + (B*EWALDREALC)**K/FLOAT(FCT(K)) 
167:                         IF (K > 1) DDMPDR = DDMPDR + (B**K)*(ABSRIJ)**(K-1)/FLOAT(FCT(K-1)) 
168:     
169:                      END DO 
170:     
171:                      EXPFCT = DEXP(-B*ABSRIJ) 
172:                      EXPFCT_SHIFT = DEXP(-B*EWALDREALC) 
173:                      ! DDMPDR is derivative of damping function with factor 1/Rab 
174:                      DDMPDR = (B*EXPFCT*DMPFCT - EXPFCT*DDMPDR)/ABSRIJ 
175:                      ! DMPFCT is damping function 
176:                      DMPFCT = 1.D0 - EXPFCT*DMPFCT 
177:                      ! DMPFCT_SHIFT is vertical shift for damping function 
178:                      DMPFCT_SHIFT = 1.D0 - EXPFCT_SHIFT*DMPFCT_SHIFT 
179:     
180: !     NOW CALCULATE RHOAB 
181:     
182:                      ! calculate cos(theta)  
183:                      COSTA      =-DOT_PRODUCT(NR(:),EI(:)) 
184:                      COSTB      = DOT_PRODUCT(NR(:),EJ(:)) 
185:     
186:                      ! calculate terms relevant to derivatives 
187:                      IF (GTEST) THEN 
188:     
189:                         ! derivative of cos(theta) wrt r_ij 
190:                         DCADR(:)   =-EI(:)/ABSRIJ - COSTA*R2*RSSMIN(:) 
191:                         DCBDR(:)   = EJ(:)/ABSRIJ - COSTB*R2*RSSMIN(:) 
192:     
193:                         ! derivative of r_ij wrt pi 
194:                         DRIJDPI(1) = DOT_PRODUCT(RSSMIN(:),DR1(J7,:)) 
195:                         DRIJDPI(2) = DOT_PRODUCT(RSSMIN(:),DR2(J7,:)) 
196:                         DRIJDPI(3) = DOT_PRODUCT(RSSMIN(:),DR3(J7,:)) 
197:     
198:                         ! derivative of r_ij wrt pj 
199:                         DRIJDPJ(1) =-DOT_PRODUCT(RSSMIN(:),DR1(J8,:)) 
200:                         DRIJDPJ(2) =-DOT_PRODUCT(RSSMIN(:),DR2(J8,:)) 
201:                         DRIJDPJ(3) =-DOT_PRODUCT(RSSMIN(:),DR3(J8,:)) 
202:     
203:                         ! derivative of cos(theta) wrt pi 
204:                         DCADPI(1)  =-DOT_PRODUCT(DR1(J7,:),EI(:))/ABSRIJ - DOT_PRODUCT(NR(:),DE1(J7,:)) &  
205:                                    - COSTA*R2*DRIJDPI(1) 
206:                         DCADPI(2)  =-DOT_PRODUCT(DR2(J7,:),EI(:))/ABSRIJ - DOT_PRODUCT(NR(:),DE2(J7,:)) & 
207:                                    - COSTA*R2*DRIJDPI(2) 
208:                         DCADPI(3)  =-DOT_PRODUCT(DR3(J7,:),EI(:))/ABSRIJ - DOT_PRODUCT(NR(:),DE3(J7,:)) & 
209:                                    - COSTA*R2*DRIJDPI(3) 
210:                         DCBDPI(1)  = DOT_PRODUCT(DR1(J7,:),EJ(:))/ABSRIJ - COSTB*R2*DRIJDPI(1) 
211:                         DCBDPI(2)  = DOT_PRODUCT(DR2(J7,:),EJ(:))/ABSRIJ - COSTB*R2*DRIJDPI(2) 
212:                         DCBDPI(3)  = DOT_PRODUCT(DR3(J7,:),EJ(:))/ABSRIJ - COSTB*R2*DRIJDPI(3) 
213:                     
214:                         ! derivative of cos(theta) wrt pj 
215:                         DCADPJ(1)  = DOT_PRODUCT(DR1(J8,:),EI(:))/ABSRIJ - COSTA*R2*DRIJDPJ(1) 
216:                         DCADPJ(2)  = DOT_PRODUCT(DR2(J8,:),EI(:))/ABSRIJ - COSTA*R2*DRIJDPJ(2) 
217:                         DCADPJ(3)  = DOT_PRODUCT(DR3(J8,:),EI(:))/ABSRIJ - COSTA*R2*DRIJDPJ(3) 
218:     
219:                         DCBDPJ(1)  =-DOT_PRODUCT(DR1(J8,:),EJ(:))/ABSRIJ + DOT_PRODUCT(NR(:),DE1(J8,:)) & 
220:                                    - COSTB*R2*DRIJDPJ(1) 
221:                         DCBDPJ(2)  =-DOT_PRODUCT(DR2(J8,:),EJ(:))/ABSRIJ + DOT_PRODUCT(NR(:),DE2(J8,:)) & 
222:                                    - COSTB*R2*DRIJDPJ(2) 
223:                         DCBDPJ(3)  =-DOT_PRODUCT(DR3(J8,:),EJ(:))/ABSRIJ + DOT_PRODUCT(NR(:),DE3(J8,:)) & 
224:                                    - COSTB*R2*DRIJDPJ(3) 
225:     
226:                      ENDIF 
227:       
228:                      ! calculate if I and J are both carbons  
229:                      IF (I <= NCARBON .AND. J <= NCARBON) THEN 
230:     
231:                         ! calculate rho_cc 
232:                         RHOCC   = RHOCC0 + RHOCC10*(COSTA + COSTB) + RHOCC20*(1.5D0*COSTA*COSTA &  
233:                                 + 1.5D0*COSTB*COSTB - 1.D0) 
234:                         ! ENERGY1 is energy due to short-range anisotropic interactions 
235:                         ! calculate vertical shift for first term 
236:                         EXPFCT  = KKJ*DEXP(-ALPHACC*(ABSRIJ - RHOCC)) 
237:                         VSHIFT1 = KKJ*DEXP(-ALPHACC*(EWALDREALC - RHOCC)) 
238:                         ENERGY1 = ENERGY1 + EXPFCT - VSHIFT1 
239:                         ! ENERGY2 is energy due to damped dispersion 
240:                         ! calculate vertical shift for second term 
241:                         VSHIFT2 = DC6CC*DMPFCT_SHIFT/(EWALDREALC**6) 
242:                         !print *, 'energy: ', dc6cc*dmpfct*r6 
243:                         ENERGY2 = ENERGY2 - DC6CC*DMPFCT*R6 - VSHIFT2 
244:     
245:                         IF (GTEST) THEN 
246:     
247:                            ! DVDR is derivative of dispersion damping factor energy with factor 1/Rab 
248:                            DVDR    = 6.D0*DC6CC*R6*R2*DMPFCT - DC6CC*R6*DDMPDR  
249:                            !print *, 'grad: ', dvdr 
250:                            ! FRIJ is derivative of ENERGY1 wrt r_ij with factor 1/Rab 
251:                            FRIJ(:) = ALPHACC*EXPFCT*(-NR(:) + (RHOCC10 + 3.D0*RHOCC20*COSTA)*DCADR(:) & 
252:                                    + (RHOCC10 + 3.D0*RHOCC20*COSTB)*DCBDR(:)) 
253:                            ! TIJ is derivative of ENERGY1 wrt pi with factor 1/Rab 
254:                            TIJ(:)  = ALPHACC*EXPFCT*(-DRIJDPI(:)/ABSRIJ + (RHOCC10 + 3.D0*RHOCC20*COSTA)*DCADPI(:) & 
255:                                    + (RHOCC10 + 3.D0*RHOCC20*COSTB)*DCBDPI(:)) 
256:                            ! TJI is derivative of ENERGY1 wrt pj with factor 1/Rab 
257:                            TJI(:)  = ALPHACC*EXPFCT*(-DRIJDPJ(:)/ABSRIJ + (RHOCC10 + 3.D0*RHOCC20*COSTA)*DCADPJ(:) & 
258:                                    + (RHOCC10 + 3.D0*RHOCC20*COSTB)*DCBDPJ(:))  
259:     
260:                         ENDIF 
261:     
262:                      ! calculate if I and J are both hydorgens 
263:                      ELSEIF (I > NCARBON .AND. J > NCARBON) THEN 
264:     
265:                         RHOHH  = RHOHH0 + RHOHH10*(COSTA + COSTB) + RHOHH20*(1.5D0*COSTA*COSTA      & 
266:                                + 1.5D0*COSTB*COSTB - 1.D0)  
267:                         EXPFCT  = KKJ*DEXP(-ALPHAHH*(ABSRIJ - RHOHH)) 
268:                         VSHIFT1 = KKJ*DEXP(-ALPHAHH*(EWALDREALC - RHOHH)) 
269:                         ENERGY1 = ENERGY1 + EXPFCT - VSHIFT1 
270:                         VSHIFT2 = DC6HH*DMPFCT_SHIFT/(EWALDREALC**6) 
271:                         !print *, 'energy: ', dc6hh*dmpfct*r6 
272:                         ENERGY2 = ENERGY2 - DC6HH*DMPFCT*R6 - VSHIFT2 
273:     
274:                         IF (GTEST) THEN 
275:     
276:                            DVDR    = 6.D0*DC6HH*R6*R2*DMPFCT - DC6HH*R6*DDMPDR  
277:                            !print *, 'grad: ', dvdr 
278:                            FRIJ(:) = ALPHAHH*EXPFCT*(-NR(:) + (RHOHH10 + 3.D0*RHOHH20*COSTA)*DCADR(:) & 
279:                                    + (RHOHH10 + 3.D0*RHOHH20*COSTB)*DCBDR(:)) 
280:                            TIJ(:)  = ALPHAHH*EXPFCT*(-DRIJDPI(:)/ABSRIJ + (RHOHH10 + 3.D0*RHOHH20*COSTA)*DCADPI(:) & 
281:                                    + (RHOHH10 + 3.D0*RHOHH20*COSTB)*DCBDPI(:)) 
282:                            TJI(:)  = ALPHAHH*EXPFCT*(-DRIJDPJ(:)/ABSRIJ + (RHOHH10 + 3.D0*RHOHH20*COSTA)*DCADPJ(:) & 
283:                                    + (RHOHH10 + 3.D0*RHOHH20*COSTB)*DCBDPJ(:)) 
284:     
285:                         ENDIF 
286:     
287:                      ! calculate if I is carbon and J is hydrogen 
288:                      ELSE IF (I <= NCARBON .AND. J > NCARBON) THEN  
289:     
290:                         RHOCH  = RHOCH0 + RHOC10H*COSTA + RHOCH10*COSTB + RHOC20H*(1.5D0*COSTA*COSTA & 
291:                                - 0.5D0) + RHOCH20*(1.5D0*COSTB*COSTB - 0.5D0) 
292:                         EXPFCT  = KKJ*DEXP(-ALPHACH*(ABSRIJ - RHOCH)) 
293:                         VSHIFT1 = KKJ*DEXP(-ALPHACH*(EWALDREALC - RHOCH)) 
294:                         ENERGY1 = ENERGY1 + EXPFCT - VSHIFT1 
295:                         VSHIFT2 = DC6CH*DMPFCT_SHIFT/(EWALDREALC**6) 
296:                         !print *, 'energy: ', dc6ch*dmpfct*r6 
297:                         ENERGY2 = ENERGY2 - DC6CH*DMPFCT*R6 - VSHIFT2 
298:     
299:                         IF (GTEST) THEN 
300:                       
301:                            DVDR    = 6.D0*DC6CH*R6*R2*DMPFCT - DC6CH*R6*DDMPDR  
302:                            !print *, 'grad: ', dvdr 
303:                            FRIJ(:) = ALPHACH*EXPFCT*(-NR(:) + (RHOC10H + 3.D0*RHOC20H*COSTA)*DCADR(:) & 
304:                                    + (RHOCH10 + 3.D0*RHOCH20*COSTB)*DCBDR(:)) 
305:                            TIJ(:)  = ALPHACH*EXPFCT*(-DRIJDPI(:)/ABSRIJ + (RHOC10H + 3.D0*RHOC20H*COSTA)*DCADPI(:) & 
306:                                    + (RHOCH10 + 3.D0*RHOCH20*COSTB)*DCBDPI(:)) 
307:                            TJI(:)  = ALPHACH*EXPFCT*(-DRIJDPJ(:)/ABSRIJ + (RHOC10H + 3.D0*RHOC20H*COSTA)*DCADPJ(:) & 
308:                                    + (RHOCH10 + 3.D0*RHOCH20*COSTB)*DCBDPJ(:)) 
309:     
310:                         ENDIF 
311:     
312:                      ELSE !IF(I > NCARBON .AND. J <= NCARBON) THEN 
313:     
314:                         RHOCH  = RHOCH0 + RHOCH10*COSTA + RHOC10H*COSTB + RHOCH20*(1.5D0*COSTA*COSTA & 
315:                                - 0.5D0) + RHOC20H*(1.5D0*COSTB*COSTB - 0.5D0) 
316:                         EXPFCT  = KKJ*DEXP(-ALPHACH*(ABSRIJ - RHOCH)) 
317:                         VSHIFT1 = KKJ*DEXP(-ALPHACH*(EWALDREALC - RHOCH)) 
318:                         ENERGY1 = ENERGY1 + EXPFCT - VSHIFT1 
319:                         VSHIFT2 = DC6CH*DMPFCT_SHIFT/(EWALDREALC**6) 
320:                         !print *, 'energy: ', dc6ch*dmpfct*r6 
321:                         ENERGY2 = ENERGY2 - DC6CH*DMPFCT*R6 - VSHIFT2 
322:     
323:                         IF (GTEST) THEN 
324:     
325:                            DVDR    = 6.D0*DC6CH*R6*R2*DMPFCT - DC6CH*R6*DDMPDR  
326:                            !print *, 'grad: ', dvdr 
327:                            FRIJ(:) = ALPHACH*EXPFCT*(-NR(:) + (RHOCH10 + 3.D0*RHOCH20*COSTA)*DCADR(:) & 
328:                                    + (RHOC10H + 3.D0*RHOC20H*COSTB)*DCBDR(:)) 
329:                            TIJ(:)  = ALPHACH*EXPFCT*(-DRIJDPI(:)/ABSRIJ + (RHOCH10 + 3.D0*RHOCH20*COSTA)*DCADPI(:) & 
330:                                    + (RHOC10H + 3.D0*RHOC20H*COSTB)*DCBDPI(:)) 
331:                            TJI(:)  = ALPHACH*EXPFCT*(-DRIJDPJ(:)/ABSRIJ + (RHOCH10 + 3.D0*RHOCH20*COSTA)*DCADPJ(:) & 
332:                                    + (RHOC10H + 3.D0*RHOC20H*COSTB)*DCBDPJ(:)) 
333:     
334:                         ENDIF 
335:     
336:                      ENDIF 
337:     
338:                      IF (GTEST) THEN 
339:     
340:                         ! total gradient wrt CoM coords for rigid body J1 
341:                         G(J3-2:J3) = G(J3-2:J3) + DVDR*RSSmin(:) + FRIJ(:) 
342:                         ! total gradient wrt CoM coords for rigid body J2 
343:                         G(J4-2:J4) = G(J4-2:J4) - DVDR*RSSmin(:) - FRIJ(:) 
344:     
345:                         ! total gradient wrt AA coords for rigid body J1 
346:                         G(J5-2:J5) = G(J5-2:J5) + DVDR*DRIJDPI(:) + TIJ(:) 
347:                         ! total gradient wrt AA coords for rigid body J2 
348:                         G(J6-2:J6) = G(J6-2:J6) + DVDR*DRIJDPJ(:) + TJI(:) 
349:     
350:                      ENDIF 
351:  
352:                   ENDIF 
353:  
354:                ENDDO 
355:  
356:             ENDDO 
357:   
358:          ENDDO 
359:  
360:       ENDDO 
361:  
362:       ! convert to cartesian coordinates 
363:       XC(:) = 0.D0 
364:       CALL TRANSFORMRIGIDTOC(1, NRIGIDBODY, XC, X) 
365:  
366:       ! ENERGY3 and G3 are energy and gradient due to electrostatics 
367:       ! computed using Ewald summation 
368:       CALL EWALDSUM(1, XC, G3C, ENERGY3, GTEST) 
369:  
370: ! check analytical and numerical gradients of Ewald terms in cartesian coords 
371: !      diff = 1.0d-6 
372: !      print *, 'analytic and numerical gradients:' 
373: !      do j1=1, 3*natoms 
374: !         xc(j1) = xc(j1) + diff 
375: !         call ewaldsum(1, xc, graddum, eplus, .false.) 
376: !         xc(j1) = xc(j1) - 2.0d0*diff 
377: !         call ewaldsum(1, xc, graddum, eminus, .false.) 
378: !         xc(j1) = xc(j1) + diff 
379: !         if ((abs(g3c(j1)).ne.0.0d0).and.(100.0d0*abs(g3c(j1)-(eplus-eminus)/(2.0d0*diff))/abs(g3c(j1)).gt.1.0d0)) then 
380: !            print *, j1, g3c(j1), (eplus-eminus)/(2.0d0*diff) 
381: !         else 
382: !            print *, 'fine: ', j1, g3c(j1), (eplus-eminus)/(2.0d0*diff) 
383: !         endif 
384: !      enddo 
385:  
386:       ! convert Ewald contribution of gradient to rigidbody coordinates 
387:       IF (GTEST) G3(:) = 0.D0 
388:       CALL TRANSFORMGRAD(G3C, X, G3) 
389:  
390:       !energy = energy2*2625.499d0 
391:       !if (gtest) g(:) = g(:)*2625.499d0 
392:       !energy = (energy3)*2625.499d0 
393:       !if (gtest) g(:) = g3(:)*2625.499d0 
394:       ENERGY = (ENERGY1 + ENERGY2 + ENERGY3)*2625.499D0  
395:       IF (GTEST) G(:) = (G(:) + G3(:))*2625.499D0 
396:  
397:       ! dj337: if input was cartesian, convert back to cartesian 
398:       ! assumes ATOMRIGIDCOORDT is correct 
399:       IF (ATOMRIGIDCOORDT) THEN 
400:  
401:          ! convert to cartesian coordinates 
402:          XR(:) = 0.D0 
403:          CALL TRANSFORMRIGIDTOC(1, NRIGIDBODY, XR, X) 
404:          X(:) = XR(:) 
405:  
406:       ENDIF 
407:  
408:       END SUBROUTINE BENZGENRIGIDEWALD 
409:  
410: !     ---------------------------------------------------------------------------------------------- 
411: ! 
412: !      SUBROUTINE DEFPAHARIGID() 
413: ! 
414: !      USE COMMONS, ONLY: RHOCC0, RHOCC10, RHOCC20,  RHOHH0, RHOHH10, RHOHH20, RHOCH0, RHOC10H, RHOCH10, RHOC20H, RHOCH20, & 
415: !                         ALPHACC, ALPHAHH, ALPHACH, DC6CC, DC6HH, DC6CH, KKJ, CCKJ 
416: ! 
417: !      IMPLICIT NONE 
418: !  
419: !      ALPHACC = 1.861500D0 
420: !      ALPHAHH = 1.431200D0 
421: !      ALPHACH = 1.775600D0 
422: ! 
423: !      DC6CC    = 30.469D0 
424: !      DC6HH    = 5.359D0 
425: !      DC6CH    = 12.840D0 
426: ! 
427: !      RHOCC0  = 5.814700D0 
428: !      RHOCC10 = 0.021700D0 
429: !      RHOCC20 =-0.220800D0 
430: ! 
431: !      RHOHH0  = 4.486200D0 
432: !      RHOHH10 =-0.271800D0 
433: !      RHOHH20 = 0.0D0 
434: ! 
435: !      RHOCH0  = 5.150500D0 
436: !      RHOC10H = 0.021700D0 
437: !      RHOCH10 =-0.271800D0 
438: !      RHOC20H =-0.220800D0 
439: !      RHOCH20 = 0.0D0 
440: ! 
441: !      KKJ     = 1.D-03 
442: !      CCKJ    = 1.D0   !1389.354848D0 
443: ! 
444: !      END SUBROUTINE DEFPAHARIGID 
445: ! 
446: !!     ---------------------------------------------------------------------------------------------- 
447:  
448:       SUBROUTINE DEFBENZENERIGIDEWALD() 
449:  
450:       USE COMMONS, ONLY: NRBSITES, SITE, RBSTLA, STCHRG  
451:       USE GENRIGID, ONLY: NRIGIDBODY 
452:  
453:       IMPLICIT NONE 
454:   
455:       INTEGER :: J1 
456:  
457: !!     C6H6 
458:  
459: !!     D6h reference geometry: C-C: 1.397 angstrom; C-H: 1.087 angstrom 
460: !      ! dj337: note that all done in atomic units 
461:  
462:       SITE(1,:)  = (/ 2.63923430843701,   0.00000000000000,   0.00000000000000/) 
463:       SITE(2,:)  = (/ 1.31961715421850,  -2.28564395764590,   0.00000000000000/) 
464:       SITE(3,:)  = (/-1.31961715421850,  -2.28564395764590,   0.00000000000000/) 
465:       SITE(4,:)  = (/-2.63923430843701,   0.00000000000000,   0.00000000000000/) 
466:       SITE(5,:)  = (/-1.31961715421850,   2.28564395764590,   0.00000000000000/) 
467:       SITE(6,:)  = (/ 1.31961715421850,   2.28564395764590,   0.00000000000000/) 
468:       SITE(7,:)  = (/ 4.69338981379532,   0.00000000000000,   0.00000000000000/) 
469:       SITE(8,:)  = (/ 2.34669490689766,  -4.06459480860986,   0.00000000000000/) 
470:       SITE(9,:)  = (/-2.34669490689766,  -4.06459480860986,   0.00000000000000/) 
471:       SITE(10,:) = (/-4.69338981379532,   0.00000000000000,   0.00000000000000/) 
472:       SITE(11,:) = (/-2.34669490689766,   4.06459480860986,   0.00000000000000/) 
473:       SITE(12,:) = (/ 2.34669490689766,   4.06459480860986,   0.00000000000000/) 
474:  
475:       RBSTLA(1,:)  = SITE(7,:)  - SITE(1,:)                 ! Z FROM C1 TO H1 
476:       RBSTLA(2,:)  = SITE(8,:)  - SITE(2,:)                 ! Z FROM C2 TO H2 
477:       RBSTLA(3,:)  = SITE(9,:)  - SITE(3,:)                 ! Z FROM C3 TO H3 
478:       RBSTLA(4,:)  = SITE(10,:) - SITE(4,:)                 ! Z FROM C4 TO H4 
479:       RBSTLA(5,:)  = SITE(11,:) - SITE(5,:)                 ! Z FROM C5 TO H5 
480:       RBSTLA(6,:)  = SITE(12,:) - SITE(6,:)                 ! Z FROM C6 TO H6 
481:       RBSTLA(7,:)  = SITE(7,:)  - SITE(1,:)                 ! Z FROM C1 TO H1! 
482:       RBSTLA(8,:)  = SITE(8,:)  - SITE(2,:)                 ! Z FROM C2 TO H2! 
483:       RBSTLA(9,:)  = SITE(9,:) -  SITE(3,:)                 ! Z FROM C3 TO H3! 
484:       RBSTLA(10,:) = SITE(10,:) - SITE(4,:)                 ! Z FROM C4 TO H4! 
485:       RBSTLA(11,:) = SITE(11,:) - SITE(5,:)                 ! Z FROM C5 TO H5! 
486:       RBSTLA(12,:) = SITE(12,:) - SITE(6,:)                 ! Z FROM C6 TO H6! 
487:  
488:       DO J1 = 1, NRBSITES 
489:   
490:          RBSTLA(J1,:)   = RBSTLA(J1,:)/DSQRT(DOT_PRODUCT(RBSTLA(J1,:),RBSTLA(J1,:))) 
491:  
492:       ENDDO 
493:  
494:       DO J1 = 1, NRIGIDBODY 
495:          STCHRG(12*(J1-1)+1:12*(J1-1)+6) = -0.11114D0 
496:          STCHRG(12*(J1-1)+7:12*(J1-1)+12) = 0.11114D0 
497:       ENDDO 
498:  
499:       END SUBROUTINE DEFBENZENERIGIDEWALD 


r32452/commons.f90 2017-05-02 18:30:26.396495926 +0100 r32451/commons.f90 2017-05-02 18:30:29.928541855 +0100
 33:      &        TBPSTEPS, TBPCI, TBPBASIN, NTSITES, NRBGROUP, NZERO, PTMCDS_FRQ, PTMCDUMPENERFRQ, MONITORINT, NBLOCKS, & 33:      &        TBPSTEPS, TBPCI, TBPBASIN, NTSITES, NRBGROUP, NZERO, PTMCDS_FRQ, PTMCDUMPENERFRQ, MONITORINT, NBLOCKS, &
 34:      &        BINARY_EXAB_FRQ, NRESMIN, USERES, EXEQ, NONEDAPBC, STRUC, CHEMSHIFTITER, GRIDSIZE, MFETRUNS, BESTINVERT, GCNATOMS, & 34:      &        BINARY_EXAB_FRQ, NRESMIN, USERES, EXEQ, NONEDAPBC, STRUC, CHEMSHIFTITER, GRIDSIZE, MFETRUNS, BESTINVERT, GCNATOMS, &
 35:      &        GCINT, GCRELAX, MTARGETS, & 35:      &        GCINT, GCRELAX, MTARGETS, &
 36:      &        INTCONSEP, INTREPSEP, NCONSTRAINTON, CPREPSEP, CPCONSEP, NCONGEOM, & 36:      &        INTCONSEP, INTREPSEP, NCONSTRAINTON, CPREPSEP, CPCONSEP, NCONGEOM, &
 37:      &        NCPREPULSIVE, NCPCONSTRAINT, MAXCONUSE, INTCONSTEPS, INTRELSTEPS, INTSTEPS1, INTLJSTEPS, & 37:      &        NCPREPULSIVE, NCPCONSTRAINT, MAXCONUSE, INTCONSTEPS, INTRELSTEPS, INTSTEPS1, INTLJSTEPS, &
 38:      &        NTRAPPOW, MAXINTIMAGE, CHECKREPINTERVAL, INTFREEZEMIN, INTNTRIESMAX, INTIMAGEINCR, & 38:      &        NTRAPPOW, MAXINTIMAGE, CHECKREPINTERVAL, INTFREEZEMIN, INTNTRIESMAX, INTIMAGEINCR, &
 39:      &        NCONSTRAINTFIX, INTIMAGECHECK, NREPULSIVEFIX, INTIMAGE, NREPULSIVE, & 39:      &        NCONSTRAINTFIX, INTIMAGECHECK, NREPULSIVEFIX, INTIMAGE, NREPULSIVE, &
 40:      &        NNREPULSIVE, NCONSTRAINT, INTMUPDATE, DUMPINTEOSFREQ, DUMPINTXYZFREQ, & 40:      &        NNREPULSIVE, NCONSTRAINT, INTMUPDATE, DUMPINTEOSFREQ, DUMPINTXYZFREQ, &
 41:      &        LOCALPERMNEIGH, LOCALPERMMAXSEP, MAXNACTIVE, QCIPERMCHECKINT, & 41:      &        LOCALPERMNEIGH, LOCALPERMMAXSEP, MAXNACTIVE, QCIPERMCHECKINT, &
 42:      &        MLPIN, MLPSTART, MLPOUT, MLPHIDDEN, MLPDATA, NMLP, DJWRBID, NHEXAMERS, QCIADDREP, QCIBONDS, QCISECOND, MQUNIT, & 42:      &        MLPIN, MLPSTART, MLPOUT, MLPHIDDEN, MLPDATA, NMLP, DJWRBID, NHEXAMERS, QCIADDREP, QCIBONDS, QCISECOND, MQUNIT, &
 43:      &        MLQIN, MLQSTART, MLQOUT, MLQDATA, NMLQ, NADDTARGET, NUMNN, SQNM_HISTMAX, SQNM_DEBUGRUN, SQNM_DEBUGLEVEL, & 43:      &        MLQIN, MLQSTART, MLQOUT, MLQDATA, NMLQ, NADDTARGET, NUMNN, SQNM_HISTMAX, SQNM_DEBUGRUN, SQNM_DEBUGLEVEL, SQNM_WRITEMAX
 44:      &        SQNM_WRITEMAX, NEWALDREAL(3), NEWALDRECIP(3), EWALDN 
 45:       DOUBLE PRECISION RHO, GAMMA, SIG, SCEPS, SCC, TOLB, T12FAC, XMOVERENORM, RESIZE, QTSALLIS, & 44:       DOUBLE PRECISION RHO, GAMMA, SIG, SCEPS, SCC, TOLB, T12FAC, XMOVERENORM, RESIZE, QTSALLIS, &
 46:      &                 CQMAX, RADIUS, BQMAX,  MAXBFGS, DECAYPARAM, SYMTOL1, SYMTOL2, SYMTOL3, SYMTOL4, SYMTOL5, PGSYMTOLS(3),& 45:      &                 CQMAX, RADIUS, BQMAX,  MAXBFGS, DECAYPARAM, SYMTOL1, SYMTOL2, SYMTOL3, SYMTOL4, SYMTOL5, PGSYMTOLS(3),&
 47:      &                 ECONV, TOLD, TOLE, SYMREM(120,3,3), GMAX, CUTOFF, PCUT, EXPFAC, EXPD, CENTX, CENTY, CENTZ, & 46:      &                 ECONV, TOLD, TOLE, SYMREM(120,3,3), GMAX, CUTOFF, PCUT, EXPFAC, EXPD, CENTX, CENTY, CENTZ, &
 48:      &                 BOXLX, BOXLY, BOXLZ, BOX3D(3), PCUTOFF, SUPSTEP, SQUEEZER, SQUEEZED, COOPCUT, STOCKMU, STOCKLAMBDA, & 47:      &                 BOXLX, BOXLY, BOXLZ, BOX3D(3), PCUTOFF, SUPSTEP, SQUEEZER, SQUEEZED, COOPCUT, STOCKMU, STOCKLAMBDA, &
 49:      &                 TFAC(3), RMS, TEMPS, SACCRAT, CEIG, PNEWJUMP, EAMP, DISTFAC, ODDCHARGE, COULQ, COULSWAP, & 48:      &                 TFAC(3), RMS, TEMPS, SACCRAT, CEIG, PNEWJUMP, EAMP, DISTFAC, ODDCHARGE, COULQ, COULSWAP, &
 50:      &                 COULTEMP, APP, AMM, APM, XQP, XQM, ALPHAP, ALPHAM, ZSTAR, K_COMP, DGUESS, GUIDECUT, EFAC,& 49:      &                 COULTEMP, APP, AMM, APM, XQP, XQM, ALPHAP, ALPHAM, ZSTAR, K_COMP, DGUESS, GUIDECUT, EFAC,&
 51:      &                 TRENORM, HISTMIN, HISTMAX, HISTFAC, EPSSPHERE, FINALCUTOFF, SHELLPROB, RINGROTSCALE, & 50:      &                 TRENORM, HISTMIN, HISTMAX, HISTFAC, EPSSPHERE, FINALCUTOFF, SHELLPROB, RINGROTSCALE, &
 52:      &                 HISTFACMUL, HPERCENT, AVOIDDIST, MAXERISE, MAXEFALL, TSTART, MATDIFF, STICKYSIG, SDTOL, & 51:      &                 HISTFACMUL, HPERCENT, AVOIDDIST, MAXERISE, MAXEFALL, TSTART, MATDIFF, STICKYSIG, SDTOL, &
 53:      &                 MinimalTemperature, MaximalTemperature, SwapProb, hdistconstraint, COREFRAC, TSTAR, & 52:      &                 MinimalTemperature, MaximalTemperature, SwapProb, hdistconstraint, COREFRAC, TSTAR, &
 54:      &                 RK_R, RK_THETA,ARMA,ARMB, ExtrapolationPercent, lnHarmFreq, PTEMIN, PTEMAX, PTTMIN, PTTMAX, EXCHPROB, & 53:      &                 RK_R, RK_THETA,ARMA,ARMB, ExtrapolationPercent, lnHarmFreq, PTEMIN, PTEMAX, PTTMIN, PTTMAX, EXCHPROB, &
 55:      &                 PTSTEPS, NEQUIL, NQUENCH, COLDFUSIONLIMIT, NEWRES_TEMP, MINOMEGA, LJSIGMA, LJEPSILON, TAUMAX, & 54:      &                 PTSTEPS, NEQUIL, NQUENCH, COLDFUSIONLIMIT, NEWRES_TEMP, MINOMEGA, LJSIGMA, LJEPSILON, TAUMAX, &
 56:      &                 TAUMAXFULL, CPFACTORSG, CPFACTORFG, VGWTOL, ABTHRESH, ACTHRESH, CSMPMAT(3,3), & 55:      &                 TAUMAXFULL, CPFACTORSG, CPFACTORFG, VGWTOL, ABTHRESH, ACTHRESH, CSMPMAT(3,3), &
 57:      &                 RADIUS_CONTAINER, HYDROPHOBIC, RESTRICTREGIONX0, RESTRICTREGIONY0, RESTRICTREGIONZ0, & 56:      &                 RADIUS_CONTAINER, HYDROPHOBIC, RESTRICTREGIONX0, RESTRICTREGIONY0, RESTRICTREGIONZ0, &
 58:      &                 RESTRICTREGIONRADIUS, HARMONICSTR, DUMPUNIQUEEPREV, DUMPUNIQUEEMARKOV, FREEZESAVEE, & 57:      &                 RESTRICTREGIONRADIUS, HARMONICSTR, DUMPUNIQUEEPREV, DUMPUNIQUEEMARKOV, FREEZESAVEE, &
 59:      &                 TBPMIN, TBPSTEP, TBPHF, TBPCF, TBPINCR, SHIFTV, GEOMDIFFTOL, LJATTOC, GCMU, HESS_EIGEN_TOL, & 58:      &                 TBPMIN, TBPSTEP, TBPHF, TBPCF, TBPINCR, SHIFTV, GEOMDIFFTOL, LJATTOC, GCMU, HESS_EIGEN_TOL, &
 60:      &                 SRATIO, TRATIO, EXCHINT, DDMCUT, SUMTEMP, SUMSTEP, SUMOSTEP, EXPANDFACTOR, ROTATEFACTOR, EPSRIGID, & 59:      &                 SRATIO, TRATIO, EXCHINT, DDMCUT, SUMTEMP, SUMSTEP, SUMOSTEP, EXPANDFACTOR, ROTATEFACTOR, EPSRIGID, &
 61:      &                 CONTOURBOUNDS(3,2), KCOMP_RIGID, RIGIDCOMDIST, PALPHA, PBETA, PGAMMA, LAT(3,3), MFETPCTL, MFETTRGT, & 60:      &                 CONTOURBOUNDS(3,2), KCOMP_RIGID, RIGIDCOMDIST, PALPHA, PBETA, PGAMMA, LAT(3,3), MFETPCTL, MFETTRGT, QUIPEQDIST, &
 62:      &                 QUIPEQDIST, EWALDALPHA, EWALDREALC, EWALDRECIPC, RSPEED, & 
 63:  61: 
 64: !   parameters for anisotropic potentials 62: !   parameters for anisotropic potentials
 65: ! 63: !
 66: !    DC430 > 64: !    DC430 >
 67:      &                 CAPEPS2, CAPRAD, CAPRHO, CAPHEIGHT1, CAPHEIGHT2, & 65:      &                 CAPEPS2, CAPRAD, CAPRHO, CAPHEIGHT1, CAPHEIGHT2, &
 68:      &                 EPSR, GBKAPPA, GBKAPPRM, GBMU,GBNU, GBSIGNOT, GBEPSNOT, GBCHI, GBCHIPRM, & 66:      &                 EPSR, GBKAPPA, GBKAPPRM, GBMU,GBNU, GBSIGNOT, GBEPSNOT, GBCHI, GBCHIPRM, &
 69:      &                 SIGNOT, EPSNOT, SIGMAF, INVKAP, ESA(3), LPRSQ, LSQDFR, GBDPMU, GBDPEPS, GBDPFCT, & 67:      &                 SIGNOT, EPSNOT, SIGMAF, INVKAP, ESA(3), LPRSQ, LSQDFR, GBDPMU, GBDPEPS, GBDPFCT, &
 70:      &                 PYSIGNOT, PYEPSNOT, PYA1(3), PYA2(3), PYDPMU, PYDPEPS, PYDPFCT, PYGRAVITYC1, PYGRAVITYC2, & 68:      &                 PYSIGNOT, PYEPSNOT, PYA1(3), PYA2(3), PYDPMU, PYDPEPS, PYDPFCT, PYGRAVITYC1, PYGRAVITYC2, &
 71:      &                 LWRCUT, LWCNSTA, LWCNSTB, LWRCUTSQ, LWRCUT2SQ, DELRC, PAPALP, PAPS, PAPCD, PAPEPS, PAPANG1, PAPANG2, & 69:      &                 LWRCUT, LWCNSTA, LWCNSTB, LWRCUTSQ, LWRCUT2SQ, DELRC, PAPALP, PAPS, PAPCD, PAPEPS, PAPANG1, PAPANG2, &
 72:      &                 DBEPSBB, DBEPSAB, DBSIGBB, DBSIGAB, DBPMU, EFIELD, YKAPPA, YEPS, GEMRC, MREQ, HSEFF, BEPS, & 70:      &                 DBEPSBB, DBEPSAB, DBSIGBB, DBSIGAB, DBPMU, EFIELD, YKAPPA, YEPS, GEMRC, MREQ, HSEFF, BEPS, &
 97:      &        FRAUSIT, ANGST, SELFT, STEPOUT, WENZEL, THRESHOLDT, THOMSONT, MULLERBROWNT, CHARMMENERGIES, & 95:      &        FRAUSIT, ANGST, SELFT, STEPOUT, WENZEL, THRESHOLDT, THOMSONT, MULLERBROWNT, CHARMMENERGIES, &
 98:      &        PROJ, RGCL2, TOSI, WELCH, AXTELL, AMBER, FIXIMAGE, BINARY, SHIFTCUT, ARNO, TUNNELT, TWOD, & 96:      &        PROJ, RGCL2, TOSI, WELCH, AXTELL, AMBER, FIXIMAGE, BINARY, SHIFTCUT, ARNO, TUNNELT, TWOD, &
 99:      &        BLJCLUSTER, BLJCLUSTER_NOCUT, COMPRESST, FIX, FIXT, BFGS, LBFGST, DBRENTT, DZTEST, FNI, FAL, CPMD, TNT, ZETT1, & 97:      &        BLJCLUSTER, BLJCLUSTER_NOCUT, COMPRESST, FIX, FIXT, BFGS, LBFGST, DBRENTT, DZTEST, FNI, FAL, CPMD, TNT, ZETT1, &
100:      &        ZETT2, GBH_RESTART, RESTART, CONJG, NEWRESTART, AVOID, NATBT, DIFFRACTT, CHRMMT, INTMINT, LB2T, & 98:      &        ZETT2, GBH_RESTART, RESTART, CONJG, NEWRESTART, AVOID, NATBT, DIFFRACTT, CHRMMT, INTMINT, LB2T, &
101:      &        PTMC, BINSTRUCTURES, PROGRESS, MODEL1T, NEWRESTART_MD, CHANGE_TEMP, NOCISTRANS, CHECKCHIRALITY, & 99:      &        PTMC, BINSTRUCTURES, PROGRESS, MODEL1T, NEWRESTART_MD, CHANGE_TEMP, NOCISTRANS, CHECKCHIRALITY, &
102:      &        GBT, GBDT, GBDPT, GEMT, LINRODT, RADIFT, CAPBINT, DBPT, DBPTDT, DMBLMT, DMBLPYT, EFIELDT, PAHAT, STOCKAAT, MORSEDPT, &100:      &        GBT, GBDT, GBDPT, GEMT, LINRODT, RADIFT, CAPBINT, DBPT, DBPTDT, DMBLMT, DMBLPYT, EFIELDT, PAHAT, STOCKAAT, MORSEDPT, &
103:      &        MSGBT, MSTBINT, MMRSDPT, MSSTOCKT, LWOTPT, NCAPT, NPAHT, NTIPT, PAHW99T, ELLIPSOIDT, GAYBERNET,&101:      &        MSGBT, MSTBINT, MMRSDPT, MSSTOCKT, LWOTPT, NCAPT, NPAHT, NTIPT, PAHW99T, ELLIPSOIDT, GAYBERNET,&
104:      &        MULTPAHAT, PAPT, PAPBINT, PAPJANT, PTSTSTT, SHIFTED, SILANET, TDHDT, DDMT, WATERDCT, WATERKZT, CHECKDT, CHECKMARKOVT,&102:      &        MULTPAHAT, PAPT, PAPBINT, PAPJANT, PTSTSTT, SHIFTED, SILANET, TDHDT, DDMT, WATERDCT, WATERKZT, CHECKDT, CHECKMARKOVT,&
105:      &        TETHER, HISTSMOOTH, VISITPROP, ARMT, FixedEndMoveT, FIXCOM, RESTORET, QUADT, AMHT, MOVESHELLT, QDT, QD2T, &103:      &        TETHER, HISTSMOOTH, VISITPROP, ARMT, FixedEndMoveT, FIXCOM, RESTORET, QUADT, AMHT, MOVESHELLT, QDT, QD2T, &
106:      &        PARAMONOVPBCX, PARAMONOVPBCY, PARAMONOVPBCZ, PARAMONOVCUTOFF, GAYBERNEDCT, UNFREEZERES, FREEZEALL, &104:      &        PARAMONOVPBCX, PARAMONOVPBCY, PARAMONOVPBCZ, PARAMONOVCUTOFF, GAYBERNEDCT, UNFREEZERES, FREEZEALL, &
107:      &        PROJIT, PROJIHT, LEAPDIHE, DUMPQUT, DUMPBESTT, LJSITE, BLJSITE, LJSITEATTR, DUMPSTEPST, PAHAGENRIGIDT, &105:      &        PROJIT, PROJIHT, LEAPDIHE, DUMPQUT, DUMPBESTT, LJSITE, BLJSITE, LJSITEATTR, DUMPSTEPST, &
108:      &        AMBERT, RANDOMSEEDT, PYGPERIODICT, LJCAPSIDT, PYBINARYT, SWAPMOVEST, MOVABLEATOMST, LIGMOVET,DUMPSTRUCTURES, &106:      &        AMBERT, RANDOMSEEDT, PYGPERIODICT, LJCAPSIDT, PYBINARYT, SWAPMOVEST, MOVABLEATOMST, LIGMOVET,DUMPSTRUCTURES, &
109:      &        LJSITECOORDST, VGW, ACKLANDT, G46, DF1T, PULLT, LOCALSAMPLET, CSMT, A9INTET, INTERESTORE, COLDFUSION, &107:      &        LJSITECOORDST, VGW, ACKLANDT, G46, DF1T, PULLT, LOCALSAMPLET, CSMT, A9INTET, INTERESTORE, COLDFUSION, &
110:      &        CSMGUIDET, MULTISITEPYT, CHAPERONINT, AVOIDRESEEDT, OHCELLT, UNFREEZEFINALQ, PERCOLATET, PERCT, PERCACCEPTED, PERCCOMPMARKOV, PERCGROUPT, &108:      &        CSMGUIDET, MULTISITEPYT, CHAPERONINT, AVOIDRESEEDT, OHCELLT, UNFREEZEFINALQ, PERCOLATET, PERCT, PERCACCEPTED, PERCCOMPMARKOV, PERCGROUPT, &
111:      &        GENALT, MINDENSITYT, RESTRICTREGION, RESTRICTREGIONTEST, RESTRICTCYL, ACK1, ACK2, HARMONICF, PERCGROUPRESEEDT, &109:      &        GENALT, MINDENSITYT, RESTRICTREGION, RESTRICTREGIONTEST, RESTRICTCYL, ACK1, ACK2, HARMONICF, PERCGROUPRESEEDT, &
112:      &        HARMONICDONTMOVE, DUMPUNIQUE, FREEZESAVE, TBP, RBSYMT, PTMCDUMPSTRUCT, PTMCDUMPENERT, PYCOLDFUSION, MONITORT,&110:      &        HARMONICDONTMOVE, DUMPUNIQUE, FREEZESAVE, TBP, RBSYMT, PTMCDUMPSTRUCT, PTMCDUMPENERT, PYCOLDFUSION, MONITORT,&
113:      &        CHARMMDFTBT, PERMINVOPT, BLOCKMOVET, MAXERISE_SET, PYT, BINARY_EXAB, CHIROT, POLYT, SANDBOXT, &111:      &        CHARMMDFTBT, PERMINVOPT, BLOCKMOVET, MAXERISE_SET, PYT, BINARY_EXAB, CHIROT, POLYT, SANDBOXT, &
114:      &        RESERVOIRT, DISTOPT, ONEDAPBCT, ONEDPBCT, TWODAPBCT, TWODPBCT, THREEDAPBCT, THREEDPBCT, RATIOT, &112:      &        RESERVOIRT, DISTOPT, ONEDAPBCT, ONEDPBCT, TWODAPBCT, TWODPBCT, THREEDAPBCT, THREEDPBCT, RATIOT, &
115:      &        PTRANDOM, PTINTERVAL, PTSINGLE, PTSETS, CHEMSHIFT, CHEMSHIFT2, CSH, DEBUGss2029, UNIFORMMOVE, RANSEEDT, &113:      &        PTRANDOM, PTINTERVAL, PTSINGLE, PTSETS, CHEMSHIFT, CHEMSHIFT2, CSH, DEBUGss2029, UNIFORMMOVE, RANSEEDT, &
116:      &        TTM3T, NOINVERSION, RIGIDCONTOURT, UPDATERIGIDREFT, HYBRIDMINT, COMPRESSRIGIDT, MWFILMT, &114:      &        TTM3T, NOINVERSION, RIGIDCONTOURT, UPDATERIGIDREFT, HYBRIDMINT, COMPRESSRIGIDT, MWFILMT, &
117:      &        SUPPRESST, MFETT, POLIRT, QUIPT, SWPOTT, MWPOTT, REPMATCHT, GLJT, MLJT, READMASST, SPECMASST, NEWTSALLIST, &115:      &        SUPPRESST, MFETT, POLIRT, QUIPT, SWPOTT, MWPOTT, REPMATCHT, GLJT, MLJT, READMASST, SPECMASST, NEWTSALLIST, &
118:      &        PHI4MODELT, CUDAT, CUDATIMET, AMBER12T, ENERGY_DECOMPT, NEWMOVEST, DUMPMINT, MBPOLT, MOLECULART, GCBHT, SEMIGRAND_MUT, USEROT, &116:      &        PHI4MODELT, CUDAT, CUDATIMET, AMBER12T, ENERGY_DECOMPT, NEWMOVEST, DUMPMINT, MBPOLT, MOLECULART, GCBHT, SEMIGRAND_MUT, USEROT, &
119:      &        SAVEMULTIMINONLY, GRADPROBLEMT, INTLJT, CONDATT, QCIPERMCHECK, &117:      &        SAVEMULTIMINONLY, GRADPROBLEMT, INTLJT, CONDATT, QCIPERMCHECK, &
120:      &        INTCONSTRAINTT, INTFREEZET, CHECKCONINT, CONCUTABST, CONCUTFRACT, INTERPCOSTFUNCTION, &118:      &        INTCONSTRAINTT, INTFREEZET, CHECKCONINT, CONCUTABST, CONCUTFRACT, INTERPCOSTFUNCTION, &
121:      &        RBAAT, FREEZENODEST, DUMPINTEOS, DUMPINTXYZ, QCIPOTT, QCIPOT2T, INTSPRINGACTIVET, LPERMDIST, LOCALPERMDIST, QCIRADSHIFTT, &119:      &        RBAAT, FREEZENODEST, DUMPINTEOS, DUMPINTXYZ, QCIPOTT, QCIPOT2T, INTSPRINGACTIVET, LPERMDIST, LOCALPERMDIST, QCIRADSHIFTT, &
122:      &        MLP3T, MKTRAPT, MLPB3T, MLPB3NEWT, MULTIPOTT, QCIAMBERT, MLPNEWREG, DJWRBT, STEALTHYT, LJADDT, QCINOREPINT, RIGIDMDT, &120:      &        MLP3T, MKTRAPT, MLPB3T, MLPB3NEWT, MULTIPOTT, QCIAMBERT, MLPNEWREG, DJWRBT, STEALTHYT, LJADDT, QCINOREPINT, RIGIDMDT, &
123:      &        DUMPMQT, MLQT, MLQPROB, LJADD2T, MLPVB3T, NOREGBIAS, PYADDT, PYADD2T, LJADD3T, REORDERADDT,  LJADD4T, &121:      &        DUMPMQT, MLQT, MLQPROB, LJADD2T, MLPVB3T, NOREGBIAS, PYADDT, PYADD2T, LJADD3T, REORDERADDT,  LJADD4T, &
124:      &        SQNMT, SQNM_DEBUGT, SQNM_BIOT, BENZRIGIDEWALDT, ORTHO, EWALDT122:      &        SQNMT, SQNM_DEBUGT, SQNM_BIOT
125: !123: !
126:       DOUBLE PRECISION, ALLOCATABLE :: SEMIGRAND_MU(:)124:       DOUBLE PRECISION, ALLOCATABLE :: SEMIGRAND_MU(:)
127:       DOUBLE PRECISION, ALLOCATABLE :: ATMASS(:)125:       DOUBLE PRECISION, ALLOCATABLE :: ATMASS(:)
128:       DOUBLE PRECISION, ALLOCATABLE :: SPECMASS(:)126:       DOUBLE PRECISION, ALLOCATABLE :: SPECMASS(:)
129: 127: 
130: ! dj337: Ewald summation variables 
131:       DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: RERHOARRAY, IMRHOARRAY 
132:  
133: ! csw34> FREEZEGROUP variables128: ! csw34> FREEZEGROUP variables
134: !129: !
135:       INTEGER :: GROUPCENTRE130:       INTEGER :: GROUPCENTRE
136:       DOUBLE PRECISION :: GROUPRADIUS131:       DOUBLE PRECISION :: GROUPRADIUS
137:       CHARACTER (LEN=2) :: FREEZEGROUPTYPE132:       CHARACTER (LEN=2) :: FREEZEGROUPTYPE
138:       LOGICAL :: FREEZEGROUPT133:       LOGICAL :: FREEZEGROUPT
139: ! END134: ! END
140: 135: 
141: !136: !
142: ! csw34> DONTMOVE variables137: ! csw34> DONTMOVE variables


r32452/ewald.f90 2017-05-02 18:30:26.616498786 +0100 r32451/ewald.f90 2017-05-02 18:30:30.144544664 +0100
  1: module ewald  1: svn: E195012: Unable to find repository location for 'svn+ssh://svn.ch.private.cam.ac.uk/groups/wales/trunk/GMIN/source/ewald.f90' in revision 32451
  2: use commons 
  3: implicit none 
  4:  
  5: contains 
  6:  
  7: ! --------------------------------------- 
  8: ! HELPER FUNCTIONS 
  9: ! --------------------------------------- 
 10: ! --------------------------------------- 
 11: ! dj337: calculates volume of cell given lattice vectors 
 12: ! --------------------------------------- 
 13:       subroutine volume(vol) 
 14:  
 15:       use commons 
 16:  
 17:       implicit none 
 18:  
 19:       double precision :: vol 
 20:  
 21:       if (ortho) then 
 22:          vol = boxlx*boxly*boxlz 
 23:       else 
 24:          ! TODO: implement volume for non-orthorhombic boxes 
 25:          print *, 'Volume has not been implemented for non-orthorhombic boxes!' 
 26:       endif 
 27:  
 28:       return 
 29:       end subroutine 
 30:  
 31: ! --------------------------------------- 
 32: ! dj337: Computes the energy and gradient of potentials using Ewald summation. 
 33: ! Usable for any potential that satifisfies the equation: 
 34: ! U_n = (1/2)*sum_L(sum_i,j(B_ij/(rij+L)**n)) 
 35: ! where n is any integer and L are lattice vectors. 
 36: ! A separate subroutine is used to calculate the special case for the 
 37: ! Coulomb potential (when n=1). 
 38: ! 
 39: ! All equations for Coulomb summation follow from: 
 40: ! Karasawa, N. and Goddard III, W. A. J. Phys. Chem., 93, 7320-7327 (1989). 
 41: !  
 42: ! All input / output are in Cartesian coordinates 
 43: ! 
 44: ! Assuming all units for length, charge, and energy are in atomic units. 
 45: ! --------------------------------------- 
 46:       subroutine ewaldsum(n, x, g, etot, gtest) 
 47:  
 48:       use commons 
 49:       use genrigid 
 50:  
 51:       implicit none 
 52:  
 53:       integer                       :: n 
 54:       logical                       :: gtest 
 55:       double precision, intent(in)  :: x(3*natoms) 
 56:       double precision, intent(out) :: g(3*natoms) 
 57:       double precision, intent(out) :: etot 
 58:  
 59:       etot = 0.0d0 
 60:       g(:) = 0.0d0 
 61:  
 62:       if (n > 1) then 
 63:          ! TODO: implement general Ewald summation 
 64:          print *, 'Ewald summation not yet implemented for n > 1!' 
 65:          return 
 66:       else 
 67:          if (ortho) then 
 68:             call coulombreal(x, etot) 
 69:             call coulombrecip(x, etot) 
 70:             if (gtest) then 
 71:                call coulombrealgrad(x, g) 
 72:                call coulombrecipgrad(x, g) 
 73:             endif 
 74:          else 
 75:             ! TODO: implement Coulomb for non-orthogonal lattice vectors 
 76:             print *, 'Ewald sums for Coulomb not yet implemented for non-orthorhombic!' 
 77:             return 
 78:          endif 
 79:       endif 
 80:  
 81:       return 
 82:       end subroutine 
 83:  
 84: ! --------------------------------------- 
 85: ! dj337: Calculates energy contributions to Coulomb sum due to real-space 
 86: ! sum (i.e. point charges screened by oppositely charged Gaussian cloud)  
 87: ! and self correction. 
 88: ! 
 89: ! Assumes orthogonal lattice vectors. 
 90: ! --------------------------------------- 
 91:       subroutine coulombreal(x, ereal) 
 92:  
 93:       use commons 
 94:       use genrigid, only: nrigidbody, nsiteperbody 
 95:  
 96:       implicit none 
 97:  
 98:       integer                         :: j1, j3, j2, j4, l, m, n, i 
 99:       double precision, intent(in)    :: x(3*natoms) 
100:       double precision                :: rmin(3), r(3) 
101:       double precision                :: q1, q2, sumq2, dist, dist2, ewaldrealc2 
102:       double precision                :: vshift, esum, eself, ewrb 
103:       double precision, intent(inout) :: ereal 
104:       double precision, parameter     :: pi = 3.141592654D0 
105:  
106:       ! real-space cutoff 
107:       ewaldrealc2 = ewaldrealc**2 
108:       esum = 0.0d0 
109:  
110:       ! compute real-space sum 
111:       ! U_real-space = sum_L,i>j(Qij*erfc(alpha*rij)/rij) 
112:       ! iterate over atoms j 
113:       do j1 = 1, natoms 
114:          j3 = 3*j1 
115:          q1 = stchrg(j1) 
116:  
117:          ! iterate over atoms i > j 
118:          do j2 = j1+1, natoms 
119:             j4 = 3*j2 
120:             q2 = stchrg(j2) 
121:  
122:             ! get distance between atoms 
123:             rmin(1) = x(j3-2)-x(j4-2) 
124:             rmin(2) = x(j3-1)-x(j4-1) 
125:             rmin(3) = x(j3)-x(j4) 
126:             ! minimum image convention 
127:             rmin(1) = rmin(1)-boxlx*anint(rmin(1)/boxlx) 
128:             rmin(2) = rmin(2)-boxly*anint(rmin(2)/boxly) 
129:             rmin(3) = rmin(3)-boxlz*anint(rmin(3)/boxlz) 
130:  
131:             ! calculate vertical shift 
132:             vshift = q1*q2*erfc(ewaldalpha*ewaldrealc)/ewaldrealc 
133:  
134:             ! iterate over boxes 
135:             do l = -newaldreal(1),newaldreal(1) 
136:                r(1) = rmin(1)+boxlx*l 
137:                do m = -newaldreal(2),newaldreal(2) 
138:                   r(2) = rmin(2)+boxly*m 
139:                   do n = -newaldreal(3),newaldreal(3) 
140:                      r(3) = rmin(3)+boxlz*n 
141:                      dist2 = r(1)**2 + r(2)**2 + r(3)**2 
142:                      if (dist2 < ewaldrealc2) then 
143:                         dist = dsqrt(dist2) 
144:                         ! calculate short-range contribution 
145:                         ! note: don't need factor of 1/2 bc summing over j,i>j 
146:                         esum = esum + q1*q2*erfc(ewaldalpha*dist)/dist - vshift 
147:                      endif 
148:                   enddo 
149:                enddo 
150:             enddo 
151:          enddo 
152:       enddo 
153:  
154:       ! include contribution due to interaction of j1 with periodic images of itself 
155:       ! (separated due to efficiency) 
156:       ! U_periodic-self = 0.5*sum_L(erfc(alpha*rL)/rL)*sum_i(Qi**2) 
157:       sumq2 = 0.0d0 
158:       do j1 = 1, natoms 
159:         q1 = stchrg(j1) 
160:         sumq2 = sumq2 + q1*q1 
161:       enddo 
162:  
163:       ! calculate vertical shift 
164:       vshift = erfc(ewaldalpha*ewaldrealc)/(2*ewaldrealc) 
165:  
166:       eself = 0.0d0 
167:       ! iterate over boxes 
168:       do l = -newaldreal(1),newaldreal(1) 
169:          r(1) = boxlx*l 
170:          do m = -newaldreal(2),newaldreal(2) 
171:             r(2) = boxly*m 
172:             do n = -newaldreal(3),newaldreal(3) 
173:                r(3) = boxlz*n 
174:                ! check not in central box 
175:                if (.not.(l.eq.0.and.m.eq.0.and.n.eq.0)) then 
176:                   dist2 = r(1)**2 + r(2)**2 + r(3)**2 
177:                   if (dist2 < ewaldrealc2) then 
178:                      dist = dsqrt(dist2) 
179:                      ! calculate short-range contribution 
180:                      ! note: need factor of 1/2 to prevent double-counting 
181:                      eself = eself + erfc(ewaldalpha*dist)/(2.0d0*dist) - vshift 
182:                   endif 
183:                endif 
184:             enddo 
185:          enddo 
186:       enddo 
187:  
188:       esum = esum + sumq2*eself 
189:  
190:       ! compensate for within-rigidbody interactions 
191:       ! calculate within-rigidbody energy using exact Coulomb sum 
192:       ! U_wrb = sum_J(sum_i>j(Qij/rij)) 
193:       ! note: don't need factor of 1/2 because summing over i > j 
194:       ewrb = 0.0d0 
195:       ! iterate over rigidbodies 
196:       do i = 1, nrigidbody 
197:  
198:          ! iterate over atoms i 
199:          do j1 = 1, nsiteperbody(i) 
200:             j3 = 3*j1 
201:             q1 = stchrg(j1) 
202:  
203:             ! iterate over atoms i > j 
204:             do j2 = j1+1, nsiteperbody(i) 
205:                j4 = 3*j2 
206:                q2 = stchrg(j2) 
207:  
208:                ! calculate rij 
209:                r(1) = x(j3-2)-x(j4-2) 
210:                r(2) = x(j3-1)-x(j4-1) 
211:                r(3) = x(j3)-x(j4) 
212:                dist2 = r(1)**2 + r(2)**2 + r(3)**2 
213:                dist = dsqrt(dist2) 
214:  
215:                ! calculate within-rigidbody contribution 
216:                ewrb = ewrb + q1*q2/dist 
217:             enddo 
218:          enddo 
219:       enddo 
220:  
221:       ! subtract U_wrb 
222:       esum = esum - ewrb 
223:  
224:       ! compensate for contribution due to self-interaction 
225:       ! U_self-interaction = -alpha*sum_i(Qi**2)/sqrt(pi) 
226:       esum = esum - sumq2*ewaldalpha/dsqrt(pi) 
227:  
228:       ereal = ereal + esum 
229:  
230:       return 
231:       end subroutine 
232:  
233: ! --------------------------------------- 
234: ! dj337: Calculates and stores terms that are needed to calculate structure 
235: ! factors, S(k)S(-k). Because the coefficient of the Coulomb term satisfies  
236: ! the geometric combination rule (i.e. Qij = sqrt(Qii*Qjj)), structure  
237: ! factors can be used to greatly simplify the computation of the  
238: ! reciprocal-space contributions to the energy and gradient. 
239: ! 
240: ! Assumes orthogonal lattice vectors. 
241: ! --------------------------------------- 
242:       subroutine ftdensity(x) 
243:  
244:       use commons  
245:  
246:       implicit none 
247:  
248:       integer                      :: j1, j3, l, m, n 
249:       double precision, intent(in) :: x(3*natoms) 
250:       double precision             :: k(3), r(3) 
251:       double precision             :: q1, k2, kdotr, rerho, imrho, ewaldrecipc2 
252:       double precision, parameter  :: pi = 3.141592654D0 
253:  
254:       ! reciprocal-space cutoff 
255:       ewaldrecipc2 = ewaldrecipc**2 
256:  
257:       ! iterate over boxes and calculate reciprocal lattice vectors 
258:       ! note: because of anti/symmetry in sine and cosine functions, 
259:       ! only need to calculate terms for half of the k-values 
260:       do l = 0,newaldrecip(1) 
261:          k(1) = 2*pi*l/boxlx 
262:          do m = -newaldrecip(2),newaldrecip(2) 
263:             k(2) = 2*pi*m/boxly 
264:             do n = -newaldrecip(3),newaldrecip(3) 
265:                k(3) = 2*pi*n/boxlz 
266:                ! check not in central box 
267:                if (.not.(l.eq.0.and.m.eq.0.and.n.eq.0)) then 
268:                   k2 = k(1)**2 + k(2)**2 + k(3)**2 
269:                   if (k2 < ewaldrecipc2) then 
270:                      rerho=0.0d0 
271:                      imrho=0.0d0 
272:                      ! iterate over atoms 
273:                      do j1 = 1, natoms 
274:                         j3 = 3*j1 
275:                         q1 = stchrg(j1) 
276:                         r(1) = x(j3-2) 
277:                         r(2) = x(j3-1) 
278:                         r(3) = x(j3) 
279:                         ! dot product of k and ri 
280:                         kdotr = k(1)*r(1) + k(2)*r(2) + k(3)*r(3) 
281:                         ! rerho = sum_i(Qi*cos(k*ri)) 
282:                         rerho = rerho + q1*dcos(kdotr) 
283:                         ! imrho = sum_i(Qi*sin(k*ri)) 
284:                         imrho = imrho + q1*dsin(kdotr) 
285:                      enddo 
286:                   endif 
287:                   ! store rerho and imrho values 
288:                   rerhoarray(-l+newaldrecip(1)+1, -m+newaldrecip(2)+1, -n+newaldrecip(3)+1) = rerho 
289:                   rerhoarray(l+newaldrecip(1)+1, m+newaldrecip(2)+1, n+newaldrecip(3)+1) = rerho 
290:                   imrhoarray(-l+newaldrecip(1)+1, -m+newaldrecip(2)+1, -n+newaldrecip(3)+1) = -imrho 
291:                   imrhoarray(l+newaldrecip(1)+1, m+newaldrecip(2)+1, n+newaldrecip(3)+1) = imrho 
292:                endif 
293:             enddo 
294:          enddo 
295:       enddo 
296:  
297:       return 
298:       endsubroutine 
299:  
300: ! --------------------------------------- 
301: ! dj337: Calculates energy contributions to Coulomb sum due to 
302: ! reciprocal-space sum. Uses terms calculated by ftdensity subroutine 
303: ! to use structure factors to simplify computation. 
304: ! 
305: ! Assumes orthogonal lattice vectors. 
306: ! --------------------------------------- 
307:       subroutine coulombrecip(x, erecip) 
308:  
309:       implicit none 
310:  
311:       integer                         :: l, m, n 
312:       double precision, intent(in)    :: x(3*natoms) 
313:       double precision                :: k(3) 
314:       double precision                :: vol, ewaldrecipc2 
315:       double precision                :: k2, rerho, imrho, esum 
316:       double precision, intent(inout) :: erecip 
317:       double precision, parameter     :: pi = 3.141592654D0 
318:  
319:       ! cell volume 
320:       call volume(vol) 
321:       ! reciprocal-space cutoff 
322:       ewaldrecipc2 = ewaldrecipc**2 
323:       call ftdensity(x) 
324:       esum = 0.0d0 
325:  
326:       ! compute reciprocal-space sum 
327:       ! U_f = (2*pi/V)*(sum_k(exp(-k**2/4*alpha**2)*S(k)S(-k)/k**2) 
328:       ! iterate over boxes and calculate reciprocal lattice vectors 
329:       do l = -newaldrecip(1), newaldrecip(1) 
330:          k(1) = 2*pi*l/boxlx 
331:          do m = -newaldrecip(2), newaldrecip(2) 
332:             k(2) = 2*pi*m/boxly 
333:             do n = -newaldrecip(3), newaldrecip(3) 
334:                k(3) = 2*pi*n/boxlz 
335:                ! check not in central box 
336:                if (.not.(l.eq.0.and.m.eq.0.and.n.eq.0)) then 
337:                   k2 = k(1)**2 + k(2)**2 + k(3)**2 
338:                   if (k2 < ewaldrecipc2) then 
339:                      rerho = rerhoarray(l+newaldrecip(1)+1, m+newaldrecip(2)+1, n+newaldrecip(3)+1) 
340:                      imrho = imrhoarray(l+newaldrecip(1)+1, m+newaldrecip(2)+1, n+newaldrecip(3)+1) 
341:                      ! calculate long-range contribution 
342:                      esum = esum + dexp(-k2/(4.0d0*ewaldalpha**2))*(rerho**2+imrho**2)/k2 
343:                   endif 
344:                endif 
345:             enddo 
346:          enddo 
347:       enddo 
348:  
349:       ! multiply sum by factor of 2*pi/vol 
350:       erecip = erecip + 2.0d0*pi*esum/vol 
351:  
352:       return 
353:       end subroutine 
354:  
355: ! --------------------------------------- 
356: ! dj337: Calculates the real-space contribution to the gradient 
357: ! of the Coulomb sum.  
358: ! 
359: ! Assumes orthogonal lattice vectors. 
360: ! --------------------------------------- 
361:       subroutine coulombrealgrad(x, g) 
362:  
363:       use commons 
364:  
365:       implicit none 
366:  
367:       integer                         :: j1, j3, j2, j4, l, m, n 
368:       double precision, intent(in)    :: x(3*natoms) 
369:       double precision, intent(inout) :: g(3*natoms) 
370:       double precision                :: r(3), rmin(3), f(3) 
371:       double precision                :: ewaldrealc2 
372:       double precision                :: q1, q2, mul, dist, dist2 
373:       double precision, parameter     :: pi = 3.141592654d0 
374:  
375:       ! real-space cutoff 
376:       ewaldrealc2 = ewaldrealc**2 
377:  
378:       ! compute real-space contribution to gradient 
379:       ! G_r = sum_L,i>j(-Qij*r*((erfc(alpha*rij)/(alpha*dist)**3) + 2*alpha*exp(-(alpha*rij)**2)/(sqrt(pi)*rij**2)) 
380:       ! iterate over atoms i 
381:       do j1 = 1, natoms 
382:          j3 = 3*j1 
383:          q1 = stchrg(j1) 
384:  
385:          ! iterate over atoms i > j 
386:          do j2 = j1+1, natoms 
387:             j4 = 3*j2 
388:             q2 = stchrg(j2) 
389:  
390:             ! get distance between atoms 
391:             rmin(1) = x(j3-2)-x(j4-2) 
392:             rmin(2) = x(j3-1)-x(j4-1) 
393:             rmin(3) = x(j3)-x(j4) 
394:             ! minimum image convention 
395:             rmin(1) = rmin(1)-boxlx*anint(rmin(1)/boxlx) 
396:             rmin(2) = rmin(2)-boxly*anint(rmin(2)/boxly) 
397:             rmin(3) = rmin(3)-boxlz*anint(rmin(3)/boxlz) 
398:  
399:             ! get gradient contribution per box 
400:             f(:) = 0.0d0 
401:  
402:             ! iterate over boxes 
403:             do l = -newaldreal(1),newaldreal(1) 
404:                r(1) = rmin(1)+boxlx*l 
405:                do m = -newaldreal(2),newaldreal(2) 
406:                   r(2) = rmin(2)+boxly*m 
407:                   do n = -newaldreal(3),newaldreal(3) 
408:                      r(3) = rmin(3)+boxlz*n 
409:                      dist2 = r(1)**2 + r(2)**2 + r(3)**2 
410:                      if (dist2 < ewaldrealc2) then 
411:                         dist = dsqrt(dist2) 
412:                         ! calculate short-range gradient contribution per box 
413:                         mul = q1*q2*(erfc(ewaldalpha*dist)/dist**3 + 2.0d0*ewaldalpha*dexp(-(ewaldalpha*dist)**2)/(dsqrt(pi)*dist**2)) 
414:                         f(1) = f(1) + mul*r(1) 
415:                         f(2) = f(2) + mul*r(2) 
416:                         f(3) = f(3) + mul*r(3) 
417:                      endif 
418:                   enddo 
419:                enddo 
420:             enddo 
421:  
422:             ! add gradient contribution 
423:             g(j3-2) = g(j3-2)-f(1) 
424:             g(j3-1) = g(j3-1)-f(2) 
425:             g(j3)   = g(j3)-f(3) 
426:             g(j4-2) = g(j4-2)+f(1) 
427:             g(j4-1) = g(j4-1)+f(2) 
428:             g(j4)   = g(j4)+f(3) 
429:          enddo 
430:       enddo 
431:  
432:       ! include contribution due to interaction of j1 with periodic images of itself 
433:       ! (separated due to efficiency) 
434:       ! G_periodic-self = sum_L(Qi**2*rL*(erfc(alpha*rL)/rL**3 + 2*alpha*exp(-(alpha*rL)**2)/(sqrt(pi)*rL**2))) 
435:       ! iterate over boxes 
436:       do l = -newaldreal(1),newaldreal(1) 
437:          rmin(1) = boxlx*l 
438:          do m = -newaldreal(2),newaldreal(2) 
439:             rmin(2) = boxly*m 
440:             do n = -newaldreal(3),newaldreal(3) 
441:                rmin(3) = boxlz*n 
442:                ! check not in central box 
443:                if (.not.(l.eq.0.and.m.eq.0.and.n.eq.0)) then 
444:                   dist2 = rmin(1)**2 + rmin(2)**2 + rmin(3)**2 
445:                   if (dist2 < ewaldrealc2) then 
446:                      dist = dsqrt(dist2) 
447:                      mul = erfc(ewaldalpha*dist)/dist**2 + 2.0d0*ewaldalpha*dexp(-(ewaldalpha*dist)**2)/(dsqrt(pi)*dist**2) 
448:                      ! iterate over atoms and calculate gradient terms 
449:                      do j1 = 1, natoms 
450:                         j3 = 3*j1 
451:                         q1 = stchrg(j1) 
452:                         g(j3-2) = g(j3-2) - q1*q1*mul*rmin(1) 
453:                         g(j3-1) = g(j3-1) - q1*q1*mul*rmin(2) 
454:                         g(j3)   = g(j3)   - q1*q1*mul*rmin(3) 
455:                      enddo 
456:                   endif 
457:                endif 
458:             enddo 
459:          enddo 
460:       enddo 
461:  
462:       return 
463:       endsubroutine 
464:  
465: ! --------------------------------------- 
466: ! dj337: Calculates the reipcrocal-space contribution to the gradient 
467: ! of the Coulomb sum. Uses terms calculated by ftdensity subroutine 
468: ! to use structure factors to simplify computation. 
469: ! 
470: ! Assumes orthogonal lattice vectors. 
471: ! --------------------------------------- 
472:       subroutine coulombrecipgrad(x, g) 
473:  
474:       use commons 
475:  
476:       implicit none 
477:  
478:       integer                         :: l, m, n, j1, j3 
479:       double precision, intent(in)    :: x(3*natoms) 
480:       double precision, intent(inout) :: g(3*natoms) 
481:       double precision                :: k(3), r(3) 
482:       double precision                :: vol, ewaldrecipc2 
483:       double precision                :: k2, kdotr, rerho, imrho, q1, mul, mul2 
484:       double precision, parameter     :: pi = 3.141592654D0 
485:  
486:       ! cell volume 
487:       call volume (vol) 
488:       ! reciprocal-space cutoff 
489:       ewaldrecipc2 = ewaldrecipc**2 
490:  
491:       ! compute reciprocal-space gradient 
492:       ! G_f = (-4*pi/vol)*q*sum_k((k/k2)*exp(-k2/4*alpha)*(sin(k*r)*sum_i(qi*cos(k*ri)) - cos(k*r)*sum_i(qi*sin(k*ri)))) 
493:       ! iterate over boxes and calculate repciprocal lattice vectors 
494:       do l = -newaldrecip(1), newaldrecip(1) 
495:          k(1) = 2*pi*l/boxlx 
496:          do m = -newaldrecip(2), newaldrecip(2) 
497:             k(2) = 2*pi*m/boxly 
498:             do n = -newaldrecip(3), newaldrecip(3) 
499:                k(3) = 2*pi*n/boxlz 
500:                ! check not in central box 
501:                if (.not.(l.eq.0.and.m.eq.0.and.n.eq.0)) then 
502:                   k2 = k(1)**2 + k(2)**2 + k(3)**2 
503:                   if (k2 < ewaldrecipc2) then 
504:                      ! calculate multiplicative factor 
505:                      mul = -4*pi*dexp(-k2/(4.0d0*ewaldalpha**2))/(vol*k2) 
506:                      rerho = rerhoarray(l+newaldrecip(1)+1, m+newaldrecip(2)+1, n+newaldrecip(3)+1) 
507:                      imrho = imrhoarray(l+newaldrecip(1)+1, m+newaldrecip(2)+1, n+newaldrecip(3)+1) 
508:                      ! iterate over atoms and calculate long-range gradient terms 
509:                      do j1 = 1,natoms 
510:                         j3 = 3*j1 
511:                         r(1) = x(j3-2) 
512:                         r(2) = x(j3-1) 
513:                         r(3) = x(j3) 
514:                         kdotr = k(1)*r(1) + k(2)*r(2) + k(3)*r(3) 
515:                         q1 = stchrg(j1) 
516:                         mul2 = mul*q1*(dsin(kdotr)*rerho - dcos(kdotr)*imrho) 
517:                         g(j3-2) = g(j3-2) + mul2*k(1) 
518:                         g(j3-1) = g(j3-1) + mul2*k(2) 
519:                         g(j3)   = g(j3)   + mul2*k(3) 
520:                      enddo 
521:                   endif 
522:                endif 
523:             enddo 
524:          enddo 
525:       enddo 
526:  
527:       return 
528:       end subroutine 
529:  
530: end module 


r32452/genrigid.f90 2017-05-02 18:30:26.836501647 +0100 r32451/genrigid.f90 2017-05-02 18:30:30.368547576 +0100
512: 512: 
513: ! vr274 > lattice matrix and inverse513: ! vr274 > lattice matrix and inverse
514:   DOUBLE PRECISION MLATTICE(3,3), MLATTICEINV(3,3)514:   DOUBLE PRECISION MLATTICE(3,3), MLATTICEINV(3,3)
515:   INTEGER NLATTICECOORDS515:   INTEGER NLATTICECOORDS
516: 516: 
517: ! hk286 - extra variables for minpermdist517: ! hk286 - extra variables for minpermdist
518:   DOUBLE PRECISION :: D, DIST2, RMAT(3,3) 518:   DOUBLE PRECISION :: D, DIST2, RMAT(3,3) 
519:   DOUBLE PRECISION :: PP1(3*NATOMS), PP2(3*NATOMS)519:   DOUBLE PRECISION :: PP1(3*NATOMS), PP2(3*NATOMS)
520:   LOGICAL :: TEMPPERMDIST520:   LOGICAL :: TEMPPERMDIST
521: 521: 
522:   !print *, 'transforming to rigid' 
523:   !print *, 'xcoords received: ', xcoords(:3*natoms) 
524:  
525: ! vr274 > if has lattice coordinates, setup matrices522: ! vr274 > if has lattice coordinates, setup matrices
526:   IF(HAS_LATTICE_COORDS) THEN523:   IF(HAS_LATTICE_COORDS) THEN
527:     NLATTICECOORDS=6524:     NLATTICECOORDS=6
528:     CALL GET_LATTICE_MATRIX(XCOORDS(3*NATOMS-5:3*NATOMS),MLATTICE)525:     CALL GET_LATTICE_MATRIX(XCOORDS(3*NATOMS-5:3*NATOMS),MLATTICE)
529:   ELSE526:   ELSE
530:     NLATTICECOORDS=0527:     NLATTICECOORDS=0
531:     MLATTICE=0528:     MLATTICE=0
532:     MLATTICE(1,1)=1529:     MLATTICE(1,1)=1
533:     MLATTICE(2,2)=1530:     MLATTICE(2,2)=1
534:     MLATTICE(3,3)=1531:     MLATTICE(3,3)=1
554:         PP2(3*J2-2:3*J2) = SITESRIGIDBODY(J2,:,J1)551:         PP2(3*J2-2:3*J2) = SITESRIGIDBODY(J2,:,J1)
555:      ENDDO552:      ENDDO
556:      TEMPPERMDIST = PERMDIST553:      TEMPPERMDIST = PERMDIST
557:      PERMDIST = .FALSE.554:      PERMDIST = .FALSE.
558:      CALL MINPERMDIST(PP1(1:3*NSITEPERBODY(J1)),PP2(1:3*NSITEPERBODY(J1)),NSITEPERBODY(J1),.FALSE., &555:      CALL MINPERMDIST(PP1(1:3*NSITEPERBODY(J1)),PP2(1:3*NSITEPERBODY(J1)),NSITEPERBODY(J1),.FALSE., &
559:           1.0D0,1.0D0,1.0D0,.FALSE.,.FALSE.,D,DIST2,.FALSE.,RMAT)556:           1.0D0,1.0D0,1.0D0,.FALSE.,.FALSE.,D,DIST2,.FALSE.,RMAT)
560:      PERMDIST = TEMPPERMDIST557:      PERMDIST = TEMPPERMDIST
561:      XRIGIDCOORDS(3*NRIGIDBODY+3*J1-2:3*NRIGIDBODY+3*J1) = rot_mx2aa(RMAT)558:      XRIGIDCOORDS(3*NRIGIDBODY+3*J1-2:3*NRIGIDBODY+3*J1) = rot_mx2aa(RMAT)
562: 559: 
563:      IF ( D/NSITEPERBODY(J1) > 0.1D0 ) THEN560:      IF ( D/NSITEPERBODY(J1) > 0.1D0 ) THEN
564:         !print *, 'not going so well...' 
565:         WRITE(MYUNIT, '(A, I3)')  'Warning: Genrigid > mapping looks bad for RB no ', J1 561:         WRITE(MYUNIT, '(A, I3)')  'Warning: Genrigid > mapping looks bad for RB no ', J1 
566:         WRITE(MYUNIT, '(A)')  'Warning: Genrigid >  Often it is the permutation of the RB members, e.g. Hs in NH3'562:         WRITE(MYUNIT, '(A)')  'Warning: Genrigid >  Often it is the permutation of the RB members, e.g. Hs in NH3'
567:      ENDIF563:      ENDIF
568: 564: 
569:   ENDDO565:   ENDDO
570: 566: 
571: ! vr274> now translate everything to reduced units567: ! vr274> now translate everything to reduced units
572:   DO J1 = 1, NRIGIDBODY568:   DO J1 = 1, NRIGIDBODY
573:     XRIGIDCOORDS(3*J1-2:3*J1) = MATMUL(MLATTICEINV, XRIGIDCOORDS(3*J1-2:3*J1))569:     XRIGIDCOORDS(3*J1-2:3*J1) = MATMUL(MLATTICEINV, XRIGIDCOORDS(3*J1-2:3*J1))
574:   END DO570:   END DO
579:         J9 = RIGIDSINGLES(J1)575:         J9 = RIGIDSINGLES(J1)
580:         ! vr274 > added lattice stuff576:         ! vr274 > added lattice stuff
581:         XRIGIDCOORDS(6*NRIGIDBODY + 3*J1-2:6*NRIGIDBODY + 3*J1) = MATMUL(MLATTICEINV, XCOORDS(3*J9-2:3*J9))577:         XRIGIDCOORDS(6*NRIGIDBODY + 3*J1-2:6*NRIGIDBODY + 3*J1) = MATMUL(MLATTICEINV, XCOORDS(3*J9-2:3*J9))
582:      ENDDO578:      ENDDO
583:   ENDIF579:   ENDIF
584: 580: 
585: ! vr274 > copy lattice coords581: ! vr274 > copy lattice coords
586:   IF(HAS_LATTICE_COORDS) THEN582:   IF(HAS_LATTICE_COORDS) THEN
587:     XRIGIDCOORDS(DEGFREEDOMS - 5:DEGFREEDOMS) =  XCOORDS(3*NATOMS-5:3*NATOMS)583:     XRIGIDCOORDS(DEGFREEDOMS - 5:DEGFREEDOMS) =  XCOORDS(3*NATOMS-5:3*NATOMS)
588:   ENDIF584:   ENDIF
589:  
590:   !print *, 'after being transformed:' 
591:   !print *, xrigidcoords(:3*natoms) 
592:  
593: END SUBROUTINE TRANSFORMCTORIGID585: END SUBROUTINE TRANSFORMCTORIGID
594: 586: 
595: !-----------------------------------------------------------587: !-----------------------------------------------------------
596: 588: 
597: SUBROUTINE TRANSFORMCTORIGID_OLD (XCOORDS, XRIGIDCOORDS)589: SUBROUTINE TRANSFORMCTORIGID_OLD (XCOORDS, XRIGIDCOORDS)
598: 590: 
599:   USE COMMONS, ONLY: NATOMS591:   USE COMMONS, ONLY: NATOMS
600:   USE VEC3592:   USE VEC3
601:   IMPLICIT NONE593:   IMPLICIT NONE
602: 594: 
968:   960:   
969:   USE COMMONS, ONLY: NATOMS961:   USE COMMONS, ONLY: NATOMS
970:   IMPLICIT NONE962:   IMPLICIT NONE
971:   963:   
972:   INTEGER          :: J1, J2, J9964:   INTEGER          :: J1, J2, J9
973:   DOUBLE PRECISION :: G(3*NATOMS), XR(DEGFREEDOMS), GR(DEGFREEDOMS)965:   DOUBLE PRECISION :: G(3*NATOMS), XR(DEGFREEDOMS), GR(DEGFREEDOMS)
974:   DOUBLE PRECISION :: PI(3)966:   DOUBLE PRECISION :: PI(3)
975:   DOUBLE PRECISION :: RMI(3,3), DRMI1(3,3), DRMI2(3,3), DRMI3(3,3)967:   DOUBLE PRECISION :: RMI(3,3), DRMI1(3,3), DRMI2(3,3), DRMI3(3,3)
976:   DOUBLE PRECISION :: TORQUE(3)968:   DOUBLE PRECISION :: TORQUE(3)
977:   DOUBLE PRECISION :: RMI0(3,3), DRMI10(3,3), DRMI20(3,3), DRMI30(3,3)969:   DOUBLE PRECISION :: RMI0(3,3), DRMI10(3,3), DRMI20(3,3), DRMI30(3,3)
978:   DOUBLE PRECISION :: DR1(3),DR2(3),DR3(3), RMI3(3,3)970:   DOUBLE PRECISION :: DR1(3),DR2(3),DR3(3), RMI3(3,3), RMS 
979:   double precision, intent(out) :: RMS  
980:  
981:   !print *, 'here in aaconv' 
982: 971: 
983:   RMS = 0.0D0972:   RMS = 0.0D0
984:   PI = (/0.0D0, 0.0D0, 0.0D0/)973:   PI = (/0.0D0, 0.0D0, 0.0D0/)
985:   CALL RMDRVT(PI, RMI0, DRMI10, DRMI20, DRMI30, .TRUE.)974:   CALL RMDRVT(PI, RMI0, DRMI10, DRMI20, DRMI30, .TRUE.)
986: 975: 
987:   DO J1 = 1, NRIGIDBODY976:   DO J1 = 1, NRIGIDBODY
988:      977:      
989:      PI = XR(3*NRIGIDBODY+3*J1-2 : 3*NRIGIDBODY+3*J1)978:      PI = XR(3*NRIGIDBODY+3*J1-2 : 3*NRIGIDBODY+3*J1)
990:      CALL RMDRVT(PI, RMI, DRMI1, DRMI2, DRMI3, .FALSE.)979:      CALL RMDRVT(PI, RMI, DRMI1, DRMI2, DRMI3, .FALSE.)
991: 980: 
992:      TORQUE(:) = 0.0D0981:      TORQUE(:) = 0.0D0
993:      DO J2 = 1, NSITEPERBODY(J1)982:      DO J2 = 1, NSITEPERBODY(J1)
994:         J9 = RIGIDGROUPS(J2, J1)983:         J9 = RIGIDGROUPS(J2, J1)
995:         DR1(:) = MATMUL(DRMI10,MATMUL(RMI,SITESRIGIDBODY(J2,:,J1)))984:         DR1(:) = MATMUL(DRMI10,MATMUL(RMI,SITESRIGIDBODY(J2,:,J1)))
996:         DR2(:) = MATMUL(DRMI20,MATMUL(RMI,SITESRIGIDBODY(J2,:,J1)))985:         DR2(:) = MATMUL(DRMI20,MATMUL(RMI,SITESRIGIDBODY(J2,:,J1)))
997:         DR3(:) = MATMUL(DRMI30,MATMUL(RMI,SITESRIGIDBODY(J2,:,J1)))986:         DR3(:) = MATMUL(DRMI30,MATMUL(RMI,SITESRIGIDBODY(J2,:,J1)))
998:         TORQUE(1) = TORQUE(1) + DOT_PRODUCT(G(3*J9-2:3*J9),DR1(:))987:         TORQUE(1) = TORQUE(1) + DOT_PRODUCT(G(3*J9-2:3*J9),DR1(:))
999:         TORQUE(2) = TORQUE(2) + DOT_PRODUCT(G(3*J9-2:3*J9),DR2(:))988:         TORQUE(2) = TORQUE(2) + DOT_PRODUCT(G(3*J9-2:3*J9),DR2(:))
1000:         TORQUE(3) = TORQUE(3) + DOT_PRODUCT(G(3*J9-2:3*J9),DR3(:))989:         TORQUE(3) = TORQUE(3) + DOT_PRODUCT(G(3*J9-2:3*J9),DR3(:))
1001:      ENDDO990:      ENDDO
1002:      !print *, j1, 'torque1: ', torque(:3)  
1003:      TORQUE = MATMUL(TRANSPOSE(RMI), TORQUE)991:      TORQUE = MATMUL(TRANSPOSE(RMI), TORQUE)
1004:      !print *, j1, 'torque2: ', torque(:3) 
1005:      !print *, 'index: ', j1 
1006:      !print *, 'rmi: ', rmi(:3,:3) 
1007:      !print *, 'inertia: ', transpose(iinverse(j1,:3,:3)) 
1008:      RMS = RMS + DOT_PRODUCT(TORQUE, MATMUL(TRANSPOSE(IINVERSE(J1,:,:)),TORQUE))992:      RMS = RMS + DOT_PRODUCT(TORQUE, MATMUL(TRANSPOSE(IINVERSE(J1,:,:)),TORQUE))
1009:      !RMI3 = MATMUL( RMI, IINVERSE(J1,:,:))993: !     RMI3 = MATMUL( RMI, IINVERSE(J1,:,:))
1010:      !RMI3 = MATMUL( RMI3, TRANSPOSE(RMI) )994: !     RMI3 = MATMUL( RMI3, TRANSPOSE(RMI) )
1011:      !RMS = RMS + DOT_PRODUCT(TORQUE, MATMUL(TRANSPOSE(RMI3),TORQUE))995: !     RMS = RMS + DOT_PRODUCT(TORQUE, MATMUL(TRANSPOSE(RMI3),TORQUE))
1012:      RMS = RMS + 1.0D0/NSITEPERBODY(J1) * DOT_PRODUCT(GR(3*J1-2:3*J1),GR(3*J1-2:3*J1)) 996:      RMS = RMS + 1.0D0/NSITEPERBODY(J1) * DOT_PRODUCT(GR(3*J1-2:3*J1),GR(3*J1-2:3*J1)) 
1013:      !print *, 'j1: ', j1, 1.0d0/nsiteperbody(j1) 
1014:      !print *, 'grad: ', gr(3*j1-2:3*j1) 
1015:      !print *, 'dot product: ', dot_product(gr(3*j1-2:3*j1), gr(3*j1-2:3*j1)) 
1016:      !print *, 'rms: ', rms 
1017:   ENDDO997:   ENDDO
1018: 998: 
1019: !  IF (DEGFREEDOMS > 6 * NRIGIDBODY) THEN999:   IF (DEGFREEDOMS > 6 * NRIGIDBODY) THEN
1020: !     print *, 'help -- in the extra loop!'1000:      DO J1 = 1, (DEGFREEDOMS - 6*NRIGIDBODY)/3
1021: !     DO J1 = 1, (DEGFREEDOMS - 6*NRIGIDBODY)/31001:         RMS = RMS + DOT_PRODUCT(GR(6*NRIGIDBODY + 3*J1-2:6*NRIGIDBODY + 3*J1),GR(6*NRIGIDBODY + 3*J1-2:6*NRIGIDBODY + 3*J1))
1022: !        RMS = RMS + DOT_PRODUCT(GR(6*NRIGIDBODY + 3*J1-2:6*NRIGIDBODY + 3*J1),GR(6*NRIGIDBODY + 3*J1-2:6*NRIGIDBODY + 3*J1))1002:      ENDDO
1023: !     ENDDO1003:   ENDIF
1024: !  ENDIF 
1025: 1004: 
1026:   RMS=MAX(DSQRT(RMS/DEGFREEDOMS),1.0D-100)1005:   RMS=MAX(DSQRT(RMS/(3*NATOMS)),1.0D-100)
1027:   !print *, 'rms: ', rms 
1028: 1006: 
1029: END SUBROUTINE AACONVERGENCE1007: END SUBROUTINE AACONVERGENCE
1030: 1008: 
1031: ! ------------------------------------------------------------- 
1032: ! dj337: second AACONVERGENCE subroutine for systems that do not have the gradient 
1033: ! in Cartesian coordinates. 
1034:  
1035: subroutine aaconvergence2(xr, gr, rms) 
1036:  
1037:   implicit none 
1038:  
1039:   integer                       :: j1 
1040:   double precision, intent(in)  :: xr(degfreedoms), gr(degfreedoms) 
1041:   double precision              :: pi(3), rmi(3,3), drmi1(3,3), drmi2(3,3), drmi3(3,3) 
1042:   double precision              :: torque(3), mat1(3,3), mat2(3,3), mat3(3,3) 
1043:   double precision, intent(out) :: rms 
1044:  
1045:   rms = 0.0d0 
1046:   
1047:   ! iterate over rigid bodies  
1048:   do j1 = 1, nrigidbody 
1049:    
1050:      ! compute RMS contribution due to translational degrees of freedom 
1051:      rms = rms + 1.0d0/nsiteperbody(j1) * dot_product(gr(3*j1-2:3*j1), gr(3*j1-2:3*j1)) 
1052:    
1053:      ! compute RMS contribution due to rotational degrees of freedom 
1054:      ! convert AA gradient to instantaneous frame 
1055:      torque(:) = 0.0d0 
1056:      mat1(:,:) = 0.0d0; mat2(:,:) = 0.0d0; mat3(:,:) = 0.0d0 
1057:      pi = xr(3*nrigidbody+3*j1-2:3*nrigidbody+3*j1) 
1058:      call rmdrvt(pi, rmi, drmi1, drmi2, drmi3, .true.) 
1059:   
1060:      mat1 = matmul(drmi1, transpose(rmi)) 
1061:      !print *, 'mat1: ', mat(:3,:3) 
1062:      torque(1) = torque(1) + gr(3*nrigidbody+3*j1-2)*mat1(3,2) 
1063:      torque(2) = torque(2) + gr(3*nrigidbody+3*j1-2)*mat1(1,3) 
1064:      torque(3) = torque(3) + gr(3*nrigidbody+3*j1-2)*mat1(2,1) 
1065:    
1066:      mat2 = matmul(drmi2, transpose(rmi)) 
1067:      !print *, 'mat2: ', mat(:3,:3) 
1068:      torque(1) = torque(1) + gr(3*nrigidbody+3*j1-1)*mat2(3,2) 
1069:      torque(2) = torque(2) + gr(3*nrigidbody+3*j1-1)*mat2(1,3) 
1070:      torque(3) = torque(3) + gr(3*nrigidbody+3*j1-1)*mat2(2,1) 
1071:    
1072:      mat3 = matmul(drmi3, transpose(rmi)) 
1073:      !print *, 'mat3: ', mat(:3,:3) 
1074:      torque(1) = torque(1) + gr(3*nrigidbody+3*j1)*mat3(3,2) 
1075:      torque(2) = torque(2) + gr(3*nrigidbody+3*j1)*mat3(1,3) 
1076:      torque(3) = torque(3) + gr(3*nrigidbody+3*j1)*mat3(2,1) 
1077:  
1078:      !print *, 'index: ', j1 
1079:      !print *, 'rmi: ', rmi(:3,:3) 
1080:      !print *, 'inertia: ', iinverse(j1,:3,:3) 
1081:      torque = matmul(transpose(rmi), torque) 
1082:      !print *, j1, 'grad: ', gr(3*nrigidbody+3*j1-2:3*nrigidbody+3*j1) 
1083:      !print *, j1, 'torque: ', torque(:3)  
1084:      rms = rms + dot_product(torque, matmul(iinverse(j1, :, :), torque)) 
1085:    
1086:   enddo 
1087:    
1088:   rms = max(dsqrt(rms/(degfreedoms)), 1.0d-100) 
1089:  
1090: end subroutine aaconvergence2  
1091:  
1092: !--------------------------------------------------------------1009: !--------------------------------------------------------------
1093: 1010: 
1094: ! hk286 > Often we want to check if the atoms grouped in a rigid body has moved or not1011: ! hk286 > Often we want to check if the atoms grouped in a rigid body has moved or not
1095: ! hk286 > They should not if everything is done correctly1012: ! hk286 > They should not if everything is done correctly
1096: ! hk286 > REDEFINESITEST = .FALSE. then it prints to standard output1013: ! hk286 > REDEFINESITEST = .FALSE. then it prints to standard output
1097: ! hk286 > REDEFINESITEST = .TRUE. then regroup atoms, SITESRIGIDBODY rewritten1014: ! hk286 > REDEFINESITEST = .TRUE. then regroup atoms, SITESRIGIDBODY rewritten
1098: 1015: 
1099: SUBROUTINE CHECKSITES (REDEFINESITEST, COORDS)1016: SUBROUTINE CHECKSITES (REDEFINESITEST, COORDS)
1100:       1017:       
1101:   USE COMMONS, ONLY: NATOMS1018:   USE COMMONS, ONLY: NATOMS
1528: DOUBLE PRECISION :: RANDOMPHI, RANDOMTHETA, RANDOMPSI, ST, CT, SPH, CPH, SPS, CPS1445: DOUBLE PRECISION :: RANDOMPHI, RANDOMTHETA, RANDOMPSI, ST, CT, SPH, CPH, SPS, CPS
1529: DOUBLE PRECISION, INTENT(INOUT) :: XCOORDS(3*NATOMS)1446: DOUBLE PRECISION, INTENT(INOUT) :: XCOORDS(3*NATOMS)
1530: DOUBLE PRECISION, INTENT(IN) :: ROTATEFACTOR1447: DOUBLE PRECISION, INTENT(IN) :: ROTATEFACTOR
1531: 1448: 
1532: ROTATIONMATRIX(:,:) = 0.0D01449: ROTATIONMATRIX(:,:) = 0.0D0
1533: TOROTATE(:) = 0.0D01450: TOROTATE(:) = 0.0D0
1534: ! Define some constants1451: ! Define some constants
1535: PI=ATAN(1.0D0)*41452: PI=ATAN(1.0D0)*4
1536: TWOPI=2.0D0*PI1453: TWOPI=2.0D0*PI
1537: 1454: 
1538: !do j1 = 1, nrigidbody 
1539: !   do j2 = 1, nsiteperbody(j1) 
1540: !      j3 = rigidgroups(j2, j1) 
1541: !      print *, xcoords(3*j3-2:3*j3) 
1542: !   enddo 
1543: !enddo 
1544:  
1545: ! Loop over all rigid bodies1455: ! Loop over all rigid bodies
1546: DO J1 = 1, NRIGIDBODY1456: DO J1 = 1, NRIGIDBODY
1547:    IF (.NOT.FROZENRIGIDBODY(J1)) THEN1457:    IF (.NOT.FROZENRIGIDBODY(J1)) THEN
1548:       COM = 0.0D01458:       COM = 0.0D0
1549:       MASS = 0.0D01459:       MASS = 0.0D0
1550: 1460: 
1551: ! For each rigid body, calculate center of mass1461: ! For each rigid body, calculate center of mass
1552:       DO J2 = 1, NSITEPERBODY(J1)1462:       DO J2 = 1, NSITEPERBODY(J1)
1553:          J3 = RIGIDGROUPS(J2, J1)1463:          J3 = RIGIDGROUPS(J2, J1)
1554:          COM = COM + XCOORDS(3*J3-2:3*J3)*GR_WEIGHTS(RIGIDGROUPS(J2,J1))1464:          COM = COM + XCOORDS(3*J3-2:3*J3)*GR_WEIGHTS(RIGIDGROUPS(J2,J1))
1593:       ENDDO1503:       ENDDO
1594: 1504: 
1595: ! Translate the rigid body centre of mass back to its old position1505: ! Translate the rigid body centre of mass back to its old position
1596:       DO J2 = 1, NSITEPERBODY(J1)1506:       DO J2 = 1, NSITEPERBODY(J1)
1597:          J3 = RIGIDGROUPS(J2, J1)1507:          J3 = RIGIDGROUPS(J2, J1)
1598:          XCOORDS(3*J3-2:3*J3) = XCOORDS(3*J3-2:3*J3) + COM1508:          XCOORDS(3*J3-2:3*J3) = XCOORDS(3*J3-2:3*J3) + COM
1599:       ENDDO1509:       ENDDO
1600:    ENDIF1510:    ENDIF
1601: ENDDO1511: ENDDO
1602: 1512: 
1603: !do j1 = 1, nrigidbody 
1604: !   do j2 = 1, nsiteperbody(j1) 
1605: !      j3 = rigidgroups(j2, j1) 
1606: !      print *, xcoords(3*j3-2:3*j3) 
1607: !   enddo 
1608: !enddo 
1609:  
1610: END SUBROUTINE GENRIGID_ROTATE1513: END SUBROUTINE GENRIGID_ROTATE
1611: 1514: 
1612: ! mo361> random rotation move for rigid bodies1515: ! mo361> random rotation move for rigid bodies
1613: SUBROUTINE GENRIGID_TRANSLATE(XCOORDS, TRANSLATEFACTOR)1516: SUBROUTINE GENRIGID_TRANSLATE(XCOORDS, TRANSLATEFACTOR)
1614: 1517: 
1615: USE COMMONS, ONLY: NATOMS1518: USE COMMONS, ONLY: NATOMS
1616: IMPLICIT NONE1519: IMPLICIT NONE
1617: 1520: 
1618: INTEGER :: J1, J2, J3  1521: INTEGER :: J1, J2, J3  
1619: DOUBLE PRECISION DPRAND1522: DOUBLE PRECISION DPRAND
1620: DOUBLE PRECISION, INTENT(INOUT) :: XCOORDS(3*NATOMS)1523: DOUBLE PRECISION, INTENT(INOUT) :: XCOORDS(3*NATOMS) 
1621: DOUBLE PRECISION, INTENT(IN) :: TRANSLATEFACTOR1524: DOUBLE PRECISION, INTENT(IN) :: TRANSLATEFACTOR
1622: DOUBLE PRECISION:: TRANSLATEVECTOR(3),LENGTH1525: DOUBLE PRECISION:: TRANSLATEVECTOR(3),LENGTH
1623: 1526: 
1624: !print *, 'into translate: ' 
1625: !do j1 = 1, nrigidbody 
1626: !   do j2 = 1, nsiteperbody(j1) 
1627: !      j3 = rigidgroups(j2, j1) 
1628: !      print *, xcoords(3*j3-2:3*j3) 
1629: !   enddo 
1630: !enddo 
1631:  
1632: ! Loop over all rigid bodies1527: ! Loop over all rigid bodies
1633: DO J1 = 1, NRIGIDBODY1528: DO J1 = 1, NRIGIDBODY
1634:    IF (.NOT.FROZENRIGIDBODY(J1)) THEN1529:    IF (.NOT.FROZENRIGIDBODY(J1)) THEN
1635:       DO J2=1,31530:       DO J2=1,3
1636:          TRANSLATEVECTOR(J2)=2.0*(DPRAND()-0.5)*TRANSLATEFACTOR1531:          TRANSLATEVECTOR(J2)=2.0*(DPRAND()-0.5)*TRANSLATEFACTOR
1637:       ENDDO1532:       ENDDO
1638:       LENGTH = DSQRT(TRANSLATEVECTOR(1)**2+TRANSLATEVECTOR(3)**2+TRANSLATEVECTOR(3)**2)1533:       LENGTH = DSQRT(TRANSLATEVECTOR(1)**2+TRANSLATEVECTOR(3)**2+TRANSLATEVECTOR(3)**2)
1639:    1534:    
1640: ! Move the rigid body1535: ! Move the rigid body
1641:       DO J2 = 1, NSITEPERBODY(J1)1536:       DO J2 = 1, NSITEPERBODY(J1)
1642:          J3 = RIGIDGROUPS(J2, J1)1537:          J3 = RIGIDGROUPS(J2, J1)
1643:          XCOORDS(3*J3-2:3*J3) = XCOORDS(3*J3-2:3*J3) + TRANSLATEVECTOR1538:          XCOORDS(3*J3-2:3*J3) = XCOORDS(3*J3-2:3*J3) + TRANSLATEVECTOR
1644:       ENDDO1539:       ENDDO
1645:    ENDIF1540:    ENDIF
1646: ENDDO1541: ENDDO
1647: 1542: 
1648: !print *, 'translated!' 
1649: ! 
1650: !print *, 'out of translate: ' 
1651: !do j1 = 1, nrigidbody 
1652: !   do j2 = 1, nsiteperbody(j1) 
1653: !      j3 = rigidgroups(j2, j1) 
1654: !      print *, xcoords(3*j3-2:3*j3) 
1655: !   enddo 
1656: !enddo 
1657:  
1658: END SUBROUTINE GENRIGID_TRANSLATE1543: END SUBROUTINE GENRIGID_TRANSLATE
1659: 1544: 
1660: ! csw34> subroutine to update the reference coordinates for the rigid bodies using 1545: ! csw34> subroutine to update the reference coordinates for the rigid bodies using 
1661: ! the NATOMS coordinates in XCOORDS. Note that the rigid body coordinates are relative1546: ! the NATOMS coordinates in XCOORDS. Note that the rigid body coordinates are relative
1662: ! to the COM of each rigid body. 1547: ! to the COM of each rigid body. 
1663: SUBROUTINE GENRIGID_UPDATE_REFERENCE(XCOORDS)1548: SUBROUTINE GENRIGID_UPDATE_REFERENCE(XCOORDS)
1664:   USE COMMONS, ONLY: NATOMS1549:   USE COMMONS, ONLY: NATOMS
1665:   IMPLICIT NONE1550:   IMPLICIT NONE
1666:   INTEGER :: J1, J2, DUMMY1551:   INTEGER :: J1, J2, DUMMY
1667:   DOUBLE PRECISION, INTENT(IN) :: XCOORDS(3*NATOMS)1552:   DOUBLE PRECISION, INTENT(IN) :: XCOORDS(3*NATOMS)


r32452/isotropic_potentials.f90 2017-05-02 18:30:29.488536133 +0100 r32451/isotropic_potentials.f90 2017-05-02 18:30:32.832579617 +0100
270:     USE COMMONS, ONLY: NATOMS270:     USE COMMONS, ONLY: NATOMS
271: 271: 
272:     IMPLICIT NONE272:     IMPLICIT NONE
273: 273: 
274:     DOUBLE PRECISION, INTENT(IN)  :: X(3*NATOMS)          ! The full atomistic coordinate array274:     DOUBLE PRECISION, INTENT(IN)  :: X(3*NATOMS)          ! The full atomistic coordinate array
275:     INTEGER, INTENT(IN)           :: POTLIST(:,:)         ! An array containing the interaction partners for each atom275:     INTEGER, INTENT(IN)           :: POTLIST(:,:)         ! An array containing the interaction partners for each atom
276:     INTEGER, INTENT(IN)           :: N_ATOM_PARTNERS(:)   ! An array containing the number of interaction partners for each atom276:     INTEGER, INTENT(IN)           :: N_ATOM_PARTNERS(:)   ! An array containing the number of interaction partners for each atom
277:     DOUBLE PRECISION, INTENT(IN)  :: Q (:)                ! An array containing the atom charges277:     DOUBLE PRECISION, INTENT(IN)  :: Q (:)                ! An array containing the atom charges
278:     DOUBLE PRECISION, INTENT(IN)  :: POTSCALE             ! The energy unit for this potential, which multiplies E, G and Hess.278:     DOUBLE PRECISION, INTENT(IN)  :: POTSCALE             ! The energy unit for this potential, which multiplies E, G and Hess.
279:     DOUBLE PRECISION, INTENT(IN)  :: PARAMS(10)           ! Maximum number of parameters is hardcoded here279:     DOUBLE PRECISION, INTENT(IN)  :: PARAMS(10)           ! Maximum number of parameters is hardcoded here
280:     DOUBLE PRECISION, INTENT(INOUT) :: ENERGY               ! The energy of the configuration280:     DOUBLE PRECISION, INTENT(OUT) :: ENERGY               ! The energy of the configuration
281:     DOUBLE PRECISION, INTENT(INOUT) :: GRAD(3*NATOMS)       ! The energy gradient281:     DOUBLE PRECISION, INTENT(OUT) :: GRAD(3*NATOMS)       ! The energy gradient
282:     LOGICAL, INTENT(IN)           :: GTEST, STEST         ! Flags to specify whether the gradient should be calculated (GTEST) and282:     LOGICAL, INTENT(IN)           :: GTEST, STEST         ! Flags to specify whether the gradient should be calculated (GTEST) and
283:                                                           ! whether the Hessian should be calculated (STEST)283:                                                           ! whether the Hessian should be calculated (STEST)
284: 284: 
285:     ! Various powers of the distance between the atoms, and the atom radius285:     ! Various powers of the distance between the atoms, and the atom radius
286:     DOUBLE PRECISION :: R, R2(NATOMS,NATOMS), R3286:     DOUBLE PRECISION :: R, R2(NATOMS,NATOMS), R3
287:     DOUBLE PRECISION :: G(NATOMS,NATOMS), F(NATOMS,NATOMS)  ! G tensor and F tensor (see ISOTROPIC_GRAD and ISOTROPIC_HESSIAN, below)287:     DOUBLE PRECISION :: G(NATOMS,NATOMS), F(NATOMS,NATOMS)  ! G tensor and F tensor (see ISOTROPIC_GRAD and ISOTROPIC_HESSIAN, below)
288:     DOUBLE PRECISION :: TMP_ENERGY288:     DOUBLE PRECISION :: TMP_ENERGY
289:     INTEGER :: J1, J2, J3, J4, J5, J6289:     INTEGER :: J1, J2, J3, J4, J5, J6
290: 290: 
291:     TMP_ENERGY=0.0D0291:     TMP_ENERGY=0.0D0


r32452/keywords.f 2017-05-02 18:30:27.280507420 +0100 r32451/keywords.f 2017-05-02 18:30:30.816553402 +0100
 50: !     &                                 AMBER12_RESIDUES, 50: !     &                                 AMBER12_RESIDUES,
 51: !     &                                 POPULATE_ATOM_DATA 51: !     &                                 POPULATE_ATOM_DATA
 52:       USE CHIRALITY, ONLY : CIS_TRANS_TOL 52:       USE CHIRALITY, ONLY : CIS_TRANS_TOL
 53:       USE ISO_C_BINDING, ONLY: C_NULL_CHAR 53:       USE ISO_C_BINDING, ONLY: C_NULL_CHAR
 54:       USE PARSE_POT_PARAMS, ONLY : PARSE_MGUPTA_PARAMS, PARSE_MSC_PARAMS, 54:       USE PARSE_POT_PARAMS, ONLY : PARSE_MGUPTA_PARAMS, PARSE_MSC_PARAMS,
 55:      &     PARSE_MLJ_PARAMS 55:      &     PARSE_MLJ_PARAMS
 56:       USE ROTAMER, ONLY: ROTAMER_MOVET, ROTAMER_SCRIPT, ROTAMER_INIT 56:       USE ROTAMER, ONLY: ROTAMER_MOVET, ROTAMER_SCRIPT, ROTAMER_INIT
 57:       USE HINGE_MOVES, ONLY: HINGE_INITIALISE 57:       USE HINGE_MOVES, ONLY: HINGE_INITIALISE
 58:       USE MOLECULAR_DYNAMICS, ONLY : MDT, MD_TSTEP, MD_GAMMA, MD_NWAIT, MD_NFREQ, MD_NSTEPS 58:       USE MOLECULAR_DYNAMICS, ONLY : MDT, MD_TSTEP, MD_GAMMA, MD_NWAIT, MD_NFREQ, MD_NSTEPS
 59:       USE OPEP_INTERFACE_MOD, ONLY : OPEP_INIT 59:       USE OPEP_INTERFACE_MOD, ONLY : OPEP_INIT
 60:       USE EWALD 60: 
 61:        
 62:       IMPLICIT NONE 61:       IMPLICIT NONE
 63:  62: 
 64:       DOUBLE PRECISION, ALLOCATABLE :: MLPMEAN(:), MLQMEAN(:) 63:       DOUBLE PRECISION, ALLOCATABLE :: MLPMEAN(:), MLQMEAN(:)
 65:       INTEGER ITEM, NITEMS, LOC, LINE, NCR, NERROR, LAST, IX, J1, JP, NPCOUNT, NDUMMY, J2, J3 64:       INTEGER ITEM, NITEMS, LOC, LINE, NCR, NERROR, LAST, IX, J1, JP, NPCOUNT, NDUMMY, J2, J3
 66:       INTEGER DATA_UNIT, FUNIT 65:       INTEGER DATA_UNIT, FUNIT
 67:       INTEGER MOVABLEATOMINDEX 66:       INTEGER MOVABLEATOMINDEX
 68:       LOGICAL CAT, YESNO, PERMFILE, CONFILE 67:       LOGICAL CAT, YESNO, PERMFILE, CONFILE
 69:       COMMON /BUFINF/ ITEM, NITEMS, LOC(80), LINE, SKIPBL, CLEAR, NCR, 68:       COMMON /BUFINF/ ITEM, NITEMS, LOC(80), LINE, SKIPBL, CLEAR, NCR,
 70:      &                NERROR, ECHO, LAST, CAT 69:      &                NERROR, ECHO, LAST, CAT
 71:        DOUBLE PRECISION XX, ROH, ROM, WTHETA 70:        DOUBLE PRECISION XX, ROH, ROM, WTHETA
 92:       DOUBLE PRECISION, ALLOCATABLE :: CHX(:), CHY(:), CHZ(:), CHMASS(:) 91:       DOUBLE PRECISION, ALLOCATABLE :: CHX(:), CHY(:), CHZ(:), CHMASS(:)
 93:       CHARACTER(LEN=100) TOPFILE,PARFILE 92:       CHARACTER(LEN=100) TOPFILE,PARFILE
 94:       CHARACTER(LEN=20) UNSTRING 93:       CHARACTER(LEN=20) UNSTRING
 95:       DOUBLE PRECISION LJREPBB, LJATTBB, LJREPLL, LJATTLL, LJREPNN, LJATTNN, 94:       DOUBLE PRECISION LJREPBB, LJATTBB, LJREPLL, LJATTLL, LJREPNN, LJATTNN,
 96:      &                 HABLN, HBBLN, HCBLN, HDBLN, EABLN, EBBLN, ECBLN, EDBLN, TABLN, TBBLN, TCBLN, TDBLN 95:      &                 HABLN, HBBLN, HCBLN, HDBLN, EABLN, EBBLN, ECBLN, EDBLN, TABLN, TBBLN, TCBLN, TDBLN
 97:       DOUBLE PRECISION LJREPBL, LJATTBL, LJREPBN, LJATTBN, LJREPLN, LJATTLN 96:       DOUBLE PRECISION LJREPBL, LJATTBL, LJREPBN, LJATTBN, LJREPLN, LJATTLN
 98:  97: 
 99: !     DC430 > 98: !     DC430 >
100:       DOUBLE PRECISION :: LPL, LPR 99:       DOUBLE PRECISION :: LPL, LPR
101:       LOGICAL          :: RBSYMTEST     ! jdf43>100:       LOGICAL          :: RBSYMTEST     ! jdf43>
102:  
103:       DOUBLE PRECISION :: VOL ! dj337 
104: !101: !
105: !       sf344> added stuff102: !       sf344> added stuff
106: !103: !
107:       CHARACTER(LEN=10) check1104:       CHARACTER(LEN=10) check1
108:       CHARACTER(LEN=1) readswitch105:       CHARACTER(LEN=1) readswitch
109:       CHARACTER(LEN=4) J1CHAR106:       CHARACTER(LEN=4) J1CHAR
110:       CHARACTER(LEN=20) J2CHAR107:       CHARACTER(LEN=20) J2CHAR
111:       INTEGER iostatus, groupsize, groupatom,groupoffset,axis1,axis2,EOF108:       INTEGER iostatus, groupsize, groupatom,groupoffset,axis1,axis2,EOF
112:       INTEGER LUNIT, GETUNIT109:       INTEGER LUNIT, GETUNIT
113: 110: 
855:       MORSEDPT    = .FALSE.852:       MORSEDPT    = .FALSE.
856:       MSGBT       = .FALSE.853:       MSGBT       = .FALSE.
857:       MSTBINT     = .FALSE.854:       MSTBINT     = .FALSE.
858:       MSSTOCKT    = .FALSE.855:       MSSTOCKT    = .FALSE.
859:       MULTPAHAT   = .FALSE.856:       MULTPAHAT   = .FALSE.
860:       NCAPT       = .FALSE.857:       NCAPT       = .FALSE.
861:       NPAHT       = .FALSE.858:       NPAHT       = .FALSE.
862:       NTIPT       = .FALSE.859:       NTIPT       = .FALSE.
863:       NZERO=0                   ! jdf43>860:       NZERO=0                   ! jdf43>
864:       PAHAT       = .FALSE.861:       PAHAT       = .FALSE.
865:       PAHAGENRIGIDT = .FALSE.   ! dj337 
866:       PAPT        = .FALSE.862:       PAPT        = .FALSE.
867:       POLYT       = .FALSE.863:       POLYT       = .FALSE.
868:       PTSTSTT     = .FALSE.864:       PTSTSTT     = .FALSE.
869:       RBSYMT      = .FALSE.     ! jdf43>865:       RBSYMT      = .FALSE.     ! jdf43>
870:       SHIFTV=1.0D6              ! jdf43>866:       SHIFTV=1.0D6              ! jdf43>
871:       SANDBOXT    = .FALSE.867:       SANDBOXT    = .FALSE.
872:       SILANET     = .FALSE.868:       SILANET     = .FALSE.
873:       STOCKAAT    = .FALSE.869:       STOCKAAT    = .FALSE.
874:       TDHDT       = .FALSE.870:       TDHDT       = .FALSE.
875:       WATERDCT    = .FALSE.871:       WATERDCT    = .FALSE.
1035: 1031: 
1036:       RIGIDOPTIMROTAT = .FALSE.1032:       RIGIDOPTIMROTAT = .FALSE.
1037:       OPTIMROTAVALUES(:) = 0.0D01033:       OPTIMROTAVALUES(:) = 0.0D0
1038:       FREEZERIGIDBODYT = .FALSE.1034:       FREEZERIGIDBODYT = .FALSE.
1039: 1035: 
1040:       AACONVERGENCET = .FALSE.1036:       AACONVERGENCET = .FALSE.
1041: 1037: 
1042: ! sn402 > Multiple potential scheme1038: ! sn402 > Multiple potential scheme
1043:       MULTIPOTT = .FALSE.1039:       MULTIPOTT = .FALSE.
1044: 1040: 
1045: ! dj337: pahagenrigid for benz with Ewald 
1046:       BENZRIGIDEWALDT = .FALSE. 
1047:  
1048: ! dj337: Ewald summation 
1049:       ORTHO = .TRUE. 
1050:       EWALDT = .FALSE. 
1051:       EWALDN = 1 
1052:       EWALDREALC = 10.0D0 
1053:       EWALDRECIPC = 3.0D0 
1054:       RSPEED = 1.0D0 
1055:  
1056: !--------------------------------!1041: !--------------------------------!
1057: ! hk286 > Generalised Thomson    !1042: ! hk286 > Generalised Thomson    !
1058: !--------------------------------!1043: !--------------------------------!
1059:       GTHOMSONT = .FALSE.1044:       GTHOMSONT = .FALSE.
1060:       GTHOMPOT = 11045:       GTHOMPOT = 1
1061: 1046: 
1062: ! hk286 > Damped group moves1047: ! hk286 > Damped group moves
1063:       DAMPEDGMOVET = .FALSE.1048:       DAMPEDGMOVET = .FALSE.
1064:       DMOVEFREQ = 11049:       DMOVEFREQ = 1
1065: 1050: 
3562:          CALL READF(EFAC)3547:          CALL READF(EFAC)
3563:          IF (NITEMS.GT.2) CALL READF(EAMP)3548:          IF (NITEMS.GT.2) CALL READF(EAMP)
3564: 3549: 
3565: ! Commenting out this AMBER keyword that should be used only with PNM's hand-coded AMBER3550: ! Commenting out this AMBER keyword that should be used only with PNM's hand-coded AMBER
3566: !      ELSE IF (WORD.EQ.'FAKEWATER') THEN3551: !      ELSE IF (WORD.EQ.'FAKEWATER') THEN
3567: !         FAKEWATER=.TRUE.3552: !         FAKEWATER=.TRUE.
3568: !         WRITE (MYUNIT,'(A)') '**********************************************************'3553: !         WRITE (MYUNIT,'(A)') '**********************************************************'
3569: !         WRITE (MYUNIT,'(A)') '* DISTANCE DEPENDENT DIELECTRIC BEING USED - FAKE WATER! *'3554: !         WRITE (MYUNIT,'(A)') '* DISTANCE DEPENDENT DIELECTRIC BEING USED - FAKE WATER! *'
3570: !         WRITE (MYUNIT,'(A)') '**********************************************************'3555: !         WRITE (MYUNIT,'(A)') '**********************************************************'
3571: 3556: 
3572: ! ---------------------------------------------------------------------------------------- 
3573: ! dj337: pahagenrigid for benzene using Ewald summation 
3574:  
3575:       ELSE IF (WORD.EQ.'BENZRIGIDEWALD') THEN 
3576:  
3577:          IF (.NOT.PERIODIC) THEN 
3578:             WRITE(MYUNIT, '(A)') 'keyword> ERROR PERIODIC must be defined first in data file' 
3579:             STOP 
3580:          ENDIF 
3581:  
3582:          BENZRIGIDEWALDT = .TRUE. 
3583:  
3584:          IF (NITEMS.GT.1) CALL READF(EWALDREALC) 
3585:          IF (NITEMS.GT.2) CALL READF(EWALDRECIPC) 
3586:  
3587:          ! CALCULATE ALPHA = 5.6/L_MIN 
3588:          EWALDALPHA = 5.6D0/MINVAL(BOX3D) 
3589:  
3590:          ! SET NUMBER OF LATTICE AND RECIPROCAL LATTICE VECTORS 
3591:          NEWALDREAL(:) = 0 
3592:  
3593:          NEWALDRECIP(1) = FLOOR(EWALDRECIPC*BOXLX/(2*PI)) 
3594:          NEWALDRECIP(2) = FLOOR(EWALDRECIPC*BOXLY/(2*PI)) 
3595:          NEWALDRECIP(3) = FLOOR(EWALDRECIPC*BOXLZ/(2*PI)) 
3596:  
3597:          ! ALLOCATE ARRAYS FOR STRUCTURE FACTORS 
3598:          ALLOCATE(RERHOARRAY(2*NEWALDRECIP(1)+1, 2*NEWALDRECIP(2)+1, 2*NEWALDRECIP(3)+1)) 
3599:          ALLOCATE(IMRHOARRAY(2*NEWALDRECIP(1)+1, 2*NEWALDRECIP(2)+1, 2*NEWALDRECIP(3)+1)) 
3600:  
3601:          ! ALLOCATE BENZENE MOLECULE 
3602:          NRBSITES = 12 
3603:          ALLOCATE(SITE(NRBSITES,3)) 
3604:          ALLOCATE(RBSTLA(NRBSITES,3)) 
3605:          CALL DEFPAHARIGID() 
3606:          NCARBON = 6 
3607:  
3608: ! ---------------------------------------------------------------------------------------- 
3609:       ! dj337: Ewald summation 
3610:       ELSE IF (WORD.EQ.'EWALD') THEN 
3611:  
3612:          IF (.NOT.PERIODIC) THEN 
3613:             WRITE(MYUNIT, '(A)') 'keyword> ERROR PERIODIC must be defined before EWALD in data file' 
3614:             STOP 
3615:          ENDIF 
3616:  
3617:          EWALDT = .TRUE. 
3618:  
3619:          IF (NITEMS.GT.1) CALL READI(EWALDN) 
3620:          IF (NITEMS.GT.2) CALL READF(EWALDREALC) 
3621:          IF (NITEMS.GT.3) CALL READF(EWALDRECIPC) 
3622:          IF (NITEMS.GT.4) CALL READF(RSPEED) 
3623:  
3624:          !VOL = BOXLX*BOXLY*BOXLZ 
3625:          !CALL VOLUME(VOL) 
3626:          ! calculate alpha value 
3627: !         EWALDALPHA = 0.28D0 
3628:          !EWALDALPHA = (RSPEED*(PI**3)*NATOMS/(VOL**2))**(1.0D0/6.0D0) 
3629:  
3630:          ewaldalpha = 5.6d0/minval(box3d) 
3631:  
3632:          IF (ORTHO) THEN 
3633:             ! set number of lattice vectors 
3634:             NEWALDREAL(1) = FLOOR(EWALDREALC/BOXLX+0.5D0) 
3635:             NEWALDREAL(2) = FLOOR(EWALDREALC/BOXLY+0.5D0) 
3636:             NEWALDREAL(3) = FLOOR(EWALDREALC/BOXLZ+0.5D0) 
3637:  
3638:             ! set number of reciprocal lattice vectors 
3639:             NEWALDRECIP(1) = FLOOR(EWALDRECIPC*BOXLX/(2*PI)) 
3640:             NEWALDRECIP(2) = FLOOR(EWALDRECIPC*BOXLY/(2*PI)) 
3641:             NEWALDRECIP(3) = FLOOR(EWALDRECIPC*BOXLZ/(2*PI)) 
3642:          ELSE 
3643:             print *, 'Not yet implemented for non-orthorhombic boxes!' 
3644:             STOP 
3645:          ENDIF 
3646:  
3647:          print *, 'alpha: ', ewaldalpha 
3648:          print *, 'nreal: ', newaldreal(:3) 
3649:          print *, 'nrecip: ', newaldrecip(:3) 
3650:  
3651:          ALLOCATE(RERHOARRAY(2*NEWALDRECIP(1)+1, 2*NEWALDRECIP(2)+1, 2*NEWALDRECIP(3)+1)) 
3652:          ALLOCATE(IMRHOARRAY(2*NEWALDRECIP(1)+1, 2*NEWALDRECIP(2)+1, 2*NEWALDRECIP(3)+1)) 
3653:  
3654:          ALLOCATE(SITE(NRBSITES,3)) 
3655:          ALLOCATE(RBSTLA(NRBSITES,3)) 
3656:          ALLOCATE(STCHRG(NRBSITES)) 
3657:  
3658:          CALL DEFPAHARIGID() 
3659:          NCARBON = 6 
3660:          CALL DEFBENZENERIGID() 
3661:  
3662: ! ---------------------------------------------------------------------------------------- 
3663:  
3664:       ELSE IF (WORD.EQ.'FAL') THEN3557:       ELSE IF (WORD.EQ.'FAL') THEN
3665:          FAL=.TRUE.3558:          FAL=.TRUE.
3666: 3559: 
3667:       ELSE IF (WORD == 'FEBH') THEN3560:       ELSE IF (WORD == 'FEBH') THEN
3668:          CALL READF(FETEMP)3561:          CALL READF(FETEMP)
3669:          FEBHT = .TRUE.3562:          FEBHT = .TRUE.
3670:          FE_FILE_UNIT = GETUNIT()3563:          FE_FILE_UNIT = GETUNIT()
3671:          OPEN(UNIT = FE_FILE_UNIT, FILE = 'free_energy', STATUS = 'REPLACE')3564:          OPEN(UNIT = FE_FILE_UNIT, FILE = 'free_energy', STATUS = 'REPLACE')
3672:          WRITE(FE_FILE_UNIT, '(6A20)') '       Quench       ', '  Potential energy  ',3565:          WRITE(FE_FILE_UNIT, '(6A20)') '       Quench       ', '  Potential energy  ',
3673:      &   '   Harmonic term    ', '    Free energy     ', '   Markov energy    ', '        Time        '3566:      &   '   Harmonic term    ', '    Free energy     ', '   Markov energy    ', '        Time        '
6866:             CALL DEFNAPHTHALENE()6759:             CALL DEFNAPHTHALENE()
6867:          ELSEIF (PAHID == 3) THEN6760:          ELSEIF (PAHID == 3) THEN
6868:             NCARBON  = 146761:             NCARBON  = 14
6869:             CALL DEFANTHRACENE()6762:             CALL DEFANTHRACENE()
6870:          ELSEIF (PAHID == 4) THEN6763:          ELSEIF (PAHID == 4) THEN
6871:             NCARBON  = 166764:             NCARBON  = 16
6872:             CALL DEFPYRENE()6765:             CALL DEFPYRENE()
6873:          ENDIF6766:          ENDIF
6874: 6767: 
6875: !     ----------------------------------------------------------------------------------------------6768: !     ----------------------------------------------------------------------------------------------
6876: ! dj337: PAHA genrigid potential 
6877:  
6878:       ELSE IF (WORD .EQ. 'PAHAGENRIGID') THEN 
6879:  
6880:          CALL READI(PAHID) 
6881:  
6882:          IF (PAHID == 1) THEN 
6883:             NRBSITES = 12 
6884:          ENDIF 
6885:  
6886:          PAHAGENRIGIDT = .TRUE. 
6887:          ALLOCATE(SITE(NRBSITES,3)) 
6888:          ALLOCATE(RBSTLA(NRBSITES,3)) 
6889:          ALLOCATE(STCHRG(NRBSITES)) 
6890:  
6891:          CALL DEFPAHARIGID() 
6892:  
6893:          IF (PAHID == 1) THEN 
6894:             NCARBON = 6 
6895:             CALL DEFBENZENERIGID() 
6896:          ENDIF 
6897:  
6898: !     ---------------------------------------------------------------------------------------------- 
6899: 6769: 
6900:       ELSE IF (WORD .EQ. 'PAHW99') THEN6770:       ELSE IF (WORD .EQ. 'PAHW99') THEN
6901: 6771: 
6902:          CALL READI(PAHID)6772:          CALL READI(PAHID)
6903: 6773: 
6904:          IF (PAHID == 1) THEN6774:          IF (PAHID == 1) THEN
6905:             NRBSITES = 186775:             NRBSITES = 18
6906:          ENDIF6776:          ENDIF
6907: 6777: 
6908:          PAHW99T  = .TRUE.6778:          PAHW99T  = .TRUE.
7887:          STOP7757:          STOP
7888:       ENDIF7758:       ENDIF
7889:       CALL FLUSH(MYUNIT)7759:       CALL FLUSH(MYUNIT)
7890: 7760: 
7891: !ds656> NTYPEA can fluctuate in homotop refinemet routine, so we need7761: !ds656> NTYPEA can fluctuate in homotop refinemet routine, so we need
7892: !     a fixed reference. It is set here instead of every single7762: !     a fixed reference. It is set here instead of every single
7893: !     IF block where NTYPEA can potentially change.7763: !     IF block where NTYPEA can potentially change.
7894:       NTYPEA_FIX = NTYPEA7764:       NTYPEA_FIX = NTYPEA
7895: 7765: 
7896:       GOTO 1907766:       GOTO 190
 7767: 
7897:       RETURN7768:       RETURN
7898:       END7769:       END


r32452/ljpshift.f90 2017-05-02 18:30:27.500510281 +0100 r32451/ljpshift.f90 2017-05-02 18:30:31.040556315 +0100
 83:             DOUBLE PRECISION, INTENT(IN) :: R 83:             DOUBLE PRECISION, INTENT(IN) :: R
 84:             DOUBLE PRECISION VAL 84:             DOUBLE PRECISION VAL
 85:             VAL = 0.D0 !not implimented 85:             VAL = 0.D0 !not implimented
 86:          END FUNCTION DDVIJ 86:          END FUNCTION DDVIJ
 87:  87: 
 88:  88: 
 89:  89: 
 90:          SUBROUTINE GET_R2(X, J1, J2, R2, XVEC) 90:          SUBROUTINE GET_R2(X, J1, J2, R2, XVEC)
 91:             IMPLICIT NONE 91:             IMPLICIT NONE
 92:             DOUBLE PRECISION, INTENT(OUT) :: R2, XVEC(3) 92:             DOUBLE PRECISION, INTENT(OUT) :: R2, XVEC(3)
 93:             DOUBLE PRECISION, INTENT(IN) :: X(3*N) 93:             DOUBLE PRECISION, INTENT(IN) :: X(N)
 94:             INTEGER, INTENT(IN) :: J1, J2 94:             INTEGER, INTENT(IN) :: J1, J2
 95:             INTEGER J3, J4 95:             INTEGER J3, J4
 96:             !print *, 'in get_r2' 
 97:             J3=3*(J1-1) 96:             J3=3*(J1-1)
 98:             J4=3*(J2-1) 97:             J4=3*(J2-1)
 99:             !print *, 'j1: ', j1, 'j3: ', j3 
100:             !print *, 'j2: ', j2, 'j4: ', j4 
101:             !calculate atom separation 98:             !calculate atom separation
102:             !print *, 'x1: ', x(j3+1:j3+3) 
103:             !print *, 'x2: ', x(j4+1:j4+3) 
104:             XVEC(:) = X(J3+1:J3+3) - X(J4+1:J4+3) 99:             XVEC(:) = X(J3+1:J3+3) - X(J4+1:J4+3)
105:             !print *, 'xvec: ', xvec(:3) 
106:             XVEC(:) = XVEC(:) - BOXLVEC(:) * NINT(XVEC(:)*IBOXLVEC(:))100:             XVEC(:) = XVEC(:) - BOXLVEC(:) * NINT(XVEC(:)*IBOXLVEC(:))
107:             !print *, 'xvec mic: ', xvec(:3) 
108:             R2 = sum(XVEC**2)101:             R2 = sum(XVEC**2)
109:             !print *, 'r2: ', r2 
110: 102: 
111:             !XVEC(:) = X(3*(J1-1)+1:3*(J1-1)+3) - X(3*(J2-1)+1:3*(J2-1)+3)103:             !XVEC(:) = X(3*(J1-1)+1:3*(J1-1)+3) - X(3*(J2-1)+1:3*(J2-1)+3)
112:             !R2 = sum(XVEC**2)104:             !R2 = sum(XVEC**2)
113:             !IF (R2 .GE. BOXLMIN_HALF_2) THEN105:             !IF (R2 .GE. BOXLMIN_HALF_2) THEN
114:                !XVEC(:) = XVEC(:) - BOXLVEC(:) * NINT(XVEC(:)*IBOXLVEC(:))106:                !XVEC(:) = XVEC(:) - BOXLVEC(:) * NINT(XVEC(:)*IBOXLVEC(:))
115:                !R2 = SUM(XVEC**2)107:                !R2 = SUM(XVEC**2)
116:             !ENDIF108:             !ENDIF
117:          END SUBROUTINE GET_R2109:          END SUBROUTINE GET_R2
118: 110: 
119:          SUBROUTINE UPDATE_POTENTIAL( X, J1, J2, POTEL, T )111:          SUBROUTINE UPDATE_POTENTIAL( X, J1, J2, POTEL, T )
173:                E = VIJ(R2, IR6, T)165:                E = VIJ(R2, IR6, T)
174:                !E = T%EPS*(T%SIG6*IR6*(T%SIG6*IR6-1.0D0) + T%RCONST/IR2 + T%CONST)166:                !E = T%EPS*(T%SIG6*IR6*(T%SIG6*IR6-1.0D0) + T%RCONST/IR2 + T%CONST)
175:                POTEL = POTEL + E167:                POTEL = POTEL + E
176:             ENDIF168:             ENDIF
177:          END SUBROUTINE UPDATE_POTENTIAL_offset169:          END SUBROUTINE UPDATE_POTENTIAL_offset
178: 170: 
179:          SUBROUTINE UPDATE_POTENTIAL_GRADIENT( X, J1, J2, POTEL, V, T )171:          SUBROUTINE UPDATE_POTENTIAL_GRADIENT( X, J1, J2, POTEL, V, T )
180:             IMPLICIT NONE172:             IMPLICIT NONE
181:             TYPE(INTERACTION_DEF), INTENT(IN) ::  T173:             TYPE(INTERACTION_DEF), INTENT(IN) ::  T
182:             DOUBLE PRECISION, INTENT(IN) :: X(3*N)174:             DOUBLE PRECISION, INTENT(IN) :: X(3*N)
183:             DOUBLE PRECISION, INTENT(INOUT) :: POTEL, V(3*N)175:             DOUBLE PRECISION, INTENT(OUT) :: POTEL, V(3*N)
184:             INTEGER, INTENT(IN) :: J1, J2176:             INTEGER, INTENT(IN) :: J1, J2
185:             DOUBLE PRECISION R2, E, XVEC(3), G, IR2, IR6, IR8, IR14177:             DOUBLE PRECISION R2, E, XVEC(3), G, IR2, IR6, IR8, IR14
186:             INTEGER J5178:             INTEGER J5
187:  
188:             !print *, 'line 180' 
189:             CALL GET_R2(X, J1, J2, R2, XVEC)179:             CALL GET_R2(X, J1, J2, R2, XVEC)
190:             !print *, 'line 182' 
191:             !print *, 'r2: ', r2 
192:             IR2 = 1.D0/R2180:             IR2 = 1.D0/R2
193:             !print *, 'line 184' 
194:             IF (IR2.GT.T%IRCUT2) THEN181:             IF (IR2.GT.T%IRCUT2) THEN
195:                !print *, 'line 186' 
196:                !update potential182:                !update potential
197:                IR6=IR2**3183:                IR6=IR2**3
198:                E = VIJ(R2, IR6, T)184:                E = VIJ(R2, IR6, T)
199:                !print *, 'e: ', e 
200:                !print *, 'line 190' 
201:                !E = T%EPS*(T%SIG6*IR6*(T%SIG6*IR6-1.0D0) + T%RCONST/IR2 + T%CONST)185:                !E = T%EPS*(T%SIG6*IR6*(T%SIG6*IR6-1.0D0) + T%RCONST/IR2 + T%CONST)
202:                POTEL = POTEL + E186:                POTEL = POTEL + E
203:                !update gradient187:                !update gradient
204:                !print *, 'line 194' 
205:                IR8=IR6*IR2188:                IR8=IR6*IR2
206:                IR14=IR8*IR6189:                IR14=IR8*IR6
207:                G = DVIJ(IR8, IR14, T)190:                G = DVIJ(IR8, IR14, T)
208:                !print *, 'g: ', g 
209:                !print *, 'line 198' 
210:                !G = -8.0D0*T%EPS*(3.0D0*(2.0D0*IR14*(T%SIG12)-IR8*T%SIG6)-T%RCONST)191:                !G = -8.0D0*T%EPS*(3.0D0*(2.0D0*IR14*(T%SIG12)-IR8*T%SIG6)-T%RCONST)
211:                DO J5=1,3192:                DO J5=1,3
212:                   !print *, 'line 201' 
213:                   V(3*(J1-1)+J5)=V(3*(J1-1)+J5)+G*XVEC(J5)193:                   V(3*(J1-1)+J5)=V(3*(J1-1)+J5)+G*XVEC(J5)
214:                   V(3*(J2-1)+J5)=V(3*(J2-1)+J5)-G*XVEC(J5)194:                   V(3*(J2-1)+J5)=V(3*(J2-1)+J5)-G*XVEC(J5)
215:                END DO195:                END DO
216:                !print *, 'line 205' 
217:             ENDIF196:             ENDIF
218:             !print *, '207' 
219:          END SUBROUTINE UPDATE_POTENTIAL_GRADIENT197:          END SUBROUTINE UPDATE_POTENTIAL_GRADIENT
220: 198: 
221:          SUBROUTINE SET_INTERACTION_DEF( T, EPS, SIG, RC )199:          SUBROUTINE SET_INTERACTION_DEF( T, EPS, SIG, RC )
222:             IMPLICIT NONE200:             IMPLICIT NONE
223:             !careful, with INTENT(OUT) here, any element of T not assigned in this subroutine could become undefined201:             !careful, with INTENT(OUT) here, any element of T not assigned in this subroutine could become undefined
224:             TYPE(INTERACTION_DEF), INTENT(OUT) ::  T202:             TYPE(INTERACTION_DEF), INTENT(OUT) ::  T
225:             DOUBLE PRECISION, INTENT(IN) ::  eps, SIG, RC203:             DOUBLE PRECISION, INTENT(IN) ::  eps, SIG, RC
226:             DOUBLE PRECISION SIGRC6, SIGRC12204:             DOUBLE PRECISION SIGRC6, SIGRC12
227:             T%EPS = EPS205:             T%EPS = EPS
228:             T%SIG = SIG206:             T%SIG = SIG
250:             CUTAB = AB%RCUT228:             CUTAB = AB%RCUT
251:          END SUBROUTINE LJPSHIFT_GET_CUT229:          END SUBROUTINE LJPSHIFT_GET_CUT
252: 230: 
253:          SUBROUTINE LJPSHIFT_CLASS_SETUP(CUTOFF, EPSAA, EPSBB, EPSAB, SIGAA, SIGBB, SIGAB, NATOMS, BOXLX_I, BOXLY_I, BOXLZ_I)231:          SUBROUTINE LJPSHIFT_CLASS_SETUP(CUTOFF, EPSAA, EPSBB, EPSAB, SIGAA, SIGBB, SIGAB, NATOMS, BOXLX_I, BOXLY_I, BOXLZ_I)
254:             IMPLICIT NONE232:             IMPLICIT NONE
255:             DOUBLE PRECISION, INTENT(IN) :: CUTOFF, EPSAA, EPSBB, EPSAB, SIGAA, SIGBB, SIGAB233:             DOUBLE PRECISION, INTENT(IN) :: CUTOFF, EPSAA, EPSBB, EPSAB, SIGAA, SIGBB, SIGAB
256:             DOUBLE PRECISION, INTENT(IN) :: BOXLX_I, BOXLY_I, BOXLZ_I234:             DOUBLE PRECISION, INTENT(IN) :: BOXLX_I, BOXLY_I, BOXLZ_I
257:             LOGICAL :: FIRST_THROUGH = .TRUE. !will be defined as .TRUE. on first initialization, but will retain value on subsequent calls235:             LOGICAL :: FIRST_THROUGH = .TRUE. !will be defined as .TRUE. on first initialization, but will retain value on subsequent calls
258:             INTEGER, INTENT(IN) :: NATOMS236:             INTEGER, INTENT(IN) :: NATOMS
259: 237: 
260:             !print *, 'line 238' 
261:             !print *, 'cutoff: ', cutoff 
262:             !print *, 'eps: ', epsaa, epsbb, epsab 
263:             !print *, 'sig: ', sigaa, sigbb, sigab 
264:             !print *, 'natoms: ', natoms 
265:             !print *, 'boxlengths: ', boxlx_i, boxly_i, boxlz_i 
266:  
267:             IF ( .NOT. FIRST_THROUGH ) RETURN238:             IF ( .NOT. FIRST_THROUGH ) RETURN
268:             FIRST_THROUGH = .FALSE.239:             FIRST_THROUGH = .FALSE.
269: 240: 
270:             !print *, 'line 243' 
271:  
272:             N = NATOMS241:             N = NATOMS
273:             BOXLX = BOXLX_I242:             BOXLX = BOXLX_I
274:             BOXLY = BOXLY_I243:             BOXLY = BOXLY_I
275:             BOXLZ = BOXLZ_I244:             BOXLZ = BOXLZ_I
276:             IBOXLX = 1.d0/BOXLX_I245:             IBOXLX = 1.d0/BOXLX_I
277:             IBOXLY = 1.d0/BOXLY_I246:             IBOXLY = 1.d0/BOXLY_I
278:             IBOXLZ = 1.d0/BOXLZ_I247:             IBOXLZ = 1.d0/BOXLZ_I
279:             BOXLVEC(1) = BOXLX248:             BOXLVEC(1) = BOXLX
280:             BOXLVEC(2) = BOXLY249:             BOXLVEC(2) = BOXLY
281:             BOXLVEC(3) = BOXLZ250:             BOXLVEC(3) = BOXLZ
282:             IBOXLVEC(:) = 1.d0 / BOXLVEC(:)251:             IBOXLVEC(:) = 1.d0 / BOXLVEC(:)
283:             BOXLMIN_HALF_2 = (MINVAL(BOXLVEC)/2.D0)**2252:             BOXLMIN_HALF_2 = (MINVAL(BOXLVEC)/2.D0)**2
284: 253: 
285:             !print *, 'line 258' 
286:  
287:             !print *, 'aa: ', AA 
288:             !print *, 'bb: ', BB 
289:             !print *, 'ab: ', ab 
290:  
291:             CALL SET_INTERACTION_DEF(AA, EPSAA, SIGAA, CUTOFF)254:             CALL SET_INTERACTION_DEF(AA, EPSAA, SIGAA, CUTOFF)
292:             !print *, 'line 261' 
293:             CALL SET_INTERACTION_DEF(BB, EPSBB, SIGBB, CUTOFF)255:             CALL SET_INTERACTION_DEF(BB, EPSBB, SIGBB, CUTOFF)
294:             !print *, 'line 263' 
295:             CALL SET_INTERACTION_DEF(AB, EPSAB, SIGAB, CUTOFF)256:             CALL SET_INTERACTION_DEF(AB, EPSAB, SIGAB, CUTOFF)
296: 257: 
297:             !print *, 'line 264' 
298:  
299:          END SUBROUTINE LJPSHIFT_CLASS_SETUP258:          END SUBROUTINE LJPSHIFT_CLASS_SETUP
300: 259: 
301:          !3 subroutines for calculating the potentials260:          !3 subroutines for calculating the potentials
302:          SUBROUTINE LJPSHIFT_UPDATE_E_AA( X, J1, J2, POTEL )261:          SUBROUTINE LJPSHIFT_UPDATE_E_AA( X, J1, J2, POTEL )
303:             IMPLICIT NONE262:             IMPLICIT NONE
304:             DOUBLE PRECISION, INTENT(IN) :: X(3*N)263:             DOUBLE PRECISION, INTENT(IN) :: X(3*N)
305:             DOUBLE PRECISION, INTENT(OUT) :: POTEL264:             DOUBLE PRECISION, INTENT(OUT) :: POTEL
306:             INTEGER, INTENT(IN) :: J1, J2265:             INTEGER, INTENT(IN) :: J1, J2
307:             CALL UPDATE_POTENTIAL(X, J1, J2, POTEL, AA)266:             CALL UPDATE_POTENTIAL(X, J1, J2, POTEL, AA)
308:          END SUBROUTINE LJPSHIFT_UPDATE_E_AA267:          END SUBROUTINE LJPSHIFT_UPDATE_E_AA
309:          !this module defines the potential LJPSHIFT! IMPLICIT NONE268:          SUBROUTINE LJPSHIFT_UPDATE_E_BB( X, J1, J2, POTEL )
310:          SUBROUTINE LJPSHIFT_UPDATE_E_BB( X, J1, J2, POTEL )  
311:             IMPLICIT NONE269:             IMPLICIT NONE
312:             DOUBLE PRECISION, INTENT(IN) :: X(3*N)270:             DOUBLE PRECISION, INTENT(IN) :: X(3*N)
313:             DOUBLE PRECISION, INTENT(OUT) :: POTEL271:             DOUBLE PRECISION, INTENT(OUT) :: POTEL
314:             INTEGER, INTENT(IN) :: J1, J2272:             INTEGER, INTENT(IN) :: J1, J2
315:             CALL UPDATE_POTENTIAL(X, J1, J2, POTEL, BB)273:             CALL UPDATE_POTENTIAL(X, J1, J2, POTEL, BB)
316:          END SUBROUTINE LJPSHIFT_UPDATE_E_BB274:          END SUBROUTINE LJPSHIFT_UPDATE_E_BB
317:          SUBROUTINE LJPSHIFT_UPDATE_E_AB( X, J1, J2, POTEL )275:          SUBROUTINE LJPSHIFT_UPDATE_E_AB( X, J1, J2, POTEL )
318:             IMPLICIT NONE276:             IMPLICIT NONE
319:             DOUBLE PRECISION, INTENT(IN) :: X(3*N)277:             DOUBLE PRECISION, INTENT(IN) :: X(3*N)
320:             DOUBLE PRECISION, INTENT(OUT) :: POTEL278:             DOUBLE PRECISION, INTENT(OUT) :: POTEL
321:             INTEGER, INTENT(IN) :: J1, J2279:             INTEGER, INTENT(IN) :: J1, J2
322:             CALL UPDATE_POTENTIAL(X, J1, J2, POTEL, AB)280:             CALL UPDATE_POTENTIAL(X, J1, J2, POTEL, AB)
323:          END SUBROUTINE LJPSHIFT_UPDATE_E_AB281:          END SUBROUTINE LJPSHIFT_UPDATE_E_AB
324: 282: 
325:          !3 subroutines for calculating the potential and gradients283:          !3 subroutines for calculating the potential and gradients
326:          SUBROUTINE LJPSHIFT_UPDATE_EG_AA( X, J1, J2, POTEL, V )284:          SUBROUTINE LJPSHIFT_UPDATE_EG_AA( X, J1, J2, POTEL, V )
327:             IMPLICIT NONE285:             IMPLICIT NONE
328:             DOUBLE PRECISION, INTENT(IN) :: X(3*N)286:             DOUBLE PRECISION, INTENT(IN) :: X(3*N)
329:             DOUBLE PRECISION, INTENT(INOUT) :: POTEL, V(3*N)287:             DOUBLE PRECISION, INTENT(OUT) :: POTEL, V(3*N)
330:             INTEGER, INTENT(IN) :: J1, J2288:             INTEGER, INTENT(IN) :: J1, J2
331:             !print *, 'line 304' 
332:             CALL UPDATE_POTENTIAL_GRADIENT(X, J1, J2, POTEL, V, AA)289:             CALL UPDATE_POTENTIAL_GRADIENT(X, J1, J2, POTEL, V, AA)
333:          END SUBROUTINE LJPSHIFT_UPDATE_EG_AA290:          END SUBROUTINE LJPSHIFT_UPDATE_EG_AA
334:          SUBROUTINE LJPSHIFT_UPDATE_EG_BB( X, J1, J2, POTEL, V )291:          SUBROUTINE LJPSHIFT_UPDATE_EG_BB( X, J1, J2, POTEL, V )
335:             IMPLICIT NONE292:             IMPLICIT NONE
336:             DOUBLE PRECISION, INTENT(IN) :: X(3*N)293:             DOUBLE PRECISION, INTENT(IN) :: X(3*N)
337:             DOUBLE PRECISION, INTENT(OUT) :: POTEL, V(3*N)294:             DOUBLE PRECISION, INTENT(OUT) :: POTEL, V(3*N)
338:             INTEGER, INTENT(IN) :: J1, J2295:             INTEGER, INTENT(IN) :: J1, J2
339:             CALL UPDATE_POTENTIAL_GRADIENT(X, J1, J2, POTEL, V, BB)296:             CALL UPDATE_POTENTIAL_GRADIENT(X, J1, J2, POTEL, V, BB)
340:          END SUBROUTINE LJPSHIFT_UPDATE_EG_BB297:          END SUBROUTINE LJPSHIFT_UPDATE_EG_BB
341:          SUBROUTINE LJPSHIFT_UPDATE_EG_AB( X, J1, J2, POTEL, V )298:          SUBROUTINE LJPSHIFT_UPDATE_EG_AB( X, J1, J2, POTEL, V )
479: 436: 
480:       SUBROUTINE LJPSHIFT(X, V, POTEL, GTEST, STEST)437:       SUBROUTINE LJPSHIFT(X, V, POTEL, GTEST, STEST)
481:       !This subroutine calculates the binary lennard jones potential with cutoff438:       !This subroutine calculates the binary lennard jones potential with cutoff
482:       !439:       !
483:       !This is essentially a wrapper function.  The actual work is done in one440:       !This is essentially a wrapper function.  The actual work is done in one
484:       !of the other LJPSHIFT subroutines441:       !of the other LJPSHIFT subroutines
485:       !442:       !
486:       USE COMMONS, ONLY : NATOMS, CUTOFF, FIXIMAGE, NORESET, BOXLX, BOXLY, BOXLZ, &443:       USE COMMONS, ONLY : NATOMS, CUTOFF, FIXIMAGE, NORESET, BOXLX, BOXLY, BOXLZ, &
487:      &    FREEZE, RESTRICTREGION, EPSAB, EPSBB, SIGAB, SIGBB, NTYPEA, &444:      &    FREEZE, RESTRICTREGION, EPSAB, EPSBB, SIGAB, SIGBB, NTYPEA, &
488:      &    ONE_ATOM_TAKESTEP445:      &    ONE_ATOM_TAKESTEP
489:       use genrigid, only: atomrigidcoordt, nrigidbody, transformrigidtoc, transformctorigid 
490:       USE LJPSHIFT_CLASS446:       USE LJPSHIFT_CLASS
491:       USE FREEZE_NL_MOD447:       USE FREEZE_NL_MOD
492:       USE NEIGHBOR_LIST_MOD448:       USE NEIGHBOR_LIST_MOD
493:       USE BIN_NL_MOD449:       USE BIN_NL_MOD
494:       USE CELL_LISTS_BINARY_MOD450:       USE CELL_LISTS_BINARY_MOD
495:       IMPLICIT NONE451:       IMPLICIT NONE
496:       INTEGER J1, J2452:       INTEGER J1, J2
497:       DOUBLE PRECISION, INTENT(INOUT) :: X(3*NATOMS) 453:       DOUBLE PRECISION, INTENT(INOUT) :: X(3*NATOMS) 
498:       DOUBLE PRECISION, INTENT(OUT) :: V(3*NATOMS), POTEL 454:       DOUBLE PRECISION, INTENT(OUT) :: V(3*NATOMS), POTEL 
499:       LOGICAL, INTENT(IN) :: GTEST, STEST455:       LOGICAL, INTENT(IN) :: GTEST, STEST
500:       LOGICAL IL_CHANGED456:       LOGICAL IL_CHANGED
501:       LOGICAL, SAVE :: USE_NEIGHBOR_LISTS = .TRUE. !this should be passable457:       LOGICAL, SAVE :: USE_NEIGHBOR_LISTS = .TRUE. !this should be passable
502:       LOGICAL :: FIRST = .TRUE.458:       LOGICAL :: FIRST = .TRUE.
503:       integer, save :: num_calls = 0459:       integer, save :: num_calls = 0
504:       double precision :: oldpotel, xr(3*natoms)460:       double precision :: oldpotel
505:       !double precision :: time0, time1, time2, time01=0.d0, time12=0.d0, time02=0.d0461:       !double precision :: time0, time1, time2, time01=0.d0, time12=0.d0, time02=0.d0
506:       num_calls = num_calls + 1462:       num_calls = num_calls + 1
507: 463: 
508:       !print *, 'line 464' 
509:  
510:       !IF (.not.(ATOMRIGIDCOORDT)) THEN 
511:       !   ! convert to cartesian coordinates 
512:       !   XR(:) = 0.D0 
513:       !   CALL TRANSFORMRIGIDTOC(1, NRIGIDBODY, XR, X) 
514:       !   X(:) = XR(:) 
515:       !ENDIF 
516:  
517:       !print *, 'master coords: ', x(:3*natoms) 
518:  
519:       !CALL MYCPU_TIME(TIME0)464:       !CALL MYCPU_TIME(TIME0)
520:       IF (FIRST) THEN465:       IF (FIRST) THEN
521:          CALL LJPSHIFT_CLASS_SETUP( CUTOFF, 1.D0, EPSBB, EPSAB, 1.D0, SIGBB, SIGAB, NATOMS, BOXLX, BOXLY, BOXLZ)466:          CALL LJPSHIFT_CLASS_SETUP( CUTOFF, 1.D0, EPSBB, EPSAB, 1.D0, SIGBB, SIGAB, NATOMS, BOXLX, BOXLY, BOXLZ)
522:       ENDIF467:       ENDIF
523: 468: 
524:       !print *, 'line 471' 
525:  
526:       FIRST = .FALSE.469:       FIRST = .FALSE.
527: 470: 
528:       !CALL MYCPU_TIME(TIME1)471:       !CALL MYCPU_TIME(TIME1)
529: !472: !
530: !  Calculate interatomic vectors using the minimum image convention.473: !  Calculate interatomic vectors using the minimum image convention.
531: !474: !
532:  
533:       !print *, 'line 480' 
534:  
535:       POTEL=0.0D0475:       POTEL=0.0D0
536:       IF (GTEST .OR. STEST) THEN476:       IF (GTEST .OR. STEST) THEN
537:          V(1:3*NATOMS)=0.D0477:          V(1:3*NATOMS)=0.D0
538:       ENDIF478:       ENDIF
539: 479: 
540:       IF (STEST) THEN480:       IF (STEST) THEN
541:         write(*,*) "warning: calculation of the hessian is not implimented in GMIN"481:         write(*,*) "warning: calculation of the hessian is not implimented in GMIN"
542:         ! js850> it could easily be implimented, but there is no way to return482:         ! js850> it could easily be implimented, but there is no way to return
543:         ! the calculated matrix.  OPTIM uses a module which is not implimented483:         ! the calculated matrix.  OPTIM uses a module which is not implimented
544:         ! (and not needed) in GMIN484:         ! (and not needed) in GMIN
549:       IF (ONE_ATOM_TAKESTEP .AND. .NOT. GTEST )  THEN489:       IF (ONE_ATOM_TAKESTEP .AND. .NOT. GTEST )  THEN
550:          CALL LJPSHIFT_ONE_ATOM2(X, V, POTEL, .false.)490:          CALL LJPSHIFT_ONE_ATOM2(X, V, POTEL, .false.)
551:          IF (.false. .and. mod(num_calls,100000).eq.1) THEN491:          IF (.false. .and. mod(num_calls,100000).eq.1) THEN
552:             OLDPOTEL = 0.D0492:             OLDPOTEL = 0.D0
553:             CALL LJPSHIFT_NEIGHBOR_LIST( X, V, oldpotel, .FALSE., .FALSE.)493:             CALL LJPSHIFT_NEIGHBOR_LIST( X, V, oldpotel, .FALSE., .FALSE.)
554:             WRITE(*,'(A,3G27.12)') "ljpshift> potel: ", OLDPOTEL-POTEL, POTEL, OLDPOTEL494:             WRITE(*,'(A,3G27.12)') "ljpshift> potel: ", OLDPOTEL-POTEL, POTEL, OLDPOTEL
555:          ENDIF495:          ENDIF
556:          RETURN496:          RETURN
557:       ENDIF497:       ENDIF
558: 498: 
559:       !print *, 'line 506' 
560:  
561: !499: !
562: !  Deal with any atoms that have left the box.500: !  Deal with any atoms that have left the box.
563: !501: !
564:       IF ((.NOT.FIXIMAGE).AND.(.NOT.NORESET).and.(.not.ONE_ATOM_TAKESTEP)) THEN502:       IF ((.NOT.FIXIMAGE).AND.(.NOT.NORESET).and.(.not.ONE_ATOM_TAKESTEP)) THEN
565:          DO J1=1,NATOMS503:          DO J1=1,NATOMS
566:             J2 = 3*(J1-1)504:             J2 = 3*(J1-1)
567:             X(J2+1)=X(J2+1) - BOXLX*ANINT(X(J2+1)/BOXLX)505:             X(J2+1)=X(J2+1) - BOXLX*ANINT(X(J2+1)/BOXLX)
568:             X(J2+2)=X(J2+2) - BOXLY*ANINT(X(J2+2)/BOXLY)506:             X(J2+2)=X(J2+2) - BOXLY*ANINT(X(J2+2)/BOXLY)
569:             X(J2+3)=X(J2+3) - BOXLZ*ANINT(X(J2+3)/BOXLZ)507:             X(J2+3)=X(J2+3) - BOXLZ*ANINT(X(J2+3)/BOXLZ)
570:          ENDDO508:          ENDDO
571:       ENDIF509:       ENDIF
572: 510: 
573:       !print *, 'line 520' 
574:  
575:       IF (USE_NEIGHBOR_LISTS) THEN511:       IF (USE_NEIGHBOR_LISTS) THEN
576:          !print *, 'line 537' 
577:          CALL LJPSHIFT_NEIGHBOR_LIST( X, V, POTEL, GTEST, STEST)512:          CALL LJPSHIFT_NEIGHBOR_LIST( X, V, POTEL, GTEST, STEST)
578:          !print *, 'v: ', v(:3*natoms) 
579:          !print *, 'potel: ', potel 
580:          return 513:          return 
581:       ENDIF514:       ENDIF
582: 515: 
583:       !print *, 'line 527'516: 
584: 517: 
585:       IF (FREEZE .AND. RESTRICTREGION) THEN518:       IF (FREEZE .AND. RESTRICTREGION) THEN
586:          CALL LJPSHIFT_INTERACTION_LIST (X, V, POTEL, GTEST, STEST)519:          CALL LJPSHIFT_INTERACTION_LIST (X, V, POTEL, GTEST, STEST)
587:       ELSEIF ((GTEST .OR. STEST) .AND. FREEZE) THEN520:       ELSEIF ((GTEST .OR. STEST) .AND. FREEZE) THEN
588:          CALL LJPSHIFT_FROZENLIST (X, V, POTEL, GTEST, STEST)521:          CALL LJPSHIFT_FROZENLIST (X, V, POTEL, GTEST, STEST)
589:       ELSEIF ( GTEST .OR. STEST ) THEN522:       ELSEIF ( GTEST .OR. STEST ) THEN
590:         !update POTEL and V523:         !update POTEL and V
591:         DO J1=1,NTYPEA524:         DO J1=1,NTYPEA
592:           DO J2=J1+1,NTYPEA525:           DO J2=J1+1,NTYPEA
593:             CALL LJPSHIFT_UPDATE_EG_AA(X, J1, J2, POTEL, V)526:             CALL LJPSHIFT_UPDATE_EG_AA(X, J1, J2, POTEL, V)
615:                CALL LJPSHIFT_UPDATE_E_AB(X, J1, J2, POTEL)548:                CALL LJPSHIFT_UPDATE_E_AB(X, J1, J2, POTEL)
616:             ENDDO549:             ENDDO
617:          ENDDO550:          ENDDO
618:          DO J1=NTYPEA+1, NATOMS551:          DO J1=NTYPEA+1, NATOMS
619:             DO J2=J1+1, NATOMS552:             DO J2=J1+1, NATOMS
620:                CALL LJPSHIFT_UPDATE_E_BB(X, J1, J2, POTEL)553:                CALL LJPSHIFT_UPDATE_E_BB(X, J1, J2, POTEL)
621:             ENDDO554:             ENDDO
622:          ENDDO555:          ENDDO
623:       ENDIF556:       ENDIF
624: 557: 
625:       ! dj337: check if input coordinates are cartesian 
626:       ! assumes ATOMRIGIDCOORDT is correct 
627:       !IF (.not.(ATOMRIGIDCOORDT)) THEN ! if input is cartesian 
628:       !   ! convert to rigidbody coordinates 
629:       !   XR(:) = 0.D0 
630:       !   CALL TRANSFORMCTORIGID(X, XR) 
631:       !   X(:) = XR(:) 
632:       !ENDIF 
633:  
634:       !print *, 'energy: ', potel 
635:  
636:       !print *, 'line 569' 
637: 558: 
638:       !CALL MYCPU_TIME(TIME2)559:       !CALL MYCPU_TIME(TIME2)
639:       !Time01 = time01 + TIME1 - TIME0560:       !Time01 = time01 + TIME1 - TIME0
640:       !Time12 = time12 + TIME2 - TIME1561:       !Time12 = time12 + TIME2 - TIME1
641:       !Time02 = time02 + TIME2 - TIME0562:       !Time02 = time02 + TIME2 - TIME0
642:       !write(*,*) "ljpshift> times", time01, time12, time02563:       !write(*,*) "ljpshift> times", time01, time12, time02
643:       RETURN564:       RETURN
644:       END SUBROUTINE LJPSHIFT565:       END SUBROUTINE LJPSHIFT
645: 566: 
646: !****************************************************************************567: !****************************************************************************
930:    USE NEIGHBOR_LIST_MOD851:    USE NEIGHBOR_LIST_MOD
931:    USE BIN_NL_MOD852:    USE BIN_NL_MOD
932:    IMPLICIT NONE853:    IMPLICIT NONE
933:    INTEGER J1, J2854:    INTEGER J1, J2
934:    DOUBLE PRECISION, INTENT(INOUT) :: X(3*NATOMS) 855:    DOUBLE PRECISION, INTENT(INOUT) :: X(3*NATOMS) 
935:    DOUBLE PRECISION, INTENT(OUT) :: V(3*NATOMS), POTEL 856:    DOUBLE PRECISION, INTENT(OUT) :: V(3*NATOMS), POTEL 
936:    LOGICAL, INTENT(IN) :: GTEST, STEST857:    LOGICAL, INTENT(IN) :: GTEST, STEST
937:    LOGICAL IL_CHANGED858:    LOGICAL IL_CHANGED
938:    LOGICAL, SAVE :: FIRST = .TRUE.859:    LOGICAL, SAVE :: FIRST = .TRUE.
939: 860: 
940:    !print *, '889' 
941:  
942:    !CALL MYCPU_TIME(TIME0)861:    !CALL MYCPU_TIME(TIME0)
943:    IF (FIRST) THEN862:    IF (FIRST) THEN
944:       CALL NL_SETUP( NATOMS, X, CUTOFF, BOXLX, BOXLY, BOXLZ )863:       CALL NL_SETUP( NATOMS, X, CUTOFF, BOXLX, BOXLY, BOXLZ )
945:       CALL BIN_NL_SETUP( NATOMS, NTYPEA )864:       CALL BIN_NL_SETUP( NATOMS, NTYPEA )
946:       IF (FREEZE) CALL FREEZE_NL_SETUP( NATOMS, NTYPEA, FREEZE, FROZEN )865:       IF (FREEZE) CALL FREEZE_NL_SETUP( NATOMS, NTYPEA, FREEZE, FROZEN )
947:    ENDIF866:    ENDIF
948: 867: 
949:    !print *, 'line 898' 
950:  
951:    CALL NL_UPDATE( X, IL_CHANGED )868:    CALL NL_UPDATE( X, IL_CHANGED )
952: 869: 
953:    IF ( (IL_CHANGED .OR. FIRST)) THEN870:    IF ( (IL_CHANGED .OR. FIRST)) THEN
954:       CALL BIN_NL_UPDATE ( NL_LIST, NL_NLIST )871:       CALL BIN_NL_UPDATE ( NL_LIST, NL_NLIST )
955:       if (FREEZE) CALL FREEZE_NL_UPDATE ( X, BIN_NL_AALIST, BIN_NL_NAA, BIN_NL_BBLIST, BIN_NL_NBB, BIN_NL_ABLIST, BIN_NL_NAB )872:       if (FREEZE) CALL FREEZE_NL_UPDATE ( X, BIN_NL_AALIST, BIN_NL_NAA, BIN_NL_BBLIST, BIN_NL_NBB, BIN_NL_ABLIST, BIN_NL_NAB )
956:    ENDIF873:    ENDIF
957: 874: 
958:    !print *, 'line 907' 
959:  
960:    FIRST = .FALSE.875:    FIRST = .FALSE.
961: 876: 
962:    IF (FREEZE) THEN877:    IF (FREEZE) THEN
963:       !print *, 'line 912' 
964:       CALL LJPSHIFT_INTERACTION_LIST2 (X, V, POTEL, GTEST, STEST, NATOMS, FREEZE_NL_AALIST, &878:       CALL LJPSHIFT_INTERACTION_LIST2 (X, V, POTEL, GTEST, STEST, NATOMS, FREEZE_NL_AALIST, &
965:          FREEZE_NL_NAA, FREEZE_NL_BBLIST, FREEZE_NL_NBB, FREEZE_NL_ABLIST, FREEZE_NL_NAB, FREEZE_NL_EOFFSET)879:          FREEZE_NL_NAA, FREEZE_NL_BBLIST, FREEZE_NL_NBB, FREEZE_NL_ABLIST, FREEZE_NL_NAB, FREEZE_NL_EOFFSET)
966:    ELSE880:    ELSE
967:       !print *, 'line 916' 
968:       !print *, 'coords: ', x(:3*natoms) 
969:       CALL LJPSHIFT_INTERACTION_LIST2 (X, V, POTEL, GTEST, STEST, NATOMS, BIN_NL_AALIST, &881:       CALL LJPSHIFT_INTERACTION_LIST2 (X, V, POTEL, GTEST, STEST, NATOMS, BIN_NL_AALIST, &
970:          BIN_NL_NAA, BIN_NL_BBLIST, BIN_NL_NBB, BIN_NL_ABLIST, BIN_NL_NAB, 0.D0)882:          BIN_NL_NAA, BIN_NL_BBLIST, BIN_NL_NBB, BIN_NL_ABLIST, BIN_NL_NAB, 0.D0)
971:    ENDIF883:    ENDIF
972:    !print *, 'line 920' 
973: END SUBROUTINE LJPSHIFT_NEIGHBOR_LIST884: END SUBROUTINE LJPSHIFT_NEIGHBOR_LIST
974: 885: 
975: SUBROUTINE LJPSHIFT_INTERACTION_LIST2 (X, V, POTEL, GTEST, STEST, NATOMS, AALIST, &886: SUBROUTINE LJPSHIFT_INTERACTION_LIST2 (X, V, POTEL, GTEST, STEST, NATOMS, AALIST, &
976: NAA, BBLIST, NBB, ABLIST, NAB, EOFFSET)887: NAA, BBLIST, NBB, ABLIST, NAB, EOFFSET)
977:    !THIS SUBROUTINE CALCULATES THE POTENTIAL USING INTERACTION LISTS.888:    !THIS SUBROUTINE CALCULATES THE POTENTIAL USING INTERACTION LISTS.
978:    !Calculate the potential energy of all atom pairs in the neighbor lists889:    !Calculate the potential energy of all atom pairs in the neighbor lists
979:    !AALIST, BBLIST, ABLIST890:    !AALIST, BBLIST, ABLIST
980:    USE LJPSHIFT_CLASS891:    USE LJPSHIFT_CLASS
981:    IMPLICIT NONE892:    IMPLICIT NONE
982:    INTEGER, INTENT(IN) :: NAA, NBB, NAB, NATOMS893:    INTEGER, INTENT(IN) :: NAA, NBB, NAB, NATOMS
984:    DOUBLE PRECISION, INTENT(OUT) :: V(3*NATOMS), POTEL 895:    DOUBLE PRECISION, INTENT(OUT) :: V(3*NATOMS), POTEL 
985:    DOUBLE PRECISION, INTENT(IN) :: EOFFSET896:    DOUBLE PRECISION, INTENT(IN) :: EOFFSET
986:    INTEGER, INTENT(IN) :: AALIST(2,NAA), BBLIST(2,NBB), ABLIST(2,NAB)897:    INTEGER, INTENT(IN) :: AALIST(2,NAA), BBLIST(2,NBB), ABLIST(2,NAB)
987:    LOGICAL, INTENT(IN) :: GTEST, STEST898:    LOGICAL, INTENT(IN) :: GTEST, STEST
988:    INTEGER J1, J2, J3899:    INTEGER J1, J2, J3
989: 900: 
990:    !901:    !
991:    !CALCULATE THE POTENTIAL USING THE INTERACTION LIST902:    !CALCULATE THE POTENTIAL USING THE INTERACTION LIST
992:    !903:    !
993: 904: 
994:    !print *, 'line 942' 
995:  
996:    !print *, 'aalist1: ', aalist(1, :naa) 
997:    !print *, 'aalist2: ', aalist(2, :naa) 
998:  
999:    !print *, 'intl potel: ', potel 
1000:  
1001:    IF ((GTEST .OR. STEST)) THEN905:    IF ((GTEST .OR. STEST)) THEN
1002:       !CALCULATE BOTH POTENTIAL AND GRADIENT.906:       !CALCULATE BOTH POTENTIAL AND GRADIENT.
1003:       !print *, 'naa: ', naa 
1004:       !print *, 'line 946' 
1005:       DO J3=1,NAA907:       DO J3=1,NAA
1006:          J1=AALIST(1,J3)908:          J1=AALIST(1,J3)
1007:          J2=AALIST(2,J3)909:          J2=AALIST(2,J3)
1008:          !print *, 'j1: ', j1, 'j2: ', j2 
1009:          !WRITE (*,*) "AA", J1, J2, FROZEN(J1), FROZEN(J2)910:          !WRITE (*,*) "AA", J1, J2, FROZEN(J1), FROZEN(J2)
1010:          !print *, 'coords: ', x(:3*natoms) 
1011:          CALL LJPSHIFT_UPDATE_EG_AA(X, J1, J2, POTEL, V)911:          CALL LJPSHIFT_UPDATE_EG_AA(X, J1, J2, POTEL, V)
1012:          !print *, 'j3: ', j3, potel 
1013:       ENDDO912:       ENDDO
1014:       !print *, 'line 953' 
1015:       DO J3=1,NBB913:       DO J3=1,NBB
1016:          J1=BBLIST(1,J3)914:          J1=BBLIST(1,J3)
1017:          J2=BBLIST(2,J3)915:          J2=BBLIST(2,J3)
1018:          CALL LJPSHIFT_UPDATE_EG_BB(X, J1, J2, POTEL, V)916:          CALL LJPSHIFT_UPDATE_EG_BB(X, J1, J2, POTEL, V)
1019:       ENDDO917:       ENDDO
1020:       !print *, 'line 959' 
1021:       DO J3=1,NAB918:       DO J3=1,NAB
1022:          J1=ABLIST(1,J3)919:          J1=ABLIST(1,J3)
1023:          J2=ABLIST(2,J3)920:          J2=ABLIST(2,J3)
1024:          CALL LJPSHIFT_UPDATE_EG_AB(X, J1, J2, POTEL, V)921:          CALL LJPSHIFT_UPDATE_EG_AB(X, J1, J2, POTEL, V)
1025:       ENDDO922:       ENDDO
1026:       !print *, 'line 965' 
1027:    ELSE923:    ELSE
1028:       !print *, 'line 967' 
1029:       !CALCULATE ONLY THE POTENTIAL924:       !CALCULATE ONLY THE POTENTIAL
1030:       DO J3=1,NAA925:       DO J3=1,NAA
1031:          J1=AALIST(1,J3)926:          J1=AALIST(1,J3)
1032:          J2=AALIST(2,J3)927:          J2=AALIST(2,J3)
1033:          CALL LJPSHIFT_UPDATE_E_AA(X, J1, J2, POTEL)928:          CALL LJPSHIFT_UPDATE_E_AA(X, J1, J2, POTEL)
1034:       ENDDO929:       ENDDO
1035:       DO J3=1,NBB930:       DO J3=1,NBB
1036:          J1=BBLIST(1,J3)931:          J1=BBLIST(1,J3)
1037:          J2=BBLIST(2,J3)932:          J2=BBLIST(2,J3)
1038:          CALL LJPSHIFT_UPDATE_E_BB(X, J1, J2, POTEL)933:          CALL LJPSHIFT_UPDATE_E_BB(X, J1, J2, POTEL)
1039:       ENDDO934:       ENDDO
1040:       DO J3=1,NAB935:       DO J3=1,NAB
1041:          J1=ABLIST(1,J3)936:          J1=ABLIST(1,J3)
1042:          J2=ABLIST(2,J3)937:          J2=ABLIST(2,J3)
1043:          CALL LJPSHIFT_UPDATE_E_AB(X, J1, J2, POTEL)938:          CALL LJPSHIFT_UPDATE_E_AB(X, J1, J2, POTEL)
1044:       ENDDO939:       ENDDO
1045:    ENDIF940:    ENDIF
1046:    !print *, 'line 985' 
1047:    POTEL = POTEL + EOFFSET941:    POTEL = POTEL + EOFFSET
1048: END SUBROUTINE LJPSHIFT_INTERACTION_LIST2942: END SUBROUTINE LJPSHIFT_INTERACTION_LIST2
1049: 943: 
1050: SUBROUTINE LJPSHIFT_INTERACTION_LIST3 (X, V, POTEL, GTEST, STEST, NATOMS, AALIST, &944: SUBROUTINE LJPSHIFT_INTERACTION_LIST3 (X, V, POTEL, GTEST, STEST, NATOMS, AALIST, &
1051:    NAA, BBLIST, NBB, ABLIST, NAB, EOFFSET, ATOMI)945:    NAA, BBLIST, NBB, ABLIST, NAB, EOFFSET, ATOMI)
1052:    !THIS SUBROUTINE CALCULATES THE POTENTIAL USING INTERACTION LISTS.946:    !THIS SUBROUTINE CALCULATES THE POTENTIAL USING INTERACTION LISTS.
1053:    !Calculate the potential energy of atomi with all the atoms in the lists947:    !Calculate the potential energy of atomi with all the atoms in the lists
1054:    !AALIST, BBLIST, ABLIST948:    !AALIST, BBLIST, ABLIST
1055:    USE LJPSHIFT_CLASS949:    USE LJPSHIFT_CLASS
1056:    IMPLICIT NONE950:    IMPLICIT NONE


r32452/main.F 2017-05-02 18:30:27.720513143 +0100 r32451/main.F 2017-05-02 18:30:31.264559225 +0100
 24:       USE QMODULE 24:       USE QMODULE
 25:       USE PERMU 25:       USE PERMU
 26:       USE F1COM 26:       USE F1COM
 27:       USE MODAMBER 27:       USE MODAMBER
 28:       USE MODAMBER9, only : AMBFINALIO_NODE,MDCRD_UNIT,MDINFO_UNIT,AMBPDB_UNIT, ATMASS1 28:       USE MODAMBER9, only : AMBFINALIO_NODE,MDCRD_UNIT,MDINFO_UNIT,AMBPDB_UNIT, ATMASS1
 29:       USE AMBER12_INTERFACE_MOD, ONLY : AMBER12_MASSES 29:       USE AMBER12_INTERFACE_MOD, ONLY : AMBER12_MASSES
 30:       USE MODCHARMM 30:       USE MODCHARMM
 31:       USE PORFUNCS 31:       USE PORFUNCS
 32:       USE TWIST_MOD 32:       USE TWIST_MOD
 33:       !USE HOMOREFMOD 33:       !USE HOMOREFMOD
 34:       USE GENRIGID, only : RIGIDINIT, GENRIGID_READ_FROM_FILE, DEGFREEDOMS, NRIGIDBODY 34:       USE GENRIGID, only : RIGIDINIT, GENRIGID_READ_FROM_FILE, DEGFREEDOMS
 35:       USE MULTIPOT, only: MULTIPOT_INITIALISE 35:       USE MULTIPOT, only: MULTIPOT_INITIALISE
 36:       USE GAUSS_MOD, ONLY: KEGEN 36:       USE GAUSS_MOD, ONLY: KEGEN
 37:       USE MOLECULAR_DYNAMICS, ONLY : MDT, MD_NSTEPS, MD_NWAIT, MDRUN 37:       USE MOLECULAR_DYNAMICS, ONLY : MDT, MD_NSTEPS, MD_NWAIT, MDRUN
 38:  38: 
 39:       IMPLICIT NONE 39:       IMPLICIT NONE
 40:       !EXTERNAL READ_CMD_ARGS 40:       !EXTERNAL READ_CMD_ARGS
 41: #ifdef MPI 41: #ifdef MPI
 42:       INCLUDE 'mpif.h' 42:       INCLUDE 'mpif.h'
 43: #endif 43: #endif
 44:       INTEGER J1,J2, JP, MPIERR, NDUMMY3,NPTOTAL,VERSIONTEMP,GETUNIT,LUNIT 44:       INTEGER J1,J2, JP, MPIERR, NDUMMY3,NPTOTAL,VERSIONTEMP,GETUNIT,LUNIT
171:       VT(1:NATOMSALLOC)=0.0D0 ! TO PREVENT READING FROM UNINITIALISED MEMORY171:       VT(1:NATOMSALLOC)=0.0D0 ! TO PREVENT READING FROM UNINITIALISED MEMORY
172:       IF (CALCQT) CALL SHINIT172:       IF (CALCQT) CALL SHINIT
173: 173: 
174:       ALLOCATE(FINISH(3*NATOMSALLOC))174:       ALLOCATE(FINISH(3*NATOMSALLOC))
175: 175: 
176:       INQUIRE(UNIT=1,OPENED=LOPEN)176:       INQUIRE(UNIT=1,OPENED=LOPEN)
177:       IF (LOPEN) THEN177:       IF (LOPEN) THEN
178:          WRITE(*,'(A,I2,A)') 'main> A ERROR *** Unit ', 1, ' is not free '178:          WRITE(*,'(A,I2,A)') 'main> A ERROR *** Unit ', 1, ' is not free '
179:          STOP179:          STOP
180:       ENDIF180:       ENDIF
 181: 
181:       CALL KEYWORD182:       CALL KEYWORD
182: !     write out the atom indices to check:183: !     write out the atom indices to check:
183: !        IF(TWISTT) THEN184: !        IF(TWISTT) THEN
184: !              WRITE(MYUNIT,*)'NWISTGROUPS dihedrals to be constrained..'185: !              WRITE(MYUNIT,*)'NWISTGROUPS dihedrals to be constrained..'
185: !              DO J1=1, NTWISTGROUPS186: !              DO J1=1, NTWISTGROUPS
186: !                WRITE(MYUNIT,*) 'Group J1  indices:'187: !                WRITE(MYUNIT,*) 'Group J1  indices:'
187: !                WRITE(MYUNIT,*) TWIST_ATOMS(1:4, J1)188: !                WRITE(MYUNIT,*) TWIST_ATOMS(1:4, J1)
188: !                WRITE(MYUNIT,*) 'Group J1  k value, ref.dihedral:'189: !                WRITE(MYUNIT,*) 'Group J1  k value, ref.dihedral:'
189: !                WRITE(MYUNIT,*) TWIST_K(J1), TWIST_THETA0(J1)190: !                WRITE(MYUNIT,*) TWIST_K(J1), TWIST_THETA0(J1)
190: !              END DO191: !              END DO
194:           CALL GENRIGID_READ_FROM_FILE ()195:           CALL GENRIGID_READ_FROM_FILE ()
195: ! csw34> Tell the user how many degrees of freedom there are in the system196: ! csw34> Tell the user how many degrees of freedom there are in the system
196:           WRITE(MYUNIT, '(A,I15)') " genrigid> rbodyconfig used to specifiy rigid bodies, degrees of freedom now ", DEGFREEDOMS197:           WRITE(MYUNIT, '(A,I15)') " genrigid> rbodyconfig used to specifiy rigid bodies, degrees of freedom now ", DEGFREEDOMS
197:           IF (GCBHT) THEN198:           IF (GCBHT) THEN
198: ! csw34> Make sure we aren't running GCBH with rigid bodies - very dangerous! Could be done but only with great care...199: ! csw34> Make sure we aren't running GCBH with rigid bodies - very dangerous! Could be done but only with great care...
199:               WRITE(MYUNIT, '(A)') " genrigid> ERROR: cannot use rigid bodies with GCBH! Stopping."200:               WRITE(MYUNIT, '(A)') " genrigid> ERROR: cannot use rigid bodies with GCBH! Stopping."
200:               STOP                201:               STOP                
201:           END IF202:           END IF
202:       END IF203:       END IF
203: 204: 
204: ! dj337: allocate charges for benzenes 
205:       if (benzrigidewaldt) then 
206:          ALLOCATE(STCHRG(NRIGIDBODY*NRBSITES)) 
207:          CALL DEFBENZENERIGIDEWALD() 
208:       endif 
209:  
210:  
211:       IF (MULTIPOTT) THEN205:       IF (MULTIPOTT) THEN
212:           CALL MULTIPOT_INITIALISE()206:           CALL MULTIPOT_INITIALISE()
213:       ENDIF207:       ENDIF
214: 208: 
215:       IF (CUDAT) THEN209:       IF (CUDAT) THEN
216:          IF ((CUDAPOT .EQ. 'A') .AND. (.NOT. AMBER12T)) THEN210:          IF ((CUDAPOT .EQ. 'A') .AND. (.NOT. AMBER12T)) THEN
217:             WRITE(MYUNIT,'(A)') " main> The AMBER12 keyword must be used with 'CUDA A'. "211:             WRITE(MYUNIT,'(A)') " main> The AMBER12 keyword must be used with 'CUDA A'. "
218:             STOP212:             STOP
219:          END IF213:          END IF
220:          IF (DEBUG) THEN214:          IF (DEBUG) THEN
713:       IF (ALLOCATED(VSITES)) DEALLOCATE(VSITES)707:       IF (ALLOCATED(VSITES)) DEALLOCATE(VSITES)
714:       IF (ALLOCATED(MIEF_SIG)) DEALLOCATE(MIEF_SIG)708:       IF (ALLOCATED(MIEF_SIG)) DEALLOCATE(MIEF_SIG)
715:       IF (ALLOCATED(MIEF_EPS)) DEALLOCATE(MIEF_EPS)709:       IF (ALLOCATED(MIEF_EPS)) DEALLOCATE(MIEF_EPS)
716:       IF (ALLOCATED(MIEF_SITES)) DEALLOCATE(MIEF_SITES)710:       IF (ALLOCATED(MIEF_SITES)) DEALLOCATE(MIEF_SITES)
717:       IF (ALLOCATED(MIEF_U_RCUT)) DEALLOCATE(MIEF_U_RCUT)711:       IF (ALLOCATED(MIEF_U_RCUT)) DEALLOCATE(MIEF_U_RCUT)
718:       IF (ALLOCATED(MIEF_DUDR_RCUT)) DEALLOCATE(MIEF_DUDR_RCUT)712:       IF (ALLOCATED(MIEF_DUDR_RCUT)) DEALLOCATE(MIEF_DUDR_RCUT)
719:       IF (ALLOCATED(OBJ)) DEALLOCATE(OBJ)713:       IF (ALLOCATED(OBJ)) DEALLOCATE(OBJ)
720:       IF (ALLOCATED(TWIST_K)) DEALLOCATE(TWIST_K)714:       IF (ALLOCATED(TWIST_K)) DEALLOCATE(TWIST_K)
721:       IF (ALLOCATED(TWIST_THETA0)) DEALLOCATE(TWIST_THETA0)715:       IF (ALLOCATED(TWIST_THETA0)) DEALLOCATE(TWIST_THETA0)
722:       IF (ALLOCATED(TWIST_ATOMS)) DEALLOCATE(TWIST_ATOMS)716:       IF (ALLOCATED(TWIST_ATOMS)) DEALLOCATE(TWIST_ATOMS)
723:       IF (ALLOCATED(RERHOARRAY)) DEALLOCATE(RERHOARRAY) 
724:       IF (ALLOCATED(IMRHOARRAY)) DEALLOCATE(IMRHOARRAY) 
725: 717: 
726: !718: !
727: ! Should also deallocate any of the arrays below, which may have been719: ! Should also deallocate any of the arrays below, which may have been
728: ! allocated in keywords. This is just to make nagfmcheck happy, though! DJW720: ! allocated in keywords. This is just to make nagfmcheck happy, though! DJW
729: !721: !
730: !          ALLOCATE(DATOMGROUPAXIS(NDGROUPS,2))722: !          ALLOCATE(DATOMGROUPAXIS(NDGROUPS,2))
731: !          ALLOCATE(DATOMGROUPPROBA(NDGROUPS))723: !          ALLOCATE(DATOMGROUPPROBA(NDGROUPS))
732: !          ALLOCATE(DATOMGROUPSCALINGA(NDGROUPS))724: !          ALLOCATE(DATOMGROUPSCALINGA(NDGROUPS))
733: !          ALLOCATE(DATOMGROUPPROBB(NDGROUPS))725: !          ALLOCATE(DATOMGROUPPROBB(NDGROUPS))
734: !          ALLOCATE(DATOMGROUPSCALINGB(NDGROUPS))726: !          ALLOCATE(DATOMGROUPSCALINGB(NDGROUPS))


r32452/mc.F 2017-05-02 18:30:27.948516106 +0100 r32451/mc.F 2017-05-02 18:30:31.508562401 +0100
242:             CALL RESTORESTATE(NDONE,EBEST,BESTCOORDS,JBEST,JP)242:             CALL RESTORESTATE(NDONE,EBEST,BESTCOORDS,JBEST,JP)
243:          ENDDO243:          ENDDO
244: #endif244: #endif
245:          WRITE(MYUNIT, '(A,I10)') 'MC> restore NDONE=',NDONE245:          WRITE(MYUNIT, '(A,I10)') 'MC> restore NDONE=',NDONE
246: !     csw34> Sets the quench counter so that the GMIN_out file makes sense after using RESTORE!246: !     csw34> Sets the quench counter so that the GMIN_out file makes sense after using RESTORE!
247: !         NQ(:)=NDONE247: !         NQ(:)=NDONE
248:       ENDIF248:       ENDIF
249:       NQ(:)=NDONE249:       NQ(:)=NDONE
250: 250: 
251: ! tvb requesting a basin-sampling MC run: 251: ! tvb requesting a basin-sampling MC run: 
252:      252:       
253:       IF (BSWL.AND.(.NOT.TETHER)) then253:       IF (BSWL.AND.(.NOT.TETHER)) then
254:          CALL BASINSAMPLING()254:          CALL BASINSAMPLING()
255:          RETURN255:          RETURN
256:       ELSEIF (TETHER) THEN256:       ELSEIF (TETHER) THEN
257:          CALL TETHEREDWL()257:          CALL TETHEREDWL()
258:          RETURN258:          RETURN
259:       ENDIF259:       ENDIF
260: 260: 
261: #ifdef MPI261: #ifdef MPI
262:       WRITE(MYUNIT, '(A,I10,A,I10,A)') "Processor", mynode+1, " of", NPAR, " speaking:"262:       WRITE(MYUNIT, '(A,I10,A,I10,A)') "Processor", mynode+1, " of", NPAR, " speaking:"
333:          WRITE(MYUNIT,'(A)') ' mc> Storing chiral information for initial (quench) structure'333:          WRITE(MYUNIT,'(A)') ' mc> Storing chiral information for initial (quench) structure'
334:          CALL INIT_CHIRAL(COORDS(:,1))334:          CALL INIT_CHIRAL(COORDS(:,1))
335:       END IF335:       END IF
336:       IF (AMBER12T.AND.NOCISTRANS) THEN336:       IF (AMBER12T.AND.NOCISTRANS) THEN
337:          WRITE(MYUNIT,'(A)') ' mc> Storing cis/trans information for initial (quench) structure'337:          WRITE(MYUNIT,'(A)') ' mc> Storing cis/trans information for initial (quench) structure'
338:          CALL INIT_CIS_TRANS(COORDS(:,1))338:          CALL INIT_CIS_TRANS(COORDS(:,1))
339:       ENDIF339:       ENDIF
340:       WRITE(MYUNIT, '(A)')  'Calculating initial energy'340:       WRITE(MYUNIT, '(A)')  'Calculating initial energy'
341:       EPSSAVE=EPSSPHERE341:       EPSSAVE=EPSSPHERE
342:       EPSSPHERE=0.0D0342:       EPSSPHERE=0.0D0
343:  
344:       CALL QUENCH(.FALSE.,JP,ITERATIONS,TIME,BRUN,QDONE,SCREENC)343:       CALL QUENCH(.FALSE.,JP,ITERATIONS,TIME,BRUN,QDONE,SCREENC)
345:       NQTOT=NQTOT+1344:       NQTOT=NQTOT+1
346:       WRITE(MYUNIT,'(A,I10,A,G20.10,A,I5,A,G12.5,A,G20.10,A,F11.1)') 'Qu ',NQ(JP),' E=',345:       WRITE(MYUNIT,'(A,I10,A,G20.10,A,I5,A,G12.5,A,G20.10,A,F11.1)') 'Qu ',NQ(JP),' E=',
347:      1           POTEL,' steps=',ITERATIONS,' RMS=',RMS,' Markov E=',POTEL,' t=',TIME-TSTART346:      1           POTEL,' steps=',ITERATIONS,' RMS=',RMS,' Markov E=',POTEL,' t=',TIME-TSTART
348:       CALL FLUSH(MYUNIT)347:       CALL FLUSH(MYUNIT)
349: 348: 
350:  349:  
351: !  EPREV saves the previous energy in the Markov chain.350: !  EPREV saves the previous energy in the Markov chain.
352: !  EBEST and JBEST record the lowest energy since the last reseeding and the351: !  EBEST and JBEST record the lowest energy since the last reseeding and the
353: !  step it was attained at. BESTCOORDS contains the corresponding coordinates.352: !  step it was attained at. BESTCOORDS contains the corresponding coordinates.
361:       IF (.NOT.RESTORET) EBEST(JP)=POTEL360:       IF (.NOT.RESTORET) EBEST(JP)=POTEL
362:       BESTCOORDS(1:3*NATOMS,JP)=COORDS(1:3*NATOMS,JP)361:       BESTCOORDS(1:3*NATOMS,JP)=COORDS(1:3*NATOMS,JP)
363:       JBEST(JP)=0362:       JBEST(JP)=0
364:       RMIN=POTEL363:       RMIN=POTEL
365:       RCOORDS(1:3*NATOMS)=COORDS(1:3*NATOMS,1)364:       RCOORDS(1:3*NATOMS)=COORDS(1:3*NATOMS,1)
366:       COORDSO(1:3*NATOMS,JP)=COORDS(1:3*NATOMS,JP)365:       COORDSO(1:3*NATOMS,JP)=COORDS(1:3*NATOMS,JP)
367:       LABELSO(1:NATOMS,JP)=LABELS(1:NATOMS,JP) ! <ds656366:       LABELSO(1:NATOMS,JP)=LABELS(1:NATOMS,JP) ! <ds656
368:       VATO(1:NATOMS,JP)=VAT(1:NATOMS,JP)367:       VATO(1:NATOMS,JP)=VAT(1:NATOMS,JP)
369:       EPSSPHERE=EPSSAVE368:       EPSSPHERE=EPSSAVE
370: 369: 
371:  
372: ! Initialisation 370: ! Initialisation 
373: 371: 
374:       IF (PTTMIN < 1.0D-6 ) PTTMIN = 1.0D-6 ! to avoid devision by zero372:       IF (PTTMIN < 1.0D-6 ) PTTMIN = 1.0D-6 ! to avoid devision by zero
375:       CTE=(LOG(PTTMAX/PTTMIN))/(NPAR-1)373:       CTE=(LOG(PTTMAX/PTTMIN))/(NPAR-1)
376:       CTE=EXP(CTE)374:       CTE=EXP(CTE)
377: 375: 
378:       DO I=0, NPAR-1376:       DO I=0, NPAR-1
379:          TEMPTRAJ(I)=PTTMIN*CTE**I377:          TEMPTRAJ(I)=PTTMIN*CTE**I
380:          T=TEMPTRAJ(I)378:          T=TEMPTRAJ(I)
381:          BETA(I)=1.0D0/T379:          BETA(I)=1.0D0/T
456:            ELSE454:            ELSE
457:               WRITE(MYUNIT,'(A,I10,A,G20.10,A,I5,A,G12.5,A,G20.10,A,F11.1)') 'Qu ',NQ(JP),' E=',455:               WRITE(MYUNIT,'(A,I10,A,G20.10,A,I5,A,G12.5,A,G20.10,A,F11.1)') 'Qu ',NQ(JP),' E=',
458:      1           POTEL,' steps=',ITERATIONS,' RMS=',RMS,' Markov E=',POTEL,' t=',TIME-TSTART456:      1           POTEL,' steps=',ITERATIONS,' RMS=',RMS,' Markov E=',POTEL,' t=',TIME-TSTART
459:            ENDIF457:            ENDIF
460:          ENDIF458:          ENDIF
461: 459: 
462: ! js850> initial dump460: ! js850> initial dump
463:       IF (DUMPUNIQUE) THEN461:       IF (DUMPUNIQUE) THEN
464:         CALL DUMPUNIQUE_DUMP(DUMPUNIQUEUNIT, JP, POTEL, DUMPUNIQUEEPREV )462:         CALL DUMPUNIQUE_DUMP(DUMPUNIQUEUNIT, JP, POTEL, DUMPUNIQUEEPREV )
465:       ENDIF463:       ENDIF
 464: 
466: ! Added dump of the initial structure, this is very useful for flu! csw34465: ! Added dump of the initial structure, this is very useful for flu! csw34
467:       IF (CHRMMT) CALL CHARMMDUMP(COORDS,'initialmin')466:       IF (CHRMMT) CALL CHARMMDUMP(COORDS,'initialmin')
468: 467: 
469: !     csw34> Added initial call to check_cistrans_protein to store cis/trans info for initial structure468: !     csw34> Added initial call to check_cistrans_protein to store cis/trans info for initial structure
470:          IF (AMBERT.AND.NOCISTRANS.AND.(.NOT.NOCISTRANSDNA).AND.(.NOT.NOCISTRANSRNA)) THEN469:          IF (AMBERT.AND.NOCISTRANS.AND.(.NOT.NOCISTRANSDNA).AND.(.NOT.NOCISTRANSRNA)) THEN
471:             WRITE(MYUNIT,'(A)') ' mc> Storing cis/trans information for initial structure'470:             WRITE(MYUNIT,'(A)') ' mc> Storing cis/trans information for initial structure'
472:             CALL check_cistrans_protein(COORDS(:,1),NATOMS,LOGDUMMY,MINOMEGA,cisarray1)471:             CALL check_cistrans_protein(COORDS(:,1),NATOMS,LOGDUMMY,MINOMEGA,cisarray1)
473:          ENDIF472:          ENDIF
474: !  EPREV saves the previous energy in the Markov chain.473: !  EPREV saves the previous energy in the Markov chain.
475: !  EBEST and JBEST record the lowest energy since the last reseeding and the474: !  EBEST and JBEST record the lowest energy since the last reseeding and the
759: !              ELSE758: !              ELSE
760: !                 CALL SYMMETRY2(JP,SCREENC,QDONE,BRUN,ITERATIONS,TIME,CHANGEDE,NSYMCALL)759: !                 CALL SYMMETRY2(JP,SCREENC,QDONE,BRUN,ITERATIONS,TIME,CHANGEDE,NSYMCALL)
761: !              ENDIF760: !              ENDIF
762: !              WRITE(MYUNIT,'(A,I2,A,2I6)') '[',JP,']mc> NCORE: ',NCORE(1:NPAR)761: !              WRITE(MYUNIT,'(A,I2,A,2I6)') '[',JP,']mc> NCORE: ',NCORE(1:NPAR)
763: !              IF (HIT) GOTO 37 ! hit cannot change in symmetry2 762: !              IF (HIT) GOTO 37 ! hit cannot change in symmetry2 
764: !763: !
765: !  Check for reseeding.764: !  Check for reseeding.
766: ! 765: ! 
767:                POTEL=EPREV(JP) ! NEWRES assumes POTEL is the energy of the current structure in COORDS766:                POTEL=EPREV(JP) ! NEWRES assumes POTEL is the energy of the current structure in COORDS
768:                IF (CHANGEDE.AND.NEWRESTART) THEN767:                IF (CHANGEDE.AND.NEWRESTART) THEN
769:                   !print *, 'line 768' 
770:                   CALL NEWRES(J1,JP,JBEST,EBEST,BESTCOORDS,EPPREV,POTEL,ITERATIONS,TIME,RCOORDS,768:                   CALL NEWRES(J1,JP,JBEST,EBEST,BESTCOORDS,EPPREV,POTEL,ITERATIONS,TIME,RCOORDS,
771:      1                  RMIN,RVAT,BRUN,SCREENC,QDONE,JACCPREV,NSUCCESS,NFAIL,NFAILT,NSUCCESST,RES1,RES2)769:      1                  RMIN,RVAT,BRUN,SCREENC,QDONE,JACCPREV,NSUCCESS,NFAIL,NFAILT,NSUCCESST,RES1,RES2)
772:                   IF(RES1.OR.RES2) QNEWRES=0770:                   IF(RES1.OR.RES2) QNEWRES=0
773:                ENDIF771:                ENDIF
774:             ELSEIF (ABS(ELASTSYM(JP)-EPREV(JP)).GT.ECONV) THEN ! Markov minimum has changed, but SYMMETRY not called772:             ELSEIF (ABS(ELASTSYM(JP)-EPREV(JP)).GT.ECONV) THEN ! Markov minimum has changed, but SYMMETRY not called
775:                NSYMREM=0                                       ! Should therefore reset NSYMREM.773:                NSYMREM=0                                       ! Should therefore reset NSYMREM.
776:             ENDIF774:             ENDIF
777: !775: !
778: !  Check for potential improvement for grand canonical relaxation block.776: !  Check for potential improvement for grand canonical relaxation block.
779: !777: !
1692:             ENDIF1690:             ENDIF
1693: 1691: 
1694: ! js850>1692: ! js850>
1695:           IF (DUMPUNIQUE) THEN1693:           IF (DUMPUNIQUE) THEN
1696:             CALL DUMPUNIQUE_DUMP(DUMPUNIQUEUNIT, JP, POTEL, DUMPUNIQUEEPREV )1694:             CALL DUMPUNIQUE_DUMP(DUMPUNIQUEUNIT, JP, POTEL, DUMPUNIQUEEPREV )
1697:           ENDIF1695:           ENDIF
1698:  1696:  
1699: !  Check for reseeding.1697: !  Check for reseeding.
1700:  1698:  
1701:             IF (NEWRESTART.AND.(.NOT.SEEDT)) THEN1699:             IF (NEWRESTART.AND.(.NOT.SEEDT)) THEN
1702:               !print *, 'line 1676' 
1703:               CALL NEWRES(J1,JP,JBEST,EBEST,BESTCOORDS,EPPREV,POTEL,ITERATIONS,TIME,RCOORDS,RMIN,RVAT,BRUN,SCREENC,QDONE,1700:               CALL NEWRES(J1,JP,JBEST,EBEST,BESTCOORDS,EPPREV,POTEL,ITERATIONS,TIME,RCOORDS,RMIN,RVAT,BRUN,SCREENC,QDONE,
1704:      &                    JACCPREV,NSUCCESS,NFAIL,NFAILT,NSUCCESST,RES1,RES2)1701:      &                    JACCPREV,NSUCCESS,NFAIL,NFAILT,NSUCCESST,RES1,RES2)
1705:               IF (RES1.OR.RES2) QNEWRES=01702:               IF (RES1.OR.RES2) QNEWRES=0
1706: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! DJW1703: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! DJW
1707: !             IF (CENT.AND.(.NOT.SEEDT)) CALL CENTRE2(COORDS(1:3*NATOMS,JP))1704: !             IF (CENT.AND.(.NOT.SEEDT)) CALL CENTRE2(COORDS(1:3*NATOMS,JP))
1708: !             COORDSO(1:3*(NATOMS-NSEED),JP)=COORDS(1:3*(NATOMS-NSEED),JP)1705: !             COORDSO(1:3*(NATOMS-NSEED),JP)=COORDS(1:3*(NATOMS-NSEED),JP)
1709: !             WRITE(MYUNIT,'(A,2G20.10)'),'mc> coordso changed: ',COORDSO(1,JP),COORDS(1,JP)     1706: !             WRITE(MYUNIT,'(A,2G20.10)'),'mc> coordso changed: ',COORDSO(1,JP),COORDS(1,JP)     
1710: !             VATO(1:NATOMS,JP)=VAT(1:NATOMS,JP)1707: !             VATO(1:NATOMS,JP)=VAT(1:NATOMS,JP)
1711: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! DJW1708: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! DJW
1712:             ENDIF1709:             ENDIF
3228:                      WRITE(MYUNIT,'(A)') 'newres> Full reseeding'3225:                      WRITE(MYUNIT,'(A)') 'newres> Full reseeding'
3229:                      IF(DMACRYST) THEN ! vr274> special reseeding for DMACRYS3226:                      IF(DMACRYST) THEN ! vr274> special reseeding for DMACRYS
3230:                         CALL DMACRYS_GENRANDOM(COORDS(:,JP))3227:                         CALL DMACRYS_GENRANDOM(COORDS(:,JP))
3231:                      ELSE IF (RIGID) THEN    ! jdf43> reseeding with uniform angle-axis distro & uniform spatial distro3228:                      ELSE IF (RIGID) THEN    ! jdf43> reseeding with uniform angle-axis distro & uniform spatial distro
3232:                         DO J2=1,NATOMS/23229:                         DO J2=1,NATOMS/2
3233:                            J4=J2*33230:                            J4=J2*3
3234:                            COORDS(J4-2:J4,JP)=VEC_RANDOM()*(DPRAND()**(1.D0/3.D0))*DSQRT(RADIUS)3231:                            COORDS(J4-2:J4,JP)=VEC_RANDOM()*(DPRAND()**(1.D0/3.D0))*DSQRT(RADIUS)
3235:                            J4=(J2+NATOMS/2)*33232:                            J4=(J2+NATOMS/2)*3
3236:                            COORDS(J4-2:J4,JP)=ROT_RANDOM_AA()3233:                            COORDS(J4-2:J4,JP)=ROT_RANDOM_AA()
3237:                         ENDDO3234:                         ENDDO
3238:                      ELSE IF (RIGIDINIT) THEN    ! dj337 > random rotation / translation for genrigid bodies 
3239:                         !print *, 'hey there, taking steps' 
3240:                         !print *, 'before: ', coords(:3*natoms,jp) 
3241:                         CALL GENRIGID_TRANSLATE(COORDS(:,JP), 0.5D0) 
3242:                         CALL GENRIGID_ROTATE(COORDS(:,JP), 1.D0) 
3243:                         !print *, 'after: ', coords(:3*natoms,jp) 
3244:                      ELSE3235:                      ELSE
3245:                         DO J2=1,3*NATOMS3236:                         DO J2=1,3*NATOMS
3246:                            RANDOM=(DPRAND()-0.5D0)*2.0D03237:                            RANDOM=(DPRAND()-0.5D0)*2.0D0
3247:                            COORDS(J2,JP)=RANDOM*DSQRT(RADIUS)/SR33238:                            COORDS(J2,JP)=RANDOM*DSQRT(RADIUS)/SR3
3248:                         ENDDO3239:                         ENDDO
3249:                      ENDIF3240:                      ENDIF
3250:                      NCORE(JP)=03241:                      NCORE(JP)=0
3251:                      PTGROUP(JP)='   '3242:                      PTGROUP(JP)='   '
3252:                   ENDIF3243:                   ENDIF
3253:                ELSEIF (NCORE(JP).GT.0) THEN3244:                ELSEIF (NCORE(JP).GT.0) THEN


r32452/mcruns.f90 2017-05-02 18:30:28.168518968 +0100 r32451/mcruns.f90 2017-05-02 18:30:31.724565207 +0100
 59:    ENDIF 59:    ENDIF
 60:  60: 
 61: ! jwrm2> If checking derivatives, call CHECKD, which then exits 61: ! jwrm2> If checking derivatives, call CHECKD, which then exits
 62:    IF (CHECKDT) THEN 62:    IF (CHECKDT) THEN
 63:       CALL CHECKD(COORDS(:, :)) 63:       CALL CHECKD(COORDS(:, :))
 64:    END IF 64:    END IF
 65:  65: 
 66: ! 66: !
 67: !  NRUNS > 1 is an obsolete option! DJW 67: !  NRUNS > 1 is an obsolete option! DJW
 68: ! 68: !
 69:  
 70:    DO I = 1, NRUNS 69:    DO I = 1, NRUNS
 71:       CALL MC(MCSTEPS(I), TFAC(I), SCREENC(:)) 70:       CALL MC(MCSTEPS(I), TFAC(I), SCREENC(:))
 72:    END DO 71:    END DO
 73:  72: 
 74: !     DO J1=1,NPAR 73: !     DO J1=1,NPAR
 75: !        CLOSE(DUMPVUNIT(J1)) 74: !        CLOSE(DUMPVUNIT(J1))
 76: !        CLOSE(DUMPXYZUNIT(J1)) 75: !        CLOSE(DUMPXYZUNIT(J1))
 77: !     ENDDO 76: !     ENDDO
 78: !     DUMPT=.FALSE. 77: !     DUMPT=.FALSE.
 79:  78: 


r32452/multipot.f90 2017-05-02 18:30:28.388521830 +0100 r32451/multipot.f90 2017-05-02 18:30:31.944568067 +0100
 50:     USE GENRIGID, ONLY: RIGIDINIT, RB_BY_ATOM 50:     USE GENRIGID, ONLY: RIGIDINIT, RB_BY_ATOM
 51:  51: 
 52:     IMPLICIT NONE 52:     IMPLICIT NONE
 53:  53: 
 54:     INTEGER NPARAMS, ATOM1, ATOM2 54:     INTEGER NPARAMS, ATOM1, ATOM2
 55:     INTEGER :: ATOMLIST(NATOMS) 55:     INTEGER :: ATOMLIST(NATOMS)
 56:     CHARACTER(LEN=1000) :: DUMMYCHAR 56:     CHARACTER(LEN=1000) :: DUMMYCHAR
 57:     LOGICAL :: END 57:     LOGICAL :: END
 58:     INTEGER :: J1, J2, J3, J4, iostatus, COUNTER 58:     INTEGER :: J1, J2, J3, J4, iostatus, COUNTER
 59:  59: 
 60:     ! dj337: Variables needed for binary potentials 
 61:     INTEGER :: NATOMS1, NATOMS2 
 62:     INTEGER, ALLOCATABLE :: ATOM1LIST(:), ATOM2LIST(:) 
 63:  
 64:     ! Variables needed to read in exclusion lists 60:     ! Variables needed to read in exclusion lists
 65:     INTEGER :: N_EXCLUDE_LINES, MAX_LINE_LENGTH 61:     INTEGER :: N_EXCLUDE_LINES, MAX_LINE_LENGTH
 66:     INTEGER, ALLOCATABLE :: LINE_LEN(:) 62:     INTEGER, ALLOCATABLE :: LINE_LEN(:)
 67:     INTEGER, ALLOCATABLE :: EXCLUSIONS(:,:)  ! Holds the indices of excluded interactions. EXCLUSIONS(l,m) contains 63:     INTEGER, ALLOCATABLE :: EXCLUSIONS(:,:)  ! Holds the indices of excluded interactions. EXCLUSIONS(l,m) contains
 68:                                              ! the m'th atom in the l'th set of excluded interactions for the current potential. 64:                                              ! the m'th atom in the l'th set of excluded interactions for the current potential.
 69:  65: 
 70:     ! Input file: multipotconfig 66:     ! Input file: multipotconfig
 71:     ! Format as follows. 67:     ! Format as follows.
 72:     ! 68:     !
 73:     ! Introduce each type of interaction with a line: 'POT' 69:     ! Introduce each type of interaction with a line: 'POT'
169:                 WRITE(MYUNIT,*) "Potential:", POTTYPES(J1)165:                 WRITE(MYUNIT,*) "Potential:", POTTYPES(J1)
170:                 WRITE(MYUNIT,*) "N_ATOM_PARTNERS:"166:                 WRITE(MYUNIT,*) "N_ATOM_PARTNERS:"
171:                 WRITE(MYUNIT,*) N_ATOM_PARTNERS(J1,:NATOM_BY_POT(J1))167:                 WRITE(MYUNIT,*) N_ATOM_PARTNERS(J1,:NATOM_BY_POT(J1))
172:                 WRITE(MYUNIT,*) "POTLISTS:"168:                 WRITE(MYUNIT,*) "POTLISTS:"
173:                 DO J2 = 1,NATOM_BY_POT(J1)169:                 DO J2 = 1,NATOM_BY_POT(J1)
174:                     WRITE(MYUNIT,*) "Atom number", J2, "in this potential"170:                     WRITE(MYUNIT,*) "Atom number", J2, "in this potential"
175:                     WRITE(MYUNIT,*) POTLISTS(J1,J2,:N_ATOM_PARTNERS(J1,J2))171:                     WRITE(MYUNIT,*) POTLISTS(J1,J2,:N_ATOM_PARTNERS(J1,J2))
176:                 ENDDO172:                 ENDDO
177:             ENDIF173:             ENDIF
178: 174: 
179:         ! dj337: For pairwise potentials which operate between two types of atoms. All the atoms of type 1 interact with the atoms 
180:         ! of type 2 but do not interact with themselves. This is essentially a binary potential by creating several  
181:         ! pairwise interactions. The input format is: 
182:         ! 
183:         ! type1_natoms type2_natoms 
184:         ! t1_atom1 t1_atom2 t1_atom3 ... 
185:         ! t2_atom1 t2_atom2 t2_atom3 ... 
186:         ! 
187:         ! where type1_natoms is the number of atoms of the first type and type2_natoms is the number of atoms of the second type. 
188:         ! In the second line, list all the type1 atoms using this potential on a single line, separated by spaces. 
189:         ! In the third line, list all the type2 atoms. 
190:         CASE('BLJ') 
191:             READ(22,*) DUMMYCHAR 
192:             READ(22,*) NATOMS1, NATOMS2 
193:  
194:             ! allocate atom lists for type1 and type2 atoms 
195:             IF (ALLOCATED(ATOM1LIST)) DEALLOCATE(ATOM1LIST) 
196:             IF (ALLOCATED(ATOM2LIST)) DEALLOCATE(ATOM2LIST) 
197:             ALLOCATE(ATOM1LIST(NATOMS1)) 
198:             ALLOCATE(ATOM2LIST(NATOMS2)) 
199:  
200:             ! read atom lists 
201:             READ(22,*) ATOM1LIST(:NATOMS1) 
202:             READ(22,*) ATOM2LIST(:NATOMS2) 
203:  
204:             DO J2 = 1, NATOMS1 
205:                 ! create entries for all type1 atoms 
206:                 POTLISTS(J1,J2,1) = ATOM1LIST(J2) 
207:                 N_ATOM_PARTNERS(J1,J2) = NATOMS2 
208:                 ! populate partners with type2 atoms 
209:                 DO J3 = 1, NATOMS2 
210:                     POTLISTS(J1,J2,1+J3) = ATOM2LIST(J3) 
211:                 ENDDO 
212:             ENDDO 
213:  
214:             ! create entries for all type2 atoms and set n_partners to 0 
215:             DO J3 = 1, NATOMS2 
216:                 POTLISTS(J1,NATOMS1+J3,1) = ATOM2LIST(J3) 
217:                 N_ATOM_PARTNERS(J1,NATOMS1+J3) = 0 
218:             ENDDO 
219:  
220:         ! dj337: Coulomb potential where all atoms interact with one another 
221:         ! The input format is the same as for ILJ and IWCA (defined below) 
222:         CASE('ICOU') 
223:             READ(22,*) ATOMLIST(:NATOM_BY_POT(J1)) 
224:  
225:             ! create entries for all atoms 
226:             DO J2=1, NATOM_BY_POT(J1) 
227:                N_ATOM_PARTNERS(J1,J2) = 0 
228:                POTLISTS(J1,J2,1) = ATOMLIST(J2) 
229:                ! populate entries, preventing double counting 
230:                DO J3=J2+1, NATOM_BY_POT(J1) 
231:                   N_ATOM_PARTNERS(J1,J2) = N_ATOM_PARTNERS(J1,J2) + 1 
232:                   POTLISTS(J1,J2,1+N_ATOM_PARTNERS(J1,J2)) = ATOMLIST(J3) 
233:                ENDDO 
234:            ENDDO 
235:  
236:         ! dj337: Coulomb potential where all type1 atoms interact with all type2 atoms 
237:         ! The input format is the same as for BLJ (defined above) 
238:         CASE('BCOU') 
239:             READ(22,*) DUMMYCHAR 
240:             READ(22,*) NATOMS1, NATOMS2 
241:  
242:             ! allocate atom lists for type1 and type2 atoms 
243:             IF (ALLOCATED(ATOM1LIST)) DEALLOCATE(ATOM1LIST) 
244:             IF (ALLOCATED(ATOM2LIST)) DEALLOCATE(ATOM2LIST) 
245:             ALLOCATE(ATOM1LIST(NATOMS1)) 
246:             ALLOCATE(ATOM2LIST(NATOMS2)) 
247:  
248:             ! read atom lists 
249:             READ(22,*) ATOM1LIST(:NATOMS1) 
250:             READ(22,*) ATOM2LIST(:NATOMS2) 
251:  
252:             DO J2 = 1, NATOMS1 
253:                 ! create entries for all type1 atoms 
254:                 POTLISTS(J1,J2,1) = ATOM1LIST(J2) 
255:                 N_ATOM_PARTNERS(J1,J2) = NATOMS2 
256:                 ! populate partners with type2 atoms 
257:                 DO J3 = 1, NATOMS2 
258:                     POTLISTS(J1,J2,1+J3) = ATOM2LIST(J3) 
259:                 ENDDO 
260:             ENDDO 
261:  
262:             ! create entries for all type2 atoms and set n_partners to 0 
263:             DO J3 = 1, NATOMS2 
264:                 POTLISTS(J1,NATOMS1+J3,1) = ATOM2LIST(J3) 
265:                 N_ATOM_PARTNERS(J1,NATOMS1+J3) = 0 
266:             ENDDO 
267:  
268:         ! For "iso_" potentials. Every specified atom with this potential type interacts with all the others.175:         ! For "iso_" potentials. Every specified atom with this potential type interacts with all the others.
269:         ! The input format is simple: list all the atoms using this potential on a single line, separated by spaces.176:         ! The input format is simple: list all the atoms using this potential on a single line, separated by spaces.
270:         ! They don't have to be in index order, but everything will make more sense if they are!177:         ! They don't have to be in index order, but everything will make more sense if they are!
271:         ! There is currently no facility to exclude the interactions within a rigid body. Use EWCA/ELJ if you need that.178:         ! There is currently no facility to exclude the interactions within a rigid body. Use EWCA/ELJ if you need that.
272:         CASE('ILJ','IWCA')179:         CASE('ILJ','IWCA')
273:             READ(22,*) ATOMLIST(:NATOM_BY_POT(J1))180:             READ(22,*) ATOMLIST(:NATOM_BY_POT(J1))
274: 181: 
275:             ! All we need to save for this type of potential is the list of whole-system degrees of freedom on which182:             ! All we need to save for this type of potential is the list of whole-system degrees of freedom on which
276:             ! the potential will depend.183:             ! the potential will depend.
277:             DO J2=1,NATOM_BY_POT(J1)184:             DO J2=1,NATOM_BY_POT(J1)
443:                 CALL COMPUTE_ISOTROPIC_POTENTIAL(X, G, ENERGY, GTEST, STEST, ISO_LJ, J1, THISN)350:                 CALL COMPUTE_ISOTROPIC_POTENTIAL(X, G, ENERGY, GTEST, STEST, ISO_LJ, J1, THISN)
444:             CASE('IWCA')351:             CASE('IWCA')
445:                 ! Only one parameter for this potential: the particle radius, sigma352:                 ! Only one parameter for this potential: the particle radius, sigma
446:                 CALL COMPUTE_ISOTROPIC_POTENTIAL(X, G, ENERGY, GTEST, STEST, ISO_WCA, J1, THISN)353:                 CALL COMPUTE_ISOTROPIC_POTENTIAL(X, G, ENERGY, GTEST, STEST, ISO_WCA, J1, THISN)
447:             CASE('PLJ')354:             CASE('PLJ')
448:                 ! Only one parameter for this potential: the particle radius, sigma355:                 ! Only one parameter for this potential: the particle radius, sigma
449:                 CALL COMPUTE_PAIRWISE_POTENTIAL(X, G, ENERGY, GTEST, STEST, PAIRWISE_LJ, J1)356:                 CALL COMPUTE_PAIRWISE_POTENTIAL(X, G, ENERGY, GTEST, STEST, PAIRWISE_LJ, J1)
450:             CASE('PWCA')357:             CASE('PWCA')
451:                 ! Only one parameter for this potential: the particle radius, sigma358:                 ! Only one parameter for this potential: the particle radius, sigma
452:                 CALL COMPUTE_PAIRWISE_POTENTIAL(X, G, ENERGY, GTEST, STEST, PAIRWISE_WCA, J1)359:                 CALL COMPUTE_PAIRWISE_POTENTIAL(X, G, ENERGY, GTEST, STEST, PAIRWISE_WCA, J1)
453:             CASE('BLJ') 
454:                 CALL COMPUTE_PAIRWISE_POTENTIAL(X, G, ENERGY, GTEST, STEST, PAIRWISE_LJ, J1) 
455:             CASE('HSPR')360:             CASE('HSPR')
456:                 ! Parameter is the equilibrium bond length, R0. Energy is returned in units of k_spr.361:                 ! Parameter is the equilibrium bond length, R0. Energy is returned in units of k_spr.
457:                 CALL COMPUTE_PAIRWISE_POTENTIAL(X, G, ENERGY, GTEST, STEST, HARMONIC_SPRINGS, J1)362:                 CALL COMPUTE_PAIRWISE_POTENTIAL(X, G, ENERGY, GTEST, STEST, HARMONIC_SPRINGS, J1)
458:             ! For exclusion potentials, we must also pass in a list specifying the number of interacting partners possessed363:             ! For exclusion potentials, we must also pass in a list specifying the number of interacting partners possessed
459:             ! by each atom, and a list specifying which atoms make up these partners (from POTLISTS)364:             ! by each atom, and a list specifying which atoms make up these partners (from POTLISTS)
460:             CASE('ELJ')365:             CASE('ELJ')
461:                 ! Only one parameter for this potential: the particle radius, sigma366:                 ! Only one parameter for this potential: the particle radius, sigma
462:                 CALL EXCLUDE_ISO_LJ(X, POTLISTS(J1,:THISN,:), N_ATOM_PARTNERS(J1,:THISN), POTSCALES(J1), THESEPARAMS, ENERGY, G, GTEST, STEST)367:                 CALL EXCLUDE_ISO_LJ(X, POTLISTS(J1,:THISN,:), N_ATOM_PARTNERS(J1,:THISN), POTSCALES(J1), THESEPARAMS, ENERGY, G, GTEST, STEST)
463:             CASE('EWCA')368:             CASE('EWCA')
464:                 ! Only one parameter for this potential: the particle radius, sigma369:                  ! Only one parameter for this potential: the particle radius, sigma
465:                 CALL EXCLUDE_ISO_WCA(X, POTLISTS(J1,:THISN,:), N_ATOM_PARTNERS(J1,:THISN), POTSCALES(J1), THESEPARAMS, ENERGY, G, GTEST, STEST)370:                 CALL EXCLUDE_ISO_WCA(X, POTLISTS(J1,:THISN,:), N_ATOM_PARTNERS(J1,:THISN), POTSCALES(J1), THESEPARAMS, ENERGY, G, GTEST, STEST)
466:             CASE('ICOU') 
467:                 ! Two parameters for this potential: the charges for the atoms (these numbers should be the same) 
468:                 CALL ISO_COULOMB(X, POTLISTS(J1,:THISN,:), N_ATOM_PARTNERS(J1,:THISN), POTSCALES(J1), THESEPARAMS, ENERGY, G, GTEST, STEST) 
469:             CASE('BCOU') 
470:                 ! Two parameters for this potential: the charge for type1 atom and for type2 atom (they should be different) 
471:                 CALL ISO_COULOMB(X, POTLISTS(J1,:THISN,:), N_ATOM_PARTNERS(J1,:THISN), POTSCALES(J1), THESEPARAMS, ENERGY, G, GTEST, STEST) 
472:             CASE DEFAULT371:             CASE DEFAULT
473:                 ! We shouldn't every get here, unless you have added a new type of potential to MULTIPOT_INITIALISE and forgotten372:                 ! We shouldn't every get here, unless you have added a new type of potential to MULTIPOT_INITIALISE and forgotten
474:                 ! to add it to this SELECT CASE.373:                 ! to add it to this SELECT CASE.
475:                 WRITE(MYUNIT,*) "multipot> Error: unspecified potential"374:                 WRITE(MYUNIT,*) "multipot> Error: unspecified potential"
476:                 STOP375:                 STOP
477:         END SELECT376:         END SELECT
478:     ENDDO377:     ENDDO
479: 378: 
480:  
481: END SUBROUTINE MULTIPOT_CALL379: END SUBROUTINE MULTIPOT_CALL
482: 380: 
483: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!381: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
484: !   Evaluate the energy(+gradient(+hessian)) for a set of atoms interacting according to this particular potential382: !   Evaluate the energy(+gradient(+hessian)) for a set of atoms interacting according to this particular potential
485: SUBROUTINE COMPUTE_ISOTROPIC_POTENTIAL(X, G, ENERGY, GTEST, STEST, POT, POTID, TMP_NATOMS)383: SUBROUTINE COMPUTE_ISOTROPIC_POTENTIAL(X, G, ENERGY, GTEST, STEST, POT, POTID, TMP_NATOMS)
486:     USE COMMONS, ONLY: NATOMS384:     USE COMMONS, ONLY: NATOMS
487:     USE MODHESS385:     USE MODHESS
488:     IMPLICIT NONE386:     IMPLICIT NONE
489:     DOUBLE PRECISION, INTENT(IN)    :: X(3*NATOMS)387:     DOUBLE PRECISION, INTENT(IN)    :: X(3*NATOMS)
490:     DOUBLE PRECISION, INTENT(INOUT) :: G(3*NATOMS)388:     DOUBLE PRECISION, INTENT(INOUT) :: G(3*NATOMS)
499:         SUBROUTINE POT(TMP_NATOMS, X, PARAMS, TMP_ENERGY, TMP_G, TMP_HESS, GTEST, STEST)397:         SUBROUTINE POT(TMP_NATOMS, X, PARAMS, TMP_ENERGY, TMP_G, TMP_HESS, GTEST, STEST)
500:             INTEGER, INTENT(IN)           :: TMP_NATOMS398:             INTEGER, INTENT(IN)           :: TMP_NATOMS
501:             DOUBLE PRECISION, INTENT(IN)  :: X(3*TMP_NATOMS)399:             DOUBLE PRECISION, INTENT(IN)  :: X(3*TMP_NATOMS)
502:             DOUBLE PRECISION, INTENT(IN)  :: PARAMS(10)  ! Maximum number of parameters is hardcoded here400:             DOUBLE PRECISION, INTENT(IN)  :: PARAMS(10)  ! Maximum number of parameters is hardcoded here
503:             DOUBLE PRECISION, INTENT(OUT) :: TMP_ENERGY401:             DOUBLE PRECISION, INTENT(OUT) :: TMP_ENERGY
504:             DOUBLE PRECISION, INTENT(OUT) :: TMP_G(3*TMP_NATOMS), TMP_HESS(3*TMP_NATOMS,3*TMP_NATOMS)402:             DOUBLE PRECISION, INTENT(OUT) :: TMP_G(3*TMP_NATOMS), TMP_HESS(3*TMP_NATOMS,3*TMP_NATOMS)
505:             LOGICAL, INTENT(IN)           :: GTEST, STEST403:             LOGICAL, INTENT(IN)           :: GTEST, STEST
506:         END SUBROUTINE POT404:         END SUBROUTINE POT
507:     END INTERFACE405:     END INTERFACE
508: 406: 
509:  
510:     NDEGS = 3*TMP_NATOMS407:     NDEGS = 3*TMP_NATOMS
511: 408: 
512:     DO J1 = 1, NDEGS  ! Loop over all the atoms with this kind of potential409:     DO J1 = 1, NDEGS  ! Loop over all the atoms with this kind of potential
513:         TMP_X(J1) = X(DEGS_BY_POT(POTID,J1))410:         TMP_X(J1) = X(DEGS_BY_POT(POTID,J1))
514:     ENDDO411:     ENDDO
515: 412: 
516: !    IF(DEBUG) THEN413: !    IF(DEBUG) THEN
517: !        WRITE(MYUNIT,*) "Calling potential", POTTYPES(J1)414: !        WRITE(MYUNIT,*) "Calling potential", POTTYPES(J1)
518: !        WRITE(MYUNIT,*) "Degrees of freedom being used:"415: !        WRITE(MYUNIT,*) "Degrees of freedom being used:"
519: !        WRITE(MYUNIT,*) DEGS_BY_POT(POTID,:NDEGS)416: !        WRITE(MYUNIT,*) DEGS_BY_POT(POTID,:NDEGS)


r32452/paha.f90 2017-05-02 18:30:28.608524689 +0100 r32451/paha.f90 2017-05-02 18:30:32.172571035 +0100
  1:       SUBROUTINE PAHA (X, G, ENERGY, GTEST)  1:       SUBROUTINE PAHA (X, G, ENERGY, GTEST)
  2:   2: 
  3:       USE COMMONS, ONLY: NATOMS, NRBSITES, NCARBON, SITE, RBSTLA, STCHRG, RHOCC0, RHOCC10, RHOCC20, &  3:       USE COMMONS, ONLY: NATOMS, NRBSITES, NCARBON, SITE, RBSTLA, STCHRG, RHOCC0, RHOCC10, RHOCC20, &
  4:      &                   RHOHH0, RHOHH10, RHOHH20, RHOCH0, RHOC10H, RHOCH10, RHOC20H, RHOCH20,      &  4:      &                   RHOHH0, RHOHH10, RHOHH20, RHOCH0, RHOC10H, RHOCH10, RHOC20H, RHOCH20,      &
  5:      &                   ALPHACC, ALPHAHH, ALPHACH, DC6CC, DC6HH, DC6CH, KKJ, CCKJ  5:      &                   ALPHACC, ALPHAHH, ALPHACH, DC6CC, DC6HH, DC6CH, KKJ, CCKJ
  6:   6: 
  7:       IMPLICIT NONE  7:       IMPLICIT NONE
  8:   8: 
  9:       INTEGER          :: I, J, K, J1, J2, J3, J4, J5, J6, J7, J8, REALNATOMS, OFFSET, FCT(6)   9:       INTEGER          :: I, J, K, J1, J2, J3, J4, J5, J6, J7, J8, REALNATOMS, OFFSET, FCT(6) 
 10:       DOUBLE PRECISION :: X(3*NATOMS), G(3*NATOMS), xr(3*natoms) 10:       DOUBLE PRECISION :: X(3*NATOMS), G(3*NATOMS)
 11:       DOUBLE PRECISION :: ENERGY, R2, R4, R6, R12, ABSRIJ, RIJSQ, DVDR, ENERGY1, ENERGY2, ENERGY3 11:       DOUBLE PRECISION :: ENERGY, R2, R4, R6, R12, ABSRIJ, RIJSQ, DVDR, ENERGY1, ENERGY2, ENERGY3
 12:       DOUBLE PRECISION :: RI(3), RJ(3), RSS(3), NR(3), P(3), EI(3), EJ(3), FRIJ(3), TIJ(3), TJI(3)  12:       DOUBLE PRECISION :: RI(3), RJ(3), RSS(3), NR(3), P(3), EI(3), EJ(3), FRIJ(3), TIJ(3), TJI(3) 
 13:       DOUBLE PRECISION :: R(NATOMS*NRBSITES/2,3), E(3*NATOMS*NRBSITES/2,3) 13:       DOUBLE PRECISION :: R(NATOMS*NRBSITES/2,3), E(3*NATOMS*NRBSITES/2,3)
 14:       DOUBLE PRECISION :: DR1(NATOMS*NRBSITES/2,3), DR2(NATOMS*NRBSITES/2,3), DR3(NATOMS*NRBSITES/2,3)  14:       DOUBLE PRECISION :: DR1(NATOMS*NRBSITES/2,3), DR2(NATOMS*NRBSITES/2,3), DR3(NATOMS*NRBSITES/2,3) 
 15:       DOUBLE PRECISION :: DE1(3*NATOMS*NRBSITES/2,3), DE2(3*NATOMS*NRBSITES/2,3), DE3(3*NATOMS*NRBSITES/2,3) 15:       DOUBLE PRECISION :: DE1(3*NATOMS*NRBSITES/2,3), DE2(3*NATOMS*NRBSITES/2,3), DE3(3*NATOMS*NRBSITES/2,3)
 16:       DOUBLE PRECISION :: RMI(3,3), DRMI1(3,3), DRMI2(3,3), DRMI3(3,3), DCADR(3), DCBDR(3) 16:       DOUBLE PRECISION :: RMI(3,3), DRMI1(3,3), DRMI2(3,3), DRMI3(3,3), DCADR(3), DCBDR(3)
 17:       DOUBLE PRECISION :: RHOCC, RHOHH, RHOCH, COSTA, COSTB, DMPFCT, DDMPDR, EXPFCT  17:       DOUBLE PRECISION :: RHOCC, RHOHH, RHOCH, COSTA, COSTB, DMPFCT, DDMPDR, EXPFCT 
 18:       DOUBLE PRECISION :: DRIJDPI(3), DRIJDPJ(3), DCADPI(3), DCBDPI(3), DCADPJ(3), DCBDPJ(3) 18:       DOUBLE PRECISION :: DRIJDPI(3), DRIJDPJ(3), DCADPI(3), DCBDPI(3), DCADPJ(3), DCBDPJ(3)
 19:       DOUBLE PRECISION, PARAMETER :: B = 1.6485D0, EB = 2.0D0 19:       DOUBLE PRECISION, PARAMETER :: B = 1.6485D0, EB = 2.0D0
 20:       LOGICAL          :: GTEST 20:       LOGICAL          :: GTEST
 21:  21: 
 22:       FCT(1) = 1; FCT(2) = 2; FCT(3) = 6; FCT(4) = 24; FCT(5) = 120; FCT(6) = 720 22:       FCT(1) = 1; FCT(2) = 2; FCT(3) = 6; FCT(4) = 24; FCT(5) = 120; FCT(6) = 720
 23:       ENERGY = 0.D0; ENERGY1 = 0.D0; ENERGY2 = 0.D0; ENERGY3 = 0.D0 23:       ENERGY = 0.D0; ENERGY1 = 0.D0; ENERGY2 = 0.D0; ENERGY3 = 0.D0
 24:  24: 
 25:       IF (GTEST) G(:) = 0.D0 25:       IF (GTEST) G(:) = 0.D0
 26:  26: 
 27:       ! dj337: changed from REALNATOMS=NRBSITES/2 27:       REALNATOMS = NATOMS/2
 28:       REALNATOMS = 13 
 29:       OFFSET     = 3*REALNATOMS 28:       OFFSET     = 3*REALNATOMS
 30:  29:   
 31:       DO J1 = 1, REALNATOMS 30:       DO J1 = 1, REALNATOMS
 32:  31: 
 33:          J3 = 3*J1 32:          J3 = 3*J1
 34:          J5 = OFFSET + J3 33:          J5 = OFFSET + J3
 35:          RI = X(J3-2:J3) 34:          RI = X(J3-2:J3)
 36:          P  = X(J5-2:J5) 35:          P  = X(J5-2:J5)
 37:  36: 
 38:          CALL RMDRVT(P, RMI, DRMI1, DRMI2, DRMI3, GTEST) 37:          CALL RMDRVT(P, RMI, DRMI1, DRMI2, DRMI3, GTEST)
 39:  38: 
 40:          DO J2 = 1, NRBSITES 39:          DO J2 = 1, NRBSITES
 41:  40: 
 42:             J4      = NRBSITES*(J1-1) + J2 41:             J4      = NRBSITES*(J1-1) + J2
 43:             R(J4,:) = RI(:) + MATMUL(RMI(:,:),SITE(J2,:)) 42:             R(J4,:) = RI(:) + MATMUL(RMI(:,:),SITE(J2,:))
 44:             !print *, r(j4,:) 
 45:             E(J4,:) = MATMUL(RMI(:,:),RBSTLA(J2,:)) 43:             E(J4,:) = MATMUL(RMI(:,:),RBSTLA(J2,:))
 46:  44: 
 47:             IF (GTEST) THEN 45:             IF (GTEST) THEN
 48:  46: 
 49:                DR1(J4,:) = MATMUL(DRMI1(:,:),SITE(J2,:)) 47:                DR1(J4,:) = MATMUL(DRMI1(:,:),SITE(J2,:))
 50:                DR2(J4,:) = MATMUL(DRMI2(:,:),SITE(J2,:)) 48:                DR2(J4,:) = MATMUL(DRMI2(:,:),SITE(J2,:))
 51:                DR3(J4,:) = MATMUL(DRMI3(:,:),SITE(J2,:)) 49:                DR3(J4,:) = MATMUL(DRMI3(:,:),SITE(J2,:))
 52:  50: 
 53:                DE1(J4,:) = MATMUL(DRMI1(:,:),RBSTLA(J2,:)) 51:                DE1(J4,:) = MATMUL(DRMI1(:,:),RBSTLA(J2,:))
 54:                DE2(J4,:) = MATMUL(DRMI2(:,:),RBSTLA(J2,:)) 52:                DE2(J4,:) = MATMUL(DRMI2(:,:),RBSTLA(J2,:))
 64:  62: 
 65:          J3 = 3*J1 63:          J3 = 3*J1
 66:          J5 = OFFSET + J3 64:          J5 = OFFSET + J3
 67:  65: 
 68:          RI(:)  = X(J3-2:J3) 66:          RI(:)  = X(J3-2:J3)
 69:  67: 
 70:          DO I = 1, NRBSITES 68:          DO I = 1, NRBSITES
 71:  69: 
 72:             J7    = NRBSITES*(J1-1) + I 70:             J7    = NRBSITES*(J1-1) + I
 73:             EI(:) = E(J7,:) 71:             EI(:) = E(J7,:)
 74:  72:                
 75:             DO J2 = J1 + 1, REALNATOMS 73:             DO J2 = J1 + 1, REALNATOMS
 76:  74: 
 77:                J4 = 3*J2 75:                J4 = 3*J2
 78:                J6 = OFFSET + J4 76:                J6 = OFFSET + J4
 79:  77: 
 80:                DO J = 1, NRBSITES 78:                DO J = 1, NRBSITES
 81:  79: 
 82:                   J8     = NRBSITES*(J2-1) + J 80:                   J8     = NRBSITES*(J2-1) + J
 83:                   EJ(:)  = E(J8,:) 81:                   EJ(:)  = E(J8,:)
 84:                   RSS(:) = R(J7,:) - R(J8,:) 82:                   RSS(:) = R(J7,:) - R(J8,:)
 97:  95: 
 98:                      DMPFCT = DMPFCT + (B*ABSRIJ)**K/FLOAT(FCT(K)) 96:                      DMPFCT = DMPFCT + (B*ABSRIJ)**K/FLOAT(FCT(K))
 99:                      IF (K > 1) DDMPDR = DDMPDR + (B**K)*(ABSRIJ)**(K-1)/FLOAT(FCT(K-1)) 97:                      IF (K > 1) DDMPDR = DDMPDR + (B**K)*(ABSRIJ)**(K-1)/FLOAT(FCT(K-1))
100:  98: 
101:                   END DO 99:                   END DO
102: 100: 
103:                   EXPFCT = DEXP(-B*ABSRIJ)101:                   EXPFCT = DEXP(-B*ABSRIJ)
104:                   DDMPDR = (B*EXPFCT*DMPFCT - EXPFCT*DDMPDR)/ABSRIJ102:                   DDMPDR = (B*EXPFCT*DMPFCT - EXPFCT*DDMPDR)/ABSRIJ
105:                   DMPFCT = 1.D0 - EXPFCT*DMPFCT103:                   DMPFCT = 1.D0 - EXPFCT*DMPFCT
106: 104: 
 105: 
107: !     NOW CALCULATE RHOAB106: !     NOW CALCULATE RHOAB
108: 107: 
109:                   COSTA      =-DOT_PRODUCT(NR(:),EI(:))108:                   COSTA      =-DOT_PRODUCT(NR(:),EI(:))
110:                   COSTB      = DOT_PRODUCT(NR(:),EJ(:))109:                   COSTB      = DOT_PRODUCT(NR(:),EJ(:))
111: 110: 
112:                   IF (GTEST) THEN111:                   IF (GTEST) THEN
113: 112: 
114:                      DCADR(:)   =-EI(:)/ABSRIJ - COSTA*R2*RSS(:)113:                      DCADR(:)   =-EI(:)/ABSRIJ - COSTA*R2*RSS(:)
115:                      DCBDR(:)   = EJ(:)/ABSRIJ - COSTB*R2*RSS(:)114:                      DCBDR(:)   = EJ(:)/ABSRIJ - COSTB*R2*RSS(:)
116: 115: 
312: !      SITE(4,:)  = (/ 1.31961715421850,  -2.28564395764590,   0.00000000000000/)311: !      SITE(4,:)  = (/ 1.31961715421850,  -2.28564395764590,   0.00000000000000/)
313: !      SITE(5,:)  = (/-1.31961715421850,   2.28564395764590,   0.00000000000000/)312: !      SITE(5,:)  = (/-1.31961715421850,   2.28564395764590,   0.00000000000000/)
314: !      SITE(6,:)  = (/ 1.31961715421850,   2.28564395764590,   0.00000000000000/)313: !      SITE(6,:)  = (/ 1.31961715421850,   2.28564395764590,   0.00000000000000/)
315: !      SITE(7,:)  = (/-4.69338981379532,   0.00000000000000,   0.00000000000000/)314: !      SITE(7,:)  = (/-4.69338981379532,   0.00000000000000,   0.00000000000000/)
316: !      SITE(8,:)  = (/ 4.69338981379532,   0.00000000000000,   0.00000000000000/)315: !      SITE(8,:)  = (/ 4.69338981379532,   0.00000000000000,   0.00000000000000/)
317: !      SITE(9,:)  = (/ 2.34669490689766,   4.06459480860986,   0.00000000000000/)316: !      SITE(9,:)  = (/ 2.34669490689766,   4.06459480860986,   0.00000000000000/)
318: !      SITE(10,:) = (/-2.34669490689766,   4.06459480860986,   0.00000000000000/)317: !      SITE(10,:) = (/-2.34669490689766,   4.06459480860986,   0.00000000000000/)
319: !      SITE(11,:) = (/ 2.34669490689766,  -4.06459480860986,   0.00000000000000/)318: !      SITE(11,:) = (/ 2.34669490689766,  -4.06459480860986,   0.00000000000000/)
320: !      SITE(12,:) = (/-2.34669490689766,  -4.06459480860986,   0.00000000000000/)319: !      SITE(12,:) = (/-2.34669490689766,  -4.06459480860986,   0.00000000000000/)
321: 320: 
322:  
323:       SITE(1,:)  = (/ 2.63923430843701,   0.00000000000000,   0.00000000000000/)321:       SITE(1,:)  = (/ 2.63923430843701,   0.00000000000000,   0.00000000000000/)
324:       SITE(2,:)  = (/ 1.31961715421850,  -2.28564395764590,   0.00000000000000/)322:       SITE(2,:)  = (/ 1.31961715421850,  -2.28564395764590,   0.00000000000000/)
325:       SITE(3,:)  = (/-1.31961715421850,  -2.28564395764590,   0.00000000000000/)323:       SITE(3,:)  = (/-1.31961715421850,  -2.28564395764590,   0.00000000000000/)
326:       SITE(4,:)  = (/-2.63923430843701,   0.00000000000000,   0.00000000000000/)324:       SITE(4,:)  = (/-2.63923430843701,   0.00000000000000,   0.00000000000000/)
327:       SITE(5,:)  = (/-1.31961715421850,   2.28564395764590,   0.00000000000000/)325:       SITE(5,:)  = (/-1.31961715421850,   2.28564395764590,   0.00000000000000/)
328:       SITE(6,:)  = (/ 1.31961715421850,   2.28564395764590,   0.00000000000000/)326:       SITE(6,:)  = (/ 1.31961715421850,   2.28564395764590,   0.00000000000000/)
329:       SITE(7,:)  = (/ 4.69338981379532,   0.00000000000000,   0.00000000000000/)327:       SITE(7,:)  = (/ 4.69338981379532,   0.00000000000000,   0.00000000000000/)
330:       SITE(8,:)  = (/ 2.34669490689766,  -4.06459480860986,   0.00000000000000/)328:       SITE(8,:)  = (/ 2.34669490689766,  -4.06459480860986,   0.00000000000000/)
331:       SITE(9,:)  = (/-2.34669490689766,  -4.06459480860986,   0.00000000000000/)329:       SITE(9,:)  = (/-2.34669490689766,  -4.06459480860986,   0.00000000000000/)
332:       SITE(10,:) = (/-4.69338981379532,   0.00000000000000,   0.00000000000000/)330:       SITE(10,:) = (/-4.69338981379532,   0.00000000000000,   0.00000000000000/)


r32452/pahagenrigid.f90 2017-05-02 18:30:28.832527602 +0100 r32451/pahagenrigid.f90 2017-05-02 18:30:32.388573843 +0100
  1:       SUBROUTINE PAHAGENRIGID (X, G, ENERGY, GTEST)  1: svn: E195012: Unable to find repository location for 'svn+ssh://svn.ch.private.cam.ac.uk/groups/wales/trunk/GMIN/source/pahagenrigid.f90' in revision 32451
  2:  
  3:       USE COMMONS, ONLY: NATOMS, NCARBON, RBSTLA, STCHRG, RHOCC0, RHOCC10, RHOCC20, & 
  4:      &                   RHOHH0, RHOHH10, RHOHH20, RHOCH0, RHOC10H, RHOCH10, RHOC20H, RHOCH20,      & 
  5:      &                   ALPHACC, ALPHAHH, ALPHACH, DC6CC, DC6HH, DC6CH, KKJ, CCKJ 
  6:  
  7:       ! dj337: PAHA adapted to the genrigid framework 
  8:       USE GENRIGID, ONLY: NRIGIDBODY, ATOMRIGIDCOORDT, TRANSFORMCTORIGID, NSITEPERBODY, & 
  9:      &                    MAXSITE, SITESRIGIDBODY, TRANSFORMRIGIDTOC 
 10:  
 11:       IMPLICIT NONE 
 12:  
 13:       INTEGER          :: I, J, K, J1, J2, J3, J4, J5, J6, J7, J8, OFFSET, FCT(6)  
 14:       DOUBLE PRECISION :: X(3*NATOMS), G(3*NATOMS), XR(3*NATOMS) 
 15:       DOUBLE PRECISION :: ENERGY, R2, R6, ABSRIJ, DVDR, ENERGY1, ENERGY2, ENERGY3 
 16:       DOUBLE PRECISION :: RI(3), RSS(3), NR(3), P(3), EI(3), EJ(3), FRIJ(3), TIJ(3), TJI(3)  
 17:       DOUBLE PRECISION :: R(MAXSITE*NRIGIDBODY,3), E(3*MAXSITE*NRIGIDBODY,3) 
 18:       DOUBLE PRECISION :: DR1(MAXSITE*NRIGIDBODY,3), DR2(MAXSITE*NRIGIDBODY,3), DR3(MAXSITE*NRIGIDBODY,3) 
 19:       DOUBLE PRECISION :: DE1(3*MAXSITE*NRIGIDBODY,3), DE2(3*MAXSITE*NRIGIDBODY,3), DE3(3*MAXSITE*NRIGIDBODY,3) 
 20:       DOUBLE PRECISION :: RMI(3,3), DRMI1(3,3), DRMI2(3,3), DRMI3(3,3), DCADR(3), DCBDR(3) 
 21:       DOUBLE PRECISION :: RHOCC, RHOHH, RHOCH, COSTA, COSTB, DMPFCT, DDMPDR, EXPFCT  
 22:       DOUBLE PRECISION :: DRIJDPI(3), DRIJDPJ(3), DCADPI(3), DCBDPI(3), DCADPJ(3), DCBDPJ(3) 
 23:       DOUBLE PRECISION, PARAMETER :: B = 1.6485D0 
 24:       LOGICAL          :: GTEST 
 25:  
 26:       FCT(1) = 1; FCT(2) = 2; FCT(3) = 6; FCT(4) = 24; FCT(5) = 120; FCT(6) = 720 
 27:       ENERGY = 0.D0; ENERGY1 = 0.D0; ENERGY2 = 0.D0; ENERGY3 = 0.D0 
 28:  
 29:       !print *, 'coords: ', x(:3*natoms) 
 30:       !xr(:) = 0.d0 
 31:       !call transformrigidtoc(1, nrigidbody, xr, x) 
 32:       !print *, 'cart: ', xr(:3*natoms) 
 33:        
 34:       ! calculate gradient if GTEST true 
 35:       IF (GTEST) G(:) = 0.D0 
 36:  
 37:       ! dj337: check if input coordinates are cartesian 
 38:       ! assumes ATOMRIGIDCOORDT is correct 
 39:       IF (ATOMRIGIDCOORDT) THEN 
 40:  
 41:          ! convert to rigid body coordinates 
 42:          XR(:) = 0.D0 
 43:          CALL TRANSFORMCTORIGID(X, XR) 
 44:          X(:) = XR(:) 
 45:  
 46:       ENDIF 
 47:  
 48:       ! OFFSET is number of CoM coords (3*NRIGIDBODY) 
 49:       OFFSET     = 3*NRIGIDBODY 
 50:  
 51:       ! Computing Cartesian coordinates for the system.   
 52:       DO J1 = 1, NRIGIDBODY 
 53:  
 54:          J3 = 3*J1 
 55:          J5 = OFFSET + J3 
 56:          ! CoM coords for rigid body J1 
 57:          RI = X(J3-2:J3) 
 58:          ! AA coords for rigid body J1 
 59:          P  = X(J5-2:J5) 
 60:  
 61:          ! calculates rotation matrix (RMI) 
 62:          ! also calculates derivatives if GTEST is true 
 63:          CALL RMDRVT(P, RMI, DRMI1, DRMI2, DRMI3, GTEST) 
 64:  
 65:          ! loop over sites in the rigid body 
 66:          DO J2 = 1, NSITEPERBODY(J1) 
 67:  
 68:             ! J4 is index for site J2 relative to a complete list of all sites in all rigid bodies 
 69:             ! dj337: assumes that same number of sites per rigid body (i.e. NSITEPERBODY(J1) == MAXSITE) 
 70:             J4      = MAXSITE*(J1-1) + J2 
 71:             ! R(J4,:) contains Cartesian coordinates for site J4 
 72:             R(J4,:) = RI(:) + MATMUL(RMI(:,:),SITESRIGIDBODY(J2,:,J1)) 
 73:             ! E(J4,:) contains Z-axis in local axis system for site J4  
 74:             E(J4,:) = MATMUL(RMI(:,:),RBSTLA(J2,:)) 
 75:  
 76:             IF (GTEST) THEN 
 77:  
 78:                ! calculate derivative wrt coordinates 
 79:                DR1(J4,:) = MATMUL(DRMI1(:,:),SITESRIGIDBODY(J2,:,J1)) 
 80:                DR2(J4,:) = MATMUL(DRMI2(:,:),SITESRIGIDBODY(J2,:,J1)) 
 81:                DR3(J4,:) = MATMUL(DRMI3(:,:),SITESRIGIDBODY(J2,:,J1)) 
 82:  
 83:                ! calculate derivative wrt local axis 
 84:                DE1(J4,:) = MATMUL(DRMI1(:,:),RBSTLA(J2,:)) 
 85:                DE2(J4,:) = MATMUL(DRMI2(:,:),RBSTLA(J2,:)) 
 86:                DE3(J4,:) = MATMUL(DRMI3(:,:),RBSTLA(J2,:)) 
 87:  
 88:             ENDIF 
 89:  
 90:          ENDDO 
 91:  
 92:       ENDDO 
 93:  
 94:       ! Now compute the actual potential. 
 95:       ! loop over rigid bodies (A) 
 96:       DO J1 = 1, NRIGIDBODY - 1 
 97:  
 98:          J3 = 3*J1 
 99:          J5 = OFFSET + J3 
100:          ! CoM coords for rigid body J1 
101:          RI(:)  = X(J3-2:J3) 
102:  
103:          ! loop over sites in the rigid body J1 
104:          DO I = 1, NSITEPERBODY(J1) 
105:  
106:             ! J7 is index for site I 
107:             J7    = MAXSITE*(J1-1) + I 
108:             ! EI is Z-axis for site I 
109:             EI(:) = E(J7,:) 
110:  
111:             ! loop over rigid bodies (B)    
112:             DO J2 = J1 + 1, NRIGIDBODY 
113:  
114:                J4 = 3*J2 
115:                J6 = OFFSET + J4 
116:  
117:                ! loop over sites in the rigid body J2 
118:                DO J = 1, NSITEPERBODY(J2) 
119:  
120:                   ! J8 is index for site J 
121:                   J8     = MAXSITE*(J2-1) + J 
122:                   ! EJ is Z-axis for site J 
123:                   EJ(:)  = E(J8,:) 
124:                   RSS(:) = R(J7,:) - R(J8,:) 
125:                   R2     = DOT_PRODUCT(RSS(:),RSS(:)) 
126:                   ! ABSRIJ is site-site separation between I and J 
127:                   ABSRIJ = DSQRT(R2) 
128:                   ! NR is unit site-site vector from sites I to J 
129:                   NR(:)  = RSS(:)/ABSRIJ 
130:                   R2     = 1.D0/R2 
131:                   R6     = R2*R2*R2 
132:  
133: !     CALCULATE THE DISPERSION DAMPING FACTOR 
134:  
135:                   ! initialize sum for the damping function 
136:                   DMPFCT = 1.D0 
137:                   ! initialize sum for the derivative of damping function 
138:                   DDMPDR = B 
139:  
140:                   ! calculate sums 
141:                   DO K = 1, 6 
142:  
143:                      DMPFCT = DMPFCT + (B*ABSRIJ)**K/FLOAT(FCT(K)) 
144:                      IF (K > 1) DDMPDR = DDMPDR + (B**K)*(ABSRIJ)**(K-1)/FLOAT(FCT(K-1)) 
145:  
146:                   END DO 
147:  
148:                   EXPFCT = DEXP(-B*ABSRIJ) 
149:                   ! DDMPDR is derivative of damping function with factor 1/Rab 
150:                   DDMPDR = (B*EXPFCT*DMPFCT - EXPFCT*DDMPDR)/ABSRIJ 
151:                   ! DMPFCT is damping function 
152:                   DMPFCT = 1.D0 - EXPFCT*DMPFCT 
153:  
154: !     NOW CALCULATE RHOAB 
155:  
156:                   ! calculate cos(theta)  
157:                   COSTA      =-DOT_PRODUCT(NR(:),EI(:)) 
158:                   COSTB      = DOT_PRODUCT(NR(:),EJ(:)) 
159:  
160:                   !!!! 
161:                   IF (GTEST) THEN 
162:  
163:                      ! derivative of cos(theta) wrt r_ij 
164:                      DCADR(:)   =-EI(:)/ABSRIJ - COSTA*R2*RSS(:) 
165:                      DCBDR(:)   = EJ(:)/ABSRIJ - COSTB*R2*RSS(:) 
166:  
167:                      ! derivative of r_ij wrt pi 
168:                      DRIJDPI(1) = DOT_PRODUCT(RSS(:),DR1(J7,:)) 
169:                      DRIJDPI(2) = DOT_PRODUCT(RSS(:),DR2(J7,:)) 
170:                      DRIJDPI(3) = DOT_PRODUCT(RSS(:),DR3(J7,:)) 
171:  
172:                      ! derivative of r_ij wrt pj 
173:                      DRIJDPJ(1) =-DOT_PRODUCT(RSS(:),DR1(J8,:)) 
174:                      DRIJDPJ(2) =-DOT_PRODUCT(RSS(:),DR2(J8,:)) 
175:                      DRIJDPJ(3) =-DOT_PRODUCT(RSS(:),DR3(J8,:)) 
176:  
177:                      ! derivative of cos(theta) wrt pi 
178:                      DCADPI(1)  =-DOT_PRODUCT(DR1(J7,:),EI(:))/ABSRIJ - DOT_PRODUCT(NR(:),DE1(J7,:)) &  
179:                                 - COSTA*R2*DRIJDPI(1) 
180:                      DCADPI(2)  =-DOT_PRODUCT(DR2(J7,:),EI(:))/ABSRIJ - DOT_PRODUCT(NR(:),DE2(J7,:)) & 
181:                                 - COSTA*R2*DRIJDPI(2) 
182:                      DCADPI(3)  =-DOT_PRODUCT(DR3(J7,:),EI(:))/ABSRIJ - DOT_PRODUCT(NR(:),DE3(J7,:)) & 
183:                                 - COSTA*R2*DRIJDPI(3) 
184:                      DCBDPI(1)  = DOT_PRODUCT(DR1(J7,:),EJ(:))/ABSRIJ - COSTB*R2*DRIJDPI(1) 
185:                      DCBDPI(2)  = DOT_PRODUCT(DR2(J7,:),EJ(:))/ABSRIJ - COSTB*R2*DRIJDPI(2) 
186:                      DCBDPI(3)  = DOT_PRODUCT(DR3(J7,:),EJ(:))/ABSRIJ - COSTB*R2*DRIJDPI(3) 
187:                  
188:                      ! derivative of cos(theta) wrt pj 
189:                      DCADPJ(1)  = DOT_PRODUCT(DR1(J8,:),EI(:))/ABSRIJ - COSTA*R2*DRIJDPJ(1) 
190:                      DCADPJ(2)  = DOT_PRODUCT(DR2(J8,:),EI(:))/ABSRIJ - COSTA*R2*DRIJDPJ(2) 
191:                      DCADPJ(3)  = DOT_PRODUCT(DR3(J8,:),EI(:))/ABSRIJ - COSTA*R2*DRIJDPJ(3) 
192:  
193:                      DCBDPJ(1)  =-DOT_PRODUCT(DR1(J8,:),EJ(:))/ABSRIJ + DOT_PRODUCT(NR(:),DE1(J8,:)) & 
194:                                 - COSTB*R2*DRIJDPJ(1) 
195:                      DCBDPJ(2)  =-DOT_PRODUCT(DR2(J8,:),EJ(:))/ABSRIJ + DOT_PRODUCT(NR(:),DE2(J8,:)) & 
196:                                 - COSTB*R2*DRIJDPJ(2) 
197:                      DCBDPJ(3)  =-DOT_PRODUCT(DR3(J8,:),EJ(:))/ABSRIJ + DOT_PRODUCT(NR(:),DE3(J8,:)) & 
198:                                 - COSTB*R2*DRIJDPJ(3) 
199:  
200:                   ENDIF 
201:    
202:                   ! calculate if I and J are both carbons  
203:                   IF (I <= NCARBON .AND. J <= NCARBON) THEN 
204:  
205:                      ! calculate rho_cc 
206:                      RHOCC   = RHOCC0 + RHOCC10*(COSTA + COSTB) + RHOCC20*(1.5D0*COSTA*COSTA &  
207:                              + 1.5D0*COSTB*COSTB - 1.D0) 
208:                      ! ENERGY1 is energy due to short-range anisotropic interactions 
209:                      EXPFCT  = KKJ*DEXP(-ALPHACC*(ABSRIJ - RHOCC)) 
210:                      ENERGY1 = ENERGY1 + EXPFCT                                 
211:                      ! ENERGY2 is energy due to damped dispersion 
212:                      ENERGY2 = ENERGY2 - DC6CC*DMPFCT*R6 
213:  
214:                      IF (GTEST) THEN 
215:  
216:                         ! DVDR is derivative of dispersion damping factor energy with factor 1/Rab 
217:                         DVDR    = 6.D0*DC6CC*R6*R2*DMPFCT - DC6CC*R6*DDMPDR  
218:                         ! FRIJ is derivative of ENERGY1 wrt r_ij with factor 1/Rab 
219:                         FRIJ(:) = ALPHACC*EXPFCT*(-NR(:) + (RHOCC10 + 3.D0*RHOCC20*COSTA)*DCADR(:) & 
220:                                 + (RHOCC10 + 3.D0*RHOCC20*COSTB)*DCBDR(:)) 
221:                         ! TIJ is derivative of ENERGY1 wrt pi with factor 1/Rab 
222:                         TIJ(:)  = ALPHACC*EXPFCT*(-DRIJDPI(:)/ABSRIJ + (RHOCC10 + 3.D0*RHOCC20*COSTA)*DCADPI(:) & 
223:                                 + (RHOCC10 + 3.D0*RHOCC20*COSTB)*DCBDPI(:)) 
224:                         ! TJI is derivative of ENERGY1 wrt pj with factor 1/Rab 
225:                         TJI(:)  = ALPHACC*EXPFCT*(-DRIJDPJ(:)/ABSRIJ + (RHOCC10 + 3.D0*RHOCC20*COSTA)*DCADPJ(:) & 
226:                                 + (RHOCC10 + 3.D0*RHOCC20*COSTB)*DCBDPJ(:))  
227:  
228:                      ENDIF 
229:  
230:                   ! calculate if I and J are both hydorgens 
231:                   ELSEIF (I > NCARBON .AND. J > NCARBON) THEN 
232:  
233:                      RHOHH  = RHOHH0 + RHOHH10*(COSTA + COSTB) + RHOHH20*(1.5D0*COSTA*COSTA      & 
234:                             + 1.5D0*COSTB*COSTB - 1.D0)  
235:                      EXPFCT  = KKJ*DEXP(-ALPHAHH*(ABSRIJ - RHOHH)) 
236:                      ENERGY1 = ENERGY1 + EXPFCT                                 
237:                      ENERGY2 = ENERGY2 - DC6HH*DMPFCT*R6 
238:  
239:                      IF (GTEST) THEN 
240:  
241:                         DVDR    = 6.D0*DC6HH*R6*R2*DMPFCT - DC6HH*R6*DDMPDR  
242:                         FRIJ(:) = ALPHAHH*EXPFCT*(-NR(:) + (RHOHH10 + 3.D0*RHOHH20*COSTA)*DCADR(:) & 
243:                                 + (RHOHH10 + 3.D0*RHOHH20*COSTB)*DCBDR(:)) 
244:                         TIJ(:)  = ALPHAHH*EXPFCT*(-DRIJDPI(:)/ABSRIJ + (RHOHH10 + 3.D0*RHOHH20*COSTA)*DCADPI(:) & 
245:                                 + (RHOHH10 + 3.D0*RHOHH20*COSTB)*DCBDPI(:)) 
246:                         TJI(:)  = ALPHAHH*EXPFCT*(-DRIJDPJ(:)/ABSRIJ + (RHOHH10 + 3.D0*RHOHH20*COSTA)*DCADPJ(:) & 
247:                                 + (RHOHH10 + 3.D0*RHOHH20*COSTB)*DCBDPJ(:)) 
248:  
249:                      ENDIF 
250:  
251:                   ! calculate if I is carbon and J is hydrogen 
252:                   ELSE IF (I <= NCARBON .AND. J > NCARBON) THEN  
253:  
254:                      RHOCH  = RHOCH0 + RHOC10H*COSTA + RHOCH10*COSTB + RHOC20H*(1.5D0*COSTA*COSTA & 
255:                             - 0.5D0) + RHOCH20*(1.5D0*COSTB*COSTB - 0.5D0) 
256:                      EXPFCT  = KKJ*DEXP(-ALPHACH*(ABSRIJ - RHOCH)) 
257:                      ENERGY1 = ENERGY1 + EXPFCT                               
258:                      ENERGY2 = ENERGY2 - DC6CH*DMPFCT*R6 
259:  
260:                      IF (GTEST) THEN 
261:                    
262:                         DVDR    = 6.D0*DC6CH*R6*R2*DMPFCT - DC6CH*R6*DDMPDR  
263:                         FRIJ(:) = ALPHACH*EXPFCT*(-NR(:) + (RHOC10H + 3.D0*RHOC20H*COSTA)*DCADR(:) & 
264:                                 + (RHOCH10 + 3.D0*RHOCH20*COSTB)*DCBDR(:)) 
265:                         TIJ(:)  = ALPHACH*EXPFCT*(-DRIJDPI(:)/ABSRIJ + (RHOC10H + 3.D0*RHOC20H*COSTA)*DCADPI(:) & 
266:                                 + (RHOCH10 + 3.D0*RHOCH20*COSTB)*DCBDPI(:)) 
267:                         TJI(:)  = ALPHACH*EXPFCT*(-DRIJDPJ(:)/ABSRIJ + (RHOC10H + 3.D0*RHOC20H*COSTA)*DCADPJ(:) & 
268:                                 + (RHOCH10 + 3.D0*RHOCH20*COSTB)*DCBDPJ(:)) 
269:  
270:                      ENDIF 
271:  
272:                   ELSE !IF(I > NCARBON .AND. J <= NCARBON) THEN 
273:  
274:                      RHOCH  = RHOCH0 + RHOCH10*COSTA + RHOC10H*COSTB + RHOCH20*(1.5D0*COSTA*COSTA & 
275:                             - 0.5D0) + RHOC20H*(1.5D0*COSTB*COSTB - 0.5D0) 
276:                      EXPFCT  = KKJ*DEXP(-ALPHACH*(ABSRIJ - RHOCH)) 
277:                      ENERGY1 = ENERGY1 + EXPFCT                          
278:                      ENERGY2 = ENERGY2 - DC6CH*DMPFCT*R6 
279:  
280:                      IF (GTEST) THEN 
281:  
282:                         DVDR    = 6.D0*DC6CH*R6*R2*DMPFCT - DC6CH*R6*DDMPDR  
283:                         FRIJ(:) = ALPHACH*EXPFCT*(-NR(:) + (RHOCH10 + 3.D0*RHOCH20*COSTA)*DCADR(:) & 
284:                                 + (RHOC10H + 3.D0*RHOC20H*COSTB)*DCBDR(:)) 
285:                         TIJ(:)  = ALPHACH*EXPFCT*(-DRIJDPI(:)/ABSRIJ + (RHOCH10 + 3.D0*RHOCH20*COSTA)*DCADPI(:) & 
286:                                 + (RHOC10H + 3.D0*RHOC20H*COSTB)*DCBDPI(:)) 
287:                         TJI(:)  = ALPHACH*EXPFCT*(-DRIJDPJ(:)/ABSRIJ + (RHOCH10 + 3.D0*RHOCH20*COSTA)*DCADPJ(:) & 
288:                                 + (RHOC10H + 3.D0*RHOC20H*COSTB)*DCBDPJ(:)) 
289:  
290:                      ENDIF 
291:  
292:                   ENDIF 
293:  
294:                   ! ENERGY3 is energy due to electrostatic interactions 
295:                   ENERGY3   = ENERGY3 + CCKJ*STCHRG(I)*STCHRG(J)/ABSRIJ 
296:   
297:                   IF (GTEST) THEN 
298:  
299:                      ! now DVDR is derivative of ENERGY1 + ENERGY2 wrt r_ij with factor of 1/Rab 
300:                      DVDR   = DVDR - CCKJ*STCHRG(I)*STCHRG(J)*R2/ABSRIJ 
301:  
302:                      !! total gradient wrt CoM coords for rigid body J1 
303:                      G(J3-2:J3) = G(J3-2:J3) + DVDR*RSS(:) + FRIJ(:) 
304:                      !! total gradient wrt CoM coords for rigid body J2 
305:                      G(J4-2:J4) = G(J4-2:J4) - DVDR*RSS(:) - FRIJ(:) 
306:  
307:                      !! total gradient wrt AA coords for rigid body J1 
308:                      G(J5-2:J5) = G(J5-2:J5) + DVDR*DRIJDPI(:) + TIJ(:) 
309:                      !! total gradient wrt AA coords for rigid body J2 
310:                      G(J6-2:J6) = G(J6-2:J6) + DVDR*DRIJDPJ(:) + TJI(:) 
311:  
312:                   ENDIF 
313:  
314:                ENDDO 
315:  
316:             ENDDO 
317:   
318:          ENDDO 
319:  
320:       ENDDO 
321:  
322:       ENERGY = (ENERGY1 + ENERGY2 + ENERGY3)*2625.499D0  
323:       IF (GTEST) G(:) = G(:)*2625.499D0 
324:  
325:       ! dj337: if input was cartesian, convert back to cartesian 
326:       ! assumes ATOMRIGIDCOORDT is correct 
327:       IF (ATOMRIGIDCOORDT) THEN 
328:  
329:          ! convert to cartesian coordinates 
330:          XR(:) = 0.D0 
331:          CALL TRANSFORMRIGIDTOC(1, NRIGIDBODY, XR, X) 
332:          X(:) = XR(:) 
333:  
334:       ENDIF 
335:  
336:       END SUBROUTINE PAHAGENRIGID 
337:  
338: !     ---------------------------------------------------------------------------------------------- 
339:  
340:       SUBROUTINE DEFPAHARIGID() 
341:  
342:       USE COMMONS, ONLY: RHOCC0, RHOCC10, RHOCC20,  RHOHH0, RHOHH10, RHOHH20, RHOCH0, RHOC10H, RHOCH10, RHOC20H, RHOCH20, & 
343:                          ALPHACC, ALPHAHH, ALPHACH, DC6CC, DC6HH, DC6CH, KKJ, CCKJ 
344:  
345:       IMPLICIT NONE 
346:   
347:       ALPHACC = 1.861500D0 
348:       ALPHAHH = 1.431200D0 
349:       ALPHACH = 1.775600D0 
350:  
351:       DC6CC    = 30.469D0 
352:       DC6HH    = 5.359D0 
353:       DC6CH    = 12.840D0 
354:  
355:       RHOCC0  = 5.814700D0 
356:       RHOCC10 = 0.021700D0 
357:       RHOCC20 =-0.220800D0 
358:  
359:       RHOHH0  = 4.486200D0 
360:       RHOHH10 =-0.271800D0 
361:       RHOHH20 = 0.0D0 
362:  
363:       RHOCH0  = 5.150500D0 
364:       RHOC10H = 0.021700D0 
365:       RHOCH10 =-0.271800D0 
366:       RHOC20H =-0.220800D0 
367:       RHOCH20 = 0.0D0 
368:  
369:       KKJ     = 1.D-03 
370:       CCKJ    = 1.D0   !1389.354848D0 
371:  
372:       END SUBROUTINE DEFPAHARIGID 
373:  
374: !     ---------------------------------------------------------------------------------------------- 
375:  
376:       SUBROUTINE DEFBENZENERIGID() 
377:  
378:       USE COMMONS, ONLY: NRBSITES, SITE, RBSTLA, STCHRG  
379:  
380:       IMPLICIT NONE 
381:   
382:       INTEGER :: J1 
383:  
384: !     C6H6 
385:  
386: !     D6h reference geometry: C-C: 1.397 angstrom; C-H: 1.087 angstrom 
387:  
388: !      SITE(1,:)  = (/-2.63923430843701,   0.00000000000000,   0.00000000000000/) 
389: !      SITE(2,:)  = (/ 2.63923430843701,   0.00000000000000,   0.00000000000000/) 
390: !      SITE(3,:)  = (/-1.31961715421850,  -2.28564395764590,   0.00000000000000/) 
391: !      SITE(4,:)  = (/ 1.31961715421850,  -2.28564395764590,   0.00000000000000/) 
392: !      SITE(5,:)  = (/-1.31961715421850,   2.28564395764590,   0.00000000000000/) 
393: !      SITE(6,:)  = (/ 1.31961715421850,   2.28564395764590,   0.00000000000000/) 
394: !      SITE(7,:)  = (/-4.69338981379532,   0.00000000000000,   0.00000000000000/) 
395: !      SITE(8,:)  = (/ 4.69338981379532,   0.00000000000000,   0.00000000000000/) 
396: !      SITE(9,:)  = (/ 2.34669490689766,   4.06459480860986,   0.00000000000000/) 
397: !      SITE(10,:) = (/-2.34669490689766,   4.06459480860986,   0.00000000000000/) 
398: !      SITE(11,:) = (/ 2.34669490689766,  -4.06459480860986,   0.00000000000000/) 
399: !      SITE(12,:) = (/-2.34669490689766,  -4.06459480860986,   0.00000000000000/) 
400:  
401:       SITE(1,:)  = (/ 2.63923430843701,   0.00000000000000,   0.00000000000000/) 
402:       SITE(2,:)  = (/ 1.31961715421850,  -2.28564395764590,   0.00000000000000/) 
403:       SITE(3,:)  = (/-1.31961715421850,  -2.28564395764590,   0.00000000000000/) 
404:       SITE(4,:)  = (/-2.63923430843701,   0.00000000000000,   0.00000000000000/) 
405:       SITE(5,:)  = (/-1.31961715421850,   2.28564395764590,   0.00000000000000/) 
406:       SITE(6,:)  = (/ 1.31961715421850,   2.28564395764590,   0.00000000000000/) 
407:       SITE(7,:)  = (/ 4.69338981379532,   0.00000000000000,   0.00000000000000/) 
408:       SITE(8,:)  = (/ 2.34669490689766,  -4.06459480860986,   0.00000000000000/) 
409:       SITE(9,:)  = (/-2.34669490689766,  -4.06459480860986,   0.00000000000000/) 
410:       SITE(10,:) = (/-4.69338981379532,   0.00000000000000,   0.00000000000000/) 
411:       SITE(11,:) = (/-2.34669490689766,   4.06459480860986,   0.00000000000000/) 
412:       SITE(12,:) = (/ 2.34669490689766,   4.06459480860986,   0.00000000000000/) 
413:  
414:       RBSTLA(1,:)  = SITE(7,:)  - SITE(1,:)                 ! Z FROM C1 TO H1 
415:       RBSTLA(2,:)  = SITE(8,:)  - SITE(2,:)                 ! Z FROM C2 TO H2 
416:       RBSTLA(3,:)  = SITE(9,:)  - SITE(3,:)                 ! Z FROM C3 TO H3 
417:       RBSTLA(4,:)  = SITE(10,:) - SITE(4,:)                 ! Z FROM C4 TO H4 
418:       RBSTLA(5,:)  = SITE(11,:) - SITE(5,:)                 ! Z FROM C5 TO H5 
419:       RBSTLA(6,:)  = SITE(12,:) - SITE(6,:)                 ! Z FROM C6 TO H6 
420:       RBSTLA(7,:)  = SITE(7,:)  - SITE(1,:)                 ! Z FROM C1 TO H1! 
421:       RBSTLA(8,:)  = SITE(8,:)  - SITE(2,:)                 ! Z FROM C2 TO H2! 
422:       RBSTLA(9,:)  = SITE(9,:) -  SITE(3,:)                 ! Z FROM C3 TO H3! 
423:       RBSTLA(10,:) = SITE(10,:) - SITE(4,:)                 ! Z FROM C4 TO H4! 
424:       RBSTLA(11,:) = SITE(11,:) - SITE(5,:)                 ! Z FROM C5 TO H5! 
425:       RBSTLA(12,:) = SITE(12,:) - SITE(6,:)                 ! Z FROM C6 TO H6! 
426:  
427: !      RBSTLA(1,:)  = SITE(7,:)  - SITE(1,:)                 ! Z FROM C1 TO H1 
428: !      RBSTLA(2,:)  = SITE(8,:)  - SITE(2,:)                 ! Z FROM C2 TO H2 
429: !      RBSTLA(3,:)  = SITE(12,:) - SITE(3,:)                 ! Z FROM C3 TO H6 
430: !      RBSTLA(4,:)  = SITE(11,:) - SITE(4,:)                 ! Z FROM C4 TO H5 
431: !      RBSTLA(5,:)  = SITE(10,:) - SITE(5,:)                 ! Z FROM C5 TO H4 
432: !      RBSTLA(6,:)  = SITE(9,:)  - SITE(6,:)                 ! Z FROM C6 TO H3 
433: !      RBSTLA(7,:)  = SITE(7,:)  - SITE(1,:)                 ! Z FROM C1 TO H1 
434: !      RBSTLA(8,:)  = SITE(8,:)  - SITE(2,:)                 ! Z FROM C2 TO H2 
435: !      RBSTLA(9,:)  = SITE(9,:)  - SITE(6,:)                 ! Z FROM C6 TO H3 
436: !      RBSTLA(10,:) = SITE(10,:) - SITE(5,:)                 ! Z FROM C5 TO H4 
437: !      RBSTLA(11,:) = SITE(11,:) - SITE(4,:)                 ! Z FROM C4 TO H5 
438: !      RBSTLA(12,:) = SITE(12,:) - SITE(3,:)                 ! Z FROM C3 TO H6 
439:        
440:       DO J1 = 1, NRBSITES 
441:   
442:          RBSTLA(J1,:)   = RBSTLA(J1,:)/DSQRT(DOT_PRODUCT(RBSTLA(J1,:),RBSTLA(J1,:))) 
443:  
444:       ENDDO 
445:  
446:       STCHRG(1:6)  = -0.11114D0 
447:       STCHRG(7:12) =  0.11114D0 
448:  
449:       !print *, 'defined benzrigid' 
450:       !print *, stchrg(:12) 
451:       !print *, site(:12, :3) 
452:  
453:       END SUBROUTINE DEFBENZENERIGID 
454:  
455: !!     ---------------------------------------------------------------------------------------------- 
456: ! 
457: !      SUBROUTINE DEFNAPHTHALENE() 
458: ! 
459: !      USE COMMONS, ONLY: NRBSITES, SITE, RBSTLA, STCHRG 
460: ! 
461: !      IMPLICIT NONE 
462: !  
463: !      INTEGER :: J1 
464: ! 
465: !!     C10H8 
466: ! 
467: !      SITE(1,:)  = (/-1.33862D0, -4.59918D0, 0.D0/)   ! C1 
468: !      SITE(2,:)  = (/-2.65019D0, -2.35249D0, 0.D0/)   ! C2 
469: !      SITE(3,:)  = (/-1.35523D0, 0.D0, 0.D0/)         ! C3 
470: !      SITE(4,:)  = (/ 1.35523D0, 0.D0, 0.D0/)         ! C4 
471: !      SITE(5,:)  = (/ 2.65019D0,-2.35249D0, 0.D0/)    ! C5 
472: !      SITE(6,:)  = (/ 1.33862D0,-4.59918D0, 0.D0/)    ! C6 
473: !      SITE(7,:)  = (/-2.65019D0, 2.35249D0, 0.D0/)    ! C7 
474: !      SITE(8,:)  = (/ 2.65019D0, 2.35249D0, 0.D0/)    ! C8 
475: !      SITE(9,:)  = (/ 1.33862D0, 4.59918D0, 0.D0/)    ! C9 
476: !      SITE(10,:) = (/-1.33862D0, 4.59918D0, 0.D0/)    ! C10 
477: !      SITE(11,:) = (/-4.70575D0, 2.34799D0, 0.D0/)    ! H1 
478: !      SITE(12,:) = (/-2.35493D0,-6.38388D0, 0.D0/)    ! H2 
479: !      SITE(13,:) = (/-4.70575D0,-2.34799D0, 0.D0/)    ! H3 
480: !      SITE(14,:) = (/ 4.70575D0,-2.34799D0, 0.D0/)    ! H4 
481: !      SITE(15,:) = (/ 2.35493D0,-6.38388D0, 0.D0/)    ! H5 
482: !      SITE(16,:) = (/ 4.70575D0, 2.34799D0, 0.D0/)    ! H6 
483: !      SITE(17,:) = (/ 2.35493D0, 6.38388D0, 0.D0/)    ! H7 
484: !      SITE(18,:) = (/-2.35493D0, 6.38388D0, 0.D0/)    ! H8 
485: ! 
486: !      STCHRG(1)  =-0.10048D0  
487: !      STCHRG(2)  =-0.29796D0 
488: !      STCHRG(3)  = 0.24018D0 
489: !      STCHRG(4)  = 0.24018D0 
490: !      STCHRG(5)  =-0.29796D0 
491: !      STCHRG(6)  =-0.10048D0 
492: !      STCHRG(7)  =-0.29796D0 
493: !      STCHRG(8)  =-0.29796D0 
494: !      STCHRG(9)  =-0.10048D0  
495: !      STCHRG(10) =-0.10048D0 
496: !      STCHRG(11) = 0.15530D0 
497: !      STCHRG(12) = 0.12304D0 
498: !      STCHRG(13) = 0.15530D0 
499: !      STCHRG(14) = 0.15530D0 
500: !      STCHRG(15) = 0.12304D0 
501: !      STCHRG(16) = 0.15530D0 
502: !      STCHRG(17) = 0.12304D0 
503: !      STCHRG(18) = 0.12304D0 
504: ! 
505: !!      SITE(:,:) =  SITE(:,:)*0.529177D0 
506: ! 
507: !      RBSTLA(1,:)  = SITE(12,:) - SITE(1,:)                 ! Z FROM C1 TO H2 
508: !      RBSTLA(2,:)  = SITE(13,:) - SITE(2,:)                 ! Z FROM C2 TO H3 
509: !      RBSTLA(3,:)  = SITE(4,:)  - SITE(3,:)                 ! Z FROM C3 TO C4 
510: !      RBSTLA(4,:)  = SITE(3,:)  - SITE(4,:)                 ! Z FROM C4 TO C3 
511: !      RBSTLA(5,:)  = SITE(14,:) - SITE(5,:)                 ! Z FROM C5 TO H4 
512: !      RBSTLA(6,:)  = SITE(15,:) - SITE(6,:)                 ! Z FROM C6 TO H5 
513: !      RBSTLA(7,:)  = SITE(11,:) - SITE(7,:)                 ! Z FROM C7 TO H1 
514: !      RBSTLA(8,:)  = SITE(16,:) - SITE(8,:)                 ! Z FROM C8 TO H6 
515: !      RBSTLA(9,:)  = SITE(17,:) - SITE(9,:)                 ! Z FROM C9 TO H7 
516: !      RBSTLA(10,:) = SITE(18,:) - SITE(10,:)                ! Z FROM C10 TO H8 
517: !      RBSTLA(11,:) = SITE(11,:) - SITE(7,:)                 ! Z FROM C7 TO H1 
518: !      RBSTLA(12,:) = SITE(12,:) - SITE(1,:)                 ! Z FROM C1 TO H2 
519: !      RBSTLA(13,:) = SITE(13,:) - SITE(2,:)                 ! Z FROM C2 TO H3 
520: !      RBSTLA(14,:) = SITE(14,:) - SITE(5,:)                 ! Z FROM C5 TO H4 
521: !      RBSTLA(15,:) = SITE(15,:) - SITE(6,:)                 ! Z FROM C6 TO H5 
522: !      RBSTLA(16,:) = SITE(16,:) - SITE(8,:)                 ! Z FROM C8 TO H6 
523: !      RBSTLA(17,:) = SITE(17,:) - SITE(9,:)                 ! Z FROM C9 TO H7 
524: !      RBSTLA(18,:) = SITE(18,:) - SITE(10,:)                ! Z FROM C10 TO H8 
525: !       
526: !      DO J1 = 1, NRBSITES 
527: !  
528: !         RBSTLA(J1,:)   = RBSTLA(J1,:)/DSQRT(DOT_PRODUCT(RBSTLA(J1,:),RBSTLA(J1,:))) 
529: ! 
530: !      ENDDO 
531: ! 
532: !      END SUBROUTINE DEFNAPHTHALENE 
533: ! 
534: !!     ---------------------------------------------------------------------------------------------- 
535: ! 
536: !      SUBROUTINE DEFANTHRACENE() 
537: ! 
538: !      USE COMMONS, ONLY: NRBSITES, SITE, RBSTLA, STCHRG 
539: ! 
540: !      IMPLICIT NONE 
541: ! 
542: !      INTEGER :: J1 
543: ! 
544: !!     C14H10 
545: ! 
546: !      SITE(1,:)  = (/ 1.36540D0, 2.31298D0, 0.D0/)    ! C1 
547: !      SITE(2,:)  = (/-1.36540D0, 2.31298D0, 0.D0/)    ! C2      
548: !      SITE(3,:)  = (/ 1.36540D0,-2.31298D0, 0.D0/)    ! C3 
549: !      SITE(4,:)  = (/-1.36540D0,-2.31298D0, 0.D0/)    ! C4 
550: !      SITE(5,:)  = (/-2.65253D0, 0.D0, 0.D0/)         ! C5 
551: !      SITE(6,:)  = (/ 2.65253D0, 0.D0, 0.D0/)         ! C6 
552: !      SITE(7,:)  = (/ 2.65927D0, 4.68538D0, 0.D0/)    ! C7 
553: !      SITE(8,:)  = (/-2.65927D0, 4.68538D0, 0.D0/)    ! C8 
554: !      SITE(9,:)  = (/ 2.65927D0,-4.68538D0, 0.D0/)    ! C9 
555: !      SITE(10,:) = (/-2.65927D0,-4.68538D0, 0.D0/)    ! C10 
556: !      SITE(11,:) = (/ 1.34762D0,-6.91760D0, 0.D0/)    ! C11 
557: !      SITE(12,:) = (/-1.34762D0,-6.91760D0, 0.D0/)    ! C12 
558: !      SITE(13,:) = (/ 1.34762D0, 6.91760D0, 0.D0/)    ! C13 
559: !      SITE(14,:) = (/-1.34762D0, 6.91760D0, 0.D0/)    ! C14 
560: !      SITE(15,:) = (/ 4.71450D0,-4.67888D0, 0.D0/)    ! H1 
561: !      SITE(16,:) = (/ 2.35428D0,-8.70751D0, 0.D0/)    ! H2 
562: !      SITE(17,:) = (/-2.35428D0,-8.70751D0, 0.D0/)    ! H3 
563: !      SITE(18,:) = (/-4.71450D0,-4.67888D0, 0.D0/)    ! H4 
564: !      SITE(19,:) = (/ 4.71450D0, 4.67888D0, 0.D0/)    ! H5 
565: !      SITE(20,:) = (/ 2.35428D0, 8.70751D0, 0.D0/)    ! H6 
566: !      SITE(21,:) = (/-2.35428D0, 8.70751D0, 0.D0/)    ! H7 
567: !      SITE(22,:) = (/-4.71450D0, 4.67888D0, 0.D0/)    ! H8 
568: !      SITE(23,:) = (/-4.70918D0, 0.D0, 0.D0/)         ! H9 
569: !      SITE(24,:) = (/ 4.70918D0, 0.D0, 0.D0/)         ! H10 
570: ! 
571: !      STCHRG(1)  = 0.23448D0  
572: !      STCHRG(2)  = 0.23448D0 
573: !      STCHRG(3)  = 0.23448D0 
574: !      STCHRG(4)  = 0.23448D0 
575: !      STCHRG(5)  =-0.47174D0 
576: !      STCHRG(6)  =-0.47174D0 
577: !      STCHRG(7)  =-0.25252D0 
578: !      STCHRG(8)  =-0.25252D0 
579: !      STCHRG(9)  =-0.25252D0 
580: !      STCHRG(10) =-0.25252D0 
581: !      STCHRG(11) =-0.11389D0 
582: !      STCHRG(12) =-0.11389D0 
583: !      STCHRG(13) =-0.11389D0 
584: !      STCHRG(14) =-0.11389D0 
585: !      STCHRG(15) = 0.14291D0 
586: !      STCHRG(16) = 0.12531D0 
587: !      STCHRG(17) = 0.12531D0 
588: !      STCHRG(18) = 0.14291D0 
589: !      STCHRG(19) = 0.14291D0 
590: !      STCHRG(20) = 0.12531D0 
591: !      STCHRG(21) = 0.12531D0 
592: !      STCHRG(22) = 0.14291D0 
593: !      STCHRG(23) = 0.19915D0 
594: !      STCHRG(24) = 0.19915D0 
595: ! 
596: !      RBSTLA(1,:)  = SITE(2,:)  - SITE(1,:)                 ! Z FROM C1 TO C2 
597: !      RBSTLA(2,:)  = SITE(1,:)  - SITE(2,:)                 ! Z FROM C2 TO C1 
598: !      RBSTLA(3,:)  = SITE(4,:)  - SITE(3,:)                 ! Z FROM C3 TO C4 
599: !      RBSTLA(4,:)  = SITE(3,:)  - SITE(4,:)                 ! Z FROM C4 TO C3 
600: !      RBSTLA(5,:)  = SITE(23,:) - SITE(5,:)                 ! Z FROM C5 TO H9 
601: !      RBSTLA(6,:)  = SITE(24,:) - SITE(6,:)                 ! Z FROM C6 TO H10 
602: !      RBSTLA(7,:)  = SITE(19,:) - SITE(7,:)                 ! Z FROM C7 TO H5 
603: !      RBSTLA(8,:)  = SITE(22,:) - SITE(8,:)                 ! Z FROM C8 TO H8 
604: !      RBSTLA(9,:)  = SITE(15,:) - SITE(9,:)                 ! Z FROM C9 TO H1 
605: !      RBSTLA(10,:) = SITE(18,:) - SITE(10,:)                ! Z FROM C10 TO H4 
606: !      RBSTLA(11,:) = SITE(16,:) - SITE(11,:)                ! Z FROM C11 TO H2 
607: !      RBSTLA(12,:) = SITE(17,:) - SITE(12,:)                ! Z FROM C12 TO H3 
608: !      RBSTLA(13,:) = SITE(20,:) - SITE(13,:)                ! Z FROM C13 TO H6 
609: !      RBSTLA(14,:) = SITE(21,:) - SITE(14,:)                ! Z FROM C14 TO H7 
610: !      RBSTLA(15,:) = SITE(15,:) - SITE(9,:)                 ! Z FROM C9 TO H1 
611: !      RBSTLA(16,:) = SITE(16,:) - SITE(11,:)                ! Z FROM C11 TO H2 
612: !      RBSTLA(17,:) = SITE(17,:) - SITE(12,:)                ! Z FROM C12 TO H3 
613: !      RBSTLA(18,:) = SITE(18,:) - SITE(10,:)                ! Z FROM C10 TO H4 
614: !      RBSTLA(19,:) = SITE(19,:) - SITE(7,:)                 ! Z FROM C7 TO H5 
615: !      RBSTLA(20,:) = SITE(20,:) - SITE(13,:)                ! Z FROM C13 TO H6 
616: !      RBSTLA(21,:) = SITE(21,:) - SITE(14,:)                ! Z FROM C14 TO H7 
617: !      RBSTLA(22,:) = SITE(22,:) - SITE(8,:)                 ! Z FROM C8 TO H8 
618: !      RBSTLA(23,:) = SITE(23,:) - SITE(5,:)                 ! Z FROM C5 TO H9 
619: !      RBSTLA(24,:) = SITE(24,:) - SITE(6,:)                 ! Z FROM C6 TO H10 
620: ! 
621: !      DO J1 = 1, NRBSITES 
622: ! 
623: !         RBSTLA(J1,:)   = RBSTLA(J1,:)/DSQRT(DOT_PRODUCT(RBSTLA(J1,:),RBSTLA(J1,:))) 
624: ! 
625: !      ENDDO 
626: ! 
627: !      END SUBROUTINE DEFANTHRACENE 
628: ! 
629: !!     ---------------------------------------------------------------------------------------------- 
630: ! 
631: !      SUBROUTINE DEFPYRENE() 
632: ! 
633: !      USE COMMONS, ONLY: NRBSITES, SITE, RBSTLA, STCHRG 
634: ! 
635: !      IMPLICIT NONE 
636: ! 
637: !      INTEGER :: J1 
638: ! 
639: !!     C16H10 
640: ! 
641: !      SITE(1,:)  = (/-1.34794D0, 0.D0, 0.D0/)         ! C1 
642: !      SITE(2,:)  = (/ 1.34794D0, 0.D0, 0.D0/)         ! C2 
643: !      SITE(3,:)  = (/ 2.70059D0, 2.33625D0, 0.D0/)    ! C3 
644: !      SITE(4,:)  = (/ 2.70059d0,-2.33625D0, 0.D0/)    ! C4 
645: !      SITE(5,:)  = (/-2.70059D0,-2.33625D0, 0.D0/)    ! C5 
646: !      SITE(6,:)  = (/-2.70059D0, 2.33625D0, 0.D0/)    ! C6 
647: !      SITE(7,:)  = (/ 1.28651D0, 4.65603D0, 0.D0/)    ! C7 
648: !      SITE(8,:)  = (/ 5.35355D0, 2.28771D0, 0.D0/)    ! C8 
649: !      SITE(9,:)  = (/ 1.28651D0,-4.65603D0, 0.D0/)    ! C9 
650: !      SITE(10,:) = (/ 5.35355D0,-2.28771D0, 0.D0/)    ! C10 
651: !      SITE(11,:) = (/-1.28651D0,-4.65603D0, 0.D0/)    ! C11 
652: !      SITE(12,:) = (/-5.35355D0,-2.28771D0, 0.D0/)    ! C12 
653: !      SITE(13,:) = (/-1.28651D0, 4.65603D0, 0.D0/)    ! C13 
654: !      SITE(14,:) = (/-5.35355D0, 2.28771D0, 0.D0/)    ! C14 
655: !      SITE(15,:) = (/ 6.65929D0, 0.D0, 0.D0/)         ! C15 
656: !      SITE(16,:) = (/-6.65929D0, 0.D0, 0.D0/)         ! C16 
657: !      SITE(17,:) = (/ 2.32543D0, 6.42907D0, 0.D0/)    ! H1 
658: !      SITE(18,:) = (/ 6.38694D0, 4.06382D0, 0.D0/)    ! H2 
659: !      SITE(19,:) = (/ 2.32543D0,-6.42907D0, 0.D0/)    ! H3 
660: !      SITE(20,:) = (/ 6.38694D0,-4.06382D0, 0.D0/)    ! H4 
661: !      SITE(21,:) = (/-2.32543D0,-6.42907D0, 0.D0/)    ! H5 
662: !      SITE(22,:) = (/-6.38694D0,-4.06382D0, 0.D0/)    ! H6 
663: !      SITE(23,:) = (/-2.32543D0, 6.42907D0, 0.D0/)    ! H7 
664: !      SITE(24,:) = (/-6.38694D0, 4.06382D0, 0.D0/)    ! H8 
665: !      SITE(25,:) = (/ 8.71284D0, 0.D0, 0.D0/)         ! H9 
666: !      SITE(26,:) = (/-8.71284D0, 0.D0, 0.D0/)         ! H10 
667: ! 
668: !      STCHRG(1)  =-0.04275D0  
669: !      STCHRG(2)  =-0.04275D0 
670: !      STCHRG(3)  = 0.22339D0 
671: !      STCHRG(4)  = 0.22339D0 
672: !      STCHRG(5)  = 0.22339D0 
673: !      STCHRG(6)  = 0.22339D0 
674: !      STCHRG(7)  =-0.24782D0 
675: !      STCHRG(8)  =-0.29542D0 
676: !      STCHRG(9)  =-0.24782D0 
677: !      STCHRG(10) =-0.29542D0 
678: !      STCHRG(11) =-0.24782D0 
679: !      STCHRG(12) =-0.29542D0 
680: !      STCHRG(13) =-0.24782D0 
681: !      STCHRG(14) =-0.29542D0 
682: !      STCHRG(15) =-0.05466D0 
683: !      STCHRG(16) =-0.05466D0 
684: !      STCHRG(17) = 0.15533D0 
685: !      STCHRG(18) = 0.15109D0 
686: !      STCHRG(19) = 0.15533D0 
687: !      STCHRG(20) = 0.15109D0 
688: !      STCHRG(21) = 0.15533D0 
689: !      STCHRG(22) = 0.15109D0 
690: !      STCHRG(23) = 0.15533D0 
691: !      STCHRG(24) = 0.15109D0 
692: !      STCHRG(25) = 0.12425D0 
693: !      STCHRG(26) = 0.12425D0 
694: ! 
695: !      RBSTLA(1,:)  = SITE(2,:)  - SITE(1,:)                 ! Z FROM C1 TO C2 
696: !      RBSTLA(2,:)  = SITE(1,:)  - SITE(2,:)                 ! Z FROM C2 TO C1 
697: !      RBSTLA(3,:)  = SITE(2,:)  - SITE(3,:)                 ! Z FROM C3 TO C2 
698: !      RBSTLA(4,:)  = SITE(2,:)  - SITE(4,:)                 ! Z FROM C4 TO C2 
699: !      RBSTLA(5,:)  = SITE(1,:)  - SITE(5,:)                 ! Z FROM C5 TO C1 
700: !      RBSTLA(6,:)  = SITE(1,:)  - SITE(6,:)                 ! Z FROM C6 TO C1 
701: !      RBSTLA(7,:)  = SITE(17,:) - SITE(7,:)                 ! Z FROM C7 TO H1 
702: !      RBSTLA(8,:)  = SITE(18,:) - SITE(8,:)                 ! Z FROM C8 TO H2 
703: !      RBSTLA(9,:)  = SITE(19,:) - SITE(9,:)                 ! Z FROM C9 TO H3 
704: !      RBSTLA(10,:) = SITE(20,:) - SITE(10,:)                ! Z FROM C10 TO H4 
705: !      RBSTLA(11,:) = SITE(21,:) - SITE(11,:)                ! Z FROM C11 TO H5 
706: !      RBSTLA(12,:) = SITE(22,:) - SITE(12,:)                ! Z FROM C12 TO H6 
707: !      RBSTLA(13,:) = SITE(23,:) - SITE(13,:)                ! Z FROM C13 TO H7 
708: !      RBSTLA(14,:) = SITE(24,:) - SITE(14,:)                ! Z FROM C14 TO H8 
709: !      RBSTLA(15,:) = SITE(25,:) - SITE(15,:)                ! Z FROM C15 TO H9 
710: !      RBSTLA(16,:) = SITE(26,:) - SITE(16,:)                ! Z FROM C16 TO H10 
711: !      RBSTLA(17,:) = SITE(17,:) - SITE(7,:)                 ! Z FROM C7 TO H1 
712: !      RBSTLA(18,:) = SITE(18,:) - SITE(8,:)                 ! Z FROM C8 TO H2 
713: !      RBSTLA(19,:) = SITE(19,:) - SITE(9,:)                 ! Z FROM C9 TO H3 
714: !      RBSTLA(20,:) = SITE(20,:) - SITE(10,:)                ! Z FROM C10 TO H4 
715: !      RBSTLA(21,:) = SITE(21,:) - SITE(11,:)                ! Z FROM C11 TO H5 
716: !      RBSTLA(22,:) = SITE(22,:) - SITE(12,:)                ! Z FROM C12 TO H6 
717: !      RBSTLA(23,:) = SITE(23,:) - SITE(13,:)                ! Z FROM C13 TO H7 
718: !      RBSTLA(24,:) = SITE(24,:) - SITE(14,:)                ! Z FROM C14 TO H8 
719: !      RBSTLA(25,:) = SITE(25,:) - SITE(15,:)                ! Z FROM C15 TO H9 
720: !      RBSTLA(26,:) = SITE(26,:) - SITE(16,:)                ! Z FROM C16 TO H10 
721: ! 
722: !      DO J1 = 1, NRBSITES 
723: ! 
724: !         RBSTLA(J1,:)   = RBSTLA(J1,:)/DSQRT(DOT_PRODUCT(RBSTLA(J1,:),RBSTLA(J1,:))) 
725: ! 
726: !      ENDDO 
727: ! 
728: !      END SUBROUTINE DEFPYRENE 
729: ! 
730: !!     ---------------------------------------------------------------------------------------------- 
731: ! 
732: !      SUBROUTINE DEFPHENANTHRENE() 
733: ! 
734: !      USE COMMONS, ONLY: NRBSITES, SITE, RBSTLA, STCHRG 
735: ! 
736: !      IMPLICIT NONE 
737: ! 
738: !      INTEGER :: J1 
739: ! 
740: !!     C14H10 
741: ! 
742: !!     UNITS INITIALLY IN ANGSTROM 
743: ! 
744: !      SITE(1,:)  = (/0.728950D0,  1.277200D0,  0.000000D0/)   !C1 
745: !      SITE(2,:)  = (/-0.728950D0,  1.277200D0,  0.000000D0/)   !C2 
746: !      SITE(3,:)  = (/0.679800D0,  -1.197690D0,  0.000000D0/)   !C3 
747: !      SITE(4,:)  = (/-0.679800D0,  -1.197690D0,  0.000000D0/)   !C4 
748: !      SITE(5,:)  = (/-1.423030D0,  0.030020D0,  0.000000D0/)   !C5 
749: !      SITE(6,:)  = (/1.423030D0,  0.030020D0,  0.000000D0/)   !C6 
750: !      SITE(7,:)  = (/1.500740D0,  2.462850D0,  0.000000D0/)   !C7 
751: !      SITE(8,:)  = (/-1.500740D0,  2.462850D0,  0.000000D0/)   !C8 
752: !      SITE(9,:)  = (/2.883480D0,  2.425000D0,  0.000000D0/)   !C9 
753: !      SITE(10,:)  = (/-2.883480D0,  2.425000D0,  0.000000D0/)   !C10 
754: !      SITE(11,:)  = (/2.837310D0,  0.016730D0,  0.000000D0/)   !C11 
755: !      SITE(12,:)  = (/-2.837310D0,  0.016730D0,  0.000000D0/)   !C12 
756: !      SITE(13,:)  = (/3.562000D0,  1.192060D0,  0.000000D0/)   !C13 
757: !      SITE(14,:)  = (/-3.562000D0,  1.192060D0,  0.000000D0/)   !C14 
758: !      SITE(15,:)  = (/1.232290D0,  -2.134300D0,  0.000000D0/)   !H1 
759: !      SITE(16,:)  = (/-1.232290D0,  -2.134300D0,  0.000000D0/)   !H2 
760: !      SITE(17,:)  = (/1.007910D0,  3.429160D0,  0.000000D0/)   !H3 
761: !      SITE(18,:)  = (/3.447220D0,  3.354020D0,  0.000000D0/)   !H4 
762: !      SITE(19,:)  = (/3.347890D0,  -0.943600D0,  0.000000D0/)   !H5 
763: !      SITE(20,:)  = (/-1.007910D0,  3.429160D0,  0.000000D0/)   !H6 
764: !      SITE(21,:)  = (/-3.447220D0,  3.354020D0,  0.000000D0/)   !H7 
765: !      SITE(22,:)  = (/-3.347890D0,  -0.943600D0,  0.000000D0/)   !H8 
766: !      SITE(23,:)  = (/4.648270D0,  1.167030D0,  0.000000D0/)   !H9 
767: !      SITE(24,:)  = (/-4.648270D0,  1.167030D0,  0.000000D0/)   !H10 
768: ! 
769: !      SITE(:,:) =  SITE(:,:)/0.5291770D0 
770: ! 
771: !      STCHRG(1)  = 0.0153630D0 
772: !      STCHRG(2)  = 0.0153630D0 
773: !      STCHRG(3)  = -0.2774610D0 
774: !      STCHRG(4)  = -0.2774610D0 
775: !      STCHRG(5)  = 0.2396090D0 
776: !      STCHRG(6)  = 0.2396090D0 
777: !      STCHRG(7)  = -0.1930180D0 
778: !      STCHRG(8)  = -0.1930180D0 
779: !      STCHRG(9)  = -0.1423640D0 
780: !      STCHRG(10)  = -0.1423640D0 
781: !      STCHRG(11)  = -0.2681230D0 
782: !      STCHRG(12)  = -0.2681230D0 
783: !      STCHRG(13)  = -0.086620D0 
784: !      STCHRG(14)  = -0.086620D0 
785: !      STCHRG(15)  = 0.1696350D0 
786: !      STCHRG(16)  = 0.1696350D0 
787: !      STCHRG(17)  = 0.1409570D0 
788: !      STCHRG(18)  = 0.1312140D0 
789: !      STCHRG(19)  = 0.1446370D0 
790: !      STCHRG(20)  = 0.1409570D0 
791: !      STCHRG(21)  = 0.1312140D0 
792: !      STCHRG(22)  = 0.1446370D0 
793: !      STCHRG(23)  = 0.1261710D0 
794: !      STCHRG(24)  = 0.1261710D0 
795: ! 
796: !      RBSTLA(1,:)  = SITE(2,:)  - SITE(1,:)                 ! Z FROM C1 TO C2 
797: !      RBSTLA(2,:)  = SITE(1,:)  - SITE(2,:)                 ! Z FROM C2 TO C1 
798: !      RBSTLA(3,:)  = SITE(15,:)  - SITE(3,:)                 ! Z FROM C3 TO H1 
799: !      RBSTLA(4,:)  = SITE(16,:)  - SITE(4,:)                 ! Z FROM C4 TO H2 
800: !      RBSTLA(5,:)  = SITE(2,:)  - SITE(5,:)                 ! Z FROM C5 TO C2 
801: !      RBSTLA(6,:)  = SITE(1,:)  - SITE(6,:)                 ! Z FROM C6 TO C1 
802: !      RBSTLA(7,:)  = SITE(17,:)  - SITE(7,:)                 ! Z FROM C7 TO H3 
803: !      RBSTLA(8,:)  = SITE(20,:)  - SITE(8,:)                 ! Z FROM C8 TO H6 
804: !      RBSTLA(9,:)  = SITE(18,:)  - SITE(9,:)                 ! Z FROM C9 TO H4 
805: !      RBSTLA(10,:)  = SITE(21,:)  - SITE(10,:)                 ! Z FROM C10 TO H7 
806: !      RBSTLA(11,:)  = SITE(19,:)  - SITE(11,:)                 ! Z FROM C11 TO H5 
807: !      RBSTLA(12,:)  = SITE(22,:)  - SITE(12,:)                 ! Z FROM C12 TO H8 
808: !      RBSTLA(13,:)  = SITE(23,:)  - SITE(13,:)                 ! Z FROM C13 TO H9 
809: !      RBSTLA(14,:)  = SITE(24,:)  - SITE(14,:)                 ! Z FROM C14 TO H10 
810: !      RBSTLA(15,:)  = SITE(15,:)  - SITE(3,:)                 ! Z FROM C3 TO H1 
811: !      RBSTLA(16,:)  = SITE(16,:)  - SITE(4,:)                 ! Z FROM C4 TO H2 
812: !      RBSTLA(17,:)  = SITE(17,:)  - SITE(7,:)                 ! Z FROM C7 TO H3 
813: !      RBSTLA(18,:)  = SITE(18,:)  - SITE(9,:)                 ! Z FROM C9 TO H4 
814: !      RBSTLA(19,:)  = SITE(19,:)  - SITE(11,:)                 ! Z FROM C11 TO H5 
815: !      RBSTLA(20,:)  = SITE(20,:)  - SITE(8,:)                 ! Z FROM C8 TO H6 
816: !      RBSTLA(21,:)  = SITE(21,:)  - SITE(10,:)                 ! Z FROM C10 TO H7 
817: !      RBSTLA(22,:)  = SITE(22,:)  - SITE(12,:)                 ! Z FROM C12 TO H8 
818: !      RBSTLA(23,:)  = SITE(23,:)  - SITE(13,:)                 ! Z FROM C13 TO H9 
819: !      RBSTLA(24,:)  = SITE(24,:)  - SITE(14,:)                 ! Z FROM C14 TO H10 
820: ! 
821: !      DO J1 = 1, NRBSITES 
822: ! 
823: !         RBSTLA(J1,:)   = RBSTLA(J1,:)/DSQRT(DOT_PRODUCT(RBSTLA(J1,:),RBSTLA(J1,:))) 
824: ! 
825: !      ENDDO 
826: ! 
827: !      END SUBROUTINE DEFPHENANTHRENE 
828: ! 
829: !!     ---------------------------------------------------------------------------------------------- 
830: ! 
831: !      SUBROUTINE DEFPERYLENE() 
832: ! 
833: !      USE COMMONS, ONLY: NRBSITES, SITE, RBSTLA, STCHRG 
834: ! 
835: !      IMPLICIT NONE 
836: ! 
837: !      INTEGER :: J1 
838: ! 
839: !!     C20H12 
840: ! 
841: !!     UNITS INITIALLY IN ANGSTROM 
842: ! 
843: !      SITE(1,:)  = (/0.000000D0,  -1.439410D0,  0.000000D0/)   !C1 
844: !      SITE(2,:)  = (/0.000000D0,  1.439410D0,  0.000000D0/)   !C2 
845: !      SITE(3,:)  = (/1.249970D0,  -0.738310D0,  0.000000D0/)   !C3 
846: !      SITE(4,:)  = (/-1.249970D0,  0.738310D0,  0.000000D0/)   !C4 
847: !      SITE(5,:)  = (/1.249970D0,  0.738310D0,  0.000000D0/)   !C5 
848: !      SITE(6,:)  = (/-1.249970D0,  -0.738310D0,  0.000000D0/)   !C6 
849: !      SITE(7,:)  = (/2.427620D0,  -1.479640D0,  0.000000D0/)   !C7 
850: !      SITE(8,:)  = (/-2.427620D0,  1.479640D0,  0.000000D0/)   !C8 
851: !      SITE(9,:)  = (/2.427620D0,  1.479640D0,  0.000000D0/)   !C9 
852: !      SITE(10,:)  = (/-2.427620D0,  -1.479640D0,  0.000000D0/)   !C10 
853: !      SITE(11,:)  = (/2.422750D0,  -2.886150D0,  0.000000D0/)   !C11 
854: !      SITE(12,:)  = (/-2.422750D0,  2.886150D0,  0.000000D0/)   !C12 
855: !      SITE(13,:)  = (/2.422750D0,  2.886150D0,  0.000000D0/)   !C13 
856: !      SITE(14,:)  = (/-2.422750D0,  -2.886150D0,  0.000000D0/)   !C14 
857: !      SITE(15,:)  = (/1.232560D0,  -3.575640D0,  0.000000D0/)   !C15 
858: !      SITE(16,:)  = (/-1.232560D0,  3.575640D0,  0.000000D0/)   !C16 
859: !      SITE(17,:)  = (/1.232560D0,  3.575640D0,  0.000000D0/)   !C17 
860: !      SITE(18,:)  = (/-1.232560D0,  -3.575640D0,  0.000000D0/)   !C18 
861: !      SITE(19,:)  = (/0.000000D0,  -2.874710D0,  0.000000D0/)   !C19 
862: !      SITE(20,:)  = (/0.000000D0,  2.874710D0,  0.000000D0/)   !C20 
863: !      SITE(21,:)  = (/1.217830D0,  -4.662620D0,  0.000000D0/)   !H1 
864: !      SITE(22,:)  = (/-1.217830D0,  4.662620D0,  0.000000D0/)   !H2 
865: !      SITE(23,:)  = (/1.217830D0,  4.662620D0,  0.000000D0/)   !H3 
866: !      SITE(24,:)  = (/-1.217830D0,  -4.662620D0,  0.000000D0/)   !H4 
867: !      SITE(25,:)  = (/3.368390D0,  -3.421400D0,  0.000000D0/)   !H5 
868: !      SITE(26,:)  = (/-3.368390D0,  3.421400D0,  0.000000D0/)   !H6 
869: !      SITE(27,:)  = (/3.368390D0,  3.421400D0,  0.000000D0/)   !H7 
870: !      SITE(28,:)  = (/-3.368390D0,  -3.421400D0,  0.000000D0/)   !H8 
871: !      SITE(29,:)  = (/3.388320D0,  -0.977500D0,  0.000000D0/)   !H9 
872: !      SITE(30,:)  = (/-3.388320D0,  0.977500D0,  0.000000D0/)   !H10 
873: !      SITE(31,:)  = (/3.388320D0,  0.977500D0,  0.000000D0/)   !H11 
874: !      SITE(32,:)  = (/-3.388320D0,  -0.977500D0,  0.000000D0/)   !H12 
875: ! 
876: !      SITE(:,:) =  SITE(:,:)/0.5291770D0 
877: ! 
878: !      STCHRG(1)  = 0.0235520D0 
879: !      STCHRG(2)  = 0.0235520D0 
880: !      STCHRG(3)  = 0.0294130D0 
881: !      STCHRG(4)  = 0.0294130D0 
882: !      STCHRG(5)  = 0.0294130D0 
883: !      STCHRG(6)  = 0.0294130D0 
884: !      STCHRG(7)  = -0.1999210D0 
885: !      STCHRG(8)  = -0.1999210D0 
886: !      STCHRG(9)  = -0.1999210D0 
887: !      STCHRG(10)  = -0.1999210D0 
888: !      STCHRG(11)  = -0.0757740D0 
889: !      STCHRG(12)  = -0.0757740D0 
890: !      STCHRG(13)  = -0.0757740D0 
891: !      STCHRG(14)  = -0.0757740D0 
892: !      STCHRG(15)  = -0.3459910D0 
893: !      STCHRG(16)  = -0.3459910D0 
894: !      STCHRG(17)  = -0.3459910D0 
895: !      STCHRG(18)  = -0.3459910D0 
896: !      STCHRG(19)  = 0.2862460D0 
897: !      STCHRG(20)  = 0.2862460D0 
898: !      STCHRG(21)  = 0.1680010D0 
899: !      STCHRG(22)  = 0.1680010D0 
900: !      STCHRG(23)  = 0.1680010D0 
901: !      STCHRG(24)  = 0.1680010D0 
902: !      STCHRG(25)  = 0.1286140D0 
903: !      STCHRG(26)  = 0.1286140D0 
904: !      STCHRG(27)  = 0.1286140D0 
905: !      STCHRG(28)  = 0.1286140D0 
906: !      STCHRG(29)  = 0.1407590D0 
907: !      STCHRG(30)  = 0.1407590D0 
908: !      STCHRG(31)  = 0.1407590D0 
909: !      STCHRG(32)  = 0.1407590D0 
910: ! 
911: !      RBSTLA(1,:)  = SITE(19,:)  - SITE(1,:)                 ! Z FROM C1 TO C19 
912: !      RBSTLA(2,:)  = SITE(20,:)  - SITE(2,:)                 ! Z FROM C2 TO C20 
913: !      RBSTLA(3,:)  = SITE(1,:)  - SITE(3,:)                 ! Z FROM C3 TO C1 
914: !      RBSTLA(4,:)  = SITE(2,:)  - SITE(4,:)                 ! Z FROM C4 TO C2 
915: !      RBSTLA(5,:)  = SITE(2,:)  - SITE(5,:)                 ! Z FROM C5 TO C2 
916: !      RBSTLA(6,:)  = SITE(1,:)  - SITE(6,:)                 ! Z FROM C6 TO C1 
917: !      RBSTLA(7,:)  = SITE(29,:)  - SITE(7,:)                 ! Z FROM C7 TO H9 
918: !      RBSTLA(8,:)  = SITE(30,:)  - SITE(8,:)                 ! Z FROM C8 TO H10 
919: !      RBSTLA(9,:)  = SITE(31,:)  - SITE(9,:)                 ! Z FROM C9 TO H11 
920: !      RBSTLA(10,:)  = SITE(32,:)  - SITE(10,:)                 ! Z FROM C10 TO H12 
921: !      RBSTLA(11,:)  = SITE(25,:)  - SITE(11,:)                 ! Z FROM C11 TO H5 
922: !      RBSTLA(12,:)  = SITE(26,:)  - SITE(12,:)                 ! Z FROM C12 TO H6 
923: !      RBSTLA(13,:)  = SITE(27,:)  - SITE(13,:)                 ! Z FROM C13 TO H7 
924: !      RBSTLA(14,:)  = SITE(28,:)  - SITE(14,:)                 ! Z FROM C14 TO H8 
925: !      RBSTLA(15,:)  = SITE(21,:)  - SITE(15,:)                 ! Z FROM C15 TO H1 
926: !      RBSTLA(16,:)  = SITE(22,:)  - SITE(16,:)                 ! Z FROM C16 TO H2 
927: !      RBSTLA(17,:)  = SITE(23,:)  - SITE(17,:)                 ! Z FROM C17 TO H3 
928: !      RBSTLA(18,:)  = SITE(24,:)  - SITE(18,:)                 ! Z FROM C18 TO H4 
929: !      RBSTLA(19,:)  = SITE(21,:)  - SITE(19,:)                 ! Z FROM C19 TO H1 
930: !      RBSTLA(20,:)  = SITE(22,:)  - SITE(20,:)                 ! Z FROM C20 TO H2 
931: !      RBSTLA(21,:)  = SITE(21,:)  - SITE(15,:)                 ! Z FROM C15 TO H1 
932: !      RBSTLA(22,:)  = SITE(22,:)  - SITE(16,:)                 ! Z FROM C16 TO H2 
933: !      RBSTLA(23,:)  = SITE(23,:)  - SITE(17,:)                 ! Z FROM C17 TO H3 
934: !      RBSTLA(24,:)  = SITE(24,:)  - SITE(18,:)                 ! Z FROM C18 TO H4 
935: !      RBSTLA(25,:)  = SITE(25,:)  - SITE(11,:)                 ! Z FROM C11 TO H5 
936: !      RBSTLA(26,:)  = SITE(26,:)  - SITE(12,:)                 ! Z FROM C12 TO H6 
937: !      RBSTLA(27,:)  = SITE(27,:)  - SITE(13,:)                 ! Z FROM C13 TO H7 
938: !      RBSTLA(28,:)  = SITE(28,:)  - SITE(14,:)                 ! Z FROM C14 TO H8 
939: !      RBSTLA(29,:)  = SITE(29,:)  - SITE(7,:)                 ! Z FROM C7 TO H9 
940: !      RBSTLA(30,:)  = SITE(30,:)  - SITE(8,:)                 ! Z FROM C8 TO H10 
941: !      RBSTLA(31,:)  = SITE(31,:)  - SITE(9,:)                 ! Z FROM C9 TO H11 
942: !      RBSTLA(32,:)  = SITE(32,:)  - SITE(10,:)                 ! Z FROM C10 TO H12 
943: ! 
944: !      DO J1 = 1, NRBSITES 
945: ! 
946: !         RBSTLA(J1,:)   = RBSTLA(J1,:)/DSQRT(DOT_PRODUCT(RBSTLA(J1,:),RBSTLA(J1,:))) 
947: ! 
948: !      ENDDO 
949: ! 
950: !      END SUBROUTINE DEFPERYLENE 
951: ! 
952: !!     ---------------------------------------------------------------------------------------------- 
953: ! 
954: !      SUBROUTINE DEFBENZOPERYLENE() 
955: ! 
956: !      USE COMMONS, ONLY: NRBSITES, SITE, RBSTLA, STCHRG 
957: ! 
958: !      IMPLICIT NONE 
959: ! 
960: !      INTEGER :: J1 
961: ! 
962: !!     C22H12 
963: ! 
964: !!     UNITS INITIALLY IN ANGSTROM 
965: ! 
966: !      SITE(1,:)  = (/-1.431340D0,  -0.344590D0,  0.000000D0/)   !C1 
967: !      SITE(2,:)  = (/1.431340D0,  -0.344590D0,  0.000000D0/)   !C2 
968: !      SITE(3,:)  = (/-0.713810D0,  0.895350D0,  0.000000D0/)   !C3 
969: !      SITE(4,:)  = (/0.734840D0,  -1.591900D0,  0.000000D0/)   !C4 
970: !      SITE(5,:)  = (/0.713810D0,  0.895350D0,  0.000000D0/)   !C5 
971: !      SITE(6,:)  = (/-0.734840D0,  -1.591900D0,  0.000000D0/)   !C6 
972: !      SITE(7,:)  = (/-1.418430D0,  2.128550D0,  0.000000D0/)   !C7 
973: !      SITE(8,:)  = (/1.490630D0,  -2.770590D0,  0.000000D0/)   !C8 
974: !      SITE(9,:)  = (/1.418430D0,  2.128550D0,  0.000000D0/)   !C9 
975: !      SITE(10,:)  = (/-1.490630D0,  -2.770590D0,  0.000000D0/)   !C10 
976: !      SITE(11,:)  = (/-2.850180D0,  2.113800D0,  0.000000D0/)   !C11 
977: !      SITE(12,:)  = (/2.888170D0,  -2.744870D0,  0.000000D0/)   !C12 
978: !      SITE(13,:)  = (/2.850180D0,  2.113800D0,  0.000000D0/)   !C13 
979: !      SITE(14,:)  = (/-2.888170D0,  -2.744870D0,  0.000000D0/)   !C14 
980: !      SITE(15,:)  = (/-3.540760D0,  0.939410D0,  0.000000D0/)   !C15 
981: !      SITE(16,:)  = (/3.570020D0,  -1.538170D0,  0.000000D0/)   !C16 
982: !      SITE(17,:)  = (/3.540760D0,  0.939410D0,  0.000000D0/)   !C17 
983: !      SITE(18,:)  = (/-3.570020D0,  -1.538170D0,  0.000000D0/)   !C18 
984: !      SITE(19,:)  = (/-0.687470D0,  3.343090D0,  0.000000D0/)   !C19 
985: !      SITE(20,:)  = (/0.687470D0,  3.343090D0,  0.000000D0/)   !C20 
986: !      SITE(21,:)  = (/-2.860950D0,  -0.323210D0,  0.000000D0/)   !C21 
987: !      SITE(22,:)  = (/2.860950D0,  -0.323210D0,  0.000000D0/)   !C22 
988: !      SITE(23,:)  = (/-4.628030D0,  0.938640D0,  0.000000D0/)   !H1 
989: !      SITE(24,:)  = (/4.657020D0,  -1.517650D0,  0.000000D0/)   !H2 
990: !      SITE(25,:)  = (/4.628030D0,  0.938640D0,  0.000000D0/)   !H3 
991: !      SITE(26,:)  = (/-4.657020D0,  -1.517650D0,  0.000000D0/)   !H4 
992: !      SITE(27,:)  = (/-3.378060D0,  3.064450D0,  0.000000D0/)   !H5 
993: !      SITE(28,:)  = (/3.438960D0,  -3.681560D0,  0.000000D0/)   !H6 
994: !      SITE(29,:)  = (/3.378060D0,  3.064450D0,  0.000000D0/)   !H7 
995: !      SITE(30,:)  = (/-3.438960D0,  -3.681560D0,  0.000000D0/)   !H8 
996: !      SITE(31,:)  = (/0.995680D0,  -3.735330D0,  0.000000D0/)   !H9 
997: !      SITE(32,:)  = (/-0.995680D0,  -3.735330D0,  0.000000D0/)   !H10 
998: !      SITE(33,:)  = (/-1.234990D0,  4.282540D0,  0.000000D0/)   !H11 
999: !      SITE(34,:)  = (/1.234990D0,  4.282540D0,  0.000000D0/)   !H12 
1000: ! 
1001: !      SITE(:,:) =  SITE(:,:)/0.5291770D0 
1002: ! 
1003: !      STCHRG(1)  = -0.0032350D0 
1004: !      STCHRG(2)  = -0.0032350D0 
1005: !      STCHRG(3)  = -0.0485040D0 
1006: !      STCHRG(4)  = 0.0531290D0 
1007: !      STCHRG(5)  = -0.0485040D0 
1008: !      STCHRG(6)  = 0.0531290D0 
1009: !      STCHRG(7)  = 0.1924370D0 
1010: !      STCHRG(8)  = -0.2123090D0 
1011: !      STCHRG(9)  = 0.1924370D0 
1012: !      STCHRG(10)  = -0.2123090D0 
1013: !      STCHRG(11)  = -0.2288940D0 
1014: !      STCHRG(12)  = -0.081160D0 
1015: !      STCHRG(13)  = -0.2288940D0 
1016: !      STCHRG(14)  = -0.081160D0 
1017: !      STCHRG(15)  = -0.2808820D0 
1018: !      STCHRG(16)  = -0.2932090D0 
1019: !      STCHRG(17)  = -0.2808820D0 
1020: !      STCHRG(18)  = -0.2932090D0 
1021: !      STCHRG(19)  = -0.2320860D0 
1022: !      STCHRG(20)  = -0.2320860D0 
1023: !      STCHRG(21)  = 0.2334920D0 
1024: !      STCHRG(22)  = 0.2334920D0 
1025: !      STCHRG(23)  = 0.1662180D0 
1026: !      STCHRG(24)  = 0.1553260D0 
1027: !      STCHRG(25)  = 0.1662180D0 
1028: !      STCHRG(26)  = 0.1553260D0 
1029: !      STCHRG(27)  = 0.1545260D0 
1030: !      STCHRG(28)  = 0.1290550D0 
1031: !      STCHRG(29)  = 0.1545260D0 
1032: !      STCHRG(30)  = 0.1290550D0 
1033: !      STCHRG(31)  = 0.1437480D0 
1034: !      STCHRG(32)  = 0.1437480D0 
1035: !      STCHRG(33)  = 0.1523490D0 
1036: !      STCHRG(34)  = 0.1523490D0 
1037: ! 
1038: !      RBSTLA(1,:)  = SITE(3,:)  - SITE(1,:)                 ! Z FROM C1 TO C3 
1039: !      RBSTLA(2,:)  = SITE(5,:)  - SITE(2,:)                 ! Z FROM C2 TO C5 
1040: !      RBSTLA(3,:)  = SITE(7,:)  - SITE(3,:)                 ! Z FROM C3 TO C7 
1041: !      RBSTLA(4,:)  = SITE(2,:)  - SITE(4,:)                 ! Z FROM C4 TO C2 
1042: !      RBSTLA(5,:)  = SITE(9,:)  - SITE(5,:)                 ! Z FROM C5 TO C9 
1043: !      RBSTLA(6,:)  = SITE(1,:)  - SITE(6,:)                 ! Z FROM C6 TO C1 
1044: !      RBSTLA(7,:)  = SITE(3,:)  - SITE(7,:)                 ! Z FROM C7 TO C3 
1045: !      RBSTLA(8,:)  = SITE(31,:)  - SITE(8,:)                 ! Z FROM C8 TO H9 
1046: !      RBSTLA(9,:)  = SITE(5,:)  - SITE(9,:)                 ! Z FROM C9 TO C5 
1047: !      RBSTLA(10,:)  = SITE(32,:)  - SITE(10,:)                 ! Z FROM C10 TO H10 
1048: !      RBSTLA(11,:)  = SITE(27,:)  - SITE(11,:)                 ! Z FROM C11 TO H5 
1049: !      RBSTLA(12,:)  = SITE(28,:)  - SITE(12,:)                 ! Z FROM C12 TO H6 
1050: !      RBSTLA(13,:)  = SITE(29,:)  - SITE(13,:)                 ! Z FROM C13 TO H7 
1051: !      RBSTLA(14,:)  = SITE(30,:)  - SITE(14,:)                 ! Z FROM C14 TO H8 
1052: !      RBSTLA(15,:)  = SITE(23,:)  - SITE(15,:)                 ! Z FROM C15 TO H1 
1053: !      RBSTLA(16,:)  = SITE(24,:)  - SITE(16,:)                 ! Z FROM C16 TO H2 
1054: !      RBSTLA(17,:)  = SITE(25,:)  - SITE(17,:)                 ! Z FROM C17 TO H3 
1055: !      RBSTLA(18,:)  = SITE(26,:)  - SITE(18,:)                 ! Z FROM C18 TO H4 
1056: !      RBSTLA(19,:)  = SITE(33,:)  - SITE(19,:)                 ! Z FROM C19 TO H11 
1057: !      RBSTLA(20,:)  = SITE(34,:)  - SITE(20,:)                 ! Z FROM C20 TO H12 
1058: !      RBSTLA(21,:)  = SITE(1,:)  - SITE(21,:)                 ! Z FROM C21 TO C1 
1059: !      RBSTLA(22,:)  = SITE(2,:)  - SITE(22,:)                 ! Z FROM C22 TO C2 
1060: !      RBSTLA(23,:)  = SITE(23,:)  - SITE(15,:)                 ! Z FROM C15 TO H1 
1061: !      RBSTLA(24,:)  = SITE(24,:)  - SITE(16,:)                 ! Z FROM C16 TO H2 
1062: !      RBSTLA(25,:)  = SITE(25,:)  - SITE(17,:)                 ! Z FROM C17 TO H3 
1063: !      RBSTLA(26,:)  = SITE(26,:)  - SITE(18,:)                 ! Z FROM C18 TO H4 
1064: !      RBSTLA(27,:)  = SITE(27,:)  - SITE(11,:)                 ! Z FROM C11 TO H5 
1065: !      RBSTLA(28,:)  = SITE(28,:)  - SITE(12,:)                 ! Z FROM C12 TO H6 
1066: !      RBSTLA(29,:)  = SITE(29,:)  - SITE(13,:)                 ! Z FROM C13 TO H7 
1067: !      RBSTLA(30,:)  = SITE(30,:)  - SITE(14,:)                 ! Z FROM C14 TO H8 
1068: !      RBSTLA(31,:)  = SITE(31,:)  - SITE(8,:)                 ! Z FROM C8 TO H9 
1069: !      RBSTLA(32,:)  = SITE(32,:)  - SITE(10,:)                 ! Z FROM C10 TO H10 
1070: !      RBSTLA(33,:)  = SITE(33,:)  - SITE(19,:)                 ! Z FROM C19 TO H11 
1071: !      RBSTLA(34,:)  = SITE(34,:)  - SITE(20,:)                 ! Z FROM C20 TO H12 
1072: ! 
1073: !      DO J1 = 1, NRBSITES 
1074: ! 
1075: !         RBSTLA(J1,:)   = RBSTLA(J1,:)/DSQRT(DOT_PRODUCT(RBSTLA(J1,:),RBSTLA(J1,:))) 
1076: ! 
1077: !      ENDDO 
1078: ! 
1079: !      END SUBROUTINE DEFBENZOPERYLENE 
1080: ! 
1081: !!     ---------------------------------------------------------------------------------------------- 
1082: ! 
1083: !      SUBROUTINE DEFCORONENE() 
1084: ! 
1085: !      USE COMMONS, ONLY: NRBSITES, SITE, RBSTLA, STCHRG 
1086: ! 
1087: !      IMPLICIT NONE 
1088: ! 
1089: !      INTEGER :: J1 
1090: ! 
1091: !!     C24H12 
1092: ! 
1093: !!     UNITS INITIALLY IN ANGSTROM 
1094: ! 
1095: !      SITE(1,:)  = (/1.427510D0,  0.000000D0,  0.000000D0/)   !C1 
1096: !      SITE(2,:)  = (/0.713760D0,  1.236260D0,  0.000000D0/)   !C2 
1097: !      SITE(3,:)  = (/-0.713750D0,  1.236260D0,  0.000000D0/)   !C3 
1098: !      SITE(4,:)  = (/-1.427500D0,  0.000000D0,  0.000000D0/)   !C4 
1099: !      SITE(5,:)  = (/-0.713750D0,  -1.236260D0,  0.000000D0/)   !C5 
1100: !      SITE(6,:)  = (/0.713760D0,  -1.236260D0,  0.000000D0/)   !C6 
1101: !      SITE(7,:)  = (/2.849060D0,  0.000000D0,  0.000000D0/)   !C7 
1102: !      SITE(8,:)  = (/1.424540D0,  2.467360D0,  0.000000D0/)   !C8 
1103: !      SITE(9,:)  = (/-1.424530D0,  2.467360D0,  0.000000D0/)   !C9 
1104: !      SITE(10,:)  = (/-2.849050D0,  0.000000D0,  0.000000D0/)   !C10 
1105: !      SITE(11,:)  = (/-1.424530D0,  -2.467360D0,  0.000000D0/)   !C11 
1106: !      SITE(12,:)  = (/1.424540D0,  -2.467360D0,  0.000000D0/)   !C12 
1107: !      SITE(13,:)  = (/3.534380D0,  1.248270D0,  0.000000D0/)   !C13 
1108: !      SITE(14,:)  = (/2.848230D0,  2.436730D0,  0.000000D0/)   !C14 
1109: !      SITE(15,:)  = (/0.686160D0,  3.685010D0,  0.000000D0/)   !C15 
1110: !      SITE(16,:)  = (/-0.686150D0,  3.685010D0,  0.000000D0/)   !C16 
1111: !      SITE(17,:)  = (/-2.848230D0,  2.436730D0,  0.000000D0/)   !C17 
1112: !      SITE(18,:)  = (/-3.534380D0,  1.248270D0,  0.000000D0/)   !C18 
1113: !      SITE(19,:)  = (/-3.534380D0,  -1.248270D0,  0.000000D0/)   !C19 
1114: !      SITE(20,:)  = (/-2.848230D0,  -2.436730D0,  0.000000D0/)   !C20 
1115: !      SITE(21,:)  = (/-0.686150D0,  -3.685010D0,  0.000000D0/)   !C21 
1116: !      SITE(22,:)  = (/0.686160D0,  -3.685010D0,  0.000000D0/)   !C22 
1117: !      SITE(23,:)  = (/2.848230D0,  -2.436730D0,  0.000000D0/)   !C23 
1118: !      SITE(24,:)  = (/3.534380D0,  -1.248270D0,  0.000000D0/)   !C24 
1119: !      SITE(25,:)  = (/4.621790D0,  1.245370D0,  0.000000D0/)   !H1 
1120: !      SITE(26,:)  = (/3.389430D0,  3.379890D0,  0.000000D0/)   !H2 
1121: !      SITE(27,:)  = (/1.232370D0,  4.625280D0,  0.000000D0/)   !H3 
1122: !      SITE(28,:)  = (/-1.232360D0,  4.625280D0,  0.000000D0/)   !H4 
1123: !      SITE(29,:)  = (/-3.389420D0,  3.379890D0,  0.000000D0/)   !H5 
1124: !      SITE(30,:)  = (/-4.621780D0,  1.245370D0,  0.000000D0/)   !H6 
1125: !      SITE(31,:)  = (/-4.621780D0,  -1.245370D0,  0.000000D0/)   !H7 
1126: !      SITE(32,:)  = (/-3.389420D0,  -3.379890D0,  0.000000D0/)   !H8 
1127: !      SITE(33,:)  = (/-1.232360D0,  -4.625280D0,  0.000000D0/)   !H9 
1128: !      SITE(34,:)  = (/1.232370D0,  -4.625280D0,  0.000000D0/)   !H10 
1129: !      SITE(35,:)  = (/3.389430D0,  -3.379890D0,  0.000000D0/)   !H11 
1130: !      SITE(36,:)  = (/4.621790D0,  -1.245370D0,  0.000000D0/)   !H12 
1131: ! 
1132: !      SITE(:,:) =  SITE(:,:)/0.5291770D0 
1133: ! 
1134: !      STCHRG(1)  = -0.0110220D0 
1135: !      STCHRG(2)  = -0.0110220D0 
1136: !      STCHRG(3)  = -0.0110220D0 
1137: !      STCHRG(4)  = -0.0110220D0 
1138: !      STCHRG(5)  = -0.0110220D0 
1139: !      STCHRG(6)  = -0.0110220D0 
1140: !      STCHRG(7)  = 0.1817100D0 
1141: !      STCHRG(8)  = 0.1817100D0 
1142: !      STCHRG(9)  = 0.1817100D0 
1143: !      STCHRG(10)  = 0.1817100D0 
1144: !      STCHRG(11)  = 0.1817100D0 
1145: !      STCHRG(12)  = 0.1817100D0 
1146: !      STCHRG(13)  = -0.2397720D0 
1147: !      STCHRG(14)  = -0.2397720D0 
1148: !      STCHRG(15)  = -0.2397720D0 
1149: !      STCHRG(16)  = -0.2397720D0 
1150: !      STCHRG(17)  = -0.2397720D0 
1151: !      STCHRG(18)  = -0.2397720D0 
1152: !      STCHRG(19)  = -0.2397720D0 
1153: !      STCHRG(20)  = -0.2397720D0 
1154: !      STCHRG(21)  = -0.2397720D0 
1155: !      STCHRG(22)  = -0.2397720D0 
1156: !      STCHRG(23)  = -0.2397720D0 
1157: !      STCHRG(24)  = -0.2397720D0 
1158: !      STCHRG(25)  = 0.1544280D0 
1159: !      STCHRG(26)  = 0.1544280D0 
1160: !      STCHRG(27)  = 0.1544280D0 
1161: !      STCHRG(28)  = 0.1544280D0 
1162: !      STCHRG(29)  = 0.1544280D0 
1163: !      STCHRG(30)  = 0.1544280D0 
1164: !      STCHRG(31)  = 0.1544280D0 
1165: !      STCHRG(32)  = 0.1544280D0 
1166: !      STCHRG(33)  = 0.1544280D0 
1167: !      STCHRG(34)  = 0.1544280D0 
1168: !      STCHRG(35)  = 0.1544280D0 
1169: !      STCHRG(36)  = 0.1544280D0 
1170: ! 
1171: !      RBSTLA(1,:)  = SITE(7,:)  - SITE(1,:)                 ! Z FROM C1 TO C7 
1172: !      RBSTLA(2,:)  = SITE(8,:)  - SITE(2,:)                 ! Z FROM C2 TO C8 
1173: !      RBSTLA(3,:)  = SITE(9,:)  - SITE(3,:)                 ! Z FROM C3 TO C9 
1174: !      RBSTLA(4,:)  = SITE(10,:)  - SITE(4,:)                 ! Z FROM C4 TO C10 
1175: !      RBSTLA(5,:)  = SITE(11,:)  - SITE(5,:)                 ! Z FROM C5 TO C11 
1176: !      RBSTLA(6,:)  = SITE(12,:)  - SITE(6,:)                 ! Z FROM C6 TO C12 
1177: !      RBSTLA(7,:)  = SITE(1,:)  - SITE(7,:)                 ! Z FROM C7 TO C1 
1178: !      RBSTLA(8,:)  = SITE(2,:)  - SITE(8,:)                 ! Z FROM C8 TO C2 
1179: !      RBSTLA(9,:)  = SITE(3,:)  - SITE(9,:)                 ! Z FROM C9 TO C3 
1180: !      RBSTLA(10,:)  = SITE(4,:)  - SITE(10,:)                 ! Z FROM C10 TO C4 
1181: !      RBSTLA(11,:)  = SITE(5,:)  - SITE(11,:)                 ! Z FROM C11 TO C5 
1182: !      RBSTLA(12,:)  = SITE(6,:)  - SITE(12,:)                 ! Z FROM C12 TO C6 
1183: !      RBSTLA(13,:)  = SITE(25,:)  - SITE(13,:)                 ! Z FROM C13 TO H1 
1184: !      RBSTLA(14,:)  = SITE(26,:)  - SITE(14,:)                 ! Z FROM C14 TO H2 
1185: !      RBSTLA(15,:)  = SITE(27,:)  - SITE(15,:)                 ! Z FROM C15 TO H3 
1186: !      RBSTLA(16,:)  = SITE(28,:)  - SITE(16,:)                 ! Z FROM C16 TO H4 
1187: !      RBSTLA(17,:)  = SITE(29,:)  - SITE(17,:)                 ! Z FROM C17 TO H5 
1188: !      RBSTLA(18,:)  = SITE(30,:)  - SITE(18,:)                 ! Z FROM C18 TO H6 
1189: !      RBSTLA(19,:)  = SITE(31,:)  - SITE(19,:)                 ! Z FROM C19 TO H7 
1190: !      RBSTLA(20,:)  = SITE(32,:)  - SITE(20,:)                 ! Z FROM C20 TO H8 
1191: !      RBSTLA(21,:)  = SITE(33,:)  - SITE(21,:)                 ! Z FROM C21 TO H9 
1192: !      RBSTLA(22,:)  = SITE(34,:)  - SITE(22,:)                 ! Z FROM C22 TO H10 
1193: !      RBSTLA(23,:)  = SITE(35,:)  - SITE(23,:)                 ! Z FROM C23 TO H11 
1194: !      RBSTLA(24,:)  = SITE(36,:)  - SITE(24,:)                 ! Z FROM C24 TO H12 
1195: !      RBSTLA(25,:)  = SITE(25,:)  - SITE(13,:)                 ! Z FROM C13 TO H1 
1196: !      RBSTLA(26,:)  = SITE(26,:)  - SITE(14,:)                 ! Z FROM C14 TO H2 
1197: !      RBSTLA(27,:)  = SITE(27,:)  - SITE(15,:)                 ! Z FROM C15 TO H3 
1198: !      RBSTLA(28,:)  = SITE(28,:)  - SITE(16,:)                 ! Z FROM C16 TO H4 
1199: !      RBSTLA(29,:)  = SITE(29,:)  - SITE(17,:)                 ! Z FROM C17 TO H5 
1200: !      RBSTLA(30,:)  = SITE(30,:)  - SITE(18,:)                 ! Z FROM C18 TO H6 
1201: !      RBSTLA(31,:)  = SITE(31,:)  - SITE(19,:)                 ! Z FROM C19 TO H7 
1202: !      RBSTLA(32,:)  = SITE(32,:)  - SITE(20,:)                 ! Z FROM C20 TO H8 
1203: !      RBSTLA(33,:)  = SITE(33,:)  - SITE(21,:)                 ! Z FROM C21 TO H9 
1204: !      RBSTLA(34,:)  = SITE(34,:)  - SITE(22,:)                 ! Z FROM C22 TO H10 
1205: !      RBSTLA(35,:)  = SITE(35,:)  - SITE(23,:)                 ! Z FROM C23 TO H11 
1206: !      RBSTLA(36,:)  = SITE(36,:)  - SITE(24,:)                 ! Z FROM C24 TO H12 
1207: ! 
1208: !      DO J1 = 1, NRBSITES 
1209: ! 
1210: !         RBSTLA(J1,:)   = RBSTLA(J1,:)/DSQRT(DOT_PRODUCT(RBSTLA(J1,:),RBSTLA(J1,:))) 
1211: ! 
1212: !      ENDDO 
1213: ! 
1214: !      END SUBROUTINE DEFCORONENE 
1215: ! 
1216: !!     ---------------------------------------------------------------------------------------------- 
1217: ! 
1218: !      SUBROUTINE DEFBISANTHENE() 
1219: ! 
1220: !      USE COMMONS, ONLY: NRBSITES, SITE, RBSTLA, STCHRG 
1221: ! 
1222: !      IMPLICIT NONE 
1223: ! 
1224: !      INTEGER :: J1 
1225: ! 
1226: !!     C28H14 
1227: ! 
1228: !!     UNITS INITIALLY IN ANGSTROM 
1229: ! 
1230: !      SITE(1,:)  = (/0.726050D0,  0.000000D0,  0.000000D0/)   !C1 
1231: !      SITE(2,:)  = (/-0.726050D0,  0.000000D0,  0.000000D0/)   !C2 
1232: !      SITE(3,:)  = (/1.431660D0,  -1.230140D0,  0.000000D0/)   !C3 
1233: !      SITE(4,:)  = (/-1.431660D0,  -1.230140D0,  0.000000D0/)   !C4 
1234: !      SITE(5,:)  = (/1.431660D0,  1.230140D0,  0.000000D0/)   !C5 
1235: !      SITE(6,:)  = (/-1.431660D0,  1.230140D0,  0.000000D0/)   !C6 
1236: !      SITE(7,:)  = (/0.736110D0,  -2.487820D0,  0.000000D0/)   !C7 
1237: !      SITE(8,:)  = (/-0.736110D0,  -2.487820D0,  0.000000D0/)   !C8 
1238: !      SITE(9,:)  = (/0.736110D0,  2.487820D0,  0.000000D0/)   !C9 
1239: !      SITE(10,:)  = (/-0.736110D0,  2.487820D0,  0.000000D0/)   !C10 
1240: !      SITE(11,:)  = (/2.872800D0,  -1.222330D0,  0.000000D0/)   !C11 
1241: !      SITE(12,:)  = (/-2.872800D0,  -1.222330D0,  0.000000D0/)   !C12 
1242: !      SITE(13,:)  = (/2.872800D0,  1.222330D0,  0.000000D0/)   !C13 
1243: !      SITE(14,:)  = (/-2.872800D0,  1.222330D0,  0.000000D0/)   !C14 
1244: !      SITE(15,:)  = (/3.552990D0,  0.000000D0,  0.000000D0/)   !C15 
1245: !      SITE(16,:)  = (/-3.552990D0,  0.000000D0,  0.000000D0/)   !C16 
1246: !      SITE(17,:)  = (/3.579590D0,  -2.458470D0,  0.000000D0/)   !C17 
1247: !      SITE(18,:)  = (/-3.579590D0,  -2.458470D0,  0.000000D0/)   !C18 
1248: !      SITE(19,:)  = (/3.579590D0,  2.458470D0,  0.000000D0/)   !C19 
1249: !      SITE(20,:)  = (/-3.579590D0,  2.458470D0,  0.000000D0/)   !C20 
1250: !      SITE(21,:)  = (/2.894490D0,  -3.647210D0,  0.000000D0/)   !C21 
1251: !      SITE(22,:)  = (/-2.894500D0,  -3.647210D0,  0.000000D0/)   !C22 
1252: !      SITE(23,:)  = (/2.894500D0,  3.647210D0,  0.000000D0/)   !C23 
1253: !      SITE(24,:)  = (/-2.894500D0,  3.647210D0,  0.000000D0/)   !C24 
1254: !      SITE(25,:)  = (/1.483700D0,  -3.659590D0,  0.000000D0/)   !C25 
1255: !      SITE(26,:)  = (/-1.483700D0,  -3.659590D0,  0.000000D0/)   !C26 
1256: !      SITE(27,:)  = (/1.483700D0,  3.659590D0,  0.000000D0/)   !C27 
1257: !      SITE(28,:)  = (/-1.483700D0,  3.659590D0,  0.000000D0/)   !C28 
1258: !      SITE(29,:)  = (/4.640690D0,  0.000000D0,  0.000000D0/)   !H1 
1259: !      SITE(30,:)  = (/-4.640690D0,  0.000000D0,  0.000000D0/)   !H2 
1260: !      SITE(31,:)  = (/4.666360D0,  -2.438830D0,  0.000000D0/)   !H3 
1261: !      SITE(32,:)  = (/-4.666360D0,  -2.438830D0,  0.000000D0/)   !H4 
1262: !      SITE(33,:)  = (/4.666360D0,  2.438830D0,  0.000000D0/)   !H5 
1263: !      SITE(34,:)  = (/-4.666360D0,  2.438830D0,  0.000000D0/)   !H6 
1264: !      SITE(35,:)  = (/3.432380D0,  -4.591340D0,  0.000000D0/)   !H7 
1265: !      SITE(36,:)  = (/-3.432380D0,  -4.591340D0,  0.000000D0/)   !H8 
1266: !      SITE(37,:)  = (/3.432380D0,  4.591340D0,  0.000000D0/)   !H9 
1267: !      SITE(38,:)  = (/-3.432380D0,  4.591340D0,  0.000000D0/)   !H10 
1268: !      SITE(39,:)  = (/0.986740D0,  -4.623150D0,  0.000000D0/)   !H11 
1269: !      SITE(40,:)  = (/-0.986740D0,  -4.623150D0,  0.000000D0/)   !H12 
1270: !      SITE(41,:)  = (/0.986740D0,  4.623150D0,  0.000000D0/)   !H13 
1271: !      SITE(42,:)  = (/-0.986740D0,  4.623150D0,  0.000000D0/)   !H14 
1272: ! 
1273: !      SITE(:,:) =  SITE(:,:)/0.5291770D0 
1274: ! 
1275: !      STCHRG(1)  = -0.0461580D0 
1276: !      STCHRG(2)  = -0.0461580D0 
1277: !      STCHRG(3)  = -0.0059470D0 
1278: !      STCHRG(4)  = -0.0059470D0 
1279: !      STCHRG(5)  = -0.0059470D0 
1280: !      STCHRG(6)  = -0.0059470D0 
1281: !      STCHRG(7)  = 0.0554270D0 
1282: !      STCHRG(8)  = 0.0554270D0 
1283: !      STCHRG(9)  = 0.0554270D0 
1284: !      STCHRG(10)  = 0.0554270D0 
1285: !      STCHRG(11)  = 0.2774230D0 
1286: !      STCHRG(12)  = 0.2774230D0 
1287: !      STCHRG(13)  = 0.2774230D0 
1288: !      STCHRG(14)  = 0.2774230D0 
1289: !      STCHRG(15)  = -0.4862500D0 
1290: !      STCHRG(16)  = -0.4862500D0 
1291: !      STCHRG(17)  = -0.2731650D0 
1292: !      STCHRG(18)  = -0.2731650D0 
1293: !      STCHRG(19)  = -0.2731650D0 
1294: !      STCHRG(20)  = -0.2731650D0 
1295: !      STCHRG(21)  = -0.1022400D0 
1296: !      STCHRG(22)  = -0.1022400D0 
1297: !      STCHRG(23)  = -0.1022400D0 
1298: !      STCHRG(24)  = -0.1022400D0 
1299: !      STCHRG(25)  = -0.2224090D0 
1300: !      STCHRG(26)  = -0.2224090D0 
1301: !      STCHRG(27)  = -0.2224090D0 
1302: !      STCHRG(28)  = -0.2224090D0 
1303: !      STCHRG(29)  = 0.1992400D0 
1304: !      STCHRG(30)  = 0.1992400D0 
1305: !      STCHRG(31)  = 0.1538890D0 
1306: !      STCHRG(32)  = 0.1538890D0 
1307: !      STCHRG(33)  = 0.1538890D0 
1308: !      STCHRG(34)  = 0.1538890D0 
1309: !      STCHRG(35)  = 0.1352520D0 
1310: !      STCHRG(36)  = 0.1352520D0 
1311: !      STCHRG(37)  = 0.1352520D0 
1312: !      STCHRG(38)  = 0.1352520D0 
1313: !      STCHRG(39)  = 0.1483550D0 
1314: !      STCHRG(40)  = 0.1483550D0 
1315: !      STCHRG(41)  = 0.1483550D0 
1316: !      STCHRG(42)  = 0.1483550D0 
1317: ! 
1318: !      RBSTLA(1,:)  = SITE(2,:)  - SITE(1,:)                 ! Z FROM C1 TO C2 
1319: !      RBSTLA(2,:)  = SITE(1,:)  - SITE(2,:)                 ! Z FROM C2 TO C1 
1320: !      RBSTLA(3,:)  = SITE(1,:)  - SITE(3,:)                 ! Z FROM C3 TO C1 
1321: !      RBSTLA(4,:)  = SITE(2,:)  - SITE(4,:)                 ! Z FROM C4 TO C2 
1322: !      RBSTLA(5,:)  = SITE(1,:)  - SITE(5,:)                 ! Z FROM C5 TO C1 
1323: !      RBSTLA(6,:)  = SITE(2,:)  - SITE(6,:)                 ! Z FROM C6 TO C2 
1324: !      RBSTLA(7,:)  = SITE(8,:)  - SITE(7,:)                 ! Z FROM C7 TO C8 
1325: !      RBSTLA(8,:)  = SITE(7,:)  - SITE(8,:)                 ! Z FROM C8 TO C7 
1326: !      RBSTLA(9,:)  = SITE(10,:)  - SITE(9,:)                 ! Z FROM C9 TO C10 
1327: !      RBSTLA(10,:)  = SITE(9,:)  - SITE(10,:)                 ! Z FROM C10 TO C9 
1328: !      RBSTLA(11,:)  = SITE(3,:)  - SITE(11,:)                 ! Z FROM C11 TO C3 
1329: !      RBSTLA(12,:)  = SITE(4,:)  - SITE(12,:)                 ! Z FROM C12 TO C4 
1330: !      RBSTLA(13,:)  = SITE(5,:)  - SITE(13,:)                 ! Z FROM C13 TO C5 
1331: !      RBSTLA(14,:)  = SITE(6,:)  - SITE(14,:)                 ! Z FROM C14 TO C6 
1332: !      RBSTLA(15,:)  = SITE(29,:)  - SITE(15,:)                 ! Z FROM C15 TO H1 
1333: !      RBSTLA(16,:)  = SITE(30,:)  - SITE(16,:)                 ! Z FROM C16 TO H2 
1334: !      RBSTLA(17,:)  = SITE(31,:)  - SITE(17,:)                 ! Z FROM C17 TO H3 
1335: !      RBSTLA(18,:)  = SITE(32,:)  - SITE(18,:)                 ! Z FROM C18 TO H4 
1336: !      RBSTLA(19,:)  = SITE(33,:)  - SITE(19,:)                 ! Z FROM C19 TO H5 
1337: !      RBSTLA(20,:)  = SITE(34,:)  - SITE(20,:)                 ! Z FROM C20 TO H6 
1338: !      RBSTLA(21,:)  = SITE(35,:)  - SITE(21,:)                 ! Z FROM C21 TO H7 
1339: !      RBSTLA(22,:)  = SITE(36,:)  - SITE(22,:)                 ! Z FROM C22 TO H8 
1340: !      RBSTLA(23,:)  = SITE(37,:)  - SITE(23,:)                 ! Z FROM C23 TO H9 
1341: !      RBSTLA(24,:)  = SITE(38,:)  - SITE(24,:)                 ! Z FROM C24 TO H10 
1342: !      RBSTLA(25,:)  = SITE(39,:)  - SITE(25,:)                 ! Z FROM C25 TO H11 
1343: !      RBSTLA(26,:)  = SITE(40,:)  - SITE(26,:)                 ! Z FROM C26 TO H12 
1344: !      RBSTLA(27,:)  = SITE(41,:)  - SITE(27,:)                 ! Z FROM C27 TO H13 
1345: !      RBSTLA(28,:)  = SITE(42,:)  - SITE(28,:)                 ! Z FROM C28 TO H14 
1346: !      RBSTLA(29,:)  = SITE(29,:)  - SITE(15,:)                 ! Z FROM C15 TO H1 
1347: !      RBSTLA(30,:)  = SITE(30,:)  - SITE(16,:)                 ! Z FROM C16 TO H2 
1348: !      RBSTLA(31,:)  = SITE(31,:)  - SITE(17,:)                 ! Z FROM C17 TO H3 
1349: !      RBSTLA(32,:)  = SITE(32,:)  - SITE(18,:)                 ! Z FROM C18 TO H4 
1350: !      RBSTLA(33,:)  = SITE(33,:)  - SITE(19,:)                 ! Z FROM C19 TO H5 
1351: !      RBSTLA(34,:)  = SITE(34,:)  - SITE(20,:)                 ! Z FROM C20 TO H6 
1352: !      RBSTLA(35,:)  = SITE(35,:)  - SITE(21,:)                 ! Z FROM C21 TO H7 
1353: !      RBSTLA(36,:)  = SITE(36,:)  - SITE(22,:)                 ! Z FROM C22 TO H8 
1354: !      RBSTLA(37,:)  = SITE(37,:)  - SITE(23,:)                 ! Z FROM C23 TO H9 
1355: !      RBSTLA(38,:)  = SITE(38,:)  - SITE(24,:)                 ! Z FROM C24 TO H10 
1356: !      RBSTLA(39,:)  = SITE(39,:)  - SITE(25,:)                 ! Z FROM C25 TO H11 
1357: !      RBSTLA(40,:)  = SITE(40,:)  - SITE(26,:)                 ! Z FROM C26 TO H12 
1358: !      RBSTLA(41,:)  = SITE(41,:)  - SITE(27,:)                 ! Z FROM C27 TO H13 
1359: !      RBSTLA(42,:)  = SITE(42,:)  - SITE(28,:)                 ! Z FROM C28 TO H14 
1360: ! 
1361: !      DO J1 = 1, NRBSITES 
1362: ! 
1363: !         RBSTLA(J1,:)   = RBSTLA(J1,:)/DSQRT(DOT_PRODUCT(RBSTLA(J1,:),RBSTLA(J1,:))) 
1364: ! 
1365: !      ENDDO 
1366: ! 
1367: !      END SUBROUTINE DEFBISANTHENE 
1368: ! 
1369: !!     ---------------------------------------------------------------------------------------------- 
1370: ! 
1371: !      SUBROUTINE DEFOVALENE() 
1372: ! 
1373: !      USE COMMONS, ONLY: NRBSITES, SITE, RBSTLA, STCHRG 
1374: ! 
1375: !      IMPLICIT NONE 
1376: ! 
1377: !      INTEGER :: J1 
1378: ! 
1379: !!     C32H14 
1380: ! 
1381: !!     UNITS INITIALLY IN ANGSTROM 
1382: ! 
1383: !      SITE(1,:)  = (/-1.228120D0,  -1.426290D0,  0.000000D0/)   !C1 
1384: !      SITE(2,:)  = (/0.000000D0,  -0.717510D0,  0.000000D0/)   !C2 
1385: !      SITE(3,:)  = (/0.000000D0,  0.717510D0,  0.000000D0/)   !C3 
1386: !      SITE(4,:)  = (/-1.228120D0,  1.426290D0,  0.000000D0/)   !C4 
1387: !      SITE(5,:)  = (/-2.464490D0,  0.713290D0,  0.000000D0/)   !C5 
1388: !      SITE(6,:)  = (/-2.464490D0,  -0.713290D0,  0.000000D0/)   !C6 
1389: !      SITE(7,:)  = (/-1.224540D0,  -2.858360D0,  0.000000D0/)   !C7 
1390: !      SITE(8,:)  = (/1.228120D0,  -1.426290D0,  0.000000D0/)   !C8 
1391: !      SITE(9,:)  = (/1.228120D0,  1.426290D0,  0.000000D0/)   !C9 
1392: !      SITE(10,:)  = (/-1.224540D0,  2.858360D0,  0.000000D0/)   !C10 
1393: !      SITE(11,:)  = (/-3.697210D0,  1.423190D0,  0.000000D0/)   !C11 
1394: !      SITE(12,:)  = (/-3.697210D0,  -1.423190D0,  0.000000D0/)   !C12 
1395: !      SITE(13,:)  = (/1.224530D0,  -2.858360D0,  0.000000D0/)   !C13 
1396: !      SITE(14,:)  = (/2.464490D0,  -0.713290D0,  0.000000D0/)   !C14 
1397: !      SITE(15,:)  = (/2.464490D0,  0.713290D0,  0.000000D0/)   !C15 
1398: !      SITE(16,:)  = (/1.224530D0,  2.858360D0,  0.000000D0/)   !C16 
1399: !      SITE(17,:)  = (/-3.665710D0,  2.855940D0,  0.000000D0/)   !C17 
1400: !      SITE(18,:)  = (/-4.907220D0,  0.690170D0,  0.000000D0/)   !C18 
1401: !      SITE(19,:)  = (/-4.907220D0,  -0.690170D0,  0.000000D0/)   !C19 
1402: !      SITE(20,:)  = (/-3.665710D0,  -2.855940D0,  0.000000D0/)   !C20 
1403: !      SITE(21,:)  = (/0.000000D0,  -3.539310D0,  0.000000D0/)   !C21 
1404: !      SITE(22,:)  = (/3.697210D0,  -1.423190D0,  0.000000D0/)   !C22 
1405: !      SITE(23,:)  = (/3.697210D0,  1.423190D0,  0.000000D0/)   !C23 
1406: !      SITE(24,:)  = (/0.000000D0,  3.539310D0,  0.000000D0/)   !C24 
1407: !      SITE(25,:)  = (/-2.485870D0,  3.542240D0,  0.000000D0/)   !C25 
1408: !      SITE(26,:)  = (/-2.485870D0,  -3.542240D0,  0.000000D0/)   !C26 
1409: !      SITE(27,:)  = (/2.485870D0,  -3.542240D0,  0.000000D0/)   !C27 
1410: !      SITE(28,:)  = (/3.665710D0,  -2.855940D0,  0.000000D0/)   !C28 
1411: !      SITE(29,:)  = (/4.907220D0,  -0.690170D0,  0.000000D0/)   !C29 
1412: !      SITE(30,:)  = (/4.907220D0,  0.690170D0,  0.000000D0/)   !C30 
1413: !      SITE(31,:)  = (/3.665710D0,  2.855940D0,  0.000000D0/)   !C31 
1414: !      SITE(32,:)  = (/2.485870D0,  3.542240D0,  0.000000D0/)   !C32 
1415: !      SITE(33,:)  = (/0.000000D0,  -4.627370D0,  0.000000D0/)   !H1 
1416: !      SITE(34,:)  = (/0.000000D0,  4.627370D0,  0.000000D0/)   !H2 
1417: !      SITE(35,:)  = (/-2.483580D0,  4.629530D0,  0.000000D0/)   !H3 
1418: !      SITE(36,:)  = (/-2.483580D0,  -4.629530D0,  0.000000D0/)   !H4 
1419: !      SITE(37,:)  = (/-5.849040D0,  1.233670D0,  0.000000D0/)   !H5 
1420: !      SITE(38,:)  = (/-5.849040D0,  -1.233670D0,  0.000000D0/)   !H6 
1421: !      SITE(39,:)  = (/-4.611080D0,  3.393330D0,  0.000000D0/)   !H7 
1422: !      SITE(40,:)  = (/-4.611080D0,  -3.393330D0,  0.000000D0/)   !H8 
1423: !      SITE(41,:)  = (/2.483580D0,  -4.629530D0,  0.000000D0/)   !H9 
1424: !      SITE(42,:)  = (/2.483580D0,  4.629530D0,  0.000000D0/)   !H10 
1425: !      SITE(43,:)  = (/4.611080D0,  -3.393330D0,  0.000000D0/)   !H11 
1426: !      SITE(44,:)  = (/5.849040D0,  -1.233670D0,  0.000000D0/)   !H12 
1427: !      SITE(45,:)  = (/5.849040D0,  1.233670D0,  0.000000D0/)   !H13 
1428: !      SITE(46,:)  = (/4.611080D0,  3.393330D0,  0.000000D0/)   !H14 
1429: ! 
1430: !      SITE(:,:) =  SITE(:,:)/0.5291770D0 
1431: ! 
1432: !      STCHRG(1)  = -0.0564090D0 
1433: !      STCHRG(2)  = 0.0160840D0 
1434: !      STCHRG(3)  = 0.0160840D0 
1435: !      STCHRG(4)  = -0.0564090D0 
1436: !      STCHRG(5)  = 0.0101710D0 
1437: !      STCHRG(6)  = 0.0101710D0 
1438: !      STCHRG(7)  = 0.2426000D0 
1439: !      STCHRG(8)  = -0.0564090D0 
1440: !      STCHRG(9)  = -0.0564090D0 
1441: !      STCHRG(10)  = 0.2426000D0 
1442: !      STCHRG(11)  = 0.1609920D0 
1443: !      STCHRG(12)  = 0.1609920D0 
1444: !      STCHRG(13)  = 0.2426000D0 
1445: !      STCHRG(14)  = 0.0101710D0 
1446: !      STCHRG(15)  = 0.0101710D0 
1447: !      STCHRG(16)  = 0.2426000D0 
1448: !      STCHRG(17)  = -0.2434940D0 
1449: !      STCHRG(18)  = -0.2338890D0 
1450: !      STCHRG(19)  = -0.2338890D0 
1451: !      STCHRG(20)  = -0.2434940D0 
1452: !      STCHRG(21)  = -0.4310520D0 
1453: !      STCHRG(22)  = 0.1609920D0 
1454: !      STCHRG(23)  = 0.1609920D0 
1455: !      STCHRG(24)  = -0.4310520D0 
1456: !      STCHRG(25)  = -0.2319160D0 
1457: !      STCHRG(26)  = -0.2319160D0 
1458: !      STCHRG(27)  = -0.2319160D0 
1459: !      STCHRG(28)  = -0.2434940D0 
1460: !      STCHRG(29)  = -0.2338890D0 
1461: !      STCHRG(30)  = -0.2338890D0 
1462: !      STCHRG(31)  = -0.2434940D0 
1463: !      STCHRG(32)  = -0.2319160D0 
1464: !      STCHRG(33)  = 0.1797660D0 
1465: !      STCHRG(34)  = 0.1797660D0 
1466: !      STCHRG(35)  = 0.1566500D0 
1467: !      STCHRG(36)  = 0.1566500D0 
1468: !      STCHRG(37)  = 0.1565740D0 
1469: !      STCHRG(38)  = 0.1565740D0 
1470: !      STCHRG(39)  = 0.1563220D0 
1471: !      STCHRG(40)  = 0.1563220D0 
1472: !      STCHRG(41)  = 0.1566500D0 
1473: !      STCHRG(42)  = 0.1566500D0 
1474: !      STCHRG(43)  = 0.1563220D0 
1475: !      STCHRG(44)  = 0.1565740D0 
1476: !      STCHRG(45)  = 0.1565740D0 
1477: !      STCHRG(46)  = 0.1563220D0 
1478: ! 
1479: !      RBSTLA(1,:)  = SITE(7,:)  - SITE(1,:)                 ! Z FROM C1 TO C7 
1480: !      RBSTLA(2,:)  = SITE(3,:)  - SITE(2,:)                 ! Z FROM C2 TO C3 
1481: !      RBSTLA(3,:)  = SITE(2,:)  - SITE(3,:)                 ! Z FROM C3 TO C2 
1482: !      RBSTLA(4,:)  = SITE(10,:)  - SITE(4,:)                 ! Z FROM C4 TO C10 
1483: !      RBSTLA(5,:)  = SITE(11,:)  - SITE(5,:)                 ! Z FROM C5 TO C11 
1484: !      RBSTLA(6,:)  = SITE(12,:)  - SITE(6,:)                 ! Z FROM C6 TO C12 
1485: !      RBSTLA(7,:)  = SITE(1,:)  - SITE(7,:)                 ! Z FROM C7 TO C1 
1486: !      RBSTLA(8,:)  = SITE(13,:)  - SITE(8,:)                 ! Z FROM C8 TO C13 
1487: !      RBSTLA(9,:)  = SITE(16,:)  - SITE(9,:)                 ! Z FROM C9 TO C16 
1488: !      RBSTLA(10,:)  = SITE(4,:)  - SITE(10,:)                 ! Z FROM C10 TO C4 
1489: !      RBSTLA(11,:)  = SITE(5,:)  - SITE(11,:)                 ! Z FROM C11 TO C5 
1490: !      RBSTLA(12,:)  = SITE(6,:)  - SITE(12,:)                 ! Z FROM C12 TO C6 
1491: !      RBSTLA(13,:)  = SITE(8,:)  - SITE(13,:)                 ! Z FROM C13 TO C8 
1492: !      RBSTLA(14,:)  = SITE(22,:)  - SITE(14,:)                 ! Z FROM C14 TO C22 
1493: !      RBSTLA(15,:)  = SITE(23,:)  - SITE(15,:)                 ! Z FROM C15 TO C23 
1494: !      RBSTLA(16,:)  = SITE(9,:)  - SITE(16,:)                 ! Z FROM C16 TO C9 
1495: !      RBSTLA(17,:)  = SITE(39,:)  - SITE(17,:)                 ! Z FROM C17 TO H7 
1496: !      RBSTLA(18,:)  = SITE(37,:)  - SITE(18,:)                 ! Z FROM C18 TO H5 
1497: !      RBSTLA(19,:)  = SITE(38,:)  - SITE(19,:)                 ! Z FROM C19 TO H6 
1498: !      RBSTLA(20,:)  = SITE(40,:)  - SITE(20,:)                 ! Z FROM C20 TO H8 
1499: !      RBSTLA(21,:)  = SITE(33,:)  - SITE(21,:)                 ! Z FROM C21 TO H1 
1500: !      RBSTLA(22,:)  = SITE(14,:)  - SITE(22,:)                 ! Z FROM C22 TO C14 
1501: !      RBSTLA(23,:)  = SITE(15,:)  - SITE(23,:)                 ! Z FROM C23 TO C15 
1502: !      RBSTLA(24,:)  = SITE(34,:)  - SITE(24,:)                 ! Z FROM C24 TO H2 
1503: !      RBSTLA(25,:)  = SITE(35,:)  - SITE(25,:)                 ! Z FROM C25 TO H3 
1504: !      RBSTLA(26,:)  = SITE(36,:)  - SITE(26,:)                 ! Z FROM C26 TO H4 
1505: !      RBSTLA(27,:)  = SITE(41,:)  - SITE(27,:)                 ! Z FROM C27 TO H9 
1506: !      RBSTLA(28,:)  = SITE(43,:)  - SITE(28,:)                 ! Z FROM C28 TO H11 
1507: !      RBSTLA(29,:)  = SITE(44,:)  - SITE(29,:)                 ! Z FROM C29 TO H12 
1508: !      RBSTLA(30,:)  = SITE(45,:)  - SITE(30,:)                 ! Z FROM C30 TO H13 
1509: !      RBSTLA(31,:)  = SITE(46,:)  - SITE(31,:)                 ! Z FROM C31 TO H14 
1510: !      RBSTLA(32,:)  = SITE(42,:)  - SITE(32,:)                 ! Z FROM C32 TO H10 
1511: !      RBSTLA(33,:)  = SITE(33,:)  - SITE(21,:)                 ! Z FROM C21 TO H1 
1512: !      RBSTLA(34,:)  = SITE(34,:)  - SITE(24,:)                 ! Z FROM C24 TO H2 
1513: !      RBSTLA(35,:)  = SITE(35,:)  - SITE(25,:)                 ! Z FROM C25 TO H3 
1514: !      RBSTLA(36,:)  = SITE(36,:)  - SITE(26,:)                 ! Z FROM C26 TO H4 
1515: !      RBSTLA(37,:)  = SITE(37,:)  - SITE(18,:)                 ! Z FROM C18 TO H5 
1516: !      RBSTLA(38,:)  = SITE(38,:)  - SITE(19,:)                 ! Z FROM C19 TO H6 
1517: !      RBSTLA(39,:)  = SITE(39,:)  - SITE(17,:)                 ! Z FROM C17 TO H7 
1518: !      RBSTLA(40,:)  = SITE(40,:)  - SITE(20,:)                 ! Z FROM C20 TO H8 
1519: !      RBSTLA(41,:)  = SITE(41,:)  - SITE(27,:)                 ! Z FROM C27 TO H9 
1520: !      RBSTLA(42,:)  = SITE(42,:)  - SITE(32,:)                 ! Z FROM C32 TO H10 
1521: !      RBSTLA(43,:)  = SITE(43,:)  - SITE(28,:)                 ! Z FROM C28 TO H11 
1522: !      RBSTLA(44,:)  = SITE(44,:)  - SITE(29,:)                 ! Z FROM C29 TO H12 
1523: !      RBSTLA(45,:)  = SITE(45,:)  - SITE(30,:)                 ! Z FROM C30 TO H13 
1524: !      RBSTLA(46,:)  = SITE(46,:)  - SITE(31,:)                 ! Z FROM C31 TO H14 
1525: ! 
1526: !      DO J1 = 1, NRBSITES 
1527: ! 
1528: !         RBSTLA(J1,:)   = RBSTLA(J1,:)/DSQRT(DOT_PRODUCT(RBSTLA(J1,:),RBSTLA(J1,:))) 
1529: ! 
1530: !      ENDDO 
1531: ! 
1532: !      END SUBROUTINE DEFOVALENE 
1533: ! 
1534: !!     ---------------------------------------------------------------------------------------------- 
1535: ! 
1536: !      SUBROUTINE DEFHEXABENZOCORONENE() 
1537: ! 
1538: !      USE COMMONS, ONLY: NRBSITES, SITE, RBSTLA, STCHRG 
1539: ! 
1540: !      IMPLICIT NONE 
1541: ! 
1542: !      INTEGER :: J1 
1543: ! 
1544: !!     C42H18 
1545: ! 
1546: !!     UNITS INITIALLY IN ANGSTROM 
1547: ! 
1548: !      SITE(1,:)  = (/0.000000D0,  -1.423760D0,  0.000000D0/)   !C1 
1549: !      SITE(2,:)  = (/1.233020D0,  -0.711880D0,  0.000000D0/)   !C2 
1550: !      SITE(3,:)  = (/1.233020D0,  0.711880D0,  0.000000D0/)   !C3 
1551: !      SITE(4,:)  = (/0.000000D0,  1.423760D0,  0.000000D0/)   !C4 
1552: !      SITE(5,:)  = (/-1.233020D0,  0.711880D0,  0.000000D0/)   !C5 
1553: !      SITE(6,:)  = (/-1.233020D0,  -0.711880D0,  0.000000D0/)   !C6 
1554: !      SITE(7,:)  = (/0.000000D0,  -2.871600D0,  0.000000D0/)   !C7 
1555: !      SITE(8,:)  = (/2.486890D0,  -1.435800D0,  0.000000D0/)   !C8 
1556: !      SITE(9,:)  = (/2.486890D0,  1.435800D0,  0.000000D0/)   !C9 
1557: !      SITE(10,:)  = (/0.000000D0,  2.871600D0,  0.000000D0/)   !C10 
1558: !      SITE(11,:)  = (/-2.486890D0,  1.435800D0,  0.000000D0/)   !C11 
1559: !      SITE(12,:)  = (/-2.486890D0,  -1.435800D0,  0.000000D0/)   !C12 
1560: !      SITE(13,:)  = (/1.200840D0,  -4.993810D0,  0.000000D0/)   !C13 
1561: !      SITE(14,:)  = (/2.495340D0,  -2.860590D0,  0.000000D0/)   !C14 
1562: !      SITE(15,:)  = (/3.725020D0,  -0.730730D0,  0.000000D0/)   !C15 
1563: !      SITE(16,:)  = (/3.725020D0,  0.730730D0,  0.000000D0/)   !C16 
1564: !      SITE(17,:)  = (/2.495340D0,  2.860590D0,  0.000000D0/)   !C17 
1565: !      SITE(18,:)  = (/1.200840D0,  4.993810D0,  0.000000D0/)   !C18 
1566: !      SITE(19,:)  = (/-1.200840D0,  4.993810D0,  0.000000D0/)   !C19 
1567: !      SITE(20,:)  = (/-2.495340D0,  2.860590D0,  0.000000D0/)   !C20 
1568: !      SITE(21,:)  = (/-3.725020D0,  0.730730D0,  0.000000D0/)   !C21 
1569: !      SITE(22,:)  = (/-3.725020D0,  -0.730730D0,  0.000000D0/)   !C22 
1570: !      SITE(23,:)  = (/-2.495340D0,  -2.860590D0,  0.000000D0/)   !C23 
1571: !      SITE(24,:)  = (/-1.200840D0,  -4.993810D0,  0.000000D0/)   !C24 
1572: !      SITE(25,:)  = (/1.229670D0,  -3.591320D0,  0.000000D0/)   !C25 
1573: !      SITE(26,:)  = (/4.925190D0,  -1.456950D0,  0.000000D0/)   !C26 
1574: !      SITE(27,:)  = (/4.925190D0,  1.456950D0,  0.000000D0/)   !C27 
1575: !      SITE(28,:)  = (/1.229670D0,  3.591320D0,  0.000000D0/)   !C28 
1576: !      SITE(29,:)  = (/-1.229670D0,  3.591320D0,  0.000000D0/)   !C29 
1577: !      SITE(30,:)  = (/-4.925190D0,  1.456950D0,  0.000000D0/)   !C30 
1578: !      SITE(31,:)  = (/-4.925190D0,  -1.456950D0,  0.000000D0/)   !C31 
1579: !      SITE(32,:)  = (/-1.229670D0,  -3.591320D0,  0.000000D0/)   !C32 
1580: !      SITE(33,:)  = (/3.724340D0,  -3.536870D0,  0.000000D0/)   !C33 
1581: !      SITE(34,:)  = (/4.925490D0,  -2.843740D0,  0.000000D0/)   !C34 
1582: !      SITE(35,:)  = (/4.925490D0,  2.843740D0,  0.000000D0/)   !C35 
1583: !      SITE(36,:)  = (/3.724340D0,  3.536870D0,  0.000000D0/)   !C36 
1584: !      SITE(37,:)  = (/0.000000D0,  5.687460D0,  0.000000D0/)   !C37 
1585: !      SITE(38,:)  = (/-3.724340D0,  3.536870D0,  0.000000D0/)   !C38 
1586: !      SITE(39,:)  = (/-4.925490D0,  2.843740D0,  0.000000D0/)   !C39 
1587: !      SITE(40,:)  = (/-4.925490D0,  -2.843740D0,  0.000000D0/)   !C40 
1588: !      SITE(41,:)  = (/-3.724340D0,  -3.536870D0,  0.000000D0/)   !C41 
1589: !      SITE(42,:)  = (/0.000000D0,  -5.687460D0,  0.000000D0/)   !C42 
1590: !      SITE(43,:)  = (/-2.121850D0,  5.562640D0,  0.000000D0/)   !H1 
1591: !      SITE(44,:)  = (/2.121850D0,  -5.562640D0,  0.000000D0/)   !H2 
1592: !      SITE(45,:)  = (/3.756480D0,  -4.618910D0,  0.000000D0/)   !H3 
1593: !      SITE(46,:)  = (/3.756480D0,  4.618910D0,  0.000000D0/)   !H4 
1594: !      SITE(47,:)  = (/-3.756480D0,  4.618910D0,  0.000000D0/)   !H5 
1595: !      SITE(48,:)  = (/-3.756480D0,  -4.618910D0,  0.000000D0/)   !H6 
1596: !      SITE(49,:)  = (/5.878330D0,  -0.943780D0,  0.000000D0/)   !H7 
1597: !      SITE(50,:)  = (/5.878330D0,  0.943780D0,  0.000000D0/)   !H8 
1598: !      SITE(51,:)  = (/2.121850D0,  5.562640D0,  0.000000D0/)   !H9 
1599: !      SITE(52,:)  = (/-5.878330D0,  0.943780D0,  0.000000D0/)   !H10 
1600: !      SITE(53,:)  = (/-5.878330D0,  -0.943780D0,  0.000000D0/)   !H11 
1601: !      SITE(54,:)  = (/-2.121850D0,  -5.562640D0,  0.000000D0/)   !H12 
1602: !      SITE(55,:)  = (/5.866390D0,  -3.386970D0,  0.000000D0/)   !H13 
1603: !      SITE(56,:)  = (/5.866390D0,  3.386970D0,  0.000000D0/)   !H14 
1604: !      SITE(57,:)  = (/0.000000D0,  6.773920D0,  0.000000D0/)   !H15 
1605: !      SITE(58,:)  = (/-5.866390D0,  3.386970D0,  0.000000D0/)   !H16 
1606: !      SITE(59,:)  = (/-5.866390D0,  -3.386970D0,  0.000000D0/)   !H17 
1607: !      SITE(60,:)  = (/0.000000D0,  -6.773920D0,  0.000000D0/)   !H18 
1608: ! 
1609: !      SITE(:,:) =  SITE(:,:)/0.5291770D0 
1610: ! 
1611: !      STCHRG(1)  = -0.0239090D0 
1612: !      STCHRG(2)  = -0.0239090D0 
1613: !      STCHRG(3)  = -0.0239090D0 
1614: !      STCHRG(4)  = -0.0239090D0 
1615: !      STCHRG(5)  = -0.0239090D0 
1616: !      STCHRG(6)  = -0.0239090D0 
1617: !      STCHRG(7)  = 0.0287860D0 
1618: !      STCHRG(8)  = 0.0287860D0 
1619: !      STCHRG(9)  = 0.0287860D0 
1620: !      STCHRG(10)  = 0.0287860D0 
1621: !      STCHRG(11)  = 0.0287860D0 
1622: !      STCHRG(12)  = 0.0287860D0 
1623: !      STCHRG(13)  = -0.2113620D0 
1624: !      STCHRG(14)  = 0.0526040D0 
1625: !      STCHRG(15)  = 0.0526040D0 
1626: !      STCHRG(16)  = 0.0526040D0 
1627: !      STCHRG(17)  = 0.0526040D0 
1628: !      STCHRG(18)  = -0.2113620D0 
1629: !      STCHRG(19)  = -0.2113620D0 
1630: !      STCHRG(20)  = 0.0526040D0 
1631: !      STCHRG(21)  = 0.0526040D0 
1632: !      STCHRG(22)  = 0.0526040D0 
1633: !      STCHRG(23)  = 0.0526040D0 
1634: !      STCHRG(24)  = -0.2113620D0 
1635: !      STCHRG(25)  = 0.0526040D0 
1636: !      STCHRG(26)  = -0.2113620D0 
1637: !      STCHRG(27)  = -0.2113620D0 
1638: !      STCHRG(28)  = 0.0526040D0 
1639: !      STCHRG(29)  = 0.0526040D0 
1640: !      STCHRG(30)  = -0.2113620D0 
1641: !      STCHRG(31)  = -0.2113620D0 
1642: !      STCHRG(32)  = 0.0526040D0 
1643: !      STCHRG(33)  = -0.2113620D0 
1644: !      STCHRG(34)  = -0.1107910D0 
1645: !      STCHRG(35)  = -0.1107910D0 
1646: !      STCHRG(36)  = -0.2113620D0 
1647: !      STCHRG(37)  = -0.1107910D0 
1648: !      STCHRG(38)  = -0.2113620D0 
1649: !      STCHRG(39)  = -0.1107910D0 
1650: !      STCHRG(40)  = -0.1107910D0 
1651: !      STCHRG(41)  = -0.2113620D0 
1652: !      STCHRG(42)  = -0.1107910D0 
1653: !      STCHRG(43)  = 0.1456340D0 
1654: !      STCHRG(44)  = 0.1456340D0 
1655: !      STCHRG(45)  = 0.1456340D0 
1656: !      STCHRG(46)  = 0.1456340D0 
1657: !      STCHRG(47)  = 0.1456340D0 
1658: !      STCHRG(48)  = 0.1456340D0 
1659: !      STCHRG(49)  = 0.1456340D0 
1660: !      STCHRG(50)  = 0.1456340D0 
1661: !      STCHRG(51)  = 0.1456340D0 
1662: !      STCHRG(52)  = 0.1456340D0 
1663: !      STCHRG(53)  = 0.1456340D0 
1664: !      STCHRG(54)  = 0.1456340D0 
1665: !      STCHRG(55)  = 0.1321610D0 
1666: !      STCHRG(56)  = 0.1321610D0 
1667: !      STCHRG(57)  = 0.1321610D0 
1668: !      STCHRG(58)  = 0.1321610D0 
1669: !      STCHRG(59)  = 0.1321610D0 
1670: !      STCHRG(60)  = 0.1321610D0 
1671: ! 
1672: !      RBSTLA(1,:)  = SITE(7,:)  - SITE(1,:)                 ! Z FROM C1 TO C7 
1673: !      RBSTLA(2,:)  = SITE(8,:)  - SITE(2,:)                 ! Z FROM C2 TO C8 
1674: !      RBSTLA(3,:)  = SITE(9,:)  - SITE(3,:)                 ! Z FROM C3 TO C9 
1675: !      RBSTLA(4,:)  = SITE(10,:)  - SITE(4,:)                 ! Z FROM C4 TO C10 
1676: !      RBSTLA(5,:)  = SITE(11,:)  - SITE(5,:)                 ! Z FROM C5 TO C11 
1677: !      RBSTLA(6,:)  = SITE(12,:)  - SITE(6,:)                 ! Z FROM C6 TO C12 
1678: !      RBSTLA(7,:)  = SITE(1,:)  - SITE(7,:)                 ! Z FROM C7 TO C1 
1679: !      RBSTLA(8,:)  = SITE(2,:)  - SITE(8,:)                 ! Z FROM C8 TO C2 
1680: !      RBSTLA(9,:)  = SITE(3,:)  - SITE(9,:)                 ! Z FROM C9 TO C3 
1681: !      RBSTLA(10,:)  = SITE(4,:)  - SITE(10,:)                 ! Z FROM C10 TO C4 
1682: !      RBSTLA(11,:)  = SITE(5,:)  - SITE(11,:)                 ! Z FROM C11 TO C5 
1683: !      RBSTLA(12,:)  = SITE(6,:)  - SITE(12,:)                 ! Z FROM C12 TO C6 
1684: !      RBSTLA(13,:)  = SITE(44,:)  - SITE(13,:)                 ! Z FROM C13 TO H2 
1685: !      RBSTLA(14,:)  = SITE(25,:)  - SITE(14,:)                 ! Z FROM C14 TO C25 
1686: !      RBSTLA(15,:)  = SITE(16,:)  - SITE(15,:)                 ! Z FROM C15 TO C16 
1687: !      RBSTLA(16,:)  = SITE(15,:)  - SITE(16,:)                 ! Z FROM C16 TO C15 
1688: !      RBSTLA(17,:)  = SITE(28,:)  - SITE(17,:)                 ! Z FROM C17 TO C28 
1689: !      RBSTLA(18,:)  = SITE(51,:)  - SITE(18,:)                 ! Z FROM C18 TO H9 
1690: !      RBSTLA(19,:)  = SITE(43,:)  - SITE(19,:)                 ! Z FROM C19 TO H1 
1691: !      RBSTLA(20,:)  = SITE(29,:)  - SITE(20,:)                 ! Z FROM C20 TO C29 
1692: !      RBSTLA(21,:)  = SITE(22,:)  - SITE(21,:)                 ! Z FROM C21 TO C22 
1693: !      RBSTLA(22,:)  = SITE(21,:)  - SITE(22,:)                 ! Z FROM C22 TO C21 
1694: !      RBSTLA(23,:)  = SITE(32,:)  - SITE(23,:)                 ! Z FROM C23 TO C32 
1695: !      RBSTLA(24,:)  = SITE(54,:)  - SITE(24,:)                 ! Z FROM C24 TO H12 
1696: !      RBSTLA(25,:)  = SITE(14,:)  - SITE(25,:)                 ! Z FROM C25 TO C14 
1697: !      RBSTLA(26,:)  = SITE(49,:)  - SITE(26,:)                 ! Z FROM C26 TO H7 
1698: !      RBSTLA(27,:)  = SITE(50,:)  - SITE(27,:)                 ! Z FROM C27 TO H8 
1699: !      RBSTLA(28,:)  = SITE(17,:)  - SITE(28,:)                 ! Z FROM C28 TO C17 
1700: !      RBSTLA(29,:)  = SITE(20,:)  - SITE(29,:)                 ! Z FROM C29 TO C20 
1701: !      RBSTLA(30,:)  = SITE(52,:)  - SITE(30,:)                 ! Z FROM C30 TO H10 
1702: !      RBSTLA(31,:)  = SITE(53,:)  - SITE(31,:)                 ! Z FROM C31 TO H11 
1703: !      RBSTLA(32,:)  = SITE(23,:)  - SITE(32,:)                 ! Z FROM C32 TO C23 
1704: !      RBSTLA(33,:)  = SITE(45,:)  - SITE(33,:)                 ! Z FROM C33 TO H3 
1705: !      RBSTLA(34,:)  = SITE(55,:)  - SITE(34,:)                 ! Z FROM C34 TO H13 
1706: !      RBSTLA(35,:)  = SITE(56,:)  - SITE(35,:)                 ! Z FROM C35 TO H14 
1707: !      RBSTLA(36,:)  = SITE(46,:)  - SITE(36,:)                 ! Z FROM C36 TO H4 
1708: !      RBSTLA(37,:)  = SITE(57,:)  - SITE(37,:)                 ! Z FROM C37 TO H15 
1709: !      RBSTLA(38,:)  = SITE(47,:)  - SITE(38,:)                 ! Z FROM C38 TO H5 
1710: !      RBSTLA(39,:)  = SITE(58,:)  - SITE(39,:)                 ! Z FROM C39 TO H16 
1711: !      RBSTLA(40,:)  = SITE(59,:)  - SITE(40,:)                 ! Z FROM C40 TO H17 
1712: !      RBSTLA(41,:)  = SITE(48,:)  - SITE(41,:)                 ! Z FROM C41 TO H6 
1713: !      RBSTLA(42,:)  = SITE(60,:)  - SITE(42,:)                 ! Z FROM C42 TO H18 
1714: !      RBSTLA(43,:)  = SITE(43,:)  - SITE(19,:)                 ! Z FROM C19 TO H1 
1715: !      RBSTLA(44,:)  = SITE(44,:)  - SITE(13,:)                 ! Z FROM C13 TO H2 
1716: !      RBSTLA(45,:)  = SITE(45,:)  - SITE(33,:)                 ! Z FROM C33 TO H3 
1717: !      RBSTLA(46,:)  = SITE(46,:)  - SITE(36,:)                 ! Z FROM C36 TO H4 
1718: !      RBSTLA(47,:)  = SITE(47,:)  - SITE(38,:)                 ! Z FROM C38 TO H5 
1719: !      RBSTLA(48,:)  = SITE(48,:)  - SITE(41,:)                 ! Z FROM C41 TO H6 
1720: !      RBSTLA(49,:)  = SITE(49,:)  - SITE(26,:)                 ! Z FROM C26 TO H7 
1721: !      RBSTLA(50,:)  = SITE(50,:)  - SITE(27,:)                 ! Z FROM C27 TO H8 
1722: !      RBSTLA(51,:)  = SITE(51,:)  - SITE(18,:)                 ! Z FROM C18 TO H9 
1723: !      RBSTLA(52,:)  = SITE(52,:)  - SITE(30,:)                 ! Z FROM C30 TO H10 
1724: !      RBSTLA(53,:)  = SITE(53,:)  - SITE(31,:)                 ! Z FROM C31 TO H11 
1725: !      RBSTLA(54,:)  = SITE(54,:)  - SITE(24,:)                 ! Z FROM C24 TO H12 
1726: !      RBSTLA(55,:)  = SITE(55,:)  - SITE(34,:)                 ! Z FROM C34 TO H13 
1727: !      RBSTLA(56,:)  = SITE(56,:)  - SITE(35,:)                 ! Z FROM C35 TO H14 
1728: !      RBSTLA(57,:)  = SITE(57,:)  - SITE(37,:)                 ! Z FROM C37 TO H15 
1729: !      RBSTLA(58,:)  = SITE(58,:)  - SITE(39,:)                 ! Z FROM C39 TO H16 
1730: !      RBSTLA(59,:)  = SITE(59,:)  - SITE(40,:)                 ! Z FROM C40 TO H17 
1731: !      RBSTLA(60,:)  = SITE(60,:)  - SITE(42,:)                 ! Z FROM C42 TO H18 
1732: ! 
1733: !      DO J1 = 1, NRBSITES 
1734: ! 
1735: !         RBSTLA(J1,:)   = RBSTLA(J1,:)/DSQRT(DOT_PRODUCT(RBSTLA(J1,:),RBSTLA(J1,:))) 
1736: ! 
1737: !      ENDDO 
1738: ! 
1739: !      END SUBROUTINE DEFHEXABENZOCORONENE 
1740: ! 
1741: !!     ---------------------------------------------------------------------------------------------- 
1742: ! 
1743: !      SUBROUTINE DEFOCTABENZOCORONENE() 
1744: ! 
1745: !      USE COMMONS, ONLY: NRBSITES, SITE, RBSTLA, STCHRG 
1746: ! 
1747: !      IMPLICIT NONE 
1748: ! 
1749: !      INTEGER :: J1 
1750: ! 
1751: !!     C46H18 
1752: ! 
1753: !!     UNITS INITIALLY IN ANGSTROM 
1754: ! 
1755: !      SITE(1,:)  = (/0.000000D0,  -1.425060D0,  0.000000D0/)   !C1 
1756: !      SITE(2,:)  = (/1.231180D0,  -0.710700D0,  0.000000D0/)   !C2 
1757: !      SITE(3,:)  = (/1.231180D0,  0.710700D0,  0.000000D0/)   !C3 
1758: !      SITE(4,:)  = (/0.000000D0,  1.425060D0,  0.000000D0/)   !C4 
1759: !      SITE(5,:)  = (/-1.231180D0,  0.710700D0,  0.000000D0/)   !C5 
1760: !      SITE(6,:)  = (/-1.231180D0,  -0.710700D0,  0.000000D0/)   !C6 
1761: !      SITE(7,:)  = (/0.000000D0,  -2.865070D0,  0.000000D0/)   !C7 
1762: !      SITE(8,:)  = (/2.478690D0,  -1.434890D0,  0.000000D0/)   !C8 
1763: !      SITE(9,:)  = (/2.478690D0,  1.434890D0,  0.000000D0/)   !C9 
1764: !      SITE(10,:)  = (/0.000000D0,  2.865070D0,  0.000000D0/)   !C10 
1765: !      SITE(11,:)  = (/-2.478690D0,  1.434890D0,  0.000000D0/)   !C11 
1766: !      SITE(12,:)  = (/-2.478690D0,  -1.434890D0,  0.000000D0/)   !C12 
1767: !      SITE(13,:)  = (/1.203620D0,  -4.987300D0,  0.000000D0/)   !C13 
1768: !      SITE(14,:)  = (/2.493820D0,  -2.849580D0,  0.000000D0/)   !C14 
1769: !      SITE(15,:)  = (/3.712050D0,  -0.714060D0,  0.000000D0/)   !C15 
1770: !      SITE(16,:)  = (/3.712050D0,  0.714060D0,  0.000000D0/)   !C16 
1771: !      SITE(17,:)  = (/2.493820D0,  2.849580D0,  0.000000D0/)   !C17 
1772: !      SITE(18,:)  = (/1.203620D0,  4.987300D0,  0.000000D0/)   !C18 
1773: !      SITE(19,:)  = (/-1.203620D0,  4.987300D0,  0.000000D0/)   !C19 
1774: !      SITE(20,:)  = (/-2.493820D0,  2.849580D0,  0.000000D0/)   !C20 
1775: !      SITE(21,:)  = (/-3.712050D0,  0.714060D0,  0.000000D0/)   !C21 
1776: !      SITE(22,:)  = (/-3.712050D0,  -0.714060D0,  0.000000D0/)   !C22 
1777: !      SITE(23,:)  = (/-2.493820D0,  -2.849580D0,  0.000000D0/)   !C23 
1778: !      SITE(24,:)  = (/-1.203620D0,  -4.987300D0,  0.000000D0/)   !C24 
1779: !      SITE(25,:)  = (/1.235310D0,  -3.583840D0,  0.000000D0/)   !C25 
1780: !      SITE(26,:)  = (/4.951530D0,  -1.413420D0,  0.000000D0/)   !C26 
1781: !      SITE(27,:)  = (/4.951530D0,  1.413420D0,  0.000000D0/)   !C27 
1782: !      SITE(28,:)  = (/1.235310D0,  3.583840D0,  0.000000D0/)   !C28 
1783: !      SITE(29,:)  = (/-1.235310D0,  3.583840D0,  0.000000D0/)   !C29 
1784: !      SITE(30,:)  = (/-4.951530D0,  1.413420D0,  0.000000D0/)   !C30 
1785: !      SITE(31,:)  = (/-4.951530D0,  -1.413420D0,  0.000000D0/)   !C31 
1786: !      SITE(32,:)  = (/-1.235310D0,  -3.583840D0,  0.000000D0/)   !C32 
1787: !      SITE(33,:)  = (/3.745490D0,  -3.515110D0,  0.000000D0/)   !C33 
1788: !      SITE(34,:)  = (/4.933170D0,  -2.824900D0,  0.000000D0/)   !C34 
1789: !      SITE(35,:)  = (/6.177280D0,  -0.682150D0,  0.000000D0/)   !C35 
1790: !      SITE(36,:)  = (/6.177280D0,  0.682150D0,  0.000000D0/)   !C36 
1791: !      SITE(37,:)  = (/4.933170D0,  2.824900D0,  0.000000D0/)   !C37 
1792: !      SITE(38,:)  = (/3.745490D0,  3.515110D0,  0.000000D0/)   !C38 
1793: !      SITE(39,:)  = (/0.000000D0,  5.678280D0,  0.000000D0/)   !C39 
1794: !      SITE(40,:)  = (/-3.745490D0,  3.515110D0,  0.000000D0/)   !C40 
1795: !      SITE(41,:)  = (/-4.933170D0,  2.824900D0,  0.000000D0/)   !C41 
1796: !      SITE(42,:)  = (/-6.177280D0,  0.682150D0,  0.000000D0/)   !C42 
1797: !      SITE(43,:)  = (/-6.177280D0,  -0.682150D0,  0.000000D0/)   !C43 
1798: !      SITE(44,:)  = (/-4.933170D0,  -2.824900D0,  0.000000D0/)   !C44 
1799: !      SITE(45,:)  = (/-3.745490D0,  -3.515110D0,  0.000000D0/)   !C45 
1800: !      SITE(46,:)  = (/0.000000D0,  -5.678280D0,  0.000000D0/)   !C46 
1801: !      SITE(47,:)  = (/3.783390D0,  -4.597500D0,  0.000000D0/)   !H1 
1802: !      SITE(48,:)  = (/3.783390D0,  4.597500D0,  0.000000D0/)   !H2 
1803: !      SITE(49,:)  = (/-3.783390D0,  4.597500D0,  0.000000D0/)   !H3 
1804: !      SITE(50,:)  = (/-3.783390D0,  -4.597500D0,  0.000000D0/)   !H4 
1805: !      SITE(51,:)  = (/2.124570D0,  -5.556960D0,  0.000000D0/)   !H5 
1806: !      SITE(52,:)  = (/2.124570D0,  5.556960D0,  0.000000D0/)   !H6 
1807: !      SITE(53,:)  = (/-2.124570D0,  5.556960D0,  0.000000D0/)   !H7 
1808: !      SITE(54,:)  = (/-2.124570D0,  -5.556960D0,  0.000000D0/)   !H8 
1809: !      SITE(55,:)  = (/5.876920D0,  -3.364720D0,  0.000000D0/)   !H9 
1810: !      SITE(56,:)  = (/7.112310D0,  -1.236870D0,  0.000000D0/)   !H10 
1811: !      SITE(57,:)  = (/7.112310D0,  1.236870D0,  0.000000D0/)   !H11 
1812: !      SITE(58,:)  = (/5.876920D0,  3.364720D0,  0.000000D0/)   !H12 
1813: !      SITE(59,:)  = (/0.000000D0,  6.764810D0,  0.000000D0/)   !H13 
1814: !      SITE(60,:)  = (/-5.876920D0,  3.364720D0,  0.000000D0/)   !H14 
1815: !      SITE(61,:)  = (/-7.112310D0,  1.236870D0,  0.000000D0/)   !H15 
1816: !      SITE(62,:)  = (/-7.112310D0,  -1.236870D0,  0.000000D0/)   !H16 
1817: !      SITE(63,:)  = (/-5.876920D0,  -3.364720D0,  0.000000D0/)   !H17 
1818: !      SITE(64,:)  = (/0.000000D0,  -6.764810D0,  0.000000D0/)   !H18 
1819: ! 
1820: !      SITE(:,:) =  SITE(:,:)/0.5291770D0 
1821: ! 
1822: !      STCHRG(1)  = -0.0628330D0 
1823: !      STCHRG(2)  = 0.0094960D0 
1824: !      STCHRG(3)  = 0.0094960D0 
1825: !      STCHRG(4)  = -0.0628330D0 
1826: !      STCHRG(5)  = 0.0094960D0 
1827: !      STCHRG(6)  = 0.0094960D0 
1828: !      STCHRG(7)  = 0.0231300D0 
1829: !      STCHRG(8)  = 0.0110570D0 
1830: !      STCHRG(9)  = 0.0110570D0 
1831: !      STCHRG(10)  = 0.0231300D0 
1832: !      STCHRG(11)  = 0.0110570D0 
1833: !      STCHRG(12)  = 0.0110570D0 
1834: !      STCHRG(13)  = -0.2250820D0 
1835: !      STCHRG(14)  = 0.0126350D0 
1836: !      STCHRG(15)  = -0.0151280D0 
1837: !      STCHRG(16)  = -0.0151280D0 
1838: !      STCHRG(17)  = 0.0126350D0 
1839: !      STCHRG(18)  = -0.2250820D0 
1840: !      STCHRG(19)  = -0.2250820D0 
1841: !      STCHRG(20)  = 0.0126350D0 
1842: !      STCHRG(21)  = -0.0151280D0 
1843: !      STCHRG(22)  = -0.0151280D0 
1844: !      STCHRG(23)  = 0.0126350D0 
1845: !      STCHRG(24)  = -0.2250820D0 
1846: !      STCHRG(25)  = 0.0861370D0 
1847: !      STCHRG(26)  = 0.1967670D0 
1848: !      STCHRG(27)  = 0.1967670D0 
1849: !      STCHRG(28)  = 0.0861370D0 
1850: !      STCHRG(29)  = 0.0861370D0 
1851: !      STCHRG(30)  = 0.1967670D0 
1852: !      STCHRG(31)  = 0.1967670D0 
1853: !      STCHRG(32)  = 0.0861370D0 
1854: !      STCHRG(33)  = -0.1762830D0 
1855: !      STCHRG(34)  = -0.2579940D0 
1856: !      STCHRG(35)  = -0.2432570D0 
1857: !      STCHRG(36)  = -0.2432570D0 
1858: !      STCHRG(37)  = -0.2579940D0 
1859: !      STCHRG(38)  = -0.1762830D0 
1860: !      STCHRG(39)  = -0.1104240D0 
1861: !      STCHRG(40)  = -0.1762830D0 
1862: !      STCHRG(41)  = -0.2579940D0 
1863: !      STCHRG(42)  = -0.2432570D0 
1864: !      STCHRG(43)  = -0.2432570D0 
1865: !      STCHRG(44)  = -0.2579940D0 
1866: !      STCHRG(45)  = -0.1762830D0 
1867: !      STCHRG(46)  = -0.1104240D0 
1868: !      STCHRG(47)  = 0.1519720D0 
1869: !      STCHRG(48)  = 0.1519720D0 
1870: !      STCHRG(49)  = 0.1519720D0 
1871: !      STCHRG(50)  = 0.1519720D0 
1872: !      STCHRG(51)  = 0.1447300D0 
1873: !      STCHRG(52)  = 0.1447300D0 
1874: !      STCHRG(53)  = 0.1447300D0 
1875: !      STCHRG(54)  = 0.1447300D0 
1876: !      STCHRG(55)  = 0.1529060D0 
1877: !      STCHRG(56)  = 0.1593090D0 
1878: !      STCHRG(57)  = 0.1593090D0 
1879: !      STCHRG(58)  = 0.1529060D0 
1880: !      STCHRG(59)  = 0.1356020D0 
1881: !      STCHRG(60)  = 0.1529060D0 
1882: !      STCHRG(61)  = 0.1593090D0 
1883: !      STCHRG(62)  = 0.1593090D0 
1884: !      STCHRG(63)  = 0.1529060D0 
1885: !      STCHRG(64)  = 0.1356020D0 
1886: ! 
1887: !      RBSTLA(1,:)  = SITE(7,:)  - SITE(1,:)                 ! Z FROM C1 TO C7 
1888: !      RBSTLA(2,:)  = SITE(8,:)  - SITE(2,:)                 ! Z FROM C2 TO C8 
1889: !      RBSTLA(3,:)  = SITE(9,:)  - SITE(3,:)                 ! Z FROM C3 TO C9 
1890: !      RBSTLA(4,:)  = SITE(10,:)  - SITE(4,:)                 ! Z FROM C4 TO C10 
1891: !      RBSTLA(5,:)  = SITE(11,:)  - SITE(5,:)                 ! Z FROM C5 TO C11 
1892: !      RBSTLA(6,:)  = SITE(12,:)  - SITE(6,:)                 ! Z FROM C6 TO C12 
1893: !      RBSTLA(7,:)  = SITE(1,:)  - SITE(7,:)                 ! Z FROM C7 TO C1 
1894: !      RBSTLA(8,:)  = SITE(2,:)  - SITE(8,:)                 ! Z FROM C8 TO C2 
1895: !      RBSTLA(9,:)  = SITE(3,:)  - SITE(9,:)                 ! Z FROM C9 TO C3 
1896: !      RBSTLA(10,:)  = SITE(4,:)  - SITE(10,:)                 ! Z FROM C10 TO C4 
1897: !      RBSTLA(11,:)  = SITE(5,:)  - SITE(11,:)                 ! Z FROM C11 TO C5 
1898: !      RBSTLA(12,:)  = SITE(6,:)  - SITE(12,:)                 ! Z FROM C12 TO C6 
1899: !      RBSTLA(13,:)  = SITE(51,:)  - SITE(13,:)                 ! Z FROM C13 TO H5 
1900: !      RBSTLA(14,:)  = SITE(25,:)  - SITE(14,:)                 ! Z FROM C14 TO C25 
1901: !      RBSTLA(15,:)  = SITE(26,:)  - SITE(15,:)                 ! Z FROM C15 TO C26 
1902: !      RBSTLA(16,:)  = SITE(27,:)  - SITE(16,:)                 ! Z FROM C16 TO C27 
1903: !      RBSTLA(17,:)  = SITE(28,:)  - SITE(17,:)                 ! Z FROM C17 TO C28 
1904: !      RBSTLA(18,:)  = SITE(52,:)  - SITE(18,:)                 ! Z FROM C18 TO H6 
1905: !      RBSTLA(19,:)  = SITE(53,:)  - SITE(19,:)                 ! Z FROM C19 TO H7 
1906: !      RBSTLA(20,:)  = SITE(29,:)  - SITE(20,:)                 ! Z FROM C20 TO C29 
1907: !      RBSTLA(21,:)  = SITE(30,:)  - SITE(21,:)                 ! Z FROM C21 TO C30 
1908: !      RBSTLA(22,:)  = SITE(31,:)  - SITE(22,:)                 ! Z FROM C22 TO C31 
1909: !      RBSTLA(23,:)  = SITE(32,:)  - SITE(23,:)                 ! Z FROM C23 TO C32 
1910: !      RBSTLA(24,:)  = SITE(54,:)  - SITE(24,:)                 ! Z FROM C24 TO H8 
1911: !      RBSTLA(25,:)  = SITE(14,:)  - SITE(25,:)                 ! Z FROM C25 TO C14 
1912: !      RBSTLA(26,:)  = SITE(15,:)  - SITE(26,:)                 ! Z FROM C26 TO C15 
1913: !      RBSTLA(27,:)  = SITE(16,:)  - SITE(27,:)                 ! Z FROM C27 TO C16 
1914: !      RBSTLA(28,:)  = SITE(17,:)  - SITE(28,:)                 ! Z FROM C28 TO C17 
1915: !      RBSTLA(29,:)  = SITE(20,:)  - SITE(29,:)                 ! Z FROM C29 TO C20 
1916: !      RBSTLA(30,:)  = SITE(21,:)  - SITE(30,:)                 ! Z FROM C30 TO C21 
1917: !      RBSTLA(31,:)  = SITE(22,:)  - SITE(31,:)                 ! Z FROM C31 TO C22 
1918: !      RBSTLA(32,:)  = SITE(23,:)  - SITE(32,:)                 ! Z FROM C32 TO C23 
1919: !      RBSTLA(33,:)  = SITE(47,:)  - SITE(33,:)                 ! Z FROM C33 TO H1 
1920: !      RBSTLA(34,:)  = SITE(55,:)  - SITE(34,:)                 ! Z FROM C34 TO H9 
1921: !      RBSTLA(35,:)  = SITE(56,:)  - SITE(35,:)                 ! Z FROM C35 TO H10 
1922: !      RBSTLA(36,:)  = SITE(57,:)  - SITE(36,:)                 ! Z FROM C36 TO H11 
1923: !      RBSTLA(37,:)  = SITE(58,:)  - SITE(37,:)                 ! Z FROM C37 TO H12 
1924: !      RBSTLA(38,:)  = SITE(48,:)  - SITE(38,:)                 ! Z FROM C38 TO H2 
1925: !      RBSTLA(39,:)  = SITE(59,:)  - SITE(39,:)                 ! Z FROM C39 TO H13 
1926: !      RBSTLA(40,:)  = SITE(49,:)  - SITE(40,:)                 ! Z FROM C40 TO H3 
1927: !      RBSTLA(41,:)  = SITE(60,:)  - SITE(41,:)                 ! Z FROM C41 TO H14 
1928: !      RBSTLA(42,:)  = SITE(61,:)  - SITE(42,:)                 ! Z FROM C42 TO H15 
1929: !      RBSTLA(43,:)  = SITE(62,:)  - SITE(43,:)                 ! Z FROM C43 TO H16 
1930: !      RBSTLA(44,:)  = SITE(63,:)  - SITE(44,:)                 ! Z FROM C44 TO H17 
1931: !      RBSTLA(45,:)  = SITE(50,:)  - SITE(45,:)                 ! Z FROM C45 TO H4 
1932: !      RBSTLA(46,:)  = SITE(64,:)  - SITE(46,:)                 ! Z FROM C46 TO H18 
1933: !      RBSTLA(47,:)  = SITE(47,:)  - SITE(33,:)                 ! Z FROM C33 TO H1 
1934: !      RBSTLA(48,:)  = SITE(48,:)  - SITE(38,:)                 ! Z FROM C38 TO H2 
1935: !      RBSTLA(49,:)  = SITE(49,:)  - SITE(40,:)                 ! Z FROM C40 TO H3 
1936: !      RBSTLA(50,:)  = SITE(50,:)  - SITE(45,:)                 ! Z FROM C45 TO H4 
1937: !      RBSTLA(51,:)  = SITE(51,:)  - SITE(13,:)                 ! Z FROM C13 TO H5 
1938: !      RBSTLA(52,:)  = SITE(52,:)  - SITE(18,:)                 ! Z FROM C18 TO H6 
1939: !      RBSTLA(53,:)  = SITE(53,:)  - SITE(19,:)                 ! Z FROM C19 TO H7 
1940: !      RBSTLA(54,:)  = SITE(54,:)  - SITE(24,:)                 ! Z FROM C24 TO H8 
1941: !      RBSTLA(55,:)  = SITE(55,:)  - SITE(34,:)                 ! Z FROM C34 TO H9 
1942: !      RBSTLA(56,:)  = SITE(56,:)  - SITE(35,:)                 ! Z FROM C35 TO H10 
1943: !      RBSTLA(57,:)  = SITE(57,:)  - SITE(36,:)                 ! Z FROM C36 TO H11 
1944: !      RBSTLA(58,:)  = SITE(58,:)  - SITE(37,:)                 ! Z FROM C37 TO H12 
1945: !      RBSTLA(59,:)  = SITE(59,:)  - SITE(39,:)                 ! Z FROM C39 TO H13 
1946: !      RBSTLA(60,:)  = SITE(60,:)  - SITE(41,:)                 ! Z FROM C41 TO H14 
1947: !      RBSTLA(61,:)  = SITE(61,:)  - SITE(42,:)                 ! Z FROM C42 TO H15 
1948: !      RBSTLA(62,:)  = SITE(62,:)  - SITE(43,:)                 ! Z FROM C43 TO H16 
1949: !      RBSTLA(63,:)  = SITE(63,:)  - SITE(44,:)                 ! Z FROM C44 TO H17 
1950: !      RBSTLA(64,:)  = SITE(64,:)  - SITE(46,:)                 ! Z FROM C46 TO H18 
1951: ! 
1952: !      DO J1 = 1, NRBSITES 
1953: ! 
1954: !         RBSTLA(J1,:)   = RBSTLA(J1,:)/DSQRT(DOT_PRODUCT(RBSTLA(J1,:),RBSTLA(J1,:))) 
1955: ! 
1956: !      ENDDO 
1957: ! 
1958: !      END SUBROUTINE DEFOCTABENZOCORONENE 
1959: ! 
1960: !!     ---------------------------------------------------------------------------------------------- 
1961: ! 
1962: !      SUBROUTINE DEFCIRCUMCORONENE() 
1963: ! 
1964: !      USE COMMONS, ONLY: NRBSITES, SITE, RBSTLA, STCHRG 
1965: ! 
1966: !      IMPLICIT NONE 
1967: ! 
1968: !      INTEGER :: J1 
1969: ! 
1970: !!     C54H18 
1971: ! 
1972: !!     UNITS INITIALLY IN ANGSTROM 
1973: ! 
1974: !      SITE(1,:)  = (/0.000000D0,  -1.419570D0,  0.000000D0/)   !C1 
1975: !      SITE(2,:)  = (/1.229390D0,  -0.709790D0,  0.000000D0/)   !C2 
1976: !      SITE(3,:)  = (/1.229390D0,  0.709790D0,  0.000000D0/)   !C3 
1977: !      SITE(4,:)  = (/0.000000D0,  1.419570D0,  0.000000D0/)   !C4 
1978: !      SITE(5,:)  = (/-1.229390D0,  0.709790D0,  0.000000D0/)   !C5 
1979: !      SITE(6,:)  = (/-1.229390D0,  -0.709790D0,  0.000000D0/)   !C6 
1980: !      SITE(7,:)  = (/0.000000D0,  -2.848790D0,  0.000000D0/)   !C7 
1981: !      SITE(8,:)  = (/2.467130D0,  -1.424390D0,  0.000000D0/)   !C8 
1982: !      SITE(9,:)  = (/2.467130D0,  1.424390D0,  0.000000D0/)   !C9 
1983: !      SITE(10,:)  = (/0.000000D0,  2.848790D0,  0.000000D0/)   !C10 
1984: !      SITE(11,:)  = (/-2.467130D0,  1.424390D0,  0.000000D0/)   !C11 
1985: !      SITE(12,:)  = (/-2.467130D0,  -1.424390D0,  0.000000D0/)   !C12 
1986: !      SITE(13,:)  = (/1.225320D0,  -4.988360D0,  0.000000D0/)   !C13 
1987: !      SITE(14,:)  = (/2.465830D0,  -2.844750D0,  0.000000D0/)   !C14 
1988: !      SITE(15,:)  = (/3.696550D0,  -0.713100D0,  0.000000D0/)   !C15 
1989: !      SITE(16,:)  = (/3.696550D0,  0.713100D0,  0.000000D0/)   !C16 
1990: !      SITE(17,:)  = (/2.465830D0,  2.844750D0,  0.000000D0/)   !C17 
1991: !      SITE(18,:)  = (/1.225320D0,  4.988360D0,  0.000000D0/)   !C18 
1992: !      SITE(19,:)  = (/-1.225320D0,  4.988360D0,  0.000000D0/)   !C19 
1993: !      SITE(20,:)  = (/-2.465830D0,  2.844750D0,  0.000000D0/)   !C20 
1994: !      SITE(21,:)  = (/-3.696550D0,  0.713100D0,  0.000000D0/)   !C21 
1995: !      SITE(22,:)  = (/-3.696550D0,  -0.713100D0,  0.000000D0/)   !C22 
1996: !      SITE(23,:)  = (/-2.465830D0,  -2.844750D0,  0.000000D0/)   !C23 
1997: !      SITE(24,:)  = (/-1.225320D0,  -4.988360D0,  0.000000D0/)   !C24 
1998: !      SITE(25,:)  = (/1.230710D0,  -3.557840D0,  0.000000D0/)   !C25 
1999: !      SITE(26,:)  = (/3.669170D0,  -4.992040D0,  0.000000D0/)   !C26 
2000: !      SITE(27,:)  = (/4.932720D0,  -1.433020D0,  0.000000D0/)   !C27 
2001: !      SITE(28,:)  = (/4.932720D0,  1.433020D0,  0.000000D0/)   !C28 
2002: !      SITE(29,:)  = (/3.669170D0,  4.992040D0,  0.000000D0/)   !C29 
2003: !      SITE(30,:)  = (/1.230710D0,  3.557840D0,  0.000000D0/)   !C30 
2004: !      SITE(31,:)  = (/-1.230710D0,  3.557840D0,  0.000000D0/)   !C31 
2005: !      SITE(32,:)  = (/-3.669170D0,  4.992040D0,  0.000000D0/)   !C32 
2006: !      SITE(33,:)  = (/-4.932720D0,  1.433020D0,  0.000000D0/)   !C33 
2007: !      SITE(34,:)  = (/-4.932720D0,  -1.433020D0,  0.000000D0/)   !C34 
2008: !      SITE(35,:)  = (/-3.669170D0,  -4.992040D0,  0.000000D0/)   !C35 
2009: !      SITE(36,:)  = (/-1.230710D0,  -3.557840D0,  0.000000D0/)   !C36 
2010: !      SITE(37,:)  = (/2.488640D0,  -5.673610D0,  0.000000D0/)   !C37 
2011: !      SITE(38,:)  = (/3.707390D0,  -3.555340D0,  0.000000D0/)   !C38 
2012: !      SITE(39,:)  = (/4.908860D0,  -2.834130D0,  0.000000D0/)   !C39 
2013: !      SITE(40,:)  = (/6.157820D0,  -0.681580D0,  0.000000D0/)   !C40 
2014: !      SITE(41,:)  = (/6.157820D0,  0.681580D0,  0.000000D0/)   !C41 
2015: !      SITE(42,:)  = (/4.908860D0,  2.834130D0,  0.000000D0/)   !C42 
2016: !      SITE(43,:)  = (/3.707390D0,  3.555340D0,  0.000000D0/)   !C43 
2017: !      SITE(44,:)  = (/2.488640D0,  5.673610D0,  0.000000D0/)   !C44 
2018: !      SITE(45,:)  = (/0.000000D0,  5.668240D0,  0.000000D0/)   !C45 
2019: !      SITE(46,:)  = (/-2.488640D0,  5.673610D0,  0.000000D0/)   !C46 
2020: !      SITE(47,:)  = (/-3.707390D0,  3.555340D0,  0.000000D0/)   !C47 
2021: !      SITE(48,:)  = (/-4.908860D0,  2.834130D0,  0.000000D0/)   !C48 
2022: !      SITE(49,:)  = (/-6.157820D0,  0.681580D0,  0.000000D0/)   !C49 
2023: !      SITE(50,:)  = (/-6.157820D0,  -0.681580D0,  0.000000D0/)   !C50 
2024: !      SITE(51,:)  = (/-4.908860D0,  -2.834130D0,  0.000000D0/)   !C51 
2025: !      SITE(52,:)  = (/-3.707390D0,  -3.555340D0,  0.000000D0/)   !C52 
2026: !      SITE(53,:)  = (/-2.488640D0,  -5.673610D0,  0.000000D0/)   !C53 
2027: !      SITE(54,:)  = (/0.000000D0,  -5.668240D0,  0.000000D0/)   !C54 
2028: !      SITE(55,:)  = (/2.484360D0,  -6.760930D0,  0.000000D0/)   !H1 
2029: !      SITE(56,:)  = (/4.612950D0,  -5.532010D0,  0.000000D0/)   !H2 
2030: !      SITE(57,:)  = (/5.851170D0,  -3.378180D0,  0.000000D0/)   !H3 
2031: !      SITE(58,:)  = (/7.097340D0,  -1.228930D0,  0.000000D0/)   !H4 
2032: !      SITE(59,:)  = (/7.097340D0,  1.228930D0,  0.000000D0/)   !H5 
2033: !      SITE(60,:)  = (/5.851170D0,  3.378180D0,  0.000000D0/)   !H6 
2034: !      SITE(61,:)  = (/4.612950D0,  5.532010D0,  0.000000D0/)   !H7 
2035: !      SITE(62,:)  = (/2.484360D0,  6.760930D0,  0.000000D0/)   !H8 
2036: !      SITE(63,:)  = (/0.000000D0,  6.756340D0,  0.000000D0/)   !H9 
2037: !      SITE(64,:)  = (/-2.484360D0,  6.760930D0,  0.000000D0/)   !H10 
2038: !      SITE(65,:)  = (/-4.612950D0,  5.532010D0,  0.000000D0/)   !H11 
2039: !      SITE(66,:)  = (/-5.851170D0,  3.378180D0,  0.000000D0/)   !H12 
2040: !      SITE(67,:)  = (/-7.097340D0,  1.228930D0,  0.000000D0/)   !H13 
2041: !      SITE(68,:)  = (/-7.097340D0,  -1.228930D0,  0.000000D0/)   !H14 
2042: !      SITE(69,:)  = (/-5.851170D0,  -3.378180D0,  0.000000D0/)   !H15 
2043: !      SITE(70,:)  = (/-4.612950D0,  -5.532010D0,  0.000000D0/)   !H16 
2044: !      SITE(71,:)  = (/-2.484360D0,  -6.760930D0,  0.000000D0/)   !H17 
2045: !      SITE(72,:)  = (/0.000000D0,  -6.756340D0,  0.000000D0/)   !H18 
2046: ! 
2047: !      SITE(:,:) =  SITE(:,:)/0.5291770D0 
2048: ! 
2049: !      STCHRG(1)  = 0.0029610D0 
2050: !      STCHRG(2)  = 0.0029610D0 
2051: !      STCHRG(3)  = 0.0029610D0 
2052: !      STCHRG(4)  = 0.0029610D0 
2053: !      STCHRG(5)  = 0.0029610D0 
2054: !      STCHRG(6)  = 0.0029610D0 
2055: !      STCHRG(7)  = 0.0008790D0 
2056: !      STCHRG(8)  = 0.0008790D0 
2057: !      STCHRG(9)  = 0.0008790D0 
2058: !      STCHRG(10)  = 0.0008790D0 
2059: !      STCHRG(11)  = 0.0008790D0 
2060: !      STCHRG(12)  = 0.0008790D0 
2061: !      STCHRG(13)  = 0.2298540D0 
2062: !      STCHRG(14)  = -0.0308620D0 
2063: !      STCHRG(15)  = -0.0308620D0 
2064: !      STCHRG(16)  = -0.0308620D0 
2065: !      STCHRG(17)  = -0.0308620D0 
2066: !      STCHRG(18)  = 0.2298540D0 
2067: !      STCHRG(19)  = 0.2298540D0 
2068: !      STCHRG(20)  = -0.0308620D0 
2069: !      STCHRG(21)  = -0.0308620D0 
2070: !      STCHRG(22)  = -0.0308620D0 
2071: !      STCHRG(23)  = -0.0308620D0 
2072: !      STCHRG(24)  = 0.2298540D0 
2073: !      STCHRG(25)  = -0.0308620D0 
2074: !      STCHRG(26)  = -0.2404810D0 
2075: !      STCHRG(27)  = 0.2298540D0 
2076: !      STCHRG(28)  = 0.2298540D0 
2077: !      STCHRG(29)  = -0.2404810D0 
2078: !      STCHRG(30)  = -0.0308620D0 
2079: !      STCHRG(31)  = -0.0308620D0 
2080: !      STCHRG(32)  = -0.2404810D0 
2081: !      STCHRG(33)  = 0.2298540D0 
2082: !      STCHRG(34)  = 0.2298540D0 
2083: !      STCHRG(35)  = -0.2404810D0 
2084: !      STCHRG(36)  = -0.0308620D0 
2085: !      STCHRG(37)  = -0.2404810D0 
2086: !      STCHRG(38)  = 0.2298540D0 
2087: !      STCHRG(39)  = -0.4184350D0 
2088: !      STCHRG(40)  = -0.2404810D0 
2089: !      STCHRG(41)  = -0.2404810D0 
2090: !      STCHRG(42)  = -0.4184350D0 
2091: !      STCHRG(43)  = 0.2298540D0 
2092: !      STCHRG(44)  = -0.2404810D0 
2093: !      STCHRG(45)  = -0.4184350D0 
2094: !      STCHRG(46)  = -0.2404810D0 
2095: !      STCHRG(47)  = 0.2298540D0 
2096: !      STCHRG(48)  = -0.4184350D0 
2097: !      STCHRG(49)  = -0.2404810D0 
2098: !      STCHRG(50)  = -0.2404810D0 
2099: !      STCHRG(51)  = -0.4184350D0 
2100: !      STCHRG(52)  = 0.2298540D0 
2101: !      STCHRG(53)  = -0.2404810D0 
2102: !      STCHRG(54)  = -0.4184350D0 
2103: !      STCHRG(55)  = 0.1585010D0 
2104: !      STCHRG(56)  = 0.1585010D0 
2105: !      STCHRG(57)  = 0.1805690D0 
2106: !      STCHRG(58)  = 0.1585010D0 
2107: !      STCHRG(59)  = 0.1585010D0 
2108: !      STCHRG(60)  = 0.1805690D0 
2109: !      STCHRG(61)  = 0.1585010D0 
2110: !      STCHRG(62)  = 0.1585010D0 
2111: !      STCHRG(63)  = 0.1805690D0 
2112: !      STCHRG(64)  = 0.1585010D0 
2113: !      STCHRG(65)  = 0.1585010D0 
2114: !      STCHRG(66)  = 0.1805690D0 
2115: !      STCHRG(67)  = 0.1585010D0 
2116: !      STCHRG(68)  = 0.1585010D0 
2117: !      STCHRG(69)  = 0.1805690D0 
2118: !      STCHRG(70)  = 0.1585010D0 
2119: !      STCHRG(71)  = 0.1585010D0 
2120: !      STCHRG(72)  = 0.1805690D0 
2121: ! 
2122: !      RBSTLA(1,:)  = SITE(7,:)  - SITE(1,:)                 ! Z FROM C1 TO C7 
2123: !      RBSTLA(2,:)  = SITE(8,:)  - SITE(2,:)                 ! Z FROM C2 TO C8 
2124: !      RBSTLA(3,:)  = SITE(9,:)  - SITE(3,:)                 ! Z FROM C3 TO C9 
2125: !      RBSTLA(4,:)  = SITE(10,:)  - SITE(4,:)                 ! Z FROM C4 TO C10 
2126: !      RBSTLA(5,:)  = SITE(11,:)  - SITE(5,:)                 ! Z FROM C5 TO C11 
2127: !      RBSTLA(6,:)  = SITE(12,:)  - SITE(6,:)                 ! Z FROM C6 TO C12 
2128: !      RBSTLA(7,:)  = SITE(1,:)  - SITE(7,:)                 ! Z FROM C7 TO C1 
2129: !      RBSTLA(8,:)  = SITE(2,:)  - SITE(8,:)                 ! Z FROM C8 TO C2 
2130: !      RBSTLA(9,:)  = SITE(3,:)  - SITE(9,:)                 ! Z FROM C9 TO C3 
2131: !      RBSTLA(10,:)  = SITE(4,:)  - SITE(10,:)                 ! Z FROM C10 TO C4 
2132: !      RBSTLA(11,:)  = SITE(5,:)  - SITE(11,:)                 ! Z FROM C11 TO C5 
2133: !      RBSTLA(12,:)  = SITE(6,:)  - SITE(12,:)                 ! Z FROM C12 TO C6 
2134: !      RBSTLA(13,:)  = SITE(25,:)  - SITE(13,:)                 ! Z FROM C13 TO C25 
2135: !      RBSTLA(14,:)  = SITE(38,:)  - SITE(14,:)                 ! Z FROM C14 TO C38 
2136: !      RBSTLA(15,:)  = SITE(27,:)  - SITE(15,:)                 ! Z FROM C15 TO C27 
2137: !      RBSTLA(16,:)  = SITE(28,:)  - SITE(16,:)                 ! Z FROM C16 TO C28 
2138: !      RBSTLA(17,:)  = SITE(43,:)  - SITE(17,:)                 ! Z FROM C17 TO C43 
2139: !      RBSTLA(18,:)  = SITE(30,:)  - SITE(18,:)                 ! Z FROM C18 TO C30 
2140: !      RBSTLA(19,:)  = SITE(31,:)  - SITE(19,:)                 ! Z FROM C19 TO C31 
2141: !      RBSTLA(20,:)  = SITE(47,:)  - SITE(20,:)                 ! Z FROM C20 TO C47 
2142: !      RBSTLA(21,:)  = SITE(33,:)  - SITE(21,:)                 ! Z FROM C21 TO C33 
2143: !      RBSTLA(22,:)  = SITE(34,:)  - SITE(22,:)                 ! Z FROM C22 TO C34 
2144: !      RBSTLA(23,:)  = SITE(52,:)  - SITE(23,:)                 ! Z FROM C23 TO C52 
2145: !      RBSTLA(24,:)  = SITE(36,:)  - SITE(24,:)                 ! Z FROM C24 TO C36 
2146: !      RBSTLA(25,:)  = SITE(13,:)  - SITE(25,:)                 ! Z FROM C25 TO C13 
2147: !      RBSTLA(26,:)  = SITE(56,:)  - SITE(26,:)                 ! Z FROM C26 TO H2 
2148: !      RBSTLA(27,:)  = SITE(15,:)  - SITE(27,:)                 ! Z FROM C27 TO C15 
2149: !      RBSTLA(28,:)  = SITE(16,:)  - SITE(28,:)                 ! Z FROM C28 TO C16 
2150: !      RBSTLA(29,:)  = SITE(61,:)  - SITE(29,:)                 ! Z FROM C29 TO H7 
2151: !      RBSTLA(30,:)  = SITE(18,:)  - SITE(30,:)                 ! Z FROM C30 TO C18 
2152: !      RBSTLA(31,:)  = SITE(19,:)  - SITE(31,:)                 ! Z FROM C31 TO C19 
2153: !      RBSTLA(32,:)  = SITE(65,:)  - SITE(32,:)                 ! Z FROM C32 TO H11 
2154: !      RBSTLA(33,:)  = SITE(21,:)  - SITE(33,:)                 ! Z FROM C33 TO C21 
2155: !      RBSTLA(34,:)  = SITE(22,:)  - SITE(34,:)                 ! Z FROM C34 TO C22 
2156: !      RBSTLA(35,:)  = SITE(70,:)  - SITE(35,:)                 ! Z FROM C35 TO H16 
2157: !      RBSTLA(36,:)  = SITE(24,:)  - SITE(36,:)                 ! Z FROM C36 TO C24 
2158: !      RBSTLA(37,:)  = SITE(55,:)  - SITE(37,:)                 ! Z FROM C37 TO H1 
2159: !      RBSTLA(38,:)  = SITE(14,:)  - SITE(38,:)                 ! Z FROM C38 TO C14 
2160: !      RBSTLA(39,:)  = SITE(57,:)  - SITE(39,:)                 ! Z FROM C39 TO H3 
2161: !      RBSTLA(40,:)  = SITE(58,:)  - SITE(40,:)                 ! Z FROM C40 TO H4 
2162: !      RBSTLA(41,:)  = SITE(59,:)  - SITE(41,:)                 ! Z FROM C41 TO H5 
2163: !      RBSTLA(42,:)  = SITE(60,:)  - SITE(42,:)                 ! Z FROM C42 TO H6 
2164: !      RBSTLA(43,:)  = SITE(17,:)  - SITE(43,:)                 ! Z FROM C43 TO C17 
2165: !      RBSTLA(44,:)  = SITE(62,:)  - SITE(44,:)                 ! Z FROM C44 TO H8 
2166: !      RBSTLA(45,:)  = SITE(63,:)  - SITE(45,:)                 ! Z FROM C45 TO H9 
2167: !      RBSTLA(46,:)  = SITE(64,:)  - SITE(46,:)                 ! Z FROM C46