hdiff output

r33425/congrad.f90 2017-10-30 11:30:12.790224430 +0000 r33424/congrad.f90 2017-10-30 11:30:13.694236325 +0000
  8: !   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  8: !   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  9: !   GNU General Public License for more details.  9: !   GNU General Public License for more details.
 10: ! 10: !
 11: !   You should have received a copy of the GNU General Public License 11: !   You should have received a copy of the GNU General Public License
 12: !   along with this program; if not, write to the Free Software 12: !   along with this program; if not, write to the Free Software
 13: !   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA 13: !   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 14: ! 14: !
 15: SUBROUTINE CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS) 15: SUBROUTINE CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
 16: USE KEY, ONLY: FROZEN, FREEZE, NREPI, NREPJ, NNREPULSIVE, & 16: USE KEY, ONLY: FROZEN, FREEZE, NREPI, NREPJ, NNREPULSIVE, &
 17:   &            NCONSTRAINT, CONI, CONJ, INTCONSTRAINTDEL, CONDISTREF, INTCONSTRAINTREP, CONDISTREFLOCAL, & 17:   &            NCONSTRAINT, CONI, CONJ, INTCONSTRAINTDEL, CONDISTREF, INTCONSTRAINTREP, CONDISTREFLOCAL, &
 18:   &            CONACTIVE, INTCONSTRAINREPCUT, NREPCUT,INTIMAGE, KINT, IMSEPMAX, ATOMACTIVE, JMAXCON, & 18:   &            CONACTIVE, INTCONSTRAINREPCUT, NREPCUT,INTIMAGE, KINT, IMSEPMAX, ATOMACTIVE, &
 19:   &            INTFREEZET, INTFROZEN, CONCUTLOCAL, CONCUT, CONCUTABST, CONCUTABS, CONCUTFRACT, CONCUTFRAC, & 19:   &            INTFREEZET, INTFROZEN, CONCUTLOCAL, CONCUT, CONCUTABST, CONCUTABS, CONCUTFRACT, CONCUTFRAC, &
 20:   &  FREEZENODEST, INTSPRINGACTIVET, INTMINFAC 20:   &  FREEZENODEST, INTSPRINGACTIVET, INTMINFAC
 21: USE COMMONS, ONLY: NATOMS, NOPT, DEBUG 21: USE COMMONS, ONLY: NATOMS, NOPT, DEBUG
 22: USE PORFUNCS 22: USE PORFUNCS
 23: IMPLICIT NONE 23: IMPLICIT NONE
 24:             24:            
 25: INTEGER :: J1,J2,NI2,NI1,NJ2,NJ1,NMAXINT,NMININT,NREPINT(INTIMAGE+2),ISTAT,NINTMIN,NINTMIN2,MYUNIT,JMAX,IMAX 25: INTEGER :: J1,J2,NI2,NI1,NJ2,NJ1,NMAXINT,NMININT,NREPINT(INTIMAGE+2),ISTAT,NINTMIN,NINTMIN2,MYUNIT,JMAX,IMAX
 26: DOUBLE PRECISION :: ECON, EREP, ETOTAL, RMS, EMAX 26: DOUBLE PRECISION :: ECON, EREP, ETOTAL, RMS, EMAX
 27: INTEGER JJMAX(INTIMAGE+2) 27: INTEGER JJMAX(INTIMAGE+2)
 28: DOUBLE PRECISION  EEMAX(INTIMAGE+2) 28: DOUBLE PRECISION  EEMAX(INTIMAGE+2)
 96:          GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)-REPGRAD(1:3) 96:          GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)-REPGRAD(1:3)
 97:       ENDIF 97:       ENDIF
 98: !     WRITE(MYUNIT,'(A,2I6,5G20.10)') 'J1,J2,D2,CONDISTREFLOCAL,CCLOCAL,EEE,CONE=',J1,J2,D2,CONDISTREFLOCAL(J2),CCLOCAL,EEE(J1),CONE(J1) 98: !     WRITE(MYUNIT,'(A,2I6,5G20.10)') 'J1,J2,D2,CONDISTREFLOCAL,CCLOCAL,EEE,CONE=',J1,J2,D2,CONDISTREFLOCAL(J2),CCLOCAL,EEE(J1),CONE(J1)
 99:    ENDDO 99:    ENDDO
100: ENDDO100: ENDDO
101: IF (JMAX.GT.0) THEN101: IF (JMAX.GT.0) THEN
102:    WRITE(*,'(A,I6,A,I6,A,2I8)') ' congrad> Highest constraint contribution for any image in image ',IMAX, &102:    WRITE(*,'(A,I6,A,I6,A,2I8)') ' congrad> Highest constraint contribution for any image in image ',IMAX, &
103:  & ' constraint ',JMAX, &103:  & ' constraint ',JMAX, &
104:  &                              ' atoms ',CONI(JMAX),CONJ(JMAX)104:  &                              ' atoms ',CONI(JMAX),CONJ(JMAX)
105: ENDIF105: ENDIF
106: JMAXCON=JMAX 
107: 106: 
108: 107: 
109: GGG(1:(3*NATOMS))=0.0D0                            ! can delete when loop range above changes108: GGG(1:(3*NATOMS))=0.0D0                            ! can delete when loop range above changes
110: GGG((3*NATOMS)*(INTIMAGE+1)+1:(3*NATOMS)*(INTIMAGE+2))=0.0D0 ! can delete when loop range above changes109: GGG((3*NATOMS)*(INTIMAGE+1)+1:(3*NATOMS)*(INTIMAGE+2))=0.0D0 ! can delete when loop range above changes
111: 110: 
112: ! INTCONST=INTCONSTRAINREPCUT**13111: ! INTCONST=INTCONSTRAINREPCUT**13
113: 112: 
114: EMAX=-1.0D200113: EMAX=-1.0D200
115: EEMAX(1:INTIMAGE+2)=-1.0D200114: EEMAX(1:INTIMAGE+2)=-1.0D200
116: JJMAX(1:INTIMAGE+2)=-1115: JJMAX(1:INTIMAGE+2)=-1
271: !270: !
272:       DPLUS=0.0D0271:       DPLUS=0.0D0
273:       DO J2=1,NATOMS272:       DO J2=1,NATOMS
274:          IF ((.NOT.INTSPRINGACTIVET).OR.ATOMACTIVE(J2)) THEN 273:          IF ((.NOT.INTSPRINGACTIVET).OR.ATOMACTIVE(J2)) THEN 
275:             DPLUS=DPLUS+(XYZ(NI1+3*(J2-1)+1)-XYZ(NI2+3*(J2-1)+1))**2 &274:             DPLUS=DPLUS+(XYZ(NI1+3*(J2-1)+1)-XYZ(NI2+3*(J2-1)+1))**2 &
276:   &                    +(XYZ(NI1+3*(J2-1)+2)-XYZ(NI2+3*(J2-1)+2))**2 &275:   &                    +(XYZ(NI1+3*(J2-1)+2)-XYZ(NI2+3*(J2-1)+2))**2 &
277:   &                    +(XYZ(NI1+3*(J2-1)+3)-XYZ(NI2+3*(J2-1)+3))**2276:   &                    +(XYZ(NI1+3*(J2-1)+3)-XYZ(NI2+3*(J2-1)+3))**2
278:          ENDIF277:          ENDIF
279:       ENDDO278:       ENDDO
280:       DPLUS=SQRT(DPLUS)279:       DPLUS=SQRT(DPLUS)
281: !     IF (DPLUS.GT.IMSEPMAX) THEN280:       IF (DPLUS.GT.IMSEPMAX) THEN
282: !        DUMMY=KINT*0.5D0*(DPLUS-IMSEPMAX)**2281: !        DUMMY=KINT*0.5D0*(DPLUS-IMSEPMAX)**2
283:          DUMMY=KINT*0.5D0*DPLUS**2282:          DUMMY=KINT*0.5D0*DPLUS**2
284:          IF (DUMMY.GT.EMAX) THEN283:          IF (DUMMY.GT.EMAX) THEN
285:             IMAX=J1284:             IMAX=J1
286:             EMAX=DUMMY285:             EMAX=DUMMY
287:          ENDIF286:          ENDIF
288:          ESPRING=ESPRING+DUMMY287:          ESPRING=ESPRING+DUMMY
289: !        DUMMY=KINT*(DPLUS-IMSEPMAX)/DPLUS288: !        DUMMY=KINT*(DPLUS-IMSEPMAX)/DPLUS
290:          DUMMY=KINT289:          DUMMY=KINT
291:          DO J2=1,NATOMS290:          DO J2=1,NATOMS
292:             IF ((.NOT.INTSPRINGACTIVET).OR.ATOMACTIVE(J2)) THEN 291:             IF ((.NOT.INTSPRINGACTIVET).OR.ATOMACTIVE(J2)) THEN 
293:                SPGRAD(1:3)=DUMMY*(XYZ(NI1+3*(J2-1)+1:NI1+3*(J2-1)+3)-XYZ(NI2+3*(J2-1)+1:NI2+3*(J2-1)+3))292:                SPGRAD(1:3)=DUMMY*(XYZ(NI1+3*(J2-1)+1:NI1+3*(J2-1)+3)-XYZ(NI2+3*(J2-1)+1:NI2+3*(J2-1)+3))
294:                GGG(NI1+3*(J2-1)+1:NI1+3*(J2-1)+3)=GGG(NI1+3*(J2-1)+1:NI1+3*(J2-1)+3)+SPGRAD(1:3)293:                GGG(NI1+3*(J2-1)+1:NI1+3*(J2-1)+3)=GGG(NI1+3*(J2-1)+1:NI1+3*(J2-1)+3)+SPGRAD(1:3)
295:                GGG(NI2+3*(J2-1)+1:NI2+3*(J2-1)+3)=GGG(NI2+3*(J2-1)+1:NI2+3*(J2-1)+3)-SPGRAD(1:3)294:                GGG(NI2+3*(J2-1)+1:NI2+3*(J2-1)+3)=GGG(NI2+3*(J2-1)+1:NI2+3*(J2-1)+3)-SPGRAD(1:3)
296:             ENDIF295:             ENDIF
297:          ENDDO296:          ENDDO
298: !     ENDIF297:       ENDIF
299:    ENDDO298:    ENDDO
300: ENDIF299: ENDIF
301: WRITE(*,'(A,I6,A,I6,A,2I6)') ' congrad> Highest spring  contribution for any image in image ',IMAX300: WRITE(*,'(A,I6,A,I6,A,2I6)') ' congrad> Highest spring  contribution for any image in image ',IMAX
302: 301: 
303: 302: 
304: !303: !
305: ! Set gradients on frozen atoms to zero.304: ! Set gradients on frozen atoms to zero.
306: !305: !
307: IF (FREEZE) THEN306: IF (FREEZE) THEN
308:    DO J1=2,INTIMAGE+1  307:    DO J1=2,INTIMAGE+1  
366:    ENDIF365:    ENDIF
367: ENDDO366: ENDDO
368: IF (DEBUG) WRITE(*, '(A,G20.10,A,2I6)') 'congrad> largest  internal energy=',MAXINT,' for image ',NMAXINT367: IF (DEBUG) WRITE(*, '(A,G20.10,A,2I6)') 'congrad> largest  internal energy=',MAXINT,' for image ',NMAXINT
369: IF (DEBUG) WRITE(*, '(A,G20.10,A,2I6)') 'congrad> smallest internal energy=',MININT,' for image ',NMININT368: IF (DEBUG) WRITE(*, '(A,G20.10,A,2I6)') 'congrad> smallest internal energy=',MININT,' for image ',NMININT
370: IF (DEBUG) WRITE(*, '(A,2I6)') 'congrad> number of internal minima=',NINTMIN,NINTMIN2369: IF (DEBUG) WRITE(*, '(A,2I6)') 'congrad> number of internal minima=',NINTMIN,NINTMIN2
371: 370: 
372: END SUBROUTINE CONGRAD371: END SUBROUTINE CONGRAD
373: 372: 
374: SUBROUTINE MINMAXD2(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, &373: SUBROUTINE MINMAXD2(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, &
375:   &                 D2,D1,DINT,G1,G2,G1INT,G2INT,NOINT,DEBUG)374:   &                 D2,D1,DINT,G1,G2,G1INT,G2INT,NOINT,DEBUG)
376: USE KEY, ONLY : CHECKCONINT 
377: IMPLICIT NONE375: IMPLICIT NONE
378: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,D2,D1,DINT376: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,D2,D1,DINT
379: DOUBLE PRECISION G1(3),G2(3),G1INT(3),G2INT(3)377: DOUBLE PRECISION G1(3),G2(3),G1INT(3),G2INT(3)
380: DOUBLE PRECISION DSQ2, DSQ1, DSQI, r1apr2bmr2amr1bsq, r1amr1bsq, r2amr2bsq378: DOUBLE PRECISION DSQ2, DSQ1, DSQI, r1apr2bmr2amr1bsq, r1amr1bsq, r2amr2bsq
381: DOUBLE PRECISION r1amr1bdr2amr2b, r1amr1bdr2amr2bsq, DUMMY379: DOUBLE PRECISION r1amr1bdr2amr2b, r1amr1bdr2amr2bsq, DUMMY
382: LOGICAL NOINT, DEBUG380: LOGICAL NOINT, DEBUG
383: !381: !
384: ! Squared distance between atoms A and B for theta=0 - distance in image 2382: ! Squared distance between atoms A and B for theta=0 - distance in image 2
385: !383: !
386: DSQ2=r2ax**2 + r2ay**2 + r2az**2 + r2bx**2 + r2by**2 + r2bz**2 - 2*(r2ax*r2bx + r2ay*r2by + r2az*r2bz)384: DSQ2=r2ax**2 + r2ay**2 + r2az**2 + r2bx**2 + r2by**2 + r2bz**2 - 2*(r2ax*r2bx + r2ay*r2by + r2az*r2bz)
409: D2=SQRT(DSQ2)407: D2=SQRT(DSQ2)
410: D1=SQRT(DSQ1)408: D1=SQRT(DSQ1)
411: G2(1)=r2ax - r2bx409: G2(1)=r2ax - r2bx
412: G2(2)=r2ay - r2by410: G2(2)=r2ay - r2by
413: G2(3)=r2az - r2bz411: G2(3)=r2az - r2bz
414: G1(1)=r1ax - r1bx412: G1(1)=r1ax - r1bx
415: G1(2)=r1ay - r1by413: G1(2)=r1ay - r1by
416: G1(3)=r1az - r1bz414: G1(3)=r1az - r1bz
417: DSQI=1.0D10415: DSQI=1.0D10
418: DINT=1.0D10416: DINT=1.0D10
419: IF (CHECKCONINT.AND.(.NOT.NOINT)) THEN417: IF (.NOT.NOINT) THEN
420:    r1amr1bdr2amr2b=(r1ax-r1bx)*(r2ax-r2bx)+(r1ay-r1by)*(r2ay-r2by)+(r1az-r1bz)*(r2az-r2bz)418:    r1amr1bdr2amr2b=(r1ax-r1bx)*(r2ax-r2bx)+(r1ay-r1by)*(r2ay-r2by)+(r1az-r1bz)*(r2az-r2bz)
421:    r1amr1bdr2amr2bsq=r1amr1bdr2amr2b**2419:    r1amr1bdr2amr2bsq=r1amr1bdr2amr2b**2
422:    r1amr1bsq=(r1ax - r1bx)**2 + (r1ay - r1by)**2 + (r1az - r1bz)**2420:    r1amr1bsq=(r1ax - r1bx)**2 + (r1ay - r1by)**2 + (r1az - r1bz)**2
423:    r2amr2bsq=(r2ax - r2bx)**2 + (r2ay - r2by)**2 + (r2az - r2bz)**2421:    r2amr2bsq=(r2ax - r2bx)**2 + (r2ay - r2by)**2 + (r2az - r2bz)**2
424:    DSQI=(-r1amr1bdr2amr2bsq + r1amr1bsq*r2amr2bsq)/r1apr2bmr2amr1bsq422:    DSQI=(-r1amr1bdr2amr2bsq + r1amr1bsq*r2amr2bsq)/r1apr2bmr2amr1bsq
425:    DUMMY=r1apr2bmr2amr1bsq**2423:    DUMMY=r1apr2bmr2amr1bsq**2
426:    DINT=SQRT(DSQI)424:    DINT=SQRT(DSQI)
427:    IF (DINT.LE.0.0D0) THEN425:    IF (DINT.LE.0.0D0) THEN
428:       NOINT=.TRUE.426:       NOINT=.TRUE.
429:    ELSE427:    ELSE
567: 565: 
568: !566: !
569: ! This version of congrad tests for an internal minimum in the567: ! This version of congrad tests for an internal minimum in the
570: ! constraint distances as well as the repulsions.568: ! constraint distances as well as the repulsions.
571: !569: !
572: SUBROUTINE CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)570: SUBROUTINE CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
573: USE KEY, ONLY: FROZEN, FREEZE, NREPI, NREPJ, NNREPULSIVE, &571: USE KEY, ONLY: FROZEN, FREEZE, NREPI, NREPJ, NNREPULSIVE, &
574:   &            NCONSTRAINT, CONI, CONJ, INTCONSTRAINTDEL, CONDISTREF, INTCONSTRAINTREP, CONDISTREFLOCAL, &572:   &            NCONSTRAINT, CONI, CONJ, INTCONSTRAINTDEL, CONDISTREF, INTCONSTRAINTREP, CONDISTREFLOCAL, &
575:   &            CONACTIVE, INTCONSTRAINREPCUT, NREPCUT,FREEZENODEST, INTIMAGE, ATOMACTIVE, KINT, IMSEPMAX, &573:   &            CONACTIVE, INTCONSTRAINREPCUT, NREPCUT,FREEZENODEST, INTIMAGE, ATOMACTIVE, KINT, IMSEPMAX, &
576:   &            INTFREEZET, INTFROZEN, REPI, REPJ, CONCUT, CONCUTLOCAL, &574:   &            INTFREEZET, INTFROZEN, REPI, REPJ, CONCUT, CONCUTLOCAL, &
577:   &            CONCUTABS, CONCUTABST, CONCUTFRAC, CONCUTFRACT, INTMINFAC, INTSPRINGACTIVET, CHECKCONINT, JMAXCON575:   &            CONCUTABS, CONCUTABST, CONCUTFRAC, CONCUTFRACT, INTMINFAC, INTSPRINGACTIVET
578: USE COMMONS, ONLY: NATOMS, NOPT, DEBUG576: USE COMMONS, ONLY: NATOMS, NOPT, DEBUG
579: IMPLICIT NONE577: IMPLICIT NONE
580:            578:            
581: INTEGER :: J1,J2,NI2,NI1,NJ2,NJ1,NMAXINT,NMININT,NCONINT(INTIMAGE+2),NREPINT(INTIMAGE+2),JMAX,IMAX579: INTEGER :: J1,J2,NI2,NI1,NJ2,NJ1,NMAXINT,NMININT,NCONINT(INTIMAGE+2),NREPINT(INTIMAGE+2),JMAX,IMAX
582: DOUBLE PRECISION :: ECON, EREP, ETOTAL, RMS, EMAX580: DOUBLE PRECISION :: ECON, EREP, ETOTAL, RMS, EMAX
583: INTEGER JJMAX(INTIMAGE+2)581: INTEGER JJMAX(INTIMAGE+2)
584: DOUBLE PRECISION  EEMAX(INTIMAGE+2)582: DOUBLE PRECISION  EEMAX(INTIMAGE+2)
585: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,D2,D1583: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,D2,D1
586: DOUBLE PRECISION G1(3),G2(3),DINT,G1INT(3),G2INT(3)584: DOUBLE PRECISION G1(3),G2(3),DINT,G1INT(3),G2INT(3)
587: DOUBLE PRECISION DUMMY, REPGRAD(3), INTCONST, D12, DSQ2, DSQ1, DSQI585: DOUBLE PRECISION DUMMY, REPGRAD(3), INTCONST, D12, DSQ2, DSQ1, DSQI
716:             EEMAX(J1-1)=DUMMY714:             EEMAX(J1-1)=DUMMY
717:          ENDIF715:          ENDIF
718:          EEE(J1-1)=EEE(J1-1)+DUMMY716:          EEE(J1-1)=EEE(J1-1)+DUMMY
719:          CONE(J1-1)=CONE(J1-1)+DUMMY717:          CONE(J1-1)=CONE(J1-1)+DUMMY
720:          ECON=ECON      +DUMMY718:          ECON=ECON      +DUMMY
721:          IF (LPRINT) WRITE(*, '(A,4I6,G15.5)') 'max J1,J2,CONI,CONJ,REPGRAD=',J1,J2,CONI(J2),CONJ(J2), &719:          IF (LPRINT) WRITE(*, '(A,4I6,G15.5)') 'max J1,J2,CONI,CONJ,REPGRAD=',J1,J2,CONI(J2),CONJ(J2), &
722:   &         SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2)720:   &         SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2)
723:          GGG(NI1+1:NI1+3)=GGG(NI1+1:NI1+3)+REPGRAD(1:3)721:          GGG(NI1+1:NI1+3)=GGG(NI1+1:NI1+3)+REPGRAD(1:3)
724:          GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)-REPGRAD(1:3)722:          GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)-REPGRAD(1:3)
725:       ENDIF723:       ENDIF
726:       IF (CHECKCONINT.AND.(.NOT.NOINT).AND.(ABS(DINT-CONDISTREFLOCAL(J2)).GT.CCLOCAL)) THEN724:       IF ((.NOT.NOINT).AND.(ABS(DINT-CONDISTREFLOCAL(J2)).GT.CCLOCAL)) THEN
727:          DUMMY=DINT-CONDISTREFLOCAL(J2)  725:          DUMMY=DINT-CONDISTREFLOCAL(J2)  
728:          REPGRAD(1:3)=2*INTMINFAC*INTCONSTRAINTDEL*((DUMMY/CCLOCAL)**2-1.0D0)*DUMMY*G1INT(1:3)726:          REPGRAD(1:3)=2*INTMINFAC*INTCONSTRAINTDEL*((DUMMY/CCLOCAL)**2-1.0D0)*DUMMY*G1INT(1:3)
729:          GGG(NI1+1:NI1+3)=GGG(NI1+1:NI1+3)+REPGRAD(1:3)727:          GGG(NI1+1:NI1+3)=GGG(NI1+1:NI1+3)+REPGRAD(1:3)
730:          GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)-REPGRAD(1:3)728:          GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)-REPGRAD(1:3)
731:          REPGRAD(1:3)=2*INTMINFAC*INTCONSTRAINTDEL*((DUMMY/CCLOCAL)**2-1.0D0)*DUMMY*G2INT(1:3)729:          REPGRAD(1:3)=2*INTMINFAC*INTCONSTRAINTDEL*((DUMMY/CCLOCAL)**2-1.0D0)*DUMMY*G2INT(1:3)
732:          DUMMY=INTMINFAC*INTCONSTRAINTDEL*(DUMMY**2-CCLOCAL**2)**2/(2.0D0*CCLOCAL**2)730:          DUMMY=INTMINFAC*INTCONSTRAINTDEL*(DUMMY**2-CCLOCAL**2)**2/(2.0D0*CCLOCAL**2)
733: !        IF (PRINTE.AND.(DUMMY.GT.1.0D-4)) THEN731: !        IF (PRINTE.AND.(DUMMY.GT.1.0D-4)) THEN
734: !           WRITE(*, '(A,2I6,2L5,G20.10)') 'B CONI,CONJ,INTFROZEN(CONI),INTFROZEN(CONJ),DUMMY=', &732: !           WRITE(*, '(A,2I6,2L5,G20.10)') 'B CONI,CONJ,INTFROZEN(CONI),INTFROZEN(CONJ),DUMMY=', &
735: ! &                                       CONI(J2),CONJ(J2),INTFROZEN(CONI(J2)),INTFROZEN(CONJ(J2)),DUMMY733: ! &                                       CONI(J2),CONJ(J2),INTFROZEN(CONI(J2)),INTFROZEN(CONJ(J2)),DUMMY
736: !        ENDIF734: !        ENDIF
766:          ENDIF764:          ENDIF
767: !        WRITE(*, '(A,4I6,G15.5)') 'in2 J1,J2,CONI,CONJ,REPGRAD=',J1,J2,CONI(J2),CONJ(J2), &765: !        WRITE(*, '(A,4I6,G15.5)') 'in2 J1,J2,CONI,CONJ,REPGRAD=',J1,J2,CONI(J2),CONJ(J2), &
768: ! &                              SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2)766: ! &                              SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2)
769:          GGG(NI2+1:NI2+3)=GGG(NI2+1:NI2+3)+REPGRAD(1:3)767:          GGG(NI2+1:NI2+3)=GGG(NI2+1:NI2+3)+REPGRAD(1:3)
770:          GGG(NJ2+1:NJ2+3)=GGG(NJ2+1:NJ2+3)-REPGRAD(1:3)768:          GGG(NJ2+1:NJ2+3)=GGG(NJ2+1:NJ2+3)-REPGRAD(1:3)
771:       ENDIF769:       ENDIF
772:    ENDDO770:    ENDDO
773: ENDDO771: ENDDO
774: ! DO J2=1,INTIMAGE+2772: ! DO J2=1,INTIMAGE+2
775: !    IF (JJMAX(J2).GT.0) THEN773: !    IF (JJMAX(J2).GT.0) THEN
776: !       WRITE(*,'(A,I6,A,I6,A,2I6)') ' congrad2> Highest constraint contribution for image ',J2,' constraint ',JJMAX(J2),' atoms ', &774: !       WRITE(*,'(A,I6,A,I6,A,2I6)') ' congrad> Highest constraint contribution for image ',J2,' constraint ',JJMAX(J2),' atoms ', &
777: !  &                                CONI(JJMAX(J2)),CONJ(JJMAX(J2))775: !  &                                CONI(JJMAX(J2)),CONJ(JJMAX(J2))
778: !    ENDIF776: !    ENDIF
779: ! ENDDO777: ! ENDDO
780: IF (JMAX.GT.0) THEN778: IF (JMAX.GT.0) THEN
781:    WRITE(*,'(A,I6,A,I6,A,2I6)') ' congrad2> Highest constraint contribution for any image in image ',IMAX, &779:    WRITE(*,'(A,I6,A,I6,A,2I6)') ' congrad> Highest constraint contribution for any image in image ',IMAX, &
782:  & ' constraint ',JMAX, &780:  & ' constraint ',JMAX, &
783:  &                              ' atoms ',CONI(JMAX),CONJ(JMAX)781:  &                              ' atoms ',CONI(JMAX),CONJ(JMAX)
784: ENDIF782: ENDIF
785: JMAXCON=JMAX 
786: 783: 
787: ! INTCONST=INTCONSTRAINREPCUT**13784: ! INTCONST=INTCONSTRAINREPCUT**13
788: 785: 
789: EMAX=-1.0D200786: EMAX=-1.0D200
790: EEMAX(1:INTIMAGE+2)=-1.0D200787: EEMAX(1:INTIMAGE+2)=-1.0D200
791: JJMAX(1:INTIMAGE+2)=-1788: JJMAX(1:INTIMAGE+2)=-1
792: JMAX=-1789: JMAX=-1
793: IMAX=-1790: IMAX=-1
794: DO J2=1,NNREPULSIVE791: DO J2=1,NNREPULSIVE
795: !  INTCONST=NREPCUT(J2)**13792: !  INTCONST=NREPCUT(J2)**13
962:          REPGRAD(1:3)=INTMINFAC*DUMMY*G2INT(1:3)959:          REPGRAD(1:3)=INTMINFAC*DUMMY*G2INT(1:3)
963: !        WRITE(*, '(A,4I6,2G15.5)') 'in1 J1,J2,REPI,REPJ,REPGRAD,NREPCUT=',J1,J2,NREPI(J2),NREPJ(J2), &960: !        WRITE(*, '(A,4I6,2G15.5)') 'in1 J1,J2,REPI,REPJ,REPGRAD,NREPCUT=',J1,J2,NREPI(J2),NREPJ(J2), &
964: ! &                              SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2),NREPCUT(J2)961: ! &                              SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2),NREPCUT(J2)
965:          GGG(NI2+1:NI2+3)=GGG(NI2+1:NI2+3)+REPGRAD(1:3)962:          GGG(NI2+1:NI2+3)=GGG(NI2+1:NI2+3)+REPGRAD(1:3)
966:          GGG(NJ2+1:NJ2+3)=GGG(NJ2+1:NJ2+3)-REPGRAD(1:3)963:          GGG(NJ2+1:NJ2+3)=GGG(NJ2+1:NJ2+3)-REPGRAD(1:3)
967:       ENDIF964:       ENDIF
968:    ENDDO965:    ENDDO
969: ENDDO966: ENDDO
970: ! DO J2=1,INTIMAGE+2967: ! DO J2=1,INTIMAGE+2
971: !    IF (JJMAX(J2).GT.0) THEN968: !    IF (JJMAX(J2).GT.0) THEN
972: !       WRITE(*,'(A,I6,A,I6,A,2I6)') ' congrad2> Highest repulsive  contribution for image ',J2,' pair index ', &969: !       WRITE(*,'(A,I6,A,I6,A,2I6)') ' congrad> Highest repulsive  contribution for image ',J2,' pair index ', &
973: !  &                                JJMAX(J2),' atoms ', &970: !  &                                JJMAX(J2),' atoms ', &
974: !  &                                NREPI(JJMAX(J2)),NREPJ(JJMAX(J2))971: !  &                                NREPI(JJMAX(J2)),NREPJ(JJMAX(J2))
975: !    ENDIF972: !    ENDIF
976: ! ENDDO973: ! ENDDO
977: IF (JMAX.GT.0) THEN974: IF (JMAX.GT.0) THEN
978:    WRITE(*,'(A,I6,A,I6,A,2I6)') ' congrad2> Highest repulsive  contribution for any image in image ',IMAX, &975:    WRITE(*,'(A,I6,A,I6,A,2I6)') ' congrad> Highest repulsive  contribution for any image in image ',IMAX, &
979:  &  ' pair index ', &976:  &  ' pair index ', &
980:  &                                JMAX,' atoms ',NREPI(JMAX),NREPJ(JMAX)977:  &                                JMAX,' atoms ',NREPI(JMAX),NREPJ(JMAX)
981: ENDIF978: ENDIF
982: !979: !
983: ! Spring energy. Set EEE(J1) and ESPRING dividing up the pairwise980: ! Spring energy. Set EEE(J1) and ESPRING dividing up the pairwise
984: ! energy terms between images except for the end points.981: ! energy terms between images except for the end points.
985: !982: !
986: ESPRING=0.0D0983: ESPRING=0.0D0
987: EMAX=0.0D0984: EMAX=0.0D0
988: IMAX=0985: IMAX=0
997:       DO J2=1,NATOMS994:       DO J2=1,NATOMS
998:          IF ((.NOT.INTSPRINGACTIVET).OR.ATOMACTIVE(J2)) THEN 995:          IF ((.NOT.INTSPRINGACTIVET).OR.ATOMACTIVE(J2)) THEN 
999:             DPLUS=DPLUS+(XYZ(NI1+3*(J2-1)+1)-XYZ(NI2+3*(J2-1)+1))**2 &996:             DPLUS=DPLUS+(XYZ(NI1+3*(J2-1)+1)-XYZ(NI2+3*(J2-1)+1))**2 &
1000:   &                    +(XYZ(NI1+3*(J2-1)+2)-XYZ(NI2+3*(J2-1)+2))**2 &997:   &                    +(XYZ(NI1+3*(J2-1)+2)-XYZ(NI2+3*(J2-1)+2))**2 &
1001:   &                    +(XYZ(NI1+3*(J2-1)+3)-XYZ(NI2+3*(J2-1)+3))**2998:   &                    +(XYZ(NI1+3*(J2-1)+3)-XYZ(NI2+3*(J2-1)+3))**2
1002:          ENDIF999:          ENDIF
1003: !        WRITE(*,'(A,2I8,G20.10)') 'J1,J2,DPLUS: ',J1,J2,DPLUS1000: !        WRITE(*,'(A,2I8,G20.10)') 'J1,J2,DPLUS: ',J1,J2,DPLUS
1004:       ENDDO1001:       ENDDO
1005:       DPLUS=SQRT(DPLUS)1002:       DPLUS=SQRT(DPLUS)
1006: !     IF (DPLUS.GT.IMSEPMAX) THEN1003: !     IF (DPLUS.GT.IMSEPMAX) THEN
1007: !        DUMMY=KINT*0.5D0*(DPLUS-IMSEPMAX)**21004:          DUMMY=KINT*0.5D0*(DPLUS-IMSEPMAX)**2
1008:          DUMMY=KINT*0.5D0*DPLUS**2 
1009:          IF (DUMMY.GT.EMAX) THEN1005:          IF (DUMMY.GT.EMAX) THEN
1010:             IMAX=J11006:             IMAX=J1
1011:             EMAX=DUMMY1007:             EMAX=DUMMY
1012:          ENDIF1008:          ENDIF
1013: !        DUMMY=KINT*0.5D0*DPLUS**21009: !        DUMMY=KINT*0.5D0*DPLUS**2
1014:          ESPRING=ESPRING+DUMMY1010:          ESPRING=ESPRING+DUMMY
1015:          IF (DUMMY.GT.EEMAX(J1+1)) THEN1011:          IF (DUMMY.GT.EEMAX(J1+1)) THEN
1016:             EEMAX(J1+1)=DUMMY1012:             EEMAX(J1+1)=DUMMY
1017:          ENDIF1013:          ENDIF
1018: 1014: 
1019: !        WRITE(*,'(A,4G20.10)') 'DPLUS,IMSEPMAX,DUMMY,ESPRING=',DPLUS,IMSEPMAX,DUMMY,ESPRING1015: !        WRITE(*,'(A,4G20.10)') 'DPLUS,IMSEPMAX,DUMMY,ESPRING=',DPLUS,IMSEPMAX,DUMMY,ESPRING
1020: !        DUMMY=KINT*(DPLUS-IMSEPMAX)/DPLUS1016:          DUMMY=KINT*(DPLUS-IMSEPMAX)/DPLUS
1021:          DUMMY=KINT1017: !        DUMMY=KINT
1022:          DO J2=1,NATOMS1018:          DO J2=1,NATOMS
1023:             IF ((.NOT.INTSPRINGACTIVET).OR.ATOMACTIVE(J2)) THEN 1019:             IF ((.NOT.INTSPRINGACTIVET).OR.ATOMACTIVE(J2)) THEN 
1024:                SPGRAD(1:3)=DUMMY*(XYZ(NI1+3*(J2-1)+1:NI1+3*(J2-1)+3)-XYZ(NI2+3*(J2-1)+1:NI2+3*(J2-1)+3))1020:                SPGRAD(1:3)=DUMMY*(XYZ(NI1+3*(J2-1)+1:NI1+3*(J2-1)+3)-XYZ(NI2+3*(J2-1)+1:NI2+3*(J2-1)+3))
1025:                GGG(NI1+3*(J2-1)+1:NI1+3*(J2-1)+3)=GGG(NI1+3*(J2-1)+1:NI1+3*(J2-1)+3)+SPGRAD(1:3)1021:                GGG(NI1+3*(J2-1)+1:NI1+3*(J2-1)+3)=GGG(NI1+3*(J2-1)+1:NI1+3*(J2-1)+3)+SPGRAD(1:3)
1026:                GGG(NI2+3*(J2-1)+1:NI2+3*(J2-1)+3)=GGG(NI2+3*(J2-1)+1:NI2+3*(J2-1)+3)-SPGRAD(1:3)1022:                GGG(NI2+3*(J2-1)+1:NI2+3*(J2-1)+3)=GGG(NI2+3*(J2-1)+1:NI2+3*(J2-1)+3)-SPGRAD(1:3)
1027:             ENDIF1023:             ENDIF
1028:          ENDDO1024:          ENDDO
1029: !     ENDIF1025: !     ENDIF
1030:    ENDDO1026:    ENDDO
1031: ENDIF1027: ENDIF
1032: WRITE(*,'(A,I6,A,I6,A,2I6)') ' congrad2> Highest spring  contribution for any image in image ',IMAX1028: WRITE(*,'(A,I6,A,I6,A,2I6)') ' congrad> Highest spring  contribution for any image in image ',IMAX
1033:          IF (PRINTE) THEN1029:          IF (PRINTE) THEN
1034:             WRITE(*, '(A,G20.10)') 'ESPRING=',ESPRING1030:             WRITE(*, '(A,G20.10)') 'ESPRING=',ESPRING
1035:          ENDIF1031:          ENDIF
1036: !1032: !
1037: ! Set gradients on frozen atoms to zero.1033: ! Set gradients on frozen atoms to zero.
1038: !1034: !
1039: IF (FREEZE) THEN1035: IF (FREEZE) THEN
1040:    DO J1=2,INTIMAGE+1  1036:    DO J1=2,INTIMAGE+1  
1041:       DO J2=1,NATOMS1037:       DO J2=1,NATOMS
1042:          IF (FROZEN(J2)) THEN1038:          IF (FROZEN(J2)) THEN


