两个type结构体的指针分配有误
! 设置大数组共享内存 - 分为5个变量
subroutine setup_shared_memory_data(node_comm, node_rank, ensemble_pi_ptr, &
ensemble_u_ptr, ensemble_v_ptr, ensemble_th_ptr, ensemble_q_ptr, &
back_data_ptr, true_data_ptr, &
win_ensemble_pi, win_ensemble_u, win_ensemble_v, &
win_ensemble_th, win_ensemble_q, win_back, win_true)
use module_initial
use iso_c_binding
integer, intent(in) :: node_comm, node_rank
real, pointer, intent(out) :: ensemble_pi_ptr(:,:,:,:), ensemble_u_ptr(:,:,:,:), ensemble_v_ptr(:,:,:,:), &
ensemble_th_ptr(:,:,:,:), ensemble_q_ptr(:,:,:,:)
type(model_data), pointer, intent(inout) :: back_data_ptr, true_data_ptr
integer, intent(out) :: win_ensemble_pi, win_ensemble_u, win_ensemble_v, win_ensemble_th, win_ensemble_q, win_back, win_true
integer(kind=MPI_ADDRESS_KIND) :: ssize_ensemble, ssize_data
integer :: ierr, disp_unit
type(c_ptr) :: baseptr_pi, baseptr_u, baseptr_v, baseptr_th, baseptr_q, baseptr_back, baseptr_true
! ---------------------------------------------------
! back_data_ptr 和 true_data_ptr 是 model_data 类型的指针
integer(kind=c_intptr_t) :: addr
type(c_ptr) :: c_ptr_back, c_ptr_true
! ---------------------------------------------------
disp_unit = 4 ! sizeof(real)
! 集合数据大小 - 每个变量单独分配
if (node_rank == 0) then
ssize_ensemble = int(nx * nz * ny * nsample, MPI_ADDRESS_KIND) ! 单个变量
ssize_data = int(nx * nz * ny * 5, MPI_ADDRESS_KIND) ! 5个变量
else
ssize_ensemble = 0
ssize_data = 0
end if
! 分配5个集合变量的共享内存
call MPI_Win_allocate_shared(ssize_ensemble * disp_unit, disp_unit, MPI_INFO_NULL, &
node_comm, baseptr_pi, win_ensemble_pi, ierr)
if (node_rank /= 0) then
call MPI_Win_shared_query(win_ensemble_pi, 0, ssize_ensemble, disp_unit, baseptr_pi, ierr)
end if
call c_f_pointer(baseptr_pi, ensemble_pi_ptr, [nx, nz, ny, nsample])
call MPI_Win_allocate_shared(ssize_ensemble * disp_unit, disp_unit, MPI_INFO_NULL, &
node_comm, baseptr_u, win_ensemble_u, ierr)
if (node_rank /= 0) then
call MPI_Win_shared_query(win_ensemble_u, 0, ssize_ensemble, disp_unit, baseptr_u, ierr)
end if
call c_f_pointer(baseptr_u, ensemble_u_ptr, [nx, nz, ny, nsample])
call MPI_Win_allocate_shared(ssize_ensemble * disp_unit, disp_unit, MPI_INFO_NULL, &
node_comm, baseptr_v, win_ensemble_v, ierr)
if (node_rank /= 0) then
call MPI_Win_shared_query(win_ensemble_v, 0, ssize_ensemble, disp_unit, baseptr_v, ierr)
end if
call c_f_pointer(baseptr_v, ensemble_v_ptr, [nx, nz, ny, nsample])
call MPI_Win_allocate_shared(ssize_ensemble * disp_unit, disp_unit, MPI_INFO_NULL, &
node_comm, baseptr_th, win_ensemble_th, ierr)
if (node_rank /= 0) then
call MPI_Win_shared_query(win_ensemble_th, 0, ssize_ensemble, disp_unit, baseptr_th, ierr)
end if
call c_f_pointer(baseptr_th, ensemble_th_ptr, [nx, nz, ny, nsample])
call MPI_Win_allocate_shared(ssize_ensemble * disp_unit, disp_unit, MPI_INFO_NULL, &
node_comm, baseptr_q, win_ensemble_q, ierr)
if (node_rank /= 0) then
call MPI_Win_shared_query(win_ensemble_q, 0, ssize_ensemble, disp_unit, baseptr_q, ierr)
end if
call c_f_pointer(baseptr_q, ensemble_q_ptr, [nx, nz, ny, nsample])
! 分配背景场共享内存
call MPI_Win_allocate_shared(ssize_data * disp_unit, disp_unit, MPI_INFO_NULL, &
node_comm, baseptr_back, win_back, ierr)
if (node_rank /= 0) then
call MPI_Win_shared_query(win_back, 0, ssize_data, disp_unit, baseptr_back, ierr)
end if
! call c_f_pointer(baseptr_back, back_data_ptr)
call c_f_pointer(baseptr_back, back_data_ptr%pi, [nx, nz, ny])
addr = transfer(baseptr_back, addr) + 1 * nx * nz * ny * disp_unit
c_ptr_back = transfer(addr, c_ptr_back)
call c_f_pointer(c_ptr_back, back_data_ptr%u, [nx, nz, ny])
addr = transfer(baseptr_back, addr) + 2 * nx * nz * ny * disp_unit
c_ptr_back = transfer(addr, c_ptr_back)
call c_f_pointer(c_ptr_back, back_data_ptr%v, [nx, nz, ny])
addr = transfer(baseptr_back, addr) + 3 * nx * nz * ny * disp_unit
c_ptr_back = transfer(addr, c_ptr_back)
call c_f_pointer(c_ptr_back, back_data_ptr%th, [nx, nz, ny])
addr = transfer(baseptr_back, addr) + 4 * nx * nz * ny * disp_unit
c_ptr_back = transfer(addr, c_ptr_back)
call c_f_pointer(c_ptr_back, back_data_ptr%q, [nx, nz, ny])
! 分配真值场共享内存
call MPI_Win_allocate_shared(ssize_data * disp_unit, disp_unit, MPI_INFO_NULL, &
node_comm, baseptr_true, win_true, ierr)
if (node_rank /= 0) then
call MPI_Win_shared_query(win_true, 0, ssize_data, disp_unit, baseptr_true, ierr)
end if
! call c_f_pointer(baseptr_true, true_data_ptr)
call c_f_pointer(baseptr_true, true_data_ptr%pi, [nx, nz, ny])
addr = transfer(baseptr_true, addr) + 1 * nx * nz * ny * disp_unit
c_ptr_true = transfer(addr, c_ptr_true)
call c_f_pointer(c_ptr_true, true_data_ptr%u, [nx, nz, ny])
addr = transfer(baseptr_true, addr) + 2 * nx * nz * ny * disp_unit
c_ptr_true = transfer(addr, c_ptr_true)
call c_f_pointer(c_ptr_true, true_data_ptr%v, [nx, nz, ny])
addr = transfer(baseptr_true, addr) + 3 * nx * nz * ny * disp_unit
c_ptr_true = transfer(addr, c_ptr_true)
call c_f_pointer(c_ptr_true, true_data_ptr%th, [nx, nz, ny])
addr = transfer(baseptr_true, addr) + 4 * nx * nz * ny * disp_unit
c_ptr_true = transfer(addr, c_ptr_true)
call c_f_pointer(c_ptr_true, true_data_ptr%q, [nx, nz, ny])
end subroutine setup_shared_memory_data
(pylk312) [hejx@login04 da_svd]$ cat mylog.e21493684
srun: ROUTE: split_hostlist: hl=a3310n[13-14],b3305r8n8,b3306r1n[1-8],b3306r2n[1-5],b3309r2n[4-8],b3309r3n[1-8],b3309r4n[1-3] tree_width 0
forrtl: severe (174): SIGSEGV, segmentation fault occurred
Image PC Routine Line Source
libifcoremt.so.5 00002B0FCC1622F6 for__signal_handl Unknown Unknown
libpthread-2.17.s 00002B0FCBCD45D0 Unknown Unknown Unknown
da_svd.exe 000000000041BD81 da_system_IP_setu 852 NUDT_RFS_DA.F90
da_svd.exe 0000000000402AD6 MAIN__ 152 NUDT_RFS_DA.F90
da_svd.exe 0000000000401D4E Unknown Unknown Unknown
libc-2.17.so 00002B0FCDE3A3D5 __libc_start_main Unknown Unknown
da_svd.exe 0000000000401C59 Unknown Unknown Unknown
forrtl: severe (174): SIGSEGV, segmentation fault occurred
Image PC Routine Line Source
libifcoremt.so.5 00002B5530B802F6 for__signal_handl Unknown Unknown
libpthread-2.17.s 00002B55306F25D0 Unknown Unknown Unknown
da_svd.exe 000000000041BD81 da_system_IP_setu 852 NUDT_RFS_DA.F90
da_svd.exe 0000000000402AD6 MAIN__ 152 NUDT_RFS_DA.F90
da_svd.exe 0000000000401D4E Unknown Unknown Unknown
libc-2.17.so 00002B55328583D5 __libc_start_main Unknown Unknown
da_svd.exe 0000000000401C59 Unknown Unknown Unknown
forrtl: severe (174): SIGSEGV, segmentation fault occurred
Image PC Routine Line Source
libifcoremt.so.5 00002B1B63F5B2F6 for__signal_handl Unknown Unknown
libpthread-2.17.s 00002B1B63ACD5D0 Unknown Unknown Unknown
da_svd.exe 000000000041BD81 da_system_IP_setu 852 NUDT_RFS_DA.F90
da_svd.exe 0000000000402AD6 MAIN__ 152 NUDT_RFS_DA.F90
da_svd.exe 0000000000401D4E Unknown Unknown Unknown
libc-2.17.so 00002B1B65C333D5 __libc_start_main Unknown Unknown
da_svd.exe 0000000000401C59 Unknown Unknown Unknown
forrtl: severe (174): SIGSEGV, segmentation fault occurred
最新发布