hdiff output

r33426/intlbfgs.f90 2017-10-30 11:30:14.958252959 +0000 r33425/intlbfgs.f90 2017-10-30 11:30:16.074267644 +0000
 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)
 19: USE PORFUNCS 19: USE PORFUNCS
 20: USE KEY, ONLY : FREEZENODEST, FREEZETOL, MAXBFGS, CONVR, ATOMSTORES, & 20: USE KEY, ONLY : FREEZENODEST, FREEZETOL, MAXBFGS, CONVR, ATOMSTORES, &
 21:      & INTRMSTOL, INTIMAGE, NREPMAX, NREPULSIVE, INTMUPDATE, INTDGUESS, & 21:      & INTRMSTOL, INTIMAGE, NREPMAX, NREPULSIVE, INTMUPDATE, INTDGUESS, &
 22:      & NCONSTRAINT, CONI, CONJ, CONDISTREF, INTCONMAX, CONOFFLIST, & 22:      & NCONSTRAINT, CONI, CONJ, CONDISTREF, INTCONMAX, &
 23:      & INTCONSTRAINREPCUT, REPCON, INTCONSTRAINTREP, INTREPSEP, NREPI, NREPJ, & 23:      & INTCONSTRAINREPCUT, REPCON, INTCONSTRAINTREP, INTREPSEP, NREPI, NREPJ, &
 24:      & CONDISTREFLOCAL, INTCONFRAC, CONACTIVE, REPI, & 24:      & CONDISTREFLOCAL, INTCONFRAC, CONACTIVE, REPI, &
 25:      & REPJ, NREPMAX, ATOMACTIVE, NCONSTRAINTON, CONION, CONJON, CONDISTREFLOCALON, CONDISTREFON, & 25:      & REPJ, NREPMAX, ATOMACTIVE, NCONSTRAINTON, CONION, CONJON, CONDISTREFLOCALON, CONDISTREFON, &
 26:      & NREPCUT, REPCUT, CHECKCONINT, INTCONSTEPS, INTRELSTEPS, MAXCONE, COLDFUSIONLIMIT, & 26:      & NREPCUT, REPCUT, CHECKCONINT, INTCONSTEPS, INTRELSTEPS, MAXCONE, COLDFUSIONLIMIT, &
 27:      & INTSTEPS1, DUMPINTXYZ, DUMPINTXYZFREQ, DUMPINTEOS, DUMPINTEOSFREQ, & 27:      & INTSTEPS1, DUMPINTXYZ, DUMPINTXYZFREQ, DUMPINTEOS, DUMPINTEOSFREQ, &
 28:      & IMSEPMIN, IMSEPMAX, MAXINTIMAGE, INTFREEZET, INTFREEZETOL, FREEZE, & 28:      & IMSEPMIN, IMSEPMAX, MAXINTIMAGE, INTFREEZET, INTFREEZETOL, FREEZE, &
 29:      & INTFROZEN, CHECKREPINTERVAL, NNREPULSIVE, INTFREEZEMIN, INTIMAGECHECK, & 29:      & INTFROZEN, CHECKREPINTERVAL, NNREPULSIVE, INTFREEZEMIN, INTIMAGECHECK, &
 30:      & CONCUT, CONCUTLOCAL, KINT, REPIFIX, REPJFIX, NREPULSIVEFIX, & 30:      & CONCUT, CONCUTLOCAL, KINT, REPIFIX, REPJFIX, NREPULSIVEFIX, &
 31:      & NCONSTRAINTFIX, CONIFIX, CONJFIX, QCIPERMCHECK, QCIPERMCHECKINT, BULKT, TWOD, RIGIDBODY, & 31:      & NCONSTRAINTFIX, CONIFIX, CONJFIX, QCIPERMCHECK, QCIPERMCHECKINT, BULKT, TWOD, RIGIDBODY, &
 32:      & QCIADDREP, QCIXYZ, WHOLEDNEB, QCIIMAGE, FROZEN, QCIRESTART, NPERMGROUP, NPERMSIZE, PERMGROUP, NSETS, SETS, & 32:      & QCIADDREP, QCIXYZ, WHOLEDNEB, QCIIMAGE, FROZEN, QCIRESTART, NPERMGROUP, NPERMSIZE, PERMGROUP, NSETS, SETS, &
 37: USE CHIRALITY 37: USE CHIRALITY
 38:  38: 
 39: IMPLICIT NONE  39: IMPLICIT NONE 
 40:  40: 
 41: DOUBLE PRECISION, INTENT(IN) :: QSTART(3*NATOMS), QFINISH(3*NATOMS)  ! The two end points 41: DOUBLE PRECISION, INTENT(IN) :: QSTART(3*NATOMS), QFINISH(3*NATOMS)  ! The two end points
 42: INTEGER D, U 42: INTEGER D, U
 43: DOUBLE PRECISION DIST, DIST2, RMAT(3,3), SUMEEE, SUMEEE2, SIGMAEEE, NEIGHBOUR_COORDS(12), CENTRE_COORDS(3) 43: DOUBLE PRECISION DIST, DIST2, RMAT(3,3), SUMEEE, SUMEEE2, SIGMAEEE, NEIGHBOUR_COORDS(12), CENTRE_COORDS(3)
 44: DOUBLE PRECISION DMAX, DF, DMIN, LOCALSTEP, ADMAX, DUMMYX, DUMMYY, DUMMYZ 44: DOUBLE PRECISION DMAX, DF, DMIN, LOCALSTEP, ADMAX, DUMMYX, DUMMYY, DUMMYZ
 45: INTEGER NDECREASE, NFAIL, NMAXINT, NMININT, JMAX, JMIN, INTIMAGESAVE, NOFF, J1, J2, NQDONE, JA1, JA2, NMOVE, NMOVES, NMOVEF, NCONOFF 45: INTEGER NDECREASE, NFAIL, NMAXINT, NMININT, JMAX, JMIN, INTIMAGESAVE, NOFF, J1, J2, NQDONE, JA1, JA2, NMOVE, NMOVES, NMOVEF, NCONOFF
 46: INTEGER PERM(NATOMS), PERMS(NATOMS), PERMF(NATOMS), STARTGROUP(NPERMGROUP), ENDGROUP(NPERMGROUP) 46: INTEGER PERM(NATOMS), PERMS(NATOMS), PERMF(NATOMS), STARTGROUP(NPERMGROUP), ENDGROUP(NPERMGROUP)
  47: INTEGER CONOFFLIST(NCONSTRAINT)
 47: LOGICAL KNOWE, KNOWG, KNOWH, ADDATOM, ADDREP(NATOMS), LDEBUG, REMOVEIMAGE, PERMUTABLE(NATOMS), IDENTITY 48: LOGICAL KNOWE, KNOWG, KNOWH, ADDATOM, ADDREP(NATOMS), LDEBUG, REMOVEIMAGE, PERMUTABLE(NATOMS), IDENTITY
 48: COMMON /KNOWN/ KNOWE, KNOWG, KNOWH 49: COMMON /KNOWN/ KNOWE, KNOWG, KNOWH
 49:  50: 
 50: DOUBLE PRECISION DUMMY, DPRAND, DUMMY2, ADUMMY 51: DOUBLE PRECISION DUMMY, DPRAND, DUMMY2, ADUMMY
 51: DOUBLE PRECISION BOXLX,BOXLY,BOXLZ,DISTANCE,RMATBEST(3,3),DISTANCES,DISTANCEF 52: DOUBLE PRECISION BOXLX,BOXLY,BOXLZ,DISTANCE,RMATBEST(3,3),DISTANCES,DISTANCEF
 52: INTEGER POINT,NPT,J3,J4,NIMAGEFREEZE,NACTIVE,NBEST,NEWATOM,NBEST2 53: INTEGER POINT,NPT,J3,J4,NIMAGEFREEZE,NACTIVE,NBEST,NEWATOM,NBEST2
 53: INTEGER TURNONORDER(NATOMS),NBACKTRACK,NQCIFREEZE, NBONDED(NATOMS), BONDEDLIST(NATOMS,6), NBOND 54: INTEGER TURNONORDER(NATOMS),NBACKTRACK,NQCIFREEZE, NBONDED(NATOMS), BONDEDLIST(NATOMS,6), NBOND
 54: INTEGER NDUMMY, NLASTGOODE, NSTEPSMAX, INGROUP(NATOMS), ACID 55: INTEGER NDUMMY, NLASTGOODE, NSTEPSMAX, INGROUP(NATOMS), ACID
 55: LOGICAL CHIRALSR, CHIRALSRP  56: LOGICAL CHIRALSR, CHIRALSRP 
 56: INTEGER NTRIES(NATOMS), NITERDONE, EXITSTATUS, DLIST(NATOMS) 57: INTEGER NTRIES(NATOMS), NITERDONE, EXITSTATUS, DLIST(NATOMS)
 80: INTEGER LUNIT, GETUNIT 81: INTEGER LUNIT, GETUNIT
 81: CHARACTER(LEN=2) SDUMMY 82: CHARACTER(LEN=2) SDUMMY
 82: INTEGER JMAXEEE,JMAXRMS 83: INTEGER JMAXEEE,JMAXRMS
 83: DOUBLE PRECISION MAXEEE,MAXRMS,MINEEE,SAVELOCALPERMCUT 84: DOUBLE PRECISION MAXEEE,MAXRMS,MINEEE,SAVELOCALPERMCUT
 84:  85: 
 85: WHOLEDNEB=.FALSE. 86: WHOLEDNEB=.FALSE.
 86: READIMAGET=.FALSE. 87: READIMAGET=.FALSE.
 87: REMOVEIMAGE=.FALSE. 88: REMOVEIMAGE=.FALSE.
 88:  89: 
 89: NCONOFF=0 90: NCONOFF=0
  91: CONOFFLIST(1:NCONSTRAINT)=-1
 90: AABACK(1:NATOMS)=.FALSE. 92: AABACK(1:NATOMS)=.FALSE.
 91: BACKDONE=.FALSE. 93: BACKDONE=.FALSE.
 92: IF (DOBACK) THEN 94: IF (DOBACK) THEN
 93:    LUNIT=GETUNIT() 95:    LUNIT=GETUNIT()
 94:    OPEN(UNIT=LUNIT,FILE='aabk',STATUS='OLD') 96:    OPEN(UNIT=LUNIT,FILE='aabk',STATUS='OLD')
 95:    DO J1=1,NATOMS 97:    DO J1=1,NATOMS
 96:       READ(LUNIT,*,END=861) NDUMMY 98:       READ(LUNIT,*,END=861) NDUMMY
 97:       AABACK(NDUMMY)=.TRUE. 99:       AABACK(NDUMMY)=.TRUE.
 98:    ENDDO100:    ENDDO
 99: 861   CLOSE(LUNIT)101: 861   CLOSE(LUNIT)