r33425/intlbfgs.f90 2017-10-30 11:30:13.018227431 +0000 r33424/intlbfgs.f90 2017-10-30 11:30:13.918239273 +0000
 23:      & INTCONSTRAINREPCUT, REPCON, INTCONSTRAINTREP, INTREPSEP, NREPI, NREPJ, & 23:      & INTCONSTRAINREPCUT, REPCON, INTCONSTRAINTREP, INTREPSEP, NREPI, NREPJ, &
 24:      & CONDISTREFLOCAL, INTCONFRAC, CONACTIVE, REPI, & 24:      & CONDISTREFLOCAL, INTCONFRAC, CONACTIVE, REPI, &
 25:      & REPJ, NREPMAX, ATOMACTIVE, NCONSTRAINTON, CONION, CONJON, CONDISTREFLOCALON, CONDISTREFON, & 25:      & REPJ, NREPMAX, ATOMACTIVE, NCONSTRAINTON, CONION, CONJON, CONDISTREFLOCALON, CONDISTREFON, &
 26:      & NREPCUT, REPCUT, CHECKCONINT, INTCONSTEPS, INTRELSTEPS, MAXCONE, COLDFUSIONLIMIT, & 26:      & NREPCUT, REPCUT, CHECKCONINT, INTCONSTEPS, INTRELSTEPS, MAXCONE, COLDFUSIONLIMIT, &
 27:      & INTSTEPS1, DUMPINTXYZ, DUMPINTXYZFREQ, DUMPINTEOS, DUMPINTEOSFREQ, & 27:      & INTSTEPS1, DUMPINTXYZ, DUMPINTXYZFREQ, DUMPINTEOS, DUMPINTEOSFREQ, &
 28:      & IMSEPMIN, IMSEPMAX, MAXINTIMAGE, INTFREEZET, INTFREEZETOL, FREEZE, & 28:      & IMSEPMIN, IMSEPMAX, MAXINTIMAGE, INTFREEZET, INTFREEZETOL, FREEZE, &
 29:      & INTFROZEN, CHECKREPINTERVAL, NNREPULSIVE, INTFREEZEMIN, INTIMAGECHECK, & 29:      & INTFROZEN, CHECKREPINTERVAL, NNREPULSIVE, INTFREEZEMIN, INTIMAGECHECK, &
 30:      & CONCUT, CONCUTLOCAL, KINT, REPIFIX, REPJFIX, NREPULSIVEFIX, & 30:      & CONCUT, CONCUTLOCAL, KINT, REPIFIX, REPJFIX, NREPULSIVEFIX, &
 31:      & NCONSTRAINTFIX, CONIFIX, CONJFIX, QCIPERMCHECK, QCIPERMCHECKINT, BULKT, TWOD, RIGIDBODY, & 31:      & NCONSTRAINTFIX, CONIFIX, CONJFIX, QCIPERMCHECK, QCIPERMCHECKINT, BULKT, TWOD, RIGIDBODY, &
 32:      & QCIADDREP, QCIXYZ, WHOLEDNEB, QCIIMAGE, FROZEN, QCIRESTART, NPERMGROUP, NPERMSIZE, PERMGROUP, NSETS, SETS, & 32:      & QCIADDREP, QCIXYZ, WHOLEDNEB, QCIIMAGE, FROZEN, QCIRESTART, NPERMGROUP, NPERMSIZE, PERMGROUP, NSETS, SETS, &
 33:      & PERMDIST, LOCALPERMCUT, QCILPERMDIST, QCIPDINT, QCIPERMCUT, QCIAMBERT, BONDS, DOBACK, & 33:      & PERMDIST, LOCALPERMCUT, QCILPERMDIST, QCIPDINT, QCIPERMCUT, QCIAMBERT, BONDS, DOBACK
 34:      & QCIRESET, QCIRESETINT1, QCIRESETINT2, JMAXCON 
 35: USE COMMONS, ONLY: NATOMS, DEBUG, PARAM1, PARAM2, PARAM3 34: USE COMMONS, ONLY: NATOMS, DEBUG, PARAM1, PARAM2, PARAM3
 36: USE MODCHARMM, ONLY : CHRMMT 35: USE MODCHARMM, ONLY : CHRMMT
 37: USE CHIRALITY 36: USE CHIRALITY
 38:  37: 
 39: IMPLICIT NONE  38: IMPLICIT NONE 
 40:  39: 
 41: DOUBLE PRECISION, INTENT(IN) :: QSTART(3*NATOMS), QFINISH(3*NATOMS)  ! The two end points 40: DOUBLE PRECISION, INTENT(IN) :: QSTART(3*NATOMS), QFINISH(3*NATOMS)  ! The two end points
 42: INTEGER D, U 41: INTEGER D, U
 43: DOUBLE PRECISION DIST, DIST2, RMAT(3,3), SUMEEE, SUMEEE2, SIGMAEEE, NEIGHBOUR_COORDS(12), CENTRE_COORDS(3) 42: DOUBLE PRECISION DIST, DIST2, RMAT(3,3), SUMEEE, SUMEEE2, SIGMAEEE, NEIGHBOUR_COORDS(12), CENTRE_COORDS(3)
 44: DOUBLE PRECISION DMAX, DF, DMIN, LOCALSTEP, ADMAX, DUMMYX, DUMMYY, DUMMYZ 43: DOUBLE PRECISION DMAX, DF, DMIN, LOCALSTEP, ADMAX, DUMMYX, DUMMYY, DUMMYZ
 45: INTEGER NDECREASE, NFAIL, NMAXINT, NMININT, JMAX, JMIN, INTIMAGESAVE, NOFF, J1, J2, NQDONE, JA1, JA2, NMOVE, NMOVES, NMOVEF, NCONOFF 44: INTEGER NDECREASE, NFAIL, NMAXINT, NMININT, JMAX, JMIN, INTIMAGESAVE, NOFF, J1, J2, NQDONE, JA1, JA2, NMOVE, NMOVES, NMOVEF  
 46: INTEGER PERM(NATOMS), PERMS(NATOMS), PERMF(NATOMS), STARTGROUP(NPERMGROUP), ENDGROUP(NPERMGROUP) 45: INTEGER PERM(NATOMS), PERMS(NATOMS), PERMF(NATOMS), STARTGROUP(NPERMGROUP), ENDGROUP(NPERMGROUP)
 47: INTEGER CONOFFLIST(NCONSTRAINT) 
 48: LOGICAL KNOWE, KNOWG, KNOWH, ADDATOM, ADDREP(NATOMS), LDEBUG, REMOVEIMAGE, PERMUTABLE(NATOMS), IDENTITY 46: LOGICAL KNOWE, KNOWG, KNOWH, ADDATOM, ADDREP(NATOMS), LDEBUG, REMOVEIMAGE, PERMUTABLE(NATOMS), IDENTITY
 49: COMMON /KNOWN/ KNOWE, KNOWG, KNOWH 47: COMMON /KNOWN/ KNOWE, KNOWG, KNOWH
 50:  48: 
 51: DOUBLE PRECISION DUMMY, DPRAND, DUMMY2, ADUMMY 49: DOUBLE PRECISION DUMMY, DPRAND, DUMMY2, ADUMMY
 52: DOUBLE PRECISION BOXLX,BOXLY,BOXLZ,DISTANCE,RMATBEST(3,3),DISTANCES,DISTANCEF 50: DOUBLE PRECISION BOXLX,BOXLY,BOXLZ,DISTANCE,RMATBEST(3,3),DISTANCES,DISTANCEF
 53: INTEGER POINT,NPT,J3,J4,NIMAGEFREEZE,NACTIVE,NBEST,NEWATOM,NBEST2 51: INTEGER POINT,NPT,J3,J4,NIMAGEFREEZE,NACTIVE,NBEST,NEWATOM,NBEST2
 54: INTEGER TURNONORDER(NATOMS),NBACKTRACK,NQCIFREEZE, NBONDED(NATOMS), BONDEDLIST(NATOMS,6), NBOND 52: INTEGER TURNONORDER(NATOMS),NBACKTRACK,NQCIFREEZE, NBONDED(NATOMS), BONDEDLIST(NATOMS,6), NBOND
 55: INTEGER NDUMMY, NLASTGOODE, NSTEPSMAX, INGROUP(NATOMS), ACID 53: INTEGER NDUMMY, NLASTGOODE, NSTEPSMAX, INGROUP(NATOMS), ACID
 56: LOGICAL CHIRALSR, CHIRALSRP  54: LOGICAL CHIRALSR, CHIRALSRP 
 57: INTEGER NTRIES(NATOMS), NITERDONE, EXITSTATUS, DLIST(NATOMS) 55: INTEGER NTRIES(NATOMS), NITERDONE, EXITSTATUS, DLIST(NATOMS)
 80: LOGICAL READIMAGET, GROUPACTIVE(NPERMGROUP), CHIRALACTIVE(NATOMS) 78: LOGICAL READIMAGET, GROUPACTIVE(NPERMGROUP), CHIRALACTIVE(NATOMS)
 81: INTEGER LUNIT, GETUNIT 79: INTEGER LUNIT, GETUNIT
 82: CHARACTER(LEN=2) SDUMMY 80: CHARACTER(LEN=2) SDUMMY
 83: INTEGER JMAXEEE,JMAXRMS 81: INTEGER JMAXEEE,JMAXRMS
 84: DOUBLE PRECISION MAXEEE,MAXRMS,MINEEE,SAVELOCALPERMCUT 82: DOUBLE PRECISION MAXEEE,MAXRMS,MINEEE,SAVELOCALPERMCUT
 85:  83: 
 86: WHOLEDNEB=.FALSE. 84: WHOLEDNEB=.FALSE.
 87: READIMAGET=.FALSE. 85: READIMAGET=.FALSE.
 88: REMOVEIMAGE=.FALSE. 86: REMOVEIMAGE=.FALSE.
 89:  87: 
 90: NCONOFF=0 
 91: CONOFFLIST(1:NCONSTRAINT)=-1 
 92: AABACK(1:NATOMS)=.FALSE. 88: AABACK(1:NATOMS)=.FALSE.
 93: BACKDONE=.FALSE. 89: BACKDONE=.FALSE.
 94: IF (DOBACK) THEN 90: IF (DOBACK) THEN
 95:    LUNIT=GETUNIT() 91:    LUNIT=GETUNIT()
 96:    OPEN(UNIT=LUNIT,FILE='aabk',STATUS='OLD') 92:    OPEN(UNIT=LUNIT,FILE='aabk',STATUS='OLD')
 97:    DO J1=1,NATOMS 93:    DO J1=1,NATOMS
 98:       READ(LUNIT,*,END=861) NDUMMY 94:       READ(LUNIT,*,END=861) NDUMMY
 99:       AABACK(NDUMMY)=.TRUE. 95:       AABACK(NDUMMY)=.TRUE.
