{"slug": "soft-lauching-terco-a-do-concurrent-driven-gpu-accelerated-quantum-chemistry", "title": "Soft lauching Terco a `do concurrent` driven, GPU accelerated quantum chemistry library/package", "summary": "JorgeG94 released terco, an open-source Fortran quantum chemistry library that uses `do concurrent` and the nvfortran 26.9 compiler to compute electron repulsion integrals on Nvidia GPUs, reporting roughly 10x speedup over a prior Fortran standard-parallelism implementation in GAMESS and performance compared against the CUDA C++-based gpu4pyscf. The package collapses the recursive ERI evaluation into fully unrolled, auto-generated routines that can run about 20,000 lines long, with the Boys function base case solved via Chebyshev interpolation in 14 FLOPs, and all GPU optimizations such as shared memory use and launch bounds left to the compiler. The author said the next steps are compiling terco with LFortran and targeting Apple, AMD and Intel GPUs.", "body_md": "If you speak Spanish you know that “terco” means “stubborn”. This package was born out of my delirious dreams of \"I am sure we can get close to cuda performance if we use `do concurrent` and abuse the nvidia Fortran compilers. This is what [terco](https://github.com/JorgeG94/terco) does! I’ve already stolen the “powered by Fortran” image, thanks [@fxm](https://fortran-lang.discourse.group/u/fxm)\n\nIn Molecular Quantum Chemistry everything goes down into evaluating these things called “electron repulsion integrals” or ERIs. They are BLOODY AWFUL. There are O(N^4) of them and they are needed for almost everything. They are 6D integrals over a Coulomb operator and they get more difficult with increasing angular momentum, remember your `s`, `p`, `d` from high school chemistry. These integrals have basis functions which have x, y, and z coordinates. They are of the form `(\\mu \\nu | \\lambda \\sigma)` and they are solved recursively, with the base case of the recursion being usually the evaluation of an integral called the Boys function, which has been shown that the best way to solve it is via Chebyshev interpolation since you can do it in 14 FLOPs.\n\nOn the GPU, the best way to do this is to collapse these recursions into full unrolled loops, therefore, certain functions can be around ~20k lines long!\n\nThe best performing codes out in the literature all use CUDA C++, some efforts were done previously exploiting OpenMP and Do Concurrent from native Fortran:\n\nHowever, none of these implementations were able to get comparable performance to CUDA written applications at scale - and these papers admit that. So, is CUDA like performance unreachable to standard Fortran for qc applications?\n\n**No.**\n\nThe main issue facing previous implementations was feeding the GPU with enough work! By using some batching schemes and shenanigans, I am able to beat the implementation found in [here](https://pubs.acs.org/jctcce/article-abstract/19/13/3798/400989/Enabling-Fortran-Standard-Parallelism-in-GAMESS?redirectedFrom=fulltext) (by a former colleague of mine) by around 10x! wooo\n\nAttached is a figure of the comparison of terco using `do concurrent` against `gpu4pyscf` which is a state of the art GPU accelerated code written in CUDA C++ and python as orchestrator.\n\nAll optimizations done in the Fortran side are algorithmic - shared memory utilization, launch bounds, etc. are all the compiler. Using nvfortran 26.9.\n\nNext step is to cause [@certik](https://fortran-lang.discourse.group/u/certik) nightmares and get this code compiled with LFortran, maybe use some Apple GPUs  Then getting this to run on AMD and Intel. Nightmares ahead!\n\nThe code is heavily validated but bugs might be present if you do some weird chemistry.\n\nExample:\n\n```\n      do concurrent(i=1:nr)\n         call pcsi1010(g0 + (i - 1)*nranks, lo, hi, nseg, sOff, sA, sNB, sOA, sOB, sPA, sPB, sD, &\n                       npair, sp_i, sp_j, sp_q, thresh, pcut, jfac, kfac, omega, dsh, nbas, nao, sh_l, ao_off, &\n                       nqp, qp_z, qp_c, qp_px, qp_py, qp_pz, &\n                       sq_ax, sq_ay, sq_az, sq_abx, sq_aby, sq_abz, sq_n, ndens, dmat, jmat)\n      end do\n```\n\nand the function is: (the code is auto-generated via a python script)\n\n```\n  pure subroutine pcsi1010(gt, lo, hi, nseg, sOff, sA, sNB, sOA, sOB, sPA, sPB, sD, &\n                      npair, sp_i, sp_j, sp_q, thresh, pcut, jfac, kfac, omega, dsh, nbas, nao, sh_l, ao_off, &\n                      nqp, qp_z, qp_c, qp_px, qp_py, qp_pz, &\n                      sq_ax, sq_ay, sq_az, sq_abx, sq_aby, sq_abz, sq_n, &\n                      ndens, dmat, jmat)\n      !$acc routine seq\n      integer(int64), intent(in) :: gt\n      integer,  intent(in)    :: lo, hi, nseg, npair, nbas, nao\n      integer(int64), intent(in) :: sOff(nseg + 1)\n      integer,  intent(in)    :: sA(nseg), sNB(nseg), sOA(nseg), sOB(nseg)\n      integer,  intent(in)    :: sPA(nseg), sPB(nseg)\n\n      logical,  intent(in)    :: sD(nseg)\n      integer,  intent(in)    :: sp_i(npair), sp_j(npair)\n      real(dp), intent(in)    :: sp_q(npair), thresh\n      real(dp), intent(in)    :: pcut\n\n      real(dp), intent(in)    :: jfac, kfac\n\n      real(dp), intent(in)    :: omega\n\n      real(dp), intent(in)    :: dsh(nbas, nbas)\n      integer,  intent(in)    :: sh_l(nbas), ao_off(nbas)\n      integer,  intent(in)    :: nqp\n\n      real(dp), intent(in)    :: qp_z(nqp), qp_c(nqp)\n      real(dp), intent(in)    :: qp_px(nqp), qp_py(nqp), qp_pz(nqp)\n      real(dp), intent(in)    :: sq_ax(npair), sq_ay(npair), sq_az(npair)\n\n      real(dp), intent(in)    :: sq_abx(npair), sq_aby(npair), sq_abz(npair)\n      integer,  intent(in)    :: sq_n(npair)\n      integer,  intent(in)    :: ndens\n      real(dp), intent(in)    :: dmat(ndens, nao, nao)\n      real(dp), intent(inout) :: jmat(ndens, nao, nao)\n      integer :: p, q, mid, seg, t, iab, icd, si, sj, sk, sl\n      integer(int64) :: nsa, u, kx\n      real(dp) :: qcut, bnd\n      integer :: slotab, slotcd, nab, ncd\n      integer :: kp, kq, k1, k2\n      integer :: d, x, cur, ia, ib, ic, id, idx, idens\n      integer :: mu, nu, lam, sig, mui, nuj, lamk, sigl\n      logical :: dij, dkl, dpq\n      real(dp) :: zeta, eta, zpe, rho, tval, pref, wc\n      real(dp) :: theta, rho_theta\n      real(dp) :: pqx, pqy, pqz, pax, pay, paz, qcx, qcy, qcz\n      real(dp) :: wpx, wpy, wpz, wqx, wqy, wqz\n      real(dp) :: oo2z, oo2e, oo2ze, rz, re, sc, vv\n      real(dp) :: abx, aby, abz, cdx, cdy, cdz\n      real(dp) :: rpx, rpy, rpz, rzeta, reta, rzpe\n      real(dp) :: f(0:BOYS_MMAX)\n      integer  :: bi, bj, bbase\n      real(dp) :: bx, bx2, b0, b1, b2, btt, bet\n      real(dp) :: v(16, 0:1), g1(16), vbuf(9)\n      real(dp) :: wq, w, wab, cabmax, ccdmax, qchunk\n      logical  :: same_ab, same_cd, same_pair\n      real(dp) :: jab(3), jcd(3), kac(9)\n      real(dp) :: kad(3), kbc(3), kbd(1)\n      real(dp) :: dab(3), dcd(3), dac(9)\n      real(dp) :: dad(3), dbc(3), dbd(1)\n\n      ! locate the segment\n         p = lo; q = hi\n         do while (p < q)\n            mid = (p + q + 1)/2\n            if (sOff(mid) < gt) then\n               p = mid\n            else\n               q = mid - 1\n            end if\n         end do\n         seg = p\n         t = int(gt - sOff(seg))\n\n         if (sD(seg)) then\n            nsa = int(sA(seg), int64)\n            u = int(t - 1, int64)\n            kx = int((real(2*nsa + 1, dp) - sqrt(real(2*nsa + 1, dp)**2 - 8.0_dp*real(u, dp)))/2.0_dp, int64)\n            if (kx < 0) kx = 0\n            do while (kx > 0)\n               if ((kx*(2*nsa + 1) - kx*kx)/2 <= u) exit\n               kx = kx - 1\n            end do\n            do while (((kx + 1)*(2*nsa + 1) - (kx + 1)*(kx + 1))/2 <= u)\n               kx = kx + 1\n            end do\n            icd = int(kx) + 1\n            iab = icd + int(u - (kx*(2*nsa + 1) - kx*kx)/2)\n         else\n            icd = (t - 1)/sA(seg) + 1\n            iab = t - (icd - 1)*sA(seg)\n         end if\n\n         qcut = sp_q(sOA(seg) + iab)*sp_q(sOB(seg) + icd)\n         if (qcut <= thresh) return\n\n         si = sp_i(sOA(seg) + iab); sj = sp_j(sOA(seg) + iab)\n         sk = sp_i(sOB(seg) + icd); sl = sp_j(sOB(seg) + icd)\n\n         if (qcut*max(4.0_dp*dsh(si, sj), 4.0_dp*dsh(sk, sl), &\n                      dsh(si, sk), dsh(si, sl), &\n                      dsh(sj, sk), dsh(sj, sl)) <= thresh) return\n\n         same_ab = (si == sj); same_cd = (sk == sl)\n         same_pair = sD(seg) .and. (iab == icd)\n\n         slotab = sOA(seg) + iab; slotcd = sOB(seg) + icd\n         nab = sq_n(slotab); ncd = sq_n(slotcd)\n\n         abx = sq_abx(slotab); aby = sq_aby(slotab); abz = sq_abz(slotab)\n         cdx = sq_abx(slotcd); cdy = sq_aby(slotcd); cdz = sq_abz(slotcd)\n\n            do x = 1, 16\n               g1(x) = 0.0_dp\n            end do\n            do k1 = 1, nab\n               kp = sPA(seg) + (k1 - 1)*sA(seg) + iab\n               zeta = qp_z(kp)\n               bnd = TWO_PI_2_5*abs(qp_c(kp))/(zeta*sqrt(zeta))\n               if (bnd*abs(qp_c(sPB(seg) + icd))/qp_z(sPB(seg) + icd) <= pcut) cycle\n\n               rpx = qp_px(kp); rpy = qp_py(kp); rpz = qp_pz(kp)\n               pax = rpx - sq_ax(slotab)\n               pay = rpy - sq_ay(slotab)\n               paz = rpz - sq_az(slotab)\n\n               rzeta = 1.0_dp/zeta\n               oo2z = 0.5_dp*rzeta\n               do k2 = 1, ncd\n                  kq = sPB(seg) + (k2 - 1)*sNB(seg) + icd\n                  eta = qp_z(kq)\n                  zpe = zeta + eta\n                  pref = TWO_PI_2_5/(zeta*eta*sqrt(zpe))*qp_c(kp)*qp_c(kq)\n                  if (bnd*abs(qp_c(kq))/eta <= pcut) exit\n                  if (abs(pref) <= pcut) cycle\n \n                  reta = 1.0_dp/eta\n                  rzpe = 1.0_dp/zpe\n                  rho = zeta*eta*rzpe\n\n                  if (omega > 0.0_dp) then\n                     theta = omega*omega/(rho + omega*omega)\n                  else\n                     theta = 1.0_dp\n                  end if\n                  rho_theta = theta*rho\n                  pqx = rpx - qp_px(kq)\n                  pqy = rpy - qp_py(kq)\n                  pqz = rpz - qp_pz(kq)\n                  qcx = qp_px(kq) - sq_ax(slotcd)\n                  qcy = qp_py(kq) - sq_ay(slotcd)\n                  qcz = qp_pz(kq) - sq_az(slotcd)\n                  wc = (zeta*rpx + eta*qp_px(kq))*rzpe\n                  wpx = wc - qp_px(kp); wqx = wc - qp_px(kq)\n                  wc = (zeta*rpy + eta*qp_py(kq))*rzpe\n                  wpy = wc - qp_py(kp); wqy = wc - qp_py(kq)\n                  wc = (zeta*rpz + eta*qp_pz(kq))*rzpe\n                  wpz = wc - qp_pz(kp); wqz = wc - qp_pz(kq)\n                  wpx = theta*wpx; wpy = theta*wpy; wpz = theta*wpz\n                  wqx = theta*wqx; wqy = theta*wqy; wqz = theta*wqz\n                  tval = rho_theta*(pqx*pqx + pqy*pqy + pqz*pqz)\n\n                  if (tval >= BOYS_TMAX) then\n                  btt = 1.0_dp/tval\n                  f(0) = 0.88622692545275801365_dp*sqrt(btt)\n                  bet = 0.0_dp\n                  f(1) = 1.0_dp*f(0)*(0.5_dp*btt)\n                  f(2) = 3.0_dp*f(1)*(0.5_dp*btt)\n               else\n                  bi = int(tval*BOYS_DTINV)\n                  bi = min(bi, BOYS_NGRID - 1)\n                  bx = 2.0_dp*(tval - real(bi, dp)*BOYS_DT)*BOYS_DTINV - 1.0_dp\n                  bx2 = 2.0_dp*bx\n                  bbase = bi*(BOYS_MMAX + 1)*(BOYS_NCHEB + 1)\n                  bj = bbase + 2*(BOYS_NCHEB + 1)\n                  b1 = boys_table(bj + BOYS_NCHEB + 1)\n                  b2 = 0.0_dp\n                  b0 = bx2*b1 - b2 + boys_table(bj + 5); b2 = b1; b1 = b0\n                  b0 = bx2*b1 - b2 + boys_table(bj + 4); b2 = b1; b1 = b0\n                  b0 = bx2*b1 - b2 + boys_table(bj + 3); b2 = b1; b1 = b0\n                  b0 = bx2*b1 - b2 + boys_table(bj + 2); b2 = b1; b1 = b0\n                  f(2) = bx*b1 - b2 + boys_table(bj + 1)\n                  bet = exp(-tval)\n                  btt = 2.0_dp*tval\n                  f(1) = (btt*f(2) + bet)*(0.3333333333333333_dp)\n                  f(0) = (btt*f(1) + bet)*(1.0_dp)\n               end if\n\n                  pref = pref*sqrt(theta)\n                  oo2e = 0.5_dp*reta; oo2ze = theta*(0.5_dp*rzpe)\n                  rz = rho_theta*rzeta; re = rho_theta*reta\n\n               ! --- level m = 2 ---\n            v(1,0) = pref*f(2)\n            ! --- level m = 1 ---\n            v(1,1) = pref*f(1)\n            v(2,1) = pax*v(1,1) + wpx*v(1,0)\n            v(3,1) = pay*v(1,1) + wpy*v(1,0)\n            v(4,1) = paz*v(1,1) + wpz*v(1,0)\n            ! --- level m = 0 ---\n            v(1,0) = pref*f(0)\n            v(2,0) = pax*v(1,0) + wpx*v(1,1)\n            v(3,0) = pay*v(1,0) + wpy*v(1,1)\n            v(4,0) = paz*v(1,0) + wpz*v(1,1)\n            v(6,0) = qcx*v(2,0) + wqx*v(2,1) &\n               + 1.0_dp*oo2ze*v(1,1)\n            v(7,0) = qcx*v(3,0) + wqx*v(3,1)\n            v(8,0) = qcx*v(4,0) + wqx*v(4,1)\n            v(10,0) = qcy*v(2,0) + wqy*v(2,1)\n            v(11,0) = qcy*v(3,0) + wqy*v(3,1) &\n               + 1.0_dp*oo2ze*v(1,1)\n            v(12,0) = qcy*v(4,0) + wqy*v(4,1)\n            v(14,0) = qcz*v(2,0) + wqz*v(2,1)\n            v(15,0) = qcz*v(3,0) + wqz*v(3,1)\n            v(16,0) = qcz*v(4,0) + wqz*v(4,1) &\n               + 1.0_dp*oo2ze*v(1,1)\n               cur = 0\n                  do x = 1, 16\n                     g1(x) = g1(x) + v(x, cur)\n                  end do\n               end do\n            end do\n         ! Single column on every side: the canonical enumeration and the\n         ! degeneracy weights are the pair-level ones.\n         dij = .not. same_ab\n         dkl = .not. same_cd\n         dpq = .not. same_pair\n         mui = ao_off(si); nuj = ao_off(sj); lamk = ao_off(sk); sigl = ao_off(sl)\n\n         ! --- HRR ---\n         vbuf(1) = g1(6)\n         vbuf(2) = g1(7)\n         vbuf(3) = g1(8)\n         vbuf(4) = g1(10)\n         vbuf(5) = g1(11)\n         vbuf(6) = g1(12)\n         vbuf(7) = g1(14)\n         vbuf(8) = g1(15)\n         vbuf(9) = g1(16)\n\n         wq = 1.0_dp\n         if (.not. dij) wq = wq*0.5_dp\n         if (.not. dkl) wq = wq*0.5_dp\n         if (.not. dpq) wq = wq*0.5_dp\n\n         !\n         if (kfac == 0.0_dp) then\n         do idens = 1, ndens\n\n         ib = 0\n            do ia = 0, 2\n               dab(1 + ia + 3*ib) = dmat(idens, mui + ia, nuj + ib)\n               jab(1 + ia + 3*ib) = 0.0_dp\n            end do\n         id = 0\n            do ic = 0, 2\n               dcd(1 + ic + 3*id) = dmat(idens, lamk + ic, sigl + id)\n               jcd(1 + ic + 3*id) = 0.0_dp\n            end do\n\n         id = 0\n         do ic = 0, 2\n         ib = 0\n         do ia = 0, 2\n            jab(1 + ia + 3*ib) = jab(1 + ia + 3*ib) &\n                                    + 4.0_dp*jfac*(wq*vbuf(1 + ia + 3*ib + 3*ic + 9*id)) &\n                                    *dcd(1 + ic + 3*id)\n            jcd(1 + ic + 3*id) = jcd(1 + ic + 3*id) &\n                                    + 4.0_dp*jfac*(wq*vbuf(1 + ia + 3*ib + 3*ic + 9*id)) &\n                                    *dab(1 + ia + 3*ib)\n         end do\n         end do\n\n         ib = 0\n            do ia = 0, 2\n               !$acc atomic update\n               jmat(idens, mui + ia, nuj + ib) = jmat(idens, mui + ia, nuj + ib) &\n                                          + jab(1 + ia + 3*ib)\n            end do\n         id = 0\n            do ic = 0, 2\n               !$acc atomic update\n               jmat(idens, lamk + ic, sigl + id) = jmat(idens, lamk + ic, sigl + id) &\n                                            + jcd(1 + ic + 3*id)\n            end do\n\n         end do   ! idens\n         else\n\n         do idens = 1, ndens\n\n         do ib = 0, 0\n            do ia = 0, 2\n               dab(1 + ia + 3*ib) = dmat(idens, mui + ia, nuj + ib)\n               jab(1 + ia + 3*ib) = 0.0_dp\n            end do\n         end do\n         do id = 0, 0\n            do ic = 0, 2\n               dcd(1 + ic + 3*id) = dmat(idens, lamk + ic, sigl + id)\n               jcd(1 + ic + 3*id) = 0.0_dp\n            end do\n         end do\n         do ic = 0, 2\n            do ia = 0, 2\n               dac(1 + ia + 3*ic) = dmat(idens, mui + ia, lamk + ic)\n               kac(1 + ia + 3*ic) = 0.0_dp\n            end do\n         end do\n         do id = 0, 0\n            do ia = 0, 2\n               dad(1 + ia + 3*id) = dmat(idens, mui + ia, sigl + id)\n               kad(1 + ia + 3*id) = 0.0_dp\n            end do\n         end do\n         do ic = 0, 2\n            do ib = 0, 0\n               dbc(1 + ib + 1*ic) = dmat(idens, nuj + ib, lamk + ic)\n               kbc(1 + ib + 1*ic) = 0.0_dp\n            end do\n         end do\n         do id = 0, 0\n            do ib = 0, 0\n               dbd(1 + ib + 1*id) = dmat(idens, nuj + ib, sigl + id)\n               kbd(1 + ib + 1*id) = 0.0_dp\n            end do\n         end do\n\n         idx = 0\n         do id = 0, 0\n         do ic = 0, 2\n         do ib = 0, 0\n         do ia = 0, 2\n            idx = idx + 1\n            sc = wq*vbuf(idx)\n            jab(1 + ia + 3*ib) = jab(1 + ia + 3*ib) &\n                                    + 4.0_dp*jfac*sc*dcd(1 + ic + 3*id)\n            jcd(1 + ic + 3*id) = jcd(1 + ic + 3*id) &\n                                    + 4.0_dp*jfac*sc*dab(1 + ia + 3*ib)\n            kac(1 + ia + 3*ic) = kac(1 + ia + 3*ic) &\n                                    - kfac*sc*dbd(1 + ib + 1*id)\n            kad(1 + ia + 3*id) = kad(1 + ia + 3*id) &\n                                    - kfac*sc*dbc(1 + ib + 1*ic)\n            kbc(1 + ib + 1*ic) = kbc(1 + ib + 1*ic) &\n                                    - kfac*sc*dad(1 + ia + 3*id)\n            kbd(1 + ib + 1*id) = kbd(1 + ib + 1*id) &\n                                    - kfac*sc*dac(1 + ia + 3*ic)\n         end do\n         end do\n         end do\n         end do\n\n         do ib = 0, 0\n            do ia = 0, 2\n               !$acc atomic update\n               jmat(idens, mui + ia, nuj + ib) = jmat(idens, mui + ia, nuj + ib) &\n                                          + jab(1 + ia + 3*ib)\n            end do\n         end do\n         do id = 0, 0\n            do ic = 0, 2\n               !$acc atomic update\n               jmat(idens, lamk + ic, sigl + id) = jmat(idens, lamk + ic, sigl + id) &\n                                            + jcd(1 + ic + 3*id)\n            end do\n         end do\n         do ic = 0, 2\n            do ia = 0, 2\n               !$acc atomic update\n               jmat(idens, mui + ia, lamk + ic) = jmat(idens, mui + ia, lamk + ic) &\n                                           + kac(1 + ia + 3*ic)\n            end do\n         end do\n         do id = 0, 0\n            do ia = 0, 2\n               !$acc atomic update\n               jmat(idens, mui + ia, sigl + id) = jmat(idens, mui + ia, sigl + id) &\n                                           + kad(1 + ia + 3*id)\n            end do\n         end do\n         do ic = 0, 2\n            do ib = 0, 0\n               !$acc atomic update\n               jmat(idens, nuj + ib, lamk + ic) = jmat(idens, nuj + ib, lamk + ic) &\n                                           + kbc(1 + ib + 1*ic)\n            end do\n         end do\n         do id = 0, 0\n            do ib = 0, 0\n               !$acc atomic update\n               jmat(idens, nuj + ib, sigl + id) = jmat(idens, nuj + ib, sigl + id) &\n                                           + kbd(1 + ib + 1*id)\n            end do\n         end do\n\n         end do   ! idens\n         end if\n   end subroutine pcsi1010\n```\n\nMy next post will be about the ocean, very different!", "url": "https://wpnews.pro/news/soft-lauching-terco-a-do-concurrent-driven-gpu-accelerated-quantum-chemistry", "canonical_source": "https://fortran-lang.discourse.group/t/soft-lauching-terco-a-do-concurrent-driven-gpu-accelerated-quantum-chemistry-library-package/11190#post_1", "published_at": "2026-10-22 12:40:44+00:00", "updated_at": "2026-10-22 12:42:22.588284+00:00", "lang": "en", "topics": ["ai-research", "developer-tools", "ai-infrastructure"], "entities": ["terco", "JorgeG94", "nvfortran", "gpu4pyscf", "GAMESS", "LFortran", "Nvidia", "Fortran"], "also_reported_by": [], "alternates": {"html": "https://wpnews.pro/news/soft-lauching-terco-a-do-concurrent-driven-gpu-accelerated-quantum-chemistry", "markdown": "https://wpnews.pro/news/soft-lauching-terco-a-do-concurrent-driven-gpu-accelerated-quantum-chemistry.md", "text": "https://wpnews.pro/news/soft-lauching-terco-a-do-concurrent-driven-gpu-accelerated-quantum-chemistry.txt", "jsonld": "https://wpnews.pro/news/soft-lauching-terco-a-do-concurrent-driven-gpu-accelerated-quantum-chemistry.jsonld"}}