hdiff output

r33451/congrad.f90 2017-11-09 15:30:08.966499964 +0000 r33450/congrad.f90 2017-11-09 15:30:09.846511618 +0000
586: !586: !
587: ! This version of congrad tests for an internal minimum in the587: ! This version of congrad tests for an internal minimum in the
588: ! constraint distances as well as the repulsions.588: ! constraint distances as well as the repulsions.
589: !589: !
590: SUBROUTINE CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)590: SUBROUTINE CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
591: USE KEY, ONLY: FROZEN, FREEZE, NREPI, NREPJ, NNREPULSIVE, &591: USE KEY, ONLY: FROZEN, FREEZE, NREPI, NREPJ, NNREPULSIVE, &
592:   &            NCONSTRAINT, CONI, CONJ, INTCONSTRAINTDEL, CONDISTREF, INTCONSTRAINTREP, CONDISTREFLOCAL, &592:   &            NCONSTRAINT, CONI, CONJ, INTCONSTRAINTDEL, CONDISTREF, INTCONSTRAINTREP, CONDISTREFLOCAL, &
593:   &            CONACTIVE, INTCONSTRAINREPCUT, NREPCUT,FREEZENODEST, INTIMAGE, ATOMACTIVE, KINT, IMSEPMAX, &593:   &            CONACTIVE, INTCONSTRAINREPCUT, NREPCUT,FREEZENODEST, INTIMAGE, ATOMACTIVE, KINT, IMSEPMAX, &
594:   &            INTFREEZET, INTFROZEN, REPI, REPJ, CONCUT, CONCUTLOCAL, &594:   &            INTFREEZET, INTFROZEN, REPI, REPJ, CONCUT, CONCUTLOCAL, &
595:   &            CONCUTABS, CONCUTABST, CONCUTFRAC, CONCUTFRACT, INTMINFAC, INTSPRINGACTIVET, CHECKCONINT, JMAXCON, &595:   &            CONCUTABS, CONCUTABST, CONCUTFRAC, CONCUTFRACT, INTMINFAC, INTSPRINGACTIVET, CHECKCONINT, JMAXCON, &
596:   &            NCONOFF, CONOFFTRIED, INTCONMAX, KINTENDS, ECON, EREP, ESPRING596:   &            NCONOFF, CONOFFTRIED, INTCONMAX, KINTENDS
597: USE COMMONS, ONLY: NATOMS, NOPT, DEBUG597: USE COMMONS, ONLY: NATOMS, NOPT, DEBUG
598: IMPLICIT NONE598: IMPLICIT NONE
599:            599:            
600: INTEGER :: J1,J2,NI2,NI1,NJ2,NJ1,NMAXINT,NMININT,NCONINT(INTIMAGE+2),NREPINT(INTIMAGE+2),JMAX,IMAX,JMAXNOFF,IMAXNOFF600: INTEGER :: J1,J2,NI2,NI1,NJ2,NJ1,NMAXINT,NMININT,NCONINT(INTIMAGE+2),NREPINT(INTIMAGE+2),JMAX,IMAX,JMAXNOFF,IMAXNOFF
601: DOUBLE PRECISION :: ETOTAL, RMS, EMAX, EMAXNOFF601: DOUBLE PRECISION :: ECON, EREP, ETOTAL, RMS, EMAX, EMAXNOFF
602: INTEGER JJMAX(INTIMAGE+2)602: INTEGER JJMAX(INTIMAGE+2)
603: DOUBLE PRECISION  EEMAX(INTIMAGE+2)603: DOUBLE PRECISION  EEMAX(INTIMAGE+2)
604: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,D2,D1604: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,D2,D1
605: DOUBLE PRECISION G1(3),G2(3),DINT,G1INT(3),G2INT(3)605: DOUBLE PRECISION G1(3),G2(3),DINT,G1INT(3),G2INT(3)
606: DOUBLE PRECISION DUMMY, REPGRAD(3), INTCONST, D12, DSQ2, DSQ1, DSQI606: DOUBLE PRECISION DUMMY, REPGRAD(3), INTCONST, D12, DSQ2, DSQ1, DSQI
607: DOUBLE PRECISION CONE(INTIMAGE+2), REPE(INTIMAGE+2),MAXINT,MININT,REPEINT(INTIMAGE+2),CONEINT(INTIMAGE+2),RMSIMAGE(INTIMAGE+2)607: DOUBLE PRECISION CONE(INTIMAGE+2), REPE(INTIMAGE+2),MAXINT,MININT,REPEINT(INTIMAGE+2),CONEINT(INTIMAGE+2),RMSIMAGE(INTIMAGE+2)
608: LOGICAL NOINT, LPRINT608: LOGICAL NOINT, LPRINT
609: DOUBLE PRECISION XYZ((3*NATOMS)*(INTIMAGE+2)), GGG((3*NATOMS)*(INTIMAGE+2)), EEE(INTIMAGE+2)609: DOUBLE PRECISION XYZ((3*NATOMS)*(INTIMAGE+2)), GGG((3*NATOMS)*(INTIMAGE+2)), EEE(INTIMAGE+2)
610: LOGICAL IMGFREEZE(INTIMAGE), PRINTE610: LOGICAL IMGFREEZE(INTIMAGE), PRINTE
611: DOUBLE PRECISION DPLUS, SPGRAD(3), CCLOCAL611: DOUBLE PRECISION DPLUS, ESPRING, SPGRAD(3), CCLOCAL
612: 612: 
613: PRINTE=.FALSE.613: PRINTE=.FALSE.
614: 111 CONTINUE614: 111 CONTINUE
615: 615: 
616: EEE(1:INTIMAGE+2)=0.0D0616: EEE(1:INTIMAGE+2)=0.0D0
617: CONE(1:INTIMAGE+2)=0.0D0617: CONE(1:INTIMAGE+2)=0.0D0
618: REPE(1:INTIMAGE+2)=0.0D0618: REPE(1:INTIMAGE+2)=0.0D0
619: NCONINT(1:INTIMAGE+2)=0619: NCONINT(1:INTIMAGE+2)=0
620: NREPINT(1:INTIMAGE+2)=0620: NREPINT(1:INTIMAGE+2)=0
621: REPEINT(1:INTIMAGE+2)=0.0D0621: REPEINT(1:INTIMAGE+2)=0.0D0


