在Fortran中存储具有多维索引的变量

问题

考虑以下代码：

program example

  implicit none

  integer, parameter :: n_coeffs = 1000
  integer, parameter :: n_indices = 5
  integer :: i
  real(8), dimension(n_coeffs) :: coeff
  integer, dimension(n_coeffs,n_indices) :: index

  do i = 1, n_coeffs
    coeff(i)   = real(i*3,8)
    index(i,:) = [2,4,8,16,32]*i
  end do

end

对于任何5维索引，我需要获得相关系数，而不需要知道或计算

I

。例如，给定

[2,4,8,16,32]

我需要在不计算

I

的情况下获得

3.0

是否有一个合理的解决方案，可能是使用稀疏矩阵，将

n_指数

计算在100左右（尽管

n_系数仍在1000左右）


糟糕的解决方案

一种解决方案是定义一个5维数组，如中所示

real(8), dimension(2000,4000,8000,16000,32000) :: coeff2

do i = 1, ncoeffs
    coeff2(index(i,1),index(i,2),index(i,3),index(i,4),index(i,5)) = coeff(i)
end do

然后，要获得与
[2,4,8,16,32]
相关的系数，请调用

coeff2(2,4,8,16,32)

但是，除了非常浪费内存之外，该解决方案还不允许将
n_索引
设置为高于7的数字，因为一个数组有7维的限制


OBS：这个问题是一个衍生问题。在第一次尝试失败后，我试图更准确地提出这个问题，这一努力从@Rodrigo_Rodrigues的回答中受益匪浅


实际代码

如果有帮助，这里是我试图解决的实际问题的代码。它是一种用于逼近函数的自适应稀疏网格方法。主要目标是尽可能快地在以下位置进行插值：

MODULE MOD_PARAMETERS

    IMPLICIT NONE
    SAVE

    INTEGER, PARAMETER :: d     = 2     ! number of dimensions
    INTEGER, PARAMETER :: L_0   = 4     ! after this adaptive grid kicks in, for L <= L_0 usual sparse grid
    INTEGER, PARAMETER :: L_max = 9    ! maximum level
    INTEGER, PARAMETER :: bound = 0     ! 0 -> for f = 0 at boundary
                                        ! 1 -> adding grid points at boundary
                                        ! 2 -> extrapolating close to boundary
    INTEGER, PARAMETER :: max_error = 1
    INTEGER, PARAMETER :: L2_error  = 1
    INTEGER, PARAMETER :: testing_sample = 1000000

    REAL(8), PARAMETER :: eps = 0.01D0   ! epsilon for adaptive grid

END MODULE MOD_PARAMETERS

PROGRAM MAIN

USE MOD_PARAMETERS
IMPLICIT NONE

INTEGER, DIMENSION(d,d)                :: ident
REAL(8), DIMENSION(d)                  :: xd
INTEGER, DIMENSION(2*d)                :: temp
INTEGER, DIMENSION(:,:),   ALLOCATABLE :: grid_index, temp_grid_index, grid_index_new, J_index
REAL(8), DIMENSION(:),     ALLOCATABLE :: coeff, temp_coeff, J_coeff

REAL(8) :: temp_min, temp_max, V, T, B, F, x1
INTEGER :: k, k_1, k_2, h, i, j, L, n, dd, L1, L2, dsize, count, first, repeated, add, ind

INTEGER :: time1, time2, clock_rate, clock_max

REAL(8), DIMENSION(L_max,L_max,2**(L_max),2**(L_max)) :: coeff_grid
INTEGER, DIMENSION(d) :: level, LL, ii

REAL(8), DIMENSION(testing_sample,d) :: x_rand
REAL(8), DIMENSION(testing_sample)   :: interp1, interp2

! ============================================================================
! EXECUTABLE
! ============================================================================

ident = 0
DO i = 1,d
    ident(i,i) = 1
ENDDO

! Initial grid point
dsize = 1
ALLOCATE(grid_index(dsize,2*d),grid_index_new(dsize,2*d))
grid_index(1,:) = 1
grid_index_new  = grid_index

ALLOCATE(coeff(dsize))
xd = (/ 0.5D0, 0.5D0 /)
CALL FF(xd,coeff(1))
CALL FF(xd,coeff_grid(1,1,1,1))

L = 1
n = SIZE(grid_index_new,1)
ALLOCATE(J_index(n*2*d,2*d))
ALLOCATE(J_coeff(n*2*d))

CALL SYSTEM_CLOCK (time1,clock_rate,clock_max)

DO WHILE (L .LT. L_max)

    L       = L+1
    n       = SIZE(grid_index_new,1)
    count   = 0
    first   = 1
    DEALLOCATE(J_index,J_coeff)
    ALLOCATE(J_index(n*2*d,2*d))
    ALLOCATE(J_coeff(n*2*d))
    J_index = 0
    J_coeff = 0.0D0
    DO k = 1,n
        DO i = 1,d
            DO j = 1,2
                IF ((bound .EQ. 0) .OR. (bound .EQ. 2)) THEN
                    temp = grid_index_new(k,:)+(/ident(i,:),ident(i,:)*(grid_index_new(k,d+i)-(-1)**j)/)
                ELSEIF (bound .EQ. 1) THEN
                    IF (grid_index_new(k,i) .EQ. 1) THEN
                        temp = grid_index_new(k,:)+(/ident(i,:),ident(i,:)*(-(-1)**j)/)
                    ELSE
                        temp = grid_index_new(k,:)+(/ident(i,:),ident(i,:)*(grid_index_new(k,d+i)-(-1)**j)/)
                    ENDIF
                ENDIF
                CALL XX(d,temp(1:d),temp(d+1:2*d),xd)
                temp_min = MINVAL(xd)
                temp_max = MAXVAL(xd)
                IF ((temp_min .GE. 0.0D0) .AND. (temp_max .LE. 1.0D0)) THEN
                    IF (first .EQ. 1) THEN
                        first = 0
                        count = count+1
                        J_index(count,:) = temp
                        V = 0.0D0
                        DO k_1 = 1,SIZE(grid_index,1)
                            T = 1.0D0
                            DO k_2 = 1,d
                                CALL XX(1,temp(k_2),temp(d+k_2),x1)
                                CALL BASE(x1,grid_index(k_1,k_2),grid_index(k_1,k_2+d),B)
                                T = T*B
                            ENDDO
                            V = V+coeff(k_1)*T
                        ENDDO
                        CALL FF(xd,F)
                        J_coeff(count) = F-V
                    ELSE
                        repeated = 0
                        DO h = 1,count
                            IF (SUM(ABS(J_index(h,:)-temp)) .EQ. 0) THEN
                                repeated = 1
                            ENDIF
                        ENDDO
                        IF (repeated .EQ. 0) THEN
                            count = count+1
                            J_index(count,:) = temp
                            V = 0.0D0
                            DO k_1 = 1,SIZE(grid_index,1)
                                T = 1.0D0
                                DO k_2 = 1,d
                                    CALL XX(1,temp(k_2),temp(d+k_2),x1)
                                    CALL BASE(x1,grid_index(k_1,k_2),grid_index(k_1,k_2+d),B)
                                    T = T*B
                                ENDDO
                                V = V+coeff(k_1)*T
                            ENDDO
                            CALL FF(xd,F)
                            J_coeff(count) = F-V
                        ENDIF
                    ENDIF
                ENDIF
            ENDDO
        ENDDO
    ENDDO

    ALLOCATE(temp_grid_index(dsize,2*d))
    ALLOCATE(temp_coeff(dsize))
    temp_grid_index = grid_index
    temp_coeff      = coeff
    DEALLOCATE(grid_index,coeff)
    ALLOCATE(grid_index(dsize+count,2*d))
    ALLOCATE(coeff(dsize+count))
    grid_index(1:dsize,:) = temp_grid_index
    coeff(1:dsize)        = temp_coeff
    DEALLOCATE(temp_grid_index,temp_coeff)
    grid_index(dsize+1:dsize+count,:) = J_index(1:count,:)
    coeff(dsize+1:dsize+count)        = J_coeff(1:count)
    dsize = dsize + count    

    DO i = 1,count
        coeff_grid(J_index(i,1),J_index(i,2),J_index(i,3),J_index(i,4)) = J_coeff(i)
    ENDDO

    IF (L .LE. L_0) THEN
        DEALLOCATE(grid_index_new)
        ALLOCATE(grid_index_new(count,2*d))
        grid_index_new = J_index(1:count,:)
    ELSE
        add = 0
        DO h = 1,count
            IF (ABS(J_coeff(h)) .GT. eps) THEN
                add = add + 1
                J_index(add,:) = J_index(h,:)
            ENDIF
        ENDDO
        DEALLOCATE(grid_index_new)
        ALLOCATE(grid_index_new(add,2*d))
        grid_index_new = J_index(1:add,:)
    ENDIF

ENDDO

CALL SYSTEM_CLOCK (time2,clock_rate,clock_max)
PRINT *, 'Elapsed real time1 = ', DBLE(time2-time1)/DBLE(clock_rate)
PRINT *, 'Grid Points        = ', SIZE(grid_index,1)

! ============================================================================
! Compute interpolated values:
! ============================================================================

CALL RANDOM_NUMBER(x_rand)
CALL SYSTEM_CLOCK (time1,clock_rate,clock_max)
DO i = 1,testing_sample
    V = 0.0D0
    DO L1=1,L_max
        DO L2=1,L_max
            IF (L1+L2 .LE. L_max+1) THEN
                level = (/L1,L2/)
                T = 1.0D0
                DO dd = 1,d
                    T = T*(1.0D0-ABS(x_rand(i,dd)/2.0D0**(-DBLE(level(dd)))-DBLE(2*FLOOR(x_rand(i,dd)*2.0D0**DBLE(level(dd)-1))+1)))
                ENDDO
                V = V + coeff_grid(L1,L2,2*FLOOR(x_rand(i,1)*2.0D0**DBLE(L1-1))+1,2*FLOOR(x_rand(i,2)*2.0D0**DBLE(L2-1))+1)*T
            ENDIF
        ENDDO
    ENDDO
    interp2(i) = V
ENDDO
CALL SYSTEM_CLOCK (time2,clock_rate,clock_max)
PRINT *, 'Elapsed real time2 = ', DBLE(time2-time1)/DBLE(clock_rate)

END PROGRAM

模块模块模块参数
隐式无
拯救
整数，参数：：d=2！尺寸数
整数，参数：：L_0=4！在该自适应网格生效后，对于边界处f=0的L
! 1->在边界处添加栅格点
! 2->在边界附近进行外推
整数，参数：：max_error=1
整数，参数：：L2_错误=1
整数，参数：：测试样本=1000000
实数（8），参数：：eps=0.01D0！自适应网格的ε
终端模块模块参数
主程序
使用MOD_参数
隐式无
整数，维度（d，d）：：标识
实数（8），维数（d）：：xd
整数，维数（2*d）：：temp
整数，维度（：，：），可分配：：网格索引，临时网格索引，网格索引，新，J索引
实数（8），维（：），可分配：：系数，临时系数，J系数
实数（8）：最小温度、最大温度、V、T、B、F、x1
整数：k，k_1，k_2，h，i，j，L，n，dd，L1，L2，dsize，count，first，repeated，add，ind
整数：：时间1，时间2，时钟速率，时钟最大值
实数（8），维数（L_max，L_max，2**（L_max），2**（L_max））：：系数网格
整数，维度（d）：：级别，LL，ii
真实（8），尺寸（测试样本，d）：：x
真实尺寸（8），尺寸（测试样本）：interp1，interp2
! ============================================================================
! 可执行
! ============================================================================
ident=0
i=1，d吗
标识（i，i）=1
恩多
! 初始网格点
dsize=1
分配（网格索引（dsize，2*d），网格索引（dsize，2*d））
网格索引（1，：）=1
网格索引=网格索引
分配（系数（dsize））
xd=（/0.5D0，0.5D0/）
调用FF（xd，系数（1））
调用FF（xd，系数网格（1,1,1,1））
L=1
n=大小（网格索引新，1）
分配（J_指数（n*2*d，2*d））
分配（J_系数（n*2*d））
呼叫系统时钟（时钟1、时钟速率、时钟最大值）
请稍等片刻（L.LT.L_max）
L=L+1
n=大小（网格索引新，1）
计数=0
第一个=1
解除分配（J_指数，J_系数）
分配（J_指数（n*2*d，2*d））
分配（J_系数（n*2*d））
J_指数=0
J_系数=0.0D0
DO k=1，n
i=1，d吗
DO j=1,2
如果（（约束等式0）或（约束等式2）），则
temp=网格索引新（k，：）+（/ident（i，：），ident（i，：）*（网格索引新（k，d+i）-（1）**j/）
ELSEIF（等式1的约束）则
如果（网格索引新（k，i）.EQ.1），那么
temp=网格索引新（k，：）+（/ident（i，：），ident（i，：）*（-1）**j）/）
其他的
temp=网格索引新（k，：）+（/ident（i，：），ident（i，：）*（网格索引新（k，d+i）-（1）**j/）
恩迪夫
恩迪夫
打电话给XX（d，temp（1:d），temp（d+1:2*d），xd）
温度最小值=最小值（xd）
温度=最大值（xd）
如果（（最低温度GE.0.0D0）和（最高温度LE.1.0D0）），则
如果（首先，等式1），则
第一个=0
计数=计数+1
J_指数（计数：）=温度
V=0.0D0
DO k_1=1，大小（网格索引，1）
T=1.0D0
k_2=1，d
打电话给XX（1，临时（k_2），临时（d+k_2），x1）
调用基（x1，网格索引（k_1，k_2），网格索引（k_1，k_2+d），B）
T=T*B
恩多
V=V+coeff（k_1）*T
恩多
呼叫FF（xd，F）
J_系数（计数）=F-V
其他的
重复=0
h=1，计数吗
如果（和（ABS（J_指数（h，：）-temp）），等式0），那么
重复=1
恩迪夫
恩多
如果（重复等式0），则
计数=计数+1
J_指数（计数：）=温度
V=0.0D0
DO k_1=1，大小（网格索引，1）
T=1.0D0
k_2=1，d
打电话给XX（1，临时（k_2），临时（d+k_2），x1）
调用基（x1，网格索引（k_1，k_2），网格索引（k_1，k_2+d），B）
T=T*B
恩多
  function findloc_vector(matrix, vector) result(out)
    integer, intent(in) :: matrix(:, :)
    integer, intent(in) :: vector(size(matrix, dim=2))
    integer :: out, i

    do i = 1, size(matrix, dim=1)
      if (all(matrix(i, :) == vector)) then
        out = i
        return
      end if
    end do
    stop "No match for this vector"
  end

print*, coeff(findloc_vector(index, [2,4,8,16,32])) ! outputs 3.0

REAL(8), DIMENSION(L_max,L_max,2**(L_max),2**(L_max)) :: coeff_grid

DO i = 1,count
    coeff_grid(J_index(i,1),J_index(i,2),J_index(i,3),J_index(i,4)) = J_coeff(i)
ENDDO