5 #include "cpp_macros.h"
13 public :: af_loop_box_arg
14 public :: af_loop_boxes
15 public :: af_loop_boxes_arg
16 public :: af_loop_tree
17 public :: af_loop_tree_arg
18 public :: af_tree_clear_cc
19 public :: af_box_clear_cc
20 public :: af_tree_clear_ghostcells
21 public :: af_box_clear_ghostcells
22 public :: af_box_add_cc
23 public :: af_box_sub_cc
24 public :: af_tree_times_cc
25 public :: af_tree_apply
26 public :: af_box_times_cc
27 public :: af_box_lincomb_cc
28 public :: af_box_copy_cc_to
29 public :: af_box_copy_cc
30 public :: af_box_copy_ccs
31 public :: af_boxes_copy_cc
32 public :: af_boxes_copy_ccs
33 public :: af_tree_copy_cc
34 public :: af_tree_copy_ccs
35 public :: af_reduction
36 public :: af_reduction_vec
37 public :: af_reduction_loc
38 public :: af_tree_max_cc
39 public :: af_tree_maxabs_cc
40 public :: af_tree_min_cc
41 public :: af_tree_max_fc
42 public :: af_tree_min_fc
43 public :: af_tree_sum_cc
44 public :: af_box_copy_fc
45 public :: af_boxes_copy_fc
46 public :: af_tree_copy_fc
49 public :: af_get_id_at
57 subroutine af_loop_box(tree, my_procedure, leaves_only)
58 type(
af_t),
intent(inout) :: tree
59 procedure(
af_subr) :: my_procedure
60 logical,
intent(in),
optional :: leaves_only
64 leaves = .false.;
if (
present(leaves_only)) leaves = leaves_only
65 if (.not. tree%ready) stop
"af_loop_box: set_base has not been called"
68 do lvl = 1, tree%highest_lvl
71 do i = 1,
size(tree%lvls(lvl)%leaves)
72 id = tree%lvls(lvl)%leaves(i)
73 call my_procedure(tree%boxes(id))
78 do i = 1,
size(tree%lvls(lvl)%ids)
79 id = tree%lvls(lvl)%ids(i)
80 call my_procedure(tree%boxes(id))
86 end subroutine af_loop_box
89 subroutine af_loop_box_arg(tree, my_procedure, rarg, leaves_only)
90 type(
af_t),
intent(inout) :: tree
92 real(dp),
intent(in) :: rarg(:)
93 logical,
intent(in),
optional :: leaves_only
97 if (.not. tree%ready) stop
"Tree not ready"
98 leaves = .false.;
if (
present(leaves_only)) leaves = leaves_only
101 do lvl = 1, tree%highest_lvl
104 do i = 1,
size(tree%lvls(lvl)%leaves)
105 id = tree%lvls(lvl)%leaves(i)
106 call my_procedure(tree%boxes(id), rarg)
111 do i = 1,
size(tree%lvls(lvl)%ids)
112 id = tree%lvls(lvl)%ids(i)
113 call my_procedure(tree%boxes(id), rarg)
119 end subroutine af_loop_box_arg
122 subroutine af_loop_boxes(tree, my_procedure, leaves_only)
123 type(
af_t),
intent(inout) :: tree
125 logical,
intent(in),
optional :: leaves_only
127 integer :: lvl, i, id
129 if (.not. tree%ready) stop
"Tree not ready"
130 leaves = .false.;
if (
present(leaves_only)) leaves = leaves_only
133 do lvl = 1, tree%highest_lvl
136 do i = 1,
size(tree%lvls(lvl)%leaves)
137 id = tree%lvls(lvl)%leaves(i)
138 call my_procedure(tree%boxes, id)
143 do i = 1,
size(tree%lvls(lvl)%ids)
144 id = tree%lvls(lvl)%ids(i)
145 call my_procedure(tree%boxes, id)
151 end subroutine af_loop_boxes
154 subroutine af_loop_boxes_arg(tree, my_procedure, rarg, leaves_only)
155 type(
af_t),
intent(inout) :: tree
157 real(dp),
intent(in) :: rarg(:)
158 logical,
intent(in),
optional :: leaves_only
160 integer :: lvl, i, id
162 if (.not. tree%ready) stop
"Tree not ready"
163 leaves = .false.;
if (
present(leaves_only)) leaves = leaves_only
166 do lvl = 1, tree%highest_lvl
169 do i = 1,
size(tree%lvls(lvl)%leaves)
170 id = tree%lvls(lvl)%leaves(i)
171 call my_procedure(tree%boxes, id, rarg)
176 do i = 1,
size(tree%lvls(lvl)%ids)
177 id = tree%lvls(lvl)%ids(i)
178 call my_procedure(tree%boxes, id, rarg)
184 end subroutine af_loop_boxes_arg
187 subroutine af_loop_tree(tree, my_procedure, leaves_only)
188 type(
af_t),
intent(inout) :: tree
190 logical,
intent(in),
optional :: leaves_only
194 if (.not. tree%ready) stop
"Tree not ready"
195 leaves = .false.;
if (
present(leaves_only)) leaves = leaves_only
198 do lvl = 1, tree%highest_lvl
201 do i = 1,
size(tree%lvls(lvl)%leaves)
202 call my_procedure(tree, tree%lvls(lvl)%leaves(i))
207 do i = 1,
size(tree%lvls(lvl)%ids)
208 call my_procedure(tree, tree%lvls(lvl)%ids(i))
214 end subroutine af_loop_tree
217 subroutine af_loop_tree_arg(tree, my_procedure, rarg, leaves_only)
218 type(
af_t),
intent(inout) :: tree
220 real(dp),
intent(in) :: rarg(:)
221 logical,
intent(in),
optional :: leaves_only
225 if (.not. tree%ready) stop
"Tree not ready"
226 leaves = .false.;
if (
present(leaves_only)) leaves = leaves_only
229 do lvl = 1, tree%highest_lvl
232 do i = 1,
size(tree%lvls(lvl)%leaves)
233 call my_procedure(tree, tree%lvls(lvl)%leaves(i), rarg)
238 do i = 1,
size(tree%lvls(lvl)%ids)
239 call my_procedure(tree, tree%lvls(lvl)%leaves(i), rarg)
245 end subroutine af_loop_tree_arg
248 pure function af_r_inside(box, r, d)
result(inside)
249 type(
box_t),
intent(in) :: box
250 real(dp),
intent(in) :: r(ndim)
251 real(dp),
intent(in),
optional :: d
252 real(dp) :: r_max(ndim)
255 r_max = box%r_min + box%dr * box%n_cell
257 inside = all(r+d >= box%r_min) .and. all(r-d <= r_max)
259 inside = all(r >= box%r_min) .and. all(r <= r_max)
261 end function af_r_inside
266 pure function af_get_id_at(tree, rr, highest_lvl, guess)
result(id)
267 type(
af_t),
intent(in) :: tree
268 real(dp),
intent(in) :: rr(ndim)
269 integer,
intent(in),
optional :: highest_lvl
270 integer,
intent(in),
optional :: guess
273 integer :: i, id_tmp, i_ch, lvl_max
276 if (
present(highest_lvl)) lvl_max = highest_lvl
280 if (
present(guess))
then
282 if (guess > 0 .and. guess < tree%highest_id)
then
283 if (tree%boxes(guess)%in_use .and. &
284 tree%boxes(guess)%lvl <= lvl_max .and. &
285 af_r_inside(tree%boxes(guess), rr))
then
293 do i = 1,
size(tree%lvls(1)%ids)
294 id_tmp = tree%lvls(1)%ids(i)
295 if (af_r_inside(tree%boxes(id_tmp), rr))
then
305 if (tree%boxes(id)%lvl >= lvl_max .or. &
306 .not. af_has_children(tree%boxes(id)))
exit
307 i_ch = child_that_contains(tree%boxes(id), rr)
308 id = tree%boxes(id)%children(i_ch)
312 end function af_get_id_at
317 pure function af_get_loc(tree, rr, highest_lvl, guess)
result(loc)
318 type(
af_t),
intent(in) :: tree
319 real(dp),
intent(in) :: rr(ndim)
320 integer,
intent(in),
optional :: highest_lvl
322 integer,
intent(in),
optional :: guess
325 loc%id = af_get_id_at(tree, rr, highest_lvl, guess)
327 if (loc%id == -1)
then
330 loc%ix = af_cc_ix(tree%boxes(loc%id), rr)
334 where (loc%ix < 1) loc%ix = 1
335 where (loc%ix > tree%n_cell) loc%ix = tree%n_cell
337 end function af_get_loc
340 pure function child_that_contains(box, rr)
result(i_ch)
341 type(
box_t),
intent(in) :: box
342 real(dp),
intent(in) :: rr(ndim)
344 real(dp) :: center(ndim)
347 center = box%r_min + box%dr * ishft(box%n_cell, -1)
349 if (rr(1) > center(1)) i_ch = i_ch + 1
351 if (rr(2) > center(2)) i_ch = i_ch + 2
354 if (rr(3) > center(3)) i_ch = i_ch + 4
356 end function child_that_contains
359 pure function af_r_loc(tree, loc)
result(r)
360 type(
af_t),
intent(in) :: tree
363 r = tree%boxes(loc%id)%r_min + &
364 (loc%ix-0.5_dp) * tree%boxes(loc%id)%dr
365 end function af_r_loc
367 subroutine af_tree_clear_cc(tree, iv)
368 type(
af_t),
intent(inout) :: tree
369 integer,
intent(in) :: iv
370 integer :: lvl, i, id
373 do lvl = 1, tree%highest_lvl
375 do i = 1,
size(tree%lvls(lvl)%ids)
376 id = tree%lvls(lvl)%ids(i)
377 call af_box_clear_cc(tree%boxes(id), iv)
382 end subroutine af_tree_clear_cc
385 subroutine af_box_clear_cc(box, iv)
386 type(
box_t),
intent(inout) :: box
387 integer,
intent(in) :: iv
388 box%cc(dtimes(:), iv) = 0
389 end subroutine af_box_clear_cc
391 subroutine af_tree_clear_ghostcells(tree, iv)
392 type(
af_t),
intent(inout) :: tree
393 integer,
intent(in) :: iv
394 integer :: lvl, i, id
397 do lvl = 1, tree%highest_lvl
399 do i = 1,
size(tree%lvls(lvl)%ids)
400 id = tree%lvls(lvl)%ids(i)
401 call af_box_clear_ghostcells(tree%boxes(id), iv)
406 end subroutine af_tree_clear_ghostcells
409 subroutine af_box_clear_ghostcells(box, iv)
410 type(
box_t),
intent(inout) :: box
411 integer,
intent(in) :: iv
421 box%cc(nc+1, :, iv) = 0
423 box%cc(:, nc+1, iv) = 0
425 box%cc(0, :, :, iv) = 0
426 box%cc(nc+1, :, :, iv) = 0
427 box%cc(:, 0, :, iv) = 0
428 box%cc(:, nc+1, :, iv) = 0
429 box%cc(:, :, 0, iv) = 0
430 box%cc(:, :, nc+1, iv) = 0
432 end subroutine af_box_clear_ghostcells
435 subroutine af_box_add_cc(box, iv_from, iv_to)
436 type(
box_t),
intent(inout) :: box
437 integer,
intent(in) :: iv_from, iv_to
438 box%cc(dtimes(:), iv_to) = box%cc(dtimes(:), iv_to) + &
439 box%cc(dtimes(:), iv_from)
440 end subroutine af_box_add_cc
443 subroutine af_box_sub_cc(box, iv_from, iv_to)
444 type(
box_t),
intent(inout) :: box
445 integer,
intent(in) :: iv_from, iv_to
446 box%cc(dtimes(:), iv_to) = box%cc(dtimes(:), iv_to) - &
447 box%cc(dtimes(:), iv_from)
448 end subroutine af_box_sub_cc
452 subroutine af_tree_apply(tree, iv_a, iv_b, op, eps)
453 type(
af_t),
intent(inout) :: tree
454 integer,
intent(in) :: iv_a, iv_b
455 character(len=*),
intent(in) :: op
456 real(dp),
intent(in),
optional :: eps
457 integer :: lvl, i, id
460 use_eps = sqrt(tiny(1.0_dp))
461 if (
present(eps)) use_eps = eps
464 do lvl = 1, tree%highest_lvl
466 do i = 1,
size(tree%lvls(lvl)%ids)
467 id = tree%lvls(lvl)%ids(i)
470 tree%boxes(id)%cc(dtimes(:), iv_a) = &
471 tree%boxes(id)%cc(dtimes(:), iv_a) + &
472 tree%boxes(id)%cc(dtimes(:), iv_b)
474 tree%boxes(id)%cc(dtimes(:), iv_a) = &
475 tree%boxes(id)%cc(dtimes(:), iv_a) * &
476 tree%boxes(id)%cc(dtimes(:), iv_b)
478 tree%boxes(id)%cc(dtimes(:), iv_a) = &
479 tree%boxes(id)%cc(dtimes(:), iv_a) / &
480 max(tree%boxes(id)%cc(dtimes(:), iv_b), eps)
482 error stop
"af_tree_apply: unknown operand"
488 end subroutine af_tree_apply
490 subroutine af_tree_times_cc(tree, ivs, facs)
491 type(
af_t),
intent(inout) :: tree
492 integer,
intent(in) :: ivs(:)
493 real(dp),
intent(in) :: facs(:)
494 integer :: lvl, i, id, n
496 if (
size(ivs) /=
size(facs)) &
497 error stop
"af_times_cc: invalid array size"
500 do lvl = 1, tree%highest_lvl
502 do i = 1,
size(tree%lvls(lvl)%ids)
503 id = tree%lvls(lvl)%ids(i)
505 call af_box_times_cc(tree%boxes(id), facs(n), ivs(n))
511 end subroutine af_tree_times_cc
514 subroutine af_box_times_cc(box, a, iv)
515 type(
box_t),
intent(inout) :: box
516 real(dp),
intent(in) :: a
517 integer,
intent(in) :: iv
518 box%cc(dtimes(:), iv) = a * box%cc(dtimes(:), iv)
519 end subroutine af_box_times_cc
522 subroutine af_box_lincomb_cc(box, a, iv_a, b, iv_b)
523 type(
box_t),
intent(inout) :: box
524 real(dp),
intent(in) :: a, b
525 integer,
intent(in) :: iv_a, iv_b
526 box%cc(dtimes(:), iv_b) = a * box%cc(dtimes(:), iv_a) + &
527 b * box%cc(dtimes(:), iv_b)
528 end subroutine af_box_lincomb_cc
531 subroutine af_box_copy_cc_to(box_from, iv_from, box_to, iv_to)
532 type(
box_t),
intent(in) :: box_from
533 type(
box_t),
intent(inout) :: box_to
534 integer,
intent(in) :: iv_from, iv_to
535 box_to%cc(dtimes(:), iv_to) = box_from%cc(dtimes(:), iv_from)
536 end subroutine af_box_copy_cc_to
539 subroutine af_box_copy_cc(box, iv_from, iv_to)
540 type(
box_t),
intent(inout) :: box
541 integer,
intent(in) :: iv_from, iv_to
542 box%cc(dtimes(:), iv_to) = box%cc(dtimes(:), iv_from)
543 end subroutine af_box_copy_cc
546 subroutine af_box_copy_ccs(box, iv_from, iv_to)
547 type(
box_t),
intent(inout) :: box
548 integer,
intent(in) :: iv_from(:), iv_to(:)
549 box%cc(dtimes(:), iv_to) = box%cc(dtimes(:), iv_from)
550 end subroutine af_box_copy_ccs
553 subroutine af_boxes_copy_cc(boxes, ids, iv_from, iv_to)
554 type(
box_t),
intent(inout) :: boxes(:)
555 integer,
intent(in) :: ids(:), iv_from, iv_to
560 call af_box_copy_cc(boxes(ids(i)), iv_from, iv_to)
563 end subroutine af_boxes_copy_cc
566 subroutine af_boxes_copy_ccs(boxes, ids, iv_from, iv_to)
567 type(
box_t),
intent(inout) :: boxes(:)
568 integer,
intent(in) :: ids(:), iv_from(:), iv_to(:)
573 call af_box_copy_ccs(boxes(ids(i)), iv_from, iv_to)
576 end subroutine af_boxes_copy_ccs
579 subroutine af_tree_copy_cc(tree, iv_from, iv_to)
580 type(
af_t),
intent(inout) :: tree
581 integer,
intent(in) :: iv_from, iv_to
584 do lvl = 1, tree%highest_lvl
585 call af_boxes_copy_cc(tree%boxes, tree%lvls(lvl)%ids, iv_from, iv_to)
587 end subroutine af_tree_copy_cc
590 subroutine af_tree_copy_ccs(tree, iv_from, iv_to)
591 type(
af_t),
intent(inout) :: tree
592 integer,
intent(in) :: iv_from(:), iv_to(:)
595 do lvl = 1, tree%highest_lvl
596 call af_boxes_copy_ccs(tree%boxes, tree%lvls(lvl)%ids, iv_from, iv_to)
598 end subroutine af_tree_copy_ccs
601 subroutine af_reduction(tree, box_func, reduction, init_val, out_val)
602 type(
af_t),
intent(in) :: tree
603 real(dp),
intent(in) :: init_val
604 real(dp),
intent(out) :: out_val
605 real(dp) :: tmp, my_val
606 integer :: i, id, lvl
610 real(dp) function box_func(box)
612 type(
box_t),
intent(in) :: box
613 end function box_func
616 real(dp) function reduction(a, b)
618 real(dp),
intent(in) :: a, b
619 end function reduction
622 if (.not. tree%ready) stop
"Tree not ready"
627 do lvl = 1, tree%highest_lvl
629 do i = 1,
size(tree%lvls(lvl)%leaves)
630 id = tree%lvls(lvl)%leaves(i)
631 tmp = box_func(tree%boxes(id))
632 my_val = reduction(tmp, my_val)
638 out_val = reduction(my_val, out_val)
641 end subroutine af_reduction
644 subroutine af_reduction_vec(tree, box_func, reduction, init_val, &
646 type(af_t),
intent(in) :: tree
647 integer,
intent(in) :: n_vals
648 real(dp),
intent(in) :: init_val(n_vals)
649 real(dp),
intent(out) :: out_val(n_vals)
650 real(dp) :: tmp(n_vals), my_val(n_vals)
651 integer :: i, id, lvl
655 function box_func(box, n_vals)
result(vec)
657 type(box_t),
intent(in) :: box
658 integer,
intent(in) :: n_vals
659 real(dp) :: vec(n_vals)
660 end function box_func
663 function reduction(vec_1, vec_2, n_vals)
result(vec)
665 integer,
intent(in) :: n_vals
666 real(dp),
intent(in) :: vec_1(n_vals), vec_2(n_vals)
667 real(dp) :: vec(n_vals)
668 end function reduction
671 if (.not. tree%ready) stop
"Tree not ready"
676 do lvl = 1, tree%highest_lvl
678 do i = 1,
size(tree%lvls(lvl)%leaves)
679 id = tree%lvls(lvl)%leaves(i)
680 tmp = box_func(tree%boxes(id), n_vals)
681 my_val = reduction(tmp, my_val, n_vals)
687 out_val = reduction(my_val, out_val, n_vals)
690 end subroutine af_reduction_vec
694 subroutine af_reduction_loc(tree, iv, box_subr, reduction, &
695 init_val, out_val, out_loc)
696 type(af_t),
intent(in) :: tree
697 integer,
intent(in) :: iv
698 real(dp),
intent(in) :: init_val
699 real(dp),
intent(out) :: out_val
700 type(af_loc_t),
intent(out) :: out_loc
701 real(dp) :: tmp, new_val, my_val
702 integer :: i, id, lvl, tmp_ix(ndim)
703 type(af_loc_t) :: my_loc
707 subroutine box_subr(box, iv, val, ix)
709 type(box_t),
intent(in) :: box
710 integer,
intent(in) :: iv
711 real(dp),
intent(out) :: val
712 integer,
intent(out) :: ix(ndim)
713 end subroutine box_subr
716 real(dp) function reduction(a, b)
718 real(dp),
intent(in) :: a, b
719 end function reduction
722 if (.not. tree%ready) stop
"Tree not ready"
730 do lvl = 1, tree%highest_lvl
732 do i = 1,
size(tree%lvls(lvl)%leaves)
733 id = tree%lvls(lvl)%leaves(i)
734 call box_subr(tree%boxes(id), iv, tmp, tmp_ix)
735 new_val = reduction(tmp, my_val)
736 if (abs(new_val - my_val) > 0)
then
746 new_val = reduction(my_val, out_val)
747 if (abs(new_val - out_val) > 0)
then
748 out_loc%id = my_loc%id
749 out_loc%ix = my_loc%ix
754 end subroutine af_reduction_loc
758 subroutine af_tree_max_cc(tree, iv, cc_max, loc)
759 type(af_t),
intent(in) :: tree
760 integer,
intent(in) :: iv
761 real(dp),
intent(out) :: cc_max
763 type(af_loc_t),
intent(out),
optional :: loc
764 type(af_loc_t) :: tmp_loc
766 call af_reduction_loc(tree, iv, box_max_cc, reduce_max, &
767 -huge(1.0_dp)/10, cc_max, tmp_loc)
768 if (
present(loc)) loc = tmp_loc
769 end subroutine af_tree_max_cc
773 subroutine af_tree_maxabs_cc(tree, iv, cc_max, loc)
774 type(af_t),
intent(in) :: tree
775 integer,
intent(in) :: iv
776 real(dp),
intent(out) :: cc_max
778 type(af_loc_t),
intent(out),
optional :: loc
779 type(af_loc_t) :: tmp_loc
781 call af_reduction_loc(tree, iv, box_maxabs_cc, reduce_max, &
782 -huge(1.0_dp)/10, cc_max, tmp_loc)
783 if (
present(loc)) loc = tmp_loc
784 end subroutine af_tree_maxabs_cc
788 subroutine af_tree_min_cc(tree, iv, cc_min, loc)
789 type(af_t),
intent(in) :: tree
790 integer,
intent(in) :: iv
791 real(dp),
intent(out) :: cc_min
793 type(af_loc_t),
intent(out),
optional :: loc
794 type(af_loc_t) :: tmp_loc
796 call af_reduction_loc(tree, iv, box_min_cc, reduce_min, &
797 huge(1.0_dp)/10, cc_min, tmp_loc)
799 if (
present(loc)) loc = tmp_loc
800 end subroutine af_tree_min_cc
803 subroutine af_tree_max_fc(tree, dim, iv, fc_max, loc)
804 type(af_t),
intent(in) :: tree
805 integer,
intent(in) :: dim
806 integer,
intent(in) :: iv
807 real(dp),
intent(out) :: fc_max
809 type(af_loc_t),
intent(out),
optional :: loc
810 type(af_loc_t) :: tmp_loc
814 dim_iv = (dim-1) * tree%n_var_face + iv - 1
816 call af_reduction_loc(tree, dim_iv, box_max_fc, reduce_max, &
817 -huge(1.0_dp)/10, fc_max, tmp_loc)
818 if (
present(loc)) loc = tmp_loc
819 end subroutine af_tree_max_fc
822 subroutine af_tree_min_fc(tree, dim, iv, fc_min, loc)
823 type(af_t),
intent(in) :: tree
824 integer,
intent(in) :: dim
825 integer,
intent(in) :: iv
826 real(dp),
intent(out) :: fc_min
828 type(af_loc_t),
intent(out),
optional :: loc
829 type(af_loc_t) :: tmp_loc
833 dim_iv = (dim-1) * tree%n_var_face + iv - 1
835 call af_reduction_loc(tree, dim_iv, box_min_fc, reduce_min, &
836 huge(1.0_dp)/10, fc_min, tmp_loc)
837 if (
present(loc)) loc = tmp_loc
838 end subroutine af_tree_min_fc
840 subroutine box_max_cc(box, iv, val, ix)
841 type(box_t),
intent(in) :: box
842 integer,
intent(in) :: iv
843 real(dp),
intent(out) :: val
844 integer,
intent(out) :: ix(NDIM)
848 ix = maxloc(box%cc(dtimes(1:nc), iv))
849 val = box%cc(dindex(ix), iv)
850 end subroutine box_max_cc
852 subroutine box_maxabs_cc(box, iv, val, ix)
853 type(box_t),
intent(in) :: box
854 integer,
intent(in) :: iv
855 real(dp),
intent(out) :: val
856 integer,
intent(out) :: ix(NDIM)
860 ix = maxloc(abs(box%cc(dtimes(1:nc), iv)))
861 val = abs(box%cc(dindex(ix), iv))
862 end subroutine box_maxabs_cc
864 subroutine box_min_cc(box, iv, val, ix)
865 type(box_t),
intent(in) :: box
866 integer,
intent(in) :: iv
867 real(dp),
intent(out) :: val
868 integer,
intent(out) :: ix(NDIM)
872 ix = minloc(box%cc(dtimes(1:nc), iv))
873 val = box%cc(dindex(ix), iv)
874 end subroutine box_min_cc
876 subroutine box_max_fc(box, dim_iv, val, ix)
877 type(box_t),
intent(in) :: box
878 integer,
intent(in) :: dim_iv
879 real(dp),
intent(out) :: val
880 integer,
intent(out) :: ix(NDIM)
881 integer :: dim, iv, n_fc, nc, dix(NDIM)
887 n_fc =
size(box%fc, 3)
892 ix = maxloc(box%fc(1:nc+1, dim, iv))
893 val = box%fc(ix(1), dim, iv)
895 n_fc =
size(box%fc, 4)
898 dim = dim_iv / n_fc + 1
899 iv = dim_iv - (dim-1) * n_fc + 1
902 ix = maxloc(box%fc(1:nc+dix(1), 1:nc+dix(2), dim, iv))
903 val = box%fc(ix(1), ix(2), dim, iv)
905 n_fc =
size(box%fc, 5)
907 dim = dim_iv / n_fc + 1
909 iv = dim_iv - (dim-1) * n_fc + 1
910 ix = maxloc(box%fc(1:nc+dix(1), 1:nc+dix(2), 1:nc+dix(3), dim, iv))
911 val = box%fc(ix(1), ix(2), ix(3), dim, iv)
913 end subroutine box_max_fc
915 subroutine box_min_fc(box, dim_iv, val, ix)
916 type(box_t),
intent(in) :: box
917 integer,
intent(in) :: dim_iv
918 real(dp),
intent(out) :: val
919 integer,
intent(out) :: ix(NDIM)
920 integer :: dim, iv, n_fc, nc, dix(NDIM)
926 n_fc =
size(box%fc, 3)
931 ix = minloc(box%fc(1:nc+1, dim, iv))
932 val = box%fc(ix(1), dim, iv)
934 n_fc =
size(box%fc, 4)
937 dim = dim_iv / n_fc + 1
938 iv = dim_iv - (dim-1) * n_fc + 1
941 ix = minloc(box%fc(1:nc+dix(1), 1:nc+dix(2), dim, iv))
942 val = box%fc(ix(1), ix(2), dim, iv)
944 n_fc =
size(box%fc, 5)
946 dim = dim_iv / n_fc + 1
948 iv = dim_iv - (dim-1) * n_fc + 1
949 ix = minloc(box%fc(1:nc+dix(1), 1:nc+dix(2), 1:nc+dix(3), dim, iv))
950 val = box%fc(ix(1), ix(2), ix(3), dim, iv)
952 end subroutine box_min_fc
954 real(dp) function reduce_max(a, b)
955 real(dp),
intent(in) :: a, b
956 reduce_max = max(a, b)
957 end function reduce_max
959 real(dp) function reduce_min(a, b)
960 real(dp),
intent(in) :: a, b
961 reduce_min = min(a, b)
962 end function reduce_min
966 subroutine af_tree_sum_cc(tree, iv, cc_sum, power)
967 type(af_t),
intent(in) :: tree
968 integer,
intent(in) :: iv
969 real(dp),
intent(out) :: cc_sum
970 integer,
intent(in),
optional :: power
971 real(dp) :: tmp, my_sum, fac
972 integer :: i, id, lvl, nc, pow
974 pow = 1;
if (
present(power)) pow = power
976 if (.not. tree%ready) stop
"Tree not ready"
980 do lvl = 1, tree%highest_lvl
981 fac = product(af_lvl_dr(tree, lvl))
984 do i = 1,
size(tree%lvls(lvl)%leaves)
985 id = tree%lvls(lvl)%leaves(i)
986 nc = tree%boxes(id)%n_cell
988 if (tree%coord_t == af_cyl)
then
989 tmp = sum_2pr_box(tree%boxes(id), iv)
991 tmp = sum(tree%boxes(id)%cc(1:nc, 1:nc, iv)**pow)
994 tmp = sum(tree%boxes(id)%cc(dtimes(1:nc), iv)**pow)
996 my_sum = my_sum + fac * tmp
1008 pure function sum_2pr_box(box, iv)
result(res)
1009 type(box_t),
intent(in) :: box
1010 integer,
intent(in) :: iv
1011 real(dp),
parameter :: twopi = 2 * acos(-1.0_dp)
1020 res = res + box%cc(i, j, iv)**pow * af_cyl_radius_cc(box, i)
1024 end function sum_2pr_box
1026 end subroutine af_tree_sum_cc
1029 subroutine af_box_copy_fc(box, iv_from, iv_to)
1030 type(box_t),
intent(inout) :: box
1031 integer,
intent(in) :: iv_from
1032 integer,
intent(in) :: iv_to
1033 box%fc(dtimes(:),:, iv_to) = box%fc(dtimes(:),:, iv_from)
1034 end subroutine af_box_copy_fc
1037 subroutine af_boxes_copy_fc(boxes, ids, iv_from, iv_to)
1038 type(box_t),
intent(inout) :: boxes(:)
1039 integer,
intent(in) :: ids(:)
1040 integer,
intent(in) :: iv_from
1041 integer,
intent(in) :: iv_to
1046 call af_box_copy_fc(boxes(ids(i)), iv_from, iv_to)
1049 end subroutine af_boxes_copy_fc
1052 subroutine af_tree_copy_fc(tree, iv_from, iv_to)
1053 type(af_t),
intent(inout) :: tree
1054 integer,
intent(in) :: iv_from
1055 integer,
intent(in) :: iv_to
1058 if (.not. tree%ready) stop
"Tree not ready"
1059 do lvl = 1, tree%highest_lvl
1060 call af_boxes_copy_fc(tree%boxes, tree%lvls(lvl)%ids, iv_from, iv_to)
1062 end subroutine af_tree_copy_fc
Subroutine that gets a box and an array of reals.
Subroutine that gets a list of boxes, an id and an array of reals.
Subroutine that gets a list of boxes and a box id.
Subroutine that gets a tree, a box id and an array of reals.
Subroutine that gets a tree and a box id.
Subroutine that gets a box.
This module contains the basic types and constants that are used in the NDIM-dimensional version of A...
This module contains all kinds of different 'helper' routines for Afivo. If the number of routines fo...
Type specifying the location of a cell.
Type which stores all the boxes and levels, as well as some information about the number of boxes,...
The basic building block of afivo: a box with cell-centered and face centered data,...