r33451/intlbfgs.f90 2017-11-09 15:30:09.190502931 +0000 r33450/intlbfgs.f90 2017-11-09 15:30:10.070514585 +0000
 24:      & CONDISTREFLOCAL, INTCONFRAC, CONACTIVE, REPI, & 24:      & CONDISTREFLOCAL, INTCONFRAC, CONACTIVE, REPI, &
 25:      & REPJ, NREPMAX, ATOMACTIVE, NCONSTRAINTON, CONION, CONJON, CONDISTREFLOCALON, CONDISTREFON, & 25:      & REPJ, NREPMAX, ATOMACTIVE, NCONSTRAINTON, CONION, CONJON, CONDISTREFLOCALON, CONDISTREFON, &
 26:      & NREPCUT, REPCUT, CHECKCONINT, INTCONSTEPS, INTRELSTEPS, MAXCONE, COLDFUSIONLIMIT, & 26:      & NREPCUT, REPCUT, CHECKCONINT, INTCONSTEPS, INTRELSTEPS, MAXCONE, COLDFUSIONLIMIT, &
 27:      & INTSTEPS1, DUMPINTXYZ, DUMPINTXYZFREQ, DUMPINTEOS, DUMPINTEOSFREQ, & 27:      & INTSTEPS1, DUMPINTXYZ, DUMPINTXYZFREQ, DUMPINTEOS, DUMPINTEOSFREQ, &
 28:      & IMSEPMIN, IMSEPMAX, MAXINTIMAGE, INTFREEZET, INTFREEZETOL, FREEZE, & 28:      & IMSEPMIN, IMSEPMAX, MAXINTIMAGE, INTFREEZET, INTFREEZETOL, FREEZE, &
 29:      & INTFROZEN, CHECKREPINTERVAL, NNREPULSIVE, INTFREEZEMIN, INTIMAGECHECK, & 29:      & INTFROZEN, CHECKREPINTERVAL, NNREPULSIVE, INTFREEZEMIN, INTIMAGECHECK, &
 30:      & CONCUT, CONCUTLOCAL, KINT, REPIFIX, REPJFIX, NREPULSIVEFIX, & 30:      & CONCUT, CONCUTLOCAL, KINT, REPIFIX, REPJFIX, NREPULSIVEFIX, &
 31:      & NCONSTRAINTFIX, CONIFIX, CONJFIX, QCIPERMCHECK, QCIPERMCHECKINT, BULKT, TWOD, RIGIDBODY, & 31:      & NCONSTRAINTFIX, CONIFIX, CONJFIX, QCIPERMCHECK, QCIPERMCHECKINT, BULKT, TWOD, RIGIDBODY, &
 32:      & QCIADDREP, QCIXYZ, WHOLEDNEB, QCIIMAGE, FROZEN, QCIRESTART, NPERMGROUP, NPERMSIZE, PERMGROUP, NSETS, SETS, & 32:      & QCIADDREP, QCIXYZ, WHOLEDNEB, QCIIMAGE, FROZEN, QCIRESTART, NPERMGROUP, NPERMSIZE, PERMGROUP, NSETS, SETS, &
 33:      & PERMDIST, LOCALPERMCUT, QCILPERMDIST, QCIPDINT, QCIPERMCUT, QCIAMBERT, BONDS, DOBACK, & 33:      & PERMDIST, LOCALPERMCUT, QCILPERMDIST, QCIPDINT, QCIPERMCUT, QCIAMBERT, BONDS, DOBACK, &
 34:      & QCIRESET, QCIRESETINT1, QCIRESETINT2, JMAXCON, NCONOFF, EREP, ECON, ESPRING 34:      & QCIRESET, QCIRESETINT1, QCIRESETINT2, JMAXCON, NCONOFF
 35: USE COMMONS, ONLY: NATOMS, DEBUG, PARAM1, PARAM2, PARAM3 35: USE COMMONS, ONLY: NATOMS, DEBUG, PARAM1, PARAM2, PARAM3
 36: USE MODCHARMM, ONLY : CHRMMT 36: USE MODCHARMM, ONLY : CHRMMT
 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 45: INTEGER NDECREASE, NFAIL, NMAXINT, NMININT, JMAX, JMIN, INTIMAGESAVE, NOFF, J1, J2, NQDONE, JA1, JA2, NMOVE, NMOVES, NMOVEF
 46: INTEGER PERM(NATOMS), PERMS(NATOMS), PERMF(NATOMS), STARTGROUP(NPERMGROUP), ENDGROUP(NPERMGROUP) 46: INTEGER PERM(NATOMS), PERMS(NATOMS), PERMF(NATOMS), STARTGROUP(NPERMGROUP), ENDGROUP(NPERMGROUP)
 47: LOGICAL KNOWE, KNOWG, KNOWH, ADDATOM, ADDREP(NATOMS), LDEBUG, REMOVEIMAGE, PERMUTABLE(NATOMS), IDENTITY, IDONE, TURNOFF 47: LOGICAL KNOWE, KNOWG, KNOWH, ADDATOM, ADDREP(NATOMS), LDEBUG, REMOVEIMAGE, PERMUTABLE(NATOMS), IDENTITY, IDONE
 48: COMMON /KNOWN/ KNOWE, KNOWG, KNOWH 48: COMMON /KNOWN/ KNOWE, KNOWG, KNOWH
 49:  49: 
 50: DOUBLE PRECISION DUMMY, DPRAND, DUMMY2, ADUMMY 50: DOUBLE PRECISION DUMMY, DPRAND, DUMMY2, ADUMMY
 51: DOUBLE PRECISION BOXLX,BOXLY,BOXLZ,DISTANCE,RMATBEST(3,3),DISTANCES,DISTANCEF 51: DOUBLE PRECISION BOXLX,BOXLY,BOXLZ,DISTANCE,RMATBEST(3,3),DISTANCES,DISTANCEF
 52: INTEGER POINT,NPT,J3,J4,NIMAGEFREEZE,NACTIVE,NBEST,NEWATOM,NBEST2 52: INTEGER POINT,NPT,J3,J4,NIMAGEFREEZE,NACTIVE,NBEST,NEWATOM,NBEST2
 53: INTEGER TURNONORDER(NATOMS),NBACKTRACK,NQCIFREEZE, NBONDED(NATOMS), BONDEDLIST(NATOMS,6), NBOND 53: INTEGER TURNONORDER(NATOMS),NBACKTRACK,NQCIFREEZE, NBONDED(NATOMS), BONDEDLIST(NATOMS,6), NBOND
 54: INTEGER NDUMMY, NLASTGOODE, NSTEPSMAX, INGROUP(NATOMS), ACID, NLASTCHANGE 54: INTEGER NDUMMY, NLASTGOODE, NSTEPSMAX, INGROUP(NATOMS), ACID, NLASTCHANGE
 55: LOGICAL CHIRALSR, CHIRALSRP  55: LOGICAL CHIRALSR, CHIRALSRP 
 56: INTEGER NTRIES(NATOMS), NITERDONE, EXITSTATUS, DLIST(NATOMS) 56: INTEGER NTRIES(NATOMS), NITERDONE, EXITSTATUS, DLIST(NATOMS)
 57: DOUBLE PRECISION :: DDOT,STPMIN, ETOTALTMP, RMSTMP, USEFRAC, STIME, FTIME, & 57: DOUBLE PRECISION :: DDOT,STPMIN, ETOTALTMP, RMSTMP, USEFRAC, STIME, FTIME, &
 78: LOGICAL, ALLOCATABLE :: CHECKG(:), IMGFREEZE(:) 78: LOGICAL, ALLOCATABLE :: CHECKG(:), IMGFREEZE(:)
 79: LOGICAL READIMAGET, GROUPACTIVE(NPERMGROUP), CHIRALACTIVE(NATOMS) 79: LOGICAL READIMAGET, GROUPACTIVE(NPERMGROUP), CHIRALACTIVE(NATOMS)
 80: INTEGER LUNIT, GETUNIT 80: INTEGER LUNIT, GETUNIT
 81: CHARACTER(LEN=2) SDUMMY 81: CHARACTER(LEN=2) SDUMMY
 82: INTEGER JMAXEEE,JMAXRMS 82: INTEGER JMAXEEE,JMAXRMS
 83: DOUBLE PRECISION MAXEEE,MAXRMS,MINEEE,SAVELOCALPERMCUT 83: DOUBLE PRECISION MAXEEE,MAXRMS,MINEEE,SAVELOCALPERMCUT
 84:  84: 
 85: WHOLEDNEB=.FALSE. 85: WHOLEDNEB=.FALSE.
 86: READIMAGET=.FALSE. 86: READIMAGET=.FALSE.
 87: REMOVEIMAGE=.FALSE. 87: REMOVEIMAGE=.FALSE.
 88: ECON=0.0D0; EREP=0.0D0; ESPRING=0.0D0 
 89:  88: 
 90: ! DO J1=1,NATOMS 89: ! DO J1=1,NATOMS
 91: !    WRITE(*,'(A,2I8)') 'intlbfgs> atom and residue: ',J1,ATOMSTORES(J1) 90: !    WRITE(*,'(A,2I8)') 'intlbfgs> atom and residue: ',J1,ATOMSTORES(J1)
 92: ! ENDDO 91: ! ENDDO
 93: ! STOP 92: ! STOP
 94: NCONOFF=0 93: NCONOFF=0
 95: AABACK(1:NATOMS)=.FALSE. 94: AABACK(1:NATOMS)=.FALSE.
 96: BACKDONE=.FALSE. 95: BACKDONE=.FALSE.
 97: IF (DOBACK) THEN 96: IF (DOBACK) THEN
 98:    LUNIT=GETUNIT() 97:    LUNIT=GETUNIT()
328:    WRITE(*,'(A)') ' intlbfgs> reading conactive'327:    WRITE(*,'(A)') ' intlbfgs> reading conactive'
329:    WRITE(*,'(A,I10,A)') ' intlbfgs> restart has ',NCONSTRAINT,' constraints'328:    WRITE(*,'(A,I10,A)') ' intlbfgs> restart has ',NCONSTRAINT,' constraints'
330:    ALLOCATE(CONACTIVE(NCONSTRAINT))329:    ALLOCATE(CONACTIVE(NCONSTRAINT))
331:    READ(LUNIT,*) CONACTIVE(1:NCONSTRAINT)330:    READ(LUNIT,*) CONACTIVE(1:NCONSTRAINT)
332: !  WRITE(*,'(12L5)') CONACTIVE(1:NCONSTRAINT) 331: !  WRITE(*,'(12L5)') CONACTIVE(1:NCONSTRAINT) 
333: 332: 
334:    ALLOCATE(CONDISTREFLOCAL(NCONSTRAINT))333:    ALLOCATE(CONDISTREFLOCAL(NCONSTRAINT))
335:    ALLOCATE(CONCUTLOCAL(NCONSTRAINT))334:    ALLOCATE(CONCUTLOCAL(NCONSTRAINT))
336:    CONDISTREFLOCAL(1:NCONSTRAINT)=CONDISTREF(1:NCONSTRAINT)335:    CONDISTREFLOCAL(1:NCONSTRAINT)=CONDISTREF(1:NCONSTRAINT)
337:    CONCUTLOCAL(1:NCONSTRAINT)=CONCUT(1:NCONSTRAINT)336:    CONCUTLOCAL(1:NCONSTRAINT)=CONCUT(1:NCONSTRAINT)
 337: !  WRITE(*,'(A)') ' intlbfgs> CONCUT:'
 338: !  WRITE(*,'(6G20.10)') CONCUT(1:NCONSTRAINT)
 339: !  WRITE(*,'(A)') ' intlbfgs> CONDISTREF:'
 340: !  WRITE(*,'(6G20.10)') CONDISTREF(1:NCONSTRAINT)
 341: !  WRITE(*,'(A)') ' intlbfgs> CONI:'
 342: !  WRITE(*,'(12I8)') CONI(1:NCONSTRAINT)
 343: !  WRITE(*,'(A)') ' intlbfgs> CONJ:'
 344: !  WRITE(*,'(12I8)') CONJ(1:NCONSTRAINT)
