!-----------------------------------------------------------------------
! Support file for command SIC\LET
!-----------------------------------------------------------------------
subroutine let_variable (line,nline,error)
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>let_variable
  use let_options
  !---------------------------------------------------------------------
  ! @ private
  !       Support routine for command
  !       LET Variable [=] Arithmetic expression
  !     [/NEW Type [Attr]]
  !     [/PROMPT "Prompt text"]
  !     [/WHERE Logical_Expression]
  !     [/RANGE Min Max]
  !     [/CHOICE C1 .. CN [*]]
  !     [/FILE Filter ]
  !     [/INDEX C1 .. CN]
  !     [/SEXAGESIMAL]
  !     [/LOWER]
  !     [/UPPER]
  !     [/FORMAT String]
  !     [/FORMULA]
  !     [/REPLACE]
  !     [/STATUS Read|Write]
  !     [/NOQUOTE]
  !     [/RESIZE]
  !
  ! Upper level to allow HEADER and STRUCTURE assignment
  !---------------------------------------------------------------------
  character(len=*)                :: line   !
  integer(kind=4),  intent(in)    :: nline  !
  logical,          intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='LET'
  integer(kind=4) :: nchar
  character(len=varname_length) :: var
  !
  call sic_ke (line,0,1,var,nchar,.true.,error)
  if (error) return
  !
  if (sic_present(optreplace,0)) then
    call let_replace(line,var,error)
    if (error) return
    !
  elseif (sic_present(optstatus,0)) then
    call let_status(line,error)
    if (error)  return
    !
  else
    if (var(nchar:nchar).ne.'%') then
      call let_avar(line,var,error)
    else if (sic_present(optresize,0)) then
      call sic_message(seve%e,rname,'/RESIZE cannot apply to Structures')
      error = .true.
    else
      ! Header assignement: special case
      call let_header(line,var,error)
    endif
  endif
