hdiff output

r32518/getconnectpair.f90 2017-05-11 17:30:08.586664403 +0100 r32517/getconnectpair.f90 2017-05-11 17:30:09.678678387 +0100
 22: !  of NUSEPAIRS in array USEPAIRSMIN 22: !  of NUSEPAIRS in array USEPAIRSMIN
 23: ! 23: !
 24: SUBROUTINE GETCONNECTPAIR(NAVAIL,NUSED,MINS,MINF,SPOINTS,FPOINTS) 24: SUBROUTINE GETCONNECTPAIR(NAVAIL,NUSED,MINS,MINF,SPOINTS,FPOINTS)
 25: USE COMMONS, ONLY: NCONNECTPAIRS, CONNECTPAIRSMIN, UMIN, NATOMS, DMIN1, DMIN2, NATTEMPT, NCPU, MAXBARRIER,  & 25: USE COMMONS, ONLY: NCONNECTPAIRS, CONNECTPAIRSMIN, UMIN, NATOMS, DMIN1, DMIN2, NATTEMPT, NCPU, MAXBARRIER,  &
 26:   &               DEBUG, NPAIRFRQ, PAIR1, PAIR2, NPAIRFRQ, NPAIRDONE, MAXPAIRS, LOCATIONA, LOCATIONB, NCONNMAX, & 26:   &               DEBUG, NPAIRFRQ, PAIR1, PAIR2, NPAIRFRQ, NPAIRDONE, MAXPAIRS, LOCATIONA, LOCATIONB, NCONNMAX, &
 27:                   NTS, NMIN, NMINA, NMINB, DIRECTION, PLUS, MINUS, KPLUS, KMINUS, NCONN, & 27:                   NTS, NMIN, NMINA, NMINB, DIRECTION, PLUS, MINUS, KPLUS, KMINUS, NCONN, &
 28:   &               ETS, EMIN, SKIPPAIRST 28:   &               ETS, EMIN, SKIPPAIRST
 29: USE PORFUNCS 29: USE PORFUNCS
 30: IMPLICIT NONE 30: IMPLICIT NONE
 31: INTEGER NUSED, MINS, MINF, NAVAIL, PAIRSTODO, J1, J2, J3, NDIFF 31: INTEGER NUSED, MINS, MINF, NAVAIL, PAIRSTODO, J1, J2, J3, NDIFF
 32: DOUBLE PRECISION SPOINTS(NOPT), FPOINTS(NOPT) 32: DOUBLE PRECISION SPOINTS(3*NATOMS), FPOINTS(3*NATOMS)
 33: DOUBLE PRECISION DMATMC(NCONNMAX,NMIN), KSUM(NMIN) 33: DOUBLE PRECISION DMATMC(NCONNMAX,NMIN), KSUM(NMIN)
 34: INTEGER NCOL(NMIN), NVAL(NCONNMAX,NMIN), NDISTA(NMIN), NDISTB(NMIN), NCYCLE, DMIN 34: INTEGER NCOL(NMIN), NVAL(NCONNMAX,NMIN), NDISTA(NMIN), NDISTB(NMIN), NCYCLE, DMIN
 35: INTEGER :: NDISTSTART(NMIN), NUNCONSTART ! sn402 35: INTEGER :: NDISTSTART(NMIN), NUNCONSTART ! sn402
 36: LOGICAL DEADTS(NTS), ISA(NMIN), ISB(NMIN), CHANGED, CHECKCONN 36: LOGICAL DEADTS(NTS), ISA(NMIN), ISB(NMIN), CHANGED, CHECKCONN
 37: INTEGER DMAX, NUNCONA, NUNCONB 37: INTEGER DMAX, NUNCONA, NUNCONB
 38: DOUBLE PRECISION :: CUT_UNDERFLOW=-300.0D0 38: DOUBLE PRECISION :: CUT_UNDERFLOW=-300.0D0
 39:  39: 
 40: IF (NAVAIL.EQ.0) THEN 40: IF (NAVAIL.EQ.0) THEN
 41: ! 41: !
 42: ! If called a second time we won't get any more candidate pairs because the routine 42: ! If called a second time we won't get any more candidate pairs because the routine
 78: MINS=DMIN1(NUSED) 78: MINS=DMIN1(NUSED)
 79: MINF=DMIN2(NUSED) 79: MINF=DMIN2(NUSED)
 80:  80: 
 81: WRITE(*,'(5(A,I8))') 'getconnectpair> connecting minima ',MINS,' and ',MINF, ' pairs used=',  & 81: WRITE(*,'(5(A,I8))') 'getconnectpair> connecting minima ',MINS,' and ',MINF, ' pairs used=',  &
 82:   &  NUSED,' remaining=',NAVAIL,' total pairs=',NPAIRDONE 82:   &  NUSED,' remaining=',NAVAIL,' total pairs=',NPAIRDONE
 83: NPAIRDONE=NPAIRDONE+1 83: NPAIRDONE=NPAIRDONE+1
 84: IF (NPAIRDONE.GT.MAXPAIRS) CALL PAIRDOUBLE 84: IF (NPAIRDONE.GT.MAXPAIRS) CALL PAIRDOUBLE
 85: PAIR1(NPAIRDONE)=DMIN1(NUSED) 85: PAIR1(NPAIRDONE)=DMIN1(NUSED)
 86: PAIR2(NPAIRDONE)=DMIN2(NUSED) 86: PAIR2(NPAIRDONE)=DMIN2(NUSED)
 87: CALL FLUSH(6) 87: CALL FLUSH(6)
 88: READ(UMIN,REC=MINS) SPOINTS(1:NOPT) 88: READ(UMIN,REC=MINS) SPOINTS(1:3*NATOMS)
 89: READ(UMIN,REC=MINF) FPOINTS(1:NOPT) 89: READ(UMIN,REC=MINF) FPOINTS(1:3*NATOMS)
 90:  90: 
 91: END SUBROUTINE GETCONNECTPAIR 91: END SUBROUTINE GETCONNECTPAIR


