DOUG 0.2

IdxMap.f90

Go to the documentation of this file.
00001 ! DOUG - Domain decomposition On Unstructured Grids
00002 ! Copyright (C) 1998-2006 Faculty of Computer Science, University of Tartu and
00003 ! Department of Mathematics, University of Bath
00004 !
00005 ! This library is free software; you can redistribute it and/or
00006 ! modify it under the terms of the GNU Lesser General Public
00007 ! License as published by the Free Software Foundation; either
00008 ! version 2.1 of the License, or (at your option) any later version.
00009 !
00010 ! This library is distributed in the hope that it will be useful,
00011 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
00012 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
00013 ! Lesser General Public License for more details.
00014 !
00015 ! You should have received a copy of the GNU Lesser General Public
00016 ! License along with this library; if not, write to the Free Software
00017 ! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
00018 ! or contact the authors (University of Tartu, Faculty of Computer Science, Chair
00019 ! of Distributed Systems, Liivi 2, 50409 Tartu, Estonia, http://dougdevel.org,
00020 ! mailto:info(at)dougdevel.org)
00021 
00022 !--------------------------------------------------
00023 ! Simple Integer -> Integer map with following properties:
00024 !   O(log(n)) lookup
00025 !   O(n*log(n)) insert, delete
00026 !   O(1) access to keys
00027 !   O(1) clear
00028 !--------------------------------------------------
00029 
00030 module IdxMap_class
00031 
00032   implicit none
00033 
00034   type IdxMap_Elem
00035   private
00036      integer :: key
00037      integer :: val
00038   end type IdxMap_Elem
00039 
00040   type IdxMap
00041   private
00042      integer :: size
00043      type(IdxMap_Elem), dimension(:), pointer :: data
00044   end type IdxMap
00045 
00046 contains
00047 
00048   function IdxMap_ElemIdx(M, k) result(idx)
00049      type (IdxMap), intent(in) :: M
00050      integer, intent(in) :: k
00051      integer :: idx
00052      integer :: step
00053 
00054      step = M%size / 2
00055      idx = M%size / 2 + 1
00056      do while (step > 1)
00057         if (M%data(idx)%key > k) then
00058            idx = idx - step
00059            if (idx < 1) idx = 1
00060         else
00061            idx = idx + step
00062            if (idx > M%size) idx = M%size
00063         end if
00064         step = step / 2
00065      end do
00066      do while (idx > 1)
00067         if (M%data(idx-1)%key < k) exit
00068         idx = idx - 1
00069      end do
00070      do while (idx <= M%size)
00071         if (M%data(idx)%key >= k) exit
00072         idx = idx + 1
00073      end do
00074   end function IdxMap_ElemIdx
00075 
00076   function IdxMap_ExactElemIdx(M, k) result(idx)
00077      type (IdxMap), intent(in) :: M
00078      integer, intent(in) :: k
00079      integer :: idx
00080 
00081      idx = IdxMap_ElemIdx(M, k)
00082      if ((idx >= 1) .and. (idx <= M%size)) then
00083         if (M%data(idx)%key /= k) idx = -1
00084      else
00085         idx = -1
00086      end if
00087   end function IdxMap_ExactElemIdx
00088 
00089   function IdxMap_New() result(M)
00090      type (IdxMap) :: M
00091 
00092      M%size = 0
00093      M%data => NULL()
00094   end function IdxMap_New
00095 
00096   subroutine IdxMap_Destroy(M)
00097      type (IdxMap), intent(in out) :: M
00098 
00099      if (associated(M%data)) deallocate(M%data)
00100   end subroutine IdxMap_Destroy
00101 
00102   subroutine IdxMap_Clear(M)
00103      type (IdxMap), intent(in out) :: M
00104 
00105      M%size = 0
00106   end subroutine IdxMap_Clear
00107 
00108   subroutine IdxMap_Insert(M, k, x)
00109      type (IdxMap), intent(in out) :: M
00110      integer, intent(in) :: k, x
00111      integer :: idx, real_size
00112      logical :: exists
00113      type (IdxMap_Elem), dimension(:), pointer :: temp
00114 
00115      idx = IdxMap_ElemIdx(M, k)
00116      exists = .false.
00117      if ((idx >= 1) .and. (idx <= M%size)) then
00118         exists = M%data(idx)%key == k
00119      end if
00120      if (.not.exists) then
00121         real_size = 0
00122         if (associated(M%data)) real_size = size(M%data)
00123         if (real_size < M%size+1) then
00124            allocate(temp(M%size * 4 / 3 + 4))
00125            if (associated(M%data)) then
00126               temp(1:M%size) = M%data(1:M%size)
00127               deallocate(M%data)
00128            end if
00129            M%data => temp
00130         end if
00131 
00132         M%data(idx+1:M%size+1) = M%data(idx:M%size)
00133         M%size = M%size + 1
00134         M%data(idx)%key = k
00135      end if
00136      M%data(idx)%val = x
00137   end subroutine IdxMap_Insert
00138 
00139   subroutine IdxMap_Delete(M, k)
00140      type (IdxMap), intent(in out) :: M
00141      integer, intent(in) :: k
00142      integer :: idx
00143 
00144      idx = IdxMap_ExactElemIdx(M, k)
00145      if (idx /= -1) then
00146         M%data(idx:) = M%data(idx+1:)
00147         M%size = M%size - 1
00148      end if
00149   end subroutine IdxMap_Delete
00150 
00151   function IdxMap_Size(M) result(n)
00152      type (IdxMap), intent(in) :: M
00153      integer :: n
00154 
00155      n = M%size
00156   end function IdxMap_Size
00157 
00158   function IdxMap_Key(M, n) result(k)
00159      type (IdxMap), intent(in) :: M
00160      integer, intent(in) :: n
00161      integer :: k
00162 
00163      if ((n >= 1) .and. (n <= M%size)) then
00164         k = M%data(n)%key
00165      else
00166         k = -1
00167      end if
00168   end function IdxMap_Key
00169 
00170   function IdxMap_Lookup(M, k) result(x)
00171      type (IdxMap), intent(in) :: M
00172      integer, intent(in) :: k
00173      integer :: x
00174      integer :: idx
00175 
00176      idx = IdxMap_ExactElemIdx(M, k)
00177      if (idx /= -1) then
00178         x = M%data(idx)%val
00179      else
00180         x = -1
00181      end if
00182   end function IdxMap_Lookup
00183 
00184   subroutine IdxMap_Print(M)
00185      type (IdxMap), intent(in) :: M
00186      integer :: i
00187 
00188      write (*, *) 'IdxMap%size = ', M%size
00189      write (*, *) 'IdxMap%data = ('
00190      do i = 1, M%size
00191         write (*, *) '   ', M%data(i)%key, ' => ', M%data(i)%val
00192      end do
00193      write (*, *) ')'
00194   end subroutine IdxMap_Print
00195 
00196 end module IdxMap_class