hdiff output

r30093/Dijinit.f90 2017-01-21 10:38:34.293213611 +0000 r30092/Dijinit.f90 2017-01-21 10:38:34.577235910 +0000
 20: !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 20: !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 21: ! 21: !
 22: !  Dijkstra connection algorithm for pathsample. 22: !  Dijkstra connection algorithm for pathsample.
 23: ! 23: !
 24: SUBROUTINE DIJINIT(NWORST) 24: SUBROUTINE DIJINIT(NWORST)
 25: USE PORFUNCS 25: USE PORFUNCS
 26: USE COMMONS 26: USE COMMONS
 27: USE UTILS,ONLY : GETUNIT 27: USE UTILS,ONLY : GETUNIT
 28: IMPLICIT NONE 28: IMPLICIT NONE
 29:  29: 
 30: INTEGER J1, J2, J4, PARENT(NMIN), JMINW, NPERM, J5, LJ1, LJ2, NWORST, NSTEPS, NMINSTART, NMINEND, J6, MUNIT, J7 30: INTEGER J1, J2, J4, PARENT(NMIN), JMINW, NPERM, J5, LJ1, LJ2, NWORST, NSTEPS, NMINSTART, NMINEND, J6, MUNIT
 31: INTEGER NMINGAP 31: INTEGER NMINGAP
 32: INTEGER, ALLOCATABLE :: LOCATIONSTART(:), LOCATIONEND(:) 32: INTEGER, ALLOCATABLE :: LOCATIONSTART(:), LOCATIONEND(:)
 33: LOGICAL PERMANENT(NMIN), ISA(NMIN), ISB(NMIN), ISSTART(NMIN), NOTDONE 33: LOGICAL PERMANENT(NMIN), ISA(NMIN), ISB(NMIN), ISSTART(NMIN), NOTDONE
 34: DOUBLE PRECISION MINWEIGHT, DUMMY, TNEW, ELAPSED, PFTOTALSTART, HUGESAVE, THRESH 34: DOUBLE PRECISION MINWEIGHT, DUMMY, TNEW, ELAPSED, PFTOTALSTART, HUGESAVE, THRESH
 35: DOUBLE PRECISION MAXWEIGHT, SCALEFAC, PDMAX, PD, MINGAPTHRESH 35: DOUBLE PRECISION MAXWEIGHT, SCALEFAC, PDMAX, PD, MINGAPTHRESH
 36: INTEGER, DIMENSION(:), ALLOCATABLE :: PATHMINS 36: INTEGER, DIMENSION(:), ALLOCATABLE :: PATHMINS
 37: ! 37: !
 38: ! KIND=16 is not supported by Portland. If you want extra precision, uncomment the following line 38: ! KIND=16 is not supported by Portland. If you want extra precision, uncomment the following line
 39: ! and use NAG. 39: ! and use NAG.
 40: ! 40: !
