Параллельное вычисление элементов массива в FORTRAN

[sithif]

Например, есть код, который вычисляет: var = [f1(var),f2(var),...]
Как можно вычислить элементы массива параллельно?

Попробовал сделать через do concurrent, но приходится использовать копию и select case.
Есть ли другой способ, требующий минимального изменения исходной программы?

Используется синтаксис Fortran

program test
    implicit none
    integer,parameter::rk=selected_real_kind(15,307)
    real(rk),dimension(4)::var,tmp
    integer :: i
    
    ! sequential
    var = 1._rk
    var = [var(1)+var(2),var(1)+var(3)**2,1._rk+var(3),var(2)+var(4)**2]
    write(*,*) var

    ! parallel
    var = 1._rk
    tmp = 0._rk
    do concurrent (i = 1:4)
        select case(i)
            case(1)
                tmp(1) = var(1)+var(2)
            case(2)
                tmp(2) = var(1)+var(3)**2
            case(3)
                tmp(3) = 1._rk+var(3)
            case(4)
                tmp(4) = var(2)+var(4)**2
        end select        
    end do
    var = tmp
    write(*,*) var   
               
end program test
 

[feedinglight]

Если конкретный математический сопроцессор может за 1 такт выполнить достаточное количество арифметических операций, то распараллеливание не нужно. И вообще, это не похоже на узкое место.

[Pphantom]

Хорошего решения, кажется, нет, но с практической точки зрения непонятно, зачем оно нужно (наверное, поэтому и нет). Если таких элементов несколько штук, то любое распараллеливание потратит ресурсов больше, чем простое вычисление, а если в каждый тип функции попадет хотя бы вектор, то распараллеливать выгоднее один такой вызов, а не все сразу.

[sithif]

Спасибо за ответы. Пока мне как раз хочется понять стоит ли с этим возиться.
Добавлю, что элементов в массиве может быть несколько сотен или тысяч, а не 4, как в примере.
Поэтому напрашивается параллельное вычисление.
Время вычисления каждого из элементов можно считать примерно одинаковым.
Сам код дан в формате var = [f1(var),f2(var),...] и требуется его переписать руками или используя CAS в более эффективный вид.
Просто оптимизировать руками едва ли даст результат лучше, чем флаги -O3 -ffast-math .

[Pphantom]

sithif в сообщении #1388814 писал(а):

Добавлю, что элементов в массиве может быть несколько сотен или тысяч, а не 4, как в примере.

С сотнями/тысячами разных функций? Тогда действительно сложный случай, и тут придется параллелить вручную.

[sithif]

Там все fi(var) заданы явно, как в примере, но более сложные выражения.
У этих выражений есть одинаковые куски, но для них определяются переменные перед вычислением самого массива.

Эта задача возникает при вычислении производных по переменным и/или параметрам отображений.
Например, для просто квадратичного отображения:

$$\left\{ \begin{array}{rcl} Q_1 &=& \cos(K_1) Q_1 + (Q_1^2+P_1) \sin(K_1) \\ P_1 &=& \cos(K_1)(Q_1^2+P_1) - Q_1 \sin(K_1) \end{array} \right.$$

код, который вычисляет как изменяются сами переменные и их первые производные:
var = [1.,K_1,Q_1,P_1,dQ_1dq_1,dP_1dq_1,...]
И если требуется считать производные высоких порядков, появляется большая размерность.

Используется синтаксис Fortran

module test
implicit none
public :: test_main
private
integer,parameter::rk=selected_real_kind(15,307)
real(rk)::wei1
real(rk)::par1,par2,par3,par4
real(rk)::var1,var2,var3,var4,var5,var6,var7,var8,var9,var10,var11,var12,var13,v&
&ar14,var15,var16,var17,var18,var19,var20,var21,var22,var23,var24,var25,var26,var&
&27,var28,var29,var30,var31,var32,var33,var34
contains
subroutine test_main(num,run,var,par)
implicit none
integer,intent(in),dimension(1)::num
real(rk),intent(in),dimension(1)::run
real(rk),intent(inout),dimension(21)::var
real(rk),intent(in),optional,dimension(0)::par
real(rk),dimension(1)::del
del=run/real(num,rk)
if (var(1) .lt. 5.E-1_rk) then
 return
endif
call seq1(num(1),del(1),var,par)
end subroutine test_main
subroutine seq1(num,del,var,par)
implicit none
integer,intent(in)::num
real(rk),intent(in)::del
real(rk),intent(inout),dimension(21)::var
real(rk),intent(in),optional,dimension(0)::par
integer::i
wei1=del
par1=var(2)
par2=cos(par1)
par3=sin(par1)
par4=-1.E+0_rk
do i=1,num,1
call seq1map1(wei1,var,par)
!IOwrite(10,*) var
end do
end subroutine seq1
subroutine seq1map1(s,var,par)
implicit none
integer::j
real(rk),intent(in)::s
real(rk),intent(inout),dimension(21)::var
real(rk),intent(in),optional,dimension(0)::par
var1=var(4)**2
var2=var1+var(5)
var3=2.E+0_rk*var(4)*var(6)
var4=var3+var(7)
var5=2.E+0_rk*var(4)*var(8)
var6=var5+var(9)
var7=2.E+0_rk*var(10)
var8=par4+var7
var9=var8*var(4)
var10=var9+var(11)
var11=var2
var12=var11+var(10)
var13=2.E+0_rk*var(4)*var(12)
var14=var13+var(13)
var15=var8*var(6)
var16=2.E+0_rk*var(4)*var(14)
var17=var15+var16+var(15)
var18=var4
var19=var18+var(14)
var20=var(6)*var(12)
var21=var(4)*var(16)
var22=var20+var21
var23=2.E+0_rk*var22
var24=var23+var(17)
var25=var8*var(8)
var26=2.E+0_rk*var(4)*var(18)
var27=var25+var26+var(19)
var28=var6
var29=var28+var(18)
var30=var(8)*var(12)
var31=var(4)*var(20)
var32=var30+var31
var33=2.E+0_rk*var32
var34=var33+var(21)
var(4:21:1)=[par3*var2+par2*var(4),par2*var2-par3*var(4),par3*var4+par2*var(6),p&
&ar2*var4-par3*var(6),par3*var6+par2*var(8),par2*var6-par3*var(8),par3*var10+par2&
&*var12,par2*var10-par3*var12,par3*var14+par2*var(12),par2*var14-par3*var(12),par&
&3*var17+par2*var19,par2*var17-1.E+0_rk*par3*var19,par3*var24+par2*var(16),par2*v&
&ar24-par3*var(16),par3*var27+par2*var29,par2*var27-par3*var29,par3*var34+par2*va&
&r(20),par2*var34-par3*var(20)]
end subroutine seq1map1
end module test