r32518/getdpair.f90 2017-05-11 17:30:08.802667167 +0100 r32517/getdpair.f90 2017-05-11 17:30:09.898681194 +0100
 19:  19: 
 20: ! 20: !
 21: !  Subroutine to provide candidate pairs of minima based on Dijkstra analysis 21: !  Subroutine to provide candidate pairs of minima based on Dijkstra analysis
 22: !  of the current database. 22: !  of the current database.
 23: ! 23: !
 24: SUBROUTINE GETDPAIR(NAVAIL,NUSED,MINS,MINF,SPOINTS,FPOINTS) 24: SUBROUTINE GETDPAIR(NAVAIL,NUSED,MINS,MINF,SPOINTS,FPOINTS)
 25: USE COMMONS, ONLY: UMIN, NATOMS, DMIN1, DMIN2, DIJINITT, NCPU, NPAIRFRQ, NATTEMPT, NMIN, DIJINITFLYT, & 25: USE COMMONS, ONLY: UMIN, NATOMS, DMIN1, DMIN2, DIJINITT, NCPU, NPAIRFRQ, NATTEMPT, NMIN, DIJINITFLYT, &
 26:   &  PAIR1, PAIR2, NPAIRDONE, MAXPAIRS 26:   &  PAIR1, PAIR2, NPAIRDONE, MAXPAIRS
 27: IMPLICIT NONE 27: IMPLICIT NONE
 28: INTEGER NUSED, MINS, MINF, NAVAIL, PAIRSTODO, MINMAP(NMIN), NMINSAVE, J1 28: INTEGER NUSED, MINS, MINF, NAVAIL, PAIRSTODO, MINMAP(NMIN), NMINSAVE, J1
 29: DOUBLE PRECISION SPOINTS(NOPT), FPOINTS(NOPT) 29: DOUBLE PRECISION SPOINTS(3*NATOMS), FPOINTS(3*NATOMS)
 30:  30: 
 31: 10 CONTINUE 31: 10 CONTINUE
 32: IF (NAVAIL.EQ.0) THEN 32: IF (NAVAIL.EQ.0) THEN
 33:    IF (DIJINITT) THEN  33:    IF (DIJINITT) THEN 
 34:       CALL DIJINIT(NAVAIL) 34:       CALL DIJINIT(NAVAIL)
 35:    ELSE IF (DIJINITFLYT) THEN  35:    ELSE IF (DIJINITFLYT) THEN 
 36:       CALL GETNCONN ! must call this first to set NCONNMAX  36:       CALL GETNCONN ! must call this first to set NCONNMAX 
 37:       CALL DIJINITFLY(NAVAIL) 37:       CALL DIJINITFLY(NAVAIL)
 38:    ELSE 38:    ELSE
 39:       PAIRSTODO=NCPU*NPAIRFRQ 39:       PAIRSTODO=NCPU*NPAIRFRQ
 58: ENDIF 58: ENDIF
 59: NUSED=NUSED+1 59: NUSED=NUSED+1
 60: NAVAIL=NAVAIL-1 60: NAVAIL=NAVAIL-1
 61: MINS=DMIN1(NUSED) 61: MINS=DMIN1(NUSED)
 62: MINF=DMIN2(NUSED) 62: MINF=DMIN2(NUSED)
 63: WRITE(*,'(4(A,I8))') 'getdpair> connecting minima ',MINS,' and ',MINF, ' pairs used=',NUSED,' remaining=',NAVAIL 63: WRITE(*,'(4(A,I8))') 'getdpair> connecting minima ',MINS,' and ',MINF, ' pairs used=',NUSED,' remaining=',NAVAIL
 64: NPAIRDONE=NPAIRDONE+1 64: NPAIRDONE=NPAIRDONE+1
 65: IF (NPAIRDONE.GT.MAXPAIRS) CALL PAIRDOUBLE 65: IF (NPAIRDONE.GT.MAXPAIRS) CALL PAIRDOUBLE
 66: PAIR1(NPAIRDONE)=DMIN1(NUSED) 66: PAIR1(NPAIRDONE)=DMIN1(NUSED)
 67: PAIR2(NPAIRDONE)=DMIN2(NUSED) 67: PAIR2(NPAIRDONE)=DMIN2(NUSED)
 68: READ(UMIN,REC=MINS) SPOINTS(1:NOPT) 68: READ(UMIN,REC=MINS) SPOINTS(1:3*NATOMS)
 69: READ(UMIN,REC=MINF) FPOINTS(1:NOPT) 69: READ(UMIN,REC=MINF) FPOINTS(1:3*NATOMS)
 70:  70: 
 71: END SUBROUTINE GETDPAIR 71: END SUBROUTINE GETDPAIR