181: ENDIF183: ENDIF
182: IF (INTSTEPS1 < 0) THEN184: IF (INTSTEPS1 < 0) THEN
183:    WRITE(*,'(1x,a)') 'Maximal number of iterations is less than zero! Stop.'185:    WRITE(*,'(1x,a)') 'Maximal number of iterations is less than zero! Stop.'
184:    STOP186:    STOP
185: ENDIF187: ENDIF
186: !188: !
187: ! XYZ, GGG, EEE include the end point images189: ! XYZ, GGG, EEE include the end point images
188: ! X, G do not.190: ! X, G do not.
189: !191: !
190: IF (.NOT.ALLOCATED(CONI)) THEN 192: IF (.NOT.ALLOCATED(CONI)) THEN 
191:    ALLOCATE(CONI(INTCONMAX),CONJ(INTCONMAX),CONDISTREF(INTCONMAX),CONCUT(INTCONMAX),CONOFFLIST(INTCONMAX))193:    ALLOCATE(CONI(INTCONMAX),CONJ(INTCONMAX),CONDISTREF(INTCONMAX),CONCUT(INTCONMAX))
192:    ALLOCATE(REPI(NREPMAX),REPJ(NREPMAX),NREPI(NREPMAX),NREPJ(NREPMAX),REPCUT(NREPMAX),NREPCUT(NREPMAX))194:    ALLOCATE(REPI(NREPMAX),REPJ(NREPMAX),NREPI(NREPMAX),NREPJ(NREPMAX),REPCUT(NREPMAX),NREPCUT(NREPMAX))
193: ENDIF195: ENDIF
194: X=>XYZ((3*NATOMS)+1:(3*NATOMS)*(INTIMAGE+1))196: X=>XYZ((3*NATOMS)+1:(3*NATOMS)*(INTIMAGE+1))
195: G=>GGG((3*NATOMS)+1:(3*NATOMS)*(INTIMAGE+1))197: G=>GGG((3*NATOMS)+1:(3*NATOMS)*(INTIMAGE+1))
196: !198: !
197: ! Initialise XYZ199: ! Initialise XYZ
198: !200: !
199: IF (READIMAGET) THEN  ! Note that this will ignore the coordinates in start and finish201: IF (READIMAGET) THEN  ! Note that this will ignore the coordinates in start and finish
200:    LUNIT=GETUNIT()202:    LUNIT=GETUNIT()
201:    OPEN(UNIT=LUNIT,FILE='int.xyz',STATUS='OLD')203:    OPEN(UNIT=LUNIT,FILE='int.xyz',STATUS='OLD')
585: ! ELSE587: ! ELSE
586:    ! CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)588:    ! CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
587: ENDIF589: ENDIF
588: EOLD=ETOTAL590: EOLD=ETOTAL
589: GLAST(1:D)=G(1:D)591: GLAST(1:D)=G(1:D)
590: XSAVE(1:D)=X(1:D)592: XSAVE(1:D)=X(1:D)
591: 593: 
592: IF (ETOTAL/INTIMAGE.LT.COLDFUSIONLIMIT) THEN594: IF (ETOTAL/INTIMAGE.LT.COLDFUSIONLIMIT) THEN
593:    WRITE(*,'(A,2G20.10)') ' intlbfgs> Cold fusion diagnosed - step discarded, energy, limit=', &595:    WRITE(*,'(A,2G20.10)') ' intlbfgs> Cold fusion diagnosed - step discarded, energy, limit=', &
594:   &                       ETOTAL/INTIMAGE,COLDFUSIONLIMIT596:   &                       ETOTAL/INTIMAGE,COLDFUSIONLIMIT
595:    DEALLOCATE(CONI,CONJ,CONDISTREF,REPI,REPJ,NREPI,NREPJ,REPCUT,NREPCUT,CONCUT,CONOFFLIST)597:    DEALLOCATE(CONI,CONJ,CONDISTREF,REPI,REPJ,NREPI,NREPJ,REPCUT,NREPCUT,CONCUT)
596:    DEALLOCATE(TRUEEE, EEETMP, MYGTMP, GTMP, &598:    DEALLOCATE(TRUEEE, EEETMP, MYGTMP, GTMP, &
597:   &      DIAG, STP, SEARCHSTEP, GDIF,GLAST, XSAVE, XYZ, GGG, CHECKG, IMGFREEZE, EEE, STEPIMAGE)599:   &      DIAG, STP, SEARCHSTEP, GDIF,GLAST, XSAVE, XYZ, GGG, CHECKG, IMGFREEZE, EEE, STEPIMAGE)
598:    INTIMAGE=INTIMAGESAVE600:    INTIMAGE=INTIMAGESAVE
599:    RETURN601:    RETURN
600: ENDIF602: ENDIF
601: 603: 
602: ! IF (DEBUG) WRITE(*,'(A6,A20,A20,A9,A9)') 'Iter','Energy per image','RMS Force','Step'604: ! IF (DEBUG) WRITE(*,'(A6,A20,A20,A9,A9)') 'Iter','Energy per image','RMS Force','Step'
603: 605: 
604: !606: !
605: ! In this block PERMGROUP(NDUMMY+J2-1) counts through the atom indices specified in perm.allow,607: ! In this block PERMGROUP(NDUMMY+J2-1) counts through the atom indices specified in perm.allow,
625: 627: 
626: DO ! Main do loop with counter NITERDONE, initially set to one628: DO ! Main do loop with counter NITERDONE, initially set to one
627: 629: 
628: !630: !
629: ! Are we stuck? If so, try resetting problem atoms to previous image.631: ! Are we stuck? If so, try resetting problem atoms to previous image.
630: !632: !
631: IF (QCIRESET) THEN633: IF (QCIRESET) THEN
632: !  IF ((SWITCHED.AND.(MOD(NITERDONE-1,QCIRESETINT2).EQ.0)).OR.((.NOT.SWITCHED).AND.(MOD(NITERDONE-1,QCIRESETINT1).EQ.0))) THEN634: !  IF ((SWITCHED.AND.(MOD(NITERDONE-1,QCIRESETINT2).EQ.0)).OR.((.NOT.SWITCHED).AND.(MOD(NITERDONE-1,QCIRESETINT1).EQ.0))) THEN
633:    PRINT *,'intlbfgs> NITERDONE,NLASTGOODE,QCIRESETINT1=',NITERDONE,NLASTGOODE,QCIRESETINT1635:    PRINT *,'intlbfgs> NITERDONE,NLASTGOODE,QCIRESETINT1=',NITERDONE,NLASTGOODE,QCIRESETINT1
634:    IF ((.NOT.SWITCHED).AND.(NITERDONE-NLASTGOODE.GT.QCIRESETINT1)) THEN636:    IF ((.NOT.SWITCHED).AND.(NITERDONE-NLASTGOODE.GT.QCIRESETINT1)) THEN
635:       CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF)637:       CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF,CONOFFLIST)
636:       CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)638:       CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)
637:       WRITE(*,'(A,I6)') 'intlbfgs> Interpolation seems to be stuck. Turn off worst constraint ',JMAXCON639:       WRITE(*,'(A,I6)') 'intlbfgs> Interpolation seems to be stuck. Turn off worst constraint ',JMAXCON
638:       IF ((JMAXCON.LT.1).OR.(JMAXCON.GT.NCONSTRAINT)) THEN640:       IF ((JMAXCON.LT.1).OR.(JMAXCON.GT.NCONSTRAINT)) THEN
639:          WRITE(*,'(A)') 'intlbfgs> *** ERROR *** constraint index out of allowed range'641:          WRITE(*,'(A)') 'intlbfgs> *** ERROR *** constraint index out of allowed range'
640:          STOP642:          STOP
641:       ENDIF643:       ENDIF
642:       NCONOFF=NCONOFF+1644:       NCONOFF=NCONOFF+1
643:       CONOFFLIST(NCONOFF)=JMAXCON645:       CONOFFLIST(NCONOFF)=JMAXCON
644:       CONACTIVE(JMAXCON)=.FALSE.646:       CONACTIVE(JMAXCON)=.FALSE.
645:       NLASTGOODE=NITERDONE647:       NLASTGOODE=NITERDONE
816: !                   ELSE818: !                   ELSE
817: !                      WRITE(*,'(A,I6,A,I6)') ' intlbfgs> inconsistent non-identity permutations for start and finish'819: !                      WRITE(*,'(A,I6,A,I6)') ' intlbfgs> inconsistent non-identity permutations for start and finish'
818: !                   ENDIF820: !                   ENDIF
819: !                ENDIF821: !                ENDIF
820: !             ENDDO822: !             ENDDO
821: !             XYZ(3*NATOMS*J3+1:3*NATOMS*(J3+1))=COORDSA(1:3*NATOMS)823: !             XYZ(3*NATOMS*J3+1:3*NATOMS*(J3+1))=COORDSA(1:3*NATOMS)
822: !          ENDIF824: !          ENDIF
823: !       ENDDO np825: !       ENDDO np
824: !    ENDDO826: !    ENDDO
825: !    LOCALPERMCUT=SAVELOCALPERMCUT827: !    LOCALPERMCUT=SAVELOCALPERMCUT
826: !    CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF)828: !    CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF,CONOFFLIST)
827: ! !  STOP829: ! !  STOP
828: 830: 
829: ENDIF831: ENDIF
830: 832: 
831: !833: !
832: !  Add next atom to active set if ADDATOM is true. 834: !  Add next atom to active set if ADDATOM is true. 
833: !  Constraints to atoms already in the active set are turned on835: !  Constraints to atoms already in the active set are turned on
834: !  and short-range repulsions to active atoms that are not distance constrained are turned on.836: !  and short-range repulsions to active atoms that are not distance constrained are turned on.
835: !  *** OLD Find nearest atom to active set attached by a constraint837: !  *** OLD Find nearest atom to active set attached by a constraint
836: !  *** NEW Find atom with most constraints to active set838: !  *** NEW Find atom with most constraints to active set
1332:       RMS=SQRT(RMS/((3*NATOMS)*INTIMAGE))1334:       RMS=SQRT(RMS/((3*NATOMS)*INTIMAGE))
1333:       EEE(1:INTIMAGE+2)=USEFRAC*EEETMP(1:INTIMAGE+2)+(1.0D0-USEFRAC)*EEE(1:INTIMAGE+2)1335:       EEE(1:INTIMAGE+2)=USEFRAC*EEETMP(1:INTIMAGE+2)+(1.0D0-USEFRAC)*EEE(1:INTIMAGE+2)
1334:       WORST=-1.0D1001336:       WORST=-1.0D100
1335:       DO J4=2,INTIMAGE+11337:       DO J4=2,INTIMAGE+1
1336:          IF (EEE(J4).GT.WORST) WORST=EEE(J4)1338:          IF (EEE(J4).GT.WORST) WORST=EEE(J4)
1337:       ENDDO1339:       ENDDO
1338:       IF (DEBUG) WRITE(*,'(A,G20.10,A,I8)') 'intlbfgs> Highest QCI image energy=',WORST,' images=',INTIMAGE1340:       IF (DEBUG) WRITE(*,'(A,G20.10,A,I8)') 'intlbfgs> Highest QCI image energy=',WORST,' images=',INTIMAGE
1339:    ENDIF1341:    ENDIF
1340:    IF (ETOTAL/INTIMAGE.LT.COLDFUSIONLIMIT) THEN1342:    IF (ETOTAL/INTIMAGE.LT.COLDFUSIONLIMIT) THEN
1341:       WRITE(*,'(A,2G20.10)') ' intlbfgs> Cold fusion diagnosed - step discarded, energy, limit=',ETOTAL/INTIMAGE,COLDFUSIONLIMIT1343:       WRITE(*,'(A,2G20.10)') ' intlbfgs> Cold fusion diagnosed - step discarded, energy, limit=',ETOTAL/INTIMAGE,COLDFUSIONLIMIT
1342:       DEALLOCATE(CONI,CONJ,CONDISTREF,REPI,REPJ,NREPI,NREPJ,REPCUT,NREPCUT,CONCUT,CONOFFLIST)1344:       DEALLOCATE(CONI,CONJ,CONDISTREF,REPI,REPJ,NREPI,NREPJ,REPCUT,NREPCUT,CONCUT)
1343:       DEALLOCATE(TRUEEE, EEETMP, MYGTMP, GTMP, &1345:       DEALLOCATE(TRUEEE, EEETMP, MYGTMP, GTMP, &
1344:   &              DIAG, STP, SEARCHSTEP, GDIF,GLAST, XSAVE, XYZ, GGG, CHECKG, IMGFREEZE, EEE, STEPIMAGE)1346:   &              DIAG, STP, SEARCHSTEP, GDIF,GLAST, XSAVE, XYZ, GGG, CHECKG, IMGFREEZE, EEE, STEPIMAGE)
1345:       QCIIMAGE=INTIMAGE1347:       QCIIMAGE=INTIMAGE
1346:       INTIMAGE=INTIMAGESAVE1348:       INTIMAGE=INTIMAGESAVE
1347:       RETURN1349:       RETURN
1348:    ENDIF1350:    ENDIF
1349: 1351: 
1350:    STEPTOT = SUM(STEPIMAGE)/INTIMAGE1352:    STEPTOT = SUM(STEPIMAGE)/INTIMAGE
1351: 1353: 
1352:    MAXRMS=-1.0D01354:    MAXRMS=-1.0D0
1515: !        IF (ETOTAL/INTIMAGE.GT.MAXCONE*MAX(0.1D0,NACTIVE*1.0D0/(NATOMS*1.0D0))) GOTO 7771517: !        IF (ETOTAL/INTIMAGE.GT.MAXCONE*MAX(0.1D0,NACTIVE*1.0D0/(NATOMS*1.0D0))) GOTO 777
1516:          PRINT '(A,3G20.10)','MAXEEE,MAXCONE,scaled=',MAXEEE,MAXCONE,MAXCONE*MAX(0.2D0,NACTIVE*1.0D0/(NATOMS*1.0D0))1518:          PRINT '(A,3G20.10)','MAXEEE,MAXCONE,scaled=',MAXEEE,MAXCONE,MAXCONE*MAX(0.2D0,NACTIVE*1.0D0/(NATOMS*1.0D0))
1517:          IF (MAXEEE.GT.MAXCONE*MAX(0.2D0,NACTIVE*1.0D0/(NATOMS*1.0D0))) GOTO 7771519:          IF (MAXEEE.GT.MAXCONE*MAX(0.2D0,NACTIVE*1.0D0/(NATOMS*1.0D0))) GOTO 777
1518:          IF (NACTIVE.LT.NATOMS) THEN 1520:          IF (NACTIVE.LT.NATOMS) THEN 
1519:             ADDATOM=.TRUE.1521:             ADDATOM=.TRUE.
1520:             GOTO 7771522:             GOTO 777
1521:          ENDIF1523:          ENDIF
1522:          CALL MYCPU_TIME(FTIME,.FALSE.)1524:          CALL MYCPU_TIME(FTIME,.FALSE.)
1523:          WRITE(*,'(A,I6,A,F12.6,A,I6,A,G20.10)') ' intlbfgs> switch on true potential at step ',NITERDONE, &1525:          WRITE(*,'(A,I6,A,F12.6,A,I6,A,G20.10)') ' intlbfgs> switch on true potential at step ',NITERDONE, &
1524:   &                                     ' fraction=',INTCONFRAC,' images=',INTIMAGE,' time=',FTIME-STIME1526:   &                                     ' fraction=',INTCONFRAC,' images=',INTIMAGE,' time=',FTIME-STIME
1525:          IF (DEBUG) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF)1527:          IF (DEBUG) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF,CONOFFLIST)
1526:          IF (DEBUG) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)1528:          IF (DEBUG) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)
1527:          WRITE(*,'(A,I6,A,F15.6)') ' intlbfgs> Allowing ',INTCONSTEPS,' further optimization steps'1529:          WRITE(*,'(A,I6,A,F15.6)') ' intlbfgs> Allowing ',INTCONSTEPS,' further optimization steps'
1528:          DO J1=1,NATOMS1530:          DO J1=1,NATOMS
1529:             IF (.NOT.ATOMACTIVE(J1)) THEN1531:             IF (.NOT.ATOMACTIVE(J1)) THEN
1530:                WRITE(*,'(A,I6,A,I6,A)') ' intlbfgs> ERROR *** number of active atoms=',NACTIVE,' but atom ',J1,' is not active'1532:                WRITE(*,'(A,I6,A,I6,A)') ' intlbfgs> ERROR *** number of active atoms=',NACTIVE,' but atom ',J1,' is not active'
1531:             ENDIF1533:             ENDIF
1532:          ENDDO1534:          ENDDO
1533:          NSTEPSMAX=NITERDONE+INTCONSTEPS1535:          NSTEPSMAX=NITERDONE+INTCONSTEPS
1534:          SWITCHED=.TRUE.1536:          SWITCHED=.TRUE.
1535:          RMS=INTRMSTOL*10.0D0 ! to prevent premature convergence1537:          RMS=INTRMSTOL*10.0D0 ! to prevent premature convergence
1550:    777 CONTINUE1552:    777 CONTINUE
1551: !1553: !
1552: ! Compute the new step and gradient change1554: ! Compute the new step and gradient change
1553: !1555: !
1554:    NPT=POINT*D1556:    NPT=POINT*D
1555:    SEARCHSTEP(POINT,:) = STP*SEARCHSTEP(POINT,:)1557:    SEARCHSTEP(POINT,:) = STP*SEARCHSTEP(POINT,:)
1556:    GDIF(POINT,:)=G-GTMP1558:    GDIF(POINT,:)=G-GTMP
1557:    1559:    
1558:    POINT=POINT+1; IF (POINT==INTMUPDATE) POINT=01560:    POINT=POINT+1; IF (POINT==INTMUPDATE) POINT=0
1559: 1561: 
1560:    IF (DUMPINTXYZ.AND.MOD(NITERDONE,DUMPINTXYZFREQ)==0) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF)1562:    IF (DUMPINTXYZ.AND.MOD(NITERDONE,DUMPINTXYZFREQ)==0) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF,CONOFFLIST)
1561:    IF (DUMPINTEOS.AND.MOD(NITERDONE,DUMPINTEOSFREQ)==0) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)1563:    IF (DUMPINTEOS.AND.MOD(NITERDONE,DUMPINTEOSFREQ)==0) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)
1562: 1564: 
1563:    NITERDONE=NITERDONE+11565:    NITERDONE=NITERDONE+1
1564:    NITERUSE=NITERUSE+11566:    NITERUSE=NITERUSE+1
1565: 1567: 
1566:    IF (NITERDONE.GT.NSTEPSMAX) EXIT1568:    IF (NITERDONE.GT.NSTEPSMAX) EXIT
1567:    IF (NACTIVE.EQ.NATOMS) THEN1569:    IF (NACTIVE.EQ.NATOMS) THEN
1568:       IF (.NOT.SWITCHED) THEN1570:       IF (.NOT.SWITCHED) THEN
1569:          CALL MYCPU_TIME(FTIME,.FALSE.)1571:          CALL MYCPU_TIME(FTIME,.FALSE.)
1570:          WRITE(*,'(A,I6,A,F12.6,A,I6,A,F10.1)') ' intlbfgs> switch on true potential at step ',NITERDONE, &1572:          WRITE(*,'(A,I6,A,F12.6,A,I6,A,F10.1)') ' intlbfgs> switch on true potential at step ',NITERDONE, &
1594: ENDIF1596: ENDIF
1595: IF (EXITSTATUS.EQ.1) THEN1597: IF (EXITSTATUS.EQ.1) THEN
1596:    WRITE(*,'(A,I6,A,G20.10,A,G15.8,A,I4)') ' intlbfgs> Converged after ',NITERDONE,' steps, energy/image=',ETOTAL/INTIMAGE, &1598:    WRITE(*,'(A,I6,A,G20.10,A,G15.8,A,I4)') ' intlbfgs> Converged after ',NITERDONE,' steps, energy/image=',ETOTAL/INTIMAGE, &
1597:   &                               ' RMS=',RMS,' images=',INTIMAGE1599:   &                               ' RMS=',RMS,' images=',INTIMAGE
1598: ELSEIF (EXITSTATUS.EQ.2) THEN1600: ELSEIF (EXITSTATUS.EQ.2) THEN
1599:    WRITE(*,'(A,I6,A,G20.10,A,G15.8,A,I4)') ' intlbfgs> After ',NITERDONE,' steps, energy/image=',ETOTAL/INTIMAGE, &1601:    WRITE(*,'(A,I6,A,G20.10,A,G15.8,A,I4)') ' intlbfgs> After ',NITERDONE,' steps, energy/image=',ETOTAL/INTIMAGE, &
1600:   &                               ' RMS=',RMS,' images=',INTIMAGE1602:   &                               ' RMS=',RMS,' images=',INTIMAGE
1601: ENDIF1603: ENDIF
1602: 678 CONTINUE1604: 678 CONTINUE
1603: 1605: 
1604: ! CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF)1606: ! CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF,CONOFFLIST)
1605: ! CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)1607: ! CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)
1606: 1608: 
1607: IF (DEBUG) WRITE(*,'(A,G20.10)') 'intlbfgs> WORST=',WORST1609: IF (DEBUG) WRITE(*,'(A,G20.10)') 'intlbfgs> WORST=',WORST
1608: 1610: 
1609: BESTWORST=WORST1611: BESTWORST=WORST
1610: BESTINTIMAGE=INTIMAGE1612: BESTINTIMAGE=INTIMAGE
1611: IF (ALLOCATED(QCIXYZ)) DEALLOCATE(QCIXYZ)1613: IF (ALLOCATED(QCIXYZ)) DEALLOCATE(QCIXYZ)
1612: ALLOCATE(QCIXYZ(3*NATOMS*(INTIMAGE+2)))1614: ALLOCATE(QCIXYZ(3*NATOMS*(INTIMAGE+2)))
1613: QCIXYZ(1:3*NATOMS*(INTIMAGE+2))=XYZ(1:3*NATOMS*(INTIMAGE+2))1615: QCIXYZ(1:3*NATOMS*(INTIMAGE+2))=XYZ(1:3*NATOMS*(INTIMAGE+2))
1614: WRITE(*,'(A,I8,A,G20.10)') 'intlbfgs> retaining ',INTIMAGE,' QCI images, highest energy=',BESTWORST1616: WRITE(*,'(A,I8,A,G20.10)') 'intlbfgs> retaining ',INTIMAGE,' QCI images, highest energy=',BESTWORST
1615: 1617: 
1616: CALL INTRWG(NACTIVE,0,INTIMAGE,XYZ,TURNONORDER,NCONOFF)1618: CALL INTRWG(NACTIVE,0,INTIMAGE,XYZ,TURNONORDER,NCONOFF,CONOFFLIST)
1617: CALL WRITEPROFILE(0,EEE,INTIMAGE)1619: CALL WRITEPROFILE(0,EEE,INTIMAGE)
1618: 1620: 
1619: DEALLOCATE(CONI,CONJ,CONDISTREF,REPI,REPJ,NREPI,NREPJ,REPCUT,NREPCUT,CONCUT,CONOFFLIST)1621: DEALLOCATE(CONI,CONJ,CONDISTREF,REPI,REPJ,NREPI,NREPJ,REPCUT,NREPCUT,CONCUT)
1620: DEALLOCATE(TRUEEE, EEETMP, MYGTMP, GTMP, &1622: DEALLOCATE(TRUEEE, EEETMP, MYGTMP, GTMP, &
1621:   &      DIAG, STP, SEARCHSTEP, GDIF,GLAST, XSAVE, XYZ, GGG, CHECKG, IMGFREEZE, EEE, STEPIMAGE)1623:   &      DIAG, STP, SEARCHSTEP, GDIF,GLAST, XSAVE, XYZ, GGG, CHECKG, IMGFREEZE, EEE, STEPIMAGE)
1622: QCIIMAGE=INTIMAGE1624: QCIIMAGE=INTIMAGE
1623: INTIMAGE=INTIMAGESAVE1625: INTIMAGE=INTIMAGESAVE
1624: 1626: 
1625: END SUBROUTINE INTLBFGS1627: END SUBROUTINE INTLBFGS
1626: !1628: !
1627: ! Neighbour list for repulsions to reduce cost of constraint potential.1629: ! Neighbour list for repulsions to reduce cost of constraint potential.
1628: !1630: !
1629: SUBROUTINE CHECKREP(INTIMAGE,XYZ,NOPT,NNSTART,NSTART)1631: SUBROUTINE CHECKREP(INTIMAGE,XYZ,NOPT,NNSTART,NSTART)
1687:          NREPCUT(NNREPULSIVE)=REPCUT(JJ)1689:          NREPCUT(NNREPULSIVE)=REPCUT(JJ)
1688:          GOTO 2461690:          GOTO 246
1689:       ENDIF1691:       ENDIF
1690:    ENDDO 1692:    ENDDO 
1691: 246 CONTINUE1693: 246 CONTINUE
1692: ENDDO1694: ENDDO
1693: IF (DEBUG) WRITE(*,'(A,2I8)') ' checkrep> number of active repulsions and total=',NNREPULSIVE,NREPULSIVE1695: IF (DEBUG) WRITE(*,'(A,2I8)') ' checkrep> number of active repulsions and total=',NNREPULSIVE,NREPULSIVE
1694: 1696: 
1695: END SUBROUTINE CHECKREP1697: END SUBROUTINE CHECKREP
1696: 1698: 
1697: SUBROUTINE INTRWG(NACTIVE,NITER,INTIMAGE,XYZ,TURNONORDER,NCONOFF)1699: SUBROUTINE INTRWG(NACTIVE,NITER,INTIMAGE,XYZ,TURNONORDER,NCONOFF,CONOFFLIST)
1698: USE PORFUNCS1700: USE PORFUNCS
1699: USE KEY,ONLY: STOCKT,STOCKAAT, RBAAT, ATOMACTIVE, NCONSTRAINT, CONACTIVE, NREPULSIVE, NNREPULSIVE, REPI, REPJ, REPCUT, NREPCUT, &1701: USE KEY,ONLY: STOCKT,STOCKAAT, RBAAT, ATOMACTIVE, NCONSTRAINT, CONACTIVE, NREPULSIVE, NNREPULSIVE, REPI, REPJ, REPCUT, NREPCUT, &
1700:   &           NREPMAX, NREPI, NREPJ, INTFROZEN, CONOFFLIST1702:   &           NREPMAX, NREPI, NREPJ, INTFROZEN
1701: USE COMMONS, ONLY: NATOMS1703: USE COMMONS, ONLY: NATOMS
1702: IMPLICIT NONE1704: IMPLICIT NONE
1703: INTEGER NCONOFF1705: INTEGER NCONOFF, CONOFFLIST(NCONSTRAINT)
1704: CHARACTER(LEN=10) :: XYZFILE   = 'int.xyz   '1706: CHARACTER(LEN=10) :: XYZFILE   = 'int.xyz   '
1705: CHARACTER(LEN=10) :: QCIFILE   = 'QCIdump   '1707: CHARACTER(LEN=10) :: QCIFILE   = 'QCIdump   '
1706: INTEGER,INTENT(IN) :: NITER, TURNONORDER(NATOMS)1708: INTEGER,INTENT(IN) :: NITER, TURNONORDER(NATOMS)
1707: INTEGER :: J1,J2,INTIMAGE,J3,NACTIVE,LUNIT,GETUNIT1709: INTEGER :: J1,J2,INTIMAGE,J3,NACTIVE,LUNIT,GETUNIT
1708: CHARACTER(LEN=80) :: FILENAME,DUMMYS1710: CHARACTER(LEN=80) :: FILENAME,DUMMYS
1709: DOUBLE PRECISION XYZ((3*NATOMS)*(INTIMAGE+2))1711: DOUBLE PRECISION XYZ((3*NATOMS)*(INTIMAGE+2))
1710: 1712: 
1711: FILENAME=XYZFILE1713: FILENAME=XYZFILE
1712: 1714: 
1713: ! IF (NITER.GT.0) THEN1715: ! IF (NITER.GT.0) THEN
1951:                         NEWATOM=CONJ(J1)1953:                         NEWATOM=CONJ(J1)
1952:                      ENDIF1954:                      ENDIF
1953:                   ENDIF1955:                   ENDIF
1954:                ENDIF1956:                ENDIF
1955:             ENDIF1957:             ENDIF
1956:          ENDIF1958:          ENDIF
1957:       ENDDO1959:       ENDDO
1958:       IF (DEBUG) WRITE(*,'(3(A,I6),A,F15.5)') ' intlbfgs> Choosing new active atom ',NEWATOM,' new constraints=', &1960:       IF (DEBUG) WRITE(*,'(3(A,I6),A,F15.5)') ' intlbfgs> Choosing new active atom ',NEWATOM,' new constraints=', &
1959:   &                                       NCONTOACTIVE(NEWATOM),' maximum=',NBEST,' shortest constraint=',DUMMY21961:   &                                       NCONTOACTIVE(NEWATOM),' maximum=',NBEST,' shortest constraint=',DUMMY2
1960:       IF (DOBACK) WRITE(*,'(A,L5)') ' intlbfgs> AABACK=',AABACK(NEWATOM)1962:       IF (DOBACK) WRITE(*,'(A,L5)') ' intlbfgs> AABACK=',AABACK(NEWATOM)
1961: !     IF (DEBUG) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF)1963: !     IF (DEBUG) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF,CONOFFLIST)
1962: !     IF (DEBUG) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)1964: !     IF (DEBUG) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)
1963:       IF (QCIADDACIDT.AND.(.NOT.CHOSENACID).AND.(.NOT.DOBACK)) THEN1965:       IF (QCIADDACIDT.AND.(.NOT.CHOSENACID).AND.(.NOT.DOBACK)) THEN
1964:          ACID=ATOMSTORES(NEWATOM)1966:          ACID=ATOMSTORES(NEWATOM)
1965:          CHOSENACID=.TRUE.1967:          CHOSENACID=.TRUE.
1966:       ENDIF1968:       ENDIF
1967:       IF ((.NOT.CHOSENACID).AND.DOBACKALL) THEN1969:       IF ((.NOT.CHOSENACID).AND.DOBACKALL) THEN
1968:          ACID=ATOMSTORES(NEWATOM)1970:          ACID=ATOMSTORES(NEWATOM)
1969:          CHOSENACID=.TRUE.1971:          CHOSENACID=.TRUE.
1970:       ENDIF1972:       ENDIF
1971:           1973:           


