subroutine gtl_destroy(line,error)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gtl_destroy
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !  Support routine for command CLEAR
  !---------------------------------------------------------------------
  character(len=*), intent(inout) :: line   ! Input command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='DESTROY'
  integer, parameter :: nvocab=3
  character(len=12) :: vocab(nvocab),to_check,comm
  integer :: nc,ncom
  ! Data
  data vocab / 'ALL','DIRECTORY','WINDOW' /
  !
  ! Get the argument
  call sic_ke (line,0,1,to_check,nc,.true.,error)
  if (error) return
  call sic_ambigs(rname,to_check,comm,ncom,vocab,nvocab,error)
  if (error)  return
  !
  select case (comm)
  case ('ALL')
    call gtv_destroy_all(error)
    !
  case ('DIRECTORY')
    call gtl_destroy_directory(line,error)
    if (error)  return
    call gtview('Update')
    !
  case ('WINDOW')
    call gtl_destroy_window(line,error)
    !
  case default
    call gtv_message(seve%e,rname,''''//trim(comm)//''' not yet implemented.')
    error = .true.
    return
  end select
  !
end subroutine gtl_destroy
!
subroutine gtl_destroy_directory(line,error)
  use gbl_message
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gtl_destroy_directory
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command DESTROY DIRECTORY [Name]
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Input command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='DESTROY'
  character(len=gtvpath_length) :: dirname
  integer :: nc
  !
  ! Get directory name. No name means last subdirectory
  dirname = ''
  call sic_ch(line,0,2,dirname,nc,.false.,error)
  if (error) return
  !
  call gtv_destroy_directory(dirname,error)
  if (error)  return
  !
end subroutine gtl_destroy_directory
!
subroutine gtv_destroy_directory(name,error)
  use gbl_message
  use gtv_interfaces, except_this=>gtv_destroy_directory
  use gtv_buffers
  use gtv_types
  !---------------------------------------------------------------------
  ! @ public
  ! Support for DESTROY DIRECTORY, using a name as input argument
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: name   !
  logical,          intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='DESTROY'
  character(len=gtvpath_length) :: dirname
  logical :: isdir,found
  type(gt_directory), pointer :: workdir,otherdir,newdir
  type(gt_segment), pointer :: segm
  !
  if (name.eq.'') then
    ! Delete the last subdirectory (for symetry with CLEAR SEGMENT)
    ! of the current directory
    if (.not.associated(cw_directory%son_last)) then
      call gtv_message(seve%e,rname,'No subdirectory to destroy here')
      error = .true.
      return
    endif
    !
    workdir => cw_directory%son_last
    !
  else
    dirname = name
    call sic_upper(dirname)
    !
    ! Get the directory
    call decode_chemin(dirname,cw_directory,workdir,isdir,segm,found)
    if (.not.found) then
      call gtv_message(seve%e,rname,'No such directory '//dirname)
      error = .true.
      return
    endif
    if (.not.isdir) then
      call gtv_message(seve%e,rname,  &
        'Input segment is not a directory, use CLEAR SEGMENT [Name] instead')
      error = .true.
      return
    endif
  endif
  !
  ! Protect root
  if (associated(workdir,root)) then
    call gtv_message(seve%e,rname,'Can not delete root directory <')
    error = .true.
    return
  endif
  !
  ! Protect Current Working Directory
  otherdir => cw_directory
  do while (associated(otherdir))
    if (associated(otherdir,workdir)) then
      ! One of the fathers is the directory to be destroyed. Switch to its
      ! parent.
      newdir => workdir%father
      if (associated(newdir,root)) then
        call gtv_message(seve%e,rname,  &
          'You are in a tree to be destroyed, move somewhere else before')
        error = .true.
        return
      else
        call gtv_open_segments_for_writing_from_main()
        call cd_by_adr(newdir,newdir%x%curwin,error)
        call gtv_close_segments_for_writing_from_main()
        if (error)  return
        exit
      endif
    endif
    otherdir => otherdir%father
  enddo
  !
  call destroy_directory(workdir,error)  ! Thread-safe
  if (error)  return
  !
end subroutine gtv_destroy_directory
!
subroutine destroy_directory(dir,error)
  use gtv_interfaces, except_this=>destroy_directory
  use gtv_protocol
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Cleanly destroy the input directory, taking care of the surrounding
  ! pointers and chain in the GTV tree.
  ! ---
  !   Threads status: thread safe
  !---------------------------------------------------------------------
  type(gt_directory), pointer       :: dir    ! Directory to destroy
  logical,            intent(inout) :: error  ! Logical error flag
  ! Local
  type(gt_directory), pointer :: father,otherdir,previous,next
  !
  if (.not.associated(dir))  return
  !
  ! 1) Look for the surrounding elements
  ! Parent
  father => dir%father
  ! Previous
  otherdir => father%son_first
  previous => null()
  do while (.not.associated(otherdir,dir))
    previous => otherdir
    otherdir => otherdir%brother
  enddo
  ! Next
  next => dir%brother
  !
  call gtv_open_segments_for_writing_from_main()
  !
  ! 2) Update the pointers and chain in the tree (parent or brother)
  if (.not.associated(previous)) then
    ! We are destroying the first son of the parent directory
    father%son_first => next  ! ... which can be null()
  else
    previous%brother => next  ! ... which can be null()
  endif
  if (.not.associated(next)) then
    ! We are destroying the last son of the parent directory
    father%son_last => previous  ! ... which can be null()
  endif
  !
  ! 3) Update the limits of the parent directory
  call gtv_limits(father,error)
  !
  ! 4) Destroy all the windows attached to the directory and
  ! subdirectories
  call win_destroy_all_recursive(dir,error)
  ! if (error) ?
  !
  call gtv_close_segments_for_writing_from_main()
  !
  ! 5) Effectively destroy the directory. This can be done out of
  ! the threads protection since its existence is know hidden to
  ! the rest of the world.
  dir%brother => null()  ! Only destroy 'dir', not the whole list.
  ! if (associated(dir)) then => tested above
    call x_destroy_directory(dir)  ! will call gtv_deldirectories(dir)
  !