100:    ENDDO 96:    ENDDO
101: 861   CLOSE(LUNIT) 97: 861   CLOSE(LUNIT)
363: !  WRITE(*,'(12I8)') NREPJ(1:NNREPULSIVE)359: !  WRITE(*,'(12I8)') NREPJ(1:NNREPULSIVE)
364:    READ(LUNIT,*) REPCUT(1:NREPULSIVE)360:    READ(LUNIT,*) REPCUT(1:NREPULSIVE)
365:    WRITE(*,'(A)') ' intlbfgs> read REPCUT:'361:    WRITE(*,'(A)') ' intlbfgs> read REPCUT:'
366: !  WRITE(*,'(6G20.10)') REPCUT(1:NREPULSIVE)362: !  WRITE(*,'(6G20.10)') REPCUT(1:NREPULSIVE)
367:    READ(LUNIT,*) NREPCUT(1:NNREPULSIVE)363:    READ(LUNIT,*) NREPCUT(1:NNREPULSIVE)
368:    WRITE(*,'(A)') ' intlbfgs> read NREPCUT:'364:    WRITE(*,'(A)') ' intlbfgs> read NREPCUT:'
369: !  WRITE(*,'(6G20.10)') NREPCUT(1:NNREPULSIVE)365: !  WRITE(*,'(6G20.10)') NREPCUT(1:NNREPULSIVE)
370:    READ(LUNIT,*) INTFROZEN(1:NATOMS)366:    READ(LUNIT,*) INTFROZEN(1:NATOMS)
371:    WRITE(*,'(A)') ' intlbfgs> read INTFROZEN'367:    WRITE(*,'(A)') ' intlbfgs> read INTFROZEN'
372: !  WRITE(*,'(12L5)') INTFROZEN(1:NATOMS)368: !  WRITE(*,'(12L5)') INTFROZEN(1:NATOMS)
373:  
374:    NCONOFF=0 
375:    READ(LUNIT,*,END=742) NCONOFF 
376:    IF (NCONOFF.GT.0) READ(LUNIT,*) CONOFFLIST(1:NCONOFF) 
377: 742 CONTINUE 
378:    CLOSE(LUNIT)369:    CLOSE(LUNIT)
379: 370: 
380:    GLAST(1:D)=G(1:D)371:    GLAST(1:D)=G(1:D)
381:    XSAVE(1:D)=X(1:D)372:    XSAVE(1:D)=X(1:D)
382:    GOTO 986373:    GOTO 986
383: ENDIF374: ENDIF
384: IF (INTFREEZET) THEN375: IF (INTFREEZET) THEN
385:    DO J1=1,NATOMS376:    DO J1=1,NATOMS
386:       IF (INTFROZEN(J1)) THEN377:       IF (INTFROZEN(J1)) THEN
387: ! 378: ! 
419:    EOLD=ETOTAL410:    EOLD=ETOTAL
420:    SWITCHED=.TRUE.411:    SWITCHED=.TRUE.
421:    USEFRAC=1.0D0412:    USEFRAC=1.0D0
422:    NREPULSIVE=0413:    NREPULSIVE=0
423:    NNREPULSIVE=0414:    NNREPULSIVE=0
424:    GLAST(1:D)=G(1:D)415:    GLAST(1:D)=G(1:D)
425:    XSAVE(1:D)=X(1:D)416:    XSAVE(1:D)=X(1:D)
426:    GOTO 567417:    GOTO 567
427: ENDIF418: ENDIF
428: DO J1=1,NCONSTRAINT419: DO J1=1,NCONSTRAINT
429:    IF (DOBACK.AND.(.NOT.AABACK(CONI(J1)).OR.(.NOT.AABACK(CONJ(J1))))) CYCLE 
430:    DF=SQRT((XYZ(3*(CONI(J1)-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+1))**2 &420:    DF=SQRT((XYZ(3*(CONI(J1)-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+1))**2 &
431:   &       +(XYZ(3*(CONI(J1)-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+2))**2 &421:   &       +(XYZ(3*(CONI(J1)-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+2))**2 &
432:   &       +(XYZ(3*(CONI(J1)-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+3))**2)&422:   &       +(XYZ(3*(CONI(J1)-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+3))**2)&
433:   &  +SQRT((XYZ(3*(CONJ(J1)-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+1))**2 &423:   &  +SQRT((XYZ(3*(CONJ(J1)-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+1))**2 &
434:   &       +(XYZ(3*(CONJ(J1)-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+2))**2 &424:   &       +(XYZ(3*(CONJ(J1)-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+2))**2 &
435:   &       +(XYZ(3*(CONJ(J1)-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+3))**2)425:   &       +(XYZ(3*(CONJ(J1)-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+3))**2)
436:    IF (DF.LT.DUMMY) THEN426:    IF (DF.LT.DUMMY) THEN
437:       NBEST=J1427:       NBEST=J1
438:       DUMMY=DF428:       DUMMY=DF
439:    ENDIF429:    ENDIF
570: ! Don;t want to redistribute images before even taking a step, so don;t call CHECKSEP.560: ! Don;t want to redistribute images before even taking a step, so don;t call CHECKSEP.
571: ! Must call CHECKREP to initialise NNREULSIVE, NREPI, NREPJ, etc. SEGV otherwise on second cycle!561: ! Must call CHECKREP to initialise NNREULSIVE, NREPI, NREPJ, etc. SEGV otherwise on second cycle!
572: !562: !
573: ! To take BH-type steps in the QCI space, jump back here. Leave SWITCHED true.563: ! To take BH-type steps in the QCI space, jump back here. Leave SWITCHED true.
574: !564: !
575: BESTWORST=1.0D100565: BESTWORST=1.0D100
576: 9876 CONTINUE566: 9876 CONTINUE
577: CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),0,1)567: CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),0,1)
578: IF (QCIADDREP.GT.0) THEN568: IF (QCIADDREP.GT.0) THEN
579:    CALL CONGRAD3(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)569:    CALL CONGRAD3(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
580: !570: ELSEIF (CHECKCONINT) THEN
581: ! Don't do the CONINT part of CONGRAD2 if CONINT isn't set. CONGRAD seems to be 
582: ! dong something different at the moment. Focus on CONGRAD2 
583: ! 
584: ! ELSEIF (CHECKCONINT) THEN 
585: ELSE 
586:    CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)571:    CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
587: ! ELSE572: ELSE
588:    ! CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)573:    CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
589: ENDIF574: ENDIF
590: EOLD=ETOTAL575: EOLD=ETOTAL
591: GLAST(1:D)=G(1:D)576: GLAST(1:D)=G(1:D)
592: XSAVE(1:D)=X(1:D)577: XSAVE(1:D)=X(1:D)
593: 578: 
594: IF (ETOTAL/INTIMAGE.LT.COLDFUSIONLIMIT) THEN579: IF (ETOTAL/INTIMAGE.LT.COLDFUSIONLIMIT) THEN
595:    WRITE(*,'(A,2G20.10)') ' intlbfgs> Cold fusion diagnosed - step discarded, energy, limit=', &580:    WRITE(*,'(A,2G20.10)') ' intlbfgs> Cold fusion diagnosed - step discarded, energy, limit=', &
596:   &                       ETOTAL/INTIMAGE,COLDFUSIONLIMIT581:   &                       ETOTAL/INTIMAGE,COLDFUSIONLIMIT
597:    DEALLOCATE(CONI,CONJ,CONDISTREF,REPI,REPJ,NREPI,NREPJ,REPCUT,NREPCUT,CONCUT)582:    DEALLOCATE(CONI,CONJ,CONDISTREF,REPI,REPJ,NREPI,NREPJ,REPCUT,NREPCUT,CONCUT)
598:    DEALLOCATE(TRUEEE, EEETMP, MYGTMP, GTMP, &583:    DEALLOCATE(TRUEEE, EEETMP, MYGTMP, GTMP, &
621:       NDUMMY=NDUMMY+NPERMSIZE(J1)606:       NDUMMY=NDUMMY+NPERMSIZE(J1)
622:       ENDGROUP(J1)=NDUMMY-1607:       ENDGROUP(J1)=NDUMMY-1
623:    ENDDO608:    ENDDO
624: ENDIF609: ENDIF
625: 610: 
626: 567 CONTINUE611: 567 CONTINUE
627: 612: 
628: DO ! Main do loop with counter NITERDONE, initially set to one613: DO ! Main do loop with counter NITERDONE, initially set to one
629: 614: 
630: !615: !
631: ! Are we stuck? If so, try resetting problem atoms to previous image. 
632: ! 
633: IF (QCIRESET) THEN 
634: !  IF ((SWITCHED.AND.(MOD(NITERDONE-1,QCIRESETINT2).EQ.0)).OR.((.NOT.SWITCHED).AND.(MOD(NITERDONE-1,QCIRESETINT1).EQ.0))) THEN 
635:    PRINT *,'intlbfgs> NITERDONE,NLASTGOODE,QCIRESETINT1=',NITERDONE,NLASTGOODE,QCIRESETINT1 
636:    IF ((.NOT.SWITCHED).AND.(NITERDONE-NLASTGOODE.GT.QCIRESETINT1)) THEN 
637:       CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF,CONOFFLIST) 
638:       CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE) 
639:       WRITE(*,'(A,I6)') 'intlbfgs> Interpolation seems to be stuck. Turn off worst constraint ',JMAXCON 
640:       IF ((JMAXCON.LT.1).OR.(JMAXCON.GT.NCONSTRAINT)) THEN 
641:          WRITE(*,'(A)') 'intlbfgs> *** ERROR *** constraint index out of allowed range' 
642:          STOP 
643:       ENDIF 
644:       NCONOFF=NCONOFF+1 
645:       CONOFFLIST(NCONOFF)=JMAXCON 
646:       CONACTIVE(JMAXCON)=.FALSE. 
647:       NLASTGOODE=NITERDONE 
648:       LASTGOODE=ETOTAL 
649: !     STOP 
650:    ENDIF 
651: ENDIF 
652:  
653: ! 
654: !  Check permutational alignments. Maintain a list of the permutable groups where all616: !  Check permutational alignments. Maintain a list of the permutable groups where all
655: !  members are active. See if we have any new complete groups. MUST update NDUMMY617: !  members are active. See if we have any new complete groups. MUST update NDUMMY
656: !  counter to step through permutable atom list.618: !  counter to step through permutable atom list.
657: !619: !
658: IF (QCILPERMDIST.AND.(MOD(NITERDONE-1,QCIPDINT).EQ.0)) THEN620: IF (QCILPERMDIST.AND.(MOD(NITERDONE-1,QCIPDINT).EQ.0)) THEN
659: 621: 
660:    CHIRALACTIVE(1:NATOMS)=.FALSE.622:    CHIRALACTIVE(1:NATOMS)=.FALSE.
661:    chicheck: DO J1=1,NATOMS623:    chicheck: DO J1=1,NATOMS
662:       IF (.NOT.ATOMACTIVE(J1)) CYCLE chicheck624:       IF (.NOT.ATOMACTIVE(J1)) CYCLE chicheck
663:       IF (NBONDED(J1).NE.4) CYCLE chicheck625:       IF (NBONDED(J1).NE.4) CYCLE chicheck
818: !                   ELSE780: !                   ELSE
819: !                      WRITE(*,'(A,I6,A,I6)') ' intlbfgs> inconsistent non-identity permutations for start and finish'781: !                      WRITE(*,'(A,I6,A,I6)') ' intlbfgs> inconsistent non-identity permutations for start and finish'
820: !                   ENDIF782: !                   ENDIF
821: !                ENDIF783: !                ENDIF
822: !             ENDDO784: !             ENDDO
823: !             XYZ(3*NATOMS*J3+1:3*NATOMS*(J3+1))=COORDSA(1:3*NATOMS)785: !             XYZ(3*NATOMS*J3+1:3*NATOMS*(J3+1))=COORDSA(1:3*NATOMS)
824: !          ENDIF786: !          ENDIF
825: !       ENDDO np787: !       ENDDO np
826: !    ENDDO788: !    ENDDO
827: !    LOCALPERMCUT=SAVELOCALPERMCUT789: !    LOCALPERMCUT=SAVELOCALPERMCUT
828: !    CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF,CONOFFLIST)790: !    CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER)
829: ! !  STOP791: ! !  STOP
830: 792: 
831: ENDIF793: ENDIF
832: 794: 
833: !795: !
834: !  Add next atom to active set if ADDATOM is true. 796: !  Add next atom to active set if ADDATOM is true. 
835: !  Constraints to atoms already in the active set are turned on797: !  Constraints to atoms already in the active set are turned on
836: !  and short-range repulsions to active atoms that are not distance constrained are turned on.798: !  and short-range repulsions to active atoms that are not distance constrained are turned on.
837: !  *** OLD Find nearest atom to active set attached by a constraint799: !  *** OLD Find nearest atom to active set attached by a constraint
838: !  *** NEW Find atom with most constraints to active set800: !  *** NEW Find atom with most constraints to active set
839: !  Turn on constraint terms for this atom with all previous members of the active set801: !  Turn on constraint terms for this atom with all previous members of the active set
840: !  Add repulsions to non-constrained atoms in this set802: !  Add repulsions to non-constrained atoms in this set
841: !  NTOADD is the number of atoms to add to the active set in each pass. 1 seems best!803: !  NTOADD is the number of atoms to add to the active set in each pass. 1 seems best!
842: !804: !
843:    IF (ADDATOM.AND.((NACTIVE.LT.NATOMS).OR.(NCONOFF.GT.0))) THEN805:    IF (ADDATOM.AND.(NACTIVE.LT.NATOMS)) THEN
844: 806: 
845: !!!!!!!!!!!!!!!DEBUG DJW !!!!!!!!!!!807: !!!!!!!!!!!!!!!DEBUG DJW !!!!!!!!!!!
846: !!808: !!
847: !!               J2=0809: !!               J2=0
848: !!               DO J1=1,NREPULSIVEFIX810: !!               DO J1=1,NREPULSIVEFIX
849: !!!                 WRITE(*,'(A,3I10,4L5)') 'doaddatom> J1,REPIFIX,REPJFIX,frozenI,frozenJ,activeI,activeJ=', &811: !!!                 WRITE(*,'(A,3I10,4L5)') 'doaddatom> J1,REPIFIX,REPJFIX,frozenI,frozenJ,activeI,activeJ=', &
850: !!! &                 J1,REPIFIX(J1),REPJFIX(J1),INTFROZEN(REPIFIX(J1)),INTFROZEN(REPJFIX(J1)), &812: !!! &                 J1,REPIFIX(J1),REPJFIX(J1),INTFROZEN(REPIFIX(J1)),INTFROZEN(REPJFIX(J1)), &
851: !!! &                 ATOMACTIVE(REPIFIX(J1)),ATOMACTIVE(REPJFIX(J1))813: !!! &                 ATOMACTIVE(REPIFIX(J1)),ATOMACTIVE(REPJFIX(J1))
852: !!                  IF (INTFROZEN(REPIFIX(J1)).AND.INTFROZEN(REPJFIX(J1))) CYCLE814: !!                  IF (INTFROZEN(REPIFIX(J1)).AND.INTFROZEN(REPJFIX(J1))) CYCLE
853: !!                  IF (ATOMACTIVE(REPIFIX(J1)).AND.ATOMACTIVE(REPJFIX(J1))) THEN815: !!                  IF (ATOMACTIVE(REPIFIX(J1)).AND.ATOMACTIVE(REPJFIX(J1))) THEN
911: !!!                    WRITE(*,'(A,I10,A,2I6)') 'doaddatom> repulsion ',NREPULSIVE,' between ',J1,J2873: !!!                    WRITE(*,'(A,I10,A,2I6)') 'doaddatom> repulsion ',NREPULSIVE,' between ',J1,J2
912: !!!874: !!!
913: !!! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact.875: !!! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact.
914: !!!876: !!!
915: !!                     REPCUT(NREPULSIVE)=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)877: !!                     REPCUT(NREPULSIVE)=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)
916: !!                  ENDDO myrep2878: !!                  ENDDO myrep2
917: !!               ENDDO879: !!               ENDDO
918: !!               WRITE(*,'(A,I6,A)') ' intlbfgs> Now it looks like there are ',NREPULSIVE,' possible repulsions before adding new atom'880: !!               WRITE(*,'(A,I6,A)') ' intlbfgs> Now it looks like there are ',NREPULSIVE,' possible repulsions before adding new atom'
919: !!!!!!!!!!!!!!!DEBUG DJW !!!!!!!!!!!881: !!!!!!!!!!!!!!!DEBUG DJW !!!!!!!!!!!
920: 882: 
921:       IF (NCONOFF.GT.0) THEN883:       CALL DOADDATOM(NCONSTRAINT,NTRIES,NEWATOM,IMGFREEZE,INTIMAGE,XYZ,EEE,GGG,TURNONORDER,NITERDONE,NACTIVE,AABACK,BACKDONE)  
922:          WRITE(*,'(A,I6)') 'intlbfgs> Turn back on constraint ',CONOFFLIST(NCONOFF) 
923:          CONACTIVE(NCONOFF)=.TRUE. 
924:          NCONOFF=NCONOFF-1 
925:       ELSE 
926:          CALL DOADDATOM(NCONSTRAINT,NTRIES,NEWATOM,IMGFREEZE,INTIMAGE,XYZ,EEE,GGG,TURNONORDER,NITERDONE,NACTIVE,AABACK,BACKDONE)   
927:       ENDIF 
928:       NLASTGOODE=NITERDONE884:       NLASTGOODE=NITERDONE
929:       LASTGOODE=ETOTAL885:       LASTGOODE=ETOTAL
930:    ENDIF886:    ENDIF
931:    GTMP(1:D)=0.0D0887:    GTMP(1:D)=0.0D0
932:    CALL MAKESTEP(NITERUSE,POINT,DIAG,INTIMAGE,SEARCHSTEP,G,GTMP,STP,GDIF,NPT,D,RHO1,ALPHA)888:    CALL MAKESTEP(NITERUSE,POINT,DIAG,INTIMAGE,SEARCHSTEP,G,GTMP,STP,GDIF,NPT,D,RHO1,ALPHA)
933: !889: !
934: ! If the number of images has changed since G was declared then G is not the same890: ! If the number of images has changed since G was declared then G is not the same
935: ! size as Gtmp and Dot_Product cannot be used.891: ! size as Gtmp and Dot_Product cannot be used.
936: !892: !
937: !  IF (Dot_Product(G,Gtmp)/SQRT( Dot_Product(G,G)*Dot_Product(Gtmp,Gtmp) ) > 0.0D0) THEN893: !  IF (Dot_Product(G,Gtmp)/SQRT( Dot_Product(G,G)*Dot_Product(Gtmp,Gtmp) ) > 0.0D0) THEN
1517: !        IF (ETOTAL/INTIMAGE.GT.MAXCONE*MAX(0.1D0,NACTIVE*1.0D0/(NATOMS*1.0D0))) GOTO 7771473: !        IF (ETOTAL/INTIMAGE.GT.MAXCONE*MAX(0.1D0,NACTIVE*1.0D0/(NATOMS*1.0D0))) GOTO 777
1518:          PRINT '(A,3G20.10)','MAXEEE,MAXCONE,scaled=',MAXEEE,MAXCONE,MAXCONE*MAX(0.2D0,NACTIVE*1.0D0/(NATOMS*1.0D0))1474:          PRINT '(A,3G20.10)','MAXEEE,MAXCONE,scaled=',MAXEEE,MAXCONE,MAXCONE*MAX(0.2D0,NACTIVE*1.0D0/(NATOMS*1.0D0))
1519:          IF (MAXEEE.GT.MAXCONE*MAX(0.2D0,NACTIVE*1.0D0/(NATOMS*1.0D0))) GOTO 7771475:          IF (MAXEEE.GT.MAXCONE*MAX(0.2D0,NACTIVE*1.0D0/(NATOMS*1.0D0))) GOTO 777
1520:          IF (NACTIVE.LT.NATOMS) THEN 1476:          IF (NACTIVE.LT.NATOMS) THEN 
1521:             ADDATOM=.TRUE.1477:             ADDATOM=.TRUE.
1522:             GOTO 7771478:             GOTO 777
1523:          ENDIF1479:          ENDIF
1524:          CALL MYCPU_TIME(FTIME,.FALSE.)1480:          CALL MYCPU_TIME(FTIME,.FALSE.)
1525:          WRITE(*,'(A,I6,A,F12.6,A,I6,A,G20.10)') ' intlbfgs> switch on true potential at step ',NITERDONE, &1481:          WRITE(*,'(A,I6,A,F12.6,A,I6,A,G20.10)') ' intlbfgs> switch on true potential at step ',NITERDONE, &
1526:   &                                     ' fraction=',INTCONFRAC,' images=',INTIMAGE,' time=',FTIME-STIME1482:   &                                     ' fraction=',INTCONFRAC,' images=',INTIMAGE,' time=',FTIME-STIME
1527:          IF (DEBUG) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF,CONOFFLIST)1483:          IF (DEBUG) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER)
1528:          IF (DEBUG) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)1484:          IF (DEBUG) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)
1529:          WRITE(*,'(A,I6,A,F15.6)') ' intlbfgs> Allowing ',INTCONSTEPS,' further optimization steps'1485:          WRITE(*,'(A,I6,A,F15.6)') ' intlbfgs> Allowing ',INTCONSTEPS,' further optimization steps'
1530:          DO J1=1,NATOMS1486:          DO J1=1,NATOMS
1531:             IF (.NOT.ATOMACTIVE(J1)) THEN1487:             IF (.NOT.ATOMACTIVE(J1)) THEN
1532:                WRITE(*,'(A,I6,A,I6,A)') ' intlbfgs> ERROR *** number of active atoms=',NACTIVE,' but atom ',J1,' is not active'1488:                WRITE(*,'(A,I6,A,I6,A)') ' intlbfgs> ERROR *** number of active atoms=',NACTIVE,' but atom ',J1,' is not active'
1533:             ENDIF1489:             ENDIF
1534:          ENDDO1490:          ENDDO
1535:          NSTEPSMAX=NITERDONE+INTCONSTEPS1491:          NSTEPSMAX=NITERDONE+INTCONSTEPS
1536:          SWITCHED=.TRUE.1492:          SWITCHED=.TRUE.
1537:          RMS=INTRMSTOL*10.0D0 ! to prevent premature convergence1493:          RMS=INTRMSTOL*10.0D0 ! to prevent premature convergence
1552:    777 CONTINUE1508:    777 CONTINUE
1553: !1509: !
1554: ! Compute the new step and gradient change1510: ! Compute the new step and gradient change
1555: !1511: !
1556:    NPT=POINT*D1512:    NPT=POINT*D
1557:    SEARCHSTEP(POINT,:) = STP*SEARCHSTEP(POINT,:)1513:    SEARCHSTEP(POINT,:) = STP*SEARCHSTEP(POINT,:)
1558:    GDIF(POINT,:)=G-GTMP1514:    GDIF(POINT,:)=G-GTMP
1559:    1515:    
1560:    POINT=POINT+1; IF (POINT==INTMUPDATE) POINT=01516:    POINT=POINT+1; IF (POINT==INTMUPDATE) POINT=0
1561: 1517: 
1562:    IF (DUMPINTXYZ.AND.MOD(NITERDONE,DUMPINTXYZFREQ)==0) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF,CONOFFLIST)1518:    IF (DUMPINTXYZ.AND.MOD(NITERDONE,DUMPINTXYZFREQ)==0) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER)
1563:    IF (DUMPINTEOS.AND.MOD(NITERDONE,DUMPINTEOSFREQ)==0) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)1519:    IF (DUMPINTEOS.AND.MOD(NITERDONE,DUMPINTEOSFREQ)==0) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)
1564: 1520: 
1565:    NITERDONE=NITERDONE+11521:    NITERDONE=NITERDONE+1
1566:    NITERUSE=NITERUSE+11522:    NITERUSE=NITERUSE+1
1567: 1523: 
1568:    IF (NITERDONE.GT.NSTEPSMAX) EXIT1524:    IF (NITERDONE.GT.NSTEPSMAX) EXIT
1569:    IF (NACTIVE.EQ.NATOMS) THEN1525:    IF (NACTIVE.EQ.NATOMS) THEN
1570:       IF (.NOT.SWITCHED) THEN1526:       IF (.NOT.SWITCHED) THEN
1571:          CALL MYCPU_TIME(FTIME,.FALSE.)1527:          CALL MYCPU_TIME(FTIME,.FALSE.)
1572:          WRITE(*,'(A,I6,A,F12.6,A,I6,A,F10.1)') ' intlbfgs> switch on true potential at step ',NITERDONE, &1528:          WRITE(*,'(A,I6,A,F12.6,A,I6,A,F10.1)') ' intlbfgs> switch on true potential at step ',NITERDONE, &
1596: ENDIF1552: ENDIF
1597: IF (EXITSTATUS.EQ.1) THEN1553: IF (EXITSTATUS.EQ.1) THEN
1598:    WRITE(*,'(A,I6,A,G20.10,A,G15.8,A,I4)') ' intlbfgs> Converged after ',NITERDONE,' steps, energy/image=',ETOTAL/INTIMAGE, &1554:    WRITE(*,'(A,I6,A,G20.10,A,G15.8,A,I4)') ' intlbfgs> Converged after ',NITERDONE,' steps, energy/image=',ETOTAL/INTIMAGE, &
1599:   &                               ' RMS=',RMS,' images=',INTIMAGE1555:   &                               ' RMS=',RMS,' images=',INTIMAGE
1600: ELSEIF (EXITSTATUS.EQ.2) THEN1556: ELSEIF (EXITSTATUS.EQ.2) THEN
1601:    WRITE(*,'(A,I6,A,G20.10,A,G15.8,A,I4)') ' intlbfgs> After ',NITERDONE,' steps, energy/image=',ETOTAL/INTIMAGE, &1557:    WRITE(*,'(A,I6,A,G20.10,A,G15.8,A,I4)') ' intlbfgs> After ',NITERDONE,' steps, energy/image=',ETOTAL/INTIMAGE, &
1602:   &                               ' RMS=',RMS,' images=',INTIMAGE1558:   &                               ' RMS=',RMS,' images=',INTIMAGE
1603: ENDIF1559: ENDIF
1604: 678 CONTINUE1560: 678 CONTINUE
1605: 1561: 
1606: ! CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF,CONOFFLIST)1562: ! CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER)
1607: ! CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)1563: ! CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)
1608: 1564: 
1609: IF (DEBUG) WRITE(*,'(A,G20.10)') 'intlbfgs> WORST=',WORST1565: IF (DEBUG) WRITE(*,'(A,G20.10)') 'intlbfgs> WORST=',WORST
1610: 1566: 
1611: BESTWORST=WORST1567: BESTWORST=WORST
1612: BESTINTIMAGE=INTIMAGE1568: BESTINTIMAGE=INTIMAGE
1613: IF (ALLOCATED(QCIXYZ)) DEALLOCATE(QCIXYZ)1569: IF (ALLOCATED(QCIXYZ)) DEALLOCATE(QCIXYZ)
1614: ALLOCATE(QCIXYZ(3*NATOMS*(INTIMAGE+2)))1570: ALLOCATE(QCIXYZ(3*NATOMS*(INTIMAGE+2)))
1615: QCIXYZ(1:3*NATOMS*(INTIMAGE+2))=XYZ(1:3*NATOMS*(INTIMAGE+2))1571: QCIXYZ(1:3*NATOMS*(INTIMAGE+2))=XYZ(1:3*NATOMS*(INTIMAGE+2))
1616: WRITE(*,'(A,I8,A,G20.10)') 'intlbfgs> retaining ',INTIMAGE,' QCI images, highest energy=',BESTWORST1572: WRITE(*,'(A,I8,A,G20.10)') 'intlbfgs> retaining ',INTIMAGE,' QCI images, highest energy=',BESTWORST
1617: 1573: 
1618: CALL INTRWG(NACTIVE,0,INTIMAGE,XYZ,TURNONORDER,NCONOFF,CONOFFLIST)1574: CALL INTRWG(NACTIVE,0,INTIMAGE,XYZ,TURNONORDER)
1619: CALL WRITEPROFILE(0,EEE,INTIMAGE)1575: CALL WRITEPROFILE(0,EEE,INTIMAGE)
1620: 1576: 
1621: DEALLOCATE(CONI,CONJ,CONDISTREF,REPI,REPJ,NREPI,NREPJ,REPCUT,NREPCUT,CONCUT)1577: DEALLOCATE(CONI,CONJ,CONDISTREF,REPI,REPJ,NREPI,NREPJ,REPCUT,NREPCUT,CONCUT)
1622: DEALLOCATE(TRUEEE, EEETMP, MYGTMP, GTMP, &1578: DEALLOCATE(TRUEEE, EEETMP, MYGTMP, GTMP, &
1623:   &      DIAG, STP, SEARCHSTEP, GDIF,GLAST, XSAVE, XYZ, GGG, CHECKG, IMGFREEZE, EEE, STEPIMAGE)1579:   &      DIAG, STP, SEARCHSTEP, GDIF,GLAST, XSAVE, XYZ, GGG, CHECKG, IMGFREEZE, EEE, STEPIMAGE)
1624: QCIIMAGE=INTIMAGE1580: QCIIMAGE=INTIMAGE
1625: INTIMAGE=INTIMAGESAVE1581: INTIMAGE=INTIMAGESAVE
1626: 1582: 
1627: END SUBROUTINE INTLBFGS1583: END SUBROUTINE INTLBFGS
1628: !1584: !
1689:          NREPCUT(NNREPULSIVE)=REPCUT(JJ)1645:          NREPCUT(NNREPULSIVE)=REPCUT(JJ)
1690:          GOTO 2461646:          GOTO 246
1691:       ENDIF1647:       ENDIF
1692:    ENDDO 1648:    ENDDO 
1693: 246 CONTINUE1649: 246 CONTINUE
1694: ENDDO1650: ENDDO
1695: IF (DEBUG) WRITE(*,'(A,2I8)') ' checkrep> number of active repulsions and total=',NNREPULSIVE,NREPULSIVE1651: IF (DEBUG) WRITE(*,'(A,2I8)') ' checkrep> number of active repulsions and total=',NNREPULSIVE,NREPULSIVE
1696: 1652: 
1697: END SUBROUTINE CHECKREP1653: END SUBROUTINE CHECKREP
1698: 1654: 
1699: SUBROUTINE INTRWG(NACTIVE,NITER,INTIMAGE,XYZ,TURNONORDER,NCONOFF,CONOFFLIST)1655: SUBROUTINE INTRWG(NACTIVE,NITER,INTIMAGE,XYZ,TURNONORDER)
1700: USE PORFUNCS1656: USE PORFUNCS
1701: USE KEY,ONLY: STOCKT,STOCKAAT, RBAAT, ATOMACTIVE, NCONSTRAINT, CONACTIVE, NREPULSIVE, NNREPULSIVE, REPI, REPJ, REPCUT, NREPCUT, &1657: USE KEY,ONLY: STOCKT,STOCKAAT, RBAAT, ATOMACTIVE, NCONSTRAINT, CONACTIVE, NREPULSIVE, NNREPULSIVE, REPI, REPJ, REPCUT, NREPCUT, &
1702:   &           NREPMAX, NREPI, NREPJ, INTFROZEN1658:   &           NREPMAX, NREPI, NREPJ, INTFROZEN
1703: USE COMMONS, ONLY: NATOMS1659: USE COMMONS, ONLY: NATOMS
1704: IMPLICIT NONE1660: IMPLICIT NONE
1705: INTEGER NCONOFF, CONOFFLIST(NCONSTRAINT) 
1706: CHARACTER(LEN=10) :: XYZFILE   = 'int.xyz   '1661: CHARACTER(LEN=10) :: XYZFILE   = 'int.xyz   '
1707: CHARACTER(LEN=10) :: QCIFILE   = 'QCIdump   '1662: CHARACTER(LEN=10) :: QCIFILE   = 'QCIdump   '
1708: INTEGER,INTENT(IN) :: NITER, TURNONORDER(NATOMS)1663: INTEGER,INTENT(IN) :: NITER, TURNONORDER(NATOMS)
1709: INTEGER :: J1,J2,INTIMAGE,J3,NACTIVE,LUNIT,GETUNIT1664: INTEGER :: J1,J2,INTIMAGE,J3,NACTIVE,LUNIT,GETUNIT
1710: CHARACTER(LEN=80) :: FILENAME,DUMMYS1665: CHARACTER(LEN=80) :: FILENAME,DUMMYS
1711: DOUBLE PRECISION XYZ((3*NATOMS)*(INTIMAGE+2))1666: DOUBLE PRECISION XYZ((3*NATOMS)*(INTIMAGE+2))
1712: 1667: 
1713: FILENAME=XYZFILE1668: FILENAME=XYZFILE
1714: 1669: 
1715: ! IF (NITER.GT.0) THEN1670: ! IF (NITER.GT.0) THEN
1763:    WRITE(*,'(A)') ' intlbfgs> dumped NREPJ:'1718:    WRITE(*,'(A)') ' intlbfgs> dumped NREPJ:'
1764: 1719: 
1765:    WRITE(LUNIT,'(6G20.10)') REPCUT(1:NREPULSIVE)1720:    WRITE(LUNIT,'(6G20.10)') REPCUT(1:NREPULSIVE)
1766:    WRITE(*,'(A)') ' intlbfgs> dumped REPCUT:'1721:    WRITE(*,'(A)') ' intlbfgs> dumped REPCUT:'
1767:    WRITE(LUNIT,'(6G20.10)') NREPCUT(1:NNREPULSIVE)1722:    WRITE(LUNIT,'(6G20.10)') NREPCUT(1:NNREPULSIVE)
1768:    WRITE(*,'(A)') ' intlbfgs> dumped NREPCUT:'1723:    WRITE(*,'(A)') ' intlbfgs> dumped NREPCUT:'
1769: 1724: 
1770:    WRITE(LUNIT,'(12L5)') INTFROZEN(1:NATOMS)1725:    WRITE(LUNIT,'(12L5)') INTFROZEN(1:NATOMS)
1771:    WRITE(*,'(A)') ' intlbfgs> dumped INTFROZEN'1726:    WRITE(*,'(A)') ' intlbfgs> dumped INTFROZEN'
1772: 1727: 
1773:    WRITE(LUNIT,'(I8)') NCONOFF 
1774:    IF (NCONOFF.GT.0) WRITE(LUNIT,'(12I8)') CONOFFLIST(1:NCONOFF) 
1775:    WRITE(*,'(A)') ' intlbfgs> dumped NCONOFF and CONOFFLIST' 
1776:  
1777: CLOSE(LUNIT)1728: CLOSE(LUNIT)
1778: 1729: 
1779: END SUBROUTINE INTRWG1730: END SUBROUTINE INTRWG
1780: 1731: 
1781: SUBROUTINE WRITEPROFILE(NITER,EEE,INTIMAGE)1732: SUBROUTINE WRITEPROFILE(NITER,EEE,INTIMAGE)
1782: IMPLICIT NONE 1733: IMPLICIT NONE 
1783: INTEGER,INTENT(IN) :: NITER, INTIMAGE1734: INTEGER,INTENT(IN) :: NITER, INTIMAGE
1784: INTEGER :: I,LUNIT,GETUNIT1735: INTEGER :: I,LUNIT,GETUNIT
1785: DOUBLE PRECISION :: EEE(INTIMAGE+2)1736: DOUBLE PRECISION :: EEE(INTIMAGE+2)
1786: CHARACTER(LEN=20) :: FILENAME1737: CHARACTER(LEN=20) :: FILENAME
1803: CLOSE(LUNIT)1754: CLOSE(LUNIT)
1804: WRITE(*,'(A)') ' writeprofile> Interpolated energy profile was saved to file "'//trim(filename)//'"'1755: WRITE(*,'(A)') ' writeprofile> Interpolated energy profile was saved to file "'//trim(filename)//'"'
1805: 1756: 
1806: END SUBROUTINE WRITEPROFILE1757: END SUBROUTINE WRITEPROFILE
1807: 1758: 
1808: SUBROUTINE DOADDATOM(NCONSTRAINT,NTRIES,NEWATOM,IMGFREEZE,INTIMAGE,XYZ,EEE,GGG,TURNONORDER,NITERDONE,NACTIVE,AABACK,BACKDONE)1759: SUBROUTINE DOADDATOM(NCONSTRAINT,NTRIES,NEWATOM,IMGFREEZE,INTIMAGE,XYZ,EEE,GGG,TURNONORDER,NITERDONE,NACTIVE,AABACK,BACKDONE)
1809: USE KEY, ONLY : CONACTIVE, CONI, CONJ, ATOMACTIVE, CONDISTREF, REPI, REPJ, REPCUT, INTREPSEP,  &1760: USE KEY, ONLY : CONACTIVE, CONI, CONJ, ATOMACTIVE, CONDISTREF, REPI, REPJ, REPCUT, INTREPSEP,  &
1810:   &             INTCONSTRAINREPCUT, NREPULSIVE, NREPMAX, MAXCONUSE, CHECKCONINT, &1761:   &             INTCONSTRAINREPCUT, NREPULSIVE, NREPMAX, MAXCONUSE, CHECKCONINT, &
1811:   &             FREEZENODEST, NNREPULSIVE, INTFROZEN, ATOMSTORES, QCIADDACIDT, &1762:   &             FREEZENODEST, NNREPULSIVE, INTFROZEN, ATOMSTORES, QCIADDACIDT, &
1812:   &             NREPULSIVEFIX, REPIFIX, REPJFIX, REPCUTFIX, NREPI, NREPJ, NREPCUT, MAXNACTIVE, &1763:   &             NREPULSIVEFIX, REPIFIX, REPJFIX, REPCUTFIX, NREPI, NREPJ, NREPCUT, MAXNACTIVE, &
1813:   &             NCONSTRAINTFIX, CONIFIX, CONJFIX, INTCONCUT, INTCONSEP, QCIRADSHIFTT, QCIRADSHIFT, QCIADDREP, DOBACK, DOBACKALL1764:   &             NCONSTRAINTFIX, CONIFIX, CONJFIX, INTCONCUT, INTCONSEP, QCIRADSHIFTT, QCIRADSHIFT, QCIADDREP, DOBACK
1814: USE COMMONS, ONLY: NATOMS, DEBUG1765: USE COMMONS, ONLY: NATOMS, DEBUG
1815: IMPLICIT NONE1766: IMPLICIT NONE
1816: INTEGER INTIMAGE1767: INTEGER INTIMAGE
1817: INTEGER NBEST, NCONTOACTIVE(NATOMS),  NCONSTRAINT, J2, NTRIES(NATOMS), NEWATOM,  CONLIST(NATOMS), N1, N2, N3, &1768: INTEGER NBEST, NCONTOACTIVE(NATOMS),  NCONSTRAINT, J2, NTRIES(NATOMS), NEWATOM,  CONLIST(NATOMS), N1, N2, N3, &
1818:   &     NTOADD, NADDED, NMININT, NMAXINT, TURNONORDER(NATOMS), NDUMMY, J1, J3, NITERDONE, NCONFORNEWATOM, NACTIVE1769:   &     NTOADD, NADDED, NMININT, NMAXINT, TURNONORDER(NATOMS), NDUMMY, J1, J3, NITERDONE, NCONFORNEWATOM, NACTIVE
1819: DOUBLE PRECISION DUMMY, DUMMY2, DPRAND, RANDOM, CONDIST(NATOMS), DMIN1770: DOUBLE PRECISION DUMMY, DUMMY2, DPRAND, RANDOM, CONDIST(NATOMS), DMIN
1820: INTEGER NDFORNEWATOM, BESTPRESERVEDN(NATOMS), ACID1771: INTEGER NDFORNEWATOM, BESTPRESERVEDN(NATOMS), ACID
1821: DOUBLE PRECISION BESTPRESERVEDD(NATOMS), BESTCLOSESTD(NATOMS), INVDTOACTIVE(NATOMS)1772: DOUBLE PRECISION BESTPRESERVEDD(NATOMS), BESTCLOSESTD(NATOMS), INVDTOACTIVE(NATOMS)
1822: LOGICAL IMGFREEZE(INTIMAGE), ADDREP(NATOMS), CHOSENACID, AABACK(NATOMS), BACKDONE1773: LOGICAL IMGFREEZE(INTIMAGE), ADDREP(NATOMS), CHOSENACID, AABACK(NATOMS), BACKDONE
1823: DOUBLE PRECISION C1, C2, C3, VEC1(3), VEC2(3), VEC3(3), ESAVED, ESAVEC, ESAVE01774: DOUBLE PRECISION C1, C2, C3, VEC1(3), VEC2(3), VEC3(3), ESAVED, ESAVEC, ESAVE0
1953:                         NEWATOM=CONJ(J1)1904:                         NEWATOM=CONJ(J1)
1954:                      ENDIF1905:                      ENDIF
1955:                   ENDIF1906:                   ENDIF
1956:                ENDIF1907:                ENDIF
1957:             ENDIF1908:             ENDIF
1958:          ENDIF1909:          ENDIF
1959:       ENDDO1910:       ENDDO
1960:       IF (DEBUG) WRITE(*,'(3(A,I6),A,F15.5)') ' intlbfgs> Choosing new active atom ',NEWATOM,' new constraints=', &1911:       IF (DEBUG) WRITE(*,'(3(A,I6),A,F15.5)') ' intlbfgs> Choosing new active atom ',NEWATOM,' new constraints=', &
1961:   &                                       NCONTOACTIVE(NEWATOM),' maximum=',NBEST,' shortest constraint=',DUMMY21912:   &                                       NCONTOACTIVE(NEWATOM),' maximum=',NBEST,' shortest constraint=',DUMMY2
1962:       IF (DOBACK) WRITE(*,'(A,L5)') ' intlbfgs> AABACK=',AABACK(NEWATOM)1913:       IF (DOBACK) WRITE(*,'(A,L5)') ' intlbfgs> AABACK=',AABACK(NEWATOM)
1963: !     IF (DEBUG) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF,CONOFFLIST)1914: !     IF (DEBUG) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,ETOTAL)
1964: !     IF (DEBUG) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)1915: !     IF (DEBUG) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)
1965:       IF (QCIADDACIDT.AND.(.NOT.CHOSENACID).AND.(.NOT.DOBACK)) THEN1916:       IF (QCIADDACIDT.AND.(.NOT.CHOSENACID).AND.(.NOT.DOBACK)) THEN
1966:          ACID=ATOMSTORES(NEWATOM)1917:          ACID=ATOMSTORES(NEWATOM)
1967:          CHOSENACID=.TRUE.1918:          CHOSENACID=.TRUE.
1968:       ENDIF1919:       ENDIF
1969:       IF ((.NOT.CHOSENACID).AND.DOBACKALL) THEN 
1970:          ACID=ATOMSTORES(NEWATOM) 
1971:          CHOSENACID=.TRUE. 
1972:       ENDIF 
1973:           1920:           
1974:       IF (NEWATOM*NBEST.EQ.0) THEN ! sanity check1921:       IF (NEWATOM*NBEST.EQ.0) THEN ! sanity check
1975:          WRITE(*,'(A,I6,A,2I6)') ' intlbfgs> ERROR *** new active atom not set'1922:          WRITE(*,'(A,I6,A,2I6)') ' intlbfgs> ERROR *** new active atom not set'
1976:          STOP1923:          STOP
1977:       ELSE1924:       ELSE
1978: !1925: !
1979: !  We need a sorted list of up to 3 active atoms, sorted according to how well the1926: !  We need a sorted list of up to 3 active atoms, sorted according to how well the
1980: !  end point distance is preserved, even if they don't satisfy the constraint 1927: !  end point distance is preserved, even if they don't satisfy the constraint 
1981: !  condition. We want three atoms to use for a local axis system in the interpolation.1928: !  condition. We want three atoms to use for a local axis system in the interpolation.
1982: !1929: !
2546: !2493: !
2547: ! Check whether we've added all atoms in the amino acid corresponding to the new atom. If not, go back to the top2494: ! Check whether we've added all atoms in the amino acid corresponding to the new atom. If not, go back to the top
2548: ! and choose the next candidate.2495: ! and choose the next candidate.
2549: !2496: !
2550:       IF (QCIADDACIDT.AND.(.NOT.DOBACK)) THEN2497:       IF (QCIADDACIDT.AND.(.NOT.DOBACK)) THEN
2551:          DO J1=1,NATOMS2498:          DO J1=1,NATOMS
2552:             IF ((ATOMSTORES(J1).EQ.ACID).AND.(.NOT.(ATOMACTIVE(J1)))) GOTO 5422499:             IF ((ATOMSTORES(J1).EQ.ACID).AND.(.NOT.(ATOMACTIVE(J1)))) GOTO 542
2553:          ENDDO2500:          ENDDO
2554:          WRITE(*,'(A,I6,A)') 'doaddatom> All atoms of residue ',ACID,' are active'2501:          WRITE(*,'(A,I6,A)') 'doaddatom> All atoms of residue ',ACID,' are active'
2555:       ENDIF2502:       ENDIF
2556:       IF (DOBACKALL) THEN 
2557:          DO J1=1,NATOMS 
2558:             IF ((ATOMSTORES(J1).EQ.ACID).AND.(.NOT.(ATOMACTIVE(J1))).AND.AABACK(J1)) GOTO 542 
2559:          ENDDO 
2560:          WRITE(*,'(A,I6,A)') 'doaddatom> All backbone atoms of residue ',ACID,' are active' 
2561:       ENDIF 
2562: 2503: 
2563:       IF (QCIRADSHIFTT) THEN2504:       IF (QCIRADSHIFTT) THEN
2564:          WRITE(*,'(A,F15.5)') ' intlbfgs> Applying radial shift for unconstrained atoms of ',QCIRADSHIFT2505:          WRITE(*,'(A,F15.5)') ' intlbfgs> Applying radial shift for unconstrained atoms of ',QCIRADSHIFT
2565:          WRITE(*,'(20I6)') CONLIST(1:NCONFORNEWATOM)2506:          WRITE(*,'(20I6)') CONLIST(1:NCONFORNEWATOM)
2566:          DO J1=2,INTIMAGE+12507:          DO J1=2,INTIMAGE+1
2567:             scaleloop: DO J2=1,NATOMS2508:             scaleloop: DO J2=1,NATOMS
2568:                IF (.NOT.ATOMACTIVE(J2)) CYCLE scaleloop2509:                IF (.NOT.ATOMACTIVE(J2)) CYCLE scaleloop
2569:                IF (J2.EQ.NEWATOM) CYCLE scaleloop2510:                IF (J2.EQ.NEWATOM) CYCLE scaleloop
2570:                DO J3=1,NCONFORNEWATOM2511:                DO J3=1,NCONFORNEWATOM
2571:                   IF (CONLIST(J3).EQ.J2) CYCLE scaleloop2512:                   IF (CONLIST(J3).EQ.J2) CYCLE scaleloop


