hdiff output

r31314/mc_gbh.F90 2016-10-14 10:30:10.593102063 +0100 r31313/mc_gbh.F90 2016-10-14 10:30:10.849105511 +0100
 60:   E0 = POTEL 60:   E0 = POTEL
 61:   ! 61:   !
 62:   EMARK=1.0D+99 62:   EMARK=1.0D+99
 63:   NDUDSTREAK=0 63:   NDUDSTREAK=0
 64:   gbh_loop: DO ITRIAL=1,NSTEPS 64:   gbh_loop: DO ITRIAL=1,NSTEPS
 65:      ! 65:      !
 66:      IF(QALCSV) WRITE(MYUNIT, '(A,I10)') & 66:      IF(QALCSV) WRITE(MYUNIT, '(A,I10)') &
 67:           'mc_gbh> Starting iteration ', ITRIAL      67:           'mc_gbh> Starting iteration ', ITRIAL     
 68:      ! 68:      !
 69:      IF(RESTART.AND.NDUDSTREAK >= NRELAX) THEN 69:      IF(RESTART.AND.NDUDSTREAK >= NRELAX) THEN
 70:         EXTRA=5.0D0*STEP(1) 70:         EXTRA=STEP(1)
 71:         EMARK=1.0D+99 71:         EMARK=1.0D+99
 72:         E0=EMARK ! Guarantee move by inflating current energy 
 73:         NDUDSTREAK=0 72:         NDUDSTREAK=0
 74:         WRITE(MYUNIT,'(A,I9)') 'mc_gbh> Big shake and E0 reset.' 73:         WRITE(MYUNIT,'(A,I9)') &
  74:              'mc_gbh> Big shake on iteration ',ITRIAL
 75:      ELSE 75:      ELSE
 76:         EXTRA=0.0D0 76:         EXTRA=0.0D0
 77:      ENDIF 77:      ENDIF
 78:      ! 78:      !
 79:      ! --- Stochastic cartesian move ------- 79:      ! --- Stochastic cartesian move -------
 80:      !CALL TAKESTEP(1) 80:      !CALL TAKESTEP(1)
 81:      CALL SHAKE(3*NATOMSALLOC, COORDS(:,1), EXTRA)      81:      DO I=1,3*NATOMSALLOC
  82:         R=(DPRAND()-0.5D0)*2.0D0
  83:         COORDS(I,1)=COORDS(I,1) + STEP(1)*R + EXTRA*SIGN(1.0D0,R)
  84:      ENDDO
 82:      ! 85:      !
 83:      !IF (RANDMULTIPERMT.AND.MOD(J1,RANDMULTIPERM_STEP)==0) & 86:      !IF (RANDMULTIPERMT.AND.MOD(J1,RANDMULTIPERM_STEP)==0) &
 84:      !     CALL RANDMULTIPERM(1) ! re-write this routine!!!!! 87:      !     CALL RANDMULTIPERM(1) ! re-write this routine!!!!!
 85:      !IF(BOXCENTROIDT) CALL BOXCENTROID(COORDS(:,1)) 88:      !IF(BOXCENTROIDT) CALL BOXCENTROID(COORDS(:,1))
 86:      ! 89:      !
 87:      ! Quench perturbed state 90:      ! Quench perturbed state
 88:      NQ(1) = NQ(1) + 1 91:      NQ(1) = NQ(1) + 1
 89:      CALL QUENCH(.FALSE.,1,ITERNS,TIME,BRUN,QDONE,SCREENC) 92:      CALL QUENCH(.FALSE.,1,ITERNS,TIME,BRUN,QDONE,SCREENC)
 90:      WRITE(MYUNIT,& 93:      WRITE(MYUNIT,&
 91:           '(A,I10,A,G20.10,A,I5,A,G12.5,A,G20.10,A,F10.1)') & 94:           '(A,I10,A,G20.10,A,I5,A,G12.5,A,F10.1)') &
 92:           'Qu ',NQ(1),' E= ',POTEL,' steps= ',ITERNS,' RMS= ',& 95:           'Qu ',NQ(1),' E= ',POTEL,' steps= ',ITERNS,' RMS= ',&
 93:           RMS,' E0=',E0,' t= ',TIME-TSTART 96:           RMS,' t= ',TIME-TSTART
 94:      CALL FLUSH(MYUNIT) 97:      CALL FLUSH(MYUNIT)
 95:      ! 98:      !
 96: #ifdef MPI 99: #ifdef MPI
 97:      ! Gather all parallel quench energies on master node.100:      ! Gather all parallel quench energies on master node.
 98:      CALL MPI_GATHER(POTEL, 1, MPI_DOUBLE_PRECISION, &101:      CALL MPI_GATHER(POTEL, 1, MPI_DOUBLE_PRECISION, &
 99:           POTEL_LIST(1:NPAR_GBH), 1, MPI_DOUBLE_PRECISION, 0, &102:           POTEL_LIST(1:NPAR_GBH), 1, MPI_DOUBLE_PRECISION, 0, &
100:           MPI_COMM_WORLD, MPIERR)103:           MPI_COMM_WORLD, MPIERR)
101: #else104: #else
102:      POTEL_LIST(1) = POTEL105:      POTEL_LIST(1) = POTEL
103: #endif106: #endif
104:      !107:      !
105:      IF(MYNODE==0) THEN108:      IF(MYNODE==0) THEN
106:         !109:         IF(EXTRA > 0.0D0) THEN
107:         POTEL_LIST(NPAR_GBH+1) = E0 ! Allows rejection110:            ! 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
108:         IF (TARGET) IPROCLO=MINLOC(POTEL_LIST(1:NPAR_GBH), 1)-1115:         IF (TARGET) IPROCLO=MINLOC(POTEL_LIST(1:NPAR_GBH), 1)-1
109:         !116:         ! Choose an IPROC with Boltzmann probability.
110:         ! Choose an IPROC. 
111:         CALL CHOOSE_FROM_LIST(NPAR_GBH+1,POTEL_LIST,IPROC)117:         CALL CHOOSE_FROM_LIST(NPAR_GBH+1,POTEL_LIST,IPROC)
112:         !118:         !
113:         IF(IPROC>NPAR_GBH) THEN ! Reject all119:         IF(IPROC>NPAR_GBH) THEN ! Revert on master node
114:            COORDS(1:3*NATOMSALLOC,1) = X0(1:3*NATOMSALLOC)120:            COORDS(1:3*NATOMSALLOC,1) = X0(1:3*NATOMSALLOC)
115:            LABELS(1:NATOMSALLOC,1) = L0(1:NATOMSALLOC) 121:            LABELS(1:NATOMSALLOC,1) = L0(1:NATOMSALLOC) 
116:            POTEL = E0122:            POTEL = E0
117:            IPROC = 0123:            IPROC = 0
118:            !WRITE(MYUNIT, '(A)') 'mc_gbh> Trial rejected.'     124:            WRITE(MYUNIT, '(A)') &
 125:                 'mc_gbh> Trial rejected.'     
