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 : !> \brief sets variables for the qmmm pool of pw_types
10 : !> \author Teodoro Laino
11 : ! **************************************************************************************************
12 : MODULE qmmm_pw_grid
13 : USE input_constants, ONLY: do_par_atom,&
14 : do_qmmm_gauss,&
15 : do_qmmm_swave
16 : USE kinds, ONLY: dp,&
17 : int_8
18 : USE pw_env_types, ONLY: pw_env_get,&
19 : pw_env_type
20 : USE pw_grid_types, ONLY: FULLSPACE,&
21 : PW_MODE_DISTRIBUTED,&
22 : PW_MODE_LOCAL,&
23 : pw_grid_type
24 : USE pw_grids, ONLY: pw_grid_release
25 : USE pw_pool_types, ONLY: pw_pool_create,&
26 : pw_pool_p_type,&
27 : pw_pool_type,&
28 : pw_pools_dealloc
29 : USE qmmm_types_low, ONLY: qmmm_env_qm_type
30 : #include "./base/base_uses.f90"
31 :
32 : IMPLICIT NONE
33 :
34 : PRIVATE
35 : PUBLIC :: qmmm_pw_grid_init
36 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qmmm_pw_grid'
37 : INTEGER :: qmmm_grid_tag = 0
38 :
39 : CONTAINS
40 :
41 : ! **************************************************************************************************
42 : !> \brief Initialize the qmmm pool of pw_r3d_rs_type.
43 : !> Then Main difference w.r.t. QS pw_r3d_rs_type pools is that this pool
44 : !> has [0,L] as boundaries.
45 : !> \param qmmm_env ...
46 : !> \param pw_env ...
47 : !> \par History
48 : !> 08.2004 created [tlaino]
49 : !> \author Teodoro Laino
50 : ! **************************************************************************************************
51 394 : SUBROUTINE qmmm_pw_grid_init(qmmm_env, pw_env)
52 : TYPE(qmmm_env_qm_type), POINTER :: qmmm_env
53 : TYPE(pw_env_type), POINTER :: pw_env
54 :
55 : INTEGER :: auxbas_grid, Ilevel, pw_mode
56 : REAL(KIND=dp), DIMENSION(3) :: Maxdr, Mindr
57 : TYPE(pw_grid_type), POINTER :: el_struct
58 394 : TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools
59 : TYPE(pw_pool_type), POINTER :: pool
60 :
61 394 : NULLIFY (el_struct)
62 1576 : Maxdr = TINY(0.0_dp)
63 1576 : Mindr = HUGE(0.0_dp)
64 394 : IF ((qmmm_env%qmmm_coupl_type == do_qmmm_gauss) .OR. (qmmm_env%qmmm_coupl_type == do_qmmm_swave)) THEN
65 : CALL pw_env_get(pw_env=pw_env, &
66 : pw_pools=pw_pools, &
67 248 : auxbas_grid=auxbas_grid)
68 : !
69 248 : IF (ASSOCIATED(qmmm_env%aug_pools)) THEN
70 0 : CALL pw_pools_dealloc(qmmm_env%aug_pools)
71 : END IF
72 1752 : ALLOCATE (qmmm_env%aug_pools(SIZE(pw_pools)))
73 : !
74 1504 : DO Ilevel = 1, SIZE(pw_pools)
75 1008 : NULLIFY (pool, qmmm_env%aug_pools(Ilevel)%pool)
76 1008 : pool => pw_pools(Ilevel)%pool
77 1008 : NULLIFY (el_struct)
78 1008 : pw_mode = PW_MODE_DISTRIBUTED
79 : ! Parallelization scheme
80 1008 : IF (qmmm_env%par_scheme == do_par_atom) THEN
81 1000 : pw_mode = PW_MODE_LOCAL
82 : END IF
83 :
84 : CALL pw_grid_create_copy_no_pbc(pool%pw_grid, el_struct, &
85 1008 : pw_mode=pw_mode)
86 : CALL pw_pool_create(qmmm_env%aug_pools(Ilevel)%pool, &
87 1008 : pw_grid=el_struct)
88 :
89 4032 : Maxdr = MAX(Maxdr, el_struct%dr)
90 4032 : Mindr = MIN(Mindr, el_struct%dr)
91 4032 : IF (ALL(Maxdr .EQ. el_struct%dr)) qmmm_env%gridlevel_info%coarser_grid = Ilevel
92 1752 : IF (ALL(Mindr .EQ. el_struct%dr)) qmmm_env%gridlevel_info%auxbas_grid = Ilevel
93 :
94 1256 : CALL pw_grid_release(el_struct)
95 :
96 : END DO
97 : END IF
98 :
99 394 : END SUBROUTINE qmmm_pw_grid_init
100 :
101 : ! **************************************************************************************************
102 : !> \brief creates a copy of pw_grid_in in which the pbc have been removed
103 : !> (by adding a point for the upper boundary)
104 : !> \param pw_grid_in the pw grid to duplicate
105 : !> \param pw_grid_out the output pw_grid_type
106 : !> \param pw_mode ...
107 : !> \par History
108 : !> 08.2004 created [tlaino]
109 : !> 04.2005 completely rewritten the duplicate routine, fixed parallel
110 : !> behaviour, narrowed scope to copy to non pbc and renamed
111 : !> accordingly [fawzi]
112 : !> 06.2007 moved to new module [jgh]
113 : !> \author Fawzi, Teo
114 : ! **************************************************************************************************
115 1008 : SUBROUTINE pw_grid_create_copy_no_pbc(pw_grid_in, pw_grid_out, pw_mode)
116 : TYPE(pw_grid_type), POINTER :: pw_grid_in, pw_grid_out
117 : INTEGER, INTENT(IN), OPTIONAL :: pw_mode
118 :
119 : INTEGER :: pw_mode_loc
120 1008 : INTEGER, ALLOCATABLE, DIMENSION(:) :: pos_of_x
121 :
122 1008 : CPASSERT(pw_grid_in%ngpts_cut > 0)
123 1008 : CPASSERT(.NOT. ASSOCIATED(pw_grid_out))
124 1008 : pw_mode_loc = pw_grid_in%para%mode
125 1008 : IF (PRESENT(pw_mode)) pw_mode_loc = pw_mode
126 : ! TODO: introduce pw_grid_create_from_grid
127 59472 : ALLOCATE (pw_grid_out)
128 1008 : CALL pw_grid_out%para%group%from_dup(pw_grid_in%para%group)
129 1008 : qmmm_grid_tag = qmmm_grid_tag + 1
130 1008 : pw_grid_out%id_nr = qmmm_grid_tag
131 1008 : pw_grid_out%ref_count = 1
132 1008 : pw_grid_out%reference = 0
133 20160 : pw_grid_out%bounds = pw_grid_in%bounds
134 4032 : pw_grid_out%bounds(2, :) = pw_grid_out%bounds(2, :) + 1
135 1008 : IF (pw_mode_loc == PW_MODE_DISTRIBUTED) THEN
136 160 : pw_grid_out%bounds_local = pw_grid_in%bounds_local
137 8 : IF (pw_grid_in%bounds_local(2, 1) == pw_grid_in%bounds(2, 1) .AND. &
138 : pw_grid_in%bounds_local(1, 1) <= pw_grid_in%bounds(2, 1)) THEN
139 4 : pw_grid_out%bounds_local(2, 1) = pw_grid_out%bounds_local(2, 1) + 1
140 : END IF
141 8 : pw_grid_out%bounds_local(2, 2) = pw_grid_out%bounds_local(2, 2) + 1
142 8 : pw_grid_out%bounds_local(2, 3) = pw_grid_out%bounds_local(2, 3) + 1
143 : ELSE
144 10000 : pw_grid_out%bounds_local = pw_grid_out%bounds
145 : END IF
146 8064 : pw_grid_out%npts = pw_grid_in%npts + 1
147 4032 : pw_grid_out%ngpts = PRODUCT(INT(pw_grid_out%npts, KIND=int_8))
148 1008 : pw_grid_out%ngpts_cut = 0
149 4032 : pw_grid_out%npts_local = pw_grid_out%bounds_local(2, :) - pw_grid_out%bounds_local(1, :) + 1
150 4032 : pw_grid_out%ngpts_local = PRODUCT(pw_grid_out%npts_local)
151 1008 : pw_grid_out%ngpts_cut_local = 0
152 8064 : pw_grid_out%dr = pw_grid_in%dr
153 26208 : pw_grid_out%dh = pw_grid_in%dh
154 26208 : pw_grid_out%dh_inv = pw_grid_in%dh_inv
155 1008 : pw_grid_out%orthorhombic = pw_grid_in%orthorhombic
156 1008 : pw_grid_out%dvol = pw_grid_in%dvol
157 : pw_grid_out%vol = pw_grid_in%vol*REAL(pw_grid_out%ngpts, dp) &
158 1008 : /REAL(pw_grid_in%ngpts, dp) !FM do not modify?
159 1008 : pw_grid_out%cutoff = pw_grid_in%cutoff
160 :
161 : !para
162 1008 : pw_grid_out%para%mode = pw_mode_loc
163 3024 : ALLOCATE (pos_of_x(pw_grid_out%bounds(1, 1):pw_grid_out%bounds(2, 1)))
164 27138 : pos_of_x(:pw_grid_out%bounds(2, 1) - 1) = pw_grid_in%para%pos_of_x
165 1008 : pos_of_x(pw_grid_out%bounds(2, 1)) = pos_of_x(pw_grid_out%bounds(2, 1) - 1)
166 1008 : CALL MOVE_ALLOC(pos_of_x, pw_grid_out%para%pos_of_x)
167 :
168 1008 : NULLIFY (pw_grid_out%g, pw_grid_out%gsq)
169 1008 : CPASSERT(pw_grid_in%grid_span == FULLSPACE)
170 1008 : pw_grid_out%grid_span = pw_grid_in%grid_span
171 1008 : pw_grid_out%have_g0 = .FALSE.
172 1008 : pw_grid_out%first_gne0 = HUGE(0)
173 1008 : NULLIFY (pw_grid_out%gidx)
174 1008 : pw_grid_out%spherical = .FALSE.
175 1008 : pw_grid_out%para%ray_distribution = .FALSE.
176 1008 : pw_grid_out%para%blocked = .FALSE.
177 1008 : END SUBROUTINE pw_grid_create_copy_no_pbc
178 : END MODULE qmmm_pw_grid
|