r32518/getspair.f90 2017-05-11 17:30:09.022669985 +0100 r32517/getspair.f90 2017-05-11 17:30:10.118684009 +0100
 24: SUBROUTINE GETSPAIR(NAVAIL,NUSED,MINS,MINF,SPOINTS,FPOINTS) 24: SUBROUTINE GETSPAIR(NAVAIL,NUSED,MINS,MINF,SPOINTS,FPOINTS)
 25: USE COMMONS, ONLY: UMIN, NATOMS, DMIN1, DMIN2, NATTEMPT, NCPU, MINSEP, BULKT, TWOD, ZSYM, DEBUG, BESTPATHLENGTH, ETS, & 25: USE COMMONS, ONLY: UMIN, NATOMS, DMIN1, DMIN2, NATTEMPT, NCPU, MINSEP, BULKT, TWOD, ZSYM, DEBUG, BESTPATHLENGTH, ETS, &
 26:   &               NPAIRFRQ, PAIR1, PAIR2, NPAIRFRQ, NPAIRDONE, MAXPAIRS, PERMDIST, BOXLX, BOXLY, BOXLZ, RIGIDBODY, BESTPATH, & 26:   &               NPAIRFRQ, PAIR1, PAIR2, NPAIRFRQ, NPAIRDONE, MAXPAIRS, PERMDIST, BOXLX, BOXLY, BOXLZ, RIGIDBODY, BESTPATH, &
 27:   &               BARRIERSHORT, EMIN, PLUS, MINUS, KPLUS, KMINUS, RATESHORT, ANGLEAXIS, NMIN, INTERPCOSTFUNCTION 27:   &               BARRIERSHORT, EMIN, PLUS, MINUS, KPLUS, KMINUS, RATESHORT, ANGLEAXIS, NMIN, INTERPCOSTFUNCTION
 28: USE PORFUNCS 28: USE PORFUNCS
 29: IMPLICIT NONE 29: IMPLICIT NONE
 30: INTEGER NUSED, MINS, MINF, NAVAIL, PAIRSTODO, J1, NSTEPS, J2, J3, J4, N1, N2 30: INTEGER NUSED, MINS, MINF, NAVAIL, PAIRSTODO, J1, NSTEPS, J2, J3, J4, N1, N2
 31: INTEGER NMINSAVE, MINMAP(NMIN) 31: INTEGER NMINSAVE, MINMAP(NMIN)
 32: INTEGER, ALLOCATABLE :: MINLIST(:), POSITION(:) 32: INTEGER, ALLOCATABLE :: MINLIST(:), POSITION(:)
 33: DOUBLE PRECISION, ALLOCATABLE :: DISTLIST(:), BHEIGHT(:) 33: DOUBLE PRECISION, ALLOCATABLE :: DISTLIST(:), BHEIGHT(:)
 34: DOUBLE PRECISION SPOINTS(NOPT), FPOINTS(NOPT), DISTANCE, RMAT(3,3), DIST2 34: DOUBLE PRECISION SPOINTS(3*NATOMS), FPOINTS(3*NATOMS), DISTANCE, RMAT(3,3), DIST2
 35:  35: 
 36: 10 CONTINUE 36: 10 CONTINUE
 37: IF (NAVAIL.EQ.0) THEN 37: IF (NAVAIL.EQ.0) THEN
 38:    PAIRSTODO=NCPU*NPAIRFRQ 38:    PAIRSTODO=NCPU*NPAIRFRQ
 39:    IF (NPAIRFRQ.LT.1) PAIRSTODO=NATTEMPT*NCPU ! just one set of pairs unless we run out 39:    IF (NPAIRFRQ.LT.1) PAIRSTODO=NATTEMPT*NCPU ! just one set of pairs unless we run out
 40:    CALL GETNCONN 40:    CALL GETNCONN
 41: ! 41: !
 42: !  NMINSAVE and MINMAP are just dummies here. 42: !  NMINSAVE and MINMAP are just dummies here.
 43: ! 43: !
 44:    NMINSAVE=NMIN 44:    NMINSAVE=NMIN
