subroutine reduce (line,key,vblank8,eblank8,error)
  use gildas_def
  use gbl_format
  use gbl_message
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>reduce
  use sic_dictionaries
  use sic_types
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !   COMPUTE MAX|MIN|MEAN|RMS|SUM|PRODUCT|MEDIAN|QUANTILE
  ! (mathematical reduction functions)
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line     !
  character(len=*), intent(in)    :: key      !
  real(kind=8),     intent(in)    :: vblank8  !
  real(kind=8),     intent(in)    :: eblank8  !
  logical,          intent(inout) :: error    !
  ! Global
  external :: comp_r4_min,comp_r4_max,comp_r8_min,comp_r8_max
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='COMPUTE'
  character(len=80) :: varin,varout
  type(sic_descriptor_t) :: descin,descout,desccopy
  integer(kind=address_length) :: ipnta,ipntb
  logical :: found
  integer :: typein,typeout,nc
  integer(kind=index_length) :: ida(sic_maxdims),idb(sic_maxdims)
  integer :: ndim,i,nkeep
  integer(kind=size_length) :: nvec
  real(kind=4) :: vblank4,eblank4
  logical :: is_vector
  !
  call sic_ke (line,0,3,varin,nc,.true.,error)
  if (error) return
  call sic_ke (line,0,1,varout,nc,.true.,error)
  if (error) return
  !
  found = .true.
  call sic_materialize(varin,descin,found)
  if (.not.found) then
    call sic_message(seve%e,rname,'Input Variable Non Existent')
    error = .true.
    return
  endif
  call sic_descriptor(varout,descout,found)
  if (.not.found) then
    call sic_message(seve%e,rname,'Output Variable Non Existent')
    error = .true.
    call sic_volatile(descin)
    return
  elseif (descout%status.eq.scratch_operand) then
    call sic_message(seve%e,rname,'Non contiguous sub-array not supported '//  &
    'for the output variable')
    call sic_volatile(descin)
    call sic_volatile(descout)
    error = .true.
    return
  endif
  typeout = descout%type
  if (descout%readonly) then
    call sic_message(seve%e,rname,'Output variable cannot be written')
    call sic_volatile(descin)
    error = .true.
    return
  elseif (typeout.ne.fmt_r4 .and. typeout.ne.fmt_r8) then
    call sic_message(seve%e,rname,'Output variable must be Real')
    call sic_volatile(descin)
    error = .true.
    return
  endif
  !
  is_vector = key.eq.'QUANTILE'  ! The output is vector
  !
  ! Check dimensions. Allow scalar result
  if (is_vector) then
    if (descout%ndim.lt.1) then
      call sic_message(seve%e,rname,  &
        'Last OUT dimension must be positive for '//key)
      call sic_volatile(descin)
      error = .true.
      return
    endif
    nvec = descout%dims(descout%ndim)
    nkeep = descout%ndim-1
    if (nkeep.gt.descin%ndim) then
      call sic_message(seve%e,rname,  &
        'OUT dim must be at most IN dim plus '//trim(key)//' dim')
      call sic_volatile(descin)
      error = .true.
      return
    elseif (nkeep.eq.descin%ndim .and. descin%ndim.ne.0) then
      ! Allow Last dimension 1 ...
      descin%ndim = descin%ndim+1
      descin%dims(descin%ndim) = 1
    endif
    ndim = nkeep
    do i=1,ndim
      if (descout%dims(i).ne.descin%dims(i)) then
        call sic_message(seve%e,rname,'Common dimensions do not match')
        call sic_volatile(descin)
        error =.true.
        return
      endif
    enddo
  else
    if (descout%ndim.ge.descin%ndim .and. descin%ndim.ne.0) then
      ! Allow Last dimension 1 ...
      if (descout%ndim.eq.descin%ndim) then
        descin%ndim = descin%ndim+1
        descin%dims(descin%ndim) = 1
      else
        call sic_message(seve%e,rname,'OUT dim must be less than IN dim')
        call sic_volatile(descin)
        error =.true.
        return
      endif
    endif
    ndim=descout%ndim
    do i=1,ndim
      if (descout%dims(i).ne.descin%dims(i)) then
        call sic_message(seve%e,rname,'Common dimensions do not match')
        call sic_volatile(descin)
        error =.true.
        return
      endif
    enddo
    ! This will make things simpler in this case:
    if (ndim.le.1.and.descout%dims(1).le.1) ndim=0
  endif
  !
  typein = descin%type
  if (typein.ne.fmt_r4 .and. typein.ne.fmt_r8 .and.  &
      typein.ne.fmt_i4 .and. typein.ne.fmt_i8) then
    call sic_message(seve%e,rname,'Input variable must be Real or Integer')
    call sic_volatile(descin)
    error = .true.
    return
  endif
  !
  if (typein.eq.fmt_i4 .or. typein.eq.fmt_i8) then
    ! Cast the integer array in a real copy. Precision is controled by the
    ! output variable.
    call sic_incarnate(typeout,descin,desccopy,error)
    if (error)  return
    call sic_volatile(descin)  ! Suppress the original (i4/i8) materialization
    descin = desccopy          ! New descriptor takes place of the original one
    typein = typeout           ! in the subsequent computations
  endif
  !
  ipnta = gag_pointer(descin%addr,memory)
  ipntb = gag_pointer(descout%addr,memory)
  do i=1,sic_maxdims
    ida(i)=descin%dims(i)
    if (ida(i).le.0) ida(i)=1
    idb(i)=descout%dims(i)
    if (idb(i).le.0) idb(i)=1
  enddo
  !
  error = .false.
  vblank4 = vblank8
  eblank4 = eblank8
  if (typein.eq.fmt_r8) then
    if (typeout.eq.fmt_r8) then
      call reduce_r8tor8(key)
    else
      call reduce_r8tor4(key)
    endif
  else
    if (typeout.eq.fmt_r8) then
      call reduce_r4tor8(key)
    else
      call reduce_r4tor4(key)
    endif
  endif
  call sic_volatile(descin)
  return
  !
contains
  subroutine reduce_r8tor8(key)
    use sic_interfaces
    character(len=*), intent(in) :: key
    if (key.eq.'MEAN') then
      call comp_r8tor8_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r8_mean,vblank8,eblank8,error)
    elseif (key.eq.'SUM') then
      call comp_r8tor8_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r8_sum,vblank8,eblank8,error)
    elseif (key.eq.'MIN') then
      call comp_r8tor8_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r8_min,vblank8,eblank8,error)
    elseif (key.eq.'MAX') then
      call comp_r8tor8_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r8_max,vblank8,eblank8,error)
    elseif (key.eq.'RMS') then
      call comp_r8tor8_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r8_rms,vblank8,eblank8,error)
    elseif (key.eq.'PRODUCT') then
      call comp_r8tor8_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r8_prod,vblank8,eblank8,error)
    elseif (key.eq.'MEDIAN') then
      call comp_r8tor8_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r8_median,vblank8,eblank8,error)
    elseif (key.eq.'QUANTILE') then
      call comp_r8tor8vec_all(ndim,key,memory(ipnta),ida,  &
      memory(ipntb),idb,nvec,comp_r8_quantile,vblank8,eblank8,error)
    endif
  end subroutine reduce_r8tor8
  !
  subroutine reduce_r8tor4(key)
    use sic_interfaces
    character(len=*), intent(in) :: key
    if (key.eq.'MEAN') then
      call comp_r8tor4_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_mean,vblank4,eblank4,error)
    elseif (key.eq.'SUM') then
      call comp_r8tor4_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_sum,vblank4,eblank4,error)
    elseif (key.eq.'MIN') then
      call comp_r8tor4_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_min,vblank4,eblank4,error)
    elseif (key.eq.'MAX') then
      call comp_r8tor4_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_max,vblank4,eblank4,error)
    elseif (key.eq.'RMS') then
      call comp_r8tor4_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_rms,vblank4,eblank4,error)
    elseif (key.eq.'PRODUCT') then
      call comp_r8tor4_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_prod,vblank4,eblank4,error)
    elseif (key.eq.'MEDIAN') then
      call comp_r8tor4_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_median,vblank4,eblank4,error)
    elseif (key.eq.'QUANTILE') then
      call comp_r8tor4vec_all(ndim,key,memory(ipnta),ida,  &
      memory(ipntb),idb,nvec,comp_r4_quantile,vblank4,eblank4,error)
    endif
  end subroutine reduce_r8tor4
  !
  subroutine reduce_r4tor8(key)
    use sic_interfaces
    character(len=*), intent(in) :: key
    if (key.eq.'MEAN') then
      call comp_r4tor8_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_mean,vblank4,eblank4,error)
    elseif (key.eq.'SUM') then
      call comp_r4tor8_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_sum,vblank4,eblank4,error)
    elseif (key.eq.'MIN') then
      call comp_r4tor8_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_min,vblank4,eblank4,error)
    elseif (key.eq.'MAX') then
      call comp_r4tor8_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_max,vblank4,eblank4,error)
    elseif (key.eq.'RMS') then
      call comp_r4tor8_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_rms,vblank4,eblank4,error)
    elseif (key.eq.'PRODUCT') then
      call comp_r4tor8_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_prod,vblank4,eblank4,error)
    elseif (key.eq.'MEDIAN') then
      call comp_r4tor8_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_median,vblank4,eblank4,error)
    elseif (key.eq.'QUANTILE') then
      call comp_r4tor8vec_all(ndim,key,memory(ipnta),ida,  &
      memory(ipntb),idb,nvec,comp_r4_quantile,vblank4,eblank4,error)
    endif
  end subroutine reduce_r4tor8
  !
  subroutine reduce_r4tor4(key)
    use sic_interfaces
    character(len=*), intent(in) :: key
    if (key.eq.'MEAN') then
      call comp_r4tor4_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_mean,vblank4,eblank4,error)
    elseif (key.eq.'SUM') then
      call comp_r4tor4_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_sum,vblank4,eblank4,error)
    elseif (key.eq.'MIN') then
      call comp_r4tor4_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_min,vblank4,eblank4,error)
    elseif (key.eq.'MAX') then
      call comp_r4tor4_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_max,vblank4,eblank4,error)
    elseif (key.eq.'RMS') then
      call comp_r4tor4_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_rms,vblank4,eblank4,error)
    elseif (key.eq.'PRODUCT') then
      call comp_r4tor4_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_prod,vblank4,eblank4,error)
    elseif (key.eq.'MEDIAN') then
      call comp_r4tor4_all(ndim,key,memory(ipnta),ida,memory(ipntb),idb,  &
      comp_r4_median,vblank4,eblank4,error)
    elseif (key.eq.'QUANTILE') then
      call comp_r4tor4vec_all(ndim,key,memory(ipnta),ida,  &
      memory(ipntb),idb,nvec,comp_r4_quantile,vblank4,eblank4,error)
    endif
  end subroutine reduce_r4tor4
  !
