Report Typos and Errors    
Semi-Lagrangian Library
Modular library for kinetic and gyrokinetic simulations of plasmas in fusion energy devices.
sll_m_nml_mesh_1d_cart.F90
Go to the documentation of this file.
1 ! Copyright INRIA
2 ! Authors :
3 ! CALVI project team
4 !
5 ! This code SeLaLib (for Semi-Lagrangian-Library)
6 ! is a parallel library for simulating the plasma turbulence
7 ! in a tokamak.
8 !
9 ! This software is governed by the CeCILL-B license
10 ! under French law and abiding by the rules of distribution
11 ! of free software. You can use, modify and redistribute
12 ! the software under the terms of the CeCILL-B license as
13 ! circulated by CEA, CNRS and INRIA at the following URL
14 ! "http://www.cecill.info".
15 !**************************************************************
51 
59 
60 !-----------------------------------------------------------------
61 ! SPECIFIC DOCUMENTATION (BEGIN)
62 !-----------------------------------------------------------------
63 
84 
85 !-----------------------------------------------------------------
86 ! SPECIFIC DOCUMENTATION (END)
87 !-----------------------------------------------------------------
88 
89 module sll_m_nml_mesh_1d_cart
90 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
91 #include "sll_errors.h"
92 #include "sll_memory.h"
93 #include "sll_working_precision.h"
94 
95  use sll_m_nml_mesh_1d_landau_cart, only: &
96  sll_o_nml_mesh_1d_landau_cart
97 
98  use sll_m_nml_mesh_1d_two_grid_cart, only: &
99  sll_o_nml_mesh_1d_two_grid_cart
100 
101  use sll_m_nml_mesh_1d_unif_cart, only: &
102  sll_o_nml_mesh_1d_unif_cart
103 
104  use sll_m_utilities, only: &
105  sll_s_new_file_id
106 
107  implicit none
108 
109  public :: &
110  sll_o_nml_mesh_1d_cart
111 
112  private
113 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
114 
115  type :: sll_t_nml_mesh_1d_cart
116  character(len=256) :: choice
117  character(len=256) :: label
118  contains
119  procedure, pass(self) :: init => init_nml_mesh_1d_cart
120  procedure, pass(self) :: init_1 => init_nml_mesh_1d_cart_1
121  procedure, pass(self) :: init_2 => init_nml_mesh_1d_cart_2
122  procedure, pass(self) :: init_3 => init_nml_mesh_1d_cart_3
123  procedure, pass(self) :: init_4 => init_nml_mesh_1d_cart_4
124  procedure, pass(self) :: init_clone => init_clone_nml_mesh_1d_cart
125  end type sll_t_nml_mesh_1d_cart
126 
127  !-----------------------------------------------------------------
128  ! SPECIFIC DECLARATION (BEGIN)
129  !-----------------------------------------------------------------
130 
131  interface sll_o_nml_mesh_1d_cart
132  module procedure &
133  s_nml_mesh_1d_cart_array, &
134  s_nml_mesh_1d_cart_print
135  end interface sll_o_nml_mesh_1d_cart
136 
137  !-----------------------------------------------------------------
138  ! SPECIFIC DECLARATION (END)
139  !-----------------------------------------------------------------
140 
141 contains
142 
143  !-----------------------------------------------------------------
144  ! SPECIFIC SUBROUTINES (BEGIN)
145  !-----------------------------------------------------------------
146 
148  subroutine s_nml_mesh_1d_cart_array( &
149  filename, &
150  array, &
151  clone, &
152  proc_id)
153 
154  character(len=*), intent(in) :: filename
155  sll_real64, pointer, intent(out) :: array(:)
156  character(len=*), intent(in), optional :: clone
157  sll_int32, intent(in), optional :: proc_id
158 
159  type(sll_t_nml_mesh_1d_cart) :: self
160  character(len=256) :: err_msg
161  character(len=256) :: caller
162 
163  if (present(clone)) then
164  call self%init_clone(clone, filename, proc_id)
165  else
166  call self%init(filename, proc_id)
167  end if
168 
169  caller = 's_nml_mesh_1d_cart_array'
170  select case (self%choice)
171  case ("unif")
172  call sll_o_nml_mesh_1d_unif_cart( &
173  filename, &
174  array, &
175  clone, &
176  proc_id)
177  case ("landau")
178  call sll_o_nml_mesh_1d_landau_cart( &
179  filename, &
180  array, &
181  clone, &
182  proc_id)
183  case ("two_grid")
184  call sll_o_nml_mesh_1d_two_grid_cart( &
185  filename, &
186  array, &
187  clone, &
188  proc_id)
189  case default
190  err_msg = 'bad value for self%choice'
191  sll_error(trim(caller), trim(err_msg))
192  end select
193 
194  end subroutine s_nml_mesh_1d_cart_array
195 
196  !-----------------------------------------------------------------
197  ! SPECIFIC SUBROUTINES (END)
198  !-----------------------------------------------------------------
199 
201  subroutine s_nml_mesh_1d_cart_print( &
202  filename, &
203  clone, &
204  proc_id)
205 
206  character(len=*), intent(in) :: filename
207  character(len=*), intent(in), optional :: clone
208  sll_int32, intent(in), optional :: proc_id
209 
210  type(sll_t_nml_mesh_1d_cart) :: self
211  sll_int32 :: proc_id_loc
212 
213  if (present(clone)) then
214  call self%init_clone(clone, filename, proc_id)
215  else
216  call self%init(filename, proc_id)
217  end if
218 
219  if (present(proc_id)) then
220  proc_id_loc = proc_id
221  else
222  proc_id_loc = 0
223  end if
224 
225  if (proc_id_loc == 0) then
226  print *, '#nml_mesh_1d_cart:'
227 
228  print *, '#label=', trim(self%label)
229  print *, '#choice=', self%choice
230  end if
231 
232  end subroutine s_nml_mesh_1d_cart_print
233 
234 #ifndef DOXYGEN_SHOULD_SKIP_THIS
235 
236  subroutine init_clone_nml_mesh_1d_cart( &
237  self, &
238  clone, &
239  filename, &
240  proc_id)
241  class(sll_t_nml_mesh_1d_cart), intent(inout) :: self
242  character(len=*), intent(in) :: clone
243  character(len=*), intent(in) :: filename
244  sll_int32, intent(in), optional :: proc_id
245 
246  character(len=256) :: err_msg
247  character(len=256) :: caller
248 
249  caller = 'init_clone_nml_mesh_1d_cart'
250  select case (clone)
251  case ("_1")
252  call self%init_1(filename, proc_id)
253  case ("_2")
254  call self%init_2(filename, proc_id)
255  case ("_3")
256  call self%init_3(filename, proc_id)
257  case ("_4")
258  call self%init_4(filename, proc_id)
259  case default
260  err_msg = 'bad value for clone'
261  sll_error(trim(caller), trim(err_msg))
262  end select
263 
264  end subroutine init_clone_nml_mesh_1d_cart
265 
266  subroutine init_nml_mesh_1d_cart( &
267  self, &
268  filename, &
269  proc_id)
270  class(sll_t_nml_mesh_1d_cart), intent(inout) :: self
271  character(len=*), intent(in) :: filename
272  sll_int32, intent(in), optional :: proc_id
273 
274  sll_int32 :: namelist_id
275  sll_int32 :: ierr
276  sll_int32 :: io_stat
277  character(len=256) :: err_msg
278  character(len=256) :: caller
279  character(len=256) :: choice
280  sll_int32 :: proc_id_loc
281 
282  namelist /mesh_1d_cart/ &
283  choice
284  caller = 'init_nml_mesh_1d_cart'
285  if (present(proc_id)) then
286  proc_id_loc = proc_id
287  else
288  proc_id_loc = 0
289  end if
290 
291  call set_default_values( &
292  choice)
293 
294  call sll_s_new_file_id(namelist_id, ierr)
295  open ( &
296  unit=namelist_id, &
297  file=trim(filename)//'.nml', &
298  iostat=io_stat)
299  if (io_stat /= 0) then
300  err_msg = &
301  'failed to open first file '//trim(filename)//'.nml'
302  sll_error(trim(caller), trim(err_msg))
303  end if
304 
305  read (namelist_id, mesh_1d_cart)
306  self%label = "no_label"
307  self%choice = choice
308  close (namelist_id)
309 
310  end subroutine init_nml_mesh_1d_cart
311 
312  subroutine init_nml_mesh_1d_cart_1( &
313  self, &
314  filename, &
315  proc_id)
316  class(sll_t_nml_mesh_1d_cart), intent(inout) :: self
317  character(len=*), intent(in) :: filename
318  sll_int32, intent(in), optional :: proc_id
319 
320  sll_int32 :: namelist_id
321  sll_int32 :: ierr
322  sll_int32 :: io_stat
323  character(len=256) :: err_msg
324  character(len=256) :: caller
325  character(len=256) :: choice_1
326  sll_int32 :: proc_id_loc
327 
328  namelist /mesh_1d_cart_1/ &
329  choice_1
330 
331  caller = 'init_nml_mesh_1d_cart_1'
332  if (present(proc_id)) then
333  proc_id_loc = proc_id
334  else
335  proc_id_loc = 0
336  end if
337 
338  call set_default_values( &
339  choice_1)
340 
341  call sll_s_new_file_id(namelist_id, ierr)
342  open ( &
343  unit=namelist_id, &
344  file=trim(filename)//'.nml', &
345  iostat=io_stat)
346  if (io_stat /= 0) then
347  err_msg = &
348  'failed to open first file '//trim(filename)//'.nml'
349  sll_error(trim(caller), trim(err_msg))
350  end if
351 
352  read (namelist_id, mesh_1d_cart_1)
353  self%label = "_1"
354  self%choice = choice_1
355  close (namelist_id)
356 
357  end subroutine init_nml_mesh_1d_cart_1
358 
359  subroutine init_nml_mesh_1d_cart_2( &
360  self, &
361  filename, &
362  proc_id)
363  class(sll_t_nml_mesh_1d_cart), intent(inout) :: self
364  character(len=*), intent(in) :: filename
365  sll_int32, intent(in), optional :: proc_id
366 
367  sll_int32 :: namelist_id
368  sll_int32 :: ierr
369  sll_int32 :: io_stat
370  character(len=256) :: err_msg
371  character(len=256) :: caller
372  character(len=256) :: choice_2
373  sll_int32 :: proc_id_loc
374 
375  namelist /mesh_1d_cart_2/ &
376  choice_2
377 
378  caller = 'init_nml_mesh_1d_cart_2'
379  if (present(proc_id)) then
380  proc_id_loc = proc_id
381  else
382  proc_id_loc = 0
383  end if
384 
385  call set_default_values( &
386  choice_2)
387 
388  call sll_s_new_file_id(namelist_id, ierr)
389  open ( &
390  unit=namelist_id, &
391  file=trim(filename)//'.nml', &
392  iostat=io_stat)
393  if (io_stat /= 0) then
394  err_msg = &
395  'failed to open first file '//trim(filename)//'.nml'
396  sll_error(trim(caller), trim(err_msg))
397  end if
398 
399  read (namelist_id, mesh_1d_cart_2)
400  self%label = "_2"
401  self%choice = choice_2
402  close (namelist_id)
403 
404  end subroutine init_nml_mesh_1d_cart_2
405 
406  subroutine init_nml_mesh_1d_cart_3( &
407  self, &
408  filename, &
409  proc_id)
410  class(sll_t_nml_mesh_1d_cart), intent(inout) :: self
411  character(len=*), intent(in) :: filename
412  sll_int32, intent(in), optional :: proc_id
413 
414  sll_int32 :: namelist_id
415  sll_int32 :: ierr
416  sll_int32 :: io_stat
417  character(len=256) :: err_msg
418  character(len=256) :: caller
419  character(len=256) :: choice_3
420  sll_int32 :: proc_id_loc
421 
422  namelist /mesh_1d_cart_3/ &
423  choice_3
424 
425  caller = 'init_nml_mesh_1d_cart_3'
426  if (present(proc_id)) then
427  proc_id_loc = proc_id
428  else
429  proc_id_loc = 0
430  end if
431 
432  call set_default_values( &
433  choice_3)
434 
435  call sll_s_new_file_id(namelist_id, ierr)
436  open ( &
437  unit=namelist_id, &
438  file=trim(filename)//'.nml', &
439  iostat=io_stat)
440  if (io_stat /= 0) then
441  err_msg = &
442  'failed to open first file '//trim(filename)//'.nml'
443  sll_error(trim(caller), trim(err_msg))
444  end if
445 
446  read (namelist_id, mesh_1d_cart_3)
447  self%label = "_3"
448  self%choice = choice_3
449  close (namelist_id)
450 
451  end subroutine init_nml_mesh_1d_cart_3
452 
453  subroutine init_nml_mesh_1d_cart_4( &
454  self, &
455  filename, &
456  proc_id)
457  class(sll_t_nml_mesh_1d_cart), intent(inout) :: self
458  character(len=*), intent(in) :: filename
459  sll_int32, intent(in), optional :: proc_id
460 
461  sll_int32 :: namelist_id
462  sll_int32 :: ierr
463  sll_int32 :: io_stat
464  character(len=256) :: err_msg
465  character(len=256) :: caller
466  character(len=256) :: choice_4
467  sll_int32 :: proc_id_loc
468 
469  namelist /mesh_1d_cart_4/ &
470  choice_4
471 
472  caller = 'init_nml_mesh_1d_cart_4'
473  if (present(proc_id)) then
474  proc_id_loc = proc_id
475  else
476  proc_id_loc = 0
477  end if
478 
479  call set_default_values( &
480  choice_4)
481 
482  call sll_s_new_file_id(namelist_id, ierr)
483  open ( &
484  unit=namelist_id, &
485  file=trim(filename)//'.nml', &
486  iostat=io_stat)
487  if (io_stat /= 0) then
488  err_msg = &
489  'failed to open first file '//trim(filename)//'.nml'
490  sll_error(trim(caller), trim(err_msg))
491  end if
492 
493  read (namelist_id, mesh_1d_cart_4)
494  self%label = "_4"
495  self%choice = choice_4
496  close (namelist_id)
497 
498  end subroutine init_nml_mesh_1d_cart_4
499 
500  subroutine set_default_values( &
501  choice)
502  character(len=256), intent(inout) :: choice
503 
504  choice = "landau"
505 
506  end subroutine set_default_values
507 
508 #endif /* DOXYGEN_SHOULD_SKIP_THIS */
509 
510 end module sll_m_nml_mesh_1d_cart
sll_m_nml_mesh_1d_cart::sll_o_nml_mesh_1d_cart
Definition: sll_m_nml_mesh_1d_cart.F90:131
sll_m_nml_mesh_1d_landau_cart::sll_o_nml_mesh_1d_landau_cart
Definition: sll_m_nml_mesh_1d_landau_cart.F90:165
sll_m_nml_mesh_1d_two_grid_cart::sll_o_nml_mesh_1d_two_grid_cart
Definition: sll_m_nml_mesh_1d_two_grid_cart.F90:170
sll_m_nml_mesh_1d_unif_cart::sll_o_nml_mesh_1d_unif_cart
Definition: sll_m_nml_mesh_1d_unif_cart.F90:154
sll_m_nml_mesh_1d_cart
initialization of 1d cartesian mesh from namelist
Definition: sll_m_nml_mesh_1d_cart.F90:89
sll_m_nml_mesh_1d_cart::s_nml_mesh_1d_cart_array
subroutine s_nml_mesh_1d_cart_array(filename, array, clone, proc_id)
create 1d array from namelist
Definition: sll_m_nml_mesh_1d_cart.F90:153
sll_m_nml_mesh_1d_cart::s_nml_mesh_1d_cart_print
subroutine s_nml_mesh_1d_cart_print(filename, clone, proc_id)
print namelist info
Definition: sll_m_nml_mesh_1d_cart.F90:205
sll_m_nml_mesh_1d_landau_cart
initialization of 1d landau cartesian mesh from namelist
Definition: sll_m_nml_mesh_1d_landau_cart.F90:122
sll_m_nml_mesh_1d_two_grid_cart
initialization of 1d two grid cartesian mesh from namelist
Definition: sll_m_nml_mesh_1d_two_grid_cart.F90:128
sll_m_nml_mesh_1d_unif_cart
initialization of 1d uniform cartesian mesh from namelist
Definition: sll_m_nml_mesh_1d_unif_cart.F90:115
sll_m_utilities
Some common numerical utilities.
Definition: sll_m_utilities.F90:20
sll_m_utilities::sll_s_new_file_id
subroutine, public sll_s_new_file_id(file_id, error)
Get a file unit number free before creating a file.
Definition: sll_m_utilities.F90:191
sll_m_nml_mesh_1d_cart::sll_t_nml_mesh_1d_cart
Definition: sll_m_nml_mesh_1d_cart.F90:115
    Report Typos and Errors
Generated on Mon Oct 23 2023 19:15:41 for Semi-Lagrangian Library by   doxygen 1.9.1