r33426/key.f90 2017-10-30 11:30:15.178255855 +0000 r33425/key.f90 2017-10-30 11:30:16.290270487 +0000
179:       DOUBLE PRECISION, ALLOCATABLE :: LJADDEPS(:,:)179:       DOUBLE PRECISION, ALLOCATABLE :: LJADDEPS(:,:)
180:       DOUBLE PRECISION, ALLOCATABLE :: LJADDREP(:,:), LJADDATT(:,:)180:       DOUBLE PRECISION, ALLOCATABLE :: LJADDREP(:,:), LJADDATT(:,:)
181:       LOGICAL, ALLOCATABLE :: CONACTIVE(:)181:       LOGICAL, ALLOCATABLE :: CONACTIVE(:)
182:       LOGICAL, ALLOCATABLE :: ATOMACTIVE(:)182:       LOGICAL, ALLOCATABLE :: ATOMACTIVE(:)
183:       INTEGER, ALLOCATABLE :: NITSTART(:)183:       INTEGER, ALLOCATABLE :: NITSTART(:)
184:       DOUBLE PRECISION, ALLOCATABLE :: RPMASSES(:), XMINA(:), XMINB(:)184:       DOUBLE PRECISION, ALLOCATABLE :: RPMASSES(:), XMINA(:), XMINB(:)
185:       DOUBLE PRECISION, ALLOCATABLE :: RBOPS(:,:)185:       DOUBLE PRECISION, ALLOCATABLE :: RBOPS(:,:)
186:       DOUBLE PRECISION, ALLOCATABLE :: SAVES(:), SAVEF(:)186:       DOUBLE PRECISION, ALLOCATABLE :: SAVES(:), SAVEF(:)
187: !     LOGICAL, ALLOCATABLE :: CONTEST(:,:)187: !     LOGICAL, ALLOCATABLE :: CONTEST(:,:)
188:       INTEGER, ALLOCATABLE :: ORDERI(:), ORDERJ(:), REPPOW(:)188:       INTEGER, ALLOCATABLE :: ORDERI(:), ORDERJ(:), REPPOW(:)
189:       INTEGER, ALLOCATABLE :: CONI(:), CONJ(:), CONION(:), CONJON(:), CONOFFLIST(:)189:       INTEGER, ALLOCATABLE :: CONI(:), CONJ(:), CONION(:), CONJON(:)
190:       INTEGER, ALLOCATABLE :: CONIFIX(:), CONJFIX(:), REPIFIX(:), REPJFIX(:)190:       INTEGER, ALLOCATABLE :: CONIFIX(:), CONJFIX(:), REPIFIX(:), REPJFIX(:)
191:       INTEGER, ALLOCATABLE :: REPI(:), REPJ(:)191:       INTEGER, ALLOCATABLE :: REPI(:), REPJ(:)
192:       INTEGER, ALLOCATABLE :: CPCONI(:), CPCONJ(:)192:       INTEGER, ALLOCATABLE :: CPCONI(:), CPCONJ(:)
193:       INTEGER, ALLOCATABLE :: CPREPI(:), CPREPJ(:)193:       INTEGER, ALLOCATABLE :: CPREPI(:), CPREPJ(:)
194:       DOUBLE PRECISION, ALLOCATABLE :: REPCUT(:), NREPCUT(:), CPREPCUT(:), REPCUTFIX(:)194:       DOUBLE PRECISION, ALLOCATABLE :: REPCUT(:), NREPCUT(:), CPREPCUT(:), REPCUTFIX(:)
195:       INTEGER, ALLOCATABLE :: NREPI(:), NREPJ(:)195:       INTEGER, ALLOCATABLE :: NREPI(:), NREPJ(:)
196:       INTEGER, ALLOCATABLE :: BESTPERM(:)196:       INTEGER, ALLOCATABLE :: BESTPERM(:)
197:       INTEGER, ALLOCATABLE :: RBGROUP(:), RBNINGROUP(:)197:       INTEGER, ALLOCATABLE :: RBGROUP(:), RBNINGROUP(:)
198:       INTEGER, ALLOCATABLE :: TO_ALIGN(:)198:       INTEGER, ALLOCATABLE :: TO_ALIGN(:)
199:       LOGICAL :: SETCHIRAL=.FALSE.199:       LOGICAL :: SETCHIRAL=.FALSE.