end subroutine reduce
!
subroutine comp_r4tor4_all(ndim,key,a,na,b,nb,myfunc,vblank4,eblank4,error)
  use sic_interfaces
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Compute the value for common leading dimensions, storing the result
  ! in a scalar value.
  ! This version for sic_maxdims==7
  !---------------------------------------------------------------------
  integer(kind=4),            intent(in)    :: ndim     !
  character(len=*),           intent(in)    :: key      !
  real(kind=4),               intent(in)    :: a(*)     !
  integer(kind=index_length), intent(in)    :: na(7)    !
  real(kind=4),               intent(out)   :: b(*)     !
  integer(kind=index_length), intent(in)    :: nb(7)    !
  external                                  :: myfunc   !
  real(kind=4),               intent(in)    :: vblank4  !
  real(kind=4),               intent(in)    :: eblank4  !
  logical,                    intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='COMP_R4TOR4_ALL'
  integer(kind=index_length) :: i1,i2,i3,i4,i5,i6
  integer(kind=size_length) :: ioff,dima
  real(kind=4), allocatable :: cwork(:)
  integer :: ier
  logical :: perror
  !
  i6 = 1
  i5 = 1
  i4 = 1
  i3 = 1
  i2 = 1
  i1 = 1
  !
  select case (ndim)
  case(1)
    dima=na(2)*na(3)*na(4)*na(5)*na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,ioff,cwork,ier,perror) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank4,eblank4,i2,i3,i4,i5,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(1)
      do i1=1,nb(1)
        ! Collect last dims of A in CWORK
        ioff = i1
        call collect_w4tow4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
          cwork,i1,i2,i3,i4,i5,i6)
        call myfunc(cwork,dima,vblank4,eblank4,b(ioff))
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(2)
    dima=na(3)*na(4)*na(5)*na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,ioff,cwork,ier,perror) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank4,eblank4,i3,i4,i5,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(2)
      do i2=1,nb(2)
        do i1=1,nb(1)
          ! Collect last dims of A in CWORK
          ioff = (i2-1)*nb(1)+i1
          call collect_w4tow4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
            cwork,i1,i2,i3,i4,i5,i6)
          call myfunc(cwork,dima,vblank4,eblank4,b(ioff))
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(3)
    dima=na(4)*na(5)*na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,i3,ioff,cwork,ier,perror) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank4,eblank4,i4,i5,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(3)
      do i3=1,nb(3)
        do i2=1,nb(2)
          do i1=1,nb(1)
            ! Collect last dims of A in CWORK
            ioff = (i3-1)*nb(1)*nb(2)+(i2-1)*nb(1)+i1
            call collect_w4tow4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
              cwork,i1,i2,i3,i4,i5,i6)
            call myfunc(cwork,dima,vblank4,eblank4,b(ioff))
          enddo
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(4)
    dima=na(5)*na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,i3,i4,ioff,cwork,ier,perror) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank4,eblank4,i5,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(4)
      do i4=1,nb(4)
        do i3=1,nb(3)
          do i2=1,nb(2)
            do i1=1,nb(1)
              ! Collect last dims of A in CWORK
              ioff = (i4-1)*nb(1)*nb(2)*nb(3) +  &
                     (i3-1)*nb(1)*nb(2) +  &
                     (i2-1)*nb(1) + i1
              call collect_w4tow4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
                cwork,i1,i2,i3,i4,i5,i6)
              call myfunc(cwork,dima,vblank4,eblank4,b(ioff))
            enddo
          enddo
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(5)
    dima=na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,i3,i4,i5,ioff,cwork,ier,perror) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank4,eblank4,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(5)
      do i5=1,nb(5)
        do i4=1,nb(4)
          do i3=1,nb(3)
            do i2=1,nb(2)
              do i1=1,nb(1)
                ! Collect last dims of A in CWORK
                ioff = (i5-1)*nb(1)*nb(2)*nb(3)*nb(4) +  &
                       (i4-1)*nb(1)*nb(2)*nb(3) +  &
                       (i3-1)*nb(1)*nb(2) +  &
                       (i2-1)*nb(1) + i1
                call collect_w4tow4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
                  cwork,i1,i2,i3,i4,i5,i6)
                call myfunc(cwork,dima,vblank4,eblank4,b(ioff))
              enddo
            enddo
          enddo
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(6)
    dima=na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,i3,i4,i5,i6,ioff,cwork,ier,perror) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank4,eblank4)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(6)
      do i6=1,nb(6)
        do i5=1,nb(5)
          do i4=1,nb(4)
            do i3=1,nb(3)
              do i2=1,nb(2)
                do i1=1,nb(1)
                  ! Collect last dims of A in CWORK
                  ioff = (i6-1)*nb(1)*nb(2)*nb(3)*nb(4)*nb(5) +  &
                         (i5-1)*nb(1)*nb(2)*nb(3)*nb(4) +  &
                         (i4-1)*nb(1)*nb(2)*nb(3) +  &
                         (i3-1)*nb(1)*nb(2) +  &
                         (i2-1)*nb(1) + i1
                  call collect_w4tow4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
                    cwork,i1,i2,i3,i4,i5,i6)
                  call myfunc(cwork,dima,vblank4,eblank4,b(ioff))
                enddo
              enddo
            enddo
          enddo
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(0)
    ! The simplest case: collect all dims of A in B
    dima=na(1)*na(2)*na(3)*na(4)*na(5)*na(6)*na(7)
    call myfunc(a,dima,vblank4,eblank4,b)
    !
  case default
    call sic_message(seve%e,rname,'Internal error')
    error = .true.
    return
  end select
  !
end subroutine comp_r4tor4_all
!
subroutine comp_r8tor8_all(ndim,key,a,na,b,nb,myfunc,vblank8,eblank8,error)
  use sic_interfaces
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Compute the value for common leading dimensions, storing the result
  ! in a scalar value.
  ! This version for sic_maxdims==7
  !---------------------------------------------------------------------
  integer(kind=4),            intent(in)    :: ndim     !
  character(len=*),           intent(in)    :: key      !
  real(kind=8),               intent(in)    :: a(*)     !
  integer(kind=index_length), intent(in)    :: na(7)    !
  real(kind=8),               intent(out)   :: b(*)     !
  integer(kind=index_length), intent(in)    :: nb(7)    !
  external                                  :: myfunc   !
  real(kind=8),               intent(in)    :: vblank8  !
  real(kind=8),               intent(in)    :: eblank8  !
  logical,                    intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='COMP_R8TOR8_ALL'
  integer(kind=index_length) :: i1,i2,i3,i4,i5,i6
  integer(kind=size_length) :: ioff,dima
  real(kind=8), allocatable :: cwork(:)
  integer :: ier
  logical :: perror
  !
  i6 = 1
  i5 = 1
  i4 = 1
  i3 = 1
  i2 = 1
  i1 = 1
  !
  select case (ndim)
  case(1)
    dima=na(2)*na(3)*na(4)*na(5)*na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,ioff,cwork,ier,perror) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank8,eblank8,i2,i3,i4,i5,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(1)
      do i1=1,nb(1)
        ! Collect last dims of A in CWORK
        ioff = i1
        call collect_w8tow8(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
          cwork,i1,i2,i3,i4,i5,i6)
        call myfunc(cwork,dima,vblank8,eblank8,b(ioff))
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(2)
    dima=na(3)*na(4)*na(5)*na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,ioff,cwork,ier,perror) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank8,eblank8,i3,i4,i5,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(2)
      do i2=1,nb(2)
        do i1=1,nb(1)
          ! Collect last dims of A in CWORK
          ioff = (i2-1)*nb(1)+i1
          call collect_w8tow8(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
            cwork,i1,i2,i3,i4,i5,i6)
          call myfunc(cwork,dima,vblank8,eblank8,b(ioff))
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(3)
    dima=na(4)*na(5)*na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,i3,ioff,cwork,ier,perror) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank8,eblank8,i4,i5,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(3)
      do i3=1,nb(3)
        do i2=1,nb(2)
          do i1=1,nb(1)
            ! Collect last dims of A in CWORK
            ioff = (i3-1)*nb(1)*nb(2)+(i2-1)*nb(1)+i1
            call collect_w8tow8(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
              cwork,i1,i2,i3,i4,i5,i6)
            call myfunc(cwork,dima,vblank8,eblank8,b(ioff))
          enddo
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(4)
    dima=na(5)*na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,i3,i4,ioff,cwork,ier,perror) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank8,eblank8,i5,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(4)
      do i4=1,nb(4)
        do i3=1,nb(3)
          do i2=1,nb(2)
            do i1=1,nb(1)
              ! Collect last dims of A in CWORK
              ioff = (i4-1)*nb(1)*nb(2)*nb(3) +  &
                     (i3-1)*nb(1)*nb(2) +  &
                     (i2-1)*nb(1) + i1
              call collect_w8tow8(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
                cwork,i1,i2,i3,i4,i5,i6)
              call myfunc(cwork,dima,vblank8,eblank8,b(ioff))
            enddo
          enddo
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(5)
    dima=na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,i3,i4,i5,ioff,cwork,ier,perror) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank8,eblank8,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(5)
      do i5=1,nb(5)
        do i4=1,nb(4)
          do i3=1,nb(3)
            do i2=1,nb(2)
              do i1=1,nb(1)
                ! Collect last dims of A in CWORK
                ioff = (i5-1)*nb(1)*nb(2)*nb(3)*nb(4) +  &
                       (i4-1)*nb(1)*nb(2)*nb(3) +  &
                       (i3-1)*nb(1)*nb(2) +  &
                       (i2-1)*nb(1) + i1
                call collect_w8tow8(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
                  cwork,i1,i2,i3,i4,i5,i6)
                call myfunc(cwork,dima,vblank8,eblank8,b(ioff))
              enddo
            enddo
          enddo
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(6)
    dima=na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,i3,i4,i5,i6,ioff,cwork,ier,perror) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank8,eblank8)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(6)
      do i6=1,nb(6)
        do i5=1,nb(5)
          do i4=1,nb(4)
            do i3=1,nb(3)
              do i2=1,nb(2)
                do i1=1,nb(1)
                  ! Collect last dims of A in CWORK
                  ioff = (i6-1)*nb(1)*nb(2)*nb(3)*nb(4)*nb(5) +  &
                         (i5-1)*nb(1)*nb(2)*nb(3)*nb(4) +  &
                         (i4-1)*nb(1)*nb(2)*nb(3) +  &
                         (i3-1)*nb(1)*nb(2) +  &
                         (i2-1)*nb(1) + i1
                  call collect_w8tow8(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
                    cwork,i1,i2,i3,i4,i5,i6)
                  call myfunc(cwork,dima,vblank8,eblank8,b(ioff))
                enddo
              enddo
            enddo
          enddo
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(0)
    ! The simplest case: collect all dims of A in B
    dima=na(1)*na(2)*na(3)*na(4)*na(5)*na(6)*na(7)
    call myfunc(a,dima,vblank8,eblank8,b)
    !
  case default
    call sic_message(seve%e,rname,'Internal error')
    error = .true.
    return
  end select
  !
