! 
! Copyright 2008-2009 Shin'ya Murakami <murashin@epa.scitec.kobe-u.ac.jp>
! $Id:$
! 
! 2次元領域内で境界に位置する格子点のインデックスリスト
! 
module mod_boundarypointindexlist
  
  use mod_pointindexlist
  use mod_integertuplelist
  use mod_arearange
  use mod_boundaryinfo
  
  implicit none

  private
  ! type
  public :: BoundaryPointIndex, BoundaryPointIndexListNode, &
       &    BoundaryPointIndexList
  ! subroutine, function
  public :: bpil_init, bpil_get_first, bpil_get_last, bpiln_get_next, &
       &    bpiln_get_prev, bpiln_remove_next, bpiln_add, bpil_add_last, &
       &    bpil_add_first, bpiln_get_data, bpiln_set_data, bpiln_add_node, &
       &    bpil_add_node_at_first, bpiln_remove, bpil_attach_list, &
       &    bpil_destroy, bpil_size, bpil_each_init, bpil_each, &
       &    bpil_pickup_at_left, bpil_pickup_at_right, bpil_pickup_at_top, &
       &    bpil_pickup_at_bottom, bpil_delete_at_left, bpil_delete_at_right, &
       &    bpil_delete_at_top, bpil_delete_at_bottom, &
       &    bpil_pickup_at_boundary_in_adjacent_area, &
       &    bpil_delete_at_boundary_in_adjacent_area, &
       &    bpil_listup_in_adjacent, bpi_set_data, bpil_replace_id, &
       &    bpil_is_over_direction

  type BoundaryPointIndex
     type(PointIndex) pi
     type(BoundaryInfo) bi
     integer area_id       ! 境界格子点が属するエリアID
  end type BoundaryPointIndex
  
  type BoundaryPointIndexListNode
     type(BoundaryPointIndexListNode), pointer :: n
     type(BoundaryPointIndexListNode), pointer :: p
     type(BoundaryPointIndex) data
  end type BoundaryPointIndexListNode
  
  type BoundaryPointIndexList
     type(BoundaryPointIndexListNode), pointer :: n
  end type BoundaryPointIndexList

contains
  
  ! 
  ! 初期化
  ! 
  subroutine bpil_init(bpil)
    
    type(BoundaryPointIndexList),     pointer :: bpil 
    type(BoundaryPointIndexListNode), pointer :: node => null()
    
    nullify(bpil)
    allocate(bpil,node)
    bpil%n => node
    nullify(node%n, node%p)
  end subroutine bpil_init
  
  ! 
  ! 最初のノードを得る
  ! 
  function bpil_get_first(bpil) result(retval)
    
    type(BoundaryPointIndexList),     pointer :: bpil
    type(BoundaryPointIndexListNode), pointer :: retval
    
    retval => bpil%n%n
  end function bpil_get_first
  
  ! 
  ! 最後のノードを得る
  ! 
  function bpil_get_last(bpil) result(retval)
    
    type(BoundaryPointIndexList),     pointer :: bpil
    type(BoundaryPointIndexListNode), pointer :: retval
    type(BoundaryPointIndexListNode), pointer :: node => null()
    
    node => bpil_each_init(bpil)
    retval => node
    do while(bpil_each(node))
       retval => node
    end do
  end function bpil_get_last
  
  ! 
  ! 指定したノードの次のノードを得る
  ! 
  function bpiln_get_next(node) result(retval)
    
    type(BoundaryPointIndexListNode), pointer :: node, retval
    
    if(associated(node))then
       retval => node%n
    else ! node is null
       nullify(retval)
    end if
  end function bpiln_get_next
  
  ! 
  ! 指定したノードの前のノードを得る
  ! 
  function bpiln_get_prev(node) result(retval)
    
    type(BoundaryPointIndexListNode), pointer :: node, retval
    
    if(associated(node))then
       retval => node%p
    else ! node is null
       nullify(retval)
    end if
  end function bpiln_get_prev
  
  ! 
  ! 指定したノードの次のノードを削除
  ! 
  function bpiln_remove_next(node) result(retval)
    
    type(BoundaryPointIndexListNode), pointer :: node
    type(BoundaryPointIndexListNode), pointer :: nnode => null()
    type(BoundaryPointIndex) retval
    
    if(.not. associated(node))then
       print *, "error: cannot remove null node"
       call exit(1)
    end if
    
    if(.not. associated(node%n))then
       ! next node is null
       print *, "error: cannot remove null node"
       call exit(1)
    else 
       nnode => node%n
       node%n => node%n%n
       if(associated(node%n))then ! 次の次のノードがある
          node%n%p => node
       end if
       retval = nnode%data
       deallocate(nnode)
    end if
  end function bpiln_remove_next
  
  ! 
  ! 指定したノードの次にdataを持つノードを挿入
  ! 
  subroutine bpiln_add(node, data)
    
    type(BoundaryPointIndexListNode), pointer    :: node
    type(BoundaryPointIndex),         intent(in) :: data
    
    type(BoundaryPointIndexListNode), pointer :: node_new => null()
    
    allocate(node_new)
    node_new%data = data
    node_new%n => node%n
    node_new%p => node
    if(associated(node%n))then
       node%n%p => node_new
    end if
    node%n => node_new
  end subroutine bpiln_add
  
  ! 
  ! ノードの末尾にdataを持つノードを追加
  ! 
  subroutine bpil_add_last(bpil, data)
    
    type(BoundaryPointIndexList), pointer :: bpil
    type(BoundaryPointIndex), intent(in) :: data
    
    call bpiln_add(bpil_get_last(bpil), data)
  end subroutine bpil_add_last
  
  ! 
  ! ノードの先頭にdataを持つノードを追加
  ! 
  subroutine bpil_add_first(bpil, data)
    
    type(BoundaryPointIndexList), pointer    :: bpil
    type(BoundaryPointIndex),     intent(in) :: data
    
    call bpiln_add(bpil%n, data)
  end subroutine bpil_add_first
  
  ! 
  ! 指定したノードのデータを取得
  ! 
  type(BoundaryPointIndex) function bpiln_get_data(node) result(retval)
    
    type(BoundaryPointIndexListNode), pointer :: node