338: 345: 
339:    READ(LUNIT,*) NREPULSIVE,NNREPULSIVE,NREPMAX346:    READ(LUNIT,*) NREPULSIVE,NNREPULSIVE,NREPMAX
340:    USEFRAC=1.0D0347:    USEFRAC=1.0D0
341: !  WRITE(*,'(A,3I10,G20.10)') 'intlbfgs> NREPULSIVE,NNREPULSIVE,NREPMAX=',NREPULSIVE,NNREPULSIVE,NREPMAX348: !  WRITE(*,'(A,3I10,G20.10)') 'intlbfgs> NREPULSIVE,NNREPULSIVE,NREPMAX=',NREPULSIVE,NNREPULSIVE,NREPMAX
342:    IF (ALLOCATED(REPI)) DEALLOCATE(REPI)349:    IF (ALLOCATED(REPI)) DEALLOCATE(REPI)
343:    IF (ALLOCATED(REPJ)) DEALLOCATE(REPJ)350:    IF (ALLOCATED(REPJ)) DEALLOCATE(REPJ)
344:    IF (ALLOCATED(NREPI)) DEALLOCATE(NREPI)351:    IF (ALLOCATED(NREPI)) DEALLOCATE(NREPI)
345:    IF (ALLOCATED(NREPJ)) DEALLOCATE(NREPJ)352:    IF (ALLOCATED(NREPJ)) DEALLOCATE(NREPJ)
346:    IF (ALLOCATED(REPCUT)) DEALLOCATE(REPCUT)353:    IF (ALLOCATED(REPCUT)) DEALLOCATE(REPCUT)
347:    IF (ALLOCATED(NREPCUT)) DEALLOCATE(NREPCUT)354:    IF (ALLOCATED(NREPCUT)) DEALLOCATE(NREPCUT)
357: !  WRITE(*,'(12I8)') NREPI(1:NNREPULSIVE)364: !  WRITE(*,'(12I8)') NREPI(1:NNREPULSIVE)
358:    READ(LUNIT,*) NREPJ(1:NNREPULSIVE)365:    READ(LUNIT,*) NREPJ(1:NNREPULSIVE)
359:    WRITE(*,'(A)') ' intlbfgs> read NREPJ:'366:    WRITE(*,'(A)') ' intlbfgs> read NREPJ:'
360: !  WRITE(*,'(12I8)') NREPJ(1:NNREPULSIVE)367: !  WRITE(*,'(12I8)') NREPJ(1:NNREPULSIVE)
361:    READ(LUNIT,*) REPCUT(1:NREPULSIVE)368:    READ(LUNIT,*) REPCUT(1:NREPULSIVE)
362:    WRITE(*,'(A)') ' intlbfgs> read REPCUT:'369:    WRITE(*,'(A)') ' intlbfgs> read REPCUT:'
363: !  WRITE(*,'(6G20.10)') REPCUT(1:NREPULSIVE)370: !  WRITE(*,'(6G20.10)') REPCUT(1:NREPULSIVE)
364:    READ(LUNIT,*) NREPCUT(1:NNREPULSIVE)371:    READ(LUNIT,*) NREPCUT(1:NNREPULSIVE)
365:    WRITE(*,'(A)') ' intlbfgs> read NREPCUT:'372:    WRITE(*,'(A)') ' intlbfgs> read NREPCUT:'
366: !  WRITE(*,'(6G20.10)') NREPCUT(1:NNREPULSIVE)373: !  WRITE(*,'(6G20.10)') NREPCUT(1:NNREPULSIVE)
367:  
368:    READ(LUNIT,*) INTFROZEN(1:NATOMS)374:    READ(LUNIT,*) INTFROZEN(1:NATOMS)
369:    WRITE(*,'(A)') ' intlbfgs> read INTFROZEN'375:    WRITE(*,'(A)') ' intlbfgs> read INTFROZEN'
370: !  WRITE(*,'(12L5)') INTFROZEN(1:NATOMS)376: !  WRITE(*,'(12L5)') INTFROZEN(1:NATOMS)
371: 377: 
372:    NCONOFF=0378:    NCONOFF=0
373:    READ(LUNIT,*,END=742) NCONOFF379:    READ(LUNIT,*,END=742) NCONOFF
374:    IF (NCONOFF.GT.0) READ(LUNIT,*) CONOFFLIST(1:NCONOFF)380:    IF (NCONOFF.GT.0) READ(LUNIT,*) CONOFFLIST(1:NCONOFF)
375:    IF (NCONOFF.GT.0) READ(LUNIT,*) CONOFFTRIED(1:NCONSTRAINT)381:    IF (NCONOFF.GT.0) READ(LUNIT,*) CONOFFTRIED(1:NCONOFF)
376: 742 CONTINUE382: 742 CONTINUE
377:    CLOSE(LUNIT)383:    CLOSE(LUNIT)
378: 384: 
379:    GLAST(1:D)=G(1:D)385:    GLAST(1:D)=G(1:D)
380:    XSAVE(1:D)=X(1:D)386:    XSAVE(1:D)=X(1:D)
381:    GOTO 986387:    GOTO 986
382: ENDIF388: ENDIF
383: IF (INTFREEZET) THEN389: IF (INTFREEZET) THEN
384:    DO J1=1,NATOMS390:    DO J1=1,NATOMS
385:       IF (INTFROZEN(J1)) THEN391:       IF (INTFROZEN(J1)) THEN
626: 632: 
627: DO ! Main do loop with counter NITERDONE, initially set to one633: DO ! Main do loop with counter NITERDONE, initially set to one
628: 634: 
629: !635: !
630: ! Are we stuck? If so, try resetting problem atoms to previous image.636: ! Are we stuck? If so, try resetting problem atoms to previous image.
631: !637: !
632: IF (QCIRESET) THEN638: IF (QCIRESET) THEN
633: !  IF ((SWITCHED.AND.(MOD(NITERDONE-1,QCIRESETINT2).EQ.0)).OR.((.NOT.SWITCHED).AND.(MOD(NITERDONE-1,QCIRESETINT1).EQ.0))) THEN639: !  IF ((SWITCHED.AND.(MOD(NITERDONE-1,QCIRESETINT2).EQ.0)).OR.((.NOT.SWITCHED).AND.(MOD(NITERDONE-1,QCIRESETINT1).EQ.0))) THEN
634: !  PRINT *,'intlbfgs> NITERDONE,NLASTGOODE,QCIRESETINT1=',NITERDONE,NLASTGOODE,QCIRESETINT1640: !  PRINT *,'intlbfgs> NITERDONE,NLASTGOODE,QCIRESETINT1=',NITERDONE,NLASTGOODE,QCIRESETINT1
635:    IF ((.NOT.SWITCHED).AND.(NITERDONE-NLASTGOODE.GT.QCIRESETINT1)) THEN ! .AND.(NITERDONE-NLASTCHANGE.GT.QCIRESETINT1)) THEN641:    IF ((.NOT.SWITCHED).AND.(NITERDONE-NLASTGOODE.GT.QCIRESETINT1)) THEN ! .AND.(NITERDONE-NLASTCHANGE.GT.QCIRESETINT1)) THEN
636:       IF (DEBUG) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF)642:       CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF)
637:       IF (DEBUG) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)643:       CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)
638:       TURNOFF=.TRUE.644:       WRITE(*,'(2(A,I6))') 'intlbfgs> Interpolation seems to be stuck. Dump images. Turn off worst constraint ',JMAXCON, &
639:       IF (EREP.GT.2.0D0*ECON) THEN 
640:          INTCONSTRAINTREP=INTCONSTRAINTREP/2.0D0 
641:          WRITE(*,'(A,G20.10)') 'intlbfgs> Interpolation seems to be stuck. Reducing repulsive prefactor to ',INTCONSTRAINTREP 
642:          TURNOFF=.FALSE. 
643:       ENDIF 
644:       IF (ESPRING.GT.2.0D0*ECON) THEN 
645:          KINT=KINT/2.0D0 
646:          WRITE(*,'(A,G20.10)') 'intlbfgs> Interpolation seems to be stuck. Reducing spring constant to ',KINT 
647:          TURNOFF=.FALSE. 
648:       ENDIF 
649:       IF (TURNOFF) THEN 
650:          WRITE(*,'(2(A,I6))') 'intlbfgs> Interpolation seems to be stuck. Dump images. Turn off worst constraint ',JMAXCON, & 
651:   &                        ' total off=',NCONOFF+1645:   &                        ' total off=',NCONOFF+1
652:          IF ((JMAXCON.LT.1).OR.(JMAXCON.GT.NCONSTRAINT)) THEN646:       IF ((JMAXCON.LT.1).OR.(JMAXCON.GT.NCONSTRAINT)) THEN
653:             WRITE(*,'(A)') 'intlbfgs> *** ERROR *** constraint index out of allowed range'647:          WRITE(*,'(A)') 'intlbfgs> *** ERROR *** constraint index out of allowed range'
654:             WRITE(*,'(A,I6)') 'NCONSTRAINT,NCONOFF=',NCONOFF648:          WRITE(*,'(A,I6)') 'NCONSTRAINT,NCONOFF=',NCONOFF
655:             WRITE(*,'(A)') 'CONOFFTRIED:'649:          WRITE(*,'(A)') 'CONOFFTRIED:'
656:             WRITE(*,'(20L5)') CONOFFTRIED(1:NCONSTRAINT)650:          WRITE(*,'(20L5)') CONOFFTRIED(1:NCONSTRAINT)
657:             STOP651:          STOP
658:          ENDIF 
659:          NCONOFF=NCONOFF+1 
660:          CONOFFLIST(NCONOFF)=JMAXCON 
661:          CONACTIVE(JMAXCON)=.FALSE. 
662:          CONOFFTRIED(JMAXCON)=.TRUE. 
663:       ENDIF652:       ENDIF
664: 653:       NCONOFF=NCONOFF+1
 654:       CONOFFLIST(NCONOFF)=JMAXCON
 655:       CONACTIVE(JMAXCON)=.FALSE.
 656:       CONOFFTRIED(JMAXCON)=.TRUE.