111:             DMIN2(NAVAIL)=N2111:             DMIN2(NAVAIL)=N2
112:             DISTLIST(NAVAIL)=BHEIGHT(J1)112:             DISTLIST(NAVAIL)=BHEIGHT(J1)
113:             IF (NAVAIL.GE.PAIRSTODO) EXIT113:             IF (NAVAIL.GE.PAIRSTODO) EXIT
114:          ENDDO loop1114:          ENDDO loop1
115:          IF (NAVAIL.GE.PAIRSTODO) EXIT115:          IF (NAVAIL.GE.PAIRSTODO) EXIT
116:       ENDDO116:       ENDDO
117:       DEALLOCATE(BHEIGHT,POSITION)117:       DEALLOCATE(BHEIGHT,POSITION)
118:    ELSE118:    ELSE
119:       DISTLIST(1:PAIRSTODO)=1.0D100119:       DISTLIST(1:PAIRSTODO)=1.0D100
120:       DO J1=1,NSTEPS120:       DO J1=1,NSTEPS
121:          READ(UMIN,REC=MINLIST(J1)) (SPOINTS(J2),J2=1,NOPT)121:          READ(UMIN,REC=MINLIST(J1)) (SPOINTS(J2),J2=1,3*NATOMS)
122:          min2: DO J2=J1+1,NSTEPS122:          min2: DO J2=J1+1,NSTEPS
123:             DO J3=1,NPAIRDONE123:             DO J3=1,NPAIRDONE
124:                IF ((PAIR1(J3).EQ.MINLIST(J1)).AND.(PAIR2(J3).EQ.MINLIST(J2))) CYCLE min2 ! do not repeat searches124:                IF ((PAIR1(J3).EQ.MINLIST(J1)).AND.(PAIR2(J3).EQ.MINLIST(J2))) CYCLE min2 ! do not repeat searches
125:                IF ((PAIR1(J3).EQ.MINLIST(J2)).AND.(PAIR2(J3).EQ.MINLIST(J1))) CYCLE min2 ! do not repeat searches125:                IF ((PAIR1(J3).EQ.MINLIST(J2)).AND.(PAIR2(J3).EQ.MINLIST(J1))) CYCLE min2 ! do not repeat searches
126:             ENDDO126:             ENDDO
127:             IF (J2-J1.GE.MINSEP) THEN ! find distance if separation is >= MINSEP127:             IF (J2-J1.GE.MINSEP) THEN ! find distance if separation is >= MINSEP
128:                READ(UMIN,REC=MINLIST(J2)) (FPOINTS(J3),J3=1,NOPT)128:                READ(UMIN,REC=MINLIST(J2)) (FPOINTS(J3),J3=1,3*NATOMS)
129:                CALL MINPERMDIST(SPOINTS,FPOINTS,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE,DIST2,RIGIDBODY, &129:                CALL MINPERMDIST(SPOINTS,FPOINTS,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE,DIST2,RIGIDBODY, &
130:   &                             RMAT,.FALSE.)130:   &                             RMAT,.FALSE.)
131:                IF (INTERPCOSTFUNCTION) CALL MINPERMDIST(SPOINTS,FPOINTS,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD, &131:                IF (INTERPCOSTFUNCTION) CALL MINPERMDIST(SPOINTS,FPOINTS,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD, &
132:   &                             DISTANCE,DIST2,RIGIDBODY,RMAT,INTERPCOSTFUNCTION)132:   &                             DISTANCE,DIST2,RIGIDBODY,RMAT,INTERPCOSTFUNCTION)
133:                NAVAIL=NAVAIL+1133:                NAVAIL=NAVAIL+1
134:                sortloop: DO J3=1,MIN(NAVAIL,PAIRSTODO) ! sort the shortest PAIRSTODO values134:                sortloop: DO J3=1,MIN(NAVAIL,PAIRSTODO) ! sort the shortest PAIRSTODO values
135:                   IF (DISTANCE.LT.DISTLIST(J3)) THEN135:                   IF (DISTANCE.LT.DISTLIST(J3)) THEN
136:                      DO J4=MIN(NAVAIL,PAIRSTODO),J3+1,-1136:                      DO J4=MIN(NAVAIL,PAIRSTODO),J3+1,-1
137:                         DMIN1(J4)=DMIN1(J4-1)137:                         DMIN1(J4)=DMIN1(J4-1)
138:                         DMIN2(J4)=DMIN2(J4-1)138:                         DMIN2(J4)=DMIN2(J4-1)
164: NAVAIL=NAVAIL-1164: NAVAIL=NAVAIL-1
165: MINS=DMIN1(NUSED)165: MINS=DMIN1(NUSED)
166: MINF=DMIN2(NUSED)166: MINF=DMIN2(NUSED)
167: WRITE(*,'(5(A,I8))') 'getspair> connecting minima ',MINS,' and ',MINF, ' pairs used=',  &167: WRITE(*,'(5(A,I8))') 'getspair> connecting minima ',MINS,' and ',MINF, ' pairs used=',  &
168:   &  NUSED,' remaining=',NAVAIL,' total pairs=',NPAIRDONE168:   &  NUSED,' remaining=',NAVAIL,' total pairs=',NPAIRDONE
169: NPAIRDONE=NPAIRDONE+1169: NPAIRDONE=NPAIRDONE+1
170: IF (NPAIRDONE.GT.MAXPAIRS) CALL PAIRDOUBLE170: IF (NPAIRDONE.GT.MAXPAIRS) CALL PAIRDOUBLE
171: PAIR1(NPAIRDONE)=DMIN1(NUSED)171: PAIR1(NPAIRDONE)=DMIN1(NUSED)
172: PAIR2(NPAIRDONE)=DMIN2(NUSED)172: PAIR2(NPAIRDONE)=DMIN2(NUSED)
173: CALL FLUSH(6)173: CALL FLUSH(6)
174: READ(UMIN,REC=MINS) SPOINTS(1:NOPT)174: READ(UMIN,REC=MINS) SPOINTS(1:3*NATOMS)
175: READ(UMIN,REC=MINF) FPOINTS(1:NOPT)175: READ(UMIN,REC=MINF) FPOINTS(1:3*NATOMS)
176: 176: 
177: END SUBROUTINE GETSPAIR177: END SUBROUTINE GETSPAIR


