hdiff output

r30413/djwgr1.f90 2016-05-09 14:30:10.789795701 +0100 r30412/djwgr1.f90 2016-05-09 14:30:12.837823050 +0100
 16: !   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA 16: !   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 17: ! 17: !
 18: !  Energy and gradient for a genrigid setup example 18: !  Energy and gradient for a genrigid setup example
 19: ! 19: !
 20: !  NATOMS = total number of sites 20: !  NATOMS = total number of sites
 21: !  NRIGIDBODY = # rigid bodies 21: !  NRIGIDBODY = # rigid bodies
 22: ! 22: !
 23: SUBROUTINE DJWGR1(NATOMS,X,V,ENERGY,GTEST,SECT) 23: SUBROUTINE DJWGR1(NATOMS,X,V,ENERGY,GTEST,SECT)
 24: USE MODHESS 24: USE MODHESS
 25: USE GENRIGID 25: USE GENRIGID
 26: USE KEY, ONLY : NHEXAMERS 
 27: IMPLICIT NONE 26: IMPLICIT NONE
 28: LOGICAL GTEST,SECT 27: LOGICAL GTEST,SECT
 29: INTEGER NATOMS, J1, J2, J3, J4, NPOS1, NPOS2 28: INTEGER NATOMS, J1, J2, J3, J4, NPOS1, NPOS2
 30: DOUBLE PRECISION X(3*NATOMS), V(3*NATOMS), ENERGY, DUMMY2, DUMMY3, DUMMY, DIST, SIGMA, XDUMM, RHO, RDIST, RAD, EPSEFF 29: DOUBLE PRECISION X(3*NATOMS), V(3*NATOMS), ENERGY, DUMMY2, DUMMY3, DUMMY, DIST, SIGMA, XDUMM, RHO, RDIST, RAD, EPSEFF
 31: DOUBLE PRECISION RADHEX, SIGMAHEX, SIGMAPH 30: DOUBLE PRECISION FATT, DFATT, DDFATT, FREP, DFREP, DDFREP
 32: DOUBLE PRECISION FATT, DFATT, FREP, DFREP 31: 
 33: DOUBLE PRECISION DDFATT, DDFREP 
 34: ! 32: !
 35: ! Derivatives of the pairwise site-site terms in terms of distance 33: ! Derivatives of the pairwise site-site terms in terms of distance
 36: ! 34: !
 37: FATT(RHO,XDUMM)=-1.0D0 + (1.0D0 - EXP(RHO*(1.0D0 - XDUMM)))**2 35: FATT(RHO,XDUMM)=-1.0D0 + (1.0D0 - EXP(RHO*(1.0D0 - XDUMM)))**2
 38: DFATT(RHO,XDUMM)=2.0D0*(-EXP(2.0D0*RHO*(1.0D0-XDUMM)) + EXP(RHO*(1.0D0-XDUMM)))*RHO 36: DFATT(RHO,XDUMM)=2.0D0*(-EXP(2.0D0*RHO*(1.0D0-XDUMM)) + EXP(RHO*(1.0D0-XDUMM)))*RHO
 39: DDFATT(RHO,XDUMM)=-2.0D0*(-2.0D0*EXP(2.0D0*RHO*(1.0D0-XDUMM)) + EXP(RHO*(1.0D0-XDUMM)))*RHO**2 37: DDFATT(RHO,XDUMM)=-2.0D0*(-2.0D0*EXP(2.0D0*RHO*(1.0D0-XDUMM)) + EXP(RHO*(1.0D0-XDUMM)))*RHO**2
 40: FREP(SIGMA,XDUMM)=(SIGMA/XDUMM)**12 38: FREP(SIGMA,XDUMM)=(SIGMA/XDUMM)**12
 41: DFREP(SIGMA,XDUMM)=-12.0D0*(SIGMA/XDUMM)**12/XDUMM 39: DFREP(SIGMA,XDUMM)=-12.0D0*(SIGMA/XDUMM)**12/XDUMM
 42: DDFREP(SIGMA,XDUMM)=156.0D0*(SIGMA/XDUMM)**12/XDUMM**2 40: DDFREP(SIGMA,XDUMM)=156.0D0*(SIGMA/XDUMM)**12/XDUMM**2
 43:  41: 
 44: ENERGY=0.0D0 42: ENERGY=0.0D0
 45: IF (GTEST) V(1:3*NATOMS)=0.0D0 43: IF (GTEST) V(1:3*NATOMS)=0.0D0
 46: IF (SECT) HESS(1:3*NATOMS,1:3*NATOMS)=0.0D0 44: IF (SECT) HESS(1:3*NATOMS,1:3*NATOMS)=0.0D0
 47:  45: 
 48: ! 46: !
 49: ! 5 Morse plus two axial site pentamers from 47: ! 5 Morse plus two axial site pentamers from
 50: ! S.N. Fejer, T. James, J. Hernandez-Rojas and D.J. Wales, Phys. Chem. Chem. Phys., 11, 2098-2104 (2009).  48: ! S.N. Fejer, T. James, J. Hernandez-Rojas and D.J. Wales, Phys. Chem. Chem. Phys., 11, 2098-2104 (2009). 
 51: ! Energy Landscapes for Shells Assembled from Pentagonal and Hexagonal Pyramids  49: ! Energy Landscapes for Shells Assembled from Pentagonal and Hexagonal Pyramids 
 52: ! 50: !
 53: RAD=5.0D0 51: RAD=5.0D0
 54: RADHEX=RAD*2.0*0.5877852522924731D0  ! 2 * Sin[36] to give the same edge length 
 55: RHO=3.0D0 52: RHO=3.0D0
 56: SIGMA=(1.0D0+RAD*SQRT((5.0D0+SQRT(5.0D0))/2.0D0)) 53: SIGMA=(1.0D0+RAD*SQRT((5.0D0+SQRT(5.0D0))/2.0D0))
 57: SIGMAHEX=(1.0D0+RADHEX*SQRT((5.0D0+SQRT(5.0D0))/2.0D0)) 54: EPSEFF=0.28D0
 58: SIGMAPH=0.5D0*(SIGMA + SIGMAHEX) 55: 
 59: EPSEFF=0.4D0 56: DO J1=1,NRIGIDBODY
  57:    DO J2=J1+1,NRIGIDBODY
 60: ! 58: !
 61: ! Three different sorts of axial repulsion 59: ! Three different sorts of axial repulsion
 62: ! 60: !
 63: ! pent-pent first 61:       NPOS1=RIGIDGROUPS(NSITEPERBODY(J1)-1,J1)
 64: ! 62:       NPOS2=RIGIDGROUPS(NSITEPERBODY(J2)-1,J2)
 65: DO J1=1,NRIGIDBODY-NHEXAMERS 
 66:    DO J2=J1+1,NRIGIDBODY-NHEXAMERS 
 67:       NPOS1=RIGIDGROUPS(1,J1) 
 68:       NPOS2=RIGIDGROUPS(1,J2) 
 69:       DIST=SQRT((X(3*(NPOS1-1)+1)-X(3*(NPOS2-1)+1))**2+(X(3*(NPOS1-1)+2)-X(3*(NPOS2-1)+2))**2+(X(3*(NPOS1-1)+3)-X(3*(NPOS2-1)+3))**2) 63:       DIST=SQRT((X(3*(NPOS1-1)+1)-X(3*(NPOS2-1)+1))**2+(X(3*(NPOS1-1)+2)-X(3*(NPOS2-1)+2))**2+(X(3*(NPOS1-1)+3)-X(3*(NPOS2-1)+3))**2)
 70:       ENERGY=ENERGY+EPSEFF*FREP(SIGMA,DIST)  ! axial-axial repulsive term 64:       ENERGY=ENERGY+EPSEFF*FREP(SIGMA,DIST)  ! axial-axial repulsive term
 71:       IF (GTEST) THEN 65:       IF (GTEST) THEN
  66:          DUMMY2=EPSEFF*DFREP(SIGMA,DIST)
 72:          RDIST=1.0D0/DIST 67:          RDIST=1.0D0/DIST
 73:          DUMMY2=EPSEFF*DFREP(SIGMA,DIST)*RDIST 
 74:          CALL DJWGR1GRAD(NATOMS,NPOS1,NPOS2,DUMMY2,RDIST,X,V) 68:          CALL DJWGR1GRAD(NATOMS,NPOS1,NPOS2,DUMMY2,RDIST,X,V)
 75:       ENDIF 69:       ENDIF
 76:       IF (SECT) THEN 70:       IF (SECT) THEN
 77:          DUMMY2=EPSEFF*DFREP(SIGMA,DIST) 71:          DUMMY2=EPSEFF*DFREP(SIGMA,DIST)
 78:          DUMMY3=EPSEFF*DDFREP(SIGMA,DIST) 72:          DUMMY3=EPSEFF*DDFREP(SIGMA,DIST)
 79:          RDIST=1.0D0/DIST 73:          RDIST=1.0D0/DIST
 80:          CALL DJWGR1SEC(NATOMS,NPOS1,NPOS2,DUMMY3,DUMMY2,RDIST,X) 74:          CALL DJWGR1SEC(NATOMS,NPOS1,NPOS2,DUMMY3,DUMMY2,RDIST,X)
 81:       ENDIF 75:       ENDIF
 82:       NPOS1=RIGIDGROUPS(1,J1) 76: 
 83:       NPOS2=RIGIDGROUPS(2,J2) 77:       NPOS1=RIGIDGROUPS(NSITEPERBODY(J1)-1,J1)
  78:       NPOS2=RIGIDGROUPS(NSITEPERBODY(J2),J2)
 84:       DIST=SQRT((X(3*(NPOS1-1)+1)-X(3*(NPOS2-1)+1))**2+(X(3*(NPOS1-1)+2)-X(3*(NPOS2-1)+2))**2+(X(3*(NPOS1-1)+3)-X(3*(NPOS2-1)+3))**2) 79:       DIST=SQRT((X(3*(NPOS1-1)+1)-X(3*(NPOS2-1)+1))**2+(X(3*(NPOS1-1)+2)-X(3*(NPOS2-1)+2))**2+(X(3*(NPOS1-1)+3)-X(3*(NPOS2-1)+3))**2)
 85:       ENERGY=ENERGY+EPSEFF*FREP(SIGMA,DIST)  ! axial-axial repulsive term 80:       ENERGY=ENERGY+EPSEFF*FREP(SIGMA,DIST)  ! axial-axial repulsive term
 86:       IF (GTEST) THEN 81:       IF (GTEST) THEN
  82:          DUMMY2=EPSEFF*DFREP(SIGMA,DIST)
 87:          RDIST=1.0D0/DIST 83:          RDIST=1.0D0/DIST
 88:          DUMMY2=EPSEFF*DFREP(SIGMA,DIST)*RDIST 
 89:          CALL DJWGR1GRAD(NATOMS,NPOS1,NPOS2,DUMMY2,RDIST,X,V) 84:          CALL DJWGR1GRAD(NATOMS,NPOS1,NPOS2,DUMMY2,RDIST,X,V)
 90:       ENDIF 85:       ENDIF
 91:       IF (SECT) THEN 86:       IF (SECT) THEN
 92:          DUMMY2=EPSEFF*DFREP(SIGMA,DIST) 87:          DUMMY2=EPSEFF*DFREP(SIGMA,DIST)
 93:          DUMMY3=EPSEFF*DDFREP(SIGMA,DIST) 88:          DUMMY3=EPSEFF*DDFREP(SIGMA,DIST)
 94:          RDIST=1.0D0/DIST 89:          RDIST=1.0D0/DIST
 95:          CALL DJWGR1SEC(NATOMS,NPOS1,NPOS2,DUMMY3,DUMMY2,RDIST,X) 90:          CALL DJWGR1SEC(NATOMS,NPOS1,NPOS2,DUMMY3,DUMMY2,RDIST,X)
 96:       ENDIF 91:       ENDIF
 97:  92: 
 98:       NPOS1=RIGIDGROUPS(2,J1) 93:       NPOS1=RIGIDGROUPS(NSITEPERBODY(J1),J1)
 99:       NPOS2=RIGIDGROUPS(1,J2) 94:       NPOS2=RIGIDGROUPS(NSITEPERBODY(J2)-1,J2)
