subroutine iniloo (line,nline,error)
  use sic_structures
  use sic_dictionaries
  use sic_interfaces, except_this=>iniloo
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! SIC   Internal routine
  !       Support for command
  !               FOR Variable n1 TO n2 ....
  !       or      FOR Variable /IN List_Variable_1D
  !       or      FOR /WHILE Logical_Expression
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: line   ! Command line
  integer(kind=4),  intent(in)  :: nline  ! Line length
  logical,          intent(out) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='FOR'
  integer(kind=4), parameter :: optwhile=2
  integer(kind=4), parameter :: optin=1
  integer(kind=4) :: istart
  character(len=message_length) :: mess
  !
  error=.false.
  !
  if (compil) then
    ! Compilation of a new nested FOR command, increment the buffer level
    if (aloop.ge.mcloop) then
      write(mess,101) mcloop
      call sic_message(seve%e,rname,mess)
      error=.true.
      return
    endif
    lasllo(cloop) = loolen
    lasblo(cloop) = bulend
    ! Encode loop number after command line
    call insloo(line,nline,error)
    if (error) return          ! No more room for loop command.
    loobuf (bulend-1) = aloop+1
    ! Check syntax
    if (sic_present(optwhile,0)) then  ! FOR /WHILE
      ! Can not check: since this FOR /WHILE is nested in another FOR loop,
      ! its logical expression may involve variables not yet defined. No
      ! worry, the expression will be checked at execution time.
      ! call check_loop_logical(aloop+1,line,error)
    elseif (sic_present(optin,0)) then   ! FOR /IN
      if (sic_narg(optin).ne.1) then
        call sic_message(seve%e,rname,'/IN option takes exactly 1 argument')
        error = .true.
      endif
    elseif (sic_present(0,2)) then  ! FOR I 1 TO 3
      call check_loop_variable(aloop+1,line,error)
    else
      call sic_message(seve%e,rname,'No variable or list')
    endif
    if (error) then            ! GD thinks this is very wise...
      ! loobuf(bulend-1) = unreference the new loop (useless since it is desinstalled hereafter)
      call desinsloo
      return
    endif
    aloop = aloop+1            ! Number of loops
    ploop(aloop) = cloop       ! Backward pointer to current loop
    cloop = aloop              ! Current loop
    firllo(cloop) = loolen
    firblo(cloop) = bulend
    !
  elseif (mlire(nlire).lt.-1) then
    ! Execution of a FOR command, dynamical interpretation,
    ! Get loop number from loop buffer
    cloop = loobuf(nloo-1)
    kloo(cloop)=0              ! Compteur de Boucles des indices
    if_loop_level (cloop) = if_current
    if (sic_present(optwhile,0)) then
      ! FOR /WHILE
      call check_loop_logical(cloop,line,error)
      if (error) goto 89
       !
    else if (sic_present(optin,0)) then
      ! FOR Variable /IN List_Variable
      call check_loop_variable(cloop,line,error)
      if (error) goto 89
      call begin_forin(cloop,error)
      if (error) goto 89
      !
    elseif (sic_present(0,2)) then
      ! FOR I Start [TO ...]
      istart = sic_start(0,2)-1
      call sic_parse_listr8(rname,line(istart:),loop_index(cloop),mloop,error)
      if (error) goto 89
      call check_loop_variable(cloop,line,error)
      if (error) goto 89
      loop_length(cloop) = 0
    else
      call sic_message(seve%e,rname,'No variable or list')
      goto 89
    endif
    !
  else
    ! First loop of a new level, compile the command line and set COMPIL
    if (aloop.ge.mcloop) then
      write(mess,101) mcloop
      call sic_message(seve%e,rname,mess)
      error=.true.
      return
    endif
    if (nlire.ge.maxlev-1) then
      error = .true.
      call sic_message(seve%e,rname,'Input level too deep')
      return
    endif
    if (sic_present(optwhile,0)) then
      call check_loop_logical(aloop+1,line,error)
      if (error) return
    elseif (sic_present(optin,0)) then
      call check_loop_variable(aloop+1,line,error)
      if (error) return
      call begin_forin(aloop+1,error)
      if (error) return
    elseif (sic_present(0,2)) then
      istart = sic_start(0,2)-1
      call sic_parse_listr8(rname,line(istart:),loop_index(aloop+1),mloop,error)
      if (error) return
      call check_loop_variable(aloop+1,line,error)
      if (error) return
      loop_length(aloop+1) = 0
    else
      call sic_message(seve%e,rname,'No variable or list')
      goto 89
    endif
    !
    ! OK...
    ifloop(nlire+1) = aloop
    curbyt(nlire+1) = nloo     ! Save Byte pointer
    curlin(nlire+1) = jloo     ! Save Line pointer
    aloop = aloop+1            ! Number of loops
    kloo(aloop) = 0
    compil  = .true.
    ploop(aloop) = cloop       ! Backward pointer to previous level
    cloop   = aloop            ! Current loop number
    firllo(cloop) = loolen
    firblo(cloop) = bulend
  endif
  return
  !
