subroutine sicset(line,lire,error)
  use gildas_def
  use gbl_format
  use gbl_message
  use gsys_types
  use sic_dependencies_interfaces
  use sic_structures
  use sic_dictionaries
  use sic_interactions
  use sic_interfaces, except_this=>sicset
  !---------------------------------------------------------------------
  ! @ private
  !  SIC Internal routine
  ! Modifies the current status of SIC monitor:
  !     MEMORY       Switch
  !     VERIFY       Switch
  !     EDIT         Status or Editor
  !     HELP         Status
  !     PRECISION    Default mathematic precision
  !     DIRECTORY    Working directory
  !     EXTENSION    Default macro extension
  !     OUTPUT       Output file name
  !     DATE         Current date
  !     USER         Current user
  !     SEARCH       Search for file existence
  !     LOGICAL      Logical name translation
  !     BEEP n       Beep n times
  !     SYNTAX       Select Free/Fixed syntax for assignment
  !     VERSION      Give the program version...
  !     WAIT         Wait n seconds
  !     WINDOW       Activate / de-activate the Window mode
  !     MACRO        Procedure search path
  !     APPEND       Append Small_file Appended_file
  !     SAVE         File Command : Save all variable in File with Command
  !     CPU          Compute CPU time (for debugging purpose)
  !     FIND         Find list of files
  !     GREP         Grep a pattern from a file
  !     EXPAND       Expand command in a macro file
  !     PARSE File Name Ext Dir
  !     MESSAGE <Filters>  Alter on-screen and to-logfile verbosity
  !     FLUSH        Force flushing message and log files buffers onto disk
  !     WHICH Proc   Print full path of the Procedure which will be executed
  !     LOCK <FileName>  Create the lock-file, or exit if it exists
  !     HEADERS      GILDAS Header version
  !     INTEGER      Default SIC INTEGER kind (short or long)
  !     DELAY        Delay execution of next command
  !     SYSTEM       Switch: error from command SIC\SYSTEM should be ignored or not?
  !     TIMER        Set/Get the timer for automatic logout after inactivity
  !     MODIFIED     Set/get the modification status of a file
  !     RANDOM_SEED  (Re)set the Fortran random seed generator
  !     PARALLEL     Set the number of Open-MP threads
  !     <noarg>      Language in active scope
  !---------------------------------------------------------------------
  character(len=*), intent(inout) :: line   ! Command line
  integer(kind=4),  intent(in)    :: lire   ! Execution level
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='SIC'
  character(len=40) :: argum
  character(len=16) :: name,ext
  character(len=12) :: action
  character(len=filename_length) :: fich,file,filo
  integer(kind=4) :: j,n,kl,nc,ier,nact,nf,tmp
  integer(kind=4) :: khelp,krecs
  integer(kind=4) :: i,iext,ip,sev
  real(kind=4) :: t,rste
  character(len=8) :: keyw
  character(len=30) :: user,date
  character(len=message_length-30) :: chain
  logical :: found,logi,fourt_status(2)
  character(len=1), parameter :: backslash=char(92)
  character(len=message_length) :: mess
  character(len=language_length) :: langs(mlang)
  ! Keyword lists
  integer(kind=4), parameter :: mact=46,nhelp=3,nrecs=5,ndebug=12,ninteg=2
  integer(kind=4), parameter :: nsystem=2
  character(len=5) :: psynt(2),pinteg(ninteg)
  character(len=6) :: precs(nrecs),phelp(nhelp),dictionary(3)
  character(len=7) :: system(nsystem)
  character(len=9) :: debug(ndebug)
  character(len=12) :: acts(mact)
  ! Data
  data acts /'APPEND','BEEP','COPY','CPU','DATE','DEBUG','DELAY','DELETE',   &
    'DIRECTORY','EDIT','ERROR','EXPAND','EXTENSION','FFT','FIND','FLUSH',    &
    'GREP','HEADERS','HELP','INTEGER','LOCK','LOGICAL','MACRO','MEMORY',     &
    'MESSAGE','MKDIR','MODIFIED','OUTPUT','PARALLEL','PARSE','PRECISION',    &
    'PRIORITY','RANDOM_SEED','RENAME','SAVE','SEARCH','SYNTAX','SYSTEM',     &
    'TIMER','USER','UVT_VERSION','VERIFY','VERSION','WAIT','WHICH',          &
    'WINDOW'/
  data precs/'SINGLE','REAL','DOUBLE','LONG','AUTO'/                    ! C*6
  data phelp/'SCROLL','PAGE','HTML'/                                    ! C*6
  data psynt/'FIXED','FREE'/                                            ! C*5
  data dictionary /'GLOBAL','LOCAL','USER'/                             ! C*6
  data debug /'LUN','IMAGE','MESSAGE','SHARED','GFORTRAN','RESOURCES',  &
              'PYTHON','VARIABLES','MEMALIGN','GIO_ALLOC','LOCALE',     &
              'SYSTEM'/                                                 ! C*9
  data pinteg /'SHORT','LONG'/                                          ! C*5
  data system /'ERROR','NOERROR'/                                       ! C*7
  !
  ! Code ----------------------------------------------------------------
  !
  ! No argument, List current status
  if (.not.sic_present(0,1)) then
    do j=1,nlang
      if (languages(j)%libmod) then
        write(mess,1005) 'Language '//trim(languages(j)%name)//backslash,  &
               'in LIBRARY ONLY'
      elseif (languages(j)%asleep) then
        write(mess,1005) 'Language '//trim(languages(j)%name)//backslash,'OFF'
      else
        write(mess,1005) 'Language '//trim(languages(j)%name)//backslash,'ON'
      endif
      call sic_message(seve%i,rname,mess)
    enddo
    !
    if (logbuf) then
      write(mess,1005) 'MEMORY switch','ON'
    else
      write(mess,1005) 'MEMORY switch','OFF'
    endif
    call sic_message(seve%i,rname,mess)
    !
    if (lverif) then
      write(mess,1005) 'VERIFY switch','ON'
    else
      write(mess,1005) 'VERIFY switch','OFF'
    endif
    call sic_message(seve%i,rname,mess)
    !
    if (edit_mode) then
      write(mess,1005) 'EDIT Mode','ON'
      call sic_message(seve%i,rname,mess)
      write(mess,1005) 'Selected editor',tt_edit
    else
      write(mess,1005) 'EDIT Mode','OFF'
    endif
    call sic_message(seve%i,rname,mess)
    !
    write(mess,1005) 'HELP Mode',phelp(help_mode)
    call sic_message(seve%i,rname,mess)
    !
    write(mess,1005) 'Precision of arithmetic',sic_precis
    call sic_message(seve%i,rname,mess)
    !
    ip = 1
    do i=1,maxext
      if (lext(i).eq.0) exit
      chain(ip:) = sicext(i)(1:lext(i))
      ip = ip+lext(i)+1
      if (ip.ge.message_length-30) exit
    enddo
    write (mess,1005) 'Macro extension',chain
    call sic_message(seve%i,rname,mess)
    !
    write (mess,1005) 'Syntax',psynt(lsynt)
    call sic_message(seve%i,rname,mess)
    !
    if (siclun.eq.0) then
      write(mess,1005) 'SIC OUTPUT','on terminal'
    else
      inquire (unit=siclun,name=fich,iostat=ier)
      write(mess,1005) 'SIC OUTPUT file',trim(fich)
    endif
    call sic_message(seve%i,rname,mess)
    !
    call sicapropos
    call sic_error_command
    return
  endif
  !
  ! Retrieve first argument
  call sic_ke (line,0,1,name,n,.true.,error)
  if (error) return
  !
  ! Set default severity: I)nfo with no arg (i.e. list value), D)ebug
  ! with an arg (i.e. set value).
  sev = seve%i
  !
  ! Languages
  if (name(n:n).eq.backslash) then
    langs(1:nlang) = languages(1:nlang)%name
    call sic_ambigs(rname,name(1:n-1),action,kl,langs,nlang,error)
    if (error) then
      call sic_message(seve%e,rname,'Could not modify status for language '//name(1:n))
      return
    endif
    if (action.eq.'SIC' .and. sic_present(0,2)) then
      call sic_message(seve%w,rname,'Cannot change SIC'//backslash//  &
      ' language status')
    elseif (languages(kl)%libmod) then
      if (sic_present(0,2)) then
        sev = seve%e
        error = .true.
      endif
      call sic_message(sev,rname,'Language '//trim(action)//backslash//  &
      ' is in LIBRARY ONLY')
    else
      if (sic_present(0,2)) then
        call sic_ke (line,0,2,argum,nc,.false.,error)
        if (error) return
        sev = seve%d
        if (argum.eq.'ON') then
          languages(kl)%asleep = .false.
          line = 'SIC'//backslash//'SIC '//trim(action)//backslash//' ON'
        elseif (argum.eq.'OFF') then
          languages(kl)%asleep = .true.
          line = 'SIC'//backslash//'SIC '//trim(action)//backslash//' OFF'
        else
          call sic_message(seve%w,rname,'Cannot set '//trim(action)//  &
          backslash//' language '//argum)
          error = .true.
        endif
      endif
      if (lire.eq.0) then
        if (languages(kl)%asleep) then
          argum = 'OFF'
        else
          argum = 'ON'
        endif
        call sic_message(sev,rname,trim(action)//backslash//' language is '//  &
        argum)
      endif
    endif
    return
  endif
  !
  ! Other actions
  call sic_ambigs('SIC',name,action,nact,acts,mact,error)
  if (error) return
  !
  select case (action)
  !
  case('MEMORY')
    call sic_switch(line,action,logbuf,lire,error)
  !
  case('VERIFY')
    call sic_setverify(line,lire,error)
  !
  case('EDIT')
    if (sic_present(0,2)) then
      call sic_ch (line,0,2,argum,nc,.false.,error)
      if (error) return
      sev = seve%d
      if (sic_eqchain(argum,'ON')) then
        call find_edit
        if (edit_mode) then
          line = 'SIC'//backslash//'SIC EDIT ON'
        else
          call sic_message(seve%w,rname,'Edit mode requires an ANSI-CRT')
          line = 'SIC'//backslash//'SIC EDIT OFF'
        endif
      elseif (sic_eqchain(argum,'OFF')) then
        edit_mode = .false.
        line = 'SIC'//backslash//'SIC EDIT OFF'
      else
        tt_edit = argum
        line = 'SIC'//backslash//'SIC EDIT "'//trim(argum)//'"'
      endif
      ier = sic_getlog(tt_edit)
    endif
    if (lire.eq.0) then
      call sic_message(sev,rname,'Editor is '//tt_edit)
    endif
  !
  case('HELP')
    if (sic_present(0,2)) then
      call sic_ke (line,0,2,argum,n,.false.,error)
      if (error) return
      sev = seve%d
      call sic_ambigs('HELP',argum,keyw,khelp,phelp,nhelp,error)
      if (error) return
      help_mode = khelp
      line = 'SIC'//backslash//'SIC HELP '//keyw
    endif
    if (lire.eq.0) then
      call sic_message(sev,rname,'HELP mode is '//phelp(help_mode))
    endif
  !
  case('PRECISION')
    if (sic_present(0,2)) then
      call sic_ke (line,0,2,argum,n,.false.,error)
      call sic_ambigs('PRECISION',argum,keyw,krecs,precs,nrecs,error)
      if (error) return
      sev = seve%d
      if (krecs.le.2) then
        sicprecis = fmt_r4
      elseif (krecs.eq.3) then
        sicprecis = fmt_r8
      elseif (krecs.eq.4) then
        sicprecis = fmt_i8
      elseif (krecs.eq.5) then
        sicprecis = 0
      endif
      line = 'SIC'//backslash//'SIC PRECISION '//keyw
      sic_precis = keyw
    endif
    if (lire.eq.0) then
      call sic_message(sev,rname,'Precision of arithmetic is '//sic_precis)
    endif
  !
  case('DIRECTORY')
    file = ' '
    nc = 0
    call sic_ch (line,0,2,file,nc,.false.,error)
    if (error) return
    if (sic_present(0,2)) sev = seve%d
    call sic_setdir(file,nc,error) ! Set or get working directory
    cur_dir = file(1:nc)
    call sic_message(sev,rname,'Default directory is '//cur_dir(1:nc))
  !
  case('OUTPUT')
    call sic_output(line,error)
    if (error)  return
  !
  case('EXTENSION')
    ! New behavior: extensions are added to previous list
    ! Pushes them at beginning of list, and removes duplicates
    if (sic_narg(0).gt.1) sev = seve%d
    do iext=min(sic_narg(0)-1,maxext),1,-1
      ! Get arg:
      call sic_ch (line,0,iext+1,argum,n,.true.,error)
      if (error) return
      ! Correct it:
      if (argum(1:1).ne.'.') then
        argum = '.'//argum
        n = n+1
      endif
      ! Remove from list if already registered:
      do i=1,maxext
        if (argum.eq.sicext(i)) then
          sicext(i) = ''
          lext(i) = 0
        endif
      enddo
      ! Remove blank (there should be currently only one):
      do i=1,maxext-1
        if (sicext(i).eq.'') then
          sicext(i) = sicext(i+1)
          lext(i) = lext(i+1)
          sicext(i+1) = ''
          lext(i+1) = 0
        endif
      enddo
      ! Push old values:
      do i=maxext,2,-1
        sicext(i) = sicext(i-1)
        lext(i) = lext(i-1)
      enddo
      ! Register:
      sicext(1) = argum
      lext(1) = n
    enddo
    ! Build a message:
    ip = 1
    n = 0
    do i=1,maxext
      if (lext(i).eq.0) then
        n = i-1
        exit
      endif
      if (ip.le.message_length) then
        chain(ip:) = sicext(i)(1:lext(i))
      endif
      ip = ip+lext(i)+1
    enddo
    call sic_message(sev,rname,'Default macro extensions: '//chain)
    !
    call sic_delvariable('SIC%EXTENSION',.false.,error)
    call sic_def_charn('SIC%EXTENSION',sicext,1,n,.true.,error)
  !
  case('DATE')
    call sic_date(date)
    call sic_setsymbol ('SYS_DATE',date,error)
  !
  case('USER')
    call sic_user(user)
    call sic_setsymbol('SYS_INFO',user,error)
  !
  case('SEARCH')
    call sic_ch (line,0,2,file,nc,.true.,error)
    if (error) return
    lexist = sic_findfile(file,fich,' ',' ')
    call sic_message(seve%w,rname,'You are using the obsolete command '//  &
    'SIC SEARCH')
    call sic_message(seve%w,rname,'Use the FILE(filename) function instead')
  !
  case('LOCK')
    if (sic_narg(0).eq.1) then
      call sic_message(seve%r,rname,'Lock files are:')
      call gag_show_locked_files()
    else
      call sic_ch(line,0,2,file,nc,.true.,error)
      if (error)  return
      call sic_parse_file(file,'','',fich)
      !
      ! Translate to an absolute path
      found = gag_which(fich,'',file)
      !
      ! (Try to) lock
      ier = gag_lock_file(file)
      if (ier.ne.0) then
         call sic_message(seve%f,rname,'Locked by file '//file)
         call sic_message(seve%f,rname,  &
           'Check the other sessions before freeing this lock')
         call sysexi(fatale)
      endif
    endif
  !
  case('LOGICAL')
    if (sic_present(0,3)) then
      call sic_ch (line,0,3,fich,nc,.true.,error)
      if (error) return
      call sic_parse_file(fich,'','',fich)
      call sic_ch (line,0,2,file,nc,.true.,error)
      if (error) return
      ier = sic_setlog(file,fich)
    else
      if (sic_present(0,2)) then
        call sic_ch (line,0,2,file,nf,.true.,error)
        if (error) return
      else
        file = '*'
        nf = 1
      endif
      if (index(file(1:nf),'*').eq.0) then
        ! Explicit name, no wilcard
        call sic_parse_file(file,'','',fich)
        if (fich.ne.file) then
          call sic_message(seve%r,rname,file(1:nf)//' = '//fich)
        else
          call sic_message(seve%w,rname,'No such logical name '//file(1:nf))
        endif
      else
        ! Wilcarded search, default '*'
        call sic_listlog(file)
      endif
    endif
  !
  case('BEEP')
    nf = 1
    call sic_i4 (line,0,2,nf,.false.,error)
    if (error) return
    nf = max(1,min(6,nf))
    do j=1,nf
      write(6,1001) char(7)
    enddo
  !
  case('SYNTAX')
    if (sic_present(0,2)) then
      call sic_ke (line,0,2,argum,n,.false.,error)
      if (error) return
      sev = seve%d
      if (n.gt.8) then
        call sic_message(seve%w,rname,'Invalid syntax '//argum(1:n))
      elseif (argum(1:n).eq.psynt(1)(1:n)) then
        if (n.eq.1) then
          call sic_message(seve%w,rname,'Ambiguous keyword')
        else
          lsynt = 1            ! Fixed syntax
        endif
        line = 'SIC'//backslash//'SIC SYNTAX FIXED'
      elseif (argum(1:n).eq.psynt(2)(1:n)) then
        lsynt = 2
        line = 'SIC'//backslash//'SIC SYNTAX FREE'
      else
        call sic_message(seve%w,rname,'Invalid syntax '//argum(1:n))
      endif
    endif
    call sic_message(sev,rname,'Syntax is '//psynt(lsynt))
  !
  case('ERROR')
    ! SIC ERROR : List the error command
    call sic_error_command
  !
  case('WAIT')
    t = 1.0
    !reads a real, sleeps howmany microseconds on several systems
    !checks the CTRL_C every seconds or at end of procedure (we are most
    ! often in a waiting LOOP, so exiting from the loop is required.)
    call sic_r4 (line,0,2,t,.false.,error)
    if (error) return
    nf = int(t)
    rste=t-float(nf)
    !
    ! wait the rste if not zero:
    ! SIC_WAIT must ensure a minimum Waiting (see sysc.c)
    if (rste.gt.0.0) call sic_wait(rste)
    ! then, if applicable, the NF seconds
    do j=1,nf
      if (sic_ctrlc()) then
        error=.true.
        return
      endif
      call sic_wait(1.0)
    enddo
    if (sic_ctrlc()) then
      error=.true.
      return
    endif
  !
  case('WINDOW')
    call sic_switch(line,'WINDOW',sic_window,lire,error)
  !
  case('DELETE')  ! DELETE File
    do i=2,sic_narg(0)
      call sic_ch (line,0,i,fich,n,.false.,error)
      call sic_parse_file(fich,'','',file)  ! Expand logicals in the string
      call gag_delete(file)
    enddo
  !
  case('COPY')  ! COPY File_in File_out
    call sic_ch (line,0,2,fich,n,.true.,error)
    if (error) return
    call sic_parse_file(fich,'','',file)
    !
    call sic_ch (line,0,3,fich,n,.true.,error)
    if (error) return
    call sic_parse_file(fich,'','',filo)
    !
    if (gag_isdir(filo).eq.0) then
      ! Target is an existing directory: copy the file there
      call sic_parse_name(file,fich,oext=ext)  ! Get 'short' name and extension
      filo = trim(filo)//'/'//trim(fich)//'.'//ext
    endif
    !
    if (gag_filcopy(file,filo).ne.0) then
      if (sicsystemerror) then
        call sic_message(seve%e,rname,  &
          'Failed to COPY '//trim(file)//' to '//trim(filo))
        error = .true.
        return
      else
        call sic_message(seve%w,rname,  &
          'Failed to COPY '//trim(file)//' to '//trim(filo))
      endif
    endif
    !
  case('RENAME')  ! RENAME File_in File_out
    if (sic_narg(0).eq.3) then
      call sic_ch (line,0,2,fich,n,.false.,error)
      if (error) return
      call sic_parse_file(fich,'','',file)
      !
      call sic_ch (line,0,3,fich,n,.false.,error)
      if (error) return
      call sic_parse_file(fich,'','',filo)
      !
      ier = gag_filmove(file,filo)
    else
      call sic_message(seve%e,rname,'RENAME File_old File_new')
    endif
  !
  case('VERSION')
    call sicapropos
  !
  case('MACRO')  ! MACRO Path
    if (sic_present(0,2)) then
      call sic_ch(line,0,2,fich,n,.true.,error)
      ier = sic_setlog('MACRO#DIR:',fich(1:n))
    else
      fich = ''
      ier = sic_getlog('MACRO#DIR:',fich)
      call sic_message(seve%i,rname,'Procedure search path:')
      call sic_message(seve%r,rname,fich)
    endif
    !
  case('APPEND')
    call sic_ch (line,0,2,fich,n,.true.,error)
    if (error) return
    call sic_parse_file(fich,'','',file)
    !
    call sic_ch (line,0,3,fich,n,.true.,error)
    if (error) return
    call sic_parse_file(fich,'','',filo)
    !
    if (gag_filappend(file,filo).ne.0) then
      if (sicsystemerror) then
        call sic_message(seve%e,rname,  &
          'Failed to APPEND '//trim(file)//' to '//trim(filo))
        error = .true.
        return
      else
        call sic_message(seve%w,rname,  &
          'Failed to APPEND '//trim(file)//' to '//trim(filo))
      endif
    endif
    !
  case('MKDIR')
    call sic_ch(line,0,2,fich,n,.true.,error)
    if (error) return
    call gag_mkdir(fich(1:n),error)
    !
  case('PARALLEL')
    call sic_openmp(line,error)
  case('DEBUG')  ! DEBUG LUN|IMAGE [Number], DEBUG MESSAGE, DEBUG SHARED
    call sic_ke(line,0,2,argum,n,.true.,error)
    if (error)  return
    call sic_ambigs('SIC DEBUG',argum,fich,n,debug,ndebug,error)
    if (error)  return
    !
    select case (fich)
    case ('LUN')
      n = 0
      call sic_i4(line,0,3,n,.false.,error)
      ier = gag_stalun(n)
      !
    case ('IMAGE')
      n = 0
      call sic_i4(line,0,3,n,.false.,error)
      if (n.eq.0) then
        call gio_lsis('',error)
      else
        tmp = gdf_stis(n)
        if (tmp.eq.-1) then
          write(mess,*) 'No such image slot ',n
        else
          write(mess,*) 'Image slot ',n,' status ',tmp
        endif
        call sic_message(seve%i,'SIC DEBUG',mess)
      endif
      !
    case ('MESSAGE')
      call gmessage_debug_swap
      !
    case ('GFORTRAN')
      call sic_debug_gfortran(error)
      if (error)  return
      !
    case ('RESOURCES')
      call gag_resources
      !
    case ('MEMALIGN')
      call sic_debug_memalign
      !
    case ('PYTHON')
#if defined(GAG_USE_PYTHON)
      call sic_debug_python
#else
      call sic_message(seve%w,rname,'SIC not compiled with Python binding')
#endif
      !
    case ('VARIABLES')
      call sic_debug_variables
      !
    case ('GIO_ALLOC')
      logi = .false.
      call sic_l4(line,0,3,logi,.false.,error)
      call gdf_prealloc(logi)
      !
    case ('LOCALE')
      if (sic_present(0,3)) then
        call sic_ch(line,0,3,argum,n,.true.,error)
        if (error)  return
        ier = gag_setlocale(argum)
        if (ier.ne.0) error = .true.
      else
        call gag_printlocale()
      endif
      !
    case ('SYSTEM')
      call sic_ke (line,0,3,argum,nc,.true.,error)
      if (error) return
      if (argum.eq.'ON') then
        call sic_debug_system(1)
      elseif (argum.eq.'OFF') then
        call sic_debug_system(0)
      else
        call sic_message(seve%e,rname,'SIC DEBUG SYSTEM argument must be ON or OFF')
        error = .true.
        return
      endif
      !
    case default
      call sic_message(seve%e,'SIC DEBUG','Unknown keyword '//fich)
      error=.true.
      return
      !
    end select
  !
  case('SAVE')  ! SAVE File Command
    if (.not.sic_present(0,2)) then
      if (lunsav.ne.0) then
        close(unit=lunsav)
        call sic_frelun (lunsav)
        lunsav = 0
      endif
    else
      if (lunsav.ne.0) then
        call sic_message(seve%w,'SIC SAVE','Closing previous file')
        close(unit=lunsav)
        call sic_frelun (lunsav)
        lunsav = 0
      endif
      call sic_ch(line,0,2,name,n,.true.,error)
      if (error) return
      call sic_ch(line,0,3,savcom,lsavcom,.true.,error)
      if (error) return
      !
      ier = sic_getlun(lunsav)
      if (ier.ne.1) then
        error = .true.
        return
      endif
      call sic_parsef (name,file,'GAG_PROC:',sicext(1)(1:lext(1)))
      ier = sic_open(lunsav,file,'UNKNOWN',.false.)
      if (ier.ne.0) then
        call sic_message(seve%e,rname,'Cannot open file for Save procedure')
        call putios('E-SIC,  ',ier)
        error = .true.
        return
      endif
    endif
  !
  case('CPU')
    call sic_cpu(line,error)
  !
  case('DELAY')
    call sic_delay(line,error)
  !
  case('FIND')  ! FIND files*.ext [Directory]
    call sic_directory(line,error)
  !
  case('GREP')  ! GREP Pattern File
    call sic_grep(line,error)
  !
  case('EXPAND')  ! EXPAND inmacro outmacro
    call expand_macro (line,error)
  !
  case('PRIORITY')
    call parse_priority(line,error)
  !
  case('PARSE')
    call parse_filename(line,error)
  !
  case('FFT')  ! FFT (for debug only)
    if (sic_narg(0).eq.1) then
      call fourt_get_usage(fourt_status)
    else
      call sic_ke(line,0,2,fich,n,.true.,error)
      fourt_status(1) = fich(1:n).eq.'FAST' .or. fich(1:n).eq.'FFTW'
      fourt_status(2) = sic_present(0,3)
      call fourt_set_usage(fourt_status)
    endif
    !
    if (fourt_status(1)) then
      write(mess,*) 'Using FFTW, Debug ',fourt_status(2)
    else
      write(mess,*) 'Using FOURT'
    endif
    call sic_message(seve%i,rname,mess)
  !
  case('MESSAGE')  ! Handle messages output
    call sicset_message(line,error)
  !
  case('FLUSH')  ! Force flushing message and log files buffers onto disk
#if defined(FORTRAN2003)
    call sic_flush_log(error)
    call gmessage_flush(error)
#else
    call sic_message(seve%w,rname,'FLUSH not done. Please enable Fortran '//  &
    '2003 features')
#endif
  !
  case('WHICH')  ! WHICH Procedure
    call sic_ch(line,0,2,fich,n,.true.,error)
    if (error) return
    call find_procedure(fich,file,found)
    if (found) then
      call sic_message(seve%r,rname,file)
    else
      call sic_message(seve%w,rname,'No such procedure '//fich)
    endif
    !
  case('HEADERS')
    call sic_i4(line,0,2,n,.true.,error)
    if (error)  return
    call gdf_stbl(n,error)
    !
  case('INTEGER')
    if (sic_present(0,2)) then
      call sic_ke(line,0,2,argum,n,.true.,error)
      if (error)  return
      call sic_ambigs('SIC INTEGER',argum,name,n,pinteg,ninteg,error)
      if (error)  return
      if (n.eq.2) then
        sicinteger = fmt_i8
      else
        sicinteger = fmt_i4
      endif
    endif
    if (sicinteger.eq.fmt_i4) then
      call sic_message(seve%i,rname,'Default SIC INTEGER is '//pinteg(1))
    elseif (sicinteger.eq.fmt_i8) then
      call sic_message(seve%i,rname,'Default SIC INTEGER is '//pinteg(2))
    endif
    !
  case('SYSTEM')
    if (sic_present(0,2)) then
      call sic_ke(line,0,2,argum,n,.true.,error)
      if (error)  return
      call sic_ambigs('SIC SYSTEM',argum,name,n,system,nsystem,error)
      if (error)  return
      sicsystemerror = n.eq.1
    endif
    if (sicsystemerror) then
      call sic_message(seve%i,rname,'SIC\SYSTEM, SIC COPY and SIC APPEND can raise errors')
    else
      call sic_message(seve%i,rname,'SIC\SYSTEM, SIC COPY and SIC APPEND won''t raise errors')
    endif
    !
  case('TIMER')
    if (sic_present(0,2)) then
      call sic_timer_dotime(line,2,3,error)
    else
      call sic_timer_show(error)
    endif
    if (error)  return
    !
  case('MODIFIED')
    call sic_modified(line,error)
    if (error)  return
    !
  case('RANDOM_SEED')
    if (sic_present(0,2)) then
      call sic_ke(line,0,2,argum,n,.true.,error)
      if (error)  return
      call gmath_random_seed_set(argum,error)
      if (error)  return
    else
      call gmath_random_seed_print(error)
      if (error)  return
    endif
    !
  case('UVT_VERSION')
    argum = ' '
    call sic_ch(line,0,2,argum,n,.false.,error)
    if (error)  return
    call gdf_set_uvt_version(argum)
    !
  case default
    error = .true.
    call sic_message(seve%e,rname,'No code for '//action)
    return
  end select
  !
1001 format (a,$)
1005 format (a,t25,' is  ',a)
end subroutine sicset
!
subroutine sicapropos
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sicapropos
  use sic_dictionaries
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  ! Display the versions of various elements of the Gildas executables
  !---------------------------------------------------------------------
  ! Local
  character(len=*), parameter :: rname='SIC'
  integer :: i
  character(len=32) :: version
  character(len=256) :: release
  character(len=message_length) :: mess
  real(kind=4) :: gdf_in,gdf_out,rversion
  !
  ! Version
  call gag_release(release)
  write(*,'(a)') trim(release)
  !
  write(mess,'(a,t20,a)')  'Compiling system ',OS_VERSION
  call sic_message(seve%r,rname,mess)
  !
  ! Translate preprocessing symbols as integers. Unable to quote them so
  ! that we can print them as strings!
#if defined(GFORTRAN)
  write(mess,102)  'Compiler','gfortran',GFORTRAN_VERSION
  call sic_message(seve%r,rname,mess)
#elif defined(IFORT)
  write(mess,102)  'Compiler','ifort',IFORT_VERSION
  call sic_message(seve%r,rname,mess)
#endif
  !
  ! External libraries
#if defined(GAG_USE_GTK)
  call gtk_get_version(version)
  write(mess,100)  'Library','GTK+',version
  call sic_message(seve%r,rname,mess)
#endif
#if defined(CFITSIO)
  call sicapropos_cfitsio_vers(rversion)
  write(mess,101)  'Library','CFITSIO',rversion
  call sic_message(seve%r,rname,mess)
#endif
  !
  ! Languages
  do i=1,nlang
    write(mess,100)  'Language',languages(i)%name,languages(i)%mess
    call sic_message(seve%r,rname,mess)
  enddo
  !
  gdf_in = 2.0
  if (gdf_stbl_get().gt.1) then
    gdf_out = 2.0
  else
    gdf_out = 1.0
  endif
  write(mess,'(A,F3.1)')  &
    'Internal Gildas Data Format Version ',gdf_in
  call sic_message(seve%r,rname,mess)
  write(mess,'(A,F3.1,A)')  &
    'External Gildas Data Format Version ',gdf_out,' (default)'
  call sic_message(seve%r,rname,mess)
  !
  if (index_length.eq.8) then
    write(mess,'(A)')  'Array indices length: up to 2**63-1 (INTEGER*8)'
  else
    write(mess,'(A)')  'Array indices length: up to 2**31-1 (INTEGER*4)'
  endif
  call sic_message(seve%r,rname,mess)
  !
  call sic_get_openmp
  !
100 format(a,t10,a,t20,a)
101 format(a,t10,a,t20,f5.3)
102 format(a,t10,a,t20,i0)
  !
end subroutine sicapropos
!
#if defined(CFITSIO)
subroutine sicapropos_cfitsio_vers(version)
  use cfitsio_api
  !---------------------------------------------------------------------
  ! @ private
  ! Return the CFITSIO version.
  !---------------------------------------------------------------------
  real(kind=4), intent(out) :: version
  call ftvers(version)
end subroutine sicapropos_cfitsio_vers
#endif
!
subroutine sic_directory(line,error)
  use sic_dependencies_interfaces
  use gildas_def
  use sic_interfaces, except_this=>sic_directory
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !   SIC\SIC FIND [Filter [Directory]]
  ! Define  DIR%NFILE and DIR%FILE variables.
  !-----------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  integer(kind=4) :: nc
  integer(kind=4) :: dir_nfile
  logical :: first
  character(len=filename_length), allocatable :: dir_file(:)
  character(len=filename_length) :: filestring,tmpstring,dirstring
  save dir_nfile,dir_file,first
  data first /.true./
  !
  if (first) then
    call sic_defstructure('DIR',.true.,error)
    if (error)  return
    call sic_def_inte('DIR%NFILE',dir_nfile,0,1,.true.,error)
    if (error)  return
    first = .false.
  endif
  call sic_delvariable('DIR%FILE',.false.,error)
  dir_nfile = 0
  !
  filestring = '*.*'
  call sic_ch(line,0,2,filestring,nc,.false.,error)
  if (error) return
  tmpstring = ' '
  call sic_ch(line,0,3,tmpstring,nc,.false.,error)
  if (error) return
  call sic_parse_file(tmpstring,'','',dirstring)  ! Translate Sic logicals and others
  call gag_directory(dirstring,filestring,dir_file,dir_nfile,error)
  if (error) return
  !
  if (dir_nfile.gt.0) then
    error = .false.
    call sic_def_charn('DIR%FILE',dir_file,1,dir_nfile,.true.,error)
  endif
end subroutine sic_directory
!
subroutine sic_error_command
  use sic_interfaces, except_this=>sic_error_command
  use sic_structures
  use sic_dictionaries
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! List the current ON ERROR Command
  !---------------------------------------------------------------------
  integer :: lerr
  character(len=message_length) :: mess
  !
  lerr = nerr(0)
  if (lerr.eq.e_pause) then
    write (mess,1000) 'Interactive: ON ERROR PAUSE'
  elseif (lerr.eq.e_cont) then
    write (mess,1000) 'Interactive: ON ERROR CONTINUE'
  elseif (lerr.eq.e_quit) then
    write (mess,1000) 'Interactive: ON ERROR QUIT'
  elseif (lerr.eq.e_retu) then
    write (mess,1000) 'Interactive: ON ERROR RETURN'
  else
    write (mess,1000) 'Interactive: ON ERROR ',errcom(0)(1:lerr)
  endif
  call sic_message(seve%i,'SIC',mess)
  if (var_level.gt.0) then
    lerr = nerr(var_level)
    if (lerr.eq.e_pause) then
      write (mess,1003) 'Level ',var_level,': ON ERROR PAUSE'
    elseif (lerr.eq.e_cont) then
      write (mess,1003) 'Level ',var_level,': ON ERROR CONTINUE'
    elseif (lerr.eq.e_quit) then
      write (mess,1003) 'Level ',var_level,': ON ERROR QUIT'
    elseif (lerr.eq.e_retu) then
      write (mess,1003) 'Level ',var_level,': ON ERROR RETURN'
    else
      write (mess,1003) 'Level ',var_level,': ON ERROR ',  &
      errcom(var_level)(1:lerr)
    endif
    call sic_message(seve%i,'SIC',mess)
  endif
1000 format (20(a))
1003 format (a,i2,a,a,a)
end subroutine sic_error_command
!
subroutine sic_switch(line,action,switch,lire,error)
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_switch
  !---------------------------------------------------------------------
  ! @ private
  ! List and/or Toggle an internal SIC switch
  !---------------------------------------------------------------------
  character(len=*), intent(inout) :: line    !
  character(len=*), intent(in)    :: action  !
  logical,          intent(inout) :: switch  !
  integer(kind=4),  intent(in)    :: lire    !
  logical,          intent(inout) :: error   !
  ! Local
  character(len=*), parameter :: rname='SIC'
  character(len=1), parameter :: backslash=char(92)
  character(len=4) :: argum,found
  integer(kind=4) :: n,sev
  integer(kind=4), parameter :: monoff=2
  character(len=3), parameter :: onoff(monoff)= (/ 'ON ','OFF' /)
  !
  sev = seve%i
  !
  if (sic_present(0,2)) then
    call sic_ke (line,0,2,argum,n,.false.,error)
    if (error) return
    call sic_ambigs(rname,argum,found,n,onoff,monoff,error)
    if (error)  return
    sev = seve%d
    switch = n.eq.1
    line = 'SIC'//backslash//'SIC '//action//' '//onoff(n)
  endif
  if (lire.eq.0) then
    if (switch) then
      argum = 'ON'
    else
      argum = 'OFF'
    endif
    call sic_message(sev,rname,action//' is '//argum)
  endif
end subroutine sic_switch
!
subroutine parse_priority(line,error)
  use sic_dependencies_interfaces
  use sic_interactions
  use sic_interfaces, except_this=>parse_priority
  use sic_dictionaries
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  character(len=*)                :: line   !
  logical,          intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='SIC PRIORITY'
  integer :: na,nc,i,j,iprio,nl,sev
  character(len=language_length) :: argum,lang,langs(mlang)
  character(len=1) :: wildcard    ! Synomym for all languages
  character(len=message_length) :: mess
  ! Data
  data wildcard /'*'/
  !
  na = sic_narg(0)
  sev = seve%i
  !
  if (na.ge.2) then
    !
    sev = seve%d
    !
    ! Get first argument (must be a level)
    call sic_i4(line,0,2,iprio,.true.,error)
    if (iprio.lt.-mprio .or. iprio.gt.mprio) then
      call sic_message(seve%e,rname,'Invalid priority level')
      error =.true.
    endif
    if (error) return
    !
    ! Get next arguments
    langs(1:nlang) = languages(1:nlang)%name
    do i=3,na
      !
      ! Try a language name
      call sic_ke(line,0,i,argum,nc,.true.,error)
      if (error) return
      !
      call sic_ambigs_sub(rname,argum,lang,nl,langs,nlang,error)
      if (error) return        ! There was an ambiguity
      !
      if (nl.ne.0) then        ! Found a language
        languages(nl)%prio = iprio
      elseif (argum.eq.wildcard) then
        languages(1:nlang)%prio = iprio
      else                     ! Not a recognized language, try a level
        call sic_i4(line,0,i,iprio,.true.,error)
        if (error) then
          call sic_message(seve%e,rname,'No such language '//argum(1:nc))
          return
        endif
        if (iprio.lt.-mprio .or. iprio.gt.mprio) then
          call sic_message(seve%e,rname,'Invalid priority level')
          error =.true.
          return
        endif
      endif
      !
    enddo
    !
  endif
  !
  call parse_priority_recompute(error)
  if (error)  return
  !
  ! Print priorities
  do i=1,nprio
    write (mess,'(A,I3,2X,30(A,1X))') 'Priority Level #',i,  &
    (languages(olang(j,i))%name,j=1,klang(i))
    call sic_message(sev,rname,mess)
  enddo
  !
end subroutine parse_priority
!
subroutine parse_priority_recompute(error)
  use gbl_message
  use eclass_types
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>parse_priority_recompute
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! @ private
  !   Recompute the priority structures according to the (new)
  ! priorities in 'languages(:)%prio'
  !   Sorting rules (example):
  !    Prio   Level
  !     1       1
  !     2       2
  !     3       3
  !     0       4  (automatic = after the explicit positive priorities
  !                         and before the negative ones)
  !    -2       5
  !    -1       6  (negative = position from the end)
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='SIC PRIORITY'
  type(eclass_inte_t) :: eclass
  integer(kind=4) :: cval(nlang),ckey(nlang),cbak(nlang)  ! Automatic arrays
  integer(kind=4) :: il,iu,is,lprio,nneg,npos
  !
  ! Compute equivalence classes to gather the priorities by family
  call reallocate_eclass_inte(eclass,nlang,error)
  if (error)  return
  eclass%val(1:nlang) = languages(1:nlang)%prio
  eclass%cnt(:) = 1
  call eclass_inte(eclass_inte_eq,eclass)
  !
  if (eclass%nequ.gt.mprio) then
    call sic_message(seve%e,rname,'Too many priority levels')
    error = .true.
    goto 10
  endif
  !
  ! Sort the classes
  cval(1:eclass%nequ) = eclass%val(1:eclass%nequ)
  call gi4_trie(cval,ckey,eclass%nequ,error)
  if (error)  goto 10
  do is=1,eclass%nequ
    cbak(ckey(is)) = is
  enddo
  !
  ! Locate the negative-or-null and positive priorities
  nneg = 0
  npos = 0
  do is=1,eclass%nequ
    if (eclass%val(is).le.0) then
      nneg=nneg+1
    else
      npos=npos+1
    endif
  enddo
  !
  ! Recompute the priority structures.
  nprio = eclass%nequ
  klang(:) = 0    ! Reset arrays
  olang(:,:) = 0  !
  do il=1,nlang
    iu = eclass%bak(il)  ! Language #i goes into equiv-class #iu (unsorted)...
    is = cbak(iu)        ! ...which is priority #is (sorted)
    if (eclass%val(iu).gt.0) then
      lprio = is-nneg
    elseif (eclass%val(iu).eq.0) then
      lprio = npos+1
    else
      lprio = npos+1+is
    endif
    klang(lprio) = klang(lprio)+1
    olang(klang(lprio),lprio) = il
  enddo
  !
10 continue
  call free_eclass_inte(eclass,error)
  !
end subroutine parse_priority_recompute
!
subroutine parse_filename (line,error)
  use sic_dependencies_interfaces
  use gildas_def
  use sic_interfaces, except_this=>parse_filename
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  ! SIC PARSE Filename Name [Ext [Dir]]
  ! Parse an input filename, and return the short Name, and optionally
  ! the Extension and Directory as SIC variables. The name of the
  ! corresponding variables are given in the command line.
  !---------------------------------------------------------------------
  character(len=*)                :: line   !
  logical,          intent(inout) :: error  !
  ! Local
  character(len=filename_length) :: file,dir,name
  character(len=32) :: ext
  integer(kind=4) :: nc
  type(sic_descriptor_t) :: desc
  !
  call sic_ch(line,0,2,name,nc,.true.,error)
  if (error)  return
  call sic_parse_name(name,file,ext,dir)
  !
  call get_achar_desc(line,0,3,desc,error)
  if (error) return
  call ctodes(file,desc%type,desc%addr)
  !
  if (.not.sic_present(0,4)) return
  call get_achar_desc(line,0,4,desc,error)
  if (error) return
  call ctodes(ext,desc%type,desc%addr)
  !
  if (.not.sic_present(0,5)) return
  call get_achar_desc(line,0,5,desc,error)
  if (error) return
  call ctodes(dir,desc%type,desc%addr)
end subroutine parse_filename
!
subroutine get_achar_desc(line,iopt,iarg,desc,error)
  use gildas_def
  use sic_interfaces, except_this=>get_achar_desc
  use sic_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! Get the descriptor of an (existing, writeable) character string
  ! whose name is the Iarg argument of option Iopt of the command line
  !---------------------------------------------------------------------
  character(len=*)                      :: line   !
  integer                               :: iopt   !
  integer                               :: iarg   !
  type(sic_descriptor_t)                :: desc   !
  logical,                intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='PARSE'
  character(len=128) :: var
  integer :: nc
  logical :: found
  !
  call sic_ch(line,iopt,iarg,var,nc,.true.,error)
  if (error) return
  call sic_descriptor(var,desc,found)
  if (.not.found) then
    call sic_message(seve%e,rname,'No such variable '//var)
    error = .true.
    return
  endif
  if (desc%type.lt.0) then
    call sic_message(seve%e,rname,'Wrong variable type')
    error = .true.
    return
  endif
  if (desc%readonly) then
    call sic_message(seve%e,rname,'Variable is ReadOnly')
    error = .true.
    return
  endif
end subroutine get_achar_desc
!
subroutine sic_debug_gfortran(error)
  use sic_interfaces, except_this=>sic_debug_gfortran
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !  Try to reproduce the bug observed with gfortran when writing
  ! Gildas binary files.
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='SIC DEBUG'
  character(len=message_length) :: before
  integer(kind=4), parameter :: vin=2147483647  ! Value to be converted
  integer(kind=4), parameter :: vout=-129       ! Expected value on return
  integer(kind=8) :: din=9223372036854775807_8  ! Value to be converted
  integer(kind=8), parameter :: dout=-129       ! Expected value on return
  integer(kind=4) :: in4,out4
  integer(kind=8) :: in8,out8
  integer(kind=1) :: in1(4),out1(4),in2(8),out2(8)
  equivalence (in4,in1(1)), (out4,out1(1))
  equivalence (in8,in2(1)), (out8,out2(1))
  !
  ! First check if the conversion works properly
  in4 = vin
  in8 = din
  Print *,' DIN ',din,' VIN ',vin
#if defined(IEEE) || defined(VAX)
  call iei4ei(in4,out4,1)
  if (out4.ne.vout) then
    call sic_message(seve%e,rname,'IEEE to EEEI conversion error:')
    write (6,*) 'Input:  ',in4, ' (int4) = ',in1, ' (4 int1)'
    write (6,*) 'Output: ',out4,' (int4) = ',out1,' (4 int1)'
    error = .true.
  endif
  call iei8ei(in8,out8,1)
  if (out8.ne.dout) then
    call sic_message(seve%e,rname,'IEEE to EEEI conversion error:')
    write (6,*) 'In: ',in8, ' (int4) ',in2, ' (8 int1)'
    write (6,*) 'Out:',out8,' (int8) ',out2,' (8 int1)'
    error = .true.
  endif
#endif
  !
  ! Then check the conversion inplace ('in' is used in and out). It seems
  ! that some versions of gfortran do not like this inplace modification.
  ! The problem is observed at least in subroutine real_to_int4, file
  ! kernel/lib/gio/rescale.f90
  in4 = vin
#if defined(IEEE) || defined(VAX)
  write (before,*) 'Input:  ',in4,' (int4) = ',in1,' (4 int1)'
  call iei4ei(in4,in4,1)
  if (in4.ne.vout) then
    call sic_message(seve%e,rname,  &
      'Call to subroutine IEI4EI with single I/O variable failed:')
    write (6,'(a)') trim(before)
    write (6,*) 'Output: ',in4,' (int4) = ',in1,' (4 int1)'
    error = .true.
  endif
  write (before,*) 'In: ',in8,' (int8) = ',in2,' (8 int1)'
  call iei8ei(in8,in8,1)
  if (in8.ne.dout) then
    call sic_message(seve%e,rname,  &
      'Call to subroutine IEI8EI with single I/O variable failed:')
    write (6,'(a)') trim(before)
    write (6,*) 'Out:',in8,' (int8) = ',in2,' (8 int1)'
    error = .true.
  endif
#endif
  !
  if (error)  return
  !
  call sic_message(seve%i,rname,'No problem during the IEEE to EEEI conversion')
  !
end subroutine sic_debug_gfortran
!
subroutine sic_debug_memalign
  use gbl_message
  use sic_dependencies_interfaces
  !---------------------------------------------------------------------
  ! @ private
  !  Check how:
  !   1) Fortran allocatables,
  !   2) malloc-ed buffers,
  !   3) and fftw_malloc-ed buffers
  !  are aligned in memory
  !---------------------------------------------------------------------
  ! Local
  integer(kind=4) :: i,ier
  integer(kind=size_length) :: siz
  integer(kind=4), allocatable :: i4(:)
  integer(kind=address_length) :: addr
  !
  write(*,'(A)')
  write(*,'(A)')  'Fortran allocatables:'
  do i=5,14
    siz = 4**i  ! Buffer size, in words
    allocate(i4(siz))
    addr = locwrd(i4)  ! Address in bytes
    write(*,'(I10,A,I16,A,4(1X,L))') siz,' words, address ',addr,  &
      ', aligned on 4, 8, 16, 32 bytes:',  &
      mod(addr,4).eq.0, &
      mod(addr,8).eq.0, &
      mod(addr,16).eq.0, &
      mod(addr,32).eq.0
    deallocate(i4)
  enddo
  !
  write(*,'(A)')
  write(*,'(A)')  'Malloc buffers:'
  do i=5,14
    siz = 4**i  ! Buffer size, in words
    ier = sic_getvm(siz,addr)  ! Return address in bytes
    write(*,'(I10,A,I16,A,4(1X,L))') siz,' words, address ',addr,  &
      ', aligned on 4, 8, 16, 32 bytes:',  &
      mod(addr,4).eq.0, &
      mod(addr,8).eq.0, &
      mod(addr,16).eq.0, &
      mod(addr,32).eq.0
    call free_vm(siz,addr)
  enddo
  !
end subroutine sic_debug_memalign
!
subroutine sic_debug_system(switch)
  use sic_dependencies_interfaces
  !---------------------------------------------------------------------
  ! @ public
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: switch
  call gag_debug_system(switch)
end subroutine sic_debug_system
!
subroutine sic_cpu(line,error)
  use gbl_message
  use gsys_types
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_cpu
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command:
  !  SIC\SIC CPU [VERBOSE]
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='SIC CPU'
  character(len=7), parameter :: verbose(1) = (/ 'VERBOSE' /)
  character(len=12) :: arg,keyw
  integer(kind=4) :: nc,ikey
  logical :: dofeedback
  character(len=message_length) :: mess
  type(cputime_t), save :: cputime
  logical, save :: firstt
  data firstt /.true./
  !
  ! Parsing
  if (sic_present(0,2)) then
    call sic_ke(line,0,2,arg,nc,.true.,error)
    if (error)  return
    call sic_ambigs(rname,arg,keyw,ikey,verbose,1,error)
    if (error)  return
    dofeedback = ikey.eq.1
  else
    dofeedback = .false.
  endif
  !
  ! Execution
  if (firstt) then
    call gag_cputime_init(cputime)
    !
    ! Parent structures
    call sic_defstructure('SIC%CPU',      .true.,error)
    if (error) return
    call sic_defstructure('SIC%CPU%RAW',  .true.,error)
    if (error) return
    call sic_defstructure('SIC%CPU%CUMUL',.true.,error)
    if (error) return
    ! System times
    call sic_def_dble('SIC%CPU%RAW%SYSTEM',  cputime%diff%system,0,1,.true.,error)
    call sic_def_dble('SIC%CPU%CUMUL%SYSTEM',cputime%curr%system,0,1,.true.,error)
    ! User times
    call sic_def_dble('SIC%CPU%RAW%USER',  cputime%diff%user,0,1,.true.,error)
    call sic_def_dble('SIC%CPU%CUMUL%USER',cputime%curr%user,0,1,.true.,error)
    ! Elapsed times
    call sic_def_dble('SIC%CPU%RAW%ELAPSED',  cputime%diff%elapsed,0,1,.true.,error)
    call sic_def_dble('SIC%CPU%CUMUL%ELAPSED',cputime%curr%elapsed,0,1,.true.,error)
    if (error) return
    !
    firstt = .false.
  else
    call gag_cputime_get(cputime)
  endif
  !
  ! Feedback
  if (dofeedback) then
    write(mess,'(A)')   '            System      User       Elapsed'
    call sic_message(seve%r,rname,mess)
    write(mess,'(4A)')  ' Raw   ',pr(cputime%diff%system),  &
                                  pr(cputime%diff%user),    &
                                  pr(cputime%diff%elapsed)
    call sic_message(seve%r,rname,mess)
    write(mess,'(4A)')  ' Cumul ',pr(cputime%curr%system),  &
                                  pr(cputime%curr%user),    &
                                  pr(cputime%curr%elapsed)
    call sic_message(seve%r,rname,mess)
  endif
  !
contains
  function pr(v)  ! Print!
    character(len=12) :: pr
    real(kind=8), intent(in) :: v
    !
    if (v.gt.6000.d0) then  ! > 100 min
      write(pr,'(F9.2,A3)')  v/3600.d0,'hr '
    elseif (v.gt.100.d0) then  ! > 100 sec
      write(pr,'(F9.2,A3)')  v/60.d0,'min'
    else
      write(pr,'(F9.2,A3)')  v,'sec'
    endif
    !
  end function pr
  !
end subroutine sic_cpu
!
subroutine sic_delay(line,error)
  use sic_dependencies_interfaces
  use gbl_message
  use gsys_types
  use sic_interfaces, except_this=>sic_delay
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for commande SIC\SIC DELAY
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Input command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='SIC DELAY'
  type(cputime_t) :: cputime
  real(kind=8) :: delay
  character(len=message_length) :: mess
  integer(kind=4) :: itime
  real(kind=8), save :: goal
  data goal /0.d0/
  !
  if (sic_present(0,2)) then
    ! SIC\SIC DELAY Time: give the minimum time to wait
    call sic_r8 (line,0,2,delay,.true.,error)
    if (error) return
    !
    call gag_cputime_init(cputime)  ! Get current date-time in cputime%refe%elapsed
    goal = cputime%refe%elapsed+delay
  else
    ! SIC\SIC DELAY (no argument): wait until new time is reached
    call gag_cputime_init(cputime)
    delay = goal-cputime%refe%elapsed
    !
    if (delay.le.0.d0)  return
    !
    if (delay.gt.10.d0) then
      write(mess,'(A,F0.2,A)')  &
        'Still have to wait for ',delay,' seconds'
      call sic_message(seve%i,rname,mess)
    endif
    !
    do itime=1,floor(delay)  ! Can be 0
      call sic_wait(1.0)
      if (sic_ctrlc())  return
    enddo
    !
    ! Remaining fraction of second
    delay = delay-real(floor(delay),kind=8)  ! Compute in double precision
    call sic_wait(real(delay,kind=4))
    !
  endif
  !
end subroutine sic_delay
!
subroutine sic_modified(line,error)
  use gildas_def
  use gbl_format
  use gbl_message
  use gsys_types
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_modified
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !   SIC MODIFIED FileName StructName
  ! Check if File has been modified or not
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Input command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='MODIFIED'
  type(mfile_t) :: modif
  character(len=filename_length) :: file, fich
  integer(kind=4) :: n
  character(len=varname_length) :: strname,varname
  type(sic_descriptor_t) :: desc
  logical :: found
  integer(kind=address_length) :: ipnt
  integer(kind=4) :: memory(2)
  !
  call sic_ke(line,0,3,strname,n,.true.,error)
  if (error)  return
  !
  ! STRUCTURE
  call my_get_descr(strname,0,found,desc,error)
  if (error)  return
  if (.not.found) then
    ! Structure does not exist. Create a user-defined structure
    call sic_crestructure(strname,.true.,error)
    if (error)  return
  endif
  !
  ! STRUCTURE%FILE
  varname = trim(strname)//'%FILE'
  call my_get_descr(varname,1,found,desc,error)
  if (error)  return
  if (found) then
    call destoc(desc%type,desc%addr,modif%file)
  else
    call sic_defvariable(filename_length,varname,.true.,error)
    if (error)  return
    modif%file = ''
  endif
  !
  ! STRUCTURE%MTIME
  varname = trim(strname)//'%MTIME'
  call my_get_descr(varname,fmt_i8,found,desc,error)
  if (error)  return
  if (found) then
    ipnt = gag_pointer(desc%addr,memory)
    call i8toi8(memory(ipnt),modif%mtime,1)
  else
    call sic_defvariable(fmt_i8,varname,.true.,error)
    if (error)  return
    modif%mtime = 0
  endif
  !
  ! STRUCTURE%PTIME
  varname = trim(strname)//'%PTIME'
  call my_get_descr(varname,fmt_i8,found,desc,error)
  if (error)  return
  if (found) then
    ipnt = gag_pointer(desc%addr,memory)
    call i8toi8(memory(ipnt),modif%ptime,1)
  else
    call sic_defvariable(fmt_i8,varname,.true.,error)
    if (error)  return
    modif%ptime = 0
  endif
  !
  ! STRUCTURE%MODIF
  varname = trim(strname)//'%MODIF'
  call my_get_descr(varname,fmt_l,found,desc,error)
  if (error)  return
  if (.not.found) then
    call sic_defvariable(fmt_l,varname,.true.,error)
    if (error)  return
    ! Do not copy struct%modif (forced below)
  endif
  !
  call sic_ch(line,0,2,fich,n,.true.,error)
  if (error)  return
  file = fich
  call sic_parsef(fich,file,' ',' ')
  !
  ! Evaluation
  modif%modif = .true.  ! Default in case of ambiguity
  call gag_filmodif(file,modif,error)
  if (error)  return
  !
  ! Copy the values back into the Sic structure
  varname = trim(strname)//'%FILE'
  found = .false.  ! Not verbose
  call sic_descriptor(varname,desc,found)
  call ctodes(file,filename_length,desc%addr)
  !
  varname = trim(strname)//'%MTIME'
  found = .false.  ! Not verbose
  call sic_descriptor(varname,desc,found)
  ipnt = gag_pointer(desc%addr,memory)
  call i8toi8(modif%mtime,memory(ipnt),1)
  !
  varname = trim(strname)//'%PTIME'
  found = .false.  ! Not verbose
  call sic_descriptor(varname,desc,found)
  ipnt = gag_pointer(desc%addr,memory)
  call i8toi8(modif%ptime,memory(ipnt),1)
  !
  varname = trim(strname)//'%MODIF'
  found = .false.  ! Not verbose
  call sic_descriptor(varname,desc,found)
  ipnt = gag_pointer(desc%addr,memory)
  call l4tol4(modif%modif,memory(ipnt),1)
  !
contains
  subroutine my_get_descr(varname,vtype,found,desc,error)
    !-------------------------------------------------------------------
    ! Get descriptor + make some checks if variable exists
    !-------------------------------------------------------------------
    character(len=*),       intent(in)    :: varname
    integer(kind=4),        intent(in)    :: vtype
    logical,                intent(out)   :: found
    type(sic_descriptor_t), intent(out)   :: desc
    logical,                intent(inout) :: error
    ! Local
    logical :: myfound
    character(len=12) :: strtype
    !
    myfound = .false.  ! Not verbose
    call sic_descriptor(varname,desc,myfound)
    found = myfound
    if (found) then
      ! VARIABLE must be a scalar, user-defined, of given type
      if (desc%ndim.ne.0) then
        call sic_message(seve%e,rname,trim(varname)//' must be a scalar variable')
        error = .true.
      elseif (desc%status.ne.user_defined) then
        call sic_message(seve%e,rname,'Output variable must be user-defined')
        error = .true.
      elseif (vtype.gt.0) then
        if (desc%type.le.0) then
          call sic_message(seve%e,rname,trim(varname)//' must be a character variable')
          error = .true.
        endif
      elseif (desc%type.ne.vtype) then
        if (vtype.eq.0) then
          strtype = 'structure'
        elseif (vtype.eq.fmt_i8) then
          strtype = 'long integer'
        elseif (vtype.eq.fmt_l) then
          strtype = 'logical'
        endif
        call sic_message(seve%e,rname,trim(varname)//' must be a '//strtype)
        error = .true.
      endif
    endif
  end subroutine my_get_descr
  !
end subroutine sic_modified
!
subroutine sic_output(line,error)
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_output
  use sic_interactions
  !---------------------------------------------------------------------
  ! @ private
  !  Support routine for command
  !    SIC OUTPUT [FileName [NEW|APPEND]]
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='SIC'
  character(len=filename_length) :: fich,file
  integer(kind=4) :: nc,ier,imode
  character(len=7) :: argum,mode
  integer(kind=4), parameter :: nmodes=2
  character(len=6), parameter :: modes(nmodes) = (/ 'NEW   ','APPEND' /)
  !
  if (.not.sic_present(0,2)) then
    call sic_output_close(error)
    return
  endif
  !
  call sic_ch(line,0,2,fich,nc,.true.,error)
  if (error) return
  !
  if (fich(1:nc).eq.'?') then
    if (siclun.eq.0) then
      call sic_message(seve%i,rname,'SIC OUTPUT is on Terminal')
    else
      inquire (unit=siclun,name=file,iostat=ier)
      call sic_message(seve%i,rname,'SIC OUTPUT to file '//file)
    endif
    return
  endif
  !
  argum = 'NEW'  ! Default
  call sic_ke(line,0,3,argum,nc,.false.,error)
  if (error) return
  call sic_ambigs(rname,argum,mode,imode,modes,nmodes,error)
  if (error)  return
  !
  ! Close previous file, if any
  call sic_output_close(error)
  if (error)  return
  ! Open new one
  ier = sic_getlun(siclun)
  if (mod(ier,2).eq.0) then
    error=.true.
    return
  endif
  call sic_parse_file(fich,' ','.dat',file)
  !
  if (mode.eq.'APPEND' .and. gag_inquire(file,len_trim(file)).ne.0) then
    ! APPEND mode but file does nos exist: create a new empty one as NEW
    mode = 'NEW'
  endif
  !
  ier = sic_open(siclun,file,mode,.false.)
  if (ier.ne.0) then
    call putios('E-SIC, ',ier)
    call sic_output_close(error)
    error = .true.
  endif
  !
end subroutine sic_output
!
subroutine sic_output_close(error)
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_output_close
  use sic_interactions
  !---------------------------------------------------------------------
  ! @ private
  !  Support routine for command
  !    SIC OUTPUT (no arg)
  !  Close the SIC OUTPUT file, if any
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='SAY'
  character(len=filename_length) :: fich
  integer(kind=4) :: ier
  !
  if (siclun.ne.0) then
    inquire (unit=siclun,name=fich,iostat=ier)
    call sic_message(seve%d,rname,'Closing output file '//fich)
    !
    ! Close the unit
    ier = sic_close(siclun)
    if (ier.ne.0) then
      call putios('E-SAY, ',ier)
      error = .true.
      ! continue
    endif
    !
    ! Free the unit
    call sic_frelun(siclun)
    siclun = 0
  endif
  !
end subroutine sic_output_close
!
subroutine sic_openmp(line,error)
  use gildas_def
  use gbl_message
  use sic_interfaces, except_this=>sic_openmp
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line
  logical,          intent(inout) :: error
  !
  if (sic_present(0,2)) then
    call sic_set_openmp(line,error)
    if (error)  return
  endif
  call sic_get_openmp
  !
end subroutine sic_openmp
!
subroutine sic_get_openmp
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_get_openmp
  use sic_interactions
  !$  use omp_lib
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  ! Local
  character(len=*), parameter :: rname='SIC'
  character(len=message_length) :: mess
  character(len=24) :: chain
  integer(kind=4) :: version
  integer(kind=4) :: mthread,  nt, ns, ier
  !
  if (sic_omp_compiled) then
    ! Current value for OpenMP nthreads. This can be set/changed with:
    ! - environment variable $OMP_NUM_THREADS at startup,
    ! - default value set by SIC init at startup,
    ! - SIC PARALLEL at run time,
    ! - Fortran program call to omp_set_num_threads() at run time.
    ! All in all, get updated value and show it (NB: SIC should provide a
    ! programmer API which sets nthreads (omp_set_num_threads()) AND updates
    ! sic_omp_nthreads; this would avoid this update and ensure
    ! SIC%OPENMP%NTHREADS is always up-to-date):
    !$ sic_omp_nthreads = omp_get_max_threads()  ! "This value is an upper bound on the
                                                 ! number of threads that could be used
                                                 ! to form a new team if a parallel region
                                                 ! without a num_threads clause."
    call sic_getenv('OMP_STACKSIZE',chain)
    if (chain.eq.'')  chain = 'unset'
    !$ version = openmp_version
    write(mess,'(A,I0,A,I0,3A)')  'Parallelization with Open-MP version ',  &
      version,' is enabled (',sic_omp_nthreads,' threads, stack size ',trim(chain),')'
    call sic_message(seve%i,rname,mess)
    !
    !$ mthread = sic_omp_mthreads  ! The maximum allowed at program start, NOT omp_get_num_procs()
    nt = 0
    ier = sic_getlog('$OMP_NUM_THREADS',nt)
    ns = 0
    ier = sic_getlog('$SLURM_CPUS_PER_TASK',ns)
    write(mess,'(A,I0,A,I0,A,I0,A,I0)') "Allowed Thread Number: Cores ",sic_omp_ncores, &
      & ", System ",sic_omp_mthreads,", OpenMP ",nt,", Slurm ",ns
    call sic_message(seve%i,rname,mess)
  else
    call sic_message(seve%i,rname,'Open-MP parallelization is NOT enabled')
  endif
  !
end subroutine sic_get_openmp
!
subroutine sic_set_openmp(line,error)
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this => sic_set_openmp
  use sic_interactions
  !$  use omp_lib
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='SIC PARALLEL'
  integer(kind=4) :: nc,ier
  character(len=64) :: chain
  !
  if (.not.sic_omp_compiled) then
    call sic_message(seve%e,rname,'GILDAS not compiled in Open-MP mode')
    error = .true.
    return
  endif
  !
  ! This section is only used when compiled with Open-MP
  call sic_ch(line,0,2,chain,nc,.true.,error)
  if (error)  return
  if (chain.eq.'*') then
    sic_omp_nthreads = sic_omp_ncores ! Default is to avoid hyper-threading
  else
    call sic_i4(line,0,2,sic_omp_nthreads,.true.,error)
    if (error)  return
  endif
  !$ call omp_set_num_threads(sic_omp_nthreads)
  !
  if (sic_present(0,3)) then
    call sic_ch(line,0,3,chain,nc,.true.,error)
    ier = sic_setenv('OMP_STACKSIZE',chain(1:nc))
    if (ier.ne.0) then
      call sic_message(seve%e,rname,'Error setting environment variable OMP_STACKSIZE')
      error = .true.
      return
    endif
  endif
  !
end subroutine sic_set_openmp
!
subroutine sic_setverify(line,lire,error)
  use gbl_message
  use sic_structures
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_setverify
  !---------------------------------------------------------------------
  ! @ private
  ! List and/or Toggle the VERIFY switches
  !---------------------------------------------------------------------
  character(len=*), intent(inout) :: line    !
  integer,          intent(in)    :: lire    !
  logical,          intent(inout) :: error   !
  ! Local
  character(len=*), parameter :: rname='SIC'
  character(len=1), parameter :: backslash=char(92)
  character(len=8) :: argum,found1,found2
  integer(kind=4) :: n,sev
  integer(kind=4), parameter :: monoff=3
  character(len=5), parameter :: onof1(monoff)= [ 'ON   ','OFF  ','MACRO']
  character(len=5), parameter :: onof2(monoff)= [ 'ON   ','OFF  ','STEP ']
  character(len=60), save :: mess='VERIF MACRO is OFF                               '
  !
  sev = seve%i
  !
  if (sic_present(0,2)) then
    call sic_ke (line,0,2,argum,n,.false.,error)
    if (error) return
    call sic_ambigs(rname,argum,found1,n,onof1,monoff,error)
    if (error)  return
    sev = seve%d
    select case (found1)
    case ('ON')
      lverif = .true.
      line = 'SIC'//backslash//'SIC VERIFY ON'
    case ('OFF')
      line = 'SIC'//backslash//'SIC VERIFY OFF'
      lverif = .false.
    case ('MACRO')
      argum = 'ON'
      call sic_ke (line,0,3,argum,n,.false.,error)
      if (error) return
      call sic_ambigs(rname,argum,found2,n,onof2,monoff,error)
      if (error)  return
      select case (found2)
      case ('OFF')
        line = 'SIC'//backslash//'SIC VERIFY MACRO OFF'
        mess = 'VERIFY MACRO is OFF'
        sic_stepin = 0
      case ('ON')
        line = 'SIC'//backslash//'SIC VERIFY MACRO ON'
        sic_stepin = -1
        mess = 'VERIFY MACRO is  ON (at enter/exit)'
      case ('STEP')
        line = 'SIC'//backslash//'SIC VERIFY MACRO ON'
        sic_stepin = +1
        mess = 'VERIFY MACRO is STEP (at each command)'
      end select
    end select
  endif
  if (lire.eq.0) then
    if (lverif) then
      call sic_message(sev,rname,'VERIFY is ON')
    else
      call sic_message(sev,rname,'VERIFY is OFF')
    endif
    call sic_message(sev,rname,mess)
  endif
end subroutine sic_setverify
!
subroutine sic_user(user)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_user
  !---------------------------------------------------------------------
  ! @ public
  ! Return "user[@host]" in output string
  !---------------------------------------------------------------------
  character(len=*), intent(out) :: user  ! Output string
  ! Local
  character(len=20) :: node
  !
  call sic_username(user)
  call sic_hostname(node)
  if (node.ne.' ')  user = trim(user)//'@'//node
end subroutine sic_user
