hdiff output

r32832/commons.f90 2017-06-22 17:30:25.429132691 +0100 r32831/commons.f90 2017-06-22 17:30:28.597175961 +0100
 33: ! 33: !
 34: ! MAXMIN 34: ! MAXMIN
 35: ! 35: !
 36:       DOUBLE PRECISION, ALLOCATABLE :: EMIN(:), FVIBMIN(:), PFMIN(:), IXMIN(:),  IYMIN(:), IZMIN(:), & 36:       DOUBLE PRECISION, ALLOCATABLE :: EMIN(:), FVIBMIN(:), PFMIN(:), IXMIN(:),  IYMIN(:), IZMIN(:), &
 37:      &                                 GPFOLD(:), MINDISTMIN(:), MINCURVE(:), MINFRQ2(:) 37:      &                                 GPFOLD(:), MINDISTMIN(:), MINCURVE(:), MINFRQ2(:)
 38: ! 38: !
 39: ! Changed PAIRDIST to linear scaling rather than quadratic with MAXMIN. DJW 14/4/08 39: ! Changed PAIRDIST to linear scaling rather than quadratic with MAXMIN. DJW 14/4/08
 40: ! 40: !
 41:       DOUBLE PRECISION, ALLOCATABLE :: PAIRDIST(:,:) ! dimension MAXMIN*PAIRDISTMAX for DIJINITT only runs 41:       DOUBLE PRECISION, ALLOCATABLE :: PAIRDIST(:,:) ! dimension MAXMIN*PAIRDISTMAX for DIJINITT only runs
 42:       INTEGER, ALLOCATABLE :: PAIRLIST(:,:) ! dimension MAXMIN*PAIRDISTMAX for DIJINITT only runs 42:       INTEGER, ALLOCATABLE :: PAIRLIST(:,:) ! dimension MAXMIN*PAIRDISTMAX for DIJINITT only runs
 43:       DOUBLE PRECISION, ALLOCATABLE :: ALLPAIRS(:) ! dimension (MAXMIN+2)(MAXMIN-1)/2 for INITIALDISTANCE runs. Scales quadratically! 
 44: ! 43: !
 45: ! MAXTS 44: ! MAXTS
 46: ! 45: !
 47:       DOUBLE PRECISION, ALLOCATABLE :: ETS(:), FVIBTS(:), KPLUS(:), KMINUS(:), IXTS(:),  IYTS(:), IZTS(:), NEGEIG(:) 46:       DOUBLE PRECISION, ALLOCATABLE :: ETS(:), FVIBTS(:), KPLUS(:), KMINUS(:), IXTS(:),  IYTS(:), IZTS(:), NEGEIG(:)
 48: ! NATOMS 47: ! NATOMS
 49:       DOUBLE PRECISION, ALLOCATABLE :: TAGFAC(:) 48:       DOUBLE PRECISION, ALLOCATABLE :: TAGFAC(:)
 50: ! NRWBINS 49: ! NRWBINS
 51:       DOUBLE PRECISION, ALLOCATABLE :: RWPROB(:) 50:       DOUBLE PRECISION, ALLOCATABLE :: RWPROB(:)
 52:  51: 
 53:       DOUBLE PRECISION EDIFFTOL, IDIFFTOL, GEOMDIFFTOL, PFMEAN, TOTALE, TEMPERATURE, PFTOTALA, PFTOTALB, PERTMAX, PERTMIN, & 52:       DOUBLE PRECISION EDIFFTOL, IDIFFTOL, GEOMDIFFTOL, PFMEAN, TOTALE, TEMPERATURE, PFTOTALA, PFTOTALB, PERTMAX, PERTMIN, &
 55:      &                 ORDERPARAM, BOXLX, BOXLY, BOXLZ, DSCALE, PSCALE, TSTHRESH, MAXBARRIER, MAXDOWNBARRIER, REGROUPPETHRESH, & 54:      &                 ORDERPARAM, BOXLX, BOXLY, BOXLZ, DSCALE, PSCALE, TSTHRESH, MAXBARRIER, MAXDOWNBARRIER, REGROUPPETHRESH, &
 56:      &                 PAIRTHRESH, MAXBREAK, PRODTHRESH, PBTHRESH, OMEGA, EINC, EDELTAMIN, ELOWBAR, RWBINWIDTH, RWEMAX, RWEMIN, & 55:      &                 PAIRTHRESH, MAXBREAK, PRODTHRESH, PBTHRESH, OMEGA, EINC, EDELTAMIN, ELOWBAR, RWBINWIDTH, RWEMAX, RWEMIN, &
 57:      &                 GT2RSwitch, GT2Ptol, EUNTRAPTHRESH, PLANCK, REGROUPFREETHRESH, FREETHRESH, EHIGHBAR, BAILDIST, & 56:      &                 GT2RSwitch, GT2Ptol, EUNTRAPTHRESH, PLANCK, REGROUPFREETHRESH, FREETHRESH, EHIGHBAR, BAILDIST, &
 58:      &                 BHACCREJ, BHSTEPSIZE, BHCONV, BHTEMP, BHDISTTHRESH, BHK, BHMAXENERGY, BHSFRAC, & 57:      &                 BHACCREJ, BHSTEPSIZE, BHCONV, BHTEMP, BHDISTTHRESH, BHK, BHMAXENERGY, BHSFRAC, &
 59:      &                 BISECTMINDIST, BISECTMAXENERGY, NKMCCYCLES, NGTSWITCH, NTFOLD, TOMEGA, TFOLDTHRESH, DIAGSCALE, & 58:      &                 BISECTMINDIST, BISECTMAXENERGY, NKMCCYCLES, NGTSWITCH, NTFOLD, TOMEGA, TFOLDTHRESH, DIAGSCALE, &
 60:      &                 CVTMIN, CVTMAX, CVTINC, DOSEMIN, DOSEMAX, DOSEINC, EVCUT, GAMMAFRICTION, & 59:      &                 CVTMIN, CVTMAX, CVTINC, DOSEMIN, DOSEMAX, DOSEINC, EVCUT, GAMMAFRICTION, &
 61:      &                 INTEPSILON, INTCONSTRAINTDEL, INTCONSTRAINTREP, INTCONSTRAINREPCUT, INTLJDEL, INTLJEPS, NGTCRSWITCH, & 60:      &                 INTEPSILON, INTCONSTRAINTDEL, INTCONSTRAINTREP, INTCONSTRAINREPCUT, INTLJDEL, INTLJEPS, NGTCRSWITCH, &
 62:      &                 PFOLDCONV, INTFREEZETOL, LOCALPERMCUT, ORBITTOL, PFORCE, LPDGEOMDIFFTOL, LOCALPERMCUT2,& 61:      &                 PFOLDCONV, INTFREEZETOL, LOCALPERMCUT, ORBITTOL, PFORCE, LPDGEOMDIFFTOL, LOCALPERMCUT2,&
 63:      &                 SLEEPTIME1, SLEEPTIME2, RATETARGETAB, RATETARGETBA, RATETARGETFRAC, RFMULTITLOW, RFMULTITINC, TIMESCALE, & 62:      &                 SLEEPTIME1, SLEEPTIME2, RATETARGETAB, RATETARGETBA, RATETARGETFRAC, RFMULTITLOW, RFMULTITINC, TIMESCALE, &
 64:      &                 PFSHIFT, MICROEMIN, MICROEMAX, MICROEINC, MICROT, RFKMCTRATE, RFKMCTINC, RFKMCTSTART, JPARAM, PEQTHRESH, & 63:      &                 PFSHIFT, MICROEMIN, MICROEMAX, MICROEINC, MICROT, RFKMCTRATE, RFKMCTINC, RFKMCTSTART, JPARAM, PEQTHRESH, &
 65:      &                 PERTHRESH, SHANNONTMIN, SHANNONTMAX, SHANNONTINC, RATEAB, RATEBA, MINBARRIER, DISBOUND 64:      &                 PERTHRESH, SHANNONTMIN, SHANNONTMAX, SHANNONTINC, RATEAB, RATEBA, MINBARRIER
 66:  65: 
 67:  66: 
 68: ! AMH 67: ! AMH
 69:       DOUBLE PRECISION QCONTCUT, RELCOCUT 68:       DOUBLE PRECISION QCONTCUT, RELCOCUT
 70:  69: 
 71:       DOUBLE PRECISION, PARAMETER :: PI=3.141592654D0 70:       DOUBLE PRECISION, PARAMETER :: PI=3.141592654D0
 72:       DOUBLE PRECISION TTSSEARCH, TPFOLD, TTFOLD, TGT, TDIJKSTRA, TCONNECTDIST, TKSHORTESTPATHS ! timers 71:       DOUBLE PRECISION TTSSEARCH, TPFOLD, TTFOLD, TGT, TDIJKSTRA, TCONNECTDIST, TKSHORTESTPATHS ! timers
 73:  72: 
 74: ! MAXMIN 73: ! MAXMIN
 75:       INTEGER, ALLOCATABLE :: HORDERMIN(:), TOPPOINTER(:), MINGROUP(:), MINCONN(:) 74:       INTEGER, ALLOCATABLE :: HORDERMIN(:), TOPPOINTER(:), MINGROUP(:), MINCONN(:)
102:      &        DUMPGROUPST, FREEPAIRT, KSHORTESTPATHST, KSHORT_FULL_PRINTT, DIJINITFLYT, BHINTERPT, ICINTERPT, &101:      &        DUMPGROUPST, FREEPAIRT, KSHORTESTPATHST, KSHORT_FULL_PRINTT, DIJINITFLYT, BHINTERPT, ICINTERPT, &
103:      &        DUMMYTST, DOCKT, DSTAGE(6), USEPAIRST, LOWESTFRQT, BISECTT, NGTDISCONNECTALL, ANGLEAXIS2, MULTISITEPYT, TFOLDT, &102:      &        DUMMYTST, DOCKT, DSTAGE(6), USEPAIRST, LOWESTFRQT, BISECTT, NGTDISCONNECTALL, ANGLEAXIS2, MULTISITEPYT, TFOLDT, &
104:      &        SLURMT, INDEXCOSTFUNCTION, CVT, CVMINIMAT, DOST, IMFRQT, CLOSEFILEST, PULLT, FRICTIONT, ATOMMATCHFULL, &103:      &        SLURMT, INDEXCOSTFUNCTION, CVT, CVMINIMAT, DOST, IMFRQT, CLOSEFILEST, PULLT, FRICTIONT, ATOMMATCHFULL, &
105:      &        INTCONSTRAINTT, CHECKCONINT, INTLJT, INTERPCOSTFUNCTION, REMOVEUNCONNECTEDT, ATOMMATCHDIST, &104:      &        INTCONSTRAINTT, CHECKCONINT, INTLJT, INTERPCOSTFUNCTION, REMOVEUNCONNECTEDT, ATOMMATCHDIST, &
106:      &        DBPT, DBPTDT, DMBLPYT, EFIELDT, MSSTOCKT, NTIPT, PAHAT, PAPT, PATCHYDT, STOCKAAT, RBAAT, RBSYMT, TRAPT, SILANET, &105:      &        DBPT, DBPTDT, DMBLPYT, EFIELDT, MSSTOCKT, NTIPT, PAHAT, PAPT, PATCHYDT, STOCKAAT, RBAAT, RBSYMT, TRAPT, SILANET, &
107:      &        OHCELLT, INTFREEZET, LPERMDIST, PBST, RANDOMMETRICT, SSHT, ALLTST, USERPOTT, CHECKMINT, &106:      &        OHCELLT, INTFREEZET, LPERMDIST, PBST, RANDOMMETRICT, SSHT, ALLTST, USERPOTT, CHECKMINT, &
108:      &        CHECKTST, CHECKSPT, FROMLOWESTT, ADDMINXYZT, MACHINE, RATESCYCLET, NOINVERSION, NEWCONNECTIONST, NIMET, NIHEAM7T, &107:      &        CHECKTST, CHECKSPT, FROMLOWESTT, ADDMINXYZT, MACHINE, RATESCYCLET, NOINVERSION, NEWCONNECTIONST, NIMET, NIHEAM7T, &
109:      &        NIH2LEPST, DISTANCET, RATETARGETT, TARGETHIT, ALLOWABT, MICROTHERMT, RFKMCT, REGROUPKMCT, ONEREGROUPT, PHI4MODT, &108:      &        NIH2LEPST, DISTANCET, RATETARGETT, TARGETHIT, ALLOWABT, MICROTHERMT, RFKMCT, REGROUPKMCT, ONEREGROUPT, PHI4MODT, &
110:      &        PERSISTT, REGROUPPERSISTT, NOLABELST, SHANNONT, MAKEPAIRS, SKIPPAIRST, PERSISTAPPROXT, ALLCOMPONENTST, &109:      &        PERSISTT, REGROUPPERSISTT, NOLABELST, SHANNONT, MAKEPAIRS, SKIPPAIRST, PERSISTAPPROXT, ALLCOMPONENTST, &
111:      &        SHANNONRT, SHANNONZT, CUDAT, MLLJAT3, MLP3T, DIJPRUNET, PRINTSUMMARYT, MKTRAPT, MLPB3T, PRUNECYCLET, PAIRSIGNORET, &110:      &        SHANNONRT, SHANNONZT, CUDAT, MLLJAT3, MLP3T, DIJPRUNET, PRINTSUMMARYT, MKTRAPT, MLPB3T, PRUNECYCLET, PAIRSIGNORET, &
112:      &        NOTRANSROTT, NOPOINTGROUPT, MACROIONT, CONNECTPAIRST, INITIALDIST111:      &        NOTRANSROTT, NOPOINTGROUPT, MACROIONT, CONNECTPAIRST
113: 112: 
114:       LOGICAL, ALLOCATABLE :: SHIFTABLE(:)113:       LOGICAL, ALLOCATABLE :: SHIFTABLE(:)
115:       CHARACTER(LEN=80) COORDSLIGANDSTR, COORDSCOMPLEXSTR, COORDSPROTEINSTR114:       CHARACTER(LEN=80) COORDSLIGANDSTR, COORDSCOMPLEXSTR, COORDSPROTEINSTR
116:       CHARACTER(LEN=80) EXEC,EXECGMIN115:       CHARACTER(LEN=80) EXEC,EXECGMIN
117:       CHARACTER(LEN=80) PATHNAME, MINNAME, ADDMINXYZNAME, ALLCOMPS116:       CHARACTER(LEN=80) PATHNAME, MINNAME, ADDMINXYZNAME, ALLCOMPS
118:       CHARACTER(LEN=150) COPYFILES117:       CHARACTER(LEN=150) COPYFILES
119:       CHARACTER(LEN=80) USEPAIRSFILE118:       CHARACTER(LEN=80) USEPAIRSFILE
120:       CHARACTER(LEN=80) CONNECTPAIRSFILE119:       CHARACTER(LEN=80) CONNECTPAIRSFILE
121:       CHARACTER(LEN=80) MAKEPAIRSFILE120:       CHARACTER(LEN=80) MAKEPAIRSFILE
122:       CHARACTER(LEN=2) DIRECTION121:       CHARACTER(LEN=2) DIRECTION


r32832/Dijinit.f90 2017-06-22 17:30:24.977126606 +0100 r32831/Dijinit.f90 2017-06-22 17:30:27.441159781 +0100
 21: ! 21: !
 22: !  Dijkstra connection algorithm for pathsample. 22: !  Dijkstra connection algorithm for pathsample.
 23: ! 23: !
 24: SUBROUTINE DIJINIT(NWORST) 24: SUBROUTINE DIJINIT(NWORST)
 25: USE PORFUNCS 25: USE PORFUNCS
 26: USE COMMONS 26: USE COMMONS
 27: USE UTILS,ONLY : GETUNIT 27: USE UTILS,ONLY : GETUNIT
 28: IMPLICIT NONE 28: IMPLICIT NONE
 29:  29: 
 30: INTEGER J1, J2, J4, PARENT(NMIN), JMINW, NPERM, J5, LJ1, LJ2, NWORST, NSTEPS, NMINSTART, NMINEND, J6, MUNIT, J7 30: INTEGER J1, J2, J4, PARENT(NMIN), JMINW, NPERM, J5, LJ1, LJ2, NWORST, NSTEPS, NMINSTART, NMINEND, J6, MUNIT, J7
 31: INTEGER JN, JM, NPOSITION, LUNIT 
 32: INTEGER NMINGAP, NPRUNEDONE, NPRUNEPAIRS, NPRUNEMIN,NPRUNEPAIRSOLD 31: INTEGER NMINGAP, NPRUNEDONE, NPRUNEPAIRS, NPRUNEMIN,NPRUNEPAIRSOLD
 33: INTEGER, ALLOCATABLE :: LOCATIONSTART(:), LOCATIONEND(:), PRUNEPAIRS(:,:) 32: INTEGER, ALLOCATABLE :: LOCATIONSTART(:), LOCATIONEND(:), PRUNEPAIRS(:,:)
 34: LOGICAL PERMANENT(NMIN), ISA(NMIN), ISB(NMIN), ISSTART(NMIN), NOTDONE, PRUNEMIN(NMIN), REDODIJKSTRA 33: LOGICAL PERMANENT(NMIN), ISA(NMIN), ISB(NMIN), ISSTART(NMIN), NOTDONE, PRUNEMIN(NMIN)
 35: DOUBLE PRECISION MINWEIGHT, DUMMY, TNEW, ELAPSED, PFTOTALSTART, HUGESAVE, THRESH, LPOINTS1(NOPT), LPOINTS2(NOPT) 34: DOUBLE PRECISION MINWEIGHT, DUMMY, TNEW, ELAPSED, PFTOTALSTART, HUGESAVE, THRESH
 36: DOUBLE PRECISION MAXWEIGHT, SCALEFAC, PDMAX, PD, MINGAPTHRESH, DIST2, DISTANCE, RMAT(3,3) 35: DOUBLE PRECISION MAXWEIGHT, SCALEFAC, PDMAX, PD, MINGAPTHRESH
 37: ! 36: !
 38: ! KIND=16 is not supported by Portland. If you want extra precision, uncomment the following line 37: ! KIND=16 is not supported by Portland. If you want extra precision, uncomment the following line
 39: ! and use NAG. 38: ! and use NAG.
 40: ! 39: !
 41: ! REAL(KIND=16) :: TMPWEIGHT, WEIGHT(NMIN) 40: ! REAL(KIND=16) :: TMPWEIGHT, WEIGHT(NMIN)
 42: REAL(KIND=8) :: TMPWEIGHT, WEIGHT(NMIN) 41: REAL(KIND=8) :: TMPWEIGHT, WEIGHT(NMIN)
 43:  42: 
 44: IF (DIJPRUNET) THEN 43: IF (DIJPRUNET) THEN
 45:    MUNIT=GETUNIT() 44:    MUNIT=GETUNIT()
 46:    IF (.NOT.(PRUNECYCLET)) NPRUNE=1 45:    IF (.NOT.(PRUNECYCLET)) NPRUNE=1
 64: IF (DIJPRUNET) NPRUNEPAIRSOLD=NPRUNEPAIRS 63: IF (DIJPRUNET) NPRUNEPAIRSOLD=NPRUNEPAIRS
 65:  64: 
 66: !!!!!!!!!!!!!!!!!!!   Dijkstra calculation    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 65: !!!!!!!!!!!!!!!!!!!   Dijkstra calculation    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 67: ! 66: !
 68: !  Dijkstra connect process similar to that in OPTIM with a weight for missing 67: !  Dijkstra connect process similar to that in OPTIM with a weight for missing
 69: !  connections based on a distance metric. 68: !  connections based on a distance metric.
 70: ! 69: !
 71: IF (DIRECTION.EQ.'AB') THEN 70: IF (DIRECTION.EQ.'AB') THEN
 72:    NMINSTART=NMINB 71:    NMINSTART=NMINB
 73:    NMINEND=NMINA 72:    NMINEND=NMINA
 74:    IF (ALLOCATED(LOCATIONSTART)) DEALLOCATE(LOCATIONSTART,LOCATIONEND) 
 75:    ALLOCATE(LOCATIONSTART(NMINB),LOCATIONEND(NMINA)) 73:    ALLOCATE(LOCATIONSTART(NMINB),LOCATIONEND(NMINA))
 76:    LOCATIONSTART(1:NMINB)=LOCATIONB(1:NMINB) 74:    LOCATIONSTART(1:NMINB)=LOCATIONB(1:NMINB)
 77:    LOCATIONEND(1:NMINA)=LOCATIONA(1:NMINA) 75:    LOCATIONEND(1:NMINA)=LOCATIONA(1:NMINA)
 78:    ISSTART(1:NMIN)=ISB(1:NMIN) 76:    ISSTART(1:NMIN)=ISB(1:NMIN)
 79:    PFTOTALSTART=PFTOTALB 77:    PFTOTALSTART=PFTOTALB
 80: ELSEIF (DIRECTION.EQ.'BA') THEN 78: ELSEIF (DIRECTION.EQ.'BA') THEN
 81:    NMINSTART=NMINA 79:    NMINSTART=NMINA
 82:    NMINEND=NMINB 80:    NMINEND=NMINB
 83:    ALLOCATE(LOCATIONSTART(NMINA),LOCATIONEND(NMINB)) 81:    ALLOCATE(LOCATIONSTART(NMINA),LOCATIONEND(NMINB))
 84:    LOCATIONSTART(1:NMINA)=LOCATIONA(1:NMINA) 82:    LOCATIONSTART(1:NMINA)=LOCATIONA(1:NMINA)
 85:    LOCATIONEND(1:NMINB)=LOCATIONB(1:NMINB) 83:    LOCATIONEND(1:NMINB)=LOCATIONB(1:NMINB)
 86:    ISSTART(1:NMIN)=ISA(1:NMIN) 84:    ISSTART(1:NMIN)=ISA(1:NMIN)
 87:    PFTOTALSTART=PFTOTALA 85:    PFTOTALSTART=PFTOTALA
 88: ENDIF 86: ENDIF
 89:  87: 
 90: 642 CONTINUE ! return here for REDODIJKSTRA 
 91: PDMAX=-1.0D0 88: PDMAX=-1.0D0
 92: IF (INITIALDIST) THEN 89: DO J2=1,NMIN
 93:    DO J2=1,(NMIN*(NMIN-1))/2 90:    DO J5=1,PAIRDISTMAX
 94:       IF (ABS(ALLPAIRS(J2)).GT.PDMAX) THEN 91:       IF (PAIRDIST(J2,J5).GT.PDMAX) THEN
 95:          PDMAX=ABS(ALLPAIRS(J2)) 92:          PDMAX=PAIRDIST(J2,J5)
 96: !        IF (DEBUG) PRINT '(A,G20.10)','Dijinit> maximum neighbour metric value increased to',PDMAX  93: !        IF (DEBUG) PRINT '(A,G20.10)','Dijinit> maximum neighbour metric value increased to',PDMAX 
 97: !        IF (DEBUG) PRINT '(A,I8,G20.10)','Dijinit> J2,ALLPAIRS=',J2,ALLPAIRS(J2) 94: !        IF (DEBUG) PRINT '(A,2I8,G20.10)','Dijinit> J2,J5,PAIRDIST=',J2,J5,PAIRDIST(J2,J5)
 98:       ENDIF 95:       ENDIF
 99:    ENDDO 96:    ENDDO
