2 use,
intrinsic :: ieee_arithmetic, only: ieee_value,ieee_quiet_nan, &
66 integer,
parameter :: mt_vti_kind_float64 = 1
67 integer,
parameter :: mt_vti_kind_int32 = 2
68 integer,
parameter :: mt_vti_name_len = 64
69 integer,
parameter :: mt_task_name_len = 128
70 double precision,
parameter :: mt_unset_real = huge(1.d0)
72 character(len=mt_task_name_len) :: mt_mode =
''
73 character(len=mt_task_name_len) :: mt_output_file =
''
74 character(len=mt_task_name_len) :: mt_output_prefix =
''
75 character(len=mt_task_name_len) :: mt_seed_file =
''
76 character(len=mt_task_name_len) :: mt_seed_surface =
''
77 character(len=mt_task_name_len) :: mt_seed_layout =
'endpoint'
78 character(len=mt_task_name_len) :: mt_vtk_detail =
'minimal'
79 character(len=mt_task_name_len) :: mt_step_control =
'global_cell_fraction'
80 character(len=mt_task_name_len) :: mt_trace_integrator =
'rk2'
81 double precision :: mt_dL = -1.d0
82 double precision :: mt_step_fraction = 0.25d0
83 double precision :: mt_dL_min = 0.d0
84 double precision :: mt_rk45_atol = 1.
d-8
85 double precision :: mt_rk45_rtol = 1.
d-6
86 double precision :: mt_rk45_safety = 0.9d0
87 double precision :: mt_rk45_min_shrink = 0.2d0
88 double precision :: mt_rk45_max_grow = 5.d0
89 double precision :: mt_rk45_tangent_floor = 1.d0
90 double precision :: mt_rk45_tangent_rtol = 2.
d-5
91 integer :: mt_max_steps = -1
92 double precision :: mt_max_steps_factor = 2.d0
93 double precision :: mt_b_min = -1.d0
94 double precision :: mt_seed_coord = mt_unset_real
95 double precision :: mt_seed_theta0 = mt_unset_real
96 double precision :: mt_seed_phi0 = mt_unset_real
97 double precision :: mt_seed_alpha = mt_unset_real
98 logical :: mt_compute_length = .true.
99 logical :: mt_compute_twist = .false.
100 logical :: mt_compute_q = .false.
101 logical :: mt_compute_qperp = .false.
102 logical :: mt_rk2_step_diagnostic = .false.
103 logical :: mt_rk45_step_diagnostic = .false.
104 logical :: mt_rk45_tangent_diagnostic = .false.
105 logical :: mt_rk2_fusion_diagnostic = .false.
106 logical :: mt_write_csv = .false.
107 character(len=mt_task_name_len) :: mt_plane =
''
108 double precision :: mt_origin(3) = mt_unset_real
109 double precision :: mt_e1(3) = mt_unset_real
110 double precision :: mt_e2(3) = mt_unset_real
111 double precision :: mt_xmin = mt_unset_real
112 double precision :: mt_xmax = mt_unset_real
113 double precision :: mt_ymin = mt_unset_real
114 double precision :: mt_ymax = mt_unset_real
115 double precision :: mt_zmin = mt_unset_real
116 double precision :: mt_zmax = mt_unset_real
117 double precision :: mt_x0 = mt_unset_real
118 double precision :: mt_y0 = mt_unset_real
119 double precision :: mt_z0 = mt_unset_real
120 integer :: mt_nx = -1
121 integer :: mt_ny = -1
122 integer :: mt_nz = -1
123 double precision :: mt_s1min = mt_unset_real
124 double precision :: mt_s1max = mt_unset_real
125 double precision :: mt_s2min = mt_unset_real
126 double precision :: mt_s2max = mt_unset_real
127 double precision :: mt_s3min = mt_unset_real
128 double precision :: mt_s3max = mt_unset_real
129 integer :: mt_n1 = -1
130 integer :: mt_n2 = -1
131 integer :: mt_n3 = -1
132 integer :: mt_chunk_nz = -1
133 logical :: mt_profile_spherical = .false.
134 logical :: mt_params_loaded = .false.
136 type,
private :: mt_vti_array_desc
137 character(len=mt_vti_name_len) :: name
139 integer(kind=8) :: nbytes
140 integer(kind=8) :: offset
141 end type mt_vti_array_desc
143 type,
private :: mt_volume_products
144 double precision,
allocatable :: length_total(:)
145 double precision,
allocatable :: length_backward(:)
146 double precision,
allocatable :: length_forward(:)
147 integer,
allocatable :: nstep_backward_length(:)
148 integer,
allocatable :: nstep_forward_length(:)
149 integer,
allocatable :: status_backward_length(:)
150 integer,
allocatable :: status_forward_length(:)
151 double precision,
allocatable :: twist_total(:)
152 double precision,
allocatable :: twist_backward(:)
153 double precision,
allocatable :: twist_forward(:)
154 integer,
allocatable :: nstep_backward_twist(:)
155 integer,
allocatable :: nstep_forward_twist(:)
156 integer,
allocatable :: status_backward_twist(:)
157 integer,
allocatable :: status_forward_twist(:)
158 double precision,
allocatable :: q(:)
159 double precision,
allocatable :: logq(:)
160 double precision,
allocatable :: N2_q(:)
161 double precision,
allocatable :: bfactor_q(:)
162 double precision,
allocatable :: length_forward_q(:)
163 double precision,
allocatable :: length_backward_q(:)
164 double precision,
allocatable :: Bseed_norm_q(:)
165 double precision,
allocatable :: Bf_norm_q(:)
166 double precision,
allocatable :: Bb_norm_q(:)
167 integer,
allocatable :: valid_q(:)
168 integer,
allocatable :: status_q(:)
169 integer,
allocatable :: face_forward_q(:)
170 integer,
allocatable :: face_backward_q(:)
171 integer,
allocatable :: status_forward_q(:)
172 integer,
allocatable :: status_backward_q(:)
173 double precision,
allocatable :: qperp(:)
174 double precision,
allocatable :: logqperp(:)
175 double precision,
allocatable :: N2(:)
176 double precision,
allocatable :: bfactor(:)
177 double precision,
allocatable :: length_forward_qperp(:)
178 double precision,
allocatable :: length_backward_qperp(:)
179 double precision,
allocatable :: Bseed_norm(:)
180 double precision,
allocatable :: Bf_norm(:)
181 double precision,
allocatable :: Bb_norm(:)
182 integer,
allocatable :: valid_qperp(:)
183 integer,
allocatable :: status_qperp(:)
184 integer,
allocatable :: face_forward_qperp(:)
185 integer,
allocatable :: face_backward_qperp(:)
186 integer,
allocatable :: status_forward_qperp(:)
187 integer,
allocatable :: status_backward_qperp(:)
188 end type mt_volume_products
195 character(len=*),
intent(in) :: files(:)
199 namelist /magnetic_topology_list/ mt_mode,mt_output_file, &
200 mt_output_prefix,mt_seed_file,mt_vtk_detail, &
201 mt_seed_surface,mt_seed_layout,mt_seed_coord, &
202 mt_seed_theta0,mt_seed_phi0,mt_seed_alpha, &
203 mt_step_control,mt_dl,mt_step_fraction,mt_dl_min, &
204 mt_trace_integrator,mt_rk45_atol,mt_rk45_rtol, &
205 mt_rk45_safety,mt_rk45_min_shrink,mt_rk45_max_grow, &
206 mt_rk45_tangent_floor,mt_rk45_tangent_rtol, &
207 mt_max_steps,mt_max_steps_factor,mt_b_min, &
208 mt_compute_length,mt_compute_twist,mt_compute_q,mt_compute_qperp, &
209 mt_rk2_step_diagnostic,mt_rk45_step_diagnostic, &
210 mt_rk45_tangent_diagnostic,mt_rk2_fusion_diagnostic, &
211 mt_write_csv,mt_plane, &
212 mt_origin,mt_e1,mt_e2,mt_xmin,mt_xmax,mt_ymin,mt_ymax, &
213 mt_zmin,mt_zmax,mt_nx,mt_ny,mt_nz,mt_x0,mt_y0,mt_z0, &
214 mt_s1min,mt_s1max,mt_n1,mt_s2min,mt_s2max,mt_n2, &
215 mt_s3min,mt_s3max,mt_n3, &
216 mt_chunk_nz,mt_profile_spherical
218 call mt_set_default_params()
220 open(
unitpar,file=trim(files(n)),status=
'old')
221 read(
unitpar,magnetic_topology_list,
end=111)
224 mt_params_loaded=.true.
232 character(len=mt_task_name_len) :: mode
233 logical :: report_rk2,report_rk45
236 'magnetic-topology conversion requires npe=1; use OpenMP threads')
238 call getbc(global_time,0.d0,ps,iwstart,nwgc)
240 mode=mt_lowercase(trim(mt_mode))
241 call mt_validate_common_params(mode)
242 call mt_validate_trace_integrator(mode)
243 call mt_apply_trace_step_control()
244 call mt_apply_auto_max_steps()
245 call trace_set_integrator(mt_trace_integrator,mt_rk45_atol, &
246 mt_rk45_rtol,mt_rk45_safety,mt_rk45_min_shrink, &
247 mt_rk45_max_grow,mt_rk45_tangent_floor,mt_rk45_tangent_rtol)
248 report_rk2=mt_lowercase(trim(mt_trace_integrator))==
'rk2' .and. &
249 mt_rk2_step_diagnostic
250 report_rk45=(mt_lowercase(trim(mt_trace_integrator))==
'rk45_cartesian' &
251 .or. mt_lowercase(trim(mt_trace_integrator))==
'rk45_spherical') &
252 .and. mt_rk45_step_diagnostic
253 call trace_rk2_stats_set_enabled(report_rk2)
254 call trace_rk45_stats_set_enabled(report_rk45)
255 if (report_rk2)
call trace_rk2_stats_reset()
256 if (report_rk45)
call trace_rk45_stats_reset()
257 if (mt_profile_spherical .and. &
258 trim(mode)/=
'spherical_surface_products' .and. &
259 trim(mode)/=
'spherical_cloud_products')
then
260 write(*,
'(a)')
'mt_run_topology_task: mt_profile_spherical applies '// &
261 'only to spherical topology modes'
264 select case (trim(mode))
265 case (
'axis_plane_full_vtu')
266 call mt_run_axis_plane_full_vtu_task()
268 call mt_run_volume_vti_task()
269 case (
'arbitrary_plane_products')
270 call mt_run_arbitrary_plane_products_task()
271 case (
'seed_products')
272 call mt_run_seed_products_task()
273 case (
'axis_plane_csv')
274 call mt_run_axis_plane_csv_task()
275 case (
'spherical_surface_products')
276 call mt_run_spherical_surface_products_task()
277 case (
'spherical_cloud_products')
278 call mt_run_spherical_cloud_products_task()
280 call mpistop(
'mt_run_topology_task: unknown mt_mode='//trim(mt_mode))
282 if (report_rk2)
call trace_rk2_stats_report(trim(mode))
283 call trace_rk2_stats_set_enabled(.false.)
284 if (report_rk45)
call trace_rk45_stats_report(trim(mode))
285 call trace_rk45_stats_set_enabled(.false.)
288 subroutine mt_set_default_params()
289 mt_params_loaded=.false.
295 mt_seed_layout=
'endpoint'
296 mt_vtk_detail=
'minimal'
297 mt_step_control=
'global_cell_fraction'
298 mt_trace_integrator=
'rk2'
300 mt_step_fraction=0.25d0
305 mt_rk45_min_shrink=0.2d0
306 mt_rk45_max_grow=5.d0
307 mt_rk45_tangent_floor=1.d0
308 mt_rk45_tangent_rtol=2.d-5
310 mt_max_steps_factor=2.d0
312 mt_seed_coord=mt_unset_real
313 mt_seed_theta0=mt_unset_real
314 mt_seed_phi0=mt_unset_real
315 mt_seed_alpha=mt_unset_real
316 mt_compute_length=.true.
317 mt_compute_twist=.false.
319 mt_compute_qperp=.false.
320 mt_rk2_step_diagnostic=.false.
321 mt_rk45_step_diagnostic=.false.
322 mt_rk45_tangent_diagnostic=.false.
323 mt_rk2_fusion_diagnostic=.false.
326 mt_origin=mt_unset_real
329 mt_xmin=mt_unset_real
330 mt_xmax=mt_unset_real
331 mt_ymin=mt_unset_real
332 mt_ymax=mt_unset_real
333 mt_zmin=mt_unset_real
334 mt_zmax=mt_unset_real
341 mt_s1min=mt_unset_real
342 mt_s1max=mt_unset_real
343 mt_s2min=mt_unset_real
344 mt_s2max=mt_unset_real
345 mt_s3min=mt_unset_real
346 mt_s3max=mt_unset_real
351 mt_profile_spherical=.false.
352 end subroutine mt_set_default_params
354 subroutine mt_validate_periodic_phi()
355 if (.not.trace_periodic_phi_supported())
then
356 call mpistop(
'spherical periodic phi requires a full 2*pi longitude span')
358 end subroutine mt_validate_periodic_phi
360 subroutine mt_validate_common_params(mode)
361 character(len=*),
intent(in) :: mode
363 if (len_trim(mode)==0)
then
364 call mpistop(
'mt_run_topology_task requires mt_mode')
366 select case (trim(mode))
367 case (
'spherical_surface_products',
'spherical_cloud_products')
369 call mpistop(trim(mode)//
' requires 3D spherical geometry')
372 if (geo_coordinate/=geo_spherical)
then
373 call mpistop(trim(mode)//
' requires 3D spherical geometry')
375 call mt_validate_periodic_phi()
377 case (
'seed_products')
379 call mpistop(
'seed_products requires 3D Cartesian or spherical geometry')
382 select case (geo_coordinate)
383 case (geo_cartesian,geo_cartesian_stretched,geo_spherical)
385 call mpistop(
'seed_products requires Cartesian or spherical geometry')
387 call mt_validate_periodic_phi()
391 call mpistop(
'volume_vti requires 3D Cartesian geometry')
394 select case (geo_coordinate)
398 case (geo_cartesian_stretched)
402 call mpistop(
'volume_vti requires Cartesian geometry')
405 case (
'axis_plane_full_vtu',
'axis_plane_csv')
407 call mpistop(trim(mode)//
' requires 3D Cartesian geometry')
410 select case (geo_coordinate)
414 case (geo_cartesian_stretched)
416 call mpistop(trim(mode)//
' requires Cartesian geometry')
419 case (
'arbitrary_plane_products')
421 call mpistop(
'arbitrary_plane_products requires 3D Cartesian geometry')
424 select case (geo_coordinate)
425 case (geo_cartesian,geo_cartesian_stretched)
427 call mpistop(
'arbitrary_plane_products requires Cartesian geometry')
431 if (ndim/=3 .or. geo_coordinate/=geo_cartesian .or. &
432 .not.slab_uniform)
then
433 call mpistop(
'mt_run_topology_task mode requires 3D uniform Cartesian geometry')
436 if (len_trim(mt_output_file)==0 .and. &
437 len_trim(mt_output_prefix)==0)
then
438 call mpistop(
'mt_run_topology_task requires mt_output_file or mt_output_prefix')
440 select case (mt_lowercase(trim(mt_step_control)))
442 if (mt_dl<=0.d0)
then
443 call mpistop(
'mt_step_control=fixed requires mt_dL > 0')
445 case (
'cell_fraction')
446 select case (geo_coordinate)
447 case (geo_cartesian,geo_cartesian_stretched)
449 select case (trim(mode))
450 case (
'seed_products',
'spherical_surface_products', &
451 'spherical_cloud_products')
453 call mpistop(
'mt_step_control=cell_fraction is only supported '// &
454 'for spherical topology modes')
457 call mpistop(
'mt_step_control=cell_fraction requires Cartesian or '// &
458 'supported spherical geometry')
460 if (mt_step_fraction<=0.d0)
then
461 call mpistop(
'mt_step_control=cell_fraction requires '// &
462 'mt_step_fraction > 0')
464 if (mt_dl_min<0.d0)
then
465 call mpistop(
'mt_step_control=cell_fraction requires mt_dL_min >= 0')
467 case (
'global_cell_fraction')
468 if (mt_step_fraction<=0.d0)
then
469 call mpistop(
'mt_step_control=global_cell_fraction requires '// &
470 'mt_step_fraction > 0')
472 if (mt_dl_min<0.d0)
then
473 call mpistop(
'mt_step_control=global_cell_fraction requires mt_dL_min >= 0')
476 call mpistop(
'mt_run_topology_task requires mt_step_control=fixed '// &
477 'or cell_fraction/global_cell_fraction')
479 if (mt_max_steps<=0 .and. mt_max_steps_factor<=0.d0)
then
480 call mpistop(
'mt_max_steps auto requires mt_max_steps_factor > 0')
482 select case (mt_lowercase(trim(mt_vtk_detail)))
483 case (
'minimal',
'full')
485 call mpistop(
'mt_run_topology_task requires mt_vtk_detail=minimal or full')
487 end subroutine mt_validate_common_params
489 subroutine mt_validate_trace_integrator(mode)
490 character(len=*),
intent(in) :: mode
492 character(len=mt_task_name_len) :: integrator
494 integrator=mt_lowercase(trim(mt_trace_integrator))
495 select case (trim(integrator))
498 case (
'rk45_cartesian')
499 if (trim(mode)/=
'seed_products' .and. trim(mode)/=
'volume_vti' .and. &
500 trim(mode)/=
'arbitrary_plane_products' .and. &
501 trim(mode)/=
'axis_plane_full_vtu' .and. &
502 trim(mode)/=
'axis_plane_csv')
then
503 write(*,
'(a)')
'mt_trace_integrator=rk45_cartesian supports '// &
504 'only Cartesian seed_products, volume_vti, arbitrary_plane_products, '// &
505 'or axis-plane products'
507 call mpistop(
'mt_trace_integrator=rk45_cartesian supports '// &
508 'only seed_products, volume_vti, arbitrary_plane_products, '// &
509 'or axis-plane products')
512 call mpistop(
'mt_trace_integrator=rk45_cartesian requires 3D Cartesian geometry')
515 select case (geo_coordinate)
516 case (geo_cartesian,geo_cartesian_stretched)
518 write(*,
'(a)')
'mt_trace_integrator=rk45_cartesian is Cartesian-only'
520 call mpistop(
'mt_trace_integrator=rk45_cartesian is Cartesian-only')
523 if (mt_rk45_atol<0.d0 .or. mt_rk45_rtol<0.d0 .or. &
524 mt_rk45_atol+mt_rk45_rtol<=0.d0)
then
525 call mpistop(
'mt_trace_integrator=rk45_cartesian requires '// &
526 'non-negative tolerances with atol+rtol > 0')
528 if (mt_rk45_safety<=0.d0 .or. mt_rk45_safety>1.d0)
then
529 call mpistop(
'mt_rk45_safety must be in (0,1]')
531 if (mt_rk45_min_shrink<=0.d0 .or. mt_rk45_min_shrink>1.d0)
then
532 call mpistop(
'mt_rk45_min_shrink must be in (0,1]')
534 if (mt_rk45_max_grow<1.d0)
then
535 call mpistop(
'mt_rk45_max_grow must be >= 1')
537 if (mt_rk45_tangent_floor<=0.d0)
then
538 call mpistop(
'mt_rk45_tangent_floor must be > 0')
540 if (mt_rk45_tangent_rtol<=0.d0)
then
541 call mpistop(
'mt_rk45_tangent_rtol must be > 0')
543 case (
'rk45_spherical')
544 if (trim(mode)/=
'seed_products' .and. &
545 trim(mode)/=
'spherical_cloud_products' .and. &
546 trim(mode)/=
'spherical_surface_products')
then
547 write(*,
'(a)')
'mt_trace_integrator=rk45_spherical supports '// &
548 'only spherical seed_products, spherical_cloud_products, '// &
549 'or spherical_surface_products'
551 call mpistop(
'mt_trace_integrator=rk45_spherical supports '// &
552 'only seed_products, spherical_cloud_products, '// &
553 'or spherical_surface_products')
556 call mpistop(
'mt_trace_integrator=rk45_spherical requires 3D spherical geometry')
559 if (geo_coordinate/=geo_spherical)
then
560 write(*,
'(a)')
'mt_trace_integrator=rk45_spherical is spherical-only'
562 call mpistop(
'mt_trace_integrator=rk45_spherical is spherical-only')
564 call mt_validate_periodic_phi()
566 if (mt_compute_q)
then
568 if (geo_coordinate/=geo_spherical)
then
569 call mpistop(
'mt_trace_integrator=rk45_spherical standard '// &
570 'logQ currently requires spherical geometry')
574 if (mt_rk45_atol<0.d0 .or. mt_rk45_rtol<0.d0 .or. &
575 mt_rk45_atol+mt_rk45_rtol<=0.d0)
then
576 call mpistop(
'mt_trace_integrator=rk45_spherical requires '// &
577 'non-negative tolerances with atol+rtol > 0')
579 if (mt_rk45_safety<=0.d0 .or. mt_rk45_safety>1.d0)
then
580 call mpistop(
'mt_rk45_safety must be in (0,1]')
582 if (mt_rk45_min_shrink<=0.d0 .or. mt_rk45_min_shrink>1.d0)
then
583 call mpistop(
'mt_rk45_min_shrink must be in (0,1]')
585 if (mt_rk45_max_grow<1.d0)
then
586 call mpistop(
'mt_rk45_max_grow must be >= 1')
588 if (mt_rk45_tangent_floor<=0.d0)
then
589 call mpistop(
'mt_rk45_tangent_floor must be > 0')
591 if (mt_rk45_tangent_rtol<=0.d0)
then
592 call mpistop(
'mt_rk45_tangent_rtol must be > 0')
595 call mpistop(
'mt_trace_integrator must be rk2, rk45_cartesian, or rk45_spherical')
597 if (mt_rk45_tangent_diagnostic)
then
598 if (trim(mode)/=
'seed_products')
then
599 call mpistop(
'mt_rk45_tangent_diagnostic requires seed_products')
601 if (trim(integrator)/=
'rk45_cartesian')
then
602 call mpistop(
'mt_rk45_tangent_diagnostic requires '// &
603 'mt_trace_integrator=rk45_cartesian')
605 if (mt_compute_q .or. mt_compute_qperp)
then
606 call mpistop(
'mt_rk45_tangent_diagnostic is q0 diagnostic-only; '// &
607 'disable public Q and Qperp')
609 if (ndim/=3 .or. .not.slab_uniform)
then
610 call mpistop(
'mt_rk45_tangent_diagnostic requires 3D uniform Cartesian geometry')
613 if (geo_coordinate/=geo_cartesian)
then
614 call mpistop(
'mt_rk45_tangent_diagnostic requires Cartesian geometry')
618 if (mt_rk2_fusion_diagnostic)
then
619 if (trim(mode)/=
'seed_products')
then
620 call mpistop(
'mt_rk2_fusion_diagnostic requires seed_products')
622 if (trim(integrator)/=
'rk2')
then
623 call mpistop(
'mt_rk2_fusion_diagnostic requires '// &
624 'mt_trace_integrator=rk2')
626 if (.not.mt_compute_twist)
then
627 call mpistop(
'mt_rk2_fusion_diagnostic requires twist diagnostics')
629 if (mt_compute_q .or. mt_compute_qperp)
then
630 call mpistop(
'mt_rk2_fusion_diagnostic is q0 diagnostic-only; '// &
631 'disable public Q and Qperp')
634 end subroutine mt_validate_trace_integrator
636 subroutine mt_apply_trace_step_control()
637 character(len=mt_task_name_len) :: step_mode
638 double precision :: hmin,dl_eff,dl_cap
641 step_mode=mt_lowercase(trim(mt_step_control))
642 select case (trim(step_mode))
643 case (
'cell_fraction')
644 if ((geo_coordinate==geo_cartesian .or. &
645 geo_coordinate==geo_cartesian_stretched .or. &
646 geo_coordinate==geo_spherical) .and. mt_dl<=0.d0)
then
647 dl_cap=mt_domain_diagonal()
648 if (dl_cap<=0.d0)
then
649 call mpistop(
'mt_step_control=cell_fraction could not determine '// &
653 write(*,
'(a,es16.8,a,es16.8,a,es16.8)') &
654 'mt_step_control=cell_fraction: mt_step_fraction=', &
655 mt_step_fraction,
', automatic dL_cap=',mt_dl, &
656 ', mt_dL_min=',mt_dl_min
658 write(*,
'(a,es16.8,a,es16.8,a,es16.8)') &
659 'mt_step_control=cell_fraction: mt_step_fraction=', &
660 mt_step_fraction,
', mt_dL_cap=',mt_dl, &
661 ', mt_dL_min=',mt_dl_min
663 call trace_set_step_control(
'cell_fraction',mt_step_fraction,mt_dl_min)
664 case (
'global_cell_fraction')
665 select case (geo_coordinate)
666 case (geo_cartesian,geo_cartesian_stretched)
667 call trace_cartesian_global_min_cell_size(hmin,status)
669 call trace_spherical_global_min_cell_size(hmin,status)
671 status=trace_status_unsupported_geometry
674 if (status/=trace_status_active .or. hmin<=0.d0)
then
675 call mpistop(
'mt_step_control=global_cell_fraction could not determine h_global_min')
677 dl_eff=mt_step_fraction*hmin
678 if (mt_dl>0.d0) dl_eff=min(dl_eff,mt_dl)
679 if (mt_dl_min>0.d0)
then
681 dl_eff=max(dl_eff,min(mt_dl_min,mt_dl))
683 dl_eff=max(dl_eff,mt_dl_min)
686 if (dl_eff<=0.d0)
then
687 call mpistop(
'mt_step_control=global_cell_fraction produced non-positive mt_dL')
690 write(*,
'(a,es16.8,a,es16.8,a,es16.8,a,es16.8)') &
691 'mt_step_control=global_cell_fraction: h_global_min=',hmin, &
692 ', mt_step_fraction=',mt_step_fraction,
', mt_dL_cap=',mt_dl, &
693 ', effective_mt_dL=',dl_eff
695 write(*,
'(a,es16.8,a,es16.8,a,es16.8)') &
696 'mt_step_control=global_cell_fraction: h_global_min=',hmin, &
697 ', mt_step_fraction=',mt_step_fraction,
', effective_mt_dL=',dl_eff
700 call trace_set_step_control(
'fixed',mt_step_fraction,mt_dl_min)
702 call trace_set_step_control(
'fixed',mt_step_fraction,mt_dl_min)
704 end subroutine mt_apply_trace_step_control
706 subroutine mt_apply_auto_max_steps()
707 character(len=mt_task_name_len) :: step_mode
708 double precision :: hmin,step_est,ldiag,nsteps_real
711 if (mt_max_steps>0)
return
713 ldiag=mt_domain_diagonal()
714 if (ldiag<=0.d0)
then
715 call mpistop(
'mt_max_steps auto could not determine domain diagonal')
718 step_mode=mt_lowercase(trim(mt_step_control))
719 select case (trim(step_mode))
722 case (
'cell_fraction',
'global_cell_fraction')
723 select case (geo_coordinate)
724 case (geo_cartesian,geo_cartesian_stretched)
725 call trace_cartesian_global_min_cell_size(hmin,status)
727 call trace_spherical_global_min_cell_size(hmin,status)
729 status=trace_status_unsupported_geometry
732 if (status/=trace_status_active .or. hmin<=0.d0)
then
733 call mpistop(
'mt_max_steps auto could not determine h_global_min')
735 step_est=mt_step_fraction*hmin
736 if (mt_dl>0.d0) step_est=min(step_est,mt_dl)
741 if (step_est<=0.d0)
then
742 call mpistop(
'mt_max_steps auto produced non-positive step estimate')
744 nsteps_real=mt_max_steps_factor*ldiag/step_est
745 if (nsteps_real>dble(huge(mt_max_steps)-1))
then
746 call mpistop(
'mt_max_steps auto estimate exceeds integer range')
748 mt_max_steps=max(1,ceiling(nsteps_real))
749 write(*,
'(a,es16.8,a,es16.8,a,es16.8,a,es16.8,a,i0)') &
750 'mt_max_steps auto: Ldiag=',ldiag,
', step_est=',step_est, &
751 ', factor=',mt_max_steps_factor,
', nsteps_real=',nsteps_real, &
752 ', mt_max_steps=',mt_max_steps
753 end subroutine mt_apply_auto_max_steps
755 double precision function mt_domain_diagonal()
result(Ldiag)
757 double precision :: r,theta,phi,dist
758 double precision :: corners(8,3),dx(3)
760 ldiag=abs(xprobmax1-xprobmin1)
762 if (geo_coordinate==geo_spherical)
then
783 corners(n,1)=r*dsin(theta)*dcos(phi)
784 corners(n,2)=r*dsin(theta)*dsin(phi)
785 corners(n,3)=r*dcos(theta)
793 dx(m)=corners(i,m)-corners(j,m)
795 dist=dsqrt(sum(dx*dx))
796 ldiag=max(ldiag,dist)
800 ldiag=dsqrt((xprobmax1-xprobmin1)**2+ &
801 (xprobmax2-xprobmin2)**2+(xprobmax3-xprobmin3)**2)
804 end function mt_domain_diagonal
806 subroutine mt_run_axis_plane_full_vtu_task()
807 character(len=mt_task_name_len) :: plane
808 character(len=mt_task_name_len) :: output_file
809 logical :: minimal_output
811 plane=mt_lowercase(trim(mt_plane))
812 minimal_output=.not.mt_vtk_detail_is_full()
813 if (minimal_output)
then
814 call mt_resolve_output_file(
'axis_plane_full_vtu',
'.vti', &
815 '_'//trim(plane)//
'_minimal.vti',output_file)
817 call mt_resolve_output_file(
'axis_plane_full_vtu',
'.vtu', &
818 '_'//trim(plane)//
'_full.vtu',output_file)
820 if (.not.minimal_output .and. &
821 (mt_compute_twist .or. mt_compute_q .or. mt_compute_qperp))
then
822 write(*,
'(a)')
'mt_run_topology_task: axis_plane_full_vtu ignores compute flags'
823 write(*,
'(a)')
'mt_run_topology_task: it always writes full plane products'
826 select case (trim(plane))
828 call mt_require_real(
'mt_xmin',mt_xmin)
829 call mt_require_real(
'mt_xmax',mt_xmax)
830 call mt_require_real(
'mt_ymin',mt_ymin)
831 call mt_require_real(
'mt_ymax',mt_ymax)
832 call mt_require_real(
'mt_z0',mt_z0)
833 call mt_require_positive_int(
'mt_nx',mt_nx)
834 call mt_require_positive_int(
'mt_ny',mt_ny)
835 call mt_require_ordered(
'mt_xmin',
'mt_xmax',mt_xmin,mt_xmax)
836 call mt_require_ordered(
'mt_ymin',
'mt_ymax',mt_ymin,mt_ymax)
837 if (minimal_output)
then
838 write(*,
'(a)')
'mt_run_topology_task: writing axis-plane minimal VTI '//trim(output_file)
839 if (mt_b_min>0.d0)
then
840 call mt_qsl_plane_vti_xy(mt_xmin,mt_xmax,mt_nx,mt_ymin,mt_ymax, &
841 mt_ny,mt_z0,mt_dl,mt_max_steps,trim(output_file), &
842 mt_compute_length,mt_compute_twist,mt_compute_q, &
843 mt_compute_qperp,b_min=mt_b_min)
845 call mt_qsl_plane_vti_xy(mt_xmin,mt_xmax,mt_nx,mt_ymin,mt_ymax, &
846 mt_ny,mt_z0,mt_dl,mt_max_steps,trim(output_file), &
847 mt_compute_length,mt_compute_twist,mt_compute_q, &
851 write(*,
'(a)')
'mt_run_topology_task: writing axis-plane full VTU '//trim(output_file)
852 if (mt_b_min>0.d0)
then
854 mt_ny,mt_z0,mt_dl,mt_max_steps,trim(output_file), &
858 mt_ny,mt_z0,mt_dl,mt_max_steps,trim(output_file))
862 call mt_require_real(
'mt_xmin',mt_xmin)
863 call mt_require_real(
'mt_xmax',mt_xmax)
864 call mt_require_real(
'mt_zmin',mt_zmin)
865 call mt_require_real(
'mt_zmax',mt_zmax)
866 call mt_require_real(
'mt_y0',mt_y0)
867 call mt_require_positive_int(
'mt_nx',mt_nx)
868 call mt_require_positive_int(
'mt_nz',mt_nz)
869 call mt_require_ordered(
'mt_xmin',
'mt_xmax',mt_xmin,mt_xmax)
870 call mt_require_ordered(
'mt_zmin',
'mt_zmax',mt_zmin,mt_zmax)
871 if (minimal_output)
then
872 write(*,
'(a)')
'mt_run_topology_task: writing axis-plane minimal VTI '//trim(output_file)
873 if (mt_b_min>0.d0)
then
874 call mt_qsl_plane_vti_xz(mt_xmin,mt_xmax,mt_nx,mt_zmin,mt_zmax, &
875 mt_nz,mt_y0,mt_dl,mt_max_steps,trim(output_file), &
876 mt_compute_length,mt_compute_twist,mt_compute_q, &
877 mt_compute_qperp,b_min=mt_b_min)
879 call mt_qsl_plane_vti_xz(mt_xmin,mt_xmax,mt_nx,mt_zmin,mt_zmax, &
880 mt_nz,mt_y0,mt_dl,mt_max_steps,trim(output_file), &
881 mt_compute_length,mt_compute_twist,mt_compute_q, &
885 write(*,
'(a)')
'mt_run_topology_task: writing axis-plane full VTU '//trim(output_file)
886 if (mt_b_min>0.d0)
then
888 mt_nz,mt_y0,mt_dl,mt_max_steps,trim(output_file), &
892 mt_nz,mt_y0,mt_dl,mt_max_steps,trim(output_file))
896 call mt_require_real(
'mt_ymin',mt_ymin)
897 call mt_require_real(
'mt_ymax',mt_ymax)
898 call mt_require_real(
'mt_zmin',mt_zmin)
899 call mt_require_real(
'mt_zmax',mt_zmax)
900 call mt_require_real(
'mt_x0',mt_x0)
901 call mt_require_positive_int(
'mt_ny',mt_ny)
902 call mt_require_positive_int(
'mt_nz',mt_nz)
903 call mt_require_ordered(
'mt_ymin',
'mt_ymax',mt_ymin,mt_ymax)
904 call mt_require_ordered(
'mt_zmin',
'mt_zmax',mt_zmin,mt_zmax)
905 if (minimal_output)
then
906 write(*,
'(a)')
'mt_run_topology_task: writing axis-plane minimal VTI '//trim(output_file)
907 if (mt_b_min>0.d0)
then
908 call mt_qsl_plane_vti_yz(mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax, &
909 mt_nz,mt_x0,mt_dl,mt_max_steps,trim(output_file), &
910 mt_compute_length,mt_compute_twist,mt_compute_q, &
911 mt_compute_qperp,b_min=mt_b_min)
913 call mt_qsl_plane_vti_yz(mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax, &
914 mt_nz,mt_x0,mt_dl,mt_max_steps,trim(output_file), &
915 mt_compute_length,mt_compute_twist,mt_compute_q, &
919 write(*,
'(a)')
'mt_run_topology_task: writing axis-plane full VTU '//trim(output_file)
920 if (mt_b_min>0.d0)
then
922 mt_nz,mt_x0,mt_dl,mt_max_steps,trim(output_file), &
926 mt_nz,mt_x0,mt_dl,mt_max_steps,trim(output_file))
930 call mpistop(
'mt_run_topology_task: axis_plane_full_vtu requires mt_plane=xy, xz, or yz')
932 end subroutine mt_run_axis_plane_full_vtu_task
934 subroutine mt_run_axis_plane_csv_task()
935 character(len=mt_task_name_len) :: plane
936 character(len=mt_task_name_len) :: length_csv,twist_csv
937 character(len=mt_task_name_len) :: q_csv
938 character(len=mt_task_name_len) :: qperp_csv
940 if (len_trim(mt_output_prefix)==0)
then
941 call mpistop(
'axis_plane_csv requires mt_output_prefix')
943 if (len_trim(mt_output_file)>0)
then
944 write(*,
'(a)')
'mt_run_topology_task: axis_plane_csv ignores mt_output_file'
945 write(*,
'(a)')
'mt_run_topology_task: axis_plane_csv uses mt_output_prefix for CSV outputs'
948 plane=mt_lowercase(trim(mt_plane))
949 call mt_resolve_prefix_file(
'_'//trim(plane)//
'_length.csv', &
950 length_csv,
'axis_plane_csv length requires mt_output_prefix')
954 if (mt_compute_twist)
then
955 call mt_resolve_prefix_file(
'_'//trim(plane)//
'_twist.csv', &
956 twist_csv,
'axis_plane_csv twist requires mt_output_prefix')
958 if (mt_compute_q)
then
959 call mt_resolve_prefix_file(
'_'//trim(plane)//
'_q.csv', &
960 q_csv,
'axis_plane_csv Q requires mt_output_prefix')
962 if (mt_compute_qperp)
then
963 call mt_resolve_prefix_file(
'_'//trim(plane)//
'_qperp_method2.csv', &
964 qperp_csv,
'axis_plane_csv Qperp requires mt_output_prefix')
967 select case (trim(plane))
969 call mt_require_real(
'mt_xmin',mt_xmin)
970 call mt_require_real(
'mt_xmax',mt_xmax)
971 call mt_require_real(
'mt_ymin',mt_ymin)
972 call mt_require_real(
'mt_ymax',mt_ymax)
973 call mt_require_real(
'mt_z0',mt_z0)
974 call mt_require_positive_int(
'mt_nx',mt_nx)
975 call mt_require_positive_int(
'mt_ny',mt_ny)
976 call mt_require_ordered(
'mt_xmin',
'mt_xmax',mt_xmin,mt_xmax)
977 call mt_require_ordered(
'mt_ymin',
'mt_ymax',mt_ymin,mt_ymax)
978 if (mt_b_min>0.d0)
then
979 call mt_axis_plane_products_csv_axis(mt_xmin,mt_xmax,mt_nx, &
980 mt_ymin,mt_ymax,mt_ny,mt_z0,1,2,3,mt_dl,mt_max_steps, &
981 trim(length_csv),trim(twist_csv),trim(q_csv), &
982 trim(qperp_csv),
'mt_axis_plane_products_csv_xy',
'ix,iy', &
983 'ix,iy',b_min=mt_b_min)
985 call mt_axis_plane_products_csv_axis(mt_xmin,mt_xmax,mt_nx, &
986 mt_ymin,mt_ymax,mt_ny,mt_z0,1,2,3,mt_dl,mt_max_steps, &
987 trim(length_csv),trim(twist_csv),trim(q_csv), &
988 trim(qperp_csv),
'mt_axis_plane_products_csv_xy',
'ix,iy', &
992 call mt_require_real(
'mt_xmin',mt_xmin)
993 call mt_require_real(
'mt_xmax',mt_xmax)
994 call mt_require_real(
'mt_zmin',mt_zmin)
995 call mt_require_real(
'mt_zmax',mt_zmax)
996 call mt_require_real(
'mt_y0',mt_y0)
997 call mt_require_positive_int(
'mt_nx',mt_nx)
998 call mt_require_positive_int(
'mt_nz',mt_nz)
999 call mt_require_ordered(
'mt_xmin',
'mt_xmax',mt_xmin,mt_xmax)
1000 call mt_require_ordered(
'mt_zmin',
'mt_zmax',mt_zmin,mt_zmax)
1001 if (mt_b_min>0.d0)
then
1002 call mt_axis_plane_products_csv_axis(mt_xmin,mt_xmax,mt_nx, &
1003 mt_zmin,mt_zmax,mt_nz,mt_y0,1,3,2,mt_dl,mt_max_steps, &
1004 trim(length_csv),trim(twist_csv),trim(q_csv), &
1005 trim(qperp_csv),
'mt_axis_plane_products_csv_xz',
'ix,iz', &
1006 'i,j',b_min=mt_b_min)
1008 call mt_axis_plane_products_csv_axis(mt_xmin,mt_xmax,mt_nx, &
1009 mt_zmin,mt_zmax,mt_nz,mt_y0,1,3,2,mt_dl,mt_max_steps, &
1010 trim(length_csv),trim(twist_csv),trim(q_csv), &
1011 trim(qperp_csv),
'mt_axis_plane_products_csv_xz',
'ix,iz', &
1015 call mt_require_real(
'mt_ymin',mt_ymin)
1016 call mt_require_real(
'mt_ymax',mt_ymax)
1017 call mt_require_real(
'mt_zmin',mt_zmin)
1018 call mt_require_real(
'mt_zmax',mt_zmax)
1019 call mt_require_real(
'mt_x0',mt_x0)
1020 call mt_require_positive_int(
'mt_ny',mt_ny)
1021 call mt_require_positive_int(
'mt_nz',mt_nz)
1022 call mt_require_ordered(
'mt_ymin',
'mt_ymax',mt_ymin,mt_ymax)
1023 call mt_require_ordered(
'mt_zmin',
'mt_zmax',mt_zmin,mt_zmax)
1024 if (mt_b_min>0.d0)
then
1025 call mt_axis_plane_products_csv_axis(mt_ymin,mt_ymax,mt_ny, &
1026 mt_zmin,mt_zmax,mt_nz,mt_x0,2,3,1,mt_dl,mt_max_steps, &
1027 trim(length_csv),trim(twist_csv),trim(q_csv), &
1028 trim(qperp_csv),
'mt_axis_plane_products_csv_yz',
'iy,iz', &
1029 'i,j',b_min=mt_b_min)
1031 call mt_axis_plane_products_csv_axis(mt_ymin,mt_ymax,mt_ny, &
1032 mt_zmin,mt_zmax,mt_nz,mt_x0,2,3,1,mt_dl,mt_max_steps, &
1033 trim(length_csv),trim(twist_csv),trim(q_csv), &
1034 trim(qperp_csv),
'mt_axis_plane_products_csv_yz',
'iy,iz', &
1038 call mpistop(
'mt_run_topology_task: axis_plane_csv requires mt_plane=xy, xz, or yz')
1041 write(*,
'(a)')
'mt_run_topology_task: wrote axis-plane CSV length '// &
1043 if (mt_compute_twist)
write(*,
'(a)') &
1044 'mt_run_topology_task: wrote axis-plane CSV twist '//trim(twist_csv)
1045 if (mt_compute_q)
write(*,
'(a)') &
1046 'mt_run_topology_task: wrote axis-plane CSV Q '//trim(q_csv)
1047 if (mt_compute_qperp)
write(*,
'(a)') &
1048 'mt_run_topology_task: wrote axis-plane CSV Qperp '//trim(qperp_csv)
1049 end subroutine mt_run_axis_plane_csv_task
1051 subroutine mt_run_volume_vti_task()
1052 character(len=mt_task_name_len) :: output_file
1054 call mt_resolve_output_file(
'volume_vti',
'.vti',
'_volume.vti', &
1056 call mt_require_real(
'mt_xmin',mt_xmin)
1057 call mt_require_real(
'mt_xmax',mt_xmax)
1058 call mt_require_real(
'mt_ymin',mt_ymin)
1059 call mt_require_real(
'mt_ymax',mt_ymax)
1060 call mt_require_real(
'mt_zmin',mt_zmin)
1061 call mt_require_real(
'mt_zmax',mt_zmax)
1062 call mt_require_positive_int(
'mt_nx',mt_nx)
1063 call mt_require_positive_int(
'mt_ny',mt_ny)
1064 call mt_require_positive_int(
'mt_nz',mt_nz)
1065 call mt_require_ordered(
'mt_xmin',
'mt_xmax',mt_xmin,mt_xmax)
1066 call mt_require_ordered(
'mt_ymin',
'mt_ymax',mt_ymin,mt_ymax)
1067 call mt_require_ordered(
'mt_zmin',
'mt_zmax',mt_zmin,mt_zmax)
1068 write(*,
'(a)')
'mt_run_topology_task: writing volume VTI '//trim(output_file)
1069 if (mt_b_min>0.d0)
then
1070 if (mt_chunk_nz>0)
then
1072 mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax,mt_nz, &
1073 mt_dl,mt_max_steps,trim(output_file),b_min=mt_b_min, &
1074 compute_twist=mt_compute_twist, &
1075 compute_length=mt_compute_length, &
1076 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1077 chunk_nz=mt_chunk_nz)
1080 mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax,mt_nz, &
1081 mt_dl,mt_max_steps,trim(output_file),b_min=mt_b_min, &
1082 compute_twist=mt_compute_twist, &
1083 compute_length=mt_compute_length, &
1084 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp)
1087 if (mt_chunk_nz>0)
then
1089 mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax,mt_nz, &
1090 mt_dl,mt_max_steps,trim(output_file), &
1091 compute_twist=mt_compute_twist, &
1092 compute_length=mt_compute_length, &
1093 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1094 chunk_nz=mt_chunk_nz)
1097 mt_ymin,mt_ymax,mt_ny,mt_zmin,mt_zmax,mt_nz, &
1098 mt_dl,mt_max_steps,trim(output_file), &
1099 compute_twist=mt_compute_twist, &
1100 compute_length=mt_compute_length, &
1101 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp)
1104 end subroutine mt_run_volume_vti_task
1106 subroutine mt_run_arbitrary_plane_products_task()
1107 character(len=mt_task_name_len) :: vtu_file,csv_file
1109 call mt_resolve_output_file(
'arbitrary_plane_products',
'.vtu', &
1110 '_arbitrary_plane_products.vtu',vtu_file)
1112 if (mt_write_csv)
then
1113 call mt_resolve_prefix_file(
'_arbitrary_plane_products.csv',csv_file, &
1114 'arbitrary_plane_products CSV requires mt_output_prefix')
1116 call mt_require_real(
'mt_origin(1)',mt_origin(1))
1117 call mt_require_real(
'mt_origin(2)',mt_origin(2))
1118 call mt_require_real(
'mt_origin(3)',mt_origin(3))
1119 call mt_require_real(
'mt_e1(1)',mt_e1(1))
1120 call mt_require_real(
'mt_e1(2)',mt_e1(2))
1121 call mt_require_real(
'mt_e1(3)',mt_e1(3))
1122 call mt_require_real(
'mt_e2(1)',mt_e2(1))
1123 call mt_require_real(
'mt_e2(2)',mt_e2(2))
1124 call mt_require_real(
'mt_e2(3)',mt_e2(3))
1125 call mt_require_real(
'mt_s1min',mt_s1min)
1126 call mt_require_real(
'mt_s1max',mt_s1max)
1127 call mt_require_real(
'mt_s2min',mt_s2min)
1128 call mt_require_real(
'mt_s2max',mt_s2max)
1129 call mt_require_positive_int(
'mt_n1',mt_n1)
1130 call mt_require_positive_int(
'mt_n2',mt_n2)
1131 call mt_require_ordered(
'mt_s1min',
'mt_s1max',mt_s1min,mt_s1max)
1132 call mt_require_ordered(
'mt_s2min',
'mt_s2max',mt_s2min,mt_s2max)
1134 write(*,
'(a)')
'mt_run_topology_task: writing arbitrary-plane VTU '// &
1136 if (mt_write_csv)
then
1137 write(*,
'(a)')
'mt_run_topology_task: writing arbitrary-plane CSV '// &
1141 if (mt_b_min>0.d0)
then
1143 mt_e1(1:ndim),mt_e2(1:ndim),mt_s1min,mt_s1max,mt_n1, &
1144 mt_s2min,mt_s2max,mt_n2,mt_dl,mt_max_steps,trim(csv_file), &
1145 b_min=mt_b_min,compute_length=mt_compute_length, &
1146 compute_twist=mt_compute_twist, &
1147 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1148 vtu_file=trim(vtu_file),write_csv=mt_write_csv)
1151 mt_e1(1:ndim),mt_e2(1:ndim),mt_s1min,mt_s1max,mt_n1, &
1152 mt_s2min,mt_s2max,mt_n2,mt_dl,mt_max_steps,trim(csv_file), &
1153 compute_length=mt_compute_length, &
1154 compute_twist=mt_compute_twist, &
1155 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1156 vtu_file=trim(vtu_file),write_csv=mt_write_csv)
1158 end subroutine mt_run_arbitrary_plane_products_task
1160 subroutine mt_run_seed_products_task()
1161 character(len=mt_task_name_len) :: csv_file,vtu_file,diag_file
1162 character(len=mt_task_name_len) :: rk2_diag_file
1163 double precision,
allocatable :: seeds(:,:)
1166 if (len_trim(mt_output_prefix)==0)
then
1167 call mpistop(
'seed_products requires mt_output_prefix')
1169 if (len_trim(mt_output_file)>0)
then
1170 write(*,
'(a)')
'mt_run_topology_task: seed_products ignores mt_output_file'
1171 write(*,
'(a)')
'mt_run_topology_task: seed_products uses mt_output_prefix for CSV and VTU'
1173 if (len_trim(mt_seed_file)==0)
then
1174 call mpistop(
'seed_products requires mt_seed_file')
1178 if (mt_write_csv)
then
1179 call mt_resolve_prefix_file(
'_seed_products.csv',csv_file, &
1180 'seed_products CSV requires mt_output_prefix')
1182 call mt_resolve_prefix_file(
'_seed_products.vtu',vtu_file, &
1183 'seed_products VTU requires mt_output_prefix')
1184 if (mt_rk45_tangent_diagnostic)
then
1185 call mt_resolve_prefix_file(
'_rk45_tangent_diag.csv',diag_file, &
1186 'seed_products RK45 tangent diagnostic requires mt_output_prefix')
1188 if (mt_rk2_fusion_diagnostic)
then
1189 call mt_resolve_prefix_file(
'_rk2_fusion_diag.csv',rk2_diag_file, &
1190 'seed_products RK2 fusion diagnostic requires mt_output_prefix')
1192 call mt_read_seed_file(trim(mt_seed_file),seeds,nseed)
1194 if (mt_write_csv)
write(*,
'(a)') &
1195 'mt_run_topology_task: writing seed-products CSV '//trim(csv_file)
1196 write(*,
'(a)')
'mt_run_topology_task: writing seed-products VTU '// &
1199 if (mt_b_min>0.d0)
then
1201 trim(csv_file),b_min=mt_b_min,compute_length=mt_compute_length, &
1202 compute_twist=mt_compute_twist, &
1203 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1204 vtu_file=trim(vtu_file))
1205 if (mt_rk45_tangent_diagnostic)
then
1206 write(*,
'(a)')
'mt_run_topology_task: writing RK45 tangent '// &
1207 'diagnostic CSV '//trim(diag_file)
1208 call mt_rk45_tangent_diagnostic_seeds(seeds,nseed,mt_dl, &
1209 mt_max_steps,trim(diag_file),b_min=mt_b_min)
1211 if (mt_rk2_fusion_diagnostic)
then
1212 write(*,
'(a)')
'mt_run_topology_task: writing RK2 fusion '// &
1213 'diagnostic CSV '//trim(rk2_diag_file)
1214 call mt_rk2_fusion_diagnostic_seeds(seeds,nseed,mt_dl, &
1215 mt_max_steps,trim(rk2_diag_file),b_min=mt_b_min)
1219 trim(csv_file),compute_length=mt_compute_length, &
1220 compute_twist=mt_compute_twist, &
1221 compute_q=mt_compute_q,compute_qperp=mt_compute_qperp, &
1222 vtu_file=trim(vtu_file))
1223 if (mt_rk45_tangent_diagnostic)
then
1224 write(*,
'(a)')
'mt_run_topology_task: writing RK45 tangent '// &
1225 'diagnostic CSV '//trim(diag_file)
1226 call mt_rk45_tangent_diagnostic_seeds(seeds,nseed,mt_dl, &
1227 mt_max_steps,trim(diag_file))
1229 if (mt_rk2_fusion_diagnostic)
then
1230 write(*,
'(a)')
'mt_run_topology_task: writing RK2 fusion '// &
1231 'diagnostic CSV '//trim(rk2_diag_file)
1232 call mt_rk2_fusion_diagnostic_seeds(seeds,nseed,mt_dl, &
1233 mt_max_steps,trim(rk2_diag_file))
1238 end subroutine mt_run_seed_products_task
1240 subroutine mt_run_spherical_surface_products_task()
1241 character(len=mt_task_name_len) :: surface,csv_file,vtu_file,suffix
1242 double precision :: seed_coord,s1_min,s1_max,s2_min,s2_max
1243 double precision :: seed_theta0,seed_phi0,seed_alpha
1245 surface=mt_lowercase(trim(mt_seed_surface))
1246 if (len_trim(surface)==0) surface=
'rmin'
1247 select case (trim(surface))
1249 seed_coord=xprobmin1
1250 case (
'rconst',
'r_const')
1252 call mt_require_real(
'mt_seed_coord',mt_seed_coord)
1253 seed_coord=mt_seed_coord
1254 if (seed_coord<xprobmin1 .or. seed_coord>xprobmax1)
then
1255 call mpistop(
'spherical_surface_products requires rconst '// &
1256 'mt_seed_coord inside domain')
1259 case (
'theta_const',
'thetaconst')
1260 surface=
'theta_const'
1261 call mt_require_real(
'mt_seed_coord',mt_seed_coord)
1262 seed_coord=mt_seed_coord
1263 if (seed_coord<xprobmin2 .or. seed_coord>xprobmax2)
then
1264 call mpistop(
'spherical_surface_products requires theta_const '// &
1265 'mt_seed_coord inside domain')
1267 case (
'phi_const',
'phiconst')
1269 call mt_require_real(
'mt_seed_coord',mt_seed_coord)
1270 seed_coord=mt_seed_coord
1271 if (seed_coord<xprobmin3 .or. seed_coord>xprobmax3)
then
1272 call mpistop(
'spherical_surface_products requires phi_const '// &
1273 'mt_seed_coord inside domain')
1275 case (
'radial_plane',
'radialplane')
1276 surface=
'radial_plane'
1278 call mt_require_real(
'mt_seed_theta0',mt_seed_theta0)
1279 call mt_require_real(
'mt_seed_phi0',mt_seed_phi0)
1280 call mt_require_real(
'mt_seed_alpha',mt_seed_alpha)
1281 if (mt_seed_theta0<xprobmin2 .or. mt_seed_theta0>xprobmax2)
then
1282 call mpistop(
'spherical_surface_products requires radial_plane '// &
1283 'mt_seed_theta0 inside domain')
1285 if (mt_seed_phi0<xprobmin3 .or. mt_seed_phi0>xprobmax3)
then
1286 call mpistop(
'spherical_surface_products requires radial_plane '// &
1287 'mt_seed_phi0 inside domain')
1289 if (abs(dsin(mt_seed_theta0))<=1.d-12)
then
1290 call mpistop(
'spherical_surface_products radial_plane requires '// &
1291 'mt_seed_theta0 away from the polar singularity')
1295 call mpistop(
'spherical_surface_products supports '// &
1296 'mt_seed_surface=rmin, rconst, theta_const, phi_const, or radial_plane')
1298 call mt_require_positive_int(
'mt_n1',mt_n1)
1299 call mt_require_positive_int(
'mt_n2',mt_n2)
1305 select case (trim(surface))
1306 case (
'rmin',
'rconst')
1311 case (
'theta_const')
1321 case (
'radial_plane')
1324 s2_min=-0.5d0*min(xprobmax2-xprobmin2,xprobmax3-xprobmin3)
1325 s2_max= 0.5d0*min(xprobmax2-xprobmin2,xprobmax3-xprobmin3)
1328 if (mt_is_set_real(mt_s1min)) s1_min=mt_s1min
1329 if (mt_is_set_real(mt_s1max)) s1_max=mt_s1max
1330 if (mt_is_set_real(mt_s2min)) s2_min=mt_s2min
1331 if (mt_is_set_real(mt_s2max)) s2_max=mt_s2max
1332 call mt_require_ordered(
'mt_s1min',
'mt_s1max',s1_min,s1_max)
1333 call mt_require_ordered(
'mt_s2min',
'mt_s2max',s2_min,s2_max)
1336 if (mt_write_csv)
then
1337 if (trim(surface)==
'rmin')
then
1338 suffix=
'_spherical_rmin_products.csv'
1339 else if (trim(surface)==
'radial_plane')
then
1340 suffix=
'_spherical_radial_plane_products.csv'
1342 suffix=
'_spherical_'//trim(surface)//
'_products.csv'
1344 call mt_resolve_prefix_file(trim(suffix),csv_file, &
1345 'spherical_surface_products CSV requires mt_output_prefix')
1347 if (trim(surface)==
'rmin')
then
1348 suffix=
'_spherical_rmin_products.vtu'
1349 else if (trim(surface)==
'radial_plane')
then
1350 suffix=
'_spherical_radial_plane_products.vtu'
1352 suffix=
'_spherical_'//trim(surface)//
'_products.vtu'
1354 call mt_resolve_output_file(
'spherical_surface_products',
'.vtu', &
1355 trim(suffix),vtu_file)
1357 if (mt_write_csv)
then
1358 write(*,
'(a)')
'mt_run_topology_task: writing spherical '// &
1359 trim(surface)//
' CSV '//trim(csv_file)
1361 write(*,
'(a)')
'mt_run_topology_task: writing spherical '// &
1362 trim(surface)//
' VTU '//trim(vtu_file)
1364 if (mt_profile_spherical)
then
1365 call trace_spherical_profile_reset()
1366 call trace_spherical_profile_set(.true.)
1369 seed_theta0=mt_seed_theta0
1370 seed_phi0=mt_seed_phi0
1371 seed_alpha=mt_seed_alpha
1372 if (mt_b_min>0.d0)
then
1373 call mt_fieldline_products_spherical_surface(trim(surface),seed_coord, &
1374 s1_min,s1_max,mt_n1,s2_min,s2_max,mt_n2,mt_dl,mt_max_steps, &
1375 trim(csv_file),trim(vtu_file),trim(mt_seed_layout), &
1376 seed_theta0,seed_phi0,seed_alpha, &
1377 compute_twist=mt_compute_twist,compute_q=mt_compute_q, &
1378 compute_qperp=mt_compute_qperp,b_min=mt_b_min)
1380 call mt_fieldline_products_spherical_surface(trim(surface),seed_coord, &
1381 s1_min,s1_max,mt_n1,s2_min,s2_max,mt_n2,mt_dl,mt_max_steps, &
1382 trim(csv_file),trim(vtu_file),trim(mt_seed_layout), &
1383 seed_theta0,seed_phi0,seed_alpha, &
1384 compute_twist=mt_compute_twist,compute_q=mt_compute_q, &
1385 compute_qperp=mt_compute_qperp)
1387 if (mt_profile_spherical)
then
1388 call trace_spherical_profile_report(
'spherical_surface_products '// &
1390 call trace_spherical_profile_set(.false.)
1392 end subroutine mt_run_spherical_surface_products_task
1394 subroutine mt_run_spherical_cloud_products_task()
1395 character(len=mt_task_name_len) :: vtu_file
1396 double precision :: s1_min,s1_max,s2_min,s2_max,s3_min,s3_max
1398 if (mt_write_csv)
then
1399 write(*,
'(a)')
'mt_run_topology_task: spherical_cloud_products '// &
1400 'does not write CSV; use seed_products for selected-point diagnostics'
1402 call mt_require_positive_int(
'mt_n1',mt_n1)
1403 call mt_require_positive_int(
'mt_n2',mt_n2)
1404 call mt_require_positive_int(
'mt_n3',mt_n3)
1417 if (mt_is_set_real(mt_s1min)) s1_min=mt_s1min
1418 if (mt_is_set_real(mt_s1max)) s1_max=mt_s1max
1419 if (mt_is_set_real(mt_s2min)) s2_min=mt_s2min
1420 if (mt_is_set_real(mt_s2max)) s2_max=mt_s2max
1421 if (mt_is_set_real(mt_s3min)) s3_min=mt_s3min
1422 if (mt_is_set_real(mt_s3max)) s3_max=mt_s3max
1423 call mt_require_ordered(
'mt_s1min',
'mt_s1max',s1_min,s1_max)
1424 call mt_require_ordered(
'mt_s2min',
'mt_s2max',s2_min,s2_max)
1425 call mt_require_ordered(
'mt_s3min',
'mt_s3max',s3_min,s3_max)
1427 call mt_resolve_output_file(
'spherical_cloud_products',
'.vtu', &
1428 '_spherical_cloud_products.vtu',vtu_file)
1430 write(*,
'(a)')
'mt_run_topology_task: writing spherical cloud VTU '// &
1433 if (mt_profile_spherical)
then
1434 call trace_spherical_profile_reset()
1435 call trace_spherical_profile_set(.true.)
1438 if (mt_b_min>0.d0)
then
1439 call mt_fieldline_products_spherical_cloud(s1_min,s1_max,mt_n1, &
1440 s2_min,s2_max,mt_n2,s3_min,s3_max,mt_n3,mt_dl,mt_max_steps, &
1441 trim(vtu_file),trim(mt_seed_layout), &
1442 compute_twist=mt_compute_twist,compute_q=mt_compute_q, &
1443 compute_qperp=mt_compute_qperp,b_min=mt_b_min)
1445 call mt_fieldline_products_spherical_cloud(s1_min,s1_max,mt_n1, &
1446 s2_min,s2_max,mt_n2,s3_min,s3_max,mt_n3,mt_dl,mt_max_steps, &
1447 trim(vtu_file),trim(mt_seed_layout), &
1448 compute_twist=mt_compute_twist,compute_q=mt_compute_q, &
1449 compute_qperp=mt_compute_qperp)
1451 if (mt_profile_spherical)
then
1452 call trace_spherical_profile_report(
'spherical_cloud_products')
1453 call trace_spherical_profile_set(.false.)
1455 end subroutine mt_run_spherical_cloud_products_task
1457 subroutine mt_resolve_output_file(mode,extension,suffix,output_file)
1458 character(len=*),
intent(in) :: mode,extension,suffix
1459 character(len=*),
intent(out) :: output_file
1460 integer :: required_len
1463 if (len_trim(mt_output_file)>0)
then
1464 output_file=trim(mt_output_file)
1465 if (len_trim(mt_output_prefix)>0)
then
1466 write(*,
'(a)')
'mt_run_topology_task: mt_output_file takes precedence over mt_output_prefix'
1468 call mt_warn_extension(output_file,extension,mode)
1470 required_len=len_trim(mt_output_prefix)+len_trim(suffix)
1471 if (required_len>len(output_file))
then
1472 call mpistop(
'mt_run_topology_task output filename exceeds internal length')
1474 output_file=trim(mt_output_prefix)//trim(suffix)
1476 end subroutine mt_resolve_output_file
1478 subroutine mt_resolve_prefix_file(suffix,output_file,missing_message)
1479 character(len=*),
intent(in) :: suffix,missing_message
1480 character(len=*),
intent(out) :: output_file
1481 integer :: required_len
1483 if (len_trim(mt_output_prefix)==0)
then
1484 call mpistop(trim(missing_message))
1486 required_len=len_trim(mt_output_prefix)+len_trim(suffix)
1487 if (required_len>len(output_file))
then
1488 call mpistop(
'mt_run_topology_task output filename exceeds internal length')
1490 output_file=trim(mt_output_prefix)//trim(suffix)
1491 end subroutine mt_resolve_prefix_file
1493 logical function mt_is_set_real(value)
result(is_set)
1494 double precision,
intent(in) :: value
1496 is_set=(
value/=mt_unset_real)
1497 end function mt_is_set_real
1499 subroutine mt_require_real(name,value)
1500 character(len=*),
intent(in) :: name
1501 double precision,
intent(in) :: value
1503 if (.not.mt_is_set_real(
value))
then
1504 call mpistop(
'mt_run_topology_task requires '//trim(name))
1506 end subroutine mt_require_real
1508 subroutine mt_require_positive_int(name,value)
1509 character(len=*),
intent(in) :: name
1510 integer,
intent(in) :: value
1513 call mpistop(
'mt_run_topology_task requires '//trim(name)//
' > 0')
1515 end subroutine mt_require_positive_int
1517 subroutine mt_require_ordered(name_min,name_max,value_min,value_max)
1518 character(len=*),
intent(in) :: name_min,name_max
1519 double precision,
intent(in) :: value_min,value_max
1521 if (value_max<value_min)
then
1522 call mpistop(
'mt_run_topology_task requires ordered '// &
1523 trim(name_min)//
'/'//trim(name_max))
1525 end subroutine mt_require_ordered
1527 subroutine mt_require_requested_science(do_length,do_twist,do_q,do_qperp, &
1529 logical,
intent(in) :: do_length,do_twist,do_q,do_qperp
1530 character(len=*),
intent(in) :: caller
1532 if (.not.(do_length .or. do_twist .or. do_q .or. do_qperp))
then
1533 call mpistop(trim(caller)//
' requires at least one requested science array')
1535 end subroutine mt_require_requested_science
1537 subroutine mt_read_seed_file(filename,seeds,nseed)
1538 character(len=*),
intent(in) :: filename
1539 double precision,
allocatable,
intent(out) :: seeds(:,:)
1540 integer,
intent(out) :: nseed
1542 character(len=1024) :: line
1543 double precision :: xyz(3)
1544 integer :: io,ios,line_no,iseed
1547 open(newunit=io,file=trim(filename),status=
'old',action=
'read', &
1548 form=
'formatted',iostat=ios)
1550 call mpistop(
'mt_read_seed_file could not open '//trim(filename))
1554 read(io,
'(a)',iostat=ios) line
1557 if (.not.mt_seed_line_is_data(line)) cycle
1558 call mt_validate_seed_line(filename,line,line_no)
1563 call mpistop(
'mt_read_seed_file found no seeds in '//trim(filename))
1566 allocate(seeds(nseed,ndim))
1568 open(newunit=io,file=trim(filename),status=
'old',action=
'read', &
1569 form=
'formatted',iostat=ios)
1571 call mpistop(
'mt_read_seed_file could not reopen '//trim(filename))
1576 read(io,
'(a)',iostat=ios) line
1579 if (.not.mt_seed_line_is_data(line)) cycle
1581 read(line,*,iostat=ios) xyz
1583 call mt_fail_seed_line(filename,line_no)
1585 seeds(iseed,1:ndim)=xyz(1:ndim)
1588 end subroutine mt_read_seed_file
1590 logical function mt_seed_line_is_data(line)
result(is_data)
1591 character(len=*),
intent(in) :: line
1592 character(len=len(line)) :: trimmed
1594 trimmed=adjustl(line)
1595 is_data=len_trim(trimmed)>0
1596 if (is_data) is_data=trimmed(1:1)/=
'#'
1597 end function mt_seed_line_is_data
1599 subroutine mt_validate_seed_line(filename,line,line_no)
1600 character(len=*),
intent(in) :: filename,line
1601 integer,
intent(in) :: line_no
1603 double precision :: x,y,z
1606 if (index(line,
',')>0)
then
1607 call mt_fail_seed_line(filename,line_no)
1609 if (mt_count_tokens(line)/=3)
then
1610 call mt_fail_seed_line(filename,line_no)
1612 read(line,*,iostat=ios) x,y,z
1614 call mt_fail_seed_line(filename,line_no)
1616 end subroutine mt_validate_seed_line
1618 integer function mt_count_tokens(line)
result(ntoken)
1619 character(len=*),
intent(in) :: line
1625 do i=1,len_trim(line)
1626 if (line(i:i)==
' ' .or. line(i:i)==achar(9))
then
1629 if (.not.in_token)
then
1635 end function mt_count_tokens
1637 subroutine mt_fail_seed_line(filename,line_no)
1638 character(len=*),
intent(in) :: filename
1639 integer,
intent(in) :: line_no
1641 call mpistop(
'mt_read_seed_file malformed line '// &
1642 trim(mt_int_to_string(line_no))//
' in '//trim(filename))
1643 end subroutine mt_fail_seed_line
1645 function mt_int_to_string(value)
result(text)
1646 integer,
intent(in) :: value
1647 character(len=32) :: text
1649 write(text,
'(i0)')
value
1650 end function mt_int_to_string
1652 subroutine mt_warn_extension(filename,extension,mode)
1653 character(len=*),
intent(in) :: filename,extension,mode
1655 if (.not.mt_has_extension(filename,extension))
then
1656 write(*,
'(a)')
'mt_run_topology_task warning: '//trim(mode)// &
1657 ' output file does not end in '//trim(extension)
1659 end subroutine mt_warn_extension
1661 logical function mt_has_extension(filename,extension)
result(has_ext)
1662 character(len=*),
intent(in) :: filename,extension
1663 character(len=mt_task_name_len) :: fname,ext
1666 fname=mt_lowercase(trim(filename))
1667 ext=mt_lowercase(trim(extension))
1671 if (lf>=le) has_ext=(fname(lf-le+1:lf)==ext(1:le))
1672 end function mt_has_extension
1674 function mt_lowercase(input)
result(output)
1675 character(len=*),
intent(in) :: input
1676 character(len=len(input)) :: output
1681 code=iachar(output(i:i))
1682 if (code>=iachar(
'A') .and. code<=iachar(
'Z'))
then
1683 output(i:i)=achar(code+iachar(
'a')-iachar(
'A'))
1686 end function mt_lowercase
1688 logical function mt_vtk_detail_is_full()
result(is_full)
1689 is_full=(mt_lowercase(trim(mt_vtk_detail))==
'full')
1690 end function mt_vtk_detail_is_full
1692 double precision function mt_visual_float(value)
result(out_value)
1693 double precision,
intent(in) :: value
1695 if (ieee_is_finite(
value))
then
1700 end function mt_visual_float
1702 double precision function mt_visual_valid_float(value,is_valid) &
1704 double precision,
intent(in) :: value
1705 logical,
intent(in) :: is_valid
1707 if (is_valid .and. ieee_is_finite(
value))
then
1712 end function mt_visual_valid_float
1714 double precision function mt_vc(vec,icomp)
result(value)
1717 double precision,
intent(in) :: vec(ndim)
1718 integer,
intent(in) :: icomp
1720 if (icomp>=1 .and. icomp<=ndim)
then
1729 double precision,
intent(in) :: seed(ndim),dl
1730 integer,
intent(in) :: max_steps
1731 character(len=*),
intent(in) :: csv_file
1732 double precision,
intent(in),
optional :: b_min
1734 type(trace_length_result) :: result
1735 double precision :: seed_xyz(3)
1736 integer :: csv_unit,io_status
1739 call mpistop(
'mt_length_single currently requires npe=1')
1742 if (
present(b_min))
then
1743 call trace_field_length_single(seed,dl,max_steps,result,b_min)
1745 call trace_field_length_single(seed,dl,max_steps,result)
1749 seed_xyz(1:ndim)=result%seed
1751 open(newunit=csv_unit,file=trim(csv_file),status=
'replace', &
1752 action=
'write',form=
'formatted',iostat=io_status)
1753 if (io_status/=0)
then
1754 call mpistop(
'mt_length_single could not open CSV file')
1757 write(csv_unit,
'(a)',iostat=io_status) &
1758 'seed_x,seed_y,seed_z,'// &
1759 'length_total,length_backward,length_forward,'// &
1760 'nstep_backward,nstep_forward,'// &
1761 'status_backward,status_forward'
1762 if (io_status/=0)
then
1764 call mpistop(
'mt_length_single could not write CSV header')
1767 write(csv_unit,
'(es24.16,5(",",es24.16),4(",",i0))',iostat=io_status) &
1768 seed_xyz,result%total_length, &
1769 result%backward_length,result%forward_length, &
1770 result%backward_nstep,result%forward_nstep, &
1771 result%backward_status,result%forward_status
1772 if (io_status/=0)
then
1774 call mpistop(
'mt_length_single could not write CSV data')
1782 integer,
intent(in) :: nseed,max_steps
1783 double precision,
intent(in) :: seeds(nseed,ndim),dl
1784 character(len=*),
intent(in) :: csv_file
1785 double precision,
intent(in),
optional :: b_min
1787 type(trace_length_result),
allocatable :: results(:)
1788 double precision :: seed_xyz(3)
1789 integer :: csv_unit,io_status,iseed
1792 call mpistop(
'mt_length_seeds currently requires npe=1')
1795 call mpistop(
'mt_length_seeds requires nseed>=0')
1798 allocate(results(nseed))
1799 if (
present(b_min))
then
1800 call trace_field_length_multi(seeds,nseed,dl,max_steps,results,b_min)
1802 call trace_field_length_multi(seeds,nseed,dl,max_steps,results)
1805 open(newunit=csv_unit,file=trim(csv_file),status=
'replace', &
1806 action=
'write',form=
'formatted',iostat=io_status)
1807 if (io_status/=0)
then
1809 call mpistop(
'mt_length_seeds could not open CSV file')
1812 write(csv_unit,
'(a)',iostat=io_status) &
1813 'seed_id,seed_x,seed_y,seed_z,'// &
1814 'length_total,length_backward,length_forward,'// &
1815 'nstep_backward,nstep_forward,'// &
1816 'status_backward,status_forward'
1817 if (io_status/=0)
then
1820 call mpistop(
'mt_length_seeds could not write CSV header')
1825 seed_xyz(1:ndim)=results(iseed)%seed
1826 write(csv_unit,
'(i0,6(",",es24.16),4(",",i0))',iostat=io_status) &
1827 iseed,seed_xyz,results(iseed)%total_length, &
1828 results(iseed)%backward_length,results(iseed)%forward_length, &
1829 results(iseed)%backward_nstep,results(iseed)%forward_nstep, &
1830 results(iseed)%backward_status,results(iseed)%forward_status
1831 if (io_status/=0)
then
1834 call mpistop(
'mt_length_seeds could not write CSV data')
1843 b_min,compute_length,compute_twist,compute_q,compute_qperp,vtu_file)
1845 integer,
intent(in) :: nseed,max_steps
1846 double precision,
intent(in) :: seeds(nseed,ndim),dl
1847 character(len=*),
intent(in) :: csv_file
1848 double precision,
intent(in),
optional :: b_min
1849 logical,
intent(in),
optional :: compute_length,compute_twist
1850 logical,
intent(in),
optional :: compute_q,compute_qperp
1851 character(len=*),
intent(in),
optional :: vtu_file
1853 type(trace_length_result),
allocatable :: length_results(:)
1854 type(trace_twist_result),
allocatable :: twist_results(:)
1855 type(trace_qperp_result),
allocatable :: q_results(:)
1856 type(trace_qperp_result),
allocatable :: qperp_results(:)
1857 logical :: do_length,do_twist,do_q,do_qperp
1858 character(len=mt_task_name_len) :: integrator
1864 if (
present(compute_length)) do_length=compute_length
1865 if (
present(compute_twist)) do_twist=compute_twist
1866 if (
present(compute_q)) do_q=compute_q
1867 if (
present(compute_qperp)) do_qperp=compute_qperp
1868 integrator=mt_lowercase(trim(mt_trace_integrator))
1871 call mpistop(
'mt_fieldline_products_seeds currently requires npe=1')
1874 call mpistop(
'mt_fieldline_products_seeds requires 3D Cartesian or spherical geometry')
1877 select case (geo_coordinate)
1878 case (geo_cartesian,geo_cartesian_stretched)
1879 case (geo_spherical)
1880 call mt_validate_periodic_phi()
1882 call mpistop(
'mt_fieldline_products_seeds requires Cartesian or spherical geometry')
1886 select case (trim(integrator))
1889 case (
'rk45_cartesian')
1891 if (geo_coordinate==geo_spherical)
then
1892 call mpistop(
'seed_products logQperp with spherical geometry '// &
1893 'requires mt_trace_integrator=rk45_spherical')
1896 case (
'rk45_spherical')
1898 if (geo_coordinate/=geo_spherical)
then
1899 call mpistop(
'seed_products logQperp with Cartesian geometry '// &
1900 'requires mt_trace_integrator=rk45_cartesian')
1904 call mpistop(
'seed_products logQperp requires mt_trace_integrator='// &
1905 'rk2, rk45_cartesian, or rk45_spherical')
1909 select case (trim(integrator))
1912 case (
'rk45_cartesian')
1914 if (geo_coordinate==geo_spherical)
then
1915 call mpistop(
'seed_products logQ with spherical geometry '// &
1916 'requires mt_trace_integrator=rk45_spherical')
1919 case (
'rk45_spherical')
1921 if (geo_coordinate/=geo_spherical)
then
1922 call mpistop(
'seed_products logQ with Cartesian geometry '// &
1923 'requires mt_trace_integrator=rk45_cartesian')
1927 call mpistop(
'seed_products logQ requires mt_trace_integrator='// &
1928 'rk2, rk45_cartesian, or rk45_spherical')
1932 call mpistop(
'mt_fieldline_products_seeds requires nseed>=0')
1934 call mt_require_requested_science(do_length,do_twist,do_q,do_qperp, &
1935 'mt_fieldline_products_seeds')
1937 allocate(length_results(nseed))
1939 allocate(twist_results(nseed))
1941 allocate(twist_results(0))
1944 allocate(q_results(nseed))
1946 allocate(q_results(0))
1949 allocate(qperp_results(nseed))
1951 allocate(qperp_results(0))
1954 if (
present(b_min))
then
1955 call mt_trace_fieldline_products_seedset(seeds,nseed,dl,max_steps, &
1956 length_results,twist_results,q_results,qperp_results,do_twist, &
1957 do_q,do_qperp,b_min)
1959 call mt_trace_fieldline_products_seedset(seeds,nseed,dl,max_steps, &
1960 length_results,twist_results,q_results,qperp_results,do_twist, &
1964 if (len_trim(csv_file)>0)
then
1965 call mt_write_fieldline_products_seeds_csv(length_results, &
1966 twist_results,q_results,qperp_results,nseed,csv_file,do_twist, &
1969 if (
present(vtu_file))
then
1970 if (len_trim(vtu_file)>0)
then
1971 call mt_write_fieldline_products_vtu_vertices(vtu_file, &
1972 length_results,twist_results,q_results,qperp_results,nseed, &
1973 do_length,do_twist,do_q,do_qperp,
'mt_fieldline_products_seeds')
1977 if (
allocated(qperp_results))
deallocate(qperp_results)
1978 if (
allocated(q_results))
deallocate(q_results)
1979 if (
allocated(twist_results))
deallocate(twist_results)
1980 deallocate(length_results)
1983 subroutine mt_rk45_tangent_diagnostic_seeds(seeds,nseed,dL,max_steps, &
1985 integer,
intent(in) :: nseed,max_steps
1986 double precision,
intent(in) :: seeds(nseed,ndim),dl
1987 character(len=*),
intent(in) :: csv_file
1988 double precision,
intent(in),
optional :: b_min
1990 type(trace_qperp_result),
allocatable :: rk2_results(:)
1991 type(trace_qperp_result),
allocatable :: rk45_results(:)
1994 call mpistop(
'mt_rk45_tangent_diagnostic_seeds currently requires npe=1')
1997 call mpistop(
'mt_rk45_tangent_diagnostic_seeds requires nseed>=0')
2000 allocate(rk2_results(nseed),rk45_results(nseed))
2001 if (
present(b_min))
then
2002 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,rk2_results, &
2004 call trace_debug_cartesian_rk45_tangent_q0_multi(seeds,nseed,dl, &
2005 max_steps,rk45_results,b_min)
2007 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,rk2_results)
2008 call trace_debug_cartesian_rk45_tangent_q0_multi(seeds,nseed,dl, &
2009 max_steps,rk45_results)
2012 call mt_write_rk45_tangent_diagnostic_csv(rk2_results,rk45_results, &
2014 deallocate(rk45_results,rk2_results)
2015 end subroutine mt_rk45_tangent_diagnostic_seeds
2017 subroutine mt_write_rk45_tangent_diagnostic_csv(rk2_results,rk45_results, &
2019 integer,
intent(in) :: nseed
2020 type(trace_qperp_result),
intent(in) :: rk2_results(nseed)
2021 type(trace_qperp_result),
intent(in) :: rk45_results(nseed)
2022 character(len=*),
intent(in) :: csv_file
2024 double precision :: seed_xyz(3),logq_diff,q_diff,length_diff
2025 double precision :: f_endpoint_diff,b_endpoint_diff
2026 double precision :: uf_diff,vf_diff,ub_diff,vb_diff
2027 integer :: csv_unit,io_status,iseed
2029 open(newunit=csv_unit,file=trim(csv_file),status=
'replace', &
2030 action=
'write',form=
'formatted',iostat=io_status)
2031 if (io_status/=0)
then
2032 call mpistop(
'mt_rk45_tangent_diagnostic could not open CSV file')
2035 write(csv_unit,
'(a)',iostat=io_status) &
2036 'seed_id,seed_x,seed_y,seed_z,'// &
2037 'rk2_status_q0,rk45_status_q0,'// &
2038 'rk2_forward_status,rk45_forward_status,'// &
2039 'rk2_backward_status,rk45_backward_status,'// &
2040 'rk2_logq0,rk45_logq0,abs_diff_logq0,'// &
2041 'rk2_q0,rk45_q0,abs_diff_q0,'// &
2042 'rk2_length_total,rk45_length_total,abs_diff_length_total,'// &
2043 'endpoint_diff_forward,endpoint_diff_backward,'// &
2044 'u_forward_perp_diff,v_forward_perp_diff,'// &
2045 'u_backward_perp_diff,v_backward_perp_diff'
2046 if (io_status/=0)
then
2048 call mpistop(
'mt_rk45_tangent_diagnostic could not write CSV header')
2053 seed_xyz(1:ndim)=rk2_results(iseed)%seed
2054 logq_diff=mt_absdiff_or_nan(rk2_results(iseed)%logq0, &
2055 rk45_results(iseed)%logq0)
2056 q_diff=mt_absdiff_or_nan(rk2_results(iseed)%q0, &
2057 rk45_results(iseed)%q0)
2058 length_diff=abs((rk2_results(iseed)%forward_length+ &
2059 rk2_results(iseed)%backward_length)- &
2060 (rk45_results(iseed)%forward_length+ &
2061 rk45_results(iseed)%backward_length))
2062 f_endpoint_diff=dsqrt(sum((rk2_results(iseed)%forward_endpoint- &
2063 rk45_results(iseed)%forward_endpoint)**2))
2064 b_endpoint_diff=dsqrt(sum((rk2_results(iseed)%backward_endpoint- &
2065 rk45_results(iseed)%backward_endpoint)**2))
2066 uf_diff=dsqrt(sum((rk2_results(iseed)%u_forward_perp- &
2067 rk45_results(iseed)%u_forward_perp)**2))
2068 vf_diff=dsqrt(sum((rk2_results(iseed)%v_forward_perp- &
2069 rk45_results(iseed)%v_forward_perp)**2))
2070 ub_diff=dsqrt(sum((rk2_results(iseed)%u_backward_perp- &
2071 rk45_results(iseed)%u_backward_perp)**2))
2072 vb_diff=dsqrt(sum((rk2_results(iseed)%v_backward_perp- &
2073 rk45_results(iseed)%v_backward_perp)**2))
2075 write(csv_unit,
'(i0,3(",",es24.16),6(",",i0),15(",",es24.16))', &
2078 rk2_results(iseed)%status_q0, &
2079 rk45_results(iseed)%status_q0, &
2080 rk2_results(iseed)%forward_status, &
2081 rk45_results(iseed)%forward_status, &
2082 rk2_results(iseed)%backward_status, &
2083 rk45_results(iseed)%backward_status, &
2084 rk2_results(iseed)%logq0,rk45_results(iseed)%logq0,logq_diff, &
2085 rk2_results(iseed)%q0,rk45_results(iseed)%q0,q_diff, &
2086 rk2_results(iseed)%forward_length+ &
2087 rk2_results(iseed)%backward_length, &
2088 rk45_results(iseed)%forward_length+ &
2089 rk45_results(iseed)%backward_length, &
2090 length_diff,f_endpoint_diff,b_endpoint_diff, &
2091 uf_diff,vf_diff,ub_diff,vb_diff
2092 if (io_status/=0)
then
2094 call mpistop(
'mt_rk45_tangent_diagnostic could not write CSV data')
2099 end subroutine mt_write_rk45_tangent_diagnostic_csv
2101 subroutine mt_rk2_fusion_diagnostic_seeds(seeds,nseed,dL,max_steps, &
2103 integer,
intent(in) :: nseed,max_steps
2104 double precision,
intent(in) :: seeds(nseed,ndim),dl
2105 character(len=*),
intent(in) :: csv_file
2106 double precision,
intent(in),
optional :: b_min
2108 type(trace_topology_result),
allocatable :: summary(:)
2109 type(trace_qperp_result),
allocatable :: q_trace(:)
2110 type(trace_qperp_result),
allocatable :: q_short(:)
2111 type(trace_twist_result),
allocatable :: q_twist(:)
2112 type(trace_twist_result),
allocatable :: q_short_twist(:)
2113 integer :: cache_status
2114 logical :: use_spherical_cache
2117 call mpistop(
'mt_rk2_fusion_diagnostic currently requires npe=1')
2120 call mpistop(
'mt_rk2_fusion_diagnostic requires nseed>=0')
2122 if (mt_lowercase(trim(mt_trace_integrator))/=
'rk2')
then
2123 call mpistop(
'mt_rk2_fusion_diagnostic requires rk2 tracing')
2126 allocate(summary(nseed),q_trace(nseed),q_short(nseed), &
2127 q_twist(nseed),q_short_twist(nseed))
2128 use_spherical_cache=.false.
2130 if (geo_coordinate==geo_spherical)
then
2131 call trace_spherical_curl_cache_build(cache_status)
2132 if (cache_status/=trace_status_active)
then
2133 call mpistop(
'mt_rk2_fusion_diagnostic failed to build '// &
2134 'spherical curl cache')
2136 use_spherical_cache=.true.
2140 if (
present(b_min))
then
2141 call trace_field_topology_multi(seeds,nseed,dl,max_steps,summary, &
2142 need_twist=.true.,need_mapping=.false.,b_min=b_min)
2143 if (geo_coordinate==geo_spherical)
then
2144 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
2145 q_trace,b_min,twist_results=q_twist)
2146 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
2147 max_steps,q_short,b_min,twist_results=q_short_twist)
2149 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,q_trace, &
2150 b_min,twist_results=q_twist)
2151 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
2152 max_steps,q_short,b_min,twist_results=q_short_twist)
2155 call trace_field_topology_multi(seeds,nseed,dl,max_steps,summary, &
2156 need_twist=.true.,need_mapping=.false.)
2157 if (geo_coordinate==geo_spherical)
then
2158 call trace_field_spherical_rmin_q_multi(seeds,nseed,dl,max_steps, &
2159 q_trace,twist_results=q_twist)
2160 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
2161 max_steps,q_short,twist_results=q_short_twist)
2163 call trace_field_qperp_multi(seeds,nseed,dl,max_steps,q_trace, &
2164 twist_results=q_twist)
2165 call trace_field_rk2_short_boundary_q_multi(seeds,nseed,dl, &
2166 max_steps,q_short,twist_results=q_short_twist)
2170 if (use_spherical_cache)
call trace_spherical_curl_cache_clear()
2171 call mt_write_rk2_fusion_diagnostic_csv(summary,q_trace,q_twist, &
2172 q_short,q_short_twist,nseed,csv_file)
2173 deallocate(q_short_twist,q_twist,q_short,q_trace,summary)
2174 end subroutine mt_rk2_fusion_diagnostic_seeds
2176 subroutine mt_write_rk2_fusion_diagnostic_csv(summary,q_trace,q_twist, &
2177 q_short,q_short_twist,nseed,csv_file)
2178 integer,
intent(in) :: nseed
2179 type(trace_topology_result),
intent(in) :: summary(nseed)
2180 type(trace_qperp_result),
intent(in) :: q_trace(nseed)
2181 type(trace_twist_result),
intent(in) :: q_twist(nseed)
2182 type(trace_qperp_result),
intent(in) :: q_short(nseed)
2183 type(trace_twist_result),
intent(in) :: q_short_twist(nseed)
2184 character(len=*),
intent(in) :: csv_file
2186 double precision :: seed_xyz(3),length_summary,length_q,length_diff
2187 double precision :: length_short,length_diff_short,length_q_short_diff
2188 double precision :: twist_summary,twist_q,twist_diff
2189 double precision :: twist_short,twist_diff_short,twist_q_short_diff
2190 double precision :: max_length_diff,max_twist_diff
2191 double precision :: max_length_short_diff,max_twist_short_diff
2192 integer :: csv_unit,io_status,iseed
2193 integer :: status_mismatch,face_mismatch,twist_status_mismatch
2194 integer :: short_status_mismatch,short_face_mismatch
2195 integer :: short_twist_status_mismatch,short_valid_q_mismatch
2197 max_length_diff=0.d0
2199 max_length_short_diff=0.d0
2200 max_twist_short_diff=0.d0
2203 twist_status_mismatch=0
2204 short_status_mismatch=0
2205 short_face_mismatch=0
2206 short_twist_status_mismatch=0
2207 short_valid_q_mismatch=0
2209 open(newunit=csv_unit,file=trim(csv_file),status=
'replace', &
2210 action=
'write',form=
'formatted',iostat=io_status)
2211 if (io_status/=0)
then
2212 call mpistop(
'mt_rk2_fusion_diagnostic could not open CSV file')
2215 write(csv_unit,
'(a)',iostat=io_status) &
2216 'seed_id,seed_x,seed_y,seed_z,'// &
2217 'length_summary,length_qtrace,dlength_summary_minus_qtrace,'// &
2218 'length_forward_summary,length_forward_qtrace,'// &
2219 'length_backward_summary,length_backward_qtrace,'// &
2220 'twist_summary,twist_qtrace,dtwist_summary_minus_qtrace,'// &
2221 'twist_forward_summary,twist_forward_qtrace,'// &
2222 'twist_backward_summary,twist_backward_qtrace,'// &
2223 'length_short,dlength_summary_minus_short,'// &
2224 'dlength_qtrace_minus_short,'// &
2225 'length_forward_short,length_backward_short,'// &
2226 'twist_short,dtwist_summary_minus_short,'// &
2227 'dtwist_qtrace_minus_short,'// &
2228 'twist_forward_short,twist_backward_short,'// &
2229 'status_forward_summary,status_forward_qtrace,status_forward_short,'// &
2230 'status_backward_summary,status_backward_qtrace,status_backward_short,'// &
2231 'face_forward_summary,face_forward_qtrace,face_forward_short,'// &
2232 'face_backward_summary,face_backward_qtrace,face_backward_short,'// &
2233 'status_twist_summary,status_twist_qtrace,status_twist_short,'// &
2234 'logQ,valid_Q,status_Q,logQ_short,valid_Q_short,status_Q_short'
2235 if (io_status/=0)
then
2237 call mpistop(
'mt_rk2_fusion_diagnostic could not write CSV header')
2242 seed_xyz(1:ndim)=summary(iseed)%seed
2243 length_summary=summary(iseed)%length_total
2244 length_q=q_trace(iseed)%forward_length+q_trace(iseed)%backward_length
2245 length_short=q_short(iseed)%forward_length+ &
2246 q_short(iseed)%backward_length
2247 length_diff=length_summary-length_q
2248 length_diff_short=length_summary-length_short
2249 length_q_short_diff=length_q-length_short
2250 twist_summary=summary(iseed)%twist_total
2251 twist_q=q_twist(iseed)%total_twist
2252 twist_short=q_short_twist(iseed)%total_twist
2253 twist_diff=twist_summary-twist_q
2254 twist_diff_short=twist_summary-twist_short
2255 twist_q_short_diff=twist_q-twist_short
2256 max_length_diff=max(max_length_diff,abs(length_diff))
2257 max_twist_diff=max(max_twist_diff,abs(twist_diff))
2258 max_length_short_diff=max(max_length_short_diff, &
2259 abs(length_diff_short))
2260 max_twist_short_diff=max(max_twist_short_diff, &
2261 abs(twist_diff_short))
2262 if (summary(iseed)%forward_status/=q_trace(iseed)%forward_status .or. &
2263 summary(iseed)%backward_status/=q_trace(iseed)%backward_status) &
2264 status_mismatch=status_mismatch+1
2265 if (summary(iseed)%forward_face/=q_trace(iseed)%forward_face .or. &
2266 summary(iseed)%backward_face/=q_trace(iseed)%backward_face) &
2267 face_mismatch=face_mismatch+1
2268 if (summary(iseed)%status_twist/=q_twist(iseed)%status_twist) &
2269 twist_status_mismatch=twist_status_mismatch+1
2270 if (summary(iseed)%forward_status/=q_short(iseed)%forward_status .or. &
2271 summary(iseed)%backward_status/=q_short(iseed)%backward_status) &
2272 short_status_mismatch=short_status_mismatch+1
2273 if (summary(iseed)%forward_face/=q_short(iseed)%forward_face .or. &
2274 summary(iseed)%backward_face/=q_short(iseed)%backward_face) &
2275 short_face_mismatch=short_face_mismatch+1
2276 if (summary(iseed)%status_twist/=q_short_twist(iseed)%status_twist) &
2277 short_twist_status_mismatch=short_twist_status_mismatch+1
2278 if (q_trace(iseed)%valid_q0 .neqv. q_short(iseed)%valid_q0) &
2279 short_valid_q_mismatch=short_valid_q_mismatch+1
2282 '(i0,3(",",es24.16),24(",",es24.16),15(",",i0),'// &
2283 '",",es24.16,",",l1,",",i0,",",es24.16,",",l1,",",i0)', &
2286 length_summary,length_q,length_diff, &
2287 summary(iseed)%length_forward,q_trace(iseed)%forward_length, &
2288 summary(iseed)%length_backward,q_trace(iseed)%backward_length, &
2289 twist_summary,twist_q,twist_diff, &
2290 summary(iseed)%twist_forward,q_twist(iseed)%forward_twist, &
2291 summary(iseed)%twist_backward,q_twist(iseed)%backward_twist, &
2292 length_short,length_diff_short,length_q_short_diff, &
2293 q_short(iseed)%forward_length,q_short(iseed)%backward_length, &
2294 twist_short,twist_diff_short,twist_q_short_diff, &
2295 q_short_twist(iseed)%forward_twist, &
2296 q_short_twist(iseed)%backward_twist, &
2297 summary(iseed)%forward_status,q_trace(iseed)%forward_status, &
2298 q_short(iseed)%forward_status, &
2299 summary(iseed)%backward_status,q_trace(iseed)%backward_status, &
2300 q_short(iseed)%backward_status, &
2301 summary(iseed)%forward_face,q_trace(iseed)%forward_face, &
2302 q_short(iseed)%forward_face, &
2303 summary(iseed)%backward_face,q_trace(iseed)%backward_face, &
2304 q_short(iseed)%backward_face, &
2305 summary(iseed)%status_twist,q_twist(iseed)%status_twist, &
2306 q_short_twist(iseed)%status_twist, &
2307 q_trace(iseed)%logq0,q_trace(iseed)%valid_q0, &
2308 q_trace(iseed)%status_q0, &
2309 q_short(iseed)%logq0,q_short(iseed)%valid_q0, &
2310 q_short(iseed)%status_q0
2311 if (io_status/=0)
then
2313 call mpistop(
'mt_rk2_fusion_diagnostic could not write CSV data')
2318 write(*,
'(a,es12.4)')
'mt_rk2_fusion_diagnostic max_abs_length_diff: ', &
2320 write(*,
'(a,es12.4)')
'mt_rk2_fusion_diagnostic max_abs_twist_diff: ', &
2322 write(*,
'(a,es12.4)') &
2323 'mt_rk2_fusion_diagnostic max_abs_length_diff_short: ', &
2324 max_length_short_diff
2325 write(*,
'(a,es12.4)') &
2326 'mt_rk2_fusion_diagnostic max_abs_twist_diff_short: ', &
2327 max_twist_short_diff
2328 write(*,
'(a,i0)')
'mt_rk2_fusion_diagnostic status_mismatch_count: ', &
2330 write(*,
'(a,i0)')
'mt_rk2_fusion_diagnostic face_mismatch_count: ', &
2333 'mt_rk2_fusion_diagnostic twist_status_mismatch_count: ', &
2334 twist_status_mismatch
2336 'mt_rk2_fusion_diagnostic short_status_mismatch_count: ', &
2337 short_status_mismatch
2339 'mt_rk2_fusion_diagnostic short_face_mismatch_count: ', &
2342 'mt_rk2_fusion_diagnostic short_twist_status_mismatch_count: ', &
2343 short_twist_status_mismatch
2345 'mt_rk2_fusion_diagnostic short_valid_q_mismatch_count: ', &
2346 short_valid_q_mismatch
2347 end subroutine mt_write_rk2_fusion_diagnostic_csv
2349 double precision function mt_absdiff_or_nan(a,b)
result(diff)
2350 double precision,
intent(in) :: a,b
2352 if (ieee_is_finite(a) .and. ieee_is_finite(b))
then
2355 diff=ieee_value(0.d0,ieee_quiet_nan)
2357 end function mt_absdiff_or_nan
2359 subroutine mt_fieldline_products_spherical_surface(surface,seed_coord, &
2360 s1_min,s1_max,n1,s2_min,s2_max,n2,dL,max_steps,csv_file, &
2361 vtu_file,seed_layout,seed_theta0,seed_phi0,seed_alpha, &
2362 compute_twist,compute_q,compute_qperp,b_min)
2363 character(len=*),
intent(in) :: surface,csv_file,vtu_file,seed_layout
2364 integer,
intent(in) :: n1,n2,max_steps
2365 double precision,
intent(in) :: seed_coord,s1_min,s1_max,s2_min,s2_max,dl
2366 double precision,
intent(in) :: seed_theta0,seed_phi0,seed_alpha
2367 logical,
intent(in),
optional :: compute_twist,compute_q,compute_qperp
2368 double precision,
intent(in),
optional :: b_min
2370 type(trace_topology_result),
allocatable :: topology(:)
2371 type(trace_qperp_result),
allocatable :: q_results(:)
2372 type(trace_qperp_result),
allocatable :: qperp_results(:)
2373 double precision,
allocatable :: seeds(:,:)
2375 logical :: do_twist,do_q,do_qperp
2378 call mpistop(
'mt_fieldline_products_spherical_surface currently '// &
2381 if (ndim/=3 .or. geo_coordinate/=geo_spherical)
then
2382 call mpistop(
'mt_fieldline_products_spherical_surface requires '// &
2383 '3D spherical geometry')
2386 call mt_validate_periodic_phi()
2388 if (n1<1 .or. n2<1)
then
2389 call mpistop(
'mt_fieldline_products_spherical_surface requires '// &
2390 'sample counts >=1')
2392 if (s1_max<s1_min .or. s2_max<s2_min)
then
2393 call mpistop(
'mt_fieldline_products_spherical_surface requires ordered bounds')
2398 if (
present(compute_twist)) do_twist=compute_twist
2399 if (
present(compute_q)) do_q=compute_q
2400 if (
present(compute_qperp)) do_qperp=compute_qperp
2401 call mt_build_spherical_surface_seeds(surface,seed_coord,s1_min,s1_max, &
2402 n1,s2_min,s2_max,n2,seed_layout,seed_theta0,seed_phi0, &
2405 if (mt_profile_spherical)
call trace_spherical_profile_count_seeds(nseed)
2406 allocate(topology(nseed))
2408 allocate(q_results(nseed))
2410 allocate(q_results(0))
2413 allocate(qperp_results(nseed))
2415 allocate(qperp_results(0))
2418 if (
present(b_min))
then
2419 call mt_trace_spherical_surface_products(seeds,nseed,dl,max_steps, &
2420 topology,q_results,qperp_results,do_twist,do_q,do_qperp,b_min)
2422 call mt_trace_spherical_surface_products(seeds,nseed,dl,max_steps, &
2423 topology,q_results,qperp_results,do_twist,do_q,do_qperp)
2426 if (len_trim(csv_file)>0)
then
2427 call mt_write_spherical_rmin_csv(topology,n1,n2,csv_file, &
2428 'mt_fieldline_products_spherical_surface',do_twist,do_q, &
2429 q_results,do_qperp,qperp_results)
2431 call mt_write_spherical_topology_vtu(vtu_file,topology,n1,n2, &
2432 'mt_fieldline_products_spherical_surface',do_twist,do_q,q_results, &
2433 do_qperp,qperp_results)
2435 deallocate(qperp_results,q_results,topology,seeds)
2436 end subroutine mt_fieldline_products_spherical_surface
2438 subroutine mt_fieldline_products_spherical_cloud(s1_min,s1_max,n1, &
2439 s2_min,s2_max,n2,s3_min,s3_max,n3,dL,max_steps,vtu_file, &
2440 seed_layout,compute_twist,compute_q,compute_qperp,b_min)
2441 character(len=*),
intent(in) :: vtu_file,seed_layout
2442 integer,
intent(in) :: n1,n2,n3,max_steps
2443 double precision,
intent(in) :: s1_min,s1_max,s2_min,s2_max
2444 double precision,
intent(in) :: s3_min,s3_max,dl
2445 logical,
intent(in),
optional :: compute_twist,compute_q,compute_qperp
2446 double precision,
intent(in),
optional :: b_min
2448 type(trace_topology_result),
allocatable :: topology(:)
2449 type(trace_qperp_result),
allocatable :: q_results(:)
2450 type(trace_qperp_result),
allocatable :: qperp_results(:)
2451 double precision,
allocatable :: seeds(:,:)
2453 logical :: do_twist,do_q,do_qperp
2454 character(len=mt_task_name_len) :: integrator
2457 call mpistop(
'mt_fieldline_products_spherical_cloud currently '// &
2460 if (ndim/=3 .or. geo_coordinate/=geo_spherical)
then
2461 call mpistop(
'mt_fieldline_products_spherical_cloud requires '// &
2462 '3D spherical geometry')
2465 call mt_validate_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
update ghost cells of all blocks including physical boundaries
subroutine getbc(time, qdt, psb, nwstart, nwbc)
do update ghost cells of all blocks including physical boundaries
This module contains definitions of global parameters and variables and some generic functions/subrou...
integer, parameter unitpar
file handle for IO
double precision global_time
The global simulation time.
integer, parameter ndim
Number of spatial dimensions for grid variables.
character(len=std_len), dimension(:), allocatable par_files
Which par files are used as input.
double precision, dimension(:), allocatable, parameter d
integer npe
The number of MPI tasks.
logical slab_uniform
uniform Cartesian geometry or not (stretched Cartesian)
subroutine, public mt_write_cartesian_vti_pointdata(vti_file, xmin, xmax, nx, ymin, ymax, ny, zmin, zmax, nz, length_total, qperp, status)
subroutine, public mt_fieldline_products_plane_arbitrary(origin, e1, e2, s1min, s1max, n1, s2min, s2max, n2, dl, max_steps, csv_file, b_min, compute_length, compute_twist, compute_q, compute_qperp, vtu_file, write_csv)
subroutine, public mt_twist_plane_yz(ymin, ymax, ny, zmin, zmax, nz, x0, dl, max_steps, csv_file, b_min)
subroutine, public mt_topology_plane_xy(xmin, xmax, nx, ymin, ymax, ny, z0, dl, max_steps, length_csv, twist_csv, mapping_csv, b_min)
subroutine, public mt_qsl_plane_vtu_yz(ymin, ymax, ny, zmin, zmax, nz, x0, dl, max_steps, vtu_file, b_min)
subroutine, public mt_qperp_plane_xz(xmin, xmax, nx, zmin, zmax, nz, y0, dl, max_steps, csv_file, b_min)
subroutine, public mt_qsl_plane_vtu_xy(xmin, xmax, nx, ymin, ymax, ny, z0, dl, max_steps, vtu_file, b_min)
subroutine, public mt_twist_plane_xz(xmin, xmax, nx, zmin, zmax, nz, y0, dl, max_steps, csv_file, b_min)
subroutine, public mt_length_plane_xy(xmin, xmax, nx, ymin, ymax, ny, z0, dl, max_steps, csv_file, b_min)
subroutine, public mt_fieldline_products_seeds(seeds, nseed, dl, max_steps, csv_file, b_min, compute_length, compute_twist, compute_q, compute_qperp, vtu_file)
subroutine, public mt_length_seeds(seeds, nseed, dl, max_steps, csv_file, b_min)
subroutine, public mt_topology_plane_yz(ymin, ymax, ny, zmin, zmax, nz, x0, dl, max_steps, length_csv, twist_csv, mapping_csv, b_min)
subroutine, public mt_qperp_plane_yz(ymin, ymax, ny, zmin, zmax, nz, x0, dl, max_steps, csv_file, b_min)
subroutine, public mt_qperp_plane_arbitrary(origin, e1, e2, s1min, s1max, n1, s2min, s2max, n2, dl, max_steps, csv_file, b_min)
subroutine, public mt_qperp_plane_xy(xmin, xmax, nx, ymin, ymax, ny, z0, dl, max_steps, csv_file, b_min)
subroutine, public mt_length_plane_xz(xmin, xmax, nx, zmin, zmax, nz, y0, dl, max_steps, csv_file, b_min)
subroutine, public mt_length_single(seed, dl, max_steps, csv_file, b_min)
subroutine, public mt_fieldline_products_volume_vti(xmin, xmax, nx, ymin, ymax, ny, zmin, zmax, nz, dl, max_steps, vti_file, b_min, compute_length, compute_twist, compute_q, compute_qperp, chunk_nz)
subroutine, public mt_qsl_plane_vtu_xz(xmin, xmax, nx, zmin, zmax, nz, y0, dl, max_steps, vtu_file, b_min)
subroutine, public mt_twist_plane_xy(xmin, xmax, nx, ymin, ymax, ny, z0, dl, max_steps, csv_file, b_min)
subroutine, public mt_params_read(files)
subroutine, public mt_topology_plane_xz(xmin, xmax, nx, zmin, zmax, nz, y0, dl, max_steps, length_csv, twist_csv, mapping_csv, b_min)
subroutine, public mt_mapping_plane_xy(xmin, xmax, nx, ymin, ymax, ny, z0, dl, max_steps, csv_file, b_min)
subroutine, public mt_twist_seeds(seeds, nseed, dl, max_steps, csv_file, b_min)
subroutine, public mt_length_plane_yz(ymin, ymax, ny, zmin, zmax, nz, x0, dl, max_steps, csv_file, b_min)
subroutine, public mt_run_topology_task()
subroutine, public mt_twist_single(seed, dl, max_steps, csv_file, b_min)
integer, parameter, public trace_face_ymin
integer, parameter, public trace_face_zmax
subroutine, public trace_spherical_profile_set(enabled)
subroutine, public trace_rk45_stats_reset()
subroutine, public trace_field_twist_multi(seeds, nseed, dl, max_steps, results, b_min)
subroutine, public trace_field_rk2_short_boundary_q_multi(seeds, nseed, dl, max_steps, results, b_min, twist_results)
subroutine, public trace_cartesian_global_min_cell_size(hmin, status)
subroutine, public trace_spherical_curl_cache_clear()
subroutine, public trace_field_qperp_multi(seeds, nseed, dl, max_steps, results, b_min, twist_results)
subroutine, public trace_field_spherical_rmin_q_multi(seeds, nseed, dl, max_steps, results, b_min, twist_results)
subroutine, public trace_rk45_stats_report(label)
subroutine, public trace_field_topology_multi(seeds, nseed, dl, max_steps, results, need_twist, need_mapping, b_min, source_normal)
integer, parameter, public trace_face_xmax
subroutine, public trace_field_twist_single(seed, dl, max_steps, result, b_min)
subroutine, public trace_field_mapping_single(seed, dl, max_steps, result, b_min, source_normal)
integer, parameter, public trace_face_none
integer, parameter, public trace_status_boundary
subroutine, public trace_spherical_profile_report(label)
integer, parameter, public trace_face_ambiguous
subroutine, public trace_field_qperp_single(seed, dl, max_steps, result, b_min)
integer, parameter, public trace_face_zmin
integer, parameter, public trace_status_unsupported_geometry
subroutine, public trace_set_step_control(mode, step_fraction, step_min)
subroutine, public trace_debug_cartesian_rk45_tangent_q0_multi(seeds, nseed, dl, max_steps, results, b_min)
integer, parameter, public trace_face_ymax
subroutine, public trace_spherical_global_min_cell_size(hmin, status)
subroutine, public trace_rk2_stats_reset()
subroutine, public trace_spherical_curl_cache_build(status)
subroutine, public trace_spherical_profile_count_seeds(nseed)
subroutine, public trace_spherical_profile_reset()
subroutine, public trace_field_spherical_rmin_q_qperp_multi(seeds, nseed, dl, max_steps, q_results, qperp_results, b_min, twist_results)
subroutine, public trace_field_length_multi(seeds, nseed, dl, max_steps, results, b_min)
subroutine, public trace_rk45_stats_set_enabled(enabled)
subroutine, public trace_set_integrator(mode, atol, rtol, safety, min_shrink, max_grow, tangent_floor, tangent_rtol)
subroutine, public trace_rk2_stats_set_enabled(enabled)
subroutine, public trace_field_spherical_qperp_multi(seeds, nseed, dl, max_steps, results, b_min, twist_results)
subroutine, public trace_rk2_stats_report(label)
logical function, public trace_periodic_phi_supported()
subroutine, public trace_field_length_single(seed, dl, max_steps, result, b_min)
integer, parameter, public trace_face_xmin
subroutine, public trace_field_mapping_multi(seeds, nseed, dl, max_steps, results, b_min, source_normal)
integer, parameter, public trace_status_active