diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/0README_QMMM 6.3.3/source/0README_QMMM --- 6.3.3/source_orig/0README_QMMM 1970-01-01 01:00:00.000000000 +0100 +++ 6.3.3/source/0README_QMMM 2015-04-15 13:40:21.380032020 +0200 @@ -0,0 +1,53 @@ +QM/MM readme +Nicolas Ferré, Aix-Marseille Université, France +Federico Melaccio, Siena Università, Italy +February 2014 + +4 types of atom: MM (qmmm = 0), HLA (qmmm = 1), QM (qmmm=2), Y (qmmm=3) +* HLA (Hydrogen Link Atom) does not have any connectivity, nor vdW parameters. +* Y (LSCF/MM mixed QM/MM Atom) carries Q_Y (QM-derived) + q_Y (MM ff) total charge. + +## Interaction rules ## +!! Not all the ff can be used together with QM/MM !! +!! Check the current status in subroutine qmmm_todo !! + +* The HLA only interacts electrostatically. Inherits 1-4 conditions from + the QM atom it is connected to +* Bond stretching: no QM-QM and QM-Y bonds. See bonds.f +* Angle bending: if at least one atom is MM or if there is a Y-Y bond. + See angles.f +* Stretch-bend coupling: exclude QM-QM-MM, QM-Y-MM, Y-QM-MM couplings +* Urey-Bradley: exclude QM-QM and QM-Y 1-3 interactions +* Angle-angle coupling: NYI +* Out of plane bending: if at least one atom is MM or if there is a Y-Y bond. + See kopbend.f +* Out of plane distance: if at least one atom is MM or if there is a Y-Y bond. + See kopdist.f +* Improper torsion: keep only if the central atom is MM or Y. See kimptor.f +* Improper dihedral: keep only if the central atom is MM or Y. See kimprop.f +* Torsion: automatically excluding torsions around QM-QM and QM-Y bonds. + See bonds.f and torsions.f + Includes a piece of code for accounting for torsions involving one MM atom, + eg. QM-QM-QM-MM. It certainly double-count some interactions, but it may + correct the force acting on the MM atom. +* Pi torsion coupling: nothing to do +* Stretch-torsion coupling: NYI +* Torsion-torsion coupling: NYI +* vdW: exclude QM-QM, but includes QM-(QM image) in case of PBC. +* Electrostatics: 2 modes, always excluding QM-QM. QM/MM electrostatics follow + (doespf .true.) or not (doespf .false.) the 1-4 conditions. DONE + !! Temporarily disabled: the potential varies too sharply !! + e4qmmm = 0: QM/MM energy/gradient => only MM/MM electrostatics in Tinker, + point charges or electrostatic potential passed to QMprog, + Y special case: includes interactions with q_MM + e4qmmm = 3: microiterations/MD => QM/MM electrostatics in Tinker, involving + at least one MM atom, nbinqm atoms frozen, + Y special case: includes interactions with Q_Y+q_Y + Warning: (MM2, MM3) bond dipoles along MM-MM, MM-Y or Y-Y bonds only. + !! Point charge/multipole interactions: + !! Now we use a substractive scheme : ec = ec(all) - ec(QM/anything) !! + !! - ec(HLA/anything) ... !! + !! where ec(all) includes all the interactions, computed by any approach, !! + !! include PME !! + + diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/angles.f 6.3.3/source/angles.f --- 6.3.3/source_orig/angles.f 2015-04-14 13:58:10.098343729 +0200 +++ 6.3.3/source/angles.f 2015-04-15 13:48:53.440041219 +0200 @@ -27,6 +27,9 @@ include 'couple.i' include 'iounit.i' integer i,j,k,m +cqmmm + include 'qmmm.i' + integer ijqmmm,ikqmmm c c c loop over all atoms, storing the atoms in each bond angle @@ -36,6 +39,11 @@ m = 0 do j = 1, n12(i)-1 do k = j+1, n12(i) +cqmmm + ijqmmm = qmmm(i) + qmmm(i12(j,i)) + ikqmmm = qmmm(i) + qmmm(i12(k,i)) + if (ijqmmm .ge. 4 .and. ijqmmm.le. 5 + & .and. ikqmmm .ge. 4 .and. ikqmmm .le. 5) goto 20 nangle = nangle + 1 if (nangle .gt. maxang) then write (iout,10) @@ -49,12 +57,15 @@ iang(2,nangle) = i iang(3,nangle) = i12(k,i) iang(4,nangle) = 0 +cqmmm + 20 continue end do end do c c set the out-of-plane atom for angles at trivalent centers c - if (n12(i) .eq. 3) then +cqmmm if (n12(i) .eq. 3) then + if (n12(i) .eq. 3 .and. mod(qmmm(i),3).eq.0) then iang(4,nangle) = i12(1,i) iang(4,nangle-1) = i12(2,i) iang(4,nangle-2) = i12(3,i) diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/bonds.f 6.3.3/source/bonds.f --- 6.3.3/source_orig/bonds.f 2015-04-14 13:58:10.098343729 +0200 +++ 6.3.3/source/bonds.f 2015-04-15 13:48:53.464041219 +0200 @@ -25,6 +25,9 @@ include 'couple.i' include 'iounit.i' integer i,j,k,m +cqmmm + include 'qmmm.i' + integer jqmmm,kqmmm,mqmmm c c c loop over all atoms, storing the atoms in each bond @@ -34,6 +37,9 @@ do j = 1, n12(i) k = i12(j,i) if (i .lt. k) then +cqmmm + kqmmm = qmmm(i) + qmmm(k) + if (kqmmm .eq. 4 .or. kqmmm .eq. 5) goto 20 nbond = nbond + 1 if (nbond .gt. maxbnd) then write (iout,10) @@ -54,5 +60,35 @@ end if end do end do +c +cqmmm Control there are enough link atoms +c + do i = 1, nbond + j = ibnd(1,i) + k = ibnd(2,i) + jqmmm = qmmm(j) + kqmmm = qmmm(k) + if (jqmmm .eq.0 .and. kqmmm .eq.2) then + do m = 1, n + mqmmm = qmmm(m) + if (mqmmm .eq.1 .and. i12(1,m) .eq.j .and. i12(2,m).eq.k) + & goto 30 + end do + else if (jqmmm .eq.2 .and. kqmmm .eq.0) then + do m = 1, n + mqmmm = qmmm(m) + if (mqmmm .eq.1 .and. i12(1,m) .eq.k .and. i12(2,m).eq.j) + & goto 30 + end do + else + goto 30 + end if + write (iout,31) j,k + 31 format (/,' BONDS -- No LAH between MM atom ',i5, + & ' and QM atom ',i5) + 30 continue + end do +cqmmm + return end diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/eangle2.f 6.3.3/source/eangle2.f --- 6.3.3/source_orig/eangle2.f 2015-04-14 13:58:10.102343729 +0200 +++ 6.3.3/source/eangle2.f 2015-04-15 13:48:53.500041220 +0200 @@ -35,6 +35,10 @@ real*8, allocatable :: d0(:,:) logical proceed logical twosided +cqmmm + include 'qmmm.i' + integer iaqmmm,ibqmmm,icqmmm + integer iabqmmm,ibcqmmm c c c compute analytical angle bending Hessian elements @@ -61,9 +65,18 @@ ib = iang(2,k) ic = iang(3,k) id = iang(4,k) +cqmmm + iaqmmm = qmmm(ia) + ibqmmm = qmmm(ib) + icqmmm = qmmm(ic) + iabqmmm = iaqmmm + ibqmmm + ibcqmmm = ibqmmm + icqmmm proceed = (i.eq.ia .or. i.eq.ib .or. i.eq.ic .or. i.eq.id) if (proceed .and. use_group) & call groups (proceed,fgrp,ia,ib,ic,id,0,0) +cqmmm + if (proceed) proceed = (min(iabqmmm,ibcqmmm) .le. 3 + & .or. max(iabqmmm,ibcqmmm) .eq. 6) end if if (proceed) then term = fgrp / eps diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/ebuck1.f 6.3.3/source/ebuck1.f --- 6.3.3/source_orig/ebuck1.f 2015-04-14 13:58:10.102343729 +0200 +++ 6.3.3/source/ebuck1.f 2015-04-15 13:48:53.504041220 +0200 @@ -112,6 +112,9 @@ real*8, allocatable :: vscale(:) logical proceed,usei character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and first derivatives @@ -173,6 +176,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -198,6 +204,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -352,6 +362,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -377,6 +390,9 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (kqmmm .ne. 1) c c compute the energy contribution for this interaction c @@ -594,6 +610,9 @@ logical proceed,usei logical prime,repeat character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and first derivatives @@ -670,6 +689,9 @@ yi = ysort(rgy(ii)) zi = zsort(rgz(ii)) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -722,6 +744,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -948,6 +974,9 @@ real*8, allocatable :: vscale(:) logical proceed,usei character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and first derivatives @@ -1009,6 +1038,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -1034,6 +1066,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/ebuck2.f 6.3.3/source/ebuck2.f --- 6.3.3/source_orig/ebuck2.f 2015-04-14 13:58:10.102343729 +0200 +++ 6.3.3/source/ebuck2.f 2015-04-15 13:48:53.508041220 +0200 @@ -96,6 +96,9 @@ real*8, allocatable :: vscale(:) logical proceed character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c perform dynamic allocation of some local arrays @@ -163,6 +166,8 @@ xi = xred(i) yi = yred(i) zi = zred(i) +cqmmm + iqmmm = qmmm(i) c c set interaction scaling coefficients for connected atoms c @@ -188,6 +193,11 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (k .ne. i) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (iqmmm .ne. 1 .and. kqmmm .ne. 1 + & .and. ikqmmm .ne. 4) c c compute the Hessian elements for this interaction c @@ -400,6 +410,8 @@ xi = xred(i) yi = yred(i) zi = zred(i) +cqmmm + iqmmm = qmmm(i) c c set interaction scaling coefficients for connected atoms c @@ -424,6 +436,9 @@ kv = ired(k) proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (iqmmm .ne. 1 .and. kqmmm .ne. 1) c c compute the Hessian elements for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/ebuck3.f 6.3.3/source/ebuck3.f --- 6.3.3/source_orig/ebuck3.f 2015-04-14 13:58:10.102343729 +0200 +++ 6.3.3/source/ebuck3.f 2015-04-15 13:48:53.508041220 +0200 @@ -118,6 +118,9 @@ logical proceed,usei logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and partitioning terms @@ -177,6 +180,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -202,6 +208,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -319,6 +329,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -344,6 +357,9 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (kqmmm .ne. 1) c c compute the energy contribution for this interaction c @@ -527,6 +543,9 @@ logical prime,repeat logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and partitioning terms @@ -601,6 +620,9 @@ yi = ysort(rgy(ii)) zi = zsort(rgz(ii)) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -653,6 +675,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -851,6 +877,9 @@ logical proceed,usei logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and partitioning terms @@ -910,6 +939,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -935,6 +967,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/ebuck.f 6.3.3/source/ebuck.f --- 6.3.3/source_orig/ebuck.f 2015-04-14 13:58:10.102343729 +0200 +++ 6.3.3/source/ebuck.f 2015-04-15 13:48:53.508041220 +0200 @@ -96,6 +96,9 @@ real*8, allocatable :: vscale(:) logical proceed,usei character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy contribution @@ -150,6 +153,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -175,6 +181,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -261,6 +271,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -286,6 +299,9 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (kqmmm .ne. 1) c c compute the energy contribution for this interaction c @@ -428,6 +444,9 @@ logical proceed,usei logical prime,repeat character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy contribution @@ -497,6 +516,9 @@ yi = ysort(rgy(ii)) zi = zsort(rgz(ii)) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -549,6 +571,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -699,6 +725,9 @@ real*8, allocatable :: vscale(:) logical proceed,usei character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy contribution @@ -753,6 +782,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -778,6 +810,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/echarge1.f 6.3.3/source/echarge1.f --- 6.3.3/source_orig/echarge1.f 2015-04-14 13:58:10.102343729 +0200 +++ 6.3.3/source/echarge1.f 2015-04-15 13:48:53.512041220 +0200 @@ -21,6 +21,8 @@ include 'sizes.i' include 'cutoff.i' include 'warp.i' +cqmmm + include 'qmmm.i' c c c choose the method for summing over pairwise interactions @@ -42,6 +44,8 @@ else call echarge1a end if +cqmmm + if (nbinqm .ne. 0 .and. e4qmmm .eq. 0) call echarge1qmmm return end c @@ -97,6 +101,9 @@ real*8, allocatable :: cscale(:) logical proceed,usei character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the charge interaction energy and derivatives @@ -154,6 +161,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = ii+1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -274,6 +292,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = ii+1, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -322,6 +344,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = ii, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -448,6 +481,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = ii, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -526,6 +563,9 @@ logical proceed,usei logical prime,repeat character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the charge interaction energy and derivatives @@ -599,6 +639,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = 1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c loop over method of lights neighbors of current atom c @@ -770,6 +821,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = 1, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -844,6 +899,9 @@ real*8, allocatable :: cscale(:) logical proceed,usei character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the charge interaction energy and derivatives @@ -901,6 +959,18 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = 1, nelst(ii) + jqmmm = mod(qmmm(iion(elst(j,ii))),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) + & cscale(iion(elst(j,ii))) = 1.0d0 + if (ijqmmm .ne. 0) cscale(iion(elst(j,ii))) = + & cscale(iion(elst(j,ii))) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -1022,6 +1092,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = 1, nelst(ii) + cscale(iion(elst(j,ii))) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -1096,6 +1170,9 @@ logical proceed,usei character*6 mode external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the Ewald summation energy and derivatives @@ -1192,6 +1269,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = ii+1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -1274,6 +1362,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = ii+1, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -1318,6 +1410,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = ii, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -1403,6 +1506,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = ii, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -1487,6 +1594,9 @@ logical prime,repeat character*6 mode external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the Ewald summation energy and derivatives @@ -1600,6 +1710,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = 1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c loop over method of lights neighbors of current atom c @@ -1733,6 +1854,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = 1, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -1818,6 +1943,9 @@ logical proceed,usei character*6 mode external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the Ewald summation energy and derivatives @@ -1944,6 +2072,18 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = 1, nelst(ii) + jqmmm = mod(qmmm(iion(elst(j,ii))),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) + & cscale(iion(elst(j,ii))) = 1.0d0 + if (ijqmmm .ne. 0) cscale(iion(elst(j,ii))) = + & cscale(iion(elst(j,ii))) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -2027,6 +2167,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = 1, nelst(ii) + cscale(iion(elst(j,ii))) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -2117,6 +2261,9 @@ real*8, allocatable :: cscale(:) logical proceed,usei external erf +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the charge interaction energy and derivatives @@ -2180,6 +2327,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = ii+1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -2279,6 +2437,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = ii+1, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -2497,3 +2659,463 @@ end do return end +c +c +c ###################################################### +c ## ## +c ## subroutine echarge1qmmm -- QM/MM corrections ## +c ## ## +c ###################################################### +c +c +c "echarge1qmmm" corrects the charge-charge interaction energy +c using a pairwise double loop +c only MM-MM, MM-Y and Y-Y interactions must be excluded +c +c + subroutine echarge1qmmm + implicit none + include 'sizes.i' + include 'atoms.i' + include 'bound.i' + include 'cell.i' + include 'charge.i' + include 'chgpot.i' + include 'couple.i' + include 'deriv.i' + include 'energi.i' + include 'group.i' + include 'inter.i' + include 'molcul.i' + include 'shunt.i' + include 'usage.i' + include 'virial.i' + integer i,j,k + integer ii,kk + integer in,kn + integer ic,kc + real*8 e,fgrp,de,dc + real*8 f,fi,fik + real*8 r,r2,rb,rb2 + real*8 xi,yi,zi + real*8 xr,yr,zr + real*8 xc,yc,zc + real*8 xic,yic,zic + real*8 dedx,dedy,dedz + real*8 dedxc,dedyc,dedzc + real*8 shift,taper,trans + real*8 dtaper,dtrans + real*8 rc,rc2,rc3,rc4 + real*8 rc5,rc6,rc7 + real*8 vxx,vyy,vzz + real*8 vyx,vzx,vzy + real*8, allocatable :: cscale(:) + logical proceed,usei + character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm,kqmmm,ikqmmm + real*8 mmact(0:2) + save mmact + data mmact/0.0d0,1.0d0,1.0d0/ +c +c +c + if (nion .eq. 0) return +c +c perform dynamic allocation of some local arrays +c + allocate (cscale(n)) +c +c set array needed to scale connected atom interactions +c + do i = 1, n + cscale(i) = 1.0d0 + end do +c +c set conversion factor, cutoff and switching coefficients +c + f = electric / dielec + mode = 'CHARGE' + call switch (mode) +c +c compute the charge interaction energy and first derivatives +c + do ii = 1, nion-1 + i = iion(ii) + in = jion(ii) + ic = kion(ii) + xic = x(ic) + yic = y(ic) + zic = z(ic) + xi = x(i) - xic + yi = y(i) - yic + zi = z(i) - zic + fi = f * pchg(ii) + usei = (use(i) .or. use(ic)) +c +c set interaction scaling coefficients for connected atoms +c + do j = 1, n12(in) + cscale(i12(j,in)) = c2scale + end do + do j = 1, n13(in) + cscale(i13(j,in)) = c3scale + end do + do j = 1, n14(in) + cscale(i14(j,in)) = c4scale + end do + do j = 1, n15(in) + cscale(i15(j,in)) = c5scale + end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = ii+1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do +c +c decide whether to compute the current interaction +c + do kk = ii+1, nion + k = iion(kk) + kn = jion(kk) + kc = kion(kk) +cqmmm + kqmmm = mod(qmmm(k),3) + ikqmmm = iqmmm + kqmmm + proceed = .true. + if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) + if (proceed) proceed = (usei .or. use(k) .or. use(kc)) + if (proceed) proceed = (ikqmmm .ne. 0) +c +c compute the energy contribution for this interaction +c + if (proceed) then + xc = xic - x(kc) + yc = yic - y(kc) + zc = zic - z(kc) + if (use_bounds) call image (xc,yc,zc) + rc2 = xc*xc + yc*yc + zc*zc + if (rc2 .le. off2) then + xr = xc + xi - x(k) + x(kc) + yr = yc + yi - y(k) + y(kc) + zr = zc + zi - z(k) + z(kc) + r2 = xr*xr + yr*yr + zr*zr + r = sqrt(r2) + rb = r + ebuffer + rb2 = rb * rb + fik = fi * pchg(kk) * cscale(kn) + e = fik / rb + de = -fik / rb2 + dc = 0.0d0 +c +c use shifted energy switching if near the cutoff distance +c + shift = fik / (0.5d0*(off+cut)) + e = e - shift + if (rc2 .gt. cut2) then + rc = sqrt(rc2) + rc3 = rc2 * rc + rc4 = rc2 * rc2 + rc5 = rc2 * rc3 + rc6 = rc3 * rc3 + rc7 = rc3 * rc4 + taper = c5*rc5 + c4*rc4 + c3*rc3 + & + c2*rc2 + c1*rc + c0 + dtaper = 5.0d0*c5*rc4 + 4.0d0*c4*rc3 + & + 3.0d0*c3*rc2 + 2.0d0*c2*rc + c1 + trans = fik * (f7*rc7 + f6*rc6 + f5*rc5 + f4*rc4 + & + f3*rc3 + f2*rc2 + f1*rc + f0) + dtrans = fik * (7.0d0*f7*rc6 + 6.0d0*f6*rc5 + & + 5.0d0*f5*rc4 + 4.0d0*f4*rc3 + & + 3.0d0*f3*rc2 + 2.0d0*f2*rc + f1) + dc = (e*dtaper + dtrans) / rc + de = de * taper + e = e*taper + trans + end if +c +c scale the interaction based on its group membership +c + if (use_group) then + e = e * fgrp + de = de * fgrp + dc = dc * fgrp + end if +c +c form the chain rule terms for derivative expressions +c + de = de / r + dedx = de * xr + dedy = de * yr + dedz = de * zr + dedxc = dc * xc + dedyc = dc * yc + dedzc = dc * zc +c +c increment the overall energy and derivative expressions +c + ec = ec - e + dec(1,i) = dec(1,i) - dedx*mmact(iqmmm) + dec(2,i) = dec(2,i) - dedy*mmact(iqmmm) + dec(3,i) = dec(3,i) - dedz*mmact(iqmmm) + dec(1,ic) = dec(1,ic) - dedxc*mmact(iqmmm) + dec(2,ic) = dec(2,ic) - dedyc*mmact(iqmmm) + dec(3,ic) = dec(3,ic) - dedzc*mmact(iqmmm) + dec(1,k) = dec(1,k) + dedx*mmact(kqmmm) + dec(2,k) = dec(2,k) + dedy*mmact(kqmmm) + dec(3,k) = dec(3,k) + dedz*mmact(kqmmm) + dec(1,kc) = dec(1,kc) + dedxc*mmact(kqmmm) + dec(2,kc) = dec(2,kc) + dedyc*mmact(kqmmm) + dec(3,kc) = dec(3,kc) + dedzc*mmact(kqmmm) +c +c increment the internal virial tensor components +c + vxx = xr*dedx + xc*dedxc + vyx = yr*dedx + yc*dedxc + vzx = zr*dedx + zc*dedxc + vyy = yr*dedy + yc*dedyc + vzy = zr*dedy + zc*dedyc + vzz = zr*dedz + zc*dedzc + vir(1,1) = vir(1,1) - vxx + vir(2,1) = vir(2,1) - vyx + vir(3,1) = vir(3,1) - vzx + vir(1,2) = vir(1,2) - vyx + vir(2,2) = vir(2,2) - vyy + vir(3,2) = vir(3,2) - vzy + vir(1,3) = vir(1,3) - vzx + vir(2,3) = vir(2,3) - vzy + vir(3,3) = vir(3,3) - vzz +c +c increment the total intermolecular energy +c + if (molcule(i) .ne. molcule(k)) then + einter = einter - e + end if + end if + end if + end do +c +c reset interaction scaling coefficients for connected atoms +c +cqmmm + do j = ii+1, nion + cscale(iion(j)) = 1.0d0 + end do + do j = 1, n12(in) + cscale(i12(j,in)) = 1.0d0 + end do + do j = 1, n13(in) + cscale(i13(j,in)) = 1.0d0 + end do + do j = 1, n14(in) + cscale(i14(j,in)) = 1.0d0 + end do + do j = 1, n15(in) + cscale(i15(j,in)) = 1.0d0 + end do + end do +c +c for periodic boundary conditions with large cutoffs +c neighbors must be found by the replicates method +c + if (.not. use_replica) return +c +c calculate interaction energy with other unit cells +c + do ii = 1, nion + i = iion(ii) + in = jion(ii) + ic = kion(ii) + usei = (use(i) .or. use(ic)) + xic = x(ic) + yic = y(ic) + zic = z(ic) + xi = x(i) - xic + yi = y(i) - yic + zi = z(i) - zic + fi = f * pchg(ii) +c +c set interaction scaling coefficients for connected atoms +c + do j = 1, n12(in) + cscale(i12(j,in)) = c2scale + end do + do j = 1, n13(in) + cscale(i13(j,in)) = c3scale + end do + do j = 1, n14(in) + cscale(i14(j,in)) = c4scale + end do + do j = 1, n15(in) + cscale(i15(j,in)) = c5scale + end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + if (iqmmm .eq. 0) goto 99 + do j = ii, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do +c +c decide whether to compute the current interaction +c + do kk = ii, nion + k = iion(kk) + kn = jion(kk) + kc = kion(kk) + proceed = .true. + if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) + if (proceed) proceed = (usei .or. use(k) .or. use(kc)) +c +c compute the energy contribution for this interaction +c + if (proceed) then + do j = 1, ncell + xc = xic - x(kc) + yc = yic - y(kc) + zc = zic - z(kc) + call imager (xc,yc,zc,j) + rc2 = xc*xc + yc*yc + zc*zc + if (rc2 .le. off2) then + xr = xc + xi - x(k) + x(kc) + yr = yc + yi - y(k) + y(kc) + zr = zc + zi - z(k) + z(kc) + r2 = xr*xr + yr*yr + zr*zr + r = sqrt(r2) + rb = r + ebuffer + rb2 = rb * rb + fik = fi * pchg(kk) + if (use_polymer) then + if (r2 .le. polycut2) fik = fik * cscale(kn) + end if + e = fik / rb + de = -fik / rb2 + dc = 0.0d0 +c +c use shifted energy switching if near the cutoff distance +c + shift = fik / (0.5d0*(off+cut)) + e = e - shift + if (rc2 .gt. cut2) then + rc = sqrt(rc2) + rc3 = rc2 * rc + rc4 = rc2 * rc2 + rc5 = rc2 * rc3 + rc6 = rc3 * rc3 + rc7 = rc3 * rc4 + taper = c5*rc5 + c4*rc4 + c3*rc3 + & + c2*rc2 + c1*rc + c0 + dtaper = 5.0d0*c5*rc4 + 4.0d0*c4*rc3 + & + 3.0d0*c3*rc2 + 2.0d0*c2*rc + c1 + trans = fik * (f7*rc7 + f6*rc6 + f5*rc5 + f4*rc4 + & + f3*rc3 + f2*rc2 + f1*rc + f0) + dtrans = fik * (7.0d0*f7*rc6 + 6.0d0*f6*rc5 + & + 5.0d0*f5*rc4 + 4.0d0*f4*rc3 + & + 3.0d0*f3*rc2 + 2.0d0*f2*rc + f1) + dc = (e*dtaper + dtrans) / rc + de = de * taper + e = e*taper + trans + end if +c +c scale the interaction based on its group membership +c + if (use_group) then + e = e * fgrp + de = de * fgrp + dc = dc * fgrp + end if +c +c form the chain rule terms for derivative expressions +c + de = de / r + dedx = de * xr + dedy = de * yr + dedz = de * zr + dedxc = dc * xc + dedyc = dc * yc + dedzc = dc * zc +c +c increment the energy and gradient values +c + if (i .eq. k) e = 0.5d0 * e + ec = ec - e + dec(1,i) = dec(1,i) - dedx*mmact(iqmmm) + dec(2,i) = dec(2,i) - dedy*mmact(iqmmm) + dec(3,i) = dec(3,i) - dedz*mmact(iqmmm) + dec(1,ic) = dec(1,ic) - dedxc*mmact(iqmmm) + dec(2,ic) = dec(2,ic) - dedyc*mmact(iqmmm) + dec(3,ic) = dec(3,ic) - dedzc*mmact(iqmmm) + if (i .ne. k) then + dec(1,k) = dec(1,k) + dedx + dec(2,k) = dec(2,k) + dedy + dec(3,k) = dec(3,k) + dedz + dec(1,kc) = dec(1,kc) + dedxc + dec(2,kc) = dec(2,kc) + dedyc + dec(3,kc) = dec(3,kc) + dedzc + end if +c +c increment the internal virial tensor components +c + vxx = xr*dedx + xc*dedxc + vyx = yr*dedx + yc*dedxc + vzx = zr*dedx + zc*dedxc + vyy = yr*dedy + yc*dedyc + vzy = zr*dedy + zc*dedyc + vzz = zr*dedz + zc*dedzc + vir(1,1) = vir(1,1) - vxx + vir(2,1) = vir(2,1) - vyx + vir(3,1) = vir(3,1) - vzx + vir(1,2) = vir(1,2) - vyx + vir(2,2) = vir(2,2) - vyy + vir(3,2) = vir(3,2) - vzy + vir(1,3) = vir(1,3) - vzx + vir(2,3) = vir(2,3) - vzy + vir(3,3) = vir(3,3) - vzz +c +c increment the total intermolecular energy +c + einter = einter - e + end if + end do + end if + end do +c +c reset interaction scaling coefficients for connected atoms +c +cqmmm + do j = ii, nion + cscale(iion(j)) = 1.0d0 + end do + do j = 1, n12(in) + cscale(i12(j,in)) = 1.0d0 + end do + do j = 1, n13(in) + cscale(i13(j,in)) = 1.0d0 + end do + do j = 1, n14(in) + cscale(i14(j,in)) = 1.0d0 + end do + do j = 1, n15(in) + cscale(i15(j,in)) = 1.0d0 + end do +cqmmm + 99 continue + end do +c +c perform deallocation of some local arrays +c + deallocate (cscale) + return + end + diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/echarge2.f 6.3.3/source/echarge2.f --- 6.3.3/source_orig/echarge2.f 2015-04-14 13:58:10.102343729 +0200 +++ 6.3.3/source/echarge2.f 2015-04-15 13:48:53.512041220 +0200 @@ -22,6 +22,8 @@ include 'cutoff.i' include 'warp.i' integer i +cqmmm + include 'qmmm.i' c c c choose the method for summing over pairwise interactions @@ -33,6 +35,8 @@ else call echarge2a (i) end if +cqmmm + if (nbinqm .ne. 0 .and. e4qmmm .eq. 0) call echarge2qmmm (i) return end c @@ -77,6 +81,9 @@ real*8, allocatable :: cscale(:) logical proceed character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c first see if the atom of interest carries a charge @@ -118,6 +125,16 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = 1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j)) = 1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = cscale(iion(j))*qmmmscale + end do c c set cutoff distances and switching function coefficients c @@ -374,6 +391,9 @@ real*8, allocatable :: cscale(:) logical proceed external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c first see if the atom of interest carries a charge @@ -416,6 +436,16 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = 1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j)) = 1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = cscale(iion(j))*qmmmscale + end do c c calculate the real space Ewald interaction Hessian elements c @@ -610,6 +640,9 @@ real*8, allocatable :: cscale(:) logical proceed external erf +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c first see if the atom of interest carries a charge @@ -651,6 +684,16 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = 1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j)) = 1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = cscale(iion(j))*qmmmscale + end do c c set the smallest exponential terms to be calculated c @@ -777,3 +820,318 @@ deallocate (cscale) return end +c +c +c ###################################################### +c ## ## +c ## subroutine echarge2qmmm -- QM/MM corrections ## +c ## ## +c ###################################################### +c +c +c "echarge2qmmm" corrects the charge-charge interaction energy +c using a pairwise double loop +c only MM-MM, MM-Y and Y-Y interactions must be excluded +c +c + subroutine echarge2qmmm (i) + implicit none + include 'sizes.i' + include 'atoms.i' + include 'bound.i' + include 'cell.i' + include 'charge.i' + include 'chgpot.i' + include 'couple.i' + include 'group.i' + include 'hessn.i' + include 'shunt.i' + integer i,j,k,kk + integer in,kn,jcell + real*8 e,de,d2e + real*8 fi,fik,fgrp + real*8 d2edx,d2edy,d2edz + real*8 xi,yi,zi + real*8 xr,yr,zr + real*8 shift,taper,trans + real*8 dtaper,dtrans + real*8 d2taper,d2trans + real*8 r,rb,rb2 + real*8 r2,r3,r4 + real*8 r5,r6,r7 + real*8 term(3,3) + real*8, allocatable :: cscale(:) + logical proceed + character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm,kqmmm,ikqmmm +c +c +c first see if the atom of interest carries a charge +c + do k = 1, nion + if (iion(k) .eq. i) then + fi = electric * pchg(k) / dielec + in = jion(k) + goto 10 + end if + end do + return + 10 continue +c +c store the coordinates of the atom of interest +c + xi = x(i) + yi = y(i) + zi = z(i) +c +c perform dynamic allocation of some local arrays +c + allocate (cscale(n)) +c +c set array needed to scale connected atom interactions +c + do j = 1, nion + cscale(iion(j)) = 1.0d0 + end do + do j = 1, n12(in) + cscale(i12(j,in)) = c2scale + end do + do j = 1, n13(in) + cscale(i13(j,in)) = c3scale + end do + do j = 1, n14(in) + cscale(i14(j,in)) = c4scale + end do + do j = 1, n15(in) + cscale(i15(j,in)) = c5scale + end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = 1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j)) = 1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = cscale(iion(j))*qmmmscale + end do +c +c set cutoff distances and switching function coefficients +c + mode = 'CHARGE' + call switch (mode) +c +c calculate the charge interaction energy Hessian elements +c + do kk = 1, nion + k = iion(kk) + kn = jion(kk) +cqmmm + kqmmm = mod(qmmm(k),3) + ikqmmm = iqmmm + kqmmm + proceed = .true. + if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) + if (proceed) proceed = (kn .ne. i) + if (proceed) proceed = (ikqmmm .ne. 0) +c +c compute the energy contribution for this interaction +c + if (proceed) then + xr = xi - x(k) + yr = yi - y(k) + zr = zi - z(k) + if (use_bounds) call image (xr,yr,zr) + r2 = xr*xr + yr*yr + zr*zr + if (r2 .le. off2) then + r = sqrt(r2) + rb = r + ebuffer + rb2 = rb * rb + fik = fi * pchg(kk) * cscale(kn) +c +c compute chain rule terms for Hessian matrix elements +c + de = -fik / rb2 + d2e = -2.0d0 * de/rb +c +c use shifted energy switching if near the cutoff distance +c + if (r2 .gt. cut2) then + e = fik / r + shift = fik / (0.5d0*(off+cut)) + e = e - shift + r3 = r2 * r + r4 = r2 * r2 + r5 = r2 * r3 + r6 = r3 * r3 + r7 = r3 * r4 + taper = c5*r5 + c4*r4 + c3*r3 + c2*r2 + c1*r + c0 + dtaper = 5.0d0*c5*r4 + 4.0d0*c4*r3 + & + 3.0d0*c3*r2 + 2.0d0*c2*r + c1 + d2taper = 20.0d0*c5*r3 + 12.0d0*c4*r2 + & + 6.0d0*c3*r + 2.0d0*c2 + trans = fik * (f7*r7 + f6*r6 + f5*r5 + f4*r4 + & + f3*r3 + f2*r2 + f1*r + f0) + dtrans = fik * (7.0d0*f7*r6 + 6.0d0*f6*r5 + & + 5.0d0*f5*r4 + 4.0d0*f4*r3 + & + 3.0d0*f3*r2 + 2.0d0*f2*r + f1) + d2trans = fik * (42.0d0*f7*r5 + 30.0d0*f6*r4 + & + 20.0d0*f5*r3 + 12.0d0*f4*r2 + & + 6.0d0*f3*r + 2.0d0*f2) + d2e = e*d2taper + 2.0d0*de*dtaper + & + d2e*taper + d2trans + de = e*dtaper + de*taper + dtrans + end if +c +c scale the interaction based on its group membership +c + if (use_group) then + de = de * fgrp + d2e = d2e * fgrp + end if +c +c form the individual Hessian element components +c + de = de / r + d2e = (d2e-de) / r2 + d2edx = d2e * xr + d2edy = d2e * yr + d2edz = d2e * zr + term(1,1) = d2edx*xr + de + term(1,2) = d2edx*yr + term(1,3) = d2edx*zr + term(2,1) = term(1,2) + term(2,2) = d2edy*yr + de + term(2,3) = d2edy*zr + term(3,1) = term(1,3) + term(3,2) = term(2,3) + term(3,3) = d2edz*zr + de +c +c increment diagonal and non-diagonal Hessian elements +c + do j = 1, 3 + hessx(j,i) = hessx(j,i) - term(1,j) + hessy(j,i) = hessy(j,i) - term(2,j) + hessz(j,i) = hessz(j,i) - term(3,j) + hessx(j,k) = hessx(j,k) + term(1,j) + hessy(j,k) = hessy(j,k) + term(2,j) + hessz(j,k) = hessz(j,k) + term(3,j) + end do + end if + end if + end do +c +c for periodic boundary conditions with large cutoffs +c neighbors must be found by the replicates method +c + if (.not. use_replica) return +cqmmm + if (iqmmm .eq. 0) return + +c +c calculate interaction energy with other unit cells +c + do kk = 1, nion + k = iion(kk) + kn = jion(kk) + proceed = .true. + if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) +c +c compute the energy contribution for this interaction +c + if (proceed) then + do jcell = 1, ncell + xr = xi - x(k) + yr = yi - y(k) + zr = zi - z(k) + call imager (xr,yr,zr,jcell) + r2 = xr*xr + yr*yr + zr*zr + if (r2 .le. off2) then + r = sqrt(r2) + rb = r + ebuffer + rb2 = rb * rb + fik = fi * pchg(kk) + if (use_polymer) then + if (r2 .le. polycut2) fik = fik * cscale(kn) + end if +c +c compute chain rule terms for Hessian matrix elements +c + de = -fik / rb2 + d2e = -2.0d0 * de/rb +c +c use shifted energy switching if near the cutoff distance +c + if (r2 .gt. cut2) then + e = fik / r + shift = fik / (0.5d0*(off+cut)) + e = e - shift + r3 = r2 * r + r4 = r2 * r2 + r5 = r2 * r3 + r6 = r3 * r3 + r7 = r3 * r4 + taper = c5*r5 + c4*r4 + c3*r3 + c2*r2 + c1*r + c0 + dtaper = 5.0d0*c5*r4 + 4.0d0*c4*r3 + & + 3.0d0*c3*r2 + 2.0d0*c2*r + c1 + d2taper = 20.0d0*c5*r3 + 12.0d0*c4*r2 + & + 6.0d0*c3*r + 2.0d0*c2 + trans = fik * (f7*r7 + f6*r6 + f5*r5 + f4*r4 + & + f3*r3 + f2*r2 + f1*r + f0) + dtrans = fik * (7.0d0*f7*r6 + 6.0d0*f6*r5 + & + 5.0d0*f5*r4 + 4.0d0*f4*r3 + & + 3.0d0*f3*r2 + 2.0d0*f2*r + f1) + d2trans = fik * (42.0d0*f7*r5 + 30.0d0*f6*r4 + & + 20.0d0*f5*r3 + 12.0d0*f4*r2 + & + 6.0d0*f3*r + 2.0d0*f2) + d2e = e*d2taper + 2.0d0*de*dtaper + & + d2e*taper + d2trans + de = e*dtaper + de*taper + dtrans + end if +c +c scale the interaction based on its group membership +c + if (use_group) then + de = de * fgrp + d2e = d2e * fgrp + end if +c +c form the individual Hessian element components +c + de = de / r + d2e = (d2e-de) / r2 + d2edx = d2e * xr + d2edy = d2e * yr + d2edz = d2e * zr + term(1,1) = d2edx*xr + de + term(1,2) = d2edx*yr + term(1,3) = d2edx*zr + term(2,1) = term(1,2) + term(2,2) = d2edy*yr + de + term(2,3) = d2edy*zr + term(3,1) = term(1,3) + term(3,2) = term(2,3) + term(3,3) = d2edz*zr + de +c +c increment diagonal and non-diagonal Hessian elements +c + do j = 1, 3 + hessx(j,i) = hessx(j,i) - term(1,j) + hessy(j,i) = hessy(j,i) - term(2,j) + hessz(j,i) = hessz(j,i) - term(3,j) + hessx(j,k) = hessx(j,k) + term(1,j) + hessy(j,k) = hessy(j,k) + term(2,j) + hessz(j,k) = hessz(j,k) + term(3,j) + end do + end if + end do + end if + end do +c +c perform deallocation of some local arrays +c + deallocate (cscale) + return + end + diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/echarge3.f 6.3.3/source/echarge3.f --- 6.3.3/source_orig/echarge3.f 2015-04-14 13:58:10.102343729 +0200 +++ 6.3.3/source/echarge3.f 2015-04-15 13:48:53.512041220 +0200 @@ -21,6 +21,8 @@ include 'sizes.i' include 'cutoff.i' include 'warp.i' +cqmmm + include 'qmmm.i' c c c choose the method for summing over pairwise interactions @@ -42,6 +44,8 @@ else call echarge3a end if +cqmmm + if (nbinqm .ne. 0 .and. e4qmmm .eq. 0) call echarge3qmmm return end c @@ -96,6 +100,9 @@ logical proceed,usei logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the charge interaction energy and partitioning @@ -153,6 +160,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = ii+1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -242,6 +260,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = ii+1, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -290,6 +312,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = ii, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -383,6 +416,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = ii, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -461,6 +498,9 @@ logical prime,repeat logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the charge interaction energy and partitioning @@ -534,6 +574,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = 1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c loop over method of lights neighbors of current atom c @@ -685,6 +736,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = 1, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -759,6 +814,9 @@ logical proceed,usei logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the charge interaction energy and partitioning @@ -816,6 +874,18 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = 1, nelst(ii) + jqmmm = mod(qmmm(iion(elst(j,ii))),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) + & cscale(iion(elst(j,ii))) = 1.0d0 + if (ijqmmm .ne. 0) cscale(iion(elst(j,ii))) = + & cscale(iion(elst(j,ii))) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -906,6 +976,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = 1, nelst(ii) + cscale(iion(elst(j,ii))) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -980,6 +1054,9 @@ logical header,huge character*6 mode external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the Ewald summation energy and partitioning @@ -1065,6 +1142,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = ii+1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -1135,6 +1223,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = ii+1, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -1183,6 +1275,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = ii, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -1253,6 +1356,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = ii, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -1333,6 +1440,9 @@ logical header,huge character*6 mode external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the Ewald summation energy and partitioning @@ -1435,6 +1545,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = 1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c loop over method of lights neighbors of current atom c @@ -1563,6 +1684,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = 1, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -1647,6 +1772,9 @@ logical header,huge character*6 mode external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the Ewald summation energy and partitioning @@ -1752,6 +1880,18 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = 1, nelst(ii) + jqmmm = mod(qmmm(iion(elst(j,ii))),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) + & cscale(iion(elst(j,ii))) = 1.0d0 + if (ijqmmm .ne. 0) cscale(iion(elst(j,ii))) = + & cscale(iion(elst(j,ii))) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -1823,6 +1963,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = 1, nelst(ii) + cscale(iion(elst(j,ii))) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -1907,6 +2051,9 @@ logical proceed,usei logical header,huge external erf +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the charge interaction energy and partitioning @@ -1969,6 +2116,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = ii+1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -2053,6 +2211,400 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = ii+1, nion + cscale(iion(j)) = 1.0d0 + end do + do j = 1, n12(in) + cscale(i12(j,in)) = 1.0d0 + end do + do j = 1, n13(in) + cscale(i13(j,in)) = 1.0d0 + end do + do j = 1, n14(in) + cscale(i14(j,in)) = 1.0d0 + end do + do j = 1, n15(in) + cscale(i15(j,in)) = 1.0d0 + end do + end do +c +c perform deallocation of some local arrays +c + deallocate (cscale) + return + end +c +c +c ###################################################### +c ## ## +c ## subroutine echarge3qmmm -- QM/MM corrections ## +c ## ## +c ###################################################### +c +c +c "echarge3qmmm" corrects the charge-charge interaction energy +c using a pairwise double loop +c only MM-MM, MM-Y and Y-Y interactions must be excluded +c +c + subroutine echarge3qmmm + implicit none + include 'sizes.i' + include 'action.i' + include 'analyz.i' + include 'atmtyp.i' + include 'atoms.i' + include 'bound.i' + include 'cell.i' + include 'charge.i' + include 'chgpot.i' + include 'couple.i' + include 'energi.i' + include 'group.i' + include 'inform.i' + include 'inter.i' + include 'iounit.i' + include 'molcul.i' + include 'shunt.i' + include 'usage.i' + integer i,j,k + integer ii,kk + integer in,kn + integer ic,kc + real*8 e,fgrp + real*8 r,r2,rb + real*8 f,fi,fik + real*8 xi,yi,zi + real*8 xr,yr,zr + real*8 xc,yc,zc + real*8 xic,yic,zic + real*8 shift,taper,trans + real*8 rc,rc2,rc3,rc4 + real*8 rc5,rc6,rc7 + real*8, allocatable :: cscale(:) + logical proceed,usei + logical header,huge + character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm,kqmmm,ikqmmm +c +c +c + if (nion .eq. 0) return + header = .true. +c +c perform dynamic allocation of some local arrays +c + allocate (cscale(n)) +c +c set array needed to scale connected atom interactions +c + do i = 1, n + cscale(i) = 1.0d0 + end do +c +c set conversion factor, cutoff and switching coefficients +c + f = electric / dielec + mode = 'CHARGE' + call switch (mode) +c +c compute and partition the charge interaction energy +c + do ii = 1, nion-1 + i = iion(ii) + in = jion(ii) + ic = kion(ii) + xic = x(ic) + yic = y(ic) + zic = z(ic) + xi = x(i) - xic + yi = y(i) - yic + zi = z(i) - zic + fi = f * pchg(ii) + usei = (use(i) .or. use(ic)) +c +c set interaction scaling coefficients for connected atoms +c + do j = 1, n12(in) + cscale(i12(j,in)) = c2scale + end do + do j = 1, n13(in) + cscale(i13(j,in)) = c3scale + end do + do j = 1, n14(in) + cscale(i14(j,in)) = c4scale + end do + do j = 1, n15(in) + cscale(i15(j,in)) = c5scale + end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = ii+1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do +c +c decide whether to compute the current interaction +c + do kk = ii+1, nion + k = iion(kk) + kn = jion(kk) + kc = kion(kk) +cqmmm + kqmmm = mod(qmmm(k),3) + ikqmmm = iqmmm + kqmmm + proceed = .true. + if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) + if (proceed) proceed = (usei .or. use(k) .or. use(kc)) + if (proceed) proceed = (cscale(kn) .ne. 0.0d0) + if (proceed) proceed = (ikqmmm .ne. 0) +c +c compute the energy contribution for this interaction +c + if (proceed) then + xc = xic - x(kc) + yc = yic - y(kc) + zc = zic - z(kc) + if (use_bounds) call image (xc,yc,zc) + rc2 = xc*xc + yc*yc + zc*zc + if (rc2 .le. off2) then + xr = xc + xi - x(k) + x(kc) + yr = yc + yi - y(k) + y(kc) + zr = zc + zi - z(k) + z(kc) + r2 = xr*xr + yr*yr + zr*zr + r = sqrt(r2) + rb = r + ebuffer + fik = fi * pchg(kk) * cscale(kn) + e = fik / rb +c +c use shifted energy switching if near the cutoff distance +c + shift = fik / (0.5d0*(off+cut)) + e = e - shift + if (rc2 .gt. cut2) then + rc = sqrt(rc2) + rc3 = rc2 * rc + rc4 = rc2 * rc2 + rc5 = rc2 * rc3 + rc6 = rc3 * rc3 + rc7 = rc3 * rc4 + taper = c5*rc5 + c4*rc4 + c3*rc3 + & + c2*rc2 + c1*rc + c0 + trans = fik * (f7*rc7 + f6*rc6 + f5*rc5 + f4*rc4 + & + f3*rc3 + f2*rc2 + f1*rc + f0) + e = e*taper + trans + end if +c +c scale the interaction based on its group membership +c + if (use_group) e = e * fgrp +c +c increment the overall charge-charge energy component +c + nec = nec - 1 + ec = ec - e + aec(i) = aec(i) - 0.5d0*e + aec(k) = aec(k) - 0.5d0*e +c +c increment the total intermolecular energy +c + if (molcule(i) .ne. molcule(k)) then + einter = einter - e + end if +c +c print a message if the energy of this interaction is large +c + huge = (abs(e) .gt. 100.0d0) + if (debug .or. (verbose.and.huge)) then + if (header) then + header = .false. + write (iout,10) + 10 format (/,' Removing Individual Charge-Charge', + & ' Interactions :', + & //,' Type',14x,'Atom Names', + & 17x,'Charges',5x,'Distance', + & 6x,'Energy',/) + end if + write (iout,20) i,name(i),k,name(k), + & pchg(ii),pchg(kk),r,e + 20 format (' Charge',4x,2(i7,'-',a3),8x, + & 2f7.2,f11.4,f12.4) + end if + end if + end if + end do +c +c reset interaction scaling coefficients for connected atoms +c +cqmmm + do j = ii+1, nion + cscale(iion(j)) = 1.0d0 + end do + do j = 1, n12(in) + cscale(i12(j,in)) = 1.0d0 + end do + do j = 1, n13(in) + cscale(i13(j,in)) = 1.0d0 + end do + do j = 1, n14(in) + cscale(i14(j,in)) = 1.0d0 + end do + do j = 1, n15(in) + cscale(i15(j,in)) = 1.0d0 + end do + end do +c +c for periodic boundary conditions with large cutoffs +c neighbors must be found by the replicates method +c + if (.not. use_replica) return +c +c calculate interaction energy with other unit cells +c + do ii = 1, nion + i = iion(ii) + in = jion(ii) + ic = kion(ii) + usei = (use(i) .or. use(ic)) + xic = x(ic) + yic = y(ic) + zic = z(ic) + xi = x(i) - xic + yi = y(i) - yic + zi = z(i) - zic + fi = f * pchg(ii) +c +c set interaction scaling coefficients for connected atoms +c + do j = 1, n12(in) + cscale(i12(j,in)) = c2scale + end do + do j = 1, n13(in) + cscale(i13(j,in)) = c3scale + end do + do j = 1, n14(in) + cscale(i14(j,in)) = c4scale + end do + do j = 1, n15(in) + cscale(i15(j,in)) = c5scale + end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + if (iqmmm .eq. 0) goto 99 + do j = ii, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do +c +c decide whether to compute the current interaction +c + do kk = ii, nion + k = iion(kk) + kn = jion(kk) + kc = kion(kk) + proceed = .true. + if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) + if (proceed) proceed = (usei .or. use(k) .or. use(kc)) +c +c compute the energy contribution for this interaction +c + if (proceed) then + do j = 1, ncell + xc = xic - x(kc) + yc = yic - y(kc) + zc = zic - z(kc) + call imager (xc,yc,zc,j) + rc2 = xc*xc + yc*yc + zc*zc + if (rc2 .le. off2) then + xr = xc + xi - x(k) + x(kc) + yr = yc + yi - y(k) + y(kc) + zr = zc + zi - z(k) + z(kc) + r2 = xr*xr + yr*yr + zr*zr + r = sqrt(r2) + rb = r + ebuffer + fik = fi * pchg(kk) + if (use_polymer) then + if (r2 .le. polycut2) fik = fik * cscale(kn) + end if + e = fik / rb +c +c use shifted energy switching if near the cutoff distance +c + shift = fik / (0.5d0*(off+cut)) + e = e - shift + if (rc2 .gt. cut2) then + rc = sqrt(rc2) + rc3 = rc2 * rc + rc4 = rc2 * rc2 + rc5 = rc2 * rc3 + rc6 = rc3 * rc3 + rc7 = rc3 * rc4 + taper = c5*rc5 + c4*rc4 + c3*rc3 + & + c2*rc2 + c1*rc + c0 + trans = fik * (f7*rc7 + f6*rc6 + f5*rc5 + f4*rc4 + & + f3*rc3 + f2*rc2 + f1*rc + f0) + e = e*taper + trans + end if +c +c scale the interaction based on its group membership +c + if (use_group) e = e * fgrp +c +c increment the overall charge-charge energy component +c + if (i .eq. k) e = 0.5d0 * e + if (e .ne. 0.0d0) nec = nec - 1 + ec = ec - e + aec(i) = aec(i) - 0.5d0*e + aec(k) = aec(k) - 0.5d0*e +c +c increment the total intermolecular energy +c + einter = einter - e +c +c print a message if the energy of this interaction is large +c + huge = (abs(e) .gt. 100.0d0) + if ((debug.and.e.ne.0.0d0) + & .or. (verbose.and.huge)) then + if (header) then + header = .false. + write (iout,30) + 30 format (/,' Removing Individual', + & ' Charge-Charge Interactions :', + & //,' Type',14x,'Atom Names', + & 17x,'Charges',5x,'Distance', + & 6x,'Energy',/) + end if + write (iout,40) i,name(i),k,name(k), + & pchg(ii),pchg(kk),r,e + 40 format (' Charge',4x,2(i7,'-',a3),1x, + & '(XTAL)',1x,2f7.2,f11.4,f12.4) + end if + end if + end do + end if + end do +c +c reset interaction scaling coefficients for connected atoms +c +cqmmm + do j = ii, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -2065,6 +2617,8 @@ do j = 1, n15(in) cscale(i15(j,in)) = 1.0d0 end do +cqmmm + 99 continue end do c c perform deallocation of some local arrays @@ -2072,3 +2626,4 @@ deallocate (cscale) return end + diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/echarge.f 6.3.3/source/echarge.f --- 6.3.3/source_orig/echarge.f 2015-04-14 13:58:10.102343729 +0200 +++ 6.3.3/source/echarge.f 2015-04-15 13:48:53.516041220 +0200 @@ -20,6 +20,8 @@ include 'sizes.i' include 'cutoff.i' include 'warp.i' +cqmmm + include 'qmmm.i' c c c choose the method for summing over pairwise interactions @@ -41,6 +43,8 @@ else call echarge0a end if +cqmmm + if (nbinqm .ne. 0 .and. e4qmmm .eq. 0) call echarge0qmmm return end c @@ -86,6 +90,9 @@ real*8, allocatable :: cscale(:) logical proceed,usei character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the charge interaction energy @@ -138,6 +145,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = ii+1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -198,6 +216,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = ii+1, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -246,6 +268,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = ii, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -312,6 +345,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = ii, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -381,6 +418,9 @@ logical proceed,usei logical prime,repeat character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the charge interaction energy @@ -449,6 +489,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = 1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c loop over method of lights neighbors of current atom c @@ -560,6 +611,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = 1, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -624,6 +679,9 @@ real*8, allocatable :: cscale(:) logical proceed,usei character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the charge interaction energy @@ -676,6 +734,18 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = 1, nelst(ii) + jqmmm = mod(qmmm(iion(elst(j,ii))),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) + & cscale(iion(elst(j,ii))) = 1.0d0 + if (ijqmmm .ne. 0) cscale(iion(elst(j,ii))) = + & cscale(iion(elst(j,ii))) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -737,6 +807,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = 1, nelst(ii) + cscale(iion(elst(j,ii))) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -800,6 +874,9 @@ logical proceed,usei character*6 mode external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the Ewald charge interaction energy @@ -876,6 +953,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = ii+1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -914,6 +1002,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = ii+1, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -958,6 +1050,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = ii, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -1005,6 +1108,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = ii, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -1074,6 +1181,9 @@ logical prime,repeat character*6 mode external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the Ewald charge interaction energy @@ -1167,6 +1277,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = 1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) + & = cscale(iion(j)) * qmmmscale + end do c c loop over method of lights neighbors of current atom c @@ -1256,6 +1377,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = 1, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -1323,6 +1448,9 @@ logical proceed,usei character*6 mode external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the Ewald charge interaction energy @@ -1412,6 +1540,18 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = 1, nelst(ii) + jqmmm = mod(qmmm(iion(elst(j,ii))),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) + & cscale(iion(elst(j,ii))) = 1.0d0 + if (ijqmmm .ne. 0) cscale(iion(elst(j,ii))) = + & cscale(iion(elst(j,ii))) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -1451,6 +1591,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = 1, nelst(ii) + cscale(iion(elst(j,ii))) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -1516,6 +1660,9 @@ real*8, allocatable :: cscale(:) logical proceed,usei external erf +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the charge interaction energy @@ -1573,6 +1720,17 @@ do j = 1, n15(in) cscale(i15(j,in)) = c5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = ii+1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do c c decide whether to compute the current interaction c @@ -1628,6 +1786,10 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = ii+1, nion + cscale(iion(j)) = 1.0d0 + end do do j = 1, n12(in) cscale(i12(j,in)) = 1.0d0 end do @@ -1767,3 +1929,331 @@ end if return end +cqmmm +c +c ##################################################### +c ## ## +c ## subroutine echarge0qmmm -- QM/MM corrections ## +c ## ## +c ##################################################### +c +c +c "echarge0qmmm" corrects the charge-charge interaction energy +c using a pairwise double loop +c only MM-MM, MM-Y and Y-Y interactions must be retained +c +c + subroutine echarge0qmmm + implicit none + include 'sizes.i' + include 'atoms.i' + include 'bound.i' + include 'cell.i' + include 'charge.i' + include 'chgpot.i' + include 'couple.i' + include 'energi.i' + include 'group.i' + include 'shunt.i' + include 'usage.i' + integer i,j,k + integer ii,kk + integer in,kn + integer ic,kc + real*8 e,fgrp + real*8 r,r2,rb + real*8 f,fi,fik + real*8 xi,yi,zi + real*8 xr,yr,zr + real*8 xc,yc,zc + real*8 xic,yic,zic + real*8 shift,taper,trans + real*8 rc,rc2,rc3,rc4 + real*8 rc5,rc6,rc7 + real*8, allocatable :: cscale(:) + logical proceed,usei + character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm,kqmmm,ikqmmm +c +c +c + if (nion .eq. 0) return +c +c perform dynamic allocation of some local arrays +c + allocate (cscale(n)) +c +c set array needed to scale connected atom interactions +c + do i = 1, n + cscale(i) = 1.0d0 + end do +c +c set conversion factor, cutoff and switching coefficients +c + f = electric / dielec + mode = 'CHARGE' + call switch (mode) +c +c calculate the charge interaction energy term +c + do ii = 1, nion-1 + i = iion(ii) + in = jion(ii) + ic = kion(ii) + xic = x(ic) + yic = y(ic) + zic = z(ic) + xi = x(i) - xic + yi = y(i) - yic + zi = z(i) - zic + fi = f * pchg(ii) + usei = (use(i) .or. use(ic)) +c +c set interaction scaling coefficients for connected atoms +c + do j = 1, n12(in) + cscale(i12(j,in)) = c2scale + end do + do j = 1, n13(in) + cscale(i13(j,in)) = c3scale + end do + do j = 1, n14(in) + cscale(i14(j,in)) = c4scale + end do + do j = 1, n15(in) + cscale(i15(j,in)) = c5scale + end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + do j = ii+1, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do +c +c decide whether to compute the current interaction +c + do kk = ii+1, nion + k = iion(kk) + kn = jion(kk) + kc = kion(kk) +cqmmm + kqmmm = mod(qmmm(k),3) + ikqmmm = iqmmm + kqmmm + proceed = .true. + if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) + if (proceed) proceed = (usei .or. use(k) .or. use(kc)) + if (proceed) proceed = (ikqmmm .ne. 0) +c +c compute the energy contribution for this interaction +c + if (proceed) then + xc = xic - x(kc) + yc = yic - y(kc) + zc = zic - z(kc) + if (use_bounds) call image (xc,yc,zc) + rc2 = xc*xc + yc*yc + zc*zc + if (rc2 .le. off2) then + xr = xc + xi - x(k) + x(kc) + yr = yc + yi - y(k) + y(kc) + zr = zc + zi - z(k) + z(kc) + r2 = xr*xr + yr*yr + zr*zr + r = sqrt(r2) + rb = r + ebuffer + fik = fi * pchg(kk) * cscale(kn) + e = fik / rb +c +c use shifted energy switching if near the cutoff distance +c + shift = fik / (0.5d0*(off+cut)) + e = e - shift + if (rc2 .gt. cut2) then + rc = sqrt(rc2) + rc3 = rc2 * rc + rc4 = rc2 * rc2 + rc5 = rc2 * rc3 + rc6 = rc3 * rc3 + rc7 = rc3 * rc4 + taper = c5*rc5 + c4*rc4 + c3*rc3 + & + c2*rc2 + c1*rc + c0 + trans = fik * (f7*rc7 + f6*rc6 + f5*rc5 + f4*rc4 + & + f3*rc3 + f2*rc2 + f1*rc + f0) + e = e*taper + trans + end if +c +c scale the interaction based on its group membership +c + if (use_group) e = e * fgrp +c +c decrement the overall charge-charge energy component +c + ec = ec - e + end if + end if + end do +c +c reset interaction scaling coefficients for connected atoms +c +cqmmm + do j = ii+1, nion + cscale(iion(j)) = 1.0d0 + end do + do j = 1, n12(in) + cscale(i12(j,in)) = 1.0d0 + end do + do j = 1, n13(in) + cscale(i13(j,in)) = 1.0d0 + end do + do j = 1, n14(in) + cscale(i14(j,in)) = 1.0d0 + end do + do j = 1, n15(in) + cscale(i15(j,in)) = 1.0d0 + end do + end do +c +c for periodic boundary conditions with large cutoffs +c neighbors must be found by the replicates method +c + if (.not. use_replica) return +c +c calculate interaction energy with other unit cells +c + do ii = 1, nion + i = iion(ii) + in = jion(ii) + ic = kion(ii) + usei = (use(i) .or. use(ic)) + xic = x(ic) + yic = y(ic) + zic = z(ic) + xi = x(i) - xic + yi = y(i) - yic + zi = z(i) - zic + fi = f * pchg(ii) +c +c set interaction scaling coefficients for connected atoms +c + do j = 1, n12(in) + cscale(i12(j,in)) = c2scale + end do + do j = 1, n13(in) + cscale(i13(j,in)) = c3scale + end do + do j = 1, n14(in) + cscale(i14(j,in)) = c4scale + end do + do j = 1, n15(in) + cscale(i15(j,in)) = c5scale + end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(i),3) + if (iqmmm .eq. 0) goto 99 + do j = ii, nion + jqmmm = mod(qmmm(iion(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) cscale(iion(j))=1.0d0 + if (ijqmmm .ne. 0) cscale(iion(j)) = + & cscale(iion(j)) * qmmmscale + end do +c +c decide whether to compute the current interaction +c + do kk = ii, nion + k = iion(kk) + kn = jion(kk) + kc = kion(kk) + proceed = .true. + if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) + if (proceed) proceed = (usei .or. use(k) .or. use(kc)) +c +c compute the energy contribution for this interaction +c + if (proceed) then + do j = 1, ncell + xc = xic - x(kc) + yc = yic - y(kc) + zc = zic - z(kc) + call imager (xc,yc,zc,j) + rc2 = xc*xc + yc*yc + zc*zc + if (rc2 .le. off2) then + xr = xc + xi - x(k) + x(kc) + yr = yc + yi - y(k) + y(kc) + zr = zc + zi - z(k) + z(kc) + r2 = xr*xr + yr*yr + zr*zr + r = sqrt(r2) + rb = r + ebuffer + fik = fi * pchg(kk) + if (use_polymer) then + if (r2 .le. polycut2) fik = fik * cscale(kn) + end if + e = fik / rb +c +c use shifted energy switching if near the cutoff distance +c + shift = fik / (0.5d0*(off+cut)) + e = e - shift + if (rc2 .gt. cut2) then + rc = sqrt(rc2) + rc3 = rc2 * rc + rc4 = rc2 * rc2 + rc5 = rc2 * rc3 + rc6 = rc3 * rc3 + rc7 = rc3 * rc4 + taper = c5*rc5 + c4*rc4 + c3*rc3 + & + c2*rc2 + c1*rc + c0 + trans = fik * (f7*rc7 + f6*rc6 + f5*rc5 + f4*rc4 + & + f3*rc3 + f2*rc2 + f1*rc + f0) + e = e*taper + trans + end if +c +c scale the interaction based on its group membership +c + if (use_group) e = e * fgrp +c +c increment the overall charge-charge energy component +c + if (i .eq. k) e = 0.5d0 * e + ec = ec - e + end if + end do + end if + end do +c +c reset interaction scaling coefficients for connected atoms +c +cqmmm + do j = ii, nion + cscale(iion(j)) = 1.0d0 + end do + do j = 1, n12(in) + cscale(i12(j,in)) = 1.0d0 + end do + do j = 1, n13(in) + cscale(i13(j,in)) = 1.0d0 + end do + do j = 1, n14(in) + cscale(i14(j,in)) = 1.0d0 + end do + do j = 1, n15(in) + cscale(i15(j,in)) = 1.0d0 + end do +cqmmm + 99 continue + end do +c +c perform deallocation of some local arrays +c + deallocate (cscale) + return + end + diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/echgdpl1.f 6.3.3/source/echgdpl1.f --- 6.3.3/source_orig/echgdpl1.f 2015-04-14 13:58:10.102343729 +0200 +++ 6.3.3/source/echgdpl1.f 2015-04-15 13:48:53.516041220 +0200 @@ -58,6 +58,9 @@ real*8 vyx,vzx,vzy logical proceed character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm c c c zero out the overall charge-dipole interaction energy @@ -99,6 +102,8 @@ yi = y(i1) zi = z(i1) fi = f * pchg(i) +cqmmm + iqmmm = mod(qmmm(i),3) c c decide whether to compute the current interaction c @@ -110,6 +115,8 @@ if (proceed) proceed = (use(i1) .or. use(k1) .or. use(k2)) if (proceed) proceed = (skip(k1).ne.i1 .and. & skip(k2).ne.i1) +cqmmm + if (proceed) proceed = (iqmmm .le. e4qmmm) c c compute the energy contribution for this interaction c @@ -253,6 +260,8 @@ yi = y(i1) zi = z(i1) fi = f * pchg(i) +cqmmm + iqmmm = mod(qmmm(i),3) c c decide whether to compute the current interaction c @@ -262,6 +271,8 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i1,k1,k2,0,0,0) if (proceed) proceed = (use(i1) .or. use(k1) .or. use(k2)) +cqmmm + if (proceed) proceed = (iqmmm .le. e4qmmm) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/echgdpl2.f 6.3.3/source/echgdpl2.f --- 6.3.3/source_orig/echgdpl2.f 2015-04-14 13:58:10.102343729 +0200 +++ 6.3.3/source/echgdpl2.f 2015-04-15 13:48:53.520041220 +0200 @@ -78,6 +78,9 @@ real*8 d2taperxz,d2taperyz logical proceed character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm c c c check for the presence of both charges and dipoles @@ -115,6 +118,8 @@ yi = y(i1) zi = z(i1) fi = f * pchg(ii) +cqmmm + iqmmm = mod(qmmm(i),3) c c decide whether to compute the current interaction c @@ -125,6 +130,8 @@ if (use_group) call groups (proceed,fgrp,i1,k1,k2,0,0,0) if (proceed) proceed = (skip(k1).ne.i1 .and. & skip(k2).ne.i1) +cqmmm + if (proceed) proceed = (iqmmm .le. e4qmmm) c c compute the energy contribution for this interaction c @@ -384,6 +391,9 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i1,k1,k2,0,0,0) if (proceed) proceed = (omit(i1) .ne. k) +cqmmm + iqmmm = mod(qmmm(i1),3) + if (proceed) proceed = (iqmmm .le. e4qmmm) c c compute the energy contribution for this interaction c @@ -774,6 +784,8 @@ yi = y(i1) zi = z(i1) fi = f * pchg(ii) +cqmmm + iqmmm = mod(qmmm(i),3) c c decide whether to compute the current interaction c @@ -782,6 +794,8 @@ k2 = idpl(2,k) proceed = .true. if (use_group) call groups (proceed,fgrp,i1,k1,k2,0,0,0) +cqmmm + if (proceed) proceed = (iqmmm .le. e4qmmm) c c compute the energy contribution for this interaction c @@ -1048,6 +1062,9 @@ i1 = iion(ii) proceed = .true. if (use_group) call groups (proceed,fgrp,i1,k1,k2,0,0,0) +cqmmm + iqmmm = mod(qmmm(i1),3) + if (proceed) proceed = (iqmmm .le. e4qmmm) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/echgdpl3.f 6.3.3/source/echgdpl3.f --- 6.3.3/source_orig/echgdpl3.f 2015-04-14 13:58:10.102343729 +0200 +++ 6.3.3/source/echgdpl3.f 2015-04-15 13:48:53.520041220 +0200 @@ -51,6 +51,9 @@ logical proceed logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm c c c zero out the overall charge-dipole interaction energy @@ -92,6 +95,8 @@ yi = y(i1) zi = z(i1) fi = f * pchg(i) +cqmmm + iqmmm = mod(qmmm(i),3) c c decide whether to compute the current interaction c @@ -103,6 +108,8 @@ if (proceed) proceed = (use(i1) .or. use(k1) .or. use(k2)) if (proceed) proceed = (skip(k1).ne.i1 .and. & skip(k2).ne.i1) +cqmmm + if (proceed) proceed = (iqmmm .le. e4qmmm) c c compute the energy contribution for this interaction c @@ -191,6 +198,8 @@ yi = y(i1) zi = z(i1) fi = f * pchg(i) +cqmmm + iqmmm = mod(qmmm(i),3) c c decide whether to compute the current interaction c @@ -200,6 +209,8 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i1,k1,k2,0,0,0) if (proceed) proceed = (use(i1) .or. use(k1) .or. use(k2)) +cqmmm + if (proceed) proceed = (iqmmm .le. e4qmmm) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/echgdpl.f 6.3.3/source/echgdpl.f --- 6.3.3/source_orig/echgdpl.f 2015-04-14 13:58:10.102343729 +0200 +++ 6.3.3/source/echgdpl.f 2015-04-15 13:48:53.524041220 +0200 @@ -42,6 +42,9 @@ real*8 r,r2,r3,r4,r5 logical proceed character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm c c c zero out the overall charge-dipole interaction energy @@ -77,6 +80,8 @@ yi = y(i1) zi = z(i1) fi = f * pchg(i) +cqmmm + iqmmm = mod(qmmm(i),3) c c decide whether to compute the current interaction c @@ -88,6 +93,8 @@ if (proceed) proceed = (use(i1) .or. use(k1) .or. use(k2)) if (proceed) proceed = (skip(k1).ne.i1 .and. & skip(k2).ne.i1) +cqmmm + if (proceed) proceed = (iqmmm .le. e4qmmm) c c compute the energy contribution for this interaction c @@ -148,6 +155,8 @@ yi = y(i1) zi = z(i1) fi = f * pchg(i) +cqmmm + iqmmm = mod(qmmm(i),3) c c decide whether to compute the current interaction c @@ -157,6 +166,8 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i1,k1,k2,0,0,0) if (proceed) proceed = (use(i1) .or. use(k1) .or. use(k2)) +cqmmm + if (proceed) proceed = (iqmmm .le. e4qmmm) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/egauss1.f 6.3.3/source/egauss1.f --- 6.3.3/source_orig/egauss1.f 2015-04-14 13:58:10.102343729 +0200 +++ 6.3.3/source/egauss1.f 2015-04-15 13:48:53.528041220 +0200 @@ -94,6 +94,9 @@ real*8, allocatable :: vscale(:) logical proceed,usei character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and first derivatives @@ -149,6 +152,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -174,6 +180,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -329,6 +339,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -354,6 +367,9 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (kqmmm .ne. 1) c c compute the energy contribution for this interaction c @@ -574,6 +590,9 @@ logical proceed,usei logical prime,repeat character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and first derivatives @@ -644,6 +663,9 @@ yi = ysort(rgy(ii)) zi = zsort(rgz(ii)) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -696,6 +718,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -924,6 +950,9 @@ real*8, allocatable :: vscale(:) logical proceed,usei character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and first derivatives @@ -979,6 +1008,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -1004,6 +1036,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -1208,6 +1244,9 @@ real*8, allocatable :: vscale(:) logical proceed,usei external erf +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and first derivatives @@ -1269,6 +1308,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -1294,6 +1336,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/egauss2.f 6.3.3/source/egauss2.f --- 6.3.3/source_orig/egauss2.f 2015-04-14 13:58:10.102343729 +0200 +++ 6.3.3/source/egauss2.f 2015-04-15 13:48:53.528041220 +0200 @@ -88,6 +88,9 @@ real*8 term(3,3) logical proceed character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c perform dynamic allocation of some local arrays @@ -149,6 +152,8 @@ xi = xred(i) yi = yred(i) zi = zred(i) +cqmmm + iqmmm = qmmm(i) c c set interaction scaling coefficients for connected atoms c @@ -174,6 +179,11 @@ proceed = (k .ne. i) if (proceed .and. use_group) & call groups (proceed,fgrp,i,k,0,0,0,0) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (iqmmm .ne. 1 .and. kqmmm .ne. 1 + & .and. ikqmmm .ne. 4) c c compute the Hessian elements for this interaction c @@ -368,6 +378,8 @@ xi = xred(i) yi = yred(i) zi = zred(i) +cqmmm + iqmmm = qmmm(i) c c set interaction scaling coefficients for connected atoms c @@ -392,6 +404,9 @@ kv = ired(k) proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (iqmmm .ne. 1 .and. kqmmm .ne. 1) c c compute the Hessian elements for this interaction c @@ -652,6 +667,9 @@ real*8, allocatable :: vscale(:) real*8 term(3,3) logical proceed +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c perform dynamic allocation of some local arrays @@ -719,6 +737,8 @@ xi = xred(i) yi = yred(i) zi = zred(i) +cqmmm + iqmmm = qmmm(i) c c set interaction scaling coefficients for connected atoms c @@ -744,6 +764,11 @@ proceed = (k .ne. i) if (proceed .and. use_group) & call groups (proceed,fgrp,i,k,0,0,0,0) +cqmmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (iqmmm .ne. 1 .and. kqmmm .ne. 1 + & .and. ikqmmm .ne. 4) c c compute the Hessian elements for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/egauss3.f 6.3.3/source/egauss3.f --- 6.3.3/source_orig/egauss3.f 2015-04-14 13:58:10.102343729 +0200 +++ 6.3.3/source/egauss3.f 2015-04-15 13:48:53.532041220 +0200 @@ -90,6 +90,9 @@ logical proceed,usei logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and partitioning terms @@ -143,6 +146,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -168,6 +174,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -283,6 +293,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -308,6 +321,9 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (kqmmm .ne. 1) c c compute the energy contribution for this interaction c @@ -492,6 +508,9 @@ logical prime,repeat logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and partitioning terms @@ -560,6 +579,9 @@ yi = ysort(rgy(ii)) zi = zsort(rgz(ii)) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -612,6 +634,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -811,6 +837,9 @@ logical proceed,usei logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and partitioning terms @@ -864,6 +893,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -889,6 +921,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -1052,6 +1088,9 @@ logical proceed,usei logical header,huge external erf +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and partitioning terms @@ -1111,6 +1150,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) do j = ii+1, nvdw vscale(ivdw(j)) = 1.0d0 end do @@ -1137,6 +1179,10 @@ if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) if (proceed) proceed = (vscale(k) .ne. 0.0d0) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/egauss.f 6.3.3/source/egauss.f --- 6.3.3/source_orig/egauss.f 2015-04-14 13:58:10.102343729 +0200 +++ 6.3.3/source/egauss.f 2015-04-15 13:48:53.532041220 +0200 @@ -81,6 +81,9 @@ real*8, allocatable :: vscale(:) logical proceed,usei character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy contribution @@ -129,6 +132,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -154,6 +160,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -240,6 +250,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -265,6 +278,9 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (kqmmm .ne. 1) c c compute the energy contribution for this interaction c @@ -407,6 +423,9 @@ logical proceed,usei logical prime,repeat character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy contribution @@ -470,6 +489,9 @@ yi = ysort(rgy(ii)) zi = zsort(rgz(ii)) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -522,6 +544,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -672,6 +698,9 @@ real*8, allocatable :: vscale(:) logical proceed,usei character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy contribution @@ -720,6 +749,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -745,6 +777,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -870,6 +906,9 @@ real*8, allocatable :: vscale(:) logical proceed,usei external erf +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy contribution @@ -924,6 +963,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -949,6 +991,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/ehal1.f 6.3.3/source/ehal1.f --- 6.3.3/source_orig/ehal1.f 2015-04-14 13:58:10.106343730 +0200 +++ 6.3.3/source/ehal1.f 2015-04-15 13:48:53.536041220 +0200 @@ -108,6 +108,9 @@ logical proceed,usei logical muti,mutk character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and first derivatives @@ -163,6 +166,9 @@ zi = zred(i) usei = (use(i) .or. use(iv)) muti = mut(i) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -189,6 +195,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -361,6 +371,9 @@ zi = zred(i) usei = (use(i) .or. use(iv)) muti = mut(i) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -387,6 +400,9 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (kqmmm .ne. 1) c c compute the energy contribution for this interaction c @@ -628,6 +644,9 @@ logical muti,mutk logical prime,repeat character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and first derivatives @@ -698,6 +717,9 @@ zi = zsort(rgz(ii)) usei = (use(i) .or. use(iv)) muti = mut(i) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -751,6 +773,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -1003,6 +1029,9 @@ logical proceed,usei logical muti,mutk character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and first derivatives @@ -1084,6 +1113,9 @@ zi = zred(i) usei = (use(i) .or. use(iv)) muti = mut(i) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -1110,6 +1142,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/ehal2.f 6.3.3/source/ehal2.f --- 6.3.3/source_orig/ehal2.f 2015-04-14 13:58:10.106343730 +0200 +++ 6.3.3/source/ehal2.f 2015-04-15 13:48:53.540041220 +0200 @@ -58,6 +58,9 @@ real*8, allocatable :: vscale(:) logical proceed character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c perform dynamic allocation of some local arrays @@ -118,6 +121,8 @@ xi = xred(i) yi = yred(i) zi = zred(i) +cqmmm + iqmmm = qmmm(i) c c set interaction scaling coefficients for connected atoms c @@ -143,6 +148,11 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (k .ne. i) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (iqmmm .ne. 1 .and. kqmmm .ne. 1 + & .and. ikqmmm .ne. 4) c c compute the Hessian elements for this interaction c @@ -351,6 +361,8 @@ xi = xred(i) yi = yred(i) zi = zred(i) +cqmmm + iqmmm = qmmm(i) c c set interaction scaling coefficients for connected atoms c @@ -375,6 +387,9 @@ kv = ired(k) proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (iqmmm .ne. 1 .and. kqmmm .ne. 1) c c compute the Hessian elements for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/ehal3.f 6.3.3/source/ehal3.f --- 6.3.3/source_orig/ehal3.f 2015-04-14 13:58:10.106343730 +0200 +++ 6.3.3/source/ehal3.f 2015-04-15 13:48:53.540041220 +0200 @@ -111,6 +111,9 @@ logical muti,mutk logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and partitioning terms @@ -164,6 +167,9 @@ zi = zred(i) usei = (use(i) .or. use(iv)) muti = mut(i) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -190,6 +196,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -318,6 +328,9 @@ zi = zred(i) usei = (use(i) .or. use(iv)) muti = mut(i) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -344,6 +357,9 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (kqmmm .ne. 1) c c compute the energy contribution for this interaction c @@ -538,6 +554,9 @@ logical prime,repeat logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and partitioning terms @@ -606,6 +625,9 @@ zi = zsort(rgz(ii)) usei = (use(i) .or. use(iv)) muti = mut(i) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -659,6 +681,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -870,6 +896,9 @@ logical muti,mutk logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and partitioning terms @@ -945,6 +974,9 @@ zi = zred(i) usei = (use(i) .or. use(iv)) muti = mut(i) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -971,6 +1003,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/ehal.f 6.3.3/source/ehal.f --- 6.3.3/source_orig/ehal.f 2015-04-14 13:58:10.106343730 +0200 +++ 6.3.3/source/ehal.f 2015-04-15 13:48:53.540041220 +0200 @@ -88,6 +88,9 @@ logical proceed,usei logical muti,mutk character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy contribution @@ -136,6 +139,9 @@ zi = zred(i) usei = (use(i) .or. use(iv)) muti = mut(i) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -162,6 +168,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -257,6 +267,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -283,6 +296,9 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (kqmmm .ne. 1) c c compute the energy contribution for this interaction c @@ -435,6 +451,9 @@ logical muti,mutk logical prime,repeat character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy contribution @@ -498,6 +517,9 @@ zi = zsort(rgz(ii)) usei = (use(i) .or. use(iv)) muti = mut(i) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -551,6 +573,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -711,6 +737,9 @@ logical proceed,usei logical muti,mutk character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy contribution @@ -773,6 +802,9 @@ zi = zred(i) usei = (use(i) .or. use(iv)) muti = mut(i) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -799,6 +831,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/elecpot.f 6.3.3/source/elecpot.f --- 6.3.3/source_orig/elecpot.f 1970-01-01 01:00:00.000000000 +0100 +++ 6.3.3/source/elecpot.f 2015-04-15 13:48:53.548041221 +0200 @@ -0,0 +1,858 @@ +cqmmm +c "elecpot" calculates the electrostatic potential (in e/A), +c field (in e/A^2) and field derivatives (in e/A^3) +c on site i (either HLA, QM or Y) due to all MM point charges +c + subroutine elecpot (i,nComp,QMMM_EP) + implicit none + include 'sizes.i' + include 'cutoff.i' + include 'warp.i' + integer i, nComp + real*8 QMMM_EP(nComp) +c +c +c choose the method for summing over pairwise interactions +c + if (use_smooth) then + call elecpotc (i,nComp,QMMM_EP) + else if (use_ewald) then + call elecpotb (i,nComp,QMMM_EP) + else + call elecpota (i,nComp,QMMM_EP) + end if + return + end +c +c +c "elecpota" calculates elecpot using a pairwise double loop +c +c + subroutine elecpota (i,nComp,QMMM_EP) + implicit none + include 'sizes.i' + include 'atoms.i' + include 'bound.i' + include 'cell.i' + include 'charge.i' + include 'chgpot.i' + include 'couple.i' + include 'group.i' + include 'hessn.i' + include 'shunt.i' + integer i,j,k,kk + integer in,kn,jcell + real*8 e,de,d2e + real*8 fi,fik,fgrp + real*8 d2edx,d2edy,d2edz + real*8 xi,yi,zi + real*8 xr,yr,zr + real*8 shift,taper,trans + real*8 dtaper,dtrans + real*8 d2taper,d2trans + real*8 r,rb,rb2 + real*8 r2,r3,r4 + real*8 r5,r6,r7 + real*8 term(3,3) + real*8, allocatable :: cscale(:) + logical proceed + character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,nComp + real*8 QMMM_EP(nComp) +c +c +c initialization +c + do k = 1, nComp + QMMM_EP(k) = 0.0d0 + end do + fi = 1.0d0 / dielec +c +c place a charge +1 at i +c + in = i + do k = 1, nion + if (iion(k) .eq. i) then + in = jion(k) + goto 10 + end if + end do + 10 continue +c +c store the coordinates of the atom of interest +c + xi = x(i) + yi = y(i) + zi = z(i) +c +c perform dynamic allocation of some local arrays +c + allocate (cscale(n)) +c +c set array needed to scale connected atom interactions +c + do j = 1, nion + cscale(iion(j)) = 1.0d0 + end do + do j = 1, n12(in) + cscale(i12(j,in)) = c2scale + end do + do j = 1, n13(in) + cscale(i13(j,in)) = c3scale + end do + do j = 1, n14(in) + cscale(i14(j,in)) = c4scale + end do + do j = 1, n15(in) + cscale(i15(j,in)) = c5scale + end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = qmmm(i) + do j = 1, nion + if (.not. doespf) then + cscale(iion(j)) = 1.0d0 +cnf-begin +cnf +cnf At the moment, the use of 1-4 conditions for generating the external potential +cnf leads to unphysical results. Switch to the old scheme for which the close +cnv charges need to be set to 0. +cnf + else + cscale(iion(j)) = 1.0d0 + end if +cnf-end + cscale(iion(j)) = cscale(iion(j)) * qmmmscale + end do +c +c set cutoff distances and switching function coefficients +c + mode = 'CHARGE' + call switch (mode) +c +c calculate the charge interaction elements +c + do kk = 1, nion + k = iion(kk) + kn = jion(kk) + proceed = .true. + if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) + if (proceed) proceed = (kn .ne. i) +cqmmm + kqmmm = mod(qmmm(k),3) + if (proceed) proceed = (kqmmm .eq. 0) +c +c compute the energy contribution for this interaction +c + if (proceed) then + xr = xi - x(k) + yr = yi - y(k) + zr = zi - z(k) + if (use_bounds) call image (xr,yr,zr) + r2 = xr*xr + yr*yr + zr*zr + if (r2 .le. off2) then + r = sqrt(r2) + rb = r + ebuffer + rb2 = rb * rb + fik = fi * pchg(kk) * cscale(kn) + e = fik / rb + de = -fik / rb2 + d2e = -2.0d0 * de/rb +c +c use shifted energy switching if near the cutoff distance +c + shift = fik / (0.5d0*(off+cut)) + e = e - shift + if (r2 .gt. cut2) then + r3 = r2 * r + r4 = r2 * r2 + r5 = r2 * r3 + r6 = r3 * r3 + r7 = r3 * r4 + taper = c5*r5 + c4*r4 + c3*r3 + c2*r2 + c1*r + c0 + dtaper = 5.0d0*c5*r4 + 4.0d0*c4*r3 + & + 3.0d0*c3*r2 + 2.0d0*c2*r + c1 + d2taper = 20.0d0*c5*r3 + 12.0d0*c4*r2 + & + 6.0d0*c3*r + 2.0d0*c2 + trans = fik * (f7*r7 + f6*r6 + f5*r5 + f4*r4 + & + f3*r3 + f2*r2 + f1*r + f0) + dtrans = fik * (7.0d0*f7*r6 + 6.0d0*f6*r5 + & + 5.0d0*f5*r4 + 4.0d0*f4*r3 + & + 3.0d0*f3*r2 + 2.0d0*f2*r + f1) + d2trans = fik * (42.0d0*f7*r5 + 30.0d0*f6*r4 + & + 20.0d0*f5*r3 + 12.0d0*f4*r2 + & + 6.0d0*f3*r + 2.0d0*f2) + d2e = e*d2taper + 2.0d0*de*dtaper + & + d2e*taper + d2trans + de = e*dtaper + de*taper + dtrans + e = e*taper + trans + end if +c +c scale the interaction based on its group membership +c + if (use_group) then + e = e * fgrp + de = de * fgrp + d2e = d2e * fgrp + end if +c +c form the individual Hessian element components +c + de = de / r + d2e = (d2e-de) / r2 + d2edx = d2e * xr + d2edy = d2e * yr + d2edz = d2e * zr + term(1,1) = d2edx*xr + de + term(1,2) = d2edx*yr + term(1,3) = d2edx*zr + term(2,1) = term(1,2) + term(2,2) = d2edy*yr + de + term(2,3) = d2edy*zr + term(3,1) = term(1,3) + term(3,2) = term(2,3) + term(3,3) = d2edz*zr + de +cqmmm +c increment the potential and derivatives +c + QMMM_EP( 1) = QMMM_EP( 1) + e + QMMM_EP( 2) = QMMM_EP( 2) + de * xr + QMMM_EP( 3) = QMMM_EP( 3) + de * yr + QMMM_EP( 4) = QMMM_EP( 4) + de * zr + if (nComp .eq. 10) then + QMMM_EP( 5) = QMMM_EP( 5) + term(1,1) + QMMM_EP( 6) = QMMM_EP( 6) + term(2,2) + QMMM_EP( 7) = QMMM_EP( 7) + term(3,3) + QMMM_EP( 8) = QMMM_EP( 8) + term(1,2) + QMMM_EP( 9) = QMMM_EP( 9) + term(1,3) + QMMM_EP(10) = QMMM_EP(10) + term(2,3) + end if + end if + end if + end do +c +c for periodic boundary conditions with large cutoffs +c neighbors must be found by the replicates method +c + if (.not. use_replica) return +c +c calculate interaction energy with other unit cells +c + do kk = 1, nion + k = iion(kk) + kn = jion(kk) + proceed = .true. + if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) +c +c compute the energy contribution for this interaction +c + if (proceed) then + do jcell = 1, ncell + xr = xi - x(k) + yr = yi - y(k) + zr = zi - z(k) + call imager (xr,yr,zr,jcell) + r2 = xr*xr + yr*yr + zr*zr + if (r2 .le. off2) then + r = sqrt(r2) + rb = r + ebuffer + rb2 = rb * rb + fik = fi * pchg(kk) + if (use_polymer) then + if (r2 .le. polycut2) fik = fik * cscale(kn) + end if + e = fik / r +c +c compute chain rule terms for Hessian matrix elements +c + de = -fik / rb2 + d2e = -2.0d0 * de/rb +c +c use shifted energy switching if near the cutoff distance +c + shift = fik / (0.5d0*(off+cut)) + e = e - shift + if (r2 .gt. cut2) then + r3 = r2 * r + r4 = r2 * r2 + r5 = r2 * r3 + r6 = r3 * r3 + r7 = r3 * r4 + taper = c5*r5 + c4*r4 + c3*r3 + c2*r2 + c1*r + c0 + dtaper = 5.0d0*c5*r4 + 4.0d0*c4*r3 + & + 3.0d0*c3*r2 + 2.0d0*c2*r + c1 + d2taper = 20.0d0*c5*r3 + 12.0d0*c4*r2 + & + 6.0d0*c3*r + 2.0d0*c2 + trans = fik * (f7*r7 + f6*r6 + f5*r5 + f4*r4 + & + f3*r3 + f2*r2 + f1*r + f0) + dtrans = fik * (7.0d0*f7*r6 + 6.0d0*f6*r5 + & + 5.0d0*f5*r4 + 4.0d0*f4*r3 + & + 3.0d0*f3*r2 + 2.0d0*f2*r + f1) + d2trans = fik * (42.0d0*f7*r5 + 30.0d0*f6*r4 + & + 20.0d0*f5*r3 + 12.0d0*f4*r2 + & + 6.0d0*f3*r + 2.0d0*f2) + d2e = e*d2taper + 2.0d0*de*dtaper + & + d2e*taper + d2trans + de = e*dtaper + de*taper + dtrans + e = e*taper + trans + end if +c +c scale the interaction based on its group membership +c + if (use_group) then + e = e * fgrp + de = de * fgrp + d2e = d2e * fgrp + end if +c +c form the individual Hessian element components +c + de = de / r + d2e = (d2e-de) / r2 + d2edx = d2e * xr + d2edy = d2e * yr + d2edz = d2e * zr + term(1,1) = d2edx*xr + de + term(1,2) = d2edx*yr + term(1,3) = d2edx*zr + term(2,1) = term(1,2) + term(2,2) = d2edy*yr + de + term(2,3) = d2edy*zr + term(3,1) = term(1,3) + term(3,2) = term(2,3) + term(3,3) = d2edz*zr + de +cqmmm +c increment the potential and derivatives +c + QMMM_EP( 1) = QMMM_EP( 1) + e + QMMM_EP( 2) = QMMM_EP( 2) + de * xr + QMMM_EP( 3) = QMMM_EP( 3) + de * yr + QMMM_EP( 4) = QMMM_EP( 4) + de * zr + if (nComp .eq. 10) then + QMMM_EP( 5) = QMMM_EP( 5) + term(1,1) + QMMM_EP( 6) = QMMM_EP( 6) + term(2,2) + QMMM_EP( 7) = QMMM_EP( 7) + term(3,3) + QMMM_EP( 8) = QMMM_EP( 8) + term(1,2) + QMMM_EP( 9) = QMMM_EP( 9) + term(1,3) + QMMM_EP(10) = QMMM_EP(10) + term(2,3) + end if + end if + end do + end if + end do +c +c perform deallocation of some local arrays +c + deallocate (cscale) + return + end +c +c +c "elecpotb" calculates elecpot using a particle mesh +c Ewald summation +c + subroutine elecpotb (i,nComp,QMMM_EP) + implicit none + include 'sizes.i' + include 'atoms.i' + include 'bound.i' + include 'cell.i' + include 'charge.i' + include 'chgpot.i' + include 'couple.i' + include 'cutoff.i' + include 'ewald.i' + include 'group.i' + include 'hessn.i' + include 'math.i' + integer i,j,k,kk + integer in,kn,jcell + real*8 fi,fik,fgrp + real*8 r,r2,rb,rb2 + real*8 e,de,d2e + real*8 d2edx,d2edy,d2edz + real*8 xi,yi,zi + real*8 xr,yr,zr + real*8 rew,erfc,cut2 + real*8 erfterm,expterm + real*8 scale,scaleterm + real*8 term(3,3) + real*8, allocatable :: cscale(:) + logical proceed + external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,nComp + real*8 QMMM_EP(nComp) +c +c +c initialization +c + do k = 1, nComp + QMMM_EP(k) = 0.0d0 + end do + fi = 1.0d0 / dielec + cut2 = ewaldcut * ewaldcut +c +c place a charge +1 at i +c + in = i + do k = 1, nion + if (iion(k) .eq. i) then + in = jion(k) + goto 10 + end if + end do + 10 continue +c +c store the coordinates of the atom of interest +c + xi = x(i) + yi = y(i) + zi = z(i) +c +c perform dynamic allocation of some local arrays +c + allocate (cscale(n)) +c +c set array needed to scale connected atom interactions +c + do j = 1, nion + cscale(iion(j)) = 1.0d0 + end do + do j = 1, n12(in) + cscale(i12(j,in)) = c2scale + end do + do j = 1, n13(in) + cscale(i13(j,in)) = c3scale + end do + do j = 1, n14(in) + cscale(i14(j,in)) = c4scale + end do + do j = 1, n15(in) + cscale(i15(j,in)) = c5scale + end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = qmmm(i) + do j = 1, nion + if (.not. doespf) cscale(iion(j)) = 1.0d0 +cnf-begin +cnf +cnf At the moment, the use of 1-4 conditions for generating the external potential +cnf leads to unphysical results. Switch to the old scheme for which the close +cnv charges need to be set to 0. +cnf + cscale(iion(j)) = 1.0d0 +cnf-end + cscale(iion(j)) = cscale(iion(j)) * qmmmscale + end do +c +c calculate the real space Ewald interaction Hessian elements +c + do kk = 1, nion + k = iion(kk) + kn = jion(kk) + if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) + proceed = .true. + if (proceed) proceed = (kn .ne. i) +cqmmm + kqmmm = mod(qmmm(k),3) + if (proceed) proceed = (kqmmm .eq. 0) +c +c compute the energy contribution for this interaction +c + if (proceed) then + xr = xi - x(k) + yr = yi - y(k) + zr = zi - z(k) + call image (xr,yr,zr) + r2 = xr*xr + yr*yr + zr*zr + if (r2 .le. cut2) then + r = sqrt(r2) + rb = r + ebuffer + rb2 = rb * rb + fik = fi * pchg(kk) * cscale(kn) + rew = aewald * r + erfterm = erfc (rew) + expterm = exp(-rew**2) + scale = cscale(kn) + if (use_group) scale = scale * fgrp + scaleterm = scale - 1.0d0 +c +c compute chain rule terms for Hessian matrix elements +c + e = (fik/rb) * (erfterm+scaleterm) + de = -fik * ((erfterm+scaleterm)/rb2 + & + (2.0d0*aewald/sqrtpi)*expterm/r) + d2e = -2.0d0*de/rb + 2.0d0*(fik/(rb*rb2))*scaleterm + & + (4.0d0*fik*aewald**3/sqrtpi)*expterm + & + 2.0d0*(fik/(rb*rb2))*scaleterm +c +c form the individual Hessian element components +c + de = de / r + d2e = (d2e-de) / r2 + d2edx = d2e * xr + d2edy = d2e * yr + d2edz = d2e * zr + term(1,1) = d2edx*xr + de + term(1,2) = d2edx*yr + term(1,3) = d2edx*zr + term(2,1) = term(1,2) + term(2,2) = d2edy*yr + de + term(2,3) = d2edy*zr + term(3,1) = term(1,3) + term(3,2) = term(2,3) + term(3,3) = d2edz*zr + de +cqmmm +c increment the potential and derivatives +c + QMMM_EP( 1) = QMMM_EP( 1) + e + QMMM_EP( 2) = QMMM_EP( 2) + de * xr + QMMM_EP( 3) = QMMM_EP( 3) + de * yr + QMMM_EP( 4) = QMMM_EP( 4) + de * zr + if (nComp .eq. 10) then + QMMM_EP( 5) = QMMM_EP( 5) + term(1,1) + QMMM_EP( 6) = QMMM_EP( 6) + term(2,2) + QMMM_EP( 7) = QMMM_EP( 7) + term(3,3) + QMMM_EP( 8) = QMMM_EP( 8) + term(1,2) + QMMM_EP( 9) = QMMM_EP( 9) + term(1,3) + QMMM_EP(10) = QMMM_EP(10) + term(2,3) + end if + end if + end if + end do +c +c for periodic boundary conditions with large cutoffs +c neighbors must be found by the replicates method +c + if (.not. use_replica) return +c +c calculate interaction energy with other unit cells +c + do kk = 1, nion + k = iion(kk) + kn = jion(kk) + if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) + proceed = .true. +c +c compute the energy contribution for this interaction +c + if (proceed) then + do jcell = 1, ncell + xr = xi - x(k) + yr = yi - y(k) + zr = zi - z(k) + call imager (xr,yr,zr,jcell) + r2 = xr*xr + yr*yr + zr*zr + if (r2 .le. cut2) then + r = sqrt(r2) + rb = r + ebuffer + rb2 = rb * rb + fik = fi * pchg(kk) + rew = aewald * r + erfterm = erfc (rew) + expterm = exp(-rew**2) + scale = 1.0d0 + if (use_group) scale = scale * fgrp + if (use_polymer) then + if (r2 .le. polycut2) then + scale = scale * cscale(kn) + end if + end if + scaleterm = scale - 1.0d0 +c +c compute chain rule terms for Hessian matrix elements +c + e = (fik/rb) * (erfterm+scaleterm) + de = -fik * ((erfterm+scaleterm)/rb2 + & + (2.0d0*aewald/sqrtpi)*exp(-rew**2)/r) + d2e = -2.0d0*de/rb + 2.0d0*(fik/(rb*rb2))*scaleterm + & + (4.0d0*fik*aewald**3/sqrtpi)*expterm + & + 2.0d0*(fik/(rb*rb2))*scaleterm +c +c form the individual Hessian element components +c + de = de / r + d2e = (d2e-de) / r2 + d2edx = d2e * xr + d2edy = d2e * yr + d2edz = d2e * zr + term(1,1) = d2edx*xr + de + term(1,2) = d2edx*yr + term(1,3) = d2edx*zr + term(2,1) = term(1,2) + term(2,2) = d2edy*yr + de + term(2,3) = d2edy*zr + term(3,1) = term(1,3) + term(3,2) = term(2,3) + term(3,3) = d2edz*zr + de +cqmmm +c increment the potential and derivatives +c + QMMM_EP( 1) = QMMM_EP( 1) + e + QMMM_EP( 2) = QMMM_EP( 2) + de * xr + QMMM_EP( 3) = QMMM_EP( 3) + de * yr + QMMM_EP( 4) = QMMM_EP( 4) + de * zr + if (nComp .eq. 10) then + QMMM_EP( 5) = QMMM_EP( 5) + term(1,1) + QMMM_EP( 6) = QMMM_EP( 6) + term(2,2) + QMMM_EP( 7) = QMMM_EP( 7) + term(3,3) + QMMM_EP( 8) = QMMM_EP( 8) + term(1,2) + QMMM_EP( 9) = QMMM_EP( 9) + term(1,3) + QMMM_EP(10) = QMMM_EP(10) + term(2,3) + end if + end if + end do + end if + end do +c +c perform deallocation of some local arrays +c + deallocate (cscale) + return + end +c +c +c "elecpotc" calculates elecpot for use with potential +c smoothing methods +c +c + subroutine elecpotc (i,nComp,QMMM_EP) + implicit none + include 'sizes.i' + include 'atoms.i' + include 'charge.i' + include 'chgpot.i' + include 'couple.i' + include 'group.i' + include 'hessn.i' + include 'math.i' + include 'warp.i' + integer i,j,k,kk + integer in,kn + real*8 fi,fik,fgrp + real*8 r,r2,rb,rb2 + real*8 e,de,d2e + real*8 d2edx,d2edy,d2edz + real*8 xi,yi,zi + real*8 xr,yr,zr + real*8 erf,erfterm + real*8 expcut,expterm + real*8 wterm,width + real*8 width2,width3 + real*8 term(3,3) + real*8, allocatable :: cscale(:) + logical proceed + external erf +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,nComp + real*8 QMMM_EP(nComp) +c +c +c initialization +c + do k = 1, nComp + QMMM_EP(k) = 0.0d0 + end do + fi = 1.0d0 / dielec +c +c place a charge +1 at i +c + in = i + do k = 1, nion + if (iion(k) .eq. i) then + in = jion(k) + goto 10 + end if + end do + return + 10 continue +c +c store the coordinates of the atom of interest +c + xi = x(i) + yi = y(i) + zi = z(i) +c +c perform dynamic allocation of some local arrays +c + allocate (cscale(n)) +c +c set array needed to scale connected atom interactions +c + do j = 1, nion + cscale(iion(j)) = 1.0d0 + end do + do j = 1, n12(in) + cscale(i12(j,in)) = c2scale + end do + do j = 1, n13(in) + cscale(i13(j,in)) = c3scale + end do + do j = 1, n14(in) + cscale(i14(j,in)) = c4scale + end do + do j = 1, n15(in) + cscale(i15(j,in)) = c5scale + end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = qmmm(i) + do j = 1, nion + if (.not. doespf) cscale(iion(j)) = 1.0d0 +cnf-begin +cnf +cnf At the moment, the use of 1-4 conditions for generating the external potential +cnf leads to unphysical results. Switch to the old scheme for which the close +cnv charges need to be set to 0. +cnf + cscale(iion(j)) = 1.0d0 +cnf-end + cscale(iion(j)) = cscale(iion(j)) * qmmmscale + end do +c +c set the smallest exponential terms to be calculated +c + expcut = -50.0d0 +c +c set the extent of smoothing to be performed +c + width = deform * diffc + if (use_dem) then + if (width .gt. 0.0d0) width = 0.5d0 / sqrt(width) + else if (use_gda) then + wterm = sqrt(3.0d0/(2.0d0*diffc)) + end if + width2 = width * width + width3 = width * width2 +c +c calculate the charge interaction energy Hessian elements +c + do kk = 1, nion + k = iion(kk) + kn = jion(kk) + proceed = .true. + if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) + if (proceed) proceed = (kn .ne. i) +cqmmm + kqmmm = mod(qmmm(k),3) + if (proceed) proceed = (kqmmm .eq. 0) +c +c compute the energy contribution for this interaction +c + if (proceed) then + xr = xi - x(k) + yr = yi - y(k) + zr = zi - z(k) + r2 = xr*xr + yr*yr + zr*zr + r = sqrt(r2) + rb = r + ebuffer + rb2 = rb * rb + fik = fi * pchg(kk) * cscale(kn) +c +c compute chain rule terms for Hessian matrix elements +c + e = fik / rb + de = -fik / rb2 + d2e = -2.0d0 * de/rb +c +c transform the potential function via smoothing +c + if (use_dem) then + if (width .gt. 0.0d0) then + erfterm = erf(width*rb) + expterm = -rb2 * width2 + if (expterm .gt. expcut) then + expterm = 2.0d0*fik*width*exp(expterm) + & / (sqrtpi*rb) + else + expterm = 0.0d0 + end if + e = e * erfterm + de = de*erfterm + expterm + d2e = -2.0d0 * (de/rb + expterm*rb*width2) + end if + else if (use_gda) then + width = m2(i) + m2(k) + if (width .gt. 0.0d0) then + width = wterm / sqrt(width) + width2 = width * width + erfterm = erf(width*rb) + expterm = -rb2 * width2 + if (expterm .gt. expcut) then + expterm = 2.0d0*fik*width*exp(expterm) + & / (sqrtpi*rb) + else + expterm = 0.0d0 + end if + e = e * erfterm + de = de*erfterm + expterm + d2e = -2.0d0 * (de/rb + expterm*r*width2) + end if + else if (use_tophat) then + if (width .gt. rb) then + e = fik * (3.0d0*width2-rb2) / (2.0d0*width3) + d2e = -fik / width3 + de = d2e * rb + end if + else if (use_stophat) then + wterm = rb + width + e = fik / wterm + de = -fik / (wterm*wterm) + d2e = -2.0d0 * de / wterm + end if +c +c scale the interaction based on its group membership +c + if (use_group) then + de = de * fgrp + d2e = d2e * fgrp + end if +c +c form the individual Hessian element components +c + de = de / r + d2e = (d2e-de) / r2 + d2edx = d2e * xr + d2edy = d2e * yr + d2edz = d2e * zr + term(1,1) = d2edx*xr + de + term(1,2) = d2edx*yr + term(1,3) = d2edx*zr + term(2,1) = term(1,2) + term(2,2) = d2edy*yr + de + term(2,3) = d2edy*zr + term(3,1) = term(1,3) + term(3,2) = term(2,3) + term(3,3) = d2edz*zr + de +cqmmm +c increment the potential and derivatives +c + QMMM_EP( 1) = QMMM_EP( 1) + e + QMMM_EP( 2) = QMMM_EP( 2) + de * xr + QMMM_EP( 3) = QMMM_EP( 3) + de * yr + QMMM_EP( 4) = QMMM_EP( 4) + de * zr + if (nComp .eq. 10) then + QMMM_EP( 5) = QMMM_EP( 5) + term(1,1) + QMMM_EP( 6) = QMMM_EP( 6) + term(2,2) + QMMM_EP( 7) = QMMM_EP( 7) + term(3,3) + QMMM_EP( 8) = QMMM_EP( 8) + term(1,2) + QMMM_EP( 9) = QMMM_EP( 9) + term(1,3) + QMMM_EP(10) = QMMM_EP(10) + term(2,3) + end if + end if + end do +c +c perform deallocation of some local arrays +c + deallocate (cscale) + return + end diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/elj1.f 6.3.3/source/elj1.f --- 6.3.3/source_orig/elj1.f 2015-04-14 13:58:10.106343730 +0200 +++ 6.3.3/source/elj1.f 2015-04-15 13:48:53.552041221 +0200 @@ -105,6 +105,9 @@ real*8, allocatable :: vscale(:) logical proceed,usei character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and first derivatives @@ -159,6 +162,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -184,6 +190,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -329,6 +339,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -354,6 +367,9 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (kqmmm .ne. 1) c c compute the energy contribution for this interaction c @@ -559,6 +575,9 @@ logical proceed,usei logical prime,repeat character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and first derivatives @@ -628,6 +647,9 @@ yi = ysort(rgy(ii)) zi = zsort(rgz(ii)) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -680,6 +702,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -897,6 +923,9 @@ real*8, allocatable :: devt(:,:) logical proceed,usei character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and first derivatives @@ -977,6 +1006,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -1002,6 +1034,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -1245,6 +1281,9 @@ real*8, allocatable :: zred(:) real*8, allocatable :: vscale(:) logical proceed,usei +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and first derivatives @@ -1304,6 +1343,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -1329,6 +1371,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/elj2.f 6.3.3/source/elj2.f --- 6.3.3/source_orig/elj2.f 2015-04-14 13:58:10.106343730 +0200 +++ 6.3.3/source/elj2.f 2015-04-15 13:48:53.552041221 +0200 @@ -91,6 +91,9 @@ real*8, allocatable :: vscale(:) logical proceed character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c perform dynamic allocation of some local arrays @@ -151,6 +154,8 @@ xi = xred(i) yi = yred(i) zi = zred(i) +cqmmm + iqmmm = qmmm(i) c c set interaction scaling coefficients for connected atoms c @@ -176,6 +181,11 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (k .ne. i) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (iqmmm .ne. 1 .and. kqmmm .ne. 1 + & .and. ikqmmm .ne. 4) c c compute the Hessian elements for this interaction c @@ -377,6 +387,8 @@ xi = xred(i) yi = yred(i) zi = zred(i) +cqmmm + iqmmm = qmmm(i) c c set interaction scaling coefficients for connected atoms c @@ -401,6 +413,9 @@ kv = ired(k) proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (iqmmm .ne. 1 .and. kqmmm .ne. 1) c c compute the Hessian elements for this interaction c @@ -707,6 +722,9 @@ real*8 zred(*) real*8, allocatable :: vscale(:) logical proceed +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c perform dynamic allocation of some local arrays @@ -773,6 +791,8 @@ xi = xred(i) yi = yred(i) zi = zred(i) +cqmmm + iqmmm = qmmm(i) c c set interaction scaling coefficients for connected atoms c @@ -798,6 +818,11 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (k .ne. i) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (iqmmm .ne. 1 .and. kqmmm. ne. 1 + & .and. ikqmmm .ne. 4) c c compute the Hessian elements for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/elj3.f 6.3.3/source/elj3.f --- 6.3.3/source_orig/elj3.f 2015-04-14 13:58:10.106343730 +0200 +++ 6.3.3/source/elj3.f 2015-04-15 13:48:53.556041221 +0200 @@ -112,6 +112,9 @@ logical proceed,usei logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and partitioning terms @@ -164,6 +167,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -189,6 +195,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -299,6 +309,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -324,6 +337,9 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (kqmmm .ne. 1) c c compute the energy contribution for this interaction c @@ -497,6 +513,9 @@ logical prime,repeat logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and partitioning terms @@ -564,6 +583,9 @@ yi = ysort(rgy(ii)) zi = zsort(rgz(ii)) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -616,6 +638,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -807,6 +833,9 @@ logical proceed,usei logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and partitioning terms @@ -879,6 +908,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -904,6 +936,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -1107,6 +1143,9 @@ real*8, allocatable :: vscale(:) logical proceed,usei logical header,huge +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and partitioning terms @@ -1155,6 +1194,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -1180,6 +1222,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/elj.f 6.3.3/source/elj.f --- 6.3.3/source_orig/elj.f 2015-04-14 13:58:10.106343730 +0200 +++ 6.3.3/source/elj.f 2015-04-15 13:48:53.556041221 +0200 @@ -90,6 +90,9 @@ real*8, allocatable :: vscale(:) logical proceed,usei character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy contribution @@ -137,6 +140,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -162,6 +168,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -241,6 +251,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -266,6 +279,9 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (kqmmm .ne. 1) c c compute the energy contribution for this interaction c @@ -398,6 +414,9 @@ logical proceed,usei logical prime,repeat character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy contribution @@ -460,6 +479,9 @@ yi = ysort(rgy(ii)) zi = zsort(rgz(ii)) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -512,6 +534,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -653,6 +679,9 @@ real*8, allocatable :: vscale(:) logical proceed,usei character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy contribution @@ -714,6 +743,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -739,6 +771,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -895,6 +931,9 @@ real*8, allocatable :: zred(:) real*8, allocatable :: vscale(:) logical proceed,usei +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy contribution @@ -946,6 +985,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -971,6 +1013,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/emm3hb1.f 6.3.3/source/emm3hb1.f --- 6.3.3/source_orig/emm3hb1.f 2015-04-14 13:58:10.106343730 +0200 +++ 6.3.3/source/emm3hb1.f 2015-04-15 13:48:53.560041221 +0200 @@ -133,6 +133,9 @@ real*8, allocatable :: vscale(:) logical proceed,usei,use_hb character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and first derivatives @@ -195,6 +198,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -220,6 +226,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -473,6 +483,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -498,6 +511,9 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (kqmmm .ne. 1) c c compute the energy contribution for this interaction c @@ -838,6 +854,9 @@ logical prime,repeat logical use_hb character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and first derivatives @@ -915,6 +934,9 @@ yi = ysort(rgy(ii)) zi = zsort(rgz(ii)) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -968,6 +990,10 @@ if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) if (proceed) proceed = (vscale(k) .ne. 0.0d0) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -1326,6 +1352,9 @@ real*8, allocatable :: vscale(:) logical proceed,usei,use_hb character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and first derivatives @@ -1388,6 +1417,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -1413,6 +1445,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/emm3hb2.f 6.3.3/source/emm3hb2.f --- 6.3.3/source_orig/emm3hb2.f 2015-04-14 13:58:10.106343730 +0200 +++ 6.3.3/source/emm3hb2.f 2015-04-15 13:48:53.564041221 +0200 @@ -88,6 +88,9 @@ real*8, allocatable :: vscale(:) logical proceed character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c perform dynamic allocation of some local arrays @@ -156,6 +159,8 @@ xi = xred(i) yi = yred(i) zi = zred(i) +cqmmm + iqmmm = qmmm(i) c c set interaction scaling coefficients for connected atoms c @@ -181,6 +186,11 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (k .ne. i) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (iqmmm .ne. 1 .and. kqmmm .ne. 1 + & .and. ikqmmm .ne. 4) c c compute the Hessian elements for this interaction c @@ -441,6 +451,8 @@ xi = xred(i) yi = yred(i) zi = zred(i) +cqmmm + iqmmm = qmmm(i) c c set interaction scaling coefficients for connected atoms c @@ -465,6 +477,9 @@ kv = ired(k) proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (iqmmm .ne. 1 .and. kqmmm .ne. 1) c c compute the Hessian elements for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/emm3hb3.f 6.3.3/source/emm3hb3.f --- 6.3.3/source_orig/emm3hb3.f 2015-04-14 13:58:10.106343730 +0200 +++ 6.3.3/source/emm3hb3.f 2015-04-15 13:48:53.564041221 +0200 @@ -134,6 +134,9 @@ logical proceed,usei logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and partitioning terms @@ -194,6 +197,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -219,6 +225,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -375,6 +385,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -400,6 +413,9 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (kqmmm .ne. 1) c c compute the energy contribution for this interaction c @@ -637,6 +653,9 @@ logical prime,repeat logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and partitioning terms @@ -712,6 +731,9 @@ yi = ysort(rgy(ii)) zi = zsort(rgz(ii)) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -764,6 +786,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -1027,6 +1053,9 @@ logical proceed,usei logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy and partitioning terms @@ -1087,6 +1116,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -1112,6 +1144,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/emm3hb.f 6.3.3/source/emm3hb.f --- 6.3.3/source_orig/emm3hb.f 2015-04-14 13:58:10.106343730 +0200 +++ 6.3.3/source/emm3hb.f 2015-04-15 13:48:53.568041221 +0200 @@ -112,6 +112,9 @@ real*8, allocatable :: vscale(:) logical proceed,usei character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy contribution @@ -167,6 +170,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -192,6 +198,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -317,6 +327,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -342,6 +355,9 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + if (proceed) proceed = (kqmmm .ne. 1) c c compute the energy contribution for this interaction c @@ -539,6 +555,9 @@ logical proceed,usei logical prime,repeat character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy contribution @@ -609,6 +628,9 @@ yi = ysort(rgy(ii)) zi = zsort(rgz(ii)) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -661,6 +683,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c @@ -877,6 +903,9 @@ real*8, allocatable :: vscale(:) logical proceed,usei character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the van der Waals energy contribution @@ -932,6 +961,9 @@ yi = yred(i) zi = zred(i) usei = (use(i) .or. use(iv)) +cqmmm + iqmmm = qmmm(i) + if (usei) usei = (iqmmm .ne. 1) c c set interaction scaling coefficients for connected atoms c @@ -957,6 +989,10 @@ proceed = .true. if (use_group) call groups (proceed,fgrp,i,k,0,0,0,0) if (proceed) proceed = (usei .or. use(k) .or. use(kv)) +cqmmm + kqmmm = qmmm(k) + ikqmmm = iqmmm + kqmmm + if (proceed) proceed = (kqmmm .ne. 1 .and. ikqmmm .ne. 4) c c compute the energy contribution for this interaction c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/empole1.f 6.3.3/source/empole1.f --- 6.3.3/source_orig/empole1.f 2015-04-14 13:58:10.106343730 +0200 +++ 6.3.3/source/empole1.f 2015-04-15 13:48:53.568041221 +0200 @@ -25,6 +25,8 @@ include 'mpole.i' include 'potent.i' integer i,j,ii +cqmmm + include 'qmmm.i' c c c choose the method for summing over multipole interactions @@ -42,6 +44,8 @@ call empole1a end if end if +cqmmm + if (nbinqm .ne. 0 .and. e4qmmm .eq. 0) call empole1qmmm c c zero out energy and derivative terms which are not in use c @@ -166,6 +170,9 @@ real*8, allocatable :: uscale(:) logical proceed,usei,usek character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out multipole and polarization energy and derivatives @@ -276,6 +283,26 @@ dscale(ip14(j,ii)) = d4scale uscale(ip14(j,ii)) = u4scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = i+1, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + dscale(ipole(j)) = 1.0d0 + uscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(j)) = mscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + dscale(ipole(j)) = dscale(ipole(j)) * qmmmscale + uscale(ipole(j)) = uscale(ipole(j)) * qmmmscale + end if + end do do k = i+1, npole kk = ipole(k) kz = zaxis(k) @@ -845,6 +872,13 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = i+1, npole + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + dscale(ipole(j)) = 1.0d0 + uscale(ipole(j)) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 @@ -942,6 +976,26 @@ dscale(ip14(j,ii)) = d4scale uscale(ip14(j,ii)) = u4scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = i, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + dscale(ipole(j)) = 1.0d0 + uscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(j)) = mscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + uscale(ipole(j)) = dscale(ipole(j)) * qmmmscale + dscale(ipole(j)) = uscale(ipole(j)) * qmmmscale + end if + end do do k = i, npole kk = ipole(k) kz = zaxis(k) @@ -1567,6 +1621,13 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = i, npole + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + dscale(ipole(j)) = 1.0d0 + uscale(ipole(j)) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 @@ -1711,6 +1772,9 @@ real*8, allocatable :: uscale(:) logical proceed,usei,usek character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out multipole and polarization energy and derivatives @@ -1821,6 +1885,30 @@ dscale(ip14(j,ii)) = d4scale uscale(ip14(j,ii)) = u4scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = 1, nelst(i) + jqmmm = mod(qmmm(ipole(elst(j,i))),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(elst(j,i))) = 1.0d0 + pscale(ipole(elst(j,i))) = 1.0d0 + dscale(ipole(elst(j,i))) = 1.0d0 + uscale(ipole(elst(j,i))) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(elst(j,i))) = mscale(ipole(elst(j,i))) + & * qmmmscale + pscale(ipole(elst(j,i))) = pscale(ipole(elst(j,i))) + & * qmmmscale + dscale(ipole(elst(j,i))) = dscale(ipole(elst(j,i))) + & * qmmmscale + uscale(ipole(elst(j,i))) = uscale(ipole(elst(j,i))) + & * qmmmscale + end if + end do do kkk = 1, nelst(i) k = elst(kkk,i) kk = ipole(k) @@ -2391,6 +2479,13 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = 1, nelst(i) + mscale(ipole(elst(j,i))) = 1.0d0 + pscale(ipole(elst(j,i))) = 1.0d0 + dscale(ipole(elst(j,i))) = 1.0d0 + uscale(ipole(elst(j,i))) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 @@ -2773,6 +2868,9 @@ real*8, allocatable :: uscale(:) character*6 mode external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the intramolecular portion of the Ewald energy @@ -2860,6 +2958,26 @@ dscale(ip14(j,ii)) = d4scale uscale(ip14(j,ii)) = u4scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = i+1, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + dscale(ipole(j)) = 1.0d0 + uscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(j)) = mscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + dscale(ipole(j)) = dscale(ipole(j)) * qmmmscale + uscale(ipole(j)) = uscale(ipole(j)) * qmmmscale + end if + end do do k = i+1, npole kk = ipole(k) xr = x(kk) - x(ii) @@ -3567,6 +3685,13 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = i+1, npole + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + dscale(ipole(j)) = 1.0d0 + uscale(ipole(j)) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 @@ -3660,6 +3785,26 @@ dscale(ip14(j,ii)) = d4scale uscale(ip14(j,ii)) = u4scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = i, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + dscale(ipole(j)) = 1.0d0 + uscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(j)) = mscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + dscale(ipole(j)) = dscale(ipole(j)) * qmmmscale + uscale(ipole(j)) = uscale(ipole(j)) * qmmmscale + end if + end do do k = i, npole kk = ipole(k) do jcell = 1, ncell @@ -4401,6 +4546,13 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = i, npole + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + dscale(ipole(j)) = 1.0d0 + uscale(ipole(j)) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 @@ -4792,6 +4944,9 @@ logical dorl,dorli character*6 mode external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the intramolecular portion of the Ewald energy @@ -4924,6 +5079,30 @@ dscale(ip14(j,ii)) = d4scale uscale(ip14(j,ii)) = u4scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = 1, nelst(i) + jqmmm = mod(qmmm(ipole(elst(j,i))),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(elst(j,i))) = 1.0d0 + pscale(ipole(elst(j,i))) = 1.0d0 + dscale(ipole(elst(j,i))) = 1.0d0 + uscale(ipole(elst(j,i))) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(elst(j,i))) = mscale(ipole(elst(j,i))) + & * qmmmscale + pscale(ipole(elst(j,i))) = pscale(ipole(elst(j,i))) + & * qmmmscale + dscale(ipole(elst(j,i))) = dscale(ipole(elst(j,i))) + & * qmmmscale + uscale(ipole(elst(j,i))) = uscale(ipole(elst(j,i))) + & * qmmmscale + end if + end do do kkk = 1, nelst(i) k = elst(kkk,i) kk = ipole(k) @@ -5691,6 +5870,13 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = 1, nelst(i) + mscale(ipole(elst(j,i))) = 1.0d0 + pscale(ipole(elst(j,i))) = 1.0d0 + dscale(ipole(elst(j,i))) = 1.0d0 + uscale(ipole(elst(j,i))) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 @@ -6447,3 +6633,1603 @@ deallocate (cphi) return end +c +c +c ##################################################### +c ## ## +c ## subroutine empole1qmmm -- QM/MM corrections ## +c ## ## +c ##################################################### +c +c +c "empole1qmmm" corrects the atomic multipole and dipole +c polarizability interaction energy using a double loop +c only MM-MM, MM-Y and Y-Y interactions must be retained +c +c + subroutine empole1qmmm + implicit none + include 'sizes.i' + include 'atoms.i' + include 'bound.i' + include 'boxes.i' + include 'cell.i' + include 'chgpot.i' + include 'couple.i' + include 'cutoff.i' + include 'deriv.i' + include 'energi.i' + include 'group.i' + include 'inter.i' + include 'molcul.i' + include 'mplpot.i' + include 'mpole.i' + include 'polar.i' + include 'polgrp.i' + include 'polpot.i' + include 'shunt.i' + include 'usage.i' + include 'virial.i' + integer i,j,k + integer ii,kk,jcell + integer ix,iy,iz + integer kx,ky,kz + integer iax,iay,iaz + integer kax,kay,kaz + real*8 e,ei,f,fgrp,gfd + real*8 damp,expdamp + real*8 pdi,pti,pgamma + real*8 scale3,scale3i + real*8 scale5,scale5i + real*8 scale7,scale7i + real*8 temp3,temp5,temp7 + real*8 psc3,psc5,psc7 + real*8 dsc3,dsc5,dsc7 + real*8 xr,yr,zr + real*8 xix,yix,zix + real*8 xiy,yiy,ziy + real*8 xiz,yiz,ziz + real*8 xkx,ykx,zkx + real*8 xky,yky,zky + real*8 xkz,ykz,zkz + real*8 r,r2,rr1,rr3 + real*8 rr5,rr7,rr9,rr11 + real*8 vxx,vyy,vzz + real*8 vyx,vzx,vzy + real*8 ci,di(3),qi(9) + real*8 ck,dk(3),qk(9) + real*8 frcxi(3),frcxk(3) + real*8 frcyi(3),frcyk(3) + real*8 frczi(3),frczk(3) + real*8 fridmp(3),findmp(3) + real*8 ftm2(3),ftm2i(3) + real*8 ttm2(3),ttm3(3) + real*8 ttm2i(3),ttm3i(3) + real*8 dixdk(3),fdir(3) + real*8 dixuk(3),dkxui(3) + real*8 dixukp(3),dkxuip(3) + real*8 uixqkr(3),ukxqir(3) + real*8 uixqkrp(3),ukxqirp(3) + real*8 qiuk(3),qkui(3) + real*8 qiukp(3),qkuip(3) + real*8 rxqiuk(3),rxqkui(3) + real*8 rxqiukp(3),rxqkuip(3) + real*8 qidk(3),qkdi(3) + real*8 qir(3),qkr(3) + real*8 qiqkr(3),qkqir(3) + real*8 qixqk(3),rxqir(3) + real*8 dixr(3),dkxr(3) + real*8 dixqkr(3),dkxqir(3) + real*8 rxqkr(3),qkrxqir(3) + real*8 rxqikr(3),rxqkir(3) + real*8 rxqidk(3),rxqkdi(3) + real*8 ddsc3(3),ddsc5(3) + real*8 ddsc7(3) + real*8 gl(0:8),gli(7),glip(7) + real*8 sc(10),sci(8),scip(8) + real*8 gf(7),gfi(6),gti(6) + real*8, allocatable :: mscale(:) + real*8, allocatable :: pscale(:) + real*8, allocatable :: dscale(:) + real*8, allocatable :: uscale(:) + logical proceed,usei,usek + character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm,kqmmm,ikqmmm +c +c +c check the sign of multipole components at chiral sites +c + call chkpole +c +c rotate the multipole components into the global frame +c + call rotpole +c +c compute the induced dipoles at each polarizable atom +c + call induce +c +c perform dynamic allocation of some local arrays +c + allocate (mscale(n)) + allocate (pscale(n)) + allocate (dscale(n)) + allocate (uscale(n)) +c +c set arrays needed to scale connected atom interactions +c + if (npole .eq. 0) return + do i = 1, n + mscale(i) = 1.0d0 + pscale(i) = 1.0d0 + dscale(i) = 1.0d0 + uscale(i) = 1.0d0 + end do +c +c set conversion factor, cutoff and switching coefficients +c + f = electric / dielec + mode = 'MPOLE' + call switch (mode) +c +c set scale factors for permanent multipole and induced terms +c + do i = 1, npole-1 + ii = ipole(i) + iz = zaxis(i) + ix = xaxis(i) + iy = yaxis(i) + pdi = pdamp(i) + pti = thole(i) + ci = rpole(1,i) + di(1) = rpole(2,i) + di(2) = rpole(3,i) + di(3) = rpole(4,i) + qi(1) = rpole(5,i) + qi(2) = rpole(6,i) + qi(3) = rpole(7,i) + qi(4) = rpole(8,i) + qi(5) = rpole(9,i) + qi(6) = rpole(10,i) + qi(7) = rpole(11,i) + qi(8) = rpole(12,i) + qi(9) = rpole(13,i) + usei = (use(ii) .or. use(iz) .or. use(ix) .or. use(iy)) +c +c set interaction scaling coefficients for connected atoms +c + do j = 1, n12(ii) + mscale(i12(j,ii)) = m2scale + pscale(i12(j,ii)) = p2scale + end do + do j = 1, n13(ii) + mscale(i13(j,ii)) = m3scale + pscale(i13(j,ii)) = p3scale + end do + do j = 1, n14(ii) + mscale(i14(j,ii)) = m4scale + pscale(i14(j,ii)) = p4scale + do k = 1, np11(ii) + if (i14(j,ii) .eq. ip11(k,ii)) + & pscale(i14(j,ii)) = p4scale * p41scale + end do + end do + do j = 1, n15(ii) + mscale(i15(j,ii)) = m5scale + pscale(i15(j,ii)) = p5scale + end do + do j = 1, np11(ii) + dscale(ip11(j,ii)) = d1scale + uscale(ip11(j,ii)) = u1scale + end do + do j = 1, np12(ii) + dscale(ip12(j,ii)) = d2scale + uscale(ip12(j,ii)) = u2scale + end do + do j = 1, np13(ii) + dscale(ip13(j,ii)) = d3scale + uscale(ip13(j,ii)) = u3scale + end do + do j = 1, np14(ii) + dscale(ip14(j,ii)) = d4scale + uscale(ip14(j,ii)) = u4scale + end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = i+1, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + dscale(ipole(j)) = 1.0d0 + uscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(j)) = mscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + dscale(ipole(j)) = dscale(ipole(j)) * qmmmscale + uscale(ipole(j)) = uscale(ipole(j)) * qmmmscale + end if + end do + do k = i+1, npole + kk = ipole(k) + kz = zaxis(k) + kx = xaxis(k) + ky = yaxis(k) + usek = (use(kk) .or. use(kz) .or. use(kx) .or. use(ky)) +cqmmm + kqmmm = mod(qmmm(kk),3) + ikqmmm = iqmmm + kqmmm + proceed = .true. + if (use_group) call groups (proceed,fgrp,ii,kk,0,0,0,0) + if (.not. use_intra) proceed = .true. + if (proceed) proceed = (usei .or. usek) +cqmmm + if (proceed) proceed = (ikqmmm .ne. 0) + if (.not. proceed) goto 10 + xr = x(kk) - x(ii) + yr = y(kk) - y(ii) + zr = z(kk) - z(ii) + if (use_bounds) call image (xr,yr,zr) + r2 = xr*xr + yr*yr + zr*zr + if (r2 .le. off2) then + r = sqrt(r2) + ck = rpole(1,k) + dk(1) = rpole(2,k) + dk(2) = rpole(3,k) + dk(3) = rpole(4,k) + qk(1) = rpole(5,k) + qk(2) = rpole(6,k) + qk(3) = rpole(7,k) + qk(4) = rpole(8,k) + qk(5) = rpole(9,k) + qk(6) = rpole(10,k) + qk(7) = rpole(11,k) + qk(8) = rpole(12,k) + qk(9) = rpole(13,k) +c +c apply Thole polarization damping to scale factors +c + rr1 = 1.0d0 / r + rr3 = rr1 / r2 + rr5 = 3.0d0 * rr3 / r2 + rr7 = 5.0d0 * rr5 / r2 + rr9 = 7.0d0 * rr7 / r2 + rr11 = 9.0d0 * rr9 / r2 + scale3 = 1.0d0 + scale5 = 1.0d0 + scale7 = 1.0d0 + do j = 1, 3 + ddsc3(j) = 0.0d0 + ddsc5(j) = 0.0d0 + ddsc7(j) = 0.0d0 + end do + damp = pdi * pdamp(k) + if (damp .ne. 0.0d0) then + pgamma = min(pti,thole(k)) + damp = -pgamma * (r/damp)**3 + if (damp .gt. -50.0d0) then + expdamp = exp(damp) + scale3 = 1.0d0 - expdamp + scale5 = 1.0d0 - (1.0d0-damp)*expdamp + scale7 = 1.0d0 - (1.0d0-damp+0.6d0*damp**2) + & *expdamp + temp3 = -3.0d0 * damp * expdamp / r2 + temp5 = -damp + temp7 = -0.2d0 - 0.6d0*damp + ddsc3(1) = temp3 * xr + ddsc3(2) = temp3 * yr + ddsc3(3) = temp3 * zr + ddsc5(1) = temp5 * ddsc3(1) + ddsc5(2) = temp5 * ddsc3(2) + ddsc5(3) = temp5 * ddsc3(3) + ddsc7(1) = temp7 * ddsc5(1) + ddsc7(2) = temp7 * ddsc5(2) + ddsc7(3) = temp7 * ddsc5(3) + end if + end if + scale3i = scale3 * uscale(kk) + scale5i = scale5 * uscale(kk) + scale7i = scale7 * uscale(kk) + dsc3 = scale3 * dscale(kk) + dsc5 = scale5 * dscale(kk) + dsc7 = scale7 * dscale(kk) + psc3 = scale3 * pscale(kk) + psc5 = scale5 * pscale(kk) + psc7 = scale7 * pscale(kk) +c +c construct necessary auxiliary vectors +c + dixdk(1) = di(2)*dk(3) - di(3)*dk(2) + dixdk(2) = di(3)*dk(1) - di(1)*dk(3) + dixdk(3) = di(1)*dk(2) - di(2)*dk(1) + dixuk(1) = di(2)*uind(3,k) - di(3)*uind(2,k) + dixuk(2) = di(3)*uind(1,k) - di(1)*uind(3,k) + dixuk(3) = di(1)*uind(2,k) - di(2)*uind(1,k) + dkxui(1) = dk(2)*uind(3,i) - dk(3)*uind(2,i) + dkxui(2) = dk(3)*uind(1,i) - dk(1)*uind(3,i) + dkxui(3) = dk(1)*uind(2,i) - dk(2)*uind(1,i) + dixukp(1) = di(2)*uinp(3,k) - di(3)*uinp(2,k) + dixukp(2) = di(3)*uinp(1,k) - di(1)*uinp(3,k) + dixukp(3) = di(1)*uinp(2,k) - di(2)*uinp(1,k) + dkxuip(1) = dk(2)*uinp(3,i) - dk(3)*uinp(2,i) + dkxuip(2) = dk(3)*uinp(1,i) - dk(1)*uinp(3,i) + dkxuip(3) = dk(1)*uinp(2,i) - dk(2)*uinp(1,i) + dixr(1) = di(2)*zr - di(3)*yr + dixr(2) = di(3)*xr - di(1)*zr + dixr(3) = di(1)*yr - di(2)*xr + dkxr(1) = dk(2)*zr - dk(3)*yr + dkxr(2) = dk(3)*xr - dk(1)*zr + dkxr(3) = dk(1)*yr - dk(2)*xr + qir(1) = qi(1)*xr + qi(4)*yr + qi(7)*zr + qir(2) = qi(2)*xr + qi(5)*yr + qi(8)*zr + qir(3) = qi(3)*xr + qi(6)*yr + qi(9)*zr + qkr(1) = qk(1)*xr + qk(4)*yr + qk(7)*zr + qkr(2) = qk(2)*xr + qk(5)*yr + qk(8)*zr + qkr(3) = qk(3)*xr + qk(6)*yr + qk(9)*zr + qiqkr(1) = qi(1)*qkr(1) + qi(4)*qkr(2) + qi(7)*qkr(3) + qiqkr(2) = qi(2)*qkr(1) + qi(5)*qkr(2) + qi(8)*qkr(3) + qiqkr(3) = qi(3)*qkr(1) + qi(6)*qkr(2) + qi(9)*qkr(3) + qkqir(1) = qk(1)*qir(1) + qk(4)*qir(2) + qk(7)*qir(3) + qkqir(2) = qk(2)*qir(1) + qk(5)*qir(2) + qk(8)*qir(3) + qkqir(3) = qk(3)*qir(1) + qk(6)*qir(2) + qk(9)*qir(3) + qixqk(1) = qi(2)*qk(3) + qi(5)*qk(6) + qi(8)*qk(9) + & - qi(3)*qk(2) - qi(6)*qk(5) - qi(9)*qk(8) + qixqk(2) = qi(3)*qk(1) + qi(6)*qk(4) + qi(9)*qk(7) + & - qi(1)*qk(3) - qi(4)*qk(6) - qi(7)*qk(9) + qixqk(3) = qi(1)*qk(2) + qi(4)*qk(5) + qi(7)*qk(8) + & - qi(2)*qk(1) - qi(5)*qk(4) - qi(8)*qk(7) + rxqir(1) = yr*qir(3) - zr*qir(2) + rxqir(2) = zr*qir(1) - xr*qir(3) + rxqir(3) = xr*qir(2) - yr*qir(1) + rxqkr(1) = yr*qkr(3) - zr*qkr(2) + rxqkr(2) = zr*qkr(1) - xr*qkr(3) + rxqkr(3) = xr*qkr(2) - yr*qkr(1) + rxqikr(1) = yr*qiqkr(3) - zr*qiqkr(2) + rxqikr(2) = zr*qiqkr(1) - xr*qiqkr(3) + rxqikr(3) = xr*qiqkr(2) - yr*qiqkr(1) + rxqkir(1) = yr*qkqir(3) - zr*qkqir(2) + rxqkir(2) = zr*qkqir(1) - xr*qkqir(3) + rxqkir(3) = xr*qkqir(2) - yr*qkqir(1) + qkrxqir(1) = qkr(2)*qir(3) - qkr(3)*qir(2) + qkrxqir(2) = qkr(3)*qir(1) - qkr(1)*qir(3) + qkrxqir(3) = qkr(1)*qir(2) - qkr(2)*qir(1) + qidk(1) = qi(1)*dk(1) + qi(4)*dk(2) + qi(7)*dk(3) + qidk(2) = qi(2)*dk(1) + qi(5)*dk(2) + qi(8)*dk(3) + qidk(3) = qi(3)*dk(1) + qi(6)*dk(2) + qi(9)*dk(3) + qkdi(1) = qk(1)*di(1) + qk(4)*di(2) + qk(7)*di(3) + qkdi(2) = qk(2)*di(1) + qk(5)*di(2) + qk(8)*di(3) + qkdi(3) = qk(3)*di(1) + qk(6)*di(2) + qk(9)*di(3) + qiuk(1) = qi(1)*uind(1,k) + qi(4)*uind(2,k) + & + qi(7)*uind(3,k) + qiuk(2) = qi(2)*uind(1,k) + qi(5)*uind(2,k) + & + qi(8)*uind(3,k) + qiuk(3) = qi(3)*uind(1,k) + qi(6)*uind(2,k) + & + qi(9)*uind(3,k) + qkui(1) = qk(1)*uind(1,i) + qk(4)*uind(2,i) + & + qk(7)*uind(3,i) + qkui(2) = qk(2)*uind(1,i) + qk(5)*uind(2,i) + & + qk(8)*uind(3,i) + qkui(3) = qk(3)*uind(1,i) + qk(6)*uind(2,i) + & + qk(9)*uind(3,i) + qiukp(1) = qi(1)*uinp(1,k) + qi(4)*uinp(2,k) + & + qi(7)*uinp(3,k) + qiukp(2) = qi(2)*uinp(1,k) + qi(5)*uinp(2,k) + & + qi(8)*uinp(3,k) + qiukp(3) = qi(3)*uinp(1,k) + qi(6)*uinp(2,k) + & + qi(9)*uinp(3,k) + qkuip(1) = qk(1)*uinp(1,i) + qk(4)*uinp(2,i) + & + qk(7)*uinp(3,i) + qkuip(2) = qk(2)*uinp(1,i) + qk(5)*uinp(2,i) + & + qk(8)*uinp(3,i) + qkuip(3) = qk(3)*uinp(1,i) + qk(6)*uinp(2,i) + & + qk(9)*uinp(3,i) + dixqkr(1) = di(2)*qkr(3) - di(3)*qkr(2) + dixqkr(2) = di(3)*qkr(1) - di(1)*qkr(3) + dixqkr(3) = di(1)*qkr(2) - di(2)*qkr(1) + dkxqir(1) = dk(2)*qir(3) - dk(3)*qir(2) + dkxqir(2) = dk(3)*qir(1) - dk(1)*qir(3) + dkxqir(3) = dk(1)*qir(2) - dk(2)*qir(1) + uixqkr(1) = uind(2,i)*qkr(3) - uind(3,i)*qkr(2) + uixqkr(2) = uind(3,i)*qkr(1) - uind(1,i)*qkr(3) + uixqkr(3) = uind(1,i)*qkr(2) - uind(2,i)*qkr(1) + ukxqir(1) = uind(2,k)*qir(3) - uind(3,k)*qir(2) + ukxqir(2) = uind(3,k)*qir(1) - uind(1,k)*qir(3) + ukxqir(3) = uind(1,k)*qir(2) - uind(2,k)*qir(1) + uixqkrp(1) = uinp(2,i)*qkr(3) - uinp(3,i)*qkr(2) + uixqkrp(2) = uinp(3,i)*qkr(1) - uinp(1,i)*qkr(3) + uixqkrp(3) = uinp(1,i)*qkr(2) - uinp(2,i)*qkr(1) + ukxqirp(1) = uinp(2,k)*qir(3) - uinp(3,k)*qir(2) + ukxqirp(2) = uinp(3,k)*qir(1) - uinp(1,k)*qir(3) + ukxqirp(3) = uinp(1,k)*qir(2) - uinp(2,k)*qir(1) + rxqidk(1) = yr*qidk(3) - zr*qidk(2) + rxqidk(2) = zr*qidk(1) - xr*qidk(3) + rxqidk(3) = xr*qidk(2) - yr*qidk(1) + rxqkdi(1) = yr*qkdi(3) - zr*qkdi(2) + rxqkdi(2) = zr*qkdi(1) - xr*qkdi(3) + rxqkdi(3) = xr*qkdi(2) - yr*qkdi(1) + rxqiuk(1) = yr*qiuk(3) - zr*qiuk(2) + rxqiuk(2) = zr*qiuk(1) - xr*qiuk(3) + rxqiuk(3) = xr*qiuk(2) - yr*qiuk(1) + rxqkui(1) = yr*qkui(3) - zr*qkui(2) + rxqkui(2) = zr*qkui(1) - xr*qkui(3) + rxqkui(3) = xr*qkui(2) - yr*qkui(1) + rxqiukp(1) = yr*qiukp(3) - zr*qiukp(2) + rxqiukp(2) = zr*qiukp(1) - xr*qiukp(3) + rxqiukp(3) = xr*qiukp(2) - yr*qiukp(1) + rxqkuip(1) = yr*qkuip(3) - zr*qkuip(2) + rxqkuip(2) = zr*qkuip(1) - xr*qkuip(3) + rxqkuip(3) = xr*qkuip(2) - yr*qkuip(1) +c +c calculate scalar products for permanent components +c + sc(2) = di(1)*dk(1) + di(2)*dk(2) + di(3)*dk(3) + sc(3) = di(1)*xr + di(2)*yr + di(3)*zr + sc(4) = dk(1)*xr + dk(2)*yr + dk(3)*zr + sc(5) = qir(1)*xr + qir(2)*yr + qir(3)*zr + sc(6) = qkr(1)*xr + qkr(2)*yr + qkr(3)*zr + sc(7) = qir(1)*dk(1) + qir(2)*dk(2) + qir(3)*dk(3) + sc(8) = qkr(1)*di(1) + qkr(2)*di(2) + qkr(3)*di(3) + sc(9) = qir(1)*qkr(1) + qir(2)*qkr(2) + qir(3)*qkr(3) + sc(10) = qi(1)*qk(1) + qi(2)*qk(2) + qi(3)*qk(3) + & + qi(4)*qk(4) + qi(5)*qk(5) + qi(6)*qk(6) + & + qi(7)*qk(7) + qi(8)*qk(8) + qi(9)*qk(9) +c +c calculate scalar products for induced components +c + sci(1) = uind(1,i)*dk(1) + uind(2,i)*dk(2) + & + uind(3,i)*dk(3) + di(1)*uind(1,k) + & + di(2)*uind(2,k) + di(3)*uind(3,k) + sci(2) = uind(1,i)*uind(1,k) + uind(2,i)*uind(2,k) + & + uind(3,i)*uind(3,k) + sci(3) = uind(1,i)*xr + uind(2,i)*yr + uind(3,i)*zr + sci(4) = uind(1,k)*xr + uind(2,k)*yr + uind(3,k)*zr + sci(7) = qir(1)*uind(1,k) + qir(2)*uind(2,k) + & + qir(3)*uind(3,k) + sci(8) = qkr(1)*uind(1,i) + qkr(2)*uind(2,i) + & + qkr(3)*uind(3,i) + scip(1) = uinp(1,i)*dk(1) + uinp(2,i)*dk(2) + & + uinp(3,i)*dk(3) + di(1)*uinp(1,k) + & + di(2)*uinp(2,k) + di(3)*uinp(3,k) + scip(2) = uind(1,i)*uinp(1,k)+uind(2,i)*uinp(2,k) + & + uind(3,i)*uinp(3,k)+uinp(1,i)*uind(1,k) + & + uinp(2,i)*uind(2,k)+uinp(3,i)*uind(3,k) + scip(3) = uinp(1,i)*xr + uinp(2,i)*yr + uinp(3,i)*zr + scip(4) = uinp(1,k)*xr + uinp(2,k)*yr + uinp(3,k)*zr + scip(7) = qir(1)*uinp(1,k) + qir(2)*uinp(2,k) + & + qir(3)*uinp(3,k) + scip(8) = qkr(1)*uinp(1,i) + qkr(2)*uinp(2,i) + & + qkr(3)*uinp(3,i) +c +c calculate the gl functions for permanent components +c + gl(0) = ci*ck + gl(1) = ck*sc(3) - ci*sc(4) + gl(2) = ci*sc(6) + ck*sc(5) - sc(3)*sc(4) + gl(3) = sc(3)*sc(6) - sc(4)*sc(5) + gl(4) = sc(5)*sc(6) + gl(5) = -4.0d0 * sc(9) + gl(6) = sc(2) + gl(7) = 2.0d0 * (sc(7)-sc(8)) + gl(8) = 2.0d0 * sc(10) +c +c calculate the gl functions for induced components +c + gli(1) = ck*sci(3) - ci*sci(4) + gli(2) = -sc(3)*sci(4) - sci(3)*sc(4) + gli(3) = sci(3)*sc(6) - sci(4)*sc(5) + gli(6) = sci(1) + gli(7) = 2.0d0 * (sci(7)-sci(8)) + glip(1) = ck*scip(3) - ci*scip(4) + glip(2) = -sc(3)*scip(4) - scip(3)*sc(4) + glip(3) = scip(3)*sc(6) - scip(4)*sc(5) + glip(6) = scip(1) + glip(7) = 2.0d0 * (scip(7)-scip(8)) +c +c compute the energy contributions for this interaction +c + e = rr1*gl(0) + rr3*(gl(1)+gl(6)) + & + rr5*(gl(2)+gl(7)+gl(8)) + & + rr7*(gl(3)+gl(5)) + rr9*gl(4) + ei = 0.5d0*(rr3*(gli(1)+gli(6))*psc3 + & + rr5*(gli(2)+gli(7))*psc5 + & + rr7*gli(3)*psc7) + e = f * mscale(kk) * e + ei = f * ei + em = em - e + ep = ep - ei +c +c increment the total intermolecular energy +c + if (molcule(ii) .ne. molcule(kk)) then + einter = einter - e - ei + end if +c +c intermediate variables for the permanent components +c + gf(1) = rr3*gl(0) + rr5*(gl(1)+gl(6)) + & + rr7*(gl(2)+gl(7)+gl(8)) + & + rr9*(gl(3)+gl(5)) + rr11*gl(4) + gf(2) = -ck*rr3 + sc(4)*rr5 - sc(6)*rr7 + gf(3) = ci*rr3 + sc(3)*rr5 + sc(5)*rr7 + gf(4) = 2.0d0 * rr5 + gf(5) = 2.0d0 * (-ck*rr5+sc(4)*rr7-sc(6)*rr9) + gf(6) = 2.0d0 * (-ci*rr5-sc(3)*rr7-sc(5)*rr9) + gf(7) = 4.0d0 * rr7 +c +c intermediate variables for the induced components +c + gfi(1) = 0.5d0 * rr5 * ((gli(1)+gli(6))*psc3 + & + (glip(1)+glip(6))*dsc3 + & + scip(2)*scale3i) + & + 0.5d0 * rr7 * ((gli(7)+gli(2))*psc5 + & + (glip(7)+glip(2))*dsc5 + & - (sci(3)*scip(4)+scip(3)*sci(4))*scale5i) + & + 0.5d0 * rr9 * (gli(3)*psc7+glip(3)*dsc7) + gfi(2) = -rr3*ck + rr5*sc(4) - rr7*sc(6) + gfi(3) = rr3*ci + rr5*sc(3) + rr7*sc(5) + gfi(4) = 2.0d0 * rr5 + gfi(5) = rr7 * (sci(4)*psc7+scip(4)*dsc7) + gfi(6) = -rr7 * (sci(3)*psc7+scip(3)*dsc7) +c +c get the permanent force components +c + ftm2(1) = gf(1)*xr + gf(2)*di(1) + gf(3)*dk(1) + & + gf(4)*(qkdi(1)-qidk(1)) + gf(5)*qir(1) + & + gf(6)*qkr(1) + gf(7)*(qiqkr(1)+qkqir(1)) + ftm2(2) = gf(1)*yr + gf(2)*di(2) + gf(3)*dk(2) + & + gf(4)*(qkdi(2)-qidk(2)) + gf(5)*qir(2) + & + gf(6)*qkr(2) + gf(7)*(qiqkr(2)+qkqir(2)) + ftm2(3) = gf(1)*zr + gf(2)*di(3) + gf(3)*dk(3) + & + gf(4)*(qkdi(3)-qidk(3)) + gf(5)*qir(3) + & + gf(6)*qkr(3) + gf(7)*(qiqkr(3)+qkqir(3)) +c +c get the induced force components +c + ftm2i(1) = gfi(1)*xr + 0.5d0* + & (- rr3*ck*(uind(1,i)*psc3+uinp(1,i)*dsc3) + & + rr5*sc(4)*(uind(1,i)*psc5+uinp(1,i)*dsc5) + & - rr7*sc(6)*(uind(1,i)*psc7+uinp(1,i)*dsc7)) + & + (rr3*ci*(uind(1,k)*psc3+uinp(1,k)*dsc3) + & + rr5*sc(3)*(uind(1,k)*psc5+uinp(1,k)*dsc5) + & + rr7*sc(5)*(uind(1,k)*psc7+uinp(1,k)*dsc7))*0.5d0 + & + rr5*scale5i*(sci(4)*uinp(1,i)+scip(4)*uind(1,i) + & + sci(3)*uinp(1,k)+scip(3)*uind(1,k))*0.5d0 + & + 0.5d0*(sci(4)*psc5+scip(4)*dsc5)*rr5*di(1) + & + 0.5d0*(sci(3)*psc5+scip(3)*dsc5)*rr5*dk(1) + & + 0.5d0*gfi(4)*((qkui(1)-qiuk(1))*psc5 + & + (qkuip(1)-qiukp(1))*dsc5) + & + gfi(5)*qir(1) + gfi(6)*qkr(1) + ftm2i(2) = gfi(1)*yr + 0.5d0* + & (- rr3*ck*(uind(2,i)*psc3+uinp(2,i)*dsc3) + & + rr5*sc(4)*(uind(2,i)*psc5+uinp(2,i)*dsc5) + & - rr7*sc(6)*(uind(2,i)*psc7+uinp(2,i)*dsc7)) + & + (rr3*ci*(uind(2,k)*psc3+uinp(2,k)*dsc3) + & + rr5*sc(3)*(uind(2,k)*psc5+uinp(2,k)*dsc5) + & + rr7*sc(5)*(uind(2,k)*psc7+uinp(2,k)*dsc7))*0.5d0 + & + rr5*scale5i*(sci(4)*uinp(2,i)+scip(4)*uind(2,i) + & + sci(3)*uinp(2,k)+scip(3)*uind(2,k))*0.5d0 + & + 0.5d0*(sci(4)*psc5+scip(4)*dsc5)*rr5*di(2) + & + 0.5d0*(sci(3)*psc5+scip(3)*dsc5)*rr5*dk(2) + & + 0.5d0*gfi(4)*((qkui(2)-qiuk(2))*psc5 + & + (qkuip(2)-qiukp(2))*dsc5) + & + gfi(5)*qir(2) + gfi(6)*qkr(2) + ftm2i(3) = gfi(1)*zr + 0.5d0* + & (- rr3*ck*(uind(3,i)*psc3+uinp(3,i)*dsc3) + & + rr5*sc(4)*(uind(3,i)*psc5+uinp(3,i)*dsc5) + & - rr7*sc(6)*(uind(3,i)*psc7+uinp(3,i)*dsc7)) + & + (rr3*ci*(uind(3,k)*psc3+uinp(3,k)*dsc3) + & + rr5*sc(3)*(uind(3,k)*psc5+uinp(3,k)*dsc5) + & + rr7*sc(5)*(uind(3,k)*psc7+uinp(3,k)*dsc7))*0.5d0 + & + rr5*scale5i*(sci(4)*uinp(3,i)+scip(4)*uind(3,i) + & + sci(3)*uinp(3,k)+scip(3)*uind(3,k))*0.5d0 + & + 0.5d0*(sci(4)*psc5+scip(4)*dsc5)*rr5*di(3) + & + 0.5d0*(sci(3)*psc5+scip(3)*dsc5)*rr5*dk(3) + & + 0.5d0*gfi(4)*((qkui(3)-qiuk(3))*psc5 + & + (qkuip(3)-qiukp(3))*dsc5) + & + gfi(5)*qir(3) + gfi(6)*qkr(3) +c +c account for partially excluded induced interactions +c + temp3 = 0.5d0 * rr3 * ((gli(1)+gli(6))*pscale(kk) + & +(glip(1)+glip(6))*dscale(kk)) + temp5 = 0.5d0 * rr5 * ((gli(2)+gli(7))*pscale(kk) + & +(glip(2)+glip(7))*dscale(kk)) + temp7 = 0.5d0 * rr7 * (gli(3)*pscale(kk) + & +glip(3)*dscale(kk)) + fridmp(1) = temp3*ddsc3(1) + temp5*ddsc5(1) + & + temp7*ddsc7(1) + fridmp(2) = temp3*ddsc3(2) + temp5*ddsc5(2) + & + temp7*ddsc7(2) + fridmp(3) = temp3*ddsc3(3) + temp5*ddsc5(3) + & + temp7*ddsc7(3) +c +c find some scaling terms for induced-induced force +c + temp3 = 0.5d0 * rr3 * uscale(kk) * scip(2) + temp5 = -0.5d0 * rr5 * uscale(kk) + & * (sci(3)*scip(4)+scip(3)*sci(4)) + findmp(1) = temp3*ddsc3(1) + temp5*ddsc5(1) + findmp(2) = temp3*ddsc3(2) + temp5*ddsc5(2) + findmp(3) = temp3*ddsc3(3) + temp5*ddsc5(3) +c +c modify induced force for partially excluded interactions +c + ftm2i(1) = ftm2i(1) - fridmp(1) - findmp(1) + ftm2i(2) = ftm2i(2) - fridmp(2) - findmp(2) + ftm2i(3) = ftm2i(3) - fridmp(3) - findmp(3) +c +c correction to convert mutual to direct polarization force +c + if (poltyp .eq. 'DIRECT') then + gfd = 0.5d0 * (rr5*scip(2)*scale3i + & - rr7*(scip(3)*sci(4)+sci(3)*scip(4))*scale5i) + temp5 = 0.5d0 * rr5 * scale5i + fdir(1) = gfd*xr + temp5 + & * (sci(4)*uinp(1,i)+scip(4)*uind(1,i) + & +sci(3)*uinp(1,k)+scip(3)*uind(1,k)) + fdir(2) = gfd*yr + temp5 + & * (sci(4)*uinp(2,i)+scip(4)*uind(2,i) + & +sci(3)*uinp(2,k)+scip(3)*uind(2,k)) + fdir(3) = gfd*zr + temp5 + & * (sci(4)*uinp(3,i)+scip(4)*uind(3,i) + & +sci(3)*uinp(3,k)+scip(3)*uind(3,k)) + ftm2i(1) = ftm2i(1) - fdir(1) + findmp(1) + ftm2i(2) = ftm2i(2) - fdir(2) + findmp(2) + ftm2i(3) = ftm2i(3) - fdir(3) + findmp(3) + end if +c +c intermediate terms for induced torque on multipoles +c + gti(2) = 0.5d0 * rr5 * (sci(4)*psc5+scip(4)*dsc5) + gti(3) = 0.5d0 * rr5 * (sci(3)*psc5+scip(3)*dsc5) + gti(4) = gfi(4) + gti(5) = gfi(5) + gti(6) = gfi(6) +c +c get the permanent torque components +c + ttm2(1) = -rr3*dixdk(1) + gf(2)*dixr(1) - gf(5)*rxqir(1) + & + gf(4)*(dixqkr(1)+dkxqir(1)+rxqidk(1)-2.0d0*qixqk(1)) + & - gf(7)*(rxqikr(1)+qkrxqir(1)) + ttm2(2) = -rr3*dixdk(2) + gf(2)*dixr(2) - gf(5)*rxqir(2) + & + gf(4)*(dixqkr(2)+dkxqir(2)+rxqidk(2)-2.0d0*qixqk(2)) + & - gf(7)*(rxqikr(2)+qkrxqir(2)) + ttm2(3) = -rr3*dixdk(3) + gf(2)*dixr(3) - gf(5)*rxqir(3) + & + gf(4)*(dixqkr(3)+dkxqir(3)+rxqidk(3)-2.0d0*qixqk(3)) + & - gf(7)*(rxqikr(3)+qkrxqir(3)) + ttm3(1) = rr3*dixdk(1) + gf(3)*dkxr(1) - gf(6)*rxqkr(1) + & - gf(4)*(dixqkr(1)+dkxqir(1)+rxqkdi(1)-2.0d0*qixqk(1)) + & - gf(7)*(rxqkir(1)-qkrxqir(1)) + ttm3(2) = rr3*dixdk(2) + gf(3)*dkxr(2) - gf(6)*rxqkr(2) + & - gf(4)*(dixqkr(2)+dkxqir(2)+rxqkdi(2)-2.0d0*qixqk(2)) + & - gf(7)*(rxqkir(2)-qkrxqir(2)) + ttm3(3) = rr3*dixdk(3) + gf(3)*dkxr(3) - gf(6)*rxqkr(3) + & - gf(4)*(dixqkr(3)+dkxqir(3)+rxqkdi(3)-2.0d0*qixqk(3)) + & - gf(7)*(rxqkir(3)-qkrxqir(3)) +c +c get the induced torque components +c + ttm2i(1) = -rr3*(dixuk(1)*psc3+dixukp(1)*dsc3)*0.5d0 + & + gti(2)*dixr(1) + gti(4)*((ukxqir(1)+rxqiuk(1))*psc5 + & +(ukxqirp(1)+rxqiukp(1))*dsc5)*0.5d0 - gti(5)*rxqir(1) + ttm2i(2) = -rr3*(dixuk(2)*psc3+dixukp(2)*dsc3)*0.5d0 + & + gti(2)*dixr(2) + gti(4)*((ukxqir(2)+rxqiuk(2))*psc5 + & +(ukxqirp(2)+rxqiukp(2))*dsc5)*0.5d0 - gti(5)*rxqir(2) + ttm2i(3) = -rr3*(dixuk(3)*psc3+dixukp(3)*dsc3)*0.5d0 + & + gti(2)*dixr(3) + gti(4)*((ukxqir(3)+rxqiuk(3))*psc5 + & +(ukxqirp(3)+rxqiukp(3))*dsc5)*0.5d0 - gti(5)*rxqir(3) + ttm3i(1) = -rr3*(dkxui(1)*psc3+dkxuip(1)*dsc3)*0.5d0 + & + gti(3)*dkxr(1) - gti(4)*((uixqkr(1)+rxqkui(1))*psc5 + & +(uixqkrp(1)+rxqkuip(1))*dsc5)*0.5d0 - gti(6)*rxqkr(1) + ttm3i(2) = -rr3*(dkxui(2)*psc3+dkxuip(2)*dsc3)*0.5d0 + & + gti(3)*dkxr(2) - gti(4)*((uixqkr(2)+rxqkui(2))*psc5 + & +(uixqkrp(2)+rxqkuip(2))*dsc5)*0.5d0 - gti(6)*rxqkr(2) + ttm3i(3) = -rr3*(dkxui(3)*psc3+dkxuip(3)*dsc3)*0.5d0 + & + gti(3)*dkxr(3) - gti(4)*((uixqkr(3)+rxqkui(3))*psc5 + & +(uixqkrp(3)+rxqkuip(3))*dsc5)*0.5d0 - gti(6)*rxqkr(3) +c +c handle the case where scaling is used +c + do j = 1, 3 + ftm2(j) = f * ftm2(j) * mscale(kk) + ftm2i(j) = f * ftm2i(j) + ttm2(j) = f * ttm2(j) * mscale(kk) + ttm2i(j) = f * ttm2i(j) + ttm3(j) = f * ttm3(j) * mscale(kk) + ttm3i(j) = f * ttm3i(j) + end do +c +c increment gradient due to force and torque on first site +c + dem(1,ii) = dem(1,ii) - ftm2(1) + dem(2,ii) = dem(2,ii) - ftm2(2) + dem(3,ii) = dem(3,ii) - ftm2(3) + dep(1,ii) = dep(1,ii) - ftm2i(1) + dep(2,ii) = dep(2,ii) - ftm2i(2) + dep(3,ii) = dep(3,ii) - ftm2i(3) + call torque (i,ttm2,ttm2i,frcxi,frcyi,frczi) +c +c increment gradient due to force and torque on second site +c + dem(1,kk) = dem(1,kk) + ftm2(1) + dem(2,kk) = dem(2,kk) + ftm2(2) + dem(3,kk) = dem(3,kk) + ftm2(3) + dep(1,kk) = dep(1,kk) + ftm2i(1) + dep(2,kk) = dep(2,kk) + ftm2i(2) + dep(3,kk) = dep(3,kk) + ftm2i(3) + call torque (k,ttm3,ttm3i,frcxk,frcyk,frczk) +c +c increment the internal virial tensor components +c + iaz = iz + iax = ix + iay = iy + kaz = kz + kax = kx + kay = ky + if (iaz .eq. 0) iaz = ii + if (iax .eq. 0) iax = ii + if (iay .eq. 0) iay = ii + if (kaz .eq. 0) kaz = kk + if (kax .eq. 0) kax = kk + if (kay .eq. 0) kay = kk + xiz = x(iaz) - x(ii) + yiz = y(iaz) - y(ii) + ziz = z(iaz) - z(ii) + xix = x(iax) - x(ii) + yix = y(iax) - y(ii) + zix = z(iax) - z(ii) + xiy = x(iay) - x(ii) + yiy = y(iay) - y(ii) + ziy = z(iay) - z(ii) + xkz = x(kaz) - x(kk) + ykz = y(kaz) - y(kk) + zkz = z(kaz) - z(kk) + xkx = x(kax) - x(kk) + ykx = y(kax) - y(kk) + zkx = z(kax) - z(kk) + xky = x(kay) - x(kk) + yky = y(kay) - y(kk) + zky = z(kay) - z(kk) + vxx = -xr*(ftm2(1)+ftm2i(1)) + xix*frcxi(1) + & + xiy*frcyi(1) + xiz*frczi(1) + xkx*frcxk(1) + & + xky*frcyk(1) + xkz*frczk(1) + vyx = -yr*(ftm2(1)+ftm2i(1)) + yix*frcxi(1) + & + yiy*frcyi(1) + yiz*frczi(1) + ykx*frcxk(1) + & + yky*frcyk(1) + ykz*frczk(1) + vzx = -zr*(ftm2(1)+ftm2i(1)) + zix*frcxi(1) + & + ziy*frcyi(1) + ziz*frczi(1) + zkx*frcxk(1) + & + zky*frcyk(1) + zkz*frczk(1) + vyy = -yr*(ftm2(2)+ftm2i(2)) + yix*frcxi(2) + & + yiy*frcyi(2) + yiz*frczi(2) + ykx*frcxk(2) + & + yky*frcyk(2) + ykz*frczk(2) + vzy = -zr*(ftm2(2)+ftm2i(2)) + zix*frcxi(2) + & + ziy*frcyi(2) + ziz*frczi(2) + zkx*frcxk(2) + & + zky*frcyk(2) + zkz*frczk(2) + vzz = -zr*(ftm2(3)+ftm2i(3)) + zix*frcxi(3) + & + ziy*frcyi(3) + ziz*frczi(3) + zkx*frcxk(3) + & + zky*frcyk(3) + zkz*frczk(3) + vir(1,1) = vir(1,1) - vxx + vir(2,1) = vir(2,1) - vyx + vir(3,1) = vir(3,1) - vzx + vir(1,2) = vir(1,2) - vyx + vir(2,2) = vir(2,2) - vyy + vir(3,2) = vir(3,2) - vzy + vir(1,3) = vir(1,3) - vzx + vir(2,3) = vir(2,3) - vzy + vir(3,3) = vir(3,3) - vzz + end if + 10 continue + end do +c +c reset interaction scaling coefficients for connected atoms +c +cqmmm + do j = i+1, npole + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + dscale(ipole(j)) = 1.0d0 + uscale(ipole(j)) = 1.0d0 + end do + do j = 1, n12(ii) + mscale(i12(j,ii)) = 1.0d0 + pscale(i12(j,ii)) = 1.0d0 + end do + do j = 1, n13(ii) + mscale(i13(j,ii)) = 1.0d0 + pscale(i13(j,ii)) = 1.0d0 + end do + do j = 1, n14(ii) + mscale(i14(j,ii)) = 1.0d0 + pscale(i14(j,ii)) = 1.0d0 + end do + do j = 1, n15(ii) + mscale(i15(j,ii)) = 1.0d0 + pscale(i15(j,ii)) = 1.0d0 + end do + do j = 1, np11(ii) + dscale(ip11(j,ii)) = 1.0d0 + uscale(ip11(j,ii)) = 1.0d0 + end do + do j = 1, np12(ii) + dscale(ip12(j,ii)) = 1.0d0 + uscale(ip12(j,ii)) = 1.0d0 + end do + do j = 1, np13(ii) + dscale(ip13(j,ii)) = 1.0d0 + uscale(ip13(j,ii)) = 1.0d0 + end do + do j = 1, np14(ii) + dscale(ip14(j,ii)) = 1.0d0 + uscale(ip14(j,ii)) = 1.0d0 + end do + end do +c +c for periodic boundary conditions with large cutoffs +c neighbors must be found by the replicates method +c + if (use_replica) then +c +c calculate interaction with other unit cells +c + do i = 1, npole + ii = ipole(i) + iz = zaxis(i) + ix = xaxis(i) + iy = yaxis(i) + pdi = pdamp(i) + pti = thole(i) + ci = rpole(1,i) + di(1) = rpole(2,i) + di(2) = rpole(3,i) + di(3) = rpole(4,i) + qi(1) = rpole(5,i) + qi(2) = rpole(6,i) + qi(3) = rpole(7,i) + qi(4) = rpole(8,i) + qi(5) = rpole(9,i) + qi(6) = rpole(10,i) + qi(7) = rpole(11,i) + qi(8) = rpole(12,i) + qi(9) = rpole(13,i) + usei = (use(ii) .or. use(iz) .or. use(ix) .or. use(iy)) +c +c set interaction scaling coefficients for connected atoms +c + do j = 1, n12(ii) + mscale(i12(j,ii)) = m2scale + pscale(i12(j,ii)) = p2scale + end do + do j = 1, n13(ii) + mscale(i13(j,ii)) = m3scale + pscale(i13(j,ii)) = p3scale + end do + do j = 1, n14(ii) + mscale(i14(j,ii)) = m4scale + pscale(i14(j,ii)) = p4scale + end do + do j = 1, n15(ii) + mscale(i15(j,ii)) = m5scale + pscale(i15(j,ii)) = p5scale + end do + do j = 1, np11(ii) + dscale(ip11(j,ii)) = d1scale + uscale(ip11(j,ii)) = u1scale + end do + do j = 1, np12(ii) + dscale(ip12(j,ii)) = d2scale + uscale(ip12(j,ii)) = u2scale + end do + do j = 1, np13(ii) + dscale(ip13(j,ii)) = d3scale + uscale(ip13(j,ii)) = u3scale + end do + do j = 1, np14(ii) + dscale(ip14(j,ii)) = d4scale + uscale(ip14(j,ii)) = u4scale + end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + if (iqmmm .eq. 0) goto 99 + do j = i, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + dscale(ipole(j)) = 1.0d0 + uscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(j)) = mscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + dscale(ipole(j)) = dscale(ipole(j)) * qmmmscale + uscale(ipole(j)) = uscale(ipole(j)) * qmmmscale + end if + end do + do k = i, npole + kk = ipole(k) + kz = zaxis(k) + kx = xaxis(k) + ky = yaxis(k) + usek = (use(kk) .or. use(kz) .or. use(kx) .or. use(ky)) + if (use_group) call groups (proceed,fgrp,ii,kk,0,0,0,0) + proceed = .true. + if (proceed) proceed = (usei .or. usek) + if (.not. proceed) goto 20 + do jcell = 1, ncell + xr = x(kk) - x(ii) + yr = y(kk) - y(ii) + zr = z(kk) - z(ii) + call imager (xr,yr,zr,jcell) + r2 = xr*xr + yr*yr + zr*zr + if (r2 .le. off2) then + r = sqrt(r2) + ck = rpole(1,k) + dk(1) = rpole(2,k) + dk(2) = rpole(3,k) + dk(3) = rpole(4,k) + qk(1) = rpole(5,k) + qk(2) = rpole(6,k) + qk(3) = rpole(7,k) + qk(4) = rpole(8,k) + qk(5) = rpole(9,k) + qk(6) = rpole(10,k) + qk(7) = rpole(11,k) + qk(8) = rpole(12,k) + qk(9) = rpole(13,k) +c +c apply Thole polarization damping to scale factors +c + rr1 = 1.0d0 / r + rr3 = rr1 / r2 + rr5 = 3.0d0 * rr3 / r2 + rr7 = 5.0d0 * rr5 / r2 + rr9 = 7.0d0 * rr7 / r2 + rr11 = 9.0d0 * rr9 / r2 + scale3 = 1.0d0 + scale5 = 1.0d0 + scale7 = 1.0d0 + do j = 1, 3 + ddsc3(j) = 0.0d0 + ddsc5(j) = 0.0d0 + ddsc7(j) = 0.0d0 + end do + damp = pdi * pdamp(k) + if (damp .ne. 0.0d0) then + pgamma = min(pti,thole(k)) + damp = -pgamma * (r/damp)**3 + if (damp .gt. -50.0d0) then + expdamp = exp(damp) + scale3 = 1.0d0 - expdamp + scale5 = 1.0d0 - (1.0d0-damp)*expdamp + scale7 = 1.0d0 - (1.0d0-damp+0.6d0*damp**2) + & *expdamp + temp3 = -3.0d0 * damp * expdamp / r2 + temp5 = -damp + temp7 = -0.2d0 - 0.6d0*damp + ddsc3(1) = temp3 * xr + ddsc3(2) = temp3 * yr + ddsc3(3) = temp3 * zr + ddsc5(1) = temp5 * ddsc3(1) + ddsc5(2) = temp5 * ddsc3(2) + ddsc5(3) = temp5 * ddsc3(3) + ddsc7(1) = temp7 * ddsc5(1) + ddsc7(2) = temp7 * ddsc5(2) + ddsc7(3) = temp7 * ddsc5(3) + end if + end if + scale3i = scale3 + scale5i = scale5 + scale7i = scale7 + dsc3 = scale3 + dsc5 = scale5 + dsc7 = scale7 + psc3 = scale3 + psc5 = scale5 + psc7 = scale7 + if (use_polymer) then + if (r2 .le. polycut2) then + scale3i = scale3i * uscale(kk) + scale5i = scale5i * uscale(kk) + scale7i = scale7i * uscale(kk) + dsc3 = dsc3 * dscale(kk) + dsc5 = dsc5 * dscale(kk) + dsc7 = dsc7 * dscale(kk) + psc3 = psc3 * pscale(kk) + psc5 = psc5 * pscale(kk) + psc7 = psc7 * pscale(kk) + end if + end if +c +c construct necessary auxiliary vectors +c + dixdk(1) = di(2)*dk(3) - di(3)*dk(2) + dixdk(2) = di(3)*dk(1) - di(1)*dk(3) + dixdk(3) = di(1)*dk(2) - di(2)*dk(1) + dixuk(1) = di(2)*uind(3,k) - di(3)*uind(2,k) + dixuk(2) = di(3)*uind(1,k) - di(1)*uind(3,k) + dixuk(3) = di(1)*uind(2,k) - di(2)*uind(1,k) + dkxui(1) = dk(2)*uind(3,i) - dk(3)*uind(2,i) + dkxui(2) = dk(3)*uind(1,i) - dk(1)*uind(3,i) + dkxui(3) = dk(1)*uind(2,i) - dk(2)*uind(1,i) + dixukp(1) = di(2)*uinp(3,k) - di(3)*uinp(2,k) + dixukp(2) = di(3)*uinp(1,k) - di(1)*uinp(3,k) + dixukp(3) = di(1)*uinp(2,k) - di(2)*uinp(1,k) + dkxuip(1) = dk(2)*uinp(3,i) - dk(3)*uinp(2,i) + dkxuip(2) = dk(3)*uinp(1,i) - dk(1)*uinp(3,i) + dkxuip(3) = dk(1)*uinp(2,i) - dk(2)*uinp(1,i) + dixr(1) = di(2)*zr - di(3)*yr + dixr(2) = di(3)*xr - di(1)*zr + dixr(3) = di(1)*yr - di(2)*xr + dkxr(1) = dk(2)*zr - dk(3)*yr + dkxr(2) = dk(3)*xr - dk(1)*zr + dkxr(3) = dk(1)*yr - dk(2)*xr + qir(1) = qi(1)*xr + qi(4)*yr + qi(7)*zr + qir(2) = qi(2)*xr + qi(5)*yr + qi(8)*zr + qir(3) = qi(3)*xr + qi(6)*yr + qi(9)*zr + qkr(1) = qk(1)*xr + qk(4)*yr + qk(7)*zr + qkr(2) = qk(2)*xr + qk(5)*yr + qk(8)*zr + qkr(3) = qk(3)*xr + qk(6)*yr + qk(9)*zr + qiqkr(1) = qi(1)*qkr(1) + qi(4)*qkr(2) + qi(7)*qkr(3) + qiqkr(2) = qi(2)*qkr(1) + qi(5)*qkr(2) + qi(8)*qkr(3) + qiqkr(3) = qi(3)*qkr(1) + qi(6)*qkr(2) + qi(9)*qkr(3) + qkqir(1) = qk(1)*qir(1) + qk(4)*qir(2) + qk(7)*qir(3) + qkqir(2) = qk(2)*qir(1) + qk(5)*qir(2) + qk(8)*qir(3) + qkqir(3) = qk(3)*qir(1) + qk(6)*qir(2) + qk(9)*qir(3) + qixqk(1) = qi(2)*qk(3) + qi(5)*qk(6) + qi(8)*qk(9) + & - qi(3)*qk(2) - qi(6)*qk(5) - qi(9)*qk(8) + qixqk(2) = qi(3)*qk(1) + qi(6)*qk(4) + qi(9)*qk(7) + & - qi(1)*qk(3) - qi(4)*qk(6) - qi(7)*qk(9) + qixqk(3) = qi(1)*qk(2) + qi(4)*qk(5) + qi(7)*qk(8) + & - qi(2)*qk(1) - qi(5)*qk(4) - qi(8)*qk(7) + rxqir(1) = yr*qir(3) - zr*qir(2) + rxqir(2) = zr*qir(1) - xr*qir(3) + rxqir(3) = xr*qir(2) - yr*qir(1) + rxqkr(1) = yr*qkr(3) - zr*qkr(2) + rxqkr(2) = zr*qkr(1) - xr*qkr(3) + rxqkr(3) = xr*qkr(2) - yr*qkr(1) + rxqikr(1) = yr*qiqkr(3) - zr*qiqkr(2) + rxqikr(2) = zr*qiqkr(1) - xr*qiqkr(3) + rxqikr(3) = xr*qiqkr(2) - yr*qiqkr(1) + rxqkir(1) = yr*qkqir(3) - zr*qkqir(2) + rxqkir(2) = zr*qkqir(1) - xr*qkqir(3) + rxqkir(3) = xr*qkqir(2) - yr*qkqir(1) + qkrxqir(1) = qkr(2)*qir(3) - qkr(3)*qir(2) + qkrxqir(2) = qkr(3)*qir(1) - qkr(1)*qir(3) + qkrxqir(3) = qkr(1)*qir(2) - qkr(2)*qir(1) + qidk(1) = qi(1)*dk(1) + qi(4)*dk(2) + qi(7)*dk(3) + qidk(2) = qi(2)*dk(1) + qi(5)*dk(2) + qi(8)*dk(3) + qidk(3) = qi(3)*dk(1) + qi(6)*dk(2) + qi(9)*dk(3) + qkdi(1) = qk(1)*di(1) + qk(4)*di(2) + qk(7)*di(3) + qkdi(2) = qk(2)*di(1) + qk(5)*di(2) + qk(8)*di(3) + qkdi(3) = qk(3)*di(1) + qk(6)*di(2) + qk(9)*di(3) + qiuk(1) = qi(1)*uind(1,k) + qi(4)*uind(2,k) + & + qi(7)*uind(3,k) + qiuk(2) = qi(2)*uind(1,k) + qi(5)*uind(2,k) + & + qi(8)*uind(3,k) + qiuk(3) = qi(3)*uind(1,k) + qi(6)*uind(2,k) + & + qi(9)*uind(3,k) + qkui(1) = qk(1)*uind(1,i) + qk(4)*uind(2,i) + & + qk(7)*uind(3,i) + qkui(2) = qk(2)*uind(1,i) + qk(5)*uind(2,i) + & + qk(8)*uind(3,i) + qkui(3) = qk(3)*uind(1,i) + qk(6)*uind(2,i) + & + qk(9)*uind(3,i) + qiukp(1) = qi(1)*uinp(1,k) + qi(4)*uinp(2,k) + & + qi(7)*uinp(3,k) + qiukp(2) = qi(2)*uinp(1,k) + qi(5)*uinp(2,k) + & + qi(8)*uinp(3,k) + qiukp(3) = qi(3)*uinp(1,k) + qi(6)*uinp(2,k) + & + qi(9)*uinp(3,k) + qkuip(1) = qk(1)*uinp(1,i) + qk(4)*uinp(2,i) + & + qk(7)*uinp(3,i) + qkuip(2) = qk(2)*uinp(1,i) + qk(5)*uinp(2,i) + & + qk(8)*uinp(3,i) + qkuip(3) = qk(3)*uinp(1,i) + qk(6)*uinp(2,i) + & + qk(9)*uinp(3,i) + dixqkr(1) = di(2)*qkr(3) - di(3)*qkr(2) + dixqkr(2) = di(3)*qkr(1) - di(1)*qkr(3) + dixqkr(3) = di(1)*qkr(2) - di(2)*qkr(1) + dkxqir(1) = dk(2)*qir(3) - dk(3)*qir(2) + dkxqir(2) = dk(3)*qir(1) - dk(1)*qir(3) + dkxqir(3) = dk(1)*qir(2) - dk(2)*qir(1) + uixqkr(1) = uind(2,i)*qkr(3) - uind(3,i)*qkr(2) + uixqkr(2) = uind(3,i)*qkr(1) - uind(1,i)*qkr(3) + uixqkr(3) = uind(1,i)*qkr(2) - uind(2,i)*qkr(1) + ukxqir(1) = uind(2,k)*qir(3) - uind(3,k)*qir(2) + ukxqir(2) = uind(3,k)*qir(1) - uind(1,k)*qir(3) + ukxqir(3) = uind(1,k)*qir(2) - uind(2,k)*qir(1) + uixqkrp(1) = uinp(2,i)*qkr(3) - uinp(3,i)*qkr(2) + uixqkrp(2) = uinp(3,i)*qkr(1) - uinp(1,i)*qkr(3) + uixqkrp(3) = uinp(1,i)*qkr(2) - uinp(2,i)*qkr(1) + ukxqirp(1) = uinp(2,k)*qir(3) - uinp(3,k)*qir(2) + ukxqirp(2) = uinp(3,k)*qir(1) - uinp(1,k)*qir(3) + ukxqirp(3) = uinp(1,k)*qir(2) - uinp(2,k)*qir(1) + rxqidk(1) = yr*qidk(3) - zr*qidk(2) + rxqidk(2) = zr*qidk(1) - xr*qidk(3) + rxqidk(3) = xr*qidk(2) - yr*qidk(1) + rxqkdi(1) = yr*qkdi(3) - zr*qkdi(2) + rxqkdi(2) = zr*qkdi(1) - xr*qkdi(3) + rxqkdi(3) = xr*qkdi(2) - yr*qkdi(1) + rxqiuk(1) = yr*qiuk(3) - zr*qiuk(2) + rxqiuk(2) = zr*qiuk(1) - xr*qiuk(3) + rxqiuk(3) = xr*qiuk(2) - yr*qiuk(1) + rxqkui(1) = yr*qkui(3) - zr*qkui(2) + rxqkui(2) = zr*qkui(1) - xr*qkui(3) + rxqkui(3) = xr*qkui(2) - yr*qkui(1) + rxqiukp(1) = yr*qiukp(3) - zr*qiukp(2) + rxqiukp(2) = zr*qiukp(1) - xr*qiukp(3) + rxqiukp(3) = xr*qiukp(2) - yr*qiukp(1) + rxqkuip(1) = yr*qkuip(3) - zr*qkuip(2) + rxqkuip(2) = zr*qkuip(1) - xr*qkuip(3) + rxqkuip(3) = xr*qkuip(2) - yr*qkuip(1) +c +c calculate scalar products for permanent components +c + sc(2) = di(1)*dk(1) + di(2)*dk(2) + di(3)*dk(3) + sc(3) = di(1)*xr + di(2)*yr + di(3)*zr + sc(4) = dk(1)*xr + dk(2)*yr + dk(3)*zr + sc(5) = qir(1)*xr + qir(2)*yr + qir(3)*zr + sc(6) = qkr(1)*xr + qkr(2)*yr + qkr(3)*zr + sc(7) = qir(1)*dk(1) + qir(2)*dk(2) + qir(3)*dk(3) + sc(8) = qkr(1)*di(1) + qkr(2)*di(2) + qkr(3)*di(3) + sc(9) = qir(1)*qkr(1) + qir(2)*qkr(2) + qir(3)*qkr(3) + sc(10) = qi(1)*qk(1) + qi(2)*qk(2) + qi(3)*qk(3) + & + qi(4)*qk(4) + qi(5)*qk(5) + qi(6)*qk(6) + & + qi(7)*qk(7) + qi(8)*qk(8) + qi(9)*qk(9) +c +c calculate scalar products for induced components +c + sci(1) = uind(1,i)*dk(1) + uind(2,i)*dk(2) + & + uind(3,i)*dk(3) + di(1)*uind(1,k) + & + di(2)*uind(2,k) + di(3)*uind(3,k) + sci(2) = uind(1,i)*uind(1,k) + uind(2,i)*uind(2,k) + & + uind(3,i)*uind(3,k) + sci(3) = uind(1,i)*xr + uind(2,i)*yr + uind(3,i)*zr + sci(4) = uind(1,k)*xr + uind(2,k)*yr + uind(3,k)*zr + sci(7) = qir(1)*uind(1,k) + qir(2)*uind(2,k) + & + qir(3)*uind(3,k) + sci(8) = qkr(1)*uind(1,i) + qkr(2)*uind(2,i) + & + qkr(3)*uind(3,i) + scip(1) = uinp(1,i)*dk(1) + uinp(2,i)*dk(2) + & + uinp(3,i)*dk(3) + di(1)*uinp(1,k) + & + di(2)*uinp(2,k) + di(3)*uinp(3,k) + scip(2) = uind(1,i)*uinp(1,k)+uind(2,i)*uinp(2,k) + & + uind(3,i)*uinp(3,k)+uinp(1,i)*uind(1,k) + & + uinp(2,i)*uind(2,k)+uinp(3,i)*uind(3,k) + scip(3) = uinp(1,i)*xr + uinp(2,i)*yr + uinp(3,i)*zr + scip(4) = uinp(1,k)*xr + uinp(2,k)*yr + uinp(3,k)*zr + scip(7) = qir(1)*uinp(1,k) + qir(2)*uinp(2,k) + & + qir(3)*uinp(3,k) + scip(8) = qkr(1)*uinp(1,i) + qkr(2)*uinp(2,i) + & + qkr(3)*uinp(3,i) +c +c calculate the gl functions for permanent components +c + gl(0) = ci*ck + gl(1) = ck*sc(3) - ci*sc(4) + gl(2) = ci*sc(6) + ck*sc(5) - sc(3)*sc(4) + gl(3) = sc(3)*sc(6) - sc(4)*sc(5) + gl(4) = sc(5)*sc(6) + gl(5) = -4.0d0 * sc(9) + gl(6) = sc(2) + gl(7) = 2.0d0 * (sc(7)-sc(8)) + gl(8) = 2.0d0 * sc(10) +c +c calculate the gl functions for induced components +c + gli(1) = ck*sci(3) - ci*sci(4) + gli(2) = -sc(3)*sci(4) - sci(3)*sc(4) + gli(3) = sci(3)*sc(6) - sci(4)*sc(5) + gli(6) = sci(1) + gli(7) = 2.0d0 * (sci(7)-sci(8)) + glip(1) = ck*scip(3) - ci*scip(4) + glip(2) = -sc(3)*scip(4) - scip(3)*sc(4) + glip(3) = scip(3)*sc(6) - scip(4)*sc(5) + glip(6) = scip(1) + glip(7) = 2.0d0 * (scip(7)-scip(8)) +c +c compute the energy contributions for this interaction +c + e = rr1*gl(0) + rr3*(gl(1)+gl(6)) + & + rr5*(gl(2)+gl(7)+gl(8)) + & + rr7*(gl(3)+gl(5)) + rr9*gl(4) + ei = 0.5d0*(rr3*(gli(1)+gli(6))*psc3 + & + rr5*(gli(2)+gli(7))*psc5 + & + rr7*gli(3)*psc7) + e = f * e + ei = f * ei + if (use_polymer) then + if (r2 .le. polycut2) then + e = e * mscale(kk) + end if + end if + if (use_group) then + e = e * fgrp +c ei = ei * fgrp + end if + if (ii .eq. kk) then + e = 0.5d0 * e + ei = 0.5d0 * ei + end if + em = em - e + ep = ep - ei +c +c increment the total intermolecular energy +c + if (molcule(ii) .ne. molcule(kk)) then + einter = einter - e - ei + end if +c +c intermediate variables for the permanent components +c + gf(1) = rr3*gl(0) + rr5*(gl(1)+gl(6)) + & + rr7*(gl(2)+gl(7)+gl(8)) + & + rr9*(gl(3)+gl(5)) + rr11*gl(4) + gf(2) = -ck*rr3 + sc(4)*rr5 - sc(6)*rr7 + gf(3) = ci*rr3 + sc(3)*rr5 + sc(5)*rr7 + gf(4) = 2.0d0 * rr5 + gf(5) = 2.0d0 * (-ck*rr5+sc(4)*rr7-sc(6)*rr9) + gf(6) = 2.0d0 * (-ci*rr5-sc(3)*rr7-sc(5)*rr9) + gf(7) = 4.0d0 * rr7 +c +c intermediate variables for the induced components +c + gfi(1) = 0.5d0 * rr5 * ((gli(1)+gli(6))*psc3 + & + (glip(1)+glip(6))*dsc3 + & + scip(2)*scale3i) + & + 0.5d0 * rr7 * ((gli(7)+gli(2))*psc5 + & + (glip(7)+glip(2))*dsc5 + & - (sci(3)*scip(4)+scip(3)*sci(4))*scale5i) + & + 0.5d0 * rr9 * (gli(3)*psc7+glip(3)*dsc7) + gfi(2) = -rr3*ck + rr5*sc(4) - rr7*sc(6) + gfi(3) = rr3*ci + rr5*sc(3) + rr7*sc(5) + gfi(4) = 2.0d0 * rr5 + gfi(5) = rr7 * (sci(4)*psc7+scip(4)*dsc7) + gfi(6) = -rr7 * (sci(3)*psc7+scip(3)*dsc7) +c +c get the permanent force components +c + ftm2(1) = gf(1)*xr + gf(2)*di(1) + gf(3)*dk(1) + & + gf(4)*(qkdi(1)-qidk(1)) + gf(5)*qir(1) + & + gf(6)*qkr(1) + gf(7)*(qiqkr(1)+qkqir(1)) + ftm2(2) = gf(1)*yr + gf(2)*di(2) + gf(3)*dk(2) + & + gf(4)*(qkdi(2)-qidk(2)) + gf(5)*qir(2) + & + gf(6)*qkr(2) + gf(7)*(qiqkr(2)+qkqir(2)) + ftm2(3) = gf(1)*zr + gf(2)*di(3) + gf(3)*dk(3) + & + gf(4)*(qkdi(3)-qidk(3)) + gf(5)*qir(3) + & + gf(6)*qkr(3) + gf(7)*(qiqkr(3)+qkqir(3)) +c +c get the induced force components +c + ftm2i(1) = gfi(1)*xr + 0.5d0* + & (- rr3*ck*(uind(1,i)*psc3+uinp(1,i)*dsc3) + & + rr5*sc(4)*(uind(1,i)*psc5+uinp(1,i)*dsc5) + & - rr7*sc(6)*(uind(1,i)*psc7+uinp(1,i)*dsc7)) + & + (rr3*ci*(uind(1,k)*psc3+uinp(1,k)*dsc3) + & + rr5*sc(3)*(uind(1,k)*psc5+uinp(1,k)*dsc5) + & + rr7*sc(5)*(uind(1,k)*psc7+uinp(1,k)*dsc7))*0.5d0 + & + rr5*scale5i*(sci(4)*uinp(1,i)+scip(4)*uind(1,i) + & + sci(3)*uinp(1,k)+scip(3)*uind(1,k))*0.5d0 + & + 0.5d0*(sci(4)*psc5+scip(4)*dsc5)*rr5*di(1) + & + 0.5d0*(sci(3)*psc5+scip(3)*dsc5)*rr5*dk(1) + & + 0.5d0*gfi(4)*((qkui(1)-qiuk(1))*psc5 + & + (qkuip(1)-qiukp(1))*dsc5) + & + gfi(5)*qir(1) + gfi(6)*qkr(1) + ftm2i(2) = gfi(1)*yr + 0.5d0* + & (- rr3*ck*(uind(2,i)*psc3+uinp(2,i)*dsc3) + & + rr5*sc(4)*(uind(2,i)*psc5+uinp(2,i)*dsc5) + & - rr7*sc(6)*(uind(2,i)*psc7+uinp(2,i)*dsc7)) + & + (rr3*ci*(uind(2,k)*psc3+uinp(2,k)*dsc3) + & + rr5*sc(3)*(uind(2,k)*psc5+uinp(2,k)*dsc5) + & + rr7*sc(5)*(uind(2,k)*psc7+uinp(2,k)*dsc7))*0.5d0 + & + rr5*scale5i*(sci(4)*uinp(2,i)+scip(4)*uind(2,i) + & + sci(3)*uinp(2,k)+scip(3)*uind(2,k))*0.5d0 + & + 0.5d0*(sci(4)*psc5+scip(4)*dsc5)*rr5*di(2) + & + 0.5d0*(sci(3)*psc5+scip(3)*dsc5)*rr5*dk(2) + & + 0.5d0*gfi(4)*((qkui(2)-qiuk(2))*psc5 + & + (qkuip(2)-qiukp(2))*dsc5) + & + gfi(5)*qir(2) + gfi(6)*qkr(2) + ftm2i(3) = gfi(1)*zr + 0.5d0* + & (- rr3*ck*(uind(3,i)*psc3+uinp(3,i)*dsc3) + & + rr5*sc(4)*(uind(3,i)*psc5+uinp(3,i)*dsc5) + & - rr7*sc(6)*(uind(3,i)*psc7+uinp(3,i)*dsc7)) + & + (rr3*ci*(uind(3,k)*psc3+uinp(3,k)*dsc3) + & + rr5*sc(3)*(uind(3,k)*psc5+uinp(3,k)*dsc5) + & + rr7*sc(5)*(uind(3,k)*psc7+uinp(3,k)*dsc7))*0.5d0 + & + rr5*scale5i*(sci(4)*uinp(3,i)+scip(4)*uind(3,i) + & + sci(3)*uinp(3,k)+scip(3)*uind(3,k))*0.5d0 + & + 0.5d0*(sci(4)*psc5+scip(4)*dsc5)*rr5*di(3) + & + 0.5d0*(sci(3)*psc5+scip(3)*dsc5)*rr5*dk(3) + & + 0.5d0*gfi(4)*((qkui(3)-qiuk(3))*psc5 + & + (qkuip(3)-qiukp(3))*dsc5) + & + gfi(5)*qir(3) + gfi(6)*qkr(3) +c +c account for partially excluded induced interactions +c + temp3 = 0.5d0 * rr3 * ((gli(1)+gli(6))*pscale(kk) + & +(glip(1)+glip(6))*dscale(kk)) + temp5 = 0.5d0 * rr5 * ((gli(2)+gli(7))*pscale(kk) + & +(glip(2)+glip(7))*dscale(kk)) + temp7 = 0.5d0 * rr7 * (gli(3)*pscale(kk) + & +glip(3)*dscale(kk)) + fridmp(1) = temp3*ddsc3(1) + temp5*ddsc5(1) + & + temp7*ddsc7(1) + fridmp(2) = temp3*ddsc3(2) + temp5*ddsc5(2) + & + temp7*ddsc7(2) + fridmp(3) = temp3*ddsc3(3) + temp5*ddsc5(3) + & + temp7*ddsc7(3) +c +c find some scaling terms for induced-induced force +c + temp3 = 0.5d0 * rr3 * uscale(kk) * scip(2) + temp5 = -0.5d0 * rr5 * uscale(kk) + & * (sci(3)*scip(4)+scip(3)*sci(4)) + findmp(1) = temp3*ddsc3(1) + temp5*ddsc5(1) + findmp(2) = temp3*ddsc3(2) + temp5*ddsc5(2) + findmp(3) = temp3*ddsc3(3) + temp5*ddsc5(3) +c +c modify induced force for partially excluded interactions +c + ftm2i(1) = ftm2i(1) - fridmp(1) - findmp(1) + ftm2i(2) = ftm2i(2) - fridmp(2) - findmp(2) + ftm2i(3) = ftm2i(3) - fridmp(3) - findmp(3) +c +c correction to convert mutual to direct polarization force +c + if (poltyp .eq. 'DIRECT') then + gfd = 0.5d0 * (rr5*scip(2)*scale3i + & - rr7*(scip(3)*sci(4)+sci(3)*scip(4))*scale5i) + temp5 = 0.5d0 * rr5 * scale5i + fdir(1) = gfd*xr + temp5 + & * (sci(4)*uinp(1,i)+scip(4)*uind(1,i) + & +sci(3)*uinp(1,k)+scip(3)*uind(1,k)) + fdir(2) = gfd*yr + temp5 + & * (sci(4)*uinp(2,i)+scip(4)*uind(2,i) + & +sci(3)*uinp(2,k)+scip(3)*uind(2,k)) + fdir(3) = gfd*zr + temp5 + & * (sci(4)*uinp(3,i)+scip(4)*uind(3,i) + & +sci(3)*uinp(3,k)+scip(3)*uind(3,k)) + ftm2i(1) = ftm2i(1) - fdir(1) + findmp(1) + ftm2i(2) = ftm2i(2) - fdir(2) + findmp(2) + ftm2i(3) = ftm2i(3) - fdir(3) + findmp(3) + end if +c +c intermediate terms for induced torque on multipoles +c + gti(2) = 0.5d0 * rr5 * (sci(4)*psc5+scip(4)*dsc5) + gti(3) = 0.5d0 * rr5 * (sci(3)*psc5+scip(3)*dsc5) + gti(4) = gfi(4) + gti(5) = gfi(5) + gti(6) = gfi(6) +c +c get the permanent torque components +c + ttm2(1) = -rr3*dixdk(1) + gf(2)*dixr(1) - gf(5)*rxqir(1) + & + gf(4)*(dixqkr(1)+dkxqir(1)+rxqidk(1)-2.0d0*qixqk(1)) + & - gf(7)*(rxqikr(1)+qkrxqir(1)) + ttm2(2) = -rr3*dixdk(2) + gf(2)*dixr(2) - gf(5)*rxqir(2) + & + gf(4)*(dixqkr(2)+dkxqir(2)+rxqidk(2)-2.0d0*qixqk(2)) + & - gf(7)*(rxqikr(2)+qkrxqir(2)) + ttm2(3) = -rr3*dixdk(3) + gf(2)*dixr(3) - gf(5)*rxqir(3) + & + gf(4)*(dixqkr(3)+dkxqir(3)+rxqidk(3)-2.0d0*qixqk(3)) + & - gf(7)*(rxqikr(3)+qkrxqir(3)) + ttm3(1) = rr3*dixdk(1) + gf(3)*dkxr(1) - gf(6)*rxqkr(1) + & - gf(4)*(dixqkr(1)+dkxqir(1)+rxqkdi(1)-2.0d0*qixqk(1)) + & - gf(7)*(rxqkir(1)-qkrxqir(1)) + ttm3(2) = rr3*dixdk(2) + gf(3)*dkxr(2) - gf(6)*rxqkr(2) + & - gf(4)*(dixqkr(2)+dkxqir(2)+rxqkdi(2)-2.0d0*qixqk(2)) + & - gf(7)*(rxqkir(2)-qkrxqir(2)) + ttm3(3) = rr3*dixdk(3) + gf(3)*dkxr(3) - gf(6)*rxqkr(3) + & - gf(4)*(dixqkr(3)+dkxqir(3)+rxqkdi(3)-2.0d0*qixqk(3)) + & - gf(7)*(rxqkir(3)-qkrxqir(3)) +c +c get the induced torque components +c + ttm2i(1) = -rr3*(dixuk(1)*psc3+dixukp(1)*dsc3)*0.5d0 + & + gti(2)*dixr(1) + gti(4)*((ukxqir(1)+rxqiuk(1))*psc5 + & +(ukxqirp(1)+rxqiukp(1))*dsc5)*0.5d0 - gti(5)*rxqir(1) + ttm2i(2) = -rr3*(dixuk(2)*psc3+dixukp(2)*dsc3)*0.5d0 + & + gti(2)*dixr(2) + gti(4)*((ukxqir(2)+rxqiuk(2))*psc5 + & +(ukxqirp(2)+rxqiukp(2))*dsc5)*0.5d0 - gti(5)*rxqir(2) + ttm2i(3) = -rr3*(dixuk(3)*psc3+dixukp(3)*dsc3)*0.5d0 + & + gti(2)*dixr(3) + gti(4)*((ukxqir(3)+rxqiuk(3))*psc5 + & +(ukxqirp(3)+rxqiukp(3))*dsc5)*0.5d0 - gti(5)*rxqir(3) + ttm3i(1) = -rr3*(dkxui(1)*psc3+dkxuip(1)*dsc3)*0.5d0 + & + gti(3)*dkxr(1) - gti(4)*((uixqkr(1)+rxqkui(1))*psc5 + & +(uixqkrp(1)+rxqkuip(1))*dsc5)*0.5d0 - gti(6)*rxqkr(1) + ttm3i(2) = -rr3*(dkxui(2)*psc3+dkxuip(2)*dsc3)*0.5d0 + & + gti(3)*dkxr(2) - gti(4)*((uixqkr(2)+rxqkui(2))*psc5 + & +(uixqkrp(2)+rxqkuip(2))*dsc5)*0.5d0 - gti(6)*rxqkr(2) + ttm3i(3) = -rr3*(dkxui(3)*psc3+dkxuip(3)*dsc3)*0.5d0 + & + gti(3)*dkxr(3) - gti(4)*((uixqkr(3)+rxqkui(3))*psc5 + & +(uixqkrp(3)+rxqkuip(3))*dsc5)*0.5d0 - gti(6)*rxqkr(3) +c +c handle the case where scaling is used +c + do j = 1, 3 + ftm2(j) = f * ftm2(j) + ftm2i(j) = f * ftm2i(j) + ttm2(j) = f * ttm2(j) + ttm2i(j) = f * ttm2i(j) + ttm3(j) = f * ttm3(j) + ttm3i(j) = f * ttm3i(j) + end do + if (use_polymer) then + if (r2 .le. polycut2) then + do j = 1, 3 + ftm2(j) = ftm2(j) * mscale(kk) + ttm2(j) = ttm2(j) * mscale(kk) + ttm3(j) = ttm3(j) * mscale(kk) + end do + end if + end if + if (use_group) then + do j = 1, 3 + ftm2(j) = ftm2(j) * fgrp + ttm2(j) = ttm2(j) * fgrp + ttm3(j) = ttm3(j) * fgrp +c ftm2i(j) = ftm2i(j) * fgrp +c ttm2i(j) = ttm2i(j) * fgrp +c ttm3i(j) = ttm3i(j) * fgrp + end do + end if + if (ii .eq. kk) then + do j = 1, 3 + ftm2(j) = 0.5d0 * ftm2(j) + ftm2i(j) = 0.5d0 * ftm2i(j) + ttm2(j) = 0.5d0 * ttm2(j) + ttm2i(j) = 0.5d0 * ttm2i(j) + ttm3(j) = 0.5d0 * ttm3(j) + ttm3i(j) = 0.5d0 * ttm3i(j) + end do + end if +c +c increment gradient due to force and torque on first site +c + dem(1,ii) = dem(1,ii) - ftm2(1) + dem(2,ii) = dem(2,ii) - ftm2(2) + dem(3,ii) = dem(3,ii) - ftm2(3) + dep(1,ii) = dep(1,ii) - ftm2i(1) + dep(2,ii) = dep(2,ii) - ftm2i(2) + dep(3,ii) = dep(3,ii) - ftm2i(3) + call torque (i,ttm2,ttm2i,frcxi,frcyi,frczi) +c +c increment gradient due to force and torque on second site +c + dem(1,kk) = dem(1,kk) + ftm2(1) + dem(2,kk) = dem(2,kk) + ftm2(2) + dem(3,kk) = dem(3,kk) + ftm2(3) + dep(1,kk) = dep(1,kk) + ftm2i(1) + dep(2,kk) = dep(2,kk) + ftm2i(2) + dep(3,kk) = dep(3,kk) + ftm2i(3) + call torque (k,ttm3,ttm3i,frcxk,frcyk,frczk) +c +c increment the internal virial tensor components +c + iaz = iz + iax = ix + iay = iy + kaz = kz + kax = kx + kay = ky + if (iaz .eq. 0) iaz = ii + if (iax .eq. 0) iax = ii + if (iay .eq. 0) iay = ii + if (kaz .eq. 0) kaz = kk + if (kax .eq. 0) kax = kk + if (kay .eq. 0) kay = kk + xiz = x(iaz) - x(ii) + yiz = y(iaz) - y(ii) + ziz = z(iaz) - z(ii) + xix = x(iax) - x(ii) + yix = y(iax) - y(ii) + zix = z(iax) - z(ii) + xiy = x(iay) - x(ii) + yiy = y(iay) - y(ii) + ziy = z(iay) - z(ii) + xkz = x(kaz) - x(kk) + ykz = y(kaz) - y(kk) + zkz = z(kaz) - z(kk) + xkx = x(kax) - x(kk) + ykx = y(kax) - y(kk) + zkx = z(kax) - z(kk) + xky = x(kay) - x(kk) + yky = y(kay) - y(kk) + zky = z(kay) - z(kk) + vxx = -xr*(ftm2(1)+ftm2i(1)) + xix*frcxi(1) + & + xiy*frcyi(1) + xiz*frczi(1) + xkx*frcxk(1) + & + xky*frcyk(1) + xkz*frczk(1) + vyx = -yr*(ftm2(1)+ftm2i(1)) + yix*frcxi(1) + & + yiy*frcyi(1) + yiz*frczi(1) + ykx*frcxk(1) + & + yky*frcyk(1) + ykz*frczk(1) + vzx = -zr*(ftm2(1)+ftm2i(1)) + zix*frcxi(1) + & + ziy*frcyi(1) + ziz*frczi(1) + zkx*frcxk(1) + & + zky*frcyk(1) + zkz*frczk(1) + vyy = -yr*(ftm2(2)+ftm2i(2)) + yix*frcxi(2) + & + yiy*frcyi(2) + yiz*frczi(2) + ykx*frcxk(2) + & + yky*frcyk(2) + ykz*frczk(2) + vzy = -zr*(ftm2(2)+ftm2i(2)) + zix*frcxi(2) + & + ziy*frcyi(2) + ziz*frczi(2) + zkx*frcxk(2) + & + zky*frcyk(2) + zkz*frczk(2) + vzz = -zr*(ftm2(3)+ftm2i(3)) + zix*frcxi(3) + & + ziy*frcyi(3) + ziz*frczi(3) + zkx*frcxk(3) + & + zky*frcyk(3) + zkz*frczk(3) + vir(1,1) = vir(1,1) - vxx + vir(2,1) = vir(2,1) - vyx + vir(3,1) = vir(3,1) - vzx + vir(1,2) = vir(1,2) - vyx + vir(2,2) = vir(2,2) - vyy + vir(3,2) = vir(3,2) - vzy + vir(1,3) = vir(1,3) - vzx + vir(2,3) = vir(2,3) - vzy + vir(3,3) = vir(3,3) - vzz + end if + end do + 20 continue + end do +c +c reset interaction scaling coefficients for connected atoms +c +cqmmm + do j = i, npole + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + dscale(ipole(j)) = 1.0d0 + uscale(ipole(j)) = 1.0d0 + end do + do j = 1, n12(ii) + mscale(i12(j,ii)) = 1.0d0 + pscale(i12(j,ii)) = 1.0d0 + end do + do j = 1, n13(ii) + mscale(i13(j,ii)) = 1.0d0 + pscale(i13(j,ii)) = 1.0d0 + end do + do j = 1, n14(ii) + mscale(i14(j,ii)) = 1.0d0 + pscale(i14(j,ii)) = 1.0d0 + end do + do j = 1, n15(ii) + mscale(i15(j,ii)) = 1.0d0 + pscale(i15(j,ii)) = 1.0d0 + end do + do j = 1, np11(ii) + dscale(ip11(j,ii)) = 1.0d0 + uscale(ip11(j,ii)) = 1.0d0 + end do + do j = 1, np12(ii) + dscale(ip12(j,ii)) = 1.0d0 + uscale(ip12(j,ii)) = 1.0d0 + end do + do j = 1, np13(ii) + dscale(ip13(j,ii)) = 1.0d0 + uscale(ip13(j,ii)) = 1.0d0 + end do + do j = 1, np14(ii) + dscale(ip14(j,ii)) = 1.0d0 + uscale(ip14(j,ii)) = 1.0d0 + end do +cqmmm + 99 continue + end do + end if +c +c perform deallocation of some local arrays +c + deallocate (mscale) + deallocate (pscale) + deallocate (dscale) + deallocate (uscale) + return + end + diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/empole2.f 6.3.3/source/empole2.f --- 6.3.3/source_orig/empole2.f 2015-04-14 13:58:10.106343730 +0200 +++ 6.3.3/source/empole2.f 2015-04-15 13:48:53.568041221 +0200 @@ -253,6 +253,9 @@ logical usei,usek logical reinduce character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm,kqmmm,ikqmmm c c c zero out the multipole and polarization first derivatives @@ -364,16 +367,41 @@ dscale(ip14(j,ii)) = d4scale uscale(ip14(j,ii)) = u4scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = i+1, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + dscale(ipole(j)) = 1.0d0 + uscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(j)) = mscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + dscale(ipole(j)) = dscale(ipole(j)) * qmmmscale + uscale(ipole(j)) = uscale(ipole(j)) * qmmmscale + end if + end do do k = i+1, npole kk = ipole(k) kz = zaxis(k) kx = xaxis(k) ky = yaxis(k) usek = (use(kk) .or. use(kz) .or. use(kx) .or. use(ky)) +cqmmm + kqmmm = mod(qmmm(kk),3) + ikqmmm = iqmmm + kqmmm proceed = .true. if (use_group) call groups (proceed,fgrp,ii,kk,0,0,0,0) if (.not. use_intra) proceed = .true. if (proceed) proceed = (usei .or. usek) +cqmmm + if (proceed) proceed = (ikqmmm .eq. 0) if (.not. proceed) goto 10 xr = x(kk) - x(ii) yr = y(kk) - y(ii) @@ -854,6 +882,13 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = i+1, npole + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + dscale(ipole(j)) = 1.0d0 + uscale(ipole(j)) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/empole3.f 6.3.3/source/empole3.f --- 6.3.3/source_orig/empole3.f 2015-04-14 13:58:10.106343730 +0200 +++ 6.3.3/source/empole3.f 2015-04-15 13:48:53.572041221 +0200 @@ -26,6 +26,8 @@ include 'mpole.i' include 'potent.i' integer i,ii +cqmmm + include 'qmmm.i' c c c choose the method for summing over multipole interactions @@ -43,6 +45,8 @@ call empole3a end if end if +cqmmm + if (nbinqm .ne. 0 .and. e4qmmm .eq. 0) call empole3qmmm c c zero out energy terms and analysis which are not in use c @@ -135,6 +139,9 @@ logical usei,usek logical muse,puse character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out multipole and polarization energy and partitioning @@ -226,6 +233,22 @@ mscale(i15(j,ii)) = m5scale pscale(i15(j,ii)) = p5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = i+1, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(j)) = mscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + end if + end do c c decide whether to compute the current interaction c @@ -397,6 +420,11 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = i+1, npole + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 @@ -462,6 +490,22 @@ mscale(i15(j,ii)) = m5scale pscale(i15(j,ii)) = p5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = i, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(j)) = mscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + end if + end do c c decide whether to compute the current interaction c @@ -638,6 +682,11 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = i, npole + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 @@ -735,6 +784,9 @@ logical usei,usek logical muse,puse character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out multipole and polarization energy and partitioning @@ -826,6 +878,24 @@ mscale(i15(j,ii)) = m5scale pscale(i15(j,ii)) = p5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = 1, nelst(i) + jqmmm = mod(qmmm(ipole(elst(j,i))),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(elst(j,i))) = 1.0d0 + pscale(ipole(elst(j,i))) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(elst(j,i))) = mscale(ipole(elst(j,i))) + & * qmmmscale + pscale(ipole(elst(j,i))) = pscale(ipole(elst(j,i))) + & * qmmmscale + end if + end do c c decide whether to compute the current interaction c @@ -998,6 +1068,11 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = 1, nelst(i) + mscale(ipole(elst(j,i))) = 1.0d0 + pscale(ipole(elst(j,i))) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 @@ -1245,6 +1320,9 @@ logical muse,puse character*6 mode external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the intramolecular portion of the Ewald energy @@ -1313,6 +1391,22 @@ mscale(i15(j,ii)) = m5scale pscale(i15(j,ii)) = p5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = i+1, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(j)) = mscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + end if + end do do k = i+1, npole kk = ipole(k) xr = x(kk) - x(ii) @@ -1487,6 +1581,11 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = i+1, npole + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 @@ -1548,6 +1647,22 @@ mscale(i15(j,ii)) = m5scale pscale(i15(j,ii)) = p5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = i, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(j)) = mscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + end if + end do do k = i, npole kk = ipole(k) do j = 1, ncell @@ -1724,6 +1839,11 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = i, npole + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 @@ -1977,6 +2097,9 @@ logical muse,puse character*6 mode external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the intramolecular portion of the Ewald energy @@ -2072,6 +2195,24 @@ mscale(i15(j,ii)) = m5scale pscale(i15(j,ii)) = p5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = 1, nelst(i) + jqmmm = mod(qmmm(ipole(elst(j,i))),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(elst(j,i))) = 1.0d0 + pscale(ipole(elst(j,i))) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(elst(j,i))) = mscale(ipole(elst(j,i))) + & * qmmmscale + pscale(ipole(elst(j,i))) = pscale(ipole(elst(j,i))) + & * qmmmscale + end if + end do do kkk = 1, nelst(i) k = elst(kkk,i) kk = ipole(k) @@ -2247,6 +2388,11 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = 1, nelst(i) + mscale(ipole(elst(j,i))) = 1.0d0 + pscale(ipole(elst(j,i))) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 @@ -2290,3 +2436,647 @@ deallocate (aeptt) return end +c +c +c ##################################################### +c ## ## +c ## subroutine empole3qmmm -- QM/MM corrections ## +c ## ## +c ##################################################### +c +c +c "empole3qmmm" corrects the atomic multipole and dipole +c polarizability interaction energy using a double loop +c only MM-MM, MM-Y and Y-Y interactions must be retained +c +c + subroutine empole3qmmm + implicit none + include 'sizes.i' + include 'action.i' + include 'analyz.i' + include 'atmtyp.i' + include 'atoms.i' + include 'bound.i' + include 'boxes.i' + include 'cell.i' + include 'chgpot.i' + include 'couple.i' + include 'energi.i' + include 'group.i' + include 'inform.i' + include 'inter.i' + include 'iounit.i' + include 'math.i' + include 'molcul.i' + include 'mplpot.i' + include 'mpole.i' + include 'polar.i' + include 'polgrp.i' + include 'polpot.i' + include 'potent.i' + include 'shunt.i' + include 'usage.i' + integer i,j,k + integer ii,kk + integer ix,iy,iz + integer kx,ky,kz + real*8 e,ei,fgrp + real*8 f,fm,fp + real*8 r,r2,xr,yr,zr + real*8 damp,expdamp + real*8 pdi,pti,pgamma + real*8 rr1,rr3,rr5 + real*8 rr7,rr9 + real*8 ci,dix,diy,diz + real*8 uix,uiy,uiz + real*8 qixx,qixy,qixz + real*8 qiyy,qiyz,qizz + real*8 ck,dkx,dky,dkz + real*8 ukx,uky,ukz + real*8 qkxx,qkxy,qkxz + real*8 qkyy,qkyz,qkzz + real*8 qix,qiy,qiz + real*8 qkx,qky,qkz + real*8 scale3,scale5 + real*8 scale7 + real*8 sc(10),sci(8) + real*8 gl(0:4),gli(3) + real*8, allocatable :: mscale(:) + real*8, allocatable :: pscale(:) + logical proceed + logical header,huge + logical usei,usek + logical muse,puse + character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm,kqmmm,ikqmmm +c +c +c + header = .true. +c +c check the sign of multipole components at chiral sites +c + call chkpole +c +c rotate the multipole components into the global frame +c + call rotpole +c +c compute the induced dipoles at each polarizable atom +c + call induce +c +c perform dynamic allocation of some local arrays +c + allocate (mscale(n)) + allocate (pscale(n)) +c +c set arrays needed to scale connected atom interactions +c + if (npole .eq. 0) return + do i = 1, n + mscale(i) = 1.0d0 + pscale(i) = 1.0d0 + end do +c +c set conversion factor, cutoff and switching coefficients +c + f = electric / dielec + mode = 'MPOLE' + call switch (mode) +c +c calculate the multipole interaction energy term +c + do i = 1, npole-1 + ii = ipole(i) + iz = zaxis(i) + ix = xaxis(i) + iy = yaxis(i) + pdi = pdamp(i) + pti = thole(i) + ci = rpole(1,i) + dix = rpole(2,i) + diy = rpole(3,i) + diz = rpole(4,i) + qixx = rpole(5,i) + qixy = rpole(6,i) + qixz = rpole(7,i) + qiyy = rpole(9,i) + qiyz = rpole(10,i) + qizz = rpole(13,i) + uix = uind(1,i) + uiy = uind(2,i) + uiz = uind(3,i) + usei = (use(ii) .or. use(iz) .or. use(ix) .or. use(iy)) +c +c set interaction scaling coefficients for connected atoms +c + do j = 1, n12(ii) + mscale(i12(j,ii)) = m2scale + pscale(i12(j,ii)) = p2scale + end do + do j = 1, n13(ii) + mscale(i13(j,ii)) = m3scale + pscale(i13(j,ii)) = p3scale + end do + do j = 1, n14(ii) + mscale(i14(j,ii)) = m4scale + pscale(i14(j,ii)) = p4scale + do k = 1, np11(ii) + if (i14(j,ii) .eq. ip11(k,ii)) + & pscale(i14(j,ii)) = p4scale * p41scale + end do + end do + do j = 1, n15(ii) + mscale(i15(j,ii)) = m5scale + pscale(i15(j,ii)) = p5scale + end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = 1, n + jqmmm = mod(qmmm(j),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(j) = 1.0d0 + pscale(j) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(j) = mscale(j) * qmmmscale + pscale(j) = pscale(j) * qmmmscale + end if + end do +c +c decide whether to compute the current interaction +c + do k = i+1, npole + kk = ipole(k) + kz = zaxis(k) + kx = xaxis(k) + ky = yaxis(k) + usek = (use(kk) .or. use(kz) .or. use(kx) .or. use(ky)) +cqmmm + kqmmm = mod(qmmm(kk),3) + ikqmmm = iqmmm + kqmmm + proceed = .true. + if (use_group) call groups (proceed,fgrp,ii,kk,0,0,0,0) + if (.not. use_intra) proceed = .true. + if (proceed) proceed = (usei .or. usek) + if (proceed) proceed = (ikqmmm .ne. 0) +c +c compute the energy contribution for this interaction +c + if (proceed) then + xr = x(kk) - x(ii) + yr = y(kk) - y(ii) + zr = z(kk) - z(ii) + if (use_bounds) call image (xr,yr,zr) + r2 = xr*xr + yr* yr + zr*zr + if (r2 .le. off2) then + r = sqrt(r2) + ck = rpole(1,k) + dkx = rpole(2,k) + dky = rpole(3,k) + dkz = rpole(4,k) + qkxx = rpole(5,k) + qkxy = rpole(6,k) + qkxz = rpole(7,k) + qkyy = rpole(9,k) + qkyz = rpole(10,k) + qkzz = rpole(13,k) + ukx = uind(1,k) + uky = uind(2,k) + ukz = uind(3,k) +c +c construct some intermediate quadrupole values +c + qix = qixx*xr + qixy*yr + qixz*zr + qiy = qixy*xr + qiyy*yr + qiyz*zr + qiz = qixz*xr + qiyz*yr + qizz*zr + qkx = qkxx*xr + qkxy*yr + qkxz*zr + qky = qkxy*xr + qkyy*yr + qkyz*zr + qkz = qkxz*xr + qkyz*yr + qkzz*zr +c +c calculate the scalar products for permanent multipoles +c + sc(2) = dix*dkx + diy*dky + diz*dkz + sc(3) = dix*xr + diy*yr + diz*zr + sc(4) = dkx*xr + dky*yr + dkz*zr + sc(5) = qix*xr + qiy*yr + qiz*zr + sc(6) = qkx*xr + qky*yr + qkz*zr + sc(7) = qix*dkx + qiy*dky + qiz*dkz + sc(8) = qkx*dix + qky*diy + qkz*diz + sc(9) = qix*qkx + qiy*qky + qiz*qkz + sc(10) = 2.0d0*(qixy*qkxy+qixz*qkxz+qiyz*qkyz) + & + qixx*qkxx + qiyy*qkyy + qizz*qkzz +c +c calculate the scalar products for polarization components +c + sci(2) = uix*dkx + dix*ukx + uiy*dky + & + diy*uky + uiz*dkz + diz*ukz + sci(3) = uix*xr + uiy*yr + uiz*zr + sci(4) = ukx*xr + uky*yr + ukz*zr + sci(7) = qix*ukx + qiy*uky + qiz*ukz + sci(8) = qkx*uix + qky*uiy + qkz*uiz +c +c calculate the gl functions for permanent multipoles +c + gl(0) = ci*ck + gl(1) = ck*sc(3) - ci*sc(4) + sc(2) + gl(2) = ci*sc(6) + ck*sc(5) - sc(3)*sc(4) + & + 2.0d0*(sc(7)-sc(8)+sc(10)) + gl(3) = sc(3)*sc(6) - sc(4)*sc(5) - 4.0d0*sc(9) + gl(4) = sc(5)*sc(6) +c +c calculate the gl functions for polarization components +c + gli(1) = ck*sci(3) - ci*sci(4) + sci(2) + gli(2) = 2.0d0*(sci(7)-sci(8)) - sci(3)*sc(4) + & - sc(3)*sci(4) + gli(3) = sci(3)*sc(6) - sci(4)*sc(5) +c +c compute the energy contributions for this interaction +c + rr1 = 1.0d0 / r + rr3 = rr1 / r2 + rr5 = 3.0d0 * rr3 / r2 + rr7 = 5.0d0 * rr5 / r2 + rr9 = 7.0d0 * rr7 / r2 + scale3 = 1.0d0 + scale5 = 1.0d0 + scale7 = 1.0d0 + damp = pdi * pdamp(k) + if (damp .ne. 0.0d0) then + pgamma = min(pti,thole(k)) + damp = -pgamma * (r/damp)**3 + if (damp .gt. -50.0d0) then + expdamp = exp(damp) + scale3 = 1.0d0 - expdamp + scale5 = 1.0d0 - (1.0d0-damp)*expdamp + scale7 = 1.0d0 - (1.0d0-damp+0.6d0*damp**2) + & *expdamp + end if + end if + e = gl(0)*rr1 + gl(1)*rr3 + gl(2)*rr5 + & + gl(3)*rr7 + gl(4)*rr9 + ei = gli(1)*rr3*scale3 + gli(2)*rr5*scale5 + & + gli(3)*rr7*scale7 +c +c apply the energy adjustments for scaled interactions +c + fm = f * mscale(kk) + fp = f * pscale(kk) + e = fm * e + ei = 0.5d0 * fp * ei +c +c scale the interaction based on its group membership; +c polarization cannot be group scaled as it is not pairwise +c + if (use_group) then + e = e * fgrp +c ei = ei * fgrp + end if +c +c increment the overall multipole and polarization energies +c + muse = (use_mpole .and. mscale(kk).ne.0.0d0) + puse = (use_polar .and. pscale(kk).ne.0.0d0) + if (muse) nem = nem - 1 + if (puse) nep = nep - 1 + em = em - e + ep = ep - ei + aem(ii) = aem(ii) - 0.5d0*e + aem(kk) = aem(kk) - 0.5d0*e + aep(ii) = aep(ii) - 0.5d0*ei + aep(kk) = aep(kk) - 0.5d0*ei +c +c increment the total intermolecular energy +c + if (molcule(ii) .ne. molcule(kk)) then + einter = einter - e - ei + end if +c +c print a message if the energy of this interaction is large +c + huge = (max(abs(e),abs(ei)) .gt. 100.0d0) + if (debug .or. (verbose.and.huge)) then + if (muse .or. puse) then + if (header) then + header = .false. + write (iout,10) + 10 format (/,' Removing Multipole and', + & ' Polarization Interactions :', + & //,' Type',14x,'Atom Names', + & 15x,'Distance',6x,'Energies', + & ' (MPol,Polar)',/) + end if + write (iout,20) ii,name(ii),kk,name(kk),r,e,ei + 20 format (' M-Pole',4x,2(i7,'-',a3),9x, + & f10.4,2x,2f12.4) + end if + end if + end if + end if + end do +c +c reset interaction scaling coefficients for connected atoms +c +cqmmm + do j = 1, n + mscale(j) = 1.0d0 + pscale(j) = 1.0d0 + end do + do j = 1, n12(ii) + mscale(i12(j,ii)) = 1.0d0 + pscale(i12(j,ii)) = 1.0d0 + end do + do j = 1, n13(ii) + mscale(i13(j,ii)) = 1.0d0 + pscale(i13(j,ii)) = 1.0d0 + end do + do j = 1, n14(ii) + mscale(i14(j,ii)) = 1.0d0 + pscale(i14(j,ii)) = 1.0d0 + end do + do j = 1, n15(ii) + mscale(i15(j,ii)) = 1.0d0 + pscale(i15(j,ii)) = 1.0d0 + end do + end do +c +c for periodic boundary conditions with large cutoffs +c neighbors must be found by the replicates method +c + if (.not. use_replica) return +c +c calculate interaction energy with other unit cells +c + do i = 1, npole + ii = ipole(i) + iz = zaxis(i) + ix = xaxis(i) + iy = yaxis(k) + pdi = pdamp(i) + pti = thole(i) + usei = (use(ii) .or. use(iz) .or. use(ix) .or. use(iy)) + ci = rpole(1,i) + dix = rpole(2,i) + diy = rpole(3,i) + diz = rpole(4,i) + qixx = rpole(5,i) + qixy = rpole(6,i) + qixz = rpole(7,i) + qiyy = rpole(9,i) + qiyz = rpole(10,i) + qizz = rpole(13,i) + uix = uind(1,i) + uiy = uind(2,i) + uiz = uind(3,i) +c +c set interaction scaling coefficients for connected atoms +c + do j = 1, n12(ii) + mscale(i12(j,ii)) = m2scale + pscale(i12(j,ii)) = p2scale + end do + do j = 1, n13(ii) + mscale(i13(j,ii)) = m3scale + pscale(i13(j,ii)) = p3scale + end do + do j = 1, n14(ii) + mscale(i14(j,ii)) = m4scale + pscale(i14(j,ii)) = p4scale + end do + do j = 1, n15(ii) + mscale(i15(j,ii)) = m5scale + pscale(i15(j,ii)) = p5scale + end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + if (iqmmm .eq. 0) goto 99 + do j = 1, n + jqmmm = mod(qmmm(j),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(j) = 1.0d0 + pscale(j) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(j) = mscale(j) * qmmmscale + pscale(j) = pscale(j) * qmmmscale + end if + end do +c +c decide whether to compute the current interaction +c + do k = i, npole + kk = ipole(k) + kz = zaxis(k) + kx = xaxis(k) + ky = yaxis(k) + usek = (use(kk) .or. use(kz) .or. use(kx) .or. use(ky)) + if (use_group) call groups (proceed,fgrp,ii,kk,0,0,0,0) + proceed = .true. + if (proceed) proceed = (usei .or. usek) +c +c compute the energy contribution for this interaction +c + if (proceed) then + do j = 1, ncell + xr = x(kk) - x(ii) + yr = y(kk) - y(ii) + zr = z(kk) - z(ii) + call imager (xr,yr,zr,j) + r2 = xr*xr + yr* yr + zr*zr + if (r2 .le. off2) then + r = sqrt(r2) + ck = rpole(1,k) + dkx = rpole(2,k) + dky = rpole(3,k) + dkz = rpole(4,k) + qkxx = rpole(5,k) + qkxy = rpole(6,k) + qkxz = rpole(7,k) + qkyy = rpole(9,k) + qkyz = rpole(10,k) + qkzz = rpole(13,k) + ukx = uind(1,k) + uky = uind(2,k) + ukz = uind(3,k) +c +c construct some intermediate quadrupole values +c + qix = qixx*xr + qixy*yr + qixz*zr + qiy = qixy*xr + qiyy*yr + qiyz*zr + qiz = qixz*xr + qiyz*yr + qizz*zr + qkx = qkxx*xr + qkxy*yr + qkxz*zr + qky = qkxy*xr + qkyy*yr + qkyz*zr + qkz = qkxz*xr + qkyz*yr + qkzz*zr +c +c calculate the scalar products for permanent multipoles +c + sc(2) = dix*dkx + diy*dky + diz*dkz + sc(3) = dix*xr + diy*yr + diz*zr + sc(4) = dkx*xr + dky*yr + dkz*zr + sc(5) = qix*xr + qiy*yr + qiz*zr + sc(6) = qkx*xr + qky*yr + qkz*zr + sc(7) = qix*dkx + qiy*dky + qiz*dkz + sc(8) = qkx*dix + qky*diy + qkz*diz + sc(9) = qix*qkx + qiy*qky + qiz*qkz + sc(10) = 2.0d0*(qixy*qkxy+qixz*qkxz+qiyz*qkyz) + & + qixx*qkxx + qiyy*qkyy + qizz*qkzz +c +c calculate the scalar products for polarization components +c + sci(2) = uix*dkx + dix*ukx + uiy*dky + & + diy*uky + uiz*dkz + diz*ukz + sci(3) = uix*xr + uiy*yr + uiz*zr + sci(4) = ukx*xr + uky*yr + ukz*zr + sci(7) = qix*ukx + qiy*uky + qiz*ukz + sci(8) = qkx*uix + qky*uiy + qkz*uiz +c +c calculate the gl functions for permanent multipoles +c + gl(0) = ci*ck + gl(1) = ck*sc(3) - ci*sc(4) + sc(2) + gl(2) = ci*sc(6) + ck*sc(5) - sc(3)*sc(4) + & + 2.0d0*(sc(7)-sc(8)+sc(10)) + gl(3) = sc(3)*sc(6) - sc(4)*sc(5) - 4.0d0*sc(9) + gl(4) = sc(5)*sc(6) +c +c calculate the gl functions for polarization components +c + gli(1) = ck*sci(3) - ci*sci(4) + sci(2) + gli(2) = 2.0d0*(sci(7)-sci(8)) - sci(3)*sc(4) + & - sc(3)*sci(4) + gli(3) = sci(3)*sc(6) - sci(4)*sc(5) +c +c compute the energy contributions for this interaction +c + rr1 = 1.0d0 / r + rr3 = rr1 / r2 + rr5 = 3.0d0 * rr3 / r2 + rr7 = 5.0d0 * rr5 / r2 + rr9 = 7.0d0 * rr7 / r2 + scale3 = 1.0d0 + scale5 = 1.0d0 + scale7 = 1.0d0 + damp = pdi * pdamp(k) + if (damp .ne. 0.0d0) then + pgamma = min(pti,thole(k)) + damp = -pgamma * (r/damp)**3 + if (damp .gt. -50.0d0) then + expdamp = exp(damp) + scale3 = 1.0d0 - expdamp + scale5 = 1.0d0 - (1.0d0-damp)*expdamp + scale7 = 1.0d0 - (1.0d0-damp+0.6d0*damp**2) + & *expdamp + end if + end if + e = gl(0)*rr1 + gl(1)*rr3 + gl(2)*rr5 + & + gl(3)*rr7 + gl(4)*rr9 + ei = gli(1)*rr3*scale3 + gli(2)*rr5*scale5 + & + gli(3)*rr7*scale7 +c +c apply the energy adjustments for scaled interactions +c + fm = f + fp = f + if (use_polymer) then + if (r2 .le. polycut2) then + fm = fm * mscale(kk) + fp = fp * pscale(kk) + end if + end if + e = fm * e + ei = 0.5d0 * fp * ei +c +c scale the interaction based on its group membership; +c polarization cannot be group scaled as it is not pairwise +c + if (use_group) then + e = e * fgrp +c ei = ei * fgrp + end if +c +c increment the overall multipole and polarization energies +c + if (ii .eq. kk) then + e = 0.5d0 * e + ei = 0.5d0 * ei + end if + nem = nem - 1 + nep = nep - 1 + em = em - e + ep = ep - ei + aem(ii) = aem(ii) - 0.5d0*e + aem(kk) = aem(kk) - 0.5d0*e + aep(ii) = aep(ii) - 0.5d0*ei + aep(kk) = aep(kk) - 0.5d0*ei +c +c increment the total intermolecular energy +c + einter = einter - e - ei +c +c print a message if the energy of this interaction is large +c + huge = (max(abs(e),abs(ei)) .gt. 100.0d0) + if (debug .or. (verbose.and.huge)) then + if (header) then + header = .false. + write (iout,30) + 30 format (/,' Removing Multipole and', + & ' Polarization Interactions :', + & //,' Type',14x,'Atom Names', + & 15x,'Distance',6x,'Energies', + & ' (MPol,Polar)',/) + end if + write (iout,40) ii,name(ii),kk,name(kk),r,e,ei + 40 format (' M-Pole',4x,2(i7,'-',a3),1x, + & '(X)',5x,f10.4,2x,2f12.4) + end if + end if + end do + end if + end do +c +c reset interaction scaling coefficients for connected atoms +c +cqmmm + do j = 1, n + mscale(j) = 1.0d0 + pscale(j) = 1.0d0 + end do + do j = 1, n12(ii) + mscale(i12(j,ii)) = 1.0d0 + pscale(i12(j,ii)) = 1.0d0 + end do + do j = 1, n13(ii) + mscale(i13(j,ii)) = 1.0d0 + pscale(i13(j,ii)) = 1.0d0 + end do + do j = 1, n14(ii) + mscale(i14(j,ii)) = 1.0d0 + pscale(i14(j,ii)) = 1.0d0 + end do + do j = 1, n15(ii) + mscale(i15(j,ii)) = 1.0d0 + pscale(i15(j,ii)) = 1.0d0 + end do +cqmmm + 99 continue + end do +c +c perform deallocation of some local arrays +c + deallocate (mscale) + deallocate (pscale) + return + end + diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/empole.f 6.3.3/source/empole.f --- 6.3.3/source_orig/empole.f 2015-04-14 13:58:10.106343730 +0200 +++ 6.3.3/source/empole.f 2015-04-15 13:48:53.572041221 +0200 @@ -21,6 +21,9 @@ include 'cutoff.i' include 'energi.i' include 'potent.i' +cqmmm + include 'sizes.i' + include 'qmmm.i' c c c choose the method for summing over multipole interactions @@ -38,6 +41,8 @@ call empole0a end if end if +cqmmm + if (nbinqm .ne. 0 .and. e4qmmm .eq. 0) call empole0qmmm c c zero out potential energies which are not in use c @@ -106,6 +111,9 @@ real*8, allocatable :: pscale(:) logical proceed,usei,usek character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the multipole and polarization energies @@ -190,6 +198,22 @@ mscale(i15(j,ii)) = m5scale pscale(i15(j,ii)) = p5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = i+1, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(j)) = mscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + end if + end do c c decide whether to compute the current interaction c @@ -327,6 +351,11 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = i+1, npole + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 @@ -392,6 +421,22 @@ mscale(i15(j,ii)) = m5scale pscale(i15(j,ii)) = p5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = i, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(j)) = mscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + end if + end do c c decide whether to compute the current interaction c @@ -540,6 +585,11 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = i, npole + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 @@ -625,6 +675,9 @@ real*8, allocatable :: pscale(:) logical proceed,usei,usek character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the multipole and polarization energies @@ -709,6 +762,24 @@ mscale(i15(j,ii)) = m5scale pscale(i15(j,ii)) = p5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = 1, nelst(i) + jqmmm = mod(qmmm(ipole(elst(j,i))),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(elst(j,i))) = 1.0d0 + pscale(ipole(elst(j,i))) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(elst(j,i))) = mscale(ipole(elst(j,i))) + & * qmmmscale + pscale(ipole(elst(j,i))) = pscale(ipole(elst(j,i))) + & * qmmmscale + end if + end do c c decide whether to compute the current interaction c @@ -847,6 +918,11 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = 1, nelst(i) + mscale(ipole(elst(j,i))) = 1.0d0 + pscale(ipole(elst(j,i))) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 @@ -1064,6 +1140,9 @@ real*8, allocatable :: pscale(:) character*6 mode external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c perform dynamic allocation of some local arrays @@ -1127,6 +1206,22 @@ mscale(i15(j,ii)) = m5scale pscale(i15(j,ii)) = p5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = i+1, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(j)) = mscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + end if + end do do k = i+1, npole kk = ipole(k) xr = x(kk) - x(ii) @@ -1262,6 +1357,11 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = i+1, npole + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 @@ -1323,6 +1423,22 @@ mscale(i15(j,ii)) = m5scale pscale(i15(j,ii)) = p5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = i, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(j)) = mscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + end if + end do do k = i, npole kk = ipole(k) do j = 1, ncell @@ -1470,6 +1586,11 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = i, npole + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 @@ -1688,6 +1809,9 @@ real*8, allocatable :: pscale(:) character*6 mode external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c perform dynamic allocation of some local arrays @@ -1769,6 +1893,24 @@ mscale(i15(j,ii)) = m5scale pscale(i15(j,ii)) = p5scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = 1, nelst(i) + jqmmm = mod(qmmm(ipole(elst(j,i))),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(elst(j,i))) = 1.0d0 + pscale(ipole(elst(j,i))) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(elst(j,i))) = mscale(ipole(elst(j,i))) + & * qmmmscale + pscale(ipole(elst(j,i))) = pscale(ipole(elst(j,i))) + & * qmmmscale + end if + end do do kkk = 1, nelst(i) k = elst(kkk,i) kk = ipole(k) @@ -1905,6 +2047,11 @@ c c reset interaction scaling coefficients for connected atoms c +cqmmm + do j = 1, nelst(i) + mscale(ipole(elst(j,i))) = 1.0d0 + pscale(ipole(elst(j,i))) = 1.0d0 + end do do j = 1, n12(ii) mscale(i12(j,ii)) = 1.0d0 pscale(i12(j,ii)) = 1.0d0 @@ -2147,3 +2294,572 @@ deallocate (fphi) return end +c +c +c ##################################################### +c ## ## +c ## subroutine empole0qmmm -- QM/MM corrections ## +c ## ## +c ##################################################### +c +c +c "empole0qmmm" corrects the atomic multipole and dipole +c polarizability interaction energy using a double loop +c only MM-MM, MM-Y and Y-Y interactions must be retained +c +c + subroutine empole0qmmm + implicit none + include 'sizes.i' + include 'atoms.i' + include 'bound.i' + include 'boxes.i' + include 'cell.i' + include 'chgpot.i' + include 'couple.i' + include 'energi.i' + include 'group.i' + include 'math.i' + include 'mplpot.i' + include 'mpole.i' + include 'polar.i' + include 'polgrp.i' + include 'polpot.i' + include 'shunt.i' + include 'usage.i' + integer i,j,k + integer ii,kk + integer ix,iy,iz + integer kx,ky,kz + real*8 e,ei,fgrp + real*8 f,fm,fp + real*8 r,r2,xr,yr,zr + real*8 damp,expdamp + real*8 pdi,pti,pgamma + real*8 rr1,rr3,rr5 + real*8 rr7,rr9 + real*8 ci,dix,diy,diz + real*8 uix,uiy,uiz + real*8 qixx,qixy,qixz + real*8 qiyy,qiyz,qizz + real*8 ck,dkx,dky,dkz + real*8 ukx,uky,ukz + real*8 qkxx,qkxy,qkxz + real*8 qkyy,qkyz,qkzz + real*8 qix,qiy,qiz + real*8 qkx,qky,qkz + real*8 scale3,scale5 + real*8 scale7 + real*8 sc(10),sci(8) + real*8 gl(0:4),gli(3) + real*8, allocatable :: mscale(:) + real*8, allocatable :: pscale(:) + logical proceed,usei,usek + character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm,kqmmm,ikqmmm +c +c +c check the sign of multipole components at chiral sites +c + call chkpole +c +c rotate the multipole components into the global frame +c + call rotpole +c +c compute the induced dipoles at each polarizable atom +c + call induce +c +c perform dynamic allocation of some local arrays +c + allocate (mscale(n)) + allocate (pscale(n)) +c +c set arrays needed to scale connected atom interactions +c + if (npole .eq. 0) return + do i = 1, n + mscale(i) = 1.0d0 + pscale(i) = 1.0d0 + end do +c +c set conversion factor, cutoff and switching coefficients +c + f = electric / dielec + mode = 'MPOLE' + call switch (mode) +c +c calculate the multipole interaction energy term +c + do i = 1, npole-1 + ii = ipole(i) + iz = zaxis(i) + ix = xaxis(i) + iy = yaxis(i) + pdi = pdamp(i) + pti = thole(i) + ci = rpole(1,i) + dix = rpole(2,i) + diy = rpole(3,i) + diz = rpole(4,i) + qixx = rpole(5,i) + qixy = rpole(6,i) + qixz = rpole(7,i) + qiyy = rpole(9,i) + qiyz = rpole(10,i) + qizz = rpole(13,i) + uix = uind(1,i) + uiy = uind(2,i) + uiz = uind(3,i) + usei = (use(ii) .or. use(iz) .or. use(ix) .or. use(iy)) +c +c set interaction scaling coefficients for connected atoms +c + do j = 1, n12(ii) + mscale(i12(j,ii)) = m2scale + pscale(i12(j,ii)) = p2scale + end do + do j = 1, n13(ii) + mscale(i13(j,ii)) = m3scale + pscale(i13(j,ii)) = p3scale + end do + do j = 1, n14(ii) + mscale(i14(j,ii)) = m4scale + pscale(i14(j,ii)) = p4scale + do k = 1, np11(ii) + if (i14(j,ii) .eq. ip11(k,ii)) + & pscale(i14(j,ii)) = p4scale * p41scale + end do + end do + do j = 1, n15(ii) + mscale(i15(j,ii)) = m5scale + pscale(i15(j,ii)) = p5scale + end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = i+1, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(j)) = mscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + end if + end do +c +c decide whether to compute the current interaction +c + do k = i+1, npole + kk = ipole(k) + kz = zaxis(k) + kx = xaxis(k) + ky = yaxis(k) + usek = (use(kk) .or. use(kz) .or. use(kx) .or. use(ky)) +cqmmm + kqmmm = mod(qmmm(kk),3) + ikqmmm = iqmmm + kqmmm + proceed = .true. + if (use_group) call groups (proceed,fgrp,ii,kk,0,0,0,0) + if (.not. use_intra) proceed = .true. + if (proceed) proceed = (usei .or. usek) +cqmmm + if (proceed) proceed = (ikqmmm .ne. 0) +c +c compute the energy contribution for this interaction +c + if (proceed) then + xr = x(kk) - x(ii) + yr = y(kk) - y(ii) + zr = z(kk) - z(ii) + if (use_bounds) call image (xr,yr,zr) + r2 = xr*xr + yr* yr + zr*zr + if (r2 .le. off2) then + r = sqrt(r2) + ck = rpole(1,k) + dkx = rpole(2,k) + dky = rpole(3,k) + dkz = rpole(4,k) + qkxx = rpole(5,k) + qkxy = rpole(6,k) + qkxz = rpole(7,k) + qkyy = rpole(9,k) + qkyz = rpole(10,k) + qkzz = rpole(13,k) + ukx = uind(1,k) + uky = uind(2,k) + ukz = uind(3,k) +c +c construct some intermediate quadrupole values +c + qix = qixx*xr + qixy*yr + qixz*zr + qiy = qixy*xr + qiyy*yr + qiyz*zr + qiz = qixz*xr + qiyz*yr + qizz*zr + qkx = qkxx*xr + qkxy*yr + qkxz*zr + qky = qkxy*xr + qkyy*yr + qkyz*zr + qkz = qkxz*xr + qkyz*yr + qkzz*zr +c +c calculate the scalar products for permanent multipoles +c + sc(2) = dix*dkx + diy*dky + diz*dkz + sc(3) = dix*xr + diy*yr + diz*zr + sc(4) = dkx*xr + dky*yr + dkz*zr + sc(5) = qix*xr + qiy*yr + qiz*zr + sc(6) = qkx*xr + qky*yr + qkz*zr + sc(7) = qix*dkx + qiy*dky + qiz*dkz + sc(8) = qkx*dix + qky*diy + qkz*diz + sc(9) = qix*qkx + qiy*qky + qiz*qkz + sc(10) = 2.0d0*(qixy*qkxy+qixz*qkxz+qiyz*qkyz) + & + qixx*qkxx + qiyy*qkyy + qizz*qkzz +c +c calculate the scalar products for polarization components +c + sci(2) = uix*dkx + dix*ukx + uiy*dky + & + diy*uky + uiz*dkz + diz*ukz + sci(3) = uix*xr + uiy*yr + uiz*zr + sci(4) = ukx*xr + uky*yr + ukz*zr + sci(7) = qix*ukx + qiy*uky + qiz*ukz + sci(8) = qkx*uix + qky*uiy + qkz*uiz +c +c calculate the gl functions for permanent multipoles +c + gl(0) = ci*ck + gl(1) = ck*sc(3) - ci*sc(4) + sc(2) + gl(2) = ci*sc(6) + ck*sc(5) - sc(3)*sc(4) + & + 2.0d0*(sc(7)-sc(8)+sc(10)) + gl(3) = sc(3)*sc(6) - sc(4)*sc(5) - 4.0d0*sc(9) + gl(4) = sc(5)*sc(6) +c +c calculate the gl functions for polarization components +c + gli(1) = ck*sci(3) - ci*sci(4) + sci(2) + gli(2) = 2.0d0*(sci(7)-sci(8)) - sci(3)*sc(4) + & - sc(3)*sci(4) + gli(3) = sci(3)*sc(6) - sci(4)*sc(5) +c +c compute the energy contributions for this interaction +c + rr1 = 1.0d0 / r + rr3 = rr1 / r2 + rr5 = 3.0d0 * rr3 / r2 + rr7 = 5.0d0 * rr5 / r2 + rr9 = 7.0d0 * rr7 / r2 + scale3 = 1.0d0 + scale5 = 1.0d0 + scale7 = 1.0d0 + damp = pdi * pdamp(k) + if (damp .ne. 0.0d0) then + pgamma = min(pti,thole(k)) + damp = -pgamma * (r/damp)**3 + if (damp .gt. -50.0d0) then + expdamp = exp(damp) + scale3 = 1.0d0 - expdamp + scale5 = 1.0d0 - (1.0d0-damp)*expdamp + scale7 = 1.0d0 - (1.0d0-damp+0.6d0*damp**2) + & *expdamp + end if + end if + e = gl(0)*rr1 + gl(1)*rr3 + gl(2)*rr5 + & + gl(3)*rr7 + gl(4)*rr9 + ei = gli(1)*rr3*scale3 + gli(2)*rr5*scale5 + & + gli(3)*rr7*scale7 +c +c apply the energy adjustments for scaled interactions +c + fm = f * mscale(kk) + fp = f * pscale(kk) + e = fm * e + ei = 0.5d0 * fp * ei +c +c scale the interaction based on its group membership; +c polarization cannot be group scaled as it is not pairwise +c + if (use_group) then + e = e * fgrp +c ei = ei * fgrp + end if +c +c increment the overall multipole and polarization energies +c + em = em - e + ep = ep - ei + end if + end if + end do +c +c reset interaction scaling coefficients for connected atoms +c +cqmmm + do j = i+1, npole + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end do + do j = 1, n12(ii) + mscale(i12(j,ii)) = 1.0d0 + pscale(i12(j,ii)) = 1.0d0 + end do + do j = 1, n13(ii) + mscale(i13(j,ii)) = 1.0d0 + pscale(i13(j,ii)) = 1.0d0 + end do + do j = 1, n14(ii) + mscale(i14(j,ii)) = 1.0d0 + pscale(i14(j,ii)) = 1.0d0 + end do + do j = 1, n15(ii) + mscale(i15(j,ii)) = 1.0d0 + pscale(i15(j,ii)) = 1.0d0 + end do + end do +c +c for periodic boundary conditions with large cutoffs +c neighbors must be found by the replicates method +c + if (.not. use_replica) return +c +c calculate interaction energy with other unit cells +c + do i = 1, npole + ii = ipole(i) + iz = zaxis(i) + ix = xaxis(i) + iy = yaxis(i) + pdi = pdamp(i) + pti = thole(i) + ci = rpole(1,i) + dix = rpole(2,i) + diy = rpole(3,i) + diz = rpole(4,i) + qixx = rpole(5,i) + qixy = rpole(6,i) + qixz = rpole(7,i) + qiyy = rpole(9,i) + qiyz = rpole(10,i) + qizz = rpole(13,i) + uix = uind(1,i) + uiy = uind(2,i) + uiz = uind(3,i) + usei = (use(ii) .or. use(iz) .or. use(ix) .or. use(iy)) +c +c set interaction scaling coefficients for connected atoms +c + do j = 1, n12(ii) + mscale(i12(j,ii)) = m2scale + pscale(i12(j,ii)) = p2scale + end do + do j = 1, n13(ii) + mscale(i13(j,ii)) = m3scale + pscale(i13(j,ii)) = p3scale + end do + do j = 1, n14(ii) + mscale(i14(j,ii)) = m4scale + pscale(i14(j,ii)) = p4scale + end do + do j = 1, n15(ii) + mscale(i15(j,ii)) = m5scale + pscale(i15(j,ii)) = p5scale + end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + if (iqmmm .eq. 0) goto 99 + do j = i, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + mscale(ipole(j)) = mscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + end if + end do +c +c decide whether to compute the current interaction +c + do k = i, npole + kk = ipole(k) + kz = zaxis(k) + kx = xaxis(k) + ky = yaxis(k) + usek = (use(kk) .or. use(kz) .or. use(kx) .or. use(ky)) + if (use_group) call groups (proceed,fgrp,ii,kk,0,0,0,0) + proceed = .true. + if (proceed) proceed = (usei .or. usek) +c +c compute the energy contribution for this interaction +c + if (proceed) then + do j = 1, ncell + xr = x(kk) - x(ii) + yr = y(kk) - y(ii) + zr = z(kk) - z(ii) + call imager (xr,yr,zr,j) + r2 = xr*xr + yr* yr + zr*zr + if (r2 .le. off2) then + r = sqrt(r2) + ck = rpole(1,k) + dkx = rpole(2,k) + dky = rpole(3,k) + dkz = rpole(4,k) + qkxx = rpole(5,k) + qkxy = rpole(6,k) + qkxz = rpole(7,k) + qkyy = rpole(9,k) + qkyz = rpole(10,k) + qkzz = rpole(13,k) + ukx = uind(1,k) + uky = uind(2,k) + ukz = uind(3,k) +c +c construct some intermediate quadrupole values +c + qix = qixx*xr + qixy*yr + qixz*zr + qiy = qixy*xr + qiyy*yr + qiyz*zr + qiz = qixz*xr + qiyz*yr + qizz*zr + qkx = qkxx*xr + qkxy*yr + qkxz*zr + qky = qkxy*xr + qkyy*yr + qkyz*zr + qkz = qkxz*xr + qkyz*yr + qkzz*zr +c +c calculate the scalar products for permanent multipoles +c + sc(2) = dix*dkx + diy*dky + diz*dkz + sc(3) = dix*xr + diy*yr + diz*zr + sc(4) = dkx*xr + dky*yr + dkz*zr + sc(5) = qix*xr + qiy*yr + qiz*zr + sc(6) = qkx*xr + qky*yr + qkz*zr + sc(7) = qix*dkx + qiy*dky + qiz*dkz + sc(8) = qkx*dix + qky*diy + qkz*diz + sc(9) = qix*qkx + qiy*qky + qiz*qkz + sc(10) = 2.0d0*(qixy*qkxy+qixz*qkxz+qiyz*qkyz) + & + qixx*qkxx + qiyy*qkyy + qizz*qkzz +c +c calculate the scalar products for polarization components +c + sci(2) = uix*dkx + dix*ukx + uiy*dky + & + diy*uky + uiz*dkz + diz*ukz + sci(3) = uix*xr + uiy*yr + uiz*zr + sci(4) = ukx*xr + uky*yr + ukz*zr + sci(7) = qix*ukx + qiy*uky + qiz*ukz + sci(8) = qkx*uix + qky*uiy + qkz*uiz +c +c calculate the gl functions for permanent multipoles +c + gl(0) = ci*ck + gl(1) = ck*sc(3) - ci*sc(4) + sc(2) + gl(2) = ci*sc(6) + ck*sc(5) - sc(3)*sc(4) + & + 2.0d0*(sc(7)-sc(8)+sc(10)) + gl(3) = sc(3)*sc(6) - sc(4)*sc(5) - 4.0d0*sc(9) + gl(4) = sc(5)*sc(6) +c +c calculate the gl functions for polarization components +c + gli(1) = ck*sci(3) - ci*sci(4) + sci(2) + gli(2) = 2.0d0*(sci(7)-sci(8)) - sci(3)*sc(4) + & - sc(3)*sci(4) + gli(3) = sci(3)*sc(6) - sci(4)*sc(5) +c +c compute the energy contributions for this interaction +c + rr1 = 1.0d0 / r + rr3 = rr1 / r2 + rr5 = 3.0d0 * rr3 / r2 + rr7 = 5.0d0 * rr5 / r2 + rr9 = 7.0d0 * rr7 / r2 + scale3 = 1.0d0 + scale5 = 1.0d0 + scale7 = 1.0d0 + damp = pdi * pdamp(k) + if (damp .ne. 0.0d0) then + pgamma = min(pti,thole(k)) + damp = -pgamma * (r/damp)**3 + if (damp .gt. -50.0d0) then + expdamp = exp(damp) + scale3 = 1.0d0 - expdamp + scale5 = 1.0d0 - (1.0d0-damp)*expdamp + scale7 = 1.0d0 - (1.0d0-damp+0.6d0*damp**2) + & *expdamp + end if + end if + e = gl(0)*rr1 + gl(1)*rr3 + gl(2)*rr5 + & + gl(3)*rr7 + gl(4)*rr9 + ei = gli(1)*rr3*scale3 + gli(2)*rr5*scale5 + & + gli(3)*rr7*scale7 +c +c apply the energy adjustments for scaled interactions +c + fm = f + fp = f + if (use_polymer) then + if (r2 .le. polycut2) then + fm = fm * mscale(kk) + fp = fp * pscale(kk) + end if + end if + e = fm * e + ei = 0.5d0 * fp * ei +c +c scale the interaction based on its group membership; +c polarization cannot be group scaled as it is not pairwise +c + if (use_group) then + e = e * fgrp +c ei = ei * fgrp + end if +c +c increment the overall multipole and polarization energies +c + if (ii .eq. kk) then + e = 0.5d0 * e + ei = 0.5d0 * ei + end if + em = em - e + ep = ep - ei + end if + end do + end if + end do +c +c reset interaction scaling coefficients for connected atoms +c +cqmmm + do j = i, npole + mscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end do + do j = 1, n12(ii) + mscale(i12(j,ii)) = 1.0d0 + pscale(i12(j,ii)) = 1.0d0 + end do + do j = 1, n13(ii) + mscale(i13(j,ii)) = 1.0d0 + pscale(i13(j,ii)) = 1.0d0 + end do + do j = 1, n14(ii) + mscale(i14(j,ii)) = 1.0d0 + pscale(i14(j,ii)) = 1.0d0 + end do + do j = 1, n15(ii) + mscale(i15(j,ii)) = 1.0d0 + pscale(i15(j,ii)) = 1.0d0 + end do +cqmmm + 99 continue + end do +c +c perform deallocation of some local arrays +c + deallocate (mscale) + deallocate (pscale) + return + end + diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/erxnfld3.f 6.3.3/source/erxnfld3.f --- 6.3.3/source_orig/erxnfld3.f 2015-04-14 13:58:10.110343730 +0200 +++ 6.3.3/source/erxnfld3.f 2015-04-15 13:48:53.588041221 +0200 @@ -47,6 +47,9 @@ logical usei,usek logical header,huge character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the reaction field energy and partitioning @@ -83,6 +86,8 @@ ix = xaxis(ii) iy = yaxis(ii) usei = (use(i) .or. use(iz) .or. use(ix) .or. use(iy)) +cqmmm + iqmmm = mod(qmmm(i),3) do j = 1, polsiz(ii) rpi(j) = rpole(j,ii) end do @@ -92,7 +97,11 @@ kx = xaxis(kk) ky = yaxis(kk) usek = (use(k) .or. use(kz) .or. use(kx) .or. use(ky)) - if (usei .or. usek) then +cqmmm + kqmmm = mod(qmmm(k),3) + ikqmmm = iqmmm + kqmmm +cqmmm if (usei .or. usek) then + if ((usei .or. usek) .and. ikqmmm .le. e4qmmm) then xr = x(k) - x(i) yr = y(k) - y(i) zr = z(k) - z(i) diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/erxnfld.f 6.3.3/source/erxnfld.f --- 6.3.3/source_orig/erxnfld.f 2015-04-14 13:58:10.106343730 +0200 +++ 6.3.3/source/erxnfld.f 2015-04-15 13:48:53.588041221 +0200 @@ -40,6 +40,9 @@ real*8 rpk(13) logical usei,usek character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,kqmmm,ikqmmm c c c zero out the macroscopic reaction field energy @@ -71,6 +74,8 @@ ix = xaxis(ii) iy = yaxis(ii) usei = (use(i) .or. use(iz) .or. use(ix) .or. use(iy)) +cqmmm + iqmmm = mod(qmmm(i),3) do j = 1, polsiz(ii) rpi(j) = rpole(j,ii) end do @@ -80,7 +85,11 @@ kx = xaxis(kk) ky = yaxis(kk) usek = (use(k) .or. use(kz) .or. use(kx) .or. use(ky)) - if (usei .or. usek) then +cqmmm + kqmmm = mod(qmmm(k),3) + ikqmmm = iqmmm + kqmmm +cqmmm if (usei .or. usek) then + if ((usei .or. usek) .and. ikqmmm .le. e4qmmm) then xr = x(k) - x(i) yr = y(k) - y(i) zr = z(k) - z(i) diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/extpot.f 6.3.3/source/extpot.f --- 6.3.3/source_orig/extpot.f 1970-01-01 01:00:00.000000000 +0100 +++ 6.3.3/source/extpot.f 2015-04-15 13:48:53.608041222 +0200 @@ -0,0 +1,88 @@ +cqmmm +c +c Determine the external potential generated by *ALL* the MM electrostatic sources +c - either by computing the electrostatic potential (and derivatives) generated by +c charges (elecpot) or permanent + induced multipoles (elecpol) +c - either by collecting their point charges +c + subroutine extpot(do_it,nComp,nCenter,QMMM_EP) + implicit none + include 'sizes.i' + include 'atoms.i' + include 'charge.i' + include 'inform.i' + include 'iounit.i' + include 'potent.i' + include 'qmmm.i' + integer do_it,nComp,nCenter,i,ii,j,k + real*8 QMMM_EP(nComp,nCenter) +c +c initialization +c + do i = 1, nComp + do j = 1, nCenter + QMMM_EP(i,j) = 0.0d0 + end do + end do + if (do_it .eq. -1) return +c +c compute the electrostatic potential generated by MM +c only if espf is used +c + if (doespf) then + write(iout,9) + & ' Tinker is computing the MM electrostatic potential' + 9 format(/,a) + do i = 1, n + j = atinqm(i) + if (j.ne.0 .and. qmmm(i).ne.0) then + if (dorunmd) then + QMMM_EP(1,j) = epavg(i) * qmmmscale + do k = 1, 3 + QMMM_EP(k+1,j) = epgavg(k,i) + QMMM_EP(k+4,j) = ephavg(k,i) + end do + if (nComp .eq. 10) then + do k = 4, 6 + QMMM_EP(k+4,j) = ephavg(k,i) + end do + end if + else if (use_charge) then + call elecpot(i,nComp,QMMM_EP(1,j)) + else if (use_chgdpl .or. use_dipole) then +c call elecpotd(i,nComp,QMMM_EP(1,j)) + else if (use_mpole .or. use_polar) then +c call elecpol(i,nComp,QMMM_EP(1,j)) + end if + if (verbose) then + write(iout,10) ' External potential on atom ',i + write(iout,11) ' V=',QMMM_EP(1,j) + write(iout,12) ' dV/dx=',QMMM_EP(2,j), + & ' dV/dy=',QMMM_EP(3,j), + & ' dV/dz=',QMMM_EP(4,j) + 10 format(/,a,i5) + 11 format(a10,f10.5) + 12 format(3(a10,f10.5)) + if (nComp .eq. 10) then + write(iout,12) ' d2V/dxdx=',QMMM_EP(5,j), + & ' d2V/dydy=',QMMM_EP(6,j), + & ' d2V/dzdz=',QMMM_EP(7,j) + write(iout,12) ' d2V/dxdy=',QMMM_EP(8,j), + & ' d2V/dxdz=',QMMM_EP(9,j), + & ' d2V/dydz=',QMMM_EP(10,j) + end if + end if + end if + end do + else + do ii = 1, nion + i = iion(ii) + QMMM_EP(1,ii) = x(i) + QMMM_EP(2,ii) = y(i) + QMMM_EP(3,ii) = z(i) + QMMM_EP(4,ii) = pchg(ii) * qmmmscale + if (mod(qmmm(i),3) .ne. 0) QMMM_EP(4,ii) = 0.0d0 + end do + end if + return + end diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/gradient.f 6.3.3/source/gradient.f --- 6.3.3/source_orig/gradient.f 2015-04-14 13:58:10.110343730 +0200 +++ 6.3.3/source/gradient.f 2015-04-15 13:48:53.628041222 +0200 @@ -33,6 +33,38 @@ integer i,j real*8 energy,cutoff real*8 derivs(3,*) +cqmmm + include 'qmmm.i' + include 'couple.i' + include 'inform.i' + integer imm,iqm,ilah + real*8 OMG,r1,r2 +c +cqmmm define the new position of the link atoms +c + if (doqmmmdyn) then + ilah = 0 + do i = 1, n + if (qmmm(i) .eq. 1) then + ilah = ilah + 1 + imm = i12(1,i) + iqm = i12(2,i) + if (lahg(ilah) .gt. 0.0d0) then + x(i) = x(iqm) + lahg(ilah) * (x(imm)-x(iqm)) + y(i) = y(iqm) + lahg(ilah) * (y(imm)-y(iqm)) + z(i) = z(iqm) + lahg(ilah) * (z(imm)-z(iqm)) + else + r1 = sqrt((x(i)-x(iqm))**2 + (y(i)-y(iqm))**2 + & + (z(i)-z(iqm))**2) + r2 = sqrt((x(imm)-x(iqm))**2 + (y(imm)-y(iqm))**2 + & + (z(imm)-z(iqm))**2) + lahg(ilah) = r1 / r2 + write(iout,20) i,lahg(ilah) +20 format(' GRADIENT -- LAH ',i5,' scaling factor:',F7.3) + end if + end if + end do + end if c c c zero out each of the potential energy components @@ -123,6 +155,13 @@ c if (use_orbit) call picalc c +cqmmm In case of a QM/MM job drived by Tinker, run the QM code +cqmmm and retrieve the energy and forces in ex/dex. +cqmmm Also retrieve the ESPF multipoles used to compute the +cqmmm electrostatic components of the MM gradient +c + if (doqmmmdyn) call runqm +c c call the local geometry energy and gradient routines c if (use_bond) call ebond1 @@ -162,7 +201,8 @@ if (use_solv) call esolv1 if (use_metal) call emetal1 if (use_geom) call egeom1 - if (use_extra) call extra1 +cqmmm if (use_extra) call extra1 + if (use_extra .and. .not.doqmmmdyn) call extra1 c c sum up to get the total energy and first derivatives c @@ -184,6 +224,29 @@ end do end do c +cqmmm +c apply the Jacobian to project out the forces +c acting on the link atoms +cqmmm +c + if (doqmmmdyn) then + ilah = 0 + do i = 1, n +c if (debug) write (iout,'(i5,3f12.5)') i,(derivs(j,i),j=1,3) + if (qmmm(i) .eq. 1) then + ilah = ilah + 1 + imm = i12(1,i) + iqm = i12(2,i) + OMG = (1.0d0-lahg(ilah)) + do j = 1, 3 + derivs(j,iqm) = derivs(j,iqm) + desum(j,i) * OMG + derivs(j,imm) = derivs(j,imm) + desum(j,i) * lahg(ilah) + derivs(j,i) = 0.0d0 + end do + end if + end do + end if +c c check for an illegal value for the total energy c if (isnan(esum)) then diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/induce.f 6.3.3/source/induce.f --- 6.3.3/source_orig/induce.f 2015-04-14 13:58:10.114343730 +0200 +++ 6.3.3/source/induce.f 2015-04-15 13:48:53.640041222 +0200 @@ -514,6 +514,9 @@ real*8 fieldp(3,*) logical proceed character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the value of the field at each site @@ -583,6 +586,22 @@ do j = 1, np14(ii) dscale(ip14(j,ii)) = d4scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = i+1, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + dscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + dscale(ipole(j)) = dscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + end if + end do do k = i+1, npole kk = ipole(k) proceed = .true. @@ -701,6 +720,22 @@ do j = 1, np14(ii) dscale(ip14(j,ii)) = d4scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = i+1, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + dscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + dscale(ipole(j)) = dscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + end if + end do do k = i, npole kk = ipole(k) ck = rpole(1,k) @@ -1107,6 +1142,9 @@ real*8 fieldp(3,*) logical proceed character*6 mode +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c zero out the value of the field at each site @@ -1176,6 +1214,24 @@ do j = 1, np14(ii) dscale(ip14(j,ii)) = d4scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = 1, nelst(i) + jqmmm = mod(qmmm(ipole(elst(j,i))),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + dscale(ipole(elst(j,i))) = 1.0d0 + pscale(ipole(elst(j,i))) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + dscale(ipole(elst(j,i))) = dscale(ipole(elst(j,i))) + & * qmmmscale + pscale(ipole(elst(j,i))) = pscale(ipole(elst(j,i))) + & * qmmmscale + end if + end do do kkk = 1, nelst(i) k = elst(kkk,i) kk = ipole(k) @@ -1815,6 +1871,9 @@ real*8 fieldp(3,*) character*6 mode external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c check for multipoles and set cutoff coefficients @@ -1882,6 +1941,22 @@ do j = 1, np14(ii) dscale(ip14(j,ii)) = d4scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = i+1, npole + jqmmm = mod(qmmm(ipole(j)),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + dscale(ipole(j)) = 1.0d0 + pscale(ipole(j)) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + dscale(ipole(j)) = dscale(ipole(j)) * qmmmscale + pscale(ipole(j)) = pscale(ipole(j)) * qmmmscale + end if + end do do k = i+1, npole kk = ipole(k) xr = x(kk) - x(ii) @@ -2017,6 +2092,11 @@ do j = 1, np14(ii) dscale(ip14(j,ii)) = 1.0d0 end do +cqmmm + do j = 1, n + pscale(j) = 1.0d0 + dscale(j) = 1.0d0 + end do end do c c periodic boundary for large cutoffs via replicates method @@ -2060,6 +2140,22 @@ do j = 1, np14(ii) dscale(ip14(j,ii)) = d4scale end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = 1, npole + jqmmm = mod(qmmm(j),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + dscale(j) = 1.0d0 + pscale(j) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + dscale(j) = dscale(j) * qmmmscale + pscale(j) = pscale(j) * qmmmscale + end if + end do do k = i, npole kk = ipole(k) ck = rpole(1,k) @@ -2215,6 +2311,11 @@ do j = 1, np14(ii) dscale(ip14(j,ii)) = 1.0d0 end do +cqmmm + do j = 1, n + pscale(j) = 1.0d0 + dscale(j) = 1.0d0 + end do end do end if c @@ -2294,6 +2395,9 @@ real*8, allocatable :: dlocal(:,:) character*6 mode external erfc +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c check for multipoles and set cutoff coefficients @@ -2399,7 +2503,27 @@ end do do j = 1, np14(ii) dscale(ip14(j,ii)) = d4scale - uscale(ip14(j,ii)) = u4scale + end do +cqmmm +c modify the interaction scaling coefficients for QM/MM +c + iqmmm = mod(qmmm(ii),3) + do j = 1, nelst(i) + jqmmm = mod(qmmm(ipole(elst(j,i))),3) + ijqmmm = iqmmm + jqmmm + if (.not. doespf .and. ijqmmm .ne. 0) then + pscale(ipole(elst(j,i))) = 1.0d0 + dscale(ipole(elst(j,i))) = 1.0d0 + uscale(ipole(elst(j,i))) = 1.0d0 + end if + if (ijqmmm .ne. 0) then + pscale(ipole(elst(j,i))) = pscale(ipole(elst(j,i))) + & * qmmmscale + dscale(ipole(elst(j,i))) = dscale(ipole(elst(j,i))) + & * qmmmscale + uscale(ipole(elst(j,i))) = dscale(ipole(elst(j,i))) + & * qmmmscale + end if end do do kkk = 1, nelst(i) k = elst(kkk,i) @@ -2557,6 +2681,12 @@ uscale(ip14(j,ii)) = 1.0d0 dscale(ip14(j,ii)) = 1.0d0 end do +cqmmm + do j = 1, nelst(i) + uscale(ipole(elst(j,i))) = 1.0d0 + dscale(ipole(elst(j,i))) = 1.0d0 + pscale(ipole(elst(j,i))) = 1.0d0 + end do end do !$OMP END DO c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/kangang.f 6.3.3/source/kangang.f --- 6.3.3/source_orig/kangang.f 2015-04-14 13:58:10.114343730 +0200 +++ 6.3.3/source/kangang.f 2015-04-15 13:48:53.648041222 +0200 @@ -77,7 +77,12 @@ c nangang = 0 do i = 1, n - nang = n12(i) * (n12(i)-1) / 2 +cqmmm nang = n12(i) * (n12(i)-1) / 2 +cqmmm + nang = 0 + do while (anglist(nang+1,i) .ne. 0) + nang = nang + 1 + end do it = class(i) do j = 1, nang-1 jang = anglist(j,i) diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/kcharge.f 6.3.3/source/kcharge.f --- 6.3.3/source_orig/kcharge.f 2015-04-14 13:58:10.114343730 +0200 +++ 6.3.3/source/kcharge.f 2015-04-15 13:48:53.652041222 +0200 @@ -38,6 +38,8 @@ character*20 keyword character*120 record character*120 string +cqmmm + include 'qmmm.i' c c c process keywords containing partial charge parameters @@ -122,14 +124,23 @@ c c remove zero partial charges from the list of charges c +cqmmm +c not true if QM/HLA/Y atoms +c nion = 0 do i = 1, n chglist(i) = 0 - if (pchg(i) .ne. 0.0d0) then +cqmmm if (pchg(i) .ne. 0.0d0) then + if (pchg(i) .ne. 0.0d0 .or. qmmm(i) .ne. 0) then nion = nion + 1 iion(nion) = i jion(nion) = i kion(nion) = i +cqmmm + if (qmmm(i) .eq. 1) then + jion(nion) = i12(1,i) + kion(nion) = i12(1,i) + end if pchg(nion) = pchg(i) chglist(i) = nion end if diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/kdipole.f 6.3.3/source/kdipole.f --- 6.3.3/source_orig/kdipole.f 2015-04-14 13:58:10.114343730 +0200 +++ 6.3.3/source/kdipole.f 2015-04-15 13:48:53.656041223 +0200 @@ -42,6 +42,9 @@ character*20 keyword character*120 record character*120 string +cqmmm + include 'qmmm.i' + integer i12qmmm c c c process keywords containing bond dipole parameters @@ -343,11 +346,15 @@ ndipole = 0 do i = 1, nbond if (bdpl(i) .ne. 0.0d0) then +cqmmm + i12qmmm = mod(qmmm(idpl(1,i)),3) + mod(qmmm(idpl(2,i)),3) + if (i12qmmm .ne. 0) goto 150 ndipole = ndipole + 1 idpl(1,ndipole) = idpl(1,i) idpl(2,ndipole) = idpl(2,i) bdpl(ndipole) = bdpl(i) sdpl(ndipole) = sdpl(i) + 150 continue end if end do c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/kimprop.f 6.3.3/source/kimprop.f --- 6.3.3/source_orig/kimprop.f 2015-04-14 13:58:10.114343730 +0200 +++ 6.3.3/source/kimprop.f 2015-04-15 13:48:53.660041223 +0200 @@ -43,6 +43,9 @@ character*20 keyword character*120 record character*120 string +cqmmm + include 'qmmm.i' + integer iaqmmm c c c process keywords containing improper dihedral parameters @@ -114,6 +117,9 @@ do i = 1, n if (n12(i) .eq. 3) then ia = i +cqmmm + iaqmmm = mod(qmmm(ia),3) + if (iaqmmm .ne. 0) goto 99 ib = i12(1,i) ic = i12(2,i) id = i12(3,i) @@ -275,6 +281,7 @@ end if end do end if +99 continue end if end do end if diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/kimptor.f 6.3.3/source/kimptor.f --- 6.3.3/source_orig/kimptor.f 2015-04-14 13:58:10.114343730 +0200 +++ 6.3.3/source/kimptor.f 2015-04-15 13:48:53.660041223 +0200 @@ -46,6 +46,9 @@ character*20 keyword character*120 record character*120 string +cqmmm + include 'qmmm.i' + integer icqmmm c c c process keywords containing improper torsion parameters @@ -127,6 +130,9 @@ ia = i12(1,i) ib = i12(2,i) ic = i +cqmmm + icqmmm = mod(qmmm(ic),3) + if (icqmmm .ne. 0) goto 99 id = i12(3,i) ita = class(ia) itb = class(ib) @@ -306,6 +312,7 @@ end if end do end if + 99 continue end if end do end if diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/kopbend.f 6.3.3/source/kopbend.f --- 6.3.3/source_orig/kopbend.f 2015-04-14 13:58:10.114343730 +0200 +++ 6.3.3/source/kopbend.f 2015-04-15 13:48:53.664041223 +0200 @@ -49,6 +49,9 @@ character*20 keyword character*120 record character*120 string +cqmmm + include 'qmmm.i' + integer abqmmm,bcqmmm c c c process keywords containing out-of-plane bend parameters @@ -153,6 +156,11 @@ itc = class(ic) id = iang(4,i) itd = class(id) +cqmmm + abqmmm = qmmm(ia) + qmmm(ib) + bcqmmm = qmmm(ib) + qmmm(ic) + if (abqmmm .ge. 4 .and. abqmmm.le. 5 + & .and. bcqmmm .ge. 4 .and. bcqmmm .le. 5) goto 70 size = 4 call numeral (ita,pa,size) call numeral (itb,pb,size) @@ -262,6 +270,9 @@ integer ittc,ittd character*4 pa,pb,pc,pd character*16 blank,pt +cqmmm + include 'qmmm.i' + integer abqmmm,bcqmmm c c c determine the total number of forcefield parameters @@ -281,6 +292,11 @@ ib = iang(2,i) ic = iang(3,i) id = iang(4,i) +cqmmm + abqmmm = qmmm(ia) + qmmm(ib) + bcqmmm = qmmm(ib) + qmmm(ic) + if (abqmmm .ge. 4 .and. abqmmm.le. 5 + & .and. bcqmmm .ge. 4 .and. bcqmmm .le. 5) goto 30 itta = type(ia) ittb = type(ib) ittc = type(ic) @@ -365,6 +381,8 @@ 20 continue end if end if +cqmmm + 30 continue end do end if c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/kopdist.f 6.3.3/source/kopdist.f --- 6.3.3/source_orig/kopdist.f 2015-04-14 13:58:10.114343730 +0200 +++ 6.3.3/source/kopdist.f 2015-04-15 13:48:53.664041223 +0200 @@ -46,6 +46,9 @@ character*20 keyword character*120 record character*120 string +cqmmm + include 'qmmm.i' + integer abqmmm,bcqmmm c c c process keywords containing out-of-plane distance parameters @@ -135,6 +138,11 @@ ib = i12(1,i) ic = i12(2,i) id = i12(3,i) +cqmmm + abqmmm = qmmm(ia) + qmmm(ib) + bcqmmm = qmmm(ib) + qmmm(ic) + if (abqmmm .ge. 4 .and. abqmmm.le. 5 + & .and. bcqmmm .ge. 4 .and. bcqmmm .le. 5) goto 70 ita = class(ia) itb = class(ib) itc = class(ic) @@ -189,6 +197,8 @@ end do 60 continue end if +cqmmm + 70 continue end do end if c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/kpolar.f 6.3.3/source/kpolar.f --- 6.3.3/source_orig/kpolar.f 2015-04-14 13:58:10.114343730 +0200 +++ 6.3.3/source/kpolar.f 2015-04-15 13:48:53.668041223 +0200 @@ -38,6 +38,9 @@ character*20 keyword character*120 record character*120 string +cqmmm + include 'qmmm.i' + integer iqmmm c c c process keywords containing polarizability parameters @@ -96,8 +99,16 @@ c find and store the atomic dipole polarizability parameters c do i = 1, n - polarity(i) = polr(type(i)) - thole(i) = athl(type(i)) +cqmmm +c polarity(i) = polr(type(i)) +c thole(i) = athl(type(i)) + if (qmmm(i).ne.0) then + polarity(i) = 0.0d0 + thole(i) = 0.0d0 + else + polarity(i) = polr(type(i)) + thole(i) = athl(type(i)) + end if end do c c process keywords containing atom specific polarizabilities @@ -175,6 +186,17 @@ c test multipoles at chiral sites and invert if necessary c call chkpole +cqmm +c zero out the values if it's not a MM or a Y atom +c + do i = 1, npole + iqmmm = mod(qmmm(ipole(i)),3) + if(iqmmm .ne. 0) then + do j = 1, maxpole + pole(j,i) = 0.0d0 + end do + end if + end do c c turn off polarizable multipole potential if it is not used c diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/kstrbnd.f 6.3.3/source/kstrbnd.f --- 6.3.3/source_orig/kstrbnd.f 2015-04-14 13:58:10.114343730 +0200 +++ 6.3.3/source/kstrbnd.f 2015-04-15 13:48:53.672041223 +0200 @@ -44,6 +44,9 @@ character*20 keyword character*120 record character*120 string +cqmmm + include 'qmmm.i' + integer abqmmm,bcqmmm c c c process keywords containing stretch-bend parameters @@ -125,6 +128,11 @@ ia = iang(1,i) ib = iang(2,i) ic = iang(3,i) +cqmmm + abqmmm = qmmm(ia) + qmmm(ib) + bcqmmm = qmmm(ib) + qmmm(ic) + if ((abqmmm .ge. 4 .and. abqmmm.le. 5) + & .or. (bcqmmm .ge. 4 .and. bcqmmm .le. 5)) goto 60 ita = class(ia) itb = class(ib) itc = class(ic) @@ -225,6 +233,9 @@ integer nb1,nb2 integer stbnt,ab,bc logical ring3,ring4 +cqmmm + include 'qmmm.i' + integer abqmmm,bcqmmm c c c assign stretch-bend parameters for each angle @@ -234,6 +245,11 @@ ia = iang(1,i) ib = iang(2,i) ic = iang(3,i) +cqmmm + abqmmm = qmmm(ia) + qmmm(ib) + bcqmmm = qmmm(ib) + qmmm(ic) + if ((abqmmm .ge. 4 .and. abqmmm.le. 5) + & .or. (bcqmmm .ge. 4 .and. bcqmmm .le. 5)) goto 99 c c stretch-bend interactions are omitted for linear angles c @@ -615,6 +631,8 @@ end if end if end if +cqmmm + 99 continue end do c c turn off the stretch-bend potential if it is not used diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/kurey.f 6.3.3/source/kurey.f --- 6.3.3/source_orig/kurey.f 2015-04-14 13:58:10.114343730 +0200 +++ 6.3.3/source/kurey.f 2015-04-15 13:48:53.676041223 +0200 @@ -40,6 +40,9 @@ character*20 keyword character*120 record character*120 string +cqmmm + include 'qmmm.i' + integer iacqmmm c c c process keywords containing Urey-Bradley parameters @@ -111,6 +114,10 @@ ia = iang(1,i) ib = iang(2,i) ic = iang(3,i) +cqmmm + iacqmmm = qmmm(ia) + qmmm(ic) + if (iacqmmm .ne. 4 .and. iacqmmm .ne. 5) goto 60 + ita = class(ia) itb = class(ib) itc = class(ic) diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/kvdw.f 6.3.3/source/kvdw.f --- 6.3.3/source_orig/kvdw.f 2015-04-14 13:58:10.114343730 +0200 +++ 6.3.3/source/kvdw.f 2015-04-15 13:48:53.676041223 +0200 @@ -49,6 +49,8 @@ character*20 keyword character*120 record character*120 string +cqmmm + include 'qmmm.i' c c c process keywords containing van der Waals parameters @@ -552,7 +554,8 @@ c nvdw = 0 do i = 1, n - if (rad(jvdw(i)) .ne. 0.0d0) then +cqmmm if (rad(jvdw(i)) .ne. 0.0d0) then + if (rad(jvdw(i)) .ne. 0.0d0 .and. qmmm(i) .ne. 1) then nvdw = nvdw + 1 ivdw(nvdw) = i end if Les fichiers binaires 6.3.3/source_orig/libtinker.a et 6.3.3/source/libtinker.a sont différents diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/Makefile 6.3.3/source/Makefile --- 6.3.3/source_orig/Makefile 1970-01-01 01:00:00.000000000 +0100 +++ 6.3.3/source/Makefile 2015-04-15 13:51:23.716043918 +0200 @@ -0,0 +1,1140 @@ +## +################################################################### +## ## +## Makefile for Building the Tinker Molecular Modeling Package ## +## ## +################################################################### +## +## Invocation Options: +## +## 1. make all Build all the TINKER executables +## 2. make rename Move the executables to BINDIR +## 3. make create_links Create soft links in LINKDIR +## 4. make remove_links Remove soft links from LINKDIR +## 6. make listing Concatenate source to tinker.txt +## 5. make clean Delete objects and executables +## +## Original version of this file is due to Peter Happersberger +## and Jochen Buehler of the University of Konstanz, Jan. 1998, +## Modifications by Reece Hart & Jay Ponder, Washington University +## +################################################################### + +################################################################### +## Master Directory Locations; Change as Needed for Local Site ## +################################################################### + +## +## TINKERDIR TINKER Distribution Directory +## BINDIR Hard Copies of TINKER Executables +## LINKDIR Linked Copies of TINKER Executables +## + +TINKERDIR = /home/ferre/tinker/6.3.3 +BINDIR = $(TINKERDIR)/bin +LINKDIR = /home/ferre/bin + +#################################################################### +## Known Machine Types; Uncomment One of the Following Sections ## +## May Need Editing to Match Your Desired OS & Compiler Version ## +#################################################################### + +## +## Machine: Generic Linux +## CPU Type: Intel x86 Compatible +## Oper Sys: Fedora Core +## Compiler: GNU gfortran +## + +F77 = /usr/bin/gfortran +LIBS = +F77FLAGS = -c -fdefault-integer-8 -mcmodel=large -fbounds-check +OPTFLAGS = -O2 +LIBFLAGS = -crusv +LINKFLAGS = + +## +## Machine: Generic Linux +## CPU Type: Intel x86 Compatible (also AMD) +## Oper Sys: Fedora Core +## Compiler: Intel Fortran for Linux 14.0 +## + +#F77 = /opt/intel/bin/ifort +#LIBS = +#F77FLAGS = -c -xHost -vec-report0 +#OPTFLAGS = -O3 -no-ipo -no-prec-div +#LIBFLAGS = -crusv +#LINKFLAGS = -static-intel + +## +## Machine: Generic Linux +## CPU Type: Intel x86 Compatible (also AMD) +## Oper Sys: Fedora Core +## Compiler: Intel Fortran for Linux 14.0 +## Parallel: OpenMP +## + +#F77 = /opt/intel/bin/ifort +#LIBS = -L$(TINKERDIR)/fftw/lib -lfftw3_threads -lfftw3 +#F77FLAGS = -c -xHost -assume cc_omp +#OPTFLAGS = -O3 -no-ipo -no-prec-div -openmp +#LIBFLAGS = -crusv +#LINKFLAGS = $(OPTFLAGS) -static-intel + +## +## Machine: Macintosh +## CPU Type: Intel Xeon +## Oper Sys: OS X 10.9 (Mavericks) +## Compiler: Intel Fortran for Mac 14.0 +## + +#F77 = /opt/intel/bin/ifort +#LIBS = +#F77FLAGS = -c -axSSSE3 -vec-report0 +#OPTFLAGS = -O3 -no-ipo -no-prec-div +#LIBFLAGS = -crusv +#LINKFLAGS = -static-intel -mmacosx-version-min=10.6 + +## +## Machine: Macintosh +## CPU Type: Intel Xeon +## Oper Sys: OS X 10.9 (Mavericks) +## Compiler: Intel Fortran for Mac 14.0 +## Parallel: OpenMP +## + +#F77 = /opt/intel/bin/ifort +#LIBS = -L$(TINKERDIR)/fftw/lib -lfftw3_threads -lfftw3 +#F77FLAGS = -c -axSSSE3 -assume cc_omp +#OPTFLAGS = -O3 -no-ipo -no-prec-div -openmp +#LIBFLAGS = -crusv +#LINKFLAGS = $(OPTFLAGS) -static-intel -mmacosx-version-min=10.6 + +## +## Machine: Macintosh +## CPU Type: PowerPC G4/G5 +## Oper Sys: OS X 10.4 (Tiger) +## Compiler: IBM XLF 8.1 +## + +#F77 = /opt/ibmcmp/xlf/8.1/bin/xlf +#F77FLAGS = -c -qextname +#OPTFLAGS = -O2 -qmaxmem=-1 +#LIBFLAGS = -r +#LINKFLAGS = + +## +## Machine: HP Alpha +## CPU Type: Alpha 21264 +## Oper Sys: HP Tru64 Unix +## Compiler: HP Fortran +## + +#F77 = /usr/bin/f77 +#LIBS = +#F77FLAGS = -c +#OPTFLAGS = -fast -arch host -tune host +#LIBFLAGS = -rclvs +#LINKFLAGS = -fast -non_shared -om -WL,-om_no_inst_sched + +## +## Machine: Silicon Graphics +## CPU Type: MIPS R10000 +## Oper Sys: SGI Irix 6.5 +## Compiler: MIPSPro Fortran +## + +#F77 = /bin/f77 +#LIBS = +#F77FLAGS = -c +#OPTFLAGS = -O -mips4 +#LIBFLAGS = -rclvs +#LINKFLAGS = -O -mips4 + +## +## Machine: SUN Workstation +## CPU Type: UltraSPARC +## Oper Sys: Solaris 4.0 +## Compiler: SUN Fortran +## + +#F77 = /bin/f77 +#LIBS = +#F77FLAGS = -c +#OPTFLAGS = -fast -temp=. +#LIBFLAGS = rcv +#LINKFLAGS = -fast + +################################################################# +## Should not be Necessary to Change Things Below this Point ## +################################################################# + +OBJS = active.o \ + alchemy.o \ + analysis.o \ + analyze.o \ + angles.o \ + anneal.o \ + archive.o \ + attach.o \ + bar.o \ + basefile.o \ + beeman.o \ + bicubic.o \ + bitors.o \ + bonds.o \ + born.o \ + bounds.o \ + bussi.o \ + calendar.o \ + center.o \ + chkpole.o \ + chkring.o \ + chkxyz.o \ + cholesky.o \ + clock.o \ + cluster.o \ + column.o \ + command.o \ + connect.o \ + connolly.o \ + control.o \ + correlate.o \ + crystal.o \ + cspline.o \ + cutoffs.o \ + deflate.o \ + delete.o \ + diagq.o \ + diffeq.o \ + diffuse.o \ + distgeom.o \ + document.o \ + dynamic.o \ + eangang.o \ + eangang1.o \ + eangang2.o \ + eangang3.o \ + eangle.o \ + eangle1.o \ + eangle2.o \ + eangle3.o \ + ebond.o \ + ebond1.o \ + ebond2.o \ + ebond3.o \ + ebuck.o \ + ebuck1.o \ + ebuck2.o \ + ebuck3.o \ + echarge.o \ + echarge1.o \ + echarge2.o \ + echarge3.o \ + echgdpl.o \ + echgdpl1.o \ + echgdpl2.o \ + echgdpl3.o \ + edipole.o \ + edipole1.o \ + edipole2.o \ + edipole3.o \ + egauss.o \ + egauss1.o \ + egauss2.o \ + egauss3.o \ + egeom.o \ + egeom1.o \ + egeom2.o \ + egeom3.o \ + ehal.o \ + ehal1.o \ + ehal2.o \ + ehal3.o \ + eimprop.o \ + eimprop1.o \ + eimprop2.o \ + eimprop3.o \ + eimptor.o \ + eimptor1.o \ + eimptor2.o \ + eimptor3.o \ + elj.o \ + elj1.o \ + elj2.o \ + elj3.o \ + embed.o \ + emetal.o \ + emetal1.o \ + emetal2.o \ + emetal3.o \ + emm3hb.o \ + emm3hb1.o \ + emm3hb2.o \ + emm3hb3.o \ + empole.o \ + empole1.o \ + empole2.o \ + empole3.o \ + energy.o \ + eopbend.o \ + eopbend1.o \ + eopbend2.o \ + eopbend3.o \ + eopdist.o \ + eopdist1.o \ + eopdist2.o \ + eopdist3.o \ + epitors.o \ + epitors1.o \ + epitors2.o \ + epitors3.o \ + erf.o \ + erxnfld.o \ + erxnfld1.o \ + erxnfld2.o \ + erxnfld3.o \ + esolv.o \ + esolv1.o \ + esolv2.o \ + esolv3.o \ + estrbnd.o \ + estrbnd1.o \ + estrbnd2.o \ + estrbnd3.o \ + estrtor.o \ + estrtor1.o \ + estrtor2.o \ + estrtor3.o \ + etors.o \ + etors1.o \ + etors2.o \ + etors3.o \ + etortor.o \ + etortor1.o \ + etortor2.o \ + etortor3.o \ + eurey.o \ + eurey1.o \ + eurey2.o \ + eurey3.o \ + evcorr.o \ + extra.o \ + extra1.o \ + extra2.o \ + extra3.o \ + fatal.o \ + fft3d.o \ + fftpack.o \ + field.o \ + final.o \ + flatten.o \ + freeunit.o \ + gda.o \ + geometry.o \ + getint.o \ + getkey.o \ + getmol.o \ + getmol2.o \ + getnumb.o \ + getpdb.o \ + getprm.o \ + getref.o \ + getstring.o \ + gettext.o \ + getword.o \ + getxyz.o \ + ghmcstep.o \ + gradient.o \ + gradrgd.o \ + gradrot.o \ + groups.o \ + grpline.o \ + gyrate.o \ + hessian.o \ + hessrgd.o \ + hessrot.o \ + hybrid.o \ + image.o \ + impose.o \ + induce.o \ + inertia.o \ + initatom.o \ + initial.o \ + initprm.o \ + initres.o \ + initrot.o \ + insert.o \ + intedit.o \ + intxyz.o \ + invbeta.o \ + invert.o \ + jacobi.o \ + kangang.o \ + kangle.o \ + katom.o \ + kbond.o \ + kcharge.o \ + kdipole.o \ + kewald.o \ + kextra.o \ + kgeom.o \ + kimprop.o \ + kimptor.o \ + kinetic.o \ + kmetal.o \ + kmpole.o \ + kopbend.o \ + kopdist.o \ + korbit.o \ + kpitors.o \ + kpolar.o \ + ksolv.o \ + kstrbnd.o \ + kstrtor.o \ + ktors.o \ + ktortor.o \ + kurey.o \ + kvdw.o \ + lattice.o \ + lbfgs.o \ + lights.o \ + makeint.o \ + makeref.o \ + makexyz.o \ + maxwell.o \ + mdinit.o \ + mdrest.o \ + mdsave.o \ + mdstat.o \ + mechanic.o \ + merge.o \ + minimize.o \ + minirot.o \ + minrigid.o \ + molecule.o \ + molxyz.o \ + moments.o \ + monte.o \ + mutate.o \ + nblist.o \ + newton.o \ + newtrot.o \ + nextarg.o \ + nexttext.o \ + nose.o \ + nspline.o \ + nucleic.o \ + number.o \ + numeral.o \ + numgrad.o \ + ocvm.o \ + openend.o \ + optimize.o \ + optirot.o \ + optrigid.o \ + optsave.o \ + orbital.o \ + orient.o \ + orthog.o \ + overlap.o \ + path.o \ + pdbxyz.o \ + picalc.o \ + pmestuff.o \ + pmpb.o \ + polarize.o \ + poledit.o \ + polymer.o \ + potential.o \ + precise.o \ + pressure.o \ + prmedit.o \ + prmkey.o \ + promo.o \ + protein.o \ + prtdyn.o \ + prterr.o \ + prtint.o \ + prtmol2.o \ + prtpdb.o \ + prtprm.o \ + prtseq.o \ + prtxyz.o \ + pss.o \ + pssrigid.o \ + pssrot.o \ + quatfit.o \ + radial.o \ + random.o \ + rattle.o \ + readdyn.o \ + readgau.o \ + readint.o \ + readmol.o \ + readmol2.o \ + readpdb.o \ + readprm.o \ + readseq.o \ + readxyz.o \ + replica.o \ + respa.o \ + rgdstep.o \ + rings.o \ + rmsfit.o \ + rotlist.o \ + rotpole.o \ + saddle.o \ + scan.o \ + sdstep.o \ + search.o \ + server.o \ + shakeup.o \ + sigmoid.o \ + sktstuff.o \ + sniffer.o \ + sort.o \ + spacefill.o \ + spectrum.o \ + square.o \ + suffix.o \ + superpose.o \ + surface.o \ + surfatom.o \ + switch.o \ + sybylxyz.o \ + temper.o \ + testgrad.o \ + testhess.o \ + testpair.o \ + testpol.o \ + testrot.o \ + timer.o \ + timerot.o \ + tncg.o \ + torphase.o \ + torque.o \ + torsfit.o \ + torsions.o \ + trimtext.o \ + unitcell.o \ + valence.o \ + verlet.o \ + version.o \ + vibbig.o \ + vibrate.o \ + vibrot.o \ + volume.o \ + xtalfit.o \ + xtalmin.o \ + xyzatm.o \ + xyzedit.o \ + xyzint.o \ + xyzpdb.o \ + xyzsybyl.o \ + zatom.o + +OBJQMMM = elecpot.o \ + extpot.o \ + minimizemm.o \ + qmmm_eg.o \ + qmmm_post.o \ + qmmm_todo.o \ + qmmmsetup.o \ + runqm.o \ + update_qmmm.o \ + tkr2qm.o \ + tkr2qm_s.o + +EXEFILES = alchemy.x \ + analyze.x \ + anneal.x \ + archive.x \ + bar.x \ + correlate.x \ + crystal.x \ + diffuse.x \ + distgeom.x \ + document.x \ + dynamic.x \ + gda.x \ + intedit.x \ + intxyz.x \ + minimize.x \ + minirot.x \ + minrigid.x \ + molxyz.x \ + monte.x \ + newton.x \ + newtrot.x \ + nucleic.x \ + optimize.x \ + optirot.x \ + optrigid.x \ + path.x \ + pdbxyz.x \ + polarize.x \ + poledit.x \ + potential.x \ + prmedit.x \ + protein.x \ + pss.x \ + pssrigid.x \ + pssrot.x \ + radial.x \ + saddle.x \ + scan.x \ + sniffer.x \ + spacefill.x \ + spectrum.x \ + superpose.x \ + sybylxyz.x \ + testgrad.x \ + testhess.x \ + testpair.x \ + testpol.x \ + testrot.x \ + timer.x \ + timerot.x \ + torsfit.x \ + valence.x \ + vibbig.x \ + vibrate.x \ + vibrot.x \ + xtalfit.x \ + xtalmin.x \ + xyzedit.x \ + xyzint.x \ + xyzpdb.x \ + xyzsybyl.x + +%.o: %.f + ${F77} ${F77FLAGS} ${OPTFLAGS} $< -o $@ + +%.o: %.c + ${CC} ${CFLAGS} ${INCLUDEDIR} ${OPTFLAGS} $< + +%.x: %.o libtinker.a + ${F77} ${LINKFLAGS} -o $@ $^ ${LIBS}; strip $@ + +all: ${EXEFILES} tkr2qm_s.x + +clean: + rm -f *.o *.a *.x + +listing: + cat *.i *.f *.c > tinker.txt + +rename: + mv alchemy.x $(BINDIR)/alchemy + mv analyze.x $(BINDIR)/analyze + mv anneal.x $(BINDIR)/anneal + mv archive.x $(BINDIR)/archive + mv bar.x $(BINDIR)/bar + mv correlate.x $(BINDIR)/correlate + mv crystal.x $(BINDIR)/crystal + mv diffuse.x $(BINDIR)/diffuse + mv distgeom.x $(BINDIR)/distgeom + mv document.x $(BINDIR)/document + mv dynamic.x $(BINDIR)/dynamic + mv gda.x $(BINDIR)/gda + mv intedit.x $(BINDIR)/intedit + mv intxyz.x $(BINDIR)/intxyz + mv minimize.x $(BINDIR)/minimize + mv minirot.x $(BINDIR)/minirot + mv minrigid.x $(BINDIR)/minrigid + mv molxyz.x $(BINDIR)/molxyz + mv monte.x $(BINDIR)/monte + mv newton.x $(BINDIR)/newton + mv newtrot.x $(BINDIR)/newtrot + mv nucleic.x $(BINDIR)/nucleic + mv optimize.x $(BINDIR)/optimize + mv optirot.x $(BINDIR)/optirot + mv optrigid.x $(BINDIR)/optrigid + mv path.x $(BINDIR)/path + mv pdbxyz.x $(BINDIR)/pdbxyz + mv polarize.x $(BINDIR)/polarize + mv poledit.x $(BINDIR)/poledit + mv potential.x $(BINDIR)/potential + mv prmedit.x $(BINDIR)/prmedit + mv protein.x $(BINDIR)/protein + mv pss.x $(BINDIR)/pss + mv pssrigid.x $(BINDIR)/pssrigid + mv pssrot.x $(BINDIR)/pssrot + mv radial.x $(BINDIR)/radial + mv saddle.x $(BINDIR)/saddle + mv scan.x $(BINDIR)/scan + mv sniffer.x $(BINDIR)/sniffer + mv spacefill.x $(BINDIR)/spacefill + mv spectrum.x $(BINDIR)/spectrum + mv superpose.x $(BINDIR)/superpose + mv sybylxyz.x $(BINDIR)/sybylxyz + mv testgrad.x $(BINDIR)/testgrad + mv testhess.x $(BINDIR)/testhess + mv testpair.x $(BINDIR)/testpair + mv testpol.x $(BINDIR)/testpol + mv testrot.x $(BINDIR)/testrot + mv timer.x $(BINDIR)/timer + mv timerot.x $(BINDIR)/timerot + mv torsfit.x $(BINDIR)/torsfit + mv valence.x $(BINDIR)/valence + mv vibbig.x $(BINDIR)/vibbig + mv vibrate.x $(BINDIR)/vibrate + mv vibrot.x $(BINDIR)/vibrot + mv xtalfit.x $(BINDIR)/xtalfit + mv xtalmin.x $(BINDIR)/xtalmin + mv xyzedit.x $(BINDIR)/xyzedit + mv xyzint.x $(BINDIR)/xyzint + mv xyzpdb.x $(BINDIR)/xyzpdb + mv xyzsybyl.x $(BINDIR)/xyzsybyl + mv tkr2qm_s.x $(BINDIR)/tkr2qm_s + +remove_links: + rm -f $(LINKDIR)/alchemy + rm -f $(LINKDIR)/analyze + rm -f $(LINKDIR)/anneal + rm -f $(LINKDIR)/archive + rm -f $(LINKDIR)/bar + rm -f $(LINKDIR)/correlate + rm -f $(LINKDIR)/crystal + rm -f $(LINKDIR)/diffuse + rm -f $(LINKDIR)/distgeom + rm -f $(LINKDIR)/document + rm -f $(LINKDIR)/dynamic + rm -f $(LINKDIR)/gda + rm -f $(LINKDIR)/intedit + rm -f $(LINKDIR)/intxyz + rm -f $(LINKDIR)/minimize + rm -f $(LINKDIR)/minirot + rm -f $(LINKDIR)/minrigid + rm -f $(LINKDIR)/molxyz + rm -f $(LINKDIR)/monte + rm -f $(LINKDIR)/newton + rm -f $(LINKDIR)/newtrot + rm -f $(LINKDIR)/nucleic + rm -f $(LINKDIR)/optimize + rm -f $(LINKDIR)/optirot + rm -f $(LINKDIR)/optrigid + rm -f $(LINKDIR)/path + rm -f $(LINKDIR)/pdbxyz + rm -f $(LINKDIR)/polarize + rm -f $(LINKDIR)/poledit + rm -f $(LINKDIR)/potential + rm -f $(LINKDIR)/prmedit + rm -f $(LINKDIR)/protein + rm -f $(LINKDIR)/pss + rm -f $(LINKDIR)/pssrigid + rm -f $(LINKDIR)/pssrot + rm -f $(LINKDIR)/radial + rm -f $(LINKDIR)/saddle + rm -f $(LINKDIR)/scan + rm -f $(LINKDIR)/sniffer + rm -f $(LINKDIR)/spacefill + rm -f $(LINKDIR)/spectrum + rm -f $(LINKDIR)/superpose + rm -f $(LINKDIR)/sybylxyz + rm -f $(LINKDIR)/testgrad + rm -f $(LINKDIR)/testhess + rm -f $(LINKDIR)/testpair + rm -f $(LINKDIR)/testpol + rm -f $(LINKDIR)/testrot + rm -f $(LINKDIR)/timer + rm -f $(LINKDIR)/timerot + rm -f $(LINKDIR)/torsfit + rm -f $(LINKDIR)/valence + rm -f $(LINKDIR)/vibbig + rm -f $(LINKDIR)/vibrate + rm -f $(LINKDIR)/vibrot + rm -f $(LINKDIR)/xtalfit + rm -f $(LINKDIR)/xtalmin + rm -f $(LINKDIR)/xyzedit + rm -f $(LINKDIR)/xyzint + rm -f $(LINKDIR)/xyzpdb + rm -f $(LINKDIR)/xyzsybyl + rm -f $(LINKDIR)/tkr2qm_s + +create_links: + ln -s $(BINDIR)/alchemy $(LINKDIR)/alchemy + ln -s $(BINDIR)/analyze $(LINKDIR)/analyze + ln -s $(BINDIR)/anneal $(LINKDIR)/anneal + ln -s $(BINDIR)/archive $(LINKDIR)/archive + ln -s $(BINDIR)/bar $(LINKDIR)/bar + ln -s $(BINDIR)/correlate $(LINKDIR)/correlate + ln -s $(BINDIR)/crystal $(LINKDIR)/crystal + ln -s $(BINDIR)/diffuse $(LINKDIR)/diffuse + ln -s $(BINDIR)/distgeom $(LINKDIR)/distgeom + ln -s $(BINDIR)/document $(LINKDIR)/document + ln -s $(BINDIR)/dynamic $(LINKDIR)/dynamic + ln -s $(BINDIR)/gda $(LINKDIR)/gda + ln -s $(BINDIR)/intedit $(LINKDIR)/intedit + ln -s $(BINDIR)/intxyz $(LINKDIR)/intxyz + ln -s $(BINDIR)/minimize $(LINKDIR)/minimize + ln -s $(BINDIR)/minirot $(LINKDIR)/minirot + ln -s $(BINDIR)/minrigid $(LINKDIR)/minrigid + ln -s $(BINDIR)/molxyz $(LINKDIR)/molxyz + ln -s $(BINDIR)/monte $(LINKDIR)/monte + ln -s $(BINDIR)/newton $(LINKDIR)/newton + ln -s $(BINDIR)/newtrot $(LINKDIR)/newtrot + ln -s $(BINDIR)/nucleic $(LINKDIR)/nucleic + ln -s $(BINDIR)/optimize $(LINKDIR)/optimize + ln -s $(BINDIR)/optirot $(LINKDIR)/optirot + ln -s $(BINDIR)/optrigid $(LINKDIR)/optrigid + ln -s $(BINDIR)/path $(LINKDIR)/path + ln -s $(BINDIR)/pdbxyz $(LINKDIR)/pdbxyz + ln -s $(BINDIR)/polarize $(LINKDIR)/polarize + ln -s $(BINDIR)/poledit $(LINKDIR)/poledit + ln -s $(BINDIR)/potential $(LINKDIR)/potential + ln -s $(BINDIR)/prmedit $(LINKDIR)/prmedit + ln -s $(BINDIR)/protein $(LINKDIR)/protein + ln -s $(BINDIR)/pss $(LINKDIR)/pss + ln -s $(BINDIR)/pssrigid $(LINKDIR)/pssrigid + ln -s $(BINDIR)/pssrot $(LINKDIR)/pssrot + ln -s $(BINDIR)/radial $(LINKDIR)/radial + ln -s $(BINDIR)/saddle $(LINKDIR)/saddle + ln -s $(BINDIR)/scan $(LINKDIR)/scan + ln -s $(BINDIR)/sniffer $(LINKDIR)/sniffer + ln -s $(BINDIR)/spacefill $(LINKDIR)/spacefill + ln -s $(BINDIR)/spectrum $(LINKDIR)/spectrum + ln -s $(BINDIR)/superpose $(LINKDIR)/superpose + ln -s $(BINDIR)/sybylxyz $(LINKDIR)/sybylxyz + ln -s $(BINDIR)/testgrad $(LINKDIR)/testgrad + ln -s $(BINDIR)/testhess $(LINKDIR)/testhess + ln -s $(BINDIR)/testpair $(LINKDIR)/testpair + ln -s $(BINDIR)/testpol $(LINKDIR)/testpol + ln -s $(BINDIR)/testrot $(LINKDIR)/testrot + ln -s $(BINDIR)/timer $(LINKDIR)/timer + ln -s $(BINDIR)/timerot $(LINKDIR)/timerot + ln -s $(BINDIR)/torsfit $(LINKDIR)/torsfit + ln -s $(BINDIR)/valence $(LINKDIR)/valence + ln -s $(BINDIR)/vibbig $(LINKDIR)/vibbig + ln -s $(BINDIR)/vibrate $(LINKDIR)/vibrate + ln -s $(BINDIR)/vibrot $(LINKDIR)/vibrot + ln -s $(BINDIR)/xtalfit $(LINKDIR)/xtalfit + ln -s $(BINDIR)/xtalmin $(LINKDIR)/xtalmin + ln -s $(BINDIR)/xyzedit $(LINKDIR)/xyzedit + ln -s $(BINDIR)/xyzint $(LINKDIR)/xyzint + ln -s $(BINDIR)/xyzpdb $(LINKDIR)/xyzpdb + ln -s $(BINDIR)/xyzsybyl $(LINKDIR)/xyzsybyl + +libtinker.a: ${OBJS} ${OBJQMMM} + ar ${LIBFLAGS} libtinker.a \ + active.o \ + analysis.o \ + angles.o \ + attach.o \ + basefile.o \ + beeman.o \ + bicubic.o \ + bitors.o \ + bonds.o \ + born.o \ + bounds.o \ + bussi.o \ + calendar.o \ + center.o \ + chkpole.o \ + chkring.o \ + chkxyz.o \ + cholesky.o \ + clock.o \ + cluster.o \ + column.o \ + command.o \ + connect.o \ + connolly.o \ + control.o \ + cspline.o \ + cutoffs.o \ + deflate.o \ + delete.o \ + diagq.o \ + diffeq.o \ + eangang.o \ + eangang1.o \ + eangang2.o \ + eangang3.o \ + eangle.o \ + eangle1.o \ + eangle2.o \ + eangle3.o \ + ebond.o \ + ebond1.o \ + ebond2.o \ + ebond3.o \ + ebuck.o \ + ebuck1.o \ + ebuck2.o \ + ebuck3.o \ + echarge.o \ + echarge1.o \ + echarge2.o \ + echarge3.o \ + echgdpl.o \ + echgdpl1.o \ + echgdpl2.o \ + echgdpl3.o \ + edipole.o \ + edipole1.o \ + edipole2.o \ + edipole3.o \ + egauss.o \ + egauss1.o \ + egauss2.o \ + egauss3.o \ + egeom.o \ + egeom1.o \ + egeom2.o \ + egeom3.o \ + ehal.o \ + ehal1.o \ + ehal2.o \ + ehal3.o \ + eimprop.o \ + eimprop1.o \ + eimprop2.o \ + eimprop3.o \ + eimptor.o \ + eimptor1.o \ + eimptor2.o \ + eimptor3.o \ + elj.o \ + elj1.o \ + elj2.o \ + elj3.o \ + embed.o \ + emetal.o \ + emetal1.o \ + emetal2.o \ + emetal3.o \ + emm3hb.o \ + emm3hb1.o \ + emm3hb2.o \ + emm3hb3.o \ + empole.o \ + empole1.o \ + empole2.o \ + empole3.o \ + energy.o \ + eopbend.o \ + eopbend1.o \ + eopbend2.o \ + eopbend3.o \ + eopdist.o \ + eopdist1.o \ + eopdist2.o \ + eopdist3.o \ + epitors.o \ + epitors1.o \ + epitors2.o \ + epitors3.o \ + erf.o \ + erxnfld.o \ + erxnfld1.o \ + erxnfld2.o \ + erxnfld3.o \ + esolv.o \ + esolv1.o \ + esolv2.o \ + esolv3.o \ + estrbnd.o \ + estrbnd1.o \ + estrbnd2.o \ + estrbnd3.o \ + estrtor.o \ + estrtor1.o \ + estrtor2.o \ + estrtor3.o \ + etors.o \ + etors1.o \ + etors2.o \ + etors3.o \ + etortor.o \ + etortor1.o \ + etortor2.o \ + etortor3.o \ + eurey.o \ + eurey1.o \ + eurey2.o \ + eurey3.o \ + evcorr.o \ + extra.o \ + extra1.o \ + extra2.o \ + extra3.o \ + fatal.o \ + fft3d.o \ + fftpack.o \ + field.o \ + final.o \ + flatten.o \ + freeunit.o \ + geometry.o \ + getint.o \ + getkey.o \ + getmol.o \ + getmol2.o \ + getnumb.o \ + getpdb.o \ + getprm.o \ + getref.o \ + getstring.o \ + gettext.o \ + getword.o \ + getxyz.o \ + ghmcstep.o \ + gradient.o \ + gradrgd.o \ + gradrot.o \ + groups.o \ + grpline.o \ + gyrate.o \ + hessian.o \ + hessrgd.o \ + hessrot.o \ + hybrid.o \ + image.o \ + impose.o \ + induce.o \ + inertia.o \ + initatom.o \ + initial.o \ + initprm.o \ + initres.o \ + initrot.o \ + insert.o \ + invbeta.o \ + invert.o \ + jacobi.o \ + kangang.o \ + kangle.o \ + katom.o \ + kbond.o \ + kcharge.o \ + kdipole.o \ + kewald.o \ + kextra.o \ + kgeom.o \ + kimprop.o \ + kimptor.o \ + kinetic.o \ + kmetal.o \ + kmpole.o \ + kopbend.o \ + kopdist.o \ + korbit.o \ + kpitors.o \ + kpolar.o \ + ksolv.o \ + kstrbnd.o \ + kstrtor.o \ + ktors.o \ + ktortor.o \ + kurey.o \ + kvdw.o \ + lattice.o \ + lbfgs.o \ + lights.o \ + makeint.o \ + makeref.o \ + makexyz.o \ + maxwell.o \ + mdinit.o \ + mdrest.o \ + mdsave.o \ + mdstat.o \ + mechanic.o \ + merge.o \ + molecule.o \ + moments.o \ + mutate.o \ + nblist.o \ + nextarg.o \ + nexttext.o \ + nose.o \ + nspline.o \ + number.o \ + numeral.o \ + numgrad.o \ + ocvm.o \ + openend.o \ + optsave.o \ + orbital.o \ + orient.o \ + orthog.o \ + overlap.o \ + picalc.o \ + pmestuff.o \ + pmpb.o \ + polymer.o \ + precise.o \ + pressure.o \ + prmkey.o \ + promo.o \ + prtdyn.o \ + prterr.o \ + prtint.o \ + prtmol2.o \ + prtpdb.o \ + prtprm.o \ + prtseq.o \ + prtxyz.o \ + quatfit.o \ + random.o \ + rattle.o \ + readdyn.o \ + readgau.o \ + readint.o \ + readmol.o \ + readmol2.o \ + readpdb.o \ + readprm.o \ + readseq.o \ + readxyz.o \ + replica.o \ + respa.o \ + rgdstep.o \ + rings.o \ + rmsfit.o \ + rotlist.o \ + rotpole.o \ + sdstep.o \ + search.o \ + server.o \ + shakeup.o \ + sigmoid.o \ + sktstuff.o \ + sort.o \ + square.o \ + suffix.o \ + surface.o \ + surfatom.o \ + switch.o \ + temper.o \ + tncg.o \ + torphase.o \ + torque.o \ + torsions.o \ + trimtext.o \ + unitcell.o \ + verlet.o \ + version.o \ + volume.o \ + xyzatm.o \ + zatom.o + ar ${LIBFLAGS} libtinker.a \ + elecpot.o \ + extpot.o \ + minimizemm.o \ + qmmm_eg.o \ + qmmm_post.o \ + qmmm_todo.o \ + qmmmsetup.o \ + runqm.o \ + update_qmmm.o \ + tkr2qm.o + +############################################################### +## Next Section has Explicit Dependencies on Include Files ## +############################################################### + diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/minimizemm.f 6.3.3/source/minimizemm.f --- 6.3.3/source_orig/minimizemm.f 1970-01-01 01:00:00.000000000 +0100 +++ 6.3.3/source/minimizemm.f 2015-04-15 13:48:53.688041223 +0200 @@ -0,0 +1,217 @@ + subroutine minimizeMM + implicit none + include 'sizes.i' + include 'atoms.i' + include 'inform.i' + include 'iounit.i' + include 'qmmm.i' + include 'scales.i' + include 'usage.i' + logical reject,doespf_save + integer i,j,nvar + real*8 grdmin,energy,minimiz1,gnorm,grms + real*8, allocatable :: xx(:) + real*8, allocatable :: derivs(:,:) + external minimiz1 + external optsave +c +c If requested, perform the MM minimization. +c At least 1 MM atom must be active (see the ACTIVE keyword) +c + reject = .true. + i = 1 + do while (reject .and. i .le. n) + if (atinqm(i).eq. 0 . and. use(i)) reject = .false. + i = i + 1 + end do + if (reject) then + write(iout,*) 'minimizeMM -- All MM atoms are frozen.' + goto 999 + end if +c +c Initialization +c + doespf_save = doespf + doespf = .false. + grdmin = 0.01d0 + iwrite = 0 + write (iout,10) grdmin + 10 format(/,' Convergence criterion = ',f7.4, + & ' kcal/mol/angstrom.') + if (debug) then + write (iout,11) + 11 format (/,' Analysis before MM microiterations') + call analysis(energy) + end if +c +c set scaling parameter for function and derivative values; +c use square root of median eigenvalue of typical Hessian +c + set_scale = .true. + nvar = 0 + do i = 1, n + if (use(i)) then + do j = 1, 3 + nvar = nvar + 1 + scale(nvar) = 12.0d0 + end do + end if + end do +c +c perform dynamic allocation of some local arrays +c + allocate (xx(nvar)) + allocate (derivs(3,n)) +c +c scale the coordinates of each active atom +c + nvar = 0 + do i = 1, n + if (use(i)) then + nvar = nvar + 1 + xx(nvar) = x(i) * scale(nvar) + nvar = nvar + 1 + xx(nvar) = y(i) * scale(nvar) + nvar = nvar + 1 + xx(nvar) = z(i) * scale(nvar) + end if + end do +c +c make the call to the optimization routine +c + call lbfgs (nvar,xx,energy,grdmin,minimiz1,optsave) +c +c unscale the final coordinates for active atoms +c + nvar = 0 + do i = 1, n + if (use(i)) then + nvar = nvar + 1 + x(i) = xx(nvar) / scale(nvar) + nvar = nvar + 1 + y(i) = xx(nvar) / scale(nvar) + nvar = nvar + 1 + z(i) = xx(nvar) / scale(nvar) + end if + end do +c +c compute the final function and RMS gradient values +c + call gradient (energy,derivs) + gnorm = 0.0d0 + do i = 1, n + if (use(i)) then + do j = 1, 3 + gnorm = gnorm + derivs(j,i)**2 + end do + end if + end do + gnorm = sqrt(gnorm) + grms = gnorm / sqrt(dble(nvar/3)) +c +c perform deallocation of some local arrays +c + deallocate (xx) + deallocate (derivs) +c +c write out the final function and gradient values +c + if (grms .gt. 1.0d-6) then + write (iout,98) energy,grms,gnorm + 98 format (/,' Final Function Value :',2x,f18.6, + & /,' Final RMS Gradient :',4x,f18.6, + & /,' Final Gradient Norm :',3x,f18.6) + else + write (iout,99) energy,grms,gnorm + 99 format (/,' Final Function Value :',2x,f18.6, + & /,' Final RMS Gradient :',4x,d18.6, + & /,' Final Gradient Norm :',3x,d18.6) + end if +c +c The end +c + doespf = doespf_save + 999 return + end +c +c +c ############################################################### +c ## ## +c ## function minimiz1 -- energy and gradient for minimize ## +c ## ## +c ############################################################### +c +c +c "minimiz1" is a service routine that computes the energy and +c gradient for a low storage BFGS optimization in Cartesian +c coordinate space +c +c + function minimiz1 (xx,g) + implicit none + include 'sizes.i' + include 'atoms.i' + include 'scales.i' + include 'usage.i' + integer i,nvar + real*8 minimiz1,e + real*8 energy,eps + real*8 xx(*) + real*8 g(*) + real*8, allocatable :: derivs(:,:) + logical analytic + external energy +c +c +c use either analytical or numerical gradients +c + analytic = .true. + eps = 0.00001d0 +c +c translate optimization parameters to atomic coordinates +c + nvar = 0 + do i = 1, n + if (use(i)) then + nvar = nvar + 1 + x(i) = xx(nvar) / scale(nvar) + nvar = nvar + 1 + y(i) = xx(nvar) / scale(nvar) + nvar = nvar + 1 + z(i) = xx(nvar) / scale(nvar) + end if + end do +c +c perform dynamic allocation of some local arrays +c + allocate (derivs(3,n)) +c +c compute and store the energy and gradient +c + if (analytic) then + call gradient (e,derivs) + else + e = energy () + call numgrad (energy,derivs,eps) + end if + minimiz1 = e +c +c store Cartesian gradient as optimization gradient +c + nvar = 0 + do i = 1, n + if (use(i)) then + nvar = nvar + 1 + g(nvar) = derivs(1,i) / scale(nvar) + nvar = nvar + 1 + g(nvar) = derivs(2,i) / scale(nvar) + nvar = nvar + 1 + g(nvar) = derivs(3,i) / scale(nvar) + end if + end do +c +c perform deallocation of some local arrays +c + deallocate (derivs) + return + end diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/picalc.f 6.3.3/source/picalc.f --- 6.3.3/source_orig/picalc.f 2015-04-14 13:58:10.118343730 +0200 +++ 6.3.3/source/picalc.f 2015-04-15 13:48:53.712041224 +0200 @@ -31,6 +31,9 @@ integer ncalls data ncalls / 0 / save ncalls +cqmmm + include 'qmmm.i' + integer iqmmm,jqmmm,ijqmmm c c c only needs to be done if pisystem is present @@ -58,10 +61,18 @@ kk = iconj(2,i) - iconj(1,i) + 1 do ii = 1, norbit-1 iorb = iorbit(ii) +cqmmm + iqmmm = qmmm(iorb) do jj = ii+1, norbit jorb = iorbit(jj) +cqmmm + jqmmm = qmmm(jorb) do k = 1, n12(iorb) if (i12(k,iorb) .eq. jorb) then +cqmmm + ijqmmm = iqmmm + jqmmm + if (ijqmmm .ne. 2 .or. ijqmmm .ne. 3 .or. + & ijqmmm .ne. 6) goto 10 nbpi = nbpi + 1 do m = 1, nbond if (iorb.eq.ibnd(1,m) .and. diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/pmestuff.f 6.3.3/source/pmestuff.f --- 6.3.3/source_orig/pmestuff.f 2022-09-30 09:09:28.116394906 +0200 +++ 6.3.3/source/pmestuff.f 2022-09-30 09:04:52.978118592 +0200 @@ -51,19 +51,19 @@ ifr = int(fr-eps) w = fr - dble(ifr) igrid(1,i) = ifr - bsorder - call bsplgen (w,thetai1(1,1,i)) + call bsplgen (w,thetai1(:,:,i)) w = xi*recip(1,2) + yi*recip(2,2) + zi*recip(3,2) fr = dble(nfft2) * (w-anint(w)+0.5d0) ifr = int(fr-eps) w = fr - dble(ifr) igrid(2,i) = ifr - bsorder - call bsplgen (w,thetai2(1,1,i)) + call bsplgen (w,thetai2(:,:,i)) w = xi*recip(1,3) + yi*recip(2,3) + zi*recip(3,3) fr = dble(nfft3) * (w-anint(w)+0.5d0) ifr = int(fr-eps) w = fr - dble(ifr) igrid(3,i) = ifr - bsorder - call bsplgen (w,thetai3(1,1,i)) + call bsplgen (w,thetai3(:,:,i)) end do return end diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/promo.f 6.3.3/source/promo.f --- 6.3.3/source_orig/promo.f 2015-04-14 13:58:10.118343730 +0200 +++ 6.3.3/source/promo.f 2015-04-15 14:03:48.548057299 +0200 @@ -30,7 +30,7 @@ & /,1x,'###',12x,'TINKER --- Software Tools for', & ' Molecular Design',12x,'###', & /,1x,'##',74x,'##', - & /,1x,'##',24x,'Version 6.3 February 2014',24x,'##', + & /,1x,'##',24x,'Version 6.3 April 2015 ',24x,'##', & /,1x,'##',74x,'##', & /,1x,'##',15x,'Copyright (c) Jay William Ponder', & ' 1990-2014',15x,'##', @@ -38,5 +38,19 @@ & /,2x,'###',70x,'###', & /,3x,74('#'), & /,5x,70('#'),/) +c +c QM/MM promo +c + write (iout,20) + 20 format (' QMMM-QMMM-QMMM-QMMM-QMMM-QMMM-QMMM-QMMM-QMMM-QMMM-QMMM', + & /,' QMMM',46x,'QMMM', + & /,' QMMM',11x,'Modifications (2014) by:',11x,'QMMM', + & /,' QMMM',4x,'Nicolas Ferre, Aix-Marseille Universite',3x, + & 'QMMM', + & /,' QMMM',4x,'Federico Melaccio, Universita di Siena',4x, + & 'QMMM', + & /,' QMMM',46x,'QMMM', + & /,' QMMM-QMMM-QMMM-QMMM-QMMM-QMMM-QMMM-QMMM-QMMM-QMMM-QMMM') + return end diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/prtxyz.f 6.3.3/source/prtxyz.f --- 6.3.3/source_orig/prtxyz.f 2015-04-14 13:58:10.118343730 +0200 +++ 6.3.3/source/prtxyz.f 2015-04-15 13:48:53.728041224 +0200 @@ -36,6 +36,9 @@ character*2 digc character*25 fstr character*120 xyzfile +cqmmm + include 'qmmm.i' + integer iqmmm c c c open the output unit if not already done @@ -96,8 +99,13 @@ fstr = '('//atmc//',2x,a3,3f'//crdc// & '.'//digc//',i6,8'//atmc//')' do i = 1, n +cqmmm + iqmmm = qmmm(i) + if (iqmmm .eq. 1) n12(i) = 2 write (ixyz,fstr) i,name(i),x(i),y(i),z(i),type(i), & (i12(k,i),k=1,n12(i)) +cqmmm + if (iqmmm .eq. 1) n12(i) = 0 end do c c close the output unit if opened by this routine diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/qmmm_eg.f 6.3.3/source/qmmm_eg.f --- 6.3.3/source_orig/qmmm_eg.f 1970-01-01 01:00:00.000000000 +0100 +++ 6.3.3/source/qmmm_eg.f 2015-04-15 13:48:53.732041224 +0200 @@ -0,0 +1,73 @@ + subroutine qmmm_eg(QMMM_energy,QMMM_gradient) + implicit none + include 'sizes.i' + include 'atoms.i' + include 'energi.i' + include 'inform.i' + include 'iounit.i' + include 'qmmm.i' + include 'units.i' + integer i,j,imm + character*3 qmmmlabel(3) + save qmmmlabel + data qmmmlabel/'HLA','QM ','Y '/ + real*8 energy + real*8 derivs(3,maxatm) + real*8 QMMM_energy,QMMM_gradient(3,nbinqm) +c + if (debug) then + write (iout,10) + 10 format (/,' Analysis of the MM energy (in a QM/MM calc.)') + do i = 1, n + if (qmmm(i) .ne. 0) write(iout,20) i,qmmmlabel(qmmm(i)) + 20 format (' Atom ',i5,' is ',a3) + end do + call analysis(energy) + end if + call gradient(energy,derivs) + if(eb .ne.0.0d0) write(iout,100) ' eb = ',eb /hartree,eb + if(ea .ne.0.0d0) write(iout,100) ' ea = ',ea /hartree,ea + if(eba .ne.0.0d0) write(iout,100) ' eba = ',eba /hartree,eba + if(eub .ne.0.0d0) write(iout,100) ' eub = ',eub /hartree,eub + if(eaa .ne.0.0d0) write(iout,100) ' eaa = ',eaa /hartree,eaa + if(eopb.ne.0.0d0) write(iout,100) ' eopb = ',eopb/hartree,eopb + if(eopd.ne.0.0d0) write(iout,100) ' eopd = ',eopd/hartree,eopd + if(eid .ne.0.0d0) write(iout,100) ' eid = ',eid /hartree,eid + if(eit .ne.0.0d0) write(iout,100) ' eit = ',eit /hartree,eit + if(et .ne.0.0d0) write(iout,100) ' et = ',et /hartree,et + if(ept .ne.0.0d0) write(iout,100) ' ept = ',ept /hartree,ebt + if(ebt .ne.0.0d0) write(iout,100) ' ebt = ',ebt /hartree,ept + if(ett .ne.0.0d0) write(iout,100) ' ett = ',ett /hartree,ett + if(ev .ne.0.0d0) write(iout,100) ' ev = ',ev /hartree,ev + if(ec .ne.0.0d0) write(iout,100) ' ec = ',ec /hartree,ec + if(ecd .ne.0.0d0) write(iout,100) ' ecd = ',ecd /hartree,ecd + if(ed .ne.0.0d0) write(iout,100) ' ed = ',ed /hartree,ed + if(em .ne.0.0d0) write(iout,100) ' em = ',em /hartree,em + if(ep .ne.0.0d0) write(iout,100) ' ep = ',ep /hartree,ep + if(er .ne.0.0d0) write(iout,100) ' er = ',er /hartree,er + if(es .ne.0.0d0) write(iout,100) ' es = ',es /hartree,es + if(elf .ne.0.0d0) write(iout,100) ' elf = ',elf /hartree,elf + if(eg .ne.0.0d0) write(iout,100) ' eg = ',eg /hartree,eg + if(ex .ne.0.0d0) write(iout,100) ' ex = ',ex /hartree,ex + 100 format(a,f15.8,' ua = ',f15.8,' kcal/mol') +c + QMMM_energy = energy + j = 0 + do imm = 1, n + i = atinqm(imm) + if (i.ne.0) then + QMMM_gradient(1,i) = derivs(1,imm) + QMMM_gradient(2,i) = derivs(2,imm) + QMMM_gradient(3,i) = derivs(3,imm) + end if + end do + if (debug) then + write(iout,200) + 200 format(/,'MM gradients:') + do i = 1, nbinqm + write(iout,210) i,(QMMM_gradient(j,i),j=1,3) + end do + 210 format(x,i3,x,3f15.8) + end if + return + end diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/qmmm.i 6.3.3/source/qmmm.i --- 6.3.3/source_orig/qmmm.i 1970-01-01 01:00:00.000000000 +0100 +++ 6.3.3/source/qmmm.i 2015-04-15 13:49:03.484041399 +0200 @@ -0,0 +1,112 @@ +c ############################################################## +c ## ## +c ## qmmm.i -- QM/MM stuff for coupling of tinker with QM ## +c ## ## +c ############################################################## +c +c maxqmmm the maximum number of atoms also defined in the qm program +c maxy the maximum number of QM/MM frontier bonds +c +c common /itkqmmm/: +c qmmm QM or MM atom ? for each atom in the system: +c MM -> 0 +c Link atom -> 1 +c QM -> 2 +c Y(LSCF/MM) -> 3 +c e4qmmm count or not some QM/MM electrostatic interactions +c -1 -> none, aka mechanical embedding +c 0 -> none but will be computed elsewhere +c 3 -> includes the QM/MM ones (microiteration or MD cases) +c nbinqm the number of atoms defined also in the qm program +c atinqm the mapping array between the qm program and tinker +c nybond the number of QM/MM SLBO frontiers +c iybond the array containing the frontier atom numbers +c qmcode selection of the QM program +c Molcas -> 0 or 1 +c Gaussian -> 2 +c casroot the casscf root which energy is scaled +c micromode MM microiterations mode: Full or On(ly) +c mmmdmode MM MD mode: Full or On(ly) +c mdnequi number of MD steps for equilibration +c mdnprod number of MD steps for production +c nsnap number of dumped MD snapshots +c +c common /ltkqmmm/: +c doespf ESPF calculation ? +c dorunmd Molecular Dynamics ? +c doqmmmdyn QM/MM molecular dynamics run ? +c doqmmmhessian QM/MM hessian contribution ? +c domdhess Hessian MD averaging ? +c +c common /ctkqmmm/: +c qmline the command line needed to run the qm job +c ensemble MD statistical ensemble for periodic systems +c +c common /rtkqmmm/: +c lahg the array containing the scaling factors of each frontier +c qmmmscale scale factor for qm/mm interactions +c casmme the saved MM energy when the caspt2 starts +c dtstep MD time step in ps +c dtdump MD dump time in ps +c x,y e zavg MD run coordinate averages +c epavg MD average electostatic potential +c epgavg MD average components of elec potential 1st derivative +c ephavg MD average components of elec potential 2nd derivative +c avgen MD average total energy +c avgderiv MD average components of total energy 1st derivative +c rmsd MD RMSD respect to the first structure +c eprmsd MD RMSD of elec potential respect to previous structure +c epgrmsd MD RMSD of 1st derivative of elec potential +c xpre ecc. MD 1st structure coordinates +c nstrut number of MD snaps used for average +c +c + integer maxqmmm,maxy,qmmm,e4qmmm,nbinqm,atinqm,nybond, + & iybond,micromode,mmmdmode,qmcode,casroot,nsnap,mdnequi,mdnprod + parameter(maxqmmm=1000) + parameter(maxy=100) + logical doespf,dorunmd,doqmmmdyn,doqmmmhessian,domdhess + character*120 qmline + character*3 ensemble + real*8 lahg,qmmmscale,casmme,dtstep,dtdump, + & xavg,yavg,zavg,rmsd,xpre,ypre,zpre,epgrmsd, + & nstrut + real*8 epavg,epgavg,ephavg,avgen,avgderiv,eprmsd + real*8 rcov(0:104) + save rcov + data rcov/0.0d0, + $ 0.354D0,0.849D0, + $ 1.336D0,1.010D0,0.838D0,0.757D0,0.700D0,0.658D0,0.668D0,0.920D0, + $ 1.539D0,1.421D0,1.244D0,1.117D0,1.101D0,1.064D0,1.044D0,1.032D0, + $ 1.953D0,1.761D0, + $ 1.513D0,1.412D0,1.402D0,1.345D0,1.382D0, + $ 1.270D0,1.241D0,1.164D0,1.302D0,1.193D0, + $ 1.260D0,1.197D0,1.211D0,1.190D0,1.192D0,1.147D0, + $ 2.260D0,2.052D0, + $ 1.698D0,1.564D0,1.473D0,1.467D0,1.322D0, + $ 1.478D0,1.332D0,1.338D0,1.386D0,1.403D0, + $ 1.459D0,1.398D0,1.407D0,1.386D0,1.382D0,1.267D0, + $ 2.570D0,2.277D0, + $ 1.943D0,1.841D0,1.823D0,1.816D0,1.801D0,1.780D0,1.771D0, + $ 1.735D0,1.732D0,1.710D0,1.696D0,1.673D0,1.660D0,1.637D0, + $ 1.671D0,1.611D0,1.511D0,1.392D0,1.372D0, + $ 1.372D0,1.371D0,1.364D0,1.262D0,1.340D0, + $ 1.518D0,1.459D0,1.512D0,1.500D0,1.545D0,1.420D0, + $ 2.880D0,2.512D0,1.983D0,1.721D0,1.711D0,1.684D0,1.666D0, + $ 1.657D0,1.660D0,1.801D0,1.761D0,1.750D0,1.724D0,1.712D0, + $ 1.689D0,1.679D0,1.698D0, + $ 1.850D0/ + + common /itkqmmm/ qmmm(maxatm),e4qmmm,nbinqm,atinqm(maxatm), + & nybond,iybond(2,maxy),qmcode,casroot,micromode, + & mmmdmode,nsnap,mdnequi,mdnprod + common /ltkqmmm/ doespf,dorunmd,doqmmmdyn,doqmmmhessian, + & domdhess + common /ctkqmmm/ qmline,ensemble + common /rtkqmmm/ lahg(maxy),qmmmscale,casmme,dtstep,dtdump, + & xavg(maxatm),yavg(maxatm),zavg(maxatm), + & epavg(maxqmmm),epgavg(3,maxqmmm),avgen(25), + & ephavg(6,maxqmmm),avgderiv(3,maxatm),rmsd, + & xpre(maxatm),ypre(maxatm),zpre(maxatm), + & eprmsd,epgrmsd(3),nstrut + diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/qmmm_post.f 6.3.3/source/qmmm_post.f --- 6.3.3/source_orig/qmmm_post.f 1970-01-01 01:00:00.000000000 +0100 +++ 6.3.3/source/qmmm_post.f 2015-04-15 13:48:53.736041224 +0200 @@ -0,0 +1,100 @@ +cqmmm +c +c Post-processing in QM/MM calculations +c - Copy the MM atom numbers and coordinates in +c MMatnum(nMM) and MMcoord(3,nMM) +c - Save informations for Morokuma's scaling factors +c - Save the last xyz file +c - Copy it to a numbered file in case of geometry relax +c + subroutine qmmm_post(do_relax,nMM,MMatnum,MMcoord,nLAH,QMMM_laha, + & QMMM_lahg) + implicit none + include 'sizes.i' + include 'atmtyp.i' + include 'atoms.i' + include 'couple.i' + include 'files.i' + include 'iounit.i' + include 'qmmm.i' + character*7 ext + character*60 minfile + integer i,j,nMM,iAlloc + integer imin,freeunit,lext,icycle + integer MMatnum(nMM) + integer nLAH + integer QMMM_laha(3,maxy) + logical do_relax,exist + real*8 MMcoord(3,nMM) + real*8 QMMM_lahg(maxy) +c +c Copy the MM atoms +c + j = 0 + do i = 1, n + if (atinqm(i) .eq. 0) then + j = j + 1 + MMatnum(j) = atomic(i) + MMcoord(1,j) = x(i) + MMcoord(2,j) = y(i) + MMcoord(3,j) = z(i) + end if + end do + if (j .ne. nMM) then + write(iout,10) j, nMM +10 format('QMMM_POST -- j = ',i5,' different from nMM = ',i5) + call fatal + end if +c +c Link atom scaling factors +c + j = 0 + do i = 1, n + if (j > maxy) then + write(iout,20) +20 format('QMMM_POST -- too much link atoms.', + & ' Increase maxy in qmmm.i') + call fatal + end if + if (qmmm(i) .eq. 1) then + j = j + 1 + QMMM_laha(1,j) = atinqm(i) + QMMM_laha(2,j) = atinqm(i12(1,i)) + QMMM_laha(3,j) = atinqm(i12(2,i)) + if (lahg(j) .le. 0.0d0) then + lahg(j) = (rcov(atomic(i12(2,i)))+rcov(atomic(i)))/ + & (rcov(atomic(i12(2,i)))+rcov(atomic(i12(1,i)))) + QMMM_lahg(j) = lahg(j) + end if + end if + end do + nLAH = j +c +c Save the new coordinates in the xyz file +c + imin = freeunit () + minfile = filename(1:leng)//'.xyz' + open (unit=imin,file=minfile,status='unknown') + rewind (unit=imin) + call prtxyz (imin) + close (unit=imin) +c +c Save the coordinates into a numbered file too +c + if (do_relax .and. .not. dorunmd) then + icycle = 0 + exist = .true. + lext = 3 + 1999 icycle = icycle + 1 + call numeral (icycle,ext,lext) + minfile = filename(1:leng)//'.'//ext(1:lext) + inquire (file=minfile,exist=exist) + if (exist) goto 1999 + imin = freeunit () + open (unit=imin,file=minfile,status='unknown') + call prtxyz (imin) + close (unit=imin) + end if +c + return + end diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/qmmmsetup.f 6.3.3/source/qmmmsetup.f --- 6.3.3/source_orig/qmmmsetup.f 1970-01-01 01:00:00.000000000 +0100 +++ 6.3.3/source/qmmmsetup.f 2015-04-15 13:48:53.736041224 +0200 @@ -0,0 +1,237 @@ + subroutine qmmmsetup + implicit none +c +c From its name ... setup the QM/MM run +c Basically read the key file and check the informations +c Also update the coordinates coming from the QM code +c + include 'sizes.i' + include 'atoms.i' + include 'bath.i' + include 'charge.i' + include 'files.i' + include 'inform.i' + include 'iounit.i' + include 'keys.i' + include 'mdstuf.i' + include 'qmmm.i' +c + integer next,i,j,k,ii,kk + integer nqmmmtmp + integer iqmmmtmp(maxqmmm) + logical found + character*20 keyword + character*120 record + character*120 string + character*2 qmmmcode + +c +c Look for the QMMM keywords in the key file +c + nbinqm = 0 + nybond = 0 + micromode = 0 + mmmdmode = 0 + if (n .eq. 0) return + do i = 1, n + atinqm(i) = 0 + end do + do i = 1, maxy + lahg(i) = -1.0d0 + end do + e4qmmm = 0 + doespf = .false. + found = .false. + doqmmmdyn = .false. + doqmmmhessian = .false. + qmcode = 0 + qmline = 'NOTHING' + qmmmscale = 1.0d0 + casroot = 0 + casmme = 0.0d0 + nqmmmtmp = 0 + mdnequi = 0 + mdnprod = 0 + dtstep = 1.0d-3 + dtdump = 1.0d-1 + domdhess = .false. + kelvin = 298.0d0 + atmsph = 1.0d0 + ensemble = 'NVE' + isothermal = .false. + isobaric = .false. + do j = 1, nkey + next = 1 + record = keyline(j) + call gettext (record,keyword,next) + call upcase (keyword) + string = record(next:120) + do i = 1, maxqmmm + iqmmmtmp(i) = 0 + end do +c +c QMMM keyword followed by 2 integers +c - NbInQM: the number of atoms defined in the QM code +c - NYBond: the number of SLBOs in the LSCF/MM computation +c + if (keyword(1:5) .eq. 'QMMM ') then + found = .true. + read(string,*,err=1,end=1) nbinqm,nybond +1 write (iout,2) +2 format(/,' This is a QM/MM calculation') + if (nbinqm.le.0.or.nbinqm.gt.n.or.nbinqm.gt.maxqmmm) then + write (iout,3) nbinqm +3 format (/,' QMMMSETUP -- Wrong NbInQM value ',i2) + call fatal + end if + if (nybond.lt.0.or.nybond.gt.n.or.nybond.gt.maxqmmm) then + write (iout,4) nybond +4 format (/,' QMMMSETUP -- Wrong NYBond value ',i2) + call fatal + end if + else if (keyword(1:3) .eq. 'QM ' + & .or. keyword(1:3) .eq. 'MM ' + & .or. keyword(1:3) .eq. 'LA ' + & .or. keyword(1:3) .eq. 'YA ') then + qmmmcode = keyword(1:2) + read(string,*,err=5,end=5) (iqmmmtmp(i),i=1,maxqmmm) +5 i = 0 +6 i = i + 1 + k = iqmmmtmp(i) + if (k .eq. 0) goto 8 + if (k .gt. n) then + write (iout,7) k +7 format (/,' QMMMSETUP -- Wrong QM/MM/LA/YA value ',i2) + call fatal + else if (k .gt. 0) then + if (qmmmcode(1:2) .eq. 'MM') then + qmmm(k) = 0 + else if (qmmmcode(1:2) .eq. 'LA') then + qmmm(k) = 1 + else if (qmmmcode(1:2) .eq. 'QM') then + qmmm(k) = 2 + else + qmmm(k) = 3 + end if + nqmmmtmp = nqmmmtmp + 1 + atinqm(k) = nqmmmtmp + else + kk = iqmmmtmp(i+1) + if (kk.le.0 .or. kk.lt.k) then + write (iout,7) kk + call fatal + end if + do ii = -k, kk + nqmmmtmp = nqmmmtmp + 1 + atinqm(ii) = nqmmmtmp + if (qmmmcode(1:2) .eq. 'MM') then + qmmm(ii) = 0 + else if (qmmmcode(1:2) .eq. 'LA') then + qmmm(ii) = 1 + else if (qmmmcode(1:2) .eq. 'QM') then + qmmm(ii) = 2 + else + qmmm(ii) = 3 + end if + end do + i = i + 1 + end if + goto 6 +8 continue +c +c Select the QM/MM electrostatics interaction mode +c + else if (keyword(1:20) .eq. 'QMMM-ELECTROSTATICS ') then + call gettext (record,keyword,next) + call upcase (keyword) + if (keyword(1:5) .eq. 'NONE ') then + e4qmmm = -1 + else + write (iout,*) ' QMMMSETUP -- Wrong QMMM-ELECTROSTATICS' + call fatal + end if +c +c Select the MM micro-iterations mode +c + else if (keyword(1:20) .eq. 'QMMM-MICROITERATION ') then + call gettext (record,keyword,next) + call upcase (keyword) + if (keyword(1:5) .eq. 'FULL ') then + micromode = 1 + else if (keyword(1:3) .eq. 'ON ' + & .or. keyword(1:5) .eq. 'ONLY ') then + micromode = 2 + else if (keyword(1:4) .eq. 'OFF ') then + else + write (iout,*) ' QMMMSETUP -- Wrong QMMM-MICROITERATION' + call fatal + end if +c +c Select the QM/MM Hessian +c + else if (keyword(1:13) .eq. 'QMMM-HESSIAN ') then + call gettext (record,keyword,next) + call upcase (keyword) + if (keyword(1:2) .eq. 'ON') then + doqmmmhessian = .true. + else if (keyword(1:3) .eq. 'OFF') then + doqmmmhessian = .false. + else + write (iout,*) ' QMMMSETUP -- Wrong QMMM-HESSIAN' + call fatal + end if +c +c Select the QM/MM dynamics arguments +c + else if (keyword(1:14) .eq. 'QMMM-EXTERNAL ') then + doqmmmdyn = .true. + call gettext (record,keyword,next) + call upcase (keyword) + if (keyword(1:7) .eq. 'MOLCAS ') then + qmcode = 1 + else if (keyword(1:8) .eq. 'GAUSSIAN ') then + qmcode = 2 + end if + qmline = record(next:120) +c +c Is there any QM/MM scale factor ? +c + else if (keyword(1:11) .eq. 'QMMM-SCALE ') then + read(string,*,err=10,end=10) qmmmscale,casroot +10 if (casroot .gt. 0) then + write (iout,11) qmmmscale,casroot +11 format(/,' Initial QM/MM scale factor:' ,f7.3, + & ' for QM state ',i2) + else if (casroot .lt. 0) then + write (iout,12) qmmmscale,abs(casroot) +12 format(/,' Constant QM/MM scale factor: ',f7.3, + & ' for QM state ',i2) + else + write (iout,13) qmmmscale +13 format(/,' Constant QM/MM scale factor: ',f7.3) + end if + if (qmmmscale .le. 0.0d0) call fatal + end if + end do + if (nqmmmtmp .ne. nbinqm) then + write(iout,19) nqmmmtmp, nbinqm +19 format(/,' QMMMSETUP -- Found ',i4,' QM/MM/LA/YA atoms', + & /,' while ',i4,' were expected') + end if + if (.not.found) return +c +c Check the mapping. +c + do 20 i = 1, (n-1) + if (atinqm(i).eq.0) goto 20 + do j = i+1, n + if (atinqm(i).eq.atinqm(j)) then + write(iout,21) i,j,atinqm(i) +21 format(/,' QMMMSETUP -- Two atoms ',i4,' and ',i4, + & ' are mapped to the same QM atom ',i4) + call fatal + end if + end do +20 continue + return + end diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/qmmm_todo.f 6.3.3/source/qmmm_todo.f --- 6.3.3/source_orig/qmmm_todo.f 1970-01-01 01:00:00.000000000 +0100 +++ 6.3.3/source/qmmm_todo.f 2015-04-15 13:48:53.740041224 +0200 @@ -0,0 +1,52 @@ +cqmmm + subroutine qmmm_todo + implicit none + include 'sizes.i' + include 'iounit.i' + include 'potent.i' + include 'qmmm.i' + logical do_fatal +c +c +c NYI in QM/MM --> TODO!!! +c + do_fatal = .false. + if (nbinqm .ne. 0) then + if (use_angang .or. use_strtor .or. use_tortor) then + write(iout,10) 'Coupled bonded interactions' + do_fatal = .true. + end if + if (use_chgdpl .or. use_dipole) then + write(iout,10) 'Bond dipoles' + do_fatal = .true. + end if + if (use_mpole) then + write(iout,10) 'Multipoles' + do_fatal = .true. + end if + if (use_polar) then + write(iout,10) 'Induced dipoles' + do_fatal = .true. + end if + if (use_solv) then + write (iout,10) 'SOLV' + do_fatal = .true. + end if + if (use_metal) then + write (iout,10) 'METAL' + do_fatal = .true. + end if + if (use_geom) then + write (iout,10) 'GEOM' + do_fatal = .true. + end if + end if + 10 format(//,' QMMM_TODO -- ',A,' NYI in QM/MM. Abort') + if ((use_polar .or. use_mpole) .and. nybond.ne.0) then + write (iout,20) + 20 format(//,' QMMM_TODO -- QM/MM Pol NYI with LSCF. Abort') + do_fatal = .true. + end if + if (do_fatal) call fatal + return + end diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/readxyz.f 6.3.3/source/readxyz.f --- 6.3.3/source_orig/readxyz.f 2015-04-14 13:58:10.118343730 +0200 +++ 6.3.3/source/readxyz.f 2015-04-15 13:48:53.748041224 +0200 @@ -27,6 +27,7 @@ include 'files.i' include 'inform.i' include 'iounit.i' + include 'qmmm.i' include 'titles.i' integer i,j,k,m integer ixyz,nmax @@ -43,6 +44,8 @@ character*120 xyzfile character*120 record character*120 string +cqmmm + integer ia,ib,ilah,iya c c c initialize the total number of atoms in the system @@ -173,6 +176,12 @@ 90 format (/,' READXYZ -- Error in Coordinate File at Atom',i6) call fatal end if +cqmmm +c set up the qm/mm options +cqmmm + call qmmmsetup + ilah = 0 + iya = 0 c c for each atom, count and sort its attached atoms c @@ -186,8 +195,73 @@ end do 100 continue call sort (n12(i),i12(1,i)) +cqmmm +c cancel the link atom connectivity but keeps the numbering +c of the frontier bond atoms +cqmmm + if (qmmm(i).eq.1) then + write (iout,81) i + 81 format (/,i6,' is defined as a QM/MM Link Atom') + ilah = ilah + 1 + if (ilah .gt. maxy) then + write (iout,*) 'READXYZ -- Too much link atoms' + call fatal + end if + if (n12(i).ne.2) then + write (iout,82) + 82 format (/,' Wrong definition of this frontier bond') + call fatal + end if + ia = i12(1,i) + ib = i12(2,i) + if (qmmm(ia).eq.0.and.qmmm(ib).eq.2) then + i12(1,i) = ia + i12(2,i) = ib + else if (qmmm(ia).eq.2.and.qmmm(ib).eq.0) then + i12(1,i) = ib + i12(2,i) = ia + else + write (iout,83) + 83 format(/,' A frontier bond must be defined between ', + & '1 MM atom and 1 QM atom') + call fatal + end if + n12(i) = 0 + end if +cqmmm +c found a hybrid Y atom in LSCF/MM +c + if (qmmm(i).eq.3) then + write (iout,85) i + 85 format (/,i6,' is defined as a LSCF/MM frontier Y atom') + do j = 1, n12(i) + k = i12(j,i) +c If k is a QM atom, add them to the iybond list + if (qmmm(k).eq.2) then + iya = iya + 1 + if (iya .gt. maxy) then + write(iout,86) + 86 format(/,' READXYZ -- Too much QM-Y SLBO bonds') + call fatal + end if + iybond (1,iya) = atinqm(i) +c Look what is the numbering of the current QM atom in the QM code + iybond (2,iya) = atinqm(k) + end if + end do + end if +cqmmm end do c +c Check the LSCF/MM frontiers. +c + if (iya.ne.nybond) then + write (iout,87) iya,nybond + 87 format (/,' QMMMSETUP -- Counted ',i2,' QM-Y bonds but ', + & i2,' are expected') + call fatal + end if +c c perform dynamic allocation of some local arrays c nmax = 0 @@ -206,6 +280,8 @@ list(tag(i)) = i if (tag(i) .ne. i) reorder = .true. end do +cqmmm + if (reorder) reorder = (nbinqm .eq. 0) if (reorder) then write (iout,110) 110 format (/,' READXYZ -- Atom Labels not Sequential,', diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/runqm.f 6.3.3/source/runqm.f --- 6.3.3/source_orig/runqm.f 1970-01-01 01:00:00.000000000 +0100 +++ 6.3.3/source/runqm.f 2015-04-15 13:48:53.756041224 +0200 @@ -0,0 +1,190 @@ +cqmmm +c +c ##################################################################### +c ## ## +c ## subroutine RunQM -- driver calling the QM part of a QM/MM job ## +c ## ## +c ##################################################################### +c + subroutine RunQM + implicit none + include 'sizes.i' + include 'atmtyp.i' + include 'atoms.i' + include 'charge.i' + include 'argue.i' + include 'energi.i' + include 'iounit.i' + include 'units.i' + include 'usage.i' + include 'files.i' + include 'group.i' + include 'inform.i' + include 'potent.i' + include 'deriv.i' + include 'qmmm.i' + character*60 minfile + integer i,j,k,kk,imin,espfmode,freeunit + real*8 fx,fy,fz,qtmp,mux,muy,muz,epf,epg(3),eph(6) +c +c atomic symbols +c + character*2 atosym(103) + save atosym + data atosym/' H','He', + $ 'Li','Be',' B',' C',' N',' O',' F','Ne', + $ 'Na','Mg','Al','Si',' P',' S','Cl','Ar', + $ ' K','Ca','Sc','Ti',' V','Cr','Mn','Fe','Co','Ni','Cu', + $ 'Zn','Ga','Ge','As','Se','Br','Kr', + $ 'Rb','Sr',' Y','Zr','Nb','Mo','Tc','Ru','Rh','Pd','Ag', + $ 'Cd','In','Sn','Sb','Te',' I','Xe', + $ 'Cs','Ba','La','Ce','Pr','Nd','Pm','Sm','Eu','Gd','Tb','Dy', + $ 'Ho','Er','Tm','Yb','Lu','Hf','Ta',' W','Re','Os','Ir','Pt', + $ 'Au','Hg','Tl','Pb','Bi','Po','At','Rn', + $ 'Fr','Ra','Ac','Th','Pa',' U','Np','Pu','Am','Cm','Bk','Cf','Es', + $ 'Fm','Md','No','Lr'/ +c +c initialization +c + if (qmcode .lt. 0 .or. qmcode .gt. 2) then + write(iout,'(A,I2)') 'RUNQM -- wrong QM code: ',qmcode + call fatal + end if + doespf = .true. + e4qmmm = 0 +c +c the coordinates +c + if (qmcode .eq. 0 .or. qmcode .eq. 1) then + imin = freeunit () + minfile = filename(1:leng)//'.coor' + open (unit=imin,file=minfile,status='unknown') + else + imin = 54 + open (unit=imin,status='unknown') + end if + rewind (unit=imin) + write(imin,'(i10,/,a)') nbinqm,'Coordinates from tinker' + do i = 1, nbinqm + do j = 1, n + if (i.eq.atinqm(j)) write(imin,1) atosym(atomic(j)),x(j), + & y(j),z(j) + 1 format (a,3f12.7) + end do + end do + close (unit=imin) +c +c the electrostatic potential and its derivatives +c + if (qmcode .eq. 0 .or. qmcode .eq. 1) then + imin = freeunit () + minfile = filename(1:leng)//'.qmmm' + open (unit=imin,file=minfile,status='unknown') + else if (qmcode .eq. 2) then + imin = 55 + open (unit=imin,status='unknown') + end if + rewind (unit=imin) + if (qmcode.ne.2) write(imin,'(A1)') '0' + do i = 1, nbinqm + do j = 1, n + if (i.eq.atinqm(j)) then +c call elecpot(j,epf,epg,eph) + write(imin,10) epf*bohr, + & epg(1)*bohr*bohr, + & epg(2)*bohr*bohr, + & epg(3)*bohr*bohr, + & eph(1)*bohr*bohr*bohr, + & eph(2)*bohr*bohr*bohr, + & eph(3)*bohr*bohr*bohr, + & eph(4)*bohr*bohr*bohr, + & eph(5)*bohr*bohr*bohr, + & eph(6)*bohr*bohr*bohr + 10 format (10f11.7) + if (debug) then + write(iout,'(/,A,I5)') ' Ext. Pot. on Tinker atom ',j + write(iout,11) ' V= ',epf * bohr + write(iout,12) ' X= ',epg(1)*bohr*bohr, + & ' Y= ',epg(2)*bohr*bohr, + & ' Z= ',epg(3)*bohr*bohr + write(iout,12) ' XX=',eph(1)*bohr*bohr*bohr, + & ' YY=',eph(2)*bohr*bohr*bohr, + & ' ZZ=',eph(3)*bohr*bohr*bohr + write(iout,12) ' XY=',eph(4)*bohr*bohr*bohr, + & ' XZ=',eph(5)*bohr*bohr*bohr, + & ' YZ=',eph(6)*bohr*bohr*bohr + 11 format(A,F10.5) + 12 format(3(A,F10.5)) + end if + end if + end do + end do + close (unit=imin) +c +c run the QM code +c + call system(qmline) +c +c get back informations from the same .qmmm file +c + if (qmcode .eq. 0 .or. qmcode .eq. 1) then + imin = freeunit () + minfile = filename(1:leng)//'.qmmm' + open (unit=imin,file=minfile,status='unknown') + else + imin = 56 + open (unit=imin,status='unknown') + end if + espfmode = -1 + rewind (unit=imin) + read(imin,20) ex, espfmode + 20 format(F12.7,I5) + ex = ex * hartree +c +c in the near future, espfmode = 1 should be ok too +c +c if (espfmode.ne.0 .or. espfmode.ne.1) then +c + if (espfmode.ne.0) then + write(iout,'(A,I5)') 'RUNQM -- wrong ESPFMODE = ',espfmode + call fatal + end if + do i = 1, nbinqm + fx = 0.0d0 + fy = 0.0d0 + fz = 0.0d0 + qtmp = 0.0d0 + mux = 0.0d0 + mux = 0.0d0 + mux = 0.0d0 + if (espfmode.eq.1) then + read(imin,21) fx,fy,fz,qtmp + 21 format(4F12.7) + else + read(imin,22) fx,fy,fz,qtmp,mux,muy,muz + 22 format(7F12.7) + end if + do j = 1, n + if (atinqm(j) .eq. i .and. qmmm(j).ne.0) then + dex(1,j) = qmmmscale * fx * hartree / bohr + dex(2,j) = qmmmscale * fy * hartree / bohr + dex(3,j) = qmmmscale * fz * hartree / bohr + do k = 1, nion + kk = iion(k) + if (j .eq. kk) then + pchg(k) = qtmp + if (debug) write (iout,23) j,pchg(k) + 23 format(' RUNQM -- New QM point charge value for ', + & i4,' = ',f10.5) + if (abs(qtmp) .gt. 1.0d0) write (iout,24) j,pchg(k) + 24 format(' RUNQM -- Warning: pchg(',i4,')= ',f10.5) + end if + end do + end if + end do + end do + close (unit=imin) + doespf = .false. +c + return + end diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/tkr2qm.f 6.3.3/source/tkr2qm.f --- 6.3.3/source_orig/tkr2qm.f 1970-01-01 01:00:00.000000000 +0100 +++ 6.3.3/source/tkr2qm.f 2015-04-15 13:48:53.776041225 +0200 @@ -0,0 +1,252 @@ +cqmmm +c For QM/MM calculations, tkr2qm is the main bridge between any QM program and Tinker. +c Arguments: +c - is_syscall: true if tkr2qm was called by the tkr2qm_s program +c - Project: name of the project +c - nAtInQM: number of atoms defined in the QMprog calling program +c - QMprog: currently only 'Molcas' or 'Gaussian' shall work, but accepts any +c - QMcoord: updated atom coordinates in angstrom +c - MltOrd: order of the QM multipoles +c ESPF -> MltOrd = 0 (charges) or 1 (charges + dipoles) +c Direct -> MltOrd = -1 +c - QMmult: QM-centered atomic charges or dipoles +c - do_calc: compute the MM contribution to the QM/MM energy +c + compute the MM contribution to the gradient at the QM atoms +c (* if false, tkr2qm is used for preparing the QM input *) +c - do_relax: shall the MM subsystem be relaxed? +c - QMMM_energy: MM contribution to the QM/MM energy +c - QMMM_gradient: MM contribution to the QM/MM gradient at the QMprog atoms +c - QMMM_extpot: MM electrostatic potential generated by all the MM atoms +c including the ones present in the QMprog program +c (* this array must be sized according to the value of MltOrd *) +c - nMM: number of MM atoms unknown from QMprog +c - MMatnum: atomic numbers of the nMM atoms +c - MMcoord: coordinates of the nMM atoms +c - nLAH: number of Link Atoms +c - QMMM_laha: triplet of atom numbers needed to apply the Morokuma's scaling scheme +c - QMMM_lahg: scaling factors for Morokuma's scaling scheme +c - elec_cpl: -1 -> mechanical embedding +c 0 -> normal electrostatic embedding +c 1 -> self-consistent electrostatic embedding +c + subroutine tkr2qm(is_syscall,Project,nAtInQM,QMprog,QMcoord, + & MltOrd,QMmult,do_calc,do_relax, + & QMMM_energy,QMMM_gradient,QMMM_extpot, + & nMM,MMatnum,MMcoord, + & nLAH,QMMM_laha,QMMM_lahg, + & elec_cpl) + implicit none + include 'sizes.i' + include 'argue.i' + include 'atmtyp.i' + include 'atoms.i' + include 'bound.i' + include 'charge.i' + include 'couple.i' + include 'cutoff.i' + include 'energi.i' + include 'files.i' + include 'group.i' + include 'inform.i' + include 'iounit.i' + include 'moldyn.i' + include 'mpole.i' + include 'polar.i' + include 'potent.i' + include 'qmmm.i' + include 'scales.i' + include 'units.i' + include 'usage.i' +c + character*(*) Project + character*(*) QMprog + integer nAtInQM,MltOrd,nMM,elec_cpl + integer MMatnum(*),nLAH,QMMM_laha(*) + logical is_syscall + logical do_calc,do_relax + real*8 QMcoord(3,*),QMmult(4,*) + real*8 QMMM_energy,QMMM_gradient(*),QMMM_extpot(*) + real*8 MMcoord(*),QMMM_lahg(*) +c + character*2 zsymbol(0:103) + character*3 MMsymbol + character*60 minfile + character*7 ext + integer i,j,ll,trimtext,imin,freeunit,nComp,nCenter + integer lext,icycle + logical exist,domicro + external trimtext + save zsymbol + data zsymbol/ + & ' X', + & ' H','He','Li','Be',' B',' C',' N',' O',' F','Ne', + & 'Na','Mg','Al','Si',' P',' S','Cl','Ar',' K','Ca', + & 'Sc','Ti',' V','Cr','Mn','Fe','Co','Ni','Cu','Zn', + & 'Ga','Ge','As','Se','Br','Kr','Rb','Sr',' Y','Zr', + & 'Nb','Mo','Tc','Ru','Rh','Pd','Ag','Cd','In','Sn', + & 'Sb','Te',' I','Xe','Cs','Ba','La','Ce','Pr','Nd', + & 'Pm','Sm','Eu','Gd','Tb','Dy','Ho','Er','Tm','Yb', + & 'Lu','Hf','Ta',' W','Re','Os','Ir','Pt','Au','Hg', + & 'Tl','Pb','Bi','Po','At','Rn','Fr','Ra','Ac','Th', + & 'Pa',' U','Np','Pu','Am','Cm','Bk','Cf','Es','Fm', + & 'Md','No','Lr' + & / +c +c Initialization +c + QMMM_energy = 0.0d0 + if (.not. is_syscall) then + call initial + narg = 1 + listarg(1) = .true. + arg(1) = Project + call getxyz + nAtInQM = nbinqm + end if +c +c Who's the master? +c + ll = trimtext(QMprog) + call upcase(QMprog(1:ll)) + write (iout,10) QMprog(1:ll) + 10 format (/, ' Tinker is called by ',a) +c +c Setup of the ff parameters +c + call mechanic + if (use_born .and. nbinqm .ne. 0) then + write (iout,*) ' Tkr2QM: Born NYI with QM/MM, turned off' + use_born = .false. + end if + elec_cpl = 0 + if (use_polar .or. use_ewald) elec_cpl = 1 + if (e4qmmm .eq. -1) elec_cpl = -1 +c +c Activate all the atoms defined in QMprog input +c + do i = 1, n + if (atinqm(i) .ne. 0 .and. .not.use(i)) then + write (iout,11) i + 11 format(' TKR2QM -- ',i6,' was inactive. Now active.') + use(i) = .true. + nuse = nuse + 1 + end if +c +c Atoms in QMprog input have to be put in group 0 to inactivate +c them in rigid body calculations +c + if (atinqm(i) .ne. 0 .and. use_group) then + j = grplist(i) + grplist(i) = 0 + kgrp(i) = 0 + if (i .eq. igrp(1,j)) igrp(1,j) = 1 + if (i .eq. igrp(2,j)) then + igrp(2,j) = 0 + ngrp = ngrp - 1 + end if + end if + end do +c +c Inconsistencies? +c + doespf = MltOrd .ge. 0 + call qmmm_todo + if ((use_mpole .or. use_polar) .and. .not.doespf) then + write(iout,*) 'TKR2QM -- Direct QM/MM electrostatics not ', + & 'compatible with MM multipoles' + call fatal + end if + if (qmline(1:7) .ne. 'NOTHING') then + write(iout,*) qmline + write (iout,*) 'TKR2QM -- QMMM-EXTERNAL keyword found. Abort' + call fatal + end if + do i = 1, n + if (mod(qmmm(i),3) .eq. 0 .and. atinqm(i) .ne. 0 + & .and. (use_chgdpl .or. use_dipole)) then + write (iout,*) ' TKR2QM -- cannot include MM/Y atoms', + & 'carrying bond dipole in the QM input. Abort' + call fatal + end if + end do +c +c Prepares a QMprog input. Store it in file named "Project.qmmm" +c + if (.not. do_calc) then + write(iout,*) + write(iout,*) 'Tinker is preparing a QM input' + write(iout,20) nbinqm,QMprog(1:ll) + 20 format(' ->',i5,' atoms are transfered to ',a10) + imin = freeunit () + minfile = filename(1:leng)//'.qmmm' + open (unit=imin,file=minfile,status='unknown') + rewind (unit=imin) + write(imin,'(i10)') nAtInQM + write(imin,'(a8)') 'Angstrom' + do j = 1, nbinqm + i = 1 + do while (j .ne. atinqm(i) .and. i .le. n) + i = i + 1 + end do + MMsymbol = ' ' + if (qmmm(i) .eq. 0) MMsymbol = '_MM' + write(imin,'(a2,a3,x,3f12.6)') zsymbol(atomic(i)), + & MMSymbol(1:3),x(i),y(i),z(i) + end do + close(unit=imin) + goto 9999 + end if +c +c Update the coordinates and multipoles carried by QMMM atoms +c + write(iout,30) + & ' Coordinates/multipoles updated from '//QMprog(1:ll) + 30 format(/,a) + if (use_charge .and. MltOrd .eq. 1) write(iout,*) + & 'Warning: get only the ESPF charges, not the dipoles' + call update_qmmm(elec_cpl,QMcoord,QMmult,.false.) +c +c MM microiterations and/or MD +c + domicro = micromode .gt. 0 + domicro = domicro .and. do_relax + if (domicro) then + write(iout,33) + 33 format (/,'Minimizing the MM subsystem energy') + call minimizeMM() + end if + dorunmd = dorunmd .and. do_relax + if (dorunmd) then + write(iout,36) + 36 format (/,'MD sampling of the MM subsystem') + write(iout,*) '... skipped (NYI)' +c call MDinMM() + end if + call update_qmmm(elec_cpl,QMcoord,QMmult,.true.) +c +c MM energy + gradient block +c + write(iout,40) + & ' Tinker is computing the MM contribution to the QM/MM energy', + & ' and the MM contributions to the gradient' + 40 format(/,a,/,a) + call qmmm_eg(QMMM_energy,QMMM_gradient) +c +c QM/MM electrostatics +c + nComp = 4 + if (doespf) nComp = nComp + 6*MltOrd + nCenter = n + if (doespf) nCenter = nbinqm + call extpot(elec_cpl,nComp,nCenter,QMMM_extpot) +c +c QM/MM post-processing +c + call qmmm_post(do_relax,nMM,MMatnum,MMcoord,nLAH,QMMM_laha, + & QMMM_lahg) +c +c perform any final tasks before program exit +c + 9999 if (.not. is_syscall) call final + return + end diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/tkr2qm_s.f 6.3.3/source/tkr2qm_s.f --- 6.3.3/source_orig/tkr2qm_s.f 1970-01-01 01:00:00.000000000 +0100 +++ 6.3.3/source/tkr2qm_s.f 2015-04-15 13:48:53.780041225 +0200 @@ -0,0 +1,265 @@ +cqmmm +c tkr2qm_s is the superdriver for tkr2qm. +c For QM/MM calculations, tkr2qm_s is the main bridge between any QM program and Tinker. +c See tkr2qm.f for a detailed explanation of the exchanged data. + program tkr2qm_s + implicit none + include 'sizes.i' + include 'argue.i' + include 'atoms.i' + include 'charge.i' + include 'files.i' + include 'inform.i' + include 'iounit.i' + include 'qmmm.i' +c + character*120 Project + character*120 QMprog + integer nAtInQM,MltOrd,elec_cpl,nMM,nLAH + integer, dimension(:), allocatable :: MMatnum + integer, dimension(:,:), allocatable :: QMMM_laha + logical is_syscall + logical do_calc,do_relax + real*8 QMMM_energy + real*8, dimension(:,:), allocatable :: QMcoord,QMmult + real*8, dimension(:,:), allocatable :: QMMM_gradient,QMMM_extpot + real*8, dimension(:,:), allocatable :: MMcoord + real*8, dimension(:), allocatable :: QMMM_lahg +c + character*20 keyword + character*120 minfile + character*120 record + character*120 string + integer iAlloc,freeunit,imin,next,iNum,i,ii,j,extpotSize + logical found + 999 format(/,' Not enough memory for allocating ',a,'. Abort') + 1000 format(a20) + 1001 format(a20,f20.8) + 1004 format(a20,4f20.8) + 1010 format(a20,i5) + 1013 format(a20,i5,3f20.8) + 1014 format(a20,i5,4f20.8) + 1020 format(a20,2i5) + 1031 format(a20,3i5,f20.8) + 1110 format(a20,i5,a20) +c +c +c Initialization +c + call initial + is_syscall = .true. + Project = "XXX" + nAtInQM = 0 + QMprog = "XXX" + MltOrd = -99 + do_calc = .false. + do_relax = .false. + elec_cpl = 0 +c +c Name of the project +c + narg = 1 + listarg(1) = .true. + Project = arg(1) + call getxyz + nAtinQM = nbinqm +c +c Get info/data from Project.qmmm +c + found = .false. + imin = freeunit () + minfile = filename(1:leng)//'.qmmm' + inquire (file=minfile,exist=found) + if (.not.found) then + write (iout,10) minfile + 10 format(/,' TKR2QM_S -- File not found: ',a120) + call fatal + end if + open (unit=imin,file=minfile,status='old') + rewind (unit=imin) + read (imin,11,end=90,err=91) record + 11 format(a120) + next = 1 + call gettext (record,keyword,next) + call upcase(keyword) + QMprog = keyword + call gettext (record,string,next) + read (string,*) iNum + do_calc = (iNum .ne. -1) + do_relax = (iNum .ne. 0) + call gettext (record,string,next) + read (string,*) iNum + MltOrd = iNum + allocate(QMcoord(3,nAtInQM),stat=iAlloc) + if (iAlloc .ne. 0) then + write(iout,999) 'QMcoord' + call fatal + end if + allocate(QMmult(4,nAtInQM),stat=iAlloc) + if (iAlloc .ne. 0) then + write(iout,999) 'QMmult' + call fatal + end if + do i = 1, nAtInQM + QMcoord(1,i) = 0.0d0 + QMcoord(2,i) = 0.0d0 + QMcoord(3,i) = 0.0d0 + QMmult(1,i) = 0.0d0 + QMmult(2,i) = 0.0d0 + QMmult(3,i) = 0.0d0 + QMmult(4,i) = 0.0d0 + end do + if (.not. do_calc) goto 90 +c +c Continue only if some calcs have to be done +c + do j = 1, nbinqm + read (imin,*,end=91,err=91) QMcoord(1,j),QMcoord(2,j), + & QMcoord(3,j) + end do + read (imin,11,end=90,err=91) record + next = 1 + call gettext (record,keyword,next) + call upcase(keyword) + if (keyword(1:10) .eq. 'MULTIPOLES') then + do j = 1, nbinqm + read (imin,*,end=90,err=91) i,QMmult(1,i),QMmult(2,i), + & QMmult(3,i),QMmult(4,i) + end do + end if + 90 close (unit=imin) + goto 99 + 91 write (iout,92) minfile,string + 92 format(/,' Error when reading ',a120,/,' Last string was: ',/, + & a120) + call fatal + 99 continue +c +c Allocations +c + allocate(QMMM_gradient(3,nAtInQM),stat=iAlloc) + if (iAlloc .ne. 0) then + write(iout,999) 'QMMM_gradient' + call fatal + end if + if (MltOrd .ge. 0) then + extpotSize = 4 + 6*MltOrd + allocate(QMMM_extpot(extpotSize,nAtInQM),stat=iAlloc) + else + extpotSize = 4 + allocate(QMMM_extpot(extpotSize,n),stat=iAlloc) + end if + if (iAlloc .ne. 0) then + write(iout,999) 'QMMM_extpot' + call fatal + end if + nMM = n - nAtInQM + allocate(MMatnum(nMM),stat=iAlloc) + if (iAlloc .ne. 0) then + write(iout,999) 'MMatnum' + call fatal + end if + allocate(MMcoord(3,nMM),stat=iAlloc) + if (iAlloc .ne. 0) then + write(iout,999) 'MMcoord' + call fatal + end if + allocate(QMMM_laha(3,maxy),stat=iAlloc) + if (iAlloc .ne. 0) then + write(iout,999) 'QMMM_laha' + call fatal + end if + allocate(QMMM_lahg(maxy),stat=iAlloc) + if (iAlloc .ne. 0) then + write(iout,999) 'QMMM_lahg' + call fatal + end if +c +c Call to tkr2qm +c + call tkr2qm(is_syscall,Project,nAtInQM,QMprog,QMcoord,MltOrd, + & QMmult,do_calc,do_relax,QMMM_energy,QMMM_gradient, + & QMMM_extpot,nMM,MMatnum,MMcoord,nLAH,QMMM_laha, + & QMMM_lahg,elec_cpl) +c +c Write info/data in Project.qmmm +c + if (do_calc) then + imin = freeunit () + open (unit=imin,file=minfile,status='old') + rewind (unit=imin) + write(imin,1000) 'MMisOK' + if (elec_cpl .eq. 1) write(imin,1000) 'FullCoupling ' + write(imin,1001) 'MMEnergy ',QMMM_energy + do i = 1, nAtInQM + write(imin,1013) 'MMGradient ',i,QMMM_gradient(1,i), + & QMMM_gradient(2,i), + & QMMM_gradient(3,i) + if (MltOrd .ge. 0) then + write(imin,1014) 'ESPF1 ',i,QMMM_extpot(1,i), + & QMMM_extpot(2,i), + & QMMM_extpot(3,i), + & QMMM_extpot(4,i) + end if + if (MltOrd .gt. 0) then + write(imin,1013) 'ESPF21 ',i,QMMM_extpot(5,i), + & QMMM_extpot(6,i), + & QMMM_extpot(7,i) + write(imin,1013) 'ESPF22 ',i,QMMM_extpot(8,i), + & QMMM_extpot(9,i), + & QMMM_extpot(10,i) + end if + end do + if (MltOrd .lt. 0) then + j = nion + do i = 1, nion + ii = iion(i) + if (mod(qmmm(ii),3) .ne. 0) j = j - 1 + end do + write(imin,1010) 'MMq ',j + do i = 1, nion + ii = iion(i) + j = mod(qmmm(ii),3) + if (j .eq. 0) + & write(imin,1004) ' ',QMMM_extpot(1,i),QMMM_extpot(2,i), + & QMMM_extpot(3,i),QMMM_extpot(4,i) + end do + end if +c +c What about MM atoms? +c + write(imin,1010) 'NMM ',nMM + do i = 1, nMM + write(imin,1013) 'MMCoord ',MMatnum(i),MMcoord(1,i), + & MMcoord(2,i),MMcoord(3,i) + end do +c +c What about Link atoms? +c + do i = 1, nLAH + write (imin,1031) 'LAH ',QMMM_laha(1,i),QMMM_laha(2,i), + & QMMM_laha(3,i),QMMM_lahg(i) + end do +c +c What about LSCF hybrid atoms? +c + do i = 1, nybond + write (imin,1020) 'YBond ',iybond(1,i),iybond(2,i) + end do +c + write(imin,1000) 'TheEnd ' + close (unit=imin) + end if +c +c Deallocations +c + deallocate(QMcoord) + deallocate(QMmult) + deallocate(QMMM_gradient) + deallocate(QMMM_extpot) + deallocate(MMatnum) + deallocate(MMcoord) + deallocate(QMMM_laha) + deallocate(QMMM_lahg) + call final + end diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/torsions.f 6.3.3/source/torsions.f --- 6.3.3/source_orig/torsions.f 2015-04-14 13:58:10.122343730 +0200 +++ 6.3.3/source/torsions.f 2015-04-15 13:48:53.784041225 +0200 @@ -25,6 +25,10 @@ include 'tors.i' integer i,j,k integer ia,ib,ic,id +cqmmm +! include 'angle.i' +! include 'qmmm.i' +! integer ii,iix c c c loop over all bonds, storing the atoms in each torsion @@ -55,5 +59,43 @@ end if end do end do +cqmmm !! Was in the previous code, need to know why !! +cqmmm Torsions with only one mm atom are added +! do i = 1, nangle +! ia = iang(1,i) +! ib = iang(2,i) +! ic = iang(3,i) +! if(qmmm(ia).eq.2 .and. qmmm(ib).ge.2) then +! do ii = 1, n12(ia) +! iix = i12(ii,ia) +! if (iix.ne.ib .and. iix.ne.ic) then +! ntors = ntors + 1 +! if (ntors .gt. maxtors) then +! write (iout,10) +! call fatal +! end if +! itors(1,ntors) = iix +! itors(2,ntors) = ia +! itors(3,ntors) = ib +! itors(4,ntors) = ic +! end if +! end do +! else if(qmmm(ib).ge.2 .and. qmmm(ic).eq.2) then +! do ii = 1, n12(ic) +! iix = i12(ii,ic) +! if (iix.ne.ia .and. iix.ne.ib) then +! ntors = ntors + 1 +! if (ntors .gt. maxtors) then +! write (iout,10) +! call fatal +! end if +! itors(1,ntors) = ia +! itors(2,ntors) = ib +! itors(3,ntors) = ic +! itors(4,ntors) = iix +! end if +! end do +! end if +! end do return end diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/update_qmmm.f 6.3.3/source/update_qmmm.f --- 6.3.3/source_orig/update_qmmm.f 1970-01-01 01:00:00.000000000 +0100 +++ 6.3.3/source/update_qmmm.f 2015-04-15 13:48:53.788041225 +0200 @@ -0,0 +1,137 @@ +cqmmm +c +c Update the coordinates/multipoles of QMMM atoms +c + subroutine update_qmmm(elec_cpl,QMcoord,QMmult,do_restore) + implicit none + include 'sizes.i' + include 'atoms.i' + include 'charge.i' + include 'inform.i' + include 'iounit.i' + include 'mpole.i' + include 'polar.i' + include 'potent.i' + include 'qmmm.i' + include 'usage.i' + integer elec_cpl,i,j,k,kk,l,iqmmm + logical found,do_restore + real*8 QMcoord(3,nbinqm),QMmult(4,nbinqm) + real*8 summu +c + if (elec_cpl .eq. -1) then + do i = 1, nbinqm + do j = 1, 4 + QMmult(j,i) = 0.0d0 + end do + end do + end if +c + if (do_restore) then + e4qmmm = 0 + do i = 1, n + if (atinqm(i) .ne. 0 .and. .not.use(i)) then + use(i) = .true. + nuse = nuse + 1 + end if + end do + if (use_charge) then + do k = 1, nion + kk = iion(k) + j = atinqm(kk) + if (qmmm(kk) .eq. 3) pchg(k) = pchg(k) - QMmult(1,j) + end do + else if (use_polar .or. use_mpole) then + do k = 1, npole + kk = ipole(k) + j = atinqm(kk) + if (qmmm(kk) .eq. 3) then + pole(1,k) = pole(1,k) - QMmult(1,j) + pole(2,k) = pole(2,k) - QMmult(2,j) + pole(3,k) = pole(3,k) - QMmult(3,j) + pole(4,k) = pole(4,k) - QMmult(4,j) + end if + end do + end if + return + end if +c + e4qmmm = 3 + do j = 1, nbinqm + found = .false. + i = 0 + do while (.not. found .and. i .lt. n) + i = i + 1 + found = atinqm(i) .eq. j + end do + if (.not. found) then + write (iout,10) j + 10 format(' UPDATE_QMMM -- ',i3,'th QM atom has no Tinker ', + & ' equivalent') + call fatal + end if + x(i) = QMcoord(1,j) + y(i) = QMcoord(2,j) + z(i) = QMcoord(3,j) + iqmmm = qmmm(i) + if (verbose) write (iout,11) i,x(i),y(i),z(i) + 11 format(' Atom ',i4,' (x,y,z) = ',3f10.5) + if (use_charge .or. use_chgdpl .or. use_dipole) then + do k = 1, nion + kk = iion(k) + if (i .eq. kk .and. iqmmm .ne. 0) then + summu = abs(QMmult(2,j)) + abs(QMmult(3,j)) + & + abs(QMmult(4,j)) + if (summu .ne. 0.0d0 .and. + & (use_chgdpl .or. use_dipole)) then + write (iout,*) ' UPDATE_QMMM -- cannot afford', + & ' QM-derived two-center dipole' + call fatal + end if + if (iqmmm .eq. 3) then + pchg(k) = pchg(k) + QMmult(1,j) + else + pchg(k) = QMmult(1,j) + end if + if (verbose) write (iout,12) pchg(k) + 12 format(' q = ',f8.3) + end if + end do + else if (use_polar .or. use_mpole) then + do k = 1, npole + kk = ipole(k) + if (i .eq. kk .and. iqmmm .ne. 0) then + if (iqmmm .eq. 3) then + pole(1,k) = pole(1,k) + QMmult(1,j) + pole(2,k) = pole(2,k) + QMmult(2,j) + pole(3,k) = pole(3,k) + QMmult(3,j) + pole(4,k) = pole(4,k) + QMmult(4,j) + else + pole(1,k) = QMmult(1,j) + pole(2,k) = QMmult(2,j) + pole(3,k) = QMmult(3,j) + pole(4,k) = QMmult(4,j) + end if + do l = 5, maxpole + pole(l,k) = 0.0d0 + enddo + if (verbose) write (iout,13) pole(1,k),pole(2,k), + & pole(3,k),pole(4,k) + 13 format(' q = ',f8.3, + & /,' (mux,muy,muz) = ',3f8.3) + end if + end do + end if + end do +c +c Desactivate any atom defined in QMprog +c + do i = 1, n + if (atinqm(i) .ne. 0 .and. use(i)) then + use(i) = .false. + nuse = nuse - 1 + end if + end do +c + return + end diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/valence.f 6.3.3/source/valence.f --- 6.3.3/source_orig/valence.f 2022-09-30 09:16:19.605860155 +0200 +++ 6.3.3/source/valence.f 2022-09-30 09:18:00.125251072 +0200 @@ -16,7 +16,7 @@ c on a quantum mechanical optimized structure and frequencies c c - program valence + program valence_prog implicit none include 'sizes.i' include 'atoms.i' diff -Nu -x '*~' -x '*.o' 6.3.3/source_orig/xyzedit.f 6.3.3/source/xyzedit.f --- 6.3.3/source_orig/xyzedit.f 2015-04-14 13:58:10.122343730 +0200 +++ 6.3.3/source/xyzedit.f 2015-04-15 13:48:53.796041225 +0200 @@ -32,6 +32,13 @@ include 'titles.i' include 'units.i' include 'usage.i' +cqmmm + include 'bond.i' + include 'charge.i' + include 'fields.i' + include 'potent.i' + include 'qmmm.i' +cqmmm integer i,j,k,m integer it,ixyz integer init,stop @@ -57,6 +64,29 @@ real*8 a(3,3) real*8, allocatable :: rad(:) logical write +cqmmm + character qmmm_symbol + logical add1la + integer iqm,imm,nold,iinput + real*8 xlink,ylink,zlink,xqm,yqm,zqm,xmm,ymm,zmm,qi,kla + character*10 iname + character*2 zsymbol(0:103) + save zsymbol + data zsymbol/ + & ' X', + & ' H','He','Li','Be',' B',' C',' N',' O',' F','Ne', + & 'Na','Mg','Al','Si',' P',' S','Cl','Ar',' K','Ca', + & 'Sc','Ti',' V','Cr','Mn','Fe','Co','Ni','Cu','Zn', + & 'Ga','Ge','As','Se','Br','Kr','Rb','Sr',' Y','Zr', + & 'Nb','Mo','Tc','Ru','Rh','Pd','Ag','Cd','In','Sn', + & 'Sb','Te',' I','Xe','Cs','Ba','La','Ce','Pr','Nd', + & 'Pm','Sm','Eu','Gd','Tb','Dy','Ho','Er','Tm','Yb', + & 'Lu','Hf','Ta',' W','Re','Os','Ir','Pt','Au','Hg', + & 'Tl','Pb','Bi','Po','At','Rn','Fr','Ra','Ac','Th', + & 'Pa',' U','Np','Pu','Am','Cm','Bk','Cf','Es','Fm', + & 'Md','No','Lr' + & / +cqmmm character*120 xyzfile character*120 record external merge @@ -102,12 +132,19 @@ & /,3x,'(16) Delete Molecules outside of Periodic Box', & /,3x,'(17) Create and Fill a Periodic Boundary Box', & /,3x,'(18) Soak Current Molecule in Box of Solvent', - & /,3x,'(19) Append a Second XYZ File to Current One') +cqmmm + & /,3x,'(19) Append a Second XYZ File to Current One', + & /,3x,'(20) Prepare a QM/MM input (G09/Tinker)', + & /,3x,'(21) Prepare a QM/MM input (Molcas/Tinker)', + & /,3x,'(22) Dump the inactive point charges') +cqmmm c c get the desired type of coordinate file modification c 20 continue - nmode = 19 +cqmmm + nmode = 22 +cqmmm mode = -1 do while (mode.lt.0 .or. mode.gt.nmode) mode = 0 @@ -648,6 +685,264 @@ write = .true. goto 20 end if +cqmmm +c +c prepare QM/MM inputs for G03/09 or Molcas +c + if (mode .eq. 20 .or. mode .eq. 21) then + call mechanic + nold = n +c +c step 1: find the missing link atoms +c + do i = 1, nbond + add1la = .false. + if(qmmm(ibnd(1,i)).eq.0 .and. qmmm(ibnd(2,i)).eq.2) then + iqm = ibnd(2,i) + imm = ibnd(1,i) + xqm = x(iqm) + yqm = y(iqm) + zqm = z(iqm) + xmm = x(imm) + ymm = y(imm) + zmm = z(imm) + kla = (rcov(atomic(iqm))+rcov(1))/ + & (rcov(atomic(iqm))+rcov(atomic(imm))) + xlink = xqm + kla*(xmm-xqm) + ylink = yqm + kla*(ymm-yqm) + zlink = zqm + kla*(zmm-zqm) + add1la = .true. + do j = 1, n + if ((qmmm(j).eq.1).and.(i12(1,j).eq.imm).and. + & (i12(2,j).eq.iqm)) add1la = .false. + end do + end if + if(qmmm(ibnd(1,i)).eq.2 .and. qmmm(ibnd(2,i)).eq.0) then + iqm = ibnd(1,i) + imm = ibnd(2,i) + xqm = x(iqm) + yqm = y(iqm) + zqm = z(iqm) + xmm = x(imm) + ymm = y(imm) + zmm = z(imm) + kla = (rcov(atomic(iqm))+rcov(1))/ + & (rcov(atomic(iqm))+rcov(atomic(imm))) + xlink = xqm + kla*(xmm-xqm) + ylink = yqm + kla*(ymm-yqm) + zlink = zqm + kla*(zmm-zqm) + add1la = .true. + do j = 1, n + if ((qmmm(j).eq.1).and.(i12(1,j).eq.imm).and. + & (i12(2,j).eq.iqm)) add1la = .false. + end do + end if + if (add1la) then + n = n + 1 + nbinqm = nbinqm + 1 + atinqm(n) = nbinqm + x(n) = xlink + y(n) = ylink + z(n) = zlink + type(n) = 2999 + class(n) = 99 + qmmm(n) = 1 + n12(n) = 0 + i12(1,n) = imm + i12(2,n) = iqm + name(n) = 'HLA' + atomic(n) = 1 + end if + end do +c +c step 2: the .xyz file (if some HLA have been added) +c + if (nold .ne. n) then + ixyz = freeunit () + xyzfile = filename(1:leng)//'.xyz' + call version (xyzfile,'new') + open(unit=ixyz,file=xyzfile,status='new') + if (ltitle .eq. 0) then + write (ixyz,450) n + 450 format (i6) + else + write (ixyz,460) n,title(1:ltitle) + 460 format (i6,2x,a) + end if + do i = 1, n + if (qmmm(i).eq.1) n12(i) = 2 + write(ixyz,480) i,name(i),x(i),y(i),z(i), + & type(i),(i12(j,i),j=1,n12(i)) + 480 format(i5,x,a3,3f12.6,5i6) + if (qmmm(i).eq.1) n12(i) = 0 + end do + close(unit=ixyz) + end if +c +c step 3: the g03/09 file +c + if (mode .eq. 20) then + ixyz = freeunit () + xyzfile = 'Gau_'//filename(1:leng)//'.com' + call version (xyzfile,'new') + open(unit=ixyz,file=xyzfile,status='new') + write(ixyz,500) filename(1:leng) + 500 format('%SUBST L101 ',/, + & '%SUBST L301 ',/, + & '%SUBST L302 ',/, + & '%SUBST L397 ',/, + & '%SUBST L701 ',/, + & '%CHK=',a,/, + & '%MEM=',/, + & '#P KEYWORDS HERE',/, + & ' NoSym QMMM=(LinkAtom1,Tinker1)',/,/, + & ' TITLE HERE',/,/ + & ' CHARGE & MULTIPLICITY HERE') + do j = 1, nbinqm + i = 0 + 501 i = i + 1 + if (atinqm(i).eq.j) goto 502 + if (i.gt.n) then + write (iout,503) j + 503 format(' No Tinker atom associated with the ',i4, + & 'th QM code atom !') + call fatal + end if + goto 501 + 502 continue + if (qmmm(i).eq.0) then + qmmm_symbol = 'L' + else if (qmmm(i).eq.1) then + qmmm_symbol = 'M' + else if (qmmm(i).eq.2) then + qmmm_symbol = 'H' + else if (qmmm(i).eq.3) then + qmmm_symbol = 'M' + end if + write(ixyz,520) zsymbol(atomic(i)),0,x(i),y(i),z(i), + & qmmm_symbol + 520 format(a2,i3,3(f10.5,2x),a1) + end do + write(ixyz,540) filename(1:leng),n + 540 format(/,a,x,i7) + write(ixyz,560) + 560 format(/,/) + close(unit=ixyz) + write(iout,599) + 599 format(/,' Do not forget to finish the set-up of G03 !') +c +c step 3': the Molcas file +c + else + ixyz = freeunit () + xyzfile = filename(1:leng)//'.input' + call version (xyzfile,'new') + open(unit=ixyz,file=xyzfile,status='new') + write(ixyz,600) + 600 format('&Gateway') + write (iout,601) + 601 format(/,' Standard (0, default) or older (1) input : ',$) + iinput = 0 + read (input,602) iinput + 602 format (i10) + if (iinput .eq. 0) then + write(ixyz,605) filename(1:leng) + 605 format( ' Tinker',/,' Group = NoSym',/,' Basis = ',/, + & /,'&Seward',/,' Title = QM/MM ',a,/, + & /,'&Espf',/,' External = Tinker') + else + do j = 1, nbinqm + i = 0 + 611 i = i + 1 + if (atinqm(i).eq.j) goto 612 + if (i.gt.n) then + write (iout,613) j + 613 format(' No Tinker atom associated with the ',i4, + & 'th QM code atom !') + call fatal + end if + goto 611 + 612 continue + iname = zsymbol(atomic(i))//' ' + if (j .lt. 10) then + write(iname(3:3),'(i1)') j + else if (j .ge. 10 .and. j .lt. 100) then + write(iname(3:4),'(i2)') j + else if (j .ge. 100 .and. j .lt. maxqmmm) then + write(iname(3:5),'(i3)') j + else + write(iout,*) 'XYZEDIT -- Too much QM/MM atoms' + write(iout,*) 'XYZEDIT -- Increase maxqmmm in qmmm.i' + call fatal + end if + if (qmmm(i).eq.0) then + qi = 0.0d0 + if (use_charge) then + do k = 1, nion + if (i .eq. iion(k)) qi = pchg(k) + end do + end if + write(ixyz,614) zsymbol(atomic(i)),iname, + & x(i),y(i),z(i),qi + 614 format(' Basis set',/, + & a2,'...... / MM',/, + & a10,3f12.6,' Angstrom',/, + & ' Charge = ',f12.6,/ + & ' End of Basis') + else if (qmmm(i).eq.1 .or .qmmm(i) .eq. 2) then + write(ixyz,615) zsymbol(atomic(i)),iname, + & x(i),y(i),z(i) + 615 format(' Basis set',/, + & a2,'......',/, + & a10,3f12.6,' Angstrom',/, + & ' End of Basis') + else if (qmmm(i).eq.3) then + write (iout,619) + 619 format(' LSCF method is not available in Molcas') + call fatal + end if + end do + write(ixyz,630) filename(1:leng) + 630 format(/,/,'&Seward',/,' Title = QM/MM ',a,/,/, + & '&Espf',/,' External = @tinker') + end if + close(unit=ixyz) + write(iout,700) + 700 format(/,' Do not forget to finish the set-up of Molcas !') + end if + if (nold.ne.n) write(iout,800) filename(1:leng)//'.key', + & n-nold + 800 format(' Please update the QMMM keyword in ',a,':',/,i2, + & ' Link Atoms (LA) has been added to the xyz file !') + write = .false. + end if +c +c dump the inactive point charges together with their coordinates +c + if (mode .eq. 22) then + call mechanic + ixyz = freeunit () + xyzfile = filename(1:leng)//'.q' + call version (xyzfile,'new') + open(unit=ixyz,file=xyzfile,status='new') + write(ixyz,900) nion-nbinqm + 900 format(i5,' 0 0 0 0 Angstrom') + qi = 0.0d0 + do i = 1, nion + k = iion (i) + if (atinqm(k) .eq. 0) then + write (ixyz,910) x(k), y(k), z(k), pchg(i) + qi = qi + pchg(i) + end if + 910 format(4f12.6) + end do + close(unit=ixyz) + write(iout,920) nion-nbinqm,qi,filename(1:leng)//'.q' + 920 format(i6, ' charges have been dumped (total charge = ',f7.3, + & ')',/,' Please check the number of point charges in ',a) + write = .false. + end if +cqmmm c c perform deallocation of some local arrays c