100: ELSE 97: ENDDO
101:    DO J2=1,NMIN 98: PRINT '(A,G20.10)','Dijinit> maximum neighbour metric value=',PDMAX
102:       DO J5=1,PAIRDISTMAX 
103:          IF (PAIRDIST(J2,J5).GT.PDMAX) THEN 
104:             PDMAX=PAIRDIST(J2,J5) 
105: !           IF (DEBUG) PRINT '(A,G20.10)','Dijinit> maximum neighbour metric value increased to',PDMAX  
106: !           IF (DEBUG) PRINT '(A,2I8,G20.10)','Dijinit> J2,J5,PAIRDIST=',J2,J5,PAIRDIST(J2,J5) 
107:          ENDIF 
108:       ENDDO 
109:    ENDDO 
110:    PRINT '(A,G20.10)','Dijinit> maximum neighbour metric value=',PDMAX 
111: ENDIF 
112:  99: 
113: IF (MINGAPT) THEN100: IF (MINGAPT) THEN
114:    IF (MINGAPRATIOT) THEN101:    IF (MINGAPRATIOT) THEN
115:       MINGAPTHRESH=PDMAX*MINGAPINP102:       MINGAPTHRESH=PDMAX*MINGAPINP
116:    ELSE103:    ELSE
117:       MINGAPTHRESH=MINGAPINP104:       MINGAPTHRESH=MINGAPINP
118:    ENDIF105:    ENDIF
119: ENDIF106: ENDIF
120: 107: 
121: !108: !
122: !  Find largest weight for each B(A) minimum to all A(B) minima.109: !  Find largest weight for each B(A) minimum to all A(B) minima.
123: !110: !
124: !  Added maximum weight condition via a scale factor.111: !  Added maximum weight condition via a scale factor.
125: !  Otherwise loss of precision can cause connections to be missed completely. DJW 29/7/08112: !  Otherwise loss of precision can cause connections to be missed completely. DJW 29/7/08
126: !  PAIR1 and PAIR2 are connections from pairs.data that have already been tried 
127: !113: !
128: MAXWEIGHT=HUGE(1.0D0)/1.0D1114: MAXWEIGHT=HUGE(1.0D0)/1.0D1
129: ! MAXWEIGHT=1.0D6115: ! MAXWEIGHT=1.0D6
130: loopstart: DO J1=1,NMINSTART ! cycle over all minima in the starting state116: loopstart: DO J1=1,NMINSTART ! cycle over all minima in the starting state
131:    SCALEFAC=1.0D0117:    SCALEFAC=1.0D0
132: 222   LJ1=LOCATIONSTART(J1)118: 222   LJ1=LOCATIONSTART(J1)
133:    WEIGHT(1:NMIN)=HUGE(1.0D0)119:    WEIGHT(1:NMIN)=HUGE(1.0D0)
134:    HUGESAVE=WEIGHT(1)120:    HUGESAVE=WEIGHT(1)
135:    WEIGHT(LJ1)=0.0D0121:    WEIGHT(LJ1)=0.0D0
136:    PERMANENT(1:NMIN)=.FALSE.122:    PERMANENT(1:NMIN)=.FALSE.
137:    PERMANENT(LJ1)=.TRUE.123:    PERMANENT(LJ1)=.TRUE.
138:    NPERM=1124:    NPERM=1
139:    PARENT(1:NMIN)=0 ! parent is initially undefined125:    PARENT(1:NMIN)=0 ! parent is initially undefined
140:    J4=LJ1126:    J4=LJ1
141:    dijkstraloop: DO127:    dijkstraloop: DO
142:       DO J2=1,NMIN128:       DO J2=1,NMIN
143:          IF (J2.EQ.J4) CYCLE129:          IF (J2.EQ.J4) CYCLE
144:          IF (PERMANENT(J2)) CYCLE130:          IF (PERMANENT(J2)) CYCLE
145:          PD=1.0D4*PDMAX131:          PD=1.0D4*PDMAX
146:          JM=MIN(J4,J2) 
147:          JN=MAX(J4,J2) 
148:          NPOSITION=((JN-2)*(JN-1))/2+JM 
149: !        IF (INITIALDIST) PRINT '(A,I8,A,I8,A,I10,A,G20.10)','Dijinit> minima ',J2,' and ',J4,' position ',NPOSITION,' distance ',ALLPAIRS(NPOSITION) 
150:          IF (.NOT.PAIRSIGNORET) THEN !for pruning the database all minima count not just the ones not searched yet132:          IF (.NOT.PAIRSIGNORET) THEN !for pruning the database all minima count not just the ones not searched yet
151:             DO J5=1,NPAIRDONE ! skip133:             DO J5=1,NPAIRDONE ! skip
152:                IF (INITIALDIST) THEN134:           !     IF ((PAIR1(J5).EQ.J4).AND.(PAIR2(J5).EQ.J2)) GOTO 973
153:                   IF ((PAIR1(J5).EQ.J4).AND.(PAIR2(J5).EQ.J2)) THEN 135:           !     IF ((PAIR1(J5).EQ.J2).AND.(PAIR2(J5).EQ.J4)) GOTO 973
154:                      PD=ABS(ALLPAIRS(NPOSITION))136: !kr366> check if pair has been searched before, if enter DO loop to check if PAIRDIST
155:                      IF (PD.EQ.0.0D0) THEN 
156:                         GOTO 973 
157:                      ELSE 
158:                         PD=1.0D4*PDMAX 
159:                         GOTO 973 
160:                      ENDIF 
161:                      GOTO 973 
162:                   ENDIF 
163:                   IF ((PAIR1(J5).EQ.J2).AND.(PAIR2(J5).EQ.J4)) THEN 
164:                      PD=ABS(ALLPAIRS(NPOSITION)) 
165:                      IF (PD.EQ.0.0D0) THEN 
166:                         GOTO 973 
167:                      ELSE 
168:                         PD=1.0D4*PDMAX 
169:                         GOTO 973 
170:                      ENDIF 
171:                      GOTO 973 
172:                   ENDIF 
173:                ELSE 
174: !kr366> check if pair has been searched before, if so enter DO loop to check if PAIRDIST 
175: !is 0.0D0: If yes go to 973, else set PAIRDIST to 1.0D4*PDMAX137: !is 0.0D0: If yes go to 973, else set PAIRDIST to 1.0D4*PDMAX
176:                   IF ((PAIR1(J5).EQ.J4).AND.(PAIR2(J5).EQ.J2)) THEN 138:                 IF ((PAIR1(J5).EQ.J4).AND.(PAIR2(J5).EQ.J2)) THEN 
177:                      DO J6=1,PAIRDISTMAX139:                    DO J6=1,PAIRDISTMAX
178:                         IF (PAIRLIST(J4,J6).EQ.J2) THEN140:                       IF (PAIRLIST(J4,J6).EQ.J2) THEN
179:                            PD=PAIRDIST(J4,J6)141:                          PD=PAIRDIST(J4,J6)
180:                            IF (PD.EQ.0.0D0) THEN142:                          IF (PD.EQ.0.0D0) THEN
181:                               GOTO 973143:                             GOTO 973
182:                            ELSE144:                          ELSE
183:                               PD=1.0D4*PDMAX145:                             PD=1.0D4*PDMAX
184:                               GOTO 973146:                             GOTO 973
185:                            ENDIF147:                          ENDIF
186:                         ENDIF148:                       ENDIF
187:                      ENDDO149:                    ENDDO
188:                      GOTO 973150:                    GOTO 973
189:                   ENDIF151:                 ENDIF
190:                   IF ((PAIR1(J5).EQ.J2).AND.(PAIR2(J5).EQ.J4)) THEN152:                 IF ((PAIR1(J5).EQ.J2).AND.(PAIR2(J5).EQ.J4)) THEN
191:                      DO J6=1,PAIRDISTMAX153:                    DO J6=1,PAIRDISTMAX
192:                         IF (PAIRLIST(J2,J6).EQ.J4) THEN154:                       IF (PAIRLIST(J2,J6).EQ.J4) THEN
193:                            PD=PAIRDIST(J2,J6)155:                          PD=PAIRDIST(J2,J6)
194:                            IF (PD.EQ.0.0D0) THEN156:                          IF (PD.EQ.0.0D0) THEN
195:                               GOTO 973157:                             GOTO 973
196:                            ELSE158:                          ELSE
197:                               PD=1.0D4*PDMAX159:                             PD=1.0D4*PDMAX
198:                               GOTO 973160:                             GOTO 973
199:                            ENDIF161:                          ENDIF
200:                         ENDIF162:                       ENDIF
201:                      ENDDO163:                    ENDDO
202:                      GOTO 973164:                    GOTO 973
203:                   ENDIF165:                 ENDIF
204:                ENDIF 
205:             ENDDO166:             ENDDO
206:          ENDIF167:          ENDIF
207:          IF (PRUNECYCLET.AND.(NPRUNEPAIRSOLD.GT.0)) THEN168:          IF (PRUNECYCLET.AND.(NPRUNEPAIRSOLD.GT.0)) THEN
208:             DO J5=1,NPRUNEPAIRS169:             DO J5=1,NPRUNEPAIRS
209:                IF ((PRUNEPAIRS(1,J5).EQ.J4).AND.(PRUNEPAIRS(2,J5).EQ.J2)) THEN170:                IF ((PRUNEPAIRS(1,J5).EQ.J4).AND.(PRUNEPAIRS(2,J5).EQ.J2)) THEN
210:                   IF (DEBUG) PRINT '(A,2I8)','pruning> pair used: ',PRUNEPAIRS(1,J5),PRUNEPAIRS(2,J5)171:                   IF (DEBUG) PRINT '(A,2I8)','pruning> pair used: ',PRUNEPAIRS(1,J5),PRUNEPAIRS(2,J5)
211:                   PD=1.0D4*PDMAX172:                   PD=1.0D4*PDMAX
212:                   GOTO 973173:                   GOTO 973
213:                ENDIF174:                ENDIF
214:                IF ((PRUNEPAIRS(2,J5).EQ.J4).AND.(PRUNEPAIRS(1,J5).EQ.J2)) THEN175:                IF ((PRUNEPAIRS(2,J5).EQ.J4).AND.(PRUNEPAIRS(1,J5).EQ.J2)) THEN
215:                   IF (DEBUG) PRINT '(A,2I8)','pruning> pair used: ',PRUNEPAIRS(1,J5),PRUNEPAIRS(2,J5)176:                   IF (DEBUG) PRINT '(A,2I8)','pruning> pair used: ',PRUNEPAIRS(1,J5),PRUNEPAIRS(2,J5)
216:                   PD=1.0D4*PDMAX177:                   PD=1.0D4*PDMAX
217:                   GOTO 973178:                   GOTO 973
218:                ENDIF179:                ENDIF
219:             ENDDO180:             ENDDO
220:          ENDIF 181:          ENDIF 
221:          IF (INITIALDIST) THEN182:          DO J5=1,PAIRDISTMAX
222:             PD=ABS(ALLPAIRS(NPOSITION))183:             IF (PAIRLIST(J4,J5).EQ.J2) THEN
223:          ELSE184:                PD=PAIRDIST(J4,J5)
224:             DO J5=1,PAIRDISTMAX185:                GOTO 973
225:                IF (PAIRLIST(J4,J5).EQ.J2) THEN186:             ENDIF
226:                   PD=PAIRDIST(J4,J5)187:          ENDDO
227:                   GOTO 973188:          DO J5=1,PAIRDISTMAX
228:                ENDIF189:             IF (PAIRLIST(J2,J5).EQ.J4) THEN
229:             ENDDO190:                PD=PAIRDIST(J2,J5)
230:             DO J5=1,PAIRDISTMAX191:                GOTO 973
231:                IF (PAIRLIST(J2,J5).EQ.J4) THEN192:             ENDIF
232:                   PD=PAIRDIST(J2,J5)193:          ENDDO
233:                   GOTO 973 
234:                ENDIF 
235:             ENDDO 
236:          ENDIF 
237: 973      CONTINUE194: 973      CONTINUE
238:          TMPWEIGHT=PD*SCALEFAC 195: !        TMPWEIGHT=PAIRDIST(MAX(J2,J4)*(MAX(J2,J4)-1)/2+MIN(J4,J2))*SCALEFAC
 196:          TMPWEIGHT=PD*SCALEFAC
 197: !         PRINT '(A,3I8,G20.10)','Dijinit> J1,J4,J2,TMPWEIGHT=',J1,J4,J2,TMPWEIGHT