end subroutine destroy_directory
!
subroutine gtv_destroy_all(error)
  use gildas_def
  use gtv_tree
  use gtv_buffers
  use gtv_graphic
  use gtv_interfaces, except_this=>gtv_destroy_all
  use gtv_protocol
  use gtv_plot
  use gtv_segatt
  use gtv_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  !   Destroy all the trees and windows.
  !   Since it is forbidden to user to be in root (<) and to create
  ! segments in it, he would have first to create a new top-directory
  ! and go in it. So we do it implicitely for him.
  !   In practice, destroy all the trees and windows EXCEPT the first
  ! window of the first child under root (normally, <GREG). This avoids
  ! to destroy and recreate a new window which could be moved to another
  ! place by the window manager.
  ! ---
  !  Thread status: safe to call from main thread.
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='DESTROY ALL'
  integer(kind=address_length) :: genv_saved
  logical :: found
  type(greg_values) :: dummy_tab
  type(gt_directory), pointer :: ancestor,brother
  !
  if (.not.awake .or. error_condition) return
  !
  ! First clear the windows
  if (cw_device%protocol.eq.p_x) then
    ! Get first child of the root, should be <GREG
    ancestor => root%son_first
    !
    call gtv_open_segments_for_writing_from_main()
    !
    ! Clear <GREG (first child) tree, keep one window
    call win_destroy_almost_recursive(ancestor,genv_saved,error)
    !
    ! Clear all other ancestors, delete all windows
    brother => ancestor%brother
    do while (associated(brother) .and. .not.error)
      call win_destroy_all_recursive(brother,error)
      !
      brother => brother%brother
    enddo
    !
    call gtv_close_segments_for_writing_from_main()
    !
  endif
  !
  ! Clear all the directories (and the allocated data in each: polylines,
  ! images, etc). In other words: throw away the current GTV tree and
  ! create a new one. Put it in the stack to ensure that all the remaining
  ! drawing instructions have been performed.
  if (associated(root))  &
    call x_destroy_directory(root)  ! will call gtv_deldirectories(root)
  !
  ! And now recreate a basic tree (i.e. < and <GREG)...
  call gtx_segm_0(error)
  if (error)  return
  !
  ! ... and attach a window.
  if (cw_device%protocol.ne.p_x) then
    call gti_clear(cw_output)
    !
  else
    !
    if (genv_saved.eq.0) then
      ! A new window will be attached to the output instances list:
      call get_free_slot_output(cw_output,error)
      if (error)  return
      cw_output%dev => cw_device  ! Point on the shared X-protocol instance
      call x_display_reset(cw_output%x)  ! Default values
      cw_output%color = .true.
      cw_output%background = cw_output%dev%background  ! Device default color is used
      call create_window(cw_output,.true.,cw_directory,.true.,.true.,error)
    else
      call gtv_open_segments_for_writing_from_main()
      call get_slot_output_by_genv(genv_saved,cw_output,.true.,found,error)
      if (error)  return
      call use_fen(cw_directory,genv_saved,error,' ')
      call gtv_close_segments_for_writing_from_main()
    endif
    !
    if (error) then
      call gtv_message(seve%e,rname,'Cannot create or reuse window')
      return
    endif
    !
    ! By default the physical area the window sees is the full physical area
    ! of the brand new directory. Must come after the 'cw_output' definition.
    cw_output%gx1 = 0.
    cw_output%gx2 = phys_sizex_def
    cw_output%gy1 = 0.
    cw_output%gy2 = phys_sizey_def
    !
  endif
  !
  cdepth = 1
  vdepth(1) = .true.
  vdepth(2:max_depth) = .false.
  !
  if (flag_greg)  &
    call reset_greg_val(dummy_tab)  ! 'dummy_tab' values unused during reset
  !