r33426/keywords.f 2017-10-30 11:30:15.406258853 +0000 r33425/keywords.f 2017-10-30 11:30:16.518273487 +0000
3619:                READ(LUNIT,*) CONCUTFIX(1:NCONSTRAINTFIX)3619:                READ(LUNIT,*) CONCUTFIX(1:NCONSTRAINTFIX)
3620:                READ(LUNIT,*) NREPULSIVEFIX3620:                READ(LUNIT,*) NREPULSIVEFIX
3621:                ALLOCATE(REPIFIX(NREPULSIVEFIX),REPJFIX(NREPULSIVEFIX),REPCUTFIX(NREPULSIVEFIX))3621:                ALLOCATE(REPIFIX(NREPULSIVEFIX),REPJFIX(NREPULSIVEFIX),REPCUTFIX(NREPULSIVEFIX))
3622:                READ(LUNIT,*) REPIFIX(1:NREPULSIVEFIX)3622:                READ(LUNIT,*) REPIFIX(1:NREPULSIVEFIX)
3623:                READ(LUNIT,*) REPJFIX(1:NREPULSIVEFIX)3623:                READ(LUNIT,*) REPJFIX(1:NREPULSIVEFIX)
3624:                READ(LUNIT,*) REPCUTFIX(1:NREPULSIVEFIX)3624:                READ(LUNIT,*) REPCUTFIX(1:NREPULSIVEFIX)
3625:                CLOSE(LUNIT)3625:                CLOSE(LUNIT)
3626:                PRINT '(A)',' keyword> Constraint potential parameters read from file congeom.dat'3626:                PRINT '(A)',' keyword> Constraint potential parameters read from file congeom.dat'
3627:                INTCONMAX=NCONSTRAINTFIX3627:                INTCONMAX=NCONSTRAINTFIX
3628:                NREPMAX=NREPULSIVEFIX3628:                NREPMAX=NREPULSIVEFIX
3629:                ALLOCATE(CONI(INTCONMAX),CONJ(INTCONMAX),CONDISTREF(INTCONMAX),CONCUT(INTCONMAX),CONOFFLIST(INTCONMAX))3629:                ALLOCATE(CONI(INTCONMAX),CONJ(INTCONMAX),CONDISTREF(INTCONMAX),CONCUT(INTCONMAX))
3630:                ALLOCATE(REPI(NREPMAX),REPJ(NREPMAX),NREPI(NREPMAX),NREPJ(NREPMAX),REPCUT(NREPMAX),NREPCUT(NREPMAX))3630:                ALLOCATE(REPI(NREPMAX),REPJ(NREPMAX),NREPI(NREPMAX),NREPJ(NREPMAX),REPCUT(NREPMAX),NREPCUT(NREPMAX))
3631:                ALLOCATE(CONACTIVE(NCONSTRAINTFIX))3631:                ALLOCATE(CONACTIVE(NCONSTRAINTFIX))
3632:             ELSE3632:             ELSE
3633:                INQUIRE(FILE='congeom',EXIST=CONFILE)3633:                INQUIRE(FILE='congeom',EXIST=CONFILE)
3634:                NCONGEOM=03634:                NCONGEOM=0
3635:                IF (.NOT.CONFILE) THEN3635:                IF (.NOT.CONFILE) THEN
3636:                   PRINT '(A)',' keyword> WARNING *** no congeom file found. Will use end point minima only.'3636:                   PRINT '(A)',' keyword> WARNING *** no congeom file found. Will use end point minima only.'
3637:                ELSE3637:                ELSE
3638:                   LUNIT=GETUNIT()3638:                   LUNIT=GETUNIT()
3639:                   OPEN(LUNIT,FILE='congeom',STATUS='OLD')3639:                   OPEN(LUNIT,FILE='congeom',STATUS='OLD')


