From 2e6df70e03303cc59e7b6d5e423105c2183e9068 Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Tue, 13 Aug 2024 12:19:30 +0200 Subject: [PATCH] cleaning in cpu vs gpu comparison --- .../local/tc_int/compute_int_2e_ao_cpu.irp.f | 233 ++++++++ .../local/tc_int/compute_int_2e_ao_gpu.irp.f | 117 ++++ plugins/local/tc_int/compute_no_cpu.irp.f | 143 +++++ ...b_no_0e_gpu.irp.f => compute_no_gpu.irp.f} | 82 ++- plugins/local/tc_int/cutc_module.F90 | 149 ------ plugins/local/tc_int/deb_int_2e_ao_gpu.irp.f | 49 +- plugins/local/tc_int/deb_no_1e_gpu.irp.f | 499 ------------------ plugins/local/tc_int/deb_no_2e_gpu.irp.f | 417 --------------- plugins/local/tc_int/deb_no_gpu.irp.f | 50 +- plugins/local/tc_int/deb_tc_int_cuda.irp.f | 55 -- 10 files changed, 640 insertions(+), 1154 deletions(-) create mode 100644 plugins/local/tc_int/compute_int_2e_ao_cpu.irp.f create mode 100644 plugins/local/tc_int/compute_int_2e_ao_gpu.irp.f create mode 100644 plugins/local/tc_int/compute_no_cpu.irp.f rename plugins/local/tc_int/{deb_no_0e_gpu.irp.f => compute_no_gpu.irp.f} (52%) delete mode 100644 plugins/local/tc_int/deb_no_1e_gpu.irp.f delete mode 100644 plugins/local/tc_int/deb_no_2e_gpu.irp.f delete mode 100644 plugins/local/tc_int/deb_tc_int_cuda.irp.f diff --git a/plugins/local/tc_int/compute_int_2e_ao_cpu.irp.f b/plugins/local/tc_int/compute_int_2e_ao_cpu.irp.f new file mode 100644 index 00000000..9ff5431d --- /dev/null +++ b/plugins/local/tc_int/compute_int_2e_ao_cpu.irp.f @@ -0,0 +1,233 @@ + +! --- + +program compute_int_2e_ao_cpu + + implicit none + + print *, ' j2e_type = ', j2e_type + print *, ' j1e_type = ', j1e_type + print *, ' env_type = ', env_type + + my_grid_becke = .True. + PROVIDE tc_grid1_a tc_grid1_r + my_n_pt_r_grid = tc_grid1_r + my_n_pt_a_grid = tc_grid1_a + touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid + + my_extra_grid_becke = .True. + PROVIDE tc_grid2_a tc_grid2_r + my_n_pt_r_extra_grid = tc_grid2_r + my_n_pt_a_extra_grid = tc_grid2_a + touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid + + call write_int(6, my_n_pt_r_grid, 'radial external grid over') + call write_int(6, my_n_pt_a_grid, 'angular external grid over') + + call write_int(6, my_n_pt_r_extra_grid, 'radial internal grid over') + call write_int(6, my_n_pt_a_extra_grid, 'angular internal grid over') + + call main() + +end + +! --- + +subroutine main() + + use cutc_module + + implicit none + + integer :: m + integer :: i, j, k, l + integer :: ipoint, jpoint + + double precision :: weight1, ao_i_r, ao_k_r + + double precision :: time0, time1 + double precision :: wall_time0, wall_time1 + double precision :: wall_ttime0, wall_ttime1 + double precision :: tt1, tt2 + + double precision, allocatable :: rn(:,:), aos_data1(:,:,:), aos_data2(:,:,:) + double precision, allocatable :: grad1_u12(:,:,:), int_fct_long_range(:,:,:), c_mat(:,:,:) + double precision, allocatable :: int2_grad1_u12_ao(:,:,:,:) + double precision, allocatable :: int_2e_ao(:,:,:,:) + + + call wall_time(time0) + print*, ' start compute_int_2e_ao_cpu' + + + ! --- + + allocate(rn(3,nucl_num)) + allocate(aos_data1(n_points_final_grid,ao_num,4)) + allocate(aos_data2(n_points_extra_final_grid,ao_num,4)) + + do k = 1, nucl_num + rn(1,k) = nucl_coord(k,1) + rn(2,k) = nucl_coord(k,2) + rn(3,k) = nucl_coord(k,3) + enddo + + do k = 1, ao_num + do ipoint = 1, n_points_final_grid + aos_data1(ipoint,k,1) = aos_in_r_array(k,ipoint) + aos_data1(ipoint,k,2) = aos_grad_in_r_array(k,ipoint,1) + aos_data1(ipoint,k,3) = aos_grad_in_r_array(k,ipoint,2) + aos_data1(ipoint,k,4) = aos_grad_in_r_array(k,ipoint,3) + enddo + enddo + + do k = 1, ao_num + do ipoint = 1, n_points_extra_final_grid + aos_data2(ipoint,k,1) = aos_in_r_array_extra(k,ipoint) + aos_data2(ipoint,k,2) = aos_grad_in_r_array_extra(k,ipoint,1) + aos_data2(ipoint,k,3) = aos_grad_in_r_array_extra(k,ipoint,2) + aos_data2(ipoint,k,4) = aos_grad_in_r_array_extra(k,ipoint,3) + enddo + enddo + + + allocate(int_fct_long_range(n_points_extra_final_grid,ao_num,ao_num)) + allocate(grad1_u12(n_points_extra_final_grid,n_points_final_grid,4)) + allocate(c_mat(n_points_final_grid,ao_num,ao_num)) + allocate(int2_grad1_u12_ao(ao_num,ao_num,n_points_final_grid,4)) + allocate(int_2e_ao(ao_num,ao_num,ao_num,ao_num)) + + call wall_time(wall_time0) + + call wall_time(wall_ttime0) + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (j, i, jpoint) & + !$OMP SHARED (int_fct_long_range, ao_num, n_points_extra_final_grid, final_weight_at_r_vector_extra, aos_in_r_array_extra_transp) + !$OMP DO SCHEDULE (static) + do j = 1, ao_num + do i = 1, ao_num + do jpoint = 1, n_points_extra_final_grid + int_fct_long_range(jpoint,i,j) = final_weight_at_r_vector_extra(jpoint) * aos_in_r_array_extra_transp(jpoint,i) * aos_in_r_array_extra_transp(jpoint,j) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + call wall_time(wall_ttime1) + write(*,"(A,2X,F15.7)") ' wall time for int_long_range (sec) = ', (wall_ttime1 - wall_ttime0) + + + call wall_time(wall_ttime0) + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint) & + !$OMP SHARED (n_points_final_grid, n_points_extra_final_grid, grad1_u12) + !$OMP DO + do ipoint = 1, n_points_final_grid + call get_grad1_u12_for_tc(ipoint, n_points_extra_final_grid, grad1_u12(1,ipoint,1) & + , grad1_u12(1,ipoint,2) & + , grad1_u12(1,ipoint,3) & + , grad1_u12(1,ipoint,4) ) + enddo + !$OMP END DO + !$OMP END PARALLEL + call wall_time(wall_ttime1) + write(*,"(A,2X,F15.7)") ' wall time for tc_int_bh (sec) = ', (wall_ttime1 - wall_ttime0) + + + call wall_time(wall_ttime0) + do m = 1, 4 + call dgemm("T", "N", ao_num*ao_num, n_points_final_grid, n_points_extra_final_grid, 1.d0 & + , int_fct_long_range(1,1,1), n_points_extra_final_grid, grad1_u12(1,1,m), n_points_extra_final_grid & + , 0.d0, int2_grad1_u12_ao(1,1,1,m), ao_num*ao_num) + enddo + call wall_time(wall_ttime1) + write(*,"(A,2X,F15.7)") ' wall time for DGEMM of integ over r2 (sec) = ', (wall_ttime1 - wall_ttime0) + + + call wall_time(wall_ttime0) + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, k, ipoint) & + !$OMP SHARED (aos_in_r_array_transp, c_mat, ao_num, n_points_final_grid, final_weight_at_r_vector) + !$OMP DO SCHEDULE (static) + do i = 1, ao_num + do k = 1, ao_num + do ipoint = 1, n_points_final_grid + c_mat(ipoint,k,i) = final_weight_at_r_vector(ipoint) * aos_in_r_array_transp(ipoint,i) * aos_in_r_array_transp(ipoint,k) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + call wall_time(wall_ttime1) + write(*,"(A,2X,F15.7)") ' wall time of Hermitian part (sec) = ', (wall_ttime1 - wall_ttime0) + + + call wall_time(wall_ttime0) + call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & + , int2_grad1_u12_ao(1,1,1,4), ao_num*ao_num, c_mat(1,1,1), n_points_final_grid & + , 0.d0, int_2e_ao(1,1,1,1), ao_num*ao_num) + call wall_time(wall_ttime1) + write(*,"(A,2X,F15.7)") ' wall time for DGEMM of Hermitian part (sec) = ', (wall_ttime1 - wall_ttime0) + + + tt1 = 0.d0 + tt2 = 0.d0 + do m = 1, 3 + + call wall_time(wall_ttime0) + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & + !$OMP SHARED (aos_in_r_array_transp, aos_grad_in_r_array_transp_bis, c_mat, & + !$OMP ao_num, n_points_final_grid, final_weight_at_r_vector, m) + !$OMP DO SCHEDULE (static) + do i = 1, ao_num + do k = 1, ao_num + do ipoint = 1, n_points_final_grid + + weight1 = final_weight_at_r_vector(ipoint) + ao_i_r = aos_in_r_array_transp(ipoint,i) + ao_k_r = aos_in_r_array_transp(ipoint,k) + + c_mat(ipoint,k,i) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,m) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,m)) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + call wall_time(wall_ttime1) + tt1 += wall_ttime1 - wall_ttime0 + + call wall_time(wall_ttime0) + call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, -0.5d0 & + , int2_grad1_u12_ao(1,1,1,m), ao_num*ao_num, c_mat(1,1,1), n_points_final_grid & + , 1.d0, int_2e_ao(1,1,1,1), ao_num*ao_num) + call wall_time(wall_ttime1) + tt2 += wall_ttime1 - wall_ttime0 + enddo + write(*,"(A,2X,F15.7)") ' wall time of non-Hermitian part (sec) = ', tt1 + write(*,"(A,2X,F15.7)") ' wall time for DGEMM of non Hermitian part (sec) = ', tt2 + + + call wall_time(wall_ttime0) + call sum_A_At(int_2e_ao(1,1,1,1), ao_num*ao_num) + call wall_time(wall_ttime1) + write(*,"(A,2X,F15.7)") ' wall time of A + A.T (sec) = ', wall_ttime1 - wall_ttime0 + + + call wall_time(wall_time1) + write(*,"(A,2X,F15.7)") ' wall time on cpu (sec) = ', (wall_time1 - wall_time0) + + + deallocate(int_fct_long_range, grad1_u12, c_mat) + deallocate(int_2e_ao, int2_grad1_u12_ao) + deallocate(rn, aos_data1, aos_data2) + + call wall_time(time1) + write(*,"(A,2X,F15.7)") ' wall time for compute_int_2e_ao_cpu (sec) = ', (time1 - time0) + + return +end diff --git a/plugins/local/tc_int/compute_int_2e_ao_gpu.irp.f b/plugins/local/tc_int/compute_int_2e_ao_gpu.irp.f new file mode 100644 index 00000000..4ffdc1cb --- /dev/null +++ b/plugins/local/tc_int/compute_int_2e_ao_gpu.irp.f @@ -0,0 +1,117 @@ + +! --- + +program compute_int_2e_ao_gpu + + implicit none + + print *, ' j2e_type = ', j2e_type + print *, ' j1e_type = ', j1e_type + print *, ' env_type = ', env_type + + my_grid_becke = .True. + PROVIDE tc_grid1_a tc_grid1_r + my_n_pt_r_grid = tc_grid1_r + my_n_pt_a_grid = tc_grid1_a + touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid + + my_extra_grid_becke = .True. + PROVIDE tc_grid2_a tc_grid2_r + my_n_pt_r_extra_grid = tc_grid2_r + my_n_pt_a_extra_grid = tc_grid2_a + touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid + + call write_int(6, my_n_pt_r_grid, 'radial external grid over') + call write_int(6, my_n_pt_a_grid, 'angular external grid over') + + call write_int(6, my_n_pt_r_extra_grid, 'radial internal grid over') + call write_int(6, my_n_pt_a_extra_grid, 'angular internal grid over') + + call main() + +end + +! --- + +subroutine main() + + use cutc_module + + implicit none + + integer :: i, j, k, l + integer :: ipoint + + double precision :: time0, time1 + + double precision, allocatable :: rn(:,:), aos_data1(:,:,:), aos_data2(:,:,:) + double precision, allocatable :: int2_grad1_u12_ao_gpu(:,:,:,:) + double precision, allocatable :: int_2e_ao_gpu(:,:,:,:) + + + call wall_time(time0) + print*, ' start compute_int_2e_ao_gpu' + + + ! --- + + allocate(rn(3,nucl_num)) + allocate(aos_data1(n_points_final_grid,ao_num,4)) + allocate(aos_data2(n_points_extra_final_grid,ao_num,4)) + + do k = 1, nucl_num + rn(1,k) = nucl_coord(k,1) + rn(2,k) = nucl_coord(k,2) + rn(3,k) = nucl_coord(k,3) + enddo + + do k = 1, ao_num + do ipoint = 1, n_points_final_grid + aos_data1(ipoint,k,1) = aos_in_r_array(k,ipoint) + aos_data1(ipoint,k,2) = aos_grad_in_r_array(k,ipoint,1) + aos_data1(ipoint,k,3) = aos_grad_in_r_array(k,ipoint,2) + aos_data1(ipoint,k,4) = aos_grad_in_r_array(k,ipoint,3) + enddo + enddo + + do k = 1, ao_num + do ipoint = 1, n_points_extra_final_grid + aos_data2(ipoint,k,1) = aos_in_r_array_extra(k,ipoint) + aos_data2(ipoint,k,2) = aos_grad_in_r_array_extra(k,ipoint,1) + aos_data2(ipoint,k,3) = aos_grad_in_r_array_extra(k,ipoint,2) + aos_data2(ipoint,k,4) = aos_grad_in_r_array_extra(k,ipoint,3) + enddo + enddo + + ! --- + + integer :: nB + integer :: sB + + PROVIDE nxBlocks nyBlocks nzBlocks + PROVIDE blockxSize blockySize blockzSize + + sB = 32 + nB = (n_points_final_grid + sB - 1) / sB + + call ezfio_set_tc_int_blockxSize(sB) + call ezfio_set_tc_int_nxBlocks(nB) + + allocate(int2_grad1_u12_ao_gpu(ao_num,ao_num,n_points_final_grid,3)) + allocate(int_2e_ao_gpu(ao_num,ao_num,ao_num,ao_num)) + + call cutc_int(nxBlocks, nyBlocks, nzBlocks, blockxSize, blockySize, blockzSize, & + n_points_final_grid, n_points_extra_final_grid, ao_num, nucl_num, jBH_size, & + final_grid_points, final_weight_at_r_vector, & + final_grid_points_extra, final_weight_at_r_vector_extra, & + rn, aos_data1, aos_data2, jBH_c, jBH_m, jBH_n, jBH_o, & + int2_grad1_u12_ao_gpu, int_2e_ao_gpu) + + deallocate(int_2e_ao_gpu, int2_grad1_u12_ao_gpu) + deallocate(rn, aos_data1, aos_data2) + + call wall_time(time1) + write(*,"(A,2X,F15.7)") ' wall time for compute_int_2e_ao_gpu (sec) = ', (time1 - time0) + + return +end diff --git a/plugins/local/tc_int/compute_no_cpu.irp.f b/plugins/local/tc_int/compute_no_cpu.irp.f new file mode 100644 index 00000000..54ba37ce --- /dev/null +++ b/plugins/local/tc_int/compute_no_cpu.irp.f @@ -0,0 +1,143 @@ + +! --- + +program compute_no_cpu + + implicit none + + print *, ' j2e_type = ', j2e_type + print *, ' j1e_type = ', j1e_type + print *, ' env_type = ', env_type + + my_grid_becke = .True. + PROVIDE tc_grid1_a tc_grid1_r + my_n_pt_r_grid = tc_grid1_r + my_n_pt_a_grid = tc_grid1_a + touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid + + my_extra_grid_becke = .True. + PROVIDE tc_grid2_a tc_grid2_r + my_n_pt_r_extra_grid = tc_grid2_r + my_n_pt_a_extra_grid = tc_grid2_a + touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid + + call write_int(6, my_n_pt_r_grid, 'radial external grid over') + call write_int(6, my_n_pt_a_grid, 'angular external grid over') + + call write_int(6, my_n_pt_r_extra_grid, 'radial internal grid over') + call write_int(6, my_n_pt_a_extra_grid, 'angular internal grid over') + + call main() + +end + +! --- + +subroutine main() + + use cutc_module + + implicit none + + integer :: i, j, k, l, ipoint + double precision :: time0, time1 + double precision :: tt0, tt1 + double precision :: acc_thr, err_tot, nrm_tot, err_loc + double precision :: noL_0e + double precision, allocatable :: int2_grad1_u12_ao(:,:,:,:) + double precision, allocatable :: tmp(:,:,:,:) + double precision, allocatable :: int2_grad1_u12_bimo_t(:,:,:,:) + double precision, allocatable :: noL_1e (:,:) + double precision, allocatable :: noL_2e (:,:,:,:) + + PROVIDE mo_l_coef mo_r_coef + PROVIDE mos_l_in_r_array_transp mos_r_in_r_array_transp + + + call wall_time(time0) + print*, ' start compute_no_cpu' + + + + allocate(int2_grad1_u12_ao(ao_num,ao_num,n_points_final_grid,3)) + print*, ' Reading int2_grad1_u12_ao from ', trim(ezfio_filename) // '/work/int2_grad1_u12_ao' + call wall_time(tt0) + open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/int2_grad1_u12_ao', action="read") + read(11) int2_grad1_u12_ao + close(11) + call wall_time(tt1) + write(*,"(A,2X,F15.7)") ' wall time for reading (sec) = ', (tt1 - tt0) + + allocate(tmp(mo_num,mo_num,n_points_final_grid,3)) + allocate(int2_grad1_u12_bimo_t(n_points_final_grid,3,mo_num,mo_num)) + + call wall_time(tt0) + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint) & + !$OMP SHARED (ao_num, mo_num, n_points_final_grid, int2_grad1_u12_ao, tmp) + !$OMP DO SCHEDULE (dynamic) + do ipoint = 1, n_points_final_grid + call ao_to_mo_bi_ortho(int2_grad1_u12_ao(1,1,ipoint,1), ao_num, tmp(1,1,ipoint,1), mo_num) + call ao_to_mo_bi_ortho(int2_grad1_u12_ao(1,1,ipoint,2), ao_num, tmp(1,1,ipoint,2), mo_num) + call ao_to_mo_bi_ortho(int2_grad1_u12_ao(1,1,ipoint,3), ao_num, tmp(1,1,ipoint,3), mo_num) + enddo + !$OMP END DO + !$OMP END PARALLEL + + deallocate(int2_grad1_u12_ao) + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, j, ipoint) & + !$OMP SHARED (mo_num, n_points_final_grid, tmp, int2_grad1_u12_bimo_t) + !$OMP DO COLLAPSE(2) SCHEDULE (dynamic) + do ipoint = 1, n_points_final_grid + do i = 1, mo_num + do j = 1, mo_num + int2_grad1_u12_bimo_t(ipoint,1,j,i) = tmp(j,i,ipoint,1) + int2_grad1_u12_bimo_t(ipoint,2,j,i) = tmp(j,i,ipoint,2) + int2_grad1_u12_bimo_t(ipoint,3,j,i) = tmp(j,i,ipoint,3) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + call wall_time(tt1) + write(*,"(A,2X,F15.7)") ' wall time for 3e-tensor (sec) = ', (tt1 - tt0) + + deallocate(tmp) + + allocate(noL_2e(mo_num,mo_num,mo_num,mo_num)) + allocate(noL_1e(mo_num,mo_num)) + + call provide_no_2e(n_points_final_grid, mo_num, elec_alpha_num, elec_beta_num, & + final_weight_at_r_vector(1), & + mos_l_in_r_array_transp(1,1), mos_r_in_r_array_transp(1,1), & + int2_grad1_u12_bimo_t(1,1,1,1), noL_2e(1,1,1,1)) + + call provide_no_1e(n_points_final_grid, mo_num, elec_alpha_num, elec_beta_num, & + final_weight_at_r_vector(1), & + mos_l_in_r_array_transp(1,1), mos_r_in_r_array_transp(1,1), & + int2_grad1_u12_bimo_t(1,1,1,1), noL_1e(1,1)) + + call provide_no_0e(n_points_final_grid, mo_num, elec_alpha_num, elec_beta_num, & + final_weight_at_r_vector(1), & + mos_l_in_r_array_transp(1,1), mos_r_in_r_array_transp(1,1), & + int2_grad1_u12_bimo_t(1,1,1,1), noL_0e) + + deallocate(int2_grad1_u12_bimo_t) + deallocate(noL_2e) + deallocate(noL_1e) + + + call wall_time(time1) + write(*,"(A,2X,F15.7)") ' wall time for compute_no_cpu (sec) = ', (time1 - time0) + + return + +end + +! --- + + diff --git a/plugins/local/tc_int/deb_no_0e_gpu.irp.f b/plugins/local/tc_int/compute_no_gpu.irp.f similarity index 52% rename from plugins/local/tc_int/deb_no_0e_gpu.irp.f rename to plugins/local/tc_int/compute_no_gpu.irp.f index afff060a..9e4d90cc 100644 --- a/plugins/local/tc_int/deb_no_0e_gpu.irp.f +++ b/plugins/local/tc_int/compute_no_gpu.irp.f @@ -1,34 +1,77 @@ ! --- -subroutine deb_no_0e_gpu() +program compute_no_gpu + + implicit none + + print *, ' j2e_type = ', j2e_type + print *, ' j1e_type = ', j1e_type + print *, ' env_type = ', env_type + + my_grid_becke = .True. + PROVIDE tc_grid1_a tc_grid1_r + my_n_pt_r_grid = tc_grid1_r + my_n_pt_a_grid = tc_grid1_a + touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid + + my_extra_grid_becke = .True. + PROVIDE tc_grid2_a tc_grid2_r + my_n_pt_r_extra_grid = tc_grid2_r + my_n_pt_a_extra_grid = tc_grid2_a + touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid + + call write_int(6, my_n_pt_r_grid, 'radial external grid over') + call write_int(6, my_n_pt_a_grid, 'angular external grid over') + + call write_int(6, my_n_pt_r_extra_grid, 'radial internal grid over') + call write_int(6, my_n_pt_a_extra_grid, 'angular internal grid over') + + call main() + +end + +! --- + +subroutine main() use cutc_module implicit none integer :: i, j, k, l, ipoint + double precision :: time0, time1 + double precision :: tt0, tt1 double precision :: acc_thr, err_tot, nrm_tot, err_loc - double precision :: noL_0e double precision :: noL_0e_gpu(1) double precision, allocatable :: int2_grad1_u12_ao(:,:,:,:) double precision, allocatable :: tmp(:,:,:,:) double precision, allocatable :: int2_grad1_u12_bimo_t(:,:,:,:) - + double precision, allocatable :: noL_1e_gpu(:,:) + double precision, allocatable :: noL_2e_gpu(:,:,:,:) PROVIDE mo_l_coef mo_r_coef PROVIDE mos_l_in_r_array_transp mos_r_in_r_array_transp + call wall_time(time0) + print*, ' start compute_no_gpu' + + + allocate(int2_grad1_u12_ao(ao_num,ao_num,n_points_final_grid,3)) print*, ' Reading int2_grad1_u12_ao from ', trim(ezfio_filename) // '/work/int2_grad1_u12_ao' + call wall_time(tt0) open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/int2_grad1_u12_ao', action="read") read(11) int2_grad1_u12_ao close(11) + call wall_time(tt1) + write(*,"(A,2X,F15.7)") ' wall time for reading (sec) = ', (tt1 - tt0) allocate(tmp(mo_num,mo_num,n_points_final_grid,3)) allocate(int2_grad1_u12_bimo_t(n_points_final_grid,3,mo_num,mo_num)) + call wall_time(tt0) !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (ipoint) & @@ -60,37 +103,30 @@ subroutine deb_no_0e_gpu() enddo !$OMP END DO !$OMP END PARALLEL + call wall_time(tt1) + write(*,"(A,2X,F15.7)") ' wall time for 3e-tensor (sec) = ', (tt1 - tt0) deallocate(tmp) - ! --- + allocate(noL_2e_gpu(mo_num,mo_num,mo_num,mo_num)) + allocate(noL_1e_gpu(mo_num,mo_num)) - call cutc_no_0e(n_points_final_grid, mo_num, elec_alpha_num, elec_beta_num, & - final_weight_at_r_vector(1), & - mos_l_in_r_array_transp(1,1), mos_r_in_r_array_transp(1,1), & - int2_grad1_u12_bimo_t(1,1,1,1), noL_0e_gpu(1)) - - ! --- - - call provide_no_0e(n_points_final_grid, mo_num, elec_alpha_num, elec_beta_num, & - final_weight_at_r_vector(1), & - mos_l_in_r_array_transp(1,1), mos_r_in_r_array_transp(1,1), & - int2_grad1_u12_bimo_t(1,1,1,1), noL_0e) - - ! --- + call cutc_no(n_points_final_grid, mo_num, elec_alpha_num, elec_beta_num, & + final_weight_at_r_vector(1), & + mos_l_in_r_array_transp(1,1), mos_r_in_r_array_transp(1,1), & + int2_grad1_u12_bimo_t(1,1,1,1), noL_2e_gpu(1,1,1,1), noL_1e_gpu(1,1), noL_0e_gpu(1)) deallocate(int2_grad1_u12_bimo_t) + deallocate(noL_2e_gpu) + deallocate(noL_1e_gpu) - print *, 'noL_0e CPU = ', noL_0e - print *, 'noL_0e GPU = ', noL_0e_gpu(1) + call wall_time(time1) + write(*,"(A,2X,F15.7)") ' wall time for compute_no_gpu (sec) = ', (time1 - time0) - err_tot = dabs(noL_0e - noL_0e_gpu(1)) - nrm_tot = dabs(noL_0e) - print *, ' absolute accuracy on noL_0e (%) =', 100.d0 * err_tot / nrm_tot - return end ! --- + diff --git a/plugins/local/tc_int/cutc_module.F90 b/plugins/local/tc_int/cutc_module.F90 index eaf271e5..0f5f6c78 100644 --- a/plugins/local/tc_int/cutc_module.F90 +++ b/plugins/local/tc_int/cutc_module.F90 @@ -41,155 +41,6 @@ module cutc_module ! --- - subroutine deb_int_2e_ao(nxBlocks, nyBlocks, nzBlocks, & - blockxSize, blockySize, blockzSize, & - n_grid1, n_grid2, n_ao, n_nuc, size_bh, & - r1, wr1, r2, wr2, rn, & - aos_data1, aos_data2, & - c_bh, m_bh, n_bh, o_bh, & - int2_grad1_u12_ao, int_2e_ao) bind(C, name = "deb_int_2e_ao") - - import c_int, c_double, c_ptr - - integer(c_int), intent(in), value :: nxBlocks, blockxSize - integer(c_int), intent(in), value :: nyBlocks, blockySize - integer(c_int), intent(in), value :: nzBlocks, blockzSize - integer(c_int), intent(in), value :: n_grid1, n_grid2 - integer(c_int), intent(in), value :: n_ao - integer(c_int), intent(in), value :: n_nuc - integer(c_int), intent(in), value :: size_bh - real(c_double), intent(in) :: r1(3,n_grid1), wr1(n_grid1) - real(c_double), intent(in) :: r2(3,n_grid2), wr2(n_grid2) - real(c_double), intent(in) :: rn(3,n_nuc) - real(c_double), intent(in) :: aos_data1(n_grid1,n_ao,4) - real(c_double), intent(in) :: aos_data2(n_grid2,n_ao,4) - real(c_double), intent(in) :: c_bh(size_bh,n_nuc) - integer(c_int), intent(in) :: m_bh(size_bh,n_nuc) - integer(c_int), intent(in) :: n_bh(size_bh,n_nuc) - integer(c_int), intent(in) :: o_bh(size_bh,n_nuc) - real(c_double), intent(out) :: int2_grad1_u12_ao(n_ao,n_ao,n_grid1,3) - real(c_double), intent(out) :: int_2e_ao(n_ao,n_ao,n_ao,n_ao) - - end subroutine deb_int_2e_ao - - ! --- - - subroutine cutc_no_2e(n_grid1, n_mo, ne_a, ne_b, & - wr1, mos_l_in_r, mos_r_in_r, int2_grad1_u12, & - no_2e) bind(C, name = "cutc_no_2e") - - import c_int, c_double, c_ptr - - integer(c_int), intent(in), value :: n_grid1 - integer(c_int), intent(in), value :: n_mo - integer(c_int), intent(in), value :: ne_a - integer(c_int), intent(in), value :: ne_b - real(c_double), intent(in) :: wr1(n_grid1) - real(c_double), intent(in) :: mos_l_in_r(n_grid1,n_mo) - real(c_double), intent(in) :: mos_r_in_r(n_grid1,n_mo) - real(c_double), intent(in) :: int2_grad1_u12(n_grid1,3,n_mo,n_mo) - real(c_double), intent(out) :: no_2e(n_mo,n_mo,n_mo,n_mo) - - end subroutine cutc_no_2e - - ! --- - - subroutine deb_no_2e(n_grid1, n_mo, ne_a, ne_b, & - wr1, mos_l_in_r, mos_r_in_r, int2_grad1_u12, & - tmpO, tmpJ, tmpA, tmpB, tmpC, tmpD, tmpE, & - no_2e) bind(C, name = "deb_no_2e") - - import c_int, c_double, c_ptr - - integer(c_int), intent(in), value :: n_grid1 - integer(c_int), intent(in), value :: n_mo - integer(c_int), intent(in), value :: ne_a - integer(c_int), intent(in), value :: ne_b - real(c_double), intent(in) :: wr1(n_grid1) - real(c_double), intent(in) :: mos_l_in_r(n_grid1,n_mo) - real(c_double), intent(in) :: mos_r_in_r(n_grid1,n_mo) - real(c_double), intent(in) :: int2_grad1_u12(n_grid1,3,n_mo,n_mo) - real(c_double), intent(out) :: tmpO(n_grid1), tmpJ(n_grid1,3) - real(c_double), intent(out) :: tmpA(n_grid1,3,n_mo), tmpB(n_grid1,3,n_mo) - real(c_double), intent(out) :: tmpC(n_grid1,4,n_mo,n_mo), tmpD(n_grid1,4,n_mo,n_mo) - real(c_double), intent(out) :: tmpE(n_mo,n_mo,n_mo,n_mo) - real(c_double), intent(out) :: no_2e(n_mo,n_mo,n_mo,n_mo) - - end subroutine deb_no_2e - - ! --- - - subroutine cutc_no_1e(n_grid1, n_mo, ne_a, ne_b, & - wr1, mos_l_in_r, mos_r_in_r, int2_grad1_u12, & - no_1e) bind(C, name = "cutc_no_1e") - - import c_int, c_double, c_ptr - - integer(c_int), intent(in), value :: n_grid1 - integer(c_int), intent(in), value :: n_mo - integer(c_int), intent(in), value :: ne_a - integer(c_int), intent(in), value :: ne_b - real(c_double), intent(in) :: wr1(n_grid1) - real(c_double), intent(in) :: mos_l_in_r(n_grid1,n_mo) - real(c_double), intent(in) :: mos_r_in_r(n_grid1,n_mo) - real(c_double), intent(in) :: int2_grad1_u12(n_grid1,3,n_mo,n_mo) - real(c_double), intent(out) :: no_1e(n_mo,n_mo) - - end subroutine cutc_no_1e - - ! --- - - subroutine deb_no_1e(n_grid1, n_mo, ne_a, ne_b, & - wr1, mos_l_in_r, mos_r_in_r, int2_grad1_u12, & - tmpO, tmpJ, tmpM, tmpS, tmpC, tmpD, tmpL, tmpR, tmpE, tmpF, & - no_1e) bind(C, name = "deb_no_1e") - - import c_int, c_double, c_ptr - - integer(c_int), intent(in), value :: n_grid1 - integer(c_int), intent(in), value :: n_mo - integer(c_int), intent(in), value :: ne_a - integer(c_int), intent(in), value :: ne_b - real(c_double), intent(in) :: wr1(n_grid1) - real(c_double), intent(in) :: mos_l_in_r(n_grid1,n_mo) - real(c_double), intent(in) :: mos_r_in_r(n_grid1,n_mo) - real(c_double), intent(in) :: int2_grad1_u12(n_grid1,3,n_mo,n_mo) - real(c_double), intent(out) :: tmpO(n_grid1) - real(c_double), intent(out) :: tmpJ(n_grid1,3) - real(c_double), intent(out) :: tmpM(n_grid1,3) - real(c_double), intent(out) :: tmpS(n_grid1) - real(c_double), intent(out) :: tmpC(n_grid1,4,n_mo,n_mo) - real(c_double), intent(out) :: tmpD(n_grid1,4) - real(c_double), intent(out) :: tmpL(n_grid1,3,n_mo) - real(c_double), intent(out) :: tmpR(n_grid1,3,n_mo) - real(c_double), intent(out) :: tmpE(n_grid1,5,n_mo) - real(c_double), intent(out) :: tmpF(n_grid1,5,n_mo) - real(c_double), intent(out) :: no_1e(n_mo,n_mo) - - end subroutine deb_no_1e - - ! --- - - subroutine cutc_no_0e(n_grid1, n_mo, ne_a, ne_b, & - wr1, mos_l_in_r, mos_r_in_r, int2_grad1_u12, & - no_0e) bind(C, name = "cutc_no_0e") - - import c_int, c_double, c_ptr - - integer(c_int), intent(in), value :: n_grid1 - integer(c_int), intent(in), value :: n_mo - integer(c_int), intent(in), value :: ne_a - integer(c_int), intent(in), value :: ne_b - real(c_double), intent(in) :: wr1(n_grid1) - real(c_double), intent(in) :: mos_l_in_r(n_grid1,n_mo) - real(c_double), intent(in) :: mos_r_in_r(n_grid1,n_mo) - real(c_double), intent(in) :: int2_grad1_u12(n_grid1,3,n_mo,n_mo) - real(c_double), intent(out) :: no_0e(1) - - end subroutine cutc_no_0e - - ! --- - subroutine cutc_no(n_grid1, n_mo, ne_a, ne_b, & wr1, mos_l_in_r, mos_r_in_r, int2_grad1_u12, & no_2e, no_1e, no_0e) bind(C, name = "cutc_no") diff --git a/plugins/local/tc_int/deb_int_2e_ao_gpu.irp.f b/plugins/local/tc_int/deb_int_2e_ao_gpu.irp.f index 3290c149..4bb44af9 100644 --- a/plugins/local/tc_int/deb_int_2e_ao_gpu.irp.f +++ b/plugins/local/tc_int/deb_int_2e_ao_gpu.irp.f @@ -1,7 +1,39 @@ ! --- -subroutine deb_int_2e_ao_gpu() +program deb_int_2e_ao_gpu + + implicit none + + print *, ' j2e_type = ', j2e_type + print *, ' j1e_type = ', j1e_type + print *, ' env_type = ', env_type + + my_grid_becke = .True. + PROVIDE tc_grid1_a tc_grid1_r + my_n_pt_r_grid = tc_grid1_r + my_n_pt_a_grid = tc_grid1_a + touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid + + my_extra_grid_becke = .True. + PROVIDE tc_grid2_a tc_grid2_r + my_n_pt_r_extra_grid = tc_grid2_r + my_n_pt_a_extra_grid = tc_grid2_a + touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid + + call write_int(6, my_n_pt_r_grid, 'radial external grid over') + call write_int(6, my_n_pt_a_grid, 'angular external grid over') + + call write_int(6, my_n_pt_r_extra_grid, 'radial internal grid over') + call write_int(6, my_n_pt_a_extra_grid, 'angular internal grid over') + + call main() + +end + +! --- + +subroutine main() use cutc_module @@ -28,7 +60,6 @@ subroutine deb_int_2e_ao_gpu() double precision, allocatable :: int_2e_ao_gpu(:,:,:,:) - call wall_time(time0) print*, ' start deb_int_2e_ao_gpu' @@ -80,12 +111,12 @@ subroutine deb_int_2e_ao_gpu() allocate(int2_grad1_u12_ao_gpu(ao_num,ao_num,n_points_final_grid,3)) allocate(int_2e_ao_gpu(ao_num,ao_num,ao_num,ao_num)) - call deb_int_2e_ao(nxBlocks, nyBlocks, nzBlocks, blockxSize, blockySize, blockzSize, & - n_points_final_grid, n_points_extra_final_grid, ao_num, nucl_num, jBH_size, & - final_grid_points, final_weight_at_r_vector, & - final_grid_points_extra, final_weight_at_r_vector_extra, & - rn, aos_data1, aos_data2, jBH_c, jBH_m, jBH_n, jBH_o, & - int2_grad1_u12_ao_gpu, int_2e_ao_gpu) + call cutc_int(nxBlocks, nyBlocks, nzBlocks, blockxSize, blockySize, blockzSize, & + n_points_final_grid, n_points_extra_final_grid, ao_num, nucl_num, jBH_size, & + final_grid_points, final_weight_at_r_vector, & + final_grid_points_extra, final_weight_at_r_vector_extra, & + rn, aos_data1, aos_data2, jBH_c, jBH_m, jBH_n, jBH_o, & + int2_grad1_u12_ao_gpu, int_2e_ao_gpu) ! --- @@ -223,7 +254,6 @@ subroutine deb_int_2e_ao_gpu() acc_thr = 1d-12 - print *, ' precision on int2_grad1_u12_ao ' err_tot = 0.d0 nrm_tot = 0.d0 do m = 1, 3 @@ -246,7 +276,6 @@ subroutine deb_int_2e_ao_gpu() print *, ' absolute accuracy on int2_grad1_u12_ao (%) =', 100.d0 * err_tot / nrm_tot - print *, ' precision on int_2e_ao ' err_tot = 0.d0 nrm_tot = 0.d0 do i = 1, ao_num diff --git a/plugins/local/tc_int/deb_no_1e_gpu.irp.f b/plugins/local/tc_int/deb_no_1e_gpu.irp.f deleted file mode 100644 index 1efbb913..00000000 --- a/plugins/local/tc_int/deb_no_1e_gpu.irp.f +++ /dev/null @@ -1,499 +0,0 @@ - -! --- - -subroutine deb_no_1e_gpu() - - use cutc_module - - implicit none - - integer :: i, j, k, l, ipoint - double precision :: acc_thr, err_tot, nrm_tot, err_loc - double precision, allocatable :: int2_grad1_u12_ao(:,:,:,:) - double precision, allocatable :: tmp(:,:,:,:) - double precision, allocatable :: int2_grad1_u12_bimo_t(:,:,:,:) - double precision, allocatable :: noL_1e(:,:) - double precision, allocatable :: noL_1e_gpu(:,:) - - - PROVIDE mo_l_coef mo_r_coef - PROVIDE mos_l_in_r_array_transp mos_r_in_r_array_transp - - - allocate(int2_grad1_u12_ao(ao_num,ao_num,n_points_final_grid,3)) - print*, ' Reading int2_grad1_u12_ao from ', trim(ezfio_filename) // '/work/int2_grad1_u12_ao' - open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/int2_grad1_u12_ao', action="read") - read(11) int2_grad1_u12_ao - close(11) - - allocate(tmp(mo_num,mo_num,n_points_final_grid,3)) - allocate(int2_grad1_u12_bimo_t(n_points_final_grid,3,mo_num,mo_num)) - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint) & - !$OMP SHARED (ao_num, mo_num, n_points_final_grid, int2_grad1_u12_ao, tmp) - !$OMP DO SCHEDULE (dynamic) - do ipoint = 1, n_points_final_grid - call ao_to_mo_bi_ortho(int2_grad1_u12_ao(1,1,ipoint,1), ao_num, tmp(1,1,ipoint,1), mo_num) - call ao_to_mo_bi_ortho(int2_grad1_u12_ao(1,1,ipoint,2), ao_num, tmp(1,1,ipoint,2), mo_num) - call ao_to_mo_bi_ortho(int2_grad1_u12_ao(1,1,ipoint,3), ao_num, tmp(1,1,ipoint,3), mo_num) - enddo - !$OMP END DO - !$OMP END PARALLEL - - deallocate(int2_grad1_u12_ao) - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, j, ipoint) & - !$OMP SHARED (mo_num, n_points_final_grid, tmp, int2_grad1_u12_bimo_t) - !$OMP DO COLLAPSE(2) SCHEDULE (dynamic) - do ipoint = 1, n_points_final_grid - do i = 1, mo_num - do j = 1, mo_num - int2_grad1_u12_bimo_t(ipoint,1,j,i) = tmp(j,i,ipoint,1) - int2_grad1_u12_bimo_t(ipoint,2,j,i) = tmp(j,i,ipoint,2) - int2_grad1_u12_bimo_t(ipoint,3,j,i) = tmp(j,i,ipoint,3) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - deallocate(tmp) - - ! --- - - allocate(noL_1e_gpu(mo_num,mo_num)) - - call cutc_no_1e(n_points_final_grid, mo_num, elec_alpha_num, elec_beta_num, & - final_weight_at_r_vector(1), & - mos_l_in_r_array_transp(1,1), mos_r_in_r_array_transp(1,1), & - int2_grad1_u12_bimo_t(1,1,1,1), noL_1e_gpu(1,1)) - - ! --- - - allocate(noL_1e(mo_num,mo_num)) - - call provide_no_1e(n_points_final_grid, mo_num, elec_alpha_num, elec_beta_num, & - final_weight_at_r_vector(1), & - mos_l_in_r_array_transp(1,1), mos_r_in_r_array_transp(1,1), & - int2_grad1_u12_bimo_t(1,1,1,1), noL_1e(1,1)) - - ! --- - - deallocate(int2_grad1_u12_bimo_t) - - acc_thr = 1d-12 - - err_tot = 0.d0 - nrm_tot = 0.d0 - do k = 1, mo_num - do l = 1, mo_num - err_loc = dabs(noL_1e(l,k) - noL_1e_gpu(l,k)) - if(err_loc > acc_thr) then - print*, " error on", l, k - print*, " CPU res", noL_1e (l,k) - print*, " GPU res", noL_1e_gpu(l,k) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(noL_1e(l,k)) - enddo - enddo - print *, ' absolute accuracy on noL_1e (%) =', 100.d0 * err_tot / nrm_tot - - deallocate(noL_1e) - deallocate(noL_1e_gpu) - - - return - -end - -! --- - -subroutine deb_no_1e_gpu_tmp() - - use cutc_module - - implicit none - - integer :: i, j, k, l, m, ipoint - double precision :: acc_thr, err_tot, nrm_tot, err_loc - double precision, allocatable :: int2_grad1_u12_ao(:,:,:,:) - double precision, allocatable :: tmp(:,:,:,:) - double precision, allocatable :: int2_grad1_u12_bimo_t(:,:,:,:) - double precision, allocatable :: tmpO(:), tmpO_gpu(:) - double precision, allocatable :: tmpJ(:,:), tmpJ_gpu(:,:) - double precision, allocatable :: tmpM(:,:), tmpM_gpu(:,:) - double precision, allocatable :: tmpS(:), tmpS_gpu(:) - double precision, allocatable :: tmpC(:,:,:,:), tmpC_gpu(:,:,:,:) - double precision, allocatable :: tmpD(:,:), tmpD_gpu(:,:) - double precision, allocatable :: tmpL(:,:,:), tmpL_gpu(:,:,:) - double precision, allocatable :: tmpR(:,:,:), tmpR_gpu(:,:,:) - double precision, allocatable :: tmpE(:,:,:), tmpE_gpu(:,:,:) - double precision, allocatable :: tmpF(:,:,:), tmpF_gpu(:,:,:) - double precision, allocatable :: noL_1e(:,:), noL_1e_gpu(:,:) - - - ! --- - - - PROVIDE mo_l_coef mo_r_coef - PROVIDE mos_l_in_r_array_transp mos_r_in_r_array_transp - - - allocate(int2_grad1_u12_ao(ao_num,ao_num,n_points_final_grid,3)) - print*, ' Reading int2_grad1_u12_ao from ', trim(ezfio_filename) // '/work/int2_grad1_u12_ao' - open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/int2_grad1_u12_ao', action="read") - read(11) int2_grad1_u12_ao - close(11) - - allocate(tmp(mo_num,mo_num,n_points_final_grid,3)) - allocate(int2_grad1_u12_bimo_t(n_points_final_grid,3,mo_num,mo_num)) - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint) & - !$OMP SHARED (ao_num, mo_num, n_points_final_grid, int2_grad1_u12_ao, tmp) - !$OMP DO SCHEDULE (dynamic) - do ipoint = 1, n_points_final_grid - call ao_to_mo_bi_ortho(int2_grad1_u12_ao(1,1,ipoint,1), ao_num, tmp(1,1,ipoint,1), mo_num) - call ao_to_mo_bi_ortho(int2_grad1_u12_ao(1,1,ipoint,2), ao_num, tmp(1,1,ipoint,2), mo_num) - call ao_to_mo_bi_ortho(int2_grad1_u12_ao(1,1,ipoint,3), ao_num, tmp(1,1,ipoint,3), mo_num) - enddo - !$OMP END DO - !$OMP END PARALLEL - - deallocate(int2_grad1_u12_ao) - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, j, ipoint) & - !$OMP SHARED (mo_num, n_points_final_grid, tmp, int2_grad1_u12_bimo_t) - !$OMP DO COLLAPSE(2) SCHEDULE (dynamic) - do ipoint = 1, n_points_final_grid - do i = 1, mo_num - do j = 1, mo_num - int2_grad1_u12_bimo_t(ipoint,1,j,i) = tmp(j,i,ipoint,1) - int2_grad1_u12_bimo_t(ipoint,2,j,i) = tmp(j,i,ipoint,2) - int2_grad1_u12_bimo_t(ipoint,3,j,i) = tmp(j,i,ipoint,3) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - deallocate(tmp) - - ! --- - - allocate(tmpO_gpu(n_points_final_grid)) - allocate(tmpJ_gpu(n_points_final_grid,3)) - allocate(tmpM_gpu(n_points_final_grid,3)) - allocate(tmpS_gpu(n_points_final_grid)) - allocate(tmpC_gpu(n_points_final_grid,4,mo_num,mo_num)) - allocate(tmpD_gpu(n_points_final_grid,4)) - allocate(tmpL_gpu(n_points_final_grid,3,mo_num)) - allocate(tmpR_gpu(n_points_final_grid,3,mo_num)) - allocate(tmpE_gpu(n_points_final_grid,5,mo_num)) - allocate(tmpF_gpu(n_points_final_grid,5,mo_num)) - allocate(noL_1e_gpu(mo_num,mo_num)) - - call deb_no_1e(n_points_final_grid, mo_num, elec_alpha_num, elec_beta_num, & - final_weight_at_r_vector(1), & - mos_l_in_r_array_transp(1,1), mos_r_in_r_array_transp(1,1), int2_grad1_u12_bimo_t(1,1,1,1), & - tmpO_gpu(1), tmpJ_gpu(1,1), tmpM_gpu(1,1), tmpS_gpu(1), tmpC_gpu(1,1,1,1), tmpD_gpu(1,1), & - tmpL_gpu(1,1,1), tmpR_gpu(1,1,1), tmpE_gpu(1,1,1), tmpF_gpu(1,1,1), noL_1e_gpu(1,1)) - - ! --- - - allocate(tmpO(n_points_final_grid)) - allocate(tmpJ(n_points_final_grid,3)) - allocate(tmpM(n_points_final_grid,3)) - allocate(tmpS(n_points_final_grid)) - allocate(tmpC(n_points_final_grid,4,mo_num,mo_num)) - allocate(tmpD(n_points_final_grid,4)) - allocate(tmpL(n_points_final_grid,3,mo_num)) - allocate(tmpR(n_points_final_grid,3,mo_num)) - allocate(tmpE(n_points_final_grid,5,mo_num)) - allocate(tmpF(n_points_final_grid,5,mo_num)) - allocate(noL_1e(mo_num,mo_num)) - - call provide_no_1e_tmp(n_points_final_grid, mo_num, elec_alpha_num, elec_beta_num, & - final_weight_at_r_vector(1), & - mos_l_in_r_array_transp(1,1), mos_r_in_r_array_transp(1,1), int2_grad1_u12_bimo_t(1,1,1,1), & - tmpO(1), tmpJ(1,1), tmpM(1,1), tmpS(1), tmpC(1,1,1,1), tmpD(1,1), tmpL(1,1,1), tmpR(1,1,1), & - tmpE(1,1,1), tmpF(1,1,1), noL_1e(1,1)) - - ! --- - - deallocate(int2_grad1_u12_bimo_t) - - - acc_thr = 1d-12 - - ! --- - - ! tmpO(n_points_final_grid)) - err_tot = 0.d0 - nrm_tot = 0.d0 - do ipoint = 1, n_points_final_grid - err_loc = dabs(tmpO(ipoint) - tmpO_gpu(ipoint)) - if(err_loc > acc_thr) then - print*, " error on", ipoint - print*, " CPU res", tmpO (ipoint) - print*, " GPU res", tmpO_gpu(ipoint) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(tmpO(ipoint)) - enddo - print *, ' absolute accuracy on tmpO (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - ! tmpJ(n_points_final_grid,3)) - err_tot = 0.d0 - nrm_tot = 0.d0 - do m = 1, 3 - do ipoint = 1, n_points_final_grid - err_loc = dabs(tmpJ(ipoint,m) - tmpJ_gpu(ipoint,m)) - if(err_loc > acc_thr) then - print*, " error on", ipoint, m - print*, " CPU res", tmpJ (ipoint,m) - print*, " GPU res", tmpJ_gpu(ipoint,m) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(tmpJ(ipoint,m)) - enddo - enddo - print *, ' absolute accuracy on tmpJ (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - ! tmpM(n_points_final_grid,3)) - err_tot = 0.d0 - nrm_tot = 0.d0 - do m = 1, 3 - do ipoint = 1, n_points_final_grid - err_loc = dabs(tmpM(ipoint,m) - tmpM_gpu(ipoint,m)) - if(err_loc > acc_thr) then - print*, " error on", ipoint, m - print*, " CPU res", tmpM (ipoint,m) - print*, " GPU res", tmpM_gpu(ipoint,m) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(tmpM(ipoint,m)) - enddo - enddo - print *, ' absolute accuracy on tmpM (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - ! tmpS(n_points_final_grid)) - err_tot = 0.d0 - nrm_tot = 0.d0 - do ipoint = 1, n_points_final_grid - err_loc = dabs(tmpS(ipoint) - tmpS_gpu(ipoint)) - if(err_loc > acc_thr) then - print*, " error on", ipoint - print*, " CPU res", tmpS (ipoint) - print*, " GPU res", tmpS_gpu(ipoint) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(tmpS(ipoint)) - enddo - print *, ' absolute accuracy on tmpS (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - ! tmpC(n_points_final_grid,4,mo_num,mo_num)) - err_tot = 0.d0 - nrm_tot = 0.d0 - do i = 1, mo_num - do j = 1, mo_num - do m = 1, 4 - do ipoint = 1, n_points_final_grid - err_loc = dabs(tmpC(ipoint,m,j,i) - tmpC_gpu(ipoint,m,j,i)) - if(err_loc > acc_thr) then - print*, " error on", ipoint, m, j, i - print*, " CPU res", tmpC (ipoint,m,j,i) - print*, " GPU res", tmpC_gpu(ipoint,m,j,i) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(tmpC(ipoint,m,j,i)) - enddo - enddo - enddo - enddo - print *, ' absolute accuracy on tmpC (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - ! tmpD(n_points_final_grid,4)) - err_tot = 0.d0 - nrm_tot = 0.d0 - do m = 1, 4 - do ipoint = 1, n_points_final_grid - err_loc = dabs(tmpD(ipoint,m) - tmpD_gpu(ipoint,m)) - if(err_loc > acc_thr) then - print*, " error on", ipoint, m - print*, " CPU res", tmpD (ipoint,m) - print*, " GPU res", tmpD_gpu(ipoint,m) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(tmpD(ipoint,m)) - enddo - enddo - print *, ' absolute accuracy on tmpD (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - ! tmpL(n_points_final_grid,3,mo_num)) - err_tot = 0.d0 - nrm_tot = 0.d0 - do i = 1, mo_num - do m = 1, 3 - do ipoint = 1, n_points_final_grid - err_loc = dabs(tmpL(ipoint,m,i) - tmpL_gpu(ipoint,m,i)) - if(err_loc > acc_thr) then - print*, " error on", ipoint, m, i - print*, " CPU res", tmpL (ipoint,m,i) - print*, " GPU res", tmpL_gpu(ipoint,m,i) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(tmpL(ipoint,m,i)) - enddo - enddo - enddo - print *, ' absolute accuracy on tmpL (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - ! tmpR(n_points_final_grid,3,mo_num)) - err_tot = 0.d0 - nrm_tot = 0.d0 - do i = 1, mo_num - do m = 1, 3 - do ipoint = 1, n_points_final_grid - err_loc = dabs(tmpR(ipoint,m,i) - tmpR_gpu(ipoint,m,i)) - if(err_loc > acc_thr) then - print*, " error on", ipoint, m, i - print*, " CPU res", tmpR (ipoint,m,i) - print*, " GPU res", tmpR_gpu(ipoint,m,i) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(tmpR(ipoint,m,i)) - enddo - enddo - enddo - print *, ' absolute accuracy on tmpR (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - ! tmpE(n_points_final_grid,5,mo_num)) - err_tot = 0.d0 - nrm_tot = 0.d0 - do i = 1, mo_num - do m = 1, 5 - do ipoint = 1, n_points_final_grid - err_loc = dabs(tmpE(ipoint,m,i) - tmpE_gpu(ipoint,m,i)) - if(err_loc > acc_thr) then - print*, " error on", ipoint, m, i - print*, " CPU res", tmpE (ipoint,m,i) - print*, " GPU res", tmpE_gpu(ipoint,m,i) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(tmpE(ipoint,m,i)) - enddo - enddo - enddo - print *, ' absolute accuracy on tmpE (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - ! tmpF(n_points_final_grid,5,mo_num)) - err_tot = 0.d0 - nrm_tot = 0.d0 - do i = 1, mo_num - do m = 1, 5 - do ipoint = 1, n_points_final_grid - err_loc = dabs(tmpF(ipoint,m,i) - tmpF_gpu(ipoint,m,i)) - if(err_loc > acc_thr) then - print*, " error on", ipoint, m, i - print*, " CPU res", tmpF (ipoint,m,i) - print*, " GPU res", tmpF_gpu(ipoint,m,i) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(tmpF(ipoint,m,i)) - enddo - enddo - enddo - print *, ' absolute accuracy on tmpF (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - ! noL_1e(mo_num,mo_num)) - err_tot = 0.d0 - nrm_tot = 0.d0 - do k = 1, mo_num - do l = 1, mo_num - err_loc = dabs(noL_1e(l,k) - noL_1e_gpu(l,k)) - if(err_loc > acc_thr) then - print*, " error on", l, k - print*, " CPU res", noL_1e (l,k) - print*, " GPU res", noL_1e_gpu(l,k) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(noL_1e(l,k)) - enddo - enddo - print *, ' absolute accuracy on noL_1e (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - - deallocate(tmpO) - deallocate(tmpJ) - deallocate(tmpM) - deallocate(tmpS) - deallocate(tmpC) - deallocate(tmpD) - deallocate(tmpL) - deallocate(tmpR) - deallocate(tmpE) - deallocate(tmpF) - deallocate(noL_1e) - - deallocate(tmpO_gpu) - deallocate(tmpJ_gpu) - deallocate(tmpM_gpu) - deallocate(tmpS_gpu) - deallocate(tmpC_gpu) - deallocate(tmpD_gpu) - deallocate(tmpL_gpu) - deallocate(tmpR_gpu) - deallocate(tmpE_gpu) - deallocate(tmpF_gpu) - deallocate(noL_1e_gpu) - - - return - -end - - - diff --git a/plugins/local/tc_int/deb_no_2e_gpu.irp.f b/plugins/local/tc_int/deb_no_2e_gpu.irp.f deleted file mode 100644 index 16f58cca..00000000 --- a/plugins/local/tc_int/deb_no_2e_gpu.irp.f +++ /dev/null @@ -1,417 +0,0 @@ - -! --- - -subroutine deb_no_2e_gpu() - - use cutc_module - - implicit none - - integer :: i, j, k, l, ipoint - double precision :: acc_thr, err_tot, nrm_tot, err_loc - double precision, allocatable :: int2_grad1_u12_ao(:,:,:,:) - double precision, allocatable :: tmp(:,:,:,:) - double precision, allocatable :: int2_grad1_u12_bimo_t(:,:,:,:) - double precision, allocatable :: noL_2e(:,:,:,:) - double precision, allocatable :: noL_2e_gpu(:,:,:,:) - - - PROVIDE mo_l_coef mo_r_coef - PROVIDE mos_l_in_r_array_transp mos_r_in_r_array_transp - - - allocate(int2_grad1_u12_ao(ao_num,ao_num,n_points_final_grid,3)) - print*, ' Reading int2_grad1_u12_ao from ', trim(ezfio_filename) // '/work/int2_grad1_u12_ao' - open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/int2_grad1_u12_ao', action="read") - read(11) int2_grad1_u12_ao - close(11) - - allocate(tmp(mo_num,mo_num,n_points_final_grid,3)) - allocate(int2_grad1_u12_bimo_t(n_points_final_grid,3,mo_num,mo_num)) - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint) & - !$OMP SHARED (ao_num, mo_num, n_points_final_grid, int2_grad1_u12_ao, tmp) - !$OMP DO SCHEDULE (dynamic) - do ipoint = 1, n_points_final_grid - call ao_to_mo_bi_ortho(int2_grad1_u12_ao(1,1,ipoint,1), ao_num, tmp(1,1,ipoint,1), mo_num) - call ao_to_mo_bi_ortho(int2_grad1_u12_ao(1,1,ipoint,2), ao_num, tmp(1,1,ipoint,2), mo_num) - call ao_to_mo_bi_ortho(int2_grad1_u12_ao(1,1,ipoint,3), ao_num, tmp(1,1,ipoint,3), mo_num) - enddo - !$OMP END DO - !$OMP END PARALLEL - - deallocate(int2_grad1_u12_ao) - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, j, ipoint) & - !$OMP SHARED (mo_num, n_points_final_grid, tmp, int2_grad1_u12_bimo_t) - !$OMP DO COLLAPSE(2) SCHEDULE (dynamic) - do ipoint = 1, n_points_final_grid - do i = 1, mo_num - do j = 1, mo_num - int2_grad1_u12_bimo_t(ipoint,1,j,i) = tmp(j,i,ipoint,1) - int2_grad1_u12_bimo_t(ipoint,2,j,i) = tmp(j,i,ipoint,2) - int2_grad1_u12_bimo_t(ipoint,3,j,i) = tmp(j,i,ipoint,3) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - deallocate(tmp) - - ! --- - - allocate(noL_2e_gpu(mo_num,mo_num,mo_num,mo_num)) - - call cutc_no_2e(n_points_final_grid, mo_num, elec_alpha_num, elec_beta_num, & - final_weight_at_r_vector(1), & - mos_l_in_r_array_transp(1,1), mos_r_in_r_array_transp(1,1), & - int2_grad1_u12_bimo_t(1,1,1,1), noL_2e_gpu(1,1,1,1)) - - ! --- - - allocate(noL_2e(mo_num,mo_num,mo_num,mo_num)) - - call provide_no_2e(n_points_final_grid, mo_num, elec_alpha_num, elec_beta_num, & - final_weight_at_r_vector(1), & - mos_l_in_r_array_transp(1,1), mos_r_in_r_array_transp(1,1), & - int2_grad1_u12_bimo_t(1,1,1,1), noL_2e(1,1,1,1)) - - ! --- - - deallocate(int2_grad1_u12_bimo_t) - - acc_thr = 1d-12 - - err_tot = 0.d0 - nrm_tot = 0.d0 - do i = 1, mo_num - do j = 1, mo_num - do k = 1, mo_num - do l = 1, mo_num - err_loc = dabs(noL_2e(l,k,j,i) - noL_2e_gpu(l,k,j,i)) - if(err_loc > acc_thr) then - print*, " error on", l, k, j, i - print*, " CPU res", noL_2e (l,k,j,i) - print*, " GPU res", noL_2e_gpu(l,k,j,i) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(noL_2e(l,k,j,i)) - enddo - enddo - enddo - enddo - print *, ' absolute accuracy on noL_2e (%) =', 100.d0 * err_tot / nrm_tot - - deallocate(noL_2e) - deallocate(noL_2e_gpu) - - - return - -end - -! --- - -subroutine deb_no_2e_gpu_tmp() - - use cutc_module - - implicit none - - integer :: i, j, k, l, m, ipoint - double precision :: acc_thr, err_tot, nrm_tot, err_loc - double precision, allocatable :: int2_grad1_u12_ao(:,:,:,:) - double precision, allocatable :: tmp(:,:,:,:) - double precision, allocatable :: int2_grad1_u12_bimo_t(:,:,:,:) - double precision, allocatable :: tmpO(:), tmpO_gpu(:) - double precision, allocatable :: tmpJ(:,:), tmpJ_gpu(:,:) - double precision, allocatable :: tmpA(:,:,:), tmpA_gpu(:,:,:) - double precision, allocatable :: tmpB(:,:,:), tmpB_gpu(:,:,:) - double precision, allocatable :: tmpC(:,:,:,:), tmpC_gpu(:,:,:,:) - double precision, allocatable :: tmpD(:,:,:,:), tmpD_gpu(:,:,:,:) - double precision, allocatable :: tmpE(:,:,:,:), tmpE_gpu(:,:,:,:) - double precision, allocatable :: noL_2e(:,:,:,:), noL_2e_gpu(:,:,:,:) - - - PROVIDE mo_l_coef mo_r_coef - PROVIDE mos_l_in_r_array_transp mos_r_in_r_array_transp - - - allocate(int2_grad1_u12_ao(ao_num,ao_num,n_points_final_grid,3)) - print*, ' Reading int2_grad1_u12_ao from ', trim(ezfio_filename) // '/work/int2_grad1_u12_ao' - open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/int2_grad1_u12_ao', action="read") - read(11) int2_grad1_u12_ao - close(11) - - allocate(tmp(mo_num,mo_num,n_points_final_grid,3)) - allocate(int2_grad1_u12_bimo_t(n_points_final_grid,3,mo_num,mo_num)) - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint) & - !$OMP SHARED (ao_num, mo_num, n_points_final_grid, int2_grad1_u12_ao, tmp) - !$OMP DO SCHEDULE (dynamic) - do ipoint = 1, n_points_final_grid - call ao_to_mo_bi_ortho(int2_grad1_u12_ao(1,1,ipoint,1), ao_num, tmp(1,1,ipoint,1), mo_num) - call ao_to_mo_bi_ortho(int2_grad1_u12_ao(1,1,ipoint,2), ao_num, tmp(1,1,ipoint,2), mo_num) - call ao_to_mo_bi_ortho(int2_grad1_u12_ao(1,1,ipoint,3), ao_num, tmp(1,1,ipoint,3), mo_num) - enddo - !$OMP END DO - !$OMP END PARALLEL - - deallocate(int2_grad1_u12_ao) - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, j, ipoint) & - !$OMP SHARED (mo_num, n_points_final_grid, tmp, int2_grad1_u12_bimo_t) - !$OMP DO COLLAPSE(2) SCHEDULE (dynamic) - do ipoint = 1, n_points_final_grid - do i = 1, mo_num - do j = 1, mo_num - int2_grad1_u12_bimo_t(ipoint,1,j,i) = tmp(j,i,ipoint,1) - int2_grad1_u12_bimo_t(ipoint,2,j,i) = tmp(j,i,ipoint,2) - int2_grad1_u12_bimo_t(ipoint,3,j,i) = tmp(j,i,ipoint,3) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - deallocate(tmp) - - ! --- - - allocate(tmpO_gpu(n_points_final_grid)) - allocate(tmpJ_gpu(n_points_final_grid,3)) - allocate(tmpA_gpu(n_points_final_grid,3,mo_num)) - allocate(tmpB_gpu(n_points_final_grid,3,mo_num)) - allocate(tmpC_gpu(n_points_final_grid,4,mo_num,mo_num)) - allocate(tmpD_gpu(n_points_final_grid,4,mo_num,mo_num)) - allocate(tmpE_gpu(mo_num,mo_num,mo_num,mo_num)) - allocate(noL_2e_gpu(mo_num,mo_num,mo_num,mo_num)) - - call deb_no_2e(n_points_final_grid, mo_num, elec_alpha_num, elec_beta_num, & - final_weight_at_r_vector(1), & - mos_l_in_r_array_transp(1,1), mos_r_in_r_array_transp(1,1), & - int2_grad1_u12_bimo_t(1,1,1,1), & - tmpO_gpu(1), tmpJ_gpu(1,1), tmpA_gpu(1,1,1), tmpB_gpu(1,1,1), & - tmpC_gpu(1,1,1,1), tmpD_gpu(1,1,1,1), tmpE_gpu(1,1,1,1), & - noL_2e_gpu(1,1,1,1)) - - ! --- - - allocate(tmpO(n_points_final_grid)) - allocate(tmpJ(n_points_final_grid,3)) - allocate(tmpA(n_points_final_grid,3,mo_num)) - allocate(tmpB(n_points_final_grid,3,mo_num)) - allocate(tmpC(n_points_final_grid,4,mo_num,mo_num)) - allocate(tmpD(n_points_final_grid,4,mo_num,mo_num)) - allocate(tmpE(mo_num,mo_num,mo_num,mo_num)) - allocate(noL_2e(mo_num,mo_num,mo_num,mo_num)) - - call provide_no_2e_tmp(n_points_final_grid, mo_num, elec_alpha_num, elec_beta_num, & - final_weight_at_r_vector(1), & - mos_l_in_r_array_transp(1,1), mos_r_in_r_array_transp(1,1), & - int2_grad1_u12_bimo_t(1,1,1,1), & - tmpO(1), tmpJ(1,1), tmpA(1,1,1), tmpB(1,1,1), & - tmpC(1,1,1,1), tmpD(1,1,1,1), tmpE(1,1,1,1), & - noL_2e(1,1,1,1)) - - ! --- - - deallocate(int2_grad1_u12_bimo_t) - - acc_thr = 1d-12 - - ! --- - - err_tot = 0.d0 - nrm_tot = 0.d0 - do ipoint = 1, n_points_final_grid - err_loc = dabs(tmpO(ipoint) - tmpO_gpu(ipoint)) - if(err_loc > acc_thr) then - print*, " error on", ipoint - print*, " CPU res", tmpO (ipoint) - print*, " GPU res", tmpO_gpu(ipoint) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(tmpO(ipoint)) - enddo - print *, ' absolute accuracy on tmpO (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - err_tot = 0.d0 - nrm_tot = 0.d0 - do m = 1, 3 - do ipoint = 1, n_points_final_grid - err_loc = dabs(tmpJ(ipoint,m) - tmpJ_gpu(ipoint,m)) - if(err_loc > acc_thr) then - print*, " error on", ipoint, m - print*, " CPU res", tmpJ (ipoint,m) - print*, " GPU res", tmpJ_gpu(ipoint,m) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(tmpJ(ipoint,m)) - enddo - enddo - print *, ' absolute accuracy on tmpJ (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - err_tot = 0.d0 - nrm_tot = 0.d0 - do i = 1, mo_num - do m = 1, 3 - do ipoint = 1, n_points_final_grid - err_loc = dabs(tmpA(ipoint,m,i) - tmpA_gpu(ipoint,m,i)) - if(err_loc > acc_thr) then - print*, " error on", ipoint, m, i - print*, " CPU res", tmpA (ipoint,m,i) - print*, " GPU res", tmpA_gpu(ipoint,m,i) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(tmpA(ipoint,m,i)) - enddo - enddo - enddo - print *, ' absolute accuracy on tmpA (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - err_tot = 0.d0 - nrm_tot = 0.d0 - do i = 1, mo_num - do m = 1, 3 - do ipoint = 1, n_points_final_grid - err_loc = dabs(tmpB(ipoint,m,i) - tmpB_gpu(ipoint,m,i)) - if(err_loc > acc_thr) then - print*, " error on", ipoint, m, i - print*, " CPU res", tmpB (ipoint,m,i) - print*, " GPU res", tmpB_gpu(ipoint,m,i) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(tmpB(ipoint,m,i)) - enddo - enddo - enddo - print *, ' absolute accuracy on tmpB (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - err_tot = 0.d0 - nrm_tot = 0.d0 - do i = 1, mo_num - do j = 1, mo_num - do m = 1, 3 - do ipoint = 1, n_points_final_grid - err_loc = dabs(tmpC(ipoint,m,i,j) - tmpC_gpu(ipoint,m,i,j)) - if(err_loc > acc_thr) then - print*, " error on", ipoint, m, i, j - print*, " CPU res", tmpC (ipoint,m,i,j) - print*, " GPU res", tmpC_gpu(ipoint,m,i,j) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(tmpC(ipoint,m,i,j)) - enddo - enddo - enddo - enddo - print *, ' absolute accuracy on tmpC (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - err_tot = 0.d0 - nrm_tot = 0.d0 - do i = 1, mo_num - do j = 1, mo_num - do m = 1, 3 - do ipoint = 1, n_points_final_grid - err_loc = dabs(tmpD(ipoint,m,i,j) - tmpD_gpu(ipoint,m,i,j)) - if(err_loc > acc_thr) then - print*, " error on", ipoint, m, i, j - print*, " CPU res", tmpD (ipoint,m,i,j) - print*, " GPU res", tmpD_gpu(ipoint,m,i,j) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(tmpD(ipoint,m,i,j)) - enddo - enddo - enddo - enddo - print *, ' absolute accuracy on tmpD (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - err_tot = 0.d0 - nrm_tot = 0.d0 - do i = 1, mo_num - do j = 1, mo_num - do k = 1, mo_num - do l = 1, mo_num - err_loc = dabs(tmpE(l,k,j,i) - tmpE_gpu(l,k,j,i)) - if(err_loc > acc_thr) then - print*, " error on", l, k, j, i - print*, " CPU res", tmpE (l,k,j,i) - print*, " GPU res", tmpE_gpu(l,k,j,i) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(tmpE(l,k,j,i)) - enddo - enddo - enddo - enddo - print *, ' absolute accuracy on tmpE (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - err_tot = 0.d0 - nrm_tot = 0.d0 - do i = 1, mo_num - do j = 1, mo_num - do k = 1, mo_num - do l = 1, mo_num - err_loc = dabs(noL_2e(l,k,j,i) - noL_2e_gpu(l,k,j,i)) - if(err_loc > acc_thr) then - print*, " error on", l, k, j, i - print*, " CPU res", noL_2e (l,k,j,i) - print*, " GPU res", noL_2e_gpu(l,k,j,i) - stop - endif - err_tot = err_tot + err_loc - nrm_tot = nrm_tot + dabs(noL_2e(l,k,j,i)) - enddo - enddo - enddo - enddo - print *, ' absolute accuracy on noL_2e (%) =', 100.d0 * err_tot / nrm_tot - - ! --- - - deallocate(tmpO, tmpO_gpu) - deallocate(tmpJ, tmpJ_gpu) - deallocate(tmpA, tmpA_gpu) - deallocate(tmpB, tmpB_gpu) - deallocate(tmpC, tmpC_gpu) - deallocate(tmpD, tmpD_gpu) - deallocate(tmpE, tmpE_gpu) - deallocate(noL_2e, noL_2e_gpu) - - return -end - - diff --git a/plugins/local/tc_int/deb_no_gpu.irp.f b/plugins/local/tc_int/deb_no_gpu.irp.f index e14404e6..de8adb97 100644 --- a/plugins/local/tc_int/deb_no_gpu.irp.f +++ b/plugins/local/tc_int/deb_no_gpu.irp.f @@ -1,13 +1,47 @@ ! --- -subroutine deb_no_gpu() +program deb_no_gpu + + implicit none + + print *, ' j2e_type = ', j2e_type + print *, ' j1e_type = ', j1e_type + print *, ' env_type = ', env_type + + my_grid_becke = .True. + PROVIDE tc_grid1_a tc_grid1_r + my_n_pt_r_grid = tc_grid1_r + my_n_pt_a_grid = tc_grid1_a + touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid + + my_extra_grid_becke = .True. + PROVIDE tc_grid2_a tc_grid2_r + my_n_pt_r_extra_grid = tc_grid2_r + my_n_pt_a_extra_grid = tc_grid2_a + touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid + + call write_int(6, my_n_pt_r_grid, 'radial external grid over') + call write_int(6, my_n_pt_a_grid, 'angular external grid over') + + call write_int(6, my_n_pt_r_extra_grid, 'radial internal grid over') + call write_int(6, my_n_pt_a_extra_grid, 'angular internal grid over') + + call main() + +end + +! --- + +subroutine main() use cutc_module implicit none integer :: i, j, k, l, ipoint + double precision :: time0, time1 + double precision :: tt0, tt1 double precision :: acc_thr, err_tot, nrm_tot, err_loc double precision :: noL_0e double precision :: noL_0e_gpu(1) @@ -24,15 +58,24 @@ subroutine deb_no_gpu() PROVIDE mos_l_in_r_array_transp mos_r_in_r_array_transp + call wall_time(time0) + print*, ' start deb_no_gpu' + + + allocate(int2_grad1_u12_ao(ao_num,ao_num,n_points_final_grid,3)) print*, ' Reading int2_grad1_u12_ao from ', trim(ezfio_filename) // '/work/int2_grad1_u12_ao' + call wall_time(tt0) open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/int2_grad1_u12_ao', action="read") read(11) int2_grad1_u12_ao close(11) + call wall_time(tt1) + write(*,"(A,2X,F15.7)") ' wall time for reading (sec) = ', (tt1 - tt0) allocate(tmp(mo_num,mo_num,n_points_final_grid,3)) allocate(int2_grad1_u12_bimo_t(n_points_final_grid,3,mo_num,mo_num)) + call wall_time(tt0) !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (ipoint) & @@ -64,6 +107,8 @@ subroutine deb_no_gpu() enddo !$OMP END DO !$OMP END PARALLEL + call wall_time(tt1) + write(*,"(A,2X,F15.7)") ' wall time for 3e-tensor (sec) = ', (tt1 - tt0) deallocate(tmp) @@ -161,6 +206,9 @@ subroutine deb_no_gpu() print *, ' absolute accuracy on noL_0e (%) =', 100.d0 * err_tot / nrm_tot + call wall_time(time1) + write(*,"(A,2X,F15.7)") ' wall time for deb_no_gpu (sec) = ', (time1 - time0) + return end diff --git a/plugins/local/tc_int/deb_tc_int_cuda.irp.f b/plugins/local/tc_int/deb_tc_int_cuda.irp.f deleted file mode 100644 index ad20d861..00000000 --- a/plugins/local/tc_int/deb_tc_int_cuda.irp.f +++ /dev/null @@ -1,55 +0,0 @@ -! --- - -program write_tc_int_cuda - - implicit none - - print *, ' j2e_type = ', j2e_type - print *, ' j1e_type = ', j1e_type - print *, ' env_type = ', env_type - - my_grid_becke = .True. - PROVIDE tc_grid1_a tc_grid1_r - my_n_pt_r_grid = tc_grid1_r - my_n_pt_a_grid = tc_grid1_a - touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid - - my_extra_grid_becke = .True. - PROVIDE tc_grid2_a tc_grid2_r - my_n_pt_r_extra_grid = tc_grid2_r - my_n_pt_a_extra_grid = tc_grid2_a - touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid - - call write_int(6, my_n_pt_r_grid, 'radial external grid over') - call write_int(6, my_n_pt_a_grid, 'angular external grid over') - - call write_int(6, my_n_pt_r_extra_grid, 'radial internal grid over') - call write_int(6, my_n_pt_a_extra_grid, 'angular internal grid over') - - call main() - -end - -! --- - -subroutine main() - - implicit none - - !call deb_int_2e_ao_gpu() - - !call deb_no_2e_gpu_tmp() - !call deb_no_2e_gpu() - - !call deb_no_1e_gpu_tmp() - !call deb_no_1e_gpu() - - !call deb_no_0e_gpu() - - call deb_no_gpu() - - return -end - -! --- -