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