end subroutine let_variable
!
subroutine let_avar(line,nameout,error)
  use gildas_def
  use gbl_format
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>let_avar
  use sic_structures
  use sic_dictionaries
  use sic_expressions
  use sic_interactions
  use sic_types
  use let_options
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !  LET Variable [=] Arithmetic expression [/OPTIONS]
  !
  ! Lower level for individual variable assignment
  !---------------------------------------------------------------------
  character(len=*)                :: line     !
  character(len=*), intent(inout) :: nameout  ! Variable name
  logical,          intent(inout) :: error    !
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='LET'
  integer(kind=4) :: ier,in,iarg,nc,np
  type(sic_dimensions_t) :: spec
  integer(kind=4) :: impndim,impvars(sic_maxdims),nline,i,kn,i_command
  character(len=12) :: command
  character(len=4) :: equal
  character(len=28) :: chain
  character(len=80) :: ptext,do_new_type
  type(sic_identifier_t) :: varout
  character(len=1024) :: expres
  logical :: do_new,do_where,do_many,do_upper,do_lower,do_sexage,do_format
  logical :: do_resize
  !
  ! Code
  i_command = 0
  !
  ! /NEW Type
  do_new = sic_present(optnew,0)
  if (do_new) then
    call let_new(line,nameout,do_new_type,error)
    if (error)  return
  endif
  !
  ! Parse dimensions
  spec%do%strict   = .true.   ! 'nameout' must refer to a valid specifier, not e.g. an expression
  spec%do%range    = .true.
  spec%do%subset   = .true.
  spec%do%implicit = .true.
  spec%do%twospec  = .true.   ! LET A[i][j:k] "AB" allowed
  call sic_parse_var(nameout,varout,spec,impvars,error)
  if (error) return
  if (spec%done(1)%implicit) then
    impndim = spec%done(1)%ndim  ! Useful size of 'impvars'
  else
    impndim = 0
  endif
  !
  ! Search first in local table
  varout%level = var_level
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,varout,in)
  if (ier.ne.1 .and. var_level.ne.0) then
    varout%level = 0
    ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,varout,in)
  endif
  if (ier.ne.1) then
    call sic_message(seve%e,rname,'No such variable '//nameout)
    error =.true.
    goto 98
  endif
  !
  ! Check number of dimensions
  if (dicvar(in)%desc%type.le.0 .and. spec%done(1)%ndim.gt.dicvar(in)%desc%ndim) then
    ! This test is disabled for strings (type>0), it is checked in extract_descr
    call sic_message(seve%e,rname,'Too many dimensions for variable '//  &
      nameout)
    error = .true.
    goto 98
  endif
  !
  ! Check whether it is readonly
  if (dicvar(in)%desc%readonly) then
    call sic_message(seve%e,rname,'Readonly variables cannot be modified')
    error = .true.
    goto 98
  endif
  !
  do_format = sic_present(optformat,0)
  do_upper = sic_present(optupper,0)
  do_lower = sic_present(optlower,0)
  do_sexage = sic_present(optsexage,0)
  do_where = sic_present(optwhere,0)
  do_many = sic_present(optnoquote,0) ! Multiple arguments for one string...
  do_resize = sic_present(optresize,0)
  !
  ! Check conflicting options
  if (do_resize) then
    if (do_format .or. do_many .or. do_sexage .or. do_where) then
      call sic_message(seve%e,rname,'Conflicting options')
      error = .true.
    endif
  endif
  if (do_where) then
    if (sic_narg(optwhere).gt.1) then
      call sic_message(seve%e,rname,'/WHERE has trailing arguments')
      error = .true.
    endif
    if (do_upper.or.do_lower.or.do_sexage.or.do_format) then
      call sic_message(seve%e,rname,'Conflicting options')
      error = .true.
    endif
    if (dicvar(in)%desc%type.gt.0) then
      call sic_message(seve%e,rname,'Option not valid for Character string')
      error = .true.
    endif
  elseif (do_upper.and.do_lower) then
    call sic_message(seve%e,rname,'Conflicting options')
    error = .true.
  elseif (do_upper.or.do_lower) then
    if (do_sexage.or.do_format.or.do_many) then
      call sic_message(seve%e,rname,'Conflicting options')
      error = .true.
    elseif  (dicvar(in)%desc%type.le.0) then
      call sic_message(seve%e,rname,'Option only valid for Character string')
      error = .true.
    endif
  elseif (do_sexage) then
    if (do_format.or.do_many) then
      call sic_message(seve%e,rname,'Conflicting options')
      error = .true.
    endif
  elseif (do_format.or.do_many) then
    if (dicvar(in)%desc%type.le.0) then
      call sic_message(seve%e,rname,'Option only valid for Character string')
      error = .true.
    endif
  endif
  if (error) goto 98
  !
  ! Check for = sign and ignore it
  iarg = 2
  if (sic_present(0,2)) then
    equal = line(sic_start(0,2):sic_end(0,2))
    if (equal.eq.'=') iarg = 3
  endif
  !
  ! If no further argument, prompt for text
  if (.not.sic_present(0,iarg)) then
    if (sic_present(optprompt,1)) then
      nline = index (line,'/PROMPT')
      if (do_new) nline = min(nline, index(line,'/NEW'))
      call sic_ch (line,optprompt,1,ptext,np,.true.,error)
      if (error) goto 98
      line(nline:nline) = ' '
      call sic_wprn(ptext(1:np)//': '//trim(varout%name)//' = ',line(nline+1:),nc)
    else
      if (do_new) then
        nline = index (line,'/NEW')
        line(nline:) = ' '
      else
        nline = len_trim(line)+1
      endif
      call sic_wprn(trim(varout%name)//' = ',line(nline+1:),nc)
    endif
    if (nc.eq.0) then
      error = .true.
      goto 98
    endif
    nline = min(nline+nc,len(line))
    call sic_format(line,nline)
    call sic_analyse (command,line,nline,error)
    if (error) goto 98
    if (do_new) then
      chain = ' /NEW '//do_new_type
      line(nline+1:) = chain
      nline = len_trim(line)
    endif
  endif
  !
  ! Check if variable should (and can) be resized
  if (do_resize) then
    call let_resize(in,varout,iarg,error)
    if (error)  goto 98
  endif
  !
  ! Check the X-Window mode if set
  ! if X_WINDOW is not set, X_COMMANDS will be zero, so will be I_COMMAND
  i_command = 0
  if (x_commands.ge.1)  &
    call let_xwindow(line,varout%name,in,i_command,error)
  !
  ! Now assign the value
  if (do_sexage) then
    ! Sexagesimal mode valid only for scalar real variables
    call let_avar_sexag(line,dicvar(in),spec,error)
    goto 98
    !
  elseif (dicvar(in)%desc%type.eq.0) then
    ! Headers...
    call sic_message(seve%e,rname,'Header structures cannot be assigned')
    error = .true.
    goto 98
    !
  elseif (dicvar(in)%desc%type.gt.0) then
    ! Characters
    call let_avar_character(line,dicvar(in),spec,iarg,error)
    if (error)  goto 98
    !
  else
    ! Arithmetic (in general, including logicals)
    call let_avar_numeric(line,dicvar(in),spec,impvars,iarg,error)
    if (error)  goto 98
  endif
  !
  ! Final cleanup
98 continue
  !
  ! If /NEW, we created a variable but something went wrong during
  ! assignement: delete it
  if (error .and. do_new) then
    call sic_delvariable(varout%name,.true.,error)
    if (error)  return
  endif
  !
  ! Clean implicit variables
  if (spec%done(1)%implicit) then
    do i=1,impndim
      kn = impvars(i)
      if (kn.eq.0)  cycle  ! No variable defined (unnamed dimension)
      ! Clean their memory, if it was allocated
      if (dicvar(kn)%desc%status.ne.empty_operand)  &
        call free_vm(dicvar(kn)%desc%size,dicvar(kn)%desc%addr)
      ! Clean them from dictionary
      call sic_zapvariable(kn,.true.,.true.,error)
    enddo
  endif
  !
  ! Deferred update...
  ! if X_WINDOW mode is not set, I_COMMAND will be 0.
  if (i_command.ne.0) then
    call sic_var_to_string(dicvar(in)%desc,expres)
    call xgag_update(varout%name,expres)
  endif
  !
end subroutine let_avar
!
subroutine let_avar_numeric(line,var,spec,impvars,argfirst,error)
  use gildas_def
  use gbl_format
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>let_avar_numeric
  use sic_dictionaries
  use sic_expressions
  use sic_types
  use let_options
  !---------------------------------------------------------------------
  ! @ private
  !  Support routine for LET (numeric or logical output variable)
  !---------------------------------------------------------------------
  character(len=*),       intent(in)    :: line                  ! Input command line
  type(sic_variable_t),   intent(in)    :: var                   ! Output variable
  type(sic_dimensions_t), intent(inout) :: spec                  !
  integer(kind=4),        intent(in)    :: impvars(sic_maxdims)  !
  integer(kind=4),        intent(in)    :: argfirst              !
  logical,                intent(inout) :: error                 !
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='LET'
  integer(kind=address_length) :: ipnt
  type(sic_descriptor_t) :: ldesc,tdesc
  type(sic_dimensions_done_t) :: vspec(2)
  character(len=1024) :: argum,expres
  type(sic_descriptor_t) :: rdesc
  logical :: by_one,found,simple,do_where
  character(len=message_length) :: mess
  integer(kind=size_length) :: lsize,tsize,size,step
  integer(kind=4) :: i,ier,ilen,itype,jarg,j,kn,max_level,min_level,nletarg
  integer(kind=4), save :: tree(formula_length*2)
  type(sic_descriptor_t), save :: operand(0:maxoper)
  integer(kind=4), save :: last_node
  integer(kind=4) :: i4
  integer(kind=8) :: i8
  real(kind=4) :: r4
  real(kind=8) :: r8
  logical :: l
  integer(kind=8), parameter :: maxi4=2147483647_8
  !
  rdesc%status = empty_operand
  !
  if (spec%done(2)%ndim.gt.0) then
    call sic_message(seve%e,rname,  &
      'Invalid substring specification on non-character string')
    error = .true.
    return
  endif
  !
  if (spec%done(1)%implicit) then
    ! Implicit loops
    if (sic_narg(0).ne.argfirst) then
      error = .true.
      call sic_message(seve%e,rname,'Trailing arguments in assignment')
      return
    endif
    !
    if (var%desc%type.eq.fmt_r8 .or.  &
        var%desc%type.eq.fmt_i8 .or.  &
        var%desc%type.eq.fmt_c4) then
      size = var%desc%size/2
    else
      size = var%desc%size
    endif
    !
    ! Allocate and fill implicit variables
    do i=1,spec%done(1)%ndim
      if (impvars(i).eq.0)  cycle  ! No variable defined (unnamed dimension)
      !
      j = var%desc%ndim-spec%done(1)%ndim+i  ! The dimension
      kn = impvars(i)
      ! Automatic integer kind. Integers are prefered rather than 'SIC PRECISION'
      ! reals, since REAL*4 give approximate results beyond 16777216, and REAL*8
      ! use too much memory most of the time. In order to save memory, use long
      ! integers only when needed.
      if (var%desc%dims(j).le.maxi4) then
        dicvar(kn)%desc%type = fmt_i4
        dicvar(kn)%desc%size = size
      else
        dicvar(kn)%desc%type = fmt_i8
        dicvar(kn)%desc%size = size*2
      endif
      ier = sic_getvm (dicvar(kn)%desc%size,dicvar(kn)%desc%addr)
      if (ier.ne.1) then
        call sic_message(seve%e,rname,'Could not allocate memory for implicit variables')
        error = .true.
        return
      endif
      ipnt = gag_pointer(dicvar(kn)%desc%addr,memory)
      if (dicvar(kn)%desc%type.eq.fmt_i4) then
        call i4_index (j,memory(ipnt),var%desc%dims)
      else
        call i8_index (j,memory(ipnt),var%desc%dims)
      endif
      dicvar(kn)%desc%readonly = .false.
      dicvar(kn)%desc%ndim     = var%desc%ndim
      dicvar(kn)%desc%dims(:)  = var%desc%dims(:)
      dicvar(kn)%desc%status   = user_defined    !
    enddo
    spec%done(1)%ndim = 0    ! To ask for a full copy (no sub-array)
  endif  ! Of implicit variables...
  !
  ldesc%size = 0
  tdesc%size = 0
  !
  ! /WHERE option
  ! print *,'DO_WHERE ',do_where
  do_where = sic_present(optwhere,0)
  if (do_where) then
    !
    ! First, check the size of the desired result...
    vspec(1)%ndim = spec%done(1)%ndim
    vspec(2)%ndim = 0
    do i=1,spec%done(1)%ndim
      vspec(1)%dims(i,1) = spec%done(1)%dims(i,1)
      vspec(1)%dims(i,2) = spec%done(1)%dims(i,2)
    enddo
    do i=spec%done(1)%ndim+1,sic_maxdims
      vspec(1)%dims(i,1) = 0
      vspec(1)%dims(i,2) = 0
    enddo
    ! print *,'Calling EXTRACT_DESCR'
    ! Allow transposition:
    call extract_descr(ldesc,var%desc,vspec,var%id%name,.true.,0,error)
    ! print *,'Done'
    if (error) goto 98
    tsize  = ldesc%size
    tdesc%type = ldesc%type
    tdesc%readonly = ldesc%readonly
    if (ldesc%type.eq.fmt_r8 .or.  &
        ldesc%type.eq.fmt_i8 .or.  &
        ldesc%type.eq.fmt_c4) then
      lsize = ldesc%size/2
    else
      lsize = ldesc%size
    endif
    call sic_volatile(ldesc) ! If it was a transposition, free it ...
    !
    ! Get logical expression name
    ! print *,'Calling SIC_ST'
    call sic_st (line,optwhere,1,argum,ilen,.true.,error)
    ! print *,'Done'
    if (error) goto 98
    ! Get logical array descriptor
    found = .true.
    ! print *,'LET_AVAR, /WHERE'
    call sic_descriptor (argum(1:ilen),ldesc,found)  ! Checked
    if (found .and. lsize.eq.ldesc%size) then
      ! Found a variable of identical size
      if (ldesc%type.ne.fmt_l) then
        call sic_message(seve%e,'LET /WHERE','Variable is not a logical '//  &
        'array')
        error = .true.
        goto 98
      endif
    else
      ! Not a variable, or a variable of different size (this may be valid
      ! e.g. LET /WHERE YES). Try to evaluate a vectorized logical expression.
      ! lsize => desired size of result
      call sic_math_desc(argum,ilen,fmt_l,lsize,ldesc,error)
      if (error) then
        call sic_message(seve%e,'/WHERE','Invalid logical expression '//  &
          argum(1:ilen))
        ldesc%size = 0  ! Memory already freed by sic_math_desc, avoid double free
        goto 98
      endif
    endif
    !
    ! Get some memory for the temporary result
    ier = sic_getvm (tsize,tdesc%addr)
    if (ier.ne.1) then
      call sic_message(seve%e,rname,'Memory allocation failure')
      error = .true.
      goto 98
    endif
    tdesc%size = tsize
    tdesc%status = user_defined  ! Eh non, pas "SCRATCH"
  endif  ! Of /WHERE option
  !
  ! Get incarnation of variable: allow transposition in same format
  call extract_descr(rdesc,var%desc,spec%done,var%id%name,.true.,0,error)
  if (error) goto 98
  !
  ! Check for element per element assignment
  nletarg = sic_narg(0)
  by_one = .false.
  if (.not.spec%done(1)%implicit .or. rdesc%ndim.ne.0) then
    step = desc_nelem(rdesc)
    by_one = nletarg.eq.(step+argfirst-1)
    if (by_one.and.do_where) then
      if (step.gt.1) then
        call sic_message(seve%e,rname,'Cannot assign element per element '//  &
        'with /WHERE option')
        error = .true.
        goto 98
      else
        by_one = .false. ! Do not go through the element by element case if /WHERE is used
      endif
    elseif ((nletarg.ne.argfirst).and..not.by_one) then
      call sic_message(seve%e,rname,'Wrong number of arguments in assignment')
      error = .true.
      goto 98
    endif
  elseif (nletarg.ne.argfirst) then
    call sic_message(seve%e,rname,'Trailing arguments in assignment')
    error = .true.
    goto 98
  endif
  !
  ! If exact number of arguments
  if (by_one) then
    !
    ipnt = gag_pointer(rdesc%addr,memory)
    do jarg=argfirst,nletarg
      call sic_st (line,0,jarg,argum,ilen,.true.,error)
      if (rdesc%type.eq.fmt_l) then
        call sic_math_logi (argum,ilen,l,error)
        if (error) goto 98
        call l4tol4(l,memory(ipnt),1)
        ipnt = ipnt+1
      elseif (rdesc%type.eq.fmt_i4) then
        call sic_math_inte (argum,ilen,i4,error)
        if (error) goto 98
        call i4toi4(i4,memory(ipnt),1)
        ipnt = ipnt+1
      elseif (rdesc%type.eq.fmt_r4) then
        call sic_math_real (argum,ilen,r4,error)
        if (error) goto 98
        call r4tor4(r4,memory(ipnt),1)
        ipnt = ipnt+1
      elseif (rdesc%type.eq.fmt_r8) then
        call sic_math_dble (argum,ilen,r8,error)
        if (error) goto 98
        call r8tor8(r8,memory(ipnt),1)
        ipnt = ipnt+2
      elseif (rdesc%type.eq.fmt_i8) then
        call sic_math_long (argum,ilen,i8,error)
        if (error) goto 98
        call i8toi8(i8,memory(ipnt),1)
        ipnt = ipnt+2
      elseif (rdesc%type.eq.fmt_c4) then
        call sic_math_real (argum,ilen,r4,error)
        if (error) goto 98
        call r4toc4(r4,memory(ipnt),1)
        ipnt = ipnt+2
      else
        call sic_message(seve%e,rname,'Output type not supported (1)')
        error = .true.
        goto 98
      endif
    enddo
  else
    !
    ! General case, not an element by element assignment
    !            IF (SPEC%DONE(1)%IMPLICIT) THEN
    !
    ! Implicit loops: beware of not formatting the expression !...
    ! Note that B.Lazareff may still find a "bug" in the syntax
    ! in this way !...
    !
    !               ISTART = SIC_START(0,ARGFIRST)
    !               IF (LINE(ISTART:ISTART).EQ."'") THEN
    !                  IEND   = ISTART + SIC_LEN(0,ARGFIRST) - 1
    !                  IF (LINE(IEND:IEND).EQ."'") THEN
    !                     ISTART = ISTART+1
    !                     IEND = IEND-1
    !                     ARGUM  = LINE(ISTART:IEND)
    !                     ILEN = IEND-ISTART+1
    !                     Print *,'B Lazareff case ',ILEN,ARGUM(1:ILEN)
    !                  ELSE
    !                     CALL SIC_ST (LINE,0,ARGFIRST,ARGUM,ILEN,.TRUE.,ERROR)
    !                     IF (ERROR) GOTO 98
    !                  ENDIF
    !               ELSE
    !                  CALL SIC_ST (LINE,0,ARGFIRST,ARGUM,ILEN,.TRUE.,ERROR)
    !                  IF (ERROR) GOTO 98
    !               ENDIF
    !            ELSE
    ! Normal assignment: get the string
    !               CALL SIC_CH(LINE,0,ARGFIRST,ARGUM,ILEN,.TRUE.,ERROR)
    !               IF (ERROR) GOTO 98
    !            ENDIF
    ! Simple code: get the argument
    call sic_st (line,0,argfirst,argum,ilen,.true.,error)
    if (error) goto 98
    call sic_add_expr(argum,ilen,expres,ilen,error)
    if (error) goto 98
    !
    ! Scalar
    if (.not.spec%done(1)%implicit .and. rdesc%ndim.eq.0 .and. rdesc%type.ne.fmt_l) then
      simple = .not.do_where
      if (expres(1:1).lt.'0'.or.expres(1:1).gt.'9') then
        simple = .false.
      elseif (index(expres(2:ilen),'+').ne.0) then
        simple = .false.
      elseif (index(expres(2:ilen),'-').ne.0) then
        simple = .false.
      elseif (index(expres(2:ilen),'*').ne.0) then
        simple = .false.
      elseif (index(expres(2:ilen),'|').ne.0) then
        simple = .false.
      endif
      ! Try a plain real number
      if (simple) then
        read (expres(1:ilen),*,iostat=ier)  r8
        ! If this does not work, try a SIC expression
        if (ier.ne.0) then
          call sic_get_dble (expres(1:ilen),r8,error)
          if (error) then
            error = .false.
            simple = .false.
          endif
        endif
      endif
      ! Move result to target location
      if (simple) then
        ipnt = gag_pointer(rdesc%addr,memory)
        if (rdesc%type.eq.fmt_i4) then
          call r8toi4_fini(r8,memory(ipnt),1,error)
        elseif (rdesc%type.eq.fmt_r4) then
          call r8tor4(r8,memory(ipnt),1)
        elseif (rdesc%type.eq.fmt_r8) then
          call r8tor8(r8,memory(ipnt),1)
        elseif (rdesc%type.eq.fmt_i8) then
          call r8toi8_fini(r8,memory(ipnt),1,error)
        else
          call sic_message(seve%e,rname,'Output type not supported (2)')
          error = .true.
        endif
        if (error)  goto 98
      endif
    else
      simple = .false.
    endif
    !
    ! In the most general case, analyse arithmetic expression
    if (.not.simple) then
      call build_tree(expres(1:ilen),ilen,operand,tree,last_node,max_level,  &
      min_level,error)
      if (error) then
        if (rdesc%type.eq.fmt_l) then
          mess = 'Invalid logical expression '//expres(1:ilen)
        else
          mess = 'Invalid arithmetic expression '//expres(1:ilen)
        endif
        call sic_message(seve%e,'DECODE',mess)
      else
        if (.not.do_where) then
          ! On peut y aller directement
          call evaluate_tree(operand,tree,last_node,max_level,min_level,  &
            rdesc,itype,error)
        else
          ! Il suffit de remplacer RDESC par la variable temporaire TDESC
          call evaluate_tree(operand,tree,last_node,max_level,min_level,  &
            tdesc,itype,error)
          ! Puis de remplir selon le masque LDESC
          call mask_fill(tdesc,rdesc,ldesc)
        endif
      endif
    endif
  endif
  !
  ! Descriptor can point to a copy if implicit transpose is used. Copy
  ! back to final location and free the memory
  if (rdesc%status.eq.scratch_operand) then
    call copy_back(rdesc,var%desc,spec%done(1)%ndim,  &
      spec%done(1)%dims(:,:),var%id%name,error)
    if (error) goto 98
  endif
  !
98 continue
  !
  call sic_volatile(rdesc)
  !
  if (tdesc%size.ne.0) call free_vm (tdesc%size,tdesc%addr)
  if (ldesc%status.eq.scratch_operand) then
    if (ldesc%size.ne.0) then
      call free_vm (ldesc%size,ldesc%addr)
      ldesc%size = 0
      ldesc%status = empty_operand
    endif
  endif
  !
end subroutine let_avar_numeric
!
subroutine let_avar_character(line,var,spec,argfirst,error)
  use gbl_message
  use sic_interfaces, except_this=>let_avar_character
  use sic_dictionaries
  use sic_types
  use let_options
  !---------------------------------------------------------------------
  ! @ private
  !  Support routine for LET (numeric or logical output variable)
  !---------------------------------------------------------------------
  character(len=*),       intent(in)    :: line      ! Input command line
  type(sic_variable_t),   intent(in)    :: var       ! Output variable
  type(sic_dimensions_t), intent(inout) :: spec      !
  integer(kind=4),        intent(in)    :: argfirst  !
  logical,                intent(inout) :: error     !
  ! Local
  character(len=*), parameter :: rname='LET'
  type(sic_descriptor_t) :: rdesc
  integer(kind=4) :: jarg,nc,nletarg
  character(len=commandline_length) :: local_line
  integer(kind=size_length) :: step,ielem
  integer(kind=address_length) :: addr
  logical :: by_one,do_where,do_format,do_upper,do_lower,do_noquote
  !
  do_where = sic_present(optwhere,0)
  do_format = sic_present(optformat,0)
  do_upper = sic_present(optupper,0)
  do_lower = sic_present(optlower,0)
  do_noquote = sic_present(optnoquote,0)
  !
  call extract_descr(rdesc,var%desc,spec%done,var%id%name,.true.,0,error)
  if (error) goto 98
  if (rdesc%ndim.eq.0 .and. .not.spec%done(1)%implicit) then
    if (do_noquote) then
      local_line = line(sic_start(0,argfirst):sic_end(0,sic_narg(0)))
    else
      call sic_ch (line,0,argfirst,local_line,nc,.true.,error)
    endif
    if (error) goto 98
    if (do_upper) then
      call sic_upper(local_line)
    elseif (do_lower) then
      call sic_lower(local_line)
    elseif (do_format) then
      call sic_letformat(line,argfirst,local_line,error)
    endif
    call ctodes(local_line,rdesc%type,rdesc%addr)
  else
    !
    ! Check for element per element assignment
    nletarg = sic_narg(0)
    by_one = .false.
    if (.not.spec%done(1)%implicit .or. rdesc%ndim.ne.0) then
      step = desc_nelem(rdesc)
      by_one = nletarg.eq.(step+argfirst-1)
      if (by_one.and.do_where) then
        if (step.gt.1) then ! If not scalar too
          call sic_message(seve%e,rname,'Cannot assign element per '//  &
          'element with /WHERE option')
          error = .true.
          goto 98
        else
          by_one = .false.  ! Use array assignement, even though it is just one scalar
        endif
      elseif ((nletarg.ne.argfirst).and..not.by_one) then
        call sic_message(seve%e,rname,'Wrong number of arguments in assignment')
        error = .true.
        goto 98
      endif
    elseif (nletarg.ne.argfirst) then
      call sic_message(seve%e,rname,'Trailing arguments in assignment')
      error = .true.
      goto 98
    endif
    !
    if (by_one) then
      addr = rdesc%addr
      do jarg=argfirst,nletarg
        call sic_ch (line,0,jarg,local_line,nc,.true.,error)
        if (error) goto 98
        if (do_upper) then
          call sic_upper(local_line)
        elseif (do_lower) then
          call sic_lower(local_line)
        elseif (do_format) then
          call sic_letformat(line,jarg,local_line,error)
        endif
        call ctodes(local_line,rdesc%type,addr)
        ! Increment the address
        addr = addr+rdesc%type
      enddo
    else
      call sic_ch(line,0,argfirst,local_line,nc,.true.,error)
      if (error) goto 98
      if (do_upper) then
        call sic_upper(local_line)
      elseif (do_lower) then
        call sic_lower(local_line)
      elseif (do_format) then
        call sic_letformat(line,argfirst,local_line,error)
      endif
      addr = rdesc%addr
      do ielem=1,desc_nelem(rdesc)
        call ctodes(local_line,rdesc%type,addr)
        addr = addr+rdesc%type
      enddo
    endif
  endif
  !
  ! Descriptor can point to a copy if implicit transpose is used. Copy
  ! back to final location and free the memory
  if (rdesc%status.eq.scratch_operand) then
    ! e.g. define char*4 a[2,2]; let a[1,] "AA" "BB"
    call copy_back(rdesc,var%desc,spec%done(1)%ndim,  &
      spec%done(1)%dims(:,:),var%id%name,error)
    if (error) goto 98
  endif
  !
98 continue
  call sic_volatile(rdesc)
  !
end subroutine let_avar_character
!
subroutine let_new(line,varname,new_type,error)
  use gbl_format
  use gbl_message
  use sic_interfaces, except_this=>let_new
  use sic_dictionaries
  use sic_interactions
  use let_options
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !  LET Var Arg1 ... ArgN /NEW Type [GLOBAL|LOCAL]
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line      !
  character(len=*), intent(inout) :: varname   ! Variable name
  character(len=*), intent(out)   :: new_type  !
  logical,          intent(inout) :: error     !
  ! Local
  character(len=*), parameter :: rname='LET'
  integer(kind=4), parameter :: nwhat=5
  character(len=12) :: what(nwhat),keyw,atype
  character(len=32) :: type
  integer(kind=4) :: dtype(nwhat),i,j,k,nc,ntype
  logical :: global
  character(len=8) :: attr
  ! Data. NB: INTEGER kind is ruled by SIC INTEGER SHORT|LONG
  data what /'REAL','DOUBLE','INTEGER','LOGICAL','CHARACTER'/
  data dtype /fmt_r4,fmt_r8,fmt_i4,fmt_l,0/
  !
  ! GLOBAL or LOCAL?
  attr = 'LOCAL'
  call sic_ke (line,optnew,2,attr,nc,.false.,error)
  if (error) return
  if (attr.eq.'GLOBAL') then
    global = .true.
  elseif (attr.ne.'LOCAL') then
    call sic_message(seve%e,rname,'Invalid attribute '//attr)
    error = .true.
    return
  else
    global = (var_level.le.0)
  endif
  !
  ! Get variable type
  call sic_ke(line,optnew,1,type,nc,.true.,error)
  if (error) return
  ! A little trick to support
  !   LET CHAIN*length " " /NEW CHAR
  ! and
  !   LET CHAIN " " /NEW CHAR*length
  i = index(type,'*')
  if (i.ne.0) then
    j = index(varname,'*')
    if (j.eq.0) then
      ! There is no *length specification in the variable name: add it
      k = index(varname,'[')
      if (k.eq.0) then
        ! There is no [N] array specification in the variable name: add the
        ! length as suffix
        j = len_trim(varname)+1
        varname(j:) = type(i:)
      else
        ! There is a [N] array specification in the variable name, e.g.
        !   let toto[2] "QWE" "RTY" /new char*12
        ! => insert the length at correct position
        varname(k:) = trim(type(i:))//varname(k:)
      endif
    endif
    atype = type(1:i-1)
  else
    atype = type
  endif
  !
  call sic_ambigs('DEFINE',atype,keyw,ntype,what,nwhat,error)
  if (error) return
  !
  new_type = trim(keyw)//' '//attr
  !
  ! Verify the CHAR*length issue
  if (i.ne.0) then
    if (ntype.ne.5) then
      call sic_message(seve%e,rname,'Invalid keyword '//type)
      error = .true.
      return
    endif
  endif
  !
  ! Set up the INTEGER kind (as this is a variable this can not be
  ! set at compilation time).
  dtype(3) = sicinteger
  !
  ! Define the new variable
  call sic_defvariable(dtype(ntype),varname,global,error)
  if (error) return
  !
  ! Strip off dimension and character specifications, if any
  if (ntype.eq.5) then
    i = index(varname,'*')
    if (i.gt.0)  varname(i:) = ' '
  endif
  i = index(varname,'[')
  if (i.gt.0)  varname(i:) = ' '

end subroutine let_new
!
subroutine let_replace(line,varout,error)
  use gildas_def
  use gbl_message
  use sic_interfaces, except_this=>let_replace
  use let_options
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !   LET NewName [=] OldName /REPLACE
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line
  character(len=*), intent(in)    :: varout
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='LET'
  character(len=varname_length) :: varin
  integer(kind=4) :: iopt,nin
  !
  ! Sanity check
  do iopt=1,mopt
    if (iopt.ne.optreplace) then
      if (sic_present(iopt,0)) then
        call sic_message(seve%e,rname,  &
          'Option '//trim(optnames(iopt))//' conflicts with /REPLACE')
        error = .true.
        return
      endif
    endif
  enddo
  !
  ! Get old variable name
  call sic_ke(line,0,2,varin,nin,.true.,error)
  if (error)  return
  if (varin(1:nin).eq.'=') then
    call sic_ke(line,0,3,varin,nin,.true.,error)
    if (error)  return
  endif
  !
  call rename_variable(varin,varout,error)
  if (error)  return
  !
end subroutine let_replace
!
subroutine let_status(line,error)
  use gildas_def
  use gbl_message
  use sic_interfaces, except_this=>let_status
  use let_options
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !   LET Variable /STATUS READ|WRITE
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='LET'
  integer(kind=4) :: iopt,ntype
  character(len=12) :: keyw,ctype
  integer(kind=4), parameter :: nwhat=2
  character(len=6), parameter :: what(nwhat) = (/ 'READ  ','WRITE ' /)
  !
  character(len=varname_length) :: cvar
  integer :: i, nvar
  logical :: rdonly
  !
  ! Sanity check
  do iopt=1,mopt
    if (iopt.ne.optstatus) then
      if (sic_present(iopt,0)) then
        call sic_message(seve%e,rname,  &
          'Option '//trim(optnames(iopt))//' conflicts with /STATUS')
        error = .true.
        return
      endif
    endif
  enddo
  !
  ! Get keyword
  call sic_ke (line,optstatus,1,ctype,ntype,.true.,error)
  if (error) return
  call sic_ambigs('LET /STATUS',ctype,keyw,ntype,what,nwhat,error)
  if (error) return
  !
  rdonly = ntype.eq.1  ! Make it READ or WRITE
  do i=1,sic_narg(0)
    call sic_ke(line,0,i,cvar,nvar,.true.,error)
    if (error) return
    call sic_changevariable(cvar,rdonly,error)    
    if (error) return
  enddo
  !
end subroutine let_status
!
subroutine let_resize(in,var,firstarg,error)
  use gbl_message
  use sic_interfaces, except_this=>let_resize
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! @ private
  ! Support subroutine for command
  !  LET Var [=] Arg1 ... ArgN /RESIZE
  !---------------------------------------------------------------------
  integer(kind=4),        intent(inout) :: in        ! Variable index (updated in return)
  type(sic_identifier_t), intent(inout) :: var       ! Variable identifier
  integer(kind=4),        intent(in)    :: firstarg  ! Position of Arg1 in command line
  logical,                intent(inout) :: error     ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='LET'
  character(len=message_length) :: chain
  integer(kind=4) :: ier,nelements,vartype
  character(len=varname_length) :: newname
  !
  ! Sanity check
  if (dicvar(in)%desc%status.eq.program_defined) then
    call sic_message(seve%e,rname,'Program defined variables cannot be resized')
    error = .true.
    return
  endif
  if (dicvar(in)%desc%ndim.ne.1) then
    call sic_message(seve%e,rname,'Only Rank-1 arrays can be resized')
    error = .true.
    return
  endif
  !
  nelements = sic_narg(0)-firstarg+1
  !
  if (nelements.eq.dicvar(in)%desc%dims(1)) return  ! Nothing to do
  !
  ! Feedback
  write(chain,'(3A,I0)')  'Resizing array ',trim(var%name),' to length ',nelements
  call sic_message(seve%w,rname,chain)
  !
  ! Keep memory of some elements before deletion from dictionary
  vartype = dicvar(in)%desc%type
  !
  ! Delete the variable
  call sic_delvariable(var%name,.true.,error)
  if (error)  return
  !
  ! Re-define the variable with new size
  write(newname,'(A,A,I0,A)') trim(var%name),'[',nelements,']'
  call sic_defvariable(vartype,newname,var%level.eq.0,error)
  if (error)  return
  !
  ! Re-locate the variable
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  if (ier.ne.1) then
    call sic_message(seve%w,rname,'Error relocating the array during /RESIZE')
    error = .true.
    return
  endif
  !
end subroutine let_resize
!
subroutine let_xwindow(line,nameout,iout,i_command,error)
  use gbl_format
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>let_xwindow
  use sic_dictionaries
  use sic_interactions
  use let_options
  !---------------------------------------------------------------------
  ! @ private
  !  Update the variable value seen in the widget, when this value is
  ! changed from the command line, e.g.
  !   @ gag_demo:demo-widget
  !   exa demo%widget%main%winteger      ! returns 123
  !   let demo%widget%main%winteger 456  ! value in the widget turns to 456
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line       ! Input command line
  character(len=*), intent(in)    :: nameout    ! Output variable (name)
  integer(kind=4),  intent(in)    :: iout       ! Output variable (index in dicvar)
  integer(kind=4),  intent(out)   :: i_command  !
  logical,          intent(inout) :: error      ! Logical error flag
  ! Local
  integer(kind=4) :: i,nar,na,ist
  logical :: ok,formula
  character(len=1024) :: expres,argum
  !
  i_command = 0
  i = 1
  formula = sic_present(optformula,0)
  ok = .true.
  do while (ok)
    if (x_number(i).eq.iout) then
      ! Defer update for sliders and logicals
      if (dicvar(iout)%desc%type.eq.fmt_l) then
        i_command = i
        ok = .false.
        ! Sliders
      elseif (x_vtypes(i).gt.(slider_offset-100)) then
        i_command = i
        ok = .false.
      elseif (.not.formula) then
        i_command = i
        ok = .false.
      else
        ! Immediate update for other variables
        ! Beware: not obvious for upper / lower case...
        nar = sic_narg(0)
        ist = 1
        if (dicvar(iout)%desc%type.gt.0) then
          ! Character variables: format completely
          do i=2,nar
            call sic_ch (line,0,i,argum,na,.true.,error)
            expres(ist:) = argum(1:na)
            ist = ist+na+1
          enddo
        else
          ! Other variables : only SIC_ST required ????
          do i=2,nar
            call sic_st (line,0,i,argum,na,.true.,error)
            expres(ist:) = argum
            ist = ist+len_trim(argum)+1
          enddo
        endif
        expres(ist:ist) = char(0)
        call xgag_update(nameout,expres)
        ok = .false.
      endif
    endif
    i = i+1
    if (i.gt.x_commands) ok = .false.
  enddo
  !
end subroutine let_xwindow
!
subroutine let_header(line,nameout,error)
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>let_header
  use sic_structures
  use sic_dictionaries
  use sic_interactions
  use sic_types
  use let_options
  !---------------------------------------------------------------------
  ! @ private
  !
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  character(len=*) :: nameout       !
  logical :: error                  !
  ! Local
  character(len=*), parameter :: rname='LET'
  type(sic_identifier_t) :: varin,varout
  integer(kind=4) :: nc,in,ou,ier
  logical :: linp,lout
  !
  nc = len_trim(nameout)-1  ! Drop the trailing '%'
  varout%name = nameout(1:nc)
  varout%lname = nc
  !
  ! Search first in local table
  varout%level = var_level
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,varout,ou)
  if (ier.ne.1 .and. var_level.ne.0) then
    varout%level = 0
    ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,varout,ou)
  endif
  if (ier.ne.1) then
    call sic_message(seve%e,rname,'No such header/structure '//nameout)
    error =.true.
    return
  endif
  !!Print *,'found output '//trim(varout%name)//' at ',ou,dicvar(ou)%desc%status
  !
  ! Check if it is a structure
  lout = dicvar(ou)%desc%status.le.0
  !
  ! Check whether it is readonly
  if (dicvar(ou)%desc%readonly) then
    call sic_message(seve%e,rname,'Readonly headers cannot be modified')
    error = .true.
    return
  endif
  !
  ! Input header now
  call sic_ke (line,0,2,varin%name,nc,.true.,error)
  if (error) return
  varin%lname = len_trim(varin%name)  ! Should it be nc?
  if (varin%name(varin%lname:varin%lname).eq.'%') then
    varin%name(varin%lname:varin%lname) = ' '
    varin%lname = varin%lname-1
  endif
  varin%level = var_level
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,varin,in)
  if (ier.ne.1 .and. var_level.ne.0) then
    varin%level = 0
    ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,varin,in)
  endif
  if (ier.ne.1) then
    call sic_message(seve%e,rname,'No such header '//varin%name)
    error =.true.
    return
  endif
  !!Print *,'found input '//trim(varin%name)//' at ',in,dicvar(in)%desc%status
  linp = dicvar(in)%desc%status.le.0
  !
  if (linp.or.lout) then
    call sic_message(seve%d,rname,'Doing my best to assign structures')
    call assign_structure(varin,varout,error)
  else
    ! Assign headers
    call let_copyheader(dicvar(in)%desc%head,dicvar(ou)%desc%head)
  endif
  !
end subroutine let_header
!
subroutine let_copyheader(in,out)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>let_copyheader
  use image_def
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: in
  type(gildas), intent(inout) :: out
  ! Local
  integer(kind=4) :: ndim
  integer(index_length) :: dims(gdf_maxdims),nvisi
  logical :: error
  !
  ! Dimensions must not be overwritten: save them
  ndim = out%gil%ndim
  dims(:) = 1
  dims(1:ndim) = out%gil%dim(1:ndim)
  ! Same for Nvisi (relevant only for UV tables)
  nvisi = out%gil%nvisi
  !
  error = .false.
  call gdf_copy_gil (in,out,error)
  out%char = in%char
  !
  ! Copy back protected elements
  out%gil%ndim = ndim
  out%gil%dim(:) = dims(:)
  out%gil%nvisi = nvisi
end subroutine let_copyheader
!
subroutine assign_structure(input,output,error)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>assign_structure
  use gildas_def
  use sic_structures
  use sic_dictionaries
  use sic_types
  use gbl_message
  use gbl_format
  !---------------------------------------------------------------------
  ! @ private
  !
  !---------------------------------------------------------------------
  type(sic_identifier_t) :: input         !
  type(sic_identifier_t) :: output        !
  logical                :: error         !
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='LET'
  integer(kind=address_length) :: ipi,ipl
  integer(kind=4) :: list(maxvar)
  integer(kind=4) :: idim,ldim,kdim
  integer(kind=4) :: i,j,l,ik,lk,in,nout,ninp
  integer(kind=size_length) :: size
  character(len=varname_length) :: ctype,dtype
  integer(kind=4) :: levout,levinp
  integer(kind=4) :: vti,vtl
  logical :: match,wrong_type,loose
  character(len=message_length) :: mess
  !
  loose = .false.
  levout = output%level
  nout = output%lname+1
  levinp = input%level
  ninp = input%lname+1
  input%name(ninp:ninp) = '%'
  output%name(nout:nout) = '%'
  !
  ! Loop on output variables
  call gag_haslis(maxvar,pfvar,pnvar,list,in)
  do i=1,in
    ik = list(i)
    ! Output match first...
    if (dicvar(ik)%id%level.eq.levout) then
      !
      ! If it is ReadOnly, do not change it...
      if (dicvar(ik)%desc%readonly)  cycle
      ctype = dicvar(ik)%id%name
      ! If variable is matched, get input variable
      if (output%name(1:nout).eq.ctype(1:nout)) then
        if (dicvar(ik)%desc%type.ne.0) then    ! If 0 means a structure
          do l=1,in
            lk = list(l)
            if (dicvar(lk)%id%level.eq.levinp) then
              dtype = dicvar(lk)%id%name
              if (input%name(1:ninp).eq.dtype(1:ninp)) then
                if (ctype(nout:).eq.dtype(ninp:)) then
                  match = .true.
                  idim = dicvar(ik)%desc%ndim
                  ldim = dicvar(lk)%desc%ndim
                  kdim = min(ldim,idim)
                  do j=1,kdim
                    if (dicvar(ik)%desc%dims(j).ne.dicvar(lk)%desc%dims(j)) then
                      match = .false.
                      write(mess,*) 'Dimension mismatch ',j
                      call sic_message(seve%w,rname,mess)
                    endif
                    !
                    ! Patch %convert size
                    if (j.eq.kdim) loose = .true.
                  enddo
                  if (idim.ne.ldim) then
                    match = .false.
                    write(mess,*) 'Shape mismatch ',idim,ldim
                    call sic_message(seve%w,rname,mess)
                  endif
                  !
                  ! Type Match can be made more generous
                  vti = dicvar(ik)%desc%type
                  vtl = dicvar(lk)%desc%type
                  if (vti.ne.vtl) then
                    if (vti.gt.0 .and. vtl.lt.0) then
                      wrong_type = .true.
                    elseif  (vti.eq.fmt_l) then
                      wrong_type = .true.
                    elseif  (vti.eq.fmt_i4) then
                      wrong_type = .true.
                      ! For real, apply automatic conversion
                    elseif ((vti.eq.fmt_r4.and.vtl.eq.fmt_r8) .or.  &
                            (vti.eq.fmt_r8.and.vtl.eq.fmt_r4) ) then
                      wrong_type = .false.
                    else
                      wrong_type = .true.
                    endif
                    if (wrong_type) then
                      match = .false.
                      write(mess,*) 'Type mismatch',vti,vtl
                      call sic_message(seve%w,rname,mess)
                    endif
                  else
                    wrong_type = .false.
                  endif
                  !
                  ! Make the assignment now
                  if (match) then
                    ! call gagout('let '//trim(ctype)//' '//trim(dtype)
                    ipi = gag_pointer(dicvar(ik)%desc%addr,memory)
                    ipl = gag_pointer(dicvar(lk)%desc%addr,memory)
                    if (vti.eq.vtl) then
                      size = dicvar(ik)%desc%size
                      call w4tow4_sl(memory(ipl),memory(ipi),size)
                    else
                      if (vti.eq.fmt_r4) then
                        size = dicvar(ik)%desc%size
                        call r8tor4_sl(memory(ipl),memory(ipi),size)
                      elseif  (vtl.eq.fmt_r4) then
                        size = dicvar(lk)%desc%size
                        call r4tor8_sl(memory(ipl),memory(ipi),size)
                      else
                        write(mess,*) 'Strange case ',vti,vtl
                        call sic_message(seve%w,rname,mess)
                      endif
                    endif
                  else if (loose) then
                    ! call gagout('let '//trim(ctype)//' '//trim(dtype)
                    ipi = gag_pointer(dicvar(ik)%desc%addr,memory)
                    ipl = gag_pointer(dicvar(lk)%desc%addr,memory)
                    if (vti.eq.vtl) then
                      size = min(dicvar(ik)%desc%size,dicvar(lk)%desc%size)
                      call w4tow4_sl(memory(ipl),memory(ipi),size)
                    else
                      if (vti.eq.fmt_r4) then
                        size = min(dicvar(ik)%desc%size,dicvar(lk)%desc%size/2)
                        call r8tor4_sl(memory(ipl),memory(ipi),size)
                      elseif  (vtl.eq.fmt_r4) then
                        size = min(dicvar(ik)%desc%size/2,dicvar(lk)%desc%size)
                        call r4tor8_sl(memory(ipl),memory(ipi),size)
                      else
                        write(mess,*) 'Strange case ',vti,vtl
                        call sic_message(seve%w,rname,mess)
                      endif
                    endif
                  else
                    call sic_message(seve%w,rname,'Mismatch between '//  &
                    trim(ctype)//' '//trim(dtype))
                  endif
                endif
              endif
            endif
          enddo
          ! else
          !   call gagout('W-LET, Ignoring sub-structure '//ctype)
        endif
      endif
    endif
  enddo
end subroutine assign_structure
!
subroutine sic_letformat (line,iarg,argum,error)
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_letformat
  use sic_types
  use let_options
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  character(len=*)                :: line   !
  integer(kind=4)                 :: iarg   !
  character(len=*)                :: argum  !
  logical,          intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='LET'
  type(sic_descriptor_t) :: ldesc
  integer(kind=4) :: nchar,n,i,ier,is,il
  real(kind=8) :: r
  character(len=80) :: chain
  character(len=1) :: f_type
  logical :: ok,found
  !
#if defined(IFORT)
  character(len=len(argum)) :: tmparg
#endif
  !
  call sic_ch (line,optformat,1,chain(2:),nchar,.true.,error)
  if (error) return
  chain(1:1) =  '('
  ! append a "?" to get the true length even with empty char variables.
  chain(nchar+2:nchar+4) = ',A)'
  nchar = nchar+4
  ok = .true.
  i = 2
  f_type = 'R'
  do while (ok)
    if (sic_eqchain(chain(i:i),'A')) then
      f_type = 'C'
      ok = .false.
    elseif  (sic_eqchain(chain(i:i),'I')) then
      f_type = 'I'
      ok = .false.
    elseif  (sic_eqchain(chain(i:i),'F')) then
      f_type = 'R'
      ok = .false.
    elseif  (sic_eqchain(chain(i:i),'G')) then
      f_type = 'R'
      ok = .false.
    elseif  (sic_eqchain(chain(i:i),'E')) then
      f_type = 'R'
      ok = .false.
    elseif  (sic_eqchain(chain(i:i),'D')) then
      f_type = 'R'
      ok = .false.
    endif
    if (i.lt.nchar) then
      i = i+1
    else
      ok = .false.
    endif
  enddo
  !
  if (f_type.eq.'C') then
    is = sic_start(0,iarg)
    il = sic_end(0,iarg)
    if (index(line(is:il),'"').eq.0) then
      found = .false.
      call sic_descriptor (argum,ldesc,found)  ! Checked
      if (found) call destoc(ldesc%type,ldesc%addr,argum)
    endif
    il = len(argum)
    ! "il-1" preserves 1 place for the "?" at the end, else we can have
    ! an overflow when writing argum+? into argum if the "A" format is
    ! larger than len(argum) ("A" means also everything).
    !
#if defined(IFORT)
      ! Re-Write in place is not allowed on IFORT 
      ! It returns undocumented error 768 (last documented value is 759)
      tmparg = argum
      write(argum,trim(chain),iostat=ier)  tmparg(1:il-1),'?'    
#else
      write(argum,trim(chain),iostat=ier)  argum(1:il-1),'?'
#endif      
  else
    if (f_type.eq.'I') then
      call sic_i4 (line,0,iarg,n,.true.,error)
      if (.not.error) write(argum,chain(1:nchar),iostat=ier) n,'?'
    else
      call sic_r8 (line,0,iarg,r,.true.,error)
      if (.not.error) write(argum,chain(1:nchar),iostat=ier) r,'?'
    endif
    if (error) then
      call sic_message(seve%e,rname,'Format / Variable type mismatch')
      return
    endif
  endif
  if (ier.ne.0) then
    call putios('E-LET,  ',ier)
    call sic_message(seve%e,rname,'Error executing LET /FORMAT')
    error = .true.
    return
  endif
  nchar = len_trim(argum)         ! drop the "?"
  argum(nchar:nchar) = ' '
end subroutine sic_letformat
!
subroutine let_avar_sexag(line,var,spec,error)
  use gildas_def
  use gbl_format
  use phys_const
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>let_avar_sexag
  use sic_types
  use let_options
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command LET Out [=] In /SEXA [D|H|R] [D|H|R]
  ! In and Out may be Numeric and String or vice-versa.
  !---------------------------------------------------------------------
  character(len=*),       intent(in)    :: line   ! Input command line
  type(sic_variable_t),   intent(in)    :: var    ! Output variable
  type(sic_dimensions_t), intent(inout) :: spec   !
  logical,                intent(inout) :: error  ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='LET'
  character(len=1024) :: local_line
  type(sic_descriptor_t) :: rdesc
  integer(kind=4) :: nc,ndiv
  real(kind=8) :: value
  integer(kind=address_length) :: ipnt
  character(len=12) :: argum
  character(len=1) :: unit_in,unit_out
  integer(kind=4), parameter :: nunits=3
  character(len=1), parameter :: units(nunits)=(/'D','H','R'/)
  !
  ! Incarnation not allowed, sic_volatile not needed
  call extract_descr(rdesc,var%desc,spec%done,var%id%name,.false.,0,error)
  if (error)  return
  !
  ! Reject unsupported cases
  if (spec%done(1)%implicit .or. rdesc%ndim.ne.0) then
    call sic_message(seve%e,rname,'Sexagesimal mode only valid for '//  &
    'scalar variables')
    error = .true.
    return
  endif
  !
  ! Check if in/out units are present
  argum = 'D'  ! Degrees for input by default
  call sic_ch(line,optsexage,1,argum,nc,.false.,error)
  if (error) return
  call sic_upper(argum)
  call sic_ambigs(rname,argum(1:1),unit_out,nc,units,nunits,error)
  if (error) return
  !
  argum = 'D'  ! Degrees for output by default
  call sic_ch(line,optsexage,2,argum,nc,.false.,error)
  if (error) return
  call sic_upper(argum)
  call sic_ambigs(rname,argum(1:1),unit_in,nc,units,nunits,error)
  if (error) return
  !
  if (rdesc%type.eq.fmt_i4 .or.  &
      rdesc%type.eq.fmt_i8 .or.  &
      rdesc%type.eq.fmt_r4 .or.  &
      rdesc%type.eq.fmt_r8) then
    ! Output is numeric
    call sic_ch (line,0,2,local_line,nc,.true.,error)
    if (error) return
    !
    if (local_line(1:nc).eq.'=') then
      ! Syntax used was: [LET] OUT = IN /SEXA
      call sic_ch (line,0,3,local_line,nc,.true.,error)
      if (error) return
    endif
    !
    call sic_sexa(local_line,nc,value,error)
    if (error) return
    !
    ! Convert input value to degrees
    select case (unit_in)
    case('D')
      continue
    case('H')
      value = value*15.d0
    case('R')
      call sic_message(seve%e,rname,  &
        'Illegal Radian unit for input sexagesimal string')
      error = .true.
      return
    end select
    !
    ! Convert input degrees to output value
    select case (unit_out)
    case('D')
      continue
    case('H')
      value = value/15.d0
    case('R')
      value = value*pi/180.d0
    end select
    !
    ipnt = gag_pointer(rdesc%addr,memory)
    if (rdesc%type.eq.fmt_i4) then
      call r8toi4(value,memory(ipnt),1)
    elseif (rdesc%type.eq.fmt_r4) then
      call r8tor4(value,memory(ipnt),1)
    elseif (rdesc%type.eq.fmt_r8) then
      call r8tor8(value,memory(ipnt),1)
    elseif (rdesc%type.eq.fmt_i8) then
      call r8toi8(value,memory(ipnt),1)
    endif
    !
  elseif (rdesc%type.gt.0) then
    ! Output is character string
    call sic_r8(line,0,2,value,.true.,error)
    if (error) return
    !
    ! Convert input value to radians ('sexag' expects angles in radians).
    select case (unit_in)
    case('D')
      value = value*pi/180.d0
    case('H')
      value = value*pi/12.d0
    case('R')
      continue
    end select
    !
    ! Select the number of divisions per turn for the output string
    select case (unit_out)
    case('D')
      ndiv = 360
    case('H')
      ndiv = 24
    case('R')
      call sic_message(seve%e,rname,  &
        'Illegal Radian unit for output sexagesimal string')
      error = .true.
      return
    end select
    !
    ! Compute the string
    call rad2sexa(value,ndiv,local_line(1:rdesc%type))
    if (error) return
    !
    ipnt = gag_pointer(rdesc%addr,memory)
    nc=min(len(local_line),rdesc%type)
    call bytoby(local_line,memory(ipnt),nc)
    !
  else
    ! Trap remaining unsupported cases (e.g. logical)
    call sic_message(seve%e,rname,  &
      'Unsupported output type in sexagesimal mode')
    error = .true.
    return
  endif
  !
end subroutine let_avar_sexag
