Skip to content
Permalink
Browse files

RPA: Split rpa_im_time.F

A lot of routines in this module are used for a specific purpose (GW, kpoints...). I moved them to their respective new modules. It also reduces the size of rpa_im_time.F. (It contained ca. 6000 lines of code.)
  • Loading branch information...
fstein93 authored and dev-zero committed Jun 18, 2019
1 parent 67af1f7 commit ea35456034a087d983313f091066793793261613
Showing with 2,094 additions and 2,039 deletions.
  1. +1 −1 src/bse.F
  2. +1 −1 src/mp2_integrals.F
  3. +97 −2 src/mp2_weights.F
  4. +86 −1 src/rpa_communication.F
  5. +1 −1 src/rpa_gw.F
  6. +1 −1 src/rpa_gw_ic.F
  7. +1,369 −0 src/rpa_gw_im_time_util.F
  8. +2 −2 src/rpa_gw_kpoints.F
  9. +238 −2,022 src/rpa_im_time.F
  10. +297 −6 src/rpa_kpoints.F
  11. +1 −2 src/rpa_main.F
@@ -26,7 +26,7 @@ MODULE bse
USE message_passing, ONLY: mp_alltoall,&
mp_sum
USE mp2_types, ONLY: integ_mat_buffer_type
USE rpa_im_time, ONLY: communicate_buffer
USE rpa_communication, ONLY: communicate_buffer
#include "./base/base_uses.f90"

IMPLICIT NONE
@@ -140,7 +140,7 @@ MODULE mp2_integrals
realspace_grid_p_type,&
rs_grid_release,&
rs_grid_retain
USE rpa_im_time, ONLY: communicate_buffer
USE rpa_communication, ONLY: communicate_buffer
USE rs_pw_interface, ONLY: potential_pw2rs
USE task_list_types, ONLY: task_list_type
USE util, ONLY: get_limit
@@ -15,6 +15,9 @@ MODULE mp2_weights
cp_para_env_release
USE cp_para_types, ONLY: cp_para_env_type
USE kinds, ONLY: dp
USE kpoint_types, ONLY: get_kpoint_info,&
kpoint_env_type,&
kpoint_type
USE machine, ONLY: m_flush
USE mathconstants, ONLY: pi
USE message_passing, ONLY: mp_bcast,&
@@ -23,8 +26,10 @@ MODULE mp2_weights
USE minimax_exp, ONLY: get_exp_minimax_coeff
USE minimax_rpa, ONLY: get_rpa_minimax_coeff
USE mp2_types, ONLY: mp2_type
USE qs_environment_types, ONLY: qs_environment_type
USE rpa_im_time, ONLY: gap_and_max_eig_diff_kpoints
USE qs_environment_types, ONLY: get_qs_env,&
qs_environment_type
USE qs_mo_types, ONLY: get_mo_set,&
mo_set_type
#include "./base/base_uses.f90"

