hdiff output

r30629/amber_top_reader.f90 2016-07-06 15:35:32.499183247 +0100 r30628/amber_top_reader.f90 2016-07-06 15:35:38.675266770 +0100
  1: SUBROUTINE TOPOLOGY_READER(NBOND)  1: svn: E195012: Unable to find repository location for 'svn+ssh://svn.ch.private.cam.ac.uk/groups/wales/trunk/OPTIM/source/amber_top_reader.f90' in revision 30628
  2: USE KEY,ONLY : BONDS 
  3: USE PORFUNCS  
  4:    IMPLICIT NONE 
  5:    CHARACTER(100) ENTRY 
  6:    INTEGER :: MYUNIT2,GETUNIT 
  7:    INTEGER,INTENT(OUT) :: NBOND 
  8:    INTEGER :: J1,START_IND,END_IND,NBONDH,NBONDA,HENTRIES,J3,J4,J5,NDUMMY,INTDUM,J6 
  9:    INTEGER , PARAMETER :: NWORDS=20 
 10:    CHARACTER(25) :: ENTRIES(NWORDS)='' 
 11:    !INTEGER, DIMENSION(:,:), ALLOCATABLE :: BONDS 
 12:  
 13:    MYUNIT2=GETUNIT() 
 14:    OPEN(MYUNIT2,FILE='coords.prmtop',STATUS='OLD') 
 15: reading:DO 
 16:  
 17: 98    READ(MYUNIT2,'(A)',END=99) ENTRY 
 18:       CALL READ_LINE2(ENTRY,NWORDS,ENTRIES)      !get all words in line 
 19:       IF (ENTRIES(2).EQ.'POINTERS') THEN        !get number of bonds 
 20:          READ(MYUNIT2,*)                             !ignore format identifier after flag 
 21:          READ(MYUNIT2,'(A)',END=99) ENTRY 
 22:          CALL READ_LINE2(ENTRY,NWORDS,ENTRIES) 
 23:          READ(ENTRIES(3),'(I8)') NBONDH 
 24:          READ(ENTRIES(4),'(I8)') NBONDA 
 25:          NBOND = NBONDH + NBONDA 
 26:          WRITE(*,'(A,I8)') 'readtopology> Number of bonds:',NBOND 
 27:          IF (ALLOCATED(BONDS)) DEALLOCATE(BONDS) 
 28:          ALLOCATE(BONDS(NBOND,2)) 
 29:       ENDIF 
 30:       IF (ENTRIES(2).EQ. 'BONDS_INC_HYDROGEN') THEN 
 31:          READ(MYUNIT2,*)                             !ignore format identifier after flag 
 32:          HENTRIES=(NBONDH*3)/10 
 33:          HENTRIES=HENTRIES+((NBONDH*3)-(HENTRIES*10)) !number of lines of entries 
 34:          NDUMMY=1 
 35:          J5=1 
 36:          DO J3=1,HENTRIES                             !go through all lines 
 37:             READ(MYUNIT2,'(A)',END=99) ENTRY               !read line 
 38:             CALL READ_LINE2(ENTRY,NWORDS,ENTRIES) 
 39:             J4=1 
 40:             DO WHILE(J4.LE.10) 
 41:                IF (NDUMMY.LE.NBONDH) THEN 
 42:                   IF (J5.EQ.1) THEN 
 43:                      READ(ENTRIES(J4),'(I8)') INTDUM 
 44:                      BONDS(NDUMMY,1) = INTDUM/3+1        !atom1 
 45:                      J5=2 
 46:                   ELSE IF (J5.EQ.2) THEN 
 47:                      READ(ENTRIES(J4),'(I8)') INTDUM 
 48:                      BONDS(NDUMMY,2) = INTDUM/3+1        !atom2 
 49:                      J5=3 
 50:                   ELSE 
 51:                      J5=1 
 52:                      NDUMMY=NDUMMY+1 
 53:                   ENDIF 
 54:                ELSE 
 55:                   GOTO 98 
 56:                ENDIF 
 57:                J4=J4+1 
 58:             ENDDO 
 59:          ENDDO 
 60:       ENDIF 
 61:       IF (ENTRIES(2).EQ. 'BONDS_WITHOUT_HYDROGEN') THEN 
 62:          READ(MYUNIT2,*)                             !ignore format identifier after flag 
 63:          HENTRIES=(NBONDA*3)/10 
 64:          HENTRIES=HENTRIES+((NBONDA*3)-(HENTRIES*10)) !number of lines of entries 
 65:          NDUMMY=NBONDH+1 
 66:          J5=1 
 67:          DO J3=1,HENTRIES                             !go through all lines 
 68:             READ(MYUNIT2,'(A)',END=99) ENTRY               !read line 
 69:             CALL READ_LINE2(ENTRY,NWORDS,ENTRIES) 
 70:             J4=1 
 71:             DO WHILE(J4.LE.10) 
 72:                IF (NDUMMY.LE.(NBONDH+NBONDA)) THEN 
 73:                   IF (J5.EQ.1) THEN 
 74:                      READ(ENTRIES(J4),'(I8)') INTDUM 
 75:                      BONDS(NDUMMY,1) = INTDUM/3+1 
 76:                      J5=2 
 77:                   ELSE IF (J5.EQ.2) THEN 
 78:                      READ(ENTRIES(J4),'(I8)') INTDUM 
 79:                      BONDS(NDUMMY,2) = INTDUM/3+1 
 80:                      J5=3 
 81:                   ELSE 
 82:                      J5=1 
 83:                      NDUMMY=NDUMMY+1 
 84:                   ENDIF 
 85:                ELSE 
 86:                   GOTO 98 
 87:                ENDIF 
 88:                J4=J4+1 
 89:             ENDDO 
 90:          ENDDO 
 91:       ENDIF 
 92:  
 93:    ENDDO reading 
 94: 99 CLOSE(MYUNIT2) 
 95: !  DO J6=1,NBOND 
 96: !     WRITE(*,'(A,I8,A,I8)') 'readtopology> Bond between',BONDS(J6,1),' and',BONDS(J6,2) 
 97: !  ENDDO 
 98:  
 99: END SUBROUTINE 
100:    
101: SUBROUTINE READ_LINE2(LINE,NWORDS,WORDSOUT) 
102:       CHARACTER(*), INTENT(IN) :: LINE 
103:       INTEGER, INTENT(IN) :: NWORDS 
104:       CHARACTER(*), DIMENSION(NWORDS), INTENT(OUT) :: WORDSOUT 
105:       INTEGER:: J1,START_IND,END_IND,J2 
106:       CHARACTER(25) :: WORD 
107:       START_IND=0 
108:       END_IND=0 
109:       J1=1 
110:       J2=0 
111:       DO WHILE(J1.LE.LEN(LINE)) 
112:           IF ((START_IND.EQ.0).AND.(LINE(J1:J1).NE.' ')) THEN 
113:              START_IND=J1 
114:           ENDIF 
115:           IF (START_IND.GT.0) THEN 
116:              IF (LINE(J1:J1).EQ.' ') END_IND=J1-1 
117:              IF (J1.EQ.LEN(LINE)) END_IND=J1 
118:              IF (END_IND.GT.0) THEN 
119:                 J2=J2+1 
120:                 WORD=LINE(START_IND:END_IND) 
121:                 WORDSOUT(J2)=TRIM(WORD) 
122:                 START_IND=0 
123:                 END_IND=0 
124:              ENDIF 
125:           ENDIF 
126:           J1=J1+1 
127:       ENDDO 
128: END SUBROUTINE 
129:  
130:  


r30629/congrad.f90 2016-07-06 15:35:32.879188381 +0100 r30628/congrad.f90 2016-07-06 15:35:39.023271458 +0100
   1: !   NEB module is an implementati on of the nudged elastic band method for performing double-ended pathway searches.
   2: !   Copyright (C) 2003-2006 Semen A. Trygubenko and David J. Wales
   3: !   This file is part of NEB module. NEB module is part of OPTIM.
   4: !
  1: !   OPTIM is free software; you can redistribute it and/or modify  5: !   OPTIM is free software; you can redistribute it and/or modify
  2: !   it under the terms of the GNU General Public License as published by  6: !   it under the terms of the GNU General Public License as published by
  3: !   the Free Software Foundation; either version 2 of the License, or  7: !   the Free Software Foundation; either version 2 of the License, or
  4: !   (at your option) any later version.  8: !   (at your option) any later version.
  5: !  9: !
  6: !   OPTIM is distributed in the hope that it will be useful, 10: !   OPTIM is distributed in the hope that it will be useful,
  7: !   but WITHOUT ANY WARRANTY; without even the implied warranty of 11: !   but WITHOUT ANY WARRANTY; without even the implied warranty of
  8: !   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 12: !   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  9: !   GNU General Public License for more details. 13: !   GNU General Public License for more details.
 10: ! 14: !
 11: !   You should have received a copy of the GNU General Public License 15: !   You should have received a copy of the GNU General Public License
 12: !   along with this program; if not, write to the Free Software 16: !   along with this program; if not, write to the Free Software
 13: !   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA 17: !   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 14: ! 18: !
 15: SUBROUTINE CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS) 19: SUBROUTINE CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
 16: USE KEY, ONLY: FROZEN, FREEZE, NREPI, NREPJ, NNREPULSIVE, & 20: USE KEY, ONLY: FROZEN, FREEZE, NREPI, NREPJ, NNREPULSIVE, &
 17:   &            NCONSTRAINT, CONI, CONJ, INTCONSTRAINTDEL, CONDISTREF, INTCONSTRAINTREP, CONDISTREFLOCAL, & 21:   &            NCONSTRAINT, CONI, CONJ, INTCONSTRAINTDEL, CONDISTREF, INTCONSTRAINTREP, CONDISTREFLOCAL, &
 18:   &            CONACTIVE, INTCONSTRAINREPCUT, NREPCUT,INTIMAGE, KINT, IMSEPMAX, ATOMACTIVE, & 22:   &            CONACTIVE, INTCONSTRAINREPCUT, NREPCUT,INTIMAGE, KINT, IMSEPMAX, ATOMACTIVE, INTMINFAC, &
 19:   &            INTFREEZET, INTFROZEN, CONCUTLOCAL, CONCUT, CONCUTABST, CONCUTABS, CONCUTFRACT, CONCUTFRAC, & 23:   &            INTFREEZET, INTFROZEN, CONCUTLOCAL, CONCUT, CONCUTABST, CONCUTABS, CONCUTFRACT, CONCUTFRAC, INTSPRINGACTIVET 
 20:   &  FREEZENODEST, INTSPRINGACTIVET, INTMINFAC 
 21: USE COMMONS, ONLY: NATOMS, NOPT, DEBUG 24: USE COMMONS, ONLY: NATOMS, NOPT, DEBUG
 22: USE PORFUNCS 25: USE PORFUNCS
 23: IMPLICIT NONE 26: IMPLICIT NONE
 24:             27:            
 25: INTEGER :: J1,J2,NI2,NI1,NJ2,NJ1,NMAXINT,NMININT,NREPINT(INTIMAGE+2),ISTAT,NINTMIN,NINTMIN2,MYUNIT 28: INTEGER :: J1,J2,NI2,NI1,NJ2,NJ1,NMAXINT,NMININT,NREPINT(INTIMAGE+2),ISTAT
 26: DOUBLE PRECISION :: ECON, EREP, ETOTAL, RMS 29: DOUBLE PRECISION :: ECON, EREP, ETOTAL, RMS
 27: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,D2,D1 30: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,D2,D1
 28: DOUBLE PRECISION G1(3),G2(3),DINT,G1INT(3),G2INT(3) 31: DOUBLE PRECISION G1(3),G2(3),DINT,G1INT(3),G2INT(3)
 29: DOUBLE PRECISION DUMMY, REPGRAD(3), INTCONST, D12, DSQ2, DSQ1, DSQI 32: DOUBLE PRECISION DUMMY, REPGRAD(3), INTCONST, D12, DSQ2, DSQ1, DSQI
 30: DOUBLE PRECISION CONE(INTIMAGE+2), REPE(INTIMAGE+2),MAXINT,MININT,REPEINT(INTIMAGE+2),RMSIM(INTIMAGE+2) 33: DOUBLE PRECISION CONE(INTIMAGE+2), REPE(INTIMAGE+2),MAXINT,MININT,REPEINT(INTIMAGE+2),RMSIM(INTIMAGE+2)
 31: LOGICAL NOINT 34: LOGICAL NOINT
 32: DOUBLE PRECISION XYZ((3*NATOMS)*(INTIMAGE+2)), GGG((3*NATOMS)*(INTIMAGE+2)), EEE(INTIMAGE+2), CCLOCAL 35: DOUBLE PRECISION XYZ(NOPT*(INTIMAGE+2)), GGG(NOPT*(INTIMAGE+2)), EEE(INTIMAGE+2), CCLOCAL
 33: LOGICAL IMGFREEZE(INTIMAGE) 36: LOGICAL IMGFREEZE(INTIMAGE)
 34: DOUBLE PRECISION DPLUS, ESPRING, SPGRAD(3) 37: DOUBLE PRECISION DPLUS, ESPRING, SPGRAD(3)
 35:  38: 
 36: EEE(1:INTIMAGE+2)=0.0D0 39: EEE(1:INTIMAGE+2)=0.0D0
 37: CONE(1:INTIMAGE+2)=0.0D0 40: CONE(1:INTIMAGE+2)=0.0D0
 38: REPE(1:INTIMAGE+2)=0.0D0 41: REPE(1:INTIMAGE+2)=0.0D0
 39: REPEINT(1:INTIMAGE+2)=0.0D0 42: REPEINT(1:INTIMAGE+2)=0.0D0
 40: NREPINT(1:INTIMAGE+2)=0 43: NREPINT(1:INTIMAGE+2)=0
 41: GGG(1:(3*NATOMS)*(INTIMAGE+2))=0.0D0 44: GGG(1:NOPT*(INTIMAGE+2))=0.0D0
 42: ECON=0.0D0; EREP=0.0D0 45: ECON=0.0D0; EREP=0.0D0
 43: NINTMIN=0 
 44: NINTMIN2=0 
 45: MYUNIT=6 
 46:  46: 
 47: ! 47: !
 48: !  Constraint energy and forces. 48: !  Constraint energy and forces.
 49: ! 49: !
 50: DO J2=1,NCONSTRAINT 50: DO J2=1,NCONSTRAINT
 51:    IF (.NOT.CONACTIVE(J2)) CYCLE 51:    IF (.NOT.CONACTIVE(J2)) CYCLE
 52:       CCLOCAL=CONCUTLOCAL(J2) 52:       CCLOCAL=CONCUTLOCAL(J2)
 53:       IF (CONCUTABST) CCLOCAL=CCLOCAL+CONCUTABS 53:       IF (CONCUTABST) CCLOCAL=CCLOCAL+CONCUTABS
 54:       IF (CONCUTFRACT) CCLOCAL=CCLOCAL+CONCUTFRAC*CONDISTREFLOCAL(J2) 54:       IF (CONCUTFRACT) CCLOCAL=CCLOCAL+CONCUTFRAC*CONDISTREFLOCAL(J2)
 55: ! 55: !
 56: ! For J1 we consider the line segment between image J1-1 and J1. 56: ! For J1 we consider the line segment between image J1-1 and J1.
 57: ! There are INTIMAGE+1 line segments in total, with an energy contribution 57: ! There are INTIMAGE+1 line segments in total, with an energy contribution
 58: ! and corresponding gradient terms for each.  58: ! and corresponding gradient terms for each. 
 59: ! A and B refer to atoms, 2 refers to image J1. 59: ! A and B refer to atoms, 2 refers to image J1.
 60: ! 60: !
 61: !  DO J1=2,INTIMAGE+1 61: !  DO J1=2,INTIMAGE+1
 62:    DO J1=1,INTIMAGE+2  ! checking for zero! 62:    DO J1=1,INTIMAGE+2  ! checking for zero!
 63:       NI1=(3*NATOMS)*(J1-1)+3*(CONI(J2)-1) 63:       NI1=NOPT*(J1-1)+3*(CONI(J2)-1)
 64:       NJ1=(3*NATOMS)*(J1-1)+3*(CONJ(J2)-1) 64:       NJ1=NOPT*(J1-1)+3*(CONJ(J2)-1)
 65:       R2AX=XYZ(NI1+1); R2AY=XYZ(NI1+2); R2AZ=XYZ(NI1+3) 65:       R2AX=XYZ(NI1+1); R2AY=XYZ(NI1+2); R2AZ=XYZ(NI1+3)
 66:       R2BX=XYZ(NJ1+1); R2BY=XYZ(NJ1+2); R2BZ=XYZ(NJ1+3) 66:       R2BX=XYZ(NJ1+1); R2BY=XYZ(NJ1+2); R2BZ=XYZ(NJ1+3)
 67:       D2=SQRT((R2AX-R2BX)**2+(R2AY-R2BY)**2+(R2AZ-R2BZ)**2) 67:       D2=SQRT((R2AX-R2BX)**2+(R2AY-R2BY)**2+(R2AZ-R2BZ)**2)
 68:       IF (ABS(D2-CONDISTREFLOCAL(J2)).GT.CCLOCAL) THEN  68:       IF (ABS(D2-CONDISTREFLOCAL(J2)).GT.CCLOCAL) THEN 
 69:          DUMMY=D2-CONDISTREFLOCAL(J2)   69:          DUMMY=D2-CONDISTREFLOCAL(J2)  
 70:          G2(1)=(R2AX-R2BX)/D2 70:          G2(1)=(R2AX-R2BX)/D2
 71:          G2(2)=(R2AY-R2BY)/D2 71:          G2(2)=(R2AY-R2BY)/D2
 72:          G2(3)=(R2AZ-R2BZ)/D2 72:          G2(3)=(R2AZ-R2BZ)/D2
 73:          REPGRAD(1:3)=2*INTCONSTRAINTDEL*((DUMMY/CCLOCAL)**2-1.0D0)*DUMMY*G2(1:3) 73:          REPGRAD(1:3)=2*INTCONSTRAINTDEL*((DUMMY/CCLOCAL)**2-1.0D0)*DUMMY*G2(1:3)
 74:          DUMMY=INTCONSTRAINTDEL*(DUMMY**2-CCLOCAL**2)**2/(2.0D0*CCLOCAL**2) 74:          DUMMY=INTCONSTRAINTDEL*(DUMMY**2-CCLOCAL**2)**2/(2.0D0*CCLOCAL**2)
 75:          EEE(J1)=EEE(J1)  +DUMMY 75:          EEE(J1)=EEE(J1)  +DUMMY
 76:          ECON=ECON        +DUMMY 76:          ECON=ECON        +DUMMY
 77:          CONE(J1)=CONE(J1)+DUMMY 77:          CONE(J1)=CONE(J1)+DUMMY
 78:          GGG(NI1+1:NI1+3)=GGG(NI1+1:NI1+3)+REPGRAD(1:3) 78:          GGG(NI1+1:NI1+3)=GGG(NI1+1:NI1+3)+REPGRAD(1:3)
 79:          GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)-REPGRAD(1:3) 79:          GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)-REPGRAD(1:3)
 80:       ENDIF 80:       ENDIF
 81: !     WRITE(MYUNIT,'(A,2I6,5G20.10)') 'J1,J2,D2,CONDISTREFLOCAL,CCLOCAL,EEE,CONE=',J1,J2,D2,CONDISTREFLOCAL(J2),CCLOCAL,EEE(J1),CONE(J1) 
 82:    ENDDO 81:    ENDDO
 83: ENDDO 82: ENDDO
 84:  83: 
 85: GGG(1:(3*NATOMS))=0.0D0                            ! can delete when loop range above changes 84: GGG(1:NOPT)=0.0D0                            ! can delete when loop range above changes
 86: GGG((3*NATOMS)*(INTIMAGE+1)+1:(3*NATOMS)*(INTIMAGE+2))=0.0D0 ! can delete when loop range above changes 85: GGG(NOPT*(INTIMAGE+1)+1:NOPT*(INTIMAGE+2))=0.0D0 ! can delete when loop range above changes
 87:  86: 
 88: ! INTCONST=INTCONSTRAINREPCUT**13 87: ! INTCONST=INTCONSTRAINREPCUT**13
 89:  88: 
 90: DO J2=1,NNREPULSIVE 89: DO J2=1,NNREPULSIVE
 91: !  INTCONST=NREPCUT(J2)**13 90: !  INTCONST=NREPCUT(J2)**13
 92:    INTCONST=NREPCUT(J2)**3 91:    INTCONST=NREPCUT(J2)**3
 93:    DO J1=2,INTIMAGE+2 92: !  DO J1=2,INTIMAGE+2
 94: !  DO J1=1,INTIMAGE+2 ! can change when zero energies are confirmed for end images 93:    DO J1=1,INTIMAGE+2 ! can change when zero energies are confirmed for end images
 95:       IF (FREEZENODEST) THEN 94:       NI2=NOPT*(J1-1)+3*(NREPI(J2)-1)
 96:          IF (J1.EQ.2) THEN 95:       NJ2=NOPT*(J1-1)+3*(NREPJ(J2)-1)
 97:             IF (IMGFREEZE(1)) CYCLE 
 98:          ELSE IF (J1.EQ.INTIMAGE+2) THEN 
 99:             IF (IMGFREEZE(INTIMAGE)) CYCLE 
100:          ELSE 
101:             IF (IMGFREEZE(J1-2).AND.IMGFREEZE(J1-1)) CYCLE 
102:          ENDIF 
103:       ENDIF 
104:       IF (INTFROZEN(NREPI(J2)).AND.INTFROZEN(NREPJ(J2))) THEN 
105: !        WRITE(*, '(A,I6,A,2I6)') ' congrad> ERROR *** repulsion ',J2,' between frozen atoms ',NREPI(J2),NREPJ(J2) 
106:          STOP 
107:       ENDIF 
108: !     WRITE(*,'(A,2I8,6G20.10)') 'congrad> B J1,J2,GGG(1:6)=',J1,J2,GGG(1:6) 
109:       NI2=(3*NATOMS)*(J1-1)+3*(NREPI(J2)-1) 
110:       NJ2=(3*NATOMS)*(J1-1)+3*(NREPJ(J2)-1) 
111:       R2AX=XYZ(NI2+1); R2AY=XYZ(NI2+2); R2AZ=XYZ(NI2+3) 96:       R2AX=XYZ(NI2+1); R2AY=XYZ(NI2+2); R2AZ=XYZ(NI2+3)
112:       R2BX=XYZ(NJ2+1); R2BY=XYZ(NJ2+2); R2BZ=XYZ(NJ2+3) 97:       R2BX=XYZ(NJ2+1); R2BY=XYZ(NJ2+2); R2BZ=XYZ(NJ2+3)
113:       D2=SQRT((R2AX-R2BX)**2+(R2AY-R2BY)**2+(R2AZ-R2BZ)**2) 98:       D2=SQRT((R2AX-R2BX)**2+(R2AY-R2BY)**2+(R2AZ-R2BZ)**2)
114:       IF (D2.LT.NREPCUT(J2)) THEN ! term for image J1 99:       IF (D2.LT.NREPCUT(J2)) THEN ! term for image J1
115: !        D12=D2**12100: !        D12=D2**12
116:          D12=D2**2101:          D12=D2**2
117: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*D2-13.0D0*NREPCUT(J2))/INTCONST)102: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*D2-13.0D0*NREPCUT(J2))/INTCONST)
118:          DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(2.0D0*D2-3.0D0*NREPCUT(J2))/INTCONST)103:          DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(2.0D0*D2-3.0D0*NREPCUT(J2))/INTCONST)
119:          EEE(J1)=EEE(J1)+DUMMY104:          EEE(J1)=EEE(J1)+DUMMY
120:          REPE(J1)=REPE(J1)+DUMMY105:          REPE(J1)=REPE(J1)+DUMMY
121:          EREP=EREP+DUMMY106:          EREP=EREP+DUMMY
122: !        DUMMY=-12.0D0*INTCONSTRAINTREP*(1.0D0/(D2*D12)-1.0D0/INTCONST)107: !        DUMMY=-12.0D0*INTCONSTRAINTREP*(1.0D0/(D2*D12)-1.0D0/INTCONST)
123:          DUMMY=-2.0D0*INTCONSTRAINTREP*(1.0D0/(D2*D12)-1.0D0/INTCONST)108:          DUMMY=-2.0D0*INTCONSTRAINTREP*(1.0D0/(D2*D12)-1.0D0/INTCONST)
124:          G2(1)=(R2AX-R2BX)/D2109:          G2(1)=(R2AX-R2BX)/D2
125:          G2(2)=(R2AY-R2BY)/D2110:          G2(2)=(R2AY-R2BY)/D2
126:          G2(3)=(R2AZ-R2BZ)/D2111:          G2(3)=(R2AZ-R2BZ)/D2
127:          REPGRAD(1:3)=DUMMY*G2(1:3)112:          REPGRAD(1:3)=DUMMY*G2(1:3)
128:          GGG(NI2+1:NI2+3)=GGG(NI2+1:NI2+3)+REPGRAD(1:3)113:          GGG(NI2+1:NI2+3)=GGG(NI2+1:NI2+3)+REPGRAD(1:3)
129:          GGG(NJ2+1:NJ2+3)=GGG(NJ2+1:NJ2+3)-REPGRAD(1:3)114:          GGG(NJ2+1:NJ2+3)=GGG(NJ2+1:NJ2+3)-REPGRAD(1:3)
130:       ENDIF115:       ENDIF
131: !     WRITE(MYUNIT,'(A,2I6,4G20.10)') 'J1,J2,D2,NREPCUT,EEE,REPE=',J1,J2,D2,NREPCUT(J2),EEE(J1),REPE(J1) 
132: !116: !
133: ! For internal minima we are counting edges. 117: ! For internal minima we are counting edges. 
134: ! Edge J1 is between images J1-1 and J1, starting from J1=2.118: ! Edge J1 is between images J1-1 and J1, starting from J1=2.
135: ! Energy contributions are shared evenly, except for119: ! Energy contributions are shared evenly, except for
136: ! edge 1, which is assigned to image 2, and edge INTIMAGE+1, which120: ! edge 1, which is assigned to image 2, and edge INTIMAGE+1, which
137: ! is assigned to image INTIMAGE+1. Gradients are set to zero for121: ! is assigned to image INTIMAGE+1. Gradients are set to zero for
138: ! the end images.122: ! the end images.
139: !123: !
140:       IF (J1.EQ.1) CYCLE124:       IF (J1.EQ.1) CYCLE
141:       NI1=(3*NATOMS)*(J1-2)+3*(NREPI(J2)-1)125:       NI1=NOPT*(J1-2)+3*(NREPI(J2)-1)
142:       NJ1=(3*NATOMS)*(J1-2)+3*(NREPJ(J2)-1)126:       NJ1=NOPT*(J1-2)+3*(NREPJ(J2)-1)
143:       R1AX=XYZ(NI1+1); R1AY=XYZ(NI1+2); R1AZ=XYZ(NI1+3)127:       R1AX=XYZ(NI1+1); R1AY=XYZ(NI1+2); R1AZ=XYZ(NI1+3)
144:       R1BX=XYZ(NJ1+1); R1BY=XYZ(NJ1+2); R1BZ=XYZ(NJ1+3)128:       R1BX=XYZ(NJ1+1); R1BY=XYZ(NJ1+2); R1BZ=XYZ(NJ1+3)
145: !     IF (r2ax**2+r2ay**2+r2az**2+r2bx**2+r2by**2+r2bz**2-2*(r2ax*r2bx+r2ay*r2by+r2az*r2bz).EQ.0.0D0) THEN129: !     IF (r2ax**2+r2ay**2+r2az**2+r2bx**2+r2by**2+r2bz**2-2*(r2ax*r2bx+r2ay*r2by+r2az*r2bz).EQ.0.0D0) THEN
146:       IF ((r1ax-r1bx-r2ax+r2bx)**2+(r1ay-r1by-r2ay+r2by)**2+(r1az-r1bz-r2az+r2bz)**2.LT.1.0D-10) THEN130: !        PRINT '(A,I6,A,2I6)','B repulsion number ',J2, ' between ',NREPI(J2),NREPJ(J2)
147: !        WRITE(*, '(A,I6,A,2I6)') 'B repulsion number ',J2, ' between ',NREPI(J2),NREPJ(J2)131: !        PRINT '(A,I6)','image number ',J1
148: !        WRITE(*, '(A,6F15.10)') 'R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ=',R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ132: !        PRINT '(A,6F15.10)','R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ=',R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ
149: !        WRITE(*, '(A,6F15.10)') 'R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ=',R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ133: !        PRINT '(A,6F15.10)','R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ=',R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ
150: !        WRITE(*,'(A,7I10)') 'congrad> J2,NI1,NJ1,NI2,NJ2,NREPI,NREPJ=',J2,NI1,NJ1,NI2,NJ2,NREPI(J2),NREPJ(J2)134: !     ENDIF
151: !        WRITE(*,'(A,7I10)') 'frames ',J1-1,J1135:       CALL MINMAXD2R(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, &
152:       ELSE 
153:          CALL MINMAXD2R(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, & 
154:   &                 D2,D1,DINT,DSQ2,DSQ1,DSQI,G1,G2,G1INT,G2INT,NOINT,.FALSE.,NREPCUT(J2))136:   &                 D2,D1,DINT,DSQ2,DSQ1,DSQI,G1,G2,G1INT,G2INT,NOINT,.FALSE.,NREPCUT(J2))
155:          IF (.NOT.NOINT) THEN 
156: !           WRITE(*,'(A,I6,A,I6,A,2I6,A,2G20.10)') 'congrad> internal minimum images ',J1-1,' and ',J1,' atoms: ',NREPI(J2),NREPJ(J2), & 
157: ! &                        ' distance,cutoff=',DINT,NREPCUT(J2) 
158:             NINTMIN=NINTMIN+1 
159:          ENDIF 
160:       ENDIF 
161:       IF ((.NOT.NOINT).AND.(DINT.LT.NREPCUT(J2))) THEN137:       IF ((.NOT.NOINT).AND.(DINT.LT.NREPCUT(J2))) THEN
162:          NINTMIN2=NINTMIN2+1 
163: !        D12=DSQI**6138: !        D12=DSQI**6
164:          D12=DSQI139:          D12=DSQI
165: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*DINT-13.0D0*NREPCUT(J2))/INTCONST)140: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*DINT-13.0D0*NREPCUT(J2))/INTCONST)
166:          DUMMY=INTMINFAC*INTCONSTRAINTREP*(1.0D0/D12+(2.0D0*DINT-3.0D0*NREPCUT(J2))/INTCONST)141:          DUMMY=INTMINFAC*INTCONSTRAINTREP*(1.0D0/D12+(2.0D0*DINT-3.0D0*NREPCUT(J2))/INTCONST)
167:          IF (J1.EQ.2) THEN142:          IF (J1.EQ.2) THEN
168:             EEE(J1)=EEE(J1)+DUMMY143:             EEE(J1)=EEE(J1)+DUMMY
169:             REPEINT(J1)=REPEINT(J1)+DUMMY144:             REPEINT(J1)=REPEINT(J1)+DUMMY
170:             NREPINT(J1)=NREPINT(J1)+1145:             NREPINT(J1)=NREPINT(J1)+1
171:          ELSE IF (J1.LT.INTIMAGE+2) THEN146:          ELSE IF (J1.LT.INTIMAGE+2) THEN
172:             EEE(J1)=EEE(J1)+DUMMY/2.0D0147:             EEE(J1)=EEE(J1)+DUMMY/2.0D0
202:       ENDIF177:       ENDIF
203:    ENDDO178:    ENDDO
204: ENDDO179: ENDDO
205: !180: !
206: ! Spring energy. Set EEE(J1) and ESPRING dividing up the pairwise181: ! Spring energy. Set EEE(J1) and ESPRING dividing up the pairwise
207: ! energy terms between images except for the end points.182: ! energy terms between images except for the end points.
208: !183: !
209: ESPRING=0.0D0184: ESPRING=0.0D0
210: IF (KINT.NE.0.0D0) THEN185: IF (KINT.NE.0.0D0) THEN
211:    DO J1=1,INTIMAGE+1 ! sum over edges from J1 to J1+1186:    DO J1=1,INTIMAGE+1 ! sum over edges from J1 to J1+1
212:       NI1=(3*NATOMS)*(J1-1)187:       NI1=NOPT*(J1-1)
213:       NI2=(3*NATOMS)*J1188:       NI2=NOPT*J1
214: !189: !
215: !  Edge between J1 and J1+1190: !  Edge between J1 and J1+1
216: !191: !
217:       DPLUS=0.0D0192:       DPLUS=0.0D0
 193: !
 194: !  Shouldn't we sum over active atoms only here?
 195: !
218:       DO J2=1,NATOMS196:       DO J2=1,NATOMS
219:          IF ((.NOT.INTSPRINGACTIVET).OR.ATOMACTIVE(J2)) THEN 197:          IF ((.NOT.INTSPRINGACTIVET).OR.ATOMACTIVE(J2)) THEN
220:             DPLUS=DPLUS+(XYZ(NI1+3*(J2-1)+1)-XYZ(NI2+3*(J2-1)+1))**2 &198:             DPLUS=DPLUS+(XYZ(NI1+3*(J2-1)+1)-XYZ(NI2+3*(J2-1)+1))**2 &
221:   &                    +(XYZ(NI1+3*(J2-1)+2)-XYZ(NI2+3*(J2-1)+2))**2 &199:   &                    +(XYZ(NI1+3*(J2-1)+2)-XYZ(NI2+3*(J2-1)+2))**2 &
222:   &                    +(XYZ(NI1+3*(J2-1)+3)-XYZ(NI2+3*(J2-1)+3))**2200:   &                    +(XYZ(NI1+3*(J2-1)+3)-XYZ(NI2+3*(J2-1)+3))**2
223:          ENDIF201:          ENDIF
224:       ENDDO202:       ENDDO
225:       DPLUS=SQRT(DPLUS)203:       DPLUS=SQRT(DPLUS)
226:       IF (DPLUS.GT.IMSEPMAX) THEN204:       IF (DPLUS.GT.IMSEPMAX) THEN
227: !        DUMMY=KINT*0.5D0*(DPLUS-IMSEPMAX)**2205: !        DUMMY=KINT*0.5D0*(DPLUS-IMSEPMAX)**2
228:          DUMMY=KINT*0.5D0*DPLUS**2206:          DUMMY=KINT*0.5D0*DPLUS**2
229:          ESPRING=ESPRING+DUMMY207:          ESPRING=ESPRING+DUMMY
230: !        DUMMY=KINT*(DPLUS-IMSEPMAX)/DPLUS208: !        DUMMY=KINT*(DPLUS-IMSEPMAX)/DPLUS
231:          DUMMY=KINT209:          DUMMY=KINT
232:          DO J2=1,NATOMS210:          DO J2=1,NATOMS
233:             IF ((.NOT.INTSPRINGACTIVET).OR.ATOMACTIVE(J2)) THEN 211:             IF ((.NOT.INTSPRINGACTIVET).OR.ATOMACTIVE(J2)) THEN
234:                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))212:                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))
235:                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)213:                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)
236:                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)214:                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)
237:             ENDIF215:             ENDIF
238:          ENDDO216:          ENDDO
239:       ENDIF217:       ENDIF
240:    ENDDO218:    ENDDO
241: ENDIF219: ENDIF
242: !220: !
243: ! Set gradients on frozen atoms to zero.221: ! Set gradients on frozen atoms to zero.
244: !222: !
245: IF (FREEZE) THEN223: IF (FREEZE) THEN
246:    DO J1=2,INTIMAGE+1  224:    DO J1=2,INTIMAGE+1  
247:       DO J2=1,NATOMS225:       DO J2=1,NATOMS
248:          IF (FROZEN(J2)) THEN226:          IF (FROZEN(J2)) THEN
249:             GGG((3*NATOMS)*(J1-1)+3*(J2-1)+1)=0.0D0227:             GGG(NOPT*(J1-1)+3*(J2-1)+1)=0.0D0
250:             GGG((3*NATOMS)*(J1-1)+3*(J2-1)+2)=0.0D0228:             GGG(NOPT*(J1-1)+3*(J2-1)+2)=0.0D0
251:             GGG((3*NATOMS)*(J1-1)+3*(J2-1)+3)=0.0D0229:             GGG(NOPT*(J1-1)+3*(J2-1)+3)=0.0D0
252:          ENDIF230:          ENDIF
253:       ENDDO231:       ENDDO
254:    ENDDO232:    ENDDO
255: ENDIF233: ENDIF
256: !234: !
257: ! Set gradients on locally frozen atoms to zero.235: ! Set gradients on locally frozen atoms to zero.
258: !236: !
259: IF (INTFREEZET) THEN237: IF (INTFREEZET) THEN
260:    DO J1=2,INTIMAGE+1  238:    DO J1=2,INTIMAGE+1  
261:       DO J2=1,NATOMS239:       DO J2=1,NATOMS
262:          IF (INTFROZEN(J2)) THEN240:          IF (INTFROZEN(J2)) THEN
263:             GGG((3*NATOMS)*(J1-1)+3*(J2-1)+1)=0.0D0241:             GGG(NOPT*(J1-1)+3*(J2-1)+1)=0.0D0
264:             GGG((3*NATOMS)*(J1-1)+3*(J2-1)+2)=0.0D0242:             GGG(NOPT*(J1-1)+3*(J2-1)+2)=0.0D0
265:             GGG((3*NATOMS)*(J1-1)+3*(J2-1)+3)=0.0D0243:             GGG(NOPT*(J1-1)+3*(J2-1)+3)=0.0D0
266:          ENDIF244:          ENDIF
267:       ENDDO245:       ENDDO
268:    ENDDO246:    ENDDO
269: ENDIF247: ENDIF
270: !248: !
271: ! Set gradients to zero for start and finish images.249: ! Set gradients to zero for start and finish images.
272: !250: !
273: GGG(1:(3*NATOMS))=0.0D0251: GGG(1:NOPT)=0.0D0
274: GGG((INTIMAGE+1)*(3*NATOMS)+1:(INTIMAGE+2)*(3*NATOMS))=0.0D0252: GGG((INTIMAGE+1)*NOPT+1:(INTIMAGE+2)*NOPT)=0.0D0
275: RMS=0.0D0253: RMS=0.0D0
276: DO J1=2,INTIMAGE+1254: DO J1=2,INTIMAGE+1
277:    RMSIM(J1)=0.0D0255:    RMSIM(J1)=0.0D0
278:    DO J2=1,(3*NATOMS)256:    DO J2=1,NOPT
279:       RMS=RMS+GGG((3*NATOMS)*(J1-1)+J2)**2257:       RMS=RMS+GGG(NOPT*(J1-1)+J2)**2
280:       RMSIM(J1)=RMSIM(J1)+GGG((3*NATOMS)*(J1-1)+J2)**2258:       RMSIM(J1)=RMSIM(J1)+GGG(NOPT*(J1-1)+J2)**2
281:    ENDDO259:    ENDDO
282:    RMSIM(J1)=SQRT(RMSIM(J1)/(3*NATOMS))260:    RMSIM(J1)=SQRT(RMSIM(J1)/NOPT)
283: ENDDO261: ENDDO
284: IF (INTIMAGE.NE.0) THEN262: IF (INTIMAGE.NE.0) THEN
285:    RMS=SQRT(RMS/((3*NATOMS)*INTIMAGE))263:    RMS=SQRT(RMS/(NOPT*INTIMAGE))
286: ENDIF264: ENDIF
287: !265: !
288: ! For INTIMAGE images there are INTIMAGE+2 replicas including the end points,266: ! For INTIMAGE images there are INTIMAGE+2 replicas including the end points,
289: ! and INTIMAGE+1 line segements, with associated energies stored in EEE(2:INTIMAGE+2)267: ! and INTIMAGE+1 line segements, with associated energies stored in EEE(2:INTIMAGE+2)
290: !268: !
291: ETOTAL=0.0D0269: ETOTAL=0.0D0
292: MAXINT=-1.0D100270: MAXINT=-1.0D100
293: MININT=1.0D100271: MININT=1.0D100
294: DO J1=2,INTIMAGE+1272: DO J1=2,INTIMAGE+1
295:    ETOTAL=ETOTAL+EEE(J1)273:    ETOTAL=ETOTAL+EEE(J1)
296: !  WRITE(*, '(A,I6,A,3G20.10)') ' congrad> con/rep/RMS image ',J1,' ',CONE(J1),REPE(J1),RMSIM(J1)274:    PRINT '(A,I6,A,3G20.10)',' congrad> con/rep/RMS image ',J1,' ',CONE(J1),REPE(J1),RMSIM(J1)
297:    IF (REPEINT(J1).LT.MININT) THEN275:    IF (REPEINT(J1).LT.MININT) THEN
298:       MININT=REPEINT(J1)276:       MININT=REPEINT(J1)
299:       NMININT=J1277:       NMININT=J1
300:    ENDIF278:    ENDIF
301:    IF (REPE(J1).GT.MAXINT) THEN279:    IF (REPE(J1).GT.MAXINT) THEN
302:       MAXINT=REPE(J1)280:       MAXINT=REPE(J1)
303:       NMAXINT=J1281:       NMAXINT=J1
304:    ENDIF282:    ENDIF
305: ENDDO283: ENDDO
306: IF (DEBUG) WRITE(*, '(A,G20.10,A,2I6)') 'congrad> largest  internal energy=',MAXINT,' for image ',NMAXINT284: IF (DEBUG) PRINT '(A,G20.10,A,2I6)',' congrad> largest  internal energy=',MAXINT,' for image ',NMAXINT
307: IF (DEBUG) WRITE(*, '(A,G20.10,A,2I6)') 'congrad> smallest internal energy=',MININT,' for image ',NMININT285: IF (DEBUG) PRINT '(A,G20.10,A,2I6)',' congrad> smallest internal energy=',MININT,' for image ',NMININT
308: IF (DEBUG) WRITE(*, '(A,2I6)') 'congrad> number of internal minima=',NINTMIN,NINTMIN2 
309: 286: 
310: END SUBROUTINE CONGRAD287: END SUBROUTINE CONGRAD
311: 288: 
312: SUBROUTINE MINMAXD2(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, &289: SUBROUTINE MINMAXD2(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, &
313:   &                 D2,D1,DINT,G1,G2,G1INT,G2INT,NOINT,DEBUG)290:   &                 D2,D1,DINT,G1,G2,G1INT,G2INT,NOINT,DEBUG)
314: IMPLICIT NONE291: IMPLICIT NONE
315: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,D2,D1,DINT292: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,D2,D1,DINT
316: DOUBLE PRECISION G1(3),G2(3),G1INT(3),G2INT(3)293: DOUBLE PRECISION G1(3),G2(3),G1INT(3),G2INT(3)
317: DOUBLE PRECISION DSQ2, DSQ1, DSQI, r1apr2bmr2amr1bsq, r1amr1bsq, r2amr2bsq294: DOUBLE PRECISION DSQ2, DSQ1, DSQI, r1apr2bmr2amr1bsq, r1amr1bsq, r2amr2bsq
318: DOUBLE PRECISION r1amr1bdr2amr2b, r1amr1bdr2amr2bsq, DUMMY295: DOUBLE PRECISION r1amr1bdr2amr2b, r1amr1bdr2amr2bsq, DUMMY
319: LOGICAL NOINT, DEBUG296: LOGICAL NOINT, DEBUG
320: !297: !
321: ! Squared distance between atoms A and B for theta=0 - distance in image 2298: ! Squared distance between atoms A and B for theta=0 - distance in image 2
322: !299: !
323: DSQ2=r2ax**2 + r2ay**2 + r2az**2 + r2bx**2 + r2by**2 + r2bz**2 - 2*(r2ax*r2bx + r2ay*r2by + r2az*r2bz)300: DSQ2=r2ax**2 + r2ay**2 + r2az**2 + r2bx**2 + r2by**2 + r2bz**2 - 2*(r2ax*r2bx + r2ay*r2by + r2az*r2bz)
324: !301: !
325: ! Squared distance between atoms A and B for theta=Pi/2 - distance in image 1302: ! Squared distance between atoms A and B for theta=Pi/2 - distance in image 1
326: !303: !
327: DSQ1=r1ax**2 + r1ay**2 + r1az**2 + r1bx**2 + r1by**2 + r1bz**2 - 2*(r1ax*r1bx + r1ay*r1by + r1az*r1bz)304: DSQ1=r1ax**2 + r1ay**2 + r1az**2 + r1bx**2 + r1by**2 + r1bz**2 - 2*(r1ax*r1bx + r1ay*r1by + r1az*r1bz)
328: ! WRITE(*,'(A,6F15.10)') 'R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ=',R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ305: ! PRINT '(A,6F15.10)','R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ=',R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ
329: ! WRITE(*,'(A,6F15.10)') 'R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ=',R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ306: ! PRINT '(A,6F15.10)','R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ=',R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ
330: ! WRITE(*,'(A,6F15.10)') 'DSQ2,DSQ1=',DSQ2,DSQ1 
331: !307: !
332: ! Is there an internal extremum?308: ! Is there an internal extremum?
333: !309: !
334: r1apr2bmr2amr1bsq=(r1ax-r1bx-r2ax+r2bx)**2+(r1ay-r1by-r2ay+r2by)**2+(r1az-r1bz-r2az+r2bz)**2310: r1apr2bmr2amr1bsq=(r1ax-r1bx-r2ax+r2bx)**2+(r1ay-r1by-r2ay+r2by)**2+(r1az-r1bz-r2az+r2bz)**2
335: IF (r1apr2bmr2amr1bsq.EQ.0.0D0) THEN311: IF (r1apr2bmr2amr1bsq.EQ.0.0D0) THEN
336:    DUMMY=2.0D0 ! just to skip the internal extremum part312:    DUMMY=2.0D0 ! just to skip the internal extremum part
337: ELSE313: ELSE
338:    DUMMY=((r1ax-r1bx)*(r1ax-r1bx-r2ax+r2bx)+(r1ay-r1by)*(r1ay-r1by-r2ay+r2by)+(r1az-r1bz)*(r1az-r1bz-r2az+r2bz))/r1apr2bmr2amr1bsq314:    DUMMY=((r1ax-r1bx)*(r1ax-r1bx-r2ax+r2bx)+(r1ay-r1by)*(r1ay-r1by-r2ay+r2by)+(r1az-r1bz)*(r1az-r1bz-r2az+r2bz))/r1apr2bmr2amr1bsq
339: ENDIF315: ENDIF
340: NOINT=.TRUE.316: NOINT=.TRUE.
410: ! Squared distance between atoms A and B for theta=Pi/2 - distance in image 1386: ! Squared distance between atoms A and B for theta=Pi/2 - distance in image 1
411: !387: !
412: DSQ1=r1ax**2 + r1ay**2 + r1az**2 + r1bx**2 + r1by**2 + r1bz**2 - 2*(r1ax*r1bx + r1ay*r1by + r1az*r1bz)388: DSQ1=r1ax**2 + r1ay**2 + r1az**2 + r1bx**2 + r1by**2 + r1bz**2 - 2*(r1ax*r1bx + r1ay*r1by + r1az*r1bz)
413: !389: !
414: ! Is there an internal extremum?390: ! Is there an internal extremum?
415: !391: !
416: r1apr2bmr2amr1bsq=(r1ax-r1bx-r2ax+r2bx)**2+(r1ay-r1by-r2ay+r2by)**2+(r1az-r1bz-r2az+r2bz)**2392: r1apr2bmr2amr1bsq=(r1ax-r1bx-r2ax+r2bx)**2+(r1ay-r1by-r2ay+r2by)**2+(r1az-r1bz-r2az+r2bz)**2
417: ! PRINT '(A,G20.10)','r1apr2bmr2amr1bsq=',r1apr2bmr2amr1bsq393: ! PRINT '(A,G20.10)','r1apr2bmr2amr1bsq=',r1apr2bmr2amr1bsq
418: IF (r1apr2bmr2amr1bsq.EQ.0.0D0) THEN394: IF (r1apr2bmr2amr1bsq.EQ.0.0D0) THEN
419:    DUMMY=2.0D0 ! just to skip the internal solution395:    DUMMY=2.0D0 ! just to skip the internal solution
420:    WRITE(*, '(A,G20.10)') 'r1apr2bmr2amr1bsq=',r1apr2bmr2amr1bsq396:    PRINT '(A,G20.10)','r1apr2bmr2amr1bsq=',r1apr2bmr2amr1bsq
421:    WRITE(*, '(A,3G20.10)') 'R1AX,R1AY,R1AZ=',R1AX,R1AY,R1AZ397:    PRINT '(A,3G20.10)','R1AX,R1AY,R1AZ=',R1AX,R1AY,R1AZ
422:    WRITE(*, '(A,3G20.10)') 'R2AX,R2AY,R2AZ=',R2AX,R2AY,R2AZ398:    PRINT '(A,3G20.10)','R2AX,R2AY,R2AZ=',R2AX,R2AY,R2AZ
423:    WRITE(*, '(A,3G20.10)') 'R1BX,R1BY,R1BZ=',R1BX,R1BY,R1BZ399:    PRINT '(A,3G20.10)','R1BX,R1BY,R1BZ=',R1BX,R1BY,R1BZ
424:    WRITE(*, '(A,3G20.10)') 'R2BX,R2BY,R2BZ=',R2BX,R2BY,R2BZ400:    PRINT '(A,3G20.10)','R2BX,R2BY,R2BZ=',R2BX,R2BY,R2BZ
425: ELSE401: ELSE
426:    DUMMY=((r1ax-r1bx)*(r1ax-r1bx-r2ax+r2bx)+(r1ay-r1by)*(r1ay-r1by-r2ay+r2by)+(r1az-r1bz)*(r1az-r1bz-r2az+r2bz))/r1apr2bmr2amr1bsq402:    DUMMY=((r1ax-r1bx)*(r1ax-r1bx-r2ax+r2bx)+(r1ay-r1by)*(r1ay-r1by-r2ay+r2by)+(r1az-r1bz)*(r1az-r1bz-r2az+r2bz))/r1apr2bmr2amr1bsq
427: ENDIF403: ENDIF
428: NOINT=.TRUE.404: NOINT=.TRUE.
429: IF ((DUMMY.GT.0.0D0).AND.(DUMMY.LT.1.0D0)) NOINT=.FALSE.405: IF ((DUMMY.GT.0.0D0).AND.(DUMMY.LT.1.0D0)) NOINT=.FALSE.
430: G2(1:3)=0.0D0406: G2(1:3)=0.0D0
431: G1(1:3)=0.0D0407: G1(1:3)=0.0D0
432: G1INT(1:3)=0.0D0408: G1INT(1:3)=0.0D0
433: G2INT(1:3)=0.0D0409: G2INT(1:3)=0.0D0
434: D2=SQRT(DSQ2)410: D2=SQRT(DSQ2)
465:  &    r1apr2bmr2amr1bsq*((r2ay - r2by)*r1amr1bsq + r1amr1bdr2amr2b*(-r1ay + r1by))))/DUMMY441:  &    r1apr2bmr2amr1bsq*((r2ay - r2by)*r1amr1bsq + r1amr1bdr2amr2b*(-r1ay + r1by))))/DUMMY
466:       G2INT(3)= (((r1amr1bdr2amr2bsq - r1amr1bsq*r2amr2bsq)*(r2az - r2bz - r1az + r1bz) + &442:       G2INT(3)= (((r1amr1bdr2amr2bsq - r1amr1bsq*r2amr2bsq)*(r2az - r2bz - r1az + r1bz) + &
467:  &    r1apr2bmr2amr1bsq*((r2az - r2bz)*r1amr1bsq + r1amr1bdr2amr2b*(-r1az + r1bz))))/DUMMY443:  &    r1apr2bmr2amr1bsq*((r2az - r2bz)*r1amr1bsq + r1amr1bdr2amr2b*(-r1az + r1bz))))/DUMMY
468:    ENDIF444:    ENDIF
469: ENDIF445: ENDIF
470: !446: !
471: ! Convert derivatives of distance^2 to derivative of distance.447: ! Convert derivatives of distance^2 to derivative of distance.
472: ! We have cancelled a factor of two above and below!448: ! We have cancelled a factor of two above and below!
473: !449: !
474: IF (r1apr2bmr2amr1bsq.EQ.0.0D0) THEN450: IF (r1apr2bmr2amr1bsq.EQ.0.0D0) THEN
475:    WRITE(*, '(A,3G20.10)') 'D2,D1,DINT=',D2,D1,DINT451:    PRINT '(A,3G20.10)','D2,D1,DINT=',D2,D1,DINT
476:    STOP452:    STOP
477: ENDIF453: ENDIF
478: G2(1:3)=G2(1:3)/D2454: G2(1:3)=G2(1:3)/D2
479: G1(1:3)=G1(1:3)/D1455: G1(1:3)=G1(1:3)/D1
480: IF (.NOT.NOINT) THEN456: IF (.NOT.NOINT) THEN
481: !  IF (DINT.EQ.0.0D0) THEN457: !  IF (DINT.EQ.0.0D0) THEN
482: !     PRINT '(A,G20.10)','minmaxd2r> ERROR *** DINT=',DINT458: !     PRINT '(A,G20.10)','minmaxd2r> ERROR *** DINT=',DINT
483: !     PRINT *,'original dummy=',((r1ax-r1bx)*(r1ax-r1bx-r2ax+r2bx)+ &459: !     PRINT *,'original dummy=',((r1ax-r1bx)*(r1ax-r1bx-r2ax+r2bx)+ &
484: ! &        (r1ay-r1by)*(r1ay-r1by-r2ay+r2by)+(r1az-r1bz)*(r1az-r1bz-r2az+r2bz))/r1apr2bmr2amr1bsq460: ! &        (r1ay-r1by)*(r1ay-r1by-r2ay+r2by)+(r1az-r1bz)*(r1az-r1bz-r2az+r2bz))/r1apr2bmr2amr1bsq
485: !     PRINT *,'r1amr1bdr2amr2b=',r1amr1bdr2amr2b461: !     PRINT *,'r1amr1bdr2amr2b=',r1amr1bdr2amr2b
504: 480: 
505: !481: !
506: ! This version of congrad tests for an internal minimum in the482: ! This version of congrad tests for an internal minimum in the
507: ! constraint distances as well as the repulsions.483: ! constraint distances as well as the repulsions.
508: !484: !
509: SUBROUTINE CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)485: SUBROUTINE CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
510: USE KEY, ONLY: FROZEN, FREEZE, NREPI, NREPJ, NNREPULSIVE, &486: USE KEY, ONLY: FROZEN, FREEZE, NREPI, NREPJ, NNREPULSIVE, &
511:   &            NCONSTRAINT, CONI, CONJ, INTCONSTRAINTDEL, CONDISTREF, INTCONSTRAINTREP, CONDISTREFLOCAL, &487:   &            NCONSTRAINT, CONI, CONJ, INTCONSTRAINTDEL, CONDISTREF, INTCONSTRAINTREP, CONDISTREFLOCAL, &
512:   &            CONACTIVE, INTCONSTRAINREPCUT, NREPCUT,FREEZENODEST, INTIMAGE, ATOMACTIVE, KINT, IMSEPMAX, &488:   &            CONACTIVE, INTCONSTRAINREPCUT, NREPCUT,FREEZENODEST, INTIMAGE, ATOMACTIVE, KINT, IMSEPMAX, &
513:   &            INTFREEZET, INTFROZEN, REPI, REPJ, CONCUT, CONCUTLOCAL, &489:   &            INTFREEZET, INTFROZEN, REPI, REPJ, CONCUT, CONCUTLOCAL, &
514:   &            CONCUTABS, CONCUTABST, CONCUTFRAC, CONCUTFRACT, INTMINFAC, INTSPRINGACTIVET490:   &            CONCUTABS, CONCUTABST, CONCUTFRAC, CONCUTFRACT, INTMINFAC, INTSPRINGACTIVET 
515: USE COMMONS, ONLY: NATOMS, NOPT, DEBUG491: USE COMMONS, ONLY: NATOMS, NOPT, DEBUG
516: IMPLICIT NONE492: IMPLICIT NONE
517:            493:            
518: INTEGER :: J1,J2,NI2,NI1,NJ2,NJ1,NMAXINT,NMININT,NCONINT(INTIMAGE+2),NREPINT(INTIMAGE+2)494: INTEGER :: J1,J2,NI2,NI1,NJ2,NJ1,NMAXINT,NMININT,NCONINT(INTIMAGE+2),NREPINT(INTIMAGE+2)
519: DOUBLE PRECISION :: ECON, EREP, ETOTAL, RMS495: DOUBLE PRECISION :: ECON, EREP, ETOTAL, RMS
520: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,D2,D1496: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,D2,D1
521: DOUBLE PRECISION G1(3),G2(3),DINT,G1INT(3),G2INT(3)497: DOUBLE PRECISION G1(3),G2(3),DINT,G1INT(3),G2INT(3)
522: DOUBLE PRECISION DUMMY, REPGRAD(3), INTCONST, D12, DSQ2, DSQ1, DSQI498: DOUBLE PRECISION DUMMY, REPGRAD(3), INTCONST, D12, DSQ2, DSQ1, DSQI
523: DOUBLE PRECISION CONE(INTIMAGE+2), REPE(INTIMAGE+2),MAXINT,MININT,REPEINT(INTIMAGE+2),CONEINT(INTIMAGE+2),RMSIMAGE(INTIMAGE+2)499: DOUBLE PRECISION CONE(INTIMAGE+2), REPE(INTIMAGE+2),MAXINT,MININT,REPEINT(INTIMAGE+2),CONEINT(INTIMAGE+2),RMSIMAGE(INTIMAGE+2)
524: LOGICAL NOINT, LPRINT500: LOGICAL NOINT, LPRINT
525: DOUBLE PRECISION XYZ((3*NATOMS)*(INTIMAGE+2)), GGG((3*NATOMS)*(INTIMAGE+2)), EEE(INTIMAGE+2)501: DOUBLE PRECISION XYZ(NOPT*(INTIMAGE+2)), GGG(NOPT*(INTIMAGE+2)), EEE(INTIMAGE+2)
526: LOGICAL IMGFREEZE(INTIMAGE), PRINTE502: LOGICAL IMGFREEZE(INTIMAGE), PRINTE
527: DOUBLE PRECISION DPLUS, ESPRING, SPGRAD(3), CCLOCAL503: DOUBLE PRECISION DPLUS, ESPRING, SPGRAD(3), CCLOCAL
528: 504: 
529: PRINTE=.FALSE.505: PRINTE=.FALSE.
530: 111 CONTINUE506: 111 CONTINUE
531: 507: 
532: EEE(1:INTIMAGE+2)=0.0D0508: EEE(1:INTIMAGE+2)=0.0D0
533: CONE(1:INTIMAGE+2)=0.0D0509: CONE(1:INTIMAGE+2)=0.0D0
534: REPE(1:INTIMAGE+2)=0.0D0510: REPE(1:INTIMAGE+2)=0.0D0
535: NCONINT(1:INTIMAGE+2)=0511: NCONINT(1:INTIMAGE+2)=0
536: NREPINT(1:INTIMAGE+2)=0512: NREPINT(1:INTIMAGE+2)=0
537: REPEINT(1:INTIMAGE+2)=0.0D0513: REPEINT(1:INTIMAGE+2)=0.0D0
538: CONEINT(1:INTIMAGE+2)=0.0D0514: CONEINT(1:INTIMAGE+2)=0.0D0
539: GGG(1:(3*NATOMS)*(INTIMAGE+2))=0.0D0515: GGG(1:NOPT*(INTIMAGE+2))=0.0D0
540: ECON=0.0D0; EREP=0.0D0516: ECON=0.0D0; EREP=0.0D0
541: LPRINT=.TRUE.517: LPRINT=.TRUE.
542: LPRINT=.FALSE.518: LPRINT=.FALSE.
543: !519: !
544: !  Constraint energy and forces.520: !  Constraint energy and forces.
545: !521: !
546: ! For J1 we consider the line segment between image J1-1 and J1.522: ! For J1 we consider the line segment between image J1-1 and J1.
547: ! There are INTIMAGE+1 line segments in total, with an energy contribution523: ! There are INTIMAGE+1 line segments in total, with an energy contribution
548: ! and corresponding gradient terms for each. 524: ! and corresponding gradient terms for each. 
549: ! A and B refer to atoms, 1 and 2 to images J1-1 and J1 corresponding to J1-2 and J1-1 below.525: ! A and B refer to atoms, 1 and 2 to images J1-1 and J1 corresponding to J1-2 and J1-1 below.
550: !526: !
551: ! IMGFREEZE(1:INTIMAGE) refers to the images excluding end points!527: ! IMGFREEZE(1:INTIMAGE) refers to the images excluding end points!
552: !528: !
553: DO J2=1,NCONSTRAINT529: DO J2=1,NCONSTRAINT
554:    IF (.NOT.CONACTIVE(J2)) CYCLE530:    IF (.NOT.CONACTIVE(J2)) CYCLE
555:    CCLOCAL=CONCUTLOCAL(J2)531:    CCLOCAL=CONCUTLOCAL(J2)
556:    IF (CONCUTABST) CCLOCAL=CCLOCAL+CONCUTABS532:    IF (CONCUTABST) CCLOCAL=CCLOCAL+CONCUTABS
557:    IF (CONCUTFRACT) CCLOCAL=CCLOCAL+CONCUTFRAC*CONDISTREFLOCAL(J2)533:    IF (CONCUTFRACT) CCLOCAL=CCLOCAL+CONCUTFRAC*CONDISTREFLOCAL(J2)
558: !!!!!!!!!!!!!!!!!!!!!!!!!! DEBUG534: !!!!!!!!!!!!!!!!!!!!!!!!!! DEBUG
559:    IF (INTFROZEN(CONI(J2)).AND.INTFROZEN(CONJ(J2))) THEN535: !  IF (INTFROZEN(CONI(J2)).AND.INTFROZEN(CONJ(J2))) THEN
560:       WRITE(*, '(A,I6,A,2I6)') ' congrad2> ERROR *** constraint ',J2,' between frozen atoms ',CONI(J2),CONJ(J2)536: !     PRINT '(A,I6,A,2I6)',' congrad> ERROR *** constraint ',J2,' between frozen atoms ',CONI(J2),CONJ(J2)
561:       STOP537: !     STOP
562:    ENDIF538: !  ENDIF
563: !!!!!!!!!!!!!!!!!!!!!!!!!! DEBUG539: !!!!!!!!!!!!!!!!!!!!!!!!!! DEBUG
564:    DO J1=2,INTIMAGE+2540:    DO J1=2,INTIMAGE+2
565:       IF (FREEZENODEST) THEN ! IMGFREEZE is not allocated otherwise!541:       IF (FREEZENODEST) THEN ! IMGFREEZE is not allocated otherwise!
566:          IF (J1.EQ.2) THEN542:          IF (J1.EQ.2) THEN
567:             IF (IMGFREEZE(1)) THEN543:             IF (IMGFREEZE(1)) THEN
568: !              IF (J2.EQ.1) PRINT '(A)','J1=2 and IMGFREEZE(1)=T cycle'544: !              IF (J2.EQ.1) PRINT '(A)','J1=2 and IMGFREEZE(1)=T cycle'
569:                CYCLE545:                CYCLE
570:             ENDIF546:             ENDIF
571:          ELSE IF (J1.EQ.INTIMAGE+2) THEN547:          ELSE IF (J1.EQ.INTIMAGE+2) THEN
572:             IF (IMGFREEZE(INTIMAGE)) THEN548:             IF (IMGFREEZE(INTIMAGE)) THEN
573: !              IF (J2.EQ.1) PRINT '(A)','J1=INTIMAGE+2 and IMGFREEZE(INTIMAGE)=T cycle'549: !              IF (J2.EQ.1) PRINT '(A)','J1=INTIMAGE+2 and IMGFREEZE(INTIMAGE)=T cycle'
574:                CYCLE550:                CYCLE
575:             ENDIF551:             ENDIF
576:          ELSE552:          ELSE
577:             IF (IMGFREEZE(J1-2).AND.IMGFREEZE(J1-1)) THEN553:             IF (IMGFREEZE(J1-2).AND.IMGFREEZE(J1-1)) THEN
578: !              IF (J2.EQ.1) PRINT '(A,I6,A)','J1=',J1,' IMGFREEZE(J1-2)=T and IMGFREEZE(J1-1)=T cycle'554: !              IF (J2.EQ.1) PRINT '(A,I6,A)','J1=',J1,' IMGFREEZE(J1-2)=T and IMGFREEZE(J1-1)=T cycle'
579:                CYCLE555:                CYCLE
580:             ENDIF556:             ENDIF
581:          ENDIF557:          ENDIF
582:       ENDIF558:       ENDIF
583:       NI1=(3*NATOMS)*(J1-2)+3*(CONI(J2)-1)559:       NI1=NOPT*(J1-2)+3*(CONI(J2)-1)
584:       NI2=(3*NATOMS)*(J1-1)+3*(CONI(J2)-1)560:       NI2=NOPT*(J1-1)+3*(CONI(J2)-1)
585:       NJ1=(3*NATOMS)*(J1-2)+3*(CONJ(J2)-1)561:       NJ1=NOPT*(J1-2)+3*(CONJ(J2)-1)
586:       NJ2=(3*NATOMS)*(J1-1)+3*(CONJ(J2)-1)562:       NJ2=NOPT*(J1-1)+3*(CONJ(J2)-1)
587:       R1AX=XYZ(NI1+1); R1AY=XYZ(NI1+2); R1AZ=XYZ(NI1+3)563:       R1AX=XYZ(NI1+1); R1AY=XYZ(NI1+2); R1AZ=XYZ(NI1+3)
588:       R1BX=XYZ(NJ1+1); R1BY=XYZ(NJ1+2); R1BZ=XYZ(NJ1+3)564:       R1BX=XYZ(NJ1+1); R1BY=XYZ(NJ1+2); R1BZ=XYZ(NJ1+3)
589:       R2AX=XYZ(NI2+1); R2AY=XYZ(NI2+2); R2AZ=XYZ(NI2+3)565:       R2AX=XYZ(NI2+1); R2AY=XYZ(NI2+2); R2AZ=XYZ(NI2+3)
590:       R2BX=XYZ(NJ2+1); R2BY=XYZ(NJ2+2); R2BZ=XYZ(NJ2+3)566:       R2BX=XYZ(NJ2+1); R2BY=XYZ(NJ2+2); R2BZ=XYZ(NJ2+3)
591:       CALL MINMAXD2(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, &567:       CALL MINMAXD2(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, &
592:   &                 D2,D1,DINT,G1,G2,G1INT,G2INT,NOINT,.FALSE.)568:   &                 D2,D1,DINT,G1,G2,G1INT,G2INT,NOINT,.FALSE.)
593: !569: !
594: ! Need to include both D2 and D1 contributions if they are both outside tolerance.570: ! Need to include both D2 and D1 contributions if they are both outside tolerance.
595: ! Otherwise we get discontinuities if they are very close and swap over.571: ! Otherwise we get discontinuities if they are very close and swap over.
596: !572: !
597: !     CONCUT=CONCUTFRAC*CONDISTREF(J2)573: !     CONCUT=CONCUTFRAC*CONDISTREF(J2)
598: !574: !
599: ! terms for image J1 - non-zero derivatives only for J1. D2 is the distance for image J1.575: ! terms for image J1 - non-zero derivatives only for J1. D2 is the distance for image J1.
600: !576: !
601:       IF (LPRINT) WRITE(*, '(A,I6,5G15.5)') &577:       IF (LPRINT) PRINT '(A,I6,5G15.5)', &
602:   &       'J1,D2,D1,DINT,MIN diff,CONCUT=',J1,D2,D1,DINT,ABS(D2-CONDISTREFLOCAL(J2)),CCLOCAL578:   &       'J1,D2,D1,DINT,MIN diff,CONCUT=',J1,D2,D1,DINT,ABS(D2-CONDISTREFLOCAL(J2)),CCLOCAL
603:       IF ((ABS(D2-CONDISTREFLOCAL(J2)).GT.CCLOCAL).AND.(J1.LT.INTIMAGE+2)) THEN 579:       IF ((ABS(D2-CONDISTREFLOCAL(J2)).GT.CCLOCAL).AND.(J1.LT.INTIMAGE+2)) THEN 
604:          DUMMY=D2-CONDISTREFLOCAL(J2)  580:          DUMMY=D2-CONDISTREFLOCAL(J2)  
605:          REPGRAD(1:3)=2*INTCONSTRAINTDEL*((DUMMY/CCLOCAL)**2-1.0D0)*DUMMY*G2(1:3)581:          REPGRAD(1:3)=2*INTCONSTRAINTDEL*((DUMMY/CCLOCAL)**2-1.0D0)*DUMMY*G2(1:3)
606:          DUMMY=INTCONSTRAINTDEL*(DUMMY**2-CCLOCAL**2)**2/(2.0D0*CCLOCAL**2)582:          DUMMY=INTCONSTRAINTDEL*(DUMMY**2-CCLOCAL**2)**2/(2.0D0*CCLOCAL**2)
607:          EEE(J1)=EEE(J1)+DUMMY583:          EEE(J1)=EEE(J1)+DUMMY
608:          CONE(J1)=CONE(J1)+DUMMY584:          CONE(J1)=CONE(J1)+DUMMY
609:          ECON=ECON      +DUMMY585:          ECON=ECON      +DUMMY
610:          IF (LPRINT) WRITE(*, '(A,4I6,G15.5)') 'min J1,J2,CONI,CONJ,REPGRAD=',J1,J2,CONI(J2),CONJ(J2), &586:          IF (LPRINT) PRINT '(A,4I6,G15.5)','min J1,J2,CONI,CONJ,REPGRAD=',J1,J2,CONI(J2),CONJ(J2), &
611:   &                              SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2)587:   &                              SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2)
612:          GGG(NI2+1:NI2+3)=GGG(NI2+1:NI2+3)+REPGRAD(1:3)588:          GGG(NI2+1:NI2+3)=GGG(NI2+1:NI2+3)+REPGRAD(1:3)
613:          GGG(NJ2+1:NJ2+3)=GGG(NJ2+1:NJ2+3)-REPGRAD(1:3)589:          GGG(NJ2+1:NJ2+3)=GGG(NJ2+1:NJ2+3)-REPGRAD(1:3)
614:       ENDIF590:       ENDIF
615: !591: !
616: ! Don't add energy contributions to EEE(2) from D1, since the gradients are non-zero only for image 1.592: ! Don't add energy contributions to EEE(2) from D1, since the gradients are non-zero only for image 1.
617: !593: !
618: ! terms for image J1-1 - non-zero derivatives only for J1-1. D1 is the distance for image J1-1.594: ! terms for image J1-1 - non-zero derivatives only for J1-1. D1 is the distance for image J1-1.
619: !595: !
620: !     IF (LPRINT) WRITE(*, '(A,I6,5G15.5)') &596:       IF (LPRINT) PRINT '(A,I6,5G15.5)', &
621: ! &       'J1,D2,D1,DINT,MAX diff,CCLOCAL=',J1,D2,D1,DINT,ABS(D1-CONDISTREFLOCAL(J2)),CCLOCAL597:   &       'J1,D2,D1,DINT,MAX diff,CCLOCAL=',J1,D2,D1,DINT,ABS(D1-CONDISTREFLOCAL(J2)),CCLOCAL
622:       IF ((ABS(D1-CONDISTREFLOCAL(J2)).GT.CCLOCAL).AND.(J1.GT.2)) THEN  598:       IF ((ABS(D1-CONDISTREFLOCAL(J2)).GT.CCLOCAL).AND.(J1.GT.2)) THEN  
623:          DUMMY=D1-CONDISTREFLOCAL(J2)  599:          DUMMY=D1-CONDISTREFLOCAL(J2)  
624:          REPGRAD(1:3)=2*INTCONSTRAINTDEL*((DUMMY/CCLOCAL)**2-1.0D0)*DUMMY*G1(1:3)600:          REPGRAD(1:3)=2*INTCONSTRAINTDEL*((DUMMY/CCLOCAL)**2-1.0D0)*DUMMY*G1(1:3)
625:          DUMMY=INTCONSTRAINTDEL*(DUMMY**2-CCLOCAL**2)**2/(2.0D0*CCLOCAL**2)601:          DUMMY=INTCONSTRAINTDEL*(DUMMY**2-CCLOCAL**2)**2/(2.0D0*CCLOCAL**2)
626:          IF (PRINTE.AND.(DUMMY.GT.1.0D-4)) THEN602:          IF (PRINTE.AND.(DUMMY.GT.1.0D-4)) THEN
627:             WRITE(*, '(A,2I6,2L5,G20.10)') 'A CONI,CONJ,INTFROZEN(CONI),INTFROZEN(CONJ),DUMMY=', &603:             PRINT '(A,2I6,2L5,G20.10)','A CONI,CONJ,INTFROZEN(CONI),INTFROZEN(CONJ),DUMMY=', &
628:   &                                       CONI(J2),CONJ(J2),INTFROZEN(CONI(J2)),INTFROZEN(CONJ(J2)),DUMMY604:   &                                       CONI(J2),CONJ(J2),INTFROZEN(CONI(J2)),INTFROZEN(CONJ(J2)),DUMMY
629:          ENDIF605:          ENDIF
630:          EEE(J1-1)=EEE(J1-1)+DUMMY606:          EEE(J1-1)=EEE(J1-1)+DUMMY
631:          CONE(J1-1)=CONE(J1-1)+DUMMY607:          CONE(J1-1)=CONE(J1-1)+DUMMY
632:          ECON=ECON      +DUMMY608:          ECON=ECON      +DUMMY
633:          IF (LPRINT) WRITE(*, '(A,4I6,G15.5)') 'max J1,J2,CONI,CONJ,REPGRAD=',J1,J2,CONI(J2),CONJ(J2), &609:          IF (LPRINT) PRINT '(A,4I6,G15.5)','max J1,J2,CONI,CONJ,REPGRAD=',J1,J2,CONI(J2),CONJ(J2), &
634:   &         SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2)610:   &         SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2)
635:          GGG(NI1+1:NI1+3)=GGG(NI1+1:NI1+3)+REPGRAD(1:3)611:          GGG(NI1+1:NI1+3)=GGG(NI1+1:NI1+3)+REPGRAD(1:3)
636:          GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)-REPGRAD(1:3)612:          GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)-REPGRAD(1:3)
637:       ENDIF613:       ENDIF
638:       IF ((.NOT.NOINT).AND.(ABS(DINT-CONDISTREFLOCAL(J2)).GT.CCLOCAL)) THEN614:       IF ((.NOT.NOINT).AND.(ABS(DINT-CONDISTREFLOCAL(J2)).GT.CCLOCAL)) THEN
639:          DUMMY=DINT-CONDISTREFLOCAL(J2)  615:          DUMMY=DINT-CONDISTREFLOCAL(J2)  
640:          REPGRAD(1:3)=2*INTMINFAC*INTCONSTRAINTDEL*((DUMMY/CCLOCAL)**2-1.0D0)*DUMMY*G1INT(1:3)616:          REPGRAD(1:3)=2*INTMINFAC*INTCONSTRAINTDEL*((DUMMY/CCLOCAL)**2-1.0D0)*DUMMY*G1INT(1:3)
641:          GGG(NI1+1:NI1+3)=GGG(NI1+1:NI1+3)+REPGRAD(1:3)617:          GGG(NI1+1:NI1+3)=GGG(NI1+1:NI1+3)+REPGRAD(1:3)
642:          GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)-REPGRAD(1:3)618:          GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)-REPGRAD(1:3)
643:          REPGRAD(1:3)=2*INTMINFAC*INTCONSTRAINTDEL*((DUMMY/CCLOCAL)**2-1.0D0)*DUMMY*G2INT(1:3)619:          REPGRAD(1:3)=2*INTMINFAC*INTCONSTRAINTDEL*((DUMMY/CCLOCAL)**2-1.0D0)*DUMMY*G2INT(1:3)
644:          DUMMY=INTMINFAC*INTCONSTRAINTDEL*(DUMMY**2-CCLOCAL**2)**2/(2.0D0*CCLOCAL**2)620:          DUMMY=INTMINFAC*INTCONSTRAINTDEL*(DUMMY**2-CCLOCAL**2)**2/(2.0D0*CCLOCAL**2)
645:          IF (PRINTE.AND.(DUMMY.GT.1.0D-4)) THEN621:          IF (PRINTE.AND.(DUMMY.GT.1.0D-4)) THEN
646:             WRITE(*, '(A,2I6,2L5,G20.10)') 'B CONI,CONJ,INTFROZEN(CONI),INTFROZEN(CONJ),DUMMY=', &622: !           PRINT '(A,2I6,2L5,G20.10)','B CONI,CONJ,INTFROZEN(CONI),INTFROZEN(CONJ),DUMMY=', &
647:   &                                       CONI(J2),CONJ(J2),INTFROZEN(CONI(J2)),INTFROZEN(CONJ(J2)),DUMMY623: ! &                                       CONI(J2),CONJ(J2),INTFROZEN(CONI(J2)),INTFROZEN(CONJ(J2)),DUMMY
648:          ENDIF624:          ENDIF
649:          ECON=ECON+DUMMY625:          ECON=ECON+DUMMY
650:          IF (J1.EQ.2) THEN626:          IF (J1.EQ.2) THEN
651:             EEE(J1)=EEE(J1)+DUMMY627:             EEE(J1)=EEE(J1)+DUMMY
652:             CONEINT(J1)=CONEINT(J1)+DUMMY628:             CONEINT(J1)=CONEINT(J1)+DUMMY
653:             NCONINT(J1)=NCONINT(J1)+1629:             NCONINT(J1)=NCONINT(J1)+1
654:          ELSE IF (J1.LT.INTIMAGE+2) THEN630:          ELSE IF (J1.LT.INTIMAGE+2) THEN
655:             EEE(J1)=EEE(J1)+DUMMY/2.0D0631:             EEE(J1)=EEE(J1)+DUMMY/2.0D0
656:             EEE(J1-1)=EEE(J1-1)+DUMMY/2.0D0632:             EEE(J1-1)=EEE(J1-1)+DUMMY/2.0D0
657:             CONEINT(J1)=CONEINT(J1)+DUMMY/2.0D0633:             CONEINT(J1)=CONEINT(J1)+DUMMY/2.0D0
658:             CONEINT(J1-1)=CONEINT(J1-1)+DUMMY/2.0D0634:             CONEINT(J1-1)=CONEINT(J1-1)+DUMMY/2.0D0
659:             NCONINT(J1)=NCONINT(J1)+1635:             NCONINT(J1)=NCONINT(J1)+1
660:             NCONINT(J1-1)=NCONINT(J1-1)+1636:             NCONINT(J1-1)=NCONINT(J1-1)+1
661:          ELSE IF (J1.EQ.INTIMAGE+2) THEN637:          ELSE IF (J1.EQ.INTIMAGE+2) THEN
662:             EEE(J1-1)=EEE(J1-1)+DUMMY638:             EEE(J1-1)=EEE(J1-1)+DUMMY
663:             CONEINT(J1-1)=CONEINT(J1-1)+DUMMY639:             CONEINT(J1-1)=CONEINT(J1-1)+DUMMY
664:             NCONINT(J1-1)=NCONINT(J1-1)+1640:             NCONINT(J1-1)=NCONINT(J1-1)+1
665:          ENDIF641:          ENDIF
666: !        WRITE(*, '(A,4I6,G15.5)') 'in2 J1,J2,CONI,CONJ,REPGRAD=',J1,J2,CONI(J2),CONJ(J2), &642: !        PRINT '(A,4I6,G15.5)','in2 J1,J2,CONI,CONJ,REPGRAD=',J1,J2,CONI(J2),CONJ(J2), &
667: ! &                              SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2)643: ! &                              SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2)
668:          GGG(NI2+1:NI2+3)=GGG(NI2+1:NI2+3)+REPGRAD(1:3)644:          GGG(NI2+1:NI2+3)=GGG(NI2+1:NI2+3)+REPGRAD(1:3)
669:          GGG(NJ2+1:NJ2+3)=GGG(NJ2+1:NJ2+3)-REPGRAD(1:3)645:          GGG(NJ2+1:NJ2+3)=GGG(NJ2+1:NJ2+3)-REPGRAD(1:3)
670:       ENDIF646:       ENDIF
671:    ENDDO647:    ENDDO
672: ENDDO648: ENDDO
673: 649: 
674: ! INTCONST=INTCONSTRAINREPCUT**13650: ! INTCONST=INTCONSTRAINREPCUT**13
 651: GGG(1:(3*NATOMS))=0.0D0                            ! can delete when loop range above changes
 652: GGG((3*NATOMS)*(INTIMAGE+1)+1:(3*NATOMS)*(INTIMAGE+2))=0.0D0 ! can delete when loop range above changes
675: 653: 
676: DO J2=1,NNREPULSIVE654: DO J2=1,NNREPULSIVE
677: !  INTCONST=NREPCUT(J2)**13655: !  INTCONST=NREPCUT(J2)**13
678:    INTCONST=NREPCUT(J2)**3656:    INTCONST=NREPCUT(J2)**3
679:    DO J1=2,INTIMAGE+2657:    DO J1=2,INTIMAGE+2
680:       IF (FREEZENODEST) THEN658:       If (FREEZENODEST) THEN
681:          IF (J1.EQ.2) THEN659:          IF (J1.EQ.2) THEN
682:             IF (IMGFREEZE(1)) CYCLE660:             IF (IMGFREEZE(1)) CYCLE
683:          ELSE IF (J1.EQ.INTIMAGE+2) THEN661:          ELSE IF (J1.EQ.INTIMAGE+2) THEN
684:             IF (IMGFREEZE(INTIMAGE)) CYCLE662:             IF (IMGFREEZE(INTIMAGE)) CYCLE
685:          ELSE663:          ELSE
686:             IF (IMGFREEZE(J1-2).AND.IMGFREEZE(J1-1)) CYCLE664:             IF (IMGFREEZE(J1-2).AND.IMGFREEZE(J1-1)) CYCLE
687:          ENDIF665:          ENDIF
688:       ENDIF666:       ENDIF
689:       IF (INTFROZEN(NREPI(J2)).AND.INTFROZEN(NREPJ(J2))) THEN667: !  IF (INTFROZEN(NREPI(J2)).AND.INTFROZEN(NREPJ(J2))) THEN
690:          WRITE(*, '(A,I6,A,2I6)') ' congrad2> ERROR *** repulsion ',J2,' between frozen atoms ',NREPI(J2),NREPJ(J2)668: !     PRINT '(A,I6,A,2I6)',' congrad> ERROR *** repulsion ',J2,' between frozen atoms ',NREPI(J2),NREPJ(J2)
691:          STOP669: !     STOP
692:       ENDIF670: !  ENDIF
693: !     WRITE(*,'(A,2I8,6G20.10)') 'congrad2> B J1,J2,GGG(1:6)=',J1,J2,GGG(1:6)671:       NI1=NOPT*(J1-2)+3*(NREPI(J2)-1)
694:       NI1=(3*NATOMS)*(J1-2)+3*(NREPI(J2)-1)672:       NI2=NOPT*(J1-1)+3*(NREPI(J2)-1)
695:       NI2=(3*NATOMS)*(J1-1)+3*(NREPI(J2)-1)673:       NJ1=NOPT*(J1-2)+3*(NREPJ(J2)-1)
696:       NJ1=(3*NATOMS)*(J1-2)+3*(NREPJ(J2)-1)674:       NJ2=NOPT*(J1-1)+3*(NREPJ(J2)-1)
697:       NJ2=(3*NATOMS)*(J1-1)+3*(NREPJ(J2)-1) 
698:       R1AX=XYZ(NI1+1); R1AY=XYZ(NI1+2); R1AZ=XYZ(NI1+3)675:       R1AX=XYZ(NI1+1); R1AY=XYZ(NI1+2); R1AZ=XYZ(NI1+3)
699:       R1BX=XYZ(NJ1+1); R1BY=XYZ(NJ1+2); R1BZ=XYZ(NJ1+3)676:       R1BX=XYZ(NJ1+1); R1BY=XYZ(NJ1+2); R1BZ=XYZ(NJ1+3)
700:       R2AX=XYZ(NI2+1); R2AY=XYZ(NI2+2); R2AZ=XYZ(NI2+3)677:       R2AX=XYZ(NI2+1); R2AY=XYZ(NI2+2); R2AZ=XYZ(NI2+3)
701:       R2BX=XYZ(NJ2+1); R2BY=XYZ(NJ2+2); R2BZ=XYZ(NJ2+3)678:       R2BX=XYZ(NJ2+1); R2BY=XYZ(NJ2+2); R2BZ=XYZ(NJ2+3)
702: !     IF (r2ax**2+r2ay**2+r2az**2+r2bx**2+r2by**2+r2bz**2-2*(r2ax*r2bx+r2ay*r2by+r2az*r2bz).EQ.0.0D0) THEN679:       IF (r2ax**2+r2ay**2+r2az**2+r2bx**2+r2by**2+r2bz**2-2*(r2ax*r2bx+r2ay*r2by+r2az*r2bz).EQ.0.0D0) THEN
703:       IF ((r1ax-r1bx-r2ax+r2bx)**2+(r1ay-r1by-r2ay+r2by)**2+(r1az-r1bz-r2az+r2bz)**2.LT.1.0D-50) THEN680: !        PRINT '(A,I6,A,2I6)','A repulsion number ',J2, ' between ',NREPI(J2),NREPJ(J2)
704: !        WRITE(*, '(A,I6,A,2I6)') 'A repulsion number ',J2, ' between ',NREPI(J2),NREPJ(J2)681: !        PRINT '(A,I6)','image number ',J1
705: !        WRITE(*, '(A,6F15.10)') 'R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ=',R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ682: !        PRINT '(A,6F15.10)','R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ=',R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ
706: !        WRITE(*, '(A,6F15.10)') 'R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ=',R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ683: !        PRINT '(A,6F15.10)','R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ=',R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ
707: !        WRITE(*,'(A,7I10)') 'congrad2> J2,NI1,NJ1,NI2,NJ2,NREPI,NREPJ=',J2,NI1,NJ1,NI2,NJ2,NREPI(J2),NREPJ(J2)684:       ENDIF
708: !        WRITE(*,'(A,7I10)') 'frames ',J1-1,J1685:       CALL MINMAXD2R(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, &
709:          D1=1.0D100; D2=1.0D100; NOINT=.TRUE.  ! to skip the next blocks686:   &                 D2,D1,DINT,DSQ2,DSQ1,DSQI,G1,G2,G1INT,G2INT,NOINT,.FALSE.,NREPCUT(J2))
710:       ELSE687:       IF ((NREPI(J2).EQ.34).AND.(NREPJ(J2).EQ.400)) THEN
711:          CALL MINMAXD2R(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, &688: !        PRINT '(A,3G20.10)',' congrad2> R1AX,R1AY,R1AZ=',R1AX,R1AY,R1AZ
712:   &                    D2,D1,DINT,DSQ2,DSQ1,DSQI,G1,G2,G1INT,G2INT,NOINT,.FALSE.,NREPCUT(J2))689: !        PRINT '(A,3G20.10)',' congrad2> R1BX,R1BY,R1BZ=',R1BX,R1BY,R1BZ
 690: !        PRINT '(A,3G20.10)',' congrad2> R2AX,R2AY,R2AZ=',R2AX,R2AY,R2AZ
 691: !        PRINT '(A,3G20.10)',' congrad2> R2BX,R2BY,R2BZ=',R2BX,R2BY,R2BZ
 692: !        PRINT '(A,I6,A,2I6)',' congrad2> J1=',J1,' edge between images: ',J1-1,J1
 693: !        PRINT '(A,L5,3G20.10)',' congrad2> NOINT,D2,D1,DINT=',NOINT,D2,D1,DINT
713:       ENDIF694:       ENDIF
 695:       DUMMY=0.0D0 
714: !696: !
715: ! Skip image INTIMAGE+2 - no non-zero gradients on other images and no energy contributions.697: ! Skip image INTIMAGE+2 - no non-zero gradients on other images and no energy contributions.
716: !698: !
717: !     IF ((D2.LT.INTCONSTRAINREPCUT).AND.(J1.LT.INTIMAGE+2)) THEN ! terms for image J1 - non-zero derivatives only for J1699: !     IF ((D2.LT.INTCONSTRAINREPCUT).AND.(J1.LT.INTIMAGE+2)) THEN ! terms for image J1 - non-zero derivatives only for J1
718:       IF ((D2.LT.NREPCUT(J2)).AND.(J1.LT.INTIMAGE+2)) THEN ! terms for image J1 - non-zero derivatives only for J1700:       IF ((D2.LT.NREPCUT(J2)).AND.(J1.LT.INTIMAGE+2)) THEN ! terms for image J1 - non-zero derivatives only for J1
719: !        D12=DSQ2**6701: !        D12=DSQ2**6
720:          D12=DSQ2702:          D12=DSQ2
721: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*D2-13.0D0*INTCONSTRAINREPCUT)/INTCONST)703: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*D2-13.0D0*INTCONSTRAINREPCUT)/INTCONST)
722: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*D2-13.0D0*NREPCUT(J2))/INTCONST)704: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*D2-13.0D0*NREPCUT(J2))/INTCONST)
723:          DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(2.0D0*D2-3.0D0*NREPCUT(J2))/INTCONST)705:          DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(2.0D0*D2-3.0D0*NREPCUT(J2))/INTCONST)
724: !        IF ((NREPJ(J2).EQ.83).AND.(NREPI(J2).EQ.357)) WRITE(*, '(A,6G20.10)') &706: !        WRITE(*, '(A,5G20.10)') 'INTCONSTRAINTREP,D12,D2,NREPCUT,INTCONST=',INTCONSTRAINTREP,D12,D2,NREPCUT(J2),INTCONST
725: ! &               'INTCONSTRAINTREP,D12,D2,NREPCUT,INTCONST,DUMMY=',INTCONSTRAINTREP,D12,D2,NREPCUT(J2),INTCONST ,DUMMY  
726: !        IF ((NREPI(J2).EQ.83).AND.(NREPJ(J2).EQ.357)) WRITE(*, '(A,6G20.10)') & 
727: ! &               'INTCONSTRAINTREP,D12,D2,NREPCUT,INTCONST,DUMMY=',INTCONSTRAINTREP,D12,D2,NREPCUT(J2),INTCONST ,DUMMY  
728:          EEE(J1)=EEE(J1)+DUMMY707:          EEE(J1)=EEE(J1)+DUMMY
729:          IF (PRINTE.AND.(DUMMY.GT.1.0D-4)) THEN708:          IF (PRINTE.AND.(DUMMY.GT.1.0D-4)) THEN
730:             WRITE(*, '(A,2I6,2L5,G20.10)') 'R1 NREPI,NREPJ,INTFROZEN(NREPI),INTFROZEN(NREPJ),DUMMY=', &709:             PRINT '(A,2I6,2L5,G20.10)','R1 NREPI,NREPJ,INTFROZEN(NREPI),INTFROZEN(NREPJ),DUMMY=', &
731:   &                                     NREPI(J2),NREPJ(J2),INTFROZEN(NREPI(J2)),INTFROZEN(NREPJ(J2)),DUMMY710:   &                                     NREPI(J2),NREPJ(J2),INTFROZEN(NREPI(J2)),INTFROZEN(NREPJ(J2)),DUMMY
732:          ENDIF711:          ENDIF
733:          REPE(J1)=REPE(J1)+DUMMY712:          REPE(J1)=REPE(J1)+DUMMY
734:          EREP=EREP+DUMMY713:          EREP=EREP+DUMMY
735: !        DUMMY=-12.0D0*INTCONSTRAINTREP*(1.0D0/(D2*D12)-1.0D0/INTCONST)714: !        DUMMY=-12.0D0*INTCONSTRAINTREP*(1.0D0/(D2*D12)-1.0D0/INTCONST)
736:          DUMMY=-2.0D0*INTCONSTRAINTREP*(1.0D0/(D2*D12)-1.0D0/INTCONST)715:          DUMMY=-2.0D0*INTCONSTRAINTREP*(1.0D0/(D2*D12)-1.0D0/INTCONST)
737:          REPGRAD(1:3)=DUMMY*G2(1:3)716:          REPGRAD(1:3)=DUMMY*G2(1:3)
738: !        WRITE(*, '(A,4I6,G15.5)') 'min J1,J2,REPI,REPJ,REPGRAD=',J1,J2,NREPI(J2),NREPJ(J2), &717: !        PRINT '(A,4I6,G15.5)','min J1,J2,REPI,REPJ,REPGRAD=',J1,J2,NREPI(J2),NREPJ(J2), &
739: ! &                              SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2)718: ! &                              SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2)
740:          GGG(NI2+1:NI2+3)=GGG(NI2+1:NI2+3)+REPGRAD(1:3)719:          GGG(NI2+1:NI2+3)=GGG(NI2+1:NI2+3)+REPGRAD(1:3)
741:          GGG(NJ2+1:NJ2+3)=GGG(NJ2+1:NJ2+3)-REPGRAD(1:3)720:          GGG(NJ2+1:NJ2+3)=GGG(NJ2+1:NJ2+3)-REPGRAD(1:3)
742:       ENDIF721:       ENDIF
743:       DUMMY=0.0D0722:       DUMMY=0.0D0
744: !723: !
745: ! Don't add energy contributions to EEE(2) from D1, since the gradients are non-zero only for image 1.724: ! Don't add energy contributions to EEE(2) from D1, since the gradients are non-zero only for image 1.
746: !725: !
747: !     IF ((D1.LT.INTCONSTRAINREPCUT).AND.(J1.GT.2)) THEN ! terms for image J1-1 - non-zero derivatives only for J1-1726: !     IF ((D1.LT.INTCONSTRAINREPCUT).AND.(J1.GT.2)) THEN ! terms for image J1-1 - non-zero derivatives only for J1-1
748:       IF ((D1.LT.NREPCUT(J2)).AND.(J1.GT.2)) THEN ! terms for image J1-1 - non-zero derivatives only for J1-1727:       IF ((D1.LT.NREPCUT(J2)).AND.(J1.GT.2)) THEN ! terms for image J1-1 - non-zero derivatives only for J1-1
749: !        D12=DSQ1**6728: !        D12=DSQ1**6
750:          D12=DSQ1729:          D12=DSQ1
751: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*D1-13.0D0*INTCONSTRAINREPCUT)/INTCONST)730: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*D1-13.0D0*INTCONSTRAINREPCUT)/INTCONST)
752: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*D1-13.0D0*NREPCUT(J2))/INTCONST)731: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*D1-13.0D0*NREPCUT(J2))/INTCONST)
753:          DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(2.0D0*D1-3.0D0*NREPCUT(J2))/INTCONST)732:          DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(2.0D0*D1-3.0D0*NREPCUT(J2))/INTCONST)
754:          EEE(J1-1)=EEE(J1-1)+DUMMY733:          EEE(J1-1)=EEE(J1-1)+DUMMY
755:          IF (PRINTE.AND.(DUMMY.GT.1.0D-4)) THEN734:          IF (PRINTE.AND.(DUMMY.GT.1.0D-4)) THEN
756:             WRITE(*, '(A,2I6,2L5,G20.10)') 'R2 NREPI,NREPJ,INTFROZEN(NREPI),INTFROZEN(NREPJ),DUMMY=', &735:             PRINT '(A,2I6,2L5,G20.10)','R2 NREPI,NREPJ,INTFROZEN(NREPI),INTFROZEN(NREPJ),DUMMY=', &
757:   &                                     NREPI(J2),NREPJ(J2),INTFROZEN(NREPI(J2)),INTFROZEN(NREPJ(J2)),DUMMY736:   &                                     NREPI(J2),NREPJ(J2),INTFROZEN(NREPI(J2)),INTFROZEN(NREPJ(J2)),DUMMY
758:          ENDIF737:          ENDIF
759:          REPE(J1-1)=REPE(J1-1)+DUMMY738:          REPE(J1-1)=REPE(J1-1)+DUMMY
760:          EREP=EREP+DUMMY739:          EREP=EREP+DUMMY
761: !        DUMMY=-12.0D0*INTCONSTRAINTREP*(1.0D0/(D1*D12)-1.0D0/INTCONST)740: !        DUMMY=-12.0D0*INTCONSTRAINTREP*(1.0D0/(D1*D12)-1.0D0/INTCONST)
762:          DUMMY=-2.0D0*INTCONSTRAINTREP*(1.0D0/(D1*D12)-1.0D0/INTCONST)741:          DUMMY=-2.0D0*INTCONSTRAINTREP*(1.0D0/(D1*D12)-1.0D0/INTCONST)
763:          REPGRAD(1:3)=DUMMY*G1(1:3)742:          REPGRAD(1:3)=DUMMY*G1(1:3)
764: !        WRITE(*, '(A,4I6,G15.5)') 'max J1,J2,REPI,REPJ,REPGRAD=',J1,J2,NREPI(J2),NREPJ(J2), &743: !        PRINT '(A,4I6,G15.5)','max J1,J2,REPI,REPJ,REPGRAD=',J1,J2,NREPI(J2),NREPJ(J2), &
765: ! &                              SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2)744: ! &                              SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2)
766:          GGG(NI1+1:NI1+3)=GGG(NI1+1:NI1+3)+REPGRAD(1:3)745:          GGG(NI1+1:NI1+3)=GGG(NI1+1:NI1+3)+REPGRAD(1:3)
767:          GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)-REPGRAD(1:3)746:          GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)-REPGRAD(1:3)
768:       ENDIF747:       ENDIF
769:       DUMMY=0.0D0748:       DUMMY=0.0D0
770: !     IF ((.NOT.NOINT).AND.(DINT.LT.INTCONSTRAINREPCUT)) THEN749: !     IF ((.NOT.NOINT).AND.(DINT.LT.INTCONSTRAINREPCUT)) THEN
771:       IF ((.NOT.NOINT).AND.(DINT.LT.NREPCUT(J2))) THEN750:       IF ((.NOT.NOINT).AND.(DINT.LT.NREPCUT(J2))) THEN
772: !        D12=DSQI**6751: !        D12=DSQI**6
773:          D12=DSQI752:          D12=DSQI
774: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*DINT-13.0D0*INTCONSTRAINREPCUT)/INTCONST)753: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*DINT-13.0D0*INTCONSTRAINREPCUT)/INTCONST)
775: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*DINT-13.0D0*NREPCUT(J2))/INTCONST)754: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*DINT-13.0D0*NREPCUT(J2))/INTCONST)
776:          DUMMY=INTMINFAC*INTCONSTRAINTREP*(1.0D0/D12+(2.0D0*DINT-3.0D0*NREPCUT(J2))/INTCONST)755:          DUMMY=INTMINFAC*INTCONSTRAINTREP*(1.0D0/D12+(2.0D0*DINT-3.0D0*NREPCUT(J2))/INTCONST)
777:          EREP=EREP+DUMMY756:          EREP=EREP+DUMMY
778: !        IF (DUMMY.GT.1.0D7) PRINT '(A,3I6,3G20.10)','J2,NREPI(J2),NREPJ(J2),DINT,NREPCUT(J2),DUMMY=', &757: !        IF (DUMMY.GT.1.0D7) PRINT '(A,3I6,3G20.10)','J2,NREPI(J2),NREPJ(J2),DINT,NREPCUT(J2),DUMMY=', &
779: ! &                                                   J2,NREPI(J2),NREPJ(J2),DINT,NREPCUT(J2),DUMMY758: ! &                                                   J2,NREPI(J2),NREPJ(J2),DINT,NREPCUT(J2),DUMMY
780: !        ENDIF759: !        ENDIF
781:          IF (PRINTE.AND.(DUMMY.GT.1.0D-4)) THEN760:          IF (PRINTE.AND.(DUMMY.GT.1.0D-4)) THEN
782:             WRITE(*, '(A,2I6,2L5,G20.10)') 'R3 NREPI,NREPJ,INTFROZEN(NREPI),INTFROZEN(NREPJ),DUMMY=', &761:             PRINT '(A,2I6,2L5,G20.10)','R3 NREPI,NREPJ,INTFROZEN(NREPI),INTFROZEN(NREPJ),DUMMY=', &
783:   &                                     NREPI(J2),NREPJ(J2),INTFROZEN(NREPI(J2)),INTFROZEN(NREPJ(J2)),DUMMY762:   &                                     NREPI(J2),NREPJ(J2),INTFROZEN(NREPI(J2)),INTFROZEN(NREPJ(J2)),DUMMY
784:          ENDIF763:          ENDIF
785:          IF (J1.EQ.2) THEN764:          IF (J1.EQ.2) THEN
786:             EEE(J1)=EEE(J1)+DUMMY765:             EEE(J1)=EEE(J1)+DUMMY
787:             REPEINT(J1)=REPEINT(J1)+DUMMY766:             REPEINT(J1)=REPEINT(J1)+DUMMY
788:             NREPINT(J1)=NREPINT(J1)+1767:             NREPINT(J1)=NREPINT(J1)+1
789:          ELSE IF (J1.LT.INTIMAGE+2) THEN768:          ELSE IF (J1.LT.INTIMAGE+2) THEN
790:             EEE(J1)=EEE(J1)+DUMMY/2.0D0769:             EEE(J1)=EEE(J1)+DUMMY/2.0D0
791:             EEE(J1-1)=EEE(J1-1)+DUMMY/2.0D0770:             EEE(J1-1)=EEE(J1-1)+DUMMY/2.0D0
792:             REPEINT(J1)=REPEINT(J1)+DUMMY/2.0D0771:             REPEINT(J1)=REPEINT(J1)+DUMMY/2.0D0
794:             NREPINT(J1)=NREPINT(J1)+1773:             NREPINT(J1)=NREPINT(J1)+1
795:             NREPINT(J1-1)=NREPINT(J1-1)+1774:             NREPINT(J1-1)=NREPINT(J1-1)+1
796:          ELSE IF (J1.EQ.INTIMAGE+2) THEN775:          ELSE IF (J1.EQ.INTIMAGE+2) THEN
797:             EEE(J1-1)=EEE(J1-1)+DUMMY776:             EEE(J1-1)=EEE(J1-1)+DUMMY
798:             REPEINT(J1-1)=REPEINT(J1-1)+DUMMY777:             REPEINT(J1-1)=REPEINT(J1-1)+DUMMY
799:             NREPINT(J1-1)=NREPINT(J1-1)+1778:             NREPINT(J1-1)=NREPINT(J1-1)+1
800:          ENDIF779:          ENDIF
801: !        DUMMY=-12.0D0*INTCONSTRAINTREP*(1.0D0/(DINT*D12)-1.0D0/INTCONST)780: !        DUMMY=-12.0D0*INTCONSTRAINTREP*(1.0D0/(DINT*D12)-1.0D0/INTCONST)
802:          DUMMY=-2.0D0*INTCONSTRAINTREP*(1.0D0/(DINT*D12)-1.0D0/INTCONST)781:          DUMMY=-2.0D0*INTCONSTRAINTREP*(1.0D0/(DINT*D12)-1.0D0/INTCONST)
803:          REPGRAD(1:3)=INTMINFAC*DUMMY*G1INT(1:3)782:          REPGRAD(1:3)=INTMINFAC*DUMMY*G1INT(1:3)
804: !        WRITE(*, '(A,4I6,2G15.5)') 'in1 J1,J2,REPI,REPJ,REPGRAD,NREPCUT=',J1,J2,NREPI(J2),NREPJ(J2), &783: !        PRINT '(A,4I6,2G15.5)','in1 J1,J2,REPI,REPJ,REPGRAD,NREPCUT=',J1,J2,NREPI(J2),NREPJ(J2), &
805: ! &                              SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2),NREPCUT(J2)784: ! &                              SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2),NREPCUT(J2)
806:          GGG(NI1+1:NI1+3)=GGG(NI1+1:NI1+3)+REPGRAD(1:3)785:          GGG(NI1+1:NI1+3)=GGG(NI1+1:NI1+3)+REPGRAD(1:3)
807:          GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)-REPGRAD(1:3)786:          GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)-REPGRAD(1:3)
808:          REPGRAD(1:3)=INTMINFAC*DUMMY*G2INT(1:3)787:          REPGRAD(1:3)=INTMINFAC*DUMMY*G2INT(1:3)
809: !        WRITE(*, '(A,4I6,2G15.5)') 'in1 J1,J2,REPI,REPJ,REPGRAD,NREPCUT=',J1,J2,NREPI(J2),NREPJ(J2), &788: !        PRINT '(A,4I6,2G15.5)','in1 J1,J2,REPI,REPJ,REPGRAD,NREPCUT=',J1,J2,NREPI(J2),NREPJ(J2), &
810: ! &                              SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2),NREPCUT(J2)789: ! &                              SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2),NREPCUT(J2)
811:          GGG(NI2+1:NI2+3)=GGG(NI2+1:NI2+3)+REPGRAD(1:3)790:          GGG(NI2+1:NI2+3)=GGG(NI2+1:NI2+3)+REPGRAD(1:3)
812:          GGG(NJ2+1:NJ2+3)=GGG(NJ2+1:NJ2+3)-REPGRAD(1:3)791:          GGG(NJ2+1:NJ2+3)=GGG(NJ2+1:NJ2+3)-REPGRAD(1:3)
813:       ENDIF792:       ENDIF
814: !     WRITE(*,'(A,2I8,6G20.10)') 'congrad2> C J1,J2,GGG(1:6)=',J1,J2,GGG(1:6) 
815:    ENDDO793:    ENDDO
816: ENDDO794: ENDDO
817: !795: !
818: ! Spring energy. Set EEE(J1) and ESPRING dividing up the pairwise796: ! Spring energy. Set EEE(J1) and ESPRING dividing up the pairwise
819: ! energy terms between images except for the end points.797: ! energy terms between images except for the end points.
820: !798: !
821: ESPRING=0.0D0799: ESPRING=0.0D0
822: IF (KINT.NE.0.0D0) THEN800: IF (KINT.NE.0.0D0) THEN
823:    DO J1=1,INTIMAGE+1 ! sum over edges from J1 to J1+1801:    DO J1=1,INTIMAGE+1 ! sum over edges from J1 to J1+1
824:       NI1=(3*NATOMS)*(J1-1)802:       NI1=NOPT*(J1-1)
825:       NI2=(3*NATOMS)*J1803:       NI2=NOPT*J1
826: !804: !
827: !  Edge between J1 and J1+1805: !  Edge between J1 and J1+1
 806: !  Shouldn't we sum over active atoms only here?
828: !807: !
829:       DPLUS=0.0D0808:       DPLUS=0.0D0
830:       DO J2=1,NATOMS809:       DO J2=1,NATOMS
831:          IF ((.NOT.INTSPRINGACTIVET).OR.ATOMACTIVE(J2)) THEN 810:          IF ((.NOT.INTSPRINGACTIVET).OR.ATOMACTIVE(J2)) THEN
832:             DPLUS=DPLUS+(XYZ(NI1+3*(J2-1)+1)-XYZ(NI2+3*(J2-1)+1))**2 &811:             DPLUS=DPLUS+(XYZ(NI1+3*(J2-1)+1)-XYZ(NI2+3*(J2-1)+1))**2 &
833:   &                    +(XYZ(NI1+3*(J2-1)+2)-XYZ(NI2+3*(J2-1)+2))**2 &812:   &                    +(XYZ(NI1+3*(J2-1)+2)-XYZ(NI2+3*(J2-1)+2))**2 &
834:   &                    +(XYZ(NI1+3*(J2-1)+3)-XYZ(NI2+3*(J2-1)+3))**2813:   &                    +(XYZ(NI1+3*(J2-1)+3)-XYZ(NI2+3*(J2-1)+3))**2
835:          ENDIF814:          ENDIF
836: !        WRITE(*,'(A,2I8,G20.10)') 'J1,J2,DPLUS: ',J1,J2,DPLUS 
837:       ENDDO815:       ENDDO
838:       DPLUS=SQRT(DPLUS)816:       DPLUS=SQRT(DPLUS)
839:       IF (DPLUS.GT.IMSEPMAX) THEN817:       IF (DPLUS.GT.IMSEPMAX) THEN
840:          DUMMY=KINT*0.5D0*(DPLUS-IMSEPMAX)**2818:          DUMMY=KINT*0.5D0*(DPLUS-IMSEPMAX)**2
841: !        DUMMY=KINT*0.5D0*DPLUS**2819: !        DUMMY=KINT*0.5D0*DPLUS**2
842:          ESPRING=ESPRING+DUMMY820:          ESPRING=ESPRING+DUMMY
843: !        WRITE(*,'(A,4G20.10)') 'DPLUS,IMSEPMAX,DUMMY,ESPRING=',DPLUS,IMSEPMAX,DUMMY,ESPRING821: !        WRITE(*,'(A,4G20.10)') 'DPLUS,IMSEPMAX,DUMMY,ESPRING=',DPLUS,IMSEPMAX,DUMMY,ESPRING
844:          DUMMY=KINT*(DPLUS-IMSEPMAX)/DPLUS822:          DUMMY=KINT*(DPLUS-IMSEPMAX)/DPLUS
845: !        DUMMY=KINT823: !        DUMMY=KINT
846:          DO J2=1,NATOMS824:          DO J2=1,NATOMS
847:             IF ((.NOT.INTSPRINGACTIVET).OR.ATOMACTIVE(J2)) THEN 825:             IF ((.NOT.INTSPRINGACTIVET).OR.ATOMACTIVE(J2)) THEN
848:                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))826:                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))
849:                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)827:                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)
850:                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)828:                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)
851:             ENDIF829:             ENDIF
852:          ENDDO830:          ENDDO
853:       ENDIF831:       ENDIF
854:    ENDDO832:    ENDDO
855: ENDIF833: ENDIF
856:          IF (PRINTE) THEN834:          IF (PRINTE) THEN
857:             WRITE(*, '(A,G20.10)') 'ESPRING=',ESPRING835:             PRINT '(A,G20.10)','ESPRING=',ESPRING
858:          ENDIF836:          ENDIF
859: !837: !
860: ! Set gradients on frozen atoms to zero.838: ! Set gradients on frozen atoms to zero.
861: !839: !
862: IF (FREEZE) THEN840: IF (FREEZE) THEN
863:    DO J1=2,INTIMAGE+1  841:    DO J1=2,INTIMAGE+1  
864:       DO J2=1,NATOMS842:       DO J2=1,NATOMS
865:          IF (FROZEN(J2)) THEN843:          IF (FROZEN(J2)) THEN
866:             GGG((3*NATOMS)*(J1-1)+3*(J2-1)+1)=0.0D0844:             GGG(NOPT*(J1-1)+3*(J2-1)+1)=0.0D0
867:             GGG((3*NATOMS)*(J1-1)+3*(J2-1)+2)=0.0D0845:             GGG(NOPT*(J1-1)+3*(J2-1)+2)=0.0D0
868:             GGG((3*NATOMS)*(J1-1)+3*(J2-1)+3)=0.0D0846:             GGG(NOPT*(J1-1)+3*(J2-1)+3)=0.0D0
869:          ENDIF847:          ENDIF
870:       ENDDO848:       ENDDO
871:    ENDDO849:    ENDDO
872: ENDIF850: ENDIF
873: !851: !
874: ! Set gradients on locally frozen atoms to zero.852: ! Set gradients on locally frozen atoms to zero.
875: !853: !
876: IF (INTFREEZET) THEN854: IF (INTFREEZET) THEN
877:    DO J1=2,INTIMAGE+1855:    DO J1=2,INTIMAGE+1
878:       DO J2=1,NATOMS856:       DO J2=1,NATOMS
879:          IF (INTFROZEN(J2)) THEN857:          IF (INTFROZEN(J2)) THEN
880:             GGG((3*NATOMS)*(J1-1)+3*(J2-1)+1)=0.0D0858:             GGG(NOPT*(J1-1)+3*(J2-1)+1)=0.0D0
881:             GGG((3*NATOMS)*(J1-1)+3*(J2-1)+2)=0.0D0859:             GGG(NOPT*(J1-1)+3*(J2-1)+2)=0.0D0
882:             GGG((3*NATOMS)*(J1-1)+3*(J2-1)+3)=0.0D0860:             GGG(NOPT*(J1-1)+3*(J2-1)+3)=0.0D0
883:          ENDIF861:          ENDIF
884:       ENDDO862:       ENDDO
885:    ENDDO863:    ENDDO
886: ENDIF864: ENDIF
887: !865: !
888: ! Set gradients to zero for start and finish images.866: ! Set gradients to zero for start and finish images.
889: !867: !
890: IF (INTIMAGE.GT.0) THEN868: IF (INTIMAGE.GT.0) THEN
891:    GGG(1:(3*NATOMS))=0.0D0869:    GGG(1:NOPT)=0.0D0
892:    GGG((INTIMAGE+1)*(3*NATOMS)+1:(INTIMAGE+2)*(3*NATOMS))=0.0D0870:    GGG((INTIMAGE+1)*NOPT+1:(INTIMAGE+2)*NOPT)=0.0D0
893: ENDIF871: ENDIF
894: RMS=0.0D0872: RMS=0.0D0
895: RMSIMAGE(1:INTIMAGE+2)=0.0D0873: RMSIMAGE(1:INTIMAGE+2)=0.0D0
896: DO J1=2,INTIMAGE+1874: DO J1=2,INTIMAGE+1
897:    DO J2=1,(3*NATOMS)875:    DO J2=1,NOPT
898:       RMSIMAGE(J1)=RMSIMAGE(J1)+GGG((3*NATOMS)*(J1-1)+J2)**2876:       RMSIMAGE(J1)=RMSIMAGE(J1)+GGG(NOPT*(J1-1)+J2)**2
899:    ENDDO877:    ENDDO
900:    RMS=RMS+RMSIMAGE(J1)878:    RMS=RMS+RMSIMAGE(J1)
901:    IF (LPRINT) WRITE(*, '(A,I6,2G20.10)') ' congrad2> J1,EEE,RMSIMAGE=',J1,EEE(J1),RMSIMAGE(J1)879:    IF (LPRINT) PRINT '(A,I6,2G20.10,L5)',' congrad2> J1,EEE,RMSIMAGE=',J1,EEE(J1),RMSIMAGE(J1)
902: ENDDO880: ENDDO
903: IF (INTIMAGE.NE.0) THEN881: IF (INTIMAGE.NE.0) THEN
904:    RMS=SQRT(RMS/((3*NATOMS)*INTIMAGE))882:    RMS=SQRT(RMS/(NOPT*INTIMAGE))
905: ENDIF883: ENDIF
906: !884: !
907: ! For INTIMAGE images there are INTIMAGE+2 replicas including the end points,885: ! For INTIMAGE images there are INTIMAGE+2 replicas including the end points,
908: ! and INTIMAGE+1 line segements, with associated energies stored in EEE(2:INTIMAGE+2)886: ! and INTIMAGE+1 line segements, with associated energies stored in EEE(2:INTIMAGE+2)
909: !887: !
910:  
911: ETOTAL=0.0D0888: ETOTAL=0.0D0
912: MAXINT=-1.0D100889: MAXINT=-1.0D100
913: MININT=1.0D100890: MININT=1.0D100
914: DO J1=2,INTIMAGE+1891: DO J1=2,INTIMAGE+1
915:    ETOTAL=ETOTAL+EEE(J1)892:    ETOTAL=ETOTAL+EEE(J1)
916: !  IF (DEBUG) PRINT '(A,I6,A,4G15.5)',' congrad2> con/rep and con/rep int image ', &893: !  IF (DEBUG) PRINT '(A,I6,A,4G15.5)',' congrad2> con/rep and con/rep int image ', &
917: ! &      J1,' ',CONE(J1),REPE(J1),CONEINT(J1),REPEINT(J1)894: ! &      J1,' ',CONE(J1),REPE(J1),CONEINT(J1),REPEINT(J1)
918:    IF (CONEINT(J1)+REPEINT(J1).LT.MININT) THEN895:    IF (CONEINT(J1)+REPEINT(J1).LT.MININT) THEN
919:       MININT=CONEINT(J1)+REPEINT(J1)896:       MININT=CONEINT(J1)+REPEINT(J1)
920:       NMININT=J1897:       NMININT=J1
922:    IF (CONEINT(J1)+REPEINT(J1).GT.MAXINT) THEN899:    IF (CONEINT(J1)+REPEINT(J1).GT.MAXINT) THEN
923:       MAXINT=CONEINT(J1)+REPEINT(J1)900:       MAXINT=CONEINT(J1)+REPEINT(J1)
924:       NMAXINT=J1901:       NMAXINT=J1
925:    ENDIF902:    ENDIF
926: ENDDO903: ENDDO
927: ! IF (DEBUG) PRINT '(A,G20.10,A,2I6)',' congrad2> largest  internal energy=',MAXINT,' for image ',NMAXINT904: ! IF (DEBUG) PRINT '(A,G20.10,A,2I6)',' congrad2> largest  internal energy=',MAXINT,' for image ',NMAXINT
928: ! IF (DEBUG) PRINT '(A,G20.10,A,2I6)',' congrad2> smallest internal energy=',MININT,' for image ',NMININT905: ! IF (DEBUG) PRINT '(A,G20.10,A,2I6)',' congrad2> smallest internal energy=',MININT,' for image ',NMININT
929: IF (INTIMAGE.EQ.0) ETOTAL=EEE(1)+EEE(2)906: IF (INTIMAGE.EQ.0) ETOTAL=EEE(1)+EEE(2)
930: 907: 
931: IF ((RMS.LT.1.0D-50).AND.(ETOTAL.GT.0.1D0).AND.(INTIMAGE.GT.0.0D0)) THEN908: IF ((RMS.LT.1.0D-50).AND.(ETOTAL.GT.0.1D0).AND.(INTIMAGE.GT.0.0D0)) THEN
932:    WRITE(*, '(A,2G20.10)') 'ETOTAL,RMS=',ETOTAL,RMS909:    PRINT '(A,2G20.10)','ETOTAL,RMS=',ETOTAL,RMS
933:    WRITE(*, '(A,G20.10)') 'ECON=',ECON910:    PRINT '(A,G20.10)','ECON=',ECON
934:    WRITE(*, '(A,G20.10)') 'EREP=',EREP911:    PRINT '(A,G20.10)','EREP=',EREP
935:    IF (PRINTE) STOP912:    IF (PRINTE) STOP
936:    PRINTE=.TRUE.913:    PRINTE=.TRUE.
937:    GOTO 111914:    GOTO 111
938: ENDIF915: ENDIF
939: 916: 
940: END SUBROUTINE CONGRAD2917: END SUBROUTINE CONGRAD2
941: 918: 
942: SUBROUTINE INTMINONLY(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,DINT,NOINT)919: SUBROUTINE INTMINONLY(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,DINT,NOINT)
943: IMPLICIT NONE920: IMPLICIT NONE
944: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,DINT,DUMMY921: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,DINT,DUMMY
968:    r1amr1bdr2amr2bsq=r1amr1bdr2amr2b**2945:    r1amr1bdr2amr2bsq=r1amr1bdr2amr2b**2
969:    r1amr1bsq=(r1ax - r1bx)**2 + (r1ay - r1by)**2 + (r1az - r1bz)**2946:    r1amr1bsq=(r1ax - r1bx)**2 + (r1ay - r1by)**2 + (r1az - r1bz)**2
970:    r2amr2bsq=(r2ax - r2bx)**2 + (r2ay - r2by)**2 + (r2az - r2bz)**2947:    r2amr2bsq=(r2ax - r2bx)**2 + (r2ay - r2by)**2 + (r2az - r2bz)**2
971:    DSQI=MAX((-r1amr1bdr2amr2bsq + r1amr1bsq*r2amr2bsq)/r1apr2bmr2amr1bsq,0.0D0)948:    DSQI=MAX((-r1amr1bdr2amr2bsq + r1amr1bsq*r2amr2bsq)/r1apr2bmr2amr1bsq,0.0D0)
972:    DINT=SQRT(DSQI)949:    DINT=SQRT(DSQI)
973: ENDIF950: ENDIF
974: 951: 
975: RETURN952: RETURN
976: 953: 
977: END SUBROUTINE INTMINONLY954: END SUBROUTINE INTMINONLY
978:  
979: ! 
980: ! Call this version for additional repulsive terms between constraints. 
981: ! 
982: SUBROUTINE CONGRAD3(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS) 
983: USE KEY, ONLY: FROZEN, FREEZE, NREPI, NREPJ, NNREPULSIVE, & 
984:   &            NCONSTRAINT, CONI, CONJ, INTCONSTRAINTDEL, CONDISTREF, INTCONSTRAINTREP, CONDISTREFLOCAL, & 
985:   &            CONACTIVE, INTCONSTRAINREPCUT, NREPCUT,INTIMAGE, KINT, IMSEPMAX, ATOMACTIVE, QCINOREPINT, & 
986:   &            INTFREEZET, INTFROZEN, CONCUTLOCAL, CONCUT, CONCUTABST, CONCUTABS, CONCUTFRACT, CONCUTFRAC, & 
987:   &  INTMINFAC, FREEZENODEST, INTSPRINGACTIVET, QCIADDREP, QCIADDREPCUT, QCIADDREPEPS, QCIBONDS 
988: USE COMMONS, ONLY: NATOMS, NOPT, DEBUG 
989: USE PORFUNCS 
990: IMPLICIT NONE 
991:             
992: INTEGER :: J1,J2,NI2,NI1,NJ2,NJ1,NMAXINT,NMININT,NREPINT(INTIMAGE+2),ISTAT,J3,J4,J5,NINTMIN,NINTMIN2,MYUNIT 
993: DOUBLE PRECISION :: ECON, EREP, ETOTAL, RMS 
994: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,D2,D1 
995: DOUBLE PRECISION G1(3),G2(3),DINT,G1INT(3),G2INT(3) 
996: DOUBLE PRECISION DUMMY, REPGRAD(3), INTCONST, D12, DSQ2, DSQ1, DSQI 
997: DOUBLE PRECISION CONE(INTIMAGE+2), REPE(INTIMAGE+2),MAXINT,MININT,REPEINT(INTIMAGE+2),RMSIM(INTIMAGE+2) 
998: LOGICAL NOINT 
999: DOUBLE PRECISION XYZ((3*NATOMS)*(INTIMAGE+2)), GGG((3*NATOMS)*(INTIMAGE+2)), EEE(INTIMAGE+2), CCLOCAL 
1000: LOGICAL IMGFREEZE(INTIMAGE) 
1001: DOUBLE PRECISION DPLUS, ESPRING, SPGRAD(3), X1, X2, Y1, Y2, Z1, Z2 
1002:  
1003: EEE(1:INTIMAGE+2)=0.0D0 
1004: CONE(1:INTIMAGE+2)=0.0D0 
1005: REPE(1:INTIMAGE+2)=0.0D0 
1006: REPEINT(1:INTIMAGE+2)=0.0D0 
1007: NREPINT(1:INTIMAGE+2)=0 
1008: GGG(1:(3*NATOMS)*(INTIMAGE+2))=0.0D0 
1009: ECON=0.0D0; EREP=0.0D0 
1010: MYUNIT=6 
1011:  
1012: IF (QCIADDREP.LT.1) THEN 
1013:    WRITE(*,'(A,I6)') 'congrad3> ERROR congrad3 called with no QCIADDREP=',QCIADDREP 
1014:    STOP 
1015: ENDIF 
1016: ! 
1017: !  Constraint energy and forces. 
1018: ! 
1019: OPEN(UNIT=852,FILE='test.xyz',STATUS='UNKNOWN') 
1020: INTCONST=QCIADDREPCUT**3 
1021: DO J2=1,NCONSTRAINT 
1022:    IF (.NOT.CONACTIVE(J2)) CYCLE 
1023:    CCLOCAL=CONCUTLOCAL(J2) 
1024:    IF (CONCUTABST) CCLOCAL=CCLOCAL+CONCUTABS 
1025:    IF (CONCUTFRACT) CCLOCAL=CCLOCAL+CONCUTFRAC*CONDISTREFLOCAL(J2) 
1026:    DO J1=2,INTIMAGE+1 
1027:       NI1=(3*NATOMS)*(J1-1)+3*(CONI(J2)-1) 
1028:       NJ1=(3*NATOMS)*(J1-1)+3*(CONJ(J2)-1) 
1029:       R2AX=XYZ(NI1+1); R2AY=XYZ(NI1+2); R2AZ=XYZ(NI1+3) 
1030:       R2BX=XYZ(NJ1+1); R2BY=XYZ(NJ1+2); R2BZ=XYZ(NJ1+3) 
1031:       D2=SQRT((R2AX-R2BX)**2+(R2AY-R2BY)**2+(R2AZ-R2BZ)**2) 
1032:       IF (ABS(D2-CONDISTREFLOCAL(J2)).GT.CCLOCAL) THEN  
1033:          DUMMY=D2-CONDISTREFLOCAL(J2)   
1034:          G2(1)=(R2AX-R2BX)/D2 
1035:          G2(2)=(R2AY-R2BY)/D2 
1036:          G2(3)=(R2AZ-R2BZ)/D2 
1037:          REPGRAD(1:3)=2*INTCONSTRAINTDEL*((DUMMY/CCLOCAL)**2-1.0D0)*DUMMY*G2(1:3) 
1038:          DUMMY=INTCONSTRAINTDEL*(DUMMY**2-CCLOCAL**2)**2/(2.0D0*CCLOCAL**2) 
1039:          EEE(J1)=EEE(J1)  +DUMMY 
1040:          ECON=ECON        +DUMMY 
1041:          CONE(J1)=CONE(J1)+DUMMY 
1042:          GGG(NI1+1:NI1+3)=GGG(NI1+1:NI1+3)+REPGRAD(1:3) 
1043:          GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)-REPGRAD(1:3) 
1044:       ENDIF 
1045: !     WRITE(MYUNIT,'(A,2I6,5G20.10)') 'J1,J2,D2,CONDISTREFLOCAL,CCLOCAL,EEE,CONE=',J1,J2,D2,CONDISTREFLOCAL(J2),CCLOCAL,EEE(J1),CONE(J1) 
1046:       IF (J2.GT.QCIBONDS) CYCLE 
1047:       DO J3=J2+1,QCIBONDS 
1048:          IF (.NOT.CONACTIVE(J3)) CYCLE 
1049:          IF (CONI(J3).EQ.CONI(J2)) CYCLE ! no extra terms for bonds with a common atom 
1050:          IF (CONI(J3).EQ.CONJ(J2)) CYCLE ! no extra terms for bonds with a common atom 
1051:          IF (CONJ(J3).EQ.CONI(J2)) CYCLE ! no extra terms for bonds with a common atom 
1052:          IF (CONJ(J3).EQ.CONJ(J2)) CYCLE ! no extra terms for bonds with a common atom 
1053:          NI2=(3*NATOMS)*(J1-1)+3*(CONI(J3)-1) 
1054:          NJ2=(3*NATOMS)*(J1-1)+3*(CONJ(J3)-1) 
1055:          DO J4=1,QCIADDREP 
1056:             X1=(J4*XYZ(NI1+1)+(QCIADDREP+1-J4)*XYZ(NJ1+1))/(QCIADDREP+1.0D0) 
1057:             Y1=(J4*XYZ(NI1+2)+(QCIADDREP+1-J4)*XYZ(NJ1+2))/(QCIADDREP+1.0D0) 
1058:             Z1=(J4*XYZ(NI1+3)+(QCIADDREP+1-J4)*XYZ(NJ1+3))/(QCIADDREP+1.0D0) 
1059:             DO J5=1,QCIADDREP 
1060:                X2=(J5*XYZ(NI2+1)+(QCIADDREP+1-J5)*XYZ(NJ2+1))/(QCIADDREP+1.0D0) 
1061:                Y2=(J5*XYZ(NI2+2)+(QCIADDREP+1-J5)*XYZ(NJ2+2))/(QCIADDREP+1.0D0) 
1062:                Z2=(J5*XYZ(NI2+3)+(QCIADDREP+1-J5)*XYZ(NJ2+3))/(QCIADDREP+1.0D0) 
1063:                D2=SQRT((X1-X2)**2+(Y1-Y2)**2+(Z1-Z2)**2) 
1064:                IF (D2.LT.QCIADDREPCUT) THEN  
1065:                   D12=D2**2 
1066:                   DUMMY=QCIADDREPEPS*(1.0D0/D12+(2.0D0*D2-3.0D0*QCIADDREPCUT)/INTCONST) 
1067:                   EEE(J1)=EEE(J1)+DUMMY 
1068:                   REPE(J1)=REPE(J1)+DUMMY 
1069:                   EREP=EREP+DUMMY 
1070: !                 WRITE(*,'(A,4I6,A,2I6,A,2G20.10)') 'congrad3> atoms: ',CONI(J2),CONJ(J2),CONI(J3),CONJ(J3), & 
1071: ! &                     ' sites ',J4,J5,' dist,erep=',D2,DUMMY    
1072:                   DUMMY=-2.0D0*QCIADDREPEPS*(1.0D0/(D2*D12)-1.0D0/INTCONST) 
1073:                   G2(1)=(X1-X2)/D2 
1074:                   G2(2)=(Y1-Y2)/D2 
1075:                   G2(3)=(Z1-Z2)/D2 
1076:                   REPGRAD(1:3)=DUMMY*G2(1:3) 
1077:                   GGG(NI1+1:NI1+3)=GGG(NI1+1:NI1+3)+J4*REPGRAD(1:3)/(QCIADDREP+1.0D0) ! forces on the four atoms involved in the two constraints 
1078:                   GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)+(QCIADDREP+1-J4)*REPGRAD(1:3)/(QCIADDREP+1.0D0) 
1079:                   GGG(NI2+1:NI2+3)=GGG(NI2+1:NI2+3)-J5*REPGRAD(1:3)/(QCIADDREP+1.0D0) 
1080:                   GGG(NJ2+1:NJ2+3)=GGG(NJ2+1:NJ2+3)-(QCIADDREP+1-J5)*REPGRAD(1:3)/(QCIADDREP+1.0D0) 
1081:                ENDIF 
1082:             ENDDO 
1083:          ENDDO 
1084:       ENDDO 
1085:    ENDDO 
1086: ENDDO 
1087: CLOSE(852) 
1088:  
1089: GGG(1:(3*NATOMS))=0.0D0                                      ! can delete when loop range above changes 
1090: GGG((3*NATOMS)*(INTIMAGE+1)+1:(3*NATOMS)*(INTIMAGE+2))=0.0D0 ! can delete when loop range above changes 
1091:  
1092: ! INTCONST=INTCONSTRAINREPCUT**13 
1093:  
1094: DO J2=1,NNREPULSIVE 
1095: !  INTCONST=NREPCUT(J2)**13 
1096:    INTCONST=NREPCUT(J2)**3 
1097:    DO J1=2,INTIMAGE+2 
1098: !  DO J1=1,INTIMAGE+2 ! can change when zero energies are confirmed for end images 
1099:       IF (FREEZENODEST) THEN 
1100:          IF (J1.EQ.2) THEN 
1101:             IF (IMGFREEZE(1)) CYCLE 
1102:          ELSE IF (J1.EQ.INTIMAGE+2) THEN 
1103:             IF (IMGFREEZE(INTIMAGE)) CYCLE 
1104:          ELSE 
1105:             IF (IMGFREEZE(J1-2).AND.IMGFREEZE(J1-1)) CYCLE 
1106:          ENDIF 
1107:       ENDIF 
1108:       IF (INTFROZEN(NREPI(J2)).AND.INTFROZEN(NREPJ(J2))) THEN 
1109:          WRITE(*, '(A,I6,A,2I6)') ' congrad3> ERROR *** repulsion ',J2,' between frozen atoms ',NREPI(J2),NREPJ(J2) 
1110:          STOP 
1111:       ENDIF 
1112: !     WRITE(*,'(A,2I8,6G20.10)') 'congrad3> B J1,J2,GGG(1:6)=',J1,J2,GGG(1:6) 
1113:       NI2=(3*NATOMS)*(J1-1)+3*(NREPI(J2)-1) 
1114:       NJ2=(3*NATOMS)*(J1-1)+3*(NREPJ(J2)-1) 
1115:       R2AX=XYZ(NI2+1); R2AY=XYZ(NI2+2); R2AZ=XYZ(NI2+3) 
1116:       R2BX=XYZ(NJ2+1); R2BY=XYZ(NJ2+2); R2BZ=XYZ(NJ2+3) 
1117:       D2=SQRT((R2AX-R2BX)**2+(R2AY-R2BY)**2+(R2AZ-R2BZ)**2) 
1118:       IF (D2.LT.NREPCUT(J2)) THEN ! term for image J1 
1119: !        D12=D2**12 
1120:          D12=D2**2 
1121: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*D2-13.0D0*NREPCUT(J2))/INTCONST) 
1122:          DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(2.0D0*D2-3.0D0*NREPCUT(J2))/INTCONST) 
1123:          EEE(J1)=EEE(J1)+DUMMY 
1124:          REPE(J1)=REPE(J1)+DUMMY 
1125:          EREP=EREP+DUMMY 
1126: !        DUMMY=-12.0D0*INTCONSTRAINTREP*(1.0D0/(D2*D12)-1.0D0/INTCONST) 
1127:          DUMMY=-2.0D0*INTCONSTRAINTREP*(1.0D0/(D2*D12)-1.0D0/INTCONST) 
1128:          G2(1)=(R2AX-R2BX)/D2 
1129:          G2(2)=(R2AY-R2BY)/D2 
1130:          G2(3)=(R2AZ-R2BZ)/D2 
1131:          REPGRAD(1:3)=DUMMY*G2(1:3) 
1132:          GGG(NI2+1:NI2+3)=GGG(NI2+1:NI2+3)+REPGRAD(1:3) 
1133:          GGG(NJ2+1:NJ2+3)=GGG(NJ2+1:NJ2+3)-REPGRAD(1:3) 
1134:       ENDIF 
1135: !     WRITE(MYUNIT,'(A,2I6,4G20.10)') 'J1,J2,D2,NREPCUT,EEE,REPE=',J1,J2,D2,NREPCUT(J2),EEE(J1),REPE(J1) 
1136: ! 
1137: ! For internal minima we are counting edges.  
1138: ! Edge J1 is between images J1-1 and J1, starting from J1=2. 
1139: ! Energy contributions are shared evenly, except for 
1140: ! edge 1, which is assigned to image 2, and edge INTIMAGE+1, which 
1141: ! is assigned to image INTIMAGE+1. Gradients are set to zero for 
1142: ! the end images. 
1143: ! 
1144:       IF (J1.EQ.1) CYCLE 
1145:       IF (QCINOREPINT) CYCLE 
1146:       NI1=(3*NATOMS)*(J1-2)+3*(NREPI(J2)-1) 
1147:       NJ1=(3*NATOMS)*(J1-2)+3*(NREPJ(J2)-1) 
1148:       R1AX=XYZ(NI1+1); R1AY=XYZ(NI1+2); R1AZ=XYZ(NI1+3) 
1149:       R1BX=XYZ(NJ1+1); R1BY=XYZ(NJ1+2); R1BZ=XYZ(NJ1+3) 
1150: !     IF (r2ax**2+r2ay**2+r2az**2+r2bx**2+r2by**2+r2bz**2-2*(r2ax*r2bx+r2ay*r2by+r2az*r2bz).EQ.0.0D0) THEN 
1151:       IF ((r1ax-r1bx-r2ax+r2bx)**2+(r1ay-r1by-r2ay+r2by)**2+(r1az-r1bz-r2az+r2bz)**2.LT.1.0D-10) THEN 
1152: !        WRITE(*, '(A,I6,A,2I6)') 'B repulsion number ',J2, ' between ',NREPI(J2),NREPJ(J2) 
1153: !        WRITE(*, '(A,6F15.10)') 'R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ=',R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ 
1154: !        WRITE(*, '(A,6F15.10)') 'R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ=',R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ 
1155: !        WRITE(*,'(A,7I10)') 'congrad3> J2,NI1,NJ1,NI2,NJ2,NREPI,NREPJ=',J2,NI1,NJ1,NI2,NJ2,NREPI(J2),NREPJ(J2) 
1156: !        WRITE(*,'(A,7I10)') 'frames ',J1-1,J1 
1157:          NOINT=.TRUE. 
1158:       ELSE 
1159:          CALL MINMAXD2R(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, & 
1160:   &                 D2,D1,DINT,DSQ2,DSQ1,DSQI,G1,G2,G1INT,G2INT,NOINT,.FALSE.,NREPCUT(J2)) 
1161:          IF (.NOT.NOINT) THEN 
1162: !           WRITE(*,'(A,I6,A,I6,A,2I6,A,2G20.10)') 'congrad3> internal minimum images ',J1-1,' and ',J1,' atoms: ',NREPI(J2),NREPJ(J2), & 
1163: ! &                        ' distance,cutoff=',DINT,NREPCUT(J2) 
1164:             NINTMIN=NINTMIN+1 
1165:          ENDIF 
1166:       ENDIF 
1167:       IF ((.NOT.NOINT).AND.(DINT.LT.NREPCUT(J2))) THEN 
1168:          NINTMIN2=NINTMIN2+1 
1169: !        D12=DSQI**6 
1170:          D12=DSQI 
1171: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*DINT-13.0D0*NREPCUT(J2))/INTCONST) 
1172:          DUMMY=INTMINFAC*INTCONSTRAINTREP*(1.0D0/D12+(2.0D0*DINT-3.0D0*NREPCUT(J2))/INTCONST) 
1173:          IF (J1.EQ.2) THEN 
1174:             EEE(J1)=EEE(J1)+DUMMY 
1175:             REPEINT(J1)=REPEINT(J1)+DUMMY 
1176:             NREPINT(J1)=NREPINT(J1)+1 
1177:          ELSE IF (J1.LT.INTIMAGE+2) THEN 
1178:             EEE(J1)=EEE(J1)+DUMMY/2.0D0 
1179:             EEE(J1-1)=EEE(J1-1)+DUMMY/2.0D0 
1180:             REPEINT(J1)=REPEINT(J1)+DUMMY/2.0D0 
1181:             REPEINT(J1-1)=REPEINT(J1-1)+DUMMY/2.0D0 
1182:             NREPINT(J1)=NREPINT(J1)+1 
1183:             NREPINT(J1-1)=NREPINT(J1-1)+1 
1184:          ELSE IF (J1.EQ.INTIMAGE+2) THEN 
1185:             EEE(J1-1)=EEE(J1-1)+DUMMY 
1186:             REPEINT(J1-1)=REPEINT(J1-1)+DUMMY 
1187:             NREPINT(J1-1)=NREPINT(J1-1)+1 
1188:          ENDIF 
1189:          EREP=EREP+DUMMY 
1190: !        DUMMY=-12.0D0*INTCONSTRAINTREP*(1.0D0/(DINT*D12)-1.0D0/INTCONST) 
1191:          DUMMY=-2.0D0*INTCONSTRAINTREP*(1.0D0/(DINT*D12)-1.0D0/INTCONST) 
1192:          REPGRAD(1:3)=INTMINFAC*DUMMY*G1INT(1:3) 
1193: !        PRINT '(A,4I6,2G15.5)','in1 J1,J2,REPI,REPJ,REPGRAD,NREPCUT=',J1,J2,NREPI(J2),NREPJ(J2), & 
1194: ! &                              SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2),NREPCUT(J2) 
1195: ! 
1196: ! Gradient contributions for image J1-1 
1197: ! 
1198:          GGG(NI1+1:NI1+3)=GGG(NI1+1:NI1+3)+REPGRAD(1:3) 
1199:          GGG(NJ1+1:NJ1+3)=GGG(NJ1+1:NJ1+3)-REPGRAD(1:3) 
1200:          REPGRAD(1:3)=INTMINFAC*DUMMY*G2INT(1:3) 
1201: !        PRINT '(A,4I6,2G15.5)','in1 J1,J2,REPI,REPJ,REPGRAD,NREPCUT=',J1,J2,NREPI(J2),NREPJ(J2), & 
1202: ! &                              SQRT(REPGRAD(1)**2+REPGRAD(2)**2+REPGRAD(3)**2),NREPCUT(J2) 
1203: ! 
1204: ! Gradient contributions for image J1 
1205: ! 
1206:          GGG(NI2+1:NI2+3)=GGG(NI2+1:NI2+3)+REPGRAD(1:3) 
1207:          GGG(NJ2+1:NJ2+3)=GGG(NJ2+1:NJ2+3)-REPGRAD(1:3) 
1208:       ENDIF 
1209:    ENDDO 
1210: ENDDO 
1211: ! 
1212: ! Spring energy. Set EEE(J1) and ESPRING dividing up the pairwise 
1213: ! energy terms between images except for the end points. 
1214: ! 
1215: ESPRING=0.0D0 
1216: IF (KINT.NE.0.0D0) THEN 
1217:    DO J1=1,INTIMAGE+1 ! sum over edges from J1 to J1+1 
1218:       NI1=(3*NATOMS)*(J1-1) 
1219:       NI2=(3*NATOMS)*J1 
1220: ! 
1221: !  Edge between J1 and J1+1 
1222: ! 
1223:       DPLUS=0.0D0 
1224:       DO J2=1,NATOMS 
1225:          IF ((.NOT.INTSPRINGACTIVET).OR.ATOMACTIVE(J2)) THEN  
1226:             DPLUS=DPLUS+(XYZ(NI1+3*(J2-1)+1)-XYZ(NI2+3*(J2-1)+1))**2 & 
1227:   &                    +(XYZ(NI1+3*(J2-1)+2)-XYZ(NI2+3*(J2-1)+2))**2 & 
1228:   &                    +(XYZ(NI1+3*(J2-1)+3)-XYZ(NI2+3*(J2-1)+3))**2 
1229:          ENDIF 
1230:       ENDDO 
1231:       DPLUS=SQRT(DPLUS) 
1232:       IF (DPLUS.GT.IMSEPMAX) THEN 
1233: !        DUMMY=KINT*0.5D0*(DPLUS-IMSEPMAX)**2 
1234:          DUMMY=KINT*0.5D0*DPLUS**2 
1235:          ESPRING=ESPRING+DUMMY 
1236: !        DUMMY=KINT*(DPLUS-IMSEPMAX)/DPLUS 
1237:          DUMMY=KINT 
1238:          DO J2=1,NATOMS 
1239:             IF ((.NOT.INTSPRINGACTIVET).OR.ATOMACTIVE(J2)) THEN  
1240:                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)) 
1241:                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) 
1242:                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) 
1243:             ENDIF 
1244:          ENDDO 
1245:       ENDIF 
1246:    ENDDO 
1247: ENDIF 
1248: ! 
1249: ! Set gradients on frozen atoms to zero. 
1250: ! 
1251: IF (FREEZE) THEN 
1252:    DO J1=2,INTIMAGE+1   
1253:       DO J2=1,NATOMS 
1254:          IF (FROZEN(J2)) THEN 
1255:             GGG((3*NATOMS)*(J1-1)+3*(J2-1)+1)=0.0D0 
1256:             GGG((3*NATOMS)*(J1-1)+3*(J2-1)+2)=0.0D0 
1257:             GGG((3*NATOMS)*(J1-1)+3*(J2-1)+3)=0.0D0 
1258:          ENDIF 
1259:       ENDDO 
1260:    ENDDO 
1261: ENDIF 
1262: ! 
1263: ! Set gradients on locally frozen atoms to zero. 
1264: ! 
1265: IF (INTFREEZET) THEN 
1266:    DO J1=2,INTIMAGE+1   
1267:       DO J2=1,NATOMS 
1268:          IF (INTFROZEN(J2)) THEN 
1269:             GGG((3*NATOMS)*(J1-1)+3*(J2-1)+1)=0.0D0 
1270:             GGG((3*NATOMS)*(J1-1)+3*(J2-1)+2)=0.0D0 
1271:             GGG((3*NATOMS)*(J1-1)+3*(J2-1)+3)=0.0D0 
1272:          ENDIF 
1273:       ENDDO 
1274:    ENDDO 
1275: ENDIF 
1276: ! 
1277: ! Set gradients to zero for start and finish images. 
1278: ! 
1279: GGG(1:(3*NATOMS))=0.0D0 
1280: GGG((INTIMAGE+1)*(3*NATOMS)+1:(INTIMAGE+2)*(3*NATOMS))=0.0D0 
1281: RMS=0.0D0 
1282: DO J1=2,INTIMAGE+1 
1283:    RMSIM(J1)=0.0D0 
1284:    DO J2=1,(3*NATOMS) 
1285:       RMS=RMS+GGG((3*NATOMS)*(J1-1)+J2)**2 
1286:       RMSIM(J1)=RMSIM(J1)+GGG((3*NATOMS)*(J1-1)+J2)**2 
1287:    ENDDO 
1288:    RMSIM(J1)=SQRT(RMSIM(J1)/(3*NATOMS)) 
1289: ENDDO 
1290: IF (INTIMAGE.NE.0) THEN 
1291:    RMS=SQRT(RMS/((3*NATOMS)*INTIMAGE)) 
1292: ENDIF 
1293: ! 
1294: ! For INTIMAGE images there are INTIMAGE+2 replicas including the end points, 
1295: ! and INTIMAGE+1 line segements, with associated energies stored in EEE(2:INTIMAGE+2) 
1296: ! 
1297: ETOTAL=0.0D0 
1298: MAXINT=-1.0D100 
1299: MININT=1.0D100 
1300: DO J1=2,INTIMAGE+1 
1301:    ETOTAL=ETOTAL+EEE(J1) 
1302: !  WRITE(*, '(A,I6,A,3G20.10)') ' congrad3> con/rep/RMS image ',J1,' ',CONE(J1),REPE(J1),RMSIM(J1) 
1303:    IF (REPEINT(J1).LT.MININT) THEN 
1304:       MININT=REPEINT(J1) 
1305:       NMININT=J1 
1306:    ENDIF 
1307:    IF (REPE(J1).GT.MAXINT) THEN 
1308:       MAXINT=REPE(J1) 
1309:       NMAXINT=J1 
1310:    ENDIF 
1311: ENDDO 
1312:  
1313: END SUBROUTINE CONGRAD3 


r30629/fetchz.f 2016-07-06 15:35:33.259193530 +0100 r30628/fetchz.f 2016-07-06 15:35:39.383276338 +0100
1750:       IF (INTLJT) THEN1750:       IF (INTLJT) THEN
1751:          PRINT '(A,F15.5)',   ' fetchz> Using interpLJ potential for initial interpolation in each cycle'1751:          PRINT '(A,F15.5)',   ' fetchz> Using interpLJ potential for initial interpolation in each cycle'
1752:          PRINT '(A,I8)',      '         maximum optimization steps for interpLJ potential=',INTLJSTEPS1752:          PRINT '(A,I8)',      '         maximum optimization steps for interpLJ potential=',INTLJSTEPS
1753:          PRINT '(A,F15.5)',   '         image distance spring constant=',KINT1753:          PRINT '(A,F15.5)',   '         image distance spring constant=',KINT
1754:          PRINT '(A,I8)',      '         number of initial intermediate images for interpLJ potential=',INTIMAGE1754:          PRINT '(A,I8)',      '         number of initial intermediate images for interpLJ potential=',INTIMAGE
1755:          PRINT '(A,F15.5)',   '         RMS gradient per image tolerance for constrained potential=',INTLJTOL1755:          PRINT '(A,F15.5)',   '         RMS gradient per image tolerance for constrained potential=',INTLJTOL
1756:          PRINT '(A,F20.10)',  '         minimum distance difference for internal minimum=',INTLJDEL1756:          PRINT '(A,F20.10)',  '         minimum distance difference for internal minimum=',INTLJDEL
1757:          PRINT '(A,F20.10)',  '         multiplying factor for internal minimum penalty function=',INTLJEPS1757:          PRINT '(A,F20.10)',  '         multiplying factor for internal minimum penalty function=',INTLJEPS
1758:       ENDIF1758:       ENDIF
1759:       IF (INTCONSTRAINTT) THEN1759:       IF (INTCONSTRAINTT) THEN
1760:          PRINT '(A,F15.5)',   ' fetchz> Using QCI potential for initial interpolation in each cycle'1760:          PRINT '(A,F15.5)',   ' fetchz> Using constraint potential for initial interpolation in each cycle'
1761:          PRINT '(A,F15.5)',   '         with absolute distance change tolerance ',INTCONSTRAINTTOL1761:          PRINT '(A,F15.5)',   '         with absolute distance change tolerance ',INTCONSTRAINTTOL
1762:          IF (CONCUTABST) THEN1762:          IF (CONCUTABST) THEN
1763:             PRINT '(A,F15.5)',   '         extra distance before turning on constraint potential ',CONCUTABS1763:             PRINT '(A,F15.5)',   '         extra distance before turning on constraint potential ',CONCUTABS
1764:          ELSEIF (CONCUTFRACT) THEN1764:          ELSEIF (CONCUTFRACT) THEN
1765:             PRINT '(A,F15.5)',   '         extra fractional distance before turning on constraint potential ',CONCUTFRAC1765:             PRINT '(A,F15.5)',   '         extra fractional distance before turning on constraint potential ',CONCUTFRAC
1766:          ENDIF1766:          ENDIF
1767:          PRINT '(A,F15.5)',   '         constraint spring constant=',INTCONSTRAINTDEL1767:          PRINT '(A,F15.5)',   '         constraint spring constant=',INTCONSTRAINTDEL
1768:          PRINT '(A,F15.5)',   '         image distance spring constant=',KINT1768:          PRINT '(A,F15.5)',   '         image distance spring constant=',KINT
1769:          PRINT '(2(A,F15.5))','         repulsion factor between unconstrained atoms=',INTCONSTRAINTREP 1769:          PRINT '(2(A,F15.5))','         repulsion factor between unconstrained atoms=',INTCONSTRAINTREP 
1770:          PRINT '(A,F15.5,A)', '         repulsion cutoff will be the minimum of ',INTCONSTRAINREPCUT,1770:          PRINT '(A,F15.5,A)', '         repulsion cutoff will be the minimum of ',INTCONSTRAINREPCUT,


r30629/ido.f90 2016-07-06 15:35:29.879147829 +0100 r30628/ido.f90 2016-07-06 15:35:36.251233986 +0100
 52:      ! endpoints initialisation 52:      ! endpoints initialisation
 53:      NMIN=2 53:      NMIN=2
 54:      MI(1)%DATA%E => EI 54:      MI(1)%DATA%E => EI
 55:      MI(2)%DATA%E => EF 55:      MI(2)%DATA%E => EF
 56:      MI(1)%DATA%X => Q 56:      MI(1)%DATA%X => Q
 57:      MI(2)%DATA%X => FIN 57:      MI(2)%DATA%X => FIN
 58:      ALLOCATE(MI(2)%DATA%D(1),MI(2)%DATA%NTRIES(1),MI(2)%DATA%INTNTRIES(1)) 58:      ALLOCATE(MI(2)%DATA%D(1),MI(2)%DATA%NTRIES(1),MI(2)%DATA%INTNTRIES(1))
 59:      MI(2)%DATA%D(1) = ENDPOINTSEP 59:      MI(2)%DATA%D(1) = ENDPOINTSEP
 60:      IF (INTERPCOSTFUNCTION) THEN 60:      IF (INTERPCOSTFUNCTION) THEN
 61:         ALLOCATE(MI(2)%DATA%INTERP(1)) 61:         ALLOCATE(MI(2)%DATA%INTERP(1))
 62: !         IF (INTLJT) THEN 62:         IF (INTLJT) THEN
 63: !            MINCOORDS(1,1:NOPT)=MI(1)%DATA%X(1:NOPT) 63:            MINCOORDS(1,1:NOPT)=MI(1)%DATA%X(1:NOPT)
 64: !            MINCOORDS(2,1:NOPT)=MI(2)%DATA%X(1:NOPT) 64:            MINCOORDS(2,1:NOPT)=MI(2)%DATA%X(1:NOPT)
 65: !            FREEZENODESTLOCAL=FREEZENODEST 65:            FREEZENODESTLOCAL=FREEZENODEST
 66: !            FREEZENODEST=.FALSE. 66:            FREEZENODEST=.FALSE.
 67: !            XYZLOCAL(1:NOPT)=MINCOORDS(1,1:NOPT) 67:            XYZLOCAL(1:NOPT)=MINCOORDS(1,1:NOPT)
 68: !            XYZLOCAL(NOPT+1:2*NOPT)=MINCOORDS(2,1:NOPT) 68:            XYZLOCAL(NOPT+1:2*NOPT)=MINCOORDS(2,1:NOPT)
 69: !            INTIMAGESAVE=INTIMAGE 69:            INTIMAGESAVE=INTIMAGE
 70: !            INTIMAGE=0 70:            INTIMAGE=0
 71: !            IF (.NOT.ALLOCATED(ATOMACTIVE)) ALLOCATE(ATOMACTIVE(NATOMS)) 71:            IF (.NOT.ALLOCATED(ATOMACTIVE)) ALLOCATE(ATOMACTIVE(NATOMS))
 72: !            ATOMACTIVE(1:NATOMS)=.TRUE. 72:            ATOMACTIVE(1:NATOMS)=.TRUE.
 73: ! !          EDGEINT(1:INTIMAGE+1,1:NATOMS,1:NATOMS)=.FALSE. 73: !          EDGEINT(1:INTIMAGE+1,1:NATOMS,1:NATOMS)=.FALSE.
 74: !            CALL INTGRADLJ(CONSTRAINTE,XYZLOCAL,GGGLOCAL,IMGFREEZELOCAL,RMSLOCAL,.FALSE.) 74:            CALL INTGRADLJ(CONSTRAINTE,XYZLOCAL,GGGLOCAL,IMGFREEZELOCAL,RMSLOCAL,.FALSE.)
 75: !            MI(2)%DATA%INTERP(1)=CONSTRAINTE/2.0D0 ! energy per image 75:            MI(2)%DATA%INTERP(1)=CONSTRAINTE/2.0D0 ! energy per image
 76: !            MI(2)%DATA%INTERP(1)=MI(2)%DATA%INTERP(1)/1.0D3+ENDPOINTSEP ! new formulation 76:            MI(2)%DATA%INTERP(1)=MI(2)%DATA%INTERP(1)/1.0D3+ENDPOINTSEP ! new formulation
 77: !            PRINT '(A,G20.10)',' initialise> Interpolation metric value for minima 1 and 2 is ',MI(2)%DATA%INTERP(1) 77:            PRINT '(A,G20.10)',' initialise> Interpolation metric value for minima 1 and 2 is ',MI(2)%DATA%INTERP(1)
 78: !            INTIMAGE=INTIMAGESAVE 78:            INTIMAGE=INTIMAGESAVE
 79: !            FREEZENODEST=FREEZENODESTLOCAL 79:            FREEZENODEST=FREEZENODESTLOCAL
 80: !         ELSEIF (INTCONSTRAINTT) THEN 80:         ELSEIF (INTCONSTRAINTT) THEN
 81: !            MINCOORDS(1,1:NOPT)=MI(1)%DATA%X(1:NOPT) 81:            MINCOORDS(1,1:NOPT)=MI(1)%DATA%X(1:NOPT)
 82: !            MINCOORDS(2,1:NOPT)=MI(2)%DATA%X(1:NOPT) 82:            MINCOORDS(2,1:NOPT)=MI(2)%DATA%X(1:NOPT)
 83: !            CALL MAKE_CONPOT(2,MINCOORDS) 83:            CALL MAKE_CONPOT(2,MINCOORDS)
 84: !            FREEZENODESTLOCAL=FREEZENODEST 84:            FREEZENODESTLOCAL=FREEZENODEST
 85: !            FREEZENODEST=.FALSE. 85:            FREEZENODEST=.FALSE.
 86: !            XYZLOCAL(1:NOPT)=MINCOORDS(1,1:NOPT) 86:            XYZLOCAL(1:NOPT)=MINCOORDS(1,1:NOPT)
 87: !            XYZLOCAL(NOPT+1:2*NOPT)=MINCOORDS(2,1:NOPT) 87:            XYZLOCAL(NOPT+1:2*NOPT)=MINCOORDS(2,1:NOPT)
 88: !            INTIMAGESAVE=INTIMAGE 88:            INTIMAGESAVE=INTIMAGE
 89: !            INTIMAGE=0 89:            INTIMAGE=0
 90: ! ! 90: !
 91: ! ! NMAXINT and NMININT are returned. 91: ! NMAXINT and NMININT are returned.
 92: ! ! 92: !
 93: !            CALL CONGRAD2(NMAXINT,NMININT,CONSTRAINTE,XYZLOCAL,GGGLOCAL,EEELOCAL,IMGFREEZELOCAL,RMSLOCAL) 93:            CALL CONGRAD2(NMAXINT,NMININT,CONSTRAINTE,XYZLOCAL,GGGLOCAL,EEELOCAL,IMGFREEZELOCAL,RMSLOCAL)
 94: !            MI(2)%DATA%INTERP(1)=CONSTRAINTE/2.0D0 ! energy per image 94:            MI(2)%DATA%INTERP(1)=CONSTRAINTE/2.0D0 ! energy per image
 95: !            MI(2)%DATA%INTERP(1)=MI(2)%DATA%INTERP(1)/1.0D3+ENDPOINTSEP ! new formulation 95:            MI(2)%DATA%INTERP(1)=MI(2)%DATA%INTERP(1)/1.0D3+ENDPOINTSEP ! new formulation
 96: !            PRINT '(A,G20.10)',' initialise> Interpolation metric value for minima 1 and 2 is ',MI(2)%DATA%INTERP(1) 96:            PRINT '(A,G20.10)',' initialise> Interpolation metric value for minima 1 and 2 is ',MI(2)%DATA%INTERP(1)
 97: !            INTIMAGE=INTIMAGESAVE 97:            INTIMAGE=INTIMAGESAVE
 98: !            FREEZENODEST=FREEZENODESTLOCAL 98:            FREEZENODEST=FREEZENODESTLOCAL
 99: !         ELSE 99:         ELSE
100:            MI(2)%DATA%INTERP(1)=INTERPVALUE(Q,FIN,ENDPOINTSEP)100:            MI(2)%DATA%INTERP(1)=INTERPVALUE(Q,FIN,ENDPOINTSEP)
101: !         ENDIF101:         ENDIF
102:      ENDIF102:      ENDIF
103:      MI(2)%DATA%NTRIES(1)=0103:      MI(2)%DATA%NTRIES(1)=0
104:      MI(2)%DATA%INTNTRIES(1)=0104:      MI(2)%DATA%INTNTRIES(1)=0
105:      MI(1)%DATA%S=.TRUE.105:      MI(1)%DATA%S=.TRUE.
106:      MI(1)%DATA%F=.FALSE.106:      MI(1)%DATA%F=.FALSE.
107:      MI(2)%DATA%S=.FALSE.107:      MI(2)%DATA%S=.FALSE.
108:      MI(2)%DATA%F=.TRUE.108:      MI(2)%DATA%F=.TRUE.
109:      NULLIFY( MI(1)%DATA%CTS,MI(1)%DATA%CMIN,MI(2)%DATA%CTS,MI(2)%DATA%CMIN )109:      NULLIFY( MI(1)%DATA%CTS,MI(1)%DATA%CMIN,MI(2)%DATA%CTS,MI(2)%DATA%CMIN )
110: 110: 
111:      ! S and F are not connected to anything yet.111:      ! S and F are not connected to anything yet.


r30629/intlbfgs.f90 2016-07-06 15:35:33.639198667 +0100 r30628/intlbfgs.f90 2016-07-06 15:35:39.727280987 +0100
  8: !  8: !
  9: !   OPTIM is distributed in the hope that it will be useful,  9: !   OPTIM is distributed in the hope that it will be useful,
 10: !   but WITHOUT ANY WARRANTY; without even the implied warranty of 10: !   but WITHOUT ANY WARRANTY; without even the implied warranty of
 11: !   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 11: !   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 12: !   GNU General Public License for more details. 12: !   GNU General Public License for more details.
 13: ! 13: !
 14: !   You should have received a copy of the GNU General Public License 14: !   You should have received a copy of the GNU General Public License
 15: !   along with this program; if not, write to the Free Software 15: !   along with this program; if not, write to the Free Software
 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: SUBROUTINE INTLBFGS(QSTART,QFINISH) 18: SUBROUTINE INTLBFGS(QSTART,QFINISH,LMINFOUND,LTSFOUND,MYMINFOUND,MYTSFOUND,MIN1ID,MIN2ID)
 19: USE PORFUNCS 19: USE PORFUNCS
 20: USE KEY, ONLY : FREEZENODEST, FREEZETOL, MAXBFGS, CONVR, & 20: USE KEYNEB, ONLY : NIMAGE, NITERMAX
 21:      & INTRMSTOL, INTIMAGE, NREPMAX, NREPULSIVE, MUPDATE, INTDGUESS, & 21: USE MODCHARMM, ONLY : CHRMMT
  22: USE NEWNEBMODULE
  23: USE NEBTOCONNECT
  24: USE CONNECTUTILS, ONLY : ISNEWMIN, ADDNEWMIN
  25: USE CONNECTDATA, ONLY : NMIN, MI
  26: USE KEYCONNECT, ONLY :  IMAGEMAX, IMAGEDENSITY, ITERDENSITY, NTRIESMAX, IMAGEINCR
  27: USE KEY, ONLY : FREEZENODEST, FREEZETOL, MAXINTBFGS, INTNEBIMAGES, &
  28:      & INTRMSTOL, INTIMAGE, NREPMAX, NREPULSIVE, INTMUPDATE, INTDGUESS, &
 22:      & NCONSTRAINT, CONI, CONJ, CONDISTREF, INTCONMAX, & 29:      & NCONSTRAINT, CONI, CONJ, CONDISTREF, INTCONMAX, &
 23:      & INTCONSTRAINREPCUT, REPCON, INTCONSTRAINTREP, INTREPSEP, NREPI, NREPJ, & 30:      & INTCONSTRAINREPCUT, REPCON, INTCONSTRAINTREP, INTREPSEP, NREPI, NREPJ, &
 24:      & CONDISTREFLOCAL, INTCONFRAC, CONACTIVE, REPI, & 31:      & CONDISTREFLOCAL, INTCONFRAC, CONACTIVE, NITSTART, REPI, &
 25:      & REPJ, NREPMAX, ATOMACTIVE, NCONSTRAINTON, CONION, CONJON, CONDISTREFLOCALON, CONDISTREFON, & 32:      & REPJ, NREPMAX, ATOMACTIVE, NCONSTRAINTON, CONION, CONJON, CONDISTREFLOCALON, CONDISTREFON, &
 26:      & NREPCUT, REPCUT, CHECKCONINT, INTCONSTEPS, INTRELSTEPS, MAXCONE, COLDFUSIONLIMIT, & 33:      & NREPCUT, REPCUT, CHECKCONINT, INTCONSTEPS, INTRELSTEPS, MAXCONE, COLDFUSIONLIMIT, &
 27:      & INTSTEPS1, DUMPINTXYZ, DUMPINTXYZFREQ, DUMPINTEOS, DUMPINTEOSFREQ, & 34:      & INTSTEPS1, DUMPINTXYZ, DUMPINTXYZFREQ, DUMPINTEOS, DUMPINTEOSFREQ, MUPDATE, BFGSSTEPS, INTTST, &
 28:      & IMSEPMIN, IMSEPMAX, MAXINTIMAGE, INTFREEZET, INTFREEZETOL, FREEZE, & 35:      & BFGSTST, NSTEPS, IMSEPMIN, IMSEPMAX, MAXINTIMAGE, EDIFFTOL, INTFREEZET, INTFREEZETOL, FREEZE, &
 29:      & INTFROZEN, CHECKREPINTERVAL, NNREPULSIVE, INTFREEZEMIN, INTIMAGECHECK, & 36:      & INTFROZEN, CHECKREPINTERVAL, NNREPULSIVE, INTFREEZEMIN, RIGIDBODY, TWOD, BULKT, INTIMAGECHECK, &
 30:      & CONCUT, CONCUTLOCAL, KINT, REPIFIX, REPJFIX, NREPULSIVEFIX, & 37:      & CONCUT, NCONGEOM, CONCUTLOCAL, NONEBMAX, WHOLEDNEB, PERMGUESS, QCIPERMCHECK, QCIPERMCHECKINT
 31:      & NCONSTRAINTFIX, CONIFIX, CONJFIX, QCIPERMCHECK, QCIPERMCHECKINT, BULKT, TWOD, RIGIDBODY, & 38: USE COMMONS, ONLY: NATOMS, NOPT, ZSYM, DEBUG, PARAM1, PARAM2, PARAM3, REDOPATH
 32:      & QCIADDREP, QCIXYZ, WHOLEDNEB, QCIIMAGE 39: USE MODEFOL
 33: USE COMMONS, ONLY: NATOMS, DEBUG, PARAM1, PARAM2, PARAM3 
 34: USE MODCHARMM, ONLY : CHRMMT 
 35:  40: 
 36: IMPLICIT NONE  41: IMPLICIT NONE 
 37:  42: 
 38: DOUBLE PRECISION, INTENT(IN) :: QSTART(3*NATOMS), QFINISH(3*NATOMS)  ! The two end points 43: DOUBLE PRECISION, INTENT(IN) :: QSTART(NOPT), QFINISH(NOPT)  ! The two end points
 39: INTEGER D, U 44: INTEGER D, U
 40: DOUBLE PRECISION DIST, DIST2, RMAT(3,3) 45: DOUBLE PRECISION DMAX, DF, DMIN, DISTANCE
 41: DOUBLE PRECISION DMAX, DF, DMIN, LOCALSTEP, ADMAX, DUMMYX, DUMMYY, DUMMYZ 46: INTEGER NDECREASE, NFAIL, NMAXINT, NMININT, JMAX, JMIN, INTIMAGESAVE, NOFF, J1, J2, ISTAT, POSITION, M1, M2
 42: INTEGER NDECREASE, NFAIL, NMAXINT, NMININT, JMAX, JMIN, INTIMAGESAVE, NOFF, J1, J2, NQDONE, JA1, JA2 47: LOGICAL KNOWE, KNOWG, KNOWH, ADDATOM, PTEST, MFLAG, PRINTOPTIMIZETS, PRINTOPTIMIZEMIN, ADDREP(NATOMS), &
 43: LOGICAL KNOWE, KNOWG, KNOWH, ADDATOM, ADDREP(NATOMS), LDEBUG 48:    &    INTMAXT, MINNEW
 44: COMMON /KNOWN/ KNOWE, KNOWG, KNOWH 49: COMMON /KNOWN/ KNOWE, KNOWG, KNOWH
 45:  50: 
 46: DOUBLE PRECISION DUMMY, DPRAND, DUMMY2, ADUMMY 51: DOUBLE PRECISION EDUMMY,EVALMIN,EVALMAX,DUMMY,DUMMY2(1)
 47: INTEGER POINT,NPT,J3,J4,NIMAGEFREEZE,NACTIVE,NBEST,NEWATOM,NBEST2 52: INTEGER POINT,NPT,J3,J4,NIMAGEFREEZE,NACTIVE,NBEST,NEWATOM,LMINFOUND,NSIDE,ITDONE,LTSFOUND,MIN1ID,MIN2ID
  53: INTEGER STARTID, FINISHID
 48: INTEGER TURNONORDER(NATOMS),NBACKTRACK,NQCIFREEZE 54: INTEGER TURNONORDER(NATOMS),NBACKTRACK,NQCIFREEZE
  55: DOUBLE PRECISION, DIMENSION(3*NATOMS) :: LGDUMMY, VECS, XDIAG
 49: INTEGER NDUMMY, NLASTGOODE, NSTEPSMAX 56: INTEGER NDUMMY, NLASTGOODE, NSTEPSMAX
 50: INTEGER NTRIES(NATOMS), NITERDONE, EXITSTATUS, DLIST(NATOMS) 57: INTEGER NTRIES(NATOMS), NITERDONE, EXITSTATUS, DLIST(NATOMS)
 51: DOUBLE PRECISION :: DDOT,STPMIN, ETOTALTMP, RMSTMP, USEFRAC, STIME, FTIME, & 58: DOUBLE PRECISION :: DDOT,STPMIN,PREVGRAD,EMINUS,EPLUS, STARTTIME, TIME0, DISTPREV, EMINPREV, EMINPREVPREV, &
 52:   &                 ETOTAL, LASTGOODE, RMS, STEPTOT, LINTCONSTRAINTTOL, LXYZ(2*3*NATOMS), & 59:   &                 DINCREMENT, ETOTALTMP, RMSTMP, USEFRAC, STIME, FTIME, DISTPREVPREV, &
 53:   &                 BESTWORST, WORST 60:   &                 ETOTAL, LASTGOODE, RMS, STEPTOT, LINTCONSTRAINTTOL, INTMAXE, INTMAXDIST, &
 54: DOUBLE PRECISION, DIMENSION(MUPDATE)     :: RHO1,ALPHA 61:   &                 INTMAXCOORDS(NOPT), LXYZ(2*NOPT), EINITIAL, EFINAL, &
 55: DOUBLE PRECISION :: EOLD, DMOVED(NATOMS) 62:   &                 VNEW(NOPT), ENERGY, RMS2, EREAL, LOCALCOORDS(3*NATOMS), DIST2, RMAT(3,3), CMIN1(3*NATOMS)
 56: LOGICAL SWITCHED 63: DOUBLE PRECISION, POINTER :: PINTERPCOORDS(:), PENERGY
  64: INTEGER INVERT, INDEX(NATOMS), IMATCH
  65: LOGICAL PERMUTE
  66: 
  67: LOGICAL TSCONVERGED, TSRESET
  68: DOUBLE PRECISION, DIMENSION(INTMUPDATE)     :: RHO1,ALPHA
  69: DOUBLE PRECISION :: EOLD, DIFF, DIST, DTOTAL, DMOVED(NATOMS)
  70: LOGICAL SWITCHED, LDEBUG
 57: DOUBLE PRECISION, POINTER :: X(:), G(:) 71: DOUBLE PRECISION, POINTER :: X(:), G(:)
  72: DOUBLE PRECISION, ALLOCATABLE :: GLOCAL(:), EWINDOW(:)
  73: !
  74: ! These declarations have to match those in NEB/ntc.f90
  75: !
  76: ! TYPE MINFOUNDTYPE
  77: !    DOUBLE PRECISION,POINTER :: E
  78: !    DOUBLE PRECISION,POINTER :: COORD(:)
  79: ! END TYPE MINFOUNDTYPE
  80: ! INTEGER,PARAMETER :: NMINMAX = 3000 ! Maximal number of min to be checked in one intlbfgs run
  81: TYPE (MINFOUNDTYPE) :: MYMINFOUND(NMINMAX)
  82: 
  83: ! INTEGER,PARAMETER :: NTSMAX = 3000 ! Maximal number of ts to be checked in one intlbfgs run
  84: ! TYPE TSFOUNDTYPE
  85: !      DOUBLE PRECISION,POINTER :: E
  86: !      DOUBLE PRECISION,POINTER :: EVALMIN
  87: !      DOUBLE PRECISION,POINTER :: COORD(:)
  88: !      DOUBLE PRECISION,POINTER :: VECS(:)
  89: ! END TYPE TSFOUNDTYPE
  90: 
  91: TYPE (TSFOUNDTYPE) :: MYTSFOUND(NTSMAX)
  92: 
  93: !
  94: ! If we USE NEBTOCONNECT then intlbfgs should have direct access to
  95: ! NTSFOUND, NMINFOUND, MINFOUND and TSFOUND. We should be able to delete
  96: ! the local variables, change MYTSFOUND and MYMINFOUND to TSFOUND and
  97: ! MINFOUND, and remove the subroutine arguments and LTSFOUND and LMINFOUND. 
  98: ! Not yet done, since INTLBFGSLJ needs to be changed in the same way. 
  99: !
 100: 
 58: !101: !
 59: ! efk: for freezenodes102: ! efk: for freezenodes
 60: !103: !
 61: DOUBLE PRECISION :: TESTG, TOTGNORM104: DOUBLE PRECISION :: TESTG, TOTGNORM
 62: INTEGER :: IM105: INTEGER :: IM
 63: !106: !
 64: ! Dimensions involving INTIMAGE107: ! Dimensions involving INTIMAGE
 65: !108: !
 66: DOUBLE PRECISION, ALLOCATABLE :: TRUEEE(:), &109: DOUBLE PRECISION, ALLOCATABLE :: TRUEEE(:), &
 67:   &              EEETMP(:), MYGTMP(:), EEE(:), STEPIMAGE(:), &110:   &              EEETMP(:), MYGTMP(:), EEE(:), STEPIMAGE(:), &
 68:   &              GTMP(:), DIAG(:), STP(:), SEARCHSTEP(:,:), GDIF(:,:), GLAST(:), XSAVE(:)111:   &              GTMP(:), DIAG(:), STP(:), SEARCHSTEP(:,:), GDIF(:,:), GLAST(:), XSAVE(:)
 69: DOUBLE PRECISION, ALLOCATABLE, TARGET :: XYZ(:), GGG(:), DPTMP(:), D2TMP(:,:)112: DOUBLE PRECISION, ALLOCATABLE, TARGET :: XYZ(:), GGG(:), DPTMP(:), D2TMP(:,:)
 70: ! saved interpolation 
 71: INTEGER BESTINTIMAGE, NSTEPS, NITERUSE 
 72: LOGICAL, ALLOCATABLE :: CHECKG(:), IMGFREEZE(:)113: LOGICAL, ALLOCATABLE :: CHECKG(:), IMGFREEZE(:)
 73: LOGICAL READIMAGET 
 74: INTEGER LUNIT, GETUNIT 
 75: CHARACTER(LEN=2) SDUMMY 
 76: INTEGER JMAXEEE,JMAXRMS 
 77: DOUBLE PRECISION MAXEEE,MAXRMS 
 78:  
 79: WHOLEDNEB=.FALSE. 
 80: READIMAGET=.TRUE. 
 81: READIMAGET=.FALSE. 
 82: IF (READIMAGET) THEN 
 83:    LUNIT=GETUNIT() 
 84:    OPEN(UNIT=LUNIT,FILE='restart.xyz',STATUS='OLD') 
 85:    INTIMAGE=0 
 86: 653 CONTINUE 
 87:    READ(LUNIT,*,END=654) NDUMMY 
 88:    READ(LUNIT,*)  
 89:    DO J1=1,NATOMS 
 90:       READ(LUNIT,*) SDUMMY, DUMMYX, DUMMYY, DUMMYZ 
 91: !     WRITE(*,'(A,I6,A2,3G20.10)') 'J1,sd,xd,yd,zd=',J1,SDUMMY, DUMMYX, DUMMYY, DUMMYZ 
 92:    ENDDO 
 93:    INTIMAGE=INTIMAGE+1 
 94:    GOTO 653 
 95: 654 CONTINUE 
 96:    INTIMAGE=INTIMAGE-2 
 97:    WRITE(*,'(A,I10,A)') 'intlbfgs> Rereading ',INTIMAGE,' frames' 
 98: ENDIF 
 99: 114: 
100: ALLOCATE(TRUEEE(INTIMAGE+2), &115: ALLOCATE(TRUEEE(INTIMAGE+2), &
101:   &      EEETMP(INTIMAGE+2), MYGTMP(3*NATOMS*INTIMAGE), &116:   &      EEETMP(INTIMAGE+2), MYGTMP(3*NATOMS*INTIMAGE), &
102:   &      GTMP(3*NATOMS*INTIMAGE), &117:   &      GTMP(3*NATOMS*INTIMAGE), &
103:   &      DIAG(3*NATOMS*INTIMAGE), STP(3*NATOMS*INTIMAGE), SEARCHSTEP(0:MUPDATE,(3*NATOMS)*INTIMAGE), &118:   &      DIAG(3*NATOMS*INTIMAGE), STP(3*NATOMS*INTIMAGE), SEARCHSTEP(0:INTMUPDATE,NOPT*INTIMAGE), &
104:   &      GDIF(0:MUPDATE,(3*NATOMS)*INTIMAGE),GLAST((3*NATOMS)*INTIMAGE), XSAVE((3*NATOMS)*INTIMAGE), &119:   &      GDIF(0:INTMUPDATE,NOPT*INTIMAGE),GLAST(NOPT*INTIMAGE), XSAVE(NOPT*INTIMAGE), &
105:   &      XYZ((3*NATOMS)*(INTIMAGE+2)), GGG((3*NATOMS)*(INTIMAGE+2)), CHECKG((3*NATOMS)*INTIMAGE), IMGFREEZE(INTIMAGE), &120:   &      XYZ(NOPT*(INTIMAGE+2)), GGG(NOPT*(INTIMAGE+2)), CHECKG(NOPT*INTIMAGE), IMGFREEZE(INTIMAGE), &
106:   &      EEE(INTIMAGE+2), STEPIMAGE(INTIMAGE))121:   &      EEE(INTIMAGE+2), STEPIMAGE(INTIMAGE))
107: 122: 
108: SWITCHED=.FALSE.123: SWITCHED=.FALSE.
109: INTIMAGESAVE=INTIMAGE124: INTIMAGESAVE=INTIMAGE
110: NBACKTRACK=1125: NBACKTRACK=1
111: CALL MYCPU_TIME(STIME,.FALSE.)126: CALL MYCPU_TIME(STIME,.FALSE.)
112: WRITE(*,'(A,I6)') ' intlbfgs> Maximum number of steps for constraint potential phase is ',INTSTEPS1127: PRINT '(A,I6)',' intlbfgs> Maximum number of steps for constraint potential phase is ',INTSTEPS1
113: WRITE(*,'(A,I6,A,G20.10)') ' intlbfgs> Updates: ',MUPDATE,' maximum step size=',MAXBFGS128: WRITE(*,'(A,I6)') ' intlbfgs> Updates: ',INTMUPDATE
 129: PREVGRAD=1.0D100
114: ADDATOM=.FALSE.130: ADDATOM=.FALSE.
 131: INTTST=.TRUE.  ! must set this before any possible exit
115: NFAIL=0132: NFAIL=0
116: IMGFREEZE(1:INTIMAGE)=.FALSE.133: IMGFREEZE(1:INTIMAGE)=.FALSE.
117: D=(3*NATOMS)*INTIMAGE134: D=NOPT*INTIMAGE
118: U=MUPDATE135: U=INTMUPDATE
119: NITERDONE=1136: NITERDONE=1
120: NITERUSE=1 
121: NQDONE=0 
122: 137: 
123: IF ( D<=0 ) THEN138: IF ( D<=0 ) THEN
124:    WRITE(*,*) 'd is not positive, d=',d139:    PRINT *, 'd is not positive, d=',d
 140:    CALL TSUMMARY
125:    STOP141:    STOP
126: ENDIF142: ENDIF
127: IF ( U<=0 ) THEN143: IF ( U<=0 ) THEN
128:    WRITE(*,*) 'u is not positive, u=',u144:    PRINT *, 'u is not positive, u=',u
 145:    CALL TSUMMARY
129:    STOP146:    STOP
130: ENDIF147: ENDIF
131: IF (INTSTEPS1 < 0) THEN148: IF (INTSTEPS1 < 0) THEN
132:    WRITE(*,'(1x,a)') 'Maximal number of iterations is less than zero! Stop.'149:    PRINT '(1x,a)', 'Maximal number of iterations is less than zero! Stop.'
 150:    CALL TSUMMARY
133:    STOP151:    STOP
134: ENDIF152: ENDIF
135: !153: !
136: ! XYZ, GGG, EEE include the end point images154: ! XYZ, GGG, EEE include the end point images
137: ! X, G do not.155: ! X, G do not.
138: !156: !
139: IF (.NOT.ALLOCATED(CONI)) THEN 157: IF (.NOT.ALLOCATED(CONI)) THEN 
140:    ALLOCATE(CONI(INTCONMAX),CONJ(INTCONMAX),CONDISTREF(INTCONMAX),CONCUT(INTCONMAX))158:    ALLOCATE(CONI(INTCONMAX),CONJ(INTCONMAX),CONDISTREF(INTCONMAX),CONCUT(INTCONMAX))
141:    ALLOCATE(REPI(NREPMAX),REPJ(NREPMAX),NREPI(NREPMAX),NREPJ(NREPMAX),REPCUT(NREPMAX),NREPCUT(NREPMAX))159:    ALLOCATE(REPI(NREPMAX),REPJ(NREPMAX),NREPI(NREPMAX),NREPJ(NREPMAX),REPCUT(NREPMAX),NREPCUT(NREPMAX))
142: ENDIF160: ENDIF
143: X=>XYZ((3*NATOMS)+1:(3*NATOMS)*(INTIMAGE+1))161: X=>XYZ(NOPT+1:NOPT*(INTIMAGE+1))
144: G=>GGG((3*NATOMS)+1:(3*NATOMS)*(INTIMAGE+1))162: G=>GGG(NOPT+1:NOPT*(INTIMAGE+1))
145: !163: !
146: ! Initialise XYZ164: ! Initialise XYZ
147: !165: !
148: IF (READIMAGET) THEN166: XYZ(1:NOPT)=QSTART(1:NOPT)
149:    REWIND(LUNIT)167: XYZ(NOPT*(INTIMAGE+1)+1:NOPT*(INTIMAGE+2))=QFINISH(1:NOPT)
150:    DO J2=1,INTIMAGE+2168: DO J1=1,INTIMAGE+2
151:       READ(LUNIT,*) NDUMMY169:    XYZ((J1-1)*NOPT+1:J1*NOPT)=((INTIMAGE+2-J1)*QSTART(1:NOPT)+(J1-1)*QFINISH(1:NOPT))/(INTIMAGE+1)
152:       READ(LUNIT,*) 170: ENDDO
153:       DO J1=1,NATOMS171:       WRITE(*,'(A)') 'intlbfgs> here Z'
154:          READ(LUNIT,*) SDUMMY,XYZ(3*NATOMS*(J2-1)+3*(J1-1)+1),XYZ(3*NATOMS*(J2-1)+3*(J1-1)+2),XYZ(3*NATOMS*(J2-1)+3*(J1-1)+3)172:       WRITE(*,'(6G20.10)') XYZ(3*(398-1)+1:3*(398-1)+3), &
155:       ENDDO173:   &                             XYZ((INTIMAGE+1)*3*NATOMS+3*(398-1)+1:(INTIMAGE+1)*3*NATOMS+3*(398-1)+3)
156:    ENDDO174:       WRITE(*,'(6G20.10)') XYZ(3*(400-1)+1:3*(400-1)+3), &
157:    CLOSE(LUNIT)175:   &                             XYZ((INTIMAGE+1)*3*NATOMS+3*(400-1)+1:(INTIMAGE+1)*3*NATOMS+3*(400-1)+3)
158: ELSE176:       WRITE(*,'(6G20.10)') QSTART(1:6)
159:    XYZ(1:(3*NATOMS))=QSTART(1:(3*NATOMS))177:       WRITE(*,'(6G20.10)') QFINISH(1:6)
160:    XYZ((3*NATOMS)*(INTIMAGE+1)+1:(3*NATOMS)*(INTIMAGE+2))=QFINISH(1:(3*NATOMS)) 
161:    DO J1=1,INTIMAGE+2 
162:       XYZ((J1-1)*(3*NATOMS)+1:J1*(3*NATOMS))=((INTIMAGE+2-J1)*QSTART(1:(3*NATOMS))+(J1-1)*QFINISH(1:(3*NATOMS)))/(INTIMAGE+1) 
163:    ENDDO 
164: ENDIF 
165: 178: 
166: NQCIFREEZE=0179: NQCIFREEZE=0
167: IF (FREEZE) THEN180: IF (FREEZE) THEN
168:    WRITE(*,'(A)') ' intlbfgs> ERROR *** QCI has not been coded for frozen atoms yet'181:    PRINT '(A)',' intlbfgs> ERROR *** QCI has not been coded for frozen atoms yet'
169:    STOP     182:    STOP     
170: ENDIF183: ENDIF
171: IF (ALLOCATED(INTFROZEN)) DEALLOCATE(INTFROZEN)184: IF (ALLOCATED(INTFROZEN)) DEALLOCATE(INTFROZEN)
172: ALLOCATE(INTFROZEN(NATOMS))185: ALLOCATE(INTFROZEN(NATOMS))
173: INTFROZEN(1:NATOMS)=.FALSE.186: INTFROZEN(1:NATOMS)=.FALSE.
174: DLIST(1:NATOMS)=-1187: DLIST(1:NATOMS)=-1
175: DMOVED(1:NATOMS)=1.0D100188: DMOVED(1:NATOMS)=1.0D100
176: IF (INTFREEZET) THEN189: IF (INTFREEZET) THEN
177:    DUMMY=INTFREEZETOL**2190:    DUMMY=INTFREEZETOL**2
 191:    PRINT '(A,6G20.10)',' intlbfgs> INTFREEZETOL,DUMMY=',INTFREEZETOL,DUMMY
178:    DO J1=1,NATOMS192:    DO J1=1,NATOMS
179:       DF=(XYZ(3*(J1-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+1))**2 &193:       DF=(XYZ(3*(J1-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+1))**2 &
180:   &     +(XYZ(3*(J1-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+2))**2 &194:   &     +(XYZ(3*(J1-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+2))**2 &
181:   &     +(XYZ(3*(J1-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+3))**2195:   &     +(XYZ(3*(J1-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+3))**2
182:       IF (DF.LT.DUMMY) THEN196:       IF (DF.LT.DUMMY) THEN
183:          NQCIFREEZE=NQCIFREEZE+1197:          NQCIFREEZE=NQCIFREEZE+1
184:          INTFROZEN(J1)=.TRUE.198:          INTFROZEN(J1)=.TRUE.
185:          IF (DEBUG) WRITE(*,'(A,I6,A,F12.6,A,I6)') &199:          IF (DEBUG) PRINT '(A,I6,A,F12.6,A,I6)',' intlbfgs> atom ',J1,' moves less than threshold: dist^2=',DF,' total=',NQCIFREEZE
186:   &            ' intlbfgs> atom ',J1,' moves less than threshold: dist^2=',DF,' total=',NQCIFREEZE 
187:       ENDIF200:       ENDIF
188:       sortd: DO J2=1,J1201:       sortd: DO J2=1,J1
189:          IF (DF.LT.DMOVED(J2)) THEN202:          IF (DF.LT.DMOVED(J2)) THEN
190:             DO J3=J1,J2+1,-1203:             DO J3=J1,J2+1,-1
191:                DMOVED(J3)=DMOVED(J3-1)204:                DMOVED(J3)=DMOVED(J3-1)
192:                DLIST(J3)=DLIST(J3-1)205:                DLIST(J3)=DLIST(J3-1)
193:             ENDDO206:             ENDDO
194:             DMOVED(J2)=DF207:             DMOVED(J2)=DF
195:             DLIST(J2)=J1208:             DLIST(J2)=J1
196:             EXIT sortd209:             EXIT sortd
197:          ENDIF210:          ENDIF
198:       ENDDO sortd211:       ENDDO sortd
199:    ENDDO212:    ENDDO
200:    WRITE(*,'(A,I6,A,F12.6,A,I6)') ' intlbfgs> Total number of atoms moving less than threshold=',NQCIFREEZE213:    PRINT '(A,I6,A,F12.6,A,I6)',' intlbfgs> Total number of atoms moving less than threshold=',NQCIFREEZE
201: ENDIF214: ENDIF
202: 215: 
 216:       WRITE(*,'(6G20.10)') XYZ(3*(398-1)+1:3*(398-1)+3), &
 217:   &                             XYZ((INTIMAGE+1)*3*NATOMS+3*(398-1)+1:(INTIMAGE+1)*3*NATOMS+3*(398-1)+3)
 218:       WRITE(*,'(6G20.10)') XYZ(3*(400-1)+1:3*(400-1)+3), &
 219:   &                             XYZ((INTIMAGE+1)*3*NATOMS+3*(400-1)+1:(INTIMAGE+1)*3*NATOMS+3*(400-1)+3)
 220: 
203: IF (NATOMS-NQCIFREEZE.LT.INTFREEZEMIN) THEN221: IF (NATOMS-NQCIFREEZE.LT.INTFREEZEMIN) THEN
204:    DO J1=NATOMS,NATOMS-INTFREEZEMIN+1,-1222:    DO J1=NATOMS,NATOMS-INTFREEZEMIN+1,-1
205:       INTFROZEN(DLIST(J1))=.FALSE.223:       INTFROZEN(DLIST(J1))=.FALSE.
206:    ENDDO224:    ENDDO
207:    NQCIFREEZE=MAX(0,NATOMS-INTFREEZEMIN)225:    NQCIFREEZE=NATOMS-INTFREEZEMIN
208:    WRITE(*,'(A,I6,A)') ' intlbfgs> Freezing ',NQCIFREEZE,' atoms'226:    PRINT '(A,I6,A)',' intlbfgs> Freezing ',NQCIFREEZE,' atoms'
209: ENDIF227: ENDIF
210: 228: 
211: NLASTGOODE=0229: NLASTGOODE=0
212: LASTGOODE=1.0D100230: LASTGOODE=1.0D100
213: 231: 
214: !232: !
215: ! Constraints are collected in a list and activated via the CONACTIVE(J1)233: ! Constraints are collected in a list and activated via the CONACTIVE(J1)
216: ! logical array. There will generally be of order NATOMS. However, the234: ! logical array. There will generally be of order NATOMS. However, the
217: ! repulsions will scale as NATOMS**2 and are treated differently. The235: ! repulsions will scale as NATOMS**2 and are treated differently. The
218: ! active repulsions are stored sequentially as atoms are added to the236: ! active repulsions are stored sequentially as atoms are added to the
221: ! via CHECKPERC, but the list of repulsions and cutoffs is recreated on239: ! via CHECKPERC, but the list of repulsions and cutoffs is recreated on
222: ! the fly. The fixed lists are used in make_conpot, since this is called240: ! the fly. The fixed lists are used in make_conpot, since this is called
223: ! for pairs of minima with all atoms active to obtain an interpolation241: ! for pairs of minima with all atoms active to obtain an interpolation
224: ! metric.242: ! metric.
225: !243: !
226: ! Perhaps we should use the fixed list to activate the repulsions below?244: ! Perhaps we should use the fixed list to activate the repulsions below?
227: ! A neighbour list for repulsions is maintained to make the constraint245: ! A neighbour list for repulsions is maintained to make the constraint
228: ! potential evaluation scale as order N.246: ! potential evaluation scale as order N.
229: !247: !
230: IF (NQCIFREEZE.LT.NATOMS) THEN248: IF (NQCIFREEZE.LT.NATOMS) THEN
231:    LXYZ(1:(3*NATOMS))=QSTART(1:(3*NATOMS))249:    LXYZ(1:NOPT)=QSTART(1:NOPT)
232:    LXYZ((3*NATOMS)+1:2*(3*NATOMS))=QFINISH(1:(3*NATOMS))250:    LXYZ(NOPT+1:2*NOPT)=QFINISH(1:NOPT)
233:    CALL CHECKPERC(LXYZ,LINTCONSTRAINTTOL,NQCIFREEZE,2)251:    CALL CHECKPERC(LXYZ,LINTCONSTRAINTTOL,NQCIFREEZE,2)
234: ELSE252: ELSE
235:    IF (.NOT.ALLOCATED(ATOMACTIVE)) ALLOCATE(ATOMACTIVE(NATOMS))253:    IF (.NOT.ALLOCATED(ATOMACTIVE)) ALLOCATE(ATOMACTIVE(NATOMS))
236:    NCONSTRAINT=0254:    NCONSTRAINT=0
237:    WRITE(*,'(A)') ' intlbfgs> All atoms move less than threshold - skip to linear interpolation for end points'255:    PRINT '(A)',' intlbfgs> All atoms move less than threshold - skip to linear interpolation for end points'
238:    INTIMAGE=0256:    INTIMAGE=0
239:    XYZ(1:(3*NATOMS))=QSTART(1:(3*NATOMS))257:    XYZ(1:NOPT)=QSTART(1:NOPT)
240:    XYZ((3*NATOMS)*(INTIMAGE+1)+1:(3*NATOMS)*(INTIMAGE+2))=QFINISH(1:(3*NATOMS))258:    XYZ(NOPT*(INTIMAGE+1)+1:NOPT*(INTIMAGE+2))=QFINISH(1:NOPT)
241:    DO J1=1,INTIMAGE+2259:    DO J1=1,INTIMAGE+2
242:       XYZ((J1-1)*(3*NATOMS)+1:J1*(3*NATOMS))=((INTIMAGE+2-J1)*QSTART(1:(3*NATOMS))+(J1-1)*QFINISH(1:(3*NATOMS)))/(INTIMAGE+1)260:       XYZ((J1-1)*NOPT+1:J1*NOPT)=((INTIMAGE+2-J1)*QSTART(1:NOPT)+(J1-1)*QFINISH(1:NOPT))/(INTIMAGE+1)
243:    ENDDO261:    ENDDO
244:    GOTO 678262:    GOTO 678
245: ENDIF263: ENDIF
246: 264: 
247: IF (READIMAGET) THEN 
248:    NACTIVE=NATOMS 
249:    DO J1=1,NATOMS 
250:       TURNONORDER(J1)=J1 ! fake initialisation 
251:    ENDDO 
252:    ATOMACTIVE(1:NATOMS)=.TRUE. 
253:    CONACTIVE(1:NCONSTRAINT)=.TRUE. 
254:    GLAST(1:D)=G(1:D) 
255:    XSAVE(1:D)=X(1:D) 
256:    GOTO 986 
257: ENDIF 
258: NACTIVE=0265: NACTIVE=0
259: TURNONORDER(1:NATOMS)=0266: TURNONORDER(1:NATOMS)=0
260: ATOMACTIVE(1:NATOMS)=.FALSE.267: ATOMACTIVE(1:NATOMS)=.FALSE.
261: IF (INTFREEZET) THEN268: IF (INTFREEZET) THEN
262:    DO J1=1,NATOMS269:    DO J1=1,NATOMS
263:       IF (INTFROZEN(J1)) THEN270:       IF (INTFROZEN(J1)) THEN
264: ! 271: ! 
265: ! linear interpolation 272: ! linear interpolation 
266: ! 273: ! 
267:          DO J2=2,INTIMAGE+1274:          DO J2=2,INTIMAGE+1
283: ALLOCATE(CONDISTREFLOCAL(NCONSTRAINT))290: ALLOCATE(CONDISTREFLOCAL(NCONSTRAINT))
284: ALLOCATE(CONCUTLOCAL(NCONSTRAINT))291: ALLOCATE(CONCUTLOCAL(NCONSTRAINT))
285: IF (ALLOCATED(CONDISTREFLOCALON)) DEALLOCATE(CONDISTREFLOCALON)292: IF (ALLOCATED(CONDISTREFLOCALON)) DEALLOCATE(CONDISTREFLOCALON)
286: IF (ALLOCATED(CONDISTREFON)) DEALLOCATE(CONDISTREFON)293: IF (ALLOCATED(CONDISTREFON)) DEALLOCATE(CONDISTREFON)
287: IF (ALLOCATED(CONION)) DEALLOCATE(CONION)294: IF (ALLOCATED(CONION)) DEALLOCATE(CONION)
288: IF (ALLOCATED(CONJON)) DEALLOCATE(CONJON)295: IF (ALLOCATED(CONJON)) DEALLOCATE(CONJON)
289: ALLOCATE(CONDISTREFLOCALON(NCONSTRAINT),CONDISTREFON(NCONSTRAINT),CONION(NCONSTRAINT),CONJON(NCONSTRAINT))296: ALLOCATE(CONDISTREFLOCALON(NCONSTRAINT),CONDISTREFON(NCONSTRAINT),CONION(NCONSTRAINT),CONJON(NCONSTRAINT))
290: CONDISTREFLOCAL(1:NCONSTRAINT)=CONDISTREF(1:NCONSTRAINT)297: CONDISTREFLOCAL(1:NCONSTRAINT)=CONDISTREF(1:NCONSTRAINT)
291: CONCUTLOCAL(1:NCONSTRAINT)=CONCUT(1:NCONSTRAINT)298: CONCUTLOCAL(1:NCONSTRAINT)=CONCUT(1:NCONSTRAINT)
292: DUMMY=1.0D100299: DUMMY=1.0D100
293: DUMMY2=-1.0D100 
294: IF (NCONSTRAINT.EQ.0) THEN300: IF (NCONSTRAINT.EQ.0) THEN
295:    NACTIVE=NATOMS301:    NACTIVE=NATOMS
296:    EOLD=ETOTAL302:    EOLD=ETOTAL
297:    SWITCHED=.TRUE.303:    SWITCHED=.TRUE.
298:    USEFRAC=1.0D0304:    USEFRAC=1.0D0
299:    NREPULSIVE=0305:    NREPULSIVE=0
300:    NNREPULSIVE=0306:    NNREPULSIVE=0
301:    GLAST(1:D)=G(1:D)307:    GLAST(1:D)=G(1:D)
302:    XSAVE(1:D)=X(1:D)308:    XSAVE(1:D)=X(1:D)
303:    GOTO 567309:    GOTO 567
304: ENDIF310: ENDIF
305: DO J1=1,NCONSTRAINT311: DO J1=1,NCONSTRAINT
306:    DF=SQRT((XYZ(3*(CONI(J1)-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+1))**2 &312:    DF=SQRT((XYZ(3*(CONI(J1)-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+1))**2 &
307:   &       +(XYZ(3*(CONI(J1)-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+2))**2 &313:   &       +(XYZ(3*(CONI(J1)-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+2))**2 &
308:   &       +(XYZ(3*(CONI(J1)-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+3))**2)&314:   &       +(XYZ(3*(CONI(J1)-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+3))**2)&
309:   &  +SQRT((XYZ(3*(CONJ(J1)-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+1))**2 &315:   &  +SQRT((XYZ(3*(CONJ(J1)-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+1))**2 &
310:   &       +(XYZ(3*(CONJ(J1)-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+2))**2 &316:   &       +(XYZ(3*(CONJ(J1)-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+2))**2 &
311:   &       +(XYZ(3*(CONJ(J1)-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+3))**2)317:   &       +(XYZ(3*(CONJ(J1)-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+3))**2)
312: !  IF (J1.EQ.3505) THEN318:    IF (J1.EQ.3505) THEN
313: !     WRITE(*,'(A,3I10)') 'intlbfgs> J1,CONI(J1),CONJ(J1)=',J1,CONI(J1),CONJ(J1)319:       WRITE(*,'(A,3I10)') 'intlbfgs> J1,CONI(J1),CONJ(J1)=',J1,CONI(J1),CONJ(J1)
314: !     WRITE(*,'(6G20.10)') XYZ(3*(CONI(J1)-1)+1:3*(CONI(J1)-1)+3), &320:       WRITE(*,'(6G20.10)') XYZ(3*(CONI(J1)-1)+1:3*(CONI(J1)-1)+3), &
315: ! &                             XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+1:(INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+3)321:   &                             XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+1:(INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+3)
316: !     WRITE(*,'(6G20.10)') XYZ(3*(CONJ(J1)-1)+1:3*(CONJ(J1)-1)+3), &322:       WRITE(*,'(6G20.10)') XYZ(3*(CONJ(J1)-1)+1:3*(CONJ(J1)-1)+3), &
317: ! &                             XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+1:(INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+3)323:   &                             XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+1:(INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+3)
318: !  ENDIF324:    ENDIF
319:    IF (DF.LT.DUMMY) THEN325:    IF (DF.LT.DUMMY) THEN
320:       NBEST=J1326:       NBEST=J1
321:       DUMMY=DF327:       DUMMY=DF
322:    ENDIF328:    ENDIF
323:    IF (DF.GT.DUMMY2) THEN 
324:       NBEST2=J1 
325:       DUMMY2=DF 
326:    ENDIF 
327: ENDDO329: ENDDO
328: IF (DEBUG) WRITE(*,'(A,I6,A,2I6,A,F15.5)') ' intlbfgs> Smallest overall motion for constraint ',NBEST, ' atoms ', &330: IF (DEBUG) PRINT '(A,I6,A,2I6,A,F15.5)',' intlbfgs> Smallest overall motion for constraint ',NBEST,' atoms ', &
329:   &                           CONI(NBEST),CONJ(NBEST),' distance=',DUMMY331:   &                           CONI(NBEST),CONJ(NBEST),' distance=',DUMMY
330: IF (DEBUG) WRITE(*,'(A,I6,A,2I6,A,F15.5)') ' intlbfgs> Largest overall motion for constraint  ',NBEST2,' atoms ', & 
331:   &                           CONI(NBEST2),CONJ(NBEST2),' distance=',DUMMY2 
332: 332: 
333: !!! NBEST=NBEST2 !!!! DJW 
334: NTRIES(1:NATOMS)=1333: NTRIES(1:NATOMS)=1
335: IF (ALLOCATED(CONACTIVE)) DEALLOCATE(CONACTIVE)334: IF (ALLOCATED(CONACTIVE)) DEALLOCATE(CONACTIVE)
336: ALLOCATE(CONACTIVE(NCONSTRAINT))335: IF (ALLOCATED(NITSTART)) DEALLOCATE(NITSTART)
 336: ALLOCATE(CONACTIVE(NCONSTRAINT),NITSTART(NCONSTRAINT))
337: CONACTIVE(1:NCONSTRAINT)=.FALSE.337: CONACTIVE(1:NCONSTRAINT)=.FALSE.
338: CONACTIVE(NBEST)=.TRUE.338: CONACTIVE(NBEST)=.TRUE.
 339: NITSTART(NBEST)=1
339: ATOMACTIVE(CONI(NBEST))=.TRUE.340: ATOMACTIVE(CONI(NBEST))=.TRUE.
340: ATOMACTIVE(CONJ(NBEST))=.TRUE.341: ATOMACTIVE(CONJ(NBEST))=.TRUE.
341: IF (.NOT.INTFROZEN(CONI(NBEST))) THEN342: IF (.NOT.INTFROZEN(CONI(NBEST))) THEN
342:    TURNONORDER(NACTIVE+1)=CONI(NBEST)343:    TURNONORDER(NACTIVE+1)=CONI(NBEST)
343:    NACTIVE=NACTIVE+1344:    NACTIVE=NACTIVE+1
344: ENDIF345: ENDIF
345: IF (.NOT.INTFROZEN(CONJ(NBEST))) THEN346: IF (.NOT.INTFROZEN(CONJ(NBEST))) THEN
346:    TURNONORDER(NACTIVE+1)=CONJ(NBEST)347:    TURNONORDER(NACTIVE+2)=CONJ(NBEST)
347:    NACTIVE=NACTIVE+1348:    NACTIVE=NACTIVE+1
348: ENDIF349: ENDIF
349: NTRIES(CONI(NBEST))=1350: NTRIES(CONI(NBEST))=1
350: NTRIES(CONJ(NBEST))=1351: NTRIES(CONJ(NBEST))=1
351: NREPULSIVE=0352: NREPULSIVE=0
352: NCONSTRAINTON=1353: NCONSTRAINTON=1
353: CONDISTREFLOCALON(1)=CONDISTREFLOCAL(NBEST)354: CONDISTREFLOCALON(1)=CONDISTREFLOCAL(NBEST)
354: CONDISTREFON(1)=CONDISTREF(NBEST)355: CONDISTREFON(1)=CONDISTREF(NBEST)
355: CONION(1)=CONI(NBEST)356: CONION(1)=CONI(NBEST)
356: CONJON(1)=CONJ(NBEST)357: CONJON(1)=CONJ(NBEST)
357: IF (DEBUG) WRITE(*,'(A,I6)') ' intlbfgs> Number of active atoms is now ',NACTIVE358: IF (DEBUG) PRINT '(A,I6)',' intlbfgs> Number of active atoms is now ',NACTIVE
358: !359: !
359: ! If INTFREEZET is true we need to add constraints and replusions to the frozen atoms.360: ! If INTFREEZET is true we need to add constraints and replusions to the frozen atoms.
360: ! ATOMACTIVE is .TRUE. for frozen atoms. 
361: !361: !
362: IF (INTFREEZET) THEN362: IF (INTFREEZET) THEN
363:    DO J1=1,NCONSTRAINT363: DO J1=1,NCONSTRAINT
364:       IF (CONACTIVE(J1)) CYCLE364:    IF (CONACTIVE(J1)) CYCLE
365:       IF ((CONI(J1).EQ.CONI(NBEST)).AND.(ATOMACTIVE(CONJ(J1))).OR.(CONJ(J1).EQ.CONI(NBEST)).AND.(ATOMACTIVE(CONI(J1)))) THEN365:    IF ((CONI(J1).EQ.CONI(NBEST)).AND.(ATOMACTIVE(CONJ(J1))).OR.(CONJ(J1).EQ.CONI(NBEST)).AND.(ATOMACTIVE(CONI(J1)))) THEN
366:          CONACTIVE(J1)=.TRUE.366:       CONACTIVE(J1)=.TRUE.
367:          IF (DEBUG) WRITE(*,'(A,I6,A,2I6)') ' intlbfgs> Turning on constraint ',J1,' for atoms ',CONI(J1),CONJ(J1)367:       IF (DEBUG) PRINT '(A,I6,A,2I6)',' intlbfgs> Turning on constraint ',J1,' for atoms ',CONI(J1),CONJ(J1)
368:       ENDIF368:    ENDIF
369:       IF ((CONI(J1).EQ.CONJ(NBEST)).AND.(ATOMACTIVE(CONJ(J1))).OR.(CONJ(J1).EQ.CONJ(NBEST)).AND.(ATOMACTIVE(CONI(J1)))) THEN369:    IF ((CONI(J1).EQ.CONJ(NBEST)).AND.(ATOMACTIVE(CONJ(J1))).OR.(CONJ(J1).EQ.CONJ(NBEST)).AND.(ATOMACTIVE(CONI(J1)))) THEN
370:          CONACTIVE(J1)=.TRUE.370:       CONACTIVE(J1)=.TRUE.
371:          IF (DEBUG) WRITE(*,'(A,I6,A,2I6)') ' intlbfgs> Turning on constraint ',J1,' for atoms ',CONI(J1),CONJ(J1)371:       IF (DEBUG) PRINT '(A,I6,A,2I6)',' intlbfgs> Turning on constraint ',J1,' for atoms ',CONI(J1),CONJ(J1)
372:       ENDIF372:    ENDIF
373:    ENDDO373: ENDDO
374: 374: 
375:    DO J1=1,NATOMS375: DO J1=1,NATOMS
376:       IF (.NOT.ATOMACTIVE(J1)) CYCLE ! identify active atoms376:    IF (.NOT.ATOMACTIVE(J1)) CYCLE ! identify active atoms
377:       IF (ABS(J1-CONI(NBEST)).LE.INTREPSEP) CYCLE ! no repulsion for atoms too close in sequence377:    IF (ABS(J1-CONI(NBEST)).LE.INTREPSEP) CYCLE ! no repulsion for atoms too close in sequence
378:       IF (INTFROZEN(J1).AND.INTFROZEN(CONI(NBEST))) CYCLE378:    IF (INTFROZEN(J1).AND.INTFROZEN(CONI(NBEST))) CYCLE
379:       DO J2=1,NCONSTRAINT379:    DO J2=1,NCONSTRAINT
380: !380: !
381: !  With MAXCONUSE set to a finite value there could be constraints for the new atom that are381: !  With MAXCONUSE set to a finite value there could be constraints for the new atom that are
382: !  not active. We don't want these to be changed to repulsion, surely?!382: !  not active. We don't want these to be changed to repulsion, surely?!
383: !  Or perhaps we do need to do something with them?383: !  Or perhaps we do need to do something with them?
384: !384: !
385:          IF (.NOT.CONACTIVE(J2)) CYCLE ! repulsions for constraints385:       IF (.NOT.CONACTIVE(J2)) CYCLE ! identify active constraints
386:          IF (((CONI(J2).EQ.J1).AND.(CONJ(J2).EQ.CONI(NBEST))).OR.((CONJ(J2).EQ.J1).AND.(CONI(J2).EQ.CONI(NBEST)))) GOTO 545386:       IF (((CONI(J2).EQ.J1).AND.(CONJ(J2).EQ.CONI(NBEST))).OR.((CONJ(J2).EQ.J1).AND.(CONI(J2).EQ.CONI(NBEST)))) GOTO 545
387:       ENDDO387:    ENDDO
388:       DMIN=1.0D100388:    DMIN=1.0D100
389:       DMAX=-1.0D0389:    DMAX=-1.0D0
390:       DO J2=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances390:    DO J2=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances
391:          DF=SQRT((XYZ((J2-1)*3*NATOMS+3*(CONI(NBEST)-1)+1)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+1))**2+ &391:       DF=SQRT((XYZ((J2-1)*3*NATOMS+3*(CONI(NBEST)-1)+1)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+1))**2+ &
392:   &           (XYZ((J2-1)*3*NATOMS+3*(CONI(NBEST)-1)+2)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+2))**2+ &392:   &           (XYZ((J2-1)*3*NATOMS+3*(CONI(NBEST)-1)+2)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+2))**2+ &
393:   &           (XYZ((J2-1)*3*NATOMS+3*(CONI(NBEST)-1)+3)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+3))**2)393:   &           (XYZ((J2-1)*3*NATOMS+3*(CONI(NBEST)-1)+3)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+3))**2)
394:          IF (DF.GT.DMAX) DMAX=DF394:       IF (DF.GT.DMAX) DMAX=DF
395:          IF (DF.LT.DMIN) DMIN=DF395:       IF (DF.LT.DMIN) DMIN=DF
396:       ENDDO396:    ENDDO
397: !397: !
398: ! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact.398: ! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact.
399: !399: !
400:       DMIN=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)400:    DMIN=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)
401:       NREPULSIVE=NREPULSIVE+1401:    NREPULSIVE=NREPULSIVE+1
402:       IF (NREPULSIVE.GT.NREPMAX) CALL REPDOUBLE402:    IF (NREPULSIVE.GT.NREPMAX) CALL REPDOUBLE
403:       REPI(NREPULSIVE)=J1403:    REPI(NREPULSIVE)=J1
404:       REPJ(NREPULSIVE)=CONI(NBEST)404:    REPJ(NREPULSIVE)=CONI(NBEST)
405:       REPCUT(NREPULSIVE)=DMIN405:    REPCUT(NREPULSIVE)=DMIN
406:       IF (DEBUG) WRITE(*,'(A,I6,A,I6,A,F15.5)') ' intlbfgs> Adding repulsion for new atom ',CONI(NBEST),' with atom ',J1, &406: !  IF (DEBUG) PRINT '(A,I6,A,I6,A,F15.5)',' intlbfgs> Adding repulsion for new atom ',CONI(NBEST),' with atom ',J1, &
407:   &                                          ' cutoff=',DMIN407: ! &                                          ' cutoff=',DMIN
408: 545   CONTINUE408: 545 CONTINUE
409:    ENDDO409: ENDDO
410: 410: 
411:    DO J1=1,NATOMS411: DO J1=1,NATOMS
412:       IF (.NOT.ATOMACTIVE(J1)) CYCLE ! identify active atoms412:    IF (ABS(J1-CONJ(NBEST)).LE.INTREPSEP) CYCLE ! no repulsion for atoms too close in sequence
413:       IF (ABS(J1-CONJ(NBEST)).LE.INTREPSEP) CYCLE ! no repulsion for atoms too close in sequence413:    IF (INTFROZEN(J1).AND.INTFROZEN(CONJ(NBEST))) CYCLE
414:       IF (INTFROZEN(J1).AND.INTFROZEN(CONJ(NBEST))) CYCLE414:    DO J2=1,NCONSTRAINT
415:       DO J2=1,NCONSTRAINT 
416: !415: !
417: !  With MAXCONUSE set to a finite value there could be constraints for the new atom that are416: !  With MAXCONUSE set to a finite value there could be constraints for the new atom that are
418: !  not active. We don't want these to be changed to repulsion, surely?!417: !  not active. We don't want these to be changed to repulsion, surely?!
419: !  Or perhaps we do need to do something with them?418: !  Or perhaps we do need to do something with them?
420: !419: !
421:          IF (.NOT.CONACTIVE(J2)) CYCLE ! identify active constraints420:       IF (.NOT.CONACTIVE(J2)) CYCLE ! identify active constraints
422:          IF (((CONI(J2).EQ.J1).AND.(CONJ(J2).EQ.CONJ(NBEST))).OR.((CONJ(J2).EQ.J1).AND.(CONI(J2).EQ.CONJ(NBEST)))) GOTO 541421:       IF (((CONI(J2).EQ.J1).AND.(CONJ(J2).EQ.CONJ(NBEST))).OR.((CONJ(J2).EQ.J1).AND.(CONI(J2).EQ.CONJ(NBEST)))) GOTO 541
423:       ENDDO422:    ENDDO
424:       DMIN=1.0D100423:    DMIN=1.0D100
425:       DMAX=-1.0D0424:    DMAX=-1.0D0
426:       DO J2=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances425:    DO J2=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances
427:          DF=SQRT((XYZ((J2-1)*3*NATOMS+3*(CONJ(NBEST)-1)+1)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+1))**2+ &426:       DF=SQRT((XYZ((J2-1)*3*NATOMS+3*(CONJ(NBEST)-1)+1)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+1))**2+ &
428:   &           (XYZ((J2-1)*3*NATOMS+3*(CONJ(NBEST)-1)+2)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+2))**2+ &427:   &           (XYZ((J2-1)*3*NATOMS+3*(CONJ(NBEST)-1)+2)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+2))**2+ &
429:   &           (XYZ((J2-1)*3*NATOMS+3*(CONJ(NBEST)-1)+3)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+3))**2)428:   &           (XYZ((J2-1)*3*NATOMS+3*(CONJ(NBEST)-1)+3)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+3))**2)
430:          IF (DF.GT.DMAX) DMAX=DF429:       IF (DF.GT.DMAX) DMAX=DF
431:          IF (DF.LT.DMIN) DMIN=DF430:       IF (DF.LT.DMIN) DMIN=DF
432:       ENDDO431:    ENDDO
433: !432: !
434: ! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact.433: ! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact.
435: !434: !
436:       DMIN=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)435:    DMIN=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)
437:       NREPULSIVE=NREPULSIVE+1436:    NREPULSIVE=NREPULSIVE+1
438:       IF (NREPULSIVE.GT.NREPMAX) CALL REPDOUBLE437:    IF (NREPULSIVE.GT.NREPMAX) CALL REPDOUBLE
439:       REPI(NREPULSIVE)=J1438:    REPI(NREPULSIVE)=J1
440:       REPJ(NREPULSIVE)=CONJ(NBEST)439:    REPJ(NREPULSIVE)=CONJ(NBEST)
441:       REPCUT(NREPULSIVE)=DMIN440:    REPCUT(NREPULSIVE)=DMIN
442:       IF (DEBUG) WRITE(*,'(A,I6,A,I6,A,F15.5)') ' intlbfgs> Adding repulsion for new atom ',CONJ(NBEST),' with atom ',J1, &441: !  IF (DEBUG) PRINT '(A,I6,A,I6,A,F15.5)',' intlbfgs> Adding repulsion for new atom ',CONJ(NBEST),' with atom ',J1, &
443:   &                                          ' cutoff=',DMIN442: ! &                                          ' cutoff=',DMIN
444: 541   CONTINUE443: 541 CONTINUE
445:    ENDDO444: ENDDO
446: ENDIF ! end of block to add constraints and repulstions for frozen atoms.445: ENDIF
447: CALL MYCPU_TIME(FTIME,.FALSE.)446: CALL MYCPU_TIME(FTIME,.FALSE.)
448: WRITE(*,'(A,F10.1,A,I6)') ' intlbfgs> constrained potential finished, time=',FTIME-STIME,' number of repulsions=',NREPULSIVE447: PRINT '(A,F10.1)',' intlbfgs> constrained potential finished, time=',FTIME-STIME
449: 986 CONTINUE 
450: STIME=FTIME448: STIME=FTIME
451: NSTEPSMAX=INTSTEPS1 
452: !449: !
453: ! Don;t want to redistribute images before even taking a step, so don;t call CHECKSEP.450: ! Don;t want to redistribute images before even taking a step, so don;t call CHECKSEP.
454: ! Must call CHECKREP to initialise NNREULSIVE, NREPI, NREPJ, etc. SEGV otherwise on second cycle!451: ! Must call CHECKREP to initialise NNREULSIVE, NREPI, NREPJ, etc. SEGV otherwise on second cycle!
455: !452: !
456: ! To take BH-type steps in the QCI space, jump back here. Leave SWITCHED true.453: CALL CHECKREP(INTIMAGE,XYZ,NOPT,0,1)
457: !454: IF (CHECKCONINT) THEN
458: BESTWORST=1.0D100 
459: 9876 CONTINUE 
460: CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),0,1) 
461: IF (QCIADDREP.GT.0) THEN 
462:    CALL CONGRAD3(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS) 
463: ELSEIF (CHECKCONINT) THEN 
464:    CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)455:    CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
465: ELSE456: ELSE
466:    CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)457:    CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
467: ENDIF458: ENDIF
468: EOLD=ETOTAL459: EOLD=ETOTAL
469: GLAST(1:D)=G(1:D)460: GLAST(1:D)=G(1:D)
470: XSAVE(1:D)=X(1:D)461: XSAVE(1:D)=X(1:D)
471: 462: 
472: IF (ETOTAL/INTIMAGE.LT.COLDFUSIONLIMIT) THEN463: IF (ETOTAL/INTIMAGE.LT.COLDFUSIONLIMIT) THEN
473:    WRITE(*,'(A,2G20.10)') ' intlbfgs> Cold fusion diagnosed - step discarded, energy, limit=', &464:    WRITE(*,'(A,2G20.10)') ' intlbfgs> Cold fusion diagnosed - step discarded, energy, limit=', &
474:   &                       ETOTAL/INTIMAGE,COLDFUSIONLIMIT465:   &                       ETOTAL/INTIMAGE,COLDFUSIONLIMIT
475:    DEALLOCATE(CONI,CONJ,CONDISTREF,REPI,REPJ,NREPI,NREPJ,REPCUT,NREPCUT,CONCUT)466:    DEALLOCATE(CONI,CONJ,CONDISTREF,REPI,REPJ,NREPI,NREPJ,REPCUT,NREPCUT,CONCUT)
476:    DEALLOCATE(TRUEEE, EEETMP, MYGTMP, GTMP, &467:    DEALLOCATE(TRUEEE, EEETMP, MYGTMP, GTMP, &
477:   &      DIAG, STP, SEARCHSTEP, GDIF,GLAST, XSAVE, XYZ, GGG, CHECKG, IMGFREEZE, EEE, STEPIMAGE)468:   &      DIAG, STP, SEARCHSTEP, GDIF,GLAST, XSAVE, XYZ, GGG, CHECKG, IMGFREEZE, EEE, STEPIMAGE)
478:    INTIMAGE=INTIMAGESAVE469:    INTIMAGE=INTIMAGESAVE
 470:    LTSFOUND=0
 471:    LMINFOUND=0
479:    RETURN472:    RETURN
480: ENDIF473: ENDIF
481: 474: 
482: ! IF (DEBUG) WRITE(*,'(A6,A20,A20,A9,A9)') 'Iter','Energy per image','RMS Force','Step'475: ! IF (DEBUG) WRITE(*,'(A6,A20,A20,A9,A9)') 'Iter','Energy per image','RMS Force','Step'
 476: NSTEPSMAX=INTSTEPS1
483: 477: 
484: 567 CONTINUE478: 567 CONTINUE
485: 479: 
486: DO ! Main do loop with counter NITERDONE, initially set to one480: DO ! Main do loop with counter NITERDONE, initially set to one
487: !481: !
488: !  Add next atom to active set if ADDATOM is true. 482: !  Add next atom to active set if ADDATOM is true. 
489: !  Constraints to atoms already in the active set are turned on483: !  Constraints to atoms already in the active set are turned on
490: !  and short-range repulsions to active atoms that are not distance constrained are turned on.484: !  and short-range repulsions to active atoms that are not distance constrained are turned on.
491: !  *** OLD Find nearest atom to active set attached by a constraint485: !  *** OLD Find nearest atom to active set attached by a constraint
492: !  *** NEW Find atom with most constraints to active set486: !  *** NEW Find atom with most constraints to active set
493: !  Turn on constraint terms for this atom with all previous members of the active set487: !  Turn on constraint terms for this atom with all previous members of the active set
494: !  Add repulsions to non-constrained atoms in this set488: !  Add repulsions to non-constrained atoms in this set
495: !  NTOADD is the number of atoms to add to the active set in each pass. 1 seems best!489: !  NTOADD is the number of atoms to add to the active set in each pass. 1 seems best!
496: !490: !
497:    IF (ADDATOM.AND.(NACTIVE.LT.NATOMS)) THEN491:    IF (ADDATOM.AND.(NACTIVE.LT.NATOMS)) THEN
498:  
499: !!!!!!!!!!!!!!!DEBUG DJW !!!!!!!!!!! 
500: !! 
501: !!               J2=0 
502: !!               DO J1=1,NREPULSIVEFIX 
503: !!!                 WRITE(*,'(A,3I10,4L5)') 'doaddatom> J1,REPIFIX,REPJFIX,frozenI,frozenJ,activeI,activeJ=', & 
504: !!! &                 J1,REPIFIX(J1),REPJFIX(J1),INTFROZEN(REPIFIX(J1)),INTFROZEN(REPJFIX(J1)), & 
505: !!! &                 ATOMACTIVE(REPIFIX(J1)),ATOMACTIVE(REPJFIX(J1)) 
506: !!                  IF (INTFROZEN(REPIFIX(J1)).AND.INTFROZEN(REPJFIX(J1))) CYCLE 
507: !!                  IF (ATOMACTIVE(REPIFIX(J1)).AND.ATOMACTIVE(REPJFIX(J1))) THEN 
508: !!                     DO J3=1,NCONSTRAINTFIX 
509: !!!                       IF (.NOT.CONACTIVE(J3)) CYCLE ! repulsions for inactive constraints 
510: !!                        IF ((CONIFIX(J3).EQ.REPIFIX(J1)).AND.(CONJFIX(J3).EQ.REPJFIX(J1))) GOTO 963 
511: !!                        IF ((CONIFIX(J3).EQ.REPJFIX(J1)).AND.(CONJFIX(J3).EQ.REPIFIX(J1))) GOTO 963 
512: !!                     ENDDO 
513: !!                     J2=J2+1 
514: !!!                    WRITE(*,'(A,I10,A,2I6)') 'doaddatom> repulsion ',J2,' between ',REPIFIX(J1),REPJFIX(J1) 
515: !!963                  CONTINUE 
516: !!                  ENDIF 
517: !!               ENDDO 
518: !!               WRITE(*,'(A,I6,A)') 'doaddatom> Looks like there are ',J2,' possible repulsions before adding new atom' 
519: !! 
520: !!               NDUMMY=1 
521: !!               NREPULSIVE=0 
522: !!               DO J1=1,NATOMS 
523: !!                  IF (.NOT.ATOMACTIVE(J1)) CYCLE 
524: !!! 
525: !!! Make a list of repelling atoms here and then use it 
526: !!! CONI(J2) is always less than CONJ(J2) so we only need to 
527: !!! cycle over a given range of constraints and continue from 
528: !!! where we left off for the next atom j1 
529: !!! 
530: !!                  ADDREP(1:J1+INTREPSEP)=.FALSE. 
531: !!                  ADDREP(J1+INTREPSEP+1:NATOMS)=.TRUE. ! no repulsion for atoms too close in sequence 
532: !!                  IF (INTFROZEN(J1)) THEN 
533: !!                     DO J2=J1+INTREPSEP+1,NATOMS 
534: !!                        IF (INTFROZEN(J2)) ADDREP(J2)=.FALSE. 
535: !!                        IF (.NOT.ATOMACTIVE(J2)) ADDREP(J2)=.FALSE. 
536: !!                     ENDDO 
537: !!                  ENDIF 
538: !!                  myaddloop: DO J2=NDUMMY,NCONSTRAINTFIX 
539: !!!                    IF (.NOT.CONACTIVE(J2)) CYCLE myaddloop ! repulsions for inactive constraints 
540: !!                     IF (CONIFIX(J2).EQ.J1) THEN 
541: !!                        ADDREP(CONJFIX(J2))=.FALSE. 
542: !!! 
543: !!! The next line is different from make_conpot because we don't count the constraints 
544: !!! sequentially, due to the ATOMACTIVE(J1) test at the top. 
545: !!! 
546: !!                     ELSEIF (CONIFIX(J2).GT.J1) THEN 
547: !!                        NDUMMY=J2 ! for next atom 
548: !!                        EXIT myaddloop 
549: !!                     ENDIF 
550: !!                  ENDDO myaddloop 
551: !!                  myrep2: DO J2=J1+INTREPSEP+1,NATOMS 
552: !!                     IF (.NOT.ADDREP(J2)) CYCLE myrep2 
553: !!                     IF (.NOT.ATOMACTIVE(J2)) CYCLE myrep2 ! This line is not in make_conpot, where we want all possible repulsions. 
554: !!                     DMIN=1.0D100 
555: !!                     DO J3=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances 
556: !!                        DF=SQRT((XYZ((J3-1)*3*NATOMS+3*(J2-1)+1)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+1))**2+ & 
557: !!    &                     (XYZ((J3-1)*3*NATOMS+3*(J2-1)+2)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+2))**2+ & 
558: !!    &                     (XYZ((J3-1)*3*NATOMS+3*(J2-1)+3)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+3))**2) 
559: !!                        IF (DF.LT.DMIN) DMIN=DF 
560: !!                     ENDDO 
561: !! 
562: !!                     NREPULSIVE=NREPULSIVE+1 
563: !!                     REPI(NREPULSIVE)=J1 
564: !!                     REPJ(NREPULSIVE)=J2 
565: !!!                    WRITE(*,'(A,I10,A,2I6)') 'doaddatom> repulsion ',NREPULSIVE,' between ',J1,J2 
566: !!! 
567: !!! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact. 
568: !!! 
569: !!                     REPCUT(NREPULSIVE)=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT) 
570: !!                  ENDDO myrep2 
571: !!               ENDDO 
572: !!               WRITE(*,'(A,I6,A)') ' intlbfgs> Now it looks like there are ',NREPULSIVE,' possible repulsions before adding new atom' 
573: !!!!!!!!!!!!!!!DEBUG DJW !!!!!!!!!!! 
574:  
575:       CALL DOADDATOM(NCONSTRAINT,NTRIES,NEWATOM,IMGFREEZE,INTIMAGE,XYZ,EEE,GGG,TURNONORDER,NITERDONE,NACTIVE)492:       CALL DOADDATOM(NCONSTRAINT,NTRIES,NEWATOM,IMGFREEZE,INTIMAGE,XYZ,EEE,GGG,TURNONORDER,NITERDONE,NACTIVE)
 493:       IF (FREEZENODEST) NIMAGEFREEZE=0
576:       NLASTGOODE=NITERDONE494:       NLASTGOODE=NITERDONE
577:       LASTGOODE=ETOTAL495:       LASTGOODE=ETOTAL
578:    ENDIF496:    ENDIF
579:    GTMP(1:D)=0.0D0497:    CALL MAKESTEP(NITERDONE,POINT,DIAG,INTIMAGE,SEARCHSTEP,G,GTMP,STP,GDIF,NPT,D,RHO1,ALPHA)
580:    CALL MAKESTEP(NITERUSE,POINT,DIAG,INTIMAGE,SEARCHSTEP,G,GTMP,STP,GDIF,NPT,D,RHO1,ALPHA) 
581: !498: !
582: ! If the number of images has changed since G was declared then G is not the same499: ! If the number of images has changed since G was declared then G is not the same
583: ! size as Gtmp and Dot_Product cannot be used.500: ! size as Gtmp and Dot_Product cannot be used.
584: !501: !
585: !  IF (Dot_Product(G,Gtmp)/SQRT( Dot_Product(G,G)*Dot_Product(Gtmp,Gtmp) ) > 0.0D0) THEN502: !  IF (Dot_Product(G,Gtmp)/SQRT( Dot_Product(G,G)*Dot_Product(Gtmp,Gtmp) ) > 0.0D0) THEN
586: !503: !
587: !  Separate sqrt;s to avoid overflow.504: !  Separate sqrt;s to avoid overflow.
588: !505: !
589:    IF (DDOT(D,G,1,GTMP,1)/MAX(1.0D-100,SQRT( DDOT(D,G,1,G,1))*SQRT(DDOT(D,GTMP,1,GTMP,1)) ) > 0.0D0) THEN506:    IF (DDOT(D,G,1,GTMP,1)/MAX(1.0D-100,SQRT( DDOT(D,G,1,G,1))*SQRT(DDOT(D,GTMP,1,GTMP,1)) ) > 0.0D0) THEN
590:         IF (DEBUG) WRITE(*,*) 'Search direction has positive projection onto gradient - reversing step'507:         IF (DEBUG) PRINT*,'Search direction has positive projection onto gradient - reversing step'
591:         GTMP(1:D)=-GTMP(1:D)508:         GTMP(1:D)=-GTMP(1:D)
592:         SEARCHSTEP(POINT,1:D)=GTMP(1:D)509:         SEARCHSTEP(POINT,1:D)=GTMP(1:D)
593:    ENDIF510:    ENDIF
594:    GTMP(1:D)=G(1:D)511:    GTMP(1:D)=G(1:D)
595: 512: 
596: !  We should apply the maximum LBFGS step to each image separately.513: !  We should apply the maximum LBFGS step to each image separately.
597: !  However, using different scale factors for different images leads to huge514: !  However, using different scale factors for different images leads to huge
598: !  discontinuities! Now take the minimum scale factor for all images. DJW 26/11/07515: !  discontinuities! Now take the minimum scale factor for all images. DJW 26/11/07
599: 516: 
600:    STPMIN=1.0D0517:    STPMIN=1.0D0
601:    DO J2=1,INTIMAGE518:    DO J2=1,INTIMAGE
602:       STEPIMAGE(J2) = SQRT(DOT_PRODUCT(SEARCHSTEP(POINT,(3*NATOMS)*(J2-1)+1:(3*NATOMS)*J2), &519:       STEPIMAGE(J2) = SQRT(DOT_PRODUCT(SEARCHSTEP(POINT,NOPT*(J2-1)+1:NOPT*J2),SEARCHSTEP(POINT,NOPT*(J2-1)+1:NOPT*J2)))
603:   &                                    SEARCHSTEP(POINT,(3*NATOMS)*(J2-1)+1:(3*NATOMS)*J2))) 
604:       DUMMY=STEPIMAGE(J2)520:       DUMMY=STEPIMAGE(J2)
605:       IF (STEPIMAGE(J2) > MAXBFGS) THEN521:       IF (STEPIMAGE(J2) > MAXINTBFGS) THEN
606:            STP((3*NATOMS)*(J2-1)+1:(3*NATOMS)*J2) = MAXBFGS/STEPIMAGE(J2)522:            STP(NOPT*(J2-1)+1:NOPT*J2) = MAXINTBFGS/STEPIMAGE(J2)
607:            STPMIN=MIN(STPMIN,STP((3*NATOMS)*(J2-1)+1))523:            STPMIN=MIN(STPMIN,STP(NOPT*(J2-1)+1))
608:       ENDIF524:       ENDIF
609: !     WRITE(*,'(A,I8,3G20.10)') ' image,initial step size,STP,prod=',J2,DUMMY,STP(3*NATOMS*(J2-1)+1), &525: !     PRINT '(A,I8,3G20.10)',' image,initial step size,STP,prod=',J2,DUMMY,STP(NOPT*(J2-1)+1),STEPIMAGE(J2)*STP(NOPT*(J2-1)+1)
610: ! &                                   STEPIMAGE(J2)*STP(3*NATOMS*(J2-1)+1)    
611:    ENDDO526:    ENDDO
612:    STP(1:D)=STPMIN527:    STP(1:D)=STPMIN
 528: 
613: ! EFK: decide whether to freeze some nodes529: ! EFK: decide whether to freeze some nodes
614:    IF (FREEZENODEST) THEN530:    IF (FREEZENODEST) THEN
615:       TOTGNORM=SQRT(DOT_PRODUCT(G(1:(3*NATOMS)*INTIMAGE),G(1:(3*NATOMS)*INTIMAGE))/INTIMAGE)531:       TOTGNORM=SQRT(DOT_PRODUCT(G(1:NOPT*INTIMAGE),G(1:NOPT*INTIMAGE))/INTIMAGE)
616:       NIMAGEFREEZE=0532:       NIMAGEFREEZE=0
617:       DO IM=1,INTIMAGE533:       DO IM=1,INTIMAGE
618:          TESTG=SQRT(DOT_PRODUCT(G((3*NATOMS)*(IM-1)+1:(3*NATOMS)*IM),G((3*NATOMS)*(IM-1)+1:(3*NATOMS)*IM)))534:          TESTG=SQRT(DOT_PRODUCT(G(NOPT*(IM-1)+1:NOPT*IM),G(NOPT*(IM-1)+1:NOPT*IM)))
619:          IMGFREEZE(IM)=.FALSE.535:          IMGFREEZE(IM)=.FALSE.
620:          IF (TOTGNORM.NE.0.0D0) THEN536:          IF (TOTGNORM.NE.0.0D0) THEN
621: !           IF (TESTG/TOTGNORM.LT.FREEZETOL) THEN537: !           IF (TESTG/TOTGNORM.LT.FREEZETOL) THEN
622:             IF (TESTG/SQRT(3.0D0*NATOMS).LT.FREEZETOL) THEN538:             IF (TESTG/SQRT(3.0D0*NATOMS).LT.FREEZETOL) THEN
623: !              IF (DEBUG) PRINT '(A,I6,3G20.10)', ' intlbfgs> Freezing image: ',IM,TESTG,FREEZETOL,TOTGNORM539: !              IF (DEBUG) PRINT '(A,I6,3G20.10)', ' intlbfgs> Freezing image: ',IM,TESTG,FREEZETOL,TOTGNORM
624:                IMGFREEZE(IM)=.TRUE.540:                IMGFREEZE(IM)=.TRUE.
625:                STEPIMAGE(IM)=0.0D0541:                STEPIMAGE(IM)=0.0D0
626:                NIMAGEFREEZE=NIMAGEFREEZE+1542:                NIMAGEFREEZE=NIMAGEFREEZE+1
627:                STP((3*NATOMS)*(IM-1)+1:(3*NATOMS)*IM)=0.0D0543:                STP(NOPT*(IM-1)+1:NOPT*IM)=0.0D0
628:             ENDIF544:             ENDIF
629:          ENDIF545:          ENDIF
630:       ENDDO546:       ENDDO
631:       IF (DEBUG) PRINT '(2(A,I6))', ' intlbfgs> Number of frozen images=',NIMAGEFREEZE,' / ',INTIMAGE547:       IF (DEBUG) PRINT '(2(A,I6))', ' intlbfgs> Number of frozen images=',NIMAGEFREEZE,' / ',INTIMAGE
632:    ENDIF548:    ENDIF
633:    !  We now have the proposed step - update geometry and calculate new gradient549:    !  We now have the proposed step - update geometry and calculate new gradient
634:    NDECREASE=0550:    NDECREASE=0
635: 20 X(1:D) = X(1:D) + STP(1:D)*SEARCHSTEP(POINT,1:D)551: 20 X(1:D) = X(1:D) + STP(1:D)*SEARCHSTEP(POINT,1:D)
636: 552: 
637: !  IF (.NOT.SWITCHED) THEN553: !  IF (.NOT.SWITCHED) THEN
638:    IF (.TRUE.) THEN554:    IF (.TRUE.) THEN
639: !     IF ((RMS.LT.INTRMSTOL*1.0D10).AND.(MOD(NITERDONE,10).EQ.0).AND.(NSTEPSMAX-NITERDONE.GT.100)) &555: !     IF ((RMS.LT.INTRMSTOL*1.0D10).AND.(MOD(NITERDONE,10).EQ.0).AND.(NSTEPSMAX-NITERDONE.GT.100)) &
640: ! &               CALL CHECKSEP(NMAXINT,NMININT,INTIMAGE,XYZ,(3*NATOMS),NATOMS)556: ! &               CALL CHECKSEP(NMAXINT,NMININT,INTIMAGE,XYZ,NOPT,NATOMS)
641:       IF (MOD(NITERDONE,INTIMAGECHECK).EQ.0) THEN557:       IF (MOD(NITERDONE,INTIMAGECHECK).EQ.0) THEN
642: 864      CONTINUE ! for adding more than one image at a time558: 864      CONTINUE ! for adding more than one image at a time
643:          DMAX=-1.0D0559:          DMAX=0.0D0
644:          ADMAX=-1.0D0 
645:          DMIN=HUGE(1.0D0)560:          DMIN=HUGE(1.0D0)
646:          DO J1=1,INTIMAGE+1561:          DO J1=1,INTIMAGE+1
647:             DUMMY=0.0D0562:             DUMMY=0.0D0
648: !           DO J2=1,3*NATOMS563:             DO J2=1,3*NATOMS
649: !              IF (ATOMACTIVE((J2-1)/3+1)) THEN564:                IF (ATOMACTIVE((J2-1)/3+1)) THEN
650: !                 DUMMY=DUMMY+( XYZ((J1-1)*3*NATOMS+J2) - XYZ(J1*3*NATOMS+J2) )**2565:                   DUMMY=DUMMY+( XYZ((J1-1)*3*NATOMS+J2) - XYZ(J1*3*NATOMS+J2) )**2
651: !              ENDIF 
652: !           ENDDO 
653:             DO J2=1,NATOMS 
654:                IF (ATOMACTIVE(J2)) THEN 
655:                   ADUMMY=( XYZ((J1-1)*3*NATOMS+3*(J2-1)+1) - XYZ(J1*3*NATOMS+3*(J2-1)+1) )**2 & 
656:   &                     +( XYZ((J1-1)*3*NATOMS+3*(J2-1)+2) - XYZ(J1*3*NATOMS+3*(J2-1)+2) )**2 & 
657:   &                     +( XYZ((J1-1)*3*NATOMS+3*(J2-1)+3) - XYZ(J1*3*NATOMS+3*(J2-1)+3) )**2  
658:                   DUMMY=DUMMY+ADUMMY 
659:                   IF (ADUMMY.GT.ADMAX) THEN 
660:                      ADMAX=ADUMMY 
661:                      JA1=J1 
662:                      JA2=J2 
663:                   ENDIF 
664:                ENDIF566:                ENDIF
665:             ENDDO567:             ENDDO
666:             DUMMY=SQRT(DUMMY)568:             DUMMY=SQRT(DUMMY)
667:             IF (DUMMY.GT.DMAX) THEN569:             IF (DUMMY.GT.DMAX) THEN
668:                DMAX=DUMMY570:                DMAX=DUMMY
669:                JMAX=J1571:                JMAX=J1
670:             ENDIF572:             ENDIF
671:             IF (DUMMY.LT.DMIN) THEN573:             IF (DUMMY.LT.DMIN) THEN
672:                DMIN=DUMMY574:                DMIN=DUMMY
673:                JMIN=J1575:                JMIN=J1
674:             ENDIF576:             ENDIF
675: !            IF (DEBUG) WRITE(*,'(A,I6,A,I6,A,G20.10)')' intlbfgs> distance between images ', &577: !           IF (DEBUG) PRINT '(A,I6,A,I6,A,G20.10)',' intlbfgs> distance between images ', &
676: !  &                                                  J1,' and ',J1+1,' is ',DUMMY578: ! &                                                  J1,' and ',J1+1,' is ',DUMMY
677: !            IF (DEBUG) WRITE(*,'(A,G20.10,A,I6,A,2I6)')' intlbfgs> largest atomic distance between images so far is ', & 
678: !  &                                                  SQRT(ADMAX),' for atom ',JA2,' and images ',JA1,JA1+1 
679:          ENDDO579:          ENDDO
680: !        IF (DEBUG) WRITE(*,'(A,G20.10,A,I6,A,2I6,A,I6)')' intlbfgs> largest atomic distance between images is ', &580:          IF ((DMAX.GT.IMSEPMAX).AND.(INTIMAGE.LT.MAXINTIMAGE).AND.(.NOT.SWITCHED)) THEN
681: ! &                                                  SQRT(ADMAX),' for atom ',JA2,' and images ',JA1,JA1+1,' total images=',INTIMAGE581:             PRINT '(A,I6,A,I6)',' intlbfgs> Add an image between ',JMAX,' and ',JMAX+1
682: !        IF (DEBUG) WRITE(*,'(A,G20.10,A,2I6)')' intlbfgs> largest image separation is ', & 
683: ! &                                                  DMAX,' for images ',JMAX,JMAX+1 
684: !        IF (DEBUG) WRITE(*,'(A,G20.10,A,2I6)')' intlbfgs> smallest image separation is ', & 
685: ! &                                                  DMIN,' for images ',JMIN,JMIN+1 
686: !        IF (DEBUG) WRITE(*,'(A,G20.10,A,G20.10)') ' intlbfgs> Mean image separation=',DUMMY2/(INTIMAGE+1),' per active atom=',DUMMY2/((INTIMAGE+1)*NACTIVE) 
687: !        IF ((DMAX.GT.IMSEPMAX).AND.(INTIMAGE.LT.MAXINTIMAGE)) THEN 
688:          IF ((SQRT(ADMAX).GT.IMSEPMAX).AND.(INTIMAGE.LT.MAXINTIMAGE)) THEN 
689:             JMAX=JA1 
690:             WRITE(*,'(A,I6,A,I6,A,I6)') ' intlbfgs> Add an image between ',JMAX,' and ',JMAX+1,' INTIMAGE=',INTIMAGE 
691:             NITERUSE=0 
692:             ALLOCATE(DPTMP(3*NATOMS*(INTIMAGE+2)))582:             ALLOCATE(DPTMP(3*NATOMS*(INTIMAGE+2)))
693:             DPTMP(1:3*NATOMS*(INTIMAGE+2))=XYZ(1:3*NATOMS*(INTIMAGE+2))583:             DPTMP(1:3*NATOMS*(INTIMAGE+2))=XYZ(1:3*NATOMS*(INTIMAGE+2))
694:             DEALLOCATE(XYZ)584:             DEALLOCATE(XYZ)
695:             ALLOCATE(XYZ(3*NATOMS*(INTIMAGE+3)))585:             ALLOCATE(XYZ(3*NATOMS*(INTIMAGE+3)))
696:             XYZ(1:3*NATOMS*JMAX)=DPTMP(1:3*NATOMS*JMAX)586:             XYZ(1:3*NATOMS*JMAX)=DPTMP(1:3*NATOMS*JMAX)
697:             XYZ(3*NATOMS*JMAX+1:3*NATOMS*(JMAX+1))=(DPTMP(3*NATOMS*(JMAX-1)+1:3*NATOMS*JMAX) &587:             XYZ(3*NATOMS*JMAX+1:3*NATOMS*(JMAX+1))=(DPTMP(3*NATOMS*(JMAX-1)+1:3*NATOMS*JMAX) &
698:   &                                               + DPTMP(3*NATOMS*JMAX+1:3*NATOMS*(JMAX+1)))/2.0D0588:   &                                               + DPTMP(3*NATOMS*JMAX+1:3*NATOMS*(JMAX+1)))/2.0D0
699:             XYZ(3*NATOMS*(JMAX+1)+1:3*NATOMS*(INTIMAGE+3))=DPTMP(3*NATOMS*JMAX+1:3*NATOMS*(INTIMAGE+2))589:             XYZ(3*NATOMS*(JMAX+1)+1:3*NATOMS*(INTIMAGE+3))=DPTMP(3*NATOMS*JMAX+1:3*NATOMS*(INTIMAGE+2))
700: !590: !
701: ! Save step-taking memories in SEARCHSTEP and GDIF.591: ! Save step-taking memories in SEARCHSTEP and GDIF.
702: ! These arrays run from 0 to MUPDATE over memories and592: ! These arrays run from 0 to INTMUPDATE over memories and
703: ! 1:(3*NATOMS)*INTIMAGE over only the variable images.593: ! 1:NOPT*INTIMAGE over only the variable images.
704: !594: !
705:             DEALLOCATE(DPTMP)595:             DEALLOCATE(DPTMP)
706:             ALLOCATE(D2TMP(0:MUPDATE,1:(3*NATOMS)*INTIMAGE))596:             ALLOCATE(D2TMP(0:INTMUPDATE,1:NOPT*INTIMAGE))
707:             D2TMP(0:MUPDATE,1:(3*NATOMS)*INTIMAGE)=SEARCHSTEP(0:MUPDATE,1:(3*NATOMS)*INTIMAGE)597:             D2TMP(0:INTMUPDATE,1:NOPT*INTIMAGE)=SEARCHSTEP(0:INTMUPDATE,1:NOPT*INTIMAGE)
708:             DEALLOCATE(SEARCHSTEP)598:             DEALLOCATE(SEARCHSTEP)
709:             ALLOCATE(SEARCHSTEP(0:MUPDATE,1:(3*NATOMS)*(INTIMAGE+1)))599:             ALLOCATE(SEARCHSTEP(0:INTMUPDATE,1:NOPT*(INTIMAGE+1)))
710:             DO J1=0,MUPDATE600:             DO J1=0,INTMUPDATE
711:                IF (JMAX.GT.1) SEARCHSTEP(J1,1:3*NATOMS*(JMAX-1))=D2TMP(J1,1:3*NATOMS*(JMAX-1))601:                IF (JMAX.GT.1) SEARCHSTEP(J1,1:3*NATOMS*(JMAX-1))=D2TMP(J1,1:3*NATOMS*(JMAX-1))
712:                IF (JMAX.LT.INTIMAGE+1) SEARCHSTEP(J1,3*NATOMS*JMAX+1:3*NATOMS*(INTIMAGE+1))= &602:                IF (JMAX.LT.INTIMAGE+1) SEARCHSTEP(J1,3*NATOMS*JMAX+1:3*NATOMS*(INTIMAGE+1))= &
713:   &                 D2TMP(J1,3*NATOMS*(JMAX-1)+1:3*NATOMS*INTIMAGE)603:   &                 D2TMP(J1,3*NATOMS*(JMAX-1)+1:3*NATOMS*INTIMAGE)
714:                SEARCHSTEP(J1,3*NATOMS*(JMAX-1)+1:3*NATOMS*JMAX)= &604:                SEARCHSTEP(J1,3*NATOMS*(JMAX-1)+1:3*NATOMS*JMAX)= &
715:   &                             D2TMP(J1,3*NATOMS*(MIN(JMAX,INTIMAGE)-1)+1:3*NATOMS*MIN(JMAX,INTIMAGE))605:   &                             D2TMP(J1,3*NATOMS*(MIN(JMAX,INTIMAGE)-1)+1:3*NATOMS*MIN(JMAX,INTIMAGE))
716:             ENDDO606:             ENDDO
717: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!607: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
718:             SEARCHSTEP(0:MUPDATE,1:(3*NATOMS)*(INTIMAGE+1))=0.0D0608:             SEARCHSTEP(0:INTMUPDATE,1:(3*NATOMS)*(INTIMAGE+1))=0.0D0
719: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!609: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
720:             D2TMP(0:MUPDATE,1:(3*NATOMS)*INTIMAGE)=GDIF(0:MUPDATE,1:(3*NATOMS)*INTIMAGE)610:             D2TMP(0:INTMUPDATE,1:NOPT*INTIMAGE)=GDIF(0:INTMUPDATE,1:NOPT*INTIMAGE)
721:             DEALLOCATE(GDIF)611:             DEALLOCATE(GDIF)
722:             ALLOCATE(GDIF(0:MUPDATE,1:(3*NATOMS)*(INTIMAGE+1)))612:             ALLOCATE(GDIF(0:INTMUPDATE,1:NOPT*(INTIMAGE+1)))
723:             DO J1=0,MUPDATE613:             DO J1=0,INTMUPDATE
724:                IF (JMAX.GT.1) GDIF(J1,1:3*NATOMS*(JMAX-1))=D2TMP(J1,1:3*NATOMS*(JMAX-1))614:                IF (JMAX.GT.1) GDIF(J1,1:3*NATOMS*(JMAX-1))=D2TMP(J1,1:3*NATOMS*(JMAX-1))
725:                IF (JMAX.LT.INTIMAGE+1) GDIF(J1,3*NATOMS*JMAX+1:3*NATOMS*(INTIMAGE+1))= &615:                IF (JMAX.LT.INTIMAGE+1) GDIF(J1,3*NATOMS*JMAX+1:3*NATOMS*(INTIMAGE+1))= &
726:   &                 D2TMP(J1,3*NATOMS*(JMAX-1)+1:3*NATOMS*INTIMAGE)616:   &                 D2TMP(J1,3*NATOMS*(JMAX-1)+1:3*NATOMS*INTIMAGE)
727:                GDIF(J1,3*NATOMS*(JMAX-1)+1:3*NATOMS*JMAX)= &617:                GDIF(J1,3*NATOMS*(JMAX-1)+1:3*NATOMS*JMAX)= &
728:   &                       D2TMP(J1,3*NATOMS*(MIN(JMAX,INTIMAGE)-1)+1:3*NATOMS*MIN(JMAX,INTIMAGE))618:   &                       D2TMP(J1,3*NATOMS*(MIN(JMAX,INTIMAGE)-1)+1:3*NATOMS*MIN(JMAX,INTIMAGE))
729:             ENDDO619:             ENDDO
730: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!620: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
731:             GDIF(0:MUPDATE,1:(3*NATOMS)*(INTIMAGE+1))=0.0D0621:             GDIF(0:INTMUPDATE,1:(3*NATOMS)*(INTIMAGE+1))=0.0D0
732: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!622: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
733:             DEALLOCATE(D2TMP)623:             DEALLOCATE(D2TMP)
734: 624: 
735:             DEALLOCATE(TRUEEE,EEETMP,MYGTMP,GTMP,GGG, &625:             DEALLOCATE(TRUEEE,EEETMP,MYGTMP,GTMP,GGG, &
736:   &                    DIAG,STP,GLAST,XSAVE,EEE,STEPIMAGE,CHECKG,IMGFREEZE)626:   &                    DIAG,STP,GLAST,XSAVE,EEE,STEPIMAGE,CHECKG,IMGFREEZE)
737:             ALLOCATE(TRUEEE(INTIMAGE+3), &627:             ALLOCATE(TRUEEE(INTIMAGE+3), &
738:   &                  EEETMP(INTIMAGE+3), MYGTMP(3*NATOMS*(INTIMAGE+1)), &628:   &                  EEETMP(INTIMAGE+3), MYGTMP(3*NATOMS*(INTIMAGE+1)), &
739:   &                  GTMP(3*NATOMS*(INTIMAGE+1)), &629:   &                  GTMP(3*NATOMS*(INTIMAGE+1)), &
740:   &                  DIAG(3*NATOMS*(INTIMAGE+1)), STP(3*NATOMS*(INTIMAGE+1)), &630:   &                  DIAG(3*NATOMS*(INTIMAGE+1)), STP(3*NATOMS*(INTIMAGE+1)), &
741:   &                  GLAST((3*NATOMS)*(INTIMAGE+1)), &631:   &                  GLAST(NOPT*(INTIMAGE+1)), &
742:   &                  XSAVE((3*NATOMS)*(INTIMAGE+1)), CHECKG((3*NATOMS)*(INTIMAGE+1)), IMGFREEZE(INTIMAGE+1), &632:   &                  XSAVE(NOPT*(INTIMAGE+1)), CHECKG(NOPT*(INTIMAGE+1)), IMGFREEZE(INTIMAGE+1), &
743:   &                  EEE(INTIMAGE+3), STEPIMAGE(INTIMAGE+1), GGG(3*NATOMS*(INTIMAGE+3)))633:   &                  EEE(INTIMAGE+3), STEPIMAGE(INTIMAGE+1), GGG(3*NATOMS*(INTIMAGE+3)))
744:             GGG(1:3*NATOMS*(INTIMAGE+3))=0.0D0634:             GGG(1:3*NATOMS*(INTIMAGE+3))=0.0D0
745:             TRUEEE(1:INTIMAGE+3)=0.0D0635:             TRUEEE(1:INTIMAGE+3)=0.0D0
746:             EEETMP(1:INTIMAGE+3)=0.0D0636:             EEETMP(1:INTIMAGE+3)=0.0D0
747:             MYGTMP(1:3*NATOMS*(INTIMAGE+1))=0.0D0637:             MYGTMP(1:3*NATOMS*(INTIMAGE+1))=0.0D0
748:             GTMP(1:3*NATOMS*(INTIMAGE+1))=0.0D0638:             GTMP(1:3*NATOMS*(INTIMAGE+1))=0.0D0
749:             DIAG(1:3*NATOMS*(INTIMAGE+1))=0.0D0639:             DIAG(1:3*NATOMS*(INTIMAGE+1))=0.0D0
750:             STP(1:3*NATOMS*(INTIMAGE+1))=0.0D0640:             STP(1:3*NATOMS*(INTIMAGE+1))=0.0D0
751:             GLAST(1:(3*NATOMS)*(INTIMAGE+1))=0.0D0641:             GLAST(1:NOPT*(INTIMAGE+1))=0.0D0
752:             XSAVE(1:(3*NATOMS)*(INTIMAGE+1))=0.0D0642:             XSAVE(1:NOPT*(INTIMAGE+1))=0.0D0
753:             CHECKG(1:(3*NATOMS)*(INTIMAGE+1))=.FALSE.643:             CHECKG(1:NOPT*(INTIMAGE+1))=.FALSE.
754:             IMGFREEZE(1:INTIMAGE+1)=.FALSE.644:             IMGFREEZE(1:INTIMAGE+1)=.FALSE.
755:             EEE(1:INTIMAGE+3)=0.0D0645:             EEE(1:INTIMAGE+3)=0.0D0
756:             STEPIMAGE(1:INTIMAGE+1)=0.0D0646:             STEPIMAGE(1:INTIMAGE+1)=0.0D0
757: 647: 
758:             X=>XYZ((3*NATOMS)+1:(3*NATOMS)*(INTIMAGE+2))648:             X=>XYZ(NOPT+1:NOPT*(INTIMAGE+2))
759:             G=>GGG((3*NATOMS)+1:(3*NATOMS)*(INTIMAGE+2))649:             G=>GGG(NOPT+1:NOPT*(INTIMAGE+2))
760:             INTIMAGE=INTIMAGE+1650:             INTIMAGE=INTIMAGE+1
761:             D=(3*NATOMS)*INTIMAGE651:             D=NOPT*INTIMAGE
762:             CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),0,1)652:             CALL CHECKREP(INTIMAGE,XYZ,NOPT,0,1)
763:             IF (QCIADDREP.GT.0) THEN653:             IF (CHECKCONINT) THEN
764:                CALL CONGRAD3(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS) 
765:             ELSEIF (CHECKCONINT) THEN 
766:                CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)654:                CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
767:             ELSE655:             ELSE
768:                CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)656:                CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
769:             ENDIF657:             ENDIF
770: !           GOTO 864658: !           GOTO 864
771:          ENDIF659:          ELSEIF ((DMIN.LT.IMSEPMIN).AND.(INTIMAGE.GT.1)) THEN
772:          IF ((DMIN.LT.IMSEPMIN).AND.(INTIMAGE.GT.1)) THEN 
773:             IF (JMIN.EQ.1) JMIN=2660:             IF (JMIN.EQ.1) JMIN=2
774:             WRITE(*,'(A,I6,A,I6)') ' intlbfgs> Remove image ',JMIN661:             PRINT '(A,I6,A,I6)',' intlbfgs> Remove image ',JMIN
775:             NITERUSE=0 
776:             ALLOCATE(DPTMP(3*NATOMS*(INTIMAGE+2)))662:             ALLOCATE(DPTMP(3*NATOMS*(INTIMAGE+2)))
777:             DPTMP(1:3*NATOMS*(INTIMAGE+2))=XYZ(1:3*NATOMS*(INTIMAGE+2))663:             DPTMP(1:3*NATOMS*(INTIMAGE+2))=XYZ(1:3*NATOMS*(INTIMAGE+2))
778:             DEALLOCATE(XYZ)664:             DEALLOCATE(XYZ)
779:             ALLOCATE(XYZ(3*NATOMS*(INTIMAGE+1)))665:             ALLOCATE(XYZ(3*NATOMS*(INTIMAGE+1)))
780:             XYZ(1:3*NATOMS*(JMIN-1))=DPTMP(1:3*NATOMS*(JMIN-1))666:             XYZ(1:3*NATOMS*(JMIN-1))=DPTMP(1:3*NATOMS*(JMIN-1))
781:             XYZ(3*NATOMS*(JMIN-1)+1:3*NATOMS*(INTIMAGE+1))=DPTMP(3*NATOMS*JMIN+1:3*NATOMS*(INTIMAGE+2))667:             XYZ(3*NATOMS*(JMIN-1)+1:3*NATOMS*(INTIMAGE+1))=DPTMP(3*NATOMS*JMIN+1:3*NATOMS*(INTIMAGE+2))
782: 668: 
783:             DEALLOCATE(DPTMP)669:             DEALLOCATE(DPTMP)
784: !670: !
785: ! Save step-taking memories in SEARCHSTEP and GDIF.671: ! Save step-taking memories in SEARCHSTEP and GDIF.
786: ! These arrays run from 0 to MUPDATE over memories and672: ! These arrays run from 0 to INTMUPDATE over memories and
787: ! 1:(3*NATOMS)*INTIMAGE over only the variable images.673: ! 1:NOPT*INTIMAGE over only the variable images.
788: !674: !
789:             ALLOCATE(D2TMP(0:MUPDATE,1:(3*NATOMS)*INTIMAGE))675:             ALLOCATE(D2TMP(0:INTMUPDATE,1:NOPT*INTIMAGE))
790:             D2TMP(0:MUPDATE,1:(3*NATOMS)*INTIMAGE)=SEARCHSTEP(0:MUPDATE,1:(3*NATOMS)*INTIMAGE)676:             D2TMP(0:INTMUPDATE,1:NOPT*INTIMAGE)=SEARCHSTEP(0:INTMUPDATE,1:NOPT*INTIMAGE)
791:             DEALLOCATE(SEARCHSTEP)677:             DEALLOCATE(SEARCHSTEP)
792:             ALLOCATE(SEARCHSTEP(0:MUPDATE,1:(3*NATOMS)*(INTIMAGE-1)))678:             ALLOCATE(SEARCHSTEP(0:INTMUPDATE,1:NOPT*(INTIMAGE-1)))
793:             DO J1=0,MUPDATE679:             DO J1=0,INTMUPDATE
794:                SEARCHSTEP(J1,1:3*NATOMS*(JMIN-2))=D2TMP(J1,1:3*NATOMS*(JMIN-2))680:                SEARCHSTEP(J1,1:3*NATOMS*(JMIN-2))=D2TMP(J1,1:3*NATOMS*(JMIN-2))
795:                SEARCHSTEP(J1,3*NATOMS*(JMIN-2)+1:3*NATOMS*(INTIMAGE-1))= &681:                SEARCHSTEP(J1,3*NATOMS*(JMIN-2)+1:3*NATOMS*(INTIMAGE-1))= &
796:   &                     D2TMP(J1,3*NATOMS*(JMIN-1)+1:3*NATOMS*INTIMAGE)682:   &                     D2TMP(J1,3*NATOMS*(JMIN-1)+1:3*NATOMS*INTIMAGE)
797:             ENDDO683:             ENDDO
798: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!684: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
799:             SEARCHSTEP(0:MUPDATE,1:(3*NATOMS)*(INTIMAGE-1))=0.0D0685:             SEARCHSTEP(0:INTMUPDATE,1:(3*NATOMS)*(INTIMAGE-1))=0.0D0
800: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!686: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
801:             D2TMP(0:MUPDATE,1:(3*NATOMS)*INTIMAGE)=GDIF(0:MUPDATE,1:(3*NATOMS)*INTIMAGE)687:             D2TMP(0:INTMUPDATE,1:NOPT*INTIMAGE)=GDIF(0:INTMUPDATE,1:NOPT*INTIMAGE)
802:             DEALLOCATE(GDIF)688:             DEALLOCATE(GDIF)
803:             ALLOCATE(GDIF(0:MUPDATE,1:(3*NATOMS)*(INTIMAGE-1)))689:             ALLOCATE(GDIF(0:INTMUPDATE,1:NOPT*(INTIMAGE-1)))
804:             DO J1=0,MUPDATE690:             DO J1=0,INTMUPDATE
805:                GDIF(J1,1:3*NATOMS*(JMIN-2))=D2TMP(J1,1:3*NATOMS*(JMIN-2))691:                GDIF(J1,1:3*NATOMS*(JMIN-2))=D2TMP(J1,1:3*NATOMS*(JMIN-2))
806:                GDIF(J1,3*NATOMS*(JMIN-2)+1:3*NATOMS*(INTIMAGE-1))= &692:                GDIF(J1,3*NATOMS*(JMIN-2)+1:3*NATOMS*(INTIMAGE-1))= &
807:   &                     D2TMP(J1,3*NATOMS*(JMIN-1)+1:3*NATOMS*INTIMAGE)693:   &                     D2TMP(J1,3*NATOMS*(JMIN-1)+1:3*NATOMS*INTIMAGE)
808:             ENDDO694:             ENDDO
809: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!695: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
810:             GDIF(0:MUPDATE,1:(3*NATOMS)*(INTIMAGE-1))=0.0D0696:             GDIF(0:INTMUPDATE,1:(3*NATOMS)*(INTIMAGE-1))=0.0D0
811: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!697: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
812:             DEALLOCATE(D2TMP)698:             DEALLOCATE(D2TMP)
813: 699: 
814:             DEALLOCATE(TRUEEE,EEETMP,MYGTMP,GTMP,GGG, &700:             DEALLOCATE(TRUEEE,EEETMP,MYGTMP,GTMP,GGG, &
815:   &                    DIAG,STP,GLAST,XSAVE,EEE,STEPIMAGE,CHECKG,IMGFREEZE)701:   &                    DIAG,STP,GLAST,XSAVE,EEE,STEPIMAGE,CHECKG,IMGFREEZE)
816:             ALLOCATE(TRUEEE(INTIMAGE+1),&702:             ALLOCATE(TRUEEE(INTIMAGE+1),&
817:   &                  EEETMP(INTIMAGE+1), MYGTMP(3*NATOMS*(INTIMAGE-1)), &703:   &                  EEETMP(INTIMAGE+1), MYGTMP(3*NATOMS*(INTIMAGE-1)), &
818:   &                  GTMP(3*NATOMS*(INTIMAGE-1)), &704:   &                  GTMP(3*NATOMS*(INTIMAGE-1)), &
819:   &                  DIAG(3*NATOMS*(INTIMAGE-1)), STP(3*NATOMS*(INTIMAGE-1)), &705:   &                  DIAG(3*NATOMS*(INTIMAGE-1)), STP(3*NATOMS*(INTIMAGE-1)), &
820:   &                  GLAST((3*NATOMS)*(INTIMAGE-1)), &706:   &                  GLAST(NOPT*(INTIMAGE-1)), &
821:   &                  XSAVE((3*NATOMS)*(INTIMAGE-1)), CHECKG((3*NATOMS)*(INTIMAGE-1)), IMGFREEZE(INTIMAGE-1), &707:   &                  XSAVE(NOPT*(INTIMAGE-1)), CHECKG(NOPT*(INTIMAGE-1)), IMGFREEZE(INTIMAGE-1), &
822:   &                  EEE(INTIMAGE+1), STEPIMAGE(INTIMAGE-1), GGG(3*NATOMS*(INTIMAGE+1)))708:   &                  EEE(INTIMAGE+1), STEPIMAGE(INTIMAGE-1), GGG(3*NATOMS*(INTIMAGE+1)))
823:             GGG(1:3*NATOMS*(INTIMAGE+1))=0.0D0709:             GGG(1:3*NATOMS*(INTIMAGE+1))=0.0D0
824:             TRUEEE(1:INTIMAGE+1)=0.0D0710:             TRUEEE(1:INTIMAGE+1)=0.0D0
825:             EEETMP(1:INTIMAGE+1)=0.0D0711:             EEETMP(1:INTIMAGE+1)=0.0D0
826:             MYGTMP(1:3*NATOMS*(INTIMAGE-1))=0.0D0712:             MYGTMP(1:3*NATOMS*(INTIMAGE-1))=0.0D0
827:             GTMP(1:3*NATOMS*(INTIMAGE-1))=0.0D0713:             GTMP(1:3*NATOMS*(INTIMAGE-1))=0.0D0
828:             DIAG(1:3*NATOMS*(INTIMAGE-1))=0.0D0714:             DIAG(1:3*NATOMS*(INTIMAGE-1))=0.0D0
829:             STP(1:3*NATOMS*(INTIMAGE-1))=0.0D0715:             STP(1:3*NATOMS*(INTIMAGE-1))=0.0D0
830:             GLAST(1:(3*NATOMS)*(INTIMAGE-1))=0.0D0716:             GLAST(1:NOPT*(INTIMAGE-1))=0.0D0
831:             XSAVE(1:(3*NATOMS)*(INTIMAGE-1))=0.0D0717:             XSAVE(1:NOPT*(INTIMAGE-1))=0.0D0
832:             CHECKG(1:(3*NATOMS)*(INTIMAGE-1))=.FALSE.718:             CHECKG(1:NOPT*(INTIMAGE-1))=.FALSE.
833:             IMGFREEZE(1:INTIMAGE-1)=.FALSE.719:             IMGFREEZE(1:INTIMAGE-1)=.FALSE.
834:             EEE(1:INTIMAGE+1)=0.0D0720:             EEE(1:INTIMAGE+1)=0.0D0
835:             STEPIMAGE(1:INTIMAGE-1)=0.0D0721:             STEPIMAGE(1:INTIMAGE-1)=0.0D0
836: 722: 
837:             X=>XYZ((3*NATOMS)+1:(3*NATOMS)*(INTIMAGE))723:             X=>XYZ(NOPT+1:NOPT*(INTIMAGE))
838:             G=>GGG((3*NATOMS)+1:(3*NATOMS)*(INTIMAGE))724:             G=>GGG(NOPT+1:NOPT*(INTIMAGE))
839:             INTIMAGE=INTIMAGE-1725:             INTIMAGE=INTIMAGE-1
840:             D=(3*NATOMS)*INTIMAGE726:             D=NOPT*INTIMAGE
841:             CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),0,1)727:             CALL CHECKREP(INTIMAGE,XYZ,NOPT,0,1)
842:             IF (QCIADDREP.GT.0) THEN728:             IF (CHECKCONINT) THEN
843:                CALL CONGRAD3(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS) 
844:             ELSEIF (CHECKCONINT) THEN 
845:                CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)729:                CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
846:             ELSE730:             ELSE
847:                CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)731:                CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
848:             ENDIF732:             ENDIF
849: !           GOTO 864733: !           GOTO 864
850:          ENDIF734:          ENDIF
851:       ELSE 
852:          DMAX=-1.0D0 
853:          ADMAX=-1.0D0 
854:          DMIN=HUGE(1.0D0) 
855:          DUMMY2=0.0D0 
856:          DO J1=1,INTIMAGE+1 
857:             DUMMY=0.0D0 
858: !           DO J2=1,3*NATOMS 
859: !              IF (ATOMACTIVE((J2-1)/3+1)) THEN 
860: !                 DUMMY=DUMMY+( XYZ((J1-1)*3*NATOMS+J2) - XYZ(J1*3*NATOMS+J2) )**2 
861: !              ENDIF 
862: !           ENDDO 
863:             DO J2=1,NATOMS 
864:                IF (ATOMACTIVE(J2)) THEN 
865:                   ADUMMY=( XYZ((J1-1)*3*NATOMS+3*(J2-1)+1) - XYZ(J1*3*NATOMS+3*(J2-1)+1) )**2 & 
866:   &                     +( XYZ((J1-1)*3*NATOMS+3*(J2-1)+2) - XYZ(J1*3*NATOMS+3*(J2-1)+2) )**2 & 
867:   &                     +( XYZ((J1-1)*3*NATOMS+3*(J2-1)+3) - XYZ(J1*3*NATOMS+3*(J2-1)+3) )**2  
868:                   DUMMY=DUMMY+ADUMMY 
869:                   IF (ADUMMY.GT.ADMAX) THEN 
870:                      ADMAX=ADUMMY 
871:                      JA1=J1 
872:                      JA2=J2 
873:                   ENDIF 
874:                ENDIF 
875:             ENDDO 
876:             DUMMY=SQRT(DUMMY) 
877:             DUMMY2=DUMMY2+DUMMY 
878:             IF (DUMMY.GT.DMAX) THEN 
879:                DMAX=DUMMY 
880:                JMAX=J1 
881:             ENDIF 
882:             IF (DUMMY.LT.DMIN) THEN 
883:                DMIN=DUMMY 
884:                JMIN=J1 
885:             ENDIF 
886: !            IF (DEBUG) WRITE(*,'(A,I6,A,I6,A,G20.10)')' intlbfgs> distance between images ', & 
887: !  &                                                  J1,' and ',J1+1,' is ',DUMMY 
888: !            IF (DEBUG) WRITE(*,'(A,G20.10,A,I6,A,2I6)')' intlbfgs> largest atomic distance between images so far is ', & 
889: !  &                                                  SQRT(ADMAX),' for atom ',JA2,' and images ',JA1,JA1+1 
890:          ENDDO 
891:          IF (DEBUG) WRITE(*,'(A,G20.10,A,I6,A,2I6,A,I6)')' intlbfgs> largest atomic distance between images is ', & 
892:   &                                                  SQRT(ADMAX),' for atom ',JA2,' and images ',JA1,JA1+1,' total images=',INTIMAGE 
893:          IF (DEBUG) WRITE(*,'(A,G20.10,A,2I6)')' intlbfgs> largest image separation is ', & 
894:   &                                                  DMAX,' for images ',JMAX,JMAX+1 
895:          IF (DEBUG) WRITE(*,'(A,G20.10,A,G20.10)') 'intlbfgs> Mean image separation=',DUMMY2/(INTIMAGE+1),' per active atom=',DUMMY2/((INTIMAGE+1)*NACTIVE) 
896: !        IF (SQRT(ADMAX).GT.IMSEPMAX) THEN 
897: !           KINT=MIN(1.0D6,KINT*1.1D0) 
898: !        ELSE 
899: !           KINT=MAX(1.0D-6,KINT/1.1D0) 
900: !        ENDIF 
901: !        WRITE(*,'(A,G20.10)') 'intlbfgs> Spring constant is now ',KINT 
902:       ENDIF735:       ENDIF
903:    ENDIF736:    ENDIF
904: !737: ! 
905: ! End of add/subtract images block.738: ! End of add/subtract images block.
906: !739: !  
907:    IF (QCIPERMCHECK.AND.(MOD(NITERDONE,QCIPERMCHECKINT).EQ.0)) THEN740:    IF (QCIPERMCHECK.AND.(MOD(NITERDONE,QCIPERMCHECKINT).EQ.0)) THEN
908:       LDEBUG=.FALSE.741:       LDEBUG=.FALSE.
909:       DO J2=2,INTIMAGE+2742:       DO J2=2,NIMAGE+2
910:          CALL MINPERMDIST(XYZ((J2-2)*3*NATOMS+1:(J2-1)*3*NATOMS),XYZ((J2-1)*3*NATOMS+1:J2*3*NATOMS),NATOMS,LDEBUG, &743:          CALL MINPERMDIST(XYZ((J2-2)*NOPT+1:(J2-1)*NOPT),XYZ((J2-1)*NOPT+1:J2*NOPT),NATOMS,LDEBUG, &
911:   &                    PARAM1,PARAM2,PARAM3,BULKT,TWOD,DIST,DIST2,RIGIDBODY,RMAT)744:   &                    PARAM1,PARAM2,PARAM3,BULKT,TWOD,DISTANCE,DIST2,RIGIDBODY,RMAT)
912:       ENDDO745:       ENDDO
913:    ENDIF746:    ENDIF
914:  
915:    IF (.NOT.SWITCHED) THEN747:    IF (.NOT.SWITCHED) THEN
916:       IF (MOD(NITERDONE,CHECKREPINTERVAL).EQ.0) CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),0,1)748:       IF (MOD(NITERDONE,CHECKREPINTERVAL).EQ.0) CALL CHECKREP(INTIMAGE,XYZ,NOPT,0,1)
917:       IF (QCIADDREP.GT.0) THEN749:       IF (CHECKCONINT) THEN
918:          CALL CONGRAD3(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS) 
919:       ELSEIF (CHECKCONINT) THEN 
920:          CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)750:          CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
921:       ELSE751:       ELSE
922:          CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)752:          CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
923:       ENDIF753:       ENDIF
924:  
925:       IF ((ETOTAL-EOLD.LT.1.0D100).OR.ADDATOM) THEN ! MAXERISE effectively set to 1.0D100 here754:       IF ((ETOTAL-EOLD.LT.1.0D100).OR.ADDATOM) THEN ! MAXERISE effectively set to 1.0D100 here
926:          EOLD=ETOTAL755:          EOLD=ETOTAL
927:          GLAST(1:D)=G(1:D)756:          GLAST(1:D)=G(1:D)
928:          XSAVE(1:D)=X(1:D)757:          XSAVE(1:D)=X(1:D)
929:       ELSE758:       ELSE
930:          NDECREASE=NDECREASE+1759:          NDECREASE=NDECREASE+1
931:          IF (NDECREASE.GT.5) THEN760:          IF (NDECREASE.GT.5) THEN
932:             NFAIL=NFAIL+1761:             NFAIL=NFAIL+1
933:             WRITE(*,'(A,I6)') ' intlbfgs> WARNING *** in lbfgs cannot find a lower energy, NFAIL=',NFAIL762:             WRITE(*,'(A,I6)') ' intlbfgs> WARNING *** in lbfgs cannot find a lower energy, NFAIL=',NFAIL
934:             X(1:D)=XSAVE(1:D)763:             X(1:D)=XSAVE(1:D)
937:             X(1:D)=XSAVE(1:D)766:             X(1:D)=XSAVE(1:D)
938:             G(1:D)=GLAST(1:D)767:             G(1:D)=GLAST(1:D)
939:             STP(1:D)=STP(1:D)/10.0D0768:             STP(1:D)=STP(1:D)/10.0D0
940:             WRITE(*,'(A,G25.15,A,G25.15,A)') ' intlbfgs> energy increased from ',EOLD,' to ',ETOTAL, &769:             WRITE(*,'(A,G25.15,A,G25.15,A)') ' intlbfgs> energy increased from ',EOLD,' to ',ETOTAL, &
941:      &          ' decreasing step size'770:      &          ' decreasing step size'
942:             GOTO 20771:             GOTO 20
943:          ENDIF772:          ENDIF
944:       ENDIF773:       ENDIF
945:       ADDATOM=.FALSE.774:       ADDATOM=.FALSE.
946:    ELSE ! combine constraint and true potentials775:    ELSE ! combine constraint and true potentials
947:       IF (MOD(NITERDONE,CHECKREPINTERVAL).EQ.0) CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),0,1)776: !     IF ((RMS.LT.INTRMSTOL*1.0D10).AND.(MOD(NITERDONE,10).EQ.0).AND.(NSTEPSMAX-NITERDONE.GT.100)) &
 777: ! &               CALL CHECKSEP(NMAXINT,NMININT,INTIMAGE,XYZ,NOPT)
 778: 
 779: !!!
 780: !
 781: ! Check that MAKE_CONPOT produces the same constraints and repulsions - this is to debug MAKE_CONPOT
 782: !
 783: !     MINCOORDS(1,1:NOPT)=XYZ(1:NOPT)
 784: !     MINCOORDS(2,1:NOPT)=XYZ(NOPT*(INTIMAGE+1)+1:NOPT*(INTIMAGE+2))
 785: !     PRINT '(A)',' intlbfgs> Before make_conpot'
 786: !     CALL CHECKREP(INTIMAGE,XYZ,NOPT,0,1)
 787: !     DO J2=1,NCONSTRAINT
 788: !        PRINT '(A,I6,L5,2I6,2F20.10)','J2,CONACTIVE,CONI,CONJ,CONDISTREF,CONDISTREFLOCAL=', &
 789: ! &                      J2,CONACTIVE(J2),CONI(J2),CONJ(J2),CONDISTREF(J2),CONDISTREFLOCAL(J2)
 790: !     ENDDO
 791: !     DO J2=1,NREPULSIVE
 792: !        PRINT '(A,3I6,F20.10)','J2,REPI,REPJ,REPCUT=',J2,REPI(J2),REPJ(J2),REPCUT(J2)
 793: !     ENDDO
 794: !     DO J2=1,NNREPULSIVE
 795: !        PRINT '(A,3I6,F20.10)','J2,NREPI,NREPJ,NREPCUT=',J2,NREPI(J2),NREPJ(J2),NREPCUT(J2)
 796: !     ENDDO
 797: !     PRINT '(A)',' intlbfgs> Calling make_conpot'
 798: !     CALL MAKE_CONPOT(2,MINCOORDS)
 799: !     CALL CHECKREP(INTIMAGE,XYZ,NOPT,0,1)
 800: !     DO J2=1,NCONSTRAINT
 801: !        PRINT '(A,I6,L5,2I6,2F20.10)','J2,CONACTIVE,CONI,CONJ,CONDISTREF,CONDISTREFLOCAL=', &
 802: ! &                      J2,CONACTIVE(J2),CONI(J2),CONJ(J2),CONDISTREF(J2),CONDISTREFLOCAL(J2)
 803: !     ENDDO
 804: !     DO J2=1,NREPULSIVE
 805: !        PRINT '(A,3I6,F20.10)','J2,REPI,REPJ,REPCUT=',J2,REPI(J2),REPJ(J2),REPCUT(J2)
 806: !     ENDDO
 807: !     DO J2=1,NNREPULSIVE
 808: !        PRINT '(A,3I6,F20.10)','J2,NREPI,NREPJ,NREPCUT=',J2,NREPI(J2),NREPJ(J2),NREPCUT(J2)
 809: !     ENDDO
 810: !     STOP
 811: !!! DJW
 812:       IF (MOD(NITERDONE,CHECKREPINTERVAL).EQ.0) CALL CHECKREP(INTIMAGE,XYZ,NOPT,0,1)
948:       ETOTALTMP=0.0D0813:       ETOTALTMP=0.0D0
949:       IF (INTCONFRAC.NE.0.0D0) THEN814:       DO J4=2,INTIMAGE+1
950:          DO J4=2,INTIMAGE+1815:          IF (CHRMMT) CALL UPDATENBONDS(XYZ(NOPT*(J4-1)+1:NOPT*J4))
951:             IF (CHRMMT) CALL UPDATENBONDS(XYZ((3*NATOMS)*(J4-1)+1:(3*NATOMS)*J4))816:          CALL POTENTIAL(XYZ(NOPT*(J4-1)+1:NOPT*J4),EEE(J4),GGG(NOPT*(J4-1)+1:NOPT*J4),.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
952:             CALL POTENTIAL(XYZ((3*NATOMS)*(J4-1)+1:(3*NATOMS)*J4),GGG((3*NATOMS)*(J4-1)+1:(3*NATOMS)*J4),EEE(J4), &817:          ETOTALTMP=ETOTALTMP+EEE(J4)
953:   &                                    .TRUE.,.FALSE.)818:       ENDDO
954:             ETOTALTMP=ETOTALTMP+EEE(J4)819:       RMSTMP=RMS
955:          ENDDO 
956:       ENDIF 
957:       EEETMP(1:INTIMAGE+2)=EEE(1:INTIMAGE+2)820:       EEETMP(1:INTIMAGE+2)=EEE(1:INTIMAGE+2)
958:       MYGTMP(1:D)=G(1:D)821:       MYGTMP(1:D)=G(1:D)
959:       IF (USEFRAC.LT.1.0D0) THEN822:       IF (USEFRAC.LT.1.0D0) THEN
960:          IF (QCIADDREP.GT.0) THEN823:          IF (CHECKCONINT) THEN
961:             CALL CONGRAD3(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS) 
962:          ELSEIF (CHECKCONINT) THEN 
963:             CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)824:             CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
964:          ELSE825:          ELSE
965:             CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)826:             CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
966:          ENDIF827:          ENDIF
967:       ELSE828:       ELSE
968:          ETOTAL=0.0D0829:          ETOTAL=0.0D0
969:          G(1:D)=0.0D0830:          G(1:D)=0.0D0
970:       ENDIF831:       ENDIF
971:       ETOTAL=USEFRAC*ETOTALTMP+(1.0D0-USEFRAC)*ETOTAL832:       ETOTAL=USEFRAC*ETOTALTMP+(1.0D0-USEFRAC)*ETOTAL
 833:       RMS=USEFRAC*RMSTMP+(1.0D0-USEFRAC)*RMS
972:       G(1:D)=USEFRAC*MYGTMP(1:D)+(1.0D0-USEFRAC)*G(1:D)834:       G(1:D)=USEFRAC*MYGTMP(1:D)+(1.0D0-USEFRAC)*G(1:D)
973:       RMS=SUM(G(1:D)**2) 
974:       RMS=SQRT(RMS/((3*NATOMS)*INTIMAGE)) 
975:       EEE(1:INTIMAGE+2)=USEFRAC*EEETMP(1:INTIMAGE+2)+(1.0D0-USEFRAC)*EEE(1:INTIMAGE+2)835:       EEE(1:INTIMAGE+2)=USEFRAC*EEETMP(1:INTIMAGE+2)+(1.0D0-USEFRAC)*EEE(1:INTIMAGE+2)
976:       WORST=-1.0D100836: !     USEFRAC=USEFRAC+INTCONFRAC
977:       DO J4=2,INTIMAGE+1837: !     IF (USEFRAC.GE.1.0D0) PRINT '(A,I6)',' intlbfgs> switching off constraint potential completely at step ',NITERDONE
978:          IF (EEE(J4).GT.WORST) WORST=EEE(J4) 
979:       ENDDO 
980:       IF (DEBUG) WRITE(*,'(A,G20.10,A,I8)') 'intlbfgs> Highest QCI image energy=',WORST,' images=',INTIMAGE 
981:    ENDIF838:    ENDIF
982:    IF (ETOTAL/INTIMAGE.LT.COLDFUSIONLIMIT) THEN839:    IF (ETOTAL/INTIMAGE.LT.COLDFUSIONLIMIT) THEN
983:       WRITE(*,'(A,2G20.10)') ' intlbfgs> Cold fusion diagnosed - step discarded, energy, limit=',ETOTAL/INTIMAGE,COLDFUSIONLIMIT840:       WRITE(*,'(A,2G20.10)') ' intlbfgs> Cold fusion diagnosed - step discarded, energy, limit=',ETOTAL/INTIMAGE,COLDFUSIONLIMIT
984:       DEALLOCATE(CONI,CONJ,CONDISTREF,REPI,REPJ,NREPI,NREPJ,REPCUT,NREPCUT,CONCUT)841:       DEALLOCATE(CONI,CONJ,CONDISTREF,REPI,REPJ,NREPI,NREPJ,REPCUT,NREPCUT,CONCUT)
985:       DEALLOCATE(TRUEEE, EEETMP, MYGTMP, GTMP, &842:       DEALLOCATE(TRUEEE, EEETMP, MYGTMP, GTMP, &
986:   &              DIAG, STP, SEARCHSTEP, GDIF,GLAST, XSAVE, XYZ, GGG, CHECKG, IMGFREEZE, EEE, STEPIMAGE)843:   &              DIAG, STP, SEARCHSTEP, GDIF,GLAST, XSAVE, XYZ, GGG, CHECKG, IMGFREEZE, EEE, STEPIMAGE)
987:       QCIIMAGE=INTIMAGE 
988:       INTIMAGE=INTIMAGESAVE844:       INTIMAGE=INTIMAGESAVE
 845:       LTSFOUND=0
 846:       LMINFOUND=0
989:       RETURN847:       RETURN
990:    ENDIF848:    ENDIF
991: 849: 
992:    STEPTOT = SUM(STEPIMAGE)/INTIMAGE850:    STEPTOT = SUM(STEPIMAGE)/INTIMAGE
993: 851: 
994:    MAXRMS=-1.0D0 
995:    MAXEEE=-1.0D100 
996:    DO J1=2,INTIMAGE+1 
997:       IF (EEE(J1).GT.MAXEEE) THEN 
998:          MAXEEE=EEE(J1) 
999:          JMAXEEE=J1 
1000:       ENDIF 
1001:       DUMMY=0.0D0 
1002:       DO J2=1,3*NATOMS 
1003:          DUMMY=DUMMY+GGG(3*NATOMS*(J1-1)+J2)**2 
1004:       ENDDO 
1005:       IF (DUMMY.GT.MAXRMS) THEN 
1006:          MAXRMS=DUMMY 
1007:          JMAXRMS=J1 
1008:       ENDIF 
1009:    ENDDO 
1010:    MAXRMS=SQRT(MAXRMS/(3*NACTIVE)) 
1011:  
1012:    IF (DEBUG) THEN852:    IF (DEBUG) THEN
1013:       WRITE(*,'(A,I6,2G20.10,3(G20.10,I8))') ' intlbfgs> steps: ',NITERDONE,ETOTAL/INTIMAGE,RMS,STEPTOT,NACTIVE, &853:       WRITE(*,'(A,I6,2G20.10,G20.10,I8)') ' intlbfgs> steps: ',NITERDONE,ETOTAL/INTIMAGE,RMS,STEPTOT,NACTIVE
1014:   &                                                        MAXEEE,JMAXEEE,MAXRMS,JMAXRMS 
1015:       CALL FLUSH(6)854:       CALL FLUSH(6)
1016:    ENDIF855:    ENDIF
1017: 856: 
1018:    IF (.NOT.SWITCHED) THEN857:    IF (.NOT.SWITCHED) THEN
1019: !     IF ((NITERDONE-NLASTGOODE.GT.INTRELSTEPS).AND.((ETOTAL.GT.LASTGOODE).OR.(ETOTAL/INTIMAGE.GT.MAXCONE*1.0D8))) THEN858:       IF ((NITERDONE-NLASTGOODE.GT.INTRELSTEPS).AND.((ETOTAL.GT.LASTGOODE).OR.(ETOTAL/INTIMAGE.GT.MAXCONE*1.0D8))) THEN
1020:       IF (.FALSE.) THEN ! no backtracking859:          PRINT '(2(A,I6))',' intlbfgs> Backtracking ',NBACKTRACK,' steps, current active atoms=',NACTIVE
1021:          WRITE(*,'(2(A,I6))') ' intlbfgs> Backtracking ',NBACKTRACK,' steps, current active atoms=',NACTIVE 
1022:          NTRIES(NEWATOM)=NTRIES(NEWATOM)+1860:          NTRIES(NEWATOM)=NTRIES(NEWATOM)+1
1023:          IF (FREEZENODEST) IMGFREEZE(1:INTIMAGE)=.FALSE.861:          IF (FREEZENODEST) IMGFREEZE(1:INTIMAGE)=.FALSE.
1024: !862: !
1025: ! Backtrack by removing the last NBACKTRACK atoms along with their active constraints and863: ! Backtrack by removing the last NBACKTRACK atoms along with their active constraints and
1026: ! repulsions.864: ! repulsions.
1027: !865: !
1028:          NOFF=0866:          NOFF=0
1029:          DO J1=1,NBACKTRACK867:          DO J1=1,NBACKTRACK
1030:             NDUMMY=TURNONORDER(NACTIVE-J1+1)868:             NDUMMY=TURNONORDER(NACTIVE-J1+1)
1031:             IF (INTFROZEN(NDUMMY)) THEN869:             IF (INTFROZEN(NDUMMY)) THEN
1032:                IF (DEBUG) WRITE(*,'(A,I6,A,2I6)') ' intlbfgs> Not turning off frozen active atom ',NDUMMY870:                IF (DEBUG) PRINT '(A,I6,A,2I6)',' intlbfgs> Not turning off frozen active atom ',NDUMMY
1033:                CYCLE871:                CYCLE
1034:             ENDIF872:             ENDIF
1035:             IF (DEBUG) WRITE(*,'(A,I6,A,2I6)') ' intlbfgs> Turning off active atom ',NDUMMY873:             IF (DEBUG) PRINT '(A,I6,A,2I6)',' intlbfgs> Turning off active atom ',NDUMMY
1036:             DO J2=1,NCONSTRAINT874:             DO J2=1,NCONSTRAINT
1037:                IF (.NOT.CONACTIVE(J2)) CYCLE 875:                IF (.NOT.CONACTIVE(J2)) CYCLE 
1038:                IF ((CONI(J2).EQ.NDUMMY).OR.(CONJ(J2).EQ.NDUMMY)) THEN876:                IF ((CONI(J2).EQ.NDUMMY).OR.(CONJ(J2).EQ.NDUMMY)) THEN
1039:                   CONACTIVE(J2)=.FALSE.877:                   CONACTIVE(J2)=.FALSE.
1040:                   IF (DEBUG) WRITE(*,'(A,I6,A,2I6)') ' intlbfgs> Turning off constraint ',J2,' for atoms ',CONI(J2),CONJ(J2)878:                   IF (DEBUG) PRINT '(A,I6,A,2I6)',' intlbfgs> Turning off constraint ',J2,' for atoms ',CONI(J2),CONJ(J2)
1041:                ENDIF879:                ENDIF
1042:             ENDDO880:             ENDDO
1043:             ATOMACTIVE(NDUMMY)=.FALSE.881:             ATOMACTIVE(NDUMMY)=.FALSE.
1044:             NOFF=NOFF+1882:             NOFF=NOFF+1
1045:          ENDDO883:          ENDDO
1046:          NACTIVE=NACTIVE-NOFF884:          NACTIVE=NACTIVE-NOFF
1047:          NDUMMY=1885: !
1048:          NREPULSIVE=0886: ! Reconstruct repulsions. 
1049:          DO J1=1,NATOMS887: !
 888: !          NREPULSIVE=0
 889: !          DO J1=1,NATOMS
 890: !             IF (.NOT.ATOMACTIVE(J1)) CYCLE ! identify active atoms
 891: !             DO J2=J1+1,NATOMS
 892: !                IF (.NOT.ATOMACTIVE(J2)) CYCLE ! identify active atoms
 893: !                IF (ABS(J1-J2).LE.INTREPSEP) CYCLE ! no repulsion for atoms too close in sequence
 894: !                IF (INTFROZEN(J1).AND.INTFROZEN(J2)) CYCLE 
 895: !                DO J3=1,NCONSTRAINT
 896: !                   IF (.NOT.CONACTIVE(J3)) CYCLE ! identify active constraints 
 897: !                   IF (((CONI(J3).EQ.J1).AND.(CONJ(J3).EQ.J2)).OR. &
 898: !   &                   ((CONJ(J3).EQ.J1).AND.(CONI(J3).EQ.J2))) GOTO 548
 899: !                ENDDO
 900: !                DMIN=1.0D100
 901: !                DO J3=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances
 902: !                   DF=SQRT((XYZ((J3-1)*3*NATOMS+3*(J2-1)+1)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+1))**2+ &
 903: !   &                       (XYZ((J3-1)*3*NATOMS+3*(J2-1)+2)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+2))**2+ &
 904: !   &                       (XYZ((J3-1)*3*NATOMS+3*(J2-1)+3)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+3))**2)
 905: !                   IF (DF.LT.DMIN) DMIN=DF
 906: !                ENDDO
 907: ! !
 908: ! ! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact.
 909: ! !
 910: !                DMIN=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)
 911: !                NREPULSIVE=NREPULSIVE+1
 912: !                REPI(NREPULSIVE)=J1
 913: !                REPJ(NREPULSIVE)=J2
 914: !                REPCUT(NREPULSIVE)=DMIN
 915: ! 548            CONTINUE
 916: !             ENDDO
 917: !          ENDDO
 918: 
 919:            NDUMMY=1
 920:            NREPULSIVE=0
 921:            DO J1=1,NATOMS
1050: ! 922: ! 
1051: ! Make a list of repelling atoms here and then use it923: ! Make a list of repelling atoms here and then use it
1052: ! CONI(J2) is always less than CONJ(J2) so we only need to924: ! CONI(J2) is always less than CONJ(J2) so we only need to
1053: ! cycle over a given range of constraints and continue from925: ! cycle over a given range of constraints and continue from
1054: ! where we left off for the next atom j1926: ! where we left off for the next atom j1
1055: !  927: !  
1056:             ADDREP(1:J1+INTREPSEP)=.FALSE.928:               ADDREP(1:J1+INTREPSEP)=.FALSE.
1057:             ADDREP(J1+INTREPSEP+1:NATOMS)=.TRUE. ! no repulsion for atoms too close in sequence929:               ADDREP(J1+INTREPSEP+1:NATOMS)=.TRUE. ! no repulsion for atoms too close in sequence
1058:             IF (INTFROZEN(J1)) THEN930:               IF (INTFROZEN(J1)) THEN
1059:                DO J2=J1+INTREPSEP+1,NATOMS931:                  DO J2=J1+INTREPSEP+1,NATOMS
1060:                   IF (INTFROZEN(J2)) ADDREP(J2)=.FALSE.932:                     IF (INTFROZEN(J2)) ADDREP(J2)=.FALSE.
1061:                ENDDO933:                  ENDDO
1062:             ENDIF934:               ENDIF
1063:             addloop: DO J2=NDUMMY,NCONSTRAINT935:               addloop: DO J2=NDUMMY,NCONSTRAINT
1064:                IF (CONI(J2).EQ.J1) THEN936:                  IF (CONI(J2).EQ.J1) THEN
1065:                   ADDREP(CONJ(J2))=.FALSE.937:                     ADDREP(CONJ(J2))=.FALSE.
1066:                ELSE938:                  ELSE
1067:                   NDUMMY=J2 ! for next atom939:                     NDUMMY=J2 ! for next atom
1068:                   EXIT addloop940:                     EXIT addloop
1069:                ENDIF941:                  ENDIF
1070:             ENDDO addloop942:               ENDDO addloop
1071:             rep2: DO J2=J1+INTREPSEP+1,NATOMS943:               rep2: DO J2=J1+INTREPSEP+1,NATOMS
1072: 944: 
1073:                IF (.NOT.ADDREP(J2)) CYCLE945:                  IF (.NOT.ADDREP(J2)) CYCLE
1074: !946: 
1075: ! Don't we need to check atomactive here for backtracking?947:                  DMIN=1.0D100
1076: !948:                  DO J3=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances
1077: !              IF (.NOT.ATOMACTIVE(J2)) CYCLE 949:                     DF=SQRT((XYZ((J3-1)*3*NATOMS+3*(J2-1)+1)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+1))**2+ &
1078: 950:     &                       (XYZ((J3-1)*3*NATOMS+3*(J2-1)+2)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+2))**2+ &
1079:                DMIN=1.0D100951:     &                       (XYZ((J3-1)*3*NATOMS+3*(J2-1)+3)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+3))**2)
1080:                DO J3=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances952:                     IF (DF.LT.DMIN) DMIN=DF
1081:                   DF=SQRT((XYZ((J3-1)*3*NATOMS+3*(J2-1)+1)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+1))**2+ &953:                  ENDDO
1082:     &                     (XYZ((J3-1)*3*NATOMS+3*(J2-1)+2)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+2))**2+ &954: 
1083:     &                     (XYZ((J3-1)*3*NATOMS+3*(J2-1)+3)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+3))**2)955:                  NREPULSIVE=NREPULSIVE+1
1084:                   IF (DF.LT.DMIN) DMIN=DF956:                  IF (NREPULSIVE.GT.NREPMAX) CALL REPDOUBLE
1085:                ENDDO957:                  REPI(NREPULSIVE)=J1
1086: 958:                  REPJ(NREPULSIVE)=J2
1087:                NREPULSIVE=NREPULSIVE+1 
1088:                IF (NREPULSIVE.GT.NREPMAX) CALL REPDOUBLE 
1089:                REPI(NREPULSIVE)=J1 
1090:                REPJ(NREPULSIVE)=J2 
1091: ! 959: ! 
1092: ! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact.960: ! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact.
1093: !961: !
1094:                REPCUT(NREPULSIVE)=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)962:                  REPCUT(NREPULSIVE)=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)
1095:             ENDDO rep2963:    ENDDO rep2
1096:          ENDDO964: ENDDO
1097:  
1098: 965: 
 966: !        NBACKTRACK=MAX(MIN(MIN(1.0D0*(NBACKTRACK+1),1.0D0*50),0.1D0*(NACTIVE-2-NQCIFREEZE)),1)
1099:          NBACKTRACK=MAX(MIN(MIN(1.0D0*(NBACKTRACK+1),1.0D0*50),1.0D0*(NACTIVE-2-NQCIFREEZE)),1.0D0)967:          NBACKTRACK=MAX(MIN(MIN(1.0D0*(NBACKTRACK+1),1.0D0*50),1.0D0*(NACTIVE-2-NQCIFREEZE)),1.0D0)
1100: !        IF (DEBUG) WRITE(*,'(A,I6)') ' intlbfgs> Number of atoms to backtrack is now ',NBACKTRACK968: !        IF (DEBUG) PRINT '(A,I6)',' intlbfgs> Number of atoms to backtrack is now ',NBACKTRACK
1101:          NDUMMY=0969:          NDUMMY=0
1102:          DO J1=1,NATOMS970:          DO J1=1,NATOMS
1103:             IF (ATOMACTIVE(J1)) NDUMMY=NDUMMY+1971:             IF (ATOMACTIVE(J1)) NDUMMY=NDUMMY+1
1104:          ENDDO972:          ENDDO
1105:          IF (NDUMMY.NE.NACTIVE) THEN973:          IF (NDUMMY.NE.NACTIVE) THEN
1106:             WRITE(*,'(A,I6)') ' intlbfgs> ERROR *** inconsistency in number of active atoms. ',NDUMMY,' should be ',NACTIVE974:             PRINT '(A,I6)',' intlbfgs> ERROR *** inconsistency in number of active atoms. ',NDUMMY,' should be ',NACTIVE
1107:             DO J1=1,NATOMS975:             DO J1=1,NATOMS
1108:                IF (ATOMACTIVE(J1)) WRITE(*,'(A,I6)') ' active atom ',J1976:                IF (ATOMACTIVE(J1)) PRINT '(A,I6)',' active atom ',J1
1109:             ENDDO977:             ENDDO
1110:             STOP978:             STOP
1111:          ENDIF979:          ENDIF
1112:          ADDATOM=.TRUE.980:          ADDATOM=.TRUE.
1113: 981: 
1114:          CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),0,1)982:          CALL CHECKREP(INTIMAGE,XYZ,NOPT,0,1)
1115:          IF (QCIADDREP.GT.0) THEN983:          IF (CHECKCONINT) THEN
1116:             CALL CONGRAD3(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS) 
1117:          ELSEIF (CHECKCONINT) THEN 
1118:             CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)984:             CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
1119:          ELSE985:          ELSE
1120:             CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)986:             CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
1121:          ENDIF987:          ENDIF
1122:       ENDIF988:       ENDIF
1123:       LASTGOODE=ETOTAL989:       LASTGOODE=ETOTAL
1124:    ENDIF990:    ENDIF
1125:  
1126:    EXITSTATUS=0991:    EXITSTATUS=0
1127:    INTDGUESS=DIAG(1) ! should be ok for subsequent runs of the same system DJW992:    INTDGUESS=DIAG(1) ! should be ok for subsequent runs of the same system DJW
1128:    IF ((.NOT.SWITCHED).AND.(MAXRMS<=INTRMSTOL).AND.NITERDONE>1) EXITSTATUS=1 993:    IF ((RMS<=INTRMSTOL.AND.NITERDONE>1).AND.(.NOT.SWITCHED)) EXITSTATUS=1 ! prevents premature convergence in second phase
1129:    IF (SWITCHED.AND.(MAXRMS<=CONVR).AND.NITERDONE>1) EXITSTATUS=1  
1130:    IF (NITERDONE==NSTEPSMAX) EXITSTATUS=2994:    IF (NITERDONE==NSTEPSMAX) EXITSTATUS=2
1131:    IF ((.NOT.SWITCHED).AND.(MOD(NITERDONE,INTRELSTEPS).EQ.0)) EXITSTATUS=1 ! Add an atom every INTRELSTEPS !!! DJW 
1132: !  PRINT '(A,2G20.10,3I8)','MAXRMS,INTRMSTOL,NITERDONE,NITERDONE,NSTEPSMAX=',MAXRMS,INTRMSTOL,NITERDONE,NITERDONE,NSTEPSMAX 
1133: 995: 
 996: !    IF (.FALSE.) THEN
 997: !       CHECKG(1:D)=.FALSE.
 998: !       DO J1=1,D
 999: !          IF (ABS(G(J1)).GT.1.0D-6) THEN
 1000: !             PRINT '(3I6,G20.10)',J1,2+(J1-1)/(3*NATOMS),(J1-3*NATOMS*((J1-1)/(3*NATOMS))-1)/3+1,G(J1)
 1001: !             CHECKG(J1)=.TRUE.
 1002: !          ENDIF
 1003: !      ENDDO
 1004: ! !!!!!!!!!!!!!!!!!!!
 1005: ! !     NDUMMY=NREPULSIVE
 1006: ! !     NCONSTRAINT=0
 1007: ! !     NREPULSIVE=0
 1008: ! !!!!!!!!!!!!!!!!!!!
 1009: !       IF (CHECKCONINT) THEN
 1010: !          CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
 1011: !       ELSE
 1012: !          CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
 1013: !       ENDIF
 1014: !       GLAST(1:D)=G(1:D)
 1015: !       DIFF=1.0D-6
 1016: !       PRINT '(A,I6)',' intlbfgs> analytic and numerical gradients: D=',D
 1017: !       DO J2=1,D
 1018: !          IF (.NOT.CHECKG(J2)) CYCLE
 1019: !          X(J2)=X(J2)+DIFF
 1020: ! !        PRINT '(A,I6)',' intlbfgs> calling congrad + for coordinate J2'
 1021: !          IF (CHECKCONINT) THEN
 1022: !             CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
 1023: !          ELSE
 1024: !             CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
 1025: !          ENDIF
 1026: !          EPLUS=ETOTAL
 1027: !          X(J2)=X(J2)-2.0D0*DIFF
 1028: ! !        PRINT '(A,I6)',' intlbfgs> calling congrad - for coordinate J2'
 1029: !          IF (CHECKCONINT) THEN
 1030: !             CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
 1031: !          ELSE
 1032: !             CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
 1033: !          ENDIF
 1034: !          EMINUS=ETOTAL
 1035: !          X(J2)=X(J2)+DIFF
 1036: !          IF (ABS(GLAST(J2)).NE.0.0D0) THEN
 1037: !             IF (100.0D0*ABS((GLAST(J2)-(EPLUS-EMINUS)/(2.0D0*DIFF))/GLAST(J2)).GT.10.0D0) THEN
 1038: !                WRITE(*,'(A,3I8,3G20.10)') 'error ',(J2-1)/NOPT+1,(J2-NOPT*((J2-1)/NOPT)-1)/3+1,J2, &
 1039: !   &                                 GLAST(J2),(EPLUS-EMINUS)/(2.0D0*DIFF), &
 1040: !   &                                 (EPLUS-EMINUS)/(2.0D0*DIFF*GLAST(J2))
 1041: !             ELSE
 1042: !                WRITE(*,'(A,3I8,3G20.10)') 'OK    ',(J2-1)/NOPT+1,(J2-NOPT*((J2-1)/NOPT)-1)/3+1,J2, &
 1043: !   &                                       GLAST(J2),(EPLUS-EMINUS)/(2.0D0*DIFF), &
 1044: !   &                                       (EPLUS-EMINUS)/(2.0D0*DIFF*GLAST(J2))
 1045: !             ENDIF
 1046: !          ENDIF
 1047: !       ENDDO
 1048: !    ENDIF
1134:    IF (EXITSTATUS > 0) THEN  1049:    IF (EXITSTATUS > 0) THEN  
1135:       IF ((.NOT.SWITCHED).AND.(EXITSTATUS.EQ.1)) THEN ! add active atom or restart with true potential on1050:       IF ((.NOT.SWITCHED).AND.(EXITSTATUS.EQ.1)) THEN ! add active atom or restart with true potential on
1136: !        IF (ETOTAL/INTIMAGE.GT.MAXCONE*MAX(0.1D0,NACTIVE*1.0D0/(NATOMS*1.0D0))) GOTO 7771051:          IF (ETOTAL/INTIMAGE.GT.MAXCONE) GOTO 777
1137:          IF (MAXEEE.GT.MAXCONE*MAX(0.1D0,NACTIVE*1.0D0/(NATOMS*1.0D0))) GOTO 777 
1138:          IF (NACTIVE.LT.NATOMS) THEN 1052:          IF (NACTIVE.LT.NATOMS) THEN 
1139:             ADDATOM=.TRUE.1053:             ADDATOM=.TRUE.
1140:             GOTO 7771054:             GOTO 777
1141:          ENDIF1055:          ENDIF
1142:          CALL MYCPU_TIME(FTIME,.FALSE.)1056:          CALL MYCPU_TIME(FTIME,.FALSE.)
1143:          WRITE(*,'(A,I6,A,F12.6,A,I6,A,F10.1)') ' intlbfgs> switch on true potential at step ',NITERDONE, &1057:          PRINT '(A,I6,A,F12.6,A,I6,A,F10.1)',' intlbfgs> switch on true potential at step ',NITERDONE, &
1144:   &                                     ' fraction=',INTCONFRAC,' images=',INTIMAGE,' time=',FTIME-STIME1058:   &                                     ' fraction=',INTCONFRAC,' images=',INTIMAGE,' time=',FTIME-STIME
1145:          IF (DEBUG) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ)1059:          PRINT '(A,I6,A,F15.6)',' intlbfgs> Allowing ',INTCONSTEPS,' further optimization steps'
1146:          IF (DEBUG) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE) 
1147:          WRITE(*,'(A,I6,A,F15.6)') ' intlbfgs> Allowing ',INTCONSTEPS,' further optimization steps' 
1148:          DO J1=1,NATOMS1060:          DO J1=1,NATOMS
1149:             IF (.NOT.ATOMACTIVE(J1)) THEN1061:             IF (.NOT.ATOMACTIVE(J1)) THEN
1150:                WRITE(*,'(A,I6,A,I6,A)') ' intlbfgs> ERROR *** number of active atoms=',NACTIVE,' but atom ',J1,' is not active'1062:                PRINT '(A,I6,A,I6,A)',' intlbfgs> ERROR *** number of active atoms=',NACTIVE,' but atom ',J1,' is not active'
1151:             ENDIF1063:             ENDIF
1152:          ENDDO1064:          ENDDO
1153:          NSTEPSMAX=NITERDONE+INTCONSTEPS1065:          NSTEPSMAX=NITERDONE+INTCONSTEPS
1154:          SWITCHED=.TRUE.1066:          SWITCHED=.TRUE.
 1067:          NIMAGEFREEZE=0
1155:          RMS=INTRMSTOL*10.0D0 ! to prevent premature convergence1068:          RMS=INTRMSTOL*10.0D0 ! to prevent premature convergence
1156:          G(1:(3*NATOMS)*INTIMAGE)=INTRMSTOL*10.0D01069:          G(1:NOPT*INTIMAGE)=INTRMSTOL*10.0D0
1157:          USEFRAC=INTCONFRAC1070:          USEFRAC=INTCONFRAC
1158:          GOTO 7771071:          GOTO 777
1159:       ELSEIF ((.NOT.SWITCHED).AND.(EXITSTATUS.EQ.2)) THEN 1072:       ELSEIF ((.NOT.SWITCHED).AND.(EXITSTATUS.EQ.2)) THEN 
1160:          WRITE(*,'(A,I6)') ' intlbfgs> QCI ERROR *** number of active atoms at final step=',NACTIVE1073:          PRINT '(A,I6)',' intlbfgs> ERROR *** number of active atoms at final step=',NACTIVE
 1074:          LTSFOUND=0
 1075:          LMINFOUND=0
1161:          CALL FLUSH(6)1076:          CALL FLUSH(6)
1162:          QCIIMAGE=INTIMAGE 
1163:          RETURN1077:          RETURN
1164:       ELSEIF (DEBUG) THEN1078:       ELSEIF (DEBUG) THEN
1165:          WRITE(*,'(A,I6,A,I6)') 'intlbfgs> energies for images:'1079:          PRINT '(A,I6,A,I6)','intlbfgs> energies for images:'
1166:          WRITE(*,'(I6,F20.10)') (J2,EEE(J2),J2=1,INTIMAGE+2)1080:          PRINT '(I6,F20.10)',(J2,EEE(J2),J2=1,INTIMAGE+2)
1167:       ENDIF1081:       ENDIF
1168:       EXIT1082:       EXIT
1169:    ENDIF1083:    ENDIF
1170:    777 CONTINUE1084:    777 CONTINUE
1171: !1085: !
1172: ! Compute the new step and gradient change1086: ! Compute the new step and gradient change
1173: !1087: !
1174:    NPT=POINT*D1088:    NPT=POINT*D
1175:    SEARCHSTEP(POINT,:) = STP*SEARCHSTEP(POINT,:)1089:    SEARCHSTEP(POINT,:) = STP*SEARCHSTEP(POINT,:)
1176:    GDIF(POINT,:)=G-GTMP1090:    GDIF(POINT,:)=G-GTMP
1177:    1091:    POINT=POINT+1; IF (POINT==INTMUPDATE) POINT=0
1178:    POINT=POINT+1; IF (POINT==MUPDATE) POINT=0 
1179: 1092: 
1180:    IF (DUMPINTXYZ.AND.MOD(NITERDONE,DUMPINTXYZFREQ)==0) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ)1093:    IF (DUMPINTXYZ.AND.MOD(NITERDONE,DUMPINTXYZFREQ)==0) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ)
1181:    IF (DUMPINTEOS.AND.MOD(NITERDONE,DUMPINTEOSFREQ)==0) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)1094:    IF (DUMPINTEOS.AND.MOD(NITERDONE,DUMPINTEOSFREQ)==0) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)
 1095:    PREVGRAD=RMS
1182: 1096: 
1183:    NITERDONE=NITERDONE+11097:    NITERDONE=NITERDONE+1
1184:    NITERUSE=NITERUSE+1 
1185:  
1186:    IF (NITERDONE.GT.NSTEPSMAX) EXIT1098:    IF (NITERDONE.GT.NSTEPSMAX) EXIT
1187:    IF (NACTIVE.EQ.NATOMS) THEN1099:    IF ((NIMAGEFREEZE.EQ.INTIMAGE).AND.(NACTIVE.EQ.NATOMS)) THEN
1188:       IF (.NOT.SWITCHED) THEN1100:       IF (SWITCHED) THEN
 1101:          EXIT
 1102:       ELSE
1189:          CALL MYCPU_TIME(FTIME,.FALSE.)1103:          CALL MYCPU_TIME(FTIME,.FALSE.)
1190:          WRITE(*,'(A,I6,A,F12.6,A,I6,A,F10.1)') ' intlbfgs> switch on true potential at step ',NITERDONE, &1104:          PRINT '(A,I6,A,F12.6,A,I6,A,F10.1)',' intlbfgs> switch on true potential at step ',NITERDONE, &
1191:   &                                     ' fraction=',INTCONFRAC,' images=',INTIMAGE,' time=',FTIME-STIME1105:   &                                     ' fraction=',INTCONFRAC,' images=',INTIMAGE,' time=',FTIME-STIME
1192:          WRITE(*,'(A,I6,A,F15.6)') ' intlbfgs> Allowing ',INTCONSTEPS,' further optimization steps'1106:          PRINT '(A,I6,A,F15.6)',' intlbfgs> Allowing ',INTCONSTEPS,' further optimization steps'
1193:          DO J1=1,NATOMS1107:          DO J1=1,NATOMS
1194:             IF (.NOT.ATOMACTIVE(J1)) THEN1108:             IF (.NOT.ATOMACTIVE(J1)) THEN
1195:                WRITE(*,'(A,I6,A,I6,A)') ' intlbfgs> ERROR *** number of active atoms=',NACTIVE,' but atom ',J1,' is not active'1109:                PRINT '(A,I6,A,I6,A)',' intlbfgs> ERROR *** number of active atoms=',NACTIVE,' but atom ',J1,' is not active'
1196:             ENDIF1110:             ENDIF
1197:          ENDDO1111:          ENDDO
1198:          NSTEPSMAX=NITERDONE+INTCONSTEPS1112:          NSTEPSMAX=NITERDONE+INTCONSTEPS
1199:          SWITCHED=.TRUE.1113:          SWITCHED=.TRUE.
1200:          IF (FREEZENODEST) THEN1114:          IF (FREEZENODEST) THEN
1201:             IMGFREEZE(1:INTIMAGE)=.FALSE.1115:             IMGFREEZE(1:INTIMAGE)=.FALSE.
 1116:             NIMAGEFREEZE=0
1202:          ENDIF1117:          ENDIF
1203:          RMS=INTRMSTOL*10.0D0 ! to prevent premature convergence1118:          RMS=INTRMSTOL*10.0D0 ! to prevent premature convergence
1204:          USEFRAC=INTCONFRAC1119:          USEFRAC=INTCONFRAC
1205:       ENDIF1120:       ENDIF
1206:    ENDIF1121:    ENDIF
1207: 1122: 
1208: ENDDO ! end of main do loop over counter NITERDONE1123: ENDDO ! end of main do loop over counter NITERDONE
1209: 1124: 
1210:       CALL FLUSH(6)1125:       CALL FLUSH(6)
1211: 1126: 
1212: IF (.NOT.SWITCHED) THEN 1127: IF (.NOT.SWITCHED) THEN 
1213:    WRITE(*,'(A,I6,A)') ' intlbfgs> QCI DID NOT CONVERGE number of active atoms at final step=',NACTIVE,' no potential switch'1128:    PRINT '(A,I6,A)',' intlbfgs> ERROR *** number of active atoms at final step=',NACTIVE,' no potential switch'
 1129:    STOP
1214: ENDIF1130: ENDIF
1215: IF (EXITSTATUS.EQ.1) THEN1131: IF (EXITSTATUS.EQ.1) THEN
1216:    WRITE(*,'(A,I6,A,G20.10,A,G15.8,A,I4)') ' intlbfgs> Converged after ',NITERDONE,' steps, energy/image=',ETOTAL/INTIMAGE, &1132:    WRITE(*,'(A,I6,A,G20.10,A,G15.10,A,I4)') ' intlbfgs> Converged after ',NITERDONE,' steps, energy/image=',ETOTAL/INTIMAGE, &
1217:   &                               ' RMS=',RMS,' images=',INTIMAGE1133:   &                               ' RMS=',RMS,' images=',INTIMAGE
1218: ELSEIF (EXITSTATUS.EQ.2) THEN1134: ELSEIF (EXITSTATUS.EQ.2) THEN
1219:    WRITE(*,'(A,I6,A,G20.10,A,G15.8,A,I4)') ' intlbfgs> After ',NITERDONE,' steps, energy/image=',ETOTAL/INTIMAGE, &1135:    WRITE(*,'(A,I6,A,G20.10,A,G15.10,A,I4)') ' intlbfgs> After ',NITERDONE,' steps, energy/image=',ETOTAL/INTIMAGE, &
1220:   &                               ' RMS=',RMS,' images=',INTIMAGE1136:   &                               ' RMS=',RMS,' images=',INTIMAGE
1221: ENDIF1137: ENDIF
 1138: !
 1139: ! Linear interpolation for constraint potential and real potential separately.
 1140: ! Constraint potential need not be flat if we have done some steps with both
 1141: ! potentials turned on.
 1142: !
1222: 678 CONTINUE1143: 678 CONTINUE
 1144: DINCREMENT=0.02D0
 1145: DTOTAL=0.0D0
 1146: OPEN(UNIT=753,FILE='intenergy',STATUS='UNKNOWN')
 1147: !
 1148: ! local maxima must have NSIDE higher energies on each side
 1149: ! This has the desirable side-effect that we don't bother with
 1150: ! images that are essentially collapsed on each other - their
 1151: ! spacing will probably be < DINCREMENT, or 5*DINCREMENT.
 1152: !
 1153: NSIDE=10
 1154: ! EWINDOW(1:2*NSIDE+1)=-1.0D20
 1155: LTSFOUND=0
 1156: LMINFOUND=0
 1157: PRINTOPTIMIZETS=DEBUG
 1158: ! IF (.FALSE.) THEN
 1159: ! ALLOCATE(EWINDOW(2*NSIDE+1))
 1160: ! DO J1=1,INTIMAGE+1
 1161: !    DUMMY=0.0D0
 1162: !    DO J2=1,3*NATOMS
 1163: !       DUMMY=DUMMY+( XYZ((J1-1)*3*NATOMS+J2) - XYZ(J1*3*NATOMS+J2) )**2
 1164: !    ENDDO
 1165: !    DUMMY=SQRT(DUMMY)
 1166: !    DIST=0.0D0
 1167: !    IF (DEBUG) PRINT '(A,I6,A,I6,A,G20.10)',' intlbfgs> distance between images ',J1,' and ',J1+1,' is ',DUMMY
 1168: !    NDUMMY=DUMMY/DINCREMENT+1
 1169: !    J3=1
 1170: ! 
 1171: !    intloop: DO
 1172: !       LOCALCOORDS(1:3*NATOMS)=((DUMMY-DIST)*XYZ((J1-1)*3*NATOMS+1:J1*3*NATOMS)+ &
 1173: !   &                                    DIST*XYZ(J1*3*NATOMS+1:(J1+1)*3*NATOMS))/DUMMY
 1174: !       CALL POTENTIAL(LOCALCOORDS,EREAL,VNEW,.FALSE.,.FALSE.,RMS,.FALSE.,.FALSE.)
 1175: !       If (DEBUG) PRINT '(A,3G20.10)',' intlbfgs> ',DTOTAL+DIST,EREAL
 1176: !       WRITE(753,'(3G20.10)') DTOTAL+DIST,EREAL
 1177: !       DIST=DIST+DINCREMENT
 1178: !       DO J4=1,2*NSIDE
 1179: !          EWINDOW(J4)=EWINDOW(J4+1)
 1180: !       ENDDO
 1181: !       EWINDOW(2*NSIDE+1)=EREAL
 1182: !       IF ((J3.EQ.1).AND.(J1.EQ.1)) EWINDOW(1:2*NSIDE+1)=EREAL
 1183: !       IF (.FALSE.) THEN
 1184: !          DO J4=2,2*NSIDE
 1185: !             PRINT '(A,3I4,3G18.10)','J3,J4,NSIDE,EWINDOW(NSIDE+1),EWINDOW(J4),diff=', &
 1186: !   &                                  J3,J4,NSIDE,EWINDOW(NSIDE+1),EWINDOW(J4),EWINDOW(NSIDE+1)-EWINDOW(J4)
 1187: !             IF (J4.EQ.NSIDE+1) CYCLE
 1188: ! !           IF (EWINDOW(NSIDE+1).LT.EWINDOW(J4)+EDIFFTOL) GOTO 432
 1189: !             IF (EWINDOW(NSIDE+1).LT.EWINDOW(J4)) GOTO 432
 1190: !          ENDDO
 1191: !          IF (EWINDOW(NSIDE+1).LT.EWINDOW(1)+EDIFFTOL) GOTO 432
 1192: !          IF (EWINDOW(NSIDE+1).LT.EWINDOW(2*NSIDE+1)+EDIFFTOL) GOTO 432
 1193: ! !
 1194: ! ! We have a ts candidate. Try optimising it!
 1195: ! !
 1196: !          PRINT '(A,I8,A,F20.10)',' local maximum in QCI profile for NSIDE+1=',NSIDE+1,' dist=',DTOTAL+(J3-NSIDE-1)*DINCREMENT
 1197: !          CALL MYCPU_TIME(STARTTIME,.FALSE.)
 1198: !          KNOWG=.FALSE.
 1199: !          KNOWE=.FALSE. ! to be safe!
 1200: !          LOCALCOORDS(1:NOPT)= &
 1201: !   &              ((DUMMY-(J3-NSIDE-1)*DINCREMENT)*XYZ((J1-1)*NOPT+1:J1*NOPT)+ &
 1202: !   &                      (J3-NSIDE-1)*DINCREMENT *XYZ(J1*NOPT+1:(J1+1)*NOPT))/DUMMY
 1203: ! 
 1204: !          IF (BFGSTST) THEN
 1205: !             VECS(1:NOPT)=(XYZ((J1-1)*NOPT+1:J1*NOPT)-XYZ(J1*NOPT+1:(J1+1)*NOPT))/DUMMY
 1206: !             CALL BFGSTS(NSTEPS,LOCALCOORDS,  &
 1207: !   &            EDUMMY,LGDUMMY,TSCONVERGED,RMS,EVALMIN,EVALMAX,VECS,ITDONE,.TRUE.,PRINTOPTIMIZETS)
 1208: !          ELSE
 1209: !             CALL EFOL(LOCALCOORDS,TSCONVERGED,NSTEPS,EDUMMY,ITDONE,EVALMIN,DEBUG,XDIAG,2)
 1210: !          ENDIF
 1211: !          CALL MYCPU_TIME(TIME0,.FALSE.)
 1212: !          IF (TSCONVERGED) THEN
 1213: !             LTSFOUND=LTSFOUND+1
 1214: ! !
 1215: ! ! Save coordinates and direction vector between images to use as starting guess
 1216: ! ! for the eigenvector.
 1217: ! !
 1218: !             ALLOCATE(MYTSFOUND(LTSFOUND)%E,MYTSFOUND(LTSFOUND)%COORD(NOPT), &
 1219: !   &                  MYTSFOUND(LTSFOUND)%EVALMIN,MYTSFOUND(LTSFOUND)%VECS(NOPT))
 1220: !             MYTSFOUND(LTSFOUND)%VECS(1:NOPT)=VECS(1:NOPT)
 1221: !             MYTSFOUND(LTSFOUND)%COORD(1:NOPT)=LOCALCOORDS(1:NOPT)
 1222: !             MYTSFOUND(LTSFOUND)%E=EDUMMY
 1223: !             MYTSFOUND(LTSFOUND)%EVALMIN=EVALMIN
 1224: !             PRINT '(A,I6,A,G20.10,A,F10.1)',' intlbfgs> transition state found, iterations=',ITDONE, &
 1225: !   &                               ' energy=',EDUMMY,' time=',TIME0-STARTTIME
 1226: !          ELSE
 1227: !             PRINT '(A,I6,A,G20.10,A,F10.1)',' intlbfgs> transition state search failed in ',ITDONE, &
 1228: !   &                               ' iterations energy=',EDUMMY,' time=',TIME0-STARTTIME
 1229: !          ENDIF
 1230: ! 432      CONTINUE
 1231: !       ENDIF
 1232: !       J3=J3+1
 1233: !       IF (DIST.GT.DUMMY) EXIT INTLOOP
 1234: !       IF (J3.GT.NDUMMY) THEN
 1235: !          PRINT '(A,I6)',' intlbfgs> ERROR *** number of interpolated energies should not be ',J3
 1236: !       ENDIF
 1237: !    ENDDO intloop
 1238: !    DTOTAL=DTOTAL+DUMMY
 1239: ! ENDDO
 1240: ! DEALLOCATE(EWINDOW)
 1241: ! ENDIF
 1242: 
 1243: WHOLEDNEB=.TRUE.
 1244: 
 1245: IF (WHOLEDNEB) THEN
 1246:    PRINT '(A,I6,2(A,G20.10))',' intlbfgs> First  minimum number ',MIN1ID
 1247:    PRINT '(A,I6,2(A,G20.10))',' intlbfgs> Second minimum number ',MIN2ID
 1248: !
 1249: ! Run DNEB.
 1250: !
 1251:    STARTID=MIN1ID
 1252:    FINISHID=MIN2ID
 1253:    M1=MAX(STARTID,FINISHID)
 1254:    M2=MIN(STARTID,FINISHID)
 1255: !
 1256: !  Work out total distance along int path
 1257: !
 1258:    DTOTAL=0.0D0
 1259:    DO J1=1,INTIMAGE+1
 1260:       DUMMY=0.0D0
 1261:       DO J2=1,3*NATOMS
 1262:          DUMMY=DUMMY+( XYZ((J1-1)*3*NATOMS+J2) - XYZ(J1*3*NATOMS+J2) )**2
 1263:       ENDDO
 1264:       DUMMY=SQRT(DUMMY)
 1265:       DTOTAL=DTOTAL+DUMMY
 1266:    ENDDO
 1267:    IF (DEBUG) PRINT '(A,G20.10)',' intlbfgs> Total interpolated distance between end points is  ',DUMMY
1223: 1268: 
1224: CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ)1269:    NIMAGE=DTOTAL*(IMAGEDENSITY+IMAGEINCR*MI(M1)%DATA%NTRIES(M2))
1225: CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE) 
1226: 1270: 
1227: IF (DEBUG) WRITE(*,'(A,G20.10)') 'intlbfgs> WORST=',WORST1271:    IF (NIMAGE >= IMAGEMAX) NIMAGE=IMAGEMAX
 1272:    IF (NIMAGE >= IMAGEMAX) MI(MAX(STARTID,FINISHID))%DATA%NTRIES(MIN(STARTID,FINISHID))=NTRIESMAX
 1273:    IF (NIMAGE < 2 ) NIMAGE=2
 1274: 12 NITERMAX=NIMAGE*ITERDENSITY 
 1275: !  PRINT '(A,I8,G20.10,2F12.2,I8)',' NIMAGE,dist,IMAGEDENSITY,IMAGEINCR,NATTEMPTS=', &
 1276: ! &    NIMAGE,DTOTAL-DISTPREV,IMAGEDENSITY,IMAGEINCR,MI(M1)%DATA%NTRIES(M2)
 1277: 
 1278:    DISTPREV=0.0D0
 1279:    DINCREMENT=DTOTAL/(10.0D0*NIMAGE)
 1280:    CALL MAKEINTNEBIMAGES(NIMAGE,INTIMAGE,DINCREMENT,DISTPREV,DTOTAL,XYZ)
 1281: !  CALL MAKEINTNEBIMAGES2(NIMAGE,INTIMAGE,DINCREMENT,DISTPREV,DTOTAL,XYZ)
 1282:    PRINT '(A,2I6,A,G12.4,A,3I6)',' intlbfgs> DNEB for minima ',STARTID,FINISHID,' dist=', &
 1283:   &            DTOTAL,' Attempts, images and iterations=', &
 1284:   &                       MI(M1)%DATA%NTRIES(M2), NIMAGE, NITERMAX
 1285:    MI(M1)%DATA%NTRIES(M2)=MI(M1)%DATA%NTRIES(M2)+1
 1286:    TSRESET=.TRUE.
 1287:    CMIN1(1:3*NATOMS)=QSTART(1:3*NATOMS)
 1288:    LOCALCOORDS(1:3*NATOMS)=QFINISH(1:3*NATOMS)
 1289:    CALL POTENTIAL(QSTART,EINITIAL,VNEW,.FALSE.,.FALSE.,RMS,.FALSE.,.FALSE.)
 1290:    CALL POTENTIAL(QFINISH,EFINAL,VNEW,.FALSE.,.FALSE.,RMS,.FALSE.,.FALSE.)
 1291:    CALL NEWNEB(.FALSE.,DUMMY2,EINITIAL,CMIN1,EFINAL,LOCALCOORDS,TSRESET)
 1292: !
 1293: ! If the DNEB profile had no maximum then
 1294: ! allow a retry with more images and iterations.
 1295: !
 1296: ! Should not be necessary!
 1297: !
 1298: !  IF (NONEBMAX.AND.(NIMAGE.LT.IMAGEMAX)) THEN 
 1299: !     NIMAGE=2*NIMAGE+1
 1300: !     IF (NIMAGE >= IMAGEMAX) NIMAGE=IMAGEMAX
 1301: !     IF (NIMAGE >= IMAGEMAX) MI(MAX(STARTID,FINISHID))%DATA%NTRIES(MIN(STARTID,FINISHID))=NTRIESMAX
 1302: !     CALL FLUSH(6)
 1303: !     GOTO 12
 1304: !  ENDIF
 1305:    LTSFOUND=NTSFOUND
 1306:    DEALLOCATE(INTNEBIMAGES)
 1307:    CLOSE(753)
 1308: ELSE
 1309: !
 1310: ! Run DNEB for connections between local minima when changes are detected.
 1311: !
 1312:    LOCALCOORDS(1:3*NATOMS)=XYZ((INTIMAGE+1)*3*NATOMS+1:(INTIMAGE+2)*3*NATOMS)
 1313:    IF (CHRMMT) CALL UPDATENBONDS(LOCALCOORDS)
 1314:    CALL POTENTIAL(LOCALCOORDS,EREAL,VNEW,.FALSE.,.FALSE.,RMS,.FALSE.,.FALSE.)
 1315:    IF (DEBUG) PRINT '(A,3G20.10)',' intlbfgs> ',DTOTAL,EREAL
 1316:    WRITE(753,'(3G20.10)') DTOTAL,EREAL
 1317:    CLOSE(753)
 1318: !
 1319: ! local minima must have NSIDE higher energies on each side.
 1320: !
 1321:    DTOTAL=0.0D0
 1322:    NSIDE=10
 1323:    ALLOCATE(EWINDOW(2*NSIDE+1))
 1324:    LMINFOUND=0
 1325:    LTSFOUND=0
 1326:    PRINTOPTIMIZEMIN=DEBUG
 1327:    PTEST=.FALSE.
 1328:    INTMAXT=.FALSE.
 1329:    INTMAXE=-1.0D100
 1330:    INTMAXDIST=0.0D0
 1331:    INTMAXCOORDS(1:3*NATOMS)=0.0D0
 1332:    OPEN(UNIT=753,FILE='intenergy',STATUS='UNKNOWN')
 1333:    CMIN1(1:3*NATOMS)=0.0D0
 1334:    DO J1=1,INTIMAGE+1
 1335:       DUMMY=0.0D0
 1336:       DO J2=1,3*NATOMS
 1337:          DUMMY=DUMMY+( XYZ((J1-1)*3*NATOMS+J2) - XYZ(J1*3*NATOMS+J2) )**2
 1338:       ENDDO
 1339:       DUMMY=SQRT(DUMMY)
 1340:       DIST=0.0D0
 1341:       IF (DEBUG) PRINT '(A,I6,A,I6,A,G20.10)',' intlbfgs> distance between images ',J1,' and ',J1+1,' is ',DUMMY
 1342: !     PRINT '(2(A,I6))',' intlbfgs> Now doing image ',J1,' to ',J1+1
 1343:       NDUMMY=DUMMY/DINCREMENT+1
 1344:       J3=1
 1345:       intloop2: DO
 1346:          LOCALCOORDS(1:3*NATOMS)=((DUMMY-DIST)*XYZ((J1-1)*3*NATOMS+1:J1*3*NATOMS)+ &
 1347:   &                                    DIST*XYZ(J1*3*NATOMS+1:(J1+1)*3*NATOMS))/DUMMY
 1348:          IF (CHRMMT) CALL UPDATENBONDS(LOCALCOORDS)
 1349:          CALL POTENTIAL(LOCALCOORDS,EREAL,VNEW,.FALSE.,.FALSE.,RMS,.FALSE.,.FALSE.)
 1350:          WRITE(753,'(3G20.10)') DTOTAL+DIST,EREAL
 1351: !
 1352: ! Save energy and coordinates of starting image.
 1353: !
 1354:          IF ((J3.EQ.1).AND.(J1.EQ.1)) THEN
 1355:             EMINPREV=EREAL
 1356:             CMIN1(1:3*NATOMS)=LOCALCOORDS(1:3*NATOMS)
 1357:             STARTID=MIN1ID
 1358:             DISTPREV=0.0D0
 1359:             PRINT '(A)',' '
 1360:             PRINT '(2(A,G20.10))',' intlbfgs> Start  minimum energy=',EMINPREV,' distance=',DISTPREV
 1361:          ENDIF
 1362:          IF (DEBUG) PRINT '(A,3G20.10)',' intlbfgs> ',DTOTAL+DIST,EREAL
 1363:          DIST=DIST+DINCREMENT
 1364:          DO J4=1,2*NSIDE
 1365:             EWINDOW(J4)=EWINDOW(J4+1)
 1366:          ENDDO
 1367:          EWINDOW(2*NSIDE+1)=EREAL
 1368:          IF ((J3.EQ.1).AND.(J1.EQ.1)) EWINDOW(1:2*NSIDE+1)=EREAL
 1369: !
 1370: ! Look for local maximum
 1371: !
 1372:          DO J4=2,2*NSIDE
 1373: !        PRINT '(A,3I4,3G18.10)','J3,J4,NSIDE,EWINDOW(NSIDE+1),EWINDOW(J4),diff=', &
 1374: ! &                                  J3,J4,NSIDE,EWINDOW(NSIDE+1),EWINDOW(J4),EWINDOW(NSIDE+1)-EWINDOW(J4)
 1375:          IF (J4.EQ.NSIDE+1) CYCLE
 1376: !        IF (EWINDOW(NSIDE+1).LT.EWINDOW(J4)+EDIFFTOL) GOTO 423
 1377:             IF (EWINDOW(NSIDE+1).LT.EWINDOW(J4)) GOTO 423
 1378:          ENDDO
 1379:          IF (EWINDOW(NSIDE+1).LT.EWINDOW(1)+EDIFFTOL) GOTO 423
 1380:          IF (EWINDOW(NSIDE+1).LT.EWINDOW(2*NSIDE+1)+EDIFFTOL) GOTO 423
 1381:          IF (DEBUG) PRINT '(A,I8,2(A,F20.10))',' local maximum in QCI profile for NSIDE+1=',NSIDE+1,' energy=', &
 1382:   &                               EWINDOW(NSIDE+1),' dist=',DTOTAL+(J3-NSIDE-1)*DINCREMENT
 1383: !
 1384: ! Update coordinates of highest maximum since last reset.
 1385: !
 1386:          IF ((.NOT.INTMAXT).OR.(EWINDOW(NSIDE+1).GT.INTMAXE)) THEN
 1387:             INTMAXT=.TRUE.
 1388:             INTMAXE=EWINDOW(NSIDE+1)
 1389:             INTMAXDIST=DTOTAL+(J3-NSIDE-1)*DINCREMENT
 1390:             INTMAXCOORDS(1:3*NATOMS)=&
 1391:   &           ((DUMMY-(J3-NSIDE-1)*DINCREMENT)*XYZ((J1-1)*NOPT+1:J1*NOPT)+ &
 1392:   &                   (J3-NSIDE-1)*DINCREMENT *XYZ(J1*NOPT+1:(J1+1)*NOPT))/DUMMY
 1393:          ENDIF
 1394: 423      CONTINUE
 1395: 
 1396:          DO J4=2,2*NSIDE
 1397: !        PRINT '(A,3I4,3G18.10)','J3,J4,NSIDE,EWINDOW(NSIDE+1),EWINDOW(J4),diff=', &
 1398: ! &                                  J3,J4,NSIDE,EWINDOW(NSIDE+1),EWINDOW(J4),EWINDOW(NSIDE+1)-EWINDOW(J4)
 1399:             IF (J4.EQ.NSIDE+1) CYCLE
 1400: !        IF (EWINDOW(J4).LT.EWINDOW(NSIDE+1)+EDIFFTOL) GOTO 431
 1401:             IF (EWINDOW(J4).LT.EWINDOW(NSIDE+1)) GOTO 431
 1402:          ENDDO
 1403:          IF (EWINDOW(1).LT.EWINDOW(NSIDE+1)+EDIFFTOL) GOTO 431
 1404:          IF (EWINDOW(2*NSIDE+1).LT.EWINDOW(NSIDE+1)+EDIFFTOL) GOTO 431
 1405: !
 1406: ! We have a min candidate. Try optimising it!
 1407: !
 1408:          IF (DEBUG) PRINT '(A,I8,A,F20.10)',' local minimum in QCI profile for NSIDE+1=',NSIDE+1,' dist=', &
 1409:   &                    DTOTAL+(J3-NSIDE-1)*DINCREMENT
 1410:          CALL MYCPU_TIME(STARTTIME,.FALSE.)
 1411:          KNOWG=.FALSE.
 1412:          KNOWE=.FALSE. ! to be safe!
 1413:          LOCALCOORDS(1:NOPT)= &
 1414:   &           ((DUMMY-(J3-NSIDE-1)*DINCREMENT)*XYZ((J1-1)*NOPT+1:J1*NOPT)+ &
 1415:   &                   (J3-NSIDE-1)*DINCREMENT *XYZ(J1*NOPT+1:(J1+1)*NOPT))/DUMMY
 1416: 
 1417:          CALL MYLBFGS(NOPT,MUPDATE,LOCALCOORDS,.FALSE., &
 1418:   &               MFLAG,EDUMMY,RMS2,EREAL,RMS,BFGSSTEPS,.TRUE.,ITDONE,PTEST,VNEW,.TRUE.,.FALSE.)
 1419: 
 1420:          ALLOCATE(MINFOUND(NMIN+1)%E,MINFOUND(NMIN+1)%COORD(NOPT))
 1421:          MINFOUND(NMIN+1)%COORD(1:NOPT)=LOCALCOORDS(1:NOPT)
 1422:          MINFOUND(NMIN+1)%E=EDUMMY
 1423:       
 1424:          CALL MYCPU_TIME(TIME0,.FALSE.)
 1425:          IF (MFLAG) THEN
 1426:             PRINT '(A,I6,A,G20.10,A,F10.1)',' intlbfgs> minimum found, iterations=',ITDONE, &
 1427:   &                            ' energy=',EDUMMY,' time=',TIME0-STARTTIME
 1428: !
 1429: !  This is the procedure to identify and add a new minimum.
 1430: !
 1431:             NULLIFY(PINTERPCOORDS,PENERGY)
 1432:             ALLOCATE(PINTERPCOORDS(NOPT),PENERGY)
 1433:             OPEN(UNIT=781,FILE='minscratch',STATUS='UNKNOWN')
 1434:             WRITE(781,*) EDUMMY,LOCALCOORDS(1:NOPT)
 1435:             REWIND(781)
 1436:             READ(781,*) PENERGY,PINTERPCOORDS
 1437:             CLOSE(781)
 1438:             CALL ISNEWMIN(PENERGY,PINTERPCOORDS,POSITION,MINNEW,REDOPATH,PERMUTE,INVERT,INDEX,IMATCH)
 1439: 
 1440:             IF (MINNEW) THEN
 1441:                CALL ADDNEWMIN(PENERGY,PINTERPCOORDS)
 1442: !              PRINT*, PINTERPCOORDS(:)
 1443:                WRITE(*,'(A,I7,A,G20.10)') ' intlbfgs> added new minimum ',NMIN,' energy=',PENERGY
 1444:             ELSE
 1445:                WRITE(*,'(A,I7)') ' tryconnect> found old minimum ',POSITION
 1446:                NULLIFY(PINTERPCOORDS,PENERGY)
 1447:                DEALLOCATE(MINFOUND(NMIN+1)%E,MINFOUND(NMIN+1)%COORD)
 1448:             ENDIF
 1449:             FINISHID=POSITION
 1450: 
 1451:             IF (STARTID.NE.FINISHID) THEN
 1452:                PRINT '(A)',' intlbfgs> Minimum has changed'
 1453:                PRINT '(A,I6,2(A,G20.10))',' intlbfgs> First  minimum number ',STARTID,' energy=',EMINPREV,' distance=',DISTPREV
 1454:                PRINT '(A,I6,2(A,G20.10))',' intlbfgs> Second minimum number ',FINISHID,' energy=',EDUMMY,' distance=', &
 1455:   &               DTOTAL+(J3-NSIDE-1)*DINCREMENT
 1456:                PRINT '(2(A,G20.10))',' intlbfgs> Highest maximum between minima energy=',INTMAXE, &
 1457:   &                                  ' distance=',INTMAXDIST
 1458: !
 1459: ! Run DNEB.
 1460: !
 1461:                M1=MAX(STARTID,FINISHID)
 1462:                M2=MIN(STARTID,FINISHID)
 1463:                NIMAGE=(DTOTAL+(J3-NSIDE-1)*DINCREMENT-DISTPREV)*(IMAGEDENSITY+IMAGEINCR*MI(M1)%DATA%NTRIES(M2))
 1464: 
 1465:                IF (NIMAGE >= IMAGEMAX) NIMAGE=IMAGEMAX
 1466:                IF (NIMAGE >= IMAGEMAX) MI(MAX(STARTID,FINISHID))%DATA%NTRIES(MIN(STARTID,FINISHID))=NTRIESMAX
 1467:                IF (NIMAGE < 2 ) NIMAGE=2
 1468:                NITERMAX=NIMAGE*ITERDENSITY 
 1469:                PRINT '(A,I8,G20.10,2F12.2,I8)',' NIMAGE,dist,IMAGEDENSITY,IMAGEINCR,NATTEMPTS=', &
 1470:   &                NIMAGE,DTOTAL-DISTPREV,IMAGEDENSITY,IMAGEINCR,MI(M1)%DATA%NTRIES(M2)
 1471: 
 1472: !              CALL MINPERMDIST(CMIN1,LOCALCOORDS,NATOMS,DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,DISTANCE,DIST2, &
 1473: !  &                             RIGIDBODY,RMAT)
 1474:                CALL MAKEINTNEBIMAGES(NIMAGE,INTIMAGE,DINCREMENT,DISTPREV,DTOTAL+(J3-NSIDE-1)*DINCREMENT,XYZ)
 1475:                PRINT '(A,2I6,A,G12.4,A,3I6)',' intlbfgs> DNEB for minima ',STARTID,FINISHID,' dist=', &
 1476:   &                        DTOTAL+(J3-NSIDE-1)*DINCREMENT-DISTPREV,' Attempts, images and iterations=', &
 1477:   &                                   MI(M1)%DATA%NTRIES(M2), NIMAGE, NITERMAX
 1478:                MI(M1)%DATA%NTRIES(M2)=MI(M1)%DATA%NTRIES(M2)+1
 1479:                TSRESET=.FALSE.
 1480:                IF (LTSFOUND.EQ.0) TSRESET=.TRUE.
 1481:                CALL NEWNEB(.FALSE.,DUMMY2,EMINPREV,CMIN1,EDUMMY,LOCALCOORDS,TSRESET)
 1482:                LTSFOUND=NTSFOUND
 1483: !              PRINT '(A,I6)','NTSFOUND,LTSFOUND=',NTSFOUND,LTSFOUND
 1484:                DEALLOCATE(INTNEBIMAGES)
1228: 1485: 
1229: BESTWORST=WORST1486:                EMINPREVPREV=EMINPREV
1230: BESTINTIMAGE=INTIMAGE1487:                DISTPREVPREV=DISTPREV
1231: IF (ALLOCATED(QCIXYZ)) DEALLOCATE(QCIXYZ)1488:             ELSE
1232: ALLOCATE(QCIXYZ(3*NATOMS*(INTIMAGE+2)))1489:                PRINT '(A)',' intlbfgs> Minimum has not changed'
1233: QCIXYZ(1:3*NATOMS*(INTIMAGE+2))=XYZ(1:3*NATOMS*(INTIMAGE+2))1490:             ENDIF
1234: WRITE(*,'(A,I8,A,G20.10)') 'intlbfgs> retaining ',INTIMAGE,' QCI images, highest energy=',BESTWORST1491:             EMINPREV=EDUMMY
 1492:             DISTPREV=DTOTAL+(J3-NSIDE-1)*DINCREMENT
 1493:             CMIN1(1:3*NATOMS)=LOCALCOORDS(1:3*NATOMS)
 1494:             STARTID=FINISHID
 1495:          ELSE
 1496:             PRINT '(A,I6,A,G20.10,A,F10.1)',' intlbfgs> minimisation failed in ',ITDONE, &
 1497:   &                            ' iterations energy=',EDUMMY,' time=',TIME0-STARTTIME
 1498:          ENDIF
 1499: 431      CONTINUE
1235: 1500: 
1236: CALL INTRWG(NACTIVE,0,INTIMAGE,XYZ)1501:          J3=J3+1
1237: CALL WRITEPROFILE(0,EEE,INTIMAGE)1502:          IF (DIST.GT.DUMMY) EXIT intloop2
 1503:          IF (J3.GT.NDUMMY) THEN
 1504:             PRINT '(A,I6)',' intlbfgs> ERROR *** number of interpolated energies should not be ',J3
 1505:          ENDIF
 1506:       ENDDO intloop2
 1507:       DTOTAL=DTOTAL+DUMMY
 1508:    ENDDO
 1509: !
 1510: ! Now check energy of the FINISH end minimum to see if there is another maximum
 1511: ! we might have bracketed.
 1512: !
 1513:    LOCALCOORDS(1:3*NATOMS)=XYZ((INTIMAGE+1)*3*NATOMS+1:(INTIMAGE+2)*3*NATOMS)
 1514:    IF (CHRMMT) CALL UPDATENBONDS(LOCALCOORDS)
 1515:    CALL POTENTIAL(LOCALCOORDS,EDUMMY,VNEW,.FALSE.,.FALSE.,RMS,.FALSE.,.FALSE.)
 1516:    WRITE(753,'(3G20.10)') DTOTAL,EREAL
 1517:    CLOSE(753)
 1518:    FINISHID=MIN2ID
 1519: 
 1520: ! IF (ABS(EDUMMY-EMINPREV).GT.EDIFFTOL) THEN
 1521:    IF (STARTID.NE.FINISHID) THEN
 1522: !
 1523: ! Now run DNEB for the last two minima, including the end minimum.
 1524: !
 1525:       PRINT '(A,G20.10)',' intlbfgs> Now running final transition state search involving end point minimum'
 1526:       PRINT '(A,I6,2(A,G20.10))',' intlbfgs> First  minimum number ',STARTID,' energy=',EMINPREV,' distance=',DISTPREV
 1527:       PRINT '(A,I6,2(A,G20.10))',' intlbfgs> Second minimum number ',FINISHID,' energy=',EDUMMY,' distance=', &
 1528:   &               DTOTAL+(J3-NSIDE-1)*DINCREMENT
 1529: 
 1530:       M1=MAX(STARTID,FINISHID)
 1531:       M2=MIN(STARTID,FINISHID)
 1532:       NIMAGE=(DTOTAL-DISTPREV)*(IMAGEDENSITY+IMAGEINCR*MI(M1)%DATA%NTRIES(M2))
 1533: 
 1534:       IF (NIMAGE >= IMAGEMAX) NIMAGE=IMAGEMAX
 1535:       IF (NIMAGE >= IMAGEMAX) MI(M1)%DATA%NTRIES(M2)=NTRIESMAX
 1536:       IF (NIMAGE < 2 ) NIMAGE=2
 1537:       NITERMAX=NIMAGE*ITERDENSITY 
 1538: 
 1539:       PRINT '(A,I8,G20.10,2F12.2,I8)',' NIMAGE,dist,IMAGEDENSITY,IMAGEINCR,NATTEMPTS=', &
 1540:   &                 NIMAGE,DTOTAL-DISTPREV,IMAGEDENSITY,IMAGEINCR,MI(M1)%DATA%NTRIES(M2)
 1541: 
 1542: !  CALL MINPERMDIST(CMIN1,LOCALCOORDS,NATOMS,DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,DISTANCE,DIST2,RIGIDBODY,RMAT)
 1543:       CALL MAKEINTNEBIMAGES(NIMAGE,INTIMAGE,DINCREMENT,DISTPREV,DTOTAL,XYZ)
 1544:       PRINT '(A,2I6,A,G12.4,A,3I6)',' intlbfgs> DNEB run for minima ',STARTID,FINISHID,' dist=', &
 1545:   &       DTOTAL-DISTPREV,' Attempts, images and iterations=', &
 1546:   &          MI(M1)%DATA%NTRIES(M2), NIMAGE, NITERMAX
 1547: 
 1548:       MI(M1)%DATA%NTRIES(M2)=MI(M1)%DATA%NTRIES(M2)+1
 1549:       TSRESET=.FALSE.
 1550:       IF (LTSFOUND.EQ.0) TSRESET=.TRUE.
 1551:       CALL NEWNEB(.FALSE.,DUMMY2,EMINPREV,CMIN1,EDUMMY,LOCALCOORDS,TSRESET)
 1552:       DEALLOCATE(INTNEBIMAGES)
 1553:       LTSFOUND=NTSFOUND
 1554: !  PRINT '(A,I6)','NTSFOUND,LTSFOUND=',NTSFOUND,LTSFOUND
 1555:    ENDIF
 1556:    PRINT '(A,I6)',' intlbfgs> Total number of transition states located=',LTSFOUND
 1557:    DEALLOCATE(EWINDOW)
 1558: ENDIF
1238: 1559: 
1239: DEALLOCATE(CONI,CONJ,CONDISTREF,REPI,REPJ,NREPI,NREPJ,REPCUT,NREPCUT,CONCUT)1560: DEALLOCATE(CONI,CONJ,CONDISTREF,REPI,REPJ,NREPI,NREPJ,REPCUT,NREPCUT,CONCUT)
1240: DEALLOCATE(TRUEEE, EEETMP, MYGTMP, GTMP, &1561: DEALLOCATE(TRUEEE, EEETMP, MYGTMP, GTMP, &
1241:   &      DIAG, STP, SEARCHSTEP, GDIF,GLAST, XSAVE, XYZ, GGG, CHECKG, IMGFREEZE, EEE, STEPIMAGE)1562:   &      DIAG, STP, SEARCHSTEP, GDIF,GLAST, XSAVE, XYZ, GGG, CHECKG, IMGFREEZE, EEE, STEPIMAGE)
1242: QCIIMAGE=INTIMAGE 
1243: INTIMAGE=INTIMAGESAVE1563: INTIMAGE=INTIMAGESAVE
1244: 1564: 
1245: END SUBROUTINE INTLBFGS1565: END SUBROUTINE INTLBFGS
1246: !1566: !
 1567: ! Possible redistribution of images for INTCONSTRAINT depending upon distances.
 1568: !
 1569: SUBROUTINE CHECKSEP(NMAXINT,NMININT,INTIMAGE,XYZ,NOPT,NATOMS)
 1570: IMPLICIT NONE
 1571: INTEGER NSEPMAX, NSEPMIN, J, NMININT, NMAXINT, INTIMAGE, NOPT, J1, J2, NATOMS
 1572: DOUBLE PRECISION SEPMAX, SEPMIN, XYZ(*), DUMMY
 1573: 
 1574: RETURN !!! DJW
 1575: 
 1576: IF ((NMININT.EQ.NMAXINT).OR.(NMININT.EQ.NMAXINT+1)) THEN
 1577:    PRINT '(A,2I6)',' checksep> skipping image redistribution for images ',NMININT,NMAXINT
 1578:    RETURN
 1579: ENDIF
 1580: IF ((NMININT.EQ.1).OR.(NMININT.EQ.INTIMAGE+2)) THEN
 1581:    PRINT '(A,I6)',' checksep> ERROR *** NMININT=',NMININT
 1582: ENDIF
 1583: IF ((NMAXINT.EQ.1).OR.(NMAXINT.EQ.INTIMAGE+2)) THEN
 1584:    PRINT '(A,I6)',' checksep> ERROR *** NMAXINT=',NMAXINT
 1585: ENDIF
 1586: ! 
 1587: ! DVEC(J) contains the distance between image J and image J+1
 1588: !
 1589: !      SEPMAX=-1.0D0
 1590: !      SEPMIN=1.0D100
 1591: !      DO J=1,INTIMAGE+1
 1592: !         IF (DVEC(J).GT.SEPMAX) THEN
 1593: !            SEPMAX=DVEC(J)
 1594: !            NSEPMAX=J
 1595: !         ENDIF
 1596: !      ENDDO
 1597: !      DO J=2,INTIMAGE+1
 1598: !         IF (DVEC(J-1)+DVEC(J).LT.SEPMIN) THEN
 1599: !            SEPMIN=DVEC(J-1)+DVEC(J)
 1600: !            NSEPMIN=J
 1601: !         ENDIF
 1602: !      ENDDO
 1603: !      PRINT '(A,F20.10,A,I6,A,I6)',' checksep> maximum image separation=',SEPMAX,' for images ',NSEPMAX,' and ',NSEPMAX+1
 1604: !      PRINT '(A,F20.10,A,I6)',' checksep> minimum sum of image separations=',SEPMIN,' for image ',NSEPMIN
 1605: 
 1606: !    IF (SEPMIN*2.0D0.LT.SEPMAX) THEN ! redistribute images
 1607: 
 1608: IF (.TRUE.) THEN ! redistribute images
 1609:    PRINT '(A,I6,A,2I6)',' checksep> removing image ',NMININT,' and adding one between images ',NMAXINT,NMAXINT+1
 1610: !  IF (NSEPMIN.LT.NSEPMAX) THEN
 1611:    IF (NMININT.LT.NMAXINT) THEN
 1612: !     DO J=NSEPMIN,NSEPMAX-1 ! move image J+1 to position J for images J=NSEPMIN+1 to NSEPMAX-1
 1613:       DO J=NMININT,NMAXINT-1 ! move image J+1 to position J for images J=NMININT+1 to NMAXINT-1
 1614:          XYZ(NOPT*(J-1)+1:NOPT*J)=XYZ(NOPT*J+1:NOPT*(J+1))
 1615:       ENDDO
 1616: !     XYZ(NOPT*(NSEPMAX-1)+1:NOPT*NSEPMAX)=(XYZ(NOPT*(NSEPMAX-1)+1:NOPT*NSEPMAX)+XYZ(NOPT*NSEPMAX+1:NOPT*(NSEPMAX+1)))/2.0D0
 1617:       XYZ(NOPT*(NMAXINT-1)+1:NOPT*NMAXINT)=(XYZ(NOPT*(NMAXINT-1)+1:NOPT*NMAXINT)+XYZ(NOPT*NMAXINT+1:NOPT*(NMAXINT+1)))/2.0D0
 1618:    ELSE
 1619: !     DO J=NSEPMIN,NSEPMAX+2,-1 ! move image J-1 to position J for images J=NSEPMIN-1 to NSEPMAX+1
 1620:       DO J=NMININT,NMAXINT+2,-1 ! move image J-1 to position J for images J=NMININT-1 to NMAXINT+1
 1621:          PRINT '(2(A,I6))',' putting image ',J-1,' in image ',J
 1622:          XYZ(NOPT*(J-1)+1:NOPT*J)=XYZ(NOPT*(J-2)+1:NOPT*(J-1))
 1623:       ENDDO
 1624:       XYZ(NOPT*NMAXINT+1:NOPT*(NMAXINT+1))=(XYZ(NOPT*NMAXINT+1:NOPT*(NMAXINT+1))+XYZ(NOPT*(NMAXINT-1)+1:NOPT*NMAXINT))/2.0D0
 1625:    ENDIF
 1626: ENDIF
 1627: 
 1628: END SUBROUTINE CHECKSEP
 1629: !
1247: ! Neighbour list for repulsions to reduce cost of constraint potential.1630: ! Neighbour list for repulsions to reduce cost of constraint potential.
1248: !1631: !
1249: SUBROUTINE CHECKREP(INTIMAGE,XYZ,NOPT,NNSTART,NSTART)1632: SUBROUTINE CHECKREP(INTIMAGE,XYZ,NOPT,NNSTART,NSTART)
1250: USE KEY,ONLY : NREPI, NREPJ, NREPCUT, NNREPULSIVE, NREPULSIVE, REPI, REPJ, REPCUT, CHECKREPCUTOFF, &1633: USE KEY,ONLY : NREPI, NREPJ, NREPCUT, NNREPULSIVE, NREPULSIVE, REPI, REPJ, REPCUT, CHECKREPCUTOFF
1251:   &                INTFROZEN, NNREPULSIVE, intconstraintrep1634: USE COMMONS,ONLY : DEBUG
1252: USE COMMONS, ONLY : DEBUG 
1253: USE PORFUNCS1635: USE PORFUNCS
1254: IMPLICIT NONE1636: IMPLICIT NONE
1255: INTEGER JJ, KK, NI1, NJ1, NI2, NJ2, INTIMAGE, NOPT, NI, NJ, NNSTART, NSTART1637: INTEGER JJ, KK, NI1, NJ1, NI2, NJ2, INTIMAGE, NOPT, ISTAT, NI, NJ, NNSTART, NSTART
1256: DOUBLE PRECISION LDIST, XYZ(NOPT*(INTIMAGE+2)),COMPARE1638: DOUBLE PRECISION LDIST, XYZ(NOPT*(INTIMAGE+2)),COMPARE
1257: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,DMIN1639: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,DMIN
1258: LOGICAL NOINT1640: LOGICAL NOINT
1259: 1641: 
1260: IF (INTCONSTRAINTREP.EQ.0) THEN 
1261:    NNREPULSIVE=0 
1262:    RETURN 
1263: ENDIF 
1264:  
1265: NNREPULSIVE=NNSTART1642: NNREPULSIVE=NNSTART
1266: DO JJ=NSTART,NREPULSIVE1643: DO JJ=NSTART,NREPULSIVE
1267:    COMPARE=(CHECKREPCUTOFF*REPCUT(JJ))**21644:    COMPARE=(CHECKREPCUTOFF*REPCUT(JJ))**2
1268:    NI=REPI(JJ)1645:    NI=REPI(JJ)
1269:    NJ=REPJ(JJ)1646:    NJ=REPJ(JJ)
1270:    DO KK=1,INTIMAGE+2 ! first check for standard distances within threshold1647:    DO KK=1,INTIMAGE+2 ! first check for standard distances within threshold
1271:       LDIST=(XYZ((KK-1)*NOPT+3*(NI-1)+1)-XYZ((KK-1)*NOPT+3*(NJ-1)+1))**2 &1648:       LDIST=(XYZ((KK-1)*NOPT+3*(NI-1)+1)-XYZ((KK-1)*NOPT+3*(NJ-1)+1))**2 &
1272:   &        +(XYZ((KK-1)*NOPT+3*(NI-1)+2)-XYZ((KK-1)*NOPT+3*(NJ-1)+2))**2 &1649:   &        +(XYZ((KK-1)*NOPT+3*(NI-1)+2)-XYZ((KK-1)*NOPT+3*(NJ-1)+2))**2 &
1273:   &        +(XYZ((KK-1)*NOPT+3*(NI-1)+3)-XYZ((KK-1)*NOPT+3*(NJ-1)+3))**21650:   &        +(XYZ((KK-1)*NOPT+3*(NI-1)+3)-XYZ((KK-1)*NOPT+3*(NJ-1)+3))**2
1274:       IF (LDIST.LT.COMPARE) THEN1651:       IF (LDIST.LT.COMPARE) THEN
1296:       IF (DMIN.LT.COMPARE) THEN1673:       IF (DMIN.LT.COMPARE) THEN
1297:          NNREPULSIVE=NNREPULSIVE+11674:          NNREPULSIVE=NNREPULSIVE+1
1298:          NREPI(NNREPULSIVE)=NI1675:          NREPI(NNREPULSIVE)=NI
1299:          NREPJ(NNREPULSIVE)=NJ1676:          NREPJ(NNREPULSIVE)=NJ
1300:          NREPCUT(NNREPULSIVE)=REPCUT(JJ)1677:          NREPCUT(NNREPULSIVE)=REPCUT(JJ)
1301:          GOTO 2461678:          GOTO 246
1302:       ENDIF1679:       ENDIF
1303:    ENDDO 1680:    ENDDO 
1304: 246 CONTINUE1681: 246 CONTINUE
1305: ENDDO1682: ENDDO
1306: IF (DEBUG) WRITE(*,'(A,2I8)') ' checkrep> number of active repulsions and total=',NNREPULSIVE,NREPULSIVE1683: IF (DEBUG) PRINT '(A,2I8)',' checkrep> number of active repulsions and total=',NNREPULSIVE,NREPULSIVE
1307: 1684: 
1308: END SUBROUTINE CHECKREP1685: END SUBROUTINE CHECKREP
1309: 1686: 
1310: SUBROUTINE INTRWG(NACTIVE,NITER,INTIMAGE,XYZ)1687: SUBROUTINE INTRWG(NACTIVE,NITER,INTIMAGE,XYZ)
1311: USE PORFUNCS1688: USE PORFUNCS
1312: USE KEY,ONLY: STOCKT,STOCKAAT, RBAAT, ATOMACTIVE1689: USE KEY,ONLY: FILTH,FILTHSTR,STOCKT,AMHT,SEQ,NUMGLY,STOCKAAT, RBAAT,ATOMACTIVE
1313: USE COMMONS, ONLY: NATOMS1690: USE COMMONS, ONLY: ZSYM, NRBSITES 
 1691: USE AMHGLOBALS, ONLY : NMRES
 1692: USE COMMONS, ONLY: NATOMS, NOPT
1314: IMPLICIT NONE1693: IMPLICIT NONE
1315: CHARACTER(LEN=10) :: XYZFILE   = 'int.xyz   '1694: CHARACTER(LEN=10) :: XYZFILE   = 'int.xyz   '
 1695: CHARACTER(LEN=12) :: RBXYZFILE = 'rbint.xyz   '
1316: INTEGER,INTENT(IN) :: NITER1696: INTEGER,INTENT(IN) :: NITER
1317: INTEGER :: J1,J2,INTIMAGE,J3,NACTIVE1697: INTEGER :: J1,J2,J3,GLY_COUNT,INTIMAGE,NACTIVE
1318: CHARACTER(LEN=80) :: FILENAME,DUMMYS1698: CHARACTER(LEN=80) :: FILENAME,FILENAME2,DUMMYS,DUMMYS2
1319: DOUBLE PRECISION XYZ((3*NATOMS)*(INTIMAGE+2))1699: DOUBLE PRECISION XYZ(NOPT*(INTIMAGE+2))
1320: 1700: 
1321: FILENAME=XYZFILE1701: IF (FILTH.EQ.0) THEN
 1702:    FILENAME=XYZFILE
 1703:    IF (RBAAT) FILENAME2=RBXYZFILE
 1704: ELSE
 1705:    FILENAME=TRIM(XYZFILE)//'.'//TRIM(ADJUSTL(FILTHSTR))
 1706:    IF (RBAAT) FILENAME2=TRIM(RBXYZFILE)//'.'//TRIM(ADJUSTL(FILTHSTR))
 1707: ENDIF 
1322: 1708: 
1323: IF (NITER.GT.0) THEN1709: IF (NITER.GT.0) THEN
1324:    WRITE(DUMMYS,'(I8)') NITER1710:    IF (FILTH.EQ.0) THEN
1325:    FILENAME='int.' // TRIM(ADJUSTL(DUMMYS)) // '.xyz' ! so that vmd recognises the file type!1711:       WRITE(DUMMYS,'(I8)') NITER
 1712:       DUMMYS2=TRIM(ADJUSTL(FILENAME))
 1713:       FILENAME='int.' // TRIM(ADJUSTL(DUMMYS)) // '.xyz' ! so that vmd recognises the file type!
 1714:       FILENAME2='rbint.' // TRIM(ADJUSTL(DUMMYS)) // '.xyz'
 1715:    ELSE 
 1716:       WRITE(DUMMYS,'(I8)') NITER
 1717:       DUMMYS2=TRIM(ADJUSTL(FILENAME))
 1718:       FILENAME='int.' // TRIM(ADJUSTL(DUMMYS)) // '.' // TRIM(ADJUSTL(FILTHSTR)) // '.xyz' 
 1719:       FILENAME2='rbint.' // TRIM(ADJUSTL(DUMMYS)) // '.' // TRIM(ADJUSTL(FILTHSTR)) // '.xyz'
 1720:    ENDIF
1326: ENDIF1721: ENDIF
1327: OPEN(UNIT=993,FILE=FILENAME,STATUS='replace')1722: OPEN(UNIT=993,FILE=FILENAME,STATUS='replace')
1328: DO J2=1,INTIMAGE+21723: IF (STOCKT .OR. STOCKAAT) THEN
1329: !  WRITE(993,'(i4/)') NACTIVE1724:    DO J2=1,INTIMAGE+2 
1330:    WRITE(993,'(i4/)') NATOMS1725:       WRITE(993,'(i4/)') (natoms/2)
1331:    DO J3=1,NATOMS1726:       DO J1=1,(natoms/2) 
1332:       IF (ATOMACTIVE(J3)) THEN1727:          WRITE(993,'(a5,1x,6f20.10)') ZSYM((j1+2)/3), &
1333:          WRITE(993,'(A5,1X,3F20.10)') 'LA   ',XYZ((J2-1)*3*NATOMS+3*(J3-1)+1),XYZ((J2-1)*3*NATOMS+3*(J3-1)+2), &  1728:   & XYZ((J2-1)*NOPT+3*(J1-1)+1), XYZ((J2-1)*NOPT+3*(J1-1)+2), XYZ((J2-1)*NOPT+3*(J1-1)+3), &
1334:   &                                                                   XYZ((J2-1)*3*NATOMS+3*(J3-1)+3)  1729:   &    XYZ((J2-1)*NOPT+3*((natoms/2)+J1-1)+1), XYZ((J2-1)*NOPT+3*((natoms/2)+J1-1)+2), XYZ((J2-1)*NOPT+3*((natoms/2)+J1-1)+3)
1335:       ELSE1730:       ENDDO
1336:          WRITE(993,'(A5,1X,3F20.10)') 'DU   ',XYZ((J2-1)*3*NATOMS+3*(J3-1)+1),XYZ((J2-1)*3*NATOMS+3*(J3-1)+2), &   
1337:   &                                                                   XYZ((J2-1)*3*NATOMS+3*(J3-1)+3)   
1338:       ENDIF 
1339:    ENDDO1731:    ENDDO
1340: ENDDO1732: ELSEIF (RBAAT .AND. (.NOT. STOCKAAT)) THEN
 1733:    PRINT '(A)',' intlbfgs> ERROR *** RGW routine needs to be taught STXYZ for this potential'
 1734:    STOP
 1735: !  OPEN(UNIT=114,FILE=FILENAME2,STATUS='unknown')
 1736: !  DO J2=1,INTIMAGE+2
 1737: !     WRITE(993,'(i4/)') NATOMS/2
 1738: !     DO J1=1,(NATOMS/2) 
 1739: !        WRITE(993,'(a5,1x,3f20.10)') 'O', &
 1740: ! & XYZ((J2-1)*NOPT+3*(J1-1)+1), XYZ((J2-1)*NOPT+3*(J1-1)+2), XYZ((J2-1)*NOPT+3*(J1-1)+3)
 1741: !     ENDDO
 1742: !     CALL SITEPOS(XYZ((J2-1)*NOPT+1:J2*NOPT),STXYZ)
 1743: !     WRITE(114,'(i4/)') (NATOMS/2)*NRBSITES
 1744: !     DO J1=1,(NATOMS/2)*NRBSITES
 1745: !        J3 = 3*J1
 1746: !        WRITE(114,'(a5,1x,3f20.10)') 'O', STXYZ(J3-2), STXYZ(J3-1), STXYZ(J3)
 1747: !     ENDDO
 1748: !  ENDDO
 1749: !  CLOSE(UNIT=114)
 1750: ELSEIF (AMHT) THEN
 1751:    DO J2=1,INTIMAGE+2
 1752: !  GLY set getparams.f
 1753: !               WRITE(993,'(i4)')NATOMS +NUMGLY
 1754: !  GLY printing turned off DJW
 1755:       WRITE(993,'(i4)')NATOMS
 1756:       WRITE(993,*)'Energy'
 1757:       GLY_COUNT = 0
 1758: 
 1759:       DO J1=1,NMRES
 1760:          IF (SEQ(J1).EQ.8) THEN
 1761:             WRITE(993,'(a5,1x,3f20.10)') 'C1   ',XYZ((J2-1)*NOPT+9*(J1-1)+1-GLY_COUNT*3),XYZ((J2-1)*NOPT+9*(J1-1)+2-GLY_COUNT*3), &
 1762:      &                                  XYZ((J2-1)*NOPT+9*(J1-1)+3-GLY_COUNT*3)
 1763: !  GLY printing turned off DJW
 1764: !           WRITE(993,'(a5,1x,3f20.10)') 'C1   ',XYZ((J2-1)*NOPT+9*(J1-1)+1-GLY_COUNT*3),XYZ((J2-1)*NOPT+9*(J1-1)+2-GLY_COUNT*3), &
 1765: !    &                                  XYZ((J2-1)*NOPT+9*(J1-1)+3-GLY_COUNT*3)
 1766:             WRITE(993,'(a5,1x,3f20.10)') 'O    ',XYZ((J2-1)*NOPT+9*(J1-1)+4-GLY_COUNT*3),XYZ((J2-1)*NOPT+9*(J1-1)+5-GLY_COUNT*3), &
 1767:      &                                  XYZ((J2-1)*NOPT+9*(J1-1)+6-GLY_COUNT*3)
 1768:             GLY_COUNT = GLY_COUNT +1
 1769:          ELSE
 1770:             WRITE(993,'(a5,1x,3f20.10)') 'C1   ',XYZ((J2-1)*NOPT+9*(J1-1)+1-GLY_COUNT*3),XYZ((J2-1)*NOPT+9*(J1-1)+2-GLY_COUNT*3), &
 1771:      &                                  XYZ((J2-1)*NOPT+9*(J1-1)+3-GLY_COUNT*3)
 1772:             WRITE(993,'(a5,1x,3f20.10)') 'C2   ',XYZ((J2-1)*NOPT+9*(J1-1)+4-GLY_COUNT*3),XYZ((J2-1)*NOPT+9*(J1-1)+5-GLY_COUNT*3), &
 1773:      &                                  XYZ((J2-1)*NOPT+9*(J1-1)+6-GLY_COUNT*3)
 1774:             WRITE(993,'(a5,1x,3f20.10)') 'O    ',XYZ((J2-1)*NOPT+9*(J1-1)+7-GLY_COUNT*3),XYZ((J2-1)*NOPT+9*(J1-1)+8-GLY_COUNT*3), &
 1775:      &                                  XYZ((J2-1)*NOPT+9*(J1-1)+9-GLY_COUNT*3)
 1776:          ENDIF
 1777:       ENDDO
 1778:    ENDDO
 1779: ELSE
 1780:    DO J2=1,INTIMAGE+2
 1781: !     WRITE(993,'(i4/)') NACTIVE
 1782:       WRITE(993,'(i4/)') NATOMS
 1783:       DO J3=1,NATOMS
 1784:          IF (ATOMACTIVE(J3)) THEN
 1785:             WRITE(993,'(A5,1X,3F20.10)') 'LA   ',XYZ((J2-1)*3*NATOMS+3*(J3-1)+1),XYZ((J2-1)*3*NATOMS+3*(J3-1)+2), &
 1786:   &                                                                      XYZ((J2-1)*3*NATOMS+3*(J3-1)+3)
 1787:          ELSE
 1788:             WRITE(993,'(A5,1X,3F20.10)') 'DU   ',XYZ((J2-1)*3*NATOMS+3*(J3-1)+1),XYZ((J2-1)*3*NATOMS+3*(J3-1)+2), &
 1789:   &                                                                      XYZ((J2-1)*3*NATOMS+3*(J3-1)+3)
 1790:          ENDIF
 1791:       ENDDO
 1792:    ENDDO
 1793: ENDIF
1341: 1794: 
1342: WRITE(*,*) 'rwg> Interpolated image coordinates were saved to xyz file "'//TRIM(FILENAME)//'"'1795: PRINT *, 'rwg> Interpolated image coordinates were saved to xyz file "'//TRIM(FILENAME)//'"'
1343: 1796: 
1344: CLOSE(UNIT=993)1797: CLOSE(UNIT=993)
1345: END SUBROUTINE INTRWG1798: END SUBROUTINE INTRWG
1346: 1799: 
1347: SUBROUTINE WRITEPROFILE(NITER,EEE,INTIMAGE)1800: SUBROUTINE WRITEPROFILE(NITER,EEE,INTIMAGE)
 1801: USE KEY,ONLY: FILTH,FILTHSTR
1348: IMPLICIT NONE 1802: IMPLICIT NONE 
1349: INTEGER,INTENT(IN) :: NITER, INTIMAGE1803: INTEGER,INTENT(IN) :: NITER, INTIMAGE
1350: INTEGER :: I,UNIT1804: INTEGER :: I,UNIT
1351: DOUBLE PRECISION :: EEE(INTIMAGE+2)1805: DOUBLE PRECISION :: EEE(INTIMAGE+2)
1352: CHARACTER(LEN=20) :: FILENAME1806: CHARACTER(LEN=20) :: FILENAME
1353: 1807: 
1354: UNIT=9921808: UNIT=992
1355: IF (NITER.GT.0) THEN1809: IF (NITER.GT.0) THEN
1356:    WRITE(FILENAME,'(I8)') NITER1810:    WRITE(FILENAME,'(I8)') NITER
1357:    FILENAME='int.EofS.' // TRIM(ADJUSTL(FILENAME))1811:    FILENAME='int.EofS.' // TRIM(ADJUSTL(FILENAME))
1358: ELSE   1812: ELSE   
1359:    FILENAME='int.EofS'1813:    FILENAME='int.EofS'
1360: ENDIF1814: ENDIF
 1815: IF (.NOT.FILTH==0) THEN
 1816:    FILENAME=TRIM(FILENAME)//'.'//TRIM(ADJUSTL(FILTHSTR))
 1817: ENDIF
1361: OPEN(UNIT=UNIT,FILE=FILENAME,STATUS='replace')1818: OPEN(UNIT=UNIT,FILE=FILENAME,STATUS='replace')
1362: 1819: 
1363: WRITE(UNIT=UNIT,FMT='(2g24.13)') EEE(1)1820: WRITE(UNIT=UNIT,FMT='(2g24.13)') EEE(1)
1364: DO I=2,INTIMAGE+11821: DO I=2,INTIMAGE+1
1365:    WRITE(UNIT=UNIT,FMT='(2G24.13)') EEE(I)1822:    WRITE(UNIT=UNIT,FMT='(2G24.13)') EEE(I)
1366: ENDDO1823: ENDDO
1367: WRITE(UNIT=UNIT,FMT='(2G24.13)') EEE(INTIMAGE+2)1824: WRITE(UNIT=UNIT,FMT='(2G24.13)') EEE(INTIMAGE+2)
1368: 1825: 
1369: CLOSE(UNIT)1826: CLOSE(UNIT)
1370: WRITE(*,'(A)') ' writeprofile> Interpolated energy profile was saved to file "'//trim(filename)//'"'1827: PRINT '(A)',' writeprofile> Interpolated energy profile was saved to file "'//trim(filename)//'"'
1371: 1828: 
1372: END SUBROUTINE WRITEPROFILE1829: END SUBROUTINE WRITEPROFILE
1373: 1830: 
1374: SUBROUTINE DOADDATOM(NCONSTRAINT,NTRIES,NEWATOM,IMGFREEZE,INTIMAGE,XYZ,EEE,GGG,TURNONORDER,NITERDONE,NACTIVE)1831: SUBROUTINE DOADDATOM(NCONSTRAINT,NTRIES,NEWATOM,IMGFREEZE,INTIMAGE,XYZ,EEE,GGG,TURNONORDER,NITERDONE,NACTIVE)
1375: USE KEY, ONLY : CONACTIVE, CONI, CONJ, ATOMACTIVE, CONDISTREF, REPI, REPJ, REPCUT, INTREPSEP,  &1832: USE KEY, ONLY : CONACTIVE, CONI, CONJ, ATOMACTIVE, CONDISTREF, REPI, REPJ, REPCUT, INTREPSEP,  &
1376:   &             INTCONSTRAINREPCUT, NREPULSIVE, NREPMAX, MAXCONUSE, CHECKCONINT, &1833:   &             INTCONSTRAINREPCUT, NREPULSIVE, NREPMAX, MAXCONUSE, NREPCUT, CHECKCONINT, INTFROZEN, &
1377:   &             FREEZENODEST, NNREPULSIVE, INTFROZEN, &1834:   &             FREEZENODEST, NNREPULSIVE, NREPI, NREPJ, CONCUT
1378:   &             NREPULSIVEFIX, REPIFIX, REPJFIX, REPCUTFIX, NREPI, NREPJ, NREPCUT, MAXNACTIVE, &1835: USE COMMONS, ONLY: NATOMS, NOPT, ZSYM, DEBUG
1379:   &             NCONSTRAINTFIX, CONIFIX, CONJFIX, INTCONCUT, INTCONSEP, QCIRADSHIFTT, QCIRADSHIFT, QCIADDREP 
1380: USE COMMONS, ONLY: NATOMS, DEBUG 
1381: IMPLICIT NONE1836: IMPLICIT NONE
1382: INTEGER INTIMAGE1837: INTEGER INTIMAGE
1383: INTEGER NBEST, NCONTOACTIVE(NATOMS),  NCONSTRAINT, J2, NTRIES(NATOMS), NEWATOM,  CONLIST(NATOMS), N1, N2, N3, &1838: INTEGER NBEST, NCONTOACTIVE(NATOMS),  NCONSTRAINT, J2, NTRIES(NATOMS), NEWATOM,  CONLIST(NATOMS), N1, N2, N3, &
1384:   &     NTOADD, NADDED, NMININT, NMAXINT, TURNONORDER(NATOMS), NDUMMY, J1, J3, NITERDONE, NCONFORNEWATOM, NACTIVE1839:   &     NTOADD, NADDED, NMININT, NMAXINT, TURNONORDER(NATOMS), NDUMMY, J1, J3, NITERDONE, NCONFORNEWATOM, NACTIVE
1385: DOUBLE PRECISION DUMMY, DUMMY2, DPRAND, RANDOM, CONDIST(NATOMS), DMIN1840: DOUBLE PRECISION DUMMY, DUMMY2, DPRAND, RANDOM, CONDIST(NATOMS), DMIN, DMAX
 1841: INTEGER, ALLOCATABLE :: IREPTEMP(:)
 1842: DOUBLE PRECISION, ALLOCATABLE :: REPTEMP(:)
1386: INTEGER NDFORNEWATOM, BESTPRESERVEDN(NATOMS)1843: INTEGER NDFORNEWATOM, BESTPRESERVEDN(NATOMS)
1387: DOUBLE PRECISION BESTPRESERVEDD(NATOMS), BESTCLOSESTD(NATOMS), INVDTOACTIVE(NATOMS)1844: DOUBLE PRECISION BESTPRESERVEDD(NATOMS), BESTCLOSESTD(NATOMS), INVDTOACTIVE(NATOMS)
1388: LOGICAL IMGFREEZE(INTIMAGE), ADDREP(NATOMS)1845: LOGICAL IMGFREEZE(INTIMAGE)
1389: DOUBLE PRECISION C1, C2, C3, VEC1(3), VEC2(3), VEC3(3), ESAVED, ESAVEC, ESAVE01846: DOUBLE PRECISION C1, C2, C3, VEC1(3), VEC2(3), VEC3(3), ESAVED, ESAVEC, ESAVE0
1390: INTEGER NCFORNEWATOM, BESTCLOSESTN(NATOMS), NNREPSAVE, NREPSAVE1847: INTEGER NCFORNEWATOM, BESTCLOSESTN(NATOMS), NNREPSAVE, NREPSAVE
1391: DOUBLE PRECISION XYZ((3*NATOMS)*(INTIMAGE+2)), XSAVED(3,INTIMAGE+2), XSAVEC(3,INTIMAGE+2), XSAVE0(3,INTIMAGE+2),FRAC,RAN1, &1848: DOUBLE PRECISION XYZ(NOPT*(INTIMAGE+2)), XSAVED(3,INTIMAGE+2), XSAVEC(3,INTIMAGE+2), XSAVE0(3,INTIMAGE+2),FRAC,RAN1, &
1392:   &              RMS,EEE(INTIMAGE+2),GGG((3*NATOMS)*(INTIMAGE+2)),ETOTAL,DS,DF,DNORM1849:   &              RMS,EEE(INTIMAGE+2),GGG(NOPT*(INTIMAGE+2)),ETOTAL,DS,DF
1393: 1850: 
1394: NTOADD=11851: NTOADD=1
 1852: !  NTOADD=NATOMS-2  !!!! DJW
1395: NADDED=01853: NADDED=0
1396: 1854: 
1397: !1855: !
1398: ! Save current number of repulsions and number that are active to speed up the1856: ! Save current number of repulsions and number that are active to speed up the
1399: ! calls to CHECKREP1857: ! calls to CHECKREP
1400: !1858: !
1401: NNREPSAVE=NNREPULSIVE1859: NNREPSAVE=NNREPULSIVE
1402: NREPSAVE=NREPULSIVE1860: NREPSAVE=NREPULSIVE
1403: 542   CONTINUE1861: 542   CONTINUE
1404: !     DUMMY=1.0D1001862: !     DUMMY=1.0D100
1405:       NBEST=01863:       NBEST=0
1406:       NCONTOACTIVE(1:NATOMS)=01864:       NCONTOACTIVE(1:NATOMS)=0
1407:       INVDTOACTIVE(1:NATOMS)=0.0D01865:       INVDTOACTIVE(1:NATOMS)=0.0D0
1408:       DO J2=1,NCONSTRAINT1866:       DO J2=1,NCONSTRAINT
1409:          IF (CONACTIVE(J2)) CYCLE   ! count new, inactive constraints1867:          IF (CONACTIVE(J2)) CYCLE   ! count new, inactive constraints
1410:          IF (ATOMACTIVE(CONI(J2))) THEN1868:          IF (ATOMACTIVE(CONI(J2))) THEN
1411:             IF (.NOT.ATOMACTIVE(CONJ(J2))) THEN1869:             IF (.NOT.ATOMACTIVE(CONJ(J2))) THEN
1412:                NCONTOACTIVE(CONJ(J2))=NCONTOACTIVE(CONJ(J2))+11870:                NCONTOACTIVE(CONJ(J2))=NCONTOACTIVE(CONJ(J2))+1
1413:                IF (1.0D0/CONDISTREF(J2).GT.INVDTOACTIVE(CONJ(J2))) INVDTOACTIVE(CONJ(J2))=1.0D0/CONDISTREF(J2)1871:                INVDTOACTIVE(CONJ(J2))=INVDTOACTIVE(CONJ(J2))+1.0D0/CONDISTREF(J2)
1414: !              INVDTOACTIVE(CONJ(J2))=INVDTOACTIVE(CONJ(J2))+1.0D0/CONDISTREF(J2) 
1415:             ENDIF1872:             ENDIF
1416:          ENDIF1873:          ENDIF
1417:          IF (ATOMACTIVE(CONJ(J2))) THEN1874:          IF (ATOMACTIVE(CONJ(J2))) THEN
1418:             IF (.NOT.ATOMACTIVE(CONI(J2))) THEN1875:             IF (.NOT.ATOMACTIVE(CONI(J2))) THEN
1419:                NCONTOACTIVE(CONI(J2))=NCONTOACTIVE(CONI(J2))+11876:                NCONTOACTIVE(CONI(J2))=NCONTOACTIVE(CONI(J2))+1
1420: !              INVDTOACTIVE(CONI(J2))=INVDTOACTIVE(CONI(J2))+1.0D0/CONDISTREF(J2)1877:                INVDTOACTIVE(CONI(J2))=INVDTOACTIVE(CONI(J2))+1.0D0/CONDISTREF(J2)
1421:                IF (1.0D0/CONDISTREF(J2).GT.INVDTOACTIVE(CONI(J2))) INVDTOACTIVE(CONI(J2))=1.0D0/CONDISTREF(J2) 
1422:             ENDIF1878:             ENDIF
1423:          ENDIF1879:          ENDIF
1424:          IF (NCONTOACTIVE(CONI(J2)).GT.NBEST) THEN1880:          IF (NCONTOACTIVE(CONI(J2)).GT.NBEST) THEN
1425:             NBEST=NCONTOACTIVE(CONI(J2))1881:             NBEST=NCONTOACTIVE(CONI(J2))
1426:          ENDIF1882:          ENDIF
1427:          IF (NCONTOACTIVE(CONJ(J2)).GT.NBEST) THEN1883:          IF (NCONTOACTIVE(CONJ(J2)).GT.NBEST) THEN
1428:             NBEST=NCONTOACTIVE(CONJ(J2))1884:             NBEST=NCONTOACTIVE(CONJ(J2))
1429:          ENDIF1885:          ENDIF
1430: !        IF ((CONI(J2).EQ.115).OR.(CONJ(J2).EQ.115)) THEN1886: !        PRINT '(A,7I6)','J2,NCONTOACTIVEI,NCONTOACTOVEJ,CONI,CONJ,NEWATOM,NBEST=', &
1431: !          WRITE(*,'(A,5I6,2G20.10)') 'J2,NCONTOACTIVEI,NCONTOACTOVEJ,CONI,CONJ,NEWATOM,NBEST,IDI,IDJ=', &1887: ! &                             J2,NCONTOACTIVE(CONI(J2)),NCONTOACTIVE(CONJ(J2)),CONI(J2),CONJ(J2),NEWATOM,NBEST
1432: !   &                             J2,NCONTOACTIVE(CONI(J2)),NCONTOACTIVE(CONJ(J2)),CONI(J2),CONJ(J2), & 
1433: !   &                             INVDTOACTIVE(CONI(J2)),INVDTOACTIVE(CONJ(J2)) 
1434: !        ENDIF 
1435: 1888: 
1436:       ENDDO1889:       ENDDO
1437: !1890: !
1438: !  Choose NEWATOM stochastically. Bias towards atoms with the maximum constraints.1891: !  Choose NEWATOM stochastically. Bias towards atoms with the maximum constraints.
1439: !  Use a normalised probability and generate a random number between 0 and 1.1892: !  Use a normalised probability and generate a random number between 0 and 1.
1440: !1893: !
1441: !       DUMMY2=0.0D01894:       DUMMY2=0.0D0
1442: !       DO J2=1,NATOMS1895:       DO J2=1,NATOMS
1443: !          IF (NCONTOACTIVE(J2).EQ.0) CYCLE1896:          IF (NCONTOACTIVE(J2).EQ.0) CYCLE
1444: !          IF (ATOMACTIVE(J2)) CYCLE1897:          IF (ATOMACTIVE(J2)) CYCLE
1445: ! !        DUMMY2=DUMMY2+((1.0D0*NCONTOACTIVE(J2))/(1.0D0*CONDISTREF(J2)*NTRIES(J2)))**4 1898: !        DUMMY2=DUMMY2+((1.0D0*NCONTOACTIVE(J2))/(1.0D0*CONDISTREF(J2)*NTRIES(J2)))**4 
1446: ! !        DUMMY2=DUMMY2+((1.0D0*INVDTOACTIVE(J2))/(1.0D0*NCONTOACTIVE(J2)*NTRIES(J2)))**4 1899:          DUMMY2=DUMMY2+((1.0D0*INVDTOACTIVE(J2))/(1.0D0*NTRIES(J2)))**4 
1447: !          DUMMY2=DUMMY2+((1.0D0*INVDTOACTIVE(J2))/(1.0D0*NTRIES(J2)))**10 1900: !        PRINT '(A,I6,A,G20.10)',' intlbfgs> Unnormalised probability for choosing atom ',J2,' is ', &
1448: ! !        WRITE(*,'(A,I6,A,G20.10)') ' intlbfgs> Unnormalised probability for choosing atom ',J2,' is ', &1901: ! &                ((1.0D0*INVDTOACTIVE(J2))/(1.0D0*NTRIES(J2)))**4
1449: ! ! &                ((1.0D0*INVDTOACTIVE(J2))/(1.0D0*NTRIES(J2)))**10 
1450: !       ENDDO 
1451: !  
1452: !       RANDOM=DUMMY2*DPRAND() 
1453: !       DNORM=DUMMY2 
1454: !       DUMMY2=0.0D0 
1455: !       choosenew: DO J2=1,NATOMS 
1456: !          IF (NCONTOACTIVE(J2).EQ.0) CYCLE 
1457: !          IF (ATOMACTIVE(J2)) CYCLE 
1458: ! !        DUMMY2=DUMMY2+((1.0D0*NCONTOACTIVE(J2))/(1.0D0*CONDISTREF(J2)*NTRIES(J2)))**4  
1459: ! !        DUMMY2=DUMMY2+((1.0D0*INVDTOACTIVE(J2))/(1.0D0*NCONTOACTIVE(J2)*NTRIES(J2)))**4  
1460: !          DUMMY2=DUMMY2+((1.0D0*INVDTOACTIVE(J2))/(1.0D0*NTRIES(J2)))**10  
1461: !          WRITE(*,'(A,I6,G20.10,I6,4G20.10)') 'J2,invd,ntries,prob,rand,D2,D2/norm=',J2,INVDTOACTIVE(J2),NTRIES(J2), & 
1462: !   &                ((1.0D0*INVDTOACTIVE(J2))/(1.0D0*NTRIES(J2)))**10/DNORM,RANDOM/DNORM,DUMMY2,DUMMY2/DNORM 
1463: !          IF (DUMMY2.GE.RANDOM) THEN 
1464: !             NEWATOM=J2 
1465: !             IF (DEBUG) WRITE(*,'(3(A,I6))') ' intlbfgs> Choosing new active atom ',NEWATOM,' new constraints=', & 
1466: !   &                                       NCONTOACTIVE(J2),' maximum=',NBEST 
1467: !             EXIT choosenew 
1468: !          ENDIF 
1469: !       ENDDO choosenew 
1470:  
1471: ! 
1472: !  Choose NEWATOM deterministically. Take the inactive atom with the shortest constrained distance. 
1473: ! 
1474:       DUMMY2=1.0D100 
1475:       DO J1=1,NCONSTRAINT 
1476:          IF (CONACTIVE(J1)) CYCLE 
1477:          IF (ATOMACTIVE(CONJ(J1))) THEN 
1478:             IF (.NOT.ATOMACTIVE(CONI(J1))) THEN 
1479:                IF (CONDISTREF(J1).LT.DUMMY2) THEN 
1480:                   DUMMY2=CONDISTREF(J1) 
1481:                   NEWATOM=CONI(J1) 
1482:                ENDIF 
1483:             ENDIF 
1484:          ELSEIF (ATOMACTIVE(CONI(J1))) THEN 
1485:             IF (.NOT.ATOMACTIVE(CONJ(J1))) THEN 
1486:                IF (CONDISTREF(J1).LT.DUMMY2) THEN 
1487:                   DUMMY2=CONDISTREF(J1) 
1488:                   NEWATOM=CONJ(J1) 
1489:                ENDIF 
1490:             ENDIF 
1491:          ENDIF 
1492:       ENDDO1902:       ENDDO
1493:       IF (DEBUG) WRITE(*,'(3(A,I6),A,F15.5)') ' intlbfgs> Choosing new active atom ',NEWATOM,' new constraints=', & 
1494:   &                                       NCONTOACTIVE(NEWATOM),' maximum=',NBEST,' shortest constraint=',DUMMY2 
1495: !     IF (DEBUG) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ) 
1496: !     IF (DEBUG) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE) 
1497: 1903: 
 1904:       RANDOM=DUMMY2*DPRAND()
 1905:       DUMMY2=0.0D0
 1906:       choosenew: DO J2=1,NATOMS
 1907:          IF (NCONTOACTIVE(J2).EQ.0) CYCLE
 1908:          IF (ATOMACTIVE(J2)) CYCLE
 1909: !        DUMMY2=DUMMY2+((1.0D0*NCONTOACTIVE(J2))/(1.0D0*CONDISTREF(J2)*NTRIES(J2)))**4 
 1910:          DUMMY2=DUMMY2+((1.0D0*INVDTOACTIVE(J2))/(1.0D0*NTRIES(J2)))**4 
 1911:          IF (DUMMY2.GE.RANDOM) THEN
 1912:             NEWATOM=J2
 1913:             IF (DEBUG) PRINT '(3(A,I6))',' intlbfgs> Choosing new active atom ',NEWATOM,' new constraints=', &
 1914:   &                                       NCONTOACTIVE(J2),' maximum=',NBEST
 1915:             EXIT choosenew
 1916:          ENDIF
 1917:       ENDDO choosenew
1498:           1918:           
1499:       IF (NEWATOM*NBEST.EQ.0) THEN ! sanity check1919:       IF (NEWATOM*NBEST.EQ.0) THEN ! sanity check
1500:          WRITE(*,'(A,I6,A,2I6)') ' intlbfgs> ERROR *** new active atom not set'1920:          PRINT '(A,I6,A,2I6)',' intlbfgs> ERROR *** new active atom not set'
1501:          STOP1921:          STOP
1502:       ELSE1922:       ELSE
1503: !1923: !
1504: !  We need a sorted list of up to 3 active atoms, sorted according to how well the1924: !  We need a sorted list of up to 3 active atoms, sorted according to how well the
1505: !  end point distance is preserved, even if they don't satisfy the constraint 1925: !  end point distance is preserved, even if they don't satisfy the constraint 
1506: !  condition. We want three atoms to use for a local axis system in the interpolation.1926: !  condition. We want three atoms to use for a local axis system in the interpolation.
1507: !1927: !
1508: !  Try sorting on the shortest average distances in the endpoint structures instead, to avoid1928: !  Try sorting on the shortest average distances in the endpoint structures instead, to avoid
1509: !  problems with distant atoms acidentally having a well-preserved distance.1929: !  problems with distant atoms acidentally having a well-preserved distance.
1510: !1930: !
1511:          NDFORNEWATOM=01931:          NDFORNEWATOM=0
1512:          BESTPRESERVEDD(1:NATOMS)=1.0D1001932:          BESTPRESERVEDD(1:NATOMS)=1.0D100
1513:          DO J1=1,NATOMS1933:          DO J1=1,NATOMS
1514:             IF (ABS(J1-NEWATOM).GT.INTCONSEP) CYCLE 
1515:             IF (.NOT.ATOMACTIVE(J1)) CYCLE1934:             IF (.NOT.ATOMACTIVE(J1)) CYCLE
1516:             DS=SQRT((XYZ(3*(NEWATOM-1)+1)-XYZ(3*(J1-1)+1))**2 &1935:             DS=SQRT((XYZ(3*(NEWATOM-1)+1)-XYZ(3*(J1-1)+1))**2 &
1517:   &                +(XYZ(3*(NEWATOM-1)+2)-XYZ(3*(J1-1)+2))**2 &1936:   &                +(XYZ(3*(NEWATOM-1)+2)-XYZ(3*(J1-1)+2))**2 &
1518:   &                +(XYZ(3*(NEWATOM-1)+3)-XYZ(3*(J1-1)+3))**2) 1937:   &                +(XYZ(3*(NEWATOM-1)+3)-XYZ(3*(J1-1)+3))**2) 
1519:             DF=SQRT((XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+1))**2 &1938:             DF=SQRT((XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+1))**2 &
1520:   &                +(XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+2))**2 &1939:   &                +(XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+2))**2 &
1521:   &                +(XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+3))**2) 1940:   &                +(XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+3))**2) 
1522:             IF (DS.GT.INTCONCUT) CYCLE 
1523:             IF (DF.GT.INTCONCUT) CYCLE 
1524:             DUMMY=ABS(DS-DF)1941:             DUMMY=ABS(DS-DF)
1525:             NDFORNEWATOM=NDFORNEWATOM+11942:             NDFORNEWATOM=NDFORNEWATOM+1
1526:             DO J2=1,NDFORNEWATOM 1943:             DO J2=1,NDFORNEWATOM 
1527:                IF (DUMMY.LT.BESTPRESERVEDD(J2)) THEN1944:                IF (DUMMY.LT.BESTPRESERVEDD(J2)) THEN
1528: !                 WRITE(*,'(A,I6,G12.4,I6,G12.4)') 'J1,DUMMY < J2,BESTPRESERVEDD: ',J1,DUMMY,J2,BESTPRESERVEDD(J2)1945: !                 PRINT '(A,I6,G12.4,I6,G12.4)','J1,DUMMY < J2,BESTPRESERVEDD: ',J1,DUMMY,J2,BESTPRESERVEDD(J2)
1529:                   DO J3=NDFORNEWATOM,J2+1,-1 1946:                   DO J3=NDFORNEWATOM,J2+1,-1 
1530: !                    WRITE(*,'(A,I6,A,I6,A,G12.4)') ' moving diff and list from ',J3-1,' to ',J3, &1947: !                    PRINT '(A,I6,A,I6,A,G12.4)',' moving diff and list from ',J3-1,' to ',J3, &
1531: !&                                               ' DIFF=',BESTPRESERVEDD(J3-1)1948: !&                                               ' DIFF=',BESTPRESERVEDD(J3-1)
1532:                      BESTPRESERVEDD(J3)=BESTPRESERVEDD(J3-1)1949:                      BESTPRESERVEDD(J3)=BESTPRESERVEDD(J3-1)
1533:                      BESTPRESERVEDN(J3)=BESTPRESERVEDN(J3-1)1950:                      BESTPRESERVEDN(J3)=BESTPRESERVEDN(J3-1)
1534:                   ENDDO1951:                   ENDDO
1535:                   BESTPRESERVEDD(J2)=DUMMY1952:                   BESTPRESERVEDD(J2)=DUMMY
1536: !                 WRITE(*,'(A,I6,A,G12.4)') ' setting BESTPRESERVEDD element ',J2,' to ',DUMMY1953: !                 PRINT '(A,I6,A,G12.4)',' setting BESTPRESERVEDD element ',J2,' to ',DUMMY
1537:                   BESTPRESERVEDN(J2)=J11954:                   BESTPRESERVEDN(J2)=J1
1538: !                 WRITE(*,'(A,I6,A,G12.4)') ' setting BESTPRESERVEDN element ',J2,' to ',J11955: !                 PRINT '(A,I6,A,G12.4)',' setting BESTPRESERVEDN element ',J2,' to ',J1
1539:                   GOTO 6531956:                   GOTO 653
1540:                ENDIF1957:                ENDIF
1541:             ENDDO1958:             ENDDO
1542: 653         CONTINUE1959: 653         CONTINUE
1543:          ENDDO1960:          ENDDO
1544:          IF (DEBUG) THEN1961:          IF (DEBUG) THEN
1545:             WRITE(*,'(A,I6,A,I6,A)') ' intlbfgs> New active atom ',NEWATOM,' best preserved distances:'1962:             PRINT '(A,I6,A,I6,A)',' intlbfgs> New active atom ',NEWATOM,' best preserved distances:'
1546:             WRITE(*,'(20I6)') BESTPRESERVEDN(1:MIN(10,NDFORNEWATOM))1963:             PRINT '(20I6)',BESTPRESERVEDN(1:MIN(10,NDFORNEWATOM))
1547:             WRITE(*,'(A,I6,A,I6,A)') ' intlbfgs> sorted differences:'1964:             PRINT '(A,I6,A,I6,A)',' intlbfgs> sorted differences:'
1548:             WRITE(*,'(10G12.4)') BESTPRESERVEDD(1:MIN(10,NDFORNEWATOM))1965:             PRINT '(10G12.4)',BESTPRESERVEDD(1:MIN(10,NDFORNEWATOM))
1549:          ENDIF1966:          ENDIF
1550:          IF (FREEZENODEST) IMGFREEZE(1:INTIMAGE)=.FALSE.1967:          IF (FREEZENODEST) IMGFREEZE(1:INTIMAGE)=.FALSE.
1551: 1968: 
1552:          NCFORNEWATOM=01969:          NCFORNEWATOM=0
1553:          BESTCLOSESTD(1:NATOMS)=1.0D1001970:          BESTCLOSESTD(1:NATOMS)=1.0D100
1554:          DO J1=1,NATOMS1971:          DO J1=1,NATOMS
1555:             IF (ABS(J1-NEWATOM).GT.INTCONSEP) CYCLE 
1556:             IF (.NOT.ATOMACTIVE(J1)) CYCLE1972:             IF (.NOT.ATOMACTIVE(J1)) CYCLE
1557:             DS=SQRT((XYZ(3*(NEWATOM-1)+1)-XYZ(3*(J1-1)+1))**2 &1973:             DS=SQRT((XYZ(3*(NEWATOM-1)+1)-XYZ(3*(J1-1)+1))**2 &
1558:   &                +(XYZ(3*(NEWATOM-1)+2)-XYZ(3*(J1-1)+2))**2 &1974:   &                +(XYZ(3*(NEWATOM-1)+2)-XYZ(3*(J1-1)+2))**2 &
1559:   &                +(XYZ(3*(NEWATOM-1)+3)-XYZ(3*(J1-1)+3))**2) 1975:   &                +(XYZ(3*(NEWATOM-1)+3)-XYZ(3*(J1-1)+3))**2) 
1560:             DF=SQRT((XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+1))**2 &1976:             DF=SQRT((XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+1))**2 &
1561:   &                +(XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+2))**2 &1977:   &                +(XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+2))**2 &
1562:   &                +(XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+3))**2) 1978:   &                +(XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+3))**2) 
1563:             IF (DS.GT.INTCONCUT) CYCLE 
1564:             IF (DF.GT.INTCONCUT) CYCLE 
1565:             DUMMY=(DS+DF)/2.0D01979:             DUMMY=(DS+DF)/2.0D0
1566:             NCFORNEWATOM=NCFORNEWATOM+11980:             NCFORNEWATOM=NCFORNEWATOM+1
1567:             DO J2=1,NCFORNEWATOM1981:             DO J2=1,NCFORNEWATOM
1568:                IF (DUMMY.LT.BESTCLOSESTD(J2)) THEN1982:                IF (DUMMY.LT.BESTCLOSESTD(J2)) THEN
1569: !                 WRITE(*,'(A,I6,G12.4,I6,G12.4)') 'J1,DUMMY < J2,BESTCLOSESTD: ',J1,DUMMY,J2,BESTCLOSESTD(J2)1983: !                 PRINT '(A,I6,G12.4,I6,G12.4)','J1,DUMMY < J2,BESTCLOSESTD: ',J1,DUMMY,J2,BESTCLOSESTD(J2)
1570:                   DO J3=NCFORNEWATOM,J2+1,-11984:                   DO J3=NCFORNEWATOM,J2+1,-1
1571: !                    WRITE(*,'(A,I6,A,I6,A,G12.4)') ' moving diff and list from ',J3-1,' to ',J3, &1985: !                    PRINT '(A,I6,A,I6,A,G12.4)',' moving diff and list from ',J3-1,' to ',J3, &
1572: !&                                               ' DIFF=',BESTCLOSESTD(J3-1)1986: !&                                               ' DIFF=',BESTCLOSESTD(J3-1)
1573:                      BESTCLOSESTD(J3)=BESTCLOSESTD(J3-1)1987:                      BESTCLOSESTD(J3)=BESTCLOSESTD(J3-1)
1574:                      BESTCLOSESTN(J3)=BESTCLOSESTN(J3-1)1988:                      BESTCLOSESTN(J3)=BESTCLOSESTN(J3-1)
1575:                   ENDDO1989:                   ENDDO
1576:                   BESTCLOSESTD(J2)=DUMMY1990:                   BESTCLOSESTD(J2)=DUMMY
1577: !                 WRITE(*,'(A,I6,A,G12.4)') ' setting BESTCLOSESTD element ',J2,' to ',DUMMY1991: !                 PRINT '(A,I6,A,G12.4)',' setting BESTCLOSESTD element ',J2,' to ',DUMMY
1578:                   BESTCLOSESTN(J2)=J11992:                   BESTCLOSESTN(J2)=J1
1579: !                 WRITE(*,'(A,I6,A,G12.4)') ' setting BESTCLOSESTN element ',J2,' to ',J11993: !                 PRINT '(A,I6,A,G12.4)',' setting BESTCLOSESTN element ',J2,' to ',J1
1580:                   GOTO 6591994:                   GOTO 659
1581:                ENDIF1995:                ENDIF
1582:             ENDDO1996:             ENDDO
1583: 659         CONTINUE1997: 659         CONTINUE
1584:          ENDDO1998:          ENDDO
1585:          IF (DEBUG) THEN1999:          IF (DEBUG) THEN
1586:             WRITE(*,'(A,I6,A,I6,A)') ' intlbfgs> New active atom ',NEWATOM,' shortest average distances in endpoints:'2000:             PRINT '(A,I6,A,I6,A)',' intlbfgs> New active atom ',NEWATOM,' shortest average distances in endpoints:'
1587:             WRITE(*,'(20I6)') BESTCLOSESTN(1:MIN(10,NCFORNEWATOM))2001:             PRINT '(20I6)',BESTCLOSESTN(1:MIN(10,NCFORNEWATOM))
1588:             WRITE(*,'(A,I6,A,I6,A)') ' intlbfgs> sorted differences:'2002:             PRINT '(A,I6,A,I6,A)',' intlbfgs> sorted differences:'
1589:             WRITE(*,'(10G12.4)') BESTCLOSESTD(1:MIN(10,NCFORNEWATOM))2003:             PRINT '(10G12.4)',BESTCLOSESTN(1:MIN(10,NCFORNEWATOM))
1590:          ENDIF2004:          ENDIF
1591: !2005: !
1592: !  Maintain a sorted list of active atoms that are constrained to the new atom, sorted2006: !  Maintain a sorted list of active atoms that are constrained to the new atom, sorted
1593: !  according to their distance.2007: !  according to their distance.
1594: !2008: !
1595:          NCONFORNEWATOM=02009:          NCONFORNEWATOM=0
1596:          CONDIST(1:NATOMS)=1.0D1002010:          CONDIST(1:NATOMS)=1.0D100
1597:          IF (DEBUG) WRITE(*,'(3(A,I6))') ' intlbfgs> New active atom is number ',NEWATOM,' total=',NACTIVE+1, &2011:          IF (DEBUG) PRINT '(3(A,I6))',' intlbfgs> New active atom is number ',NEWATOM,' total=',NACTIVE+1, &
1598:  &                        ' steps=',NITERDONE2012:  &                        ' steps=',NITERDONE
1599:          DO J1=1,NCONSTRAINT2013:          DO J1=1,NCONSTRAINT
1600:             IF (CONACTIVE(J1)) CYCLE2014:             IF (CONACTIVE(J1)) CYCLE
1601:             IF ((CONI(J1).EQ.NEWATOM).AND.(ATOMACTIVE(CONJ(J1))).OR.(CONJ(J1).EQ.NEWATOM).AND.(ATOMACTIVE(CONI(J1)))) THEN  2015:             IF ((CONI(J1).EQ.NEWATOM).AND.(ATOMACTIVE(CONJ(J1))).OR.(CONJ(J1).EQ.NEWATOM).AND.(ATOMACTIVE(CONI(J1)))) THEN  
1602:                  NCONFORNEWATOM=NCONFORNEWATOM+12016:                  NCONFORNEWATOM=NCONFORNEWATOM+1
1603: !                CONACTIVE(J1)=.TRUE.2017: !                CONACTIVE(J1)=.TRUE.
1604: !                NITSTART(J1)=NITERDONE2018: !                NITSTART(J1)=NITERDONE
1605: !                NCONSTRAINTON=NCONSTRAINTON+12019: !                NCONSTRAINTON=NCONSTRAINTON+1
1606: ! !2020: ! !
1607: ! ! The ...ON variables are not actually used in congrad.f90.2021: ! ! The ...ON variables are not actually used in congrad.f90.
1608: ! !2022: ! !
1609: !                CONDISTREFLOCALON(NCONSTRAINTON)=CONDISTREFLOCAL(J1)2023: !                CONDISTREFLOCALON(NCONSTRAINTON)=CONDISTREFLOCAL(J1)
1610: !                CONDISTREFON(NCONSTRAINTON)=CONDISTREF(J1)2024: !                CONDISTREFON(NCONSTRAINTON)=CONDISTREF(J1)
1611: !                CONION(NCONSTRAINTON)=CONI(J1)2025: !                CONION(NCONSTRAINTON)=CONI(J1)
1612: !                CONJON(NCONSTRAINTON)=CONJ(J1)2026: !                CONJON(NCONSTRAINTON)=CONJ(J1)
1613: ! 2027: ! 
1614: !                IF (DEBUG) WRITE(*,'(A,I6,A,2I6)') ' intlbfgs> Turning on constraint ',J1,' for atoms ',CONI(J1),CONJ(J1)2028: !                IF (DEBUG) PRINT '(A,I6,A,2I6)',' intlbfgs> Turning on constraint ',J1,' for atoms ',CONI(J1),CONJ(J1)
1615:                IF (NCONFORNEWATOM.EQ.1) THEN2029:                IF (NCONFORNEWATOM.EQ.1) THEN
1616:                   CONDIST(1)=CONDISTREF(J1)2030:                   CONDIST(1)=CONDISTREF(J1)
1617:                   IF (CONI(J1).EQ.NEWATOM) CONLIST(1)=CONJ(J1)2031:                   IF (CONI(J1).EQ.NEWATOM) CONLIST(1)=CONJ(J1)
1618:                   IF (CONJ(J1).EQ.NEWATOM) CONLIST(1)=CONI(J1)2032:                   IF (CONJ(J1).EQ.NEWATOM) CONLIST(1)=CONI(J1)
1619:                ENDIF2033:                ENDIF
1620:                DO J2=1,NCONFORNEWATOM-12034:                DO J2=1,NCONFORNEWATOM-1
1621:                   IF (CONDISTREF(J1).LT.CONDIST(J2)) THEN2035:                   IF (CONDISTREF(J1).LT.CONDIST(J2)) THEN
1622: !                    WRITE(*,'(A,I6,G12.4,I6,G12.4)') 'J1,CONDISTREF < J2,CONDIST: ',J1,CONDISTREF(J1),J2,CONDIST(J2)2036: !                    PRINT '(A,I6,G12.4,I6,G12.4)','J1,CONDISTREF < J2,CONDIST: ',J1,CONDISTREF(J1),J2,CONDIST(J2)
1623:                      DO J3=NCONFORNEWATOM,J2+1,-12037:                      DO J3=NCONFORNEWATOM,J2+1,-1
1624: !                       WRITE(*,'(A,I6,A,I6,A,G12.4)') ' moving dist and list from ',J3-1,' to ',J3,' CONDIST=',CONDIST(J3-1)2038: !                       PRINT '(A,I6,A,I6,A,G12.4)',' moving dist and list from ',J3-1,' to ',J3,' CONDIST=',CONDIST(J3-1)
1625:                         CONDIST(J3)=CONDIST(J3-1)2039:                         CONDIST(J3)=CONDIST(J3-1)
1626:                         CONLIST(J3)=CONLIST(J3-1)2040:                         CONLIST(J3)=CONLIST(J3-1)
1627:                      ENDDO2041:                      ENDDO
1628:                      CONDIST(J2)=CONDISTREF(J1)2042:                      CONDIST(J2)=CONDISTREF(J1)
1629: !                    WRITE(*,'(A,I6,A,G12.4)') ' setting condist element ',J2,' to ',CONDISTREF(J1)2043: !                    PRINT '(A,I6,A,G12.4)',' setting condist element ',J2,' to ',CONDISTREF(J1)
1630:                      IF (CONI(J1).EQ.NEWATOM) CONLIST(J2)=CONJ(J1)2044:                      IF (CONI(J1).EQ.NEWATOM) CONLIST(J2)=CONJ(J1)
1631:                      IF (CONJ(J1).EQ.NEWATOM) CONLIST(J2)=CONI(J1)2045:                      IF (CONJ(J1).EQ.NEWATOM) CONLIST(J2)=CONI(J1)
1632: !                    WRITE(*,'(A,I6,A,G12.4)') ' setting conlist element ',J2,' to ',CONLIST(J2)2046: !                    PRINT '(A,I6,A,G12.4)',' setting conlist element ',J2,' to ',CONLIST(J2)
1633:                      GOTO 6542047:                      GOTO 654
1634:                   ENDIF2048:                   ENDIF
1635:                ENDDO 2049:                ENDDO 
1636:                CONDIST(NCONFORNEWATOM)=CONDISTREF(J1)2050:                CONDIST(NCONFORNEWATOM)=CONDISTREF(J1)
1637: !              WRITE(*,'(A,I6,A,G12.4)') ' setting condist element ',NCONFORNEWATOM,' to ',CONDISTREF(J1)2051: !              PRINT '(A,I6,A,G12.4)',' setting condist element ',NCONFORNEWATOM,' to ',CONDISTREF(J1)
1638:                IF (CONI(J1).EQ.NEWATOM) CONLIST(NCONFORNEWATOM)=CONJ(J1)2052:                IF (CONI(J1).EQ.NEWATOM) CONLIST(NCONFORNEWATOM)=CONJ(J1)
1639:                IF (CONJ(J1).EQ.NEWATOM) CONLIST(NCONFORNEWATOM)=CONI(J1)2053:                IF (CONJ(J1).EQ.NEWATOM) CONLIST(NCONFORNEWATOM)=CONI(J1)
1640: !              WRITE(*,'(A,I6,A,G12.4)') ' setting conlist element ',NCONFORNEWATOM,' to ',CONLIST(NCONFORNEWATOM)2054: !              PRINT '(A,I6,A,G12.4)',' setting conlist element ',NCONFORNEWATOM,' to ',CONLIST(NCONFORNEWATOM)
1641: 654          CONTINUE2055: 654          CONTINUE
1642:             ENDIF2056:             ENDIF
1643:          ENDDO 2057:          ENDDO 
1644:          IF (DEBUG) THEN2058:          IF (DEBUG) THEN
1645:             WRITE(*,'(A,I6,A,I6,A)') ' intlbfgs> New active atom ',NEWATOM,' is constrained to ',NCONFORNEWATOM, &2059:             PRINT '(A,I6,A,I6,A)',' intlbfgs> New active atom ',NEWATOM,' is constrained to ',NCONFORNEWATOM,' other active atoms:'
1646:   &                                       ' other active atoms:'2060:             PRINT '(20I6)',CONLIST(1:NCONFORNEWATOM)
1647:             WRITE(*,'(20I6)') CONLIST(1:NCONFORNEWATOM)2061:             PRINT '(A,I6,A,I6,A)',' intlbfgs> sorted distances:'
1648:             WRITE(*,'(A,I6,A,I6,A)') ' intlbfgs> sorted distances:'2062:             PRINT '(10G12.4)',CONDIST(1:NCONFORNEWATOM)
1649:             WRITE(*,'(10G12.4)') CONDIST(1:NCONFORNEWATOM) 
1650:          ENDIF2063:          ENDIF
1651:          DO J1=1,MIN(MAXCONUSE,NCONFORNEWATOM)2064:          DO J1=1,MIN(MAXCONUSE,NCONFORNEWATOM)
1652:             DO J2=1,NCONSTRAINT2065:             DO J2=1,NCONSTRAINT
1653:                IF ((CONI(J2).EQ.NEWATOM).AND.(CONJ(J2).EQ.CONLIST(J1))) THEN2066:                IF ((CONI(J2).EQ.NEWATOM).AND.(CONJ(J2).EQ.CONLIST(J1))) THEN
1654:                      CONACTIVE(J2)=.TRUE.2067:                      CONACTIVE(J2)=.TRUE.
1655:                      IF (DEBUG) WRITE(*,'(A,I6,A,2I6)') ' intlbfgs> Turning on constraint ',J2,' for atoms ',CONI(J2),CONJ(J2)2068:                      IF (DEBUG) PRINT '(A,I6,A,2I6)',' intlbfgs> Turning on constraint ',J2,' for atoms ',CONI(J2),CONJ(J2)
1656:                ELSE IF ((CONJ(J2).EQ.NEWATOM).AND.(CONI(J2).EQ.CONLIST(J1))) THEN2069:                ELSE IF ((CONJ(J2).EQ.NEWATOM).AND.(CONI(J2).EQ.CONLIST(J1))) THEN
1657:                      CONACTIVE(J2)=.TRUE.2070:                      CONACTIVE(J2)=.TRUE.
1658:                      IF (DEBUG) WRITE(*,'(A,I6,A,2I6)') ' intlbfgs> Turning on constraint ',J2,' for atoms ',CONI(J2),CONJ(J2)2071:                      IF (DEBUG) PRINT '(A,I6,A,2I6)',' intlbfgs> Turning on constraint ',J2,' for atoms ',CONI(J2),CONJ(J2)
1659:                ENDIF2072:                ENDIF
1660:             ENDDO2073:             ENDDO
1661:          ENDDO2074:          ENDDO
1662:  
1663:          DO J1=1,NATOMS2075:          DO J1=1,NATOMS
1664:             IF (.NOT.ATOMACTIVE(J1)) CYCLE ! identify active atoms2076:             IF (.NOT.ATOMACTIVE(J1)) CYCLE ! identify active atoms
1665:             IF (ABS(J1-NEWATOM).LE.INTREPSEP) CYCLE ! no repulsion for atoms too close in sequence2077:             IF (ABS(J1-NEWATOM).LE.INTREPSEP) CYCLE ! no repulsion for atoms too close in sequence
1666:             DO J2=1,NCONSTRAINT2078:             DO J2=1,NCONSTRAINT
1667: !2079: !
1668: !  With MAXCONUSE set to a finite value there could be constraints for the new atom that are2080: !  With MAXCONUSE set to a finite value there could be constraints for the new atom that are
1669: !  not active. We don't want these to be changed to repulsion, surely?!2081: !  not active. We don't want these to be changed to repulsion, surely?!
1670: !  Or perhaps we do need to do something with them?2082: !  Or perhaps we do need to do something with them?
1671: !2083: !
1672: !              IF (.NOT.CONACTIVE(J2)) CYCLE ! repulsions for inactive constraints 2084:                IF (.NOT.CONACTIVE(J2)) CYCLE ! identify active constraints 
1673:                IF (((CONI(J2).EQ.J1).AND.(CONJ(J2).EQ.NEWATOM)).OR.((CONJ(J2).EQ.J1).AND.(CONI(J2).EQ.NEWATOM))) GOTO 5432085:                IF (((CONI(J2).EQ.J1).AND.(CONJ(J2).EQ.NEWATOM)).OR.((CONJ(J2).EQ.J1).AND.(CONI(J2).EQ.NEWATOM))) GOTO 543
1674:             ENDDO2086:             ENDDO
1675:             DMIN=1.0D1002087:             DMIN=1.0D100
1676:             DO J2=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances2088:             DO J2=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances
1677:                DF=SQRT((XYZ((J2-1)*3*NATOMS+3*(NEWATOM-1)+1)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+1))**2+ &2089:                DF=SQRT((XYZ((J2-1)*3*NATOMS+3*(NEWATOM-1)+1)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+1))**2+ &
1678:   &                    (XYZ((J2-1)*3*NATOMS+3*(NEWATOM-1)+2)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+2))**2+ &2090:   &                    (XYZ((J2-1)*3*NATOMS+3*(NEWATOM-1)+2)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+2))**2+ &
1679:   &                    (XYZ((J2-1)*3*NATOMS+3*(NEWATOM-1)+3)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+3))**2)2091:   &                    (XYZ((J2-1)*3*NATOMS+3*(NEWATOM-1)+3)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+3))**2)
1680:                IF (DF.LT.DMIN) DMIN=DF2092:                IF (DF.LT.DMIN) DMIN=DF
1681:             ENDDO2093:             ENDDO
1682: !2094: !
1683: ! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact.2095: ! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact.
1684: !2096: !
1685:             DMIN=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)2097:             DMIN=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)
1686:             NREPULSIVE=NREPULSIVE+12098:             NREPULSIVE=NREPULSIVE+1
1687:             IF (NREPULSIVE.GT.NREPMAX) CALL REPDOUBLE2099:             IF (NREPULSIVE.GT.NREPMAX) CALL REPDOUBLE
1688:             REPI(NREPULSIVE)=J12100:             REPI(NREPULSIVE)=J1
1689:             REPJ(NREPULSIVE)=NEWATOM2101:             REPJ(NREPULSIVE)=NEWATOM
1690:             REPCUT(NREPULSIVE)=DMIN2102:             REPCUT(NREPULSIVE)=DMIN
1691: !           IF (DEBUG) WRITE(*,'(A,I6,A,I6,A,F15.5)') ' intlbfgs> Adding repulsion for new atom ',NEWATOM,' with atom ',J1, &2103: !           IF (DEBUG) PRINT '(A,I6,A,I6,A,F15.5)',' intlbfgs> Adding repulsion for new atom ',NEWATOM,' with atom ',J1, &
1692: ! &                                                   ' cutoff=',DMIN2104: ! &                                                   ' cutoff=',DMIN
1693: 543         CONTINUE2105: 543         CONTINUE
1694:          ENDDO2106:          ENDDO
1695:          ATOMACTIVE(NEWATOM)=.TRUE.2107:          ATOMACTIVE(NEWATOM)=.TRUE.
1696:          NACTIVE=NACTIVE+12108:          NACTIVE=NACTIVE+1
1697:          IF (MAXNACTIVE.EQ.0) MAXNACTIVE=NATOMS 
1698: ! 
1699: ! Freeze atoms that became active more than NACTIVE-MAXNACTIVE events ago. 
1700: ! For example, with MAXNACTIVE=5 and 40 active atoms, we would freeze those  
1701: ! turned on first, second, up to the 35th in the TURNONORDER list. 
1702: ! 
1703:          IF (DEBUG) WRITE(*,'(A,I6)') 'doaddatom> Number of active atoms is now ',NACTIVE 
1704:          IF (NACTIVE.GT.MAXNACTIVE) THEN 
1705:             WRITE(*,'(A)') 'doaddatom> TURNONORDER:' 
1706:             WRITE(*,'(5I6)') TURNONORDER(1:NACTIVE-1) 
1707:             NDUMMY=TURNONORDER(NACTIVE-MAXNACTIVE) 
1708:             IF (INTFROZEN(NDUMMY)) THEN 
1709:                IF (DEBUG) WRITE(*,'(A,I6,A,2I6)') ' doaddatom> Not turning off frozen active atom ',NDUMMY,' already frozen' 
1710:             ELSE 
1711:                IF (DEBUG) WRITE(*,'(A,I6,A,2I6)') ' doaddatom> Freezing active atom ',NDUMMY 
1712:                INTFROZEN(NDUMMY)=.TRUE. 
1713: ! 
1714: ! Turn off constraints and repulsions between frozen atoms. 
1715: ! 
1716:                DO J2=1,NCONSTRAINT 
1717:                   IF (.NOT.CONACTIVE(J2)) CYCLE 
1718:                   IF (INTFROZEN(CONI(J2)).AND.INTFROZEN(CONJ(J2))) THEN 
1719:                      CONACTIVE(J2)=.FALSE. 
1720:                      WRITE(*,'(A,I6,A,2I6)') 'doaddatom> turning off constraint ',J2,' between atoms ',CONI(J2),CONJ(J2) 
1721:                   ENDIF 
1722:                ENDDO 
1723:  
1724:                J2=0 
1725:                DO J1=1,NREPULSIVEFIX 
1726:                   IF (INTFROZEN(REPIFIX(J1)).AND.INTFROZEN(REPJFIX(J1))) CYCLE 
1727:                   IF (ATOMACTIVE(REPIFIX(J1)).AND.ATOMACTIVE(REPJFIX(J1))) THEN 
1728:                      DO J3=1,NCONSTRAINTFIX 
1729: !                       IF (.NOT.CONACTIVE(J3)) CYCLE ! no repulsions for any constraints 
1730:                         IF ((CONIFIX(J3).EQ.REPIFIX(J1)).AND.(CONJFIX(J3).EQ.REPJFIX(J1))) GOTO 962 
1731:                         IF ((CONIFIX(J3).EQ.REPJFIX(J1)).AND.(CONJFIX(J3).EQ.REPIFIX(J1))) GOTO 962 
1732:                      ENDDO 
1733:                      J2=J2+1 
1734:                      REPI(J2)=REPIFIX(J1) 
1735:                      REPJ(J2)=REPJFIX(J1) 
1736:                      REPCUT(J2)=REPCUTFIX(J1) 
1737: 962                  CONTINUE 
1738:                   ENDIF 
1739:                ENDDO 
1740:                NREPULSIVE=J2 
1741:                WRITE(*,'(A,I6,A)') ' doaddatom> After allowing for frozen atoms there are ',NREPULSIVE,' possible repulsions' 
1742:                NREPI(1:NREPULSIVE)=REPI(1:NREPULSIVE) 
1743:                NREPJ(1:NREPULSIVE)=REPJ(1:NREPULSIVE) 
1744:                NNREPULSIVE=NREPULSIVE 
1745:                NREPCUT(1:NREPULSIVE)=REPCUT(1:NREPULSIVE) 
1746:             ENDIF 
1747:          ENDIF 
1748: 2109: 
1749:          NDUMMY=02110:          NDUMMY=0
1750:          DO J1=1,NATOMS2111:          DO J1=1,NATOMS
1751:             IF (ATOMACTIVE(J1)) NDUMMY=NDUMMY+12112:             IF (ATOMACTIVE(J1)) NDUMMY=NDUMMY+1
1752:          ENDDO2113:          ENDDO
1753:          IF (NDUMMY.NE.NACTIVE) THEN2114:          IF (NDUMMY.NE.NACTIVE) THEN
1754:             WRITE(*,'(A,I6)') ' doaddatom> ERROR *** inconsistency in number of active atoms. ',NDUMMY,' should be ',NACTIVE2115:             PRINT '(A,I6)',' intlbfgs> ERROR *** inconsistency in number of active atoms. ',NDUMMY,' should be ',NACTIVE
1755:             DO J1=1,NATOMS2116:             DO J1=1,NATOMS
1756:                IF (ATOMACTIVE(J1)) WRITE(*,'(A,I6)') ' active atom ',J12117:                IF (ATOMACTIVE(J1)) PRINT '(A,I6)',' active atom ',J1
1757:             ENDDO2118:             ENDDO
1758:             STOP2119:             STOP
1759:          ENDIF2120:          ENDIF
1760: 2121: 
1761:          TURNONORDER(NACTIVE)=NEWATOM2122:          TURNONORDER(NACTIVE)=NEWATOM
1762: !2123: !
1763: ! Initial guess for new active atom position. This is crucial for success in INTCONSTRAINT schemes!2124: ! Initial guess for new active atom position. This is crucial for success in INTCONSTRAINT schemes!
1764: !2125: !
1765:          ESAVED=1.0D1002126:          ESAVED=1.0D100
1766:          ESAVE0=1.0D1002127:          ESAVE0=1.0D100
1767:          ESAVEC=1.0D1002128:          ESAVEC=1.0D100
1768:          IF (NCONFORNEWATOM.GE.3) THEN2129:          IF (NCONFORNEWATOM.GE.3) THEN
1769: !2130: !
1770: ! Move the new atom consistently in the local environment of its three nearest actively constrained atoms.2131: ! Move the new atom consistently in the local environment of its three nearest actively constrained atoms.
1771: ! Make a local orthogonal coordinate system and use constant components in this basis.2132: ! Make a local orthogonal coordinate system and use constant components in this basis.
1772: !2133: !
1773:             IF (DEBUG) WRITE(*,'(A,3I6)') ' intlbfgs> initial guess from closest three constrained active atoms, ',CONLIST(1:3)2134:             IF (DEBUG) PRINT '(A)',' intlbfgs> initial guess from closest three constrained active atoms'
1774:             VEC1(1:3)=XYZ(3*(CONLIST(2)-1)+1:3*(CONLIST(2)-1)+3)-XYZ(3*(CONLIST(1)-1)+1:3*(CONLIST(1)-1)+3)2135:             VEC1(1:3)=XYZ(3*(CONLIST(2)-1)+1:3*(CONLIST(2)-1)+3)-XYZ(3*(CONLIST(1)-1)+1:3*(CONLIST(1)-1)+3)
1775:             DUMMY=SQRT(VEC1(1)**2+VEC1(2)**2+VEC1(3)**2)2136:             DUMMY=SQRT(VEC1(1)**2+VEC1(2)**2+VEC1(3)**2)
1776:             IF (DUMMY.NE.0.0D0) VEC1(1:3)=VEC1(1:3)/DUMMY2137:             IF (DUMMY.NE.0.0D0) VEC1(1:3)=VEC1(1:3)/DUMMY
1777:             VEC2(1:3)=XYZ(3*(CONLIST(3)-1)+1:3*(CONLIST(3)-1)+3)-XYZ(3*(CONLIST(1)-1)+1:3*(CONLIST(1)-1)+3)2138:             VEC2(1:3)=XYZ(3*(CONLIST(3)-1)+1:3*(CONLIST(3)-1)+3)-XYZ(3*(CONLIST(1)-1)+1:3*(CONLIST(1)-1)+3)
1778:             DUMMY=VEC1(1)*VEC2(1)+VEC1(2)*VEC2(2)+VEC1(3)*VEC2(3)2139:             DUMMY=VEC1(1)*VEC2(1)+VEC1(2)*VEC2(2)+VEC1(3)*VEC2(3)
1779:             VEC2(1:3)=VEC2(1:3)-DUMMY*VEC1(1:3)2140:             VEC2(1:3)=VEC2(1:3)-DUMMY*VEC1(1:3)
1780:             DUMMY=SQRT(VEC2(1)**2+VEC2(2)**2+VEC2(3)**2)2141:             DUMMY=SQRT(VEC2(1)**2+VEC2(2)**2+VEC2(3)**2)
1781:             IF (DUMMY.NE.0.0D0) VEC2(1:3)=VEC2(1:3)/DUMMY2142:             IF (DUMMY.NE.0.0D0) VEC2(1:3)=VEC2(1:3)/DUMMY
1782:             VEC3(1)= VEC1(2)*VEC2(3)-VEC1(3)*VEC2(2)2143:             VEC3(1)= VEC1(2)*VEC2(3)-VEC1(3)*VEC2(2)
1783:             VEC3(2)=-VEC1(1)*VEC2(3)+VEC1(3)*VEC2(1)2144:             VEC3(2)=-VEC1(1)*VEC2(3)+VEC1(3)*VEC2(1)
1801:                DUMMY=VEC1(1)*VEC2(1)+VEC1(2)*VEC2(2)+VEC1(3)*VEC2(3)2162:                DUMMY=VEC1(1)*VEC2(1)+VEC1(2)*VEC2(2)+VEC1(3)*VEC2(3)
1802:                VEC2(1:3)=VEC2(1:3)-DUMMY*VEC1(1:3)2163:                VEC2(1:3)=VEC2(1:3)-DUMMY*VEC1(1:3)
1803:                DUMMY=SQRT(VEC2(1)**2+VEC2(2)**2+VEC2(3)**2)2164:                DUMMY=SQRT(VEC2(1)**2+VEC2(2)**2+VEC2(3)**2)
1804:                IF (DUMMY.NE.0.0D0) VEC2(1:3)=VEC2(1:3)/DUMMY2165:                IF (DUMMY.NE.0.0D0) VEC2(1:3)=VEC2(1:3)/DUMMY
1805:                VEC3(1)= VEC1(2)*VEC2(3)-VEC1(3)*VEC2(2)2166:                VEC3(1)= VEC1(2)*VEC2(3)-VEC1(3)*VEC2(2)
1806:                VEC3(2)=-VEC1(1)*VEC2(3)+VEC1(3)*VEC2(1)2167:                VEC3(2)=-VEC1(1)*VEC2(3)+VEC1(3)*VEC2(1)
1807:                VEC3(3)= VEC1(1)*VEC2(2)-VEC1(2)*VEC2(1)2168:                VEC3(3)= VEC1(1)*VEC2(2)-VEC1(2)*VEC2(1)
1808:                XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)= &2169:                XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)= &
1809:   &            XYZ((J1-1)*3*NATOMS+3*(CONLIST(1)-1)+1:(J1-1)*3*NATOMS+3*(CONLIST(1)-1)+3)+C1*VEC1(1:3)+C2*VEC2(1:3)+C3*VEC3(1:3)2170:   &            XYZ((J1-1)*3*NATOMS+3*(CONLIST(1)-1)+1:(J1-1)*3*NATOMS+3*(CONLIST(1)-1)+3)+C1*VEC1(1:3)+C2*VEC2(1:3)+C3*VEC3(1:3)
1810:             ENDDO2171:             ENDDO
1811:             CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),NNREPSAVE,NREPSAVE+1) ! set up repulsive neighbour list2172:             CALL CHECKREP(INTIMAGE,XYZ,NOPT,NNREPSAVE,NREPSAVE+1) ! set up repulsive neighbour list
1812:             IF (QCIADDREP.GT.0) THEN2173:             IF (CHECKCONINT) THEN
1813:                CALL CONGRAD3(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS) 
1814:             ELSEIF (CHECKCONINT) THEN 
1815:                CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)2174:                CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
1816:             ELSE2175:             ELSE
1817:                CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)2176:                CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
1818:             ENDIF2177:             ENDIF
1819:             ESAVE0=ETOTAL2178:             ESAVE0=ETOTAL
1820:             DO J1=2,INTIMAGE+12179:             DO J1=2,INTIMAGE+1
1821:                XSAVE0(1:3,J1)=XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)2180:                XSAVE0(1:3,J1)=XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)
1822:             ENDDO2181:             ENDDO
1823:          ENDIF2182:          ENDIF
1824:          IF (NDFORNEWATOM.GE.3) THEN2183:          IF (NDFORNEWATOM.GE.3) THEN
1849:                      ENDIF2208:                      ENDIF
1850:                      IF (N2.EQ.0) THEN2209:                      IF (N2.EQ.0) THEN
1851:                         N2=J12210:                         N2=J1
1852:                         EXIT2211:                         EXIT
1853:                      ENDIF2212:                      ENDIF
1854:                      N3=J12213:                      N3=J1
1855:                      EXIT2214:                      EXIT
1856:                   ENDIF2215:                   ENDIF
1857:                ENDDO2216:                ENDDO
1858:             ENDDO2217:             ENDDO
1859:             IF (DEBUG) WRITE(*,'(A,3I6,A)') ' intlbfgs> choosing positions ',N1,N2,N3,' in best preserved list'2218:             IF (DEBUG) PRINT '(A,3I6,A)',' intlbfgs> choosing positions ',N1,N2,N3,' in best preserved list'
1860:             IF (DEBUG) WRITE(*,'(A,3I6)') ' intlbfgs> atoms are ',BESTPRESERVEDN(N1),BESTPRESERVEDN(N2),BESTPRESERVEDN(N3)2219:             IF (DEBUG) PRINT '(A,3I6)',' intlbfgs> atoms are ',BESTPRESERVEDN(N1),BESTPRESERVEDN(N2),BESTPRESERVEDN(N3)
1861: !           IF (DEBUG) WRITE(*,'(A,3I6,A)') ' intlbfgs> full list has length ',NDFORNEWATOM2220: !           IF (DEBUG) PRINT '(A,3I6,A)',' intlbfgs> full list has length ',NDFORNEWATOM
1862: !           IF (DEBUG) WRITE(*,'(20I6)') BESTPRESERVEDN(1:NDFORNEWATOM)2221: !           IF (DEBUG) PRINT '(20I6)',BESTPRESERVEDN(1:NDFORNEWATOM)
1863: 2222: 
1864: !2223: !
1865: ! Move the new atom consistently in the local environment of the three active atoms with the2224: ! Move the new atom consistently in the local environment of the three active atoms with the
1866: ! best preserved absolute distances or the shortest average distances in the end points.2225: ! best preserved absolute distances or the shortest average distances in the end points.
1867: ! Check the energies and compare linear interpolation as well, then choose the interpolation2226: ! Check the energies and compare linear interpolation as well, then choose the interpolation
1868: ! with the lowest energy.2227: ! with the lowest energy.
1869: ! Make a local orthogonal coordinate system and use constant components in this basis.2228: ! Make a local orthogonal coordinate system and use constant components in this basis.
1870: !2229: !
1871:             VEC1(1:3)=XYZ(3*(BESTPRESERVEDN(N2)-1)+1:3*(BESTPRESERVEDN(N2)-1)+3) &2230:             VEC1(1:3)=XYZ(3*(BESTPRESERVEDN(N2)-1)+1:3*(BESTPRESERVEDN(N2)-1)+3) &
1872:   &                  -XYZ(3*(BESTPRESERVEDN(N1)-1)+1:3*(BESTPRESERVEDN(N1)-1)+3)2231:   &                  -XYZ(3*(BESTPRESERVEDN(N1)-1)+1:3*(BESTPRESERVEDN(N1)-1)+3)
1899:   &                     -XYZ((J1-1)*3*NATOMS+3*(BESTPRESERVEDN(N1)-1)+1:(J1-1)*3*NATOMS+3*(BESTPRESERVEDN(N1)-1)+3)2258:   &                     -XYZ((J1-1)*3*NATOMS+3*(BESTPRESERVEDN(N1)-1)+1:(J1-1)*3*NATOMS+3*(BESTPRESERVEDN(N1)-1)+3)
1900:                DUMMY=VEC1(1)*VEC2(1)+VEC1(2)*VEC2(2)+VEC1(3)*VEC2(3)2259:                DUMMY=VEC1(1)*VEC2(1)+VEC1(2)*VEC2(2)+VEC1(3)*VEC2(3)
1901:                VEC2(1:3)=VEC2(1:3)-DUMMY*VEC1(1:3)2260:                VEC2(1:3)=VEC2(1:3)-DUMMY*VEC1(1:3)
1902:                DUMMY=SQRT(VEC2(1)**2+VEC2(2)**2+VEC2(3)**2)2261:                DUMMY=SQRT(VEC2(1)**2+VEC2(2)**2+VEC2(3)**2)
1903:                IF (DUMMY.NE.0.0D0) VEC2(1:3)=VEC2(1:3)/DUMMY2262:                IF (DUMMY.NE.0.0D0) VEC2(1:3)=VEC2(1:3)/DUMMY
1904:                VEC3(1)= VEC1(2)*VEC2(3)-VEC1(3)*VEC2(2)2263:                VEC3(1)= VEC1(2)*VEC2(3)-VEC1(3)*VEC2(2)
1905:                VEC3(2)=-VEC1(1)*VEC2(3)+VEC1(3)*VEC2(1)2264:                VEC3(2)=-VEC1(1)*VEC2(3)+VEC1(3)*VEC2(1)
1906:                VEC3(3)= VEC1(1)*VEC2(2)-VEC1(2)*VEC2(1)2265:                VEC3(3)= VEC1(1)*VEC2(2)-VEC1(2)*VEC2(1)
1907:                XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)= &2266:                XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)= &
1908:   &            XYZ((J1-1)*3*NATOMS+3*(BESTPRESERVEDN(N1)-1)+1:(J1-1)*3*NATOMS+3*(BESTPRESERVEDN(N1)-1)+3)+ &2267:   &            XYZ((J1-1)*3*NATOMS+3*(BESTPRESERVEDN(N1)-1)+1:(J1-1)*3*NATOMS+3*(BESTPRESERVEDN(N1)-1)+3)+ &
1909:   &                   C1*VEC1(1:3)+C2*VEC2(1:3)+C3*VEC3(1:3)+0.01D0*(DPRAND()-0.5D0)*2.0D02268:   &                   C1*VEC1(1:3)+C2*VEC2(1:3)+C3*VEC3(1:3)
1910: !              WRITE(*,'(A,I6,3G20.10)') 'intlbfgs> J1,C1,C2,C3=',J1,C1,C2,C3 
1911: !              WRITE(*,'(A,9G20.10)') 'intlbfgs> VEC1,2,3=',VEC1(1:3),VEC2(1:3),VEC3(1:3) 
1912: !              WRITE(*,'(A,6I6)') 'intlbfgs> N1,N2,N3,Bestpreserved N1,N2,N3=',N1,N2,N3, & 
1913: ! &                 BESTPRESERVEDN(N1),BESTPRESERVEDN(N2),BESTPRESERVEDN(N3) 
1914:             ENDDO2269:             ENDDO
1915: 2270: 
1916:             CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),NNREPSAVE,NREPSAVE+1) ! set up repulsive neighbour list2271:             CALL CHECKREP(INTIMAGE,XYZ,NOPT,NNREPSAVE,NREPSAVE+1) ! set up repulsive neighbour list
1917:             IF (QCIADDREP.GT.0) THEN2272:             IF (CHECKCONINT) THEN
1918:                CALL CONGRAD3(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS) 
1919:             ELSEIF (CHECKCONINT) THEN 
1920:                CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)2273:                CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
1921:             ELSE2274:             ELSE
1922:                CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)2275:                CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
1923:             ENDIF2276:             ENDIF
1924:             ESAVED=ETOTAL2277:             ESAVED=ETOTAL
1925:             DO J1=2,INTIMAGE+12278:             DO J1=2,INTIMAGE+1
1926:                XSAVED(1:3,J1)=XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)2279:                XSAVED(1:3,J1)=XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)
1927:             ENDDO2280:             ENDDO
1928:          ENDIF2281:          ENDIF
1929: 2282: 
1955:                      ENDIF2308:                      ENDIF
1956:                      IF (N2.EQ.0) THEN2309:                      IF (N2.EQ.0) THEN
1957:                         N2=J12310:                         N2=J1
1958:                         EXIT2311:                         EXIT
1959:                      ENDIF2312:                      ENDIF
1960:                      N3=J12313:                      N3=J1
1961:                      EXIT2314:                      EXIT
1962:                   ENDIF2315:                   ENDIF
1963:                ENDDO2316:                ENDDO
1964:             ENDDO2317:             ENDDO
1965:             IF (DEBUG) WRITE(*,'(A,3I6,A)') ' intlbfgs> choosing positions ',N1,N2,N3,' in closest list'2318:             IF (DEBUG) PRINT '(A,3I6,A)',' intlbfgs> choosing positions ',N1,N2,N3,' in closest list'
1966: 2319: 
1967:             VEC1(1:3)=XYZ(3*(BESTCLOSESTN(N2)-1)+1:3*(BESTCLOSESTN(N2)-1)+3)-XYZ(3*(BESTCLOSESTN(N1)-1)+1:3*(BESTCLOSESTN(N1)-1)+3)2320:             VEC1(1:3)=XYZ(3*(BESTCLOSESTN(N2)-1)+1:3*(BESTCLOSESTN(N2)-1)+3)-XYZ(3*(BESTCLOSESTN(N1)-1)+1:3*(BESTCLOSESTN(N1)-1)+3)
1968:             DUMMY=SQRT(VEC1(1)**2+VEC1(2)**2+VEC1(3)**2)2321:             DUMMY=SQRT(VEC1(1)**2+VEC1(2)**2+VEC1(3)**2)
1969:             IF (DUMMY.NE.0.0D0) VEC1(1:3)=VEC1(1:3)/DUMMY2322:             IF (DUMMY.NE.0.0D0) VEC1(1:3)=VEC1(1:3)/DUMMY
1970:             VEC2(1:3)=XYZ(3*(BESTCLOSESTN(N3)-1)+1:3*(BESTCLOSESTN(N3)-1)+3)-XYZ(3*(BESTCLOSESTN(N1)-1)+1:3*(BESTCLOSESTN(N1)-1)+3)2323:             VEC2(1:3)=XYZ(3*(BESTCLOSESTN(N3)-1)+1:3*(BESTCLOSESTN(N3)-1)+3)-XYZ(3*(BESTCLOSESTN(N1)-1)+1:3*(BESTCLOSESTN(N1)-1)+3)
1971:             DUMMY=VEC1(1)*VEC2(1)+VEC1(2)*VEC2(2)+VEC1(3)*VEC2(3)2324:             DUMMY=VEC1(1)*VEC2(1)+VEC1(2)*VEC2(2)+VEC1(3)*VEC2(3)
1972:             VEC2(1:3)=VEC2(1:3)-DUMMY*VEC1(1:3)2325:             VEC2(1:3)=VEC2(1:3)-DUMMY*VEC1(1:3)
1973:             DUMMY=SQRT(VEC2(1)**2+VEC2(2)**2+VEC2(3)**2)2326:             DUMMY=SQRT(VEC2(1)**2+VEC2(2)**2+VEC2(3)**2)
1974:             IF (DUMMY.NE.0.0D0) VEC2(1:3)=VEC2(1:3)/DUMMY2327:             IF (DUMMY.NE.0.0D0) VEC2(1:3)=VEC2(1:3)/DUMMY
1975:             VEC3(1)= VEC1(2)*VEC2(3)-VEC1(3)*VEC2(2)2328:             VEC3(1)= VEC1(2)*VEC2(3)-VEC1(3)*VEC2(2)
1996:                DUMMY=SQRT(VEC2(1)**2+VEC2(2)**2+VEC2(3)**2)2349:                DUMMY=SQRT(VEC2(1)**2+VEC2(2)**2+VEC2(3)**2)
1997:                IF (DUMMY.NE.0.0D0) VEC2(1:3)=VEC2(1:3)/DUMMY2350:                IF (DUMMY.NE.0.0D0) VEC2(1:3)=VEC2(1:3)/DUMMY
1998:                VEC3(1)= VEC1(2)*VEC2(3)-VEC1(3)*VEC2(2)2351:                VEC3(1)= VEC1(2)*VEC2(3)-VEC1(3)*VEC2(2)
1999:                VEC3(2)=-VEC1(1)*VEC2(3)+VEC1(3)*VEC2(1)2352:                VEC3(2)=-VEC1(1)*VEC2(3)+VEC1(3)*VEC2(1)
2000:                VEC3(3)= VEC1(1)*VEC2(2)-VEC1(2)*VEC2(1)2353:                VEC3(3)= VEC1(1)*VEC2(2)-VEC1(2)*VEC2(1)
2001:                XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)= &2354:                XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)= &
2002:   &            XYZ((J1-1)*3*NATOMS+3*(BESTCLOSESTN(N1)-1)+1:(J1-1)*3*NATOMS+3*(BESTCLOSESTN(N1)-1)+3)+ &2355:   &            XYZ((J1-1)*3*NATOMS+3*(BESTCLOSESTN(N1)-1)+1:(J1-1)*3*NATOMS+3*(BESTCLOSESTN(N1)-1)+3)+ &
2003:   &                   C1*VEC1(1:3)+C2*VEC2(1:3)+C3*VEC3(1:3)2356:   &                   C1*VEC1(1:3)+C2*VEC2(1:3)+C3*VEC3(1:3)
2004:             ENDDO2357:             ENDDO
2005: 2358: 
2006:             CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),NNREPSAVE,NREPSAVE+1) ! set up repulsive neighbour list2359:             CALL CHECKREP(INTIMAGE,XYZ,NOPT,NNREPSAVE,NREPSAVE+1) ! set up repulsive neighbour list
2007:             IF (QCIADDREP.GT.0) THEN2360:             IF (CHECKCONINT) THEN
2008:                CALL CONGRAD3(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS) 
2009:             ELSEIF (CHECKCONINT) THEN 
2010:                CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)2361:                CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
2011:             ELSE2362:             ELSE
2012:                CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)2363:                CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
2013:             ENDIF2364:             ENDIF
2014:             ESAVEC=ETOTAL2365:             ESAVEC=ETOTAL
2015:             DO J1=2,INTIMAGE+12366:             DO J1=2,INTIMAGE+1
2016:                XSAVEC(1:3,J1)=XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)2367:                XSAVEC(1:3,J1)=XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)
2017:             ENDDO2368:             ENDDO
2018:          ENDIF2369:          ENDIF
2019: !2370: !
2027:             XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1)=XYZ((J1-1)*3*NATOMS+3*(CONLIST(1)-1)+1)  &2378:             XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1)=XYZ((J1-1)*3*NATOMS+3*(CONLIST(1)-1)+1)  &
2028:  &            +(INTIMAGE-J1+2)*FRAC*(XYZ(3*(NEWATOM-1)+1)-XYZ(3*(CONLIST(1)-1)+1))/(INTIMAGE+1) &2379:  &            +(INTIMAGE-J1+2)*FRAC*(XYZ(3*(NEWATOM-1)+1)-XYZ(3*(CONLIST(1)-1)+1))/(INTIMAGE+1) &
2029:  &   +(J1-1)*(XYZ(3*NATOMS*(INTIMAGE+1)+3*(NEWATOM-1)+1)-XYZ(3*NATOMS*(INTIMAGE+1)+3*(CONLIST(1)-1)+1))/(INTIMAGE+1)2380:  &   +(J1-1)*(XYZ(3*NATOMS*(INTIMAGE+1)+3*(NEWATOM-1)+1)-XYZ(3*NATOMS*(INTIMAGE+1)+3*(CONLIST(1)-1)+1))/(INTIMAGE+1)
2030:             XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+2)=XYZ((J1-1)*3*NATOMS+3*(CONLIST(1)-1)+2)  &2381:             XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+2)=XYZ((J1-1)*3*NATOMS+3*(CONLIST(1)-1)+2)  &
2031:  &            +(INTIMAGE-J1+2)*FRAC*(XYZ(3*(NEWATOM-1)+2)-XYZ(3*(CONLIST(1)-1)+2))/(INTIMAGE+1) &2382:  &            +(INTIMAGE-J1+2)*FRAC*(XYZ(3*(NEWATOM-1)+2)-XYZ(3*(CONLIST(1)-1)+2))/(INTIMAGE+1) &
2032:  &   +(J1-1)*(XYZ(3*NATOMS*(INTIMAGE+1)+3*(NEWATOM-1)+2)-XYZ(3*NATOMS*(INTIMAGE+1)+3*(CONLIST(1)-1)+2))/(INTIMAGE+1)2383:  &   +(J1-1)*(XYZ(3*NATOMS*(INTIMAGE+1)+3*(NEWATOM-1)+2)-XYZ(3*NATOMS*(INTIMAGE+1)+3*(CONLIST(1)-1)+2))/(INTIMAGE+1)
2033:             XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+3)=XYZ((J1-1)*3*NATOMS+3*(CONLIST(1)-1)+3)  &2384:             XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+3)=XYZ((J1-1)*3*NATOMS+3*(CONLIST(1)-1)+3)  &
2034:  &            +(INTIMAGE-J1+2)*FRAC*(XYZ(3*(NEWATOM-1)+3)-XYZ(3*(CONLIST(1)-1)+3))/(INTIMAGE+1) &2385:  &            +(INTIMAGE-J1+2)*FRAC*(XYZ(3*(NEWATOM-1)+3)-XYZ(3*(CONLIST(1)-1)+3))/(INTIMAGE+1) &
2035:  &   +(J1-1)*(XYZ(3*NATOMS*(INTIMAGE+1)+3*(NEWATOM-1)+3)-XYZ(3*NATOMS*(INTIMAGE+1)+3*(CONLIST(1)-1)+3))/(INTIMAGE+1)2386:  &   +(J1-1)*(XYZ(3*NATOMS*(INTIMAGE+1)+3*(NEWATOM-1)+3)-XYZ(3*NATOMS*(INTIMAGE+1)+3*(CONLIST(1)-1)+3))/(INTIMAGE+1)
2036:          ENDDO2387:          ENDDO
2037:          CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),NNREPSAVE,NREPSAVE+1) ! set up repulsive neighbour list2388:          CALL CHECKREP(INTIMAGE,XYZ,NOPT,NNREPSAVE,NREPSAVE+1) ! set up repulsive neighbour list
2038:          IF (QCIADDREP.GT.0) THEN2389:          IF (CHECKCONINT) THEN
2039:             CALL CONGRAD3(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS) 
2040:          ELSEIF (CHECKCONINT) THEN 
2041:             CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)2390:             CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
2042:          ELSE2391:          ELSE
2043:             CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)2392:             CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
2044:          ENDIF2393:          ENDIF
2045:          IF (DEBUG) WRITE(*,'(A,4G15.5)') ' intlbfgs> energies for constrained, preserved, closest, and linear schemes=', &2394:          IF (DEBUG) PRINT '(A,4G15.5)',' intlbfgs> energies for constrained, preserved, closest, and linear schemes=', &
2046:   &                 ESAVE0,ESAVED,ESAVEC,ETOTAL2395:   &                 ESAVE0,ESAVED,ESAVEC,ETOTAL
2047:          IF ((ETOTAL.LT.ESAVEC).AND.(ETOTAL.LT.ESAVED).AND.(ETOTAL.LT.ESAVE0)) THEN2396:          IF ((ETOTAL.LT.ESAVEC).AND.(ETOTAL.LT.ESAVED).AND.(ETOTAL.LT.ESAVE0)) THEN
2048:             IF (DEBUG) WRITE(*,'(A,2G20.10)') ' intlbfgs> lowest energy from linear interpolation'2397:             IF (DEBUG) PRINT '(A,2G20.10)',' intlbfgs> lowest energy from linear interpolation'
2049:          ELSE IF ((ESAVEC.LT.ESAVED).AND.(ESAVEC.LT.ESAVE0)) THEN2398:          ELSE IF ((ESAVEC.LT.ESAVED).AND.(ESAVEC.LT.ESAVE0)) THEN
2050:             IF (DEBUG) WRITE(*,'(A,2G20.10)') ' intlbfgs> lowest energy from interpolation using closest atoms'2399:             IF (DEBUG) PRINT '(A,2G20.10)',' intlbfgs> lowest energy from interpolation using closest atoms'
2051:             DO J1=2,INTIMAGE+12400:             DO J1=2,INTIMAGE+1
2052:                XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)=XSAVEC(1:3,J1)2401:                XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)=XSAVEC(1:3,J1)
2053:             ENDDO2402:             ENDDO
2054:             ETOTAL=ESAVEC2403:             ETOTAL=ESAVEC
2055:          ELSE IF (ESAVED.LT.ESAVE0) THEN2404:          ELSE IF (ESAVED.LT.ESAVE0) THEN
2056:             IF (DEBUG) WRITE(*,'(A,2G20.10)') ' intlbfgs> lowest energy from interpolation using preserved distances'2405:             IF (DEBUG) PRINT '(A,2G20.10)',' intlbfgs> lowest energy from interpolation using preserved distances'
2057:             DO J1=2,INTIMAGE+12406:             DO J1=2,INTIMAGE+1
2058:                XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)=XSAVED(1:3,J1)2407:                XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)=XSAVED(1:3,J1)
2059:             ENDDO2408:             ENDDO
2060:             ETOTAL=ESAVED2409:             ETOTAL=ESAVED
2061:          ELSE 2410:          ELSE 
2062:             IF (DEBUG) WRITE(*,'(A,2G20.10)') ' intlbfgs> lowest energy from interpolation using closest constraints'2411:             IF (DEBUG) PRINT '(A,2G20.10)',' intlbfgs> lowest energy from interpolation using closest constraints'
2063:             DO J1=2,INTIMAGE+12412:             DO J1=2,INTIMAGE+1
2064:                XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)=XSAVE0(1:3,J1)2413:                XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)=XSAVE0(1:3,J1)
2065:             ENDDO2414:             ENDDO
2066:             ETOTAL=ESAVE02415:             ETOTAL=ESAVE0
2067:          ENDIF2416:          ENDIF
2068:       ENDIF2417:       ENDIF
2069:       NADDED=NADDED+12418:       NADDED=NADDED+1
2070:       IF (NADDED.LT.NTOADD) GOTO 5422419:       IF (NADDED.LT.NTOADD) GOTO 542
2071:  
2072:       IF (QCIRADSHIFTT) THEN 
2073:          WRITE(*,'(A,F15.5)') ' intlbfgs> Applying radial shift for unconstrained atoms of ',QCIRADSHIFT 
2074:          WRITE(*,'(20I6)') CONLIST(1:NCONFORNEWATOM) 
2075:          DO J1=2,INTIMAGE+1 
2076:             scaleloop: DO J2=1,NATOMS 
2077:                IF (.NOT.ATOMACTIVE(J2)) CYCLE scaleloop 
2078:                IF (J2.EQ.NEWATOM) CYCLE scaleloop 
2079:                DO J3=1,NCONFORNEWATOM 
2080:                   IF (CONLIST(J3).EQ.J2) CYCLE scaleloop 
2081:                ENDDO 
2082:                VEC1(1:3)=XYZ((J1-1)*3*NATOMS+3*(J2-1)+1:(J1-1)*3*NATOMS+3*(J2-1)+3)- & 
2083:    &                     XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3) 
2084:                DUMMY=SQRT(VEC1(1)**2+VEC1(2)**2+VEC1(3)**2) 
2085:                IF (DUMMY.NE.0.0D0) VEC1(1:3)=VEC1(1:3)*QCIRADSHIFT/DUMMY 
2086:                XYZ((J1-1)*3*NATOMS+3*(J2-1)+1:(J1-1)*3*NATOMS+3*(J2-1)+3)= & 
2087:    &           XYZ((J1-1)*3*NATOMS+3*(J2-1)+1:(J1-1)*3*NATOMS+3*(J2-1)+3)+VEC1(1:3) 
2088: !!!!!!!!!!! debug DJW !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
2089: !              VEC1(1:3)=XYZ((J1-1)*3*NATOMS+3*(J2-1)+1:(J1-1)*3*NATOMS+3*(J2-1)+3)- & 
2090: !  &                     XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3) 
2091: !              DUMMY2=SQRT(VEC1(1)**2+VEC1(2)**2+VEC1(3)**2) 
2092: !              PRINT '(A,I6,A,2I6,A,2F15.5)','image ',J1,' atoms ',NEWATOM,J2,' initial and final distance=',DUMMY,DUMMY2 
2093: !!!!!!!!!!! debug DJW !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
2094:             ENDDO scaleloop 
2095:          ENDDO 
2096:       ENDIF 
2097: !2420: !
2098: ! Turn frozen images off for new added atom.2421: ! Turn frozen images off for new added atom.
2099: !2422: !
2100: !     IF (DEBUG) WRITE(*,'(A)') ' intlbfgs> turning off frozen images'2423: !     IF (DEBUG) PRINT '(A)',' intlbfgs> turning off frozen images'
2101: !     IF (FREEZENODEST) IMGFREEZE(1:INTIMAGE)=.FALSE.2424: !     IF (FREEZENODEST) IMGFREEZE(1:INTIMAGE)=.FALSE.
2102:       CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),NNREPSAVE,NREPSAVE+1) ! set up repulsive neighbour list2425:       CALL CHECKREP(INTIMAGE,XYZ,NOPT,NNREPSAVE,NREPSAVE+1) ! set up repulsive neighbour list
2103: !2426: !
2104: ! need a new gradient since the active atom has changed !2427: ! need a new gradient since the active atom has changed !
2105: !2428: !
2106:       IF (QCIADDREP.GT.0) THEN2429:       IF (CHECKCONINT) THEN
2107:          CALL CONGRAD3(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS) 
2108:       ELSEIF (CHECKCONINT) THEN 
2109:          CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)2430:          CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
2110:       ELSE2431:       ELSE
2111:          CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)2432:          CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
2112:       ENDIF2433:       ENDIF
2113: 2434: 
2114: END SUBROUTINE DOADDATOM2435: END SUBROUTINE DOADDATOM
2115: 2436: 
2116: SUBROUTINE CHECKPERC(LXYZ,LINTCONSTRAINTTOL,NQCIFREEZE,NCPFIT)2437: SUBROUTINE CHECKPERC(LXYZ,LINTCONSTRAINTTOL,NQCIFREEZE,NCPFIT)
2117: USE KEY, ONLY : ATOMACTIVE, NCONSTRAINT, INTFROZEN, CONI, CONJ, CONDISTREF, INTCONMAX, INTCONSTRAINTTOL, &2438: USE KEY, ONLY : ATOMACTIVE, NCONSTRAINT, INTFROZEN, CONI, CONJ, CONDISTREF, INTCONMAX, INTCONSTRAINTTOL, &
2118:   &             INTCONSEP, NCONGEOM, CONGEOM, CONIFIX, CONJFIX, CONDISTREFFIX, INTCONCUT, &2439:   &             INTCONSEP, INTFREEZET, NCONGEOM, CONGEOM, CONIFIX, CONJFIX, CONDISTREFFIX, &
2119:   &             NCONSTRAINTFIX, BULKT, TWOD, RIGIDBODY, CONDATT, CONCUT, CONCUTFIX, &2440:   &             NCONSTRAINTFIX, BULKT, TWOD, RIGIDBODY, CONDATT, CONCUT, CONCUTFIX
2120:   &             BONDS, QCIAMBERT, QCIADDREP, QCIADDREPCUT, QCIBONDS, QCISECOND2441: USE COMMONS, ONLY: NATOMS, DEBUG, NOPT, PARAM1, PARAM2, PARAM3
2121: USE COMMONS, ONLY: NATOMS, DEBUG, PARAM1, PARAM2, PARAM3 
2122: IMPLICIT NONE2442: IMPLICIT NONE
2123: INTEGER NDIST1(NATOMS), NCYCLE, DMIN1, DMAX1, NUNCON1, J1, J2, J3, NQCIFREEZE, J4, NCPFIT, LUNIT, GETUNIT2443: INTEGER NDIST1(NATOMS), NCYCLE, DMIN1, DMAX1, NUNCON1, J1, J2, J3, NQCIFREEZE, J4, NCPFIT
2124: INTEGER NI1, NJ1, NI2, NJ2, J5, ATOM1, ATOM22444: DOUBLE PRECISION LINTCONSTRAINTTOL, MAXCONDIST, MINCONDIST, DS, DF, LXYZ(NOPT*2)
2125: DOUBLE PRECISION LINTCONSTRAINTTOL, MAXCONDIST, MINCONDIST, DS, DF, LXYZ((3*NATOMS)*2)2445: DOUBLE PRECISION DSMIN, DSMAX, DSMEAN, DISTANCE, DIST2, RMAT(3,3)
2126: DOUBLE PRECISION DSMIN, DSMAX, DSMEAN, D, DIST2, RMAT(3,3), DUMMY, X1, Y1, Z1, X2, Y2, Z2, DMIN, D22446: LOGICAL CHANGED
2127: LOGICAL CHANGED, LDEBUG, CONFILET 
2128: LOGICAL :: CALLED=.FALSE.2447: LOGICAL :: CALLED=.FALSE.
2129: SAVE CALLED2448: SAVE CALLED
2130: !for QCIAMBER 
2131: INTEGER NBOND, NDUMMY 
2132: 2449: 
2133: LINTCONSTRAINTTOL=INTCONSTRAINTTOL2450: LINTCONSTRAINTTOL=INTCONSTRAINTTOL
2134: 2451: 
2135: IF (.NOT.ALLOCATED(ATOMACTIVE)) ALLOCATE(ATOMACTIVE(NATOMS))2452: IF (.NOT.ALLOCATED(ATOMACTIVE)) ALLOCATE(ATOMACTIVE(NATOMS))
2136: !2453: !
2137: ! Fixed constraints based on congeom file entries2454: ! Fixed constraints based on congeom file entries
2138: ! Just need to adjust the list based on any frozen atoms. We2455: ! Just need to adjust the list based on any frozen atoms. We
2139: ! want to exclude any constraints between two frozen atoms 2456: ! want to exclude any constraints between two frozen atoms 
2140: ! from the list, because subsequent code depends on this.2457: ! from the list, because subsequent code depends on this.
2141: !2458: !
2147: !2464: !
2148: ! If called with two minima check that CONCUTFIX is large enough to2465: ! If called with two minima check that CONCUTFIX is large enough to
2149: ! accommodate the separation of the two atoms in both minima.2466: ! accommodate the separation of the two atoms in both minima.
2150: !2467: !
2151:          IF (NCPFIT.EQ.2) THEN2468:          IF (NCPFIT.EQ.2) THEN
2152:             DF=MAX(ABS(CONDISTREFFIX(J1)- &2469:             DF=MAX(ABS(CONDISTREFFIX(J1)- &
2153:   &                SQRT((LXYZ(3*(CONIFIX(J1)-1)+1)-LXYZ(3*(CONJFIX(J1)-1)+1))**2+ &2470:   &                SQRT((LXYZ(3*(CONIFIX(J1)-1)+1)-LXYZ(3*(CONJFIX(J1)-1)+1))**2+ &
2154:   &                     (LXYZ(3*(CONIFIX(J1)-1)+2)-LXYZ(3*(CONJFIX(J1)-1)+2))**2+ &2471:   &                     (LXYZ(3*(CONIFIX(J1)-1)+2)-LXYZ(3*(CONJFIX(J1)-1)+2))**2+ &
2155:   &                     (LXYZ(3*(CONIFIX(J1)-1)+3)-LXYZ(3*(CONJFIX(J1)-1)+3))**2)),&2472:   &                     (LXYZ(3*(CONIFIX(J1)-1)+3)-LXYZ(3*(CONJFIX(J1)-1)+3))**2)),&
2156:                    ABS(CONDISTREFFIX(J1)- &2473:                    ABS(CONDISTREFFIX(J1)- &
2157:   &                SQRT((LXYZ((3*NATOMS)+3*(CONIFIX(J1)-1)+1)-LXYZ((3*NATOMS)+3*(CONJFIX(J1)-1)+1))**2+ &2474:   &                SQRT((LXYZ(NOPT+3*(CONIFIX(J1)-1)+1)-LXYZ(NOPT+3*(CONJFIX(J1)-1)+1))**2+ &
2158:   &                     (LXYZ((3*NATOMS)+3*(CONIFIX(J1)-1)+2)-LXYZ((3*NATOMS)+3*(CONJFIX(J1)-1)+2))**2+ &2475:   &                     (LXYZ(NOPT+3*(CONIFIX(J1)-1)+2)-LXYZ(NOPT+3*(CONJFIX(J1)-1)+2))**2+ &
2159:   &                     (LXYZ((3*NATOMS)+3*(CONIFIX(J1)-1)+3)-LXYZ((3*NATOMS)+3*(CONJFIX(J1)-1)+3))**2)))2476:   &                     (LXYZ(NOPT+3*(CONIFIX(J1)-1)+3)-LXYZ(NOPT+3*(CONJFIX(J1)-1)+3))**2)))
2160:             IF (DF.GT.CONCUTFIX(J1)) THEN2477:             IF (DF.GT.CONCUTFIX(J1)) THEN
2161:                IF (ABS(DF-CONCUTFIX(J1)).GT.1.0D-6) &2478:                IF (ABS(DF-CONCUTFIX(J1)).GT.1.0D-6) &
2162:   &                WRITE(*,'(A,2I5,3(A,G15.5))') ' checkperc> Increasing con cutoff atoms ', &2479:   &                PRINT '(A,2I5,3(A,G15.5))',' checkperc> Increasing con cutoff atoms ', &
2163:   &                CONIFIX(J1),CONJFIX(J1),' from ',CONCUTFIX(J1),' to ',DF,' ref=',CONDISTREFFIX(J1)2480:   &                CONIFIX(J1),CONJFIX(J1),' from ',CONCUTFIX(J1),' to ',DF,' ref=',CONDISTREFFIX(J1)
2164:                CONCUTFIX(J1)=DF2481:                CONCUTFIX(J1)=DF
2165:             ENDIF2482:             ENDIF
2166:          ENDIF2483:          ENDIF
2167:          IF (INTFROZEN(CONIFIX(J1)).AND.INTFROZEN(CONJFIX(J1))) CYCLE2484:          IF (INTFROZEN(CONIFIX(J1)).AND.INTFROZEN(CONJFIX(J1))) CYCLE
2168:          J2=J2+12485:          J2=J2+1
2169:          CONI(J2)=CONIFIX(J1)2486:          CONI(J2)=CONIFIX(J1)
2170:          CONJ(J2)=CONJFIX(J1)2487:          CONJ(J2)=CONJFIX(J1)
2171:          CONDISTREF(J2)=CONDISTREFFIX(J1)2488:          CONDISTREF(J2)=CONDISTREFFIX(J1)
2172:          CONCUT(J2)=CONCUTFIX(J1)2489:          CONCUT(J2)=CONCUTFIX(J1)
2173:       ENDDO2490:       ENDDO
2174:       NCONSTRAINT=J22491:       NCONSTRAINT=J2
2175:       WRITE(*,'(A,I6,A)') ' checkperc> After allowing for frozen atoms there are ',NCONSTRAINT,' constraints'2492:       PRINT '(A,I6,A)',' checkperc> After allowing for frozen atoms there are ',NCONSTRAINT,' constraints'
2176:       RETURN 2493:       RETURN 
2177:    ELSE2494:    ELSE
2178: !2495: !
2179: ! Put reference minima in optimal permutational alignment with reference minimum one.2496: ! Put reference minima in optimal permutational alignment with reference minimum one.
2180: !2497: !
2181:       DO J2=2,NCONGEOM2498:       DO J2=2,NCONGEOM
2182:          LDEBUG=.FALSE.2499:          CALL MINPERMDIST(CONGEOM(1,1:3*NATOMS),CONGEOM(J2,1:3*NATOMS),NATOMS,DEBUG, &
2183:          CALL MINPERMDIST(CONGEOM(1,1:3*NATOMS),CONGEOM(J2,1:3*NATOMS),NATOMS,LDEBUG, &2500:   &                       PARAM1,PARAM2,PARAM3,BULKT,TWOD,DISTANCE,DIST2,RIGIDBODY,RMAT)
2184:   &                       PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT) 
2185:       ENDDO2501:       ENDDO
2186:    ENDIF2502:    ENDIF
2187:    ALLOCATE(CONIFIX(INTCONMAX),CONJFIX(INTCONMAX),CONCUTFIX(INTCONMAX),CONDISTREFFIX(INTCONMAX))2503:    ALLOCATE(CONIFIX(INTCONMAX),CONJFIX(INTCONMAX),CONCUTFIX(INTCONMAX),CONDISTREFFIX(INTCONMAX))
2188: ENDIF2504: ENDIF
2189: 2505: 
2190: INQUIRE(FILE='constraintfile',EXIST=CONFILET) 
2191:  
2192: 51   NCONSTRAINT=0 2506: 51   NCONSTRAINT=0 
2193: MAXCONDIST=-1.0D02507: MAXCONDIST=-1.0D0
2194: MINCONDIST=1.0D1002508: MINCONDIST=1.0D100
2195: IF (QCIAMBERT) THEN             2509: IF (NCONGEOM.LT.2) THEN 
2196:    CALL TOPOLOGY_READER(NBOND)   
2197: ! 
2198: !  kr366> assume we use two endpoints and topology for amber constraints 
2199: !  get number of bonds and bonds from topology 
2200: !  loop through all bonds and add them to constraint list 
2201: ! 
2202:    DO J2=1,NBOND                !loop through all bonds and add them to constraint list 
2203:       IF (INTFROZEN(BONDS(J2,1)).AND.INTFROZEN(BONDS(J2,2))) CYCLE ! no constraints between intfrozen atoms 
2204:       NCONSTRAINT=NCONSTRAINT+1 
2205:       IF (DEBUG) WRITE(*,'(A,2I6,A,I6)') 'intlbfgs> Adding constraint for atoms ',BONDS(J2,1),BONDS(J2,2), & 
2206:   &                     '  total=',NCONSTRAINT 
2207:       DS=SQRT((LXYZ(3*(BONDS(J2,1)-1)+1)-LXYZ(3*(BONDS(J2,2)-1)+1))**2 & 
2208:   &          +(LXYZ(3*(BONDS(J2,1)-1)+2)-LXYZ(3*(BONDS(J2,2)-1)+2))**2 & 
2209:   &          +(LXYZ(3*(BONDS(J2,1)-1)+3)-LXYZ(3*(BONDS(J2,2)-1)+3))**2) 
2210:       DF=SQRT((LXYZ(3*NATOMS+3*(BONDS(J2,1)-1)+1)-LXYZ(3*NATOMS+3*(BONDS(J2,2)-1)+1))**2 & 
2211:   &          +(LXYZ(3*NATOMS+3*(BONDS(J2,1)-1)+2)-LXYZ(3*NATOMS+3*(BONDS(J2,2)-1)+2))**2 & 
2212:   &          +(LXYZ(3*NATOMS+3*(BONDS(J2,1)-1)+3)-LXYZ(3*NATOMS+3*(BONDS(J2,2)-1)+3))**2) 
2213:       IF (NCONSTRAINT.GT.INTCONMAX) CALL CONDOUBLE 
2214:       CONI(NCONSTRAINT)=MIN(BONDS(J2,1),BONDS(J2,2)) 
2215:       CONJ(NCONSTRAINT)=MAX(BONDS(J2,2),BONDS(J2,2)) 
2216:       CONDISTREF(NCONSTRAINT)=(DF+DS)/2.0D0 
2217:       CONCUT(NCONSTRAINT)=ABS(DF-DS)/2.0D0 
2218:       IF (CONDISTREF(NCONSTRAINT).GT.MAXCONDIST) MAXCONDIST=CONDISTREF(NCONSTRAINT) 
2219:       IF (CONDISTREF(NCONSTRAINT).LT.MINCONDIST) MINCONDIST=CONDISTREF(NCONSTRAINT) 
2220: !     IF (DEBUG) WRITE(*,'(A,2I6,A,2F12.2,A,F12.4,A,I8)') ' intlbfgs> constrain distance for ',CONI(NCONSTRAINT), & 
2221: ! &             CONJ(NCONSTRAINT),' values are ',DS,DF,' fraction=',2*ABS(DS-DF)/(DS+DF), & 
2222: ! &            ' # bond constraints=',NCONSTRAINT 
2223:    ENDDO 
2224:    QCIBONDS=NCONSTRAINT 
2225: ! 
2226: ! Add constraints for second-nearest neighbours - should correspond to bond angles 
2227: ! 
2228:    DO J2=1,NBOND 
2229:       inloop: DO J3=J2+1,NBOND 
2230:         IF (BONDS(J2,1).EQ.BONDS(J3,1)) THEN 
2231:            ATOM1=BONDS(J2,2) 
2232:            ATOM2=BONDS(J3,2) 
2233:         ELSEIF (BONDS(J2,1).EQ.BONDS(J3,2)) THEN 
2234:            ATOM1=BONDS(J2,2) 
2235:            ATOM2=BONDS(J3,1) 
2236:         ELSEIF (BONDS(J2,2).EQ.BONDS(J3,1)) THEN 
2237:            ATOM1=BONDS(J2,1) 
2238:            ATOM2=BONDS(J3,2) 
2239:         ELSEIF (BONDS(J2,2).EQ.BONDS(J3,2)) THEN 
2240:            ATOM1=BONDS(J2,1) 
2241:            ATOM2=BONDS(J3,1) 
2242:         ELSE 
2243:            CYCLE inloop 
2244:         ENDIF 
2245:         IF (INTFROZEN(ATOM1).AND.INTFROZEN(ATOM2)) CYCLE ! no constraints between intfrozen atoms 
2246:         NCONSTRAINT=NCONSTRAINT+1 
2247: !       WRITE(*,'(A,2I6,A,I6)') 'intlbfgs> Adding constraint for second neighbours ',ATOM1,ATOM2, & 
2248: ! &                     '  total=',NCONSTRAINT 
2249:          DS=SQRT((LXYZ(3*(ATOM1-1)+1)-LXYZ(3*(ATOM2-1)+1))**2 & 
2250:   &             +(LXYZ(3*(ATOM1-1)+2)-LXYZ(3*(ATOM2-1)+2))**2 & 
2251:   &             +(LXYZ(3*(ATOM1-1)+3)-LXYZ(3*(ATOM2-1)+3))**2) 
2252:          DF=SQRT((LXYZ(3*NATOMS+3*(ATOM1-1)+1)-LXYZ(3*NATOMS+3*(ATOM2-1)+1))**2 & 
2253:   &             +(LXYZ(3*NATOMS+3*(ATOM1-1)+2)-LXYZ(3*NATOMS+3*(ATOM2-1)+2))**2 & 
2254:   &             +(LXYZ(3*NATOMS+3*(ATOM1-1)+3)-LXYZ(3*NATOMS+3*(ATOM2-1)+3))**2) 
2255:          IF (NCONSTRAINT.GT.INTCONMAX) CALL CONDOUBLE 
2256:          CONI(NCONSTRAINT)=MIN(ATOM1,ATOM2) 
2257:          CONJ(NCONSTRAINT)=MAX(ATOM1,ATOM2) 
2258:          CONDISTREF(NCONSTRAINT)=(DF+DS)/2.0D0 
2259:          CONCUT(NCONSTRAINT)=ABS(DF-DS)/2.0D0 
2260:          IF (CONDISTREF(NCONSTRAINT).GT.MAXCONDIST) MAXCONDIST=CONDISTREF(NCONSTRAINT) 
2261:          IF (CONDISTREF(NCONSTRAINT).LT.MINCONDIST) MINCONDIST=CONDISTREF(NCONSTRAINT) 
2262: !        WRITE(*,'(A,2I6,A,2F12.2,A,F12.4,A,2I8)') ' intlbfgs> constrain distance for ',CONI(NCONSTRAINT), & 
2263: ! &             CONJ(NCONSTRAINT),' values are ',DS,DF,' fraction=',2*ABS(DS-DF)/(DS+DF), & 
2264: ! &            ' # second neighbour constraints, total=',QCISECOND,NCONSTRAINT 
2265:       ENDDO inloop 
2266:    ENDDO 
2267:    QCISECOND=NCONSTRAINT-QCIBONDS 
2268:    WRITE(*,'(A,2I6,A,I6)') 'intlbfgs> First and second neighbour constraints: ',QCIBONDS,QCISECOND,' total: ',NCONSTRAINT 
2269:    NDUMMY=NCONSTRAINT 
2270:    IF (CONFILET) THEN 
2271:       LUNIT=GETUNIT() 
2272:       OPEN(LUNIT,FILE='constraintfile',STATUS='OLD') 
2273: ! 
2274: !  Additional amber constraints, e.g. cis/trans 
2275: ! 
2276:       DO 
2277:          READ(LUNIT,*,END=534)  J2, J3 
2278: ! 
2279: ! Forbid constraints corresponding to atoms distant in sequence. Set INTCONSEP to number of sites to 
2280: ! turn this off 
2281: ! 
2282:          IF (J3-J2.GT.INTCONSEP) CYCLE 
2283:          IF (INTFROZEN(J2).AND.INTFROZEN(J3)) CYCLE ! no constraints between intfrozen atoms 
2284:          NCONSTRAINT=NCONSTRAINT+1 
2285:          IF (DEBUG) WRITE(*,'(A,2I6,A,I6)') 'intlbfgs> Adding extra constraint for atoms ',J2,J3,'  total=',NCONSTRAINT 
2286:          DS=SQRT((LXYZ(3*(J2-1)+1)-LXYZ(3*(J3-1)+1))**2 & 
2287:   &             +(LXYZ(3*(J2-1)+2)-LXYZ(3*(J3-1)+2))**2 & 
2288:   &             +(LXYZ(3*(J2-1)+3)-LXYZ(3*(J3-1)+3))**2) 
2289:          DF=SQRT((LXYZ(3*NATOMS+3*(J2-1)+1)-LXYZ(3*NATOMS+3*(J3-1)+1))**2 & 
2290:   &             +(LXYZ(3*NATOMS+3*(J2-1)+2)-LXYZ(3*NATOMS+3*(J3-1)+2))**2 & 
2291:   &             +(LXYZ(3*NATOMS+3*(J2-1)+3)-LXYZ(3*NATOMS+3*(J3-1)+3))**2) 
2292:          IF (NCONSTRAINT.GT.INTCONMAX) CALL CONDOUBLE 
2293:          CONI(NCONSTRAINT)=J2 
2294:          CONJ(NCONSTRAINT)=J3 
2295:          CONDISTREF(NCONSTRAINT)=(DF+DS)/2.0D0 
2296:          CONCUT(NCONSTRAINT)=ABS(DF-DS)/2.0D0 
2297:          IF (CONDISTREF(NCONSTRAINT).GT.MAXCONDIST) MAXCONDIST=CONDISTREF(NCONSTRAINT) 
2298:          IF (CONDISTREF(NCONSTRAINT).LT.MINCONDIST) MINCONDIST=CONDISTREF(NCONSTRAINT) 
2299:          IF (DEBUG) WRITE(*,'(A,2I6,A,2F12.2,A,F12.4,A,I8)') ' intlbfgs> constrain distance for ',CONI(NCONSTRAINT), & 
2300:   &                     CONJ(NCONSTRAINT),' values are ',DS,DF,' fraction=',2*ABS(DS-DF)/(DS+DF), & 
2301:   &                  ' # constraints=',NCONSTRAINT 
2302:       ENDDO 
2303: 534   CONTINUE 
2304:       CLOSE(LUNIT) 
2305:       IF (NCONSTRAINT-NDUMMY.GT.0) WRITE(*,'(A,I6,2(A,F15.5))') ' intlbfgs> Extra distance constraints: ',NCONSTRAINT-NDUMMY 
2306:       WRITE(*,'(A,I6,2(A,F15.5))') ' intlbfgs> Total distance constraints=',NCONSTRAINT,' shortest=',MINCONDIST,' longest=',MAXCONDIST 
2307:       CLOSE(LUNIT) 
2308:    ENDIF 
2309: ELSE IF (CONFILET) THEN  
2310:     LUNIT=GETUNIT() 
2311:     OPEN(LUNIT,FILE='constraintfile',STATUS='OLD') 
2312: ! 
2313: !  Add constraint for this distance to the list. 
2314: ! 
2315:     DO  
2316:        READ(LUNIT,*,END=531)  J2, J3 
2317: ! 
2318: ! Forbid constraints corresponding to atoms distant in sequence. Set INTCONSEP to number of sites to  
2319: ! turn this off 
2320: ! 
2321:        IF (J3-J2.GT.INTCONSEP) CYCLE  
2322:        IF (INTFROZEN(J2).AND.INTFROZEN(J3)) CYCLE ! no constraints between intfrozen atoms 
2323:        NCONSTRAINT=NCONSTRAINT+1 
2324: !      WRITE(*,'(A,2I6,A,I6)') 'intlbfgs> Adding constraint for atoms ',J2,J3,'  total=',NCONSTRAINT 
2325:        DS=SQRT((LXYZ(3*(J2-1)+1)-LXYZ(3*(J3-1)+1))**2 & 
2326:   &           +(LXYZ(3*(J2-1)+2)-LXYZ(3*(J3-1)+2))**2 & 
2327:   &           +(LXYZ(3*(J2-1)+3)-LXYZ(3*(J3-1)+3))**2)  
2328:        DF=SQRT((LXYZ(3*NATOMS+3*(J2-1)+1)-LXYZ(3*NATOMS+3*(J3-1)+1))**2 & 
2329:   &           +(LXYZ(3*NATOMS+3*(J2-1)+2)-LXYZ(3*NATOMS+3*(J3-1)+2))**2 & 
2330:   &           +(LXYZ(3*NATOMS+3*(J2-1)+3)-LXYZ(3*NATOMS+3*(J3-1)+3))**2)  
2331:        IF (NCONSTRAINT.GT.INTCONMAX) CALL CONDOUBLE 
2332:        CONI(NCONSTRAINT)=J2 
2333:        CONJ(NCONSTRAINT)=J3 
2334:        CONDISTREF(NCONSTRAINT)=(DF+DS)/2.0D0 
2335:        CONCUT(NCONSTRAINT)=ABS(DF-DS)/2.0D0 
2336:        IF (CONDISTREF(NCONSTRAINT).GT.MAXCONDIST) MAXCONDIST=CONDISTREF(NCONSTRAINT) 
2337:        IF (CONDISTREF(NCONSTRAINT).LT.MINCONDIST) MINCONDIST=CONDISTREF(NCONSTRAINT) 
2338:        WRITE(*,'(A,2I6,A,2F12.2,A,F12.4,A,I8)') ' intlbfgs> constrain distance for ',CONI(NCONSTRAINT), & 
2339:   &                 CONJ(NCONSTRAINT),' values are ',DS,DF,' fraction=',2*ABS(DS-DF)/(DS+DF), & 
2340:   &                ' # constraints=',NCONSTRAINT 
2341:     ENDDO 
2342: 531 CONTINUE 
2343:     WRITE(*,'(A,I6,2(A,F15.5))') ' intlbfgs> Total distance constraints=',NCONSTRAINT, & 
2344:   &                               ' shortest=',MINCONDIST,' longest=',MAXCONDIST 
2345:     CLOSE(LUNIT) 
2346:  
2347: ELSE IF (NCONGEOM.LT.2) THEN  
2348:    DO J2=1,NATOMS2510:    DO J2=1,NATOMS
2349:       DO J3=J2+1,NATOMS2511:       DO J3=J2+1,NATOMS
2350: 2512: 
2351:          IF (J3-J2.GT.INTCONSEP) CYCLE ! forbid constraints corresponding to atoms distant in sequence2513:          IF (J3-J2.GT.INTCONSEP) CYCLE ! forbid constraints corresponding to atoms distant in sequence
2352:          IF (INTFROZEN(J2).AND.INTFROZEN(J3)) CYCLE ! no constraints between intfrozen atoms2514:          IF (INTFROZEN(J2).AND.INTFROZEN(J3)) CYCLE ! no constraints between intfrozen atoms
2353:          DS=SQRT((LXYZ(3*(J2-1)+1)-LXYZ(3*(J3-1)+1))**2 &2515:          DS=SQRT((LXYZ(3*(J2-1)+1)-LXYZ(3*(J3-1)+1))**2 &
2354:   &             +(LXYZ(3*(J2-1)+2)-LXYZ(3*(J3-1)+2))**2 &2516:   &             +(LXYZ(3*(J2-1)+2)-LXYZ(3*(J3-1)+2))**2 &
2355:   &             +(LXYZ(3*(J2-1)+3)-LXYZ(3*(J3-1)+3))**2) 2517:   &             +(LXYZ(3*(J2-1)+3)-LXYZ(3*(J3-1)+3))**2) 
2356:          IF (DS.GT.INTCONCUT) CYCLE ! don't allow constraints if either endpoint separation is too large DJW2518:          IF (DS.GT.5.0D0) CYCLE ! don't allow constraints if either endpoint separation is too large DJW
 2519: !        IF (DS.GT.15.0D0) CYCLE ! don't allow constraints if either endpoint separation is too large DJW
2357:          DF=SQRT((LXYZ(3*NATOMS+3*(J2-1)+1)-LXYZ(3*NATOMS+3*(J3-1)+1))**2 &2520:          DF=SQRT((LXYZ(3*NATOMS+3*(J2-1)+1)-LXYZ(3*NATOMS+3*(J3-1)+1))**2 &
2358:   &             +(LXYZ(3*NATOMS+3*(J2-1)+2)-LXYZ(3*NATOMS+3*(J3-1)+2))**2 &2521:   &             +(LXYZ(3*NATOMS+3*(J2-1)+2)-LXYZ(3*NATOMS+3*(J3-1)+2))**2 &
2359:   &             +(LXYZ(3*NATOMS+3*(J2-1)+3)-LXYZ(3*NATOMS+3*(J3-1)+3))**2) 2522:   &             +(LXYZ(3*NATOMS+3*(J2-1)+3)-LXYZ(3*NATOMS+3*(J3-1)+3))**2) 
2360:          IF (DF.GT.INTCONCUT) CYCLE ! don't allow constraints if either endpoint separation is too large DJW2523:          IF (DF.GT.5.0D0) CYCLE ! don't allow constraints if either endpoint separation is too large DJW
 2524: !        IF (DF.GT.15.0D0) CYCLE ! don't allow constraints if either endpoint separation is too large DJW
2361: !        IF (2.0D0*ABS(DS-DF)/(DS+DF).LT.LINTCONSTRAINTTOL) THEN2525: !        IF (2.0D0*ABS(DS-DF)/(DS+DF).LT.LINTCONSTRAINTTOL) THEN
2362:          WRITE(*,'(A,2I6,2G20.10)') 'intlbfgs> J2,J3,DS,DF=', J2,J3,DS,DF 
2363:          IF (ABS(DS-DF).LT.LINTCONSTRAINTTOL) THEN2526:          IF (ABS(DS-DF).LT.LINTCONSTRAINTTOL) THEN
2364: !2527: !
2365: !  Add constraint for this distance to the list.2528: !  Add constraint for this distance to the list.
2366: !2529: !
2367:             NCONSTRAINT=NCONSTRAINT+12530:             NCONSTRAINT=NCONSTRAINT+1
2368: !           WRITE(*,'(A,2I6,A,I6)') 'intlbfgs> Adding constraint for atoms ',J2,J3,'  total=',NCONSTRAINT2531: !           PRINT '(A,2I6,A,I6)','checkperc> Adding constraint for atoms ',J2,J3,'  total=',NCONSTRAINT
 2532:          IF ((J3.EQ.701).AND.(J2.EQ.700)) PRINT '(A,2I6,A,I6)','checkperc> Adding constraint for atoms ', &
 2533:   &                                                        J2,J3,'  total=',NCONSTRAINT
2369:             IF (NCONSTRAINT.GT.INTCONMAX) CALL CONDOUBLE2534:             IF (NCONSTRAINT.GT.INTCONMAX) CALL CONDOUBLE
2370:             CONI(NCONSTRAINT)=J22535:             CONI(NCONSTRAINT)=J2
2371:             CONJ(NCONSTRAINT)=J32536:             CONJ(NCONSTRAINT)=J3
2372:             CONDISTREF(NCONSTRAINT)=(DF+DS)/2.0D02537:             CONDISTREF(NCONSTRAINT)=(DF+DS)/2.0D0
2373:             CONCUT(NCONSTRAINT)=ABS(DF-DS)/2.0D02538:             CONCUT(NCONSTRAINT)=ABS(DF-DS)/2.0D0
2374:             IF (CONDISTREF(NCONSTRAINT).GT.MAXCONDIST) MAXCONDIST=CONDISTREF(NCONSTRAINT)2539:             IF (CONDISTREF(NCONSTRAINT).GT.MAXCONDIST) MAXCONDIST=CONDISTREF(NCONSTRAINT)
2375:             IF (CONDISTREF(NCONSTRAINT).LT.MINCONDIST) MINCONDIST=CONDISTREF(NCONSTRAINT)2540:             IF (CONDISTREF(NCONSTRAINT).LT.MINCONDIST) MINCONDIST=CONDISTREF(NCONSTRAINT)
2376: !           IF (DEBUG) PRINT '(A,2I6,A,2F12.2,A,F12.4,A,I8)',' intlbfgs> constrain distance for ',CONI(NCONSTRAINT), &2541: !           IF (DEBUG) PRINT '(A,2I6,A,2F12.2,A,F12.4,A,I8)',' checkperc> constrain distance for atoms ',CONI(NCONSTRAINT), &
2377: ! &                 CONJ(NCONSTRAINT),' values are ',DS,DF,' fraction=',2*ABS(DS-DF)/(DS+DF), &2542: ! &                 CONJ(NCONSTRAINT),' values are ',DS,DF,' fraction=',2*ABS(DS-DF)/(DS+DF), &
2378: ! &                ' # constraints=',NCONSTRAINT2543: ! &                ' # constraints=',NCONSTRAINT
2379:          ENDIF2544:          ENDIF
2380:       ENDDO2545:       ENDDO
2381:    ENDDO2546:    ENDDO
2382:    IF (DEBUG) WRITE(*,'(A,I6,2(A,F15.5))') ' intlbfgs> Total distance constraints=',NCONSTRAINT, &2547:    IF (DEBUG) PRINT '(A,I6,2(A,F15.5))',' checkperc> Total distance constraints=',NCONSTRAINT, &
2383:   &                                     ' shortest=',MINCONDIST,' longest=',MAXCONDIST2548:   &                                     ' shortest=',MINCONDIST,' longest=',MAXCONDIST
2384: ELSE2549: ELSE
2385:    DO J2=1,NATOMS2550:    DO J2=1,NATOMS
2386:       DO J3=J2+1,NATOMS2551:       DO J3=J2+1,NATOMS
2387:          IF (J3-J2.GT.INTCONSEP) CYCLE ! forbid constraints corresponding to atoms distant in sequence2552:          IF (J3-J2.GT.INTCONSEP) CYCLE ! forbid constraints corresponding to atoms distant in sequence
2388:          DSMIN=1.0D1002553:          DSMIN=1.0D100
2389:          DSMAX=-1.0D1002554:          DSMAX=-1.0D100
2390:          DSMEAN=0.0D02555:          DSMEAN=0.0D0
 2556:          IF ((J3.EQ.701).AND.(J2.EQ.700)) PRINT '(A)','checkperc> doing atoms 700 and 701'
2391:          DO J4=1,NCONGEOM2557:          DO J4=1,NCONGEOM
2392:             DS=SQRT((CONGEOM(J4,3*(J2-1)+1)-CONGEOM(J4,3*(J3-1)+1))**2 &2558:             DS=SQRT((CONGEOM(J4,3*(J2-1)+1)-CONGEOM(J4,3*(J3-1)+1))**2 &
2393:   &                +(CONGEOM(J4,3*(J2-1)+2)-CONGEOM(J4,3*(J3-1)+2))**2 &2559:   &                +(CONGEOM(J4,3*(J2-1)+2)-CONGEOM(J4,3*(J3-1)+2))**2 &
2394:   &                +(CONGEOM(J4,3*(J2-1)+3)-CONGEOM(J4,3*(J3-1)+3))**2) 2560:   &                +(CONGEOM(J4,3*(J2-1)+3)-CONGEOM(J4,3*(J3-1)+3))**2) 
2395:             IF (DS.GT.DSMAX) DSMAX=DS2561:             IF (DS.GT.DSMAX) DSMAX=DS
2396:             IF (DS.LT.DSMIN) DSMIN=DS2562:             IF (DS.LT.DSMIN) DSMIN=DS
 2563:          IF ((J3.EQ.701).AND.(J2.EQ.700)) PRINT '(A,I6,6F20.10)','checkperc> J4,DS,DSMAX,DSMIN,abs,tol=', &
 2564:   &                      J4,DS,DSMIN,DSMAX,ABS(DSMIN-DSMAX),LINTCONSTRAINTTOL
2397:             IF ((J4.GT.1).AND.(ABS(DSMIN-DSMAX).GT.LINTCONSTRAINTTOL)) GOTO 753 ! unconstrained2565:             IF ((J4.GT.1).AND.(ABS(DSMIN-DSMAX).GT.LINTCONSTRAINTTOL)) GOTO 753 ! unconstrained
2398:             IF (DS.GT.INTCONCUT) GOTO 753 ! don't allow constraints if any image separation is too large DJW 
2399:             DSMEAN=DSMEAN+DS2566:             DSMEAN=DSMEAN+DS
2400:          ENDDO2567:          ENDDO
2401: !2568: !
2402: !  Add constraint for this distance to the list if we make it to here.2569: !  Add constraint for this distance to the list if we make it to here.
2403: !2570: !
2404:          NCONSTRAINT=NCONSTRAINT+12571:          NCONSTRAINT=NCONSTRAINT+1
2405:          WRITE(*,'(A,2I6,A,I6)') 'checkperc> Adding constraint for atoms ',J2,J3,'  total=',NCONSTRAINT2572: !        PRINT '(A,2I6,A,I6)','checkperc> Adding constraint for atoms ',J2,J3,'  total=',NCONSTRAINT
 2573:          IF ((J3.EQ.701).AND.(J2.EQ.700)) PRINT '(A,2I6,A,I6)','checkperc> Adding constraint for atoms ', &
 2574:   &                                                      J2,J3,'  total=',NCONSTRAINT
2406:          IF (NCONSTRAINT.GT.INTCONMAX) CALL CONDOUBLE2575:          IF (NCONSTRAINT.GT.INTCONMAX) CALL CONDOUBLE
2407:          CONI(NCONSTRAINT)=J22576:          CONI(NCONSTRAINT)=J2
2408:          CONJ(NCONSTRAINT)=J32577:          CONJ(NCONSTRAINT)=J3
2409:          CONDISTREF(NCONSTRAINT)=(DSMAX+DSMIN)/2.0D0 2578:          CONDISTREF(NCONSTRAINT)=(DSMAX+DSMIN)/2.0D0 
2410:          CONCUT(NCONSTRAINT)=(DSMAX-DSMIN)/2.0D02579:          CONCUT(NCONSTRAINT)=(DSMAX-DSMIN)/2.0D0
2411:          IF (CONDISTREF(NCONSTRAINT).GT.MAXCONDIST) MAXCONDIST=CONDISTREF(NCONSTRAINT)2580:          IF (CONDISTREF(NCONSTRAINT).GT.MAXCONDIST) MAXCONDIST=CONDISTREF(NCONSTRAINT)
2412:          IF (CONDISTREF(NCONSTRAINT).LT.MINCONDIST) MINCONDIST=CONDISTREF(NCONSTRAINT)2581:          IF (CONDISTREF(NCONSTRAINT).LT.MINCONDIST) MINCONDIST=CONDISTREF(NCONSTRAINT)
2413:          IF (DEBUG) WRITE(*,'(A,2I5,A,2F10.4,A,F12.4,A,I8)') &2582:          IF (DEBUG) PRINT '(A,2I5,A,2F10.4,A,F12.4,A,I8)', &
2414:   &                       ' checkperc> constrain atoms ',CONI(NCONSTRAINT), &2583:   &                       ' checkperc> constrain atoms ',CONI(NCONSTRAINT), &
2415:   &                       CONJ(NCONSTRAINT),' max, min ',DSMAX,DSMIN, &2584:   &                       CONJ(NCONSTRAINT),' max, min ',DSMAX,DSMIN, &
2416:   &                       ' cutoff=',CONCUT(NCONSTRAINT),' constraints=',NCONSTRAINT2585:   &                       ' cutoff=',CONCUT(NCONSTRAINT),' constraints=',NCONSTRAINT
2417: 753      CONTINUE2586: 753      CONTINUE
2418:       ENDDO2587:       ENDDO
2419:    ENDDO2588:    ENDDO
2420:    CONIFIX(1:NCONSTRAINT)=CONI(1:NCONSTRAINT)2589:    CONIFIX(1:NCONSTRAINT)=CONI(1:NCONSTRAINT)
2421:    CONJFIX(1:NCONSTRAINT)=CONJ(1:NCONSTRAINT)2590:    CONJFIX(1:NCONSTRAINT)=CONJ(1:NCONSTRAINT)
2422:    CONDISTREFFIX(1:NCONSTRAINT)=CONDISTREF(1:NCONSTRAINT)2591:    CONDISTREFFIX(1:NCONSTRAINT)=CONDISTREF(1:NCONSTRAINT)
2423:    CONCUTFIX(1:NCONSTRAINT)=CONCUT(1:NCONSTRAINT)2592:    CONCUTFIX(1:NCONSTRAINT)=CONCUT(1:NCONSTRAINT)
2424:    NCONSTRAINTFIX=NCONSTRAINT2593:    NCONSTRAINTFIX=NCONSTRAINT
2425: ENDIF2594: ENDIF
2426:  
2427: IF (QCIADDREP.GT.0) THEN 
2428:    DMIN=1.0D100 
2429:    DO J2=1,QCIBONDS 
2430: ! 
2431: ! end point 1 
2432: ! 
2433:       NI1=3*(CONI(J2)-1) 
2434:       NJ1=3*(CONJ(J2)-1) 
2435:       DO J3=J2+1,QCIBONDS 
2436:          IF (CONI(J3).EQ.CONI(J2)) CYCLE ! no extra terms for bonds with a common atom 
2437:          IF (CONI(J3).EQ.CONJ(J2)) CYCLE ! no extra terms for bonds with a common atom 
2438:          IF (CONJ(J3).EQ.CONI(J2)) CYCLE ! no extra terms for bonds with a common atom 
2439:          IF (CONJ(J3).EQ.CONJ(J2)) CYCLE ! no extra terms for bonds with a common atom 
2440: ! 
2441: ! end point 1 
2442: ! 
2443:          NI2=3*(CONI(J3)-1) 
2444:          NJ2=3*(CONJ(J3)-1) 
2445:          DO J4=1,QCIADDREP 
2446:             X1=(J4*LXYZ(NI1+1)+(QCIADDREP+1-J4)*LXYZ(NJ1+1))/(QCIADDREP+1.0D0) 
2447:             Y1=(J4*LXYZ(NI1+2)+(QCIADDREP+1-J4)*LXYZ(NJ1+2))/(QCIADDREP+1.0D0) 
2448:             Z1=(J4*LXYZ(NI1+3)+(QCIADDREP+1-J4)*LXYZ(NJ1+3))/(QCIADDREP+1.0D0) 
2449:             DO J5=1,QCIADDREP 
2450:                X2=(J5*LXYZ(NI2+1)+(QCIADDREP+1-J5)*LXYZ(NJ2+1))/(QCIADDREP+1.0D0) 
2451:                Y2=(J5*LXYZ(NI2+2)+(QCIADDREP+1-J5)*LXYZ(NJ2+2))/(QCIADDREP+1.0D0) 
2452:                Z2=(J5*LXYZ(NI2+3)+(QCIADDREP+1-J5)*LXYZ(NJ2+3))/(QCIADDREP+1.0D0) 
2453:                D2=SQRT((X1-X2)**2+(Y1-Y2)**2+(Z1-Z2)**2) 
2454:                IF (D2.LT.DMIN) DMIN=D2 
2455: !              WRITE(*,'(A,2I6,A,4I6,A,2I6,A,F20.10)') 'intlbfgs> start constraints ',J2,J3,' atoms ', & 
2456: ! &                                CONI(J2),CONJ(J2),CONI(J3),CONJ(J3),' J4,J5 ',J4,J5,' distance=',D2 
2457:            ENDDO 
2458:          ENDDO 
2459:       ENDDO 
2460: ! 
2461: ! end point 2 
2462: ! 
2463:       NI1=3*(CONI(J2)-1)+3*NATOMS 
2464:       NJ1=3*(CONJ(J2)-1)+3*NATOMS 
2465:       DO J3=J2+1,QCIBONDS 
2466:          IF (CONI(J3).EQ.CONI(J2)) CYCLE ! no extra terms for bonds with a common atom 
2467:          IF (CONI(J3).EQ.CONJ(J2)) CYCLE ! no extra terms for bonds with a common atom 
2468:          IF (CONJ(J3).EQ.CONI(J2)) CYCLE ! no extra terms for bonds with a common atom 
2469:          IF (CONJ(J3).EQ.CONJ(J2)) CYCLE ! no extra terms for bonds with a common atom 
2470: ! 
2471: ! end point 2 
2472: ! 
2473:      NI2=3*(CONI(J3)-1) 
2474:          NI2=3*(CONI(J3)-1)+3*NATOMS 
2475:          NJ2=3*(CONJ(J3)-1)+3*NATOMS 
2476:          DO J4=1,QCIADDREP 
2477:             X1=(J4*LXYZ(NI1+1)+(QCIADDREP+1-J4)*LXYZ(NJ1+1))/(QCIADDREP+1.0D0) 
2478:             Y1=(J4*LXYZ(NI1+2)+(QCIADDREP+1-J4)*LXYZ(NJ1+2))/(QCIADDREP+1.0D0) 
2479:             Z1=(J4*LXYZ(NI1+3)+(QCIADDREP+1-J4)*LXYZ(NJ1+3))/(QCIADDREP+1.0D0) 
2480:             DO J5=1,QCIADDREP 
2481:                X2=(J5*LXYZ(NI2+1)+(QCIADDREP+1-J5)*LXYZ(NJ2+1))/(QCIADDREP+1.0D0) 
2482:                Y2=(J5*LXYZ(NI2+2)+(QCIADDREP+1-J5)*LXYZ(NJ2+2))/(QCIADDREP+1.0D0) 
2483:                Z2=(J5*LXYZ(NI2+3)+(QCIADDREP+1-J5)*LXYZ(NJ2+3))/(QCIADDREP+1.0D0) 
2484:                D2=SQRT((X1-X2)**2+(Y1-Y2)**2+(Z1-Z2)**2) 
2485:                IF (D2.LT.DMIN) DMIN=D2 
2486: !              WRITE(*,'(A,2I6,A,4I6,A,2I6,A,F20.10)') 'intlbfgs> finish constraints ',J2,J3,' atoms ', & 
2487: ! &                                CONI(J2),CONJ(J2),CONI(J3),CONJ(J3),' J4,J5 ',J4,J5,' distance=',D2 
2488:            ENDDO 
2489:          ENDDO 
2490:       ENDDO 
2491:    ENDDO 
2492:    WRITE(*,'(A,F20.10,A,F20.10)') 'intlbfgs> minimum decoration distance=',DMIN,' compared with cutoff ',QCIADDREPCUT 
2493:    QCIADDREPCUT=MIN(DMIN-1.0D-3,QCIADDREPCUT) 
2494:    WRITE(*,'(A,F20.10)') 'intlbfgs> cutoff after setup is ',QCIADDREPCUT 
2495: ENDIF 
2496: !2595: !
2497: ! Check that we have a percolating constraint network. If not, increase the tolerance and try again!2596: ! Check that we have a percolating constraint network. If not, increase the tolerance and try again!
2498: ! Calculate minimum number of steps of each atom from number 1 or any frozen atom.2597: ! Calculate minimum number of steps of each atom from number 1 or any frozen atom.
2499: !2598: !
2500: NDIST1(1:NATOMS)=10000002599: NDIST1(1:NATOMS)=1000000
2501: IF (NQCIFREEZE.EQ.0) THEN2600: IF (NQCIFREEZE.EQ.0) THEN
2502:    NDIST1(1)=02601:    NDIST1(1)=0
2503: ELSE2602: ELSE
2504:    DO J1=1,NATOMS2603:    DO J1=1,NATOMS
2505:       IF (INTFROZEN(J1)) NDIST1(J1)=02604:       IF (INTFROZEN(J1)) NDIST1(J1)=0
2524:             CHANGED=.TRUE.2623:             CHANGED=.TRUE.
2525:             NDIST1(J1)=NDIST1(CONI(J2))+12624:             NDIST1(J1)=NDIST1(CONI(J2))+1
2526:          ENDIF2625:          ENDIF
2527:       ENDIF2626:       ENDIF
2528:    ENDDO2627:    ENDDO
2529:    IF ((NDIST1(J1).GT.DMAX1).AND.(NDIST1(J1).NE.1000000)) DMAX1=NDIST1(J1)2628:    IF ((NDIST1(J1).GT.DMAX1).AND.(NDIST1(J1).NE.1000000)) DMAX1=NDIST1(J1)
2530:    IF (NDIST1(J1).LT.DMIN1) DMIN1=NDIST1(J1)2629:    IF (NDIST1(J1).LT.DMIN1) DMIN1=NDIST1(J1)
2531:    IF (NDIST1(J1).EQ.1000000) NUNCON1=NUNCON1+12630:    IF (NDIST1(J1).EQ.1000000) NUNCON1=NUNCON1+1
2532: ENDDO2631: ENDDO
2533: IF (CHANGED) GOTO 52632: IF (CHANGED) GOTO 5
2534:   IF (DEBUG) WRITE(*,'(3(A,I8))') ' checkperc> steps to atom 1 converged in ',NCYCLE-1, &2633:   IF (DEBUG) PRINT '(3(A,I8))',' checkperc> steps to atom 1 converged in ',NCYCLE-1, &
2535:     &               ' cycles; maximum=',DMAX1,' disconnected=',NUNCON12634:     &               ' cycles; maximum=',DMAX1,' disconnected=',NUNCON1
2536: IF (NUNCON1.GT.0) THEN2635: IF (NUNCON1.GT.0) THEN
2537:    LINTCONSTRAINTTOL=LINTCONSTRAINTTOL*1.1D02636:    LINTCONSTRAINTTOL=LINTCONSTRAINTTOL*1.1D0
2538:    IF (DEBUG) WRITE(*,'(A,F15.5)') ' checkperc> increasing the local constraint tolerance parameter to ',LINTCONSTRAINTTOL2637:    IF (DEBUG) PRINT '(A,F15.5)',' checkperc> increasing the local constraint tolerance parameter to ',LINTCONSTRAINTTOL
2539:    IF (LINTCONSTRAINTTOL.GT.100.0D0) THEN2638:    IF (LINTCONSTRAINTTOL.GT.100.0D0) THEN
2540:       WRITE(*,'(A,G20.10)') 'checkperc> likely ERROR *** LINTCONSTRAINTTOL=',LINTCONSTRAINTTOL2639:       PRINT '(A,G20.10)','checkperc> likely ERROR *** LINTCONSTRAINTTOL=',LINTCONSTRAINTTOL
2541:       STOP2640:       STOP
2542:    ENDIF2641:    ENDIF
2543:    GOTO 512642:    GOTO 51
2544: ENDIF2643: ENDIF
2545: ! IF (DEBUG) WRITE(*,'(A,F15.5)') ' checkperc> Final constraint tolerance parameter ',LINTCONSTRAINTTOL2644: ! IF (DEBUG) PRINT '(A,F15.5)',' checkperc> Final constraint tolerance parameter ',LINTCONSTRAINTTOL
2546: 2645: 
2547: ! WRITE(*,'(A,I6,3(A,F15.5))') ' checkperc> Total distance constraints=',NCONSTRAINT, &2646: ! PRINT '(A,I6,3(A,F15.5))',' checkperc> Total distance constraints=',NCONSTRAINT, &
2548: !   &                    ' shortest=',MINCONDIST,' longest=',MAXCONDIST,' tolerance=',LINTCONSTRAINTTOL2647: !   &                    ' shortest=',MINCONDIST,' longest=',MAXCONDIST,' tolerance=',LINTCONSTRAINTTOL
2549: 2648: 
2550: CALLED=.TRUE.2649: CALLED=.TRUE.
2551: 2650: 
2552: END SUBROUTINE CHECKPERC2651: END SUBROUTINE CHECKPERC
2553: 2652: 
2554: SUBROUTINE MAKESTEP(NITERDONE,POINT,DIAG,INTIMAGE,SEARCHSTEP,G,GTMP,STP,GDIF,NPT,D,RHO1,ALPHA)2653: SUBROUTINE MAKESTEP(NITERDONE,POINT,DIAG,INTIMAGE,SEARCHSTEP,G,GTMP,STP,GDIF,NPT,D,RHO1,ALPHA)
2555: USE KEY, ONLY : MUPDATE, INTDGUESS2654: USE KEY, ONLY : INTMUPDATE, INTDGUESS
2556: USE COMMONS, ONLY: NATOMS2655: USE COMMONS, ONLY: NATOMS, NOPT
2557: IMPLICIT NONE2656: IMPLICIT NONE
2558: INTEGER NITERDONE, POINT, BOUND, NPT, D, CP, INTIMAGE, I2657: INTEGER NITERDONE, POINT, BOUND, NPT, D, CP, INTIMAGE, I
2559: DOUBLE PRECISION DIAG(3*NATOMS*INTIMAGE),SEARCHSTEP(0:MUPDATE,(3*NATOMS)*INTIMAGE),G((3*NATOMS)*INTIMAGE), &2658: DOUBLE PRECISION DIAG(3*NATOMS*INTIMAGE),SEARCHSTEP(0:INTMUPDATE,NOPT*INTIMAGE),G(NOPT*INTIMAGE), &
2560:   &  GTMP(3*NATOMS*INTIMAGE), GNORM, STP(3*NATOMS*INTIMAGE), YS, GDIF(0:MUPDATE,(3*NATOMS)*INTIMAGE), YY, &2659:   &  GTMP(3*NATOMS*INTIMAGE), GNORM, STP(3*NATOMS*INTIMAGE), YS, GDIF(0:INTMUPDATE,NOPT*INTIMAGE), YY, &
2561:   &  SQ, YR, BETA2660:   &  SQ, YR, BETA
2562: DOUBLE PRECISION, DIMENSION(MUPDATE)     :: RHO1,ALPHA2661: DOUBLE PRECISION, DIMENSION(INTMUPDATE)     :: RHO1,ALPHA
2563: LOGICAL CHANGEIMAGE 
2564: SAVE2662: SAVE
2565: 2663: 
2566: MAIN: IF (NITERDONE==1) THEN2664: MAIN: IF (NITERDONE==1) THEN
2567:      POINT = 02665:      POINT = 0
2568:      DIAG(1:D)=INTDGUESS2666:      DIAG(1:D)=INTDGUESS
2569:      SEARCHSTEP(0,1:D)= -G(1:D)*INTDGUESS            ! NR STEP FOR DIAGONAL INVERSE HESSIAN2667:      SEARCHSTEP(0,1:D)= -G(1:D)*INTDGUESS            ! NR STEP FOR DIAGONAL INVERSE HESSIAN
2570:      GTMP(1:D)        = SEARCHSTEP(0,1:D)2668:      GTMP(1:D)        = SEARCHSTEP(0,1:D)
2571:      GNORM            = MAX(SQRT(DOT_PRODUCT(G(1:D),G(1:D))),1.0D-100)2669:      GNORM            = MAX(SQRT(DOT_PRODUCT(G(1:D),G(1:D))),1.0D-100)
2572:      STP(1:D)         = MIN(1.0D0/GNORM, GNORM) ! MAKE THE FIRST GUESS FOR THE STEP LENGTH CAUTIOUS2670:      STP(1:D)         = MIN(1.0D0/GNORM, GNORM) ! MAKE THE FIRST GUESS FOR THE STEP LENGTH CAUTIOUS
2573: ELSE MAIN2671: ELSE MAIN
2574:      BOUND=NITERDONE-12672:      BOUND=NITERDONE-1
2575:      IF (NITERDONE.GT.MUPDATE) BOUND=MUPDATE2673:      IF (NITERDONE.GT.INTMUPDATE) BOUND=INTMUPDATE
2576:      YS=DOT_PRODUCT( GDIF(NPT/D,:), SEARCHSTEP(NPT/D,:)  )2674:      YS=DOT_PRODUCT( GDIF(NPT/D,:), SEARCHSTEP(NPT/D,:)  )
2577:      IF (YS==0.0D0) YS=1.0D02675:      IF (YS==0.0D0) YS=1.0D0
2578:     2676:     
2579: ! Update estimate of diagonal inverse Hessian elements.2677: ! Update estimate of diagonal inverse Hessian elements.
2580: ! We divide by both YS and YY at different points, so they had better not be zero!2678: ! We divide by both YS and YY at different points, so they had better not be zero!
2581: 2679: 
2582:      YY=DOT_PRODUCT( GDIF(NPT/D,:) , GDIF(NPT/D,:) )2680:      YY=DOT_PRODUCT( GDIF(NPT/D,:) , GDIF(NPT/D,:) )
2583:      IF (YY==0.0D0) YY=1.0D02681:      IF (YY==0.0D0) YY=1.0D0
2584: !    DIAG = ABS(YS/YY)2682: !    DIAG = ABS(YS/YY)
2585:      DIAG(1) = YS/YY2683:      DIAG(1) = YS/YY
2586:       2684:       
2587: ! COMPUTE -H*G USING THE FORMULA GIVEN IN: Nocedal, J. 1980, 2685: ! COMPUTE -H*G USING THE FORMULA GIVEN IN: Nocedal, J. 1980, 
2588: ! "Updating quasi-Newton matrices with limited storage",2686: ! "Updating quasi-Newton matrices with limited storage",
2589: ! Mathematics of Computation, Vol.35, No.151, pp. 773-7822687: ! Mathematics of Computation, Vol.35, No.151, pp. 773-782
2590: 2688: 
2591:      CP= POINT; IF (POINT==0) CP = MUPDATE2689:      CP= POINT; IF (POINT==0) CP = INTMUPDATE
2592:      RHO1(CP)=1.0D0/YS2690:      RHO1(CP)=1.0D0/YS
2593:      GTMP(1:D) = -G(1:D)2691:      GTMP(1:D) = -G(1:D)
2594:      CP= POINT 2692:      CP= POINT 
2595:                    2693:                    
2596:      DO I= 1,BOUND 2694:      DO I= 1,BOUND 
2597:           CP = CP - 1; IF (CP == -1) CP = MUPDATE - 12695:           CP = CP - 1; IF (CP == -1) CP = INTMUPDATE - 1
2598:           SQ= DOT_PRODUCT( SEARCHSTEP(CP,1:D),GTMP(1:D) )2696:           SQ= DOT_PRODUCT( SEARCHSTEP(CP,1:D),GTMP(1:D) )
2599:           ALPHA(CP+1) = RHO1(CP+1) * SQ2697:           ALPHA(CP+1) = RHO1(CP+1) * SQ
2600:           GTMP(1:D)        = -ALPHA(CP+1)*GDIF(CP,1:D) + GTMP(1:D)2698:           GTMP(1:D)        = -ALPHA(CP+1)*GDIF(CP,1:D) + GTMP(1:D)
2601:      ENDDO2699:      ENDDO
2602:               2700:               
2603:      GTMP(1:D)=DIAG(1)*GTMP(1:D)2701:      GTMP(1:D)=DIAG(1)*GTMP(1:D)
2604: 2702: 
2605:      DO I=1,BOUND2703:      DO I=1,BOUND
2606:           YR= DOT_PRODUCT( GDIF(CP,1:D) , GTMP )2704:           YR= DOT_PRODUCT( GDIF(CP,1:D) , GTMP )
2607:           BETA= RHO1(CP+1)*YR2705:           BETA= RHO1(CP+1)*YR
2608:           BETA= ALPHA(CP+1)-BETA2706:           BETA= ALPHA(CP+1)-BETA
2609: !         WRITE(*,'(A,I8,4G20.10)') 'makestep> I,YR,BETA,RHO1,ALPHA=',I,YR,BETA,RHO1(CP+1),ALPHA(CP+1)2707: !         WRITE(*,'(A,I8,4G20.10)') 'makestep> I,YR,BETA,RHO1,ALPHA=',I,YR,BETA,RHO1(CP+1),ALPHA(CP+1)
2610:           GTMP(1:D) = BETA*SEARCHSTEP(CP,1:D) + GTMP(1:D)2708:           GTMP(1:D) = BETA*SEARCHSTEP(CP,1:D) + GTMP(1:D)
2611:           CP=CP+12709:           CP=CP+1
2612: !         IF (CP==M) CP=02710: !         IF (CP==M) CP=0
2613:           IF (CP==MUPDATE) CP=02711:           IF (CP==INTMUPDATE) CP=0
2614:      ENDDO2712:      ENDDO
2615:               2713:               
2616:      STP(1:D) = 1.0D02714:      STP(1:D) = 1.0D0
2617: ENDIF MAIN2715: ENDIF MAIN
2618: 2716: 
2619: !  Store the new search direction2717: !  Store the new search direction
2620: IF (NITERDONE.GT.1) SEARCHSTEP(POINT,1:D)=GTMP(1:D)2718: IF (NITERDONE.GT.1) SEARCHSTEP(POINT,1:D)=GTMP(1:D)
2621: 2719: 
2622: END SUBROUTINE MAKESTEP2720: END SUBROUTINE MAKESTEP
 2721: 
 2722: 
 2723: SUBROUTINE MAKEINTNEBIMAGES(NIMAGE,INTIMAGE,DINCREMENT,QCIDIST1,QCIDIST4,XYZ)
 2724: USE COMMONS, ONLY: NATOMS, NOPT, DEBUG
 2725: USE KEY, ONLY : INTNEBIMAGES
 2726: IMPLICIT NONE
 2727: INTEGER NDONE, J2, NIMAGE, INTIMAGE, J5
 2728: DOUBLE PRECISION LDTOTAL, LDIST, LDUMMY, DINCREMENT, QCIDIST1, QCIDIST4, XYZ(NOPT*(INTIMAGE+2))
 2729: 
 2730: ALLOCATE(INTNEBIMAGES(NIMAGE*NOPT))
 2731: !
 2732: ! Initialise DNEB images at QCIDIST1+1*(QCIDIST4-QCIDIST1)/(NIMAGE+1),
 2733: !                           QCIDIST1+2*(QCIDIST4-QCIDIST1)/(NIMAGE+1),
 2734: !                              .     .     .    .    .    .    .
 2735: !                           QCIDIST1+NIMAGE*(QCIDIST4-QCIDIST1)/(NIMAGE+1)
 2736: !
 2737: LDTOTAL=0.0D0
 2738: NDONE=1
 2739: imageloop1: DO J2=1,INTIMAGE+1
 2740:    LDUMMY=0.0D0
 2741:    DO J5=1,3*NATOMS
 2742:       LDUMMY=LDUMMY+( XYZ((J2-1)*3*NATOMS+J5) - XYZ(J2*3*NATOMS+J5) )**2
 2743:    ENDDO
 2744:    LDUMMY=SQRT(LDUMMY)
 2745:    LDIST=0.0D0
 2746:    DO WHILE (LDIST.LE.LDUMMY)
 2747:       LDIST=LDIST+DINCREMENT
 2748:       IF (LDIST+LDTOTAL.GE.QCIDIST1+NDONE*(QCIDIST4-QCIDIST1)/(NIMAGE+1)) THEN
 2749:          INTNEBIMAGES(NOPT*(NDONE-1)+1:NOPT*NDONE)=((LDUMMY-LDIST)*XYZ((J2-1)*3*NATOMS+1:J2*3*NATOMS)+ &
 2750:   &                                                          LDIST*XYZ(J2*3*NATOMS+1:(J2+1)*3*NATOMS))/LDUMMY
 2751:          IF (DEBUG) PRINT '(A,F20.10,A,I6)',' intlbfgs> image made for distance LDIST+LDTOTAL=',LDIST+LDTOTAL,' NDONE=',NDONE
 2752:          NDONE=NDONE+1
 2753:          IF (NDONE.GT.NIMAGE) EXIT imageloop1
 2754:       ENDIF
 2755:    ENDDO
 2756:    LDTOTAL=LDTOTAL+LDUMMY
 2757: ENDDO imageloop1
 2758: 
 2759: END SUBROUTINE MAKEINTNEBIMAGES
 2760: 
 2761: SUBROUTINE MAKEINTNEBIMAGES2(NIMAGE,INTIMAGE,DINCREMENT,QCIDIST1,QCIDIST4,XYZ)
 2762: USE COMMONS, ONLY: NATOMS, NOPT, DEBUG
 2763: USE KEY, ONLY : INTNEBIMAGES
 2764: IMPLICIT NONE
 2765: INTEGER NDONE, J2, NIMAGE, INTIMAGE, J5, LUNIT, GETUNIT
 2766: DOUBLE PRECISION LDTOTAL, LDIST, LDUMMY, DINCREMENT, QCIDIST1, QCIDIST4, XYZ(NOPT*(INTIMAGE+2))
 2767: DOUBLE PRECISION EREAL, VNEW(3*NATOMS), RMS
 2768: 
 2769: NIMAGE=2*INTIMAGE+1
 2770: ALLOCATE(INTNEBIMAGES(NIMAGE*NOPT))
 2771: !
 2772: ! Initialise DNEB images at all the interpolation images plus 
 2773: ! bisectors.
 2774: !
 2775: NDONE=1
 2776: imageloop1: DO J2=1,INTIMAGE
 2777:    INTNEBIMAGES(NOPT*(NDONE-1)+1:NOPT*NDONE)=(XYZ((J2-1)*3*NATOMS+1:J2*3*NATOMS) &
 2778:   &                                          +XYZ(J2*3*NATOMS+1:(J2+1)*3*NATOMS))/2.0D0
 2779:    NDONE=NDONE+1
 2780:    INTNEBIMAGES(NOPT*(NDONE-1)+1:NOPT*NDONE)=XYZ(J2*3*NATOMS+1:(J2+1)*3*NATOMS)
 2781:    NDONE=NDONE+1
 2782: ENDDO imageloop1
 2783: 
 2784: INTNEBIMAGES(NOPT*(NDONE-1)+1:NOPT*NDONE)=(XYZ(INTIMAGE*3*NATOMS+1:(INTIMAGE+1)*3*NATOMS) &
 2785:   &                                       +XYZ((INTIMAGE+1)*3*NATOMS+1:(INTIMAGE+2)*3*NATOMS))/2.0D0
 2786: 
 2787: CLOSE(LUNIT)
 2788: 
 2789: END SUBROUTINE MAKEINTNEBIMAGES2


r30629/key.f90 2016-07-06 15:35:33.999203536 +0100 r30628/key.f90 2016-07-06 15:35:40.059285478 +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, MLPSTART, MLPOUT, MLPHIDDEN, MLPDATA, NMLP, N_TO_ALIGN, DJWRBID, STM, NHEXAMERS, & 25:      &        MLPIN, MLPOUT, MLPHIDDEN, MLPDATA, NMLP, N_TO_ALIGN, DJWRBID, STM, NHEXAMERS
 26:      &        QCIADDREP, QCIBONDS, QCISECOND, MAXNACTIVE, QCIIMAGE 
 27:  26: 
 28:       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, &
 29:      &        PGRAD, VALUEST, ADMT, BFGSMINT, BFGSTST, CHECKINDEX, TOSI, CONTAINER, & 28:      &        PGRAD, VALUEST, ADMT, BFGSMINT, BFGSTST, CHECKINDEX, TOSI, CONTAINER, &
 30:      &        GAUSSIAN, CADPAC, PRESSURE, FTEST, DCHECK, CP2K, DFTP, CPMD, CPMDC, FREEZERES, DF1T, & 29:      &        GAUSSIAN, CADPAC, PRESSURE, FTEST, DCHECK, CP2K, DFTP, CPMD, CPMDC, FREEZERES, DF1T, &
 31:      &        VARIABLES, FIELDT, OHT, IHT, TDT, D5HT, TWOENDS, PV, FRACTIONAL, BLNT, HYBRIDMINT, & 30:      &        VARIABLES, FIELDT, OHT, IHT, TDT, D5HT, TWOENDS, PV, FRACTIONAL, BLNT, HYBRIDMINT, &
 32:      &        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, &
 33:      &        BFGSSTEP, BULKT, HUPDATE, NOHESS, READV, NOIT, THOMSONT, SIO2T, SIO2C6T, BISECTT, BISECTDEBUG, & 32:      &        BFGSSTEP, BULKT, HUPDATE, NOHESS, READV, NOIT, THOMSONT, SIO2T, SIO2C6T, BISECTT, BISECTDEBUG, &
 34:      &        TOSIC6, TOSIPOL, FIXIMAGE, DFTBT, CHECKCONT, CHECKDT, SHIFTED, READSP, DUMPSP, NOFRQS, & 33:      &        TOSIC6, TOSIPOL, FIXIMAGE, DFTBT, CHECKCONT, CHECKDT, SHIFTED, READSP, DUMPSP, NOFRQS, &
 35:      &        ALLSTEPS, ALLVECTORS, MWVECTORS, WELCH, BINARY, READHESS, MOVIE, NORESET, TWOD, & 34:      &        ALLSTEPS, ALLVECTORS, MWVECTORS, WELCH, BINARY, READHESS, MOVIE, NORESET, TWOD, &
 36:      &        DOUBLET, REOPT, PARALLEL, LINEMIN, FIXD, KEEPINDEX, BSMIN, PRINTPTS, RKMIN, REPELTST,& 35:      &        DOUBLET, REOPT, PARALLEL, LINEMIN, FIXD, KEEPINDEX, BSMIN, PRINTPTS, RKMIN, REPELTST,&
 46:      &        QSPCFWT, QTIP4PFT, CFUSIONT, DUMPINTXYZ, DUMPINTEOS, INTLJT, INTTST, EYTRAPT, OHCELLT, MKTRAPT, & 45:      &        QSPCFWT, QTIP4PFT, CFUSIONT, DUMPINTXYZ, DUMPINTEOS, INTLJT, INTTST, EYTRAPT, OHCELLT, MKTRAPT, &
 47:      &        INTFREEZET, LPERMDIST, CHECKNEGATIVET, CHECKOVERLAPT, ACK1, ACK2, CONDATT, USERPOTT, & 46:      &        INTFREEZET, LPERMDIST, CHECKNEGATIVET, CHECKOVERLAPT, ACK1, ACK2, CONDATT, USERPOTT, &
 48:      &        CONCUTFRACT, CONCUTABST, ENDNUMHESS2, CHARMMDFTBT, PAIRCOLOURT, REVERSEUPHILLT, WHOLEDNEB, & 47:      &        CONCUTFRACT, CONCUTABST, ENDNUMHESS2, CHARMMDFTBT, PAIRCOLOURT, REVERSEUPHILLT, WHOLEDNEB, &
 49:      &        NONEBMAX, READMASST, ONEDAPBCT, ONEDPBCT, INVTONEDPBCT, INVTTWODPBCT, TWODAPBCT, TWODPBCT, THREEDAPBCT, & 48:      &        NONEBMAX, READMASST, ONEDAPBCT, ONEDPBCT, INVTONEDPBCT, INVTTWODPBCT, TWODAPBCT, TWODPBCT, THREEDAPBCT, &
 50:      &        THREEDPBCT, FOURDAPBCT, FOURDPBCT, MODEDOWNT, CHEMSHIFT, TTM3T, & 49:      &        THREEDPBCT, FOURDAPBCT, FOURDPBCT, MODEDOWNT, CHEMSHIFT, TTM3T, &
 51:      &        NOINVERSION, INVERTPT, KNOWVECS, PMPATHT, AAORIENTT, MULTIJOBT, QUIPARGSTRT, QUIPPARAMST, HESSDUMPT, & 50:      &        NOINVERSION, INVERTPT, KNOWVECS, PMPATHT, AAORIENTT, MULTIJOBT, QUIPARGSTRT, QUIPPARAMST, HESSDUMPT, &
 52:      &        CLASSICALRATEST, TSPLITTINGT, HESSREADT, INSTANTONOPTT,INSTANTONSTARTDUMPT,VARSTEPOPTT, MOLPRO, REAXFFT, & 51:      &        CLASSICALRATEST, TSPLITTINGT, HESSREADT, INSTANTONOPTT,INSTANTONSTARTDUMPT,VARSTEPOPTT, MOLPRO, REAXFFT, &
 53:      &        EIGENONLY,OVERCONV, GLJT,CLSTRINGT,CLSTRINGTST, PHI4MODT, EX1DT, MCPATHT, MCBIAST, RPHT, TWISTT, MCPATH2T, & 52:      &        EIGENONLY,OVERCONV, GLJT,CLSTRINGT,CLSTRINGTST, PHI4MODT, EX1DT, MCPATHT, MCBIAST, RPHT, TWISTT, MCPATH2T, &
 54:      &        PBST, SSHT, GAUSSIAN03, CPPNEBT, CUDAT, CUDATIMET, TRUSTMODET,MODELOST, METRICTENSOR, INTSPRINGACTIVET, & 53:      &        PBST, SSHT, GAUSSIAN03, CPPNEBT, CUDAT, CUDATIMET, TRUSTMODET,MODELOST, METRICTENSOR, INTSPRINGACTIVET, &
 55:      &        PERMGUESS, QCIPERMCHECK, DUMPFRQST, MULTIPOTT, MLP3T, MLPB3T, DUMPBESTPATH, ALIGNRBST, AVOID_COLLISIONS, MLPPROB, & 54:      &        PERMGUESS, QCIPERMCHECK, DUMPFRQST, MULTIPOTT, MLP3T, MLPB3T, DUMPBESTPATH, ALIGNRBST, AVOID_COLLISIONS, MLPPROB, &
 56:      &        MALONALDEHYDE, MLPNEWREG, DJWRBT, STEALTHYT, STEALTV, LJADDT, MLPB3NEWT, & 55:      &        MALONALDEHYDE, MLPNEWREG, DJWRBT, STEALTHYT, STEALTV, LJADDT, SLERPT
 57:      &        QCIPOTT, QCIPOT2T, QCIRADSHIFTT, QCINOREPINT, QCIAMBERT, SLERPT 
 58:  56: 
 59: ! bf269 > polymer in a pore (non-bonding (LJ) energy from neighbours is not subtracted) 57: ! bf269 > polymer in a pore (non-bonding (LJ) energy from neighbours is not subtracted)
 60:       LOGICAL :: PORE8T = .FALSE. ! add 8th power cylindrical pore to the potential? 58:       LOGICAL :: PORE8T = .FALSE. ! add 8th power cylindrical pore to the potential?
 61:       INTEGER :: PORE8_AXIS = 3 ! principal axis of the cylindric pore (1:x, 2:y, 3:z) 59:       INTEGER :: PORE8_AXIS = 3 ! principal axis of the cylindric pore (1:x, 2:y, 3:z)
 62:       DOUBLE PRECISION :: PORE8_ENERGY = 1.0d1 ! energy of the pore when radius = 1 60:       DOUBLE PRECISION :: PORE8_ENERGY = 1.0d1 ! energy of the pore when radius = 1
 63:       LOGICAL :: HARMPOLYT = .FALSE. ! add harmonic bonds between the beads 61:       LOGICAL :: HARMPOLYT = .FALSE. ! add harmonic bonds between the beads
 64:       DOUBLE PRECISION :: HARMPOLY_BONLEN = 0.0d0 ! equilibrium length of springs between beads 62:       DOUBLE PRECISION :: HARMPOLY_BONLEN = 0.0d0 ! equilibrium length of springs between beads
 65:       DOUBLE PRECISION :: HARMPOLY_K = 1.0d2 ! force constant of the springs 63:       DOUBLE PRECISION :: HARMPOLY_K = 1.0d2 ! force constant of the springs
 66:  64: 
 67: ! hk286 > generalised THOMSON problem 65: ! hk286 > generalised THOMSON problem
 93:      &        BISECTMAXENERGY, BISECTMINDIST, BLFACTOR, NEBRESEEDEMAX, NEBRESEEDBMAX, NEBRESEEDDEL1, & 91:      &        BISECTMAXENERGY, BISECTMINDIST, BLFACTOR, NEBRESEEDEMAX, NEBRESEEDBMAX, NEBRESEEDDEL1, &
 94:      &        NEBRESEEDDEL2, INTCONSTRAINTTOL, INTCONSTRAINTDEL, RBCUTOFF, INTCONSTRAINTREP, INTCONSTRAINREPCUT, & 92:      &        NEBRESEEDDEL2, INTCONSTRAINTTOL, INTCONSTRAINTDEL, RBCUTOFF, INTCONSTRAINTREP, INTCONSTRAINREPCUT, &
 95:      &        REDOK, REDOFRAC, D1INIT, D2INIT, REDOE1, REDOE2, RPBETA, REPCON, PFORCE, & 93:      &        REDOK, REDOFRAC, D1INIT, D2INIT, REDOE1, REDOE2, RPBETA, REPCON, PFORCE, &
 96:      &        CPCONSTRAINTTOL, CPCONSTRAINTDEL, CPCONSTRAINTREP, CPCONSTRAINREPCUT, CPCONFRAC, & 94:      &        CPCONSTRAINTTOL, CPCONSTRAINTDEL, CPCONSTRAINTREP, CPCONSTRAINREPCUT, CPCONFRAC, &
 97:      &        INTLJTOL, INTLJDEL, INTLJEPS, IMSEPMIN, IMSEPMAX, TRAPK, MINOVERLAP, & 95:      &        INTLJTOL, INTLJDEL, INTLJEPS, IMSEPMIN, IMSEPMAX, TRAPK, MINOVERLAP, &
 98:      &        INTFREEZETOL, LOCALPERMCUT, LOCALPERMCUT2, LOCALPERMCUTINC, CHECKREPCUTOFF, CONCUTABS, & 96:      &        INTFREEZETOL, LOCALPERMCUT, LOCALPERMCUT2, LOCALPERMCUTINC, CHECKREPCUTOFF, CONCUTABS, &
 99:      &        CONCUTFRAC, ENDNUMHESSDELTA, DNEBEFRAC, QCHEMSCALE, KAA, SIGMAAA, QUIPATOMMASS, TEMPERATURE1, & 97:      &        CONCUTFRAC, ENDNUMHESSDELTA, DNEBEFRAC, QCHEMSCALE, KAA, SIGMAAA, QUIPATOMMASS, TEMPERATURE1, &
100:      &        DISTORTINST,DELTAINST,MOLPROSCALE,COVER,STTSRMSCONV,LAN_DIST,LANCONV,LANFACTOR, & 98:      &        DISTORTINST,DELTAINST,MOLPROSCALE,COVER,STTSRMSCONV,LAN_DIST,LANCONV,LANFACTOR, &
101:      &        STOCKEXP, JPARAM, MCPATHTEMP, MCPATHDMAX, MCPATHSTEP, MCPATHACCRATIO, BIASFAC, & 99:      &        STOCKEXP, JPARAM, MCPATHTEMP, MCPATHDMAX, MCPATHSTEP, MCPATHACCRATIO, BIASFAC, &
102:      &        MCADDDEV, MCPATHQMIN, MCPATHQMAX, RPHQMIN, RPHQMAX, RPHTEMP, TWISTF, TWISTREF, MCPATHADDREF, &100:      &        MCADDDEV, MCPATHQMIN, MCPATHQMAX, RPHQMIN, RPHQMAX, RPHTEMP, TWISTF, TWISTREF, MCPATHADDREF, &
103:      &        MCPATHGWS, MCPATHGWQ, MCPATHNEGLECT, MCPATHTOL, FRAMESDIFF,TMRATIO, INTMINFAC, MLPLAMBDA, COLL_TOL, KLIM, SCA, &101:      &        MCPATHGWS, MCPATHGWQ, MCPATHNEGLECT, MCPATHTOL, FRAMESDIFF,TMRATIO, INTMINFAC, MLPLAMBDA, COLL_TOL, KLIM, SCA
104:      &        QCIADDREPCUT, QCIADDREPEPS, QCIRADSHIFT, INTCONCUT 
105: 102: 
106: !     sf344103: !     sf344
107:       DOUBLE PRECISION :: PCUTOFF,PYA11(3),PYA21(3),PYA12(3),PYA22(3),PEPSILON1(3),PSCALEFAC1(2),PSCALEFAC2(2), &104:       DOUBLE PRECISION :: PCUTOFF,PYA11(3),PYA21(3),PYA12(3),PYA22(3),PEPSILON1(3),PSCALEFAC1(2),PSCALEFAC2(2), &
108:      &                     PEPSILONATTR(2),PSIGMAATTR(2), PYOVERLAPTHRESH, LJSITECOORDS(3), LJGSITESIGMA, LJGSITEEPS, &105:      &                     PEPSILONATTR(2),PSIGMAATTR(2), PYOVERLAPTHRESH, LJSITECOORDS(3), LJGSITESIGMA, LJGSITEEPS, &
109:      &                     PYLOCALSTEP(2)106:      &                     PYLOCALSTEP(2)
110:  107:  
111:       DOUBLE PRECISION, ALLOCATABLE :: POINTSDECA(:), POINTSICOS(:)108:       DOUBLE PRECISION, ALLOCATABLE :: POINTSDECA(:), POINTSICOS(:)
112:       DOUBLE PRECISION, ALLOCATABLE :: VT(:), pya1bin(:,:),pya2bin(:,:)109:       DOUBLE PRECISION, ALLOCATABLE :: VT(:), pya1bin(:,:),pya2bin(:,:)
113:       LOGICAL          :: LJSITE,BLJSITE,LJSITEATTR,PYBINARYT,PARAMONOVPBCX,PARAMONOVPBCY,PARAMONOVPBCZ,PARAMONOVCUTOFF110:       LOGICAL          :: LJSITE,BLJSITE,LJSITEATTR,PYBINARYT,PARAMONOVPBCX,PARAMONOVPBCY,PARAMONOVPBCZ,PARAMONOVCUTOFF
114:       LOGICAL          :: PYGPERIODICT,ELLIPSOIDT,LJSITECOORDST,REALIGNXYZ,MULTISITEPYT,LJGSITET,NORMALMODET111:       LOGICAL          :: PYGPERIODICT,ELLIPSOIDT,LJSITECOORDST,REALIGNXYZ,MULTISITEPYT,LJGSITET,NORMALMODET
297:       CHARACTER(LEN=1) :: CUDAPOT294:       CHARACTER(LEN=1) :: CUDAPOT
298: 295: 
299:       !ds656> Mie field(s) for modelling substrate effects296:       !ds656> Mie field(s) for modelling substrate effects
300:       LOGICAL :: MIEFT, MIEF_CUTT, MIEF_PBCT297:       LOGICAL :: MIEFT, MIEF_CUTT, MIEF_PBCT
301:       CHARACTER(LEN=130) :: MIEF_FILENAME298:       CHARACTER(LEN=130) :: MIEF_FILENAME
302:       INTEGER :: MIEF_NSITES,MIEF_N,MIEF_M299:       INTEGER :: MIEF_NSITES,MIEF_N,MIEF_M
303:       DOUBLE PRECISION :: MIEF_BOX(3), MIEF_RCUT300:       DOUBLE PRECISION :: MIEF_BOX(3), MIEF_RCUT
304:       DOUBLE PRECISION, ALLOCATABLE :: MIEF_EPS(:), MIEF_SIG(:), &301:       DOUBLE PRECISION, ALLOCATABLE :: MIEF_EPS(:), MIEF_SIG(:), &
305:            MIEF_SITES(:,:), MIEF_U_RCUT(:), MIEF_DUDR_RCUT(:)302:            MIEF_SITES(:,:), MIEF_U_RCUT(:), MIEF_DUDR_RCUT(:)
306:       303:       
307:       DOUBLE PRECISION, ALLOCATABLE ::  QCIXYZ(:) 
308: ! AMBER 12 variables304: ! AMBER 12 variables
309:       LOGICAL :: AMBER12T305:       LOGICAL :: AMBER12T
310:       LOGICAL :: CHIRALENDPOINTS306:       LOGICAL :: CHIRALENDPOINTS
311:       LOGICAL :: CLIMBERT,CLIMBERINIT307:       LOGICAL :: CLIMBERT,CLIMBERINIT
312:       INTEGER :: CLIMBERSTEPS308:       INTEGER :: CLIMBERSTEPS
313:       DOUBLE PRECISION :: CLIMBERCONV,CLIMBERSPRING309:       DOUBLE PRECISION :: CLIMBERCONV,CLIMBERSPRING
314:       INTEGER, DIMENSION(:,:), ALLOCATABLE :: BONDS310:       INTEGER, DIMENSION(:,:), ALLOCATABLE :: BONDS
315: 311: 
316:       DOUBLE PRECISION, ALLOCATABLE ::  MLPDAT(:,:)312:       DOUBLE PRECISION, ALLOCATABLE ::  MLPDAT(:,:)
317:       INTEGER, ALLOCATABLE ::  MLPOUTCOME(:)313:       INTEGER, ALLOCATABLE ::  MLPOUTCOME(:)


r30629/keywords.f 2016-07-06 15:35:34.367208514 +0100 r30628/keywords.f 2016-07-06 15:35:40.411290236 +0100
419:          PERTDIHET=.FALSE.419:          PERTDIHET=.FALSE.
420:          CHPMAX=0.5d0420:          CHPMAX=0.5d0
421:          CHPMIN=0.25d0421:          CHPMIN=0.25d0
422:          CHNMAX=1.0d0422:          CHNMAX=1.0d0
423:          CHNMIN=0.d0423:          CHNMIN=0.d0
424:          CHARMMDFTBT=.FALSE.424:          CHARMMDFTBT=.FALSE.
425:          CHARMMNOTUPDATE=.FALSE.425:          CHARMMNOTUPDATE=.FALSE.
426:          ISEED=0426:          ISEED=0
427:          TOMEGAC=.FALSE.427:          TOMEGAC=.FALSE.
428:          TSIDECHAIN=.FALSE.428:          TSIDECHAIN=.FALSE.
 429:          INTMINT=.FALSE.
429:          IMINCUT=0.0D0430:          IMINCUT=0.0D0
430:          GUESSTST=.False.431:          GUESSTST=.False.
431:          CALCDIHE=.False.432:          CALCDIHE=.False.
432:          TRYNEB=.FALSE.433:          TRYNEB=.FALSE.
433:          NOCISTRANS=.FALSE.434:          NOCISTRANS=.FALSE.
434:          CISTRANS=.FALSE.435:          CISTRANS=.FALSE.
435:          CHECKOMEGAT=.FALSE.436:          CHECKOMEGAT=.FALSE.
436:          MINOMEGA=150.D0437:          MINOMEGA=150.D0
437:          CHECKCHIRALT=.FALSE.438:          CHECKCHIRALT=.FALSE.
438:          TURNOFFCHECKCHIRALITY=.FALSE.439:          TURNOFFCHECKCHIRALITY=.FALSE.
565: 566: 
566:          ! EFK: growing strings and freezing nodes567:          ! EFK: growing strings and freezing nodes
567:          GROWSTRINGT = .FALSE.568:          GROWSTRINGT = .FALSE.
568:          NOLBFGS = .FALSE.569:          NOLBFGS = .FALSE.
569:          HESSGRAD = .FALSE.570:          HESSGRAD = .FALSE.
570:          ARCTOL = 1.0D-4571:          ARCTOL = 1.0D-4
571:          DQAGKEY = 6572:          DQAGKEY = 6
572:          DESMDEBUG = .FALSE.573:          DESMDEBUG = .FALSE.
573:          GSMAXTOTITD = -1574:          GSMAXTOTITD = -1
574:          MAXGROWSTEPS = 1.0D3575:          MAXGROWSTEPS = 1.0D3
575:          EVOLVESTRINGT=.FALSE.576:          EVOLVESTRINGT = .FALSE.
576:          FREEZENODEST=.FALSE.577:          FREEZENODEST = .FALSE.
577:          FIXATMS = .FALSE.578:          FIXATMS = .FALSE.
578:          PREROTATE = .FALSE.579:          PREROTATE = .FALSE.
579:          CUBSPLT = .FALSE.580:          CUBSPLT = .FALSE.
580:          MAXLENPERIM = 100.0D0581:          MAXLENPERIM = 100.0D0
581:          GSTANTYPE = 1582:          GSTANTYPE = 1
582:          REPARAMTOL = 0.75583:          REPARAMTOL = 0.75
583:          GSGROWTOL = 0.25584:          GSGROWTOL = 0.25
584:          GSCONV = 1.0D-3585:          GSCONV = 1.0D-3
585:          GSMXSTP = 0.1586:          GSMXSTP = 0.1
586:          STOCKT=.FALSE.587:          STOCKT=.FALSE.
609:          NEBRESEEDPOW2=10610:          NEBRESEEDPOW2=10
610:          ADDREPT=.FALSE.611:          ADDREPT=.FALSE.
611: 612: 
612:          INTLJT=.FALSE.613:          INTLJT=.FALSE.
613:          INTLJSTEPS=1000614:          INTLJSTEPS=1000
614:          INTLJTOL=1.0D-3615:          INTLJTOL=1.0D-3
615:          INTLJDEL=0.1D0616:          INTLJDEL=0.1D0
616:          INTLJEPS=1.0D0617:          INTLJEPS=1.0D0
617: 618: 
618:          FREEZETOL=1.0D-3619:          FREEZETOL=1.0D-3
619: ! 
620: ! QCI parameters 
621: ! 
622:          CONDATT=.FALSE. 
623:          QCIPOTT=.FALSE. 
624:          QCIPOT2T=.FALSE. 
625:          QCIADDREP=0 
626:          QCIADDREPCUT=1.0D0 
627:          QCIADDREPEPS=1.0D0 
628:          QCINOREPINT=.FALSE. 
629:          MAXNACTIVE=0 
630:          FREEZETOL=1.0D-3 
631:          QCIPERMCHECK=.FALSE.620:          QCIPERMCHECK=.FALSE.
632:          QCIPERMCHECKINT=100621:          QCIPERMCHECKINT=100
633:          INTCONSTRAINTT=.FALSE.622:          INTCONSTRAINTT=.FALSE.
634:          INTCONSTRAINTTOL=0.1D0623:          INTCONSTRAINTTOL=0.1D0
635:          INTCONSTRAINTDEL=10.0D0624:          INTCONSTRAINTDEL=10.0D0
636:          INTCONSTRAINTREP=100.0D0625:          INTCONSTRAINTREP=100.0D0
637:          INTCONSTRAINREPCUT=1.7D0626:          INTCONSTRAINREPCUT=1.7D0
638:          INTFREEZET=.FALSE.627:          INTFREEZET=.FALSE.
639:          INTFREEZETOL=1.0D-3628:          INTFREEZETOL=1.0D-3
640:          INTFREEZEMIN=10629:          INTFREEZEMIN=10
641:          INTCONFRAC=0.9D0630:          INTCONFRAC=0.9D0
642:          INTCONSEP=15631:          INTCONSEP=15
643:          INTREPSEP=0632:          INTREPSEP=0
644:          INTSTEPS1=300001633:          INTSTEPS1=300001
645:          INTCONSTEPS=100634:          INTCONSTEPS=100
646:          INTRELSTEPS=200635:          INTRELSTEPS=200
647:          MAXCONUSE=4636:          MAXCONUSE=4
648:          MAXCONE=0.01D0637:          MAXCONE=0.01D0
649:          INTRMSTOL=0.01D0638:          INTRMSTOL=0.01D0
 639:          IMSEPMIN=0.2D0
 640:          IMSEPMAX=10.0D0
650:          INTIMAGE=3641:          INTIMAGE=3
651:          MAXINTIMAGE=75642:          MAXINTIMAGE=75
652:          INTNTRIESMAX=2643:          INTNTRIESMAX=2
653:          INTIMAGEINCR=6644:          INTIMAGEINCR=6
654:          INTIMAGECHECK=25645:          INTIMAGECHECK=25
655:          IMSEPMIN=0.0D0646:          IMSEPMIN=0.0D0
656:          IMSEPMAX=HUGE(1.0D0)647:          IMSEPMAX=HUGE(1.0D0)
657: 648: 
658:          CHECKCONINT=.FALSE.649:          CHECKCONINT=.FALSE.
659:          CONCUTABS=0.15D0650:          CONCUTABS=0.15D0
660:          CONCUTABST=.TRUE.651:          CONCUTABST=.TRUE.
661:          CONCUTFRAC=0.1D0652:          CONCUTFRAC=0.1D0
662:          CONCUTFRACT=.FALSE.653:          CONCUTFRACT=.FALSE.
663:          CHECKREPINTERVAL=10654:          CHECKREPINTERVAL=10
664:          CHECKREPCUTOFF=2.0655:          CHECKREPCUTOFF=2.0
665:          DUMPINTXYZ=.FALSE.656:          DUMPINTXYZ=.FALSE.
666:          DUMPINTEOS=.FALSE.657:          DUMPINTEOS=.FALSE.
667:          DUMPINTXYZFREQ=100658:          DUMPINTXYZFREQ=100
668:          DUMPINTEOSFREQ=100659:          DUMPINTEOSFREQ=100
669:          KINT=0.0D0660:          KINT=0.0D0
670:          QCIAMBERT=.FALSE. 
671:          INTMINT=.FALSE. 
672:          INTSPRINGACTIVET=.TRUE. 
673:          INTMINFAC=1.0D0 
674:          QCIRADSHIFTT=.FALSE. 
675:          QCIRADSHIFT=1.0D0 
676: 661: 
677:          CONPOTT=.FALSE.662:          CONPOTT=.FALSE.
678:          CPCONSTRAINTTOL=0.1D0663:          CPCONSTRAINTTOL=0.1D0
679:          CPCONSTRAINTDEL=1.0D5664:          CPCONSTRAINTDEL=1.0D5
680:          CPCONSTRAINTREP=1.0D0665:          CPCONSTRAINTREP=1.0D0
681:          CPCONSTRAINREPCUT=20.0D0666:          CPCONSTRAINREPCUT=20.0D0
682:          CPCONFRAC=1.0D-4667:          CPCONFRAC=1.0D-4
683:          CPREPSEP=0668:          CPREPSEP=0
684:          CPCONSEP=10000669:          CPCONSEP=10000
685:          CHECKOVERLAPT=.FALSE.670:          CHECKOVERLAPT=.FALSE.
925: ! Stealthy potential910: ! Stealthy potential
926: !911: !
927:          STEALTHYT=.FALSE.912:          STEALTHYT=.FALSE.
928:          STEALTV=.FALSE.913:          STEALTV=.FALSE.
929: 914: 
930: !915: !
931: ! Neural network potential916: ! Neural network potential
932: !917: !
933:          MLP3T=.FALSE.918:          MLP3T=.FALSE.
934:          MLPB3T=.FALSE.919:          MLPB3T=.FALSE.
935:          MLPB3NEWT=.FALSE. 
936:          MLPNEWREG=.FALSE.920:          MLPNEWREG=.FALSE.
937:          MLPPROB=.FALSE.921:          MLPPROB=.FALSE.
938:          MLPDONE=.FALSE.922:          MLPDONE=.FALSE.
939:          MLPNORM=.FALSE.923:          MLPNORM=.FALSE.
940:          MLPLAMBDA=0.0D0924:          MLPLAMBDA=0.0D0
941:          MLPDATSTART=1925:          MLPDATSTART=1
942: 926: 
943:          MALONALDEHYDE=.FALSE.927:          MALONALDEHYDE=.FALSE.
944: 928: 
945:          CLSTRINGT=.FALSE.929:          CLSTRINGT=.FALSE.
2021: ! input to OPTIM). The alignment is done via rigid-body movements and by considering2005: ! input to OPTIM). The alignment is done via rigid-body movements and by considering
2022: ! permutational isomerizations. The aligned `finish' coordinates are dumped and the2006: ! permutational isomerizations. The aligned `finish' coordinates are dumped and the
2023: ! minimized distance is printed.2007: ! minimized distance is printed.
2024: ! 2008: ! 
2025:          ELSE IF (WORD.EQ.'CLOSESTALIGNMENT') THEN2009:          ELSE IF (WORD.EQ.'CLOSESTALIGNMENT') THEN
2026:             CLOSESTALIGNMENT=.TRUE.2010:             CLOSESTALIGNMENT=.TRUE.
2027:             WRITE(*,*) 'Putting structures into closest alignment, then stopping'2011:             WRITE(*,*) 'Putting structures into closest alignment, then stopping'
2028: ! 2012: ! 
2029: ! Check for internal minimum in constraint terms for INTCONSTRAINT2013: ! Check for internal minimum in constraint terms for INTCONSTRAINT
2030: ! 2014: ! 
2031:          ELSE IF ((WORD.EQ.'CONINT').OR.(WORD.EQ.'QCIINT')) THEN2015:          ELSE IF (WORD.EQ.'CONINT') THEN
2032:             CHECKCONINT=.TRUE.2016:             CHECKCONINT=.TRUE.
2033:             IF (NITEMS.GT.1) CALL READF(INTMINFAC)2017:             IF (NITEMS.GT.1) CALL READF(INTMINFAC)
2034:             WRITE(*,'(A,G20.10)') ' keyword> Internal minima terms will be scaled by a factor of ',INTMINFAC 
2035: ! 
2036: ! Maximum active atoms in QCI procedure. 
2037: ! 
2038:       ELSE IF (WORD.EQ.'QCIMAXACTIVE') THEN 
2039:          CALL READI(MAXNACTIVE) 
2040: ! 2018: ! 
2041: ! Absolute distance to allow before turning on constraint potential.2019: ! Absolute distance to allow before turning on constraint potential.
2042: ! 2020: ! 
2043:          ELSE IF (WORD.EQ.'CONCUTABS') THEN2021:          ELSE IF (WORD.EQ.'CONCUTABS') THEN
2044:             CONCUTABST=.TRUE.2022:             CONCUTABST=.TRUE.
2045:             CONCUTFRACT=.FALSE.2023:             CONCUTFRACT=.FALSE.
2046:             IF (NITEMS.GT.1) CALL READF(CONCUTABS)2024:             IF (NITEMS.GT.1) CALL READF(CONCUTABS)
2047: ! 2025: ! 
2048: ! Fraction of constraint distance to allow before turning on constraint potential.2026: ! Fraction of constraint distance to allow before turning on constraint potential.
2049: ! 2027: ! 
3285:             FIELDT=.TRUE.3263:             FIELDT=.TRUE.
3286:             IHT=.TRUE.3264:             IHT=.TRUE.
3287:             CALL READF(FIH)3265:             CALL READF(FIH)
3288: ! 3266: ! 
3289: ! Search for a saddle of index INDEX if3267: ! Search for a saddle of index INDEX if
3290: ! SEARCH 2 is specified. See also KEEPINDEX. Also works with BFGSTS3268: ! SEARCH 2 is specified. See also KEEPINDEX. Also works with BFGSTS
3291: ! up to a maximum of index 50, but NOIT must be set and a Hessian is needed.3269: ! up to a maximum of index 50, but NOIT must be set and a Hessian is needed.
3292: ! 3270: ! 
3293:          ELSE IF (WORD.EQ.'INDEX') THEN3271:          ELSE IF (WORD.EQ.'INDEX') THEN
3294:             CALL READI(HINDEX)3272:             CALL READI(HINDEX)
3295: ! 
3296: ! Radial shift to make space for new atoms. 
3297: ! 
3298:          ELSE IF (WORD.EQ.'QCIRADSHIFT') THEN 
3299:             QCIRADSHIFTT=.TRUE. 
3300:             IF (NITEMS.GT.1) CALL READF(QCIRADSHIFT) 
3301:             WRITE(*,'(A,G20.10)') ' keyword> Shifting unconstrained atoms away from added atoms by ',QCIRADSHIFT 
3302:          ELSE IF (WORD.EQ.'QCIPERMCHECK') THEN3273:          ELSE IF (WORD.EQ.'QCIPERMCHECK') THEN
3303:             QCIPERMCHECK=.TRUE.3274:             QCIPERMCHECK=.TRUE.
3304:             CALL READI(QCIPERMCHECKINT)3275:             CALL READI(QCIPERMCHECKINT)
3305: ! 3276: ! 
3306: ! Images for INTCONSTRAINT3277: ! Images for INTCONSTRAINT
3307: ! 3278: ! 
3308:          ELSE IF ((WORD.EQ.'INTIMAGE').OR.(WORD.EQ.'QCIIMAGE')) THEN3279:          ELSE IF (WORD.EQ.'INTIMAGE') THEN
3309:             IF (NITEMS.GT.1) CALL READF(IMSEPMIN)3280:     &n