r33426/make_conpot.f90 2017-10-30 11:30:15.626261750 +0000 r33425/make_conpot.f90 2017-10-30 11:30:16.738276382 +0000
 11: !   GNU General Public License for more details. 11: !   GNU General Public License for more details.
 12: ! 12: !
 13: !   You should have received a copy of the GNU General Public License 13: !   You should have received a copy of the GNU General Public License
 14: !   along with this program; if not, write to the Free Software 14: !   along with this program; if not, write to the Free Software
 15: !   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA 15: !   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 16: ! 16: !
 17: SUBROUTINE MAKE_CONPOT(NCPFIT,MINCOORDS) 17: SUBROUTINE MAKE_CONPOT(NCPFIT,MINCOORDS)
 18: USE KEY, ONLY : INTCONSEP, NREPMAX, NREPULSIVE, CONDISTREF, REPCON, INTCONSTRAINTREP, & 18: USE KEY, ONLY : INTCONSEP, NREPMAX, NREPULSIVE, CONDISTREF, REPCON, INTCONSTRAINTREP, &
 19:   & REPCUT, NCONSTRAINT, CONI, CONJ, CONDISTREFLOCAL, INTCONMAX, CONACTIVE, & 19:   & REPCUT, NCONSTRAINT, CONI, CONJ, CONDISTREFLOCAL, INTCONMAX, CONACTIVE, &
 20:   & INTCONSTRAINREPCUT, INTREPSEP, REPI, REPJ, INTCONSTRAINTTOL, REPCUT, NREPI, NREPJ, NREPCUT, & 20:   & INTCONSTRAINREPCUT, INTREPSEP, REPI, REPJ, INTCONSTRAINTTOL, REPCUT, NREPI, NREPJ, NREPCUT, &
 21:   & NCONGEOM, CONGEOM, NNREPULSIVE, BULKT, RIGIDBODY, TWOD, CONOFFLIST, & 21:   & NCONGEOM, CONGEOM, NNREPULSIVE, BULKT, RIGIDBODY, TWOD, &
 22:   & INTFROZEN, FREEZE, INTFREEZET, INTFREEZETOL, INTFREEZEMIN, CONIFIX, CONJFIX, CONDISTREFFIX, REPIFIX, REPJFIX, & 22:   & INTFROZEN, FREEZE, INTFREEZET, INTFREEZETOL, INTFREEZEMIN, CONIFIX, CONJFIX, CONDISTREFFIX, REPIFIX, REPJFIX, &
 23:   & REPCUTFIX, NCONGEOM, NREPULSIVEFIX, CONDATT, NCONSTRAINTFIX, CONCUTLOCAL, CONCUTFIX, CONCUT 23:   & REPCUTFIX, NCONGEOM, NREPULSIVEFIX, CONDATT, NCONSTRAINTFIX, CONCUTLOCAL, CONCUTFIX, CONCUT
 24: USE COMMONS, ONLY: NATOMS, DEBUG, PARAM1, PARAM2, PARAM3 24: USE COMMONS, ONLY: NATOMS, DEBUG, PARAM1, PARAM2, PARAM3
 25:  25: 
 26: IMPLICIT NONE  26: IMPLICIT NONE 
 27: DOUBLE PRECISION DF, D, RMAT(3,3), DISTANCE, D2 27: DOUBLE PRECISION DF, D, RMAT(3,3), DISTANCE, D2
 28: INTEGER :: J2,ISTAT,J1,J3,J4,NCPFIT,J5,NQCIFREEZE,NDUMMY,LUNIT,GETUNIT 28: INTEGER :: J2,ISTAT,J1,J3,J4,NCPFIT,J5,NQCIFREEZE,NDUMMY,LUNIT,GETUNIT
 29: INTEGER NCONFORNEWATOM 29: INTEGER NCONFORNEWATOM
 30: DOUBLE PRECISION :: NDIST, MINCOORDS(NCPFIT,3*NATOMS), DMIN, LINTCONSTRAINTTOL, & 30: DOUBLE PRECISION :: NDIST, MINCOORDS(NCPFIT,3*NATOMS), DMIN, LINTCONSTRAINTTOL, &
 31:   &                 LXYZ(6*NATOMS) 31:   &                 LXYZ(6*NATOMS)