665:       NLASTGOODE=NITERDONE657:       NLASTGOODE=NITERDONE
666:       LASTGOODE=ETOTAL658:       LASTGOODE=ETOTAL
667: !     IF (NITERDONE.GT.3123) STOP  !!!! DEBUG DJW659: !     IF (NITERDONE.GT.3123) STOP  !!!! DEBUG DJW
668: !     STOP660: !     STOP
669:    ENDIF661:    ENDIF
670: ENDIF662: ENDIF
671: 663: 
672: !664: !
673: !  Check permutational alignments. Maintain a list of the permutable groups where all665: !  Check permutational alignments. Maintain a list of the permutable groups where all
674: !  members are active. See if we have any new complete groups. MUST update NDUMMY666: !  members are active. See if we have any new complete groups. MUST update NDUMMY
677: IF (QCILPERMDIST.AND.(MOD(NITERDONE-1,QCIPDINT).EQ.0)) THEN669: IF (QCILPERMDIST.AND.(MOD(NITERDONE-1,QCIPDINT).EQ.0)) THEN
678: 670: 
679:    PRINT *,'DOING CHIRALCHECK NOW'671:    PRINT *,'DOING CHIRALCHECK NOW'
680:    CHIRALACTIVE(1:NATOMS)=.FALSE.672:    CHIRALACTIVE(1:NATOMS)=.FALSE.
681:    chicheck: DO J1=1,NATOMS673:    chicheck: DO J1=1,NATOMS
682:       IF (.NOT.ATOMACTIVE(J1)) CYCLE chicheck674:       IF (.NOT.ATOMACTIVE(J1)) CYCLE chicheck
683:       IF (NBONDED(J1).NE.4) CYCLE chicheck675:       IF (NBONDED(J1).NE.4) CYCLE chicheck
684:       DO J2=1,4676:       DO J2=1,4
685:          IF (.NOT.ATOMACTIVE(BONDEDLIST(J1,J2))) CYCLE chicheck677:          IF (.NOT.ATOMACTIVE(BONDEDLIST(J1,J2))) CYCLE chicheck
686:       ENDDO678:       ENDDO
 679:       IF (J1.EQ.1070) WRITE(*,'(A,I6,A)') 'intlbfgs> Active four-coordinate atom ',J1,' has four active neighbours'
687:       CHIRALACTIVE(J1)=.TRUE.680:       CHIRALACTIVE(J1)=.TRUE.
688:       DO J3=1,INTIMAGE+2681:       DO J3=1,INTIMAGE+2
689:          CENTRE_COORDS(1)=XYZ(3*NATOMS*(J3-1)+3*(J1-1)+1)682:          CENTRE_COORDS(1)=XYZ(3*NATOMS*(J3-1)+3*(J1-1)+1)
690:          CENTRE_COORDS(2)=XYZ(3*NATOMS*(J3-1)+3*(J1-1)+2)683:          CENTRE_COORDS(2)=XYZ(3*NATOMS*(J3-1)+3*(J1-1)+2)
691:          CENTRE_COORDS(3)=XYZ(3*NATOMS*(J3-1)+3*(J1-1)+3)684:          CENTRE_COORDS(3)=XYZ(3*NATOMS*(J3-1)+3*(J1-1)+3)
692: 685: 
693:          DO J4=1,4686:          DO J4=1,4
694:             J2=BONDEDLIST(J1,J4)687:             J2=BONDEDLIST(J1,J4)
695:             NEIGHBOUR_COORDS(3*(J4-1)+1)=XYZ(3*NATOMS*(J3-1)+3*(J2-1)+1)688:             NEIGHBOUR_COORDS(3*(J4-1)+1)=XYZ(3*NATOMS*(J3-1)+3*(J2-1)+1)
696:             NEIGHBOUR_COORDS(3*(J4-1)+2)=XYZ(3*NATOMS*(J3-1)+3*(J2-1)+2)689:             NEIGHBOUR_COORDS(3*(J4-1)+2)=XYZ(3*NATOMS*(J3-1)+3*(J2-1)+2)
697:             NEIGHBOUR_COORDS(3*(J4-1)+3)=XYZ(3*NATOMS*(J3-1)+3*(J2-1)+3)690:             NEIGHBOUR_COORDS(3*(J4-1)+3)=XYZ(3*NATOMS*(J3-1)+3*(J2-1)+3)
698:          ENDDO691:          ENDDO
699:          CHIRALSR=CHIRALITY_SR(NEIGHBOUR_COORDS,CENTRE_COORDS)692:          CHIRALSR=CHIRALITY_SR(NEIGHBOUR_COORDS,CENTRE_COORDS)
 693:          IF (J1.EQ.1070) WRITE(*,'(A,I6,A,I6,A,L5)') 'intlbfgs> Atom ',J1,' image ',J3,' chirality=',CHIRALSR