end subroutine comp_r8tor8_all
!
subroutine comp_r8tor4_all(ndim,key,a,na,b,nb,myfunc,vblank4,eblank4,error)
  use sic_interfaces
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Compute the value for common leading dimensions, storing the result
  ! in a scalar value.
  ! This version for sic_maxdims==7
  !---------------------------------------------------------------------
  integer(kind=4),            intent(in)    :: ndim     !
  character(len=*),           intent(in)    :: key      !
  real(kind=8),               intent(in)    :: a(*)     !
  integer(kind=index_length), intent(in)    :: na(7)    !
  real(kind=4),               intent(out)   :: b(*)     !
  integer(kind=index_length), intent(in)    :: nb(7)    !
  external                                  :: myfunc   !
  real(kind=4),               intent(in)    :: vblank4  !
  real(kind=4),               intent(in)    :: eblank4  !
  logical,                    intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='COMP_R8TOR4_ALL'
  integer(kind=index_length) :: i1,i2,i3,i4,i5,i6
  integer(kind=size_length) :: ioff,dima
  real(kind=4), allocatable :: cwork(:)
  integer :: ier
  logical :: perror
  !
  i6 = 1
  i5 = 1
  i4 = 1
  i3 = 1
  i2 = 1
  i1 = 1
  !
  select case (ndim)
  case(1)
    dima=na(2)*na(3)*na(4)*na(5)*na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,ioff,cwork,ier,perror) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank4,eblank4,i2,i3,i4,i5,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(1)
      do i1=1,nb(1)
        ! Collect last dims of A in CWORK
        ioff = i1
        call collect_r8tor4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
          cwork,i1,i2,i3,i4,i5,i6)
        call myfunc(cwork,dima,vblank4,eblank4,b(ioff))
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(2)
    dima=na(3)*na(4)*na(5)*na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,ioff,cwork,ier,perror) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank4,eblank4,i3,i4,i5,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(2)
      do i2=1,nb(2)
        do i1=1,nb(1)
          ! Collect last dims of A in CWORK
          ioff = (i2-1)*nb(1)+i1
          call collect_r8tor4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
            cwork,i1,i2,i3,i4,i5,i6)
          call myfunc(cwork,dima,vblank4,eblank4,b(ioff))
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(3)
    dima=na(4)*na(5)*na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,i3,ioff,cwork,ier,perror) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank4,eblank4,i4,i5,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(3)
      do i3=1,nb(3)
        do i2=1,nb(2)
          do i1=1,nb(1)
            ! Collect last dims of A in CWORK
            ioff = (i3-1)*nb(1)*nb(2)+(i2-1)*nb(1)+i1
            call collect_r8tor4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
              cwork,i1,i2,i3,i4,i5,i6)
            call myfunc(cwork,dima,vblank4,eblank4,b(ioff))
          enddo
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(4)
    dima=na(5)*na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,i3,i4,ioff,cwork,ier,perror) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank4,eblank4,i5,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(4)
      do i4=1,nb(4)
        do i3=1,nb(3)
          do i2=1,nb(2)
            do i1=1,nb(1)
              ! Collect last dims of A in CWORK
              ioff = (i4-1)*nb(1)*nb(2)*nb(3) +  &
                     (i3-1)*nb(1)*nb(2) +  &
                     (i2-1)*nb(1) + i1
              call collect_r8tor4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
                cwork,i1,i2,i3,i4,i5,i6)
              call myfunc(cwork,dima,vblank4,eblank4,b(ioff))
            enddo
          enddo
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(5)
    dima=na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,i3,i4,i5,ioff,cwork,ier,perror) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank4,eblank4,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(5)
      do i5=1,nb(5)
        do i4=1,nb(4)
          do i3=1,nb(3)
            do i2=1,nb(2)
              do i1=1,nb(1)
                ! Collect last dims of A in CWORK
                ioff = (i5-1)*nb(1)*nb(2)*nb(3)*nb(4) +  &
                       (i4-1)*nb(1)*nb(2)*nb(3) +  &
                       (i3-1)*nb(1)*nb(2) +  &
                       (i2-1)*nb(1) + i1
                call collect_r8tor4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
                  cwork,i1,i2,i3,i4,i5,i6)
                call myfunc(cwork,dima,vblank4,eblank4,b(ioff))
              enddo
            enddo
          enddo
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(6)
    dima=na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,i3,i4,i5,i6,ioff,cwork,ier,perror) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank4,eblank4)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(6)
      do i6=1,nb(6)
        do i5=1,nb(5)
          do i4=1,nb(4)
            do i3=1,nb(3)
              do i2=1,nb(2)
                do i1=1,nb(1)
                  ! Collect last dims of A in CWORK
                  ioff = (i6-1)*nb(1)*nb(2)*nb(3)*nb(4)*nb(5) +  &
                         (i5-1)*nb(1)*nb(2)*nb(3)*nb(4) +  &
                         (i4-1)*nb(1)*nb(2)*nb(3) +  &
                         (i3-1)*nb(1)*nb(2) +  &
                         (i2-1)*nb(1) + i1
                  call collect_r8tor4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
                    cwork,i1,i2,i3,i4,i5,i6)
                  call myfunc(cwork,dima,vblank4,eblank4,b(ioff))
                enddo
              enddo
            enddo
          enddo
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(0)
    ! The simplest case: collect all dims of A in B
    dima=na(1)*na(2)*na(3)*na(4)*na(5)*na(6)*na(7)
    allocate(cwork(dima),stat=ier)
    if (failed_allocate(key,'cwork',ier,error))  return
    call r8tor4_sl(a,cwork,dima)
    call myfunc(cwork,dima,vblank4,eblank4,b)
    deallocate(cwork)
    !
  case default
    call sic_message(seve%e,rname,'Internal error')
    error = .true.
    return
  end select
  !
end subroutine comp_r8tor4_all
!
subroutine comp_r4tor8_all(ndim,key,a,na,b,nb,myfunc,vblank4,eblank4,error)
  use sic_interfaces
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Compute the value for common leading dimensions, storing the result
  ! in a scalar value.
  ! This version for sic_maxdims==7
  !---------------------------------------------------------------------
  integer(kind=4),            intent(in)    :: ndim     !
  character(len=*),           intent(in)    :: key      !
  real(kind=4),               intent(in)    :: a(*)     !
  integer(kind=index_length), intent(in)    :: na(7)    !
  real(kind=8),               intent(out)   :: b(*)     !
  integer(kind=index_length), intent(in)    :: nb(7)    !
  external                                  :: myfunc   !
  real(kind=4),               intent(in)    :: vblank4  !
  real(kind=4),               intent(in)    :: eblank4  !
  logical,                    intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='COMP_R4TOR8_ALL'
  real :: res4               ! space optimisation
  integer(kind=index_length) :: i1,i2,i3,i4,i5,i6
  integer(kind=size_length) :: ioff,dima
  real(kind=4), allocatable :: cwork(:)
  integer :: ier
  logical :: perror
  !
  i6 = 1
  i5 = 1
  i4 = 1
  i3 = 1
  i2 = 1
  i1 = 1
  !
  select case(ndim)
  case(1)
    dima=na(2)*na(3)*na(4)*na(5)*na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,ioff,cwork,ier,perror,res4) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank4,eblank4,i2,i3,i4,i5,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(1)
      do i1=1,nb(1)
        ! Collect last dims of A in CWORK
        ioff = i1
        call collect_w4tow4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
          cwork,i1,i2,i3,i4,i5,i6)
        call myfunc(cwork,dima,vblank4,eblank4,res4)
        call r4tor8(res4,b(ioff),1)
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(2)
    dima=na(3)*na(4)*na(5)*na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,ioff,cwork,ier,perror,res4) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank4,eblank4,i3,i4,i5,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(2)
      do i2=1,nb(2)
        do i1=1,nb(1)
          ! Collect last dims of A in CWORK
          ioff = (i2-1)*nb(1)+i1
          call collect_w4tow4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
            cwork,i1,i2,i3,i4,i5,i6)
          call myfunc(cwork,dima,vblank4,eblank4,res4)
          call r4tor8(res4,b(ioff),1)
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(3)
    dima=na(4)*na(5)*na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,i3,ioff,cwork,ier,perror,res4) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank4,eblank4,i4,i5,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(3)
      do i3=1,nb(3)
        do i2=1,nb(2)
          do i1=1,nb(1)
            ! Collect last dims of A in CWORK
            ioff = (i3-1)*nb(1)*nb(2)+(i2-1)*nb(1)+i1
            call collect_w4tow4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
              cwork,i1,i2,i3,i4,i5,i6)
            call myfunc(cwork,dima,vblank4,eblank4,res4)
            call r4tor8(res4,b(ioff),1)
          enddo
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(4)
    dima=na(5)*na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,i3,i4,ioff,cwork,ier,perror,res4) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank4,eblank4,i5,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(4)
      do i4=1,nb(4)
        do i3=1,nb(3)
          do i2=1,nb(2)
            do i1=1,nb(1)
              ! Collect last dims of A in CWORK
              ioff = (i4-1)*nb(1)*nb(2)*nb(3) +  &
                     (i3-1)*nb(1)*nb(2) +  &
                     (i2-1)*nb(1) + i1
              call collect_w4tow4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
                cwork,i1,i2,i3,i4,i5,i6)
              call myfunc(cwork,dima,vblank4,eblank4,res4)
              call r4tor8(res4,b(ioff),1)
            enddo
          enddo
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(5)
    dima=na(6)*na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,i3,i4,i5,ioff,cwork,ier,perror,res4) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank4,eblank4,i6)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(5)
      do i5=1,nb(5)
        do i4=1,nb(4)
          do i3=1,nb(3)
            do i2=1,nb(2)
              do i1=1,nb(1)
                ! Collect last dims of A in CWORK
                ioff = (i5-1)*nb(1)*nb(2)*nb(3)*nb(4) +  &
                       (i4-1)*nb(1)*nb(2)*nb(3) +  &
                       (i3-1)*nb(1)*nb(2) +  &
                       (i2-1)*nb(1) + i1
                call collect_w4tow4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
                  cwork,i1,i2,i3,i4,i5,i6)
                call myfunc(cwork,dima,vblank4,eblank4,res4)
                call r4tor8(res4,b(ioff),1)
              enddo
            enddo
          enddo
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(6)
    dima=na(7)
    !$OMP PARALLEL &
    !$OMP DEFAULT(NONE) &
    !$OMP PRIVATE(i1,i2,i3,i4,i5,i6,ioff,cwork,ier,perror,res4) &
    !$OMP SHARED(key,error,ndim,a,na,dima,b,nb,vblank4,eblank4)
    allocate(cwork(dima),stat=ier)
    perror = .false.
    if (failed_allocate(key,'cwork',ier,perror)) then
      error = .true.
    else
      !$OMP DO COLLAPSE(6)
      do i6=1,nb(6)
        do i5=1,nb(5)
          do i4=1,nb(4)
            do i3=1,nb(3)
              do i2=1,nb(2)
                do i1=1,nb(1)
                  ! Collect last dims of A in CWORK
                  ioff = (i6-1)*nb(1)*nb(2)*nb(3)*nb(4)*nb(5) +  &
                         (i5-1)*nb(1)*nb(2)*nb(3)*nb(4) +  &
                         (i4-1)*nb(1)*nb(2)*nb(3) +  &
                         (i3-1)*nb(1)*nb(2) +  &
                         (i2-1)*nb(1) + i1
                  call collect_w4tow4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
                    cwork,i1,i2,i3,i4,i5,i6)
                  call myfunc(cwork,dima,vblank4,eblank4,res4)
                  call r4tor8(res4,b(ioff),1)
                enddo
              enddo
            enddo
          enddo
        enddo
      enddo
      !$OMP END DO
      deallocate(cwork)
    endif
    !$OMP END PARALLEL
    if (error)  return
    !
  case(0)
    ! The simplest case: collect all dims of A in B
    dima=na(1)*na(2)*na(3)*na(4)*na(5)*na(6)*na(7)
    call myfunc(a,dima,vblank4,eblank4,res4)
    call r4tor8(res4,b,1)
    !
  case default
    call sic_message(seve%e,rname,'Internal error')
    error = .true.
    return
  end select
  !
