2 use,
intrinsic :: ieee_arithmetic, only: ieee_value,ieee_quiet_nan, &
65 integer,
parameter :: mt_vti_kind_float64 = 1
66 integer,
parameter :: mt_vti_kind_int32 = 2
67 integer,
parameter :: mt_vti_name_len = 64
68 integer,
parameter :: mt_task_name_len = 128
69 double precision,
parameter :: mt_unset_real = huge(1.d0)
71 logical :: mt_enable = .false.
72 character(len=mt_task_name_len) :: mt_mode =
''
73 character(len=mt_task_name_len) :: mt_output_file =
''
74 character(len=mt_task_name_len) :: mt_output_prefix =
''
75 character(len=mt_task_name_len) :: mt_seed_file =
''
76 character(len=mt_task_name_len) :: mt_seed_surface =
''
77 character(len=mt_task_name_len) :: mt_seed_layout =
'endpoint'
78 character(len=mt_task_name_len) :: mt_vtk_detail =
'minimal'
79 character(len=mt_task_name_len) :: mt_step_control =
'global_cell_fraction'
80 character(len=mt_task_name_len) :: mt_trace_integrator =
'rk2'
81 double precision :: mt_dL = -1.d0
82 double precision :: mt_step_fraction = 0.25d0
83 double precision :: mt_dL_min = 0.d0
84 double precision :: mt_rk45_atol = 1.
d-8
85 double precision :: mt_rk45_rtol = 1.
d-6
86 double precision :: mt_rk45_safety = 0.9d0
87 double precision :: mt_rk45_min_shrink = 0.2d0
88 double precision :: mt_rk45_max_grow = 5.d0
89 double precision :: mt_rk45_tangent_floor = 1.d0
90 double precision :: mt_rk45_tangent_rtol = 2.
d-5
91 integer :: mt_max_steps = -1
92 double precision :: mt_max_steps_factor = 2.d0
93 double precision :: mt_b_min = -1.d0
94 double precision :: mt_seed_coord = mt_unset_real
95 double precision :: mt_seed_theta0 = mt_unset_real
96 double precision :: mt_seed_phi0 = mt_unset_real
97 double precision :: mt_seed_alpha = mt_unset_real
98 logical :: mt_compute_length = .true.
99 logical :: mt_compute_twist = .false.
100 logical :: mt_compute_q = .false.
101 logical :: mt_compute_qperp = .false.
102 logical :: mt_rk2_step_diagnostic = .false.
103 logical :: mt_rk45_step_diagnostic = .false.
104 logical :: mt_rk45_tangent_diagnostic = .false.
105 logical :: mt_rk2_fusion_diagnostic = .false.
106 logical :: mt_write_csv = .false.
107 character(len=mt_task_name_len) :: mt_plane =
''
108 double precision :: mt_origin(3) = mt_unset_real
109 double precision :: mt_e1(3) = mt_unset_real
110 double precision :: mt_e2(3) = mt_unset_real
111 double precision :: mt_xmin = mt_unset_real
112 double precision :: mt_xmax = mt_unset_real
113 double precision :: mt_ymin = mt_unset_real
114 double precision :: mt_ymax = mt_unset_real
115 double precision :: mt_zmin = mt_unset_real
116 double precision :: mt_zmax = mt_unset_real
117 double precision :: mt_x0 = mt_unset_real
118 double precision :: mt_y0 = mt_unset_real
119 double precision :: mt_z0 = mt_unset_real
120 integer :: mt_nx = -1
121 integer :: mt_ny = -1
122 integer :: mt_nz = -1
123 double precision :: mt_s1min = mt_unset_real
124 double precision :: mt_s1max = mt_unset_real
125 double precision :: mt_s2min = mt_unset_real
126 double precision :: mt_s2max = mt_unset_real
127 double precision :: mt_s3min = mt_unset_real
128 double precision :: mt_s3max = mt_unset_real
129 integer :: mt_n1 = -1
130 integer :: mt_n2 = -1
131 integer :: mt_n3 = -1
132 integer :: mt_chunk_nz = -1
133 logical :: mt_profile_spherical = .false.
135 type,
private :: mt_vti_array_desc
136 character(len=mt_vti_name_len) :: name
138 integer(kind=8) :: nbytes
139 integer(kind=8) :: offset
140 end type mt_vti_array_desc
142 type,
private :: mt_volume_products
143 double precision,
allocatable :: length_total(:)
144 double precision,
allocatable :: length_backward(:)
145 double precision,
allocatable :: length_forward(:)
146 integer,
allocatable :: nstep_backward_length(:)
147 integer,
allocatable :: nstep_forward_length(:)
148 integer,
allocatable :: status_backward_length(:)
149 integer,
allocatable :: status_forward_length(:)
150 double precision,
allocatable :: twist_total(:)
151 double precision,
allocatable :: twist_backward(:)
152 double precision,
allocatable :: twist_forward(:)
153 integer,
allocatable :: nstep_backward_twist(:)
154 integer,
allocatable :: nstep_forward_twist(:)
155 integer,
allocatable :: status_backward_twist(:)
156 integer,
allocatable :: status_forward_twist(:)
157 double precision,
allocatable :: q(:)
158 double precision,
allocatable :: logq(:)
159 double precision,
allocatable :: N2_q(:)
160 double precision,
allocatable :: bfactor_q(:)
161 double precision,
allocatable :: length_forward_q(:)
162 double precision,
allocatable :: length_backward_q(:)
163 double precision,
allocatable :: Bseed_norm_q(:)
164 double precision,
allocatable :: Bf_norm_q(:)
165 double precision,
allocatable :: Bb_norm_q(:)
166 integer,
allocatable :: valid_q(:)
167 integer,
allocatable :: status_q(:)
168 integer,
allocatable :: face_forward_q(:)
169 integer,
allocatable :: face_backward_q(:)
170 integer,
allocatable :: status_forward_q(:)
171 integer,
allocatable :: status_backward_q(:)
172 double precision,
allocatable :: qperp(:)
173 double precision,
allocatable :: logqperp(:)
174 double precision,
allocatable :: N2(:)
175 double precision,
allocatable :: bfactor(:)
176 double precision,
allocatable :: length_forward_qperp(:)
177 double precision,
allocatable :: length_backward_qperp(:)
178 double precision,
allocatable :: Bseed_norm(:)
179 double precision,
allocatable :: Bf_norm(:)
180 double precision,
allocatable :: Bb_norm(:)
181 integer,
allocatable :: valid_qperp(:)
182 integer,
allocatable :: status_qperp(:)
183 integer,
allocatable :: face_forward_qperp(:)
184 integer,
allocatable :: face_backward_qperp(:)
185 integer,
allocatable :: status_forward_qperp(:)
186 integer,
allocatable :: status_backward_qperp(:)
187 end type mt_volume_products
194 character(len=*),
intent(in) :: files(:)
198 namelist /magnetic_topology_list/ mt_enable,mt_mode,mt_output_file, &
199 mt_output_prefix,mt_seed_file,mt_vtk_detail, &
200 mt_seed_surface,mt_seed_layout,mt_seed_coord, &
201 mt_seed_theta0,mt_seed_phi0,mt_seed_alpha, &
202 mt_step_control,mt_dl,mt_step_fraction,mt_dl_min, &
203 mt_trace_integrator,mt_rk45_atol,mt_rk45_rtol, &
204 mt_rk45_safety,mt_rk45_min_shrink,mt_rk45_max_grow, &
205 mt_rk45_tangent_floor,mt_rk45_tangent_rtol, &
206 mt_max_steps,mt_max_steps_factor,mt_b_min, &
207 mt_compute_length,mt_compute_twist,mt_compute_q,mt_compute_qperp, &
208 mt_rk2_step_diagnostic,mt_rk45_step_diagnostic, &
209 mt_rk45_tangent_diagnostic,mt_rk2_fusion_diagnostic, &
210 mt_write_csv,mt_plane, &
211 mt_origin,mt_e1,mt_e2,mt_xmin,mt_xmax,mt_ymin,mt_ymax, &
212 mt_zmin,mt_zmax,mt_nx,mt_ny,mt_nz,mt_x0,mt_y0,mt_z0, &
213 mt_s1min,mt_s1max,mt_n1,mt_s2min,mt_s2max,mt_n2, &
214 mt_s3min,mt_s3max,mt_n3, &
215 mt_chunk_nz,mt_profile_spherical
217 call mt_set_default_params()
219 open(
unitpar,file=trim(files(n)),status=
'old')
220 read(
unitpar,magnetic_topology_list,
end=111)
227 character(len=mt_task_name_len) :: mode
228 logical :: report_rk2,report_rk45
230 if (.not.mt_enable)
return
232 mode=mt_lowercase(trim(mt_mode))
233 call mt_validate_common_params(mode)
234 call mt_validate_trace_integrator(mode)
235 call mt_apply_trace_step_control()
236 call mt_apply_auto_max_steps()
237 call trace_set_integrator(mt_trace_integrator,mt_rk45_atol, &
238 mt_rk45_rtol,mt_rk45_safety,mt_rk45_min_shrink, &
239 mt_rk45_max_grow,mt_rk45_tangent_floor,mt_rk45_tangent_rtol)
240 report_rk2=mt_lowercase(trim(mt_trace_integrator))==
'rk2' .and. &
241 mt_rk2_step_diagnostic
242 report_rk45=(mt_lowercase(trim(mt_trace_integrator))==
'rk45_cartesian' &
243 .or. mt_lowercase(trim(mt_trace_integrator))==
'rk45_spherical') &
244 .and. mt_rk45_step_diagnostic
245 call trace_rk2_stats_set_enabled(report_rk2)
246 call trace_rk45_stats_set_enabled(report_rk45)
247 if (report_rk2)
call trace_rk2_stats_reset()
248 if (report_rk45)
call trace_rk45_stats_reset()
249 if (mt_profile_spherical .and. &
250 trim(mode)/=
'spherical_surface_products' .and. &
251 trim(mode)/=
'spherical_cloud_products')
then
252 write(*,
'(a)')
'mt_run_topology_task: mt_profile_spherical applies '// &
253 'only to spherical topology modes'
256 select case (trim(mode))
257 case (
'axis_plane_full_vtu')
258 call mt_run_axis_plane_full_vtu_task()
260 call mt_run_volume_vti_task()
261 case (
'arbitrary_plane_products')
262 call mt_run_arbitrary_plane_products_task()
263 case (
'seed_products')
264 call mt_run_seed_products_task()
265 case (
'axis_plane_csv')
266 call mt_run_axis_plane_csv_task()
267 case (
'spherical_surface_products')
268 call mt_run_spherical_surface_products_task()
269 case (
'spherical_cloud_products')
270 call mt_run_spherical_cloud_products_task()
272 call mpistop(
'mt_run_topology_task: unknown mt_mode='//trim(mt_mode))
274 if (report_rk2)
call trace_rk2_stats_report(trim(mode))
275 call trace_rk2_stats_set_enabled(.false.)
276 if (report_rk45)
call trace_rk45_stats_report(trim(mode))
277 call trace_rk45_stats_set_enabled(.false.)
280 subroutine mt_set_default_params()
287 mt_seed_layout=
'endpoint'
288 mt_vtk_detail=
'minimal'
289 mt_step_control=
'global_cell_fraction'
290 mt_trace_integrator=
'rk2'
292 mt_step_fraction=0.25d0
297 mt_rk45_min_shrink=0.2d0
298 mt_rk45_max_grow=5.d0
299 mt_rk45_tangent_floor=1.d0
300 mt_rk45_tangent_rtol=2.d-5
302 mt_max_steps_factor=2.d0
304 mt_seed_coord=mt_unset_real
305 mt_seed_theta0=mt_unset_real
306 mt_seed_phi0=mt_unset_real
307 mt_seed_alpha=mt_unset_real
308 mt_compute_length=.true.
309 mt_compute_twist=.false.
311 mt_compute_qperp=.false.
312 mt_rk2_step_diagnostic=.false.
313 mt_rk45_step_diagnostic=.false.
314 mt_rk45_tangent_diagnostic=.false.
315 mt_rk2_fusion_diagnostic=.false.
318 mt_origin=mt_unset_real
321 mt_xmin=mt_unset_real
322 mt_xmax=mt_unset_real
323 mt_ymin=mt_unset_real
324 mt_ymax=mt_unset_real
325 mt_zmin=mt_unset_real
326 mt_zmax=mt_unset_real
333 mt_s1min=mt_unset_real
334 mt_s1max=mt_unset_real
335 mt_s2min=mt_unset_real
336 mt_s2max=mt_unset_real
337 mt_s3min=mt_unset_real
338 mt_s3max=mt_unset_real
343 mt_profile_spherical=.false.
344 end subroutine mt_set_default_params
346 subroutine mt_validate_common_params(mode)
347 character(len=*),
intent(in) :: mode
349 if (len_trim(mode)==0)
then
350 call mpistop(
'mt_run_topology_task requires mt_mode')
352 select case (trim(mode))
353 case (
'spherical_surface_products',
'spherical_cloud_products')
355 call mpistop(trim(mode)//
' requires 3D spherical geometry')
358 if (geo_coordinate/=geo_spherical)
then
359 call mpistop(trim(mode)//
' requires 3D spherical geometry')
362 call mpistop(trim(mode)//
' does not yet support periodic phi')
365 case (
'seed_products')
367 call mpistop(
'seed_products requires 3D Cartesian or spherical geometry')
370 select case (geo_coordinate)
371 case (geo_cartesian,geo_cartesian_stretched,geo_spherical)
373 call mpistop(
'seed_products requires Cartesian or spherical geometry')
375 if (geo_coordinate==geo_spherical .and. periodb(3))
then
376 call mpistop(
'spherical seed_products does not yet support periodic phi')
381 call mpistop(
'volume_vti requires 3D Cartesian geometry')
384 select case (geo_coordinate)
388 case (geo_cartesian_stretched)
392 call mpistop(
'volume_vti requires Cartesian geometry')
395 case (
'axis_plane_full_vtu',
'axis_plane_csv')
397 call mpistop(trim(mode)//
' requires 3D Cartesian geometry')
400 select case (geo_coordinate)
404 case (geo_cartesian_stretched)
406 call mpistop(trim(mode)//
' requires Cartesian geometry')
409 case (
'arbitrary_plane_products')
411 call mpistop(
'arbitrary_plane_products requires 3D Cartesian geometry')
414 select case (geo_coordinate)
415 case (geo_cartesian,geo_cartesian_stretched)
417 call mpistop(
'arbitrary_plane_products requires Cartesian geometry')
421 if (ndim/=3 .or. geo_coordinate/=geo_cartesian .or. &
422 .not.slab_uniform)
then
423 call mpistop(
'mt_run_topology_task mode requires 3D uniform Cartesian geometry')
426 if (len_trim(mt_output_file)==0 .and. &
427 len_trim(mt_output_prefix)==0)
then
428 call mpistop(
'mt_run_topology_task requires mt_output_file or mt_output_prefix')
430 select case (mt_lowercase(trim(mt_step_control)))
432 if (mt_dl<=0.d0)
then
433 call mpistop(
'mt_step_control=fixed requires mt_dL > 0')
435 case (
'cell_fraction')
436 select case (geo_coordinate)
437 case (geo_cartesian,geo_cartesian_stretched)
439 select case (trim(mode))
440 case (
'seed_products',
'spherical_surface_products', &
441 'spherical_cloud_products')
443 call mpistop(
'mt_step_control=cell_fraction is only supported '// &
444 'for spherical topology modes')
447 call mpistop(
'mt_step_control=cell_fraction requires Cartesian or '// &
448 'supported spherical geometry')
450 if (mt_step_fraction<=0.d0)
then
451 call mpistop(
'mt_step_control=cell_fraction requires '// &
452 'mt_step_fraction > 0')
454 if (mt_dl_min<0.d0)
then
455 call mpistop(
'mt_step_control=cell_fraction requires mt_dL_min >= 0')
457 case (
'global_cell_fraction')
458 if (mt_step_fraction<=0.d0)
then
459 call mpistop(
'mt_step_control=global_cell_fraction requires '// &
460 'mt_step_fraction > 0')
462 if (mt_dl_min<0.d0)
then
463 call mpistop(
'mt_step_control=global_cell_fraction requires mt_dL_min >= 0')
466 call mpistop(
'mt_run_topology_task requires mt_step_control=fixed '// &
467 'or cell_fraction/global_cell_fraction')
469 if (mt_max_steps<=0 .and. mt_max_steps_factor<=0.d0)
then
470 call mpistop(
'mt_max_steps auto requires mt_max_steps_factor > 0')
472 select case (mt_lowercase(trim(mt_vtk_detail)))
473 case (
'minimal',
'full')
475 call mpistop(
'mt_run_topology_task requires mt_vtk_detail=minimal or full')
477 end subroutine mt_validate_common_params
479 subroutine mt_validate_trace_integrator(mode)
480 character(len=*),
intent(in) :: mode
482 character(len=mt_task_name_len) :: integrator
484 integrator=mt_lowercase(trim(mt_trace_integrator))
485 select case (trim(integrator))
488 case (
'rk45_cartesian')
489 if (trim(mode)/=
'seed_products' .and. trim(mode)/=
'volume_vti' .and. &
490 trim(mode)/=
'arbitrary_plane_products' .and. &
491 trim(mode)/=
'axis_plane_full_vtu' .and. &
492 trim(mode)/=
'axis_plane_csv')
then
493 write(*,
'(a)')
'mt_trace_integrator=rk45_cartesian supports '// &
494 'only Cartesian seed_products, volume_vti, arbitrary_plane_products, '// &
495 'or axis-plane products'
497 call mpistop(
'mt_trace_integrator=rk45_cartesian supports '// &
498 'only seed_products, volume_vti, arbitrary_plane_products, '// &
499 'or axis-plane products')
502 call mpistop(
'mt_trace_integrator=rk45_cartesian requires 3D Cartesian geometry')
505 select case (geo_coordinate)
506 case (geo_cartesian,geo_cartesian_stretched)
508 write(*,
'(a)')
'mt_trace_integrator=rk45_cartesian is Cartesian-only'
510 call mpistop(
'mt_trace_integrator=rk45_cartesian is Cartesian-only')
513 if (mt_rk45_atol<0.d0 .or. mt_rk45_rtol<0.d0 .or. &
514 mt_rk45_atol+mt_rk45_rtol<=0.d0)
then
515 call mpistop(
'mt_trace_integrator=rk45_cartesian requires '// &
516 'non-negative tolerances with atol+rtol > 0')
518 if (mt_rk45_safety<=0.d0 .or. mt_rk45_safety>1.d0)
then
519 call mpistop(
'mt_rk45_safety must be in (0,1]')
521 if (mt_rk45_min_shrink<=0.d0 .or. mt_rk45_min_shrink>1.d0)
then
522 call mpistop(
'mt_rk45_min_shrink must be in (0,1]')
524 if (mt_rk45_max_grow<1.d0)
then
525 call mpistop(
'mt_rk45_max_grow must be >= 1')
527 if (mt_rk45_tangent_floor<=0.d0)
then
528 call mpistop(
'mt_rk45_tangent_floor must be > 0')
530 if (mt_rk45_tangent_rtol<=0.d0)
then
531 call mpistop(
'mt_rk45_tangent_rtol must be > 0')
533 case (
'rk45_spherical')
534 if (trim(mode)/=
'seed_products' .and. &
535 trim(mode)/=
'spherical_cloud_products' .and. &
536 trim(mode)/=
'spherical_surface_products')
then
537 write(*,
'(a)')
'mt_trace_integrator=rk45_spherical supports '// &
538 'only spherical seed_products, spherical_cloud_products, '// &
539 'or spherical_surface_products'
541 call mpistop(
'mt_trace_integrator=rk45_spherical supports '// &
542 'only seed_products, spherical_cloud_products, '// &
543 'or spherical_surface_products')
546 call mpistop(
'mt_trace_integrator=rk45_spherical requires 3D spherical geometry')
549 if (geo_coordinate/=geo_spherical)
then
550 write(*,
'(a)')
'mt_trace_integrator=rk45_spherical is spherical-only'
552 call mpistop(
'mt_trace_integrator=rk45_spherical is spherical-only')
555 call mpistop(
'mt_trace_integrator=rk45_spherical does not yet support periodic phi')
558 if (mt_compute_q)
then
560 if (geo_coordinate/=geo_spherical)
then
561 call mpistop(
'mt_trace_integrator=rk45_spherical standard '// &
562 'logQ currently requires spherical geometry')
566 if (mt_rk45_atol<0.d0 .or. mt_rk45_rtol<0.d0 .or. &
567 mt_rk45_atol+mt_rk45_rtol<=0.d0)
then
568 call mpistop(
'mt_trace_integrator=rk45_spherical requires '// &
569 'non-negative tolerances with atol+rtol > 0')
571 if (mt_rk45_safety<=0.d0 .or. mt_rk45_safety>1.d0)
then
572 call mpistop(
'mt_rk45_safety must be in (0,1]')
574 if (mt_rk45_min_shrink<=0.d0 .or. mt_rk45_min_shrink>1.d0)
then
575 call mpistop(
'mt_rk45_min_shrink must be in (0,1]')
577 if (mt_rk45_max_grow<1.d0)
then
578 call mpistop(
'mt_rk45_max_grow must be >= 1')
580 if (mt_rk45_tangent_floor<=0.d0)
then
581 call mpistop(
'mt_rk45_tangent_floor must be > 0')
583 if (mt_rk45_tangent_rtol<=0.d0)
then
584 call mpistop(
'mt_rk45_tangent_rtol must be > 0')
587 call mpistop(
'mt_trace_integrator must be rk2, rk45_cartesian, or rk45_spherical')
589 if (mt_rk45_tangent_diagnostic)
then
590 if (trim(mode)/=
'seed_products')
then
591 call mpistop(
'mt_rk45_tangent_diagnostic requires seed_products')
593 if (trim(integrator)/=
'rk45_cartesian')
then
594 call mpistop(
'mt_rk45_tangent_diagnostic requires '// &
595 'mt_trace_integrator=rk45_cartesian')
597 if (mt_compute_q .or. mt_compute_qperp)
then
598 call mpistop(
'mt_rk45_tangent_diagnostic is q0 diagnostic-only; '// &
599 'disable public Q and Qperp')
601 if (ndim/=3 .or. .not.slab_uniform)
then
602 call mpistop(
'mt_rk45_tangent_diagnostic requires 3D uniform Cartesian geometry')
605 if (geo_coordinate/=geo_cartesian)
then
606 call mpistop(
'mt_rk45_tangent_diagnostic requires Cartesian geometry')
610 if (mt_rk2_fusion_diagnostic)
then
611 if (trim(mode)/=
'seed_products')
then
612 call mpistop(
'mt_rk2_fusion_diagnostic requires seed_products')
614 if (trim(integrator)/=
'rk2')
then
615 call mpistop(
'mt_rk2_fusion_diagnostic requires '// &
616 'mt_trace_integrator=rk2')
618 if (.not.mt_compute_twist)
then
619 call mpistop(
'mt_rk2_fusion_diagnostic requires twist diagnostics')
621 if (mt_compute_q .or. mt_compute_qperp)
then
622 call mpistop(
'mt_rk2_fusion_diagnostic is q0 diagnostic-only; '// &
623 'disable public Q and Qperp')
626 end subroutine mt_validate_trace_integrator
628 subroutine mt_apply_trace_step_control()
629 character(len=mt_task_name_len) :: step_mode
630 double precision :: hmin,dl_eff,dl_cap
633 step_mode=mt_lowercase(trim(mt_step_control))
634 select case (trim(step_mode))
635 case (
'cell_fraction')
636 if ((geo_coordinate==geo_cartesian .or. &
637 geo_coordinate==geo_cartesian_stretched .or. &
638 geo_coordinate==geo_spherical) .and. mt_dl<=0.d0)
then
639 dl_cap=mt_domain_diagonal()
640 if (dl_cap<=0.d0)
then
641 call mpistop(
'mt_step_control=cell_fraction could not determine '// &
645 write(*,
'(a,es16.8,a,es16.8,a,es16.8)') &
646 'mt_step_control=cell_fraction: mt_step_fraction=', &
647 mt_step_fraction,
', automatic dL_cap=',mt_dl, &
648 ', mt_dL_min=',mt_dl_min
650 write(*,
'(a,es16.8,a,es16.8,a,es16.8)') &
651 'mt_step_control=cell_fraction: mt_step_fraction=', &
652 mt_step_fraction,
', mt_dL_cap=',mt_dl, &
653 ', mt_dL_min=',mt_dl_min
655 call trace_set_step_control(
'cell_fraction',mt_step_fraction,mt_dl_min)
656 case (
'global_cell_fraction')
657 select case (geo_coordinate)
658 case (geo_cartesian,geo_cartesian_stretched)
659 call trace_cartesian_global_min_cell_size(hmin,status)
661 call trace_spherical_global_min_cell_size(hmin,status)
663 status=trace_status_unsupported_geometry
666 if (status/=trace_status_active .or. hmin<=0.d0)
then
667 call mpistop(
'mt_step_control=global_cell_fraction could not determine h_global_min')
669 dl_eff=mt_step_fraction*hmin
670 if (mt_dl>0.d0) dl_eff=min(dl_eff,mt_dl)
671 if (mt_dl_min>0.d0)
then
673 dl_eff=max(dl_eff,min(mt_dl_min,mt_dl))
675 dl_eff=max(dl_eff,mt_dl_min)
678 if (dl_eff<=0.d0)
then
679 call mpistop(
'mt_step_control=global_cell_fraction produced non-positive mt_dL')
682 write(*,
'(a,es16.8,a,es16.8,a,es16.8,a,es16.8)') &
683 'mt_step_control=global_cell_fraction: h_global_min=',hmin, &
684 ', mt_step_fraction=',mt_step_fraction,
', mt_dL_cap=',mt_dl, &
685 ', effective_mt_dL=',dl_eff
687 write(*,
'(a,es16.8,a,es16.8,a,es16.8)') &
688 'mt_step_control=global_cell_fraction: h_global_min=',hmin, &
689 ', mt_step_fraction=',mt_step_fraction,
', effective_mt_dL=',dl_eff
692 call trace_set_step_control(
'fixed',mt_step_fraction,mt_dl_min)
694 call trace_set_step_control(
'fixed',mt_step_fraction,mt_dl_min)
696 end subroutine mt_apply_trace_step_control
698 subroutine mt_apply_auto_max_steps()
699 character(len=mt_task_name_len) :: step_mode
700 double precision :: hmin,step_est,ldiag,nsteps_real
703 if (mt_max_steps>0)
return
705 ldiag=mt_domain_diagonal()
706 if (ldiag<=0.d0)
then
707 call mpistop(
'mt_max_steps auto could not determine domain diagonal')
710 step_mode=mt_lowercase(trim(mt_step_control))
711 select case (trim(step_mode))
714 case (
'cell_fraction',
'global_cell_fraction')
715 select case (geo_coordinate)
716 case (geo_cartesian,geo_cartesian_stretched)
717 call trace_cartesian_global_min_cell_size(hmin,status)
719 call trace_spherical_global_min_cell_size(hmin,status)
721 status=trace_status_unsupported_geometry
724 if (status/=trace_status_active .or. hmin<=0.d0)
then
725 call mpistop(
'mt_max_steps auto could not determine h_global_min')
727 step_est=mt_step_fraction*hmin
728 if (mt_dl>0.d0) step_est=min(step_est,mt_dl)
733 if (step_est<=0.d0)
then
734 call mpistop(
'mt_max_steps auto produced non-positive step estimate')
736 nsteps_real=mt_max_steps_factor*ldiag/step_est
737 if (nsteps_real>dble(huge(mt_max_steps)-1))
then
738 call mpistop(
'mt_max_steps auto estimate exceeds integer range')
740 mt_max_steps=max(1,ceiling(nsteps_real))
741 write(*,
'(a,es16.8,a,es16.8,a,es16.8,a,es16.8,a,i0)') &
742 'mt_max_steps auto: Ldiag=',ldiag,
', step_est=',step_est, &
743 ', factor=',mt_max_steps_factor,
', nsteps_real=',nsteps_real, &
744 ', mt_max_steps=',mt_max_steps
745 end subroutine mt_apply_auto_max_steps
747 double precision function mt_domain_diagonal()
result(Ldiag)
749 double precision :: r,theta,phi,dist
750 double precision :: corners(8,3),dx(3)
752 ldiag=abs(xprobmax1-xprobmin1)
754 if (geo_coordinate==geo_spherical)
then
775 corners(n,1)=r*dsin(theta)*dcos(phi)
776 corners(n,2)=r*dsin(theta)*dsin(phi)
777 corners(n,3)=r*dcos(theta)
785 dx(m)=corners(i,m)-corners(j,m)
787 dist=dsqrt(sum(dx*dx))
788 ldiag=max(ldiag,dist)
792 ldiag=dsqrt((xprobmax1-xprobmin1)**2+ &
793 (xprobmax2-xprobmin2)**2+(xprobmax3-xprobmin3)**2)
796 end function mt_domain_diagonal
798 subroutine mt_run_axis_plane_full_vtu_task()
799 character(len=mt_task_name_len) :: plane
800 character(len=mt_task_name_len) :: output_file
801 logical :: minimal_output
803 plane=mt_lowercase(trim(mt_plane))
804 minimal_output=.not.mt_vtk_detail_is_full()
805 if (minimal_output)
then
806 call mt_resolve_output_file(
'axis_plane_full_vtu',
'.vti', &
807 '_'//trim(plane)//
'_minimal.vti',output_file)
809 call mt_resolve_output_file(
'axis_plane_full_vtu',
'.vtu', &
810 '_'//trim(plane)//
'_full.vtu',output_file)
812 if (.not.minimal_output .and. &
813 (mt_compute_twist .or. mt_compute_q .or. mt_compute_qperp))
then
814 write(*,
'(a)')
'mt_run_topology_task: axis_plane_full_vtu ignores compute flags'
815 write(*,
'(a)')
'mt_run_topology_task: it always writes full plane products'
818 select case (trim(plane))
820 call mt_require_real(
'mt_xmin',mt_xmin)
821 call mt_require_real(
'mt_xmax',mt_xmax)
822 call mt_require_real(
'mt_ymin',mt_ymin)
823 call mt_require_real(
'mt_ymax',mt_ymax)
824 call mt_require_real(
'mt_z0',mt_z0)
825 call mt_require_positive_int(
'mt_nx',mt_nx)
826 call mt_require_positive_int(
'mt_ny',mt_ny)
827 call mt_require_ordered(
'mt_xmin',
'mt_xmax',mt_xmin,mt_xmax)
828 call mt_require_ordered(
'mt_ymin',
'mt_ymax',mt_ymin,mt_ymax)
829 if (minimal_output)
then
830 write(*,
'(a)')
'mt_run_topology_task: writing axis-plane minimal VTI '//trim(output_file)
831 if (mt_b_min>0.d0)
then
832 call mt_qsl_plane_vti_xy(mt_xmin,mt_xmax,mt_nx,mt_ymin,mt_ymax, &
833 mt_ny,mt_z0,mt_dl,mt_max_steps,trim(output_file), &
834 mt_compute_length,mt_compute_twist,mt_compute_q, &
835 mt_compute_qperp,b_min=mt_b_min)
837 call mt_qsl_plane_vti_xy(mt_xmin,mt_xmax,mt_nx,mt_ymin,mt_ymax, &
838 mt_ny,mt_z0,mt_dl,mt_max_steps,trim(output_file), &
839 mt_compute_length,mt_compute_twist,mt_compute_q, &
843 write(*,
'(a)')
'mt_run_topology_task: writing axis-plane full VTU '//trim(output_file)
844 if (mt_b_min>0.d0)
then
846 mt_ny,mt_z0,mt_dl,mt_max_steps,trim(output_file), &
850 mt_ny,mt_z0,mt_dl,mt_max_steps,trim(output_file))
854 call mt_require_real(
'mt_xmin',mt_xmin)
855 call mt_require_real(
'mt_xmax',mt_xmax)
856 call mt_require_real(
'mt_zmin',mt_zmin)
857 call mt_require_real(
'mt_zmax',mt_zmax)
858 call mt_require_real(
'mt_y0',mt_y0)
859 call mt_require_positive_int(
'mt_nx',mt_nx)
860 call mt_require_positive_int(
'mt_nz',mt_nz)
861 call mt_require_ordered(
'mt_xmin',
'mt_xmax',mt_xmin,mt_xmax)
862 call mt_require_ordered(
'mt_zmin',
'mt_zmax',mt_zmin,mt_zmax)
863 if (minimal_output)
then
864 write(*,
'(a)')
'mt_run_topology_task: writing axis-plane minimal VTI '//trim(output_file)
865 if (mt_b_min>0.d0)
then
866 call mt_qsl_plane_vti_xz(mt_xmin,mt_xmax,mt_nx,mt_zmin,mt_zmax, &
867 mt_nz,mt_y0,mt_dl,mt_max_steps,trim(output_file), &
868 mt_compute_length,mt_compute_twist,mt_compute_q, &
869 mt_compute_qperp,b_min=mt_b_min)
871 call mt_qsl_plane_vti_xz(mt_xmin,mt_xmax,mt_nx,mt_zmin,mt_zmax, &
872 mt_nz,mt_y0,mt_dl,mt_max_steps,trim(output_file), &
873 mt_compute_length,mt_compute_twist,mt_compute_q, &
877 write(*,
'(a)')
'mt_run_topology_task: writing axis-plane full VTU '//trim(output_file)
878 if (mt_b_min>0.d0)
then
880 mt_nz,mt_y0,mt_dl,mt_max_steps,trim(output_file), &
884 mt_nz,mt_y0,mt_dl,mt_max_steps,trim(output_file))
888 call mt_require_real(
'mt_ymin',mt_ymin)
889 call mt_require_real(
'mt_ymax',mt_ymax)
890 call mt_require_real(
'mt_zmin',mt_zmin)
891 call mt_require_real(
'mt_zmax',mt_zmax)
892 call mt_require_real(
'mt_x0',mt_x0)
893 call mt_require_positive_int(
'mt_ny',mt_ny)
894 call mt_require_positive_int(
'mt_nz',mt_nz)
895 call mt_require_ordered(
'mt_ymin',
'mt_ymax',mt_ymin,mt_ymax)
896 call mt_require_ordered(
'mt_zmin',
'mt_zmax',mt_zmin,mt_zmax)
897 if (minimal_output)
then
898 write(*,
'(a)')
'mt_run_topology_task: writing axis-plane minimal VTI '//trim(output_file)
899 if (mt_b_min>0.d0)
then
900 call mt_qsl_plane_vti_yz(mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax, &
901 mt_nz,mt_x0,mt_dl,mt_max_steps,trim(output_file), &
902 mt_compute_length,mt_compute_twist,mt_compute_q, &
903 mt_compute_qperp,b_min=mt_b_min)
905 call mt_qsl_plane_vti_yz(mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax, &
906 mt_nz,mt_x0,mt_dl,mt_max_steps,trim(output_file), &
907 mt_compute_length,mt_compute_twist,mt_compute_q, &
911 write(*,
'(a)')
'mt_run_topology_task: writing axis-plane full VTU '//trim(output_file)
912 if (mt_b_min>0.d0)
then
914 mt_nz,mt_x0,mt_dl,mt_max_steps,trim(output_file), &
918 mt_nz,mt_x0,mt_dl,mt_max_steps,trim(output_file))
922 call mpistop(
'mt_run_topology_task: axis_plane_full_vtu requires mt_plane=xy, xz, or yz')
924 end subroutine mt_run_axis_plane_full_vtu_task
926 subroutine mt_run_axis_plane_csv_task()
927 character(len=mt_task_name_len) :: plane
928 character(len=mt_task_name_len) :: length_csv,twist_csv
929 character(len=mt_task_name_len) :: q_csv
930 character(len=mt_task_name_len) :: qperp_csv
932 if (len_trim(mt_output_prefix)==0)
then
933 call mpistop(
'axis_plane_csv requires mt_output_prefix')
935 if (len_trim(mt_output_file)>0)
then
936 write(*,
'(a)')
'mt_run_topology_task: axis_plane_csv ignores mt_output_file'
937 write(*,
'(a)')
'mt_run_topology_task: axis_plane_csv uses mt_output_prefix for CSV outputs'
940 plane=mt_lowercase(trim(mt_plane))
941 call mt_resolve_prefix_file(
'_'//trim(plane)//
'_length.csv', &
942 length_csv,
'axis_plane_csv length requires mt_output_prefix')
946 if (mt_compute_twist)
then
947 call mt_resolve_prefix_file(
'_'//trim(plane)//
'_twist.csv', &
948 twist_csv,
'axis_plane_csv twist requires mt_output_prefix')
950 if (mt_compute_q)
then
951 call mt_resolve_prefix_file(
'_'//trim(plane)//
'_q.csv', &
952 q_csv,
'axis_plane_csv Q requires mt_output_prefix')
954 if (mt_compute_qperp)
then
955 call mt_resolve_prefix_file(
'_'//trim(plane)//
'_qperp_method2.csv', &
956 qperp_csv,
'axis_plane_csv Qperp requires mt_output_prefix')
959 select case (trim(plane))
961 call mt_require_real(
'mt_xmin',mt_xmin)
962 call mt_require_real(
'mt_xmax',mt_xmax)
963 call mt_require_real(
'mt_ymin',mt_ymin)
964 call mt_require_real(
'mt_ymax',mt_ymax)
965 call mt_require_real(
'mt_z0',mt_z0)
966 call mt_require_positive_int(
'mt_nx',mt_nx)
967 call mt_require_positive_int(
'mt_ny',mt_ny)
968 call mt_require_ordered(
'mt_xmin',
'mt_xmax',mt_xmin,mt_xmax)
969 call mt_require_ordered(
'mt_ymin',
'mt_ymax',mt_ymin,mt_ymax)
970 if (mt_b_min>0.d0)
then
971 call mt_axis_plane_products_csv_axis(mt_xmin,mt_xmax,mt_nx, &
972 mt_ymin,mt_ymax,mt_ny,mt_z0,1,2,3,mt_dl,mt_max_steps, &
973 trim(length_csv),trim(twist_csv),trim(q_csv), &
974 trim(qperp_csv),
'mt_axis_plane_products_csv_xy',
'ix,iy', &
975 'ix,iy',b_min=mt_b_min)
977 call mt_axis_plane_products_csv_axis(mt_xmin,mt_xmax,mt_nx, &
978 mt_ymin,mt_ymax,mt_ny,mt_z0,1,2,3,mt_dl,mt_max_steps, &
979 trim(length_csv),trim(twist_csv),trim(q_csv), &
980 trim(qperp_csv),
'mt_axis_plane_products_csv_xy',
'ix,iy', &
984 call mt_require_real(
'mt_xmin',mt_xmin)
985 call mt_require_real(
'mt_xmax',mt_xmax)
986 call mt_require_real(
'mt_zmin',mt_zmin)
987 call mt_require_real(
'mt_zmax',mt_zmax)
988 call mt_require_real(
'mt_y0',mt_y0)
989 call mt_require_positive_int(
'mt_nx',mt_nx)
990 call mt_require_positive_int(
'mt_nz',mt_nz)
991 call mt_require_ordered(
'mt_xmin',
'mt_xmax',mt_xmin,mt_xmax)
992 call mt_require_ordered(
'mt_zmin',
'mt_zmax',mt_zmin,mt_zmax)
993 if (mt_b_min>0.d0)
then
994 call mt_axis_plane_products_csv_axis(mt_xmin,mt_xmax,mt_nx, &
995 mt_zmin,mt_zmax,mt_nz,mt_y0,1,3,2,mt_dl,mt_max_steps, &
996 trim(length_csv),trim(twist_csv),trim(q_csv), &
997 trim(qperp_csv),
'mt_axis_plane_products_csv_xz',
'ix,iz', &
998 'i,j',b_min=mt_b_min)
1000 call mt_axis_plane_products_csv_axis(mt_xmin,mt_xmax,mt_nx, &
1001 mt_zmin,mt_zmax,mt_nz,mt_y0,1,3,2,mt_dl,mt_max_steps, &
1002 trim(length_csv),trim(twist_csv),trim(q_csv), &
1003 trim(qperp_csv),
'mt_axis_plane_products_csv_xz',
'ix,iz', &
1007 call mt_require_real(
'mt_ymin',mt_ymin)
1008 call mt_require_real(
'mt_ymax',mt_ymax)
1009 call mt_require_real(
'mt_zmin',mt_zmin)
1010 call mt_require_real(
'mt_zmax',mt_zmax)
1011 call mt_require_real(
'mt_x0',mt_x0)
1012 call mt_require_positive_int(
'mt_ny',mt_ny)
1013 call mt_require_positive_int(
'mt_nz',mt_nz)
1014 call mt_require_ordered(
'mt_ymin',
'mt_ymax',mt_ymin,mt_ymax)
1015 call mt_require_ordered(
'mt_zmin',
'mt_zmax',mt_zmin,mt_zmax)
1016 if (mt_b_min>0.d0)
then
1017 call mt_axis_plane_products_csv_axis(mt_ymin,mt_ymax,mt_ny, &
1018 mt_zmin,mt_zmax,mt_nz,mt_x0,2,3,1,mt_dl,mt_max_steps, &
1019 trim(length_csv),trim(twist_csv),trim(q_csv), &
1020 trim(qperp_csv),
'mt_axis_plane_products_csv_yz',
'iy,iz', &
1021 'i,j',b_min=mt_b_min)
1023 call mt_axis_plane_products_csv_axis(mt_ymin,mt_ymax,mt_ny, &
1024 mt_zmin,mt_zmax,mt_nz,mt_x0,2,3,1,mt_dl,mt_max_steps, &
1025 trim(length_csv),trim(twist_csv),trim(q_csv), &
1026 trim(qperp_csv),
'mt_axis_plane_products_csv_yz',
'iy,iz', &
1030 call mpistop(
'mt_run_topology_task: axis_plane_csv requires mt_plane=xy, xz, or yz')
1033 write(*,
'(a)')
'mt_run_topology_task: wrote axis-plane CSV length '// &
1035 if (mt_compute_twist)
write(*,
'(a)') &
1036 'mt_run_topology_task: wrote axis-plane CSV twist '//trim(twist_csv)
1037 if (mt_compute_q)
write(*,
'(a)') &
1038 'mt_run_topology_task: wrote axis-plane CSV Q '//trim(q_csv)
1039 if (mt_compute_qperp)
write(*,
'(a)') &
1040 'mt_run_topology_task: wrote axis-plane CSV Qperp '//trim(qperp_csv)
1041 end subroutine mt_run_axis_plane_csv_task
1043 subroutine mt_run_volume_vti_task()
1044 character(len=mt_task_name_len) :: output_file
1046 call mt_resolve_output_file(
'volume_vti',
'.vti',
'_volume.vti', &
1048 call mt_require_real(
'mt_xmin',mt_xmin)
1049 call mt_require_real(
'mt_xmax',mt_xmax)
1050 call mt_require_real(
'mt_ymin',mt_ymin)
1051 call mt_require_real(
'mt_ymax',mt_ymax)
1052 call mt_require_real(
'mt_zmin',mt_zmin)
1053 call mt_require_real(
'mt_zmax',mt_zmax)
1054 call mt_require_positive_int(
'mt_nx',mt_nx)
1055 call mt_require_positive_int(
'mt_ny',mt_ny)
1056 call mt_require_positive_int(
'mt_nz',mt_nz)
1057 call mt_require_ordered(
'mt_xmin',
'mt_xmax',mt_xmin,mt_xmax)
1058 call mt_require_ordered(
'mt_ymin',
'mt_ymax',mt_ymin,mt_ymax)
1059 call mt_require_ordered(
'mt_zmin',
'mt_zmax',mt_zmin,mt_zmax)
1060 write(*,
'(a)')
'mt_run_topology_task: writing volume VTI '//trim(output_file)
1061 if (mt_b_min>0.d0)
then
1062 if (mt_chunk_nz>0)
then
1064 mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax,mt_nz, &
1065 mt_dl,mt_max_steps,trim(output_file),b_min=mt_b_min, &
1066 compute_twist=mt_compute_twist, &
1067 compute_length=mt_compute_length, &
1068 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1069 chunk_nz=mt_chunk_nz)
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)
1079 if (mt_chunk_nz>0)
then
1081 mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax,mt_nz, &
1082 mt_dl,mt_max_steps,trim(output_file), &
1083 compute_twist=mt_compute_twist, &
1084 compute_length=mt_compute_length, &
1085 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1086 chunk_nz=mt_chunk_nz)
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)
1096 end subroutine mt_run_volume_vti_task
1098 subroutine mt_run_arbitrary_plane_products_task()
1099 character(len=mt_task_name_len) :: vtu_file,csv_file
1101 call mt_resolve_output_file(
'arbitrary_plane_products',
'.vtu', &
1102 '_arbitrary_plane_products.vtu',vtu_file)
1104 if (mt_write_csv)
then
1105 call mt_resolve_prefix_file(
'_arbitrary_plane_products.csv',csv_file, &
1106 'arbitrary_plane_products CSV requires mt_output_prefix')
1108 call mt_require_real(
'mt_origin(1)',mt_origin(1))
1109 call mt_require_real(
'mt_origin(2)',mt_origin(2))
1110 call mt_require_real(
'mt_origin(3)',mt_origin(3))
1111 call mt_require_real(
'mt_e1(1)',mt_e1(1))
1112 call mt_require_real(
'mt_e1(2)',mt_e1(2))
1113 call mt_require_real(
'mt_e1(3)',mt_e1(3))
1114 call mt_require_real(
'mt_e2(1)',mt_e2(1))
1115 call mt_require_real(
'mt_e2(2)',mt_e2(2))
1116 call mt_require_real(
'mt_e2(3)',mt_e2(3))
1117 call mt_require_real(
'mt_s1min',mt_s1min)
1118 call mt_require_real(
'mt_s1max',mt_s1max)
1119 call mt_require_real(
'mt_s2min',mt_s2min)
1120 call mt_require_real(
'mt_s2max',mt_s2max)
1121 call mt_require_positive_int(
'mt_n1',mt_n1)
1122 call mt_require_positive_int(
'mt_n2',mt_n2)
1123 call mt_require_ordered(
'mt_s1min',
'mt_s1max',mt_s1min,mt_s1max)
1124 call mt_require_ordered(
'mt_s2min',
'mt_s2max',mt_s2min,mt_s2max)
1126 write(*,
'(a)')
'mt_run_topology_task: writing arbitrary-plane VTU '// &
1128 if (mt_write_csv)
then
1129 write(*,
'(a)')
'mt_run_topology_task: writing arbitrary-plane CSV '// &
1133 if (mt_b_min>0.d0)
then
1135 mt_e1(1:ndim),mt_e2(1:ndim),mt_s1min,mt_s1max,mt_n1, &
1136 mt_s2min,mt_s2max,mt_n2,mt_dl,mt_max_steps,trim(csv_file), &
1137 b_min=mt_b_min,compute_length=mt_compute_length, &
1138 compute_twist=mt_compute_twist, &
1139 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1140 vtu_file=trim(vtu_file),write_csv=mt_write_csv)
1143 mt_e1(1:ndim),mt_e2(1:ndim),mt_s1min,mt_s1max,mt_n1, &
1144 mt_s2min,mt_s2max,mt_n2,mt_dl,mt_max_steps,trim(csv_file), &
1145 compute_length=mt_compute_length, &
1146 compute_twist=mt_compute_twist, &
1147 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1148 vtu_file=trim(vtu_file),write_csv=mt_write_csv)
1150 end subroutine mt_run_arbitrary_plane_products_task
1152 subroutine mt_run_seed_products_task()
1153 character(len=mt_task_name_len) :: csv_file,vtu_file,diag_file
1154 character(len=mt_task_name_len) :: rk2_diag_file
1155 double precision,
allocatable :: seeds(:,:)
1158 if (len_trim(mt_output_prefix)==0)
then
1159 call mpistop(
'seed_products requires mt_output_prefix')
1161 if (len_trim(mt_output_file)>0)
then
1162 write(*,
'(a)')
'mt_run_topology_task: seed_products ignores mt_output_file'
1163 write(*,
'(a)')
'mt_run_topology_task: seed_products uses mt_output_prefix for CSV and VTU'
1165 if (len_trim(mt_seed_file)==0)
then
1166 call mpistop(
'seed_products requires mt_seed_file')
1170 if (mt_write_csv)
then
1171 call mt_resolve_prefix_file(
'_seed_products.csv',csv_file, &
1172 'seed_products CSV requires mt_output_prefix')
1174 call mt_resolve_prefix_file(
'_seed_products.vtu',vtu_file, &
1175 'seed_products VTU requires mt_output_prefix')
1176 if (mt_rk45_tangent_diagnostic)
then
1177 call mt_resolve_prefix_file(
'_rk45_tangent_diag.csv',diag_file, &
1178 'seed_products RK45 tangent diagnostic requires mt_output_prefix')
1180 if (mt_rk2_fusion_diagnostic)
then
1181 call mt_resolve_prefix_file(
'_rk2_fusion_diag.csv',rk2_diag_file, &
1182 'seed_products RK2 fusion diagnostic requires mt_output_prefix')
1184 call mt_read_seed_file(trim(mt_seed_file),seeds,nseed)
1186 if (mt_write_csv)
write(*,
'(a)') &
1187 'mt_run_topology_task: writing seed-products CSV '//trim(csv_file)
1188 write(*,
'(a)')
'mt_run_topology_task: writing seed-products VTU '// &
1191 if (mt_b_min>0.d0)
then
1193 trim(csv_file),b_min=mt_b_min,compute_length=mt_compute_length, &
1194 compute_twist=mt_compute_twist, &
1195 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1196 vtu_file=trim(vtu_file))
1197 if (mt_rk45_tangent_diagnostic)
then
1198 write(*,
'(a)')
'mt_run_topology_task: writing RK45 tangent '// &
1199 'diagnostic CSV '//trim(diag_file)
1200 call mt_rk45_tangent_diagnostic_seeds(seeds,nseed,mt_dl, &
1201 mt_max_steps,trim(diag_file),b_min=mt_b_min)
1203 if (mt_rk2_fusion_diagnostic)
then
1204 write(*,
'(a)')
'mt_run_topology_task: writing RK2 fusion '// &
1205 'diagnostic CSV '//trim(rk2_diag_file)
1206 call mt_rk2_fusion_diagnostic_seeds(seeds,nseed,mt_dl, &
1207 mt_max_steps,trim(rk2_diag_file),b_min=mt_b_min)
1211 trim(csv_file),compute_length=mt_compute_length, &
1212 compute_twist=mt_compute_twist, &
1213 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1214 vtu_file=trim(vtu_file))
1215 if (mt_rk45_tangent_diagnostic)
then
1216 write(*,
'(a)')
'mt_run_topology_task: writing RK45 tangent '// &
1217 'diagnostic CSV '//trim(diag_file)
1218 call mt_rk45_tangent_diagnostic_seeds(seeds,nseed,mt_dl, &
1219 mt_max_steps,trim(diag_file))
1221 if (mt_rk2_fusion_diagnostic)
then
1222 write(*,
'(a)')
'mt_run_topology_task: writing RK2 fusion '// &
1223 'diagnostic CSV '//trim(rk2_diag_file)
1224 call mt_rk2_fusion_diagnostic_seeds(seeds,nseed,mt_dl, &
1225 mt_max_steps,trim(rk2_diag_file))
1230 end subroutine mt_run_seed_products_task
1232 subroutine mt_run_spherical_surface_products_task()
1233 character(len=mt_task_name_len) :: surface,csv_file,vtu_file,suffix
1234 double precision :: seed_coord,s1_min,s1_max,s2_min,s2_max
1235 double precision :: seed_theta0,seed_phi0,seed_alpha
1237 surface=mt_lowercase(trim(mt_seed_surface))
1238 if (len_trim(surface)==0) surface=
'rmin'
1239 select case (trim(surface))
1241 seed_coord=xprobmin1
1242 case (
'rconst',
'r_const')
1244 call mt_require_real(
'mt_seed_coord',mt_seed_coord)
1245 seed_coord=mt_seed_coord
1246 if (seed_coord<xprobmin1 .or. seed_coord>xprobmax1)
then
1247 call mpistop(
'spherical_surface_products requires rconst '// &
1248 'mt_seed_coord inside domain')
1251 case (
'theta_const',
'thetaconst')
1252 surface=
'theta_const'
1253 call mt_require_real(
'mt_seed_coord',mt_seed_coord)
1254 seed_coord=mt_seed_coord
1255 if (seed_coord<xprobmin2 .or. seed_coord>xprobmax2)
then
1256 call mpistop(
'spherical_surface_products requires theta_const '// &
1257 'mt_seed_coord inside domain')
1259 case (
'phi_const',
'phiconst')
1261 call mt_require_real(
'mt_seed_coord',mt_seed_coord)
1262 seed_coord=mt_seed_coord
1263 if (seed_coord<xprobmin3 .or. seed_coord>xprobmax3)
then
1264 call mpistop(
'spherical_surface_products requires phi_const '// &
1265 'mt_seed_coord inside domain')
1267 case (
'radial_plane',
'radialplane')
1268 surface=
'radial_plane'
1270 call mt_require_real(
'mt_seed_theta0',mt_seed_theta0)
1271 call mt_require_real(
'mt_seed_phi0',mt_seed_phi0)
1272 call mt_require_real(
'mt_seed_alpha',mt_seed_alpha)
1273 if (mt_seed_theta0<xprobmin2 .or. mt_seed_theta0>xprobmax2)
then
1274 call mpistop(
'spherical_surface_products requires radial_plane '// &
1275 'mt_seed_theta0 inside domain')
1277 if (mt_seed_phi0<xprobmin3 .or. mt_seed_phi0>xprobmax3)
then
1278 call mpistop(
'spherical_surface_products requires radial_plane '// &
1279 'mt_seed_phi0 inside domain')
1281 if (abs(dsin(mt_seed_theta0))<=1.d-12)
then
1282 call mpistop(
'spherical_surface_products radial_plane requires '// &
1283 'mt_seed_theta0 away from the polar singularity')
1287 call mpistop(
'spherical_surface_products supports '// &
1288 'mt_seed_surface=rmin, rconst, theta_const, phi_const, or radial_plane')
1290 call mt_require_positive_int(
'mt_n1',mt_n1)
1291 call mt_require_positive_int(
'mt_n2',mt_n2)
1297 select case (trim(surface))
1298 case (
'rmin',
'rconst')
1303 case (
'theta_const')
1313 case (
'radial_plane')
1316 s2_min=-0.5d0*min(xprobmax2-xprobmin2,xprobmax3-xprobmin3)
1317 s2_max= 0.5d0*min(xprobmax2-xprobmin2,xprobmax3-xprobmin3)
1320 if (mt_is_set_real(mt_s1min)) s1_min=mt_s1min
1321 if (mt_is_set_real(mt_s1max)) s1_max=mt_s1max
1322 if (mt_is_set_real(mt_s2min)) s2_min=mt_s2min
1323 if (mt_is_set_real(mt_s2max)) s2_max=mt_s2max
1324 call mt_require_ordered(
'mt_s1min',
'mt_s1max',s1_min,s1_max)
1325 call mt_require_ordered(
'mt_s2min',
'mt_s2max',s2_min,s2_max)
1328 if (mt_write_csv)
then
1329 if (trim(surface)==
'rmin')
then
1330 suffix=
'_spherical_rmin_products.csv'
1331 else if (trim(surface)==
'radial_plane')
then
1332 suffix=
'_spherical_radial_plane_products.csv'
1334 suffix=
'_spherical_'//trim(surface)//
'_products.csv'
1336 call mt_resolve_prefix_file(trim(suffix),csv_file, &
1337 'spherical_surface_products CSV requires mt_output_prefix')
1339 if (trim(surface)==
'rmin')
then
1340 suffix=
'_spherical_rmin_products.vtu'
1341 else if (trim(surface)==
'radial_plane')
then
1342 suffix=
'_spherical_radial_plane_products.vtu'
1344 suffix=
'_spherical_'//trim(surface)//
'_products.vtu'
1346 call mt_resolve_output_file(
'spherical_surface_products',
'.vtu', &
1347 trim(suffix),vtu_file)
1349 if (mt_write_csv)
then
1350 write(*,
'(a)')
'mt_run_topology_task: writing spherical '// &
1351 trim(surface)//
' CSV '//trim(csv_file)
1353 write(*,
'(a)')
'mt_run_topology_task: writing spherical '// &
1354 trim(surface)//
' VTU '//trim(vtu_file)
1356 if (mt_profile_spherical)
then
1357 call trace_spherical_profile_reset()
1358 call trace_spherical_profile_set(.true.)
1361 seed_theta0=mt_seed_theta0
1362 seed_phi0=mt_seed_phi0
1363 seed_alpha=mt_seed_alpha
1364 if (mt_b_min>0.d0)
then
1365 call mt_fieldline_products_spherical_surface(trim(surface),seed_coord, &
1366 s1_min,s1_max,mt_n1,s2_min,s2_max,mt_n2,mt_dl,mt_max_steps, &
1367 trim(csv_file),trim(vtu_file),trim(mt_seed_layout), &
1368 seed_theta0,seed_phi0,seed_alpha, &
1369 compute_twist=mt_compute_twist,compute_q=mt_compute_q, &
1370 compute_qperp=mt_compute_qperp,b_min=mt_b_min)
1372 call mt_fieldline_products_spherical_surface(trim(surface),seed_coord, &
1373 s1_min,s1_max,mt_n1,s2_min,s2_max,mt_n2,mt_dl,mt_max_steps, &
1374 trim(csv_file),trim(vtu_file),trim(mt_seed_layout), &
1375 seed_theta0,seed_phi0,seed_alpha, &
1376 compute_twist=mt_compute_twist,compute_q=mt_compute_q, &
1377 compute_qperp=mt_compute_qperp)
1379 if (mt_profile_spherical)
then
1380 call trace_spherical_profile_report(
'spherical_surface_products '// &
1382 call trace_spherical_profile_set(.false.)
1384 end subroutine mt_run_spherical_surface_products_task
1386 subroutine mt_run_spherical_cloud_products_task()
1387 character(len=mt_task_name_len) :: vtu_file
1388 double precision :: s1_min,s1_max,s2_min,s2_max,s3_min,s3_max
1390 if (mt_write_csv)
then
1391 write(*,
'(a)')
'mt_run_topology_task: spherical_cloud_products '// &
1392 'does not write CSV; use seed_products for selected-point diagnostics'
1394 call mt_require_positive_int(
'mt_n1',mt_n1)
1395 call mt_require_positive_int(
'mt_n2',mt_n2)
1396 call mt_require_positive_int(
'mt_n3',mt_n3)
1409 if (mt_is_set_real(mt_s1min)) s1_min=mt_s1min
1410 if (mt_is_set_real(mt_s1max)) s1_max=mt_s1max
1411 if (mt_is_set_real(mt_s2min)) s2_min=mt_s2min
1412 if (mt_is_set_real(mt_s2max)) s2_max=mt_s2max
1413 if (mt_is_set_real(mt_s3min)) s3_min=mt_s3min
1414 if (mt_is_set_real(mt_s3max)) s3_max=mt_s3max
1415 call mt_require_ordered(
'mt_s1min',
'mt_s1max',s1_min,s1_max)
1416 call mt_require_ordered(
'mt_s2min',
'mt_s2max',s2_min,s2_max)
1417 call mt_require_ordered(
'mt_s3min',
'mt_s3max',s3_min,s3_max)
1419 call mt_resolve_output_file(
'spherical_cloud_products',
'.vtu', &
1420 '_spherical_cloud_products.vtu',vtu_file)
1422 write(*,
'(a)')
'mt_run_topology_task: writing spherical cloud VTU '// &
1425 if (mt_profile_spherical)
then
1426 call trace_spherical_profile_reset()
1427 call trace_spherical_profile_set(.true.)
1430 if (mt_b_min>0.d0)
then
1431 call mt_fieldline_products_spherical_cloud(s1_min,s1_max,mt_n1, &
1432 s2_min,s2_max,mt_n2,s3_min,s3_max,mt_n3,mt_dl,mt_max_steps, &
1433 trim(vtu_file),trim(mt_seed_layout), &
1434 compute_twist=mt_compute_twist,compute_q=mt_compute_q, &
1435 compute_qperp=mt_compute_qperp,b_min=mt_b_min)
1437 call mt_fieldline_products_spherical_cloud(s1_min,s1_max,mt_n1, &
1438 s2_min,s2_max,mt_n2,s3_min,s3_max,mt_n3,mt_dl,mt_max_steps, &
1439 trim(vtu_file),trim(mt_seed_layout), &
1440 compute_twist=mt_compute_twist,compute_q=mt_compute_q, &
1441 compute_qperp=mt_compute_qperp)
1443 if (mt_profile_spherical)
then
1444 call trace_spherical_profile_report(
'spherical_cloud_products')
1445 call trace_spherical_profile_set(.false.)
1447 end subroutine mt_run_spherical_cloud_products_task
1449 subroutine mt_resolve_output_file(mode,extension,suffix,output_file)
1450 character(len=*),
intent(in) :: mode,extension,suffix
1451 character(len=*),
intent(out) :: output_file
1452 integer :: required_len
1455 if (len_trim(mt_output_file)>0)
then
1456 output_file=trim(mt_output_file)
1457 if (len_trim(mt_output_prefix)>0)
then
1458 write(*,
'(a)')
'mt_run_topology_task: mt_output_file takes precedence over mt_output_prefix'
1460 call mt_warn_extension(output_file,extension,mode)
1462 required_len=len_trim(mt_output_prefix)+len_trim(suffix)
1463 if (required_len>len(output_file))
then
1464 call mpistop(
'mt_run_topology_task output filename exceeds internal length')
1466 output_file=trim(mt_output_prefix)//trim(suffix)
1468 end subroutine mt_resolve_output_file
1470 subroutine mt_resolve_prefix_file(suffix,output_file,missing_message)
1471 character(len=*),
intent(in) :: suffix,missing_message
1472 character(len=*),
intent(out) :: output_file
1473 integer :: required_len
1475 if (len_trim(mt_output_prefix)==0)
then
1476 call mpistop(trim(missing_message))
1478 required_len=len_trim(mt_output_prefix)+len_trim(suffix)
1479 if (required_len>len(output_file))
then
1480 call mpistop(
'mt_run_topology_task output filename exceeds internal length')
1482 output_file=trim(mt_output_prefix)//trim(suffix)
1483 end subroutine mt_resolve_prefix_file
1485 logical function mt_is_set_real(value)
result(is_set)
1486 double precision,
intent(in) :: value
1488 is_set=(
value/=mt_unset_real)
1489 end function mt_is_set_real
1491 subroutine mt_require_real(name,value)
1492 character(len=*),
intent(in) :: name
1493 double precision,
intent(in) :: value
1495 if (.not.mt_is_set_real(
value))
then
1496 call mpistop(
'mt_run_topology_task requires '//trim(name))
1498 end subroutine mt_require_real
1500 subroutine mt_require_positive_int(name,value)
1501 character(len=*),
intent(in) :: name
1502 integer,
intent(in) :: value
1505 call mpistop(
'mt_run_topology_task requires '//trim(name)//
' > 0')
1507 end subroutine mt_require_positive_int
1509 subroutine mt_require_ordered(name_min,name_max,value_min,value_max)
1510 character(len=*),
intent(in) :: name_min,name_max
1511 double precision,
intent(in) :: value_min,value_max
1513 if (value_max<value_min)
then
1514 call mpistop(
'mt_run_topology_task requires ordered '// &
1515 trim(name_min)//
'/'//trim(name_max))
1517 end subroutine mt_require_ordered
1519 subroutine mt_require_requested_science(do_length,do_twist,do_q,do_qperp, &
1521 logical,
intent(in) :: do_length,do_twist,do_q,do_qperp
1522 character(len=*),
intent(in) :: caller
1524 if (.not.(do_length .or. do_twist .or. do_q .or. do_qperp))
then
1525 call mpistop(trim(caller)//
' requires at least one requested science array')
1527 end subroutine mt_require_requested_science
1529 subroutine mt_read_seed_file(filename,seeds,nseed)
1530 character(len=*),
intent(in) :: filename
1531 double precision,
allocatable,
intent(out) :: seeds(:,:)
1532 integer,
intent(out) :: nseed
1534 character(len=1024) :: line
1535 double precision :: xyz(3)
1536 integer :: io,ios,line_no,iseed
1539 open(newunit=io,file=trim(filename),status=
'old',action=
'read', &
1540 form=
'formatted',iostat=ios)
1542 call mpistop(
'mt_read_seed_file could not open '//trim(filename))
1546 read(io,
'(a)',iostat=ios) line
1549 if (.not.mt_seed_line_is_data(line)) cycle
1550 call mt_validate_seed_line(filename,line,line_no)
1555 call mpistop(
'mt_read_seed_file found no seeds in '//trim(filename))
1558 allocate(seeds(nseed,ndim))
1560 open(newunit=io,file=trim(filename),status=
'old',action=
'read', &
1561 form=
'formatted',iostat=ios)
1563 call mpistop(
'mt_read_seed_file could not reopen '//trim(filename))
1568 read(io,
'(a)',iostat=ios) line
1571 if (.not.mt_seed_line_is_data(line)) cycle
1573 read(line,*,iostat=ios) xyz
1575 call mt_fail_seed_line(filename,line_no)
1577 seeds(iseed,1:ndim)=xyz(1:ndim)
1580 end subroutine mt_read_seed_file
1582 logical function mt_seed_line_is_data(line)
result(is_data)
1583 character(len=*),
intent(in) :: line
1584 character(len=len(line)) :: trimmed
1586 trimmed=adjustl(line)
1587 is_data=len_trim(trimmed)>0
1588 if (is_data) is_data=trimmed(1:1)/=
'#'
1589 end function mt_seed_line_is_data
1591 subroutine mt_validate_seed_line(filename,line,line_no)
1592 character(len=*),
intent(in) :: filename,line
1593 integer,
intent(in) :: line_no
1595 double precision :: x,y,z
1598 if (index(line,
',')>0)
then
1599 call mt_fail_seed_line(filename,line_no)
1601 if (mt_count_tokens(line)/=3)
then
1602 call mt_fail_seed_line(filename,line_no)
1604 read(line,*,iostat=ios) x,y,z
1606 call mt_fail_seed_line(filename,line_no)
1608 end subroutine mt_validate_seed_line
1610 integer function mt_count_tokens(line)
result(ntoken)
1611 character(len=*),
intent(in) :: line
1617 do i=1,len_trim(line)
1618 if (line(i:i)==
' ' .or. line(i:i)==achar(9))
then
1621 if (.not.in_token)
then
1627 end function mt_count_tokens
1629 subroutine mt_fail_seed_line(filename,line_no)
1630 character(len=*),
intent(in) :: filename
1631 integer,
intent(in) :: line_no
1633 call mpistop(
'mt_read_seed_file malformed line '// &
1634 trim(mt_int_to_string(line_no))//
' in '//trim(filename))
1635 end subroutine mt_fail_seed_line
1637 function mt_int_to_string(value)
result(text)
1638 integer,
intent(in) :: value
1639 character(len=32) :: text
1641 write(text,
'(i0)')
value
1642 end function mt_int_to_string
1644 subroutine mt_warn_extension(filename,extension,mode)
1645 character(len=*),
intent(in) :: filename,extension,mode
1647 if (.not.mt_has_extension(filename,extension))
then
1648 write(*,
'(a)')
'mt_run_topology_task warning: '//trim(mode)// &
1649 ' output file does not end in '//trim(extension)
1651 end subroutine mt_warn_extension
1653 logical function mt_has_extension(filename,extension)
result(has_ext)
1654 character(len=*),
intent(in) :: filename,extension
1655 character(len=mt_task_name_len) :: fname,ext
1658 fname=mt_lowercase(trim(filename))
1659 ext=mt_lowercase(trim(extension))
1663 if (lf>=le) has_ext=(fname(lf-le+1:lf)==ext(1:le))
1664 end function mt_has_extension
1666 function mt_lowercase(input)
result(output)
1667 character(len=*),
intent(in) :: input
1668 character(len=len(input)) :: output
1673 code=iachar(output(i:i))
1674 if (code>=iachar(
'A') .and. code<=iachar(
'Z'))
then
1675 output(i:i)=achar(code+iachar(
'a')-iachar(
'A'))
1678 end function mt_lowercase
1680 logical function mt_vtk_detail_is_full()
result(is_full)
1681 is_full=(mt_lowercase(trim(mt_vtk_detail))==
'full')
1682 end function mt_vtk_detail_is_full
1684 double precision function mt_visual_float(value)
result(out_value)
1685 double precision,
intent(in) :: value
1687 if (ieee_is_finite(
value))
then
1692 end function mt_visual_float
1694 double precision function mt_visual_valid_float(value,is_valid) &
1696 double precision,
intent(in) :: value
1697 logical,
intent(in) :: is_valid
1699 if (is_valid .and. ieee_is_finite(
value))
then
1704 end function mt_visual_valid_float
1706 double precision function mt_vc(vec,icomp)
result(value)
1709 double precision,
intent(in) :: vec(ndim)
1710 integer,
intent(in) :: icomp
1712 if (icomp>=1 .and. icomp<=ndim)
then
1721 double precision,
intent(in) :: seed(ndim),dl
1722 integer,
intent(in) :: max_steps
1723 character(len=*),
intent(in) :: csv_file
1724 double precision,
intent(in),
optional :: b_min
1726 type(trace_length_result) :: result
1727 double precision :: seed_xyz(3)
1728 integer :: csv_unit,io_status
1731 call mpistop(
'mt_length_single currently requires npe=1')
1734 if (
present(b_min))
then
1735 call trace_field_length_single(seed,dl,max_steps,result,b_min)
1737 call trace_field_length_single(seed,dl,max_steps,result)
1741 seed_xyz(1:ndim)=result%seed
1743 open(newunit=csv_unit,file=trim(csv_file),status=
'replace', &
1744 action=
'write',form=
'formatted',iostat=io_status)
1745 if (io_status/=0)
then
1746 call mpistop(
'mt_length_single could not open CSV file')
1749 write(csv_unit,
'(a)',iostat=io_status) &
1750 'seed_x,seed_y,seed_z,'// &
1751 'length_total,length_backward,length_forward,'// &
1752 'nstep_backward,nstep_forward,'// &
1753 'status_backward,status_forward'
1754 if (io_status/=0)
then
1756 call mpistop(
'mt_length_single could not write CSV header')
1759 write(csv_unit,
'(es24.16,5(",",es24.16),4(",",i0))',iostat=io_status) &
1760 seed_xyz,result%total_length, &
1761 result%backward_length,result%forward_length, &
1762 result%backward_nstep,result%forward_nstep, &
1763 result%backward_status,result%forward_status
1764 if (io_status/=0)
then
1766 call mpistop(
'mt_length_single could not write CSV data')
1774 integer,
intent(in) :: nseed,max_steps
1775 double precision,
intent(in) :: seeds(nseed,ndim),dl
1776 character(len=*),
intent(in) :: csv_file
1777 double precision,
intent(in),
optional :: b_min
1779 type(trace_length_result),
allocatable :: results(:)
1780 double precision :: seed_xyz(3)
1781 integer :: csv_unit,io_status,iseed
1784 call mpistop(
'mt_length_seeds currently requires npe=1')
1787 call mpistop(
'mt_length_seeds requires nseed>=0')
1790 allocate(results(nseed))
1791 if (
present(b_min))
then
1792 call trace_field_length_multi(seeds,nseed,dl,max_steps,results,b_min)
1794 call trace_field_length_multi(seeds,nseed,dl,max_steps,results)
1797 open(newunit=csv_unit,file=trim(csv_file),status=
'replace', &
1798 action=
'write',form=
'formatted',iostat=io_status)
1799 if (io_status/=0)
then
1801 call mpistop(
'mt_length_seeds could not open CSV file')
1804 write(csv_unit,
'(a)',iostat=io_status) &
1805 'seed_id,seed_x,seed_y,seed_z,'// &
1806 'length_total,length_backward,length_forward,'// &
1807 'nstep_backward,nstep_forward,'// &
1808 'status_backward,status_forward'
1809 if (io_status/=0)
then
1812 call mpistop(
'mt_length_seeds could not write CSV header')
1817 seed_xyz(1:ndim)=results(iseed)%seed
1818 write(csv_unit,
'(i0,6(",",es24.16),4(",",i0))',iostat=io_status) &
1819 iseed,seed_xyz,results(iseed)%total_length, &
1820 results(iseed)%backward_length,results(iseed)%forward_length, &
1821 results(iseed)%backward_nstep,results(iseed)%forward_nstep, &
1822 results(iseed)%backward_status,results(iseed)%forward_status
1823 if (io_status/=0)
then
1826 call mpistop(
'mt_length_seeds could not write CSV data')
1835 b_min,compute_length,compute_twist,compute_q,compute_qperp,vtu_file)
1837 integer,
intent(in) :: nseed,max_steps
1838 double precision,
intent(in) :: seeds(nseed,ndim),dl
1839 character(len=*),
intent(in) :: csv_file
1840 double precision,
intent(in),
optional :: b_min
1841 logical,
intent(in),
optional :: compute_length,compute_twist
1842 logical,
intent(in),
optional :: compute_q,compute_qperp
1843 character(len=*),
intent(in),
optional :: vtu_file
1845 type(trace_length_result),
allocatable :: length_results(:)
1846 type(trace_twist_result),
allocatable :: twist_results(:)
1847 type(trace_qperp_result),
allocatable :: q_results(:)
1848 type(trace_qperp_result),
allocatable :: qperp_results(:)
1849 logical :: do_length,do_twist,do_q,do_qperp
1850 character(len=mt_task_name_len) :: integrator
1856 if (
present(compute_length)) do_length=compute_length
1857 if (
present(compute_twist)) do_twist=compute_twist
1858 if (
present(compute_q)) do_q=compute_q
1859 if (
present(compute_qperp)) do_qperp=compute_qperp
1860 integrator=mt_lowercase(trim(mt_trace_integrator))
1863 call mpistop(
'mt_fieldline_products_seeds currently requires npe=1')
1866 call mpistop(
'mt_fieldline_products_seeds requires 3D Cartesian or spherical geometry')
1869 select case (geo_coordinate)
1870 case (geo_cartesian,geo_cartesian_stretched)
1871 case (geo_spherical)
1872 if (periodb(3))
then
1873 call mpistop(
'spherical seed_products does not yet support periodic phi')
1876 call mpistop(
'mt_fieldline_products_seeds requires Cartesian or spherical geometry')
1880 select case (trim(integrator))
1883 case (
'rk45_cartesian')
1885 if (geo_coordinate==geo_spherical)
then
1886 call mpistop(
'seed_products logQperp with spherical geometry '// &
1887 'requires mt_trace_integrator=rk45_spherical')
1890 case (
'rk45_spherical')
1892 if (geo_coordinate/=geo_spherical)
then
1893 call mpistop(
'seed_products logQperp with Cartesian geometry '// &
1894 'requires mt_trace_integrator=rk45_cartesian')
1898 call mpistop(
'seed_products logQperp requires mt_trace_integrator='// &
1899 'rk2, rk45_cartesian, or rk45_spherical')
1903 select case (trim(integrator))
1906 case (
'rk45_cartesian')
1908 if (geo_coordinate==geo_spherical)
then
1909 call mpistop(
'seed_products logQ with spherical geometry '// &
1910 'requires mt_trace_integrator=rk45_spherical')
1913 case (
'rk45_spherical')
1915 if (geo_coordinate/=geo_spherical)
then
1916 call mpistop(
'seed_products logQ with Cartesian geometry '// &
1917 'requires mt_trace_integrator=rk45_cartesian')
1921 call mpistop(
'seed_products logQ requires mt_trace_integrator='// &
1922 'rk2, rk45_cartesian, or rk45_spherical')
1926 call mpistop(
'mt_fieldline_products_seeds requires nseed>=0')
1928 call mt_require_requested_science(do_length,do_twist,do_q,do_qperp, &
1929 'mt_fieldline_products_seeds')
1931 allocate(length_results(nseed))
1933 allocate(twist_results(nseed))
1935 allocate(twist_results(0))
1938 allocate(q_results(nseed))
1940 allocate(q_results(0))
1943 allocate(qperp_results(nseed))
1945 allocate(qperp_results(0))
1948 if (
present(b_min))
then
1949 call mt_trace_fieldline_products_seedset(seeds,nseed,dl,max_steps, &
1950 length_results,twist_results,q_results,qperp_results,do_twist, &
1951 do_q,do_qperp,b_min)
1953 call mt_trace_fieldline_products_seedset(seeds,nseed,dl,max_steps, &
1954 length_results,twist_results,q_results,qperp_results,do_twist, &
1958 if (len_trim(csv_file)>0)
then
1959 call mt_write_fieldline_products_seeds_csv(length_results, &
1960 twist_results,q_results,qperp_results,nseed,csv_file,do_twist, &
1963 if (
present(vtu_file))
then
1964 if (len_trim(vtu_file)>0)
then
1965 call mt_write_fieldline_products_vtu_vertices(vtu_file, &
1966 length_results,twist_results,q_results,qperp_results,nseed, &
1967 do_length,do_twist,do_q,do_qperp,
'mt_fieldline_products_seeds')
1971 if (
allocated(qperp_results))
deallocate(qperp_results)
1972 if (
allocated(q_results))
deallocate(q_results)
1973 if (
allocated(twist_results))
deallocate(twist_results)
1974 deallocate(length_results)
1977 subroutine mt_rk45_tangent_diagnostic_seeds(seeds,nseed,dL,max_steps, &
1979 integer,
intent(in) :: nseed,max_steps
1980 double precision,
intent(in) :: seeds(nseed,ndim),dl
1981 character(len=*),
intent(in) :: csv_file
1982 double precision,
intent(in),
optional :: b_min
1984 type(trace_qperp_result),
allocatable :: rk2_results(:)
1985 type(trace_qperp_result),
allocatable :: rk45_results(:)
1988 call mpistop(
'mt_rk45_tangent_diagnostic_seeds currently requires npe=1')
1991 call mpistop(
'mt_rk45_tangent_diagnostic_seeds requires nseed>=0')
1994 allocate(rk2_results(nseed),rk45_results(nseed))
1995 if (
present(b_min))
then
1996 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,rk2_results, &
1998 call trace_debug_cartesian_rk45_tangent_q0_multi(seeds,nseed,dl, &
1999 max_steps,rk45_results,b_min)
2001 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,rk2_results)
2002 call trace_debug_cartesian_rk45_tangent_q0_multi(seeds,nseed,dl, &
2003 max_steps,rk45_results)
2006 call mt_write_rk45_tangent_diagnostic_csv(rk2_results,rk45_results, &
2008 deallocate(rk45_results,rk2_results)
2009 end subroutine mt_rk45_tangent_diagnostic_seeds
2011 subroutine mt_write_rk45_tangent_diagnostic_csv(rk2_results,rk45_results, &
2013 integer,
intent(in) :: nseed
2014 type(trace_qperp_result),
intent(in) :: rk2_results(nseed)
2015 type(trace_qperp_result),
intent(in) :: rk45_results(nseed)
2016 character(len=*),
intent(in) :: csv_file
2018 double precision :: seed_xyz(3),logq_diff,q_diff,length_diff
2019 double precision :: f_endpoint_diff,b_endpoint_diff
2020 double precision :: uf_diff,vf_diff,ub_diff,vb_diff
2021 integer :: csv_unit,io_status,iseed
2023 open(newunit=csv_unit,file=trim(csv_file),status=
'replace', &
2024 action=
'write',form=
'formatted',iostat=io_status)
2025 if (io_status/=0)
then
2026 call mpistop(
'mt_rk45_tangent_diagnostic could not open CSV file')
2029 write(csv_unit,
'(a)',iostat=io_status) &
2030 'seed_id,seed_x,seed_y,seed_z,'// &
2031 'rk2_status_q0,rk45_status_q0,'// &
2032 'rk2_forward_status,rk45_forward_status,'// &
2033 'rk2_backward_status,rk45_backward_status,'// &
2034 'rk2_logq0,rk45_logq0,abs_diff_logq0,'// &
2035 'rk2_q0,rk45_q0,abs_diff_q0,'// &
2036 'rk2_length_total,rk45_length_total,abs_diff_length_total,'// &
2037 'endpoint_diff_forward,endpoint_diff_backward,'// &
2038 'u_forward_perp_diff,v_forward_perp_diff,'// &
2039 'u_backward_perp_diff,v_backward_perp_diff'
2040 if (io_status/=0)
then
2042 call mpistop(
'mt_rk45_tangent_diagnostic could not write CSV header')
2047 seed_xyz(1:ndim)=rk2_results(iseed)%seed
2048 logq_diff=mt_absdiff_or_nan(rk2_results(iseed)%logq0, &
2049 rk45_results(iseed)%logq0)
2050 q_diff=mt_absdiff_or_nan(rk2_results(iseed)%q0, &
2051 rk45_results(iseed)%q0)
2052 length_diff=abs((rk2_results(iseed)%forward_length+ &
2053 rk2_results(iseed)%backward_length)- &
2054 (rk45_results(iseed)%forward_length+ &
2055 rk45_results(iseed)%backward_length))
2056 f_endpoint_diff=dsqrt(sum((rk2_results(iseed)%forward_endpoint- &
2057 rk45_results(iseed)%forward_endpoint)**2))
2058 b_endpoint_diff=dsqrt(sum((rk2_results(iseed)%backward_endpoint- &
2059 rk45_results(iseed)%backward_endpoint)**2))
2060 uf_diff=dsqrt(sum((rk2_results(iseed)%u_forward_perp- &
2061 rk45_results(iseed)%u_forward_perp)**2))
2062 vf_diff=dsqrt(sum((rk2_results(iseed)%v_forward_perp- &
2063 rk45_results(iseed)%v_forward_perp)**2))
2064 ub_diff=dsqrt(sum((rk2_results(iseed)%u_backward_perp- &
2065 rk45_results(iseed)%u_backward_perp)**2))
2066 vb_diff=dsqrt(sum((rk2_results(iseed)%v_backward_perp- &
2067 rk45_results(iseed)%v_backward_perp)**2))
2069 write(csv_unit,
'(i0,3(",",es24.16),6(",",i0),15(",",es24.16))', &
2072 rk2_results(iseed)%status_q0, &
2073 rk45_results(iseed)%status_q0, &
2074 rk2_results(iseed)%forward_status, &
2075 rk45_results(iseed)%forward_status, &
2076 rk2_results(iseed)%backward_status, &
2077 rk45_results(iseed)%backward_status, &
2078 rk2_results(iseed)%logq0,rk45_results(iseed)%logq0,logq_diff, &
2079 rk2_results(iseed)%q0,rk45_results(iseed)%q0,q_diff, &
2080 rk2_results(iseed)%forward_length+ &
2081 rk2_results(iseed)%backward_length, &
2082 rk45_results(iseed)%forward_length+ &
2083 rk45_results(iseed)%backward_length, &
2084 length_diff,f_endpoint_diff,b_endpoint_diff, &
2085 uf_diff,vf_diff,ub_diff,vb_diff
2086 if (io_status/=0)
then
2088 call mpistop(
'mt_rk45_tangent_diagnostic could not write CSV data')
2093 end subroutine mt_write_rk45_tangent_diagnostic_csv
2095 subroutine mt_rk2_fusion_diagnostic_seeds(seeds,nseed,dL,max_steps, &
2097 integer,
intent(in) :: nseed,max_steps
2098 double precision,
intent(in) :: seeds(nseed,ndim),dl
2099 character(len=*),
intent(in) :: csv_file
2100 double precision,
intent(in),
optional :: b_min
2102 type(trace_topology_result),
allocatable :: summary(:)
2103 type(trace_qperp_result),
allocatable :: q_trace(:)
2104 type(trace_qperp_result),
allocatable :: q_short(:)
2105 type(trace_twist_result),
allocatable :: q_twist(:)
2106 type(trace_twist_result),
allocatable :: q_short_twist(:)
2107 integer :: cache_status
2108 logical :: use_spherical_cache
2111 call mpistop(
'mt_rk2_fusion_diagnostic currently requires npe=1')
2114 call mpistop(
'mt_rk2_fusion_diagnostic requires nseed>=0')
2116 if (mt_lowercase(trim(mt_trace_integrator))/=
'rk2')
then
2117 call mpistop(
'mt_rk2_fusion_diagnostic requires rk2 tracing')
2120 allocate(summary(nseed),q_trace(nseed),q_short(nseed), &
2121 q_twist(nseed),q_short_twist(nseed))
2122 use_spherical_cache=.false.
2124 if (geo_coordinate==geo_spherical)
then
2125 call trace_spherical_curl_cache_build(cache_status)
2126 if (cache_status/=trace_status_active)
then
2127 call mpistop(
'mt_rk2_fusion_diagnostic failed to build '// &
2128 'spherical curl cache')
2130 use_spherical_cache=.true.
2134 if (
present(b_min))
then
2135 call trace_field_topology_multi(seeds,nseed,dl,max_steps,summary, &
2136 need_twist=.true.,need_mapping=.false.,b_min=b_min)
2137 if (geo_coordinate==geo_spherical)
then
2138 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
2139 q_trace,b_min,twist_results=q_twist)
2140 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
2141 max_steps,q_short,b_min,twist_results=q_short_twist)
2143 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,q_trace, &
2144 b_min,twist_results=q_twist)
2145 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
2146 max_steps,q_short,b_min,twist_results=q_short_twist)
2149 call trace_field_topology_multi(seeds,nseed,dl,max_steps,summary, &
2150 need_twist=.true.,need_mapping=.false.)
2151 if (geo_coordinate==geo_spherical)
then
2152 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
2153 q_trace,twist_results=q_twist)
2154 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
2155 max_steps,q_short,twist_results=q_short_twist)
2157 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,q_trace, &
2158 twist_results=q_twist)
2159 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
2160 max_steps,q_short,twist_results=q_short_twist)
2164 if (use_spherical_cache)
call trace_spherical_curl_cache_clear()
2165 call mt_write_rk2_fusion_diagnostic_csv(summary,q_trace,q_twist, &
2166 q_short,q_short_twist,nseed,csv_file)
2167 deallocate(q_short_twist,q_twist,q_short,q_trace,summary)
2168 end subroutine mt_rk2_fusion_diagnostic_seeds
2170 subroutine mt_write_rk2_fusion_diagnostic_csv(summary,q_trace,q_twist, &
2171 q_short,q_short_twist,nseed,csv_file)
2172 integer,
intent(in) :: nseed
2173 type(trace_topology_result),
intent(in) :: summary(nseed)
2174 type(trace_qperp_result),
intent(in) :: q_trace(nseed)
2175 type(trace_twist_result),
intent(in) :: q_twist(nseed)
2176 type(trace_qperp_result),
intent(in) :: q_short(nseed)
2177 type(trace_twist_result),
intent(in) :: q_short_twist(nseed)
2178 character(len=*),
intent(in) :: csv_file
2180 double precision :: seed_xyz(3),length_summary,length_q,length_diff
2181 double precision :: length_short,length_diff_short,length_q_short_diff
2182 double precision :: twist_summary,twist_q,twist_diff
2183 double precision :: twist_short,twist_diff_short,twist_q_short_diff
2184 double precision :: max_length_diff,max_twist_diff
2185 double precision :: max_length_short_diff,max_twist_short_diff
2186 integer :: csv_unit,io_status,iseed
2187 integer :: status_mismatch,face_mismatch,twist_status_mismatch
2188 integer :: short_status_mismatch,short_face_mismatch
2189 integer :: short_twist_status_mismatch,short_valid_q_mismatch
2191 max_length_diff=0.d0
2193 max_length_short_diff=0.d0
2194 max_twist_short_diff=0.d0
2197 twist_status_mismatch=0
2198 short_status_mismatch=0
2199 short_face_mismatch=0
2200 short_twist_status_mismatch=0
2201 short_valid_q_mismatch=0
2203 open(newunit=csv_unit,file=trim(csv_file),status=
'replace', &
2204 action=
'write',form=
'formatted',iostat=io_status)
2205 if (io_status/=0)
then
2206 call mpistop(
'mt_rk2_fusion_diagnostic could not open CSV file')
2209 write(csv_unit,
'(a)',iostat=io_status) &
2210 'seed_id,seed_x,seed_y,seed_z,'// &
2211 'length_summary,length_qtrace,dlength_summary_minus_qtrace,'// &
2212 'length_forward_summary,length_forward_qtrace,'// &
2213 'length_backward_summary,length_backward_qtrace,'// &
2214 'twist_summary,twist_qtrace,dtwist_summary_minus_qtrace,'// &
2215 'twist_forward_summary,twist_forward_qtrace,'// &
2216 'twist_backward_summary,twist_backward_qtrace,'// &
2217 'length_short,dlength_summary_minus_short,'// &
2218 'dlength_qtrace_minus_short,'// &
2219 'length_forward_short,length_backward_short,'// &
2220 'twist_short,dtwist_summary_minus_short,'// &
2221 'dtwist_qtrace_minus_short,'// &
2222 'twist_forward_short,twist_backward_short,'// &
2223 'status_forward_summary,status_forward_qtrace,status_forward_short,'// &
2224 'status_backward_summary,status_backward_qtrace,status_backward_short,'// &
2225 'face_forward_summary,face_forward_qtrace,face_forward_short,'// &
2226 'face_backward_summary,face_backward_qtrace,face_backward_short,'// &
2227 'status_twist_summary,status_twist_qtrace,status_twist_short,'// &
2228 'logQ,valid_Q,status_Q,logQ_short,valid_Q_short,status_Q_short'
2229 if (io_status/=0)
then
2231 call mpistop(
'mt_rk2_fusion_diagnostic could not write CSV header')
2236 seed_xyz(1:ndim)=summary(iseed)%seed
2237 length_summary=summary(iseed)%length_total
2238 length_q=q_trace(iseed)%forward_length+q_trace(iseed)%backward_length
2239 length_short=q_short(iseed)%forward_length+ &
2240 q_short(iseed)%backward_length
2241 length_diff=length_summary-length_q
2242 length_diff_short=length_summary-length_short
2243 length_q_short_diff=length_q-length_short
2244 twist_summary=summary(iseed)%twist_total
2245 twist_q=q_twist(iseed)%total_twist
2246 twist_short=q_short_twist(iseed)%total_twist
2247 twist_diff=twist_summary-twist_q
2248 twist_diff_short=twist_summary-twist_short
2249 twist_q_short_diff=twist_q-twist_short
2250 max_length_diff=max(max_length_diff,abs(length_diff))
2251 max_twist_diff=max(max_twist_diff,abs(twist_diff))
2252 max_length_short_diff=max(max_length_short_diff, &
2253 abs(length_diff_short))
2254 max_twist_short_diff=max(max_twist_short_diff, &
2255 abs(twist_diff_short))
2256 if (summary(iseed)%forward_status/=q_trace(iseed)%forward_status .or. &
2257 summary(iseed)%backward_status/=q_trace(iseed)%backward_status) &
2258 status_mismatch=status_mismatch+1
2259 if (summary(iseed)%forward_face/=q_trace(iseed)%forward_face .or. &
2260 summary(iseed)%backward_face/=q_trace(iseed)%backward_face) &
2261 face_mismatch=face_mismatch+1
2262 if (summary(iseed)%status_twist/=q_twist(iseed)%status_twist) &
2263 twist_status_mismatch=twist_status_mismatch+1
2264 if (summary(iseed)%forward_status/=q_short(iseed)%forward_status .or. &
2265 summary(iseed)%backward_status/=q_short(iseed)%backward_status) &
2266 short_status_mismatch=short_status_mismatch+1
2267 if (summary(iseed)%forward_face/=q_short(iseed)%forward_face .or. &
2268 summary(iseed)%backward_face/=q_short(iseed)%backward_face) &
2269 short_face_mismatch=short_face_mismatch+1
2270 if (summary(iseed)%status_twist/=q_short_twist(iseed)%status_twist) &
2271 short_twist_status_mismatch=short_twist_status_mismatch+1
2272 if (q_trace(iseed)%valid_q0 .neqv. q_short(iseed)%valid_q0) &
2273 short_valid_q_mismatch=short_valid_q_mismatch+1
2276 '(i0,3(",",es24.16),24(",",es24.16),15(",",i0),'// &
2277 '",",es24.16,",",l1,",",i0,",",es24.16,",",l1,",",i0)', &
2280 length_summary,length_q,length_diff, &
2281 summary(iseed)%length_forward,q_trace(iseed)%forward_length, &
2282 summary(iseed)%length_backward,q_trace(iseed)%backward_length, &
2283 twist_summary,twist_q,twist_diff, &
2284 summary(iseed)%twist_forward,q_twist(iseed)%forward_twist, &
2285 summary(iseed)%twist_backward,q_twist(iseed)%backward_twist, &
2286 length_short,length_diff_short,length_q_short_diff, &
2287 q_short(iseed)%forward_length,q_short(iseed)%backward_length, &
2288 twist_short,twist_diff_short,twist_q_short_diff, &
2289 q_short_twist(iseed)%forward_twist, &
2290 q_short_twist(iseed)%backward_twist, &
2291 summary(iseed)%forward_status,q_trace(iseed)%forward_status, &
2292 q_short(iseed)%forward_status, &
2293 summary(iseed)%backward_status,q_trace(iseed)%backward_status, &
2294 q_short(iseed)%backward_status, &
2295 summary(iseed)%forward_face,q_trace(iseed)%forward_face, &
2296 q_short(iseed)%forward_face, &
2297 summary(iseed)%backward_face,q_trace(iseed)%backward_face, &
2298 q_short(iseed)%backward_face, &
2299 summary(iseed)%status_twist,q_twist(iseed)%status_twist, &
2300 q_short_twist(iseed)%status_twist, &
2301 q_trace(iseed)%logq0,q_trace(iseed)%valid_q0, &
2302 q_trace(iseed)%status_q0, &
2303 q_short(iseed)%logq0,q_short(iseed)%valid_q0, &
2304 q_short(iseed)%status_q0
2305 if (io_status/=0)
then
2307 call mpistop(
'mt_rk2_fusion_diagnostic could not write CSV data')
2312 write(*,
'(a,es12.4)')
'mt_rk2_fusion_diagnostic max_abs_length_diff: ', &
2314 write(*,
'(a,es12.4)')
'mt_rk2_fusion_diagnostic max_abs_twist_diff: ', &
2316 write(*,
'(a,es12.4)') &
2317 'mt_rk2_fusion_diagnostic max_abs_length_diff_short: ', &
2318 max_length_short_diff
2319 write(*,
'(a,es12.4)') &
2320 'mt_rk2_fusion_diagnostic max_abs_twist_diff_short: ', &
2321 max_twist_short_diff
2322 write(*,
'(a,i0)')
'mt_rk2_fusion_diagnostic status_mismatch_count: ', &
2324 write(*,
'(a,i0)')
'mt_rk2_fusion_diagnostic face_mismatch_count: ', &
2327 'mt_rk2_fusion_diagnostic twist_status_mismatch_count: ', &
2328 twist_status_mismatch
2330 'mt_rk2_fusion_diagnostic short_status_mismatch_count: ', &
2331 short_status_mismatch
2333 'mt_rk2_fusion_diagnostic short_face_mismatch_count: ', &
2336 'mt_rk2_fusion_diagnostic short_twist_status_mismatch_count: ', &
2337 short_twist_status_mismatch
2339 'mt_rk2_fusion_diagnostic short_valid_q_mismatch_count: ', &
2340 short_valid_q_mismatch
2341 end subroutine mt_write_rk2_fusion_diagnostic_csv
2343 double precision function mt_absdiff_or_nan(a,b)
result(diff)
2344 double precision,
intent(in) :: a,b
2346 if (ieee_is_finite(a) .and. ieee_is_finite(b))
then
2349 diff=ieee_value(0.d0,ieee_quiet_nan)
2351 end function mt_absdiff_or_nan
2353 subroutine mt_fieldline_products_spherical_surface(surface,seed_coord, &
2354 s1_min,s1_max,n1,s2_min,s2_max,n2,dL,max_steps,csv_file, &
2355 vtu_file,seed_layout,seed_theta0,seed_phi0,seed_alpha, &
2356 compute_twist,compute_q,compute_qperp,b_min)
2357 character(len=*),
intent(in) :: surface,csv_file,vtu_file,seed_layout
2358 integer,
intent(in) :: n1,n2,max_steps
2359 double precision,
intent(in) :: seed_coord,s1_min,s1_max,s2_min,s2_max,dl
2360 double precision,
intent(in) :: seed_theta0,seed_phi0,seed_alpha
2361 logical,
intent(in),
optional :: compute_twist,compute_q,compute_qperp
2362 double precision,
intent(in),
optional :: b_min
2364 type(trace_topology_result),
allocatable :: topology(:)
2365 type(trace_qperp_result),
allocatable :: q_results(:)
2366 type(trace_qperp_result),
allocatable :: qperp_results(:)
2367 double precision,
allocatable :: seeds(:,:)
2369 logical :: do_twist,do_q,do_qperp
2372 call mpistop(
'mt_fieldline_products_spherical_surface currently '// &
2375 if (ndim/=3 .or. geo_coordinate/=geo_spherical)
then
2376 call mpistop(
'mt_fieldline_products_spherical_surface requires '// &
2377 '3D spherical geometry')
2380 if (periodb(3))
then
2381 call mpistop(
'mt_fieldline_products_spherical_surface does not '// &
2382 'yet support periodic phi')
2385 if (n1<1 .or. n2<1)
then
2386 call mpistop(
'mt_fieldline_products_spherical_surface requires '// &
2387 'sample counts >=1')
2389 if (s1_max<s1_min .or. s2_max<s2_min)
then
2390 call mpistop(
'mt_fieldline_products_spherical_surface requires ordered bounds')
2395 if (
present(compute_twist)) do_twist=compute_twist
2396 if (
present(compute_q)) do_q=compute_q
2397 if (
present(compute_qperp)) do_qperp=compute_qperp
2398 call mt_build_spherical_surface_seeds(surface,seed_coord,s1_min,s1_max, &
2399 n1,s2_min,s2_max,n2,seed_layout,seed_theta0,seed_phi0, &
2402 if (mt_profile_spherical)
call trace_spherical_profile_count_seeds(nseed)
2403 allocate(topology(nseed))
2405 allocate(q_results(nseed))
2407 allocate(q_results(0))
2410 allocate(qperp_results(nseed))
2412 allocate(qperp_results(0))
2415 if (
present(b_min))
then
2416 call mt_trace_spherical_surface_products(seeds,nseed,dl,max_steps, &
2417 topology,q_results,qperp_results,do_twist,do_q,do_qperp,b_min)
2419 call mt_trace_spherical_surface_products(seeds,nseed,dl,max_steps, &
2420 topology,q_results,qperp_results,do_twist,do_q,do_qperp)
2423 if (len_trim(csv_file)>0)
then
2424 call mt_write_spherical_rmin_csv(topology,n1,n2,csv_file, &
2425 'mt_fieldline_products_spherical_surface',do_twist,do_q, &
2426 q_results,do_qperp,qperp_results)
2428 call mt_write_spherical_topology_vtu(vtu_file,topology,n1,n2, &
2429 'mt_fieldline_products_spherical_surface',do_twist,do_q,q_results, &
2430 do_qperp,qperp_results)
2432 deallocate(qperp_results,q_results,topology,seeds)
2433 end subroutine mt_fieldline_products_spherical_surface
2435 subroutine mt_fieldline_products_spherical_cloud(s1_min,s1_max,n1, &
2436 s2_min,s2_max,n2,s3_min,s3_max,n3,dL,max_steps,vtu_file, &
2437 seed_layout,compute_twist,compute_q,compute_qperp,b_min)
2438 character(len=*),
intent(in) :: vtu_file,seed_layout
2439 integer,
intent(in) :: n1,n2,n3,max_steps
2440 double precision,
intent(in) :: s1_min,s1_max,s2_min,s2_max
2441 double precision,
intent(in) :: s3_min,s3_max,dl
2442 logical,
intent(in),
optional :: compute_twist,compute_q,compute_qperp
2443 double precision,
intent(in),
optional :: b_min
2445 type(trace_topology_result),
allocatable :: topology(:)
2446 type(trace_qperp_result),
allocatable :: q_results(:)
2447 type(trace_qperp_result),
allocatable :: qperp_results(:)
2448 double precision,
allocatable :: seeds(:,:)
2450 logical :: do_twist,do_q,do_qperp
2451 character(len=mt_task_name_len) :: integrator
2454 call mpistop(
'mt_fieldline_products_spherical_cloud currently '// &
2457 if (ndim/=3 .or. geo_coordinate/=geo_spherical)
then
2458 call mpistop(
'mt_fieldline_products_spherical_cloud requires '// &
2459 '3D spherical geometry')
2462 if (periodb(3))
then
2463 call mpistop(
'mt_fieldline_products_spherical_cloud does not '// &
2464 'yet support periodic phi')
2467 if (n1<1 .or. n2<1 .or. n3<1)
then
2468 call mpistop(
'mt_fieldline_products_spherical_cloud requires '// &
2469 'sample counts >=1')
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')
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))
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)
2486 if (mt_profile_spherical)
call trace_spherical_profile_count_seeds(nseed)
2487 allocate(topology(nseed))
2489 allocate(q_results(nseed))
2491 allocate(q_results(0))
2494 allocate(qperp_results(nseed))
2496 allocate(qperp_results(0))
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)
2503 call mt_trace_spherical_cloud_products(seeds,nseed,dl,max_steps, &
2504 topology,q_results,qperp_results,do_twist,do_q,do_qperp)
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)
2511 deallocate(qperp_results,q_results,topology,seeds)
2512 end subroutine mt_fieldline_products_spherical_cloud
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
2524 type(trace_qperp_result) :: q_local,qperp_local
2525 double precision :: seed_local(ndim)
2526 integer :: iseed,cache_status
2528 if (nseed<=0)
return
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')
2538 if (
present(b_min))
then
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, &
2545 if (do_q) q_results(iseed)=q_local
2546 if (do_qperp) qperp_results(iseed)=qperp_local
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, &
2556 if (do_q) q_results(iseed)=q_local
2557 if (do_qperp) qperp_results(iseed)=qperp_local
2562 if (do_twist)
call trace_spherical_curl_cache_clear()
2563 end subroutine mt_trace_spherical_surface_products
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
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)
2581 source_normal(1)=-1.d0
2583 if (do_q .and. do_qperp)
then
2584 if (
present(b_min))
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)
2589 call trace_field_spherical_rmin_q_qperp_multi(seed_one,1,dl, &
2590 max_steps,q_one,qperp_one,b_min)
2594 call trace_field_spherical_rmin_q_qperp_multi(seed_one,1,dl, &
2595 max_steps,q_one,qperp_one,twist_results=twist_one)
2597 call trace_field_spherical_rmin_q_qperp_multi(seed_one,1,dl, &
2598 max_steps,q_one,qperp_one)
2601 call mt_q0_trace_to_topology(q_one,twist_one,1,topology_one,do_twist)
2602 topology=topology_one(1)
2604 qperp_result=qperp_one(1)
2609 if (
present(b_min))
then
2611 call trace_field_spherical_rmin_q_multi(seed_one,1,dl,max_steps, &
2612 q_one,b_min,twist_results=twist_one)
2614 call trace_field_spherical_rmin_q_multi(seed_one,1,dl,max_steps, &
2619 call trace_field_spherical_rmin_q_multi(seed_one,1,dl,max_steps, &
2620 q_one,twist_results=twist_one)
2622 call trace_field_spherical_rmin_q_multi(seed_one,1,dl,max_steps, &
2626 call mt_q0_trace_to_topology(q_one,twist_one,1,topology_one,do_twist)
2627 topology=topology_one(1)
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)
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)
2641 topology=topology_one(1)
2644 if (
present(b_min))
then
2645 call trace_field_spherical_qperp_multi(seed_one,1,dl,max_steps, &
2648 call trace_field_spherical_qperp_multi(seed_one,1,dl,max_steps, &
2651 qperp_result=qperp_one(1)
2653 end subroutine mt_trace_spherical_surface_seed
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
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
2671 if (nseed<=0)
return
2673 integrator=mt_lowercase(trim(mt_trace_integrator))
2674 if (do_q .and. do_qperp .and. &
2675 (integrator==
'rk2' .or. integrator==
'rk45_spherical'))
then
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)
2683 call mt_trace_spherical_surface_products(seeds,nseed,dl,max_steps, &
2684 topology,q_results,qperp_results,do_twist,do_q,do_qperp)
2689 if (do_q .and. .not.do_qperp)
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)
2696 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
2697 q_results,twist_results=twist_results)
2699 call mt_q0_trace_to_topology(q_results,twist_results,nseed,topology, &
2701 deallocate(twist_results)
2703 allocate(twist_results(0))
2704 if (
present(b_min))
then
2705 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
2708 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
2711 call mt_q0_trace_to_topology(q_results,twist_results,nseed,topology, &
2713 deallocate(twist_results)
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)
2725 call trace_field_spherical_qperp_multi(seeds,nseed,dl,max_steps, &
2726 qperp_results,twist_results=twist_results)
2728 call mt_qperp_trace_to_topology(qperp_results,twist_results,nseed, &
2730 deallocate(twist_results)
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)
2737 call trace_field_spherical_qperp_multi(seeds,nseed,dl,max_steps, &
2740 call mt_qperp_trace_to_topology(qperp_results,twist_results,nseed, &
2742 deallocate(twist_results)
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')
2755 if (
present(b_min))
then
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., &
2763 topology(iseed)=topology_one(1)
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)
2778 if (do_twist)
call trace_spherical_curl_cache_clear()
2779 end subroutine mt_trace_spherical_cloud_products
2782 max_steps,csv_file,b_min)
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
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)
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')
2799 max_steps,csv_file,b_min)
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
2806 type(trace_mapping_result),
allocatable :: results(:)
2807 double precision,
allocatable :: seeds(:,:)
2808 double precision :: source_normal(3)
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, &
2817 source_normal(3)=1.d0
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)
2824 call trace_field_mapping_multi(seeds,nseed,dl,max_steps,results, &
2825 source_normal=source_normal)
2827 call mt_write_mapping_plane_xy_csv(results,nx,ny,csv_file)
2829 deallocate(seeds,results)
2832 subroutine mt_q_plane_xy(xmin,xmax,nx,ymin,ymax,ny,z0,dL, &
2833 max_steps,csv_file,b_min)
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
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)
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')
2847 end subroutine mt_q_plane_xy
2849 subroutine mt_q_plane_xz(xmin,xmax,nx,zmin,zmax,nz,y0,dL, &
2850 max_steps,csv_file,b_min)
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
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)
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')
2864 end subroutine mt_q_plane_xz
2866 subroutine mt_q_plane_yz(ymin,ymax,ny,zmin,zmax,nz,x0,dL, &
2867 max_steps,csv_file,b_min)
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
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)
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')
2881 end subroutine mt_q_plane_yz
2884 max_steps,csv_file,b_min)
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
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)
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')
2901 max_steps,csv_file,b_min)
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
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)
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')
2918 max_steps,csv_file,b_min)
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
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)
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')
2935 s2min,s2max,n2,dL,max_steps,csv_file,b_min)
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
2943 type(trace_qperp_result),
allocatable :: results(:)
2944 double precision,
allocatable :: seeds(:,:),s1(:),s2(:)
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')
2954 call mt_build_arbitrary_plane_seeds(origin,e1,e2,s1min,s1max,n1, &
2955 s2min,s2max,n2,seeds,s1,s2)
2958 allocate(results(nseed))
2959 if (
present(b_min))
then
2960 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,results,b_min)
2962 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,results)
2964 call mt_write_qperp_arbitrary_csv(results,s1,s2,n1,n2,csv_file, &
2965 'mt_qperp_plane_arbitrary')
2967 deallocate(seeds,s1,s2,results)
2971 s1max,n1,s2min,s2max,n2,dL,max_steps,csv_file,b_min, &
2972 compute_length,compute_twist,compute_q,compute_qperp,vtu_file, &
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
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(:)
2991 logical :: do_length,do_twist,do_q,do_qperp,do_csv
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
3004 if (.not.mt_validate_arbitrary_plane_basis(e1,e2,s1min,s1max,n1, &
3005 s2min,s2max,n2,
'mt_fieldline_products_plane_arbitrary'))
then
3007 call mt_write_fieldline_products_plane_arbitrary_header(csv_file, &
3008 'mt_fieldline_products_plane_arbitrary',do_twist,do_q,do_qperp)
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)
3019 call mt_require_requested_science(do_length,do_twist,do_q,do_qperp, &
3020 'mt_fieldline_products_plane_arbitrary')
3022 call mt_build_arbitrary_plane_seeds(origin,e1,e2,s1min,s1max,n1, &
3023 s2min,s2max,n2,seeds,s1,s2)
3026 allocate(length_results(nseed))
3028 allocate(twist_results(nseed))
3030 allocate(twist_results(0))
3033 allocate(q_results(nseed))
3035 allocate(q_results(0))
3038 allocate(qperp_results(nseed))
3040 allocate(qperp_results(0))
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)
3048 call mt_trace_fieldline_products_seedset(seeds,nseed,dl,max_steps, &
3049 length_results,twist_results,q_results,qperp_results,do_twist, &
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')
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)
3067 deallocate(qperp_results,q_results,twist_results,length_results,seeds,s1,s2)
3071 max_steps,length_csv,twist_csv,mapping_csv,b_min)
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
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)
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')
3090 max_steps,length_csv,twist_csv,mapping_csv,b_min)
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
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)
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')
3109 max_steps,length_csv,twist_csv,mapping_csv,b_min)
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
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)
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')
3128 max_steps,vtu_file,b_min)
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
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)
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')
3145 max_steps,vtu_file,b_min)
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
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)
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')
3162 max_steps,vtu_file,b_min)
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
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)
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')
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)
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
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)
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)
3196 end subroutine mt_qsl_plane_vti_xy
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)
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
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)
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)
3216 end subroutine mt_qsl_plane_vti_xz
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)
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
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)
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)
3236 end subroutine mt_qsl_plane_vti_yz
3239 ymin,ymax,ny,zmin,zmax,nz,length_total,qperp,status)
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(:)
3250 double precision :: origin(3),spacing(3)
3252 if (len_trim(vti_file)==0)
then
3253 call mpistop(
'mt_write_cartesian_vti_pointdata requires a VTI file')
3255 if (nx<=0 .or. ny<=0 .or. nz<=0)
then
3256 call mpistop(
'mt_write_cartesian_vti_pointdata requires positive dimensions')
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')
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')
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)
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
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
3298 if (len_trim(vti_file)==0)
then
3299 call mpistop(
'mt_fieldline_products_volume_vti requires a VTI file')
3302 call mpistop(
'mt_fieldline_products_volume_vti currently requires npe=1')
3305 call mpistop(
'mt_fieldline_products_volume_vti requires 3D Cartesian geometry')
3308 select case (geo_coordinate)
3309 case (geo_cartesian)
3312 case (geo_cartesian_stretched)
3314 call mpistop(
'volume_vti requires Cartesian geometry')
3317 if (nx<=0 .or. ny<=0 .or. nz<=0)
then
3318 call mpistop(
'mt_fieldline_products_volume_vti requires positive dimensions')
3320 if (xmax<xmin .or. ymax<ymin .or. zmax<zmin)
then
3321 call mpistop(
'mt_fieldline_products_volume_vti requires ordered bounds')
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')
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'
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')
3347 if (
present(chunk_nz)) chunk_nz_eff=max(1,min(nz,chunk_nz))
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)
3354 call mt_allocate_volume_products(products,nseed,do_twist,do_q,do_qperp)
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
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)
3365 allocate(length_slab(slab_nseed))
3367 allocate(twist_slab(slab_nseed))
3369 allocate(twist_slab(0))
3372 allocate(q_slab(slab_nseed))
3378 allocate(qperp_slab(slab_nseed))
3380 allocate(qperp_slab(0))
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)
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)
3393 call mt_copy_volume_length_slab(products,length_slab,nx,ny, &
3395 deallocate(length_slab)
3398 call mt_copy_volume_twist_slab(products,twist_slab,nx,ny, &
3401 deallocate(twist_slab)
3404 call mt_copy_volume_q_slab(products,q_slab,nx,ny,k_start,slab_nz)
3409 call mt_copy_volume_qperp_slab(products,qperp_slab,nx,ny, &
3412 deallocate(qperp_slab)
3414 deallocate(seeds_slab)
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)
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
3435 type(trace_topology_result) :: topology_one(1)
3436 double precision :: seed_local(ndim),seed_one(1,ndim)
3438 character(len=mt_task_name_len) :: integrator
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
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)
3449 call trace_field_spherical_rmin_q_qperp_multi(seeds,nseed,dl, &
3450 max_steps,q_results,qperp_results, &
3451 twist_results=twist_results)
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)
3458 call trace_field_spherical_rmin_q_qperp_multi(seeds,nseed,dl, &
3459 max_steps,q_results,qperp_results)
3462 call mt_q0_trace_to_length(q_results,nseed,length_results)
3466 if (do_q .and. do_qperp .and. geo_coordinate/=geo_spherical .and. &
3467 (integrator==
'rk2' .or. integrator==
'rk45_cartesian'))
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)
3473 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3474 qperp_results,twist_results=twist_results)
3477 if (
present(b_min))
then
3478 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3479 qperp_results,b_min)
3481 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3485 q_results=qperp_results
3486 call mt_qperp_trace_to_length(qperp_results,nseed,length_results)
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)
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)
3502 call trace_field_spherical_qperp_multi(seeds,nseed,dl,max_steps, &
3503 qperp_results,twist_results=twist_results)
3506 if (
present(b_min))
then
3507 call trace_field_spherical_qperp_multi(seeds,nseed,dl,max_steps, &
3508 qperp_results,b_min)
3510 call trace_field_spherical_qperp_multi(seeds,nseed,dl,max_steps, &
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)
3520 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3521 qperp_results,twist_results=twist_results)
3524 if (
present(b_min))
then
3525 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3526 qperp_results,b_min)
3528 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3533 call mt_qperp_trace_to_length(qperp_results,nseed,length_results)
3537 if (do_q .and. .not.do_qperp .and. geo_coordinate==geo_spherical .and. &
3538 (integrator==
'rk2' .or. integrator==
'rk45_spherical'))
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)
3544 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
3545 q_results,twist_results=twist_results)
3548 if (
present(b_min))
then
3549 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
3552 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
3556 call mt_q0_trace_to_length(q_results,nseed,length_results)
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
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)
3573 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3574 q_results,twist_results=twist_results)
3577 if (
present(b_min))
then
3578 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3581 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
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)
3591 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
3592 max_steps,q_results,twist_results=twist_results)
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)
3599 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
3600 max_steps,q_results)
3604 else if (integrator==
'rk45_cartesian')
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)
3610 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3611 q_results,twist_results=twist_results)
3614 if (
present(b_min))
then
3615 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
3618 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,q_results)
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)
3627 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl, &
3628 max_steps,q_results,twist_results=twist_results)
3631 if (
present(b_min))
then
3632 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl, &
3633 max_steps,q_results,b_min)
3635 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl, &
3636 max_steps,q_results)
3640 call mt_q0_trace_to_length(q_results,nseed,length_results)
3644 if (
present(b_min))
then
3647 seed_local=seeds(iseed,:)
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., &
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))
3658 call trace_field_length_single(seed_local,dl,max_steps, &
3659 length_results(iseed),b_min)
3662 call trace_field_qperp_single(seed_local,dl,max_steps, &
3663 qperp_results(iseed),b_min)
3670 seed_local=seeds(iseed,:)
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))
3680 call trace_field_length_single(seed_local,dl,max_steps, &
3681 length_results(iseed))
3684 call trace_field_qperp_single(seed_local,dl,max_steps, &
3685 qperp_results(iseed))
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, &
3697 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,q_results)
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)
3704 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl, &
3705 max_steps,q_results)
3707 else if (do_qperp)
then
3708 q_results=qperp_results
3710 if (
present(b_min))
then
3711 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,q_results, &
3714 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,q_results)
3718 end subroutine mt_trace_fieldline_products_seedset
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
3727 type(trace_twist_result) :: result
3728 double precision :: seed_xyz(3)
3729 integer :: csv_unit,io_status
3732 call mpistop(
'mt_twist_single currently requires npe=1')
3734 if (ndim/=3 .or. .not.slab_uniform)
then
3735 call mpistop(
'mt_twist_single requires 3D uniform Cartesian geometry')
3738 if (
present(b_min))
then
3739 call trace_field_twist_single(seed,dl,max_steps,result,b_min)
3741 call trace_field_twist_single(seed,dl,max_steps,result)
3745 seed_xyz(1:ndim)=result%line%seed
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')
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
3761 call mpistop(
'mt_twist_single could not write CSV header')
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
3772 call mpistop(
'mt_twist_single could not write CSV data')
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
3785 type(trace_twist_result),
allocatable :: results(:)
3786 double precision :: seed_xyz(3)
3787 integer :: csv_unit,io_status,iseed
3790 call mpistop(
'mt_twist_seeds currently requires npe=1')
3792 if (ndim/=3 .or. .not.slab_uniform)
then
3793 call mpistop(
'mt_twist_seeds requires 3D uniform Cartesian geometry')
3796 call mpistop(
'mt_twist_seeds requires nseed>=0')
3799 allocate(results(nseed))
3800 if (
present(b_min))
then
3801 call trace_field_twist_multi(seeds,nseed,dl,max_steps,results,b_min)
3803 call trace_field_twist_multi(seeds,nseed,dl,max_steps,results)
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
3810 call mpistop(
'mt_twist_seeds could not open CSV file')
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
3822 call mpistop(
'mt_twist_seeds could not write CSV header')
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
3841 call mpistop(
'mt_twist_seeds could not write CSV data')
3850 max_steps,csv_file,b_min)
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
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)
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')
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
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)
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')
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
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)
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')
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
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)
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')
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
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)
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')
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
3939 type(trace_length_result),
allocatable :: results(:)
3940 double precision,
allocatable :: seeds(:,:)
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)
3948 allocate(results(nseed))
3949 if (
present(b_min))
then
3950 call trace_field_length_multi(seeds,nseed,dl,max_steps,results,b_min)
3952 call trace_field_length_multi(seeds,nseed,dl,max_steps,results)
3954 call mt_write_length_plane_csv(results,n1,n2,csv_file,caller, &
3957 deallocate(seeds,results)
3958 end subroutine mt_length_plane_axis
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
3969 type(trace_twist_result),
allocatable :: results(:)
3970 double precision,
allocatable :: seeds(:,:)
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)
3978 allocate(results(nseed))
3979 if (
present(b_min))
then
3980 call trace_field_twist_multi(seeds,nseed,dl,max_steps,results,b_min)
3982 call trace_field_twist_multi(seeds,nseed,dl,max_steps,results)
3984 call mt_write_twist_plane_csv(results,n1,n2,csv_file,caller, &
3987 deallocate(seeds,results)
3988 end subroutine mt_twist_plane_axis
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, &
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
3999 type(trace_qperp_result),
allocatable :: results(:)
4000 double precision,
allocatable :: seeds(:,:)
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)
4008 allocate(results(nseed))
4009 if (
present(b_min))
then
4010 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,results,b_min)
4012 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,results)
4014 call mt_write_q_plane_csv(results,n1,n2,csv_file,caller,index_header)
4016 deallocate(seeds,results)
4017 end subroutine mt_q_plane_axis
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
4028 type(trace_qperp_result),
allocatable :: results(:)
4029 double precision,
allocatable :: seeds(:,:)
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)
4037 allocate(results(nseed))
4038 if (
present(b_min))
then
4039 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,results,b_min)
4041 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,results)
4043 call mt_write_qperp_plane_csv(results,n1,n2,csv_file,caller, &
4046 deallocate(seeds,results)
4047 end subroutine mt_qperp_plane_axis
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, &
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
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(:,:)
4066 logical :: do_twist,do_q,do_qperp
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')
4073 do_twist=len_trim(twist_csv)>0
4074 do_q=len_trim(q_csv)>0
4075 do_qperp=len_trim(qperp_csv)>0
4077 call mt_build_axis_plane_seeds(c1min,c1max,n1,c2min,c2max,n2, &
4078 fixed_value,axis1,axis2,fixed_axis,seeds)
4080 allocate(length_results(nseed))
4082 allocate(twist_results(nseed))
4084 allocate(twist_results(0))
4087 allocate(q_results(nseed))
4089 allocate(q_results(0))
4092 allocate(qperp_results(nseed))
4094 allocate(qperp_results(0))
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)
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)
4107 call mt_write_length_plane_csv(length_results,n1,n2,length_csv, &
4108 caller,length_index_header)
4110 call mt_write_twist_plane_csv(twist_results,n1,n2,twist_csv, &
4111 caller,length_index_header)
4114 call mt_write_q_plane_csv(q_results,n1,n2,q_csv,caller, &
4118 call mt_write_qperp_plane_csv(qperp_results,n1,n2,qperp_csv, &
4119 caller,index_header)
4122 deallocate(qperp_results,q_results,twist_results,length_results,seeds)
4123 end subroutine mt_axis_plane_products_csv_axis
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, &
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
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)
4143 logical :: write_twist,write_mapping,need_mapping
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')
4150 write_twist=len_trim(twist_csv)>0
4151 write_mapping=len_trim(mapping_csv)>0
4152 need_mapping=write_mapping
4154 call mt_build_axis_plane_seeds(c1min,c1max,n1,c2min,c2max,n2, &
4155 fixed_value,axis1,axis2,fixed_axis,seeds)
4157 allocate(topology(nseed),length_results(nseed))
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)
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)
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)
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)
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)
4189 deallocate(mapping_results)
4192 deallocate(length_results,topology,seeds)
4193 end subroutine mt_topology_plane_axis
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, &
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
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)
4211 logical :: need_mapping
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')
4218 call mt_build_axis_plane_seeds(c1min,c1max,n1,c2min,c2max,n2, &
4219 fixed_value,axis1,axis2,fixed_axis,seeds)
4221 allocate(length_results(nseed),twist_results(nseed), &
4222 mapping_results(nseed),qperp_results(nseed))
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)
4232 call mt_trace_qsl_plane_full(seeds,nseed,dl,max_steps,source_normal, &
4233 qperp_results,twist_results,mapping_results)
4235 call mt_qperp_trace_to_length(qperp_results,nseed,length_results)
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)
4241 call mt_trace_qsl_plane_minimal(seeds,nseed,dl,max_steps, &
4242 qperp_results,twist_results)
4244 call mt_qperp_trace_to_length(qperp_results,nseed,length_results)
4247 call mt_write_qsl_plane_vtu(vtu_file,length_results,twist_results, &
4248 mapping_results,qperp_results,n1,n2,caller)
4250 deallocate(qperp_results,mapping_results,twist_results, &
4251 length_results,seeds)
4252 end subroutine mt_qsl_plane_vtu_axis
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
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
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')
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, &
4284 call mt_build_axis_plane_seeds(c1min,c1max,n1,c2min,c2max,n2, &
4285 fixed_value,axis1,axis2,fixed_axis,seeds)
4288 allocate(length_results(nseed))
4290 allocate(twist_results(nseed))
4292 allocate(twist_results(0))
4295 allocate(q_results(nseed))
4297 allocate(q_results(0))
4300 allocate(qperp_results(nseed))
4302 allocate(qperp_results(0))
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)
4310 call mt_trace_fieldline_products_seedset(seeds,nseed,dl,max_steps, &
4311 length_results,twist_results,q_results,qperp_results,do_twist, &
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, &
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, &
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)
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, &
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
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
4367 double precision :: seed_local(ndim)
4370 if (
present(b_min))
then
4373 seed_local=seeds(iseed,:)
4374 call trace_field_mapping_single(seed_local,dl,max_steps, &
4375 mapping_results(iseed),b_min,source_normal)
4378 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
4379 qperp_results,b_min,twist_results=twist_results)
4383 seed_local=seeds(iseed,:)
4384 call trace_field_mapping_single(seed_local,dl,max_steps, &
4385 mapping_results(iseed),source_normal=source_normal)
4388 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
4389 qperp_results,twist_results=twist_results)
4391 end subroutine mt_trace_qsl_plane_full
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
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)
4405 call trace_field_qperp_multi(seeds,nseed,dl,max_steps, &
4406 qperp_results,twist_results=twist_results)
4408 end subroutine mt_trace_qsl_plane_minimal
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)
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
4431 results(iseed)%forward_length=0.d0
4432 results(iseed)%backward_length=0.d0
4433 results(iseed)%total_length=0.d0
4436 end subroutine mt_qperp_to_length
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)
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
4458 end subroutine mt_qperp_trace_to_length
4460 subroutine mt_qperp_trace_to_topology(qperp_results,twist_results,nseed, &
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
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
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
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
4514 topology(iseed)%valid_twist=twist_results(iseed)%valid_twist
4515 topology(iseed)%status_twist=twist_results(iseed)%status_twist
4517 topology(iseed)%valid=qperp_results(iseed)%status==trace_status_boundary
4518 topology(iseed)%status=qperp_results(iseed)%status
4520 end subroutine mt_qperp_trace_to_topology
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)
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
4542 end subroutine mt_q0_trace_to_length
4544 subroutine mt_q0_trace_to_topology(q_results,twist_results,nseed, &
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
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
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
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
4598 topology(iseed)%valid_twist=twist_results(iseed)%valid_twist
4599 topology(iseed)%status_twist=twist_results(iseed)%status_twist
4601 topology(iseed)%valid=q_results(iseed)%status==trace_status_boundary
4602 topology(iseed)%status=q_results(iseed)%status
4604 end subroutine mt_q0_trace_to_topology
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)
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
4625 end subroutine mt_topology_to_length
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)
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
4651 end subroutine mt_topology_to_twist
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)
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
4679 end subroutine mt_topology_to_mapping
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
4687 call mpistop(trim(caller)//
' currently requires npe=1')
4690 call mpistop(trim(caller)//
' requires ndim=3')
4694 select case (geo_coordinate)
4695 case (geo_cartesian)
4698 case (geo_cartesian_stretched)
4700 call mpistop(trim(caller)//
' requires Cartesian geometry')
4703 if (n1<1 .or. n2<1)
then
4704 call mpistop(trim(caller)//
' requires both sample counts >=1')
4706 if (c1max<c1min .or. c2max<c2min)
then
4707 call mpistop(trim(caller)//
' requires ordered plane bounds')
4709 end subroutine mt_validate_axis_plane
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(:,:)
4717 double precision :: dc1,dc2
4718 integer :: i,j,iseed
4722 if (n1>1) dc1=(c1max-c1min)/dble(n1-1)
4723 if (n2>1) dc2=(c2max-c2min)/dble(n2-1)
4725 allocate(seeds(n1*n2,ndim))
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
4735 end subroutine mt_build_axis_plane_seeds
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, &
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(:,:)
4746 character(len=mt_task_name_len) :: layout
4747 double precision :: s1,s2
4748 integer :: i,j,iseed,status
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')
4756 call mpistop(
'spherical_surface_products requires '// &
4757 'mt_seed_layout=endpoint or cell_centered')
4760 allocate(seeds(n1*n2,ndim))
4763 s2=mt_seed_axis_coord(s2_min,s2_max,n2,j,layout)
4765 s1=mt_seed_axis_coord(s1_min,s1_max,n1,i,layout)
4767 select case (trim(surface))
4768 case (
'rmin',
'rconst')
4769 seeds(iseed,1)=seed_coord
4772 case (
'theta_const')
4774 seeds(iseed,2)=seed_coord
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)
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')
4789 call mpistop(
'mt_build_spherical_surface_seeds got '// &
4790 'unsupported surface')
4794 end subroutine mt_build_spherical_surface_seeds
4796 subroutine mt_spherical_radial_plane_seed(radius,u,theta0,phi0,alpha,seed, &
4798 double precision,
intent(in) :: radius,u,theta0,phi0,alpha
4799 double precision,
intent(out) :: seed(ndim)
4800 integer,
intent(out) :: status
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
4809 if (radius<xprobmin1 .or. radius>xprobmax1)
return
4810 if (theta0<xprobmin2 .or. theta0>xprobmax2)
return
4811 if (phi0<xprobmin3 .or. phi0>xprobmax3)
return
4813 sin_theta0=dsin(theta0)
4814 cos_theta0=dcos(theta0)
4815 if (abs(sin_theta0)<=1.d-12)
return
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
4826 nhat=cos_u*n0+sin_u*tangent
4827 norm_n=dsqrt(sum(nhat**2))
4828 if (norm_n<=0.d0)
return
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
4841 end subroutine mt_spherical_radial_plane_seed
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(:,:)
4851 character(len=mt_task_name_len) :: layout
4852 double precision :: s1,s2,s3
4853 integer :: i,j,k,iseed
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')
4861 call mpistop(
'spherical_cloud_products requires '// &
4862 'mt_seed_layout=endpoint or cell_centered')
4865 allocate(seeds(n1*n2*n3,ndim))
4868 s3=mt_seed_axis_coord(s3_min,s3_max,n3,k,layout)
4870 s2=mt_seed_axis_coord(s2_min,s2_max,n2,j,layout)
4872 s1=mt_seed_axis_coord(s1_min,s1_max,n1,i,layout)
4873 iseed=(k-1)*n1*n2+(j-1)*n1+i
4880 end subroutine mt_build_spherical_cloud_seeds
4882 double precision function mt_seed_axis_coord(cmin,cmax,n,i,layout) &
4884 double precision,
intent(in) :: cmin,cmax
4885 integer,
intent(in) :: n,i
4886 character(len=*),
intent(in) :: layout
4888 select case (trim(layout))
4889 case (
'cell_centered',
'cell-centered',
'centered',
'center')
4890 coord=cmin+(dble(i)-0.5d0)*(cmax-cmin)/dble(n)
4893 coord=cmin+dble(i-1)*(cmax-cmin)/dble(n-1)
4898 end function mt_seed_axis_coord
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
4905 logical :: b_rmin,f_rmin,b_rmax,f_rmax,b_side,f_side
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
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)
4919 if (b_rmin .and. f_rmin)
then
4921 else if ((b_rmin .and. f_rmax) .or. (b_rmax .and. f_rmin))
then
4923 else if ((b_rmin .and. f_side) .or. (f_rmin .and. b_side))
then
4925 else if (b_rmax .and. f_rmax)
then
4927 else if (b_side .and. f_side .and. face_b==face_f)
then
4932 end function mt_spherical_connection_type
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
4941 double precision,
parameter :: basis_tol=1.d-10
4942 double precision :: e1_norm,e2_norm,e12_dot
4946 write(*,
'(a)') trim(caller)//
' currently requires npe=1'
4950 write(*,
'(a)') trim(caller)//
' requires ndim=3'
4954 select case (geo_coordinate)
4955 case (geo_cartesian,geo_cartesian_stretched)
4957 write(*,
'(a)') trim(caller)//
' requires Cartesian geometry'
4961 if (n1<1 .or. n2<1)
then
4962 write(*,
'(a)') trim(caller)//
' requires both sample counts >=1'
4965 if (s1max<s1min .or. s2max<s2min)
then
4966 write(*,
'(a)') trim(caller)//
' requires ordered plane bounds'
4969 e1_norm=dsqrt(sum(e1**2))
4970 e2_norm=dsqrt(sum(e2**2))
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'
4980 end function mt_validate_arbitrary_plane_basis
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(:)
4989 double precision :: ds1,ds2
4990 integer :: i,j,iseed
4994 if (n1>1) ds1=(s1max-s1min)/dble(n1-1)
4995 if (n2>1) ds2=(s2max-s2min)/dble(n2-1)
4997 allocate(seeds(n1*n2,ndim),s1(n1*n2),s2(n1*n2))
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
5006 end subroutine mt_build_arbitrary_plane_seeds
5008 subroutine mt_write_length_plane_csv(results,n1,n2,csv_file,caller, &
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
5014 double precision :: seed_xyz(3)
5015 integer :: csv_unit,io_status,i,j,iseed
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')
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
5030 call mpistop(trim(caller)//
' could not write CSV header')
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
5048 call mpistop(trim(caller)//
' could not write CSV data')
5054 end subroutine mt_write_length_plane_csv
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(:)
5065 integer :: csv_unit,io_status,i,j,iseed,connection_type
5067 character(len=2048) :: header
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')
5075 header=
'i,j,seed_r,seed_theta,seed_phi,'// &
5076 'length_total,length_backward,length_forward'
5078 header=trim(header)//
','// &
5079 'twist_total,twist_backward,twist_forward'
5082 header=trim(header)//
','// &
5083 'logQ,valid_Q,status_Q'
5086 header=trim(header)//
','// &
5087 'logQperp,valid_Qperp,status_Qperp'
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'
5094 header=trim(header)//
','// &
5095 'status_twist,valid_twist'
5097 header=trim(header)//
',valid'
5098 write(csv_unit,
'(a)',iostat=io_status) trim(header)
5099 if (io_status/=0)
then
5101 call mpistop(trim(caller)//
' could not write CSV header')
5107 valid=topology(iseed)%valid
5108 connection_type=mt_spherical_connection_type( &
5109 topology(iseed)%backward_face,topology(iseed)%forward_face, &
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
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
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
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
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
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
5150 write(csv_unit,
'(",",l1)',iostat=io_status) valid
5151 if (io_status/=0)
then
5153 call mpistop(trim(caller)//
' could not write CSV data')
5159 end subroutine mt_write_spherical_rmin_csv
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(:)
5170 integer :: vtu_unit,io_status,npoint,ncell
5174 if (n1>1 .and. n2>1) ncell=(n1-1)*(n2-1)
5175 if (ncell==0) ncell=npoint
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')
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)
5192 call mt_write_vtu_vertex_cells(vtu_unit,npoint,io_status)
5195 if (io_status==0)
call mt_write_vtu_file_footer(vtu_unit,io_status)
5197 if (io_status/=0)
then
5198 call mpistop(trim(caller)//
' could not write VTU file')
5200 end subroutine mt_write_spherical_topology_vtu
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(:)
5210 integer :: csv_unit,io_status,i,j,k,iseed,connection_type
5212 character(len=2048) :: header
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')
5220 header=
'i,j,k,seed_r,seed_theta,seed_phi,'// &
5221 'length_total,length_backward,length_forward'
5223 header=trim(header)//
','// &
5224 'twist_total,twist_backward,twist_forward'
5227 header=trim(header)//
','// &
5228 'logQperp,valid_Qperp,status_Qperp'
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'
5235 header=trim(header)//
','// &
5236 'status_twist,valid_twist'
5238 header=trim(header)//
',valid'
5239 write(csv_unit,
'(a)',iostat=io_status) trim(header)
5240 if (io_status/=0)
then
5242 call mpistop(trim(caller)//
' could not write CSV header')
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, &
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
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
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
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
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
5287 write(csv_unit,
'(",",l1)',iostat=io_status) valid
5288 if (io_status/=0)
exit
5290 if (io_status/=0)
exit
5292 if (io_status/=0)
exit
5295 if (io_status/=0)
then
5297 call mpistop(trim(caller)//
' could not write CSV data')
5300 end subroutine mt_write_spherical_cloud_csv
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(:)
5311 integer :: vtu_unit,io_status
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')
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, &
5326 if (io_status==0)
call mt_write_vtu_file_footer(vtu_unit,io_status)
5328 if (io_status/=0)
then
5329 call mpistop(trim(caller)//
' could not write VTU file')
5331 end subroutine mt_write_spherical_cloud_vtu
5333 subroutine mt_write_fieldline_products_seeds_csv(length_results, &
5334 twist_results,q_results,qperp_results,nseed,csv_file,do_twist, &
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
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
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')
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'
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'
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'
5374 header=trim(header)//
','// &
5375 'qperp,logqperp,valid_qperp,status_qperp,'// &
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'
5384 write(csv_unit,
'(a)',iostat=io_status) trim(header)
5385 if (io_status/=0)
then
5387 call mpistop(
'mt_fieldline_products_seeds could not write CSV header')
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
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
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
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))
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
5458 write(csv_unit,
'()',iostat=io_status)
5459 if (io_status/=0)
exit
5462 if (io_status/=0)
then
5464 call mpistop(
'mt_fieldline_products_seeds could not write CSV data')
5467 end subroutine mt_write_fieldline_products_seeds_csv
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
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'
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'
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'
5492 header=trim(header)//
','// &
5493 'qperp,logqperp,valid_qperp,status_qperp,'// &
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'
5502 end subroutine mt_fieldline_products_append_header
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
5509 character(len=2048) :: header
5510 integer :: csv_unit,io_status
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')
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
5523 call mpistop(trim(caller)//
' could not write CSV header')
5527 end subroutine mt_write_fieldline_products_plane_arbitrary_header
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
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
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')
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
5557 call mpistop(trim(caller)//
' could not write CSV header')
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
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
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
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))
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
5631 write(csv_unit,
'()',iostat=io_status)
5632 if (io_status/=0)
exit
5634 if (io_status/=0)
exit
5637 if (io_status/=0)
then
5639 call mpistop(trim(caller)//
' could not write CSV data')
5642 end subroutine mt_write_fieldline_products_plane_arbitrary_csv
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
5650 integer :: vtu_unit,io_status
5651 logical :: do_length_eff
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')
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, &
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>'
5669 if (io_status==0)
then
5670 write(vtu_unit,
'(a)',iostat=io_status) &
5671 '<DataArray type="Float64" NumberOfComponents="3" format="ascii">'
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
5679 call mpistop(trim(caller)//
' could not write VTU file')
5683 end subroutine mt_write_fieldline_products_vtu_empty
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
5696 integer :: vtu_unit,io_status
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')
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, &
5712 if (io_status==0)
call mt_write_vtu_vertex_cells(vtu_unit,npoint, &
5714 if (io_status==0)
call mt_write_vtu_file_footer(vtu_unit,io_status)
5715 if (io_status/=0)
then
5717 call mpistop(trim(caller)//
' could not write VTU file')
5721 end subroutine mt_write_fieldline_products_vtu_vertices
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
5735 integer :: npoint,ncell,vtu_unit,io_status
5736 logical :: do_length_eff
5739 if (n1>1 .and. n2>1)
then
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')
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, &
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)
5765 call mt_write_vtu_vertex_cells(vtu_unit,npoint,io_status)
5768 if (io_status==0)
call mt_write_vtu_file_footer(vtu_unit,io_status)
5769 if (io_status/=0)
then
5771 call mpistop(trim(caller)//
' could not write VTU file')
5775 end subroutine mt_write_fieldline_products_vtu_plane
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
5786 integer :: npoint,ncell,vtu_unit,io_status
5789 if (n1>1 .and. n2>1)
then
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')
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, &
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)
5812 call mt_write_vtu_vertex_cells(vtu_unit,npoint,io_status)
5815 if (io_status==0)
call mt_write_vtu_file_footer(vtu_unit,io_status)
5816 if (io_status/=0)
then
5818 call mpistop(trim(caller)//
' could not write VTU file')
5822 end subroutine mt_write_qsl_plane_vtu
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
5833 write(vtu_unit,
'(a)',iostat=io_status)
'<PointData>'
5834 if (io_status/=0)
return
5836 if (mt_vtk_detail_is_full())
then
5837 call mt_write_vtu_length_pointdata(vtu_unit,length_results,npoint, &
5839 call mt_write_vtu_twist_pointdata(vtu_unit,twist_results,npoint, &
5841 call mt_write_vtu_mapping_pointdata(vtu_unit,mapping_results,npoint, &
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, &
5847 call mt_write_vtu_qperp_method2_pointdata(vtu_unit,qperp_results, &
5850 call mt_write_vtu_qsl_minimal_pointdata(vtu_unit,length_results, &
5851 twist_results,qperp_results,npoint,io_status)
5854 if (io_status==0)
write(vtu_unit,
'(a)',iostat=io_status)
'</PointData>'
5855 end subroutine mt_write_qsl_plane_vtu_pointdata
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
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), &
5871 call mt_write_vtu_data_array_end(vtu_unit,io_status)
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), &
5877 call mt_write_vtu_data_array_end(vtu_unit,io_status)
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)
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)
5891 end subroutine mt_write_vtu_qsl_minimal_pointdata
5893 double precision function mt_vti_axis_spacing(xmin,xmax,n)
5894 integer,
intent(in) :: n
5895 double precision,
intent(in) :: xmin,xmax
5898 mt_vti_axis_spacing=(xmax-xmin)/dble(n-1)
5900 mt_vti_axis_spacing=0.d0
5902 end function mt_vti_axis_spacing
5904 subroutine mt_allocate_volume_products(products,nseed,do_twist,do_q, &
5906 type(mt_volume_products),
intent(inout) :: products
5907 integer,
intent(in) :: nseed
5908 logical,
intent(in) :: do_twist,do_q,do_qperp
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))
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))
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))
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))
5963 end subroutine mt_allocate_volume_products
5965 subroutine mt_deallocate_volume_products(products)
5966 type(mt_volume_products),
intent(inout) :: products
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)
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)
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)
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
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
6043 integer :: i,j,k,kk,iseed
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)
6056 end subroutine mt_build_volume_slab_seeds
6058 subroutine mt_copy_volume_length_slab(products,results,nx,ny,k_start, &
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
6064 integer :: i,j,kk,k,ilocal,iglobal
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
6086 end subroutine mt_copy_volume_length_slab
6088 subroutine mt_copy_volume_twist_slab(products,results,nx,ny,k_start, &
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
6094 integer :: i,j,kk,k,ilocal,iglobal
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
6116 end subroutine mt_copy_volume_twist_slab
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
6123 integer :: i,j,kk,k,ilocal,iglobal
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
6149 end subroutine mt_copy_volume_q_slab
6151 subroutine mt_copy_volume_qperp_slab(products,results,nx,ny,k_start, &
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
6157 integer :: i,j,kk,k,ilocal,iglobal
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
6187 end subroutine mt_copy_volume_qperp_slab
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
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
6206 end subroutine mt_build_vti_desc
6208 subroutine mt_finalize_vti_desc_offsets(descs,ndesc)
6209 integer,
intent(in) :: ndesc
6210 type(mt_vti_array_desc),
intent(inout) :: descs(ndesc)
6213 integer(kind=8) :: offset
6217 descs(idesc)%offset=offset
6218 offset=offset+descs(idesc)%nbytes+4_8
6220 end subroutine mt_finalize_vti_desc_offsets
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
6229 call mt_build_vti_desc(descs(idesc),name,array_kind,npoint)
6230 end subroutine mt_append_vti_desc
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
6238 allocate(descs(ndesc))
6239 call mt_build_vti_desc(descs(1),
'length_total',mt_vti_kind_float64, &
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
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
6253 integer :: idesc,max_desc
6255 if (.not.mt_vtk_detail_is_full())
then
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
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
6268 allocate(descs(max_desc))
6272 call mt_append_vti_desc(descs,idesc,
'length_total', &
6273 mt_vti_kind_float64,npoint)
6275 if (.not.mt_vtk_detail_is_full())
then
6277 call mt_append_vti_desc(descs,idesc,
'twist_total', &
6278 mt_vti_kind_float64,npoint)
6281 call mt_append_vti_desc(descs,idesc,
'logQ', &
6282 mt_vti_kind_float64,npoint)
6285 call mt_append_vti_desc(descs,idesc,
'logQperp', &
6286 mt_vti_kind_float64,npoint)
6289 call mt_finalize_vti_desc_offsets(descs,ndesc)
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)
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)
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)
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, &
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)
6390 call mt_finalize_vti_desc_offsets(descs,ndesc)
6391 end subroutine mt_build_volume_vti_descs
6393 character(len=8) function mt_vti_type_name(array_kind)
6394 integer,
intent(in) :: array_kind
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'
6402 mt_vti_type_name=
'Unknown'
6404 end function mt_vti_type_name
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
6413 integer :: extent(6),idesc
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
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
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
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
6455 integer :: vti_unit,io_status,npoint
6456 character(len=1) :: marker
6457 type(mt_vti_array_desc),
allocatable :: descs(:)
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)
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')
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
6475 call mpistop(trim(caller)//
' could not write VTI header')
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')
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, &
6493 if (io_status/=0)
then
6494 call mpistop(trim(caller)//
' could not write VTI payload')
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')
6502 write(vti_unit,
'(a)',iostat=io_status)
'</AppendedData>'
6503 if (io_status==0)
write(vti_unit,
'(a)',iostat=io_status)
'</VTKFile>'
6505 if (io_status/=0)
then
6506 call mpistop(trim(caller)//
' could not write VTI footer')
6509 end subroutine mt_write_fieldline_products_volume_vti
6511 subroutine mt_write_volume_vti_payload(vti_unit,products,npoint,descs, &
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
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, &
6527 call mt_write_vti_payload_float64_visual(vti_unit, &
6528 products%length_total,npoint,io_status)
6530 case (
'length_backward')
6531 call mt_write_vti_payload_float64(vti_unit,products%length_backward, &
6533 case (
'length_forward')
6534 call mt_write_vti_payload_float64(vti_unit,products%length_forward, &
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, &
6553 call mt_write_vti_payload_float64_visual(vti_unit, &
6554 products%twist_total,npoint,io_status)
6556 case (
'twist_backward')
6557 call mt_write_vti_payload_float64(vti_unit,products%twist_backward, &
6559 case (
'twist_forward')
6560 call mt_write_vti_payload_float64(vti_unit,products%twist_forward, &
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)
6575 call mt_write_vti_payload_float64(vti_unit,products%q,npoint, &
6578 call mt_write_vti_payload_float64(vti_unit,products%logq,npoint, &
6581 call mt_write_vti_payload_logq_visual(vti_unit,products,npoint, &
6584 call mt_write_vti_payload_float64(vti_unit,products%N2_q,npoint, &
6587 call mt_write_vti_payload_float64(vti_unit,products%bfactor_q, &
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, &
6599 call mt_write_vti_payload_float64(vti_unit,products%Bf_norm_q,npoint, &
6602 call mt_write_vti_payload_float64(vti_unit,products%Bb_norm_q,npoint, &
6605 call mt_write_vti_payload_int32(vti_unit,products%valid_q,npoint, &
6608 call mt_write_vti_payload_int32(vti_unit,products%status_q,npoint, &
6610 case (
'face_forward_Q')
6611 call mt_write_vti_payload_int32(vti_unit,products%face_forward_q, &
6613 case (
'face_backward_Q')
6614 call mt_write_vti_payload_int32(vti_unit,products%face_backward_q, &
6616 case (
'status_forward_Q')
6617 call mt_write_vti_payload_int32(vti_unit,products%status_forward_q, &
6619 case (
'status_backward_Q')
6620 call mt_write_vti_payload_int32(vti_unit,products%status_backward_q, &
6623 call mt_write_vti_payload_float64(vti_unit,products%qperp,npoint, &
6626 call mt_write_vti_payload_float64(vti_unit,products%logqperp, &
6629 call mt_write_vti_payload_logqperp_visual(vti_unit,products,npoint, &
6632 call mt_write_vti_payload_float64(vti_unit,products%N2,npoint, &
6635 call mt_write_vti_payload_float64(vti_unit,products%bfactor,npoint, &
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)
6644 call mt_write_vti_payload_float64(vti_unit,products%Bseed_norm, &
6647 call mt_write_vti_payload_float64(vti_unit,products%Bf_norm,npoint, &
6650 call mt_write_vti_payload_float64(vti_unit,products%Bb_norm,npoint, &
6652 case (
'valid_qperp')
6653 call mt_write_vti_payload_int32(vti_unit,products%valid_qperp, &
6655 case (
'valid_Qperp')
6656 call mt_write_vti_payload_int32(vti_unit,products%valid_qperp, &
6658 case (
'status_qperp')
6659 call mt_write_vti_payload_int32(vti_unit,products%status_qperp, &
6661 case (
'status_Qperp')
6662 call mt_write_vti_payload_int32(vti_unit,products%status_qperp, &
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)
6679 if (io_status/=0)
exit
6681 end subroutine mt_write_volume_vti_payload
6683 subroutine mt_write_vti_payload_logq_visual(vti_unit,products,npoint, &
6685 integer,
intent(in) :: vti_unit,npoint
6686 type(mt_volume_products),
intent(in) :: products
6687 integer,
intent(inout) :: io_status
6689 double precision,
allocatable :: visual_values(:)
6692 allocate(visual_values(npoint))
6694 visual_values(ipoint)=mt_visual_valid_float(products%logq(ipoint), &
6695 products%valid_q(ipoint)==1)
6697 call mt_write_vti_payload_float64(vti_unit,visual_values,npoint, &
6699 deallocate(visual_values)
6700 end subroutine mt_write_vti_payload_logq_visual
6702 subroutine mt_write_vti_payload_float64_visual(vti_unit,values,npoint, &
6704 integer,
intent(in) :: vti_unit,npoint
6705 double precision,
intent(in) :: values(npoint)
6706 integer,
intent(inout) :: io_status
6708 double precision,
allocatable :: visual_values(:)
6711 if (io_status/=0)
return
6712 allocate(visual_values(npoint))
6714 visual_values(ipoint)=mt_visual_float(values(ipoint))
6716 call mt_write_vti_payload_float64(vti_unit,visual_values,npoint, &
6718 deallocate(visual_values)
6719 end subroutine mt_write_vti_payload_float64_visual
6721 subroutine mt_write_vti_payload_logqperp_visual(vti_unit,products,npoint, &
6723 integer,
intent(in) :: vti_unit,npoint
6724 type(mt_volume_products),
intent(in) :: products
6725 integer,
intent(inout) :: io_status
6727 double precision,
allocatable :: visual_values(:)
6730 if (io_status/=0)
return
6731 allocate(visual_values(npoint))
6733 visual_values(ipoint)=mt_visual_valid_float(products%logqperp(ipoint), &
6734 products%valid_qperp(ipoint)==1)
6736 call mt_write_vti_payload_float64(vti_unit,visual_values,npoint, &
6738 deallocate(visual_values)
6739 end subroutine mt_write_vti_payload_logqperp_visual
6741 subroutine mt_check_vti_byte_count(npoint,caller)
6742 integer,
intent(in) :: npoint
6743 character(len=*),
intent(in) :: caller
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')
6748 end subroutine mt_check_vti_byte_count
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
6755 integer :: byte_count
6757 if (io_status/=0)
return
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
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
6768 integer :: byte_count
6770 if (io_status/=0)
return
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
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)
6784 integer :: vti_unit,io_status,npoint
6785 integer :: idesc,ndesc
6786 character(len=1) :: marker
6787 type(mt_vti_array_desc),
allocatable :: descs(:)
6790 call mt_check_vti_byte_count(npoint,caller)
6791 call mt_build_cartesian_vti_pointdata_descs(npoint,descs,ndesc)
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')
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
6803 call mpistop(trim(caller)//
' could not write VTI header')
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')
6815 write(vti_unit,iostat=io_status) marker
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, &
6823 call mt_write_vti_payload_float64(vti_unit,qperp,npoint,io_status)
6825 call mt_write_vti_payload_int32(vti_unit,status,npoint,io_status)
6831 if (io_status/=0)
then
6832 call mpistop(trim(caller)//
' could not write VTI payload')
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')
6840 write(vti_unit,
'(a)',iostat=io_status)
'</AppendedData>'
6841 if (io_status==0)
write(vti_unit,
'(a)',iostat=io_status)
'</VTKFile>'
6843 if (io_status/=0)
then
6844 call mpistop(trim(caller)//
' could not write VTI footer')
6847 end subroutine mt_write_vti_pointdata_fixed
6849 subroutine mt_write_vti_appended_array(vti_unit,vtk_type,name,offset, &
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
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
6871 subroutine mt_write_vtu_length_pointdata(vtu_unit,length_results,npoint, &
6873 integer,
intent(in) :: vtu_unit,npoint
6874 type(trace_length_result),
intent(in) :: length_results(npoint)
6875 integer,
intent(inout) :: io_status
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', &
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', &
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)
6894 call mt_write_vtu_int_array_start(vtu_unit,
'nstep_backward_length', &
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', &
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', &
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', &
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
6916 subroutine mt_write_vtu_mapping_pointdata(vtu_unit,mapping_results, &
6918 integer,
intent(in) :: vtu_unit,npoint
6919 type(trace_mapping_result),
intent(in) :: mapping_results(npoint)
6920 integer,
intent(inout) :: io_status
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)
6949 call mt_write_vtu_float_array_start(vtu_unit,
'source_Bn_mapping', &
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', &
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', &
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)
6965 call mt_write_vtu_int_array_start(vtu_unit,
'face_forward_mapping', &
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', &
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', &
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', &
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
6991 subroutine mt_write_vtu_qperp_public_pointdata(vtu_unit,qperp_results, &
6993 integer,
intent(in) :: vtu_unit,npoint
6994 type(trace_qperp_result),
intent(in) :: qperp_results(npoint)
6995 integer,
intent(inout) :: io_status
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
7014 subroutine mt_write_vtu_qperp_method2_pointdata(vtu_unit,qperp_results, &
7016 integer,
intent(in) :: vtu_unit,npoint
7017 type(trace_qperp_result),
intent(in) :: qperp_results(npoint)
7018 integer,
intent(inout) :: io_status
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', &
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', &
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', &
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)
7050 call mt_write_vtu_float_array_start(vtu_unit,
'Bseed_norm_qperp', &
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)
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)
7089 call mt_write_vtu_int_array_start(vtu_unit,
'valid_qperp_method2', &
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', &
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', &
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', &
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', &
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', &
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
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
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)
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', &
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
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
7172 write(vtu_unit,
'(a)',iostat=io_status)
'<PointData>'
7173 if (io_status/=0)
return
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, &
7179 if (io_status==0)
write(vtu_unit,
'(a)',iostat=io_status) &
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', &
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', &
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)
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', &
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', &
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)
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)
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)
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), &
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), &
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), &
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), &
7286 call mt_write_vtu_data_array_end(vtu_unit,io_status)
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', &
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), &
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)
7324 if (io_status==0)
write(vtu_unit,
'(a)',iostat=io_status)
'</PointData>'
7325 end subroutine mt_write_vtu_spherical_topology_pointdata
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
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)
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)
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)
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)
7366 end subroutine mt_write_vtu_spherical_minimal_pointdata
7368 subroutine mt_write_vtu_file_header(vtu_unit,npoint,ncell)
7369 integer,
intent(in) :: vtu_unit,npoint,ncell
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
7379 subroutine mt_write_vtu_file_footer(vtu_unit,io_status)
7380 integer,
intent(in) :: vtu_unit
7381 integer,
intent(inout) :: io_status
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
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
7402 logical :: do_length_eff
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
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) &
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', &
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', &
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)
7434 call mt_write_vtu_int_array_start(vtu_unit,
'nstep_backward_length', &
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', &
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', &
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', &
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)
7457 call mt_write_vtu_twist_pointdata(vtu_unit,twist_results,npoint, &
7461 call mt_write_vtu_q_product_pointdata(vtu_unit,q_results,npoint, &
7465 call mt_write_vtu_qperp_pointdata(vtu_unit,qperp_results,npoint, &
7469 if (io_status==0)
write(vtu_unit,
'(a)',iostat=io_status)
'</PointData>'
7470 end subroutine mt_write_vtu_product_pointdata
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
7485 logical :: do_length_eff
7487 do_length_eff=.true.
7488 if (
present(do_length)) do_length_eff=do_length
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), &
7495 call mt_write_vtu_data_array_end(vtu_unit,io_status)
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))', &
7502 (mt_visual_float(twist_results(ipoint)%total_twist), &
7504 call mt_write_vtu_data_array_end(vtu_unit,io_status)
7508 call mt_write_vtu_float_array_start(vtu_unit,
'logQ',io_status)
7509 if (io_status==0)
write(vtu_unit,
'(4(1pe24.16))', &
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)
7517 call mt_write_vtu_float_array_start(vtu_unit,
'logQperp',io_status)
7518 if (io_status==0)
write(vtu_unit,
'(4(1pe24.16))', &
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)
7524 end subroutine mt_write_vtu_product_minimal_pointdata
7526 subroutine mt_write_vtu_twist_pointdata(vtu_unit,twist_results,npoint, &
7528 integer,
intent(in) :: vtu_unit,npoint
7529 type(trace_twist_result),
intent(in) :: twist_results(npoint)
7530 integer,
intent(inout) :: io_status
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', &
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', &
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)
7549 call mt_write_vtu_int_array_start(vtu_unit,
'nstep_backward_twist', &
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', &
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', &
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', &
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
7571 subroutine mt_write_vtu_qperp_pointdata(vtu_unit,qperp_results,npoint, &
7573 integer,
intent(in) :: vtu_unit,npoint
7574 type(trace_qperp_result),
intent(in) :: qperp_results(npoint)
7575 integer,
intent(inout) :: io_status
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', &
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', &
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)
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)
7619 call mt_write_vtu_qperp_endpoint_pointdata(vtu_unit,qperp_results, &
7621 call mt_write_vtu_qperp_int_pointdata(vtu_unit,qperp_results,npoint, &
7623 end subroutine mt_write_vtu_qperp_pointdata
7625 subroutine mt_write_vtu_qperp_endpoint_pointdata(vtu_unit,qperp_results, &
7627 integer,
intent(in) :: vtu_unit,npoint
7628 type(trace_qperp_result),
intent(in) :: qperp_results(npoint)
7629 integer,
intent(inout) :: io_status
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
7659 subroutine mt_write_vtu_qperp_int_pointdata(vtu_unit,qperp_results, &
7661 integer,
intent(in) :: vtu_unit,npoint
7662 type(trace_qperp_result),
intent(in) :: qperp_results(npoint)
7663 integer,
intent(inout) :: io_status
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', &
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', &
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', &
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', &
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
7697 subroutine mt_write_vtu_empty_pointdata(vtu_unit,do_length,do_twist, &
7699 integer,
intent(in) :: vtu_unit
7700 logical,
intent(in) :: do_length,do_twist,do_q,do_qperp
7702 write(vtu_unit,
'(a)')
'<PointData>'
7703 if (.not.mt_vtk_detail_is_full())
then
7705 call mt_write_vtu_empty_float_array(vtu_unit,
'length_total')
7708 call mt_write_vtu_empty_float_array(vtu_unit,
'twist_total')
7711 call mt_write_vtu_empty_float_array(vtu_unit,
'logQ')
7714 call mt_write_vtu_empty_float_array(vtu_unit,
'logQperp')
7716 write(vtu_unit,
'(a)')
'</PointData>'
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')
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')
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')
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')
7777 write(vtu_unit,
'(a)')
'</PointData>'
7778 end subroutine mt_write_vtu_empty_pointdata
7780 subroutine mt_write_vtu_empty_float_array(vtu_unit,name)
7781 integer,
intent(in) :: vtu_unit
7782 character(len=*),
intent(in) :: name
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
7789 subroutine mt_write_vtu_empty_int_array(vtu_unit,name)
7790 integer,
intent(in) :: vtu_unit
7791 character(len=*),
intent(in) :: name
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
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
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
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
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
7818 subroutine mt_write_vtu_data_array_end(vtu_unit,io_status)
7819 integer,
intent(in) :: vtu_unit
7820 integer,
intent(inout) :: io_status
7822 if (io_status/=0)
return
7823 write(vtu_unit,
'(a)',iostat=io_status)
'</DataArray>'
7824 end subroutine mt_write_vtu_data_array_end
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
7831 double precision :: seed_xyz(3)
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">'
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
7844 if (io_status==0)
write(vtu_unit,
'(a)',iostat=io_status) &
7846 if (io_status==0)
write(vtu_unit,
'(a)',iostat=io_status)
'</Points>'
7847 end subroutine mt_write_vtu_points
7849 subroutine mt_write_vtu_topology_points(vtu_unit,topology,npoint, &
7851 integer,
intent(in) :: vtu_unit,npoint
7852 type(trace_topology_result),
intent(in) :: topology(npoint)
7853 integer,
intent(inout) :: io_status
7855 double precision :: seed_xyz(3)
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">'
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
7868 if (io_status==0)
write(vtu_unit,
'(a)',iostat=io_status) &
7870 if (io_status==0)
write(vtu_unit,
'(a)',iostat=io_status)
'</Points>'
7871 end subroutine mt_write_vtu_topology_points
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)
7877 double precision :: r,theta,phi,sin_theta
7880 if (geo_coordinate==geo_spherical .and. ndim==3)
then
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)
7891 point_xyz(1)=mt_vc(coord,1)
7892 point_xyz(2)=mt_vc(coord,2)
7893 point_xyz(3)=mt_vc(coord,3)
7895 end subroutine mt_vtu_point_from_coord
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
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) &
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) &
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) &
7920 if (io_status==0)
write(vtu_unit,
'(a)',iostat=io_status) &
7922 if (io_status==0)
write(vtu_unit,
'(a)',iostat=io_status)
'</Cells>'
7923 end subroutine mt_write_vtu_vertex_cells
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
7929 integer :: i,j,icell,p,ncell
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">'
7938 if (io_status==0)
write(vtu_unit,
'(4(i0,1x))',iostat=io_status) &
7942 if (io_status==0)
write(vtu_unit,
'(a)',iostat=io_status) &
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) &
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) &
7954 if (io_status==0)
write(vtu_unit,
'(a)',iostat=io_status) &
7956 if (io_status==0)
write(vtu_unit,
'(a)',iostat=io_status)
'</Cells>'
7957 end subroutine mt_write_vtu_quad_cells
7959 subroutine mt_write_vtu_cells_empty(vtu_unit,io_status)
7960 integer,
intent(in) :: vtu_unit
7961 integer,
intent(inout) :: io_status
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) &
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) &
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) &
7976 if (io_status==0)
write(vtu_unit,
'(a)',iostat=io_status)
'</Cells>'
7977 end subroutine mt_write_vtu_cells_empty
7979 subroutine mt_write_twist_plane_csv(results,n1,n2,csv_file,caller, &
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
7985 double precision :: seed_xyz(3)
7986 integer :: csv_unit,io_status,i,j,iseed
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')
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
8002 call mpistop(trim(caller)//
' could not write CSV header')
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
8024 call mpistop(trim(caller)//
' could not write CSV data')
8030 end subroutine mt_write_twist_plane_csv
8032 subroutine mt_write_q_plane_csv(results,n1,n2,csv_file,caller, &
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
8038 integer :: csv_unit,io_status,i,j,iseed
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')
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
8055 call mpistop(trim(caller)//
' could not write CSV header')
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
8074 call mpistop(trim(caller)//
' could not write CSV data')
8080 end subroutine mt_write_q_plane_csv
8082 subroutine mt_write_qperp_plane_csv(results,n1,n2,csv_file,caller, &
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
8088 double precision :: bseed_norm,bf_norm,bb_norm
8089 integer :: csv_unit,io_status,i,j,iseed
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')
8097 write(csv_unit,
'(a)',iostat=io_status) &
8098 trim(index_header)//
',seed_x,seed_y,seed_z,'// &
8099 'qperp,logqperp,valid,status,'// &
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
8108 call mpistop(trim(caller)//
' could not write CSV header')
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))
8118 '(i0,",",i0,5(",",es24.16),",",l1,",",i0,'// &
8119 '2(",",es24.16),4(",",i0),11(",",es24.16))', &
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
8133 call mpistop(trim(caller)//
' could not write CSV data')
8139 end subroutine mt_write_qperp_plane_csv
8141 subroutine mt_write_qperp_arbitrary_header(csv_file,caller)
8142 character(len=*),
intent(in) :: csv_file,caller
8144 integer :: csv_unit,io_status
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')
8152 write(csv_unit,
'(a)',iostat=io_status) &
8153 'i,j,s1,s2,seed_x,seed_y,seed_z,'// &
8154 'qperp,logqperp,valid,status,'// &
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
8163 call mpistop(trim(caller)//
' could not write CSV header')
8167 end subroutine mt_write_qperp_arbitrary_header
8169 subroutine mt_write_qperp_arbitrary_csv(results,s1,s2,n1,n2,csv_file, &
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
8176 double precision :: bseed_norm,bf_norm,bb_norm
8177 integer :: csv_unit,io_status,i,j,iseed
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')
8185 write(csv_unit,
'(a)',iostat=io_status) &
8186 'i,j,s1,s2,seed_x,seed_y,seed_z,'// &
8187 'qperp,logqperp,valid,status,'// &
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
8196 call mpistop(trim(caller)//
' could not write CSV header')
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))
8206 '(i0,",",i0,7(",",es24.16),",",l1,",",i0,'// &
8207 '2(",",es24.16),4(",",i0),11(",",es24.16))', &
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
8221 call mpistop(trim(caller)//
' could not write CSV data')
8227 end subroutine mt_write_qperp_arbitrary_csv
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
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
8238 subroutine mt_write_mapping_plane_csv(results,n1,n2,csv_file,caller, &
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
8244 integer :: csv_unit,io_status,i,j,iseed
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')
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
8264 call mpistop(trim(caller)//
' could not write CSV header')
8271 '(i0,",",i0,14(",",es24.16),",",i0,",",es24.16,'// &
8272 '",",i0,7(",",es24.16),",",i0,",",es24.16,'// &
8273 '",",i0,",",l1)',iostat=io_status) &
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
8290 call mpistop(trim(caller)//
' could not write CSV data')
8296 end subroutine mt_write_mapping_plane_csv
8298 integer function mt_q_result_face_pair(qperp_result)
result(face_pair)
8299 type(trace_qperp_result),
intent(in) :: qperp_result
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
8307 integer function mt_q_result_connection_type(qperp_result) &
8308 result(connection_type)
8309 type(trace_qperp_result),
intent(in) :: qperp_result
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
8317 integer function mt_q_face_pair_from_faces(face_b,face_f)
result(face_pair)
8318 integer,
intent(in) :: face_b,face_f
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
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
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
8335 else if (face_b==trace_face_zmax .and. face_f==trace_face_zmax)
then
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
8340 else if (face_b==face_f)
then
8345 end function mt_q_connection_type_from_faces
8347 logical function mt_q_face_valid(face)
8348 integer,
intent(in) :: face
8350 mt_q_face_valid=face>=trace_face_xmin .and. face<=trace_face_zmax
8351 end function mt_q_face_valid
subroutine, public mpistop(message)
Exit MPI-AMRVAC with an error message.
Module with geometry-related routines (e.g., divergence, curl)
integer, parameter spherical
integer, parameter cartesian
integer, parameter cartesian_stretched
This module contains definitions of global parameters and variables and some generic functions/subrou...
integer, parameter unitpar
file handle for IO
integer, parameter ndim
Number of spatial dimensions for grid variables.
double precision, dimension(:), allocatable, parameter d
integer npe
The number of MPI tasks.
logical, dimension(ndim) periodb
True for dimensions with periodic boundaries.
logical slab_uniform
uniform Cartesian geometry or not (stretched Cartesian)
subroutine, public mt_write_cartesian_vti_pointdata(vti_file, xmin, xmax, nx, ymin, ymax, ny, zmin, zmax, nz, length_total, qperp, status)
subroutine, public mt_fieldline_products_plane_arbitrary(origin, e1, e2, s1min, s1max, n1, s2min, s2max, n2, dl, max_steps, csv_file, b_min, compute_length, compute_twist, compute_q, compute_qperp, vtu_file, write_csv)
subroutine, public mt_twist_plane_yz(ymin, ymax, ny, zmin, zmax, nz, x0, dl, max_steps, csv_file, b_min)
subroutine, public mt_topology_plane_xy(xmin, xmax, nx, ymin, ymax, ny, z0, dl, max_steps, length_csv, twist_csv, mapping_csv, b_min)
subroutine, public mt_qsl_plane_vtu_yz(ymin, ymax, ny, zmin, zmax, nz, x0, dl, max_steps, vtu_file, b_min)
subroutine, public mt_qperp_plane_xz(xmin, xmax, nx, zmin, zmax, nz, y0, dl, max_steps, csv_file, b_min)
subroutine, public mt_qsl_plane_vtu_xy(xmin, xmax, nx, ymin, ymax, ny, z0, dl, max_steps, vtu_file, b_min)
subroutine, public mt_twist_plane_xz(xmin, xmax, nx, zmin, zmax, nz, y0, dl, max_steps, csv_file, b_min)
subroutine, public mt_length_plane_xy(xmin, xmax, nx, ymin, ymax, ny, z0, dl, max_steps, csv_file, b_min)
subroutine, public mt_fieldline_products_seeds(seeds, nseed, dl, max_steps, csv_file, b_min, compute_length, compute_twist, compute_q, compute_qperp, vtu_file)
subroutine, public mt_length_seeds(seeds, nseed, dl, max_steps, csv_file, b_min)
subroutine, public mt_topology_plane_yz(ymin, ymax, ny, zmin, zmax, nz, x0, dl, max_steps, length_csv, twist_csv, mapping_csv, b_min)
subroutine, public mt_qperp_plane_yz(ymin, ymax, ny, zmin, zmax, nz, x0, dl, max_steps, csv_file, b_min)
subroutine, public mt_qperp_plane_arbitrary(origin, e1, e2, s1min, s1max, n1, s2min, s2max, n2, dl, max_steps, csv_file, b_min)
subroutine, public mt_qperp_plane_xy(xmin, xmax, nx, ymin, ymax, ny, z0, dl, max_steps, csv_file, b_min)
subroutine, public mt_length_plane_xz(xmin, xmax, nx, zmin, zmax, nz, y0, dl, max_steps, csv_file, b_min)
subroutine, public mt_length_single(seed, dl, max_steps, csv_file, b_min)
subroutine, public mt_fieldline_products_volume_vti(xmin, xmax, nx, ymin, ymax, ny, zmin, zmax, nz, dl, max_steps, vti_file, b_min, compute_length, compute_twist, compute_q, compute_qperp, chunk_nz)
subroutine, public mt_qsl_plane_vtu_xz(xmin, xmax, nx, zmin, zmax, nz, y0, dl, max_steps, vtu_file, b_min)
subroutine, public mt_twist_plane_xy(xmin, xmax, nx, ymin, ymax, ny, z0, dl, max_steps, csv_file, b_min)
subroutine, public mt_params_read(files)
subroutine, public mt_topology_plane_xz(xmin, xmax, nx, zmin, zmax, nz, y0, dl, max_steps, length_csv, twist_csv, mapping_csv, b_min)
subroutine, public mt_mapping_plane_xy(xmin, xmax, nx, ymin, ymax, ny, z0, dl, max_steps, csv_file, b_min)
subroutine, public mt_twist_seeds(seeds, nseed, dl, max_steps, csv_file, b_min)
subroutine, public mt_length_plane_yz(ymin, ymax, ny, zmin, zmax, nz, x0, dl, max_steps, csv_file, b_min)
subroutine, public mt_run_topology_task()
subroutine, public mt_twist_single(seed, dl, max_steps, csv_file, b_min)
integer, parameter, public trace_face_ymin
integer, parameter, public trace_face_zmax
subroutine, public trace_spherical_profile_set(enabled)
subroutine, public trace_rk45_stats_reset()
subroutine, public trace_field_twist_multi(seeds, nseed, dl, max_steps, results, b_min)
subroutine, public trace_field_rk2_short_boundary_q_multi(seeds, nseed, dl, max_steps, results, b_min, twist_results)
subroutine, public trace_cartesian_global_min_cell_size(hmin, status)
subroutine, public trace_spherical_curl_cache_clear()
subroutine, public trace_field_qperp_multi(seeds, nseed, dl, max_steps, results, b_min, twist_results)
subroutine, public trace_field_spherical_rmin_q_multi(seeds, nseed, dl, max_steps, results, b_min, twist_results)
subroutine, public trace_rk45_stats_report(label)
subroutine, public trace_field_topology_multi(seeds, nseed, dl, max_steps, results, need_twist, need_mapping, b_min, source_normal)
integer, parameter, public trace_face_xmax
subroutine, public trace_field_twist_single(seed, dl, max_steps, result, b_min)
subroutine, public trace_field_mapping_single(seed, dl, max_steps, result, b_min, source_normal)
integer, parameter, public trace_face_none
integer, parameter, public trace_status_boundary
subroutine, public trace_spherical_profile_report(label)
integer, parameter, public trace_face_ambiguous
subroutine, public trace_field_qperp_single(seed, dl, max_steps, result, b_min)
integer, parameter, public trace_face_zmin
integer, parameter, public trace_status_unsupported_geometry
subroutine, public trace_set_step_control(mode, step_fraction, step_min)
subroutine, public trace_debug_cartesian_rk45_tangent_q0_multi(seeds, nseed, dl, max_steps, results, b_min)
integer, parameter, public trace_face_ymax
subroutine, public trace_spherical_global_min_cell_size(hmin, status)
subroutine, public trace_rk2_stats_reset()
subroutine, public trace_spherical_curl_cache_build(status)
subroutine, public trace_spherical_profile_count_seeds(nseed)
subroutine, public trace_spherical_profile_reset()
subroutine, public trace_field_spherical_rmin_q_qperp_multi(seeds, nseed, dl, max_steps, q_results, qperp_results, b_min, twist_results)
subroutine, public trace_field_length_multi(seeds, nseed, dl, max_steps, results, b_min)
subroutine, public trace_rk45_stats_set_enabled(enabled)
subroutine, public trace_set_integrator(mode, atol, rtol, safety, min_shrink, max_grow, tangent_floor, tangent_rtol)
subroutine, public trace_rk2_stats_set_enabled(enabled)
subroutine, public trace_field_spherical_qperp_multi(seeds, nseed, dl, max_steps, results, b_min, twist_results)
subroutine, public trace_rk2_stats_report(label)
subroutine, public trace_field_length_single(seed, dl, max_steps, result, b_min)
integer, parameter, public trace_face_xmin
subroutine, public trace_field_mapping_multi(seeds, nseed, dl, max_steps, results, b_min, source_normal)
integer, parameter, public trace_status_active