ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-4/src/utils/vector_class.F90
(Generate patch)

Comparing trunk/OOPSE-4/src/utils/vector_class.F90 (file contents):
Revision 2203 by gezelter, Tue Apr 12 21:28:07 2005 UTC vs.
Revision 2204 by gezelter, Fri Apr 15 22:04:00 2005 UTC

# Line 60 | Line 60
60   !! @author J. Daniel Gezelter
61   !! @author Charles F. Vardeman II
62   !! @author Matthew Meineke
63 < !! @version $Id: vector_class.F90,v 1.6 2005-04-12 21:28:07 gezelter Exp $, $Date: 2005-04-12 21:28:07 $, $Name: not supported by cvs2svn $, $Revision: 1.6 $
63 > !! @version $Id: vector_class.F90,v 1.7 2005-04-15 22:03:59 gezelter Exp $, $Date: 2005-04-15 22:03:59 $, $Name: not supported by cvs2svn $, $Revision: 1.7 $
64  
65   module Vector_class
66 <  
66 >
67    implicit NONE
68    PRIVATE
69 <  
69 >
70    public :: initialize
71    public :: destroy
72    public :: getSize
# Line 78 | Line 78 | module Vector_class
78    public :: getElementProperty
79    public :: getMatchingElementList
80    public :: getFirstMatchingElement
81 –  
81  
82 +
83    integer, parameter :: logical_data_type = 1
84    integer, parameter :: integer_data_type = 2
85    integer, parameter :: real_data_type = 3
86  
87 < !!
87 >  !!
88    type, public :: Vector
89       PRIVATE
90       integer :: initialCapacity = 10
91       integer :: capacityIncrement = 0
92       integer :: elementCount = 0
93 <    
93 >
94       integer :: initialProperties = 5
95       integer :: PropertyIncrement = 0
96       integer :: propertyCount = 0
97 <    
97 >
98       integer, pointer :: ElementData(:) => null()
99       character(len=100), pointer :: PropertyDescriptions(:) => null()
100       integer, pointer :: PropertyDataType(:) => null()
# Line 103 | Line 103 | module Vector_class
103       logical, pointer :: logicalElementProperties(:,:) => null()
104    end type Vector
105  
106 < !! Initialize vector
106 >  !! Initialize vector
107    interface initialize
108       module procedure initialize_0i
109       module procedure initialize_1i
# Line 171 | Line 171 | contains
171      integer, intent(in) :: MatchValue
172      integer :: id
173      integer :: i, j
174 <    
174 >
175      id = 0
176 <  
176 >
177      do i = 1, this%propertyCount
178         if (this%PropertyDescriptions(i) == MatchName) then
179            do j = 1, this%elementCount
# Line 222 | Line 222 | contains
222            enddo
223         endif
224      end do
225 <    
225 >
226      return
227    end function getFirstMatchingElement2i
228  
# Line 232 | Line 232 | contains
232      logical, intent(in) :: MatchValue
233      integer :: id
234      integer :: i, j
235 <    
235 >
236      id = 0
237  
238      do i = 1, this%propertyCount
# Line 283 | Line 283 | contains
283            enddo
284         endif
285      end do
286 <    
286 >
287      return
288    end function getFirstMatchingElement2l
289  
# Line 317 | Line 317 | contains
317      integer :: i, MatchID1, MatchID2
318      logical :: found1 = .false.
319      logical :: found2 = .false.
320 <    
320 >
321      ! first figure out which properties we are using to do the match:
322 <    
322 >
323      do i = 1, this%propertyCount
324         if (this%PropertyDescriptions(i) == MatchName1) then
325            MatchID1 = i
# Line 329 | Line 329 | contains
329            MatchID2 = i
330            found2 = .true.
331         endif
332 <      
332 >
333         if (found1.and.found2) then
334            call getAllMatches2i(this, MatchID1, MatchValue1, &
335                 MatchID2, MatchValue2, nMatches, MatchList)
# Line 369 | Line 369 | contains
369      integer :: i, MatchID1, MatchID2
370      logical :: found1 = .false.
371      logical :: found2 = .false.
372 <    
372 >
373      ! first figure out which properties we are using to do the match:
374 <    
374 >
375      do i = 1, this%propertyCount
376         if (this%PropertyDescriptions(i) == MatchName1) then
377            MatchID1 = i
# Line 381 | Line 381 | contains
381            MatchID2 = i
382            found2 = .true.
383         endif
384 <      
384 >
385         if (found1.and.found2) then
386            call getAllMatches2l(this, MatchID1, MatchValue1, &
387                 MatchID2, MatchValue2, nMatches, MatchList)
# Line 390 | Line 390 | contains
390      enddo
391      return
392    end subroutine getMatchingElementList2l
393 <    
393 >
394    subroutine getAllMatches1i(this, MatchID, MatchValue, nMatches, MatchList)
395      type(Vector), pointer :: this
396      integer, intent(in) :: MatchID
# Line 399 | Line 399 | contains
399      integer, allocatable :: MatchListTemp(:)
400      integer, intent(out) :: nMatches
401      integer :: error, i
402 <    
402 >
403      if(associated(MatchList)) deallocate(MatchList)
404      MatchList => null()
405  
406      allocate(MatchListTemp(this%elementCount), stat=error)
407      if(error .ne. 0) write(*,*) 'Could not allocate MatchListTemp!'
408 <    
408 >
409      nMatches = 0
410 <    
410 >
411      do i = 1, this%elementCount
412         if (this%integerElementProperties(i, MatchID) == MatchValue) then
413            nMatches = nMatches + 1
414            MatchListTemp(nMatches) = i
415         endif
416      enddo
417 <    
418 <    
417 >
418 >
419      if (nMatches .ne. 0) then
420         allocate(MatchList(nMatches), stat=error)
421         if (error.ne.0) write(*, *) 'Could not allocate MatchList!'
# Line 423 | Line 423 | contains
423            MatchList(i) = MatchListTemp(i)
424         enddo
425      endif
426 <    
426 >
427      deallocate(MatchListTemp)
428 –    
428  
429 +
430    end subroutine getAllMatches1i
431  
432    subroutine getAllMatches2i(this, MatchID1, MatchValue1, &
# Line 438 | Line 438 | contains
438      integer, allocatable :: MatchListTemp(:)
439      integer, intent(out) :: nMatches
440      integer :: error, i
441 <    
441 >
442      if(associated(MatchList)) deallocate(MatchList)
443      MatchList => null()
444  
445      allocate(MatchListTemp(this%elementCount), stat=error)
446      if(error .ne. 0) write(*,*) 'Could not allocate MatchListTemp!'
447 <    
447 >
448      nMatches = 0
449 <    
449 >
450      do i = 1, this%elementCount
451         if ((this%integerElementProperties(i, MatchID1) == MatchValue1) .and. &
452              (this%integerElementProperties(i, MatchID2) == MatchValue2)) then
# Line 462 | Line 462 | contains
462            MatchList(i) = MatchListTemp(i)
463         enddo
464      endif
465 <    
465 >
466      deallocate(MatchListTemp)
467  
468    end subroutine getAllMatches2i
# Line 475 | Line 475 | contains
475      integer, allocatable :: MatchListTemp(:)
476      integer, intent(out) :: nMatches
477      integer :: error, i
478 <    
478 >
479      if(associated(MatchList)) deallocate(MatchList)
480      MatchList => null()
481  
482      allocate(MatchListTemp(this%elementCount), stat=error)
483      if(error .ne. 0) write(*,*) 'Could not allocate MatchListTemp!'
484 <    
484 >
485      nMatches = 0
486 <    
486 >
487      do i = 1, this%elementCount
488         if (this%logicalElementProperties(i, MatchID).eqv.MatchValue) then
489            nMatches = nMatches + 1
# Line 498 | Line 498 | contains
498            MatchList(i) = MatchListTemp(i)
499         enddo
500      endif
501 <    
501 >
502      deallocate(MatchListTemp)
503  
504    end subroutine getAllMatches1l
# Line 512 | Line 512 | contains
512      integer, allocatable :: MatchListTemp(:)
513      integer, intent(out) :: nMatches
514      integer :: error, i
515 <    
515 >
516      if(associated(MatchList)) deallocate(MatchList)
517      MatchList => null()
518  
519      allocate(MatchListTemp(this%elementCount), stat=error)
520      if(error .ne. 0) write(*,*) 'Could not allocate MatchListTemp!'
521 <    
521 >
522      nMatches = 0
523 <    
523 >
524      do i = 1, this%elementCount
525         if ((this%logicalElementProperties(i, MatchID1).eqv.MatchValue1) .and. &
526              (this%logicalElementProperties(i, MatchID2).eqv.MatchValue2)) then
# Line 536 | Line 536 | contains
536            MatchList(i) = MatchListTemp(i)
537         enddo
538      endif
539 <    
539 >
540      deallocate(MatchListTemp)
541  
542    end subroutine getAllMatches2l
543 <  
544 <    
543 >
544 >
545    subroutine getElementPropertyReal(this, id, PropName, pv)
546      type(Vector), pointer :: this
547      integer :: id, whichprop
548      character(len=*) :: PropName
549      real( kind = 8 ) :: pv
550 <    
550 >
551      whichprop = getPropertyIndex(this, PropName)
552      if (whichprop .eq. 0 ) then
553         write(*,*) 'unknown property: ', PropName
# Line 567 | Line 567 | contains
567      integer :: id, whichprop
568      character(len=*) :: PropName
569      integer :: pv
570 <    
570 >
571      whichprop = getPropertyIndex(this, PropName)
572      if (whichprop .eq. 0 ) then
573         write(*,*) 'unknown property! ', PropName
# Line 587 | Line 587 | contains
587      integer :: id, whichprop
588      character(len=*) :: PropName
589      logical :: pv
590 <    
590 >
591      whichprop = getPropertyIndex(this, PropName)
592      if (whichprop .eq. 0 ) then
593         write(*,*) 'unknown property! ', PropName
# Line 612 | Line 612 | contains
612            id = i
613            return
614         endif
615 <    enddo    
615 >    enddo
616      id = 0
617    end function getPropertyIndex
618  
# Line 625 | Line 625 | contains
625  
626      resizeFlag = .false.
627  
628 < !  first time: allocate a new vector with default size
628 >    !  first time: allocate a new vector with default size
629  
630      if (.not. associated(this)) then
631         this => initialize()
# Line 633 | Line 633 | contains
633  
634      oldCapacity = size(this%ElementData)
635      oldPropCap  = size(this%PropertyDescriptions)
636 <    
636 >
637      if (minCapacity > oldCapacity) then
638         if (this%capacityIncrement .gt. 0) then
639            newCapacity = oldCapacity + this%capacityIncrement
# Line 647 | Line 647 | contains
647      else
648         newCapacity = oldCapacity
649      endif
650 <    
650 >
651   !!! newCapacity is not set.....
652      if (minPropCap > oldPropCap) then
653         if (this%PropertyIncrement .gt. 0) then
# Line 662 | Line 662 | contains
662      else
663         newPropCap = oldPropCap
664      endif
665 <    
665 >
666      if (resizeFlag) then
667         that => initialize(newCapacity, newPropCap, &
668              this%capacityIncrement, this%PropertyIncrement)      
# Line 671 | Line 671 | contains
671         this => that
672      endif
673    end subroutine ensureCapacityHelper
674 <  
674 >
675    subroutine copyAllData(v1, v2)
676      type(Vector), pointer  :: v1
677      type(Vector), pointer  :: v2
678      integer :: i, j
679 <  
679 >
680      do i = 1, v1%elementCount
681         v2%elementData(i) = v1%elementData(i)
682         do j = 1, v1%propertyCount
# Line 693 | Line 693 | contains
693                 v1%logicalElementProperties(i,j)                        
694         enddo
695      enddo
696 <    
696 >
697      do j = 1, v1%propertyCount
698         v2%PropertyDescriptions(j) = v1%PropertyDescriptions(j)
699         v2%PropertyDataType(j) = v1%PropertyDataType(j)
700      enddo
701 <    
701 >
702      v2%elementCount = v1%elementCount
703      v2%propertyCount = v1%propertyCount
704 <    
704 >
705      return
706    end subroutine copyAllData
707  
# Line 709 | Line 709 | contains
709      type(Vector), pointer :: this
710      integer :: id
711      integer :: error
712 <    
712 >
713      if (.not. associated(this)) then
714         call ensureCapacityHelper(this,1,0)
715      else
716         call ensureCapacityHelper(this, this%elementCount + 1, this%PropertyCount)
717      end if
718 <    
718 >
719      this%elementCount = this%elementCount + 1
720 <    
720 >
721      !! We never use this and we set the entire array to the same value
722      this%elementData = this%elementCount
723      id = this%elementCount
# Line 729 | Line 729 | contains
729      character(len=*), intent(in) :: PropName
730      real( kind = 8 ), intent(in) :: PropValue
731      logical :: foundit
732 <    
732 >
733      foundit = .false.
734  
735      ! first make sure that the PropName isn't in the list of known properties:
# Line 742 | Line 742 | contains
742      enddo
743  
744      if (.not.foundit) then
745 <         call addPropertyToVector(this, PropName, real_data_type)
746 <         call setElementPropertyReal(this, id, PropName, PropValue)
745 >       call addPropertyToVector(this, PropName, real_data_type)
746 >       call setElementPropertyReal(this, id, PropName, PropValue)
747      endif
748    end subroutine setElementPropertyReal
749  
# Line 762 | Line 762 | contains
762            this%integerElementProperties(id,i) = PropValue
763         endif
764      enddo
765 <    
765 >
766      if (.not.foundit) then
767         call addPropertyToVector(this, PropName, integer_data_type)
768         call setElementPropertyInt(this, id, PropName, PropValue)
# Line 784 | Line 784 | contains
784            this%logicalElementProperties(id,i) = PropValue
785         endif
786      enddo
787 <    
787 >
788      if (.not.foundit) then
789         call addPropertyToVector(this, PropName, logical_data_type)
790         call setElementPropertyLogical(this, id, PropName, PropValue)
# Line 795 | Line 795 | contains
795      type(Vector), pointer :: this
796      character(len=*), intent(in) :: PropName
797      integer data_type
798 <    
799 <     call ensureCapacityHelper(this, this%elementCount, this%propertyCount + 1)
800 <     this%propertyCount = this%propertyCount + 1
801 <     this%PropertyDescriptions(this%propertyCount) = PropName
802 <     this%PropertyDataType(this%propertyCount) = data_type
803 <   end subroutine addPropertyToVector
804 <  
798 >
799 >    call ensureCapacityHelper(this, this%elementCount, this%propertyCount + 1)
800 >    this%propertyCount = this%propertyCount + 1
801 >    this%PropertyDescriptions(this%propertyCount) = PropName
802 >    this%PropertyDataType(this%propertyCount) = data_type
803 >  end subroutine addPropertyToVector
804 >
805    function initialize_0i() result(this)
806      type(Vector), pointer :: this
807      this => initialize_2i(10, 5)
# Line 826 | Line 826 | contains
826    end function initialize_3i
827  
828    function initialize_4i(cap, nprop, capinc, propinc) result(this)
829 <     integer, intent(in) :: cap, nprop, capinc, propinc
829 >    integer, intent(in) :: cap, nprop, capinc, propinc
830      integer :: error
831      type(Vector), pointer :: this
832  
833      nullify(this)
834  
835 <     if (cap < 0) then
835 >    if (cap < 0) then
836         write(*,*) 'Bogus Capacity:', cap
837         return
838      endif
# Line 840 | Line 840 | contains
840         write(*,*) 'Bogus Number of Properties:', nprop
841         return
842      endif
843 <    
843 >
844      allocate(this,stat=error)
845      if ( error /= 0 ) then
846         write(*,*) 'Could not allocate Vector!'
# Line 851 | Line 851 | contains
851      this%initialProperties = nprop
852      this%capacityIncrement = capinc
853      this%propertyIncrement = propinc
854 <
854 >
855      allocate(this%elementData(this%initialCapacity), stat=error)
856      if(error /= 0) write(*,*) 'Could not allocate elementData!'
857 –
857  
858 +
859      allocate(this%PropertyDescriptions(this%initialProperties), &
860           stat=error)
861      if(error /=  0) write(*,*) 'Could not allocate PropertyDescriptions!'
# Line 863 | Line 863 | contains
863      allocate(this%PropertyDataType(this%initialProperties), &
864           stat=error)
865      if(error /=  0) write(*,*) 'Could not allocate PropertyDataType!'
866 <    
866 >
867      allocate(this%integerElementProperties(this%initialCapacity, &
868           this%initialProperties), stat=error)
869      if(error /= 0) write(*,*) 'Could not allocate integerElementProperties!'
# Line 878 | Line 878 | contains
878  
879    end function initialize_4i
880  
881 <    !! This function destroys the vector components....
881 >  !! This function destroys the vector components....
882    function destroy(this) result(null_this)
883      logical :: done
884      type(Vector), pointer :: this
# Line 888 | Line 888 | contains
888         null_this => null()
889         return
890      end if
891 <    
892 < !! Walk down the list and deallocate each of the vector component
893 <     if(associated(this%logicalElementProperties)) then
894 <        deallocate(this%logicalElementProperties)
895 <        this%logicalElementProperties=>null()
896 <     endif
897 <     if(associated(this%realElementProperties)) then
898 <        deallocate(this%realElementProperties)
899 <        this%realElementProperties=>null()
900 <     endif
901 <     if(associated(this%integerElementProperties)) then
902 <        deallocate(this%integerElementProperties)
903 <        this%integerElementProperties=>null()
904 <     endif
905 <     if(associated(this%PropertyDataType)) then
906 <        deallocate(this%PropertyDataType)
907 <        this%PropertyDataType=>null()
908 <     endif
909 <     if(associated(this%PropertyDescriptions)) then
910 <        deallocate(this%PropertyDescriptions)
911 <        this%PropertyDescriptions=>null()
912 <     endif
913 <     if(associated(this%elementData)) then
914 <        deallocate(this%elementData)
915 <        this%elementData=>null()
916 <     endif
917 <     deallocate(this)
918 <     this => null()
919 <     null_this => null()
891 >
892 >    !! Walk down the list and deallocate each of the vector component
893 >    if(associated(this%logicalElementProperties)) then
894 >       deallocate(this%logicalElementProperties)
895 >       this%logicalElementProperties=>null()
896 >    endif
897 >    if(associated(this%realElementProperties)) then
898 >       deallocate(this%realElementProperties)
899 >       this%realElementProperties=>null()
900 >    endif
901 >    if(associated(this%integerElementProperties)) then
902 >       deallocate(this%integerElementProperties)
903 >       this%integerElementProperties=>null()
904 >    endif
905 >    if(associated(this%PropertyDataType)) then
906 >       deallocate(this%PropertyDataType)
907 >       this%PropertyDataType=>null()
908 >    endif
909 >    if(associated(this%PropertyDescriptions)) then
910 >       deallocate(this%PropertyDescriptions)
911 >       this%PropertyDescriptions=>null()
912 >    endif
913 >    if(associated(this%elementData)) then
914 >       deallocate(this%elementData)
915 >       this%elementData=>null()
916 >    endif
917 >    deallocate(this)
918 >    this => null()
919 >    null_this => null()
920    end function destroy
921 <  
921 >
922   end module Vector_class

Diff Legend

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