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