1module m_common_notations
2
3#ifndef DUMMYLIB
4  use fox_m_fsys_array_str, only: vs_str, str_vs
5  use m_common_error, only: FoX_error
6
7  implicit none
8  private
9
10  type notation
11    character(len=1), dimension(:), pointer :: name
12    character(len=1), dimension(:), pointer :: systemID
13    character(len=1), dimension(:), pointer :: publicId
14  end type notation
15
16  type notation_list
17    type(notation), dimension(:), pointer :: list
18  end type notation_list
19
20  public :: notation
21  public :: notation_list
22  public :: init_notation_list
23  public :: destroy_notation_list
24  public :: add_notation
25  public :: notation_exists
26
27contains
28
29  subroutine init_notation_list(nlist)
30! It is not clear how we should specify the
31! intent of this argument - different
32! compilers seem to have different semantics
33    type(notation_list), intent(inout) :: nlist
34
35    allocate(nlist%list(0:0))
36    allocate(nlist%list(0)%name(0))
37    allocate(nlist%list(0)%systemId(0))
38    allocate(nlist%list(0)%publicId(0))
39
40  end subroutine init_notation_list
41
42
43  subroutine destroy_notation_list(nlist)
44    type(notation_list), intent(inout) :: nlist
45
46    integer :: i
47
48    do i = 0, ubound(nlist%list, 1)
49      deallocate(nlist%list(i)%name)
50      deallocate(nlist%list(i)%systemId)
51      deallocate(nlist%list(i)%publicId)
52    enddo
53    deallocate(nlist%list)
54  end subroutine destroy_notation_list
55
56
57  subroutine add_notation(nlist, name, systemId, publicId)
58    type(notation_list), intent(inout) :: nlist
59    character(len=*), intent(in) :: name
60    character(len=*), intent(in), optional :: systemId
61    character(len=*), intent(in), optional :: publicId
62
63    integer :: i
64    type(notation), dimension(:), pointer :: temp
65    ! pointer not allocatable to avoid bug on Lahey
66
67    if (.not.present(systemId) .and. .not.present(publicId)) &
68      call FoX_error("Neither System nor Public Id specified for notation: "//name)
69
70    allocate(temp(0:ubound(nlist%list,1)))
71    do i = 0, ubound(nlist%list, 1)
72      temp(i)%name => nlist%list(i)%name
73      temp(i)%systemId => nlist%list(i)%systemId
74      temp(i)%publicId => nlist%list(i)%publicId
75    enddo
76
77    deallocate(nlist%list)
78    allocate(nlist%list(0:ubound(temp, 1)+1))
79    do i = 0, ubound(temp, 1)
80      nlist%list(i)%name => temp(i)%name
81      nlist%list(i)%systemId => temp(i)%systemId
82      nlist%list(i)%publicId => temp(i)%publicId
83    enddo
84    deallocate(temp)
85
86    allocate(nlist%list(i)%name(len(name)))
87    nlist%list(i)%name = vs_str(name)
88    if (present(systemId)) then
89      allocate(nlist%list(i)%systemId(len(systemId)))
90      nlist%list(i)%systemId = vs_str(systemId)
91    else
92      allocate(nlist%list(i)%systemId(0))
93    endif
94    if (present(publicId)) then
95      allocate(nlist%list(i)%publicId(len(publicId)))
96      nlist%list(i)%publicId = vs_str(publicId)
97    else
98      allocate(nlist%list(i)%publicId(0))
99    endif
100  end subroutine add_notation
101
102
103  function notation_exists(nlist, name) result(p)
104    type(notation_list), intent(in) :: nlist
105    character(len=*), intent(in) :: name
106    logical :: p
107
108    integer :: i
109
110    p = .false.
111    do i = 1, ubound(nlist%list, 1)
112      if (str_vs(nlist%list(i)%name) == name) then
113        p = .true.
114        exit
115      endif
116    enddo
117  end function notation_exists
118
119#endif
120end module m_common_notations
121