Report Typos and Errors    
Semi-Lagrangian Library
Modular library for kinetic and gyrokinetic simulations of plasmas in fusion energy devices.
sll_m_vector_space_base.F90
Go to the documentation of this file.
1 
6 !
8 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
9 #include "sll_errors.h"
10 
11  use sll_m_working_precision, only: f64
12 
13  implicit none
14 
15  public :: sll_c_vector_space
16 
17  private
18 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
19 
21  integer, parameter :: wp = f64
22 
23  !-----------------------------------------------------------------------------
24  ! Abstract type definition
25  !-----------------------------------------------------------------------------
26 
28  type, abstract :: sll_c_vector_space
29 
30  contains
31 
34  procedure(i_copy), deferred :: copy ! z = x
35  procedure(i_incr), deferred :: incr ! z+= x
36  procedure(i_scal), deferred :: scal ! z*= a
37 
42  procedure :: add => s_vector_space__add ! z = x + y
43  procedure :: mult => s_vector_space__mult ! z = a * x
44  procedure :: mult_add => s_vector_space__mult_add ! z = a * x + y
45  procedure :: incr_mult => s_vector_space__incr_mult ! z+= a * x
46  procedure :: lcmb => s_vector_space__lcmb ! z = sum_i ( a_i*x_i )
47  procedure :: incr_lcmb => s_vector_space__incr_lcmb ! z+= sum_i ( a_i*x_i )
48 
53  procedure :: norm => f_vector_space__norm
54  procedure :: inner => f_vector_space__inner
55  procedure :: show => s_vector_space__show
56 
58  generic :: source => source_scalar, source_array
60 
62  procedure, private :: source_scalar => s_vector_space__source_scalar
63  procedure, private :: source_array => s_vector_space__source_array
65 
66  end type sll_c_vector_space
67 
68  !-----------------------------------------------------------------------------
69  ! Abstract interfaces: basic operations
70  !-----------------------------------------------------------------------------
71 
72  !-----------------------------------------------------------------------------
78  !-----------------------------------------------------------------------------
79  abstract interface
80  subroutine i_copy(self, x)
81  import sll_c_vector_space
82  class(sll_c_vector_space), intent(inout) :: self
83  class(sll_c_vector_space), intent(in) :: x
84  end subroutine i_copy
85  end interface
86 
87  !-----------------------------------------------------------------------------
93  !-----------------------------------------------------------------------------
94  abstract interface
95  subroutine i_incr(self, x)
96  import sll_c_vector_space
97  class(sll_c_vector_space), intent(inout) :: self
98  class(sll_c_vector_space), intent(in) :: x
99  end subroutine i_incr
100  end interface
101 
102  !-----------------------------------------------------------------------------
108  !-----------------------------------------------------------------------------
109  abstract interface
110  subroutine i_scal(self, a)
111  import sll_c_vector_space, wp
112  class(sll_c_vector_space), intent(inout) :: self
113  real(wp), intent(in) :: a
114  end subroutine i_scal
115  end interface
116 
117 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
118 contains
119 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
120 
121  !-----------------------------------------------------------------------------
122  ! Default subroutines: composite operations
123  !-----------------------------------------------------------------------------
124 
125  !-----------------------------------------------------------------------------
134  !-----------------------------------------------------------------------------
135  subroutine s_vector_space__add(self, x, y)
136  class(sll_c_vector_space), intent(inout) :: self
137  class(sll_c_vector_space), intent(in) :: x
138  class(sll_c_vector_space), intent(in) :: y
139 
140  call self%copy(x)
141  call self%incr(y)
142 
143  end subroutine s_vector_space__add
144 
145  !-----------------------------------------------------------------------------
155  !-----------------------------------------------------------------------------
156  subroutine s_vector_space__mult(self, a, x)
157  class(sll_c_vector_space), intent(inout) :: self
158  real(wp), intent(in) :: a
159  class(sll_c_vector_space), intent(in) :: x
160 
161  call self%copy(x)
162  call self%scal(a)
163 
164  end subroutine s_vector_space__mult
165 
166  !-----------------------------------------------------------------------------
177  !-----------------------------------------------------------------------------
178  subroutine s_vector_space__mult_add(self, a, x, y)
179  class(sll_c_vector_space), intent(inout) :: self
180  real(wp), intent(in) :: a
181  class(sll_c_vector_space), intent(in) :: x
182  class(sll_c_vector_space), intent(in) :: y
183 
184  call self%mult(a, x)
185  call self%incr(y)
186 
187  end subroutine s_vector_space__mult_add
188 
189  !-----------------------------------------------------------------------------
198  !-----------------------------------------------------------------------------
199  subroutine s_vector_space__incr_mult(self, a, x)
200  class(sll_c_vector_space), intent(inout) :: self
201  real(wp), intent(in) :: a
202  class(sll_c_vector_space), intent(in) :: x
203 
204  class(sll_c_vector_space), allocatable :: temp
205 
206  call self%source(temp)
207  call temp%mult(a, x)
208  call self%incr(temp)
209 
210  deallocate (temp)
211 
212  end subroutine s_vector_space__incr_mult
213 
214  !-----------------------------------------------------------------------------
224  !-----------------------------------------------------------------------------
225  subroutine s_vector_space__lcmb(self, a, x)
226  class(sll_c_vector_space), intent(inout) :: self
227  real(wp), intent(in) :: a(:)
228  class(sll_c_vector_space), intent(in) :: x(:)
229 
230  class(sll_c_vector_space), allocatable :: temp
231  integer :: i
232 
233  call self%source(temp)
234  call self%mult(a(1), x(1))
235 
236  do i = 2, size(a)
237  call temp%mult(a(i), x(i))
238  call self%incr(temp)
239  end do
240 
241  deallocate (temp)
242 
243  end subroutine s_vector_space__lcmb
244 
245  !-----------------------------------------------------------------------------
255  !-----------------------------------------------------------------------------
256  subroutine s_vector_space__incr_lcmb(self, a, x)
257  class(sll_c_vector_space), intent(inout) :: self
258  real(wp), intent(in) :: a(:)
259  class(sll_c_vector_space), intent(in) :: x(:)
260 
261  class(sll_c_vector_space), allocatable :: temp
262  integer :: i
263 
264  call self%source(temp)
265 
266  do i = 1, size(a)
267  call temp%mult(a(i), x(i))
268  call self%incr(temp)
269  end do
270 
271  deallocate (temp)
272 
273  end subroutine s_vector_space__incr_lcmb
274 
275  !-----------------------------------------------------------------------------
276  ! Empty functions/subroutines: optional operations and debugging
277  !-----------------------------------------------------------------------------
278 
279  !-----------------------------------------------------------------------------
287  !-----------------------------------------------------------------------------
288  function f_vector_space__norm(self) result(res)
289  class(sll_c_vector_space), intent(in) :: self
290  real(wp) :: res
291 
292  res = sqrt(self%inner(self))
293 
294  end function f_vector_space__norm
295 
296  !-----------------------------------------------------------------------------
305  !-----------------------------------------------------------------------------
306  function f_vector_space__inner(self, x) result(res)
307  class(sll_c_vector_space), intent(in) :: self
308  class(sll_c_vector_space), intent(in) :: x
309  real(wp) :: res
310 
311  sll_error("sll_c_vector_space % inner", "Function not implemented.")
312 
313 #ifdef DEBUG
314  print *, storage_size(self), storage_size(x)
315 #endif
316 
317  res = 0.0_f64
318 
319  end function f_vector_space__inner
320 
321  !-----------------------------------------------------------------------------
324  !-----------------------------------------------------------------------------
325  subroutine s_vector_space__show(self)
326  class(sll_c_vector_space), intent(in) :: self
327 
328  sll_warning("sll_c_vector_space % show", "Overload this subroutine if you need it.")
329 
330  print *, storage_size(self)
331 
332  end subroutine s_vector_space__show
333 
334  !-----------------------------------------------------------------------------
343  !-----------------------------------------------------------------------------
344  subroutine s_vector_space__source_scalar(self, x)
345  class(sll_c_vector_space), intent(in) :: self
346  class(sll_c_vector_space), allocatable, intent(out) :: x
347 
348  allocate (x, source=self)
349 
350  end subroutine s_vector_space__source_scalar
351 
352  !-----------------------------------------------------------------------------
363  !-----------------------------------------------------------------------------
364  subroutine s_vector_space__source_array(self, x, n)
365  class(sll_c_vector_space), intent(in) :: self
366  class(sll_c_vector_space), allocatable, intent(out) :: x(:)
367  integer, intent(in) :: n
368 
369  allocate (x(n), source=self)
370 
371  end subroutine s_vector_space__source_array
372 
373 end module sll_m_vector_space_base
Abstract type implementing a generic vector space.
subroutine s_vector_space__source_scalar(self, x)
Copy constructor: create one copy of vector z
subroutine s_vector_space__show(self)
Show something, for debug.
real(wp) function f_vector_space__norm(self)
Norm of vector: ||z||.
integer, parameter wp
Working precision.
subroutine s_vector_space__incr_mult(self, a, x)
z += a * x
subroutine s_vector_space__mult_add(self, a, x, y)
z = a * x + y
real(wp) function f_vector_space__inner(self, x)
Inner product: <z,x>
subroutine s_vector_space__add(self, x, y)
z = x + y
subroutine s_vector_space__lcmb(self, a, x)
z =
subroutine s_vector_space__source_array(self, x, n)
Copy constructor: create n copies of vector z
subroutine s_vector_space__incr_lcmb(self, a, x)
z +=
subroutine s_vector_space__mult(self, a, x)
z = a * x
Module to select the kind parameter.
integer, parameter, public f64
f64 is the kind type for 64-bit reals (double precision)
function scal(x, y, n)
Definition: sol.f:173
Abstract base class for all vector spaces.
    Report Typos and Errors