117 #include "sll_errors.h"
118 #include "sll_memory.h"
119 #include "sll_working_precision.h"
137 sll_int32 :: num_cells
138 sll_real64 :: eta_min
139 sll_real64 :: eta_max
140 character(len=256) :: label
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
173 filename, & !< namelist file input
174 array, & !< output array
175 clone, & !< optional choice of clone
176 proc_id) !< optional id of proc
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
186 sll_int32 :: num_cells
187 sll_real64 :: eta_min
188 sll_real64 :: eta_max
189 sll_real64 :: delta_eta
191 if (
present(clone))
then
192 call self%init_clone(clone, filename, proc_id)
194 call self%init(filename, proc_id)
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)
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
211 filename, & !< namelist file input
212 mesh, & !< output mesh
213 clone, & !< optional choice of clone
214 proc_id) !< optional id of proc
216 character(len=*),
intent(in) :: filename
218 character(len=*),
intent(in),
optional :: clone
219 sll_int32,
intent(in),
optional :: proc_id
223 sll_int32 :: num_cells
224 sll_real64 :: eta_min
225 sll_real64 :: eta_max
227 if (
present(clone))
then
228 call self%init_clone(clone, filename, proc_id)
230 call self%init(filename, proc_id)
233 num_cells = self%num_cells
234 eta_min = self%eta_min
235 eta_max = self%eta_max
250 filename, & !< namelist file input
251 clone, & !< optional choice of clone
252 proc_id & !< optional id of proc
254 character(len=*),
intent(in) :: filename
255 character(len=*),
intent(in),
optional :: clone
256 sll_int32,
intent(in),
optional :: proc_id
259 sll_int32 :: proc_id_loc
261 if (
present(clone))
then
262 call self%init_clone(clone, filename, proc_id)
264 call self%init(filename, proc_id)
267 if (
present(proc_id))
then
268 proc_id_loc = proc_id
273 if (proc_id_loc == 0)
then
274 print *,
'#nml_mesh_1d_unif_cart:'
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
284 #ifndef DOXYGEN_SHOULD_SKIP_THIS
286 subroutine init_clone_nml_mesh_1d_unif_cart( &
292 character(len=*),
intent(in) :: clone
293 character(len=*),
intent(in) :: filename
294 sll_int32,
intent(in),
optional :: proc_id
296 character(len=256) :: err_msg
297 character(len=256) :: caller
299 caller =
'init_clone_nml_mesh_1d_unif_cart'
302 call self%init_1(filename, proc_id)
304 call self%init_2(filename, proc_id)
306 call self%init_3(filename, proc_id)
308 call self%init_4(filename, proc_id)
310 err_msg =
'bad value for clone'
311 sll_error(trim(caller), trim(err_msg))
314 end subroutine init_clone_nml_mesh_1d_unif_cart
316 subroutine init_nml_mesh_1d_unif_cart( &
321 character(len=*),
intent(in) :: filename
322 sll_int32,
intent(in),
optional :: proc_id
324 sll_int32 :: namelist_id
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
334 namelist /mesh_1d_unif_cart/ &
338 caller =
'init_nml_mesh_1d_unif_cart'
339 if (
present(proc_id))
then
340 proc_id_loc = proc_id
345 call set_default_values( &
353 file=trim(filename)//
'.nml', &
355 if (io_stat /= 0)
then
357 'failed to open first file '//trim(filename)//
'.nml'
358 sll_error(trim(caller), trim(err_msg))
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
368 end subroutine init_nml_mesh_1d_unif_cart
370 subroutine init_nml_mesh_1d_unif_cart_1( &
375 character(len=*),
intent(in) :: filename
376 sll_int32,
intent(in),
optional :: proc_id
378 sll_int32 :: namelist_id
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
388 namelist /mesh_1d_unif_cart_1/ &
393 caller =
'init_nml_mesh_1d_unif_cart_1'
394 if (
present(proc_id))
then
395 proc_id_loc = proc_id
400 call set_default_values( &
408 file=trim(filename)//
'.nml', &
410 if (io_stat /= 0)
then
412 'failed to open first file '//trim(filename)//
'.nml'
413 sll_error(trim(caller), trim(err_msg))
416 read (namelist_id, mesh_1d_unif_cart_1)
418 self%num_cells = num_cells_1
419 self%eta_min = eta_min_1
420 self%eta_max = eta_max_1
423 end subroutine init_nml_mesh_1d_unif_cart_1
425 subroutine init_nml_mesh_1d_unif_cart_2( &
430 character(len=*),
intent(in) :: filename
431 sll_int32,
intent(in),
optional :: proc_id
433 sll_int32 :: namelist_id
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
443 namelist /mesh_1d_unif_cart_2/ &
448 caller =
'init_nml_mesh_1d_unif_cart_2'
449 if (
present(proc_id))
then
450 proc_id_loc = proc_id
455 call set_default_values( &
463 file=trim(filename)//
'.nml', &
465 if (io_stat /= 0)
then
467 'failed to open first file '//trim(filename)//
'.nml'
468 sll_error(trim(caller), trim(err_msg))
471 read (namelist_id, mesh_1d_unif_cart_2)
473 self%num_cells = num_cells_2
474 self%eta_min = eta_min_2
475 self%eta_max = eta_max_2
478 end subroutine init_nml_mesh_1d_unif_cart_2
480 subroutine init_nml_mesh_1d_unif_cart_3( &
485 character(len=*),
intent(in) :: filename
486 sll_int32,
intent(in),
optional :: proc_id
488 sll_int32 :: namelist_id
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
498 namelist /mesh_1d_unif_cart_3/ &
503 caller =
'init_nml_mesh_1d_unif_cart_3'
504 if (
present(proc_id))
then
505 proc_id_loc = proc_id
510 call set_default_values( &
518 file=trim(filename)//
'.nml', &
520 if (io_stat /= 0)
then
522 'failed to open first file '//trim(filename)//
'.nml'
523 sll_error(trim(caller), trim(err_msg))
526 read (namelist_id, mesh_1d_unif_cart_3)
528 self%num_cells = num_cells_3
529 self%eta_min = eta_min_3
530 self%eta_max = eta_max_3
533 end subroutine init_nml_mesh_1d_unif_cart_3
535 subroutine init_nml_mesh_1d_unif_cart_4( &
540 character(len=*),
intent(in) :: filename
541 sll_int32,
intent(in),
optional :: proc_id
543 sll_int32 :: namelist_id
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
553 namelist /mesh_1d_unif_cart_4/ &
558 caller =
'init_nml_mesh_1d_unif_cart_4'
559 if (
present(proc_id))
then
560 proc_id_loc = proc_id
565 call set_default_values( &
573 file=trim(filename)//
'.nml', &
575 if (io_stat /= 0)
then
577 'failed to open first file '//trim(filename)//
'.nml'
578 sll_error(trim(caller), trim(err_msg))
581 read (namelist_id, mesh_1d_unif_cart_4)
583 self%num_cells = num_cells_4
584 self%eta_min = eta_min_4
585 self%eta_max = eta_max_4
588 end subroutine init_nml_mesh_1d_unif_cart_4
590 subroutine set_default_values( &
594 sll_int32,
intent(inout) :: num_cells
595 sll_real64,
intent(inout) :: eta_min
596 sll_real64,
intent(inout) :: eta_max
602 end subroutine set_default_values
604 #endif /* DOXYGEN_SHOULD_SKIP_THIS */
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.