hdiff output

r29132/atom_label_flips.f90 2015-11-17 23:33:26.388858652 +0000 r29131/atom_label_flips.f90 2015-11-17 23:33:27.144868791 +0000
 25:   ! 25:   !
 26:   WRITE(MYUNIT,'(A)') & 26:   WRITE(MYUNIT,'(A)') &
 27:        '============================================================' 27:        '============================================================'
 28:   ! 28:   !
 29:   IF(LFLIPS_RESET) THEN 29:   IF(LFLIPS_RESET) THEN
 30:      WRITE(MYUNIT,'(A)') 'flipseq> Resetting stoichiometry...' 30:      WRITE(MYUNIT,'(A)') 'flipseq> Resetting stoichiometry...'
 31:      CALL RESET_STOICHIOMETRY() 31:      CALL RESET_STOICHIOMETRY()
 32:      NQTOT = NQTOT + 1 32:      NQTOT = NQTOT + 1
 33:      NQ(NP) = NQ(NP) + 1 33:      NQ(NP) = NQ(NP) + 1
 34:      CALL QUENCH(.FALSE.,NP,ITER,TIME,BRUN,QDONE,SCREENC) 34:      CALL QUENCH(.FALSE.,NP,ITER,TIME,BRUN,QDONE,SCREENC)
 35:      IF (NPAR.GT.1) THEN 35:      IF (MOD(N-1,PRTFRQ).EQ.0) THEN
 36:         WRITE(MYUNIT,'(A,I1,A,I10,A,F20.10,A,I5,A,G12.5,A,F11.1)') & 36:         IF (NPAR.GT.1) THEN
 37:              '[',NP,']Qu ',NQ(NP),' E=',POTEL,' steps=',ITER, & 37:            WRITE(MYUNIT,'(A,I1,A,I10,A,F20.10,A,I5,A,G12.5,A,F11.1)') &
 38:              ' RMS=',RMS,' t=',TIME 38:                 '[',NP,']Qu ',NQ(NP),' E=',POTEL,' steps=',ITER, &
 39:      ELSE 39:                 ' RMS=',RMS,' t=',TIME
 40:         WRITE(MYUNIT,'(A,I10,A,F20.10,A,I5,A,G12.5,A,F11.1)') & 40:         ELSE
 41:              'Qu ',NQ(NP),' E=',POTEL,' steps=',ITER, & 41:            WRITE(MYUNIT,'(A,I10,A,F20.10,A,I5,A,G12.5,A,F11.1)') &
 42:              ' RMS=',RMS,' t=',TIME 42:                 'Qu ',NQ(NP),' E=',POTEL,' steps=',ITER, &
 43:      ENDIF     43:                 ' RMS=',RMS,' t=',TIME
  44:         ENDIF
  45:      ENDIF
 44:   ENDIF 46:   ENDIF
 45:   ! 47:   !
 46:   NSPECIES_MIN(:) = NSPECIES(:) 48:   NSPECIES_MIN(:) = NSPECIES(:)
 47:   ATOMLISTS_MIN(:,:,:) = ATOMLISTS(:,:,:) 49:   ATOMLISTS_MIN(:,:,:) = ATOMLISTS(:,:,:)
 48:   INVATOMLISTS_MIN(:,:) = INVATOMLISTS(:,:) 50:   INVATOMLISTS_MIN(:,:) = INVATOMLISTS(:,:)
 49:   XMIN(1:3*NATOMS) = COORDS(1:3*NATOMS, NP) 51:   XMIN(1:3*NATOMS) = COORDS(1:3*NATOMS, NP)
 50:   EMIN = POTEL 52:   EMIN = POTEL
 51:   TEMP = LFLIPS_TEMP 53:   TEMP = LFLIPS_TEMP
 52:   ! 54:   !
 53:   WRITE(MYUNIT,'(A,F20.10,A,F10.8)',ADVANCE='NO') & 55:   WRITE(MYUNIT,'(A,F20.10,A,F10.8)',ADVANCE='NO') &


r29132/atomlists.f90 2015-11-17 23:33:26.572861117 +0000 r29131/atomlists.f90 2015-11-17 23:33:27.328871266 +0000
 72:   ! 72:   !
 73:   RETURN 73:   RETURN
 74:   ! 74:   !
 75: END SUBROUTINE RESET_ATOMLISTS 75: END SUBROUTINE RESET_ATOMLISTS
 76: ! 76: !
 77: ! ds656> Routine for resetting ATOMLISTS in accord with provided 77: ! ds656> Routine for resetting ATOMLISTS in accord with provided
 78: ! list of atomic labels.  78: ! list of atomic labels. 
 79: SUBROUTINE SET_ATOMLISTS(LABELS,IGROUP) 79: SUBROUTINE SET_ATOMLISTS(LABELS,IGROUP)
 80:   ! 80:   !
 81:   USE COMMONS, ONLY : ATOMLISTS, INVATOMLISTS, NATOMS, NSPECIES, & 81:   USE COMMONS, ONLY : ATOMLISTS, INVATOMLISTS, NATOMS, NSPECIES, &
 82:        SPECMASST, SPECMASS, ATMASS, MYUNIT, LFLIPST, QALCSMODE 82:        SPECMASST, SPECMASS, ATMASS, MYUNIT, LFLIPST
 83:   ! 83:   !
 84:   IMPLICIT NONE 84:   IMPLICIT NONE
 85:   ! 85:   !
 86:   INTEGER, INTENT(IN) :: LABELS(NATOMS), IGROUP 86:   INTEGER, INTENT(IN) :: LABELS(NATOMS), IGROUP
 87:   ! 87:   !
 88:   INTEGER :: I,J,TYPECOUNTS(1:NSPECIES(0)) 88:   INTEGER :: I,J,TYPECOUNTS(1:NSPECIES(0))
 89:   ! 89:   !
 90:   ATOMLISTS(:,:,:) = 0 90:   ATOMLISTS(:,:,:) = 0
 91:   INVATOMLISTS(:,:)=0 91:   INVATOMLISTS(:,:)=0
 92:   TYPECOUNTS(:) = 0 92:   TYPECOUNTS(:) = 0
102:      !102:      !
103:      INVATOMLISTS(I,1) = J103:      INVATOMLISTS(I,1) = J
104:      INVATOMLISTS(I,2) = IGROUP104:      INVATOMLISTS(I,2) = IGROUP
105:      INVATOMLISTS(I,3) = ATOMLISTS(J,IGROUP,0)105:      INVATOMLISTS(I,3) = ATOMLISTS(J,IGROUP,0)
106:      !106:      !
107:      IF(SPECMASST) ATMASS(I) = SPECMASS(J)107:      IF(SPECMASST) ATMASS(I) = SPECMASS(J)
108:      !108:      !
109:   END DO109:   END DO
110:   !110:   !
111:   DO I=1,NSPECIES(0)111:   DO I=1,NSPECIES(0)
112:      IF(LFLIPST.OR.(QALCSMODE.GE.6)) THEN112:      IF(LFLIPST) THEN
113:         NSPECIES(I) = TYPECOUNTS(I)113:         NSPECIES(I) = TYPECOUNTS(I)
114:      ELSE IF(NSPECIES(I) /= TYPECOUNTS(I)) THEN114:      ELSE IF(NSPECIES(I) /= TYPECOUNTS(I)) THEN
115:         WRITE(MYUNIT,'(A, I2, A, I5, I5)') &115:         WRITE(MYUNIT,'(A, I2, A, I5, I5)') &
116:              'set_atomlists> Inconsistent counts for atom-type ', &116:              'set_atomlists> Inconsistent counts for atom-type ', &
117:              I,' ,these numbers should equal:', NSPECIES(I), &117:              I,' ,these numbers should equal:', NSPECIES(I), &
118:              TYPECOUNTS(I)118:              TYPECOUNTS(I)
119:         STOP119:         STOP
120:      ENDIF120:      ENDIF
121:   END DO121:   END DO
122:   !122:   !


