Choral
ode_problem_mod.f90
Go to the documentation of this file.
1 
94 
96 
99  use real_type
100  use basic_tools
101  use abstract_interfaces, only: rntorn
102  use ode_def
103 
104  implicit none
105  private
106 
107  public :: ode_problem
108 
109  public :: clear, valid, print
110  public :: name_ode_problem
111 
112 
113  ! %----------------------------------------%
114  ! | |
115  ! | DERIVED TYPE |
116  ! | |
117  ! %----------------------------------------%
122  type :: ode_problem
123 
125  integer :: type = -1
126 
128  integer :: n = 1
129 
131  integer :: na = 0
132 
135  integer :: dim = 3
136 
139  integer :: dof = 1
140 
142  real(RP), dimension(:,:), allocatable :: x
143 
145  procedure(ode_reaction),nopass, pointer:: ab =>null()
146 
148  procedure(rntorn), nopass, pointer :: m =>null()
149 
151  procedure(rntorn), nopass, pointer :: s =>null()
152 
153  contains
154 
157 
158  end type ode_problem
159 
160 
161  ! %----------------------------------------%
162  ! | |
163  ! | GENERIc SUBROUTINES |
164  ! | |
165  ! %----------------------------------------%
166  interface clear
167  module procedure ode_problem_clear
168  end interface clear
169 
170  interface ode_problem
171  module procedure ode_problem_create
172  end interface ode_problem
173 
174  interface valid
175  module procedure ode_problem_valid
176  end interface valid
177 
178  interface print
179  module procedure ode_problem_print
180  end interface print
181 
182 contains
183 
186  subroutine ode_problem_clear(pb)
187  type(ode_problem), intent(inout) :: pb
188 
189  pb%AB =>null()
190  pb%M =>null()
191  pb%S =>null()
192 
193  pb%type = -1
194  pb%dim = 3
195  pb%N = 1
196  pb%Na = 0
197  pb%dof = 1
198 
199  end subroutine ode_problem_clear
200 
201 
202 
222  function ode_problem_create(type, dim, dof, X, M, S, AB, N, Na) &
223  & result(pb)
224  type(ode_problem) :: pb
225  integer , intent(in) :: type
226  integer , optional :: dim
227  integer , optional :: dof, N, Na
228  procedure(rntorn) , optional :: M, S
229  real(RP), dimension(:,:) , optional :: X
230  procedure(ode_reaction) , optional :: AB
231 
232  if (choral_verb>0) write(*,*) &
233  & "ode_problem_mod : ode_problem_create"
234  call clear(pb)
235 
236  pb%type = type
237  if (present(dim)) then
238  pb%dim = dim
239  if (dim==0) call allocmem(pb%x, 3, 1)
240  end if
241 
242  if (present(dof)) pb%dof = dof
243  if (present(n )) pb%N = n
244  if (present(na)) pb%Na = na
245 
246  if (present(x)) then
247  call allocmem(pb%X, size(x,1), size(x,2))
248  pb%X = x
249  end if
250  if (present(m)) pb%M => m
251  if (present(s)) pb%S => s
252  if (present(ab)) pb%AB => ab
253 
254  if (.NOT.valid(pb)) call quit(&
255  & "ode_problem_mod: ode_problem_create: not valid")
256 
257  end function ode_problem_create
258 
259 
262  function ode_problem_valid(pb) result(bool)
263  type(ode_problem), intent(in) :: pb
264  logical :: bool
265 
266  !! Ode problem type
267  bool = (pb%type>0) .AND. (pb%type<=ode_pb_tot_nb)
268  if (.NOT.bool) return
269 
270  !! ODE problem characteristics
271  bool = (pb%N>=1) .AND. (pb%Na>=0) .AND. (pb%Na<=pb%N)
272  bool = bool .AND. (pb%dof >= 1)
273  if (.NOT.bool) return
274 
275  !! ODE problem where X is needed
276  select case(pb%type)
278 
279  bool = (allocated(pb%X))
280  if (.NOT.bool) return
281 
282  bool = (size(pb%X,1)==3).AND.(size(pb%X,2)==pb%dof)
283  if (.NOT.bool) return
284 
285  if (pb%dim == 0) then
286  bool = (pb%dof==1)
287  end if
288  if (.NOT.bool) return
289 
290  end select
291 
292  !! problem specific requirements
293  select case(pb%type)
294 
295  case(ode_pb_lin)
296  bool = associated(pb%M) .AND. associated(pb%S)
297 
298  case(ode_pb_nl)
299  bool = associated(pb%AB)
300 
301  case(ode_pb_sl)
302  bool = associated(pb%M) .AND. associated(pb%S)
303  bool = bool .AND. associated(pb%AB)
304 
305  !! semilinear problems have size N=1
306  bool = bool .AND. (pb%N==1)
307 
308  case(ode_pb_sl_nl)
309  bool = associated(pb%M) .AND. associated(pb%S)
310  bool = bool .AND. associated(pb%AB)
311 
312  end select
313 
314  end function ode_problem_valid
315 
318  function name_ode_problem(type) result(name)
319  integer, intent(in) :: type
320  character(len=15) :: name
321 
322  select case(type)
323  case(ode_pb_lin)
324  name = "ODE_PB_LIN"
325 
326  case(ode_pb_nl)
327  name = "ODE_PB_NL"
328 
329  case(ode_pb_sl)
330  name = "ODE_PB_SL"
331 
332  case(ode_pb_sl_nl)
333  name = "ODE_PB_SL_NL"
334 
335  case default
336  name = 'invalid'
337 
338  end select
339 
340  end function name_ode_problem
341 
342 
345  subroutine ode_problem_print(pb)
346  type(ode_problem) , intent(in) :: pb
347 
348  character(len=15) :: name
349 
350  write(*,*)"ode_problem_mod : ode_problem_print"
351  name = name_ode_problem(pb%type)
352 
353  write(*,*)" Problem type = ", name
354  write(*,*)" Problem sizes N, Na =", pb%N, pb%Na
355 
356  if (pb%dim == 0) then
357  write(*,*)" 0D problem, No disc. nodes in space"
358  else
359  write(*,*)" Number of nodes in space =", pb%dof
360  end if
361 
362  if ( valid(pb)) then
363  write(*,*)" Status = valid"
364 
365  else
366  write(*,*)" Status = invalid"
367  write(*,*)" Associated M =", associated(pb%M)
368  write(*,*)" Associated S =", associated(pb%S)
369  write(*,*)" Associated AB =", associated(pb%AB)
370  write(*,*)" Allocated X =", allocated(pb%X)
371  if (allocated(pb%X)) then
372  write(*,*)" Shape of the array X =", shape(pb%X)
373  end if
374  end if
375 
376  end subroutine ode_problem_print
377 
378 end module ode_problem_mod
DEFINITION OF ABSTRACT_INTERFACES FOR THE LIBRARY CHORAL
BASIC TOOLS
Definition: basic_tools.F90:8
DERIVED TYPE ode_problem: definition of ODE/PDE problems
subroutine ode_problem_print(pb)
print ode_problem
subroutine, public quit(message)
Stop program execution, display an error messahe.
integer, parameter ode_pb_tot_nb
Number of ode problem types.
Abstract interface: .
Definition: ode_def.f90:40
REAL NUMBERS PRECISION IN CHORAL: selects simple/double/quad
Definition: real_type.F90:33
integer, parameter ode_pb_sl
SemiLinear ODE : with .
integer, parameter ode_pb_lin
Linear ODE : .
logical function ode_problem_valid(pb)
check ode_problem
subroutine ode_problem_clear(pb)
destructor for ode_problem
CHORAL CONSTANTS
type(ode_problem) function ode_problem_create(type, dim, dof, X, M, S, AB, N, Na)
Constructor for the type ode_problem
allocate memory for real(RP) arrays
Definition: real_type.F90:158
BOTTOM LEVEL MODULE FOR ODEs
Definition: ode_def.f90:12
integer choral_verb
Verbosity level.
integer, parameter ode_pb_sl_nl
SemiLinear ODE coupled with a non-linear ODE system for with .
DEFINITION OF GLOBAL VARIABLES FOR THE LIBRARY CHORAL
integer, parameter na
character(len=15) function, public name_ode_problem(type)
ode_problem name
Type ode_problem: definition of ODE/PDE problems.
integer, parameter ode_pb_nl
Non-Linear ODE system: , .