!-----------------------------------------------------------------------
!
begin procedure trans_init
  if (.not.exist(demo)) then
    define structure demo  /global
  endif
  if (exist(demo%trans)) then
    delete /variable demo%trans
  endif
  define structure demo%trans /global
  !
  define integer demo%trans%ndim  /global
  define integer demo%trans%dims[7]  /global
  define integer demo%trans%order[7]  /global
  !
  define character*7 demo%trans%code  /global
  !
  define logical demo%trans%error  /global
  !
end procedure trans_init
!
begin procedure trans_memo_dims
  !---------------------------------------------------------------------
  ! Dimensions to be used for memory transpositions. Use prime numbers
  ! to avoid any ambiguous effect when transposing pairs (or more) of
  ! dimensions.
  !---------------------------------------------------------------------
  let demo%trans%dims[1] 2
  let demo%trans%dims[2] 3
  let demo%trans%dims[3] 5
  let demo%trans%dims[4] 7
  let demo%trans%dims[5] 11
  let demo%trans%dims[6] 13
  let demo%trans%dims[7] 17
  ! NB: with the 7 dimensions, the cube has a size of 1.9 MB
end procedure trans_memo_dims
!
begin procedure trans_disk_dims
  !---------------------------------------------------------------------
  !  Dimensions to be used for disk transpositions. Use prime numbers to
  ! avoid any ambiguous effect when transposing pairs (or more) of
  ! dimensions.
  !  Define cubes with ~2 mega-elements (8 MB per cube, 16 MB
  ! needed for both) in order to enforce disk mode with SPACE_GILDAS = 4
  !  Set a large number of elements in dimensions 1 because the
  ! transposition engine have some optimizations which packs and loops
  ! on the last dimension(s).
  !---------------------------------------------------------------------
  let demo%trans%dims 1
  if demo%trans%ndim.eq.2 then
    let demo%trans%dims[1] 1048573
    let demo%trans%dims[2] 2
  else if demo%trans%ndim.eq.3 then
    let demo%trans%dims[1] 349529
    let demo%trans%dims[2] 3
    let demo%trans%dims[3] 2
  else if demo%trans%ndim.eq.4 then
    let demo%trans%dims[1] 69911
    let demo%trans%dims[2] 5
    let demo%trans%dims[3] 3
    let demo%trans%dims[4] 2
  else if demo%trans%ndim.eq.5 then
    let demo%trans%dims[1] 10007
    let demo%trans%dims[2] 7
    let demo%trans%dims[3] 5
    let demo%trans%dims[4] 3
    let demo%trans%dims[5] 2
  else if demo%trans%ndim.eq.6 then
    let demo%trans%dims[1] 907
    let demo%trans%dims[2] 11
    let demo%trans%dims[3] 7
    let demo%trans%dims[4] 5
    let demo%trans%dims[5] 3
    let demo%trans%dims[6] 2
  else if demo%trans%ndim.eq.7 then
    let demo%trans%dims[1] 71
    let demo%trans%dims[2] 13
    let demo%trans%dims[3] 11
    let demo%trans%dims[4] 7
    let demo%trans%dims[5] 5
    let demo%trans%dims[6] 3
    let demo%trans%dims[7] 2
  endif
  !
  define real s
  sic\compute s product demo%trans%dims
  let s s/1024/256
  message i demo "Cube size: "'s'" MB"
end procedure trans_disk_dims
!
!-----------------------------------------------------------------------
!
begin procedure define_abc
  !---------------------------------------------------------------------
  ! Define the A array, and transposed B and C arrays in memory. None
  ! is filled yet
  !---------------------------------------------------------------------
  if demo%trans%ndim.eq.2 then
    @ define_abc_2d
  else if demo%trans%ndim.eq.3 then
    @ define_abc_3d
  else if demo%trans%ndim.eq.4 then
    @ define_abc_4d
  else if demo%trans%ndim.eq.5 then
    @ define_abc_5d
  else if demo%trans%ndim.eq.6 then
    @ define_abc_6d
  else if demo%trans%ndim.eq.7 then
    @ define_abc_7d
  endif