r29132/commons.f90 2015-11-17 23:33:26.764863694 +0000 r29131/commons.f90 2015-11-17 23:33:27.520873831 +0000
296:       INTEGER :: HOMOREF_FGMODE, HOMOREF_LSMODE, HOMOREF_NCYCLES296:       INTEGER :: HOMOREF_FGMODE, HOMOREF_LSMODE, HOMOREF_NCYCLES
297:       INTEGER :: HOMOREF_AUX_NSWAPS, HOMOREF_NFMAX, HOMOREF_NSMAX297:       INTEGER :: HOMOREF_AUX_NSWAPS, HOMOREF_NFMAX, HOMOREF_NSMAX
298:       INTEGER :: HOMOREF_BH_NSWAPMAX, HOMOREF_BH_NDUDMAX298:       INTEGER :: HOMOREF_BH_NSWAPMAX, HOMOREF_BH_NDUDMAX
299:       INTEGER :: RANDPERM_STEP, RANDMULTIPERM_STEP299:       INTEGER :: RANDPERM_STEP, RANDMULTIPERM_STEP
300:       DOUBLE PRECISION :: HOMOREF_AUX_TEMP, HOMOREF_AUX_FACTOR300:       DOUBLE PRECISION :: HOMOREF_AUX_TEMP, HOMOREF_AUX_FACTOR
301:       DOUBLE PRECISION :: HOMOREF_AUX_NNCUT301:       DOUBLE PRECISION :: HOMOREF_AUX_NNCUT
302:       DOUBLE PRECISION :: HOMOREF_BH_TEMP, HOMOREF_BH_FACTOR302:       DOUBLE PRECISION :: HOMOREF_BH_TEMP, HOMOREF_BH_FACTOR
303: !ds656> Quench-Assisted Local Combinatorial Search303: !ds656> Quench-Assisted Local Combinatorial Search
304:       LOGICAL :: QALCST, QALCSV, QALCS_SURFT, QALCS_SYMT, SPECLABELST304:       LOGICAL :: QALCST, QALCSV, QALCS_SURFT, QALCS_SYMT, SPECLABELST
305:       INTEGER :: QALCSMODE, QALCS_SYM_MINCORESIZE, QALCS_NBRHD, &305:       INTEGER :: QALCSMODE, QALCS_SYM_MINCORESIZE, QALCS_NBRHD, &
306:            QALCS_PARAM, SEQLENGTH306:            QALCS_PARAM, SWAPSEQLENGTH
307:       CHARACTER(LEN=2), ALLOCATABLE :: SPECLABELS(:)307:       CHARACTER(LEN=2), ALLOCATABLE :: SPECLABELS(:)
308: !ds656> Enumerate permutations308: !ds656> Enumerate permutations
309:       LOGICAL :: ENPERMST, MULTIPERMT, SPANSWAPST309:       LOGICAL :: ENPERMST, MULTIPERMT, SPANSWAPST
310:       DOUBLE PRECISION, ALLOCATABLE :: LEHMER_COORDS(:,:) ! NAT, NPAR310:       DOUBLE PRECISION, ALLOCATABLE :: LEHMER_COORDS(:,:) ! NAT, NPAR
311:       CHARACTER(LEN=1), ALLOCATABLE :: LEHMER_LIST(:,:) ! NATOMS, NPAR311:       CHARACTER(LEN=1), ALLOCATABLE :: LEHMER_LIST(:,:) ! NATOMS, NPAR
312:       CHARACTER(LEN=1), ALLOCATABLE :: LEHMER_LAST(:) ! NPAR312:       CHARACTER(LEN=1), ALLOCATABLE :: LEHMER_LAST(:) ! NPAR
313:       INTEGER, ALLOCATABLE :: LEHMER_ILASTB(:) ! NPAR313:       INTEGER, ALLOCATABLE :: LEHMER_ILASTB(:) ! NPAR
314: !ds656> Generalized LJ + Yukawa potential314: !ds656> Generalized LJ + Yukawa potential
315:       LOGICAL :: GLJY315:       LOGICAL :: GLJY
316: 316: 


r29132/QALCSearch.f90 2015-11-17 23:33:26.200856129 +0000 r29131/QALCSearch.f90 2015-11-17 23:33:26.952866217 +0000
 18: ! 18: !
 19: !============================================================= 19: !=============================================================
 20: !   All routines in this file were implemented by 20: !   All routines in this file were implemented by
 21: !   Dmitri Schebarchov (ds656). 21: !   Dmitri Schebarchov (ds656).
 22: !============================================================= 22: !=============================================================
 23: ! 23: !
 24: SUBROUTINE QALCS(NP,ITER,TIME,BRUN,QDONE,SCREENC) 24: SUBROUTINE QALCS(NP,ITER,TIME,BRUN,QDONE,SCREENC)
 25:   ! 25:   !
 26:   ! Quench-Assisted Local Combinatorial Search 26:   ! Quench-Assisted Local Combinatorial Search
 27:   ! 27:   !
 28:   USE COMMONS, ONLY : NATOMS,COORDS,ECONV,NSPECIES,TSTART,MYUNIT,& 28:   USE COMMONS, ONLY : NATOMS, COORDS, ECONV, NSPECIES, TSTART, MYUNIT, &
 29:                       INVATOMLISTS,QALCS_SURFT,QALCST,QALCSMODE,& 29:                       INVATOMLISTS, QALCS_SURFT, QALCST, QALCSMODE, &
 30:                       QALCS_SYMT, SEQLENGTH, SAVEMULTIMINONLY,& 30:                       QALCS_SYMT, SWAPSEQLENGTH, SAVEMULTIMINONLY
 31:                       LFLIPS_RESET,NPAR,RMS,NQ 
 32:   ! 31:   !
 33:   IMPLICIT NONE 32:   IMPLICIT NONE
 34:   ! 33:   !
 35:   ! Parsed variables 34:   ! Parsed variables
 36:   INTEGER, INTENT(IN) :: NP 35:   INTEGER, INTENT(IN) :: NP
 37:   INTEGER, INTENT(INOUT) :: ITER, BRUN, QDONE ! for QUENCH 36:   INTEGER, INTENT(INOUT) :: ITER, BRUN, QDONE ! for QUENCH
 38:   DOUBLE PRECISION, INTENT(INOUT) :: TIME, SCREENC(3*NATOMS) ! for QUENCH 37:   DOUBLE PRECISION, INTENT(INOUT) :: TIME, SCREENC(3*NATOMS) ! for QUENCH
 39:   ! 38:   !
 40:   LOGICAL :: DONE, STEP 39:   LOGICAL :: DONE, STEP
 41:   INTEGER :: ALPHA,BETA,AB(2),NQ0,NQTOT,NDUDS,NBLOCKS,L0(NATOMS) 40:   INTEGER :: ALPHA,BETA,AB(2),NQ0,NQTOT,NDUDS,NBLOCKS,L0(NATOMS)
 42:   DOUBLE PRECISION :: POTEL, E0 41:   DOUBLE PRECISION :: POTEL, E0
 43:   ! 42:   !
 44:   ! Energy of COORDS from last quench. Common block in QUENCH.   43:   ! Energy of COORDS from last quench. Common block in QUENCH.  
 45:   COMMON /MYPOT/ POTEL 44:   COMMON /MYPOT/ POTEL
 46:   ! Total quench count. Commom block in MC. 45:   ! Total quench count. Commom block in MC.
 47:   COMMON /TOT/ NQTOT 46:   COMMON /TOT/ NQTOT
 48:   ! 47:   !
 49:   IF(LFLIPS_RESET) THEN 
 50:      WRITE(MYUNIT,'(A)') 'QALCSearch> Resetting stoichiometry...' 
 51:      CALL RESET_STOICHIOMETRY() 
 52:      NQTOT = NQTOT + 1 
 53:      NQ(NP) = NQ(NP) + 1 
 54:      CALL QUENCH(.FALSE.,NP,ITER,TIME,BRUN,QDONE,SCREENC) 
 55:      IF (NPAR.GT.1) THEN 
 56:         WRITE(MYUNIT,'(A,I1,A,I10,A,F20.10,A,I5,A,G12.5,A,F11.1)') & 
 57:              '[',NP,']Qu ',NQ(NP),' E=',POTEL,' steps=',ITER, & 
 58:              ' RMS=',RMS,' t=',TIME 
 59:      ELSE 
 60:         WRITE(MYUNIT,'(A,I10,A,F20.10,A,I5,A,G12.5,A,F11.1)') & 
 61:              'Qu ',NQ(NP),' E=',POTEL,' steps=',ITER, & 
 62:              ' RMS=',RMS,' t=',TIME 
 63:      ENDIF 
 64:   ENDIF 
 65:   ! 
 66:   CALL MYCPU_TIME(TIME) 48:   CALL MYCPU_TIME(TIME)
 67:   WRITE(MYUNIT,'(A,F20.10,A,F11.1)') & 49:   WRITE(MYUNIT,'(A,F20.10,A,F11.1)') &
 68:        'QALCS> Initial E= ',POTEL,' t= ',TIME-TSTART 50:        'QALCS> Initial E= ',POTEL,' t= ',TIME-TSTART
 69:   ! 51:   !
 70:   ! Count species with non-zero population 52:   ! Count species with non-zero population
 71:   BETA=0 53:   BETA=0
 72:   DO ALPHA=1,NSPECIES(0) 54:   DO ALPHA=1,NSPECIES(0)
 73:      IF(NSPECIES(ALPHA) > 0) BETA = BETA+1 55:      IF(NSPECIES(ALPHA) > 0) BETA = BETA+1
 74:   ENDDO 56:   ENDDO
 75:   NBLOCKS = BETA*(BETA-1)/2 57:   NBLOCKS = BETA*(BETA-1)/2
 76:   ! 58:   !
 77:   DONE = .FALSE. 59:   DONE = .FALSE.
 78:   NQ0 = NQTOT 60:   NQ0 = NQTOT
 79:   ! 61:   !
 80:   ! The outer while loop is for QALCS_SYM or QALCS_SURF. 62:   ! The outer while loop is for QALCS_SYM or QALCS_SURF.
 81:   DO WHILE(.NOT. DONE)  63:   DO WHILE(.NOT. DONE) 
 82:      ! 64:      !
 83:      DONE = .TRUE. 65:      DONE = .TRUE.
 84:      ! 66:      !
 85:      L0(1:NATOMS) = INVATOMLISTS(1:NATOMS,1) 67:      L0(1:NATOMS) = INVATOMLISTS(1:NATOMS,1)
 86:      SEQLENGTH = 0 68:      SWAPSEQLENGTH = 0
 87:      ! 69:      !
 88:      IF(QALCST) THEN ! Loop over inter-species swap types. 70:      IF(QALCST) THEN ! Loop over inter-species swap types.
 89:         ! 71:         !
 90:         IF(QALCSMODE == 0) THEN ! Steepest descent (slow) 72:         IF(QALCSMODE == 0) THEN ! Steepest descent (slow)
 91:            ! 73:            !
 92:            STEP = .TRUE. 74:            STEP = .TRUE.
 93:            DO WHILE(STEP) 75:            DO WHILE(STEP)
 94:               CALL SPAN_SWAPS(NP,ITER,TIME,BRUN,QDONE,SCREENC,STEP) 76:               CALL SPAN_SWAPS(NP,ITER,TIME,BRUN,QDONE,SCREENC,STEP)
 95:            ENDDO 77:            ENDDO
 96:            ! 78:            !
 97:         ELSEIF(QALCSMODE >= 1 .AND. QALCSMODE < 4) THEN  79:         ELSEIF(QALCSMODE >= 1 .AND. QALCSMODE < 4) THEN 
 98:            ! 80:            !
 99:            ! More efficient descents with each interspecies 81:            ! More efficient descents with each interspecies
