!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeadm_directory_type
  use cubetools_structure
  use cubeadm_messaging
  !
  public :: dir,dir_opt_t
  public :: cubeadm_directory_create
  public :: cubeadm_found_createtuple,cubeadm_transname
  private
  !
  integer(kind=4), parameter :: dir_l = 3 
  integer(kind=4), parameter :: ndirtype = 3
  integer(kind=code_k), parameter :: iraw = 1
  integer(kind=code_k), parameter :: itmp = 2
  integer(kind=code_k), parameter :: ired = 3
  character(len=*), parameter :: dirtype(ndirtype) = ['RAW','TMP','RED']
  character(len=*), parameter :: dirdefault(ndirtype) = ['raw/','tmp/','red/']
  !
  type dir_t
     character(len=file_l)          :: dirs(ndirtype)
     character(len=file_l), pointer :: raw 
     character(len=file_l), pointer :: tmp 
     character(len=file_l), pointer :: red
   contains
     procedure, public :: init   => cubeadm_directory_buffer_init
     procedure, public :: sicdef => cubeadm_directory_buffer_sicdef
     procedure, public :: list   => cubeadm_directory_buffer_list
  end type dir_t
  !
  type dir_opt_t
     type(option_t),        pointer :: opt
     integer(kind=code_k)           :: type
   contains
     procedure, public  :: register => cubeadm_directory_option_register
     procedure, public  :: parse    => cubeadm_directory_option_parse
  end type dir_opt_t
  !
  type(dir_t) :: dir
  !