89 error = .true.
  if (nerr(var_level).eq.e_cont) then
    nloo  = lasblo(cloop)
    jloo  = lasllo(cloop)
    error = .false.
  endif
  if (lverif) then
    write(mess,102) cloop
    call sic_message(seve%i,rname,mess)
  endif
  loop_length(cloop) = 0
  cloop = ploop(cloop)
  return
  !
101 format('Only ',i2,' levels of FOR - NEXT loops')
102 format('Loop ',i2,' has finished')
end subroutine iniloo
!
subroutine insloo (line,nline,error)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>insloo
  use gildas_def
  use sic_structures
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! SIC
  !   Support for FOR command 
  !   Insert a command line into the current loop buffer
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   !
  integer(kind=4),  intent(in)    :: nline  !
  logical,          intent(inout) :: error  !
  !
  mlen = (nline+3)/4+3
  !
  ! Loop buffer full
  if (mlen+bulend.ge.looend) then
    call sic_message(seve%e,'FOR','Loop buffer overflow')
    error = .true.
    return
  endif
  loobuf(bulend) = nline
  loobuf(bulend+1) = locwrd(loobuf(bulend+2))
  call ctodes (line,nline,loobuf(bulend+1))
  bulend = bulend + mlen
  loolen = loolen + 1
  !
end subroutine insloo
!
subroutine desinsloo
  use sic_structures
  !---------------------------------------------------------------------
  ! @ private
  ! This if an error occurs, to be used immediately to forget erroneous
  ! line.
  !---------------------------------------------------------------------
  loolen = loolen - 1
  bulend = bulend - mlen
end subroutine desinsloo
!
subroutine exeloo (error)
  use gbl_format
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>exeloo
  use sic_structures
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! @ private
  ! SIC   Internal routine
  !       Execute a FOR - NEXT loop : activated by a NEXT command
  !---------------------------------------------------------------------
  logical, intent(out) :: error  !
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='FOR'
  logical :: logi
  character(len=loop_string_length) :: chain
  integer(kind=4) :: ls, lchoice, lout
  integer(kind=address_length) :: ipnt, opnt
  integer(kind=4) :: loopin, loopva, nstep
  !
  ! Retrieves next index value
  error = .false.
  !
  ! An IF level must be defined even for null loops, otherwise errors occur
  ! at close time if they contain a test.
  if_loop_level (cloop) = if_current
  loopin = loop_var(cloop)
  !!Print *,'EXELOO got loopin ',cloop,loopin
  !
  if (loopin.eq.0) then       ! No variable <==> a logical expression
    ! FOR /WHILE: evaluate the logical expression. See comment in check_loop_logical.
    call sic_shape(chain,loop_string(cloop),1,loop_length(cloop),ls,error)
    if (error)  return
    call sic_math_logi(chain,ls,logi,error)
    !
    ! Once more
    if (.not.error .and. logi) then
      nloo = firblo(cloop)     ! Reset Byte pointer
      jloo = firllo(cloop)     ! Reset Line pointer
      return
    endif
  else if (loopin.gt.0) then
    ! Simple FOR
    call list2(loop_index(cloop),kloo(cloop),indice(cloop),error)
    !
    ! Once more
    if (.not.error) then
      nloo = firblo(cloop)     ! Reset Byte pointer
      jloo = firllo(cloop)     ! Reset Line pointer
      if (lverif) then
        write(chain,101) cloop,indice(cloop)
        call sic_message(seve%i,rname,chain)
      endif
      return
    endif
  else
    ! FOR /IN List
    loop_curarg(cloop) = loop_curarg(cloop)+1
    if (loop_curarg(cloop).le.abs(loop_size(cloop))) then
      nloo = firblo(cloop)     ! Reset Byte pointer
      jloo = firllo(cloop)     ! Reset Line pointer
      !
      loopin = abs(loopin)
      loopva = abs(loop_list(cloop))
      lout = dicvar(loopin)%desc%type
      if (lout.gt.0) then
        ! Character strings
        lchoice = dicvar(loopva)%desc%type
        lout = min(lout,lchoice)  ! Probably not relevant...
        opnt = bytpnt(dicvar(loopin)%desc%addr,membyt)
        ipnt = bytpnt(dicvar(loopva)%desc%addr,membyt) &
          + (loop_curarg(cloop)-1)*lchoice
        call bytoby(membyt(ipnt),membyt(opnt),lout)
      else
        if (lout.eq.fmt_r8 .or.  &
            lout.eq.fmt_i8 .or.  &
            lout.eq.fmt_c4) then
          nstep = 2
        else
          nstep = 1
        endif
        opnt = gag_pointer(dicvar(loopin)%desc%addr,memory)
        ipnt = gag_pointer(dicvar(loopva)%desc%addr,memory) &
          + nstep*(loop_curarg(cloop)-1)
        call w4tow4(memory(ipnt),memory(opnt),nstep)
      endif
      if (lverif)  call exeloo_verif(ipnt,lout)
      return
    endif
  endif
  !
  ! End of loop
  error = .false.
  call finloo()
  !