100:       DIST=SQRT((X(3*(NPOS1-1)+1)-X(3*(NPOS2-1)+1))**2+(X(3*(NPOS1-1)+2)-X(3*(NPOS2-1)+2))**2+(X(3*(NPOS1-1)+3)-X(3*(NPOS2-1)+3))**2) 95:       DIST=SQRT((X(3*(NPOS1-1)+1)-X(3*(NPOS2-1)+1))**2+(X(3*(NPOS1-1)+2)-X(3*(NPOS2-1)+2))**2+(X(3*(NPOS1-1)+3)-X(3*(NPOS2-1)+3))**2)
101:       ENERGY=ENERGY+EPSEFF*FREP(SIGMA,DIST)  ! axial 2-axial repulsive term 96:       ENERGY=ENERGY+EPSEFF*FREP(SIGMA,DIST)  ! axial 2-axial repulsive term
102:       IF (GTEST) THEN 97:       IF (GTEST) THEN
  98:          DUMMY2=EPSEFF*DFREP(SIGMA,DIST)
103:          RDIST=1.0D0/DIST 99:          RDIST=1.0D0/DIST
104:          DUMMY2=EPSEFF*DFREP(SIGMA,DIST)*RDIST 
105:          CALL DJWGR1GRAD(NATOMS,NPOS1,NPOS2,DUMMY2,RDIST,X,V)100:          CALL DJWGR1GRAD(NATOMS,NPOS1,NPOS2,DUMMY2,RDIST,X,V)
106:       ENDIF101:       ENDIF
107:       IF (SECT) THEN102:       IF (SECT) THEN
108:          DUMMY2=EPSEFF*DFREP(SIGMA,DIST)103:          DUMMY2=EPSEFF*DFREP(SIGMA,DIST)
109:          DUMMY3=EPSEFF*DDFREP(SIGMA,DIST)104:          DUMMY3=EPSEFF*DDFREP(SIGMA,DIST)
110:          RDIST=1.0D0/DIST105:          RDIST=1.0D0/DIST
111:          CALL DJWGR1SEC(NATOMS,NPOS1,NPOS2,DUMMY3,DUMMY2,RDIST,X)106:          CALL DJWGR1SEC(NATOMS,NPOS1,NPOS2,DUMMY3,DUMMY2,RDIST,X)
112:       ENDIF107:       ENDIF
113:    ENDDO 
114: ENDDO 
115: ! 
116: ! pent-hex second 
117: ! 
118: DO J1=1,NRIGIDBODY-NHEXAMERS 
119:    DO J2=NRIGIDBODY-NHEXAMERS+1,NRIGIDBODY 
120:       NPOS1=RIGIDGROUPS(1,J1) 
121:       NPOS2=RIGIDGROUPS(1,J2) 
122:       DIST=SQRT((X(3*(NPOS1-1)+1)-X(3*(NPOS2-1)+1))**2+(X(3*(NPOS1-1)+2)-X(3*(NPOS2-1)+2))**2+(X(3*(NPOS1-1)+3)-X(3*(NPOS2-1)+3))**2) 
123:       ENERGY=ENERGY+EPSEFF*FREP(SIGMAPH,DIST)  ! axial-axial repulsive term 
124:       IF (GTEST) THEN 
125:          RDIST=1.0D0/DIST 
126:          DUMMY2=EPSEFF*DFREP(SIGMAPH,DIST)*RDIST 
127:          CALL DJWGR1GRAD(NATOMS,NPOS1,NPOS2,DUMMY2,RDIST,X,V) 
128:       ENDIF 
129:       IF (SECT) THEN 
130:          DUMMY2=EPSEFF*DFREP(SIGMAPH,DIST) 
131:          DUMMY3=EPSEFF*DDFREP(SIGMAPH,DIST) 
132:          RDIST=1.0D0/DIST 
133:          CALL DJWGR1SEC(NATOMS,NPOS1,NPOS2,DUMMY3,DUMMY2,RDIST,X) 
134:       ENDIF 
135:       NPOS1=RIGIDGROUPS(1,J1) 
136:       NPOS2=RIGIDGROUPS(2,J2) 
137:       DIST=SQRT((X(3*(NPOS1-1)+1)-X(3*(NPOS2-1)+1))**2+(X(3*(NPOS1-1)+2)-X(3*(NPOS2-1)+2))**2+(X(3*(NPOS1-1)+3)-X(3*(NPOS2-1)+3))**2) 
138:       ENERGY=ENERGY+EPSEFF*FREP(SIGMAPH,DIST)  ! axial-axial repulsive term 
139:       IF (GTEST) THEN 
140:          RDIST=1.0D0/DIST 
141:          DUMMY2=EPSEFF*DFREP(SIGMAPH,DIST)*RDIST 
142:          CALL DJWGR1GRAD(NATOMS,NPOS1,NPOS2,DUMMY2,RDIST,X,V) 
143:       ENDIF 
144:       IF (SECT) THEN 
145:          DUMMY2=EPSEFF*DFREP(SIGMAPH,DIST) 
146:          DUMMY3=EPSEFF*DDFREP(SIGMAPH,DIST) 
147:          RDIST=1.0D0/DIST 
148:          CALL DJWGR1SEC(NATOMS,NPOS1,NPOS2,DUMMY3,DUMMY2,RDIST,X) 
149:       ENDIF 
150:  
151:       NPOS1=RIGIDGROUPS(2,J1) 
152:       NPOS2=RIGIDGROUPS(1,J2) 
153:       DIST=SQRT((X(3*(NPOS1-1)+1)-X(3*(NPOS2-1)+1))**2+(X(3*(NPOS1-1)+2)-X(3*(NPOS2-1)+2))**2+(X(3*(NPOS1-1)+3)-X(3*(NPOS2-1)+3))**2) 
154:       ENERGY=ENERGY+EPSEFF*FREP(SIGMAPH,DIST)  ! axial 2-axial repulsive term 
155:       IF (GTEST) THEN 
156:          RDIST=1.0D0/DIST 
157:          DUMMY2=EPSEFF*DFREP(SIGMAPH,DIST)*RDIST 
158:          CALL DJWGR1GRAD(NATOMS,NPOS1,NPOS2,DUMMY2,RDIST,X,V) 
159:       ENDIF 
160:       IF (SECT) THEN 
161:          DUMMY2=EPSEFF*DFREP(SIGMAPH,DIST) 
162:          DUMMY3=EPSEFF*DDFREP(SIGMAPH,DIST) 
163:          RDIST=1.0D0/DIST 
164:          CALL DJWGR1SEC(NATOMS,NPOS1,NPOS2,DUMMY3,DUMMY2,RDIST,X) 
165:       ENDIF 
166:    ENDDO 
167: ENDDO 
168: ! 
169: ! hex-hex third 
170: ! 
171: DO J1=NRIGIDBODY-NHEXAMERS+1,NRIGIDBODY 
172:    DO J2=J1+1,NRIGIDBODY 
173:       NPOS1=RIGIDGROUPS(1,J1) 
174:       NPOS2=RIGIDGROUPS(1,J2) 
175:       DIST=SQRT((X(3*(NPOS1-1)+1)-X(3*(NPOS2-1)+1))**2+(X(3*(NPOS1-1)+2)-X(3*(NPOS2-1)+2))**2+(X(3*(NPOS1-1)+3)-X(3*(NPOS2-1)+3))**2) 
176:       ENERGY=ENERGY+EPSEFF*FREP(SIGMAHEX,DIST)  ! axial-axial repulsive term 
177:       IF (GTEST) THEN 
178:          RDIST=1.0D0/DIST 
179:          DUMMY2=EPSEFF*DFREP(SIGMAHEX,DIST)*RDIST 
180:          CALL DJWGR1GRAD(NATOMS,NPOS1,NPOS2,DUMMY2,RDIST,X,V) 
181:       ENDIF 
182:       IF (SECT) THEN 
183:          DUMMY2=EPSEFF*DFREP(SIGMAHEX,DIST) 
184:          DUMMY3=EPSEFF*DDFREP(SIGMAHEX,DIST) 
185:          RDIST=1.0D0/DIST 
186:          CALL DJWGR1SEC(NATOMS,NPOS1,NPOS2,DUMMY3,DUMMY2,RDIST,X) 
187:       ENDIF 
188:       NPOS1=RIGIDGROUPS(1,J1) 
189:       NPOS2=RIGIDGROUPS(2,J2) 
190:       DIST=SQRT((X(3*(NPOS1-1)+1)-X(3*(NPOS2-1)+1))**2+(X(3*(NPOS1-1)+2)-X(3*(NPOS2-1)+2))**2+(X(3*(NPOS1-1)+3)-X(3*(NPOS2-1)+3))**2) 
191:       ENERGY=ENERGY+EPSEFF*FREP(SIGMAHEX,DIST)  ! axial-axial repulsive term 
192:       IF (GTEST) THEN 
193:          RDIST=1.0D0/DIST 
194:          DUMMY2=EPSEFF*DFREP(SIGMAHEX,DIST)*RDIST 
195:          CALL DJWGR1GRAD(NATOMS,NPOS1,NPOS2,DUMMY2,RDIST,X,V) 
196:       ENDIF 
197:       IF (SECT) THEN 
198:          DUMMY2=EPSEFF*DFREP(SIGMAHEX,DIST) 
199:          DUMMY3=EPSEFF*DDFREP(SIGMAHEX,DIST) 
200:          RDIST=1.0D0/DIST 
201:          CALL DJWGR1SEC(NATOMS,NPOS1,NPOS2,DUMMY3,DUMMY2,RDIST,X) 
202:       ENDIF 
203:  
204:       NPOS1=RIGIDGROUPS(2,J1) 
205:       NPOS2=RIGIDGROUPS(1,J2) 
206:       DIST=SQRT((X(3*(NPOS1-1)+1)-X(3*(NPOS2-1)+1))**2+(X(3*(NPOS1-1)+2)-X(3*(NPOS2-1)+2))**2+(X(3*(NPOS1-1)+3)-X(3*(NPOS2-1)+3))**2) 
207:       ENERGY=ENERGY+EPSEFF*FREP(SIGMAHEX,DIST)  ! axial 2-axial repulsive term 
208:       IF (GTEST) THEN 
209:          RDIST=1.0D0/DIST 
210:          DUMMY2=EPSEFF*DFREP(SIGMAHEX,DIST)*RDIST 
211:          CALL DJWGR1GRAD(NATOMS,NPOS1,NPOS2,DUMMY2,RDIST,X,V) 
212:       ENDIF 
213:       IF (SECT) THEN 
214:          DUMMY2=EPSEFF*DFREP(SIGMAHEX,DIST) 
215:          DUMMY3=EPSEFF*DDFREP(SIGMAHEX,DIST) 
216:          RDIST=1.0D0/DIST 
217:          CALL DJWGR1SEC(NATOMS,NPOS1,NPOS2,DUMMY3,DUMMY2,RDIST,X) 
218:       ENDIF 
219:    ENDDO 
220: ENDDO 
221: !108: !
222: ! Sum over the attractive sites109: ! Sum over the attractive sites
223: !110: !
224: DO J1=1,NRIGIDBODY111:       DO J3=1,NSITEPERBODY(J1)-2     ! # Morse sites in rb J1 NSITEPERBODY(J1)
225:    DO J2=J1+1,NRIGIDBODY 
226:       DO J3=3,NSITEPERBODY(J1)     ! # Morse sites in rb J1 NSITEPERBODY(J1) 
227:          NPOS1=RIGIDGROUPS(J3,J1)    ! where is this site in the list?112:          NPOS1=RIGIDGROUPS(J3,J1)    ! where is this site in the list?
228:          DO J4=3,NSITEPERBODY(J2)  ! # Morse sites in rb J2 NSITEPERBODY(J2)113:          DO J4=1,NSITEPERBODY(J2)-2  ! # Morse sites in rb J2 NSITEPERBODY(J2)
229:             NPOS2=RIGIDGROUPS(J4,J2) ! where is this site in the list?114:             NPOS2=RIGIDGROUPS(J4,J2) ! where is this site in the list?
230:             DIST=SQRT((X(3*(NPOS1-1)+1)-X(3*(NPOS2-1)+1))**2+(X(3*(NPOS1-1)+2)-X(3*(NPOS2-1)+2))**2+ &115:             DIST=SQRT((X(3*(NPOS1-1)+1)-X(3*(NPOS2-1)+1))**2+(X(3*(NPOS1-1)+2)-X(3*(NPOS2-1)+2))**2+ &
231:   &                   (X(3*(NPOS1-1)+3)-X(3*(NPOS2-1)+3))**2)116:   &                   (X(3*(NPOS1-1)+3)-X(3*(NPOS2-1)+3))**2)
232:             ENERGY=ENERGY+FATT(RHO,DIST) 117:             ENERGY=ENERGY+FATT(RHO,DIST) 
233:             IF (GTEST) THEN118:             IF (GTEST) THEN
 119:                DUMMY2=DFATT(RHO,DIST)
