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