end subroutine gtv_destroy_all
!
subroutine gtclear
  use gtv_interfaces, except_this=>gtclear
  !---------------------------------------------------------------------
  ! @ public obsolete
  ! Obsolete entry point to 'gtv_destroy_all'. To be removed from
  ! some packages and official documentation before.
  ! SB, 22-09-2009
  !---------------------------------------------------------------------
  logical :: error
  error = .false.
  call gtv_destroy_all(error)
end subroutine gtclear
!
subroutine use_fen(dir,genv,error,nam)
  use gildas_def
  use gtv_buffers
  use gtv_graphic
  use gtv_interfaces, except_this=>use_fen
  use gtv_protocol
  use gtv_tree
  use gtv_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !  Re-use a pre-existing window...
  !  Utilise UNIQUEMENT par gtv_destroy_all, apres un appel a DESTROY_MOST
  ! ---
  !  Thread status: not thread safe. Calling routine must be thread
  ! safe for writing.
  !---------------------------------------------------------------------
  type(gt_directory)              :: dir      ! Pointer to directory
  integer(kind=address_length)    :: genv     !
  logical,          intent(inout) :: error    ! Logical error flag
  character(len=*), intent(in)    :: nam      ! Optional window name
  ! Local
  integer :: nb_env
  character(len=64) :: dirname
  integer*4 :: nl,width,height
  !
  if (cw_output%dev%protocol.eq.p_null)  then
    ! No device, nothing to do
    return
    !
  elseif (cw_device%protocol.ne.p_x) then
    error = .true.
    call gtv_message(seve%e,'USE_FEN','Not implemented')
    return
  endif
  !
  ! Recuperation du nom du repertoire. The name of the x window is the directory
  ! name and the window number, unless otherwise specified in the calling
  ! arguments
  nb_env = 0
  nl = len_trim(nam)
  if (nl.eq.0) then
    call cree_chemin_dir(dir,dirname,nl)
    dirname(nl+1:) = ' 0'
  else
    dirname = nam(1:nl)
  endif
  !
  ! This will be a new window in a directory with no windows.
  ! Create a new table for the addresses of the graphical environments,
  ! put the address of the table in the directory descriptor
  dir%x%genv_array = c_new_genv_array(mwindows)
  !
  ! Put the address of the graphical environment in the directory descriptor
  dir%x%genv = genv
  !
  ! Put the address of the graphical environment in the table of addresses for
  ! all the windows in the directory (the table is ordered by window number)
  call c_set_win_genv(dir%x%genv_array,nb_env,genv)
  !
  ! Put the number of the current window and the total number of windows in the
  ! directory descriptor
  dir%x%curwin = nb_env
  dir%x%nbwin = nb_env+1
  !
  ! Update global values
  call get_win_pixel_info(genv,cw_output%px1,cw_output%py1,  &
                               cw_output%px2,cw_output%py2)
  cw_device%hardw_cursor = .true.
  !
  ! Use a Character String (DIRNAME): not portable...
  call reusewindow(genv,dirname,width,height,dir,len_trim(dirname))
  !
end subroutine use_fen
!
subroutine gtl_destroy_window(line,error)
  use gbl_message
  use gtv_buffers
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gtl_destroy_window
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command:
  !  DESTROY WINDOW [Dirname [WinNum|ZOOM]]
  ! Destroys all the windows of the input directory
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Input command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='DESTROY WINDOW'
  character(len=gtvpath_length) :: dirname
  integer :: nc,cnum
  logical :: isdir,found
  type(gt_segment), pointer :: segm
  type(gt_directory), pointer :: workdir
  !
  if (sic_present(0,2)) then
    ! Get directory name
    call sic_ch(line,0,2,dirname,nc,.true.,error)
    if (error) return
    call sic_upper(dirname)
    !
    ! Get the directory
    call decode_chemin(dirname,cw_directory,workdir,isdir,segm,found)
    if (.not.found) then
      call gtv_message(seve%e,rname,'No such directory '//dirname)
      error = .true.
      return
    endif
    if (.not.isdir) then
      call gtv_message(seve%e,rname,'Input segment is not a directory')
      error = .true.
      return
    endif
    !
  else
    workdir => cw_directory
  endif
  !
  call gtv_open_segments_for_writing_from_main()
  !
  if (sic_present(0,3)) then
    ! Destroy given window
    cnum = get_window_cnum_byname(workdir,rname,line,0,3,error)
    if (error .or. cnum.lt.0) then
      call gtv_message(seve%w,rname,'No such window, nothing done')
      return
    endif
    call win_destroy_one(workdir,cnum,error)
  else
    ! Destroy all windows
    call win_destroy_all(workdir,error)
  endif
  !
  call gtv_close_segments_for_writing_from_main()
  !
end subroutine gtl_destroy_window
!
subroutine win_destroy_one_genv(dir,num_to_delete,error)
  use gildas_def
  use gbl_message
  use gtv_buffers
  use gtv_interfaces, except_this=>win_destroy_one_genv
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !   Elemental routine which detaches the pointer to the input window
  ! from the input directory: the directory descriptor is updated
  ! accordingly. The code here assumes that c_delete_win_genv
  ! removes and shifts the window to be deleted from the genv_array
  ! list.
  !   Can be called by the window which is destroying itself (e.g.
  ! user has closed it manually).
  ! ---
  !  Thread status: not thread safe. Calling routine must be thread
  ! safe for writing.
  !---------------------------------------------------------------------
  type(gt_directory)             :: dir            ! Directory where the window is attached
  integer(kind=4), intent(in)    :: num_to_delete  ! Window number to be deleted
  logical,         intent(inout) :: error          ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='WIN_DESTROY_ONE_GENV'
  integer(kind=address_length) :: genv
  character(len=message_length) :: mess
  !
  if (dir%x%genv_array.eq.0) then
    call gtv_message(seve%e,rname,'No graphical environment attached')
    error = .true.
    return
  endif
  !
  ! Get the current window index and total number of windows attached
  if (dir%x%nbwin.eq.0) then
    call gtv_message(seve%e,rname,'No window attached')
    error = .true.
    return
  endif
  if (num_to_delete.ge.dir%x%nbwin) then
    write (mess,'(A,I0,A,I0,A)') 'Invalid window number #',num_to_delete,  &
      ' (directory has only ',dir%x%nbwin,' window(s))'
    call gtv_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  genv = c_get_win_genv(dir%x%genv_array,num_to_delete)
  !
  ! Decrease the number of windows attached, ...
  dir%x%nbwin = dir%x%nbwin-1
  ! compress the genv array, ...
  call c_delete_win_genv(dir%x%genv_array,num_to_delete)
  !
  ! Does any window remain attached?
  if (dir%x%nbwin.eq.0) then
    ! Delete the genv_array
    call c_delete_genv_array(dir%x%genv_array)
    dir%x%genv_array = 0
    !
    dir%x%curwin = 0  ! Dummy value
    !
    dir%x%genv = 0
    !
  elseif (dir%x%curwin.eq.num_to_delete) then
    ! Modify the active window number (arbitrarily take the first of the list
    ! of windows). Call cd_by_win which does all the job correctly.
    call cd_by_win(dir,0,error)
    !
  elseif (dir%x%curwin.gt.num_to_delete) then
    ! c_delete_win_genv should have decreased the window number for the C side.
    ! All is ok except the new number of the active window which has changed.
    dir%x%curwin = dir%x%curwin-1
    !
  endif
  !
  ! Free the window instance
  call free_slot_output_by_genv(genv,error)
  if (error)  return
  !
end subroutine win_destroy_one_genv
!
subroutine win_destroy_one(dir,num_to_delete,error)
  use gildas_def
  use gbl_message
  use gtv_buffers
  use gtv_interfaces, except_this=>win_destroy_one
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !   Elemental routine which detaches the input window from the input
  ! directory: the window is destroyed and the directory descriptor is
  ! updated accordingly.
  !   Can be called by the user from the command line e.g. CLEAR
  ! WINDOW num.
  ! ---
  !  Thread status: not thread safe. Calling routine must be thread
  ! safe for writing.
  !---------------------------------------------------------------------
  type(gt_directory)             :: dir            ! Directory where the window is attached
  integer(kind=4), intent(in)    :: num_to_delete  ! Window number to be deleted
  logical,         intent(inout) :: error          ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='WIN_DESTROY_ONE'
  integer(kind=address_length) :: genv
  !
  if (error)  return
  !
  if (dir%x%genv_array.eq.0) then
    call gtv_message(seve%e,rname,'No graphical environment attached')
    error = .true.
    return
  endif
  !
  ! Get the current window index and total number of windows attached
  genv = c_get_win_genv(dir%x%genv_array,num_to_delete)
  if (genv.eq.0) then
    call gtv_message(seve%e,rname,'Invalid window number')
    error = .true.
    return
  endif
  !
  ! Destroy the X window
  call x_destroy_window(dir%x%genv_array,genv)
  !
  ! Suppress the window cleanly in the GTV tree
  call win_destroy_one_genv(dir,num_to_delete,error)
  !
  ! NB: 'win_destroy_one_genv' is called when the destruction order
  ! comes from Fortran (i.e. the 2 above routine calls). When the
  ! order does not come from Fortran (i.e. user closed it manually),
  ! the window must call it by itself.
  !  This scheme MUST be preserved in a multi-thread context: the
  ! window should not call 'win_destroy_one_genv' in all cases, since
  ! this can imply an asynchroneous call, when the parent directory
  ! is already destroyed. Which would mean: troubles...
  !
end subroutine win_destroy_one
!
subroutine win_destroy_all(dir,error)
  use gildas_def
  use gtv_buffers
  use gtv_interfaces, except_this=>win_destroy_all
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !  Detach all the windows attached to the input directory, and
  ! update the directory descriptor accordingly.
  ! ---
  !  Thread status: not thread safe. Calling routine must be thread
  ! safe for writing.
  !---------------------------------------------------------------------
  type(gt_directory)     :: dir    ! Directory where the window is attached
  logical, intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='WIN_DESTROY_ALL'
  integer*4 :: iwin
  !
  do iwin=dir%x%nbwin-1,0,-1
    ! Detach from last to first window (this order mandatory).
    call win_destroy_one(dir,iwin,error)
    if (error)  return
  enddo
  !
end subroutine win_destroy_all
!
recursive subroutine win_destroy_all_recursive(dir,error)
  use gtv_interfaces, except_this=>win_destroy_all_recursive
  use gtv_buffers
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !  Detach all the windows starting from input directory and
  ! recursively in its sub-directories.
  ! ---
  !  Thread status: not thread safe. Calling routine must be thread
  ! safe for writing.
  !---------------------------------------------------------------------
  type(gt_directory)     :: dir    ! Directory to start from
  logical, intent(inout) :: error  ! Logical error flag
  ! Local
  type(gt_directory), pointer :: son
  !
  ! 1) Destroy the windows of the input directory
  call win_destroy_all(dir,error)
  if (error)  return
  !
  ! 2) Loop on its subdirectories and destroy their windows too
  son => dir%son_first
  do while (associated(son))
    call win_destroy_all_recursive(son,error)
    if (error)  return
    !
    son => son%brother
  enddo
  !