119:         ELSE126:         ELSE
120:            !WRITE(MYUNIT, '(A)') 'mc_gbh> Trial accepted.'    127:            WRITE(MYUNIT, '(A)') &
 128:                 'mc_gbh> Trial accepted.'     
121:            IPROC=IPROC-1129:            IPROC=IPROC-1
122:         ENDIF130:         ENDIF
123:         !131:         !
124:      ENDIF132:      ENDIF
125:      !133:      !
126: #ifdef MPI 134: #ifdef MPI 
127:      ! Broadcast IPROC from master135:      ! Broadcast IPROC from master
128:      CALL MPI_BCAST(IPROC,1,MPI_INTEGER,&136:      CALL MPI_BCAST(IPROC,1,MPI_INTEGER,&
129:           0,MPI_COMM_WORLD,MPIERR)137:           0,MPI_COMM_WORLD,MPIERR)
130:      ! Broadcast state from IPROC138:      ! Broadcast state from IPROC
176:   ENDDO gbh_loop184:   ENDDO gbh_loop
177:   !185:   !
178:   RETURN186:   RETURN
179:   !187:   !
180: END SUBROUTINE MC_GBH188: END SUBROUTINE MC_GBH
181: 189: 
182: SUBROUTINE CHOOSE_FROM_LIST(N,VALUES,I)190: SUBROUTINE CHOOSE_FROM_LIST(N,VALUES,I)
183:   !191:   !
184:   ! Choose an element of VALUES with Boltzmann probability192:   ! Choose an element of VALUES with Boltzmann probability
185:   !193:   !
186:   USE COMMONS, ONLY : TEMP, QALCSV, MYUNIT194:   USE COMMONS, ONLY : TEMP
187:   !195:   !
188:   IMPLICIT NONE196:   IMPLICIT NONE
189:   !197:   !
190:   INTEGER, INTENT(IN) :: N198:   INTEGER, INTENT(IN) :: N
191:   DOUBLE PRECISION, INTENT(IN) :: VALUES(N)199:   DOUBLE PRECISION, INTENT(IN) :: VALUES(N)
192:   INTEGER, INTENT(OUT) :: I200:   INTEGER, INTENT(OUT) :: I
193:   !201:   !
194:   LOGICAL :: SELECTIVE202:   LOGICAL :: SELECTIVE
195:   DOUBLE PRECISION :: PSUM(N), X, Y, DPRAND, ELOWEST203:   DOUBLE PRECISION :: PSUM(N), X, Y, DPRAND, ELOWEST
196:   !204:   !
198:   IF (MINLOC(VALUES,1)==N) THEN206:   IF (MINLOC(VALUES,1)==N) THEN
199:      SELECTIVE=.FALSE.207:      SELECTIVE=.FALSE.
200:   ELSE208:   ELSE
201:      SELECTIVE=.TRUE.209:      SELECTIVE=.TRUE.
202:   ENDIF210:   ENDIF
203:   !211:   !
204:   X=0.0D0 ! initialise total sum212:   X=0.0D0 ! initialise total sum
205:   DO I=1,N213:   DO I=1,N
206:      IF(SELECTIVE) THEN214:      IF(SELECTIVE) THEN
207:         IF(VALUES(I) < VALUES(N)) THEN215:         IF(VALUES(I) < VALUES(N)) THEN
208:            Y = DEXP(-(VALUES(I)-ELOWEST)/TEMP(1))216:            Y = DEXP(-(VALUES(I)-ELOWEST)/TEMP(1))
209:         ELSE217:         ELSE
210:            Y = 0.0D0 ! avoid selection 218:            Y = 0.0D0 ! avoid selection 
211:         ENDIF219:         ENDIF    
212:      ELSE220:      ELSE
213:         Y = DEXP(-(VALUES(I)-ELOWEST)/TEMP(1))221:         Y = DEXP(-(VALUES(I)-ELOWEST)/TEMP(1))
214:      ENDIF222:      ENDIF
215:      X = X + Y223:      X = X + Y
216:      PSUM(I) = X ! store partial sum224:      PSUM(I) = X ! store partial sum
217:   ENDDO225:   ENDDO
218:   !226:   !
219:   X=X*DPRAND()227:   X=X*DPRAND()
220:   !228:   !
221:   I=1229:   I=1
222:   DO WHILE (X > PSUM(I))230:   DO WHILE (X > PSUM(I))
223:      I=I+1231:      I=I+1
224:   ENDDO232:   ENDDO
225:   !233:   !
226:   !IF(QALCSV) THEN 
227:   !   WRITE(MYUNIT, *) 'choose_from_list> vals=', VALUES 
228:   !   WRITE(MYUNIT, *) 'choose_from_list> psum=', PSUM 
229:   !   WRITE(MYUNIT, *) 'choose_from_list> choice=', I 
230:   !ENDIF 
231:   ! 
232:   RETURN234:   RETURN
233:   !235:   !
234: END SUBROUTINE CHOOSE_FROM_LIST236: END SUBROUTINE CHOOSE_FROM_LIST
235:  
236: SUBROUTINE SHAKE(N,X,EXTRA) 
237:   ! 
238:   USE COMMONS, ONLY : STEP 
239:   ! 
240:   IMPLICIT NONE 
241:   ! 
242:   INTEGER, INTENT(IN) :: N 
243:   DOUBLE PRECISION, INTENT(INOUT) :: X(N) 
244:   DOUBLE PRECISION, INTENT(IN) :: EXTRA 
245:   ! 
246:   INTEGER :: I 
247:   DOUBLE PRECISION :: DPRAND, R 
248:   ! 
249:   DO I=1,N 
250:      R=(DPRAND()-0.5D0)*2.0D0 
251:      X(I)=X(I) + STEP(1)*R + EXTRA*SIGN(1.0D0,R) 
252:   ENDDO 
253:   ! 
254:   RETURN 
255:   ! 
256: END SUBROUTINE SHAKE 


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0