module sic_define_status
  logical :: strict_define = .true.
  integer(kind=4), parameter :: code_header=0        ! Header of any kind
  integer(kind=4), parameter :: code_image=1         !
  integer(kind=4), parameter :: code_uv=2            !
  integer(kind=4), parameter :: code_table=3         !
  integer(kind=4), parameter :: code_header_image=4  ! Header for a GDF image
  integer(kind=4), parameter :: code_header_uv=5     ! Header for a GDF UV table
end module sic_define_status
!
subroutine sic_define (line,nline,error)
  use gildas_def
  use gbl_message
  use gbl_format
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_define
  use sic_dictionaries
  use sic_interactions
  use sic_structures
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  ! SIC   Support routine for command
  !       DEFINE Type Variable1 [Variable2 [...]]] 
  !         [/GLOBAL] [/LIKE Other] [/TRIM]
  !       Defines new variables, local or global
  !       DEFINE CHARACTER*Length  is now supported
  !---------------------------------------------------------------------
  character(len=*)                :: line   ! Command line          Input
  integer(kind=4)                 :: nline  ! Length of line        Input
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  integer, parameter :: nwhat=17
  character(len=12) :: status,what(nwhat),keyw
  character(len=6) :: ext(nwhat)
  character(len=filename_length) :: chain,filename
  character(len=132) :: name,cast,like
  character(len=commandline_length) :: trans
  integer :: ntype,i,nc,nn,nt,dtype(nwhat),itype,nlike,list(maxvar),in
  type(sic_descriptor_t) :: lkdesc
  logical :: global,do_like,found
  integer(kind=4) :: therank,istar,isize
  character(len=24) :: type,clength
  !
  ! CAUTION: The ordering cannot be changed in the following definitions.
  !
  ! Problem: fmt_r4 is -1 on VAX
  integer, parameter :: unused = 1000 ! > 10
  data dtype /fmt_r4,fmt_r8,fmt_i4,fmt_i8,fmt_l,0,  &
              fmt_c4,8,9,10,11,unused,unused, &
              unused,fmt_r4,unused,unused/
              ! ,fmt_r4, fmt_r4, fmt_r4, fmt_r4, unused/
  !
  data what /'REAL','DOUBLE','INTEGER','LONG','LOGICAL','CHARACTER',      &
    'COMPLEX','TABLE','STRUCTURE','IMAGE','HEADER','FUNCTION','COMMAND',  &
    'FITS','UVTABLE','ALIAS','LANGUAGE'/
  data ext /' ', ' ', ' ', ' ', ' ', ' ', &
    ' ','.tab', ' ', '.gdf', '.gdf', ' ', ' ', &
    '.fits', '.uvt', ' ', ' '/
  ! ,'VO_TABLE', 'TUV_TABLE', 'CLASS_TABLE', 'CLASS_VO', 'SPREADSHEET' /
  ! Code ----------------------------------------------------------------
  call sic_ke (line,0,1,type,nn,.true.,error)
  if (error) return
  !
  ! Set default character length if present...
  istar = index(type,'*')
  if (istar.ne.0) then
     clength = type(istar:nn)
     type(istar:) = ' '
  endif
  !
  ! Check if type of variable is known
  call sic_ambigs('DEFINE',type,keyw,ntype,what,nwhat,error)
  if (error) return
  if (istar.ne.0 .and. ntype.ne.6) then
     call sic_message(seve%e,'DEFINE '//keyw,' *Length not supported')
     error = .true.
     return
  endif
  !
  ! /GLOBAL option
  if (sic_present(1,0)) then
    global = .true.
  else
    ! If current level is non 0, variable is Local
    global = (var_level.le.0)
  endif
  !
  select case (keyw)
  case ('FUNCTION')
    call sic_ke (line,0,2,chain,nc,.true.,error)
    if (error) return
    call sic_ch (line,0,3,name,nn,.true.,error)
    if (error) return
    call sic_upper(name)
    call sic_def_expr(chain,nc,name,nn,error)
    return
    !
  case ('LANGUAGE')
    call sic_ke (line,0,2,chain,nc,.true.,error)
    if (error) return
    filename = ' '
    call sic_ch(line,0,3,filename,nn,.false.,error)
    if (error) return
    call sic_define_language(chain,filename,error)
    if (error)  return
    return
    !
  case ('COMMAND')
    call sic_ke(line,0,2,chain,nc,.true.,error)
    if (error) return
    call sic_ch(line,0,3,trans,nn,.true.,error)
    if (error) return
    filename = ' '
    call sic_ch(line,0,4,filename,nn,.false.,error)
    if (error) return
    !
    ! Insert in appropriate language and resolve language on return
    call sic_loadcom(filename,chain,trans,1,error)
    if (error)  return
    !
    return
    !
  case ('ALIAS')
    call sic_alias(line,global,error)
    return
    !
  case ('FITS')
    call sic_fits(line,global,error)
    return
  end select
  !
  ! /LIKE
  do_like = sic_present(2,0)
  if (do_like) then
    call sic_ke (line,2,1,like,nlike,.true.,error)
    if (error) return
  endif
  !
  ! Structures
  if (keyw.eq.'STRUCTURE') then
    do i=2,sic_narg(0)
      call sic_ke (line,0,i,name,nn,.true.,error)
      if (error) return
      call sic_crestructure(name,global,error)
      if (error) return
      !
      if (do_like) then  ! Fill the structure
        call gag_haslis(maxvar,pfvar,pnvar,list,in)
        call sic_define_likestruct(name,like,list,in,global,error)
        if (error) return
      endif
    enddo
    return
  endif
  !
  ! /LIKE
  cast = ' '
  if (do_like) then
    found = .true.
    call sic_materialize (like,lkdesc,found) ! Checked, but could be changed
    if (.not.found) then
      call sic_message(seve%e,'DEFINE /LIKE','No such variable '//like)
      error = .true.
      return
    endif
    !
    if (lkdesc%type.eq.0) then
      like = trim(like)//'%DATA'
      call sic_materialize(like,lkdesc,found)
      if (.not.found) then
        call sic_message(seve%e,'DEFINE /LIKE','No variable '//like)
        error = .true.
        return
      endif
    endif
    !
    call sic_define_likevar(lkdesc,cast)  ! Retrieve dimensions in 'cast'
    !
    call sic_volatile(lkdesc)    ! If it had been transposed...
  endif
  !
  ! Array-able variables (i.e. numerics and strings)
  if (ntype.le.7) then
    if (ntype.eq.3) then  ! DEFINE INTEGER
      itype = sicinteger
    else
      itype = dtype(ntype)
    endif
    do i=2,sic_narg(0)
      call sic_ke (line,0,i,name,nn,.true.,error)
      if (error) return
      !
      ! Insert default length if needed
      if (istar.ne.0) then
         isize = index(name,'*')
         if (isize.eq.0) then
            isize = index(name,'[')
            if (isize.ne.0) then
               name = name(1:isize-1)//trim(clength)//name(isize:)
            else
               name = trim(name)//trim(clength)
            endif
         endif
      endif
      !
      name = trim(name)//cast
      call sic_defvariable(itype,name,global,error)
      if (error) return
    enddo
  !
  ! Image, Headers and Tables
  elseif (ntype.ge.8) then
    if (sic_present(3,1)) then
      call sic_i4(line,3,1,therank,.false.,error)
      if (error) return
      if (therank.eq.0 .or. abs(therank).gt.sic_maxdims) then
        write(cast,'(A,I0,A,I0,A)') & 
        & 'Invalid trim value, must be in range [-', &
        & sic_maxdims,',-1] or [1,',sic_maxdims,']'
        call sic_message(seve%e,'DEFINE /TRIM',cast)
        error = .true.
        return
      endif
    else if (sic_present(3,0)) then
      therank = -10  ! Trim all dimensions
    else
      therank = 0  ! Option /TRIM was absent
    endif
    i = 2
    do while (i.le.sic_narg(0))
      ! Variable name
      call sic_ke (line,0,i,name,nn,.true.,error)
      if (error) return
      ! Add like-dimensions (if any)
      name(nn+1:) = cast
      ! Associated filename
      call sic_ch (line,0,i+1,chain,nt,.true.,error)
      if (error) return
      if (chain(1:nt).ne.'*') then
        call sic_parse_file(chain,' ',ext(ntype),filename)
      else
        filename = '*'
      endif
      ! Status
      call sic_ke (line,0,i+2,status,nt,.true.,error)
      if (error) return
      i = i+3
      !
      if (ntype.eq.8) then
        call sic_define_table (name,filename,status,global,2,error)
      elseif (ntype.eq.11) then
        call sic_define_header (name,filename,status,global,therank,error)
      elseif (ntype.eq.10) then
        call sic_define_image (name,filename,status,global,therank,error)
      elseif (ntype.eq.15) then
        call sic_define_uvtable (name,filename,status,global,0,error)
      endif
      if (error) return
    enddo
  endif
  !
end subroutine sic_define
!
subroutine sic_define_likevar(desc,cast)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_define_likevar
  use gildas_def
  use sic_types
  !---------------------------------------------------------------------
  ! @private
  ! Return the dimensions (if any) of variable described by the input
  ! descriptor. Return an empty string if this variable is a scalar.
  !---------------------------------------------------------------------
  type(sic_descriptor_t), intent(in)  :: desc  ! Variable descriptor
  character(len=*),       intent(out) :: cast  ! Dimensions as string
  ! Local
  integer :: i,nc
  !
  if (desc%ndim.ge.1) then
    write (cast,1010) (desc%dims(i),i=1,desc%ndim)
    nc = len_trim(cast)
    cast(nc:nc) = ']'
  else
    cast=' '
  endif
  !
1010 format('[',10(i0,','))  ! Support up to 10 dimensions
end subroutine sic_define_likevar
!
recursive subroutine sic_define_likestruct(newvar,like,inlist,nelem,global,error)
  use sic_interfaces, except_this=>sic_define_likestruct
  use gildas_def
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !    DEFINE STRUCTURE MYNEW /LIKE MYOLD
  ! Fill a (just defined) structure with the same tree as the other
  ! (already existing) structure given with option /LIKE.
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: newvar         ! Name of structure to be filled
  character(len=*), intent(in)    :: like           ! Name of structure used like
  integer,          intent(in)    :: nelem          ! Number of variables to check
  integer,          intent(in)    :: inlist(nelem)  ! List of variable to check
  logical,          intent(in)    :: global         ! Will new variable be global?
  logical,          intent(inout) :: error          ! Error flag
  ! Local
  integer, allocatable :: list(:)
  integer :: ielem,ik,sl,vtype,selected,ier
  character(len=varname_length) :: varname,structname,newvarsub
  character(len=132) :: cast
  !
  sl = len_trim(like)
  if (like(sl:sl).eq.'%') then
    structname = like
  else
    structname = trim(like)//'%'  ! MYOLD%
    sl = sl+1
  endif
  !
  ! 1/ Search structure elements
  allocate(list(nelem),stat=ier)
  selected = 0
  do ielem=1,nelem
    ik = inlist(ielem)
    varname = dicvar(ik)%id%name
    if (index(varname,structname(:sl)).eq.1) then  ! Begins with 'MYOLD%'
       selected = selected+1
       list(selected) = ik
    endif
  enddo
  !
  ! 2/ Loop over selected elements
  do ielem=1,selected
    ik = list(ielem)
    varname = dicvar(ik)%id%name
    if (index(varname(sl+1:),'%').eq.0) then  ! MYOLD%FOO
      ! Bind only variable at this level. Sub-elements in sub-structures will
      ! be bound in a recursion call.
      vtype = dicvar(ik)%desc%type
      newvarsub = trim(newvar)//'%'//varname(sl+1:)  ! MYNEW%FOO
      !
      if (vtype.eq.0) then
        ! A structure
        call sic_crestructure(newvarsub,global,error)
        if (error) exit  ! ielem
        call sic_define_likestruct(newvarsub,varname,list,selected,global,error)
      else
        ! Something else
        call sic_define_likevar(dicvar(ik)%desc,cast)
        call sic_defvariable(vtype,trim(newvarsub)//cast,global,error)
      endif
      if (error) exit  ! ielem
    endif
  enddo
  !
  deallocate(list)
  !
end subroutine sic_define_likestruct
!
function sic_checkstruct(namein,global)
  use gildas_def
  use gbl_message
  use sic_interfaces, except_this=>sic_checkstruct
  use sic_structures
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Check wether the name NAMEIN is a structure member. It is normally
  ! forbidden to attach a new element under a header/image, except for
  ! aliases.
  !
  ! Return values
  !     1        The parent structure exists
  !     0        There is no parent structure
  !     -1       This is not a structure member
  !---------------------------------------------------------------------
  integer(kind=4) :: sic_checkstruct      ! Function value on return
  character(len=*), intent(in) :: namein  ! Variable name
  logical,          intent(in) :: global  ! Input variable status
  ! Local
  character(len=*), parameter :: rname='CHECK'
  integer(kind=4) :: in,n,i,ier
  type(sic_identifier_t) :: parent
  logical :: isheader,allowed
  !
  sic_checkstruct = 0
  n = len_trim(namein)
  if (namein(n:n).eq.'%') then
    call sic_message(seve%e,rname,'Invalid structure member name '//  &
    namein(1:n-1))
    sic_checkstruct = 0
    return                     ! on error
  endif
  do i=n,2,-1
    if (namein(i:i).eq.'%') then ! seems to be a structure
      parent%name = namein(1:i-1)
      parent%lname = i-1
      ! Add the last Byte according to the parent structure status
      if (global) then
        parent%level = 0
      else
        parent%level = var_level
      endif
      ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,parent,in)
      if (ier.ne.1) then
        if (global) then
          call sic_message(seve%e,rname,  &
            'Global structure '//trim(parent%name)//' does not exist')
        else
          call sic_message(seve%e,rname,  &
            'Structure '//trim(parent%name)//' does not exist')
        endif
        sic_checkstruct = 0
        ! was a structure member of an unknown variable/struct
        return
      endif
      ! Check if it is a structure or a header
      isheader = associated(dicvar(in)%desc%head)
      if (dicvar(in)%desc%type.ne.0 .and. .not.isheader) then
        call sic_message(seve%e,rname,trim(parent%name)//' is not a structure')
        sic_checkstruct = 0
        return
      endif
      allowed = dicvar(in)%desc%status.eq.user_defined .or.  &
                dicvar(in)%desc%status.eq.program_defined .or.  &
                isheader
      if (.not.allowed) then
        call sic_message(seve%e,rname,'Not allowed on the structure '//parent%name)
        sic_checkstruct = 0
        return                 ! not a structure
      endif
      sic_checkstruct = 1
      return                   !good structure
    endif
  enddo
  sic_checkstruct = -1
  return                       !not a structure member
end function sic_checkstruct
!
subroutine sic_defvariable (type,namein,global,error)
  use sic_interfaces, except_this=>sic_defvariable
  use gildas_def
  use sic_dependencies_interfaces
  use sic_structures
  use sic_dictionaries
  use gbl_message
  use gbl_format
  !---------------------------------------------------------------------
  ! @ public (for Python port)
  !  Define a new user-defined variable (usually from command DEFINE).
  ! Variable necessarily has Read-Write access
  !---------------------------------------------------------------------
  integer                         :: type    ! Data type code          Input
  character(len=*)                :: namein  ! Variable name
  logical                         :: global  ! Is variable global?     Input
  logical,          intent(inout) :: error   ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='DEFINE'
  integer :: in,i,blank,zero,nchar,ier
  integer(kind=8) :: ntot
  integer(kind=8), parameter :: maxi4=2147483647_8 ! 2**31-1
  integer(kind=1) :: bblank(4)
  equivalence (blank,bblank)
  type(sic_identifier_t) :: var
  integer(kind=address_length) :: ipnt
  type(sic_dimensions_t) :: spec
  logical :: verbose,lglobal
  character(len=132) :: cast
  ! Data
  save blank
  data bblank /32,32,32,32/
  data zero /0/
  !
  ! Parse name from dimensions...
  spec%do%strict   = .true.   ! Can not be an expression like A[1].eq.B[1]
  spec%do%range    = .false.  ! A[2:4] forbidden
  spec%do%subset   = .false.  ! A[2,]  forbidden
  spec%do%implicit = .false.  ! e.g. A[i] forbidden
  spec%do%twospec  = .false.  ! e.g. A[i][j:k] forbidden
  verbose = .true.
  if (type.eq.0) then
    call sic_parse_char(namein,var,nchar,spec,verbose,error)
  else
    call sic_parse_dim (namein,var,      spec,verbose,error)
  endif
  if (.not.error) call sic_validname(var%name,error)
  if (error) then
    ! Invalid variable name, probably too long.
    call sic_message(seve%e,rname,'Invalid variable name '//namein)
    return
  endif
  !
  if (var_level.eq.0) then
    lglobal = .true.
  else
    lglobal = global
  endif
  !
  ! Check variable size
  ntot = 1
  do i=1,spec%done(1)%ndim
    ntot = ntot*spec%done(1)%dims(i,1)
  enddo
  if (ntot.gt.maxi4) then
    if (index_length.eq.4) then
      call sic_message(seve%e,rname,  &
      'Arrays of more than 2**31-1 elements not supported')
       error = .true.
    endif
  endif
  !
  ! Check if variable is already defined. First, variable must be either
  ! a true variable or a component of an existing structure.
  if (sic_checkstruct(var%name,lglobal).eq.0) then
    error = .true.
    return
  endif
  if (lglobal) then
    var%level = 0
  else
    var%level = var_level
  endif
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  if (ier.eq.1) then
    !  the actual size of the already-defined variable
    call sic_define_likevar(dicvar(in)%desc,cast)
    call sic_message(seve%e,rname,'Variable '//trim(var%name)//trim(cast)//' already exists')
    error = .true.
    return
  endif
  ier = sic_hasins(rname,maxvar,pfvar,pnvar,dicvar,var,in)
  if (ier.eq.0 .or. ier.eq.2) then
    error = .true.
    return
  endif
  !
  ! Fill the descriptor
  dicvar(in)%desc%ndim = spec%done(1)%ndim
  dicvar(in)%desc%dims(:) = spec%done(1)%dims(:,1)
  dicvar(in)%desc%status = user_defined
  dicvar(in)%desc%head => null()
  !
  ! Character variable
  if (type.eq.0) then
    dicvar(in)%desc%type = nchar
    dicvar(in)%desc%readonly = .false.
    ! Round up to an integer number of word
    dicvar(in)%desc%size = (ntot*nchar+3)/4
  elseif (type.gt.0) then
    dicvar(in)%desc%type = type
    dicvar(in)%desc%readonly = .false.
    dicvar(in)%desc%size = (ntot*type+3)/4
  else
    dicvar(in)%desc%type = type
    dicvar(in)%desc%readonly = .false.
    if (type.eq.fmt_r8) then
      dicvar(in)%desc%size = 2*ntot
    elseif (type.eq.fmt_c4) then
      dicvar(in)%desc%size = 2*ntot
    elseif (type.eq.fmt_i8) then
      dicvar(in)%desc%size = 2*ntot
    else
      dicvar(in)%desc%size = ntot
    endif
  endif
  ier = sic_getvm (dicvar(in)%desc%size,dicvar(in)%desc%addr)
  if (ier.ne.1) then
    call sic_message(seve%e,rname,'Memory allocation failure')
    ier = sic_hasdel(maxvar,pfvar,pnvar,dicvar,var)
    error = .true.
    return
  endif
  ipnt = gag_pointer(dicvar(in)%desc%addr,memory)
  !
  ! Initialize characters to blanks, and all others to zero
  if (type.ge.0) then
    call gdf_fill (dicvar(in)%desc%size,memory(ipnt),blank)
  else
    call gdf_fill (dicvar(in)%desc%size,memory(ipnt),zero)
  endif
  if (lglobal) then
    var_g = var_g-1
    var_pointer (var_g) = in
  else
    var_n = var_n+1
    var_pointer (var_n) = in
  endif
  error = .false.
  !
  ! Write into LUNSAV file if in SAVE mode
  if (lunsav.ne.0) then
    write(lunsav,'(A,1X,A)') savcom(1:lsavcom),trim(var%name)
  endif
  !
#if defined(GAG_USE_PYTHON)
  call gpy_getvar(var%name,var%level)
#endif
end subroutine sic_defvariable
!
subroutine sic_inivariable
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_inivariable
  use sic_dictionaries
  use gildas_def
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! SIC
  !     Initialize the variable structure list
  !---------------------------------------------------------------------
  ! Local
  character(len=*), parameter :: rname='INIVAR'
  integer :: ier
  character(len=message_length) :: mess
  !
  ! Check if user have customized its SIC_MAXVAR
  maxvar = maxvardef
  ier = sic_getlog('SIC_MAXVAR',maxvar)
  if (ier.eq.0) then
    write(mess,'(A,I0)')  'User-defined SIC_MAXVAR is ',maxvar
    call sic_message(seve%d,rname,mess)
  elseif (ier.eq.2) then
    call sic_message(seve%f,rname,  &
      'Could not decode user-defined SIC_MAXVAR logical variable')
    call sysexi(fatale)
  endif
  !
  ! Allocate variable arrays
  allocate(dicvar(maxvar),pnvar(maxvar),var_pointer(maxvar),    &
  &  alias(maxvar),dicali(maxvar),pointee(maxvar),stat=ier)
  if (ier.ne.0) then
     call sic_message(seve%f,rname,'Insufficient memory for Dictionary')
     call sysexi(fatale)
  endif
  !
  ! Initialize arrays
  call gag_hasini(maxvar,pfvar,pnvar)
  var_g = maxvar+1
  var_n = 0
  nalias = 0
  !
end subroutine sic_inivariable
!
subroutine sic_define_image(namein,file,status,global,therank,error)
  use gildas_def
  use sic_dependencies_interfaces
  use sic_structures
  use sic_dictionaries
  use sic_define_status
  use sic_interfaces, except_this=>sic_define_image
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !     Define a new variable associated to an image file from command
  !     DEFINE IMAGE Variable File Read|Write|Integer|Real|Double|Extend
  !     Variable may have ReadOnly protection.
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: namein   ! Variable name
  character(len=*), intent(in)    :: file     ! Associated file name
  character(len=*), intent(in)    :: status   ! Variable type / status
  logical,          intent(in)    :: global   ! Global or Local variable
  integer(kind=4),  intent(in)    :: therank  ! Trim degenerate dimensions
  logical,          intent(inout) :: error    ! Return error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='DEFINE'
  integer(kind=4) :: in,istat,ier,actual_rank
  integer(kind=address_length) :: ipnt
  type(sic_identifier_t) :: var
  type(sic_descriptor_t) :: desc
  integer(kind=4), parameter :: mstates=8
  character(len=8) :: keyw,states(mstates)
  logical :: do_header,rdonly
  character(len=132) :: mess
  type(sic_dimensions_t) :: spec
  logical :: verbose
  ! EXTEND must be the last one
  data states/'READ','WRITE','INTEGER','LONG','REAL','DOUBLE','COMPLEX','EXTEND'/
  integer :: code
  !
  code = code_image  ! Need IMAGE data
  do_header = .true.
  goto 10
  !
entry sic_define_uvtable (namein,file,status,global,therank,error)
  code = code_uv
  do_header = .true.
  goto 10
  !
entry sic_define_table (namein,file,status,global,therank,error)
  code = code_table
  do_header = .false.
  !
10 continue
  !
  ! Check STATUS
  call sic_ambigs('IMAGE',status,keyw,istat,states,mstates,error)
  if (error) return
  !
  ! Parse name from dimensions...
  spec%do%strict   = .true.   ! Can not be an expression like A[1].eq.B[1]
  spec%do%range    = .false.  ! A[2:4] forbidden
  spec%do%subset   = .false.  ! A[2,]  forbidden
  spec%do%implicit = .false.  ! e.g. A[i] forbidden
  spec%do%twospec  = .false.  ! e.g. A[i][j:k] forbidden
  verbose = .true.
  call sic_parse_dim(namein,var,spec,verbose,error)
  if (error)  return
  call sic_validname(var%name,error)
  if (error) return
  if (istat.le.2 .and. spec%done(1)%ndim.ne.0) then
    call sic_message(seve%e,rname,'Cannot specify dimension for existing '//  &
    'image')
    error = .true.
    return
  elseif (istat.ge.3 .and. spec%done(1)%ndim.eq.0) then
    call sic_message(seve%e,rname,'Missing dimension of new image')
    error = .true.
    return
  elseif (istat.eq.mstates .and. spec%done(1)%ndim.ne.1) then
    call sic_message(seve%e,rname,'Only last dimension can be extended')
    error = .true.
    return
  endif
  !
  ! Check if variable is already defined. First, variable must be either
  ! a true variable or a component of an existing structure.
  if (sic_checkstruct(var%name,global).eq.0) then
    error = .true.
    return
  endif
  if (var%lname.gt.varname_length-12) then
    write(mess,1001) 'IMAGE names must be at most ',varname_length-12,' char'
    call sic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  if (global) then
    var%level = 0
  else
    var%level = var_level
  endif
  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
  !
  ! Readonly Status
  rdonly = istat.eq.1
  !
  if (istat.eq.mstates) then
    call sic_define_extend_file(file,spec%done(1)%dims(1,1),desc,error)
    actual_rank = desc%ndim
    !
  elseif (istat.gt.2) then  ! Create a new file
    if (code.eq.code_uv) then
      ! How to check table size?
      call sic_define_new_uvtable(file,spec%done(1)%ndim,spec%done(1)%dims,desc,istat,error)
    else
      call sic_define_new_file(file,spec%done(1)%ndim,spec%done(1)%dims,desc,istat,code,error)
    endif
    actual_rank = desc%ndim
    !
  else  ! READ or WRITE: reopen an old file
    actual_rank = therank
    call sic_define_old_file(file,code,rdonly,actual_rank,desc,error)
  endif
  if (error) return
  !
  ier = sic_hasins(rname,maxvar,pfvar,pnvar,dicvar,var,in)
  if (ier.eq.0 .or. ier.eq.2) then
    error = .true.
    return
  endif
  !
  if (global) then
    var_g = var_g-1
    var_pointer (var_g) = in
  else
    var_n = var_n+1
    var_pointer (var_n) = in
  endif
  dicvar(in)%desc = desc
  !
  ! Header if required
  if (do_header) then
    call sub_def_header(var,'%',desc%head,rdonly,actual_rank,error)
    ! Define Var%RDONLY to be able to access the Read Status.
    call sub_def_logi(trim(var%name)//'%RDONLY',dicvar(in)%desc%readonly, &
      .true.,var%level,error)
#if defined(GAG_USE_PYTHON)
    call gpy_getvar(var%name,var%level)
#endif
    !
    ! And extra data if required & possible
    if (code.eq.code_uv) then
      call sic_def_uvcoor(var,memory(ipnt),desc,rdonly,error)
    endif
  endif
  !
#if defined(GAG_USE_PYTHON)
  call gpy_getvar(var%name,var%level)
#endif
  !
1001 format(a,i2,a)
end subroutine sic_define_image
!
subroutine sic_define_old_file(filename,code,rdonly,rank,desc,error)
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_define_old_file
  use sic_define_status
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  ! Support subroutine for
  !   DEFINE HEADER
  !   DEFINE IMAGE
  !   DEFINE TABLE
  !   DEFINE UVTABLE
  ! Open an old (already existing) file and fill the corresponding Sic
  ! structure, mapped on a GIO slot
  !---------------------------------------------------------------------
  character(len=*),       intent(in)    :: filename  !
  integer(kind=4),        intent(in)    :: code      ! Kind of object (header, image, uv...)
  logical,                intent(in)    :: rdonly    !
  integer(kind=4),        intent(inout) :: rank      ! Desired rank (in) / actual rank (out)
  type(sic_descriptor_t), intent(out)   :: desc      !
  logical,                intent(inout) :: error     !
  ! Local
  character(len=*), parameter :: rname='DEFINE'
  integer(kind=4) :: filekind
  !
  if (filename.eq.'*') then
    filekind = 1  ! GDF
  else
    call gag_file_guess(rname,filename,filekind,error)
    if (error)  return
  endif
  !
  if (filekind.eq.2 .and. (code.eq.code_header .or. code.eq.code_image)) then
    ! DEFINE IMAGE|HEADER on a FITS file
    if (.not.rdonly) then
      call sic_message(seve%e,rname,'FITS file can only be opened with READ status')
      error = .true.
      return
    endif
    call sic_define_map_fits(filename,code,desc,rank,error)
    if (error)  return
    rank = desc%head%gil%ndim
    !
  else
    ! A GDF file, or a FITS UV or table
    call sic_define_map_file(filename,desc,rdonly,code,rank,error)
    if (error)  return
  endif
  !
end subroutine sic_define_old_file
!
subroutine sic_define_map_file(file,desc,rdonly,code,therank,error)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_define_map_file
  use gildas_def
  use image_def
  use gbl_format
  use gbl_message
  use sic_define_status
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Map an existing image, or a virtual buffer, in a gio image slot, in
  ! ReadOnly or ReadWrite.
  !---------------------------------------------------------------------
  character(len=*),       intent(in)    :: file     ! Image name
  type(sic_descriptor_t), intent(out)   :: desc     ! Descriptor
  logical,                intent(in)    :: rdonly   ! Open in Read Only
  integer(kind=4),        intent(in)    :: code     ! Kind of object (header, image, uv...)
  integer(kind=4),        intent(inout) :: therank  ! Trim trailing dimensions
  logical,                intent(inout) :: error    ! Error flag
  ! Local
  integer(kind=4) :: is,form,ms,myseve
  integer(kind=size_length) :: size
  integer(kind=index_length) :: whole(gdf_maxdims) = 0
  integer(kind=address_length) :: addr
  character(len=12) :: gtype
  character(len=60) :: mess
  character(len=14) :: rname
  !
  call gio_geis (is,error)
  if (error) return
  !
  if (rdonly) then
    call gio_reis (is,gtype,file,form,size,error)
    desc%type = form
  else
    if (file.eq.'*') then
      if (code.eq.code_header_uv) then
        gtype = 'GILDAS_UVFIL'
      else
        gtype = 'GILDAS_IMAGE'
      endif
      call gio_crws (is,gtype,form,size,error)
    else
      call gio_wris (is,gtype,file,form,size,error)
    endif
    desc%type = form
  endif
  if (error) goto 99
  !
  desc%readonly = rdonly
  !
  !!Print *,'After GDF_REIS or WRIS Form ',form
  !
  if (form.eq.fmt_r8 .or. form.eq.fmt_i8 .or. form.eq.fmt_c4)  size = 2*size
  !
  if (code.eq.code_header       .or.  &
      code.eq.code_header_image .or.  &
      code.eq.code_header_uv) then
    rname = 'DEFINE HEADER'
    !
    ! option /RANK checking, although the job is done later in some case
    call gdf_dims(is,desc%ndim,desc%dims)
    call trim_rank(rname,desc%ndim,desc%dims,therank,error)
    if (error) goto 99
    !
    desc%type = 0
    desc%addr = ptr_null
    desc%ndim = 0
    desc%dims(:) = 0
    desc%size = 0
    desc%status = 0
  else
    if (code.eq.code_image) then
      rname = 'DEFINE IMAGE'
      if (gtype.ne.'GILDAS_IMAGE') then
        mess = 'Mismatch '//gtype//' for Image'
        error = .true.
      endif
    else if (code.eq.code_uv) then
      rname = 'DEFINE UVTABLE'
      if (gtype.ne.'GILDAS_UVFIL') then
        mess = 'Mismatch '//gtype//' for UV data'
        error = .true.
      endif
    endif
    if (error) then
      if (strict_define) then
        myseve = seve%e
      else
        myseve = seve%w
        error = .false.
      endif
      call sic_message(myseve,rname,mess)
      if (error) then
         call sic_message(seve%i,rname,'You can turn off checking with '// &
           'SIC%DEFINE_STRICT = NO')
         goto 99
      endif
    endif
    !
    call gio_gems (ms,is,whole,whole,addr,form,error)
    !!Print *,'After GDF_GEMS'
    !!call gio_dump_slot(is) ! Test
    if (error) goto 99
    call adtoad(addr,desc%addr,1) ! Copy to C_PTR if needed
    call gdf_dims(is,desc%ndim,desc%dims)
    !
    ! Check image size
    call desc_toobig(desc,error)
    if (error)  goto 98
    !
    ! option /RANK: adjust array rank to desired shape
    call trim_rank(rname,desc%ndim,desc%dims,therank,error)
    if (error) goto 98
    !
    desc%size = size
  endif
  !
  desc%status = is
  call gdf_geih(desc%status,desc%head,error)
  if (error)  goto 98
  return
  !
98 call gio_frms (ms,error)
99 call gio_fris (is,error)
  error = .true.
end subroutine sic_define_map_file
!
subroutine sic_define_map_fits(file,code,desc,rank,error)
  use gildas_def
  use gbl_message
  use image_def
  use gfits_types
  use sic_dependencies_interfaces, no_interface=>fitscube2gdf_patch_bval
  use sic_interfaces, except_this=>sic_define_map_fits
  use sic_dictionaries
  use sic_types
  use sic_define_status
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !  DEFINE IMAGE|HEADER Var FitsFile READ
  ! i.e. fill (memory-only) a FITS file to a GDF image structure and map
  ! it on a GIO slot
  !---------------------------------------------------------------------
  character(len=*),       intent(in)    :: file   !
  integer(kind=4),        intent(in)    :: code   ! Kind of object (header, image, uv...)
  type(sic_descriptor_t), intent(out)   :: desc   !
  integer(kind=4),        intent(inout) :: rank   ! Desired rank (in) / actual rank (out)
  logical,                intent(inout) :: error  !
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='DEFINE'
  integer(kind=4) :: is,ms,fdata
  integer(kind=4), parameter :: khdu=1  ! Desired HDU. 1 is Primary HDU.
  integer(kind=size_length) :: nfill,ndata,sdata,nblank
  type(gildas) :: fits
  integer(kind=index_length) :: whole(gdf_maxdims)
  integer(kind=address_length) :: ipnt
  character(len=12) :: gtype
  type(gfits_hdesc_t) :: fd
  character(len=message_length) :: mess
  !
  if (code.eq.code_uv .or. code.eq.code_table) then
    ! Early exit in this case
    call sic_message(seve%e,rname,'Reading FITS file as TABLE or UVTABLE is not implemented')
    error = .true.
    return
  endif
  !
  ! Open FITS file, including basic sanity checks
  call gfits_open(file,'IN',error)
  if (error)  return
  call gfits_goto_hdu(fd,khdu,error)
  if (error)  goto 10
  !
  ! --- Read the header (always) ---
  call gildas_null(fits)
  !
  call fitscube2gdf_header(file,khdu,fd,fits,sic_getsymbol,error)
  if (error)  goto 10
  !
  ! --- Trim image rank if needed ---
  call trim_rank(rname,fits%gil%ndim,fits%gil%dim,rank,error)
  if (error)  goto 10
  !
  ! --- Data description (useful even in case of code_header) ---
  ndata = product(fits%gil%dim(1:fits%gil%ndim))  ! Number of elements
  sdata = ndata   ! Size of data. This assumes R*4 data (i.e. should be twice for R*8)
  fdata = fmt_r4  ! Format of data
  !
  ! --- Descriptor (first part) ---
  if (code.eq.code_header) then
    ! Data is not requested
    desc%type = 0     ! A pure header with no data associated
    desc%size = 0     ! Yes, the header variable has no data size associated
    desc%ndim = 0     ! Yes, the header variable has no data dimensions associated
    desc%dims(:) = 0  !
    gtype = 'GILDAS_IMAGE'
    !
  else if (code.eq.code_image) then
    ! Read and store data in a permanent place
    desc%type = fdata
    desc%ndim = fits%gil%ndim
    desc%dims(:) = fits%gil%dim(:)
    desc%size = sdata
    gtype = 'GILDAS_IMAGE'
    !
  else
    call sic_message(seve%e,rname,'Not implemented')
    error = .true.
    goto 10
  endif
  !
  ! --- GIO image slot ---
  !
  ! Prepare slot in gio
  ms = 0  ! Just in case of error recovery
  call gio_geis(is,error)
  if (error)  goto 10
  !
  call gio_write_header(fits,is,error)
  if (error)  goto 20
  !
  ! Now declare properly the gio image slot (CREate Work Slot)
  call gio_crws(is,gtype,fdata,sdata,error)
  if (error)  goto 20
  !
  ! --- Data? ---
  if (code.eq.code_header) then
    desc%addr = ptr_null  ! Data address: none
    !
  elseif (code.eq.code_image) then
    whole(:) = 0
    call gio_gems(ms,is,whole,whole,desc%addr,desc%type,error)
    if (error) goto 20
    !
    ! Make sure the FITS file is at the right position
    nfill = 0
    call gfits_flush_data(error)
    if (error)  goto 20
    !
    ! Read all data at once, as DEFINE IMAGE needs all the data loaded in memory
    ipnt = gag_pointer(desc%addr,memory)
    call read_allmap(fd,memory(ipnt),ndata,nfill,fits%gil%bval,error)
    if (nfill.lt.ndata)  &
      call sic_message(seve%w,rname,'FITS data file is incomplete')
    if (error)  goto 20
    !
    nblank = 0
    call fitscube2gdf_patch_bval(fd,fits,memory(ipnt),ndata,nblank,error)
    if (error)  goto 20
    if (nblank.eq.0) then
      call sic_message(seve%d,rname,'No blank data in FITS file')
      fits%gil%eval = -1.0
      call gio_write_header(fits,is,error)  ! Update image header in GIO
      if (error)  goto 20
    else
      write(mess,'(A,I0,A)') 'Patched ',nblank,' blank data'
      call sic_message(seve%d,rname,mess)
    endif
    !
  endif
  !
  ! --- Descriptor (remaining parts) ---
  call gdf_geih(is,desc%head,error)  ! Get pointer to header in GIO
  if (error)  goto 20
  desc%head%file = file  ! Save origin in GIO header slot, just for consistency
  desc%status = is
  desc%readonly = .true.
  !
  ! At this stage the descriptor describes where to find the data, if
  ! any (desc%addr). Now we give hand back to subroutine
  ! 'sic_define_image' which will:
  !  - insert the new variable in the dictionary, given the
  !    descriptor above,
  !  - build all the header variables thanks to the type(gildas) in desc%head
  !
  ! Error recovery
20 continue
   if (error) then
     if (ms.ne.0)  call gio_frms(ms,error)
     call gio_fris(is,error)
   endif
10 continue
  call gfits_close(error)
  !
end subroutine sic_define_map_fits
!
subroutine sic_define_new_file (file,ndim,dim,desc,istat,code,error)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_define_new_file
  use image_def
  use gbl_format
  use gbl_message
  use sic_dictionaries
  use sic_types
  use sic_define_status
  !---------------------------------------------------------------------
  ! @ private
  ! SIC Internal routine
  !     Creates a new image of specified dimensions. The
  !     increments along each axis are initialized to 1.
  !---------------------------------------------------------------------
  character(len=*) :: file              ! Image file name       Input
  integer :: ndim                       ! Number of dimensions  Input
  integer(kind=index_length), intent(in) :: dim(ndim)  ! Dimensions
  type(sic_descriptor_t) :: desc        ! Returned descriptor   Output
  integer(kind=4), intent(in) :: istat  ! Code for format
  integer(kind=4), intent(in) :: code   ! Code for type of image
  logical :: error                      ! Logical error flag    Output
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='DEFINE'
  integer(kind=4) :: is,form,ms
  integer(kind=size_length) :: size
  integer(kind=index_length) :: whole(gdf_maxdims) = 0
  integer(kind=address_length) :: addr
  integer(kind=address_length) :: ipnt
  integer :: i
  type (gildas) :: x
  character(len=message_length) :: mess
  !
  if (ndim.gt.gdf_maxdims) then
    write (mess,'(A,I0,A,I0,A)')  &
      'Gildas images can have at most ',gdf_maxdims,' dimensions (',ndim,' given)'
    call sic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  ! This is a patch for creation of Old GILDAS data format...
  if (ndim.gt.4) then
    if (gdf_stbl_get().eq.1) then
      write (mess,'(A,I0,A)')  &
      'Old Format Gildas images can have at most 4 dimensions (',ndim,' given)'
      call sic_message(seve%e,rname,mess)
      error = .true.
      return
    endif
  endif
  !
  call gildas_null(x)
  !
  if (istat.eq.3) then
    desc%size = 1
    form = fmt_i4
  elseif (istat.eq.4) then
    desc%size = 2
    form = fmt_i8
  elseif (istat.eq.5) then
    desc%size = 1
    form = fmt_r4
  elseif (istat.eq.6) then
    desc%size = 2
    form = fmt_r8
  elseif (istat.eq.7) then
    desc%size = 2
    form = fmt_c4
  endif
  !
  desc%ndim = ndim
  desc%dims = 0  ! To initialize all SIC dimensions
  x%gil%ndim = ndim
  do i=1,ndim
    desc%dims(i) = dim(i)
    desc%size = desc%size*dim(i)
    x%gil%dim(i) = dim(i)
    x%gil%convert(:,i) = 1.d0
  enddo
  do i=ndim+1,gdf_maxdims
    desc%dims(i) = 1
    x%gil%dim(i) = 1
    x%gil%convert(:,i) = 0.d0
  enddo
  !
  ! Check image size
  call desc_toobig(desc,error)
  if (error)  return
  !
  if (code.eq.code_table) then
    ! For TABLES, could reset section lengths to zero...
    x%gil%type_gdf = code_gdf_table
    x%gil%dim_words = 2*gdf_maxdims+2
  else
    x%gil%type_gdf = code_gdf_image
    x%gil%dim_words = 2*gdf_maxdims+2
  endif
  !
  error = .false.
  call gio_geis (is,error)
  if (error) return
  !
  call gio_write_header (x,is,error)
  !
  if (error) return
  if (form.eq.fmt_r8 .or. form.eq.fmt_i8) then
    size = desc%size/2
  else
    size = desc%size
  endif
  if (file.eq.'*') then
    call gio_crws (is,'GILDAS_IMAGE',form,size,error)
  else
    call gio_cris (is,'GILDAS_IMAGE',file,form,size,error)
  endif
  if (error) return
  call gio_gems (ms,is,whole,whole,addr,form,error)
  if (error) return
  ipnt = gag_pointer(addr,memory)
  call gdf_fill (desc%size,memory(ipnt),0.0)
  desc%type = form
  desc%readonly = .false.
  call adtoad(addr,desc%addr,1)
  desc%status = is
  call gdf_geih(desc%status,desc%head,error)
  if (error)  return
  !
end subroutine sic_define_new_file
!
subroutine sic_define_new_uvtable(file,ndim,dim,desc,istat,error)
  use image_def
  use gbl_message
  use gbl_format
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_define_new_uvtable
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Creates a new image of specified dimensions. The increments along
  ! each axis are initialized to 1.
  !---------------------------------------------------------------------
  character(len=*),           intent(in)    :: file       ! Image file name
  integer(kind=4),            intent(in)    :: ndim       ! Number of dimensions
  integer(kind=index_length), intent(in)    :: dim(ndim)  ! Dimensions
  type(sic_descriptor_t)                    :: desc       ! Returned decriptor
  integer(kind=4),            intent(in)    :: istat      ! Code for format
  logical,                    intent(inout) :: error      ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='DEFINE'
  integer(kind=address_length) :: ipnt,addr
  integer(kind=4) :: i,is,form,ms,vaxi,saxi,nf
  integer(kind=size_length) :: size
  integer(kind=index_length) :: whole(gdf_maxdims) = 0
  type(gildas) :: x
  character(len=message_length) :: mess
  character(len=3) :: ttype
  !
  if (ndim.gt.gdf_maxdims) then
    write (mess,'(A,I0,A,I0,A)')  &
      'Gildas UV tables can have at most ',gdf_maxdims,' dimensions (',ndim,' given)'
    call sic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  ! Try to guess if we are creating an UVT or transposed TUV
  nf = len_trim(file)
  if (file(nf-3:nf).eq.'.tuv') then
    ! TUV order
    vaxi = 1       ! Visibility axis
    saxi = 2       ! Stokes axis
    ttype = 'TUV'  ! Table type
  else
    ! UVT order
    vaxi = 2
    saxi = 1
    ttype = 'UVT'
  endif
  !
  error = .false.
  if (istat.ne.5) then
    call sic_message(seve%e,rname,'Only REAL format for UV Tables')
    error = .true.
  endif
  if (ndim.ne.2) then
    call sic_message(seve%e,rname,'UV Tables must have 2 dimensions')
    error = .true.
  endif
  if (dim(saxi).lt.10) then
    call sic_message(seve%e,rname,'UV tables Stokes dimension must be at least 10')
    error = .true.
  endif
  if (error) return
  !
  call gio_geis (is,error)
  if (error) return
  !
  ! The GIO now has a better initialization routine
  call gildas_null(x, type=ttype)
  desc%size = 1
  form = fmt_r4
  desc%ndim = ndim
  desc%dims = 0   ! To initialize all dimensions
  x%gil%ndim = ndim
  do i=1,ndim
    desc%dims(i) = dim(i)
    desc%size = desc%size*dim(i)
    x%gil%dim(i) = dim(i)
    x%gil%convert(:,i) = 1.d0
  enddo
  do i=ndim+1,gdf_maxdims
    desc%dims(i) = 1
    x%gil%dim(i) = 1
    x%gil%convert(:,i) = 0.d0
  enddo
  x%gil%dim_words = 2*gdf_maxdims+2
  x%gil%nchan = (x%gil%dim(saxi)-7)/3
  x%gil%nvisi = x%gil%dim(vaxi)
  !
  error = .false.
  call gio_write_header (x,is,error)
  if (error) return
  if (form.eq.fmt_r8 .or. form.eq.fmt_i8) then
    size = desc%size/2
  else
    size = desc%size
  endif
  call gio_cris (is,'GILDAS_UVFIL',file,form,size,error)
  if (error) return
  call gio_gems (ms,is,whole,whole,addr,form,error)
  if (error) return
  ipnt = gag_pointer(addr,memory)
  call gdf_fill (desc%size,memory(ipnt),0.0)
  desc%type = form
  desc%readonly = .false.
  call adtoad(addr,desc%addr,1)
  desc%status = is
  call gdf_geih(desc%status,desc%head,error)
  if (error)  return
  !
end subroutine sic_define_new_uvtable
!
subroutine sic_define_extend_file (file,newdim,desc,error)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_define_extend_file
  use image_def
  use gbl_format
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  ! SIC Internal routine
  !  Extend an existing image by increasing its LAST dimension
  !---------------------------------------------------------------------
  character(len=*),           intent(in)    :: file    ! Image file name
  integer(kind=index_length), intent(in)    :: newdim  ! New value of last dimension
  type(sic_descriptor_t),     intent(out)   :: desc    ! Returned descriptor
  logical,                    intent(inout) :: error   ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  integer(kind=address_length) :: ipnt,addr
  integer(kind=index_length) :: whole(gdf_maxdims)=0
  character(len=12) :: gtype
  integer(kind=4) :: is,form,ms
  integer(kind=size_length) :: osize,nsize
  integer(kind=index_length) :: olddim
  type(gildas) :: x
  !
  call gildas_null(x)
  !
  call gio_geis (is,error)
  if (error) return
  call gio_wris (is,gtype,file,form,osize,error)
  if (error) return
  desc%type = form
  desc%readonly = .false.
  call gio_read_header(x,is,error)
  if (error) return
  !
  ! Now extend it if needed
  if (x%gil%ndim.lt.1) then
    x%gil%ndim = 1
    x%gil%dim = 1
    x%gil%convert = 1.d0
  endif
  olddim = x%gil%dim(x%gil%ndim)
  !
  if (newdim.gt.olddim) then
    ! Actual extension
    nsize = osize / olddim * newdim
    !
    x%gil%dim(x%gil%ndim) = newdim
    call gio_write_header(x,is,error)
    if (error) return
    call gio_clis (is,error)  ! Close image slot
    !
    call gio_exis (is,gtype,file,form,nsize,error)
    if (error) return
  else
    ! Already large enough, nothing to be done
    nsize = osize
  endif
  call gio_gems (ms,is,whole,whole,addr,form,error)
  if (error) return
  !
  ! Define descriptor
  if (form.eq.fmt_r8) then
    osize = 2*osize
    nsize = 2*nsize
  endif
  call adtoad(addr,desc%addr,1)
  desc%ndim = x%gil%ndim
  desc%dims(:) = 0
  desc%dims(1:desc%ndim) = x%gil%dim(1:x%gil%ndim)
  desc%size = nsize
  desc%status = is
  call gdf_geih(desc%status,desc%head,error)
  if (error)  return
  !
  if (nsize.gt.osize) then
    ! Zero fill the extended part
    ipnt = gag_pointer(addr,memory)
    call gdf_fill (nsize-osize,memory(ipnt+osize),0.0)
  endif
end subroutine sic_define_extend_file
!
subroutine sic_crestructure(namein,global,error)
  use sic_interfaces, except_this=>sic_crestructure
  use gildas_def
  use sic_structures
  use sic_dictionaries
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public (for Python port)
  !     Define a new structure from command
  !     DEFINE STRUCT Variable Read|Write
  !     Variable may have ReadOnly protection.
  !---------------------------------------------------------------------
  character(len=*)                :: namein  ! Structure name
  logical                         :: global  ! Local / Global flag        Input
  logical,          intent(inout) :: error   ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='DEFINE'
  integer(kind=4) :: in,ier
  type(sic_identifier_t) :: var
  character(len=132) :: mess
  type(sic_dimensions_t) :: spec
  logical :: verbose,lglobal
  !
  ! Parse name from dimensions...
  spec%do%strict   = .true.   ! Can not be an expression like A[1].eq.B[1]
  spec%do%range    = .false.  ! A[2:4] forbidden
  spec%do%subset   = .false.  ! A[2,]  forbidden
  spec%do%implicit = .false.  ! e.g. A[i] forbidden
  spec%do%twospec  = .false.  ! e.g. A[i][j:k] forbidden
  verbose = .true.
  call sic_parse_dim(namein,var,spec,verbose,error)
  if (error)  return
  if (spec%done(1)%ndim.ne.0) then
    call sic_message(seve%e,rname,'Structure cannot have Dimensionality')
    error = .true.
    return
  endif
  ! Here NAMEIN has no dimensionality:
  ! Strip off the superfluous % at the end.
  if (var%name(var%lname:var%lname).eq.'%') then
    var%name(var%lname:var%lname) = ' '
    var%lname = var%lname-1
  endif
  ! Save 12 char at the end as a strict minimum for structure members
  if (var%lname.gt.varname_length-12) then
    write(mess,1001) 'STRUCTURE names must be at most ',varname_length-12,' char'
    call sic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  if (var_level.eq.0) then
    lglobal = .true.
  else
    lglobal = global
  endif
  !
  ! Check if variable is already defined.
  ! As a component of an existing structure.
  if (sic_checkstruct(var%name,lglobal).eq.0) then
    error = .true.
    return
  endif
  ! or as a simple variable
  if (lglobal) then
    var%level = 0
  else
    var%level = var_level
  endif
  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
  !
  ! Define the "generic" structure name
  ier = sic_hasins(rname,maxvar,pfvar,pnvar,dicvar,var,in)
  if (ier.eq.0 .or. ier.eq.2) then
    error = .true.
    return
  endif
  !
  ! Setup the back pointer
  if (lglobal) then
    var_g = var_g-1
    var_pointer (var_g) = in
  else
    var_n = var_n+1
    var_pointer (var_n) = in
  endif
  dicvar(in)%desc%type = 0
  dicvar(in)%desc%readonly = .false.
  dicvar(in)%desc%head => null()
  dicvar(in)%desc%addr = ptr_null
  dicvar(in)%desc%ndim = 0
  dicvar(in)%desc%dims(:) = 0
  dicvar(in)%desc%size = 0
  dicvar(in)%desc%status = user_defined
  !
#if defined(GAG_USE_PYTHON)
  call gpy_getvar(var%name,var%level)
#endif
  return
  !
1001 format(a,i2,a)
end subroutine sic_crestructure
!
subroutine sic_defstructure(namein,global,error)
  use sic_interfaces, except_this=>sic_defstructure
  use gildas_def
  use sic_structures
  use sic_dictionaries
  use sic_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  !     Define a new structure from program.
  !     Variable may have ReadOnly protection ?
  !---------------------------------------------------------------------
  character(len=*) :: namein        ! Structure name
  logical :: global                 ! Local / Global flag        Input
  logical :: error                  ! Logical error flag         Output
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='DEFINE'
  integer(kind=4) :: in,ier
  type(sic_identifier_t) :: var
  character(len=132) :: mess
  type(sic_dimensions_t) :: spec
  logical :: verbose
  !
  ! Parse name from dimensions...
  spec%do%strict   = .true.   ! Can not be an expression like A[1].eq.B[1]
  spec%do%range    = .false.  ! A[2:4] forbidden
  spec%do%subset   = .false.  ! A[2,]  forbidden
  spec%do%implicit = .false.  ! e.g. A[i] forbidden
  spec%do%twospec  = .false.  ! e.g. A[i][j:k] forbidden
  verbose = .true.
  call sic_parse_dim(namein,var,spec,verbose,error)
  if (error)  return
  if (spec%done(1)%ndim.ne.0) then
    call sic_message(seve%e,rname,'Structure cannot have Dimensionality')
    error = .true.
    return
  endif
  ! Here NAMEIN has no dimensionality:
  ! Strip off the superfluous % at the end.
  if (var%name(var%lname:var%lname).eq.'%') then
    var%name(var%lname:var%lname)= ' '
    var%lname = var%lname-1
  endif
  ! Save 12 char at the end as a strict minimum for structure members
  if (var%lname.gt.varname_length-12) then
    write(mess,1001) 'STRUCTURE names must be at most ',varname_length-12,' char'
    call sic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  ! Check if variable is already defined.
  ! As a component of an existing structure.
  if (sic_checkstruct(var%name,global).eq.0) then
    error = .true.
    return
  endif
  ! or as a simple variable
  if (global) then
    var%level = 0
  else
    var%level = var_level
  endif
  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
  !
  ! Define the "generic" structure name
  ier = sic_hasins(rname,maxvar,pfvar,pnvar,dicvar,var,in)
  if (ier.eq.0 .or. ier.eq.2) then
    error = .true.
    return
  endif
  !
  ! Setup the program defined indicator
  dicvar(in)%desc%type = 0
  dicvar(in)%desc%readonly = .false.
  dicvar(in)%desc%head => null()
  dicvar(in)%desc%addr = ptr_null
  dicvar(in)%desc%ndim = 0
  dicvar(in)%desc%dims(:) = 0
  dicvar(in)%desc%size = 0
  dicvar(in)%desc%status = program_defined
  !
#if defined(GAG_USE_PYTHON)
  call gpy_getvar(var%name,var%level)
#endif
  return
  !
1001 format(a,i2,a)
end subroutine sic_defstructure
!
subroutine sic_define_header(namein,file,status,global,therank,error)
  use gildas_def
  use sic_dependencies_interfaces 
  use sic_interfaces, except_this=>sic_define_header
  use sic_structures
  use sic_dictionaries
  use gbl_message
  use sic_define_status
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  ! SIC Internal routine
  !     Define a new variable associated to an image header, from command
  !     DEFINE HEADER Variable File Read|Write  /TRIM [Rank]
  ! and
  !     DEFINE HEADER Variable * Image|UVData [/LIKE Other]
  !     Variable may have ReadOnly protection.
  !---------------------------------------------------------------------
  character(len=*)                :: namein  ! Variable name
  character(len=*)                :: file    ! Associated file name
  character(len=*)                :: status  ! Variable type / status
  logical, intent(in)             :: global  ! Global or Local variable
  integer(4), intent(in)          :: therank ! Desired Output Rank
  logical,          intent(inout) :: error   ! Return error flag
  ! Local
  character(len=*), parameter :: rname='DEFINE'
  integer(kind=4) :: in,istat,ier,actual_rank,code
  type(sic_identifier_t) :: var
  character(len=132) :: mess
  integer(kind=4), parameter :: mstates=8
  character(len=8) :: keyw,states(mstates),vstate(2)
  type(sic_descriptor_t) :: desc
  type(sic_dimensions_t) :: spec
  logical :: rdonly,virtuel,verbose
  ! Data
  data states/'READ','WRITE','INTEGER','LONG','REAL','DOUBLE','COMPLEX','EXTEND'/
  data vstate/'IMAGE','UVDATA'/
  !
  ! Check STATUS
  virtuel = file.eq.'*'
  if (virtuel) then
    call sic_ambigs('HEADER',status,keyw,istat,vstate,2,error)
    if (istat.eq.1) then
      code = code_header_image
    else
      code = code_header_uv
    endif
  else
    code = code_header
    call sic_ambigs('HEADER',status,keyw,istat,states,mstates,error)
  endif
  if (error) return
  !
  ! Parse name from dimensions...
  spec%do%strict   = .true.   ! Can not be an expression like A[1].eq.B[1]
  spec%do%range    = .false.  ! A[2:4] forbidden
  spec%do%subset   = .false.  ! A[2,]  forbidden
  spec%do%implicit = .false.  ! e.g. A[i] forbidden
  spec%do%twospec  = .false.  ! e.g. A[i][j:k] forbidden
  verbose = .true.
  call sic_parse_dim(namein,var,spec,verbose,error)
  if (error)  return
  if (virtuel) then
    if (spec%done(1)%ndim.eq.0) then
      call sic_message(seve%e,rname,'Missing dimension of new header')
      error = .true.
      return
    endif
    istat = 2
  elseif (istat.le.2 .and. spec%done(1)%ndim.ne.0) then
    call sic_message(seve%e,rname,'Cannot specify dimension for existing image')
    error = .true.
    return
  elseif (istat.ge.3 .and. spec%done(1)%ndim.eq.0) then
    call sic_message(seve%e,rname,'Missing dimension of new image')
    error = .true.
    return
  elseif (istat.eq.mstates .and. spec%done(1)%ndim.ne.1) then
    call sic_message(seve%e,rname,'Only last dimension can be extended')
    error = .true.
    return
  endif
  !
  ! Check if variable is already defined
  if (var%lname.gt.varname_length-12) then
    write(mess,1001) 'IMAGE names must be at most ',varname_length-12,' char'
    call sic_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  ! Check if variable is already defined. First, variable must be either
  ! a true variable or a component of an existing structure.
  if (sic_checkstruct(var%name,global).eq.0) then
    error = .true.
    return
  endif
  if (global) then
    var%level = 0
  else
    var%level = var_level
  endif
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  if (ier.eq.1) then
    call sic_message(seve%e,rname,'Variable '//trim(namein)//' already exists')
    error = .true.
    return
  endif
  !
  if (istat.eq.1) then
    rdonly = .true.
  elseif (istat.eq.2) then
    rdonly = .false.
  else
    call sic_message(seve%e,'DEFINE HEADER','Invalid status '//keyw)
    error = .true.
    return
  endif
  !
  ! Get the header parameter
  if (virtuel) then
    actual_rank = 0  ! Do not worry for Virtual header
  else
    actual_rank = therank
  endif
  !
  call sic_define_old_file(file,code,rdonly,actual_rank,desc,error)
  !! Print *,'THERANK ',therank,' actual rank ',actual_rank
  if (error) return
  !
  ! Check the dimensions in case of Virtual header
  if (virtuel .and. therank.ne.0) then
    actual_rank = therank
    desc%ndim = spec%done(1)%ndim
    desc%dims = spec%done(1)%dims(1:sic_maxdims,1)
    call trim_rank(rname,desc%ndim,desc%dims,actual_rank,error)
    spec%done(1)%ndim = desc%ndim
    if (error) return
  endif
  !
  ! Define the "generic" variable name
  ier = sic_hasins('DEFINE',maxvar,pfvar,pnvar,dicvar,var,in)
  if (ier.eq.0 .or. ier.eq.2) then
    error = .true.
    return
  endif
  !
  if (global) then
    var_g = var_g-1
    var_pointer (var_g) = in
  else
    var_n = var_n+1
    var_pointer (var_n) = in
  endif
  dicvar(in)%desc = desc
  !
  call sub_def_header(var,'%',desc%head,rdonly,actual_rank,error)
  !!Print *,'Done sub_def_header ACTUAL_RANK ',actual_rank
  ! Define Var%RDONLY to be able to access the Read Status.
  call sub_def_logi(trim(var%name)//'%RDONLY',dicvar(in)%desc%readonly, &
    & .true.,var%level,error)
#if defined(GAG_USE_PYTHON)
  if (.not.error) call gpy_getvar(var%name,var%level)
#endif
  !
  ! Fill the dimensions in case of new header
  if (virtuel) then
    call sub_dim_header(desc%head,spec%done(1))
  endif
  !
  return
  !
1001 format(a,i2,a)
end subroutine sic_define_header
!
subroutine sub_dim_header(head,subdims)
  use image_def
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Fill the dimensions in case of new header
  !---------------------------------------------------------------------
  type(gildas),                intent(inout) :: head     ! Target header
  type(sic_dimensions_done_t), intent(in)    :: subdims  !
  !
  head%gil%ndim = subdims%ndim
  head%gil%dim(1:sic_maxdims) = subdims%dims(1:sic_maxdims,1)
end subroutine sub_dim_header
!
subroutine sic_def_header(name,head,readonly,error)
  use image_def
  use sic_types
  !---------------------------------------------------------------------
  ! @ public
  !   Public entry point which allows to fill a SIC structure mapping
  ! the input image header. The structure is always global. Input object
  ! must be the whole 'gildas' type because we map head%gil% and
  ! head%char% elements.
  !   NB: if missing, the blanking section is enabled to default values
  ! (with eval<0). Because of this the input target header is
  ! intent(inout).
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: name      ! Structure name
  type(gildas),     intent(inout) :: head      ! Target header
  logical,          intent(in)    :: readonly  ! Readonly status
  logical,          intent(inout) :: error     ! Logical error flag
  ! Local
  type(sic_identifier_t) :: var
  logical, save :: yes=.true.
  logical, save :: no=.false.
  !
  ! Warning:  
  !   subroutine sic_mapheader 
  ! apparently provides a similar functionality.  
  ! The main differences are
  !   1)  readonly attribute is possible here
  !   2)  However, there does not seem  to be any simple mechanism 
  !       to delete variables implicitely created by sic_def_header,
  !       while a simple call to sic_delvariable can delete
  !       the whole structure created by sic_mapheader
  !
  var%name = name
  var%lname = len_trim(name)
  var%level = 0
  call sub_def_header(var,'%',head,readonly,-1,error)
  if (error)  return
  ! Define Var%RDONLY to be able to access the Read Status.
  if (readonly) then
    call sub_def_logi(trim(var%name)//'%RDONLY',yes,.true.,var%level,error)
  else
    call sub_def_logi(trim(var%name)//'%RDONLY',no,.true.,var%level,error)
  endif
  !
end subroutine sic_def_header
!
subroutine sub_def_header(varin,sep,h,rd,therank,error)
  use image_def
  use sic_interfaces, except_this=>sub_def_header
  use sic_structures
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !  Define all variables associated to an image header. Input object
  ! must be the whole 'gildas' type because we map head%gil% and
  ! head%char% elements.
  !   NB: if missing, the blanking section is enabled to default values
  ! (with eval<0). Because of this the input target header is
  ! intent(inout).
  !---------------------------------------------------------------------
  type(sic_identifier_t), intent(in)    :: varin  ! Parent structure
  character(len=*),       intent(in)    :: sep    ! Separator between parent structure and its components (1 char)
  type(gildas),           intent(inout) :: h      ! Target header
  logical,                intent(in)    :: rd     ! Readonly status
  integer(4),             intent(in)    :: therank ! Trim degenerate trailing dims
  logical,                intent(inout) :: error  ! Logical error flag
  ! Local
  integer(kind=index_length) :: dim(2)
  integer(kind=4) :: nn,n2,lev,itel
  character(len=varname_length) :: pre,pretel
  !
  lev = varin%level
  nn = min(varin%lname+1,varname_length-12)
  pre = varin%name
  pre(nn:nn) = sep(1:1)
  !
  ! Basic header information
  error = .false.
  call sub_def_inte(pre(1:nn)//'VERSION_GDF',h%gil%version_gdf,0,dim,rd,lev,error)
  if (error)  return
  call sub_def_inte(pre(1:nn)//'TYPE_GDF',h%gil%type_gdf,0,dim,rd,lev,error)
  if (error)  return
  !
  ! GENERAL section
  call sub_def_inte(pre(1:nn)//'GENE',h%gil%dim_words,0,dim,rd,lev,error)
  call sub_def_inte(pre(1:nn)//'NDIM',h%gil%ndim,0,dim,.true.,lev,error)
  dim(1) = gdf_maxdims
#if defined(INDEX4) || !defined(BITS64)
  call sub_def_inte(pre(1:nn)//'DIM',h%gil%dim,1,dim,.true.,lev,error)
#else
  call sub_def_long(pre(1:nn)//'DIM',h%gil%dim(1),1,dim,.true.,lev,error)
#endif
  dim(1) = 3
  dim(2) = gdf_maxdims
  call sub_def_dble(pre(1:nn)//'CONVERT',h%gil%convert(1,1),2,dim,rd,lev,error)
  ! Blanking section
  call sub_def_inte(pre(1:nn)//'BLAN',h%gil%blan_words,0,dim,rd,lev,error)
  if (h%gil%blan_words.eq.0) then
    h%gil%blan_words = 2
    h%gil%eval = -1
  endif
  !
  ! Probably not at the right place: Make the Blanking # NaN
  if (h%gil%bval.ne.h%gil%bval) h%gil%bval = 1.23456e+34
  dim(1) = 2
  call sub_def_real(pre(1:nn)//'BLANK',h%gil%bval,1,dim,rd,lev,error)
  !
  ! Extrema
  call sub_def_inte(pre(1:nn)//'EXTREMA',h%gil%extr_words,0,dim,rd,lev,error)
  call sub_def_real(pre(1:nn)//'MIN',    h%gil%rmin,0,dim,rd,lev,error)
  call sub_def_real(pre(1:nn)//'MAX',    h%gil%rmax,0,dim,rd,lev,error)
  !
  dim(1) = gdf_maxdims
#if defined(INDEX4) || !defined(BITS64)
  call sub_def_inte(pre(1:nn)//'MINLOC',h%gil%minloc(1),1,dim,rd,lev,error)
  call sub_def_inte(pre(1:nn)//'MAXLOC',h%gil%maxloc(1),1,dim,rd,lev,error)
#else
  call sub_def_long(pre(1:nn)//'MINLOC',h%gil%minloc(1),1,dim,rd,lev,error)
  call sub_def_long(pre(1:nn)//'MAXLOC',h%gil%maxloc(1),1,dim,rd,lev,error)
#endif
  !
  ! Units and coordinate system
  call sub_def_inte(pre(1:nn)//'DESC',h%gil%desc_words,0,dim,rd,lev,error)
  call sub_def_char(pre(1:nn)//'UNIT',  h%char%unit,rd,lev,error)
  call sub_def_char(pre(1:nn)//'UNIT1', h%char%code(1),rd,lev,error)
  call sub_def_char(pre(1:nn)//'UNIT2', h%char%code(2),rd,lev,error)
  call sub_def_char(pre(1:nn)//'UNIT3', h%char%code(3),rd,lev,error)
  call sub_def_char(pre(1:nn)//'UNIT4', h%char%code(4),rd,lev,error)
  call sub_def_char(pre(1:nn)//'UNIT5', h%char%code(5),rd,lev,error)
  call sub_def_char(pre(1:nn)//'UNIT6', h%char%code(6),rd,lev,error)
  call sub_def_char(pre(1:nn)//'UNIT7', h%char%code(7),rd,lev,error)
  call sub_def_char(pre(1:nn)//'SYSTEM', h%char%syst,rd,lev,error)
  !
  ! Astronomical position
  call sub_def_inte(pre(1:nn)//'POSI',h%gil%posi_words,0,dim,rd,lev,error)
  call sub_def_char(pre(1:nn)//'SOURCE',h%char%name,rd,lev,error)
  call sub_def_dble(pre(1:nn)//'RA',   h%gil%ra,0,dim,rd,lev,error)
  call sub_def_dble(pre(1:nn)//'DEC',  h%gil%dec, 0,dim,rd,lev,error)
  call sub_def_dble(pre(1:nn)//'LII',  h%gil%lii, 0,dim,rd,lev,error)
  call sub_def_dble(pre(1:nn)//'BII',  h%gil%bii, 0,dim,rd,lev,error)
  !
  call sub_def_real(pre(1:nn)//'EQUINOX',h%gil%epoc, 0,dim,rd,lev,error)
  !
  ! Projection
  call sub_def_inte(pre(1:nn)//'PROJ',  h%gil%proj_words,0,dim,rd,lev,error)
  call sub_def_inte(pre(1:nn)//'PTYPE', h%gil%ptyp,0,dim,rd,lev,error)
  call sub_def_dble(pre(1:nn)//'A0',    h%gil%a0,0,dim,rd,lev,error)
  call sub_def_dble(pre(1:nn)//'D0',    h%gil%d0,0,dim,rd,lev,error)
  call sub_def_dble(pre(1:nn)//'ANGLE', h%gil%pang,0,dim,rd,lev,error)
  call sub_def_inte(pre(1:nn)//'X_AXIS',h%gil%xaxi,0,dim,rd,lev,error)
  call sub_def_inte(pre(1:nn)//'Y_AXIS',h%gil%yaxi,0,dim,rd,lev,error)
  !
  ! Spectroscopy
  call sub_def_inte(pre(1:nn)//'SPEC',   h%gil%spec_words,0,dim,rd,lev,error)
  call sub_def_char(pre(1:nn)//'LINE',   h%char%line,rd,lev,error)
  call sub_def_dble(pre(1:nn)//'FREQRES',h%gil%fres,0,dim,rd,lev,error)
  call sub_def_dble(pre(1:nn)//'IMAGFRE',h%gil%fima,0,dim,rd,lev,error)
  call sub_def_dble(pre(1:nn)//'RESTFRE',h%gil%freq,0,dim,rd,lev,error)
  call sub_def_real(pre(1:nn)//'VELRES', h%gil%vres,0,dim,rd,lev,error)
  call sub_def_real(pre(1:nn)//'VELOFF', h%gil%voff,0,dim,rd,lev,error)
  call sub_def_inte(pre(1:nn)//'F_AXIS', h%gil%faxi,0,dim,rd,lev,error)
  call sub_def_real(pre(1:nn)//'DOPPLER',h%gil%dopp,0,dim,rd,lev,error)  !
  call sub_def_inte(pre(1:nn)//'VTYPE',  h%gil%vtyp,0,dim,rd,lev,error)  !
  !
  ! Beam size
  call sub_def_inte(pre(1:nn)//'BEAM', h%gil%reso_words,0,dim,rd,lev,error)
  call sub_def_real(pre(1:nn)//'MAJOR',h%gil%majo,0,dim,rd,lev,error)
  call sub_def_real(pre(1:nn)//'MINOR',h%gil%mino,0,dim,rd,lev,error)
  call sub_def_real(pre(1:nn)//'PA',   h%gil%posa,0,dim,rd,lev,error)
  !
  ! Noise
  call sub_def_inte(pre(1:nn)//'SIGMA',h%gil%nois_words,0,dim,rd,lev,error)
  call sub_def_real(pre(1:nn)//'NOISE',h%gil%noise,0,dim,rd,lev,error)
  call sub_def_real(pre(1:nn)//'RMS',  h%gil%rms,0,dim,rd,lev,error)
  !
  ! Proper Motion
  call sub_def_inte(pre(1:nn)//'PROPER',  h%gil%astr_words,0,dim,rd,lev,error)
  dim(1) = 2
  call sub_def_real(pre(1:nn)//'MU',      h%gil%mura,1,dim,rd,lev,error)
  call sub_def_real(pre(1:nn)//'PARALLAX',h%gil%parallax,0,dim,rd,lev,error)
  !
  if (abs(h%gil%type_gdf).eq.code_gdf_uvt) then
    call sic_def_uvhead(varin,h,rd,error)
  endif
  !
  ! Telescope
  call sub_def_inte(pre(1:nn)//'TELE_SEC',h%gil%tele_words,0,dim,rd,lev,error)
  call sub_def_inte(pre(1:nn)//'NTEL',    h%gil%nteles,    0,dim,.true.,lev,error)  ! Read-only
  do itel=1,h%gil%nteles
    write(pretel,'(A,A,I0)')  pre(1:nn),'TEL',itel
    n2 = len_trim(pretel)
    call sic_defstructure(pretel(1:n2),lev.eq.0,error)
    if (error)  return
    n2 = n2+1
    pretel(n2:n2) = '%'
    call sub_def_dble(pretel(1:n2)//'LON', h%gil%teles(itel)%lon, 0,dim,rd,lev,error)
    call sub_def_dble(pretel(1:n2)//'LAT', h%gil%teles(itel)%lat, 0,dim,rd,lev,error)
    call sub_def_real(pretel(1:n2)//'ALT', h%gil%teles(itel)%alt, 0,dim,rd,lev,error)
    call sub_def_real(pretel(1:n2)//'DIAM',h%gil%teles(itel)%diam,0,dim,rd,lev,error)
    call sub_def_char(pretel(1:n2)//'NAME',h%gil%teles(itel)%ctele,     rd,lev,error)
  enddo
  !
  ! Trim trick
  if (therank.ge.0) h%gil%ndim = therank
end subroutine sub_def_header
!
subroutine rename_variable(namein,nameout,error)
  use gbl_message
  use sic_interfaces, except_this=>rename_variable
  use sic_structures
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  !   Rename a Sic variable
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: namein   ! Original name
  character(len=*), intent(in)    :: nameout  ! New name
  logical,          intent(inout) :: error    ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='LET /REPLACE'
  type(sic_identifier_t) :: varin,varout,tmp
  integer(kind=4) :: in,ou,ier,list(maxvar),ielem,nelem,ik,il,ol,rpos
  logical :: global,domany
  character(len=varname_length) :: iname,oname
  !
  if (namein.eq.' ') then
    call sic_message(seve%e,rname,'Empty input variable name')
    error = .true.
    return
  endif
  !
  ! Drop trailing %, if any
  il = len_trim(namein)
  if (namein(il:il).eq.'%')  il = il-1
  iname = namein(1:il)
  ol = len_trim(nameout)
  if (nameout(ol:ol).eq.'%')  ol = ol-1
  oname = nameout(1:ol)
  !
  ! Find variable and determine if local or global
  global = .false.
  varin%name = iname
  varin%lname = il
  varin%level = var_level
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,varin,in)
  if (ier.ne.1) then
    varin%level = 0
    ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,varin,in)
    if (ier.ne.1) then
      call sic_message(seve%e,rname,'No such variable '//namein)
      error = .true.
      return
    endif
    global = .true.
  endif
  !
  ! Sanity check
  if (dicvar(in)%desc%status.eq.program_defined) then
    call sic_message(seve%e,rname,'Program-defined variables can not be renamed')
    error = .true.
    return
  endif
  ! if (dicvar(in)%desc%readonly): this is allowed, e.g. for DEFINE IMAGE ... READ
  !
  ! Check alternate name
  varout%name = oname
  varout%lname = ol
  varout%level = varin%level
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,varout,ou)
  if (ier.eq.1) then
    call sic_message(seve%e,rname,'Variable '//trim(nameout)//  &
    ' already exists')
    error = .true.
    return
  endif
  !
  ! If new name is under a structure, check it exists!
  rpos = index(oname,'%',back=.true.)
  if (rpos.gt.0) then
    tmp%name = oname(1:rpos-1)
    tmp%lname = rpos-1
    tmp%level = varout%level
    ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,tmp,ou)
    if (ier.ne.1) then
      call sic_message(seve%e,rname,  &
        'Structure '//nameout(1:rpos-1)//' does not exist')
      error = .true.
      return
    endif
  endif
  !
  if (dicvar(in)%desc%status.eq.user_defined .and.  &
      dicvar(in)%desc%type.eq.0) then
    ! User defined structure
    domany = .true.
  elseif (dicvar(in)%desc%status.gt.0) then
    ! Images or Headers
    domany = .true.
  elseif (dicvar(in)%desc%status.eq.alias_defined) then
    ! Aliases. Not implemented
    call sic_message(seve%e,rname,'Aliases can not be renamed')
    error = .true.
    return
  else
    domany = .false.
  endif
  !
  call do_rename_variable(varin,in,varout,global,error)
  if (error)  return
  !
  if (domany) then
    ! The parent structure has been renamed: rename also its elements
    il = il+1
    iname(il:il) = '%'
    call gag_haslis(maxvar,pfvar,pnvar,list,nelem)
    do ielem=1,nelem
      ik = list(ielem)
      if (dicvar(ik)%id%level.ne.varin%level)  cycle
      if (index(dicvar(ik)%id%name,iname(1:il)).ne.1)  cycle
      !
      varin = dicvar(ik)%id
      !
      varout%name = trim(oname)//'%'//dicvar(ik)%id%name(il+1:)
      varout%lname = len_trim(varout%name)
      ! varout%level = unchanged
      !
      call do_rename_variable(varin,ik,varout,global,error)
      if (error)  return
      !
    enddo
  endif
  !
contains
  subroutine do_rename_variable(varin,in,varout,global,error)
    use sic_dictionaries
    type(sic_identifier_t), intent(inout) :: varin
    integer(kind=4),        intent(in)    :: in
    type(sic_identifier_t), intent(inout) :: varout
    logical,                intent(in)    :: global
    logical,                intent(inout) :: error
    ! Local
    integer(kind=4) :: ier,i,ou
    !
    ! Define the output variable in dictionary:
    ier = sic_hasins(rname,maxvar,pfvar,pnvar,dicvar,varout,ou)
    if (ier.eq.0 .or. ier.eq.2) then
      error = .true.
      return
    endif
    !
    ! Copy descriptor
    dicvar(ou)%desc = dicvar(in)%desc
    !
    ! Delete entry IN
    ier = sic_hasdel(maxvar,pfvar,pnvar,dicvar,varin)
    !
    ! Reset back pointers
    if (.not.global) then
      do i=1,var_n
        if (var_pointer(i).eq.in) then
          var_pointer(i) = ou
          return
        endif
      enddo
    else
      do i=var_g,maxvar
        if (var_pointer(i).eq.in) then
          var_pointer(i) = ou
          return
        endif
      enddo
    endif
  end subroutine do_rename_variable
  !
end subroutine rename_variable
!
subroutine sub_def_real(symb,rel,ndim,dim,readonly,lev,error)
  use gildas_def
  use gbl_format
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sub_def_real
  !---------------------------------------------------------------------
  ! @ private
  ! Defines global variables by program
  !---------------------------------------------------------------------
  character(len=*),           intent(in)    :: symb       ! Variable name
  real(kind=4),               intent(in)    :: rel        ! Real array
  integer(kind=4),            intent(in)    :: ndim       ! Number of dimensions
  integer(kind=index_length), intent(in)    :: dim(ndim)  ! Dimensions
  logical,                    intent(in)    :: readonly   ! ReadOnly flag
  integer(kind=4),            intent(in)    :: lev        ! Variable level
  logical,                    intent(inout) :: error      ! Logical error flag
  ! Local
  integer(kind=address_length) :: vaddr
  integer(kind=4) :: vtype,i
  integer(kind=size_length) :: size
  !
  vaddr = locwrd (rel)
  vtype = fmt_r4
  size = 1
  do i = 1,ndim
    size = size*dim(i)
  enddo
  call sic_def_avar(symb,vaddr,vtype,size,ndim,dim,readonly,lev,error)
end subroutine sub_def_real
!
subroutine sub_def_dble(symb,dble,ndim,dim,readonly,lev,error)
  use gildas_def
  use gbl_format
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sub_def_dble
  !---------------------------------------------------------------------
  ! @ private
  ! Defines global variables by program
  !---------------------------------------------------------------------
  character(len=*),           intent(in)    :: symb       ! Variable name
  real(kind=8),               intent(in)    :: dble       ! REAL*8 array
  integer(kind=4),            intent(in)    :: ndim       ! Number of dimensions
  integer(kind=index_length), intent(in)    :: dim(ndim)  ! Dimensions
  logical,                    intent(in)    :: readonly   ! ReadOnly flag
  integer(kind=4),            intent(in)    :: lev        ! Variable level
  logical,                    intent(inout) :: error      ! Logical error flag
  ! Local
  integer(kind=address_length) :: vaddr
  integer(kind=4) :: vtype,i
  integer(kind=size_length) :: size
  !
  vaddr = locwrd(dble)
  vtype = fmt_r8
  size = 2
  do i = 1,ndim
    size = size*dim(i)
  enddo
  call sic_def_avar(symb,vaddr,vtype,size,ndim,dim,readonly,lev,error)
end subroutine sub_def_dble
!
subroutine sub_def_inte(symb,inte,ndim,dim,readonly,lev,error)
  use gildas_def
  use gbl_format
  use sic_dependencies_interfaces
  use sic_interfaces
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument rank mismatch)
  ! Defines global variables by program
  !---------------------------------------------------------------------
  character(len=*),           intent(in)    :: symb       ! Variable name
  integer(kind=4),            intent(in)    :: inte       ! Integer array
  integer(kind=4),            intent(in)    :: ndim       ! Number of dimensions
  integer(kind=index_length), intent(in)    :: dim(ndim)  ! Dimensions
  logical,                    intent(in)    :: readonly   ! ReadOnly flag
  integer(kind=4),            intent(in)    :: lev        ! Variable level
  logical,                    intent(inout) :: error      ! Logical error flag
  ! Local
  integer(kind=address_length) :: vaddr
  integer(kind=4) :: vtype,i
  integer(kind=size_length) :: size
  !
  vaddr = locwrd(inte)
  vtype = fmt_i4
  size = 1
  do i = 1,ndim
    size = size*dim(i)
  enddo
  call sic_def_avar(symb,vaddr,vtype,size,ndim,dim,readonly,lev,error)
end subroutine sub_def_inte
!
subroutine sub_def_long(symb,long,ndim,dim,readonly,lev,error)
  use gildas_def
  use gbl_format
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sub_def_long
  !---------------------------------------------------------------------
  ! @ private
  ! Defines global variables by program
  !---------------------------------------------------------------------
  character(len=*),           intent(in)    :: symb       ! Variable name
  integer(kind=8),            intent(in)    :: long       ! Long integer array
  integer(kind=4),            intent(in)    :: ndim       ! Number of dimensions
  integer(kind=index_length), intent(in)    :: dim(ndim)  ! Dimensions
  logical,                    intent(in)    :: readonly   ! ReadOnly flag
  integer(kind=4),            intent(in)    :: lev        ! Variable level
  logical,                    intent(inout) :: error      ! Logical error flag
  ! Local
  integer(kind=address_length) :: vaddr
  integer(kind=4) :: vtype,i
  integer(kind=size_length) :: size
  !
  vaddr = locwrd(long)
  vtype = fmt_i8
  size = 2
  do i = 1,ndim
    size = size*dim(i)
  enddo
  call sic_def_avar(symb,vaddr,vtype,size,ndim,dim,readonly,lev,error)
end subroutine sub_def_long
!
subroutine sub_def_logi (symb,logi,readonly,lev,error)
  use gildas_def
  use gbl_format
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sub_def_logi
  !---------------------------------------------------------------------
  ! @ private
  ! Defines global variables by program
  !---------------------------------------------------------------------
  character(len=*),           intent(in)    :: symb      ! Variable name
  logical,                    intent(in)    :: logi      ! Logical scalar
  logical,                    intent(in)    :: readonly  ! ReadOnly flag
  integer(kind=4),            intent(in)    :: lev       ! Variable level
  logical,                    intent(inout) :: error     ! Logical error flag
  ! Local
  integer(kind=address_length) :: vaddr
  integer(kind=4) :: vtype,ndim
  integer(kind=size_length) :: size
  integer(kind=index_length) :: dim(sic_maxdims)
  !
  vaddr = locwrd(logi)
  vtype = fmt_l
  size = 1
  ndim = 0
  call sic_def_avar(symb,vaddr,vtype,size,ndim,dim,readonly,lev,error)
end subroutine sub_def_logi
!
subroutine sub_def_login(symb,logi,ndim,dim,readonly,lev,error)
  use gildas_def
  use gbl_format
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sub_def_login
  !---------------------------------------------------------------------
  ! @ private
  ! Defines global variables by program
  !---------------------------------------------------------------------
  character(len=*),           intent(in)    :: symb       ! Variable name
  logical,                    intent(in)    :: logi       ! Logical array
  integer(kind=4),            intent(in)    :: ndim       ! Number of dimensions
  integer(kind=index_length), intent(in)    :: dim(ndim)  ! Dimensions
  logical,                    intent(in)    :: readonly   ! ReadOnly flag
  integer(kind=4),            intent(in)    :: lev        ! Variable level
  logical,                    intent(inout) :: error      ! Logical error flag
  ! Local
  integer(kind=address_length) :: vaddr
  integer(kind=4) :: vtype,i
  integer(kind=size_length) :: size
  !
  vaddr = locwrd(logi)
  vtype = fmt_l
  size = 1
  do i = 1,ndim
    size = size*dim(i)
  enddo
  call sic_def_avar(symb,vaddr,vtype,size,ndim,dim,readonly,lev,error)
end subroutine sub_def_login
!
subroutine sub_def_char(symb,chain,readonly,lev,error)
  use gildas_def
  use gbl_format
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sub_def_char
  !---------------------------------------------------------------------
  ! @ private
  ! Defines global variables by program
  !---------------------------------------------------------------------
  character(len=*),           intent(in)    :: symb      ! Variable name
  character(len=*),           intent(in)    :: chain     ! Character string
  logical,                    intent(in)    :: readonly  ! ReadOnly flag
  integer(kind=4),            intent(in)    :: lev       ! Variable level
  logical,                    intent(inout) :: error     ! Logical error flag
  ! Local
  integer(kind=address_length) :: vaddr
  integer(kind=4) :: vtype,ndim
  integer(kind=size_length) :: size
  integer(kind=index_length) :: dim(sic_maxdims)
  !
  vaddr = locstr(chain)
  vtype = len(chain)
  size = (vtype+3)/4
  ndim = 0
  call sic_def_avar(symb,vaddr,vtype,size,ndim,dim,readonly,lev,error)
end subroutine sub_def_char
!
subroutine sub_def_strn(symb,string,ns,readonly,lev,error)
  use gildas_def
  use gbl_format
  use sic_dependencies_interfaces
  use sic_interfaces
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Defines global variables by program
  ! Added for HEADERCHAR
  !---------------------------------------------------------------------
  character(len=*),           intent(in)    :: symb       ! Variable name
  integer(kind=1),            intent(in)    :: string(*)  !
  integer(kind=4),            intent(in)    :: ns         !
  logical,                   intent(in)    :: readonly   ! ReadOnly flag
  integer(kind=4),            intent(in)    :: lev        ! Variable level
  logical,                    intent(inout) :: error      ! Logical error flag
  ! Local
  integer(kind=address_length) :: vaddr
  integer(kind=4) :: vtype,ndim
  integer(kind=size_length) :: size
  integer(kind=index_length) :: dim(sic_maxdims)
  !
  vaddr = locwrd(string)
  vtype = ns
  size = (vtype+3)/4
  ndim = 0
  call sic_def_avar(symb,vaddr,vtype,size,ndim,dim,readonly,lev,error)
end subroutine sub_def_strn
!
subroutine sub_def_charn(symb,chain,ndim,dim,readonly,lev,error)
  use gildas_def
  use gbl_format
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sub_def_charn
  !---------------------------------------------------------------------
  ! @ private
  ! Defines global variables by program
  !---------------------------------------------------------------------
  character(len=*),           intent(in)    :: symb       ! Variable name
  character(len=*),           intent(in)    :: chain      ! Character string
  integer(kind=4),            intent(in)    :: ndim       ! Number of dimensions
  integer(kind=index_length), intent(in)    :: dim(ndim)  ! Dimensions
  logical,                    intent(in)    :: readonly   ! ReadOnly flag
  integer(kind=4),            intent(in)    :: lev        ! Variable level
  logical,                    intent(inout) :: error      ! Logical error flag
  ! Local
  integer(kind=address_length) :: vaddr
  integer(kind=4) :: vtype,i
  integer(kind=size_length) :: size
  !
  vaddr = locstr(chain)
  vtype = len(chain)
  size = vtype
  do i = 1,ndim
    size = size*dim(i)
  enddo
  size = (size+3)/4  ! Convert to words
  call sic_def_avar(symb,vaddr,vtype,size,ndim,dim,readonly,lev,error)
end subroutine sub_def_charn
!
subroutine sic_changevariable(namin,rdonly,error)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_changevariable
  use gildas_def
  use sic_structures
  use sic_dictionaries
  use sic_types
  use gbl_message
  use gbl_format
  !---------------------------------------------------------------------
  ! @ private
  ! Change the status of an IMAGE variable (HEADER or TABLE) to
  ! Read or Write
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: namin  ! Variable name
  logical, intent(in) :: rdonly          !
  logical, intent(out) :: error          !
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='LET /STATUS'
  integer :: vtype,in,ier
  type(sic_identifier_t) :: varin
  character(len=132) :: message
  !
  ! Locate the variable name
  !
  ! Check syntax and analyse dimensions.
  error = .true.
  if (namin.eq.' ') return
  !
  ! Find variable
  varin%name = namin
  varin%lname = len_trim(namin)
  varin%level = var_level
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,varin,in)
  if (ier.ne.1) then
    varin%level = 0
    ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,varin,in)
    if (ier.ne.1) return
  endif
  !
  vtype = dicvar(in)%desc%status
  !
  if (vtype.eq.program_defined) then 
    call sic_message(seve%e,rname,'Program defined variables are protected')
    error =.true.
  else if (vtype.eq.user_defined .and. dicvar(in)%desc%type.eq.0) then
    call sic_message(seve%e,rname,'Structures invalid in this context')
    error = .true.             ! User defined structure
  else
    error = .false.
  endif
  if (error) return
  !
  ! The readonly  status is always defined in the same way
  if (dicvar(in)%desc%readonly) then
    if (rdonly) then
      message = trim(namin)//' is already ReadOnly'
      call sic_message(seve%w,rname,message)
    else
      ! Set it to Write Status
      ! Easy for the normal variables or image data
      dicvar(in)%desc%readonly = .false.
      if (vtype.gt.0) then
        ! More difficult for the header
        call sic_changeheader(varin,in,.false.,error)
        ier = gio_chis(vtype,.false.)
      endif
    endif
  else
    if (rdonly) then
      ! Set it to Read Status
      ! Easy for the normal variables or image data
      dicvar(in)%desc%readonly = .true.
      if (vtype.gt.0) then
        ! More difficult for the header
        call sic_changeheader(varin,in,.false.,error)
        ier = gio_chis(vtype,.false.)
      endif
    else
      message = trim(namin)//' is already Writeable'
      call sic_message(seve%w,rname,message)
    endif
  endif
  !
end subroutine sic_changevariable
!
subroutine sic_changeheader(headvar,jn,rdonly,error)
  use sic_interfaces, except_this=>sic_changeheader
  use gildas_def
  use sic_structures
  use sic_dictionaries
  !---------------------------------------------------------------------
  ! @ private
  ! Change the status of an HEADER variable to Read or Write
  !---------------------------------------------------------------------
  type(sic_identifier_t), intent(in)    :: headvar  ! SIC variable
  integer,                intent(in)    :: jn       ! Variable number DUMMY ...
  logical,                intent(in)    :: rdonly   ! Read-only status
  logical,                intent(inout) :: error    ! Error flag
  ! Local
  integer :: in,nn,ier
  type(sic_identifier_t) :: var
  !
  var%name = headvar%name
  var%lname = len_trim(var%name)+1
  var%name(var%lname:var%lname) = '%'
  nn = var%lname
  !
  ! Check there is a header
  var%level = headvar%level
  var%name(nn+1:) = 'GENE'
  var%lname = nn+4
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  ! Return if not
  if (ier.ne.1) return
  ! Change if yes
  dicvar(in)%desc%readonly = rdonly
  !
  ! GENERAL section
  var%name(nn+1:) = 'NDIM'
  var%lname = nn+4
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'DIM'
  var%lname = nn+3
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'CONVERT'
  var%lname = nn+7
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  ! Blanking section
  var%name(nn+1:) = 'BLAN'
  var%lname = nn+4
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'BLANK'
  var%lname = nn+5
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'EXTREMA'
  var%lname = nn+7
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'MAX'
  var%lname = nn+3
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'MIN'
  var%lname = nn+3
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'MINLOC'
  var%lname = nn+6
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'MAXLOC'
  var%lname = nn+6
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  ! Units and coordinate system
  var%name(nn+1:) = 'DESC'
  var%lname = nn+4
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'UNIT'
  var%lname = nn+4
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'UNIT1'
  var%lname = nn+5
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'UNIT2'
  var%lname = nn+5
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'UNIT3'
  var%lname = nn+5
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'UNIT4'
  var%lname = nn+5
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'UNIT5'
  var%lname = nn+5
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'UNIT6'
  var%lname = nn+5
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'UNIT7'
  var%lname = nn+5
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'SYSTEM'
  var%lname = nn+6
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  ! Astronomical position
  var%name(nn+1:) = 'POSI'
  var%lname = nn+4
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'SOURCE'
  var%lname = nn+6
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'RA'
  var%lname = nn+2
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'DEC'
  var%lname = nn+3
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'LII'
  var%lname = nn+3
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'BII'
  var%lname = nn+3
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'EQUINOX'
  var%lname = nn+7
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  ! Projection
  var%name(nn+1:) = 'PROJ'
  var%lname = nn+4
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'PTYPE'
  var%lname = nn+5
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'A0'
  var%lname = nn+2
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'D0'
  var%lname = nn+2
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'ANGLE'
  var%lname = nn+5
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'X_AXIS'
  var%lname = nn+6
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'Y_AXIS'
  var%lname = nn+6
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  ! Spectroscopy
  var%name(nn+1:) = 'SPEC'
  var%lname = nn+4
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'LINE'
  var%lname = nn+4
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'FREQRES'
  var%lname = nn+7
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'IMAGFRE'
  var%lname = nn+7
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'RESTFRE'
  var%lname = nn+7
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'VELRES'
  var%lname = nn+6
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'VELOFF'
  var%lname = nn+6
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'F_AXIS'
  var%lname = nn+6
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'DOPPLER'
  var%lname = nn+7
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'VTYPE'
  var%lname = nn+5
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  ! Beam size
  var%name(nn+1:) = 'BEAM'
  var%lname = nn+4
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'MAJOR'
  var%lname = nn+5
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'MINOR'
  var%lname = nn+5
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'PA'
  var%lname = nn+2
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  ! Noise
  var%name(nn+1:) = 'SIGMA'
  var%lname = nn+5
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'NOISE'
  var%lname = nn+5
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'RMS'
  var%lname = nn+3
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  ! Proper
  var%name(nn+1:) = 'PROPER'
  var%lname = nn+6
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'MU'
  var%lname = nn+2
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
  var%name(nn+1:) = 'PARALLAX'
  var%lname = nn+8
  ier = sic_hasfin(maxvar,pfvar,pnvar,dicvar,var,in)
  dicvar(in)%desc%readonly = rdonly
  !
end subroutine sic_changeheader
!
subroutine sic_def_uvhead(var,h,rd,error)
  use sic_interfaces
  use image_def
  use sic_structures
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! SIC Internal routine
  !     Define all Header variables associated to a UV table
  !---------------------------------------------------------------------
  type(sic_identifier_t), intent(in)    :: var    ! SIC variable
  type(gildas),           intent(inout) :: h      ! Gildas Header
  logical,                intent(in)    :: rd     ! ReadOnly flag
  logical,                intent(inout) :: error  ! Error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  integer(kind=index_length) :: dim(1)
  integer :: nn,lev
  character(len=varname_length) :: pre
  !
  lev = var%level
  nn = min(index(var%name,' '),varname_length-12)
  pre = var%name
  pre(nn:nn) = '%'
  !
  dim(1) = 0
  call sub_def_inte(pre(1:nn)//'NCHAN',h%gil%nchan,0,dim,rd,lev,error)
  call sub_def_long(pre(1:nn)//'NVISI',h%gil%nvisi,0,dim,rd,lev,error)
  call sub_def_inte(pre(1:nn)//'NSTOKES',h%gil%nstokes,0,dim,rd,lev,error)
  call sub_def_inte(pre(1:nn)//'NATOM',h%gil%natom,0,dim,rd,lev,error)
  call sub_def_real(pre(1:nn)//'BASEMIN',h%gil%basemin,0,dim,rd,lev,error)
  call sub_def_real(pre(1:nn)//'BASEMAX',h%gil%basemax,0,dim,rd,lev,error)
  call sub_def_inte(pre(1:nn)//'VERSION_UV',h%gil%version_uv,0,dim,rd,lev,error)
  !
  if (h%gil%nfreq.ne.0) then
    dim(1) = h%gil%nfreq
    call sub_def_dble(pre(1:nn)//'FREQUENCIES',h%gil%freqs(1),1,dim,rd,lev,error)
    call sub_def_inte(pre(1:nn)//'STOKES',h%gil%stokes(1),1,dim,rd,lev,error)
  endif
end subroutine sic_def_uvhead
!
subroutine sic_def_uvcoor(var,h,desc,rd,error)
  use sic_dependencies_interfaces
  use sic_interfaces
  use image_def
  use sic_structures
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! SIC Internal routine
  !     Define U and V variables for a TUV Table
  !---------------------------------------------------------------------
  type(sic_identifier_t), intent(in)    :: var    ! SIC variable
  type(gildas),           intent(inout) :: h      ! Gildas Header
  type(sic_descriptor_t), intent(in)    :: desc   ! Variable descriptor
  logical,                intent(in)    :: rd     ! ReadOnly flag
  logical,                intent(inout) :: error  ! Error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  integer(kind=index_length) :: dim(1)
  integer(kind=address_length) :: vaddr,oaddr
  integer(kind=size_length) :: vsize
  integer :: nn,np,lev,vtype
  character(len=varname_length) :: pre
  !
  lev = var%level
  nn = min(index(var%name,' '),varname_length-12)
  np = nn+1
  pre = var%name(1:nn)
  !
  if (h%gil%type_gdf.eq.code_gdf_tuv) then
     ! Define U and V
     dim = 0
     dim(1) = desc%dims(1)
     vtype = fmt_r4
     vsize = dim(1)
     call adtoad(desc%addr,oaddr,1)
     vaddr = oaddr + 4*dim(1)*(h%gil%column_pointer(code_uvt_u)-1)
     pre(nn:np) = '%U'
     call sic_def_avar(pre,vaddr,vtype,vsize,1,dim,rd,lev,error)
     vaddr = oaddr + 4*dim(1)*(h%gil%column_pointer(code_uvt_v)-1)
     pre(nn:np) = '%V'
     call sic_def_avar(pre,vaddr,vtype,vsize,1,dim,rd,lev,error)
     !
     if (h%gil%column_size(code_uvt_ra).eq.2) then
       vtype = fmt_r8
       vsize = 2*dim(1)
       vaddr = oaddr + 4*dim(1)*(h%gil%column_pointer(code_uvt_ra)-1)
       np = nn+4
       pre(nn:np) = '%E_RA'
       call sic_def_avar(pre,vaddr,vtype,vsize,1,dim,rd,lev,error)
     endif
     if (h%gil%column_size(code_uvt_dec).eq.2) then
       vtype = fmt_r8
       vsize = 2*dim(1)
       vaddr = oaddr + 4*dim(1)*(h%gil%column_pointer(code_uvt_dec)-1)
       np = nn+5
       pre(nn:np) = '%E_DEC'
       call sic_def_avar(pre,vaddr,vtype,vsize,1,dim,rd,lev,error)
     endif
  endif
end subroutine sic_def_uvcoor
!
subroutine trim_rank(rname,ndim,dims,therank,error)
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>trim_rank
  use gildas_def
  use image_def
  use gbl_format
  use gbl_message
  use sic_define_status
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  ! Trim the rank of an Image or Header
  !---------------------------------------------------------------------
  character(len=*),           intent(in)    :: rname    !
  integer(kind=4),            intent(inout) :: ndim     !
  integer(kind=index_length), intent(inout) :: dims(:)  !
  integer(kind=4),            intent(inout) :: therank  ! Desired rank
  logical,                    intent(inout) :: error    !
  ! Local
  integer(kind=4) :: i
  !
  if (therank.eq.0) then
    therank = -1 ! Code to use the true dimensions
    !
  else if (therank.le.-10) then
    !!Print *,'Trim all degenerate trailing dimensions'
    do while (dims(ndim).eq.1)
      ndim = ndim-1
      if (ndim.eq.0) exit
    enddo
    therank = ndim
    !
  else if (therank.lt.0) then
    !
    !!Print *,'Reduce to at least ',-therank,' more if possible'
    therank = -therank
    do i=therank+1,ndim
      if (dims(i).gt.1) then
        call sic_message(seve%e,rname,'Cannot reduce array rank')
        error = .true.
        return
      endif
    enddo
    ndim = therank
    do while (dims(ndim).eq.1)
      ndim = ndim-1
      if (ndim.eq.0) exit
    enddo
    therank = ndim
    !
  else if (therank.lt.ndim) then
    !!Print *,'Reduce to ',therank
    do i=therank+1,ndim
      if (dims(i).gt.1) then
        call sic_message(seve%e,rname,'Cannot reduce array rank')
        error = .true.
        return
      endif
    enddo
    ndim = therank
    !
  else if (therank.gt.ndim) then
    !!Print *,'Extend to ',therank,' by adding trailing degenerate dimensions'
    do i=ndim+1,therank
      dims(i) = 1
    enddo
    ndim = therank
  endif
  !
end subroutine trim_rank
!
subroutine sic_mapheader(name,head,error)
  use image_def
  use sic_interfaces, except_this=>sic_mapheader
  !---------------------------------------------------------------------
  ! @ public
  !   Create a HEADER SIC variable from an existing Header structure.
  ! It is global and program_defined.
  !---------------------------------------------------------------------
  character(len=*),     intent(in)    :: name   ! Header name
  type(gildas), target, intent(inout) :: head   ! Header
  logical(kind=4),      intent(inout) :: error  ! Logical error flag
  ! Local
  integer(kind=address_length) :: addr
  !
  addr = ptr_null
  call sub_mapgildas(name,head,0,addr,error)
end subroutine sic_mapheader
!
subroutine sic_mapgildas_r41d(name,head,error,data)
  use image_def
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_mapgildas_r41d
  !---------------------------------------------------------------------
  ! @ public-generic sic_mapgildas
  !   Create an IMAGE SIC variable from an existing Header structure
  ! and data. It is global and program_defined.
  !---------------------------------------------------------------------
  character(len=*),     intent(in)    :: name     ! Header name
  type(gildas), target, intent(inout) :: head     ! Header
  logical(kind=4),      intent(inout) :: error    ! Logical error flag
  real(kind=4),         intent(in)    :: data(:)  !
  ! Local
  integer(kind=address_length) :: addr
  !
  addr = locwrd(data(1))
  call sub_mapgildas(name,head,fmt_r4,addr,error)
end subroutine sic_mapgildas_r41d
!
subroutine sic_mapgildas_r42d(name,head,error,data)
  use image_def
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_mapgildas_r42d
  !---------------------------------------------------------------------
  ! @ public-generic sic_mapgildas
  !   Create an IMAGE SIC variable from an existing Header structure
  ! and data. It is global and program_defined.
  !---------------------------------------------------------------------
  character(len=*),     intent(in)    :: name     ! Header name
  type(gildas), target, intent(inout) :: head     ! Header
  logical(kind=4),      intent(inout) :: error    ! Logical error flag
  real(kind=4),         intent(in)    :: data(:,:)  !
  ! Local
  integer(kind=address_length) :: addr
  !
  addr = locwrd(data(1,1))
  call sub_mapgildas(name,head,fmt_r4,addr,error)
end subroutine sic_mapgildas_r42d
!
subroutine sic_mapgildas_r43d(name,head,error,data)
  use image_def
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_mapgildas_r43d
  !---------------------------------------------------------------------
  ! @ public-generic sic_mapgildas
  !   Create an IMAGE SIC variable from an existing Header structure
  ! and data. It is global and program_defined.
  !---------------------------------------------------------------------
  character(len=*),     intent(in)    :: name     ! Header name
  type(gildas), target, intent(inout) :: head     ! Header
  logical(kind=4),      intent(inout) :: error    ! Logical error flag
  real(kind=4),         intent(in)    :: data(:,:,:)  !
  ! Local
  integer(kind=address_length) :: addr
  !
  addr = locwrd(data(1,1,1))
  call sub_mapgildas(name,head,fmt_r4,addr,error)
end subroutine sic_mapgildas_r43d
!
subroutine sic_mapgildas_r44d(name,head,error,data)
  use image_def
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_mapgildas_r44d
  !---------------------------------------------------------------------
  ! @ public-generic sic_mapgildas
  !   Create an IMAGE SIC variable from an existing Header structure
  ! and data. It is global and program_defined.
  !---------------------------------------------------------------------
  character(len=*),     intent(in)    :: name     ! Header name
  type(gildas), target, intent(inout) :: head     ! Header
  logical(kind=4),      intent(inout) :: error    ! Logical error flag
  real(kind=4),         intent(in)    :: data(:,:,:,:)  !
  ! Local
  integer(kind=address_length) :: addr
  !
  addr = locwrd(data(1,1,1,1))
  call sub_mapgildas(name,head,fmt_r4,addr,error)
end subroutine sic_mapgildas_r44d
!
subroutine sic_mapgildas_r81d(name,head,error,data)
  use image_def
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_mapgildas_r81d
  !---------------------------------------------------------------------
  ! @ public-generic sic_mapgildas
  !   Create an IMAGE SIC variable from an existing Header structure
  ! and data. It is global and program_defined.
  !---------------------------------------------------------------------
  character(len=*),     intent(in)    :: name     ! Header name
  type(gildas), target, intent(inout) :: head     ! Header
  logical(kind=4),      intent(inout) :: error    ! Logical error flag
  real(kind=8),         intent(in)    :: data(:)  !
  ! Local
  integer(kind=address_length) :: addr
  !
  addr = locwrd(data(1))
  call sub_mapgildas(name,head,fmt_r8,addr,error)
end subroutine sic_mapgildas_r81d
!
subroutine sic_mapgildas_r82d(name,head,error,data)
  use image_def
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_mapgildas_r82d
  !---------------------------------------------------------------------
  ! @ public-generic sic_mapgildas
  !   Create an IMAGE SIC variable from an existing Header structure
  ! and data. It is global and program_defined.
  !---------------------------------------------------------------------
  character(len=*),     intent(in)    :: name     ! Header name
  type(gildas), target, intent(inout) :: head     ! Header
  logical(kind=4),      intent(inout) :: error    ! Logical error flag
  real(kind=8),         intent(in)    :: data(:,:)  !
  ! Local
  integer(kind=address_length) :: addr
  !
  addr = locwrd(data(1,1))
  call sub_mapgildas(name,head,fmt_r8,addr,error)
end subroutine sic_mapgildas_r82d
!
subroutine sic_mapgildas_r83d(name,head,error,data)
  use image_def
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_mapgildas_r83d
  !---------------------------------------------------------------------
  ! @ public-generic sic_mapgildas
  !   Create an IMAGE SIC variable from an existing Header structure
  ! and data. It is global and program_defined.
  !---------------------------------------------------------------------
  character(len=*),     intent(in)    :: name     ! Header name
  type(gildas), target, intent(inout) :: head     ! Header
  logical(kind=4),      intent(inout) :: error    ! Logical error flag
  real(kind=8),         intent(in)    :: data(:,:,:)  !
  ! Local
  integer(kind=address_length) :: addr
  !
  addr = locwrd(data(1,1,1))
  call sub_mapgildas(name,head,fmt_r8,addr,error)
end subroutine sic_mapgildas_r83d
!
subroutine sic_mapgildas_r84d(name,head,error,data)
  use image_def
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sic_mapgildas_r84d
  !---------------------------------------------------------------------
  ! @ public-generic sic_mapgildas
  !   Create an IMAGE SIC variable from an existing Header structure
  ! and data. It is global and program_defined.
  !---------------------------------------------------------------------
  character(len=*),     intent(in)    :: name     ! Header name
  type(gildas), target, intent(inout) :: head     ! Header
  logical(kind=4),      intent(inout) :: error    ! Logical error flag
  real(kind=8),         intent(in)    :: data(:,:,:,:)  !
  ! Local
  integer(kind=address_length) :: addr
  !
  addr = locwrd(data(1,1,1,1))
  call sub_mapgildas(name,head,fmt_r8,addr,error)
end subroutine sic_mapgildas_r84d
!
subroutine sub_mapgildas(name,head,fmt,address,error)
  use image_def
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>sub_mapgildas
  use sic_structures
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ public-generic sic_mapgildas
  !   Create an IMAGE SIC variable from an existing Header structure
  ! and data (specified by its address and size). 
  ! It is global and program_defined.
  !---------------------------------------------------------------------
  character(len=*),             intent(in)    :: name     ! Header name
  type(gildas), target,         intent(inout) :: head     ! Header
  integer(kind=4),              intent(in)    :: fmt      ! Data type (fmt_r4,...)
  integer(kind=address_length), intent(in)    :: address  ! Address of data
  logical(kind=4),              intent(inout) :: error    ! Logical error flag
  ! Local
  type(sic_descriptor_t) :: desc
  type(sic_identifier_t) :: var
  integer(kind=4) :: in,ier,lf
  !
  ! Warning:  
  !   A combination of SIC_DEF_REAL and SIC_DEF_HEADER apparently
  ! provides a similar functionality, but would be different.
  ! The main differences are
  !   1)  readonly attribute is NOT possible here
  !   2)  a simple call to sic_delvariable can delete
  !       the whole structure created by sic_mapgildas
  !
  var%name = name
  lf = len_trim(var%name)
  var%lname = lf
  var%level = 0                         ! Global of course
  ier = sic_hasins('DEFINE',maxvar,pfvar,pnvar,dicvar,var,in)
  if (ier.eq.0 .or. ier.eq.2) then
    error = .true.
    return
  endif
  !
  if (address.eq.ptr_null) then  ! Header only
    desc%type = 0
    desc%addr = ptr_null
    desc%head => head
    desc%ndim = 0
    desc%dims(:) = 0
    desc%size = 0
  else                 ! Header and data
    desc%type = fmt
    desc%addr = address 
    desc%head => head
    desc%ndim = head%gil%ndim
    desc%dims(:) = head%gil%dim
    desc%size = desc_nword(desc)
  endif
  desc%readonly = .true.
  desc%status = program_defined
  !
  ! "Program defined" global variable are not tracked
  ! by the VAR_G - VAR_N stuff
  !
  ! Set the descriptor
  dicvar(in)%desc = desc
  ! and only after that, define the associated Header 
  call sub_def_header(var,'%',head,.false.,-1,error)
end subroutine sub_mapgildas