700:          IF ((J3.GT.1).AND.(CHIRALSR.NEQV.CHIRALSRP)) THEN694:          IF ((J3.GT.1).AND.(CHIRALSR.NEQV.CHIRALSRP)) THEN
701:             WRITE(*,'(A,I6,A,I6,A,I6)') 'intlbfgs> Atom ',J1,' image ',J3,' chirality CHANGED; use previous image coordinates'  695:             WRITE(*,'(A,I6,A,I6,A,I6)') 'intlbfgs> Atom ',J1,' image ',J3,' chirality CHANGED; use previous image coordinates'  
702:             NLASTCHANGE=NITERDONE696:             NLASTCHANGE=NITERDONE
703: !697: !
704: ! need to revert to whole aa coordinates, active atoms or not.698: ! need to revert to whole aa coordinates, active atoms or not.
705: !699: !
706:             ACID=ATOMSTORES(J1)700:             ACID=ATOMSTORES(J1)
707: 701: 
708:             DO J4=1,NATOMS702:             DO J4=1,NATOMS
709:                IF (ATOMSTORES(J4).NE.ACID) CYCLE703:                IF (ATOMSTORES(J4).NE.ACID) CYCLE
795:                      WRITE(*,'(A,I6,A,I6)') ' intlbfgs> inconsistent non-identity lopermdist permutations for start and finish'789:                      WRITE(*,'(A,I6,A,I6)') ' intlbfgs> inconsistent non-identity lopermdist permutations for start and finish'
796:                   ENDIF790:                   ENDIF
797:                ENDIF791:                ENDIF
798:             ENDDO792:             ENDDO
799:             XYZ(3*NATOMS*J3+1:3*NATOMS*(J3+1))=COORDSA(1:3*NATOMS)793:             XYZ(3*NATOMS*J3+1:3*NATOMS*(J3+1))=COORDSA(1:3*NATOMS)
800:          ENDIF794:          ENDIF
801:        ENDDO795:        ENDDO
802:     ENDDO np796:     ENDDO np
803:     LOCALPERMCUT=SAVELOCALPERMCUT797:     LOCALPERMCUT=SAVELOCALPERMCUT
804: 798: 
805: !   STOP  !!!! DEBUG DJW799: !STOP
806: ! 800: ! 
807: !    COORDSB(1:3*NATOMS)=XYZ(1:3*NATOMS) ! starting endpoint801: !    COORDSB(1:3*NATOMS)=XYZ(1:3*NATOMS) ! starting endpoint
808: !    COORDSC(1:3*NATOMS)=XYZ(3*NATOMS*(INTIMAGE+1)+1:3*NATOMS*(INTIMAGE+2)) ! finish endpoint802: !    COORDSC(1:3*NATOMS)=XYZ(3*NATOMS*(INTIMAGE+1)+1:3*NATOMS*(INTIMAGE+2)) ! finish endpoint
809: !    SAVELOCALPERMCUT=LOCALPERMCUT803: !    SAVELOCALPERMCUT=LOCALPERMCUT
810: ! !804: ! !
811: ! ! needs to be a bit sloppier than usual to allow for distorted geometries. Otherwise we may get wrong assignments805: ! ! needs to be a bit sloppier than usual to allow for distorted geometries. Otherwise we may get wrong assignments
812: ! ! because we don't have enough neighbours.806: ! ! because we don't have enough neighbours.
813: ! !807: ! !
814: !    LOCALPERMCUT=QCIPERMCUT ! 0.8D0 808: !    LOCALPERMCUT=QCIPERMCUT ! 0.8D0 
815: !    DO J3=1,INTIMAGE809: !    DO J3=1,INTIMAGE
937: !!                  ENDDO myrep2931: !!                  ENDDO myrep2
938: !!               ENDDO932: !!               ENDDO
939: !!               WRITE(*,'(A,I6,A)') ' intlbfgs> Now it looks like there are ',NREPULSIVE,' possible repulsions before adding new atom'933: !!               WRITE(*,'(A,I6,A)') ' intlbfgs> Now it looks like there are ',NREPULSIVE,' possible repulsions before adding new atom'
940: !!!!!!!!!!!!!!!DEBUG DJW !!!!!!!!!!!934: !!!!!!!!!!!!!!!DEBUG DJW !!!!!!!!!!!
941: 935: 
942:       IF (NCONOFF.GT.0) THEN936:       IF (NCONOFF.GT.0) THEN
943:          CONACTIVE(CONOFFLIST(NCONOFF))=.TRUE.937:          CONACTIVE(CONOFFLIST(NCONOFF))=.TRUE.
944:          WRITE(*,'(2(A,I6))') 'intlbfgs> Turn back on constraint ',CONOFFLIST(NCONOFF),' total off=',NCONOFF-1938:          WRITE(*,'(2(A,I6))') 'intlbfgs> Turn back on constraint ',CONOFFLIST(NCONOFF),' total off=',NCONOFF-1
945:          NCONOFF=NCONOFF-1939:          NCONOFF=NCONOFF-1
946:       ELSE940:       ELSE
947:          IF (DEBUG) WRITE(*,'(A)') 'intlbfgs> dump state before doaddatom index -2'941:          WRITE(*,'(A)') 'intlbfgs> dump state before doaddatom index -2'
948:          IF (DEBUG) CALL INTRWG2(NACTIVE,-2,INTIMAGE,XYZ,TURNONORDER,NCONOFF)942:          CALL INTRWG2(NACTIVE,-2,INTIMAGE,XYZ,TURNONORDER,NCONOFF)
949:          CALL DOADDATOM(NCONSTRAINT,NTRIES,NEWATOM,IMGFREEZE,INTIMAGE,XYZ,EEE,GGG,TURNONORDER,NITERDONE,NACTIVE,AABACK,BACKDONE)  943:          CALL DOADDATOM(NCONSTRAINT,NTRIES,NEWATOM,IMGFREEZE,INTIMAGE,XYZ,EEE,GGG,TURNONORDER,NITERDONE,NACTIVE,AABACK,BACKDONE)  
950:          IF (DEBUG) WRITE(*,'(A)') 'intlbfgs> dump state after doaddatom index -1'944:          WRITE(*,'(A)') 'intlbfgs> dump state after doaddatom index -1'
951:          IF (DEBUG) CALL INTRWG2(NACTIVE,-1,INTIMAGE,XYZ,TURNONORDER,NCONOFF)945:          CALL INTRWG2(NACTIVE,-1,INTIMAGE,XYZ,TURNONORDER,NCONOFF)
952:       ENDIF946:       ENDIF
953:       NLASTGOODE=NITERDONE947:       NLASTGOODE=NITERDONE
954:       LASTGOODE=ETOTAL948:       LASTGOODE=ETOTAL
955:    ENDIF949:    ENDIF
956:    GTMP(1:D)=0.0D0950:    GTMP(1:D)=0.0D0
957:    CALL MAKESTEP(NITERUSE,POINT,DIAG,INTIMAGE,SEARCHSTEP,G,GTMP,STP,GDIF,NPT,D,RHO1,ALPHA)951:    CALL MAKESTEP(NITERUSE,POINT,DIAG,INTIMAGE,SEARCHSTEP,G,GTMP,STP,GDIF,NPT,D,RHO1,ALPHA)
958: !952: !
959: ! If the number of images has changed since G was declared then G is not the same953: ! If the number of images has changed since G was declared then G is not the same
960: ! size as Gtmp and Dot_Product cannot be used.954: ! size as Gtmp and Dot_Product cannot be used.
961: !955: !
1542: !        IF (ETOTAL/INTIMAGE.GT.MAXCONE*MAX(0.3D0,NACTIVE*1.0D0/(NATOMS*1.0D0))) GOTO 7771536: !        IF (ETOTAL/INTIMAGE.GT.MAXCONE*MAX(0.3D0,NACTIVE*1.0D0/(NATOMS*1.0D0))) GOTO 777
1543:          PRINT '(A,3G20.10)','MAXEEE,MAXCONE,scaled=',MAXEEE,MAXCONE,MAXCONE*MAX(0.3D0,NACTIVE*1.0D0/(NATOMS*1.0D0))1537:          PRINT '(A,3G20.10)','MAXEEE,MAXCONE,scaled=',MAXEEE,MAXCONE,MAXCONE*MAX(0.3D0,NACTIVE*1.0D0/(NATOMS*1.0D0))
1544:          IF (MAXEEE.GT.MAXCONE*MAX(0.3D0,NACTIVE*1.0D0/(NATOMS*1.0D0))) GOTO 7771538:          IF (MAXEEE.GT.MAXCONE*MAX(0.3D0,NACTIVE*1.0D0/(NATOMS*1.0D0))) GOTO 777
1545:          IF (NACTIVE.LT.NATOMS) THEN 1539:          IF (NACTIVE.LT.NATOMS) THEN 
1546:             ADDATOM=.TRUE.1540:             ADDATOM=.TRUE.
1547:             GOTO 7771541:             GOTO 777
1548:          ENDIF1542:          ENDIF
1549:          CALL MYCPU_TIME(FTIME,.FALSE.)1543:          CALL MYCPU_TIME(FTIME,.FALSE.)
1550:          WRITE(*,'(A,I6,A,F12.6,A,I6,A,G20.10)') ' intlbfgs> switch on true potential at step ',NITERDONE, &1544:          WRITE(*,'(A,I6,A,F12.6,A,I6,A,G20.10)') ' intlbfgs> switch on true potential at step ',NITERDONE, &
1551:   &                                     ' fraction=',INTCONFRAC,' images=',INTIMAGE,' time=',FTIME-STIME1545:   &                                     ' fraction=',INTCONFRAC,' images=',INTIMAGE,' time=',FTIME-STIME
1552:          CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF)1546:          IF (DEBUG) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ,TURNONORDER,NCONOFF)
1553:          CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)1547:          IF (DEBUG) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE)
1554:          WRITE(*,'(A,I6,A,F15.6)') ' intlbfgs> Allowing ',INTCONSTEPS,' further optimization steps'1548:          WRITE(*,'(A,I6,A,F15.6)') ' intlbfgs> Allowing ',INTCONSTEPS,' further optimization steps'
1555:          DO J1=1,NATOMS1549:          DO J1=1,NATOMS
1556:             IF (.NOT.ATOMACTIVE(J1)) THEN1550:             IF (.NOT.ATOMACTIVE(J1)) THEN
1557:                WRITE(*,'(A,I6,A,I6,A)') ' intlbfgs> ERROR *** number of active atoms=',NACTIVE,' but atom ',J1,' is not active'1551:                WRITE(*,'(A,I6,A,I6,A)') ' intlbfgs> ERROR *** number of active atoms=',NACTIVE,' but atom ',J1,' is not active'
1558:             ENDIF1552:             ENDIF
1559:          ENDDO1553:          ENDDO
1560:          NSTEPSMAX=NITERDONE+INTCONSTEPS1554:          NSTEPSMAX=NITERDONE+INTCONSTEPS
1561:          SWITCHED=.TRUE.1555:          SWITCHED=.TRUE.
1562:          RMS=INTRMSTOL*10.0D0 ! to prevent premature convergence1556:          RMS=INTRMSTOL*10.0D0 ! to prevent premature convergence
1563:          G(1:(3*NATOMS)*INTIMAGE)=INTRMSTOL*10.0D01557:          G(1:(3*NATOMS)*INTIMAGE)=INTRMSTOL*10.0D0
1769: IF (DEBUG) WRITE(*,'(A,I10,A)') ' intlbfgs> dumping state for ',NACTIVE,' active atoms'1763: IF (DEBUG) WRITE(*,'(A,I10,A)') ' intlbfgs> dumping state for ',NACTIVE,' active atoms'
1770: WRITE(LUNIT,'(I10)') NACTIVE1764: WRITE(LUNIT,'(I10)') NACTIVE
1771: ! WRITE(*,'(A,I10,A)') ' intlbfgs> dumping turnonorder for ',NACTIVE,' active atoms'1765: ! WRITE(*,'(A,I10,A)') ' intlbfgs> dumping turnonorder for ',NACTIVE,' active atoms'
1772: WRITE(LUNIT,'(12I8)') TURNONORDER(1:NACTIVE)1766: WRITE(LUNIT,'(12I8)') TURNONORDER(1:NACTIVE)
1773: ! WRITE(*,'(A)') ' intlbfgs> dumping atomactive'1767: ! WRITE(*,'(A)') ' intlbfgs> dumping atomactive'
1774: WRITE(LUNIT,'(12L5)') ATOMACTIVE(1:NATOMS)1768: WRITE(LUNIT,'(12L5)') ATOMACTIVE(1:NATOMS)
1775: WRITE(LUNIT,'(I10)') NCONSTRAINT1769: WRITE(LUNIT,'(I10)') NCONSTRAINT
1776: ! WRITE(*,'(A,I10,A)') ' intlbfgs> dumping conactive for ',NCONSTRAINT,' constraints'1770: ! WRITE(*,'(A,I10,A)') ' intlbfgs> dumping conactive for ',NCONSTRAINT,' constraints'
1777: WRITE(LUNIT,'(12L5)') CONACTIVE(1:NCONSTRAINT)1771: WRITE(LUNIT,'(12L5)') CONACTIVE(1:NCONSTRAINT)
1778: 1772: 
1779: WRITE(LUNIT,'(3I12,G20.10)') NREPULSIVE,NNREPULSIVE,NREPMAX1773:    WRITE(LUNIT,'(3I12,G20.10)') NREPULSIVE,NNREPULSIVE,NREPMAX
1780: ! WRITE(*,'(A,3I10,G20.10)') 'intlbfgs> dumping NREPULSIVE,NNREPULSIVE,NREPMAX=',NREPULSIVE,NNREPULSIVE,NREPMAX1774:    ! WRITE(*,'(A,3I10,G20.10)') 'intlbfgs> dumping NREPULSIVE,NNREPULSIVE,NREPMAX=',NREPULSIVE,NNREPULSIVE,NREPMAX
1781: 1775: 
1782: WRITE(LUNIT,'(12I8)') REPI(1:NREPULSIVE)1776:    WRITE(LUNIT,'(12I8)') REPI(1:NREPULSIVE)
1783: ! WRITE(*,'(A)') ' intlbfgs> dumped REPI:'1777:    ! WRITE(*,'(A)') ' intlbfgs> dumped REPI:'
1784: WRITE(LUNIT,'(12I8)') REPJ(1:NREPULSIVE)1778:    WRITE(LUNIT,'(12I8)') REPJ(1:NREPULSIVE)
1785: ! WRITE(*,'(A)') ' intlbfgs> dumped REPJ:'1779:    ! WRITE(*,'(A)') ' intlbfgs> dumped REPJ:'
1786: WRITE(LUNIT,'(12I8)') NREPI(1:NNREPULSIVE)1780:    WRITE(LUNIT,'(12I8)') NREPI(1:NNREPULSIVE)
1787: ! WRITE(*,'(A)') ' intlbfgs> dumped NREPI:'1781:    ! WRITE(*,'(A)') ' intlbfgs> dumped NREPI:'
1788: WRITE(LUNIT,'(12I8)') NREPJ(1:NNREPULSIVE)1782:    WRITE(LUNIT,'(12I8)') NREPJ(1:NNREPULSIVE)
1789: ! WRITE(*,'(A)') ' intlbfgs> dumped NREPJ:'1783:    ! WRITE(*,'(A)') ' intlbfgs> dumped NREPJ:'
1790: 1784: 
1791: WRITE(LUNIT,'(6G20.10)') REPCUT(1:NREPULSIVE)1785:    WRITE(LUNIT,'(6G20.10)') REPCUT(1:NREPULSIVE)
1792: ! WRITE(*,'(A)') ' intlbfgs> dumped REPCUT:'1786:    ! WRITE(*,'(A)') ' intlbfgs> dumped REPCUT:'
1793: WRITE(LUNIT,'(6G20.10)') NREPCUT(1:NNREPULSIVE)1787:    WRITE(LUNIT,'(6G20.10)') NREPCUT(1:NNREPULSIVE)
1794: ! WRITE(*,'(A)') ' intlbfgs> dumped NREPCUT:'1788:    ! WRITE(*,'(A)') ' intlbfgs> dumped NREPCUT:'
1795: 1789: 
1796:    WRITE(LUNIT,'(12L5)') INTFROZEN(1:NATOMS)1790:    WRITE(LUNIT,'(12L5)') INTFROZEN(1:NATOMS)
1797:    ! WRITE(*,'(A)') ' intlbfgs> dumped INTFROZEN'1791:    ! WRITE(*,'(A)') ' intlbfgs> dumped INTFROZEN'
1798: 1792: 
1799:    WRITE(LUNIT,'(I8)') NCONOFF1793:    WRITE(LUNIT,'(I8)') NCONOFF
1800:    IF (NCONOFF.GT.0) WRITE(LUNIT,'(12I8)') CONOFFLIST(1:NCONOFF)1794:    IF (NCONOFF.GT.0) WRITE(LUNIT,'(12I8)') CONOFFLIST(1:NCONOFF)
1801:    IF (NCONOFF.GT.0) WRITE(LUNIT,'(12L5)') CONOFFTRIED(1:NCONSTRAINT)1795:    IF (NCONOFF.GT.0) WRITE(LUNIT,'(12L5)') CONOFFTRIED(1:NCONOFF)
1802:    ! WRITE(*,'(A)') ' intlbfgs> dumped NCONOFF and CONOFFLIST'1796:    ! WRITE(*,'(A)') ' intlbfgs> dumped NCONOFF and CONOFFLIST'
1803: 1797: 
1804: CLOSE(LUNIT)1798: CLOSE(LUNIT)
1805: 1799: 
1806: END SUBROUTINE INTRWG1800: END SUBROUTINE INTRWG
1807: 1801: 
1808: SUBROUTINE WRITEPROFILE(NITER,EEE,INTIMAGE)1802: SUBROUTINE WRITEPROFILE(NITER,EEE,INTIMAGE)
1809: IMPLICIT NONE 1803: IMPLICIT NONE 
1810: INTEGER,INTENT(IN) :: NITER, INTIMAGE1804: INTEGER,INTENT(IN) :: NITER, INTIMAGE
1811: INTEGER :: I,LUNIT,GETUNIT1805: INTEGER :: I,LUNIT,GETUNIT