239:          IF (TMPWEIGHT.LT.HUGE(1.0D0)/10.0D0) THEN ! don;t raise a huge number to any power!198:          IF (TMPWEIGHT.LT.HUGE(1.0D0)/10.0D0) THEN ! don;t raise a huge number to any power!
240:             IF (INDEXCOSTFUNCTION) THEN 199:             IF (INDEXCOSTFUNCTION) THEN 
241:                IF (TMPWEIGHT.EQ.0.0D0) THEN ! minima are connected!200:                IF (TMPWEIGHT.EQ.0.0D0) THEN ! minima are connected!
242:                ELSE201:                ELSE
243:                   TMPWEIGHT=ABS(J4-J2)202:                   TMPWEIGHT=ABS(J4-J2)
244:                   IF (DIRECTION.EQ.'BA') THEN203:                   IF (DIRECTION.EQ.'BA') THEN
245:                      IF (J4.LE.NMINA) TMPWEIGHT=NMIN+1-J2 ! not sure that this really makes sense for A and B ! DJW204:                      IF (J4.LE.NMINA) TMPWEIGHT=NMIN+1-J2 ! not sure that this really makes sense for A and B ! DJW
246:                      IF (J2.LE.NMINA) TMPWEIGHT=NMIN+1-J4205:                      IF (J2.LE.NMINA) TMPWEIGHT=NMIN+1-J4
247:                   ELSE206:                   ELSE
248:                      IF ((J4.LE.NMINA+NMINB).AND.(J4.GT.NMINA)) TMPWEIGHT=NMIN+1-J2207:                      IF ((J4.LE.NMINA+NMINB).AND.(J4.GT.NMINA)) TMPWEIGHT=NMIN+1-J2
249:                      IF ((J2.LE.NMINA+NMINB).AND.(J2.GT.NMINA)) TMPWEIGHT=NMIN+1-J4208:                      IF ((J2.LE.NMINA+NMINB).AND.(J2.GT.NMINA)) TMPWEIGHT=NMIN+1-J4
250:                   ENDIF209:                   ENDIF
251:                 ENDIF210:                 ENDIF
252:             ELSEIF (EXPCOSTFUNCTION) THEN 211:             ELSEIF (EXPCOSTFUNCTION) THEN ! saves memory and CPU when endpoint separation is very large SAT
253:                IF (TMPWEIGHT.EQ.0.0D0) THEN212:                IF (TMPWEIGHT.EQ.0.0D0) THEN
254:                   ! do nothing - don;t set the weight to one !! DJW 22/7/08213:                   ! do nothing - don;t set the weight to one !! DJW 22/7/08
255:                ELSEIF (TMPWEIGHT.GT.700.0D0) THEN214:                ELSEIF (TMPWEIGHT.GT.700.0D0) THEN
256:                   TMPWEIGHT=DEXP(700.0D0)215:                   TMPWEIGHT=DEXP(700.0D0)
257:                ELSE216:                ELSE
258:                   TMPWEIGHT=DEXP(TMPWEIGHT)217:                   TMPWEIGHT=DEXP(TMPWEIGHT)
259:                ENDIF218:                ENDIF
260:             ELSE ! compare squares to favour more small jumps over big ones DJW219:             ELSE ! compare squares to favour more small jumps over big ones DJW
261:                IF (TMPWEIGHT.EQ.0.0D0) THEN220:                IF (TMPWEIGHT.EQ.0.0D0) THEN
262:                ELSEIF (COSTFUNCTIONPOWER.EQ.0) THEN221:                ELSEIF (COSTFUNCTIONPOWER.EQ.0) THEN
263:                   TMPWEIGHT=TMPWEIGHT+1.0D0222:                   TMPWEIGHT=TMPWEIGHT+1.0D0
264:                ELSEIF (COSTFUNCTIONPOWER.EQ.-1) THEN223:                ELSEIF (COSTFUNCTIONPOWER.EQ.-1) THEN
265:                   TMPWEIGHT=1.0D0/TMPWEIGHT224:                   TMPWEIGHT=1.0D0/TMPWEIGHT
266:                ELSE225:                ELSE
267:                   TMPWEIGHT=TMPWEIGHT**COSTFUNCTIONPOWER 226:                   TMPWEIGHT=TMPWEIGHT**COSTFUNCTIONPOWER 
268:                ENDIF227:                ENDIF
269:             ENDIF228:             ENDIF
270:          ENDIF229:          ENDIF
271:          230:          
272: !        PRINT '(A,2I10,3G20.10)','J2,J4,TMPWEIGHT,WEIGHT(J4),WEIGHT(J2)=',J2,J4,TMPWEIGHT,WEIGHT(J4),WEIGHT(J2) 
273:          IF (TMPWEIGHT+WEIGHT(J4).LT.WEIGHT(J2)) THEN ! relax J2231:          IF (TMPWEIGHT+WEIGHT(J4).LT.WEIGHT(J2)) THEN ! relax J2
274:             WEIGHT(J2)=WEIGHT(J4)+TMPWEIGHT232:             WEIGHT(J2)=WEIGHT(J4)+TMPWEIGHT
275:             PARENT(J2)=J4233:             PARENT(J2)=J4
276: !           PRINT '(A,2I10)','J2,PARENT=',J2,PARENT(J2) 
277:          ENDIF234:          ENDIF
278:       ENDDO235:       ENDDO
279: 236: 
280:       MINWEIGHT=HUGE(1.0D0)237:       MINWEIGHT=HUGE(1.0D0)
281:       NOTDONE=.TRUE.238:       NOTDONE=.TRUE.
282:       DO J2=1,NMIN239:       DO J2=1,NMIN
283:          IF (.NOT.PERMANENT(J2)) THEN240:          IF (.NOT.PERMANENT(J2)) THEN
284:             IF (WEIGHT(J2).LT.MINWEIGHT) THEN241:             IF (WEIGHT(J2).LT.MINWEIGHT) THEN
285:                MINWEIGHT=WEIGHT(J2)242:                MINWEIGHT=WEIGHT(J2)
286:                JMINW=J2243:                JMINW=J2
287:                NOTDONE=.FALSE.244:                NOTDONE=.FALSE.
288:             ENDIF245:             ENDIF
289:          ENDIF246:          ENDIF
290: !        PRINT '(A,I10,L5,2G20.10,I10)','J2,PERMANENT,WEIGHT,MINWEIGHT,JMINW=',J2,PERMANENT(J2),WEIGHT(J2),MINWEIGHT,JMINW 
291:       ENDDO247:       ENDDO
292:       IF (NOTDONE) THEN248:       IF (NOTDONE) THEN
293:          PRINT '(A,I8,A,I8)','dijinit> WARNING - JMINW not set - value=',JMINW,' J4=',J4249:          PRINT '(A,I8,A,I8)','dijinit> WARNING - JMINW not set - value=',JMINW,' J4=',J4
294: !        PRINT '(A,I8)','dijinit> NPERM=',NPERM250:          PRINT '(A,I8)','dijinit> NPERM=',NPERM
295:          DO J2=1,NMIN251:          DO J2=1,NMIN
296: !           PRINT '(A,I8,L5,2G20.10)','J2,PERMANENT,WEIGHT,MINWEIGHT=',J2,PERMANENT(J2),WEIGHT(J2),MINWEIGHT252:             PRINT '(A,I8,L5,2G20.10)','J2,PERMANENT,WEIGHT,MINWEIGHT=',J2,PERMANENT(J2),WEIGHT(J2),MINWEIGHT
297:             IF (.NOT.PERMANENT(J2)) THEN253:             IF (.NOT.PERMANENT(J2)) THEN
298:                IF (WEIGHT(J2).LT.MINWEIGHT) THEN254:                IF (WEIGHT(J2).LT.MINWEIGHT) THEN
299:                   MINWEIGHT=WEIGHT(J2)255:                   MINWEIGHT=WEIGHT(J2)
300:                   JMINW=J2256:                   JMINW=J2
301:                   NOTDONE=.FALSE.257:                   NOTDONE=.FALSE.
302:                ENDIF258:                ENDIF
303:             ENDIF259:             ENDIF
304:          ENDDO260:          ENDDO
305:          STOP !!! DJW261:          STOP !!! DJW
306:       ENDIF262:       ENDIF
318:       IF (NPERM.EQ.NMIN) EXIT dijkstraloop274:       IF (NPERM.EQ.NMIN) EXIT dijkstraloop
319: 275: 
320:    ENDDO dijkstraloop276:    ENDDO dijkstraloop
321: 277: 
322: ENDDO loopstart278: ENDDO loopstart
323: ! 279: ! 
324: !  Summarise the best path for any A(B) and any B(A)280: !  Summarise the best path for any A(B) and any B(A)
325: !281: !
326: LJ2=LOCATIONEND(1)282: LJ2=LOCATIONEND(1)
327: LJ1=LOCATIONSTART(1)283: LJ1=LOCATIONSTART(1)
328: REDODIJKSTRA=.FALSE. 
329: J5=LJ2284: J5=LJ2
330: NWORST=0285: NWORST=0
331: NSTEPS=0286: NSTEPS=0
332: IF (MINGAPT) NMINGAP=0287: IF (MINGAPT) NMINGAP=0
333: PRINT '(A)','Dijinit> Summary of best path based on missing connection metric - note distance scaling is removed'288: PRINT '(A)','Dijinit> Summary of best path based on missing connection metric - note distance scaling is removed'
334: PRINT '(A)','    min1          energy        min2          energy             metric          edge weight            weight'289: PRINT '(A)','    min1          energy        min2          energy             metric          edge weight            weight'
335: DO 290: DO 
336:    IF (PARENT(J5).EQ.0) THEN291:    IF (PARENT(J5).EQ.0) THEN
337:       PRINT '(A,I6,A)','Dijinit> ERROR - parent for J5=',J5,' is zero'292:       PRINT '(A,I6,A)','Dijinit> ERROR - parent for J5=',J5,' is zero'
338:       PRINT '(A)',     'Dijinit> Suggests all possible pairs have been tried!'293:       PRINT '(A)',     'Dijinit> Suggests all possible pairs have been tried!'
339:       STOP294:       STOP
340:    ENDIF295:    ENDIF
 296: !  DUMMY=PAIRDIST(MAX(J5,PARENT(J5))*(MAX(J5,PARENT(J5))-1)/2+MIN(J5,PARENT(J5)))*SCALEFAC
341:    DUMMY=1.0D4*PDMAX*SCALEFAC297:    DUMMY=1.0D4*PDMAX*SCALEFAC
342:    IF (.NOT.PAIRSIGNORET) THEN298:    IF (.NOT.PAIRSIGNORET) THEN
343:      DO J2=1,NPAIRDONE ! skip299:      DO J2=1,NPAIRDONE ! skip
 300: !      IF ((PAIR1(J2).EQ.J5).AND.(PAIR2(J2).EQ.PARENT(J5))) GOTO 864
 301: !      IF ((PAIR1(J2).EQ.PARENT(J5)).AND.(PAIR2(J2).EQ.J5)) GOTO 864
344:        IF ((PAIR1(J2).EQ.J5).AND.(PAIR2(J2).EQ.PARENT(J5))) THEN302:        IF ((PAIR1(J2).EQ.J5).AND.(PAIR2(J2).EQ.PARENT(J5))) THEN
345:           IF (INITIALDIST) THEN303:           DO J6=1,PAIRDISTMAX
346:              JM=MIN(J5,PARENT(J5))304:              IF (PAIRLIST(J5,J6).EQ.PARENT(J5)) THEN
347:              JN=MAX(J5,PARENT(J5))305:                 DUMMY=PAIRDIST(J5,J6)*SCALEFAC
348:              NPOSITION=((JN-2)*(JN-1))/2+JM306:                 IF (DUMMY.EQ.0.0D0) THEN
349:              DUMMY=ABS(ALLPAIRS(NPOSITION))*SCALEFAC307:                    GOTO 864
350:              IF (DUMMY.EQ.0.0D0) THEN308:                 ELSE
351:                 GOTO 864309:                    DUMMY=1.0D4*PDMAX*SCALEFAC
352:              ELSE310:                    GOTO 864
353:                 DUMMY=1.0D4*PDMAX*SCALEFAC 
354:                 GOTO 864 
355:              ENDIF 
356:           ELSE 
357:              DO J6=1,PAIRDISTMAX 
358:                 IF (PAIRLIST(J5,J6).EQ.PARENT(J5)) THEN 
359:                    DUMMY=PAIRDIST(J5,J6)*SCALEFAC 
360:                    IF (DUMMY.EQ.0.0D0) THEN 
361:                       GOTO 864 
362:                    ELSE 
363:                       DUMMY=1.0D4*PDMAX*SCALEFAC 
364:                       GOTO 864 
365:                    ENDIF 
366:                 ENDIF311:                 ENDIF
367:              ENDDO 
368:           ENDIF 
369:           GOTO 864 
370:        ENDIF 
371:        IF ((PAIR1(J2).EQ.PARENT(J5)).AND.(PAIR2(J2).EQ.J5)) THEN 
372:           IF (INITIALDIST) THEN 
373:              JM=MIN(J5,PARENT(J5)) 
374:              JN=MAX(J5,PARENT(J5)) 
375:              NPOSITION=((JN-2)*(JN-1))/2+JM 
376:              DUMMY=ABS(ALLPAIRS(NPOSITION))*SCALEFAC 
377:              IF (DUMMY.EQ.0.0D0) THEN 
378:                 GOTO 864 
379:              ELSE 
380:                 DUMMY=1.0D4*PDMAX*SCALEFAC 
381:                 GOTO 864 
382:              ENDIF312:              ENDIF
383:           ELSE313:           ENDDO
384:              DO J6=1,PAIRDISTMAX 
385:                 IF (PAIRLIST(PARENT(J5),J6).EQ.J5) THEN 
386:                    DUMMY=PAIRDIST(PARENT(J5),J6)*SCALEFAC 
387:                    IF (DUMMY.EQ.0.0D0) THEN 
388:                        GOTO 864 
389:                    ELSE 
390:                       DUMMY=1.0D4*PDMAX*SCALEFAC 
391:                       GOTO 864 
392:                    ENDIF 
393:                 ENDIF 
394:              ENDDO 
395:           ENDIF 
396:           GOTO 864314:           GOTO 864
397:        ENDIF315:        ENDIF
398:      ENDDO316:        IF ((PAIR1(J2).EQ.PARENT(J5)).AND.(PAIR2(J2).EQ.J5)) THEN
 317:           DO J6=1,PAIRDISTMAX
 318:              IF (PAIRLIST(PARENT(J5),J6).EQ.J5) THEN
 319:                  DUMMY=PAIRDIST(PARENT(J5),J6)*SCALEFAC
 320:                  IF (DUMMY.EQ.0.0D0) THEN
 321:                      GOTO 864
 322:                  ELSE
 323:                     DUMMY=1.0D4*PDMAX*SCALEFAC
 324:                     GOTO 864
 325:                  ENDIF
 326:               ENDIF
 327:            ENDDO
 328:            GOTO 864
 329:         ENDIF
 330:       ENDDO
399:    ENDIF331:    ENDIF
400:    IF (PRUNECYCLET.AND.(NPRUNEPAIRSOLD.GT.0)) THEN332:    IF (PRUNECYCLET.AND.(NPRUNEPAIRSOLD.GT.0)) THEN
401:       DO J2=1,NPRUNEPAIRSOLD333:       DO J2=1,NPRUNEPAIRSOLD
402:          IF ((PRUNEPAIRS(1,J2).EQ.J5).AND.(PRUNEPAIRS(2,J2).EQ.PARENT(J5))) THEN334:          IF ((PRUNEPAIRS(1,J2).EQ.J5).AND.(PRUNEPAIRS(2,J2).EQ.PARENT(J5))) THEN
403:             IF (DEBUG) PRINT '(A,2I8)','pruning> pair used: ',PRUNEPAIRS(1,J2),PRUNEPAIRS(2,J2)335:             IF (DEBUG) PRINT '(A,2I8)','pruning> pair used: ',PRUNEPAIRS(1,J2),PRUNEPAIRS(2,J2)
404:             DUMMY=1.0D4*PDMAX*SCALEFAC336:             DUMMY=1.0D4*PDMAX*SCALEFAC
405:             GOTO 864337:             GOTO 864
406:          ENDIF338:          ENDIF
407:          IF ((PRUNEPAIRS(2,J2).EQ.PARENT(J5)).AND.(PRUNEPAIRS(1,J2).EQ.J5)) THEN339:          IF ((PRUNEPAIRS(2,J2).EQ.PARENT(J5)).AND.(PRUNEPAIRS(1,J2).EQ.J5)) THEN
408:             IF (DEBUG) PRINT '(A,2I8)','pruning> pair used: ',PRUNEPAIRS(1,J2),PRUNEPAIRS(2,J2)340:             IF (DEBUG) PRINT '(A,2I8)','pruning> pair used: ',PRUNEPAIRS(1,J2),PRUNEPAIRS(2,J2)
409:             DUMMY=1.0D4*PDMAX*SCALEFAC341:             DUMMY=1.0D4*PDMAX*SCALEFAC
410:             GOTO 864342:             GOTO 864
411:          ENDIF343:          ENDIF
412:       ENDDO344:       ENDDO
413:    ENDIF345:    ENDIF
414:    IF (INITIALDIST) THEN346:    DO J2=1,PAIRDISTMAX
415:       JM=MIN(J5,PARENT(J5))347:       IF (PAIRLIST(J5,J2).EQ.PARENT(J5)) THEN
416:       JN=MAX(J5,PARENT(J5))348:          DUMMY=PAIRDIST(J5,J2)*SCALEFAC
417:       NPOSITION=((JN-2)*(JN-1))/2+JM349:          GOTO 864
418:       DUMMY=ABS(ALLPAIRS(NPOSITION))*SCALEFAC350:       ENDIF
419:    ELSE351:    ENDDO
420:       DO J2=1,PAIRDISTMAX352:    DO J2=1,PAIRDISTMAX
421:          IF (PAIRLIST(J5,J2).EQ.PARENT(J5)) THEN353:       IF (PAIRLIST(PARENT(J5),J2).EQ.J5) THEN
422:             DUMMY=PAIRDIST(J5,J2)*SCALEFAC354:          DUMMY=PAIRDIST(PARENT(J5),J2)*SCALEFAC
423:             GOTO 864355:          GOTO 864
424:          ENDIF356:       ENDIF
425:       ENDDO357:    ENDDO
426:       DO J2=1,PAIRDISTMAX 
427:          IF (PAIRLIST(PARENT(J5),J2).EQ.J5) THEN 
428:             DUMMY=PAIRDIST(PARENT(J5),J2)*SCALEFAC 
429:             GOTO 864 
430:          ENDIF 
431:       ENDDO 
432:    ENDIF 
433: 864 CONTINUE358: 864 CONTINUE
434:    IF (DUMMY.LT.HUGE(1.0D0)/10.0D0) THEN ! don;t raise a huge number to any power!359:    IF (DUMMY.LT.HUGE(1.0D0)/10.0D0) THEN ! don;t raise a huge number to any power!
435:       IF (INDEXCOSTFUNCTION) THEN360:       IF (INDEXCOSTFUNCTION) THEN
436:          IF (DUMMY.EQ.0.0D0) THEN ! minima are connected!361:          IF (DUMMY.EQ.0.0D0) THEN ! minima are connected!
437:             TMPWEIGHT=0.0D0362:             TMPWEIGHT=0.0D0
438:          ELSE363:          ELSE
439:             TMPWEIGHT=ABS(J5-PARENT(J5))364:             TMPWEIGHT=ABS(J5-PARENT(J5))
440:             IF (DIRECTION.EQ.'AB') THEN365:             IF (DIRECTION.EQ.'AB') THEN
441:                IF (J5.LE.NMINA) TMPWEIGHT=NMIN+1-PARENT(J5)366:                IF (J5.LE.NMINA) TMPWEIGHT=NMIN+1-PARENT(J5)
442:                IF (PARENT(J5).LE.NMINA) TMPWEIGHT=NMIN+1-J5367:                IF (PARENT(J5).LE.NMINA) TMPWEIGHT=NMIN+1-J5
465:          ELSE390:          ELSE
466:             TMPWEIGHT=DUMMY**COSTFUNCTIONPOWER391:             TMPWEIGHT=DUMMY**COSTFUNCTIONPOWER
467:          ENDIF392:          ENDIF
468:       ENDIF393:       ENDIF
469:    ELSE394:    ELSE
470:       TMPWEIGHT=DUMMY395:       TMPWEIGHT=DUMMY
471:    ENDIF396:    ENDIF
472:    NSTEPS=NSTEPS+1397:    NSTEPS=NSTEPS+1
473:    398:    
474:    PRINT '(2(I8,G20.10),3G20.10)',J5,EMIN(J5),parent(J5),EMIN(PARENT(J5)),DUMMY/SCALEFAC,TMPWEIGHT,WEIGHT(J5)399:    PRINT '(2(I8,G20.10),3G20.10)',J5,EMIN(J5),parent(J5),EMIN(PARENT(J5)),DUMMY/SCALEFAC,TMPWEIGHT,WEIGHT(J5)
475:    IF (INITIALDIST) THEN 
476:       JM=MIN(J5,PARENT(J5)) 
477:       JN=MAX(J5,PARENT(J5)) 
478:       NPOSITION=((JN-2)*(JN-1))/2+JM 
479:       IF (ALLPAIRS(NPOSITION).LT.0.0D0) THEN 
480:          READ(UMIN,REC=J5) (LPOINTS1(J2),J2=1,NOPT) 
481:          READ(UMIN,REC=PARENT(J5)) (LPOINTS2(J2),J2=1,NOPT) 
482:          CALL MINPERMDIST(LPOINTS1,LPOINTS2,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE, & 
483:   &                          DIST2,RIGIDBODY,RMAT,.FALSE.) 
484:          PRINT '(A,I10,A,I10,A,G20.10)','Dijinit> true distance for minima ',J5,' and ',PARENT(J5),' is ',DISTANCE 
485:          ALLPAIRS(NPOSITION)=DISTANCE 
486: ! 
487: ! Need to run Dikstra again and rewrite allpairs 
488: ! 
489:          REDODIJKSTRA=.TRUE. 
490:       ENDIF 
491:    ENDIF 
492:    IF (DIJPRUNET) PRUNEMIN(J5)=.TRUE.400:    IF (DIJPRUNET) PRUNEMIN(J5)=.TRUE.
493:    IF (DEBUG.AND.DIJPRUNET) PRINT '(A,I8)','pruning> minimum added to min.retain: ',J5401:    IF (DEBUG.AND.DIJPRUNET) PRINT '(A,I8)','pruning> minimum added to min.retain: ',J5
494:    THRESH=0.0D0402:    THRESH=0.0D0
495:    IF (BHINTERPT) THRESH=BHDISTTHRESH ! for bhinterp runs raise the threshold to BHDISTTHRESH403:    IF (BHINTERPT) THRESH=BHDISTTHRESH ! for bhinterp runs raise the threshold to BHDISTTHRESH
496:    IF (BISECTT) THRESH=BISECTMINDIST ! for bisect runs raise the threshold to BISECTMINDIST404:    IF (BISECTT) THRESH=BISECTMINDIST ! for bisect runs raise the threshold to BISECTMINDIST
497:    IF ((DUMMY/SCALEFAC.GT.THRESH).AND.(TMPWEIGHT.LT.HUGE(1.0D0)/10.0D0)) THEN405:    IF ((DUMMY/SCALEFAC.GT.THRESH).AND.(TMPWEIGHT.LT.HUGE(1.0D0)/10.0D0)) THEN
498:       NWORST=NWORST+1406:       NWORST=NWORST+1
499:       IF (PRUNECYCLET) THEN407:       IF (PRUNECYCLET) THEN
500:          NPRUNEPAIRS=NPRUNEPAIRS+1408:          NPRUNEPAIRS=NPRUNEPAIRS+1
501:          PRUNEPAIRS(1,NPRUNEPAIRS)=J5409:          PRUNEPAIRS(1,NPRUNEPAIRS)=J5
538: !            ENDIF446: !            ENDIF
539: !         ENDDO447: !         ENDDO
540: !751      CONTINUE448: !751      CONTINUE
541: !      ENDIF449: !      ENDIF
542:    ENDIF450:    ENDIF
543:    J5=PARENT(J5)451:    J5=PARENT(J5)
544:    IF (J5.EQ.LJ1) EXIT452:    IF (J5.EQ.LJ1) EXIT
545:    IF (J5.EQ.0) EXIT453:    IF (J5.EQ.0) EXIT
546: ENDDO454: ENDDO
547: PRINT '(2(A,I8))','Dijinit> Number of steps=',NSTEPS,' number of missing connections=',NWORST455: PRINT '(2(A,I8))','Dijinit> Number of steps=',NSTEPS,' number of missing connections=',NWORST
548: IF (REDODIJKSTRA) THEN 
549:    LUNIT=GETUNIT() 
550:    OPEN(UNIT=LUNIT,FILE='allpairs',STATUS='UNKNOWN') 
551:    WRITE(LUNIT,'(G20.10)') ALLPAIRS(1:(NMIN*(NMIN-1))/2) 
552:    CLOSE(LUNIT) 
553:    GOTO 642 
554: ENDIF 
555: PRUNEMIN(J5)=.TRUE.456: PRUNEMIN(J5)=.TRUE.
556: IF (PRUNECYCLET) THEN457: IF (PRUNECYCLET) THEN
557:    NPRUNEDONE=NPRUNEDONE+1458:    NPRUNEDONE=NPRUNEDONE+1
558:    PRINT '(A,I8)','Dijinit> Pruning cycle completed: ',NPRUNEDONE459:    PRINT '(A,I8)','Dijinit> Pruning cycle completed: ',NPRUNEDONE
559:    IF (NPRUNEDONE.LT.NPRUNE) THEN460:    IF (NPRUNEDONE.LT.NPRUNE) THEN
560:       DEALLOCATE(LOCATIONSTART,LOCATIONEND)461:       DEALLOCATE(LOCATIONSTART,LOCATIONEND)
561:       GOTO 121462:       GOTO 121
562:    ENDIF463:    ENDIF
563: ENDIF464: ENDIF
564: IF (MINGAPT) THEN465: IF (MINGAPT) THEN