101 format('Loop ',i0,' is running with index ',1pg24.17)
  !
contains
  subroutine exeloo_verif(ipnt,lout)
    integer(kind=address_length), intent(in) :: ipnt
    integer(kind=4),              intent(inout) :: lout
    ! Local
    character(len=loop_string_length) :: str
    integer(kind=4) :: i4val
    integer(kind=8) :: i8val
    real(kind=4) :: r4val
    real(kind=8) :: r8val
    !
    if (lout.gt.0) then
      call bytoch(membyt(ipnt),str,lout)
      lout = min(lout,loop_string_length-60) ! Avoid Format Overflow
      lout = min(lout,len_trim(str))         ! Avoid trailing spaces
      write(chain,102) cloop,str(1:lout)
    elseif (lout.eq.fmt_i8) then
      call i8toi8(memory(ipnt),i8val,1)
      write(chain,103) cloop,i8val
    else if (lout.eq.fmt_i4) then
      call i4toi4(memory(ipnt),i4val,1)
      write(chain,103) cloop,i4val
    else if (lout.eq.fmt_r8) then
      call r8tor8(memory(ipnt),r8val,1)
      write(chain,104) cloop,r8val
    else if (lout.eq.fmt_r4) then
      call r4tor4(memory(ipnt),r4val,1)
      write(chain,104) cloop,r4val
    endif
    call sic_message(seve%i,rname,chain)
102 format('Loop ',i0,' is running with argument "',A,'"')
103 format('Loop ',i0,' is running with argument [',I0,']')
104 format('Loop ',i0,' is running with argument [',1pg24.17,']')
  end subroutine exeloo_verif
  !
end subroutine exeloo
!
subroutine finloo
  use gbl_message
  use sic_interfaces, except_this=>finloo
  use sic_structures
  use sic_dictionaries
  !----------------------------------------------------------------------
  ! @ private
  ! End of a loop execution
  !----------------------------------------------------------------------
  ! Local
  character(len=*), parameter :: rname='FOR'
  character(len=message_length) :: mess
  integer(kind=4) :: i,lloop
  !
  ! End of a loop (QUIT or BREAK) : reset pointer
  nloo  = lasblo(cloop)
  jloo  = lasllo(cloop)
  !!Print *,'LOOP ',cloop,' Length ',loop_length(cloop),' List ',loop_list(cloop)
  if (loop_length(cloop).eq.0) then
    call delete_loop_variable(cloop)
  endif
  loop_list(cloop) = 0
  loop_size(cloop) = 0
  !
  ! Reset active IF_blocks
  do i=if_loop_level(cloop)+1,if_current
    if_active(i) = .false.
    if_elsefound(i) = .false.
    if_finished(i) = .true.
  enddo
  if_current = if_loop_level(cloop)
  if_last = if_current
  !
  indice(cloop) = 0.0
  kloo(cloop)  = 0
  if (lverif) then
    write(mess,102) cloop
    call sic_message(seve%i,rname,mess)
  endif
  loop_length(cloop) = 0
  lloop = cloop
  cloop = ploop(cloop)
  if (cloop.le.ifloop(nlire)) then
    aloop = ifloop(nlire)
    nloo = curbyt(nlire)       ! Restore Byte pointer
    jloo = curlin(nlire)       ! Save Line pointer
    bulend = firblo(lloop)
    loolen = firllo(lloop)
    nlire = nlire-1
  endif
  !
