Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \note
10 : !> Copy of pw types using an optimal match strategy
11 : !> \par History
12 : !> JGH (06-May-2021) : pw_copy routine for complex match
13 : !> \author JGH
14 : ! **************************************************************************************************
15 : MODULE pw_copy_all
16 : USE kinds, ONLY: dp
17 : USE mathconstants, ONLY: z_zero
18 : USE message_passing, ONLY: mp_comm_type
19 : USE pw_grid_types, ONLY: pw_grid_type
20 : USE pw_types, ONLY: pw_c1d_gs_type
21 : #include "../base/base_uses.f90"
22 :
23 : IMPLICIT NONE
24 :
25 : PRIVATE
26 :
27 : PUBLIC :: pw_copy_match
28 :
29 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'pw_copy_all'
30 : LOGICAL, PARAMETER, PRIVATE :: debug_this_module = .FALSE.
31 :
32 : ! **************************************************************************************************
33 :
34 : CONTAINS
35 :
36 : ! **************************************************************************************************
37 : !> \brief copy a pw type variable
38 : !> \param pw1 ...
39 : !> \param pw2 ...
40 : !> \author JGH
41 : ! **************************************************************************************************
42 38 : SUBROUTINE pw_copy_match(pw1, pw2)
43 : TYPE(pw_c1d_gs_type), INTENT(IN) :: pw1
44 : TYPE(pw_c1d_gs_type), INTENT(INOUT) :: pw2
45 :
46 38 : COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:) :: cc
47 : INTEGER :: group_size, ig1, ig2, ip, jg2, me, ng1, &
48 : ng2, ngm, penow, same_order
49 38 : INTEGER, ALLOCATABLE, DIMENSION(:) :: ngr
50 38 : INTEGER, ALLOCATABLE, DIMENSION(:, :) :: g_hat
51 : INTEGER, DIMENSION(3) :: k1, k2
52 : TYPE(mp_comm_type) :: group
53 : TYPE(pw_grid_type), POINTER :: pg1, pg2
54 :
55 38 : ng1 = SIZE(pw1%array)
56 38 : ng2 = SIZE(pw2%array)
57 :
58 38 : pg1 => pw1%pw_grid
59 38 : pg2 => pw2%pw_grid
60 :
61 38 : group = pg1%para%group
62 38 : group_size = pg1%para%group%num_pe
63 38 : me = pg1%para%group%mepos
64 : ! Independently constructed grids can still have identical local ordering.
65 : ! All ranks must agree before bypassing the collective ring exchange.
66 38 : same_order = 0
67 38 : IF (ng1 == ng2) THEN
68 6773906 : IF (ALL(pg1%g_hat(1:3, 1:ng1) == pg2%g_hat(1:3, 1:ng2))) same_order = 1
69 : END IF
70 38 : CALL group%min(same_order)
71 38 : IF (same_order == 1) THEN
72 1693487 : pw2%array(:) = pw1%array(:)
73 : RETURN
74 : END IF
75 36 : ALLOCATE (ngr(group_size))
76 12 : ngr = 0
77 12 : ngr(me + 1) = pg1%ngpts_cut_local
78 12 : CALL group%sum(ngr)
79 36 : ngm = MAXVAL(ngr)
80 36 : ALLOCATE (cc(ngm))
81 89 : cc(1:ng1) = pw1%array(1:ng1)
82 19 : cc(ng1 + 1:ngm) = z_zero
83 :
84 36 : ALLOCATE (g_hat(3, ngm))
85 12 : g_hat = 0
86 320 : g_hat(1:3, 1:ng1) = pg1%g_hat(1:3, 1:ng1)
87 :
88 36 : DO ip = 1, group_size
89 24 : penow = me - ip + 1
90 24 : IF (penow < 0) penow = penow + group_size
91 :
92 178 : DO ig1 = 1, ngr(penow + 1)
93 616 : k1(1:3) = g_hat(1:3, ig1)
94 875 : jg2 = 0
95 875 : DO ig2 = 1, ng2
96 3184 : k2(1:3) = pg2%g_hat(1:3, ig2)
97 3263 : IF (SUM(ABS(k1 - k2)) == 0) THEN
98 : jg2 = ig2
99 : EXIT
100 : END IF
101 : END DO
102 178 : IF (jg2 /= 0) pw2%array(jg2) = cc(ig1)
103 : END DO
104 36 : IF (ip /= group_size) THEN
105 12 : CALL group%shift(cc)
106 12 : CALL group%shift(g_hat)
107 : END IF
108 :
109 : END DO
110 :
111 12 : DEALLOCATE (ngr, cc, g_hat)
112 :
113 76 : END SUBROUTINE pw_copy_match
114 :
115 : END MODULE pw_copy_all
|
