module cubedag_nodedesc_type
  use gkernel_interfaces
  use cubetools_list
  use cubetools_header_interface
  use cubedag_parameters
  use cubedag_flag
  use cubedag_tuple
  use cubedag_link_type

  type :: cubedag_node_desc_t
    integer(kind=iden_l)  :: id=0                        ! Identifier
    integer(kind=entr_k)  :: ient                        ! Entry number (backpointer to IX)
    integer(kind=code_k)  :: type=code_null              ! Fortran type identifier
    integer(kind=code_k)  :: origin=code_origin_unknown  ! Imported, created, etc
    type(flag_list_t)     :: flag                        ! Signal, noise, etc
    type(cubedag_tuple_t) :: tuple                       !
    integer(kind=iden_l)  :: history=0                   ! History identifier
    type(cubedag_link_t)  :: parents                     ! List of parents
    type(cubedag_link_t)  :: children                    ! List of children
    type(cubedag_link_t)  :: twins                       ! List of twins
    integer(kind=4)       :: nsicvar=0                   !
    character(len=varn_l) :: sicvar(dag_msicvar)=''      ! List of SIC variables pointing to the node
    ! Header components
    character(len=base_l) :: family=''                   ! Family name
    type(cube_header_interface_t), pointer :: head=>null()
  contains
    procedure, public  :: write         => node_write
    procedure, public  :: read          => node_read
    procedure, private :: basic_write   => node_basic_write
    procedure, private :: basic_read    => node_basic_read
    procedure, private :: history_write => node_history_write
    procedure, private :: history_read  => node_history_read
    procedure, private :: links_write   => node_links_write
    procedure, private :: links_read    => node_links_read
    procedure, private :: head_write    => node_head_write
    procedure, private :: head_read     => node_head_read
  end type cubedag_node_desc_t

  integer(kind=4), parameter :: key_l=24  ! Note the T26 tab below
  character(len=*), parameter :: form_i4 ='(A,T26,I11,20(I11))'       ! Scalar or array I*4
  character(len=*), parameter :: form_i8 ='(A,T26,I20)'
  character(len=*), parameter :: form_a  ='(A,T26,A)'                 ! Scalar string

  public :: cubedag_node_desc_t
  private

contains

  subroutine node_write(node,lun,error)
    class(cubedag_node_desc_t), intent(in)    :: node
    integer(kind=4),            intent(in)    :: lun
    logical,                    intent(inout) :: error
    !
    ! Order matters here as per the data format
    call node%basic_write(lun,error)
    if (error)  return
    call node%flag%write(lun,error)
    if (error)  return
    call node%tuple%write(lun,error)
    if (error)  return
    call node%history_write(lun,error)
    if (error)  return
    call node%links_write(lun,error)
    if (error)  return
    call node%head_write(lun,error)
    if (error)  return
  end subroutine node_write

  subroutine node_read(node,lun,error)
    class(cubedag_node_desc_t), intent(inout) :: node
    integer(kind=4),            intent(in)    :: lun
    logical,                    intent(inout) :: error
    !
    ! Order matters here as per the data format
    call node%basic_read(lun,error)
    if (error)  return
    call node%flag%read(lun,error)
    if (error)  return
    call node%tuple%read(lun,error)
    if (error)  return
    call node%history_read(lun,error)
    if (error)  return
    call node%links_read(lun,error)
    if (error)  return
    call node%head_read(lun,error)
    if (error)  return
  end subroutine node_read

  subroutine node_basic_write(node,lun,error)
    class(cubedag_node_desc_t), intent(in)    :: node
    integer(kind=4),            intent(in)    :: lun
    logical,                    intent(inout) :: error
    !
    write(lun,form_i8) 'ID',node%id
    write(lun,form_i4) 'ORIGIN',node%origin
    write(lun,form_a)  'FAMILY',trim(node%family)
  end subroutine node_basic_write

  subroutine node_basic_read(node,lun,error)
    class(cubedag_node_desc_t), intent(inout) :: node
    integer(kind=4),            intent(in)    :: lun
    logical,                    intent(inout) :: error
    ! Local
    character(len=key_l) :: key
    !
    read(lun,form_i8) key,node%id
    read(lun,form_i4) key,node%origin
    read(lun,form_a)  key,node%family
  end subroutine node_basic_read

  subroutine node_history_write(node,lun,error)
    class(cubedag_node_desc_t), intent(in)    :: node
    integer(kind=4),            intent(in)    :: lun
    logical,                    intent(inout) :: error
    !
    write(lun,form_i8) 'HISTORY',node%history
  end subroutine node_history_write

  subroutine node_history_read(node,lun,error)
    class(cubedag_node_desc_t), intent(inout) :: node
    integer(kind=4),            intent(in)    :: lun
    logical,                    intent(inout) :: error
    ! Local
    character(len=key_l) :: key
    !
    read(lun,form_i8) key,node%history
  end subroutine node_history_read

  subroutine node_links_write(node,lun,error)
    class(cubedag_node_desc_t), intent(in)    :: node
    integer(kind=4),            intent(in)    :: lun
    logical,                    intent(inout) :: error
    !
    call node%parents%write(lun,'PARENTS',error)
    if (error)  return
    call node%children%write(lun,'CHILDREN',error)
    if (error)  return
    call node%twins%write(lun,'TWINS',error)
    if (error)  return
  end subroutine node_links_write

  subroutine node_links_read(node,lun,error)
    class(cubedag_node_desc_t), intent(inout) :: node
    integer(kind=4),            intent(in)    :: lun
    logical,                    intent(inout) :: error
    !
    call node%parents%read(lun,error)
    if (error)  return
    call node%children%read(lun,error)
    if (error)  return
    call node%twins%read(lun,error)
    if (error)  return
  end subroutine node_links_read

  subroutine node_head_write(node,lun,error)
    class(cubedag_node_desc_t), intent(in)    :: node
    integer(kind=4),            intent(in)    :: lun
    logical,                    intent(inout) :: error
    !
    call node%head%write(lun,error)
    if (error)  return
  end subroutine node_head_write

  subroutine node_head_read(node,lun,error)
    class(cubedag_node_desc_t), intent(inout) :: node
    integer(kind=4),            intent(in)    :: lun
    logical,                    intent(inout) :: error
    ! Local
    integer(kind=4) :: ier
    character(len=*), parameter :: rname='NODE>HEAD>HEAD'
    !
    if (associated(node%head))  deallocate(node%head)
    allocate(node%head,stat=ier)
    if (failed_allocate(rname,'node%head',ier,error)) return
    !
    call node%head%read(lun,error)
    if (error)  return
  end subroutine node_head_read

end module cubedag_nodedesc_type