end procedure define_abc
!
begin procedure define_abc_2d
  !---------------------------------------------------------------------
  ! Define the A array, and transposed B and C arrays in memory. None
  ! is filled yet
  !---------------------------------------------------------------------
  if exist(demo%trans%a) then
    delete /variable demo%trans%a
    delete /variable demo%trans%b
    delete /variable demo%trans%c
  endif
  !
  define integer n1 n2
  let n1 demo%trans%dims[1]
  let n2 demo%trans%dims[2]
  define real demo%trans%a[n1,n2] /global
  !
  define integer o1 o2
  let o1 demo%trans%order[1]
  let o2 demo%trans%order[2]
  let n1 demo%trans%dims[o1]
  let n2 demo%trans%dims[o2]
  define real demo%trans%b[n1,n2] /global
  define real demo%trans%c /like demo%trans%b /global
  !
end procedure define_abc_2d
!
begin procedure define_abc_3d
  !---------------------------------------------------------------------
  ! Define the A array, and transposed B and C arrays in memory. None
  ! is filled yet
  !---------------------------------------------------------------------
  if exist(demo%trans%a) then
    delete /variable demo%trans%a
    delete /variable demo%trans%b
    delete /variable demo%trans%c
  endif
  !
  define integer n1 n2 n3
  let n1 demo%trans%dims[1]
  let n2 demo%trans%dims[2]
  let n3 demo%trans%dims[3]
  define real demo%trans%a[n1,n2,n3] /global
  !
  define integer o1 o2 o3
  let o1 demo%trans%order[1]
  let o2 demo%trans%order[2]
  let o3 demo%trans%order[3]
  let n1 demo%trans%dims[o1]
  let n2 demo%trans%dims[o2]
  let n3 demo%trans%dims[o3]
  define real demo%trans%b[n1,n2,n3] /global
  define real demo%trans%c /like demo%trans%b /global
  !
end procedure define_abc_3d
!
begin procedure define_abc_4d
  !---------------------------------------------------------------------
  ! Define the A array, and transposed B and C arrays in memory. None
  ! is filled yet
  !---------------------------------------------------------------------
  if exist(demo%trans%a) then
    delete /variable demo%trans%a
    delete /variable demo%trans%b
    delete /variable demo%trans%c
  endif
  !
  define integer n1 n2 n3 n4
  let n1 demo%trans%dims[1]
  let n2 demo%trans%dims[2]
  let n3 demo%trans%dims[3]
  let n4 demo%trans%dims[4]
  define real demo%trans%a[n1,n2,n3,n4] /global
  !
  define integer o1 o2 o3 o4
  let o1 demo%trans%order[1]
  let o2 demo%trans%order[2]
  let o3 demo%trans%order[3]
  let o4 demo%trans%order[4]
  let n1 demo%trans%dims[o1]
  let n2 demo%trans%dims[o2]
  let n3 demo%trans%dims[o3]
  let n4 demo%trans%dims[o4]
  define real demo%trans%b[n1,n2,n3,n4] /global
  define real demo%trans%c /like demo%trans%b /global
  !
end procedure define_abc_4d
!
begin procedure define_abc_5d
  !---------------------------------------------------------------------
  ! Define the A array, and transposed B and C arrays in memory. None
  ! is filled yet
  !---------------------------------------------------------------------
  if exist(demo%trans%a) then
    delete /variable demo%trans%a
    delete /variable demo%trans%b
    delete /variable demo%trans%c
  endif
  !
  define integer n1 n2 n3 n4 n5
  let n1 demo%trans%dims[1]
  let n2 demo%trans%dims[2]
  let n3 demo%trans%dims[3]
  let n4 demo%trans%dims[4]
  let n5 demo%trans%dims[5]
  define real demo%trans%a[n1,n2,n3,n4,n5] /global
  !
  define integer o1 o2 o3 o4 o5
  let o1 demo%trans%order[1]
  let o2 demo%trans%order[2]
  let o3 demo%trans%order[3]
  let o4 demo%trans%order[4]
  let o5 demo%trans%order[5]
  let n1 demo%trans%dims[o1]
  let n2 demo%trans%dims[o2]
  let n3 demo%trans%dims[o3]
  let n4 demo%trans%dims[o4]
  let n5 demo%trans%dims[o5]
  define real demo%trans%b[n1,n2,n3,n4,n5] /global
  define real demo%trans%c /like demo%trans%b /global
  !
