| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | module raffle__distribs | ||
| 2 | !! Module for handling distribution functions. | ||
| 3 | !! | ||
| 4 | !! This module contains the types and subroutines for generating distribution | ||
| 5 | !! fucntions for individual materials. | ||
| 6 | !! The distribution functions are used as fingerprints for atomic structures | ||
| 7 | !! to identify similarities and differences between structures. | ||
| 8 | use raffle__constants, only: real32, pi, tau | ||
| 9 | use raffle__io_utils, only: stop_program, print_warning | ||
| 10 | use raffle__misc, only: strip_null, sort_str | ||
| 11 | use raffle__misc_maths, only: triangular_number | ||
| 12 | use raffle__misc_linalg, only: get_angle, get_improper_dihedral_angle | ||
| 13 | use raffle__geom_rw, only: basis_type, get_element_properties | ||
| 14 | use raffle__geom_extd, only: extended_basis_type | ||
| 15 | use raffle__element_utils, only: & | ||
| 16 | element_type, element_bond_type, & | ||
| 17 | element_database, element_bond_database | ||
| 18 | implicit none | ||
| 19 | |||
| 20 | |||
| 21 | private | ||
| 22 | |||
| 23 | public :: distribs_base_type, distribs_type, get_distrib | ||
| 24 | |||
| 25 | |||
| 26 | type :: distribs_base_type | ||
| 27 | !! Base type for distribution functions. | ||
| 28 | real(real32), dimension(:,:), allocatable :: df_2body | ||
| 29 | !! 2-body distribution function. | ||
| 30 | real(real32), dimension(:,:), allocatable :: df_3body | ||
| 31 | !! 3-body distribution function. | ||
| 32 | real(real32), dimension(:,:), allocatable :: df_4body | ||
| 33 | !! 4-body distribution function. | ||
| 34 | contains | ||
| 35 | procedure, pass(this) :: compare | ||
| 36 | !! Compare this distribution function with another. | ||
| 37 | end type distribs_base_type | ||
| 38 | |||
| 39 | type, extends(distribs_base_type) :: distribs_type | ||
| 40 | !! Type for distribution functions. | ||
| 41 | !! | ||
| 42 | !! This type contains the distribution functions for a single atomic | ||
| 43 | !! structure. It also contains other structure properties, including: | ||
| 44 | !! - energy | ||
| 45 | !! - stoichiometry | ||
| 46 | !! - elements | ||
| 47 | !! - number of atoms | ||
| 48 | integer :: num_atoms = 0 | ||
| 49 | !! Number of atoms in the structure. | ||
| 50 | real(real32) :: energy = 0.0_real32 | ||
| 51 | !! Energy of the structure. | ||
| 52 | real(real32) :: energy_above_hull = 0.0_real32 | ||
| 53 | !! Energy above the hull of the structure. | ||
| 54 | logical :: from_host = .false. | ||
| 55 | !! Boolean whether the structure is derived from the host. | ||
| 56 | integer, dimension(:), allocatable :: stoichiometry | ||
| 57 | !! Stoichiometry of the structure. | ||
| 58 | character(len=3), dimension(:), allocatable :: element_symbols | ||
| 59 | !! Elements contained within the structure. | ||
| 60 | integer, dimension(:), allocatable :: num_pairs, num_per_species | ||
| 61 | !! Number of pairs and number of pairs per species. | ||
| 62 | real(real32), dimension(:), allocatable :: weight_pair, weight_per_species | ||
| 63 | !! Weights for the 2-body and species distribution functions. | ||
| 64 | contains | ||
| 65 | procedure, pass(this) :: calculate | ||
| 66 | !! Calculate the distribution functions for the structure. | ||
| 67 | end type distribs_type | ||
| 68 | |||
| 69 | |||
| 70 | contains | ||
| 71 | |||
| 72 | !############################################################################### | ||
| 73 | 14 | subroutine set_bond_radius_to_default(elements) | |
| 74 | !! Set the bond radius to the default value. | ||
| 75 | !! | ||
| 76 | !! The default value is the average of the covalent radii of the elements. | ||
| 77 | implicit none | ||
| 78 | |||
| 79 | ! Arguments | ||
| 80 | character(len=3), dimension(2), intent(in) :: elements | ||
| 81 | !! Element symbols. | ||
| 82 | |||
| 83 | ! Local variables | ||
| 84 | integer :: idx1, idx2 | ||
| 85 | !! Index of the elements in the element database. | ||
| 86 | real(real32) :: radius, radius1, radius2 | ||
| 87 | !! Average of covalent radii. | ||
| 88 | character(256) :: warn_msg | ||
| 89 | |||
| 90 | |||
| 91 | |||
| 92 | write(warn_msg,'("No bond data for element pair ",A," and ",A)') & | ||
| 93 | 14 | elements(1), elements(2) | |
| 94 | warn_msg = trim(warn_msg) // & | ||
| 95 | achar(13) // achar(10) // & | ||
| 96 |
2/4✓ Branch 2 taken 14 times.
✗ Branch 3 not taken.
✓ Branch 6 taken 14 times.
✗ Branch 7 not taken.
|
14 | "Setting bond to average of covalent radii" |
| 97 | 14 | call print_warning(warn_msg) | |
| 98 |
1/10✗ Branch 0 not taken.
✓ Branch 1 taken 14 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
|
14 | if(.not.allocated(element_database)) allocate(element_database(0)) |
| 99 | idx1 = findloc([ element_database(:)%name ], & | ||
| 100 |
6/8✗ Branch 0 not taken.
✓ Branch 1 taken 14 times.
✓ Branch 3 taken 29 times.
✓ Branch 4 taken 14 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 14 times.
✓ Branch 7 taken 29 times.
✓ Branch 8 taken 14 times.
|
72 | elements(1), dim=1) |
| 101 |
2/2✓ Branch 0 taken 1 times.
✓ Branch 1 taken 13 times.
|
14 | if(idx1.lt.1)then |
| 102 | 1 | call get_element_properties(elements(1), radius=radius1) | |
| 103 | element_database = [ element_database, & | ||
| 104 |
11/16✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✓ Branch 3 taken 1 times.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✓ Branch 7 taken 2 times.
✓ Branch 8 taken 1 times.
✓ Branch 9 taken 1 times.
✗ Branch 10 not taken.
✗ Branch 11 not taken.
✓ Branch 12 taken 1 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 1 times.
✓ Branch 15 taken 2 times.
✓ Branch 16 taken 1 times.
|
6 | element_type(name=elements(1), radius=radius1) ] |
| 105 | 1 | idx1 = size(element_database) | |
| 106 | end if | ||
| 107 | idx2 = findloc([ element_database(:)%name ], & | ||
| 108 |
6/8✗ Branch 0 not taken.
✓ Branch 1 taken 14 times.
✓ Branch 3 taken 30 times.
✓ Branch 4 taken 14 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 14 times.
✓ Branch 7 taken 30 times.
✓ Branch 8 taken 14 times.
|
74 | elements(2), dim=1) |
| 109 |
2/2✓ Branch 0 taken 1 times.
✓ Branch 1 taken 13 times.
|
14 | if(idx2.lt.1)then |
| 110 | 1 | call get_element_properties(elements(2), radius=radius2) | |
| 111 | element_database = [ element_database, & | ||
| 112 |
11/16✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✓ Branch 3 taken 2 times.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✓ Branch 7 taken 3 times.
✓ Branch 8 taken 1 times.
✓ Branch 9 taken 1 times.
✗ Branch 10 not taken.
✗ Branch 11 not taken.
✓ Branch 12 taken 1 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 1 times.
✓ Branch 15 taken 3 times.
✓ Branch 16 taken 1 times.
|
9 | element_type(name=elements(2), radius=radius2) ] |
| 113 | 1 | idx2 = size(element_database) | |
| 114 | end if | ||
| 115 | radius = ( element_database(idx1)%radius + & | ||
| 116 | 14 | element_database(idx2)%radius ) / 2._real32 | |
| 117 |
2/2✓ Branch 0 taken 6 times.
✓ Branch 1 taken 8 times.
|
14 | if(.not.allocated(element_bond_database)) & |
| 118 |
4/8✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
|
6 | allocate(element_bond_database(0)) |
| 119 | element_bond_database = [ element_bond_database, & | ||
| 120 | element_bond_type(elements=[ & | ||
| 121 | elements(1), & | ||
| 122 | elements(2) & | ||
| 123 | ], radius=radius) & | ||
| 124 |
13/18✗ Branch 0 not taken.
✓ Branch 1 taken 14 times.
✓ Branch 3 taken 21 times.
✓ Branch 4 taken 14 times.
✓ Branch 5 taken 28 times.
✓ Branch 6 taken 14 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 14 times.
✓ Branch 9 taken 35 times.
✓ Branch 10 taken 14 times.
✓ Branch 11 taken 14 times.
✗ Branch 12 not taken.
✗ Branch 13 not taken.
✓ Branch 14 taken 14 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 14 times.
✓ Branch 17 taken 35 times.
✓ Branch 18 taken 14 times.
|
133 | ] |
| 125 | call sort_str( & | ||
| 126 | element_bond_database(size(element_bond_database))%element & | ||
| 127 | 14 | ) | |
| 128 | |||
| 129 | 14 | end subroutine set_bond_radius_to_default | |
| 130 | !############################################################################### | ||
| 131 | |||
| 132 | |||
| 133 | !############################################################################### | ||
| 134 | 42 | subroutine calculate(this, basis, & | |
| 135 | nbins, width, sigma, cutoff_min, cutoff_max, radius_distance_tol) | ||
| 136 | !! Calculate the distribution functions for the container. | ||
| 137 | !! | ||
| 138 | !! This procedure calculates the 2-, 3-, and 4-body distribution function | ||
| 139 | !! for a given atomic structure (i.e. basis). | ||
| 140 | implicit none | ||
| 141 | |||
| 142 | ! Arguments | ||
| 143 | class(distribs_type), intent(inout) :: this | ||
| 144 | !! Parent of the procedure. Instance of distribution functions container. | ||
| 145 | type(basis_type), intent(in) :: basis | ||
| 146 | !! Atomic structure. | ||
| 147 | integer, dimension(3), intent(in), optional :: nbins | ||
| 148 | !! Optional. Number of bins for the distribution functions. | ||
| 149 | real(real32), dimension(3), intent(in), optional :: width, sigma | ||
| 150 | !! Optional. Width and sigma for the distribution functions. | ||
| 151 | real(real32), dimension(3), intent(in), optional :: cutoff_min, cutoff_max | ||
| 152 | !! Optional. Cutoff minimum and maximum for the distribution functions. | ||
| 153 | real(real32), dimension(4), intent(in), optional :: radius_distance_tol | ||
| 154 | !! Tolerance for the distance between atoms for 3- and 4-body. | ||
| 155 | |||
| 156 | ! Local variables | ||
| 157 | integer, dimension(3) :: nbins_ | ||
| 158 | !! Number of bins for the distribution functions. | ||
| 159 | real(real32), dimension(3) :: sigma_ | ||
| 160 | !! Sigma for the distribution functions. | ||
| 161 | real(real32), dimension(3) :: width_ | ||
| 162 | !! Width of the bins for the distribution functions. | ||
| 163 | real(real32), dimension(3) :: cutoff_min_ | ||
| 164 | !! Cutoff minimum for the distribution functions. | ||
| 165 | real(real32), dimension(3) :: cutoff_max_ | ||
| 166 | !! Cutoff maximum for the distribution functions. | ||
| 167 | 42 | type(element_bond_type), dimension(:), allocatable :: bond_info | |
| 168 | !! Bond information for radii. | ||
| 169 | real(real32), dimension(4) :: radius_distance_tol_ | ||
| 170 | !! Tolerance for the distance between atoms for 3- and 4-body. | ||
| 171 | |||
| 172 | |||
| 173 | integer :: i, b, itmp1, idx | ||
| 174 | !! Loop index. | ||
| 175 | integer :: is, js, ia, ja, ka, la | ||
| 176 | !! Loop index. | ||
| 177 | integer :: num_pairs | ||
| 178 | !! Number of pairs and angles. | ||
| 179 | real(real32) :: bondlength, rtmp1, dist_max_smooth, dist_min_smooth | ||
| 180 | !! Temporary real variables. | ||
| 181 | logical :: success | ||
| 182 | !! Boolean for success. | ||
| 183 |
6/6✓ Branch 0 taken 126 times.
✓ Branch 1 taken 42 times.
✓ Branch 2 taken 378 times.
✓ Branch 3 taken 126 times.
✓ Branch 4 taken 126 times.
✓ Branch 5 taken 42 times.
|
672 | type(extended_basis_type) :: basis_extd |
| 184 | !! Extended basis of the system. | ||
| 185 |
6/6✓ Branch 0 taken 126 times.
✓ Branch 1 taken 42 times.
✓ Branch 2 taken 378 times.
✓ Branch 3 taken 126 times.
✓ Branch 4 taken 126 times.
✓ Branch 5 taken 42 times.
|
672 | type(extended_basis_type) :: neighbour_basis |
| 186 | !! Basis for storing neighbour data. | ||
| 187 | real(real32), dimension(3) :: eta | ||
| 188 | !! Parameters for the distribution functions. | ||
| 189 | real(real32), dimension(4) :: tolerances | ||
| 190 | !! Tolerance for the distance between atoms for 3- and 4-body. | ||
| 191 | 42 | real(real32), allocatable, dimension(:) :: angle_list, bondlength_list, & | |
| 192 | 42 | distance | |
| 193 | !! Temporary real arrays. | ||
| 194 | 42 | integer, allocatable, dimension(:,:) :: pair_index | |
| 195 | !! Index of element pairs. | ||
| 196 | |||
| 197 | |||
| 198 | !--------------------------------------------------------------------------- | ||
| 199 | ! initialise optional variables | ||
| 200 | !--------------------------------------------------------------------------- | ||
| 201 |
1/2✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
|
42 | if(present(cutoff_min))then |
| 202 | 42 | cutoff_min_ = cutoff_min | |
| 203 | else | ||
| 204 | ✗ | cutoff_min_ = [0.5_real32, 0._real32, 0._real32] | |
| 205 | end if | ||
| 206 |
1/2✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
|
42 | if(present(cutoff_max))then |
| 207 | 42 | cutoff_max_ = cutoff_max | |
| 208 | else | ||
| 209 | ✗ | cutoff_max_ = [6._real32, pi, pi] | |
| 210 | end if | ||
| 211 |
1/2✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
|
42 | if(present(width))then |
| 212 | 42 | width_ = width | |
| 213 | else | ||
| 214 | ✗ | width_ = [0.25_real32, pi/64._real32, pi/64._real32] | |
| 215 | end if | ||
| 216 |
1/2✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
|
42 | if(present(sigma))then |
| 217 | 42 | sigma_ = sigma | |
| 218 | else | ||
| 219 | ✗ | sigma_ = [0.1_real32, 0.1_real32, 0.1_real32] | |
| 220 | end if | ||
| 221 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 42 times.
|
42 | if(present(nbins))then |
| 222 | ✗ | nbins_ = nbins | |
| 223 | ✗ | width_ = ( cutoff_max_ - cutoff_min_ )/real( nbins_ - 1, real32 ) | |
| 224 | else | ||
| 225 |
2/2✓ Branch 0 taken 126 times.
✓ Branch 1 taken 42 times.
|
168 | nbins_ = 1 + nint( (cutoff_max_ - cutoff_min_)/width_ ) |
| 226 | end if | ||
| 227 |
1/2✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
|
42 | if(present(radius_distance_tol))then |
| 228 | 42 | radius_distance_tol_ = radius_distance_tol | |
| 229 | else | ||
| 230 | ✗ | radius_distance_tol_ = [1.5_real32, 2.5_real32, 3._real32, 6._real32] | |
| 231 | end if | ||
| 232 | |||
| 233 | |||
| 234 | |||
| 235 | !--------------------------------------------------------------------------- | ||
| 236 | ! get the number of pairs of species | ||
| 237 | ! (this uses a combination calculator with repetition) | ||
| 238 | !--------------------------------------------------------------------------- | ||
| 239 | num_pairs = nint( & | ||
| 240 | gamma(real(basis%nspec + 2, real32)) / & | ||
| 241 | ( gamma(real(basis%nspec, real32)) * gamma( 3._real32 ) ) & | ||
| 242 | 42 | ) | |
| 243 |
7/14✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 42 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 42 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 42 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 42 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 42 times.
|
42 | allocate(this%element_symbols(basis%nspec)) |
| 244 |
2/2✓ Branch 0 taken 53 times.
✓ Branch 1 taken 42 times.
|
95 | do is = 1, basis%nspec |
| 245 | 95 | this%element_symbols(is) = strip_null(basis%spec(is)%name) | |
| 246 | end do | ||
| 247 | 42 | i = 0 | |
| 248 |
9/16✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 42 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 42 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 42 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 42 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 42 times.
✓ Branch 17 taken 65 times.
✓ Branch 18 taken 42 times.
|
107 | allocate(bond_info(num_pairs)) |
| 249 |
9/18✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 42 times.
✓ Branch 4 taken 42 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 42 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 42 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 42 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 42 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 42 times.
|
42 | allocate(pair_index(basis%nspec,basis%nspec)) |
| 250 |
2/2✓ Branch 0 taken 53 times.
✓ Branch 1 taken 42 times.
|
95 | do is = 1, basis%nspec, 1 |
| 251 |
2/2✓ Branch 0 taken 65 times.
✓ Branch 1 taken 53 times.
|
160 | do js = is, basis%nspec, 1 |
| 252 | 65 | i = i + 1 | |
| 253 | 65 | pair_index(js,is) = i | |
| 254 | 65 | pair_index(is,js) = i | |
| 255 | call bond_info(i)%set( & | ||
| 256 | this%element_symbols(is), & | ||
| 257 | this%element_symbols(js), success & | ||
| 258 | 65 | ) | |
| 259 |
2/2✓ Branch 0 taken 51 times.
✓ Branch 1 taken 14 times.
|
65 | if(success) cycle |
| 260 | call set_bond_radius_to_default( [ & | ||
| 261 | this%element_symbols(is), & | ||
| 262 | this%element_symbols(js) & | ||
| 263 |
2/2✓ Branch 0 taken 28 times.
✓ Branch 1 taken 14 times.
|
42 | ] ) |
| 264 | call bond_info(i)%set( & | ||
| 265 | this%element_symbols(is), & | ||
| 266 | this%element_symbols(js), success & | ||
| 267 | 67 | ) | |
| 268 | end do | ||
| 269 | end do | ||
| 270 | |||
| 271 | |||
| 272 | !--------------------------------------------------------------------------- | ||
| 273 | ! get the stoichiometry, energy, and number of atoms | ||
| 274 | !--------------------------------------------------------------------------- | ||
| 275 |
4/8✗ Branch 0 not taken.
✓ Branch 1 taken 42 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✓ Branch 4 taken 42 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 53 times.
✓ Branch 7 taken 42 times.
|
95 | this%stoichiometry = basis%spec(:)%num |
| 276 | 42 | this%energy = basis%energy | |
| 277 | 42 | this%num_atoms = basis%natom | |
| 278 | |||
| 279 | |||
| 280 | !--------------------------------------------------------------------------- | ||
| 281 | ! calculate the gaussian width and allocate the distribution functions | ||
| 282 | !--------------------------------------------------------------------------- | ||
| 283 |
2/2✓ Branch 0 taken 126 times.
✓ Branch 1 taken 42 times.
|
168 | eta = 1._real32 / ( 2._real32 * sigma_**2._real32 ) |
| 284 |
9/16✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 42 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 42 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 42 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 42 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 42 times.
✓ Branch 17 taken 65 times.
✓ Branch 18 taken 42 times.
|
107 | allocate(this%num_pairs(num_pairs), source = 0) |
| 285 |
9/16✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 42 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 42 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 42 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 42 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 42 times.
✓ Branch 17 taken 53 times.
✓ Branch 18 taken 42 times.
|
95 | allocate(this%num_per_species(basis%nspec), source = 0) |
| 286 |
9/16✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 42 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 42 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 42 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 42 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 42 times.
✓ Branch 17 taken 65 times.
✓ Branch 18 taken 42 times.
|
107 | allocate(this%weight_pair(num_pairs), source = 0._real32) |
| 287 |
9/16✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 42 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 42 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 42 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 42 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 42 times.
✓ Branch 17 taken 53 times.
✓ Branch 18 taken 42 times.
|
95 | allocate(this%weight_per_species(basis%nspec), source = 0._real32) |
| 288 |
13/22✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 42 times.
✓ Branch 4 taken 42 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 42 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 42 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 42 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 42 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 42 times.
✓ Branch 21 taken 65 times.
✓ Branch 22 taken 42 times.
✓ Branch 23 taken 13375 times.
✓ Branch 24 taken 65 times.
|
13482 | allocate(this%df_2body(nbins_(1), num_pairs), source = 0._real32) |
| 289 |
13/22✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 42 times.
✓ Branch 4 taken 42 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 42 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 42 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 42 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 42 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 42 times.
✓ Branch 21 taken 53 times.
✓ Branch 22 taken 42 times.
✓ Branch 23 taken 3824 times.
✓ Branch 24 taken 53 times.
|
3919 | allocate(this%df_3body(nbins_(2), basis%nspec), source = 0._real32) |
| 290 |
13/22✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 42 times.
✓ Branch 4 taken 42 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 42 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 42 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 42 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 42 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 42 times.
✓ Branch 21 taken 53 times.
✓ Branch 22 taken 42 times.
✓ Branch 23 taken 3824 times.
✓ Branch 24 taken 53 times.
|
3919 | allocate(this%df_4body(nbins_(3), basis%nspec), source = 0._real32) |
| 291 | |||
| 292 | |||
| 293 | !--------------------------------------------------------------------------- | ||
| 294 | ! create the extended basis and neighbour basis | ||
| 295 | !--------------------------------------------------------------------------- | ||
| 296 | 42 | call basis_extd%copy(basis) | |
| 297 | 42 | call basis_extd%create_images( max_bondlength = cutoff_max_(1) ) | |
| 298 |
7/14✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 42 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 42 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 42 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 42 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 42 times.
|
42 | allocate(bondlength_list(basis_extd%natom+basis_extd%num_images)) |
| 299 | |||
| 300 |
9/16✗ Branch 0 not taken.
✓ Branch 1 taken 42 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 42 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
✓ Branch 9 taken 42 times.
✓ Branch 10 taken 42 times.
✓ Branch 11 taken 42 times.
✗ Branch 12 not taken.
✗ Branch 13 not taken.
✓ Branch 14 taken 42 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 42 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 42 times.
|
84 | allocate(neighbour_basis%spec(1)) |
| 301 |
9/16✗ Branch 0 not taken.
✓ Branch 1 taken 42 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 42 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
✓ Branch 9 taken 42 times.
✓ Branch 10 taken 42 times.
✓ Branch 11 taken 42 times.
✗ Branch 12 not taken.
✗ Branch 13 not taken.
✓ Branch 14 taken 42 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 42 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 42 times.
|
84 | allocate(neighbour_basis%image_spec(1)) |
| 302 | ✗ | allocate(neighbour_basis%spec(1)%atom( & | |
| 303 | sum(basis_extd%spec(:)%num)+sum(basis_extd%image_spec(:)%num), 4 & | ||
| 304 |
12/20✓ Branch 0 taken 53 times.
✓ Branch 1 taken 42 times.
✓ Branch 2 taken 53 times.
✓ Branch 3 taken 42 times.
✓ Branch 4 taken 42 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 42 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 42 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 42 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 42 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 42 times.
✗ Branch 19 not taken.
✓ Branch 20 taken 42 times.
|
148 | ) ) |
| 305 | ✗ | allocate(neighbour_basis%image_spec(1)%atom( & | |
| 306 | sum(basis_extd%spec(:)%num)+sum(basis_extd%image_spec(:)%num), 4 & | ||
| 307 |
12/20✓ Branch 0 taken 53 times.
✓ Branch 1 taken 42 times.
✓ Branch 2 taken 53 times.
✓ Branch 3 taken 42 times.
✓ Branch 4 taken 42 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 42 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 42 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 42 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 42 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 42 times.
✗ Branch 19 not taken.
✓ Branch 20 taken 42 times.
|
148 | ) ) |
| 308 | 42 | neighbour_basis%nspec = basis%nspec | |
| 309 | 42 | neighbour_basis%natom = 0 | |
| 310 | 42 | neighbour_basis%num_images = 0 | |
| 311 |
4/4✓ Branch 0 taken 126 times.
✓ Branch 1 taken 42 times.
✓ Branch 2 taken 378 times.
✓ Branch 3 taken 126 times.
|
546 | neighbour_basis%lat = basis%lat |
| 312 | |||
| 313 | |||
| 314 | !--------------------------------------------------------------------------- | ||
| 315 | ! calculate the distribution functions | ||
| 316 | !--------------------------------------------------------------------------- | ||
| 317 |
2/2✓ Branch 0 taken 53 times.
✓ Branch 1 taken 42 times.
|
95 | do is = 1, basis%nspec |
| 318 |
2/2✓ Branch 0 taken 289 times.
✓ Branch 1 taken 53 times.
|
384 | do ia = 1, basis%spec(is)%num |
| 319 |
7/14✓ Branch 0 taken 289 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 289 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 289 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 289 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 289 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 289 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 289 times.
|
289 | allocate(distance(basis_extd%natom+basis_extd%num_images)) |
| 320 | 289 | neighbour_basis%spec(1)%num = 0 | |
| 321 | 289 | neighbour_basis%image_spec(1)%num = 0 | |
| 322 |
2/2✓ Branch 0 taken 371 times.
✓ Branch 1 taken 289 times.
|
660 | do js = 1, basis%nspec |
| 323 | 371 | itmp1 = 0 | |
| 324 | tolerances(:) = radius_distance_tol_(:) * & | ||
| 325 |
2/2✓ Branch 0 taken 1484 times.
✓ Branch 1 taken 371 times.
|
1855 | bond_info(pair_index(is, js))%radius_covalent |
| 326 | 371 | tolerances(1) = max( cutoff_min_(1), tolerances(1) ) | |
| 327 | 371 | tolerances(3) = max( cutoff_min_(1), tolerances(3) ) | |
| 328 | 371 | tolerances(2) = min( cutoff_max_(1), tolerances(2) ) | |
| 329 | 371 | tolerances(4) = min( cutoff_max_(1), tolerances(4) ) | |
| 330 | |||
| 331 | !------------------------------------------------------------------ | ||
| 332 | ! loop over all atoms inside the unit cell | ||
| 333 | !------------------------------------------------------------------ | ||
| 334 |
2/2✓ Branch 0 taken 2145 times.
✓ Branch 1 taken 371 times.
|
2516 | atom_loop: do ja = 1, basis_extd%spec(js)%num |
| 335 | |||
| 336 | associate( vector => matmul( & | ||
| 337 | [ & | ||
| 338 | basis_extd%spec(js)%atom(ja,1:3) - & | ||
| 339 | basis_extd%spec(is)%atom(ia,1:3) & | ||
| 340 | ], basis_extd%lat ) & | ||
| 341 | 371 | ) | |
| 342 |
6/6✓ Branch 0 taken 6435 times.
✓ Branch 1 taken 2145 times.
✓ Branch 2 taken 4304 times.
✓ Branch 3 taken 2131 times.
✓ Branch 4 taken 1596 times.
✓ Branch 5 taken 2708 times.
|
8580 | bondlength = norm2( vector ) |
| 343 | |||
| 344 | if( & | ||
| 345 |
2/2✓ Branch 0 taken 289 times.
✓ Branch 1 taken 1856 times.
|
2145 | bondlength .lt. cutoff_min_(1) .or. & |
| 346 | bondlength .gt. cutoff_max_(1) & | ||
| 347 | 289 | ) cycle atom_loop | |
| 348 | |||
| 349 | ! add 2-body bond to store if within tolerances for 3-body | ||
| 350 | ! distance | ||
| 351 | if( & | ||
| 352 |
2/2✓ Branch 0 taken 664 times.
✓ Branch 1 taken 1192 times.
|
1856 | bondlength .ge. tolerances(1) .and. & |
| 353 | bondlength .le. tolerances(2) & | ||
| 354 | ) then | ||
| 355 | neighbour_basis%spec(1)%num = & | ||
| 356 | 664 | neighbour_basis%spec(1)%num + 1 | |
| 357 | neighbour_basis%spec(1)%atom( & | ||
| 358 | neighbour_basis%spec(1)%num,1:3 & | ||
| 359 |
2/2✓ Branch 0 taken 1992 times.
✓ Branch 1 taken 664 times.
|
2656 | ) = vector |
| 360 | neighbour_basis%spec(1)%atom( & | ||
| 361 | neighbour_basis%spec(1)%num,4 & | ||
| 362 | ) = -0.5_real32 * ( & | ||
| 363 | cos( tau * ( bondlength - tolerances(1) ) / & | ||
| 364 | ( & | ||
| 365 | min(cutoff_max_(1), tolerances(2)) - & | ||
| 366 | tolerances(1) & | ||
| 367 | ) & | ||
| 368 | 664 | ) - 1._real32 ) | |
| 369 | end if | ||
| 370 | |||
| 371 | ! add 2-body bond to store if within tolerances for 4-body | ||
| 372 | ! distance | ||
| 373 | if( & | ||
| 374 |
2/2✓ Branch 0 taken 1130 times.
✓ Branch 1 taken 726 times.
|
1856 | bondlength .ge. tolerances(3) .and. & |
| 375 | bondlength .le. tolerances(4) & | ||
| 376 | ) then | ||
| 377 | neighbour_basis%image_spec(1)%num = & | ||
| 378 | 1130 | neighbour_basis%image_spec(1)%num + 1 | |
| 379 | neighbour_basis%image_spec(1)%atom( & | ||
| 380 | neighbour_basis%image_spec(1)%num,1:3 & | ||
| 381 |
2/2✓ Branch 0 taken 3390 times.
✓ Branch 1 taken 1130 times.
|
4520 | ) = vector |
| 382 | neighbour_basis%image_spec(1)%atom( & | ||
| 383 | neighbour_basis%image_spec(1)%num,4 & | ||
| 384 | ) = -0.5_real32 * ( & | ||
| 385 | cos( tau * ( bondlength - tolerances(3) ) / & | ||
| 386 | ( & | ||
| 387 | min(cutoff_max_(1), tolerances(4)) - & | ||
| 388 | tolerances(3) & | ||
| 389 | ) & | ||
| 390 | 1130 | ) - 1._real32 ) | |
| 391 | end if | ||
| 392 | |||
| 393 | !if(js.lt.js.or.(is.eq.js.and.ja.le.ia)) cycle | ||
| 394 | 1856 | itmp1 = itmp1 + 1 | |
| 395 | 1856 | bondlength_list(itmp1) = bondlength | |
| 396 |
4/4✓ Branch 0 taken 6435 times.
✓ Branch 1 taken 2145 times.
✓ Branch 2 taken 6435 times.
✓ Branch 3 taken 2145 times.
|
16871 | distance(itmp1) = 1._real32 |
| 397 | |||
| 398 | end associate | ||
| 399 | end do atom_loop | ||
| 400 | |||
| 401 | |||
| 402 | !------------------------------------------------------------------ | ||
| 403 | ! loop over all image atoms outside of the unit cell | ||
| 404 | !------------------------------------------------------------------ | ||
| 405 |
2/2✓ Branch 0 taken 109360 times.
✓ Branch 1 taken 371 times.
|
109731 | image_loop: do ja = 1, basis_extd%image_spec(js)%num |
| 406 | associate( vector => matmul( & | ||
| 407 | [ & | ||
| 408 | basis_extd%image_spec(js)%atom(ja,1:3) - & | ||
| 409 | basis_extd%spec(is)%atom(ia,1:3) & | ||
| 410 | ], basis_extd%lat ) & | ||
| 411 | 371 | ) | |
| 412 | |||
| 413 |
6/6✓ Branch 0 taken 328080 times.
✓ Branch 1 taken 109360 times.
✓ Branch 2 taken 299006 times.
✓ Branch 3 taken 29074 times.
✓ Branch 4 taken 162346 times.
✓ Branch 5 taken 136660 times.
|
437440 | bondlength = norm2( vector ) |
| 414 | |||
| 415 | if( & | ||
| 416 |
2/2✓ Branch 0 taken 73598 times.
✓ Branch 1 taken 35762 times.
|
109360 | bondlength .lt. cutoff_min_(1) .or. & |
| 417 | bondlength .gt. cutoff_max_(1) & | ||
| 418 | 73598 | ) cycle image_loop | |
| 419 | |||
| 420 | ! add 2-body bond to store if within tolerances for 3-body | ||
| 421 | ! distance | ||
| 422 | if( & | ||
| 423 |
2/2✓ Branch 0 taken 1026 times.
✓ Branch 1 taken 34736 times.
|
35762 | bondlength .ge. tolerances(1) .and. & |
| 424 | bondlength .le. tolerances(2) & | ||
| 425 | ) then | ||
| 426 | neighbour_basis%spec(1)%num = & | ||
| 427 | 1026 | neighbour_basis%spec(1)%num + 1 | |
| 428 | neighbour_basis%spec(1)%atom( & | ||
| 429 | neighbour_basis%spec(1)%num,1:3 & | ||
| 430 |
2/2✓ Branch 0 taken 3078 times.
✓ Branch 1 taken 1026 times.
|
4104 | ) = vector |
| 431 | neighbour_basis%spec(1)%atom( & | ||
| 432 | neighbour_basis%spec(1)%num,4 & | ||
| 433 | ) = -0.5_real32 * ( & | ||
| 434 | cos( tau * ( bondlength - tolerances(1) ) / & | ||
| 435 | ( & | ||
| 436 | min(cutoff_max_(1), tolerances(2)) - & | ||
| 437 | tolerances(1) & | ||
| 438 | ) & | ||
| 439 | 1026 | ) - 1._real32 ) | |
| 440 | end if | ||
| 441 | |||
| 442 | ! add 2-body bond to store if within tolerances for 4-body | ||
| 443 | ! distance | ||
| 444 | if( & | ||
| 445 |
2/2✓ Branch 0 taken 14864 times.
✓ Branch 1 taken 20898 times.
|
35762 | bondlength .ge. tolerances(3) .and. & |
| 446 | bondlength .le. tolerances(4) & | ||
| 447 | ) then | ||
| 448 | neighbour_basis%image_spec(1)%num = & | ||
| 449 | 14864 | neighbour_basis%image_spec(1)%num + 1 | |
| 450 | neighbour_basis%image_spec(1)%atom( & | ||
| 451 | neighbour_basis%image_spec(1)%num,1:3 & | ||
| 452 |
2/2✓ Branch 0 taken 44592 times.
✓ Branch 1 taken 14864 times.
|
59456 | ) = vector |
| 453 | neighbour_basis%image_spec(1)%atom( & | ||
| 454 | neighbour_basis%image_spec(1)%num,4 & | ||
| 455 | ) = -0.5_real32 * ( & | ||
| 456 | cos( tau * ( bondlength - tolerances(3) ) / & | ||
| 457 | ( & | ||
| 458 | min(cutoff_max_(1), tolerances(4)) - & | ||
| 459 | tolerances(3) & | ||
| 460 | ) & | ||
| 461 | 14864 | ) - 1._real32 ) | |
| 462 | end if | ||
| 463 | |||
| 464 | 35762 | itmp1 = itmp1 + 1 | |
| 465 | 35762 | bondlength_list(itmp1) = bondlength | |
| 466 |
4/4✓ Branch 0 taken 328080 times.
✓ Branch 1 taken 109360 times.
✓ Branch 2 taken 328080 times.
✓ Branch 3 taken 109360 times.
|
801282 | distance(itmp1) = 1._real32 |
| 467 | |||
| 468 | end associate | ||
| 469 | end do image_loop | ||
| 470 | |||
| 471 | !------------------------------------------------------------------ | ||
| 472 | ! calculate the 2-body distribution function contributions from | ||
| 473 | ! atom (is,ia) for species pair (is,js) | ||
| 474 | !------------------------------------------------------------------ | ||
| 475 |
1/2✓ Branch 0 taken 371 times.
✗ Branch 1 not taken.
|
660 | if(itmp1.gt.0)then |
| 476 | this%df_2body(:,pair_index(is, js)) = & | ||
| 477 | this%df_2body(:,pair_index(is, js)) + & | ||
| 478 | get_distrib( & | ||
| 479 | bondlength_list(:itmp1), & | ||
| 480 | nbins_(1), eta(1), width_(1), & | ||
| 481 | cutoff_min_(1), & | ||
| 482 | scale_list = distance(:itmp1) & | ||
| 483 |
3/4✗ Branch 0 not taken.
✓ Branch 1 taken 371 times.
✓ Branch 3 taken 76051 times.
✓ Branch 4 taken 371 times.
|
76422 | ) |
| 484 | this%weight_pair(pair_index(is, js)) = & | ||
| 485 | this%weight_pair(pair_index(is, js)) + & | ||
| 486 | 4._real32 * sum( & | ||
| 487 | ( & | ||
| 488 | bond_info(pair_index(is, js))%radius_covalent / & | ||
| 489 | bondlength_list(:itmp1) ) ** 2 & | ||
| 490 |
2/2✓ Branch 0 taken 37618 times.
✓ Branch 1 taken 371 times.
|
37989 | ) |
| 491 | this%num_pairs(pair_index(is, js)) = & | ||
| 492 | 371 | this%num_pairs(pair_index(is, js)) + itmp1 | |
| 493 | this%weight_per_species(is) = & | ||
| 494 | this%weight_per_species(is) + & | ||
| 495 | 4._real32 * sum( & | ||
| 496 | ( & | ||
| 497 | bond_info(pair_index(is, js))%radius_covalent / & | ||
| 498 | bondlength_list(:itmp1) ) ** 2 & | ||
| 499 |
2/2✓ Branch 0 taken 37618 times.
✓ Branch 1 taken 371 times.
|
37989 | ) |
| 500 | 371 | this%num_per_species(is) = this%num_per_species(is) + itmp1 | |
| 501 | end if | ||
| 502 | |||
| 503 | end do | ||
| 504 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 289 times.
|
289 | deallocate(distance) |
| 505 | |||
| 506 | |||
| 507 | !--------------------------------------------------------------------- | ||
| 508 | ! calculate the 3-body distribution function for atom (is,ia) | ||
| 509 | !--------------------------------------------------------------------- | ||
| 510 |
2/2✓ Branch 0 taken 12 times.
✓ Branch 1 taken 277 times.
|
289 | if(neighbour_basis%spec(1)%num.le.1) cycle |
| 511 | associate( & | ||
| 512 | num_angles => & | ||
| 513 | triangular_number( neighbour_basis%spec(1)%num - 1 ) & | ||
| 514 | ) | ||
| 515 |
14/28✓ Branch 0 taken 277 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 277 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 277 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 277 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 277 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 277 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 277 times.
✓ Branch 17 taken 277 times.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
✓ Branch 20 taken 277 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 277 times.
✗ Branch 23 not taken.
✓ Branch 24 taken 277 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 277 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 277 times.
✗ Branch 31 not taken.
✓ Branch 32 taken 277 times.
|
277 | allocate( angle_list(num_angles), distance(num_angles) ) |
| 516 | end associate | ||
| 517 | 277 | do concurrent ( ja = 1:neighbour_basis%spec(1)%num:1 ) | |
| 518 |
2/2✓ Branch 0 taken 1690 times.
✓ Branch 1 taken 277 times.
|
1967 | do concurrent ( ka = ja + 1:neighbour_basis%spec(1)%num:1 ) |
| 519 | idx = nint( & | ||
| 520 | (ja - 1) * (neighbour_basis%spec(1)%num - ja / 2.0) + & | ||
| 521 | (ka - ja) & | ||
| 522 | 7613 | ) | |
| 523 | angle_list(idx) = get_angle( & | ||
| 524 | [ neighbour_basis%spec(1)%atom(ja,:3) ], & | ||
| 525 | [ neighbour_basis%spec(1)%atom(ka,:3) ] & | ||
| 526 |
12/16✗ Branch 0 not taken.
✓ Branch 1 taken 7613 times.
✓ Branch 3 taken 22839 times.
✓ Branch 4 taken 7613 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 7613 times.
✓ Branch 7 taken 22839 times.
✓ Branch 8 taken 7613 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 7613 times.
✓ Branch 12 taken 22839 times.
✓ Branch 13 taken 7613 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 7613 times.
✓ Branch 16 taken 22839 times.
✓ Branch 17 taken 7613 times.
|
98969 | ) |
| 527 | distance(idx) = & | ||
| 528 | ( & | ||
| 529 | neighbour_basis%spec(1)%atom(ja,4) * & | ||
| 530 | neighbour_basis%spec(1)%atom(ka,4) & | ||
| 531 | ) / ( & | ||
| 532 | norm2(neighbour_basis%spec(1)%atom(ja,:3)) ** 2 * & | ||
| 533 | norm2(neighbour_basis%spec(1)%atom(ka,:3)) ** 2 & | ||
| 534 |
14/14✓ Branch 0 taken 7613 times.
✓ Branch 1 taken 1690 times.
✓ Branch 2 taken 22839 times.
✓ Branch 3 taken 7613 times.
✓ Branch 4 taken 15201 times.
✓ Branch 5 taken 7638 times.
✓ Branch 6 taken 6605 times.
✓ Branch 7 taken 8596 times.
✓ Branch 8 taken 22839 times.
✓ Branch 9 taken 7613 times.
✓ Branch 10 taken 12561 times.
✓ Branch 11 taken 10278 times.
✓ Branch 12 taken 6605 times.
✓ Branch 13 taken 5956 times.
|
54981 | ) |
| 535 | end do | ||
| 536 | end do | ||
| 537 | ! a NaN in the angle refers to one where two of the vectors are | ||
| 538 | ! parallel, so the angle is undefined | ||
| 539 |
2/2✓ Branch 0 taken 7613 times.
✓ Branch 1 taken 277 times.
|
7890 | do i = 1, size(angle_list) |
| 540 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 7613 times.
|
7890 | if(isnan(angle_list(i)))then |
| 541 | ✗ | angle_list(i) = -huge(1._real32) | |
| 542 | ✗ | distance(i) = 1._real32 | |
| 543 | end if | ||
| 544 | end do | ||
| 545 | this%df_3body(:,is) = this%df_3body(:,is) + & | ||
| 546 | get_distrib( & | ||
| 547 | angle_list, & | ||
| 548 | nbins_(2), eta(2), width_(2), & | ||
| 549 | cutoff_min_(2), & | ||
| 550 | scale_list = distance & | ||
| 551 |
3/4✗ Branch 0 not taken.
✓ Branch 1 taken 277 times.
✓ Branch 3 taken 18849 times.
✓ Branch 4 taken 277 times.
|
19126 | ) |
| 552 |
2/4✗ Branch 0 not taken.
✓ Branch 1 taken 277 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 277 times.
|
277 | deallocate( angle_list, distance ) |
| 553 | |||
| 554 | |||
| 555 | !--------------------------------------------------------------------- | ||
| 556 | ! calculate the 4-body distribution function for atom (is,ia) | ||
| 557 | !--------------------------------------------------------------------- | ||
| 558 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 277 times.
|
277 | if(neighbour_basis%image_spec(1)%num.eq.0) cycle |
| 559 | associate( & | ||
| 560 | num_angles => & | ||
| 561 | triangular_number( neighbour_basis%spec(1)%num - 1 ) * & | ||
| 562 | neighbour_basis%image_spec(1)%num & | ||
| 563 | ) | ||
| 564 |
14/28✓ Branch 0 taken 277 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 277 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 277 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 277 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 277 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 277 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 277 times.
✓ Branch 17 taken 277 times.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
✓ Branch 20 taken 277 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 277 times.
✗ Branch 23 not taken.
✓ Branch 24 taken 277 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 277 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 277 times.
✗ Branch 31 not taken.
✓ Branch 32 taken 277 times.
|
277 | allocate( angle_list(num_angles), distance(num_angles) ) |
| 565 | end associate | ||
| 566 | 277 | idx = 0 | |
| 567 | do concurrent ( & | ||
| 568 | ja = 1:neighbour_basis%spec(1)%num:1, & | ||
| 569 | la = 1:neighbour_basis%image_spec(1)%num:1 & | ||
| 570 | 16239 | ) | |
| 571 |
4/4✓ Branch 0 taken 15962 times.
✓ Branch 1 taken 277 times.
✓ Branch 2 taken 101388 times.
✓ Branch 3 taken 15962 times.
|
117627 | do concurrent ( ka = ja + 1:neighbour_basis%spec(1)%num:1 ) |
| 572 | idx = nint( & | ||
| 573 | (ja - 1) * (neighbour_basis%spec(1)%num - ja / 2.0) + & | ||
| 574 | (ka - ja - 1) & | ||
| 575 | 478782 | ) * neighbour_basis%image_spec(1)%num + la | |
| 576 | angle_list(idx) = & | ||
| 577 | get_improper_dihedral_angle( & | ||
| 578 | [ neighbour_basis%spec(1)%atom(ja,:3) ], & | ||
| 579 | [ neighbour_basis%spec(1)%atom(ka,:3) ], & | ||
| 580 | [ neighbour_basis%image_spec(1)%atom(la,:3) ] & | ||
| 581 |
18/24✗ Branch 0 not taken.
✓ Branch 1 taken 478782 times.
✓ Branch 3 taken 1436346 times.
✓ Branch 4 taken 478782 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 478782 times.
✓ Branch 7 taken 1436346 times.
✓ Branch 8 taken 478782 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 478782 times.
✓ Branch 12 taken 1436346 times.
✓ Branch 13 taken 478782 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 478782 times.
✓ Branch 16 taken 1436346 times.
✓ Branch 17 taken 478782 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 478782 times.
✓ Branch 21 taken 1436346 times.
✓ Branch 22 taken 478782 times.
✗ Branch 23 not taken.
✓ Branch 24 taken 478782 times.
✓ Branch 25 taken 1436346 times.
✓ Branch 26 taken 478782 times.
|
9096858 | ) |
| 582 | distance(idx) = & | ||
| 583 | ( & | ||
| 584 | neighbour_basis%spec(1)%atom(ja,4) * & | ||
| 585 | neighbour_basis%spec(1)%atom(ka,4) * & | ||
| 586 | neighbour_basis%image_spec(1)%atom(la,4) & | ||
| 587 | ) / ( & | ||
| 588 | norm2(neighbour_basis%spec(1)%atom(ja,:3)) ** 2 * & | ||
| 589 | norm2(neighbour_basis%spec(1)%atom(ka,:3)) ** 2 * & | ||
| 590 | norm2(neighbour_basis%image_spec(1)%atom(la,:3)) ** 2 & | ||
| 591 |
20/20✓ Branch 0 taken 478782 times.
✓ Branch 1 taken 101388 times.
✓ Branch 2 taken 1436346 times.
✓ Branch 3 taken 478782 times.
✓ Branch 4 taken 964110 times.
✓ Branch 5 taken 472236 times.
✓ Branch 6 taken 413982 times.
✓ Branch 7 taken 550128 times.
✓ Branch 8 taken 1436346 times.
✓ Branch 9 taken 478782 times.
✓ Branch 10 taken 784974 times.
✓ Branch 11 taken 651372 times.
✓ Branch 12 taken 413982 times.
✓ Branch 13 taken 370992 times.
✓ Branch 14 taken 1436346 times.
✓ Branch 15 taken 478782 times.
✓ Branch 16 taken 1186746 times.
✓ Branch 17 taken 249600 times.
✓ Branch 18 taken 663190 times.
✓ Branch 19 taken 523556 times.
|
4889208 | ) |
| 592 | end do | ||
| 593 | end do | ||
| 594 | ! a NaN in the angle refers to one where two of the vectors are | ||
| 595 | ! parallel, so the angle is undefined | ||
| 596 |
2/2✓ Branch 0 taken 478782 times.
✓ Branch 1 taken 277 times.
|
479059 | do i = 1, size(angle_list) |
| 597 |
2/2✓ Branch 0 taken 32062 times.
✓ Branch 1 taken 446720 times.
|
479059 | if(isnan(angle_list(i)))then |
| 598 | 32062 | angle_list(i) = -huge(1._real32) | |
| 599 | 32062 | distance(i) = 1._real32 | |
| 600 | end if | ||
| 601 | end do | ||
| 602 | this%df_4body(:,is) = this%df_4body(:,is) + & | ||
| 603 | get_distrib( & | ||
| 604 | angle_list, & | ||
| 605 | nbins_(3), eta(3), width_(3), & | ||
| 606 | cutoff_min_(3), & | ||
| 607 | scale_list = distance & | ||
| 608 |
3/4✗ Branch 0 not taken.
✓ Branch 1 taken 277 times.
✓ Branch 3 taken 18849 times.
✓ Branch 4 taken 277 times.
|
19126 | ) |
| 609 |
2/4✗ Branch 0 not taken.
✓ Branch 1 taken 277 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 277 times.
|
330 | deallocate( angle_list, distance ) |
| 610 | |||
| 611 | end do | ||
| 612 | end do | ||
| 613 | |||
| 614 | !--------------------------------------------------------------------------- | ||
| 615 | ! apply the cutoff function to the 2-body distribution function | ||
| 616 | !--------------------------------------------------------------------------- | ||
| 617 | 42 | dist_max_smooth = cutoff_max_(1) - 0.25_real32 | |
| 618 | 42 | dist_min_smooth = cutoff_min_(1) + 0.25_real32 | |
| 619 |
2/2✓ Branch 0 taken 8622 times.
✓ Branch 1 taken 42 times.
|
8664 | do b = 1, nbins_(1) |
| 620 | 8622 | rtmp1 = cutoff_min_(1) + width_(1) * real(b-1, real32) | |
| 621 |
2/2✓ Branch 0 taken 13375 times.
✓ Branch 1 taken 8622 times.
|
21997 | this%df_2body(b,:) = this%df_2body(b,:) / rtmp1 ** 2 |
| 622 |
2/2✓ Branch 0 taken 392 times.
✓ Branch 1 taken 8230 times.
|
8664 | if( rtmp1 .gt. dist_max_smooth )then |
| 623 | this%df_2body(b,:) = this%df_2body(b,:) * 0.5_real32 * & | ||
| 624 | ( 1._real32 + cos( pi * & | ||
| 625 | ( rtmp1 - dist_max_smooth ) / & | ||
| 626 | ( cutoff_max_(1) - dist_max_smooth ) & | ||
| 627 |
2/2✓ Branch 0 taken 608 times.
✓ Branch 1 taken 392 times.
|
1000 | ) ) |
| 628 |
2/2✓ Branch 0 taken 392 times.
✓ Branch 1 taken 7838 times.
|
8230 | elseif( rtmp1 .lt. dist_min_smooth )then |
| 629 | this%df_2body(b,:) = this%df_2body(b,:) * 0.5_real32 * & | ||
| 630 | ( 1._real32 + cos( pi * & | ||
| 631 | ( rtmp1 - dist_min_smooth ) / & | ||
| 632 | ( dist_min_smooth - cutoff_min_(1) ) & | ||
| 633 |
2/2✓ Branch 0 taken 608 times.
✓ Branch 1 taken 392 times.
|
1000 | ) ) |
| 634 | end if | ||
| 635 | end do | ||
| 636 | |||
| 637 | |||
| 638 | !--------------------------------------------------------------------------- | ||
| 639 | ! renormalise the distribution functions so that area under the curve is 1 | ||
| 640 | !--------------------------------------------------------------------------- | ||
| 641 |
2/2✓ Branch 0 taken 65 times.
✓ Branch 1 taken 42 times.
|
107 | do i = 1, num_pairs |
| 642 |
4/6✓ Branch 0 taken 3028 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 65 times.
✓ Branch 3 taken 2963 times.
✓ Branch 4 taken 65 times.
✗ Branch 5 not taken.
|
3070 | if(any(abs(this%df_2body(:,i)).gt.1.E-6))then |
| 643 |
4/4✓ Branch 0 taken 13375 times.
✓ Branch 1 taken 65 times.
✓ Branch 2 taken 13375 times.
✓ Branch 3 taken 65 times.
|
26815 | this%df_2body(:,i) = this%df_2body(:,i) / sum(this%df_2body(:,i)) |
| 644 | end if | ||
| 645 | end do | ||
| 646 |
2/2✓ Branch 0 taken 53 times.
✓ Branch 1 taken 42 times.
|
95 | do is = 1, basis%nspec |
| 647 |
6/6✓ Branch 0 taken 1444 times.
✓ Branch 1 taken 3 times.
✓ Branch 2 taken 50 times.
✓ Branch 3 taken 1394 times.
✓ Branch 4 taken 50 times.
✓ Branch 5 taken 3 times.
|
1447 | if(any(abs(this%df_3body(:,is)).gt.1.E-6))then |
| 648 |
4/4✓ Branch 0 taken 3629 times.
✓ Branch 1 taken 50 times.
✓ Branch 2 taken 3629 times.
✓ Branch 3 taken 50 times.
|
7308 | this%df_3body(:,is) = this%df_3body(:,is) / sum(this%df_3body(:,is)) |
| 649 | end if | ||
| 650 |
6/6✓ Branch 0 taken 245 times.
✓ Branch 1 taken 3 times.
✓ Branch 2 taken 50 times.
✓ Branch 3 taken 195 times.
✓ Branch 4 taken 50 times.
✓ Branch 5 taken 3 times.
|
290 | if(any(abs(this%df_4body(:,is)).gt.1.E-6))then |
| 651 |
4/4✓ Branch 0 taken 3629 times.
✓ Branch 1 taken 50 times.
✓ Branch 2 taken 3629 times.
✓ Branch 3 taken 50 times.
|
7308 | this%df_4body(:,is) = this%df_4body(:,is) / sum(this%df_4body(:,is)) |
| 652 | end if | ||
| 653 | end do | ||
| 654 | |||
| 655 | |||
| 656 | !--------------------------------------------------------------------------- | ||
| 657 | ! check for NaN in the distribution functions | ||
| 658 | !--------------------------------------------------------------------------- | ||
| 659 |
6/8✓ Branch 0 taken 65 times.
✓ Branch 1 taken 42 times.
✓ Branch 2 taken 13375 times.
✓ Branch 3 taken 65 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 13375 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
|
13482 | if(any(isnan(this%df_2body)))then |
| 660 | ✗ | call stop_program('NaN in 2-body distribution function') | |
| 661 | end if | ||
| 662 |
6/8✓ Branch 0 taken 53 times.
✓ Branch 1 taken 42 times.
✓ Branch 2 taken 3824 times.
✓ Branch 3 taken 53 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 3824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
|
3919 | if(any(isnan(this%df_3body)))then |
| 663 | ✗ | call stop_program('NaN in 3-body distribution function') | |
| 664 | end if | ||
| 665 |
6/8✓ Branch 0 taken 53 times.
✓ Branch 1 taken 42 times.
✓ Branch 2 taken 3824 times.
✓ Branch 3 taken 53 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 3824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
|
3919 | if(any(isnan(this%df_4body)))then |
| 666 | ✗ | call stop_program('NaN in 4-body distribution function') | |
| 667 | end if | ||
| 668 | |||
| 669 |
33/58✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 42 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 42 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 42 times.
✓ Branch 7 taken 42 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 42 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 42 times.
✓ Branch 12 taken 42 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 42 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 42 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 42 times.
✓ Branch 19 taken 42 times.
✗ Branch 20 not taken.
✓ Branch 21 taken 42 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 42 times.
✓ Branch 24 taken 42 times.
✗ Branch 25 not taken.
✗ Branch 26 not taken.
✓ Branch 27 taken 42 times.
✓ Branch 28 taken 42 times.
✗ Branch 29 not taken.
✓ Branch 30 taken 42 times.
✗ Branch 31 not taken.
✓ Branch 32 taken 42 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 42 times.
✗ Branch 35 not taken.
✓ Branch 36 taken 53 times.
✓ Branch 37 taken 42 times.
✓ Branch 38 taken 53 times.
✗ Branch 39 not taken.
✓ Branch 40 taken 53 times.
✗ Branch 41 not taken.
✓ Branch 42 taken 53 times.
✗ Branch 43 not taken.
✓ Branch 44 taken 42 times.
✗ Branch 45 not taken.
✓ Branch 46 taken 42 times.
✗ Branch 47 not taken.
✓ Branch 48 taken 53 times.
✓ Branch 49 taken 42 times.
✗ Branch 50 not taken.
✓ Branch 51 taken 53 times.
✗ Branch 52 not taken.
✓ Branch 53 taken 53 times.
✓ Branch 54 taken 53 times.
✗ Branch 55 not taken.
✗ Branch 56 not taken.
✓ Branch 57 taken 42 times.
|
232 | end subroutine calculate |
| 670 | !############################################################################### | ||
| 671 | |||
| 672 | |||
| 673 | !############################################################################### | ||
| 674 |
1/2✓ Branch 0 taken 959 times.
✗ Branch 1 not taken.
|
959 | function get_distrib(value_list, nbins, eta, width, cutoff_min, & |
| 675 |
2/4✓ Branch 0 taken 959 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 959 times.
✗ Branch 3 not taken.
|
959 | scale_list ) result(output) |
| 676 | !! Calculate the angular distribution function for a list of values. | ||
| 677 | implicit none | ||
| 678 | |||
| 679 | ! Arguments | ||
| 680 | integer, intent(in) :: nbins | ||
| 681 | !! Number of bins for the distribution functions. | ||
| 682 | real(real32), intent(in) :: eta, width, cutoff_min | ||
| 683 | !! Parameters for the distribution functions. | ||
| 684 | real(real32), dimension(:), intent(in) :: value_list | ||
| 685 | !! List of angles. | ||
| 686 | real(real32), dimension(:), intent(in) :: scale_list | ||
| 687 | !! List of scaling for each angle (distance**3 or distance**4) | ||
| 688 | real(real32), dimension(nbins) :: output | ||
| 689 | !! Distribution function for the list of values. | ||
| 690 | |||
| 691 | ! Local variables | ||
| 692 | integer :: i, j, b, bin | ||
| 693 | !! Loop index. | ||
| 694 | integer :: max_num_steps | ||
| 695 | !! Maximum number of steps. | ||
| 696 | integer, dimension(3,2) :: loop_limits | ||
| 697 | !! Loop limits for the 3-body distribution function. | ||
| 698 | |||
| 699 | |||
| 700 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 959 times.
|
959 | max_num_steps = ceiling( sqrt(16._real32/eta) / width ) |
| 701 |
2/2✓ Branch 0 taken 120933 times.
✓ Branch 1 taken 959 times.
|
121892 | output = 0._real32 |
| 702 | |||
| 703 | !--------------------------------------------------------------------------- | ||
| 704 | ! calculate the distribution function for a list of values | ||
| 705 | !--------------------------------------------------------------------------- | ||
| 706 |
2/2✓ Branch 0 taken 524047 times.
✓ Branch 1 taken 959 times.
|
525006 | do i = 1, size(value_list), 1 |
| 707 | |||
| 708 | !------------------------------------------------------------------------ | ||
| 709 | ! get the bin closest to the value | ||
| 710 | !------------------------------------------------------------------------ | ||
| 711 | 524047 | bin = nint( ( value_list(i) - cutoff_min ) / width ) + 1 | |
| 712 | if( & | ||
| 713 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 524047 times.
|
524047 | bin .lt. 1 - max_num_steps .or. & |
| 714 | bin .gt. nbins + max_num_steps & | ||
| 715 | ✗ | ) cycle | |
| 716 | |||
| 717 | |||
| 718 | !------------------------------------------------------------------------ | ||
| 719 | ! calculate the gaussian for this bond | ||
| 720 | !------------------------------------------------------------------------ | ||
| 721 | loop_limits(:,1) = & | ||
| 722 |
2/2✓ Branch 0 taken 1572141 times.
✓ Branch 1 taken 524047 times.
|
2096188 | [ min(nbins, bin), min(nbins, bin + max_num_steps), 1 ] |
| 723 | loop_limits(:,2) = & | ||
| 724 |
2/2✓ Branch 0 taken 1572141 times.
✓ Branch 1 taken 524047 times.
|
2096188 | [ max(0, bin - 1), max(1, bin - max_num_steps), -1 ] |
| 725 | |||
| 726 | |||
| 727 | !------------------------------------------------------------------------ | ||
| 728 | ! do forward and backward loops to add gaussian from its centre | ||
| 729 | !------------------------------------------------------------------------ | ||
| 730 | 959 | do concurrent ( j = 1:2 ) | |
| 731 | do concurrent ( & | ||
| 732 | b = loop_limits(1,j):loop_limits(2,j):loop_limits(3,j) & | ||
| 733 |
2/2✓ Branch 0 taken 1048094 times.
✓ Branch 1 taken 524047 times.
|
1572141 | ) |
| 734 | output(b) = output(b) + & | ||
| 735 | exp( & | ||
| 736 | -eta * ( & | ||
| 737 | value_list(i) - & | ||
| 738 | ( width * real(b-1, real32) + cutoff_min ) & | ||
| 739 | ) ** 2._real32 & | ||
| 740 |
2/2✓ Branch 0 taken 12696415 times.
✓ Branch 1 taken 1048094 times.
|
13744509 | ) * scale_list(i) |
| 741 | end do | ||
| 742 | end do | ||
| 743 | end do | ||
| 744 |
2/2✓ Branch 0 taken 120933 times.
✓ Branch 1 taken 959 times.
|
121892 | output = output * sqrt( eta / pi ) / real(size(value_list,1),real32) |
| 745 | |||
| 746 | 959 | end function get_distrib | |
| 747 | !############################################################################### | ||
| 748 | |||
| 749 | |||
| 750 | !############################################################################### | ||
| 751 | 4 | function compare(this, input) result(output) | |
| 752 | !! Compare this distribution function with another. | ||
| 753 | implicit none | ||
| 754 | |||
| 755 | ! Arguments | ||
| 756 | class(distribs_base_type), intent(in) :: this | ||
| 757 | !! Parent of the procedure. Instance of distribution functions container. | ||
| 758 | class(distribs_base_type), intent(in) :: input | ||
| 759 | !! Distribution function to compare with. | ||
| 760 | |||
| 761 | ! Local variables | ||
| 762 | integer :: num_bins_2body, num_bins_3body, num_bins_4body | ||
| 763 | !! Number of bins for the distribution functions. | ||
| 764 | real(real32) :: diff_2body, diff_3body, diff_4body | ||
| 765 | !! Difference between the two distribution functions. | ||
| 766 | real(real32) :: output | ||
| 767 | !! Output comparison value (i.e. how much the two dfs overlap). | ||
| 768 | integer :: i | ||
| 769 | !! Loop index. | ||
| 770 | |||
| 771 | |||
| 772 | 4 | output = 0._real32 | |
| 773 | |||
| 774 | !--------------------------------------------------------------------------- | ||
| 775 | ! compare the 2-body distribution functions | ||
| 776 | !--------------------------------------------------------------------------- | ||
| 777 | 4 | num_bins_2body = size(this%df_2body, dim=1) | |
| 778 | 4 | num_bins_3body = size(this%df_3body, dim=1) | |
| 779 | 4 | num_bins_4body = size(this%df_4body, dim=1) | |
| 780 |
2/2✓ Branch 0 taken 14 times.
✓ Branch 1 taken 4 times.
|
18 | do i = 1, size(this%df_2body, dim=2) |
| 781 |
4/6✓ Branch 0 taken 464 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 14 times.
✓ Branch 3 taken 450 times.
✓ Branch 4 taken 14 times.
✗ Branch 5 not taken.
|
468 | if(any(abs(this%df_2body(:,i)).gt.1.E-6))then |
| 782 | diff_2body = sum( & | ||
| 783 | abs( this%df_2body(:,i) - input%df_2body(:,i) ) & | ||
| 784 |
2/2✓ Branch 0 taken 3094 times.
✓ Branch 1 taken 14 times.
|
3108 | ) / num_bins_2body |
| 785 | 14 | output = output + diff_2body | |
| 786 | end if | ||
| 787 | end do | ||
| 788 | |||
| 789 | !--------------------------------------------------------------------------- | ||
| 790 | ! compare the 3-body distribution functions | ||
| 791 | !--------------------------------------------------------------------------- | ||
| 792 |
2/2✓ Branch 0 taken 8 times.
✓ Branch 1 taken 4 times.
|
12 | do i = 1, size(this%df_3body, dim=2) |
| 793 |
4/6✓ Branch 0 taken 124 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 8 times.
✓ Branch 3 taken 116 times.
✓ Branch 4 taken 8 times.
✗ Branch 5 not taken.
|
124 | if(any(abs(this%df_3body(:,i)).gt.1.E-6))then |
| 794 | diff_3body = sum( & | ||
| 795 | abs( this%df_3body(:,i) - input%df_3body(:,i) ) & | ||
| 796 |
2/2✓ Branch 0 taken 520 times.
✓ Branch 1 taken 8 times.
|
528 | ) / num_bins_3body |
| 797 | 8 | output = output + diff_3body | |
| 798 | end if | ||
| 799 |
3/6✓ Branch 0 taken 8 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 8 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 8 times.
✗ Branch 5 not taken.
|
12 | if(any(abs(this%df_4body(:,i)).gt.1.E-6))then |
| 800 | diff_4body = sum( & | ||
| 801 | abs( this%df_4body(:,i) - input%df_4body(:,i) ) & | ||
| 802 |
2/2✓ Branch 0 taken 520 times.
✓ Branch 1 taken 8 times.
|
528 | ) / num_bins_4body |
| 803 | 8 | output = output + diff_4body | |
| 804 | end if | ||
| 805 | end do | ||
| 806 | |||
| 807 | 4 | end function compare | |
| 808 | !############################################################################### | ||
| 809 | |||
| 810 | ✗ | end module raffle__distribs | |
| 811 |