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_unif_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 !**************************************************************
59 
67 
68 !-----------------------------------------------------------------
69 ! SPECIFIC DOCUMENTATION (BEGIN)
70 !-----------------------------------------------------------------
71 
110 
111 !-----------------------------------------------------------------
112 ! SPECIFIC DOCUMENTATION (END)
113 !-----------------------------------------------------------------
114 
116 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
117 #include "sll_errors.h"
118 #include "sll_memory.h"
119 #include "sll_working_precision.h"
120 
121  use sll_m_cartesian_meshes, only: &
124 
125  use sll_m_utilities, only: &
127 
128  implicit none
129 
130  public :: &
132 
133  private
134 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
135 
137  sll_int32 :: num_cells
138  sll_real64 :: eta_min
139  sll_real64 :: eta_max
140  character(len=256) :: label
141  contains
142  procedure, pass(self) :: init => init_nml_mesh_1d_unif_cart
143  procedure, pass(self) :: init_1 => init_nml_mesh_1d_unif_cart_1
144  procedure, pass(self) :: init_2 => init_nml_mesh_1d_unif_cart_2
145  procedure, pass(self) :: init_3 => init_nml_mesh_1d_unif_cart_3
146  procedure, pass(self) :: init_4 => init_nml_mesh_1d_unif_cart_4
147  procedure, pass(self) :: init_clone => init_clone_nml_mesh_1d_unif_cart
149 
150  !-----------------------------------------------------------------
151  ! SPECIFIC DECLARATION (BEGIN)
152  !-----------------------------------------------------------------
153 
155  module procedure &
159  end interface sll_o_nml_mesh_1d_unif_cart
160 
161  !-----------------------------------------------------------------
162  ! SPECIFIC DECLARATION (END)
163  !-----------------------------------------------------------------
164 
165 contains
166 
167  !-----------------------------------------------------------------
168  ! SPECIFIC SUBROUTINES (BEGIN)
169  !-----------------------------------------------------------------
170 
173  filename, & !< namelist file input
174  array, & !< output array
175  clone, & !< optional choice of clone
176  proc_id) !< optional id of proc
177 
178  character(len=*), intent(in) :: filename
179  sll_real64, pointer, intent(out) :: array(:)
180  character(len=*), intent(in), optional :: clone
181  sll_int32, intent(in), optional :: proc_id
182 
183  type(sll_t_nml_mesh_1d_unif_cart) :: self
184  sll_int32 :: ierr
185  sll_int32 :: i
186  sll_int32 :: num_cells
187  sll_real64 :: eta_min
188  sll_real64 :: eta_max
189  sll_real64 :: delta_eta
190 
191  if (present(clone)) then
192  call self%init_clone(clone, filename, proc_id)
193  else
194  call self%init(filename, proc_id)
195  end if
196 
197  num_cells = self%num_cells
198  eta_min = self%eta_min
199  eta_max = self%eta_max
200  delta_eta = (eta_max - eta_min)/real(num_cells, f64)
201 
202  sll_allocate(array(num_cells + 1), ierr)
203  do i = 1, num_cells + 1
204  array(i) = eta_min + real(i - 1, f64)*delta_eta
205  end do
206 
207  end subroutine s_nml_mesh_1d_unif_cart_array
208 
211  filename, & !< namelist file input
212  mesh, & !< output mesh
213  clone, & !< optional choice of clone
214  proc_id) !< optional id of proc
215 
216  character(len=*), intent(in) :: filename
217  type(sll_t_cartesian_mesh_1d), pointer, intent(out) :: mesh
218  character(len=*), intent(in), optional :: clone
219  sll_int32, intent(in), optional :: proc_id
220 
221  type(sll_t_nml_mesh_1d_unif_cart) :: self
222  !sll_int32 :: ierr
223  sll_int32 :: num_cells
224  sll_real64 :: eta_min
225  sll_real64 :: eta_max
226 
227  if (present(clone)) then
228  call self%init_clone(clone, filename, proc_id)
229  else
230  call self%init(filename, proc_id)
231  end if
232 
233  num_cells = self%num_cells
234  eta_min = self%eta_min
235  eta_max = self%eta_max
236 
237  mesh => sll_f_new_cartesian_mesh_1d( &
238  num_cells, &
239  eta_min=eta_min, &
240  eta_max=eta_max)
241 
242  end subroutine s_nml_mesh_1d_unif_cart_mesh
243 
244  !-----------------------------------------------------------------
245  ! SPECIFIC SUBROUTINES (END)
246  !-----------------------------------------------------------------
247 
250  filename, & !< namelist file input
251  clone, & !< optional choice of clone
252  proc_id & !< optional id of proc
253  )
254  character(len=*), intent(in) :: filename
255  character(len=*), intent(in), optional :: clone
256  sll_int32, intent(in), optional :: proc_id
257 
258  type(sll_t_nml_mesh_1d_unif_cart) :: self
259  sll_int32 :: proc_id_loc
260 
261  if (present(clone)) then
262  call self%init_clone(clone, filename, proc_id)
263  else
264  call self%init(filename, proc_id)
265  end if
266 
267  if (present(proc_id)) then
268  proc_id_loc = proc_id
269  else
270  proc_id_loc = 0
271  end if
272 
273  if (proc_id_loc == 0) then
274  print *, '#nml_mesh_1d_unif_cart:'
275 
276  print *, '#label=', trim(self%label)
277  print *, '#num_cells=', self%num_cells
278  print *, '#eta_min=', self%eta_min
279  print *, '#eta_max=', self%eta_max
280  end if
281 
282  end subroutine s_nml_mesh_1d_unif_cart_print
283 
284 #ifndef DOXYGEN_SHOULD_SKIP_THIS
285 
286  subroutine init_clone_nml_mesh_1d_unif_cart( &
287  self, &
288  clone, &
289  filename, &
290  proc_id)
291  class(sll_t_nml_mesh_1d_unif_cart), intent(inout) :: self
292  character(len=*), intent(in) :: clone
293  character(len=*), intent(in) :: filename
294  sll_int32, intent(in), optional :: proc_id
295 
296  character(len=256) :: err_msg
297  character(len=256) :: caller
298 
299  caller = 'init_clone_nml_mesh_1d_unif_cart'
300  select case (clone)
301  case ("_1")
302  call self%init_1(filename, proc_id)
303  case ("_2")
304  call self%init_2(filename, proc_id)
305  case ("_3")
306  call self%init_3(filename, proc_id)
307  case ("_4")
308  call self%init_4(filename, proc_id)
309  case default
310  err_msg = 'bad value for clone'
311  sll_error(trim(caller), trim(err_msg))
312  end select
313 
314  end subroutine init_clone_nml_mesh_1d_unif_cart
315 
316  subroutine init_nml_mesh_1d_unif_cart( &
317  self, &
318  filename, &
319  proc_id)
320  class(sll_t_nml_mesh_1d_unif_cart), intent(inout) :: self
321  character(len=*), intent(in) :: filename
322  sll_int32, intent(in), optional :: proc_id
323 
324  sll_int32 :: namelist_id
325  sll_int32 :: ierr
326  sll_int32 :: io_stat
327  character(len=256) :: err_msg
328  character(len=256) :: caller
329  sll_int32 :: num_cells
330  sll_real64 :: eta_min
331  sll_real64 :: eta_max
332  sll_int32 :: proc_id_loc
333 
334  namelist /mesh_1d_unif_cart/ &
335  num_cells, &
336  eta_min, &
337  eta_max
338  caller = 'init_nml_mesh_1d_unif_cart'
339  if (present(proc_id)) then
340  proc_id_loc = proc_id
341  else
342  proc_id_loc = 0
343  end if
344 
345  call set_default_values( &
346  num_cells, &
347  eta_min, &
348  eta_max)
349 
350  call sll_s_new_file_id(namelist_id, ierr)
351  open ( &
352  unit=namelist_id, &
353  file=trim(filename)//'.nml', &
354  iostat=io_stat)
355  if (io_stat /= 0) then
356  err_msg = &
357  'failed to open first file '//trim(filename)//'.nml'
358  sll_error(trim(caller), trim(err_msg))
359  end if
360 
361  read (namelist_id, mesh_1d_unif_cart)
362  self%label = "no_label"
363  self%num_cells = num_cells
364  self%eta_min = eta_min
365  self%eta_max = eta_max
366  close (namelist_id)
367 
368  end subroutine init_nml_mesh_1d_unif_cart
369 
370  subroutine init_nml_mesh_1d_unif_cart_1( &
371  self, &
372  filename, &
373  proc_id)
374  class(sll_t_nml_mesh_1d_unif_cart), intent(inout) :: self
375  character(len=*), intent(in) :: filename
376  sll_int32, intent(in), optional :: proc_id
377 
378  sll_int32 :: namelist_id
379  sll_int32 :: ierr
380  sll_int32 :: io_stat
381  character(len=256) :: err_msg
382  character(len=256) :: caller
383  sll_int32 :: num_cells_1
384  sll_real64 :: eta_min_1
385  sll_real64 :: eta_max_1
386  sll_int32 :: proc_id_loc
387 
388  namelist /mesh_1d_unif_cart_1/ &
389  num_cells_1, &
390  eta_min_1, &
391  eta_max_1
392 
393  caller = 'init_nml_mesh_1d_unif_cart_1'
394  if (present(proc_id)) then
395  proc_id_loc = proc_id
396  else
397  proc_id_loc = 0
398  end if
399 
400  call set_default_values( &
401  num_cells_1, &
402  eta_min_1, &
403  eta_max_1)
404 
405  call sll_s_new_file_id(namelist_id, ierr)
406  open ( &
407  unit=namelist_id, &
408  file=trim(filename)//'.nml', &
409  iostat=io_stat)
410  if (io_stat /= 0) then
411  err_msg = &
412  'failed to open first file '//trim(filename)//'.nml'
413  sll_error(trim(caller), trim(err_msg))
414  end if
415 
416  read (namelist_id, mesh_1d_unif_cart_1)
417  self%label = "_1"
418  self%num_cells = num_cells_1
419  self%eta_min = eta_min_1
420  self%eta_max = eta_max_1
421  close (namelist_id)
422 
423  end subroutine init_nml_mesh_1d_unif_cart_1
424 
425  subroutine init_nml_mesh_1d_unif_cart_2( &
426  self, &
427  filename, &
428  proc_id)
429  class(sll_t_nml_mesh_1d_unif_cart), intent(inout) :: self
430  character(len=*), intent(in) :: filename
431  sll_int32, intent(in), optional :: proc_id
432 
433  sll_int32 :: namelist_id
434  sll_int32 :: ierr
435  sll_int32 :: io_stat
436  character(len=256) :: err_msg
437  character(len=256) :: caller
438  sll_int32 :: num_cells_2
439  sll_real64 :: eta_min_2
440  sll_real64 :: eta_max_2
441  sll_int32 :: proc_id_loc
442 
443  namelist /mesh_1d_unif_cart_2/ &
444  num_cells_2, &
445  eta_min_2, &
446  eta_max_2
447 
448  caller = 'init_nml_mesh_1d_unif_cart_2'
449  if (present(proc_id)) then
450  proc_id_loc = proc_id
451  else
452  proc_id_loc = 0
453  end if
454 
455  call set_default_values( &
456  num_cells_2, &
457  eta_min_2, &
458  eta_max_2)
459 
460  call sll_s_new_file_id(namelist_id, ierr)
461  open ( &
462  unit=namelist_id, &
463  file=trim(filename)//'.nml', &
464  iostat=io_stat)
465  if (io_stat /= 0) then
466  err_msg = &
467  'failed to open first file '//trim(filename)//'.nml'
468  sll_error(trim(caller), trim(err_msg))
469  end if
470 
471  read (namelist_id, mesh_1d_unif_cart_2)
472  self%label = "_2"
473  self%num_cells = num_cells_2
474  self%eta_min = eta_min_2
475  self%eta_max = eta_max_2
476  close (namelist_id)
477 
478  end subroutine init_nml_mesh_1d_unif_cart_2
479 
480  subroutine init_nml_mesh_1d_unif_cart_3( &
481  self, &
482  filename, &
483  proc_id)
484  class(sll_t_nml_mesh_1d_unif_cart), intent(inout) :: self
485  character(len=*), intent(in) :: filename
486  sll_int32, intent(in), optional :: proc_id
487 
488  sll_int32 :: namelist_id
489  sll_int32 :: ierr
490  sll_int32 :: io_stat
491  character(len=256) :: err_msg
492  character(len=256) :: caller
493  sll_int32 :: num_cells_3
494  sll_real64 :: eta_min_3
495  sll_real64 :: eta_max_3
496  sll_int32 :: proc_id_loc
497 
498  namelist /mesh_1d_unif_cart_3/ &
499  num_cells_3, &
500  eta_min_3, &
501  eta_max_3
502 
503  caller = 'init_nml_mesh_1d_unif_cart_3'
504  if (present(proc_id)) then
505  proc_id_loc = proc_id
506  else
507  proc_id_loc = 0
508  end if
509 
510  call set_default_values( &
511  num_cells_3, &
512  eta_min_3, &
513  eta_max_3)
514 
515  call sll_s_new_file_id(namelist_id, ierr)
516  open ( &
517  unit=namelist_id, &
518  file=trim(filename)//'.nml', &
519  iostat=io_stat)
520  if (io_stat /= 0) then
521  err_msg = &
522  'failed to open first file '//trim(filename)//'.nml'
523  sll_error(trim(caller), trim(err_msg))
524  end if
525 
526  read (namelist_id, mesh_1d_unif_cart_3)
527  self%label = "_3"
528  self%num_cells = num_cells_3
529  self%eta_min = eta_min_3
530  self%eta_max = eta_max_3
531  close (namelist_id)
532 
533  end subroutine init_nml_mesh_1d_unif_cart_3
534 
535  subroutine init_nml_mesh_1d_unif_cart_4( &
536  self, &
537  filename, &
538  proc_id)
539  class(sll_t_nml_mesh_1d_unif_cart), intent(inout) :: self
540  character(len=*), intent(in) :: filename
541  sll_int32, intent(in), optional :: proc_id
542 
543  sll_int32 :: namelist_id
544  sll_int32 :: ierr
545  sll_int32 :: io_stat
546  character(len=256) :: err_msg
547  character(len=256) :: caller
548  sll_int32 :: num_cells_4
549  sll_real64 :: eta_min_4
550  sll_real64 :: eta_max_4
551  sll_int32 :: proc_id_loc
552 
553  namelist /mesh_1d_unif_cart_4/ &
554  num_cells_4, &
555  eta_min_4, &
556  eta_max_4
557 
558  caller = 'init_nml_mesh_1d_unif_cart_4'
559  if (present(proc_id)) then
560  proc_id_loc = proc_id
561  else
562  proc_id_loc = 0
563  end if
564 
565  call set_default_values( &
566  num_cells_4, &
567  eta_min_4, &
568  eta_max_4)
569 
570  call sll_s_new_file_id(namelist_id, ierr)
571  open ( &
572  unit=namelist_id, &
573  file=trim(filename)//'.nml', &
574  iostat=io_stat)
575  if (io_stat /= 0) then
576  err_msg = &
577  'failed to open first file '//trim(filename)//'.nml'
578  sll_error(trim(caller), trim(err_msg))
579  end if
580 
581  read (namelist_id, mesh_1d_unif_cart_4)
582  self%label = "_4"
583  self%num_cells = num_cells_4
584  self%eta_min = eta_min_4
585  self%eta_max = eta_max_4
586  close (namelist_id)
587 
588  end subroutine init_nml_mesh_1d_unif_cart_4
589 
590  subroutine set_default_values( &
591  num_cells, &
592  eta_min, &
593  eta_max)
594  sll_int32, intent(inout) :: num_cells
595  sll_real64, intent(inout) :: eta_min
596  sll_real64, intent(inout) :: eta_max
597 
598  num_cells = 32
599  eta_min = 0._f64
600  eta_max = 1._f64
601 
602  end subroutine set_default_values
603 
604 #endif /* DOXYGEN_SHOULD_SKIP_THIS */
605 
Cartesian mesh basic types.
type(sll_t_cartesian_mesh_1d) function, pointer, public sll_f_new_cartesian_mesh_1d(num_cells, eta_min, eta_max)
allocates the memory space for a new 1D cartesian mesh on the heap, initializes it with the given arg...
initialization of 1d uniform cartesian mesh from namelist
subroutine s_nml_mesh_1d_unif_cart_mesh(filename, mesh, clone, proc_id)
create 1d (uniform) cartesian mesh from namelist
subroutine s_nml_mesh_1d_unif_cart_print(filename, clone, proc_id)
print namelist info
subroutine s_nml_mesh_1d_unif_cart_array(filename, array, clone, proc_id)
create 1d array from namelist
Some common numerical utilities.
subroutine, public sll_s_new_file_id(file_id, error)
Get a file unit number free before creating a file.
    Report Typos and Errors