end procedure define_abc_5d
!
begin procedure define_abc_6d
  !---------------------------------------------------------------------
  ! Define the A array, and transposed B and C arrays in memory. None
  ! is filled yet
  !---------------------------------------------------------------------
  if exist(demo%trans%a) then
    delete /variable demo%trans%a
    delete /variable demo%trans%b
    delete /variable demo%trans%c
  endif
  !
  define integer n1 n2 n3 n4 n5 n6
  let n1 demo%trans%dims[1]
  let n2 demo%trans%dims[2]
  let n3 demo%trans%dims[3]
  let n4 demo%trans%dims[4]
  let n5 demo%trans%dims[5]
  let n6 demo%trans%dims[6]
  define real demo%trans%a[n1,n2,n3,n4,n5,n6] /global
  !
  define integer o1 o2 o3 o4 o5 o6
  let o1 demo%trans%order[1]
  let o2 demo%trans%order[2]
  let o3 demo%trans%order[3]
  let o4 demo%trans%order[4]
  let o5 demo%trans%order[5]
  let o6 demo%trans%order[6]
  let n1 demo%trans%dims[o1]
  let n2 demo%trans%dims[o2]
  let n3 demo%trans%dims[o3]
  let n4 demo%trans%dims[o4]
  let n5 demo%trans%dims[o5]
  let n6 demo%trans%dims[o6]
  define real demo%trans%b[n1,n2,n3,n4,n5,n6] /global
  define real demo%trans%c /like demo%trans%b /global
  !
end procedure define_abc_6d
!
begin procedure define_abc_7d
  !---------------------------------------------------------------------
  ! Define the A array, and transposed B and C arrays in memory. None
  ! is filled yet
  !---------------------------------------------------------------------
  if exist(demo%trans%a) then
    delete /variable demo%trans%a
    delete /variable demo%trans%b
    delete /variable demo%trans%c
  endif
  !
  define integer n1 n2 n3 n4 n5 n6 n7
  let n1 demo%trans%dims[1]
  let n2 demo%trans%dims[2]
  let n3 demo%trans%dims[3]
  let n4 demo%trans%dims[4]
  let n5 demo%trans%dims[5]
  let n6 demo%trans%dims[6]
  let n7 demo%trans%dims[7]
  define real demo%trans%a[n1,n2,n3,n4,n5,n6,n7] /global
  !
  define integer o1 o2 o3 o4 o5 o6 o7
  let o1 demo%trans%order[1]
  let o2 demo%trans%order[2]
  let o3 demo%trans%order[3]
  let o4 demo%trans%order[4]
  let o5 demo%trans%order[5]
  let o6 demo%trans%order[6]
  let o7 demo%trans%order[7]
  let n1 demo%trans%dims[o1]
  let n2 demo%trans%dims[o2]
  let n3 demo%trans%dims[o3]
  let n4 demo%trans%dims[o4]
  let n5 demo%trans%dims[o5]
  let n6 demo%trans%dims[o6]
  let n7 demo%trans%dims[o7]
  define real demo%trans%b[n1,n2,n3,n4,n5,n6,n7] /global
  define real demo%trans%c /like demo%trans%b /global
  !
end procedure define_abc_7d
!
!-----------------------------------------------------------------------
!
begin procedure fill_a
  !---------------------------------------------------------------------
  ! Fill the A array with unambiguous values
  !---------------------------------------------------------------------
  if demo%trans%ndim.eq.2 then
    @ fill_a_2d
  else if demo%trans%ndim.eq.3 then
    @ fill_a_3d
  else if demo%trans%ndim.eq.4 then
    @ fill_a_4d
  else if demo%trans%ndim.eq.5 then
    @ fill_a_5d
  else if demo%trans%ndim.eq.6 then
    @ fill_a_6d
  else if demo%trans%ndim.eq.7 then
    @ fill_a_7d
  endif