100:            ! swap types are treated separately. There are NBLOCKS 82:            ! swap types are treated separately. There are NBLOCKS
101:            ! different swap types, and we converge when all of  83:            ! different swap types, and we onverge when all of 
102:            ! them fail to yield an improvement. 84:            ! them fail to yield an improvement.
103:            ! 85:            !
104:            NDUDS = 0 86:            NDUDS = 0
105:            DO WHILE(NDUDS < NBLOCKS) 87:            DO WHILE(NDUDS < NBLOCKS)
106:               NDUDS = 1 88:               NDUDS = 1
107:               DO ALPHA=1,NSPECIES(0)-1 89:               DO ALPHA=1,NSPECIES(0)-1
108:                  IF(NSPECIES(ALPHA) == 0) CYCLE 90:                  IF(NSPECIES(ALPHA) == 0) CYCLE
109:                  AB(1) = ALPHA 91:                  AB(1) = ALPHA
110:                  DO BETA=ALPHA+1,NSPECIES(0) 92:                  DO BETA=ALPHA+1,NSPECIES(0)
111:                     IF(NSPECIES(BETA) == 0) CYCLE 93:                     IF(NSPECIES(BETA) == 0) CYCLE
121:               ENDDO103:               ENDDO
122:            ENDDO104:            ENDDO
123:            !105:            !
124:         ELSEIF(QALCSMODE >= 4 .AND. QALCSMODE < 6) THEN106:         ELSEIF(QALCSMODE >= 4 .AND. QALCSMODE < 6) THEN
125:            !107:            !
126:            ! In modes 4 and 5 all interspecies swap types108:            ! In modes 4 and 5 all interspecies swap types
127:            ! are lumped into a single neighbourhood, which 109:            ! are lumped into a single neighbourhood, which 
128:            ! is then ranked by unquenched swap-gain.110:            ! is then ranked by unquenched swap-gain.
129:            STEP=.TRUE.111:            STEP=.TRUE.
130:            DO WHILE(STEP)112:            DO WHILE(STEP)
131:               CALL SCAN_SWAP_NBRHD(NP,ITER,TIME,BRUN,QDONE,SCREENC,STEP)113:               CALL SCAN_NBRHD(NP,ITER,TIME,BRUN,QDONE,SCREENC,STEP)
132:            ENDDO 
133:            ! 
134:         ELSEIF(QALCSMODE == 6) THEN 
135:            ! 
136:            ! Steepest descent FLIP sequence.. 
137:            STEP = .TRUE. 
138:            DO WHILE(STEP) 
139:               CALL SPAN_FLIPS(NP,ITER,TIME,BRUN,QDONE,SCREENC,STEP) 
140:            ENDDO 
141:            ! 
142:         ELSEIF(QALCSMODE.EQ.7 .OR. QALCSMODE.EQ.8) THEN 
143:            ! 
144:            ! In modes 7 and 8 all interspecies flips 
145:            ! are lumped into a single neighbourhood, which  
146:            ! is then ranked by unquenched swap-gain (8) or  
147:            ! scanned in random order (7). 
148:            ! 
149:            STEP=.TRUE. 
150:            DO WHILE(STEP) 
151:               CALL SCAN_FLIP_NBRHD(NP,ITER,TIME,BRUN,QDONE,SCREENC,STEP) 
152:            ENDDO114:            ENDDO
153:            !115:            !
154:         ELSE116:         ELSE
155:            !117:            !
156:            WRITE(MYUNIT,'(A)') 'QALCSearch> Bad QALCSMODE!'118:            WRITE(MYUNIT,'(A)') 'QALCSearch> Bad QALCSMODE!'
157:            STOP119:            STOP
158:            !120:            !
159:         ENDIF121:         ENDIF
160:         !122:         !
161:      ENDIF123:      ENDIF
172:      ! DO ALPHA=1,NATOMS134:      ! DO ALPHA=1,NATOMS
173:      !    WRITE(MYUNIT,'(I3)',ADVANCE='NO') INVATOMLISTS(ALPHA,1)135:      !    WRITE(MYUNIT,'(I3)',ADVANCE='NO') INVATOMLISTS(ALPHA,1)
174:      !    IF(INVATOMLISTS(ALPHA,1) == 1) BETA=BETA+1136:      !    IF(INVATOMLISTS(ALPHA,1) == 1) BETA=BETA+1
175:      ! ENDDO137:      ! ENDDO
176:      ! WRITE(MYUNIT,*)138:      ! WRITE(MYUNIT,*)
177:      ! IF(BETA /= NSPECIES(1)) THEN139:      ! IF(BETA /= NSPECIES(1)) THEN
178:      !    WRITE(MYUNIT,'(A,I4)') 'QALCS_ab> Bad count for type-1:',BETA140:      !    WRITE(MYUNIT,'(A,I4)') 'QALCS_ab> Bad count for type-1:',BETA
179:      ! ENDIF141:      ! ENDIF
180:      !<ds656 End of testing.142:      !<ds656 End of testing.
181:      !143:      !
182:      CALL CALC_HAMMING_DISTANCE(NATOMS,L0(1:NATOMS),&144:      CALL CALC_MULTIPERM_DISTANCE(.TRUE.,NATOMS,L0(1:NATOMS),&
183:           INVATOMLISTS(1:NATOMS,1),ALPHA)145:           INVATOMLISTS(1:NATOMS,1),ALPHA)
184:      !146:      !
185:      CALL MYCPU_TIME(TIME)147:      CALL MYCPU_TIME(TIME)
186:      WRITE(MYUNIT,'(A,F20.10,A,I9,A,F11.1)') &148:      WRITE(MYUNIT,'(A,F20.10,A,I9,A,F11.1)') &
187:           'QALCS> Biminimum E= ',POTEL, &149:           'QALCS> Biminimum E= ',POTEL, &
188:           ' after ',NQTOT-NQ0,' quenches t= ',TIME-TSTART150:           ' after ',NQTOT-NQ0,' quenches t= ',TIME-TSTART
189:      WRITE(MYUNIT,'(A,I5,A,I5)') &151:      WRITE(MYUNIT,'(A,I5,A,I5)') &
190:           'QALCS> Swap-sequence length: ',SEQLENGTH,&152:           'QALCS> Swap-sequence length: ',SWAPSEQLENGTH,&
191:           ' Hamming distance: ',ALPHA153:           ' end-to-end distance: ',ALPHA
192:           154:           
193:      !155:      !
194:      E0 = POTEL156:      E0 = POTEL
195:      IF(QALCS_SYMT) THEN ! Symmetrisation scheme157:      IF(QALCS_SYMT) THEN ! Symmetrisation scheme
196:         CALL QALCS_SYM(NP,ITER,TIME,BRUN,QDONE,SCREENC)158:         CALL QALCS_SYM(NP,ITER,TIME,BRUN,QDONE,SCREENC)
197:      ENDIF159:      ENDIF
198:      IF(QALCS_SURFT) THEN ! Perform DLS-like surface optimisation.160:      IF(QALCS_SURFT) THEN ! Perform DLS-like surface optimisation.
199:         CALL QALCS_SURF(NP,ITER,TIME,BRUN,QDONE,SCREENC)161:         CALL QALCS_SURF(NP,ITER,TIME,BRUN,QDONE,SCREENC)
200:      ENDIF162:      ENDIF
201:      IF( POTEL < E0 - ECONV .AND. QALCST) DONE = .FALSE.163:      IF( POTEL < E0 - ECONV .AND. QALCST) DONE = .FALSE.
330: END SUBROUTINE QALCS_AB292: END SUBROUTINE QALCS_AB
331: !293: !
332: !=============================================================294: !=============================================================
333: !295: !
334: SUBROUTINE AB_SEARCH2(NP,ITER,TIME,BRUN,QDONE,SCREENC,LISTS_AB,I_AB)296: SUBROUTINE AB_SEARCH2(NP,ITER,TIME,BRUN,QDONE,SCREENC,LISTS_AB,I_AB)
335:   !297:   !
336:   ! Randomly search for negative swap gain in AB-block.298:   ! Randomly search for negative swap gain in AB-block.
337:   !299:   !
338:   USE PORFUNCS300:   USE PORFUNCS
339:   USE COMMONS, ONLY : NATOMS, COORDS, QALCSV, NQ, ECONV, &301:   USE COMMONS, ONLY : NATOMS, COORDS, QALCSV, NQ, ECONV, &
340:        MYUNIT, QALCSMODE, SEQLENGTH302:        MYUNIT, QALCSMODE, SWAPSEQLENGTH
341:   !303:   !
342:   IMPLICIT NONE304:   IMPLICIT NONE
343:   !305:   !
344:   ! Parsed variables306:   ! Parsed variables
345:   INTEGER, INTENT(IN) :: NP,LISTS_AB(1:2,0:NATOMS)307:   INTEGER, INTENT(IN) :: NP,LISTS_AB(1:2,0:NATOMS)
346:   INTEGER, INTENT(OUT) :: I_AB(1:2)308:   INTEGER, INTENT(OUT) :: I_AB(1:2)
347:   INTEGER, INTENT(INOUT) :: ITER, BRUN, QDONE ! for QUENCH309:   INTEGER, INTENT(INOUT) :: ITER, BRUN, QDONE ! for QUENCH
348:   DOUBLE PRECISION, INTENT(INOUT) :: TIME, SCREENC(3*NATOMS) ! for QUENCH310:   DOUBLE PRECISION, INTENT(INOUT) :: TIME, SCREENC(3*NATOMS) ! for QUENCH
349:   !311:   !
350:   INTEGER :: NQTOT, N, NTOT, SWAPS(LISTS_AB(1,0)*LISTS_AB(2,0),2),&312:   INTEGER :: NQTOT, N, NTOT, SWAPS(LISTS_AB(1,0)*LISTS_AB(2,0),2),&
415:      CALL QUENCH(.FALSE.,NP,ITER,TIME,BRUN,QDONE,SCREENC)377:      CALL QUENCH(.FALSE.,NP,ITER,TIME,BRUN,QDONE,SCREENC)
416:      IF(QALCSV) THEN378:      IF(QALCSV) THEN
417:         CALL PRINT_QUENCH(NP, ITER, '  ')379:         CALL PRINT_QUENCH(NP, ITER, '  ')
418:         IF(QALCSMODE==3) THEN380:         IF(QALCSMODE==3) THEN
419:            WRITE(MYUNIT,'(2(A,F15.10))') &381:            WRITE(MYUNIT,'(2(A,F15.10))') &
420:                 'ab_search2> dE*= ',EST(J)-E0,' dE= ',POTEL-E0 382:                 'ab_search2> dE*= ',EST(J)-E0,' dE= ',POTEL-E0 
421:         ENDIF383:         ENDIF
422:      ENDIF384:      ENDIF
423:      !385:      !
424:      IF(POTEL < E0 - ECONV) THEN386:      IF(POTEL < E0 - ECONV) THEN
425:         SEQLENGTH = SEQLENGTH + 1387:         SWAPSEQLENGTH = SWAPSEQLENGTH + 1
426:         WRITE(MYUNIT,'(A,I4,A,I4,A,F15.10)') &388:         WRITE(MYUNIT,'(A,I4,A,I4,A,F15.10)') &
427:              'ab_search2> ',SWAPS(J,1),' <-> ',SWAPS(J,2),&389:              'ab_search2> ',SWAPS(J,1),' <-> ',SWAPS(J,2),&
428:              ' => dE= ', POTEL-E0390:              ' => dE= ', POTEL-E0
429:         I_AB(1:2) = SWAPS(J,1:2)391:         I_AB(1:2) = SWAPS(J,1:2)
430:         RETURN392:         RETURN
431:      ELSE 393:      ELSE 
432:         ! Undo the swap and restore the configuratiion394:         ! Undo the swap and restore the configuratiion
433:         CALL SWAP_LABELS(SWAPS(J,1),SWAPS(J,2))395:         CALL SWAP_LABELS(SWAPS(J,1),SWAPS(J,2))
434:         COORDS(1:3*NATOMS, NP) = X0(1:3*NATOMS)396:         COORDS(1:3*NATOMS, NP) = X0(1:3*NATOMS)
435:         POTEL = E0397:         POTEL = E0
453: !415: !
454: !=============================================================416: !=============================================================
455: !417: !
456: SUBROUTINE AB_SEARCH(NP,ITER,TIME,BRUN,QDONE,SCREENC, & 418: SUBROUTINE AB_SEARCH(NP,ITER,TIME,BRUN,QDONE,SCREENC, & 
457:      LISTS_AB,FLIPS_AB,I_AB,SCAN_ALL)419:      LISTS_AB,FLIPS_AB,I_AB,SCAN_ALL)
458:   !420:   !
459:   ! Search for negative swap gain in AB-(sub)block.421:   ! Search for negative swap gain in AB-(sub)block.
460:   !422:   !
461:   USE PORFUNCS423:   USE PORFUNCS
462:   USE COMMONS, ONLY : NATOMS, COORDS, QALCSV, NQ, ECONV, &424:   USE COMMONS, ONLY : NATOMS, COORDS, QALCSV, NQ, ECONV, &
463:        MYUNIT, SEQLENGTH425:        MYUNIT, SWAPSEQLENGTH
464:   !426:   !
465:   IMPLICIT NONE427:   IMPLICIT NONE
466:   !428:   !
467:   ! Parsed variables429:   ! Parsed variables
468:   LOGICAL, INTENT(IN) :: SCAN_ALL430:   LOGICAL, INTENT(IN) :: SCAN_ALL
469:   INTEGER, INTENT(IN) :: NP,LISTS_AB(1:2,0:NATOMS)431:   INTEGER, INTENT(IN) :: NP,LISTS_AB(1:2,0:NATOMS)
470:   INTEGER, INTENT(OUT) :: I_AB(1:2)432:   INTEGER, INTENT(OUT) :: I_AB(1:2)
471:   INTEGER, INTENT(INOUT) :: ITER, BRUN, QDONE ! for QUENCH433:   INTEGER, INTENT(INOUT) :: ITER, BRUN, QDONE ! for QUENCH
472:   DOUBLE PRECISION, INTENT(INOUT) :: TIME, SCREENC(3*NATOMS) ! for QUENCH434:   DOUBLE PRECISION, INTENT(INOUT) :: TIME, SCREENC(3*NATOMS) ! for QUENCH
473:   DOUBLE PRECISION, INTENT(IN) :: FLIPS_AB(1:2,1:NATOMS)435:   DOUBLE PRECISION, INTENT(IN) :: FLIPS_AB(1:2,1:NATOMS)
604:            WRITE(MYUNIT,'(A)') 'ab_search> List depleted!'566:            WRITE(MYUNIT,'(A)') 'ab_search> List depleted!'
605:         ENDIF567:         ENDIF
606:         !568:         !
607:      ENDDO sublist569:      ENDDO sublist
608:      !570:      !
609:      IF(.NOT. SCAN_ALL) COMPLETE = .TRUE.571:      IF(.NOT. SCAN_ALL) COMPLETE = .TRUE.
610:      !572:      !
611:   ENDDO list573:   ENDDO list
612:   !574:   !
613:   IF(EBEST < E0 - ECONV) THEN575:   IF(EBEST < E0 - ECONV) THEN
614:      SEQLENGTH = SEQLENGTH + 1576:      SWAPSEQLENGTH = SWAPSEQLENGTH + 1
615:      CALL SWAP_LABELS( I_AB(1), I_AB(2) )577:      CALL SWAP_LABELS( I_AB(1), I_AB(2) )
616:      !SCREENC(1:3*NATOMS) = XBEST(1:3*NATOMS)578:      !SCREENC(1:3*NATOMS) = XBEST(1:3*NATOMS)
617:      COORDS(1:3*NATOMS, NP) = XBEST(1:3*NATOMS)579:      COORDS(1:3*NATOMS, NP) = XBEST(1:3*NATOMS)
618:      POTEL = EBEST580:      POTEL = EBEST
619:      WRITE(MYUNIT,'(A,I4,A,I4,A,F20.10)') &581:      WRITE(MYUNIT,'(A,I4,A,I4,A,F20.10)') &
620:           'ab_search> Swapped ',I_AB(1),' and ',I_AB(2), &582:           'ab_search> Swapped ',I_AB(1),' and ',I_AB(2), &
621:           ' to get E=',POTEL583:           ' to get E=',POTEL
622:      CALL FLUSH(MYUNIT)584:      CALL FLUSH(MYUNIT)
623:   !ELSE585:   !ELSE
624:   !   WRITE(MYUNIT,'(A)') 'ab_search> Found no good swaps.'586:   !   WRITE(MYUNIT,'(A)') 'ab_search> Found no good swaps.'
835: SUBROUTINE SPAN_SWAPS(NP,ITER,TIME,BRUN,QDONE,SCREENC,STEP)797: SUBROUTINE SPAN_SWAPS(NP,ITER,TIME,BRUN,QDONE,SCREENC,STEP)
836:   !798:   !
837:   ! Calculated all swap gains and count the number of 799:   ! Calculated all swap gains and count the number of 
838:   ! negative ones. If STEP=.true. on input, then find800:   ! negative ones. If STEP=.true. on input, then find
839:   ! and execute the lowest flip gain; and in the absence801:   ! and execute the lowest flip gain; and in the absence
840:   ! of negative flip gains set STEP=.false on output.802:   ! of negative flip gains set STEP=.false on output.
841:   ! Determine if the configuration is a minimum or a803:   ! Determine if the configuration is a minimum or a
842:   ! saddle (or neither) in permutation space.804:   ! saddle (or neither) in permutation space.
843:   !805:   !
844:   USE COMMONS, ONLY : NSPECIES,ATOMLISTS,NATOMS,COORDS,NQ, &806:   USE COMMONS, ONLY : NSPECIES,ATOMLISTS,NATOMS,COORDS,NQ, &
845:        QALCSV,ECONV,MYUNIT,SEQLENGTH807:        QALCSV,ECONV,MYUNIT,SWAPSEQLENGTH
846:   !808:   !
847:   IMPLICIT NONE809:   IMPLICIT NONE
848:   !810:   !
849:   ! Parsed variables811:   ! Parsed variables
850:   INTEGER, INTENT(IN) :: NP812:   INTEGER, INTENT(IN) :: NP
851:   INTEGER, INTENT(INOUT) :: ITER, BRUN, QDONE ! for QUENCH813:   INTEGER, INTENT(INOUT) :: ITER, BRUN, QDONE ! for QUENCH
852:   DOUBLE PRECISION, INTENT(INOUT) :: TIME, SCREENC(3*NATOMS)814:   DOUBLE PRECISION, INTENT(INOUT) :: TIME, SCREENC(3*NATOMS)
853:   ! 815:   ! 
854:   LOGICAL, INTENT(INOUT) :: STEP816:   LOGICAL, INTENT(INOUT) :: STEP
855:   !817:   !
934:         WRITE(MYUNIT, '(A)') ' => saddle.'896:         WRITE(MYUNIT, '(A)') ' => saddle.'
935:      ELSE897:      ELSE
936:         WRITE(MYUNIT, '(A)') ' => ?'898:         WRITE(MYUNIT, '(A)') ' => ?'
937:      ENDIF899:      ENDIF
938:   ELSE900:   ELSE
939:      WRITE(MYUNIT,*)901:      WRITE(MYUNIT,*)
940:   ENDIF902:   ENDIF
941:   !903:   !
942:   IF(STEP) THEN904:   IF(STEP) THEN
943:      IF(NNEG > 0) THEN905:      IF(NNEG > 0) THEN
944:         SEQLENGTH = SEQLENGTH + 1906:         SWAPSEQLENGTH = SWAPSEQLENGTH + 1
945:         POTEL = EMIN(1)907:         POTEL = EMIN(1)
946:         COORDS(1:3*NATOMS, NP) = XMIN(1:3*NATOMS)908:         COORDS(1:3*NATOMS, NP) = XMIN(1:3*NATOMS)
947:         CALL SWAP_LABELS(BESTSWAP(1,1),BESTSWAP(1,2))909:         CALL SWAP_LABELS(BESTSWAP(1,1),BESTSWAP(1,2))
948:         WRITE(MYUNIT, '(A, G20.10)') &910:         WRITE(MYUNIT, '(A, G20.10)') &
949:              'span_swaps> Executed best swap with dE=', &911:              'span_swaps> Executed best swap with dE=', &
950:              EMIN(1)-E0912:              EMIN(1)-E0
951:      ELSE913:      ELSE
952:         STEP=.FALSE.914:         STEP=.FALSE.
953:      ENDIF915:      ENDIF
954:   ELSEIF(NNEG > 0) THEN916:   ELSEIF(NNEG > 0) THEN
955:      STEP=.TRUE.917:      STEP=.TRUE.
956:   ENDIF918:   ENDIF
957:   !919:   !
958:   RETURN920:   RETURN
959:   !921:   !
960: END SUBROUTINE SPAN_SWAPS922: END SUBROUTINE SPAN_SWAPS
961: !923: !
962: SUBROUTINE SPAN_FLIPS(NP,ITER,TIME,BRUN,QDONE,SCREENC,STEP) 
963:   ! 
964:   ! Calculated all flip gains and count the number of  
965:   ! negative ones. If STEP=.true. on input, then find 
966:   ! and execute the lowest flip gain; and in the absence 
967:   ! of negative flip gains set STEP=.false on output. 
968:   ! Determine if the configuration is a minimum or a 
969:   ! saddle (or neither) in permutation space. 
970:   ! 
971:   USE COMMONS, ONLY : NSPECIES,ATOMLISTS,NATOMS,COORDS,NQ, & 
972:        QALCSV,ECONV,MYUNIT,SEQLENGTH 
973:   ! 
974:   IMPLICIT NONE 
975:   ! 
976:   ! Parsed variables 
977:   INTEGER, INTENT(IN) :: NP 
978:   INTEGER, INTENT(INOUT) :: ITER, BRUN, QDONE ! for QUENCH 
979:   DOUBLE PRECISION, INTENT(INOUT) :: TIME, SCREENC(3*NATOMS) 
980:   !  
981:   LOGICAL, INTENT(INOUT) :: STEP 
982:   ! 
983:   INTEGER :: TA, TB, GA, IA, I, NTOT, NNEG, NQTOT, & 
984:        BESTFLIP(2,2) 
985:   DOUBLE PRECISION :: POTEL, E0, X0(3*NATOMS), E0LO, & 
986:        EMIN(2), XMIN(3*NATOMS) 
987:   ! 
988:   ! Energy of COORDS from last quench. Common block in QUENCH. 
989:   COMMON /MYPOT/ POTEL 
990:   ! Total quench count. Commom block in MC. 
991:   COMMON /TOT/ NQTOT 
992:   ! 
993:   WRITE(MYUNIT,'(A)') & 
994:        '============================================================' 
995:   ! 
996:   X0(1:3*NATOMS) = COORDS(1:3*NATOMS, NP) 
997:   XMIN(1:3*NATOMS) = COORDS(1:3*NATOMS, NP) 
998:   E0 = POTEL 
999:   E0LO = E0 - ECONV 
1000:   EMIN(1:2) = POTEL 
1001:   BESTFLIP(1:2,1:2) = 0 
1002:   ! 
1003:   NNEG=0 ! counter for -ve flip gains 
1004:   !NTOT=0 
1005:   ! 
1006:   DO TA=1,NSPECIES(0) ! loop over species 
1007:      DO GA = 1,2 ! loop over groups 
1008:         DO IA=1,ATOMLISTS(TA,GA,0) ! loop over atoms 
1009:            I=ATOMLISTS(TA,GA,IA) ! actual atom index 
1010:            DO TB=1,NSPECIES(0) 
1011:               IF(TB.NE.TA) THEN ! attempt flip 
1012:                  ! 
1013:                  CALL FLIP_LABEL(I,TB) 
1014:                  ! 
1015:                  NQTOT = NQTOT + 1 
1016:                  NQ(NP) = NQ(NP) + 1 
1017:                  CALL QUENCH(.FALSE.,NP,ITER,TIME,BRUN, & 
1018:                       QDONE,SCREENC) 
1019:                  IF(QALCSV) CALL PRINT_QUENCH(NP, ITER, '  ') 
1020:                  ! 
1021:                  !NTOT = NTOT+1 
1022:                  IF(POTEL < E0LO) THEN 
1023:                     NNEG=NNEG+1                        
1024:                     IF(POTEL < EMIN(2) - ECONV) THEN 
1025:                        EMIN(2) = POTEL 
1026:                        BESTFLIP(2,1:2) = (/I,TB/) 
1027:                        IF(POTEL < EMIN(1) - ECONV) THEN 
1028:                           EMIN(2) = EMIN(1) 
1029:                           BESTFLIP(2,1:2) = BESTFLIP(1,1:2) 
1030:                           EMIN(1) = POTEL 
1031:                           BESTFLIP(1,1:2) = (/I,TB/) 
1032:                           IF(STEP) XMIN(:) = COORDS(:,NP) 
1033:                        ENDIF 
1034:                     ENDIF 
1035:                  ENDIF 
1036:                  ! 
1037:                  CALL FLIP_LABEL(I,TA) 
1038:                  POTEL = E0 
1039:                  COORDS(1:3*NATOMS, NP) = X0(1:3*NATOMS) 
1040:                  ! 
1041:               ENDIF 
1042:            ENDDO 
1043:         ENDDO 
1044:         ! 
1045:      ENDDO 
1046:   ENDDO 
1047:   ! 
1048:   WRITE(MYUNIT, '(A, I6, A)', ADVANCE='NO') & 
1049:        'span_flips> ',NNEG,' -ve flip-gain(s)' 
1050:   ! 
1051:   IF(NNEG == 0) THEN ! permutational (bi)minimum 
1052:      WRITE(MYUNIT, '(A)') ' => local optimum.' 
1053:   !ELSEIF(NNEG == 2) THEN 
1054:   !   WRITE(MYUNIT,'(A,I3,A,I3,A,I3,A,I3)', ADVANCE='NO') ': ', & 
1055:   !        BESTSWAP(1,1),' <-> ', BESTSWAP(1,2), ' and ', & 
1056:   !        BESTSWAP(2,1),' <-> ', BESTSWAP(2,2) 
1057:   !   IF(  BESTSWAP(1,1) /= BESTSWAP(2,1) .AND. & 
1058:   !        BESTSWAP(1,2) /= BESTSWAP(2,2) ) THEN ! 'permutational saddle' 
1059:   !      WRITE(MYUNIT, '(A)') ' => saddle.' 
1060:   !   ELSE 
1061:   !      WRITE(MYUNIT, '(A)') ' => ?' 
1062:   !   ENDIF 
1063:   ELSE 
1064:      WRITE(MYUNIT,*) 
1065:   ENDIF 
1066:   ! 
1067:   IF(STEP) THEN 
1068:      IF(NNEG > 0) THEN 
1069:         SEQLENGTH = SEQLENGTH + 1 
1070:         POTEL = EMIN(1) 
1071:         COORDS(1:3*NATOMS, NP) = XMIN(1:3*NATOMS) 
1072:         CALL FLIP_LABEL(BESTFLIP(1,1),BESTFLIP(1,2)) 
1073:         WRITE(MYUNIT, '(A, G20.10)') & 
1074:              'span_flips> Executed best flip with dE=', & 
1075:              EMIN(1)-E0 
1076:      ELSE 
1077:         STEP=.FALSE. 
1078:      ENDIF 
1079:   ELSEIF(NNEG > 0) THEN 
1080:      STEP=.TRUE. 
1081:   ENDIF 
1082:   ! 
1083:   RETURN 
1084:   ! 
1085: END SUBROUTINE SPAN_FLIPS 
1086: ! 
1087: !=============================================================924: !=============================================================
1088: !925: !
1089: SUBROUTINE RANDMULTIPERM(NP, IGROUP)926: SUBROUTINE RANDMULTIPERM(NP, IGROUP)
1090:   !927:   !
1091:   ! ds656> 6/1/2015928:   ! ds656> 6/1/2015
1092:   ! Randomly permute atomic labels in a multicomponent system.929:   ! Randomly permute atomic labels in a multicomponent system.
1093:   ! (More general than RANPERM.) Permute labels only for atoms930:   ! (More general than RANPERM.) Permute labels only for atoms
1094:   ! in group IGROUP.931:   ! in group IGROUP.
1095:   !932:   !
1096:   USE COMMONS, ONLY : NATOMS, NSPECIES, ATOMLISTS, INVATOMLISTS, &933:   USE COMMONS, ONLY : NATOMS, NSPECIES, ATOMLISTS, INVATOMLISTS, &
1140:   !977:   !
1141:   WRITE(MYUNIT,'(A, I2)') &978:   WRITE(MYUNIT,'(A, I2)') &
1142:        'randmultiperm> Permuted labels of atoms in group ',IGROUP979:        'randmultiperm> Permuted labels of atoms in group ',IGROUP
1143:   !980:   !
1144:   RETURN981:   RETURN
1145:   !982:   !
1146: END SUBROUTINE RANDMULTIPERM983: END SUBROUTINE RANDMULTIPERM
1147: !984: !
1148: !=============================================================985: !=============================================================
1149: !986: !
1150: SUBROUTINE CALC_HAMMING_DISTANCE(N,LIST1,LIST2,NDIFF)987: SUBROUTINE CALC_MULTIPERM_DISTANCE(SWAPDIST,N,LIST1,LIST2,NDIFF)
1151:   !988:   !
1152:   IMPLICIT NONE989:   IMPLICIT NONE
1153:   !990:   !
 991:   LOGICAL, INTENT(IN) :: SWAPDIST
