hdiff output

r31308/mc_gbh.F90 2016-10-12 22:30:09.150695692 +0100 r31307/mc_gbh.F90 2016-10-12 22:30:09.406699111 +0100
 28:   ! 28:   !
 29: #ifdef MPI  29: #ifdef MPI 
 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
 39:   DOUBLE PRECISION :: TIME, SCREENC(3*NATOMSALLOC), POTEL, EXTRA, R, & 39:   DOUBLE PRECISION :: TIME, SCREENC(3*NATOMSALLOC), POTEL, EXTRA, &
 40:        POTEL_LIST(0:NPAR_GBH), DPRAND, EMARK, X0(3*NATOMSALLOC), E0 40:        POTEL_LIST(NPAR_GBH), POTELO, R, DPRAND, EREF
 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)') &
 51:        'Qu ',NQ(1),' E= ',POTEL,' steps= ',ITERNS,' RMS= ',RMS,& 51:        'Qu ',NQ(1),' E= ',POTEL,' steps= ',ITERNS,' RMS= ',RMS,&
 52:        ' t= ',TIME-TSTART 52:        ' t= ',TIME-TSTART
 53:   CALL FLUSH(MYUNIT) 53:   CALL FLUSH(MYUNIT)
 54:   ! 54:   !
 55:   WRITE(MYUNIT, '(A,I6)') & 55:   WRITE(MYUNIT, '(A,I6)') &
 56:        'mc_gbh> Starting GBH loop of length ',NSTEPS 56:        'mc_gbh> Starting GBH loop of length ',NSTEPS
 57:   ! 57:   !
 58:   X0(1:3*NATOMSALLOC) = COORDS(1:3*NATOMSALLOC,1) 58:   EREF=1.0D+99
 59:   L0(1:NATOMSALLOC) = LABELS(1:NATOMSALLOC,1) 
 60:   E0 = POTEL 
 61:   ! 
 62:   EMARK=1.0D+99 
 63:   NDUDSTREAK=0 59:   NDUDSTREAK=0
 64:   gbh_loop: DO ITRIAL=1,NSTEPS 60:   gbh_loop: DO ITRIAL=1,NSTEPS
 65:      ! 61:      !
 66:      IF(QALCSV) WRITE(MYUNIT, '(A,I10)') & 62:      IF(QALCSV) WRITE(MYUNIT, '(A,I10)') &
 67:           'mc_gbh> Starting iteration ', ITRIAL      63:           'mc_gbh> Starting iteration ', ITRIAL     
  64:      POTELO=POTEL
 68:      ! 65:      !
 69:      IF(RESTART.AND.NDUDSTREAK >= NRELAX) THEN 66:      IF(RESTART.AND.NDUDSTREAK >= NRELAX) THEN
 70:         EXTRA=STEP(1) 67:         EXTRA=STEP(1)
 71:         EMARK=1.0D+99 68:         EREF=1.0D+99
 72:         NDUDSTREAK=0 69:         NDUDSTREAK=0
 73:         WRITE(MYUNIT,'(A,I9)') & 70:         WRITE(MYUNIT,'(A,I9)') &
 74:              'mc_gbh> Big shake on iteration ',ITRIAL 71:              'mc_gbh> Big shake on iteration ',ITRIAL
 75:      ELSE 72:      ELSE
 76:         EXTRA=0.0D0 73:         EXTRA=0.0D0
 77:      ENDIF 74:      ENDIF
 78:      ! 75:      !
 79:      ! --- Stochastic cartesian move ------- 76:      ! --- Stochastic cartesian move -------
 80:      !CALL TAKESTEP(1) 77:      !CALL TAKESTEP(1)
 81:      DO I=1,3*NATOMSALLOC 78:      DO I=1,3*NATOMSALLOC
 92:      CALL QUENCH(.FALSE.,1,ITERNS,TIME,BRUN,QDONE,SCREENC) 89:      CALL QUENCH(.FALSE.,1,ITERNS,TIME,BRUN,QDONE,SCREENC)
 93:      WRITE(MYUNIT,& 90:      WRITE(MYUNIT,&
 94:           '(A,I10,A,G20.10,A,I5,A,G12.5,A,F10.1)') & 91:           '(A,I10,A,G20.10,A,I5,A,G12.5,A,F10.1)') &
 95:           'Qu ',NQ(1),' E= ',POTEL,' steps= ',ITERNS,' RMS= ',& 92:           'Qu ',NQ(1),' E= ',POTEL,' steps= ',ITERNS,' RMS= ',&
 96:           RMS,' t= ',TIME-TSTART 93:           RMS,' t= ',TIME-TSTART
 97:      CALL FLUSH(MYUNIT) 94:      CALL FLUSH(MYUNIT)
 98:      ! 95:      !
 99: #ifdef MPI 96: #ifdef MPI
100:      ! Gather all parallel quench energies on master node. 97:      ! Gather all parallel quench energies on master node.
101:      CALL MPI_GATHER(POTEL, 1, MPI_DOUBLE_PRECISION, & 98:      CALL MPI_GATHER(POTEL, 1, MPI_DOUBLE_PRECISION, &
102:           POTEL_LIST(1:NPAR_GBH), 1, MPI_DOUBLE_PRECISION, 0, & 99:           POTEL_LIST, 1, MPI_DOUBLE_PRECISION, 0, &
103:           MPI_COMM_WORLD, MPIERR)100:           MPI_COMM_WORLD, MPIERR)
104: #else101: #else
105:      POTEL_LIST(1) = POTEL102:      POTEL_LIST(1) = POTEL
106: #endif103: #endif
107:      !104:      !
108:      IF(MYNODE==0) THEN105:      IF(MYNODE==0) THEN
109:         IF (TARGET) IPROCLO=MINLOC(POTEL_LIST, 1)-1106:         IF (TARGET) IPROCLO=MINLOC(POTEL_LIST, 1)-1
110:         ! Choose an IPROC with Boltzmann probability.107:         ! Choose a IPROC with Boltzmann probability.
111:         CALL CHOOSE_FROM_LIST(NPAR_GBH,POTEL_LIST,IPROC)108:         CALL CHOOSE_FROM_LIST(NPAR_GBH,POTEL_LIST,IPROC)
112:         IPROC=IPROC-1109:         IPROC=IPROC-1
113:         !110:         !
114:         IF(IPROC<0) THEN ! Revert on master node 
115:            COORDS(1:3*NATOMSALLOC,1) = X0(1:3*NATOMSALLOC) 
116:            LABELS(1:NATOMSALLOC,1) = L0(1:NATOMSALLOC)  
117:            POTEL = E0 
118:            IPROC = 0 
119:            IF(QALCSV) WRITE(MYUNIT, '(A)') & 
120:                 'mc_gbh> Trial rejected.'      
121:         ELSE 
122:            IF(QALCSV) WRITE(MYUNIT, '(A)') & 
123:                 'mc_gbh> Trial accepted.'      
124:         ENDIF 
125:         ! 
126:      ENDIF111:      ENDIF
127:      !112:      !
128: #ifdef MPI 113: #ifdef MPI 
129:      ! Broadcast IPROC from master114:      ! Broadcast IPROC from master
130:      CALL MPI_BCAST(IPROC,1,MPI_INTEGER,&115:      CALL MPI_BCAST(IPROC,1,MPI_INTEGER,&
131:           0,MPI_COMM_WORLD,MPIERR)116:           0,MPI_COMM_WORLD,MPIERR)
132:      ! Broadcast state from IPROC117:      ! Broadcast state from IPROC
133:      CALL MPI_BCAST(COORDS(:,1),3*NATOMSALLOC,&118:      CALL MPI_BCAST(COORDS(:,1),3*NATOMSALLOC,&
134:           MPI_DOUBLE_PRECISION,IPROC,MPI_COMM_WORLD,MPIERR)119:           MPI_DOUBLE_PRECISION,IPROC,MPI_COMM_WORLD,MPIERR)
135:      CALL MPI_BCAST(LABELS(:,1),NATOMSALLOC,MPI_INTEGER,&120:      CALL MPI_BCAST(LABELS(:,1),NATOMSALLOC,MPI_INTEGER,&
141:      ! Broadcast HIT from IPROCLO if targetting...126:      ! Broadcast HIT from IPROCLO if targetting...
142:      IF(TARGET) THEN127:      IF(TARGET) THEN
143:         ! Broadcast IPROCLO from master128:         ! Broadcast IPROCLO from master
144:         CALL MPI_BCAST(IPROCLO,1,MPI_INTEGER,&129:         CALL MPI_BCAST(IPROCLO,1,MPI_INTEGER,&
145:              0,MPI_COMM_WORLD,MPIERR)130:              0,MPI_COMM_WORLD,MPIERR)
146:         CALL MPI_BCAST(HIT,1,MPI_LOGICAL,&131:         CALL MPI_BCAST(HIT,1,MPI_LOGICAL,&
147:              IPROCLO,MPI_COMM_WORLD,MPIERR)        132:              IPROCLO,MPI_COMM_WORLD,MPIERR)        
148:      ENDIF133:      ENDIF
149: #endif                     134: #endif                     
150:      !135:      !
151:      IF(POTEL < EMARK - ECONV) THEN136:      IF(POTEL < EREF - ECONV) THEN
152:         EMARK = POTEL137:         EREF = POTEL
153:         NDUDSTREAK=0138:         NDUDSTREAK=0
154:      ELSE139:      ELSE
155:         NDUDSTREAK = NDUDSTREAK+1140:         NDUDSTREAK = NDUDSTREAK+1
156:      ENDIF141:      ENDIF
157:      !142:      !
158:      IF(HIT) THEN143:      IF(HIT) THEN
159:         WRITE(MYUNIT,'(A,I3,A,I6)') &144:         WRITE(MYUNIT,'(A,I3,A,I6)') &
160:              'mc_gbh> Target hit stochastically by node ',IPROCLO+1,&145:              'mc_gbh> Target hit stochastically by node ',IPROCLO+1,&
161:              ' on trial ',ITRIAL146:              ' on trial ',ITRIAL
162:         EXIT gbh_loop147:         EXIT gbh_loop
163:      ENDIF148:      ENDIF
164:      !149:      !
165:      ! --- Deterministic refinement --------------------------150:      ! --- Deterministic refinement --------------------------
166:      IF(.NOT.HIT .AND. QALCST .AND. QALCS_NBRHD>0 &151:      IF(.NOT.HIT .AND. QALCST .AND. QALCS_NBRHD>0 &
167:           .AND. ABS(POTEL-E0)>ECONV) THEN152:           .AND. ABS(POTEL-POTELO)>ECONV) THEN
168:         ! perform a variable neighbourhood search (in parallel)153:         ! perform a variable neighbourhood search (in parallel)
169:         CALL QALCS_PARALLEL(ITERNS, TIME, BRUN, QDONE, SCREENC)154:         CALL QALCS_PARALLEL(ITERNS, TIME, BRUN, QDONE, SCREENC)
170:      ENDIF155:      ENDIF
171:      !156:      !
172:      IF(HIT) EXIT gbh_loop157:      IF(HIT) EXIT gbh_loop
173:      !158:      !
174:       
175:      !159:      !
176:   ENDDO gbh_loop160:   ENDDO gbh_loop
177:   !161:   !
178:   RETURN162:   RETURN
179:   !163:   !
180: END SUBROUTINE MC_GBH164: END SUBROUTINE MC_GBH
181: 165: 
182: SUBROUTINE CHOOSE_FROM_LIST(N,VALUES,I)166: SUBROUTINE CHOOSE_FROM_LIST(N,VALUES,I)
183:   !167:   !
184:   ! Choose an element of VALUES with Boltzmann probability168:   ! Choose an element of VALUES with Boltzmann probability
185:   !169:   !
186:   USE COMMONS, ONLY : TEMP170:   USE COMMONS, ONLY : TEMP
187:   !171:   !
188:   IMPLICIT NONE172:   IMPLICIT NONE
189:   !173:   !
190:   INTEGER, INTENT(IN) :: N174:   INTEGER, INTENT(IN) :: N
191:   DOUBLE PRECISION, INTENT(IN) :: VALUES(0:N)175:   DOUBLE PRECISION, INTENT(IN) :: VALUES(N)
192:   INTEGER, INTENT(OUT) :: I176:   INTEGER, INTENT(OUT) :: I
193:   !177:   !
 178:   INTEGER :: J
194:   DOUBLE PRECISION :: PSUM(N), X, DPRAND, ELOWEST179:   DOUBLE PRECISION :: PSUM(N), X, DPRAND, ELOWEST
195:   !180:   !
196:   ELOWEST=MINVAL(VALUES(0:N))181:   ELOWEST=MINVAL(VALUES)
197:   !182:   !
198:   X=0.0D0 ! initialise total sum183:   X=0.0D0 ! initialise total sum
199:   DO I=0,N 184:   DO J=1,N 
200:      X = X + DEXP(-(VALUES(I)-ELOWEST)/TEMP(1))185:      X = X + DEXP(-(VALUES(J)-ELOWEST)/TEMP(1))
201:      PSUM(I) = X ! store partial sum186:      PSUM(J) = X ! store partial sum
202:   ENDDO187:   ENDDO
203:   !188:   !
204:   X=X*DPRAND()189:   X=X*DPRAND()
205:   !190:   !
206:   I=0191:   I=1
207:   DO WHILE (X > PSUM(I))192:   DO WHILE (X > PSUM(I))
208:      I=I+1193:      I=I+1
209:   ENDDO194:   ENDDO
210:   !195:   !
211:   RETURN196:   RETURN
212:   !197:   !
213: END SUBROUTINE CHOOSE_FROM_LIST198: END SUBROUTINE CHOOSE_FROM_LIST


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0