end procedure fill_a
!
begin procedure fill_a_2d
  !---------------------------------------------------------------------
  ! Fill the A array with unambiguous values
  !---------------------------------------------------------------------
  define integer n1
  let n1 demo%trans%dims[1]
  let demo%trans%a[i1,i2] -
    i1+n1*i2
end procedure fill_a_2d
!
begin procedure fill_a_3d
  !---------------------------------------------------------------------
  ! Fill the A array with unambiguous values
  !---------------------------------------------------------------------
  define integer n1 n2
  let n1 demo%trans%dims[1]
  let n2 demo%trans%dims[2]
  let demo%trans%a[i1,i2,i3] -
    i1+n1*i2+n1*n2*i3
end procedure fill_a_3d
!
begin procedure fill_a_4d
  !---------------------------------------------------------------------
  ! Fill the A array with unambiguous values
  !---------------------------------------------------------------------
  define integer n1 n2 n3
  let n1 demo%trans%dims[1]
  let n2 demo%trans%dims[2]
  let n3 demo%trans%dims[3]
  let demo%trans%a[i1,i2,i3,i4] -
    i1+n1*i2+n1*n2*i3+n1*n2*n3*i4
end procedure fill_a_4d
!
begin procedure fill_a_5d
  !---------------------------------------------------------------------
  ! Fill the A array with unambiguous values
  !---------------------------------------------------------------------
  define integer n1 n2 n3 n4
  let n1 demo%trans%dims[1]
  let n2 demo%trans%dims[2]
  let n3 demo%trans%dims[3]
  let n4 demo%trans%dims[4]
  let demo%trans%a[i1,i2,i3,i4,i5] -
    i1+n1*i2+n1*n2*i3+n1*n2*n3*i4+n1*n2*n3*n4*i5
end procedure fill_a_5d
!
begin procedure fill_a_6d
  !---------------------------------------------------------------------
  ! Fill the A array with unambiguous values
  !---------------------------------------------------------------------
  define integer n1 n2 n3 n4 n5
  let n1 demo%trans%dims[1]
  let n2 demo%trans%dims[2]
  let n3 demo%trans%dims[3]
  let n4 demo%trans%dims[4]
  let n5 demo%trans%dims[5]
  let demo%trans%a[i1,i2,i3,i4,i5,i6] -
    i1+n1*i2+n1*n2*i3+n1*n2*n3*i4+n1*n2*n3*n4*i5+n1*n2*n3*n4*n5*i6
end procedure fill_a_6d
!
begin procedure fill_a_7d
  !---------------------------------------------------------------------
  ! Fill the A array with unambiguous values
  !---------------------------------------------------------------------
  define integer n1 n2 n3 n4 n5 n6
  let n1 demo%trans%dims[1]
  let n2 demo%trans%dims[2]
  let n3 demo%trans%dims[3]
  let n4 demo%trans%dims[4]
  let n5 demo%trans%dims[5]
  let n6 demo%trans%dims[6]
  let demo%trans%a[i1,i2,i3,i4,i5,i6,i7] -
    i1+n1*i2+n1*n2*i3+n1*n2*n3*i4+n1*n2*n3*n4*i5+n1*n2*n3*n4*n5*i6+n1*n2*n3*n4*n5*n6*i7
end procedure fill_a_7d
!
!-----------------------------------------------------------------------
!
begin procedure transpose_ac
  !---------------------------------------------------------------------
  ! Transpose A in the C array by hand
  !---------------------------------------------------------------------
  !
  if demo%trans%ndim.eq.2 then
    @ transpose_ac_2d
  else if demo%trans%ndim.eq.3 then
    @ transpose_ac_3d
  else if demo%trans%ndim.eq.4 then
    @ transpose_ac_4d
  else if demo%trans%ndim.eq.5 then
    @ transpose_ac_5d
  else if demo%trans%ndim.eq.6 then
    @ transpose_ac_6d
  else if demo%trans%ndim.eq.7 then
    @ transpose_ac_7d
  endif