234:                RDIST=1.0D0/DIST120:                RDIST=1.0D0/DIST
235:                DUMMY2=DFATT(RHO,DIST)*RDIST 
236:                CALL DJWGR1GRAD(NATOMS,NPOS1,NPOS2,DUMMY2,RDIST,X,V)121:                CALL DJWGR1GRAD(NATOMS,NPOS1,NPOS2,DUMMY2,RDIST,X,V)
237:             ENDIF122:             ENDIF
238:             IF (SECT) THEN123:             IF (SECT) THEN
239:                DUMMY2=DFATT(RHO,DIST)124:                DUMMY2=DFATT(RHO,DIST)
240:                DUMMY3=DDFATT(RHO,DIST)125:                DUMMY3=DDFATT(RHO,DIST)
241:                RDIST=1.0D0/DIST126:                RDIST=1.0D0/DIST
242:                CALL DJWGR1SEC(NATOMS,NPOS1,NPOS2,DUMMY3,DUMMY2,RDIST,X)127:                CALL DJWGR1SEC(NATOMS,NPOS1,NPOS2,DUMMY3,DUMMY2,RDIST,X)
243:             ENDIF128:             ENDIF
244:          ENDDO129:          ENDDO
245:       ENDDO130:       ENDDO
272:    HESS(J3+J1,J4+J1)=HESS(J3+J1,J4+J1)-DUMMY5157:    HESS(J3+J1,J4+J1)=HESS(J3+J1,J4+J1)-DUMMY5
273:    HESS(J4+J1,J3+J1)=HESS(J4+J1,J3+J1)-DUMMY5158:    HESS(J4+J1,J3+J1)=HESS(J4+J1,J3+J1)-DUMMY5
274: ENDDO159: ENDDO
275: 160: 
276: END SUBROUTINE DJWGR1SEC161: END SUBROUTINE DJWGR1SEC
277: 162: 
278: SUBROUTINE DJWGR1GRAD(NATOMS,NPOS1,NPOS2,DUMMY2,RDIST,X,V)163: SUBROUTINE DJWGR1GRAD(NATOMS,NPOS1,NPOS2,DUMMY2,RDIST,X,V)
279: USE MODHESS164: USE MODHESS
280: IMPLICIT NONE165: IMPLICIT NONE
281: INTEGER NPOS1, NPOS2, NATOMS, J1, J2, J3, J4166: INTEGER NPOS1, NPOS2, NATOMS, J1, J2, J3, J4
282: DOUBLE PRECISION X(3*NATOMS), DUMMY2, RDIST, DUMMY5, V(3*NATOMS)167: DOUBLE PRECISION X(3*NATOMS), DUMMY2, RDIST, DUMMY4, DUMMY5, V(3*NATOMS)
283: 168: 
 169: DUMMY4=DUMMY2*RDIST
284: J3=3*(NPOS1-1)170: J3=3*(NPOS1-1)
285: J4=3*(NPOS2-1)171: J4=3*(NPOS2-1)
286: 172: 
287: DO J1=1,3173: DO J1=1,3
288:    DUMMY5=DUMMY2*(X(J3+J1)-X(J4+J1))174:    DUMMY5=DUMMY4*(X(J3+J1)-X(J4+J1))
289:    V(J3+J1)=V(J3+J1)+DUMMY5175:    V(J3+J1)=V(J3+J1)+DUMMY5
290:    V(J4+J1)=V(J4+J1)-DUMMY5176:    V(J4+J1)=V(J4+J1)-DUMMY5
291: ENDDO177: ENDDO
292: 178: 
293: END SUBROUTINE DJWGR1GRAD179: END SUBROUTINE DJWGR1GRAD
294: 180: 