1154:   INTEGER, INTENT(IN) :: N, LIST1(N),LIST2(N)992:   INTEGER, INTENT(IN) :: N, LIST1(N),LIST2(N)
1155:   INTEGER, INTENT(OUT) :: NDIFF993:   INTEGER, INTENT(OUT) :: NDIFF
1156:   !994:   !
1157:   INTEGER :: I995:   INTEGER :: I
1158:   !996:   !
1159:   NDIFF=0997:   NDIFF=0
1160:   DO I=1,N998:   DO I=1,N
1161:      IF(LIST1(I).NE.LIST2(I)) NDIFF=NDIFF+1999:      IF(LIST1(I).NE.LIST2(I)) NDIFF=NDIFF+1
1162:   ENDDO1000:   ENDDO
 1001:   IF(SWAPDIST) NDIFF = NDIFF/2
1163:   !1002:   !
1164:   RETURN1003:   RETURN
1165:   !1004:   !
1166: END SUBROUTINE CALC_HAMMING_DISTANCE1005: END SUBROUTINE CALC_MULTIPERM_DISTANCE
1167: !1006: !
1168: SUBROUTINE SCAN_SWAP_NBRHD(NP,ITER,TIME,BRUN,QDONE,SCREENC,STEP)1007: SUBROUTINE SCAN_NBRHD(NP,ITER,TIME,BRUN,QDONE,SCREENC,STEP)
1169:   !1008:   !
1170:   USE PORFUNCS1009:   USE PORFUNCS
1171:   USE COMMONS, ONLY : NATOMS, COORDS, QALCSV, NQ, ECONV, &1010:   USE COMMONS, ONLY : NATOMS, COORDS, QALCSV, NQ, ECONV, &
1172:        MYUNIT, QALCSMODE, SEQLENGTH, ATOMLISTS, &1011:        MYUNIT, QALCSMODE, SWAPSEQLENGTH, ATOMLISTS, &
1173:        NSPECIES, QALCS_NBRHD, QALCS_PARAM1012:        NSPECIES, QALCS_NBRHD, QALCS_PARAM
1174:   !1013:   !
1175:   IMPLICIT NONE1014:   IMPLICIT NONE
1176:   !1015:   !
1177:   ! Parsed variables1016:   ! Parsed variables
1178:   INTEGER, INTENT(IN) :: NP1017:   INTEGER, INTENT(IN) :: NP
1179:   INTEGER, INTENT(INOUT) :: ITER, BRUN, QDONE ! for QUENCH1018:   INTEGER, INTENT(INOUT) :: ITER, BRUN, QDONE ! for QUENCH
1180:   DOUBLE PRECISION, INTENT(INOUT) :: TIME, SCREENC(3*NATOMS) ! for QUENCH1019:   DOUBLE PRECISION, INTENT(INOUT) :: TIME, SCREENC(3*NATOMS) ! for QUENCH
1181:   LOGICAL, INTENT(OUT) :: STEP1020:   LOGICAL, INTENT(OUT) :: STEP
1182:   !1021:   !
1269:      CALL QUENCH(.FALSE.,NP,ITER,TIME,BRUN,QDONE,SCREENC)1108:      CALL QUENCH(.FALSE.,NP,ITER,TIME,BRUN,QDONE,SCREENC)
1270:      IF(QALCSV) THEN1109:      IF(QALCSV) THEN
1271:         CALL PRINT_QUENCH(NP, ITER, '  ')1110:         CALL PRINT_QUENCH(NP, ITER, '  ')
1272:         IF(QALCSMODE==5) THEN1111:         IF(QALCSMODE==5) THEN
1273:            WRITE(MYUNIT,'(2(A,F15.10))') &1112:            WRITE(MYUNIT,'(2(A,F15.10))') &
1274:                 'scan_nbrhd> dE*= ',EST(J)-E0,' dE= ',POTEL-E0 1113:                 'scan_nbrhd> dE*= ',EST(J)-E0,' dE= ',POTEL-E0 
1275:         ENDIF1114:         ENDIF
1276:      ENDIF1115:      ENDIF
1277:      !1116:      !
1278:      IF(POTEL < E0 - ECONV) THEN1117:      IF(POTEL < E0 - ECONV) THEN
1279:         SEQLENGTH = SEQLENGTH + 11118:         SWAPSEQLENGTH = SWAPSEQLENGTH + 1
1280:         WRITE(MYUNIT,'(A,I4,A,I4,A,I4,A,F15.10)') &1119:         WRITE(MYUNIT,'(A,I4,A,I4,A,I4,A,F15.10)') &
1281:              'scan_nbrhd> Try ',I,' : ',&1120:              'scan_nbrhd> Try ',I,' : ',&
1282:              SWAPS(J,1),' <-> ',SWAPS(J,2),&1121:              SWAPS(J,1),' <-> ',SWAPS(J,2),&
1283:              ' => dE= ', POTEL-E01122:              ' => dE= ', POTEL-E0
1284:         STEP = .TRUE.1123:         STEP = .TRUE.
1285:         RETURN1124:         RETURN
1286:      ELSE 1125:      ELSE 
1287:         ! Undo the swap and restore the configuration1126:         ! Undo the swap and restore the configuration
1288:         CALL SWAP_LABELS(SWAPS(J,1),SWAPS(J,2))1127:         CALL SWAP_LABELS(SWAPS(J,1),SWAPS(J,2))
1289:         COORDS(1:3*NATOMS, NP) = X0(1:3*NATOMS)1128:         COORDS(1:3*NATOMS, NP) = X0(1:3*NATOMS)
1304:      WRITE(MYUNIT,'(A,I6,A)') &1143:      WRITE(MYUNIT,'(A,I6,A)') &
1305:           'scan_nbrhd> Failed to find improvement after ',&1144:           'scan_nbrhd> Failed to find improvement after ',&
1306:           NTOT,' trial swaps!'1145:           NTOT,' trial swaps!'
1307:   ELSE1146:   ELSE
1308:      WRITE(MYUNIT,'(A)') 'scan_nbrhd> No swaps with -ve gain!'1147:      WRITE(MYUNIT,'(A)') 'scan_nbrhd> No swaps with -ve gain!'
1309:   ENDIF1148:   ENDIF
1310:   STEP = .FALSE.1149:   STEP = .FALSE.
1311:   !1150:   !
1312:   RETURN1151:   RETURN
1313:   !1152:   !
1314: END SUBROUTINE SCAN_SWAP_NBRHD1153: END SUBROUTINE SCAN_NBRHD
1315: ! 
1316: SUBROUTINE SCAN_FLIP_NBRHD(NP,ITER,TIME,BRUN,QDONE,SCREENC,STEP) 
1317:   ! 
1318:   USE PORFUNCS 
1319:   USE COMMONS, ONLY : NATOMS, COORDS, QALCSV, NQ, ECONV, & 
1320:        MYUNIT,QALCSMODE,SEQLENGTH,ATOMLISTS,INVATOMLISTS,& 
1321:        NSPECIES,QALCS_NBRHD,QALCS_PARAM,SEMIGRAND_MUT,& 
1322:        SEMIGRAND_MU 
1323:   ! 
1324:   IMPLICIT NONE 
1325:   ! 
1326:   ! Parsed variables 
1327:   INTEGER, INTENT(IN) :: NP 
1328:   INTEGER, INTENT(INOUT) :: ITER, BRUN, QDONE ! for QUENCH 
1329:   DOUBLE PRECISION, INTENT(INOUT) :: TIME, SCREENC(3*NATOMS) ! for QUENCH 
1330:   LOGICAL, INTENT(OUT) :: STEP 
1331:   ! 
1332:   INTEGER :: NQTOT, N, NTOT, FLIPS(NATOMS,2), I, J, K, & 
1333:        TA, TB, GA, IA, I_AB(1:2) 
1334:   DOUBLE PRECISION :: POTEL, E0, X0(3*NATOMS), DPRAND, & 
1335:        EST(QALCS_NBRHD), DUMMY 
1336:   ! 
1337:   ! Energy of COORDS from last quench. Common block in QUENCH. 
1338:   COMMON /MYPOT/ POTEL 
1339:   ! Total quench count. Commom block in MC. 
1340:   COMMON /TOT/ NQTOT 
1341:   ! 
1342:   !============================================================== 
1343:   ! Firs loop over the entire neighbourhood to compute the 
1344:   ! sorted list of pair-swaps. 
1345:   ! 
1346:   N = 0 
1347:   DO TA=1,NSPECIES(0) ! loop over species 
1348:      DO GA = 1,2 ! loop over groups 1 and 2 
1349:         DO IA=1,ATOMLISTS(TA,GA,0) ! loop over atoms 
1350:            I=ATOMLISTS(TA,GA,IA) 
1351:            DO TB=1,NSPECIES(0) ! loop over species 
1352:               IF(TB.NE.TA) THEN 
1353:                  N = N + 1 
1354:                  FLIPS(N,1) = I; FLIPS(N,2) = TB                     
1355:                  ! 
1356:                  IF(QALCSMODE == 8) THEN 
1357:                     ! 
1358:                     CALL FLIP_LABEL(I,TB) 
1359:                     CALL POTENTIAL(COORDS(:,NP),X0(:),EST(N),.FALSE.,.FALSE.) 
1360:                     IF (SEMIGRAND_MUT) THEN 
1361:                        DUMMY=0.0D0 
1362:                        DO J=2, NSPECIES(0) 
1363:                           DUMMY = DUMMY + NSPECIES(J)*SEMIGRAND_MU(J) 
1364:                        ENDDO 
1365:                        EST(N) = EST(N) - DUMMY 
1366:                     ENDIF 
1367:                     CALL FLIP_LABEL(I,TA) 
1368:                     ! 
1369:                     SORT_EST3: DO K=N,2,-1 
1370:                        IF(EST(K) < EST(K-1)) THEN 
1371:                           E0=EST(K); EST(K)=EST(K-1); EST(K-1)=E0 
1372:                           I_AB(1:2) = FLIPS(K,1:2) 
1373:                           FLIPS(K,1:2) = FLIPS(K-1,1:2) 
1374:                           FLIPS(K-1,1:2) = I_AB(1:2) 
1375:                        ELSE 
1376:                           EXIT SORT_EST3 
1377:                        ENDIF 
1378:                     ENDDO SORT_EST3 
1379:                     ! 
1380:                  ENDIF 
1381:               ENDIF 
1382:               ! 
1383:            ENDDO 
1384:         ENDDO 
1385:      ENDDO 
1386:   ENDDO 
1387:   ! 
1388:   IF(N /= NATOMS*(NSPECIES(0)-1)) THEN 
1389:      WRITE(MYUNIT,'(A)') 'scan_flip_nbrhd> Inconsistency!' 
1390:      STOP 
1391:   ENDIF 
1392:   ! 
1393:   ! Now E0 and I_AB are no longer dummies! 
1394:   ! 
1395:   E0 = POTEL 
1396:   X0(1:3*NATOMS) = COORDS(1:3*NATOMS, NP) 
1397:   ! 
1398:   IF(QALCS_PARAM > 0 .AND. QALCS_PARAM < N) THEN 
1399:      NTOT = QALCS_PARAM 
1400:   ELSE 
1401:      NTOT = N 
1402:   ENDIF 
1403:   ! 
1404:   DO I=1,NTOT 
1405:      ! 
1406:      IF(QALCSMODE==7) THEN     
1407:         J = INT(DPRAND()*DBLE(N)) + 1 
1408:      ELSEIF(QALCSMODE==8) THEN 
1409:         J=I 
1410:      ENDIF 
1411:      ! 
1412:      TA=INVATOMLISTS(FLIPS(J,1),1) ! Current label 
1413:      TB=FLIPS(J,2) ! new label 
1414:      CALL FLIP_LABEL(FLIPS(J,1),TB) 
1415:      !                                                             
1416:      NQTOT = NQTOT + 1 
1417:      NQ(NP) = NQ(NP) + 1 
1418:      CALL QUENCH(.FALSE.,NP,ITER,TIME,BRUN,QDONE,SCREENC) 
1419:      IF(QALCSV) THEN 
1420:         CALL PRINT_QUENCH(NP, ITER, '  ') 
1421:         IF(QALCSMODE==8) THEN 
1422:            WRITE(MYUNIT,'(2(A,F15.10))') & 
1423:                 'scan_flip_nbrhd> dE*= ',EST(J)-E0,' dE= ',POTEL-E0  
1424:         ENDIF 
1425:      ENDIF 
1426:      ! 
1427:      IF(POTEL < E0 - ECONV) THEN 
1428:         SEQLENGTH = SEQLENGTH + 1 
1429:         WRITE(MYUNIT,'(A,I4,A,I4,A,I4,A,F15.10)') & 
1430:              'scan_flip_nbrhd> Trial ',I,' : ',& 
1431:              FLIPS(J,1),' ~> ',FLIPS(J,2),& 
1432:              ' => dE= ', POTEL-E0 
1433:         STEP = .TRUE. 
1434:         RETURN 
1435:      ELSE  
1436:         ! Undo the flip and restore the configuration 
1437:         CALL FLIP_LABEL(FLIPS(J,1),TA) 
1438:         COORDS(1:3*NATOMS, NP) = X0(1:3*NATOMS) 
1439:         POTEL = E0 
1440:         ! 
1441:         IF(QALCSMODE==7) THEN 
1442:            ! Remove the rejected swap from list 
1443:            FLIPS(J,1:2) = FLIPS(N,1:2) 
1444:            FLIPS(N,1:2) = 0 
1445:            N = N - 1 
1446:         ENDIF 
1447:         ! 
1448:      ENDIF 
1449:      ! 
1450:   ENDDO 
1451:   ! 
1452:   IF(NTOT == QALCS_PARAM) THEN 
1453:      WRITE(MYUNIT,'(A,I6,A)') & 
1454:           'scan_flip_nbrhd> Failed to find improvement after ',& 
1455:           NTOT,' trial swaps!' 
1456:   ELSE 
1457:      WRITE(MYUNIT,'(A)') 'scan_flip_nbrhd> No flips with -ve gain!' 
1458:   ENDIF 
1459:   STEP = .FALSE. 
1460:   ! 
1461:   RETURN 
1462:   ! 
1463: END SUBROUTINE SCAN_FLIP_NBRHD 
1464: 1154: 
1465: ! SUBROUTINE BH_SWAPS(NP, ITER, TIME, BRUN, QDONE, SCREENC)1155: ! SUBROUTINE BH_SWAPS(NP, ITER, TIME, BRUN, QDONE, SCREENC)
1466: !   !1156: !   !
1467: !   USE COMMONS, ONLY : NSPECIES,ATOMLISTS,NATOMS,COORDS,NQ, &1157: !   USE COMMONS, ONLY : NSPECIES,ATOMLISTS,NATOMS,COORDS,NQ, &
1468: !        ECONV,MYUNIT1158: !        ECONV,MYUNIT
1469: !   !1159: !   !
1470: !   IMPLICIT NONE1160: !   IMPLICIT NONE
1471: !   !1161: !   !
1472: !   ! Parsed variables1162: !   ! Parsed variables
1473: !   INTEGER, INTENT(IN) :: NP1163: !   INTEGER, INTENT(IN) :: NP


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0