end procedure transpose_ac

begin procedure transpose_ac_2d
  !---------------------------------------------------------------------
  ! Transpose A in the C array by hand
  !---------------------------------------------------------------------
  !
  define integer o1 o2
  let o1 demo%trans%order[1]
  let o2 demo%trans%order[2]
  !
  define integer i[2]
  define alias j1 i[o1]
  define alias j2 i[o2]
  !
  delete /variable o1 o2
  !
  for i2 1 to demo%trans%dims[2]
    let i[2] i2
    for i1 1 to demo%trans%dims[1]
      let i[1] i1
      let demo%trans%c[j1,j2] demo%trans%a[i1,i2]
    next i1
  next i2
end procedure transpose_ac_2d
!
begin procedure transpose_ac_3d
  !---------------------------------------------------------------------
  ! Transpose A in the C array by hand
  !---------------------------------------------------------------------
  !
  define integer o1 o2 o3
  let o1 demo%trans%order[1]
  let o2 demo%trans%order[2]
  let o3 demo%trans%order[3]
  !
  define integer i[3]
  define alias j1 i[o1]
  define alias j2 i[o2]
  define alias j3 i[o3]
  !
  delete /variable o1 o2 o3
  !
  for i3 1 to demo%trans%dims[3]
    let i[3] i3
    for i2 1 to demo%trans%dims[2]
      let i[2] i2
      for i1 1 to demo%trans%dims[1]
        let i[1] i1
        let demo%trans%c[j1,j2,j3] demo%trans%a[i1,i2,i3]
      next i1
    next i2
  next i3
end procedure transpose_ac_3d
!
begin procedure transpose_ac_4d
  !---------------------------------------------------------------------
  ! Transpose A in the C array by hand
  !---------------------------------------------------------------------
  !
  define integer o1 o2 o3 o4
  let o1 demo%trans%order[1]
  let o2 demo%trans%order[2]
  let o3 demo%trans%order[3]
  let o4 demo%trans%order[4]
  !
  define integer i[4]
  define alias j1 i[o1]
  define alias j2 i[o2]
  define alias j3 i[o3]
  define alias j4 i[o4]
  !
  delete /variable o1 o2 o3 o4
  !
  for i4 1 to demo%trans%dims[4]
    let i[4] i4
    for i3 1 to demo%trans%dims[3]
      let i[3] i3
      for i2 1 to demo%trans%dims[2]
        let i[2] i2
        for i1 1 to demo%trans%dims[1]
          let i[1] i1
          let demo%trans%c[j1,j2,j3,j4] demo%trans%a[i1,i2,i3,i4]
        next i1
      next i2
    next i3
  next i4
end procedure transpose_ac_4d
!
begin procedure transpose_ac_5d
  !---------------------------------------------------------------------
  ! Transpose A in the C array by hand
  !---------------------------------------------------------------------
  !
  define integer o1 o2 o3 o4 o5
  let o1 demo%trans%order[1]
  let o2 demo%trans%order[2]
  let o3 demo%trans%order[3]
  let o4 demo%trans%order[4]
  let o5 demo%trans%order[5]
  !
  define integer i[5]
  define alias j1 i[o1]
  define alias j2 i[o2]
  define alias j3 i[o3]
  define alias j4 i[o4]
  define alias j5 i[o5]
  !
  delete /variable o1 o2 o3 o4 o5
  !
  for i5 1 to demo%trans%dims[5]
    let i[5] i5
    for i4 1 to demo%trans%dims[4]
      let i[4] i4
      for i3 1 to demo%trans%dims[3]
        let i[3] i3
        for i2 1 to demo%trans%dims[2]
          let i[2] i2
          for i1 1 to demo%trans%dims[1]
            let i[1] i1
            let demo%trans%c[j1,j2,j3,j4,j5] demo%trans%a[i1,i2,i3,i4,i5]
          next i1
        next i2
      next i3
    next i4
  next i5
