MPI-AMRVAC 3.2
The MPI - Adaptive Mesh Refinement - Versatile Advection Code (development version)
Loading...
Searching...
No Matches
mod_magnetic_topology.t
Go to the documentation of this file.
2 use, intrinsic :: ieee_arithmetic, only: ieee_value,ieee_quiet_nan, &
3 ieee_is_finite
5 xprobmin1,xprobmax1
6 {^ifthreed
7 use mod_global_parameters, only: xprobmin2,xprobmax2,xprobmin3,xprobmax3
8 }
9 use mod_comm_lib, only: mpistop
10 use mod_geometry, only: geo_coordinate => coordinate, &
11 geo_cartesian => cartesian, geo_spherical => spherical, &
12 geo_cartesian_stretched => cartesian_stretched
47 implicit none
48 private
49
55 public :: mt_mapping_plane_xy
64
65 integer, parameter :: mt_vti_kind_float64 = 1
66 integer, parameter :: mt_vti_kind_int32 = 2
67 integer, parameter :: mt_vti_name_len = 64
68 integer, parameter :: mt_task_name_len = 128
69 double precision, parameter :: mt_unset_real = huge(1.d0)
70
71 logical :: mt_enable = .false.
72 character(len=mt_task_name_len) :: mt_mode = ''
73 character(len=mt_task_name_len) :: mt_output_file = ''
74 character(len=mt_task_name_len) :: mt_output_prefix = ''
75 character(len=mt_task_name_len) :: mt_seed_file = ''
76 character(len=mt_task_name_len) :: mt_seed_surface = ''
77 character(len=mt_task_name_len) :: mt_seed_layout = 'endpoint'
78 character(len=mt_task_name_len) :: mt_vtk_detail = 'minimal'
79 character(len=mt_task_name_len) :: mt_step_control = 'global_cell_fraction'
80 character(len=mt_task_name_len) :: mt_trace_integrator = 'rk2'
81 double precision :: mt_dL = -1.d0
82 double precision :: mt_step_fraction = 0.25d0
83 double precision :: mt_dL_min = 0.d0
84 double precision :: mt_rk45_atol = 1.d-8
85 double precision :: mt_rk45_rtol = 1.d-6
86 double precision :: mt_rk45_safety = 0.9d0
87 double precision :: mt_rk45_min_shrink = 0.2d0
88 double precision :: mt_rk45_max_grow = 5.d0
89 double precision :: mt_rk45_tangent_floor = 1.d0
90 double precision :: mt_rk45_tangent_rtol = 2.d-5
91 integer :: mt_max_steps = -1
92 double precision :: mt_max_steps_factor = 2.d0
93 double precision :: mt_b_min = -1.d0
94 double precision :: mt_seed_coord = mt_unset_real
95 double precision :: mt_seed_theta0 = mt_unset_real
96 double precision :: mt_seed_phi0 = mt_unset_real
97 double precision :: mt_seed_alpha = mt_unset_real
98 logical :: mt_compute_length = .true.
99 logical :: mt_compute_twist = .false.
100 logical :: mt_compute_q = .false.
101 logical :: mt_compute_qperp = .false.
102 logical :: mt_rk2_step_diagnostic = .false.
103 logical :: mt_rk45_step_diagnostic = .false.
104 logical :: mt_rk45_tangent_diagnostic = .false.
105 logical :: mt_rk2_fusion_diagnostic = .false.
106 logical :: mt_write_csv = .false.
107 character(len=mt_task_name_len) :: mt_plane = ''
108 double precision :: mt_origin(3) = mt_unset_real
109 double precision :: mt_e1(3) = mt_unset_real
110 double precision :: mt_e2(3) = mt_unset_real
111 double precision :: mt_xmin = mt_unset_real
112 double precision :: mt_xmax = mt_unset_real
113 double precision :: mt_ymin = mt_unset_real
114 double precision :: mt_ymax = mt_unset_real
115 double precision :: mt_zmin = mt_unset_real
116 double precision :: mt_zmax = mt_unset_real
117 double precision :: mt_x0 = mt_unset_real
118 double precision :: mt_y0 = mt_unset_real
119 double precision :: mt_z0 = mt_unset_real
120 integer :: mt_nx = -1
121 integer :: mt_ny = -1
122 integer :: mt_nz = -1
123 double precision :: mt_s1min = mt_unset_real
124 double precision :: mt_s1max = mt_unset_real
125 double precision :: mt_s2min = mt_unset_real
126 double precision :: mt_s2max = mt_unset_real
127 double precision :: mt_s3min = mt_unset_real
128 double precision :: mt_s3max = mt_unset_real
129 integer :: mt_n1 = -1
130 integer :: mt_n2 = -1
131 integer :: mt_n3 = -1
132 integer :: mt_chunk_nz = -1
133 logical :: mt_profile_spherical = .false.
134
135 type, private :: mt_vti_array_desc
136 character(len=mt_vti_name_len) :: name
137 integer :: kind
138 integer(kind=8) :: nbytes
139 integer(kind=8) :: offset
140 end type mt_vti_array_desc
141
142 type, private :: mt_volume_products
143 double precision, allocatable :: length_total(:)
144 double precision, allocatable :: length_backward(:)
145 double precision, allocatable :: length_forward(:)
146 integer, allocatable :: nstep_backward_length(:)
147 integer, allocatable :: nstep_forward_length(:)
148 integer, allocatable :: status_backward_length(:)
149 integer, allocatable :: status_forward_length(:)
150 double precision, allocatable :: twist_total(:)
151 double precision, allocatable :: twist_backward(:)
152 double precision, allocatable :: twist_forward(:)
153 integer, allocatable :: nstep_backward_twist(:)
154 integer, allocatable :: nstep_forward_twist(:)
155 integer, allocatable :: status_backward_twist(:)
156 integer, allocatable :: status_forward_twist(:)
157 double precision, allocatable :: q(:)
158 double precision, allocatable :: logq(:)
159 double precision, allocatable :: N2_q(:)
160 double precision, allocatable :: bfactor_q(:)
161 double precision, allocatable :: length_forward_q(:)
162 double precision, allocatable :: length_backward_q(:)
163 double precision, allocatable :: Bseed_norm_q(:)
164 double precision, allocatable :: Bf_norm_q(:)
165 double precision, allocatable :: Bb_norm_q(:)
166 integer, allocatable :: valid_q(:)
167 integer, allocatable :: status_q(:)
168 integer, allocatable :: face_forward_q(:)
169 integer, allocatable :: face_backward_q(:)
170 integer, allocatable :: status_forward_q(:)
171 integer, allocatable :: status_backward_q(:)
172 double precision, allocatable :: qperp(:)
173 double precision, allocatable :: logqperp(:)
174 double precision, allocatable :: N2(:)
175 double precision, allocatable :: bfactor(:)
176 double precision, allocatable :: length_forward_qperp(:)
177 double precision, allocatable :: length_backward_qperp(:)
178 double precision, allocatable :: Bseed_norm(:)
179 double precision, allocatable :: Bf_norm(:)
180 double precision, allocatable :: Bb_norm(:)
181 integer, allocatable :: valid_qperp(:)
182 integer, allocatable :: status_qperp(:)
183 integer, allocatable :: face_forward_qperp(:)
184 integer, allocatable :: face_backward_qperp(:)
185 integer, allocatable :: status_forward_qperp(:)
186 integer, allocatable :: status_backward_qperp(:)
187 end type mt_volume_products
188
189contains
190
191 subroutine mt_params_read(files)
192 ! Read the optional one-task magnetic-topology namelist.
194 character(len=*), intent(in) :: files(:)
195
196 integer :: n
197
198 namelist /magnetic_topology_list/ mt_enable,mt_mode,mt_output_file, &
199 mt_output_prefix,mt_seed_file,mt_vtk_detail, &
200 mt_seed_surface,mt_seed_layout,mt_seed_coord, &
201 mt_seed_theta0,mt_seed_phi0,mt_seed_alpha, &
202 mt_step_control,mt_dl,mt_step_fraction,mt_dl_min, &
203 mt_trace_integrator,mt_rk45_atol,mt_rk45_rtol, &
204 mt_rk45_safety,mt_rk45_min_shrink,mt_rk45_max_grow, &
205 mt_rk45_tangent_floor,mt_rk45_tangent_rtol, &
206 mt_max_steps,mt_max_steps_factor,mt_b_min, &
207 mt_compute_length,mt_compute_twist,mt_compute_q,mt_compute_qperp, &
208 mt_rk2_step_diagnostic,mt_rk45_step_diagnostic, &
209 mt_rk45_tangent_diagnostic,mt_rk2_fusion_diagnostic, &
210 mt_write_csv,mt_plane, &
211 mt_origin,mt_e1,mt_e2,mt_xmin,mt_xmax,mt_ymin,mt_ymax, &
212 mt_zmin,mt_zmax,mt_nx,mt_ny,mt_nz,mt_x0,mt_y0,mt_z0, &
213 mt_s1min,mt_s1max,mt_n1,mt_s2min,mt_s2max,mt_n2, &
214 mt_s3min,mt_s3max,mt_n3, &
215 mt_chunk_nz,mt_profile_spherical
216
217 call mt_set_default_params()
218 do n=1,size(files)
219 open(unitpar,file=trim(files(n)),status='old')
220 read(unitpar,magnetic_topology_list,end=111)
221111 close(unitpar)
222 enddo
223 end subroutine mt_params_read
224
226 ! Dispatch the namelist-selected topology/QSL postprocessing task.
227 character(len=mt_task_name_len) :: mode
228 logical :: report_rk2,report_rk45
229
230 if (.not.mt_enable) return
231
232 mode=mt_lowercase(trim(mt_mode))
233 call mt_validate_common_params(mode)
234 call mt_validate_trace_integrator(mode)
235 call mt_apply_trace_step_control()
236 call mt_apply_auto_max_steps()
237 call trace_set_integrator(mt_trace_integrator,mt_rk45_atol, &
238 mt_rk45_rtol,mt_rk45_safety,mt_rk45_min_shrink, &
239 mt_rk45_max_grow,mt_rk45_tangent_floor,mt_rk45_tangent_rtol)
240 report_rk2=mt_lowercase(trim(mt_trace_integrator))=='rk2' .and. &
241 mt_rk2_step_diagnostic
242 report_rk45=(mt_lowercase(trim(mt_trace_integrator))=='rk45_cartesian' &
243 .or. mt_lowercase(trim(mt_trace_integrator))=='rk45_spherical') &
244 .and. mt_rk45_step_diagnostic
245 call trace_rk2_stats_set_enabled(report_rk2)
246 call trace_rk45_stats_set_enabled(report_rk45)
247 if (report_rk2) call trace_rk2_stats_reset()
248 if (report_rk45) call trace_rk45_stats_reset()
249 if (mt_profile_spherical .and. &
250 trim(mode)/='spherical_surface_products' .and. &
251 trim(mode)/='spherical_cloud_products') then
252 write(*,'(a)') 'mt_run_topology_task: mt_profile_spherical applies '// &
253 'only to spherical topology modes'
254 endif
255
256 select case (trim(mode))
257 case ('axis_plane_full_vtu')
258 call mt_run_axis_plane_full_vtu_task()
259 case ('volume_vti')
260 call mt_run_volume_vti_task()
261 case ('arbitrary_plane_products')
262 call mt_run_arbitrary_plane_products_task()
263 case ('seed_products')
264 call mt_run_seed_products_task()
265 case ('axis_plane_csv')
266 call mt_run_axis_plane_csv_task()
267 case ('spherical_surface_products')
268 call mt_run_spherical_surface_products_task()
269 case ('spherical_cloud_products')
270 call mt_run_spherical_cloud_products_task()
271 case default
272 call mpistop('mt_run_topology_task: unknown mt_mode='//trim(mt_mode))
273 end select
274 if (report_rk2) call trace_rk2_stats_report(trim(mode))
275 call trace_rk2_stats_set_enabled(.false.)
276 if (report_rk45) call trace_rk45_stats_report(trim(mode))
277 call trace_rk45_stats_set_enabled(.false.)
278 end subroutine mt_run_topology_task
279
280 subroutine mt_set_default_params()
281 mt_enable=.false.
282 mt_mode=''
283 mt_output_file=''
284 mt_output_prefix=''
285 mt_seed_file=''
286 mt_seed_surface=''
287 mt_seed_layout='endpoint'
288 mt_vtk_detail='minimal'
289 mt_step_control='global_cell_fraction'
290 mt_trace_integrator='rk2'
291 mt_dl=-1.d0
292 mt_step_fraction=0.25d0
293 mt_dl_min=0.d0
294 mt_rk45_atol=1.d-8
295 mt_rk45_rtol=1.d-6
296 mt_rk45_safety=0.9d0
297 mt_rk45_min_shrink=0.2d0
298 mt_rk45_max_grow=5.d0
299 mt_rk45_tangent_floor=1.d0
300 mt_rk45_tangent_rtol=2.d-5
301 mt_max_steps=-1
302 mt_max_steps_factor=2.d0
303 mt_b_min=-1.d0
304 mt_seed_coord=mt_unset_real
305 mt_seed_theta0=mt_unset_real
306 mt_seed_phi0=mt_unset_real
307 mt_seed_alpha=mt_unset_real
308 mt_compute_length=.true.
309 mt_compute_twist=.false.
310 mt_compute_q=.false.
311 mt_compute_qperp=.false.
312 mt_rk2_step_diagnostic=.false.
313 mt_rk45_step_diagnostic=.false.
314 mt_rk45_tangent_diagnostic=.false.
315 mt_rk2_fusion_diagnostic=.false.
316 mt_write_csv=.false.
317 mt_plane=''
318 mt_origin=mt_unset_real
319 mt_e1=mt_unset_real
320 mt_e2=mt_unset_real
321 mt_xmin=mt_unset_real
322 mt_xmax=mt_unset_real
323 mt_ymin=mt_unset_real
324 mt_ymax=mt_unset_real
325 mt_zmin=mt_unset_real
326 mt_zmax=mt_unset_real
327 mt_x0=mt_unset_real
328 mt_y0=mt_unset_real
329 mt_z0=mt_unset_real
330 mt_nx=-1
331 mt_ny=-1
332 mt_nz=-1
333 mt_s1min=mt_unset_real
334 mt_s1max=mt_unset_real
335 mt_s2min=mt_unset_real
336 mt_s2max=mt_unset_real
337 mt_s3min=mt_unset_real
338 mt_s3max=mt_unset_real
339 mt_n1=-1
340 mt_n2=-1
341 mt_n3=-1
342 mt_chunk_nz=-1
343 mt_profile_spherical=.false.
344 end subroutine mt_set_default_params
345
346 subroutine mt_validate_common_params(mode)
347 character(len=*), intent(in) :: mode
348
349 if (len_trim(mode)==0) then
350 call mpistop('mt_run_topology_task requires mt_mode')
351 endif
352 select case (trim(mode))
353 case ('spherical_surface_products','spherical_cloud_products')
354 if (ndim/=3) then
355 call mpistop(trim(mode)//' requires 3D spherical geometry')
356 endif
357 {^ifthreed
358 if (geo_coordinate/=geo_spherical) then
359 call mpistop(trim(mode)//' requires 3D spherical geometry')
360 endif
361 if (periodb(3)) then
362 call mpistop(trim(mode)//' does not yet support periodic phi')
363 endif
364 }
365 case ('seed_products')
366 if (ndim/=3) then
367 call mpistop('seed_products requires 3D Cartesian or spherical geometry')
368 endif
369 {^ifthreed
370 select case (geo_coordinate)
371 case (geo_cartesian,geo_cartesian_stretched,geo_spherical)
372 case default
373 call mpistop('seed_products requires Cartesian or spherical geometry')
374 end select
375 if (geo_coordinate==geo_spherical .and. periodb(3)) then
376 call mpistop('spherical seed_products does not yet support periodic phi')
377 endif
378 }
379 case ('volume_vti')
380 if (ndim/=3) then
381 call mpistop('volume_vti requires 3D Cartesian geometry')
382 endif
383 {^ifthreed
384 select case (geo_coordinate)
385 case (geo_cartesian)
386 ! The VTI sampling grid is user-defined; tracing may interpolate
387 ! through uniform or AMR Cartesian simulation grids.
388 case (geo_cartesian_stretched)
389 ! The VTI sampling grid is uniform Cartesian; tracing may interpolate
390 ! through a stretched Cartesian simulation grid.
391 case default
392 call mpistop('volume_vti requires Cartesian geometry')
393 end select
394 }
395 case ('axis_plane_full_vtu','axis_plane_csv')
396 if (ndim/=3) then
397 call mpistop(trim(mode)//' requires 3D Cartesian geometry')
398 endif
399 {^ifthreed
400 select case (geo_coordinate)
401 case (geo_cartesian)
402 ! Axis-plane output is a seed-surface product; RK2 tracing supports
403 ! both slab-uniform and AMR Cartesian simulation grids.
404 case (geo_cartesian_stretched)
405 case default
406 call mpistop(trim(mode)//' requires Cartesian geometry')
407 end select
408 }
409 case ('arbitrary_plane_products')
410 if (ndim/=3) then
411 call mpistop('arbitrary_plane_products requires 3D Cartesian geometry')
412 endif
413 {^ifthreed
414 select case (geo_coordinate)
415 case (geo_cartesian,geo_cartesian_stretched)
416 case default
417 call mpistop('arbitrary_plane_products requires Cartesian geometry')
418 end select
419 }
420 case default
421 if (ndim/=3 .or. geo_coordinate/=geo_cartesian .or. &
422 .not.slab_uniform) then
423 call mpistop('mt_run_topology_task mode requires 3D uniform Cartesian geometry')
424 endif
425 end select
426 if (len_trim(mt_output_file)==0 .and. &
427 len_trim(mt_output_prefix)==0) then
428 call mpistop('mt_run_topology_task requires mt_output_file or mt_output_prefix')
429 endif
430 select case (mt_lowercase(trim(mt_step_control)))
431 case ('fixed')
432 if (mt_dl<=0.d0) then
433 call mpistop('mt_step_control=fixed requires mt_dL > 0')
434 endif
435 case ('cell_fraction')
436 select case (geo_coordinate)
437 case (geo_cartesian,geo_cartesian_stretched)
438 case (geo_spherical)
439 select case (trim(mode))
440 case ('seed_products','spherical_surface_products', &
441 'spherical_cloud_products')
442 case default
443 call mpistop('mt_step_control=cell_fraction is only supported '// &
444 'for spherical topology modes')
445 end select
446 case default
447 call mpistop('mt_step_control=cell_fraction requires Cartesian or '// &
448 'supported spherical geometry')
449 end select
450 if (mt_step_fraction<=0.d0) then
451 call mpistop('mt_step_control=cell_fraction requires '// &
452 'mt_step_fraction > 0')
453 endif
454 if (mt_dl_min<0.d0) then
455 call mpistop('mt_step_control=cell_fraction requires mt_dL_min >= 0')
456 endif
457 case ('global_cell_fraction')
458 if (mt_step_fraction<=0.d0) then
459 call mpistop('mt_step_control=global_cell_fraction requires '// &
460 'mt_step_fraction > 0')
461 endif
462 if (mt_dl_min<0.d0) then
463 call mpistop('mt_step_control=global_cell_fraction requires mt_dL_min >= 0')
464 endif
465 case default
466 call mpistop('mt_run_topology_task requires mt_step_control=fixed '// &
467 'or cell_fraction/global_cell_fraction')
468 end select
469 if (mt_max_steps<=0 .and. mt_max_steps_factor<=0.d0) then
470 call mpistop('mt_max_steps auto requires mt_max_steps_factor > 0')
471 endif
472 select case (mt_lowercase(trim(mt_vtk_detail)))
473 case ('minimal','full')
474 case default
475 call mpistop('mt_run_topology_task requires mt_vtk_detail=minimal or full')
476 end select
477 end subroutine mt_validate_common_params
478
479 subroutine mt_validate_trace_integrator(mode)
480 character(len=*), intent(in) :: mode
481
482 character(len=mt_task_name_len) :: integrator
483
484 integrator=mt_lowercase(trim(mt_trace_integrator))
485 select case (trim(integrator))
486 case ('rk2')
487 ! RK2 is the default tracing path; product-specific guards live below.
488 case ('rk45_cartesian')
489 if (trim(mode)/='seed_products' .and. trim(mode)/='volume_vti' .and. &
490 trim(mode)/='arbitrary_plane_products' .and. &
491 trim(mode)/='axis_plane_full_vtu' .and. &
492 trim(mode)/='axis_plane_csv') then
493 write(*,'(a)') 'mt_trace_integrator=rk45_cartesian supports '// &
494 'only Cartesian seed_products, volume_vti, arbitrary_plane_products, '// &
495 'or axis-plane products'
496 flush(6)
497 call mpistop('mt_trace_integrator=rk45_cartesian supports '// &
498 'only seed_products, volume_vti, arbitrary_plane_products, '// &
499 'or axis-plane products')
500 endif
501 if (ndim/=3) then
502 call mpistop('mt_trace_integrator=rk45_cartesian requires 3D Cartesian geometry')
503 endif
504 {^ifthreed
505 select case (geo_coordinate)
506 case (geo_cartesian,geo_cartesian_stretched)
507 case default
508 write(*,'(a)') 'mt_trace_integrator=rk45_cartesian is Cartesian-only'
509 flush(6)
510 call mpistop('mt_trace_integrator=rk45_cartesian is Cartesian-only')
511 end select
512 }
513 if (mt_rk45_atol<0.d0 .or. mt_rk45_rtol<0.d0 .or. &
514 mt_rk45_atol+mt_rk45_rtol<=0.d0) then
515 call mpistop('mt_trace_integrator=rk45_cartesian requires '// &
516 'non-negative tolerances with atol+rtol > 0')
517 endif
518 if (mt_rk45_safety<=0.d0 .or. mt_rk45_safety>1.d0) then
519 call mpistop('mt_rk45_safety must be in (0,1]')
520 endif
521 if (mt_rk45_min_shrink<=0.d0 .or. mt_rk45_min_shrink>1.d0) then
522 call mpistop('mt_rk45_min_shrink must be in (0,1]')
523 endif
524 if (mt_rk45_max_grow<1.d0) then
525 call mpistop('mt_rk45_max_grow must be >= 1')
526 endif
527 if (mt_rk45_tangent_floor<=0.d0) then
528 call mpistop('mt_rk45_tangent_floor must be > 0')
529 endif
530 if (mt_rk45_tangent_rtol<=0.d0) then
531 call mpistop('mt_rk45_tangent_rtol must be > 0')
532 endif
533 case ('rk45_spherical')
534 if (trim(mode)/='seed_products' .and. &
535 trim(mode)/='spherical_cloud_products' .and. &
536 trim(mode)/='spherical_surface_products') then
537 write(*,'(a)') 'mt_trace_integrator=rk45_spherical supports '// &
538 'only spherical seed_products, spherical_cloud_products, '// &
539 'or spherical_surface_products'
540 flush(6)
541 call mpistop('mt_trace_integrator=rk45_spherical supports '// &
542 'only seed_products, spherical_cloud_products, '// &
543 'or spherical_surface_products')
544 endif
545 if (ndim/=3) then
546 call mpistop('mt_trace_integrator=rk45_spherical requires 3D spherical geometry')
547 endif
548 {^ifthreed
549 if (geo_coordinate/=geo_spherical) then
550 write(*,'(a)') 'mt_trace_integrator=rk45_spherical is spherical-only'
551 flush(6)
552 call mpistop('mt_trace_integrator=rk45_spherical is spherical-only')
553 endif
554 if (periodb(3)) then
555 call mpistop('mt_trace_integrator=rk45_spherical does not yet support periodic phi')
556 endif
557 }
558 if (mt_compute_q) then
559 {^ifthreed
560 if (geo_coordinate/=geo_spherical) then
561 call mpistop('mt_trace_integrator=rk45_spherical standard '// &
562 'logQ currently requires spherical geometry')
563 endif
564 }
565 endif
566 if (mt_rk45_atol<0.d0 .or. mt_rk45_rtol<0.d0 .or. &
567 mt_rk45_atol+mt_rk45_rtol<=0.d0) then
568 call mpistop('mt_trace_integrator=rk45_spherical requires '// &
569 'non-negative tolerances with atol+rtol > 0')
570 endif
571 if (mt_rk45_safety<=0.d0 .or. mt_rk45_safety>1.d0) then
572 call mpistop('mt_rk45_safety must be in (0,1]')
573 endif
574 if (mt_rk45_min_shrink<=0.d0 .or. mt_rk45_min_shrink>1.d0) then
575 call mpistop('mt_rk45_min_shrink must be in (0,1]')
576 endif
577 if (mt_rk45_max_grow<1.d0) then
578 call mpistop('mt_rk45_max_grow must be >= 1')
579 endif
580 if (mt_rk45_tangent_floor<=0.d0) then
581 call mpistop('mt_rk45_tangent_floor must be > 0')
582 endif
583 if (mt_rk45_tangent_rtol<=0.d0) then
584 call mpistop('mt_rk45_tangent_rtol must be > 0')
585 endif
586 case default
587 call mpistop('mt_trace_integrator must be rk2, rk45_cartesian, or rk45_spherical')
588 end select
589 if (mt_rk45_tangent_diagnostic) then
590 if (trim(mode)/='seed_products') then
591 call mpistop('mt_rk45_tangent_diagnostic requires seed_products')
592 endif
593 if (trim(integrator)/='rk45_cartesian') then
594 call mpistop('mt_rk45_tangent_diagnostic requires '// &
595 'mt_trace_integrator=rk45_cartesian')
596 endif
597 if (mt_compute_q .or. mt_compute_qperp) then
598 call mpistop('mt_rk45_tangent_diagnostic is q0 diagnostic-only; '// &
599 'disable public Q and Qperp')
600 endif
601 if (ndim/=3 .or. .not.slab_uniform) then
602 call mpistop('mt_rk45_tangent_diagnostic requires 3D uniform Cartesian geometry')
603 endif
604 {^ifthreed
605 if (geo_coordinate/=geo_cartesian) then
606 call mpistop('mt_rk45_tangent_diagnostic requires Cartesian geometry')
607 endif
608 }
609 endif
610 if (mt_rk2_fusion_diagnostic) then
611 if (trim(mode)/='seed_products') then
612 call mpistop('mt_rk2_fusion_diagnostic requires seed_products')
613 endif
614 if (trim(integrator)/='rk2') then
615 call mpistop('mt_rk2_fusion_diagnostic requires '// &
616 'mt_trace_integrator=rk2')
617 endif
618 if (.not.mt_compute_twist) then
619 call mpistop('mt_rk2_fusion_diagnostic requires twist diagnostics')
620 endif
621 if (mt_compute_q .or. mt_compute_qperp) then
622 call mpistop('mt_rk2_fusion_diagnostic is q0 diagnostic-only; '// &
623 'disable public Q and Qperp')
624 endif
625 endif
626 end subroutine mt_validate_trace_integrator
627
628 subroutine mt_apply_trace_step_control()
629 character(len=mt_task_name_len) :: step_mode
630 double precision :: hmin,dl_eff,dl_cap
631 integer :: status
632
633 step_mode=mt_lowercase(trim(mt_step_control))
634 select case (trim(step_mode))
635 case ('cell_fraction')
636 if ((geo_coordinate==geo_cartesian .or. &
637 geo_coordinate==geo_cartesian_stretched .or. &
638 geo_coordinate==geo_spherical) .and. mt_dl<=0.d0) then
639 dl_cap=mt_domain_diagonal()
640 if (dl_cap<=0.d0) then
641 call mpistop('mt_step_control=cell_fraction could not determine '// &
642 'domain step cap')
643 endif
644 mt_dl=dl_cap
645 write(*,'(a,es16.8,a,es16.8,a,es16.8)') &
646 'mt_step_control=cell_fraction: mt_step_fraction=', &
647 mt_step_fraction,', automatic dL_cap=',mt_dl, &
648 ', mt_dL_min=',mt_dl_min
649 else
650 write(*,'(a,es16.8,a,es16.8,a,es16.8)') &
651 'mt_step_control=cell_fraction: mt_step_fraction=', &
652 mt_step_fraction,', mt_dL_cap=',mt_dl, &
653 ', mt_dL_min=',mt_dl_min
654 endif
655 call trace_set_step_control('cell_fraction',mt_step_fraction,mt_dl_min)
656 case ('global_cell_fraction')
657 select case (geo_coordinate)
658 case (geo_cartesian,geo_cartesian_stretched)
659 call trace_cartesian_global_min_cell_size(hmin,status)
660 case (geo_spherical)
661 call trace_spherical_global_min_cell_size(hmin,status)
662 case default
663 status=trace_status_unsupported_geometry
664 hmin=-1.d0
665 end select
666 if (status/=trace_status_active .or. hmin<=0.d0) then
667 call mpistop('mt_step_control=global_cell_fraction could not determine h_global_min')
668 endif
669 dl_eff=mt_step_fraction*hmin
670 if (mt_dl>0.d0) dl_eff=min(dl_eff,mt_dl)
671 if (mt_dl_min>0.d0) then
672 if (mt_dl>0.d0) then
673 dl_eff=max(dl_eff,min(mt_dl_min,mt_dl))
674 else
675 dl_eff=max(dl_eff,mt_dl_min)
676 endif
677 endif
678 if (dl_eff<=0.d0) then
679 call mpistop('mt_step_control=global_cell_fraction produced non-positive mt_dL')
680 endif
681 if (mt_dl>0.d0) then
682 write(*,'(a,es16.8,a,es16.8,a,es16.8,a,es16.8)') &
683 'mt_step_control=global_cell_fraction: h_global_min=',hmin, &
684 ', mt_step_fraction=',mt_step_fraction,', mt_dL_cap=',mt_dl, &
685 ', effective_mt_dL=',dl_eff
686 else
687 write(*,'(a,es16.8,a,es16.8,a,es16.8)') &
688 'mt_step_control=global_cell_fraction: h_global_min=',hmin, &
689 ', mt_step_fraction=',mt_step_fraction,', effective_mt_dL=',dl_eff
690 endif
691 mt_dl=dl_eff
692 call trace_set_step_control('fixed',mt_step_fraction,mt_dl_min)
693 case default
694 call trace_set_step_control('fixed',mt_step_fraction,mt_dl_min)
695 end select
696 end subroutine mt_apply_trace_step_control
697
698 subroutine mt_apply_auto_max_steps()
699 character(len=mt_task_name_len) :: step_mode
700 double precision :: hmin,step_est,ldiag,nsteps_real
701 integer :: status
702
703 if (mt_max_steps>0) return
704
705 ldiag=mt_domain_diagonal()
706 if (ldiag<=0.d0) then
707 call mpistop('mt_max_steps auto could not determine domain diagonal')
708 endif
709
710 step_mode=mt_lowercase(trim(mt_step_control))
711 select case (trim(step_mode))
712 case ('fixed')
713 step_est=mt_dl
714 case ('cell_fraction','global_cell_fraction')
715 select case (geo_coordinate)
716 case (geo_cartesian,geo_cartesian_stretched)
717 call trace_cartesian_global_min_cell_size(hmin,status)
718 case (geo_spherical)
719 call trace_spherical_global_min_cell_size(hmin,status)
720 case default
721 status=trace_status_unsupported_geometry
722 hmin=-1.d0
723 end select
724 if (status/=trace_status_active .or. hmin<=0.d0) then
725 call mpistop('mt_max_steps auto could not determine h_global_min')
726 endif
727 step_est=mt_step_fraction*hmin
728 if (mt_dl>0.d0) step_est=min(step_est,mt_dl)
729 case default
730 step_est=mt_dl
731 end select
732
733 if (step_est<=0.d0) then
734 call mpistop('mt_max_steps auto produced non-positive step estimate')
735 endif
736 nsteps_real=mt_max_steps_factor*ldiag/step_est
737 if (nsteps_real>dble(huge(mt_max_steps)-1)) then
738 call mpistop('mt_max_steps auto estimate exceeds integer range')
739 endif
740 mt_max_steps=max(1,ceiling(nsteps_real))
741 write(*,'(a,es16.8,a,es16.8,a,es16.8,a,es16.8,a,i0)') &
742 'mt_max_steps auto: Ldiag=',ldiag,', step_est=',step_est, &
743 ', factor=',mt_max_steps_factor,', nsteps_real=',nsteps_real, &
744 ', mt_max_steps=',mt_max_steps
745 end subroutine mt_apply_auto_max_steps
746
747 double precision function mt_domain_diagonal() result(Ldiag)
748 integer :: i,j,k,n,m
749 double precision :: r,theta,phi,dist
750 double precision :: corners(8,3),dx(3)
751
752 ldiag=abs(xprobmax1-xprobmin1)
753 {^ifthreed
754 if (geo_coordinate==geo_spherical) then
755 n=0
756 do i=0,1
757 if (i==0) then
758 r=xprobmin1
759 else
760 r=xprobmax1
761 endif
762 do j=0,1
763 if (j==0) then
764 theta=xprobmin2
765 else
766 theta=xprobmax2
767 endif
768 do k=0,1
769 if (k==0) then
770 phi=xprobmin3
771 else
772 phi=xprobmax3
773 endif
774 n=n+1
775 corners(n,1)=r*dsin(theta)*dcos(phi)
776 corners(n,2)=r*dsin(theta)*dsin(phi)
777 corners(n,3)=r*dcos(theta)
778 end do
779 end do
780 end do
781 ldiag=0.d0
782 do i=1,n-1
783 do j=i+1,n
784 do m=1,3
785 dx(m)=corners(i,m)-corners(j,m)
786 end do
787 dist=dsqrt(sum(dx*dx))
788 ldiag=max(ldiag,dist)
789 end do
790 end do
791 else
792 ldiag=dsqrt((xprobmax1-xprobmin1)**2+ &
793 (xprobmax2-xprobmin2)**2+(xprobmax3-xprobmin3)**2)
794 endif
795 }
796 end function mt_domain_diagonal
797
798 subroutine mt_run_axis_plane_full_vtu_task()
799 character(len=mt_task_name_len) :: plane
800 character(len=mt_task_name_len) :: output_file
801 logical :: minimal_output
802
803 plane=mt_lowercase(trim(mt_plane))
804 minimal_output=.not.mt_vtk_detail_is_full()
805 if (minimal_output) then
806 call mt_resolve_output_file('axis_plane_full_vtu','.vti', &
807 '_'//trim(plane)//'_minimal.vti',output_file)
808 else
809 call mt_resolve_output_file('axis_plane_full_vtu','.vtu', &
810 '_'//trim(plane)//'_full.vtu',output_file)
811 endif
812 if (.not.minimal_output .and. &
813 (mt_compute_twist .or. mt_compute_q .or. mt_compute_qperp)) then
814 write(*,'(a)') 'mt_run_topology_task: axis_plane_full_vtu ignores compute flags'
815 write(*,'(a)') 'mt_run_topology_task: it always writes full plane products'
816 endif
817
818 select case (trim(plane))
819 case ('xy')
820 call mt_require_real('mt_xmin',mt_xmin)
821 call mt_require_real('mt_xmax',mt_xmax)
822 call mt_require_real('mt_ymin',mt_ymin)
823 call mt_require_real('mt_ymax',mt_ymax)
824 call mt_require_real('mt_z0',mt_z0)
825 call mt_require_positive_int('mt_nx',mt_nx)
826 call mt_require_positive_int('mt_ny',mt_ny)
827 call mt_require_ordered('mt_xmin','mt_xmax',mt_xmin,mt_xmax)
828 call mt_require_ordered('mt_ymin','mt_ymax',mt_ymin,mt_ymax)
829 if (minimal_output) then
830 write(*,'(a)') 'mt_run_topology_task: writing axis-plane minimal VTI '//trim(output_file)
831 if (mt_b_min>0.d0) then
832 call mt_qsl_plane_vti_xy(mt_xmin,mt_xmax,mt_nx,mt_ymin,mt_ymax, &
833 mt_ny,mt_z0,mt_dl,mt_max_steps,trim(output_file), &
834 mt_compute_length,mt_compute_twist,mt_compute_q, &
835 mt_compute_qperp,b_min=mt_b_min)
836 else
837 call mt_qsl_plane_vti_xy(mt_xmin,mt_xmax,mt_nx,mt_ymin,mt_ymax, &
838 mt_ny,mt_z0,mt_dl,mt_max_steps,trim(output_file), &
839 mt_compute_length,mt_compute_twist,mt_compute_q, &
840 mt_compute_qperp)
841 endif
842 else
843 write(*,'(a)') 'mt_run_topology_task: writing axis-plane full VTU '//trim(output_file)
844 if (mt_b_min>0.d0) then
845 call mt_qsl_plane_vtu_xy(mt_xmin,mt_xmax,mt_nx,mt_ymin,mt_ymax, &
846 mt_ny,mt_z0,mt_dl,mt_max_steps,trim(output_file), &
847 b_min=mt_b_min)
848 else
849 call mt_qsl_plane_vtu_xy(mt_xmin,mt_xmax,mt_nx,mt_ymin,mt_ymax, &
850 mt_ny,mt_z0,mt_dl,mt_max_steps,trim(output_file))
851 endif
852 endif
853 case ('xz')
854 call mt_require_real('mt_xmin',mt_xmin)
855 call mt_require_real('mt_xmax',mt_xmax)
856 call mt_require_real('mt_zmin',mt_zmin)
857 call mt_require_real('mt_zmax',mt_zmax)
858 call mt_require_real('mt_y0',mt_y0)
859 call mt_require_positive_int('mt_nx',mt_nx)
860 call mt_require_positive_int('mt_nz',mt_nz)
861 call mt_require_ordered('mt_xmin','mt_xmax',mt_xmin,mt_xmax)
862 call mt_require_ordered('mt_zmin','mt_zmax',mt_zmin,mt_zmax)
863 if (minimal_output) then
864 write(*,'(a)') 'mt_run_topology_task: writing axis-plane minimal VTI '//trim(output_file)
865 if (mt_b_min>0.d0) then
866 call mt_qsl_plane_vti_xz(mt_xmin,mt_xmax,mt_nx,mt_zmin,mt_zmax, &
867 mt_nz,mt_y0,mt_dl,mt_max_steps,trim(output_file), &
868 mt_compute_length,mt_compute_twist,mt_compute_q, &
869 mt_compute_qperp,b_min=mt_b_min)
870 else
871 call mt_qsl_plane_vti_xz(mt_xmin,mt_xmax,mt_nx,mt_zmin,mt_zmax, &
872 mt_nz,mt_y0,mt_dl,mt_max_steps,trim(output_file), &
873 mt_compute_length,mt_compute_twist,mt_compute_q, &
874 mt_compute_qperp)
875 endif
876 else
877 write(*,'(a)') 'mt_run_topology_task: writing axis-plane full VTU '//trim(output_file)
878 if (mt_b_min>0.d0) then
879 call mt_qsl_plane_vtu_xz(mt_xmin,mt_xmax,mt_nx,mt_zmin,mt_zmax, &
880 mt_nz,mt_y0,mt_dl,mt_max_steps,trim(output_file), &
881 b_min=mt_b_min)
882 else
883 call mt_qsl_plane_vtu_xz(mt_xmin,mt_xmax,mt_nx,mt_zmin,mt_zmax, &
884 mt_nz,mt_y0,mt_dl,mt_max_steps,trim(output_file))
885 endif
886 endif
887 case ('yz')
888 call mt_require_real('mt_ymin',mt_ymin)
889 call mt_require_real('mt_ymax',mt_ymax)
890 call mt_require_real('mt_zmin',mt_zmin)
891 call mt_require_real('mt_zmax',mt_zmax)
892 call mt_require_real('mt_x0',mt_x0)
893 call mt_require_positive_int('mt_ny',mt_ny)
894 call mt_require_positive_int('mt_nz',mt_nz)
895 call mt_require_ordered('mt_ymin','mt_ymax',mt_ymin,mt_ymax)
896 call mt_require_ordered('mt_zmin','mt_zmax',mt_zmin,mt_zmax)
897 if (minimal_output) then
898 write(*,'(a)') 'mt_run_topology_task: writing axis-plane minimal VTI '//trim(output_file)
899 if (mt_b_min>0.d0) then
900 call mt_qsl_plane_vti_yz(mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax, &
901 mt_nz,mt_x0,mt_dl,mt_max_steps,trim(output_file), &
902 mt_compute_length,mt_compute_twist,mt_compute_q, &
903 mt_compute_qperp,b_min=mt_b_min)
904 else
905 call mt_qsl_plane_vti_yz(mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax, &
906 mt_nz,mt_x0,mt_dl,mt_max_steps,trim(output_file), &
907 mt_compute_length,mt_compute_twist,mt_compute_q, &
908 mt_compute_qperp)
909 endif
910 else
911 write(*,'(a)') 'mt_run_topology_task: writing axis-plane full VTU '//trim(output_file)
912 if (mt_b_min>0.d0) then
913 call mt_qsl_plane_vtu_yz(mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax, &
914 mt_nz,mt_x0,mt_dl,mt_max_steps,trim(output_file), &
915 b_min=mt_b_min)
916 else
917 call mt_qsl_plane_vtu_yz(mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax, &
918 mt_nz,mt_x0,mt_dl,mt_max_steps,trim(output_file))
919 endif
920 endif
921 case default
922 call mpistop('mt_run_topology_task: axis_plane_full_vtu requires mt_plane=xy, xz, or yz')
923 end select
924 end subroutine mt_run_axis_plane_full_vtu_task
925
926 subroutine mt_run_axis_plane_csv_task()
927 character(len=mt_task_name_len) :: plane
928 character(len=mt_task_name_len) :: length_csv,twist_csv
929 character(len=mt_task_name_len) :: q_csv
930 character(len=mt_task_name_len) :: qperp_csv
931
932 if (len_trim(mt_output_prefix)==0) then
933 call mpistop('axis_plane_csv requires mt_output_prefix')
934 endif
935 if (len_trim(mt_output_file)>0) then
936 write(*,'(a)') 'mt_run_topology_task: axis_plane_csv ignores mt_output_file'
937 write(*,'(a)') 'mt_run_topology_task: axis_plane_csv uses mt_output_prefix for CSV outputs'
938 endif
939
940 plane=mt_lowercase(trim(mt_plane))
941 call mt_resolve_prefix_file('_'//trim(plane)//'_length.csv', &
942 length_csv,'axis_plane_csv length requires mt_output_prefix')
943 twist_csv=''
944 q_csv=''
945 qperp_csv=''
946 if (mt_compute_twist) then
947 call mt_resolve_prefix_file('_'//trim(plane)//'_twist.csv', &
948 twist_csv,'axis_plane_csv twist requires mt_output_prefix')
949 endif
950 if (mt_compute_q) then
951 call mt_resolve_prefix_file('_'//trim(plane)//'_q.csv', &
952 q_csv,'axis_plane_csv Q requires mt_output_prefix')
953 endif
954 if (mt_compute_qperp) then
955 call mt_resolve_prefix_file('_'//trim(plane)//'_qperp_method2.csv', &
956 qperp_csv,'axis_plane_csv Qperp requires mt_output_prefix')
957 endif
958
959 select case (trim(plane))
960 case ('xy')
961 call mt_require_real('mt_xmin',mt_xmin)
962 call mt_require_real('mt_xmax',mt_xmax)
963 call mt_require_real('mt_ymin',mt_ymin)
964 call mt_require_real('mt_ymax',mt_ymax)
965 call mt_require_real('mt_z0',mt_z0)
966 call mt_require_positive_int('mt_nx',mt_nx)
967 call mt_require_positive_int('mt_ny',mt_ny)
968 call mt_require_ordered('mt_xmin','mt_xmax',mt_xmin,mt_xmax)
969 call mt_require_ordered('mt_ymin','mt_ymax',mt_ymin,mt_ymax)
970 if (mt_b_min>0.d0) then
971 call mt_axis_plane_products_csv_axis(mt_xmin,mt_xmax,mt_nx, &
972 mt_ymin,mt_ymax,mt_ny,mt_z0,1,2,3,mt_dl,mt_max_steps, &
973 trim(length_csv),trim(twist_csv),trim(q_csv), &
974 trim(qperp_csv),'mt_axis_plane_products_csv_xy','ix,iy', &
975 'ix,iy',b_min=mt_b_min)
976 else
977 call mt_axis_plane_products_csv_axis(mt_xmin,mt_xmax,mt_nx, &
978 mt_ymin,mt_ymax,mt_ny,mt_z0,1,2,3,mt_dl,mt_max_steps, &
979 trim(length_csv),trim(twist_csv),trim(q_csv), &
980 trim(qperp_csv),'mt_axis_plane_products_csv_xy','ix,iy', &
981 'ix,iy')
982 endif
983 case ('xz')
984 call mt_require_real('mt_xmin',mt_xmin)
985 call mt_require_real('mt_xmax',mt_xmax)
986 call mt_require_real('mt_zmin',mt_zmin)
987 call mt_require_real('mt_zmax',mt_zmax)
988 call mt_require_real('mt_y0',mt_y0)
989 call mt_require_positive_int('mt_nx',mt_nx)
990 call mt_require_positive_int('mt_nz',mt_nz)
991 call mt_require_ordered('mt_xmin','mt_xmax',mt_xmin,mt_xmax)
992 call mt_require_ordered('mt_zmin','mt_zmax',mt_zmin,mt_zmax)
993 if (mt_b_min>0.d0) then
994 call mt_axis_plane_products_csv_axis(mt_xmin,mt_xmax,mt_nx, &
995 mt_zmin,mt_zmax,mt_nz,mt_y0,1,3,2,mt_dl,mt_max_steps, &
996 trim(length_csv),trim(twist_csv),trim(q_csv), &
997 trim(qperp_csv),'mt_axis_plane_products_csv_xz','ix,iz', &
998 'i,j',b_min=mt_b_min)
999 else
1000 call mt_axis_plane_products_csv_axis(mt_xmin,mt_xmax,mt_nx, &
1001 mt_zmin,mt_zmax,mt_nz,mt_y0,1,3,2,mt_dl,mt_max_steps, &
1002 trim(length_csv),trim(twist_csv),trim(q_csv), &
1003 trim(qperp_csv),'mt_axis_plane_products_csv_xz','ix,iz', &
1004 'i,j')
1005 endif
1006 case ('yz')
1007 call mt_require_real('mt_ymin',mt_ymin)
1008 call mt_require_real('mt_ymax',mt_ymax)
1009 call mt_require_real('mt_zmin',mt_zmin)
1010 call mt_require_real('mt_zmax',mt_zmax)
1011 call mt_require_real('mt_x0',mt_x0)
1012 call mt_require_positive_int('mt_ny',mt_ny)
1013 call mt_require_positive_int('mt_nz',mt_nz)
1014 call mt_require_ordered('mt_ymin','mt_ymax',mt_ymin,mt_ymax)
1015 call mt_require_ordered('mt_zmin','mt_zmax',mt_zmin,mt_zmax)
1016 if (mt_b_min>0.d0) then
1017 call mt_axis_plane_products_csv_axis(mt_ymin,mt_ymax,mt_ny, &
1018 mt_zmin,mt_zmax,mt_nz,mt_x0,2,3,1,mt_dl,mt_max_steps, &
1019 trim(length_csv),trim(twist_csv),trim(q_csv), &
1020 trim(qperp_csv),'mt_axis_plane_products_csv_yz','iy,iz', &
1021 'i,j',b_min=mt_b_min)
1022 else
1023 call mt_axis_plane_products_csv_axis(mt_ymin,mt_ymax,mt_ny, &
1024 mt_zmin,mt_zmax,mt_nz,mt_x0,2,3,1,mt_dl,mt_max_steps, &
1025 trim(length_csv),trim(twist_csv),trim(q_csv), &
1026 trim(qperp_csv),'mt_axis_plane_products_csv_yz','iy,iz', &
1027 'i,j')
1028 endif
1029 case default
1030 call mpistop('mt_run_topology_task: axis_plane_csv requires mt_plane=xy, xz, or yz')
1031 end select
1032
1033 write(*,'(a)') 'mt_run_topology_task: wrote axis-plane CSV length '// &
1034 trim(length_csv)
1035 if (mt_compute_twist) write(*,'(a)') &
1036 'mt_run_topology_task: wrote axis-plane CSV twist '//trim(twist_csv)
1037 if (mt_compute_q) write(*,'(a)') &
1038 'mt_run_topology_task: wrote axis-plane CSV Q '//trim(q_csv)
1039 if (mt_compute_qperp) write(*,'(a)') &
1040 'mt_run_topology_task: wrote axis-plane CSV Qperp '//trim(qperp_csv)
1041 end subroutine mt_run_axis_plane_csv_task
1042
1043 subroutine mt_run_volume_vti_task()
1044 character(len=mt_task_name_len) :: output_file
1045
1046 call mt_resolve_output_file('volume_vti','.vti','_volume.vti', &
1047 output_file)
1048 call mt_require_real('mt_xmin',mt_xmin)
1049 call mt_require_real('mt_xmax',mt_xmax)
1050 call mt_require_real('mt_ymin',mt_ymin)
1051 call mt_require_real('mt_ymax',mt_ymax)
1052 call mt_require_real('mt_zmin',mt_zmin)
1053 call mt_require_real('mt_zmax',mt_zmax)
1054 call mt_require_positive_int('mt_nx',mt_nx)
1055 call mt_require_positive_int('mt_ny',mt_ny)
1056 call mt_require_positive_int('mt_nz',mt_nz)
1057 call mt_require_ordered('mt_xmin','mt_xmax',mt_xmin,mt_xmax)
1058 call mt_require_ordered('mt_ymin','mt_ymax',mt_ymin,mt_ymax)
1059 call mt_require_ordered('mt_zmin','mt_zmax',mt_zmin,mt_zmax)
1060 write(*,'(a)') 'mt_run_topology_task: writing volume VTI '//trim(output_file)
1061 if (mt_b_min>0.d0) then
1062 if (mt_chunk_nz>0) then
1063 call mt_fieldline_products_volume_vti(mt_xmin,mt_xmax,mt_nx, &
1064 mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax,mt_nz, &
1065 mt_dl,mt_max_steps,trim(output_file),b_min=mt_b_min, &
1066 compute_twist=mt_compute_twist, &
1067 compute_length=mt_compute_length, &
1068 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1069 chunk_nz=mt_chunk_nz)
1070 else
1071 call mt_fieldline_products_volume_vti(mt_xmin,mt_xmax,mt_nx, &
1072 mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax,mt_nz, &
1073 mt_dl,mt_max_steps,trim(output_file),b_min=mt_b_min, &
1074 compute_twist=mt_compute_twist, &
1075 compute_length=mt_compute_length, &
1076 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp)
1077 endif
1078 else
1079 if (mt_chunk_nz>0) then
1080 call mt_fieldline_products_volume_vti(mt_xmin,mt_xmax,mt_nx, &
1081 mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax,mt_nz, &
1082 mt_dl,mt_max_steps,trim(output_file), &
1083 compute_twist=mt_compute_twist, &
1084 compute_length=mt_compute_length, &
1085 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1086 chunk_nz=mt_chunk_nz)
1087 else
1088 call mt_fieldline_products_volume_vti(mt_xmin,mt_xmax,mt_nx, &
1089 mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax,mt_nz, &
1090 mt_dl,mt_max_steps,trim(output_file), &
1091 compute_twist=mt_compute_twist, &
1092 compute_length=mt_compute_length, &
1093 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp)
1094 endif
1095 endif
1096 end subroutine mt_run_volume_vti_task
1097
1098 subroutine mt_run_arbitrary_plane_products_task()
1099 character(len=mt_task_name_len) :: vtu_file,csv_file
1100
1101 call mt_resolve_output_file('arbitrary_plane_products','.vtu', &
1102 '_arbitrary_plane_products.vtu',vtu_file)
1103 csv_file=''
1104 if (mt_write_csv) then
1105 call mt_resolve_prefix_file('_arbitrary_plane_products.csv',csv_file, &
1106 'arbitrary_plane_products CSV requires mt_output_prefix')
1107 endif
1108 call mt_require_real('mt_origin(1)',mt_origin(1))
1109 call mt_require_real('mt_origin(2)',mt_origin(2))
1110 call mt_require_real('mt_origin(3)',mt_origin(3))
1111 call mt_require_real('mt_e1(1)',mt_e1(1))
1112 call mt_require_real('mt_e1(2)',mt_e1(2))
1113 call mt_require_real('mt_e1(3)',mt_e1(3))
1114 call mt_require_real('mt_e2(1)',mt_e2(1))
1115 call mt_require_real('mt_e2(2)',mt_e2(2))
1116 call mt_require_real('mt_e2(3)',mt_e2(3))
1117 call mt_require_real('mt_s1min',mt_s1min)
1118 call mt_require_real('mt_s1max',mt_s1max)
1119 call mt_require_real('mt_s2min',mt_s2min)
1120 call mt_require_real('mt_s2max',mt_s2max)
1121 call mt_require_positive_int('mt_n1',mt_n1)
1122 call mt_require_positive_int('mt_n2',mt_n2)
1123 call mt_require_ordered('mt_s1min','mt_s1max',mt_s1min,mt_s1max)
1124 call mt_require_ordered('mt_s2min','mt_s2max',mt_s2min,mt_s2max)
1125
1126 write(*,'(a)') 'mt_run_topology_task: writing arbitrary-plane VTU '// &
1127 trim(vtu_file)
1128 if (mt_write_csv) then
1129 write(*,'(a)') 'mt_run_topology_task: writing arbitrary-plane CSV '// &
1130 trim(csv_file)
1131 endif
1132
1133 if (mt_b_min>0.d0) then
1134 call mt_fieldline_products_plane_arbitrary(mt_origin(1:ndim), &
1135 mt_e1(1:ndim),mt_e2(1:ndim),mt_s1min,mt_s1max,mt_n1, &
1136 mt_s2min,mt_s2max,mt_n2,mt_dl,mt_max_steps,trim(csv_file), &
1137 b_min=mt_b_min,compute_length=mt_compute_length, &
1138 compute_twist=mt_compute_twist, &
1139 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1140 vtu_file=trim(vtu_file),write_csv=mt_write_csv)
1141 else
1142 call mt_fieldline_products_plane_arbitrary(mt_origin(1:ndim), &
1143 mt_e1(1:ndim),mt_e2(1:ndim),mt_s1min,mt_s1max,mt_n1, &
1144 mt_s2min,mt_s2max,mt_n2,mt_dl,mt_max_steps,trim(csv_file), &
1145 compute_length=mt_compute_length, &
1146 compute_twist=mt_compute_twist, &
1147 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1148 vtu_file=trim(vtu_file),write_csv=mt_write_csv)
1149 endif
1150 end subroutine mt_run_arbitrary_plane_products_task
1151
1152 subroutine mt_run_seed_products_task()
1153 character(len=mt_task_name_len) :: csv_file,vtu_file,diag_file
1154 character(len=mt_task_name_len) :: rk2_diag_file
1155 double precision, allocatable :: seeds(:,:)
1156 integer :: nseed
1157
1158 if (len_trim(mt_output_prefix)==0) then
1159 call mpistop('seed_products requires mt_output_prefix')
1160 endif
1161 if (len_trim(mt_output_file)>0) then
1162 write(*,'(a)') 'mt_run_topology_task: seed_products ignores mt_output_file'
1163 write(*,'(a)') 'mt_run_topology_task: seed_products uses mt_output_prefix for CSV and VTU'
1164 endif
1165 if (len_trim(mt_seed_file)==0) then
1166 call mpistop('seed_products requires mt_seed_file')
1167 endif
1168
1169 csv_file=''
1170 if (mt_write_csv) then
1171 call mt_resolve_prefix_file('_seed_products.csv',csv_file, &
1172 'seed_products CSV requires mt_output_prefix')
1173 endif
1174 call mt_resolve_prefix_file('_seed_products.vtu',vtu_file, &
1175 'seed_products VTU requires mt_output_prefix')
1176 if (mt_rk45_tangent_diagnostic) then
1177 call mt_resolve_prefix_file('_rk45_tangent_diag.csv',diag_file, &
1178 'seed_products RK45 tangent diagnostic requires mt_output_prefix')
1179 endif
1180 if (mt_rk2_fusion_diagnostic) then
1181 call mt_resolve_prefix_file('_rk2_fusion_diag.csv',rk2_diag_file, &
1182 'seed_products RK2 fusion diagnostic requires mt_output_prefix')
1183 endif
1184 call mt_read_seed_file(trim(mt_seed_file),seeds,nseed)
1185
1186 if (mt_write_csv) write(*,'(a)') &
1187 'mt_run_topology_task: writing seed-products CSV '//trim(csv_file)
1188 write(*,'(a)') 'mt_run_topology_task: writing seed-products VTU '// &
1189 trim(vtu_file)
1190
1191 if (mt_b_min>0.d0) then
1192 call mt_fieldline_products_seeds(seeds,nseed,mt_dl,mt_max_steps, &
1193 trim(csv_file),b_min=mt_b_min,compute_length=mt_compute_length, &
1194 compute_twist=mt_compute_twist, &
1195 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1196 vtu_file=trim(vtu_file))
1197 if (mt_rk45_tangent_diagnostic) then
1198 write(*,'(a)') 'mt_run_topology_task: writing RK45 tangent '// &
1199 'diagnostic CSV '//trim(diag_file)
1200 call mt_rk45_tangent_diagnostic_seeds(seeds,nseed,mt_dl, &
1201 mt_max_steps,trim(diag_file),b_min=mt_b_min)
1202 endif
1203 if (mt_rk2_fusion_diagnostic) then
1204 write(*,'(a)') 'mt_run_topology_task: writing RK2 fusion '// &
1205 'diagnostic CSV '//trim(rk2_diag_file)
1206 call mt_rk2_fusion_diagnostic_seeds(seeds,nseed,mt_dl, &
1207 mt_max_steps,trim(rk2_diag_file),b_min=mt_b_min)
1208 endif
1209 else
1210 call mt_fieldline_products_seeds(seeds,nseed,mt_dl,mt_max_steps, &
1211 trim(csv_file),compute_length=mt_compute_length, &
1212 compute_twist=mt_compute_twist, &
1213 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1214 vtu_file=trim(vtu_file))
1215 if (mt_rk45_tangent_diagnostic) then
1216 write(*,'(a)') 'mt_run_topology_task: writing RK45 tangent '// &
1217 'diagnostic CSV '//trim(diag_file)
1218 call mt_rk45_tangent_diagnostic_seeds(seeds,nseed,mt_dl, &
1219 mt_max_steps,trim(diag_file))
1220 endif
1221 if (mt_rk2_fusion_diagnostic) then
1222 write(*,'(a)') 'mt_run_topology_task: writing RK2 fusion '// &
1223 'diagnostic CSV '//trim(rk2_diag_file)
1224 call mt_rk2_fusion_diagnostic_seeds(seeds,nseed,mt_dl, &
1225 mt_max_steps,trim(rk2_diag_file))
1226 endif
1227 endif
1228
1229 deallocate(seeds)
1230 end subroutine mt_run_seed_products_task
1231
1232 subroutine mt_run_spherical_surface_products_task()
1233 character(len=mt_task_name_len) :: surface,csv_file,vtu_file,suffix
1234 double precision :: seed_coord,s1_min,s1_max,s2_min,s2_max
1235 double precision :: seed_theta0,seed_phi0,seed_alpha
1236
1237 surface=mt_lowercase(trim(mt_seed_surface))
1238 if (len_trim(surface)==0) surface='rmin'
1239 select case (trim(surface))
1240 case ('rmin')
1241 seed_coord=xprobmin1
1242 case ('rconst','r_const')
1243 surface='rconst'
1244 call mt_require_real('mt_seed_coord',mt_seed_coord)
1245 seed_coord=mt_seed_coord
1246 if (seed_coord<xprobmin1 .or. seed_coord>xprobmax1) then
1247 call mpistop('spherical_surface_products requires rconst '// &
1248 'mt_seed_coord inside domain')
1249 endif
1250 {^ifthreed
1251 case ('theta_const','thetaconst')
1252 surface='theta_const'
1253 call mt_require_real('mt_seed_coord',mt_seed_coord)
1254 seed_coord=mt_seed_coord
1255 if (seed_coord<xprobmin2 .or. seed_coord>xprobmax2) then
1256 call mpistop('spherical_surface_products requires theta_const '// &
1257 'mt_seed_coord inside domain')
1258 endif
1259 case ('phi_const','phiconst')
1260 surface='phi_const'
1261 call mt_require_real('mt_seed_coord',mt_seed_coord)
1262 seed_coord=mt_seed_coord
1263 if (seed_coord<xprobmin3 .or. seed_coord>xprobmax3) then
1264 call mpistop('spherical_surface_products requires phi_const '// &
1265 'mt_seed_coord inside domain')
1266 endif
1267 case ('radial_plane','radialplane')
1268 surface='radial_plane'
1269 seed_coord=0.d0
1270 call mt_require_real('mt_seed_theta0',mt_seed_theta0)
1271 call mt_require_real('mt_seed_phi0',mt_seed_phi0)
1272 call mt_require_real('mt_seed_alpha',mt_seed_alpha)
1273 if (mt_seed_theta0<xprobmin2 .or. mt_seed_theta0>xprobmax2) then
1274 call mpistop('spherical_surface_products requires radial_plane '// &
1275 'mt_seed_theta0 inside domain')
1276 endif
1277 if (mt_seed_phi0<xprobmin3 .or. mt_seed_phi0>xprobmax3) then
1278 call mpistop('spherical_surface_products requires radial_plane '// &
1279 'mt_seed_phi0 inside domain')
1280 endif
1281 if (abs(dsin(mt_seed_theta0))<=1.d-12) then
1282 call mpistop('spherical_surface_products radial_plane requires '// &
1283 'mt_seed_theta0 away from the polar singularity')
1284 endif
1285 }
1286 case default
1287 call mpistop('spherical_surface_products supports '// &
1288 'mt_seed_surface=rmin, rconst, theta_const, phi_const, or radial_plane')
1289 end select
1290 call mt_require_positive_int('mt_n1',mt_n1)
1291 call mt_require_positive_int('mt_n2',mt_n2)
1292 s1_min=0.d0
1293 s1_max=0.d0
1294 s2_min=0.d0
1295 s2_max=0.d0
1296 {^ifthreed
1297 select case (trim(surface))
1298 case ('rmin','rconst')
1299 s1_min=xprobmin2
1300 s1_max=xprobmax2
1301 s2_min=xprobmin3
1302 s2_max=xprobmax3
1303 case ('theta_const')
1304 s1_min=xprobmin1
1305 s1_max=xprobmax1
1306 s2_min=xprobmin3
1307 s2_max=xprobmax3
1308 case ('phi_const')
1309 s1_min=xprobmin1
1310 s1_max=xprobmax1
1311 s2_min=xprobmin2
1312 s2_max=xprobmax2
1313 case ('radial_plane')
1314 s1_min=xprobmin1
1315 s1_max=xprobmax1
1316 s2_min=-0.5d0*min(xprobmax2-xprobmin2,xprobmax3-xprobmin3)
1317 s2_max= 0.5d0*min(xprobmax2-xprobmin2,xprobmax3-xprobmin3)
1318 end select
1319 }
1320 if (mt_is_set_real(mt_s1min)) s1_min=mt_s1min
1321 if (mt_is_set_real(mt_s1max)) s1_max=mt_s1max
1322 if (mt_is_set_real(mt_s2min)) s2_min=mt_s2min
1323 if (mt_is_set_real(mt_s2max)) s2_max=mt_s2max
1324 call mt_require_ordered('mt_s1min','mt_s1max',s1_min,s1_max)
1325 call mt_require_ordered('mt_s2min','mt_s2max',s2_min,s2_max)
1326
1327 csv_file=''
1328 if (mt_write_csv) then
1329 if (trim(surface)=='rmin') then
1330 suffix='_spherical_rmin_products.csv'
1331 else if (trim(surface)=='radial_plane') then
1332 suffix='_spherical_radial_plane_products.csv'
1333 else
1334 suffix='_spherical_'//trim(surface)//'_products.csv'
1335 endif
1336 call mt_resolve_prefix_file(trim(suffix),csv_file, &
1337 'spherical_surface_products CSV requires mt_output_prefix')
1338 endif
1339 if (trim(surface)=='rmin') then
1340 suffix='_spherical_rmin_products.vtu'
1341 else if (trim(surface)=='radial_plane') then
1342 suffix='_spherical_radial_plane_products.vtu'
1343 else
1344 suffix='_spherical_'//trim(surface)//'_products.vtu'
1345 endif
1346 call mt_resolve_output_file('spherical_surface_products','.vtu', &
1347 trim(suffix),vtu_file)
1348
1349 if (mt_write_csv) then
1350 write(*,'(a)') 'mt_run_topology_task: writing spherical '// &
1351 trim(surface)//' CSV '//trim(csv_file)
1352 endif
1353 write(*,'(a)') 'mt_run_topology_task: writing spherical '// &
1354 trim(surface)//' VTU '//trim(vtu_file)
1355
1356 if (mt_profile_spherical) then
1357 call trace_spherical_profile_reset()
1358 call trace_spherical_profile_set(.true.)
1359 endif
1360
1361 seed_theta0=mt_seed_theta0
1362 seed_phi0=mt_seed_phi0
1363 seed_alpha=mt_seed_alpha
1364 if (mt_b_min>0.d0) then
1365 call mt_fieldline_products_spherical_surface(trim(surface),seed_coord, &
1366 s1_min,s1_max,mt_n1,s2_min,s2_max,mt_n2,mt_dl,mt_max_steps, &
1367 trim(csv_file),trim(vtu_file),trim(mt_seed_layout), &
1368 seed_theta0,seed_phi0,seed_alpha, &
1369 compute_twist=mt_compute_twist,compute_q=mt_compute_q, &
1370 compute_qperp=mt_compute_qperp,b_min=mt_b_min)
1371 else
1372 call mt_fieldline_products_spherical_surface(trim(surface),seed_coord, &
1373 s1_min,s1_max,mt_n1,s2_min,s2_max,mt_n2,mt_dl,mt_max_steps, &
1374 trim(csv_file),trim(vtu_file),trim(mt_seed_layout), &
1375 seed_theta0,seed_phi0,seed_alpha, &
1376 compute_twist=mt_compute_twist,compute_q=mt_compute_q, &
1377 compute_qperp=mt_compute_qperp)
1378 endif
1379 if (mt_profile_spherical) then
1380 call trace_spherical_profile_report('spherical_surface_products '// &
1381 trim(surface))
1382 call trace_spherical_profile_set(.false.)
1383 endif
1384 end subroutine mt_run_spherical_surface_products_task
1385
1386 subroutine mt_run_spherical_cloud_products_task()
1387 character(len=mt_task_name_len) :: vtu_file
1388 double precision :: s1_min,s1_max,s2_min,s2_max,s3_min,s3_max
1389
1390 if (mt_write_csv) then
1391 write(*,'(a)') 'mt_run_topology_task: spherical_cloud_products '// &
1392 'does not write CSV; use seed_products for selected-point diagnostics'
1393 endif
1394 call mt_require_positive_int('mt_n1',mt_n1)
1395 call mt_require_positive_int('mt_n2',mt_n2)
1396 call mt_require_positive_int('mt_n3',mt_n3)
1397 s1_min=xprobmin1
1398 s1_max=xprobmax1
1399 s2_min=0.d0
1400 s2_max=0.d0
1401 s3_min=0.d0
1402 s3_max=0.d0
1403 {^ifthreed
1404 s2_min=xprobmin2
1405 s2_max=xprobmax2
1406 s3_min=xprobmin3
1407 s3_max=xprobmax3
1408 }
1409 if (mt_is_set_real(mt_s1min)) s1_min=mt_s1min
1410 if (mt_is_set_real(mt_s1max)) s1_max=mt_s1max
1411 if (mt_is_set_real(mt_s2min)) s2_min=mt_s2min
1412 if (mt_is_set_real(mt_s2max)) s2_max=mt_s2max
1413 if (mt_is_set_real(mt_s3min)) s3_min=mt_s3min
1414 if (mt_is_set_real(mt_s3max)) s3_max=mt_s3max
1415 call mt_require_ordered('mt_s1min','mt_s1max',s1_min,s1_max)
1416 call mt_require_ordered('mt_s2min','mt_s2max',s2_min,s2_max)
1417 call mt_require_ordered('mt_s3min','mt_s3max',s3_min,s3_max)
1418
1419 call mt_resolve_output_file('spherical_cloud_products','.vtu', &
1420 '_spherical_cloud_products.vtu',vtu_file)
1421
1422 write(*,'(a)') 'mt_run_topology_task: writing spherical cloud VTU '// &
1423 trim(vtu_file)
1424
1425 if (mt_profile_spherical) then
1426 call trace_spherical_profile_reset()
1427 call trace_spherical_profile_set(.true.)
1428 endif
1429
1430 if (mt_b_min>0.d0) then
1431 call mt_fieldline_products_spherical_cloud(s1_min,s1_max,mt_n1, &
1432 s2_min,s2_max,mt_n2,s3_min,s3_max,mt_n3,mt_dl,mt_max_steps, &
1433 trim(vtu_file),trim(mt_seed_layout), &
1434 compute_twist=mt_compute_twist,compute_q=mt_compute_q, &
1435 compute_qperp=mt_compute_qperp,b_min=mt_b_min)
1436 else
1437 call mt_fieldline_products_spherical_cloud(s1_min,s1_max,mt_n1, &
1438 s2_min,s2_max,mt_n2,s3_min,s3_max,mt_n3,mt_dl,mt_max_steps, &
1439 trim(vtu_file),trim(mt_seed_layout), &
1440 compute_twist=mt_compute_twist,compute_q=mt_compute_q, &
1441 compute_qperp=mt_compute_qperp)
1442 endif
1443 if (mt_profile_spherical) then
1444 call trace_spherical_profile_report('spherical_cloud_products')
1445 call trace_spherical_profile_set(.false.)
1446 endif
1447 end subroutine mt_run_spherical_cloud_products_task
1448
1449 subroutine mt_resolve_output_file(mode,extension,suffix,output_file)
1450 character(len=*), intent(in) :: mode,extension,suffix
1451 character(len=*), intent(out) :: output_file
1452 integer :: required_len
1453
1454 output_file=''
1455 if (len_trim(mt_output_file)>0) then
1456 output_file=trim(mt_output_file)
1457 if (len_trim(mt_output_prefix)>0) then
1458 write(*,'(a)') 'mt_run_topology_task: mt_output_file takes precedence over mt_output_prefix'
1459 endif
1460 call mt_warn_extension(output_file,extension,mode)
1461 else
1462 required_len=len_trim(mt_output_prefix)+len_trim(suffix)
1463 if (required_len>len(output_file)) then
1464 call mpistop('mt_run_topology_task output filename exceeds internal length')
1465 endif
1466 output_file=trim(mt_output_prefix)//trim(suffix)
1467 endif
1468 end subroutine mt_resolve_output_file
1469
1470 subroutine mt_resolve_prefix_file(suffix,output_file,missing_message)
1471 character(len=*), intent(in) :: suffix,missing_message
1472 character(len=*), intent(out) :: output_file
1473 integer :: required_len
1474
1475 if (len_trim(mt_output_prefix)==0) then
1476 call mpistop(trim(missing_message))
1477 endif
1478 required_len=len_trim(mt_output_prefix)+len_trim(suffix)
1479 if (required_len>len(output_file)) then
1480 call mpistop('mt_run_topology_task output filename exceeds internal length')
1481 endif
1482 output_file=trim(mt_output_prefix)//trim(suffix)
1483 end subroutine mt_resolve_prefix_file
1484
1485 logical function mt_is_set_real(value) result(is_set)
1486 double precision, intent(in) :: value
1487
1488 is_set=(value/=mt_unset_real)
1489 end function mt_is_set_real
1490
1491 subroutine mt_require_real(name,value)
1492 character(len=*), intent(in) :: name
1493 double precision, intent(in) :: value
1494
1495 if (.not.mt_is_set_real(value)) then
1496 call mpistop('mt_run_topology_task requires '//trim(name))
1497 endif
1498 end subroutine mt_require_real
1499
1500 subroutine mt_require_positive_int(name,value)
1501 character(len=*), intent(in) :: name
1502 integer, intent(in) :: value
1503
1504 if (value<=0) then
1505 call mpistop('mt_run_topology_task requires '//trim(name)//' > 0')
1506 endif
1507 end subroutine mt_require_positive_int
1508
1509 subroutine mt_require_ordered(name_min,name_max,value_min,value_max)
1510 character(len=*), intent(in) :: name_min,name_max
1511 double precision, intent(in) :: value_min,value_max
1512
1513 if (value_max<value_min) then
1514 call mpistop('mt_run_topology_task requires ordered '// &
1515 trim(name_min)//'/'//trim(name_max))
1516 endif
1517 end subroutine mt_require_ordered
1518
1519 subroutine mt_require_requested_science(do_length,do_twist,do_q,do_qperp, &
1520 caller)
1521 logical, intent(in) :: do_length,do_twist,do_q,do_qperp
1522 character(len=*), intent(in) :: caller
1523
1524 if (.not.(do_length .or. do_twist .or. do_q .or. do_qperp)) then
1525 call mpistop(trim(caller)//' requires at least one requested science array')
1526 endif
1527 end subroutine mt_require_requested_science
1528
1529 subroutine mt_read_seed_file(filename,seeds,nseed)
1530 character(len=*), intent(in) :: filename
1531 double precision, allocatable, intent(out) :: seeds(:,:)
1532 integer, intent(out) :: nseed
1533
1534 character(len=1024) :: line
1535 double precision :: xyz(3)
1536 integer :: io,ios,line_no,iseed
1537
1538 nseed=0
1539 open(newunit=io,file=trim(filename),status='old',action='read', &
1540 form='formatted',iostat=ios)
1541 if (ios/=0) then
1542 call mpistop('mt_read_seed_file could not open '//trim(filename))
1543 endif
1544 line_no=0
1545 do
1546 read(io,'(a)',iostat=ios) line
1547 if (ios/=0) exit
1548 line_no=line_no+1
1549 if (.not.mt_seed_line_is_data(line)) cycle
1550 call mt_validate_seed_line(filename,line,line_no)
1551 nseed=nseed+1
1552 enddo
1553 close(io)
1554 if (nseed<=0) then
1555 call mpistop('mt_read_seed_file found no seeds in '//trim(filename))
1556 endif
1557
1558 allocate(seeds(nseed,ndim))
1559 seeds=0.d0
1560 open(newunit=io,file=trim(filename),status='old',action='read', &
1561 form='formatted',iostat=ios)
1562 if (ios/=0) then
1563 call mpistop('mt_read_seed_file could not reopen '//trim(filename))
1564 endif
1565 line_no=0
1566 iseed=0
1567 do
1568 read(io,'(a)',iostat=ios) line
1569 if (ios/=0) exit
1570 line_no=line_no+1
1571 if (.not.mt_seed_line_is_data(line)) cycle
1572 iseed=iseed+1
1573 read(line,*,iostat=ios) xyz
1574 if (ios/=0) then
1575 call mt_fail_seed_line(filename,line_no)
1576 endif
1577 seeds(iseed,1:ndim)=xyz(1:ndim)
1578 enddo
1579 close(io)
1580 end subroutine mt_read_seed_file
1581
1582 logical function mt_seed_line_is_data(line) result(is_data)
1583 character(len=*), intent(in) :: line
1584 character(len=len(line)) :: trimmed
1585
1586 trimmed=adjustl(line)
1587 is_data=len_trim(trimmed)>0
1588 if (is_data) is_data=trimmed(1:1)/='#'
1589 end function mt_seed_line_is_data
1590
1591 subroutine mt_validate_seed_line(filename,line,line_no)
1592 character(len=*), intent(in) :: filename,line
1593 integer, intent(in) :: line_no
1594
1595 double precision :: x,y,z
1596 integer :: ios
1597
1598 if (index(line,',')>0) then
1599 call mt_fail_seed_line(filename,line_no)
1600 endif
1601 if (mt_count_tokens(line)/=3) then
1602 call mt_fail_seed_line(filename,line_no)
1603 endif
1604 read(line,*,iostat=ios) x,y,z
1605 if (ios/=0) then
1606 call mt_fail_seed_line(filename,line_no)
1607 endif
1608 end subroutine mt_validate_seed_line
1609
1610 integer function mt_count_tokens(line) result(ntoken)
1611 character(len=*), intent(in) :: line
1612 integer :: i
1613 logical :: in_token
1614
1615 ntoken=0
1616 in_token=.false.
1617 do i=1,len_trim(line)
1618 if (line(i:i)==' ' .or. line(i:i)==achar(9)) then
1619 in_token=.false.
1620 else
1621 if (.not.in_token) then
1622 ntoken=ntoken+1
1623 in_token=.true.
1624 endif
1625 endif
1626 enddo
1627 end function mt_count_tokens
1628
1629 subroutine mt_fail_seed_line(filename,line_no)
1630 character(len=*), intent(in) :: filename
1631 integer, intent(in) :: line_no
1632
1633 call mpistop('mt_read_seed_file malformed line '// &
1634 trim(mt_int_to_string(line_no))//' in '//trim(filename))
1635 end subroutine mt_fail_seed_line
1636
1637 function mt_int_to_string(value) result(text)
1638 integer, intent(in) :: value
1639 character(len=32) :: text
1640
1641 write(text,'(i0)') value
1642 end function mt_int_to_string
1643
1644 subroutine mt_warn_extension(filename,extension,mode)
1645 character(len=*), intent(in) :: filename,extension,mode
1646
1647 if (.not.mt_has_extension(filename,extension)) then
1648 write(*,'(a)') 'mt_run_topology_task warning: '//trim(mode)// &
1649 ' output file does not end in '//trim(extension)
1650 endif
1651 end subroutine mt_warn_extension
1652
1653 logical function mt_has_extension(filename,extension) result(has_ext)
1654 character(len=*), intent(in) :: filename,extension
1655 character(len=mt_task_name_len) :: fname,ext
1656 integer :: lf,le
1657
1658 fname=mt_lowercase(trim(filename))
1659 ext=mt_lowercase(trim(extension))
1660 lf=len_trim(fname)
1661 le=len_trim(ext)
1662 has_ext=.false.
1663 if (lf>=le) has_ext=(fname(lf-le+1:lf)==ext(1:le))
1664 end function mt_has_extension
1665
1666 function mt_lowercase(input) result(output)
1667 character(len=*), intent(in) :: input
1668 character(len=len(input)) :: output
1669 integer :: i,code
1670
1671 output=input
1672 do i=1,len(input)
1673 code=iachar(output(i:i))
1674 if (code>=iachar('A') .and. code<=iachar('Z')) then
1675 output(i:i)=achar(code+iachar('a')-iachar('A'))
1676 endif
1677 enddo
1678 end function mt_lowercase
1679
1680 logical function mt_vtk_detail_is_full() result(is_full)
1681 is_full=(mt_lowercase(trim(mt_vtk_detail))=='full')
1682 end function mt_vtk_detail_is_full
1683
1684 double precision function mt_visual_float(value) result(out_value)
1685 double precision, intent(in) :: value
1686
1687 if (ieee_is_finite(value)) then
1688 out_value=value
1689 else
1690 out_value=0.d0
1691 endif
1692 end function mt_visual_float
1693
1694 double precision function mt_visual_valid_float(value,is_valid) &
1695 result(out_value)
1696 double precision, intent(in) :: value
1697 logical, intent(in) :: is_valid
1698
1699 if (is_valid .and. ieee_is_finite(value)) then
1700 out_value=value
1701 else
1702 out_value=0.d0
1703 endif
1704 end function mt_visual_valid_float
1705
1706 double precision function mt_vc(vec,icomp) result(value)
1707 ! Return a physical coordinate component without creating fixed
1708 ! out-of-bounds references in 1D/2D source expansions.
1709 double precision, intent(in) :: vec(ndim)
1710 integer, intent(in) :: icomp
1711
1712 if (icomp>=1 .and. icomp<=ndim) then
1713 value=vec(icomp)
1714 else
1715 value=0.d0
1716 endif
1717 end function mt_vc
1718
1719 subroutine mt_length_single(seed,dL,max_steps,csv_file,b_min)
1720 ! Trace one magnetic field line and write its summary to a CSV file.
1721 double precision, intent(in) :: seed(ndim),dl
1722 integer, intent(in) :: max_steps
1723 character(len=*), intent(in) :: csv_file
1724 double precision, intent(in), optional :: b_min
1725
1726 type(trace_length_result) :: result
1727 double precision :: seed_xyz(3)
1728 integer :: csv_unit,io_status
1729
1730 if (npe/=1) then
1731 call mpistop('mt_length_single currently requires npe=1')
1732 endif
1733
1734 if (present(b_min)) then
1735 call trace_field_length_single(seed,dl,max_steps,result,b_min)
1736 else
1737 call trace_field_length_single(seed,dl,max_steps,result)
1738 endif
1739
1740 seed_xyz=0.d0
1741 seed_xyz(1:ndim)=result%seed
1742
1743 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
1744 action='write',form='formatted',iostat=io_status)
1745 if (io_status/=0) then
1746 call mpistop('mt_length_single could not open CSV file')
1747 endif
1748
1749 write(csv_unit,'(a)',iostat=io_status) &
1750 'seed_x,seed_y,seed_z,'// &
1751 'length_total,length_backward,length_forward,'// &
1752 'nstep_backward,nstep_forward,'// &
1753 'status_backward,status_forward'
1754 if (io_status/=0) then
1755 close(csv_unit)
1756 call mpistop('mt_length_single could not write CSV header')
1757 endif
1758
1759 write(csv_unit,'(es24.16,5(",",es24.16),4(",",i0))',iostat=io_status) &
1760 seed_xyz,result%total_length, &
1761 result%backward_length,result%forward_length, &
1762 result%backward_nstep,result%forward_nstep, &
1763 result%backward_status,result%forward_status
1764 if (io_status/=0) then
1765 close(csv_unit)
1766 call mpistop('mt_length_single could not write CSV data')
1767 endif
1768
1769 close(csv_unit)
1770 end subroutine mt_length_single
1771
1772 subroutine mt_length_seeds(seeds,nseed,dL,max_steps,csv_file,b_min)
1773 ! Trace multiple magnetic field lines and write one summary row per seed.
1774 integer, intent(in) :: nseed,max_steps
1775 double precision, intent(in) :: seeds(nseed,ndim),dl
1776 character(len=*), intent(in) :: csv_file
1777 double precision, intent(in), optional :: b_min
1778
1779 type(trace_length_result), allocatable :: results(:)
1780 double precision :: seed_xyz(3)
1781 integer :: csv_unit,io_status,iseed
1782
1783 if (npe/=1) then
1784 call mpistop('mt_length_seeds currently requires npe=1')
1785 endif
1786 if (nseed<0) then
1787 call mpistop('mt_length_seeds requires nseed>=0')
1788 endif
1789
1790 allocate(results(nseed))
1791 if (present(b_min)) then
1792 call trace_field_length_multi(seeds,nseed,dl,max_steps,results,b_min)
1793 else
1794 call trace_field_length_multi(seeds,nseed,dl,max_steps,results)
1795 endif
1796
1797 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
1798 action='write',form='formatted',iostat=io_status)
1799 if (io_status/=0) then
1800 deallocate(results)
1801 call mpistop('mt_length_seeds could not open CSV file')
1802 endif
1803
1804 write(csv_unit,'(a)',iostat=io_status) &
1805 'seed_id,seed_x,seed_y,seed_z,'// &
1806 'length_total,length_backward,length_forward,'// &
1807 'nstep_backward,nstep_forward,'// &
1808 'status_backward,status_forward'
1809 if (io_status/=0) then
1810 close(csv_unit)
1811 deallocate(results)
1812 call mpistop('mt_length_seeds could not write CSV header')
1813 endif
1814
1815 do iseed=1,nseed
1816 seed_xyz=0.d0
1817 seed_xyz(1:ndim)=results(iseed)%seed
1818 write(csv_unit,'(i0,6(",",es24.16),4(",",i0))',iostat=io_status) &
1819 iseed,seed_xyz,results(iseed)%total_length, &
1820 results(iseed)%backward_length,results(iseed)%forward_length, &
1821 results(iseed)%backward_nstep,results(iseed)%forward_nstep, &
1822 results(iseed)%backward_status,results(iseed)%forward_status
1823 if (io_status/=0) then
1824 close(csv_unit)
1825 deallocate(results)
1826 call mpistop('mt_length_seeds could not write CSV data')
1827 endif
1828 enddo
1829
1830 close(csv_unit)
1831 deallocate(results)
1832 end subroutine mt_length_seeds
1833
1834 subroutine mt_fieldline_products_seeds(seeds,nseed,dL,max_steps,csv_file, &
1835 b_min,compute_length,compute_twist,compute_q,compute_qperp,vtu_file)
1836 ! Write selected per-field-line diagnostics for an arbitrary seed set.
1837 integer, intent(in) :: nseed,max_steps
1838 double precision, intent(in) :: seeds(nseed,ndim),dl
1839 character(len=*), intent(in) :: csv_file
1840 double precision, intent(in), optional :: b_min
1841 logical, intent(in), optional :: compute_length,compute_twist
1842 logical, intent(in), optional :: compute_q,compute_qperp
1843 character(len=*), intent(in), optional :: vtu_file
1844
1845 type(trace_length_result), allocatable :: length_results(:)
1846 type(trace_twist_result), allocatable :: twist_results(:)
1847 type(trace_qperp_result), allocatable :: q_results(:)
1848 type(trace_qperp_result), allocatable :: qperp_results(:)
1849 logical :: do_length,do_twist,do_q,do_qperp
1850 character(len=mt_task_name_len) :: integrator
1851
1852 do_length=.true.
1853 do_twist=.false.
1854 do_q=.false.
1855 do_qperp=.false.
1856 if (present(compute_length)) do_length=compute_length
1857 if (present(compute_twist)) do_twist=compute_twist
1858 if (present(compute_q)) do_q=compute_q
1859 if (present(compute_qperp)) do_qperp=compute_qperp
1860 integrator=mt_lowercase(trim(mt_trace_integrator))
1861
1862 if (npe/=1) then
1863 call mpistop('mt_fieldline_products_seeds currently requires npe=1')
1864 endif
1865 if (ndim/=3) then
1866 call mpistop('mt_fieldline_products_seeds requires 3D Cartesian or spherical geometry')
1867 endif
1868 {^ifthreed
1869 select case (geo_coordinate)
1870 case (geo_cartesian,geo_cartesian_stretched)
1871 case (geo_spherical)
1872 if (periodb(3)) then
1873 call mpistop('spherical seed_products does not yet support periodic phi')
1874 endif
1875 case default
1876 call mpistop('mt_fieldline_products_seeds requires Cartesian or spherical geometry')
1877 end select
1878 }
1879 if (do_qperp) then
1880 select case (trim(integrator))
1881 case ('rk2')
1882 ! RK2 Qperp is the mature tangent-transport path.
1883 case ('rk45_cartesian')
1884 {^ifthreed
1885 if (geo_coordinate==geo_spherical) then
1886 call mpistop('seed_products logQperp with spherical geometry '// &
1887 'requires mt_trace_integrator=rk45_spherical')
1888 endif
1889 }
1890 case ('rk45_spherical')
1891 {^ifthreed
1892 if (geo_coordinate/=geo_spherical) then
1893 call mpistop('seed_products logQperp with Cartesian geometry '// &
1894 'requires mt_trace_integrator=rk45_cartesian')
1895 endif
1896 }
1897 case default
1898 call mpistop('seed_products logQperp requires mt_trace_integrator='// &
1899 'rk2, rk45_cartesian, or rk45_spherical')
1900 end select
1901 endif
1902 if (do_q) then
1903 select case (trim(integrator))
1904 case ('rk2')
1905 ! RK2 standard logQ is the mature tangent-transport path.
1906 case ('rk45_cartesian')
1907 {^ifthreed
1908 if (geo_coordinate==geo_spherical) then
1909 call mpistop('seed_products logQ with spherical geometry '// &
1910 'requires mt_trace_integrator=rk45_spherical')
1911 endif
1912 }
1913 case ('rk45_spherical')
1914 {^ifthreed
1915 if (geo_coordinate/=geo_spherical) then
1916 call mpistop('seed_products logQ with Cartesian geometry '// &
1917 'requires mt_trace_integrator=rk45_cartesian')
1918 endif
1919 }
1920 case default
1921 call mpistop('seed_products logQ requires mt_trace_integrator='// &
1922 'rk2, rk45_cartesian, or rk45_spherical')
1923 end select
1924 endif
1925 if (nseed<0) then
1926 call mpistop('mt_fieldline_products_seeds requires nseed>=0')
1927 endif
1928 call mt_require_requested_science(do_length,do_twist,do_q,do_qperp, &
1929 'mt_fieldline_products_seeds')
1930
1931 allocate(length_results(nseed))
1932 if (do_twist) then
1933 allocate(twist_results(nseed))
1934 else
1935 allocate(twist_results(0))
1936 endif
1937 if (do_q) then
1938 allocate(q_results(nseed))
1939 else
1940 allocate(q_results(0))
1941 endif
1942 if (do_qperp) then
1943 allocate(qperp_results(nseed))
1944 else
1945 allocate(qperp_results(0))
1946 endif
1947
1948 if (present(b_min)) then
1949 call mt_trace_fieldline_products_seedset(seeds,nseed,dl,max_steps, &
1950 length_results,twist_results,q_results,qperp_results,do_twist, &
1951 do_q,do_qperp,b_min)
1952 else
1953 call mt_trace_fieldline_products_seedset(seeds,nseed,dl,max_steps, &
1954 length_results,twist_results,q_results,qperp_results,do_twist, &
1955 do_q,do_qperp)
1956 endif
1957
1958 if (len_trim(csv_file)>0) then
1959 call mt_write_fieldline_products_seeds_csv(length_results, &
1960 twist_results,q_results,qperp_results,nseed,csv_file,do_twist, &
1961 do_q,do_qperp)
1962 endif
1963 if (present(vtu_file)) then
1964 if (len_trim(vtu_file)>0) then
1965 call mt_write_fieldline_products_vtu_vertices(vtu_file, &
1966 length_results,twist_results,q_results,qperp_results,nseed, &
1967 do_length,do_twist,do_q,do_qperp,'mt_fieldline_products_seeds')
1968 endif
1969 endif
1970
1971 if (allocated(qperp_results)) deallocate(qperp_results)
1972 if (allocated(q_results)) deallocate(q_results)
1973 if (allocated(twist_results)) deallocate(twist_results)
1974 deallocate(length_results)
1975 end subroutine mt_fieldline_products_seeds
1976
1977 subroutine mt_rk45_tangent_diagnostic_seeds(seeds,nseed,dL,max_steps, &
1978 csv_file,b_min)
1979 integer, intent(in) :: nseed,max_steps
1980 double precision, intent(in) :: seeds(nseed,ndim),dl
1981 character(len=*), intent(in) :: csv_file
1982 double precision, intent(in), optional :: b_min
1983
1984 type(trace_qperp_result), allocatable :: rk2_results(:)
1985 type(trace_qperp_result), allocatable :: rk45_results(:)
1986
1987 if (npe/=1) then
1988 call mpistop('mt_rk45_tangent_diagnostic_seeds currently requires npe=1')
1989 endif
1990 if (nseed<0) then
1991 call mpistop('mt_rk45_tangent_diagnostic_seeds requires nseed>=0')
1992 endif
1993
1994 allocate(rk2_results(nseed),rk45_results(nseed))
1995 if (present(b_min)) then
1996 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,rk2_results, &
1997 b_min)
1998 call trace_debug_cartesian_rk45_tangent_q0_multi(seeds,nseed,dl, &
1999 max_steps,rk45_results,b_min)
2000 else
2001 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,rk2_results)
2002 call trace_debug_cartesian_rk45_tangent_q0_multi(seeds,nseed,dl, &
2003 max_steps,rk45_results)
2004 endif
2005
2006 call mt_write_rk45_tangent_diagnostic_csv(rk2_results,rk45_results, &
2007 nseed,csv_file)
2008 deallocate(rk45_results,rk2_results)
2009 end subroutine mt_rk45_tangent_diagnostic_seeds
2010
2011 subroutine mt_write_rk45_tangent_diagnostic_csv(rk2_results,rk45_results, &
2012 nseed,csv_file)
2013 integer, intent(in) :: nseed
2014 type(trace_qperp_result), intent(in) :: rk2_results(nseed)
2015 type(trace_qperp_result), intent(in) :: rk45_results(nseed)
2016 character(len=*), intent(in) :: csv_file
2017
2018 double precision :: seed_xyz(3),logq_diff,q_diff,length_diff
2019 double precision :: f_endpoint_diff,b_endpoint_diff
2020 double precision :: uf_diff,vf_diff,ub_diff,vb_diff
2021 integer :: csv_unit,io_status,iseed
2022
2023 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
2024 action='write',form='formatted',iostat=io_status)
2025 if (io_status/=0) then
2026 call mpistop('mt_rk45_tangent_diagnostic could not open CSV file')
2027 endif
2028
2029 write(csv_unit,'(a)',iostat=io_status) &
2030 'seed_id,seed_x,seed_y,seed_z,'// &
2031 'rk2_status_q0,rk45_status_q0,'// &
2032 'rk2_forward_status,rk45_forward_status,'// &
2033 'rk2_backward_status,rk45_backward_status,'// &
2034 'rk2_logq0,rk45_logq0,abs_diff_logq0,'// &
2035 'rk2_q0,rk45_q0,abs_diff_q0,'// &
2036 'rk2_length_total,rk45_length_total,abs_diff_length_total,'// &
2037 'endpoint_diff_forward,endpoint_diff_backward,'// &
2038 'u_forward_perp_diff,v_forward_perp_diff,'// &
2039 'u_backward_perp_diff,v_backward_perp_diff'
2040 if (io_status/=0) then
2041 close(csv_unit)
2042 call mpistop('mt_rk45_tangent_diagnostic could not write CSV header')
2043 endif
2044
2045 do iseed=1,nseed
2046 seed_xyz=0.d0
2047 seed_xyz(1:ndim)=rk2_results(iseed)%seed
2048 logq_diff=mt_absdiff_or_nan(rk2_results(iseed)%logq0, &
2049 rk45_results(iseed)%logq0)
2050 q_diff=mt_absdiff_or_nan(rk2_results(iseed)%q0, &
2051 rk45_results(iseed)%q0)
2052 length_diff=abs((rk2_results(iseed)%forward_length+ &
2053 rk2_results(iseed)%backward_length)- &
2054 (rk45_results(iseed)%forward_length+ &
2055 rk45_results(iseed)%backward_length))
2056 f_endpoint_diff=dsqrt(sum((rk2_results(iseed)%forward_endpoint- &
2057 rk45_results(iseed)%forward_endpoint)**2))
2058 b_endpoint_diff=dsqrt(sum((rk2_results(iseed)%backward_endpoint- &
2059 rk45_results(iseed)%backward_endpoint)**2))
2060 uf_diff=dsqrt(sum((rk2_results(iseed)%u_forward_perp- &
2061 rk45_results(iseed)%u_forward_perp)**2))
2062 vf_diff=dsqrt(sum((rk2_results(iseed)%v_forward_perp- &
2063 rk45_results(iseed)%v_forward_perp)**2))
2064 ub_diff=dsqrt(sum((rk2_results(iseed)%u_backward_perp- &
2065 rk45_results(iseed)%u_backward_perp)**2))
2066 vb_diff=dsqrt(sum((rk2_results(iseed)%v_backward_perp- &
2067 rk45_results(iseed)%v_backward_perp)**2))
2068
2069 write(csv_unit,'(i0,3(",",es24.16),6(",",i0),15(",",es24.16))', &
2070 iostat=io_status) &
2071 iseed,seed_xyz, &
2072 rk2_results(iseed)%status_q0, &
2073 rk45_results(iseed)%status_q0, &
2074 rk2_results(iseed)%forward_status, &
2075 rk45_results(iseed)%forward_status, &
2076 rk2_results(iseed)%backward_status, &
2077 rk45_results(iseed)%backward_status, &
2078 rk2_results(iseed)%logq0,rk45_results(iseed)%logq0,logq_diff, &
2079 rk2_results(iseed)%q0,rk45_results(iseed)%q0,q_diff, &
2080 rk2_results(iseed)%forward_length+ &
2081 rk2_results(iseed)%backward_length, &
2082 rk45_results(iseed)%forward_length+ &
2083 rk45_results(iseed)%backward_length, &
2084 length_diff,f_endpoint_diff,b_endpoint_diff, &
2085 uf_diff,vf_diff,ub_diff,vb_diff
2086 if (io_status/=0) then
2087 close(csv_unit)
2088 call mpistop('mt_rk45_tangent_diagnostic could not write CSV data')
2089 endif
2090 enddo
2091
2092 close(csv_unit)
2093 end subroutine mt_write_rk45_tangent_diagnostic_csv
2094
2095 subroutine mt_rk2_fusion_diagnostic_seeds(seeds,nseed,dL,max_steps, &
2096 csv_file,b_min)
2097 integer, intent(in) :: nseed,max_steps
2098 double precision, intent(in) :: seeds(nseed,ndim),dl
2099 character(len=*), intent(in) :: csv_file
2100 double precision, intent(in), optional :: b_min
2101
2102 type(trace_topology_result), allocatable :: summary(:)
2103 type(trace_qperp_result), allocatable :: q_trace(:)
2104 type(trace_qperp_result), allocatable :: q_short(:)
2105 type(trace_twist_result), allocatable :: q_twist(:)
2106 type(trace_twist_result), allocatable :: q_short_twist(:)
2107 integer :: cache_status
2108 logical :: use_spherical_cache
2109
2110 if (npe/=1) then
2111 call mpistop('mt_rk2_fusion_diagnostic currently requires npe=1')
2112 endif
2113 if (nseed<0) then
2114 call mpistop('mt_rk2_fusion_diagnostic requires nseed>=0')
2115 endif
2116 if (mt_lowercase(trim(mt_trace_integrator))/='rk2') then
2117 call mpistop('mt_rk2_fusion_diagnostic requires rk2 tracing')
2118 endif
2119
2120 allocate(summary(nseed),q_trace(nseed),q_short(nseed), &
2121 q_twist(nseed),q_short_twist(nseed))
2122 use_spherical_cache=.false.
2123 {^ifthreed
2124 if (geo_coordinate==geo_spherical) then
2125 call trace_spherical_curl_cache_build(cache_status)
2126 if (cache_status/=trace_status_active) then
2127 call mpistop('mt_rk2_fusion_diagnostic failed to build '// &
2128 'spherical curl cache')
2129 endif
2130 use_spherical_cache=.true.
2131 endif
2132 }
2133
2134 if (present(b_min)) then
2135 call trace_field_topology_multi(seeds,nseed,dl,max_steps,summary, &
2136 need_twist=.true.,need_mapping=.false.,b_min=b_min)
2137 if (geo_coordinate==geo_spherical) then
2138 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
2139 q_trace,b_min,twist_results=q_twist)
2140 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
2141 max_steps,q_short,b_min,twist_results=q_short_twist)
2142 else
2143 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,q_trace, &
2144 b_min,twist_results=q_twist)
2145 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
2146 max_steps,q_short,b_min,twist_results=q_short_twist)
2147 endif
2148 else
2149 call trace_field_topology_multi(seeds,nseed,dl,max_steps,summary, &
2150 need_twist=.true.,need_mapping=.false.)
2151 if (geo_coordinate==geo_spherical) then
2152 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
2153 q_trace,twist_results=q_twist)
2154 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
2155 max_steps,q_short,twist_results=q_short_twist)
2156 else
2157 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,q_trace, &
2158 twist_results=q_twist)
2159 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
2160 max_steps,q_short,twist_results=q_short_twist)
2161 endif
2162 endif
2163
2164 if (use_spherical_cache) call trace_spherical_curl_cache_clear()
2165 call mt_write_rk2_fusion_diagnostic_csv(summary,q_trace,q_twist, &
2166 q_short,q_short_twist,nseed,csv_file)
2167 deallocate(q_short_twist,q_twist,q_short,q_trace,summary)
2168 end subroutine mt_rk2_fusion_diagnostic_seeds
2169
2170 subroutine mt_write_rk2_fusion_diagnostic_csv(summary,q_trace,q_twist, &
2171 q_short,q_short_twist,nseed,csv_file)
2172 integer, intent(in) :: nseed
2173 type(trace_topology_result), intent(in) :: summary(nseed)
2174 type(trace_qperp_result), intent(in) :: q_trace(nseed)
2175 type(trace_twist_result), intent(in) :: q_twist(nseed)
2176 type(trace_qperp_result), intent(in) :: q_short(nseed)
2177 type(trace_twist_result), intent(in) :: q_short_twist(nseed)
2178 character(len=*), intent(in) :: csv_file
2179
2180 double precision :: seed_xyz(3),length_summary,length_q,length_diff
2181 double precision :: length_short,length_diff_short,length_q_short_diff
2182 double precision :: twist_summary,twist_q,twist_diff
2183 double precision :: twist_short,twist_diff_short,twist_q_short_diff
2184 double precision :: max_length_diff,max_twist_diff
2185 double precision :: max_length_short_diff,max_twist_short_diff
2186 integer :: csv_unit,io_status,iseed
2187 integer :: status_mismatch,face_mismatch,twist_status_mismatch
2188 integer :: short_status_mismatch,short_face_mismatch
2189 integer :: short_twist_status_mismatch,short_valid_q_mismatch
2190
2191 max_length_diff=0.d0
2192 max_twist_diff=0.d0
2193 max_length_short_diff=0.d0
2194 max_twist_short_diff=0.d0
2195 status_mismatch=0
2196 face_mismatch=0
2197 twist_status_mismatch=0
2198 short_status_mismatch=0
2199 short_face_mismatch=0
2200 short_twist_status_mismatch=0
2201 short_valid_q_mismatch=0
2202
2203 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
2204 action='write',form='formatted',iostat=io_status)
2205 if (io_status/=0) then
2206 call mpistop('mt_rk2_fusion_diagnostic could not open CSV file')
2207 endif
2208
2209 write(csv_unit,'(a)',iostat=io_status) &
2210 'seed_id,seed_x,seed_y,seed_z,'// &
2211 'length_summary,length_qtrace,dlength_summary_minus_qtrace,'// &
2212 'length_forward_summary,length_forward_qtrace,'// &
2213 'length_backward_summary,length_backward_qtrace,'// &
2214 'twist_summary,twist_qtrace,dtwist_summary_minus_qtrace,'// &
2215 'twist_forward_summary,twist_forward_qtrace,'// &
2216 'twist_backward_summary,twist_backward_qtrace,'// &
2217 'length_short,dlength_summary_minus_short,'// &
2218 'dlength_qtrace_minus_short,'// &
2219 'length_forward_short,length_backward_short,'// &
2220 'twist_short,dtwist_summary_minus_short,'// &
2221 'dtwist_qtrace_minus_short,'// &
2222 'twist_forward_short,twist_backward_short,'// &
2223 'status_forward_summary,status_forward_qtrace,status_forward_short,'// &
2224 'status_backward_summary,status_backward_qtrace,status_backward_short,'// &
2225 'face_forward_summary,face_forward_qtrace,face_forward_short,'// &
2226 'face_backward_summary,face_backward_qtrace,face_backward_short,'// &
2227 'status_twist_summary,status_twist_qtrace,status_twist_short,'// &
2228 'logQ,valid_Q,status_Q,logQ_short,valid_Q_short,status_Q_short'
2229 if (io_status/=0) then
2230 close(csv_unit)
2231 call mpistop('mt_rk2_fusion_diagnostic could not write CSV header')
2232 endif
2233
2234 do iseed=1,nseed
2235 seed_xyz=0.d0
2236 seed_xyz(1:ndim)=summary(iseed)%seed
2237 length_summary=summary(iseed)%length_total
2238 length_q=q_trace(iseed)%forward_length+q_trace(iseed)%backward_length
2239 length_short=q_short(iseed)%forward_length+ &
2240 q_short(iseed)%backward_length
2241 length_diff=length_summary-length_q
2242 length_diff_short=length_summary-length_short
2243 length_q_short_diff=length_q-length_short
2244 twist_summary=summary(iseed)%twist_total
2245 twist_q=q_twist(iseed)%total_twist
2246 twist_short=q_short_twist(iseed)%total_twist
2247 twist_diff=twist_summary-twist_q
2248 twist_diff_short=twist_summary-twist_short
2249 twist_q_short_diff=twist_q-twist_short
2250 max_length_diff=max(max_length_diff,abs(length_diff))
2251 max_twist_diff=max(max_twist_diff,abs(twist_diff))
2252 max_length_short_diff=max(max_length_short_diff, &
2253 abs(length_diff_short))
2254 max_twist_short_diff=max(max_twist_short_diff, &
2255 abs(twist_diff_short))
2256 if (summary(iseed)%forward_status/=q_trace(iseed)%forward_status .or. &
2257 summary(iseed)%backward_status/=q_trace(iseed)%backward_status) &
2258 status_mismatch=status_mismatch+1
2259 if (summary(iseed)%forward_face/=q_trace(iseed)%forward_face .or. &
2260 summary(iseed)%backward_face/=q_trace(iseed)%backward_face) &
2261 face_mismatch=face_mismatch+1
2262 if (summary(iseed)%status_twist/=q_twist(iseed)%status_twist) &
2263 twist_status_mismatch=twist_status_mismatch+1
2264 if (summary(iseed)%forward_status/=q_short(iseed)%forward_status .or. &
2265 summary(iseed)%backward_status/=q_short(iseed)%backward_status) &
2266 short_status_mismatch=short_status_mismatch+1
2267 if (summary(iseed)%forward_face/=q_short(iseed)%forward_face .or. &
2268 summary(iseed)%backward_face/=q_short(iseed)%backward_face) &
2269 short_face_mismatch=short_face_mismatch+1
2270 if (summary(iseed)%status_twist/=q_short_twist(iseed)%status_twist) &
2271 short_twist_status_mismatch=short_twist_status_mismatch+1
2272 if (q_trace(iseed)%valid_q0 .neqv. q_short(iseed)%valid_q0) &
2273 short_valid_q_mismatch=short_valid_q_mismatch+1
2274
2275 write(csv_unit, &
2276 '(i0,3(",",es24.16),24(",",es24.16),15(",",i0),'// &
2277 '",",es24.16,",",l1,",",i0,",",es24.16,",",l1,",",i0)', &
2278 iostat=io_status) &
2279 iseed,seed_xyz, &
2280 length_summary,length_q,length_diff, &
2281 summary(iseed)%length_forward,q_trace(iseed)%forward_length, &
2282 summary(iseed)%length_backward,q_trace(iseed)%backward_length, &
2283 twist_summary,twist_q,twist_diff, &
2284 summary(iseed)%twist_forward,q_twist(iseed)%forward_twist, &
2285 summary(iseed)%twist_backward,q_twist(iseed)%backward_twist, &
2286 length_short,length_diff_short,length_q_short_diff, &
2287 q_short(iseed)%forward_length,q_short(iseed)%backward_length, &
2288 twist_short,twist_diff_short,twist_q_short_diff, &
2289 q_short_twist(iseed)%forward_twist, &
2290 q_short_twist(iseed)%backward_twist, &
2291 summary(iseed)%forward_status,q_trace(iseed)%forward_status, &
2292 q_short(iseed)%forward_status, &
2293 summary(iseed)%backward_status,q_trace(iseed)%backward_status, &
2294 q_short(iseed)%backward_status, &
2295 summary(iseed)%forward_face,q_trace(iseed)%forward_face, &
2296 q_short(iseed)%forward_face, &
2297 summary(iseed)%backward_face,q_trace(iseed)%backward_face, &
2298 q_short(iseed)%backward_face, &
2299 summary(iseed)%status_twist,q_twist(iseed)%status_twist, &
2300 q_short_twist(iseed)%status_twist, &
2301 q_trace(iseed)%logq0,q_trace(iseed)%valid_q0, &
2302 q_trace(iseed)%status_q0, &
2303 q_short(iseed)%logq0,q_short(iseed)%valid_q0, &
2304 q_short(iseed)%status_q0
2305 if (io_status/=0) then
2306 close(csv_unit)
2307 call mpistop('mt_rk2_fusion_diagnostic could not write CSV data')
2308 endif
2309 enddo
2310
2311 close(csv_unit)
2312 write(*,'(a,es12.4)') 'mt_rk2_fusion_diagnostic max_abs_length_diff: ', &
2313 max_length_diff
2314 write(*,'(a,es12.4)') 'mt_rk2_fusion_diagnostic max_abs_twist_diff: ', &
2315 max_twist_diff
2316 write(*,'(a,es12.4)') &
2317 'mt_rk2_fusion_diagnostic max_abs_length_diff_short: ', &
2318 max_length_short_diff
2319 write(*,'(a,es12.4)') &
2320 'mt_rk2_fusion_diagnostic max_abs_twist_diff_short: ', &
2321 max_twist_short_diff
2322 write(*,'(a,i0)') 'mt_rk2_fusion_diagnostic status_mismatch_count: ', &
2323 status_mismatch
2324 write(*,'(a,i0)') 'mt_rk2_fusion_diagnostic face_mismatch_count: ', &
2325 face_mismatch
2326 write(*,'(a,i0)') &
2327 'mt_rk2_fusion_diagnostic twist_status_mismatch_count: ', &
2328 twist_status_mismatch
2329 write(*,'(a,i0)') &
2330 'mt_rk2_fusion_diagnostic short_status_mismatch_count: ', &
2331 short_status_mismatch
2332 write(*,'(a,i0)') &
2333 'mt_rk2_fusion_diagnostic short_face_mismatch_count: ', &
2334 short_face_mismatch
2335 write(*,'(a,i0)') &
2336 'mt_rk2_fusion_diagnostic short_twist_status_mismatch_count: ', &
2337 short_twist_status_mismatch
2338 write(*,'(a,i0)') &
2339 'mt_rk2_fusion_diagnostic short_valid_q_mismatch_count: ', &
2340 short_valid_q_mismatch
2341 end subroutine mt_write_rk2_fusion_diagnostic_csv
2342
2343 double precision function mt_absdiff_or_nan(a,b) result(diff)
2344 double precision, intent(in) :: a,b
2345
2346 if (ieee_is_finite(a) .and. ieee_is_finite(b)) then
2347 diff=abs(a-b)
2348 else
2349 diff=ieee_value(0.d0,ieee_quiet_nan)
2350 endif
2351 end function mt_absdiff_or_nan
2352
2353 subroutine mt_fieldline_products_spherical_surface(surface,seed_coord, &
2354 s1_min,s1_max,n1,s2_min,s2_max,n2,dL,max_steps,csv_file, &
2355 vtu_file,seed_layout,seed_theta0,seed_phi0,seed_alpha, &
2356 compute_twist,compute_q,compute_qperp,b_min)
2357 character(len=*), intent(in) :: surface,csv_file,vtu_file,seed_layout
2358 integer, intent(in) :: n1,n2,max_steps
2359 double precision, intent(in) :: seed_coord,s1_min,s1_max,s2_min,s2_max,dl
2360 double precision, intent(in) :: seed_theta0,seed_phi0,seed_alpha
2361 logical, intent(in), optional :: compute_twist,compute_q,compute_qperp
2362 double precision, intent(in), optional :: b_min
2363
2364 type(trace_topology_result), allocatable :: topology(:)
2365 type(trace_qperp_result), allocatable :: q_results(:)
2366 type(trace_qperp_result), allocatable :: qperp_results(:)
2367 double precision, allocatable :: seeds(:,:)
2368 integer :: nseed
2369 logical :: do_twist,do_q,do_qperp
2370
2371 if (npe/=1) then
2372 call mpistop('mt_fieldline_products_spherical_surface currently '// &
2373 'requires npe=1')
2374 endif
2375 if (ndim/=3 .or. geo_coordinate/=geo_spherical) then
2376 call mpistop('mt_fieldline_products_spherical_surface requires '// &
2377 '3D spherical geometry')
2378 endif
2379 {^ifthreed
2380 if (periodb(3)) then
2381 call mpistop('mt_fieldline_products_spherical_surface does not '// &
2382 'yet support periodic phi')
2383 endif
2384 }
2385 if (n1<1 .or. n2<1) then
2386 call mpistop('mt_fieldline_products_spherical_surface requires '// &
2387 'sample counts >=1')
2388 endif
2389 if (s1_max<s1_min .or. s2_max<s2_min) then
2390 call mpistop('mt_fieldline_products_spherical_surface requires ordered bounds')
2391 endif
2392 do_twist=.false.
2393 do_q=.false.
2394 do_qperp=.false.
2395 if (present(compute_twist)) do_twist=compute_twist
2396 if (present(compute_q)) do_q=compute_q
2397 if (present(compute_qperp)) do_qperp=compute_qperp
2398 call mt_build_spherical_surface_seeds(surface,seed_coord,s1_min,s1_max, &
2399 n1,s2_min,s2_max,n2,seed_layout,seed_theta0,seed_phi0, &
2400 seed_alpha,seeds)
2401 nseed=n1*n2
2402 if (mt_profile_spherical) call trace_spherical_profile_count_seeds(nseed)
2403 allocate(topology(nseed))
2404 if (do_q) then
2405 allocate(q_results(nseed))
2406 else
2407 allocate(q_results(0))
2408 endif
2409 if (do_qperp) then
2410 allocate(qperp_results(nseed))
2411 else
2412 allocate(qperp_results(0))
2413 endif
2414
2415 if (present(b_min)) then
2416 call mt_trace_spherical_surface_products(seeds,nseed,dl,max_steps, &
2417 topology,q_results,qperp_results,do_twist,do_q,do_qperp,b_min)
2418 else
2419 call mt_trace_spherical_surface_products(seeds,nseed,dl,max_steps, &
2420 topology,q_results,qperp_results,do_twist,do_q,do_qperp)
2421 endif
2422
2423 if (len_trim(csv_file)>0) then
2424 call mt_write_spherical_rmin_csv(topology,n1,n2,csv_file, &
2425 'mt_fieldline_products_spherical_surface',do_twist,do_q, &
2426 q_results,do_qperp,qperp_results)
2427 endif
2428 call mt_write_spherical_topology_vtu(vtu_file,topology,n1,n2, &
2429 'mt_fieldline_products_spherical_surface',do_twist,do_q,q_results, &
2430 do_qperp,qperp_results)
2431
2432 deallocate(qperp_results,q_results,topology,seeds)
2433 end subroutine mt_fieldline_products_spherical_surface
2434
2435 subroutine mt_fieldline_products_spherical_cloud(s1_min,s1_max,n1, &
2436 s2_min,s2_max,n2,s3_min,s3_max,n3,dL,max_steps,vtu_file, &
2437 seed_layout,compute_twist,compute_q,compute_qperp,b_min)
2438 character(len=*), intent(in) :: vtu_file,seed_layout
2439 integer, intent(in) :: n1,n2,n3,max_steps
2440 double precision, intent(in) :: s1_min,s1_max,s2_min,s2_max
2441 double precision, intent(in) :: s3_min,s3_max,dl
2442 logical, intent(in), optional :: compute_twist,compute_q,compute_qperp
2443 double precision, intent(in), optional :: b_min
2444
2445 type(trace_topology_result), allocatable :: topology(:)
2446 type(trace_qperp_result), allocatable :: q_results(:)
2447 type(trace_qperp_result), allocatable :: qperp_results(:)
2448 double precision, allocatable :: seeds(:,:)
2449 integer :: nseed
2450 logical :: do_twist,do_q,do_qperp
2451 character(len=mt_task_name_len) :: integrator
2452
2453 if (npe/=1) then
2454 call mpistop('mt_fieldline_products_spherical_cloud currently '// &
2455 'requires npe=1')
2456 endif
2457 if (ndim/=3 .or. geo_coordinate/=geo_spherical) then
2458 call mpistop('mt_fieldline_products_spherical_cloud requires '// &
2459 '3D spherical geometry')
2460 endif
2461 {^ifthreed
2462 if (periodb(3)) then
2463 call mpistop('mt_fieldline_products_spherical_cloud does not '// &
2464 'yet support periodic phi')
2465 endif
2466 }
2467 if (n1<1 .or. n2<1 .or. n3<1) then
2468 call mpistop('mt_fieldline_products_spherical_cloud requires '// &
2469 'sample counts >=1')
2470 endif
2471 if (s1_max<s1_min .or. s2_max<s2_min .or. s3_max<s3_min) then
2472 call mpistop('mt_fieldline_products_spherical_cloud requires ordered bounds')
2473 endif
2474
2475 do_twist=.false.
2476 do_q=.false.
2477 do_qperp=.false.
2478 if (present(compute_twist)) do_twist=compute_twist
2479 if (present(compute_q)) do_q=compute_q
2480 if (present(compute_qperp)) do_qperp=compute_qperp
2481 integrator=mt_lowercase(trim(mt_trace_integrator))
2482
2483 call mt_build_spherical_cloud_seeds(s1_min,s1_max,n1,s2_min,s2_max, &
2484 n2,s3_min,s3_max,n3,seed_layout,seeds)
2485 nseed=n1*n2*n3
2486 if (mt_profile_spherical) call trace_spherical_profile_count_seeds(nseed)
2487 allocate(topology(nseed))
2488 if (do_q) then
2489 allocate(q_results(nseed))
2490 else
2491 allocate(q_results(0))
2492 endif
2493 if (do_qperp) then
2494 allocate(qperp_results(nseed))
2495 else
2496 allocate(qperp_results(0))
2497 endif
2498
2499 if (present(b_min)) then
2500 call mt_trace_spherical_cloud_products(seeds,nseed,dl,max_steps, &
2501 topology,q_results,qperp_results,do_twist,do_q,do_qperp,b_min)
2502 else
2503 call mt_trace_spherical_cloud_products(seeds,nseed,dl,max_steps, &
2504 topology,q_results,qperp_results,do_twist,do_q,do_qperp)
2505 endif
2506
2507 call mt_write_spherical_cloud_vtu(vtu_file,topology,nseed, &
2508 'mt_fieldline_products_spherical_cloud',do_twist,do_q,q_results, &
2509 do_qperp,qperp_results)
2510
2511 deallocate(qperp_results,q_results,topology,seeds)
2512 end subroutine mt_fieldline_products_spherical_cloud
2513
2514 subroutine mt_trace_spherical_surface_products(seeds,nseed,dL,max_steps, &
2515 topology,q_results,qperp_results,do_twist,do_q,do_qperp,b_min)
2516 integer, intent(in) :: nseed,max_steps
2517 double precision, intent(in) :: seeds(nseed,ndim),dl
2518 type(trace_topology_result), intent(out) :: topology(nseed)
2519 type(trace_qperp_result), intent(out) :: q_results(:)
2520 type(trace_qperp_result), intent(out) :: qperp_results(:)
2521 logical, intent(in) :: do_twist,do_q,do_qperp
2522 double precision, intent(in), optional :: b_min
2523
2524 type(trace_qperp_result) :: q_local,qperp_local
2525 double precision :: seed_local(ndim)
2526 integer :: iseed,cache_status
2527
2528 if (nseed<=0) return
2529
2530 if (do_twist) then
2531 call trace_spherical_curl_cache_build(cache_status)
2532 if (cache_status/=trace_status_active) then
2533 call mpistop('mt_trace_spherical_surface_products failed to '// &
2534 'build spherical curl cache')
2535 endif
2536 endif
2537
2538 if (present(b_min)) then
2539 !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(iseed,seed_local,q_local,qperp_local) SCHEDULE(DYNAMIC,16)
2540 do iseed=1,nseed
2541 seed_local=seeds(iseed,:)
2542 call mt_trace_spherical_surface_seed(seed_local,dl,max_steps, &
2543 topology(iseed),q_local,qperp_local,do_twist,do_q, &
2544 do_qperp,b_min)
2545 if (do_q) q_results(iseed)=q_local
2546 if (do_qperp) qperp_results(iseed)=qperp_local
2547 enddo
2548 !$OMP END PARALLEL DO
2549 else
2550 !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(iseed,seed_local,q_local,qperp_local) SCHEDULE(DYNAMIC,16)
2551 do iseed=1,nseed
2552 seed_local=seeds(iseed,:)
2553 call mt_trace_spherical_surface_seed(seed_local,dl,max_steps, &
2554 topology(iseed),q_local,qperp_local,do_twist,do_q, &
2555 do_qperp)
2556 if (do_q) q_results(iseed)=q_local
2557 if (do_qperp) qperp_results(iseed)=qperp_local
2558 enddo
2559 !$OMP END PARALLEL DO
2560 endif
2561
2562 if (do_twist) call trace_spherical_curl_cache_clear()
2563 end subroutine mt_trace_spherical_surface_products
2564
2565 subroutine mt_trace_spherical_surface_seed(seed,dL,max_steps,topology, &
2566 q_result,qperp_result,do_twist,do_q,do_qperp,b_min)
2567 integer, intent(in) :: max_steps
2568 double precision, intent(in) :: seed(ndim),dl
2569 type(trace_topology_result), intent(out) :: topology
2570 type(trace_qperp_result), intent(out) :: q_result,qperp_result
2571 logical, intent(in) :: do_twist,do_q,do_qperp
2572 double precision, intent(in), optional :: b_min
2573
2574 type(trace_topology_result) :: topology_one(1)
2575 type(trace_qperp_result) :: q_one(1),qperp_one(1)
2576 type(trace_twist_result) :: twist_one(1)
2577 double precision :: seed_one(1,ndim),source_normal(3)
2578
2579 seed_one(1,:)=seed
2580 source_normal=0.d0
2581 source_normal(1)=-1.d0
2582
2583 if (do_q .and. do_qperp) then
2584 if (present(b_min)) then
2585 if (do_twist) then
2586 call trace_field_spherical_rmin_q_qperp_multi(seed_one,1,dl, &
2587 max_steps,q_one,qperp_one,b_min,twist_results=twist_one)
2588 else
2589 call trace_field_spherical_rmin_q_qperp_multi(seed_one,1,dl, &
2590 max_steps,q_one,qperp_one,b_min)
2591 endif
2592 else
2593 if (do_twist) then
2594 call trace_field_spherical_rmin_q_qperp_multi(seed_one,1,dl, &
2595 max_steps,q_one,qperp_one,twist_results=twist_one)
2596 else
2597 call trace_field_spherical_rmin_q_qperp_multi(seed_one,1,dl, &
2598 max_steps,q_one,qperp_one)
2599 endif
2600 endif
2601 call mt_q0_trace_to_topology(q_one,twist_one,1,topology_one,do_twist)
2602 topology=topology_one(1)
2603 q_result=q_one(1)
2604 qperp_result=qperp_one(1)
2605 return
2606 endif
2607
2608 if (do_q) then
2609 if (present(b_min)) then
2610 if (do_twist) then
2611 call trace_field_spherical_rmin_q_multi(seed_one,1,dl,max_steps, &
2612 q_one,b_min,twist_results=twist_one)
2613 else
2614 call trace_field_spherical_rmin_q_multi(seed_one,1,dl,max_steps, &
2615 q_one,b_min)
2616 endif
2617 else
2618 if (do_twist) then
2619 call trace_field_spherical_rmin_q_multi(seed_one,1,dl,max_steps, &
2620 q_one,twist_results=twist_one)
2621 else
2622 call trace_field_spherical_rmin_q_multi(seed_one,1,dl,max_steps, &
2623 q_one)
2624 endif
2625 endif
2626 call mt_q0_trace_to_topology(q_one,twist_one,1,topology_one,do_twist)
2627 topology=topology_one(1)
2628 q_result=q_one(1)
2629 return
2630 endif
2631
2632 if (present(b_min)) then
2633 call trace_field_topology_multi(seed_one,1,dl,max_steps,topology_one, &
2634 need_twist=do_twist,need_mapping=.false.,b_min=b_min, &
2635 source_normal=source_normal)
2636 else
2637 call trace_field_topology_multi(seed_one,1,dl,max_steps,topology_one, &
2638 need_twist=do_twist,need_mapping=.false., &
2639 source_normal=source_normal)
2640 endif
2641 topology=topology_one(1)
2642
2643 if (do_qperp) then
2644 if (present(b_min)) then
2645 call trace_field_spherical_qperp_multi(seed_one,1,dl,max_steps, &
2646 qperp_one,b_min)
2647 else
2648 call trace_field_spherical_qperp_multi(seed_one,1,dl,max_steps, &
2649 qperp_one)
2650 endif
2651 qperp_result=qperp_one(1)
2652 endif
2653 end subroutine mt_trace_spherical_surface_seed
2654
2655 subroutine mt_trace_spherical_cloud_products(seeds,nseed,dL,max_steps, &
2656 topology,q_results,qperp_results,do_twist,do_q,do_qperp,b_min)
2657 integer, intent(in) :: nseed,max_steps
2658 double precision, intent(in) :: seeds(nseed,ndim),dl
2659 type(trace_topology_result), intent(out) :: topology(nseed)
2660 type(trace_qperp_result), intent(out) :: q_results(:)
2661 type(trace_qperp_result), intent(out) :: qperp_results(:)
2662 logical, intent(in) :: do_twist,do_q,do_qperp
2663 double precision, intent(in), optional :: b_min
2664
2665 type(trace_topology_result) :: topology_one(1)
2666 type(trace_twist_result), allocatable :: twist_results(:)
2667 double precision :: seed_local(ndim),seed_one(1,ndim)
2668 integer :: iseed,cache_status
2669 character(len=mt_task_name_len) :: integrator
2670
2671 if (nseed<=0) return
2672
2673 integrator=mt_lowercase(trim(mt_trace_integrator))
2674 if (do_q .and. do_qperp .and. &
2675 (integrator=='rk2' .or. integrator=='rk45_spherical')) then
2676 ! The spherical grouped RK45 driver scans all active states by grid.
2677 ! For volume clouds this is much slower and much more memory-hungry than
2678 ! the surface product's seed-wise OpenMP schedule.
2679 if (present(b_min)) then
2680 call mt_trace_spherical_surface_products(seeds,nseed,dl,max_steps, &
2681 topology,q_results,qperp_results,do_twist,do_q,do_qperp,b_min)
2682 else
2683 call mt_trace_spherical_surface_products(seeds,nseed,dl,max_steps, &
2684 topology,q_results,qperp_results,do_twist,do_q,do_qperp)
2685 endif
2686 return
2687 endif
2688
2689 if (do_q .and. .not.do_qperp) then
2690 if (do_twist) then
2691 allocate(twist_results(nseed))
2692 if (present(b_min)) then
2693 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
2694 q_results,b_min,twist_results=twist_results)
2695 else
2696 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
2697 q_results,twist_results=twist_results)
2698 endif
2699 call mt_q0_trace_to_topology(q_results,twist_results,nseed,topology, &
2700 do_twist)
2701 deallocate(twist_results)
2702 else
2703 allocate(twist_results(0))
2704 if (present(b_min)) then
2705 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
2706 q_results,b_min)
2707 else
2708 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
2709 q_results)
2710 endif
2711 call mt_q0_trace_to_topology(q_results,twist_results,nseed,topology, &
2712 do_twist)
2713 deallocate(twist_results)
2714 endif
2715 return
2716 endif
2717
2718 if (do_qperp) then
2719 if (do_twist) then
2720 allocate(twist_results(nseed))
2721 if (present(b_min)) then
2722 call trace_field_spherical_qperp_multi(seeds,nseed,dl,max_steps, &
2723 qperp_results,b_min,twist_results=twist_results)
2724 else
2725 call trace_field_spherical_qperp_multi(seeds,nseed,dl,max_steps, &
2726 qperp_results,twist_results=twist_results)
2727 endif
2728 call mt_qperp_trace_to_topology(qperp_results,twist_results,nseed, &
2729 topology,do_twist)
2730 deallocate(twist_results)
2731 else
2732 allocate(twist_results(0))
2733 if (present(b_min)) then
2734 call trace_field_spherical_qperp_multi(seeds,nseed,dl,max_steps, &
2735 qperp_results,b_min)
2736 else
2737 call trace_field_spherical_qperp_multi(seeds,nseed,dl,max_steps, &
2738 qperp_results)
2739 endif
2740 call mt_qperp_trace_to_topology(qperp_results,twist_results,nseed, &
2741 topology,do_twist)
2742 deallocate(twist_results)
2743 endif
2744 return
2745 endif
2746
2747 if (do_twist) then
2748 call trace_spherical_curl_cache_build(cache_status)
2749 if (cache_status/=trace_status_active) then
2750 call mpistop('mt_trace_spherical_cloud_products failed to '// &
2751 'build spherical curl cache')
2752 endif
2753 endif
2754
2755 if (present(b_min)) then
2756 !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(iseed,seed_local,seed_one,topology_one) SCHEDULE(DYNAMIC,16)
2757 do iseed=1,nseed
2758 seed_local=seeds(iseed,:)
2759 seed_one(1,:)=seed_local
2760 call trace_field_topology_multi(seed_one,1,dl,max_steps, &
2761 topology_one,need_twist=do_twist,need_mapping=.false., &
2762 b_min=b_min)
2763 topology(iseed)=topology_one(1)
2764 enddo
2765 !$OMP END PARALLEL DO
2766 else
2767 !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(iseed,seed_local,seed_one,topology_one) SCHEDULE(DYNAMIC,16)
2768 do iseed=1,nseed
2769 seed_local=seeds(iseed,:)
2770 seed_one(1,:)=seed_local
2771 call trace_field_topology_multi(seed_one,1,dl,max_steps, &
2772 topology_one,need_twist=do_twist,need_mapping=.false.)
2773 topology(iseed)=topology_one(1)
2774 enddo
2775 !$OMP END PARALLEL DO
2776 endif
2777
2778 if (do_twist) call trace_spherical_curl_cache_clear()
2779 end subroutine mt_trace_spherical_cloud_products
2780
2781 subroutine mt_length_plane_xy(xmin,xmax,nx,ymin,ymax,ny,z0,dL, &
2782 max_steps,csv_file,b_min)
2783 ! Trace a uniform seed grid on a constant-z Cartesian plane.
2784 integer, intent(in) :: nx,ny,max_steps
2785 double precision, intent(in) :: xmin,xmax,ymin,ymax,z0,dl
2786 character(len=*), intent(in) :: csv_file
2787 double precision, intent(in), optional :: b_min
2788
2789 if (present(b_min)) then
2790 call mt_length_plane_axis(xmin,xmax,nx,ymin,ymax,ny,z0,1,2,3, &
2791 dl,max_steps,csv_file,'mt_length_plane_xy','ix,iy',b_min)
2792 else
2793 call mt_length_plane_axis(xmin,xmax,nx,ymin,ymax,ny,z0,1,2,3, &
2794 dl,max_steps,csv_file,'mt_length_plane_xy','ix,iy')
2795 endif
2796 end subroutine mt_length_plane_xy
2797
2798 subroutine mt_mapping_plane_xy(xmin,xmax,nx,ymin,ymax,ny,z0,dL, &
2799 max_steps,csv_file,b_min)
2800 ! Trace a constant-z seed grid and write endpoint metadata for Q mapping.
2801 integer, intent(in) :: nx,ny,max_steps
2802 double precision, intent(in) :: xmin,xmax,ymin,ymax,z0,dl
2803 character(len=*), intent(in) :: csv_file
2804 double precision, intent(in), optional :: b_min
2805
2806 type(trace_mapping_result), allocatable :: results(:)
2807 double precision, allocatable :: seeds(:,:)
2808 double precision :: source_normal(3)
2809 integer :: nseed
2810
2811 call mt_validate_axis_plane(xmin,xmax,nx,ymin,ymax,ny, &
2812 'mt_mapping_plane_xy')
2813 call mt_build_axis_plane_seeds(xmin,xmax,nx,ymin,ymax,ny,z0, &
2814 1,2,3,seeds)
2815
2816 source_normal=0.d0
2817 source_normal(3)=1.d0
2818 nseed=nx*ny
2819 allocate(results(nseed))
2820 if (present(b_min)) then
2821 call trace_field_mapping_multi(seeds,nseed,dl,max_steps,results, &
2822 b_min=b_min,source_normal=source_normal)
2823 else
2824 call trace_field_mapping_multi(seeds,nseed,dl,max_steps,results, &
2825 source_normal=source_normal)
2826 endif
2827 call mt_write_mapping_plane_xy_csv(results,nx,ny,csv_file)
2828
2829 deallocate(seeds,results)
2830 end subroutine mt_mapping_plane_xy
2831
2832 subroutine mt_q_plane_xy(xmin,xmax,nx,ymin,ymax,ny,z0,dL, &
2833 max_steps,csv_file,b_min)
2834 ! Compute standard Cartesian logQ diagnostics on a constant-z seed plane.
2835 integer, intent(in) :: nx,ny,max_steps
2836 double precision, intent(in) :: xmin,xmax,ymin,ymax,z0,dl
2837 character(len=*), intent(in) :: csv_file
2838 double precision, intent(in), optional :: b_min
2839
2840 if (present(b_min)) then
2841 call mt_q_plane_axis(xmin,xmax,nx,ymin,ymax,ny,z0,1,2,3, &
2842 dl,max_steps,csv_file,'mt_q_plane_xy','ix,iy',b_min)
2843 else
2844 call mt_q_plane_axis(xmin,xmax,nx,ymin,ymax,ny,z0,1,2,3, &
2845 dl,max_steps,csv_file,'mt_q_plane_xy','ix,iy')
2846 endif
2847 end subroutine mt_q_plane_xy
2848
2849 subroutine mt_q_plane_xz(xmin,xmax,nx,zmin,zmax,nz,y0,dL, &
2850 max_steps,csv_file,b_min)
2851 ! Compute standard Cartesian logQ diagnostics on a constant-y seed plane.
2852 integer, intent(in) :: nx,nz,max_steps
2853 double precision, intent(in) :: xmin,xmax,zmin,zmax,y0,dl
2854 character(len=*), intent(in) :: csv_file
2855 double precision, intent(in), optional :: b_min
2856
2857 if (present(b_min)) then
2858 call mt_q_plane_axis(xmin,xmax,nx,zmin,zmax,nz,y0,1,3,2, &
2859 dl,max_steps,csv_file,'mt_q_plane_xz','ix,iz',b_min)
2860 else
2861 call mt_q_plane_axis(xmin,xmax,nx,zmin,zmax,nz,y0,1,3,2, &
2862 dl,max_steps,csv_file,'mt_q_plane_xz','ix,iz')
2863 endif
2864 end subroutine mt_q_plane_xz
2865
2866 subroutine mt_q_plane_yz(ymin,ymax,ny,zmin,zmax,nz,x0,dL, &
2867 max_steps,csv_file,b_min)
2868 ! Compute standard Cartesian logQ diagnostics on a constant-x seed plane.
2869 integer, intent(in) :: ny,nz,max_steps
2870 double precision, intent(in) :: ymin,ymax,zmin,zmax,x0,dl
2871 character(len=*), intent(in) :: csv_file
2872 double precision, intent(in), optional :: b_min
2873
2874 if (present(b_min)) then
2875 call mt_q_plane_axis(ymin,ymax,ny,zmin,zmax,nz,x0,2,3,1, &
2876 dl,max_steps,csv_file,'mt_q_plane_yz','iy,iz',b_min)
2877 else
2878 call mt_q_plane_axis(ymin,ymax,ny,zmin,zmax,nz,x0,2,3,1, &
2879 dl,max_steps,csv_file,'mt_q_plane_yz','iy,iz')
2880 endif
2881 end subroutine mt_q_plane_yz
2882
2883 subroutine mt_qperp_plane_xy(xmin,xmax,nx,ymin,ymax,ny,z0,dL, &
2884 max_steps,csv_file,b_min)
2885 ! Compute Method-II Qperp diagnostics on a constant-z source plane.
2886 integer, intent(in) :: nx,ny,max_steps
2887 double precision, intent(in) :: xmin,xmax,ymin,ymax,z0,dl
2888 character(len=*), intent(in) :: csv_file
2889 double precision, intent(in), optional :: b_min
2890
2891 if (present(b_min)) then
2892 call mt_qperp_plane_axis(xmin,xmax,nx,ymin,ymax,ny,z0,1,2,3, &
2893 dl,max_steps,csv_file,'mt_qperp_plane_xy','ix,iy',b_min)
2894 else
2895 call mt_qperp_plane_axis(xmin,xmax,nx,ymin,ymax,ny,z0,1,2,3, &
2896 dl,max_steps,csv_file,'mt_qperp_plane_xy','ix,iy')
2897 endif
2898 end subroutine mt_qperp_plane_xy
2899
2900 subroutine mt_qperp_plane_xz(xmin,xmax,nx,zmin,zmax,nz,y0,dL, &
2901 max_steps,csv_file,b_min)
2902 ! Compute Method-II Qperp diagnostics on a constant-y source plane.
2903 integer, intent(in) :: nx,nz,max_steps
2904 double precision, intent(in) :: xmin,xmax,zmin,zmax,y0,dl
2905 character(len=*), intent(in) :: csv_file
2906 double precision, intent(in), optional :: b_min
2907
2908 if (present(b_min)) then
2909 call mt_qperp_plane_axis(xmin,xmax,nx,zmin,zmax,nz,y0,1,3,2, &
2910 dl,max_steps,csv_file,'mt_qperp_plane_xz','ix,iz',b_min)
2911 else
2912 call mt_qperp_plane_axis(xmin,xmax,nx,zmin,zmax,nz,y0,1,3,2, &
2913 dl,max_steps,csv_file,'mt_qperp_plane_xz','ix,iz')
2914 endif
2915 end subroutine mt_qperp_plane_xz
2916
2917 subroutine mt_qperp_plane_yz(ymin,ymax,ny,zmin,zmax,nz,x0,dL, &
2918 max_steps,csv_file,b_min)
2919 ! Compute Method-II Qperp diagnostics on a constant-x source plane.
2920 integer, intent(in) :: ny,nz,max_steps
2921 double precision, intent(in) :: ymin,ymax,zmin,zmax,x0,dl
2922 character(len=*), intent(in) :: csv_file
2923 double precision, intent(in), optional :: b_min
2924
2925 if (present(b_min)) then
2926 call mt_qperp_plane_axis(ymin,ymax,ny,zmin,zmax,nz,x0,2,3,1, &
2927 dl,max_steps,csv_file,'mt_qperp_plane_yz','iy,iz',b_min)
2928 else
2929 call mt_qperp_plane_axis(ymin,ymax,ny,zmin,zmax,nz,x0,2,3,1, &
2930 dl,max_steps,csv_file,'mt_qperp_plane_yz','iy,iz')
2931 endif
2932 end subroutine mt_qperp_plane_yz
2933
2934 subroutine mt_qperp_plane_arbitrary(origin,e1,e2,s1min,s1max,n1, &
2935 s2min,s2max,n2,dL,max_steps,csv_file,b_min)
2936 ! Compute Method-II Qperp diagnostics on an orthonormal arbitrary plane.
2937 integer, intent(in) :: n1,n2,max_steps
2938 double precision, intent(in) :: origin(ndim),e1(ndim),e2(ndim)
2939 double precision, intent(in) :: s1min,s1max,s2min,s2max,dl
2940 character(len=*), intent(in) :: csv_file
2941 double precision, intent(in), optional :: b_min
2942
2943 type(trace_qperp_result), allocatable :: results(:)
2944 double precision, allocatable :: seeds(:,:),s1(:),s2(:)
2945 integer :: nseed
2946
2947 if (.not.mt_validate_arbitrary_plane_basis(e1,e2,s1min,s1max,n1, &
2948 s2min,s2max,n2,'mt_qperp_plane_arbitrary')) then
2949 call mt_write_qperp_arbitrary_header(csv_file, &
2950 'mt_qperp_plane_arbitrary')
2951 return
2952 endif
2953
2954 call mt_build_arbitrary_plane_seeds(origin,e1,e2,s1min,s1max,n1, &
2955 s2min,s2max,n2,seeds,s1,s2)
2956
2957 nseed=n1*n2
2958 allocate(results(nseed))
2959 if (present(b_min)) then
2960 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,results,b_min)
2961 else
2962 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,results)
2963 endif
2964 call mt_write_qperp_arbitrary_csv(results,s1,s2,n1,n2,csv_file, &
2965 'mt_qperp_plane_arbitrary')
2966
2967 deallocate(seeds,s1,s2,results)
2968 end subroutine mt_qperp_plane_arbitrary
2969
2970 subroutine mt_fieldline_products_plane_arbitrary(origin,e1,e2,s1min, &
2971 s1max,n1,s2min,s2max,n2,dL,max_steps,csv_file,b_min, &
2972 compute_length,compute_twist,compute_q,compute_qperp,vtu_file, &
2973 write_csv)
2974 ! Write selected per-field-line diagnostics on an arbitrary seed plane.
2975 integer, intent(in) :: n1,n2,max_steps
2976 double precision, intent(in) :: origin(ndim),e1(ndim),e2(ndim)
2977 double precision, intent(in) :: s1min,s1max,s2min,s2max,dl
2978 character(len=*), intent(in) :: csv_file
2979 double precision, intent(in), optional :: b_min
2980 logical, intent(in), optional :: compute_length,compute_twist
2981 logical, intent(in), optional :: compute_q,compute_qperp
2982 character(len=*), intent(in), optional :: vtu_file
2983 logical, intent(in), optional :: write_csv
2984
2985 type(trace_length_result), allocatable :: length_results(:)
2986 type(trace_twist_result), allocatable :: twist_results(:)
2987 type(trace_qperp_result), allocatable :: q_results(:)
2988 type(trace_qperp_result), allocatable :: qperp_results(:)
2989 double precision, allocatable :: seeds(:,:),s1(:),s2(:)
2990 integer :: nseed
2991 logical :: do_length,do_twist,do_q,do_qperp,do_csv
2992
2993 do_length=.true.
2994 do_twist=.false.
2995 do_q=.false.
2996 do_qperp=.false.
2997 do_csv=.true.
2998 if (present(compute_length)) do_length=compute_length
2999 if (present(compute_twist)) do_twist=compute_twist
3000 if (present(compute_q)) do_q=compute_q
3001 if (present(compute_qperp)) do_qperp=compute_qperp
3002 if (present(write_csv)) do_csv=write_csv
3003
3004 if (.not.mt_validate_arbitrary_plane_basis(e1,e2,s1min,s1max,n1, &
3005 s2min,s2max,n2,'mt_fieldline_products_plane_arbitrary')) then
3006 if (do_csv) then
3007 call mt_write_fieldline_products_plane_arbitrary_header(csv_file, &
3008 'mt_fieldline_products_plane_arbitrary',do_twist,do_q,do_qperp)
3009 endif
3010 if (present(vtu_file)) then
3011 if (len_trim(vtu_file)>0) then
3012 call mt_write_fieldline_products_vtu_empty(vtu_file,do_twist, &
3013 do_q,do_qperp,'mt_fieldline_products_plane_arbitrary', &
3014 do_length=do_length)
3015 endif
3016 endif
3017 return
3018 endif
3019 call mt_require_requested_science(do_length,do_twist,do_q,do_qperp, &
3020 'mt_fieldline_products_plane_arbitrary')
3021
3022 call mt_build_arbitrary_plane_seeds(origin,e1,e2,s1min,s1max,n1, &
3023 s2min,s2max,n2,seeds,s1,s2)
3024
3025 nseed=n1*n2
3026 allocate(length_results(nseed))
3027 if (do_twist) then
3028 allocate(twist_results(nseed))
3029 else
3030 allocate(twist_results(0))
3031 endif
3032 if (do_q) then
3033 allocate(q_results(nseed))
3034 else
3035 allocate(q_results(0))
3036 endif
3037 if (do_qperp) then
3038 allocate(qperp_results(nseed))
3039 else
3040 allocate(qperp_results(0))
3041 endif
3042
3043 if (present(b_min)) then
3044 call mt_trace_fieldline_products_seedset(seeds,nseed,dl,max_steps, &
3045 length_results,twist_results,q_results,qperp_results,do_twist, &
3046 do_q,do_qperp,b_min)
3047 else
3048 call mt_trace_fieldline_products_seedset(seeds,nseed,dl,max_steps, &
3049 length_results,twist_results,q_results,qperp_results,do_twist, &
3050 do_q,do_qperp)
3051 endif
3052
3053 if (do_csv) then
3054 call mt_write_fieldline_products_plane_arbitrary_csv(length_results, &
3055 twist_results,q_results,qperp_results,s1,s2,n1,n2,csv_file, &
3056 do_twist,do_q,do_qperp,'mt_fieldline_products_plane_arbitrary')
3057 endif
3058 if (present(vtu_file)) then
3059 if (len_trim(vtu_file)>0) then
3060 call mt_write_fieldline_products_vtu_plane(vtu_file, &
3061 length_results,twist_results,q_results,qperp_results,n1,n2, &
3062 do_twist,do_q,do_qperp,'mt_fieldline_products_plane_arbitrary', &
3063 do_length=do_length)
3064 endif
3065 endif
3066
3067 deallocate(qperp_results,q_results,twist_results,length_results,seeds,s1,s2)
3069
3070 subroutine mt_topology_plane_xy(xmin,xmax,nx,ymin,ymax,ny,z0,dL, &
3071 max_steps,length_csv,twist_csv,mapping_csv,b_min)
3072 ! Trace a constant-z seed plane once and write selected topology products.
3073 integer, intent(in) :: nx,ny,max_steps
3074 double precision, intent(in) :: xmin,xmax,ymin,ymax,z0,dl
3075 character(len=*), intent(in) :: length_csv,twist_csv,mapping_csv
3076 double precision, intent(in), optional :: b_min
3077
3078 if (present(b_min)) then
3079 call mt_topology_plane_axis(xmin,xmax,nx,ymin,ymax,ny,z0,1,2,3, &
3080 dl,max_steps,length_csv,twist_csv,mapping_csv, &
3081 'mt_topology_plane_xy','ix,iy','ix,iy',b_min)
3082 else
3083 call mt_topology_plane_axis(xmin,xmax,nx,ymin,ymax,ny,z0,1,2,3, &
3084 dl,max_steps,length_csv,twist_csv,mapping_csv, &
3085 'mt_topology_plane_xy','ix,iy','ix,iy')
3086 endif
3087 end subroutine mt_topology_plane_xy
3088
3089 subroutine mt_topology_plane_xz(xmin,xmax,nx,zmin,zmax,nz,y0,dL, &
3090 max_steps,length_csv,twist_csv,mapping_csv,b_min)
3091 ! Trace a constant-y seed plane once and write selected topology products.
3092 integer, intent(in) :: nx,nz,max_steps
3093 double precision, intent(in) :: xmin,xmax,zmin,zmax,y0,dl
3094 character(len=*), intent(in) :: length_csv,twist_csv,mapping_csv
3095 double precision, intent(in), optional :: b_min
3096
3097 if (present(b_min)) then
3098 call mt_topology_plane_axis(xmin,xmax,nx,zmin,zmax,nz,y0,1,3,2, &
3099 dl,max_steps,length_csv,twist_csv,mapping_csv, &
3100 'mt_topology_plane_xz','ix,iz','i,j',b_min)
3101 else
3102 call mt_topology_plane_axis(xmin,xmax,nx,zmin,zmax,nz,y0,1,3,2, &
3103 dl,max_steps,length_csv,twist_csv,mapping_csv, &
3104 'mt_topology_plane_xz','ix,iz','i,j')
3105 endif
3106 end subroutine mt_topology_plane_xz
3107
3108 subroutine mt_topology_plane_yz(ymin,ymax,ny,zmin,zmax,nz,x0,dL, &
3109 max_steps,length_csv,twist_csv,mapping_csv,b_min)
3110 ! Trace a constant-x seed plane once and write selected topology products.
3111 integer, intent(in) :: ny,nz,max_steps
3112 double precision, intent(in) :: ymin,ymax,zmin,zmax,x0,dl
3113 character(len=*), intent(in) :: length_csv,twist_csv,mapping_csv
3114 double precision, intent(in), optional :: b_min
3115
3116 if (present(b_min)) then
3117 call mt_topology_plane_axis(ymin,ymax,ny,zmin,zmax,nz,x0,2,3,1, &
3118 dl,max_steps,length_csv,twist_csv,mapping_csv, &
3119 'mt_topology_plane_yz','iy,iz','i,j',b_min)
3120 else
3121 call mt_topology_plane_axis(ymin,ymax,ny,zmin,zmax,nz,x0,2,3,1, &
3122 dl,max_steps,length_csv,twist_csv,mapping_csv, &
3123 'mt_topology_plane_yz','iy,iz','i,j')
3124 endif
3125 end subroutine mt_topology_plane_yz
3126
3127 subroutine mt_qsl_plane_vtu_xy(xmin,xmax,nx,ymin,ymax,ny,z0,dL, &
3128 max_steps,vtu_file,b_min)
3129 ! Write a full topology/QSL visualization file for a constant-z plane.
3130 integer, intent(in) :: nx,ny,max_steps
3131 double precision, intent(in) :: xmin,xmax,ymin,ymax,z0,dl
3132 character(len=*), intent(in) :: vtu_file
3133 double precision, intent(in), optional :: b_min
3134
3135 if (present(b_min)) then
3136 call mt_qsl_plane_vtu_axis(xmin,xmax,nx,ymin,ymax,ny,z0,1,2,3, &
3137 dl,max_steps,vtu_file,'mt_qsl_plane_vtu_xy',b_min)
3138 else
3139 call mt_qsl_plane_vtu_axis(xmin,xmax,nx,ymin,ymax,ny,z0,1,2,3, &
3140 dl,max_steps,vtu_file,'mt_qsl_plane_vtu_xy')
3141 endif
3142 end subroutine mt_qsl_plane_vtu_xy
3143
3144 subroutine mt_qsl_plane_vtu_xz(xmin,xmax,nx,zmin,zmax,nz,y0,dL, &
3145 max_steps,vtu_file,b_min)
3146 ! Write a full topology/QSL visualization file for a constant-y plane.
3147 integer, intent(in) :: nx,nz,max_steps
3148 double precision, intent(in) :: xmin,xmax,zmin,zmax,y0,dl
3149 character(len=*), intent(in) :: vtu_file
3150 double precision, intent(in), optional :: b_min
3151
3152 if (present(b_min)) then
3153 call mt_qsl_plane_vtu_axis(xmin,xmax,nx,zmin,zmax,nz,y0,1,3,2, &
3154 dl,max_steps,vtu_file,'mt_qsl_plane_vtu_xz',b_min)
3155 else
3156 call mt_qsl_plane_vtu_axis(xmin,xmax,nx,zmin,zmax,nz,y0,1,3,2, &
3157 dl,max_steps,vtu_file,'mt_qsl_plane_vtu_xz')
3158 endif
3159 end subroutine mt_qsl_plane_vtu_xz
3160
3161 subroutine mt_qsl_plane_vtu_yz(ymin,ymax,ny,zmin,zmax,nz,x0,dL, &
3162 max_steps,vtu_file,b_min)
3163 ! Write a full topology/QSL visualization file for a constant-x plane.
3164 integer, intent(in) :: ny,nz,max_steps
3165 double precision, intent(in) :: ymin,ymax,zmin,zmax,x0,dl
3166 character(len=*), intent(in) :: vtu_file
3167 double precision, intent(in), optional :: b_min
3168
3169 if (present(b_min)) then
3170 call mt_qsl_plane_vtu_axis(ymin,ymax,ny,zmin,zmax,nz,x0,2,3,1, &
3171 dl,max_steps,vtu_file,'mt_qsl_plane_vtu_yz',b_min)
3172 else
3173 call mt_qsl_plane_vtu_axis(ymin,ymax,ny,zmin,zmax,nz,x0,2,3,1, &
3174 dl,max_steps,vtu_file,'mt_qsl_plane_vtu_yz')
3175 endif
3176 end subroutine mt_qsl_plane_vtu_yz
3177
3178 subroutine mt_qsl_plane_vti_xy(xmin,xmax,nx,ymin,ymax,ny,z0,dL, &
3179 max_steps,vti_file,do_length,do_twist,do_q,do_qperp,b_min)
3180 ! Write requested minimal science arrays for a constant-z plane as VTI.
3181 integer, intent(in) :: nx,ny,max_steps
3182 double precision, intent(in) :: xmin,xmax,ymin,ymax,z0,dl
3183 character(len=*), intent(in) :: vti_file
3184 logical, intent(in) :: do_length,do_twist,do_q,do_qperp
3185 double precision, intent(in), optional :: b_min
3186
3187 if (present(b_min)) then
3188 call mt_qsl_plane_vti_axis(xmin,xmax,nx,ymin,ymax,ny,z0, &
3189 1,2,3,dl,max_steps,vti_file,do_twist,do_q,do_qperp, &
3190 'mt_qsl_plane_vti_xy',b_min,do_length=do_length)
3191 else
3192 call mt_qsl_plane_vti_axis(xmin,xmax,nx,ymin,ymax,ny,z0, &
3193 1,2,3,dl,max_steps,vti_file,do_twist,do_q,do_qperp, &
3194 'mt_qsl_plane_vti_xy',do_length=do_length)
3195 endif
3196 end subroutine mt_qsl_plane_vti_xy
3197
3198 subroutine mt_qsl_plane_vti_xz(xmin,xmax,nx,zmin,zmax,nz,y0,dL, &
3199 max_steps,vti_file,do_length,do_twist,do_q,do_qperp,b_min)
3200 ! Write requested minimal science arrays for a constant-y plane as VTI.
3201 integer, intent(in) :: nx,nz,max_steps
3202 double precision, intent(in) :: xmin,xmax,zmin,zmax,y0,dl
3203 character(len=*), intent(in) :: vti_file
3204 logical, intent(in) :: do_length,do_twist,do_q,do_qperp
3205 double precision, intent(in), optional :: b_min
3206
3207 if (present(b_min)) then
3208 call mt_qsl_plane_vti_axis(xmin,xmax,nx,zmin,zmax,nz,y0, &
3209 1,3,2,dl,max_steps,vti_file,do_twist,do_q,do_qperp, &
3210 'mt_qsl_plane_vti_xz',b_min,do_length=do_length)
3211 else
3212 call mt_qsl_plane_vti_axis(xmin,xmax,nx,zmin,zmax,nz,y0, &
3213 1,3,2,dl,max_steps,vti_file,do_twist,do_q,do_qperp, &
3214 'mt_qsl_plane_vti_xz',do_length=do_length)
3215 endif
3216 end subroutine mt_qsl_plane_vti_xz
3217
3218 subroutine mt_qsl_plane_vti_yz(ymin,ymax,ny,zmin,zmax,nz,x0,dL, &
3219 max_steps,vti_file,do_length,do_twist,do_q,do_qperp,b_min)
3220 ! Write requested minimal science arrays for a constant-x plane as VTI.
3221 integer, intent(in) :: ny,nz,max_steps
3222 double precision, intent(in) :: ymin,ymax,zmin,zmax,x0,dl
3223 character(len=*), intent(in) :: vti_file
3224 logical, intent(in) :: do_length,do_twist,do_q,do_qperp
3225 double precision, intent(in), optional :: b_min
3226
3227 if (present(b_min)) then
3228 call mt_qsl_plane_vti_axis(ymin,ymax,ny,zmin,zmax,nz,x0, &
3229 2,3,1,dl,max_steps,vti_file,do_twist,do_q,do_qperp, &
3230 'mt_qsl_plane_vti_yz',b_min,do_length=do_length)
3231 else
3232 call mt_qsl_plane_vti_axis(ymin,ymax,ny,zmin,zmax,nz,x0, &
3233 2,3,1,dl,max_steps,vti_file,do_twist,do_q,do_qperp, &
3234 'mt_qsl_plane_vti_yz',do_length=do_length)
3235 endif
3236 end subroutine mt_qsl_plane_vti_yz
3237
3238 subroutine mt_write_cartesian_vti_pointdata(vti_file,xmin,xmax,nx, &
3239 ymin,ymax,ny,zmin,zmax,nz,length_total,qperp,status)
3240 ! Low-level appended-binary VTI writer for future uniform seed-volume
3241 ! products. PointData values use i-fastest ordering:
3242 ! ipoint = (k-1)*nx*ny + (j-1)*nx + i.
3243 character(len=*), intent(in) :: vti_file
3244 integer, intent(in) :: nx,ny,nz
3245 double precision, intent(in) :: xmin,xmax,ymin,ymax,zmin,zmax
3246 double precision, intent(in) :: length_total(:),qperp(:)
3247 integer, intent(in) :: status(:)
3248
3249 integer :: npoint
3250 double precision :: origin(3),spacing(3)
3251
3252 if (len_trim(vti_file)==0) then
3253 call mpistop('mt_write_cartesian_vti_pointdata requires a VTI file')
3254 endif
3255 if (nx<=0 .or. ny<=0 .or. nz<=0) then
3256 call mpistop('mt_write_cartesian_vti_pointdata requires positive dimensions')
3257 endif
3258
3259 npoint=nx*ny*nz
3260 if (size(length_total)/=npoint .or. size(qperp)/=npoint .or. &
3261 size(status)/=npoint) then
3262 call mpistop('mt_write_cartesian_vti_pointdata array size mismatch')
3263 endif
3264
3265 origin=(/ xmin,ymin,zmin /)
3266 spacing(1)=mt_vti_axis_spacing(xmin,xmax,nx)
3267 spacing(2)=mt_vti_axis_spacing(ymin,ymax,ny)
3268 spacing(3)=mt_vti_axis_spacing(zmin,zmax,nz)
3269 call mt_write_vti_pointdata_fixed(vti_file,origin,spacing,nx,ny,nz, &
3270 length_total,qperp,status,'mt_write_cartesian_vti_pointdata')
3272
3273 subroutine mt_fieldline_products_volume_vti(xmin,xmax,nx, &
3274 ymin,ymax,ny,zmin,zmax,nz,dL,max_steps,vti_file,b_min, &
3275 compute_length,compute_twist,compute_q,compute_qperp,chunk_nz)
3276 ! Compute per-seed field-line products on a user-defined uniform
3277 ! Cartesian sampling volume and write PointData to appended-binary VTI.
3278 integer, intent(in) :: nx,ny,nz,max_steps
3279 double precision, intent(in) :: xmin,xmax,ymin,ymax,zmin,zmax,dl
3280 character(len=*), intent(in) :: vti_file
3281 double precision, intent(in), optional :: b_min
3282 logical, intent(in), optional :: compute_length,compute_twist
3283 logical, intent(in), optional :: compute_q,compute_qperp
3284 integer, intent(in), optional :: chunk_nz
3285
3286 type(trace_length_result), allocatable :: length_slab(:)
3287 type(trace_twist_result), allocatable :: twist_slab(:)
3288 type(trace_qperp_result), allocatable :: q_slab(:)
3289 type(trace_qperp_result), allocatable :: qperp_slab(:)
3290 type(mt_volume_products) :: products
3291 double precision, allocatable :: seeds_slab(:,:)
3292 double precision :: origin(3),spacing(3)
3293 integer :: k_start,k_end,slab_nz,slab_nseed,nseed
3294 integer :: chunk_nz_eff
3295 integer(kind=8) :: nseed64
3296 logical :: do_length,do_twist,do_q,do_qperp
3297
3298 if (len_trim(vti_file)==0) then
3299 call mpistop('mt_fieldline_products_volume_vti requires a VTI file')
3300 endif
3301 if (npe/=1) then
3302 call mpistop('mt_fieldline_products_volume_vti currently requires npe=1')
3303 endif
3304 if (ndim/=3) then
3305 call mpistop('mt_fieldline_products_volume_vti requires 3D Cartesian geometry')
3306 endif
3307 {^ifthreed
3308 select case (geo_coordinate)
3309 case (geo_cartesian)
3310 ! The output VTI is a user-defined sampling lattice; RK2 tracing can
3311 ! interpolate through either slab-uniform or AMR Cartesian grids.
3312 case (geo_cartesian_stretched)
3313 case default
3314 call mpistop('volume_vti requires Cartesian geometry')
3315 end select
3316 }
3317 if (nx<=0 .or. ny<=0 .or. nz<=0) then
3318 call mpistop('mt_fieldline_products_volume_vti requires positive dimensions')
3319 endif
3320 if (xmax<xmin .or. ymax<ymin .or. zmax<zmin) then
3321 call mpistop('mt_fieldline_products_volume_vti requires ordered bounds')
3322 endif
3323
3324 nseed64=int(nx,kind=8)*int(ny,kind=8)*int(nz,kind=8)
3325 if (nseed64>int(huge(nseed),kind=8)) then
3326 call mpistop('mt_fieldline_products_volume_vti seed count overflows integer')
3327 endif
3328 if (nseed64>1000000_8) then
3329 write(*,'(a,i0,a)') &
3330 'mt_fieldline_products_volume_vti warning: volume has ', &
3331 nseed64,' seeds; final VTI arrays still scale with nseed'
3332 endif
3333 nseed=int(nseed64)
3334
3335 do_length=.true.
3336 do_twist=.false.
3337 do_q=.false.
3338 do_qperp=.false.
3339 if (present(compute_length)) do_length=compute_length
3340 if (present(compute_twist)) do_twist=compute_twist
3341 if (present(compute_q)) do_q=compute_q
3342 if (present(compute_qperp)) do_qperp=compute_qperp
3343 call mt_require_requested_science(do_length,do_twist,do_q,do_qperp, &
3344 'mt_fieldline_products_volume_vti')
3345
3346 chunk_nz_eff=nz
3347 if (present(chunk_nz)) chunk_nz_eff=max(1,min(nz,chunk_nz))
3348
3349 origin=(/ xmin,ymin,zmin /)
3350 spacing(1)=mt_vti_axis_spacing(xmin,xmax,nx)
3351 spacing(2)=mt_vti_axis_spacing(ymin,ymax,ny)
3352 spacing(3)=mt_vti_axis_spacing(zmin,zmax,nz)
3353
3354 call mt_allocate_volume_products(products,nseed,do_twist,do_q,do_qperp)
3355
3356 do k_start=1,nz,chunk_nz_eff
3357 k_end=min(nz,k_start+chunk_nz_eff-1)
3358 slab_nz=k_end-k_start+1
3359 slab_nseed=nx*ny*slab_nz
3360
3361 allocate(seeds_slab(slab_nseed,ndim))
3362 call mt_build_volume_slab_seeds(seeds_slab,xmin,ymin,zmin, &
3363 spacing,nx,ny,k_start,slab_nz)
3364
3365 allocate(length_slab(slab_nseed))
3366 if (do_twist) then
3367 allocate(twist_slab(slab_nseed))
3368 else
3369 allocate(twist_slab(0))
3370 endif
3371 if (do_q) then
3372 allocate(q_slab(slab_nseed))
3373 else
3374 allocate(q_slab(0))
3375 endif
3376
3377 if (do_qperp) then
3378 allocate(qperp_slab(slab_nseed))
3379 else
3380 allocate(qperp_slab(0))
3381 endif
3382
3383 if (present(b_min)) then
3384 call mt_trace_fieldline_products_seedset(seeds_slab,slab_nseed, &
3385 dl,max_steps,length_slab,twist_slab,q_slab,qperp_slab, &
3386 do_twist,do_q,do_qperp,b_min)
3387 else
3388 call mt_trace_fieldline_products_seedset(seeds_slab,slab_nseed, &
3389 dl,max_steps,length_slab,twist_slab,q_slab,qperp_slab, &
3390 do_twist,do_q,do_qperp)
3391 endif
3392
3393 call mt_copy_volume_length_slab(products,length_slab,nx,ny, &
3394 k_start,slab_nz)
3395 deallocate(length_slab)
3396
3397 if (do_twist) then
3398 call mt_copy_volume_twist_slab(products,twist_slab,nx,ny, &
3399 k_start,slab_nz)
3400 endif
3401 deallocate(twist_slab)
3402
3403 if (do_q) then
3404 call mt_copy_volume_q_slab(products,q_slab,nx,ny,k_start,slab_nz)
3405 endif
3406 deallocate(q_slab)
3407
3408 if (do_qperp) then
3409 call mt_copy_volume_qperp_slab(products,qperp_slab,nx,ny, &
3410 k_start,slab_nz)
3411 endif
3412 deallocate(qperp_slab)
3413
3414 deallocate(seeds_slab)
3415 enddo
3416
3417 call mt_write_fieldline_products_volume_vti(vti_file,origin,spacing, &
3418 nx,ny,nz,products, &
3419 do_length,do_twist,do_q,do_qperp,'mt_fieldline_products_volume_vti')
3420 call mt_deallocate_volume_products(products)
3422
3423 subroutine mt_trace_fieldline_products_seedset(seeds,nseed,dL,max_steps, &
3424 length_results,twist_results,q_results,qperp_results,do_twist, &
3425 do_q,do_qperp,b_min)
3426 integer, intent(in) :: nseed,max_steps
3427 double precision, intent(in) :: seeds(nseed,ndim),dl
3428 type(trace_length_result), intent(out) :: length_results(nseed)
3429 type(trace_twist_result), intent(out) :: twist_results(:)
3430 type(trace_qperp_result), intent(out) :: q_results(:)
3431 type(trace_qperp_result), intent(out) :: qperp_results(:)
3432 logical, intent(in) :: do_twist,do_q,do_qperp
3433 double precision, intent(in), optional :: b_min
3434
3435 type(trace_topology_result) :: topology_one(1)
3436 double precision :: seed_local(ndim),seed_one(1,ndim)
3437 integer :: iseed
3438 character(len=mt_task_name_len) :: integrator
3439
3440 integrator=mt_lowercase(trim(mt_trace_integrator))
3441 if (do_q .and. do_qperp .and. geo_coordinate==geo_spherical .and. &
3442 (integrator=='rk2' .or. integrator=='rk45_spherical')) then
3443 if (do_twist) then
3444 if (present(b_min)) then
3445 call trace_field_spherical_rmin_q_qperp_multi(seeds,nseed,dl, &
3446 max_steps,q_results,qperp_results,b_min, &
3447 twist_results=twist_results)
3448 else
3449 call trace_field_spherical_rmin_q_qperp_multi(seeds,nseed,dl, &
3450 max_steps,q_results,qperp_results, &
3451 twist_results=twist_results)
3452 endif
3453 else
3454 if (present(b_min)) then
3455 call trace_field_spherical_rmin_q_qperp_multi(seeds,nseed,dl, &
3456 max_steps,q_results,qperp_results,b_min)
3457 else
3458 call trace_field_spherical_rmin_q_qperp_multi(seeds,nseed,dl, &
3459 max_steps,q_results,qperp_results)
3460 endif
3461 endif
3462 call mt_q0_trace_to_length(q_results,nseed,length_results)
3463 return
3464 endif
3465
3466 if (do_q .and. do_qperp .and. geo_coordinate/=geo_spherical .and. &
3467 (integrator=='rk2' .or. integrator=='rk45_cartesian')) then
3468 if (do_twist) then
3469 if (present(b_min)) then
3470 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3471 qperp_results,b_min,twist_results=twist_results)
3472 else
3473 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3474 qperp_results,twist_results=twist_results)
3475 endif
3476 else
3477 if (present(b_min)) then
3478 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3479 qperp_results,b_min)
3480 else
3481 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3482 qperp_results)
3483 endif
3484 endif
3485 q_results=qperp_results
3486 call mt_qperp_trace_to_length(qperp_results,nseed,length_results)
3487 return
3488 endif
3489
3490 if (do_qperp .and. .not.do_q .and. &
3491 (integrator=='rk2' .or. &
3492 (integrator=='rk45_cartesian' .and. geo_coordinate/=geo_spherical) &
3493 .or. (integrator=='rk45_spherical' .and. &
3494 geo_coordinate==geo_spherical))) then
3495 select case (geo_coordinate)
3496 case (geo_spherical)
3497 if (do_twist) then
3498 if (present(b_min)) then
3499 call trace_field_spherical_qperp_multi(seeds,nseed,dl,max_steps, &
3500 qperp_results,b_min,twist_results=twist_results)
3501 else
3502 call trace_field_spherical_qperp_multi(seeds,nseed,dl,max_steps, &
3503 qperp_results,twist_results=twist_results)
3504 endif
3505 else
3506 if (present(b_min)) then
3507 call trace_field_spherical_qperp_multi(seeds,nseed,dl,max_steps, &
3508 qperp_results,b_min)
3509 else
3510 call trace_field_spherical_qperp_multi(seeds,nseed,dl,max_steps, &
3511 qperp_results)
3512 endif
3513 endif
3514 case default
3515 if (do_twist) then
3516 if (present(b_min)) then
3517 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3518 qperp_results,b_min,twist_results=twist_results)
3519 else
3520 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3521 qperp_results,twist_results=twist_results)
3522 endif
3523 else
3524 if (present(b_min)) then
3525 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3526 qperp_results,b_min)
3527 else
3528 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3529 qperp_results)
3530 endif
3531 endif
3532 end select
3533 call mt_qperp_trace_to_length(qperp_results,nseed,length_results)
3534 return
3535 endif
3536
3537 if (do_q .and. .not.do_qperp .and. geo_coordinate==geo_spherical .and. &
3538 (integrator=='rk2' .or. integrator=='rk45_spherical')) then
3539 if (do_twist) then
3540 if (present(b_min)) then
3541 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
3542 q_results,b_min,twist_results=twist_results)
3543 else
3544 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
3545 q_results,twist_results=twist_results)
3546 endif
3547 else
3548 if (present(b_min)) then
3549 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
3550 q_results,b_min)
3551 else
3552 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
3553 q_results)
3554 endif
3555 endif
3556 call mt_q0_trace_to_length(q_results,nseed,length_results)
3557 return
3558 endif
3559
3560 if (do_q .and. .not.do_qperp .and. &
3561 (integrator=='rk2' .or. &
3562 (integrator=='rk45_cartesian' .and. geo_coordinate/=geo_spherical) &
3563 .or. (integrator=='rk45_spherical' .and. &
3564 geo_coordinate==geo_spherical))) then
3565 if (integrator=='rk2') then
3566 if (geo_coordinate==geo_cartesian_stretched .or. &
3567 (geo_coordinate==geo_cartesian .and. .not.slab_uniform)) then
3568 if (do_twist) then
3569 if (present(b_min)) then
3570 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3571 q_results,b_min,twist_results=twist_results)
3572 else
3573 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3574 q_results,twist_results=twist_results)
3575 endif
3576 else
3577 if (present(b_min)) then
3578 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3579 q_results,b_min)
3580 else
3581 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3582 q_results)
3583 endif
3584 endif
3585 else
3586 if (do_twist) then
3587 if (present(b_min)) then
3588 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
3589 max_steps,q_results,b_min,twist_results=twist_results)
3590 else
3591 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
3592 max_steps,q_results,twist_results=twist_results)
3593 endif
3594 else
3595 if (present(b_min)) then
3596 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
3597 max_steps,q_results,b_min)
3598 else
3599 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
3600 max_steps,q_results)
3601 endif
3602 endif
3603 endif
3604 else if (integrator=='rk45_cartesian') then
3605 if (do_twist) then
3606 if (present(b_min)) then
3607 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3608 q_results,b_min,twist_results=twist_results)
3609 else
3610 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3611 q_results,twist_results=twist_results)
3612 endif
3613 else
3614 if (present(b_min)) then
3615 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3616 q_results,b_min)
3617 else
3618 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,q_results)
3619 endif
3620 endif
3621 else
3622 if (do_twist) then
3623 if (present(b_min)) then
3624 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl, &
3625 max_steps,q_results,b_min,twist_results=twist_results)
3626 else
3627 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl, &
3628 max_steps,q_results,twist_results=twist_results)
3629 endif
3630 else
3631 if (present(b_min)) then
3632 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl, &
3633 max_steps,q_results,b_min)
3634 else
3635 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl, &
3636 max_steps,q_results)
3637 endif
3638 endif
3639 endif
3640 call mt_q0_trace_to_length(q_results,nseed,length_results)
3641 return
3642 endif
3643
3644 if (present(b_min)) then
3645 !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(iseed,seed_local,seed_one,topology_one) SCHEDULE(DYNAMIC,16)
3646 do iseed=1,nseed
3647 seed_local=seeds(iseed,:)
3648 if (do_twist) then
3649 seed_one(1,:)=seed_local
3650 call trace_field_topology_multi(seed_one,1,dl,max_steps, &
3651 topology_one,need_twist=.true.,need_mapping=.false., &
3652 b_min=b_min)
3653 call mt_topology_to_length(topology_one,1, &
3654 length_results(iseed:iseed))
3655 call mt_topology_to_twist(topology_one,1, &
3656 twist_results(iseed:iseed))
3657 else
3658 call trace_field_length_single(seed_local,dl,max_steps, &
3659 length_results(iseed),b_min)
3660 endif
3661 if (do_qperp) then
3662 call trace_field_qperp_single(seed_local,dl,max_steps, &
3663 qperp_results(iseed),b_min)
3664 endif
3665 enddo
3666 !$OMP END PARALLEL DO
3667 else
3668 !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(iseed,seed_local,seed_one,topology_one) SCHEDULE(DYNAMIC,16)
3669 do iseed=1,nseed
3670 seed_local=seeds(iseed,:)
3671 if (do_twist) then
3672 seed_one(1,:)=seed_local
3673 call trace_field_topology_multi(seed_one,1,dl,max_steps, &
3674 topology_one,need_twist=.true.,need_mapping=.false.)
3675 call mt_topology_to_length(topology_one,1, &
3676 length_results(iseed:iseed))
3677 call mt_topology_to_twist(topology_one,1, &
3678 twist_results(iseed:iseed))
3679 else
3680 call trace_field_length_single(seed_local,dl,max_steps, &
3681 length_results(iseed))
3682 endif
3683 if (do_qperp) then
3684 call trace_field_qperp_single(seed_local,dl,max_steps, &
3685 qperp_results(iseed))
3686 endif
3687 enddo
3688 !$OMP END PARALLEL DO
3689 endif
3690
3691 if (do_q) then
3692 if (mt_lowercase(trim(mt_trace_integrator))=='rk45_cartesian') then
3693 if (present(b_min)) then
3694 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,q_results, &
3695 b_min)
3696 else
3697 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,q_results)
3698 endif
3699 else if (geo_coordinate==geo_spherical) then
3700 if (present(b_min)) then
3701 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl, &
3702 max_steps,q_results,b_min)
3703 else
3704 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl, &
3705 max_steps,q_results)
3706 endif
3707 else if (do_qperp) then
3708 q_results=qperp_results
3709 else
3710 if (present(b_min)) then
3711 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,q_results, &
3712 b_min)
3713 else
3714 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,q_results)
3715 endif
3716 endif
3717 endif
3718 end subroutine mt_trace_fieldline_products_seedset
3719
3720 subroutine mt_twist_single(seed,dL,max_steps,csv_file,b_min)
3721 ! Trace one magnetic field line and write its length and twist summary.
3722 double precision, intent(in) :: seed(ndim),dl
3723 integer, intent(in) :: max_steps
3724 character(len=*), intent(in) :: csv_file
3725 double precision, intent(in), optional :: b_min
3726
3727 type(trace_twist_result) :: result
3728 double precision :: seed_xyz(3)
3729 integer :: csv_unit,io_status
3730
3731 if (npe/=1) then
3732 call mpistop('mt_twist_single currently requires npe=1')
3733 endif
3734 if (ndim/=3 .or. .not.slab_uniform) then
3735 call mpistop('mt_twist_single requires 3D uniform Cartesian geometry')
3736 endif
3737
3738 if (present(b_min)) then
3739 call trace_field_twist_single(seed,dl,max_steps,result,b_min)
3740 else
3741 call trace_field_twist_single(seed,dl,max_steps,result)
3742 endif
3743
3744 seed_xyz=0.d0
3745 seed_xyz(1:ndim)=result%line%seed
3746
3747 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
3748 action='write',form='formatted',iostat=io_status)
3749 if (io_status/=0) then
3750 call mpistop('mt_twist_single could not open CSV file')
3751 endif
3752
3753 write(csv_unit,'(a)',iostat=io_status) &
3754 'seed_id,seed_x,seed_y,seed_z,'// &
3755 'length_total,length_backward,length_forward,'// &
3756 'twist_total,twist_backward,twist_forward,'// &
3757 'nstep_backward,nstep_forward,'// &
3758 'status_backward,status_forward'
3759 if (io_status/=0) then
3760 close(csv_unit)
3761 call mpistop('mt_twist_single could not write CSV header')
3762 endif
3763
3764 write(csv_unit,'(i0,9(",",es24.16),4(",",i0))',iostat=io_status) &
3765 1,seed_xyz,result%line%total_length, &
3766 result%line%backward_length,result%line%forward_length, &
3767 result%total_twist,result%backward_twist,result%forward_twist, &
3768 result%line%backward_nstep,result%line%forward_nstep, &
3769 result%line%backward_status,result%line%forward_status
3770 if (io_status/=0) then
3771 close(csv_unit)
3772 call mpistop('mt_twist_single could not write CSV data')
3773 endif
3774
3775 close(csv_unit)
3776 end subroutine mt_twist_single
3777
3778 subroutine mt_twist_seeds(seeds,nseed,dL,max_steps,csv_file,b_min)
3779 ! Trace multiple magnetic field lines and write length and twist summaries.
3780 integer, intent(in) :: nseed,max_steps
3781 double precision, intent(in) :: seeds(nseed,ndim),dl
3782 character(len=*), intent(in) :: csv_file
3783 double precision, intent(in), optional :: b_min
3784
3785 type(trace_twist_result), allocatable :: results(:)
3786 double precision :: seed_xyz(3)
3787 integer :: csv_unit,io_status,iseed
3788
3789 if (npe/=1) then
3790 call mpistop('mt_twist_seeds currently requires npe=1')
3791 endif
3792 if (ndim/=3 .or. .not.slab_uniform) then
3793 call mpistop('mt_twist_seeds requires 3D uniform Cartesian geometry')
3794 endif
3795 if (nseed<0) then
3796 call mpistop('mt_twist_seeds requires nseed>=0')
3797 endif
3798
3799 allocate(results(nseed))
3800 if (present(b_min)) then
3801 call trace_field_twist_multi(seeds,nseed,dl,max_steps,results,b_min)
3802 else
3803 call trace_field_twist_multi(seeds,nseed,dl,max_steps,results)
3804 endif
3805
3806 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
3807 action='write',form='formatted',iostat=io_status)
3808 if (io_status/=0) then
3809 deallocate(results)
3810 call mpistop('mt_twist_seeds could not open CSV file')
3811 endif
3812
3813 write(csv_unit,'(a)',iostat=io_status) &
3814 'seed_id,seed_x,seed_y,seed_z,'// &
3815 'length_total,length_backward,length_forward,'// &
3816 'twist_total,twist_backward,twist_forward,'// &
3817 'nstep_backward,nstep_forward,'// &
3818 'status_backward,status_forward'
3819 if (io_status/=0) then
3820 close(csv_unit)
3821 deallocate(results)
3822 call mpistop('mt_twist_seeds could not write CSV header')
3823 endif
3824
3825 do iseed=1,nseed
3826 seed_xyz=0.d0
3827 seed_xyz(1:ndim)=results(iseed)%line%seed
3828 write(csv_unit,'(i0,9(",",es24.16),4(",",i0))',iostat=io_status) &
3829 iseed,seed_xyz,results(iseed)%line%total_length, &
3830 results(iseed)%line%backward_length, &
3831 results(iseed)%line%forward_length, &
3832 results(iseed)%total_twist,results(iseed)%backward_twist, &
3833 results(iseed)%forward_twist, &
3834 results(iseed)%line%backward_nstep, &
3835 results(iseed)%line%forward_nstep, &
3836 results(iseed)%line%backward_status, &
3837 results(iseed)%line%forward_status
3838 if (io_status/=0) then
3839 close(csv_unit)
3840 deallocate(results)
3841 call mpistop('mt_twist_seeds could not write CSV data')
3842 endif
3843 enddo
3844
3845 close(csv_unit)
3846 deallocate(results)
3847 end subroutine mt_twist_seeds
3848
3849 subroutine mt_twist_plane_xy(xmin,xmax,nx,ymin,ymax,ny,z0,dL, &
3850 max_steps,csv_file,b_min)
3851 ! Trace a uniform seed grid on a constant-z plane and write twist summaries.
3852 integer, intent(in) :: nx,ny,max_steps
3853 double precision, intent(in) :: xmin,xmax,ymin,ymax,z0,dl
3854 character(len=*), intent(in) :: csv_file
3855 double precision, intent(in), optional :: b_min
3856
3857 if (present(b_min)) then
3858 call mt_twist_plane_axis(xmin,xmax,nx,ymin,ymax,ny,z0,1,2,3, &
3859 dl,max_steps,csv_file,'mt_twist_plane_xy','ix,iy',b_min)
3860 else
3861 call mt_twist_plane_axis(xmin,xmax,nx,ymin,ymax,ny,z0,1,2,3, &
3862 dl,max_steps,csv_file,'mt_twist_plane_xy','ix,iy')
3863 endif
3864 end subroutine mt_twist_plane_xy
3865
3866 subroutine mt_length_plane_xz(xmin,xmax,nx,zmin,zmax,nz,y0,dL, &
3867 max_steps,csv_file,b_min)
3868 integer, intent(in) :: nx,nz,max_steps
3869 double precision, intent(in) :: xmin,xmax,zmin,zmax,y0,dl
3870 character(len=*), intent(in) :: csv_file
3871 double precision, intent(in), optional :: b_min
3872
3873 if (present(b_min)) then
3874 call mt_length_plane_axis(xmin,xmax,nx,zmin,zmax,nz,y0,1,3,2, &
3875 dl,max_steps,csv_file,'mt_length_plane_xz','i,j',b_min)
3876 else
3877 call mt_length_plane_axis(xmin,xmax,nx,zmin,zmax,nz,y0,1,3,2, &
3878 dl,max_steps,csv_file,'mt_length_plane_xz','i,j')
3879 endif
3880 end subroutine mt_length_plane_xz
3881
3882 subroutine mt_length_plane_yz(ymin,ymax,ny,zmin,zmax,nz,x0,dL, &
3883 max_steps,csv_file,b_min)
3884 integer, intent(in) :: ny,nz,max_steps
3885 double precision, intent(in) :: ymin,ymax,zmin,zmax,x0,dl
3886 character(len=*), intent(in) :: csv_file
3887 double precision, intent(in), optional :: b_min
3888
3889 if (present(b_min)) then
3890 call mt_length_plane_axis(ymin,ymax,ny,zmin,zmax,nz,x0,2,3,1, &
3891 dl,max_steps,csv_file,'mt_length_plane_yz','i,j',b_min)
3892 else
3893 call mt_length_plane_axis(ymin,ymax,ny,zmin,zmax,nz,x0,2,3,1, &
3894 dl,max_steps,csv_file,'mt_length_plane_yz','i,j')
3895 endif
3896 end subroutine mt_length_plane_yz
3897
3898 subroutine mt_twist_plane_xz(xmin,xmax,nx,zmin,zmax,nz,y0,dL, &
3899 max_steps,csv_file,b_min)
3900 integer, intent(in) :: nx,nz,max_steps
3901 double precision, intent(in) :: xmin,xmax,zmin,zmax,y0,dl
3902 character(len=*), intent(in) :: csv_file
3903 double precision, intent(in), optional :: b_min
3904
3905 if (present(b_min)) then
3906 call mt_twist_plane_axis(xmin,xmax,nx,zmin,zmax,nz,y0,1,3,2, &
3907 dl,max_steps,csv_file,'mt_twist_plane_xz','i,j',b_min)
3908 else
3909 call mt_twist_plane_axis(xmin,xmax,nx,zmin,zmax,nz,y0,1,3,2, &
3910 dl,max_steps,csv_file,'mt_twist_plane_xz','i,j')
3911 endif
3912 end subroutine mt_twist_plane_xz
3913
3914 subroutine mt_twist_plane_yz(ymin,ymax,ny,zmin,zmax,nz,x0,dL, &
3915 max_steps,csv_file,b_min)
3916 integer, intent(in) :: ny,nz,max_steps
3917 double precision, intent(in) :: ymin,ymax,zmin,zmax,x0,dl
3918 character(len=*), intent(in) :: csv_file
3919 double precision, intent(in), optional :: b_min
3920
3921 if (present(b_min)) then
3922 call mt_twist_plane_axis(ymin,ymax,ny,zmin,zmax,nz,x0,2,3,1, &
3923 dl,max_steps,csv_file,'mt_twist_plane_yz','i,j',b_min)
3924 else
3925 call mt_twist_plane_axis(ymin,ymax,ny,zmin,zmax,nz,x0,2,3,1, &
3926 dl,max_steps,csv_file,'mt_twist_plane_yz','i,j')
3927 endif
3928 end subroutine mt_twist_plane_yz
3929
3930 subroutine mt_length_plane_axis(c1min,c1max,n1,c2min,c2max,n2, &
3931 fixed_value,axis1,axis2,fixed_axis,dL,max_steps,csv_file, &
3932 caller,index_header,b_min)
3933 integer, intent(in) :: n1,n2,axis1,axis2,fixed_axis,max_steps
3934 double precision, intent(in) :: c1min,c1max,c2min,c2max
3935 double precision, intent(in) :: fixed_value,dl
3936 character(len=*), intent(in) :: csv_file,caller,index_header
3937 double precision, intent(in), optional :: b_min
3938
3939 type(trace_length_result), allocatable :: results(:)
3940 double precision, allocatable :: seeds(:,:)
3941 integer :: nseed
3942
3943 call mt_validate_axis_plane(c1min,c1max,n1,c2min,c2max,n2,caller)
3944 call mt_build_axis_plane_seeds(c1min,c1max,n1,c2min,c2max,n2, &
3945 fixed_value,axis1,axis2,fixed_axis,seeds)
3946
3947 nseed=n1*n2
3948 allocate(results(nseed))
3949 if (present(b_min)) then
3950 call trace_field_length_multi(seeds,nseed,dl,max_steps,results,b_min)
3951 else
3952 call trace_field_length_multi(seeds,nseed,dl,max_steps,results)
3953 endif
3954 call mt_write_length_plane_csv(results,n1,n2,csv_file,caller, &
3955 index_header)
3956
3957 deallocate(seeds,results)
3958 end subroutine mt_length_plane_axis
3959
3960 subroutine mt_twist_plane_axis(c1min,c1max,n1,c2min,c2max,n2, &
3961 fixed_value,axis1,axis2,fixed_axis,dL,max_steps,csv_file, &
3962 caller,index_header,b_min)
3963 integer, intent(in) :: n1,n2,axis1,axis2,fixed_axis,max_steps
3964 double precision, intent(in) :: c1min,c1max,c2min,c2max
3965 double precision, intent(in) :: fixed_value,dl
3966 character(len=*), intent(in) :: csv_file,caller,index_header
3967 double precision, intent(in), optional :: b_min
3968
3969 type(trace_twist_result), allocatable :: results(:)
3970 double precision, allocatable :: seeds(:,:)
3971 integer :: nseed
3972
3973 call mt_validate_axis_plane(c1min,c1max,n1,c2min,c2max,n2,caller)
3974 call mt_build_axis_plane_seeds(c1min,c1max,n1,c2min,c2max,n2, &
3975 fixed_value,axis1,axis2,fixed_axis,seeds)
3976
3977 nseed=n1*n2
3978 allocate(results(nseed))
3979 if (present(b_min)) then
3980 call trace_field_twist_multi(seeds,nseed,dl,max_steps,results,b_min)
3981 else
3982 call trace_field_twist_multi(seeds,nseed,dl,max_steps,results)
3983 endif
3984 call mt_write_twist_plane_csv(results,n1,n2,csv_file,caller, &
3985 index_header)
3986
3987 deallocate(seeds,results)
3988 end subroutine mt_twist_plane_axis
3989
3990 subroutine mt_q_plane_axis(c1min,c1max,n1,c2min,c2max,n2, &
3991 fixed_value,axis1,axis2,fixed_axis,dL,max_steps,csv_file,caller, &
3992 index_header,b_min)
3993 integer, intent(in) :: n1,n2,axis1,axis2,fixed_axis,max_steps
3994 double precision, intent(in) :: c1min,c1max,c2min,c2max
3995 double precision, intent(in) :: fixed_value,dl
3996 character(len=*), intent(in) :: csv_file,caller,index_header
3997 double precision, intent(in), optional :: b_min
3998
3999 type(trace_qperp_result), allocatable :: results(:)
4000 double precision, allocatable :: seeds(:,:)
4001 integer :: nseed
4002
4003 call mt_validate_axis_plane(c1min,c1max,n1,c2min,c2max,n2,caller)
4004 call mt_build_axis_plane_seeds(c1min,c1max,n1,c2min,c2max,n2, &
4005 fixed_value,axis1,axis2,fixed_axis,seeds)
4006
4007 nseed=n1*n2
4008 allocate(results(nseed))
4009 if (present(b_min)) then
4010 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,results,b_min)
4011 else
4012 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,results)
4013 endif
4014 call mt_write_q_plane_csv(results,n1,n2,csv_file,caller,index_header)
4015
4016 deallocate(seeds,results)
4017 end subroutine mt_q_plane_axis
4018
4019 subroutine mt_qperp_plane_axis(c1min,c1max,n1,c2min,c2max,n2, &
4020 fixed_value,axis1,axis2,fixed_axis,dL,max_steps,csv_file, &
4021 caller,index_header,b_min)
4022 integer, intent(in) :: n1,n2,axis1,axis2,fixed_axis,max_steps
4023 double precision, intent(in) :: c1min,c1max,c2min,c2max
4024 double precision, intent(in) :: fixed_value,dl
4025 character(len=*), intent(in) :: csv_file,caller,index_header
4026 double precision, intent(in), optional :: b_min
4027
4028 type(trace_qperp_result), allocatable :: results(:)
4029 double precision, allocatable :: seeds(:,:)
4030 integer :: nseed
4031
4032 call mt_validate_axis_plane(c1min,c1max,n1,c2min,c2max,n2,caller)
4033 call mt_build_axis_plane_seeds(c1min,c1max,n1,c2min,c2max,n2, &
4034 fixed_value,axis1,axis2,fixed_axis,seeds)
4035
4036 nseed=n1*n2
4037 allocate(results(nseed))
4038 if (present(b_min)) then
4039 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,results,b_min)
4040 else
4041 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,results)
4042 endif
4043 call mt_write_qperp_plane_csv(results,n1,n2,csv_file,caller, &
4044 index_header)
4045
4046 deallocate(seeds,results)
4047 end subroutine mt_qperp_plane_axis
4048
4049 subroutine mt_axis_plane_products_csv_axis(c1min,c1max,n1,c2min,c2max, &
4050 n2,fixed_value,axis1,axis2,fixed_axis,dL,max_steps,length_csv, &
4051 twist_csv,q_csv,qperp_csv,caller,index_header,length_index_header, &
4052 b_min)
4053 integer, intent(in) :: n1,n2,axis1,axis2,fixed_axis,max_steps
4054 double precision, intent(in) :: c1min,c1max,c2min,c2max
4055 double precision, intent(in) :: fixed_value,dl
4056 character(len=*), intent(in) :: length_csv,twist_csv,q_csv,qperp_csv
4057 character(len=*), intent(in) :: caller,index_header,length_index_header
4058 double precision, intent(in), optional :: b_min
4059
4060 type(trace_length_result), allocatable :: length_results(:)
4061 type(trace_twist_result), allocatable :: twist_results(:)
4062 type(trace_qperp_result), allocatable :: q_results(:)
4063 type(trace_qperp_result), allocatable :: qperp_results(:)
4064 double precision, allocatable :: seeds(:,:)
4065 integer :: nseed
4066 logical :: do_twist,do_q,do_qperp
4067
4068 call mt_validate_axis_plane(c1min,c1max,n1,c2min,c2max,n2,caller)
4069 if (len_trim(length_csv)==0) then
4070 call mpistop(trim(caller)//' requires a length CSV file')
4071 endif
4072
4073 do_twist=len_trim(twist_csv)>0
4074 do_q=len_trim(q_csv)>0
4075 do_qperp=len_trim(qperp_csv)>0
4076
4077 call mt_build_axis_plane_seeds(c1min,c1max,n1,c2min,c2max,n2, &
4078 fixed_value,axis1,axis2,fixed_axis,seeds)
4079 nseed=n1*n2
4080 allocate(length_results(nseed))
4081 if (do_twist) then
4082 allocate(twist_results(nseed))
4083 else
4084 allocate(twist_results(0))
4085 endif
4086 if (do_q) then
4087 allocate(q_results(nseed))
4088 else
4089 allocate(q_results(0))
4090 endif
4091 if (do_qperp) then
4092 allocate(qperp_results(nseed))
4093 else
4094 allocate(qperp_results(0))
4095 endif
4096
4097 if (present(b_min)) then
4098 call mt_trace_fieldline_products_seedset(seeds,nseed,dl,max_steps, &
4099 length_results,twist_results,q_results,qperp_results, &
4100 do_twist,do_q,do_qperp,b_min)
4101 else
4102 call mt_trace_fieldline_products_seedset(seeds,nseed,dl,max_steps, &
4103 length_results,twist_results,q_results,qperp_results, &
4104 do_twist,do_q,do_qperp)
4105 endif
4106
4107 call mt_write_length_plane_csv(length_results,n1,n2,length_csv, &
4108 caller,length_index_header)
4109 if (do_twist) then
4110 call mt_write_twist_plane_csv(twist_results,n1,n2,twist_csv, &
4111 caller,length_index_header)
4112 endif
4113 if (do_q) then
4114 call mt_write_q_plane_csv(q_results,n1,n2,q_csv,caller, &
4115 index_header)
4116 endif
4117 if (do_qperp) then
4118 call mt_write_qperp_plane_csv(qperp_results,n1,n2,qperp_csv, &
4119 caller,index_header)
4120 endif
4121
4122 deallocate(qperp_results,q_results,twist_results,length_results,seeds)
4123 end subroutine mt_axis_plane_products_csv_axis
4124
4125 subroutine mt_topology_plane_axis(c1min,c1max,n1,c2min,c2max,n2, &
4126 fixed_value,axis1,axis2,fixed_axis,dL,max_steps,length_csv, &
4127 twist_csv,mapping_csv,caller,index_header,length_index_header, &
4128 b_min)
4129 integer, intent(in) :: n1,n2,axis1,axis2,fixed_axis,max_steps
4130 double precision, intent(in) :: c1min,c1max,c2min,c2max
4131 double precision, intent(in) :: fixed_value,dl
4132 character(len=*), intent(in) :: length_csv,twist_csv,mapping_csv
4133 character(len=*), intent(in) :: caller,index_header,length_index_header
4134 double precision, intent(in), optional :: b_min
4135
4136 type(trace_topology_result), allocatable :: topology(:)
4137 type(trace_length_result), allocatable :: length_results(:)
4138 type(trace_twist_result), allocatable :: twist_results(:)
4139 type(trace_mapping_result), allocatable :: mapping_results(:)
4140 double precision, allocatable :: seeds(:,:)
4141 double precision :: source_normal(3)
4142 integer :: nseed
4143 logical :: write_twist,write_mapping,need_mapping
4144
4145 call mt_validate_axis_plane(c1min,c1max,n1,c2min,c2max,n2,caller)
4146 if (len_trim(length_csv)==0) then
4147 call mpistop(trim(caller)//' requires a length CSV file')
4148 endif
4149
4150 write_twist=len_trim(twist_csv)>0
4151 write_mapping=len_trim(mapping_csv)>0
4152 need_mapping=write_mapping
4153
4154 call mt_build_axis_plane_seeds(c1min,c1max,n1,c2min,c2max,n2, &
4155 fixed_value,axis1,axis2,fixed_axis,seeds)
4156 nseed=n1*n2
4157 allocate(topology(nseed),length_results(nseed))
4158 source_normal=0.d0
4159 source_normal(fixed_axis)=1.d0
4160 if (present(b_min)) then
4161 call trace_field_topology_multi(seeds,nseed,dl,max_steps,topology, &
4162 need_twist=write_twist,need_mapping=need_mapping,b_min=b_min, &
4163 source_normal=source_normal)
4164 else
4165 call trace_field_topology_multi(seeds,nseed,dl,max_steps,topology, &
4166 need_twist=write_twist,need_mapping=need_mapping, &
4167 source_normal=source_normal)
4168 endif
4169
4170 call mt_topology_to_length(topology,nseed,length_results)
4171 call mt_write_length_plane_csv(length_results,n1,n2,length_csv, &
4172 caller,length_index_header)
4173
4174 if (write_twist) then
4175 allocate(twist_results(nseed))
4176 call mt_topology_to_twist(topology,nseed,twist_results)
4177 call mt_write_twist_plane_csv(twist_results,n1,n2,twist_csv, &
4178 caller,length_index_header)
4179 deallocate(twist_results)
4180 endif
4181
4182 if (need_mapping) then
4183 allocate(mapping_results(nseed))
4184 call mt_topology_to_mapping(topology,nseed,mapping_results)
4185 if (write_mapping) then
4186 call mt_write_mapping_plane_csv(mapping_results,n1,n2,mapping_csv, &
4187 caller,index_header)
4188 endif
4189 deallocate(mapping_results)
4190 endif
4191
4192 deallocate(length_results,topology,seeds)
4193 end subroutine mt_topology_plane_axis
4194
4195 subroutine mt_qsl_plane_vtu_axis(c1min,c1max,n1,c2min,c2max,n2, &
4196 fixed_value,axis1,axis2,fixed_axis,dL,max_steps,vtu_file,caller, &
4197 b_min)
4198 integer, intent(in) :: n1,n2,axis1,axis2,fixed_axis,max_steps
4199 double precision, intent(in) :: c1min,c1max,c2min,c2max
4200 double precision, intent(in) :: fixed_value,dl
4201 character(len=*), intent(in) :: vtu_file,caller
4202 double precision, intent(in), optional :: b_min
4203
4204 type(trace_length_result), allocatable :: length_results(:)
4205 type(trace_twist_result), allocatable :: twist_results(:)
4206 type(trace_mapping_result), allocatable :: mapping_results(:)
4207 type(trace_qperp_result), allocatable :: qperp_results(:)
4208 double precision, allocatable :: seeds(:,:)
4209 double precision :: source_normal(3)
4210 integer :: nseed
4211 logical :: need_mapping
4212
4213 call mt_validate_axis_plane(c1min,c1max,n1,c2min,c2max,n2,caller)
4214 if (len_trim(vtu_file)==0) then
4215 call mpistop(trim(caller)//' requires a VTU file')
4216 endif
4217
4218 call mt_build_axis_plane_seeds(c1min,c1max,n1,c2min,c2max,n2, &
4219 fixed_value,axis1,axis2,fixed_axis,seeds)
4220 nseed=n1*n2
4221 allocate(length_results(nseed),twist_results(nseed), &
4222 mapping_results(nseed),qperp_results(nseed))
4223
4224 source_normal=0.d0
4225 source_normal(fixed_axis)=1.d0
4226 need_mapping=mt_vtk_detail_is_full()
4227 if (need_mapping) then
4228 if (present(b_min)) then
4229 call mt_trace_qsl_plane_full(seeds,nseed,dl,max_steps,source_normal, &
4230 qperp_results,twist_results,mapping_results,b_min)
4231 else
4232 call mt_trace_qsl_plane_full(seeds,nseed,dl,max_steps,source_normal, &
4233 qperp_results,twist_results,mapping_results)
4234 endif
4235 call mt_qperp_trace_to_length(qperp_results,nseed,length_results)
4236 else
4237 if (present(b_min)) then
4238 call mt_trace_qsl_plane_minimal(seeds,nseed,dl,max_steps, &
4239 qperp_results,twist_results,b_min)
4240 else
4241 call mt_trace_qsl_plane_minimal(seeds,nseed,dl,max_steps, &
4242 qperp_results,twist_results)
4243 endif
4244 call mt_qperp_trace_to_length(qperp_results,nseed,length_results)
4245 endif
4246
4247 call mt_write_qsl_plane_vtu(vtu_file,length_results,twist_results, &
4248 mapping_results,qperp_results,n1,n2,caller)
4249
4250 deallocate(qperp_results,mapping_results,twist_results, &
4251 length_results,seeds)
4252 end subroutine mt_qsl_plane_vtu_axis
4253
4254 subroutine mt_qsl_plane_vti_axis(c1min,c1max,n1,c2min,c2max,n2, &
4255 fixed_value,axis1,axis2,fixed_axis,dL,max_steps,vti_file, &
4256 do_twist,do_q,do_qperp,caller,b_min,do_length)
4257 integer, intent(in) :: n1,n2,axis1,axis2,fixed_axis,max_steps
4258 double precision, intent(in) :: c1min,c1max,c2min,c2max
4259 double precision, intent(in) :: fixed_value,dl
4260 character(len=*), intent(in) :: vti_file,caller
4261 logical, intent(in) :: do_twist,do_q,do_qperp
4262 double precision, intent(in), optional :: b_min
4263 logical, intent(in), optional :: do_length
4264
4265 type(trace_length_result), allocatable :: length_results(:)
4266 type(trace_twist_result), allocatable :: twist_results(:)
4267 type(trace_qperp_result), allocatable :: q_results(:)
4268 type(trace_qperp_result), allocatable :: qperp_results(:)
4269 type(mt_volume_products) :: products
4270 double precision, allocatable :: seeds(:,:)
4271 double precision :: origin(3),spacing(3)
4272 integer :: nseed,nx_vti,ny_vti,nz_vti
4273 logical :: do_length_eff
4274
4275 call mt_validate_axis_plane(c1min,c1max,n1,c2min,c2max,n2,caller)
4276 if (len_trim(vti_file)==0) then
4277 call mpistop(trim(caller)//' requires a VTI file')
4278 endif
4279 do_length_eff=.true.
4280 if (present(do_length)) do_length_eff=do_length
4281 call mt_require_requested_science(do_length_eff,do_twist,do_q,do_qperp, &
4282 caller)
4283
4284 call mt_build_axis_plane_seeds(c1min,c1max,n1,c2min,c2max,n2, &
4285 fixed_value,axis1,axis2,fixed_axis,seeds)
4286 nseed=n1*n2
4287
4288 allocate(length_results(nseed))
4289 if (do_twist) then
4290 allocate(twist_results(nseed))
4291 else
4292 allocate(twist_results(0))
4293 endif
4294 if (do_q) then
4295 allocate(q_results(nseed))
4296 else
4297 allocate(q_results(0))
4298 endif
4299 if (do_qperp) then
4300 allocate(qperp_results(nseed))
4301 else
4302 allocate(qperp_results(0))
4303 endif
4304
4305 if (present(b_min)) then
4306 call mt_trace_fieldline_products_seedset(seeds,nseed,dl,max_steps, &
4307 length_results,twist_results,q_results,qperp_results,do_twist, &
4308 do_q,do_qperp,b_min)
4309 else
4310 call mt_trace_fieldline_products_seedset(seeds,nseed,dl,max_steps, &
4311 length_results,twist_results,q_results,qperp_results,do_twist, &
4312 do_q,do_qperp)
4313 endif
4314
4315 call mt_allocate_volume_products(products,nseed,do_twist,do_q,do_qperp)
4316 call mt_copy_volume_length_slab(products,length_results,nseed,1,1,1)
4317 if (do_twist) call mt_copy_volume_twist_slab(products,twist_results, &
4318 nseed,1,1,1)
4319 if (do_q) call mt_copy_volume_q_slab(products,q_results,nseed,1,1,1)
4320 if (do_qperp) call mt_copy_volume_qperp_slab(products,qperp_results, &
4321 nseed,1,1,1)
4322
4323 origin=0.d0
4324 spacing=0.d0
4325 nx_vti=1
4326 ny_vti=1
4327 nz_vti=1
4328 origin(axis1)=c1min
4329 origin(axis2)=c2min
4330 origin(fixed_axis)=fixed_value
4331 spacing(axis1)=mt_vti_axis_spacing(c1min,c1max,n1)
4332 spacing(axis2)=mt_vti_axis_spacing(c2min,c2max,n2)
4333 select case (axis1)
4334 case (1)
4335 nx_vti=n1
4336 case (2)
4337 ny_vti=n1
4338 case (3)
4339 nz_vti=n1
4340 end select
4341 select case (axis2)
4342 case (1)
4343 nx_vti=n2
4344 case (2)
4345 ny_vti=n2
4346 case (3)
4347 nz_vti=n2
4348 end select
4349
4350 call mt_write_fieldline_products_volume_vti(vti_file,origin,spacing, &
4351 nx_vti,ny_vti,nz_vti,products,do_length_eff,do_twist,do_q, &
4352 do_qperp,caller)
4353
4354 call mt_deallocate_volume_products(products)
4355 deallocate(qperp_results,q_results,twist_results,length_results,seeds)
4356 end subroutine mt_qsl_plane_vti_axis
4357
4358 subroutine mt_trace_qsl_plane_full(seeds,nseed,dL,max_steps,source_normal, &
4359 qperp_results,twist_results,mapping_results,b_min)
4360 integer, intent(in) :: nseed,max_steps
4361 double precision, intent(in) :: seeds(nseed,ndim),dl,source_normal(3)
4362 type(trace_qperp_result), intent(out) :: qperp_results(nseed)
4363 type(trace_twist_result), intent(out) :: twist_results(nseed)
4364 type(trace_mapping_result), intent(out) :: mapping_results(nseed)
4365 double precision, intent(in), optional :: b_min
4366
4367 double precision :: seed_local(ndim)
4368 integer :: iseed
4369
4370 if (present(b_min)) then
4371 !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(iseed,seed_local) SCHEDULE(DYNAMIC,16)
4372 do iseed=1,nseed
4373 seed_local=seeds(iseed,:)
4374 call trace_field_mapping_single(seed_local,dl,max_steps, &
4375 mapping_results(iseed),b_min,source_normal)
4376 enddo
4377 !$OMP END PARALLEL DO
4378 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
4379 qperp_results,b_min,twist_results=twist_results)
4380 else
4381 !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(iseed,seed_local) SCHEDULE(DYNAMIC,16)
4382 do iseed=1,nseed
4383 seed_local=seeds(iseed,:)
4384 call trace_field_mapping_single(seed_local,dl,max_steps, &
4385 mapping_results(iseed),source_normal=source_normal)
4386 enddo
4387 !$OMP END PARALLEL DO
4388 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
4389 qperp_results,twist_results=twist_results)
4390 endif
4391 end subroutine mt_trace_qsl_plane_full
4392
4393 subroutine mt_trace_qsl_plane_minimal(seeds,nseed,dL,max_steps, &
4394 qperp_results,twist_results,b_min)
4395 integer, intent(in) :: nseed,max_steps
4396 double precision, intent(in) :: seeds(nseed,ndim),dl
4397 type(trace_qperp_result), intent(out) :: qperp_results(nseed)
4398 type(trace_twist_result), intent(out) :: twist_results(nseed)
4399 double precision, intent(in), optional :: b_min
4400
4401 if (present(b_min)) then
4402 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
4403 qperp_results,b_min,twist_results=twist_results)
4404 else
4405 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
4406 qperp_results,twist_results=twist_results)
4407 endif
4408 end subroutine mt_trace_qsl_plane_minimal
4409
4410 subroutine mt_qperp_to_length(qperp_results,nseed,results)
4411 integer, intent(in) :: nseed
4412 type(trace_qperp_result), intent(in) :: qperp_results(nseed)
4413 type(trace_length_result), intent(out) :: results(nseed)
4414
4415 integer :: iseed
4416
4417 do iseed=1,nseed
4418 results(iseed)%seed=qperp_results(iseed)%seed
4419 results(iseed)%forward_footpoint=qperp_results(iseed)%forward_endpoint
4420 results(iseed)%backward_footpoint=qperp_results(iseed)%backward_endpoint
4421 results(iseed)%forward_status=qperp_results(iseed)%forward_status
4422 results(iseed)%backward_status=qperp_results(iseed)%backward_status
4423 results(iseed)%forward_nstep=0
4424 results(iseed)%backward_nstep=0
4425 if (qperp_results(iseed)%valid_q0) then
4426 results(iseed)%forward_length=qperp_results(iseed)%forward_length
4427 results(iseed)%backward_length=qperp_results(iseed)%backward_length
4428 results(iseed)%total_length=results(iseed)%forward_length &
4429 +results(iseed)%backward_length
4430 else
4431 results(iseed)%forward_length=0.d0
4432 results(iseed)%backward_length=0.d0
4433 results(iseed)%total_length=0.d0
4434 endif
4435 enddo
4436 end subroutine mt_qperp_to_length
4437
4438 subroutine mt_qperp_trace_to_length(qperp_results,nseed,results)
4439 integer, intent(in) :: nseed
4440 type(trace_qperp_result), intent(in) :: qperp_results(nseed)
4441 type(trace_length_result), intent(out) :: results(nseed)
4442
4443 integer :: iseed
4444
4445 do iseed=1,nseed
4446 results(iseed)%seed=qperp_results(iseed)%seed
4447 results(iseed)%forward_footpoint=qperp_results(iseed)%forward_endpoint
4448 results(iseed)%backward_footpoint=qperp_results(iseed)%backward_endpoint
4449 results(iseed)%forward_length=qperp_results(iseed)%forward_length
4450 results(iseed)%backward_length=qperp_results(iseed)%backward_length
4451 results(iseed)%total_length=results(iseed)%forward_length+ &
4452 results(iseed)%backward_length
4453 results(iseed)%forward_nstep=qperp_results(iseed)%forward_nstep
4454 results(iseed)%backward_nstep=qperp_results(iseed)%backward_nstep
4455 results(iseed)%forward_status=qperp_results(iseed)%forward_status
4456 results(iseed)%backward_status=qperp_results(iseed)%backward_status
4457 enddo
4458 end subroutine mt_qperp_trace_to_length
4459
4460 subroutine mt_qperp_trace_to_topology(qperp_results,twist_results,nseed, &
4461 topology,do_twist)
4462 integer, intent(in) :: nseed
4463 type(trace_qperp_result), intent(in) :: qperp_results(nseed)
4464 type(trace_twist_result), intent(in) :: twist_results(:)
4465 type(trace_topology_result), intent(out) :: topology(nseed)
4466 logical, intent(in) :: do_twist
4467
4468 integer :: iseed
4469
4470 do iseed=1,nseed
4471 topology(iseed)%seed=qperp_results(iseed)%seed
4472 topology(iseed)%length_forward=qperp_results(iseed)%forward_length
4473 topology(iseed)%length_backward=qperp_results(iseed)%backward_length
4474 topology(iseed)%length_total=topology(iseed)%length_forward &
4475 +topology(iseed)%length_backward
4476 topology(iseed)%twist_forward=0.d0
4477 topology(iseed)%twist_backward=0.d0
4478 topology(iseed)%twist_total=0.d0
4479 if (do_twist) then
4480 topology(iseed)%twist_forward=twist_results(iseed)%forward_twist
4481 topology(iseed)%twist_backward=twist_results(iseed)%backward_twist
4482 topology(iseed)%twist_total=twist_results(iseed)%total_twist
4483 endif
4484 topology(iseed)%forward_endpoint=qperp_results(iseed)%forward_endpoint
4485 topology(iseed)%backward_endpoint=qperp_results(iseed)%backward_endpoint
4486 topology(iseed)%forward_nstep=qperp_results(iseed)%forward_nstep
4487 topology(iseed)%backward_nstep=qperp_results(iseed)%backward_nstep
4488 topology(iseed)%forward_face=qperp_results(iseed)%forward_face
4489 topology(iseed)%backward_face=qperp_results(iseed)%backward_face
4490 topology(iseed)%forward_status=qperp_results(iseed)%forward_status
4491 topology(iseed)%backward_status=qperp_results(iseed)%backward_status
4492 topology(iseed)%map_forward_endpoint=qperp_results(iseed)%forward_endpoint
4493 topology(iseed)%map_backward_endpoint=qperp_results(iseed)%backward_endpoint
4494 topology(iseed)%map_forward_length=qperp_results(iseed)%forward_length
4495 topology(iseed)%map_backward_length=qperp_results(iseed)%backward_length
4496 topology(iseed)%map_forward_face=qperp_results(iseed)%forward_face
4497 topology(iseed)%map_backward_face=qperp_results(iseed)%backward_face
4498 topology(iseed)%map_forward_status=qperp_results(iseed)%forward_status
4499 topology(iseed)%map_backward_status=qperp_results(iseed)%backward_status
4500 topology(iseed)%source_B=0.d0
4501 topology(iseed)%forward_B=0.d0
4502 topology(iseed)%backward_B=0.d0
4503 topology(iseed)%source_B(1:ndim)=qperp_results(iseed)%B_seed
4504 topology(iseed)%forward_B(1:ndim)=qperp_results(iseed)%forward_B
4505 topology(iseed)%backward_B(1:ndim)=qperp_results(iseed)%backward_B
4506 topology(iseed)%source_Bn=0.d0
4507 topology(iseed)%forward_Bn=0.d0
4508 topology(iseed)%backward_Bn=0.d0
4509 topology(iseed)%has_twist=do_twist
4510 topology(iseed)%has_mapping=.false.
4511 topology(iseed)%valid_twist=.false.
4512 topology(iseed)%status_twist=qperp_results(iseed)%status
4513 if (do_twist) then
4514 topology(iseed)%valid_twist=twist_results(iseed)%valid_twist
4515 topology(iseed)%status_twist=twist_results(iseed)%status_twist
4516 endif
4517 topology(iseed)%valid=qperp_results(iseed)%status==trace_status_boundary
4518 topology(iseed)%status=qperp_results(iseed)%status
4519 enddo
4520 end subroutine mt_qperp_trace_to_topology
4521
4522 subroutine mt_q0_trace_to_length(q_results,nseed,results)
4523 integer, intent(in) :: nseed
4524 type(trace_qperp_result), intent(in) :: q_results(nseed)
4525 type(trace_length_result), intent(out) :: results(nseed)
4526
4527 integer :: iseed
4528
4529 do iseed=1,nseed
4530 results(iseed)%seed=q_results(iseed)%seed
4531 results(iseed)%forward_footpoint=q_results(iseed)%forward_endpoint
4532 results(iseed)%backward_footpoint=q_results(iseed)%backward_endpoint
4533 results(iseed)%forward_length=q_results(iseed)%forward_length
4534 results(iseed)%backward_length=q_results(iseed)%backward_length
4535 results(iseed)%total_length=results(iseed)%forward_length &
4536 +results(iseed)%backward_length
4537 results(iseed)%forward_nstep=q_results(iseed)%forward_nstep
4538 results(iseed)%backward_nstep=q_results(iseed)%backward_nstep
4539 results(iseed)%forward_status=q_results(iseed)%forward_status
4540 results(iseed)%backward_status=q_results(iseed)%backward_status
4541 enddo
4542 end subroutine mt_q0_trace_to_length
4543
4544 subroutine mt_q0_trace_to_topology(q_results,twist_results,nseed, &
4545 topology,do_twist)
4546 integer, intent(in) :: nseed
4547 type(trace_qperp_result), intent(in) :: q_results(nseed)
4548 type(trace_twist_result), intent(in) :: twist_results(:)
4549 type(trace_topology_result), intent(out) :: topology(nseed)
4550 logical, intent(in) :: do_twist
4551
4552 integer :: iseed
4553
4554 do iseed=1,nseed
4555 topology(iseed)%seed=q_results(iseed)%seed
4556 topology(iseed)%length_forward=q_results(iseed)%forward_length
4557 topology(iseed)%length_backward=q_results(iseed)%backward_length
4558 topology(iseed)%length_total=topology(iseed)%length_forward &
4559 +topology(iseed)%length_backward
4560 topology(iseed)%twist_forward=0.d0
4561 topology(iseed)%twist_backward=0.d0
4562 topology(iseed)%twist_total=0.d0
4563 if (do_twist) then
4564 topology(iseed)%twist_forward=twist_results(iseed)%forward_twist
4565 topology(iseed)%twist_backward=twist_results(iseed)%backward_twist
4566 topology(iseed)%twist_total=twist_results(iseed)%total_twist
4567 endif
4568 topology(iseed)%forward_endpoint=q_results(iseed)%forward_endpoint
4569 topology(iseed)%backward_endpoint=q_results(iseed)%backward_endpoint
4570 topology(iseed)%forward_nstep=q_results(iseed)%forward_nstep
4571 topology(iseed)%backward_nstep=q_results(iseed)%backward_nstep
4572 topology(iseed)%forward_face=q_results(iseed)%forward_face
4573 topology(iseed)%backward_face=q_results(iseed)%backward_face
4574 topology(iseed)%forward_status=q_results(iseed)%forward_status
4575 topology(iseed)%backward_status=q_results(iseed)%backward_status
4576 topology(iseed)%map_forward_endpoint=q_results(iseed)%forward_endpoint
4577 topology(iseed)%map_backward_endpoint=q_results(iseed)%backward_endpoint
4578 topology(iseed)%map_forward_length=q_results(iseed)%forward_length
4579 topology(iseed)%map_backward_length=q_results(iseed)%backward_length
4580 topology(iseed)%map_forward_face=q_results(iseed)%forward_face
4581 topology(iseed)%map_backward_face=q_results(iseed)%backward_face
4582 topology(iseed)%map_forward_status=q_results(iseed)%forward_status
4583 topology(iseed)%map_backward_status=q_results(iseed)%backward_status
4584 topology(iseed)%source_B=0.d0
4585 topology(iseed)%forward_B=0.d0
4586 topology(iseed)%backward_B=0.d0
4587 topology(iseed)%source_B(1:ndim)=q_results(iseed)%B_seed
4588 topology(iseed)%forward_B(1:ndim)=q_results(iseed)%forward_B
4589 topology(iseed)%backward_B(1:ndim)=q_results(iseed)%backward_B
4590 topology(iseed)%source_Bn=0.d0
4591 topology(iseed)%forward_Bn=q_results(iseed)%forward_Bn_q0
4592 topology(iseed)%backward_Bn=q_results(iseed)%backward_Bn_q0
4593 topology(iseed)%has_twist=do_twist
4594 topology(iseed)%has_mapping=.false.
4595 topology(iseed)%valid_twist=.false.
4596 topology(iseed)%status_twist=q_results(iseed)%status
4597 if (do_twist) then
4598 topology(iseed)%valid_twist=twist_results(iseed)%valid_twist
4599 topology(iseed)%status_twist=twist_results(iseed)%status_twist
4600 endif
4601 topology(iseed)%valid=q_results(iseed)%status==trace_status_boundary
4602 topology(iseed)%status=q_results(iseed)%status
4603 enddo
4604 end subroutine mt_q0_trace_to_topology
4605
4606 subroutine mt_topology_to_length(topology,nseed,results)
4607 integer, intent(in) :: nseed
4608 type(trace_topology_result), intent(in) :: topology(nseed)
4609 type(trace_length_result), intent(out) :: results(nseed)
4610
4611 integer :: iseed
4612
4613 do iseed=1,nseed
4614 results(iseed)%seed=topology(iseed)%seed
4615 results(iseed)%forward_footpoint=topology(iseed)%forward_endpoint
4616 results(iseed)%backward_footpoint=topology(iseed)%backward_endpoint
4617 results(iseed)%forward_length=topology(iseed)%length_forward
4618 results(iseed)%backward_length=topology(iseed)%length_backward
4619 results(iseed)%total_length=topology(iseed)%length_total
4620 results(iseed)%forward_nstep=topology(iseed)%forward_nstep
4621 results(iseed)%backward_nstep=topology(iseed)%backward_nstep
4622 results(iseed)%forward_status=topology(iseed)%forward_status
4623 results(iseed)%backward_status=topology(iseed)%backward_status
4624 enddo
4625 end subroutine mt_topology_to_length
4626
4627 subroutine mt_topology_to_twist(topology,nseed,results)
4628 integer, intent(in) :: nseed
4629 type(trace_topology_result), intent(in) :: topology(nseed)
4630 type(trace_twist_result), intent(out) :: results(nseed)
4631
4632 integer :: iseed
4633
4634 do iseed=1,nseed
4635 results(iseed)%line%seed=topology(iseed)%seed
4636 results(iseed)%line%forward_footpoint=topology(iseed)%forward_endpoint
4637 results(iseed)%line%backward_footpoint=topology(iseed)%backward_endpoint
4638 results(iseed)%line%forward_length=topology(iseed)%length_forward
4639 results(iseed)%line%backward_length=topology(iseed)%length_backward
4640 results(iseed)%line%total_length=topology(iseed)%length_total
4641 results(iseed)%line%forward_nstep=topology(iseed)%forward_nstep
4642 results(iseed)%line%backward_nstep=topology(iseed)%backward_nstep
4643 results(iseed)%line%forward_status=topology(iseed)%forward_status
4644 results(iseed)%line%backward_status=topology(iseed)%backward_status
4645 results(iseed)%forward_twist=topology(iseed)%twist_forward
4646 results(iseed)%backward_twist=topology(iseed)%twist_backward
4647 results(iseed)%total_twist=topology(iseed)%twist_total
4648 results(iseed)%valid_twist=topology(iseed)%valid_twist
4649 results(iseed)%status_twist=topology(iseed)%status_twist
4650 enddo
4651 end subroutine mt_topology_to_twist
4652
4653 subroutine mt_topology_to_mapping(topology,nseed,results)
4654 integer, intent(in) :: nseed
4655 type(trace_topology_result), intent(in) :: topology(nseed)
4656 type(trace_mapping_result), intent(out) :: results(nseed)
4657
4658 integer :: iseed
4659
4660 do iseed=1,nseed
4661 results(iseed)%seed=topology(iseed)%seed
4662 results(iseed)%source_B=topology(iseed)%source_B
4663 results(iseed)%forward_footpoint=topology(iseed)%map_forward_endpoint
4664 results(iseed)%backward_footpoint=topology(iseed)%map_backward_endpoint
4665 results(iseed)%forward_B=topology(iseed)%forward_B
4666 results(iseed)%backward_B=topology(iseed)%backward_B
4667 results(iseed)%forward_length=topology(iseed)%map_forward_length
4668 results(iseed)%backward_length=topology(iseed)%map_backward_length
4669 results(iseed)%source_Bn=topology(iseed)%source_Bn
4670 results(iseed)%forward_Bn=topology(iseed)%forward_Bn
4671 results(iseed)%backward_Bn=topology(iseed)%backward_Bn
4672 results(iseed)%forward_face=topology(iseed)%map_forward_face
4673 results(iseed)%backward_face=topology(iseed)%map_backward_face
4674 results(iseed)%forward_status=topology(iseed)%map_forward_status
4675 results(iseed)%backward_status=topology(iseed)%map_backward_status
4676 results(iseed)%valid=topology(iseed)%has_mapping .and. &
4677 topology(iseed)%valid
4678 enddo
4679 end subroutine mt_topology_to_mapping
4680
4681 subroutine mt_validate_axis_plane(c1min,c1max,n1,c2min,c2max,n2,caller)
4682 integer, intent(in) :: n1,n2
4683 double precision, intent(in) :: c1min,c1max,c2min,c2max
4684 character(len=*), intent(in) :: caller
4685
4686 if (npe/=1) then
4687 call mpistop(trim(caller)//' currently requires npe=1')
4688 endif
4689 if (ndim/=3) then
4690 call mpistop(trim(caller)//' requires ndim=3')
4691 return
4692 endif
4693 {^ifthreed
4694 select case (geo_coordinate)
4695 case (geo_cartesian)
4696 ! Coordinate-plane products are sampled seed surfaces. RK2 tracing can
4697 ! use either slab-uniform or AMR Cartesian simulation grids.
4698 case (geo_cartesian_stretched)
4699 case default
4700 call mpistop(trim(caller)//' requires Cartesian geometry')
4701 end select
4702 }
4703 if (n1<1 .or. n2<1) then
4704 call mpistop(trim(caller)//' requires both sample counts >=1')
4705 endif
4706 if (c1max<c1min .or. c2max<c2min) then
4707 call mpistop(trim(caller)//' requires ordered plane bounds')
4708 endif
4709 end subroutine mt_validate_axis_plane
4710
4711 subroutine mt_build_axis_plane_seeds(c1min,c1max,n1,c2min,c2max,n2, &
4712 fixed_value,axis1,axis2,fixed_axis,seeds)
4713 integer, intent(in) :: n1,n2,axis1,axis2,fixed_axis
4714 double precision, intent(in) :: c1min,c1max,c2min,c2max,fixed_value
4715 double precision, allocatable, intent(out) :: seeds(:,:)
4716
4717 double precision :: dc1,dc2
4718 integer :: i,j,iseed
4719
4720 dc1=0.d0
4721 dc2=0.d0
4722 if (n1>1) dc1=(c1max-c1min)/dble(n1-1)
4723 if (n2>1) dc2=(c2max-c2min)/dble(n2-1)
4724
4725 allocate(seeds(n1*n2,ndim))
4726 seeds=0.d0
4727 do j=1,n2
4728 do i=1,n1
4729 iseed=(j-1)*n1+i
4730 seeds(iseed,axis1)=c1min+dble(i-1)*dc1
4731 seeds(iseed,axis2)=c2min+dble(j-1)*dc2
4732 seeds(iseed,fixed_axis)=fixed_value
4733 enddo
4734 enddo
4735 end subroutine mt_build_axis_plane_seeds
4736
4737 subroutine mt_build_spherical_surface_seeds(surface,seed_coord,s1_min, &
4738 s1_max,n1,s2_min,s2_max,n2,seed_layout,seed_theta0,seed_phi0, &
4739 seed_alpha,seeds)
4740 character(len=*), intent(in) :: surface,seed_layout
4741 integer, intent(in) :: n1,n2
4742 double precision, intent(in) :: seed_coord,s1_min,s1_max,s2_min,s2_max
4743 double precision, intent(in) :: seed_theta0,seed_phi0,seed_alpha
4744 double precision, allocatable, intent(out) :: seeds(:,:)
4745
4746 character(len=mt_task_name_len) :: layout
4747 double precision :: s1,s2
4748 integer :: i,j,iseed,status
4749
4750 layout=mt_lowercase(trim(seed_layout))
4751 if (len_trim(layout)==0) layout='endpoint'
4752 select case (trim(layout))
4753 case ('endpoint','endpoints','boundary')
4754 case ('cell_centered','cell-centered','centered','center')
4755 case default
4756 call mpistop('spherical_surface_products requires '// &
4757 'mt_seed_layout=endpoint or cell_centered')
4758 end select
4759
4760 allocate(seeds(n1*n2,ndim))
4761 seeds=0.d0
4762 do j=1,n2
4763 s2=mt_seed_axis_coord(s2_min,s2_max,n2,j,layout)
4764 do i=1,n1
4765 s1=mt_seed_axis_coord(s1_min,s1_max,n1,i,layout)
4766 iseed=(j-1)*n1+i
4767 select case (trim(surface))
4768 case ('rmin','rconst')
4769 seeds(iseed,1)=seed_coord
4770 seeds(iseed,2)=s1
4771 seeds(iseed,3)=s2
4772 case ('theta_const')
4773 seeds(iseed,1)=s1
4774 seeds(iseed,2)=seed_coord
4775 seeds(iseed,3)=s2
4776 case ('phi_const')
4777 seeds(iseed,1)=s1
4778 seeds(iseed,2)=s2
4779 seeds(iseed,3)=seed_coord
4780 case ('radial_plane')
4781 call mt_spherical_radial_plane_seed(s1,s2,seed_theta0,seed_phi0, &
4782 seed_alpha,seeds(iseed,:),status)
4783 if (status/=0) then
4784 call mpistop('mt_build_spherical_surface_seeds radial_plane '// &
4785 'seed lies outside the spherical domain; adjust '// &
4786 'mt_seed_theta0/mt_seed_phi0/mt_seed_alpha or mt_s2 bounds')
4787 endif
4788 case default
4789 call mpistop('mt_build_spherical_surface_seeds got '// &
4790 'unsupported surface')
4791 end select
4792 enddo
4793 enddo
4794 end subroutine mt_build_spherical_surface_seeds
4795
4796 subroutine mt_spherical_radial_plane_seed(radius,u,theta0,phi0,alpha,seed, &
4797 status)
4798 double precision, intent(in) :: radius,u,theta0,phi0,alpha
4799 double precision, intent(out) :: seed(ndim)
4800 integer, intent(out) :: status
4801
4802 double precision :: sin_theta0,cos_theta0,sin_phi0,cos_phi0
4803 double precision :: n0(3),etheta(3),ephi(3),tangent(3),nhat(3)
4804 double precision :: norm_n,theta,phi,cos_u,sin_u
4805
4806 seed=0.d0
4807 status=1
4808 {^ifthreed
4809 if (radius<xprobmin1 .or. radius>xprobmax1) return
4810 if (theta0<xprobmin2 .or. theta0>xprobmax2) return
4811 if (phi0<xprobmin3 .or. phi0>xprobmax3) return
4812
4813 sin_theta0=dsin(theta0)
4814 cos_theta0=dcos(theta0)
4815 if (abs(sin_theta0)<=1.d-12) return
4816 sin_phi0=dsin(phi0)
4817 cos_phi0=dcos(phi0)
4818
4819 n0=(/sin_theta0*cos_phi0,sin_theta0*sin_phi0,cos_theta0/)
4820 etheta=(/cos_theta0*cos_phi0,cos_theta0*sin_phi0,-sin_theta0/)
4821 ephi=(/-sin_phi0,cos_phi0,0.d0/)
4822 tangent=dcos(alpha)*etheta+dsin(alpha)*ephi
4823
4824 cos_u=dcos(u)
4825 sin_u=dsin(u)
4826 nhat=cos_u*n0+sin_u*tangent
4827 norm_n=dsqrt(sum(nhat**2))
4828 if (norm_n<=0.d0) return
4829 nhat=nhat/norm_n
4830
4831 theta=dacos(max(-1.d0,min(1.d0,nhat(3))))
4832 phi=datan2(nhat(2),nhat(1))
4833 if (theta<xprobmin2 .or. theta>xprobmax2) return
4834 if (phi<xprobmin3 .or. phi>xprobmax3) return
4835
4836 seed(1)=radius
4837 seed(2)=theta
4838 seed(3)=phi
4839 status=0
4840 }
4841 end subroutine mt_spherical_radial_plane_seed
4842
4843 subroutine mt_build_spherical_cloud_seeds(s1_min,s1_max,n1,s2_min, &
4844 s2_max,n2,s3_min,s3_max,n3,seed_layout,seeds)
4845 character(len=*), intent(in) :: seed_layout
4846 integer, intent(in) :: n1,n2,n3
4847 double precision, intent(in) :: s1_min,s1_max,s2_min,s2_max
4848 double precision, intent(in) :: s3_min,s3_max
4849 double precision, allocatable, intent(out) :: seeds(:,:)
4850
4851 character(len=mt_task_name_len) :: layout
4852 double precision :: s1,s2,s3
4853 integer :: i,j,k,iseed
4854
4855 layout=mt_lowercase(trim(seed_layout))
4856 if (len_trim(layout)==0) layout='endpoint'
4857 select case (trim(layout))
4858 case ('endpoint','endpoints','boundary')
4859 case ('cell_centered','cell-centered','centered','center')
4860 case default
4861 call mpistop('spherical_cloud_products requires '// &
4862 'mt_seed_layout=endpoint or cell_centered')
4863 end select
4864
4865 allocate(seeds(n1*n2*n3,ndim))
4866 seeds=0.d0
4867 do k=1,n3
4868 s3=mt_seed_axis_coord(s3_min,s3_max,n3,k,layout)
4869 do j=1,n2
4870 s2=mt_seed_axis_coord(s2_min,s2_max,n2,j,layout)
4871 do i=1,n1
4872 s1=mt_seed_axis_coord(s1_min,s1_max,n1,i,layout)
4873 iseed=(k-1)*n1*n2+(j-1)*n1+i
4874 seeds(iseed,1)=s1
4875 seeds(iseed,2)=s2
4876 seeds(iseed,3)=s3
4877 enddo
4878 enddo
4879 enddo
4880 end subroutine mt_build_spherical_cloud_seeds
4881
4882 double precision function mt_seed_axis_coord(cmin,cmax,n,i,layout) &
4883 result(coord)
4884 double precision, intent(in) :: cmin,cmax
4885 integer, intent(in) :: n,i
4886 character(len=*), intent(in) :: layout
4887
4888 select case (trim(layout))
4889 case ('cell_centered','cell-centered','centered','center')
4890 coord=cmin+(dble(i)-0.5d0)*(cmax-cmin)/dble(n)
4891 case default
4892 if (n>1) then
4893 coord=cmin+dble(i-1)*(cmax-cmin)/dble(n-1)
4894 else
4895 coord=cmin
4896 endif
4897 end select
4898 end function mt_seed_axis_coord
4899
4900 integer function mt_spherical_connection_type(face_b,face_f,is_valid) &
4901 result(connection_type)
4902 integer, intent(in) :: face_b,face_f
4903 logical, intent(in) :: is_valid
4904
4905 logical :: b_rmin,f_rmin,b_rmax,f_rmax,b_side,f_side
4906
4907 connection_type=0
4908 if (.not.is_valid) return
4909 if (.not.mt_q_face_valid(face_b)) return
4910 if (.not.mt_q_face_valid(face_f)) return
4911
4912 b_rmin=face_b==trace_face_xmin
4913 f_rmin=face_f==trace_face_xmin
4914 b_rmax=face_b==trace_face_xmax
4915 f_rmax=face_f==trace_face_xmax
4916 b_side=.not.(b_rmin .or. b_rmax)
4917 f_side=.not.(f_rmin .or. f_rmax)
4918
4919 if (b_rmin .and. f_rmin) then
4920 connection_type=1
4921 else if ((b_rmin .and. f_rmax) .or. (b_rmax .and. f_rmin)) then
4922 connection_type=2
4923 else if ((b_rmin .and. f_side) .or. (f_rmin .and. b_side)) then
4924 connection_type=3
4925 else if (b_rmax .and. f_rmax) then
4926 connection_type=4
4927 else if (b_side .and. f_side .and. face_b==face_f) then
4928 connection_type=5
4929 else
4930 connection_type=6
4931 endif
4932 end function mt_spherical_connection_type
4933
4934 logical function mt_validate_arbitrary_plane_basis(e1,e2,s1min,s1max, &
4935 n1,s2min,s2max,n2,caller) result(valid)
4936 integer, intent(in) :: n1,n2
4937 double precision, intent(in) :: e1(ndim),e2(ndim)
4938 double precision, intent(in) :: s1min,s1max,s2min,s2max
4939 character(len=*), intent(in) :: caller
4940
4941 double precision, parameter :: basis_tol=1.d-10
4942 double precision :: e1_norm,e2_norm,e12_dot
4943
4944 valid=.false.
4945 if (npe/=1) then
4946 write(*,'(a)') trim(caller)//' currently requires npe=1'
4947 return
4948 endif
4949 if (ndim/=3) then
4950 write(*,'(a)') trim(caller)//' requires ndim=3'
4951 return
4952 endif
4953 {^ifthreed
4954 select case (geo_coordinate)
4955 case (geo_cartesian,geo_cartesian_stretched)
4956 case default
4957 write(*,'(a)') trim(caller)//' requires Cartesian geometry'
4958 return
4959 end select
4960 }
4961 if (n1<1 .or. n2<1) then
4962 write(*,'(a)') trim(caller)//' requires both sample counts >=1'
4963 return
4964 endif
4965 if (s1max<s1min .or. s2max<s2min) then
4966 write(*,'(a)') trim(caller)//' requires ordered plane bounds'
4967 return
4968 endif
4969 e1_norm=dsqrt(sum(e1**2))
4970 e2_norm=dsqrt(sum(e2**2))
4971 e12_dot=sum(e1*e2)
4972 if (abs(e1_norm-1.d0)>basis_tol .or. &
4973 abs(e2_norm-1.d0)>basis_tol .or. &
4974 abs(e12_dot)>basis_tol) then
4975 write(*,'(a)') trim(caller)//' requires orthonormal e1/e2'
4976 return
4977 endif
4978
4979 valid=.true.
4980 end function mt_validate_arbitrary_plane_basis
4981
4982 subroutine mt_build_arbitrary_plane_seeds(origin,e1,e2,s1min,s1max,n1, &
4983 s2min,s2max,n2,seeds,s1,s2)
4984 integer, intent(in) :: n1,n2
4985 double precision, intent(in) :: origin(ndim),e1(ndim),e2(ndim)
4986 double precision, intent(in) :: s1min,s1max,s2min,s2max
4987 double precision, allocatable, intent(out) :: seeds(:,:),s1(:),s2(:)
4988
4989 double precision :: ds1,ds2
4990 integer :: i,j,iseed
4991
4992 ds1=0.d0
4993 ds2=0.d0
4994 if (n1>1) ds1=(s1max-s1min)/dble(n1-1)
4995 if (n2>1) ds2=(s2max-s2min)/dble(n2-1)
4996
4997 allocate(seeds(n1*n2,ndim),s1(n1*n2),s2(n1*n2))
4998 do j=1,n2
4999 do i=1,n1
5000 iseed=(j-1)*n1+i
5001 s1(iseed)=s1min+dble(i-1)*ds1
5002 s2(iseed)=s2min+dble(j-1)*ds2
5003 seeds(iseed,:)=origin+s1(iseed)*e1+s2(iseed)*e2
5004 enddo
5005 enddo
5006 end subroutine mt_build_arbitrary_plane_seeds
5007
5008 subroutine mt_write_length_plane_csv(results,n1,n2,csv_file,caller, &
5009 index_header)
5010 integer, intent(in) :: n1,n2
5011 type(trace_length_result), intent(in) :: results(n1*n2)
5012 character(len=*), intent(in) :: csv_file,caller,index_header
5013
5014 double precision :: seed_xyz(3)
5015 integer :: csv_unit,io_status,i,j,iseed
5016
5017 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
5018 action='write',form='formatted',iostat=io_status)
5019 if (io_status/=0) then
5020 call mpistop(trim(caller)//' could not open CSV file')
5021 endif
5022
5023 write(csv_unit,'(a)',iostat=io_status) &
5024 trim(index_header)//',seed_x,seed_y,seed_z,'// &
5025 'length_total,length_backward,length_forward,'// &
5026 'nstep_backward,nstep_forward,'// &
5027 'status_backward,status_forward'
5028 if (io_status/=0) then
5029 close(csv_unit)
5030 call mpistop(trim(caller)//' could not write CSV header')
5031 endif
5032
5033 do j=1,n2
5034 do i=1,n1
5035 iseed=(j-1)*n1+i
5036 seed_xyz=0.d0
5037 seed_xyz(1:ndim)=results(iseed)%seed
5038 write(csv_unit,'(i0,",",i0,6(",",es24.16),4(",",i0))', &
5039 iostat=io_status) i,j,seed_xyz,results(iseed)%total_length, &
5040 results(iseed)%backward_length, &
5041 results(iseed)%forward_length, &
5042 results(iseed)%backward_nstep, &
5043 results(iseed)%forward_nstep, &
5044 results(iseed)%backward_status, &
5045 results(iseed)%forward_status
5046 if (io_status/=0) then
5047 close(csv_unit)
5048 call mpistop(trim(caller)//' could not write CSV data')
5049 endif
5050 enddo
5051 enddo
5052
5053 close(csv_unit)
5054 end subroutine mt_write_length_plane_csv
5055
5056 subroutine mt_write_spherical_rmin_csv(topology,n1,n2,csv_file,caller, &
5057 do_twist,do_q,q_results,do_qperp,qperp_results)
5058 integer, intent(in) :: n1,n2
5059 type(trace_topology_result), intent(in) :: topology(n1*n2)
5060 character(len=*), intent(in) :: csv_file,caller
5061 logical, intent(in) :: do_twist,do_q,do_qperp
5062 type(trace_qperp_result), intent(in) :: q_results(:)
5063 type(trace_qperp_result), intent(in) :: qperp_results(:)
5064
5065 integer :: csv_unit,io_status,i,j,iseed,connection_type
5066 logical :: valid
5067 character(len=2048) :: header
5068
5069 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
5070 action='write',form='formatted',iostat=io_status)
5071 if (io_status/=0) then
5072 call mpistop(trim(caller)//' could not open CSV file')
5073 endif
5074
5075 header='i,j,seed_r,seed_theta,seed_phi,'// &
5076 'length_total,length_backward,length_forward'
5077 if (do_twist) then
5078 header=trim(header)//','// &
5079 'twist_total,twist_backward,twist_forward'
5080 endif
5081 if (do_q) then
5082 header=trim(header)//','// &
5083 'logQ,valid_Q,status_Q'
5084 endif
5085 if (do_qperp) then
5086 header=trim(header)//','// &
5087 'logQperp,valid_Qperp,status_Qperp'
5088 endif
5089 header=trim(header)//','// &
5090 'r_b,theta_b,phi_b,r_f,theta_f,phi_f,'// &
5091 'face_backward,face_forward,connection_type_spherical,'// &
5092 'nstep_backward,nstep_forward,status_backward,status_forward'
5093 if (do_twist) then
5094 header=trim(header)//','// &
5095 'status_twist,valid_twist'
5096 endif
5097 header=trim(header)//',valid'
5098 write(csv_unit,'(a)',iostat=io_status) trim(header)
5099 if (io_status/=0) then
5100 close(csv_unit)
5101 call mpistop(trim(caller)//' could not write CSV header')
5102 endif
5103
5104 do j=1,n2
5105 do i=1,n1
5106 iseed=(j-1)*n1+i
5107 valid=topology(iseed)%valid
5108 connection_type=mt_spherical_connection_type( &
5109 topology(iseed)%backward_face,topology(iseed)%forward_face, &
5110 valid)
5111 write(csv_unit,'(i0,",",i0,6(",",es24.16))',advance='no', &
5112 iostat=io_status) i,j,topology(iseed)%seed, &
5113 topology(iseed)%length_total, &
5114 topology(iseed)%length_backward, &
5115 topology(iseed)%length_forward
5116 if (io_status/=0) exit
5117 if (do_twist) then
5118 write(csv_unit,'(3(",",es24.16))',advance='no', &
5119 iostat=io_status) topology(iseed)%twist_total, &
5120 topology(iseed)%twist_backward, &
5121 topology(iseed)%twist_forward
5122 if (io_status/=0) exit
5123 endif
5124 if (do_q) then
5125 write(csv_unit,'(",",es24.16,",",l1,",",i0)',advance='no', &
5126 iostat=io_status) q_results(iseed)%logq0, &
5127 q_results(iseed)%valid_q0,q_results(iseed)%status_q0
5128 if (io_status/=0) exit
5129 endif
5130 if (do_qperp) then
5131 write(csv_unit,'(",",es24.16,",",l1,",",i0)',advance='no', &
5132 iostat=io_status) qperp_results(iseed)%logqperp, &
5133 qperp_results(iseed)%valid,qperp_results(iseed)%status
5134 if (io_status/=0) exit
5135 endif
5136 write(csv_unit,'(6(",",es24.16),7(",",i0))',advance='no', &
5137 iostat=io_status) topology(iseed)%backward_endpoint, &
5138 topology(iseed)%forward_endpoint, &
5139 topology(iseed)%backward_face,topology(iseed)%forward_face, &
5140 connection_type,topology(iseed)%backward_nstep, &
5141 topology(iseed)%forward_nstep, &
5142 topology(iseed)%backward_status, &
5143 topology(iseed)%forward_status
5144 if (io_status/=0) exit
5145 if (do_twist) then
5146 write(csv_unit,'(",",i0,",",l1)',advance='no',iostat=io_status) &
5147 topology(iseed)%status_twist,topology(iseed)%valid_twist
5148 if (io_status/=0) exit
5149 endif
5150 write(csv_unit,'(",",l1)',iostat=io_status) valid
5151 if (io_status/=0) then
5152 close(csv_unit)
5153 call mpistop(trim(caller)//' could not write CSV data')
5154 endif
5155 enddo
5156 enddo
5157
5158 close(csv_unit)
5159 end subroutine mt_write_spherical_rmin_csv
5160
5161 subroutine mt_write_spherical_topology_vtu(vtu_file,topology,n1,n2, &
5162 caller,do_twist,do_q,q_results,do_qperp,qperp_results)
5163 character(len=*), intent(in) :: vtu_file,caller
5164 integer, intent(in) :: n1,n2
5165 type(trace_topology_result), intent(in) :: topology(n1*n2)
5166 logical, intent(in) :: do_twist,do_q,do_qperp
5167 type(trace_qperp_result), intent(in) :: q_results(:)
5168 type(trace_qperp_result), intent(in) :: qperp_results(:)
5169
5170 integer :: vtu_unit,io_status,npoint,ncell
5171
5172 npoint=n1*n2
5173 ncell=0
5174 if (n1>1 .and. n2>1) ncell=(n1-1)*(n2-1)
5175 if (ncell==0) ncell=npoint
5176
5177 open(newunit=vtu_unit,file=trim(vtu_file),status='replace', &
5178 action='write',form='formatted',iostat=io_status)
5179 if (io_status/=0) then
5180 call mpistop(trim(caller)//' could not open VTU file')
5181 endif
5182
5183 call mt_write_vtu_file_header(vtu_unit,npoint,ncell)
5184 call mt_write_vtu_spherical_topology_pointdata(vtu_unit,topology, &
5185 npoint,do_twist,do_q,q_results,do_qperp,qperp_results,io_status)
5186 if (io_status==0) call mt_write_vtu_topology_points(vtu_unit, &
5187 topology,npoint,io_status)
5188 if (io_status==0) then
5189 if (n1>1 .and. n2>1) then
5190 call mt_write_vtu_quad_cells(vtu_unit,n1,n2,io_status)
5191 else
5192 call mt_write_vtu_vertex_cells(vtu_unit,npoint,io_status)
5193 endif
5194 endif
5195 if (io_status==0) call mt_write_vtu_file_footer(vtu_unit,io_status)
5196 close(vtu_unit)
5197 if (io_status/=0) then
5198 call mpistop(trim(caller)//' could not write VTU file')
5199 endif
5200 end subroutine mt_write_spherical_topology_vtu
5201
5202 subroutine mt_write_spherical_cloud_csv(topology,n1,n2,n3,csv_file, &
5203 caller,do_twist,do_qperp,qperp_results)
5204 integer, intent(in) :: n1,n2,n3
5205 type(trace_topology_result), intent(in) :: topology(n1*n2*n3)
5206 character(len=*), intent(in) :: csv_file,caller
5207 logical, intent(in) :: do_twist,do_qperp
5208 type(trace_qperp_result), intent(in) :: qperp_results(:)
5209
5210 integer :: csv_unit,io_status,i,j,k,iseed,connection_type
5211 logical :: valid
5212 character(len=2048) :: header
5213
5214 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
5215 action='write',form='formatted',iostat=io_status)
5216 if (io_status/=0) then
5217 call mpistop(trim(caller)//' could not open CSV file')
5218 endif
5219
5220 header='i,j,k,seed_r,seed_theta,seed_phi,'// &
5221 'length_total,length_backward,length_forward'
5222 if (do_twist) then
5223 header=trim(header)//','// &
5224 'twist_total,twist_backward,twist_forward'
5225 endif
5226 if (do_qperp) then
5227 header=trim(header)//','// &
5228 'logQperp,valid_Qperp,status_Qperp'
5229 endif
5230 header=trim(header)//','// &
5231 'r_b,theta_b,phi_b,r_f,theta_f,phi_f,'// &
5232 'face_backward,face_forward,connection_type_spherical,'// &
5233 'nstep_backward,nstep_forward,status_backward,status_forward'
5234 if (do_twist) then
5235 header=trim(header)//','// &
5236 'status_twist,valid_twist'
5237 endif
5238 header=trim(header)//',valid'
5239 write(csv_unit,'(a)',iostat=io_status) trim(header)
5240 if (io_status/=0) then
5241 close(csv_unit)
5242 call mpistop(trim(caller)//' could not write CSV header')
5243 endif
5244
5245 do k=1,n3
5246 do j=1,n2
5247 do i=1,n1
5248 iseed=(k-1)*n1*n2+(j-1)*n1+i
5249 valid=topology(iseed)%valid
5250 connection_type=mt_spherical_connection_type( &
5251 topology(iseed)%backward_face,topology(iseed)%forward_face, &
5252 valid)
5253 write(csv_unit,'(i0,",",i0,",",i0,6(",",es24.16))', &
5254 advance='no',iostat=io_status) i,j,k,topology(iseed)%seed, &
5255 topology(iseed)%length_total, &
5256 topology(iseed)%length_backward, &
5257 topology(iseed)%length_forward
5258 if (io_status/=0) exit
5259 if (do_twist) then
5260 write(csv_unit,'(3(",",es24.16))',advance='no', &
5261 iostat=io_status) topology(iseed)%twist_total, &
5262 topology(iseed)%twist_backward, &
5263 topology(iseed)%twist_forward
5264 if (io_status/=0) exit
5265 endif
5266 if (do_qperp) then
5267 write(csv_unit,'(",",es24.16,",",l1,",",i0)',advance='no', &
5268 iostat=io_status) qperp_results(iseed)%logqperp, &
5269 qperp_results(iseed)%valid,qperp_results(iseed)%status
5270 if (io_status/=0) exit
5271 endif
5272 write(csv_unit,'(6(",",es24.16),7(",",i0))',advance='no', &
5273 iostat=io_status) topology(iseed)%backward_endpoint, &
5274 topology(iseed)%forward_endpoint, &
5275 topology(iseed)%backward_face,topology(iseed)%forward_face, &
5276 connection_type,topology(iseed)%backward_nstep, &
5277 topology(iseed)%forward_nstep, &
5278 topology(iseed)%backward_status, &
5279 topology(iseed)%forward_status
5280 if (io_status/=0) exit
5281 if (do_twist) then
5282 write(csv_unit,'(",",i0,",",l1)',advance='no', &
5283 iostat=io_status) topology(iseed)%status_twist, &
5284 topology(iseed)%valid_twist
5285 if (io_status/=0) exit
5286 endif
5287 write(csv_unit,'(",",l1)',iostat=io_status) valid
5288 if (io_status/=0) exit
5289 enddo
5290 if (io_status/=0) exit
5291 enddo
5292 if (io_status/=0) exit
5293 enddo
5294
5295 if (io_status/=0) then
5296 close(csv_unit)
5297 call mpistop(trim(caller)//' could not write CSV data')
5298 endif
5299 close(csv_unit)
5300 end subroutine mt_write_spherical_cloud_csv
5301
5302 subroutine mt_write_spherical_cloud_vtu(vtu_file,topology,npoint,caller, &
5303 do_twist,do_q,q_results,do_qperp,qperp_results)
5304 character(len=*), intent(in) :: vtu_file,caller
5305 integer, intent(in) :: npoint
5306 type(trace_topology_result), intent(in) :: topology(npoint)
5307 logical, intent(in) :: do_twist,do_q,do_qperp
5308 type(trace_qperp_result), intent(in) :: q_results(:)
5309 type(trace_qperp_result), intent(in) :: qperp_results(:)
5310
5311 integer :: vtu_unit,io_status
5312
5313 open(newunit=vtu_unit,file=trim(vtu_file),status='replace', &
5314 action='write',form='formatted',iostat=io_status)
5315 if (io_status/=0) then
5316 call mpistop(trim(caller)//' could not open VTU file')
5317 endif
5318
5319 call mt_write_vtu_file_header(vtu_unit,npoint,npoint)
5320 call mt_write_vtu_spherical_topology_pointdata(vtu_unit,topology, &
5321 npoint,do_twist,do_q,q_results,do_qperp,qperp_results,io_status)
5322 if (io_status==0) call mt_write_vtu_topology_points(vtu_unit, &
5323 topology,npoint,io_status)
5324 if (io_status==0) call mt_write_vtu_vertex_cells(vtu_unit,npoint, &
5325 io_status)
5326 if (io_status==0) call mt_write_vtu_file_footer(vtu_unit,io_status)
5327 close(vtu_unit)
5328 if (io_status/=0) then
5329 call mpistop(trim(caller)//' could not write VTU file')
5330 endif
5331 end subroutine mt_write_spherical_cloud_vtu
5332
5333 subroutine mt_write_fieldline_products_seeds_csv(length_results, &
5334 twist_results,q_results,qperp_results,nseed,csv_file,do_twist, &
5335 do_q,do_qperp)
5336 integer, intent(in) :: nseed
5337 type(trace_length_result), intent(in) :: length_results(nseed)
5338 type(trace_twist_result), intent(in) :: twist_results(:)
5339 type(trace_qperp_result), intent(in) :: q_results(:)
5340 type(trace_qperp_result), intent(in) :: qperp_results(:)
5341 character(len=*), intent(in) :: csv_file
5342 logical, intent(in) :: do_twist,do_q,do_qperp
5343
5344 double precision :: seed_xyz(3)
5345 double precision :: bseed_norm,bf_norm,bb_norm
5346 character(len=2048) :: header
5347 integer :: csv_unit,io_status,iseed
5348
5349 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
5350 action='write',form='formatted',iostat=io_status)
5351 if (io_status/=0) then
5352 call mpistop('mt_fieldline_products_seeds could not open CSV file')
5353 endif
5354
5355 header='seed_id,seed_x,seed_y,seed_z,'// &
5356 'length_total,length_backward,length_forward,'// &
5357 'nstep_backward_length,nstep_forward_length,'// &
5358 'status_backward_length,status_forward_length'
5359 if (do_twist) then
5360 header=trim(header)//','// &
5361 'twist_total,twist_backward,twist_forward,'// &
5362 'nstep_backward_twist,nstep_forward_twist,'// &
5363 'status_backward_twist,status_forward_twist'
5364 endif
5365 if (do_q) then
5366 header=trim(header)//','// &
5367 'logQ,valid_Q,status_Q,'// &
5368 'face_forward_Q,face_backward_Q,'// &
5369 'status_forward_Q,status_backward_Q,'// &
5370 'length_forward_Q,length_backward_Q,'// &
5371 'x_f_Q,y_f_Q,z_f_Q,x_b_Q,y_b_Q,z_b_Q'
5372 endif
5373 if (do_qperp) then
5374 header=trim(header)//','// &
5375 'qperp,logqperp,valid_qperp,status_qperp,'// &
5376 'N2,bfactor,'// &
5377 'face_forward_qperp,face_backward_qperp,'// &
5378 'status_forward_qperp,status_backward_qperp,'// &
5379 'length_forward_qperp,length_backward_qperp,'// &
5380 'Bseed_norm,Bf_norm,Bb_norm,'// &
5381 'x_f_qperp,y_f_qperp,z_f_qperp,'// &
5382 'x_b_qperp,y_b_qperp,z_b_qperp'
5383 endif
5384 write(csv_unit,'(a)',iostat=io_status) trim(header)
5385 if (io_status/=0) then
5386 close(csv_unit)
5387 call mpistop('mt_fieldline_products_seeds could not write CSV header')
5388 endif
5389
5390 do iseed=1,nseed
5391 seed_xyz=0.d0
5392 seed_xyz(1:ndim)=length_results(iseed)%seed
5393 write(csv_unit,'(i0,6(",",es24.16),4(",",i0))', &
5394 advance='no',iostat=io_status) &
5395 iseed,seed_xyz,length_results(iseed)%total_length, &
5396 length_results(iseed)%backward_length, &
5397 length_results(iseed)%forward_length, &
5398 length_results(iseed)%backward_nstep, &
5399 length_results(iseed)%forward_nstep, &
5400 length_results(iseed)%backward_status, &
5401 length_results(iseed)%forward_status
5402 if (io_status/=0) exit
5403
5404 if (do_twist) then
5405 write(csv_unit,'(3(",",es24.16),4(",",i0))', &
5406 advance='no',iostat=io_status) &
5407 twist_results(iseed)%total_twist, &
5408 twist_results(iseed)%backward_twist, &
5409 twist_results(iseed)%forward_twist, &
5410 twist_results(iseed)%line%backward_nstep, &
5411 twist_results(iseed)%line%forward_nstep, &
5412 twist_results(iseed)%line%backward_status, &
5413 twist_results(iseed)%line%forward_status
5414 if (io_status/=0) exit
5415 endif
5416
5417 if (do_q) then
5418 write(csv_unit, &
5419 '(",",es24.16,",",l1,",",i0,4(",",i0),8(",",es24.16))', &
5420 advance='no',iostat=io_status) &
5421 q_results(iseed)%logq0, &
5422 q_results(iseed)%valid_q0,q_results(iseed)%status_q0, &
5423 q_results(iseed)%forward_face, &
5424 q_results(iseed)%backward_face, &
5425 q_results(iseed)%forward_status, &
5426 q_results(iseed)%backward_status, &
5427 q_results(iseed)%forward_length, &
5428 q_results(iseed)%backward_length, &
5429 q_results(iseed)%forward_endpoint, &
5430 q_results(iseed)%backward_endpoint
5431 if (io_status/=0) exit
5432 endif
5433
5434 if (do_qperp) then
5435 bseed_norm=dsqrt(sum(qperp_results(iseed)%B_seed**2))
5436 bf_norm=dsqrt(sum(qperp_results(iseed)%forward_B**2))
5437 bb_norm=dsqrt(sum(qperp_results(iseed)%backward_B**2))
5438 write(csv_unit, &
5439 '(2(",",es24.16),",",l1,",",i0,2(",",es24.16),'// &
5440 '4(",",i0),11(",",es24.16))', &
5441 advance='no',iostat=io_status) &
5442 qperp_results(iseed)%qperp, &
5443 qperp_results(iseed)%logqperp, &
5444 qperp_results(iseed)%valid,qperp_results(iseed)%status, &
5445 qperp_results(iseed)%N2,qperp_results(iseed)%bfactor, &
5446 qperp_results(iseed)%forward_face, &
5447 qperp_results(iseed)%backward_face, &
5448 qperp_results(iseed)%forward_status, &
5449 qperp_results(iseed)%backward_status, &
5450 qperp_results(iseed)%forward_length, &
5451 qperp_results(iseed)%backward_length, &
5452 bseed_norm,bf_norm,bb_norm, &
5453 qperp_results(iseed)%forward_endpoint, &
5454 qperp_results(iseed)%backward_endpoint
5455 if (io_status/=0) exit
5456 endif
5457
5458 write(csv_unit,'()',iostat=io_status)
5459 if (io_status/=0) exit
5460 enddo
5461
5462 if (io_status/=0) then
5463 close(csv_unit)
5464 call mpistop('mt_fieldline_products_seeds could not write CSV data')
5465 endif
5466 close(csv_unit)
5467 end subroutine mt_write_fieldline_products_seeds_csv
5468
5469 subroutine mt_fieldline_products_append_header(header,do_twist,do_q,do_qperp)
5470 character(len=*), intent(inout) :: header
5471 logical, intent(in) :: do_twist,do_q,do_qperp
5472
5473 header=trim(header)//','// &
5474 'length_total,length_backward,length_forward,'// &
5475 'nstep_backward_length,nstep_forward_length,'// &
5476 'status_backward_length,status_forward_length'
5477 if (do_twist) then
5478 header=trim(header)//','// &
5479 'twist_total,twist_backward,twist_forward,'// &
5480 'nstep_backward_twist,nstep_forward_twist,'// &
5481 'status_backward_twist,status_forward_twist'
5482 endif
5483 if (do_q) then
5484 header=trim(header)//','// &
5485 'logQ,valid_Q,status_Q,'// &
5486 'face_forward_Q,face_backward_Q,'// &
5487 'status_forward_Q,status_backward_Q,'// &
5488 'length_forward_Q,length_backward_Q,'// &
5489 'x_f_Q,y_f_Q,z_f_Q,x_b_Q,y_b_Q,z_b_Q'
5490 endif
5491 if (do_qperp) then
5492 header=trim(header)//','// &
5493 'qperp,logqperp,valid_qperp,status_qperp,'// &
5494 'N2,bfactor,'// &
5495 'face_forward_qperp,face_backward_qperp,'// &
5496 'status_forward_qperp,status_backward_qperp,'// &
5497 'length_forward_qperp,length_backward_qperp,'// &
5498 'Bseed_norm,Bf_norm,Bb_norm,'// &
5499 'x_f_qperp,y_f_qperp,z_f_qperp,'// &
5500 'x_b_qperp,y_b_qperp,z_b_qperp'
5501 endif
5502 end subroutine mt_fieldline_products_append_header
5503
5504 subroutine mt_write_fieldline_products_plane_arbitrary_header(csv_file, &
5505 caller,do_twist,do_q,do_qperp)
5506 character(len=*), intent(in) :: csv_file,caller
5507 logical, intent(in) :: do_twist,do_q,do_qperp
5508
5509 character(len=2048) :: header
5510 integer :: csv_unit,io_status
5511
5512 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
5513 action='write',form='formatted',iostat=io_status)
5514 if (io_status/=0) then
5515 call mpistop(trim(caller)//' could not open CSV file')
5516 endif
5517
5518 header='i,j,s1,s2,seed_x,seed_y,seed_z'
5519 call mt_fieldline_products_append_header(header,do_twist,do_q,do_qperp)
5520 write(csv_unit,'(a)',iostat=io_status) trim(header)
5521 if (io_status/=0) then
5522 close(csv_unit)
5523 call mpistop(trim(caller)//' could not write CSV header')
5524 endif
5525
5526 close(csv_unit)
5527 end subroutine mt_write_fieldline_products_plane_arbitrary_header
5528
5529 subroutine mt_write_fieldline_products_plane_arbitrary_csv( &
5530 length_results,twist_results,q_results,qperp_results,s1,s2,n1,n2, &
5531 csv_file,do_twist,do_q,do_qperp,caller)
5532 integer, intent(in) :: n1,n2
5533 type(trace_length_result), intent(in) :: length_results(n1*n2)
5534 type(trace_twist_result), intent(in) :: twist_results(:)
5535 type(trace_qperp_result), intent(in) :: q_results(:)
5536 type(trace_qperp_result), intent(in) :: qperp_results(:)
5537 double precision, intent(in) :: s1(n1*n2),s2(n1*n2)
5538 character(len=*), intent(in) :: csv_file,caller
5539 logical, intent(in) :: do_twist,do_q,do_qperp
5540
5541 double precision :: seed_xyz(3)
5542 double precision :: bseed_norm,bf_norm,bb_norm
5543 character(len=2048) :: header
5544 integer :: csv_unit,io_status,i,j,iseed
5545
5546 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
5547 action='write',form='formatted',iostat=io_status)
5548 if (io_status/=0) then
5549 call mpistop(trim(caller)//' could not open CSV file')
5550 endif
5551
5552 header='i,j,s1,s2,seed_x,seed_y,seed_z'
5553 call mt_fieldline_products_append_header(header,do_twist,do_q,do_qperp)
5554 write(csv_unit,'(a)',iostat=io_status) trim(header)
5555 if (io_status/=0) then
5556 close(csv_unit)
5557 call mpistop(trim(caller)//' could not write CSV header')
5558 endif
5559
5560 do j=1,n2
5561 do i=1,n1
5562 iseed=(j-1)*n1+i
5563 seed_xyz=0.d0
5564 seed_xyz(1:ndim)=length_results(iseed)%seed
5565 write(csv_unit,'(i0,",",i0,8(",",es24.16),4(",",i0))', &
5566 advance='no',iostat=io_status) &
5567 i,j,s1(iseed),s2(iseed),seed_xyz, &
5568 length_results(iseed)%total_length, &
5569 length_results(iseed)%backward_length, &
5570 length_results(iseed)%forward_length, &
5571 length_results(iseed)%backward_nstep, &
5572 length_results(iseed)%forward_nstep, &
5573 length_results(iseed)%backward_status, &
5574 length_results(iseed)%forward_status
5575 if (io_status/=0) exit
5576
5577 if (do_twist) then
5578 write(csv_unit,'(3(",",es24.16),4(",",i0))', &
5579 advance='no',iostat=io_status) &
5580 twist_results(iseed)%total_twist, &
5581 twist_results(iseed)%backward_twist, &
5582 twist_results(iseed)%forward_twist, &
5583 twist_results(iseed)%line%backward_nstep, &
5584 twist_results(iseed)%line%forward_nstep, &
5585 twist_results(iseed)%line%backward_status, &
5586 twist_results(iseed)%line%forward_status
5587 if (io_status/=0) exit
5588 endif
5589
5590 if (do_q) then
5591 write(csv_unit, &
5592 '(",",es24.16,",",l1,",",i0,4(",",i0),8(",",es24.16))', &
5593 advance='no',iostat=io_status) &
5594 q_results(iseed)%logq0, &
5595 q_results(iseed)%valid_q0,q_results(iseed)%status_q0, &
5596 q_results(iseed)%forward_face, &
5597 q_results(iseed)%backward_face, &
5598 q_results(iseed)%forward_status, &
5599 q_results(iseed)%backward_status, &
5600 q_results(iseed)%forward_length, &
5601 q_results(iseed)%backward_length, &
5602 q_results(iseed)%forward_endpoint, &
5603 q_results(iseed)%backward_endpoint
5604 if (io_status/=0) exit
5605 endif
5606
5607 if (do_qperp) then
5608 bseed_norm=dsqrt(sum(qperp_results(iseed)%B_seed**2))
5609 bf_norm=dsqrt(sum(qperp_results(iseed)%forward_B**2))
5610 bb_norm=dsqrt(sum(qperp_results(iseed)%backward_B**2))
5611 write(csv_unit, &
5612 '(2(",",es24.16),",",l1,",",i0,2(",",es24.16),'// &
5613 '4(",",i0),11(",",es24.16))', &
5614 advance='no',iostat=io_status) &
5615 qperp_results(iseed)%qperp, &
5616 qperp_results(iseed)%logqperp, &
5617 qperp_results(iseed)%valid,qperp_results(iseed)%status, &
5618 qperp_results(iseed)%N2,qperp_results(iseed)%bfactor, &
5619 qperp_results(iseed)%forward_face, &
5620 qperp_results(iseed)%backward_face, &
5621 qperp_results(iseed)%forward_status, &
5622 qperp_results(iseed)%backward_status, &
5623 qperp_results(iseed)%forward_length, &
5624 qperp_results(iseed)%backward_length, &
5625 bseed_norm,bf_norm,bb_norm, &
5626 qperp_results(iseed)%forward_endpoint, &
5627 qperp_results(iseed)%backward_endpoint
5628 if (io_status/=0) exit
5629 endif
5630
5631 write(csv_unit,'()',iostat=io_status)
5632 if (io_status/=0) exit
5633 enddo
5634 if (io_status/=0) exit
5635 enddo
5636
5637 if (io_status/=0) then
5638 close(csv_unit)
5639 call mpistop(trim(caller)//' could not write CSV data')
5640 endif
5641 close(csv_unit)
5642 end subroutine mt_write_fieldline_products_plane_arbitrary_csv
5643
5644 subroutine mt_write_fieldline_products_vtu_empty(vtu_file,do_twist, &
5645 do_q,do_qperp,caller,do_length)
5646 character(len=*), intent(in) :: vtu_file,caller
5647 logical, intent(in) :: do_twist,do_q,do_qperp
5648 logical, intent(in), optional :: do_length
5649
5650 integer :: vtu_unit,io_status
5651 logical :: do_length_eff
5652
5653 open(newunit=vtu_unit,file=trim(vtu_file),status='replace', &
5654 action='write',form='formatted',iostat=io_status)
5655 if (io_status/=0) then
5656 call mpistop(trim(caller)//' could not open VTU file')
5657 endif
5658
5659 call mt_write_vtu_file_header(vtu_unit,0,0)
5660 do_length_eff=.true.
5661 if (present(do_length)) do_length_eff=do_length
5662 call mt_write_vtu_empty_pointdata(vtu_unit,do_length_eff,do_twist, &
5663 do_q,do_qperp)
5664 write(vtu_unit,'(a)',iostat=io_status) '<CellData>'
5665 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) '</CellData>'
5666 if (io_status==0) then
5667 write(vtu_unit,'(a)',iostat=io_status) '<Points>'
5668 endif
5669 if (io_status==0) then
5670 write(vtu_unit,'(a)',iostat=io_status) &
5671 '<DataArray type="Float64" NumberOfComponents="3" format="ascii">'
5672 endif
5673 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) '</DataArray>'
5674 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) '</Points>'
5675 if (io_status==0) call mt_write_vtu_cells_empty(vtu_unit,io_status)
5676 if (io_status==0) call mt_write_vtu_file_footer(vtu_unit,io_status)
5677 if (io_status/=0) then
5678 close(vtu_unit)
5679 call mpistop(trim(caller)//' could not write VTU file')
5680 endif
5681
5682 close(vtu_unit)
5683 end subroutine mt_write_fieldline_products_vtu_empty
5684
5685 subroutine mt_write_fieldline_products_vtu_vertices(vtu_file, &
5686 length_results,twist_results,q_results,qperp_results,npoint, &
5687 do_length,do_twist,do_q,do_qperp,caller)
5688 integer, intent(in) :: npoint
5689 type(trace_length_result), intent(in) :: length_results(npoint)
5690 type(trace_twist_result), intent(in) :: twist_results(:)
5691 type(trace_qperp_result), intent(in) :: q_results(:)
5692 type(trace_qperp_result), intent(in) :: qperp_results(:)
5693 character(len=*), intent(in) :: vtu_file,caller
5694 logical, intent(in) :: do_length,do_twist,do_q,do_qperp
5695
5696 integer :: vtu_unit,io_status
5697
5698 open(newunit=vtu_unit,file=trim(vtu_file),status='replace', &
5699 action='write',form='formatted',iostat=io_status)
5700 if (io_status/=0) then
5701 call mpistop(trim(caller)//' could not open VTU file')
5702 endif
5703
5704 call mt_write_vtu_file_header(vtu_unit,npoint,npoint)
5705 call mt_write_vtu_product_pointdata(vtu_unit,length_results, &
5706 twist_results,q_results,qperp_results,npoint,do_twist,do_q, &
5707 do_qperp,io_status,do_length=do_length)
5708 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) '<CellData>'
5709 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) '</CellData>'
5710 if (io_status==0) call mt_write_vtu_points(vtu_unit,length_results, &
5711 npoint,io_status)
5712 if (io_status==0) call mt_write_vtu_vertex_cells(vtu_unit,npoint, &
5713 io_status)
5714 if (io_status==0) call mt_write_vtu_file_footer(vtu_unit,io_status)
5715 if (io_status/=0) then
5716 close(vtu_unit)
5717 call mpistop(trim(caller)//' could not write VTU file')
5718 endif
5719
5720 close(vtu_unit)
5721 end subroutine mt_write_fieldline_products_vtu_vertices
5722
5723 subroutine mt_write_fieldline_products_vtu_plane(vtu_file, &
5724 length_results,twist_results,q_results,qperp_results,n1,n2,do_twist, &
5725 do_q,do_qperp,caller,do_length)
5726 integer, intent(in) :: n1,n2
5727 type(trace_length_result), intent(in) :: length_results(n1*n2)
5728 type(trace_twist_result), intent(in) :: twist_results(:)
5729 type(trace_qperp_result), intent(in) :: q_results(:)
5730 type(trace_qperp_result), intent(in) :: qperp_results(:)
5731 character(len=*), intent(in) :: vtu_file,caller
5732 logical, intent(in) :: do_twist,do_q,do_qperp
5733 logical, intent(in), optional :: do_length
5734
5735 integer :: npoint,ncell,vtu_unit,io_status
5736 logical :: do_length_eff
5737
5738 npoint=n1*n2
5739 if (n1>1 .and. n2>1) then
5740 ncell=(n1-1)*(n2-1)
5741 else
5742 ncell=npoint
5743 endif
5744
5745 open(newunit=vtu_unit,file=trim(vtu_file),status='replace', &
5746 action='write',form='formatted',iostat=io_status)
5747 if (io_status/=0) then
5748 call mpistop(trim(caller)//' could not open VTU file')
5749 endif
5750
5751 call mt_write_vtu_file_header(vtu_unit,npoint,ncell)
5752 do_length_eff=.true.
5753 if (present(do_length)) do_length_eff=do_length
5754 call mt_write_vtu_product_pointdata(vtu_unit,length_results, &
5755 twist_results,q_results,qperp_results,npoint,do_twist,do_q, &
5756 do_qperp,io_status,do_length=do_length_eff)
5757 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) '<CellData>'
5758 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) '</CellData>'
5759 if (io_status==0) call mt_write_vtu_points(vtu_unit,length_results, &
5760 npoint,io_status)
5761 if (io_status==0) then
5762 if (n1>1 .and. n2>1) then
5763 call mt_write_vtu_quad_cells(vtu_unit,n1,n2,io_status)
5764 else
5765 call mt_write_vtu_vertex_cells(vtu_unit,npoint,io_status)
5766 endif
5767 endif
5768 if (io_status==0) call mt_write_vtu_file_footer(vtu_unit,io_status)
5769 if (io_status/=0) then
5770 close(vtu_unit)
5771 call mpistop(trim(caller)//' could not write VTU file')
5772 endif
5773
5774 close(vtu_unit)
5775 end subroutine mt_write_fieldline_products_vtu_plane
5776
5777 subroutine mt_write_qsl_plane_vtu(vtu_file,length_results,twist_results, &
5778 mapping_results,qperp_results,n1,n2,caller)
5779 integer, intent(in) :: n1,n2
5780 type(trace_length_result), intent(in) :: length_results(n1*n2)
5781 type(trace_twist_result), intent(in) :: twist_results(n1*n2)
5782 type(trace_mapping_result), intent(in) :: mapping_results(n1*n2)
5783 type(trace_qperp_result), intent(in) :: qperp_results(n1*n2)
5784 character(len=*), intent(in) :: vtu_file,caller
5785
5786 integer :: npoint,ncell,vtu_unit,io_status
5787
5788 npoint=n1*n2
5789 if (n1>1 .and. n2>1) then
5790 ncell=(n1-1)*(n2-1)
5791 else
5792 ncell=npoint
5793 endif
5794
5795 open(newunit=vtu_unit,file=trim(vtu_file),status='replace', &
5796 action='write',form='formatted',iostat=io_status)
5797 if (io_status/=0) then
5798 call mpistop(trim(caller)//' could not open VTU file')
5799 endif
5800
5801 call mt_write_vtu_file_header(vtu_unit,npoint,ncell)
5802 call mt_write_qsl_plane_vtu_pointdata(vtu_unit,length_results, &
5803 twist_results,mapping_results,qperp_results,npoint,io_status)
5804 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) '<CellData>'
5805 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) '</CellData>'
5806 if (io_status==0) call mt_write_vtu_points(vtu_unit,length_results, &
5807 npoint,io_status)
5808 if (io_status==0) then
5809 if (n1>1 .and. n2>1) then
5810 call mt_write_vtu_quad_cells(vtu_unit,n1,n2,io_status)
5811 else
5812 call mt_write_vtu_vertex_cells(vtu_unit,npoint,io_status)
5813 endif
5814 endif
5815 if (io_status==0) call mt_write_vtu_file_footer(vtu_unit,io_status)
5816 if (io_status/=0) then
5817 close(vtu_unit)
5818 call mpistop(trim(caller)//' could not write VTU file')
5819 endif
5820
5821 close(vtu_unit)
5822 end subroutine mt_write_qsl_plane_vtu
5823
5824 subroutine mt_write_qsl_plane_vtu_pointdata(vtu_unit,length_results, &
5825 twist_results,mapping_results,qperp_results,npoint,io_status)
5826 integer, intent(in) :: vtu_unit,npoint
5827 type(trace_length_result), intent(in) :: length_results(npoint)
5828 type(trace_twist_result), intent(in) :: twist_results(npoint)
5829 type(trace_mapping_result), intent(in) :: mapping_results(npoint)
5830 type(trace_qperp_result), intent(in) :: qperp_results(npoint)
5831 integer, intent(inout) :: io_status
5832
5833 write(vtu_unit,'(a)',iostat=io_status) '<PointData>'
5834 if (io_status/=0) return
5835
5836 if (mt_vtk_detail_is_full()) then
5837 call mt_write_vtu_length_pointdata(vtu_unit,length_results,npoint, &
5838 io_status)
5839 call mt_write_vtu_twist_pointdata(vtu_unit,twist_results,npoint, &
5840 io_status)
5841 call mt_write_vtu_mapping_pointdata(vtu_unit,mapping_results,npoint, &
5842 io_status)
5843 call mt_write_vtu_q_product_pointdata(vtu_unit,qperp_results, &
5844 npoint,.true.,io_status)
5845 call mt_write_vtu_qperp_public_pointdata(vtu_unit,qperp_results, &
5846 npoint,io_status)
5847 call mt_write_vtu_qperp_method2_pointdata(vtu_unit,qperp_results, &
5848 npoint,io_status)
5849 else
5850 call mt_write_vtu_qsl_minimal_pointdata(vtu_unit,length_results, &
5851 twist_results,qperp_results,npoint,io_status)
5852 endif
5853
5854 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) '</PointData>'
5855 end subroutine mt_write_qsl_plane_vtu_pointdata
5856
5857 subroutine mt_write_vtu_qsl_minimal_pointdata(vtu_unit,length_results, &
5858 twist_results,qperp_results,npoint,io_status)
5859 integer, intent(in) :: vtu_unit,npoint
5860 type(trace_length_result), intent(in) :: length_results(npoint)
5861 type(trace_twist_result), intent(in) :: twist_results(npoint)
5862 type(trace_qperp_result), intent(in) :: qperp_results(npoint)
5863 integer, intent(inout) :: io_status
5864
5865 integer :: ipoint
5866
5867 call mt_write_vtu_float_array_start(vtu_unit,'length_total',io_status)
5868 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
5869 (mt_visual_float(length_results(ipoint)%total_length), &
5870 ipoint=1,npoint)
5871 call mt_write_vtu_data_array_end(vtu_unit,io_status)
5872
5873 call mt_write_vtu_float_array_start(vtu_unit,'twist_total',io_status)
5874 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
5875 (mt_visual_float(twist_results(ipoint)%total_twist), &
5876 ipoint=1,npoint)
5877 call mt_write_vtu_data_array_end(vtu_unit,io_status)
5878
5879 call mt_write_vtu_float_array_start(vtu_unit,'logQ',io_status)
5880 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
5881 (mt_visual_valid_float(qperp_results(ipoint)%logq0, &
5882 qperp_results(ipoint)%valid_q0),ipoint=1,npoint)
5883 call mt_write_vtu_data_array_end(vtu_unit,io_status)
5884
5885 call mt_write_vtu_float_array_start(vtu_unit,'logQperp',io_status)
5886 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
5887 (mt_visual_valid_float(qperp_results(ipoint)%logqperp, &
5888 qperp_results(ipoint)%valid),ipoint=1,npoint)
5889 call mt_write_vtu_data_array_end(vtu_unit,io_status)
5890
5891 end subroutine mt_write_vtu_qsl_minimal_pointdata
5892
5893 double precision function mt_vti_axis_spacing(xmin,xmax,n)
5894 integer, intent(in) :: n
5895 double precision, intent(in) :: xmin,xmax
5896
5897 if (n>1) then
5898 mt_vti_axis_spacing=(xmax-xmin)/dble(n-1)
5899 else
5900 mt_vti_axis_spacing=0.d0
5901 endif
5902 end function mt_vti_axis_spacing
5903
5904 subroutine mt_allocate_volume_products(products,nseed,do_twist,do_q, &
5905 do_qperp)
5906 type(mt_volume_products), intent(inout) :: products
5907 integer, intent(in) :: nseed
5908 logical, intent(in) :: do_twist,do_q,do_qperp
5909
5910 allocate(products%length_total(nseed))
5911 allocate(products%length_backward(nseed))
5912 allocate(products%length_forward(nseed))
5913 allocate(products%nstep_backward_length(nseed))
5914 allocate(products%nstep_forward_length(nseed))
5915 allocate(products%status_backward_length(nseed))
5916 allocate(products%status_forward_length(nseed))
5917
5918 if (do_twist) then
5919 allocate(products%twist_total(nseed))
5920 allocate(products%twist_backward(nseed))
5921 allocate(products%twist_forward(nseed))
5922 allocate(products%nstep_backward_twist(nseed))
5923 allocate(products%nstep_forward_twist(nseed))
5924 allocate(products%status_backward_twist(nseed))
5925 allocate(products%status_forward_twist(nseed))
5926 endif
5927
5928 if (do_q) then
5929 allocate(products%q(nseed))
5930 allocate(products%logq(nseed))
5931 allocate(products%N2_q(nseed))
5932 allocate(products%bfactor_q(nseed))
5933 allocate(products%length_forward_q(nseed))
5934 allocate(products%length_backward_q(nseed))
5935 allocate(products%Bseed_norm_q(nseed))
5936 allocate(products%Bf_norm_q(nseed))
5937 allocate(products%Bb_norm_q(nseed))
5938 allocate(products%valid_q(nseed))
5939 allocate(products%status_q(nseed))
5940 allocate(products%face_forward_q(nseed))
5941 allocate(products%face_backward_q(nseed))
5942 allocate(products%status_forward_q(nseed))
5943 allocate(products%status_backward_q(nseed))
5944 endif
5945
5946 if (do_qperp) then
5947 allocate(products%qperp(nseed))
5948 allocate(products%logqperp(nseed))
5949 allocate(products%N2(nseed))
5950 allocate(products%bfactor(nseed))
5951 allocate(products%length_forward_qperp(nseed))
5952 allocate(products%length_backward_qperp(nseed))
5953 allocate(products%Bseed_norm(nseed))
5954 allocate(products%Bf_norm(nseed))
5955 allocate(products%Bb_norm(nseed))
5956 allocate(products%valid_qperp(nseed))
5957 allocate(products%status_qperp(nseed))
5958 allocate(products%face_forward_qperp(nseed))
5959 allocate(products%face_backward_qperp(nseed))
5960 allocate(products%status_forward_qperp(nseed))
5961 allocate(products%status_backward_qperp(nseed))
5962 endif
5963 end subroutine mt_allocate_volume_products
5964
5965 subroutine mt_deallocate_volume_products(products)
5966 type(mt_volume_products), intent(inout) :: products
5967
5968 if (allocated(products%length_total)) deallocate(products%length_total)
5969 if (allocated(products%length_backward)) deallocate(products%length_backward)
5970 if (allocated(products%length_forward)) deallocate(products%length_forward)
5971 if (allocated(products%nstep_backward_length)) &
5972 deallocate(products%nstep_backward_length)
5973 if (allocated(products%nstep_forward_length)) &
5974 deallocate(products%nstep_forward_length)
5975 if (allocated(products%status_backward_length)) &
5976 deallocate(products%status_backward_length)
5977 if (allocated(products%status_forward_length)) &
5978 deallocate(products%status_forward_length)
5979
5980 if (allocated(products%twist_total)) deallocate(products%twist_total)
5981 if (allocated(products%twist_backward)) deallocate(products%twist_backward)
5982 if (allocated(products%twist_forward)) deallocate(products%twist_forward)
5983 if (allocated(products%nstep_backward_twist)) &
5984 deallocate(products%nstep_backward_twist)
5985 if (allocated(products%nstep_forward_twist)) &
5986 deallocate(products%nstep_forward_twist)
5987 if (allocated(products%status_backward_twist)) &
5988 deallocate(products%status_backward_twist)
5989 if (allocated(products%status_forward_twist)) &
5990 deallocate(products%status_forward_twist)
5991
5992 if (allocated(products%q)) deallocate(products%q)
5993 if (allocated(products%logq)) deallocate(products%logq)
5994 if (allocated(products%N2_q)) deallocate(products%N2_q)
5995 if (allocated(products%bfactor_q)) deallocate(products%bfactor_q)
5996 if (allocated(products%length_forward_q)) &
5997 deallocate(products%length_forward_q)
5998 if (allocated(products%length_backward_q)) &
5999 deallocate(products%length_backward_q)
6000 if (allocated(products%Bseed_norm_q)) deallocate(products%Bseed_norm_q)
6001 if (allocated(products%Bf_norm_q)) deallocate(products%Bf_norm_q)
6002 if (allocated(products%Bb_norm_q)) deallocate(products%Bb_norm_q)
6003 if (allocated(products%valid_q)) deallocate(products%valid_q)
6004 if (allocated(products%status_q)) deallocate(products%status_q)
6005 if (allocated(products%face_forward_q)) &
6006 deallocate(products%face_forward_q)
6007 if (allocated(products%face_backward_q)) &
6008 deallocate(products%face_backward_q)
6009 if (allocated(products%status_forward_q)) &
6010 deallocate(products%status_forward_q)
6011 if (allocated(products%status_backward_q)) &
6012 deallocate(products%status_backward_q)
6013
6014 if (allocated(products%qperp)) deallocate(products%qperp)
6015 if (allocated(products%logqperp)) deallocate(products%logqperp)
6016 if (allocated(products%N2)) deallocate(products%N2)
6017 if (allocated(products%bfactor)) deallocate(products%bfactor)
6018 if (allocated(products%length_forward_qperp)) &
6019 deallocate(products%length_forward_qperp)
6020 if (allocated(products%length_backward_qperp)) &
6021 deallocate(products%length_backward_qperp)
6022 if (allocated(products%Bseed_norm)) deallocate(products%Bseed_norm)
6023 if (allocated(products%Bf_norm)) deallocate(products%Bf_norm)
6024 if (allocated(products%Bb_norm)) deallocate(products%Bb_norm)
6025 if (allocated(products%valid_qperp)) deallocate(products%valid_qperp)
6026 if (allocated(products%status_qperp)) deallocate(products%status_qperp)
6027 if (allocated(products%face_forward_qperp)) &
6028 deallocate(products%face_forward_qperp)
6029 if (allocated(products%face_backward_qperp)) &
6030 deallocate(products%face_backward_qperp)
6031 if (allocated(products%status_forward_qperp)) &
6032 deallocate(products%status_forward_qperp)
6033 if (allocated(products%status_backward_qperp)) &
6034 deallocate(products%status_backward_qperp)
6035 end subroutine mt_deallocate_volume_products
6036
6037 subroutine mt_build_volume_slab_seeds(seeds,xmin,ymin,zmin,spacing, &
6038 nx,ny,k_start,slab_nz)
6039 double precision, intent(out) :: seeds(:,:)
6040 double precision, intent(in) :: xmin,ymin,zmin,spacing(3)
6041 integer, intent(in) :: nx,ny,k_start,slab_nz
6042
6043 integer :: i,j,k,kk,iseed
6044
6045 do kk=1,slab_nz
6046 k=k_start+kk-1
6047 do j=1,ny
6048 do i=1,nx
6049 iseed=(kk-1)*nx*ny+(j-1)*nx+i
6050 seeds(iseed,1)=xmin+dble(i-1)*spacing(1)
6051 seeds(iseed,2)=ymin+dble(j-1)*spacing(2)
6052 seeds(iseed,3)=zmin+dble(k-1)*spacing(3)
6053 enddo
6054 enddo
6055 enddo
6056 end subroutine mt_build_volume_slab_seeds
6057
6058 subroutine mt_copy_volume_length_slab(products,results,nx,ny,k_start, &
6059 slab_nz)
6060 type(mt_volume_products), intent(inout) :: products
6061 type(trace_length_result), intent(in) :: results(:)
6062 integer, intent(in) :: nx,ny,k_start,slab_nz
6063
6064 integer :: i,j,kk,k,ilocal,iglobal
6065
6066 do kk=1,slab_nz
6067 k=k_start+kk-1
6068 do j=1,ny
6069 do i=1,nx
6070 ilocal=(kk-1)*nx*ny+(j-1)*nx+i
6071 iglobal=(k-1)*nx*ny+(j-1)*nx+i
6072 products%length_total(iglobal)=results(ilocal)%total_length
6073 products%length_backward(iglobal)=results(ilocal)%backward_length
6074 products%length_forward(iglobal)=results(ilocal)%forward_length
6075 products%nstep_backward_length(iglobal)= &
6076 results(ilocal)%backward_nstep
6077 products%nstep_forward_length(iglobal)= &
6078 results(ilocal)%forward_nstep
6079 products%status_backward_length(iglobal)= &
6080 results(ilocal)%backward_status
6081 products%status_forward_length(iglobal)= &
6082 results(ilocal)%forward_status
6083 enddo
6084 enddo
6085 enddo
6086 end subroutine mt_copy_volume_length_slab
6087
6088 subroutine mt_copy_volume_twist_slab(products,results,nx,ny,k_start, &
6089 slab_nz)
6090 type(mt_volume_products), intent(inout) :: products
6091 type(trace_twist_result), intent(in) :: results(:)
6092 integer, intent(in) :: nx,ny,k_start,slab_nz
6093
6094 integer :: i,j,kk,k,ilocal,iglobal
6095
6096 do kk=1,slab_nz
6097 k=k_start+kk-1
6098 do j=1,ny
6099 do i=1,nx
6100 ilocal=(kk-1)*nx*ny+(j-1)*nx+i
6101 iglobal=(k-1)*nx*ny+(j-1)*nx+i
6102 products%twist_total(iglobal)=results(ilocal)%total_twist
6103 products%twist_backward(iglobal)=results(ilocal)%backward_twist
6104 products%twist_forward(iglobal)=results(ilocal)%forward_twist
6105 products%nstep_backward_twist(iglobal)= &
6106 results(ilocal)%line%backward_nstep
6107 products%nstep_forward_twist(iglobal)= &
6108 results(ilocal)%line%forward_nstep
6109 products%status_backward_twist(iglobal)= &
6110 results(ilocal)%line%backward_status
6111 products%status_forward_twist(iglobal)= &
6112 results(ilocal)%line%forward_status
6113 enddo
6114 enddo
6115 enddo
6116 end subroutine mt_copy_volume_twist_slab
6117
6118 subroutine mt_copy_volume_q_slab(products,results,nx,ny,k_start,slab_nz)
6119 type(mt_volume_products), intent(inout) :: products
6120 type(trace_qperp_result), intent(in) :: results(:)
6121 integer, intent(in) :: nx,ny,k_start,slab_nz
6122
6123 integer :: i,j,kk,k,ilocal,iglobal
6124
6125 do kk=1,slab_nz
6126 k=k_start+kk-1
6127 do j=1,ny
6128 do i=1,nx
6129 ilocal=(kk-1)*nx*ny+(j-1)*nx+i
6130 iglobal=(k-1)*nx*ny+(j-1)*nx+i
6131 products%q(iglobal)=results(ilocal)%q0
6132 products%logq(iglobal)=results(ilocal)%logq0
6133 products%N2_q(iglobal)=results(ilocal)%N2_qperp0
6134 products%bfactor_q(iglobal)=results(ilocal)%bfactor_qperp0
6135 products%length_forward_q(iglobal)=results(ilocal)%forward_length
6136 products%length_backward_q(iglobal)=results(ilocal)%backward_length
6137 products%Bseed_norm_q(iglobal)=dsqrt(sum(results(ilocal)%B_seed**2))
6138 products%Bf_norm_q(iglobal)=dsqrt(sum(results(ilocal)%forward_B**2))
6139 products%Bb_norm_q(iglobal)=dsqrt(sum(results(ilocal)%backward_B**2))
6140 products%valid_q(iglobal)=merge(1,0,results(ilocal)%valid_q0)
6141 products%status_q(iglobal)=results(ilocal)%status_q0
6142 products%face_forward_q(iglobal)=results(ilocal)%forward_face
6143 products%face_backward_q(iglobal)=results(ilocal)%backward_face
6144 products%status_forward_q(iglobal)=results(ilocal)%forward_status
6145 products%status_backward_q(iglobal)=results(ilocal)%backward_status
6146 enddo
6147 enddo
6148 enddo
6149 end subroutine mt_copy_volume_q_slab
6150
6151 subroutine mt_copy_volume_qperp_slab(products,results,nx,ny,k_start, &
6152 slab_nz)
6153 type(mt_volume_products), intent(inout) :: products
6154 type(trace_qperp_result), intent(in) :: results(:)
6155 integer, intent(in) :: nx,ny,k_start,slab_nz
6156
6157 integer :: i,j,kk,k,ilocal,iglobal
6158
6159 do kk=1,slab_nz
6160 k=k_start+kk-1
6161 do j=1,ny
6162 do i=1,nx
6163 ilocal=(kk-1)*nx*ny+(j-1)*nx+i
6164 iglobal=(k-1)*nx*ny+(j-1)*nx+i
6165 products%qperp(iglobal)=results(ilocal)%qperp
6166 products%logqperp(iglobal)=results(ilocal)%logqperp
6167 products%N2(iglobal)=results(ilocal)%N2
6168 products%bfactor(iglobal)=results(ilocal)%bfactor
6169 products%length_forward_qperp(iglobal)= &
6170 results(ilocal)%forward_length
6171 products%length_backward_qperp(iglobal)= &
6172 results(ilocal)%backward_length
6173 products%Bseed_norm(iglobal)=dsqrt(sum(results(ilocal)%B_seed**2))
6174 products%Bf_norm(iglobal)=dsqrt(sum(results(ilocal)%forward_B**2))
6175 products%Bb_norm(iglobal)=dsqrt(sum(results(ilocal)%backward_B**2))
6176 products%valid_qperp(iglobal)=merge(1,0,results(ilocal)%valid)
6177 products%status_qperp(iglobal)=results(ilocal)%status
6178 products%face_forward_qperp(iglobal)=results(ilocal)%forward_face
6179 products%face_backward_qperp(iglobal)=results(ilocal)%backward_face
6180 products%status_forward_qperp(iglobal)= &
6181 results(ilocal)%forward_status
6182 products%status_backward_qperp(iglobal)= &
6183 results(ilocal)%backward_status
6184 enddo
6185 enddo
6186 enddo
6187 end subroutine mt_copy_volume_qperp_slab
6188
6189 subroutine mt_build_vti_desc(desc,name,array_kind,npoint)
6190 type(mt_vti_array_desc), intent(out) :: desc
6191 character(len=*), intent(in) :: name
6192 integer, intent(in) :: array_kind,npoint
6193
6194 desc%name=''
6195 desc%name=trim(name)
6196 desc%kind=array_kind
6197 select case (array_kind)
6198 case (mt_vti_kind_float64)
6199 desc%nbytes=int(npoint,kind=8)*8_8
6200 case (mt_vti_kind_int32)
6201 desc%nbytes=int(npoint,kind=8)*4_8
6202 case default
6203 desc%nbytes=0_8
6204 end select
6205 desc%offset=0_8
6206 end subroutine mt_build_vti_desc
6207
6208 subroutine mt_finalize_vti_desc_offsets(descs,ndesc)
6209 integer, intent(in) :: ndesc
6210 type(mt_vti_array_desc), intent(inout) :: descs(ndesc)
6211
6212 integer :: idesc
6213 integer(kind=8) :: offset
6214
6215 offset=0_8
6216 do idesc=1,ndesc
6217 descs(idesc)%offset=offset
6218 offset=offset+descs(idesc)%nbytes+4_8
6219 enddo
6220 end subroutine mt_finalize_vti_desc_offsets
6221
6222 subroutine mt_append_vti_desc(descs,idesc,name,array_kind,npoint)
6223 type(mt_vti_array_desc), intent(inout) :: descs(:)
6224 integer, intent(inout) :: idesc
6225 character(len=*), intent(in) :: name
6226 integer, intent(in) :: array_kind,npoint
6227
6228 idesc=idesc+1
6229 call mt_build_vti_desc(descs(idesc),name,array_kind,npoint)
6230 end subroutine mt_append_vti_desc
6231
6232 subroutine mt_build_cartesian_vti_pointdata_descs(npoint,descs,ndesc)
6233 integer, intent(in) :: npoint
6234 type(mt_vti_array_desc), allocatable, intent(out) :: descs(:)
6235 integer, intent(out) :: ndesc
6236
6237 ndesc=3
6238 allocate(descs(ndesc))
6239 call mt_build_vti_desc(descs(1),'length_total',mt_vti_kind_float64, &
6240 npoint)
6241 call mt_build_vti_desc(descs(2),'qperp',mt_vti_kind_float64,npoint)
6242 call mt_build_vti_desc(descs(3),'status',mt_vti_kind_int32,npoint)
6243 call mt_finalize_vti_desc_offsets(descs,ndesc)
6244 end subroutine mt_build_cartesian_vti_pointdata_descs
6245
6246 subroutine mt_build_volume_vti_descs(npoint,do_length,do_twist,do_q, &
6247 do_qperp,descs,ndesc)
6248 integer, intent(in) :: npoint
6249 logical, intent(in) :: do_length,do_twist,do_q,do_qperp
6250 type(mt_vti_array_desc), allocatable, intent(out) :: descs(:)
6251 integer, intent(out) :: ndesc
6252
6253 integer :: idesc,max_desc
6254
6255 if (.not.mt_vtk_detail_is_full()) then
6256 max_desc=0
6257 if (do_length) max_desc=max_desc+1
6258 if (do_twist) max_desc=max_desc+1
6259 if (do_q) max_desc=max_desc+1
6260 if (do_qperp) max_desc=max_desc+1
6261 else
6262 max_desc=0
6263 if (do_length) max_desc=max_desc+7
6264 if (do_twist) max_desc=max_desc+7
6265 if (do_q) max_desc=max_desc+15
6266 if (do_qperp) max_desc=max_desc+15
6267 endif
6268 allocate(descs(max_desc))
6269
6270 idesc=0
6271 if (do_length) then
6272 call mt_append_vti_desc(descs,idesc,'length_total', &
6273 mt_vti_kind_float64,npoint)
6274 endif
6275 if (.not.mt_vtk_detail_is_full()) then
6276 if (do_twist) then
6277 call mt_append_vti_desc(descs,idesc,'twist_total', &
6278 mt_vti_kind_float64,npoint)
6279 endif
6280 if (do_q) then
6281 call mt_append_vti_desc(descs,idesc,'logQ', &
6282 mt_vti_kind_float64,npoint)
6283 endif
6284 if (do_qperp) then
6285 call mt_append_vti_desc(descs,idesc,'logQperp', &
6286 mt_vti_kind_float64,npoint)
6287 endif
6288 ndesc=idesc
6289 call mt_finalize_vti_desc_offsets(descs,ndesc)
6290 return
6291 endif
6292
6293 if (do_length) then
6294 call mt_append_vti_desc(descs,idesc,'length_backward', &
6295 mt_vti_kind_float64,npoint)
6296 call mt_append_vti_desc(descs,idesc,'length_forward', &
6297 mt_vti_kind_float64,npoint)
6298 call mt_append_vti_desc(descs,idesc,'nstep_backward_length', &
6299 mt_vti_kind_int32,npoint)
6300 call mt_append_vti_desc(descs,idesc,'nstep_forward_length', &
6301 mt_vti_kind_int32,npoint)
6302 call mt_append_vti_desc(descs,idesc,'status_backward_length', &
6303 mt_vti_kind_int32,npoint)
6304 call mt_append_vti_desc(descs,idesc,'status_forward_length', &
6305 mt_vti_kind_int32,npoint)
6306 endif
6307
6308 if (do_twist) then
6309 call mt_append_vti_desc(descs,idesc,'twist_total', &
6310 mt_vti_kind_float64,npoint)
6311 call mt_append_vti_desc(descs,idesc,'twist_backward', &
6312 mt_vti_kind_float64,npoint)
6313 call mt_append_vti_desc(descs,idesc,'twist_forward', &
6314 mt_vti_kind_float64,npoint)
6315 call mt_append_vti_desc(descs,idesc,'nstep_backward_twist', &
6316 mt_vti_kind_int32,npoint)
6317 call mt_append_vti_desc(descs,idesc,'nstep_forward_twist', &
6318 mt_vti_kind_int32,npoint)
6319 call mt_append_vti_desc(descs,idesc,'status_backward_twist', &
6320 mt_vti_kind_int32,npoint)
6321 call mt_append_vti_desc(descs,idesc,'status_forward_twist', &
6322 mt_vti_kind_int32,npoint)
6323 endif
6324
6325 if (do_q) then
6326 call mt_append_vti_desc(descs,idesc,'q',mt_vti_kind_float64,npoint)
6327 call mt_append_vti_desc(descs,idesc,'logq', &
6328 mt_vti_kind_float64,npoint)
6329 call mt_append_vti_desc(descs,idesc,'N2_q',mt_vti_kind_float64,npoint)
6330 call mt_append_vti_desc(descs,idesc,'bfactor_q', &
6331 mt_vti_kind_float64,npoint)
6332 call mt_append_vti_desc(descs,idesc,'length_forward_q', &
6333 mt_vti_kind_float64,npoint)
6334 call mt_append_vti_desc(descs,idesc,'length_backward_q', &
6335 mt_vti_kind_float64,npoint)
6336 call mt_append_vti_desc(descs,idesc,'Bseed_norm_q', &
6337 mt_vti_kind_float64,npoint)
6338 call mt_append_vti_desc(descs,idesc,'Bf_norm_q', &
6339 mt_vti_kind_float64,npoint)
6340 call mt_append_vti_desc(descs,idesc,'Bb_norm_q', &
6341 mt_vti_kind_float64,npoint)
6342 call mt_append_vti_desc(descs,idesc,'valid_Q', &
6343 mt_vti_kind_int32,npoint)
6344 call mt_append_vti_desc(descs,idesc,'status_Q', &
6345 mt_vti_kind_int32,npoint)
6346 call mt_append_vti_desc(descs,idesc,'face_forward_Q', &
6347 mt_vti_kind_int32,npoint)
6348 call mt_append_vti_desc(descs,idesc,'face_backward_Q', &
6349 mt_vti_kind_int32,npoint)
6350 call mt_append_vti_desc(descs,idesc,'status_forward_Q', &
6351 mt_vti_kind_int32,npoint)
6352 call mt_append_vti_desc(descs,idesc,'status_backward_Q', &
6353 mt_vti_kind_int32,npoint)
6354 endif
6355
6356 if (do_qperp) then
6357 call mt_append_vti_desc(descs,idesc,'qperp', &
6358 mt_vti_kind_float64,npoint)
6359 call mt_append_vti_desc(descs,idesc,'logqperp', &
6360 mt_vti_kind_float64,npoint)
6361 call mt_append_vti_desc(descs,idesc,'N2',mt_vti_kind_float64, &
6362 npoint)
6363 call mt_append_vti_desc(descs,idesc,'bfactor', &
6364 mt_vti_kind_float64,npoint)
6365 call mt_append_vti_desc(descs,idesc,'length_forward_qperp', &
6366 mt_vti_kind_float64,npoint)
6367 call mt_append_vti_desc(descs,idesc,'length_backward_qperp', &
6368 mt_vti_kind_float64,npoint)
6369 call mt_append_vti_desc(descs,idesc,'Bseed_norm', &
6370 mt_vti_kind_float64,npoint)
6371 call mt_append_vti_desc(descs,idesc,'Bf_norm', &
6372 mt_vti_kind_float64,npoint)
6373 call mt_append_vti_desc(descs,idesc,'Bb_norm', &
6374 mt_vti_kind_float64,npoint)
6375 call mt_append_vti_desc(descs,idesc,'valid_qperp', &
6376 mt_vti_kind_int32,npoint)
6377 call mt_append_vti_desc(descs,idesc,'status_qperp', &
6378 mt_vti_kind_int32,npoint)
6379 call mt_append_vti_desc(descs,idesc,'face_forward_qperp', &
6380 mt_vti_kind_int32,npoint)
6381 call mt_append_vti_desc(descs,idesc,'face_backward_qperp', &
6382 mt_vti_kind_int32,npoint)
6383 call mt_append_vti_desc(descs,idesc,'status_forward_qperp', &
6384 mt_vti_kind_int32,npoint)
6385 call mt_append_vti_desc(descs,idesc,'status_backward_qperp', &
6386 mt_vti_kind_int32,npoint)
6387 endif
6388
6389 ndesc=idesc
6390 call mt_finalize_vti_desc_offsets(descs,ndesc)
6391 end subroutine mt_build_volume_vti_descs
6392
6393 character(len=8) function mt_vti_type_name(array_kind)
6394 integer, intent(in) :: array_kind
6395
6396 select case (array_kind)
6397 case (mt_vti_kind_float64)
6398 mt_vti_type_name='Float64'
6399 case (mt_vti_kind_int32)
6400 mt_vti_type_name='Int32'
6401 case default
6402 mt_vti_type_name='Unknown'
6403 end select
6404 end function mt_vti_type_name
6405
6406 subroutine mt_write_vti_image_header(vti_unit,origin,spacing,nx,ny,nz, &
6407 descs,ndesc,io_status)
6408 integer, intent(in) :: vti_unit,nx,ny,nz,ndesc
6409 double precision, intent(in) :: origin(3),spacing(3)
6410 type(mt_vti_array_desc), intent(in) :: descs(ndesc)
6411 integer, intent(out) :: io_status
6412
6413 integer :: extent(6),idesc
6414
6415 extent=(/ 0,nx-1,0,ny-1,0,nz-1 /)
6416 write(vti_unit,'(a)',iostat=io_status) '<?xml version="1.0"?>'
6417 if (io_status/=0) return
6418 write(vti_unit,'(a)',iostat=io_status) &
6419 '<VTKFile type="ImageData" version="0.1" byte_order="LittleEndian">'
6420 if (io_status/=0) return
6421 write(vti_unit,'(a,3(1pe24.16),a,6(i0,1x),a,3(1pe24.16),a)', &
6422 iostat=io_status) ' <ImageData Origin="',origin, &
6423 '" WholeExtent="',extent,'" Spacing="',spacing,'">'
6424 if (io_status/=0) return
6425 write(vti_unit,'(a,6(i0,1x),a)',iostat=io_status) &
6426 ' <Piece Extent="',extent,'">'
6427 if (io_status/=0) return
6428 write(vti_unit,'(a)',iostat=io_status) ' <PointData>'
6429 if (io_status/=0) return
6430
6431 do idesc=1,ndesc
6432 call mt_write_vti_appended_array(vti_unit, &
6433 mt_vti_type_name(descs(idesc)%kind),trim(descs(idesc)%name), &
6434 descs(idesc)%offset,io_status)
6435 if (io_status/=0) return
6436 enddo
6437
6438 write(vti_unit,'(a)',iostat=io_status) ' </PointData>'
6439 if (io_status/=0) return
6440 write(vti_unit,'(a)',iostat=io_status) ' </Piece>'
6441 if (io_status/=0) return
6442 write(vti_unit,'(a)',iostat=io_status) ' </ImageData>'
6443 if (io_status/=0) return
6444 write(vti_unit,'(a)',iostat=io_status) '<AppendedData encoding="raw">'
6445 end subroutine mt_write_vti_image_header
6446
6447 subroutine mt_write_fieldline_products_volume_vti(vti_file,origin, &
6448 spacing,nx,ny,nz,products,do_length,do_twist,do_q,do_qperp,caller)
6449 integer, intent(in) :: nx,ny,nz
6450 double precision, intent(in) :: origin(3),spacing(3)
6451 type(mt_volume_products), intent(in) :: products
6452 logical, intent(in) :: do_length,do_twist,do_q,do_qperp
6453 character(len=*), intent(in) :: vti_file,caller
6454
6455 integer :: vti_unit,io_status,npoint
6456 character(len=1) :: marker
6457 type(mt_vti_array_desc), allocatable :: descs(:)
6458 integer :: ndesc
6459
6460 npoint=nx*ny*nz
6461 call mt_check_vti_byte_count(npoint,caller)
6462 call mt_build_volume_vti_descs(npoint,do_length,do_twist,do_q, &
6463 do_qperp,descs,ndesc)
6464
6465 open(newunit=vti_unit,file=trim(vti_file),status='replace', &
6466 action='write',form='formatted',iostat=io_status)
6467 if (io_status/=0) then
6468 call mpistop(trim(caller)//' could not open VTI file')
6469 endif
6470
6471 call mt_write_vti_image_header(vti_unit,origin,spacing,nx,ny,nz, &
6472 descs,ndesc,io_status)
6473 if (io_status/=0) then
6474 close(vti_unit)
6475 call mpistop(trim(caller)//' could not write VTI header')
6476 endif
6477 close(vti_unit)
6478
6479 open(newunit=vti_unit,file=trim(vti_file),access='stream', &
6480 form='unformatted',status='old',position='append', &
6481 action='write',iostat=io_status)
6482 if (io_status/=0) then
6483 call mpistop(trim(caller)//' could not append VTI payload')
6484 endif
6485
6486 marker='_'
6487 write(vti_unit,iostat=io_status) marker
6488 if (io_status==0) then
6489 call mt_write_volume_vti_payload(vti_unit,products,npoint,descs, &
6490 ndesc,io_status)
6491 endif
6492 close(vti_unit)
6493 if (io_status/=0) then
6494 call mpistop(trim(caller)//' could not write VTI payload')
6495 endif
6496
6497 open(newunit=vti_unit,file=trim(vti_file),status='old', &
6498 action='write',form='formatted',position='append',iostat=io_status)
6499 if (io_status/=0) then
6500 call mpistop(trim(caller)//' could not append VTI footer')
6501 endif
6502 write(vti_unit,'(a)',iostat=io_status) '</AppendedData>'
6503 if (io_status==0) write(vti_unit,'(a)',iostat=io_status) '</VTKFile>'
6504 close(vti_unit)
6505 if (io_status/=0) then
6506 call mpistop(trim(caller)//' could not write VTI footer')
6507 endif
6508 deallocate(descs)
6509 end subroutine mt_write_fieldline_products_volume_vti
6510
6511 subroutine mt_write_volume_vti_payload(vti_unit,products,npoint,descs, &
6512 ndesc,io_status)
6513 integer, intent(in) :: vti_unit,npoint,ndesc
6514 type(mt_volume_products), intent(in) :: products
6515 type(mt_vti_array_desc), intent(in) :: descs(ndesc)
6516 integer, intent(inout) :: io_status
6517
6518 integer :: idesc
6519
6520 do idesc=1,ndesc
6521 select case (trim(descs(idesc)%name))
6522 case ('length_total')
6523 if (mt_vtk_detail_is_full()) then
6524 call mt_write_vti_payload_float64(vti_unit,products%length_total, &
6525 npoint,io_status)
6526 else
6527 call mt_write_vti_payload_float64_visual(vti_unit, &
6528 products%length_total,npoint,io_status)
6529 endif
6530 case ('length_backward')
6531 call mt_write_vti_payload_float64(vti_unit,products%length_backward, &
6532 npoint,io_status)
6533 case ('length_forward')
6534 call mt_write_vti_payload_float64(vti_unit,products%length_forward, &
6535 npoint,io_status)
6536 case ('nstep_backward_length')
6537 call mt_write_vti_payload_int32(vti_unit, &
6538 products%nstep_backward_length,npoint,io_status)
6539 case ('nstep_forward_length')
6540 call mt_write_vti_payload_int32(vti_unit, &
6541 products%nstep_forward_length,npoint,io_status)
6542 case ('status_backward_length')
6543 call mt_write_vti_payload_int32(vti_unit, &
6544 products%status_backward_length,npoint,io_status)
6545 case ('status_forward_length')
6546 call mt_write_vti_payload_int32(vti_unit, &
6547 products%status_forward_length,npoint,io_status)
6548 case ('twist_total')
6549 if (mt_vtk_detail_is_full()) then
6550 call mt_write_vti_payload_float64(vti_unit,products%twist_total, &
6551 npoint,io_status)
6552 else
6553 call mt_write_vti_payload_float64_visual(vti_unit, &
6554 products%twist_total,npoint,io_status)
6555 endif
6556 case ('twist_backward')
6557 call mt_write_vti_payload_float64(vti_unit,products%twist_backward, &
6558 npoint,io_status)
6559 case ('twist_forward')
6560 call mt_write_vti_payload_float64(vti_unit,products%twist_forward, &
6561 npoint,io_status)
6562 case ('nstep_backward_twist')
6563 call mt_write_vti_payload_int32(vti_unit, &
6564 products%nstep_backward_twist,npoint,io_status)
6565 case ('nstep_forward_twist')
6566 call mt_write_vti_payload_int32(vti_unit, &
6567 products%nstep_forward_twist,npoint,io_status)
6568 case ('status_backward_twist')
6569 call mt_write_vti_payload_int32(vti_unit, &
6570 products%status_backward_twist,npoint,io_status)
6571 case ('status_forward_twist')
6572 call mt_write_vti_payload_int32(vti_unit, &
6573 products%status_forward_twist,npoint,io_status)
6574 case ('q')
6575 call mt_write_vti_payload_float64(vti_unit,products%q,npoint, &
6576 io_status)
6577 case ('logq')
6578 call mt_write_vti_payload_float64(vti_unit,products%logq,npoint, &
6579 io_status)
6580 case ('logQ')
6581 call mt_write_vti_payload_logq_visual(vti_unit,products,npoint, &
6582 io_status)
6583 case ('N2_q')
6584 call mt_write_vti_payload_float64(vti_unit,products%N2_q,npoint, &
6585 io_status)
6586 case ('bfactor_q')
6587 call mt_write_vti_payload_float64(vti_unit,products%bfactor_q, &
6588 npoint,io_status)
6589 case ('length_forward_q')
6590 call mt_write_vti_payload_float64(vti_unit, &
6591 products%length_forward_q,npoint,io_status)
6592 case ('length_backward_q')
6593 call mt_write_vti_payload_float64(vti_unit, &
6594 products%length_backward_q,npoint,io_status)
6595 case ('Bseed_norm_q')
6596 call mt_write_vti_payload_float64(vti_unit,products%Bseed_norm_q, &
6597 npoint,io_status)
6598 case ('Bf_norm_q')
6599 call mt_write_vti_payload_float64(vti_unit,products%Bf_norm_q,npoint, &
6600 io_status)
6601 case ('Bb_norm_q')
6602 call mt_write_vti_payload_float64(vti_unit,products%Bb_norm_q,npoint, &
6603 io_status)
6604 case ('valid_Q')
6605 call mt_write_vti_payload_int32(vti_unit,products%valid_q,npoint, &
6606 io_status)
6607 case ('status_Q')
6608 call mt_write_vti_payload_int32(vti_unit,products%status_q,npoint, &
6609 io_status)
6610 case ('face_forward_Q')
6611 call mt_write_vti_payload_int32(vti_unit,products%face_forward_q, &
6612 npoint,io_status)
6613 case ('face_backward_Q')
6614 call mt_write_vti_payload_int32(vti_unit,products%face_backward_q, &
6615 npoint,io_status)
6616 case ('status_forward_Q')
6617 call mt_write_vti_payload_int32(vti_unit,products%status_forward_q, &
6618 npoint,io_status)
6619 case ('status_backward_Q')
6620 call mt_write_vti_payload_int32(vti_unit,products%status_backward_q, &
6621 npoint,io_status)
6622 case ('qperp')
6623 call mt_write_vti_payload_float64(vti_unit,products%qperp,npoint, &
6624 io_status)
6625 case ('logqperp')
6626 call mt_write_vti_payload_float64(vti_unit,products%logqperp, &
6627 npoint,io_status)
6628 case ('logQperp')
6629 call mt_write_vti_payload_logqperp_visual(vti_unit,products,npoint, &
6630 io_status)
6631 case ('N2')
6632 call mt_write_vti_payload_float64(vti_unit,products%N2,npoint, &
6633 io_status)
6634 case ('bfactor')
6635 call mt_write_vti_payload_float64(vti_unit,products%bfactor,npoint, &
6636 io_status)
6637 case ('length_forward_qperp')
6638 call mt_write_vti_payload_float64(vti_unit, &
6639 products%length_forward_qperp,npoint,io_status)
6640 case ('length_backward_qperp')
6641 call mt_write_vti_payload_float64(vti_unit, &
6642 products%length_backward_qperp,npoint,io_status)
6643 case ('Bseed_norm')
6644 call mt_write_vti_payload_float64(vti_unit,products%Bseed_norm, &
6645 npoint,io_status)
6646 case ('Bf_norm')
6647 call mt_write_vti_payload_float64(vti_unit,products%Bf_norm,npoint, &
6648 io_status)
6649 case ('Bb_norm')
6650 call mt_write_vti_payload_float64(vti_unit,products%Bb_norm,npoint, &
6651 io_status)
6652 case ('valid_qperp')
6653 call mt_write_vti_payload_int32(vti_unit,products%valid_qperp, &
6654 npoint,io_status)
6655 case ('valid_Qperp')
6656 call mt_write_vti_payload_int32(vti_unit,products%valid_qperp, &
6657 npoint,io_status)
6658 case ('status_qperp')
6659 call mt_write_vti_payload_int32(vti_unit,products%status_qperp, &
6660 npoint,io_status)
6661 case ('status_Qperp')
6662 call mt_write_vti_payload_int32(vti_unit,products%status_qperp, &
6663 npoint,io_status)
6664 case ('face_forward_qperp')
6665 call mt_write_vti_payload_int32(vti_unit, &
6666 products%face_forward_qperp,npoint,io_status)
6667 case ('face_backward_qperp')
6668 call mt_write_vti_payload_int32(vti_unit, &
6669 products%face_backward_qperp,npoint,io_status)
6670 case ('status_forward_qperp')
6671 call mt_write_vti_payload_int32(vti_unit, &
6672 products%status_forward_qperp,npoint,io_status)
6673 case ('status_backward_qperp')
6674 call mt_write_vti_payload_int32(vti_unit, &
6675 products%status_backward_qperp,npoint,io_status)
6676 case default
6677 io_status=1
6678 end select
6679 if (io_status/=0) exit
6680 enddo
6681 end subroutine mt_write_volume_vti_payload
6682
6683 subroutine mt_write_vti_payload_logq_visual(vti_unit,products,npoint, &
6684 io_status)
6685 integer, intent(in) :: vti_unit,npoint
6686 type(mt_volume_products), intent(in) :: products
6687 integer, intent(inout) :: io_status
6688
6689 double precision, allocatable :: visual_values(:)
6690 integer :: ipoint
6691
6692 allocate(visual_values(npoint))
6693 do ipoint=1,npoint
6694 visual_values(ipoint)=mt_visual_valid_float(products%logq(ipoint), &
6695 products%valid_q(ipoint)==1)
6696 enddo
6697 call mt_write_vti_payload_float64(vti_unit,visual_values,npoint, &
6698 io_status)
6699 deallocate(visual_values)
6700 end subroutine mt_write_vti_payload_logq_visual
6701
6702 subroutine mt_write_vti_payload_float64_visual(vti_unit,values,npoint, &
6703 io_status)
6704 integer, intent(in) :: vti_unit,npoint
6705 double precision, intent(in) :: values(npoint)
6706 integer, intent(inout) :: io_status
6707
6708 double precision, allocatable :: visual_values(:)
6709 integer :: ipoint
6710
6711 if (io_status/=0) return
6712 allocate(visual_values(npoint))
6713 do ipoint=1,npoint
6714 visual_values(ipoint)=mt_visual_float(values(ipoint))
6715 enddo
6716 call mt_write_vti_payload_float64(vti_unit,visual_values,npoint, &
6717 io_status)
6718 deallocate(visual_values)
6719 end subroutine mt_write_vti_payload_float64_visual
6720
6721 subroutine mt_write_vti_payload_logqperp_visual(vti_unit,products,npoint, &
6722 io_status)
6723 integer, intent(in) :: vti_unit,npoint
6724 type(mt_volume_products), intent(in) :: products
6725 integer, intent(inout) :: io_status
6726
6727 double precision, allocatable :: visual_values(:)
6728 integer :: ipoint
6729
6730 if (io_status/=0) return
6731 allocate(visual_values(npoint))
6732 do ipoint=1,npoint
6733 visual_values(ipoint)=mt_visual_valid_float(products%logqperp(ipoint), &
6734 products%valid_qperp(ipoint)==1)
6735 enddo
6736 call mt_write_vti_payload_float64(vti_unit,visual_values,npoint, &
6737 io_status)
6738 deallocate(visual_values)
6739 end subroutine mt_write_vti_payload_logqperp_visual
6740
6741 subroutine mt_check_vti_byte_count(npoint,caller)
6742 integer, intent(in) :: npoint
6743 character(len=*), intent(in) :: caller
6744
6745 if (int(npoint,kind=8)*8_8>int(huge(0),kind=8)) then
6746 call mpistop(trim(caller)//' exceeds 32-bit VTI byte count')
6747 endif
6748 end subroutine mt_check_vti_byte_count
6749
6750 subroutine mt_write_vti_payload_float64(vti_unit,values,npoint,io_status)
6751 integer, intent(in) :: vti_unit,npoint
6752 double precision, intent(in) :: values(npoint)
6753 integer, intent(inout) :: io_status
6754
6755 integer :: byte_count
6756
6757 if (io_status/=0) return
6758 byte_count=npoint*8
6759 write(vti_unit,iostat=io_status) byte_count
6760 if (io_status==0) write(vti_unit,iostat=io_status) values
6761 end subroutine mt_write_vti_payload_float64
6762
6763 subroutine mt_write_vti_payload_int32(vti_unit,values,npoint,io_status)
6764 integer, intent(in) :: vti_unit,npoint
6765 integer, intent(in) :: values(npoint)
6766 integer, intent(inout) :: io_status
6767
6768 integer :: byte_count
6769
6770 if (io_status/=0) return
6771 byte_count=npoint*4
6772 write(vti_unit,iostat=io_status) byte_count
6773 if (io_status==0) write(vti_unit,iostat=io_status) values
6774 end subroutine mt_write_vti_payload_int32
6775
6776 subroutine mt_write_vti_pointdata_fixed(vti_file,origin,spacing,nx,ny,nz, &
6777 length_total,qperp,status,caller)
6778 character(len=*), intent(in) :: vti_file,caller
6779 integer, intent(in) :: nx,ny,nz
6780 double precision, intent(in) :: origin(3),spacing(3)
6781 double precision, intent(in) :: length_total(nx*ny*nz),qperp(nx*ny*nz)
6782 integer, intent(in) :: status(nx*ny*nz)
6783
6784 integer :: vti_unit,io_status,npoint
6785 integer :: idesc,ndesc
6786 character(len=1) :: marker
6787 type(mt_vti_array_desc), allocatable :: descs(:)
6788
6789 npoint=nx*ny*nz
6790 call mt_check_vti_byte_count(npoint,caller)
6791 call mt_build_cartesian_vti_pointdata_descs(npoint,descs,ndesc)
6792
6793 open(newunit=vti_unit,file=trim(vti_file),status='replace', &
6794 action='write',form='formatted',iostat=io_status)
6795 if (io_status/=0) then
6796 call mpistop(trim(caller)//' could not open VTI file')
6797 endif
6798
6799 call mt_write_vti_image_header(vti_unit,origin,spacing,nx,ny,nz, &
6800 descs,ndesc,io_status)
6801 if (io_status/=0) then
6802 close(vti_unit)
6803 call mpistop(trim(caller)//' could not write VTI header')
6804 endif
6805 close(vti_unit)
6806
6807 open(newunit=vti_unit,file=trim(vti_file),access='stream', &
6808 form='unformatted',status='old',position='append', &
6809 action='write',iostat=io_status)
6810 if (io_status/=0) then
6811 call mpistop(trim(caller)//' could not append VTI payload')
6812 endif
6813
6814 marker='_'
6815 write(vti_unit,iostat=io_status) marker
6816 do idesc=1,ndesc
6817 if (io_status/=0) exit
6818 select case (trim(descs(idesc)%name))
6819 case ('length_total')
6820 call mt_write_vti_payload_float64(vti_unit,length_total,npoint, &
6821 io_status)
6822 case ('qperp')
6823 call mt_write_vti_payload_float64(vti_unit,qperp,npoint,io_status)
6824 case ('status')
6825 call mt_write_vti_payload_int32(vti_unit,status,npoint,io_status)
6826 case default
6827 io_status=1
6828 end select
6829 enddo
6830 close(vti_unit)
6831 if (io_status/=0) then
6832 call mpistop(trim(caller)//' could not write VTI payload')
6833 endif
6834
6835 open(newunit=vti_unit,file=trim(vti_file),status='old', &
6836 action='write',form='formatted',position='append',iostat=io_status)
6837 if (io_status/=0) then
6838 call mpistop(trim(caller)//' could not append VTI footer')
6839 endif
6840 write(vti_unit,'(a)',iostat=io_status) '</AppendedData>'
6841 if (io_status==0) write(vti_unit,'(a)',iostat=io_status) '</VTKFile>'
6842 close(vti_unit)
6843 if (io_status/=0) then
6844 call mpistop(trim(caller)//' could not write VTI footer')
6845 endif
6846 deallocate(descs)
6847 end subroutine mt_write_vti_pointdata_fixed
6848
6849 subroutine mt_write_vti_appended_array(vti_unit,vtk_type,name,offset, &
6850 io_status)
6851 integer, intent(in) :: vti_unit
6852 character(len=*), intent(in) :: vtk_type,name
6853 integer(kind=8), intent(in) :: offset
6854 integer, intent(out) :: io_status
6855
6856 write(vti_unit,'(a)',advance='no',iostat=io_status) &
6857 ' <DataArray type="'
6858 if (io_status==0) write(vti_unit,'(a)',advance='no', &
6859 iostat=io_status) trim(vtk_type)
6860 if (io_status==0) write(vti_unit,'(a)',advance='no', &
6861 iostat=io_status) '" Name="'
6862 if (io_status==0) write(vti_unit,'(a)',advance='no', &
6863 iostat=io_status) trim(name)
6864 if (io_status==0) write(vti_unit,'(a)',advance='no', &
6865 iostat=io_status) '" format="appended" offset="'
6866 if (io_status==0) write(vti_unit,'(i0)',advance='no', &
6867 iostat=io_status) offset
6868 if (io_status==0) write(vti_unit,'(a)',iostat=io_status) '"/>'
6869 end subroutine mt_write_vti_appended_array
6870
6871 subroutine mt_write_vtu_length_pointdata(vtu_unit,length_results,npoint, &
6872 io_status)
6873 integer, intent(in) :: vtu_unit,npoint
6874 type(trace_length_result), intent(in) :: length_results(npoint)
6875 integer, intent(inout) :: io_status
6876
6877 integer :: ipoint
6878
6879 call mt_write_vtu_float_array_start(vtu_unit,'length_total',io_status)
6880 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
6881 (length_results(ipoint)%total_length,ipoint=1,npoint)
6882 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6883 call mt_write_vtu_float_array_start(vtu_unit,'length_backward', &
6884 io_status)
6885 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
6886 (length_results(ipoint)%backward_length,ipoint=1,npoint)
6887 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6888 call mt_write_vtu_float_array_start(vtu_unit,'length_forward', &
6889 io_status)
6890 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
6891 (length_results(ipoint)%forward_length,ipoint=1,npoint)
6892 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6893
6894 call mt_write_vtu_int_array_start(vtu_unit,'nstep_backward_length', &
6895 io_status)
6896 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
6897 (length_results(ipoint)%backward_nstep,ipoint=1,npoint)
6898 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6899 call mt_write_vtu_int_array_start(vtu_unit,'nstep_forward_length', &
6900 io_status)
6901 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
6902 (length_results(ipoint)%forward_nstep,ipoint=1,npoint)
6903 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6904 call mt_write_vtu_int_array_start(vtu_unit,'status_backward_length', &
6905 io_status)
6906 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
6907 (length_results(ipoint)%backward_status,ipoint=1,npoint)
6908 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6909 call mt_write_vtu_int_array_start(vtu_unit,'status_forward_length', &
6910 io_status)
6911 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
6912 (length_results(ipoint)%forward_status,ipoint=1,npoint)
6913 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6914 end subroutine mt_write_vtu_length_pointdata
6915
6916 subroutine mt_write_vtu_mapping_pointdata(vtu_unit,mapping_results, &
6917 npoint,io_status)
6918 integer, intent(in) :: vtu_unit,npoint
6919 type(trace_mapping_result), intent(in) :: mapping_results(npoint)
6920 integer, intent(inout) :: io_status
6921
6922 integer :: ipoint
6923
6924 call mt_write_vtu_float_array_start(vtu_unit,'x_f_mapping',io_status)
6925 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
6926 (mt_vc(mapping_results(ipoint)%forward_footpoint,1),ipoint=1,npoint)
6927 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6928 call mt_write_vtu_float_array_start(vtu_unit,'y_f_mapping',io_status)
6929 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
6930 (mt_vc(mapping_results(ipoint)%forward_footpoint,2),ipoint=1,npoint)
6931 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6932 call mt_write_vtu_float_array_start(vtu_unit,'z_f_mapping',io_status)
6933 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
6934 (mt_vc(mapping_results(ipoint)%forward_footpoint,3),ipoint=1,npoint)
6935 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6936 call mt_write_vtu_float_array_start(vtu_unit,'x_b_mapping',io_status)
6937 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
6938 (mt_vc(mapping_results(ipoint)%backward_footpoint,1),ipoint=1,npoint)
6939 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6940 call mt_write_vtu_float_array_start(vtu_unit,'y_b_mapping',io_status)
6941 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
6942 (mt_vc(mapping_results(ipoint)%backward_footpoint,2),ipoint=1,npoint)
6943 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6944 call mt_write_vtu_float_array_start(vtu_unit,'z_b_mapping',io_status)
6945 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
6946 (mt_vc(mapping_results(ipoint)%backward_footpoint,3),ipoint=1,npoint)
6947 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6948
6949 call mt_write_vtu_float_array_start(vtu_unit,'source_Bn_mapping', &
6950 io_status)
6951 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
6952 (mapping_results(ipoint)%source_Bn,ipoint=1,npoint)
6953 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6954 call mt_write_vtu_float_array_start(vtu_unit,'forward_Bn_mapping', &
6955 io_status)
6956 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
6957 (mapping_results(ipoint)%forward_Bn,ipoint=1,npoint)
6958 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6959 call mt_write_vtu_float_array_start(vtu_unit,'backward_Bn_mapping', &
6960 io_status)
6961 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
6962 (mapping_results(ipoint)%backward_Bn,ipoint=1,npoint)
6963 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6964
6965 call mt_write_vtu_int_array_start(vtu_unit,'face_forward_mapping', &
6966 io_status)
6967 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
6968 (mapping_results(ipoint)%forward_face,ipoint=1,npoint)
6969 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6970 call mt_write_vtu_int_array_start(vtu_unit,'face_backward_mapping', &
6971 io_status)
6972 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
6973 (mapping_results(ipoint)%backward_face,ipoint=1,npoint)
6974 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6975 call mt_write_vtu_int_array_start(vtu_unit,'status_forward_mapping', &
6976 io_status)
6977 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
6978 (mapping_results(ipoint)%forward_status,ipoint=1,npoint)
6979 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6980 call mt_write_vtu_int_array_start(vtu_unit,'status_backward_mapping', &
6981 io_status)
6982 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
6983 (mapping_results(ipoint)%backward_status,ipoint=1,npoint)
6984 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6985 call mt_write_vtu_int_array_start(vtu_unit,'valid_mapping',io_status)
6986 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
6987 (merge(1,0,mapping_results(ipoint)%valid),ipoint=1,npoint)
6988 call mt_write_vtu_data_array_end(vtu_unit,io_status)
6989 end subroutine mt_write_vtu_mapping_pointdata
6990
6991 subroutine mt_write_vtu_qperp_public_pointdata(vtu_unit,qperp_results, &
6992 npoint,io_status)
6993 integer, intent(in) :: vtu_unit,npoint
6994 type(trace_qperp_result), intent(in) :: qperp_results(npoint)
6995 integer, intent(inout) :: io_status
6996
6997 integer :: ipoint
6998
6999 call mt_write_vtu_float_array_start(vtu_unit,'logQperp',io_status)
7000 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7001 (mt_visual_valid_float(qperp_results(ipoint)%logqperp, &
7002 qperp_results(ipoint)%valid),ipoint=1,npoint)
7003 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7004 call mt_write_vtu_int_array_start(vtu_unit,'valid_Qperp',io_status)
7005 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7006 (merge(1,0,qperp_results(ipoint)%valid),ipoint=1,npoint)
7007 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7008 call mt_write_vtu_int_array_start(vtu_unit,'status_Qperp',io_status)
7009 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7010 (qperp_results(ipoint)%status,ipoint=1,npoint)
7011 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7012 end subroutine mt_write_vtu_qperp_public_pointdata
7013
7014 subroutine mt_write_vtu_qperp_method2_pointdata(vtu_unit,qperp_results, &
7015 npoint,io_status)
7016 integer, intent(in) :: vtu_unit,npoint
7017 type(trace_qperp_result), intent(in) :: qperp_results(npoint)
7018 integer, intent(inout) :: io_status
7019
7020 integer :: ipoint
7021
7022 call mt_write_vtu_float_array_start(vtu_unit,'qperp_method2',io_status)
7023 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7024 (qperp_results(ipoint)%qperp,ipoint=1,npoint)
7025 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7026 call mt_write_vtu_float_array_start(vtu_unit,'logqperp_method2', &
7027 io_status)
7028 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7029 (qperp_results(ipoint)%logqperp,ipoint=1,npoint)
7030 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7031 call mt_write_vtu_float_array_start(vtu_unit,'N2_qperp',io_status)
7032 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7033 (qperp_results(ipoint)%N2,ipoint=1,npoint)
7034 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7035 call mt_write_vtu_float_array_start(vtu_unit,'bfactor_qperp',io_status)
7036 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7037 (qperp_results(ipoint)%bfactor,ipoint=1,npoint)
7038 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7039 call mt_write_vtu_float_array_start(vtu_unit,'length_forward_qperp', &
7040 io_status)
7041 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7042 (qperp_results(ipoint)%forward_length,ipoint=1,npoint)
7043 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7044 call mt_write_vtu_float_array_start(vtu_unit,'length_backward_qperp', &
7045 io_status)
7046 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7047 (qperp_results(ipoint)%backward_length,ipoint=1,npoint)
7048 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7049
7050 call mt_write_vtu_float_array_start(vtu_unit,'Bseed_norm_qperp', &
7051 io_status)
7052 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7053 (dsqrt(sum(qperp_results(ipoint)%B_seed**2)),ipoint=1,npoint)
7054 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7055 call mt_write_vtu_float_array_start(vtu_unit,'Bf_norm_qperp',io_status)
7056 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7057 (dsqrt(sum(qperp_results(ipoint)%forward_B**2)),ipoint=1,npoint)
7058 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7059 call mt_write_vtu_float_array_start(vtu_unit,'Bb_norm_qperp',io_status)
7060 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7061 (dsqrt(sum(qperp_results(ipoint)%backward_B**2)),ipoint=1,npoint)
7062 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7063
7064 call mt_write_vtu_float_array_start(vtu_unit,'x_f_qperp',io_status)
7065 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7066 (mt_vc(qperp_results(ipoint)%forward_endpoint,1),ipoint=1,npoint)
7067 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7068 call mt_write_vtu_float_array_start(vtu_unit,'y_f_qperp',io_status)
7069 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7070 (mt_vc(qperp_results(ipoint)%forward_endpoint,2),ipoint=1,npoint)
7071 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7072 call mt_write_vtu_float_array_start(vtu_unit,'z_f_qperp',io_status)
7073 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7074 (mt_vc(qperp_results(ipoint)%forward_endpoint,3),ipoint=1,npoint)
7075 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7076 call mt_write_vtu_float_array_start(vtu_unit,'x_b_qperp',io_status)
7077 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7078 (mt_vc(qperp_results(ipoint)%backward_endpoint,1),ipoint=1,npoint)
7079 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7080 call mt_write_vtu_float_array_start(vtu_unit,'y_b_qperp',io_status)
7081 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7082 (mt_vc(qperp_results(ipoint)%backward_endpoint,2),ipoint=1,npoint)
7083 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7084 call mt_write_vtu_float_array_start(vtu_unit,'z_b_qperp',io_status)
7085 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7086 (mt_vc(qperp_results(ipoint)%backward_endpoint,3),ipoint=1,npoint)
7087 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7088
7089 call mt_write_vtu_int_array_start(vtu_unit,'valid_qperp_method2', &
7090 io_status)
7091 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7092 (merge(1,0,qperp_results(ipoint)%valid),ipoint=1,npoint)
7093 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7094 call mt_write_vtu_int_array_start(vtu_unit,'status_qperp_method2', &
7095 io_status)
7096 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7097 (qperp_results(ipoint)%status,ipoint=1,npoint)
7098 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7099 call mt_write_vtu_int_array_start(vtu_unit,'face_forward_qperp', &
7100 io_status)
7101 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7102 (qperp_results(ipoint)%forward_face,ipoint=1,npoint)
7103 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7104 call mt_write_vtu_int_array_start(vtu_unit,'face_backward_qperp', &
7105 io_status)
7106 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7107 (qperp_results(ipoint)%backward_face,ipoint=1,npoint)
7108 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7109 call mt_write_vtu_int_array_start(vtu_unit,'status_forward_qperp', &
7110 io_status)
7111 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7112 (qperp_results(ipoint)%forward_status,ipoint=1,npoint)
7113 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7114 call mt_write_vtu_int_array_start(vtu_unit,'status_backward_qperp', &
7115 io_status)
7116 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7117 (qperp_results(ipoint)%backward_status,ipoint=1,npoint)
7118 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7119 end subroutine mt_write_vtu_qperp_method2_pointdata
7120
7121 subroutine mt_write_vtu_q_product_pointdata(vtu_unit,qperp_results, &
7122 npoint,write_raw_q,io_status)
7123 integer, intent(in) :: vtu_unit,npoint
7124 type(trace_qperp_result), intent(in) :: qperp_results(npoint)
7125 logical, intent(in) :: write_raw_q
7126 integer, intent(inout) :: io_status
7127
7128 integer :: ipoint
7129
7130 if (write_raw_q) then
7131 call mt_write_vtu_float_array_start(vtu_unit,'q',io_status)
7132 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7133 (qperp_results(ipoint)%q0,ipoint=1,npoint)
7134 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7135 endif
7136
7137 call mt_write_vtu_float_array_start(vtu_unit,'logQ',io_status)
7138 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7139 (mt_visual_valid_float(qperp_results(ipoint)%logq0, &
7140 qperp_results(ipoint)%valid_q0),ipoint=1,npoint)
7141 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7142 call mt_write_vtu_int_array_start(vtu_unit,'valid_Q',io_status)
7143 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7144 (merge(1,0,qperp_results(ipoint)%valid_q0),ipoint=1,npoint)
7145 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7146 call mt_write_vtu_int_array_start(vtu_unit,'status_Q',io_status)
7147 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7148 (qperp_results(ipoint)%status_q0,ipoint=1,npoint)
7149 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7150 call mt_write_vtu_int_array_start(vtu_unit,'face_pair_Q',io_status)
7151 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7152 (mt_q_result_face_pair(qperp_results(ipoint)),ipoint=1,npoint)
7153 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7154 call mt_write_vtu_int_array_start(vtu_unit,'connection_type_Q', &
7155 io_status)
7156 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7157 (mt_q_result_connection_type(qperp_results(ipoint)),ipoint=1,npoint)
7158 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7159 end subroutine mt_write_vtu_q_product_pointdata
7160
7161 subroutine mt_write_vtu_spherical_topology_pointdata(vtu_unit,topology, &
7162 npoint,do_twist,do_q,q_results,do_qperp,qperp_results,io_status)
7163 integer, intent(in) :: vtu_unit,npoint
7164 type(trace_topology_result), intent(in) :: topology(npoint)
7165 logical, intent(in) :: do_twist,do_q,do_qperp
7166 type(trace_qperp_result), intent(in) :: q_results(:)
7167 type(trace_qperp_result), intent(in) :: qperp_results(:)
7168 integer, intent(inout) :: io_status
7169
7170 integer :: ipoint
7171
7172 write(vtu_unit,'(a)',iostat=io_status) '<PointData>'
7173 if (io_status/=0) return
7174
7175 if (.not.mt_vtk_detail_is_full()) then
7176 call mt_write_vtu_spherical_minimal_pointdata(vtu_unit,topology, &
7177 npoint,do_twist,do_q,q_results,do_qperp,qperp_results, &
7178 io_status)
7179 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7180 '</PointData>'
7181 return
7182 endif
7183
7184 call mt_write_vtu_float_array_start(vtu_unit,'length_total',io_status)
7185 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7186 (mt_visual_float(topology(ipoint)%length_total),ipoint=1,npoint)
7187 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7188 call mt_write_vtu_float_array_start(vtu_unit,'length_backward', &
7189 io_status)
7190 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7191 (topology(ipoint)%length_backward,ipoint=1,npoint)
7192 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7193 call mt_write_vtu_float_array_start(vtu_unit,'length_forward', &
7194 io_status)
7195 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7196 (topology(ipoint)%length_forward,ipoint=1,npoint)
7197 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7198
7199 if (do_twist) then
7200 call mt_write_vtu_float_array_start(vtu_unit,'twist_total',io_status)
7201 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7202 (mt_visual_valid_float(topology(ipoint)%twist_total, &
7203 topology(ipoint)%valid_twist),ipoint=1,npoint)
7204 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7205 call mt_write_vtu_float_array_start(vtu_unit,'twist_backward', &
7206 io_status)
7207 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7208 (mt_visual_valid_float(topology(ipoint)%twist_backward, &
7209 topology(ipoint)%valid_twist),ipoint=1,npoint)
7210 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7211 call mt_write_vtu_float_array_start(vtu_unit,'twist_forward', &
7212 io_status)
7213 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7214 (mt_visual_valid_float(topology(ipoint)%twist_forward, &
7215 topology(ipoint)%valid_twist),ipoint=1,npoint)
7216 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7217 call mt_write_vtu_int_array_start(vtu_unit,'valid_twist',io_status)
7218 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7219 (merge(1,0,topology(ipoint)%valid_twist),ipoint=1,npoint)
7220 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7221 call mt_write_vtu_int_array_start(vtu_unit,'status_twist',io_status)
7222 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7223 (topology(ipoint)%status_twist,ipoint=1,npoint)
7224 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7225 endif
7226
7227 if (do_q) then
7228 call mt_write_vtu_float_array_start(vtu_unit,'logQ',io_status)
7229 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7230 (mt_visual_valid_float(q_results(ipoint)%logq0, &
7231 q_results(ipoint)%valid_q0),ipoint=1,npoint)
7232 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7233 call mt_write_vtu_int_array_start(vtu_unit,'valid_Q',io_status)
7234 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7235 (merge(1,0,q_results(ipoint)%valid_q0),ipoint=1,npoint)
7236 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7237 call mt_write_vtu_int_array_start(vtu_unit,'status_Q',io_status)
7238 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7239 (q_results(ipoint)%status_q0,ipoint=1,npoint)
7240 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7241 endif
7242
7243 if (do_qperp) then
7244 call mt_write_vtu_float_array_start(vtu_unit,'logQperp',io_status)
7245 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7246 (mt_visual_valid_float(qperp_results(ipoint)%logqperp, &
7247 qperp_results(ipoint)%valid),ipoint=1,npoint)
7248 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7249 call mt_write_vtu_int_array_start(vtu_unit,'valid_Qperp',io_status)
7250 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7251 (merge(1,0,qperp_results(ipoint)%valid),ipoint=1,npoint)
7252 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7253 call mt_write_vtu_int_array_start(vtu_unit,'status_Qperp',io_status)
7254 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7255 (qperp_results(ipoint)%status,ipoint=1,npoint)
7256 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7257 endif
7258
7259 call mt_write_vtu_float_array_start(vtu_unit,'r_b',io_status)
7260 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7261 (topology(ipoint)%backward_endpoint(1),ipoint=1,npoint)
7262 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7263 call mt_write_vtu_float_array_start(vtu_unit,'theta_b',io_status)
7264 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7265 (mt_vc(topology(ipoint)%backward_endpoint,2), &
7266 ipoint=1,npoint)
7267 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7268 call mt_write_vtu_float_array_start(vtu_unit,'phi_b',io_status)
7269 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7270 (mt_vc(topology(ipoint)%backward_endpoint,3), &
7271 ipoint=1,npoint)
7272 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7273 call mt_write_vtu_float_array_start(vtu_unit,'r_f',io_status)
7274 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7275 (topology(ipoint)%forward_endpoint(1),ipoint=1,npoint)
7276 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7277 call mt_write_vtu_float_array_start(vtu_unit,'theta_f',io_status)
7278 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7279 (mt_vc(topology(ipoint)%forward_endpoint,2), &
7280 ipoint=1,npoint)
7281 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7282 call mt_write_vtu_float_array_start(vtu_unit,'phi_f',io_status)
7283 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7284 (mt_vc(topology(ipoint)%forward_endpoint,3), &
7285 ipoint=1,npoint)
7286 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7287
7288 call mt_write_vtu_int_array_start(vtu_unit,'face_backward',io_status)
7289 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7290 (topology(ipoint)%backward_face,ipoint=1,npoint)
7291 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7292 call mt_write_vtu_int_array_start(vtu_unit,'face_forward',io_status)
7293 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7294 (topology(ipoint)%forward_face,ipoint=1,npoint)
7295 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7296 call mt_write_vtu_int_array_start(vtu_unit,'connection_type_spherical', &
7297 io_status)
7298 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7299 (mt_spherical_connection_type(topology(ipoint)%backward_face, &
7300 topology(ipoint)%forward_face,topology(ipoint)%valid), &
7301 ipoint=1,npoint)
7302 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7303 call mt_write_vtu_int_array_start(vtu_unit,'nstep_backward',io_status)
7304 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7305 (topology(ipoint)%backward_nstep,ipoint=1,npoint)
7306 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7307 call mt_write_vtu_int_array_start(vtu_unit,'nstep_forward',io_status)
7308 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7309 (topology(ipoint)%forward_nstep,ipoint=1,npoint)
7310 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7311 call mt_write_vtu_int_array_start(vtu_unit,'status_backward',io_status)
7312 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7313 (topology(ipoint)%backward_status,ipoint=1,npoint)
7314 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7315 call mt_write_vtu_int_array_start(vtu_unit,'status_forward',io_status)
7316 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7317 (topology(ipoint)%forward_status,ipoint=1,npoint)
7318 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7319 call mt_write_vtu_int_array_start(vtu_unit,'valid',io_status)
7320 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7321 (merge(1,0,topology(ipoint)%valid),ipoint=1,npoint)
7322 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7323
7324 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) '</PointData>'
7325 end subroutine mt_write_vtu_spherical_topology_pointdata
7326
7327 subroutine mt_write_vtu_spherical_minimal_pointdata(vtu_unit,topology, &
7328 npoint,do_twist,do_q,q_results,do_qperp,qperp_results,io_status)
7329 integer, intent(in) :: vtu_unit,npoint
7330 type(trace_topology_result), intent(in) :: topology(npoint)
7331 logical, intent(in) :: do_twist,do_q,do_qperp
7332 type(trace_qperp_result), intent(in) :: q_results(:)
7333 type(trace_qperp_result), intent(in) :: qperp_results(:)
7334 integer, intent(inout) :: io_status
7335
7336 integer :: ipoint
7337
7338 call mt_write_vtu_float_array_start(vtu_unit,'length_total',io_status)
7339 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7340 (mt_visual_float(topology(ipoint)%length_total),ipoint=1,npoint)
7341 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7342
7343 if (do_twist) then
7344 call mt_write_vtu_float_array_start(vtu_unit,'twist_total',io_status)
7345 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7346 (mt_visual_valid_float(topology(ipoint)%twist_total, &
7347 topology(ipoint)%valid_twist),ipoint=1,npoint)
7348 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7349 endif
7350
7351 if (do_q) then
7352 call mt_write_vtu_float_array_start(vtu_unit,'logQ',io_status)
7353 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7354 (mt_visual_valid_float(q_results(ipoint)%logq0, &
7355 q_results(ipoint)%valid_q0),ipoint=1,npoint)
7356 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7357 endif
7358
7359 if (do_qperp) then
7360 call mt_write_vtu_float_array_start(vtu_unit,'logQperp',io_status)
7361 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7362 (mt_visual_valid_float(qperp_results(ipoint)%logqperp, &
7363 qperp_results(ipoint)%valid),ipoint=1,npoint)
7364 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7365 endif
7366 end subroutine mt_write_vtu_spherical_minimal_pointdata
7367
7368 subroutine mt_write_vtu_file_header(vtu_unit,npoint,ncell)
7369 integer, intent(in) :: vtu_unit,npoint,ncell
7370
7371 write(vtu_unit,'(a)') '<?xml version="1.0"?>'
7372 write(vtu_unit,'(a)') &
7373 '<VTKFile type="UnstructuredGrid" version="0.1" byte_order="LittleEndian">'
7374 write(vtu_unit,'(a)') '<UnstructuredGrid>'
7375 write(vtu_unit,'(a,i0,a,i0,a)') '<Piece NumberOfPoints="',npoint, &
7376 '" NumberOfCells="',ncell,'">'
7377 end subroutine mt_write_vtu_file_header
7378
7379 subroutine mt_write_vtu_file_footer(vtu_unit,io_status)
7380 integer, intent(in) :: vtu_unit
7381 integer, intent(inout) :: io_status
7382
7383 write(vtu_unit,'(a)',iostat=io_status) '</Piece>'
7384 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7385 '</UnstructuredGrid>'
7386 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) '</VTKFile>'
7387 end subroutine mt_write_vtu_file_footer
7388
7389 subroutine mt_write_vtu_product_pointdata(vtu_unit,length_results, &
7390 twist_results,q_results,qperp_results,npoint,do_twist,do_q, &
7391 do_qperp,io_status,do_length)
7392 integer, intent(in) :: vtu_unit,npoint
7393 type(trace_length_result), intent(in) :: length_results(npoint)
7394 type(trace_twist_result), intent(in) :: twist_results(:)
7395 type(trace_qperp_result), intent(in) :: q_results(:)
7396 type(trace_qperp_result), intent(in) :: qperp_results(:)
7397 logical, intent(in) :: do_twist,do_q,do_qperp
7398 integer, intent(inout) :: io_status
7399 logical, intent(in), optional :: do_length
7400
7401 integer :: ipoint
7402 logical :: do_length_eff
7403
7404 write(vtu_unit,'(a)',iostat=io_status) '<PointData>'
7405 if (io_status/=0) return
7406 do_length_eff=.true.
7407 if (present(do_length)) do_length_eff=do_length
7408
7409 if (.not.mt_vtk_detail_is_full()) then
7410 call mt_write_vtu_product_minimal_pointdata(vtu_unit,length_results, &
7411 twist_results,q_results,qperp_results,npoint,do_twist,do_q, &
7412 do_qperp,io_status,do_length=do_length_eff)
7413 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7414 '</PointData>'
7415 return
7416 endif
7417
7418 if (do_length_eff) then
7419 call mt_write_vtu_float_array_start(vtu_unit,'length_total',io_status)
7420 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7421 (length_results(ipoint)%total_length,ipoint=1,npoint)
7422 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7423 call mt_write_vtu_float_array_start(vtu_unit,'length_backward', &
7424 io_status)
7425 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7426 (length_results(ipoint)%backward_length,ipoint=1,npoint)
7427 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7428 call mt_write_vtu_float_array_start(vtu_unit,'length_forward', &
7429 io_status)
7430 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7431 (length_results(ipoint)%forward_length,ipoint=1,npoint)
7432 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7433
7434 call mt_write_vtu_int_array_start(vtu_unit,'nstep_backward_length', &
7435 io_status)
7436 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7437 (length_results(ipoint)%backward_nstep,ipoint=1,npoint)
7438 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7439 call mt_write_vtu_int_array_start(vtu_unit,'nstep_forward_length', &
7440 io_status)
7441 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7442 (length_results(ipoint)%forward_nstep,ipoint=1,npoint)
7443 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7444 call mt_write_vtu_int_array_start(vtu_unit,'status_backward_length', &
7445 io_status)
7446 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7447 (length_results(ipoint)%backward_status,ipoint=1,npoint)
7448 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7449 call mt_write_vtu_int_array_start(vtu_unit,'status_forward_length', &
7450 io_status)
7451 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7452 (length_results(ipoint)%forward_status,ipoint=1,npoint)
7453 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7454 endif
7455
7456 if (do_twist) then
7457 call mt_write_vtu_twist_pointdata(vtu_unit,twist_results,npoint, &
7458 io_status)
7459 endif
7460 if (do_q) then
7461 call mt_write_vtu_q_product_pointdata(vtu_unit,q_results,npoint, &
7462 .false.,io_status)
7463 endif
7464 if (do_qperp) then
7465 call mt_write_vtu_qperp_pointdata(vtu_unit,qperp_results,npoint, &
7466 io_status)
7467 endif
7468
7469 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) '</PointData>'
7470 end subroutine mt_write_vtu_product_pointdata
7471
7472 subroutine mt_write_vtu_product_minimal_pointdata(vtu_unit, &
7473 length_results,twist_results,q_results,qperp_results,npoint, &
7474 do_twist,do_q,do_qperp,io_status,do_length)
7475 integer, intent(in) :: vtu_unit,npoint
7476 type(trace_length_result), intent(in) :: length_results(npoint)
7477 type(trace_twist_result), intent(in) :: twist_results(:)
7478 type(trace_qperp_result), intent(in) :: q_results(:)
7479 type(trace_qperp_result), intent(in) :: qperp_results(:)
7480 logical, intent(in) :: do_twist,do_q,do_qperp
7481 integer, intent(inout) :: io_status
7482 logical, intent(in), optional :: do_length
7483
7484 integer :: ipoint
7485 logical :: do_length_eff
7486
7487 do_length_eff=.true.
7488 if (present(do_length)) do_length_eff=do_length
7489
7490 if (do_length_eff) then
7491 call mt_write_vtu_float_array_start(vtu_unit,'length_total',io_status)
7492 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7493 (mt_visual_float(length_results(ipoint)%total_length), &
7494 ipoint=1,npoint)
7495 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7496 endif
7497
7498 if (do_twist) then
7499 call mt_write_vtu_float_array_start(vtu_unit,'twist_total',io_status)
7500 if (io_status==0) write(vtu_unit,'(4(1pe24.16))', &
7501 iostat=io_status) &
7502 (mt_visual_float(twist_results(ipoint)%total_twist), &
7503 ipoint=1,npoint)
7504 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7505 endif
7506
7507 if (do_q) then
7508 call mt_write_vtu_float_array_start(vtu_unit,'logQ',io_status)
7509 if (io_status==0) write(vtu_unit,'(4(1pe24.16))', &
7510 iostat=io_status) &
7511 (mt_visual_valid_float(q_results(ipoint)%logq0, &
7512 q_results(ipoint)%valid_q0),ipoint=1,npoint)
7513 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7514 endif
7515
7516 if (do_qperp) then
7517 call mt_write_vtu_float_array_start(vtu_unit,'logQperp',io_status)
7518 if (io_status==0) write(vtu_unit,'(4(1pe24.16))', &
7519 iostat=io_status) &
7520 (mt_visual_valid_float(qperp_results(ipoint)%logqperp, &
7521 qperp_results(ipoint)%valid),ipoint=1,npoint)
7522 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7523 endif
7524 end subroutine mt_write_vtu_product_minimal_pointdata
7525
7526 subroutine mt_write_vtu_twist_pointdata(vtu_unit,twist_results,npoint, &
7527 io_status)
7528 integer, intent(in) :: vtu_unit,npoint
7529 type(trace_twist_result), intent(in) :: twist_results(npoint)
7530 integer, intent(inout) :: io_status
7531
7532 integer :: ipoint
7533
7534 call mt_write_vtu_float_array_start(vtu_unit,'twist_total',io_status)
7535 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7536 (twist_results(ipoint)%total_twist,ipoint=1,npoint)
7537 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7538 call mt_write_vtu_float_array_start(vtu_unit,'twist_backward', &
7539 io_status)
7540 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7541 (twist_results(ipoint)%backward_twist,ipoint=1,npoint)
7542 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7543 call mt_write_vtu_float_array_start(vtu_unit,'twist_forward', &
7544 io_status)
7545 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7546 (twist_results(ipoint)%forward_twist,ipoint=1,npoint)
7547 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7548
7549 call mt_write_vtu_int_array_start(vtu_unit,'nstep_backward_twist', &
7550 io_status)
7551 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7552 (twist_results(ipoint)%line%backward_nstep,ipoint=1,npoint)
7553 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7554 call mt_write_vtu_int_array_start(vtu_unit,'nstep_forward_twist', &
7555 io_status)
7556 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7557 (twist_results(ipoint)%line%forward_nstep,ipoint=1,npoint)
7558 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7559 call mt_write_vtu_int_array_start(vtu_unit,'status_backward_twist', &
7560 io_status)
7561 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7562 (twist_results(ipoint)%line%backward_status,ipoint=1,npoint)
7563 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7564 call mt_write_vtu_int_array_start(vtu_unit,'status_forward_twist', &
7565 io_status)
7566 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7567 (twist_results(ipoint)%line%forward_status,ipoint=1,npoint)
7568 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7569 end subroutine mt_write_vtu_twist_pointdata
7570
7571 subroutine mt_write_vtu_qperp_pointdata(vtu_unit,qperp_results,npoint, &
7572 io_status)
7573 integer, intent(in) :: vtu_unit,npoint
7574 type(trace_qperp_result), intent(in) :: qperp_results(npoint)
7575 integer, intent(inout) :: io_status
7576
7577 integer :: ipoint
7578
7579 call mt_write_vtu_float_array_start(vtu_unit,'qperp',io_status)
7580 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7581 (qperp_results(ipoint)%qperp,ipoint=1,npoint)
7582 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7583 call mt_write_vtu_float_array_start(vtu_unit,'logqperp',io_status)
7584 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7585 (qperp_results(ipoint)%logqperp,ipoint=1,npoint)
7586 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7587 call mt_write_vtu_float_array_start(vtu_unit,'N2',io_status)
7588 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7589 (qperp_results(ipoint)%N2,ipoint=1,npoint)
7590 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7591 call mt_write_vtu_float_array_start(vtu_unit,'bfactor',io_status)
7592 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7593 (qperp_results(ipoint)%bfactor,ipoint=1,npoint)
7594 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7595 call mt_write_vtu_float_array_start(vtu_unit,'length_forward_qperp', &
7596 io_status)
7597 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7598 (qperp_results(ipoint)%forward_length,ipoint=1,npoint)
7599 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7600 call mt_write_vtu_float_array_start(vtu_unit,'length_backward_qperp', &
7601 io_status)
7602 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7603 (qperp_results(ipoint)%backward_length,ipoint=1,npoint)
7604 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7605
7606 call mt_write_vtu_float_array_start(vtu_unit,'Bseed_norm',io_status)
7607 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7608 (dsqrt(sum(qperp_results(ipoint)%B_seed**2)),ipoint=1,npoint)
7609 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7610 call mt_write_vtu_float_array_start(vtu_unit,'Bf_norm',io_status)
7611 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7612 (dsqrt(sum(qperp_results(ipoint)%forward_B**2)),ipoint=1,npoint)
7613 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7614 call mt_write_vtu_float_array_start(vtu_unit,'Bb_norm',io_status)
7615 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7616 (dsqrt(sum(qperp_results(ipoint)%backward_B**2)),ipoint=1,npoint)
7617 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7618
7619 call mt_write_vtu_qperp_endpoint_pointdata(vtu_unit,qperp_results, &
7620 npoint,io_status)
7621 call mt_write_vtu_qperp_int_pointdata(vtu_unit,qperp_results,npoint, &
7622 io_status)
7623 end subroutine mt_write_vtu_qperp_pointdata
7624
7625 subroutine mt_write_vtu_qperp_endpoint_pointdata(vtu_unit,qperp_results, &
7626 npoint,io_status)
7627 integer, intent(in) :: vtu_unit,npoint
7628 type(trace_qperp_result), intent(in) :: qperp_results(npoint)
7629 integer, intent(inout) :: io_status
7630
7631 integer :: ipoint
7632
7633 call mt_write_vtu_float_array_start(vtu_unit,'x_f_qperp',io_status)
7634 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7635 (mt_vc(qperp_results(ipoint)%forward_endpoint,1),ipoint=1,npoint)
7636 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7637 call mt_write_vtu_float_array_start(vtu_unit,'y_f_qperp',io_status)
7638 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7639 (mt_vc(qperp_results(ipoint)%forward_endpoint,2),ipoint=1,npoint)
7640 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7641 call mt_write_vtu_float_array_start(vtu_unit,'z_f_qperp',io_status)
7642 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7643 (mt_vc(qperp_results(ipoint)%forward_endpoint,3),ipoint=1,npoint)
7644 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7645 call mt_write_vtu_float_array_start(vtu_unit,'x_b_qperp',io_status)
7646 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7647 (mt_vc(qperp_results(ipoint)%backward_endpoint,1),ipoint=1,npoint)
7648 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7649 call mt_write_vtu_float_array_start(vtu_unit,'y_b_qperp',io_status)
7650 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7651 (mt_vc(qperp_results(ipoint)%backward_endpoint,2),ipoint=1,npoint)
7652 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7653 call mt_write_vtu_float_array_start(vtu_unit,'z_b_qperp',io_status)
7654 if (io_status==0) write(vtu_unit,'(4(1pe24.16))',iostat=io_status) &
7655 (mt_vc(qperp_results(ipoint)%backward_endpoint,3),ipoint=1,npoint)
7656 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7657 end subroutine mt_write_vtu_qperp_endpoint_pointdata
7658
7659 subroutine mt_write_vtu_qperp_int_pointdata(vtu_unit,qperp_results, &
7660 npoint,io_status)
7661 integer, intent(in) :: vtu_unit,npoint
7662 type(trace_qperp_result), intent(in) :: qperp_results(npoint)
7663 integer, intent(inout) :: io_status
7664
7665 integer :: ipoint
7666
7667 call mt_write_vtu_int_array_start(vtu_unit,'valid_qperp',io_status)
7668 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7669 (merge(1,0,qperp_results(ipoint)%valid),ipoint=1,npoint)
7670 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7671 call mt_write_vtu_int_array_start(vtu_unit,'status_qperp',io_status)
7672 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7673 (qperp_results(ipoint)%status,ipoint=1,npoint)
7674 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7675 call mt_write_vtu_int_array_start(vtu_unit,'face_forward_qperp', &
7676 io_status)
7677 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7678 (qperp_results(ipoint)%forward_face,ipoint=1,npoint)
7679 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7680 call mt_write_vtu_int_array_start(vtu_unit,'face_backward_qperp', &
7681 io_status)
7682 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7683 (qperp_results(ipoint)%backward_face,ipoint=1,npoint)
7684 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7685 call mt_write_vtu_int_array_start(vtu_unit,'status_forward_qperp', &
7686 io_status)
7687 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7688 (qperp_results(ipoint)%forward_status,ipoint=1,npoint)
7689 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7690 call mt_write_vtu_int_array_start(vtu_unit,'status_backward_qperp', &
7691 io_status)
7692 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7693 (qperp_results(ipoint)%backward_status,ipoint=1,npoint)
7694 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7695 end subroutine mt_write_vtu_qperp_int_pointdata
7696
7697 subroutine mt_write_vtu_empty_pointdata(vtu_unit,do_length,do_twist, &
7698 do_q,do_qperp)
7699 integer, intent(in) :: vtu_unit
7700 logical, intent(in) :: do_length,do_twist,do_q,do_qperp
7701
7702 write(vtu_unit,'(a)') '<PointData>'
7703 if (.not.mt_vtk_detail_is_full()) then
7704 if (do_length) then
7705 call mt_write_vtu_empty_float_array(vtu_unit,'length_total')
7706 endif
7707 if (do_twist) then
7708 call mt_write_vtu_empty_float_array(vtu_unit,'twist_total')
7709 endif
7710 if (do_q) then
7711 call mt_write_vtu_empty_float_array(vtu_unit,'logQ')
7712 endif
7713 if (do_qperp) then
7714 call mt_write_vtu_empty_float_array(vtu_unit,'logQperp')
7715 endif
7716 write(vtu_unit,'(a)') '</PointData>'
7717 return
7718 endif
7719 if (do_length) then
7720 call mt_write_vtu_empty_float_array(vtu_unit,'length_total')
7721 call mt_write_vtu_empty_float_array(vtu_unit,'length_backward')
7722 call mt_write_vtu_empty_float_array(vtu_unit,'length_forward')
7723 call mt_write_vtu_empty_int_array(vtu_unit,'nstep_backward_length')
7724 call mt_write_vtu_empty_int_array(vtu_unit,'nstep_forward_length')
7725 call mt_write_vtu_empty_int_array(vtu_unit,'status_backward_length')
7726 call mt_write_vtu_empty_int_array(vtu_unit,'status_forward_length')
7727 endif
7728 if (do_twist) then
7729 call mt_write_vtu_empty_float_array(vtu_unit,'twist_total')
7730 call mt_write_vtu_empty_float_array(vtu_unit,'twist_backward')
7731 call mt_write_vtu_empty_float_array(vtu_unit,'twist_forward')
7732 call mt_write_vtu_empty_int_array(vtu_unit,'nstep_backward_twist')
7733 call mt_write_vtu_empty_int_array(vtu_unit,'nstep_forward_twist')
7734 call mt_write_vtu_empty_int_array(vtu_unit,'status_backward_twist')
7735 call mt_write_vtu_empty_int_array(vtu_unit,'status_forward_twist')
7736 endif
7737 if (do_q) then
7738 call mt_write_vtu_empty_float_array(vtu_unit,'q')
7739 call mt_write_vtu_empty_float_array(vtu_unit,'logQ')
7740 call mt_write_vtu_empty_float_array(vtu_unit,'N2_q')
7741 call mt_write_vtu_empty_float_array(vtu_unit,'bfactor_q')
7742 call mt_write_vtu_empty_float_array(vtu_unit,'length_forward_q')
7743 call mt_write_vtu_empty_float_array(vtu_unit,'length_backward_q')
7744 call mt_write_vtu_empty_float_array(vtu_unit,'Bseed_norm_q')
7745 call mt_write_vtu_empty_float_array(vtu_unit,'Bf_norm_q')
7746 call mt_write_vtu_empty_float_array(vtu_unit,'Bb_norm_q')
7747 call mt_write_vtu_empty_int_array(vtu_unit,'valid_Q')
7748 call mt_write_vtu_empty_int_array(vtu_unit,'status_Q')
7749 call mt_write_vtu_empty_int_array(vtu_unit,'face_forward_Q')
7750 call mt_write_vtu_empty_int_array(vtu_unit,'face_backward_Q')
7751 call mt_write_vtu_empty_int_array(vtu_unit,'status_forward_Q')
7752 call mt_write_vtu_empty_int_array(vtu_unit,'status_backward_Q')
7753 endif
7754 if (do_qperp) then
7755 call mt_write_vtu_empty_float_array(vtu_unit,'qperp')
7756 call mt_write_vtu_empty_float_array(vtu_unit,'logqperp')
7757 call mt_write_vtu_empty_float_array(vtu_unit,'N2')
7758 call mt_write_vtu_empty_float_array(vtu_unit,'bfactor')
7759 call mt_write_vtu_empty_float_array(vtu_unit,'length_forward_qperp')
7760 call mt_write_vtu_empty_float_array(vtu_unit,'length_backward_qperp')
7761 call mt_write_vtu_empty_float_array(vtu_unit,'Bseed_norm')
7762 call mt_write_vtu_empty_float_array(vtu_unit,'Bf_norm')
7763 call mt_write_vtu_empty_float_array(vtu_unit,'Bb_norm')
7764 call mt_write_vtu_empty_float_array(vtu_unit,'x_f_qperp')
7765 call mt_write_vtu_empty_float_array(vtu_unit,'y_f_qperp')
7766 call mt_write_vtu_empty_float_array(vtu_unit,'z_f_qperp')
7767 call mt_write_vtu_empty_float_array(vtu_unit,'x_b_qperp')
7768 call mt_write_vtu_empty_float_array(vtu_unit,'y_b_qperp')
7769 call mt_write_vtu_empty_float_array(vtu_unit,'z_b_qperp')
7770 call mt_write_vtu_empty_int_array(vtu_unit,'valid_qperp')
7771 call mt_write_vtu_empty_int_array(vtu_unit,'status_qperp')
7772 call mt_write_vtu_empty_int_array(vtu_unit,'face_forward_qperp')
7773 call mt_write_vtu_empty_int_array(vtu_unit,'face_backward_qperp')
7774 call mt_write_vtu_empty_int_array(vtu_unit,'status_forward_qperp')
7775 call mt_write_vtu_empty_int_array(vtu_unit,'status_backward_qperp')
7776 endif
7777 write(vtu_unit,'(a)') '</PointData>'
7778 end subroutine mt_write_vtu_empty_pointdata
7779
7780 subroutine mt_write_vtu_empty_float_array(vtu_unit,name)
7781 integer, intent(in) :: vtu_unit
7782 character(len=*), intent(in) :: name
7783
7784 write(vtu_unit,'(a,a,a)') '<DataArray type="Float64" Name="', &
7785 trim(name),'" format="ascii">'
7786 write(vtu_unit,'(a)') '</DataArray>'
7787 end subroutine mt_write_vtu_empty_float_array
7788
7789 subroutine mt_write_vtu_empty_int_array(vtu_unit,name)
7790 integer, intent(in) :: vtu_unit
7791 character(len=*), intent(in) :: name
7792
7793 write(vtu_unit,'(a,a,a)') '<DataArray type="Int32" Name="', &
7794 trim(name),'" format="ascii">'
7795 write(vtu_unit,'(a)') '</DataArray>'
7796 end subroutine mt_write_vtu_empty_int_array
7797
7798 subroutine mt_write_vtu_float_array_start(vtu_unit,name,io_status)
7799 integer, intent(in) :: vtu_unit
7800 character(len=*), intent(in) :: name
7801 integer, intent(inout) :: io_status
7802
7803 if (io_status/=0) return
7804 write(vtu_unit,'(a,a,a)',iostat=io_status) &
7805 '<DataArray type="Float64" Name="',trim(name),'" format="ascii">'
7806 end subroutine mt_write_vtu_float_array_start
7807
7808 subroutine mt_write_vtu_int_array_start(vtu_unit,name,io_status)
7809 integer, intent(in) :: vtu_unit
7810 character(len=*), intent(in) :: name
7811 integer, intent(inout) :: io_status
7812
7813 if (io_status/=0) return
7814 write(vtu_unit,'(a,a,a)',iostat=io_status) &
7815 '<DataArray type="Int32" Name="',trim(name),'" format="ascii">'
7816 end subroutine mt_write_vtu_int_array_start
7817
7818 subroutine mt_write_vtu_data_array_end(vtu_unit,io_status)
7819 integer, intent(in) :: vtu_unit
7820 integer, intent(inout) :: io_status
7821
7822 if (io_status/=0) return
7823 write(vtu_unit,'(a)',iostat=io_status) '</DataArray>'
7824 end subroutine mt_write_vtu_data_array_end
7825
7826 subroutine mt_write_vtu_points(vtu_unit,length_results,npoint,io_status)
7827 integer, intent(in) :: vtu_unit,npoint
7828 type(trace_length_result), intent(in) :: length_results(npoint)
7829 integer, intent(inout) :: io_status
7830
7831 double precision :: seed_xyz(3)
7832 integer :: ipoint
7833
7834 write(vtu_unit,'(a)',iostat=io_status) '<Points>'
7835 if (io_status==0) then
7836 write(vtu_unit,'(a)',iostat=io_status) &
7837 '<DataArray type="Float64" NumberOfComponents="3" format="ascii">'
7838 endif
7839 do ipoint=1,npoint
7840 call mt_vtu_point_from_coord(length_results(ipoint)%seed,seed_xyz)
7841 if (io_status==0) write(vtu_unit,'(3(1pe24.16))', &
7842 iostat=io_status) seed_xyz
7843 enddo
7844 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7845 '</DataArray>'
7846 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) '</Points>'
7847 end subroutine mt_write_vtu_points
7848
7849 subroutine mt_write_vtu_topology_points(vtu_unit,topology,npoint, &
7850 io_status)
7851 integer, intent(in) :: vtu_unit,npoint
7852 type(trace_topology_result), intent(in) :: topology(npoint)
7853 integer, intent(inout) :: io_status
7854
7855 double precision :: seed_xyz(3)
7856 integer :: ipoint
7857
7858 write(vtu_unit,'(a)',iostat=io_status) '<Points>'
7859 if (io_status==0) then
7860 write(vtu_unit,'(a)',iostat=io_status) &
7861 '<DataArray type="Float64" NumberOfComponents="3" format="ascii">'
7862 endif
7863 do ipoint=1,npoint
7864 call mt_vtu_point_from_coord(topology(ipoint)%seed,seed_xyz)
7865 if (io_status==0) write(vtu_unit,'(3(1pe24.16))', &
7866 iostat=io_status) seed_xyz
7867 enddo
7868 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7869 '</DataArray>'
7870 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) '</Points>'
7871 end subroutine mt_write_vtu_topology_points
7872
7873 subroutine mt_vtu_point_from_coord(coord,point_xyz)
7874 double precision, intent(in) :: coord(ndim)
7875 double precision, intent(out) :: point_xyz(3)
7876
7877 double precision :: r,theta,phi,sin_theta
7878
7879 point_xyz=0.d0
7880 if (geo_coordinate==geo_spherical .and. ndim==3) then
7881 {^ifthreed
7882 r=coord(1)
7883 theta=coord(2)
7884 phi=coord(3)
7885 sin_theta=dsin(theta)
7886 point_xyz(1)=r*sin_theta*dcos(phi)
7887 point_xyz(2)=r*sin_theta*dsin(phi)
7888 point_xyz(3)=r*dcos(theta)
7889 }
7890 else
7891 point_xyz(1)=mt_vc(coord,1)
7892 point_xyz(2)=mt_vc(coord,2)
7893 point_xyz(3)=mt_vc(coord,3)
7894 endif
7895 end subroutine mt_vtu_point_from_coord
7896
7897 subroutine mt_write_vtu_vertex_cells(vtu_unit,npoint,io_status)
7898 integer, intent(in) :: vtu_unit,npoint
7899 integer, intent(inout) :: io_status
7900
7901 integer :: ipoint
7902
7903 write(vtu_unit,'(a)',iostat=io_status) '<Cells>'
7904 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7905 '<DataArray type="Int32" Name="connectivity" format="ascii">'
7906 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7907 (ipoint-1,ipoint=1,npoint)
7908 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7909 '</DataArray>'
7910 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7911 '<DataArray type="Int32" Name="offsets" format="ascii">'
7912 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7913 (ipoint,ipoint=1,npoint)
7914 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7915 '</DataArray>'
7916 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7917 '<DataArray type="UInt8" Name="types" format="ascii">'
7918 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7919 (1,ipoint=1,npoint)
7920 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7921 '</DataArray>'
7922 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) '</Cells>'
7923 end subroutine mt_write_vtu_vertex_cells
7924
7925 subroutine mt_write_vtu_quad_cells(vtu_unit,n1,n2,io_status)
7926 integer, intent(in) :: vtu_unit,n1,n2
7927 integer, intent(inout) :: io_status
7928
7929 integer :: i,j,icell,p,ncell
7930
7931 ncell=(n1-1)*(n2-1)
7932 write(vtu_unit,'(a)',iostat=io_status) '<Cells>'
7933 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7934 '<DataArray type="Int32" Name="connectivity" format="ascii">'
7935 do j=1,n2-1
7936 do i=1,n1-1
7937 p=(j-1)*n1+(i-1)
7938 if (io_status==0) write(vtu_unit,'(4(i0,1x))',iostat=io_status) &
7939 p,p+1,p+1+n1,p+n1
7940 enddo
7941 enddo
7942 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7943 '</DataArray>'
7944 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7945 '<DataArray type="Int32" Name="offsets" format="ascii">'
7946 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7947 (4*icell,icell=1,ncell)
7948 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7949 '</DataArray>'
7950 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7951 '<DataArray type="UInt8" Name="types" format="ascii">'
7952 if (io_status==0) write(vtu_unit,'(12(i0,1x))',iostat=io_status) &
7953 (9,icell=1,ncell)
7954 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7955 '</DataArray>'
7956 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) '</Cells>'
7957 end subroutine mt_write_vtu_quad_cells
7958
7959 subroutine mt_write_vtu_cells_empty(vtu_unit,io_status)
7960 integer, intent(in) :: vtu_unit
7961 integer, intent(inout) :: io_status
7962
7963 write(vtu_unit,'(a)',iostat=io_status) '<Cells>'
7964 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7965 '<DataArray type="Int32" Name="connectivity" format="ascii">'
7966 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7967 '</DataArray>'
7968 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7969 '<DataArray type="Int32" Name="offsets" format="ascii">'
7970 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7971 '</DataArray>'
7972 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7973 '<DataArray type="UInt8" Name="types" format="ascii">'
7974 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) &
7975 '</DataArray>'
7976 if (io_status==0) write(vtu_unit,'(a)',iostat=io_status) '</Cells>'
7977 end subroutine mt_write_vtu_cells_empty
7978
7979 subroutine mt_write_twist_plane_csv(results,n1,n2,csv_file,caller, &
7980 index_header)
7981 integer, intent(in) :: n1,n2
7982 type(trace_twist_result), intent(in) :: results(n1*n2)
7983 character(len=*), intent(in) :: csv_file,caller,index_header
7984
7985 double precision :: seed_xyz(3)
7986 integer :: csv_unit,io_status,i,j,iseed
7987
7988 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
7989 action='write',form='formatted',iostat=io_status)
7990 if (io_status/=0) then
7991 call mpistop(trim(caller)//' could not open CSV file')
7992 endif
7993
7994 write(csv_unit,'(a)',iostat=io_status) &
7995 trim(index_header)//',seed_x,seed_y,seed_z,'// &
7996 'length_total,length_backward,length_forward,'// &
7997 'twist_total,twist_backward,twist_forward,'// &
7998 'nstep_backward,nstep_forward,'// &
7999 'status_backward,status_forward'
8000 if (io_status/=0) then
8001 close(csv_unit)
8002 call mpistop(trim(caller)//' could not write CSV header')
8003 endif
8004
8005 do j=1,n2
8006 do i=1,n1
8007 iseed=(j-1)*n1+i
8008 seed_xyz=0.d0
8009 seed_xyz(1:ndim)=results(iseed)%line%seed
8010 write(csv_unit,'(i0,",",i0,9(",",es24.16),4(",",i0))', &
8011 iostat=io_status) i,j,seed_xyz, &
8012 results(iseed)%line%total_length, &
8013 results(iseed)%line%backward_length, &
8014 results(iseed)%line%forward_length, &
8015 results(iseed)%total_twist, &
8016 results(iseed)%backward_twist, &
8017 results(iseed)%forward_twist, &
8018 results(iseed)%line%backward_nstep, &
8019 results(iseed)%line%forward_nstep, &
8020 results(iseed)%line%backward_status, &
8021 results(iseed)%line%forward_status
8022 if (io_status/=0) then
8023 close(csv_unit)
8024 call mpistop(trim(caller)//' could not write CSV data')
8025 endif
8026 enddo
8027 enddo
8028
8029 close(csv_unit)
8030 end subroutine mt_write_twist_plane_csv
8031
8032 subroutine mt_write_q_plane_csv(results,n1,n2,csv_file,caller, &
8033 index_header)
8034 integer, intent(in) :: n1,n2
8035 type(trace_qperp_result), intent(in) :: results(n1*n2)
8036 character(len=*), intent(in) :: csv_file,caller,index_header
8037
8038 integer :: csv_unit,io_status,i,j,iseed
8039
8040 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
8041 action='write',form='formatted',iostat=io_status)
8042 if (io_status/=0) then
8043 call mpistop(trim(caller)//' could not open CSV file')
8044 endif
8045
8046 write(csv_unit,'(a)',iostat=io_status) &
8047 trim(index_header)//',seed_x,seed_y,seed_z,'// &
8048 'logQ,valid_Q,status_Q,'// &
8049 'face_forward_Q,face_backward_Q,'// &
8050 'status_forward_Q,status_backward_Q,'// &
8051 'length_forward_Q,length_backward_Q,'// &
8052 'x_f_Q,y_f_Q,z_f_Q,x_b_Q,y_b_Q,z_b_Q'
8053 if (io_status/=0) then
8054 close(csv_unit)
8055 call mpistop(trim(caller)//' could not write CSV header')
8056 endif
8057
8058 do j=1,n2
8059 do i=1,n1
8060 iseed=(j-1)*n1+i
8061 write(csv_unit, &
8062 '(i0,",",i0,4(",",es24.16),",",l1,5(",",i0),'// &
8063 '8(",",es24.16))',iostat=io_status) &
8064 i,j,results(iseed)%seed, &
8065 results(iseed)%logq0, &
8066 results(iseed)%valid_q0,results(iseed)%status_q0, &
8067 results(iseed)%forward_face,results(iseed)%backward_face, &
8068 results(iseed)%forward_status,results(iseed)%backward_status, &
8069 results(iseed)%forward_length,results(iseed)%backward_length, &
8070 results(iseed)%forward_endpoint, &
8071 results(iseed)%backward_endpoint
8072 if (io_status/=0) then
8073 close(csv_unit)
8074 call mpistop(trim(caller)//' could not write CSV data')
8075 endif
8076 enddo
8077 enddo
8078
8079 close(csv_unit)
8080 end subroutine mt_write_q_plane_csv
8081
8082 subroutine mt_write_qperp_plane_csv(results,n1,n2,csv_file,caller, &
8083 index_header)
8084 integer, intent(in) :: n1,n2
8085 type(trace_qperp_result), intent(in) :: results(n1*n2)
8086 character(len=*), intent(in) :: csv_file,caller,index_header
8087
8088 double precision :: bseed_norm,bf_norm,bb_norm
8089 integer :: csv_unit,io_status,i,j,iseed
8090
8091 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
8092 action='write',form='formatted',iostat=io_status)
8093 if (io_status/=0) then
8094 call mpistop(trim(caller)//' could not open CSV file')
8095 endif
8096
8097 write(csv_unit,'(a)',iostat=io_status) &
8098 trim(index_header)//',seed_x,seed_y,seed_z,'// &
8099 'qperp,logqperp,valid,status,'// &
8100 'N2,bfactor,'// &
8101 'face_forward,face_backward,'// &
8102 'status_forward,status_backward,'// &
8103 'length_forward,length_backward,'// &
8104 'Bseed_norm,Bf_norm,Bb_norm,'// &
8105 'x_f,y_f,z_f,x_b,y_b,z_b'
8106 if (io_status/=0) then
8107 close(csv_unit)
8108 call mpistop(trim(caller)//' could not write CSV header')
8109 endif
8110
8111 do j=1,n2
8112 do i=1,n1
8113 iseed=(j-1)*n1+i
8114 bseed_norm=dsqrt(sum(results(iseed)%B_seed**2))
8115 bf_norm=dsqrt(sum(results(iseed)%forward_B**2))
8116 bb_norm=dsqrt(sum(results(iseed)%backward_B**2))
8117 write(csv_unit, &
8118 '(i0,",",i0,5(",",es24.16),",",l1,",",i0,'// &
8119 '2(",",es24.16),4(",",i0),11(",",es24.16))', &
8120 iostat=io_status) &
8121 i,j,results(iseed)%seed, &
8122 results(iseed)%qperp,results(iseed)%logqperp, &
8123 results(iseed)%valid,results(iseed)%status, &
8124 results(iseed)%N2,results(iseed)%bfactor, &
8125 results(iseed)%forward_face,results(iseed)%backward_face, &
8126 results(iseed)%forward_status,results(iseed)%backward_status, &
8127 results(iseed)%forward_length,results(iseed)%backward_length, &
8128 bseed_norm,bf_norm,bb_norm, &
8129 results(iseed)%forward_endpoint, &
8130 results(iseed)%backward_endpoint
8131 if (io_status/=0) then
8132 close(csv_unit)
8133 call mpistop(trim(caller)//' could not write CSV data')
8134 endif
8135 enddo
8136 enddo
8137
8138 close(csv_unit)
8139 end subroutine mt_write_qperp_plane_csv
8140
8141 subroutine mt_write_qperp_arbitrary_header(csv_file,caller)
8142 character(len=*), intent(in) :: csv_file,caller
8143
8144 integer :: csv_unit,io_status
8145
8146 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
8147 action='write',form='formatted',iostat=io_status)
8148 if (io_status/=0) then
8149 call mpistop(trim(caller)//' could not open CSV file')
8150 endif
8151
8152 write(csv_unit,'(a)',iostat=io_status) &
8153 'i,j,s1,s2,seed_x,seed_y,seed_z,'// &
8154 'qperp,logqperp,valid,status,'// &
8155 'N2,bfactor,'// &
8156 'face_forward,face_backward,'// &
8157 'status_forward,status_backward,'// &
8158 'length_forward,length_backward,'// &
8159 'Bseed_norm,Bf_norm,Bb_norm,'// &
8160 'x_f,y_f,z_f,x_b,y_b,z_b'
8161 if (io_status/=0) then
8162 close(csv_unit)
8163 call mpistop(trim(caller)//' could not write CSV header')
8164 endif
8165
8166 close(csv_unit)
8167 end subroutine mt_write_qperp_arbitrary_header
8168
8169 subroutine mt_write_qperp_arbitrary_csv(results,s1,s2,n1,n2,csv_file, &
8170 caller)
8171 integer, intent(in) :: n1,n2
8172 type(trace_qperp_result), intent(in) :: results(n1*n2)
8173 double precision, intent(in) :: s1(n1*n2),s2(n1*n2)
8174 character(len=*), intent(in) :: csv_file,caller
8175
8176 double precision :: bseed_norm,bf_norm,bb_norm
8177 integer :: csv_unit,io_status,i,j,iseed
8178
8179 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
8180 action='write',form='formatted',iostat=io_status)
8181 if (io_status/=0) then
8182 call mpistop(trim(caller)//' could not open CSV file')
8183 endif
8184
8185 write(csv_unit,'(a)',iostat=io_status) &
8186 'i,j,s1,s2,seed_x,seed_y,seed_z,'// &
8187 'qperp,logqperp,valid,status,'// &
8188 'N2,bfactor,'// &
8189 'face_forward,face_backward,'// &
8190 'status_forward,status_backward,'// &
8191 'length_forward,length_backward,'// &
8192 'Bseed_norm,Bf_norm,Bb_norm,'// &
8193 'x_f,y_f,z_f,x_b,y_b,z_b'
8194 if (io_status/=0) then
8195 close(csv_unit)
8196 call mpistop(trim(caller)//' could not write CSV header')
8197 endif
8198
8199 do j=1,n2
8200 do i=1,n1
8201 iseed=(j-1)*n1+i
8202 bseed_norm=dsqrt(sum(results(iseed)%B_seed**2))
8203 bf_norm=dsqrt(sum(results(iseed)%forward_B**2))
8204 bb_norm=dsqrt(sum(results(iseed)%backward_B**2))
8205 write(csv_unit, &
8206 '(i0,",",i0,7(",",es24.16),",",l1,",",i0,'// &
8207 '2(",",es24.16),4(",",i0),11(",",es24.16))', &
8208 iostat=io_status) &
8209 i,j,s1(iseed),s2(iseed),results(iseed)%seed, &
8210 results(iseed)%qperp,results(iseed)%logqperp, &
8211 results(iseed)%valid,results(iseed)%status, &
8212 results(iseed)%N2,results(iseed)%bfactor, &
8213 results(iseed)%forward_face,results(iseed)%backward_face, &
8214 results(iseed)%forward_status,results(iseed)%backward_status, &
8215 results(iseed)%forward_length,results(iseed)%backward_length, &
8216 bseed_norm,bf_norm,bb_norm, &
8217 results(iseed)%forward_endpoint, &
8218 results(iseed)%backward_endpoint
8219 if (io_status/=0) then
8220 close(csv_unit)
8221 call mpistop(trim(caller)//' could not write CSV data')
8222 endif
8223 enddo
8224 enddo
8225
8226 close(csv_unit)
8227 end subroutine mt_write_qperp_arbitrary_csv
8228
8229 subroutine mt_write_mapping_plane_xy_csv(results,nx,ny,csv_file)
8230 integer, intent(in) :: nx,ny
8231 type(trace_mapping_result), intent(in) :: results(nx*ny)
8232 character(len=*), intent(in) :: csv_file
8233
8234 call mt_write_mapping_plane_csv(results,nx,ny,csv_file, &
8235 'mt_mapping_plane_xy','ix,iy')
8236 end subroutine mt_write_mapping_plane_xy_csv
8237
8238 subroutine mt_write_mapping_plane_csv(results,n1,n2,csv_file,caller, &
8239 index_header)
8240 integer, intent(in) :: n1,n2
8241 type(trace_mapping_result), intent(in) :: results(n1*n2)
8242 character(len=*), intent(in) :: csv_file,caller,index_header
8243
8244 integer :: csv_unit,io_status,i,j,iseed
8245
8246 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
8247 action='write',form='formatted',iostat=io_status)
8248 if (io_status/=0) then
8249 call mpistop(trim(caller)//' could not open CSV file')
8250 endif
8251
8252 write(csv_unit,'(a)',iostat=io_status) &
8253 trim(index_header)//','// &
8254 'seed_x,seed_y,seed_z,'// &
8255 'source_Bx,source_By,source_Bz,source_Bn,'// &
8256 'backward_x,backward_y,backward_z,'// &
8257 'backward_Bx,backward_By,backward_Bz,backward_Bn,'// &
8258 'backward_face,backward_length,backward_status,'// &
8259 'forward_x,forward_y,forward_z,'// &
8260 'forward_Bx,forward_By,forward_Bz,forward_Bn,'// &
8261 'forward_face,forward_length,forward_status,valid'
8262 if (io_status/=0) then
8263 close(csv_unit)
8264 call mpistop(trim(caller)//' could not write CSV header')
8265 endif
8266
8267 do j=1,n2
8268 do i=1,n1
8269 iseed=(j-1)*n1+i
8270 write(csv_unit, &
8271 '(i0,",",i0,14(",",es24.16),",",i0,",",es24.16,'// &
8272 '",",i0,7(",",es24.16),",",i0,",",es24.16,'// &
8273 '",",i0,",",l1)',iostat=io_status) &
8274 i,j, &
8275 results(iseed)%seed, &
8276 results(iseed)%source_B,results(iseed)%source_Bn, &
8277 results(iseed)%backward_footpoint, &
8278 results(iseed)%backward_B,results(iseed)%backward_Bn, &
8279 results(iseed)%backward_face, &
8280 results(iseed)%backward_length, &
8281 results(iseed)%backward_status, &
8282 results(iseed)%forward_footpoint, &
8283 results(iseed)%forward_B,results(iseed)%forward_Bn, &
8284 results(iseed)%forward_face, &
8285 results(iseed)%forward_length, &
8286 results(iseed)%forward_status, &
8287 results(iseed)%valid
8288 if (io_status/=0) then
8289 close(csv_unit)
8290 call mpistop(trim(caller)//' could not write CSV data')
8291 endif
8292 enddo
8293 enddo
8294
8295 close(csv_unit)
8296 end subroutine mt_write_mapping_plane_csv
8297
8298 integer function mt_q_result_face_pair(qperp_result) result(face_pair)
8299 type(trace_qperp_result), intent(in) :: qperp_result
8300
8301 face_pair=0
8302 if (.not.qperp_result%valid_q0) return
8303 face_pair=mt_q_face_pair_from_faces(qperp_result%backward_face, &
8304 qperp_result%forward_face)
8305 end function mt_q_result_face_pair
8306
8307 integer function mt_q_result_connection_type(qperp_result) &
8308 result(connection_type)
8309 type(trace_qperp_result), intent(in) :: qperp_result
8310
8311 connection_type=0
8312 if (.not.qperp_result%valid_q0) return
8313 connection_type=mt_q_connection_type_from_faces( &
8314 qperp_result%backward_face,qperp_result%forward_face)
8315 end function mt_q_result_connection_type
8316
8317 integer function mt_q_face_pair_from_faces(face_b,face_f) result(face_pair)
8318 integer, intent(in) :: face_b,face_f
8319
8320 face_pair=0
8321 if (.not.mt_q_face_valid(face_b)) return
8322 if (.not.mt_q_face_valid(face_f)) return
8323 face_pair=10*face_b+face_f
8324 end function mt_q_face_pair_from_faces
8325
8326 integer function mt_q_connection_type_from_faces(face_b,face_f) &
8327 result(connection_type)
8328 integer, intent(in) :: face_b,face_f
8329
8330 connection_type=0
8331 if (.not.mt_q_face_valid(face_b)) return
8332 if (.not.mt_q_face_valid(face_f)) return
8333 if (face_b==trace_face_zmin .and. face_f==trace_face_zmin) then
8334 connection_type=1
8335 else if (face_b==trace_face_zmax .and. face_f==trace_face_zmax) then
8336 connection_type=2
8337 else if ((face_b==trace_face_zmin .and. face_f==trace_face_zmax) .or. &
8338 (face_b==trace_face_zmax .and. face_f==trace_face_zmin)) then
8339 connection_type=3
8340 else if (face_b==face_f) then
8341 connection_type=4
8342 else
8343 connection_type=5
8344 endif
8345 end function mt_q_connection_type_from_faces
8346
8347 logical function mt_q_face_valid(face)
8348 integer, intent(in) :: face
8349
8350 mt_q_face_valid=face>=trace_face_xmin .and. face<=trace_face_zmax
8351 end function mt_q_face_valid
8352
8353end module mod_magnetic_topology
subroutine, public mpistop(message)
Exit MPI-AMRVAC with an error message.
Module with geometry-related routines (e.g., divergence, curl)
Definition mod_geometry.t:2
integer coordinate
Definition mod_geometry.t:7
integer, parameter spherical
integer, parameter cartesian
Definition mod_geometry.t:8
integer, parameter cartesian_stretched
Definition mod_geometry.t:9
This module contains definitions of global parameters and variables and some generic functions/subrou...
integer, parameter unitpar
file handle for IO
integer, parameter ndim
Number of spatial dimensions for grid variables.
double precision, dimension(:), allocatable, parameter d
integer npe
The number of MPI tasks.
logical, dimension(ndim) periodb
True for dimensions with periodic boundaries.
logical slab_uniform
uniform Cartesian geometry or not (stretched Cartesian)
subroutine, public mt_write_cartesian_vti_pointdata(vti_file, xmin, xmax, nx, ymin, ymax, ny, zmin, zmax, nz, length_total, qperp, status)
subroutine, public mt_fieldline_products_plane_arbitrary(origin, e1, e2, s1min, s1max, n1, s2min, s2max, n2, dl, max_steps, csv_file, b_min, compute_length, compute_twist, compute_q, compute_qperp, vtu_file, write_csv)
subroutine, public mt_twist_plane_yz(ymin, ymax, ny, zmin, zmax, nz, x0, dl, max_steps, csv_file, b_min)
subroutine, public mt_topology_plane_xy(xmin, xmax, nx, ymin, ymax, ny, z0, dl, max_steps, length_csv, twist_csv, mapping_csv, b_min)
subroutine, public mt_qsl_plane_vtu_yz(ymin, ymax, ny, zmin, zmax, nz, x0, dl, max_steps, vtu_file, b_min)
subroutine, public mt_qperp_plane_xz(xmin, xmax, nx, zmin, zmax, nz, y0, dl, max_steps, csv_file, b_min)
subroutine, public mt_qsl_plane_vtu_xy(xmin, xmax, nx, ymin, ymax, ny, z0, dl, max_steps, vtu_file, b_min)
subroutine, public mt_twist_plane_xz(xmin, xmax, nx, zmin, zmax, nz, y0, dl, max_steps, csv_file, b_min)
subroutine, public mt_length_plane_xy(xmin, xmax, nx, ymin, ymax, ny, z0, dl, max_steps, csv_file, b_min)
subroutine, public mt_fieldline_products_seeds(seeds, nseed, dl, max_steps, csv_file, b_min, compute_length, compute_twist, compute_q, compute_qperp, vtu_file)
subroutine, public mt_length_seeds(seeds, nseed, dl, max_steps, csv_file, b_min)
subroutine, public mt_topology_plane_yz(ymin, ymax, ny, zmin, zmax, nz, x0, dl, max_steps, length_csv, twist_csv, mapping_csv, b_min)
subroutine, public mt_qperp_plane_yz(ymin, ymax, ny, zmin, zmax, nz, x0, dl, max_steps, csv_file, b_min)
subroutine, public mt_qperp_plane_arbitrary(origin, e1, e2, s1min, s1max, n1, s2min, s2max, n2, dl, max_steps, csv_file, b_min)
subroutine, public mt_qperp_plane_xy(xmin, xmax, nx, ymin, ymax, ny, z0, dl, max_steps, csv_file, b_min)
subroutine, public mt_length_plane_xz(xmin, xmax, nx, zmin, zmax, nz, y0, dl, max_steps, csv_file, b_min)
subroutine, public mt_length_single(seed, dl, max_steps, csv_file, b_min)
subroutine, public mt_fieldline_products_volume_vti(xmin, xmax, nx, ymin, ymax, ny, zmin, zmax, nz, dl, max_steps, vti_file, b_min, compute_length, compute_twist, compute_q, compute_qperp, chunk_nz)
subroutine, public mt_qsl_plane_vtu_xz(xmin, xmax, nx, zmin, zmax, nz, y0, dl, max_steps, vtu_file, b_min)
subroutine, public mt_twist_plane_xy(xmin, xmax, nx, ymin, ymax, ny, z0, dl, max_steps, csv_file, b_min)
subroutine, public mt_params_read(files)
subroutine, public mt_topology_plane_xz(xmin, xmax, nx, zmin, zmax, nz, y0, dl, max_steps, length_csv, twist_csv, mapping_csv, b_min)
subroutine, public mt_mapping_plane_xy(xmin, xmax, nx, ymin, ymax, ny, z0, dl, max_steps, csv_file, b_min)
subroutine, public mt_twist_seeds(seeds, nseed, dl, max_steps, csv_file, b_min)
subroutine, public mt_length_plane_yz(ymin, ymax, ny, zmin, zmax, nz, x0, dl, max_steps, csv_file, b_min)
subroutine, public mt_run_topology_task()
subroutine, public mt_twist_single(seed, dl, max_steps, csv_file, b_min)
integer, parameter, public trace_face_ymin
integer, parameter, public trace_face_zmax
subroutine, public trace_spherical_profile_set(enabled)
subroutine, public trace_rk45_stats_reset()
subroutine, public trace_field_twist_multi(seeds, nseed, dl, max_steps, results, b_min)
subroutine, public trace_field_rk2_short_boundary_q_multi(seeds, nseed, dl, max_steps, results, b_min, twist_results)
subroutine, public trace_cartesian_global_min_cell_size(hmin, status)
subroutine, public trace_spherical_curl_cache_clear()
subroutine, public trace_field_qperp_multi(seeds, nseed, dl, max_steps, results, b_min, twist_results)
subroutine, public trace_field_spherical_rmin_q_multi(seeds, nseed, dl, max_steps, results, b_min, twist_results)
subroutine, public trace_rk45_stats_report(label)
subroutine, public trace_field_topology_multi(seeds, nseed, dl, max_steps, results, need_twist, need_mapping, b_min, source_normal)
integer, parameter, public trace_face_xmax
subroutine, public trace_field_twist_single(seed, dl, max_steps, result, b_min)
subroutine, public trace_field_mapping_single(seed, dl, max_steps, result, b_min, source_normal)
integer, parameter, public trace_face_none
integer, parameter, public trace_status_boundary
subroutine, public trace_spherical_profile_report(label)
integer, parameter, public trace_face_ambiguous
subroutine, public trace_field_qperp_single(seed, dl, max_steps, result, b_min)
integer, parameter, public trace_face_zmin
integer, parameter, public trace_status_unsupported_geometry
subroutine, public trace_set_step_control(mode, step_fraction, step_min)
subroutine, public trace_debug_cartesian_rk45_tangent_q0_multi(seeds, nseed, dl, max_steps, results, b_min)
integer, parameter, public trace_face_ymax
subroutine, public trace_spherical_global_min_cell_size(hmin, status)
subroutine, public trace_rk2_stats_reset()
subroutine, public trace_spherical_curl_cache_build(status)
subroutine, public trace_spherical_profile_count_seeds(nseed)
subroutine, public trace_spherical_profile_reset()
subroutine, public trace_field_spherical_rmin_q_qperp_multi(seeds, nseed, dl, max_steps, q_results, qperp_results, b_min, twist_results)
subroutine, public trace_field_length_multi(seeds, nseed, dl, max_steps, results, b_min)
subroutine, public trace_rk45_stats_set_enabled(enabled)
subroutine, public trace_set_integrator(mode, atol, rtol, safety, min_shrink, max_grow, tangent_floor, tangent_rtol)
subroutine, public trace_rk2_stats_set_enabled(enabled)
subroutine, public trace_field_spherical_qperp_multi(seeds, nseed, dl, max_steps, results, b_min, twist_results)
subroutine, public trace_rk2_stats_report(label)
subroutine, public trace_field_length_single(seed, dl, max_steps, result, b_min)
integer, parameter, public trace_face_xmin
subroutine, public trace_field_mapping_multi(seeds, nseed, dl, max_steps, results, b_min, source_normal)
integer, parameter, public trace_status_active