module cubedag_links_type
  use cubedag_parameters
  use cubedag_link_type
  !
  public :: cubedag_links_t
  public :: cubedag_hlinks_t
  private
  !
  ! Cross links for the DAG
  type :: cubedag_links_t
    type(cubedag_link_t), public :: parents   ! List of parent nodes
    type(cubedag_link_t), public :: children  ! List of child nodes
    type(cubedag_link_t), public :: twins     ! List of twin nodes
    integer(kind=iden_l), allocatable, private :: pids(:)  ! Parent ids for snapshot-read
    integer(kind=iden_l), allocatable, private :: cids(:)  ! Child ids for snapshot-read
    integer(kind=iden_l), allocatable, private :: tids(:)  ! Twin ids for snapshot-read
  contains
    procedure, public :: write   => cubedag_links_write
    procedure, public :: read    => cubedag_links_read
    procedure, public :: resolve => cubedag_links_resolve
    procedure, public :: final   => cubedag_links_final
  end type cubedag_links_t
  !
  ! Cross links for the history
  type :: cubedag_hlinks_t
    type(cubedag_link_t), public :: inputs   ! List of command inputs
    type(cubedag_link_t), public :: outputs  ! List of command outputs
    integer(kind=iden_l), allocatable, private :: iids(:)  ! Input ids for snapshot-read
    integer(kind=iden_l), allocatable, private :: oids(:)  ! Output ids for snapshot-read
  contains
    procedure, public :: write   => cubedag_hlinks_write
    procedure, public :: read    => cubedag_hlinks_read
    procedure, public :: resolve => cubedag_hlinks_resolve
    procedure, public :: final   => cubedag_hlinks_final
  end type cubedag_hlinks_t
  !
contains
  !
  subroutine cubedag_links_write(links,lun,error)
    class(cubedag_links_t), intent(in)    :: links
    integer(kind=4),        intent(in)    :: lun
    logical,                intent(inout) :: error
    !
    call links%parents%write(lun,'PARENTS',error)
    if (error)  return
    call links%children%write(lun,'CHILDREN',error)
    if (error)  return
    call links%twins%write(lun,'TWINS',error)
    if (error)  return
  end subroutine cubedag_links_write
  !
  subroutine cubedag_links_read(links,lun,nshift,error)
    class(cubedag_links_t), intent(inout) :: links
    integer(kind=4),        intent(in)    :: lun
    integer(kind=iden_l),   intent(in)    :: nshift  ! links ID shift
    logical,                intent(inout) :: error
    !
    call links%parents%read(lun,nshift,links%pids,error)
    if (error)  return
    call links%children%read(lun,nshift,links%cids,error)
    if (error)  return
    call links%twins%read(lun,nshift,links%tids,error)
    if (error)  return
  end subroutine cubedag_links_read
  !
  subroutine cubedag_links_resolve(links,optx,error)
    !-------------------------------------------------------------------
    ! Resolve all the cross-links (from IDs to pointer) for the given
    ! object.
    !-------------------------------------------------------------------
    class(cubedag_links_t), intent(inout) :: links
    type(cubedag_link_t),   intent(in)    :: optx
    logical,                intent(inout) :: error
    !
    call links%parents%resolve (optx,links%pids,error)
    if (error)  return
    call links%children%resolve(optx,links%cids,error)
    if (error)  return
    call links%twins%resolve   (optx,links%tids,error)
    if (error)  return
  end subroutine cubedag_links_resolve
  !
  subroutine cubedag_links_final(links,error)
    class(cubedag_links_t), intent(inout) :: links
    logical,                intent(inout) :: error
    !
    call links%parents%final(error)
    if (error)  continue
    call links%children%final(error)
    if (error)  continue
    call links%twins%final(error)
    if (error)  continue
    !
    if (allocated(links%pids)) deallocate(links%pids)
    if (allocated(links%cids)) deallocate(links%cids)
    if (allocated(links%tids)) deallocate(links%tids)
  end subroutine cubedag_links_final
  !
  !---------------------------------------------------------------------
  !
  subroutine cubedag_hlinks_write(links,lun,error)
    class(cubedag_hlinks_t), intent(in)    :: links
    integer(kind=4),         intent(in)    :: lun
    logical,                 intent(inout) :: error
    !
    call links%inputs%write(lun,'INPUTS',error)
    if (error)  return
    call links%outputs%write(lun,'OUTPUTS',error)
    if (error)  return
  end subroutine cubedag_hlinks_write
  !
  subroutine cubedag_hlinks_read(links,lun,nshift,error)
    class(cubedag_hlinks_t), intent(inout) :: links
    integer(kind=4),         intent(in)    :: lun
    integer(kind=iden_l),    intent(in)    :: nshift  ! links ID shift
    logical,                 intent(inout) :: error
    !
    call links%inputs%read(lun,nshift,links%iids,error)
    if (error)  return
    call links%outputs%read(lun,nshift,links%oids,error)
    if (error)  return
  end subroutine cubedag_hlinks_read

  subroutine cubedag_hlinks_resolve(links,optx,error)
    !-------------------------------------------------------------------
    ! Resolve all the cross-links (from IDs to pointer) for the given
    ! object.
    !-------------------------------------------------------------------
    class(cubedag_hlinks_t), intent(inout) :: links
    type(cubedag_link_t),    intent(in)    :: optx
    logical,                 intent(inout) :: error
    !
    call links%inputs%resolve(optx,links%iids,error)
    if (error)  return
    call links%outputs%resolve(optx,links%oids,error)
    if (error)  return
  end subroutine cubedag_hlinks_resolve
  !
  subroutine cubedag_hlinks_final(links,error)
    class(cubedag_hlinks_t), intent(inout) :: links
    logical,                 intent(inout) :: error
    !
    call links%inputs%final(error)
    if (error)  continue
    call links%outputs%final(error)
    if (error)  continue
    !
    if (allocated(links%iids)) deallocate(links%iids)
    if (allocated(links%oids)) deallocate(links%oids)
  end subroutine cubedag_hlinks_final
end module cubedag_links_type
