From f59d86efbfb93e791877d8c0e1a921729b195fbd Mon Sep 17 00:00:00 2001 From: Ivan Carnimeo Date: Mon, 16 Oct 2023 14:02:12 +0200 Subject: [PATCH] Update cabec related things in ph, tddfpt, hp --- HP/src/hp_allocate_q.f90 | 10 ++-------- HP/src/hp_solve_linear_system.f90 | 17 +++++++---------- LR_Modules/ch_psi_all.f90 | 4 ++-- LR_Modules/ch_psi_all_complex.f90 | 6 ++---- PHonon/PH/allocate_phq.f90 | 9 +-------- PHonon/PH/deallocate_phq.f90 | 6 +----- TDDFPT/src/lr_alloc_init.f90 | 16 +++------------- 7 files changed, 18 insertions(+), 50 deletions(-) diff --git a/HP/src/hp_allocate_q.f90 b/HP/src/hp_allocate_q.f90 index dc8701de2..c25b629b6 100644 --- a/HP/src/hp_allocate_q.f90 +++ b/HP/src/hp_allocate_q.f90 @@ -19,7 +19,7 @@ subroutine hp_allocate_q USE noncollin_module, ONLY : npol, nspin_mag USE fft_base, ONLY : dfftp USE wavefunctions, ONLY : evc - USE becmod, ONLY : allocate_bec_type + USE becmod, ONLY : allocate_bec_type, allocate_bec_type_acc, becp USE uspp, ONLY : nkb, okvan USE qpoint, ONLY : nksq, eigqts USE lrus, ONLY : becp1 @@ -27,10 +27,6 @@ subroutine hp_allocate_q USE control_lr, ONLY : lgamma USE ldaU, ONLY : Hubbard_lmax, nwfcU USE ldaU_lr, ONLY : swfcatomk, swfcatomkpq -#if defined(__CUDA) - USE becmod_gpum, ONLY: becp_d - USE becmod_subs_gpum, ONLY: allocate_bec_type_gpu -#endif ! IMPLICIT NONE INTEGER :: ik @@ -52,10 +48,8 @@ subroutine hp_allocate_q ALLOCATE (becp1(nksq)) DO ik = 1,nksq CALL allocate_bec_type ( nkb, nbnd, becp1(ik) ) -#if defined(__CUDA) - CALL allocate_bec_type_gpu(nkb,nbnd,becp_d) -#endif ENDDO + CALL allocate_bec_type_acc(nkb,nbnd,becp) ENDIF ! ALLOCATE (swfcatomk(npwx,nwfcU)) diff --git a/HP/src/hp_solve_linear_system.f90 b/HP/src/hp_solve_linear_system.f90 index bb1881b08..56f298d8c 100644 --- a/HP/src/hp_solve_linear_system.f90 +++ b/HP/src/hp_solve_linear_system.f90 @@ -28,7 +28,7 @@ SUBROUTINE hp_solve_linear_system (na, iq) USE wvfct, ONLY : nbnd, npwx USE uspp, ONLY : okvan, nkb USE uspp_param, ONLY : nhm - USE becmod, ONLY : allocate_bec_type, deallocate_bec_type, becp + USE becmod, ONLY : allocate_bec_type_acc, deallocate_bec_type_acc, becp USE buffers, ONLY : save_buffer, get_buffer USE noncollin_module, ONLY : npol, nspin_mag USE paw_variables, ONLY : okpaw @@ -51,10 +51,6 @@ SUBROUTINE hp_solve_linear_system (na, iq) USE apply_dpot_mod, ONLY : apply_dpot_allocate, apply_dpot_deallocate USE efermi_shift, ONLY : ef_shift, def USE response_kernels, ONLY : sternheimer_kernel -#if defined(__CUDA) - USE becmod_gpum, ONLY: becp_d - USE becmod_subs_gpum, ONLY: allocate_bec_type_gpu -#endif ! IMPLICIT NONE ! @@ -137,10 +133,9 @@ SUBROUTINE hp_solve_linear_system (na, iq) ! IF (okvan) ALLOCATE (int3 ( nhm, nhm, nat, nspin_mag, 1)) IF (okpaw) ALLOCATE (int3_paw ( nhm, nhm, nat, nspin_mag, 1)) - CALL allocate_bec_type (nkb, nbnd, becp) -#if defined(__CUDA) - CALL allocate_bec_type_gpu(nkb,nbnd,becp_d) -#endif +write(*,*) '@2a' + CALL allocate_bec_type_acc (nkb, nbnd, becp) +write(*,*) '@2b' ! ALLOCATE (dbecsum((nhm*(nhm+1))/2, nat, nspin_mag, 1)) ! @@ -412,7 +407,9 @@ SUBROUTINE hp_solve_linear_system (na, iq) DEALLOCATE (t) DEALLOCATE (tmq) ENDIF - CALL deallocate_bec_type (becp) +write(*,*) '@2c' + CALL deallocate_bec_type_acc (becp) +write(*,*) '@2d' ! WRITE( stdout,*) " " WRITE( stdout,*) " =--------------------------------------------=" diff --git a/LR_Modules/ch_psi_all.f90 b/LR_Modules/ch_psi_all.f90 index 3364af37b..7526a95c1 100644 --- a/LR_Modules/ch_psi_all.f90 +++ b/LR_Modules/ch_psi_all.f90 @@ -16,7 +16,7 @@ SUBROUTINE ch_psi_all (n, h, ah, e, ik, m) USE kinds, ONLY : DP USE cell_base, ONLY : tpiba USE wvfct, ONLY : npwx, nbnd, current_k - USE becmod, ONLY : bec_type, becp, calbec + USE becmod, ONLY : becp, calbec USE uspp, ONLY : nkb, vkb USE fft_base, ONLY : dffts USE gvect, ONLY : g @@ -100,7 +100,7 @@ SUBROUTINE ch_psi_all (n, h, ah, e, ik, m) #if defined(__CUDA) !$acc host_data use_device(h, hpsi, spsi) CALL h_psi_gpu (npwx, n, m, h, hpsi) - CALL s_psi_gpu (npwx, n, m, h, spsi) + CALL s_psi_acc (npwx, n, m, h, spsi) !$acc end host_data #else CALL h_psi (npwx, n, m, h, hpsi) diff --git a/LR_Modules/ch_psi_all_complex.f90 b/LR_Modules/ch_psi_all_complex.f90 index 338d07122..4734b2f4d 100644 --- a/LR_Modules/ch_psi_all_complex.f90 +++ b/LR_Modules/ch_psi_all_complex.f90 @@ -16,7 +16,7 @@ SUBROUTINE ch_psi_all_complex (n, h, ah, e, ik, m) USE kinds, ONLY : DP USE cell_base, ONLY : tpiba USE wvfct, ONLY : npwx, nbnd, current_k - USE becmod, ONLY : bec_type, becp, calbec + USE becmod, ONLY : becp, calbec USE uspp, ONLY : nkb, vkb USE fft_base, ONLY : dffts USE gvect, ONLY : g @@ -99,7 +99,7 @@ SUBROUTINE ch_psi_all_complex (n, h, ah, e, ik, m) !$acc data present(h, hpsi, spsi) !$acc host_data use_device(h, hpsi, spsi) CALL h_psi_gpu (npwx, n, m, h, hpsi) - CALL s_psi_gpu (npwx, n, m, h, spsi) + CALL s_psi_acc (npwx, n, m, h, spsi) !$acc end host_data !$acc end data @@ -167,7 +167,6 @@ CONTAINS ! ! K-point part ! - USE becmod, ONLY : becp, calbec #if defined(__CUDA) USE cublas #endif @@ -259,7 +258,6 @@ CONTAINS ! ! gamma_only case ! - USE becmod, ONLY : becp, calbec USE realus, ONLY : real_space, invfft_orbital_gamma, & fwfft_orbital_gamma, calbec_rs_gamma, s_psir_gamma use gvect, only : gstart diff --git a/PHonon/PH/allocate_phq.f90 b/PHonon/PH/allocate_phq.f90 index 4b4e745e4..3a0ecb757 100644 --- a/PHonon/PH/allocate_phq.f90 +++ b/PHonon/PH/allocate_phq.f90 @@ -22,7 +22,7 @@ subroutine allocate_phq USE fft_base, ONLY : dfftp USE wavefunctions, ONLY : evc USE nc_mag_aux, ONLY : int1_nc_save, deeq_nc_save - USE becmod, ONLY : bec_type, becp, allocate_bec_type, allocate_bec_type_acc + USE becmod, ONLY : becp, allocate_bec_type, allocate_bec_type_acc USE uspp, ONLY : okvan, nkb, vkb USE paw_variables, ONLY : okpaw USE uspp_param, ONLY : nhm @@ -47,10 +47,6 @@ subroutine allocate_phq sdwfcatomkpq, dvkb, vkbkpq, dvkbkpq USE ldaU_lr, ONLY : swfcatomk, swfcatomkpq USE qpoint_aux, ONLY : becpt, alphapt -#if defined(__CUDA) - USE becmod_gpum, ONLY: becp_d - USE becmod_subs_gpum, ONLY: allocate_bec_type_gpu -#endif IMPLICIT NONE INTEGER :: ik, ipol, ldim @@ -153,9 +149,6 @@ subroutine allocate_phq ENDDO END DO CALL allocate_bec_type_acc ( nkb, nbnd, becp ) -#if defined(__CUDA) - CALL allocate_bec_type_gpu ( nkb, nbnd, becp_d ) -#endif if (elph) then allocate (el_ph_mat( nbnd, nbnd, nksq, 3*nat)) diff --git a/PHonon/PH/deallocate_phq.f90 b/PHonon/PH/deallocate_phq.f90 index a687daef8..6c9ce25fe 100644 --- a/PHonon/PH/deallocate_phq.f90 +++ b/PHonon/PH/deallocate_phq.f90 @@ -12,7 +12,7 @@ subroutine deallocate_phq !! Deallocates the variables allocated by \(\texttt{allocate_phq}\). ! USE noncollin_module, ONLY : m_loc - USE becmod, ONLY: bec_type, becp, deallocate_bec_type_acc, & + USE becmod, ONLY: becp, deallocate_bec_type_acc, & deallocate_bec_type USE wavefunctions, ONLY: evc USE ramanm, ONLY: ramtns @@ -44,10 +44,6 @@ subroutine deallocate_phq dvkb, vkbkpq, dvkbkpq USE ldaU_lr, ONLY : swfcatomk, swfcatomkpq USE qpoint_aux, ONLY : ikmks, ikmkmqs, becpt, alphapt -#if defined(__CUDA) - USE becmod_gpum, ONLY : becp_d - USE becmod_subs_gpum, ONLY : deallocate_bec_type_gpu -#endif USE nc_mag_aux, ONLY : int1_nc_save, deeq_nc_save USE Coul_cut_2D_ph, ONLY : deallocate_2d_arrays diff --git a/TDDFPT/src/lr_alloc_init.f90 b/TDDFPT/src/lr_alloc_init.f90 index 850efdd01..4b5341550 100644 --- a/TDDFPT/src/lr_alloc_init.f90 +++ b/TDDFPT/src/lr_alloc_init.f90 @@ -28,15 +28,11 @@ SUBROUTINE lr_alloc_init() USE realus, ONLY : tg_psic USE noncollin_module, ONLY : nspin_mag, npol, noncolin USE wavefunctions, ONLY : evc - USE becmod, ONLY : allocate_bec_type, bec_type, becp + USE becmod, ONLY : allocate_bec_type_acc, becp USE lrus, ONLY : int3, int3_nc, becp1 USE eqv, ONLY : dmuxc, evq, dpsi, dvpsi USE qpoint, ONLY : nksq, eigqts USE control_lr, ONLY : nbnd_occ, nbnd_occx -#if defined(__CUDA) - USE becmod_gpum, ONLY: becp_d - USE becmod_subs_gpum, ONLY: allocate_bec_type_gpu -#endif ! IMPLICIT NONE ! @@ -273,10 +269,7 @@ CONTAINS ! IF (nkb > 0) THEN ! - IF (.not. allocated(becp%r)) CALL allocate_bec_type(nkb,nbnd,becp) -#if defined(__CUDA) - CALL allocate_bec_type_gpu(nkb,nbnd,becp_d) -#endif + IF (.not. allocated(becp%r)) CALL allocate_bec_type_acc(nkb,nbnd,becp) ! ALLOCATE(becp_1(nkb,nbnd)) becp_1(:,:) = 0.0d0 @@ -296,10 +289,7 @@ CONTAINS ! IF (nkb > 0) THEN ! - IF(.not. allocated(becp%k)) CALL allocate_bec_type(nkb,nbnd,becp) -#if defined(__CUDA) - CALL allocate_bec_type_gpu(nkb,nbnd,becp_d) -#endif + IF(.not. allocated(becp%k)) CALL allocate_bec_type_acc(nkb,nbnd,becp) ! IF (.NOT.eels) THEN ALLOCATE(becp1_c(nkb,nbnd,nks))