Перевод mpi_send/recv в mpi_scatterv с 4D массивами Фортрана

Question

В настоящее время я пытаюсь преобразовать следующее mpi_send/recv звонки в один mpi_scattervпотому что я испытываю довольно значительное снижение производительности, копируя мой массив во временный буфер и отправляя этот временный буфер. Это все еще стоит того же, что и в последовательной реализации, но я надеялся распределить работу, не копируя ее во временный буфер. Похоже, что mpi_scatterv это функция, которую я хочу, но мои различные попытки реализации не сработали и были в основном сбиты с толку.

Код, который выполняет вызовы mpi_send / recv, приведен ниже:

    if(me_image.eq.root_image) then
        do i = 0, max_proc-1, 1
            allocate(temp_dCpqdR(3*nat_sl, 3*nat_sl, n_pairs(i+1), 3))

            do j = 1, n_pairs(i+1), 1
                temp_dCpqdR(:,:,j,:) = dCpqdR(:,:,j+offset,:)
                end do
            offset = offset + n_pairs(i+1)
            if(i.ne.0) then
                call mpi_send(temp_dCpqdR, 3*nat_sl*3*nat_sl*3*n_pairs(i+1), mpi_double_precision,&
                              i, 0, intra_image_comm,ierr)

                call mpi_send(Cpq, 3*nat_sl*3*nat_sl, mpi_double_precision,&
                              i, 1, intra_image_comm,ierr)

                call mpi_send(eigenvalues, 3*nat_sl, mpi_double_precision,&
                              i, 2, intra_image_comm,ierr)
                else
                my_dCpqdR(:,:,:,:) = temp_dCpqdR(:,:,:,:)
                end if
            deallocate(temp_dCpqdR)
            end do
        else
            if(me_image.le.(max_proc-1)) then
                call mpi_recv(my_dCpqdR,& ! Buffer
                              3*nat_sl*3*nat_sl*3*n_pairs(me_image+1),& ! Count
                              mpi_double_precision,& ! Type
                              0,& ! Source
                              0,& ! Tag
                              intra_image_comm,& ! Communicator
                              rstatus,& ! Status var
                              ierr) ! Error flag

                call mpi_recv(Cpq,& ! Buffer
                              3*nat_sl*3*nat_sl,& ! Count
                              mpi_double_precision,& ! Type
                              0,& ! Source
                              1,& ! Tag
                              intra_image_comm,& ! Communicator
                              rstatus,& ! Status var
                              ierr) ! Error flag

                call mpi_recv(eigenvalues,& ! Buffer
                              3*nat_sl,& ! Count
                              mpi_double_precision,& ! Type
                              0,& ! Source
                              2,& ! Tag
                              intra_image_comm,& ! Communicator
                              rstatus,& ! Status var
                              ierr) ! Error flag
                end if

        end if

Я пытался перевести вышеупомянутый код в вызовы scatterv сам, но я не уверен, как это сделать. Я думаю, что мне нужно иметь такие строки:

call mpi_type_create_subarray(4, (/ nat_sl, nat_sl, nat, 3 /), (/nat_sl, nat_sl, n_pairs(me_image+1), 3/),&
                              (/0, 0, 0, 0/), mpi_order_fortran, mpi_double_precision, subarr_typ, ierr)
call mpi_type_commit(subarr_typ, ierr)

А также

call mpi_scatterv(dCpqdR, n_pairs(me_image+1), f_displs, subarr_typ,&
                  my_dCpqdR, 3*nat_sl*3*nat_sl*3*n_pairs(me_image+1), subarr_typ,&
                  root_image, intra_image_comm, ierr)

Я прочитал, что мне нужно установить экстенты, чтобы я реализовал их так:

extent = 3*nat_sl*3*nat_sl*3*n_pairs(me_image+1)
call MPI_Type_create_resized(subarr_typ, 0, extent, resized_subarr, ierr)
call MPI_Type_commit(resized_subarr, ierr)

Но это дает мне довольно много ошибок, в том числе

[MathBook Pro:58100] *** An error occurred in MPI_Type_create_subarray
[MathBook Pro:58100] *** reported by process [2560884737,2314885530279477248]
[MathBook Pro:58100] *** on communicator MPI_COMM_WORLD
[MathBook Pro:58100] *** MPI_ERR_ARG: invalid argument of some other kind
[MathBook Pro:58100] *** MPI_ERRORS_ARE_FATAL (processes in this communicator will now abort,
[MathBook Pro:58100] ***    and potentially your MPI job)

В любом случае, я уверен, что ошибка заключается в том, что я обрабатываю схему памяти. Пожалуйста, дайте мне знать, если вам нужна дополнительная информация от меня, и я с нетерпением жду ваших предложений.