r30413/key.f90 2016-05-09 14:30:11.429804246 +0100 r30412/key.f90 2016-05-09 14:30:13.029825618 +0100
 15:      &        NRBTRIES, REDOTSIM, REDOBFGSSTEPS, RPIMAGES, RPDOF, SDOXYGEN, SDHYDROGEN, SDCHARGE, BOWMANPES, & 15:      &        NRBTRIES, REDOTSIM, REDOBFGSSTEPS, RPIMAGES, RPDOF, SDOXYGEN, SDHYDROGEN, SDCHARGE, BOWMANPES, &
 16:      &        INTCONSEP, PATOM1, PATOM2, INTREPSEP, NCONSTRAINTON, CPREPSEP, CPCONSEP, NCONGEOM, & 16:      &        INTCONSEP, PATOM1, PATOM2, INTREPSEP, NCONSTRAINTON, CPREPSEP, CPCONSEP, NCONGEOM, &
 17:      &        NCPREPULSIVE, NCPCONSTRAINT, MAXCONUSE, INTCONSTEPS, INTRELSTEPS, INTSTEPS1, INTLJSTEPS, & 17:      &        NCPREPULSIVE, NCPCONSTRAINT, MAXCONUSE, INTCONSTEPS, INTRELSTEPS, INTSTEPS1, INTLJSTEPS, &
 18:      &        NTRAPPOW, MAXINTIMAGE, CHECKDID, CHECKREPINTERVAL, INTFREEZEMIN, INTNTRIESMAX, INTIMAGEINCR, & 18:      &        NTRAPPOW, MAXINTIMAGE, CHECKDID, CHECKREPINTERVAL, INTFREEZEMIN, INTNTRIESMAX, INTIMAGEINCR, &
 19:      &        NCONSTRAINTFIX, INTIMAGECHECK, NREPULSIVEFIX, NRANROT, NENDDUP, LOCALPERMNEIGH, & 19:      &        NCONSTRAINTFIX, INTIMAGECHECK, NREPULSIVEFIX, NRANROT, NENDDUP, LOCALPERMNEIGH, &
 20:      &        LOCALPERMMAXSEP, NONEDAPBC, STRUC, QCHEMESNAO, QCHEMESNMO, QCHEMESNZERO, QCHEMESNELEC, PMPATHINR, & 20:      &        LOCALPERMMAXSEP, NONEDAPBC, STRUC, QCHEMESNAO, QCHEMESNMO, QCHEMESNZERO, QCHEMESNELEC, PMPATHINR, &
 21:      &        MULTISUNIT, MULTIFUNIT,NIMAGEINST,NGLJ,ST_TSSTEP,LANSTEP,NONFREEZE, & 21:      &        MULTISUNIT, MULTIFUNIT,NIMAGEINST,NGLJ,ST_TSSTEP,LANSTEP,NONFREEZE, &
 22:      &        MCPATHBINS,MCPATHEQUIL,MCPATHSTEPS,MCPATHPRTFRQ,MCPATHTS,MCPATHSCHECK,RPHSLICES,RPHQBINS, & 22:      &        MCPATHBINS,MCPATHEQUIL,MCPATHSTEPS,MCPATHPRTFRQ,MCPATHTS,MCPATHSCHECK,RPHSLICES,RPHQBINS, &
 23:      &        ITWIST, JTWIST, KTWIST, LTWIST, MCPATHSTART, MCPATHBLOCK, MCPATHOVER, NCPU, MCPATHDOBLOCK, MCMERGES, MCMERGEQ, & 23:      &        ITWIST, JTWIST, KTWIST, LTWIST, MCPATHSTART, MCPATHBLOCK, MCPATHOVER, NCPU, MCPATHDOBLOCK, MCMERGES, MCMERGEQ, &
 24:      &        MCMERGEI,GAUSSIANCHARGE,GAUSSIANMULTI,ITG03, REDOTS, QCIPERMCHECKINT, & 24:      &        MCMERGEI,GAUSSIANCHARGE,GAUSSIANMULTI,ITG03, REDOTS, QCIPERMCHECKINT, &
 25:      &        MLPIN, MLPOUT, MLPHIDDEN, MLPDATA, NMLP, N_TO_ALIGN, DJWRBID, NHEXAMERS 25:      &        MLPIN, MLPOUT, MLPHIDDEN, MLPDATA, NMLP, N_TO_ALIGN, DJWRBID
 26:  26: 
 27:       LOGICAL :: DTEST, MASST, RTEST, EFSTEPST, VECTORST, SUMMARYT, DUMPV, DUMPMAG, FREEZE, FREEZERANGE, GRADSQ, & 27:       LOGICAL :: DTEST, MASST, RTEST, EFSTEPST, VECTORST, SUMMARYT, DUMPV, DUMPMAG, FREEZE, FREEZERANGE, GRADSQ, &
 28:      &        PGRAD, VALUEST, ADMT, BFGSMINT, BFGSTST, CHECKINDEX, TOSI, CONTAINER, & 28:      &        PGRAD, VALUEST, ADMT, BFGSMINT, BFGSTST, CHECKINDEX, TOSI, CONTAINER, &
 29:      &        GAUSSIAN, CADPAC, PRESSURE, FTEST, DCHECK, CP2K, DFTP, CPMD, CPMDC, FREEZERES, DF1T, & 29:      &        GAUSSIAN, CADPAC, PRESSURE, FTEST, DCHECK, CP2K, DFTP, CPMD, CPMDC, FREEZERES, DF1T, &
 30:      &        VARIABLES, FIELDT, OHT, IHT, TDT, D5HT, TWOENDS, PV, FRACTIONAL, BLNT, HYBRIDMINT, & 30:      &        VARIABLES, FIELDT, OHT, IHT, TDT, D5HT, TWOENDS, PV, FRACTIONAL, BLNT, HYBRIDMINT, &
 31:      &        INDEXT, LANCZOST, NOSHIFT, GAMESSUS, GAMESSUK, PVTS, RIGIDBODY, CASTEP, ONETEP, QCHEM, QCHEMES, VASP, & 31:      &        INDEXT, LANCZOST, NOSHIFT, GAMESSUS, GAMESSUK, PVTS, RIGIDBODY, CASTEP, ONETEP, QCHEM, QCHEMES, VASP, &
 32:      &        BFGSSTEP, BULKT, HUPDATE, NOHESS, READV, NOIT, THOMSONT, SIO2T, SIO2C6T, BISECTT, BISECTDEBUG, & 32:      &        BFGSSTEP, BULKT, HUPDATE, NOHESS, READV, NOIT, THOMSONT, SIO2T, SIO2C6T, BISECTT, BISECTDEBUG, &
 33:      &        TOSIC6, TOSIPOL, FIXIMAGE, DFTBT, CHECKCONT, CHECKDT, SHIFTED, READSP, DUMPSP, NOFRQS, & 33:      &        TOSIC6, TOSIPOL, FIXIMAGE, DFTBT, CHECKCONT, CHECKDT, SHIFTED, READSP, DUMPSP, NOFRQS, &
 34:      &        ALLSTEPS, ALLVECTORS, MWVECTORS, WELCH, BINARY, READHESS, MOVIE, NORESET, TWOD, & 34:      &        ALLSTEPS, ALLVECTORS, MWVECTORS, WELCH, BINARY, READHESS, MOVIE, NORESET, TWOD, &
 35:      &        DOUBLET, REOPT, PARALLEL, LINEMIN, FIXD, KEEPINDEX, BSMIN, PRINTPTS, RKMIN, REPELTST,& 35:      &        DOUBLET, REOPT, PARALLEL, LINEMIN, FIXD, KEEPINDEX, BSMIN, PRINTPTS, RKMIN, REPELTST,&


r30413/keywords.f 2016-05-09 14:30:11.633806970 +0100 r30412/keywords.f 2016-05-09 14:30:13.229828285 +0100
678:          NOINVERSION=.FALSE.678:          NOINVERSION=.FALSE.
679:          PMPATHT=.FALSE.679:          PMPATHT=.FALSE.
680:          PMPATHINR=6680:          PMPATHINR=6
681:          AAORIENTT=.FALSE.681:          AAORIENTT=.FALSE.
682:          KAA=1.0D0682:          KAA=1.0D0
683:          SIGMAAA=0.0D0683:          SIGMAAA=0.0D0
684:          MULTIJOBT=.FALSE.684:          MULTIJOBT=.FALSE.
685:          MULTISTART=''685:          MULTISTART=''
686:          MULTIFINISH=''686:          MULTIFINISH=''
687:          DJWRBT=.FALSE.687:          DJWRBT=.FALSE.
688:          NHEXAMERS=0 
689:          ! 688:          ! 
690:          ! General mixed LJ systems689:          ! General mixed LJ systems
691:          ! 690:          ! 
692:          GLJT=.FALSE.691:          GLJT=.FALSE.
693:          NGLJ=1 ! number of atom types692:          NGLJ=1 ! number of atom types
694:          ! 693:          ! 
695:          ! ds656> substrate field(s)694:          ! ds656> substrate field(s)
696:          MIEFT=.FALSE.695:          MIEFT=.FALSE.
697:          MIEF_PBCT=.FALSE.696:          MIEF_PBCT=.FALSE.
698:          MIEF_CUTT=.FALSE.697:          MIEF_CUTT=.FALSE.
2263: 2262: 
2264:          ELSE IF (WORD.EQ.'DJWRB') THEN2263:          ELSE IF (WORD.EQ.'DJWRB') THEN
2265:             DJWRBT=.TRUE.2264:             DJWRBT=.TRUE.
2266:             CALL READI(DJWRBID)2265:             CALL READI(DJWRBID)
2267:             IF (.NOT.ALLOCATED(ATMASS)) ALLOCATE(ATMASS(NATOMS))2266:             IF (.NOT.ALLOCATED(ATMASS)) ALLOCATE(ATMASS(NATOMS))
2268:             ATMASS(1:NATOMS)=1.0D02267:             ATMASS(1:NATOMS)=1.0D0
2269:             IF (DJWRBID /= 1) THEN2268:             IF (DJWRBID /= 1) THEN
2270:                PRINT *, 'DJWRB id ',DJWRBID,' unknown'2269:                PRINT *, 'DJWRB id ',DJWRBID,' unknown'
2271:                STOP2270:                STOP
2272:             ENDIF2271:             ENDIF
2273:             IF (NITEMS.GT.2) CALL READI(NHEXAMERS)2272: 
2274: ! 2273: ! 
2275: ! DCHECK  turns ON/OFF warnings about short interatomic distances2274: ! DCHECK  turns ON/OFF warnings about short interatomic distances
2276: ! default ON2275: ! default ON
2277: ! 2276: ! 
2278:          ELSE IF (WORD.EQ.'DMBLPY') THEN2277:          ELSE IF (WORD.EQ.'DMBLPY') THEN
2279: 2278: 
2280:             DMBLPYT = .TRUE.2279:             DMBLPYT = .TRUE.
2281:             RBAAT   = .TRUE.2280:             RBAAT   = .TRUE.
2282:             CALL READF(YEPS)2281:             CALL READF(YEPS)
2283:             CALL READF(YKAPPA)2282:             CALL READF(YKAPPA)


