1969896995

Committed 06 Aug 2025 12:38PM UTC coverage: 8.166% (+0.006%) from 8.16%

Build # 1969896995

Build Type

push

gitlab-ci

Committed by David Dickinson

Commit Message

Merged in minor/remove_nl_forbid_force_zero (pull request #1078)

Run Details

3667 of 44908 relevant lines covered (8.17%)

124289.88 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

0.0

/src/array_utils.fpp

!> Provides wrappers to some simple array operations. We use this
!> indirection in order to be able to consistently treat performance
!> concerns. Currently this is limited to adding OpenMP, although in
!> the future it might allow different approaches as appropriate.
module array_utils
  implicit none

  private

  public :: copy, gs2_maxval, gs2_abs, gs2_max_abs
  public :: zero_array

  !> Interface to helper subroutines for copying one array into another.
  interface copy
     module procedure copy_real_array_3
     module procedure copy_real_array_4
     module procedure copy_complex_array_3
     module procedure copy_complex_array_4
  end interface copy

  !> Interface to helper functions for finding the maximum in an array
  interface gs2_maxval
     module procedure gs2_maxval_real_array_2
     module procedure gs2_maxval_real_array_3
  end interface gs2_maxval

  !> Interface to helper functions for finding magnitude of an array
  interface gs2_abs
     module procedure gs2_abs_real_array_2
     module procedure gs2_abs_real_array_3
     module procedure gs2_abs_complex_array_2
     module procedure gs2_abs_complex_array_3
  end interface gs2_abs

  !> Interface to helper functions for finding maxval of magnitude of an array
  interface gs2_max_abs
     module procedure gs2_max_abs_real_array_2
     module procedure gs2_max_abs_real_array_3
     module procedure gs2_max_abs_complex_array_2
     module procedure gs2_max_abs_complex_array_3
  end interface gs2_max_abs

  !> Interface to helper functions to zero an array
  interface zero_array
     module procedure zero_array_real_array_1
     module procedure zero_array_real_array_2
     module procedure zero_array_real_array_3
     module procedure zero_array_real_array_4
     module procedure zero_array_real_array_5
     module procedure zero_array_complex_array_1
     module procedure zero_array_complex_array_2
     module procedure zero_array_complex_array_3
     module procedure zero_array_complex_array_4
     module procedure zero_array_complex_array_5
  end interface zero_array

contains

  !> Copy 3D real arrays
  subroutine copy_real_array_3(array_in, array_out)
    implicit none
    real, dimension(:, :, :), intent(in) :: array_in
    real, dimension(:, :, :), intent(out) :: array_out
    integer :: c2, s2, c3, s3
    ! In a debug build we might want to add a check here that the arrays have
    ! compatible shape.
    s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)

    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2, c3) &
    !$OMP SHARED(s2, s3, array_out, array_in) &
    !$OMP COLLAPSE(2) &
    !$OMP SCHEDULE(static)
    do c3 = 1, s3 ; do c2 = 1, s2
       array_out(:, c2, c3) = array_in(:, c2, c3)
    end do ; end do
    !$OMP END PARALLEL DO
  end subroutine copy_real_array_3

  !> Copy 4D real arrays
  subroutine copy_real_array_4(array_in, array_out)
    implicit none
    real, dimension(:, :, :, :), intent(in) :: array_in
    real, dimension(:, :, :, :), intent(out) :: array_out
    integer :: c2, s2, c3, s3, c4, s4
    ! In a debug build we might want to add a check here that the arrays have
    ! compatible shape.
    s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)
    s4 = size(array_in, dim = 4)

    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2, c3, c4) &
    !$OMP SHARED(s2, s3, s4, array_out, array_in) &
    !$OMP COLLAPSE(3) &
    !$OMP SCHEDULE(static)
    do c4 = 1, s4; do c3 = 1, s3 ; do c2 = 1, s2
       array_out(:, c2, c3, c4) = array_in(:, c2, c3, c4)
    end do ; end do ; end do
    !$OMP END PARALLEL DO
  end subroutine copy_real_array_4

  !> Copy 3D complex arrays
  subroutine copy_complex_array_3(array_in, array_out)
    implicit none
    complex, dimension(:, :, :), intent(in) :: array_in
    complex, dimension(:, :, :), intent(out) :: array_out
    integer :: c2, s2, c3, s3
    ! In a debug build we might want to add a check here that the arrays have
    ! compatible shape.
    s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)

    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2, c3) &
    !$OMP SHARED(s2, s3, array_out, array_in) &
    !$OMP COLLAPSE(2) &
    !$OMP SCHEDULE(static)
    do c3 = 1, s3 ; do c2 = 1, s2
       array_out(:, c2, c3) = array_in(:, c2, c3)
    end do ; end do
    !$OMP END PARALLEL DO
  end subroutine copy_complex_array_3

  !> Copy 4D complex arrays
  subroutine copy_complex_array_4(array_in, array_out)
    implicit none
    complex, dimension(:, :, :, :), intent(in) :: array_in
    complex, dimension(:, :, :, :), intent(out) :: array_out
    integer :: c2, s2, c3, s3, c4, s4
    ! In a debug build we might want to add a check here that the arrays have
    ! compatible shape.
    s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)
    s4 = size(array_in, dim = 4)

    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2, c3, c4) &
    !$OMP SHARED(s2, s3, s4, array_out, array_in) &
    !$OMP COLLAPSE(3) &
    !$OMP SCHEDULE(static)
    do c4 = 1, s4; do c3 = 1, s3 ; do c2 = 1, s2
       array_out(:, c2, c3, c4) = array_in(:, c2, c3, c4)
    end do ; end do ; end do
    !$OMP END PARALLEL DO
  end subroutine copy_complex_array_4

  !> Find maximum in 2D array
  real function gs2_maxval_real_array_2(array_in) result(the_max)
    implicit none
    real, dimension(:, :), intent(in) :: array_in
    integer :: c2, s2
    s2 = size(array_in, dim = 2)
    the_max = 0.0
    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2) &
    !$OMP SHARED(s2, array_in) &
    !$OMP REDUCTION(max: the_max) &
    !$OMP SCHEDULE(static)
    do c2 = 1, s2
       the_max = max(maxval(array_in(:, c2)), the_max)
    end do
    !$OMP END PARALLEL DO
  end function gs2_maxval_real_array_2

  !> Find maximum in 3D array
  real function gs2_maxval_real_array_3(array_in) result(the_max)
    implicit none
    real, dimension(:, :, :), intent(in) :: array_in
    integer :: c2, s2, c3, s3
    s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)
    the_max = 0.0
    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2, c3) &
    !$OMP SHARED(s2, s3, array_in) &
    !$OMP REDUCTION(max: the_max) &
    !$OMP COLLAPSE(2) &
    !$OMP SCHEDULE(static)
    do c3 = 1, s3 ; do c2 = 1, s2
       the_max = max(maxval(array_in(:, c2, c3)), the_max)
    end do ; end do
    !$OMP END PARALLEL DO
  end function gs2_maxval_real_array_3

  !> Return absolute of 2D array
  function gs2_abs_real_array_2(array_in) result(array_out)
    implicit none
    real, dimension(:, :), intent(in) :: array_in
    real, dimension(:, :), allocatable :: array_out
    integer :: c2, s2
    s2 = size(array_in, dim = 2)

    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2) &
    !$OMP SHARED(s2, array_in, array_out) &
    !$OMP SCHEDULE(static)
    do c2 = 1, s2
       array_out(:, c2) = abs(array_in(:, c2))
    end do
    !$OMP END PARALLEL DO
  end function gs2_abs_real_array_2

  !> Return absolute of 3D array
  function gs2_abs_real_array_3(array_in) result(array_out)
    implicit none
    real, dimension(:, :, :), intent(in) :: array_in
    real, dimension(:, :, :), allocatable :: array_out
    integer :: c2, s2, c3, s3
    s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)

    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2, c3) &
    !$OMP SHARED(s2, s3, array_in, array_out) &
    !$OMP COLLAPSE(2) &
    !$OMP SCHEDULE(static)
    do c3 = 1, s3 ; do c2 = 1, s2
       array_out(:, c2, c3) = abs(array_in(:, c2, c3))
    end do ; end do
    !$OMP END PARALLEL DO
  end function gs2_abs_real_array_3

  !> Return absolute of 2D array
  function gs2_abs_complex_array_2(array_in) result(array_out)
    implicit none
    complex, dimension(:, :), intent(in) :: array_in
    complex, dimension(:, :), allocatable :: array_out
    integer :: c2, s2
    s2 = size(array_in, dim = 2)

    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2) &
    !$OMP SHARED(s2, array_in, array_out) &
    !$OMP SCHEDULE(static)
    do c2 = 1, s2
       array_out(:, c2) = abs(array_in(:, c2))
    end do
    !$OMP END PARALLEL DO
  end function gs2_abs_complex_array_2

  !> Return absolute of 3D array
  function gs2_abs_complex_array_3(array_in) result(array_out)
    implicit none
    complex, dimension(:, :, :), intent(in) :: array_in
    complex, dimension(:, :, :), allocatable :: array_out
    integer :: c2, s2, c3, s3
    s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)

    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2, c3) &
    !$OMP SHARED(s2, s3, array_in, array_out) &
    !$OMP COLLAPSE(2) &
    !$OMP SCHEDULE(static)
    do c3 = 1, s3 ; do c2 = 1, s2
       array_out(:, c2, c3) = abs(array_in(:, c2, c3))
    end do ; end do
    !$OMP END PARALLEL DO
  end function gs2_abs_complex_array_3

  !> Find maximum of abs 2D array
  real function gs2_max_abs_real_array_2(array_in) result(the_max)
    implicit none
    real, dimension(:, :), intent(in) :: array_in
    integer :: c2, s2
    s2 = size(array_in, dim = 2)
    the_max = 0.0
    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2) &
    !$OMP SHARED(s2, array_in) &
    !$OMP REDUCTION(max: the_max) &
    !$OMP SCHEDULE(static)
    do c2 = 1, s2
       the_max = max(maxval(abs(array_in(:, c2))), the_max)
    end do
    !$OMP END PARALLEL DO
  end function gs2_max_abs_real_array_2

  !> Find maximum of abs 3D array
  real function gs2_max_abs_real_array_3(array_in) result(the_max)
    implicit none
    real, dimension(:, :, :), intent(in) :: array_in
    integer :: c2, s2, c3, s3
    s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)
    the_max = 0.0
    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2, c3) &
    !$OMP SHARED(s2, s3, array_in) &
    !$OMP REDUCTION(max: the_max) &
    !$OMP COLLAPSE(2) &
    !$OMP SCHEDULE(static)
    do c3 = 1, s3 ; do c2 = 1, s2
       the_max = max(maxval(abs(array_in(:, c2, c3))), the_max)
    end do ; end do
    !$OMP END PARALLEL DO
  end function gs2_max_abs_real_array_3

  !> Find maximum of abs 2D array
  real function gs2_max_abs_complex_array_2(array_in) result(the_max)
    implicit none
    complex, dimension(:, :), intent(in) :: array_in
    integer :: c2, s2
    s2 = size(array_in, dim = 2)
    the_max = 0.0
    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2) &
    !$OMP SHARED(s2, array_in) &
    !$OMP REDUCTION(max: the_max) &
    !$OMP SCHEDULE(static)
    do c2 = 1, s2
       the_max = max(maxval(abs(array_in(:, c2))), the_max)
    end do
    !$OMP END PARALLEL DO
  end function gs2_max_abs_complex_array_2

  !> Find maximum of abs 3D array
  real function gs2_max_abs_complex_array_3(array_in) result(the_max)
    implicit none
    complex, dimension(:, :, :), intent(in) :: array_in
    integer :: c2, s2, c3, s3
    s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)
    the_max = 0.0
    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2, c3) &
    !$OMP SHARED(s2, s3, array_in) &
    !$OMP REDUCTION(max: the_max) &
    !$OMP COLLAPSE(2) &
    !$OMP SCHEDULE(static)
    do c3 = 1, s3 ; do c2 = 1, s2
       the_max = max(maxval(abs(array_in(:, c2, c3))), the_max)
    end do ; end do
    !$OMP END PARALLEL DO
  end function gs2_max_abs_complex_array_3

  !> Zero out a 1D array
  subroutine zero_array_real_array_1(array_in)
    implicit none
    real, dimension(:), intent(in out) :: array_in
    integer :: c1, s1
    s1 = size(array_in, dim = 1)
    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c1) &
    !$OMP SHARED(s1, array_in) &
    !$OMP SCHEDULE(static)
    do c1 = 1, s1
       array_in(c1) = 0.0
    end do
    !$OMP END PARALLEL DO
  end subroutine zero_array_real_array_1

  !> Zero out a 2D array
  subroutine zero_array_real_array_2(array_in)
    implicit none
    real, dimension(:, :), intent(in out) :: array_in
    integer :: c2, s2
    s2 = size(array_in, dim = 2)
    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2) &
    !$OMP SHARED(s2, array_in) &
    !$OMP SCHEDULE(static)
    do c2 = 1, s2
       array_in(:, c2) = 0.0
    end do
    !$OMP END PARALLEL DO
  end subroutine zero_array_real_array_2

  !> Zero out a 3D array
  subroutine zero_array_real_array_3(array_in)
    implicit none
    real, dimension(:, :, :), intent(in out) :: array_in
    integer :: c2, s2, c3, s3
    s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)
    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2, c3) &
    !$OMP SHARED(s2, s3, array_in) &
    !$OMP COLLAPSE(2) &
    !$OMP SCHEDULE(static)
    do c3 = 1, s3 ; do c2 = 1, s2
       array_in(:, c2, c3) = 0.0
    end do ; end do
    !$OMP END PARALLEL DO
  end subroutine zero_array_real_array_3

  !> Zero out a 4D array
  subroutine zero_array_real_array_4(array_in)
    implicit none
    real, dimension(:, :, :, :), intent(in out) :: array_in
    integer :: c2, s2, c3, s3, c4, s4
    s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)
    s4 = size(array_in, dim = 4)
    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2, c3, c4) &
    !$OMP SHARED(s2, s3, s4, array_in) &
    !$OMP COLLAPSE(3) &
    !$OMP SCHEDULE(static)
    do c4 = 1, s4 ; do c3 = 1, s3 ; do c2 = 1, s2
       array_in(:, c2, c3, c4) = 0.0
    end do ; end do ; end do
    !$OMP END PARALLEL DO
  end subroutine zero_array_real_array_4

  !> Zero out a 5D array
  subroutine zero_array_real_array_5(array_in)
    implicit none
    real, dimension(:, :, :, :, :), intent(in out) :: array_in
    integer :: c2, s2, c3, s3, c4, s4, c5, s5
    s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)
    s4 = size(array_in, dim = 4) ; s5 = size(array_in, dim = 5)
    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2, c3, c4, c5) &
    !$OMP SHARED(s2, s3, s4, s5, array_in) &
    !$OMP COLLAPSE(4) &
    !$OMP SCHEDULE(static)
    do c5 = 1, s5 ; do c4 = 1, s4 ; do c3 = 1, s3 ; do c2 = 1, s2
       array_in(:, c2, c3, c4, c5) = 0.0
    end do ; end do ; end do ; end do
    !$OMP END PARALLEL DO
  end subroutine zero_array_real_array_5

  !> Zero out a 1D array
  subroutine zero_array_complex_array_1(array_in)
    implicit none
    complex, dimension(:), intent(in out) :: array_in
    integer :: c1, s1
    s1 = size(array_in, dim = 1)
    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c1) &
    !$OMP SHARED(s1, array_in) &
    !$OMP SCHEDULE(static)
    do c1 = 1, s1
       array_in(c1) = 0.0
    end do
    !$OMP END PARALLEL DO
  end subroutine zero_array_complex_array_1

  !> Zero out a 2D array
  subroutine zero_array_complex_array_2(array_in)
    implicit none
    complex, dimension(:, :), intent(in out) :: array_in
    integer :: c2, s2
    s2 = size(array_in, dim = 2)
    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2) &
    !$OMP SHARED(s2, array_in) &
    !$OMP SCHEDULE(static)
    do c2 = 1, s2
       array_in(:, c2) = 0.0
    end do
    !$OMP END PARALLEL DO
  end subroutine zero_array_complex_array_2

  !> Zero out a 3D array
  subroutine zero_array_complex_array_3(array_in)
    implicit none
    complex, dimension(:, :, :), intent(in out) :: array_in
    integer :: c2, s2, c3, s3
    s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)
    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2, c3) &
    !$OMP SHARED(s2, s3, array_in) &
    !$OMP COLLAPSE(2) &
    !$OMP SCHEDULE(static)
    do c3 = 1, s3 ; do c2 = 1, s2
       array_in(:, c2, c3) = 0.0
    end do ; end do
    !$OMP END PARALLEL DO
  end subroutine zero_array_complex_array_3

  !> Zero out a 4D array
  subroutine zero_array_complex_array_4(array_in)
    implicit none
    complex, dimension(:, :, :, :), intent(in out) :: array_in
    integer :: c2, s2, c3, s3, c4, s4
    s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)
    s4 = size(array_in, dim = 4)
    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2, c3, c4) &
    !$OMP SHARED(s2, s3, s4, array_in) &
    !$OMP COLLAPSE(3) &
    !$OMP SCHEDULE(static)
    do c4 = 1, s4 ; do c3 = 1, s3 ; do c2 = 1, s2
       array_in(:, c2, c3, c4) = 0.0
    end do ; end do ; end do
    !$OMP END PARALLEL DO
  end subroutine zero_array_complex_array_4

  !> Zero out a 5D array
  subroutine zero_array_complex_array_5(array_in)
    implicit none
    complex, dimension(:, :, :, :, :), intent(in out) :: array_in
    integer :: c2, s2, c3, s3, c4, s4, c5, s5
    s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)
    s4 = size(array_in, dim = 4) ; s5 = size(array_in, dim = 5)
    !$OMP PARALLEL DO DEFAULT(none) &
    !$OMP PRIVATE(c2, c3, c4, c5) &
    !$OMP SHARED(s2, s3, s4, s5, array_in) &
    !$OMP COLLAPSE(4) &
    !$OMP SCHEDULE(static)
    do c5 = 1, s5 ; do c4 = 1, s4 ; do c3 = 1, s3 ; do c2 = 1, s2
       array_in(:, c2, c3, c4, c5) = 0.0
    end do ; end do ; end do ; end do
    !$OMP END PARALLEL DO
  end subroutine zero_array_complex_array_5

end module array_utils

1	!> Provides wrappers to some simple array operations. We use this
2	!> indirection in order to be able to consistently treat performance
3	!> concerns. Currently this is limited to adding OpenMP, although in
4	!> the future it might allow different approaches as appropriate.
5	module array_utils
6	implicit none
7
8	private
9
10	public :: copy, gs2_maxval, gs2_abs, gs2_max_abs
11	public :: zero_array
12
13	!> Interface to helper subroutines for copying one array into another.
14	interface copy
15	module procedure copy_real_array_3
16	module procedure copy_real_array_4
17	module procedure copy_complex_array_3
18	module procedure copy_complex_array_4
19	end interface copy
20
21	!> Interface to helper functions for finding the maximum in an array
22	interface gs2_maxval
23	module procedure gs2_maxval_real_array_2
24	module procedure gs2_maxval_real_array_3
25	end interface gs2_maxval
26
27	!> Interface to helper functions for finding magnitude of an array
28	interface gs2_abs
29	module procedure gs2_abs_real_array_2
30	module procedure gs2_abs_real_array_3
31	module procedure gs2_abs_complex_array_2
32	module procedure gs2_abs_complex_array_3
33	end interface gs2_abs
34
35	!> Interface to helper functions for finding maxval of magnitude of an array
36	interface gs2_max_abs
37	module procedure gs2_max_abs_real_array_2
38	module procedure gs2_max_abs_real_array_3
39	module procedure gs2_max_abs_complex_array_2
40	module procedure gs2_max_abs_complex_array_3
41	end interface gs2_max_abs
42
43	!> Interface to helper functions to zero an array
44	interface zero_array
45	module procedure zero_array_real_array_1
46	module procedure zero_array_real_array_2
47	module procedure zero_array_real_array_3
48	module procedure zero_array_real_array_4
49	module procedure zero_array_real_array_5
50	module procedure zero_array_complex_array_1
51	module procedure zero_array_complex_array_2
52	module procedure zero_array_complex_array_3
53	module procedure zero_array_complex_array_4
54	module procedure zero_array_complex_array_5
55	end interface zero_array
56
57	contains
58
59	!> Copy 3D real arrays
60	subroutine copy_real_array_3(array_in, array_out)	×
61	implicit none
62	real, dimension(:, :, :), intent(in) :: array_in
63	real, dimension(:, :, :), intent(out) :: array_out
64	integer :: c2, s2, c3, s3
65	! In a debug build we might want to add a check here that the arrays have
66	! compatible shape.
67	s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)	×
68
69	!$OMP PARALLEL DO DEFAULT(none) &
70	!$OMP PRIVATE(c2, c3) &
71	!$OMP SHARED(s2, s3, array_out, array_in) &
72	!$OMP COLLAPSE(2) &
73	!$OMP SCHEDULE(static)
74	do c3 = 1, s3 ; do c2 = 1, s2	×
75	array_out(:, c2, c3) = array_in(:, c2, c3)	×
76	end do ; end do
77	!$OMP END PARALLEL DO
78	end subroutine copy_real_array_3	×
79
80	!> Copy 4D real arrays
81	subroutine copy_real_array_4(array_in, array_out)	×
82	implicit none
83	real, dimension(:, :, :, :), intent(in) :: array_in
84	real, dimension(:, :, :, :), intent(out) :: array_out
85	integer :: c2, s2, c3, s3, c4, s4
86	! In a debug build we might want to add a check here that the arrays have
87	! compatible shape.
88	s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)	×
89	s4 = size(array_in, dim = 4)	×
90
91	!$OMP PARALLEL DO DEFAULT(none) &
92	!$OMP PRIVATE(c2, c3, c4) &
93	!$OMP SHARED(s2, s3, s4, array_out, array_in) &
94	!$OMP COLLAPSE(3) &
95	!$OMP SCHEDULE(static)
96	do c4 = 1, s4; do c3 = 1, s3 ; do c2 = 1, s2	×
97	array_out(:, c2, c3, c4) = array_in(:, c2, c3, c4)	×
98	end do ; end do ; end do
99	!$OMP END PARALLEL DO
100	end subroutine copy_real_array_4	×
101
102	!> Copy 3D complex arrays
103	subroutine copy_complex_array_3(array_in, array_out)	×
104	implicit none
105	complex, dimension(:, :, :), intent(in) :: array_in
106	complex, dimension(:, :, :), intent(out) :: array_out
107	integer :: c2, s2, c3, s3
108	! In a debug build we might want to add a check here that the arrays have
109	! compatible shape.
110	s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)	×
111
112	!$OMP PARALLEL DO DEFAULT(none) &
113	!$OMP PRIVATE(c2, c3) &
114	!$OMP SHARED(s2, s3, array_out, array_in) &
115	!$OMP COLLAPSE(2) &
116	!$OMP SCHEDULE(static)
117	do c3 = 1, s3 ; do c2 = 1, s2	×
118	array_out(:, c2, c3) = array_in(:, c2, c3)	×
119	end do ; end do
120	!$OMP END PARALLEL DO
121	end subroutine copy_complex_array_3	×
122
123	!> Copy 4D complex arrays
124	subroutine copy_complex_array_4(array_in, array_out)	×
125	implicit none
126	complex, dimension(:, :, :, :), intent(in) :: array_in
127	complex, dimension(:, :, :, :), intent(out) :: array_out
128	integer :: c2, s2, c3, s3, c4, s4
129	! In a debug build we might want to add a check here that the arrays have
130	! compatible shape.
131	s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)	×
132	s4 = size(array_in, dim = 4)	×
133
134	!$OMP PARALLEL DO DEFAULT(none) &
135	!$OMP PRIVATE(c2, c3, c4) &
136	!$OMP SHARED(s2, s3, s4, array_out, array_in) &
137	!$OMP COLLAPSE(3) &
138	!$OMP SCHEDULE(static)
139	do c4 = 1, s4; do c3 = 1, s3 ; do c2 = 1, s2	×
140	array_out(:, c2, c3, c4) = array_in(:, c2, c3, c4)	×
141	end do ; end do ; end do
142	!$OMP END PARALLEL DO
143	end subroutine copy_complex_array_4	×
144
145	!> Find maximum in 2D array
146	real function gs2_maxval_real_array_2(array_in) result(the_max)	×
147	implicit none
148	real, dimension(:, :), intent(in) :: array_in
149	integer :: c2, s2
150	s2 = size(array_in, dim = 2)	×
151	the_max = 0.0	×
152	!$OMP PARALLEL DO DEFAULT(none) &
153	!$OMP PRIVATE(c2) &
154	!$OMP SHARED(s2, array_in) &
155	!$OMP REDUCTION(max: the_max) &
156	!$OMP SCHEDULE(static)
157	do c2 = 1, s2	×
158	the_max = max(maxval(array_in(:, c2)), the_max)	×
159	end do
160	!$OMP END PARALLEL DO
161	end function gs2_maxval_real_array_2	×
162
163	!> Find maximum in 3D array
164	real function gs2_maxval_real_array_3(array_in) result(the_max)	×
165	implicit none
166	real, dimension(:, :, :), intent(in) :: array_in
167	integer :: c2, s2, c3, s3
168	s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)	×
169	the_max = 0.0	×
170	!$OMP PARALLEL DO DEFAULT(none) &
171	!$OMP PRIVATE(c2, c3) &
172	!$OMP SHARED(s2, s3, array_in) &
173	!$OMP REDUCTION(max: the_max) &
174	!$OMP COLLAPSE(2) &
175	!$OMP SCHEDULE(static)
176	do c3 = 1, s3 ; do c2 = 1, s2	×
177	the_max = max(maxval(array_in(:, c2, c3)), the_max)	×
178	end do ; end do
179	!$OMP END PARALLEL DO
180	end function gs2_maxval_real_array_3	×
181
182	!> Return absolute of 2D array
183	function gs2_abs_real_array_2(array_in) result(array_out)	×
184	implicit none
185	real, dimension(:, :), intent(in) :: array_in
186	real, dimension(:, :), allocatable :: array_out
187	integer :: c2, s2
188	s2 = size(array_in, dim = 2)	×
189
190	!$OMP PARALLEL DO DEFAULT(none) &
191	!$OMP PRIVATE(c2) &
192	!$OMP SHARED(s2, array_in, array_out) &
193	!$OMP SCHEDULE(static)
194	do c2 = 1, s2	×
195	array_out(:, c2) = abs(array_in(:, c2))	×
196	end do
197	!$OMP END PARALLEL DO
198	end function gs2_abs_real_array_2	×
199
200	!> Return absolute of 3D array
201	function gs2_abs_real_array_3(array_in) result(array_out)	×
202	implicit none
203	real, dimension(:, :, :), intent(in) :: array_in
204	real, dimension(:, :, :), allocatable :: array_out
205	integer :: c2, s2, c3, s3
206	s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)	×
207
208	!$OMP PARALLEL DO DEFAULT(none) &
209	!$OMP PRIVATE(c2, c3) &
210	!$OMP SHARED(s2, s3, array_in, array_out) &
211	!$OMP COLLAPSE(2) &
212	!$OMP SCHEDULE(static)
213	do c3 = 1, s3 ; do c2 = 1, s2	×
214	array_out(:, c2, c3) = abs(array_in(:, c2, c3))	×
215	end do ; end do
216	!$OMP END PARALLEL DO
217	end function gs2_abs_real_array_3	×
218
219	!> Return absolute of 2D array
220	function gs2_abs_complex_array_2(array_in) result(array_out)	×
221	implicit none
222	complex, dimension(:, :), intent(in) :: array_in
223	complex, dimension(:, :), allocatable :: array_out
224	integer :: c2, s2
225	s2 = size(array_in, dim = 2)	×
226
227	!$OMP PARALLEL DO DEFAULT(none) &
228	!$OMP PRIVATE(c2) &
229	!$OMP SHARED(s2, array_in, array_out) &
230	!$OMP SCHEDULE(static)
231	do c2 = 1, s2	×
232	array_out(:, c2) = abs(array_in(:, c2))	×
233	end do
234	!$OMP END PARALLEL DO
235	end function gs2_abs_complex_array_2	×
236
237	!> Return absolute of 3D array
238	function gs2_abs_complex_array_3(array_in) result(array_out)	×
239	implicit none
240	complex, dimension(:, :, :), intent(in) :: array_in
241	complex, dimension(:, :, :), allocatable :: array_out
242	integer :: c2, s2, c3, s3
243	s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)	×
244
245	!$OMP PARALLEL DO DEFAULT(none) &
246	!$OMP PRIVATE(c2, c3) &
247	!$OMP SHARED(s2, s3, array_in, array_out) &
248	!$OMP COLLAPSE(2) &
249	!$OMP SCHEDULE(static)
250	do c3 = 1, s3 ; do c2 = 1, s2	×
251	array_out(:, c2, c3) = abs(array_in(:, c2, c3))	×
252	end do ; end do
253	!$OMP END PARALLEL DO
254	end function gs2_abs_complex_array_3	×
255
256	!> Find maximum of abs 2D array
257	real function gs2_max_abs_real_array_2(array_in) result(the_max)	×
258	implicit none
259	real, dimension(:, :), intent(in) :: array_in
260	integer :: c2, s2
261	s2 = size(array_in, dim = 2)	×
262	the_max = 0.0	×
263	!$OMP PARALLEL DO DEFAULT(none) &
264	!$OMP PRIVATE(c2) &
265	!$OMP SHARED(s2, array_in) &
266	!$OMP REDUCTION(max: the_max) &
267	!$OMP SCHEDULE(static)
268	do c2 = 1, s2	×
269	the_max = max(maxval(abs(array_in(:, c2))), the_max)	×
270	end do
271	!$OMP END PARALLEL DO
272	end function gs2_max_abs_real_array_2	×
273
274	!> Find maximum of abs 3D array
275	real function gs2_max_abs_real_array_3(array_in) result(the_max)	×
276	implicit none
277	real, dimension(:, :, :), intent(in) :: array_in
278	integer :: c2, s2, c3, s3
279	s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)	×
280	the_max = 0.0	×
281	!$OMP PARALLEL DO DEFAULT(none) &
282	!$OMP PRIVATE(c2, c3) &
283	!$OMP SHARED(s2, s3, array_in) &
284	!$OMP REDUCTION(max: the_max) &
285	!$OMP COLLAPSE(2) &
286	!$OMP SCHEDULE(static)
287	do c3 = 1, s3 ; do c2 = 1, s2	×
288	the_max = max(maxval(abs(array_in(:, c2, c3))), the_max)	×
289	end do ; end do
290	!$OMP END PARALLEL DO
291	end function gs2_max_abs_real_array_3	×
292
293	!> Find maximum of abs 2D array
294	real function gs2_max_abs_complex_array_2(array_in) result(the_max)	×
295	implicit none
296	complex, dimension(:, :), intent(in) :: array_in
297	integer :: c2, s2
298	s2 = size(array_in, dim = 2)	×
299	the_max = 0.0	×
300	!$OMP PARALLEL DO DEFAULT(none) &
301	!$OMP PRIVATE(c2) &
302	!$OMP SHARED(s2, array_in) &
303	!$OMP REDUCTION(max: the_max) &
304	!$OMP SCHEDULE(static)
305	do c2 = 1, s2	×
306	the_max = max(maxval(abs(array_in(:, c2))), the_max)	×
307	end do
308	!$OMP END PARALLEL DO
309	end function gs2_max_abs_complex_array_2	×
310
311	!> Find maximum of abs 3D array
312	real function gs2_max_abs_complex_array_3(array_in) result(the_max)	×
313	implicit none
314	complex, dimension(:, :, :), intent(in) :: array_in
315	integer :: c2, s2, c3, s3
316	s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)	×
317	the_max = 0.0	×
318	!$OMP PARALLEL DO DEFAULT(none) &
319	!$OMP PRIVATE(c2, c3) &
320	!$OMP SHARED(s2, s3, array_in) &
321	!$OMP REDUCTION(max: the_max) &
322	!$OMP COLLAPSE(2) &
323	!$OMP SCHEDULE(static)
324	do c3 = 1, s3 ; do c2 = 1, s2	×
325	the_max = max(maxval(abs(array_in(:, c2, c3))), the_max)	×
326	end do ; end do
327	!$OMP END PARALLEL DO
328	end function gs2_max_abs_complex_array_3	×
329
330	!> Zero out a 1D array
331	subroutine zero_array_real_array_1(array_in)	×
332	implicit none
333	real, dimension(:), intent(in out) :: array_in
334	integer :: c1, s1
335	s1 = size(array_in, dim = 1)	×
336	!$OMP PARALLEL DO DEFAULT(none) &
337	!$OMP PRIVATE(c1) &
338	!$OMP SHARED(s1, array_in) &
339	!$OMP SCHEDULE(static)
340	do c1 = 1, s1	×
341	array_in(c1) = 0.0	×
342	end do
343	!$OMP END PARALLEL DO
344	end subroutine zero_array_real_array_1	×
345
346	!> Zero out a 2D array
347	subroutine zero_array_real_array_2(array_in)	×
348	implicit none
349	real, dimension(:, :), intent(in out) :: array_in
350	integer :: c2, s2
351	s2 = size(array_in, dim = 2)	×
352	!$OMP PARALLEL DO DEFAULT(none) &
353	!$OMP PRIVATE(c2) &
354	!$OMP SHARED(s2, array_in) &
355	!$OMP SCHEDULE(static)
356	do c2 = 1, s2	×
357	array_in(:, c2) = 0.0	×
358	end do
359	!$OMP END PARALLEL DO
360	end subroutine zero_array_real_array_2	×
361
362	!> Zero out a 3D array
363	subroutine zero_array_real_array_3(array_in)	×
364	implicit none
365	real, dimension(:, :, :), intent(in out) :: array_in
366	integer :: c2, s2, c3, s3
367	s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)	×
368	!$OMP PARALLEL DO DEFAULT(none) &
369	!$OMP PRIVATE(c2, c3) &
370	!$OMP SHARED(s2, s3, array_in) &
371	!$OMP COLLAPSE(2) &
372	!$OMP SCHEDULE(static)
373	do c3 = 1, s3 ; do c2 = 1, s2	×
374	array_in(:, c2, c3) = 0.0	×
375	end do ; end do
376	!$OMP END PARALLEL DO
377	end subroutine zero_array_real_array_3	×
378
379	!> Zero out a 4D array
380	subroutine zero_array_real_array_4(array_in)	×
381	implicit none
382	real, dimension(:, :, :, :), intent(in out) :: array_in
383	integer :: c2, s2, c3, s3, c4, s4
384	s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)	×
385	s4 = size(array_in, dim = 4)	×
386	!$OMP PARALLEL DO DEFAULT(none) &
387	!$OMP PRIVATE(c2, c3, c4) &
388	!$OMP SHARED(s2, s3, s4, array_in) &
389	!$OMP COLLAPSE(3) &
390	!$OMP SCHEDULE(static)
391	do c4 = 1, s4 ; do c3 = 1, s3 ; do c2 = 1, s2	×
392	array_in(:, c2, c3, c4) = 0.0	×
393	end do ; end do ; end do
394	!$OMP END PARALLEL DO
395	end subroutine zero_array_real_array_4	×
396
397	!> Zero out a 5D array
398	subroutine zero_array_real_array_5(array_in)	×
399	implicit none
400	real, dimension(:, :, :, :, :), intent(in out) :: array_in
401	integer :: c2, s2, c3, s3, c4, s4, c5, s5
402	s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)	×
403	s4 = size(array_in, dim = 4) ; s5 = size(array_in, dim = 5)	×
404	!$OMP PARALLEL DO DEFAULT(none) &
405	!$OMP PRIVATE(c2, c3, c4, c5) &
406	!$OMP SHARED(s2, s3, s4, s5, array_in) &
407	!$OMP COLLAPSE(4) &
408	!$OMP SCHEDULE(static)
409	do c5 = 1, s5 ; do c4 = 1, s4 ; do c3 = 1, s3 ; do c2 = 1, s2	×
410	array_in(:, c2, c3, c4, c5) = 0.0	×
411	end do ; end do ; end do ; end do
412	!$OMP END PARALLEL DO
413	end subroutine zero_array_real_array_5	×
414
415	!> Zero out a 1D array
416	subroutine zero_array_complex_array_1(array_in)	×
417	implicit none
418	complex, dimension(:), intent(in out) :: array_in
419	integer :: c1, s1
420	s1 = size(array_in, dim = 1)	×
421	!$OMP PARALLEL DO DEFAULT(none) &
422	!$OMP PRIVATE(c1) &
423	!$OMP SHARED(s1, array_in) &
424	!$OMP SCHEDULE(static)
425	do c1 = 1, s1	×
426	array_in(c1) = 0.0	×
427	end do
428	!$OMP END PARALLEL DO
429	end subroutine zero_array_complex_array_1	×
430
431	!> Zero out a 2D array
432	subroutine zero_array_complex_array_2(array_in)	×
433	implicit none
434	complex, dimension(:, :), intent(in out) :: array_in
435	integer :: c2, s2
436	s2 = size(array_in, dim = 2)	×
437	!$OMP PARALLEL DO DEFAULT(none) &
438	!$OMP PRIVATE(c2) &
439	!$OMP SHARED(s2, array_in) &
440	!$OMP SCHEDULE(static)
441	do c2 = 1, s2	×
442	array_in(:, c2) = 0.0	×
443	end do
444	!$OMP END PARALLEL DO
445	end subroutine zero_array_complex_array_2	×
446
447	!> Zero out a 3D array
448	subroutine zero_array_complex_array_3(array_in)	×
449	implicit none
450	complex, dimension(:, :, :), intent(in out) :: array_in
451	integer :: c2, s2, c3, s3
452	s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)	×
453	!$OMP PARALLEL DO DEFAULT(none) &
454	!$OMP PRIVATE(c2, c3) &
455	!$OMP SHARED(s2, s3, array_in) &
456	!$OMP COLLAPSE(2) &
457	!$OMP SCHEDULE(static)
458	do c3 = 1, s3 ; do c2 = 1, s2	×
459	array_in(:, c2, c3) = 0.0	×
460	end do ; end do
461	!$OMP END PARALLEL DO
462	end subroutine zero_array_complex_array_3	×
463
464	!> Zero out a 4D array
465	subroutine zero_array_complex_array_4(array_in)	×
466	implicit none
467	complex, dimension(:, :, :, :), intent(in out) :: array_in
468	integer :: c2, s2, c3, s3, c4, s4
469	s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)	×
470	s4 = size(array_in, dim = 4)	×
471	!$OMP PARALLEL DO DEFAULT(none) &
472	!$OMP PRIVATE(c2, c3, c4) &
473	!$OMP SHARED(s2, s3, s4, array_in) &
474	!$OMP COLLAPSE(3) &
475	!$OMP SCHEDULE(static)
476	do c4 = 1, s4 ; do c3 = 1, s3 ; do c2 = 1, s2	×
477	array_in(:, c2, c3, c4) = 0.0	×
478	end do ; end do ; end do
479	!$OMP END PARALLEL DO
480	end subroutine zero_array_complex_array_4	×
481
482	!> Zero out a 5D array
483	subroutine zero_array_complex_array_5(array_in)	×
484	implicit none
485	complex, dimension(:, :, :, :, :), intent(in out) :: array_in
486	integer :: c2, s2, c3, s3, c4, s4, c5, s5
487	s2 = size(array_in, dim = 2) ; s3 = size(array_in, dim = 3)	×
488	s4 = size(array_in, dim = 4) ; s5 = size(array_in, dim = 5)	×
489	!$OMP PARALLEL DO DEFAULT(none) &
490	!$OMP PRIVATE(c2, c3, c4, c5) &
491	!$OMP SHARED(s2, s3, s4, s5, array_in) &
492	!$OMP COLLAPSE(4) &
493	!$OMP SCHEDULE(static)
494	do c5 = 1, s5 ; do c4 = 1, s4 ; do c3 = 1, s3 ; do c2 = 1, s2	×
495	array_in(:, c2, c3, c4, c5) = 0.0	×
496	end do ; end do ; end do ; end do
497	!$OMP END PARALLEL DO
498	end subroutine zero_array_complex_array_5	×
499
500	end module array_utils

gyrokinetics / gs2 / 1969896995

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous