CellWithNbrs.f90

Go to the documentation of this file.

module cellwithnbrsmodule
  use kindmodule, only: i4b, lgp
  use numericalmodelmodule, only: numericalmodeltype
  use virtualmodelmodule, only: virtualmodeltype
  implicit none
  private
 
  integer(I4B), parameter :: defaultcapacity = 6
 
  !> Data structure to hold a global cell identifier,
  !! using a pointer to the model and its local cell
  !< index
  type, public :: globalcelltype
    integer(I4B) :: index !< the index on the model grid
    class(virtualmodeltype), pointer :: v_model => null() !< virtual model
  end type
 
  ! a global cell with neighbors
  type, public :: cellwithnbrstype
    type(globalcelltype) :: cell
    integer(I4B) :: nrofnbrs = 0
    type(cellwithnbrstype), dimension(:), pointer, &
      contiguous :: neighbors => null()
  contains
    procedure :: addnbrcell
  end type
 
contains
 
  subroutine addnbrcell(this, index, v_model)
    class(cellwithnbrstype) :: this
    integer(I4B) :: index
    class(virtualmodeltype), pointer :: v_model
    ! local
    integer(I4B) :: nbrCnt, currentSize, i
    type(cellwithnbrstype), dimension(:), pointer, contiguous :: newNeighbors
    type(cellwithnbrstype), dimension(:), pointer, contiguous :: oldNeighbors
 
    if (.not. associated(this%neighbors)) then
      allocate (this%neighbors(defaultcapacity))
      this%nrOfNbrs = 0
    end if
 
    nbrcnt = this%nrOfNbrs
    currentsize = size(this%neighbors)
    if (nbrcnt + 1 > currentsize) then
 
      ! inflate
      oldneighbors => this%neighbors
      allocate (newneighbors(currentsize + defaultcapacity))
      do i = 1, currentsize
        newneighbors(i) = oldneighbors(i)
      end do
      this%neighbors => newneighbors
 
      ! clean up
      deallocate (oldneighbors)
      nullify (oldneighbors)
    end if
 
    this%neighbors(nbrcnt + 1)%cell%index = index
    this%neighbors(nbrcnt + 1)%cell%v_model => v_model
 
    this%nrOfNbrs = nbrcnt + 1
 
  end subroutine addnbrcell
 
end module