121:    NPERM=1121:    NPERM=1
122:    PARENT(1:NMIN)=0 ! parent is initially undefined122:    PARENT(1:NMIN)=0 ! parent is initially undefined
123:    J4=LJ1123:    J4=LJ1
124:    dijkstraloop: DO124:    dijkstraloop: DO
125:       DO J2=1,NMIN125:       DO J2=1,NMIN
126:          IF (J2.EQ.J4) CYCLE126:          IF (J2.EQ.J4) CYCLE
127:          IF (PERMANENT(J2)) CYCLE127:          IF (PERMANENT(J2)) CYCLE
128:          PD=1.0D4*PDMAX128:          PD=1.0D4*PDMAX
129:          IF (.NOT.DIJPRUNET) THEN !for pruning the database all minima count not just the ones not searched yet129:          IF (.NOT.DIJPRUNET) THEN !for pruning the database all minima count not just the ones not searched yet
130:             DO J5=1,NPAIRDONE ! skip130:             DO J5=1,NPAIRDONE ! skip
131:           !     IF ((PAIR1(J5).EQ.J4).AND.(PAIR2(J5).EQ.J2)) GOTO 973131:                IF ((PAIR1(J5).EQ.J4).AND.(PAIR2(J5).EQ.J2)) GOTO 973
132:           !     IF ((PAIR1(J5).EQ.J2).AND.(PAIR2(J5).EQ.J4)) GOTO 973132:                IF ((PAIR1(J5).EQ.J2).AND.(PAIR2(J5).EQ.J4)) GOTO 973
133: !kr366> check if pair has been searched before, if enter DO loop to check if PAIRDIST 
134: !is 0.0D0: If yes go to 973, else set PAIRDIST to 1.0D4*PDMAX 
135:                 IF ((PAIR1(J5).EQ.J4).AND.(PAIR2(J5).EQ.J2)) THEN  
136:                    DO J6=1,PAIRDISTMAX 
137:                       IF (PAIRLIST(J4,J6).EQ.J2) THEN 
138:                          PD=PAIRDIST(J4,J6) 
139:                          IF (PD.EQ.0.0D0) THEN 
140:                             GOTO 973 
141:                          ELSE 
142:                             PD=1.0D4*PDMAX 
143:                             GOTO 973 
144:                          ENDIF 
145:                       ENDIF 
146:                    ENDDO 
147:                    GOTO 973 
148:                 ENDIF 
149:                 IF ((PAIR1(J5).EQ.J2).AND.(PAIR2(J5).EQ.J4)) THEN 
150:                    DO J6=1,PAIRDISTMAX 
151:                       IF (PAIRLIST(J2,J6).EQ.J4) THEN 
152:                          PD=PAIRDIST(J2,J6) 
153:                          IF (PD.EQ.0.0D0) THEN 
154:                             GOTO 973 
155:                          ELSE 
156:                             PD=1.0D4*PDMAX 
157:                             GOTO 973 
158:                          ENDIF 
159:                       ENDIF 
160:                    ENDDO 
161:                    GOTO 973 
162:                 ENDIF 
163:             ENDDO133:             ENDDO
164:          ENDIF 134:          ENDIF 
165:          DO J5=1,PAIRDISTMAX135:          DO J5=1,PAIRDISTMAX
166:             IF (PAIRLIST(J4,J5).EQ.J2) THEN136:             IF (PAIRLIST(J4,J5).EQ.J2) THEN
167:                PD=PAIRDIST(J4,J5)137:                PD=PAIRDIST(J4,J5)
168:                GOTO 973138:                GOTO 973
169:             ENDIF139:             ENDIF
170:          ENDDO140:          ENDDO
171:          DO J5=1,PAIRDISTMAX141:          DO J5=1,PAIRDISTMAX
172:             IF (PAIRLIST(J2,J5).EQ.J4) THEN142:             IF (PAIRLIST(J2,J5).EQ.J4) THEN
273: IF (DIJPRUNET) OPEN(MUNIT,FILE='min.retain',POSITION='APPEND',ACTION='WRITE',STATUS='NEW')243: IF (DIJPRUNET) OPEN(MUNIT,FILE='min.retain',POSITION='APPEND',ACTION='WRITE',STATUS='NEW')
274: DO 244: DO 
275:    IF (PARENT(J5).EQ.0) THEN245:    IF (PARENT(J5).EQ.0) THEN
276:       PRINT '(A,I6,A)','Dijinit> ERROR - parent for J5=',J5,' is zero'246:       PRINT '(A,I6,A)','Dijinit> ERROR - parent for J5=',J5,' is zero'
277:       PRINT '(A)',     'Dijinit> Suggests all possible pairs have been tried!'247:       PRINT '(A)',     'Dijinit> Suggests all possible pairs have been tried!'
278:       STOP248:       STOP
279:    ENDIF249:    ENDIF
280: !  DUMMY=PAIRDIST(MAX(J5,PARENT(J5))*(MAX(J5,PARENT(J5))-1)/2+MIN(J5,PARENT(J5)))*SCALEFAC250: !  DUMMY=PAIRDIST(MAX(J5,PARENT(J5))*(MAX(J5,PARENT(J5))-1)/2+MIN(J5,PARENT(J5)))*SCALEFAC
281:    DUMMY=1.0D4*PDMAX*SCALEFAC251:    DUMMY=1.0D4*PDMAX*SCALEFAC
282:    DO J2=1,NPAIRDONE ! skip252:    DO J2=1,NPAIRDONE ! skip
283: !      IF ((PAIR1(J2).EQ.J5).AND.(PAIR2(J2).EQ.PARENT(J5))) GOTO 864253:       IF ((PAIR1(J2).EQ.J5).AND.(PAIR2(J2).EQ.PARENT(J5))) GOTO 864
284: !      IF ((PAIR1(J2).EQ.PARENT(J5)).AND.(PAIR2(J2).EQ.J5)) GOTO 864254:       IF ((PAIR1(J2).EQ.PARENT(J5)).AND.(PAIR2(J2).EQ.J5)) GOTO 864
285:        IF ((PAIR1(J2).EQ.J5).AND.(PAIR2(J2).EQ.PARENT(J5))) THEN 
286:           DO J6=1,PAIRDISTMAX 
287:              IF (PAIRLIST(J5,J6).EQ.PARENT(J5)) THEN 
288:                 DUMMY=PAIRDIST(J5,J6)*SCALEFAC 
289:                 IF (DUMMY.EQ.0.0D0) THEN 
290:                    GOTO 864 
291:                 ELSE 
292:                    DUMMY=1.0D4*PDMAX*SCALEFAC 
293:                    GOTO 864 
294:                 ENDIF 
295:              ENDIF 
296:           ENDDO 
297:           GOTO 864 
298:        ENDIF 
299:        IF ((PAIR1(J2).EQ.PARENT(J5)).AND.(PAIR2(J2).EQ.J5)) THEN 
300:           DO J6=1,PAIRDISTMAX 
301:              IF (PAIRLIST(PARENT(J5),J6).EQ.J5) THEN 
302:                  DUMMY=PAIRDIST(PARENT(J5),J6)*SCALEFAC 
303:                  IF (DUMMY.EQ.0.0D0) THEN 
304:                      GOTO 864 
305:                  ELSE 
306:                     DUMMY=1.0D4*PDMAX*SCALEFAC 
307:                     GOTO 864 
308:                  ENDIF 
309:               ENDIF 
310:            ENDDO 
311:            GOTO 864 
312:         ENDIF 
313:    ENDDO 255:    ENDDO 
314:    DO J2=1,PAIRDISTMAX256:    DO J2=1,PAIRDISTMAX
315:       IF (PAIRLIST(J5,J2).EQ.PARENT(J5)) THEN257:       IF (PAIRLIST(J5,J2).EQ.PARENT(J5)) THEN
316:          DUMMY=PAIRDIST(J5,J2)*SCALEFAC258:          DUMMY=PAIRDIST(J5,J2)*SCALEFAC
317:          GOTO 864259:          GOTO 864
318:       ENDIF260:       ENDIF
319:    ENDDO261:    ENDDO
320:    DO J2=1,PAIRDISTMAX262:    DO J2=1,PAIRDISTMAX
321:       IF (PAIRLIST(PARENT(J5),J2).EQ.J5) THEN263:       IF (PAIRLIST(PARENT(J5),J2).EQ.J5) THEN
322:          DUMMY=PAIRDIST(PARENT(J5),J2)*SCALEFAC264:          DUMMY=PAIRDIST(PARENT(J5),J2)*SCALEFAC
423:       PRINT '(A)','Dijinit> No missing connection is above the required distance cut off.'365:       PRINT '(A)','Dijinit> No missing connection is above the required distance cut off.'
424:       PRINT '(A)','Dijinit> Set MINGAP to false and redo analysis'366:       PRINT '(A)','Dijinit> Set MINGAP to false and redo analysis'
425:       MINGAPT=.FALSE.367:       MINGAPT=.FALSE.
426:       DEALLOCATE(LOCATIONSTART,LOCATIONEND)368:       DEALLOCATE(LOCATIONSTART,LOCATIONEND)
427:       GOTO 121369:       GOTO 121
428:    ENDIF370:    ENDIF
429: ENDIF371: ENDIF
430: IF (DIJPRUNET) THEN !write the best path out to min.retain and then terminate372: IF (DIJPRUNET) THEN !write the best path out to min.retain and then terminate
431:    PATHMINS(NSTEPS+1)=J5373:    PATHMINS(NSTEPS+1)=J5
432:    WRITE(MUNIT,'(I8)') NSTEPS+1374:    WRITE(MUNIT,'(I8)') NSTEPS+1
433:    DO J7=1,NSTEPS+1375:    DO J6=1,NSTEPS+1
434:       WRITE(MUNIT,'(I8)') PATHMINS(J7)376:       WRITE(MUNIT,'(I8)') PATHMINS(J6)
435:    ENDDO377:    ENDDO
436:    CLOSE(MUNIT)378:    CLOSE(MUNIT)
437:    PRINT '(A)','Dijprune> Best path written to min.retain'379:    PRINT '(A)','Dijprune> Best path written to min.retain'
438:    DEALLOCATE(PATHMINS)380:    DEALLOCATE(PATHMINS)
439:    STOP381:    STOP
440: ENDIF382: ENDIF
441: IF (NWORST.EQ.0) THEN383: IF (NWORST.EQ.0) THEN
442:    PRINT '(A)','Dijinit> Connected path found'384:    PRINT '(A)','Dijinit> Connected path found'
443: !  IF (DIJCONT) THEN385: !  IF (DIJCONT) THEN
444: !     DIJINITT=.FALSE.386: !     DIJINITT=.FALSE.


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0