1*
2* $Id$
3*
4#define NIL	-1
5
6*     ***********************************************************
7*     *															*
8*     *   		   nwpw_ilist library							*
9*     *															*
10*     *   Author - Eric Bylaska									*
11*     *   date   - 10/09/01										*
12*     *															*
13*     ***********************************************************
14
15*	The nwpw_ilist  library is a linked list for integer values.
16*
17*
18
19*     ***********************************
20*     *									*
21*     *	       nwpw_ilist_init			*
22*     *									*
23*     ***********************************
24      subroutine nwpw_ilist_init(mem)
25      implicit none
26      integer mem(2)
27
28
29*     **** initialize list ****
30!!$OMP SINGLE
31      mem(1) = NIL
32      mem(2) = NIL
33!!OMP END SINGLE copyprivate(mem)
34!OMP BARRIER
35
36      return
37      end
38
39
40*     ***********************************
41*     *									*
42*     *	       nwpw_ilist_add			*
43*     *									*
44*     ***********************************
45
46      subroutine nwpw_ilist_add(mem,tag,ivalue)
47      implicit none
48#include "errquit.fh"
49      integer mem(2)
50      integer tag
51      integer ivalue
52
53#include "bafdecls.fh"
54
55
56*     **** local variables ****
57      logical value
58      integer node(2),cur
59      character*16 id
60
61*     **** allocate q_map,p_map,k_map *****
62      id='ilist'//CHAR(ICHAR('a')+tag)
63      value = BA_alloc_get(mt_int,4,id,node(2),node(1))
64      if (.not. value) then
65        call errquit('nwpw_ilist_add: out of heap memory',0, MA_ERR)
66      end if
67
68      int_mb(node(1))   = NIL
69      int_mb(node(1)+1) = NIL
70      int_mb(node(1)+2) = tag
71      int_mb(node(1)+3) = ivalue
72
73
74*     *** add to the end of list ***
75      if (mem(1).eq.NIL) then
76         mem(1) = node(1)
77         mem(2) = node(2)
78      else
79        cur = mem(1)
80        do while (int_mb(cur).ne.NIL)
81          cur = int_mb(cur)
82        end do
83        int_mb(cur)   = node(1)
84        int_mb(cur+1) = node(2)
85      end if
86
87      return
88      end
89
90*     ***********************************
91*     *									*
92*     *	        nwpw_ilist_get   		*
93*     *									*
94*     ***********************************
95      subroutine nwpw_ilist_get(mem,tag,ivalue)
96      implicit none
97#include "errquit.fh"
98      integer mem(2)
99      integer tag
100      integer ivalue
101
102#include "bafdecls.fh"
103
104*     **** local variables ****
105      integer cur
106
107      cur = mem(1)
108      if (cur.eq.NIL) then
109         call errquit('nwpw_ilist_get: empty list',0, MEM_ERR)
110      end if
111
112      do while ((int_mb(cur+2).ne.tag).and.
113     >          (int_mb(cur).ne.NIL))
114        cur = int_mb(cur)
115      end do
116
117*     **** error - tag not found ****
118      if  (int_mb(cur+2).ne.tag) then
119         write(*,*) 'tag,mem:',tag,mem
120         call errquit('nwpw_ilist_get: tag not found',0, INT_ERR)
121      end if
122
123      ivalue = int_mb(cur+3)
124
125      return
126      end
127
128
129*     ***********************************
130*     *									*
131*     *	       nwpw_ilist_delete		*
132*     *									*
133*     ***********************************
134
135      subroutine nwpw_ilist_delete(mem,tag)
136      implicit none
137#include "errquit.fh"
138      integer mem(2)
139      integer tag
140
141#include "bafdecls.fh"
142
143*     **** local variables ****
144      integer cur,prev,del_node(2),next(2)
145
146      prev = mem(1)
147      cur  = mem(1)
148      if (cur.eq.NIL) then
149         write(*,*) 'warning empty ilist, tag,mem:',tag,mem
150         return
151      end if
152
153*     *** delete first node ****
154      if (int_mb(cur+2).eq.tag) then
155         del_node(1) = mem(1)
156         del_node(2) = mem(2)
157         mem(1) = int_mb(cur)
158         mem(2) = int_mb(cur+1)
159
160*     *** delete after first node ****
161      else
162         do while ((int_mb(cur+2).ne.tag).and.
163     >             (int_mb(cur).ne.NIL))
164           prev = cur
165           cur  = int_mb(cur)
166         end do
167
168*        **** error - tag not found ****
169         if  (int_mb(cur+2).ne.tag) then
170            write(*,*) 'tag,mem:',tag,mem
171            call errquit('nwpw_ilist_get: tag not found',0, INT_ERR)
172         end if
173
174         del_node(1) = int_mb(prev)
175         del_node(2) = int_mb(prev+1)
176         next(1) = int_mb(cur)
177         next(2) = int_mb(cur+1)
178
179         int_mb(prev)   = next(1)
180         int_mb(prev+1) = next(2)
181      end if
182
183*     **** remove node from heap ****
184      if (.not.BA_free_heap(del_node(2))) then
185         call errquit('nwpw_ilist_delete: cannot free heap',0, MA_ERR)
186      end if
187
188      return
189      end
190
191
192
193