r33425/key.f90 2017-10-30 11:30:13.238230327 +0000 r33424/key.f90 2017-10-30 11:30:14.134242116 +0000
 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, MLPSTART, MLPOUT, MLPHIDDEN, MLPDATA, NMLP, N_TO_ALIGN, DJWRBID, STM, NHEXAMERS, & 25:      &        MLPIN, MLPSTART, MLPOUT, MLPHIDDEN, MLPDATA, NMLP, N_TO_ALIGN, DJWRBID, STM, NHEXAMERS, &
 26:      &        MLQIN, MLQSTART, MLQOUT, MLQDATA, NMLQ, & 26:      &        MLQIN, MLQSTART, MLQOUT, MLQDATA, NMLQ, &
 27:      &        QCIADDREP, QCIBONDS, QCISECOND, MAXNACTIVE, QCIIMAGE, NADDTARGET, NUMNN, MULTI_COUNT, MULTI_LAST, MULTI_STEP, & 27:      &        QCIADDREP, QCIBONDS, QCISECOND, MAXNACTIVE, QCIIMAGE, NADDTARGET, NUMNN, MULTI_COUNT, MULTI_LAST, MULTI_STEP, &
 28:      &        NDOF, RECCOUNT, MLPPROBPOS, PUSHOPTMAX, MLPNEIGH, QCICYCN, QCIPDINT, NPEAKS, NDISPLACEMENTS, NROTATIONS, & 28:      &        NDOF, RECCOUNT, MLPPROBPOS, PUSHOPTMAX, MLPNEIGH, QCICYCN, QCIPDINT, NPEAKS, NDISPLACEMENTS, NROTATIONS, &
 29:      &        MAX_ANGMOM, BNB_NSTEPS, QUIPZ, QCIRESETINT1, QCIRESETINT2, JMAXCON 29:      &        MAX_ANGMOM, BNB_NSTEPS, QUIPZ
 30:  30: 
 31:       LOGICAL :: DTEST, MASST, RTEST, EFSTEPST, VECTORST, SUMMARYT, DUMPV, DUMPMAG, FREEZE, FREEZERANGE, GRADSQ, & 31:       LOGICAL :: DTEST, MASST, RTEST, EFSTEPST, VECTORST, SUMMARYT, DUMPV, DUMPMAG, FREEZE, FREEZERANGE, GRADSQ, &
 32:      &        PGRAD, VALUEST, ADMT, BFGSMINT, BFGSTST, CHECKINDEX, TOSI, CONTAINER, & 32:      &        PGRAD, VALUEST, ADMT, BFGSMINT, BFGSTST, CHECKINDEX, TOSI, CONTAINER, &
 33:      &        GAUSSIAN, CADPAC, PRESSURE, FTEST, DCHECK, CP2K, DFTP, CPMD, CPMDC, FREEZERES, DF1T, & 33:      &        GAUSSIAN, CADPAC, PRESSURE, FTEST, DCHECK, CP2K, DFTP, CPMD, CPMDC, FREEZERES, DF1T, &
 34:      &        VARIABLES, FIELDT, OHT, IHT, TDT, D5HT, TWOENDS, PV, FRACTIONAL, BLNT, HYBRIDMINT, & 34:      &        VARIABLES, FIELDT, OHT, IHT, TDT, D5HT, TWOENDS, PV, FRACTIONAL, BLNT, HYBRIDMINT, &
 35:      &        INDEXT, LANCZOST, NOSHIFT, GAMESSUS, GAMESSUK, PVTS, RIGIDBODY, CASTEP, ONETEP, QCHEM, QCHEMES, VASP, & 35:      &        INDEXT, LANCZOST, NOSHIFT, GAMESSUS, GAMESSUK, PVTS, RIGIDBODY, CASTEP, ONETEP, QCHEM, QCHEMES, VASP, &
 36:      &        BFGSSTEP, EFOLSTEP, BULKT, HUPDATE, NOHESS, READV, NOIT, THOMSONT, SIO2T, SIO2C6T, BISECTT, BISECTDEBUG, & 36:      &        BFGSSTEP, EFOLSTEP, BULKT, HUPDATE, NOHESS, READV, NOIT, THOMSONT, SIO2T, SIO2C6T, BISECTT, BISECTDEBUG, &
 37:      &        TOSIC6, TOSIPOL, FIXIMAGE, DFTBT, CHECKCONT, CHECKDT, SHIFTED, READSP, DUMPSP, NOFRQS, & 37:      &        TOSIC6, TOSIPOL, FIXIMAGE, DFTBT, CHECKCONT, CHECKDT, SHIFTED, READSP, DUMPSP, NOFRQS, &
 38:      &        ALLSTEPS, ALLVECTORS, MWVECTORS, WELCH, BINARY, READHESS, MOVIE, NORESET, TWOD, & 38:      &        ALLSTEPS, ALLVECTORS, MWVECTORS, WELCH, BINARY, READHESS, MOVIE, NORESET, TWOD, &
 39:      &        DOUBLET, REOPT, PARALLEL, LINEMIN, FIXD, KEEPINDEX, BSMIN, PRINTPTS, RKMIN, REPELTST,& 39:      &        DOUBLET, REOPT, PARALLEL, LINEMIN, FIXD, KEEPINDEX, BSMIN, PRINTPTS, RKMIN, REPELTST,&
 53:      &        THREEDPBCT, FOURDAPBCT, FOURDPBCT, MODEDOWNT, CHEMSHIFT, TTM3T, & 53:      &        THREEDPBCT, FOURDAPBCT, FOURDPBCT, MODEDOWNT, CHEMSHIFT, TTM3T, &
 54:      &        NOINVERSION, INVERTPT, KNOWVECS, PMPATHT, AAORIENTT, MULTIJOBT, QUIPARGSTRT, QUIPPARAMST, HESSDUMPT, & 54:      &        NOINVERSION, INVERTPT, KNOWVECS, PMPATHT, AAORIENTT, MULTIJOBT, QUIPARGSTRT, QUIPPARAMST, HESSDUMPT, &
 55:      &        CLASSICALRATEST, TSPLITTINGT, HESSREADT, INSTANTONOPTT,INSTANTONSTARTDUMPT,VARSTEPOPTT, MOLPRO, REAXFFT, & 55:      &        CLASSICALRATEST, TSPLITTINGT, HESSREADT, INSTANTONOPTT,INSTANTONSTARTDUMPT,VARSTEPOPTT, MOLPRO, REAXFFT, &
 56:      &        EIGENONLY,OVERCONV, GLJT,CLSTRINGT,CLSTRINGTST, PHI4MODT, EX1DT, MCPATHT, MCBIAST, RPHT, TWISTT, MCPATH2T, & 56:      &        EIGENONLY,OVERCONV, GLJT,CLSTRINGT,CLSTRINGTST, PHI4MODT, EX1DT, MCPATHT, MCBIAST, RPHT, TWISTT, MCPATH2T, &
 57:      &        PBST, SSHT, GAUSSIAN03, GAUSSIAN09, CPPNEBT, CUDAT, CUDATIMET, TRUSTMODET,MODELOST, METRICTENSOR, INTSPRINGACTIVET, & 57:      &        PBST, SSHT, GAUSSIAN03, GAUSSIAN09, CPPNEBT, CUDAT, CUDATIMET, TRUSTMODET,MODELOST, METRICTENSOR, INTSPRINGACTIVET, &
 58:      &        PERMGUESS, QCIPERMCHECK, DUMPFRQST, MULTIPOTT, MLP3T, MLPB3T, DUMPBESTPATH, ALIGNRBST, AVOID_COLLISIONS, MLPPROB, & 58:      &        PERMGUESS, QCIPERMCHECK, DUMPFRQST, MULTIPOTT, MLP3T, MLPB3T, DUMPBESTPATH, ALIGNRBST, AVOID_COLLISIONS, MLPPROB, &
 59:      &        MALONALDEHYDE, SIO2PT, MLPNEWREG, DJWRBT, STEALTHYT, STEALTV, LJADDT, MLPB3NEWT, MLPVB3T, & 59:      &        MALONALDEHYDE, SIO2PT, MLPNEWREG, DJWRBT, STEALTHYT, STEALTV, LJADDT, MLPB3NEWT, MLPVB3T, &
 60:      &        QCIPOTT, QCIPOT2T, QCIRADSHIFTT, QCINOREPINT, QCIAMBERT, SLERPT, NOTRANSROTT, MAXGAPT, BULKBOXT, GDSQT, FLATTESTT, & 60:      &        QCIPOTT, QCIPOT2T, QCIRADSHIFTT, QCINOREPINT, QCIAMBERT, SLERPT, NOTRANSROTT, MAXGAPT, BULKBOXT, GDSQT, FLATTESTT, &
 61:      &        MLQT, MLQPROB, LJADD2T, MACROIONT, NOREGBIAS, PYADDT, PYADD2T, SANDBOXT, LJADD3T, LJADD4T, & 61:      &        MLQT, MLQPROB, LJADD2T, MACROIONT, NOREGBIAS, PYADDT, PYADD2T, SANDBOXT, LJADD3T, LJADD4T, &
 62:      &        MBPOLT, MULTIJOB_MACHINET, DUMPDATA_MACHINET, PLUSSIDET, MINUSSIDET, PUSHOPTT, MLPVB3NNT, GAUSSIAN16, QCICYCLEST, & 62:      &        MBPOLT, MULTIJOB_MACHINET, DUMPDATA_MACHINET, PLUSSIDET, MINUSSIDET, PUSHOPTT, MLPVB3NNT, GAUSSIAN16, QCICYCLEST, &
 63:      &        QCIDNEBT, QCIRESTART, QCILPERMDIST, FASTOVERLAPT, BNB_ALIGNT, QUIPT, QCIADDACIDT, DOBACK, QCIRESET, DOBACKALL 63:      &        QCIDNEBT, QCIRESTART, QCILPERMDIST, FASTOVERLAPT, BNB_ALIGNT, QUIPT, QCIADDACIDT, DOBACK
 64:  64: 
 65:  65: 
 66: ! sy349 > for testing the flatpath after dneb 66: ! sy349 > for testing the flatpath after dneb
 67:       !LOGICAL, ALLOCATABLE :: FLATPATHT(:) 67:       !LOGICAL, ALLOCATABLE :: FLATPATHT(:)
 68:       LOGICAL FLATPATHT 68:       LOGICAL FLATPATHT
 69:  69: 
 70: ! bf269 > polymer in a pore (non-bonding (LJ) energy from neighbours is not subtracted) 70: ! bf269 > polymer in a pore (non-bonding (LJ) energy from neighbours is not subtracted)
 71:       LOGICAL :: PORE8T = .FALSE. ! add 8th power cylindrical pore to the potential? 71:       LOGICAL :: PORE8T = .FALSE. ! add 8th power cylindrical pore to the potential?
 72:       INTEGER :: PORE8_AXIS = 3 ! principal axis of the cylindric pore (1:x, 2:y, 3:z) 72:       INTEGER :: PORE8_AXIS = 3 ! principal axis of the cylindric pore (1:x, 2:y, 3:z)
 73:       DOUBLE PRECISION :: PORE8_ENERGY = 1.0d1 ! energy of the pore when radius = 1 73:       DOUBLE PRECISION :: PORE8_ENERGY = 1.0d1 ! energy of the pore when radius = 1


r33425/keywords.f 2017-10-30 11:30:13.470233379 +0000 r33424/keywords.f 2017-10-30 11:30:14.366245168 +0000
645:          INTLJEPS=1.0D0645:          INTLJEPS=1.0D0
646: 646: 
647: !647: !
648: ! QCI parameters648: ! QCI parameters
649: !649: !
650:          CONDATT=.FALSE.650:          CONDATT=.FALSE.
651:          QCIPOTT=.FALSE.651:          QCIPOTT=.FALSE.
652:          QCIPOT2T=.FALSE.652:          QCIPOT2T=.FALSE.
653:          QCIADDREP=0653:          QCIADDREP=0
654:          DOBACK=.FALSE.654:          DOBACK=.FALSE.
655:          DOBACKALL=.FALSE. 
656:          QCIRESET=.FALSE. 
657:          QCIRESETINT1=300 
658:          QCIRESETINT2=1000 
659:          QCIADDACIDT=.FALSE.655:          QCIADDACIDT=.FALSE.
660:          QCIADDREPCUT=1.0D0656:          QCIADDREPCUT=1.0D0
661:          QCIADDREPEPS=1.0D0657:          QCIADDREPEPS=1.0D0
662:          QCINOREPINT=.FALSE.658:          QCINOREPINT=.FALSE.
663:          MAXNACTIVE=0659:          MAXNACTIVE=0
664: 660: 
665:          FREEZETOL=1.0D-3661:          FREEZETOL=1.0D-3
666:          FLATTESTT=.FALSE.662:          FLATTESTT=.FALSE.
667:          FLATEDIFF=1.0D-6663:          FLATEDIFF=1.0D-6
668:          QCIPERMCHECK=.FALSE.664:          QCIPERMCHECK=.FALSE.
3656: ! 3652: ! 
3657: ! DO NOT Use the quasi-continuous metric for connection attempts, instead of distance.3653: ! DO NOT Use the quasi-continuous metric for connection attempts, instead of distance.
3658: ! 3654: ! 
3659:             INTERPCOSTFUNCTION=.FALSE.3655:             INTERPCOSTFUNCTION=.FALSE.
3660: !3656: !
3661: ! Do the backbone first3657: ! Do the backbone first
3662: !3658: !
3663:       ELSE IF (WORD.EQ.'QCIDOBACK') THEN3659:       ELSE IF (WORD.EQ.'QCIDOBACK') THEN
3664:          DOBACK=.TRUE.3660:          DOBACK=.TRUE.
3665: !3661: !
3666: ! Do the backbone first and add all backbone atoms in each aa in one go 
3667: ! 
3668:       ELSE IF (WORD.EQ.'QCIDOBACKALL') THEN 
3669:          DOBACKALL=.TRUE. 
3670:          DOBACK=.TRUE. 
3671: ! 
3672: ! Add complete amino acids3662: ! Add complete amino acids
3673: !3663: !
3674:       ELSE IF (WORD.EQ.'QCIADDACID') THEN3664:       ELSE IF (WORD.EQ.'QCIADDACID') THEN
3675:          QCIADDACIDT=.TRUE.3665:          QCIADDACIDT=.TRUE.
3676: !3666: !
3677: ! Reset when diagnosed stuck 
3678: ! 
3679:       ELSE IF (WORD.EQ.'QCIRESET') THEN 
3680:          QCIRESET=.TRUE. 
3681:          IF (NITEMS.GT.1) CALL READI(QCIRESETINT1) 
3682:          IF (NITEMS.GT.2) CALL READI(QCIRESETINT2) 
3683: ! 
3684: !Use topology information for QCI constraints for AMBER3667: !Use topology information for QCI constraints for AMBER
3685: !3668: !
3686:       ELSE IF (WORD.EQ.'QCIAMBER') THEN3669:       ELSE IF (WORD.EQ.'QCIAMBER') THEN
3687:          QCIAMBERT=.TRUE.3670:          QCIAMBERT=.TRUE.
3688:          WRITE(*,'(A)') ' keyword> Use topology file for constraints in QCI'3671:          WRITE(*,'(A)') ' keyword> Use topology file for constraints in QCI'
3689: 3672: 
3690:          ELSE IF (WORD.EQ.'INTFREEZE') THEN3673:          ELSE IF (WORD.EQ.'INTFREEZE') THEN
3691:             INTFREEZET=.TRUE.3674:             INTFREEZET=.TRUE.
3692:             IF (NITEMS.GT.1) CALL READF(INTFREEZETOL)3675:             IF (NITEMS.GT.1) CALL READF(INTFREEZETOL)
3693:             IF (NITEMS.GT.2) CALL READI(INTFREEZEMIN)3676:             IF (NITEMS.GT.2) CALL READI(INTFREEZEMIN)


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0