end subroutine comp_r4tor8_all
!
subroutine comp_r4tor4vec_all(ndim,key,a,na,b,nb,nvec,myfunc,  &
                                vblank4,eblank4,error)
  use sic_interfaces
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Compute the value for common leading dimensions, storing the result
  ! in a 1D vector.
  ! This version for sic_maxdims==7
  !---------------------------------------------------------------------
  integer(kind=4),            intent(in)    :: ndim     !
  character(len=*),           intent(in)    :: key      !
  real(kind=4),               intent(in)    :: a(*)     !
  integer(kind=index_length), intent(in)    :: na(7)    !
  real(kind=4),               intent(out)   :: b(*)     !
  integer(kind=index_length), intent(in)    :: nb(7)    !
  integer(kind=size_length),  intent(in)    :: nvec     !
  external                                  :: myfunc   !
  real(kind=4),               intent(in)    :: vblank4  !
  real(kind=4),               intent(in)    :: eblank4  !
  logical,                    intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='comp_r4tor4vec_all'
  integer(kind=index_length) :: i1,i2,i3,i4,i5,i6
  integer(kind=size_length) :: ioff,boff,dima,ncommon
  real(kind=4), allocatable :: cwork(:)
  real(kind=4), allocatable :: qwork(:)
  integer :: i,ier
  integer(kind=size_length) :: iq
  !
  if (ndim.lt.0 .or. ndim.gt.6) then
    call sic_message(seve%e,rname,'Internal error')
    error = .true.
    return
  endif
  ncommon = 1
  do i=1,ndim
    ncommon = ncommon*nb(i)
  enddo
  dima = 1
  do i=ndim+1,7
    dima = dima*na(i)
  enddo
  !
  allocate(qwork(nvec),stat=ier)
  if (failed_allocate(key,'qwork',ier,error))  return
  if (ndim.eq.0) then
    call myfunc(a,dima,vblank4,eblank4,qwork,nvec,error)
    if (error) then
      deallocate(qwork)
      return
    endif
    do iq=1,nvec
      b(iq) = qwork(iq)
    enddo
    deallocate(qwork)
    return
  endif
  !
  allocate(cwork(dima),stat=ier)
  if (failed_allocate(key,'cwork',ier,error)) then
    deallocate(qwork)
    return
  endif
  do ioff=1,ncommon
    call decode_reduce_indices(ndim,nb,ioff,i1,i2,i3,i4,i5,i6)
    call collect_w4tow4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
      cwork,i1,i2,i3,i4,i5,i6)
    call myfunc(cwork,dima,vblank4,eblank4,qwork,nvec,error)
    if (error)  exit
    do iq=1,nvec
      boff = ioff+(iq-1)*ncommon
      b(boff) = qwork(iq)
    enddo
  enddo
  deallocate(cwork)
  deallocate(qwork)
  !
end subroutine comp_r4tor4vec_all
!
subroutine comp_r8tor8vec_all(ndim,key,a,na,b,nb,nvec,myfunc,  &
                                vblank8,eblank8,error)
  use sic_interfaces
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Compute the value for common leading dimensions, storing the result
  ! in a 1D vector.
  ! This version for sic_maxdims==7
  !---------------------------------------------------------------------
  integer(kind=4),            intent(in)    :: ndim     !
  character(len=*),           intent(in)    :: key      !
  real(kind=8),               intent(in)    :: a(*)     !
  integer(kind=index_length), intent(in)    :: na(7)    !
  real(kind=8),               intent(out)   :: b(*)     !
  integer(kind=index_length), intent(in)    :: nb(7)    !
  integer(kind=size_length),  intent(in)    :: nvec   !
  external                                  :: myfunc   !
  real(kind=8),               intent(in)    :: vblank8  !
  real(kind=8),               intent(in)    :: eblank8  !
  logical,                    intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='comp_r8tor8vec_all'
  integer(kind=index_length) :: i1,i2,i3,i4,i5,i6
  integer(kind=size_length) :: ioff,boff,dima,ncommon
  real(kind=8), allocatable :: cwork(:)
  real(kind=8), allocatable :: qwork(:)
  integer :: i,ier
  integer(kind=size_length) :: iq
  !
  if (ndim.lt.0 .or. ndim.gt.6) then
    call sic_message(seve%e,rname,'Internal error')
    error = .true.
    return
  endif
  ncommon = 1
  do i=1,ndim
    ncommon = ncommon*nb(i)
  enddo
  dima = 1
  do i=ndim+1,7
    dima = dima*na(i)
  enddo
  !
  allocate(qwork(nvec),stat=ier)
  if (failed_allocate(key,'qwork',ier,error))  return
  if (ndim.eq.0) then
    call myfunc(a,dima,vblank8,eblank8,qwork,nvec,error)
    if (error) then
      deallocate(qwork)
      return
    endif
    do iq=1,nvec
      b(iq) = qwork(iq)
    enddo
    deallocate(qwork)
    return
  endif
  !
  allocate(cwork(dima),stat=ier)
  if (failed_allocate(key,'cwork',ier,error)) then
    deallocate(qwork)
    return
  endif
  do ioff=1,ncommon
    call decode_reduce_indices(ndim,nb,ioff,i1,i2,i3,i4,i5,i6)
    call collect_w8tow8(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
      cwork,i1,i2,i3,i4,i5,i6)
    call myfunc(cwork,dima,vblank8,eblank8,qwork,nvec,error)
    if (error)  exit
    do iq=1,nvec
      boff = ioff+(iq-1)*ncommon
      b(boff) = qwork(iq)
    enddo
  enddo
  deallocate(cwork)
  deallocate(qwork)
  !
end subroutine comp_r8tor8vec_all
!
subroutine comp_r8tor4vec_all(ndim,key,a,na,b,nb,nvec,myfunc,  &
                                vblank4,eblank4,error)
  use sic_interfaces
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Compute the value for common leading dimensions, storing the result
  ! in a 1D vector.
  ! This version for sic_maxdims==7
  !---------------------------------------------------------------------
  integer(kind=4),            intent(in)    :: ndim     !
  character(len=*),           intent(in)    :: key      !
  real(kind=8),               intent(in)    :: a(*)     !
  integer(kind=index_length), intent(in)    :: na(7)    !
  real(kind=4),               intent(out)   :: b(*)     !
  integer(kind=index_length), intent(in)    :: nb(7)    !
  integer(kind=size_length),  intent(in)    :: nvec   !
  external                                  :: myfunc   !
  real(kind=4),               intent(in)    :: vblank4  !
  real(kind=4),               intent(in)    :: eblank4  !
  logical,                    intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='comp_r8tor4vec_all'
  integer(kind=index_length) :: i1,i2,i3,i4,i5,i6
  integer(kind=size_length) :: ioff,boff,dima,ncommon
  real(kind=4), allocatable :: cwork(:)
  real(kind=4), allocatable :: qwork(:)
  integer :: i,ier
  integer(kind=size_length) :: iq
  !
  if (ndim.lt.0 .or. ndim.gt.6) then
    call sic_message(seve%e,rname,'Internal error')
    error = .true.
    return
  endif
  ncommon = 1
  do i=1,ndim
    ncommon = ncommon*nb(i)
  enddo
  dima = 1
  do i=ndim+1,7
    dima = dima*na(i)
  enddo
  !
  allocate(qwork(nvec),stat=ier)
  if (failed_allocate(key,'qwork',ier,error))  return
  allocate(cwork(dima),stat=ier)
  if (failed_allocate(key,'cwork',ier,error)) then
    deallocate(qwork)
    return
  endif
  if (ndim.eq.0) then
    call r8tor4_sl(a,cwork,dima)
    call myfunc(cwork,dima,vblank4,eblank4,qwork,nvec,error)
    if (.not.error) then
      do iq=1,nvec
        b(iq) = qwork(iq)
      enddo
    endif
    deallocate(cwork)
    deallocate(qwork)
    return
  endif
  !
  do ioff=1,ncommon
    call decode_reduce_indices(ndim,nb,ioff,i1,i2,i3,i4,i5,i6)
    call collect_r8tor4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
      cwork,i1,i2,i3,i4,i5,i6)
    call myfunc(cwork,dima,vblank4,eblank4,qwork,nvec,error)
    if (error)  exit
    do iq=1,nvec
      boff = ioff+(iq-1)*ncommon
      b(boff) = qwork(iq)
    enddo
  enddo
  deallocate(cwork)
  deallocate(qwork)
  !