102: 102: 
103: IF (NATOMS-NQCIFREEZE.LT.INTFREEZEMIN) THEN103: IF (NATOMS-NQCIFREEZE.LT.INTFREEZEMIN) THEN
104:    DO J1=NATOMS,NATOMS-INTFREEZEMIN+1,-1104:    DO J1=NATOMS,NATOMS-INTFREEZEMIN+1,-1
105:       INTFROZEN(DLIST(J1))=.FALSE.105:       INTFROZEN(DLIST(J1))=.FALSE.
106:    ENDDO106:    ENDDO
107:    NQCIFREEZE=MAX(0,NATOMS-INTFREEZEMIN)107:    NQCIFREEZE=MAX(0,NATOMS-INTFREEZEMIN)
108:    IF (DEBUG) WRITE(*, '(A,I6,A)') ' make_conpot> Freezing ',NQCIFREEZE,' atoms'108:    IF (DEBUG) WRITE(*, '(A,I6,A)') ' make_conpot> Freezing ',NQCIFREEZE,' atoms'
109: ENDIF109: ENDIF
110: 110: 
111: IF (.NOT.ALLOCATED(CONI)) THEN 111: IF (.NOT.ALLOCATED(CONI)) THEN 
112:    ALLOCATE(CONI(INTCONMAX),CONJ(INTCONMAX),CONDISTREF(INTCONMAX),CONCUT(INTCONMAX),CONOFFLIST(INTCONMAX))112:    ALLOCATE(CONI(INTCONMAX),CONJ(INTCONMAX),CONDISTREF(INTCONMAX),CONCUT(INTCONMAX))
113:    ALLOCATE(REPI(NREPMAX),REPJ(NREPMAX),NREPI(NREPMAX),NREPJ(NREPMAX),REPCUT(NREPMAX),NREPCUT(NREPMAX))113:    ALLOCATE(REPI(NREPMAX),REPJ(NREPMAX),NREPI(NREPMAX),NREPJ(NREPMAX),REPCUT(NREPMAX),NREPCUT(NREPMAX))
114: ENDIF114: ENDIF
115: 115: 
116: IF (NQCIFREEZE.EQ.NATOMS) THEN116: IF (NQCIFREEZE.EQ.NATOMS) THEN
117:    NREPULSIVE=0117:    NREPULSIVE=0
118:    NNREPULSIVE=0118:    NNREPULSIVE=0
119:    NCONSTRAINT=0119:    NCONSTRAINT=0
120:    IF (DEBUG) WRITE(*,'(A,2I10,A,G20.10)') ' make_conpot> Total number of constraints and repulsions=', &120:    IF (DEBUG) WRITE(*,'(A,2I10,A,G20.10)') ' make_conpot> Total number of constraints and repulsions=', &
121:   &   NCONSTRAINT,NREPULSIVE121:   &   NCONSTRAINT,NREPULSIVE
122:    122:    
468: NREPCUT(1:NREPMAX)=REPTEMP(1:NREPMAX)468: NREPCUT(1:NREPMAX)=REPTEMP(1:NREPMAX)
469: 469: 
470: DEALLOCATE(IREPTEMP,REPTEMP)470: DEALLOCATE(IREPTEMP,REPTEMP)
471: NREPMAX=2*NREPMAX471: NREPMAX=2*NREPMAX
472: 472: 
473: END SUBROUTINE REPDOUBLE473: END SUBROUTINE REPDOUBLE
474: 474: 
475: 475: 
476: SUBROUTINE CONDOUBLE476: SUBROUTINE CONDOUBLE
477: USE KEY, ONLY : CONI, CONJ, CONDISTREF, INTCONMAX, CONIFIX, CONJFIX, CONDISTREFFIX, NCONGEOM, &477: USE KEY, ONLY : CONI, CONJ, CONDISTREF, INTCONMAX, CONIFIX, CONJFIX, CONDISTREFFIX, NCONGEOM, &
478:   &             CONCUT, CONCUTFIX, CONOFFLIST478:   &             CONCUT, CONCUTFIX
479: IMPLICIT NONE479: IMPLICIT NONE
480: DOUBLE PRECISION, ALLOCATABLE :: CPTEMP(:)480: DOUBLE PRECISION, ALLOCATABLE :: CPTEMP(:)
481: INTEGER, ALLOCATABLE :: ICPTEMP(:)481: INTEGER, ALLOCATABLE :: ICPTEMP(:)
482: 482: 
483: ALLOCATE(ICPTEMP(INTCONMAX))483: ALLOCATE(ICPTEMP(INTCONMAX))
484: ALLOCATE(CPTEMP(1:INTCONMAX))484: ALLOCATE(CPTEMP(1:INTCONMAX))
485:                 485:                 
486: ICPTEMP(1:INTCONMAX)=CONI(1:INTCONMAX)486: ICPTEMP(1:INTCONMAX)=CONI(1:INTCONMAX)
487: DEALLOCATE(CONI)487: DEALLOCATE(CONI)
488: ALLOCATE(CONI(2*INTCONMAX))488: ALLOCATE(CONI(2*INTCONMAX))
508:    DEALLOCATE(CONCUTFIX)508:    DEALLOCATE(CONCUTFIX)
509:    ALLOCATE(CONCUTFIX(2*INTCONMAX))509:    ALLOCATE(CONCUTFIX(2*INTCONMAX))
510:    CONCUTFIX(1:INTCONMAX)=CPTEMP(1:INTCONMAX)510:    CONCUTFIX(1:INTCONMAX)=CPTEMP(1:INTCONMAX)
511: ENDIF511: ENDIF
512:                512:                
513: ICPTEMP(1:INTCONMAX)=CONJ(1:INTCONMAX)513: ICPTEMP(1:INTCONMAX)=CONJ(1:INTCONMAX)
514: DEALLOCATE(CONJ)514: DEALLOCATE(CONJ)
515: ALLOCATE(CONJ(2*INTCONMAX))515: ALLOCATE(CONJ(2*INTCONMAX))
516: CONJ(1:INTCONMAX)=ICPTEMP(1:INTCONMAX)516: CONJ(1:INTCONMAX)=ICPTEMP(1:INTCONMAX)
517:                517:                
518: ICPTEMP(1:INTCONMAX)=CONOFFLIST(1:INTCONMAX) 
519: DEALLOCATE(CONOFFLIST) 
520: ALLOCATE(CONOFFLIST(2*INTCONMAX)) 
521: CONOFFLIST(1:INTCONMAX)=ICPTEMP(1:INTCONMAX) 
522:                 
523: CPTEMP(1:INTCONMAX)=CONDISTREF(1:INTCONMAX)518: CPTEMP(1:INTCONMAX)=CONDISTREF(1:INTCONMAX)
524: DEALLOCATE(CONDISTREF)519: DEALLOCATE(CONDISTREF)
525: ALLOCATE(CONDISTREF(2*INTCONMAX))520: ALLOCATE(CONDISTREF(2*INTCONMAX))
526: CONDISTREF(1:INTCONMAX)=CPTEMP(1:INTCONMAX)521: CONDISTREF(1:INTCONMAX)=CPTEMP(1:INTCONMAX)
527:                522:                
528: CPTEMP(1:INTCONMAX)=CONCUT(1:INTCONMAX)523: CPTEMP(1:INTCONMAX)=CONCUT(1:INTCONMAX)
529: DEALLOCATE(CONCUT)524: DEALLOCATE(CONCUT)
530: ALLOCATE(CONCUT(2*INTCONMAX))525: ALLOCATE(CONCUT(2*INTCONMAX))
531: CONCUT(1:INTCONMAX)=CPTEMP(1:INTCONMAX)526: CONCUT(1:INTCONMAX)=CPTEMP(1:INTCONMAX)
532: 527: 