end procedure transpose_ac_5d
!
begin procedure transpose_ac_6d
  !---------------------------------------------------------------------
  ! Transpose A in the C array by hand
  !---------------------------------------------------------------------
  !
  define integer o1 o2 o3 o4 o5 o6
  let o1 demo%trans%order[1]
  let o2 demo%trans%order[2]
  let o3 demo%trans%order[3]
  let o4 demo%trans%order[4]
  let o5 demo%trans%order[5]
  let o6 demo%trans%order[6]
  !
  define integer i[6]
  define alias j1 i[o1]
  define alias j2 i[o2]
  define alias j3 i[o3]
  define alias j4 i[o4]
  define alias j5 i[o5]
  define alias j6 i[o6]
  !
  delete /variable o1 o2 o3 o4 o5 o6
  !
  for i6 1 to demo%trans%dims[6]
    let i[6] i6
    for i5 1 to demo%trans%dims[5]
      let i[5] i5
      for i4 1 to demo%trans%dims[4]
        let i[4] i4
        for i3 1 to demo%trans%dims[3]
          let i[3] i3
          for i2 1 to demo%trans%dims[2]
            let i[2] i2
            for i1 1 to demo%trans%dims[1]
              let i[1] i1
              let demo%trans%c[j1,j2,j3,j4,j5,j6] demo%trans%a[i1,i2,i3,i4,i5,i6]
            next i1
          next i2
        next i3
      next i4
    next i5
  next i6
end procedure transpose_ac_6d
!
begin procedure transpose_ac_7d
  !---------------------------------------------------------------------
  ! Transpose A in the C array by hand
  !---------------------------------------------------------------------
  !
  define integer o1 o2 o3 o4 o5 o6 o7
  let o1 demo%trans%order[1]
  let o2 demo%trans%order[2]
  let o3 demo%trans%order[3]
  let o4 demo%trans%order[4]
  let o5 demo%trans%order[5]
  let o6 demo%trans%order[6]
  let o7 demo%trans%order[7]
  !
  define integer i[7]
  define alias j1 i[o1]
  define alias j2 i[o2]
  define alias j3 i[o3]
  define alias j4 i[o4]
  define alias j5 i[o5]
  define alias j6 i[o6]
  define alias j7 i[o7]
  !
  delete /variable o1 o2 o3 o4 o5 o6 o7
  !
  say "Transposing with Sic, this may take a while..."
  for i7 1 to demo%trans%dims[7]
    let i[7] i7
    for i6 1 to demo%trans%dims[6]
      let i[6] i6
      for i5 1 to demo%trans%dims[5]
        let i[5] i5
        for i4 1 to demo%trans%dims[4]
          let i[4] i4
          for i3 1 to demo%trans%dims[3]
            let i[3] i3
            for i2 1 to demo%trans%dims[2]
              let i[2] i2
              for i1 1 to demo%trans%dims[1]
                let i[1] i1
                let demo%trans%c[j1,j2,j3,j4,j5,j6,j7] demo%trans%a[i1,i2,i3,i4,i5,i6,i7]
              next i1
            next i2
          next i3
        next i4
      next i5
    next i6
  next i7
  say "... done."
end procedure transpose_ac_7d
!
!-----------------------------------------------------------------------
!
begin procedure do_memo_var
  !---------------------------------------------------------------------
  ! Compare hand-made and command-made transposition of Sic variables
  !---------------------------------------------------------------------
  !
  message i demo "Checking SIC variables transposition in memory"
  !
  v\transpose demo%trans%a demo%trans%b 'demo%trans%code'
  @ transpose_ac
  !
  @ compare_bc
  !
end procedure do_memo_var
!
begin procedure do_memo_gdf
  !---------------------------------------------------------------------
  ! Compare hand-made and command-made transposition of GDF images
  !---------------------------------------------------------------------
  !
  message i demo "Checking GDF images transposition in memory"
  define image ima a.gdf real /like demo%trans%a
  let ima demo%trans%a
  delete /var ima
  v\transpose a.gdf b.gdf 'demo%trans%code'
  !
  delete /var demo%trans%b
  define image demo%trans%b b.gdf read /global
  @ compare_bc
  !
  sic delete a.gdf b.gdf
  !
