hdiff output

r31627/calc.Cv.f90 2016-12-12 17:30:08.112449955 +0000 r31626/calc.Cv.f90 2016-12-12 17:30:08.612456360 +0000
999: !999: !
1000: ! Is this fraction one when the above if block is not used?1000: ! Is this fraction one when the above if block is not used?
1001: !1001: !
1002:           EVAR(J1)=EVAR(J1)+FRACTION*EXP(OLDVAR(NCOUNT))1002:           EVAR(J1)=EVAR(J1)+FRACTION*EXP(OLDVAR(NCOUNT))
1003: 1003: 
1004:           IF (ENERGY(J1)-QENERGY(J2).GT.0.0D0) THEN1004:           IF (ENERGY(J1)-QENERGY(J2).GT.0.0D0) THEN
1005:              WRITE(19,'(2I8,3G20.10)') J2, J1, QENERGY(J2), ENERGY(J1), &1005:              WRITE(19,'(2I8,3G20.10)') J2, J1, QENERGY(J2), ENERGY(J1), &
1006:   &                          LOG( (1.0D0-FRACTION)*EXP((KFAC+(ENERGY(J1)-QENERGY(J2))*EXP(FITA(J2))) &1006:   &                          LOG( (1.0D0-FRACTION)*EXP((KFAC+(ENERGY(J1)-QENERGY(J2))*EXP(FITA(J2))) &
1007:   &                                           *LOG(ENERGY(J1)-QENERGY(J2))+FITB(J2)) &1007:   &                                           *LOG(ENERGY(J1)-QENERGY(J2))+FITB(J2)) &
1008:   &                               +FRACTION*EXP(OLDVAR(NCOUNT)) )1008:   &                               +FRACTION*EXP(OLDVAR(NCOUNT)) )
1009:           ELSE                     
1010:              WRITE(19,'(2I8,3G20.10)') J2, J1, QENERGY(J2), ENERGY(J1), & 
1011:   &                          LOG( FRACTION*EXP(OLDVAR(NCOUNT)) ) 
1012:           ENDIF1009:           ENDIF
1013:  
1014:        ENDDO1010:        ENDDO
1015: !      DO J1=(LOWESTDIRECT(J2)+BESTBINS(J2))/2+1,NBINS ! use direct visits above range of fit if available1011: !      DO J1=(LOWESTDIRECT(J2)+BESTBINS(J2))/2+1,NBINS ! use direct visits above range of fit if available
1016: !      DO J1=LOWESTDIRECT(J2),NBINS ! use only direct visits above lowest direct1012: !      DO J1=LOWESTDIRECT(J2),NBINS ! use only direct visits above lowest direct
1017:        DO J1=BESTBINS(J2)+1,NBINS ! use direct visits above range of fit if available1013:        DO J1=BESTBINS(J2)+1,NBINS ! use direct visits above range of fit if available
1018:           IF (ALLZERO2(J1,J2)) CYCLE1014:           IF (ALLZERO2(J1,J2)) CYCLE
1019:           NCOUNT=VARMAP2(J1,J2)1015:           NCOUNT=VARMAP2(J1,J2)
1020:           EVAR(J1)=EVAR(J1)+EXP(OLDVAR(NCOUNT))1016:           EVAR(J1)=EVAR(J1)+EXP(OLDVAR(NCOUNT))
1021:           WRITE(19,'(2I8,3G20.10)') J2, J1, QENERGY(J2), ENERGY(J1), (KFAC+(ENERGY(J1)-QENERGY(J2))*EXP(FITA(J2))) &1017:           WRITE(19,'(2I8,3G20.10)') J2, J1, QENERGY(J2), ENERGY(J1), (KFAC+(ENERGY(J1)-QENERGY(J2))*EXP(FITA(J2))) &
1022:   &                                           *LOG(ENERGY(J1)-QENERGY(J2))+FITB(J2)1018:   &                                           *LOG(ENERGY(J1)-QENERGY(J2))+FITB(J2)
1023:        ENDDO1019:        ENDDO
1144: ! Repeat previous construction with some refined FITB values using min.data.1140: ! Repeat previous construction with some refined FITB values using min.data.
1145: !1141: !
1146: ! Final densities of states are calculated from direct pe, q bin visits if1142: ! Final densities of states are calculated from direct pe, q bin visits if
1147: ! available, and the values inferred from the fit otherwise.1143: ! available, and the values inferred from the fit otherwise.
1148: !1144: !
1149: ! Fitting range for q bin J1 includes gamma bins from1145: ! Fitting range for q bin J1 includes gamma bins from
1150: ! LOWESTDIRECT(J1) to NBINS.1146: ! LOWESTDIRECT(J1) to NBINS.
1151: ! There is no contribution to the fit if q bin j1 is never visited for any gamma.1147: ! There is no contribution to the fit if q bin j1 is never visited for any gamma.
1152: !1148: !
1153: EVAR(1:NBINS)=0.0D01149: EVAR(1:NBINS)=0.0D0
1154: OPEN(UNIT=19,FILE='weights.2D.D') 
1155: QHISTINT=QENERGY(2)-QENERGY(1) ! in case we didn't set this before1150: QHISTINT=QENERGY(2)-QENERGY(1) ! in case we didn't set this before
1156: OPEN(UNIT=1,FILE='anharmonic.fit',STATUS='UNKNOWN')1151: OPEN(UNIT=1,FILE='anharmonic.fit',STATUS='UNKNOWN')
1157: DO J2=1,NQBINS             ! J2 labels the PE bin we quench to1152: DO J2=1,NQBINS             ! J2 labels the PE bin we quench to
1158:    IF (FITA(J2).NE.0.0D0) THEN1153:    IF (FITA(J2).NE.0.0D0) THEN
1159:       WRITE(1,'(5G20.10)') QENERGY(J2),QENERGY(J2)-QHISTINT/2.0D0,QENERGY(J2)+QHISTINT/2.0D0,FITA(J2),FITB(J2)1154:       WRITE(1,'(5G20.10)') QENERGY(J2),QENERGY(J2)-QHISTINT/2.0D0,QENERGY(J2)+QHISTINT/2.0D0,FITA(J2),FITB(J2)
1160:    ENDIF1155:    ENDIF
1161: !1156: !
1162: ! Next block was causing artefacts for LJ31, but seems to be needed for LJ75.1157: ! Next block was causing artefacts for LJ31, but seems to be needed for LJ75.
1163: ! Excluding contributions from the rescaled fit if either1158: ! Excluding contributions from the rescaled fit if either
1164: ! (1) we are above BESTBINS and there were no direct visits1159: ! (1) we are above BESTBINS and there were no direct visits
1171:          IF (J1.LT.BESTBINS(J2)) THEN1166:          IF (J1.LT.BESTBINS(J2)) THEN
1172:             DUMMY=1.0D01167:             DUMMY=1.0D0
1173:          ELSEIF (.NOT.ALLZERO2(J1,J2)) THEN1168:          ELSEIF (.NOT.ALLZERO2(J1,J2)) THEN
1174:             NCOUNT=VARMAP2(J1,J2)1169:             NCOUNT=VARMAP2(J1,J2)
1175:             DUMMY=EXP((KFAC+(ENERGY(J1)-QENERGY(J2))*EXP(FITA(J2)))*LOG(ENERGY(J1)-QENERGY(J2))+FITB(J2)-OLDVAR(NCOUNT))1170:             DUMMY=EXP((KFAC+(ENERGY(J1)-QENERGY(J2))*EXP(FITA(J2)))*LOG(ENERGY(J1)-QENERGY(J2))+FITB(J2)-OLDVAR(NCOUNT))
1176:          ELSE ! we are above BESTBINS and there were no direct visits1171:          ELSE ! we are above BESTBINS and there were no direct visits
1177:             DUMMY=HUGE(1.0D0)1172:             DUMMY=HUGE(1.0D0)
1178:          ENDIF1173:          ENDIF
1179:          IF (DUMMY.LT.RATMAX) EVAR(J1)=EVAR(J1)+EXP((KFAC+(ENERGY(J1)-QENERGY(J2))*EXP(FITA(J2))) &1174:          IF (DUMMY.LT.RATMAX) EVAR(J1)=EVAR(J1)+EXP((KFAC+(ENERGY(J1)-QENERGY(J2))*EXP(FITA(J2))) &
1180:    &                              *LOG(ENERGY(J1)-QENERGY(J2))+FITB(J2))1175:    &                              *LOG(ENERGY(J1)-QENERGY(J2))+FITB(J2))
1181:          IF (DUMMY.LT.RATMAX) WRITE(19,'(2I8,3G20.10)') J2, J1, QENERGY(J2), ENERGY(J1), & 
1182:    &                             (KFAC+(ENERGY(J1)-QENERGY(J2))*EXP(FITA(J2))) & 
1183:    &                              *LOG(ENERGY(J1)-QENERGY(J2))+FITB(J2) 
1184:       ENDDO1176:       ENDDO
1185:    ELSEIF (ALLZEROQ(J2)) THEN ! no quenches or fit for this q bin - use direct visits only1177:    ELSEIF (ALLZEROQ(J2)) THEN ! no quenches or fit for this q bin - use direct visits only
1186: !  IF (ALLZEROQ(J2)) THEN ! no quenches or fit for this q bin - use direct visits only1178: !  IF (ALLZEROQ(J2)) THEN ! no quenches or fit for this q bin - use direct visits only
1187:       DO J1=1,NBINS ! J1 labels the PE bin we quenched from1179:       DO J1=1,NBINS ! J1 labels the PE bin we quenched from
1188:          IF (ALLZERO2(J1,J2)) CYCLE1180:          IF (ALLZERO2(J1,J2)) CYCLE
1189:          NCOUNT=VARMAP2(J1,J2)1181:          NCOUNT=VARMAP2(J1,J2)
1190:          EVAR(J1)=EVAR(J1)+EXP(OLDVAR(NCOUNT))1182:          EVAR(J1)=EVAR(J1)+EXP(OLDVAR(NCOUNT))
1191:          WRITE(19,'(2I8,3G20.10)') J2, J1, QENERGY(J2), ENERGY(J1), OLDVAR(NCOUNT) 
1192:       ENDDO1183:       ENDDO
1193:    ELSE ! use a combination of extrapolated or direct visit results1184:    ELSE ! use a combination of extrapolated or direct visit results
1194:       DO J1=1,LOWESTDIRECT(J2)-1 ! interpolated values only available from fit to quenches from1185:       DO J1=1,LOWESTDIRECT(J2)-1 ! interpolated values only available from fit to quenches from
1195:                                  ! higher energy PE bins1186:                                  ! higher energy PE bins
1196:          IF (ENERGY(J1)-QENERGY(J2).GT.0.0D0) THEN1187:          IF (ENERGY(J1)-QENERGY(J2).GT.0.0D0) THEN
1197:             EVAR(J1)=EVAR(J1)+EXP((KFAC+(ENERGY(J1)-QENERGY(J2))*EXP(FITA(J2))) &1188:             EVAR(J1)=EVAR(J1)+EXP((KFAC+(ENERGY(J1)-QENERGY(J2))*EXP(FITA(J2))) &
1198:   &                                          *LOG(ENERGY(J1)-QENERGY(J2))+FITB(J2))1189:   &                                          *LOG(ENERGY(J1)-QENERGY(J2))+FITB(J2))
1199:             WRITE(19,'(2I8,3G20.10)') J2, J1, QENERGY(J2), ENERGY(J1), (KFAC+(ENERGY(J1)-QENERGY(J2))*EXP(FITA(J2))) & 
1200:   &                                          *LOG(ENERGY(J1)-QENERGY(J2))+FITB(J2) 
1201:          ENDIF1190:          ENDIF
1202:       ENDDO1191:       ENDDO
1203:       DO J1=LOWESTDIRECT(J2),BESTBINS(J2) ! range used for fit1192:       DO J1=LOWESTDIRECT(J2),BESTBINS(J2) ! range used for fit
1204: !        FRACTION=( (J1*1.0D0-LOWESTDIRECT(J2)*1.0D0)/(BESTBINS(J2)*1.0D0-LOWESTDIRECT(J2)*1.0D0) )**601193: !        FRACTION=( (J1*1.0D0-LOWESTDIRECT(J2)*1.0D0)/(BESTBINS(J2)*1.0D0-LOWESTDIRECT(J2)*1.0D0) )**60
1205:          FRACTION=( (J1*1.0D0-LOWESTDIRECT(J2)*1.0D0)/(BESTBINS(J2)*1.0D0-LOWESTDIRECT(J2)*1.0D0) )1194:          FRACTION=( (J1*1.0D0-LOWESTDIRECT(J2)*1.0D0)/(BESTBINS(J2)*1.0D0-LOWESTDIRECT(J2)*1.0D0) )
1206: !        FRACTION=FRACTION**2*(3.0D0-2*FRACTION)1195: !        FRACTION=FRACTION**2*(3.0D0-2*FRACTION)
1207: !        FRACTION=0.0D01196: !        FRACTION=0.0D0
1208: !        IF ((SUMVISITS(J1,J2).GT.0).AND.(ENERGY(J1)-QENERGY(J2).GT.0.0D0)) THEN1197: !        IF ((SUMVISITS(J1,J2).GT.0).AND.(ENERGY(J1)-QENERGY(J2).GT.0.0D0)) THEN
1209:          IF (ENERGY(J1)-QENERGY(J2).GT.0.0D0) THEN 1198:          IF (ENERGY(J1)-QENERGY(J2).GT.0.0D0) THEN 
1210:             EVAR(J1)=EVAR(J1)+(1.0D0-FRACTION)*EXP((KFAC+(ENERGY(J1)-QENERGY(J2))*EXP(FITA(J2))) &1199:             EVAR(J1)=EVAR(J1)+(1.0D0-FRACTION)*EXP((KFAC+(ENERGY(J1)-QENERGY(J2))*EXP(FITA(J2))) &
1211:   &                                           *LOG(ENERGY(J1)-QENERGY(J2))+FITB(J2))1200:   &                                           *LOG(ENERGY(J1)-QENERGY(J2))+FITB(J2))
1212:          ENDIF1201:          ENDIF
1213:          NCOUNT=VARMAP2(J1,J2)1202:          NCOUNT=VARMAP2(J1,J2)
1214:          EVAR(J1)=EVAR(J1)+FRACTION*EXP(OLDVAR(NCOUNT))1203:          EVAR(J1)=EVAR(J1)+FRACTION*EXP(OLDVAR(NCOUNT))
1215:  
1216:           IF (ENERGY(J1)-QENERGY(J2).GT.0.0D0) THEN 
1217:              WRITE(19,'(2I8,3G20.10)') J2, J1, QENERGY(J2), ENERGY(J1), & 
1218:   &                          LOG( (1.0D0-FRACTION)*EXP((KFAC+(ENERGY(J1)-QENERGY(J2))*EXP(FITA(J2))) & 
1219:   &                                           *LOG(ENERGY(J1)-QENERGY(J2))+FITB(J2)) & 
1220:   &                               +FRACTION*EXP(OLDVAR(NCOUNT)) ) 
1221:           ELSE 
1222:              WRITE(19,'(2I8,3G20.10)') J2, J1, QENERGY(J2), ENERGY(J1), & 
1223:   &                          LOG( FRACTION*EXP(OLDVAR(NCOUNT)) ) 
1224:           ENDIF 
1225:  
1226:       ENDDO1204:       ENDDO
1227:       DO J1=BESTBINS(J2)+1,NBINS ! use direct visits above range of fit if available1205:       DO J1=BESTBINS(J2)+1,NBINS ! use direct visits above range of fit if available
1228:          IF (ALLZERO2(J1,J2)) CYCLE1206:          IF (ALLZERO2(J1,J2)) CYCLE
1229:          NCOUNT=VARMAP2(J1,J2)1207:          NCOUNT=VARMAP2(J1,J2)
1230:          EVAR(J1)=EVAR(J1)+EXP(OLDVAR(NCOUNT))1208:          EVAR(J1)=EVAR(J1)+EXP(OLDVAR(NCOUNT))
1231:          WRITE(19,'(2I8,3G20.10)') J2, J1, QENERGY(J2), ENERGY(J1), OLDVAR(NCOUNT) 
1232:       ENDDO1209:       ENDDO
1233:    ENDIF1210:    ENDIF
1234: ENDDO1211: ENDDO
1235: CLOSE(19) 
1236: CLOSE(1)1212: CLOSE(1)
1237: 1213: 
1238: PRINT '(A)',' '1214: PRINT '(A)',' '
1239: PRINT '(A)','dumping pe bin, direct visits, bin energy, ln omega to weights.D'1215: PRINT '(A)','dumping pe bin, direct visits, bin energy, ln omega to weights.D'
1240: NCOUNT=01216: NCOUNT=0
1241: IF (ALLOCATED(VSUM)) DEALLOCATE(VSUM)1217: IF (ALLOCATED(VSUM)) DEALLOCATE(VSUM)
1242: ALLOCATE(VSUM(NBINS))1218: ALLOCATE(VSUM(NBINS))
1243: VSUM=SUM(VISITS,DIM=2)1219: VSUM=SUM(VISITS,DIM=2)
1244: OPEN(UNIT=1,FILE='weights.D',STATUS='UNKNOWN')1220: OPEN(UNIT=1,FILE='weights.D',STATUS='UNKNOWN')
1245: DO J1=1,NBINS1221: DO J1=1,NBINS