end subroutine comp_r8tor4vec_all
!
subroutine comp_r4tor8vec_all(ndim,key,a,na,b,nb,nvec,myfunc,  &
                                vblank4,eblank4,error)
  use sic_interfaces
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Compute the value for common leading dimensions, storing the result
  ! in a 1D vector.
  ! This version for sic_maxdims==7
  !---------------------------------------------------------------------
  integer(kind=4),            intent(in)    :: ndim     !
  character(len=*),           intent(in)    :: key      !
  real(kind=4),               intent(in)    :: a(*)     !
  integer(kind=index_length), intent(in)    :: na(7)    !
  real(kind=8),               intent(out)   :: b(*)     !
  integer(kind=index_length), intent(in)    :: nb(7)    !
  integer(kind=size_length),  intent(in)    :: nvec   !
  external                                  :: myfunc   !
  real(kind=4),               intent(in)    :: vblank4  !
  real(kind=4),               intent(in)    :: eblank4  !
  logical,                    intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='comp_r4tor8vec_all'
  integer(kind=index_length) :: i1,i2,i3,i4,i5,i6
  integer(kind=size_length) :: ioff,boff,dima,ncommon
  real(kind=4), allocatable :: cwork(:)
  real(kind=4), allocatable :: qwork(:)
  integer :: i,ier
  integer(kind=size_length) :: iq
  !
  if (ndim.lt.0 .or. ndim.gt.6) then
    call sic_message(seve%e,rname,'Internal error')
    error = .true.
    return
  endif
  ncommon = 1
  do i=1,ndim
    ncommon = ncommon*nb(i)
  enddo
  dima = 1
  do i=ndim+1,7
    dima = dima*na(i)
  enddo
  !
  allocate(qwork(nvec),stat=ier)
  if (failed_allocate(key,'qwork',ier,error))  return
  if (ndim.eq.0) then
    call myfunc(a,dima,vblank4,eblank4,qwork,nvec,error)
    if (error) then
      deallocate(qwork)
      return
    endif
    do iq=1,nvec
      call r4tor8(qwork(iq),b(iq),1)
    enddo
    deallocate(qwork)
    return
  endif
  !
  allocate(cwork(dima),stat=ier)
  if (failed_allocate(key,'cwork',ier,error)) then
    deallocate(qwork)
    return
  endif
  do ioff=1,ncommon
    call decode_reduce_indices(ndim,nb,ioff,i1,i2,i3,i4,i5,i6)
    call collect_w4tow4(ndim,a,na(1),na(2),na(3),na(4),na(5),na(6),na(7),  &
      cwork,i1,i2,i3,i4,i5,i6)
    call myfunc(cwork,dima,vblank4,eblank4,qwork,nvec,error)
    if (error)  exit
    do iq=1,nvec
      boff = ioff+(iq-1)*ncommon
      call r4tor8(qwork(iq),b(boff),1)
    enddo
  enddo
  deallocate(cwork)
  deallocate(qwork)
  !
end subroutine comp_r4tor8vec_all
!
subroutine decode_reduce_indices(ndim,nb,ioff,i1,i2,i3,i4,i5,i6)
  use gildas_def
  !---------------------------------------------------------------------
  ! @ private
  ! Decode a 1-based linear offset in the common output dimensions.
  !---------------------------------------------------------------------
  integer(kind=4),            intent(in)  :: ndim
  integer(kind=index_length), intent(in)  :: nb(7)
  integer(kind=size_length),  intent(in)  :: ioff
  integer(kind=index_length), intent(out) :: i1,i2,i3,i4,i5,i6
  ! Local
  integer(kind=size_length) :: work,dim
  !
  i1 = 1
  i2 = 1
  i3 = 1
  i4 = 1
  i5 = 1
  i6 = 1
  work = ioff-1
  if (ndim.ge.1) then
    dim = nb(1)
    i1 = int(mod(work,dim),kind=index_length)+1
    work = work/dim
  endif
  if (ndim.ge.2) then
    dim = nb(2)
    i2 = int(mod(work,dim),kind=index_length)+1
    work = work/dim
  endif
  if (ndim.ge.3) then
    dim = nb(3)
    i3 = int(mod(work,dim),kind=index_length)+1
    work = work/dim
  endif
  if (ndim.ge.4) then
    dim = nb(4)
    i4 = int(mod(work,dim),kind=index_length)+1
    work = work/dim
  endif
  if (ndim.ge.5) then
    dim = nb(5)
    i5 = int(mod(work,dim),kind=index_length)+1
    work = work/dim
  endif
  if (ndim.ge.6) then
    dim = nb(6)
    i6 = int(mod(work,dim),kind=index_length)+1
  endif
  !
end subroutine decode_reduce_indices
!
subroutine collect_w4tow4(ndim,a,n1,n2,n3,n4,n5,n6,n7,w,j1,j2,j3,j4,j5,j6)
  use sic_interfaces, except_this=>collect_w4tow4
  use gildas_def
  !---------------------------------------------------------------------
  ! @ private
  !  Word-to-word collection of dimensions. Type is not relevant, use
  ! integer type (avoid IEEE floats because bits in NaN values may not
  ! preserved during copy)
  ! This version for sic_maxdims==7
  !---------------------------------------------------------------------
  integer(kind=4),            intent(in)  :: ndim
  integer(kind=index_length), intent(in)  :: n1,n2,n3,n4,n5,n6,n7
  real(kind=4),               intent(in)  :: a(n1,n2,n3,n4,n5,n6,n7)
  real(kind=4),               intent(out) :: w(*)
  integer(kind=index_length), intent(in)  :: j1,j2,j3,j4,j5,j6
  ! Local
  integer(kind=index_length) :: i2,i3,i4,i5,i6,i7
  integer(kind=size_length) :: ioff
  !
  if (ndim.eq.1) then
    do i7=1,n7
      do i6=1,n6
        do i5=1,n5
          do i4=1,n4
            do i3=1,n3
              do i2=1,n2
                ioff = (i7-1)*n6*n5*n4*n3*n2 + &
                       (i6-1)*n5*n4*n3*n2 + &
                       (i5-1)*n4*n3*n2 + &
                       (i4-1)*n3*n2 +  &
                       (i3-1)*n2 + i2
                w(ioff)=a(j1,i2,i3,i4,i5,i6,i7)
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
    !
  elseif (ndim.eq.2) then
    do i7=1,n7
      do i6=1,n6
        do i5=1,n5
          do i4=1,n4
            do i3=1,n3
              ioff = (i7-1)*n6*n5*n4*n3 +  &
                     (i6-1)*n5*n4*n3 +  &
                     (i5-1)*n4*n3 +  &
                     (i4-1)*n3 + i3
              w(ioff)=a(j1,j2,i3,i4,i5,i6,i7)
            enddo
          enddo
        enddo
      enddo
    enddo
    !
  elseif (ndim.eq.3) then
    do i7=1,n7
      do i6=1,n6
        do i5=1,n5
          do i4=1,n4
            ioff = (i7-1)*n6*n5*n4 +  &
                   (i6-1)*n5*n4 +  &
                   (i5-1)*n4 + i4
            w(ioff)=a(j1,j2,j3,i4,i5,i6,i7)
          enddo
        enddo
      enddo
    enddo
    !
  elseif (ndim.eq.4) then
    do i7=1,n7
      do i6=1,n6
        do i5=1,n5
          ioff = (i7-1)*n6*n5 +  &
                 (i6-1)*n5 + i5
          w(ioff)=a(j1,j2,j3,j4,i5,i6,i7)
        enddo
      enddo
    enddo
    !
  elseif (ndim.eq.5) then
    do i7=1,n7
      do i6=1,n6
        ioff = (i7-1)*n6 + i6
        w(ioff)=a(j1,j2,j3,j4,j5,i6,i7)
      enddo
    enddo
    !
  elseif (ndim.eq.6) then
    do i7=1,n7
      ioff = i7
      w(ioff)=a(j1,j2,j3,j4,j5,j6,i7)
    enddo
    !
  endif
  !
end subroutine collect_w4tow4
!
subroutine collect_w8tow8(ndim,a,n1,n2,n3,n4,n5,n6,n7,w,j1,j2,j3,j4,j5,j6)
  use sic_interfaces, except_this=>collect_w8tow8
  use gildas_def
  !---------------------------------------------------------------------
  ! @ private
  !  Word-to-word collection of dimensions. Type is not relevant, use
  ! integer type (avoid IEEE floats because bits in NaN values may not
  ! preserved during copy)
  ! This version for sic_maxdims==7
  !---------------------------------------------------------------------
  integer(kind=4),            intent(in)  :: ndim
  integer(kind=index_length), intent(in)  :: n1,n2,n3,n4,n5,n6,n7
  real(kind=8),               intent(in)  :: a(n1,n2,n3,n4,n5,n6,n7)
  real(kind=8),               intent(out) :: w(*)
  integer(kind=index_length), intent(in)  :: j1,j2,j3,j4,j5,j6
  ! Local
  integer(kind=index_length) :: i2,i3,i4,i5,i6,i7
  integer(kind=size_length) :: ioff
  !
  if (ndim.eq.1) then
    do i7=1,n7
      do i6=1,n6
        do i5=1,n5
          do i4=1,n4
            do i3=1,n3
              do i2=1,n2
                ioff = (i7-1)*n6*n5*n4*n3*n2 + &
                       (i6-1)*n5*n4*n3*n2 + &
                       (i5-1)*n4*n3*n2 + &
                       (i4-1)*n3*n2 +  &
                       (i3-1)*n2 + i2
                w(ioff)=a(j1,i2,i3,i4,i5,i6,i7)
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
    !
  elseif (ndim.eq.2) then
    do i7=1,n7
      do i6=1,n6
        do i5=1,n5
          do i4=1,n4
            do i3=1,n3
              ioff = (i7-1)*n6*n5*n4*n3 +  &
                     (i6-1)*n5*n4*n3 +  &
                     (i5-1)*n4*n3 +  &
                     (i4-1)*n3 + i3
              w(ioff)=a(j1,j2,i3,i4,i5,i6,i7)
            enddo
          enddo
        enddo
      enddo
    enddo
    !
  elseif (ndim.eq.3) then
    do i7=1,n7
      do i6=1,n6
        do i5=1,n5
          do i4=1,n4
            ioff = (i7-1)*n6*n5*n4 +  &
                   (i6-1)*n5*n4 +  &
                   (i5-1)*n4 + i4
            w(ioff)=a(j1,j2,j3,i4,i5,i6,i7)
          enddo
        enddo
      enddo
    enddo
    !
  elseif (ndim.eq.4) then
    do i7=1,n7
      do i6=1,n6
        do i5=1,n5
          ioff = (i7-1)*n6*n5 +  &
                 (i6-1)*n5 + i5
          w(ioff)=a(j1,j2,j3,j4,i5,i6,i7)
        enddo
      enddo
    enddo
    !
  elseif (ndim.eq.5) then
    do i7=1,n7
      do i6=1,n6
        ioff = (i7-1)*n6 + i6
        w(ioff)=a(j1,j2,j3,j4,j5,i6,i7)
      enddo
    enddo
    !
  elseif (ndim.eq.6) then
    do i7=1,n7
      ioff = i7
      w(ioff)=a(j1,j2,j3,j4,j5,j6,i7)
    enddo
    !
  endif
  !
end subroutine collect_w8tow8
!
subroutine collect_r8tor4(ndim,a,n1,n2,n3,n4,n5,n6,n7,w,j1,j2,j3,j4,j5,j6)
  use sic_interfaces, except_this=>collect_r8tor4
  use gildas_def
  !---------------------------------------------------------------------
  ! @ private
  !  real(kind=8)-to-real(kind=4) collection of dimensions (including float
  ! conversion at the same time).
  ! This version for sic_maxdims==7
  !---------------------------------------------------------------------
  integer(kind=4),            intent(in)  :: ndim
  integer(kind=index_length), intent(in)  :: n1,n2,n3,n4,n5,n6,n7
  real(kind=8),               intent(in)  :: a(n1,n2,n3,n4,n5,n6,n7)
  real(kind=4),               intent(out) :: w(*)
  integer(kind=index_length), intent(in)  :: j1,j2,j3,j4,j5,j6
  ! Local
  integer(kind=index_length) :: i2,i3,i4,i5,i6,i7
  integer(kind=size_length) :: ioff
  !
  if (ndim.eq.1) then
    do i7=1,n7
      do i6=1,n6
        do i5=1,n5
          do i4=1,n4
            do i3=1,n3
              do i2=1,n2
                ioff = (i7-1)*n6*n5*n4*n3*n2 + &
                       (i6-1)*n5*n4*n3*n2 + &
                       (i5-1)*n4*n3*n2 + &
                       (i4-1)*n3*n2 +  &
                       (i3-1)*n2+i2
                w(ioff)=a(j1,i2,i3,i4,i5,i6,i7)
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
    !
  elseif (ndim.eq.2) then
    do i7=1,n7
      do i6=1,n6
        do i5=1,n5
          do i4=1,n4
            do i3=1,n3
              ioff = (i7-1)*n6*n5*n4*n3 +  &
                     (i6-1)*n5*n4*n3 +  &
                     (i5-1)*n4*n3 +  &
                     (i4-1)*n3 + i3
              w(ioff)=a(j1,j2,i3,i4,i5,i6,i7)
            enddo
          enddo
        enddo
      enddo
    enddo
    !
  elseif (ndim.eq.3) then
    do i7=1,n7
      do i6=1,n6
        do i5=1,n5
          do i4=1,n4
            ioff = (i7-1)*n6*n5*n4 +  &
                   (i6-1)*n5*n4 +  &
                   (i5-1)*n4 + i4
            w(ioff)=a(j1,j2,j3,i4,i5,i6,i7)
          enddo
        enddo
      enddo
    enddo
    !
  elseif (ndim.eq.4) then
    do i7=1,n7
      do i6=1,n6
        do i5=1,n5
          ioff = (i7-1)*n6*n5 +  &
                 (i6-1)*n5 + i5
          w(ioff)=a(j1,j2,j3,j4,i5,i6,i7)
        enddo
      enddo
    enddo
    !
  elseif (ndim.eq.5) then
    do i7=1,n7
      do i6=1,n6
        ioff = (i7-1)*n6 + i6
        w(ioff)=a(j1,j2,j3,j4,j5,i6,i7)
      enddo
    enddo
    !
  elseif (ndim.eq.6) then
    do i7=1,n7
      ioff = i7
      w(ioff)=a(j1,j2,j3,j4,j5,j6,i7)
    enddo
    !
  endif
  !
end subroutine collect_r8tor4
!
subroutine comp_r4_mean(x,n,vblank4,eblank4,out)
  use gildas_def
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>comp_r4_mean
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  ! Support routine for command
  !   COMPUTE OutVar MEAN InVar  (single precision)
  ! Protected against NaNs and Using Blanking Values. If Blanking
  ! enabled, will return blanking value if no valid result. If Blanking
  ! is not enabled, will return NaN if no valid result.
  !---------------------------------------------------------------------
  real(kind=4),              intent(in)  :: x(*)     ! Data values to compute
  integer(kind=size_length), intent(in)  :: n        ! Number of data values
  real(kind=4),              intent(in)  :: vblank4  !
  real(kind=4),              intent(in)  :: eblank4  !
  real(kind=4),              intent(out) :: out      ! Output scalar value
  !
  call gr4_mean(x,n,vblank4,eblank4,out)
end subroutine comp_r4_mean
!
subroutine comp_r4_sum(x,n,vblank4,eblank4,out)
  !$ use omp_lib
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>comp_r4_sum
  use gildas_def
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  ! Support routine for command
  !   COMPUTE OutVar SUM InVar  (single precision)
  ! Protected against NaNs and Using Blanking Values. If Blanking
  ! enabled, will return blanking value if no valid result. If Blanking
  ! is not enabled, will return NaN if no valid result.
  !---------------------------------------------------------------------
  real(kind=4),              intent(in)  :: x(*)     ! Data values to compute
  integer(kind=size_length), intent(in)  :: n        ! Number of data values
  real(kind=4),              intent(in)  :: vblank4  !
  real(kind=4),              intent(in)  :: eblank4  !
  real(kind=4),              intent(out) :: out      ! Output scalar value
  ! Local
  integer(kind=size_length) :: i,count
  real(kind=4) :: nan
  real(kind=4) :: lastchanceretval
  real(kind=8) :: out8  ! Temporary real(kind=8) sum to avoid sum loss in real(kind=4)
  !
  if (eblank4.ge.0) then
    lastchanceretval=vblank4
  else
    call gag_notanum(nan)
    lastchanceretval=nan
  endif
  out = lastchanceretval
  if (n.lt.1) return
  !
  out8 = 0.d0
  count = 0
  !$OMP PARALLEL IF(.not.OMP_IN_PARALLEL()) &
  !$OMP DEFAULT(NONE) &
  !$OMP SHARED(n,x,vblank4,eblank4,count,out8) &
  !$OMP PRIVATE(i)
  !$OMP DO REDUCTION(+:out8) REDUCTION(+:count)
  do i=1,n
    if (x(i).eq.x(i)) then
      if (eblank4.lt.0) then
        out8 = out8 + x(i)
        count = count+1
      else
        if (abs(x(i)-vblank4).gt.eblank4) then
          out8 = out8 + x(i)
          count = count+1
        endif
      endif
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  if (count.le.0) then
    out = lastchanceretval
  else
    out = real(out8,kind=4)
  endif
end subroutine comp_r4_sum
!
subroutine comp_r4_prod(x,n,vblank4,eblank4,out)
  !$ use omp_lib
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>comp_r4_prod
  use gildas_def
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  ! Support routine for command
  !   COMPUTE OutVar PRODUCT InVar  (single precision)
  ! Protected against NaNs and Using Blanking Values. If Blanking
  ! enabled, will return blanking value if no valid result. If Blanking
  ! is not enabled, will return NaN if no valid result.
  !---------------------------------------------------------------------
  real(kind=4),              intent(in)  :: x(*)     ! Data values to compute
  integer(kind=size_length), intent(in)  :: n        ! Number of data values
  real(kind=4),              intent(in)  :: vblank4  !
  real(kind=4),              intent(in)  :: eblank4  !
  real(kind=4),              intent(out) :: out      ! Output scalar value
  ! Local
  integer(kind=size_length) :: i,count
  real(kind=4) :: nan
  real(kind=4) :: lastchanceretval
  !
  if (eblank4.ge.0) then
    lastchanceretval=vblank4
  else
    call gag_notanum(nan)
    lastchanceretval=nan
  endif
  out = lastchanceretval
  if (n.lt.1) return
  !
  if (x(1).eq.x(1)) then
    if (eblank4.lt.0) then
      out = x(1)
      count = 1
    else
      if (abs(x(1)-vblank4).gt.eblank4) then
        out = x(1)
        count = 1
      else
        out = 1.0              !Neutral Element for Prod...
        count = 0
      endif
    endif
  else
    out = 1.0                  !Neutral Element for Prod...
    count = 0
  endif
  !
  !$OMP PARALLEL IF(.not.OMP_IN_PARALLEL()) &
  !$OMP DEFAULT(NONE) &
  !$OMP SHARED(n,x,vblank4,eblank4,count,out) &
  !$OMP PRIVATE(i)
  !$OMP DO REDUCTION(*:out) REDUCTION(+:count)
  do i=2,n
    if (x(i).eq.x(i)) then
      if (eblank4.lt.0) then
        out = out * x(i)
        count = count+1
      else
        if (abs(x(i)-vblank4).gt.eblank4) then
          out = out * x(i)
          count = count+1
        endif
      endif
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  if (count.le.0) then
    out = lastchanceretval
  endif
end subroutine comp_r4_prod
!
subroutine comp_r4_max(x,n,vblank4,eblank4,out)
  !$ use omp_lib
  use sic_dependencies_interfaces
  use sic_interfaces
  use gildas_def
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Support routine for command
  !   COMPUTE OutVar MAX InVar  (single precision)
  ! Protected against NaNs and Using Blanking Values. If Blanking
  ! enabled, will return blanking value if no valid result. If Blanking
  ! is not enabled, will return NaN if no valid result.
  !---------------------------------------------------------------------
  real(kind=4),              intent(in)  :: x(*)     ! Data values to compute
  integer(kind=size_length), intent(in)  :: n        ! Number of data values
  real(kind=4),              intent(in)  :: vblank4  !
  real(kind=4),              intent(in)  :: eblank4  !
  real(kind=4),              intent(out) :: out      ! Output scalar value
  ! Local
  integer(kind=size_length) :: i,j,count
  real(kind=4) :: nan
  real(kind=4) :: lastchanceretval
  !
  if (eblank4.ge.0) then
    lastchanceretval=vblank4
  else
    call gag_notanum(nan)
    lastchanceretval=nan
  endif
  out = lastchanceretval
  if (n.lt.1) return
  !
  count = 0
  do i=1,n
    if (x(i).eq.x(i)) then
      if (eblank4.lt.0) then
        count = 1
        out = x(i)
        j = i
        goto 1
      else
        if (abs(x(i)-vblank4).gt.eblank4) then
          count = 1
          out = x(i)
          j = i
          goto 1
        endif
      endif
    endif
  enddo
