hdiff output

r31309/mc_gbh.F90 2016-10-13 08:30:09.997016404 +0100 r31308/mc_gbh.F90 2016-10-13 08:30:10.253019919 +0100
 30:   INCLUDE 'mpif.h' 30:   INCLUDE 'mpif.h'
 31:   INTEGER MPIERR 31:   INTEGER MPIERR
 32: #endif 32: #endif
 33:   ! 33:   !
 34:   INTEGER, INTENT(IN) :: NSTEPS 34:   INTEGER, INTENT(IN) :: NSTEPS
 35:   ! 35:   !
 36:   LOGICAL :: ACCEPT 36:   LOGICAL :: ACCEPT
 37:   INTEGER :: I, ITRIAL, ITERNS, BRUN, QDONE, NQTOT, IPROC, IPROCLO, & 37:   INTEGER :: I, ITRIAL, ITERNS, BRUN, QDONE, NQTOT, IPROC, IPROCLO, &
 38:        NDUDSTREAK, L0(NATOMSALLOC) 38:        NDUDSTREAK, L0(NATOMSALLOC)
 39:   DOUBLE PRECISION :: TIME, SCREENC(3*NATOMSALLOC), POTEL, EXTRA, R, & 39:   DOUBLE PRECISION :: TIME, SCREENC(3*NATOMSALLOC), POTEL, EXTRA, R, &
 40:        POTEL_LIST(NPAR_GBH+1), DPRAND, EMARK, X0(3*NATOMSALLOC), E0 40:        POTEL_LIST(0:NPAR_GBH), DPRAND, EMARK, X0(3*NATOMSALLOC), E0
 41:   ! 41:   !
 42:   COMMON /MYPOT/ POTEL 42:   COMMON /MYPOT/ POTEL
 43:   ! 43:   !
 44:   WRITE(MYUNIT, '(A)')  'mc_gbh> Calculating initial energy' 44:   WRITE(MYUNIT, '(A)')  'mc_gbh> Calculating initial energy'
 45:   !WRITE(MYUNIT, *)  'mc_gbh> NATOMSALLOC=', NATOMSALLOC 45:   !WRITE(MYUNIT, *)  'mc_gbh> NATOMSALLOC=', NATOMSALLOC
 46:   CALL FLUSH(MYUNIT) 46:   CALL FLUSH(MYUNIT)
 47:   CALL QUENCH(.FALSE.,1,ITERNS,TIME,BRUN,QDONE,SCREENC) 47:   CALL QUENCH(.FALSE.,1,ITERNS,TIME,BRUN,QDONE,SCREENC)
 48:   NQ(1) = 0 48:   NQ(1) = 0
 49:   WRITE(MYUNIT,& 49:   WRITE(MYUNIT,&
 50:        '(A,I10,A,G20.10,A,I5,A,G12.5,A,F10.1)') & 50:        '(A,I10,A,G20.10,A,I5,A,G12.5,A,F10.1)') &
 99: #ifdef MPI 99: #ifdef MPI
100:      ! Gather all parallel quench energies on master node.100:      ! Gather all parallel quench energies on master node.
101:      CALL MPI_GATHER(POTEL, 1, MPI_DOUBLE_PRECISION, &101:      CALL MPI_GATHER(POTEL, 1, MPI_DOUBLE_PRECISION, &
102:           POTEL_LIST(1:NPAR_GBH), 1, MPI_DOUBLE_PRECISION, 0, &102:           POTEL_LIST(1:NPAR_GBH), 1, MPI_DOUBLE_PRECISION, 0, &
103:           MPI_COMM_WORLD, MPIERR)103:           MPI_COMM_WORLD, MPIERR)
104: #else104: #else
105:      POTEL_LIST(1) = POTEL105:      POTEL_LIST(1) = POTEL
106: #endif106: #endif
107:      !107:      !
108:      IF(MYNODE==0) THEN108:      IF(MYNODE==0) THEN
109:         IF(EXTRA > 0.0D0) THEN109:         IF (TARGET) IPROCLO=MINLOC(POTEL_LIST, 1)-1
110:            ! Guarantee move by inflating current energy 
111:            POTEL_LIST(NPAR_GBH+1) = 1.0D+99 
112:         ELSE 
113:            POTEL_LIST(NPAR_GBH+1) = E0 
114:         ENDIF 
115:         IF (TARGET) IPROCLO=MINLOC(POTEL_LIST(1:NPAR_GBH), 1)-1 
116:         ! Choose an IPROC with Boltzmann probability.110:         ! Choose an IPROC with Boltzmann probability.
117:         CALL CHOOSE_FROM_LIST(NPAR_GBH+1,POTEL_LIST,IPROC)111:         CALL CHOOSE_FROM_LIST(NPAR_GBH,POTEL_LIST,IPROC)
 112:         IPROC=IPROC-1
