Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 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 2 : 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 : COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:) :: cc
47 : INTEGER :: group_size, ig1, ig2, ip, jg2, me, ng1, &
48 : ng2, ngm, penow
49 : INTEGER, ALLOCATABLE, DIMENSION(:) :: ngr
50 : 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 2 : ng1 = SIZE(pw1%array)
56 2 : ng2 = SIZE(pw2%array)
57 :
58 2 : pg1 => pw1%pw_grid
59 2 : pg2 => pw2%pw_grid
60 :
61 2 : group = pg1%para%group
62 2 : group_size = pg1%para%group%num_pe
63 2 : me = pg1%para%group%mepos
64 6 : ALLOCATE (ngr(group_size))
65 6 : ngr = 0
66 2 : ngr(me + 1) = pg1%ngpts_cut_local
67 2 : CALL group%sum(ngr)
68 6 : ngm = MAXVAL(ngr)
69 6 : ALLOCATE (cc(ngm))
70 13826 : cc(1:ng1) = pw1%array(1:ng1)
71 2 : cc(ng1 + 1:ngm) = z_zero
72 :
73 6 : ALLOCATE (g_hat(3, ngm))
74 55298 : g_hat = 0
75 55298 : g_hat(1:3, 1:ng1) = pg1%g_hat(1:3, 1:ng1)
76 :
77 6 : DO ip = 1, group_size
78 4 : penow = me - ip + 1
79 4 : IF (penow < 0) penow = penow + group_size
80 :
81 27652 : DO ig1 = 1, ngr(penow + 1)
82 110592 : k1(1:3) = g_hat(1:3, ig1)
83 143347968 : jg2 = 0
84 143347968 : DO ig2 = 1, ng2
85 573336576 : k2(1:3) = pg2%g_hat(1:3, ig2)
86 573350400 : IF (SUM(ABS(k1 - k2)) == 0) THEN
87 : jg2 = ig2
88 : EXIT
89 : END IF
90 : END DO
91 27652 : IF (jg2 /= 0) pw2%array(jg2) = cc(ig1)
92 : END DO
93 6 : IF (ip /= group_size) THEN
94 2 : CALL group%shift(cc)
95 2 : CALL group%shift(g_hat)
96 : END IF
97 :
98 : END DO
99 :
100 2 : DEALLOCATE (ngr, cc, g_hat)
101 :
102 2 : END SUBROUTINE pw_copy_match
103 :
104 : END MODULE pw_copy_all
105 :
|
