hdiff output

r25707/disconnectionDPS.f90 2017-01-21 10:41:52.100277952 +0000 r25706/disconnectionDPS.f90 2017-01-21 10:41:52.336287007 +0000
123: ! the high energy minima have been discarded.123: ! the high energy minima have been discarded.
124: !124: !
125: ! NCONNMIN125: ! NCONNMIN
126: ! Minima with NCONNMIN connections or fewer are discarded. Default is zero.126: ! Minima with NCONNMIN connections or fewer are discarded. Default is zero.
127: !127: !
128: ! NOBARRIERS128: ! NOBARRIERS
129: ! If present, all transition state energies are reset to the energy of the higher129: ! If present, all transition state energies are reset to the energy of the higher
130: ! of the two minima they connect. This transforms the energy landscape to the130: ! of the two minima they connect. This transforms the energy landscape to the
131: ! type explored by gmin.131: ! type explored by gmin.
132: !132: !
133: ! ORDER_BY_ENERGY 
134: ! If this keyword is present, then when a node splits into its daughter nodes, 
135: ! the lower energy nodes are closer to the center. 
136: ! 
137: ! ORDER_BY_SIZE 
138: ! If this keyword is present, then when a node splits into its daughter nodes, 
139: ! the nodes that represent larger basins are closer to the center.  This keyword 
140: ! is compatible with keyword CENTREGMIN 
141: ! 
142: ! PICK <file>133: ! PICK <file>
143: ! Specifies the name of a list of numbers of minima, one per line.  Minima on134: ! Specifies the name of a list of numbers of minima, one per line.  Minima on
144: ! this list are included on the graph.  Minima preceded with a minus sign are135: ! this list are included on the graph.  Minima preceded with a minus sign are
145: ! removed from the graph.  This process is executed after the commands136: ! removed from the graph.  This process is executed after the commands
146: ! MONOTONIC, LOWEST and EXCLUDEALL have been executed, thereby making it137: ! MONOTONIC, LOWEST and EXCLUDEALL have been executed, thereby making it
147: ! possible to override them for particular minima.  Examples: 1. To remove138: ! possible to override them for particular minima.  Examples: 1. To remove
148: ! certain minima from a full plot, just specify PICK and a list of negative139: ! certain minima from a full plot, just specify PICK and a list of negative
149: ! minima numbers.  2. To include only specific minima, use EXCLUDEALL and140: ! minima numbers.  2. To include only specific minima, use EXCLUDEALL and
150: ! PICK plus a list of positive minima numbers.  All basin analysis includes141: ! PICK plus a list of positive minima numbers.  All basin analysis includes
151: ! the full sample and is performed before minima are removed or added back in.142: ! the full sample and is performed before minima are removed or added back in.
443:                END SELECT434:                END SELECT
444:             END DO435:             END DO
445:          ENDIF436:          ENDIF
446:       ENDIF437:       ENDIF
447:    END SUBROUTINE NEXT_ITEM438:    END SUBROUTINE NEXT_ITEM
448: !!439: !!
449: END MODULE KEYWORDS440: END MODULE KEYWORDS
450: !................................................................................!441: !................................................................................!
451: !MODULE VARS 442: !MODULE VARS 
452: MODULE VARS 443: MODULE VARS 
453: ! variable definitions 
454: ! M           : the energies of all the minima 
455: ! NODES(I)    : is the number of nodes at level I 
456: ! BRANCHES(I,N) : is the number of branches sprouting from node N at 
457: !                 level I 
458: ! BASIN(I,M)    : is the basin number at level I of minimum M 
459: ! ORDER(I,P)    : is the node in position P at level I 
460: ! node_size(I,N) : is the total number of minima associated with node N at level I 
461: ! node_lowest_energy(I,N) : is the lowest minimum energy associated with node N at 
462: !                           level I 
463: 444: 
464:    IMPLICIT NONE445:    IMPLICIT NONE
465: 446: 
466:    INTEGER, DIMENSION(:), ALLOCATABLE :: NODES, FIRSTCOL, LASTCOL, COLSPAN, CHILDREN447:    INTEGER, DIMENSION(:), ALLOCATABLE :: NODES, FIRSTCOL, LASTCOL, COLSPAN, CHILDREN
467:    INTEGER, DIMENSION(:,:), ALLOCATABLE :: BASIN, BRANCHES, COL_0, ORDER, &448:    INTEGER, DIMENSION(:,:), ALLOCATABLE :: BASIN, BRANCHES, COL_0, ORDER, &
468:       NODE_SIZE, PARENT, MARKNODE449:       NODE_SIZE, PARENT, MARKNODE
469:    DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: DPMARKNODE450:    DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: DPMARKNODE
470:    DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: END_X, END_Y, M451:    DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: END_X, END_Y, M
471:    DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: LEVELWEIGHTS, CENTRESPAN452:    DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: LEVELWEIGHTS, CENTRESPAN
472:    DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: node_lowest_energy 
473: 453: 
474:    INTEGER :: N_LEVELS, N_MIN, LOWEST, MAX_MIN, MAX_MIN2454:    INTEGER :: N_LEVELS, N_MIN, LOWEST, MAX_MIN, MAX_MIN2
475:    INTEGER :: NCONNMIN=0455:    INTEGER :: NCONNMIN=0
476:    INTEGER :: NMINID=0456:    INTEGER :: NMINID=0
477:    INTEGER :: NMINTR=0457:    INTEGER :: NMINTR=0
478:    INTEGER :: CONNECTMIN=0458:    INTEGER :: CONNECTMIN=0
479:    INTEGER :: MINRANGE=10000459:    INTEGER :: MINRANGE=10000
480:    INTEGER, ALLOCATABLE :: MINIDS(:)460:    INTEGER, ALLOCATABLE :: MINIDS(:)
481:    INTEGER, ALLOCATABLE :: MINTRS(:)461:    INTEGER, ALLOCATABLE :: MINTRS(:)
482:    DOUBLE PRECISION, ALLOCATABLE :: DPMINTRS(:)462:    DOUBLE PRECISION, ALLOCATABLE :: DPMINTRS(:)
489:    DOUBLE PRECISION :: TRMIN=0.0D0469:    DOUBLE PRECISION :: TRMIN=0.0D0
490:    DOUBLE PRECISION :: TRMAX=1.0D0470:    DOUBLE PRECISION :: TRMAX=1.0D0
491:    DOUBLE PRECISION :: BENERGY=1.0D100 471:    DOUBLE PRECISION :: BENERGY=1.0D100 
492:    DOUBLE PRECISION :: TRSCALEX=90.0472:    DOUBLE PRECISION :: TRSCALEX=90.0
493:    DOUBLE PRECISION :: TRSCALEY=50.0473:    DOUBLE PRECISION :: TRSCALEY=50.0
494:    CHARACTER(LEN=120) :: FILE_MIN, FILE_PICK, FILE_TS, FILE_WEIGHTS, &    474:    CHARACTER(LEN=120) :: FILE_MIN, FILE_PICK, FILE_TS, FILE_WEIGHTS, &    
495:       FILE_TRACE475:       FILE_TRACE
496:    CHARACTER(LEN=10) :: LAB_FMT476:    CHARACTER(LEN=10) :: LAB_FMT
497:    LOGICAL :: BARRIERS, CENTRE_GMIN, DUMP_NUMBERS, DUMP_SIZES, EXCLUDEALL, &477:    LOGICAL :: BARRIERS, CENTRE_GMIN, DUMP_NUMBERS, DUMP_SIZES, EXCLUDEALL, &
498:       IDENTIFY, MONOTONIC, SPLIT, WEIGHTS,ZEROGM478:       IDENTIFY, MONOTONIC, SPLIT, WEIGHTS,ZEROGM
499:    LOGICAL :: ORDER_BY_SIZE 
500:    LOGICAL :: ORDER_BY_ENERGY 
501:    LOGICAL :: IDENTIFY_NODE=.FALSE.479:    LOGICAL :: IDENTIFY_NODE=.FALSE.
502:    LOGICAL :: IDENTIFY_NODE_SIZE=.FALSE.480:    LOGICAL :: IDENTIFY_NODE_SIZE=.FALSE.
503:    LOGICAL :: IDMINT=.FALSE.481:    LOGICAL :: IDMINT=.FALSE.
504:    LOGICAL :: TRMINT=.FALSE.482:    LOGICAL :: TRMINT=.FALSE.
505:    LOGICAL :: TRPRINT=.FALSE.483:    LOGICAL :: TRPRINT=.FALSE.
506:    LOGICAL :: TRVALRANGET=.FALSE.484:    LOGICAL :: TRVALRANGET=.FALSE.
507:    LOGICAL :: TRVALT=.FALSE.485:    LOGICAL :: TRVALT=.FALSE.
508:    LOGICAL :: BASINT=.FALSE.486:    LOGICAL :: BASINT=.FALSE.
509:    LOGICAL :: WEIGHTLOWER=.FALSE.487:    LOGICAL :: WEIGHTLOWER=.FALSE.
510:    LOGICAL :: TRVALSCALET=.FALSE.488:    LOGICAL :: TRVALSCALET=.FALSE.
540: 518: 
541:    CHARACTER(LEN=3) :: PG519:    CHARACTER(LEN=3) :: PG
542:    CHARACTER(LEN=8) :: MIN_TRIM, BRANCH_TRIM, BRANCH_TRIM2520:    CHARACTER(LEN=8) :: MIN_TRIM, BRANCH_TRIM, BRANCH_TRIM2
543:    DOUBLE PRECISION :: B_HIGH, B_LOW, ENERGY, FRAC, LPAFS, &521:    DOUBLE PRECISION :: B_HIGH, B_LOW, ENERGY, FRAC, LPAFS, &
544:       & X1, X2, X3, X_POS, Y1, Y2, Y3, Y_POS, PADDING, E_GMIN, SPLIT_OPTION522:       & X1, X2, X3, X_POS, Y1, Y2, Y3, Y_POS, PADDING, E_GMIN, SPLIT_OPTION
545:    TYPE(TRANSITION_STATE), DIMENSION(:), ALLOCATABLE :: TS523:    TYPE(TRANSITION_STATE), DIMENSION(:), ALLOCATABLE :: TS
546:    INTEGER :: I, J, K, P, Q, S, R, F, C, MM, NCONNMAX, J1, NDEAD, NCYCLE, NUNCONA, NLEFTMIN, NLEFTTS524:    INTEGER :: I, J, K, P, Q, S, R, F, C, MM, NCONNMAX, J1, NDEAD, NCYCLE, NUNCONA, NLEFTMIN, NLEFTTS
547:    INTEGER :: BASIN_NO, ERR, H_PG, MIN1, MIN2, MIN_TEMP, N_BR, N_COLS, &525:    INTEGER :: BASIN_NO, ERR, H_PG, MIN1, MIN2, MIN_TEMP, N_BR, N_COLS, &
548:       & N_NODES, N_TS, PATH, USED, BIG_ONES, BASIN_GMIN, GMIN526:       & N_NODES, N_TS, PATH, USED, BIG_ONES, BASIN_GMIN, GMIN
549:    INTEGER, DIMENSION(:), ALLOCATABLE :: CONNECT, END_M, INDX1, SORTED527:    INTEGER, DIMENSION(:), ALLOCATABLE :: CONNECT, END_M, INDX1, SORTED
550:    DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: FSORTED 
551:    LOGICAL :: AGAIN, CHANGED528:    LOGICAL :: AGAIN, CHANGED
552:    INTEGER, ALLOCATABLE :: PLUS(:), MINUS(:), NDISTA(:)529:    INTEGER, ALLOCATABLE :: PLUS(:), MINUS(:), NDISTA(:)
553:    LOGICAL, ALLOCATABLE :: DEADTS(:)530:    LOGICAL, ALLOCATABLE :: DEADTS(:)
554:    INTEGER NDUMMY, NN 531:    INTEGER NDUMMY, NN 
555:    DOUBLE PRECISION VMIN, VMAX, DUMMY,R2532:    DOUBLE PRECISION VMIN, VMAX, DUMMY,R2
556:    DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: END_E, TSEN533:    DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: END_E, TSEN
557:    DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: BRANCH_XY534:    DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: BRANCH_XY
558: 535: 
559:    INTEGER, ALLOCATABLE :: DJWBASIN(:), NMINGROUP(:), GROUPMAP(:)536:    INTEGER, ALLOCATABLE :: DJWBASIN(:), NMINGROUP(:), GROUPMAP(:)
560:    DOUBLE PRECISION ETHRESH537:    DOUBLE PRECISION ETHRESH
1036:       DO J = 1, N_MIN1013:       DO J = 1, N_MIN
1037:          IF (NCONN(J).LE.NCONNMIN) CYCLE1014:          IF (NCONN(J).LE.NCONNMIN) CYCLE
1038:          K = BASIN(I, J)1015:          K = BASIN(I, J)
1039:          IF (K > 0) THEN1016:          IF (K > 0) THEN
1040:             NODE_SIZE(I, K) = NODE_SIZE(I, K) + 11017:             NODE_SIZE(I, K) = NODE_SIZE(I, K) + 1
1041:          END IF1018:          END IF
1042:       END DO1019:       END DO
1043:    END DO1020:    END DO
1044:    WRITE (6, '(A, /)') 'Done.'1021:    WRITE (6, '(A, /)') 'Done.'
1045: 1022: 
1046: !  Work out the lowest energy minimum associated with each node at each level. 
1047:  
1048:    IF (ORDER_BY_ENERGY) THEN 
1049:       WRITE (6, '(A)') 'Determining the lowest energy minimum in each basin at each level.' 
1050:       ALLOCATE (node_lowest_energy(N_LEVELS, MAXVAL(NODES))) 
1051:       NODE_LOWEST_ENERGY(:,:) = 1D100 
1052:       DO I = 1, N_LEVELS 
1053:          DO J = 1, N_MIN 
1054:             !IF (NCONN(J).LE.NCONNMIN) CYCLE 
1055:             K = BASIN(I, J) 
1056:             IF (K > 0) THEN 
1057:                IF (M(J) .LT. NODE_LOWEST_ENERGY(I,K) ) THEN 
1058:                   NODE_LOWEST_ENERGY(I,K) = M(J) 
1059:                ENDIF 
1060:             END IF 
1061:          END DO 
1062:       END DO 
1063:       WRITE (6, '(A, /)') 'Done.' 
1064:    ENDIF 
1065:  
1066: 1023: 
1067: !  Work out order in which to print the nodes in each level.1024: !  Work out order in which to print the nodes in each level.
1068: 1025: 
1069:    WRITE (6, '(A)') 'Ordering branches.'1026:    WRITE (6, '(A)') 'Ordering branches.'
1070:    ALLOCATE (ORDER(N_LEVELS, MAXVAL(NODES)))1027:    ALLOCATE (ORDER(N_LEVELS, MAXVAL(NODES)))
1071:    ORDER = 01028:    ORDER = 0
1072:    WRITE (6, '(A)') 'Level   1'1029:    WRITE (6, '(A)') 'Level  1'
1073:    DO I = 1, NODES(1)1030:    DO I = 1, NODES(1)
1074:       ORDER(1, I) = I1031:       ORDER(1, I) = I
1075:    END DO1032:    END DO
1076:    DO I = 2, N_LEVELS1033:    DO I = 2, N_LEVELS
1077:       WRITE (6, '(A, I3)') 'Level ', i1034:       WRITE (6, '(A, I3)') 'Level ', i
1078:       IF (ORDER(I-1, 1) == 0) EXIT1035:       IF (ORDER(I-1, 1) == 0) EXIT
1079:       BASIN_GMIN = BASIN(I, GMIN)1036:       BASIN_GMIN = BASIN(I, GMIN)
1080:       K = 11037:       K = 1
1081:       DO J = 1, NODES(I-1)1038:       DO J = 1, NODES(I-1)
1082:          N_BR = BRANCHES(I-1, ORDER(I-1, J))1039:          N_BR = BRANCHES(I-1, ORDER(I-1, J))
1083:          IF (N_BR > 0) THEN1040:          IF (N_BR > 0) THEN
1084:             ! CONNECT(:) : is a list of NODES at level I connected to node ORDER(I-1,J) at level I-1 (I think ...)1041:             ALLOCATE (CONNECT(N_BR), SORTED(N_BR), INDX1(N_BR))
1085:             ! SORTED(K)  : is the size of node CONNECT(K)  
1086:             ! INDX1(P)   : are the indices of CONNECT sorted by node size.  CONNECT(INDX1(P)) is the Pth smallest node 
1087:             ALLOCATE (CONNECT(N_BR), SORTED(N_BR), FSORTED(N_BR), INDX1(N_BR)) 
1088:             ! get the list of nodes connected to node(I-1,J) 
1089:             CALL CONNECTIONS(I-1, ORDER(I-1, J), CONNECT, N_BR)1042:             CALL CONNECTIONS(I-1, ORDER(I-1, J), CONNECT, N_BR)
1090:             ! SORT the nodes by size and return the order in array INDX11043:             DO P = 1, N_BR
1091:             IF (ORDER_BY_SIZE) THEN1044:                SORTED(P) = NODE_SIZE(I, CONNECT(P))
1092:                DO P = 1, N_BR1045:             END DO
1093:                   SORTED(P) = NODE_SIZE(I, CONNECT(P))1046:             CALL INDEXX(N_BR, DBLE(SORTED), INDX1)
1094:                END DO1047:             DO P = N_BR, 1, -1
1095:                CALL INDEXX(N_BR, DBLE(SORTED), INDX1)1048:                IF (1.0D0*SORTED(INDX1(P))/SORTED(INDX1(N_BR)) < 0.5D0) EXIT
1096:                ! mix the indices so that the largest basins are in the middle1049:             END DO
1097:                CALL MIX_ALTERNATE(N_BR, INDX1)1050:             BIG_ONES = N_BR-P
1098:                DO P = 1, N_BR1051:             CALL MIX(N_BR-BIG_ONES, INDX1(1 : N_BR-BIG_ONES))
1099:                   ORDER(I, K) = CONNECT(INDX1(P))1052:             CALL MIX(BIG_ONES, INDX1(N_BR-BIG_ONES+1 : N_BR))
1100:                   K = K + 11053:             PADDING = 1.0D0*(N_BR - BIG_ONES)/(BIG_ONES + 1)
1101:                END DO1054:             DO P = 1, NINT(PADDING)
1102:             ELSE IF (ORDER_BY_ENERGY) THEN !SORT BY ENERGY1055:                ORDER(I, K) = CONNECT(INDX1(P))
1103:                ! sort by energy instead of size1056:                K = K + 1
1104:                DO P = 1, N_BR1057:             END DO
1105:                   FSORTED(P) = -node_lowest_energy(I, CONNECT(P))1058:             DO Q = 1, BIG_ONES
1106:                END DO1059:                ORDER(I, K) = CONNECT(INDX1(N_BR+1-Q))
1107:                CALL INDEXX(N_BR, FSORTED, INDX1)1060:                K = K + 1
1108:                ! mix the indices so that the basins with the lowest energy minima are in the middle1061:                DO P = NINT(PADDING*Q)+1, NINT(PADDING*(Q+1))
1109:                CALL MIX_ALTERNATE(N_BR, INDX1) 
1110:                DO P = 1, N_BR 
1111:                   ORDER(I, K) = CONNECT(INDX1(P)) 
1112:                   K = K + 1 
1113:                END DO 
1114:             ELSE 
1115:                ! js850> this is the original ordering algorithm. 
1116:                DO P = 1, N_BR 
1117:                   SORTED(P) = NODE_SIZE(I, CONNECT(P)) 
1118:                END DO 
1119:                CALL INDEXX(N_BR, DBLE(SORTED), INDX1) 
1120:                DO P = N_BR, 1, -1 
1121:                   IF (1.0D0*SORTED(INDX1(P))/SORTED(INDX1(N_BR)) < 0.5D0) EXIT 
1122:                END DO 
1123:                BIG_ONES = N_BR-P 
1124:                CALL MIX(N_BR-BIG_ONES, INDX1(1 : N_BR-BIG_ONES)) 
1125:                CALL MIX(BIG_ONES, INDX1(N_BR-BIG_ONES+1 : N_BR)) 
1126:                PADDING = 1.0D0*(N_BR - BIG_ONES)/(BIG_ONES + 1) 
1127:                DO P = 1, NINT(PADDING) 
1128:                   ORDER(I, K) = CONNECT(INDX1(P))1062:                   ORDER(I, K) = CONNECT(INDX1(P))
1129:                   K = K + 11063:                   K = K + 1
1130:                END DO1064:                END DO
1131:                DO Q = 1, BIG_ONES1065:             END DO
1132:                   ORDER(I, K) = CONNECT(INDX1(N_BR+1-Q)) 
1133:                   K = K + 1 
1134:                   DO P = NINT(PADDING*Q)+1, NINT(PADDING*(Q+1)) 
1135:                      ORDER(I, K) = CONNECT(INDX1(P)) 
1136:                      K = K + 1 
1137:                   END DO 
1138:                END DO 
1139:             ENDIF 
1140:             IF (CENTRE_GMIN) THEN1066:             IF (CENTRE_GMIN) THEN
1141:                DO P = K-N_BR, K-11067:                DO P = K-N_BR, K-1
1142:                   IF (ORDER(I, P) == BASIN_GMIN) THEN1068:                   IF (ORDER(I, P) == BASIN_GMIN) THEN
1143:                      Q = K-N_BR + INT(N_BR/2.0D0)1069:                      Q = K-N_BR + INT(N_BR/2.0D0)
1144:                      S = ORDER(I, Q)1070:                      S = ORDER(I, Q)
1145:                      ORDER(I, Q) = BASIN_GMIN1071:                      ORDER(I, Q) = BASIN_GMIN
1146:                      ORDER(I, P) = S 1072:                      ORDER(I, P) = S 
1147:                      EXIT1073:                      EXIT
1148:                   END IF1074:                   END IF
1149:                END DO1075:                END DO
1150:             END IF1076:             END IF
1151:             DEALLOCATE (CONNECT, SORTED, FSORTED, INDX1)1077:             DEALLOCATE (CONNECT, SORTED, INDX1)
1152:          ENDIF1078:          ENDIF
1153:       END DO1079:       END DO
1154:    END DO1080:    END DO
1155:    WRITE (6, '(A, /)') 'Done.'1081:    WRITE (6, '(A, /)') 'Done.'
1156: 1082: 
1157: 1083: 
1158: !  Dump the number of minima represented by each node in the order they will appear.1084: !  Dump the number of minima represented by each node in the order they will appear.
1159: 1085: 
1160:    IF (DUMP_SIZES) THEN1086:    IF (DUMP_SIZES) THEN
1161:       WRITE (6, '(A)') 'Writing node sizes to "node_sizes".'1087:       WRITE (6, '(A)') 'Writing node sizes to "node_sizes".'
1731:    USE PAGE1657:    USE PAGE
1732:    USE VARS1658:    USE VARS
1733:    IMPLICIT NONE1659:    IMPLICIT NONE
1734:    CHARACTER(LEN=50) :: KEYWORD1660:    CHARACTER(LEN=50) :: KEYWORD
1735:    INTEGER ERR, NDUMMY, I41661:    INTEGER ERR, NDUMMY, I4
1736:    INTEGER, ALLOCATABLE :: SAVEID(:)1662:    INTEGER, ALLOCATABLE :: SAVEID(:)
1737:    LOGICAL :: SUCCESS1663:    LOGICAL :: SUCCESS
1738: 1664: 
1739:    BARRIERS = .TRUE.1665:    BARRIERS = .TRUE.
1740:    CENTRE_GMIN = .FALSE.1666:    CENTRE_GMIN = .FALSE.
1741:    ORDER_BY_SIZE = .FALSE. 
1742:    ORDER_BY_energy = .FALSE. 
1743:    DELTA_E = 0.0D01667:    DELTA_E = 0.0D0
1744:    DUMP_NUMBERS = .FALSE.1668:    DUMP_NUMBERS = .FALSE.
1745:    DUMP_SIZES = .FALSE.1669:    DUMP_SIZES = .FALSE.
1746:    E_HIGH = 0.0D01670:    E_HIGH = 0.0D0
1747:    EXCLUDEALL = .FALSE.1671:    EXCLUDEALL = .FALSE.
1748:    LOWEST = 01672:    LOWEST = 0
1749:    LAB_FMT = 'F8.2'1673:    LAB_FMT = 'F8.2'
1750:    MONOTONIC = .FALSE.1674:    MONOTONIC = .FALSE.
1751:    N_LEVELS = 01675:    N_LEVELS = 0
1752:    FILE_PICK = ''1676:    FILE_PICK = ''
1834:       CASE ('NOBARRIERS')1758:       CASE ('NOBARRIERS')
1835:          BARRIERS = .FALSE.1759:          BARRIERS = .FALSE.
1836:       CASE ('NOSPLIT')1760:       CASE ('NOSPLIT')
1837:          SPLIT = .FALSE.1761:          SPLIT = .FALSE.
1838:       CASE ('PICK')1762:       CASE ('PICK')
1839:          CALL GET_STRING(FILE_PICK)1763:          CALL GET_STRING(FILE_PICK)
1840:       CASE ('PS_PAGE_X')1764:       CASE ('PS_PAGE_X')
1841:          CALL GET_INTEGER(PAGE_X)1765:          CALL GET_INTEGER(PAGE_X)
1842:       CASE ('PS_PAGE_Y')1766:       CASE ('PS_PAGE_Y')
1843:          CALL GET_INTEGER(PAGE_Y)1767:          CALL GET_INTEGER(PAGE_Y)
1844:       CASE ('ORDER_BY_ENERGY') 
1845:          ORDER_BY_ENERGY = .TRUE. 
1846:       CASE ('ORDER_BY_SIZE') 
1847:          ORDER_BY_SIZE = .TRUE. 
1848:       CASE ('TRMIN')1768:       CASE ('TRMIN')
1849:          TRMINT = .TRUE.1769:          TRMINT = .TRUE.
1850:          CALL GET_INTEGER(NDUMMY)1770:          CALL GET_INTEGER(NDUMMY)
1851:          CALL GET_INTEGER(MINRANGE)1771:          CALL GET_INTEGER(MINRANGE)
1852:          IF (NDUMMY.eq.1) THEN1772:          IF (NDUMMY.eq.1) THEN
1853:          WRITE (6, '(I6, A)') ndummy, ' set of minima will be traced in colour'1773:          WRITE (6, '(I6, A)') ndummy, ' set of minima will be traced in colour'
1854:          ELSE1774:          ELSE
1855:          WRITE (6, '(I6, A)') ndummy, ' sets of minima will be traced in colour'1775:          WRITE (6, '(I6, A)') ndummy, ' sets of minima will be traced in colour'
1856:          ENDIF1776:          ENDIF
1857:          ALLOCATE(MINTRS(1:MINRANGE))1777:          ALLOCATE(MINTRS(1:MINRANGE))
1978:       IF (ERR /= 0) EXIT1898:       IF (ERR /= 0) EXIT
1979:       IF (MIN1 /= MIN2) N_TS=N_TS+11899:       IF (MIN1 /= MIN2) N_TS=N_TS+1
1980:       IF (E > B_HIGH) B_HIGH=E1900:       IF (E > B_HIGH) B_HIGH=E
1981:       IF (E < B_LOW) B_LOW=E1901:       IF (E < B_LOW) B_LOW=E
1982:    END DO1902:    END DO
1983:    CLOSE (20)1903:    CLOSE (20)
1984: 1904: 
1985: END SUBROUTINE COUNT_TS1905: END SUBROUTINE COUNT_TS
1986: !................................................................................!1906: !................................................................................!
1987: ! CONNECTIONS(INT :: LEVEL, NODE, INT(N_BR) :: CONNECT, INT N_BR)1907: ! CONNECTIONS(INT :: LEVEL, NODE, INT(N_BR) :: CONNECT, INT N_BR)
1988: ! js850> return a list of nodes at level LEVEL+1 that are childen of node NODE at level LEVEL 
1989: SUBROUTINE CONNECTIONS(LEVEL, NODE, CONNECT, N_BR)1908: SUBROUTINE CONNECTIONS(LEVEL, NODE, CONNECT, N_BR)
1990: 1909: 
1991:    USE VARS1910:    USE VARS
1992:    IMPLICIT NONE1911:    IMPLICIT NONE
1993: 1912: 
1994:    INTEGER, INTENT(IN) :: LEVEL, NODE, N_BR1913:    INTEGER, INTENT(IN) :: LEVEL, NODE, N_BR
1995:    INTEGER, DIMENSION(N_BR), INTENT(OUT) :: CONNECT1914:    INTEGER, DIMENSION(N_BR), INTENT(OUT) :: CONNECT
1996: 1915: 
1997:    INTEGER :: I, J, LAST1916:    INTEGER :: I, J, LAST
1998: 1917: 
2122:       IF (NCONN(A).LE.NCONNMIN) CYCLE2041:       IF (NCONN(A).LE.NCONNMIN) CYCLE
2123:       IF ( M(A) < END_E(BASIN(L, A)) ) THEN2042:       IF ( M(A) < END_E(BASIN(L, A)) ) THEN
2124:          END_E(BASIN(L, A)) = M(A)2043:          END_E(BASIN(L, A)) = M(A)
2125:          END_M(BASIN(L, A)) = A2044:          END_M(BASIN(L, A)) = A
2126:       END IF2045:       END IF
2127:    END DO2046:    END DO
2128: 2047: 
2129: END SUBROUTINE ENDPOINTS2048: END SUBROUTINE ENDPOINTS
2130: !................................................................................!2049: !................................................................................!
2131: ! MIX(INT N, INT(N) MIXLIST)2050: ! MIX(INT N, INT(N) MIXLIST)
2132: ! js850> mix the indices in mixlist so that the first element is at position1 
2133: ! the last element is at position 2, etc. 
2134: ! MIXLIST(1) = OLD_MIXLIST(1) 
2135: ! MIXLIST(2) = OLD_MIXLIST(N) 
2136: ! MIXLIST(3) = OLD_MIXLIST(N-1) 
2137: ! MIXLIST(4) = OLD_MIXLIST(2) 
2138: ! MIXLIST(5) = OLD_MIXLIST(3) 
2139: ! MIXLIST(6) = OLD_MIXLIST(N-2) 
2140: ! MIXLIST(7) = OLD_MIXLIST(N-3) 
2141: ! MIXLIST(8) = OLD_MIXLIST(4) 
2142: ! MIXLIST(9) = OLD_MIXLIST(5) 
2143: SUBROUTINE MIX(N, MIXLIST)2051: SUBROUTINE MIX(N, MIXLIST)
2144: 2052: 
2145:    IMPLICIT NONE2053:    IMPLICIT NONE
2146: 2054: 
2147:    INTEGER :: N2055:    INTEGER :: N
2148:    INTEGER, DIMENSION(N) :: MIXLIST2056:    INTEGER, DIMENSION(N) :: MIXLIST
2149: 2057: 
2150:    INTEGER :: SGN, DELTA, POS, I2058:    INTEGER :: SGN, DELTA, POS, I
2151:    INTEGER, DIMENSION(N) :: COPYLIST2059:    INTEGER, DIMENSION(N) :: COPYLIST
2152:    LOGICAL :: BIG2060:    LOGICAL :: BIG
2165:          SGN = -SGN2073:          SGN = -SGN
2166:          BIG = .FALSE.2074:          BIG = .FALSE.
2167:       ELSE2075:       ELSE
2168:          POS = POS + SGN2076:          POS = POS + SGN
2169:          BIG = .TRUE.2077:          BIG = .TRUE.
2170:       END IF2078:       END IF
2171:    END DO2079:    END DO
2172: 2080: 
2173: END SUBROUTINE MIX2081: END SUBROUTINE MIX
2174: !................................................................................!2082: !................................................................................!
2175: ! MIX(INT N, INT(N) MIXLIST) 
2176: ! js850> mix the indices in mixlist so that the first element is at position 1, 
2177: ! the next element is at position N and so on 
2178: ! MISLIST(1)   = OLD_MIXLIST(1) 
2179: ! MISLIST(N-1) = OLD_MIXLIST(2) 
2180: ! MISLIST(2)   = OLD_MIXLIST(3) 
2181: ! MISLIST(N-2) = OLD_MIXLIST(4) 
2182: SUBROUTINE MIX_ALTERNATE(N, MIXLIST) 
2183:  
2184:    IMPLICIT NONE 
2185:  
2186:    INTEGER, intent(IN) :: N 
2187:    INTEGER, intent(INOUT) :: MIXLIST(N) 
2188:  
2189:    INTEGER :: top, bottom, offset, POS, I 
2190:    INTEGER :: COPYLIST(N) 
2191:    LOGICAL :: BIG 
2192:  
2193:    COPYLIST = MIXLIST 
2194:    POS = 1 
2195:    BIG = .False. 
2196:    TOP = N 
2197:    BOTTOM = 1 
2198:    OFFSET = 0 
2199:  
2200:    DO I = 1, N 
2201:       IF (BIG) THEN 
2202:          POS = top - OFFSET 
2203:          OFFSET = OFFSET + 1 
2204:          BIG = .FALSE. 
2205:       ELSE 
2206:          POS = BOTTOM + OFFSET 
2207:          BIG = .TRUE. 
2208:       END IF 
2209:       !MIXLIST(I) = COPYLIST(POS) 
2210:       MIXLIST(pos) = COPYLIST(I) 
2211:    END DO 
2212:  
2213: END SUBROUTINE MIX_ALTERNATE 
2214: !................................................................................! 
2215: !INDEXX(INT N, DP(N) ARR, INT(N) INDX)2083: !INDEXX(INT N, DP(N) ARR, INT(N) INDX)
2216: ! js850> On exit INDX will be the indices 1:N sorted according to the weights ARR 
2217:       SUBROUTINE INDEXX(N,ARR,INDX)2084:       SUBROUTINE INDEXX(N,ARR,INDX)
2218:       INTEGER, INTENT(IN) :: N2085:       INTEGER N,INDX(N),M,NSTACK
2219:       DOUBLE PRECISION, INTENT(IN) :: ARR(N)2086:       DOUBLE PRECISION ARR(N)
2220:       INTEGER, INTENT(OUT) :: INDX(N) 
2221:       INTEGER M,NSTACK 
2222:       PARAMETER (M=7,NSTACK=50)2087:       PARAMETER (M=7,NSTACK=50)
2223:       INTEGER I,INDXT,IR,ITEMP,J,JSTACK,K,L,ISTACK(NSTACK)2088:       INTEGER I,INDXT,IR,ITEMP,J,JSTACK,K,L,ISTACK(NSTACK)
2224:       DOUBLE PRECISION A2089:       DOUBLE PRECISION A
2225:       DO 11 J=1,N2090:       DO 11 J=1,N
2226:         INDX(J)=J2091:         INDX(J)=J
2227: 11    CONTINUE2092: 11    CONTINUE
2228:       JSTACK=02093:       JSTACK=0
2229:       L=12094:       L=1
2230:       IR=N2095:       IR=N
2231: 1     IF(IR-L.LT.M)THEN2096: 1     IF(IR-L.LT.M)THEN


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0