r32518/getupair.f90 2017-05-11 17:30:09.242672799 +0100 r32517/getupair.f90 2017-05-11 17:30:10.366687197 +0100
 26:   &               NPAIRFRQ, PAIR1, PAIR2, NPAIRFRQ, NPAIRDONE, MAXPAIRS, DMINMAX, DEBUG, LOCATIONA, LOCATIONB, BULKT, & 26:   &               NPAIRFRQ, PAIR1, PAIR2, NPAIRFRQ, NPAIRDONE, MAXPAIRS, DMINMAX, DEBUG, LOCATIONA, LOCATIONB, BULKT, &
 27:   &               ZSYM, TWOD, DIRECTION, PLUS, MINUS, NMINA, NMINB, EMIN, NTS, ETS, EUNTRAPTHRESH, EINC, DEBUG, ANGLEAXIS, & 27:   &               ZSYM, TWOD, DIRECTION, PLUS, MINUS, NMINA, NMINB, EMIN, NTS, ETS, EUNTRAPTHRESH, EINC, DEBUG, ANGLEAXIS, &
 28:   &               TSTHRESH, TOPPOINTER, POINTERP, POINTERM, BOXLX, BOXLY, BOXLZ, RIGIDBODY, INTERPCOSTFUNCTION, & 28:   &               TSTHRESH, TOPPOINTER, POINTERP, POINTERM, BOXLX, BOXLY, BOXLZ, RIGIDBODY, INTERPCOSTFUNCTION, &
 29:   &               METRICUPAIR, UNTRAPMETRICT, METMATMAX, BAILDIST                          29:   &               METRICUPAIR, UNTRAPMETRICT, METMATMAX, BAILDIST                         
 30: USE PORFUNCS 30: USE PORFUNCS
 31: IMPLICIT NONE 31: IMPLICIT NONE
 32: INTEGER NUSED, MINS, MINF, NAVAIL, PAIRSTODO, J1, J3, J4, CLOSEST(NMIN), MINVAL, OLDBASIN(NMIN), BASIN(NMIN), NBASIN, J2, NDONE 32: INTEGER NUSED, MINS, MINF, NAVAIL, PAIRSTODO, J1, J3, J4, CLOSEST(NMIN), MINVAL, OLDBASIN(NMIN), BASIN(NMIN), NBASIN, J2, NDONE
 33: INTEGER MAXNEIGHBOURS, NP, NNEIGH, JDOING, NTRIED, J5, J6, J7 33: INTEGER MAXNEIGHBOURS, NP, NNEIGH, JDOING, NTRIED, J5, J6, J7
 34: INTEGER, ALLOCATABLE :: NEIGHBOURS(:), ITEMP(:) 34: INTEGER, ALLOCATABLE :: NEIGHBOURS(:), ITEMP(:)
 35: DOUBLE PRECISION, ALLOCATABLE :: BLIST(:) 35: DOUBLE PRECISION, ALLOCATABLE :: BLIST(:)
 36: DOUBLE PRECISION SPOINTS(NOPT), FPOINTS(NOPT), BARRIER(NMIN), POINTS1(NOPT), POINTS2(NOPT), & 36: DOUBLE PRECISION SPOINTS(3*NATOMS), FPOINTS(3*NATOMS), BARRIER(NMIN), POINTS1(3*NATOMS), POINTS2(3*NATOMS), &
 37:   &              DISTANCE, RMAT(3,3), DIST2, LOWESTTARG, & 37:   &              DISTANCE, RMAT(3,3), DIST2, LOWESTTARG, &
 38:   &              HIGHESTTS, DUMMY, ETHRESH 38:   &              HIGHESTTS, DUMMY, ETHRESH
 39: INTEGER, ALLOCATABLE :: VINT(:) 39: INTEGER, ALLOCATABLE :: VINT(:)
 40: INTEGER MINMET(1:METMATMAX) 40: INTEGER MINMET(1:METMATMAX)
 41: LOGICAL ISA(NMIN), ISB(NMIN), BASINT(NMIN), CHANGED, DONE(NMIN), MATCHED, OLDBASINT(NMIN), OHCELLTSV, METRICM 41: LOGICAL ISA(NMIN), ISB(NMIN), BASINT(NMIN), CHANGED, DONE(NMIN), MATCHED, OLDBASINT(NMIN), OHCELLTSV, METRICM
 42:  42: 
 43: ALLOCATE(VINT(DMINMAX)) 43: ALLOCATE(VINT(DMINMAX))
 44:  44: 
 45:  45: 
 46: 10 CONTINUE 46: 10 CONTINUE
