!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubecompute_operdir_types
  use cubetools_parameters
  use cubesyntax_key_types
  use cubecompute_messaging
  !
  public :: code_operdir_direct,code_operdir_inverse,code_operdir_default
  public :: operdir_comm_t,operdir_user_t,operdir_prog_t
  private
  !
  integer(kind=code_k), parameter :: code_operdir_direct  = +1 ! To be compatible with fourt
  integer(kind=code_k), parameter :: code_operdir_inverse = -1 ! To be compatible with fourt
  integer(kind=code_k), parameter :: code_operdir_default =  0 ! Results will depend on context
  !  
  type operdir_comm_t
     type(key_comm_t), private :: direct
     type(key_comm_t), private :: inverse
   contains
     procedure, public :: register => cubecompute_operdir_comm_register
     procedure, public :: parse    => cubecompute_operdir_comm_parse
  end type operdir_comm_t
  !
  type operdir_user_t
     type(key_user_t), private :: direct
     type(key_user_t), private :: inverse
   contains
     procedure, public :: toprog => cubecompute_operdir_user_toprog
     procedure, public :: list   => cubecompute_operdir_user_list
  end type operdir_user_t
  !
  type operdir_prog_t
     integer(kind=code_k) :: code = code_operdir_default
   contains
     procedure, public :: list => cubecompute_operdir_prog_list
  end type operdir_prog_t
  !
contains
  !
  subroutine cubecompute_operdir_comm_register(comm,dabstract,iabstract,error)
    use cubetools_flag_types
    !----------------------------------------------------------------------
    ! Register "[ /DIRECT | /INVERSE ]" key pair
    !----------------------------------------------------------------------
    class(operdir_comm_t), intent(inout) :: comm
    character(len=*),      intent(in)    :: dabstract
    character(len=*),      intent(in)    :: iabstract
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='OPERDIR>COMM>REGISTER'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    call comm%direct%register(&
         'DIRECT',&
         dabstract,&
         strg_emp,&
         error)
    if (error) return
    call comm%inverse%register(&
         'INVERSE',&
         iabstract,&
         strg_emp,&
         error)
    if (error) return
  end subroutine cubecompute_operdir_comm_register
  !
  subroutine cubecompute_operdir_comm_parse(comm,line,user,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(operdir_comm_t), intent(in)    :: comm
    character(len=*),      intent(in)    :: line
    class(operdir_user_t), intent(inout) :: user
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='OPERDIR>COMM>PARSE'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    call comm%direct%parse(line,user%direct,error)
    if (error) return
    call comm%inverse%parse(line,user%inverse,error)
    if (error) return
  end subroutine cubecompute_operdir_comm_parse
  !
  !------------------------------------------------------------------------
  !
  subroutine cubecompute_operdir_user_toprog(user,comm,prog,error)
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(operdir_user_t), intent(in)    :: user
    class(operdir_comm_t), intent(in)    :: comm
    class(operdir_prog_t), intent(inout) :: prog
    logical,               intent(inout) :: error
    !
    type(key_prog_t) :: direct,inverse
    character(len=*), parameter :: rname='OPERDIR>USER>TOPROG'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    call user%direct%toprog(comm%direct,direct,error)
    if (error) return
    call user%inverse%toprog(comm%inverse,inverse,error)
    if (error) return
    if (direct%act.and.inverse%act) then
       call cubecompute_message(seve%e,rname,'DIRECT and INVERSE keys are mutually exclusive')
       error = .true.
       return
    else if ((.not.direct%act).and.(.not.inverse%act)) then
       prog%code = code_operdir_default
    else
       if (direct%act) then
          prog%code = code_operdir_direct
       else
          prog%code = code_operdir_inverse
       endif
    endif
  end subroutine cubecompute_operdir_user_toprog
  !
  subroutine cubecompute_operdir_user_list(user,error)
    !----------------------------------------------------------------------
    ! For debugging purposes
    !----------------------------------------------------------------------
    class(operdir_user_t), intent(in)    :: user
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='OPERDIR>USER>LIST'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    ! ***JP: to be written
  end subroutine cubecompute_operdir_user_list
  !
  !------------------------------------------------------------------------
  !
  subroutine cubecompute_operdir_prog_list(prog,error)
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    class(operdir_prog_t), intent(inout) :: prog
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='OPERDIR>PROG>LIST'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    select case (prog%code)
    case (code_operdir_direct)
       call cubecompute_message(computeseve%trace,rname,'Direct operation')
    case (code_operdir_inverse)
       call cubecompute_message(computeseve%trace,rname,'Inverse operation')
    case (code_operdir_default)
       call cubecompute_message(computeseve%trace,rname,'Default operation')
    case default
       call cubecompute_message(seve%e,rname,'Unknown operdir direction')
       error = .true.
       return
    end select
  end subroutine cubecompute_operdir_prog_list
end module cubecompute_operdir_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
