Omp并行计算中效率优化以及数组安全性问题
在写代码时，发现这一块代码耗时很高，一时又找不到什么好的办法提高效率，想来问问大家有没有好办法。另外对于循环中需要叠加的Fad和Fad_ss数组，在更新过程中可能会有数组竞争风险，请问有什么办法规避嘛？
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
页:
[1]