r33426/OPTIM.F 2017-10-30 11:30:14.734250011 +0000 r33425/OPTIM.F 2017-10-30 11:30:15.850264696 +0000
167: 167: 
168:       IF (AMBERT .OR. NABT) CALL SET_CHECK_CHIRAL(Q,NATOMS,GOODSTRUCTURE1,CHIARRAY1)168:       IF (AMBERT .OR. NABT) CALL SET_CHECK_CHIRAL(Q,NATOMS,GOODSTRUCTURE1,CHIARRAY1)
169: 169: 
170:       IF (CHECKDT) CALL CHECKDRVTS(Q)170:       IF (CHECKDT) CALL CHECKDRVTS(Q)
171: 171: 
172:       IF ((INTCONSTRAINTT.OR.INTLJT).AND.(NCONGEOM.GE.2)) THEN172:       IF ((INTCONSTRAINTT.OR.INTLJT).AND.(NCONGEOM.GE.2)) THEN
173: !173: !
174: ! Set up all the constraints and repulsions for zero frozen atoms.174: ! Set up all the constraints and repulsions for zero frozen atoms.
175: !175: !
176:          IF (.NOT.ALLOCATED(CONI)) THEN176:          IF (.NOT.ALLOCATED(CONI)) THEN
177:             ALLOCATE(CONI(INTCONMAX),CONJ(INTCONMAX),CONDISTREF(INTCONMAX),CONCUT(INTCONMAX),CONOFFLIST(INTCONMAX))177:             ALLOCATE(CONI(INTCONMAX),CONJ(INTCONMAX),CONDISTREF(INTCONMAX),CONCUT(INTCONMAX))
178:             ALLOCATE(REPI(NREPMAX),REPJ(NREPMAX),NREPI(NREPMAX),NREPJ(NREPMAX),REPCUT(NREPMAX),NREPCUT(NREPMAX))178:             ALLOCATE(REPI(NREPMAX),REPJ(NREPMAX),NREPI(NREPMAX),NREPJ(NREPMAX),REPCUT(NREPMAX),NREPCUT(NREPMAX))
179:          ENDIF179:          ENDIF
180:          INTFREEZETOLSAVE=INTFREEZETOL180:          INTFREEZETOLSAVE=INTFREEZETOL
181:          INTFREEZETOL=-1.0D0181:          INTFREEZETOL=-1.0D0
182:          PRINT *,'OPTIM> NCONGEOM=',NCONGEOM182:          PRINT *,'OPTIM> NCONGEOM=',NCONGEOM
183:          CALL MAKE_CONPOT(NCONGEOM,CONGEOM) 183:          CALL MAKE_CONPOT(NCONGEOM,CONGEOM) 
184:          INTFREEZETOL=INTFREEZETOLSAVE184:          INTFREEZETOL=INTFREEZETOLSAVE
185:       ENDIF185:       ENDIF
186: 186: 
187: 187: 


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0