hdiff output

r30529/disconnectionDPS.f90 2017-01-21 10:41:44.523982898 +0000 r30528/disconnectionDPS.f90 2017-01-21 10:41:44.767992529 +0000
379:       OPEN (UNIT=22, FILE=TRIM(FILE_TRACE), STATUS='OLD', IOSTAT=ERR)379:       OPEN (UNIT=22, FILE=TRIM(FILE_TRACE), STATUS='OLD', IOSTAT=ERR)
380:       IF (ERR /= 0) THEN380:       IF (ERR /= 0) THEN
381:       WRITE (6, '(/,2A,/)') 'ERROR: Could not open ', TRIM(file_trace)381:       WRITE (6, '(/,2A,/)') 'ERROR: Could not open ', TRIM(file_trace)
382:       STOP382:       STOP
383:       END IF383:       END IF
384:       DO I=1, N_TRACE384:       DO I=1, N_TRACE
385:       READ (22, *) NUMOFMIN385:       READ (22, *) NUMOFMIN
386:       VALUES(NUMOFMIN)=VALUE386:       VALUES(NUMOFMIN)=VALUE
387:       END DO387:       END DO
388:       CLOSE (22)388:       CLOSE (22)
389:       WRITE (6, '(A,I2,A,I8, 3A)')'Colour ',value, ': ', n_trace, ' minima read in from ', TRIM(file_trace), '.'389:       WRITE (6, '(A,I2,A,I6, 3A)')'Colour ',value, ': ', n_trace, ' minima read in from ', TRIM(file_trace), '.'
390:   390:   
391:    END SUBROUTINE READ_TRFILE391:    END SUBROUTINE READ_TRFILE
392: !!392: !!
393: ! READ_PAIRFILE(CH(120) FILE_PAIRS, INT VALUE, INT(:,:,:) :: VALUES)393: ! READ_PAIRFILE(CH(120) FILE_PAIRS, INT VALUE, INT(:,:,:) :: VALUES)
394:    SUBROUTINE READ_PAIRFILE(FILE_PAIRS, VALUE, VALUES)394:    SUBROUTINE READ_PAIRFILE(FILE_PAIRS, VALUE, VALUES)
395:       IMPLICIT NONE395:       IMPLICIT NONE
396:       INTEGER :: VALUES(:,:,:)396:       INTEGER :: VALUES(:,:,:)
397:       INTEGER :: ERR, I, N_PAIRS, VALUE397:       INTEGER :: ERR, I, N_PAIRS, VALUE
398:       CHARACTER(LEN=120) :: FILE_PAIRS 398:       CHARACTER(LEN=120) :: FILE_PAIRS 
399:       399:       
697:    DO I=1, N_MIN697:    DO I=1, N_MIN
698: !     READ (20, *) j, m(i)698: !     READ (20, *) j, m(i)
699: !  Standard PATHSAMPLE.2.0 format699: !  Standard PATHSAMPLE.2.0 format
700:       READ (20, *) M(I)700:       READ (20, *) M(I)
701:       IF (M(I) < E_GMIN) THEN701:       IF (M(I) < E_GMIN) THEN
702:          E_GMIN = M(I)702:          E_GMIN = M(I)
703:          GMIN = I703:          GMIN = I
704:       END IF704:       END IF
705:    END DO705:    END DO
706:    CLOSE (20)706:    CLOSE (20)
707:    WRITE (6, '(I8, 3A)') n_min, ' minima read in from ', TRIM(file_min), '.'707:    WRITE (6, '(I6, 3A)') n_min, ' minima read in from ', TRIM(file_min), '.'
708:    WRITE (6, '(A,I10,F18.10,A)') ' Global minimum at index, energy ',GMIN,E_GMIN,'.'708:    WRITE (6, '(A,I10,F18.10,A)') ' Global minimum at index, energy ',GMIN,E_GMIN,'.'
709:    IF ((LOWEST <= 0).OR.(LOWEST > N_MIN)) LOWEST = N_MIN709:    IF ((LOWEST <= 0).OR.(LOWEST > N_MIN)) LOWEST = N_MIN
710: 710: 
711: 711: 
712: !  Procure transition state info.712: !  Procure transition state info.
713:    CALL COUNT_TS(FILE_TS, N_TS, B_HIGH, B_LOW)713:    CALL COUNT_TS(FILE_TS, N_TS, B_HIGH, B_LOW)
714:    ALLOCATE (TS(N_TS),DEADTS(N_TS))714:    ALLOCATE (TS(N_TS),DEADTS(N_TS))
715:    I = 1715:    I = 1
716:    OPEN (UNIT=20, FILE=TRIM(FILE_TS), STATUS='OLD', IOSTAT=err)716:    OPEN (UNIT=20, FILE=TRIM(FILE_TS), STATUS='OLD', IOSTAT=err)
717:    IF (ERR /= 0) THEN717:    IF (ERR /= 0) THEN
729: !  Set global minimum energy to 0.729: !  Set global minimum energy to 0.
730:    IF (ZEROGM) THEN730:    IF (ZEROGM) THEN
731:       DO I=1,N_MIN731:       DO I=1,N_MIN
732:          M(I)=M(I)-E_GMIN732:          M(I)=M(I)-E_GMIN
733:       ENDDO733:       ENDDO
734:       DO I=1,N_TS734:       DO I=1,N_TS
735:          TS(I)%E=TS(I)%E-E_GMIN735:          TS(I)%E=TS(I)%E-E_GMIN
736:       ENDDO736:       ENDDO
737:    ENDIF737:    ENDIF
738: 738: 
739:    WRITE (6, '(I8, 3A)') &739:    WRITE (6, '(I6, 3A)') &
740:       & N_TS, ' non-degenerate paths read in from ', TRIM(file_ts), '.'740:       & N_TS, ' non-degenerate paths read in from ', TRIM(file_ts), '.'
741:    WRITE (6, '(A, 2(F18.10))') 'Highest and lowest transition states: ', &741:    WRITE (6, '(A, 2(F18.10))') 'Highest and lowest transition states: ', &
742:       & B_HIGH, B_LOW742:       & B_HIGH, B_LOW
743: 743: 
744:    PRINT *,'n_min,n_ts=',n_min,n_ts744:    PRINT *,'n_min,n_ts=',n_min,n_ts
745:    ALLOCATE (NCONN(N_MIN),PLUS(N_TS),MINUS(N_TS),NDISTA(N_MIN),TSEN(N_TS))745:    ALLOCATE (NCONN(N_MIN),PLUS(N_TS),MINUS(N_TS),NDISTA(N_MIN),TSEN(N_TS))
746:    DO I=1,N_TS746:    DO I=1,N_TS
747:       IF (TS(I)%E.LE.M(TS(I)%MIN1)) THEN747:       IF (TS(I)%E.LE.M(TS(I)%MIN1)) THEN
748:          PRINT '(A,G20.10,A)','WARNING *** energy of ts (= ',TS(I)%E,') is lower than min1:'748:          PRINT '(A,G20.10,A)','WARNING *** energy of ts (= ',TS(I)%E,') is lower than min1:'
749:          IF (TS(I)%E-M(TS(I)%MIN1).GE.TSLOWBARTHRESH) THEN749:          IF (TS(I)%E-M(TS(I)%MIN1).GE.TSLOWBARTHRESH) THEN
1022: 1022: 
1023:       PRINT *,'ENERGY=',ENERGY+SPLIT_OPTION1023:       PRINT *,'ENERGY=',ENERGY+SPLIT_OPTION
1024:       PRINT *,'NBASIN+1,BASIN_NO=',NBASIN+1,BASIN_NO1024:       PRINT *,'NBASIN+1,BASIN_NO=',NBASIN+1,BASIN_NO
1025:       DO J=1,N_MIN1025:       DO J=1,N_MIN
1026:          PRINT '(A,3I8)','minimum, old, new basins: ',J,BASIN(I,J),DJWBASIN(J)1026:          PRINT '(A,3I8)','minimum, old, new basins: ',J,BASIN(I,J),DJWBASIN(J)
1027:       ENDDO1027:       ENDDO
1028: 1028: 
1029: 666   CONTINUE1029: 666   CONTINUE
1030: 1030: 
1031:      IF (NODES(I) == 1) THEN1031:      IF (NODES(I) == 1) THEN
1032:         WRITE (6, '(I8, A, F18.10)') 1, ' basin  at energy ', energy1032:         WRITE (6, '(I6, A, F18.10)') 1, ' basin  at energy ', energy
1033:      ELSE1033:      ELSE
1034:         WRITE (6, '(I8, A, F18.10)') nodes(i), ' basins at energy ', energy1034:         WRITE (6, '(I6, A, F18.10)') nodes(i), ' basins at energy ', energy
1035:      ENDIF1035:      ENDIF
1036:    END DO1036:    END DO
1037:    WRITE (6, '(A, /)') 'Done.'1037:    WRITE (6, '(A, /)') 'Done.'
1038: !1038: !
1039: !  Read weights and add them up to correspond to the energies used in the superbasin 1039: !  Read weights and add them up to correspond to the energies used in the superbasin 
1040: !  analysis.1040: !  analysis.
1041: !1041: !
1042:    IF (WEIGHTS) THEN1042:    IF (WEIGHTS) THEN
1043:       OPEN (1,FILE=TRIM(ADJUSTL(FILE_WEIGHTS)),STATUS='OLD')1043:       OPEN (1,FILE=TRIM(ADJUSTL(FILE_WEIGHTS)),STATUS='OLD')
1044:       ALLOCATE(LEVELWEIGHTS(N_LEVELS))1044:       ALLOCATE(LEVELWEIGHTS(N_LEVELS))
1105:    IF (FILE_PICK /= '') THEN1105:    IF (FILE_PICK /= '') THEN
1106:       OPEN (UNIT=20, FILE=TRIM(FILE_PICK), STATUS='OLD', IOSTAT=err)1106:       OPEN (UNIT=20, FILE=TRIM(FILE_PICK), STATUS='OLD', IOSTAT=err)
1107:       IF (ERR /= 0) THEN1107:       IF (ERR /= 0) THEN
1108:          WRITE (6, '(/,2A,/)') 'ERROR: Could not open ', TRIM(file_pick)1108:          WRITE (6, '(/,2A,/)') 'ERROR: Could not open ', TRIM(file_pick)
1109:          STOP1109:          STOP
1110:       END IF1110:       END IF
1111:       DO1111:       DO
1112:          READ (UNIT=20, FMT=*, IOSTAT=ERR) I1112:          READ (UNIT=20, FMT=*, IOSTAT=ERR) I
1113:          IF (ERR /= 0) EXIT1113:          IF (ERR /= 0) EXIT
1114:          IF (ABS(I)==0 .OR. ABS(I)>N_MIN) THEN1114:          IF (ABS(I)==0 .OR. ABS(I)>N_MIN) THEN
1115:             WRITE (6, '(A,I8,3A,I8)') 'WARNING: Ignoring ', i, ' in ', &1115:             WRITE (6, '(A,I8,3A,I6)') 'WARNING: Ignoring ', i, ' in ', &
1116:                TRIM(FILE_PICK), '; minima numbers: 1 to', n_min1116:                TRIM(FILE_PICK), '; minima numbers: 1 to', n_min
1117:          ELSE1117:          ELSE
1118:             IF (I < 0) THEN1118:             IF (I < 0) THEN
1119:                DO J = 1, N_LEVELS1119:                DO J = 1, N_LEVELS
1120:                   BASIN(J, -I) = -ABS(BASIN(J, -I))1120:                   BASIN(J, -I) = -ABS(BASIN(J, -I))
1121:                END DO1121:                END DO
1122:             ELSE1122:             ELSE
1123:                DO J = 1, N_LEVELS1123:                DO J = 1, N_LEVELS
1124:                   BASIN(J, I) = ABS(BASIN(J, I))1124:                   BASIN(J, I) = ABS(BASIN(J, I))
1125:                END DO1125:                END DO
1148:          IF (P > 0) THEN1148:          IF (P > 0) THEN
1149:             IF (INDX1(P) == 0) THEN1149:             IF (INDX1(P) == 0) THEN
1150:                K = K + 11150:                K = K + 1
1151:                INDX1(P) = K1151:                INDX1(P) = K
1152:             END IF1152:             END IF
1153:          ELSE1153:          ELSE
1154:             BASIN(I, J) = 01154:             BASIN(I, J) = 0
1155:          END IF1155:          END IF
1156:       END DO1156:       END DO
1157:       NODES(I) = K1157:       NODES(I) = K
1158:       WRITE (6, '(A, I3, A, I8)') 'Nodes remaining at level ', i, ': ', k1158:       WRITE (6, '(A, I3, A, I6)') 'Nodes remaining at level ', i, ': ', k
1159:       DO J = 1, N_MIN1159:       DO J = 1, N_MIN
1160:          IF (NCONN(J).LE.NCONNMIN) CYCLE1160:          IF (NCONN(J).LE.NCONNMIN) CYCLE
1161:          BASIN(I, J) = INDX1(BASIN(I, J))1161:          BASIN(I, J) = INDX1(BASIN(I, J))
1162:       END DO1162:       END DO
1163:    END DO1163:    END DO
1164:    DEALLOCATE (INDX1)1164:    DEALLOCATE (INDX1)
1165: 1165: 
1166:    WRITE (6, '(A, /)') 'Done.'1166:    WRITE (6, '(A, /)') 'Done.'
1167: 1167: 
1168: 1168: 
1332: !  Dump the minima numbers at each node if required.1332: !  Dump the minima numbers at each node if required.
1333: !  This double loop for each level is probably not the most efficient way, but...1333: !  This double loop for each level is probably not the most efficient way, but...
1334: 1334: 
1335:    IF (DUMP_NUMBERS) THEN1335:    IF (DUMP_NUMBERS) THEN
1336:       WRITE (6, '(A)') &1336:       WRITE (6, '(A)') &
1337:       'Writing minima numbers associated with nodes to "node_numbers".'1337:       'Writing minima numbers associated with nodes to "node_numbers".'
1338:       OPEN (UNIT=20, FILE='node_numbers', STATUS='REPLACE')1338:       OPEN (UNIT=20, FILE='node_numbers', STATUS='REPLACE')
1339:       DO I = 1, N_LEVELS1339:       DO I = 1, N_LEVELS
1340:          WRITE (20, '(/, A, I3, /, A)') 'LEVEL ', i, '========='1340:          WRITE (20, '(/, A, I3, /, A)') 'LEVEL ', i, '========='
1341:          DO J = 1, NODES(I)1341:          DO J = 1, NODES(I)
1342:             WRITE (20, '(/, A, I8)') 'Node ', j1342:             WRITE (20, '(/, A, I6)') 'Node ', j
1343:             K = ORDER(I, J)1343:             K = ORDER(I, J)
1344:             DO P = 1, N_MIN1344:             DO P = 1, N_MIN
1345:                IF (NCONN(P).LE.NCONNMIN) CYCLE1345:                IF (NCONN(P).LE.NCONNMIN) CYCLE
1346:                IF (BASIN(I, P) == K) WRITE (20, '(I8)') p1346:                IF (BASIN(I, P) == K) WRITE (20, '(I6)') p
1347:             END DO1347:             END DO
1348:          END DO1348:          END DO
1349:       END DO1349:       END DO
1350:       CLOSE (20)1350:       CLOSE (20)
1351:       WRITE (6, '(A, /)') 'Done.'1351:       WRITE (6, '(A, /)') 'Done.'
1352:    END IF1352:    END IF
1353: 1353: 
1354: ! Colour minima in sections if required.1354: ! Colour minima in sections if required.
1355: ! For each node, check all minima for which the node is a parent.1355: ! For each node, check all minima for which the node is a parent.
1356: ! If all minima are contained on one of the lists, the node 1356: ! If all minima are contained on one of the lists, the node 
1378:                  K=BASIN(I,P)1378:                  K=BASIN(I,P)
1379:                  IF (K.EQ.0) CYCLE1379:                  IF (K.EQ.0) CYCLE
1380:                  IF (MARKNODE(I,K)==0) CYCLE1380:                  IF (MARKNODE(I,K)==0) CYCLE
1381:                  IF (MINTRS(P)==0.or.MINTRS(P)> MARKNODE(I,K)) MARKNODE(I,K)=MINTRS(P)1381:                  IF (MINTRS(P)==0.or.MINTRS(P)> MARKNODE(I,K)) MARKNODE(I,K)=MINTRS(P)
1382: ! If any minimum is not listed at all the node is not coloured1382: ! If any minimum is not listed at all the node is not coloured
1383:             END DO 1383:             END DO 
1384:     IF (TRPRINT) THEN1384:     IF (TRPRINT) THEN
1385:          WRITE (20, '(/, A, I3, /, A)') 'LEVEL ', i, '========='1385:          WRITE (20, '(/, A, I3, /, A)') 'LEVEL ', i, '========='
1386:            DO J = 1, NODES(I)1386:            DO J = 1, NODES(I)
1387:             K=ORDER(I,J) 1387:             K=ORDER(I,J) 
1388:               IF (MARKNODE(I,K)/=0) WRITE (20, '(A, I8, A, I8)') 'Node ', j, ' --> Colour ', MARKNODE(I,K)1388:               IF (MARKNODE(I,K)/=0) WRITE (20, '(A, I6, A, I6)') 'Node ', j, ' --> Colour ', MARKNODE(I,K)
1389:            ENDDO 1389:            ENDDO 
1390:     ENDIF1390:     ENDIF
1391: !         END DO1391: !         END DO
1392:        END DO   1392:        END DO   
1393:    IF (TRPRINT) THEN1393:    IF (TRPRINT) THEN
1394:    CLOSE(20)1394:    CLOSE(20)
1395:    ENDIF 1395:    ENDIF 
1396:    WRITE (6, '(A, /)') 'Done.'1396:    WRITE (6, '(A, /)') 'Done.'
1397:    END IF1397:    END IF
1398: 1398: 
1453: ! Check this first and find the maximum integer for mapping1453: ! Check this first and find the maximum integer for mapping
1454:               RMAX=R 1454:               RMAX=R 
1455:               DO1455:               DO
1456: !               PRINT*, 'Rmax, map(Rmax)= ', RMAX, MAP(RMAX) 1456: !               PRINT*, 'Rmax, map(Rmax)= ', RMAX, MAP(RMAX) 
1457:                 IF (MAP(RMAX).EQ.RMAX) THEN1457:                 IF (MAP(RMAX).EQ.RMAX) THEN
1458:                  EXIT1458:                  EXIT
1459:                 ENDIF1459:                 ENDIF
1460:                 RMAX=MAP(RMAX) 1460:                 RMAX=MAP(RMAX) 
1461:               ENDDO   1461:               ENDDO   
1462:               IF (K1.EQ.K2) THEN1462:               IF (K1.EQ.K2) THEN
1463:      WRITE (20, '(A, I8, A, I8, A, I8, A, I8)')'Nodes ', MINPAIRS(R,Q,2), ' and ' , MINPAIRS(R,Q,1), ' BASIN ', K2, ' joins Colour ', r1463:      WRITE (20, '(A, I6, A, I6, A, I6, A, I6)')'Nodes ', MINPAIRS(R,Q,2), ' and ' , MINPAIRS(R,Q,1), ' BASIN ', K2, ' joins Colour ', r
1464: ! Also need to stop colouring this pair.1464: ! Also need to stop colouring this pair.
1465:                 JOINED(R,Q)=R1465:                 JOINED(R,Q)=R
1466:                 CYCLE1466:                 CYCLE
1467:               ENDIF1467:               ENDIF
1468:               IF ((MARKNODE(I2,K2).NE.0).AND.(MARKNODE(I2,K2).NE.R)) THEN1468:               IF ((MARKNODE(I2,K2).NE.0).AND.(MARKNODE(I2,K2).NE.R)) THEN
1469:                NCHAIN=MARKNODE(I2,K2)1469:                NCHAIN=MARKNODE(I2,K2)
1470:                IF (MARKNODE(I2,K2).GT.R) PRINT*, 'Error- marknode'1470:                IF (MARKNODE(I2,K2).GT.R) PRINT*, 'Error- marknode'
1471: ! Now check mapping for previous value of marknode1471: ! Now check mapping for previous value of marknode
1472:                DO1472:                DO
1473: !                PRINT*, 'nchain, map(nchain)= ', NCHAIN, MAP(NCHAIN) 1473: !                PRINT*, 'nchain, map(nchain)= ', NCHAIN, MAP(NCHAIN) 
1480:                IF(NCHAIN.GT.RMAX) THEN1480:                IF(NCHAIN.GT.RMAX) THEN
1481:                 MAP(RMAX)=NCHAIN1481:                 MAP(RMAX)=NCHAIN
1482:                 RMAX=NCHAIN 1482:                 RMAX=NCHAIN 
1483:                ELSE   1483:                ELSE   
1484:                 MAP(NCHAIN)=RMAX1484:                 MAP(NCHAIN)=RMAX
1485:                ENDIF1485:                ENDIF
1486:                MARKNODE(I2,K2)=R1486:                MARKNODE(I2,K2)=R
1487:               ELSE 1487:               ELSE 
1488:                MARKNODE(I2,K2)=R1488:                MARKNODE(I2,K2)=R
1489:               ENDIF 1489:               ENDIF 
1490:               WRITE (20, '(A, I8, A, I8, A, I8)')'Node ', MINPAIRS(R,Q,2), ' BASIN ', K2, ' --> Colour ', r1490:               WRITE (20, '(A, I6, A, I6, A, I6)')'Node ', MINPAIRS(R,Q,2), ' BASIN ', K2, ' --> Colour ', r
1491:               ENDIF 1491:               ENDIF 
1492:               IF (K1.NE.0) THEN1492:               IF (K1.NE.0) THEN
1493: ! R may already map to another integer.1493: ! R may already map to another integer.
1494: ! Check this first and find the maximum integer for mapping1494: ! Check this first and find the maximum integer for mapping
1495:               RMAX=R 1495:               RMAX=R 
1496:               DO1496:               DO
1497: !               PRINT*, 'Rmax, map(Rmax)= ', RMAX, MAP(RMAX) 1497: !               PRINT*, 'Rmax, map(Rmax)= ', RMAX, MAP(RMAX) 
1498:                 IF (MAP(RMAX).EQ.RMAX) THEN1498:                 IF (MAP(RMAX).EQ.RMAX) THEN
1499:                  EXIT1499:                  EXIT
1500:                 ENDIF1500:                 ENDIF
1514: !                 PRINT*, 'K1 Basin:',  K1, ' R= ',R, ' Nchain= ', NCHAIN, 'RMAX= ', RMAX 1514: !                 PRINT*, 'K1 Basin:',  K1, ' R= ',R, ' Nchain= ', NCHAIN, 'RMAX= ', RMAX 
1515:                IF(NCHAIN.GT.RMAX) THEN1515:                IF(NCHAIN.GT.RMAX) THEN
1516:                 MAP(RMAX)=NCHAIN1516:                 MAP(RMAX)=NCHAIN
1517:                ELSE   1517:                ELSE   
1518:                 MAP(NCHAIN)=RMAX1518:                 MAP(NCHAIN)=RMAX
1519:                ENDIF1519:                ENDIF
1520:                 MARKNODE(I2,K1)=R1520:                 MARKNODE(I2,K1)=R
1521:               ELSE 1521:               ELSE 
1522:                 MARKNODE(I2,K1)=R1522:                 MARKNODE(I2,K1)=R
1523:               ENDIF 1523:               ENDIF 
1524:               WRITE (20, '(A, I8, A, I8, A, I8)')'Node ', MINPAIRS(R,Q,1), ' BASIN ', K1, ' --> Colour ', r 1524:               WRITE (20, '(A, I6, A, I6, A, I6)')'Node ', MINPAIRS(R,Q,1), ' BASIN ', K1, ' --> Colour ', r 
1525:               ENDIF1525:               ENDIF
1526:           ENDDO1526:           ENDDO
1527:        ENDDO1527:        ENDDO
1528:        DO R=1,NMINTR1528:        DO R=1,NMINTR
1529:          NCHAIN=R1529:          NCHAIN=R
1530:          DO  1530:          DO  
1531:            IF (MAP(NCHAIN).EQ.NCHAIN) THEN1531:            IF (MAP(NCHAIN).EQ.NCHAIN) THEN
1532:              MAP(R)=NCHAIN1532:              MAP(R)=NCHAIN
1533:              EXIT1533:              EXIT
1534:            ENDIF 1534:            ENDIF 
1661:       DO J = 1, NODES(I)1661:       DO J = 1, NODES(I)
1662:          K = ORDER(I, J)1662:          K = ORDER(I, J)
1663:          X1 = (COL_0(I-1, PARENT(I,K)) + NODE_SIZE(I-1, PARENT(I,K))/2.0 - 1.0) / N_COLS1663:          X1 = (COL_0(I-1, PARENT(I,K)) + NODE_SIZE(I-1, PARENT(I,K))/2.0 - 1.0) / N_COLS
1664:          X2 = (COL_0(I, K) + NODE_SIZE(I, K)/2.0 - 1.0) / N_COLS1664:          X2 = (COL_0(I, K) + NODE_SIZE(I, K)/2.0 - 1.0) / N_COLS
1665:          IF (WEIGHTS) THEN1665:          IF (WEIGHTS) THEN
1666:             X1 = (X1-CENTRESPAN(I-1)) * (LEVELWEIGHTS(I-1)/LEVELWEIGHTS(1)) &1666:             X1 = (X1-CENTRESPAN(I-1)) * (LEVELWEIGHTS(I-1)/LEVELWEIGHTS(1)) &
1667:                * (1.0D0*COLSPAN(1)/COLSPAN(I-1)) + 0.51667:                * (1.0D0*COLSPAN(1)/COLSPAN(I-1)) + 0.5
1668:             X2 = (X2-CENTRESPAN(I)) * (LEVELWEIGHTS(I)/LEVELWEIGHTS(1)) &1668:             X2 = (X2-CENTRESPAN(I)) * (LEVELWEIGHTS(I)/LEVELWEIGHTS(1)) &
1669:                * (1.0D0*COLSPAN(1)/COLSPAN(I)) + 0.51669:                * (1.0D0*COLSPAN(1)/COLSPAN(I)) + 0.5
1670:          ENDIF1670:          ENDIF
1671: !        PRINT '(A,2I8,4F15.5)','i,j,x1,x2,x_pos1,x_pos2: ',i,j,x1,x2,x_pos(x1),x_pos(x2)1671: !        PRINT '(A,2I6,4F15.5)','i,j,x1,x2,x_pos1,x_pos2: ',i,j,x1,x2,x_pos(x1),x_pos(x2)
1672:          X1 = X_POS(X1)1672:          X1 = X_POS(X1)
1673:          X2 = X_POS(X2)1673:          X2 = X_POS(X2)
1674: 1674: 
1675: !        IF ( BRANCHES(I,K) > 1) THEN1675: !        IF ( BRANCHES(I,K) > 1) THEN
1676:          IF ( ALLOCATED(BRANCH_XY) ) THEN1676:          IF ( ALLOCATED(BRANCH_XY) ) THEN
1677:             PRINT '(A,2I8)','I,K=',I,K1677:             PRINT '(A,2I8)','I,K=',I,K
1678:             PRINT '(A,G20.10)','branch',BRANCH_XY(I,K,1)1678:             PRINT '(A,G20.10)','branch',BRANCH_XY(I,K,1)
1679:             BRANCH_XY(I,K,1) = X11679:             BRANCH_XY(I,K,1) = X1
1680:             BRANCH_XY(I,K,2) = Y11680:             BRANCH_XY(I,K,2) = Y1
1681:             BRANCH_XY(I,K,3) = X21681:             BRANCH_XY(I,K,3) = X2
1944:         DO J = 1, NODES(I)1944:         DO J = 1, NODES(I)
1945:            K = ORDER(I, J)1945:            K = ORDER(I, J)
1946:            X1 = (COL_0(I-1, PARENT(I,K)) + NODE_SIZE(I-1, PARENT(I,K))/2.0 - 1.0) / N_COLS1946:            X1 = (COL_0(I-1, PARENT(I,K)) + NODE_SIZE(I-1, PARENT(I,K))/2.0 - 1.0) / N_COLS
1947:            X2 = (COL_0(I, K) + NODE_SIZE(I, K)/2.0 - 1.0) / N_COLS1947:            X2 = (COL_0(I, K) + NODE_SIZE(I, K)/2.0 - 1.0) / N_COLS
1948:            IF (WEIGHTS) THEN1948:            IF (WEIGHTS) THEN
1949:               X1 = (X1-CENTRESPAN(I-1)) * (LEVELWEIGHTS(I-1)/LEVELWEIGHTS(1)) &1949:               X1 = (X1-CENTRESPAN(I-1)) * (LEVELWEIGHTS(I-1)/LEVELWEIGHTS(1)) &
1950:                  * (1.0D0*COLSPAN(1)/COLSPAN(I-1)) + 0.51950:                  * (1.0D0*COLSPAN(1)/COLSPAN(I-1)) + 0.5
1951:               X2 = (X2-CENTRESPAN(I)) * (LEVELWEIGHTS(I)/LEVELWEIGHTS(1)) &1951:               X2 = (X2-CENTRESPAN(I)) * (LEVELWEIGHTS(I)/LEVELWEIGHTS(1)) &
1952:                  * (1.0D0*COLSPAN(1)/COLSPAN(I)) + 0.51952:                  * (1.0D0*COLSPAN(1)/COLSPAN(I)) + 0.5
1953:            ENDIF1953:            ENDIF
1954: !          PRINT '(A,2I8,4F15.5)','i,j,x1,x2,x_pos1,x_pos2: ',i,j,x1,x2,x_pos(x1),x_pos(x2)1954: !          PRINT '(A,2I6,4F15.5)','i,j,x1,x2,x_pos1,x_pos2: ',i,j,x1,x2,x_pos(x1),x_pos(x2)
1955:            X1 = X_POS(X1)1955:            X1 = X_POS(X1)
1956:            X2 = X_POS(X2)1956:            X2 = X_POS(X2)
1957: 1957: 
1958: !          IF ( BRANCHES(I,K) > 1) THEN1958: !          IF ( BRANCHES(I,K) > 1) THEN
1959:            IF ( ALLOCATED(BRANCH_XY) ) THEN1959:            IF ( ALLOCATED(BRANCH_XY) ) THEN
1960:               PRINT '(A,2I8)','I,K=',I,K1960:               PRINT '(A,2I8)','I,K=',I,K
1961:               PRINT '(A,G20.10)','branch',BRANCH_XY(I,K,1)1961:               PRINT '(A,G20.10)','branch',BRANCH_XY(I,K,1)
1962:               BRANCH_XY(I,K,1) = X11962:               BRANCH_XY(I,K,1) = X1
1963:               BRANCH_XY(I,K,2) = Y11963:               BRANCH_XY(I,K,2) = Y1
1964:               BRANCH_XY(I,K,3) = X21964:               BRANCH_XY(I,K,3) = X2
2397:       CASE ('NOBARRIERS')2397:       CASE ('NOBARRIERS')
2398:          BARRIERS = .FALSE.2398:          BARRIERS = .FALSE.
2399:       CASE ('NOSPLIT')2399:       CASE ('NOSPLIT')
2400:          SPLIT = .FALSE.2400:          SPLIT = .FALSE.
2401:       CASE ('PAIRS') 2401:       CASE ('PAIRS') 
2402:          PAIRST = .TRUE.2402:          PAIRST = .TRUE.
2403:          CALL GET_INTEGER(NDUMMY)2403:          CALL GET_INTEGER(NDUMMY)
2404:          CALL GET_INTEGER(MINRANGE)2404:          CALL GET_INTEGER(MINRANGE)
2405:          IF (NDUMMY.GT.0) THEN 2405:          IF (NDUMMY.GT.0) THEN 
2406:            IF (NDUMMY.eq.1) THEN2406:            IF (NDUMMY.eq.1) THEN
2407:              WRITE (6, '(I8, A)') ndummy, ' set of pairs of minima will be traced in colour'2407:              WRITE (6, '(I6, A)') ndummy, ' set of pairs of minima will be traced in colour'
2408:            ELSE2408:            ELSE
2409:              WRITE (6, '(I8, A)') ndummy, ' sets of pairs of minima will be traced in colour'2409:              WRITE (6, '(I6, A)') ndummy, ' sets of pairs of minima will be traced in colour'
2410:            ENDIF2410:            ENDIF
2411:            ALLOCATE(MINPAIRS(1:NDUMMY, 1:MINRANGE, 1:2))2411:            ALLOCATE(MINPAIRS(1:NDUMMY, 1:MINRANGE, 1:2))
2412:            MINPAIRS=02412:            MINPAIRS=0
2413:            DO I4=1, NDUMMY 2413:            DO I4=1, NDUMMY 
2414:              CALL GET_STRING(FILE_PAIRS)2414:              CALL GET_STRING(FILE_PAIRS)
2415:              CALL READ_PAIRFILE(FILE_PAIRS, I4, MINPAIRS)  2415:              CALL READ_PAIRFILE(FILE_PAIRS, I4, MINPAIRS)  
2416:            ENDDO2416:            ENDDO
2417:            NMINTR=NDUMMY 2417:            NMINTR=NDUMMY 
2418:          ELSE2418:          ELSE
2419:              WRITE (6, '(A, I8, A)') ' Up to, ',MINRANGE, ' sets of pairs of minima will be traced in colour'2419:              WRITE (6, '(A, I6, A)') ' Up to, ',MINRANGE, ' sets of pairs of minima will be traced in colour'
2420:              ALLOCATE(MINPAIRS(1:MINRANGE, 1, 1:2))2420:              ALLOCATE(MINPAIRS(1:MINRANGE, 1, 1:2))
2421:              MINPAIRS=02421:              MINPAIRS=0
2422:              CALL GET_STRING(FILE_PAIRS)2422:              CALL GET_STRING(FILE_PAIRS)
2423:              CALL READ_PAIRFILE(FILE_PAIRS, NDUMMY, MINPAIRS)  2423:              CALL READ_PAIRFILE(FILE_PAIRS, NDUMMY, MINPAIRS)  
2424:            NMINTR=MINRANGE 2424:            NMINTR=MINRANGE 
2425:            MINRANGE=12425:            MINRANGE=1
2426:          ENDIF 2426:          ENDIF 
2427:       CASE ('PAIRSONLY') 2427:       CASE ('PAIRSONLY') 
2428:          PAIRSF = .FALSE.2428:          PAIRSF = .FALSE.
2429:       CASE ('PAIRSSWITCH') 2429:       CASE ('PAIRSSWITCH') 
2439:       CASE ('ORDER_BY_SIZE')2439:       CASE ('ORDER_BY_SIZE')
2440:          ORDER_BY_SIZE = .TRUE.2440:          ORDER_BY_SIZE = .TRUE.
2441:       CASE ('SCALEBAR')2441:       CASE ('SCALEBAR')
2442:          SCALEBAR = .TRUE.2442:          SCALEBAR = .TRUE.
2443:          CALL GET_INTEGER(NDELTASB)2443:          CALL GET_INTEGER(NDELTASB)
2444:       CASE ('TRMIN')2444:       CASE ('TRMIN')
2445:          TRMINT = .TRUE.2445:          TRMINT = .TRUE.
2446:          CALL GET_INTEGER(NDUMMY)2446:          CALL GET_INTEGER(NDUMMY)
2447:          CALL GET_INTEGER(MINRANGE)2447:          CALL GET_INTEGER(MINRANGE)
2448:          IF (NDUMMY.eq.1) THEN2448:          IF (NDUMMY.eq.1) THEN
2449:          WRITE (6, '(I8, A)') ndummy, ' set of minima will be traced in colour'2449:          WRITE (6, '(I6, A)') ndummy, ' set of minima will be traced in colour'
2450:          ELSE2450:          ELSE
2451:          WRITE (6, '(I8, A)') ndummy, ' sets of minima will be traced in colour'2451:          WRITE (6, '(I6, A)') ndummy, ' sets of minima will be traced in colour'
2452:          ENDIF2452:          ENDIF
2453:          ALLOCATE(MINTRS(1:MINRANGE))2453:          ALLOCATE(MINTRS(1:MINRANGE))
2454:          MINTRS=02454:          MINTRS=0
2455:          DO I4=1, NDUMMY 2455:          DO I4=1, NDUMMY 
2456:          CALL GET_STRING(FILE_TRACE)2456:          CALL GET_STRING(FILE_TRACE)
2457:          CALL READ_TRFILE(FILE_TRACE, I4, MINTRS)  2457:          CALL READ_TRFILE(FILE_TRACE, I4, MINTRS)  
2458:          ENDDO2458:          ENDDO
2459:          NMINTR=NDUMMY 2459:          NMINTR=NDUMMY 
2460:       CASE ('TRVAL')2460:       CASE ('TRVAL')
2461:          TRVALT = .TRUE.2461:          TRVALT = .TRUE.
2978:          CONNECTED(J1)=.FALSE.2978:          CONNECTED(J1)=.FALSE.
2979:          IF (NCONN(J1).GT.NCONNMIN) THEN2979:          IF (NCONN(J1).GT.NCONNMIN) THEN
2980:             CONNECTED(J1)=.TRUE.2980:             CONNECTED(J1)=.TRUE.
2981:             NCONNECTED=NCONNECTED+12981:             NCONNECTED=NCONNECTED+1
2982:          ENDIF2982:          ENDIF
2983:       ENDDO2983:       ENDDO
2984:       IF (DEBUG) PRINT*,'getnconn> NCONNECTED,PNCONNECTED=',NCONNECTED,PNCONNECTED2984:       IF (DEBUG) PRINT*,'getnconn> NCONNECTED,PNCONNECTED=',NCONNECTED,PNCONNECTED
2985:       IF (NCONNECTED.NE.PNCONNECTED) GOTO 112985:       IF (NCONNECTED.NE.PNCONNECTED) GOTO 11
2986: 2986: 
2987:       DO J1=1,NMIN2987:       DO J1=1,NMIN
2988:          IF (DEBUG) WRITE(*,'(A,I8,A,I8)') 'getnconn> number of connections for minimum ',J1,' is ',NCONN(J1)2988:          IF (DEBUG) WRITE(*,'(A,I6,A,I6)') 'getnconn> number of connections for minimum ',J1,' is ',NCONN(J1)
2989:       ENDDO 2989:       ENDDO 
2990: 2990: 
2991:       NCONNMAX=NCONN(1)2991:       NCONNMAX=NCONN(1)
2992:       NZERO=02992:       NZERO=0
2993:       IF (NCONN(1).EQ.0) NZERO=12993:       IF (NCONN(1).EQ.0) NZERO=1
2994:       JMAX=12994:       JMAX=1
2995:       DO J1=2,NMIN2995:       DO J1=2,NMIN
2996:          IF (NCONN(J1).EQ.0) NZERO=NZERO+12996:          IF (NCONN(J1).EQ.0) NZERO=NZERO+1
2997:          IF (NCONN(J1).GT.NCONNMAX) THEN2997:          IF (NCONN(J1).GT.NCONNMAX) THEN
2998:             NCONNMAX=NCONN(J1)2998:             NCONNMAX=NCONN(J1)
2999:             JMAX=J12999:             JMAX=J1
3000:          ENDIF3000:          ENDIF
3001:       ENDDO3001:       ENDDO
3002: !     WRITE(*,'(4(A,I8))') 'getnconn> max connections: ',NCONNMAX,' for min ',JMAX,' # of zeros=',NZERO, &3002: !     WRITE(*,'(4(A,I6))') 'getnconn> max connections: ',NCONNMAX,' for min ',JMAX,' # of zeros=',NZERO, &
3003: !    &                     ' after removing minima with < ',NCONNMIN+13003: !    &                     ' after removing minima with < ',NCONNMIN+1
3004: 3004: 
3005:       RETURN3005:       RETURN
3006:       END3006:       END


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0