end subroutine win_destroy_all_recursive
!
subroutine win_destroy_almost(dir,genv,error)
  use gildas_def
  use gtv_buffers
  use gtv_interfaces, except_this=>win_destroy_almost
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !  Detach almost all the windows attached to the input directory, and
  ! update the directory descriptor accordingly. Keep only the first
  ! window of the input directory, and return its genv.
  ! ---
  !  Thread status: not thread safe. Calling routine must be thread
  ! safe for writing.
  !---------------------------------------------------------------------
  type(gt_directory)                          :: dir    ! Directory where the window is attached
  integer(kind=address_length), intent(out)   :: genv   ! Saved Genv
  logical,                      intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='WIN_DESTROY_ALMOST'
  integer*4 :: iwin
  !
  genv = 0  ! No window found for the time being
  !
  if (dir%x%genv_array.eq.0) then
    ! No graphical environment attached: which means, no window to save.
    ! Not an error.
    return
  endif
  !
  do iwin=dir%x%nbwin-1,1,-1
    ! Detach from last to 2nd (#1) window (this order mandatory).
    call win_destroy_one(dir,iwin,error)
    if (error)  return
  enddo
  !
  ! And return 1st window Genv
  genv = c_get_win_genv(dir%x%genv_array,0)
  ! Should not be 0 (== error) on return, since the genv_array exists.
  !
  ! ZZZ Do we really want this?
  ! Destroy the genv_array: a new one will be created after and the
  ! genv saved will restored in it.
  call c_delete_genv_array(dir%x%genv_array)
  !
end subroutine win_destroy_almost
!
subroutine win_destroy_almost_recursive(dir,genv,error)
  use gildas_def
  use gtv_buffers
  use gtv_interfaces, except_this=>win_destroy_almost_recursive
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !   Detach almost all the windows starting from input directory and
  ! recursively in its sub-directories. Keep only the first window
  ! of the input directory, and return its genv.
  ! ---
  !  Thread status: not thread safe. Calling routine must be thread
  ! safe for writing.
  !---------------------------------------------------------------------
  type(gt_directory)                          :: dir    ! Directory to start from
  integer(kind=address_length), intent(out)   :: genv   ! Saved Genv
  logical,                      intent(inout) :: error  ! Logical error flag
  ! Local
  type(gt_directory), pointer :: son
  !
  call win_destroy_almost(dir,genv,error)
  if (error)  return
  !
  son => dir%son_first
  do while (associated(son))
    call win_destroy_all_recursive(son,error)
    if (error)  return
    !
    son => son%brother
  enddo
  !
end subroutine win_destroy_almost_recursive
