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,global_time,ps,iwstart,nwgc,par_files
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
48 implicit none
49 private
50
56 public :: mt_mapping_plane_xy
65
66 integer, parameter :: mt_vti_kind_float64 = 1
67 integer, parameter :: mt_vti_kind_int32 = 2
68 integer, parameter :: mt_vti_name_len = 64
69 integer, parameter :: mt_task_name_len = 128
70 double precision, parameter :: mt_unset_real = huge(1.d0)
71
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 logical :: mt_params_loaded = .false.
135
136 type, private :: mt_vti_array_desc
137 character(len=mt_vti_name_len) :: name
138 integer :: kind
139 integer(kind=8) :: nbytes
140 integer(kind=8) :: offset
141 end type mt_vti_array_desc
142
143 type, private :: mt_volume_products
144 double precision, allocatable :: length_total(:)
145 double precision, allocatable :: length_backward(:)
146 double precision, allocatable :: length_forward(:)
147 integer, allocatable :: nstep_backward_length(:)
148 integer, allocatable :: nstep_forward_length(:)
149 integer, allocatable :: status_backward_length(:)
150 integer, allocatable :: status_forward_length(:)
151 double precision, allocatable :: twist_total(:)
152 double precision, allocatable :: twist_backward(:)
153 double precision, allocatable :: twist_forward(:)
154 integer, allocatable :: nstep_backward_twist(:)
155 integer, allocatable :: nstep_forward_twist(:)
156 integer, allocatable :: status_backward_twist(:)
157 integer, allocatable :: status_forward_twist(:)
158 double precision, allocatable :: q(:)
159 double precision, allocatable :: logq(:)
160 double precision, allocatable :: N2_q(:)
161 double precision, allocatable :: bfactor_q(:)
162 double precision, allocatable :: length_forward_q(:)
163 double precision, allocatable :: length_backward_q(:)
164 double precision, allocatable :: Bseed_norm_q(:)
165 double precision, allocatable :: Bf_norm_q(:)
166 double precision, allocatable :: Bb_norm_q(:)
167 integer, allocatable :: valid_q(:)
168 integer, allocatable :: status_q(:)
169 integer, allocatable :: face_forward_q(:)
170 integer, allocatable :: face_backward_q(:)
171 integer, allocatable :: status_forward_q(:)
172 integer, allocatable :: status_backward_q(:)
173 double precision, allocatable :: qperp(:)
174 double precision, allocatable :: logqperp(:)
175 double precision, allocatable :: N2(:)
176 double precision, allocatable :: bfactor(:)
177 double precision, allocatable :: length_forward_qperp(:)
178 double precision, allocatable :: length_backward_qperp(:)
179 double precision, allocatable :: Bseed_norm(:)
180 double precision, allocatable :: Bf_norm(:)
181 double precision, allocatable :: Bb_norm(:)
182 integer, allocatable :: valid_qperp(:)
183 integer, allocatable :: status_qperp(:)
184 integer, allocatable :: face_forward_qperp(:)
185 integer, allocatable :: face_backward_qperp(:)
186 integer, allocatable :: status_forward_qperp(:)
187 integer, allocatable :: status_backward_qperp(:)
188 end type mt_volume_products
189
190contains
191
192 subroutine mt_params_read(files)
193 ! Read the one-task magnetic-topology namelist.
195 character(len=*), intent(in) :: files(:)
196
197 integer :: n
198
199 namelist /magnetic_topology_list/ mt_mode,mt_output_file, &
200 mt_output_prefix,mt_seed_file,mt_vtk_detail, &
201 mt_seed_surface,mt_seed_layout,mt_seed_coord, &
202 mt_seed_theta0,mt_seed_phi0,mt_seed_alpha, &
203 mt_step_control,mt_dl,mt_step_fraction,mt_dl_min, &
204 mt_trace_integrator,mt_rk45_atol,mt_rk45_rtol, &
205 mt_rk45_safety,mt_rk45_min_shrink,mt_rk45_max_grow, &
206 mt_rk45_tangent_floor,mt_rk45_tangent_rtol, &
207 mt_max_steps,mt_max_steps_factor,mt_b_min, &
208 mt_compute_length,mt_compute_twist,mt_compute_q,mt_compute_qperp, &
209 mt_rk2_step_diagnostic,mt_rk45_step_diagnostic, &
210 mt_rk45_tangent_diagnostic,mt_rk2_fusion_diagnostic, &
211 mt_write_csv,mt_plane, &
212 mt_origin,mt_e1,mt_e2,mt_xmin,mt_xmax,mt_ymin,mt_ymax, &
213 mt_zmin,mt_zmax,mt_nx,mt_ny,mt_nz,mt_x0,mt_y0,mt_z0, &
214 mt_s1min,mt_s1max,mt_n1,mt_s2min,mt_s2max,mt_n2, &
215 mt_s3min,mt_s3max,mt_n3, &
216 mt_chunk_nz,mt_profile_spherical
217
218 call mt_set_default_params()
219 do n=1,size(files)
220 open(unitpar,file=trim(files(n)),status='old')
221 read(unitpar,magnetic_topology_list,end=111)
222111 close(unitpar)
223 enddo
224 mt_params_loaded=.true.
225 end subroutine mt_params_read
226
228 ! Dispatch the namelist-selected topology/QSL postprocessing task.
229 ! This backend is deliberately single-MPI-rank and OpenMP capable.
230 use mod_comm_lib, only: mpistop
232 character(len=mt_task_name_len) :: mode
233 logical :: report_rk2,report_rk45
234
235 if (npe/=1) call mpistop(&
236 'magnetic-topology conversion requires npe=1; use OpenMP threads')
237 if (.not.mt_params_loaded) call mt_params_read(par_files)
238 call getbc(global_time,0.d0,ps,iwstart,nwgc)
239
240 mode=mt_lowercase(trim(mt_mode))
241 call mt_validate_common_params(mode)
242 call mt_validate_trace_integrator(mode)
243 call mt_apply_trace_step_control()
244 call mt_apply_auto_max_steps()
245 call trace_set_integrator(mt_trace_integrator,mt_rk45_atol, &
246 mt_rk45_rtol,mt_rk45_safety,mt_rk45_min_shrink, &
247 mt_rk45_max_grow,mt_rk45_tangent_floor,mt_rk45_tangent_rtol)
248 report_rk2=mt_lowercase(trim(mt_trace_integrator))=='rk2' .and. &
249 mt_rk2_step_diagnostic
250 report_rk45=(mt_lowercase(trim(mt_trace_integrator))=='rk45_cartesian' &
251 .or. mt_lowercase(trim(mt_trace_integrator))=='rk45_spherical') &
252 .and. mt_rk45_step_diagnostic
253 call trace_rk2_stats_set_enabled(report_rk2)
254 call trace_rk45_stats_set_enabled(report_rk45)
255 if (report_rk2) call trace_rk2_stats_reset()
256 if (report_rk45) call trace_rk45_stats_reset()
257 if (mt_profile_spherical .and. &
258 trim(mode)/='spherical_surface_products' .and. &
259 trim(mode)/='spherical_cloud_products') then
260 write(*,'(a)') 'mt_run_topology_task: mt_profile_spherical applies '// &
261 'only to spherical topology modes'
262 endif
263
264 select case (trim(mode))
265 case ('axis_plane_full_vtu')
266 call mt_run_axis_plane_full_vtu_task()
267 case ('volume_vti')
268 call mt_run_volume_vti_task()
269 case ('arbitrary_plane_products')
270 call mt_run_arbitrary_plane_products_task()
271 case ('seed_products')
272 call mt_run_seed_products_task()
273 case ('axis_plane_csv')
274 call mt_run_axis_plane_csv_task()
275 case ('spherical_surface_products')
276 call mt_run_spherical_surface_products_task()
277 case ('spherical_cloud_products')
278 call mt_run_spherical_cloud_products_task()
279 case default
280 call mpistop('mt_run_topology_task: unknown mt_mode='//trim(mt_mode))
281 end select
282 if (report_rk2) call trace_rk2_stats_report(trim(mode))
283 call trace_rk2_stats_set_enabled(.false.)
284 if (report_rk45) call trace_rk45_stats_report(trim(mode))
285 call trace_rk45_stats_set_enabled(.false.)
286 end subroutine mt_run_topology_task
287
288 subroutine mt_set_default_params()
289 mt_params_loaded=.false.
290 mt_mode=''
291 mt_output_file=''
292 mt_output_prefix=''
293 mt_seed_file=''
294 mt_seed_surface=''
295 mt_seed_layout='endpoint'
296 mt_vtk_detail='minimal'
297 mt_step_control='global_cell_fraction'
298 mt_trace_integrator='rk2'
299 mt_dl=-1.d0
300 mt_step_fraction=0.25d0
301 mt_dl_min=0.d0
302 mt_rk45_atol=1.d-8
303 mt_rk45_rtol=1.d-6
304 mt_rk45_safety=0.9d0
305 mt_rk45_min_shrink=0.2d0
306 mt_rk45_max_grow=5.d0
307 mt_rk45_tangent_floor=1.d0
308 mt_rk45_tangent_rtol=2.d-5
309 mt_max_steps=-1
310 mt_max_steps_factor=2.d0
311 mt_b_min=-1.d0
312 mt_seed_coord=mt_unset_real
313 mt_seed_theta0=mt_unset_real
314 mt_seed_phi0=mt_unset_real
315 mt_seed_alpha=mt_unset_real
316 mt_compute_length=.true.
317 mt_compute_twist=.false.
318 mt_compute_q=.false.
319 mt_compute_qperp=.false.
320 mt_rk2_step_diagnostic=.false.
321 mt_rk45_step_diagnostic=.false.
322 mt_rk45_tangent_diagnostic=.false.
323 mt_rk2_fusion_diagnostic=.false.
324 mt_write_csv=.false.
325 mt_plane=''
326 mt_origin=mt_unset_real
327 mt_e1=mt_unset_real
328 mt_e2=mt_unset_real
329 mt_xmin=mt_unset_real
330 mt_xmax=mt_unset_real
331 mt_ymin=mt_unset_real
332 mt_ymax=mt_unset_real
333 mt_zmin=mt_unset_real
334 mt_zmax=mt_unset_real
335 mt_x0=mt_unset_real
336 mt_y0=mt_unset_real
337 mt_z0=mt_unset_real
338 mt_nx=-1
339 mt_ny=-1
340 mt_nz=-1
341 mt_s1min=mt_unset_real
342 mt_s1max=mt_unset_real
343 mt_s2min=mt_unset_real
344 mt_s2max=mt_unset_real
345 mt_s3min=mt_unset_real
346 mt_s3max=mt_unset_real
347 mt_n1=-1
348 mt_n2=-1
349 mt_n3=-1
350 mt_chunk_nz=-1
351 mt_profile_spherical=.false.
352 end subroutine mt_set_default_params
353
354 subroutine mt_validate_periodic_phi()
355 if (.not.trace_periodic_phi_supported()) then
356 call mpistop('spherical periodic phi requires a full 2*pi longitude span')
357 endif
358 end subroutine mt_validate_periodic_phi
359
360 subroutine mt_validate_common_params(mode)
361 character(len=*), intent(in) :: mode
362
363 if (len_trim(mode)==0) then
364 call mpistop('mt_run_topology_task requires mt_mode')
365 endif
366 select case (trim(mode))
367 case ('spherical_surface_products','spherical_cloud_products')
368 if (ndim/=3) then
369 call mpistop(trim(mode)//' requires 3D spherical geometry')
370 endif
371 {^ifthreed
372 if (geo_coordinate/=geo_spherical) then
373 call mpistop(trim(mode)//' requires 3D spherical geometry')
374 endif
375 call mt_validate_periodic_phi()
376 }
377 case ('seed_products')
378 if (ndim/=3) then
379 call mpistop('seed_products requires 3D Cartesian or spherical geometry')
380 endif
381 {^ifthreed
382 select case (geo_coordinate)
383 case (geo_cartesian,geo_cartesian_stretched,geo_spherical)
384 case default
385 call mpistop('seed_products requires Cartesian or spherical geometry')
386 end select
387 call mt_validate_periodic_phi()
388 }
389 case ('volume_vti')
390 if (ndim/=3) then
391 call mpistop('volume_vti requires 3D Cartesian geometry')
392 endif
393 {^ifthreed
394 select case (geo_coordinate)
395 case (geo_cartesian)
396 ! The VTI sampling grid is user-defined; tracing may interpolate
397 ! through uniform or AMR Cartesian simulation grids.
398 case (geo_cartesian_stretched)
399 ! The VTI sampling grid is uniform Cartesian; tracing may interpolate
400 ! through a stretched Cartesian simulation grid.
401 case default
402 call mpistop('volume_vti requires Cartesian geometry')
403 end select
404 }
405 case ('axis_plane_full_vtu','axis_plane_csv')
406 if (ndim/=3) then
407 call mpistop(trim(mode)//' requires 3D Cartesian geometry')
408 endif
409 {^ifthreed
410 select case (geo_coordinate)
411 case (geo_cartesian)
412 ! Axis-plane output is a seed-surface product; RK2 tracing supports
413 ! both slab-uniform and AMR Cartesian simulation grids.
414 case (geo_cartesian_stretched)
415 case default
416 call mpistop(trim(mode)//' requires Cartesian geometry')
417 end select
418 }
419 case ('arbitrary_plane_products')
420 if (ndim/=3) then
421 call mpistop('arbitrary_plane_products requires 3D Cartesian geometry')
422 endif
423 {^ifthreed
424 select case (geo_coordinate)
425 case (geo_cartesian,geo_cartesian_stretched)
426 case default
427 call mpistop('arbitrary_plane_products requires Cartesian geometry')
428 end select
429 }
430 case default
431 if (ndim/=3 .or. geo_coordinate/=geo_cartesian .or. &
432 .not.slab_uniform) then
433 call mpistop('mt_run_topology_task mode requires 3D uniform Cartesian geometry')
434 endif
435 end select
436 if (len_trim(mt_output_file)==0 .and. &
437 len_trim(mt_output_prefix)==0) then
438 call mpistop('mt_run_topology_task requires mt_output_file or mt_output_prefix')
439 endif
440 select case (mt_lowercase(trim(mt_step_control)))
441 case ('fixed')
442 if (mt_dl<=0.d0) then
443 call mpistop('mt_step_control=fixed requires mt_dL > 0')
444 endif
445 case ('cell_fraction')
446 select case (geo_coordinate)
447 case (geo_cartesian,geo_cartesian_stretched)
448 case (geo_spherical)
449 select case (trim(mode))
450 case ('seed_products','spherical_surface_products', &
451 'spherical_cloud_products')
452 case default
453 call mpistop('mt_step_control=cell_fraction is only supported '// &
454 'for spherical topology modes')
455 end select
456 case default
457 call mpistop('mt_step_control=cell_fraction requires Cartesian or '// &
458 'supported spherical geometry')
459 end select
460 if (mt_step_fraction<=0.d0) then
461 call mpistop('mt_step_control=cell_fraction requires '// &
462 'mt_step_fraction > 0')
463 endif
464 if (mt_dl_min<0.d0) then
465 call mpistop('mt_step_control=cell_fraction requires mt_dL_min >= 0')
466 endif
467 case ('global_cell_fraction')
468 if (mt_step_fraction<=0.d0) then
469 call mpistop('mt_step_control=global_cell_fraction requires '// &
470 'mt_step_fraction > 0')
471 endif
472 if (mt_dl_min<0.d0) then
473 call mpistop('mt_step_control=global_cell_fraction requires mt_dL_min >= 0')
474 endif
475 case default
476 call mpistop('mt_run_topology_task requires mt_step_control=fixed '// &
477 'or cell_fraction/global_cell_fraction')
478 end select
479 if (mt_max_steps<=0 .and. mt_max_steps_factor<=0.d0) then
480 call mpistop('mt_max_steps auto requires mt_max_steps_factor > 0')
481 endif
482 select case (mt_lowercase(trim(mt_vtk_detail)))
483 case ('minimal','full')
484 case default
485 call mpistop('mt_run_topology_task requires mt_vtk_detail=minimal or full')
486 end select
487 end subroutine mt_validate_common_params
488
489 subroutine mt_validate_trace_integrator(mode)
490 character(len=*), intent(in) :: mode
491
492 character(len=mt_task_name_len) :: integrator
493
494 integrator=mt_lowercase(trim(mt_trace_integrator))
495 select case (trim(integrator))
496 case ('rk2')
497 ! RK2 is the default tracing path; product-specific guards live below.
498 case ('rk45_cartesian')
499 if (trim(mode)/='seed_products' .and. trim(mode)/='volume_vti' .and. &
500 trim(mode)/='arbitrary_plane_products' .and. &
501 trim(mode)/='axis_plane_full_vtu' .and. &
502 trim(mode)/='axis_plane_csv') then
503 write(*,'(a)') 'mt_trace_integrator=rk45_cartesian supports '// &
504 'only Cartesian seed_products, volume_vti, arbitrary_plane_products, '// &
505 'or axis-plane products'
506 flush(6)
507 call mpistop('mt_trace_integrator=rk45_cartesian supports '// &
508 'only seed_products, volume_vti, arbitrary_plane_products, '// &
509 'or axis-plane products')
510 endif
511 if (ndim/=3) then
512 call mpistop('mt_trace_integrator=rk45_cartesian requires 3D Cartesian geometry')
513 endif
514 {^ifthreed
515 select case (geo_coordinate)
516 case (geo_cartesian,geo_cartesian_stretched)
517 case default
518 write(*,'(a)') 'mt_trace_integrator=rk45_cartesian is Cartesian-only'
519 flush(6)
520 call mpistop('mt_trace_integrator=rk45_cartesian is Cartesian-only')
521 end select
522 }
523 if (mt_rk45_atol<0.d0 .or. mt_rk45_rtol<0.d0 .or. &
524 mt_rk45_atol+mt_rk45_rtol<=0.d0) then
525 call mpistop('mt_trace_integrator=rk45_cartesian requires '// &
526 'non-negative tolerances with atol+rtol > 0')
527 endif
528 if (mt_rk45_safety<=0.d0 .or. mt_rk45_safety>1.d0) then
529 call mpistop('mt_rk45_safety must be in (0,1]')
530 endif
531 if (mt_rk45_min_shrink<=0.d0 .or. mt_rk45_min_shrink>1.d0) then
532 call mpistop('mt_rk45_min_shrink must be in (0,1]')
533 endif
534 if (mt_rk45_max_grow<1.d0) then
535 call mpistop('mt_rk45_max_grow must be >= 1')
536 endif
537 if (mt_rk45_tangent_floor<=0.d0) then
538 call mpistop('mt_rk45_tangent_floor must be > 0')
539 endif
540 if (mt_rk45_tangent_rtol<=0.d0) then
541 call mpistop('mt_rk45_tangent_rtol must be > 0')
542 endif
543 case ('rk45_spherical')
544 if (trim(mode)/='seed_products' .and. &
545 trim(mode)/='spherical_cloud_products' .and. &
546 trim(mode)/='spherical_surface_products') then
547 write(*,'(a)') 'mt_trace_integrator=rk45_spherical supports '// &
548 'only spherical seed_products, spherical_cloud_products, '// &
549 'or spherical_surface_products'
550 flush(6)
551 call mpistop('mt_trace_integrator=rk45_spherical supports '// &
552 'only seed_products, spherical_cloud_products, '// &
553 'or spherical_surface_products')
554 endif
555 if (ndim/=3) then
556 call mpistop('mt_trace_integrator=rk45_spherical requires 3D spherical geometry')
557 endif
558 {^ifthreed
559 if (geo_coordinate/=geo_spherical) then
560 write(*,'(a)') 'mt_trace_integrator=rk45_spherical is spherical-only'
561 flush(6)
562 call mpistop('mt_trace_integrator=rk45_spherical is spherical-only')
563 endif
564 call mt_validate_periodic_phi()
565 }
566 if (mt_compute_q) then
567 {^ifthreed
568 if (geo_coordinate/=geo_spherical) then
569 call mpistop('mt_trace_integrator=rk45_spherical standard '// &
570 'logQ currently requires spherical geometry')
571 endif
572 }
573 endif
574 if (mt_rk45_atol<0.d0 .or. mt_rk45_rtol<0.d0 .or. &
575 mt_rk45_atol+mt_rk45_rtol<=0.d0) then
576 call mpistop('mt_trace_integrator=rk45_spherical requires '// &
577 'non-negative tolerances with atol+rtol > 0')
578 endif
579 if (mt_rk45_safety<=0.d0 .or. mt_rk45_safety>1.d0) then
580 call mpistop('mt_rk45_safety must be in (0,1]')
581 endif
582 if (mt_rk45_min_shrink<=0.d0 .or. mt_rk45_min_shrink>1.d0) then
583 call mpistop('mt_rk45_min_shrink must be in (0,1]')
584 endif
585 if (mt_rk45_max_grow<1.d0) then
586 call mpistop('mt_rk45_max_grow must be >= 1')
587 endif
588 if (mt_rk45_tangent_floor<=0.d0) then
589 call mpistop('mt_rk45_tangent_floor must be > 0')
590 endif
591 if (mt_rk45_tangent_rtol<=0.d0) then
592 call mpistop('mt_rk45_tangent_rtol must be > 0')
593 endif
594 case default
595 call mpistop('mt_trace_integrator must be rk2, rk45_cartesian, or rk45_spherical')
596 end select
597 if (mt_rk45_tangent_diagnostic) then
598 if (trim(mode)/='seed_products') then
599 call mpistop('mt_rk45_tangent_diagnostic requires seed_products')
600 endif
601 if (trim(integrator)/='rk45_cartesian') then
602 call mpistop('mt_rk45_tangent_diagnostic requires '// &
603 'mt_trace_integrator=rk45_cartesian')
604 endif
605 if (mt_compute_q .or. mt_compute_qperp) then
606 call mpistop('mt_rk45_tangent_diagnostic is q0 diagnostic-only; '// &
607 'disable public Q and Qperp')
608 endif
609 if (ndim/=3 .or. .not.slab_uniform) then
610 call mpistop('mt_rk45_tangent_diagnostic requires 3D uniform Cartesian geometry')
611 endif
612 {^ifthreed
613 if (geo_coordinate/=geo_cartesian) then
614 call mpistop('mt_rk45_tangent_diagnostic requires Cartesian geometry')
615 endif
616 }
617 endif
618 if (mt_rk2_fusion_diagnostic) then
619 if (trim(mode)/='seed_products') then
620 call mpistop('mt_rk2_fusion_diagnostic requires seed_products')
621 endif
622 if (trim(integrator)/='rk2') then
623 call mpistop('mt_rk2_fusion_diagnostic requires '// &
624 'mt_trace_integrator=rk2')
625 endif
626 if (.not.mt_compute_twist) then
627 call mpistop('mt_rk2_fusion_diagnostic requires twist diagnostics')
628 endif
629 if (mt_compute_q .or. mt_compute_qperp) then
630 call mpistop('mt_rk2_fusion_diagnostic is q0 diagnostic-only; '// &
631 'disable public Q and Qperp')
632 endif
633 endif
634 end subroutine mt_validate_trace_integrator
635
636 subroutine mt_apply_trace_step_control()
637 character(len=mt_task_name_len) :: step_mode
638 double precision :: hmin,dl_eff,dl_cap
639 integer :: status
640
641 step_mode=mt_lowercase(trim(mt_step_control))
642 select case (trim(step_mode))
643 case ('cell_fraction')
644 if ((geo_coordinate==geo_cartesian .or. &
645 geo_coordinate==geo_cartesian_stretched .or. &
646 geo_coordinate==geo_spherical) .and. mt_dl<=0.d0) then
647 dl_cap=mt_domain_diagonal()
648 if (dl_cap<=0.d0) then
649 call mpistop('mt_step_control=cell_fraction could not determine '// &
650 'domain step cap')
651 endif
652 mt_dl=dl_cap
653 write(*,'(a,es16.8,a,es16.8,a,es16.8)') &
654 'mt_step_control=cell_fraction: mt_step_fraction=', &
655 mt_step_fraction,', automatic dL_cap=',mt_dl, &
656 ', mt_dL_min=',mt_dl_min
657 else
658 write(*,'(a,es16.8,a,es16.8,a,es16.8)') &
659 'mt_step_control=cell_fraction: mt_step_fraction=', &
660 mt_step_fraction,', mt_dL_cap=',mt_dl, &
661 ', mt_dL_min=',mt_dl_min
662 endif
663 call trace_set_step_control('cell_fraction',mt_step_fraction,mt_dl_min)
664 case ('global_cell_fraction')
665 select case (geo_coordinate)
666 case (geo_cartesian,geo_cartesian_stretched)
667 call trace_cartesian_global_min_cell_size(hmin,status)
668 case (geo_spherical)
669 call trace_spherical_global_min_cell_size(hmin,status)
670 case default
671 status=trace_status_unsupported_geometry
672 hmin=-1.d0
673 end select
674 if (status/=trace_status_active .or. hmin<=0.d0) then
675 call mpistop('mt_step_control=global_cell_fraction could not determine h_global_min')
676 endif
677 dl_eff=mt_step_fraction*hmin
678 if (mt_dl>0.d0) dl_eff=min(dl_eff,mt_dl)
679 if (mt_dl_min>0.d0) then
680 if (mt_dl>0.d0) then
681 dl_eff=max(dl_eff,min(mt_dl_min,mt_dl))
682 else
683 dl_eff=max(dl_eff,mt_dl_min)
684 endif
685 endif
686 if (dl_eff<=0.d0) then
687 call mpistop('mt_step_control=global_cell_fraction produced non-positive mt_dL')
688 endif
689 if (mt_dl>0.d0) then
690 write(*,'(a,es16.8,a,es16.8,a,es16.8,a,es16.8)') &
691 'mt_step_control=global_cell_fraction: h_global_min=',hmin, &
692 ', mt_step_fraction=',mt_step_fraction,', mt_dL_cap=',mt_dl, &
693 ', effective_mt_dL=',dl_eff
694 else
695 write(*,'(a,es16.8,a,es16.8,a,es16.8)') &
696 'mt_step_control=global_cell_fraction: h_global_min=',hmin, &
697 ', mt_step_fraction=',mt_step_fraction,', effective_mt_dL=',dl_eff
698 endif
699 mt_dl=dl_eff
700 call trace_set_step_control('fixed',mt_step_fraction,mt_dl_min)
701 case default
702 call trace_set_step_control('fixed',mt_step_fraction,mt_dl_min)
703 end select
704 end subroutine mt_apply_trace_step_control
705
706 subroutine mt_apply_auto_max_steps()
707 character(len=mt_task_name_len) :: step_mode
708 double precision :: hmin,step_est,ldiag,nsteps_real
709 integer :: status
710
711 if (mt_max_steps>0) return
712
713 ldiag=mt_domain_diagonal()
714 if (ldiag<=0.d0) then
715 call mpistop('mt_max_steps auto could not determine domain diagonal')
716 endif
717
718 step_mode=mt_lowercase(trim(mt_step_control))
719 select case (trim(step_mode))
720 case ('fixed')
721 step_est=mt_dl
722 case ('cell_fraction','global_cell_fraction')
723 select case (geo_coordinate)
724 case (geo_cartesian,geo_cartesian_stretched)
725 call trace_cartesian_global_min_cell_size(hmin,status)
726 case (geo_spherical)
727 call trace_spherical_global_min_cell_size(hmin,status)
728 case default
729 status=trace_status_unsupported_geometry
730 hmin=-1.d0
731 end select
732 if (status/=trace_status_active .or. hmin<=0.d0) then
733 call mpistop('mt_max_steps auto could not determine h_global_min')
734 endif
735 step_est=mt_step_fraction*hmin
736 if (mt_dl>0.d0) step_est=min(step_est,mt_dl)
737 case default
738 step_est=mt_dl
739 end select
740
741 if (step_est<=0.d0) then
742 call mpistop('mt_max_steps auto produced non-positive step estimate')
743 endif
744 nsteps_real=mt_max_steps_factor*ldiag/step_est
745 if (nsteps_real>dble(huge(mt_max_steps)-1)) then
746 call mpistop('mt_max_steps auto estimate exceeds integer range')
747 endif
748 mt_max_steps=max(1,ceiling(nsteps_real))
749 write(*,'(a,es16.8,a,es16.8,a,es16.8,a,es16.8,a,i0)') &
750 'mt_max_steps auto: Ldiag=',ldiag,', step_est=',step_est, &
751 ', factor=',mt_max_steps_factor,', nsteps_real=',nsteps_real, &
752 ', mt_max_steps=',mt_max_steps
753 end subroutine mt_apply_auto_max_steps
754
755 double precision function mt_domain_diagonal() result(Ldiag)
756 integer :: i,j,k,n,m
757 double precision :: r,theta,phi,dist
758 double precision :: corners(8,3),dx(3)
759
760 ldiag=abs(xprobmax1-xprobmin1)
761 {^ifthreed
762 if (geo_coordinate==geo_spherical) then
763 n=0
764 do i=0,1
765 if (i==0) then
766 r=xprobmin1
767 else
768 r=xprobmax1
769 endif
770 do j=0,1
771 if (j==0) then
772 theta=xprobmin2
773 else
774 theta=xprobmax2
775 endif
776 do k=0,1
777 if (k==0) then
778 phi=xprobmin3
779 else
780 phi=xprobmax3
781 endif
782 n=n+1
783 corners(n,1)=r*dsin(theta)*dcos(phi)
784 corners(n,2)=r*dsin(theta)*dsin(phi)
785 corners(n,3)=r*dcos(theta)
786 end do
787 end do
788 end do
789 ldiag=0.d0
790 do i=1,n-1
791 do j=i+1,n
792 do m=1,3
793 dx(m)=corners(i,m)-corners(j,m)
794 end do
795 dist=dsqrt(sum(dx*dx))
796 ldiag=max(ldiag,dist)
797 end do
798 end do
799 else
800 ldiag=dsqrt((xprobmax1-xprobmin1)**2+ &
801 (xprobmax2-xprobmin2)**2+(xprobmax3-xprobmin3)**2)
802 endif
803 }
804 end function mt_domain_diagonal
805
806 subroutine mt_run_axis_plane_full_vtu_task()
807 character(len=mt_task_name_len) :: plane
808 character(len=mt_task_name_len) :: output_file
809 logical :: minimal_output
810
811 plane=mt_lowercase(trim(mt_plane))
812 minimal_output=.not.mt_vtk_detail_is_full()
813 if (minimal_output) then
814 call mt_resolve_output_file('axis_plane_full_vtu','.vti', &
815 '_'//trim(plane)//'_minimal.vti',output_file)
816 else
817 call mt_resolve_output_file('axis_plane_full_vtu','.vtu', &
818 '_'//trim(plane)//'_full.vtu',output_file)
819 endif
820 if (.not.minimal_output .and. &
821 (mt_compute_twist .or. mt_compute_q .or. mt_compute_qperp)) then
822 write(*,'(a)') 'mt_run_topology_task: axis_plane_full_vtu ignores compute flags'
823 write(*,'(a)') 'mt_run_topology_task: it always writes full plane products'
824 endif
825
826 select case (trim(plane))
827 case ('xy')
828 call mt_require_real('mt_xmin',mt_xmin)
829 call mt_require_real('mt_xmax',mt_xmax)
830 call mt_require_real('mt_ymin',mt_ymin)
831 call mt_require_real('mt_ymax',mt_ymax)
832 call mt_require_real('mt_z0',mt_z0)
833 call mt_require_positive_int('mt_nx',mt_nx)
834 call mt_require_positive_int('mt_ny',mt_ny)
835 call mt_require_ordered('mt_xmin','mt_xmax',mt_xmin,mt_xmax)
836 call mt_require_ordered('mt_ymin','mt_ymax',mt_ymin,mt_ymax)
837 if (minimal_output) then
838 write(*,'(a)') 'mt_run_topology_task: writing axis-plane minimal VTI '//trim(output_file)
839 if (mt_b_min>0.d0) then
840 call mt_qsl_plane_vti_xy(mt_xmin,mt_xmax,mt_nx,mt_ymin,mt_ymax, &
841 mt_ny,mt_z0,mt_dl,mt_max_steps,trim(output_file), &
842 mt_compute_length,mt_compute_twist,mt_compute_q, &
843 mt_compute_qperp,b_min=mt_b_min)
844 else
845 call mt_qsl_plane_vti_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 mt_compute_length,mt_compute_twist,mt_compute_q, &
848 mt_compute_qperp)
849 endif
850 else
851 write(*,'(a)') 'mt_run_topology_task: writing axis-plane full VTU '//trim(output_file)
852 if (mt_b_min>0.d0) then
853 call mt_qsl_plane_vtu_xy(mt_xmin,mt_xmax,mt_nx,mt_ymin,mt_ymax, &
854 mt_ny,mt_z0,mt_dl,mt_max_steps,trim(output_file), &
855 b_min=mt_b_min)
856 else
857 call mt_qsl_plane_vtu_xy(mt_xmin,mt_xmax,mt_nx,mt_ymin,mt_ymax, &
858 mt_ny,mt_z0,mt_dl,mt_max_steps,trim(output_file))
859 endif
860 endif
861 case ('xz')
862 call mt_require_real('mt_xmin',mt_xmin)
863 call mt_require_real('mt_xmax',mt_xmax)
864 call mt_require_real('mt_zmin',mt_zmin)
865 call mt_require_real('mt_zmax',mt_zmax)
866 call mt_require_real('mt_y0',mt_y0)
867 call mt_require_positive_int('mt_nx',mt_nx)
868 call mt_require_positive_int('mt_nz',mt_nz)
869 call mt_require_ordered('mt_xmin','mt_xmax',mt_xmin,mt_xmax)
870 call mt_require_ordered('mt_zmin','mt_zmax',mt_zmin,mt_zmax)
871 if (minimal_output) then
872 write(*,'(a)') 'mt_run_topology_task: writing axis-plane minimal VTI '//trim(output_file)
873 if (mt_b_min>0.d0) then
874 call mt_qsl_plane_vti_xz(mt_xmin,mt_xmax,mt_nx,mt_zmin,mt_zmax, &
875 mt_nz,mt_y0,mt_dl,mt_max_steps,trim(output_file), &
876 mt_compute_length,mt_compute_twist,mt_compute_q, &
877 mt_compute_qperp,b_min=mt_b_min)
878 else
879 call mt_qsl_plane_vti_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 mt_compute_length,mt_compute_twist,mt_compute_q, &
882 mt_compute_qperp)
883 endif
884 else
885 write(*,'(a)') 'mt_run_topology_task: writing axis-plane full VTU '//trim(output_file)
886 if (mt_b_min>0.d0) then
887 call mt_qsl_plane_vtu_xz(mt_xmin,mt_xmax,mt_nx,mt_zmin,mt_zmax, &
888 mt_nz,mt_y0,mt_dl,mt_max_steps,trim(output_file), &
889 b_min=mt_b_min)
890 else
891 call mt_qsl_plane_vtu_xz(mt_xmin,mt_xmax,mt_nx,mt_zmin,mt_zmax, &
892 mt_nz,mt_y0,mt_dl,mt_max_steps,trim(output_file))
893 endif
894 endif
895 case ('yz')
896 call mt_require_real('mt_ymin',mt_ymin)
897 call mt_require_real('mt_ymax',mt_ymax)
898 call mt_require_real('mt_zmin',mt_zmin)
899 call mt_require_real('mt_zmax',mt_zmax)
900 call mt_require_real('mt_x0',mt_x0)
901 call mt_require_positive_int('mt_ny',mt_ny)
902 call mt_require_positive_int('mt_nz',mt_nz)
903 call mt_require_ordered('mt_ymin','mt_ymax',mt_ymin,mt_ymax)
904 call mt_require_ordered('mt_zmin','mt_zmax',mt_zmin,mt_zmax)
905 if (minimal_output) then
906 write(*,'(a)') 'mt_run_topology_task: writing axis-plane minimal VTI '//trim(output_file)
907 if (mt_b_min>0.d0) then
908 call mt_qsl_plane_vti_yz(mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax, &
909 mt_nz,mt_x0,mt_dl,mt_max_steps,trim(output_file), &
910 mt_compute_length,mt_compute_twist,mt_compute_q, &
911 mt_compute_qperp,b_min=mt_b_min)
912 else
913 call mt_qsl_plane_vti_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 mt_compute_length,mt_compute_twist,mt_compute_q, &
916 mt_compute_qperp)
917 endif
918 else
919 write(*,'(a)') 'mt_run_topology_task: writing axis-plane full VTU '//trim(output_file)
920 if (mt_b_min>0.d0) then
921 call mt_qsl_plane_vtu_yz(mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax, &
922 mt_nz,mt_x0,mt_dl,mt_max_steps,trim(output_file), &
923 b_min=mt_b_min)
924 else
925 call mt_qsl_plane_vtu_yz(mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax, &
926 mt_nz,mt_x0,mt_dl,mt_max_steps,trim(output_file))
927 endif
928 endif
929 case default
930 call mpistop('mt_run_topology_task: axis_plane_full_vtu requires mt_plane=xy, xz, or yz')
931 end select
932 end subroutine mt_run_axis_plane_full_vtu_task
933
934 subroutine mt_run_axis_plane_csv_task()
935 character(len=mt_task_name_len) :: plane
936 character(len=mt_task_name_len) :: length_csv,twist_csv
937 character(len=mt_task_name_len) :: q_csv
938 character(len=mt_task_name_len) :: qperp_csv
939
940 if (len_trim(mt_output_prefix)==0) then
941 call mpistop('axis_plane_csv requires mt_output_prefix')
942 endif
943 if (len_trim(mt_output_file)>0) then
944 write(*,'(a)') 'mt_run_topology_task: axis_plane_csv ignores mt_output_file'
945 write(*,'(a)') 'mt_run_topology_task: axis_plane_csv uses mt_output_prefix for CSV outputs'
946 endif
947
948 plane=mt_lowercase(trim(mt_plane))
949 call mt_resolve_prefix_file('_'//trim(plane)//'_length.csv', &
950 length_csv,'axis_plane_csv length requires mt_output_prefix')
951 twist_csv=''
952 q_csv=''
953 qperp_csv=''
954 if (mt_compute_twist) then
955 call mt_resolve_prefix_file('_'//trim(plane)//'_twist.csv', &
956 twist_csv,'axis_plane_csv twist requires mt_output_prefix')
957 endif
958 if (mt_compute_q) then
959 call mt_resolve_prefix_file('_'//trim(plane)//'_q.csv', &
960 q_csv,'axis_plane_csv Q requires mt_output_prefix')
961 endif
962 if (mt_compute_qperp) then
963 call mt_resolve_prefix_file('_'//trim(plane)//'_qperp_method2.csv', &
964 qperp_csv,'axis_plane_csv Qperp requires mt_output_prefix')
965 endif
966
967 select case (trim(plane))
968 case ('xy')
969 call mt_require_real('mt_xmin',mt_xmin)
970 call mt_require_real('mt_xmax',mt_xmax)
971 call mt_require_real('mt_ymin',mt_ymin)
972 call mt_require_real('mt_ymax',mt_ymax)
973 call mt_require_real('mt_z0',mt_z0)
974 call mt_require_positive_int('mt_nx',mt_nx)
975 call mt_require_positive_int('mt_ny',mt_ny)
976 call mt_require_ordered('mt_xmin','mt_xmax',mt_xmin,mt_xmax)
977 call mt_require_ordered('mt_ymin','mt_ymax',mt_ymin,mt_ymax)
978 if (mt_b_min>0.d0) then
979 call mt_axis_plane_products_csv_axis(mt_xmin,mt_xmax,mt_nx, &
980 mt_ymin,mt_ymax,mt_ny,mt_z0,1,2,3,mt_dl,mt_max_steps, &
981 trim(length_csv),trim(twist_csv),trim(q_csv), &
982 trim(qperp_csv),'mt_axis_plane_products_csv_xy','ix,iy', &
983 'ix,iy',b_min=mt_b_min)
984 else
985 call mt_axis_plane_products_csv_axis(mt_xmin,mt_xmax,mt_nx, &
986 mt_ymin,mt_ymax,mt_ny,mt_z0,1,2,3,mt_dl,mt_max_steps, &
987 trim(length_csv),trim(twist_csv),trim(q_csv), &
988 trim(qperp_csv),'mt_axis_plane_products_csv_xy','ix,iy', &
989 'ix,iy')
990 endif
991 case ('xz')
992 call mt_require_real('mt_xmin',mt_xmin)
993 call mt_require_real('mt_xmax',mt_xmax)
994 call mt_require_real('mt_zmin',mt_zmin)
995 call mt_require_real('mt_zmax',mt_zmax)
996 call mt_require_real('mt_y0',mt_y0)
997 call mt_require_positive_int('mt_nx',mt_nx)
998 call mt_require_positive_int('mt_nz',mt_nz)
999 call mt_require_ordered('mt_xmin','mt_xmax',mt_xmin,mt_xmax)
1000 call mt_require_ordered('mt_zmin','mt_zmax',mt_zmin,mt_zmax)
1001 if (mt_b_min>0.d0) then
1002 call mt_axis_plane_products_csv_axis(mt_xmin,mt_xmax,mt_nx, &
1003 mt_zmin,mt_zmax,mt_nz,mt_y0,1,3,2,mt_dl,mt_max_steps, &
1004 trim(length_csv),trim(twist_csv),trim(q_csv), &
1005 trim(qperp_csv),'mt_axis_plane_products_csv_xz','ix,iz', &
1006 'i,j',b_min=mt_b_min)
1007 else
1008 call mt_axis_plane_products_csv_axis(mt_xmin,mt_xmax,mt_nx, &
1009 mt_zmin,mt_zmax,mt_nz,mt_y0,1,3,2,mt_dl,mt_max_steps, &
1010 trim(length_csv),trim(twist_csv),trim(q_csv), &
1011 trim(qperp_csv),'mt_axis_plane_products_csv_xz','ix,iz', &
1012 'i,j')
1013 endif
1014 case ('yz')
1015 call mt_require_real('mt_ymin',mt_ymin)
1016 call mt_require_real('mt_ymax',mt_ymax)
1017 call mt_require_real('mt_zmin',mt_zmin)
1018 call mt_require_real('mt_zmax',mt_zmax)
1019 call mt_require_real('mt_x0',mt_x0)
1020 call mt_require_positive_int('mt_ny',mt_ny)
1021 call mt_require_positive_int('mt_nz',mt_nz)
1022 call mt_require_ordered('mt_ymin','mt_ymax',mt_ymin,mt_ymax)
1023 call mt_require_ordered('mt_zmin','mt_zmax',mt_zmin,mt_zmax)
1024 if (mt_b_min>0.d0) then
1025 call mt_axis_plane_products_csv_axis(mt_ymin,mt_ymax,mt_ny, &
1026 mt_zmin,mt_zmax,mt_nz,mt_x0,2,3,1,mt_dl,mt_max_steps, &
1027 trim(length_csv),trim(twist_csv),trim(q_csv), &
1028 trim(qperp_csv),'mt_axis_plane_products_csv_yz','iy,iz', &
1029 'i,j',b_min=mt_b_min)
1030 else
1031 call mt_axis_plane_products_csv_axis(mt_ymin,mt_ymax,mt_ny, &
1032 mt_zmin,mt_zmax,mt_nz,mt_x0,2,3,1,mt_dl,mt_max_steps, &
1033 trim(length_csv),trim(twist_csv),trim(q_csv), &
1034 trim(qperp_csv),'mt_axis_plane_products_csv_yz','iy,iz', &
1035 'i,j')
1036 endif
1037 case default
1038 call mpistop('mt_run_topology_task: axis_plane_csv requires mt_plane=xy, xz, or yz')
1039 end select
1040
1041 write(*,'(a)') 'mt_run_topology_task: wrote axis-plane CSV length '// &
1042 trim(length_csv)
1043 if (mt_compute_twist) write(*,'(a)') &
1044 'mt_run_topology_task: wrote axis-plane CSV twist '//trim(twist_csv)
1045 if (mt_compute_q) write(*,'(a)') &
1046 'mt_run_topology_task: wrote axis-plane CSV Q '//trim(q_csv)
1047 if (mt_compute_qperp) write(*,'(a)') &
1048 'mt_run_topology_task: wrote axis-plane CSV Qperp '//trim(qperp_csv)
1049 end subroutine mt_run_axis_plane_csv_task
1050
1051 subroutine mt_run_volume_vti_task()
1052 character(len=mt_task_name_len) :: output_file
1053
1054 call mt_resolve_output_file('volume_vti','.vti','_volume.vti', &
1055 output_file)
1056 call mt_require_real('mt_xmin',mt_xmin)
1057 call mt_require_real('mt_xmax',mt_xmax)
1058 call mt_require_real('mt_ymin',mt_ymin)
1059 call mt_require_real('mt_ymax',mt_ymax)
1060 call mt_require_real('mt_zmin',mt_zmin)
1061 call mt_require_real('mt_zmax',mt_zmax)
1062 call mt_require_positive_int('mt_nx',mt_nx)
1063 call mt_require_positive_int('mt_ny',mt_ny)
1064 call mt_require_positive_int('mt_nz',mt_nz)
1065 call mt_require_ordered('mt_xmin','mt_xmax',mt_xmin,mt_xmax)
1066 call mt_require_ordered('mt_ymin','mt_ymax',mt_ymin,mt_ymax)
1067 call mt_require_ordered('mt_zmin','mt_zmax',mt_zmin,mt_zmax)
1068 write(*,'(a)') 'mt_run_topology_task: writing volume VTI '//trim(output_file)
1069 if (mt_b_min>0.d0) then
1070 if (mt_chunk_nz>0) then
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 chunk_nz=mt_chunk_nz)
1078 else
1079 call mt_fieldline_products_volume_vti(mt_xmin,mt_xmax,mt_nx, &
1080 mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax,mt_nz, &
1081 mt_dl,mt_max_steps,trim(output_file),b_min=mt_b_min, &
1082 compute_twist=mt_compute_twist, &
1083 compute_length=mt_compute_length, &
1084 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp)
1085 endif
1086 else
1087 if (mt_chunk_nz>0) then
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 chunk_nz=mt_chunk_nz)
1095 else
1096 call mt_fieldline_products_volume_vti(mt_xmin,mt_xmax,mt_nx, &
1097 mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax,mt_nz, &
1098 mt_dl,mt_max_steps,trim(output_file), &
1099 compute_twist=mt_compute_twist, &
1100 compute_length=mt_compute_length, &
1101 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp)
1102 endif
1103 endif
1104 end subroutine mt_run_volume_vti_task
1105
1106 subroutine mt_run_arbitrary_plane_products_task()
1107 character(len=mt_task_name_len) :: vtu_file,csv_file
1108
1109 call mt_resolve_output_file('arbitrary_plane_products','.vtu', &
1110 '_arbitrary_plane_products.vtu',vtu_file)
1111 csv_file=''
1112 if (mt_write_csv) then
1113 call mt_resolve_prefix_file('_arbitrary_plane_products.csv',csv_file, &
1114 'arbitrary_plane_products CSV requires mt_output_prefix')
1115 endif
1116 call mt_require_real('mt_origin(1)',mt_origin(1))
1117 call mt_require_real('mt_origin(2)',mt_origin(2))
1118 call mt_require_real('mt_origin(3)',mt_origin(3))
1119 call mt_require_real('mt_e1(1)',mt_e1(1))
1120 call mt_require_real('mt_e1(2)',mt_e1(2))
1121 call mt_require_real('mt_e1(3)',mt_e1(3))
1122 call mt_require_real('mt_e2(1)',mt_e2(1))
1123 call mt_require_real('mt_e2(2)',mt_e2(2))
1124 call mt_require_real('mt_e2(3)',mt_e2(3))
1125 call mt_require_real('mt_s1min',mt_s1min)
1126 call mt_require_real('mt_s1max',mt_s1max)
1127 call mt_require_real('mt_s2min',mt_s2min)
1128 call mt_require_real('mt_s2max',mt_s2max)
1129 call mt_require_positive_int('mt_n1',mt_n1)
1130 call mt_require_positive_int('mt_n2',mt_n2)
1131 call mt_require_ordered('mt_s1min','mt_s1max',mt_s1min,mt_s1max)
1132 call mt_require_ordered('mt_s2min','mt_s2max',mt_s2min,mt_s2max)
1133
1134 write(*,'(a)') 'mt_run_topology_task: writing arbitrary-plane VTU '// &
1135 trim(vtu_file)
1136 if (mt_write_csv) then
1137 write(*,'(a)') 'mt_run_topology_task: writing arbitrary-plane CSV '// &
1138 trim(csv_file)
1139 endif
1140
1141 if (mt_b_min>0.d0) then
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 b_min=mt_b_min,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 else
1150 call mt_fieldline_products_plane_arbitrary(mt_origin(1:ndim), &
1151 mt_e1(1:ndim),mt_e2(1:ndim),mt_s1min,mt_s1max,mt_n1, &
1152 mt_s2min,mt_s2max,mt_n2,mt_dl,mt_max_steps,trim(csv_file), &
1153 compute_length=mt_compute_length, &
1154 compute_twist=mt_compute_twist, &
1155 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1156 vtu_file=trim(vtu_file),write_csv=mt_write_csv)
1157 endif
1158 end subroutine mt_run_arbitrary_plane_products_task
1159
1160 subroutine mt_run_seed_products_task()
1161 character(len=mt_task_name_len) :: csv_file,vtu_file,diag_file
1162 character(len=mt_task_name_len) :: rk2_diag_file
1163 double precision, allocatable :: seeds(:,:)
1164 integer :: nseed
1165
1166 if (len_trim(mt_output_prefix)==0) then
1167 call mpistop('seed_products requires mt_output_prefix')
1168 endif
1169 if (len_trim(mt_output_file)>0) then
1170 write(*,'(a)') 'mt_run_topology_task: seed_products ignores mt_output_file'
1171 write(*,'(a)') 'mt_run_topology_task: seed_products uses mt_output_prefix for CSV and VTU'
1172 endif
1173 if (len_trim(mt_seed_file)==0) then
1174 call mpistop('seed_products requires mt_seed_file')
1175 endif
1176
1177 csv_file=''
1178 if (mt_write_csv) then
1179 call mt_resolve_prefix_file('_seed_products.csv',csv_file, &
1180 'seed_products CSV requires mt_output_prefix')
1181 endif
1182 call mt_resolve_prefix_file('_seed_products.vtu',vtu_file, &
1183 'seed_products VTU requires mt_output_prefix')
1184 if (mt_rk45_tangent_diagnostic) then
1185 call mt_resolve_prefix_file('_rk45_tangent_diag.csv',diag_file, &
1186 'seed_products RK45 tangent diagnostic requires mt_output_prefix')
1187 endif
1188 if (mt_rk2_fusion_diagnostic) then
1189 call mt_resolve_prefix_file('_rk2_fusion_diag.csv',rk2_diag_file, &
1190 'seed_products RK2 fusion diagnostic requires mt_output_prefix')
1191 endif
1192 call mt_read_seed_file(trim(mt_seed_file),seeds,nseed)
1193
1194 if (mt_write_csv) write(*,'(a)') &
1195 'mt_run_topology_task: writing seed-products CSV '//trim(csv_file)
1196 write(*,'(a)') 'mt_run_topology_task: writing seed-products VTU '// &
1197 trim(vtu_file)
1198
1199 if (mt_b_min>0.d0) then
1200 call mt_fieldline_products_seeds(seeds,nseed,mt_dl,mt_max_steps, &
1201 trim(csv_file),b_min=mt_b_min,compute_length=mt_compute_length, &
1202 compute_twist=mt_compute_twist, &
1203 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1204 vtu_file=trim(vtu_file))
1205 if (mt_rk45_tangent_diagnostic) then
1206 write(*,'(a)') 'mt_run_topology_task: writing RK45 tangent '// &
1207 'diagnostic CSV '//trim(diag_file)
1208 call mt_rk45_tangent_diagnostic_seeds(seeds,nseed,mt_dl, &
1209 mt_max_steps,trim(diag_file),b_min=mt_b_min)
1210 endif
1211 if (mt_rk2_fusion_diagnostic) then
1212 write(*,'(a)') 'mt_run_topology_task: writing RK2 fusion '// &
1213 'diagnostic CSV '//trim(rk2_diag_file)
1214 call mt_rk2_fusion_diagnostic_seeds(seeds,nseed,mt_dl, &
1215 mt_max_steps,trim(rk2_diag_file),b_min=mt_b_min)
1216 endif
1217 else
1218 call mt_fieldline_products_seeds(seeds,nseed,mt_dl,mt_max_steps, &
1219 trim(csv_file),compute_length=mt_compute_length, &
1220 compute_twist=mt_compute_twist, &
1221 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1222 vtu_file=trim(vtu_file))
1223 if (mt_rk45_tangent_diagnostic) then
1224 write(*,'(a)') 'mt_run_topology_task: writing RK45 tangent '// &
1225 'diagnostic CSV '//trim(diag_file)
1226 call mt_rk45_tangent_diagnostic_seeds(seeds,nseed,mt_dl, &
1227 mt_max_steps,trim(diag_file))
1228 endif
1229 if (mt_rk2_fusion_diagnostic) then
1230 write(*,'(a)') 'mt_run_topology_task: writing RK2 fusion '// &
1231 'diagnostic CSV '//trim(rk2_diag_file)
1232 call mt_rk2_fusion_diagnostic_seeds(seeds,nseed,mt_dl, &
1233 mt_max_steps,trim(rk2_diag_file))
1234 endif
1235 endif
1236
1237 deallocate(seeds)
1238 end subroutine mt_run_seed_products_task
1239
1240 subroutine mt_run_spherical_surface_products_task()
1241 character(len=mt_task_name_len) :: surface,csv_file,vtu_file,suffix
1242 double precision :: seed_coord,s1_min,s1_max,s2_min,s2_max
1243 double precision :: seed_theta0,seed_phi0,seed_alpha
1244
1245 surface=mt_lowercase(trim(mt_seed_surface))
1246 if (len_trim(surface)==0) surface='rmin'
1247 select case (trim(surface))
1248 case ('rmin')
1249 seed_coord=xprobmin1
1250 case ('rconst','r_const')
1251 surface='rconst'
1252 call mt_require_real('mt_seed_coord',mt_seed_coord)
1253 seed_coord=mt_seed_coord
1254 if (seed_coord<xprobmin1 .or. seed_coord>xprobmax1) then
1255 call mpistop('spherical_surface_products requires rconst '// &
1256 'mt_seed_coord inside domain')
1257 endif
1258 {^ifthreed
1259 case ('theta_const','thetaconst')
1260 surface='theta_const'
1261 call mt_require_real('mt_seed_coord',mt_seed_coord)
1262 seed_coord=mt_seed_coord
1263 if (seed_coord<xprobmin2 .or. seed_coord>xprobmax2) then
1264 call mpistop('spherical_surface_products requires theta_const '// &
1265 'mt_seed_coord inside domain')
1266 endif
1267 case ('phi_const','phiconst')
1268 surface='phi_const'
1269 call mt_require_real('mt_seed_coord',mt_seed_coord)
1270 seed_coord=mt_seed_coord
1271 if (seed_coord<xprobmin3 .or. seed_coord>xprobmax3) then
1272 call mpistop('spherical_surface_products requires phi_const '// &
1273 'mt_seed_coord inside domain')
1274 endif
1275 case ('radial_plane','radialplane')
1276 surface='radial_plane'
1277 seed_coord=0.d0
1278 call mt_require_real('mt_seed_theta0',mt_seed_theta0)
1279 call mt_require_real('mt_seed_phi0',mt_seed_phi0)
1280 call mt_require_real('mt_seed_alpha',mt_seed_alpha)
1281 if (mt_seed_theta0<xprobmin2 .or. mt_seed_theta0>xprobmax2) then
1282 call mpistop('spherical_surface_products requires radial_plane '// &
1283 'mt_seed_theta0 inside domain')
1284 endif
1285 if (mt_seed_phi0<xprobmin3 .or. mt_seed_phi0>xprobmax3) then
1286 call mpistop('spherical_surface_products requires radial_plane '// &
1287 'mt_seed_phi0 inside domain')
1288 endif
1289 if (abs(dsin(mt_seed_theta0))<=1.d-12) then
1290 call mpistop('spherical_surface_products radial_plane requires '// &
1291 'mt_seed_theta0 away from the polar singularity')
1292 endif
1293 }
1294 case default
1295 call mpistop('spherical_surface_products supports '// &
1296 'mt_seed_surface=rmin, rconst, theta_const, phi_const, or radial_plane')
1297 end select
1298 call mt_require_positive_int('mt_n1',mt_n1)
1299 call mt_require_positive_int('mt_n2',mt_n2)
1300 s1_min=0.d0
1301 s1_max=0.d0
1302 s2_min=0.d0
1303 s2_max=0.d0
1304 {^ifthreed
1305 select case (trim(surface))
1306 case ('rmin','rconst')
1307 s1_min=xprobmin2
1308 s1_max=xprobmax2
1309 s2_min=xprobmin3
1310 s2_max=xprobmax3
1311 case ('theta_const')
1312 s1_min=xprobmin1
1313 s1_max=xprobmax1
1314 s2_min=xprobmin3
1315 s2_max=xprobmax3
1316 case ('phi_const')
1317 s1_min=xprobmin1
1318 s1_max=xprobmax1
1319 s2_min=xprobmin2
1320 s2_max=xprobmax2
1321 case ('radial_plane')
1322 s1_min=xprobmin1
1323 s1_max=xprobmax1
1324 s2_min=-0.5d0*min(xprobmax2-xprobmin2,xprobmax3-xprobmin3)
1325 s2_max= 0.5d0*min(xprobmax2-xprobmin2,xprobmax3-xprobmin3)
1326 end select
1327 }
1328 if (mt_is_set_real(mt_s1min)) s1_min=mt_s1min
1329 if (mt_is_set_real(mt_s1max)) s1_max=mt_s1max
1330 if (mt_is_set_real(mt_s2min)) s2_min=mt_s2min
1331 if (mt_is_set_real(mt_s2max)) s2_max=mt_s2max
1332 call mt_require_ordered('mt_s1min','mt_s1max',s1_min,s1_max)
1333 call mt_require_ordered('mt_s2min','mt_s2max',s2_min,s2_max)
1334
1335 csv_file=''
1336 if (mt_write_csv) then
1337 if (trim(surface)=='rmin') then
1338 suffix='_spherical_rmin_products.csv'
1339 else if (trim(surface)=='radial_plane') then
1340 suffix='_spherical_radial_plane_products.csv'
1341 else
1342 suffix='_spherical_'//trim(surface)//'_products.csv'
1343 endif
1344 call mt_resolve_prefix_file(trim(suffix),csv_file, &
1345 'spherical_surface_products CSV requires mt_output_prefix')
1346 endif
1347 if (trim(surface)=='rmin') then
1348 suffix='_spherical_rmin_products.vtu'
1349 else if (trim(surface)=='radial_plane') then
1350 suffix='_spherical_radial_plane_products.vtu'
1351 else
1352 suffix='_spherical_'//trim(surface)//'_products.vtu'
1353 endif
1354 call mt_resolve_output_file('spherical_surface_products','.vtu', &
1355 trim(suffix),vtu_file)
1356
1357 if (mt_write_csv) then
1358 write(*,'(a)') 'mt_run_topology_task: writing spherical '// &
1359 trim(surface)//' CSV '//trim(csv_file)
1360 endif
1361 write(*,'(a)') 'mt_run_topology_task: writing spherical '// &
1362 trim(surface)//' VTU '//trim(vtu_file)
1363
1364 if (mt_profile_spherical) then
1365 call trace_spherical_profile_reset()
1366 call trace_spherical_profile_set(.true.)
1367 endif
1368
1369 seed_theta0=mt_seed_theta0
1370 seed_phi0=mt_seed_phi0
1371 seed_alpha=mt_seed_alpha
1372 if (mt_b_min>0.d0) then
1373 call mt_fieldline_products_spherical_surface(trim(surface),seed_coord, &
1374 s1_min,s1_max,mt_n1,s2_min,s2_max,mt_n2,mt_dl,mt_max_steps, &
1375 trim(csv_file),trim(vtu_file),trim(mt_seed_layout), &
1376 seed_theta0,seed_phi0,seed_alpha, &
1377 compute_twist=mt_compute_twist,compute_q=mt_compute_q, &
1378 compute_qperp=mt_compute_qperp,b_min=mt_b_min)
1379 else
1380 call mt_fieldline_products_spherical_surface(trim(surface),seed_coord, &
1381 s1_min,s1_max,mt_n1,s2_min,s2_max,mt_n2,mt_dl,mt_max_steps, &
1382 trim(csv_file),trim(vtu_file),trim(mt_seed_layout), &
1383 seed_theta0,seed_phi0,seed_alpha, &
1384 compute_twist=mt_compute_twist,compute_q=mt_compute_q, &
1385 compute_qperp=mt_compute_qperp)
1386 endif
1387 if (mt_profile_spherical) then
1388 call trace_spherical_profile_report('spherical_surface_products '// &
1389 trim(surface))
1390 call trace_spherical_profile_set(.false.)
1391 endif
1392 end subroutine mt_run_spherical_surface_products_task
1393
1394 subroutine mt_run_spherical_cloud_products_task()
1395 character(len=mt_task_name_len) :: vtu_file
1396 double precision :: s1_min,s1_max,s2_min,s2_max,s3_min,s3_max
1397
1398 if (mt_write_csv) then
1399 write(*,'(a)') 'mt_run_topology_task: spherical_cloud_products '// &
1400 'does not write CSV; use seed_products for selected-point diagnostics'
1401 endif
1402 call mt_require_positive_int('mt_n1',mt_n1)
1403 call mt_require_positive_int('mt_n2',mt_n2)
1404 call mt_require_positive_int('mt_n3',mt_n3)
1405 s1_min=xprobmin1
1406 s1_max=xprobmax1
1407 s2_min=0.d0
1408 s2_max=0.d0
1409 s3_min=0.d0
1410 s3_max=0.d0
1411 {^ifthreed
1412 s2_min=xprobmin2
1413 s2_max=xprobmax2
1414 s3_min=xprobmin3
1415 s3_max=xprobmax3
1416 }
1417 if (mt_is_set_real(mt_s1min)) s1_min=mt_s1min
1418 if (mt_is_set_real(mt_s1max)) s1_max=mt_s1max
1419 if (mt_is_set_real(mt_s2min)) s2_min=mt_s2min
1420 if (mt_is_set_real(mt_s2max)) s2_max=mt_s2max
1421 if (mt_is_set_real(mt_s3min)) s3_min=mt_s3min
1422 if (mt_is_set_real(mt_s3max)) s3_max=mt_s3max
1423 call mt_require_ordered('mt_s1min','mt_s1max',s1_min,s1_max)
1424 call mt_require_ordered('mt_s2min','mt_s2max',s2_min,s2_max)
1425 call mt_require_ordered('mt_s3min','mt_s3max',s3_min,s3_max)
1426
1427 call mt_resolve_output_file('spherical_cloud_products','.vtu', &
1428 '_spherical_cloud_products.vtu',vtu_file)
1429
1430 write(*,'(a)') 'mt_run_topology_task: writing spherical cloud VTU '// &
1431 trim(vtu_file)
1432
1433 if (mt_profile_spherical) then
1434 call trace_spherical_profile_reset()
1435 call trace_spherical_profile_set(.true.)
1436 endif
1437
1438 if (mt_b_min>0.d0) then
1439 call mt_fieldline_products_spherical_cloud(s1_min,s1_max,mt_n1, &
1440 s2_min,s2_max,mt_n2,s3_min,s3_max,mt_n3,mt_dl,mt_max_steps, &
1441 trim(vtu_file),trim(mt_seed_layout), &
1442 compute_twist=mt_compute_twist,compute_q=mt_compute_q, &
1443 compute_qperp=mt_compute_qperp,b_min=mt_b_min)
1444 else
1445 call mt_fieldline_products_spherical_cloud(s1_min,s1_max,mt_n1, &
1446 s2_min,s2_max,mt_n2,s3_min,s3_max,mt_n3,mt_dl,mt_max_steps, &
1447 trim(vtu_file),trim(mt_seed_layout), &
1448 compute_twist=mt_compute_twist,compute_q=mt_compute_q, &
1449 compute_qperp=mt_compute_qperp)
1450 endif
1451 if (mt_profile_spherical) then
1452 call trace_spherical_profile_report('spherical_cloud_products')
1453 call trace_spherical_profile_set(.false.)
1454 endif
1455 end subroutine mt_run_spherical_cloud_products_task
1456
1457 subroutine mt_resolve_output_file(mode,extension,suffix,output_file)
1458 character(len=*), intent(in) :: mode,extension,suffix
1459 character(len=*), intent(out) :: output_file
1460 integer :: required_len
1461
1462 output_file=''
1463 if (len_trim(mt_output_file)>0) then
1464 output_file=trim(mt_output_file)
1465 if (len_trim(mt_output_prefix)>0) then
1466 write(*,'(a)') 'mt_run_topology_task: mt_output_file takes precedence over mt_output_prefix'
1467 endif
1468 call mt_warn_extension(output_file,extension,mode)
1469 else
1470 required_len=len_trim(mt_output_prefix)+len_trim(suffix)
1471 if (required_len>len(output_file)) then
1472 call mpistop('mt_run_topology_task output filename exceeds internal length')
1473 endif
1474 output_file=trim(mt_output_prefix)//trim(suffix)
1475 endif
1476 end subroutine mt_resolve_output_file
1477
1478 subroutine mt_resolve_prefix_file(suffix,output_file,missing_message)
1479 character(len=*), intent(in) :: suffix,missing_message
1480 character(len=*), intent(out) :: output_file
1481 integer :: required_len
1482
1483 if (len_trim(mt_output_prefix)==0) then
1484 call mpistop(trim(missing_message))
1485 endif
1486 required_len=len_trim(mt_output_prefix)+len_trim(suffix)
1487 if (required_len>len(output_file)) then
1488 call mpistop('mt_run_topology_task output filename exceeds internal length')
1489 endif
1490 output_file=trim(mt_output_prefix)//trim(suffix)
1491 end subroutine mt_resolve_prefix_file
1492
1493 logical function mt_is_set_real(value) result(is_set)
1494 double precision, intent(in) :: value
1495
1496 is_set=(value/=mt_unset_real)
1497 end function mt_is_set_real
1498
1499 subroutine mt_require_real(name,value)
1500 character(len=*), intent(in) :: name
1501 double precision, intent(in) :: value
1502
1503 if (.not.mt_is_set_real(value)) then
1504 call mpistop('mt_run_topology_task requires '//trim(name))
1505 endif
1506 end subroutine mt_require_real
1507
1508 subroutine mt_require_positive_int(name,value)
1509 character(len=*), intent(in) :: name
1510 integer, intent(in) :: value
1511
1512 if (value<=0) then
1513 call mpistop('mt_run_topology_task requires '//trim(name)//' > 0')
1514 endif
1515 end subroutine mt_require_positive_int
1516
1517 subroutine mt_require_ordered(name_min,name_max,value_min,value_max)
1518 character(len=*), intent(in) :: name_min,name_max
1519 double precision, intent(in) :: value_min,value_max
1520
1521 if (value_max<value_min) then
1522 call mpistop('mt_run_topology_task requires ordered '// &
1523 trim(name_min)//'/'//trim(name_max))
1524 endif
1525 end subroutine mt_require_ordered
1526
1527 subroutine mt_require_requested_science(do_length,do_twist,do_q,do_qperp, &
1528 caller)
1529 logical, intent(in) :: do_length,do_twist,do_q,do_qperp
1530 character(len=*), intent(in) :: caller
1531
1532 if (.not.(do_length .or. do_twist .or. do_q .or. do_qperp)) then
1533 call mpistop(trim(caller)//' requires at least one requested science array')
1534 endif
1535 end subroutine mt_require_requested_science
1536
1537 subroutine mt_read_seed_file(filename,seeds,nseed)
1538 character(len=*), intent(in) :: filename
1539 double precision, allocatable, intent(out) :: seeds(:,:)
1540 integer, intent(out) :: nseed
1541
1542 character(len=1024) :: line
1543 double precision :: xyz(3)
1544 integer :: io,ios,line_no,iseed
1545
1546 nseed=0
1547 open(newunit=io,file=trim(filename),status='old',action='read', &
1548 form='formatted',iostat=ios)
1549 if (ios/=0) then
1550 call mpistop('mt_read_seed_file could not open '//trim(filename))
1551 endif
1552 line_no=0
1553 do
1554 read(io,'(a)',iostat=ios) line
1555 if (ios/=0) exit
1556 line_no=line_no+1
1557 if (.not.mt_seed_line_is_data(line)) cycle
1558 call mt_validate_seed_line(filename,line,line_no)
1559 nseed=nseed+1
1560 enddo
1561 close(io)
1562 if (nseed<=0) then
1563 call mpistop('mt_read_seed_file found no seeds in '//trim(filename))
1564 endif
1565
1566 allocate(seeds(nseed,ndim))
1567 seeds=0.d0
1568 open(newunit=io,file=trim(filename),status='old',action='read', &
1569 form='formatted',iostat=ios)
1570 if (ios/=0) then
1571 call mpistop('mt_read_seed_file could not reopen '//trim(filename))
1572 endif
1573 line_no=0
1574 iseed=0
1575 do
1576 read(io,'(a)',iostat=ios) line
1577 if (ios/=0) exit
1578 line_no=line_no+1
1579 if (.not.mt_seed_line_is_data(line)) cycle
1580 iseed=iseed+1
1581 read(line,*,iostat=ios) xyz
1582 if (ios/=0) then
1583 call mt_fail_seed_line(filename,line_no)
1584 endif
1585 seeds(iseed,1:ndim)=xyz(1:ndim)
1586 enddo
1587 close(io)
1588 end subroutine mt_read_seed_file
1589
1590 logical function mt_seed_line_is_data(line) result(is_data)
1591 character(len=*), intent(in) :: line
1592 character(len=len(line)) :: trimmed
1593
1594 trimmed=adjustl(line)
1595 is_data=len_trim(trimmed)>0
1596 if (is_data) is_data=trimmed(1:1)/='#'
1597 end function mt_seed_line_is_data
1598
1599 subroutine mt_validate_seed_line(filename,line,line_no)
1600 character(len=*), intent(in) :: filename,line
1601 integer, intent(in) :: line_no
1602
1603 double precision :: x,y,z
1604 integer :: ios
1605
1606 if (index(line,',')>0) then
1607 call mt_fail_seed_line(filename,line_no)
1608 endif
1609 if (mt_count_tokens(line)/=3) then
1610 call mt_fail_seed_line(filename,line_no)
1611 endif
1612 read(line,*,iostat=ios) x,y,z
1613 if (ios/=0) then
1614 call mt_fail_seed_line(filename,line_no)
1615 endif
1616 end subroutine mt_validate_seed_line
1617
1618 integer function mt_count_tokens(line) result(ntoken)
1619 character(len=*), intent(in) :: line
1620 integer :: i
1621 logical :: in_token
1622
1623 ntoken=0
1624 in_token=.false.
1625 do i=1,len_trim(line)
1626 if (line(i:i)==' ' .or. line(i:i)==achar(9)) then
1627 in_token=.false.
1628 else
1629 if (.not.in_token) then
1630 ntoken=ntoken+1
1631 in_token=.true.
1632 endif
1633 endif
1634 enddo
1635 end function mt_count_tokens
1636
1637 subroutine mt_fail_seed_line(filename,line_no)
1638 character(len=*), intent(in) :: filename
1639 integer, intent(in) :: line_no
1640
1641 call mpistop('mt_read_seed_file malformed line '// &
1642 trim(mt_int_to_string(line_no))//' in '//trim(filename))
1643 end subroutine mt_fail_seed_line
1644
1645 function mt_int_to_string(value) result(text)
1646 integer, intent(in) :: value
1647 character(len=32) :: text
1648
1649 write(text,'(i0)') value
1650 end function mt_int_to_string
1651
1652 subroutine mt_warn_extension(filename,extension,mode)
1653 character(len=*), intent(in) :: filename,extension,mode
1654
1655 if (.not.mt_has_extension(filename,extension)) then
1656 write(*,'(a)') 'mt_run_topology_task warning: '//trim(mode)// &
1657 ' output file does not end in '//trim(extension)
1658 endif
1659 end subroutine mt_warn_extension
1660
1661 logical function mt_has_extension(filename,extension) result(has_ext)
1662 character(len=*), intent(in) :: filename,extension
1663 character(len=mt_task_name_len) :: fname,ext
1664 integer :: lf,le
1665
1666 fname=mt_lowercase(trim(filename))
1667 ext=mt_lowercase(trim(extension))
1668 lf=len_trim(fname)
1669 le=len_trim(ext)
1670 has_ext=.false.
1671 if (lf>=le) has_ext=(fname(lf-le+1:lf)==ext(1:le))
1672 end function mt_has_extension
1673
1674 function mt_lowercase(input) result(output)
1675 character(len=*), intent(in) :: input
1676 character(len=len(input)) :: output
1677 integer :: i,code
1678
1679 output=input
1680 do i=1,len(input)
1681 code=iachar(output(i:i))
1682 if (code>=iachar('A') .and. code<=iachar('Z')) then
1683 output(i:i)=achar(code+iachar('a')-iachar('A'))
1684 endif
1685 enddo
1686 end function mt_lowercase
1687
1688 logical function mt_vtk_detail_is_full() result(is_full)
1689 is_full=(mt_lowercase(trim(mt_vtk_detail))=='full')
1690 end function mt_vtk_detail_is_full
1691
1692 double precision function mt_visual_float(value) result(out_value)
1693 double precision, intent(in) :: value
1694
1695 if (ieee_is_finite(value)) then
1696 out_value=value
1697 else
1698 out_value=0.d0
1699 endif
1700 end function mt_visual_float
1701
1702 double precision function mt_visual_valid_float(value,is_valid) &
1703 result(out_value)
1704 double precision, intent(in) :: value
1705 logical, intent(in) :: is_valid
1706
1707 if (is_valid .and. ieee_is_finite(value)) then
1708 out_value=value
1709 else
1710 out_value=0.d0
1711 endif
1712 end function mt_visual_valid_float
1713
1714 double precision function mt_vc(vec,icomp) result(value)
1715 ! Return a physical coordinate component without creating fixed
1716 ! out-of-bounds references in 1D/2D source expansions.
1717 double precision, intent(in) :: vec(ndim)
1718 integer, intent(in) :: icomp
1719
1720 if (icomp>=1 .and. icomp<=ndim) then
1721 value=vec(icomp)
1722 else
1723 value=0.d0
1724 endif
1725 end function mt_vc
1726
1727 subroutine mt_length_single(seed,dL,max_steps,csv_file,b_min)
1728 ! Trace one magnetic field line and write its summary to a CSV file.
1729 double precision, intent(in) :: seed(ndim),dl
1730 integer, intent(in) :: max_steps
1731 character(len=*), intent(in) :: csv_file
1732 double precision, intent(in), optional :: b_min
1733
1734 type(trace_length_result) :: result
1735 double precision :: seed_xyz(3)
1736 integer :: csv_unit,io_status
1737
1738 if (npe/=1) then
1739 call mpistop('mt_length_single currently requires npe=1')
1740 endif
1741
1742 if (present(b_min)) then
1743 call trace_field_length_single(seed,dl,max_steps,result,b_min)
1744 else
1745 call trace_field_length_single(seed,dl,max_steps,result)
1746 endif
1747
1748 seed_xyz=0.d0
1749 seed_xyz(1:ndim)=result%seed
1750
1751 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
1752 action='write',form='formatted',iostat=io_status)
1753 if (io_status/=0) then
1754 call mpistop('mt_length_single could not open CSV file')
1755 endif
1756
1757 write(csv_unit,'(a)',iostat=io_status) &
1758 'seed_x,seed_y,seed_z,'// &
1759 'length_total,length_backward,length_forward,'// &
1760 'nstep_backward,nstep_forward,'// &
1761 'status_backward,status_forward'
1762 if (io_status/=0) then
1763 close(csv_unit)
1764 call mpistop('mt_length_single could not write CSV header')
1765 endif
1766
1767 write(csv_unit,'(es24.16,5(",",es24.16),4(",",i0))',iostat=io_status) &
1768 seed_xyz,result%total_length, &
1769 result%backward_length,result%forward_length, &
1770 result%backward_nstep,result%forward_nstep, &
1771 result%backward_status,result%forward_status
1772 if (io_status/=0) then
1773 close(csv_unit)
1774 call mpistop('mt_length_single could not write CSV data')
1775 endif
1776
1777 close(csv_unit)
1778 end subroutine mt_length_single
1779
1780 subroutine mt_length_seeds(seeds,nseed,dL,max_steps,csv_file,b_min)
1781 ! Trace multiple magnetic field lines and write one summary row per seed.
1782 integer, intent(in) :: nseed,max_steps
1783 double precision, intent(in) :: seeds(nseed,ndim),dl
1784 character(len=*), intent(in) :: csv_file
1785 double precision, intent(in), optional :: b_min
1786
1787 type(trace_length_result), allocatable :: results(:)
1788 double precision :: seed_xyz(3)
1789 integer :: csv_unit,io_status,iseed
1790
1791 if (npe/=1) then
1792 call mpistop('mt_length_seeds currently requires npe=1')
1793 endif
1794 if (nseed<0) then
1795 call mpistop('mt_length_seeds requires nseed>=0')
1796 endif
1797
1798 allocate(results(nseed))
1799 if (present(b_min)) then
1800 call trace_field_length_multi(seeds,nseed,dl,max_steps,results,b_min)
1801 else
1802 call trace_field_length_multi(seeds,nseed,dl,max_steps,results)
1803 endif
1804
1805 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
1806 action='write',form='formatted',iostat=io_status)
1807 if (io_status/=0) then
1808 deallocate(results)
1809 call mpistop('mt_length_seeds could not open CSV file')
1810 endif
1811
1812 write(csv_unit,'(a)',iostat=io_status) &
1813 'seed_id,seed_x,seed_y,seed_z,'// &
1814 'length_total,length_backward,length_forward,'// &
1815 'nstep_backward,nstep_forward,'// &
1816 'status_backward,status_forward'
1817 if (io_status/=0) then
1818 close(csv_unit)
1819 deallocate(results)
1820 call mpistop('mt_length_seeds could not write CSV header')
1821 endif
1822
1823 do iseed=1,nseed
1824 seed_xyz=0.d0
1825 seed_xyz(1:ndim)=results(iseed)%seed
1826 write(csv_unit,'(i0,6(",",es24.16),4(",",i0))',iostat=io_status) &
1827 iseed,seed_xyz,results(iseed)%total_length, &
1828 results(iseed)%backward_length,results(iseed)%forward_length, &
1829 results(iseed)%backward_nstep,results(iseed)%forward_nstep, &
1830 results(iseed)%backward_status,results(iseed)%forward_status
1831 if (io_status/=0) then
1832 close(csv_unit)
1833 deallocate(results)
1834 call mpistop('mt_length_seeds could not write CSV data')
1835 endif
1836 enddo
1837
1838 close(csv_unit)
1839 deallocate(results)
1840 end subroutine mt_length_seeds
1841
1842 subroutine mt_fieldline_products_seeds(seeds,nseed,dL,max_steps,csv_file, &
1843 b_min,compute_length,compute_twist,compute_q,compute_qperp,vtu_file)
1844 ! Write selected per-field-line diagnostics for an arbitrary seed set.
1845 integer, intent(in) :: nseed,max_steps
1846 double precision, intent(in) :: seeds(nseed,ndim),dl
1847 character(len=*), intent(in) :: csv_file
1848 double precision, intent(in), optional :: b_min
1849 logical, intent(in), optional :: compute_length,compute_twist
1850 logical, intent(in), optional :: compute_q,compute_qperp
1851 character(len=*), intent(in), optional :: vtu_file
1852
1853 type(trace_length_result), allocatable :: length_results(:)
1854 type(trace_twist_result), allocatable :: twist_results(:)
1855 type(trace_qperp_result), allocatable :: q_results(:)
1856 type(trace_qperp_result), allocatable :: qperp_results(:)
1857 logical :: do_length,do_twist,do_q,do_qperp
1858 character(len=mt_task_name_len) :: integrator
1859
1860 do_length=.true.
1861 do_twist=.false.
1862 do_q=.false.
1863 do_qperp=.false.
1864 if (present(compute_length)) do_length=compute_length
1865 if (present(compute_twist)) do_twist=compute_twist
1866 if (present(compute_q)) do_q=compute_q
1867 if (present(compute_qperp)) do_qperp=compute_qperp
1868 integrator=mt_lowercase(trim(mt_trace_integrator))
1869
1870 if (npe/=1) then
1871 call mpistop('mt_fieldline_products_seeds currently requires npe=1')
1872 endif
1873 if (ndim/=3) then
1874 call mpistop('mt_fieldline_products_seeds requires 3D Cartesian or spherical geometry')
1875 endif
1876 {^ifthreed
1877 select case (geo_coordinate)
1878 case (geo_cartesian,geo_cartesian_stretched)
1879 case (geo_spherical)
1880 call mt_validate_periodic_phi()
1881 case default
1882 call mpistop('mt_fieldline_products_seeds requires Cartesian or spherical geometry')
1883 end select
1884 }
1885 if (do_qperp) then
1886 select case (trim(integrator))
1887 case ('rk2')
1888 ! RK2 Qperp is the mature tangent-transport path.
1889 case ('rk45_cartesian')
1890 {^ifthreed
1891 if (geo_coordinate==geo_spherical) then
1892 call mpistop('seed_products logQperp with spherical geometry '// &
1893 'requires mt_trace_integrator=rk45_spherical')
1894 endif
1895 }
1896 case ('rk45_spherical')
1897 {^ifthreed
1898 if (geo_coordinate/=geo_spherical) then
1899 call mpistop('seed_products logQperp with Cartesian geometry '// &
1900 'requires mt_trace_integrator=rk45_cartesian')
1901 endif
1902 }
1903 case default
1904 call mpistop('seed_products logQperp requires mt_trace_integrator='// &
1905 'rk2, rk45_cartesian, or rk45_spherical')
1906 end select
1907 endif
1908 if (do_q) then
1909 select case (trim(integrator))
1910 case ('rk2')
1911 ! RK2 standard logQ is the mature tangent-transport path.
1912 case ('rk45_cartesian')
1913 {^ifthreed
1914 if (geo_coordinate==geo_spherical) then
1915 call mpistop('seed_products logQ with spherical geometry '// &
1916 'requires mt_trace_integrator=rk45_spherical')
1917 endif
1918 }
1919 case ('rk45_spherical')
1920 {^ifthreed
1921 if (geo_coordinate/=geo_spherical) then
1922 call mpistop('seed_products logQ with Cartesian geometry '// &
1923 'requires mt_trace_integrator=rk45_cartesian')
1924 endif
1925 }
1926 case default
1927 call mpistop('seed_products logQ requires mt_trace_integrator='// &
1928 'rk2, rk45_cartesian, or rk45_spherical')
1929 end select
1930 endif
1931 if (nseed<0) then
1932 call mpistop('mt_fieldline_products_seeds requires nseed>=0')
1933 endif
1934 call mt_require_requested_science(do_length,do_twist,do_q,do_qperp, &
1935 'mt_fieldline_products_seeds')
1936
1937 allocate(length_results(nseed))
1938 if (do_twist) then
1939 allocate(twist_results(nseed))
1940 else
1941 allocate(twist_results(0))
1942 endif
1943 if (do_q) then
1944 allocate(q_results(nseed))
1945 else
1946 allocate(q_results(0))
1947 endif
1948 if (do_qperp) then
1949 allocate(qperp_results(nseed))
1950 else
1951 allocate(qperp_results(0))
1952 endif
1953
1954 if (present(b_min)) then
1955 call mt_trace_fieldline_products_seedset(seeds,nseed,dl,max_steps, &
1956 length_results,twist_results,q_results,qperp_results,do_twist, &
1957 do_q,do_qperp,b_min)
1958 else
1959 call mt_trace_fieldline_products_seedset(seeds,nseed,dl,max_steps, &
1960 length_results,twist_results,q_results,qperp_results,do_twist, &
1961 do_q,do_qperp)
1962 endif
1963
1964 if (len_trim(csv_file)>0) then
1965 call mt_write_fieldline_products_seeds_csv(length_results, &
1966 twist_results,q_results,qperp_results,nseed,csv_file,do_twist, &
1967 do_q,do_qperp)
1968 endif
1969 if (present(vtu_file)) then
1970 if (len_trim(vtu_file)>0) then
1971 call mt_write_fieldline_products_vtu_vertices(vtu_file, &
1972 length_results,twist_results,q_results,qperp_results,nseed, &
1973 do_length,do_twist,do_q,do_qperp,'mt_fieldline_products_seeds')
1974 endif
1975 endif
1976
1977 if (allocated(qperp_results)) deallocate(qperp_results)
1978 if (allocated(q_results)) deallocate(q_results)
1979 if (allocated(twist_results)) deallocate(twist_results)
1980 deallocate(length_results)
1981 end subroutine mt_fieldline_products_seeds
1982
1983 subroutine mt_rk45_tangent_diagnostic_seeds(seeds,nseed,dL,max_steps, &
1984 csv_file,b_min)
1985 integer, intent(in) :: nseed,max_steps
1986 double precision, intent(in) :: seeds(nseed,ndim),dl
1987 character(len=*), intent(in) :: csv_file
1988 double precision, intent(in), optional :: b_min
1989
1990 type(trace_qperp_result), allocatable :: rk2_results(:)
1991 type(trace_qperp_result), allocatable :: rk45_results(:)
1992
1993 if (npe/=1) then
1994 call mpistop('mt_rk45_tangent_diagnostic_seeds currently requires npe=1')
1995 endif
1996 if (nseed<0) then
1997 call mpistop('mt_rk45_tangent_diagnostic_seeds requires nseed>=0')
1998 endif
1999
2000 allocate(rk2_results(nseed),rk45_results(nseed))
2001 if (present(b_min)) then
2002 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,rk2_results, &
2003 b_min)
2004 call trace_debug_cartesian_rk45_tangent_q0_multi(seeds,nseed,dl, &
2005 max_steps,rk45_results,b_min)
2006 else
2007 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,rk2_results)
2008 call trace_debug_cartesian_rk45_tangent_q0_multi(seeds,nseed,dl, &
2009 max_steps,rk45_results)
2010 endif
2011
2012 call mt_write_rk45_tangent_diagnostic_csv(rk2_results,rk45_results, &
2013 nseed,csv_file)
2014 deallocate(rk45_results,rk2_results)
2015 end subroutine mt_rk45_tangent_diagnostic_seeds
2016
2017 subroutine mt_write_rk45_tangent_diagnostic_csv(rk2_results,rk45_results, &
2018 nseed,csv_file)
2019 integer, intent(in) :: nseed
2020 type(trace_qperp_result), intent(in) :: rk2_results(nseed)
2021 type(trace_qperp_result), intent(in) :: rk45_results(nseed)
2022 character(len=*), intent(in) :: csv_file
2023
2024 double precision :: seed_xyz(3),logq_diff,q_diff,length_diff
2025 double precision :: f_endpoint_diff,b_endpoint_diff
2026 double precision :: uf_diff,vf_diff,ub_diff,vb_diff
2027 integer :: csv_unit,io_status,iseed
2028
2029 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
2030 action='write',form='formatted',iostat=io_status)
2031 if (io_status/=0) then
2032 call mpistop('mt_rk45_tangent_diagnostic could not open CSV file')
2033 endif
2034
2035 write(csv_unit,'(a)',iostat=io_status) &
2036 'seed_id,seed_x,seed_y,seed_z,'// &
2037 'rk2_status_q0,rk45_status_q0,'// &
2038 'rk2_forward_status,rk45_forward_status,'// &
2039 'rk2_backward_status,rk45_backward_status,'// &
2040 'rk2_logq0,rk45_logq0,abs_diff_logq0,'// &
2041 'rk2_q0,rk45_q0,abs_diff_q0,'// &
2042 'rk2_length_total,rk45_length_total,abs_diff_length_total,'// &
2043 'endpoint_diff_forward,endpoint_diff_backward,'// &
2044 'u_forward_perp_diff,v_forward_perp_diff,'// &
2045 'u_backward_perp_diff,v_backward_perp_diff'
2046 if (io_status/=0) then
2047 close(csv_unit)
2048 call mpistop('mt_rk45_tangent_diagnostic could not write CSV header')
2049 endif
2050
2051 do iseed=1,nseed
2052 seed_xyz=0.d0
2053 seed_xyz(1:ndim)=rk2_results(iseed)%seed
2054 logq_diff=mt_absdiff_or_nan(rk2_results(iseed)%logq0, &
2055 rk45_results(iseed)%logq0)
2056 q_diff=mt_absdiff_or_nan(rk2_results(iseed)%q0, &
2057 rk45_results(iseed)%q0)
2058 length_diff=abs((rk2_results(iseed)%forward_length+ &
2059 rk2_results(iseed)%backward_length)- &
2060 (rk45_results(iseed)%forward_length+ &
2061 rk45_results(iseed)%backward_length))
2062 f_endpoint_diff=dsqrt(sum((rk2_results(iseed)%forward_endpoint- &
2063 rk45_results(iseed)%forward_endpoint)**2))
2064 b_endpoint_diff=dsqrt(sum((rk2_results(iseed)%backward_endpoint- &
2065 rk45_results(iseed)%backward_endpoint)**2))
2066 uf_diff=dsqrt(sum((rk2_results(iseed)%u_forward_perp- &
2067 rk45_results(iseed)%u_forward_perp)**2))
2068 vf_diff=dsqrt(sum((rk2_results(iseed)%v_forward_perp- &
2069 rk45_results(iseed)%v_forward_perp)**2))
2070 ub_diff=dsqrt(sum((rk2_results(iseed)%u_backward_perp- &
2071 rk45_results(iseed)%u_backward_perp)**2))
2072 vb_diff=dsqrt(sum((rk2_results(iseed)%v_backward_perp- &
2073 rk45_results(iseed)%v_backward_perp)**2))
2074
2075 write(csv_unit,'(i0,3(",",es24.16),6(",",i0),15(",",es24.16))', &
2076 iostat=io_status) &
2077 iseed,seed_xyz, &
2078 rk2_results(iseed)%status_q0, &
2079 rk45_results(iseed)%status_q0, &
2080 rk2_results(iseed)%forward_status, &
2081 rk45_results(iseed)%forward_status, &
2082 rk2_results(iseed)%backward_status, &
2083 rk45_results(iseed)%backward_status, &
2084 rk2_results(iseed)%logq0,rk45_results(iseed)%logq0,logq_diff, &
2085 rk2_results(iseed)%q0,rk45_results(iseed)%q0,q_diff, &
2086 rk2_results(iseed)%forward_length+ &
2087 rk2_results(iseed)%backward_length, &
2088 rk45_results(iseed)%forward_length+ &
2089 rk45_results(iseed)%backward_length, &
2090 length_diff,f_endpoint_diff,b_endpoint_diff, &
2091 uf_diff,vf_diff,ub_diff,vb_diff
2092 if (io_status/=0) then
2093 close(csv_unit)
2094 call mpistop('mt_rk45_tangent_diagnostic could not write CSV data')
2095 endif
2096 enddo
2097
2098 close(csv_unit)
2099 end subroutine mt_write_rk45_tangent_diagnostic_csv
2100
2101 subroutine mt_rk2_fusion_diagnostic_seeds(seeds,nseed,dL,max_steps, &
2102 csv_file,b_min)
2103 integer, intent(in) :: nseed,max_steps
2104 double precision, intent(in) :: seeds(nseed,ndim),dl
2105 character(len=*), intent(in) :: csv_file
2106 double precision, intent(in), optional :: b_min
2107
2108 type(trace_topology_result), allocatable :: summary(:)
2109 type(trace_qperp_result), allocatable :: q_trace(:)
2110 type(trace_qperp_result), allocatable :: q_short(:)
2111 type(trace_twist_result), allocatable :: q_twist(:)
2112 type(trace_twist_result), allocatable :: q_short_twist(:)
2113 integer :: cache_status
2114 logical :: use_spherical_cache
2115
2116 if (npe/=1) then
2117 call mpistop('mt_rk2_fusion_diagnostic currently requires npe=1')
2118 endif
2119 if (nseed<0) then
2120 call mpistop('mt_rk2_fusion_diagnostic requires nseed>=0')
2121 endif
2122 if (mt_lowercase(trim(mt_trace_integrator))/='rk2') then
2123 call mpistop('mt_rk2_fusion_diagnostic requires rk2 tracing')
2124 endif
2125
2126 allocate(summary(nseed),q_trace(nseed),q_short(nseed), &
2127 q_twist(nseed),q_short_twist(nseed))
2128 use_spherical_cache=.false.
2129 {^ifthreed
2130 if (geo_coordinate==geo_spherical) then
2131 call trace_spherical_curl_cache_build(cache_status)
2132 if (cache_status/=trace_status_active) then
2133 call mpistop('mt_rk2_fusion_diagnostic failed to build '// &
2134 'spherical curl cache')
2135 endif
2136 use_spherical_cache=.true.
2137 endif
2138 }
2139
2140 if (present(b_min)) then
2141 call trace_field_topology_multi(seeds,nseed,dl,max_steps,summary, &
2142 need_twist=.true.,need_mapping=.false.,b_min=b_min)
2143 if (geo_coordinate==geo_spherical) then
2144 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
2145 q_trace,b_min,twist_results=q_twist)
2146 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
2147 max_steps,q_short,b_min,twist_results=q_short_twist)
2148 else
2149 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,q_trace, &
2150 b_min,twist_results=q_twist)
2151 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
2152 max_steps,q_short,b_min,twist_results=q_short_twist)
2153 endif
2154 else
2155 call trace_field_topology_multi(seeds,nseed,dl,max_steps,summary, &
2156 need_twist=.true.,need_mapping=.false.)
2157 if (geo_coordinate==geo_spherical) then
2158 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
2159 q_trace,twist_results=q_twist)
2160 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
2161 max_steps,q_short,twist_results=q_short_twist)
2162 else
2163 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,q_trace, &
2164 twist_results=q_twist)
2165 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
2166 max_steps,q_short,twist_results=q_short_twist)
2167 endif
2168 endif
2169
2170 if (use_spherical_cache) call trace_spherical_curl_cache_clear()
2171 call mt_write_rk2_fusion_diagnostic_csv(summary,q_trace,q_twist, &
2172 q_short,q_short_twist,nseed,csv_file)
2173 deallocate(q_short_twist,q_twist,q_short,q_trace,summary)
2174 end subroutine mt_rk2_fusion_diagnostic_seeds
2175
2176 subroutine mt_write_rk2_fusion_diagnostic_csv(summary,q_trace,q_twist, &
2177 q_short,q_short_twist,nseed,csv_file)
2178 integer, intent(in) :: nseed
2179 type(trace_topology_result), intent(in) :: summary(nseed)
2180 type(trace_qperp_result), intent(in) :: q_trace(nseed)
2181 type(trace_twist_result), intent(in) :: q_twist(nseed)
2182 type(trace_qperp_result), intent(in) :: q_short(nseed)
2183 type(trace_twist_result), intent(in) :: q_short_twist(nseed)
2184 character(len=*), intent(in) :: csv_file
2185
2186 double precision :: seed_xyz(3),length_summary,length_q,length_diff
2187 double precision :: length_short,length_diff_short,length_q_short_diff
2188 double precision :: twist_summary,twist_q,twist_diff
2189 double precision :: twist_short,twist_diff_short,twist_q_short_diff
2190 double precision :: max_length_diff,max_twist_diff
2191 double precision :: max_length_short_diff,max_twist_short_diff
2192 integer :: csv_unit,io_status,iseed
2193 integer :: status_mismatch,face_mismatch,twist_status_mismatch
2194 integer :: short_status_mismatch,short_face_mismatch
2195 integer :: short_twist_status_mismatch,short_valid_q_mismatch
2196
2197 max_length_diff=0.d0
2198 max_twist_diff=0.d0
2199 max_length_short_diff=0.d0
2200 max_twist_short_diff=0.d0
2201 status_mismatch=0
2202 face_mismatch=0
2203 twist_status_mismatch=0
2204 short_status_mismatch=0
2205 short_face_mismatch=0
2206 short_twist_status_mismatch=0
2207 short_valid_q_mismatch=0
2208
2209 open(newunit=csv_unit,file=trim(csv_file),status='replace', &
2210 action='write',form='formatted',iostat=io_status)
2211 if (io_status/=0) then
2212 call mpistop('mt_rk2_fusion_diagnostic could not open CSV file')
2213 endif
2214
2215 write(csv_unit,'(a)',iostat=io_status) &
2216 'seed_id,seed_x,seed_y,seed_z,'// &
2217 'length_summary,length_qtrace,dlength_summary_minus_qtrace,'// &
2218 'length_forward_summary,length_forward_qtrace,'// &
2219 'length_backward_summary,length_backward_qtrace,'// &
2220 'twist_summary,twist_qtrace,dtwist_summary_minus_qtrace,'// &
2221 'twist_forward_summary,twist_forward_qtrace,'// &
2222 'twist_backward_summary,twist_backward_qtrace,'// &
2223 'length_short,dlength_summary_minus_short,'// &
2224 'dlength_qtrace_minus_short,'// &
2225 'length_forward_short,length_backward_short,'// &
2226 'twist_short,dtwist_summary_minus_short,'// &
2227 'dtwist_qtrace_minus_short,'// &
2228 'twist_forward_short,twist_backward_short,'// &
2229 'status_forward_summary,status_forward_qtrace,status_forward_short,'// &
2230 'status_backward_summary,status_backward_qtrace,status_backward_short,'// &
2231 'face_forward_summary,face_forward_qtrace,face_forward_short,'// &
2232 'face_backward_summary,face_backward_qtrace,face_backward_short,'// &
2233 'status_twist_summary,status_twist_qtrace,status_twist_short,'// &
2234 'logQ,valid_Q,status_Q,logQ_short,valid_Q_short,status_Q_short'
2235 if (io_status/=0) then
2236 close(csv_unit)
2237 call mpistop('mt_rk2_fusion_diagnostic could not write CSV header')
2238 endif
2239
2240 do iseed=1,nseed
2241 seed_xyz=0.d0
2242 seed_xyz(1:ndim)=summary(iseed)%seed
2243 length_summary=summary(iseed)%length_total
2244 length_q=q_trace(iseed)%forward_length+q_trace(iseed)%backward_length
2245 length_short=q_short(iseed)%forward_length+ &
2246 q_short(iseed)%backward_length
2247 length_diff=length_summary-length_q
2248 length_diff_short=length_summary-length_short
2249 length_q_short_diff=length_q-length_short
2250 twist_summary=summary(iseed)%twist_total
2251 twist_q=q_twist(iseed)%total_twist
2252 twist_short=q_short_twist(iseed)%total_twist
2253 twist_diff=twist_summary-twist_q
2254 twist_diff_short=twist_summary-twist_short
2255 twist_q_short_diff=twist_q-twist_short
2256 max_length_diff=max(max_length_diff,abs(length_diff))
2257 max_twist_diff=max(max_twist_diff,abs(twist_diff))
2258 max_length_short_diff=max(max_length_short_diff, &
2259 abs(length_diff_short))
2260 max_twist_short_diff=max(max_twist_short_diff, &
2261 abs(twist_diff_short))
2262 if (summary(iseed)%forward_status/=q_trace(iseed)%forward_status .or. &
2263 summary(iseed)%backward_status/=q_trace(iseed)%backward_status) &
2264 status_mismatch=status_mismatch+1
2265 if (summary(iseed)%forward_face/=q_trace(iseed)%forward_face .or. &
2266 summary(iseed)%backward_face/=q_trace(iseed)%backward_face) &
2267 face_mismatch=face_mismatch+1
2268 if (summary(iseed)%status_twist/=q_twist(iseed)%status_twist) &
2269 twist_status_mismatch=twist_status_mismatch+1
2270 if (summary(iseed)%forward_status/=q_short(iseed)%forward_status .or. &
2271 summary(iseed)%backward_status/=q_short(iseed)%backward_status) &
2272 short_status_mismatch=short_status_mismatch+1
2273 if (summary(iseed)%forward_face/=q_short(iseed)%forward_face .or. &
2274 summary(iseed)%backward_face/=q_short(iseed)%backward_face) &
2275 short_face_mismatch=short_face_mismatch+1
2276 if (summary(iseed)%status_twist/=q_short_twist(iseed)%status_twist) &
2277 short_twist_status_mismatch=short_twist_status_mismatch+1
2278 if (q_trace(iseed)%valid_q0 .neqv. q_short(iseed)%valid_q0) &
2279 short_valid_q_mismatch=short_valid_q_mismatch+1
2280
2281 write(csv_unit, &
2282 '(i0,3(",",es24.16),24(",",es24.16),15(",",i0),'// &
2283 '",",es24.16,",",l1,",",i0,",",es24.16,",",l1,",",i0)', &
2284 iostat=io_status) &
2285 iseed,seed_xyz, &
2286 length_summary,length_q,length_diff, &
2287 summary(iseed)%length_forward,q_trace(iseed)%forward_length, &
2288 summary(iseed)%length_backward,q_trace(iseed)%backward_length, &
2289 twist_summary,twist_q,twist_diff, &
2290 summary(iseed)%twist_forward,q_twist(iseed)%forward_twist, &
2291 summary(iseed)%twist_backward,q_twist(iseed)%backward_twist, &
2292 length_short,length_diff_short,length_q_short_diff, &
2293 q_short(iseed)%forward_length,q_short(iseed)%backward_length, &
2294 twist_short,twist_diff_short,twist_q_short_diff, &
2295 q_short_twist(iseed)%forward_twist, &
2296 q_short_twist(iseed)%backward_twist, &
2297 summary(iseed)%forward_status,q_trace(iseed)%forward_status, &
2298 q_short(iseed)%forward_status, &
2299 summary(iseed)%backward_status,q_trace(iseed)%backward_status, &
2300 q_short(iseed)%backward_status, &
2301 summary(iseed)%forward_face,q_trace(iseed)%forward_face, &
2302 q_short(iseed)%forward_face, &
2303 summary(iseed)%backward_face,q_trace(iseed)%backward_face, &
2304 q_short(iseed)%backward_face, &
2305 summary(iseed)%status_twist,q_twist(iseed)%status_twist, &
2306 q_short_twist(iseed)%status_twist, &
2307 q_trace(iseed)%logq0,q_trace(iseed)%valid_q0, &
2308 q_trace(iseed)%status_q0, &
2309 q_short(iseed)%logq0,q_short(iseed)%valid_q0, &
2310 q_short(iseed)%status_q0
2311 if (io_status/=0) then
2312 close(csv_unit)
2313 call mpistop('mt_rk2_fusion_diagnostic could not write CSV data')
2314 endif
2315 enddo
2316
2317 close(csv_unit)
2318 write(*,'(a,es12.4)') 'mt_rk2_fusion_diagnostic max_abs_length_diff: ', &
2319 max_length_diff
2320 write(*,'(a,es12.4)') 'mt_rk2_fusion_diagnostic max_abs_twist_diff: ', &
2321 max_twist_diff
2322 write(*,'(a,es12.4)') &
2323 'mt_rk2_fusion_diagnostic max_abs_length_diff_short: ', &
2324 max_length_short_diff
2325 write(*,'(a,es12.4)') &
2326 'mt_rk2_fusion_diagnostic max_abs_twist_diff_short: ', &
2327 max_twist_short_diff
2328 write(*,'(a,i0)') 'mt_rk2_fusion_diagnostic status_mismatch_count: ', &
2329 status_mismatch
2330 write(*,'(a,i0)') 'mt_rk2_fusion_diagnostic face_mismatch_count: ', &
2331 face_mismatch
2332 write(*,'(a,i0)') &
2333 'mt_rk2_fusion_diagnostic twist_status_mismatch_count: ', &
2334 twist_status_mismatch
2335 write(*,'(a,i0)') &
2336 'mt_rk2_fusion_diagnostic short_status_mismatch_count: ', &
2337 short_status_mismatch
2338 write(*,'(a,i0)') &
2339 'mt_rk2_fusion_diagnostic short_face_mismatch_count: ', &
2340 short_face_mismatch
2341 write(*,'(a,i0)') &
2342 'mt_rk2_fusion_diagnostic short_twist_status_mismatch_count: ', &
2343 short_twist_status_mismatch
2344 write(*,'(a,i0)') &
2345 'mt_rk2_fusion_diagnostic short_valid_q_mismatch_count: ', &
2346 short_valid_q_mismatch
2347 end subroutine mt_write_rk2_fusion_diagnostic_csv
2348
2349 double precision function mt_absdiff_or_nan(a,b) result(diff)
2350 double precision, intent(in) :: a,b
2351
2352 if (ieee_is_finite(a) .and. ieee_is_finite(b)) then
2353 diff=abs(a-b)
2354 else
2355 diff=ieee_value(0.d0,ieee_quiet_nan)
2356 endif
2357 end function mt_absdiff_or_nan
2358
2359 subroutine mt_fieldline_products_spherical_surface(surface,seed_coord, &
2360 s1_min,s1_max,n1,s2_min,s2_max,n2,dL,max_steps,csv_file, &
2361 vtu_file,seed_layout,seed_theta0,seed_phi0,seed_alpha, &
2362 compute_twist,compute_q,compute_qperp,b_min)
2363 character(len=*), intent(in) :: surface,csv_file,vtu_file,seed_layout
2364 integer, intent(in) :: n1,n2,max_steps
2365 double precision, intent(in) :: seed_coord,s1_min,s1_max,s2_min,s2_max,dl
2366 double precision, intent(in) :: seed_theta0,seed_phi0,seed_alpha
2367 logical, intent(in), optional :: compute_twist,compute_q,compute_qperp
2368 double precision, intent(in), optional :: b_min
2369
2370 type(trace_topology_result), allocatable :: topology(:)
2371 type(trace_qperp_result), allocatable :: q_results(:)
2372 type(trace_qperp_result), allocatable :: qperp_results(:)
2373 double precision, allocatable :: seeds(:,:)
2374 integer :: nseed
2375 logical :: do_twist,do_q,do_qperp
2376
2377 if (npe/=1) then
2378 call mpistop('mt_fieldline_products_spherical_surface currently '// &
2379 'requires npe=1')
2380 endif
2381 if (ndim/=3 .or. geo_coordinate/=geo_spherical) then
2382 call mpistop('mt_fieldline_products_spherical_surface requires '// &
2383 '3D spherical geometry')
2384 endif
2385 {^ifthreed
2386 call mt_validate_periodic_phi()
2387 }
2388 if (n1<1 .or. n2<1) then
2389 call mpistop('mt_fieldline_products_spherical_surface requires '// &
2390 'sample counts >=1')
2391 endif
2392 if (s1_max<s1_min .or. s2_max<s2_min) then
2393 call mpistop('mt_fieldline_products_spherical_surface requires ordered bounds')
2394 endif
2395 do_twist=.false.
2396 do_q=.false.
2397 do_qperp=.false.
2398 if (present(compute_twist)) do_twist=compute_twist
2399 if (present(compute_q)) do_q=compute_q
2400 if (present(compute_qperp)) do_qperp=compute_qperp
2401 call mt_build_spherical_surface_seeds(surface,seed_coord,s1_min,s1_max, &
2402 n1,s2_min,s2_max,n2,seed_layout,seed_theta0,seed_phi0, &
2403 seed_alpha,seeds)
2404 nseed=n1*n2
2405 if (mt_profile_spherical) call trace_spherical_profile_count_seeds(nseed)
2406 allocate(topology(nseed))
2407 if (do_q) then
2408 allocate(q_results(nseed))
2409 else
2410 allocate(q_results(0))
2411 endif
2412 if (do_qperp) then
2413 allocate(qperp_results(nseed))
2414 else
2415 allocate(qperp_results(0))
2416 endif
2417
2418 if (present(b_min)) then
2419 call mt_trace_spherical_surface_products(seeds,nseed,dl,max_steps, &
2420 topology,q_results,qperp_results,do_twist,do_q,do_qperp,b_min)
2421 else
2422 call mt_trace_spherical_surface_products(seeds,nseed,dl,max_steps, &
2423 topology,q_results,qperp_results,do_twist,do_q,do_qperp)
2424 endif
2425
2426 if (len_trim(csv_file)>0) then
2427 call mt_write_spherical_rmin_csv(topology,n1,n2,csv_file, &
2428 'mt_fieldline_products_spherical_surface',do_twist,do_q, &
2429 q_results,do_qperp,qperp_results)
2430 endif
2431 call mt_write_spherical_topology_vtu(vtu_file,topology,n1,n2, &
2432 'mt_fieldline_products_spherical_surface',do_twist,do_q,q_results, &
2433 do_qperp,qperp_results)
2434
2435 deallocate(qperp_results,q_results,topology,seeds)
2436 end subroutine mt_fieldline_products_spherical_surface
2437
2438 subroutine mt_fieldline_products_spherical_cloud(s1_min,s1_max,n1, &
2439 s2_min,s2_max,n2,s3_min,s3_max,n3,dL,max_steps,vtu_file, &
2440 seed_layout,compute_twist,compute_q,compute_qperp,b_min)
2441 character(len=*), intent(in) :: vtu_file,seed_layout
2442 integer, intent(in) :: n1,n2,n3,max_steps
2443 double precision, intent(in) :: s1_min,s1_max,s2_min,s2_max
2444 double precision, intent(in) :: s3_min,s3_max,dl
2445 logical, intent(in), optional :: compute_twist,compute_q,compute_qperp
2446 double precision, intent(in), optional :: b_min
2447
2448 type(trace_topology_result), allocatable :: topology(:)
2449 type(trace_qperp_result), allocatable :: q_results(:)
2450 type(trace_qperp_result), allocatable :: qperp_results(:)
2451 double precision, allocatable :: seeds(:,:)
2452 integer :: nseed
2453 logical :: do_twist,do_q,do_qperp
2454 character(len=mt_task_name_len) :: integrator
2455
2456 if (npe/=1) then
2457 call mpistop('mt_fieldline_products_spherical_cloud currently '// &
2458 'requires npe=1')
2459 endif
2460 if (ndim/=3 .or. geo_coordinate/=geo_spherical) then
2461 call mpistop('mt_fieldline_products_spherical_cloud requires '// &
2462 '3D spherical geometry')
2463 endif
2464 {^ifthreed
2465 call mt_validate_periodic_phi()
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
update ghost cells of all blocks including physical boundaries
subroutine getbc(time, qdt, psb, nwstart, nwbc)
do update ghost cells of all blocks including physical boundaries
This module contains definitions of global parameters and variables and some generic functions/subrou...
integer, parameter unitpar
file handle for IO
double precision global_time
The global simulation time.
integer, parameter ndim
Number of spatial dimensions for grid variables.
character(len=std_len), dimension(:), allocatable par_files
Which par files are used as input.
double precision, dimension(:), allocatable, parameter d
integer npe
The number of MPI tasks.
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)
logical function, public trace_periodic_phi_supported()
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