1!! Copyright (C) 2019 M. Oliveira, S. Ohlmann
2!!
3!! This program is free software; you can redistribute it and/or modify
4!! it under the terms of the GNU General Public License as published by
5!! the Free Software Foundation; either version 2, or (at your option)
6!! any later version.
7!!
8!! This program is distributed in the hope that it will be useful,
9!! but WITHOUT ANY WARRANTY; without even the implied warranty of
10!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11!! GNU General Public License for more details.
12!!
13!! You should have received a copy of the GNU General Public License
14!! along with this program; if not, write to the Free Software
15!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
16!! 02110-1301, USA.
17!!
18
19#include "global.h"
20
21module namespace_oct_m
22  use global_oct_m
23  use mpi_oct_m
24  implicit none
25
26  private
27  public :: namespace_t, &
28            global_namespace
29
30  integer, parameter :: MAX_NAMESPACE_LEN = 128
31
32  type :: namespace_t
33    private
34    character(len=MAX_NAMESPACE_LEN) :: name = ""
35    type(namespace_t), pointer :: parent => NULL()
36  contains
37    procedure :: get => namespace_get
38    procedure :: len => namespace_len
39  end type namespace_t
40
41  interface namespace_t
42    procedure namespace_init
43  end interface namespace_t
44
45  type(namespace_t) :: global_namespace
46
47contains
48
49  ! ---------------------------------------------------------
50  type(namespace_t) function namespace_init(name, parent)
51    character(len=*),                    intent(in) :: name
52    type(namespace_t), optional, target, intent(in) :: parent
53
54    integer :: total_len, parent_len
55
56    total_len = len_trim(name)
57
58    ! We do not allow the creation of empty namespaces, as that might lead to ambiguous paths
59    ASSERT(total_len /= 0)
60
61    ! Calculate total length of namespace, including the parent
62    if (present(parent)) then
63      parent_len = parent%len()
64      if (parent_len > 0) then
65        total_len = total_len + parent_len + 1
66      end if
67    end if
68
69    ! If total length is too large, stop and explain the reason
70    if (total_len > MAX_NAMESPACE_LEN) then
71      write(stderr,'(a)') '*** Fatal Error (description follows)'
72      write(stderr,'(a)') 'Trying to create the following namespace:'
73      if (present(parent)) then
74        if (parent%len() > 0) then
75          write(stderr,'(a)') trim(parent%get()) // "." // name
76        end if
77      else
78        write(stderr,'(a)') name
79      end if
80      write(stderr,'(a,i4,a)') 'but namespaces are limited to ', MAX_NAMESPACE_LEN, ' characters'
81#ifdef HAVE_MPI
82      if(mpi_world%comm /= -1) call MPI_Abort(mpi_world%comm, 999, mpi_err)
83#endif
84      stop
85    end if
86
87    ! Now initialize the type
88    namespace_init%name = name
89    if (present(parent)) then
90      namespace_init%parent => parent
91    else
92      nullify(namespace_init%parent)
93    end if
94
95  end function namespace_init
96
97  ! ---------------------------------------------------------
98  recursive function namespace_get(this, delimiter) result(name)
99    class(namespace_t),           intent(in) :: this
100    character(len=1),   optional, intent(in) :: delimiter
101    character(len=MAX_NAMESPACE_LEN) :: name
102
103    character(len=1) :: delimiter_
104
105    if (present(delimiter)) then
106      delimiter_ = delimiter
107    else
108      delimiter_ = '.'
109    end if
110
111    name = ""
112    if (associated(this%parent)) then
113      if (this%parent%len() > 0) then
114        name = trim(this%parent%get(delimiter_)) // delimiter_
115      end if
116    end if
117    name = trim(name)//this%name
118
119  end function namespace_get
120
121  ! ---------------------------------------------------------
122  pure recursive function namespace_len(this)
123    class(namespace_t), intent(in) :: this
124    integer :: namespace_len
125
126    integer :: parent_len
127
128    namespace_len = len_trim(this%name)
129    if (associated(this%parent)) then
130      parent_len = this%parent%len()
131      if (parent_len > 0) then
132        namespace_len = namespace_len + parent_len + 1
133      end if
134    end if
135
136  end function namespace_len
137
138end module namespace_oct_m
139
140!! Local Variables:
141!! mode: f90
142!! coding: utf-8
143!! End:
144