r31627/Cv.BS2.f90 2016-12-12 17:30:07.864446854 +0000 r31626/Cv.BS2.f90 2016-12-12 17:30:08.364453186 +0000
255:       DUMMY2=0.0D0255:       DUMMY2=0.0D0
256:       DO J2=1,NQBINS256:       DO J2=1,NQBINS
257:          DUMMY2=DUMMY2+CQP(J2)+CQM(J2)257:          DUMMY2=DUMMY2+CQP(J2)+CQM(J2)
258:          IF (CQP(J2)+CQM(J2).GT.1.0D-10) THEN 258:          IF (CQP(J2)+CQM(J2).GT.1.0D-10) THEN 
259:             PRINT '(I8,4G20.10)',J2,CQP(J2),CQM(J2),CQP(J2)+CQM(J2),DUMMY2259:             PRINT '(I8,4G20.10)',J2,CQP(J2),CQM(J2),CQP(J2)+CQM(J2),DUMMY2
260:          ENDIF260:          ENDIF
261:       ENDDO261:       ENDDO
262:    262:    
263:       PRINT '(A,I8,A)','For disconnectionDPS use line TRMIN 2 ',NMIN,' min.minus.BS min.plus.BS and '263:       PRINT '(A,I8,A)','For disconnectionDPS use line TRMIN 2 ',NMIN,' min.minus.BS min.plus.BS and '
264:       PRINT '(A)','CHOOSECOLOURS in the dinfo file'264:       PRINT '(A)','CHOOSECOLOURS in the dinfo file'
 265:       PRINT '(A)','Assignment of minima to quench bins: minimum, pe, q bin, q energy, diff'