r33451/key.f90 2017-11-09 15:30:09.406505791 +0000 r33450/key.f90 2017-11-09 15:30:10.290517503 +0000
107:      &        REDOK, REDOFRAC, D1INIT, D2INIT, REDOE1, REDOE2, RPBETA, REPCON, PFORCE, &107:      &        REDOK, REDOFRAC, D1INIT, D2INIT, REDOE1, REDOE2, RPBETA, REPCON, PFORCE, &
108:      &        CPCONSTRAINTTOL, CPCONSTRAINTDEL, CPCONSTRAINTREP, CPCONSTRAINREPCUT, CPCONFRAC, &108:      &        CPCONSTRAINTTOL, CPCONSTRAINTDEL, CPCONSTRAINTREP, CPCONSTRAINREPCUT, CPCONFRAC, &
109:      &        INTLJTOL, INTLJDEL, INTLJEPS, IMSEPMIN, IMSEPMAX, TRAPK, MINOVERLAP, &109:      &        INTLJTOL, INTLJDEL, INTLJEPS, IMSEPMIN, IMSEPMAX, TRAPK, MINOVERLAP, &
110:      &        INTFREEZETOL, LOCALPERMCUT, LOCALPERMCUT2, LOCALPERMCUTINC, CHECKREPCUTOFF, CONCUTABS, &110:      &        INTFREEZETOL, LOCALPERMCUT, LOCALPERMCUT2, LOCALPERMCUTINC, CHECKREPCUTOFF, CONCUTABS, &
111:      &        CONCUTFRAC, ENDNUMHESSDELTA, DNEBEFRAC, QCHEMSCALE, KAA, SIGMAAA, QUIPATOMMASS, TEMPERATURE1, &111:      &        CONCUTFRAC, ENDNUMHESSDELTA, DNEBEFRAC, QCHEMSCALE, KAA, SIGMAAA, QUIPATOMMASS, TEMPERATURE1, &
112:      &        DISTORTINST,DELTAINST,MOLPROSCALE,COVER,STTSRMSCONV,LAN_DIST,LANCONV,LANFACTOR, &112:      &        DISTORTINST,DELTAINST,MOLPROSCALE,COVER,STTSRMSCONV,LAN_DIST,LANCONV,LANFACTOR, &
113:      &        STOCKEXP, JPARAM, MCPATHTEMP, MCPATHDMAX, MCPATHSTEP, MCPATHACCRATIO, BIASFAC, &113:      &        STOCKEXP, JPARAM, MCPATHTEMP, MCPATHDMAX, MCPATHSTEP, MCPATHACCRATIO, BIASFAC, &
114:      &        MCADDDEV, MCPATHQMIN, MCPATHQMAX, RPHQMIN, RPHQMAX, RPHTEMP, TWISTF, TWISTREF, MCPATHADDREF, &114:      &        MCADDDEV, MCPATHQMIN, MCPATHQMAX, RPHQMIN, RPHQMAX, RPHTEMP, TWISTF, TWISTREF, MCPATHADDREF, &
115:      &        MCPATHGWS, MCPATHGWQ, MCPATHNEGLECT, MCPATHTOL, FRAMESDIFF,TMRATIO, INTMINFAC, MLPLAMBDA, COLL_TOL, KLIM, SCA, &115:      &        MCPATHGWS, MCPATHGWQ, MCPATHNEGLECT, MCPATHTOL, FRAMESDIFF,TMRATIO, INTMINFAC, MLPLAMBDA, COLL_TOL, KLIM, SCA, &
116:      &        NEBMAXERISE, GDSQ, FLATEDIFF, QCIADDREPCUT, QCIADDREPEPS, QCIRADSHIFT, INTCONCUT, MLQLAMBDA, FRQCONV, FRQCONV2, &116:      &        NEBMAXERISE, GDSQ, FLATEDIFF, QCIADDREPCUT, QCIADDREPEPS, QCIRADSHIFT, INTCONCUT, MLQLAMBDA, FRQCONV, FRQCONV2, &
117:      &        TANHFAC, LJADDCUTOFF,LJADDREFNORM,MAXIMFACTOR, PUSHOPTCONV, QCICYCDIST, QCIPERMCUT, KERNELWIDTH, QUIPLATT(3,3), &117:      &        TANHFAC, LJADDCUTOFF,LJADDREFNORM,MAXIMFACTOR, PUSHOPTCONV, QCICYCDIST, QCIPERMCUT, KERNELWIDTH, QUIPLATT(3,3)
118:      &        ECON, EREP, ESPRING 
119: 118: 
120: !     sf344119: !     sf344
121:       DOUBLE PRECISION :: PCUTOFF,PYA11(3),PYA21(3),PYA12(3),PYA22(3),PEPSILON1(3),PSCALEFAC1(2),PSCALEFAC2(2), &120:       DOUBLE PRECISION :: PCUTOFF,PYA11(3),PYA21(3),PYA12(3),PYA22(3),PEPSILON1(3),PSCALEFAC1(2),PSCALEFAC2(2), &
122:      &                     PEPSILONATTR(2),PSIGMAATTR(2), PYOVERLAPTHRESH, LJSITECOORDS(3), LJGSITESIGMA, LJGSITEEPS, &121:      &                     PEPSILONATTR(2),PSIGMAATTR(2), PYOVERLAPTHRESH, LJSITECOORDS(3), LJGSITESIGMA, LJGSITEEPS, &
123:      &                     PYLOCALSTEP(2),PYCFTHRESH,PYGRAVITYC1,PYGRAVITYC2,PERCCUT122:      &                     PYLOCALSTEP(2),PYCFTHRESH,PYGRAVITYC1,PYGRAVITYC2,PERCCUT
124:  123:  
125:       DOUBLE PRECISION, ALLOCATABLE :: PYADDEPS(:,:)124:       DOUBLE PRECISION, ALLOCATABLE :: PYADDEPS(:,:)
126:       DOUBLE PRECISION, ALLOCATABLE :: SHIFTL(:)125:       DOUBLE PRECISION, ALLOCATABLE :: SHIFTL(:)
127:       LOGICAL, ALLOCATABLE :: uniaxarray(:)126:       LOGICAL, ALLOCATABLE :: uniaxarray(:)
128:       DOUBLE PRECISION, ALLOCATABLE :: PYADDREP(:,:), PYADDATT(:,:)127:       DOUBLE PRECISION, ALLOCATABLE :: PYADDREP(:,:), PYADDATT(:,:)