118:         !113:         !
119:         IF(IPROC>NPAR_GBH) THEN ! Revert on master node114:         IF(IPROC<0) THEN ! Revert on master node
120:            COORDS(1:3*NATOMSALLOC,1) = X0(1:3*NATOMSALLOC)115:            COORDS(1:3*NATOMSALLOC,1) = X0(1:3*NATOMSALLOC)
121:            LABELS(1:NATOMSALLOC,1) = L0(1:NATOMSALLOC) 116:            LABELS(1:NATOMSALLOC,1) = L0(1:NATOMSALLOC) 
122:            POTEL = E0117:            POTEL = E0
123:            IPROC = 0118:            IPROC = 0
124:            WRITE(MYUNIT, '(A)') &119:            IF(QALCSV) WRITE(MYUNIT, '(A)') &
125:                 'mc_gbh> Trial rejected.'     120:                 'mc_gbh> Trial rejected.'     
126:         ELSE121:         ELSE
127:            WRITE(MYUNIT, '(A)') &122:            IF(QALCSV) WRITE(MYUNIT, '(A)') &
128:                 'mc_gbh> Trial accepted.'     123:                 'mc_gbh> Trial accepted.'     
129:            IPROC=IPROC-1 
130:         ENDIF124:         ENDIF
131:         !125:         !
132:      ENDIF126:      ENDIF
133:      !127:      !
134: #ifdef MPI 128: #ifdef MPI 
135:      ! Broadcast IPROC from master129:      ! Broadcast IPROC from master
136:      CALL MPI_BCAST(IPROC,1,MPI_INTEGER,&130:      CALL MPI_BCAST(IPROC,1,MPI_INTEGER,&
137:           0,MPI_COMM_WORLD,MPIERR)131:           0,MPI_COMM_WORLD,MPIERR)
138:      ! Broadcast state from IPROC132:      ! Broadcast state from IPROC
139:      CALL MPI_BCAST(COORDS(:,1),3*NATOMSALLOC,&133:      CALL MPI_BCAST(COORDS(:,1),3*NATOMSALLOC,&
170:      !164:      !
171:      ! --- Deterministic refinement --------------------------165:      ! --- Deterministic refinement --------------------------
172:      IF(.NOT.HIT .AND. QALCST .AND. QALCS_NBRHD>0 &166:      IF(.NOT.HIT .AND. QALCST .AND. QALCS_NBRHD>0 &
173:           .AND. ABS(POTEL-E0)>ECONV) THEN167:           .AND. ABS(POTEL-E0)>ECONV) THEN
174:         ! perform a variable neighbourhood search (in parallel)168:         ! perform a variable neighbourhood search (in parallel)
175:         CALL QALCS_PARALLEL(ITERNS, TIME, BRUN, QDONE, SCREENC)169:         CALL QALCS_PARALLEL(ITERNS, TIME, BRUN, QDONE, SCREENC)
176:      ENDIF170:      ENDIF
177:      !171:      !
178:      IF(HIT) EXIT gbh_loop172:      IF(HIT) EXIT gbh_loop
179:      !173:      !
180:      X0(1:3*NATOMSALLOC) = COORDS(1:3*NATOMSALLOC,1)174:      
181:      L0(1:NATOMSALLOC) = LABELS(1:NATOMSALLOC,1) 
182:      E0 = POTEL 
183:      !175:      !
184:   ENDDO gbh_loop176:   ENDDO gbh_loop
185:   !177:   !
186:   RETURN178:   RETURN
187:   !179:   !
188: END SUBROUTINE MC_GBH180: END SUBROUTINE MC_GBH
189: 181: 
190: SUBROUTINE CHOOSE_FROM_LIST(N,VALUES,I)182: SUBROUTINE CHOOSE_FROM_LIST(N,VALUES,I)
191:   !183:   !
192:   ! Choose an element of VALUES with Boltzmann probability184:   ! Choose an element of VALUES with Boltzmann probability
193:   !185:   !
194:   USE COMMONS, ONLY : TEMP186:   USE COMMONS, ONLY : TEMP
195:   !187:   !
196:   IMPLICIT NONE188:   IMPLICIT NONE
197:   !189:   !
198:   INTEGER, INTENT(IN) :: N190:   INTEGER, INTENT(IN) :: N
199:   DOUBLE PRECISION, INTENT(IN) :: VALUES(N)191:   DOUBLE PRECISION, INTENT(IN) :: VALUES(0:N)
200:   INTEGER, INTENT(OUT) :: I192:   INTEGER, INTENT(OUT) :: I
201:   !193:   !
202:   DOUBLE PRECISION :: PSUM(N), X, DPRAND, ELOWEST194:   DOUBLE PRECISION :: PSUM(N), X, DPRAND, ELOWEST
203:   !195:   !
204:   ELOWEST=MINVAL(VALUES(0:N))196:   ELOWEST=MINVAL(VALUES(0:N))
205:   !197:   !
206:   X=0.0D0 ! initialise total sum198:   X=0.0D0 ! initialise total sum
207:   DO I=1,N 199:   DO I=0,N 
208:      X = X + DEXP(-(VALUES(I)-ELOWEST)/TEMP(1))200:      X = X + DEXP(-(VALUES(I)-ELOWEST)/TEMP(1))
209:      PSUM(I) = X ! store partial sum201:      PSUM(I) = X ! store partial sum
210:   ENDDO202:   ENDDO
211:   !203:   !
212:   X=X*DPRAND()204:   X=X*DPRAND()
213:   !205:   !
214:   I=1206:   I=0
215:   DO WHILE (X > PSUM(I))207:   DO WHILE (X > PSUM(I))
216:      I=I+1208:      I=I+1
217:   ENDDO209:   ENDDO
218:   !210:   !
219:   RETURN211:   RETURN
220:   !212:   !
221: END SUBROUTINE CHOOSE_FROM_LIST213: END SUBROUTINE CHOOSE_FROM_LIST


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0