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_landau_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 !**************************************************************
63 
71 
72 !-----------------------------------------------------------------
73 ! SPECIFIC DOCUMENTATION (BEGIN)
74 !-----------------------------------------------------------------
75 
117 
118 !-----------------------------------------------------------------
119 ! SPECIFIC DOCUMENTATION (END)
120 !-----------------------------------------------------------------
121 
123 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
124 #include "sll_errors.h"
125 #include "sll_memory.h"
126 #include "sll_working_precision.h"
127 
128  use sll_m_cartesian_meshes, only: &
131 
132  use sll_m_constants, only: &
133  sll_p_pi
134 
135  use sll_m_utilities, only: &
137 
138  implicit none
139 
140  public :: &
142 
143  private
144 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
145 
147  sll_int32 :: num_cells
148  sll_real64 :: eta_min
149  sll_int32 :: nbox
150  sll_real64 :: kmode
151  character(len=256) :: label
152  contains
153  procedure, pass(self) :: init => init_nml_mesh_1d_landau_cart
154  procedure, pass(self) :: init_1 => init_nml_mesh_1d_landau_cart_1
155  procedure, pass(self) :: init_2 => init_nml_mesh_1d_landau_cart_2
156  procedure, pass(self) :: init_3 => init_nml_mesh_1d_landau_cart_3
157  procedure, pass(self) :: init_4 => init_nml_mesh_1d_landau_cart_4
158  procedure, pass(self) :: init_clone => init_clone_nml_mesh_1d_landau_cart
160 
161  !-----------------------------------------------------------------
162  ! SPECIFIC DECLARATION (BEGIN)
163  !-----------------------------------------------------------------
164 
166  module procedure &
170  end interface sll_o_nml_mesh_1d_landau_cart
171 
172  !-----------------------------------------------------------------
173  ! SPECIFIC DECLARATION (END)
174  !-----------------------------------------------------------------
175 
176 contains
177 
178  !-----------------------------------------------------------------
179  ! SPECIFIC SUBROUTINES (BEGIN)
180  !-----------------------------------------------------------------
181 
184  filename, &
185  array, &
186  clone, &
187  proc_id)
188 
189  character(len=*), intent(in) :: filename
190  sll_real64, pointer, intent(out) :: array(:)
191  character(len=*), intent(in), optional :: clone
192  sll_int32, intent(in), optional :: proc_id
193 
194  type(sll_t_nml_mesh_1d_landau_cart) :: self
195  sll_int32 :: ierr
196  sll_int32 :: i
197  sll_int32 :: num_cells
198  sll_real64 :: eta_min
199  sll_real64 :: eta_max
200  sll_real64 :: delta_eta
201 
202  if (present(clone)) then
203  call self%init_clone(clone, filename, proc_id)
204  else
205  call self%init(filename, proc_id)
206  end if
207 
208  num_cells = self%num_cells
209  eta_min = self%eta_min
210  eta_max = eta_min + real(self%nbox, f64)*2._f64*sll_p_pi/real(self%kmode, f64)
211  delta_eta = (eta_max - eta_min)/real(num_cells, f64)
212 
213  sll_allocate(array(num_cells + 1), ierr)
214  do i = 1, num_cells + 1
215  array(i) = eta_min + real(i - 1, f64)*delta_eta
216  end do
217 
218  end subroutine s_nml_mesh_1d_landau_cart_array
219 
222  filename, &
223  mesh, &
224  clone, &
225  proc_id)
226 
227  character(len=*), intent(in) :: filename
228  type(sll_t_cartesian_mesh_1d), pointer, intent(out) :: mesh
229  character(len=*), intent(in), optional :: clone
230  sll_int32, intent(in), optional :: proc_id
231 
232  type(sll_t_nml_mesh_1d_landau_cart) :: self
233  !sll_int32 :: ierr
234  sll_int32 :: num_cells
235  sll_real64 :: eta_min
236  sll_real64 :: eta_max
237 
238  if (present(clone)) then
239  call self%init_clone(clone, filename, proc_id)
240  else
241  call self%init(filename, proc_id)
242  end if
243 
244  num_cells = self%num_cells
245  eta_min = self%eta_min
246  eta_max = eta_min + real(self%nbox, f64)*2._f64*sll_p_pi/real(self%kmode, f64)
247 
248  mesh => sll_f_new_cartesian_mesh_1d( &
249  num_cells, &
250  eta_min=eta_min, &
251  eta_max=eta_max)
252 
253  end subroutine s_nml_mesh_1d_landau_cart_mesh
254 
255  !-----------------------------------------------------------------
256  ! SPECIFIC SUBROUTINES (END)
257  !-----------------------------------------------------------------
258 
261  filename, &
262  clone, &
263  proc_id)
264 
265  character(len=*), intent(in) :: filename
266  character(len=*), intent(in), optional :: clone
267  sll_int32, intent(in), optional :: proc_id
268 
269  type(sll_t_nml_mesh_1d_landau_cart) :: self
270  sll_int32 :: proc_id_loc
271 
272  if (present(clone)) then
273  call self%init_clone(clone, filename, proc_id)
274  else
275  call self%init(filename, proc_id)
276  end if
277 
278  if (present(proc_id)) then
279  proc_id_loc = proc_id
280  else
281  proc_id_loc = 0
282  end if
283 
284  if (proc_id_loc == 0) then
285  print *, '#nml_mesh_1d_landau_cart:'
286 
287  print *, '#label=', trim(self%label)
288  print *, '#num_cells=', self%num_cells
289  print *, '#eta_min=', self%eta_min
290  print *, '#nbox=', self%nbox
291  print *, '#kmode=', self%kmode
292  end if
293 
294  end subroutine s_nml_mesh_1d_landau_cart_print
295 
296 #ifndef DOXYGEN_SHOULD_SKIP_THIS
297 
298  subroutine init_clone_nml_mesh_1d_landau_cart( &
299  self, &
300  clone, &
301  filename, &
302  proc_id)
303  class(sll_t_nml_mesh_1d_landau_cart), intent(inout) :: self
304  character(len=*), intent(in) :: clone
305  character(len=*), intent(in) :: filename
306  sll_int32, intent(in), optional :: proc_id
307 
308  character(len=256) :: err_msg
309  character(len=256) :: caller
310 
311  caller = 'init_clone_nml_mesh_1d_landau_cart'
312  select case (clone)
313  case ("_1")
314  call self%init_1(filename, proc_id)
315  case ("_2")
316  call self%init_2(filename, proc_id)
317  case ("_3")
318  call self%init_3(filename, proc_id)
319  case ("_4")
320  call self%init_4(filename, proc_id)
321  case default
322  err_msg = 'bad value for clone'
323  sll_error(trim(caller), trim(err_msg))
324  end select
325 
326  end subroutine init_clone_nml_mesh_1d_landau_cart
327 
328  subroutine init_nml_mesh_1d_landau_cart( &
329  self, &
330  filename, &
331  proc_id)
332  class(sll_t_nml_mesh_1d_landau_cart), intent(inout) :: self
333  character(len=*), intent(in) :: filename
334  sll_int32, intent(in), optional :: proc_id
335 
336  sll_int32 :: namelist_id
337  sll_int32 :: ierr
338  sll_int32 :: io_stat
339  character(len=256) :: err_msg
340  character(len=256) :: caller
341  sll_int32 :: num_cells
342  sll_real64 :: eta_min
343  sll_int32 :: nbox
344  sll_real64 :: kmode
345  sll_int32 :: proc_id_loc
346 
347  namelist /mesh_1d_landau_cart/ &
348  num_cells, &
349  eta_min, &
350  nbox, &
351  kmode
352  caller = 'init_nml_mesh_1d_landau_cart'
353  if (present(proc_id)) then
354  proc_id_loc = proc_id
355  else
356  proc_id_loc = 0
357  end if
358 
359  call set_default_values( &
360  num_cells, &
361  eta_min, &
362  nbox, &
363  kmode)
364 
365  call sll_s_new_file_id(namelist_id, ierr)
366  open ( &
367  unit=namelist_id, &
368  file=trim(filename)//'.nml', &
369  iostat=io_stat)
370  if (io_stat /= 0) then
371  err_msg = &
372  'failed to open first file '//trim(filename)//'.nml'
373  sll_error(trim(caller), trim(err_msg))
374  end if
375 
376  read (namelist_id, mesh_1d_landau_cart)
377  self%label = "no_label"
378  self%num_cells = num_cells
379  self%eta_min = eta_min
380  self%nbox = nbox
381  self%kmode = kmode
382  close (namelist_id)
383 
384  end subroutine init_nml_mesh_1d_landau_cart
385 
386  subroutine init_nml_mesh_1d_landau_cart_1( &
387  self, &
388  filename, &
389  proc_id)
390  class(sll_t_nml_mesh_1d_landau_cart), intent(inout) :: self
391  character(len=*), intent(in) :: filename
392  sll_int32, intent(in), optional :: proc_id
393 
394  sll_int32 :: namelist_id
395  sll_int32 :: ierr
396  sll_int32 :: io_stat
397  character(len=256) :: err_msg
398  character(len=256) :: caller
399  sll_int32 :: num_cells_1
400  sll_real64 :: eta_min_1
401  sll_int32 :: nbox_1
402  sll_real64 :: kmode_1
403  sll_int32 :: proc_id_loc
404 
405  namelist /mesh_1d_landau_cart_1/ &
406  num_cells_1, &
407  eta_min_1, &
408  nbox_1, &
409  kmode_1
410 
411  caller = 'init_nml_mesh_1d_landau_cart_1'
412  if (present(proc_id)) then
413  proc_id_loc = proc_id
414  else
415  proc_id_loc = 0
416  end if
417 
418  call set_default_values( &
419  num_cells_1, &
420  eta_min_1, &
421  nbox_1, &
422  kmode_1)
423 
424  call sll_s_new_file_id(namelist_id, ierr)
425  open ( &
426  unit=namelist_id, &
427  file=trim(filename)//'.nml', &
428  iostat=io_stat)
429  if (io_stat /= 0) then
430  err_msg = &
431  'failed to open first file '//trim(filename)//'.nml'
432  sll_error(trim(caller), trim(err_msg))
433  end if
434 
435  read (namelist_id, mesh_1d_landau_cart_1)
436  self%label = "_1"
437  self%num_cells = num_cells_1
438  self%eta_min = eta_min_1
439  self%nbox = nbox_1
440  self%kmode = kmode_1
441  close (namelist_id)
442 
443  end subroutine init_nml_mesh_1d_landau_cart_1
444 
445  subroutine init_nml_mesh_1d_landau_cart_2( &
446  self, &
447  filename, &
448  proc_id)
449  class(sll_t_nml_mesh_1d_landau_cart), intent(inout) :: self
450  character(len=*), intent(in) :: filename
451  sll_int32, intent(in), optional :: proc_id
452 
453  sll_int32 :: namelist_id
454  sll_int32 :: ierr
455  sll_int32 :: io_stat
456  character(len=256) :: err_msg
457  character(len=256) :: caller
458  sll_int32 :: num_cells_2
459  sll_real64 :: eta_min_2
460  sll_int32 :: nbox_2
461  sll_real64 :: kmode_2
462  sll_int32 :: proc_id_loc
463 
464  namelist /mesh_1d_landau_cart_2/ &
465  num_cells_2, &
466  eta_min_2, &
467  nbox_2, &
468  kmode_2
469 
470  caller = 'init_nml_mesh_1d_landau_cart_2'
471  if (present(proc_id)) then
472  proc_id_loc = proc_id
473  else
474  proc_id_loc = 0
475  end if
476 
477  call set_default_values( &
478  num_cells_2, &
479  eta_min_2, &
480  nbox_2, &
481  kmode_2)
482 
483  call sll_s_new_file_id(namelist_id, ierr)
484  open ( &
485  unit=namelist_id, &
486  file=trim(filename)//'.nml', &
487  iostat=io_stat)
488  if (io_stat /= 0) then
489  err_msg = &
490  'failed to open first file '//trim(filename)//'.nml'
491  sll_error(trim(caller), trim(err_msg))
492  end if
493 
494  read (namelist_id, mesh_1d_landau_cart_2)
495  self%label = "_2"
496  self%num_cells = num_cells_2
497  self%eta_min = eta_min_2
498  self%nbox = nbox_2
499  self%kmode = kmode_2
500  close (namelist_id)
501 
502  end subroutine init_nml_mesh_1d_landau_cart_2
503 
504  subroutine init_nml_mesh_1d_landau_cart_3( &
505  self, &
506  filename, &
507  proc_id)
508  class(sll_t_nml_mesh_1d_landau_cart), intent(inout) :: self
509  character(len=*), intent(in) :: filename
510  sll_int32, intent(in), optional :: proc_id
511 
512  sll_int32 :: namelist_id
513  sll_int32 :: ierr
514  sll_int32 :: io_stat
515  character(len=256) :: err_msg
516  character(len=256) :: caller
517  sll_int32 :: num_cells_3
518  sll_real64 :: eta_min_3
519  sll_int32 :: nbox_3
520  sll_real64 :: kmode_3
521  sll_int32 :: proc_id_loc
522 
523  namelist /mesh_1d_landau_cart_3/ &
524  num_cells_3, &
525  eta_min_3, &
526  nbox_3, &
527  kmode_3
528 
529  caller = 'init_nml_mesh_1d_landau_cart_3'
530  if (present(proc_id)) then
531  proc_id_loc = proc_id
532  else
533  proc_id_loc = 0
534  end if
535 
536  call set_default_values( &
537  num_cells_3, &
538  eta_min_3, &
539  nbox_3, &
540  kmode_3)
541 
542  call sll_s_new_file_id(namelist_id, ierr)
543  open ( &
544  unit=namelist_id, &
545  file=trim(filename)//'.nml', &
546  iostat=io_stat)
547  if (io_stat /= 0) then
548  err_msg = &
549  'failed to open first file '//trim(filename)//'.nml'
550  sll_error(trim(caller), trim(err_msg))
551  end if
552 
553  read (namelist_id, mesh_1d_landau_cart_3)
554  self%label = "_3"
555  self%num_cells = num_cells_3
556  self%eta_min = eta_min_3
557  self%nbox = nbox_3
558  self%kmode = kmode_3
559  close (namelist_id)
560 
561  end subroutine init_nml_mesh_1d_landau_cart_3
562 
563  subroutine init_nml_mesh_1d_landau_cart_4( &
564  self, &
565  filename, &
566  proc_id)
567  class(sll_t_nml_mesh_1d_landau_cart), intent(inout) :: self
568  character(len=*), intent(in) :: filename
569  sll_int32, intent(in), optional :: proc_id
570 
571  sll_int32 :: namelist_id
572  sll_int32 :: ierr
573  sll_int32 :: io_stat
574  character(len=256) :: err_msg
575  character(len=256) :: caller
576  sll_int32 :: num_cells_4
577  sll_real64 :: eta_min_4
578  sll_int32 :: nbox_4
579  sll_real64 :: kmode_4
580  sll_int32 :: proc_id_loc
581 
582  namelist /mesh_1d_landau_cart_4/ &
583  num_cells_4, &
584  eta_min_4, &
585  nbox_4, &
586  kmode_4
587 
588  caller = 'init_nml_mesh_1d_landau_cart_4'
589  if (present(proc_id)) then
590  proc_id_loc = proc_id
591  else
592  proc_id_loc = 0
593  end if
594 
595  call set_default_values( &
596  num_cells_4, &
597  eta_min_4, &
598  nbox_4, &
599  kmode_4)
600 
601  call sll_s_new_file_id(namelist_id, ierr)
602  open ( &
603  unit=namelist_id, &
604  file=trim(filename)//'.nml', &
605  iostat=io_stat)
606  if (io_stat /= 0) then
607  err_msg = &
608  'failed to open first file '//trim(filename)//'.nml'
609  sll_error(trim(caller), trim(err_msg))
610  end if
611 
612  read (namelist_id, mesh_1d_landau_cart_4)
613  self%label = "_4"
614  self%num_cells = num_cells_4
615  self%eta_min = eta_min_4
616  self%nbox = nbox_4
617  self%kmode = kmode_4
618  close (namelist_id)
619 
620  end subroutine init_nml_mesh_1d_landau_cart_4
621 
622  subroutine set_default_values( &
623  num_cells, &
624  eta_min, &
625  nbox, &
626  kmode)
627  sll_int32, intent(inout) :: num_cells
628  sll_real64, intent(inout) :: eta_min
629  sll_int32, intent(inout) :: nbox
630  sll_real64, intent(inout) :: kmode
631 
632  num_cells = 32
633  eta_min = 0._f64
634  nbox = 1
635  kmode = 0.5_f64
636 
637  end subroutine set_default_values
638 
639 #endif /* DOXYGEN_SHOULD_SKIP_THIS */
640 
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...
Fortran module where set some physical and mathematical constants.
real(kind=f64), parameter, public sll_p_pi
initialization of 1d landau cartesian mesh from namelist
subroutine s_nml_mesh_1d_landau_cart_mesh(filename, mesh, clone, proc_id)
create 1d (uniform) cartesian mesh from namelist
subroutine s_nml_mesh_1d_landau_cart_print(filename, clone, proc_id)
print namelist info
subroutine s_nml_mesh_1d_landau_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