1#ifdef TRACING
2! linked list for extrae events, holding the event number and the section name
3! functionalities:
4!   - add entry to list  -> addToList(list, name)
5!   - find ID for name   -> getNumber(list, name)
6!   - write list to file -> writeList(list)
7!   - delete list        -> deleteList(list)
8module extrae_eventllist
9  implicit none
10
11  integer, parameter :: extrae_MAXNAMELEN = 30
12  integer            :: extrae_maxEventNumber
13  integer, parameter :: NOT_FOUND = -1
14
15  type extrae_event
16    integer                           :: eventnumber
17    character (len=extrae_MAXNAMELEN) :: sectionname
18    type(extrae_event), pointer       :: next => null()
19  end type extrae_event
20
21  type(extrae_event), pointer :: eventlist => null()
22
23  contains
24
25  ! finds the event number associated with 'name'
26  ! returns NOT_FOUND if the entry is not found
27  recursive function getNumber(list, name) result(getNumber_result)
28!use parallel,only: node
29    implicit none
30
31    type(extrae_event), pointer, intent(in)  :: list
32    character (len=*),           intent(in)  :: name
33    integer :: getNumber_result
34
35    if (associated(list)) then
36      if (trim(list%sectionname) == trim(name)) then
37        getNumber_result = list%eventnumber
38!if (Node == 0) write (*,*) 'extraeLIST found                ', list%eventnumber, name
39      else
40!if (Node == 0) write (*,*) 'extraeLIST continue looking for ', name
41        getNumber_result = getNumber(list%next, name)
42      end if
43    else
44      getNumber_result = NOT_FOUND
45    end if
46
47  end function getNumber
48
49
50  ! adds a new element to the HEAD of the list,
51  ! resulting in descending numbering in the list
52  ! this order reduces searching time for repeated calls
53  function addToList(list, name)
54!use parallel,only: node
55    implicit none
56
57    type(extrae_event), pointer, intent(inout)  :: list
58    character (len=*),           intent(in)     :: name
59    integer    :: addToList
60
61    type(extrae_event), pointer :: newElement
62
63    extrae_maxEventNumber = extrae_maxEventNumber + 1
64    allocate(newElement)
65    newElement%sectionname = trim(name)
66    newElement%eventnumber = extrae_maxEventNumber
67    newElement%next        => list
68    list                   => newElement
69
70!if (Node == 0) write (*,*) 'extraeLIST adding               ', newElement%eventnumber, name
71    addToList = newElement%eventnumber
72  end function addToList
73
74
75  ! writes the content of the list in pcf format to the file 'siesta_user_labels.pcf'
76  ! its content has to be appended to the trace's pcf file for labeling the user-functions traced
77  subroutine writeList(list)
78    implicit none
79    type(extrae_event), pointer, intent(in)  :: list
80
81    character(len=*),parameter :: userfuncFile = 'siesta_user_labels.pcf'
82    integer                    :: iu
83
84    call io_assign(iu)
85    open(unit=iu, file=userfuncFile, form='formatted', status='unknown')
86
87    write (iu,*) "EVENT_TYPE"
88    write (iu,*) "9   1000    PEXSI user functions"
89    write (iu,*) "VALUES"
90    write (iu,*) "    0   End"
91
92    call writeElements(list, iu)
93
94    call io_close(iu)
95
96  end subroutine writeList
97
98
99  recursive subroutine writeElements(list, iu)
100    implicit none
101    type(extrae_event), pointer, intent(in)  :: list
102    integer,                     intent(in)  :: iu
103
104    ! elements are in reverse order in list, so reverse them again
105    if (associated(list)) then
106      call writeElements(list%next, iu)
107      write(iu,'(i6, a)') list%eventnumber, '   ' // list%sectionname
108    end if
109
110  end subroutine writeElements
111
112
113  recursive subroutine deleteList(list)
114    implicit none
115    type(extrae_event), pointer, intent(inout)  :: list
116
117    if (associated(list)) then
118      if (associated(list%next)) then
119        call deleteList(list%next)
120        deallocate(list)
121      end if
122    end if
123
124  end subroutine deleteList
125
126end module extrae_eventllist
127#endif /* TRACING */
128