Neko  0.9.0
A portable framework for high-order spectral element flow simulations
coriolis_source_term.f90
Go to the documentation of this file.
1 ! Copyright (c) 2024, The Neko Authors
2 ! All rights reserved.
3 !
4 ! Redistribution and use in source and binary forms, with or without
5 ! modification, are permitted provided that the following conditions
6 ! are met:
7 !
8 ! * Redistributions of source code must retain the above copyright
9 ! notice, this list of conditions and the following disclaimer.
10 !
11 ! * Redistributions in binary form must reproduce the above
12 ! copyright notice, this list of conditions and the following
13 ! disclaimer in the documentation and/or other materials provided
14 ! with the distribution.
15 !
16 ! * Neither the name of the authors nor the names of its
17 ! contributors may be used to endorse or promote products derived
18 ! from this software without specific prior written permission.
19 !
20 ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 ! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 ! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 ! FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 ! COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 ! INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 ! BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 ! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 ! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29 ! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30 ! ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 ! POSSIBILITY OF SUCH DAMAGE.
32 !
35 
37  use num_types, only : rp
38  use field_list, only : field_list_t
39  use json_module, only : json_file
41  use source_term, only : source_term_t
42  use coefs, only : coef_t
43  use neko_config, only : neko_bcknd_device
44  use utils, only : neko_error
46  implicit none
47  private
48 
50  type, public, extends(source_term_t) :: coriolis_source_term_t
52  real(kind=rp) :: omega(3)
54  real(kind=rp) :: u_geo(3) = 0
55  contains
57  procedure, pass(this) :: init => coriolis_source_term_init_from_json
59  procedure, pass(this) :: init_from_compenents => &
62  procedure, pass(this) :: free => coriolis_source_term_free
64  procedure, pass(this) :: compute_ => coriolis_source_term_compute
65  end type coriolis_source_term_t
66 
67 contains
72  subroutine coriolis_source_term_init_from_json(this, json, fields, coef)
73  class(coriolis_source_term_t), intent(inout) :: this
74  type(json_file), intent(inout) :: json
75  type(field_list_t), intent(inout), target :: fields
76  type(coef_t), intent(inout), target :: coef
77  ! Rotation vector and geostrophic wind
78  real(kind=rp), allocatable :: rotation_vec(:), u_geo(:)
79  ! Alternative parameters to set the rotation vector
80  real(kind=rp) :: omega, phi, f, pi
81  real(kind=rp) :: start_time, end_time
82 
83  call json_get_or_default(json, "start_time", start_time, 0.0_rp)
84  call json_get_or_default(json, "end_time", end_time, huge(0.0_rp))
85 
86  if (json%valid_path("geostrophic_wind")) then
87  call json_get(json, "geostrophic_wind", u_geo)
88  else
89  allocate(u_geo(3))
90  u_geo = 0.0_rp
91  end if
92 
93  if (json%valid_path("rotation_vector")) then
94  call json_get(json, "rotation_vector", rotation_vec)
95  else if (json%valid_path("omega") .and. json%valid_path("phi")) then
96  call json_get(json, "phi", phi)
97  call json_get(json, "omega", omega)
98 
99  allocate(rotation_vec(3))
100  pi = 4 * atan(1.0_rp)
101  rotation_vec(1) = 0.0_rp
102  rotation_vec(2) = omega * cos(phi * pi / 180 )
103  rotation_vec(3) = omega * sin(phi * pi / 180)
104  else if (json%valid_path("f")) then
105  call json_get(json, "f", phi)
106 
107  allocate(rotation_vec(3))
108  rotation_vec(1) = 0.0_rp
109  rotation_vec(2) = 0.0_rp
110  rotation_vec(3) = 0.5_rp * f
111  else
112  call neko_error("Specify either rotation_vector, phi and omega, or f &
113  & for the Coriolis source term.")
114  end if
115 
116 
117 
118  call coriolis_source_term_init_from_components(this, fields, rotation_vec, &
119  u_geo, coef, start_time, end_time)
120 
122 
130  subroutine coriolis_source_term_init_from_components(this, fields, omega, &
131  u_geo, coef, start_time, end_time)
132  class(coriolis_source_term_t), intent(inout) :: this
133  class(field_list_t), intent(inout), target :: fields
134  real(kind=rp), intent(in) :: omega(3)
135  real(kind=rp), intent(in) :: u_geo(3)
136  type(coef_t) :: coef
137  real(kind=rp), intent(in) :: start_time
138  real(kind=rp), intent(in) :: end_time
139 
140  call this%free()
141  call this%init_base(fields, coef, start_time, end_time)
142 
143  if (fields%size() .ne. 3) then
144  call neko_error("Number of fields for the Coriolis force must be 3.")
145  end if
146 
147  this%omega = omega
148  this%u_geo = u_geo
150 
152  subroutine coriolis_source_term_free(this)
153  class(coriolis_source_term_t), intent(inout) :: this
154 
155  call this%free_base()
156  end subroutine coriolis_source_term_free
157 
161  subroutine coriolis_source_term_compute(this, t, tstep)
162  class(coriolis_source_term_t), intent(inout) :: this
163  real(kind=rp), intent(in) :: t
164  integer, intent(in) :: tstep
165 
166  if (neko_bcknd_device .eq. 1) then
167  call neko_error("The Coriolis force is only implemented on the CPU")
168  else
169  call coriolis_source_term_compute_cpu(this%fields, this%omega, &
170  this%u_geo)
171  end if
172  end subroutine coriolis_source_term_compute
173 
174 end module coriolis_source_term
Retrieves a parameter by name or assigns a provided default value. In the latter case also adds the m...
Definition: json_utils.f90:54
Retrieves a parameter by name or throws an error.
Definition: json_utils.f90:45
Coefficients.
Definition: coef.f90:34
Implements the cpu kernel for the coriolis_source_term_t type. Maintainer: Timofey Mukha.
subroutine, public coriolis_source_term_compute_cpu(fields, omega, u_geo)
Computes the generic Coriolis source term on the cpu.
Implements the coriolis_source_term_t type. Maintainer: Timofey Mukha.
subroutine coriolis_source_term_init_from_components(this, fields, omega, u_geo, coef, start_time, end_time)
The constructor from type components.
subroutine coriolis_source_term_init_from_json(this, json, fields, coef)
The common constructor using a JSON object.
subroutine coriolis_source_term_free(this)
Destructor.
subroutine coriolis_source_term_compute(this, t, tstep)
Computes the source term and adds the result to fields.
Utilities for retrieving parameters from the case files.
Definition: json_utils.f90:34
Build configurations.
Definition: neko_config.f90:34
integer, parameter neko_bcknd_device
Definition: neko_config.f90:44
integer, parameter, public rp
Global precision used in computations.
Definition: num_types.f90:12
Implements the source_term_t type and a wrapper source_term_wrapper_t.
Definition: source_term.f90:34
Utilities.
Definition: utils.f90:35
Coefficients defined on a given (mesh, ) tuple. Arrays use indices (i,j,k,e): element e,...
Definition: coef.f90:55
This source term adds the Coriolis force.
field_list_t, To be able to group fields together
Definition: field_list.f90:13
Base abstract type for source terms.
Definition: source_term.f90:43