contains
  !
  subroutine cubeadm_directory_buffer_init(dir,error)
    !----------------------------------------------------------------------
    ! Initializes the directory buffer and sets it to defaults
    !----------------------------------------------------------------------
    class(dir_t), target, intent(inout) :: dir
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname = "DIRECTORY>BUFFER>INIT"
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    dir%dirs = dirdefault
    dir%raw => dir%dirs(iraw)
    dir%tmp => dir%dirs(itmp)
    dir%red => dir%dirs(ired)
  end subroutine cubeadm_directory_buffer_init
  !
  subroutine cubeadm_directory_buffer_sicdef(dir,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Define the SIC variables mapping the dir% directories
    !-------------------------------------------------------------------
    class(dir_t), intent(in)    :: dir
    logical,      intent(inout) :: error
    !
    character(len=*), parameter :: rname = "DIRECTORY>BUFFER>SICDEF"
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call sic_defstructure('cube%dir',.true.,error)
    if (error) return
    call sic_def_char('cube%dir%raw',dir%raw,.false.,error)
    call sic_def_char('cube%dir%tmp',dir%tmp,.false.,error)
    call sic_def_char('cube%dir%red',dir%red,.false.,error)
    if (error) return
  end subroutine cubeadm_directory_buffer_sicdef
  !
  subroutine cubeadm_directory_buffer_list(dir,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(dir_t), intent(in)    :: dir
    logical,      intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='DIRECTORY>BUFFER>LIST'
    !
    call cubeadm_message(seve%r,rname,'Directories are:')
    write(mess,10) dirtype(1),trim(dir%raw)
    call cubeadm_message(seve%r,rname,mess)
    write(mess,10) dirtype(2),trim(dir%tmp)
    call cubeadm_message(seve%r,rname,mess)
    write(mess,10) dirtype(3),trim(dir%red)
    call cubeadm_message(seve%r,rname,mess)
    !
    10 format(T2,A,': ',A)
  end subroutine cubeadm_directory_buffer_list
  !
  !----------------------------------------------------------------------
  !
  subroutine cubeadm_directory_option_register(dire,type,abstract,error)
    use cubetools_disambiguate
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(dir_opt_t), intent(inout) :: dire
    character(len=*), intent(in)    :: type
    character(len=*), intent(in)    :: abstract
    logical,          intent(inout) :: error
    !
    type(standard_arg_t) :: stdarg
    character(len=dir_l) :: solved
    character(len=*), parameter :: rname = "DIRECTORY>OPTION>REGISTER"
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call cubetools_disambiguate_strict(type,dirtype,dire%type,solved,error)
    if (error) return
    call cubetools_register_option(&
         type,'dirname',&
         abstract,&
         strg_id,&
         dire%opt,error)
    if (error) return
    call stdarg%register( &
         'dirname',  &
         'Directory name or path', &
         strg_id,&
         code_arg_optional, &
         error)
    if (error) return
  end subroutine cubeadm_directory_option_register
  !
  subroutine cubeadm_directory_option_parse(dire,line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(dir_opt_t), intent(inout) :: dire
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    logical :: do
    character(len=file_l) :: path
    integer(kind=4) :: nc
    character(len=*), parameter :: rname = "DIRECTORY>OPTION>PARSE"
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call dire%opt%present(line,do,error)
    if (error) return
    if (do) then
       call cubetools_getarg(line,dire%opt,1,path,mandatory,error)
       if (error) return
       nc = len_trim(path)
       if (path(nc:nc).ne.'/')  path(nc+1:nc+1) = '/'
       dir%dirs(dire%type) = path
    else
       ! Do nothing
    endif
  end subroutine cubeadm_directory_option_parse
  !
  !----------------------------------------------------------------------
  !
  subroutine cubeadm_directory_create(dirname,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*), intent(inout) :: dirname
    logical,          intent(inout) :: error
    !
    integer(kind=4) :: nlength
    !
    nlength = len_trim(dirname)
    if (gag_inquire(dirname,nlength).ne.0) then
      call gag_mkdir(dirname,error)
      if (error) return
    endif
  end subroutine cubeadm_directory_create
  !
  subroutine cubeadm_found_createtuple(filename,cubeid,tuple,cube,error)
    use gkernel_interfaces
    use cube_types
    use cubedag_tuple
    use cubeio_cube_define
    use cubetuple_get
    !-------------------------------------------------------------------
    ! Search for the cube on disk and fill the associated tuple (with
    ! this single entry only).
    !-------------------------------------------------------------------
    character(len=*),      intent(in)    :: filename
    character(len=*),      intent(in)    :: cubeid  ! Identifier (feedback only)
    type(cubedag_tuple_t), intent(inout) :: tuple
    type(cube_t),          intent(inout) :: cube
    logical,               intent(inout) :: error
    !
    character(len=file_l) :: filedir,cubename
    character(len=base_l) :: filebase
    character(len=exte_l) :: fileext
    character(len=*), parameter :: rname='FOUND>CREATETUPLE'
    !
    call sic_parse_name(filename,filebase,fileext,filedir)
    !
    if (.not.cubeadm_found_fromdisk(code_access_imaset_or_speset,filedir,  &
      filebase,fileext,cubename,error)) then
       call cubeadm_message(seve%e,rname,'Can not create tuple file')
       error = .true.
       return
    endif
    !
    call cubeio_cube_define_access(cube%prog,code_access_any,error)
    if (error)  return
    call cubeio_cube_define_action(cube%prog,code_read,error)
    if (error)  return
    call cubetuple_read_cube_header(cubename,cubeid,cube,error)
    if (error) return
    call cubedag_tuple_upsert(tuple,cube%order(),code_buffer_disk,cubename,error)
    if (error)  return
  end subroutine cubeadm_found_createtuple
  !
  function cubeadm_found_fromdisk(access,filedir,filebase,fileext,cubename,error)
    use cubetools_access
    !-------------------------------------------------------------------
    ! Find the cube and return its full path
    !-------------------------------------------------------------------
    logical                         :: cubeadm_found_fromdisk
    integer(kind=4),  intent(in)    :: access
    character(len=*), intent(in)    :: filedir
    character(len=*), intent(in)    :: filebase
    character(len=*), intent(in)    :: fileext
    character(len=*), intent(out)   :: cubename
    logical,          intent(inout) :: error
    !
    character(len=file_l) :: fullname
    character(len=exte_l) :: exts(2)
    integer(kind=4) :: nexts,iext
    integer(kind=code_k) :: o1,o2
    character(len=*), parameter :: rname='FOUND>FROMDISK'
    !
    if (fileext.eq.'') then
       select case (access)
       case (code_access_imaset)
          o1 = code_cube_imaset
          o2 = code_cube_speset
       case (code_access_speset)
          o1 = code_cube_speset
          o2 = code_cube_imaset
       case (code_access_imaset_or_speset)
          ! ZZZ Which precedence?
          o1 = code_cube_speset
          o2 = code_cube_imaset
       case default
          call cubeadm_message(seve%e,rname,'Access code must be either image or spectrum')
          cubeadm_found_fromdisk = .false.
          cubename = ''
          error = .true.
          return
       end select
       nexts = 2
       exts(1) = cubetools_order2ext(o1)
       exts(2) = cubetools_order2ext(o2)
    else
       nexts = 1
       exts(1) = '.'//fileext
    endif
    !
    cubeadm_found_fromdisk = .true.
    do iext=1,nexts
       fullname = trim(filebase)//exts(iext)
       if (cubeadm_found_one(filedir,fullname,cubename))  return
    enddo
    cubeadm_found_fromdisk = .false.
  end function cubeadm_found_fromdisk
  !
  function cubeadm_found_one(direc,iname,oname)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    logical                       :: cubeadm_found_one
    character(len=*), intent(in)  :: direc
    character(len=*), intent(in)  :: iname
    character(len=*), intent(out) :: oname
    !
    integer(kind=4) :: nc
    character(len=*), parameter :: rname='FOUND>ONE'
    !
    oname = trim(direc)//trim(iname)
    nc = len_trim(oname)
    cubeadm_found_one = gag_inquire(oname,nc).eq.0
    if (cubeadm_found_one) then
      call cubeadm_message(seve%d,rname,oname(1:nc)//' found')
    else
      call cubeadm_message(seve%i,rname,oname(1:nc)//' not found')
    endif
  end function cubeadm_found_one
  !
  function cubeadm_transname(id,taccess,error)
    use cubetools_access
    use cubedag_parameters
    !---------------------------------------------------------------------
    ! Return the transposed file name (path+base+extension) from the
    ! original file name.
    ! If iname has the form: ipath/ibase.iext
    !    tname is set as:    dir%tmp/id.text
    !
    ! Note that for 100% robustness, the tranposed file does not use the
    ! same basename as its original file. This because we can be dealing
    ! with 2 raw files raw1/foo.lmv and raw2/foo.lmv, and both transposed
    ! would be named tmp/foo.vlm
    !---------------------------------------------------------------------
    character(len=file_l)               :: cubeadm_transname
    integer(kind=iden_l), intent(in)    :: id
    integer(kind=4),      intent(in)    :: taccess  ! code_cube_*
    logical,              intent(inout) :: error
    !
    character(len=base_l) :: obase
    !
    call cubeadm_directory_create(dir%tmp,error)
    if (error)  return
    !
    write(obase,'(I0)')  id
    cubeadm_transname = trim(dir%tmp)//trim(obase)//cubetools_access2ext(taccess)
  end function cubeadm_transname
end module cubeadm_directory_type
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