102 format('Loop ',i2,' has finished')
end subroutine finloo
!
subroutine aboloo
  use gbl_message
  use sic_interfaces, except_this=>aboloo
  use sic_structures
  !----------------------------------------------------------------------
  ! @ private
  ! Abort a loop compilation : decrease loop pointers and exit
  ! compilation mode if needed
  !----------------------------------------------------------------------
  ! Local
  character(len=*), parameter :: rname='FOR'
  character(len=message_length) :: mess
  integer(kind=4) :: lloop,i
  !
  write(mess,103) cloop
  call sic_message(seve%i,rname,mess)
  lloop = cloop
  do i=cloop,aloop
    if (loop_length(i).eq.0) then
      call delete_loop_variable(i)
    else
      loop_length(i) = 0
    endif
  enddo
  cloop = ploop(cloop)
  aloop = cloop
  !
  if (cloop.eq.0) then
    ! Exit compilation mode
    compil=.false.
    bulend = 1
    loolen = 0
  else
    ! Reset end of buffer pointers as for FINLOO
    loolen = firllo(lloop)
    bulend = firblo(lloop)
    if (aloop.eq.ifloop(nlire+1)) compil = .false.
  endif
  return
  !
103 format('Loop ',i2,' compilation aborted')
end subroutine aboloo
!
subroutine check_loop_variable(loop_number,line,error)
  use gildas_def
  use gbl_format
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>check_loop_variable
  use sic_structures
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! @ private
  !   Support for FOR command
  !   Check the non-existence of the loop variable specified in command
  ! FOR, and insert it in dictionary.
  !---------------------------------------------------------------------
  integer(kind=4),  intent(in)    :: loop_number  ! Loop number
  character(len=*), intent(in)    :: line         ! Command line
  logical,          intent(inout) :: error        ! Error flag
  ! Local
  character(len=*), parameter :: rname='VARIABLE'
  integer, parameter :: optin=1
  type(sic_identifier_t) :: var
  type(sic_identifier_t) :: list
  integer(kind=4) :: in,jn,ier
  !
  call sic_ke (line,0,1,var%name,in,.true.,error)
  if (error) return
  var%lname = len_trim(var%name)
  !
  var%level = var_level
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  if (ier.eq.1) then
    call sic_message(seve%e,rname,'Variable '//trim(var%name)//  &
    ' already exists')
    error = .true.
    return
  endif
  !
  if (sic_present(optin,0)) then
    if (sic_narg(optin).ne.1) then
      call sic_message(seve%e,rname,'/IN must have one argument')
      error = .true.
      return
    endif
    call sic_ke (line,optin,1,list%name,list%lname,.true.,error)
    if (error) return
    !
    list%level = var_level
    ! FOR Var /IN List  requires an existing List variable
    ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,list,jn)
    if (ier.ne.1) then
      list%level = 0
      ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,list,jn)
    endif
    if (ier.ne.1) then
      call sic_message(seve%e,rname,  &
        'Variable '//trim(list%name)//' does not exists')
      error = .true.
      return
    endif
    if (dicvar(jn)%desc%ndim.gt.1) then
      call sic_message(seve%e,rname,  &
        'Variable '//trim(list%name)//' must be scalar or rank 1')
      error = .true.
      return
    endif
    loop_list(loop_number) = jn
    loop_size(loop_number) = desc_nelem(dicvar(jn)%desc)
    !
    ! Create the loop variable, local to current level, same type as the
    ! list array
    call sic_defvariable(dicvar(jn)%desc%type,var%name,var_level.eq.0,error)
    if (error)  return
    !
    ! Locate it
    var%level = var_level
    ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
    loop_var(loop_number) = -in  ! Use sign to identify type of loop
    !
  else
    ! FOR Index Loop    must define its own (Real*8) variable
    ! Insert in variable dictionnary
    ier = sic_hasins(rname,maxvar,pfvar,pnvar,dicvar,var,in)
    if (ier.eq.0 .or. ier.eq.2) then
      error = .true.
      return
    endif
    !
    dicvar(in)%desc%addr = locwrd(indice(loop_number))
    dicvar(in)%desc%type = fmt_r8
    dicvar(in)%desc%readonly = .true.
    dicvar(in)%desc%ndim = 0
    dicvar(in)%desc%dims(:) = 1         ! Normally useless, but...
    dicvar(in)%desc%size = 2            ! Do not remove this one!!!
    dicvar(in)%desc%status = program_defined
    loop_var(loop_number) = in
  endif
  !
end subroutine check_loop_variable
!
subroutine delete_loop_variable(loop_number)
  use sic_interfaces, except_this=>delete_loop_variable
  use sic_dictionaries
  use sic_structures
  !---------------------------------------------------------------------
  ! @ private
  ! Delete loop variable
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: loop_number
  ! Local
  integer(kind=4) :: in,ier
  logical :: error
  !
  in = loop_var(loop_number)
  !
  if (in.gt.0) then  ! FOR I Start [TO ...]
    ! Delete loop variable from dictionary. Note that the associated
    ! memory was pointing to 'indice(loop_number)', which we never
    ! delete
    dicvar(in)%desc%status = empty_operand  ! Mandatory
    ier = sic_hasdel(maxvar,pfvar,pnvar,dicvar,dicvar(in)%id)
    !
  elseif (in.eq.0) then  ! FOR /WHILE
    ! WHILE loops do not define loop variables (nothing to delete here)
    continue
    !
  else  ! in.lt.0  FOR I /IN List
    ! Loop variable was defined with sic_defvariable, its own memory
    ! was allocated. Delete as any other standard variable, else we
    ! would miss some important cleaning (memory, var_pointer, ...)
    error = .false.
    call sic_delvariable(dicvar(-in)%id%name,user=.true.,error=error)
    if (error) return
    !
  endif
  !
  loop_var(loop_number) = 0
  !
end subroutine delete_loop_variable
!
subroutine verify_loop_variable(loop_number,line,error)
  use gildas_def
  use gbl_message
  use sic_interfaces, except_this=>verify_loop_variable
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! @ private
  !   Support for NEXT Variable
  !   Verify variable name match with the FOR command
  !---------------------------------------------------------------------
  integer(kind=4),  intent(in)    :: loop_number  !
  character(len=*), intent(in)    :: line         !
  logical,          intent(inout) :: error        !
  ! Local
  character(len=*), parameter :: rname='FOR'
  integer(kind=4) :: in,nc
  character(len=varname_length) :: varname
  !
  in = abs(loop_var(loop_number))
  if (in.eq.0) then
    call sic_message(seve%e,rname,'No variable for FOR /WHILE loops')
    error = .true.
    return
  endif
  !
  call sic_ke(line,0,1,varname,nc,.true.,error)
  if (error)  return
  !
  if (dicvar(in)%id%name.ne.varname(1:nc)) then
    call sic_message(seve%e,rname,'Wrong loop variable '// &
      varname(1:nc)//' expected '//dicvar(in)%id%name)
    error = .true.
    return
  endif
  !
end subroutine verify_loop_variable
!
subroutine check_loop_logical(loop_number,line,error)
  use sic_interfaces, except_this=>check_loop_logical
  use sic_structures
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !  Check that the expression specified in /WHILE option of FOR command
  ! is a valid logical expression.
  !---------------------------------------------------------------------
  integer(kind=4),  intent(in)    :: loop_number  !
  character(len=*), intent(in)    :: line         !
  logical,          intent(inout) :: error        !
  ! Local
  integer(kind=4), parameter :: optwhile=2
  integer(kind=4) :: is,ls
  logical :: logi
  character(len=loop_string_length) :: chain
  !
  ! 1) Retrieve the raw logical expression. No evaluation! For example with
  !     FOR /WHILE test['j+1']
  ! 'j+1' is not translated, it will be re-evaluated at each iteration.
  ls = sic_len(optwhile,1)
  if (ls.gt.loop_string_length) then
    call sic_message(seve%e,'FOR','Logical expression is too long')
    error = .true.
    return
  endif
  loop_length(loop_number) = ls
  is = sic_start(optwhile,1)
  loop_string(loop_number) =  line(is:is+ls-1)
  !
  ! 2) Check this is a valid logical expression
  call sic_shape(chain,loop_string(loop_number),1,loop_length(loop_number),ls,error)
  if (error)  return
  call sic_math_logi(chain,ls,logi,error)
  if (error)  return
  !
end subroutine check_loop_logical
!
subroutine begin_forin(loop_number,error)
  use sic_interfaces, except_this=>begin_forin
  use sic_structures
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command:
  !     FOR Var /IN List
  !---------------------------------------------------------------------
  integer(kind=4),  intent(in)    :: loop_number  ! Current loop number
  logical,          intent(inout) :: error        ! Error flag
  !
  ! Identify loop variable
  loop_curarg(loop_number) = 0
  !
end subroutine begin_forin
