[ViewVC] Diff of: group/trunk/OOPSE_old/src/mdtools/libmdCode/vector

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 316 by gezelter, Tue Mar 11 21:24:04 2003 UTC

-+
+! vector_class.F90
-+
+!! Module Vector_class
-+
+!! Fortran 95 Vector class module. Similar to java.util vector class.
-+
+!!
-+
+!! The Vector class implements a growable array of objects. Like an array,
-+
+!! it contains components that can be accessed using an integer index.
-+
+!! However, the size of a Vector can grow as needed to accommodate
-+
+!! adding and removing items after the Vector has been created.
-+
+!! Each vector tries to optimize storage management by maintaining a
-+
+!! capacity and a capacityIncrement. The capacity is always at least as
-+
+!! large as the vector size;
-+
+!! it is usually larger because as components are added to the vector,
-+
+!! the vector's storage increases in chunks the size of capacityIncrement.
-+
+!! An application can increase the capacity of a vector before inserting a
-+
+!! large number of components; this reduces the amount of incremental
-+
+!! reallocation.
-+
+!!
-+
+!!
-+
+!! @author J. Daniel Gezelter
-+
+!! @author Charles F. Vardeman II
-+
+!! @author Matthew Meineke
-+
+!! @version $Id: vector_class.F90,v 1.5 2003-03-11 21:24:04 gezelter Exp $, $Date: 2003-03-11 21:24:04 $, $Name: not supported by cvs2svn $, $Revision: 1.5 $
-+
+module Vector_class
+  implicit NONE
+  public :: addElement
+  public :: setElementProperty
+  public :: getElementProperty
-+
+  public :: getMatchingElementList
-+
+  public :: getFirstMatchingElement
+  integer, parameter :: logical_data_type = 1
+  integer, parameter :: integer_data_type = 2
+  integer, parameter :: real_data_type = 3
-+
+!!
+  type, public :: Vector
+     PRIVATE
+     integer :: initialCapacity = 10
+     integer :: PropertyIncrement = 0
+     integer :: propertyCount = 0
-<
+     integer, pointer :: ElementData(:)
-<
+     character(len=100), pointer :: PropertyDescriptions(:)
-<
+     integer, pointer :: PropertyDataType(:)
-<
+     real(kind = 8), pointer :: realElementProperties(:,:)
-<
+     integer, pointer :: integerElementProperties(:,:)
-<
+     logical, pointer :: logicalElementProperties(:,:)
->
+     integer, pointer :: ElementData(:) => null()
->
+     character(len=100), pointer :: PropertyDescriptions(:) => null()
->
+     integer, pointer :: PropertyDataType(:) => null()
->
+     real(kind = 8), pointer :: realElementProperties(:,:) => null()
->
+     integer, pointer :: integerElementProperties(:,:) => null()
->
+     logical, pointer :: logicalElementProperties(:,:) => null()
+  end type Vector
-+
+!! Initialize vector
+  interface initialize
+     module procedure initialize_0i
+     module procedure initialize_1i
+     module procedure getElementPropertyInt
+     module procedure getElementPropertyLogical
+  end interface
-+
-+
+  interface getMatchingElementList
-+
+     module procedure getMatchingElementList1i
-+
+     module procedure getMatchingElementList2i
-+
+     module procedure getMatchingElementList1l
-+
+     module procedure getMatchingElementList2l
-+
+  end interface
-+
-+
+  interface getFirstMatchingElement
-+
+     module procedure getFirstMatchingElement1i
-+
+     module procedure getFirstMatchingElement2i
-+
+     module procedure getFirstMatchingElement1l
-+
+     module procedure getFirstMatchingElement2l
-+
+  end interface
+contains
+  function getSize(this) result (ne)
+    pn = this%PropertyDescriptions(loc)
+  end function getPropertyNameAt
-+
+  function getFirstMatchingElement1i(this, MatchName, MatchValue) result (id)
-+
+    type(Vector), pointer :: this
-+
+    character(len=*), intent(in) :: MatchName
-+
+    integer, intent(in) :: MatchValue
-+
+    integer :: id
-+
+    integer :: i, j
-+
-+
+    id = 0
-+
-+
+    do i = 1, this%propertyCount
-+
+       if (this%PropertyDescriptions(i) == MatchName) then
-+
+          do j = 1, this%elementCount
-+
+             if (this%integerElementProperties(j, i) == MatchValue) then
-+
+                id = j
-+
+                return
-+
+             endif
-+
+          enddo
-+
+       endif
-+
+    enddo
-+
+    return
-+
+  end function getFirstMatchingElement1i
-+
-+
+  function getFirstMatchingElement2i(this, MatchName1, MatchValue1, &
-+
+       MatchName2, MatchValue2) result (id)
-+
+    type(Vector), pointer :: this
-+
+    character(len=*), intent(in) :: MatchName1, MatchName2
-+
+    integer, intent(in) :: MatchValue1, MatchValue2
-+
+    integer :: id
-+
+    integer :: i, j, MatchID1, MatchID2
-+
+    logical :: found1 = .false.
-+
+    logical :: found2 = .false.
-+
-+
+    id = 0
-+
+    ! first figure out which properties we are using to do the match:
-+
-+
+    do i = 1, this%propertyCount
-+
+       if (this%PropertyDescriptions(i) == MatchName1) then
-+
+          MatchID1 = i
-+
+          found1 = .true.
-+
+       endif
-+
+       if (this%PropertyDescriptions(i) == MatchName2) then
-+
+          MatchID2 = i
-+
+          found2 = .true.
-+
+       endif
-+
-+
+       if (found1.and.found2) then
-+
+          do j = 1, this%elementCount
-+
+             if ((this%integerElementProperties(j, MatchID1) == MatchValue1) &
-+
+                  .and. &
-+
+                  (this%integerElementProperties(j, MatchID2) ==MatchValue2)) &
-+
+                  then
-+
+                id = j
-+
+                return
-+
+             endif
-+
+          enddo
-+
+       endif
-+
+    end do
-+
-+
+    return
-+
+  end function getFirstMatchingElement2i
-+
-+
+  function getFirstMatchingElement1l(this, MatchName, MatchValue) result (id)
-+
+    type(Vector), pointer :: this
-+
+    character(len=*), intent(in) :: MatchName
-+
+    logical, intent(in) :: MatchValue
-+
+    integer :: id
-+
+    integer :: i, j
-+
-+
+    id = 0
-+
-+
+    do i = 1, this%propertyCount
-+
+       if (this%PropertyDescriptions(i) == MatchName) then
-+
+          do j = 1, this%elementCount
-+
+             if (this%logicalElementProperties(j, i) .eqv. MatchValue) then
-+
+                id = j
-+
+                return
-+
+             endif
-+
+          enddo
-+
+       endif
-+
+    enddo
-+
+    return
-+
+  end function getFirstMatchingElement1l
-+
-+
+  function getFirstMatchingElement2l(this, MatchName1, MatchValue1, &
-+
+       MatchName2, MatchValue2) result (id)
-+
+    type(Vector), pointer :: this
-+
+    character(len=*), intent(in) :: MatchName1, MatchName2
-+
+    logical, intent(in) :: MatchValue1, MatchValue2
-+
+    integer :: id
-+
+    integer :: i, j, MatchID1, MatchID2
-+
+    logical :: found1 = .false.
-+
+    logical :: found2 = .false.
-+
-+
+    id = 0
-+
+    ! first figure out which properties we are using to do the match:
-+
-+
+    do i = 1, this%propertyCount
-+
+       if (this%PropertyDescriptions(i) == MatchName1) then
-+
+          MatchID1 = i
-+
+          found1 = .true.
-+
+       endif
-+
+       if (this%PropertyDescriptions(i) == MatchName2) then
-+
+          MatchID2 = i
-+
+          found2 = .true.
-+
+       endif
-+
-+
+       if (found1.and.found2) then
-+
+          do j = 1, this%elementCount
-+
+             if ((this%logicalElementProperties(j, MatchID1).eqv.MatchValue1) &
-+
+                  .and. &
-+
+                  (this%logicalElementProperties(j, MatchID2).eqv.MatchValue2)) &
-+
+                  then
-+
+                id = j
-+
+                return
-+
+             endif
-+
+          enddo
-+
+       endif
-+
+    end do
-+
-+
+    return
-+
+  end function getFirstMatchingElement2l
-+
-+
+  subroutine getMatchingElementList1i(this, MatchName, MatchValue, &
-+
+       nMatches, MatchList)
-+
+    type(Vector), pointer :: this
-+
+    character(len=*), intent(in) :: MatchName
-+
+    integer, intent(in) :: MatchValue
-+
+    integer, intent(out) :: nMatches
-+
+    integer, pointer :: MatchList(:)
-+
+    integer :: i
-+
-+
+    ! first figure out which property we are using to do the match:
-+
-+
+    do i = 1, this%propertyCount
-+
+       if (this%PropertyDescriptions(i) == MatchName) then
-+
+          call getAllMatches1i(this, i, MatchValue, nMatches, MatchList)
-+
+          return
-+
+       endif
-+
+    enddo
-+
+    return
-+
+  end subroutine getMatchingElementList1i
-+
-+
+  subroutine getMatchingElementList2i(this, MatchName1, MatchValue1, &
-+
+       MatchName2, MatchValue2, nMatches, MatchList)
-+
+    type(Vector), pointer :: this
-+
+    character(len=*), intent(in) :: MatchName1, MatchName2
-+
+    integer, intent(in)  :: MatchValue1, MatchValue2
-+
+    integer, intent(out)  :: nMatches
-+
+    integer, pointer :: MatchList(:)
-+
+    integer :: i, MatchID1, MatchID2
-+
+    logical :: found1 = .false.
-+
+    logical :: found2 = .false.
-+
-+
+    ! first figure out which properties we are using to do the match:
-+
-+
+    do i = 1, this%propertyCount
-+
+       if (this%PropertyDescriptions(i) == MatchName1) then
-+
+          MatchID1 = i
-+
+          found1 = .true.
-+
+       endif
-+
+       if (this%PropertyDescriptions(i) == MatchName2) then
-+
+          MatchID2 = i
-+
+          found2 = .true.
-+
+       endif
-+
-+
+       if (found1.and.found2) then
-+
+          call getAllMatches2i(this, MatchID1, MatchValue1, &
-+
+               MatchID2, MatchValue2, nMatches, MatchList)
-+
+          return
-+
+       endif
-+
+    enddo
-+
+    return
-+
+  end subroutine getMatchingElementList2i
-+
-+
+  subroutine getMatchingElementList1l(this, MatchName, MatchValue, &
-+
+       nMatches, MatchList)
-+
+    type(Vector), pointer :: this
-+
+    character(len=*), intent(in) :: MatchName
-+
+    logical, intent(in) :: MatchValue
-+
+    integer, intent(out) :: nMatches
-+
+    integer, pointer :: MatchList(:)
-+
+    integer :: i
-+
-+
+    ! first figure out which property we are using to do the match:
-+
-+
+    do i = 1, this%propertyCount
-+
+       if (this%PropertyDescriptions(i) == MatchName) then
-+
+          call getAllMatches1l(this, i, MatchValue, nMatches, MatchList)
-+
+          return
-+
+       endif
-+
+    enddo
-+
+    return
-+
+  end subroutine getMatchingElementList1l
-+
-+
+  subroutine getMatchingElementList2l(this, MatchName1, MatchValue1, &
-+
+       MatchName2, MatchValue2, nMatches, MatchList)
-+
+    type(Vector), pointer :: this
-+
+    character(len=*), intent(in) :: MatchName1, MatchName2
-+
+    logical, intent(in)  :: MatchValue1, MatchValue2
-+
+    integer, intent(out)  :: nMatches
-+
+    integer, pointer :: MatchList(:)
-+
+    integer :: i, MatchID1, MatchID2
-+
+    logical :: found1 = .false.
-+
+    logical :: found2 = .false.
-+
-+
+    ! first figure out which properties we are using to do the match:
-+
-+
+    do i = 1, this%propertyCount
-+
+       if (this%PropertyDescriptions(i) == MatchName1) then
-+
+          MatchID1 = i
-+
+          found1 = .true.
-+
+       endif
-+
+       if (this%PropertyDescriptions(i) == MatchName2) then
-+
+          MatchID2 = i
-+
+          found2 = .true.
-+
+       endif
-+
-+
+       if (found1.and.found2) then
-+
+          call getAllMatches2l(this, MatchID1, MatchValue1, &
-+
+               MatchID2, MatchValue2, nMatches, MatchList)
-+
+          return
-+
+       endif
-+
+    enddo
-+
+    return
-+
+  end subroutine getMatchingElementList2l
-+
-+
+  subroutine getAllMatches1i(this, MatchID, MatchValue, nMatches, MatchList)
-+
+    type(Vector), pointer :: this
-+
+    integer, intent(in) :: MatchID
-+
+    integer, intent(in) :: MatchValue
-+
+    integer, pointer :: MatchList(:)
-+
+    integer, intent(out) :: nMatches
-+
+    integer :: error, i
-+
-+
+    allocate(MatchList(this%elementCount), stat=error)
-+
+    if(error .ne. 0) write(*,*) 'Could not allocate MatchList!'
-+
-+
+    nMatches = 0
-+
-+
+    do i = 1, this%elementCount
-+
+       if (this%integerElementProperties(i, MatchID) == MatchValue) then
-+
+          nMatches = nMatches + 1
-+
+          MatchList(nMatches) = i
-+
+       endif
-+
+    enddo
-+
+  end subroutine getAllMatches1i
-+
-+
+  subroutine getAllMatches2i(this, MatchID1, MatchValue1, &
-+
+       MatchID2, MatchValue2, nMatches, MatchList)
-+
+    type(Vector), pointer :: this
-+
+    integer, intent(in) :: MatchID1, MatchID2
-+
+    integer, intent(in) :: MatchValue1, MatchValue2
-+
+    integer, pointer :: MatchList(:)
-+
+    integer, intent(out) :: nMatches
-+
+    integer :: error, i
-+
-+
+    allocate(MatchList(this%elementCount), stat=error)
-+
+    if(error .ne. 0) write(*,*) 'Could not allocate MatchList!'
-+
-+
+    nMatches = 0
-+
-+
+    do i = 1, this%elementCount
-+
+       if ((this%integerElementProperties(i, MatchID1) == MatchValue1) .and. &
-+
+            (this%integerElementProperties(i, MatchID2) == MatchValue2)) then
-+
+          nMatches = nMatches + 1
-+
+          MatchList(nMatches) = i
-+
+       endif
-+
+    enddo
-+
+  end subroutine getAllMatches2i
-+
-+
+  subroutine getAllMatches1l(this, MatchID, MatchValue, nMatches, MatchList)
-+
+    type(Vector), pointer :: this
-+
+    integer, intent(in) :: MatchID
-+
+    logical, intent(in) :: MatchValue
-+
+    integer, pointer :: MatchList(:)
-+
+    integer, intent(out) :: nMatches
-+
+    integer :: error, i
-+
-+
+    allocate(MatchList(this%elementCount), stat=error)
-+
+    if(error .ne. 0) write(*,*) 'Could not allocate MatchList!'
-+
-+
+    nMatches = 0
-+
-+
+    do i = 1, this%elementCount
-+
+       if (this%logicalElementProperties(i, MatchID).eqv.MatchValue) then
-+
+          nMatches = nMatches + 1
-+
+          MatchList(nMatches) = i
-+
+       endif
-+
+    enddo
-+
+  end subroutine getAllMatches1l
-+
-+
+  subroutine getAllMatches2l(this, MatchID1, MatchValue1, &
-+
+       MatchID2, MatchValue2, nMatches, MatchList)
-+
+    type(Vector), pointer :: this
-+
+    integer, intent(in) :: MatchID1, MatchID2
-+
+    logical, intent(in) :: MatchValue1, MatchValue2
-+
+    integer, pointer :: MatchList(:)
-+
+    integer, intent(out) :: nMatches
-+
+    integer :: error, i
-+
-+
+    allocate(MatchList(this%elementCount), stat=error)
-+
+    if(error .ne. 0) write(*,*) 'Could not allocate MatchList!'
-+
-+
+    nMatches = 0
-+
-+
+    do i = 1, this%elementCount
-+
+       if ((this%logicalElementProperties(i, MatchID1).eqv.MatchValue1) .and. &
-+
+            (this%logicalElementProperties(i, MatchID2).eqv.MatchValue2)) then
-+
+          nMatches = nMatches + 1
-+
+          MatchList(nMatches) = i
-+
+       endif
-+
+    enddo
-+
+  end subroutine getAllMatches2l
-+
+  subroutine getElementPropertyReal(this, id, PropName, pv)
+    type(Vector), pointer :: this
+    integer :: id, whichprop
+    character(len=*) :: PropName
-<
+    real(kind=8) :: pv
->
+    real( kind = 8 ) :: pv
+    whichprop = getPropertyIndex(this, PropName)
+    if (whichprop .eq. 0 ) then
+    type(Vector), pointer :: this
+    integer :: id, i
+    character(len=*), intent(in) :: PropName
-<
+    real( kind=8 ), intent(in) :: PropValue
->
+    real( kind = 8 ), intent(in) :: PropValue
+    logical :: foundit = .false.
+    ! first make sure that the PropName isn't in the list of known properties:
+    do i = 1, this%propertyCount
+    integer :: error
+    type(Vector), pointer :: this
+    nullify(this)
-<
+    if (cap .lt. 0) then
->
+    if (cap < 0) then
+       write(*,*) 'Bogus Capacity:', cap
+       stop
+    endif
-<
+    if (nprop .lt. 0) then
->
+    if (nprop < 0) then
+       write(*,*) 'Bogus Number of Properties:', nprop
+       stop
+    endif
+    this%propertyIncrement = propinc
+    allocate(this%elementData(this%initialCapacity), stat=error)
-<
+    if(error .ne. 0) write(*,*) 'Could not allocate elementData!'
->
+    if(error /= 0) write(*,*) 'Could not allocate elementData!'
+    allocate(this%PropertyDescriptions(this%initialProperties), &
+         stat=error)
-<
+    if(error .ne. 0) write(*,*) 'Could not allocate PropertyDescriptions!'
->
+    if(error /=  0) write(*,*) 'Could not allocate PropertyDescriptions!'
+    allocate(this%integerElementProperties(this%initialCapacity, &
+         this%initialProperties), stat=error)
-<
+    if(error .ne. 0) write(*,*) 'Could not allocate integerElementProperties!'
->
+    if(error /= 0) write(*,*) 'Could not allocate integerElementProperties!'
+    allocate(this%realElementProperties(this%initialCapacity, &
+         this%initialProperties), stat=error)
-<
+    if(error .ne. 0) write(*,*) 'Could not allocate realElementProperties!'
->
+    if(error /= 0) write(*,*) 'Could not allocate realElementProperties!'
+    allocate(this%logicalElementProperties(this%initialCapacity, &
+         this%initialProperties), stat=error)

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

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 316 by gezelter, Tue Mar 11 21:24:04 2003 UTC

Diff Legend

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 316 by gezelter, Tue Mar 11 21:24:04 2003 UTC