Neko-TOP
A portable framework for high-order spectral element flow toplogy optimization.
Loading...
Searching...
No Matches
math_ext.f90
Go to the documentation of this file.
1
34
35module math_ext
36 use num_types, only: rp, xp
37 use comm, only: neko_comm, mpi_extra_precision
38 use mpi_f08, only: mpi_allreduce, mpi_sum, mpi_in_place
39 implicit none
40
41contains
42
46 subroutine copy_mask(a, b, size, mask, mask_size)
47 integer, intent(in) :: size, mask_size
48 real(kind=rp), dimension(size), intent(inout) :: a
49 real(kind=rp), dimension(size), intent(in) :: b
50 integer, dimension(mask_size), intent(in) :: mask
51 integer :: i
52
53 do i = 1, mask_size
54 a(mask(i)) = b(mask(i))
55 end do
56
57 end subroutine copy_mask
58
61 subroutine cadd_mask(a, c, size, mask, mask_size)
62 integer, intent(in) :: size, mask_size
63 real(kind=rp), dimension(size), intent(inout) :: a
64 real(kind=rp), intent(in) :: c
65 integer, dimension(mask_size), intent(in) :: mask
66 integer :: i
67
68 do i = 1, mask_size
69 a(mask(i)) = a(mask(i)) + c
70 end do
71
72 end subroutine cadd_mask
73
76 subroutine invcol1_mask(a, size, mask, mask_size)
77 integer, intent(in) :: size, mask_size
78 real(kind=rp), dimension(size), intent(inout) :: a
79 integer, dimension(mask_size), intent(in) :: mask
80 integer :: i
81
82 do i = 1, mask_size
83 a(mask(i)) = 1.0_rp / a(mask(i))
84 end do
85
86 end subroutine invcol1_mask
87
90 subroutine cmult_mask(a, c, size, mask, mask_size)
91 integer, intent(in) :: size, mask_size
92 real(kind=rp), dimension(size), intent(inout) :: a
93 real(kind=rp), intent(in) :: c
94 integer, dimension(mask_size), intent(in) :: mask
95 integer :: i
96
97 do i = 1, mask_size
98 a(mask(i)) = c * a(mask(i))
99 end do
100
101 end subroutine cmult_mask
102
105 subroutine col2_mask(a, b, size, mask, mask_size)
106 integer, intent(in) :: size, mask_size
107 real(kind=rp), dimension(size), intent(inout) :: a
108 real(kind=rp), dimension(size), intent(in) :: b
109 integer, dimension(mask_size), intent(in) :: mask
110 integer :: i
111
112 do i = 1, mask_size
113 a(mask(i)) = a(mask(i)) * b(mask(i))
114 end do
115
116 end subroutine col2_mask
117
120 subroutine col3_mask(a, b, c, size, mask, mask_size)
121 integer, intent(in) :: size, mask_size
122 real(kind=rp), dimension(size), intent(inout) :: a
123 real(kind=rp), dimension(size), intent(in) :: b, c
124 integer, dimension(mask_size), intent(in) :: mask
125 integer :: i
126
127 do i = 1, mask_size
128 a(mask(i)) = b(mask(i)) * c(mask(i))
129 end do
130
131 end subroutine col3_mask
132
135 subroutine sub3_mask(a, b, c, size, mask, mask_size)
136 integer, intent(in) :: size, mask_size
137 real(kind=rp), dimension(size), intent(inout) :: a
138 real(kind=rp), dimension(size), intent(in) :: b, c
139 integer, dimension(mask_size), intent(in) :: mask
140 integer :: i
141
142 do i = 1, mask_size
143 a(mask(i)) = b(mask(i)) - c(mask(i))
144 end do
145
146 end subroutine sub3_mask
147
150 function glsc2_mask(a, b, size, mask, mask_size)
151 integer, intent(in) :: size, mask_size
152 real(kind=rp), dimension(size), intent(in) :: a
153 real(kind=rp), dimension(size), intent(in) :: b
154 integer, dimension(mask_size), intent(in) :: mask
155 real(kind=rp) :: glsc2_mask
156 real(kind=xp) :: tmp
157 integer :: i, ierr
158
159 tmp = 0.0_xp
160 do i = 1, mask_size
161 tmp = tmp + a(mask(i)) * b(mask(i))
162 end do
163
164 call mpi_allreduce(mpi_in_place, tmp, 1, &
165 mpi_extra_precision, mpi_sum, neko_comm, ierr)
166 glsc2_mask = real(tmp, kind=rp)
167 end function glsc2_mask
168end module math_ext