1 continue
  if (count.le.0) then
    out = lastchanceretval
    return
  endif
  !$OMP PARALLEL IF(.not.OMP_IN_PARALLEL()) &
  !$OMP DEFAULT(NONE) &
  !$OMP SHARED(j,n,x,vblank4,eblank4,out) &
  !$OMP PRIVATE(i)
  !$OMP DO REDUCTION(MAX:out)
  do i=j+1,n
    if (x(i).eq.x(i)) then
      if (eblank4.lt.0) then
        out = max(out,x(i))
        ! count = count+1  (Unused)
      else
        if (abs(x(i)-vblank4).gt.eblank4) then
          out = max(out,x(i))
          ! count = count+1  (Unused)
        endif
      endif
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
end subroutine comp_r4_max
!
subroutine comp_r4_min(x,n,vblank4,eblank4,out)
  !$ use omp_lib
  use sic_dependencies_interfaces
  use sic_interfaces
  use gildas_def
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Support routine for command
  !   COMPUTE OutVar MIN InVar  (single precision)
  ! Protected against NaNs and Using Blanking Values. If Blanking
  ! enabled, will return blanking value if no valid result. If Blanking
  ! is not enabled, will return NaN if no valid result.
  !---------------------------------------------------------------------
  real(kind=4),              intent(in)  :: x(*)     ! Data values to compute
  integer(kind=size_length), intent(in)  :: n        ! Number of data values
  real(kind=4),              intent(in)  :: vblank4  !
  real(kind=4),              intent(in)  :: eblank4  !
  real(kind=4),              intent(out) :: out      ! Output scalar value
  ! Local
  integer(kind=size_length) :: i,j,count
  real(kind=4) :: nan
  real(kind=4) :: lastchanceretval
  !
  if (eblank4.ge.0) then
    lastchanceretval=vblank4
  else
    call gag_notanum(nan)
    lastchanceretval=nan
  endif
  out = lastchanceretval
  if (n.lt.1) return
  !
  count = 0
  do i=1,n
    if (x(i).eq.x(i)) then
      if (eblank4.lt.0) then
        count = 1
        out = x(i)
        j = i
        goto 1
      else
        if (abs(x(i)-vblank4).gt.eblank4) then
          count = 1
          out = x(i)
          j = i
          goto 1
        endif
      endif
    endif
  enddo
1 continue
  if (count.le.0) then
    out = lastchanceretval
    return
  endif
  !$OMP PARALLEL IF(.not.OMP_IN_PARALLEL()) &
  !$OMP DEFAULT(NONE) &
  !$OMP SHARED(j,n,x,vblank4,eblank4,out) &
  !$OMP PRIVATE(i)
  !$OMP DO REDUCTION(MIN:out)
  do i=j+1,n
    if (x(i).eq.x(i)) then
      if (eblank4.lt.0) then
        out = min(out,x(i))
        ! count = count+1  (Unused)
      else
        if (abs(x(i)-vblank4).gt.eblank4) then
          out = min(out,x(i))
          ! count = count+1  (Unused)
        endif
      endif
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
end subroutine comp_r4_min
!
subroutine comp_r4_rms (x,n,vblank4,eblank4,out)
  !$ use omp_lib
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>comp_r4_rms
  use gildas_def
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  ! Support routine for command
  !   COMPUTE OutVar RMS InVar  (single precision)
  ! Protected against NaNs and Using Blanking Values. If Blanking
  ! enabled, will return blanking value if no valid result. If Blanking
  ! is not enabled, will return NaN if no valid result.
  !---------------------------------------------------------------------
  real(kind=4),              intent(in)  :: x(*)     ! Data values to compute
  integer(kind=size_length), intent(in)  :: n        ! Number of data values
  real(kind=4),              intent(in)  :: vblank4  !
  real(kind=4),              intent(in)  :: eblank4  !
  real(kind=4),              intent(out) :: out      ! Output scalar value
  ! Local
  integer(kind=size_length) :: i,count
  real(kind=4) :: nan
  real(kind=4) :: s0,s1
  real(kind=8) :: s8  ! Temporary real(kind=8) sum to avoid sum loss in real(kind=4)
  real(kind=4) :: lastchanceretval
  !
  if (eblank4.ge.0) then
    lastchanceretval=vblank4
  else
    call gag_notanum(nan)
    lastchanceretval=nan
  endif
  out = lastchanceretval
  if (n.lt.1) return
  out = 0.0
  !
  s8 = 0.d0
  count = 0
  !$OMP PARALLEL IF(.not.OMP_IN_PARALLEL()) &
  !$OMP DEFAULT(NONE) &
  !$OMP SHARED(n,x,vblank4,eblank4,count,s8) &
  !$OMP PRIVATE(i)
  !$OMP DO REDUCTION(+:s8) REDUCTION(+:count)
  do i = 1,n
    if (x(i).eq.x(i)) then
      if (eblank4.ge.0) then
        if (abs(x(i)-vblank4).gt.eblank4) then
          s8 = s8+x(i)
          count = count+1
        endif
      else
        s8 = s8+x(i)
        count = count+1
      endif
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  if (count.gt.0) then
    s0 = s8/dble(count)
  else
    out = lastchanceretval
    return
  endif
  !
  s1 = 0.
  !$OMP PARALLEL IF(.not.OMP_IN_PARALLEL()) &
  !$OMP DEFAULT(NONE) &
  !$OMP SHARED(n,x,vblank4,eblank4,s0,s1) &
  !$OMP PRIVATE(i)
  !$OMP DO REDUCTION(+:s1)
  do i = 1,n
    if (x(i).eq.x(i)) then
      if (eblank4.lt.0) then
        s1 = s1 + (x(i)-s0)**2
      else
        if (abs(x(i)-vblank4).gt.eblank4) then
          s1 = s1 + (x(i)-s0)**2
        endif
      endif
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  s1 = s1/dble(count)
  out = sqrt (s1)
end subroutine comp_r4_rms
!
subroutine comp_r4_median(x,n,vblank4,eblank4,out)
  use sic_interfaces, except_this=>comp_r4_median
  use gildas_def
  use sic_dependencies_interfaces
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  ! Support routine for command
  !   COMPUTE OutVar MEDIAN InVar  (single precision)
  ! If Blanking enabled, will return blanking value if no valid result.
  ! If Blanking is not enabled, will return NaN if no valid result.
  !---------------------------------------------------------------------
  real(kind=4),              intent(in)  :: x(*)     ! Data values to compute
  integer(kind=size_length), intent(in)  :: n        ! Number of data values
  real(kind=4),              intent(in)  :: vblank4  !
  real(kind=4),              intent(in)  :: eblank4  !
  real(kind=4),              intent(out) :: out      ! Output scalar value
  ! Local
  real(kind=4) :: nan,lastchanceretval
  logical :: error
  !
  if (eblank4.ge.0.) then
    lastchanceretval=vblank4
  else
    call gag_notanum(nan)
    lastchanceretval=nan
  endif
  out = lastchanceretval
  if (n.lt.1) return
  !
  error = .false.
  call gr4_median(x,n,vblank4,eblank4,out,error)
  !
end subroutine comp_r4_median
!
subroutine comp_r4_quantile(x,n,vblank4,eblank4,quant,nquant,error)
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  ! Support routine for command
  !   COMPUTE OutVar QUANTILE InVar  (single precision)
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in)    :: n              ! Number of values
  real(kind=4),              intent(in)    :: x(n)           ! Data values
  real(kind=4),              intent(in)    :: vblank4        !
  real(kind=4),              intent(in)    :: eblank4        !
  integer(kind=size_length), intent(in)    :: nquant         ! Number of quantiles
  real(kind=4),              intent(out)   :: quant(nquant)  ! Output values
  logical,                   intent(inout) :: error          !
  ! Local
  real(kind=4) :: nan,lastchanceretval
  !
  if (eblank4.ge.0.) then
    lastchanceretval = vblank4
  else
    call gag_notanum(nan)
    lastchanceretval = nan
  endif
  quant(:) = lastchanceretval
  !
  call gr4_quantile(x,n,vblank4,eblank4,quant,nquant,error)
  if (error)  return
end subroutine comp_r4_quantile
!
subroutine comp_r8_mean(x,n,vblank8,eblank8,out)
  use gildas_def
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>comp_r8_mean
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  ! Support routine for command
  !   COMPUTE OutVar MEAN InVar  (double precision)
  ! Protected against NaNs and Using Blanking Values. If Blanking
  ! enabled, will return blanking value if no valid result. If Blanking
  ! is not enabled, will return NaN if no valid result.
  !---------------------------------------------------------------------
  real(kind=8),              intent(in)  :: x(*)     ! Data values to compute
  integer(kind=size_length), intent(in)  :: n        ! Number of data values
  real(kind=8),              intent(in)  :: vblank8  !
  real(kind=8),              intent(in)  :: eblank8  !
  real(kind=8),              intent(out) :: out      ! Output scalar value
  !
  call gr8_mean(x,n,vblank8,eblank8,out)
end subroutine comp_r8_mean
!
subroutine comp_r8_sum(x,n,vblank8,eblank8,out)
  !$ use omp_lib
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>comp_r8_sum
  use gildas_def
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  ! Support routine for command
  !   COMPUTE OutVar SUM InVar  (double precision)
  ! Protected against NaNs and Using Blanking Values. If Blanking
  ! enabled, will return blanking value if no valid result. If Blanking
  ! is not enabled, will return NaN if no valid result.
  !---------------------------------------------------------------------
  real(kind=8),              intent(in)  :: x(*)     ! Data values to compute
  integer(kind=size_length), intent(in)  :: n        ! Number of data values
  real(kind=8),              intent(in)  :: vblank8  !
  real(kind=8),              intent(in)  :: eblank8  !
  real(kind=8),              intent(out) :: out      ! Output scalar value
  ! Local
  integer(kind=size_length) :: i,count
  real(kind=4) :: nan
  real(kind=8) :: lastchanceretval
  !
  if (eblank8.ge.0) then
    lastchanceretval=vblank8
  else
    call gag_notanum(nan)
    lastchanceretval=nan
  endif
  out = lastchanceretval
  if (n.lt.1) return
  !
  out = 0.0
  count = 0
  !$OMP PARALLEL IF(.not.OMP_IN_PARALLEL()) &
  !$OMP DEFAULT(NONE) &
  !$OMP SHARED(n,x,vblank8,eblank8,count,out) &
  !$OMP PRIVATE(i)
  !$OMP DO REDUCTION(+:out) REDUCTION(+:count)
  do i=1,n
    if (x(i).eq.x(i)) then
      if (eblank8.lt.0) then
        out = out + x(i)
        count = count+1
      else
        if (abs(x(i)-vblank8).gt.eblank8) then
          out = out + x(i)
          count = count+1
        endif
      endif
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  if (count.le.0) then
    out = lastchanceretval
  endif
end subroutine comp_r8_sum
!
subroutine comp_r8_prod(x,n,vblank8,eblank8,out)
  !$ use omp_lib
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>comp_r8_prod
  use gildas_def
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  ! Support routine for command
  !   COMPUTE OutVar PRODUCT InVar  (double precision)
  ! Protected against NaNs and Using Blanking Values. If Blanking
  ! enabled, will return blanking value if no valid result. If Blanking
  ! is not enabled, will return NaN if no valid result.
  !---------------------------------------------------------------------
  real(kind=8),              intent(in)  :: x(*)     ! Data values to compute
  integer(kind=size_length), intent(in)  :: n        ! Number of data values
  real(kind=8),              intent(in)  :: vblank8  !
  real(kind=8),              intent(in)  :: eblank8  !
  real(kind=8),              intent(out) :: out      ! Output scalar value
  ! Local
  integer(kind=size_length) :: i,count
  real(kind=4) :: nan
  real(kind=8) :: lastchanceretval
  !
  if (eblank8.ge.0) then
    lastchanceretval=vblank8
  else
    call gag_notanum(nan)
    lastchanceretval=nan
  endif
  out = lastchanceretval
  if (n.lt.1) return
  !
  if (x(1).eq.x(1)) then
    if (eblank8.lt.0) then
      out = x(1)
      count = 1
    else
      if (abs(x(1)-vblank8).gt.eblank8) then
        out = x(1)
        count = 1
      else
        out = 1.0              !Neutral Element for Prod...
        count = 0
      endif
    endif
  else
    out = 1.0                  !Neutral Element for Prod...
    count = 0
  endif
  !$OMP PARALLEL IF(.not.OMP_IN_PARALLEL()) &
  !$OMP DEFAULT(NONE) &
  !$OMP SHARED(n,x,vblank8,eblank8,count,out) &
  !$OMP PRIVATE(i)
  !$OMP DO REDUCTION(*:out) REDUCTION(+:count)
  do i=2,n
    if (x(i).eq.x(i)) then
      if (eblank8.lt.0) then
        out = out * x(i)
        count = count+1
      else
        if (abs(x(i)-vblank8).gt.eblank8) then
          out = out * x(i)
          count = count+1
        endif
      endif
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  if (count.le.0) then
    out = lastchanceretval
  endif
