我有一个子程序，使用MPI_Type_indexed作为类型，将文件视图设定为输出来自CFD程序的数据。

该子程序有一个输入参数 local_data_array，
它识别 local_data_array 的类型，
写入一个整型头部，包含数组的大小，
创建一个带全局数组位移的索引类型（其中包含一些索引处理，用于把矩阵分离出来）
在这些索引处写入数组。

代码是用 gfortran -fdec-format-defaults -ffree-line-length-none -g3 -fcheck=all -fbacktrace 编译的

并使用mpich-5.0.1，未进行任何特殊配置。

subroutine interleaved_datawrite(local_data_array)

        use utils, only: quicksort
        implicit none

        class(*),dimension(:,:),intent(in)        :: local_data_array
        integer :: i, j, k, bytsize, indexarray(npoin), arraysize, number_of_leaves
        TYPE(mpi_datatype) :: mpitype, MPIindexedtype
        integer(KIND=INT_ADDRESSING) :: blocksize

        select type (local_data_array)
            type is (integer(KIND=INT_FLAG))
                bytsize = 2
                mpitype = MPI_INTEGER2
            type is (integer(KIND=INT_INDEX))
                bytsize = 4
                mpitype = MPI_INTEGER4
            type is (integer(KIND=INT_ADDRESSING))
                bytsize = 8
                mpitype = MPI_INTEGER8
            type is (real(KIND=REAL_LOW_PREC))
                bytsize = 4
                mpitype = MPI_REAL4
            type is (real(KIND=REAL_HIGH_PREC))
                bytsize = 8
                mpitype = MPI_REAL8
            class default
                print*,"MISSING TYPING IN [datawrite] subroutine in output module"
                STOP
        end select

        number_of_leaves = size(local_data_array,2)

        arraysize = nptot * number_of_leaves

        blocksize = (arraysize * bytsize) + 8

        call MPI_BARRIER(MPI_COMM_WORLD, ierr)

        call MPI_File_set_view(file, offset, MPI_INTEGER8, MPI_INTEGER8, "native", MPI_INFO_NULL, ierr)
        call MPI_File_write_all(file, blocksize, 1 , MPI_INTEGER8, MPI_STATUS_IGNORE, ierr)

        offset = offset + 8

        indexarray = GblDomainDisps * number_of_leaves

        call quicksort(indexarray, 1, npoin, local_data_array)
! the quicksort subroutine here is sorting indexarray and then rearranging the local_data_array. such that indexarray is not all jumbled up as that causes other errors with mpi_indexed


        call MPI_BARRIER(MPI_COMM_WORLD, ierr)

        do i=1,number_of_leaves

            CALL MPI_Type_create_indexed_block(npoin, 1, indexarray, mpitype, MPIindexedtype, ierr)

            CALL MPI_Type_commit(MPIindexedtype, ierr)

            call MPI_File_set_view(file, offset, mpitype, MPIindexedtype, "native", MPI_INFO_NULL, ierr)

            call MPI_File_write_all(file, local_data_array(:,i), npoin , mpitype, MPI_STATUS_IGNORE, ierr)

            call MPI_Type_free(MPIindexedtype, ierr)

            indexarray = indexarray + 1 

        enddo

        offset = offset + arraysize * bytsize

    end subroutine

子程序在任何矩阵或数组下都会出错，例如，对于矩阵 Outarr，来自 ISO_FORTRAN_ENV 的一个 REAL32 类型数组。

        real(KIND=REAL32), dimension(npoin,3) :: Outarr

        call interleaved_datawrite(Outarr)

并产生如下错误：