205:          ENDDO 205:          ENDDO 
206:       ENDIF206:       ENDIF
207:       DO J1=1,MINVAL ! cycle over target minima207:       DO J1=1,MINVAL ! cycle over target minima
208:         NTRIED=0208:         NTRIED=0
209:         IF (DONE(J1)) CYCLE209:         IF (DONE(J1)) CYCLE
210: ! Use metric to find pairs210: ! Use metric to find pairs
211:         IF (UNTRAPMETRICT) THEN211:         IF (UNTRAPMETRICT) THEN
212:           DO J3=1,NPAIRDONE212:           DO J3=1,NPAIRDONE
213:             IF (PAIR1(J3).EQ.DMIN1(J1)) CYCLE ! do not repeat searches213:             IF (PAIR1(J3).EQ.DMIN1(J1)) CYCLE ! do not repeat searches
214:           ENDDO214:           ENDDO
215:           READ(UMIN,REC=DMIN1(J1)) POINTS1(1:NOPT)215:           READ(UMIN,REC=DMIN1(J1)) POINTS1(1:3*NATOMS)
216:           IF (DEBUG) PRINT*, 'Use metric to find pairs'216:           IF (DEBUG) PRINT*, 'Use metric to find pairs'
217:           METRICM=.FALSE.217:           METRICM=.FALSE.
218:           IF (DEBUG) PRINT*, 'Call getupairmetric'218:           IF (DEBUG) PRINT*, 'Call getupairmetric'
219:           CALL GETUPAIRMETRIC(DMIN1(J1), MINMET, METRICUPAIR, METRICM,METMATMAX)  219:           CALL GETUPAIRMETRIC(DMIN1(J1), MINMET, METRICUPAIR, METRICM,METMATMAX)  
220:           IF (METRICM) THEN220:           IF (METRICM) THEN
221:           DUMMY=1.0D100 221:           DUMMY=1.0D100 
222:            DO J6=1,INT(METMATMAX/20.0D0)222:            DO J6=1,INT(METMATMAX/20.0D0)
223:             IF (DUMMY.LT.BAILDIST) EXIT 223:             IF (DUMMY.LT.BAILDIST) EXIT 
224:             DO J7=1,20224:             DO J7=1,20
225:             IF (J7.LE.10) THEN225:             IF (J7.LE.10) THEN
226:               J5=INT(METMATMAX/2.0D0)-(J6*10)+(J7-1)226:               J5=INT(METMATMAX/2.0D0)-(J6*10)+(J7-1)
227:             ELSE227:             ELSE
228:               J5=INT(METMATMAX/2.0D0)+(J6*10)-(J7-10)228:               J5=INT(METMATMAX/2.0D0)+(J6*10)-(J7-10)
229:             ENDIF   229:             ENDIF   
230:             IF (MINMET(J5).GT.NMIN) CYCLE230:             IF (MINMET(J5).GT.NMIN) CYCLE
231:             IF (MINMET(J5).LT.1) CYCLE231:             IF (MINMET(J5).LT.1) CYCLE
232:             IF (MINMET(J5).EQ.DMIN1(J1)) THEN232:             IF (MINMET(J5).EQ.DMIN1(J1)) THEN
233:                 PRINT*, 'SKIPPING - trying to connect to self! MINMET(J5),DMIN1(J1) ',MINMET(J5),DMIN1(J1)233:                 PRINT*, 'SKIPPING - trying to connect to self! MINMET(J5),DMIN1(J1) ',MINMET(J5),DMIN1(J1)
234:                 CYCLE234:                 CYCLE
235:             ENDIF  235:             ENDIF  
236:             READ(UMIN,REC=MINMET(J5)) POINTS2(1:NOPT)236:             READ(UMIN,REC=MINMET(J5)) POINTS2(1:3*NATOMS)
237:             IF (DEBUG) PRINT*, 'Call minpermdist'237:             IF (DEBUG) PRINT*, 'Call minpermdist'
238:             IF (DEBUG) CALL FLUSH(6)238:             IF (DEBUG) CALL FLUSH(6)
239:             CALL MINPERMDIST(POINTS1,POINTS2,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE,DIST2,RIGIDBODY,&239:             CALL MINPERMDIST(POINTS1,POINTS2,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE,DIST2,RIGIDBODY,&
240:   &                          RMAT,.FALSE.)240:   &                          RMAT,.FALSE.)
241:             IF (DISTANCE.LT.DUMMY) THEN241:             IF (DISTANCE.LT.DUMMY) THEN
242:             DUMMY=DISTANCE242:             DUMMY=DISTANCE
243:             DMIN2(J1)=MINMET(J5)243:             DMIN2(J1)=MINMET(J5)
244:             ENDIF244:             ENDIF
245:             WRITE(6,'(A58,I10,I10,2F11.5)') 'Matrix index, matching minimum, distance, best distance = ', &245:             WRITE(6,'(A58,I10,I10,2F11.5)') 'Matrix index, matching minimum, distance, best distance = ', &
246:   &                                         J5, MINMET(J5), DISTANCE, DUMMY246:   &                                         J5, MINMET(J5), DISTANCE, DUMMY
287:                   NEIGHBOURS(NNEIGH)=PLUS(NP)287:                   NEIGHBOURS(NNEIGH)=PLUS(NP)
288:                   NP=POINTERM(NP)288:                   NP=POINTERM(NP)
289:                ENDIF289:                ENDIF
290:                IF (.NOT.MATCHED) THEN290:                IF (.NOT.MATCHED) THEN
291:                   PRINT '(A,I6,A)','getupair minimum ',JDOING,' not matched - this should never happen'291:                   PRINT '(A,I6,A)','getupair minimum ',JDOING,' not matched - this should never happen'
292:                   STOP292:                   STOP
293:                ENDIF293:                ENDIF
294:             ENDDO294:             ENDDO
295: !           PRINT '(A,I8,A,I8,A)','getupair> minimum ',JDOING,' has ',NNEIGH,' neighbours'295: !           PRINT '(A,I8,A,I8,A)','getupair> minimum ',JDOING,' has ',NNEIGH,' neighbours'
296: ! Read in the coordinates of the minimum we are trying to UNTRAP (in DMIN1)296: ! Read in the coordinates of the minimum we are trying to UNTRAP (in DMIN1)
297:             READ(UMIN,REC=DMIN1(J1)) POINTS1(1:NOPT)297:             READ(UMIN,REC=DMIN1(J1)) POINTS1(1:3*NATOMS)
298: !298: !
299: !  Which product minimum should we try to connect to? Try the closest in the299: !  Which product minimum should we try to connect to? Try the closest in the
300: !  product superbasin before they merge within threshold EUNTRAPTHRESH.300: !  product superbasin before they merge within threshold EUNTRAPTHRESH.
301: !301: !
302:             DUMMY=1.0D100302:             DUMMY=1.0D100
303:             min2: DO J2=1,NMIN303:             min2: DO J2=1,NMIN
304: !              IF (OLDBASIN(J2).EQ.BASIN(DMIN1(J1))) THEN304: !              IF (OLDBASIN(J2).EQ.BASIN(DMIN1(J1))) THEN
305:                IF (OLDBASIN(J2).EQ.0) CYCLE305:                IF (OLDBASIN(J2).EQ.0) CYCLE
306:                IF (OLDBASINT(OLDBASIN(J2))) THEN ! this minimum was in a product basin in the last cycle306:                IF (OLDBASINT(OLDBASIN(J2))) THEN ! this minimum was in a product basin in the last cycle
307: !                 PRINT '(A,7I6)','J1,DMIN1(J1),J2,BASIN(DMIN1(J1)),OLDBASIN(DMIN1(J1)),BASIN(J2),OLDBASIN(J2)=', &307: !                 PRINT '(A,7I6)','J1,DMIN1(J1),J2,BASIN(DMIN1(J1)),OLDBASIN(DMIN1(J1)),BASIN(J2),OLDBASIN(J2)=', &
314:                            CYCLE min2 ! they are already connected!314:                            CYCLE min2 ! they are already connected!
315:                         ENDIF315:                         ENDIF
316:                      ENDDO316:                      ENDDO
317: 317: 
318:                      DO J3=1,NPAIRDONE318:                      DO J3=1,NPAIRDONE
319:                         IF ((PAIR1(J3).EQ.DMIN1(J1)).AND.(PAIR2(J3).EQ.J2)) CYCLE min2 ! do not repeat searches319:                         IF ((PAIR1(J3).EQ.DMIN1(J1)).AND.(PAIR2(J3).EQ.J2)) CYCLE min2 ! do not repeat searches
320:                         IF ((PAIR1(J3).EQ.J2).AND.(PAIR2(J3).EQ.DMIN1(J1))) CYCLE min2 ! do not repeat searches320:                         IF ((PAIR1(J3).EQ.J2).AND.(PAIR2(J3).EQ.DMIN1(J1))) CYCLE min2 ! do not repeat searches
321:                      ENDDO321:                      ENDDO
322: ! Read in the coordinates of the potential partner minimum and call MINPERMDIST322: ! Read in the coordinates of the potential partner minimum and call MINPERMDIST
323: ! to calculate the distance.323: ! to calculate the distance.
324:                      READ(UMIN,REC=J2) POINTS2(1:NOPT)324:                      READ(UMIN,REC=J2) POINTS2(1:3*NATOMS)
325:                      NTRIED=NTRIED+1 325:                      NTRIED=NTRIED+1 
326:                      CALL MINPERMDIST(POINTS1,POINTS2,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE,DIST2,RIGIDBODY, &326:                      CALL MINPERMDIST(POINTS1,POINTS2,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE,DIST2,RIGIDBODY, &
327:   &                                   RMAT,.FALSE.)327:   &                                   RMAT,.FALSE.)
328:                      IF (INTERPCOSTFUNCTION) CALL MINPERMDIST(POINTS1,POINTS2,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD, &328:                      IF (INTERPCOSTFUNCTION) CALL MINPERMDIST(POINTS1,POINTS2,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD, &
329:   &                                                           DISTANCE,DIST2,RIGIDBODY,RMAT,INTERPCOSTFUNCTION)329:   &                                                           DISTANCE,DIST2,RIGIDBODY,RMAT,INTERPCOSTFUNCTION)
330: ! If the distance for the pair is smaller than previously found (DUMMY), replace330: ! If the distance for the pair is smaller than previously found (DUMMY), replace
331: ! DUMMY with the current value.331: ! DUMMY with the current value.
332:                      IF (DISTANCE.LT.DUMMY) THEN332:                      IF (DISTANCE.LT.DUMMY) THEN
333:                         DUMMY=DISTANCE333:                         DUMMY=DISTANCE
334:                         IF (DEBUG) PRINT '(3(A,I6),A,G20.10,A,F12.2)','getupair> changing partner for min ', &334:                         IF (DEBUG) PRINT '(3(A,I6),A,G20.10,A,F12.2)','getupair> changing partner for min ', &
381: NAVAIL=NAVAIL-1381: NAVAIL=NAVAIL-1
382: MINS=DMIN1(NUSED)382: MINS=DMIN1(NUSED)
383: MINF=DMIN2(NUSED)383: MINF=DMIN2(NUSED)
384: WRITE(*,'(5(A,I8))') 'getupair> connecting minima ',MINS,' and ',MINF, ' pairs used=',  &384: WRITE(*,'(5(A,I8))') 'getupair> connecting minima ',MINS,' and ',MINF, ' pairs used=',  &
385:   &    NUSED,' remaining=',NAVAIL,' total pairs=',NPAIRDONE385:   &    NUSED,' remaining=',NAVAIL,' total pairs=',NPAIRDONE
386: CALL FLUSH(6)386: CALL FLUSH(6)
387: NPAIRDONE=NPAIRDONE+1387: NPAIRDONE=NPAIRDONE+1
388: IF (NPAIRDONE.GT.MAXPAIRS) CALL PAIRDOUBLE388: IF (NPAIRDONE.GT.MAXPAIRS) CALL PAIRDOUBLE
389: PAIR1(NPAIRDONE)=DMIN1(NUSED)389: PAIR1(NPAIRDONE)=DMIN1(NUSED)
390: PAIR2(NPAIRDONE)=DMIN2(NUSED)390: PAIR2(NPAIRDONE)=DMIN2(NUSED)
391: READ(UMIN,REC=MINS) SPOINTS(1:NOPT)391: READ(UMIN,REC=MINS) SPOINTS(1:3*NATOMS)
392: READ(UMIN,REC=MINF) FPOINTS(1:NOPT)392: READ(UMIN,REC=MINF) FPOINTS(1:3*NATOMS)
393: 393: 
394: END SUBROUTINE GETUPAIR394: END SUBROUTINE GETUPAIR
395: 395: 
396: !396: !
397: !  Find the approximate lowest barrier from each minimum to a minimum from397: !  Find the approximate lowest barrier from each minimum to a minimum from
398: !  the product region using a superbasin analysis.398: !  the product region using a superbasin analysis.
399: !399: !
400: SUBROUTINE GETBARRIER(BARRIER,CLOSEST,LOWESTTARG)400: SUBROUTINE GETBARRIER(BARRIER,CLOSEST,LOWESTTARG)
401: USE COMMONS,ONLY : NMIN, NTS, ETS, EMIN, NMINA, NMINB, PLUS, MINUS, LOCATIONA, LOCATIONB, DIRECTION, EINC, DEBUG, TSTHRESH,  &401: USE COMMONS,ONLY : NMIN, NTS, ETS, EMIN, NMINA, NMINB, PLUS, MINUS, LOCATIONA, LOCATIONB, DIRECTION, EINC, DEBUG, TSTHRESH,  &
402:   &  ELOWBAR, EHIGHBAR402:   &  ELOWBAR, EHIGHBAR