end procedure do_memo_gdf
!
begin procedure do_disk_gdf
  !---------------------------------------------------------------------
  ! Compare command-made transposition of Sic variables vs command-made
  ! tranposition of GDF images. This assumes that command-made
  ! transposition of Sic variables has already been checked.
  !---------------------------------------------------------------------
  !
  message i demo "Checking GDF images transposition on disk"
  define image ima a.gdf real /like demo%trans%a
  let ima demo%trans%a
  del /var ima
  !
  v\transpose demo%trans%a demo%trans%b 'demo%trans%code'
  v\transpose a.gdf b.gdf 'demo%trans%code'
  !
  del /var demo%trans%c
  define image demo%trans%c b.gdf read  /global
  @ compare_bc
  !
  sic delete a.gdf b.gdf
  !
end procedure do_disk_gdf
!
begin procedure do_memo
  !---------------------------------------------------------------------
  ! Compare hand-made and command-made transposition of Sic variables
  ! and GDF images
  !---------------------------------------------------------------------
  @ trans_memo_dims
  @ define_abc
  @ fill_a
  !
  @ do_memo_var
  @ do_memo_gdf
  !
end procedure do_memo
!
begin procedure do_disk
  !---------------------------------------------------------------------
  ! Compare command-made transposition of Sic variables vs command-made
  ! tranposition of GDF images. This assumes that command-made
  ! transposition of Sic variables has already been checked.
  !---------------------------------------------------------------------
  @ trans_disk_dims
  @ define_abc
  @ fill_a
  !
  @ do_disk_gdf
  !
end procedure do_disk
!
begin procedure compare_bc
  !---------------------------------------------------------------------
  ! Compare B and C arrays
  !---------------------------------------------------------------------
  !
  define integer d /like demo%trans%b
  let d 0
  let d 1 /where demo%trans%b.ne.demo%trans%c
  define real m
  sic\compute m max d
  if m.ne.0. then
    let demo%trans%error .true.
    message e demo "Transposition "'demo%trans%code'" failed"
    return error
  else
    message i demo "Success"
  endif
  !
end procedure compare_bc
!
begin procedure do_one
  !
  define character*7 nocode
  !
  say ""
  if pro%narg.eq.2 then
    let demo%trans%code 'pro%arg[1]''pro%arg[2]'
    message i demo "Checking transposition "'demo%trans%code'
    let demo%trans%ndim 2
    let demo%trans%order[1:2] 'pro%arg[1]' 'pro%arg[2]'
    let nocode "12"
    !
  else if pro%narg.eq.3 then
    let demo%trans%code 'pro%arg[1]''pro%arg[2]''pro%arg[3]'
    message i demo "Checking transposition "'demo%trans%code'
    let demo%trans%ndim 3
    let demo%trans%order[1:3] 'pro%arg[1]' 'pro%arg[2]' 'pro%arg[3]'
    let nocode "123"
    !
  else if pro%narg.eq.4 then
    let demo%trans%code 'pro%arg[1]''pro%arg[2]''pro%arg[3]''pro%arg[4]'
    message i demo "Checking transposition "'demo%trans%code'
    let demo%trans%ndim 4
    let demo%trans%order[1:4] 'pro%arg[1]' 'pro%arg[2]' 'pro%arg[3]' 'pro%arg[4]'
    let nocode "1234"
    !
  else if pro%narg.eq.5 then
    let demo%trans%code 'pro%arg[1]''pro%arg[2]''pro%arg[3]''pro%arg[4]''pro%arg[5]'
    message i demo "Checking transposition "'demo%trans%code'
    let demo%trans%ndim 5
    let demo%trans%order[1:5] 'pro%arg[1]' 'pro%arg[2]' 'pro%arg[3]' 'pro%arg[4]' 'pro%arg[5]'
    let nocode "12345"
    !
  else if pro%narg.eq.6 then
    let demo%trans%code 'pro%arg[1]''pro%arg[2]''pro%arg[3]''pro%arg[4]''pro%arg[5]''pro%arg[6]'
    message i demo "Checking transposition "'demo%trans%code'
    let demo%trans%ndim 6
    let demo%trans%order[1:6] 'pro%arg[1]' 'pro%arg[2]' 'pro%arg[3]' 'pro%arg[4]' 'pro%arg[5]' 'pro%arg[6]'
    let nocode "123456"
    !
  else if pro%narg.eq.7 then
    let demo%trans%code 'pro%arg[1]''pro%arg[2]''pro%arg[3]''pro%arg[4]''pro%arg[5]''pro%arg[6]''pro%arg[7]'
    message i demo "Checking transposition "'demo%trans%code'
    let demo%trans%ndim 7
    let demo%trans%order[1:7] 'pro%arg[1]' 'pro%arg[2]' 'pro%arg[3]' 'pro%arg[4]' 'pro%arg[5]' 'pro%arg[6]' 'pro%arg[7]'
    let nocode "1234567"
    !
  else
    message e demo "Unsupported number of dimensions"
    return error
  endif
  !
  @ do_memo
  if demo%trans%code.ne.nocode then
    ! If no transposition is to be done, the command has an optimization which just copies
    ! the file, i.e. there is no "disk" mode to be checked.
    @ do_disk
  endif
  !
end procedure do_one
!
begin procedure do_all
  !
  @ trans_init
  !
  @ do_one 1 2  ! No transposition, but should work
  @ do_one 2 1
  !
  @ do_one 1 2 3  ! No transposition, but should work
  @ do_one 1 3 2
  @ do_one 2 1 3
  @ do_one 2 3 1
  @ do_one 3 1 2
  @ do_one 3 2 1  ! New 02-apr-2012
  !
  @ do_one 1 2 3 4  ! No transposition, but should work
  @ do_one 1 2 4 3
  @ do_one 1 3 2 4
  @ do_one 1 3 4 2  ! New 02-apr-2012
  @ do_one 1 4 2 3  ! New 02-apr-2012
  @ do_one 1 4 3 2  ! New 02-apr-2012
  @ do_one 2 1 3 4
  ! @ do_one 2 1 4 3  ! 2 passes required
  @ do_one 2 3 1 4
  @ do_one 2 3 4 1
  ! @ do_one 2 4 1 3  ! 2 passes required
  ! @ do_one 2 4 3 1  ! 2 passes required
  @ do_one 3 1 2 4
  ! @ do_one 3 1 4 2  ! 2 passes required
  @ do_one 3 2 1 4  ! New 02-apr-2012
  ! @ do_one 3 2 4 1  ! 2 passes required
  @ do_one 3 4 1 2  ! New 02-apr-2012
  @ do_one 3 4 2 1  ! New 02-apr-2012
  @ do_one 4 1 2 3
  ! @ do_one 4 1 3 2  ! 2 passes required
  ! @ do_one 4 2 1 3  ! 2 passes required
  @ do_one 4 2 3 1  ! New 02-apr-2012
  @ do_one 4 3 1 2  ! New 02-apr-2012
  ! @ do_one 4 3 2 1  ! 2 passes required
  !
  ! For 5 dimensions or more, check only a few configurations
  @ do_one 1 2 3 4 5  ! No transposition, but should work
  @ do_one 1 4 3 2 5
  @ do_one 1 2 3 4 5 6  ! No transposition, but should work
  @ do_one 1 3 4 5 6 2
  @ do_one 4 5 6 3 1 2
  ! @ do_one 1 2 3 4 5 6 7  ! No transposition, but should work
  @ do_one 1 5 6 7 4 2 3
  !
  say ""
  if demo%trans%error then
    message e demo "Error: some transpositions failed"
  else
    message i demo "Success: all transpositions passed"
  endif
  !
end procedure do_all
!
! Set 'space_gildas' to a quite low value to enforce transposition of GDF
! images on disk
define character*5 space_sav
let space_sav `space_gildas`
sic logical space_gildas 4
!
sic headers 2
!
@ do_all
!
sic logical space_gildas 'space_sav'
!