Code: /..../mpich-5.0.1/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.c:33: cdesc_create_datatype: Assertion `cdesc->elem_len == size' failed.

据我理解，这似乎是 local_data_array 的大小可能与 mpitype*npoin 不一致的问题，但我手动检查过，情况并非如此。我也不确定这是不是某种更隐蔽的问题，或者可能是我打错了某些东西。

编辑：已移除编译选项，问题仍然存在。

解决方案

问题在于将一个 class(*) 变量传递给MPI，如果不在select-type块中显式执行写操作，MPI无法正确确定缓冲区中变量的长度。

下面这段代码有点偷懒，但能正常工作。

    subroutine interleaved_datawrite(local_data_array)

        use utils, only: quicksort
        implicit none

        class(*),intent(in)        :: local_data_array(:,:)
        integer :: i, j, k, bytsize, indexarray(npoin), arraysize, number_of_leaves
        TYPE(mpi_datatype) :: mpitype, MPIindexedtype
        integer(KIND=INT_ADDRESSING) :: blocksize

        select type (local_data_array)
            type is (integer(KIND=INT_FLAG))
                bytsize = 2
                mpitype = MPI_INTEGER2
            type is (integer(KIND=INT_INDEX))
                bytsize = 4
                mpitype = MPI_INTEGER4
            type is (integer(KIND=INT_ADDRESSING))
                bytsize = 8
                mpitype = MPI_INTEGER8
            type is (real(KIND=REAL_LOW_PREC))
                bytsize = 4
                mpitype = MPI_REAL4
            type is (real(KIND=REAL_HIGH_PREC))
                bytsize = 8
                mpitype = MPI_REAL8
            class default
                print*,"MISSING TYPING IN [datawrite] subroutine in output module"
                STOP
        end select

        number_of_leaves = size(local_data_array,2)

        arraysize = nptot * number_of_leaves

        blocksize = (arraysize * bytsize) + 8

        call MPI_BARRIER(MPI_COMM_WORLD, ierr)

        call MPI_File_set_view(file, offset, MPI_INTEGER8, MPI_INTEGER8, "native", MPI_INFO_NULL, ierr)
        call MPI_File_write_all(file, blocksize, 1 , MPI_INTEGER8, MPI_STATUS_IGNORE, ierr)

        offset = offset + 8

        indexarray = GblDomainDisps * number_of_leaves

        call quicksort(indexarray, 1, npoin, local_data_array)

        if (isize .eq. 1) then
            print*, 'Serial execution detected, serial write script enabled'
            call MPI_File_set_view(file, offset, mpitype, mpitype, "native", MPI_INFO_NULL, ierr)
            call MPI_File_write_all(file, local_data_array, npoin , mpitype, MPI_STATUS_IGNORE, ierr)
            offset = offset + arraysize * bytsize
            return
        endif

        call MPI_BARRIER(MPI_COMM_WORLD, ierr)

        do i=1,number_of_leaves

            CALL MPI_Type_create_indexed_block(npoin, 1, indexarray, mpitype, MPIindexedtype)

            CALL MPI_Type_commit(MPIindexedtype, ierr)

            call MPI_File_set_view(file, offset, mpitype, MPIindexedtype, "native", MPI_INFO_NULL, ierr)

            select type (local_data_array)
                type is (integer(KIND=INT_FLAG))
                    call MPI_File_write_all(file, local_data_array(:,i) , npoin , MPI_INTEGER2, MPI_STATUS_IGNORE, ierr)
                type is (integer(KIND=INT_INDEX))
                    call MPI_File_write_all(file, local_data_array(:,i) , npoin , MPI_INTEGER4, MPI_STATUS_IGNORE, ierr)
                type is (integer(KIND=INT_ADDRESSING))
                    call MPI_File_write_all(file, local_data_array(:,i) , npoin , MPI_INTEGER8, MPI_STATUS_IGNORE, ierr)
                type is (real(KIND=REAL_LOW_PREC))
                    call MPI_File_write_all(file, local_data_array(:,i) , npoin , MPI_REAL4, MPI_STATUS_IGNORE, ierr)
                type is (real(KIND=REAL_HIGH_PREC))
                    call MPI_File_write_all(file, local_data_array(:,i) , npoin , MPI_REAL8, MPI_STATUS_IGNORE, ierr)
                class default
                    print*,"MISSING TYPING IN [datawrite] subroutine in output module"
                    STOP
            end select

            call MPI_Type_free(MPIindexedtype, ierr)

            indexarray = indexarray + 1 

        enddo

        offset = offset + arraysize * bytsize

    end subroutine

最佳做法可能是把子程序重构为只保留一个select-type块，但为了让答案更易读，我就维持这样。