r30413/lopermdist.f90 2016-05-09 14:30:11.821809480 +0100 r30412/lopermdist.f90 2016-05-09 14:30:13.437831054 +0100
 56: DOUBLE PRECISION TIME0, TIME1 56: DOUBLE PRECISION TIME0, TIME1
 57: DOUBLE PRECISION, ALLOCATABLE :: TEMPA(:), TEMPB(:) 57: DOUBLE PRECISION, ALLOCATABLE :: TEMPA(:), TEMPB(:)
 58: CHARACTER(LEN=5) ZSYMSAVE 58: CHARACTER(LEN=5) ZSYMSAVE
 59: COMMON /SYS/ ZSYMSAVE 59: COMMON /SYS/ ZSYMSAVE
 60: DOUBLE PRECISION XA, XB, YA, YB, ZA, ZB, DMEAN(NATOMS), DA, DB 60: DOUBLE PRECISION XA, XB, YA, YB, ZA, ZB, DMEAN(NATOMS), DA, DB
 61: INTEGER TRIED(NATOMS), DLIST(NATOMS), SORTLIST(NATOMS), NDUMMY2, INGROUP(NATOMS), NADDED 61: INTEGER TRIED(NATOMS), DLIST(NATOMS), SORTLIST(NATOMS), NDUMMY2, INGROUP(NATOMS), NADDED
 62:  62: 
 63: IF (DEBUG) THEN 63: IF (DEBUG) THEN
 64:    IF (CHRMMT) CALL UPDATENBONDS(COORDSA) 64:    IF (CHRMMT) CALL UPDATENBONDS(COORDSA)
 65:    CALL POTENTIAL(COORDSA,AINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.) 65:    CALL POTENTIAL(COORDSA,AINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
 66:    PRINT '(2(A,G25.15))',' initial energy for structure A=             ',AINIT,' RMS=',RMS 66:    PRINT '(2(A,G25.15))',' initial energy for minimum A=             ',AINIT,' RMS=',RMS
 67:    IF (RMS-MAX(GMAX,CONVR).GT.1.0D-6) THEN 67:    IF (RMS-MAX(GMAX,CONVR).GT.1.0D-6) THEN
 68:       PRINT '(A)',' lopermdist> WARNING *** RMS for structure A is outside tolerance' 68:       PRINT '(A)',' lopermdist> WARNING *** RMS for minimum A is outside tolerance'
 69:    ENDIF 69:    ENDIF
 70:    IF (CHRMMT) CALL UPDATENBONDS(COORDSB) 70:    IF (CHRMMT) CALL UPDATENBONDS(COORDSB)
 71:    CALL POTENTIAL(COORDSB,BINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.) 71:    CALL POTENTIAL(COORDSB,BINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
 72:    PRINT '(2(A,G25.15))',' initial energy for structure B=             ',BINIT,' RMS=',RMS 72:    PRINT '(2(A,G25.15))',' initial energy for minimum B=             ',BINIT,' RMS=',RMS
 73:    IF (RMS-MAX(GMAX,CONVR).GT.1.0D-6) THEN 73:    IF (RMS-MAX(GMAX,CONVR).GT.1.0D-6) THEN
 74:       PRINT '(A)',' lopermdist> WARNING *** RMS for structure B is outside tolerance' 74:       PRINT '(A)',' lopermdist> WARNING *** RMS for minimum B is outside tolerance'
 75:    ENDIF 75:    ENDIF
 76: ENDIF 76: ENDIF
 77:  77: 
 78: LPC2=LOCALPERMCUT**2 78: LPC2=LOCALPERMCUT**2
 79: LPC22=LOCALPERMCUT2**2 79: LPC22=LOCALPERMCUT2**2
 80: DBEST=1.0D100 80: DBEST=1.0D100
 81: PERMUTABLE(1:NATOMS)=.FALSE. 81: PERMUTABLE(1:NATOMS)=.FALSE.
 82: NDUMMY=1 82: NDUMMY=1
 83: DO J1=1,NPERMGROUP 83: DO J1=1,NPERMGROUP
 84:    DO J2=1,NPERMSIZE(J1) 84:    DO J2=1,NPERMSIZE(J1)
504: 504: 
505: COORDSA(1:3*NATOMS)=XBEST(1:3*NATOMS) ! finally, best COORDSA should include permutations for DNEB input!505: COORDSA(1:3*NATOMS)=XBEST(1:3*NATOMS) ! finally, best COORDSA should include permutations for DNEB input!
506: 506: 
507: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!507: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
508: ! IF (DEBUG) PRINT '(A)',' lopermdist> Overall permutation for COORDSA (second argument):'508: ! IF (DEBUG) PRINT '(A)',' lopermdist> Overall permutation for COORDSA (second argument):'
509: ! IF (DEBUG) PRINT '(20I6)',BESTPERM(1:NATOMS)509: ! IF (DEBUG) PRINT '(20I6)',BESTPERM(1:NATOMS)
510: 510: 
511: IF (DEBUG) THEN511: IF (DEBUG) THEN
512:    IF (CHRMMT) CALL UPDATENBONDS(COORDSA)512:    IF (CHRMMT) CALL UPDATENBONDS(COORDSA)
513:    CALL POTENTIAL(COORDSA,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)513:    CALL POTENTIAL(COORDSA,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
514:    PRINT '(2(A,G25.15))',' lopermdist> final   energy for structure A=             ',ENERGY,' RMS=',RMS514:    PRINT '(2(A,G25.15))',' lopermdist> final   energy for minimum A=             ',ENERGY,' RMS=',RMS
515:    IF (ABS(ENERGY-AINIT).GT.EDIFFTOL) THEN515:    IF (ABS(ENERGY-AINIT).GT.EDIFFTOL) THEN
516:       PRINT '(A)',' minpermdist> WARNING *** energy change for structure A is outside tolerance'516:       PRINT '(A)',' minpermdist> WARNING *** energy change for minimum A is outside tolerance'
517:    ENDIF517:    ENDIF
518:    IF (CHRMMT) CALL UPDATENBONDS(COORDSB)518:    IF (CHRMMT) CALL UPDATENBONDS(COORDSB)
519:    CALL POTENTIAL(COORDSB,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)519:    CALL POTENTIAL(COORDSB,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
520:    PRINT '(2(A,G25.15))',' lopermdist> final   energy for structure B=             ',ENERGY,' RMS=',RMS520:    PRINT '(2(A,G25.15))',' lopermdist> final   energy for minimum B=             ',ENERGY,' RMS=',RMS
521:    IF (ABS(ENERGY-BINIT).GT.EDIFFTOL) THEN521:    IF (ABS(ENERGY-BINIT).GT.EDIFFTOL) THEN
522:       PRINT '(A)',' minpermdist> WARNING *** energy change for structure B is outside tolerance'522:       PRINT '(A)',' minpermdist> WARNING *** energy change for minimum B is outside tolerance'
523:    ENDIF523:    ENDIF
524: ENDIF524: ENDIF
525: 525: 
526: RETURN526: RETURN
527: END SUBROUTINE LOPERMDIST527: END SUBROUTINE LOPERMDIST
528: 528: 
529: SUBROUTINE DEPTHSEARCH(PATOMS,MAXSEP,NDUMMY,NPG,NDIST1)529: SUBROUTINE DEPTHSEARCH(PATOMS,MAXSEP,NDUMMY,NPG,NDIST1)
530: USE KEY, ONLY : CONIFIX, CONJFIX, NCONSTRAINTFIX, CONCUTFIX, NPERMSIZE, PERMGROUP530: USE KEY, ONLY : CONIFIX, CONJFIX, NCONSTRAINTFIX, CONCUTFIX, NPERMSIZE, PERMGROUP
531: USE COMMONS, ONLY: NATOMS, DEBUG531: USE COMMONS, ONLY: NATOMS, DEBUG
532: IMPLICIT NONE532: IMPLICIT NONE


r30413/minpermdist.f90 2016-05-09 14:30:12.017812098 +0100 r30412/minpermdist.f90 2016-05-09 14:30:13.637833730 +0100
149:    ! loop any more, but somehow during this subroutine COORDSA gets truncated to a much149:    ! loop any more, but somehow during this subroutine COORDSA gets truncated to a much
150:    ! shorter array, which later on causes a segfault.150:    ! shorter array, which later on causes a segfault.
151:    ! It seems to happen in between the end of the subroutine GENRIGID_POTENTIAL and the151:    ! It seems to happen in between the end of the subroutine GENRIGID_POTENTIAL and the
152:    ! point at which the array is returned to this subroutine.152:    ! point at which the array is returned to this subroutine.
153: !jdf43> infinite153: !jdf43> infinite
154:       CALL GENRIGID_POTENTIAL(COORDSA,AINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)154:       CALL GENRIGID_POTENTIAL(COORDSA,AINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
155: !jdf43> loop155: !jdf43> loop
156:    ELSE156:    ELSE
157:       CALL POTENTIAL(COORDSA,AINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)157:       CALL POTENTIAL(COORDSA,AINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
158:    ENDIF158:    ENDIF
159:    PRINT '(2(A,F25.15))',' initial energy for structure A=             ',AINIT,' RMS=',RMS159:    PRINT '(2(A,F25.15))',' initial energy for minimum A=             ',AINIT,' RMS=',RMS
160:    IF (RMS-MAX(GMAX,CONVR).GT.1.0D-6) THEN160:    IF (RMS-MAX(GMAX,CONVR).GT.1.0D-6) THEN
161:       PRINT '(A)',' minpermdist> WARNING *** RMS for structure A is outside tolerance'161:       PRINT '(A)',' minpermdist> WARNING *** RMS for minimum A is outside tolerance'
162:    ENDIF162:    ENDIF
163:    IF (CHRMMT) CALL UPDATENBONDS(COORDSB)163:    IF (CHRMMT) CALL UPDATENBONDS(COORDSB)
164:    IF (RIGIDINIT) THEN164:    IF (RIGIDINIT) THEN
165: !jdf43> infinite165: !jdf43> infinite
166:       CALL GENRIGID_POTENTIAL(COORDSB,BINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)166:       CALL GENRIGID_POTENTIAL(COORDSB,BINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
167: !jdf43> loop167: !jdf43> loop
168:    ELSE168:    ELSE
169:       CALL POTENTIAL(COORDSB,BINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)169:       CALL POTENTIAL(COORDSB,BINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
170:    ENDIF170:    ENDIF
171:    PRINT '(2(A,F25.15))',' initial energy for structure B=             ',BINIT,' RMS=',RMS171:    PRINT '(2(A,F25.15))',' initial energy for minimum B=             ',BINIT,' RMS=',RMS
172:    IF ((.NOT.MCPATHT).AND.(RMS-MAX(GMAX,CONVR).GT.1.0D-6)) THEN172:    IF ((.NOT.MCPATHT).AND.(RMS-MAX(GMAX,CONVR).GT.1.0D-6)) THEN
173:       PRINT '(A)',' minpermdist> WARNING *** RMS for structure B is outside tolerance - QCI/DNEB endpoint alignment?'173:       PRINT '(A)',' minpermdist> WARNING *** RMS for structure B is outside tolerance - QCI/DNEB endpoint alignment?'
174:    ENDIF174:    ENDIF
175: ENDIF175: ENDIF
176: 176: 
177: 177: 
178: IF (RIGIDINIT .AND. ALIGNRBST) THEN178: IF (RIGIDINIT .AND. ALIGNRBST) THEN
179:     CALL ALIGN_RBS(COORDSA, COORDSB, DEBUG, BULKT, TWOD, DISTANCE, DIST2, RMATBEST)179:     CALL ALIGN_RBS(COORDSA, COORDSB, DEBUG, BULKT, TWOD, DISTANCE, DIST2, RMATBEST)
180:     RETURN180:     RETURN
181: ENDIF181: ENDIF
270:    RETURN270:    RETURN
271: ELSEIF (LPERMDIST) THEN271: ELSEIF (LPERMDIST) THEN
272:    CALL LOPERMDIST(COORDSB,COORDSA,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE,DIST2,RIGID,RMATBEST)272:    CALL LOPERMDIST(COORDSB,COORDSA,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE,DIST2,RIGID,RMATBEST)
273:    IF (DEBUG) THEN273:    IF (DEBUG) THEN
274:       IF (CHRMMT) CALL UPDATENBONDS(COORDSA)274:       IF (CHRMMT) CALL UPDATENBONDS(COORDSA)
275:       IF (RIGIDINIT ) THEN275:       IF (RIGIDINIT ) THEN
276:          CALL GENRIGID_POTENTIAL(COORDSA,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)276:          CALL GENRIGID_POTENTIAL(COORDSA,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
277:       ELSE277:       ELSE
278:          CALL POTENTIAL(COORDSA,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)278:          CALL POTENTIAL(COORDSA,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
279:       ENDIF279:       ENDIF
280:       PRINT '(2(A,G25.15))',' minpermdist> final   energy for structure A=             ',ENERGY,' RMS=',RMS280:       PRINT '(2(A,G25.15))',' minpermdist> final   energy for minimum A=             ',ENERGY,' RMS=',RMS
281:       IF (ABS(ENERGY-AINIT).GT.2*EDIFFTOL) THEN281:       IF (ABS(ENERGY-AINIT).GT.2*EDIFFTOL) THEN
282:          PRINT '(A)',' minpermdist> ERROR *** energy change for structure A is outside tolerance - QCI/DNEB endpoint alignment?'282:          PRINT '(A)',' minpermdist> ERROR *** energy change for minimum A is outside tolerance - QCI/DNEB endpoint alignment?'
283:       ENDIF283:       ENDIF
284:       IF (CHRMMT) CALL UPDATENBONDS(COORDSB)284:       IF (CHRMMT) CALL UPDATENBONDS(COORDSB)
285:       IF (RIGIDINIT) THEN285:       IF (RIGIDINIT) THEN
286:          CALL GENRIGID_POTENTIAL(COORDSB,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)286:          CALL GENRIGID_POTENTIAL(COORDSB,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
287:       ELSE287:       ELSE
288:          CALL POTENTIAL(COORDSB,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)288:          CALL POTENTIAL(COORDSB,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
289:       ENDIF289:       ENDIF
290:       PRINT '(2(A,G25.15))',' minpermdist> final   energy for structure B=             ',ENERGY,' RMS=',RMS290:       PRINT '(2(A,G25.15))',' minpermdist> final   energy for minimum B=             ',ENERGY,' RMS=',RMS
291:       IF (ABS(ENERGY-BINIT).GT.2*EDIFFTOL) THEN291:       IF (ABS(ENERGY-BINIT).GT.2*EDIFFTOL) THEN
292:          PRINT '(A)',' minpermdist> ERROR *** energy change for structure B is outside tolerance - QCI/DNEB endpoint alignment?'292:          PRINT '(A)',' minpermdist> ERROR *** energy change for minimum B is outside tolerance - QCI/DNEB endpoint alignment?'
293:       ENDIF293:       ENDIF
294:    ENDIF294:    ENDIF
295: 295: 
296:    RETURN296:    RETURN
297: ENDIF297: ENDIF
298: 298: 
299: IF (INTMINPERMT.AND.(INTINTERPT.OR.DESMINT)) THEN299: IF (INTMINPERMT.AND.(INTINTERPT.OR.DESMINT)) THEN
300:     IF (CHRMMT.OR.OLDINTMINPERMT) THEN300:     IF (CHRMMT.OR.OLDINTMINPERMT) THEN
301:       !CALL MYCPU_TIME(TIME0,.FALSE.)301:       !CALL MYCPU_TIME(TIME0,.FALSE.)
302:       CALL OLD_INTMINPERM(COORDSB, COORDSA, DISTANCE, RMAT, DEBUG)302:       CALL OLD_INTMINPERM(COORDSB, COORDSA, DISTANCE, RMAT, DEBUG)
975:          DISTANCE=DISTANCE**2 ! minpermdist used to return the distance squared for historical reasons!975:          DISTANCE=DISTANCE**2 ! minpermdist used to return the distance squared for historical reasons!
976:       ENDIF976:       ENDIF
977: 977: 
978: IF (DEBUG) THEN978: IF (DEBUG) THEN
979:    IF (CHRMMT) CALL UPDATENBONDS(COORDSA)979:    IF (CHRMMT) CALL UPDATENBONDS(COORDSA)
980:    IF (RIGIDINIT) THEN980:    IF (RIGIDINIT) THEN
981:       CALL GENRIGID_POTENTIAL(COORDSA,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)981:       CALL GENRIGID_POTENTIAL(COORDSA,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
982:    ELSE982:    ELSE
983:       CALL POTENTIAL(COORDSA,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)983:       CALL POTENTIAL(COORDSA,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
984:    ENDIF984:    ENDIF
985:    PRINT '(2(A,F25.15))',' final   energy for structure A=             ',ENERGY,' RMS=',RMS985:    PRINT '(2(A,F25.15))',' final   energy for minimum A=             ',ENERGY,' RMS=',RMS
986:    IF (ABS(ENERGY-AINIT).GT.2*EDIFFTOL) THEN986:    IF (ABS(ENERGY-AINIT).GT.2*EDIFFTOL) THEN
987:       PRINT '(A)',' minpermdist> ERROR *** energy change for structure A is outside tolerance'987:       PRINT '(A)',' minpermdist> ERROR *** energy change for minimum A is outside tolerance'
988:       STOP988:       STOP
989:    ENDIF989:    ENDIF
990:    IF (CHRMMT) CALL UPDATENBONDS(COORDSB)990:    IF (CHRMMT) CALL UPDATENBONDS(COORDSB)
991:    IF (RIGIDINIT) THEN991:    IF (RIGIDINIT) THEN
992:       CALL GENRIGID_POTENTIAL(COORDSB,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)992:       CALL GENRIGID_POTENTIAL(COORDSB,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
993:    ELSE993:    ELSE
994:       CALL POTENTIAL(COORDSB,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)994:       CALL POTENTIAL(COORDSB,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
995:    ENDIF995:    ENDIF
996:    PRINT '(2(A,F25.15))',' final   energy for structure B=             ',ENERGY,' RMS=',RMS996:    PRINT '(2(A,F25.15))',' final   energy for minimum B=             ',ENERGY,' RMS=',RMS
997:    IF (ABS(ENERGY-BINIT).GT.2*EDIFFTOL) THEN997:    IF (ABS(ENERGY-BINIT).GT.2*EDIFFTOL) THEN
998:       PRINT '(A)',' minpermdist> ERROR *** energy change for structure B is outside tolerance'998:       PRINT '(A)',' minpermdist> ERROR *** energy change for minimum B is outside tolerance'
999:       STOP999:       STOP
1000:    ENDIF1000:    ENDIF
1001: ENDIF1001: ENDIF
1002: 1002: 
1003: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1003: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1004: ! IF (DEBUG) PRINT '(A)',' minpermdist> Overall permutation for COORDSA (second argument):'1004: ! IF (DEBUG) PRINT '(A)',' minpermdist> Overall permutation for COORDSA (second argument):'
1005: ! IF (DEBUG) PRINT '(20I6)',BESTPERM(1:NATOMS)1005: ! IF (DEBUG) PRINT '(20I6)',BESTPERM(1:NATOMS)
1006: ! PRINT '(I6)',NATOMS1006: ! PRINT '(I6)',NATOMS
1007: ! PRINT '(A)','coordsa in minpermdist:'1007: ! PRINT '(A)','coordsa in minpermdist:'
1008: ! PRINT '(A,3F20.10)',('LA ',COORDSA(3*(J1-1)+1),COORDSA(3*(J1-1)+2),COORDSA(3*(J1-1)+3),J1=1,NATOMS)1008: ! PRINT '(A,3F20.10)',('LA ',COORDSA(3*(J1-1)+1),COORDSA(3*(J1-1)+2),COORDSA(3*(J1-1)+3),J1=1,NATOMS)


r30413/ncutils.f90 2016-05-09 14:30:10.213788010 +0100 r30412/ncutils.f90 2016-05-09 14:30:12.233814981 +0100
 35:            35:           
 36:           INTEGER :: I, SAMEAS 36:           INTEGER :: I, SAMEAS
 37:           DOUBLE PRECISION :: XCOORDS1(NOPT), XCOORDS2(NOPT) 37:           DOUBLE PRECISION :: XCOORDS1(NOPT), XCOORDS2(NOPT)
 38:  38: 
 39:           SAMEAS=0 39:           SAMEAS=0
 40:           IF (NTS==0) THEN 40:           IF (NTS==0) THEN
 41:                NCISNEWTS=.TRUE. 41:                NCISNEWTS=.TRUE.
 42:                RETURN 42:                RETURN
 43:           ENDIF 43:           ENDIF
 44:  44: 
 45:           PRINT *,'ncisnewts> NTS=',NTS 
 46:           DO I=1,NTS 45:           DO I=1,NTS
 47:                PRINT *,'I,TSTOCHECK%E,TS(I)%DATA%E=',I,TSTOCHECK%E,TS(I)%DATA%E 
 48:                IF (ABS(TSTOCHECK%E-TS(I)%DATA%E) < EDIFFTOL) THEN 46:                IF (ABS(TSTOCHECK%E-TS(I)%DATA%E) < EDIFFTOL) THEN
 49:                   IF (RIGIDINIT) THEN 47:                   IF (RIGIDINIT) THEN
 50:                      CALL TRANSFORMRIGIDTOC(1,NRIGIDBODY, XCOORDS1, TSTOCHECK%COORD(1:DEGFREEDOMS)) 48:                      CALL TRANSFORMRIGIDTOC(1,NRIGIDBODY, XCOORDS1, TSTOCHECK%COORD(1:DEGFREEDOMS))
 51:                      CALL TRANSFORMRIGIDTOC(1,NRIGIDBODY, XCOORDS2, TS(I)%DATA%X(1:DEGFREEDOMS)) 49:                      CALL TRANSFORMRIGIDTOC(1,NRIGIDBODY, XCOORDS2, TS(I)%DATA%X(1:DEGFREEDOMS))
 52:                      CALL MINPERMDIST(XCOORDS1,XCOORDS2, NATOMS, & 50:                      CALL MINPERMDIST(XCOORDS1,XCOORDS2, NATOMS, &
 53:                           &   DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT) 51:                           &   DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT)
 54:                   ELSE 52:                   ELSE
 55:                      CALL MINPERMDIST(TSTOCHECK%COORD,TS(I)%DATA%X, NATOMS, & 53:                      CALL MINPERMDIST(TSTOCHECK%COORD,TS(I)%DATA%X, NATOMS, &
 56:   &                                 DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT) 54:   &                                 DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT)
 57:                   ENDIF 55:                   ENDIF


r30413/OPTIM.F 2016-05-09 14:30:10.597793137 +0100 r30412/OPTIM.F 2016-05-09 14:30:12.641820430 +0100
 42: !     USE BENCHMARKS, ONLY : MINBMT, MINBM 42: !     USE BENCHMARKS, ONLY : MINBMT, MINBM
 43: ! hk286 43: ! hk286
 44:       USE GENRIGID 44:       USE GENRIGID
 45:  45: 
 46:       IMPLICIT NONE 46:       IMPLICIT NONE
 47: ! subroutine parameters   47: ! subroutine parameters  
 48:       INTEGER F1,F2 48:       INTEGER F1,F2
 49:       CHARACTER(LEN=80) FLSTRING 49:       CHARACTER(LEN=80) FLSTRING
 50:       CHARACTER(LEN=2) DUMMYS 50:       CHARACTER(LEN=2) DUMMYS
 51:  51: 
 52:       INTEGER J1, J2, NPCALL, ECALL, FCALL, SCALL, HORDER, NATOMSSAVE, SUNIT, FUNIT, MULTIINR 52:       INTEGER J1, J2, NPCALL, ECALL, FCALL, SCALL, HORDER, NATOMSSAVE, SUNIT, FUNIT
 53:       DOUBLE PRECISION VNEW(NOPT), ENERGY, EVALMIN, RMS, VECS(NOPT), QSAVE(NOPT), 53:       DOUBLE PRECISION VNEW(NOPT), ENERGY, EVALMIN, RMS, VECS(NOPT), QSAVE(NOPT),
 54:      1  QPLUS(NOPT), LGDUMMY(NOPT),RMSINITIAL,RMSFINAL,E1,E2, RMAT(3,3), 54:      1  QPLUS(NOPT), LGDUMMY(NOPT),RMSINITIAL,RMSFINAL,E1,E2, RMAT(3,3),
 55:      2  DIST, OVEC(3), H1VEC(3), H2VEC(3), Q(NOPT), EINITIAL, EFINAL,  55:      2  DIST, OVEC(3), H1VEC(3), H2VEC(3), Q(NOPT), EINITIAL, EFINAL, 
 56:      3  ETIME, FTIME, STIME, DPRAND, DCOORDS(NOPT), INTFREEZETOLSAVE, 56:      3  ETIME, FTIME, STIME, DPRAND, DCOORDS(NOPT), INTFREEZETOLSAVE,
 57:      4  ETS, EPLUS, EMINUS, SLENGTH, DISP, GAMMA, NTILDE,  57:      4  ETS, EPLUS, EMINUS, SLENGTH, DISP, GAMMA, NTILDE, 
 58:      5  FRQSTS(NOPT), FRQSPLUS(NOPT), FRQSMINUS(NOPT), QMINUS(NOPT), DISTSF 58:      5  FRQSTS(NOPT), FRQSPLUS(NOPT), FRQSMINUS(NOPT), QMINUS(NOPT), DISTSF
 59:       DOUBLE PRECISION THTEMP(NOPT) 59:       DOUBLE PRECISION THTEMP(NOPT)
 60:       CHARACTER ESTRING*87, GPSTRING*80, NSTRING*80, FSTRING*80, FNAME*13, FNAMEV*18,  60:       CHARACTER ESTRING*87, GPSTRING*80, NSTRING*80, FSTRING*80, FNAME*13, FNAMEV*18, 
 61:      1          ITSTRING*22, EOFSSTRING*15 61:      1          ITSTRING*22, EOFSSTRING*15
 62:       CHARACTER(LEN=80) FNAMEF 62:       CHARACTER(LEN=80) FNAMEF
236: C  account for this in BFGSTS.236: C  account for this in BFGSTS.
237: C     IF (NOIT) NOSHIFT=.FALSE.237: C     IF (NOIT) NOSHIFT=.FALSE.
238: C     IF (VARIABLES) NOSHIFT=.TRUE.238: C     IF (VARIABLES) NOSHIFT=.TRUE.
239: C     NOSHIFT=(FIELDT.OR.BFGSMINT.OR.BSMIN.OR.RKMIN.OR.NOHESS.OR.BFGSSTEP)239: C     NOSHIFT=(FIELDT.OR.BFGSMINT.OR.BSMIN.OR.RKMIN.OR.NOHESS.OR.BFGSSTEP)
240: C     IF (INR.GE.0) NOSHIFT=.FALSE. ! changed INR default value in keywords to -1240: C     IF (INR.GE.0) NOSHIFT=.FALSE. ! changed INR default value in keywords to -1
241: C     IF (NOIT) NOSHIFT=.FALSE.241: C     IF (NOIT) NOSHIFT=.FALSE.
242: C     IF (VARIABLES) NOSHIFT=.TRUE.242: C     IF (VARIABLES) NOSHIFT=.TRUE.
243: C243: C
244: C  Jump back here for MULTIJOB runs.244: C  Jump back here for MULTIJOB runs.
245: C245: C
246:       MULTIINR=INR 
247: 963   CONTINUE246: 963   CONTINUE
248: C247: C
249: C  Resize the system if required.248: C  Resize the system if required.
250: C249: C
251:       IF (RESIZE.NE.1.0D0) THEN250:       IF (RESIZE.NE.1.0D0) THEN
252:          PRINT*,'Scaling coordinates by ',RESIZE251:          PRINT*,'Scaling coordinates by ',RESIZE
253:          IF (ZSYMSAVE(1:1).EQ.'W') THEN252:          IF (ZSYMSAVE(1:1).EQ.'W') THEN
254:             DO J1=1,3*(NATOMS/2)253:             DO J1=1,3*(NATOMS/2)
255:                Q(J1)=Q(J1)*RESIZE254:                Q(J1)=Q(J1)*RESIZE
256:             ENDDO255:             ENDDO
948:             ELSE947:             ELSE
949:                WRITE(PINFOSTRING,'(A)') 'path.info.'//TRIM(ADJUSTL(FILTHSTR))948:                WRITE(PINFOSTRING,'(A)') 'path.info.'//TRIM(ADJUSTL(FILTHSTR))
950:             ENDIF949:             ENDIF
951: 950: 
952:             IF (MACHINE) THEN951:             IF (MACHINE) THEN
953:                  OPEN(UNIT=88,FILE=PINFOSTRING,STATUS='UNKNOWN',FORM='UNFORMATTED',POSITION='APPEND')952:                  OPEN(UNIT=88,FILE=PINFOSTRING,STATUS='UNKNOWN',FORM='UNFORMATTED',POSITION='APPEND')
954:             ELSE953:             ELSE
955:                  OPEN(UNIT=88,FILE=PINFOSTRING,STATUS='UNKNOWN',POSITION='APPEND')954:                  OPEN(UNIT=88,FILE=PINFOSTRING,STATUS='UNKNOWN',POSITION='APPEND')
956:             ENDIF955:             ENDIF
957:          ENDIF956:          ENDIF
958:          INR=MULTIINR 
959:          GOTO 963957:          GOTO 963
960: 864      CONTINUE958: 864      CONTINUE
961:          PRINT '(A)',' OPTIM> End of multijob coordinates'959:          PRINT '(A)',' OPTIM> End of multijob coordinates'
962:       ENDIF960:       ENDIF
963:       CALL TSUMMARY961:       CALL TSUMMARY
964: 962: 
965:       IF (INTMINT.OR.DESMINT.OR.INTINTERPT.OR.NATINT) CALL INTCLEANUP963:       IF (INTMINT.OR.DESMINT.OR.INTINTERPT.OR.NATINT) CALL INTCLEANUP
966:       IF (UNRST) DEALLOCATE(UREFCOORD,UREFPPSANGLE,INTSTEP)964:       IF (UNRST) DEALLOCATE(UREFCOORD,UREFPPSANGLE,INTSTEP)
967:       IF (ZSYM(NATOMS).EQ.'SV') call cleanMemory965:       IF (ZSYM(NATOMS).EQ.'SV') call cleanMemory
968: 966: 


r30413/tryconnect.f90 2016-05-09 14:30:10.409790627 +0100 r30412/tryconnect.f90 2016-05-09 14:30:12.449817862 +0100
497:                    WRITE(*,'(A,I7)') ' tryconnect> found old minimum ',POSITION497:                    WRITE(*,'(A,I7)') ' tryconnect> found old minimum ',POSITION
498:                 ENDIF498:                 ENDIF
499:                 NULLIFY(PINTERPCOORDS,PENERGY)499:                 NULLIFY(PINTERPCOORDS,PENERGY)
500:                 DEALLOCATE(MINFOUND(I)%E,MINFOUND(I)%COORD)500:                 DEALLOCATE(MINFOUND(I)%E,MINFOUND(I)%COORD)
501:              ENDDO501:              ENDDO
502:              if(allocated(FOUNDBEFORE)) DEALLOCATE(FOUNDBEFORE,DOAGAIN)502:              if(allocated(FOUNDBEFORE)) DEALLOCATE(FOUNDBEFORE,DOAGAIN)
503:              RETURN ! assumes that we have no TS if we have new minima. Probably OK.503:              RETURN ! assumes that we have no TS if we have new minima. Probably OK.
504:           ENDIF504:           ENDIF
505: 505: 
506: ! saving new ts into ts rack; otherwise - free memory immediately506: ! saving new ts into ts rack; otherwise - free memory immediately
507:     
508:           PRINT *,'tryconnect> A NTS=',NTS 
509: 507: 
510:           NTSOLD=NTS508:           NTSOLD=NTS
511:           UNIQUE=0509:           UNIQUE=0
512:           IF (ALLOCATED(FOUNDBEFORE)) DEALLOCATE(FOUNDBEFORE)510:           IF (ALLOCATED(FOUNDBEFORE)) DEALLOCATE(FOUNDBEFORE)
513:           IF (ALLOCATED(DOAGAIN)) DEALLOCATE(DOAGAIN)511:           IF (ALLOCATED(DOAGAIN)) DEALLOCATE(DOAGAIN)
514:           ALLOCATE(FOUNDBEFORE(NTSFOUND),DOAGAIN(NTSFOUND))512:           ALLOCATE(FOUNDBEFORE(NTSFOUND),DOAGAIN(NTSFOUND))
515:           FOUNDBEFORE(1:NTSFOUND)=.FALSE.513:           FOUNDBEFORE(1:NTSFOUND)=.FALSE.
516:           DOAGAIN(1:NTSFOUND)=.FALSE.514:           DOAGAIN(1:NTSFOUND)=.FALSE.
517:           PRINT *,'tryconnect> B NTS=',NTS 
518:           DO I=1,NTSFOUND515:           DO I=1,NTSFOUND
519:           PRINT *,'tryconnect> C NTS,I=',NTS,I516: !              PRINT '(A,2G20.10)',' tryconnect> TSFOUND(i)%E, MAXTSENERGY=',TSfound(i)%E, MAXTSENERGY
520:                PRINT '(A,2G20.10)',' tryconnect> TSFOUND(i)%E, MAXTSENERGY=',TSfound(i)%E, MAXTSENERGY 
521: ! hk286517: ! hk286
522:                AMIDEFAIL=.FALSE.518:                AMIDEFAIL=.FALSE.
523:                CHIRALFAIL=.FALSE.519:                CHIRALFAIL=.FALSE.
524:                IF (CHRMMT) THEN520:                IF (CHRMMT) THEN
525:                   IF (RIGIDINIT) THEN521:                   IF (RIGIDINIT) THEN
526:                      XRIGIDCOORDS(1:DEGFREEDOMS) = TSFOUND(I)%COORD(1:DEGFREEDOMS)522:                      XRIGIDCOORDS(1:DEGFREEDOMS) = TSFOUND(I)%COORD(1:DEGFREEDOMS)
527:                      CALL TRANSFORMRIGIDTOC(1, NRIGIDBODY, XCOORDS, XRIGIDCOORDS)523:                      CALL TRANSFORMRIGIDTOC(1, NRIGIDBODY, XCOORDS, XRIGIDCOORDS)
528:                      IF (CHECKOMEGAT) &524:                      IF (CHECKOMEGAT) &
529:                           CALL CHECKOMEGA(XCOORDS,AMIDEFAIL)525:                           CALL CHECKOMEGA(XCOORDS,AMIDEFAIL)
530:                      IF (CHECKCHIRALT) &526:                      IF (CHECKCHIRALT) &
547:                ELSEIF (TSFOUND(I)%E.GT.MAXTSENERGY) THEN543:                ELSEIF (TSFOUND(I)%E.GT.MAXTSENERGY) THEN
548:                   PRINT '(A,G20.10,A)',' tryconnect> Transition state with energy ',TSfound(i)%E,' ignored'544:                   PRINT '(A,G20.10,A)',' tryconnect> Transition state with energy ',TSfound(i)%E,' ignored'
549:                   DEALLOCATE(TSFOUND(I)%E,TSFOUND(I)%COORD,TSFOUND(I)%EVALMIN,TSFOUND(I)%VECS)545:                   DEALLOCATE(TSFOUND(I)%E,TSFOUND(I)%COORD,TSFOUND(I)%EVALMIN,TSFOUND(I)%VECS)
550: !546: !
551: ! Allow redopath to add the same transition state more than once.547: ! Allow redopath to add the same transition state more than once.
552: ! For use with different PUSHOFF and BFGSSTEP values in case the connection fails548: ! For use with different PUSHOFF and BFGSSTEP values in case the connection fails
553: ! to give the minima pair that we actually want.549: ! to give the minima pair that we actually want.
554: !550: !
555: !              ELSEIF ( NCISNEWTS(TSFOUND(I),SAMEAS).OR.REDOPATH ) THEN551: !              ELSEIF ( NCISNEWTS(TSFOUND(I),SAMEAS).OR.REDOPATH ) THEN
556:                ELSE552:                ELSE
557:           PRINT *,'tryconnect> D NTS,I=',NTS,I 
558:                   IF ((.NOT.NCISNEWTS(TSFOUND(I),SAMEAS)).AND.(.NOT.REDOPATH)) FOUNDBEFORE(I)=.TRUE.553:                   IF ((.NOT.NCISNEWTS(TSFOUND(I),SAMEAS)).AND.(.NOT.REDOPATH)) FOUNDBEFORE(I)=.TRUE.
559:                   IF (FOUNDBEFORE(I)) THEN554:                   IF (FOUNDBEFORE(I)) THEN
560:                      TS(SAMEAS)%DATA%HITS=TS(SAMEAS)%DATA%HITS+1555:                      TS(SAMEAS)%DATA%HITS=TS(SAMEAS)%DATA%HITS+1
561:                      IF (TS(SAMEAS)%DATA%HITS.LT.REDOTS) THEN556:                      IF (TS(SAMEAS)%DATA%HITS.LT.REDOTS) THEN
562:                         PRINT '(A,I6,A,G20.10)',' tryconnect> Try the path again for ts ',I,' with pushoff=',PUSHOFF/1.0D1557:                         PRINT '(A,I6,A,G20.10)',' tryconnect> Try the path again for ts ',I,' with pushoff=',PUSHOFF/1.0D1
563:                         IF (NTS==TSRACKSIZE) CALL REALLOCATETSRACK558:                         IF (NTS==TSRACKSIZE) CALL REALLOCATETSRACK
564:                         NTS=NTS+1; UNIQUE=UNIQUE+1559:                         NTS=NTS+1; UNIQUE=UNIQUE+1
565:                         DOAGAIN(UNIQUE)=.TRUE.560:                         DOAGAIN(UNIQUE)=.TRUE.
566:                         TS(NTS)%DATA%E => TSFOUND(I)%E561:                         TS(NTS)%DATA%E => TSFOUND(I)%E
567:                         TS(NTS)%DATA%X => TSFOUND(I)%COORD562:                         TS(NTS)%DATA%X => TSFOUND(I)%COORD


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0