Added local-spec to every remaining do concurrent

src/collision/collision_check.f90

@@ -101,7 +101,11 @@ module subroutine collision_check_plpl(self, nbody_system, param, t, dt, irec, l
             lcollision(:) = .false.
             self%lclosest(:) = .false.
 
+#ifdef DOCONLOC
+            do concurrent(k = 1:nenc, lmask(k)) shared(self,pl,lmask, dt, lcollision) local(i,j,xr,vr,rlim,Gmtot)
+#else
             do concurrent(k = 1:nenc, lmask(k))
+#endif
                i = self%index1(k)
                j = self%index2(k)
                xr(:) = pl%rh(:, i) - pl%rh(:, j) 
@@ -204,8 +208,11 @@ module subroutine collision_check_pltp(self, nbody_system, param, t, dt, irec, l
             lcollision(:) = .false.
             self%lclosest(:) = .false.
 
-
+#ifdef DOCONLOC
+            do concurrent(k = 1:nenc, lmask(k)) shared(self,pl,tp,lmask, dt, lcollision) local(i,j,xr,vr)
+#else
             do concurrent(k = 1:nenc, lmask(k))
+#endif
                i = self%index1(k)
                j = self%index2(k)
                xr(:) = pl%rh(:, i) - tp%rh(:, j) 

src/collision/collision_regime.f90

@@ -111,7 +111,11 @@ subroutine collision_regime_LS12(collider, nbody_system, param)
          if (impactors%regime == COLLRESOLVE_REGIME_MERGE) then
             volume = 4._DP / 3._DP * PI * sum(impactors%radius(:)**3)
             radius = (3._DP * volume / (4._DP * PI))**(THIRD)
+#ifdef DOCONLOC
+            do concurrent(i = 1:NDIM) shared(impactors,Ip,L_spin)
+#else
             do concurrent(i = 1:NDIM)
+#endif
                Ip(i) = sum(impactors%mass(:) * impactors%Ip(i,:)) 
                L_spin(i) = sum(impactors%L_orbit(i,:) + impactors%L_spin(i,:))
             end do

src/collision/collision_resolve.f90

@@ -387,7 +387,11 @@ module subroutine collision_resolve_mergeaddsub(nbody_system, param, t, status)
             !    plnew%tlag = pl%tlag(ibiggest)
             ! end if
 
+#ifdef DOCONLOC
+            do concurrent(i = 1:nfrag) shared(plnew,fragments) local(volume)
+#else
             do concurrent(i = 1:nfrag)
+#endif
                volume = 4.0_DP/3.0_DP * PI * plnew%radius(i)**3
                plnew%density(i) = fragments%mass(i) / volume
             end do

src/collision/collision_util.f90

@@ -36,7 +36,11 @@ module subroutine collision_util_add_fragments_to_collider(self, nbody_system, p
             pl%mass(npl_before+1:npl_after) = fragments%mass(1:nfrag)
             pl%Gmass(npl_before+1:npl_after) = fragments%mass(1:nfrag) * param%GU
             pl%radius(npl_before+1:npl_after) = fragments%radius(1:nfrag)
+#ifdef DOCONLOC
+            do concurrent (i = 1:nfrag) shared(cb,pl,fragments)
+#else
             do concurrent (i = 1:nfrag)
+#endif
                pl%rb(:,npl_before+i) =  fragments%rb(:,i) 
                pl%vb(:,npl_before+i) =  fragments%vb(:,i) 
                pl%rh(:,npl_before+i) =  fragments%rb(:,i) - cb%rb(:)
@@ -169,7 +173,11 @@ module subroutine collision_util_get_energy_and_momentum(self, nbody_system, par
          associate(fragments => self%fragments, impactors => self%impactors, pl => nbody_system%pl, cb => nbody_system%cb)
             nfrag = self%fragments%nbody
             if (phase_val == 1) then
+#ifdef DOCONLOC
+               do concurrent(i = 1:2) shared(impactors)
+#else
                do concurrent(i = 1:2)
+#endif
                   impactors%ke_orbit(i) = 0.5_DP * impactors%mass(i) * dot_product(impactors%vc(:,i), impactors%vc(:,i))
                   impactors%ke_spin(i) = 0.5_DP * impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3,i) * dot_product(impactors%rot(:,i), impactors%rot(:,i))
                   impactors%be(i) = -3 * impactors%Gmass(i) * impactors%mass(i) / (5 * impactors%radius(i))
@@ -185,7 +193,11 @@ module subroutine collision_util_get_energy_and_momentum(self, nbody_system, par
                call swiftest_util_get_potential_energy(2, [(.true., i = 1, 2)], 0.0_DP, impactors%Gmass, impactors%mass, impactors%rb, self%pe(phase_val))
                self%te(phase_val) = self%ke_orbit(phase_val) + self%ke_spin(phase_val) + self%be(phase_val) + self%pe(phase_val)
             else if (phase_val == 2) then
+#ifdef DOCONLOC
+               do concurrent(i = 1:nfrag) shared(fragments)
+#else
                do concurrent(i = 1:nfrag)
+#endif
                   fragments%ke_orbit(i) = 0.5_DP * fragments%mass(i) * dot_product(fragments%vc(:,i), fragments%vc(:,i))
                   fragments%ke_spin(i) = 0.5_DP * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i) * dot_product(fragments%rot(:,i), fragments%rot(:,i))
                   fragments%L_orbit(:,i) = fragments%mass(i) * fragments%rc(:,i) .cross. fragments%vc(:,i)
@@ -918,7 +930,11 @@ module subroutine collision_util_set_original_scale_factors(self)
          impactors%L_orbit   = impactors%L_orbit   * collider%Lscale
          impactors%ke_orbit  = impactors%ke_orbit  * collider%Escale
          impactors%ke_spin   = impactors%ke_spin   * collider%Escale
+#ifdef DOCONLOC
+         do concurrent(i = 1:2) shared(impactors)
+#else
          do concurrent(i = 1:2)
+#endif
             impactors%rot(:,i) = impactors%L_spin(:,i) * (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3,i))
          end do
 

src/encounter/encounter_check.f90

@@ -174,7 +174,11 @@ subroutine encounter_check_all_sort_and_sweep_plpl(npl, r, v, renc, dt, nenc, in
          npl_last = npl
       end if
 
+#ifdef DOCONLOC
+      do concurrent (i = 1:npl) shared(r,renc,rmin,rmax) local(rmag)
+#else
       do concurrent (i = 1:npl)
+#endif
          rmag = .mag.r(:,i)
          rmax(i) = rmag + RSWEEP_FACTOR * renc(i)
          rmin(i) = rmag - RSWEEP_FACTOR * renc(i)
@@ -227,12 +231,20 @@ subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, rplm, vplm, rplt
          ntot_last = ntot
       end if
 
+#ifdef DOCONLOC
+      do concurrent (i = 1:nplm) shared(rmin,rmax,rplm,rencm) local(rmag)
+#else
       do concurrent (i = 1:nplm)
+#endif
          rmag = .mag.rplm(:,i)
          rmax(i) = rmag + RSWEEP_FACTOR * rencm(i)
          rmin(i) = rmag - RSWEEP_FACTOR * rencm(i)
       end do
+#ifdef DOCONLOC
+      do concurrent (i = 1:nplt) shared(rmin,rmax,rplt,renct) local(rmag)
+#else
       do concurrent (i = 1:nplt)
+#endif
          rmag = .mag.rplt(:,i)
          rmax(nplm+i) = rmag + RSWEEP_FACTOR * renct(i)
          rmin(nplm+i) = rmag - RSWEEP_FACTOR * renct(i)
@@ -287,12 +299,20 @@ subroutine encounter_check_all_sort_and_sweep_pltp(npl, ntp, rpl, vpl, rtp, vtp,
 
       renctp(:) = 0.0_DP
 
+#ifdef DOCONLOC
+      do concurrent (i = 1:npl) shared(rmin,rmax,rpl,rencpl) local(rmag)
+#else
       do concurrent (i = 1:npl)
+#endif
          rmag = .mag.rpl(:,i)
          rmax(i) = rmag + RSWEEP_FACTOR * rencpl(i)
          rmin(i) = rmag - RSWEEP_FACTOR * rencpl(i)
       end do
-      do concurrent (i = 1:ntp)
+#ifdef DOCONLOC
+      do concurrent (i = 1:ntp) shared(rmin,rmax,rtp,renctp) local(rmag)
+#else
+      do concurrent (i = 1:ntp) 
+#endif
          rmag = .mag.rtp(:,i)
          rmax(npl+i) = rmag + RSWEEP_FACTOR * renctp(i)
          rmin(npl+i) = rmag - RSWEEP_FACTOR * renctp(i)
@@ -335,7 +355,11 @@ pure subroutine encounter_check_all_sweep_one(i, n, xi, yi, zi, vxi, vyi, vzi, x
       logical, dimension(n) :: lencounteri, lvdotri
 
       lencounteri(:) = .false.
+#ifdef DOCONLOC
+      do concurrent(j = 1:n, lgood(j)) shared(lgood,lencounteri,lvdotri,x,y,z,vx,vy,vz,renci,renc) local(xr,yr,zr,vxr,vyr,vzr,renc12)
+#else
       do concurrent(j = 1:n, lgood(j))
+#endif
          xr = x(j) - xi
          yr = y(j) - yi
          zr = z(j) - zi
@@ -383,7 +407,7 @@ subroutine encounter_check_all_triangular_one(i, n, xi, yi, zi, vxi, vyi, vzi, x
       logical, dimension(n) :: lencounteri, lvdotri
 
 #ifdef DOCONLOC
-      do concurrent(j = i+1:n) shared(lencounteri, lvdotri)
+      do concurrent(j = i+1:n) shared(lencounteri, lvdotri, renci, renc) local(xr,yr,zr,vxr,vyr,vzr,renc12)
 #else
       do concurrent(j = i+1:n)
 #endif
@@ -700,7 +724,11 @@ subroutine encounter_check_remove_duplicates(n, nenc, index1, index2, lvdotr)
       ! Sort on the second index and remove duplicates 
       if (allocated(itmp)) deallocate(itmp)
       allocate(itmp, source=index2)
+#ifdef DOCONLOC
+      do concurrent(i = 1:n, iend(i) - ibeg(i) > 0_I8B) shared(iend,ibeg,index2,lencounter,itmp) local(klo,khi,nenci,j)
+#else
       do concurrent(i = 1:n, iend(i) - ibeg(i) > 0_I8B)
+#endif
          klo = ibeg(i)
          khi = iend(i)
          nenci = khi - klo + 1_I8B
@@ -747,7 +775,11 @@ pure module subroutine encounter_check_sort_aabb_1D(self, n, extent_arr)
 
       call util_sort(extent_arr, self%ind)
 
+#ifdef DOCONLOC
+      do concurrent(k = 1_I8B:2_I8B * n) shared(self,n) local(i)
+#else
       do concurrent(k = 1_I8B:2_I8B * n)
+#endif
          i = self%ind(k)
          if (i <= n) then
             self%ibeg(i) = k
@@ -940,7 +972,11 @@ module subroutine encounter_check_sweep_aabb_single_list(self, n, r, v, renc, dt
       call encounter_check_collapse_ragged_list(lenc, n, nenc, index1, index2, lvdotr)
 
       ! By convention, we always assume that index1 < index2, and so we must swap any that are out of order
+#ifdef DOCONLOC
+      do concurrent(k = 1_I8B:nenc, index1(k) > index2(k)) shared(index1,index2) local(itmp)
+#else
       do concurrent(k = 1_I8B:nenc, index1(k) > index2(k))
+#endif
          itmp = index1(k)
          index1(k) = index2(k)
          index2(k) = itmp

src/fraggle/fraggle_generate.f90

@@ -68,7 +68,11 @@ module subroutine fraggle_generate(self, nbody_system, param, t)
                ! Get the energy and momentum of the system before and after the collision
                call self%get_energy_and_momentum(nbody_system, param, phase="before")
                nfrag = fragments%nbody
+#ifdef DOCONLOC
+               do concurrent(i = 1:2) shared(fragments,impactors)
+#else
                do concurrent(i = 1:2)
+#endif
                   fragments%rc(:,i) = fragments%rb(:,i) - impactors%rbcom(:)
                   fragments%vc(:,i) = fragments%vb(:,i) - impactors%vbcom(:)
                end do
@@ -309,7 +313,11 @@ module subroutine fraggle_generate_merge(self, nbody_system, param, t)
             mass = sum(impactors%mass(:))
             volume = 4._DP / 3._DP * PI * sum(impactors%radius(:)**3)
             radius = (3._DP * volume / (4._DP * PI))**(THIRD)
+#ifdef DOCONLOC
+            do concurrent(i = 1:NDIM) shared(impactors, Ip, L_spin_new)
+#else
             do concurrent(i = 1:NDIM)
+#endif
                Ip(i) = sum(impactors%mass(:) * impactors%Ip(i,:)) 
                L_spin_new(i) = sum(impactors%L_orbit(i,:) + impactors%L_spin(i,:))
             end do
@@ -414,7 +422,7 @@ module subroutine fraggle_generate_pos_vec(collider, nbody_system, param, lfailu
 
             ! Randomly place the n>2 fragments inside their cloud until none are overlapping
 #ifdef DOCONLOC
-            do concurrent(i = istart:nfrag, loverlap(i)) shared(loverlap, mass_rscale, u, phi, theta, lhitandrun) local(j, direction)
+            do concurrent(i = istart:nfrag, loverlap(i)) shared(fragments, impactors, fragment_cloud_radius, fragment_cloud_center, loverlap, mass_rscale, u, phi, theta, lhitandrun) local(j, direction)
 #else
             do concurrent(i = istart:nfrag, loverlap(i))
 #endif
@@ -457,7 +465,7 @@ module subroutine fraggle_generate_pos_vec(collider, nbody_system, param, lfailu
             ! when the rest are not, we will randomly walk their position in space so as not to move them too far from their starting  position
             if (all(.not.loverlap(istart:nfrag)) .and. any(loverlap(1:istart-1))) then
 #ifdef DOCONLOC
-               do concurrent(i = 1:istart-1,loverlap(i)) shared(loverlap, u, theta, i) local(rwalk, dis)
+               do concurrent(i = 1:istart-1,loverlap(i)) shared(fragments,loverlap, u, theta, i) local(rwalk, dis)
 #else
                do concurrent(i = 1:istart-1,loverlap(i))
 #endif
@@ -519,7 +527,7 @@ module subroutine fraggle_generate_rot_vec(collider, nbody_system, param)
       class(swiftest_parameters),   intent(inout) :: param        !! Current run configuration parameters 
       ! Internals
       integer(I4B) :: i, nfrag
-      real(DP), parameter :: frag_rot_fac = 0.1_DP ! Fraction of projectile rotation magnitude to add as random noise to fragment rotation
+      real(DP), parameter :: FRAG_ROT_FAC = 0.1_DP ! Fraction of projectile rotation magnitude to add as random noise to fragment rotation
       real(DP), parameter :: hitandrun_momentum_transfer = 0.01_DP ! Fraction of projectile momentum transfered to target in a hit and run
       real(DP) :: mass_fac
       real(DP), dimension(NDIM) :: drot, dL
@@ -568,9 +576,13 @@ module subroutine fraggle_generate_rot_vec(collider, nbody_system, param)
          end if   
 
          call random_number(fragments%rot(:,2:nfrag))
+#ifdef DOCONLOC
+         do concurrent (i = 2:nfrag) shared(fragments,impactors) local(mass_fac)
+#else
          do concurrent (i = 2:nfrag)
+#endif
             mass_fac = fragments%mass(i) / impactors%mass(2)
-            fragments%rot(:,i) = mass_fac**(5.0_DP/3.0_DP) * impactors%rot(:,2) + 2 * (fragments%rot(:,i) - 1.0_DP) * frag_rot_fac * .mag.impactors%rot(:,2)
+            fragments%rot(:,i) = mass_fac**(5.0_DP/3.0_DP) * impactors%rot(:,2) + 2 * (fragments%rot(:,i) - 1.0_DP) * FRAG_ROT_FAC * .mag.impactors%rot(:,2)
          end do
          fragments%rotmag(:) = .mag.fragments%rot(:,:)
 
@@ -662,7 +674,11 @@ module subroutine fraggle_generate_vel_vec(collider, nbody_system, param, lfailu
 
                ! Scale the magnitude of the velocity by the distance from the impact point
                ! This will reduce the chances of fragments colliding with each other immediately, and is more physically correct  
-               do concurrent(i = 1:fragments%nbody)
+#ifdef DOCONLOC
+               do concurrent(i = 1:fragments%nbody) shared(fragments,impactors,vscale) local(rimp)
+#else
+               do concurrent(i = 1:fragments%nbody) 
+#endif
                   rimp(:) = fragments%rc(:,i) - impactors%rcimp(:) 
                   vscale(i) = .mag. rimp(:) / sum(impactors%radius(1:2))
                end do
@@ -673,7 +689,11 @@ module subroutine fraggle_generate_vel_vec(collider, nbody_system, param, lfailu
 
                ! Set the velocities of all fragments using all of the scale factors determined above
                if (istart > 1) fragments%vc(:,1) = impactors%vc(:,1) * impactors%mass(1) / fragments%mass(1)
+#ifdef DOCONLOC
+               do concurrent(i = istart:fragments%nbody) shared(fragments,impactors,lhitandrun, vscale, vesc, vsign) local(j,vrot,vmag,vdisp,rimp,vimp_unit)
+#else
                do concurrent(i = istart:fragments%nbody)
+#endif
                   j = fragments%origin_body(i)
                   vrot(:) = impactors%rot(:,j) .cross. (fragments%rc(:,i) - impactors%rc(:,j))
                   if (lhitandrun) then
@@ -704,7 +724,11 @@ module subroutine fraggle_generate_vel_vec(collider, nbody_system, param, lfailu
                   if (nsteps == 1) L_residual_best(:) = L_residual(:)
 
                   ! Use equipartition of spin kinetic energy to distribution spin angular momentum
+#ifdef DOCONLOC
+                  do concurrent(i = istart:fragments%nbody) shared(DLi_mag, fragments)
+#else
                   do concurrent(i = istart:fragments%nbody)
+#endif
                      dLi_mag(i) = ((fragments%mass(i) / fragments%mass(istart)) * &
                                    (fragments%radius(i) / fragments%radius(istart))**2 * &
                                    (fragments%Ip(3,i) / fragments%Ip(3,istart)))**(1.5_DP)
@@ -816,7 +840,11 @@ module subroutine fraggle_generate_vel_vec(collider, nbody_system, param, lfailu
             L_residual(:) = (collider%L_total(:,2) - collider%L_total(:,1))
             call collision_util_velocity_torque(-L_residual(:), collider%fragments%mtot, impactors%rbcom, impactors%vbcom)
 
+#ifdef DOCONLOC
+            do concurrent(i = 1:nfrag) shared(collider, impactors)
+#else
             do concurrent(i = 1:nfrag)
+#endif
                collider%fragments%vb(:,i) = collider%fragments%vc(:,i) + impactors%vbcom(:)
             end do
 

src/fraggle/fraggle_util.f90

@@ -44,7 +44,11 @@ module subroutine fraggle_util_restructure(self, nbody_system, param, lfailure)
          new_fragments%Gmass(1) =sum(old_fragments%Gmass(1:2))
          new_fragments%density(1) = new_fragments%mass(1) / volume
          new_fragments%radius(1) = (3._DP * volume / (4._DP * PI))**(THIRD)
+#ifdef DOCONLOC
+         do concurrent(i = 1:NDIM) shared(old_fragments, new_fragments)
+#else
          do concurrent(i = 1:NDIM)
+#endif
             new_fragments%Ip(i,1) = sum(old_fragments%mass(1:2) * old_fragments%Ip(i,1:2)) 
          end do
          new_fragments%Ip(:,1) = new_fragments%Ip(:,1) / new_fragments%mass(1)
@@ -55,7 +59,11 @@ module subroutine fraggle_util_restructure(self, nbody_system, param, lfailure)
          new_fragments%Gmass(2:nnew) = old_fragments%Gmass(3:nold)
          new_fragments%density(2:nnew) = old_fragments%density(3:nold)
          new_fragments%radius(2:nnew) = old_fragments%radius(3:nold)
+#ifdef DOCONLOC
+         do concurrent(i = 1:NDIM) shared(old_fragments,new_fragments)
+#else
          do concurrent(i = 1:NDIM)
+#endif
             new_fragments%Ip(i,2:nnew) = old_fragments%Ip(i,3:nold) 
          end do
          new_fragments%origin_body(2:nnew) = old_fragments%origin_body(3:nold)
@@ -87,10 +95,10 @@ module subroutine fraggle_util_set_mass_dist(self, param)
       class(collision_fraggle),   intent(inout) :: self  !! Fraggle collision system object
       class(swiftest_parameters), intent(in)    :: param !! Current Swiftest run configuration parameters
       ! Internals
-      integer(I4B)              :: i, j, k, jproj, jtarg, nfrag, istart, nfragmax, nrem
+      integer(I4B)              :: i, j, jproj, jtarg, nfrag, istart, nfragmax
       real(DP), dimension(2)    :: volume
       real(DP), dimension(NDIM) :: Ip_avg
-      real(DP) ::  mremaining, mtot, mcumul, G, mass_noise, Mslr, x0, x1, ymid, y0, y1, y, yp, eps, Mrat
+      real(DP) ::  mremaining, mtot, mcumul, G, mass_noise, Mslr, Mrat
       real(DP), dimension(:), allocatable :: mass
       real(DP)  :: beta 
       integer(I4B), parameter :: MASS_NOISE_FACTOR = 5  !! The number of digits of random noise that get added to the minimum mass value to prevent identical masses from being generated in a single run 
@@ -207,7 +215,11 @@ module subroutine fraggle_util_set_mass_dist(self, param)
 
             fragments%density(istart:nfrag) = fragments%mtot / sum(volume(:))
             fragments%radius(istart:nfrag) = (3 * fragments%mass(istart:nfrag) / (4 * PI * fragments%density(istart:nfrag)))**(1.0_DP / 3.0_DP)
+#ifdef DOCONLOC
+            do concurrent(i = istart:nfrag) shared(fragments,Ip_avg)
+#else
             do concurrent(i = istart:nfrag)
+#endif
                fragments%Ip(:, i) = Ip_avg(:)
             end do
 

src/helio/helio_gr.f90

@@ -77,7 +77,11 @@ pure module subroutine helio_gr_p4_pl(self, nbody_system, param, dt)
 
       associate(pl => self)
          npl = self%nbody
+#ifdef DOCONLOC
+         do concurrent(i = 1:npl, pl%lmask(i)) shared(param,pl,dt)
+#else
          do concurrent(i = 1:npl, pl%lmask(i))
+#endif
             call swiftest_gr_p4_pos_kick(param, pl%rh(:, i), pl%vb(:, i), dt)
          end do
       end associate
@@ -106,7 +110,11 @@ pure module subroutine helio_gr_p4_tp(self, nbody_system, param, dt)
 
       associate(tp => self)
          ntp = self%nbody
+#ifdef DOCONLOC
+         do concurrent(i = 1:ntp, tp%lmask(i)) shared(param,tp,dt)
+#else
          do concurrent(i = 1:ntp, tp%lmask(i))
+#endif
             call swiftest_gr_p4_pos_kick(param, tp%rh(:, i), tp%vb(:, i), dt)
          end do
       end associate