CI probe: multi-lane device-versus-host check of every EOS helper

Author: sbryngelson

src/simulation/m_start_up.fpp

@@ -1034,7 +1034,13 @@ contains
     !> Transfer initial conservative variable and model parameter data to the GPU device
     subroutine s_initialize_gpu_vars
 
-        integer :: i
+        integer                               :: i, n, kk
+        integer, parameter                    :: np = 100000
+        real(wp), allocatable, dimension(:)   :: pin
+        real(wp), allocatable, dimension(:,:) :: pout
+        real(wp), dimension(6)                :: href
+        integer, dimension(6)                 :: nbad, nfirst
+        real(wp)                              :: rho, gamma, pi_inf, dpi, dgamma, tmp
 
         if (.not. down_sample) then
             do i = 1, sys_size
@@ -1101,6 +1107,54 @@ contains
             $:GPU_UPDATE(device='[igr, nb, igr_order]')
         #:endif
 
+        ! CI probe: every EOS helper over many lanes with per-lane inputs, device against host.
+        @:ALLOCATE(pin(1:np), pout(1:np, 1:6))
+        do n = 1, np
+            pin(n) = 1._wp + 1.e-3_wp*n
+        end do
+        $:GPU_UPDATE(device='[pin]')
+        $:GPU_PARALLEL_LOOP(private='[n, rho, gamma, pi_inf, dpi, dgamma, tmp]')
+        do n = 1, np
+            pout(n, 1) = f_bulk_modulus(pin(n), gammas(1), pi_infs(1))
+            call s_phase_coefficients(0.5_wp*pin(n), 0.5_wp, 1, rho, gamma, pi_inf, dpi, dgamma)
+            pout(n, 2) = gamma*pin(n) + pi_inf + rho
+            call s_phase_bulk_modulus(pin(n), 0.5_wp, 0.5_wp*pin(n), 1, pout(n, 3))
+            call s_phase_bulk_modulus(pin(n), 0.5_wp, 0.5_wp*pin(n), 1, tmp)
+            pout(n, 4) = tmp
+            call s_phase_internal_energy(pin(n), 0.5_wp, 0.5_wp*pin(n), 1, tmp)
+            pout(n, 5) = tmp
+            call s_eos_coefficients(pin(n), 1, gamma, pi_inf, dpi, dgamma)
+            pout(n, 6) = gamma*pin(n) + pi_inf + dpi + dgamma
+        end do
+        $:END_GPU_PARALLEL_LOOP()
+        $:GPU_UPDATE(host='[pout]')
+        nbad = 0
+        nfirst = 0
+        do n = 1, np
+            href(1) = f_bulk_modulus(pin(n), gammas(1), pi_infs(1))
+            call s_phase_coefficients(0.5_wp*pin(n), 0.5_wp, 1, rho, gamma, pi_inf, dpi, dgamma)
+            href(2) = gamma*pin(n) + pi_inf + rho
+            call s_phase_bulk_modulus(pin(n), 0.5_wp, 0.5_wp*pin(n), 1, href(3))
+            href(4) = href(3)
+            call s_phase_internal_energy(pin(n), 0.5_wp, 0.5_wp*pin(n), 1, href(5))
+            call s_eos_coefficients(pin(n), 1, gamma, pi_inf, dpi, dgamma)
+            href(6) = gamma*pin(n) + pi_inf + dpi + dgamma
+            do kk = 1, 6
+                if (.not. abs(pout(n, kk) - href(kk)) <= 1.e-12_wp*abs(href(kk))) then
+                    nbad(kk) = nbad(kk) + 1
+                    if (nfirst(kk) == 0) nfirst(kk) = n
+                end if
+            end do
+        end do
+        if (proc_rank == 0) then
+            print '(A, 6I8)', ' eos probe mismatches per kernel (of 100000): ', nbad
+            do kk = 1, 6
+                if (nfirst(kk) > 0) print '(A, I2, A, I7, 2ES24.15)', ' eos probe kernel ', kk, ' first bad lane ', nfirst(kk), &
+                    & pout(nfirst(kk), kk), href(kk)
+            end do
+        end if
+        @:DEALLOCATE(pin, pout)
+
     end subroutine s_initialize_gpu_vars
 
     !> Finalize and deallocate all simulation sub-modules in reverse initialization order