Skip to content

Commit fe1c8ce

Browse files
foxtranfoxtran
authored
Avoid spread intrinsic (#1281)
* Avoid spread intrinsic in coulomb/ Signed-off-by: Igor S. Gerasimov <[email protected]> * Avoid spread intrinsic in solv/ Signed-off-by: Igor S. Gerasimov <[email protected]> * Avoid spread intrinsic in peeq_module Signed-off-by: Igor S. Gerasimov <[email protected]> * Avoid spread intrinsic in freq/prooject.f90 Signed-off-by: Igor S. Gerasimov <[email protected]> * Avoid spread intrinsic in type/coulomb Signed-off-by: Igor S. Gerasimov <[email protected]> * Avoid spread intrinsic in xtb/hamiltonian, xtb/repulsion Signed-off-by: Igor S. Gerasimov <[email protected]> * Avoid spread intrinsic in disp/ Signed-off-by: Igor S. Gerasimov <[email protected]> * Avoid spread intrinsic in gfnff/gdisp0 Signed-off-by: Igor S. Gerasimov <[email protected]> * Add note about GCC perf Signed-off-by: Igor S. Gerasimov <[email protected]> * Avoid spread intrinsic in abhgfnff_eg3 Signed-off-by: Igor S. Gerasimov <[email protected]> * Avoid spread intrinsic in abhgfnff_eg2_rnr Signed-off-by: Igor S. Gerasimov <[email protected]> * Simplify expression Signed-off-by: Igor S. Gerasimov <[email protected]> * Avoid spread intrinsic in abhgfnff_eg2new Signed-off-by: Igor S. Gerasimov <[email protected]> * Avoid spread intrinsic in abhgfnff_eg1 Signed-off-by: Igor S. Gerasimov <[email protected]> * Avoid spread intrinsic in rbxgfnff_eg Signed-off-by: Igor S. Gerasimov <[email protected]> * Avoid rest spread intrinsic in gfnff/gfnff_eg Signed-off-by: Igor S. Gerasimov <[email protected]> --------- Signed-off-by: Igor S. Gerasimov <[email protected]>
1 parent 293469d commit fe1c8ce

File tree

14 files changed

+267
-101
lines changed

14 files changed

+267
-101
lines changed

‎src/coulomb/ewald.f90‎

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -139,7 +139,9 @@ pure subroutine ewaldDerivPBC3D_alp(vec, gTrans, qpc, volume, alpha, scale, &
139139
arg = dot_product(rik,vec)
140140
dtmp = -sin(arg) * expterm
141141
dAmat = dAmat + rik*dtmp
142-
dS = spread(rik,1,3)*spread(rik,2,3)
142+
dS(:, 1) = rik(1) * rik
143+
dS(:, 2) = rik(2) * rik
144+
dS(:, 3) = rik(3) * rik
143145
sigma = sigma + expterm * cos(arg) * ( &
144146
& - unity * (1.0_wp + rik2*falp + rik2*fqpc) &
145147
& + (2.0_wp/rik2 + 0.5_wp/alpha**2 + 0.5_wp*fqpc) * dS)
@@ -194,7 +196,9 @@ pure subroutine ewaldDerivPBC3D(vec, gTrans, qpc, volume, alpha, scale, &
194196
arg = dot_product(rik,vec)
195197
dtmp = -sin(arg) * expterm
196198
dAmat = dAmat + rik*dtmp
197-
dS = spread(rik,1,3)*spread(rik,2,3)
199+
dS(:, 1) = rik(1) * rik
200+
dS(:, 2) = rik(2) * rik
201+
dS(:, 3) = rik(3) * rik
198202
sigma = sigma + 0.5_wp * expterm * cos(arg) * ( &
199203
& - unity * (1.0_wp + rik2*fqpc) &
200204
& + (2.0_wp/rik2 + 0.5_wp/alpha**2 + 0.5_wp*fqpc) * dS)

‎src/coulomb/gaussian.f90‎

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -432,7 +432,9 @@ subroutine getCoulombDerivsCluster(mol, itbl, rad, qvec, djdr, djdtr, djdL)
432432
gij = 1.0_wp/(rad(ish, iid)**2 + rad(jsh, jid)**2)
433433
g1 = erf(sqrt(gij*r2))/sqrt(r2)
434434
dG(:) = (2*sqrt(gij)*exp(-gij*r2)/sqrtpi - g1) * vec/r2
435-
dS(:, :) = 0.5_wp * spread(dG, 1, 3) * spread(vec, 2, 3)
435+
dS(:, 1) = 0.5_wp * dG(1) * vec
436+
dS(:, 2) = 0.5_wp * dG(2) * vec
437+
dS(:, 3) = 0.5_wp * dG(3) * vec
436438
djdr(:, iat, jj+jsh) = djdr(:, iat, jj+jsh) - dG*qvec(ii+ish)
437439
djdr(:, jat, ii+ish) = djdr(:, jat, ii+ish) + dG*qvec(jj+jsh)
438440
djdtr(:, jj+jsh) = djdtr(:, jj+jsh) + dG*qvec(ii+ish)
@@ -577,7 +579,9 @@ pure subroutine getRDeriv(vec, gij, rTrans, alpha, scale, dG, dS)
577579
dd = + 2*gij*exp(-gij**2*r1**2)/(sqrtpi*r1**2) - erf(gij*r1)/(r1**3) &
578580
& - 2*alpha*exp(-arg)/(sqrtpi*r1**2) + erf(alpha*r1)/(r1**3)
579581
dG = dG + rij*dd
580-
dS = dS + 0.5_wp * dd*spread(rij, 1, 3)*spread(rij, 2, 3)
582+
dS(:, 1) = dS(:, 1) + 0.5_wp * dd * rij(1) * rij
583+
dS(:, 2) = dS(:, 2) + 0.5_wp * dd * rij(2) * rij
584+
dS(:, 3) = dS(:, 3) + 0.5_wp * dd * rij(3) * rij
581585
enddo
582586
dG = dG * scale
583587
dS = dS * scale

‎src/coulomb/klopmanohno.f90‎

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -525,7 +525,9 @@ subroutine getCoulombDerivsCluster(mol, itbl, gamAverage, gExp, hardness, &
525525
gij = gamAverage(hardness(ish, iid), hardness(jsh, jid))
526526
g1 = 1.0_wp / (r1**gExp + gij**(-gExp))
527527
dG(:) = -vec*r1**(gExp-2.0_wp) * g1 * g1**(1.0_wp/gExp)
528-
dS(:, :) = 0.5_wp * spread(dG, 1, 3) * spread(vec, 2, 3)
528+
dS(:, 1) = 0.5_wp * dG(1) * vec
529+
dS(:, 2) = 0.5_wp * dG(2) * vec
530+
dS(:, 3) = 0.5_wp * dG(3) * vec
529531
djdr(:, iat, jj+jsh) = djdr(:, iat, jj+jsh) - dG*qvec(ii+ish)
530532
djdr(:, jat, ii+ish) = djdr(:, jat, ii+ish) + dG*qvec(jj+jsh)
531533
djdtr(:, jj+jsh) = djdtr(:, jj+jsh) + dG*qvec(ii+ish)
@@ -679,7 +681,9 @@ pure subroutine getRDeriv(vec, gij, gExp, rTrans, alpha, scale, dG, dS)
679681
dd = -r1**(gExp-2.0_wp) * g1 * g1**(1.0_wp/gExp) &
680682
& - 2*alpha*exp(-arg)/(sqrtpi*r1**2) + erf(alpha*r1)/(r1**3)
681683
dG = dG + rij*dd
682-
dS = dS + 0.5_wp * dd*spread(rij, 1, 3)*spread(rij, 2, 3)
684+
dS(:, 1) = dS(:, 1) + 0.5_wp * dd * rij(1) * rij
685+
dS(:, 2) = dS(:, 2) + 0.5_wp * dd * rij(2) * rij
686+
dS(:, 3) = dS(:, 3) + 0.5_wp * dd * rij(3) * rij
683687
enddo
684688
dG = dG * scale
685689
dS = dS * scale

‎src/disp/coordinationnumber.f90‎

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -283,7 +283,9 @@ subroutine ncoordNeighs(mol, neighs, neighlist, kcn, cfunc, dfunc, enscale, &
283283
dcndr(:, iat, jat) = dcndr(:, iat, jat) + countd
284284
dcndr(:, jat, iat) = dcndr(:, jat, iat) - countd
285285

286-
stress = spread(countd, 1, 3) * spread(rij, 2, 3)
286+
stress(:, 1) = countd(1) * rij
287+
stress(:, 2) = countd(2) * rij
288+
stress(:, 3) = countd(3) * rij
287289

288290
dcndL(:, :, iat) = dcndL(:, :, iat) + stress
289291
if (iat /= jat) then
@@ -428,7 +430,9 @@ subroutine ncoordLatP(mol, trans, cutoff, kcn, cfunc, dfunc, enscale, &
428430
dcndr(:, iat, jat) = dcndr(:, iat, jat) + countd
429431
dcndr(:, jat, iat) = dcndr(:, jat, iat) - countd
430432

431-
stress = spread(countd, 1, 3) * spread(rij, 2, 3)
433+
stress(:, 1) = countd(1) * rij
434+
stress(:, 2) = countd(2) * rij
435+
stress(:, 3) = countd(3) * rij
432436

433437
dcndL(:, :, iat) = dcndL(:, :, iat) + stress
434438
if (iat /= jat) then

‎src/disp/dftd3.f90‎

Lines changed: 17 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -323,7 +323,9 @@ subroutine disp_gradient_latp &
323323

324324
dE = -c6(iat, jat)*disp * 0.5_wp
325325
dG = -c6(iat, jat)*ddisp*rij
326-
dS = spread(dG, 1, 3) * spread(rij, 2, 3) * 0.5_wp
326+
dS(:, 1) = 0.5_wp * dG(1) * rij
327+
dS(:, 2) = 0.5_wp * dG(2) * rij
328+
dS(:, 3) = 0.5_wp * dG(3) * rij
327329

328330
energies(iat) = energies(iat) + dE
329331
dEdcn(iat) = dEdcn(iat) - dc6dcn(iat, jat) * disp
@@ -647,7 +649,9 @@ subroutine disp_gradient_neigh &
647649

648650
dE = -c6(iat, jat)*disp * 0.5_wp
649651
dG = -c6(iat, jat)*ddisp*rij
650-
dS = spread(dG, 1, 3) * spread(rij, 2, 3) * 0.5_wp
652+
dS(:, 1) = 0.5_wp * dG(1) * rij
653+
dS(:, 2) = 0.5_wp * dG(2) * rij
654+
dS(:, 3) = 0.5_wp * dG(3) * rij
651655

652656
energies(iat) = energies(iat) + dE
653657
dEdcn(iat) = dEdcn(iat) - dc6dcn(iat, jat) * disp
@@ -841,17 +845,21 @@ pure subroutine deriv_atm_triple(c6ij, c6ik, c6jk, cij, cjk, cik, &
841845
& -5.0_wp*(r2jk-r2ik)**2*(r2jk+r2ik)) / (rrr3*rrr2)
842846
dGr = (-dang*c9*fdmp + dfdmp*c9*ang)/r2ij
843847
dG(:, 1) = -dGr * rij
844-
dG(:, 2) = +dGr * rij
845-
dS(:, :) = 0.5_wp * dGr * spread(rij, 1, 3) * spread(rij, 2, 3)
848+
dG(:, 2) = +dGr * rij
849+
dS(:, 1) = 0.5_wp * dGr * rij(1) * rij
850+
dS(:, 2) = 0.5_wp * dGr * rij(2) * rij
851+
dS(:, 3) = 0.5_wp * dGr * rij(3) * rij
846852

847853
! Derivative w.r.t. i-k distance
848854
dang = -0.375_wp*(r2ik**3+r2ik**2*(r2jk+r2ij) &
849855
& +r2ik*(3.0_wp*r2jk**2+2.0*r2jk*r2ij+3.0_wp*r2ij**2) &
850856
& -5.0_wp*(r2jk-r2ij)**2*(r2jk+r2ij)) / (rrr3*rrr2)
851857
dGr = (-dang*c9*fdmp + dfdmp*c9*ang)/r2ik
852858
dG(:, 1) = -dGr * rik + dG(:, 1)
853-
dG(:, 3) = +dGr * rik
854-
dS(:, :) = 0.5_wp * dGr * spread(rik, 1, 3) * spread(rik, 2, 3) + dS
859+
dG(:, 3) = +dGr * rik
860+
dS(:, 1) = 0.5_wp * dGr * rik(1) * rik + dS(:, 1)
861+
dS(:, 2) = 0.5_wp * dGr * rik(2) * rik + dS(:, 2)
862+
dS(:, 3) = 0.5_wp * dGr * rik(3) * rik + dS(:, 3)
855863

856864
! Derivative w.r.t. j-k distance
857865
dang=-0.375_wp*(r2jk**3+r2jk**2*(r2ik+r2ij) &
@@ -860,7 +868,9 @@ pure subroutine deriv_atm_triple(c6ij, c6ik, c6jk, cij, cjk, cik, &
860868
dGr = (-dang*c9*fdmp + dfdmp*c9*ang)/r2jk
861869
dG(:, 2) = -dGr * rjk + dG(:, 2)
862870
dG(:, 3) = +dGr * rjk + dG(:, 3)
863-
dS(:, :) = 0.5_wp * dGr * spread(rjk, 1, 3) * spread(rjk, 2, 3) + dS
871+
dS(:, 1) = 0.5_wp * dGr * rjk(1) * rjk + dS(:, 1)
872+
dS(:, 2) = 0.5_wp * dGr * rjk(2) * rjk + dS(:, 2)
873+
dS(:, 3) = 0.5_wp * dGr * rjk(3) * rjk + dS(:, 3)
864874

865875
! CN derivative
866876
dc9 = 0.5_wp*c9*(dc6ij/c6ij+dc6ik/c6ik)

‎src/disp/dftd4.F90‎

Lines changed: 22 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1428,7 +1428,9 @@ subroutine disp_gradient_neigh &
14281428

14291429
dE = -c6(iat, jat)*disp * 0.5_wp
14301430
dG = -c6(iat, jat)*ddisp*rij
1431-
dS = spread(dG, 1, 3) * spread(rij, 2, 3) * 0.5_wp
1431+
dS(:, 1) = 0.5_wp * dG(1) * rij
1432+
dS(:, 2) = 0.5_wp * dG(2) * rij
1433+
dS(:, 3) = 0.5_wp * dG(3) * rij
14321434

14331435
energies(iat) = energies(iat) + dE
14341436
dEdcn(iat) = dEdcn(iat) - dc6dcn(iat, jat) * disp
@@ -1906,7 +1908,9 @@ subroutine disp_gradient_latp &
19061908

19071909
dE = -c6(iat, jat)*disp * 0.5_wp
19081910
dG = -c6(iat, jat)*ddisp*rij
1909-
dS = spread(dG, 1, 3) * spread(rij, 2, 3) * 0.5_wp
1911+
dS(:, 1) = 0.5_wp * dG(1) * rij
1912+
dS(:, 2) = 0.5_wp * dG(2) * rij
1913+
dS(:, 3) = 0.5_wp * dG(3) * rij
19101914

19111915
energies(iat) = energies(iat) + dE
19121916
dEdcn(iat) = dEdcn(iat) - dc6dcn(iat, jat) * disp
@@ -2275,17 +2279,17 @@ subroutine atm_gradient_latp_gpu &
22752279
! & -5.0_wp*(r2jk-r2ik)**2*(r2jk+r2ik)) / (rrr3*rrr2)
22762280
!dGr = (-dang*c9*fdmp + dfdmp*c9*ang)/r2ij
22772281
!dG(:, 1) = -dGr * rij
2278-
!dG(:, 2) = +dGr * rij
2279-
!dS(:, :) = 0.5_wp * dGr * spread(rij, 1, 3) * spread(rij, 2, 3)
2282+
!dG(:, 2) = +dGr * rij
2283+
!dS(:, :) = 0.5_wp * dGr * spread(rij, 1, 3) * spread(rij, 2, 3) !< GCC perf: do not use spread
22802284

22812285
!! Derivative w.r.t. i-k distance
22822286
!dang = -0.375_wp*(r2ik**3+r2ik**2*(r2jk+r2ij) &
22832287
! & +r2ik*(3.0_wp*r2jk**2+2.0*r2jk*r2ij+3.0_wp*r2ij**2) &
22842288
! & -5.0_wp*(r2jk-r2ij)**2*(r2jk+r2ij)) / (rrr3*rrr2)
22852289
!dGr = (-dang*c9*fdmp + dfdmp*c9*ang)/r2ik
22862290
!dG(:, 1) = -dGr * rik + dG(:, 1)
2287-
!dG(:, 3) = +dGr * rik
2288-
!dS(:, :) = 0.5_wp * dGr * spread(rik, 1, 3) * spread(rik, 2, 3) + dS
2291+
!dG(:, 3) = +dGr * rik
2292+
!dS(:, :) = 0.5_wp * dGr * spread(rik, 1, 3) * spread(rik, 2, 3) + dS !< GCC perf: do not use spread
22892293

22902294
!! Derivative w.r.t. j-k distance
22912295
!dang=-0.375_wp*(r2jk**3+r2jk**2*(r2ik+r2ij) &
@@ -2294,7 +2298,7 @@ subroutine atm_gradient_latp_gpu &
22942298
!dGr = (-dang*c9*fdmp + dfdmp*c9*ang)/r2jk
22952299
!dG(:, 2) = -dGr * rjk + dG(:, 2)
22962300
!dG(:, 3) = +dGr * rjk + dG(:, 3)
2297-
!dS(:, :) = 0.5_wp * dGr * spread(rjk, 1, 3) * spread(rjk, 2, 3) + dS
2301+
!dS(:, :) = 0.5_wp * dGr * spread(rjk, 1, 3) * spread(rjk, 2, 3) + dS !< GCC perf: do not use spread
22982302

22992303
!! CN derivative
23002304
!dc9 = 0.5_wp*c9*(dc6dcn(iat,jat)/c6ij+dc6dcn(iat,kat)/c6ik)
@@ -2386,17 +2390,21 @@ pure subroutine deriv_atm_triple(c6ij, c6ik, c6jk, cij, cjk, cik, &
23862390
& -5.0_wp*(r2jk-r2ik)**2*(r2jk+r2ik)) / (rrr3*rrr2)
23872391
dGr = (-dang*c9*fdmp + dfdmp*c9*ang)/r2ij
23882392
dG(:, 1) = -dGr * rij
2389-
dG(:, 2) = +dGr * rij
2390-
dS(:, :) = 0.5_wp * dGr * spread(rij, 1, 3) * spread(rij, 2, 3)
2393+
dG(:, 2) = +dGr * rij
2394+
dS(:, 1) = 0.5_wp * dGr * rij(1) * rij
2395+
dS(:, 2) = 0.5_wp * dGr * rij(2) * rij
2396+
dS(:, 3) = 0.5_wp * dGr * rij(3) * rij
23912397

23922398
! Derivative w.r.t. i-k distance
23932399
dang = -0.375_wp*(r2ik**3+r2ik**2*(r2jk+r2ij) &
23942400
& +r2ik*(3.0_wp*r2jk**2+2.0*r2jk*r2ij+3.0_wp*r2ij**2) &
23952401
& -5.0_wp*(r2jk-r2ij)**2*(r2jk+r2ij)) / (rrr3*rrr2)
23962402
dGr = (-dang*c9*fdmp + dfdmp*c9*ang)/r2ik
23972403
dG(:, 1) = -dGr * rik + dG(:, 1)
2398-
dG(:, 3) = +dGr * rik
2399-
dS(:, :) = 0.5_wp * dGr * spread(rik, 1, 3) * spread(rik, 2, 3) + dS
2404+
dG(:, 3) = +dGr * rik
2405+
dS(:, 1) = 0.5_wp * dGr * rik(1) * rik + dS(:, 1)
2406+
dS(:, 2) = 0.5_wp * dGr * rik(2) * rik + dS(:, 2)
2407+
dS(:, 3) = 0.5_wp * dGr * rik(3) * rik + dS(:, 3)
24002408

24012409
! Derivative w.r.t. j-k distance
24022410
dang=-0.375_wp*(r2jk**3+r2jk**2*(r2ik+r2ij) &
@@ -2405,7 +2413,9 @@ pure subroutine deriv_atm_triple(c6ij, c6ik, c6jk, cij, cjk, cik, &
24052413
dGr = (-dang*c9*fdmp + dfdmp*c9*ang)/r2jk
24062414
dG(:, 2) = -dGr * rjk + dG(:, 2)
24072415
dG(:, 3) = +dGr * rjk + dG(:, 3)
2408-
dS(:, :) = 0.5_wp * dGr * spread(rjk, 1, 3) * spread(rjk, 2, 3) + dS
2416+
dS(:, 1) = 0.5_wp * dGr * rjk(1) * rjk + dS(:, 1)
2417+
dS(:, 2) = 0.5_wp * dGr * rjk(2) * rjk + dS(:, 2)
2418+
dS(:, 3) = 0.5_wp * dGr * rjk(3) * rjk + dS(:, 3)
24092419

24102420
! CN derivative
24112421
dc9 = 0.5_wp*c9*(dc6ij/c6ij+dc6ik/c6ik)

‎src/freq/project.f90‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -105,8 +105,10 @@ subroutine projectHessian(hessian, mol, removeTrans, removeRot)
105105
do iat = 1, mol%n
106106
vec(:) = mol%xyz(:, iat) - center
107107
r2 = vec(1)**2 + vec(2)**2 + vec(3)**2
108-
inertia(:, :) = inertia + mol%atmass(iat) &
109-
& * (unity*r2 - spread(vec, 1, 3)*spread(vec, 2, 3))
108+
inertia(:, :) = inertia + mol%atmass(iat) * unity * r2
109+
inertia(:, 1) = inertia(:, 1) - mol%atmass(iat) * vec(1) * vec
110+
inertia(:, 2) = inertia(:, 2) - mol%atmass(iat) * vec(2) * vec
111+
inertia(:, 3) = inertia(:, 3) - mol%atmass(iat) * vec(3) * vec
110112
end do
111113

112114
call eigvec3x3(inertia, moments, axes)

‎src/gfnff/gdisp0.f90‎

Lines changed: 26 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -325,7 +325,9 @@ subroutine d3_gradient(dispm, nat, at, xyz, npair, pairlist, zeta_scale, radii,
325325

326326
dE = -c6(iat, jat)*disp * 0.5_wp
327327
dG = -c6(iat, jat)*ddisp*rij
328-
dS = spread(dG, 1, 3) * spread(rij, 2, 3) * 0.5_wp
328+
dS(:, 1) = 0.5_wp * dG(1) * rij
329+
dS(:, 2) = 0.5_wp * dG(2) * rij
330+
dS(:, 3) = 0.5_wp * dG(3) * rij
329331

330332
energies(iat) = energies(iat) + dE
331333
dEdcn(iat) = dEdcn(iat) - dc6dcn(iat, jat) * disp
@@ -470,7 +472,9 @@ subroutine disp_gradient_latp &
470472

471473
dE = -c6(iat, jat)*disp * 0.5_wp
472474
dG = -c6(iat, jat)*ddisp*rij
473-
dS = spread(dG, 1, 3) * spread(rij, 2, 3) * 0.5_wp
475+
dS(:, 1) = 0.5_wp * dG(1) * rij
476+
dS(:, 2) = 0.5_wp * dG(2) * rij
477+
dS(:, 3) = 0.5_wp * dG(3) * rij
474478

475479
energies(iat) = energies(iat) + dE
476480
dEdcn(iat) = dEdcn(iat) - dc6dcn(iat, jat) * disp
@@ -555,7 +559,9 @@ subroutine disp_gradient_latp_inter &
555559

556560
dE = -c6(iat, jat)*disp * 0.5_wp
557561
dG = -c6(iat, jat)*ddisp*rij
558-
dS = spread(dG, 1, 3) * spread(rij, 2, 3) * 0.5_wp
562+
dS(:, 1) = 0.5_wp * dG(1) * rij
563+
dS(:, 2) = 0.5_wp * dG(2) * rij
564+
dS(:, 3) = 0.5_wp * dG(3) * rij
559565

560566
energies(iat) = energies(iat) + dE
561567
dEdcn(iat) = dEdcn(iat) - dc6dcn(iat, jat) * disp
@@ -640,7 +646,9 @@ subroutine disp_gradient_latp_intra &
640646

641647
dE = -c6(iat, jat)*disp * 0.5_wp
642648
dG = -c6(iat, jat)*ddisp*rij
643-
dS = spread(dG, 1, 3) * spread(rij, 2, 3) * 0.5_wp
649+
dS(:, 1) = 0.5_wp * dG(1) * rij
650+
dS(:, 2) = 0.5_wp * dG(2) * rij
651+
dS(:, 3) = 0.5_wp * dG(3) * rij
644652

645653
energies(iat) = energies(iat) + dE
646654
dEdcn(iat) = dEdcn(iat) - dc6dcn(iat, jat) * disp
@@ -974,7 +982,9 @@ subroutine disp_gradient_neigh &
974982

975983
dE = -c6(iat, jat)*disp * 0.5_wp
976984
dG = -c6(iat, jat)*ddisp*rij
977-
dS = spread(dG, 1, 3) * spread(rij, 2, 3) * 0.5_wp
985+
dS(:, 1) = 0.5_wp * dG(1) * rij
986+
dS(:, 2) = 0.5_wp * dG(2) * rij
987+
dS(:, 3) = 0.5_wp * dG(3) * rij
978988

979989
energies(iat) = energies(iat) + dE
980990
dEdcn(iat) = dEdcn(iat) - dc6dcn(iat, jat) * disp
@@ -1167,17 +1177,21 @@ pure subroutine deriv_atm_triple(c6ij, c6ik, c6jk, cij, cjk, cik, &
11671177
& -5.0_wp*(r2jk-r2ik)**2*(r2jk+r2ik)) / (rrr3*rrr2)
11681178
dGr = (-dang*c9*fdmp + dfdmp*c9*ang)/r2ij
11691179
dG(:, 1) = -dGr * rij
1170-
dG(:, 2) = +dGr * rij
1171-
dS(:, :) = 0.5_wp * dGr * spread(rij, 1, 3) * spread(rij, 2, 3)
1180+
dG(:, 2) = +dGr * rij
1181+
dS(:, 1) = 0.5_wp * dGr * rij(1) * rij
1182+
dS(:, 2) = 0.5_wp * dGr * rij(2) * rij
1183+
dS(:, 3) = 0.5_wp * dGr * rij(3) * rij
11721184

11731185
! Derivative w.r.t. i-k distance
11741186
dang = -0.375_wp*(r2ik**3+r2ik**2*(r2jk+r2ij) &
11751187
& +r2ik*(3.0_wp*r2jk**2+2.0*r2jk*r2ij+3.0_wp*r2ij**2) &
11761188
& -5.0_wp*(r2jk-r2ij)**2*(r2jk+r2ij)) / (rrr3*rrr2)
11771189
dGr = (-dang*c9*fdmp + dfdmp*c9*ang)/r2ik
11781190
dG(:, 1) = -dGr * rik + dG(:, 1)
1179-
dG(:, 3) = +dGr * rik
1180-
dS(:, :) = 0.5_wp * dGr * spread(rik, 1, 3) * spread(rik, 2, 3) + dS
1191+
dG(:, 3) = +dGr * rik
1192+
dS(:, 1) = 0.5_wp * dGr * rik(1) * rik + dS(:, 1)
1193+
dS(:, 2) = 0.5_wp * dGr * rik(2) * rik + dS(:, 2)
1194+
dS(:, 3) = 0.5_wp * dGr * rik(3) * rik + dS(:, 3)
11811195

11821196
! Derivative w.r.t. j-k distance
11831197
dang=-0.375_wp*(r2jk**3+r2jk**2*(r2ik+r2ij) &
@@ -1186,7 +1200,9 @@ pure subroutine deriv_atm_triple(c6ij, c6ik, c6jk, cij, cjk, cik, &
11861200
dGr = (-dang*c9*fdmp + dfdmp*c9*ang)/r2jk
11871201
dG(:, 2) = -dGr * rjk + dG(:, 2)
11881202
dG(:, 3) = +dGr * rjk + dG(:, 3)
1189-
dS(:, :) = 0.5_wp * dGr * spread(rjk, 1, 3) * spread(rjk, 2, 3) + dS
1203+
dS(:, 1) = 0.5_wp * dGr * rjk(1) * rjk + dS(:, 1)
1204+
dS(:, 2) = 0.5_wp * dGr * rjk(2) * rjk + dS(:, 2)
1205+
dS(:, 3) = 0.5_wp * dGr * rjk(3) * rjk + dS(:, 3)
11901206

11911207
! CN derivative
11921208
dc9 = 0.5_wp*c9*(dc6ij/c6ij+dc6ik/c6ik)

0 commit comments

Comments
 (0)