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.)
cp2k · Jul 5, 2019 · ea35456 · ea35456
1 parent 67af1f7
commit ea35456
Show file tree

Hide file tree

Showing 11 changed files with 2,094 additions and 2,039 deletions.
diff --git a/src/bse.F b/src/bse.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

diff --git a/src/mp2_integrals.F b/src/mp2_integrals.F
@@ -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

diff --git a/src/mp2_weights.F b/src/mp2_weights.F
@@ -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
diff --git a/src/rpa_communication.F b/src/rpa_communication.F
@@ -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
diff --git a/src/rpa_gw.F b/src/rpa_gw.F
@@ -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

diff --git a/src/rpa_gw_ic.F b/src/rpa_gw_ic.F
@@ -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