r32832/Dijkstra.f90 2017-06-22 17:30:25.209129730 +0100 r32831/Dijkstra.f90 2017-06-22 17:30:27.669162851 +0100
333:                MINWEIGHT=WEIGHT(J2)333:                MINWEIGHT=WEIGHT(J2)
334:                JMINW=J2334:                JMINW=J2
335:             ENDIF335:             ENDIF
336:          ENDIF336:          ENDIF
337:       ENDDO337:       ENDDO
338: 338: 
339:       J4=JMINW339:       J4=JMINW
340:       PERMANENT(J4)=.TRUE.340:       PERMANENT(J4)=.TRUE.
341:       NPERM=NPERM+1341:       NPERM=NPERM+1
342: !     IF (DEBUG) PRINT '(A,I8)','NPERM=',NPERM342: !     IF (DEBUG) PRINT '(A,I8)','NPERM=',NPERM
343:       PRINT '(A,2I8,G20.10)','permanent minimum J4,NPERM,WEIGHT=',J4,NPERM,WEIGHT(J4) 
344: 343: 
345:       IF (NPERM.EQ.NMIN) EXIT DIJKSTRALOOP344:       IF (NPERM.EQ.NMIN) EXIT DIJKSTRALOOP
346: 345: 
347:    ENDDO dijkstraloop346:    ENDDO dijkstraloop
348: !347: !
349: !  The next block should be in a separate subroutine for finding pairs of minima348: !  The next block should be in a separate subroutine for finding pairs of minima
350: !  to connect.349: !  to connect.
351: !350: !
352: !  We only want one candidiate ts from a given non-endpoint minimum to the endpoint set,351: !  We only want one candidiate ts from a given non-endpoint minimum to the endpoint set,
353: !  otherwise dimensions will get out of hand. EWORSTANY helps us to identify this one.352: !  otherwise dimensions will get out of hand. EWORSTANY helps us to identify this one.


r32832/getallmin.f 2017-06-22 17:30:25.653135708 +0100 r32831/getallmin.f 2017-06-22 17:30:28.821178362 +0100
192:                   IF (ZSYM(1:2).EQ.'CA') KMINUS(NTS)=KMINUS(NTS)+30.66356D0192:                   IF (ZSYM(1:2).EQ.'CA') KMINUS(NTS)=KMINUS(NTS)+30.66356D0
193:                   IF (PLUS(NTS).EQ.MINUS(NTS)) KPLUS(NTS)=KPLUS(NTS)+LOG(2.0D0)193:                   IF (PLUS(NTS).EQ.MINUS(NTS)) KPLUS(NTS)=KPLUS(NTS)+LOG(2.0D0)
194:                   IF (PLUS(NTS).EQ.MINUS(NTS)) KMINUS(NTS)=KMINUS(NTS)+LOG(2.0D0)194:                   IF (PLUS(NTS).EQ.MINUS(NTS)) KMINUS(NTS)=KMINUS(NTS)+LOG(2.0D0)
195:                ENDIF195:                ENDIF
196:             ENDDO196:             ENDDO
197:          ENDIF197:          ENDIF
198: 198: 
199:          IF (DIJINITT) THEN199:          IF (DIJINITT) THEN
200:             CALL GETMETRIC(NMIN,NMIN)200:             CALL GETMETRIC(NMIN,NMIN)
201: 201: 
 202: !             PAIRDIST(NMIN,1:PAIRDISTMAX)=1.0D100
 203: !             DO J3=1,NMIN-1
 204: !                READ(UMIN,REC=J3) (LOCALPOINTS(J2),J2=1,3*NATOMS)
 205: !                CALL MINPERMDIST(LOCALPOINTS,NEWPOINTSMIN,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE,DIST2,RIGIDBODY,
 206: !      &                          RMAT,.FALSE.)
 207: !                IF (INTERPCOSTFUNCTION) THEN
 208: !                   CALL MINPERMDIST(LOCALPOINTS,NEWPOINTSMIN,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,
 209: !      &                                 DISTANCE,DIST2,RIGIDBODY,RMAT,INTERPCOSTFUNCTION)
 210: !                   DISTANCE=MAX(DISTANCE,0.1D0)
 211: !                ENDIF
 212: !                
 213: ! !
 214: ! ! Maintain sorted list of nearest nodes according to the chosen interpolation metric.
 215: ! ! 
 216: !                sortloop: DO J4=1,PAIRDISTMAX
 217: !                   IF (DISTANCE.LT.PAIRDIST(NMIN,J4)) THEN
 218: !                      DO J5=PAIRDISTMAX,J4+1,-1
 219: !                         PAIRDIST(NMIN,J5)=PAIRDIST(NMIN,J5-1)
 220: !                         PAIRLIST(NMIN,J5)=PAIRLIST(NMIN,J5-1)
 221: !                      ENDDO
 222: !                      PAIRDIST(NMIN,J4)=DISTANCE
 223: !                      PAIRLIST(NMIN,J4)=J3
 224: !                      EXIT sortloop
 225: !                   ENDIF
 226: !                ENDDO sortloop
 227: !                sortloop2: DO J4=1,PAIRDISTMAX
 228: !                   IF (DISTANCE.LT.PAIRDIST(J3,J4)) THEN
 229: !                      DO J5=PAIRDISTMAX,J4+1,-1
 230: !                         PAIRDIST(J3,J5)=PAIRDIST(J3,J5-1)
 231: !                         PAIRLIST(J3,J5)=PAIRLIST(J3,J5-1)
 232: !                      ENDDO
 233: !                      PAIRDIST(J3,J4)=DISTANCE
 234: !                      PAIRLIST(J3,J4)=NMIN
 235: !                      EXIT sortloop2
 236: !                   ENDIF
 237: !                ENDDO sortloop2
 238: !             ENDDO
202:             PRINT '(A,I8)','setup> Finished pair distance calculation for new minimum ',NMIN239:             PRINT '(A,I8)','setup> Finished pair distance calculation for new minimum ',NMIN
203:           240:             PRINT '(10G13.2)',PAIRDIST(NMIN,1:PAIRDISTMAX)
204:             IF (INITIALDIST) THEN241:             PRINT '(10I13)',PAIRLIST(NMIN,1:PAIRDISTMAX)
205:                PRINT '(10G13.2)',ALLPAIRS(((NMIN-1)*(NMIN-2))/2+1:(NMIN*(NMIN-1))/2)   
206:             ELSE 
207:                PRINT '(10G13.2)',PAIRDIST(NMIN,1:PAIRDISTMAX) 
208:                PRINT '(10I13)',PAIRLIST(NMIN,1:PAIRDISTMAX) 
209:             ENDIF 
210: 242: 
211:          ENDIF243:          ENDIF
212: 244: 
213:          CALL FLUSH(UMIN)245:          CALL FLUSH(UMIN)
214: 130      CONTINUE246: 130      CONTINUE
215:       ENDDO247:       ENDDO
216: 110   CLOSE(LUNIT)248: 110   CLOSE(LUNIT)
217:       IF (DIJINITT) THEN249:       IF (DIJINITT) THEN
218:          IF (INITIALDIST) THEN250:          IF (NMIN.GT.NMINSAVE) THEN ! write new pairdist and pairlist files
219: ! 
220: ! Append distances to file allpairs. Do the whole file for the moment. 
221: ! 
222:             LUNIT=GETUNIT()251:             LUNIT=GETUNIT()
223:             OPEN(UNIT=LUNIT,FILE='allpairs',STATUS='UNKNOWN')252:             OPEN(UNIT=LUNIT,FILE='pairdist',STATUS='UNKNOWN',POSITION='APPEND')
224:             WRITE(LUNIT,'(G20.10)') ALLPAIRS(1:(NMIN*(NMIN-1))/2)253:             DO J3=NMINSAVE+1,NMIN
 254:                WRITE(LUNIT,'(10G20.10)') (PAIRDIST(J3,J4),J4=1,PAIRDISTMAX)
 255:             ENDDO
 256:             CALL FLUSH(LUNIT)
 257:             CLOSE(LUNIT)
 258:             OPEN(UNIT=LUNIT,FILE='pairlist',STATUS='UNKNOWN',POSITION='APPEND')
 259:             DO J3=NMINSAVE+1,NMIN
 260:                WRITE(LUNIT,'(10I10)') (PAIRLIST(J3,J4),J4=1,PAIRDISTMAX)
 261:             ENDDO
 262:             CALL FLUSH(LUNIT)
225:             CLOSE(LUNIT)263:             CLOSE(LUNIT)
226:          ELSE 
227:             IF (NMIN.GT.NMINSAVE) THEN ! write new pairdist and pairlist files 
228:                LUNIT=GETUNIT() 
229:                OPEN(UNIT=LUNIT,FILE='pairdist',STATUS='UNKNOWN',POSITION='APPEND') 
230:                DO J3=NMINSAVE+1,NMIN 
231:                   WRITE(LUNIT,'(10G20.10)') (PAIRDIST(J3,J4),J4=1,PAIRDISTMAX) 
232:                ENDDO 
233:                CALL FLUSH(LUNIT) 
234:                CLOSE(LUNIT) 
235:                OPEN(UNIT=LUNIT,FILE='pairlist',STATUS='UNKNOWN',POSITION='APPEND') 
236:                DO J3=NMINSAVE+1,NMIN 
237:                   WRITE(LUNIT,'(10I10)') (PAIRLIST(J3,J4),J4=1,PAIRDISTMAX) 
238:                ENDDO 
239:                CALL FLUSH(LUNIT) 
240:                CLOSE(LUNIT) 
241:             ENDIF 
242:          ENDIF264:          ENDIF
243:       ENDIF265:       ENDIF
244: !266: !
245: !  If we found new minima between the original ones then adjust the barrier for MINS and MINF267: !  If we found new minima between the original ones then adjust the barrier for MINS and MINF
246: !  according to the sum of distances.268: !  according to the sum of distances.
247: !269: !
248:       IF ((NMIN-NMINSAVE.GT.0).AND.(BISECTT)) THEN270:       IF ((NMIN-NMINSAVE.GT.0).AND.(BISECTT)) THEN
249:          MATCHED=.FALSE.271:          MATCHED=.FALSE.
250:          DO J3=1,NTS272:          DO J3=1,NTS
251:             IF (((PLUS(J3).EQ.MINS).AND.(MINUS(J3).EQ.MINF)).OR.((PLUS(J3).EQ.MINF).AND.(MINUS(J3).EQ.MINS))) THEN273:             IF (((PLUS(J3).EQ.MINS).AND.(MINUS(J3).EQ.MINF)).OR.((PLUS(J3).EQ.MINF).AND.(MINUS(J3).EQ.MINS))) THEN


r32832/getallpaths.f 2017-06-22 17:30:25.877138724 +0100 r32831/getallpaths.f 2017-06-22 17:30:29.053181485 +0100
 22: C 22: C
 23: C  This subroutine analyses a path.info in the new min-sad-min min-sad-min format 23: C  This subroutine analyses a path.info in the new min-sad-min min-sad-min format
 24: C  as generated with OPTIM keyword DUMPALLPATHS. 24: C  as generated with OPTIM keyword DUMPALLPATHS.
 25: C 25: C
 26:       SUBROUTINE GETALLPATHS 26:       SUBROUTINE GETALLPATHS
 27:       USE PORFUNCS 27:       USE PORFUNCS
 28:       USE COMMONS 28:       USE COMMONS
 29:       USE UTILS,ONLY : GETUNIT 29:       USE UTILS,ONLY : GETUNIT
 30:       IMPLICIT NONE 30:       IMPLICIT NONE
 31:  31: 
 32:       INTEGER J1, J2, NMINOLD, TSNUMBER, J3, NCOUNT, NMINSAVE, NTSSAVE, J4, J5, PLUSMIN, LUNIT, JM, JN, NPOSITION 32:       INTEGER J1, J2, NMINOLD, TSNUMBER, J3, NCOUNT, NMINSAVE, NTSSAVE, J4, J5, LUNIT, PLUSMIN
 33:       DOUBLE PRECISION LOCALPOINTS(NOPT), ENERGY, NEWEMIN, NEWETS, DISTANCE, RMAT(3,3), 33:       DOUBLE PRECISION LOCALPOINTS(NOPT), ENERGY, NEWEMIN, NEWETS, DISTANCE, RMAT(3,3),
 34:      1                 LPOINTSTS(NOPT), LPLUS(NOPT), LMINUS(NOPT), LOCALPOINTS2(NOPT) 34:      1                 LPOINTSTS(NOPT), LPLUS(NOPT), LMINUS(NOPT), LOCALPOINTS2(NOPT)
 35:       DOUBLE PRECISION DUMMY, DIST2, ELAPSED, TNEW 35:       DOUBLE PRECISION DUMMY, DIST2, ELAPSED, TNEW
 36:       DOUBLE PRECISION NEWFVIBMIN, NEWFVIBTS, NEWNEGEIG, NEWPOINTSMIN(NOPT), NEWPOINTSMINPLUS(NOPT), EPLUS, 36:       DOUBLE PRECISION NEWFVIBMIN, NEWFVIBTS, NEWNEGEIG, NEWPOINTSMIN(NOPT), NEWPOINTSMINPLUS(NOPT), EPLUS,
 37:      1                 NEWPOINTSTS(NOPT), NEWIXMIN,  NEWIYMIN, NEWIZMIN, IXPLUS, IYPLUS, IZPLUS, 37:      1                 NEWPOINTSTS(NOPT), NEWIXMIN,  NEWIYMIN, NEWIZMIN, IXPLUS, IYPLUS, IZPLUS,
 38:      2                 NEWIXTS,  NEWIYTS, NEWIZTS, IXMINUS, IYMINUS, IZMINUS, FRICTIONFAC, TEMPD(PAIRDISTMAX) 38:      2                 NEWIXTS,  NEWIYTS, NEWIZTS, IXMINUS, IYMINUS, IZMINUS, FRICTIONFAC, TEMPD(PAIRDISTMAX)
 39:       INTEGER NEWHORDERMIN, NEWHORDERTS, NEWMIN, NEWTS, NTRIPLES, TEMPL(PAIRDISTMAX), NFRQS, NVARS 39:       INTEGER NEWHORDERMIN, NEWHORDERTS, NEWMIN, NEWTS, NTRIPLES, TEMPL(PAIRDISTMAX), NFRQS, NVARS
 40:       LOGICAL TSISOLD, FAILED, MINPOLD, MINMOLD, BADTRIPLE, TESTOP, TESTNAME 40:       LOGICAL TSISOLD, FAILED, MINPOLD, MINMOLD, BADTRIPLE, TESTOP, TESTNAME
 41:       CHARACTER(LEN=1) DUMMYSTRING 41:       CHARACTER(LEN=1) DUMMYSTRING
 42:  42: 
