| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | module field | ||
| 2 | !> Field module aggregating all field types and factory functions. | ||
| 3 | |||
| 4 | use libneo_coordinates, only: detect_refcoords_file_type, refcoords_file_chartmap, & | ||
| 5 | refcoords_file_vmec_wout, refcoords_file_unknown | ||
| 6 | use field_base, only: magnetic_field_t | ||
| 7 | use field_vmec, only: vmec_field_t, create_vmec_field | ||
| 8 | use field_coils, only: coils_field_t, create_coils_field | ||
| 9 | use field_splined, only: splined_field_t, create_splined_field | ||
| 10 | use field_boozer_chartmap, only: boozer_chartmap_field_t, & | ||
| 11 | create_boozer_chartmap_field, & | ||
| 12 | is_boozer_chartmap | ||
| 13 | use field_spectre, only: spectre_field_t, create_spectre_field | ||
| 14 | |||
| 15 | implicit none | ||
| 16 | |||
| 17 | contains | ||
| 18 | |||
| 19 | 108 | subroutine field_clone(source, dest) | |
| 20 | class(magnetic_field_t), intent(in) :: source | ||
| 21 | class(magnetic_field_t), allocatable, intent(out) :: dest | ||
| 22 | |||
| 23 | select type (source) | ||
| 24 | type is (vmec_field_t) | ||
| 25 |
1/2✗ Branch 1 not taken.
✓ Branch 2 taken 72 times.
|
72 | allocate (vmec_field_t :: dest) |
| 26 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 72 times.
|
72 | select type (dest) |
| 27 | type is (vmec_field_t) | ||
| 28 |
5/12✓ Branch 0 taken 72 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 72 times.
✗ Branch 3 not taken.
✓ Branch 5 taken 72 times.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✓ Branch 8 taken 72 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✗ Branch 12 not taken.
✓ Branch 13 taken 72 times.
|
72 | dest = source |
| 29 | class default | ||
| 30 | ✗ | error stop 'field_clone: Allocation failure (vmec)' | |
| 31 | end select | ||
| 32 | type is (coils_field_t) | ||
| 33 | ✗ | allocate (coils_field_t :: dest) | |
| 34 | ✗ | select type (dest) | |
| 35 | type is (coils_field_t) | ||
| 36 | ✗ | dest = source | |
| 37 | class default | ||
| 38 | ✗ | error stop 'field_clone: Allocation failure (coils)' | |
| 39 | end select | ||
| 40 | type is (splined_field_t) | ||
| 41 |
15/16✗ Branch 1 not taken.
✓ Branch 2 taken 3 times.
✓ Branch 4 taken 3 times.
✓ Branch 5 taken 9 times.
✓ Branch 6 taken 3 times.
✓ Branch 7 taken 9 times.
✓ Branch 8 taken 3 times.
✓ Branch 9 taken 9 times.
✓ Branch 10 taken 3 times.
✓ Branch 11 taken 9 times.
✓ Branch 12 taken 3 times.
✓ Branch 13 taken 9 times.
✓ Branch 14 taken 3 times.
✓ Branch 15 taken 9 times.
✓ Branch 16 taken 9 times.
✓ Branch 17 taken 3 times.
|
84 | allocate (splined_field_t :: dest) |
| 42 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 3 times.
|
3 | select type (dest) |
| 43 | type is (splined_field_t) | ||
| 44 |
7/16✓ Branch 0 taken 3 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 3 times.
✗ Branch 3 not taken.
✓ Branch 5 taken 3 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 3 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✓ Branch 10 taken 3 times.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
✗ Branch 14 not taken.
✓ Branch 15 taken 3 times.
✗ Branch 16 not taken.
✓ Branch 17 taken 3 times.
|
3 | dest = source |
| 45 | class default | ||
| 46 | ✗ | error stop 'field_clone: Allocation failure (splined)' | |
| 47 | end select | ||
| 48 | type is (boozer_chartmap_field_t) | ||
| 49 | ✗ | allocate (boozer_chartmap_field_t :: dest) | |
| 50 | ✗ | select type (dest) | |
| 51 | type is (boozer_chartmap_field_t) | ||
| 52 | ✗ | dest = source | |
| 53 | class default | ||
| 54 | ✗ | error stop 'field_clone: Allocation failure (boozer_chartmap)' | |
| 55 | end select | ||
| 56 | type is (spectre_field_t) | ||
| 57 |
1/2✗ Branch 1 not taken.
✓ Branch 2 taken 33 times.
|
33 | allocate (spectre_field_t :: dest) |
| 58 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 33 times.
|
33 | select type (dest) |
| 59 | type is (spectre_field_t) | ||
| 60 |
35/80✓ Branch 0 taken 33 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 33 times.
✗ Branch 3 not taken.
✓ Branch 5 taken 33 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 33 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 33 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 33 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 33 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 33 times.
✗ Branch 16 not taken.
✓ Branch 17 taken 33 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 33 times.
✗ Branch 20 not taken.
✓ Branch 21 taken 33 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 33 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 33 times.
✗ Branch 26 not taken.
✓ Branch 27 taken 33 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 69 times.
✓ Branch 30 taken 33 times.
✓ Branch 31 taken 69 times.
✗ Branch 32 not taken.
✓ Branch 33 taken 69 times.
✗ Branch 34 not taken.
✓ Branch 35 taken 69 times.
✗ Branch 36 not taken.
✓ Branch 37 taken 69 times.
✗ Branch 38 not taken.
✓ Branch 39 taken 33 times.
✗ Branch 40 not taken.
✗ Branch 41 not taken.
✓ Branch 42 taken 33 times.
✗ Branch 43 not taken.
✗ Branch 44 not taken.
✗ Branch 46 not taken.
✓ Branch 47 taken 33 times.
✗ Branch 48 not taken.
✓ Branch 49 taken 33 times.
✗ Branch 50 not taken.
✓ Branch 51 taken 33 times.
✗ Branch 52 not taken.
✓ Branch 53 taken 33 times.
✗ Branch 54 not taken.
✓ Branch 55 taken 33 times.
✗ Branch 56 not taken.
✓ Branch 57 taken 33 times.
✗ Branch 58 not taken.
✓ Branch 59 taken 33 times.
✗ Branch 60 not taken.
✓ Branch 61 taken 33 times.
✗ Branch 62 not taken.
✓ Branch 63 taken 33 times.
✗ Branch 64 not taken.
✓ Branch 65 taken 33 times.
✗ Branch 66 not taken.
✓ Branch 67 taken 33 times.
✗ Branch 68 not taken.
✓ Branch 69 taken 33 times.
✗ Branch 70 not taken.
✓ Branch 71 taken 33 times.
✗ Branch 72 not taken.
✗ Branch 73 not taken.
✗ Branch 74 not taken.
✗ Branch 75 not taken.
✗ Branch 76 not taken.
✗ Branch 77 not taken.
✗ Branch 78 not taken.
✗ Branch 79 not taken.
✗ Branch 80 not taken.
✗ Branch 81 not taken.
|
102 | dest = source |
| 61 | class default | ||
| 62 | ✗ | error stop 'field_clone: Allocation failure (spectre)' | |
| 63 | end select | ||
| 64 | class default | ||
| 65 | ✗ | error stop 'field_clone: Unsupported field type' | |
| 66 | end select | ||
| 67 | 108 | end subroutine field_clone | |
| 68 | |||
| 69 | 62 | subroutine field_from_file(filename, field) | |
| 70 | !> Create appropriate field type from file. | ||
| 71 | !> For coils files, creates a splined_field_t wrapping coils_field_t. | ||
| 72 | use reference_coordinates, only: ref_coords | ||
| 73 | |||
| 74 | character(*), intent(in) :: filename | ||
| 75 | class(magnetic_field_t), allocatable, intent(out) :: field | ||
| 76 | |||
| 77 | 62 | character(len(filename)) :: stripped_name | |
| 78 | 62 | type(coils_field_t) :: raw_coils | |
| 79 | 62 | type(splined_field_t), allocatable :: splined_coils | |
| 80 | 62 | type(vmec_field_t) :: vmec_field | |
| 81 | 62 | type(boozer_chartmap_field_t), allocatable :: bc_temp | |
| 82 | 62 | type(spectre_field_t), allocatable :: spectre_temp | |
| 83 | integer :: file_type, ierr | ||
| 84 | character(len=2048) :: message | ||
| 85 | |||
| 86 |
1/2✓ Branch 1 taken 62 times.
✗ Branch 2 not taken.
|
62 | stripped_name = strip_directory(filename) |
| 87 | |||
| 88 |
1/2✗ Branch 1 not taken.
✓ Branch 2 taken 62 times.
|
62 | if (is_spectre_file(filename)) then |
| 89 | ✗ | allocate (spectre_temp) | |
| 90 | ✗ | call create_spectre_field(spectre_temp, filename, ierr) | |
| 91 | ✗ | if (ierr /= 0) then | |
| 92 | ✗ | print *, 'field_from_file: create_spectre_field failed for ', & | |
| 93 | ✗ | trim(filename), ' (ierr = ', ierr, ')' | |
| 94 | ✗ | error stop | |
| 95 | end if | ||
| 96 | ✗ | call move_alloc(spectre_temp, field) | |
| 97 |
1/2✓ Branch 0 taken 62 times.
✗ Branch 1 not taken.
|
62 | else if (endswith(filename, '.nc')) then |
| 98 |
2/2✓ Branch 1 taken 6 times.
✓ Branch 2 taken 56 times.
|
62 | if (is_boozer_chartmap(filename)) then |
| 99 | call create_boozer_chartmap_field(filename, bc_temp) | ||
| 100 |
1/4✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
|
6 | call move_alloc(bc_temp, field) |
| 101 | else | ||
| 102 | 56 | call detect_refcoords_file_type(filename, file_type, ierr, message) | |
| 103 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 56 times.
|
56 | if (ierr /= 0) then |
| 104 | ✗ | print *, 'field_from_file: NetCDF file detection error for ', & | |
| 105 | ✗ | trim(filename) | |
| 106 | ✗ | print *, trim(message) | |
| 107 | ✗ | error stop | |
| 108 | end if | ||
| 109 | |||
| 110 | 56 | select case (file_type) | |
| 111 | case (refcoords_file_vmec_wout) | ||
| 112 | 56 | call create_vmec_field(vmec_field) | |
| 113 |
1/4✗ Branch 0 not taken.
✓ Branch 1 taken 56 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
|
56 | call field_clone(vmec_field, field) |
| 114 | case (refcoords_file_chartmap) | ||
| 115 | print *, & | ||
| 116 | ✗ | 'field_from_file: chartmap NetCDF is a coordinate system ', & | |
| 117 | ✗ | 'file, not a field:' | |
| 118 | ✗ | print *, ' filename = ', trim(filename) | |
| 119 | print *, & | ||
| 120 | ✗ | 'Set coord_input to this chartmap file and set field_input', & | |
| 121 | ✗ | ' to a VMEC wout.' | |
| 122 | ✗ | error stop | |
| 123 | case (refcoords_file_unknown) | ||
| 124 | ✗ | print *, 'field_from_file: Unknown NetCDF file type: ', trim(filename) | |
| 125 | ✗ | error stop | |
| 126 | case default | ||
| 127 | ✗ | print *, 'field_from_file: Unexpected file_type ', file_type, ' for ', & | |
| 128 | ✗ | trim(filename) | |
| 129 |
1/4✓ Branch 0 taken 56 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
|
56 | error stop |
| 130 | end select | ||
| 131 | end if | ||
| 132 | ✗ | else if (startswidth(stripped_name, 'coils') .or. & | |
| 133 | endswith(filename, '.coils')) then | ||
| 134 | ✗ | call create_coils_field(filename, raw_coils) | |
| 135 | ✗ | allocate (splined_coils) | |
| 136 | ✗ | call create_splined_field(raw_coils, ref_coords, splined_coils) | |
| 137 | ✗ | call move_alloc(splined_coils, field) | |
| 138 | else | ||
| 139 | ✗ | print *, 'field_from_file: Unknown file name format ', filename | |
| 140 | ✗ | error stop | |
| 141 | end if | ||
| 142 |
12/22✓ Branch 0 taken 56 times.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 56 times.
✓ Branch 5 taken 56 times.
✓ Branch 6 taken 6 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 62 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✗ Branch 12 not taken.
✓ Branch 13 taken 62 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 62 times.
✗ Branch 16 not taken.
✓ Branch 17 taken 62 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 62 times.
✗ Branch 20 not taken.
✓ Branch 21 taken 62 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 62 times.
|
62 | end subroutine field_from_file |
| 143 | |||
| 144 | 466 | function is_spectre_file(filename) result(is_spectre) | |
| 145 | !> SPECTRE equilibria are HDF5. Accept a .h5 name or any non-.nc file whose | ||
| 146 | !> first bytes carry the HDF5 signature, so a mislabelled extension still | ||
| 147 | !> routes. NetCDF-4 is itself HDF5, so .nc is excluded from the magic sniff | ||
| 148 | !> to keep VMEC and chartmap files on the NetCDF path. | ||
| 149 | character(*), intent(in) :: filename | ||
| 150 | logical :: is_spectre | ||
| 151 | |||
| 152 | character(len=1) :: magic(8) | ||
| 153 | integer :: unit, ios, i | ||
| 154 | integer, parameter :: hdf5_magic(8) = [137, 72, 68, 70, 13, 10, 26, 10] | ||
| 155 | |||
| 156 | 466 | is_spectre = endswith(filename, '.h5') | |
| 157 |
2/2✓ Branch 0 taken 112 times.
✓ Branch 1 taken 354 times.
|
466 | if (is_spectre) return |
| 158 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 354 times.
|
354 | if (endswith(filename, '.nc')) return |
| 159 | |||
| 160 | open (newunit=unit, file=filename, access='stream', form='unformatted', & | ||
| 161 | ✗ | status='old', action='read', iostat=ios) | |
| 162 | ✗ | if (ios /= 0) return | |
| 163 | |||
| 164 | ✗ | read (unit, iostat=ios) magic | |
| 165 | ✗ | close (unit) | |
| 166 | ✗ | if (ios /= 0) return | |
| 167 | |||
| 168 | ✗ | is_spectre = .true. | |
| 169 | ✗ | do i = 1, 8 | |
| 170 | ✗ | if (iachar(magic(i)) /= hdf5_magic(i)) then | |
| 171 | 354 | is_spectre = .false. | |
| 172 | return | ||
| 173 | end if | ||
| 174 | end do | ||
| 175 | 62 | end function is_spectre_file | |
| 176 | |||
| 177 | ✗ | function startswidth(text, start) | |
| 178 | logical :: startswidth | ||
| 179 | character(*), intent(in) :: text | ||
| 180 | character(*), intent(in) :: start | ||
| 181 | integer :: len_text, len_start | ||
| 182 | |||
| 183 | ✗ | len_text = len_trim(text) | |
| 184 | ✗ | len_start = len_trim(start) | |
| 185 | |||
| 186 | ✗ | startswidth = .false. | |
| 187 | ✗ | if (len_text >= len_start) then | |
| 188 | ✗ | if (text(1:len_start) == start) then | |
| 189 | ✗ | startswidth = .true. | |
| 190 | end if | ||
| 191 | end if | ||
| 192 | ✗ | end function startswidth | |
| 193 | |||
| 194 | 882 | function endswith(text, ending) | |
| 195 | logical :: endswith | ||
| 196 | character(*), intent(in) :: text | ||
| 197 | character(*), intent(in) :: ending | ||
| 198 | integer :: len_text, len_end | ||
| 199 | |||
| 200 | 882 | len_text = len_trim(text) | |
| 201 | 882 | len_end = len_trim(ending) | |
| 202 | |||
| 203 | 882 | endswith = .false. | |
| 204 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 882 times.
|
882 | if (len_text >= len_end) then |
| 205 |
2/2✓ Branch 0 taken 354 times.
✓ Branch 1 taken 528 times.
|
882 | if (text(len_text - len_end + 1:len_text) == ending) then |
| 206 | 882 | endswith = .true. | |
| 207 | end if | ||
| 208 | end if | ||
| 209 | 882 | end function endswith | |
| 210 | |||
| 211 | 62 | function strip_directory(filename) | |
| 212 | character(*), intent(in) :: filename | ||
| 213 | character(len(filename)) :: strip_directory | ||
| 214 | integer :: i | ||
| 215 | |||
| 216 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 62 times.
|
62 | strip_directory = filename |
| 217 |
2/2✓ Branch 0 taken 61494 times.
✓ Branch 1 taken 48 times.
|
61542 | do i = len(filename), 1, -1 |
| 218 |
2/2✓ Branch 0 taken 14 times.
✓ Branch 1 taken 61480 times.
|
61542 | if (filename(i:i) == '/') then |
| 219 |
2/4✓ Branch 0 taken 14 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 14 times.
✗ Branch 3 not taken.
|
14 | strip_directory = filename(i + 1:len(filename)) |
| 220 | 14 | return | |
| 221 | end if | ||
| 222 | end do | ||
| 223 |
1/2✓ Branch 0 taken 62 times.
✗ Branch 1 not taken.
|
62 | end function strip_directory |
| 224 | |||
| 225 |
10/20✓ Branch 0 taken 72 times.
✓ Branch 1 taken 36 times.
✓ Branch 2 taken 72 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 36 times.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✓ Branch 8 taken 3 times.
✓ Branch 9 taken 33 times.
✓ Branch 10 taken 3 times.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
✓ Branch 13 taken 33 times.
✗ Branch 14 not taken.
✗ Branch 15 not taken.
✓ Branch 16 taken 33 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 33 times.
✗ Branch 19 not taken.
|
216 | end module field |
| 226 |