mod_phys_lmdz_omp_transfert OMP transfer 核心

输入范围

LMDZ.COMMON-6.3\LMDZ.COMMON\libf\phy_common\mod_phys_lmdz_omp_transfert.F90

本页范围

本页展开 mod_phys_lmdz_omp_transfert.F90（1119 行）的全部 4 个泛型接口、56 个 specific procedures、12 个引擎子程序和 3 个 buffer 检查 helper。omp-data-transfer 是组页概览；phys-transfer-para-wrapper 覆盖上层合并层；本页专注 OMP 底层实现细节。

模块结构

MODULE mod_phys_lmdz_omp_transfert
  PRIVATE
  REAL,PARAMETER :: grow_factor=1.5
  INTEGER,PARAMETER :: size_min=1024

  CHARACTER(LEN=size_min),SAVE            :: buffer_c
  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_i
  REAL,SAVE,ALLOCATABLE,DIMENSION(:)      :: buffer_r
  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_l
  ...
  PUBLIC bcast_omp,scatter_omp,gather_omp,reduce_sum_omp, omp_barrier

模块默认 PRIVATE，只导出 4 个泛型接口和 omp_barrier。所有 buffer 都是模块级 SAVE 变量，在线程间共享（非 THREADPRIVATE）。

动态 buffer 机制

模块级 buffer 声明

配套 size 跟踪变量 size_i/size_r/size_l（初始 0）。

check_buffer 模式

check_buffer_i/check_buffer_r 使用 BARRIER+MASTER 模式：

SUBROUTINE check_buffer_i(buff_size)
!$OMP BARRIER
!$OMP MASTER
  IF (buff_size>size_i) THEN
    IF (ALLOCATED(buffer_i)) DEALLOCATE(buffer_i)
    size_i=MAX(size_min,INT(grow_factor*buff_size))
    ALLOCATE(buffer_i(size_i))
  ENDIF
!$OMP END MASTER
!$OMP BARRIER
END SUBROUTINE

流程：前 barrier 确保所有线程到达 → master 判断是否需要扩容 → 分配 MAX(size_min, 1.5*buff_size) 元素 → 后 barrier 确保所有线程看到新 buffer。

check_buffer_l 的 SINGLE 差异

check_buffer_l 使用 !$OMP SINGLE 替代 !$OMP MASTER：

!$OMP BARRIER
!$OMP SINGLE
  IF (buff_size>size_l) THEN ...
!$OMP END SINGLE
!$OMP BARRIER

源码注释解释了原因（Ehouarn 调试发现）：尽管有前后 BARRIER，MASTER 分配后某些调试环境下 buffer 尚未对所有线程可见，SINGLE 行为更可靠。

4 个泛型接口总览

总计 56 个 specific procedures + 12 个引擎子程序 + 3 个 check_buffer。

类型覆盖差异

• character：仅 bcast_omp_c（1 个），使用固定 buffer_c。
• logical：无 reduce_sum_omp（与 MPI 侧一致）。
• integer/real：覆盖全部 4 个接口。

维度后缀约定

与 MPI 侧一致：_i = scalar，_i1 = 1D，_i2 = 2D，_i3 = 3D。bcast 额外支持到 _i6（6D），reduce_sum 额外支持 _i4（4D）。

bcast_omp 引擎

通用模式

所有 bcast 引擎（bcast_omp_cgen/igen/rgen/lgen）使用相同的 OMP 指令序列：

!$OMP MASTER
  DO i=1,Nb
    Buff(i)=Var(i)       ! master 将值写入共享 buffer
  ENDDO
!$OMP END MASTER
!$OMP BARRIER             ! 确保所有线程看到 buffer

  DO i=1,Nb
    Var(i)=Buff(i)        ! 每个线程从 buffer 读回自己的 Var
  ENDDO
!$OMP BARRIER             ! 确保所有线程完成读

bcast 在 OMP 上下文中将 MPI rank 级的值（由 master 线程代表）广播给所有 OMP 线程。master 写 → barrier → 所有线程读 → barrier。

character 引擎特殊

bcast_omp_cgen 使用固定 buffer_c（LEN=size_min=1024），不做 check_buffer：

!$OMP MASTER
  Buff=Var
!$OMP END MASTER
!$OMP BARRIER
  DO i=1,Nb
    Var=Buff              ! 赋值整个字符串
  ENDDO
!$OMP BARRIER

标量包装

标量过程（bcast_omp_i/_r/_l）先复制到 Var_tmp(1) 数组，调用引擎，再复制回来。与 MPI 侧 bcast_mpi_i 的标量包装模式相同。

scatter_omp 引擎

通用模式

所有 scatter 引擎（scatter_omp_igen/rgen/lgen）使用相同的 OMP 指令序列：

!$OMP MASTER
  DO i=1,dimsize
    DO ij=1,klon_mpi
      Buff(ij,i)=VarIn(ij,i)    ! master 拷贝 rank 级数据到 buffer
    ENDDO
  ENDDO
!$OMP END MASTER
!$OMP BARRIER

  DO i=1,dimsize
    DO ij=1,klon_omp
      VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)  ! 每个线程取自己的列
    ENDDO
  ENDDO
!$OMP BARRIER

scatter 将 rank 级的 VarIn(klon_mpi,dimsize) 分发到各线程的 VarOut(klon_omp,dimsize)。每个线程通过 klon_omp_begin 偏移定位自己在 buffer 中的列段。

dimsize 计算

scatter 从 VarOut 额外维度取 dimsize（Size(VarOut,2) 等），与 MPI scatter 侧一致。

buffer 声明

scatter 引擎的 Buff 声明为 DIMENSION(klon_mpi,dimsize)，由 check_buffer_* 确保模块级 buffer 足够大。

gather_omp 引擎

integer/logical 引擎：buffer 模式

gather_omp_igen/lgen 使用与 scatter 对称的 buffer 模式：

  DO i=1,dimsize
    DO ij=1,klon_omp
      Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)  ! 每个线程写入自己的列
    ENDDO
  ENDDO
!$OMP BARRIER

!$OMP MASTER
  DO i=1,dimsize
    DO ij=1,klon_mpi
      VarOut(ij,i)=Buff(ij,i)    ! master 从 buffer 拷贝到 rank 级输出
    ENDDO
  ENDDO
!$OMP END MASTER
!$OMP BARRIER

方向与 scatter 相反：所有线程先写 → barrier → master 读 → barrier。

real 引擎：POINTER 直写（无 buffer）

gather_omp_rgen 使用 POINTER 而非 buffer，是唯一不通过共享 buffer 的引擎：

SUBROUTINE gather_omp_rgen(VarIn,VarOut,dimsize)
  REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize),TARGET :: VarOut
  REAL, POINTER, SAVE :: Varout_ptr(:,:)  ! Shared between threads, NOT THREADPRIVATE

  !$OMP MASTER
  Varout_ptr => VarOut
  !$OMP END MASTER
  !$OMP BARRIER

  DO i=1,dimsize
    DO ij=1,klon_omp
      Varout_ptr(klon_omp_begin-1+ij,i)=VarIn(ij,i)
    ENDDO
  ENDDO
  !$OMP BARRIER
END SUBROUTINE

master 获取 VarOut 的 POINTER → barrier → 所有线程通过 POINTER 直接写入各自偏移位置。这避免了 buffer 分配和额外拷贝，是性能优化。

注意：Varout_ptr 是 SAVE 但非 THREADPRIVATE，所有线程共享同一指针。VarOut 的 TARGET 属性允许 POINTER 关联。

gather_omp_r* specific procedures 不检查 buffer

gather_omp_r/_r1/_r2/_r3 不调用 check_buffer_r，因为 real gather 不使用 buffer。

reduce_sum_omp 引擎

通用模式

reduce_sum_omp_igen/rgen 使用 CRITICAL section 实现线程间求和：

!$OMP MASTER
  Buff(:)=0                    ! master 清零
!$OMP END MASTER
!$OMP BARRIER

!$OMP CRITICAL
  DO i=1,dimsize
    Buff(i)=Buff(i)+VarIn(i)   ! 每个线程串行累加
  ENDDO
!$OMP END CRITICAL
!$OMP BARRIER

!$OMP MASTER
  DO i=1,dimsize
    VarOut(i)=Buff(i)          ! master 将结果写入输出
  ENDDO
!$OMP END MASTER
!$OMP BARRIER

三阶段：master 清零 → barrier → 各线程 CRITICAL 累加（串行化，保证原子性） → barrier → master 输出 → barrier。

标量包装

标量过程（reduce_sum_omp_i/_r）使用 VarIn_tmp(1)/VarOut_tmp(1) 包装标量为数组。

dimsize 计算

reduce_sum 使用 SIZE(VarIn) 展平多维数组为连续内存，与 MPI 侧一致。

omp_barrier 工具

SUBROUTINE omp_barrier
!$OMP BARRIER
END SUBROUTINE

独立的 barrier 子程序，供上层代码在需要同步所有 OMP 线程时使用。

OMP 指令使用模式汇总

barrier 计数

与 MPI 侧对比

OMP 模块没有 scatter2D/gather2D/grid1dTo2d/grid2dTo1d 接口——这些操作在 MPI 侧完成后，OMP 层只做 rank→thread 的列分配。

依赖数据汇总

Mars 运行参与度

条件经过：Mars 物理侧使用 OMP 并行时经过。CPP_OMP 构建 + omp_size>1 时执行 OMP 指令；
非 OMP 构建时 OMP 指令被编译器忽略，引擎退化为直接拷贝（buffer 仍存在但无同步语义）。

Mars 物理过程通过 phys-transfer-para-wrapper 的 bcast/scatter/gather 泛型间接调用本模块。_para wrapper 中 OMP 部分在所有线程上执行（非 !$OMP MASTER 区域），确保线程级列分配正确。

相关页面

• phy_common 总览
• omp-data-transfer（组页）
• phys-transfer-para-wrapper（上层合并层）
• phys-transfer-mpi-core（MPI 底层）
• mod_phys_lmdz_omp_transfert（主文件页）
• calfis-p-parallel-transfer