709:             END IF709:             END IF
710:             CALL FLUSH(UTSDATA)710:             CALL FLUSH(UTSDATA)
711:             IF (CLOSEFILEST) CLOSE(UNIT=UTSDATA)711:             IF (CLOSEFILEST) CLOSE(UNIT=UTSDATA)
712:             PRINT '(A,I6,A)','getallpaths> writing data for new ts to ts.data'712:             PRINT '(A,I6,A)','getallpaths> writing data for new ts to ts.data'
713:             IF (NEWCONNECTIONST) THEN713:             IF (NEWCONNECTIONST) THEN
714:                MINCONN(PLUS(NTS))=MINCONN(PLUS(NTS))+1714:                MINCONN(PLUS(NTS))=MINCONN(PLUS(NTS))+1
715:                MINCONN(MINUS(NTS))=MINCONN(MINUS(NTS))+1715:                MINCONN(MINUS(NTS))=MINCONN(MINUS(NTS))+1
716:             ENDIF716:             ENDIF
717: C           PRINT '(A,2L5,2I6)','MINPOLD,MINMOLD,NMINSAVE,NMIN=',MINPOLD,MINMOLD,NMINSAVE,NMIN717: C           PRINT '(A,2L5,2I6)','MINPOLD,MINMOLD,NMINSAVE,NMIN=',MINPOLD,MINMOLD,NMINSAVE,NMIN
718:             IF (NMIN-NMINSAVE.GT.0) THEN718:             IF (NMIN-NMINSAVE.GT.0) THEN
719:                PRINT '(A,I6,A)','getallpaths> writing data for ',NMIN-NMINSAVE,' new min to min.data'719:                PRINT '(A,I6,A)','getallpaths> writing data for ',NMIN-NMINSAVE,' new minima to min.data'
720:                IF (CLOSEFILEST) OPEN(UNIT=UMINDATA,FILE='min.data',STATUS='UNKNOWN',POSITION='APPEND')720:                IF (CLOSEFILEST) OPEN(UNIT=UMINDATA,FILE='min.data',STATUS='UNKNOWN',POSITION='APPEND')
721:                DO J2=NMINSAVE+1,NMIN721:                DO J2=NMINSAVE+1,NMIN
722:                   WRITE(UMINDATA,'(2F25.15,I6,3F20.10)') EMIN(J2),FVIBMIN(J2),HORDERMIN(J2),IXMIN(J2),IYMIN(J2),IZMIN(J2)722:                   WRITE(UMINDATA,'(2F25.15,I6,3F20.10)') EMIN(J2),FVIBMIN(J2),HORDERMIN(J2),IXMIN(J2),IYMIN(J2),IZMIN(J2)
723:                   CALL FLUSH(UMINDATA)723:                   CALL FLUSH(UMINDATA)
724:                ENDDO724:                ENDDO
725:                IF (CLOSEFILEST) CLOSE(UNIT=UMINDATA)725:                IF (CLOSEFILEST) CLOSE(UNIT=UMINDATA)
726:             ENDIF726:             ENDIF
727: !727: !
728: ! (1) Construct pairlist and pairdist entries for any new minima.728: ! (1) Construct pairlist and pairdist entries for any new minima.
729: ! (2) Insert zero entry into PAIRDIST for connected pair. 729: ! (2) Insert zero entry into PAIRDIST for connected pair. 
730: ! Must remove any previous entry for this pair first.730: ! Must remove any previous entry for this pair first.
731: ! Put the zero entry at position one, and move the others731: ! Put the zero entry at position one, and move the others
732: ! along, unless we hit the same minimum, in which case we732: ! along, unless we hit the same minimum, in which case we
733: ! can overwrite it and leave the rest of the sorted list733: ! can overwrite it and leave the rest of the sorted list
734: ! unchanged.734: ! unchanged.
735: ! For INITIALDIST we maintain a full list of distances and not pairlist and pairdist. 
736: ! Need to insert zero entry into ALLPAIRS 
737: !735: !
738:             IF (DIJINITT) THEN736:             IF (DIJINITT) THEN
739:                CALL CPU_TIME(ELAPSED)737:                CALL CPU_TIME(ELAPSED)
740:                CALL GETMETRIC(NMINSAVE+1,NMIN) ! NMINSAVE+1 is the first new minimum, NMIN is the last.738:                CALL GETMETRIC(NMINSAVE+1,NMIN) ! (NEWPOINTSMIN)
741:                CALL CPU_TIME(TNEW)739:                CALL CPU_TIME(TNEW)
742:                IF (INITIALDIST) THEN740: 
743:                   JM=MIN(PLUS(NTS),MINUS(NTS))741: !              IF (NMIN.GT.NMINSAVE) THEN ! write new pairdist and pairlist entries
744:                   JN=MAX(PLUS(NTS),MINUS(NTS))742: !                 LUNIT=GETUNIT()
745:                   IF (JM.NE.JN) THEN743: !                 OPEN(UNIT=LUNIT,FILE='pairdist',STATUS='UNKNOWN',POSITION='APPEND')
746:                      NPOSITION=((JN-2)*(JN-1))/2+JM744: !                 DO J3=NMINSAVE+1,NMIN
747:                      ALLPAIRS(NPOSITION)=0.0D0745: !                    WRITE(LUNIT,'(10G20.10)') (PAIRDIST(J3,J4),J4=1,PAIRDISTMAX)
748: !746: !                 ENDDO
749: ! Append distances to file allpairs. Need to rewrite the file if we have found747: !                 CLOSE(LUNIT)
750: ! a connection that changes connections in the set of minima previously known.748: !                 OPEN(UNIT=LUNIT,FILE='pairlist',STATUS='UNKNOWN',POSITION='APPEND')
751: !749: !                 DO J3=NMINSAVE+1,NMIN
752:                      LUNIT=GETUNIT()750: !                    WRITE(LUNIT,'(10I10)') (PAIRLIST(J3,J4),J4=1,PAIRDISTMAX)
753:                      IF (JM.LE.NMINSAVE) THEN751: !                 ENDDO
754:                         OPEN(UNIT=LUNIT,FILE='allpairs',STATUS='OLD')752: !                 CLOSE(LUNIT)
755:                         WRITE(LUNIT,'(G20.10)') ALLPAIRS(1:(NMIN*(NMIN-1))/2)753: !              ENDIF
756:                      ELSE754: 
757:                         OPEN(UNIT=LUNIT,FILE='allpairs',POSITION='APPEND',ACTION='WRITE',STATUS='OLD')755: 
758:                         WRITE(LUNIT,'(G20.10)') ALLPAIRS((NMINSAVE*(NMINSAVE-1))/2+1:(NMIN*(NMIN-1))/2)  756:                J2=MAX(PLUS(NTS),MINUS(NTS))
759:                      ENDIF757:                J3=MIN(PLUS(NTS),MINUS(NTS))
760:                      CLOSE(LUNIT)758:                PRINT '(A,3I6)','getallpaths> J2,J3,NTS=',J2,J3,NTS
761:                   ENDIF759:                IF (J2.NE.J3) THEN
762:                ELSE760: !                 PRINT '(A)','pairlist old J2:'
763:                   J2=MAX(PLUS(NTS),MINUS(NTS))761: !                 PRINT '(10I10)',PAIRLIST(J2,1:PAIRDISTMAX)
764:                   J3=MIN(PLUS(NTS),MINUS(NTS))762:                   TEMPL(1:PAIRDISTMAX)=PAIRLIST(J2,1:PAIRDISTMAX)
765: !                 PRINT '(A,3I6)','getallpaths> J2,J3,NTS=',J2,J3,NTS763:                   TEMPD(1:PAIRDISTMAX)=PAIRDIST(J2,1:PAIRDISTMAX)
766:                   IF (J2.NE.J3) THEN764:                   DO J5=2,PAIRDISTMAX
767: !                    PRINT '(A)','pairlist old J2:'765:                      IF (PAIRLIST(J2,J5-1).EQ.J3) EXIT
768: !                    PRINT '(10I10)',PAIRLIST(J2,1:PAIRDISTMAX)766:                      TEMPL(J5)=PAIRLIST(J2,J5-1)
769:                      TEMPL(1:PAIRDISTMAX)=PAIRLIST(J2,1:PAIRDISTMAX)767:                      TEMPD(J5)=PAIRDIST(J2,J5-1)
770:                      TEMPD(1:PAIRDISTMAX)=PAIRDIST(J2,1:PAIRDISTMAX)768:                   ENDDO
771:                      DO J5=2,PAIRDISTMAX769:                   PAIRLIST(J2,2:PAIRDISTMAX)=TEMPL(2:PAIRDISTMAX)
772:                         IF (PAIRLIST(J2,J5-1).EQ.J3) EXIT770:                   PAIRDIST(J2,2:PAIRDISTMAX)=TEMPD(2:PAIRDISTMAX)
773:                         TEMPL(J5)=PAIRLIST(J2,J5-1)771: !                 PRINT '(A)','pairlist new J2:'
774:                         TEMPD(J5)=PAIRDIST(J2,J5-1)772: !                 PRINT '(10I10)',PAIRLIST(J2,1:PAIRDISTMAX)
775:                      ENDDO773:                   PAIRDIST(J2,1)=0.0D0
776:                      PAIRLIST(J2,2:PAIRDISTMAX)=TEMPL(2:PAIRDISTMAX)774:                   PAIRLIST(J2,1)=J3
777:                      PAIRDIST(J2,2:PAIRDISTMAX)=TEMPD(2:PAIRDISTMAX)775: !                 PRINT '(A)','pairlist J2,1:'
778: !                    PRINT '(A)','pairlist new J2:'776: !                 PRINT '(10I10)',PAIRLIST(J2,1)
779: !                    PRINT '(10I10)',PAIRLIST(J2,1:PAIRDISTMAX)777: !                 PRINT '(A)','pairlist old J3:'
780:                      PAIRDIST(J2,1)=0.0D0778: !                 PRINT '(10I10)',PAIRLIST(J3,1:PAIRDISTMAX)
781:                      PAIRLIST(J2,1)=J3779:                   TEMPL(1:PAIRDISTMAX)=PAIRLIST(J3,1:PAIRDISTMAX)
782: !                    PRINT '(A)','pairlist J2,1:'780:                   TEMPD(1:PAIRDISTMAX)=PAIRDIST(J3,1:PAIRDISTMAX)
783: !                    PRINT '(10I10)',PAIRLIST(J2,1)781:                   DO J5=2,PAIRDISTMAX
784: !                    PRINT '(A)','pairlist old J3:'782:                      IF (PAIRLIST(J3,J5-1).EQ.J2) EXIT
785: !                    PRINT '(10I10)',PAIRLIST(J3,1:PAIRDISTMAX)783:                      TEMPL(J5)=PAIRLIST(J3,J5-1)
786:                      TEMPL(1:PAIRDISTMAX)=PAIRLIST(J3,1:PAIRDISTMAX)784:                      TEMPD(J5)=PAIRDIST(J3,J5-1)
787:                      TEMPD(1:PAIRDISTMAX)=PAIRDIST(J3,1:PAIRDISTMAX)785:                   ENDDO
788:                      DO J5=2,PAIRDISTMAX786:                   PAIRLIST(J3,2:PAIRDISTMAX)=TEMPL(2:PAIRDISTMAX)
789:                         IF (PAIRLIST(J3,J5-1).EQ.J2) EXIT787:                   PAIRDIST(J3,2:PAIRDISTMAX)=TEMPD(2:PAIRDISTMAX)
790:                         TEMPL(J5)=PAIRLIST(J3,J5-1)788: !                 PRINT '(A)','pairlist new J3:'
791:                         TEMPD(J5)=PAIRDIST(J3,J5-1)789: !                 PRINT '(10I10)',PAIRLIST(J3,1:PAIRDISTMAX)
792:                      ENDDO790:                   PAIRDIST(J3,1)=0.0D0
793:                      PAIRLIST(J3,2:PAIRDISTMAX)=TEMPL(2:PAIRDISTMAX)791:                   PAIRLIST(J3,1)=J2
794:                      PAIRDIST(J3,2:PAIRDISTMAX)=TEMPD(2:PAIRDISTMAX)792: !                 PRINT '(A)','pairlist J3,1:'
795: !                    PRINT '(A)','pairlist new J3:'793: !                 PRINT '(10I10)',PAIRLIST(J3,1)
796: !                    PRINT '(10I10)',PAIRLIST(J3,1:PAIRDISTMAX)794:                  IF (DEBUG) THEN
797:                      PAIRDIST(J3,1)=0.0D0795:                      PRINT '(A,2I8)','getallpaths> Changed pair distance list for minima ',J2,J3
798:                      PAIRLIST(J3,1)=J2796:                      PRINT '(10G13.2)',PAIRDIST(J2,1:PAIRDISTMAX)
799: !                    PRINT '(A)','pairlist J3,1:'797:                      PRINT '(10I13)',PAIRLIST(J2,1:PAIRDISTMAX)
800: !                    PRINT '(10I10)',PAIRLIST(J3,1)798:                      PRINT '(10G13.2)',PAIRDIST(J3,1:PAIRDISTMAX)
801:                      IF (DEBUG) THEN799:                      PRINT '(10I13)',PAIRLIST(J3,1:PAIRDISTMAX)
802:                         PRINT '(A,2I8)','getallpaths> Changed pair distance list for minima ',J2,J3800:                  ENDIF
803:                         PRINT '(10G13.2)',PAIRDIST(J2,1:PAIRDISTMAX) 
804:                         PRINT '(10I13)',PAIRLIST(J2,1:PAIRDISTMAX) 
805:                         PRINT '(10G13.2)',PAIRDIST(J3,1:PAIRDISTMAX) 
806:                         PRINT '(10I13)',PAIRLIST(J3,1:PAIRDISTMAX) 
807:                      ENDIF 
808: !801: !
809: ! Since entries have changed we'd better rewrite these files rather802: ! Since entries have changed we'd better rewrite these files rather
810: ! than just append to them. 803: ! than just append to them. 
811: !804: !
812:                      LUNIT=GETUNIT()805:                   LUNIT=GETUNIT()
813:                      OPEN(UNIT=LUNIT,FILE='pairdist',STATUS='UNKNOWN')806:                   OPEN(UNIT=LUNIT,FILE='pairdist',STATUS='UNKNOWN')
814:                      DO J3=1,NMIN807:                   DO J3=1,NMIN
815:                         WRITE(LUNIT,'(10G20.10)') (PAIRDIST(J3,J4),J4=1,PAIRDISTMAX)808:                      WRITE(LUNIT,'(10G20.10)') (PAIRDIST(J3,J4),J4=1,PAIRDISTMAX)
816:                      ENDDO809:                   ENDDO
817:                      CALL FLUSH(LUNIT)810:                   CALL FLUSH(LUNIT)
818:                      CLOSE(LUNIT)811:                   CLOSE(LUNIT)
819:                      OPEN(UNIT=LUNIT,FILE='pairlist',STATUS='UNKNOWN')812:                   OPEN(UNIT=LUNIT,FILE='pairlist',STATUS='UNKNOWN')
820:                      DO J3=1,NMIN813:                   DO J3=1,NMIN
821:                         WRITE(LUNIT,'(10I10)') (PAIRLIST(J3,J4),J4=1,PAIRDISTMAX)814:                      WRITE(LUNIT,'(10I10)') (PAIRLIST(J3,J4),J4=1,PAIRDISTMAX)
822:                      ENDDO815:                   ENDDO
823:                      CALL FLUSH(LUNIT)816:                   CALL FLUSH(LUNIT)
824:                      CLOSE(LUNIT)817:                   CLOSE(LUNIT)
825:                   ENDIF 
826:                ENDIF818:                ENDIF
827:             ENDIF819:             ENDIF
828: C820: C
829: C  Update ts pointers.821: C  Update ts pointers.
830: C822: C
831:             POINTERP(NTS)=-1823:             POINTERP(NTS)=-1
832:             POINTERM(NTS)=-1824:             POINTERM(NTS)=-1
833:             IF (TOPPOINTER(PLUS(NTS)).GT.0) POINTERP(NTS)=TOPPOINTER(PLUS(NTS))825:             IF (TOPPOINTER(PLUS(NTS)).GT.0) POINTERP(NTS)=TOPPOINTER(PLUS(NTS))
834:             IF (TOPPOINTER(MINUS(NTS)).GT.0) POINTERM(NTS)=TOPPOINTER(MINUS(NTS))826:             IF (TOPPOINTER(MINUS(NTS)).GT.0) POINTERM(NTS)=TOPPOINTER(MINUS(NTS))
835:             TOPPOINTER(PLUS(NTS))=NTS827:             TOPPOINTER(PLUS(NTS))=NTS