IMPLICIT NONE
@@ -1474,4 +1479,94 @@ PURE SUBROUTINE eval_fit_func_omega_grid_cosine(func_val, x_value, num_integ_poi

END SUBROUTINE eval_fit_func_omega_grid_cosine

! **************************************************************************************************
!> \brief ...
!> \param qs_env ...
!> \param para_env ...
!> \param gap ...
!> \param max_eig_diff ...
!> \param e_fermi ...
! **************************************************************************************************
SUBROUTINE gap_and_max_eig_diff_kpoints(qs_env, para_env, gap, max_eig_diff, e_fermi)

TYPE(qs_environment_type), POINTER :: qs_env
TYPE(cp_para_env_type), POINTER :: para_env
REAL(KIND=dp), INTENT(OUT) :: gap, max_eig_diff, e_fermi

CHARACTER(LEN=*), PARAMETER :: routineN = 'gap_and_max_eig_diff_kpoints', &
routineP = moduleN//':'//routineN

INTEGER :: handle, homo, ikpgr, ispin, kplocal, &
nmo, nspin
INTEGER, DIMENSION(2) :: kp_range
REAL(KIND=dp) :: e_homo, e_homo_temp, e_lumo, e_lumo_temp
REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: e_homo_array, e_lumo_array, &
max_eig_diff_array
REAL(KIND=dp), DIMENSION(:), POINTER :: eigenvalues
TYPE(kpoint_env_type), POINTER :: kp
TYPE(kpoint_type), POINTER :: kpoint
TYPE(mo_set_type), POINTER :: mo_set

CALL timeset(routineN, handle)

CALL get_qs_env(qs_env, &
kpoints=kpoint)

mo_set => kpoint%kp_env(1)%kpoint_env%mos(1, 1)%mo_set
CALL get_mo_set(mo_set, nmo=nmo)

CALL get_kpoint_info(kpoint, kp_range=kp_range)
kplocal = kp_range(2)-kp_range(1)+1

gap = 1000.0_dp
max_eig_diff = 0.0_dp
e_homo = -1000.0_dp
e_lumo = 1000.0_dp

DO ikpgr = 1, kplocal
kp => kpoint%kp_env(ikpgr)%kpoint_env
nspin = SIZE(kp%mos, 2)
DO ispin = 1, nspin
mo_set => kp%mos(1, ispin)%mo_set
CALL get_mo_set(mo_set, eigenvalues=eigenvalues, homo=homo)
e_homo_temp = eigenvalues(homo)
e_lumo_temp = eigenvalues(homo+1)

IF (e_homo_temp > e_homo) e_homo = e_homo_temp
IF (e_lumo_temp < e_lumo) e_lumo = e_lumo_temp
IF (eigenvalues(nmo)-eigenvalues(1) > max_eig_diff) max_eig_diff = eigenvalues(nmo)-eigenvalues(1)

END DO
END DO

ALLOCATE (e_homo_array(0:para_env%num_pe-1))
e_homo_array = 0.0_dp
e_homo_array(para_env%mepos) = e_homo

ALLOCATE (e_lumo_array(0:para_env%num_pe-1))
e_lumo_array = 0.0_dp
e_lumo_array(para_env%mepos) = e_lumo

ALLOCATE (max_eig_diff_array(0:para_env%num_pe-1))
max_eig_diff_array = 0.0_dp
max_eig_diff_array(para_env%mepos) = max_eig_diff

CALL mp_sum(e_homo_array, para_env%group)

CALL mp_sum(e_lumo_array, para_env%group)

CALL mp_sum(max_eig_diff_array, para_env%group)

gap = MINVAL(e_lumo_array)-MAXVAL(e_homo_array)

e_fermi = (MAXVAL(e_homo_array)+MINVAL(e_lumo_array))/2.0_dp

max_eig_diff = MAXVAL(max_eig_diff_array)

DEALLOCATE (max_eig_diff_array, e_homo_array, e_lumo_array)

CALL timestop(handle)

END SUBROUTINE

END MODULE mp2_weights
@@ -60,7 +60,8 @@ MODULE rpa_communication
PUBLIC :: initialize_buffer, &
fm_redistribute, &
release_buffer, &
gamma_fm_to_dbcsr
gamma_fm_to_dbcsr, &
communicate_buffer

CONTAINS

@@ -971,4 +972,88 @@ SUBROUTINE gamma_fm_to_dbcsr(fm_mat_Gamma_3, dbcsr_Gamma_3, para_env_RPA, para_e

END SUBROUTINE gamma_fm_to_dbcsr

! **************************************************************************************************
!> \brief ...
!> \param para_env ...
!> \param num_entries_rec ...
!> \param num_entries_send ...
!> \param buffer_rec ...
!> \param buffer_send ...
!> \param req_array ...
!> \param do_indx ...
!> \param do_msg ...
! **************************************************************************************************
SUBROUTINE communicate_buffer(para_env, num_entries_rec, num_entries_send, buffer_rec, buffer_send, &
req_array, do_indx, do_msg)

TYPE(cp_para_env_type), POINTER :: para_env
INTEGER, ALLOCATABLE, DIMENSION(:), INTENT(IN) :: num_entries_rec, num_entries_send
TYPE(integ_mat_buffer_type), ALLOCATABLE, &
DIMENSION(:), INTENT(INOUT) :: buffer_rec, buffer_send
INTEGER, DIMENSION(:, :), POINTER :: req_array
LOGICAL, INTENT(IN), OPTIONAL :: do_indx, do_msg

CHARACTER(LEN=*), PARAMETER :: routineN = 'communicate_buffer', &
routineP = moduleN//':'//routineN

INTEGER :: handle, imepos, rec_counter, send_counter
LOGICAL :: my_do_indx, my_do_msg

CALL timeset(routineN, handle)

my_do_indx = .TRUE.
IF (PRESENT(do_indx)) my_do_indx = do_indx
my_do_msg = .TRUE.
IF (PRESENT(do_msg)) my_do_msg = do_msg

IF (para_env%num_pe > 1) THEN

send_counter = 0
rec_counter = 0

DO imepos = 0, para_env%num_pe-1
IF (num_entries_rec(imepos) > 0) THEN
rec_counter = rec_counter+1
IF (my_do_indx) THEN
CALL mp_irecv(buffer_rec(imepos)%indx, imepos, para_env%group, req_array(rec_counter, 3), tag=4)
END IF
IF (my_do_msg) THEN
CALL mp_irecv(buffer_rec(imepos)%msg, imepos, para_env%group, req_array(rec_counter, 4), tag=7)
END IF
END IF
END DO

DO imepos = 0, para_env%num_pe-1
IF (num_entries_send(imepos) > 0) THEN
send_counter = send_counter+1
IF (my_do_indx) THEN
CALL mp_isend(buffer_send(imepos)%indx, imepos, para_env%group, req_array(send_counter, 1), tag=4)
END IF
IF (my_do_msg) THEN
CALL mp_isend(buffer_send(imepos)%msg, imepos, para_env%group, req_array(send_counter, 2), tag=7)
END IF
END IF
END DO

IF (my_do_indx) THEN
CALL mp_waitall(req_array(1:send_counter, 1))
CALL mp_waitall(req_array(1:rec_counter, 3))
END IF

IF (my_do_msg) THEN
CALL mp_waitall(req_array(1:send_counter, 2))
CALL mp_waitall(req_array(1:rec_counter, 4))
END IF

ELSE

buffer_rec(0)%indx = buffer_send(0)%indx
buffer_rec(0)%msg = buffer_send(0)%msg

END IF

CALL timestop(handle)

END SUBROUTINE communicate_buffer

END MODULE rpa_communication
@@ -79,7 +79,7 @@ MODULE rpa_gw
neighbor_list_set_p_type
USE qs_neighbor_lists, ONLY: setup_neighbor_list
USE qs_overlap, ONLY: build_overlap_matrix_simple
USE rpa_im_time, ONLY: get_mat_3c_overl_int_gw
USE rpa_gw_im_time_util, ONLY: get_mat_3c_overl_int_gw
#include "./base/base_uses.f90"

IMPLICIT NONE
@@ -37,7 +37,7 @@ MODULE rpa_gw_ic
USE mp2_types, ONLY: integ_mat_buffer_type,&
mp2_type
USE physcon, ONLY: evolt
USE rpa_im_time, ONLY: communicate_buffer
USE rpa_communication, ONLY: communicate_buffer
#include "./base/base_uses.f90"

IMPLICIT NONE

0 comments on commit ea35456

Please sign in to comment.
You can’t perform that action at this time.