!    type(BoundaryPointIndex) retval
    
    retval = node%data
  end function bpiln_get_data
  
  ! 
  ! 指定したノードにデータをセット
  ! 
  subroutine bpiln_set_data(node, data)
    
    type(BoundaryPointIndexListNode), pointer    :: node
    type(BoundaryPointIndex),         intent(in) :: data
    
    node%data = data
  end subroutine bpiln_set_data
  
  ! 
  ! node の次にnode_newを挿入
  ! 
  subroutine bpiln_add_node(node, node_new)
    
    type(BoundaryPointIndexListNode), pointer :: node, node_new
    
    node_new%n => node%n
    node_new%p => node
    node%n => node_new
    if(associated(node_new%n))then
       node_new%n%p => node_new
    end if
  end subroutine bpiln_add_node
  
  ! 
  ! 先頭にnodeを挿入
  ! 
  subroutine bpil_add_node_at_first(bpil, node)
    
    type(BoundaryPointIndexList),     pointer :: bpil
    type(BoundaryPointIndexListNode), pointer :: node
    
    call bpiln_add_node(bpil%n, node)
  end subroutine bpil_add_node_at_first
  
  ! 
  ! 指定したノードを削除
  ! 
  function bpiln_remove(node) result(retval)
    
    type(BoundaryPointIndexListNode), pointer :: node, retval
    type(BoundaryPointIndexListNode), pointer :: nnode => null()
    type(BoundaryPointIndexListNode), pointer :: pnode => null()
    
    if(.not. associated(node%n))then
       pnode => node%p
       nullify(pnode%n, node%p)
    else ! others
       pnode => node%p
       nnode => node%n
       pnode%n => nnode
       nnode%p => pnode
       nullify(node%p, node%n)
    end if
    retval => node
  end function bpiln_remove

  ! 
  ! bpil1にbpil2をくっつける
  ! 
  subroutine bpil_attach_list(bpil1, bpil2)
    
    type(BoundaryPointIndexList),     pointer :: bpil1, bpil2
    type(BoundaryPointIndexListNode), pointer :: n1=>null(), n2=>null()
    
    n1 => bpil_get_last(bpil1)
    n2 => bpil2%n%n
    if(associated(n1))then
       if(associated(n2))then
          ! n1, n2 ともにある
          n1%n => n2
          n2%p => n1
          nullify(bpil2%n%n)
       else
          ! n1 はある, n2は null
          ! そのまま
       end if
    else if(associated(n2))then
       bpil1%n%n => n2
       n2%p => bpil1%n
       nullify(bpil2%n%n)       
    else
       ! n1, n2 はともに null
       ! そのまま
    end if
    call bpil_destroy(bpil2)
    
  end subroutine bpil_attach_list
  
  ! 
  ! リンクリストを解放する.
  ! 
  subroutine bpil_destroy(bpil)
    
    type(BoundaryPointIndexList),     pointer :: bpil
    type(BoundaryPointIndexListNode), pointer :: node=>null(), nnode=>null()
    
    node => bpil%n
    deallocate(bpil)
    nullify(bpil)
    do while(associated(node%n))
       nnode => node%n
       deallocate(node)
       nullify(node)
       node => nnode
    end do
    deallocate(node)
    nullify(node)
  end subroutine bpil_destroy
  
  ! 
  ! たどれるノードがいくつあるか数える.
  ! 特殊な先頭ノードは数えない.
  ! 
  function bpil_size(bpil) result(retval)
    
    type(BoundaryPointIndexList),     pointer :: bpil
    type(BoundaryPointIndexListNode), pointer :: node=>null()
    integer n, retval
    
    n = 0
    node => bpil_each_init(bpil)
    do while(bpil_each(node))
       n = n+1
    end do
    retval = n
  end function bpil_size
  
  ! 
  ! do loopの初期化
  ! 
  function bpil_each_init(bpil) result(retval)
    
    type(BoundaryPointIndexList),     pointer :: bpil
    type(BoundaryPointIndexListNode), pointer :: retval
    
    retval => bpil%n
    
  end function bpil_each_init
  
  ! 
  ! whileループ用
  ! 
  logical function bpil_each(node) result(retval)
    
    type(BoundaryPointIndexListNode), pointer :: node
    
    node => node%n
    retval = associated(node)
  end function bpil_each
  
  ! 
  ! 与えた BoundaryPointIndex 型から, 指定した
  ! 境界位置のみを保持する部分リストを作成する. 
  ! 
  subroutine bpil_pickup_at_left(bpil, pbpil)
    
    type(BoundaryPointIndexList),     pointer :: bpil, pbpil
    type(BoundaryPointIndexListNode), pointer :: node=>null(), nnode=>null()
    
    call bpil_init(pbpil)
    node => bpil_get_first(bpil)
    do while(associated(node))
       nnode => node%n
       if(node%data%bi%is_at_left)then
          call bpil_add_node_at_first(pbpil, bpiln_remove(node))
       end if
       node => nnode
    end do
  end subroutine bpil_pickup_at_left
  
  ! 
  ! 与えた BoundaryPointIndex 型から, 指定した
  ! 境界位置のみを保持する部分リストを作成する. 
  ! 
  subroutine bpil_pickup_at_right(bpil, pbpil)
    
    type(BoundaryPointIndexList),     pointer :: bpil, pbpil
    type(BoundaryPointIndexListNode), pointer :: node=>null(), nnode=>null()
    
    call bpil_init(pbpil)
    node => bpil_get_first(bpil)
    do while(associated(node))
       nnode => node%n
       if(node%data%bi%is_at_right)then
          call bpil_add_node_at_first(pbpil, bpiln_remove(node))
       end if
       node => nnode
    end do
  end subroutine bpil_pickup_at_right
  
  ! 
  ! 与えた BoundaryPointIndex 型から, 指定した
  ! 境界位置のみを保持する部分リストを作成する. 
  ! 
  subroutine bpil_pickup_at_top(bpil, pbpil)
    
    type(BoundaryPointIndexList),     pointer :: bpil, pbpil
    type(BoundaryPointIndexListNode), pointer :: node=>null(), nnode=>null()
    
    call bpil_init(pbpil)
    node => bpil_get_first(bpil)
    do while(associated(node))
       nnode => node%n
       if(node%data%bi%is_at_top)then
          call bpil_add_node_at_first(pbpil, bpiln_remove(node))
       end if
       node => nnode
    end do
  end subroutine bpil_pickup_at_top
  
  ! 
  ! 与えた BoundaryPointIndex 型から, 指定した
  ! 境界位置のみを保持する部分リストを作成する. 
  ! 
  subroutine bpil_pickup_at_bottom(bpil, pbpil)
    
    type(BoundaryPointIndexList),     pointer :: bpil, pbpil
    type(BoundaryPointIndexListNode), pointer :: node=>null(), nnode=>null()
    
    call bpil_init(pbpil)
    node => bpil_get_first(bpil)
    do while(associated(node))
       nnode => node%n
       if(node%data%bi%is_at_bottom)then
          call bpil_add_node_at_first(pbpil, bpiln_remove(node))
       end if
       node => nnode
    end do
  end subroutine bpil_pickup_at_bottom

  ! 
  ! bpilからis_at_leftをfalseに設定し, 境界フラグが立ってない要素を削除.
  ! 
  subroutine bpil_delete_at_left(bpil)
    
    type(BoundaryPointIndexList),     pointer :: bpil
    type(BoundaryPointIndexListNode), pointer :: node=>null(), nnode=>null()
    
    node => bpil_get_first(bpil)
    do while(associated(node))
       nnode => node%n
       node%data%bi%is_at_left = .false.
       if(.not. bi_is_at_boundary(node%data%bi))then
          node => bpiln_remove(node)
          deallocate(node)
       end if
       node => nnode
    end do
  end subroutine bpil_delete_at_left

  ! 
  ! bpilからis_at_rightをfalseに設定し, 境界フラグが立ってない要素を削除.
  ! 
  subroutine bpil_delete_at_right(bpil)
    
    type(BoundaryPointIndexList),     pointer :: bpil
    type(BoundaryPointIndexListNode), pointer :: node=>null(), nnode=>null()
    
    node => bpil_get_first(bpil)
    do while(associated(node))
       nnode => node%n
       node%data%bi%is_at_right = .false.
       if(.not. bi_is_at_boundary(node%data%bi))then
          node => bpiln_remove(node)
          deallocate(node)
       end if
       node => nnode
    end do
  end subroutine bpil_delete_at_right
  
  ! 
  ! bpilからis_at_topをfalseに設定し, 境界フラグが立ってない要素を削除.
  ! 
  subroutine bpil_delete_at_top(bpil)
    
    type(BoundaryPointIndexList),     pointer :: bpil
    type(BoundaryPointIndexListNode), pointer :: node=>null(), nnode=>null()
    
    node => bpil_get_first(bpil)
    do while(associated(node))
       nnode => node%n
       node%data%bi%is_at_top = .false.
       if(.not. bi_is_at_boundary(node%data%bi))then
          node => bpiln_remove(node)
          deallocate(node)
       end if
       node => nnode
    end do
  end subroutine bpil_delete_at_top
  
  ! 
  ! bpilからis_at_bottomをfalseに設定し, 境界フラグが立ってない要素を削除.
  ! 
  subroutine bpil_delete_at_bottom(bpil)
    
    type(BoundaryPointIndexList),     pointer :: bpil
    type(BoundaryPointIndexListNode), pointer :: node=>null(), nnode=>null()
    
    node => bpil_get_first(bpil)
    do while(associated(node))
       nnode => node%n
       node%data%bi%is_at_bottom = .false.
       if(.not. bi_is_at_boundary(node%data%bi))then
          node => bpiln_remove(node)
          deallocate(node)
       end if
       node => nnode
    end do
  end subroutine bpil_delete_at_bottom
  
  ! 
  ! dir == .true. のとき上下に隣接
  !        .false. のとき左右に隣接.
  ! b1o と b2o は順序付き(下, 上, あるいは 左, 右に並ぶ)
  ! b1o, b2oはオリジナルの境界情報リストで, 
  ! dirに従って境界位置の境界情報リストをb1, b2に取り出す.
  ! 
  subroutine bpil_pickup_at_boundary_in_adjacent_area(b1o, b2o, b1, b2, dir)
    
    type(BoundaryPointIndexList), pointer :: b1o,b2o,b1,b2
    logical, intent(in) :: dir
    
    if(dir)then
       call bpil_pickup_at_top(b1o, b1)
       call bpil_pickup_at_bottom(b2o, b2)
    else
       call bpil_pickup_at_right(b1o, b1)
       call bpil_pickup_at_left(b2o, b2)
    end if
  end subroutine bpil_pickup_at_boundary_in_adjacent_area
  
  ! 
  ! dirに従って, 隣接境界位置にある境界位置情報を消去.
  ! 
  subroutine bpil_delete_at_boundary_in_adjacent_area(b1, b2, dir)
    
    type(BoundaryPointIndexList), pointer :: b1,b2
    logical, intent(in) :: dir
    
    if(dir)then
       call bpil_delete_at_top(b1)    ! b1から上側境界フラグを消す
       call bpil_delete_at_bottom(b2) ! b2から下側境界フラグを消す
    else
       call bpil_delete_at_right(b1)  ! b1から右側境界フラグを消す
       call bpil_delete_at_left(b2)   ! b2から左側境界フラグを消す
    end if
  end subroutine bpil_delete_at_boundary_in_adjacent_area
  
  ! 
  ! b1とb2から, 互いに隣接位置にある格子点の属する
  ! エリアidの組のリストを返す.
  ! 
  function bpil_listup_in_adjacent(b1, b2, dir) result(retval)
    
    type(BoundaryPointIndexList), pointer    :: b1,b2
    logical,                      intent(in) :: dir

    type(IntegerTupleList), pointer :: retval, area_id_tuple => null()
    type(BoundaryPointIndexListNode), pointer :: n1 => null(), n2 => null()
    type(IntegerTuple) tpl
    
    call itl_init(area_id_tuple)
    if(dir)then !上下隣接
       n1 => bpil_each_init(b1)
       do while(bpil_each(n1))
          n2 => bpil_each_init(b2)
          do while(bpil_each(n2))
             if(n1%data%pi%ix == n2%data%pi%ix)then
                tpl%i = n1%data%area_id
                tpl%j = n2%data%area_id
                call itl_add_last(area_id_tuple, tpl)
             end if
          end do
       end do
    else !左右隣接
       n1 => bpil_each_init(b1)
       do while(bpil_each(n1))
          n2 => bpil_each_init(b2)
          do while(bpil_each(n2))
             if(n1%data%pi%iy == n2%data%pi%iy)then
                tpl%i = n1%data%area_id
                tpl%j = n2%data%area_id
                call itl_add_last(area_id_tuple, tpl)
             end if
          end do
       end do
    end if
    retval => area_id_tuple
  end function bpil_listup_in_adjacent
  
  ! 
  ! 境界付き格子点データにデータをセット
  ! 
  subroutine bpi_set_data(bpi, b, pi, id)
    
    type(BoundaryPointIndex), intent(inout) :: bpi
    type(BoundaryInfo),       intent(in)    :: b
    type(PointIndex),         intent(in)    :: pi
    integer, intent(in) :: id
    
    bpi%bi = b
    bpi%pi = pi
    bpi%area_id = id
  end subroutine bpi_set_data
  
  ! 
  ! bpilのうちid_oldをid_newにリプレース
  ! 
  subroutine bpil_replace_id(bpil, id_old, id_new)
    
    type(BoundaryPointIndexList), pointer    :: bpil
    integer, intent(in) :: id_old, id_new

    type(BoundaryPointIndexListNode), pointer :: node => null()
    
    node => bpil_each_init(bpil)
    do while(bpil_each(node))
       if(node%data%area_id == id_old)then
          node%data%area_id = id_new
       end if
    end do
  end subroutine bpil_replace_id
  
  ! 
  ! bpilのうち, エリアIDがidであるエリアの境界情報から, 
  ! そのエリアがx,y軸に沿った境界それぞれを跨いでいるか返す.
  ! ここではどちらも周期境界であると仮定している.
  ! 
  subroutine bpil_is_over_direction(bpil, id, is_over_x, is_over_y)
    
    type(BoundaryPointIndexList), pointer :: bpil
    integer, intent(in)  :: id
    logical, intent(out) :: is_over_x, is_over_y
    
    type(BoundaryPointIndexListNode), pointer :: node => null()
    
    is_over_x = .false.
    is_over_y = .false.
    node => bpil_each_init(bpil)
    do while(bpil_each(node))
       if(node%data%area_id == id)then
          if(node%data%bi%is_at_left)then
             is_over_y = .true.
          end if
          if(node%data%bi%is_at_bottom)then
             is_over_x = .true.
          end if
          if(is_over_x .and. is_over_y)then
             return
          end if
       end if
    end do
  end subroutine bpil_is_over_direction
  
end module mod_boundarypointindexlist