r32832/getmetric.f90 2017-06-22 17:30:26.101141740 +0100 r32831/getmetric.f90 2017-06-22 17:30:29.277184501 +0100
  1: SUBROUTINE GETMETRIC(NSTART,NFINISH) ! (NEWPOINTSMIN)  1: SUBROUTINE GETMETRIC(NSTART,NFINISH) ! (NEWPOINTSMIN)
  2: USE PORFUNCS  2: USE PORFUNCS
  3: USE COMMONS, ONLY : NMIN, PAIRDIST, PAIRLIST, PAIRDISTMAX, UMIN, NATOMS, DEBUG, BOXLX, BOXLY, BOXLZ, &  3: USE COMMONS, ONLY : NMIN, PAIRDIST, PAIRLIST, PAIRDISTMAX, UMIN, NATOMS, DEBUG, BOXLX, BOXLY, BOXLZ, &
  4:   &                BULKT, TWOD, RIGIDBODY, INTERPCOSTFUNCTION, ETS, PLUS, MINUS, NTS, PAIR1, PAIR2, &  4:   &                BULKT, TWOD, RIGIDBODY, INTERPCOSTFUNCTION, ETS, PLUS, MINUS, NTS, PAIR1, PAIR2, &
  5:   &                NPAIRDONE, INDEXCOSTFUNCTION, RANDOMMETRICT, NRANDOMMETRIC, GEOMDIFFTOL, ALLPAIRS, &  5:   &                NPAIRDONE, INDEXCOSTFUNCTION, RANDOMMETRICT, NRANDOMMETRIC, GEOMDIFFTOL
  6:   &                INITIALDIST, DISBOUND 
  7: IMPLICIT NONE  6: IMPLICIT NONE
  8: INTEGER J1, J2, J3, J4, J5, ISTAT, BASIN(NMIN), NBASIN, NSTART, NFINISH, J6, NDONE  7: INTEGER J1, J2, J3, J4, J5, ISTAT, BASIN(NMIN), NBASIN, NSTART, NFINISH, J6, NDONE
  9: INTEGER JM, JN, NPOSITION 
 10: DOUBLE PRECISION LOCALPOINTS(3*NATOMS), NEWPOINTSMIN(3*NATOMS), DISTANCE, DIST2, RMAT(3,3), DPRAND  8: DOUBLE PRECISION LOCALPOINTS(3*NATOMS), NEWPOINTSMIN(3*NATOMS), DISTANCE, DIST2, RMAT(3,3), DPRAND
 11: DOUBLE PRECISION HIGHESTTS, ETHRESH  9: DOUBLE PRECISION HIGHESTTS, ETHRESH
 12: LOGICAL CHANGED 10: LOGICAL CHANGED
 13:  11: 
 14:  12: 
 15: ! 13: !
 16: ! Find highest transition state. 14: ! Find highest transition state.
 17: ! 15: !
 18: ! HIGHESTTS=-1.0D100 16: ! HIGHESTTS=-1.0D100
 19: ! DO J1=1,NTS 17: ! DO J1=1,NTS
 53: ! PRINT '(A,I8)','getmetric> Number of superbasins=',NBASIN 51: ! PRINT '(A,I8)','getmetric> Number of superbasins=',NBASIN
 54:  52: 
 55: DO J6=NSTART,NFINISH 53: DO J6=NSTART,NFINISH
 56:    READ(UMIN,REC=J6) (NEWPOINTSMIN(J2),J2=1,3*NATOMS) 54:    READ(UMIN,REC=J6) (NEWPOINTSMIN(J2),J2=1,3*NATOMS)
 57:  55: 
 58:    min2: DO J3=1,NMIN 56:    min2: DO J3=1,NMIN
 59:       DISTANCE=1.0D100 57:       DISTANCE=1.0D100
 60:       DO J4=1,NTS 58:       DO J4=1,NTS
 61:          IF ((PLUS(J4).EQ.J6).AND.(MINUS(J4).EQ.J3)) DISTANCE=0.0D0 59:          IF ((PLUS(J4).EQ.J6).AND.(MINUS(J4).EQ.J3)) DISTANCE=0.0D0
 62:          IF ((PLUS(J4).EQ.J3).AND.(MINUS(J4).EQ.J6)) DISTANCE=0.0D0 60:          IF ((PLUS(J4).EQ.J3).AND.(MINUS(J4).EQ.J6)) DISTANCE=0.0D0
 63: !        PRINT '(A,5I6,G20.10)','J6,J3,J4,plus,minus,distance=',J6,J3,J4,plus(J4),minus(J4),distance 
 64:          IF (DISTANCE.LT.1.0D-10) EXIT 61:          IF (DISTANCE.LT.1.0D-10) EXIT
 65:       ENDDO  62:       ENDDO 
 66: ! 63: !
 67: ! This line is setting the metric to 1.0D100 if two minima are connected by a 64: ! This line is setting the metric to 1.0D100 if two minima are connected by a
 68: ! discrete path of any length. Change to using the actual metric if they 65: ! discrete path of any length. Change to using the actual metric if they
 69: ! are not directly connected. 66: ! are not directly connected.
 70: ! 67: !
 71: ! If they are in the same superbasin, there is a path between them! 68: ! If they are in the same superbasin, there is a path between them!
 72: !     IF ((BASIN(J3).EQ.BASIN(J6)).AND.(DISTANCE.GT.1.0D-10)) CYCLE  69: !     IF ((BASIN(J3).EQ.BASIN(J6)).AND.(DISTANCE.GT.1.0D-10)) CYCLE 
 73:       IF ((J3.LE.J6).AND.(J3.GE.NSTART)) CYCLE ! already done by symmetry 70:       IF ((J3.LE.J6).AND.(J3.GE.NSTART)) CYCLE ! already done by symmetry
 76: ! so they are not tried again. Don't overwrite zero distance settings for connections 73: ! so they are not tried again. Don't overwrite zero distance settings for connections
 77: ! that have actually been found! 74: ! that have actually been found!
 78: !  75: ! 
 79:       IF ((DISTANCE.GT.1.0D-10).AND.(.NOT.RANDOMMETRICT)) THEN 76:       IF ((DISTANCE.GT.1.0D-10).AND.(.NOT.RANDOMMETRICT)) THEN
 80:          DO J4=1,NPAIRDONE 77:          DO J4=1,NPAIRDONE
 81:             IF ((PAIR1(J4).EQ.J6).AND.(PAIR2(J4).EQ.J3)) CYCLE min2 78:             IF ((PAIR1(J4).EQ.J6).AND.(PAIR2(J4).EQ.J3)) CYCLE min2
 82:             IF ((PAIR1(J4).EQ.J3).AND.(PAIR2(J4).EQ.J6)) CYCLE min2 79:             IF ((PAIR1(J4).EQ.J3).AND.(PAIR2(J4).EQ.J6)) CYCLE min2
 83:          ENDDO  80:          ENDDO 
 84:          IF (INDEXCOSTFUNCTION) THEN 81:          IF (INDEXCOSTFUNCTION) THEN
 85:             DISTANCE=ABS(J6-J3)  82:             DISTANCE=ABS(J6-J3) 
 86:          ELSEIF (INITIALDIST) THEN 
 87:             IF (DISTANCE.GT.1.0D-10) DISTANCE=-DISBOUND 
 88:          ELSE 83:          ELSE
 89:             READ(UMIN,REC=J3) (LOCALPOINTS(J2),J2=1,3*NATOMS) 84:             READ(UMIN,REC=J3) (LOCALPOINTS(J2),J2=1,3*NATOMS)
 90:             CALL MINPERMDIST(LOCALPOINTS,NEWPOINTSMIN,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE, & 85:             CALL MINPERMDIST(LOCALPOINTS,NEWPOINTSMIN,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE, &
 91:   &                          DIST2,RIGIDBODY,RMAT,.FALSE.) 86:   &                          DIST2,RIGIDBODY,RMAT,.FALSE.)
 92:             IF (INTERPCOSTFUNCTION) THEN 87:             IF (INTERPCOSTFUNCTION) THEN
 93:                CALL MINPERMDIST(LOCALPOINTS,NEWPOINTSMIN,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD, & 88:                CALL MINPERMDIST(LOCALPOINTS,NEWPOINTSMIN,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD, &
 94:   &                             DISTANCE,DIST2,RIGIDBODY,RMAT,INTERPCOSTFUNCTION) 89:   &                             DISTANCE,DIST2,RIGIDBODY,RMAT,INTERPCOSTFUNCTION)
 95:             ENDIF 90:             ENDIF
 96: !     91: !    
 97: ! The interpolation metric could be zero for minima that are not actually connected. 92: ! The interpolation metric could be zero for minima that are not actually connected.
 98: ! Set a minimum non-zero value to avoid Dijinit thinking that they are connected. 93: ! Set a minimum non-zero value to avoid Dijinit thinking that they are connected.
 99: !  94: ! 
100:              95:             
101:             DISTANCE=MAX(DISTANCE,GEOMDIFFTOL/100.0) 96:             DISTANCE=MAX(DISTANCE,GEOMDIFFTOL/100.0)
102:             !DISTANCE=MAX(DISTANCE,0.1D0) 97:             !DISTANCE=MAX(DISTANCE,0.1D0)
103:          ENDIF 98:          ENDIF
104:       ENDIF 99:       ENDIF
105:       IF (INITIALDIST.AND.(J6.NE.J3)) THEN100: !     PRINT '(A,2I6,G20.10)','J6,J3,DISTANCE=',J6,J3,DISTANCE
106:          JM=MIN(J6,J3) 
107:          JN=MAX(J6,J3) 
108:          NPOSITION=((JN-2)*(JN-1))/2+JM  
109:          ALLPAIRS(NPOSITION)=DISTANCE 
110:       ELSE 
111: !101: !
112: ! Maintain sorted list of nearest nodes according to the chosen interpolation metric.102: ! Maintain sorted list of nearest nodes according to the chosen interpolation metric.
113: ! 103: ! 
114:          sortloop: DO J4=1,PAIRDISTMAX104:       sortloop: DO J4=1,PAIRDISTMAX
115:             IF (DISTANCE.LT.PAIRDIST(J6,J4)) THEN105:          IF (DISTANCE.LT.PAIRDIST(J6,J4)) THEN
116:                DO J5=PAIRDISTMAX,J4+1,-1106:             DO J5=PAIRDISTMAX,J4+1,-1
117:                   PAIRDIST(J6,J5)=PAIRDIST(J6,J5-1)107:                PAIRDIST(J6,J5)=PAIRDIST(J6,J5-1)
118:                   PAIRLIST(J6,J5)=PAIRLIST(J6,J5-1)108:                PAIRLIST(J6,J5)=PAIRLIST(J6,J5-1)
119:                ENDDO109:             ENDDO
120:                PAIRDIST(J6,J4)=DISTANCE110:             PAIRDIST(J6,J4)=DISTANCE
121:                PAIRLIST(J6,J4)=J3111:             PAIRLIST(J6,J4)=J3
122:                EXIT sortloop112:             EXIT sortloop
123:             ENDIF113:          ENDIF
124:          ENDDO sortloop114:       ENDDO sortloop
125:          sortloop2: DO J4=1,PAIRDISTMAX115:       sortloop2: DO J4=1,PAIRDISTMAX
126:             IF (DISTANCE.LT.PAIRDIST(J3,J4)) THEN116:          IF (DISTANCE.LT.PAIRDIST(J3,J4)) THEN
127:                DO J5=PAIRDISTMAX,J4+1,-1117:             DO J5=PAIRDISTMAX,J4+1,-1
128:                   PAIRDIST(J3,J5)=PAIRDIST(J3,J5-1)118:                PAIRDIST(J3,J5)=PAIRDIST(J3,J5-1)
129:                   PAIRLIST(J3,J5)=PAIRLIST(J3,J5-1)119:                PAIRLIST(J3,J5)=PAIRLIST(J3,J5-1)
130:                ENDDO120:             ENDDO
131:                PAIRDIST(J3,J4)=DISTANCE121:             PAIRDIST(J3,J4)=DISTANCE
132:                PAIRLIST(J3,J4)=J6122:             PAIRLIST(J3,J4)=J6
133:                EXIT sortloop2123:             EXIT sortloop2
134:             ENDIF124:          ENDIF
135:          ENDDO sortloop2125:       ENDDO sortloop2
136:       ENDIF 
137:    ENDDO min2126:    ENDDO min2
138:    PRINT '(A,I8)','getmetric> Finished metric calculation for minimum ',J6127:    PRINT '(A,I8)','getmetric> Finished metric calculation for minimum ',J6
139:    IF (DEBUG) THEN128:    IF (DEBUG) THEN
140:       IF (INITIALDIST) THEN129:       PRINT '(10G13.5)',PAIRDIST(J6,1:PAIRDISTMAX)
141: !        IF (J6.GT.1) PRINT '(10G13.5)',ALLPAIRS(((J6-1)*(J6-2))/2+1:(J6*(J6-1)/2))130:       PRINT '(10I13)',PAIRLIST(J6,1:PAIRDISTMAX)
142:       ELSE 
143:          PRINT '(10G13.5)',PAIRDIST(J6,1:PAIRDISTMAX) 
144:          PRINT '(10I13)',PAIRLIST(J6,1:PAIRDISTMAX) 
145:       ENDIF 
146:    ENDIF131:    ENDIF
147:    CALL FLUSH(6)132:    CALL FLUSH(6)
148: ENDDO133: ENDDO
149: 134: 
150: IF (INITIALDIST) RETURN 
151: IF (.NOT.RANDOMMETRICT) RETURN135: IF (.NOT.RANDOMMETRICT) RETURN
152: !136: !
153: ! We have assigned all the direct connections in the above loop. Now calculate137: ! We have assigned all the direct connections in the above loop. Now calculate
154: ! NRANDOMMETRIC values for each specified minimum.138: ! NRANDOMMETRIC values for each specified minimum.
155: !139: !
156: DO J6=NSTART,NFINISH140: DO J6=NSTART,NFINISH
157:    READ(UMIN,REC=J6) (NEWPOINTSMIN(J2),J2=1,3*NATOMS)141:    READ(UMIN,REC=J6) (NEWPOINTSMIN(J2),J2=1,3*NATOMS)
158: 142: 
159:    NDONE=0143:    NDONE=0
160:    ranmin2: DO WHILE (NDONE.LE.NRANDOMMETRIC)144:    ranmin2: DO WHILE (NDONE.LE.NRANDOMMETRIC)