end subroutine comp_r8_prod
!
subroutine comp_r8_max(x,n,vblank8,eblank8,out)
  !$ use omp_lib
  use sic_dependencies_interfaces
  use sic_interfaces
  use gildas_def
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Support routine for command
  !   COMPUTE OutVar MAX InVar  (double precision)
  ! Protected against NaNs and Using Blanking Values. If Blanking
  ! enabled, will return blanking value if no valid result. If Blanking
  ! is not enabled, will return NaN if no valid result.
  !---------------------------------------------------------------------
  real(kind=8),              intent(in)  :: x(*)     ! Data values to compute
  integer(kind=size_length), intent(in)  :: n        ! Number of data values
  real(kind=8),              intent(in)  :: vblank8  !
  real(kind=8),              intent(in)  :: eblank8  !
  real(kind=8),              intent(out) :: out      ! Output scalar value
  ! Local
  integer(kind=size_length) :: i,j,count
  real(kind=4) :: nan
  real(kind=8) :: lastchanceretval
  !
  if (eblank8.ge.0) then
    lastchanceretval=vblank8
  else
    call gag_notanum(nan)
    lastchanceretval=nan
  endif
  out = lastchanceretval
  if (n.lt.1) return
  !
  count = 0
  do i=1,n
    if (x(i).eq.x(i)) then
      if (eblank8.lt.0) then
        count = 1
        out = x(i)
        j = i
        goto 1
      else
        if (abs(x(i)-vblank8).gt.eblank8) then
          count = 1
          out = x(i)
          j = i
          goto 1
        endif
      endif
    endif
  enddo
1 continue
  if (count.le.0) then
    out = lastchanceretval
    return
  endif
  !$OMP PARALLEL IF(.not.OMP_IN_PARALLEL()) &
  !$OMP DEFAULT(NONE) &
  !$OMP SHARED(j,n,x,vblank8,eblank8,out) &
  !$OMP PRIVATE(i)
  !$OMP DO REDUCTION(MAX:out)
  do i=j+1,n
    if (x(i).eq.x(i)) then
      if (eblank8.lt.0) then
        out = max(out,x(i))
        ! count = count+1  (Unused)
      else
        if (abs(x(i)-vblank8).gt.eblank8) then
          out = max(out,x(i))
          ! count = count+1  (Unused)
        endif
      endif
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
end subroutine comp_r8_max
!
subroutine comp_r8_min (x,n,vblank8,eblank8,out)
  !$ use omp_lib
  use sic_dependencies_interfaces
  use sic_interfaces
  use gildas_def
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Support routine for command
  !   COMPUTE OutVar MIN InVar  (double precision)
  ! Protected against NaNs and Using Blanking Values. If Blanking
  ! enabled, will return blanking value if no valid result. If Blanking
  ! is not enabled, will return NaN if no valid result.
  !---------------------------------------------------------------------
  real(kind=8),              intent(in)  :: x(*)     ! Data values to compute
  integer(kind=size_length), intent(in)  :: n        ! Number of data values
  real(kind=8),              intent(in)  :: vblank8  !
  real(kind=8),              intent(in)  :: eblank8  !
  real(kind=8),              intent(out) :: out      ! Output scalar value
  ! Local
  integer(kind=size_length) :: i,j,count
  real(kind=4) :: nan
  real(kind=8) :: lastchanceretval
  !
  if (eblank8.ge.0) then
    lastchanceretval=vblank8
  else
    call gag_notanum(nan)
    lastchanceretval=nan
  endif
  out = lastchanceretval
  if (n.lt.1) return
  !
  count = 0
  do i=1,n
    if (x(i).eq.x(i)) then
      if (eblank8.lt.0) then
        count = 1
        out = x(i)
        j = i
        goto 1
      else
        if (abs(x(i)-vblank8).gt.eblank8) then
          count = 1
          out = x(i)
          j = i
          goto 1
        endif
      endif
    endif
  enddo
1 continue
  if (count.le.0) then
    out = lastchanceretval
    return
  endif
  !$OMP PARALLEL IF(.not.OMP_IN_PARALLEL()) &
  !$OMP DEFAULT(NONE) &
  !$OMP SHARED(j,n,x,vblank8,eblank8,out) &
  !$OMP PRIVATE(i)
  !$OMP DO REDUCTION(MIN:out)
  do i=j+1,n
    if (x(i).eq.x(i)) then
      if (eblank8.lt.0) then
        out = min(out,x(i))
        ! count = count+1  (Unused)
      else
        if (abs(x(i)-vblank8).gt.eblank8) then
          out = min(out,x(i))
          ! count = count+1  (Unused)
        endif
      endif
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
end subroutine comp_r8_min
!
subroutine comp_r8_rms (x,n,vblank8,eblank8,out)
  !$ use omp_lib
  use sic_dependencies_interfaces
  use sic_interfaces, except_this=>comp_r8_rms
  use gildas_def
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  ! Support routine for command
  !   COMPUTE OutVar RMS InVar  (double precision)
  ! Protected against NaNs and Using Blanking Values. If Blanking
  ! enabled, will return blanking value if no valid result. If Blanking
  ! is not enabled, will return NaN if no valid result.
  !---------------------------------------------------------------------
  real(kind=8),              intent(in)  :: x(*)     ! Data values to compute
  integer(kind=size_length), intent(in)  :: n        ! Number of data values
  real(kind=8),              intent(in)  :: vblank8  !
  real(kind=8),              intent(in)  :: eblank8  !
  real(kind=8),              intent(out) :: out      ! Output scalar value
  ! Local
  integer(kind=size_length) :: i,count
  real(kind=4) :: nan
  real(kind=8) :: s0,s1
  real(kind=8) :: lastchanceretval
  !
  if (eblank8.ge.0) then
    lastchanceretval=vblank8
  else
    call gag_notanum(nan)
    lastchanceretval=nan
  endif
  out = lastchanceretval
  if (n.lt.1) return
  out = 0.0
  !
  s0 = 0.
  count = 0
  !$OMP PARALLEL IF(.not.OMP_IN_PARALLEL()) &
  !$OMP DEFAULT(NONE) &
  !$OMP SHARED(n,x,vblank8,eblank8,count,s0) &
  !$OMP PRIVATE(i)
  !$OMP DO REDUCTION(+:s0) REDUCTION(+:count)
  do i = 1,n
    if (x(i).eq.x(i)) then
      if (eblank8.ge.0) then
        if (abs(x(i)-vblank8).gt.eblank8) then
          s0 = s0+x(i)
          count = count+1
        endif
      else
        s0 = s0+x(i)
        count = count+1
      endif
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  if (count.gt.0) then
    s0 = s0/dble(count)
  else
    out = lastchanceretval
    return
  endif
  !
  s1 = 0.
  !$OMP PARALLEL IF(.not.OMP_IN_PARALLEL()) &
  !$OMP DEFAULT(NONE) &
  !$OMP SHARED(n,x,vblank8,eblank8,s0,s1) &
  !$OMP PRIVATE(i)
  !$OMP DO REDUCTION(+:s1)
  do i = 1,n
    if (x(i).eq.x(i)) then
      if (eblank8.lt.0) then
        s1 = s1 + (x(i)-s0)**2
      else
        if (abs(x(i)-vblank8).gt.eblank8) then
          s1 = s1 + (x(i)-s0)**2
        endif
      endif
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  s1 = s1/dble(count)
  out = sqrt (s1)
end subroutine comp_r8_rms
!
subroutine comp_r8_median(x,n,vblank8,eblank8,out)
  use sic_interfaces, except_this=>comp_r8_median
  use gildas_def
  use sic_dependencies_interfaces
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  ! Support routine for command
  !   COMPUTE OutVar MEDIAN InVar  (double precision)
  ! If Blanking enabled, will return blanking value if no valid result.
  ! If Blanking is not enabled, will return NaN if no valid result.
  !---------------------------------------------------------------------
  real(kind=8),              intent(in)  :: x(*)     ! Data values to compute
  integer(kind=size_length), intent(in)  :: n        ! Number of data values
  real(kind=8),              intent(in)  :: vblank8  !
  real(kind=8),              intent(in)  :: eblank8  !
  real(kind=8),              intent(out) :: out      ! Output scalar value
  ! Local
  real(kind=4) :: nan
  real(kind=8) :: lastchanceretval
  logical :: error
  !
  if (eblank8.ge.0.d0) then
    lastchanceretval=vblank8
  else
    call gag_notanum(nan)
    lastchanceretval=nan
  endif
  out = lastchanceretval
  if (n.lt.1) return
  !
  error = .false.
  call gr8_median(x,n,vblank8,eblank8,out,error)
  !
end subroutine comp_r8_median
!
subroutine comp_r8_quantile(x,n,vblank8,eblank8,quant,nquant,error)
  use gildas_def
  use gbl_message
  use sic_dependencies_interfaces
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  ! Support routine for command
  !   COMPUTE OutVar QUANTILE InVar  (double precision)
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in)    :: n              ! Number of values
  real(kind=8),              intent(in)    :: x(n)           ! Data values
  real(kind=8),              intent(in)    :: vblank8        !
  real(kind=8),              intent(in)    :: eblank8        !
  integer(kind=size_length), intent(in)    :: nquant         ! Number of quantiles
  real(kind=8),              intent(out)   :: quant(nquant)  ! Output values
  logical,                   intent(inout) :: error          !
  ! Local
  real(kind=8) :: nan,lastchanceretval
  !
  if (eblank8.ge.0.) then
    lastchanceretval = vblank8
  else
    call gag_notanum(nan)
    lastchanceretval = nan
  endif
  quant(:) = lastchanceretval
  !
  call gr8_quantile(x,n,vblank8,eblank8,quant,nquant,error)
  if (error)  return
end subroutine comp_r8_quantile