r32518/getusepair.f90 2017-05-11 17:30:09.458675564 +0100 r32517/getusepair.f90 2017-05-11 17:30:10.614690361 +0100
 22: !  of NUSEPAIRS in array USEPAIRSMIN 22: !  of NUSEPAIRS in array USEPAIRSMIN
 23: ! 23: !
 24: SUBROUTINE GETUSEPAIR(NAVAIL,NUSED,MINS,MINF,SPOINTS,FPOINTS) 24: SUBROUTINE GETUSEPAIR(NAVAIL,NUSED,MINS,MINF,SPOINTS,FPOINTS)
 25: USE COMMONS, ONLY: NUSEPAIRS, USEPAIRSMIN, UMIN, NATOMS, DMIN1, DMIN2, NATTEMPT, NCPU, MAXBARRIER,  & 25: USE COMMONS, ONLY: NUSEPAIRS, USEPAIRSMIN, UMIN, NATOMS, DMIN1, DMIN2, NATTEMPT, NCPU, MAXBARRIER,  &
 26:   &               DEBUG, NPAIRFRQ, PAIR1, PAIR2, NPAIRFRQ, NPAIRDONE, MAXPAIRS, LOCATIONA, LOCATIONB, NCONNMAX, & 26:   &               DEBUG, NPAIRFRQ, PAIR1, PAIR2, NPAIRFRQ, NPAIRDONE, MAXPAIRS, LOCATIONA, LOCATIONB, NCONNMAX, &
 27:                   NTS, NMIN, NMINA, NMINB, DIRECTION, PLUS, MINUS, KPLUS, KMINUS, NCONN, & 27:                   NTS, NMIN, NMINA, NMINB, DIRECTION, PLUS, MINUS, KPLUS, KMINUS, NCONN, &
 28:   &               ETS, EMIN, SKIPPAIRST 28:   &               ETS, EMIN, SKIPPAIRST
 29: USE PORFUNCS 29: USE PORFUNCS
 30: IMPLICIT NONE 30: IMPLICIT NONE
 31: INTEGER NUSED, MINS, MINF, NAVAIL, PAIRSTODO, J1, J2, J3, NDIFF 31: INTEGER NUSED, MINS, MINF, NAVAIL, PAIRSTODO, J1, J2, J3, NDIFF
 32: DOUBLE PRECISION SPOINTS(NOPT), FPOINTS(NOPT) 32: DOUBLE PRECISION SPOINTS(3*NATOMS), FPOINTS(3*NATOMS)
 33: DOUBLE PRECISION DMATMC(NCONNMAX,NMIN), KSUM(NMIN) 33: DOUBLE PRECISION DMATMC(NCONNMAX,NMIN), KSUM(NMIN)
 34: INTEGER NCOL(NMIN), NVAL(NCONNMAX,NMIN), NDISTA(NMIN), NDISTB(NMIN), NCYCLE, DMIN 34: INTEGER NCOL(NMIN), NVAL(NCONNMAX,NMIN), NDISTA(NMIN), NDISTB(NMIN), NCYCLE, DMIN
 35: INTEGER :: NDISTSTART(NMIN), NUNCONSTART ! sn402 35: INTEGER :: NDISTSTART(NMIN), NUNCONSTART ! sn402
 36: LOGICAL DEADTS(NTS), ISA(NMIN), ISB(NMIN), CHANGED, CHECKCONN 36: LOGICAL DEADTS(NTS), ISA(NMIN), ISB(NMIN), CHANGED, CHECKCONN
 37: INTEGER DMAX, NUNCONA, NUNCONB 37: INTEGER DMAX, NUNCONA, NUNCONB
 38: DOUBLE PRECISION :: CUT_UNDERFLOW=-300.0D0 38: DOUBLE PRECISION :: CUT_UNDERFLOW=-300.0D0
 39:  39: 
 40: IF (NAVAIL.EQ.0) THEN 40: IF (NAVAIL.EQ.0) THEN
 41:    NDIFF=1 41:    NDIFF=1
 42:    PAIRSTODO=NCPU*NPAIRFRQ 42:    PAIRSTODO=NCPU*NPAIRFRQ
