1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2019  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5
6! **************************************************************************************************
7!> \brief sets variables for the qmmm pool of pw_types
8!> \author Teodoro Laino
9! **************************************************************************************************
10MODULE qmmm_pw_grid
11   USE input_constants,                 ONLY: do_par_atom,&
12                                              do_qmmm_gauss,&
13                                              do_qmmm_swave
14   USE kinds,                           ONLY: dp,&
15                                              int_8
16   USE message_passing,                 ONLY: mp_comm_dup,&
17                                              mp_environ
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_create,&
25                                              pw_grid_release
26   USE pw_pool_types,                   ONLY: pw_pool_create,&
27                                              pw_pool_p_type,&
28                                              pw_pool_type,&
29                                              pw_pools_dealloc
30   USE qmmm_types_low,                  ONLY: qmmm_env_qm_type
31#include "./base/base_uses.f90"
32
33   IMPLICIT NONE
34
35   PRIVATE
36   PUBLIC :: qmmm_pw_grid_init
37   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qmmm_pw_grid'
38   INTEGER :: qmmm_grid_tag = 0
39
40CONTAINS
41
42! **************************************************************************************************
43!> \brief Initialize the qmmm pool of pw_type.
44!>      Then Main difference w.r.t. QS pw_type pools is that this pool
45!>      has [0,L] as boundaries.
46!> \param qmmm_env ...
47!> \param pw_env ...
48!> \par History
49!>      08.2004 created [tlaino]
50!> \author Teodoro Laino
51! **************************************************************************************************
52   SUBROUTINE qmmm_pw_grid_init(qmmm_env, pw_env)
53      TYPE(qmmm_env_qm_type), POINTER                    :: qmmm_env
54      TYPE(pw_env_type), POINTER                         :: pw_env
55
56      CHARACTER(len=*), PARAMETER :: routineN = 'qmmm_pw_grid_init', &
57         routineP = moduleN//':'//routineN
58
59      INTEGER                                            :: auxbas_grid, Ilevel, pw_mode
60      REAL(KIND=dp), DIMENSION(3)                        :: Maxdr, Mindr
61      TYPE(pw_grid_type), POINTER                        :: el_struct
62      TYPE(pw_pool_p_type), DIMENSION(:), POINTER        :: pw_pools
63      TYPE(pw_pool_type), POINTER                        :: pool
64
65      NULLIFY (el_struct)
66      Maxdr = TINY(0.0_dp)
67      Mindr = HUGE(0.0_dp)
68      IF ((qmmm_env%qmmm_coupl_type == do_qmmm_gauss) .OR. (qmmm_env%qmmm_coupl_type == do_qmmm_swave)) THEN
69         CALL pw_env_get(pw_env=pw_env, &
70                         pw_pools=pw_pools, &
71                         auxbas_grid=auxbas_grid)
72         !
73         IF (ASSOCIATED(qmmm_env%aug_pools)) THEN
74            CALL pw_pools_dealloc(qmmm_env%aug_pools)
75         END IF
76         ALLOCATE (qmmm_env%aug_pools(SIZE(pw_pools)))
77         !
78         DO Ilevel = 1, SIZE(pw_pools)
79            NULLIFY (pool, qmmm_env%aug_pools(Ilevel)%pool)
80            pool => pw_pools(Ilevel)%pool
81            NULLIFY (el_struct)
82            pw_mode = PW_MODE_DISTRIBUTED
83            ! Parallelization scheme
84            IF (qmmm_env%par_scheme == do_par_atom) THEN
85               pw_mode = PW_MODE_LOCAL
86            END IF
87
88            CALL pw_grid_create_copy_no_pbc(pool%pw_grid, el_struct, &
89                                            pw_mode=pw_mode)
90            CALL pw_pool_create(qmmm_env%aug_pools(Ilevel)%pool, &
91                                pw_grid=el_struct)
92
93            Maxdr = MAX(Maxdr, el_struct%dr)
94            Mindr = MIN(Mindr, el_struct%dr)
95            IF (ALL(Maxdr .EQ. el_struct%dr)) qmmm_env%gridlevel_info%coarser_grid = Ilevel
96            IF (ALL(Mindr .EQ. el_struct%dr)) qmmm_env%gridlevel_info%auxbas_grid = Ilevel
97
98            CALL pw_grid_release(el_struct)
99
100         END DO
101      END IF
102
103   END SUBROUTINE qmmm_pw_grid_init
104
105! **************************************************************************************************
106!> \brief creates a copy of pw_grid_in in which the pbc have been removed
107!>      (by adding a point for the upper boundary)
108!> \param pw_grid_in the pw grid to duplicate
109!> \param pw_grid_out the output pw_grid_type
110!> \param pw_mode ...
111!> \par History
112!>      08.2004 created [tlaino]
113!>      04.2005 completly rewritten the duplicate routine, fixed parallel
114!>              behaviour, narrowed scope to copy to non pbc and renamed
115!>              accordingly [fawzi]
116!>      06.2007 moved to new module [jgh]
117!> \author Fawzi, Teo
118! **************************************************************************************************
119   SUBROUTINE pw_grid_create_copy_no_pbc(pw_grid_in, pw_grid_out, pw_mode)
120      TYPE(pw_grid_type), POINTER                        :: pw_grid_in, pw_grid_out
121      INTEGER, INTENT(IN), OPTIONAL                      :: pw_mode
122
123      CHARACTER(len=*), PARAMETER :: routineN = 'pw_grid_create_copy_no_pbc', &
124         routineP = moduleN//':'//routineN
125
126      INTEGER                                            :: pw_mode_loc
127      INTEGER, DIMENSION(:), POINTER                     :: pos_of_x
128
129      CPASSERT(pw_grid_in%ngpts_cut > 0)
130      CPASSERT(.NOT. ASSOCIATED(pw_grid_out))
131      pw_mode_loc = pw_grid_in%para%mode
132      IF (PRESENT(pw_mode)) pw_mode_loc = pw_mode
133      CALL pw_grid_create(pw_grid_out, pw_grid_in%para%group)
134      qmmm_grid_tag = qmmm_grid_tag + 1
135      pw_grid_out%id_nr = qmmm_grid_tag
136      pw_grid_out%ref_count = 1
137      pw_grid_out%reference = 0
138      pw_grid_out%bounds = pw_grid_in%bounds
139      pw_grid_out%bounds(2, :) = pw_grid_out%bounds(2, :) + 1
140      IF (pw_mode_loc == PW_MODE_DISTRIBUTED) THEN
141         pw_grid_out%bounds_local = pw_grid_in%bounds_local
142         IF (pw_grid_in%bounds_local(2, 1) == pw_grid_in%bounds(2, 1) .AND. &
143             pw_grid_in%bounds_local(1, 1) <= pw_grid_in%bounds(2, 1)) THEN
144            pw_grid_out%bounds_local(2, 1) = pw_grid_out%bounds_local(2, 1) + 1
145         END IF
146         pw_grid_out%bounds_local(2, 2) = pw_grid_out%bounds_local(2, 2) + 1
147         pw_grid_out%bounds_local(2, 3) = pw_grid_out%bounds_local(2, 3) + 1
148      ELSE
149         pw_grid_out%bounds_local = pw_grid_out%bounds
150      END IF
151      pw_grid_out%npts = pw_grid_in%npts + 1
152      pw_grid_out%ngpts = PRODUCT(INT(pw_grid_out%npts, KIND=int_8))
153      pw_grid_out%ngpts_cut = 0
154      pw_grid_out%npts_local = pw_grid_out%bounds_local(2, :) - pw_grid_out%bounds_local(1, :) + 1
155      pw_grid_out%ngpts_local = PRODUCT(pw_grid_out%npts_local)
156      pw_grid_out%ngpts_cut_local = 0
157      pw_grid_out%dr = pw_grid_in%dr
158      pw_grid_out%dh = pw_grid_in%dh
159      pw_grid_out%dh_inv = pw_grid_in%dh_inv
160      pw_grid_out%orthorhombic = pw_grid_in%orthorhombic
161      pw_grid_out%dvol = pw_grid_in%dvol
162      pw_grid_out%vol = pw_grid_in%vol*REAL(pw_grid_out%ngpts, dp) &
163                        /REAL(pw_grid_in%ngpts, dp) !FM do not modify?
164      pw_grid_out%cutoff = pw_grid_in%cutoff
165      NULLIFY (pw_grid_out%mapl%pos, pw_grid_out%mapl%neg, &
166               pw_grid_out%mapm%pos, pw_grid_out%mapm%neg, &
167               pw_grid_out%mapn%pos, pw_grid_out%mapn%neg)
168
169      !para
170      CALL mp_environ(pw_grid_out%para%group_size, &
171                      pw_grid_out%para%my_pos, &
172                      pw_grid_out%para%group)
173      pw_grid_out%para%group_head_id = pw_grid_in%para%group_head_id
174      pw_grid_out%para%group_head = &
175         (pw_grid_out%para%group_head_id == pw_grid_out%para%my_pos)
176      pw_grid_out%para%mode = pw_mode_loc
177      NULLIFY (pw_grid_out%para%yzp, &
178               pw_grid_out%para%yzq, &
179               pw_grid_out%para%nyzray, &
180               pw_grid_out%para%bo)
181      ALLOCATE (pos_of_x(pw_grid_out%bounds(1, 1):pw_grid_out%bounds(2, 1)))
182      pos_of_x(:pw_grid_out%bounds(2, 1) - 1) = pw_grid_in%para%pos_of_x
183      pos_of_x(pw_grid_out%bounds(2, 1)) = pos_of_x(pw_grid_out%bounds(2, 1) - 1)
184      pw_grid_out%para%pos_of_x => pos_of_x
185      pw_grid_out%para%rs_dims = pw_grid_in%para%rs_dims
186      IF (PRODUCT(pw_grid_in%para%rs_dims) /= 0) THEN
187         CALL mp_comm_dup(pw_grid_in%para%rs_group, &
188                          pw_grid_out%para%rs_group)
189      END IF
190      pw_grid_out%para%rs_pos = pw_grid_in%para%rs_pos
191      pw_grid_out%para%rs_mpo = pw_grid_in%para%rs_mpo
192
193      NULLIFY (pw_grid_out%g, pw_grid_out%gsq, pw_grid_out%g_hat)
194      CPASSERT(pw_grid_in%grid_span == FULLSPACE)
195      pw_grid_out%grid_span = pw_grid_in%grid_span
196      pw_grid_out%have_g0 = .FALSE.
197      pw_grid_out%first_gne0 = HUGE(0)
198      NULLIFY (pw_grid_out%gidx)
199      pw_grid_out%spherical = .FALSE.
200      pw_grid_out%para%ray_distribution = .FALSE.
201      pw_grid_out%para%blocked = .FALSE.
202   END SUBROUTINE pw_grid_create_copy_no_pbc
203END MODULE qmmm_pw_grid
204