Omp并行计算中效率优化以及数组安全性问题

NAN00

在写代码时，发现这一块代码耗时很高，一时又找不到什么好的办法提高效率，想来问问大家有没有好办法。
另外对于循环中需要叠加的Fad和Fad_ss数组，在更新过程中可能会有数组竞争风险，请问有什么办法规避嘛？

[Fortran] 纯文本查看 复制代码

subroutine substrate_adhesion_force(Nc,p,Ad_type,diff_Ad,num_L,num_W,nearss,Nnearss,xyz,xyz_ss,spring_ss0,cutoff_ss,kad,Fad,Fad_ss)
    implicit none
    integer,intent(in) :: Nc,p,num_L,num_W,nearss(2,20,p,Nc),Nnearss(p,Nc)
    logical,intent(in) :: Ad_type(p,Nc)
    double precision,intent(in)  :: xyz(3,p,Nc),xyz_ss(3,num_L,num_W),spring_ss0(20,p,Nc),cutoff_ss,kad,diff_Ad
    double precision,intent(out) :: Fad(3,p,Nc),Fad_ss(3,num_L,num_W)
    ! integer,intent(out) :: t1,t2,t3

    integer :: i,j,k,i1,i2
    double precision :: core(3),vtemp1(3),dis,temp_force(3,20,p,Nc),temp0(3),Kad_temp

    Fad = 0; Fad_ss = 0
    temp_force = 0
    ! call system_clock(t1)
!$omp parallel private(i,j,k,i1,i2,core,vtemp1,dis,temp0,Kad_temp)
!$omp do
    do i = 1,Nc
        do j = 1,p-1
            if(Nnearss(j,i) /= 0)then
                core = xyz(:,j,i)
                if(Ad_type(j,i))then
                    Kad_temp = kad * diff_Ad
                else
                    Kad_temp = kad
                end if

                do k = 1,Nnearss(j,i)
                    i1 = nearss(1,k,j,i); i2 = nearss(2,k,j,i)
                    vtemp1 = xyz_ss(:,i1,i2) - core
                    dis = norm2(vtemp1)
                    vtemp1 = vtemp1 / dis

                    if(dis < cutoff_ss)then
                        temp0 = Kad_temp * (dis - spring_ss0(k,j,i)) * vtemp1
                        Fad(:,j,i) = Fad(:,j,i) + temp0
                        Fad_ss(:,i1,i2) = Fad_ss(:,i1,i2) - temp0
                    end if
                    ! temp_force(:,k,j,i) = kad * (dis - spring_ss0(k,j,i)) * vtemp1

                end do

            end if
        end do
    end do
!$omp end do
!$omp end parallel
end subroutine