214: ENDIF214: ENDIF
215: 215: 
216: 216: 
217: WRITE(*,'(5(A,I8))') 'getusepair> connecting minima ',MINS,' and ',MINF, ' pairs used=',  &217: WRITE(*,'(5(A,I8))') 'getusepair> connecting minima ',MINS,' and ',MINF, ' pairs used=',  &
218:   &  NUSED,' remaining=',NAVAIL,' total pairs=',NPAIRDONE218:   &  NUSED,' remaining=',NAVAIL,' total pairs=',NPAIRDONE
219: NPAIRDONE=NPAIRDONE+1219: NPAIRDONE=NPAIRDONE+1
220: IF (NPAIRDONE.GT.MAXPAIRS) CALL PAIRDOUBLE220: IF (NPAIRDONE.GT.MAXPAIRS) CALL PAIRDOUBLE
221: PAIR1(NPAIRDONE)=DMIN1(NUSED)221: PAIR1(NPAIRDONE)=DMIN1(NUSED)
222: PAIR2(NPAIRDONE)=DMIN2(NUSED)222: PAIR2(NPAIRDONE)=DMIN2(NUSED)
223: CALL FLUSH(6)223: CALL FLUSH(6)
224: READ(UMIN,REC=MINS) SPOINTS(1:NOPT)224: READ(UMIN,REC=MINS) SPOINTS(1:3*NATOMS)
225: READ(UMIN,REC=MINF) FPOINTS(1:NOPT)225: READ(UMIN,REC=MINF) FPOINTS(1:3*NATOMS)
226: 226: 
227: END SUBROUTINE GETUSEPAIR227: END SUBROUTINE GETUSEPAIR


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0