265: 266: 
266:       NQPLUS=0.0D0267:       NQPLUS=0.0D0
267:       NQMINUS=0.0D0268:       NQMINUS=0.0D0
268:       DQPLUS=0.0D0269:       DQPLUS=0.0D0
269:       DQMINUS=0.0D0270:       DQMINUS=0.0D0
270:       ALLOCATE(PERMINQP(NQBINS),PERMINQM(NQBINS),MINQP(NQBINS),MINQM(NQBINS))271:       ALLOCATE(PERMINQP(NQBINS),PERMINQM(NQBINS),MINQP(NQBINS),MINQM(NQBINS))
271: 272: 
272:       DO J2=1,NQBINS273:       DO J2=1,NQBINS
273:          IF ((ABS(CQP(J2)).LT.1.0D-10).AND.(ABS(CQM(J2)).LT.1.0D-10)) CYCLE 
274:          IF (CQP(J2)-CQM(J2).LT.0.0D0) THEN274:          IF (CQP(J2)-CQM(J2).LT.0.0D0) THEN
275:             NQMINUS=NQMINUS+1275:             NQMINUS=NQMINUS+1
276:             MINQM(NQMINUS)=J2276:             MINQM(NQMINUS)=J2
277:             PERMINQM(NQMINUS)=CQM(J2)-CQP(J2)277:             PERMINQM(NQMINUS)=CQM(J2)-CQP(J2)
278:             DQMINUS=DQMINUS+CQM(J2)-CQP(J2)278:             DQMINUS=DQMINUS+CQM(J2)-CQP(J2)
279:          ELSE279:          ELSE
280:             NQPLUS=NQPLUS+1280:             NQPLUS=NQPLUS+1
281:             MINQP(NQPLUS)=J2281:             MINQP(NQPLUS)=J2
282:             PERMINQP(NQPLUS)=CQP(J2)-CQM(J2)282:             PERMINQP(NQPLUS)=CQP(J2)-CQM(J2)
283:             DQPLUS=DQPLUS+CQP(J2)-CQM(J2)283:             DPLUS=DPLUS+CQP(J2)-CQM(J2)
284:          ENDIF284:          ENDIF
285: !        PRINT '(A,I8,4G20.10)','J2,CQP,CQM,NQMINUS,NQPLUS=',J2,CQP(J2),CQM(J2),NQMINUS,NQPLUS 
286:       ENDDO285:       ENDDO
287:       DO J2=1,NQMINUS286:       DO J2=1,NQMINUS
288:          PERMINQM(J2)=PERMINQM(J2)/MAX(DQMINUS,1.0D-200)287:          PERMINQM(J2)=PERMINQM(J2)/MAX(DQMINUS,1.0D-200)
289: !        PRINT '(A,I8,2G20.10)','J2,PERMINQM,DQMINUS=',J2,PERMINQM(J2),DQMINUS 
290:       ENDDO288:       ENDDO
291:       DO J2=1,NQPLUS289:       DO J2=1,NQPLUS
292:          PERMINQP(J2)=PERMINQP(J2)/MAX(DQPLUS,1.0D-200)290:          PERMINQP(J2)=PERMINQP(J2)/MAX(DQPLUS,1.0D-200)
293: !        PRINT '(A,I8,2G20.10)','J2,PERMINQP,DQPLUS=',J2,PERMINQP(J2),DQPLUS 
294:       ENDDO291:       ENDDO
295:       CALL SORT(NQMINUS,NQBINS,PERMINQM,MINQM)292:       CALL SORT(NQMINUS,NQBINS,PERMINQM,MINQM)
296:       CALL SORT(NQPLUS,NQBINS,PERMINQP,MINQP)293:       CALL SORT(NQPLUS,NQBINS,PERMINQP,MINQP)
297:       294:       
298:       DUMMY=0.0D0295:       DUMMY=0.0D0
299:       PRINT '(A)','q bins with negative overall flux below threshold:'296:       PRINT '(A)','q bins with negative overall flux below threshold:'
300:       DO J2=1,NQMINUS297:       DO J2=1,NQMINUS
301:          DUMMY=DUMMY+PERMINQM(J2)298:          DUMMY=DUMMY+PERMINQM(J2)
302:          PRINT '(2I6,4G20.10)',J2,MINQM(J2),PERMINQM(J2),DUMMY,QENERGY(MINQM(J2))299:          PRINT '(2I6,4G20.10)',J2,MINQM(J2),PERMINQM(J2),DUMMY,QENERGY(MINQM(J2))
303:          IF (DUMMY.GT.COLOURTHRESH) EXIT300:          IF (DUMMY.GT.COLOURTHRESH) EXIT
304:       ENDDO301:       ENDDO
305:       DUMMY=0.0D0302:       DUMMY=0.0D0
306:       PRINT '(A)','q bins with positive overall flux below threshold:'303:       PRINT '(A)','q bins with positive overall flux below threshold:'
307:       DO J2=1,NQPLUS304:       DO J2=1,NQPLUS
308:          DUMMY=DUMMY+PERMINQP(J2)305:          DUMMY=DUMMY+PERMINQP(J2)
309:          PRINT '(2I6,4G20.10)',J2,MINQP(J2),PERMINQP(J2),DUMMY,QENERGY(MINQP(J2))306:          PRINT '(2I6,4G20.10)',J2,MINQP(J2),PERMINQP(J2),DUMMY,QENERGY(MINQP(J2))
310:          IF (DUMMY.GT.COLOURTHRESH) EXIT307:          IF (DUMMY.GT.COLOURTHRESH) EXIT
311:       ENDDO308:       ENDDO
312: 309: 
313:       PRINT '(A)','Assignment of minima to quench bins: minimum, pe, q bin, q energy, diff' 
314:       DO J1=1,NMIN310:       DO J1=1,NMIN
315:          DMIN=HUGE(1.0D0)311:          DMIN=HUGE(1.0D0)
316:          DO J2=1,NQBINS312:          DO J2=1,NQBINS
317:             IF (ABS(EMIN(J1)-QENERGY(J2)).LT.DMIN) THEN313:             IF (ABS(EMIN(J1)-QENERGY(J2)).LT.DMIN) THEN
318:                QBIN(J1)=J2314:                QBIN(J1)=J2
319:                DMIN=ABS(EMIN(J1)-QENERGY(J2))315:                DMIN=ABS(EMIN(J1)-QENERGY(J2))
320:             ENDIF316:             ENDIF
321:          ENDDO317:          ENDDO
322: !        PRINT '(I8,G20.10,I8,2G20.10)',J1,EMIN(J1),QBIN(J1),QENERGY(QBIN(J1)),DMIN318: !        PRINT '(I8,G20.10,I8,2G20.10)',J1,EMIN(J1),QBIN(J1),QENERGY(QBIN(J1)),DMIN
323:       ENDDO319:       ENDDO
324: 320: 
325:       OPEN(UNIT=1,FILE='min.minus.BS',STATUS='UNKNOWN')321:       OPEN(UNIT=1,FILE='min.minus.BS',STATUS='UNKNOWN')
326:       DUMMY=0.0D0322:       DUMMY=0.0D0
327:       DO J2=1,NQMINUS323:       DO J2=1,NQMINUS
328:          DUMMY=DUMMY+PERMINQM(J2)324:          DUMMY=DUMMY+PERMINQM(J2)
329:          DO J1=1,NMIN325:          DO J1=1,NMIN
330:             IF (QBIN(J1).EQ.MINQM(J2)) THEN326:             IF (QBIN(J1).EQ.MINQM(J2)) THEN
331:                WRITE(1,'(I6)') J1327:                WRITE(1,'(I6)') J1
332: !              WRITE(*,'(A,3I8,3G20.10)') 'J1, J2, MINQM(J2), EMIN', J1, J2, MINQM(J2), EMIN(J1)328:                WRITE(*,'(A,3I8,3G20.10)') 'J1, J2, MINQM(J2), EMIN', J1, J2, MINQM(J2), EMIN(J1)
333:             ENDIF329:             ENDIF
334:          ENDDO330:          ENDDO
335:          IF (DUMMY.GT.COLOURTHRESH) EXIT331:          IF (DUMMY.GT.COLOURTHRESH) EXIT
336:       ENDDO332:       ENDDO
337:       CLOSE(1)333:       CLOSE(1)
338: 334: 
339:       OPEN(UNIT=1,FILE='min.plus.BS',STATUS='UNKNOWN')335:       OPEN(UNIT=1,FILE='min.plus.BS',STATUS='UNKNOWN')
340:       DUMMY=0.0D0336:       DUMMY=0.0D0
341:       DO J2=1,NQPLUS337:       DO J2=1,NQPLUS
342:          DUMMY=DUMMY+PERMINQP(J2)338:          DUMMY=DUMMY+PERMINQP(J2)
343:          DO J1=1,NMIN339:          DO J1=1,NMIN
344:             IF (QBIN(J1).EQ.MINQP(J2)) THEN340:             IF (QBIN(J1).EQ.MINQP(J2)) THEN
345:                WRITE(1,'(I6)') J1341:                WRITE(1,'(I6)') J1
346: !              WRITE(*,'(A,3I6,3G20.10)') 'J1, J2, MINQP(J2), EMIN=', J1, J2, MINQP(J2), EMIN(J1)342:                WRITE(*,'(A,3I6,3G20.10)') 'J1, J2, MINQP(J2), EMIN=', J1, J2, MINQP(J2), EMIN(J1)
347:             ENDIF343:             ENDIF
348:          ENDDO344:          ENDDO
349:          IF (DUMMY.GT.COLOURTHRESH) EXIT345:          IF (DUMMY.GT.COLOURTHRESH) EXIT
350:       ENDDO 346:       ENDDO 
351:       CLOSE(1)347:       CLOSE(1)
352: 348: 
353:    ENDIF349:    ENDIF
354: ENDIF350: ENDIF
355: 351: 
356: END PROGRAM CVBS352: END PROGRAM CVBS


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0