r33451/lopermdist.f90 2017-11-09 15:30:09.626508704 +0000 r33450/lopermdist.f90 2017-11-09 15:30:10.514520466 +0000
 51: LOGICAL DEBUG, TWOD, RIGID, BULKT, PITEST, AOK, BOK, ADDED, PERMUTABLE(NATOMS), USEATOM 51: LOGICAL DEBUG, TWOD, RIGID, BULKT, PITEST, AOK, BOK, ADDED, PERMUTABLE(NATOMS), USEATOM
 52: DOUBLE PRECISION PDUMMYA(3*NATOMS), PDUMMYB(3*NATOMS), LDISTANCE, DUMMYC(3*NATOMS), XDUMMY, DUMMYD(3*NATOMS), & 52: DOUBLE PRECISION PDUMMYA(3*NATOMS), PDUMMYB(3*NATOMS), LDISTANCE, DUMMYC(3*NATOMS), XDUMMY, DUMMYD(3*NATOMS), &
 53:    &             LDBEST(NPERMGROUP), LDBESTATOM 53:    &             LDBEST(NPERMGROUP), LDBESTATOM
 54: DOUBLE PRECISION SPDUMMYA(3*NATOMS), SPDUMMYB(3*NATOMS), AINIT, BINIT 54: DOUBLE PRECISION SPDUMMYA(3*NATOMS), SPDUMMYB(3*NATOMS), AINIT, BINIT
 55: INTEGER NEWPERM(NATOMS), ALLPERM(NATOMS), SAVEPERM(NATOMS) 55: INTEGER NEWPERM(NATOMS), ALLPERM(NATOMS), SAVEPERM(NATOMS)
 56: DOUBLE PRECISION TIME0, TIME1 56: DOUBLE PRECISION TIME0, TIME1
 57: DOUBLE PRECISION, ALLOCATABLE :: TEMPA(:), TEMPB(:) 57: DOUBLE PRECISION, ALLOCATABLE :: TEMPA(:), TEMPB(:)
 58: CHARACTER(LEN=5) ZSYMSAVE 58: CHARACTER(LEN=5) ZSYMSAVE
 59: COMMON /SYS/ ZSYMSAVE 59: COMMON /SYS/ ZSYMSAVE
 60: DOUBLE PRECISION XA, XB, YA, YB, ZA, ZB, DMEAN(NATOMS), DA, DB 60: DOUBLE PRECISION XA, XB, YA, YB, ZA, ZB, DMEAN(NATOMS), DA, DB
 61: INTEGER TRIED(NATOMS), DLIST(NATOMS), SORTLIST(NATOMS), NDUMMY2, INGROUP(NATOMS), NADDED, DOGROUP 61: INTEGER TRIED(NATOMS), DLIST(NATOMS), SORTLIST(NATOMS), NDUMMY2, INGROUP(NATOMS), NADDED, DOGROUP, NDMEAN
 62:  62: 
 63: IF (DEBUG.AND.(DOGROUP.EQ.0)) THEN 63: IF (DEBUG.AND.(DOGROUP.EQ.0)) THEN
 64:    IF (CHRMMT) CALL UPDATENBONDS(COORDSA) 64:    IF (CHRMMT) CALL UPDATENBONDS(COORDSA)
 65:    CALL POTENTIAL(COORDSA,AINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.) 65:    CALL POTENTIAL(COORDSA,AINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
 66:    WRITE(*,'(2(A,G25.15))') ' initial energy for structure A=             ',AINIT,' RMS=',RMS 66:    WRITE(*,'(2(A,G25.15))') ' initial energy for structure A=             ',AINIT,' RMS=',RMS
 67:    IF (RMS-MAX(GMAX,CONVR).GT.1.0D-6) THEN 67:    IF (RMS-MAX(GMAX,CONVR).GT.1.0D-6) THEN
 68:       WRITE(*,'(A)') ' lopermdist> WARNING *** RMS for structure A is outside tolerance' 68:       WRITE(*,'(A)') ' lopermdist> WARNING *** RMS for structure A is outside tolerance'
 69:    ENDIF 69:    ENDIF
 70:    IF (CHRMMT) CALL UPDATENBONDS(COORDSB) 70:    IF (CHRMMT) CALL UPDATENBONDS(COORDSB)
 71:    CALL POTENTIAL(COORDSB,BINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.) 71:    CALL POTENTIAL(COORDSB,BINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
153: !153: !
154: ! TRIED(J2) is 0 if atom J2 is eligible to be a neighbour, but has not154: ! TRIED(J2) is 0 if atom J2 is eligible to be a neighbour, but has not
155: ! yet been tried. It is -1 if it is ineligible, or has been tried and155: ! yet been tried. It is -1 if it is ineligible, or has been tried and
156: ! broke the alignment. It is +1 if it has been tried and did not break156: ! broke the alignment. It is +1 if it has been tried and did not break
157: ! the alignment. It is -1 for atoms already in the set of permutable157: ! the alignment. It is -1 for atoms already in the set of permutable
158: ! atoms in question. We add neighbours one at a time in order of 158: ! atoms in question. We add neighbours one at a time in order of 
159: ! increasing distance from primary permutable set159: ! increasing distance from primary permutable set
160: ! and test whether they break the alignment.160: ! and test whether they break the alignment.
161: !161: !
162:    DMEAN(1:NATOMS)=1.0D10162:    DMEAN(1:NATOMS)=1.0D10
 163:    NDMEAN=0
163: !164: !
164: ! Make a sorted list of distance from the permuting atoms.165: ! Make a sorted list of distance from the permuting atoms.
165: ! DMEAN, SORTLIST, TRIED, PERMUTABLE, and DLIST entries refer to original166: ! DMEAN, SORTLIST, TRIED, PERMUTABLE, and DLIST entries refer to original
166: ! atom labels. Use NEWPERM to find where they are in coordinate lists.167: ! atom labels. Use NEWPERM to find where they are in coordinate lists.
167: !168: !
168:    outer1: DO J2=1,NATOMS169:    outer1: DO J2=1,NATOMS
169:       USEATOM=.TRUE.170:       USEATOM=.TRUE.
170:       IF (DOGROUP.GT.0) THEN171:       IF (DOGROUP.GT.0) THEN
171:          IF (.NOT.ATOMACTIVE(J2)) USEATOM=.FALSE. ! must not attempt to access atomactive unless DOGROUP.GT.0 - not allocated!172:          IF (.NOT.ATOMACTIVE(J2)) USEATOM=.FALSE. ! must not attempt to access atomactive unless DOGROUP.GT.0 - not allocated!
172:       ENDIF173:       ENDIF
173: !174: !
174: ! Don't allow members of the same permutational group 175: ! Don't allow members of the same permutational group 
175: ! to appear as reference neighbours.176: ! to appear as reference neighbours.
176: !177: !
177:       IF (TRIED(J2).EQ.-1) THEN178:       IF (TRIED(J2).EQ.-1) THEN
178:          XDUMMY=1.0D9179:          XDUMMY=1.0D9
 180:          CYCLE outer1
179:       ELSE181:       ELSE
180:          IF (.NOT.USEATOM) THEN ! only use active atoms for QCI single group182:          IF (.NOT.USEATOM) THEN ! only use active atoms for QCI single group
181:             XDUMMY=1.0D9183:             XDUMMY=1.0D9
 184:             CYCLE outer1
182:          ELSE185:          ELSE
183:             DA=(XA-DUMMYA(3*(NEWPERM(J2)-1)+1))**2 &186:             DA=(XA-DUMMYA(3*(NEWPERM(J2)-1)+1))**2 &
184:   &           +(YA-DUMMYA(3*(NEWPERM(J2)-1)+2))**2 &187:   &           +(YA-DUMMYA(3*(NEWPERM(J2)-1)+2))**2 &
185:   &           +(ZA-DUMMYA(3*(NEWPERM(J2)-1)+3))**2188:   &           +(ZA-DUMMYA(3*(NEWPERM(J2)-1)+3))**2
186: !           DB=(XB-DUMMYB(3*(NEWPERM(J2)-1)+1))**2 &189: !           DB=(XB-DUMMYB(3*(NEWPERM(J2)-1)+1))**2 &
187: ! &           +(YB-DUMMYB(3*(NEWPERM(J2)-1)+2))**2 &190: ! &           +(YB-DUMMYB(3*(NEWPERM(J2)-1)+2))**2 &
188: ! &           +(ZB-DUMMYB(3*(NEWPERM(J2)-1)+3))**2191: ! &           +(ZB-DUMMYB(3*(NEWPERM(J2)-1)+3))**2
189:             DB=(XB-DUMMYB(3*(J2-1)+1))**2 &192:             DB=(XB-DUMMYB(3*(J2-1)+1))**2 &
190:   &           +(YB-DUMMYB(3*(J2-1)+2))**2 &193:   &           +(YB-DUMMYB(3*(J2-1)+2))**2 &
191:   &           +(ZB-DUMMYB(3*(J2-1)+3))**2194:   &           +(ZB-DUMMYB(3*(J2-1)+3))**2
192:             XDUMMY=(SQRT(DA)+SQRT(DB))/2.0D0195:             XDUMMY=(SQRT(DA)+SQRT(DB))/2.0D0
 196:             IF (XDUMMY.GT.LOCALPERMCUT2) CYCLE outer1
193:          ENDIF197:          ENDIF
194:       ENDIF198:       ENDIF
195:       loop1: DO J3=1,J2199:       NDMEAN=NDMEAN+1
 200:       loop1: DO J3=1,NDMEAN ! J2
196:          IF (XDUMMY.LT.DMEAN(J3)) THEN201:          IF (XDUMMY.LT.DMEAN(J3)) THEN
197: !202: !
198: ! Move the rest down.203: ! Move the rest down.
199: !204: !
200:             DO J4=J2,J3+1,-1205:             DO J4=NDMEAN,J3+1,-1  !  J2,J3+1,-1
201:                DMEAN(J4)=DMEAN(J4-1)206:                DMEAN(J4)=DMEAN(J4-1)
202:                SORTLIST(J4)=SORTLIST(J4-1)207:                SORTLIST(J4)=SORTLIST(J4-1)
203:             ENDDO208:             ENDDO
204:             DMEAN(J3)=XDUMMY209:             DMEAN(J3)=XDUMMY
205:             SORTLIST(J3)=J2210:             SORTLIST(J3)=J2
206:             EXIT loop1211:             EXIT loop1
207:          ENDIF212:          ENDIF
208:       ENDDO loop1213:       ENDDO loop1
209:    ENDDO outer1214:    ENDDO outer1
210: 215: 
463: !  PRINT '(20I6)',NEWPERM(1:NATOMS)468: !  PRINT '(20I6)',NEWPERM(1:NATOMS)
464: 469: 
465: !470: !
466: ! Update NDUMMY, the cumulative offset for PERMGROUP471: ! Update NDUMMY, the cumulative offset for PERMGROUP
467: !472: !
468: 864   NDUMMY=NDUMMY+NPERMSIZE(J1)473: 864   NDUMMY=NDUMMY+NPERMSIZE(J1)
469: ENDDO  !  end of loop over groups of permutable atoms474: ENDDO  !  end of loop over groups of permutable atoms
470: 475: 
471: IF (DOGROUP.GT.0) THEN476: IF (DOGROUP.GT.0) THEN
472:    DISTANCE=SQRT(LDBEST(DOGROUP))477:    DISTANCE=SQRT(LDBEST(DOGROUP))
473:    NMOVE=0478:    IF (DEBUG) THEN
474:    DO J2=1,NATOMS479:       NMOVE=0
475:       IF (NEWPERM(J2).NE.J2) THEN480:       DO J2=1,NATOMS
476: !        WRITE(*,'(A,I6,A,I6)') ' lopermdist> need to move atom ',NEWPERM(J2),' to position ',J2481:          IF (NEWPERM(J2).NE.J2) THEN
477:          NMOVE=NMOVE+1482: !           WRITE(*,'(A,I6,A,I6)') ' lopermdist> need to move atom ',NEWPERM(J2),' to position ',J2
478:       ENDIF483:             NMOVE=NMOVE+1
479:    ENDDO484:          ENDIF
480: !  PRINT '(A,I6,A,I6)',' lopermdist> Total permutations (not applied!) for optimal alignment of group ',DOGROUP,' is ',NMOVE485:       ENDDO
 486: !     PRINT '(A,I6,A,I6)',' lopermdist> Total permutations (not applied!) for optimal alignment of group ',DOGROUP,' is ',NMOVE
 487:    ENDIF
481:    RETURN488:    RETURN
482: ENDIF489: ENDIF
483: NMOVE=0490: NMOVE=0
484: ! DO J2=1,NATOMS491: ! DO J2=1,NATOMS
485: !    IF (NEWPERM(J2).NE.J2) THEN492: !    IF (NEWPERM(J2).NE.J2) THEN
486: !       WRITE(*,'(A,I6,A,I6)') ' lopermdist> need to move atom ',NEWPERM(J2),' to position ',J2493: !       WRITE(*,'(A,I6,A,I6)') ' lopermdist> need to move atom ',NEWPERM(J2),' to position ',J2
487: !       NMOVE=NMOVE+1494: !       NMOVE=NMOVE+1
488: !    ENDIF495: !    ENDIF
489: ! ENDDO496: ! ENDDO
490:   IF (DEBUG) PRINT '(A,I6)',' lopermdist> Total permutations for optimal alignment (will be applied)=',NMOVE497:   IF (DEBUG) PRINT '(A,I6)',' lopermdist> Total permutations for optimal alignment (will be applied)=',NMOVE


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0