3 #include "sll_working_precision.h"
17 use sll_m_remapper,
only: &
18 sll_o_compute_local_sizes, &
73 type(sll_t_layout_2d),
pointer :: layout
75 sll_real64,
dimension(:, :),
intent(out) :: array
77 sll_real64,
dimension(:),
intent(in) :: func_params
81 sll_int32 :: loc_size_x1
82 sll_int32 :: loc_size_x2
85 sll_real64 :: eta1_min
86 sll_real64 :: eta2_min
91 sll_int32,
dimension(1:2) :: gi
93 if (.not.
associated(layout))
then
94 print *,
'#sll_o_2d_parallel_array_initializer_cartesian error: ', &
95 '#passed layout is uninitialized.'
98 if (.not.
associated(mesh2d))
then
99 print *,
'#sll_o_2d_parallel_array_initializer_cartesian error: ', &
100 '#passed mesh2d_eta1_eta2 argument is uninitialized.'
103 call sll_o_compute_local_sizes(layout, loc_size_x1, loc_size_x2)
105 if (
size(array, 1) .lt. loc_size_x1)
then
106 print *,
'#sll_o_2d_parallel_array_initializer_cartesian error: ', &
107 '#first dimension of passed array is inconsistent with ', &
108 '#the size contained in the passed layout.'
111 if (
size(array, 2) .lt. loc_size_x2)
then
112 print *,
'#sll_o_2d_parallel_array_initializer_cartesian error: ', &
113 '#second dimension of passed array is inconsistent with ', &
114 '#the size contained in the passed layout.'
117 eta1_min = mesh2d%eta1_min
118 eta2_min = mesh2d%eta2_min
119 delta1 = mesh2d%delta_eta1
120 delta2 = mesh2d%delta_eta2
125 do j = 1, loc_size_x2
126 do i = 1, loc_size_x1
127 gi(:) = sll_o_local_to_global(layout, (/i, j/))
128 eta1 = eta1_min + real(gi(1) - 1, f64)*delta1
129 eta2 = eta2_min + real(gi(2) - 1, f64)*delta2
130 array(i, j) = func(eta1, eta2, func_params)
144 type(sll_t_layout_2d),
pointer :: layout
145 sll_real64,
dimension(:),
intent(in) :: x1_array
146 sll_real64,
dimension(:),
intent(in) :: x2_array
147 sll_real64,
dimension(:, :),
intent(out) :: array
149 sll_real64,
dimension(:),
intent(in) :: func_params
153 sll_int32 :: loc_size_x1
154 sll_int32 :: loc_size_x2
157 sll_int32,
dimension(1:2) :: gi
159 if (.not.
associated(layout))
then
160 print *,
'#sll_o_2d_parallel_array_initializer_cartesian error: ', &
161 '#passed layout is uninitialized.'
169 call sll_o_compute_local_sizes(layout, loc_size_x1, loc_size_x2)
171 if (
size(array, 1) .lt. loc_size_x1)
then
172 print *,
'#sll_o_2d_parallel_array_initializer_cartesian error: ', &
173 '#first dimension of passed array is inconsistent with ', &
174 '#the size contained in the passed layout.'
177 if (
size(array, 2) .lt. loc_size_x2)
then
178 print *,
'#sll_o_2d_parallel_array_initializer_cartesian error: ', &
179 '#second dimension of passed array is inconsistent with ', &
180 '#the size contained in the passed layout.'
183 do j = 1, loc_size_x2
184 do i = 1, loc_size_x1
185 gi(:) = sll_o_local_to_global(layout, (/i, j/))
186 eta1 = x1_array(gi(1))
187 eta2 = x2_array(gi(2))
188 array(i, j) = func(eta1, eta2, func_params)
207 type(sll_t_layout_4d),
pointer :: layout
208 sll_real64,
intent(in) :: eta1_min
209 sll_real64,
intent(in) :: eta2_min
210 sll_real64,
intent(in) :: eta3_min
211 sll_real64,
intent(in) :: eta4_min
212 sll_real64,
intent(in) :: delta1
213 sll_real64,
intent(in) :: delta2
214 sll_real64,
intent(in) :: delta3
215 sll_real64,
intent(in) :: delta4
216 sll_real64,
dimension(:, :, :, :),
intent(out) :: array
218 sll_real64,
dimension(:),
intent(in) :: func_params
223 sll_int32 :: loc_size_x1
224 sll_int32 :: loc_size_x2
225 sll_int32 :: loc_size_x3
226 sll_int32 :: loc_size_x4
235 sll_int32,
dimension(1:4) :: gi
237 if (.not.
associated(layout))
then
238 print *,
'sll_o_4d_parallel_array_initializer error: ', &
239 'passed layout is uninitialized.'
242 call sll_o_compute_local_sizes(layout, loc_size_x1, loc_size_x2, loc_size_x3, &
245 if (
size(array, 1) .lt. loc_size_x1)
then
246 print *,
'sll_o_4d_parallel_array_initializer error: ', &
247 'first dimension of passed array is inconsistent with ', &
248 'the size contained in the passed layout.'
251 if (
size(array, 2) .lt. loc_size_x2)
then
252 print *,
'sll_o_4d_parallel_array_initializer error: ', &
253 'second dimension of passed array is inconsistent with ', &
254 'the size contained in the passed layout.'
257 if (
size(array, 3) .lt. loc_size_x3)
then
258 print *,
'sll_o_4d_parallel_array_initializer error: ', &
259 'third dimension of passed array is inconsistent with ', &
260 'the size contained in the passed layout.'
263 if (
size(array, 4) .lt. loc_size_x4)
then
264 print *,
'sll_o_4d_parallel_array_initializer error: ', &
265 'fourth dimension of passed array is inconsistent with ', &
266 'the size contained in the passed layout.'
269 do l = 1, loc_size_x4
270 do k = 1, loc_size_x3
271 do j = 1, loc_size_x2
272 do i = 1, loc_size_x1
273 gi(:) = sll_o_local_to_global(layout, (/i, j, k, l/))
274 eta1 = eta1_min + real(gi(1) - 1, f64)*delta1
275 eta2 = eta2_min + real(gi(2) - 1, f64)*delta2
276 eta3 = eta3_min + real(gi(3) - 1, f64)*delta3
277 eta4 = eta4_min + real(gi(4) - 1, f64)*delta4
278 array(i, j, k, l) = func(eta1, eta2, eta3, eta4, func_params)
295 type(sll_t_layout_4d),
pointer :: layout
300 sll_real64,
dimension(:, :, :, :),
intent(out) :: array
302 sll_real64,
dimension(:),
intent(in) :: func_params
303 sll_real64 :: eta1_min
304 sll_real64 :: eta2_min
305 sll_real64 :: eta3_min
306 sll_real64 :: eta4_min
312 eta1_min = mesh1d_eta1%eta_min
313 delta1 = mesh1d_eta1%delta_eta
314 eta2_min = mesh1d_eta2%eta_min
315 delta2 = mesh1d_eta2%delta_eta
316 eta3_min = mesh1d_eta3%eta_min
317 delta3 = mesh1d_eta3%delta_eta
318 eta4_min = mesh1d_eta4%eta_min
319 delta4 = mesh1d_eta4%delta_eta
344 type(sll_t_layout_4d),
pointer :: layout
346 sll_real64,
dimension(:, :, :, :),
intent(out) :: array
348 sll_real64,
dimension(:),
intent(in) :: func_params
354 sll_real64 :: eta1_min
355 sll_real64 :: eta2_min
356 sll_real64 :: eta3_min
357 sll_real64 :: eta4_min
359 eta1_min = mesh4d%eta1_min
360 eta2_min = mesh4d%eta2_min
361 eta3_min = mesh4d%eta3_min
362 eta4_min = mesh4d%eta4_min
363 delta1 = mesh4d%delta_eta1
364 delta2 = mesh4d%delta_eta2
365 delta3 = mesh4d%delta_eta3
366 delta4 = mesh4d%delta_eta4
397 type(sll_t_layout_4d),
pointer :: layout
400 sll_real64,
dimension(:, :, :, :),
intent(out) :: array
402 sll_real64,
dimension(:),
intent(in) :: func_params
414 sll_int32 :: loc_size_x1
415 sll_int32 :: loc_size_x2
416 sll_int32 :: loc_size_x3
417 sll_int32 :: loc_size_x4
422 sll_real64 :: eta1_min
423 sll_real64 :: eta2_min
424 sll_real64 :: eta3_min
425 sll_real64 :: eta4_min
434 sll_int32 :: case_selector
435 sll_int32,
dimension(1:4) :: gi
437 if (.not.
associated(layout))
then
438 print *,
'sll_o_4d_parallel_array_initializer error: ', &
439 'passed layout is uninitialized.'
442 if (.not.
associated(mesh2d_eta1_eta2))
then
443 print *,
'sll_o_4d_parallel_array_initializer error: ', &
444 'passed mesh2d_eta1_eta2 argument is uninitialized.'
447 if (.not.
associated(mesh2d_eta3_eta4))
then
448 print *,
'sll_o_4d_parallel_array_initializer error: ', &
449 'passed mesh2d_eta3_eta4 argument is uninitialized.'
452 call sll_o_compute_local_sizes(layout, loc_size_x1, loc_size_x2, loc_size_x3, &
455 if (
size(array, 1) .lt. loc_size_x1)
then
456 print *,
'sll_o_4d_parallel_array_initializer error: ', &
457 'first dimension of passed array is inconsistent with ', &
458 'the size contained in the passed layout.'
461 if (
size(array, 2) .lt. loc_size_x2)
then
462 print *,
'sll_o_4d_parallel_array_initializer error: ', &
463 'second dimension of passed array is inconsistent with ', &
464 'the size contained in the passed layout.'
467 if (
size(array, 3) .lt. loc_size_x3)
then
468 print *,
'sll_o_4d_parallel_array_initializer error: ', &
469 'third dimension of passed array is inconsistent with ', &
470 'the size contained in the passed layout.'
473 if (
size(array, 4) .lt. loc_size_x4)
then
474 print *,
'sll_o_4d_parallel_array_initializer error: ', &
475 'fourth dimension of passed array is inconsistent with ', &
476 'the size contained in the passed layout.'
505 if (
present(transf_x1_x2))
then
506 case_selector = case_selector + 1
509 if (
present(transf_x3_x4))
then
510 case_selector = case_selector + 2
512 eta1_min = mesh2d_eta1_eta2%eta1_min
513 eta2_min = mesh2d_eta1_eta2%eta2_min
514 eta3_min = mesh2d_eta3_eta4%eta1_min
515 eta4_min = mesh2d_eta3_eta4%eta2_min
516 delta1 = mesh2d_eta1_eta2%delta_eta1
517 delta2 = mesh2d_eta1_eta2%delta_eta2
518 delta3 = mesh2d_eta3_eta4%delta_eta1
519 delta4 = mesh2d_eta3_eta4%delta_eta2
524 select case (case_selector)
527 do l = 1, loc_size_x4
528 do k = 1, loc_size_x3
529 do j = 1, loc_size_x2
530 do i = 1, loc_size_x1
531 gi(:) = sll_o_local_to_global(layout, (/i, j, k, l/))
532 eta1 = eta1_min + real(gi(1) - 1, f64)*delta1
533 eta2 = eta2_min + real(gi(2) - 1, f64)*delta2
534 eta3 = eta3_min + real(gi(3) - 1, f64)*delta3
535 eta4 = eta4_min + real(gi(4) - 1, f64)*delta4
536 array(i, j, k, l) = func(eta1, eta2, eta3, eta4, func_params)
542 do l = 1, loc_size_x4
543 do k = 1, loc_size_x3
544 do j = 1, loc_size_x2
545 do i = 1, loc_size_x1
546 gi(:) = sll_o_local_to_global(layout, (/i, j, k, l/))
547 eta1 = eta1_min + real(gi(1) - 1, f64)*delta1
548 eta2 = eta2_min + real(gi(2) - 1, f64)*delta2
549 eta3 = eta3_min + real(gi(3) - 1, f64)*delta3
550 eta4 = eta4_min + real(gi(4) - 1, f64)*delta4
551 x1 = transf_x1_x2%x1(eta1, eta2)
552 x2 = transf_x1_x2%x2(eta1, eta2)
553 array(i, j, k, l) = func(x1, x2, eta3, eta4, func_params)
560 do l = 1, loc_size_x4
561 do k = 1, loc_size_x3
562 do j = 1, loc_size_x2
563 do i = 1, loc_size_x1
564 gi(:) = sll_o_local_to_global(layout, (/i, j, k, l/))
565 eta1 = eta1_min + real(gi(1) - 1, f64)*delta1
566 eta2 = eta2_min + real(gi(2) - 1, f64)*delta2
567 eta3 = eta3_min + real(gi(3) - 1, f64)*delta3
568 eta4 = eta4_min + real(gi(4) - 1, f64)*delta4
569 x3 = transf_x3_x4%x1(eta3, eta4)
570 x4 = transf_x3_x4%x2(eta3, eta4)
571 array(i, j, k, l) = func(eta1, eta2, x3, x4, func_params)
577 do l = 1, loc_size_x4
578 do k = 1, loc_size_x3
579 do j = 1, loc_size_x2
580 do i = 1, loc_size_x1
581 gi(:) = sll_o_local_to_global(layout, (/i, j, k, l/))
582 eta1 = eta1_min + real(gi(1) - 1, f64)*delta1
583 eta2 = eta2_min + real(gi(2) - 1, f64)*delta2
584 eta3 = eta3_min + real(gi(3) - 1, f64)*delta3
585 eta4 = eta4_min + real(gi(4) - 1, f64)*delta4
586 x1 = transf_x1_x2%x1(eta1, eta2)
587 x2 = transf_x1_x2%x2(eta1, eta2)
588 x3 = transf_x3_x4%x1(eta3, eta4)
589 x4 = transf_x3_x4%x2(eta3, eta4)
590 array(i, j, k, l) = func(x1, x2, x3, x4, func_params)
816 ! in case of a mesh with cell subdivisions
822 type(sll_t_layout_4d),
pointer :: layout
825 sll_real64,
dimension(:, :, :, :),
intent(out) :: array
827 sll_real64,
dimension(:),
intent(in) :: func_params
828 sll_int32,
optional :: subcells1
829 sll_int32,
optional :: subcells2
830 sll_int32,
optional :: subcells3
831 sll_int32,
optional :: subcells4
843 sll_int32 :: loc_size_x1
844 sll_int32 :: loc_size_x2
845 sll_int32 :: loc_size_x3
846 sll_int32 :: loc_size_x4
851 sll_real64 :: eta1_min
852 sll_real64 :: eta2_min
853 sll_real64 :: eta3_min
854 sll_real64 :: eta4_min
863 sll_int32 :: case_selector
864 sll_int32 :: sub1, sub2, sub3, sub4
865 sll_int32,
dimension(1:4) :: gi
867 if (.not.
associated(layout))
then
868 print *,
'sll_o_4d_parallel_array_initializer error: ', &
869 'passed layout is uninitialized.'
872 if (.not.
associated(mesh2d_eta1_eta2))
then
873 print *,
'sll_o_4d_parallel_array_initializer error: ', &
874 'passed mesh2d_eta1_eta2 argument is uninitialized.'
877 if (.not.
associated(mesh2d_eta3_eta4))
then
878 print *,
'sll_o_4d_parallel_array_initializer error: ', &
879 'passed mesh2d_eta3_eta4 argument is uninitialized.'
882 call sll_o_compute_local_sizes(layout, loc_size_x1, loc_size_x2, loc_size_x3, &
885 if (
size(array, 1) .lt. loc_size_x1)
then
886 print *,
'sll_o_4d_parallel_array_initializer error: ', &
887 'first dimension of passed array is inconsistent with ', &
888 'the size contained in the passed layout.'
891 if (
size(array, 2) .lt. loc_size_x2)
then
892 print *,
'sll_o_4d_parallel_array_initializer error: ', &
893 'second dimension of passed array is inconsistent with ', &
894 'the size contained in the passed layout.'
897 if (
size(array, 3) .lt. loc_size_x3)
then
898 print *,
'sll_o_4d_parallel_array_initializer error: ', &
899 'third dimension of passed array is inconsistent with ', &
900 'the size contained in the passed layout.'
903 if (
size(array, 4) .lt. loc_size_x4)
then
904 print *,
'sll_o_4d_parallel_array_initializer error: ', &
905 'fourth dimension of passed array is inconsistent with ', &
906 'the size contained in the passed layout.'
933 if (.not.
present(subcells1))
then
939 if (.not.
present(subcells2))
then
945 if (.not.
present(subcells3))
then
951 if (.not.
present(subcells3))
then
959 if (
present(transf_x1_x2))
then
960 case_selector = case_selector + 1
963 if (
present(transf_x3_x4))
then
964 case_selector = case_selector + 2
967 eta1_min = mesh2d_eta1_eta2%eta1_min
968 eta2_min = mesh2d_eta1_eta2%eta2_min
969 eta3_min = mesh2d_eta3_eta4%eta1_min
970 eta4_min = mesh2d_eta3_eta4%eta2_min
971 delta1 = mesh2d_eta1_eta2%delta_eta1/sub1
972 delta2 = mesh2d_eta1_eta2%delta_eta2/sub2
973 delta3 = mesh2d_eta3_eta4%delta_eta1/sub3
974 delta4 = mesh2d_eta3_eta4%delta_eta2/sub4
979 select case (case_selector)
982 do l = 1, loc_size_x4
983 do k = 1, loc_size_x3
984 do j = 1, loc_size_x2
985 do i = 1, loc_size_x1
986 gi(:) = sll_o_local_to_global(layout, (/i, j, k, l/))
987 eta1 = eta1_min + real(gi(1) - 1, f64)*delta1
988 eta2 = eta2_min + real(gi(2) - 1, f64)*delta2
989 eta3 = eta3_min + real(gi(3) - 1, f64)*delta3
990 eta4 = eta4_min + real(gi(4) - 1, f64)*delta4
991 array(i, j, k, l) = func(eta1, eta2, eta3, eta4, func_params)
997 do l = 1, loc_size_x4
998 do k = 1, loc_size_x3
999 do j = 1, loc_size_x2
1000 do i = 1, loc_size_x1
1001 gi(:) = sll_o_local_to_global(layout, (/i, j, k, l/))
1002 eta1 = eta1_min + real(gi(1) - 1, f64)*delta1
1003 eta2 = eta2_min + real(gi(2) - 1, f64)*delta2
1004 eta3 = eta3_min + real(gi(3) - 1, f64)*delta3
1005 eta4 = eta4_min + real(gi(4) - 1, f64)*delta4
1006 x1 = transf_x1_x2%x1(eta1, eta2)
1007 x2 = transf_x1_x2%x2(eta1, eta2)
1008 array(i, j, k, l) = func(x1, x2, eta3, eta4, func_params)
1014 do l = 1, loc_size_x4
1015 do k = 1, loc_size_x3
1016 do j = 1, loc_size_x2
1017 do i = 1, loc_size_x1
1018 gi(:) = sll_o_local_to_global(layout, (/i, j, k, l/))
1019 eta1 = eta1_min + real(gi(1) - 1, f64)*delta1
1020 eta2 = eta2_min + real(gi(2) - 1, f64)*delta2
1021 eta3 = eta3_min + real(gi(3) - 1, f64)*delta3
1022 eta4 = eta4_min + real(gi(4) - 1, f64)*delta4
1023 x3 = transf_x3_x4%x1(eta3, eta4)
1024 x4 = transf_x3_x4%x2(eta3, eta4)
1025 array(i, j, k, l) = func(eta1, eta2, x3, x4, func_params)
1031 do l = 1, loc_size_x4
1032 do k = 1, loc_size_x3
1033 do j = 1, loc_size_x2
1034 do i = 1, loc_size_x1
1035 gi(:) = sll_o_local_to_global(layout, (/i, j, k, l/))
1036 eta1 = eta1_min + real(gi(1) - 1, f64)*delta1
1037 eta2 = eta2_min + real(gi(2) - 1, f64)*delta2
1038 eta3 = eta3_min + real(gi(3) - 1, f64)*delta3
1039 eta4 = eta4_min + real(gi(4) - 1, f64)*delta4
1040 x1 = transf_x1_x2%x1(eta1, eta2)
1041 x2 = transf_x1_x2%x2(eta1, eta2)
1042 x3 = transf_x3_x4%x1(eta3, eta4)
1043 x4 = transf_x3_x4%x2(eta3, eta4)
1044 array(i, j, k, l) = func(x1, x2, x3, x4, func_params)
Cartesian mesh basic types.
subroutine sll_4d_parallel_array_initializer_cartesian_logical_1d_1d_1d_1d(layout, mesh1d_eta1, mesh1d_eta2, mesh1d_eta3, mesh1d_eta4, array, func, func_params)
subroutine sll_2d_times_2d_parallel_array_initializer(layout, mesh2d_eta1_eta2, mesh2d_eta3_eta4, array, func, func_params, transf_x1_x2, transf_x3_x4)
subroutine, public sll_s_4d_parallel_array_initializer_finite_volume(layout, mesh2d_eta1_eta2, mesh2d_eta3_eta4, array, func, func_params, transf_x1_x2, transf_x3_x4, subcells1, subcells2, subcells3, subcells4)
subroutine sll_2d_parallel_array_initializer_cartesian_logical_2d(layout, mesh2d, array, func, func_params)
subroutine sll_2d_parallel_array_initializer_cartesian_array_1d_1d(layout, x1_array, x2_array, array, func, func_params)
subroutine sll_4d_parallel_array_initializer_cartesian_logical_4d(layout, mesh4d, array, func, func_params)
subroutine sll_4d_parallel_array_initializer_cartesian_aux(layout, eta1_min, eta2_min, eta3_min, eta4_min, delta1, delta2, delta3, delta4, array, func, func_params)