r32832/keywords.f 2017-06-22 17:30:26.329144812 +0100 r32831/keywords.f 2017-06-22 17:30:29.509187627 +0100
369:       RATETARGETT=.FALSE.369:       RATETARGETT=.FALSE.
370:       RATETARGETAB=HUGE(1.0)370:       RATETARGETAB=HUGE(1.0)
371:       RATETARGETBA=HUGE(1.0)371:       RATETARGETBA=HUGE(1.0)
372:       TARGETHIT=.FALSE.372:       TARGETHIT=.FALSE.
373:       NRANROT=0373:       NRANROT=0
374:       CHECKSPT=.FALSE.374:       CHECKSPT=.FALSE.
375:       CHECKMINT=.FALSE.375:       CHECKMINT=.FALSE.
376:       CHECKTST=.FALSE.376:       CHECKTST=.FALSE.
377:       CHECKSPS=-1377:       CHECKSPS=-1
378:       CHECKSPF=-1378:       CHECKSPF=-1
379:       INITIALDIST=.FALSE. 
380: 379: 
381:       NZEROS=0380:       NZEROS=0
382: 381: 
383: 382: 
384:       DISTANCET=.FALSE.383:       DISTANCET=.FALSE.
385:       DISTANCETO=1384:       DISTANCETO=1
386:       DISTANCETO1=1385:       DISTANCETO1=1
387:       DISTANCETO2=1386:       DISTANCETO2=1
388: 387: 
389: ! hk286388: ! hk286
1370:       ELSE IF (WORD=='IGNOREPAIRS') THEN1369:       ELSE IF (WORD=='IGNOREPAIRS') THEN
1371:          CALL READA(UNSTRING)1370:          CALL READA(UNSTRING)
1372:          IF (TRIM(ADJUSTL(UNSTRING)).EQ.'TRUE') PAIRSIGNORET=.TRUE.1371:          IF (TRIM(ADJUSTL(UNSTRING)).EQ.'TRUE') PAIRSIGNORET=.TRUE.
1373:          IF (TRIM(ADJUSTL(UNSTRING)).EQ.'FALSE') PAIRSIGNORET=.FALSE.1372:          IF (TRIM(ADJUSTL(UNSTRING)).EQ.'FALSE') PAIRSIGNORET=.FALSE.
1374: C1373: C
1375: C Prints the negative eigenvalue of each TS in ts.data as final (ninth) column1374: C Prints the negative eigenvalue of each TS in ts.data as final (ninth) column
1376: C1375: C
1377:       ELSE IF (WORD=='IMFRQ') THEN1376:       ELSE IF (WORD=='IMFRQ') THEN
1378:          IMFRQT=.TRUE.1377:          IMFRQT=.TRUE.
1379: C1378: C
1380: C  Set initial distance for all pairs of minima for use with DIJINITSTART/CONT 
1381: C 
1382:       ELSE IF (WORD.EQ.'INITIALDISTANCE') THEN 
1383:          INITIALDIST=.TRUE. 
1384:          CALL READF(DISBOUND) 
1385: C 
1386: C  Use constraint potential for interpolation as a connection metric (instead of distance).1379: C  Use constraint potential for interpolation as a connection metric (instead of distance).
1387: C1380: C
1388:       ELSE IF (WORD.EQ.'INTCONSTRAINT') THEN1381:       ELSE IF (WORD.EQ.'INTCONSTRAINT') THEN
1389:          INTCONSTRAINTT=.TRUE.1382:          INTCONSTRAINTT=.TRUE.
1390:          IF (NITEMS.GT.1) CALL READF(INTCONSTRAINTTOL)1383:          IF (NITEMS.GT.1) CALL READF(INTCONSTRAINTTOL)
1391:          IF (NITEMS.GT.2) CALL READF(INTCONSTRAINTDEL)1384:          IF (NITEMS.GT.2) CALL READF(INTCONSTRAINTDEL)
1392:          IF (NITEMS.GT.3) CALL READF(INTCONSTRAINTREP)1385:          IF (NITEMS.GT.3) CALL READF(INTCONSTRAINTREP)
1393:          IF (NITEMS.GT.4) CALL READF(INTCONSTRAINREPCUT)1386:          IF (NITEMS.GT.4) CALL READF(INTCONSTRAINREPCUT)
1394:          IF (NITEMS.GT.5) CALL READI(INTCONSEP)1387:          IF (NITEMS.GT.5) CALL READI(INTCONSEP)
1395:          IF (NITEMS.GT.6) CALL READI(INTREPSEP)1388:          IF (NITEMS.GT.6) CALL READI(INTREPSEP)
2571: 2564: 
2572: C need a general way to communicate the number of zero frequencies - used for PY2565: C need a general way to communicate the number of zero frequencies - used for PY
2573: C2566: C
2574:       ELSE IF (WORD.EQ.'ZEROS') THEN2567:       ELSE IF (WORD.EQ.'ZEROS') THEN
2575:          CALL READI(NZEROS)2568:          CALL READI(NZEROS)
2576:          PRINT '(A,I6)','keywords> number of zero frequencies will be set to ',NZEROS2569:          PRINT '(A,I6)','keywords> number of zero frequencies will be set to ',NZEROS
2577: 2570: 
2578:       ELSE2571:       ELSE
2579: 2572: 
2580:          CALL REPORT('Unrecognized command '//WORD,.TRUE.)2573:          CALL REPORT('Unrecognized command '//WORD,.TRUE.)
2581:          STOP 
2582:       ENDIF2574:       ENDIF
2583: 2575: 
2584:       CALL FLUSH(6)2576:       CALL FLUSH(6)
2585:       GOTO 1902577:       GOTO 190
2586: 2578: 
2587:       RETURN2579:       RETURN
2588:       END2580:       END


r32832/main.F 2017-06-22 17:30:26.553147825 +0100 r32831/main.F 2017-06-22 17:30:29.765191072 +0100
109:       IF (DUMMYTST) THEN109:       IF (DUMMYTST) THEN
110:          ALLOCATE(MINDISTMIN(MAXMIN))110:          ALLOCATE(MINDISTMIN(MAXMIN))
111:          ALLOCATE(MINCURVE(MAXMIN))111:          ALLOCATE(MINCURVE(MAXMIN))
112:          ALLOCATE(MINFRQ2(MAXMIN))112:          ALLOCATE(MINFRQ2(MAXMIN))
113:          MINDISTMIN(1:MAXMIN)=HUGE(1.0D0)113:          MINDISTMIN(1:MAXMIN)=HUGE(1.0D0)
114:       ENDIF114:       ENDIF
115:       IF (DIJKSTRAT .OR. KSHORTESTPATHST) ALLOCATE(TSATTEMPT(MAXTS))115:       IF (DIJKSTRAT .OR. KSHORTESTPATHST) ALLOCATE(TSATTEMPT(MAXTS))
116:       IF (NEWCONNECTIONST) ALLOCATE(MINCONN(MAXMIN))116:       IF (NEWCONNECTIONST) ALLOCATE(MINCONN(MAXMIN))
117:       IF (DIJKSTRAT .OR. KSHORTESTPATHST) ALLOCATE(DMIN1(MAXMIN),DMIN2(MAXMIN))117:       IF (DIJKSTRAT .OR. KSHORTESTPATHST) ALLOCATE(DMIN1(MAXMIN),DMIN2(MAXMIN))
118:       IF (DIJINITT) THEN118:       IF (DIJINITT) THEN
119:          IF (INITIALDIST) THEN119:          ALLOCATE(PAIRDIST(MAXMIN,PAIRDISTMAX),PAIRLIST(MAXMIN,PAIRDISTMAX))
120:             ALLOCATE(ALLPAIRS((MAXMIN*(MAXMIN-1))/2))120:          PAIRDIST(1:MAXMIN,1:PAIRDISTMAX)=1.0D100
121:             ALLPAIRS(1:(MAXMIN*(MAXMIN-1))/2)=-DISBOUND ! fixed initial default value.121:          PAIRLIST(1:MAXMIN,1:PAIRDISTMAX)=-1
122:          ELSE 
123:             ALLOCATE(PAIRDIST(MAXMIN,PAIRDISTMAX),PAIRLIST(MAXMIN,PAIRDISTMAX)) 
124:             PAIRDIST(1:MAXMIN,1:PAIRDISTMAX)=1.0D100 
125:             PAIRLIST(1:MAXMIN,1:PAIRDISTMAX)=-1 
126:          ENDIF 
127:       ENDIF122:       ENDIF
128:       IF (CONNECTREGIONT) ALLOCATE(DMIN1(DMINMAX),DMIN2(DMINMAX))123:       IF (CONNECTREGIONT) ALLOCATE(DMIN1(DMINMAX),DMIN2(DMINMAX))
129:       IF (UNTRAPT .AND. (.NOT. DIJKSTRAT) .AND. (.NOT. KSHORTESTPATHST)) ALLOCATE(DMIN1(DMINMAX),DMIN2(DMINMAX))124:       IF (UNTRAPT .AND. (.NOT. DIJKSTRAT) .AND. (.NOT. KSHORTESTPATHST)) ALLOCATE(DMIN1(DMINMAX),DMIN2(DMINMAX))
130: 125: 
131:       IF (NATOMS.LT.1) THEN126:       IF (NATOMS.LT.1) THEN
132:          PRINT*,'ERROR - NATOMS=',NATOMS127:          PRINT*,'ERROR - NATOMS=',NATOMS
133:          STOP128:          STOP
134:       ENDIF129:       ENDIF
135: 130: 
136:       IF (ANGLEAXIS) THEN131:       IF (ANGLEAXIS) THEN
438:       ELSEIF (DIJINITT) THEN433:       ELSEIF (DIJINITT) THEN
439:          WRITE(*,'(A)') 'Performing Dijkstra analysis to perform initial connection'434:          WRITE(*,'(A)') 'Performing Dijkstra analysis to perform initial connection'
440:          IF (INDEXCOSTFUNCTION) THEN435:          IF (INDEXCOSTFUNCTION) THEN
441:             WRITE(*,'(A)') 'Using index of minima for edge weights'436:             WRITE(*,'(A)') 'Using index of minima for edge weights'
442:          ELSEIF (EXPCOSTFUNCTION) THEN437:          ELSEIF (EXPCOSTFUNCTION) THEN
443:             WRITE(*,'(A)') 'Using exponential distance for edge weights'438:             WRITE(*,'(A)') 'Using exponential distance for edge weights'
444:          ELSEIF (.NOT.INTCONSTRAINTT) THEN439:          ELSEIF (.NOT.INTCONSTRAINTT) THEN
445:             WRITE(*,'(A,I4,A)') 'Using distance to the power ',CostFunctionPower,' for edge weights'440:             WRITE(*,'(A,I4,A)') 'Using distance to the power ',CostFunctionPower,' for edge weights'
446:          ENDIF441:          ENDIF
447:          WRITE(*,'(A,G20.10)') 'Transition states will be rejected above threshold energy ',TSTHRESH442:          WRITE(*,'(A,G20.10)') 'Transition states will be rejected above threshold energy ',TSTHRESH
448:          IF (INITIALDIST) THEN443:          WRITE(*,'(A,I8)') 'Number of closest neighbours to save=',PAIRDISTMAX
449:             WRITE(*,'(A,G20.10,A)') 'Pair distances will be intialised to ',DISBOUND,' and calculated when needed' 
450:          ELSE 
451:             WRITE(*,'(A,I8)') 'Number of closest neighbours to save=',PAIRDISTMAX 
452:          ENDIF 
453:       ELSEIF (DIJINITFLYT) THEN444:       ELSEIF (DIJINITFLYT) THEN
454:          WRITE(*,'(A)') 'Performing Dijkstra analysis to perform initial connection with weights calculated on-the-fly'445:          WRITE(*,'(A)') 'Performing Dijkstra analysis to perform initial connection with weights calculated on-the-fly'
455:          IF (EXPCOSTFUNCTION) THEN446:          IF (EXPCOSTFUNCTION) THEN
456:             WRITE(*,'(A)') 'Using exponential distance for edge weights'447:             WRITE(*,'(A)') 'Using exponential distance for edge weights'
457:          ELSEIF (.NOT.INTCONSTRAINTT) THEN448:          ELSEIF (.NOT.INTCONSTRAINTT) THEN
458:             WRITE(*,'(A,I4,A)') 'Using distance to the power ',CostFunctionPower,' for edge weights'449:             WRITE(*,'(A,I4,A)') 'Using distance to the power ',CostFunctionPower,' for edge weights'
459:          ENDIF450:          ENDIF
460:          WRITE(*,'(A,G20.10)') 'Transition states will be rejected above threshold energy ',TSTHRESH451:          WRITE(*,'(A,G20.10)') 'Transition states will be rejected above threshold energy ',TSTHRESH
461:          WRITE(*,'(A,I8)') 'Number of closest neighbours to save=',PAIRDISTMAX452:          WRITE(*,'(A,I8)') 'Number of closest neighbours to save=',PAIRDISTMAX
462:       ELSEIF (DIJPAIRT) THEN453:       ELSEIF (DIJPAIRT) THEN
821: 812: 
822:       DEALLOCATE(FRQS,MASS,ZSYMBOL,RESLABEL, 813:       DEALLOCATE(FRQS,MASS,ZSYMBOL,RESLABEL, 
823:      &         ATOMLABEL,RESNUMBER,EMIN,FVIBMIN,PFMIN, 814:      &         ATOMLABEL,RESNUMBER,EMIN,FVIBMIN,PFMIN, 
824:      &         IXMIN,IYMIN,IZMIN,GPFOLD,ETS,FVIBTS,KPLUS,KMINUS,NEGEIG,815:      &         IXMIN,IYMIN,IZMIN,GPFOLD,ETS,FVIBTS,KPLUS,KMINUS,NEGEIG,
825:      &         IXTS,IYTS,IZTS,HORDERMIN,TOPPOINTER,HORDERTS, 816:      &         IXTS,IYTS,IZTS,HORDERMIN,TOPPOINTER,HORDERTS, 
826:      &         PLUS,MINUS,POINTERM,POINTERP,PAIR1,PAIR2)817:      &         PLUS,MINUS,POINTERM,POINTERP,PAIR1,PAIR2)
827:       IF (ALLOCATED(NCONN)) DEALLOCATE(NCONN)818:       IF (ALLOCATED(NCONN)) DEALLOCATE(NCONN)
828:       IF (ALLOCATED(DMIN1)) DEALLOCATE(DMIN1,DMIN2)819:       IF (ALLOCATED(DMIN1)) DEALLOCATE(DMIN1,DMIN2)
829:       IF (ALLOCATED(TSATTEMPT)) DEALLOCATE(TSATTEMPT)820:       IF (ALLOCATED(TSATTEMPT)) DEALLOCATE(TSATTEMPT)
830:       IF (ALLOCATED(MINDONE)) DEALLOCATE(MINDONE)821:       IF (ALLOCATED(MINDONE)) DEALLOCATE(MINDONE)
831:       IF (ALLOCATED(PAIRDIST)) DEALLOCATE(PAIRDIST)822:       IF (DIJINITT) DEALLOCATE(PAIRDIST)
832:       IF (ALLOCATED(ALLPAIRS)) DEALLOCATE(ALLPAIRS) 
833:       IF (DUMMYTST) DEALLOCATE(MINDISTMIN)823:       IF (DUMMYTST) DEALLOCATE(MINDISTMIN)
834: 824: 
835:       CALL CPU_TIME(TNEW)825:       CALL CPU_TIME(TNEW)
836:       IF (NATTEMPT.GT.0) WRITE(*,'(A,G15.5,A)') 'main> CPU time spent iterating committor probability=',TPFOLD,' s'826:       IF (NATTEMPT.GT.0) WRITE(*,'(A,G15.5,A)') 'main> CPU time spent iterating committor probability=',TPFOLD,' s'
837:       IF (TFOLDT) WRITE(*,'(A,G15.5,A)') 'main> CPU time spent iterating waiting times=',TTFOLD,' s'827:       IF (TFOLDT) WRITE(*,'(A,G15.5,A)') 'main> CPU time spent iterating waiting times=',TTFOLD,' s'
838:       IF (GTT) WRITE(*,'(A,G15.5,A)') 'main> CPU time spent in GT                          =',TGT,' s'828:       IF (GTT) WRITE(*,'(A,G15.5,A)') 'main> CPU time spent in GT                          =',TGT,' s'
839:       IF (NGTT) WRITE(*,'(A,G15.5,A)') 'main> CPU time spent in NGT                          =',TGT,' s'829:       IF (NGTT) WRITE(*,'(A,G15.5,A)') 'main> CPU time spent in NGT                          =',TGT,' s'
840:       IF (DIJKSTRAT) WRITE(*,'(A,G15.5,A)') 'main> CPU time spent in Dijkstra                    =',TDIJKSTRA,' s'830:       IF (DIJKSTRAT) WRITE(*,'(A,G15.5,A)') 'main> CPU time spent in Dijkstra                    =',TDIJKSTRA,' s'
841:       IF (KSHORTESTPATHST) WRITE(*,'(A,G15.5,A)') 'main> CPU time spent in kshortestpaths              =',TKSHORTESTPATHS,' s'831:       IF (KSHORTESTPATHST) WRITE(*,'(A,G15.5,A)') 'main> CPU time spent in kshortestpaths              =',TKSHORTESTPATHS,' s'
842:       IF (CONNECTREGIONT) WRITE(*,'(A,G15.5,A)') 'main> CPU time spent in connectdist                 =',TCONNECTDIST,' s'832:       IF (CONNECTREGIONT) WRITE(*,'(A,G15.5,A)') 'main> CPU time spent in connectdist                 =',TCONNECTDIST,' s'


r32832/mergedb.f90 2017-06-22 17:30:26.773150787 +0100 r32831/mergedb.f90 2017-06-22 17:30:29.989194087 +0100
 21: !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 21: !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 22: ! 22: !
 23: !  This subroutine merges the database information in directory PATHNAME. 23: !  This subroutine merges the database information in directory PATHNAME.
 24: ! 24: !
 25: SUBROUTINE MERGEDB 25: SUBROUTINE MERGEDB
 26: USE COMMONS,ONLY : NATOMS, IYTS, IZTS, UTSDATA, UTS, HORDERMIN, TOPPOINTER, HORDERTS, PLUS, MINUS, GPFOLD, & 26: USE COMMONS,ONLY : NATOMS, IYTS, IZTS, UTSDATA, UTS, HORDERMIN, TOPPOINTER, HORDERTS, PLUS, MINUS, GPFOLD, &
 27:    &              MAXMIN, MAXTS, FVIBTS, EMIN, FVIBMIN, IXMIN, IYMIN, IZMIN, NEGEIG, PATHNAME, ETS, DEBUG, & 27:    &              MAXMIN, MAXTS, FVIBTS, EMIN, FVIBMIN, IXMIN, IYMIN, IZMIN, NEGEIG, PATHNAME, ETS, DEBUG, &
 28:    &              NMIN, UNRST, CHARMMT, IDIFFTOL, EDIFFTOL, UMINDATA, UMIN, NTS, IXTS, NMINA, NMINB, & 28:    &              NMIN, UNRST, CHARMMT, IDIFFTOL, EDIFFTOL, UMINDATA, UMIN, NTS, IXTS, NMINA, NMINB, &
 29:    &              LOCATIONA, LOCATIONB, ANGLEAXIS, PERMDIST, BOXLX, BOXLY, BOXLZ, GEOMDIFFTOL, TWOD, & 29:    &              LOCATIONA, LOCATIONB, ANGLEAXIS, PERMDIST, BOXLX, BOXLY, BOXLZ, GEOMDIFFTOL, TWOD, &
 30:    &              RIGIDBODY, BULKT, ZSYM, PERMISOMER, IMFRQT, CLOSEFILEST, AMHT, PAIRDISTMAX, DIJINITT, & 30:    &              RIGIDBODY, BULKT, ZSYM, PERMISOMER, IMFRQT, CLOSEFILEST, AMHT, PAIRDISTMAX, DIJINITT, &
 31:    &              DIJINITCONTT, ALLTST, ADDPT2, ADDPT3, NOPT, LPERMDIST, INITIALDIST 31:    &              DIJINITCONTT, ALLTST, ADDPT2, ADDPT3, NOPT, LPERMDIST
 32: USE UTILS,ONLY : GETUNIT 32: USE UTILS,ONLY : GETUNIT
 33:  33: 
 34: USE PORFUNCS 34: USE PORFUNCS
 35: IMPLICIT NONE 35: IMPLICIT NONE
 36:  36: 
 37: INTEGER J1, J2, ISTAT, NMINOLD, NTSOLD, NMINDB, NDUMMY, J3, LUNIT, J4, LPLUNIT, LPDUNIT, PLUNIT, PDUNIT 37: INTEGER J1, J2, ISTAT, NMINOLD, NTSOLD, NMINDB, NDUMMY, J3, LUNIT, J4, LPLUNIT, LPDUNIT, PLUNIT, PDUNIT
 38: DOUBLE PRECISION LOCALPOINTS(NOPT), NEWEMIN, NEWETS 38: DOUBLE PRECISION LOCALPOINTS(NOPT), NEWEMIN, NEWETS
 39: DOUBLE PRECISION NEWFVIBMIN, NEWFVIBTS, NEWPOINTSMIN(NOPT), NEWNEGEIG, LPLUS(NOPT), LMINUS(NOPT), & 39: DOUBLE PRECISION NEWFVIBMIN, NEWFVIBTS, NEWPOINTSMIN(NOPT), NEWNEGEIG, LPLUS(NOPT), LMINUS(NOPT), &
 40:   &  NEWPOINTSTS(NOPT), NEWIXMIN,  NEWIYMIN, NEWIZMIN, LPAIRDIST(PAIRDISTMAX), & 40:   &  NEWPOINTSTS(NOPT), NEWIXMIN,  NEWIYMIN, NEWIZMIN, LPAIRDIST(PAIRDISTMAX), &
 41:   &  NEWIXTS,  NEWIYTS, NEWIZTS, DISTANCE, DIST2, LOCALPOINTS2(NOPT), RMAT(3,3) 41:   &  NEWIXTS,  NEWIYTS, NEWIZTS, DISTANCE, DIST2, LOCALPOINTS2(NOPT), RMAT(3,3)
113:    IF (INDEX.GT.MAXMIN) CALL MINDOUBLE113:    IF (INDEX.GT.MAXMIN) CALL MINDOUBLE
114:    IF (IMFRQT) THEN114:    IF (IMFRQT) THEN
115:       READ(1,*,END=30) EMIN(INDEX),FVIBMIN(INDEX),HORDERMIN(INDEX),IXMIN(INDEX),IYMIN(INDEX),IZMIN(INDEX),NEGEIG(INDEX)115:       READ(1,*,END=30) EMIN(INDEX),FVIBMIN(INDEX),HORDERMIN(INDEX),IXMIN(INDEX),IYMIN(INDEX),IZMIN(INDEX),NEGEIG(INDEX)
116:    ELSE116:    ELSE
117:       READ(1,*,END=30) EMIN(INDEX),FVIBMIN(INDEX),HORDERMIN(INDEX),IXMIN(INDEX),IYMIN(INDEX),IZMIN(INDEX)117:       READ(1,*,END=30) EMIN(INDEX),FVIBMIN(INDEX),HORDERMIN(INDEX),IXMIN(INDEX),IYMIN(INDEX),IZMIN(INDEX)
118:    END IF118:    END IF
119:    NEWEMIN=EMIN(INDEX)119:    NEWEMIN=EMIN(INDEX)
120:    NEWFVIBMIN=FVIBMIN(INDEX)120:    NEWFVIBMIN=FVIBMIN(INDEX)
121:    NEWHORDERMIN=HORDERMIN(INDEX)121:    NEWHORDERMIN=HORDERMIN(INDEX)
122:    IF (DIJINITT.OR.DIJINITCONTT) THEN122:    IF (DIJINITT.OR.DIJINITCONTT) THEN
123:       IF (INITIALDIST) THEN 
124:          PRINT '(A)','mergedb> ERROR *** mergedb has not been changed to handle INITIALDIST yet' 
125:          STOP 
126:       ENDIF 
127:       READ(PLUNIT,'(10I10)') (LPAIRLIST(J4),J4=1,PAIRDISTMAX)123:       READ(PLUNIT,'(10I10)') (LPAIRLIST(J4),J4=1,PAIRDISTMAX)
128: !     PRINT '(A)','mergedb> read pairlist values:'124: !     PRINT '(A)','mergedb> read pairlist values:'
129: !     WRITE(*,'(10I10)') (LPAIRLIST(J4),J4=1,PAIRDISTMAX)125: !     WRITE(*,'(10I10)') (LPAIRLIST(J4),J4=1,PAIRDISTMAX)
130:       READ(PDUNIT,'(10G20.10)') (LPAIRDIST(J4),J4=1,PAIRDISTMAX)126:       READ(PDUNIT,'(10G20.10)') (LPAIRDIST(J4),J4=1,PAIRDISTMAX)
131:    ENDIF127:    ENDIF
132: !128: !
133: !  Read in points and check for agreement with moments of inertia as in setup129: !  Read in points and check for agreement with moments of inertia as in setup
134: !130: !
135:    READ(2,REC=MINDB) (NEWPOINTSMIN(J2),J2=1,NOPT)  131:    READ(2,REC=MINDB) (NEWPOINTSMIN(J2),J2=1,NOPT)  
136:    LOCALPOINTS(1:NOPT)=NEWPOINTSMIN(1:NOPT)132:    LOCALPOINTS(1:NOPT)=NEWPOINTSMIN(1:NOPT)


r32832/mindouble.f90 2017-06-22 17:30:26.997153804 +0100 r32831/mindouble.f90 2017-06-22 17:30:30.217197162 +0100
 13: !   GNU General Public License for more details. 13: !   GNU General Public License for more details.
 14: ! 14: !
 15: !   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
 16: !   along with this program; if not, write to the Free Software 16: !   along with this program; if not, write to the Free Software
 17: !   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
 18: ! 18: !
 19:  19: 
 20: SUBROUTINE MINDOUBLE 20: SUBROUTINE MINDOUBLE
 21:    USE COMMONS 21:    USE COMMONS
 22:    IMPLICIT NONE 22:    IMPLICIT NONE
 23:    DOUBLE PRECISION, ALLOCATABLE :: VDP(:), VDP2(:,:), VDPVEC(:) 23:    DOUBLE PRECISION, ALLOCATABLE :: VDP(:), VDP2(:,:)
 24:    INTEGER, ALLOCATABLE :: VINT(:), VINT2(:,:) 24:    INTEGER, ALLOCATABLE :: VINT(:), VINT2(:,:)
 25:    INTEGER OLDSIZE, NEWSIZE 
 26:  25: 
 27:    PRINT '(A,I8)','mindouble> Increasing maximum number of minima to ',2*MAXMIN 26:    PRINT '(A,I8)','mindouble> Increasing maximum number of minima to ',2*MAXMIN
 28:  27: 
 29:    ALLOCATE(VDP(MAXMIN),VINT(MAXMIN)) 28:    ALLOCATE(VDP(MAXMIN),VINT(MAXMIN))
 30:  29: 
 31:    VDP(1:MAXMIN)=EMIN(1:MAXMIN) 30:    VDP(1:MAXMIN)=EMIN(1:MAXMIN)
 32:    DEALLOCATE(EMIN) 31:    DEALLOCATE(EMIN)
 33:    ALLOCATE(EMIN(2*MAXMIN)) 32:    ALLOCATE(EMIN(2*MAXMIN))
 34:    EMIN(1:MAXMIN)=VDP(1:MAXMIN) 33:    EMIN(1:MAXMIN)=VDP(1:MAXMIN)
 35:  34: 
 93:       VDP(1:MAXMIN)=MINFRQ2(1:MAXMIN) 92:       VDP(1:MAXMIN)=MINFRQ2(1:MAXMIN)
 94:       DEALLOCATE(MINFRQ2) 93:       DEALLOCATE(MINFRQ2)
 95:       ALLOCATE(MINFRQ2(2*MAXMIN)) 94:       ALLOCATE(MINFRQ2(2*MAXMIN))
 96:       MINFRQ2(1:MAXMIN)=VDP(1:MAXMIN) 95:       MINFRQ2(1:MAXMIN)=VDP(1:MAXMIN)
 97:    ENDIF 96:    ENDIF
 98:    97:   
 99: ! 98: !
100: ! If the PAIRDIST vector has not been zeroed in a MERGEDBT run executing the 99: ! If the PAIRDIST vector has not been zeroed in a MERGEDBT run executing the
101: ! next block can give a SIGFPE100: ! next block can give a SIGFPE
102: !101: !
103:    IF (DIJINITT.AND.INITIALDIST) THEN102:    IF (DIJINITT.AND.(.NOT.MERGEDBT)) THEN
104:       PRINT '(A,I20)','mindouble> Increasing pair distance array dimension to ',2*MAXMIN,' minima ' 
105:       IF (ALLOCATED(VDPVEC)) DEALLOCATE(VDPVEC) 
106:       OLDSIZE=(MAXMIN*(MAXMIN-1))/2 
107:       NEWSIZE=(2*MAXMIN*(2*MAXMIN-1))/2 
108:       ALLOCATE(VDPVEC(OLDSIZE)) 
109:       VDPVEC(1:OLDSIZE)=ALLPAIRS(1:OLDSIZE) 
110:       DEALLOCATE(ALLPAIRS) 
111:       ALLOCATE(ALLPAIRS(NEWSIZE)) 
112:       ALLPAIRS(1:NEWSIZE)=1.0D100 
113:       ALLPAIRS(1:OLDSIZE)=VDPVEC(1:OLDSIZE) 
114:       DEALLOCATE(VDPVEC) 
115:    ELSEIF (DIJINITT.AND.(.NOT.MERGEDBT)) THEN 
116:       PRINT '(A,I20)','mindouble> Increasing pair distance array dimension to ',2*MAXMIN103:       PRINT '(A,I20)','mindouble> Increasing pair distance array dimension to ',2*MAXMIN
117:       IF (ALLOCATED(VDP2)) DEALLOCATE(VDP2)104:       IF (ALLOCATED(VDP2)) DEALLOCATE(VDP2)
118:       ALLOCATE(VDP2(MAXMIN,PAIRDISTMAX))105:       ALLOCATE(VDP2(MAXMIN,PAIRDISTMAX))
119:       VDP2(1:MAXMIN,1:PAIRDISTMAX)=PAIRDIST(1:MAXMIN,1:PAIRDISTMAX)106:       VDP2(1:MAXMIN,1:PAIRDISTMAX)=PAIRDIST(1:MAXMIN,1:PAIRDISTMAX)
120:       DEALLOCATE(PAIRDIST)107:       DEALLOCATE(PAIRDIST)
121:       ALLOCATE(PAIRDIST(2*MAXMIN,PAIRDISTMAX))108:       ALLOCATE(PAIRDIST(2*MAXMIN,PAIRDISTMAX))
122:       PAIRDIST(1:2*MAXMIN,1:PAIRDISTMAX)=1.0D100109:       PAIRDIST(1:2*MAXMIN,1:PAIRDISTMAX)=1.0D100
123:       PAIRDIST(1:MAXMIN,1:PAIRDISTMAX)=VDP2(1:MAXMIN,1:PAIRDISTMAX)110:       PAIRDIST(1:MAXMIN,1:PAIRDISTMAX)=VDP2(1:MAXMIN,1:PAIRDISTMAX)
124:       DEALLOCATE(VDP2)111:       DEALLOCATE(VDP2)
125: 112: 
126:       IF (ALLOCATED(VINT2)) DEALLOCATE(VINT2)113:       IF (ALLOCATED(VINT2)) DEALLOCATE(VINT2)
127:       ALLOCATE(VINT2(MAXMIN,PAIRDISTMAX))114:       ALLOCATE(VINT2(MAXMIN,PAIRDISTMAX))
128:       VINT2(1:MAXMIN,1:PAIRDISTMAX)=PAIRLIST(1:MAXMIN,1:PAIRDISTMAX)115:       VINT2(1:MAXMIN,1:PAIRDISTMAX)=PAIRLIST(1:MAXMIN,1:PAIRDISTMAX)
129:       DEALLOCATE(PAIRLIST)116:       DEALLOCATE(PAIRLIST)
130:       ALLOCATE(PAIRLIST(2*MAXMIN,PAIRDISTMAX))117:       ALLOCATE(PAIRLIST(2*MAXMIN,PAIRDISTMAX))
131:       PAIRLIST(1:2*MAXMIN,1:PAIRDISTMAX)=-1118:       PAIRLIST(1:2*MAXMIN,1:PAIRDISTMAX)=-1
132:       PAIRLIST(1:MAXMIN,1:PAIRDISTMAX)=VINT2(1:MAXMIN,1:PAIRDISTMAX)119:       PAIRLIST(1:MAXMIN,1:PAIRDISTMAX)=VINT2(1:MAXMIN,1:PAIRDISTMAX)
133:       DEALLOCATE(VINT2)120:       DEALLOCATE(VINT2)
134:    ENDIF121:    ENDIF
135: 122: 
136:  
137:    IF (NEWCONNECTIONST) THEN123:    IF (NEWCONNECTIONST) THEN
138:       VINT(1:MAXMIN)=MINCONN(1:MAXMIN)124:       VINT(1:MAXMIN)=MINCONN(1:MAXMIN)
139:       DEALLOCATE(MINCONN)125:       DEALLOCATE(MINCONN)
140:       ALLOCATE(MINCONN(2*MAXMIN))126:       ALLOCATE(MINCONN(2*MAXMIN))
141:       MINCONN(1:MAXMIN)=VINT(1:MAXMIN)127:       MINCONN(1:MAXMIN)=VINT(1:MAXMIN)
142:    ENDIF128:    ENDIF
143: 129: 
144:    IF (.FALSE.) THEN130:    IF (.FALSE.) THEN
145:       VINT(1:MAXMIN)=DMIN1(1:MAXMIN)131:       VINT(1:MAXMIN)=DMIN1(1:MAXMIN)
146:       DEALLOCATE(DMIN1)132:       DEALLOCATE(DMIN1)


r32832/setup.f 2017-06-22 17:30:27.221156820 +0100 r32831/setup.f 2017-06-22 17:30:30.445200228 +0100
1502: C1502: C
1503:       IF (DIJINITT) THEN1503:       IF (DIJINITT) THEN
1504:          DO J1=1,NTS1504:          DO J1=1,NTS
1505: !1505: !
1506: ! JMC n.b. don't apply the nconnmin criteria at this point, hence the huge(1) 's 1506: ! JMC n.b. don't apply the nconnmin criteria at this point, hence the huge(1) 's 
1507: ! in place of NCONN() for the plus and minus minima.1507: ! in place of NCONN() for the plus and minus minima.
1508: !1508: !
1509:             CALL CHECKTS(ETS(J1),EMIN(PLUS(J1)),EMIN(MINUS(J1)),KPLUS(J1),KMINUS(J1),HUGE(1),HUGE(1), 1509:             CALL CHECKTS(ETS(J1),EMIN(PLUS(J1)),EMIN(MINUS(J1)),KPLUS(J1),KMINUS(J1),HUGE(1),HUGE(1), 
1510:      &                   PLUS(J1),MINUS(J1),.TRUE.,CUT_UNDERFLOW,DEADTS)1510:      &                   PLUS(J1),MINUS(J1),.TRUE.,CUT_UNDERFLOW,DEADTS)
1511:          ENDDO1511:          ENDDO
1512:          IF (INITIALDIST) THEN1512: !         IF (PAIRDISTMAX.GT.NMIN-1) THEN
1513:             ALLPAIRS(1:(NMIN*(NMIN-1)/2))=-DISBOUND1513: !            PRINT '(A)','setup> WARNING *** number of neighbours > number of minima-1, resetting'
1514:             INQUIRE(FILE='allpairs',EXIST=YESNO)1514: !            PAIRDISTMAX=NMIN-1
1515:             IF (YESNO) THEN1515: !         ENDIF
1516:                LUNIT=GETUNIT()1516:          PAIRDIST(1:NMIN,1:PAIRDISTMAX)=1.0D100
1517:                OPEN(UNIT=LUNIT,FILE='allpairs',STATUS='OLD')1517:          PAIRLIST(1:NMIN,1:PAIRDISTMAX)=-1
1518:                READ(LUNIT,*) ALLPAIRS(1:(NMIN*(NMIN-1)/2))1518:          INQUIRE(FILE='pairdist',EXIST=YESNO)
1519:                CLOSE(LUNIT)1519:          IF (PAIRDIST1.NE.0) YESNO=.FALSE. ! so we can write new entries for READMIN etc.
1520:                PRINT '(A,I8)','setup> Pair distance values read'1520:          IF (YESNO) THEN
1521:             ELSE1521: 
1522:                CALL GETMETRIC(1,NMIN)1522: !                 OPEN(UNIT=LUNIT,FILE='pairdist',STATUS='UNKNOWN')
1523:                LUNIT=GETUNIT()1523: !                 DO J3=1,NMIN
1524:                OPEN(UNIT=LUNIT,FILE='allpairs',STATUS='UNKNOWN')1524: !                    WRITE(LUNIT,'(10G20.10)') (PAIRDIST(J3,J4),J4=1,PAIRDISTMAX)
1525:                WRITE(LUNIT,'(G20.10)') ALLPAIRS(1:(NMIN*(NMIN-1))/2)1525: !                 ENDDO
1526:                CLOSE(LUNIT)1526: !                 CLOSE(LUNIT)
1527:             ENDIF1527: !                 OPEN(UNIT=LUNIT,FILE='pairlist',STATUS='UNKNOWN')
 1528: !                 DO J3=1,NMIN
 1529: !                    WRITE(LUNIT,'(10I10)') (PAIRLIST(J3,J4),J4=1,PAIRDISTMAX)
 1530: !                 ENDDO
 1531: !                 CLOSE(LUNIT)
 1532: 
 1533:             LUNIT=GETUNIT()
 1534:             OPEN(UNIT=LUNIT,FILE='pairdist',STATUS='OLD')
 1535:             DO J1=1,NMIN
 1536:                READ(LUNIT,*) (PAIRDIST(J1,J2),J2=1,PAIRDISTMAX)
 1537:             ENDDO
 1538:             CLOSE(LUNIT)
 1539:             LUNIT=GETUNIT()
 1540:             OPEN(UNIT=LUNIT,FILE='pairlist',STATUS='OLD')
 1541:             DO J1=1,NMIN
 1542:                READ(LUNIT,*) (PAIRLIST(J1,J2),J2=1,PAIRDISTMAX)
 1543:             ENDDO
 1544:             CLOSE(LUNIT)
 1545:             PRINT '(A,I8)','setup> Pair distance metric values read'
1528:          ELSE1546:          ELSE
1529:             PAIRDIST(1:NMIN,1:PAIRDISTMAX)=1.0D1001547:             IF (PAIRDIST1.EQ.0) PAIRDIST1=1
1530:             PAIRLIST(1:NMIN,1:PAIRDISTMAX)=-11548:             IF (PAIRDIST2.EQ.0) PAIRDIST2=NMIN
1531:             INQUIRE(FILE='pairdist',EXIST=YESNO)1549:             IF (PAIRDIST1.GT.NMIN) STOP
1532:             IF (PAIRDIST1.NE.0) YESNO=.FALSE. ! so we can write new entries for READMIN etc.1550:             PAIRDIST2=MIN(PAIRDIST2,NMIN)
1533:             IF (YESNO) THEN1551:             CALL GETMETRIC(PAIRDIST1,PAIRDIST2)
1534:                LUNIT=GETUNIT()1552:             IF ((PAIRDIST1.EQ.1).AND.(PAIRDIST2.EQ.NMIN)) THEN
1535:                OPEN(UNIT=LUNIT,FILE='pairdist',STATUS='OLD')1553:                OPEN(UNIT=1,FILE='pairdist',STATUS='UNKNOWN')
1536:                DO J1=1,NMIN1554:                DO J3=1,NMIN
1537:                   READ(LUNIT,*) (PAIRDIST(J1,J2),J2=1,PAIRDISTMAX)1555:                   WRITE(1,'(10G20.10)') (PAIRDIST(J3,J4),J4=1,PAIRDISTMAX)
1538:                ENDDO1556:                ENDDO
1539:                CLOSE(LUNIT)1557:                CLOSE(1)
1540:                LUNIT=GETUNIT()1558:                OPEN(UNIT=1,FILE='pairlist',STATUS='UNKNOWN')
1541:                OPEN(UNIT=LUNIT,FILE='pairlist',STATUS='OLD')1559:                DO J3=1,NMIN
1542:                DO J1=1,NMIN1560:                   WRITE(1,'(10I10)') (PAIRLIST(J3,J4),J4=1,PAIRDISTMAX)
1543:                   READ(LUNIT,*) (PAIRLIST(J1,J2),J2=1,PAIRDISTMAX) 
1544:                ENDDO1561:                ENDDO
1545:                CLOSE(LUNIT)1562:                CLOSE(1)
1546:                PRINT '(A,I8)','setup> Pair distance metric values read' 
1547:             ELSE1563:             ELSE
1548:                IF (PAIRDIST1.EQ.0) PAIRDIST1=11564:                WRITE(S1,'(I10)') PAIRDIST1
1549:                IF (PAIRDIST2.EQ.0) PAIRDIST2=NMIN1565:                WRITE(S2,'(I10)') PAIRDIST2
1550:                IF (PAIRDIST1.GT.NMIN) STOP1566:                WRITE(FNAME,'(A)') 'pairdist.' // TRIM(ADJUSTL(S1)) // '.' // TRIM(ADJUSTL(S2))
1551:                PAIRDIST2=MIN(PAIRDIST2,NMIN)1567:                OPEN(UNIT=1,FILE=TRIM(ADJUSTL(FNAME)),STATUS='UNKNOWN')
1552:                CALL GETMETRIC(PAIRDIST1,PAIRDIST2)1568:                DO J3=PAIRDIST1,PAIRDIST2
1553:                IF ((PAIRDIST1.EQ.1).AND.(PAIRDIST2.EQ.NMIN)) THEN1569:                   WRITE(1,'(10G20.10)') (PAIRDIST(J3,J4),J4=1,PAIRDISTMAX)
1554:                   OPEN(UNIT=1,FILE='pairdist',STATUS='UNKNOWN')1570:                ENDDO
1555:                   DO J3=1,NMIN1571:                CLOSE(1)
1556:                      WRITE(1,'(10G20.10)') (PAIRDIST(J3,J4),J4=1,PAIRDISTMAX)1572:                WRITE(FNAME,'(A)') 'pairlist.' // TRIM(ADJUSTL(S1)) // '.' // TRIM(ADJUSTL(S2))
1557:                   ENDDO1573:                OPEN(UNIT=1,FILE=TRIM(ADJUSTL(FNAME)),STATUS='UNKNOWN')
1558:                   CLOSE(1)1574:                DO J3=PAIRDIST1,PAIRDIST2
1559:                   OPEN(UNIT=1,FILE='pairlist',STATUS='UNKNOWN')1575:                   WRITE(1,'(10I10)') (PAIRLIST(J3,J4),J4=1,PAIRDISTMAX)
1560:                   DO J3=1,NMIN1576:                ENDDO
1561:                      WRITE(1,'(10I10)') (PAIRLIST(J3,J4),J4=1,PAIRDISTMAX)1577:                CLOSE(1)
1562:                   ENDDO1578:                STOP
1563:                   CLOSE(1) 
1564:                ELSE 
1565:                   WRITE(S1,'(I10)') PAIRDIST1 
1566:                   WRITE(S2,'(I10)') PAIRDIST2 
1567:                   WRITE(FNAME,'(A)') 'pairdist.' // TRIM(ADJUSTL(S1)) // '.' // TRIM(ADJUSTL(S2)) 
1568:                   OPEN(UNIT=1,FILE=TRIM(ADJUSTL(FNAME)),STATUS='UNKNOWN') 
1569:                   DO J3=PAIRDIST1,PAIRDIST2 
1570:                      WRITE(1,'(10G20.10)') (PAIRDIST(J3,J4),J4=1,PAIRDISTMAX) 
1571:                   ENDDO 
1572:                   CLOSE(1) 
1573:                   WRITE(FNAME,'(A)') 'pairlist.' // TRIM(ADJUSTL(S1)) // '.' // TRIM(ADJUSTL(S2)) 
1574:                   OPEN(UNIT=1,FILE=TRIM(ADJUSTL(FNAME)),STATUS='UNKNOWN') 
1575:                   DO J3=PAIRDIST1,PAIRDIST2 
1576:                      WRITE(1,'(10I10)') (PAIRLIST(J3,J4),J4=1,PAIRDISTMAX) 
1577:                   ENDDO 
1578:                   CLOSE(1) 
1579:                   STOP 
1580:                ENDIF 
1581:             ENDIF1579:             ENDIF
1582:          ENDIF1580:          ENDIF
1583:       ENDIF1581:       ENDIF
1584: C1582: C
1585: C  Add transition states and minima from the <PATHNAME> file.1583: C  Add transition states and minima from the <PATHNAME> file.
1586: C  Use GETNEWPATH to do the bookkeeping.1584: C  Use GETNEWPATH to do the bookkeeping.
1587: C1585: C
1588:       IF (ADDPATH) THEN1586:       IF (ADDPATH) THEN
1589:          CALL MYSYSTEM(STATUS,DEBUG,'cp ' // TRIM(ADJUSTL(PATHNAME)) // ' path.info')1587:          CALL MYSYSTEM(STATUS,DEBUG,'cp ' // TRIM(ADJUSTL(PATHNAME)) // ' path.info')
1590: !        IF (ADDTRIPLES) THEN1588: !        IF (ADDTRIPLES) THEN


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0