ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE_old/src/mdtools/libmdCode/vector_class.F90
(Generate patch)

Comparing trunk/OOPSE_old/src/mdtools/libmdCode/vector_class.F90 (file contents):
Revision 312 by gezelter, Tue Mar 11 17:46:18 2003 UTC vs.
Revision 313 by gezelter, Tue Mar 11 18:51:05 2003 UTC

# Line 11 | Line 11 | module Vector_class
11    public :: addElement
12    public :: setElementProperty
13    public :: getElementProperty
14 +  public :: getMatchingElementList
15 +  public :: getFirstMatchingElement
16  
17    integer, parameter :: logical_data_type = 1
18    integer, parameter :: integer_data_type = 2
# Line 53 | Line 55 | contains
55       module procedure getElementPropertyInt
56       module procedure getElementPropertyLogical
57    end interface
58 +
59 +  interface getMatchingElementList
60 +     module procedure getMatchingElementList1i
61 +     module procedure getMatchingElementList2i
62 +  end interface
63 +
64 +  interface getFirstMatchingElement
65 +     module procedure getFirstMatchingElement1i
66 +     module procedure getFirstMatchingElement2i
67 +  end interface
68   contains
69  
70    function getSize(this) result (ne)
# Line 81 | Line 93 | contains
93      pn = this%PropertyDescriptions(loc)
94    end function getPropertyNameAt
95  
96 <  
96 >  function getFirstMatchingElement1i(this, MatchName, MatchValue) result (id)
97 >    type(Vector), pointer :: this
98 >    character(len=*), intent(in) :: MatchName
99 >    integer, intent(in) :: MatchValue
100 >    integer :: id
101 >    integer :: i, j
102 >    
103 >    id = 0
104 >
105 >    do i = 1, this%propertyCount
106 >       if (this%PropertyDescriptions(i) == MatchName) then
107 >          do j = 1, this%elementCount
108 >             if (this%integerElementProperties(j, i) == MatchValue) then
109 >                id = j
110 >                return
111 >             endif
112 >          enddo
113 >       endif
114 >    enddo
115 >    return
116 >  end function getFirstMatchingElement1i
117 >
118 >  function getFirstMatchingElement2i(this, MatchName1, MatchValue1, &
119 >       MatchName2, MatchValue2) result (id)
120 >    type(Vector), pointer :: this
121 >    character(len=*), intent(in) :: MatchName1, MatchName2
122 >    integer, intent(in) :: MatchValue1, MatchValue2
123 >    integer :: id
124 >    integer :: i, j, MatchID1, MatchID2
125 >    logical :: found1 = .false.
126 >    logical :: found2 = .false.
127 >
128 >    id = 0
129 >    ! first figure out which properties we are using to do the match:
130 >
131 >    do i = 1, this%propertyCount
132 >       if (this%PropertyDescriptions(i) == MatchName1) then
133 >          MatchID1 = i
134 >          found1 = .true.
135 >       endif
136 >       if (this%PropertyDescriptions(i) == MatchName2) then
137 >          MatchID2 = i
138 >          found2 = .true.
139 >       endif
140 >
141 >       if (found1.and.found2) then
142 >          do j = 1, this%elementCount
143 >             if ((this%integerElementProperties(j, MatchID1) == MatchValue1) &
144 >                  .and. &
145 >                  (this%integerElementProperties(j, MatchID2) ==MatchValue2)) &
146 >                  then
147 >                id = j
148 >                return
149 >             endif
150 >          enddo
151 >       endif
152 >    end do
153 >    
154 >    return
155 >  end function getFirstMatchingElement2i
156 >
157 >
158 >  subroutine getMatchingElementList1i(this, MatchName, MatchValue, &
159 >       nMatches, MatchList)
160 >    type(Vector), pointer :: this
161 >    character(len=*), intent(in) :: MatchName
162 >    integer, intent(in) :: MatchValue
163 >    integer, intent(out) :: nMatches
164 >    integer, pointer :: MatchList
165 >    integer :: i
166 >
167 >    ! first figure out which property we are using to do the match:
168 >
169 >    do i = 1, this%propertyCount
170 >       if (this%PropertyDescriptions(i) == MatchName) then
171 >          call getMatches1(this, i, MatchValue, MatchList)
172 >          return
173 >       endif
174 >    enddo
175 >    return
176 >  end subroutine getMatchingElementList1i
177 >
178 >  subroutine getMatchingElementList2i(this, MatchName1, MatchValue1, &
179 >       MatchName2, MatchValue2, nMatches, MatchList)
180 >    type(Vector), pointer :: this
181 >    character(len=*), intent(in) :: MatchName1, MatchName2
182 >    integer, intent(in) :: MatchValue1, MatchValue2
183 >    integer, intent(out) :: nMatches
184 >    integer, pointer :: MatchList
185 >    integer :: i, MatchID1, MatchID2
186 >    logical :: found1 = .false.
187 >    logical :: found2 = .false.
188 >    
189 >    ! first figure out which properties we are using to do the match:
190 >    
191 >    do i = 1, this%propertyCount
192 >       if (this%PropertyDescriptions(i) == MatchName1) then
193 >          MatchID1 = i
194 >          found1 = .true.
195 >       endif
196 >       if (this%PropertyDescriptions(i) == MatchName2) then
197 >          MatchID2 = i
198 >          found2 = .true.
199 >       endif
200 >      
201 >       if (found1.and.found2) then
202 >          call getAllMatches2i(this, MatchID1, MatchValue1, &
203 >               MatchID2, MatchValue2, nMatches, MatchList)
204 >          return
205 >       endif
206 >    enddo
207 >    return
208 >  end subroutine getMatchingElementList2i
209 >    
210 >  subroutine getAllMatches1i(this, MatchID, MatchValue, nMatches, MatchList)
211 >    type(Vector), pointer :: this
212 >    integer, intent(in) :: MatchID
213 >    integer, intent(in) :: MatchValue
214 >    integer, pointer :: MatchList(:)
215 >    integer, intent(out) :: nMatches
216 >    integer :: error, i
217 >    
218 >    allocate(MatchList(this%elementCount), stat=error)
219 >    if(error .ne. 0) write(*,*) 'Could not allocate MatchList!'
220 >    
221 >    nMatches = 0
222 >    
223 >    do i = 1, this%elementCount
224 >       if (this%integerElementProperties(i, MatchID) == MatchValue) then
225 >          nMatches = nMatches + 1
226 >          MatchList(nMatches) = i
227 >       endif
228 >    enddo
229 >  end subroutine getAllMatches1i
230 >
231 >  subroutine getAllMatches2i(this, MatchID1, MatchValue1, &
232 >       MatchID2, MatchValue2, nMatches, MatchList)
233 >    type(Vector), pointer :: this
234 >    integer, intent(in) :: MatchID1, MatchID2
235 >    integer, intent(in) :: MatchValue1, MatchValue2
236 >    integer, pointer :: MatchList(:)
237 >    integer, intent(out) :: nMatches
238 >    integer :: error, i
239 >    
240 >    allocate(MatchList(this%elementCount), stat=error)
241 >    if(error .ne. 0) write(*,*) 'Could not allocate MatchList!'
242 >    
243 >    nMatches = 0
244 >    
245 >    do i = 1, this%elementCount
246 >       if ((this%integerElementProperties(i, MatchID1) == MatchValue1) .and. &
247 >            (this%integerElementProperties(i, MatchID2) == MatchValue2)) then
248 >          nMatches = nMatches + 1
249 >          MatchList(nMatches) = i
250 >       endif
251 >    enddo
252 >  end subroutine getAllMatches2i
253 >    
254 >    
255    subroutine getElementPropertyReal(this, id, PropName, pv)
256      type(Vector), pointer :: this
257      integer :: id, whichprop

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines