使用OpenMP填充数组元素时并行编译报错问题求助

问题根源 #

你的代码串行编译正常，但启用OpenMP并行编译报错，核心原因是OpenMP的parallel do指令仅支持包裹单个循环，你将4个独立的do循环都放在了同一个parallel do代码块内，违反了OpenMP语法规则。

解决方法 #

方法1：为每个循环单独添加OpenMP并行指令 #

将每个需要并行的循环用独立的parallel do块包裹，语法完全合规：

Program test
    !$ use omp_lib
    
    implicit none
    !$ call omp_set_num_threads(4)
    
    integer :: i, j
    integer, parameter :: dimen = 5
    real (kind = 8), dimension(dimen, dimen) :: tstarr = 0.0

    !.....................................................................
    ! Later I will have to fill the elements of the following matrix in the same way
    ! real (kind = 8), dimension(:,:), allocatable :: tstarr2
    ! allocate(tstarr2(2 * dimen, 2 * dimen))
    !.....................................................................

    ! 并行处理对角线填充
    !$ omp parallel do default(shared) private(i)
    do i = 1, dimen
        tstarr(i,i) = 3
    end do
    !$ omp end parallel do
    
    ! 并行处理相邻次对角线填充
    !$ omp parallel do default(shared) private(i)
    do i = 1, dimen - 1
        tstarr(i + 1, i) = 2
        tstarr(i, i + 1) = 2
    end do
    !$ omp end parallel do

    ! 并行处理隔一行的对角线填充
    !$ omp parallel do default(shared) private(i)
    do i = 1, dimen - 2
        tstarr(i + 2, i) = 4
        tstarr(i, i + 2) = 4
    end do
    !$ omp end parallel do

    ! 并行处理隔两行的对角线填充
    !$ omp parallel do default(shared) private(i)
    do i = 1, dimen - 3
        tstarr(i + 3, i) = 5
        tstarr(i, i + 3) = 5
    end do
    !$ omp end parallel do

    do i = 1, dimen
        do j = 1, dimen
            print *, tstarr(i,j)
        end do
    end do

end program test

方法2：合并循环后再并行（更高效） #

将多个独立循环合并为一个大循环，减少线程创建与销毁的开销，尤其适合大维度矩阵：

Program test
    !$ use omp_lib
    
    implicit none
    !$ call omp_set_num_threads(4)
    
    integer :: i, j
    integer, parameter :: dimen = 5
    real (kind = 8), dimension(dimen, dimen) :: tstarr = 0.0

    !.....................................................................
    ! Later I will have to fill the elements of the following matrix in the same way
    ! real (kind = 8), dimension(:,:), allocatable :: tstarr2
    ! allocate(tstarr2(2 * dimen, 2 * dimen))
    !.....................................................................

    !$ omp parallel do default(shared) private(i)
    do i = 1, dimen
        ! 填充对角线
        tstarr(i,i) = 3
        ! 填充相邻次对角线（i满足条件时执行）
        if (i <= dimen - 1) then
            tstarr(i + 1, i) = 2
            tstarr(i, i + 1) = 2
        end if
        ! 填充隔一行的对角线（i满足条件时执行）
        if (i <= dimen - 2) then
            tstarr(i + 2, i) = 4
            tstarr(i, i + 2) = 4
        end if
        ! 填充隔两行的对角线（i满足条件时执行）
        if (i <= dimen - 3) then
            tstarr(i + 3, i) = 5
            tstarr(i, i + 3) = 5
        end if
    end do
    !$ omp end parallel do

    do i = 1, dimen
        do j = 1, dimen
            print *, tstarr(i,j)
        end do
    end do

end program test

额外优化点 #

• 原代码中声明private(i,j)，但并行块内并未使用j，可以仅声明private(i)，减少不必要的变量私有化开销。
• 对于小维度矩阵（如示例中的dimen=5），并行的性能提升有限，但语法规则必须遵守；如果是大维度可分配矩阵（如注释中的tstarr2），方法2的效率优势会更明显。

内容的提问来源于stack exchange，提问作者Shubhanshu Karoliya