| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | module simple_profiles | ||
| 2 | use, intrinsic :: iso_fortran_env, only: dp => real64 | ||
| 3 | implicit none | ||
| 4 | |||
| 5 | integer, parameter :: MAX_POWER_SERIES = 10 | ||
| 6 | |||
| 7 | integer, parameter :: POWER_SERIES = 1 | ||
| 8 | integer, parameter :: TWO_POWER = 2 | ||
| 9 | |||
| 10 | character(len=32) :: profile_type = "power_series" | ||
| 11 | integer :: active_profile = POWER_SERIES | ||
| 12 | real(dp), allocatable, private :: table_radius(:), table_values(:, :) | ||
| 13 | |||
| 14 | real(dp) :: Te_scale = 1.0d4 | ||
| 15 | real(dp) :: Ti1_scale = 1.0d4 | ||
| 16 | real(dp) :: Ti2_scale = 1.0d4 | ||
| 17 | real(dp) :: ni1_scale = 0.5d20 | ||
| 18 | real(dp) :: ni2_scale = 0.5d20 | ||
| 19 | |||
| 20 | real(dp) :: Te_coef(MAX_POWER_SERIES) = [1.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, & | ||
| 21 | 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0] | ||
| 22 | real(dp) :: Ti1_coef(MAX_POWER_SERIES) = [1.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, & | ||
| 23 | 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0] | ||
| 24 | real(dp) :: Ti2_coef(MAX_POWER_SERIES) = [1.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, & | ||
| 25 | 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0] | ||
| 26 | real(dp) :: ni1_coef(MAX_POWER_SERIES) = [1.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, & | ||
| 27 | 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0] | ||
| 28 | real(dp) :: ni2_coef(MAX_POWER_SERIES) = [1.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, & | ||
| 29 | 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0] | ||
| 30 | |||
| 31 | real(dp) :: Te_p1 = 1.0d0, Te_p2 = 0.0d0 | ||
| 32 | real(dp) :: Ti1_p1 = 1.0d0, Ti1_p2 = 0.0d0 | ||
| 33 | real(dp) :: Ti2_p1 = 1.0d0, Ti2_p2 = 0.0d0 | ||
| 34 | real(dp) :: ni1_p1 = 1.0d0, ni1_p2 = 0.0d0 | ||
| 35 | real(dp) :: ni2_p1 = 1.0d0, ni2_p2 = 0.0d0 | ||
| 36 | |||
| 37 | namelist /profiles/ profile_type, & | ||
| 38 | Te_scale, Ti1_scale, Ti2_scale, ni1_scale, ni2_scale, & | ||
| 39 | Te_coef, Ti1_coef, Ti2_coef, ni1_coef, ni2_coef, & | ||
| 40 | Te_p1, Te_p2, Ti1_p1, Ti1_p2, Ti2_p1, Ti2_p2, & | ||
| 41 | ni1_p1, ni1_p2, ni2_p1, ni2_p2 | ||
| 42 | |||
| 43 | contains | ||
| 44 | |||
| 45 | 60 | subroutine read_profiles(config_file) | |
| 46 | character(len=*), intent(in) :: config_file | ||
| 47 | integer :: ios, unit | ||
| 48 | |||
| 49 | 60 | open (newunit=unit, file=config_file, status='old', action='read', iostat=ios) | |
| 50 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 60 times.
|
60 | if (ios /= 0) return |
| 51 | |||
| 52 | 60 | read (unit, nml=profiles, iostat=ios) | |
| 53 | 60 | close (unit) | |
| 54 | 60 | call select_active_profile | |
| 55 | end subroutine read_profiles | ||
| 56 | |||
| 57 | 23 | subroutine reset_profiles | |
| 58 | ! Restore every &profiles value to its compiled default. The first call | ||
| 59 | ! records the defaults, so call it before changing any value. | ||
| 60 | integer, save :: defaults_unit | ||
| 61 | logical, save :: recorded = .false. | ||
| 62 | |||
| 63 |
3/4✓ Branch 0 taken 1 time.
✓ Branch 1 taken 22 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 time.
|
23 | if (allocated(table_radius)) deallocate (table_radius, table_values) |
| 64 | |||
| 65 |
2/2✓ Branch 0 taken 21 times.
✓ Branch 1 taken 2 times.
|
23 | if (.not. recorded) then |
| 66 | 21 | open (newunit=defaults_unit, status='scratch', delim='apostrophe') | |
| 67 | 21 | write (defaults_unit, nml=profiles) | |
| 68 | 21 | recorded = .true. | |
| 69 | end if | ||
| 70 | 23 | rewind (defaults_unit) | |
| 71 | 23 | read (defaults_unit, nml=profiles) | |
| 72 | 23 | call select_active_profile | |
| 73 | 23 | end subroutine reset_profiles | |
| 74 | |||
| 75 | 84 | subroutine select_active_profile | |
| 76 | 85 | select case (trim(profile_type)) | |
| 77 | case ("two_power") | ||
| 78 | 1 | active_profile = TWO_POWER | |
| 79 | case default | ||
| 80 |
2/2✓ Branch 0 taken 1 time.
✓ Branch 1 taken 83 times.
|
84 | active_profile = POWER_SERIES |
| 81 | end select | ||
| 82 | 84 | end subroutine select_active_profile | |
| 83 | |||
| 84 | !> Library plasma table: reference radius, Te, Ti1, Ti2 [eV], ni1, ni2 [m^-3]. | ||
| 85 | 4 | subroutine set_profile_table(n, table, status) | |
| 86 | use, intrinsic :: ieee_arithmetic, only: ieee_is_finite | ||
| 87 | integer, intent(in) :: n | ||
| 88 | real(dp), intent(in) :: table(6, n) | ||
| 89 | integer, intent(out) :: status | ||
| 90 | |||
| 91 | 2 | status = 1 | |
| 92 |
1/2✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
|
2 | if (n < 2) return |
| 93 |
6/8✓ Branch 0 taken 6 times.
✓ Branch 1 taken 2 times.
✓ Branch 2 taken 36 times.
✓ Branch 3 taken 6 times.
✓ Branch 4 taken 36 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 2 times.
✗ Branch 7 not taken.
|
44 | if (.not. all(ieee_is_finite(table))) return |
| 94 |
6/8✓ Branch 0 taken 6 times.
✓ Branch 1 taken 2 times.
✓ Branch 2 taken 30 times.
✓ Branch 3 taken 6 times.
✓ Branch 4 taken 30 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 2 times.
✗ Branch 7 not taken.
|
38 | if (any(table(2:6, :) < 0.0_dp)) return |
| 95 |
2/4✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
|
2 | if (table(1, 1) /= 0.0_dp .or. table(1, n) /= 1.0_dp) return |
| 96 |
6/6✓ Branch 0 taken 3 times.
✓ Branch 1 taken 1 time.
✓ Branch 2 taken 2 times.
✓ Branch 3 taken 1 time.
✓ Branch 4 taken 1 time.
✓ Branch 5 taken 1 time.
|
4 | if (any(table(1, 2:n) <= table(1, 1:n - 1))) return |
| 97 |
1/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 time.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
|
1 | if (allocated(table_radius)) deallocate (table_radius, table_values) |
| 98 |
12/24✗ Branch 0 not taken.
✓ Branch 1 taken 1 time.
✓ Branch 2 taken 1 time.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 time.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 1 time.
✗ Branch 9 not taken.
✓ Branch 10 taken 1 time.
✗ Branch 12 not taken.
✓ Branch 13 taken 1 time.
✗ Branch 15 not taken.
✓ Branch 16 taken 1 time.
✓ Branch 17 taken 1 time.
✗ Branch 18 not taken.
✓ Branch 19 taken 1 time.
✗ Branch 20 not taken.
✗ Branch 21 not taken.
✓ Branch 22 taken 1 time.
✗ Branch 24 not taken.
✓ Branch 25 taken 1 time.
✗ Branch 27 not taken.
✓ Branch 28 taken 1 time.
|
5 | allocate (table_radius(n), table_values(5, n)) |
| 99 |
3/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 time.
✓ Branch 2 taken 3 times.
✓ Branch 3 taken 1 time.
|
5 | table_radius = table(1, :) |
| 100 |
7/14✓ Branch 0 taken 1 time.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 time.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 time.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✓ Branch 10 taken 3 times.
✓ Branch 11 taken 1 time.
✓ Branch 12 taken 15 times.
✓ Branch 13 taken 3 times.
|
20 | table_values = table(2:6, :) |
| 101 | 1 | status = 0 | |
| 102 | 2 | end subroutine set_profile_table | |
| 103 | |||
| 104 | 6154 | subroutine get_plasma_params(s, Te, Ti1, Ti2, ni1, ni2) | |
| 105 | 2 | use plag_coeff_sub, only: plag_coeff | |
| 106 | real(dp), intent(in) :: s | ||
| 107 | real(dp), intent(out) :: Te, Ti1, Ti2, ni1, ni2 | ||
| 108 | real(dp) :: radius, coefficient(0:0, 2), values(5) | ||
| 109 | integer :: i | ||
| 110 | |||
| 111 |
2/2✓ Branch 0 taken 1 time.
✓ Branch 1 taken 6153 times.
|
6154 | if (allocated(table_radius)) then |
| 112 | 1 | radius = max(0.0_dp, min(1.0_dp, s)) | |
| 113 |
4/4✓ Branch 0 taken 3 times.
✓ Branch 1 taken 1 time.
✓ Branch 2 taken 2 times.
✓ Branch 3 taken 1 time.
|
4 | i = max(1, min(size(table_radius) - 1, count(table_radius <= radius))) |
| 114 | 1 | call plag_coeff(2, 0, radius, table_radius(i:i + 1), coefficient) | |
| 115 |
5/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 time.
✓ Branch 2 taken 10 times.
✓ Branch 3 taken 2 times.
✓ Branch 4 taken 10 times.
✗ Branch 5 not taken.
|
13 | values = matmul(table_values(:, i:i + 1), coefficient(0, :)) |
| 116 | 1 | Te = values(1) | |
| 117 | 1 | Ti1 = values(2) | |
| 118 | 1 | Ti2 = values(3) | |
| 119 | 1 | ni1 = values(4) | |
| 120 | 1 | ni2 = values(5) | |
| 121 |
2/2✓ Branch 0 taken 1816 times.
✓ Branch 1 taken 4337 times.
|
6153 | else if (active_profile == TWO_POWER) then |
| 122 | 1816 | call get_two_power(s, Te, Ti1, Ti2, ni1, ni2) | |
| 123 | else | ||
| 124 | 4337 | call get_power_series(s, Te, Ti1, Ti2, ni1, ni2) | |
| 125 | end if | ||
| 126 | 6154 | end subroutine get_plasma_params | |
| 127 | |||
| 128 | 21688 | pure function eval_power_series(s, scale, coef) result(f) | |
| 129 | real(dp), intent(in) :: s | ||
| 130 | real(dp), intent(in) :: scale | ||
| 131 | real(dp), intent(in) :: coef(MAX_POWER_SERIES) | ||
| 132 | real(dp) :: f | ||
| 133 | real(dp) :: s_power | ||
| 134 | integer :: n | ||
| 135 | |||
| 136 | 21688 | f = 0.0d0 | |
| 137 | 21688 | s_power = 1.0d0 | |
| 138 |
2/2✓ Branch 0 taken 216880 times.
✓ Branch 1 taken 21688 times.
|
238568 | do n = 1, MAX_POWER_SERIES |
| 139 | 216880 | f = f + coef(n)*s_power | |
| 140 | 238568 | s_power = s_power*s | |
| 141 | end do | ||
| 142 | 21688 | f = scale*f | |
| 143 | 21688 | end function eval_power_series | |
| 144 | |||
| 145 | 9085 | pure function eval_two_power(s, scale, p1, p2) result(f) | |
| 146 | real(dp), intent(in) :: s | ||
| 147 | real(dp), intent(in) :: scale | ||
| 148 | real(dp), intent(in) :: p1 | ||
| 149 | real(dp), intent(in) :: p2 | ||
| 150 | real(dp) :: f | ||
| 151 | real(dp) :: base | ||
| 152 | |||
| 153 | 9085 | base = 1.0d0 - s**p1 | |
| 154 |
1/2✓ Branch 0 taken 9085 times.
✗ Branch 1 not taken.
|
9085 | if (base < 0.0d0) then |
| 155 | f = 0.0d0 | ||
| 156 |
2/2✓ Branch 0 taken 82 times.
✓ Branch 1 taken 9003 times.
|
9085 | else if (abs(base) < epsilon(1.0d0)) then |
| 157 |
2/2✓ Branch 0 taken 30 times.
✓ Branch 1 taken 52 times.
|
82 | if (abs(p2) < epsilon(1.0d0)) then |
| 158 | 30 | f = scale | |
| 159 | else | ||
| 160 | f = 0.0d0 | ||
| 161 | end if | ||
| 162 | else | ||
| 163 | 9003 | f = scale*base**p2 | |
| 164 | end if | ||
| 165 | 9085 | end function eval_two_power | |
| 166 | |||
| 167 | 4337 | subroutine get_power_series(s, Te, Ti1, Ti2, ni1, ni2) | |
| 168 | real(dp), intent(in) :: s | ||
| 169 | real(dp), intent(out) :: Te, Ti1, Ti2, ni1, ni2 | ||
| 170 | |||
| 171 | 4337 | Te = eval_power_series(s, Te_scale, Te_coef) | |
| 172 | 4337 | Ti1 = eval_power_series(s, Ti1_scale, Ti1_coef) | |
| 173 | 4337 | Ti2 = eval_power_series(s, Ti2_scale, Ti2_coef) | |
| 174 | 4337 | ni1 = eval_power_series(s, ni1_scale, ni1_coef) | |
| 175 | 4337 | ni2 = eval_power_series(s, ni2_scale, ni2_coef) | |
| 176 | 4337 | end subroutine get_power_series | |
| 177 | |||
| 178 | 1816 | subroutine get_two_power(s, Te, Ti1, Ti2, ni1, ni2) | |
| 179 | real(dp), intent(in) :: s | ||
| 180 | real(dp), intent(out) :: Te, Ti1, Ti2, ni1, ni2 | ||
| 181 | |||
| 182 | 1816 | Te = eval_two_power(s, Te_scale, Te_p1, Te_p2) | |
| 183 | 1816 | Ti1 = eval_two_power(s, Ti1_scale, Ti1_p1, Ti1_p2) | |
| 184 | 1816 | Ti2 = eval_two_power(s, Ti2_scale, Ti2_p1, Ti2_p2) | |
| 185 | 1816 | ni1 = eval_two_power(s, ni1_scale, ni1_p1, ni1_p2) | |
| 186 | 1816 | ni2 = eval_two_power(s, ni2_scale, ni2_p1, ni2_p2) | |
| 187 | 1816 | end subroutine get_two_power | |
| 188 | |||
| 189 | end module simple_profiles | ||
| 190 |