|
CP2K 2.4 (Revision 12889)
|
00001 !-----------------------------------------------------------------------------! 00002 ! CP2K: A general program to perform molecular dynamics simulations ! 00003 ! Copyright (C) 2000 - 2013 CP2K developers group ! 00004 !-----------------------------------------------------------------------------! 00005 00006 ! ***************************************************************************** 00011 MODULE qmmm_types 00012 USE f77_blas 00013 USE force_field_types, ONLY: deallocate_inp_info,& 00014 init_inp_info,& 00015 input_info_type 00016 USE input_constants, ONLY: do_qmmm_none 00017 USE kinds, ONLY: dp 00018 USE particle_types, ONLY: allocate_particle_set,& 00019 deallocate_particle_set,& 00020 particle_type 00021 USE pw_grid_types, ONLY: pw_grid_type 00022 USE pw_grids, ONLY: pw_grid_release 00023 USE pw_pool_types, ONLY: pw_pool_give_back_pw,& 00024 pw_pool_p_type,& 00025 pw_pool_release,& 00026 pw_pool_type,& 00027 pw_pools_dealloc 00028 USE pw_types, ONLY: pw_type 00029 USE qmmm_gaussian_types, ONLY: qmmm_gaussian_p_type 00030 #include "cp_common_uses.h" 00031 00032 IMPLICIT NONE 00033 PRIVATE 00034 00035 LOGICAL, PRIVATE, PARAMETER :: debug_this_module=.TRUE. 00036 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qmmm_types' 00037 INTEGER, SAVE, PRIVATE :: last_qmmm_env_id_nr=0 00038 INTEGER, PARAMETER, PUBLIC :: primary_subsys = 1 00039 INTEGER, PARAMETER, PUBLIC :: fist_subsys = 1, 00040 qs_subsys = 2 00041 INTEGER, PARAMETER, PUBLIC :: force_mixing_extended_subsys = 1, 00042 force_mixing_core_subsys = 2 00043 INTEGER, PARAMETER, PUBLIC :: force_mixing_label_none = -1, 00044 force_mixing_label_QM_core_list = 10, 00045 force_mixing_label_QM_core = 9, 00046 force_mixing_label_QM_dynamics_list = 8, 00047 force_mixing_label_QM_dynamics = 7, 00048 force_mixing_label_buffer_list = 6, 00049 force_mixing_label_buffer = 5, 00050 force_mixing_label_termination = 4 00051 00052 PUBLIC :: qmmm_env_qm_type, gridlevel_info_type, qmmm_pot_type, qmmm_pot_p_type 00053 PUBLIC :: qmmm_env_qm_retain, qmmm_env_qm_release, qmmm_env_qm_create 00054 PUBLIC :: qmmm_env_mm_type, qmmm_env_mm_create, qmmm_env_mm_retain, qmmm_env_mm_release 00055 PUBLIC :: qmmm_imomm_link_type, qmmm_imomm_link_p_type, qmmm_links_type 00056 PUBLIC :: qmmm_pseudo_link_type, qmmm_pseudo_link_p_type 00057 PUBLIC :: add_env_type, add_set_type, add_set_release, create_add_set_type 00058 PUBLIC :: qmmm_per_pot_type, qmmm_per_pot_p_type, image_charge_type 00059 !*** 00060 00061 ! ***************************************************************************** 00068 TYPE gridlevel_info_type 00069 INTEGER :: auxbas_grid 00070 INTEGER :: coarser_grid 00071 END TYPE gridlevel_info_type 00072 ! 00073 ! Real Space Potential 00074 ! 00075 ! ***************************************************************************** 00076 TYPE qmmm_pot_type 00077 REAL(KIND=dp), DIMENSION(:,:), POINTER :: Pot0_2 00078 REAL(KIND=dp) :: Rmax, Rmin, dx, Rc 00079 INTEGER :: npts 00080 INTEGER, DIMENSION(:), POINTER :: mm_atom_index 00081 END TYPE qmmm_pot_type 00082 00083 ! ***************************************************************************** 00084 TYPE qmmm_pot_p_type 00085 TYPE(qmmm_pot_type), POINTER :: pot 00086 END TYPE qmmm_pot_p_type 00087 ! 00088 ! Periodic Potential 00089 ! 00090 ! ***************************************************************************** 00091 TYPE qmmm_per_pot_type 00092 REAL(KIND=dp), DIMENSION(:), POINTER :: lg, gx, gy, gz 00093 REAL(KIND=dp) :: Gmax, Fac(3) 00094 INTEGER :: Kmax(3), n_rep_real(3) 00095 INTEGER, DIMENSION(:), POINTER :: mm_atom_index 00096 TYPE ( pw_pool_type ), POINTER :: pw_pool 00097 TYPE ( pw_grid_type ), POINTER :: pw_grid 00098 TYPE ( pw_type ), POINTER :: TabLR 00099 END TYPE qmmm_per_pot_type 00100 00101 ! ***************************************************************************** 00102 TYPE qmmm_per_pot_p_type 00103 TYPE(qmmm_per_pot_type), POINTER :: pot 00104 END TYPE qmmm_per_pot_p_type 00105 ! 00106 ! LINKs 00107 ! 00108 ! IMOMM 00109 ! ***************************************************************************** 00110 TYPE qmmm_imomm_link_type 00111 INTEGER :: qm_index, mm_index 00112 REAL(KIND=dp) :: alpha 00113 END TYPE qmmm_imomm_link_type 00114 00115 ! ***************************************************************************** 00116 TYPE qmmm_imomm_link_p_type 00117 TYPE(qmmm_imomm_link_type), POINTER :: link 00118 END TYPE qmmm_imomm_link_p_type 00119 ! PSEUDO 00120 ! ***************************************************************************** 00121 TYPE qmmm_pseudo_link_type 00122 INTEGER :: qm_index, mm_index 00123 END TYPE qmmm_pseudo_link_type 00124 00125 ! ***************************************************************************** 00126 TYPE qmmm_pseudo_link_p_type 00127 TYPE(qmmm_pseudo_link_type), POINTER :: link 00128 END TYPE qmmm_pseudo_link_p_type 00129 ! 00130 ! LINKs summary... 00131 ! 00132 ! ***************************************************************************** 00133 TYPE qmmm_links_type 00134 TYPE(qmmm_imomm_link_p_type), DIMENSION(:), POINTER :: imomm 00135 TYPE(qmmm_pseudo_link_p_type), DIMENSION(:), POINTER :: pseudo 00136 END TYPE qmmm_links_type 00137 00138 ! ***************************************************************************** 00139 TYPE add_env_type 00140 INTEGER :: Index1, Index2 00141 REAL(KIND=dp) :: alpha 00142 END TYPE add_env_type 00143 00144 ! ***************************************************************************** 00145 TYPE add_set_type 00146 INTEGER :: num_mm_atoms 00147 TYPE(add_env_type), DIMENSION(:), POINTER :: add_env 00148 TYPE(particle_type), DIMENSION(:), POINTER :: added_particles 00149 INTEGER, DIMENSION(:), POINTER :: mm_atom_index 00150 REAL(KIND=dp), DIMENSION(:), POINTER :: mm_atom_chrg 00151 REAL(KIND=dp), DIMENSION(:), POINTER :: mm_el_pot_radius 00152 REAL(KIND=dp), DIMENSION(:), POINTER :: mm_el_pot_radius_corr 00153 TYPE(qmmm_pot_p_type), DIMENSION(:), POINTER :: Potentials 00154 TYPE(qmmm_per_pot_p_type), DIMENSION(:), POINTER :: Per_Potentials 00155 TYPE(qmmm_gaussian_p_type), DIMENSION(:),POINTER :: pgfs 00156 END TYPE add_set_type 00157 00158 ! ***************************************************************************** 00159 TYPE image_charge_type 00160 LOGICAL :: all_mm 00161 LOGICAL :: coeff_iterative 00162 LOGICAL :: image_restart 00163 INTEGER, DIMENSION(:), POINTER :: image_mm_list 00164 TYPE(particle_type), DIMENSION(:), POINTER :: particles_all 00165 REAL(KIND=dp),DIMENSION(:,:),POINTER :: image_forcesMM 00166 REAL(KIND=dp) :: V0 00167 REAL(KIND=dp) :: eta 00168 END TYPE image_charge_type 00169 00170 ! ***************************************************************************** 00171 TYPE qmmm_env_qm_type 00172 INTEGER :: ref_count, id_nr 00173 LOGICAL :: center_qm_subsys 00174 LOGICAL :: center_qm_subsys0, do_translate 00175 LOGICAL :: compatibility 00176 LOGICAL :: qmmm_link 00177 LOGICAL :: move_mm_charges 00178 LOGICAL :: add_mm_charges 00179 LOGICAL :: periodic 00180 LOGICAL :: image_charge 00181 INTEGER :: par_scheme 00182 INTEGER :: qmmm_coupl_type 00183 INTEGER :: num_qm_atoms 00184 INTEGER :: num_mm_atoms 00185 INTEGER :: num_image_mm_atoms 00186 REAL(KIND=dp) :: eps_mm_rspace 00187 REAL(KIND=dp), DIMENSION(3) :: dOmmOqm, utrasl, transl_v 00188 REAL(KIND=dp), DIMENSION(2) :: spherical_cutoff 00189 REAL(KIND=dp), DIMENSION(:), POINTER :: maxradius 00190 INTEGER, DIMENSION(:), POINTER :: qm_atom_index 00191 INTEGER, DIMENSION(:), POINTER :: mm_atom_index 00192 INTEGER, DIMENSION(:), POINTER :: mm_link_atoms 00193 REAL(KIND=dp), DIMENSION(:), POINTER :: mm_atom_chrg 00194 REAL(KIND=dp), DIMENSION(:), POINTER :: mm_el_pot_radius 00195 REAL(KIND=dp), DIMENSION(:), POINTER :: mm_el_pot_radius_corr 00196 TYPE(qmmm_pot_p_type), DIMENSION(:), POINTER :: Potentials 00197 TYPE(qmmm_per_pot_p_type), DIMENSION(:), POINTER :: Per_Potentials 00198 TYPE(gridlevel_info_type) :: gridlevel_info 00199 TYPE(qmmm_gaussian_p_type), DIMENSION(:),POINTER :: pgfs 00200 TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: aug_pools 00201 TYPE(qmmm_links_type), POINTER :: qmmm_links 00202 TYPE(add_set_type), POINTER :: added_charges 00203 TYPE(image_charge_type), POINTER :: image_charge_pot 00204 END TYPE qmmm_env_qm_type 00205 00206 ! ***************************************************************************** 00207 TYPE qmmm_env_mm_type 00208 INTEGER :: ref_count, id_nr 00209 LOGICAL :: qmmm_link 00210 LOGICAL :: use_qmmm_ff 00211 LOGICAL :: multiple_potential 00212 INTEGER :: qmmm_coupl_type 00213 INTEGER, DIMENSION(:), POINTER :: qm_atom_index 00214 INTEGER, DIMENSION(:), POINTER :: mm_link_atoms 00215 REAL(KIND=dp), DIMENSION(:), POINTER :: mm_link_scale_factor 00216 REAL(KIND=dp), DIMENSION(:), POINTER :: fist_scale_charge_link 00217 INTEGER, DIMENSION(:), POINTER :: qm_molecule_index 00218 TYPE(input_info_type),POINTER :: inp_info 00219 END TYPE qmmm_env_mm_type 00220 00221 CONTAINS 00222 00223 ! ***************************************************************************** 00228 SUBROUTINE qmmm_env_mm_create(qmmm_env, error) 00229 TYPE(qmmm_env_mm_type), POINTER :: qmmm_env 00230 TYPE(cp_error_type), INTENT(inout) :: error 00231 00232 CHARACTER(len=*), PARAMETER :: routineN = 'qmmm_env_mm_create', 00233 routineP = moduleN//':'//routineN 00234 00235 INTEGER :: stat 00236 LOGICAL :: failure 00237 00238 failure=.FALSE. 00239 CPPrecondition(.NOT.ASSOCIATED(qmmm_env),cp_failure_level,routineP,error,failure) 00240 ALLOCATE(qmmm_env, stat=stat) 00241 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00242 IF (.NOT. failure) THEN 00243 qmmm_env%ref_count=1 00244 last_qmmm_env_id_nr=last_qmmm_env_id_nr+1 00245 qmmm_env%id_nr=last_qmmm_env_id_nr 00246 NULLIFY(qmmm_env%qm_atom_index,& 00247 qmmm_env%qm_molecule_index,& 00248 qmmm_env%mm_link_atoms,& 00249 qmmm_env%mm_link_scale_factor,& 00250 qmmm_env%fist_scale_charge_link,& 00251 qmmm_env%inp_info) 00252 qmmm_env%qmmm_coupl_type=do_qmmm_none 00253 qmmm_env%qmmm_link = .FALSE. 00254 qmmm_env%use_qmmm_ff = .FALSE. 00255 ALLOCATE(qmmm_env%inp_info, stat=stat) 00256 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00257 CALL init_inp_info(qmmm_env%inp_info) 00258 END IF 00259 END SUBROUTINE qmmm_env_mm_create 00260 00261 ! ***************************************************************************** 00266 SUBROUTINE qmmm_env_mm_retain(qmmm_env,error) 00267 TYPE(qmmm_env_mm_type), POINTER :: qmmm_env 00268 TYPE(cp_error_type), INTENT(inout) :: error 00269 00270 CHARACTER(len=*), PARAMETER :: routineN = 'qmmm_env_mm_retain', 00271 routineP = moduleN//':'//routineN 00272 00273 LOGICAL :: failure 00274 00275 failure=.FALSE. 00276 00277 CPPrecondition(ASSOCIATED(qmmm_env),cp_failure_level,routineP,error,failure) 00278 IF (.NOT. failure) THEN 00279 CPPreconditionNoFail(qmmm_env%ref_count>0,cp_failure_level,routineP,error) 00280 qmmm_env%ref_count=qmmm_env%ref_count+1 00281 END IF 00282 END SUBROUTINE qmmm_env_mm_retain 00283 00284 ! ***************************************************************************** 00292 SUBROUTINE qmmm_env_mm_release(qmmm_env,error) 00293 TYPE(qmmm_env_mm_type), POINTER :: qmmm_env 00294 TYPE(cp_error_type), INTENT(inout) :: error 00295 00296 CHARACTER(len=*), PARAMETER :: routineN = 'qmmm_env_mm_release', 00297 routineP = moduleN//':'//routineN 00298 00299 INTEGER :: stat 00300 LOGICAL :: failure 00301 00302 failure=.FALSE. 00303 IF (ASSOCIATED(qmmm_env)) THEN 00304 CPPreconditionNoFail(qmmm_env%ref_count>0,cp_failure_level,routineP,error) 00305 qmmm_env%ref_count=qmmm_env%ref_count-1 00306 IF (qmmm_env%ref_count==0) THEN 00307 IF (ASSOCIATED(qmmm_env%qm_atom_index)) THEN 00308 DEALLOCATE(qmmm_env%qm_atom_index,stat=stat) 00309 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00310 END IF 00311 IF (ASSOCIATED(qmmm_env%qm_molecule_index)) THEN 00312 DEALLOCATE(qmmm_env%qm_molecule_index,stat=stat) 00313 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00314 END IF 00315 IF (ASSOCIATED(qmmm_env%mm_link_atoms)) THEN 00316 DEALLOCATE(qmmm_env%mm_link_atoms,stat=stat) 00317 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00318 END IF 00319 IF (ASSOCIATED(qmmm_env%mm_link_scale_factor)) THEN 00320 DEALLOCATE(qmmm_env%mm_link_scale_factor,stat=stat) 00321 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00322 END IF 00323 IF (ASSOCIATED(qmmm_env%fist_scale_charge_link)) THEN 00324 DEALLOCATE(qmmm_env%fist_scale_charge_link,stat=stat) 00325 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00326 END IF 00327 IF (ASSOCIATED(qmmm_env%inp_info)) THEN 00328 CALL deallocate_inp_info(qmmm_env%inp_info,error) 00329 DEALLOCATE(qmmm_env%inp_info,stat=stat) 00330 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00331 END IF 00332 00333 DEALLOCATE(qmmm_env,stat=stat) 00334 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00335 END IF 00336 END IF 00337 NULLIFY(qmmm_env) 00338 END SUBROUTINE qmmm_env_mm_release 00339 00340 ! ***************************************************************************** 00345 SUBROUTINE qmmm_env_qm_create(qmmm_env, error) 00346 TYPE(qmmm_env_qm_type), POINTER :: qmmm_env 00347 TYPE(cp_error_type), INTENT(inout) :: error 00348 00349 CHARACTER(len=*), PARAMETER :: routineN = 'qmmm_env_qm_create', 00350 routineP = moduleN//':'//routineN 00351 00352 INTEGER :: stat 00353 LOGICAL :: failure 00354 00355 failure=.FALSE. 00356 CPPrecondition(.NOT.ASSOCIATED(qmmm_env),cp_failure_level,routineP,error,failure) 00357 ALLOCATE(qmmm_env, stat=stat) 00358 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00359 IF (.NOT. failure) THEN 00360 qmmm_env%ref_count=1 00361 last_qmmm_env_id_nr=last_qmmm_env_id_nr+1 00362 qmmm_env%id_nr=last_qmmm_env_id_nr 00363 NULLIFY(qmmm_env%qm_atom_index, qmmm_env%mm_link_atoms,& 00364 qmmm_env%mm_atom_index,qmmm_env%mm_atom_chrg,& 00365 qmmm_env%pgfs, qmmm_env%maxradius,& 00366 qmmm_env%aug_pools, qmmm_env%potentials,& 00367 qmmm_env%qmmm_links, qmmm_env%added_charges,& 00368 qmmm_env%per_potentials,qmmm_env%image_charge_pot) 00369 qmmm_env%do_translate = .TRUE. 00370 qmmm_env%center_qm_subsys = .TRUE. 00371 qmmm_env%center_qm_subsys0= .TRUE. 00372 qmmm_env%compatibility = .TRUE. 00373 qmmm_env%qmmm_link = .FALSE. 00374 qmmm_env%add_mm_charges = .FALSE. 00375 qmmm_env%move_mm_charges = .FALSE. 00376 qmmm_env%periodic = .FALSE. 00377 qmmm_env%image_charge = .FALSE. 00378 qmmm_env%qmmm_coupl_type=do_qmmm_none 00379 qmmm_env%num_qm_atoms=0 00380 qmmm_env%num_mm_atoms=0 00381 qmmm_env%num_image_mm_atoms=0 00382 qmmm_env%gridlevel_info%auxbas_grid = 0 00383 qmmm_env%gridlevel_info%coarser_grid = 0 00384 CALL create_add_set_type(qmmm_env%added_charges, ndim=0, error=error) 00385 CALL create_image_charge_type(qmmm_env%image_charge_pot,error=error) 00386 END IF 00387 END SUBROUTINE qmmm_env_qm_create 00388 00389 ! ***************************************************************************** 00396 SUBROUTINE qmmm_env_qm_retain(qmmm_env,error) 00397 TYPE(qmmm_env_qm_type), POINTER :: qmmm_env 00398 TYPE(cp_error_type), INTENT(inout) :: error 00399 00400 CHARACTER(len=*), PARAMETER :: routineN = 'qmmm_env_qm_retain', 00401 routineP = moduleN//':'//routineN 00402 00403 LOGICAL :: failure 00404 00405 failure=.FALSE. 00406 00407 CPPrecondition(ASSOCIATED(qmmm_env),cp_failure_level,routineP,error,failure) 00408 IF (.NOT. failure) THEN 00409 CPPreconditionNoFail(qmmm_env%ref_count>0,cp_failure_level,routineP,error) 00410 qmmm_env%ref_count=qmmm_env%ref_count+1 00411 END IF 00412 END SUBROUTINE qmmm_env_qm_retain 00413 00414 ! ***************************************************************************** 00422 SUBROUTINE qmmm_env_qm_release(qmmm_env,error) 00423 TYPE(qmmm_env_qm_type), POINTER :: qmmm_env 00424 TYPE(cp_error_type), INTENT(inout) :: error 00425 00426 CHARACTER(len=*), PARAMETER :: routineN = 'qmmm_env_qm_release', 00427 routineP = moduleN//':'//routineN 00428 00429 INTEGER :: stat 00430 LOGICAL :: failure 00431 00432 failure=.FALSE. 00433 IF (ASSOCIATED(qmmm_env)) THEN 00434 CPPreconditionNoFail(qmmm_env%ref_count>0,cp_failure_level,routineP,error) 00435 qmmm_env%ref_count=qmmm_env%ref_count-1 00436 IF (qmmm_env%ref_count==0) THEN 00437 IF (ASSOCIATED(qmmm_env%qm_atom_index)) THEN 00438 DEALLOCATE(qmmm_env%qm_atom_index,stat=stat) 00439 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00440 END IF 00441 IF (ASSOCIATED(qmmm_env%maxradius)) THEN 00442 DEALLOCATE(qmmm_env%maxradius,stat=stat) 00443 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00444 END IF 00445 IF (ASSOCIATED(qmmm_env%mm_atom_index)) THEN 00446 DEALLOCATE(qmmm_env%mm_atom_index,stat=stat) 00447 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00448 END IF 00449 IF (ASSOCIATED(qmmm_env%mm_link_atoms)) THEN 00450 DEALLOCATE(qmmm_env%mm_link_atoms,stat=stat) 00451 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00452 END IF 00453 IF (ASSOCIATED(qmmm_env%mm_atom_chrg)) THEN 00454 DEALLOCATE(qmmm_env%mm_atom_chrg,stat=stat) 00455 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00456 END IF 00457 IF (ASSOCIATED(qmmm_env%mm_el_pot_radius)) THEN 00458 DEALLOCATE(qmmm_env%mm_el_pot_radius,stat=stat) 00459 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00460 END IF 00461 IF (ASSOCIATED(qmmm_env%mm_el_pot_radius_corr)) THEN 00462 DEALLOCATE(qmmm_env%mm_el_pot_radius_corr,stat=stat) 00463 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00464 END IF 00465 IF (ASSOCIATED(qmmm_env%pgfs)) THEN 00466 CALL pgfs_release(qmmm_env%pgfs, error) 00467 DEALLOCATE(qmmm_env%pgfs,stat=stat) 00468 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00469 END IF 00470 IF (ASSOCIATED(qmmm_env%Potentials)) THEN 00471 CALL qmmm_pot_type_dealloc(qmmm_env%Potentials,error=error) 00472 DEALLOCATE(qmmm_env%Potentials,stat=stat) 00473 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00474 END IF 00475 IF (ASSOCIATED(qmmm_env%Per_Potentials)) THEN 00476 CALL qmmm_per_pot_type_dealloc(qmmm_env%Per_Potentials,error=error) 00477 DEALLOCATE(qmmm_env%Per_Potentials,stat=stat) 00478 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00479 END IF 00480 IF (ASSOCIATED(qmmm_env%aug_pools)) THEN 00481 CALL pw_pools_dealloc(qmmm_env%aug_pools,error=error) 00482 END IF 00483 IF (ASSOCIATED(qmmm_env%qmmm_links)) THEN 00484 CALL qmmm_links_dealloc(qmmm_env%qmmm_links, error=error) 00485 END IF 00486 IF (ASSOCIATED(qmmm_env%added_charges)) THEN 00487 CALL add_set_release(qmmm_env%added_charges, error=error) 00488 END IF 00489 IF (ASSOCIATED(qmmm_env%image_charge_pot)) THEN 00490 CALL qmmm_image_charge_dealloc(qmmm_env%image_charge_pot,error=error) 00491 END IF 00492 DEALLOCATE(qmmm_env, stat=stat) 00493 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00494 END IF 00495 END IF 00496 NULLIFY(qmmm_env) 00497 END SUBROUTINE qmmm_env_qm_release 00498 00499 ! ***************************************************************************** 00505 SUBROUTINE pgfs_release(pgfs, error) 00506 TYPE(qmmm_gaussian_p_type), 00507 DIMENSION(:), POINTER :: pgfs 00508 TYPE(cp_error_type), INTENT(inout) :: error 00509 00510 CHARACTER(len=*), PARAMETER :: routineN = 'pgfs_release', 00511 routineP = moduleN//':'//routineN 00512 00513 INTEGER :: I, stat 00514 LOGICAL :: failure 00515 00516 failure = .FALSE. 00517 IF (.NOT.failure) THEN 00518 DO I=1,SIZE(pgfs) 00519 IF (ASSOCIATED(pgfs(I)%pgf)) THEN 00520 IF (ASSOCIATED(pgfs(I)%pgf%Ak)) THEN 00521 DEALLOCATE(pgfs(I)%pgf%Ak,stat=stat) 00522 CPPostcondition(stat==0,cp_failure_level,routineP,error,Failure) 00523 END IF 00524 IF (ASSOCIATED(pgfs(I)%pgf%Gk)) THEN 00525 DEALLOCATE(pgfs(I)%pgf%Gk,stat=stat) 00526 CPPostcondition(stat==0,cp_failure_level,routineP,error,Failure) 00527 END IF 00528 IF (ASSOCIATED(pgfs(I)%pgf%grid_level)) THEN 00529 DEALLOCATE(pgfs(I)%pgf%grid_level,stat=stat) 00530 CPPostcondition(stat==0,cp_failure_level,routineP,error,Failure) 00531 END IF 00532 DEALLOCATE(pgfs(I)%pgf,stat=stat) 00533 CPPostcondition(stat==0,cp_failure_level,routineP,error,Failure) 00534 END IF 00535 END DO 00536 END IF 00537 END SUBROUTINE pgfs_release 00538 00539 ! ***************************************************************************** 00545 SUBROUTINE qmmm_links_dealloc(qmmm_links, error) 00546 TYPE(qmmm_links_type), POINTER :: qmmm_links 00547 TYPE(cp_error_type), INTENT(inout) :: error 00548 00549 CHARACTER(len=*), PARAMETER :: routineN = 'qmmm_links_dealloc', 00550 routineP = moduleN//':'//routineN 00551 00552 INTEGER :: I, stat 00553 00554 IF (ASSOCIATED(qmmm_links%imomm)) THEN 00555 DO i = 1, SIZE(qmmm_links%imomm) 00556 IF (ASSOCIATED(qmmm_links%imomm(i)%link)) DEALLOCATE(qmmm_links%imomm(i)%link, stat=stat) 00557 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00558 END DO 00559 DEALLOCATE(qmmm_links%imomm, stat=stat) 00560 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00561 END IF 00562 IF (ASSOCIATED(qmmm_links%pseudo)) THEN 00563 DO i = 1, SIZE(qmmm_links%pseudo) 00564 IF (ASSOCIATED(qmmm_links%pseudo(i)%link)) DEALLOCATE(qmmm_links%pseudo(i)%link, stat=stat) 00565 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00566 END DO 00567 DEALLOCATE(qmmm_links%pseudo, stat=stat) 00568 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00569 END IF 00570 DEALLOCATE(qmmm_links, stat=stat) 00571 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00572 END SUBROUTINE qmmm_links_dealloc 00573 00574 ! **************************************************************************** 00580 SUBROUTINE qmmm_image_charge_dealloc(image_charge_pot, error) 00581 TYPE(image_charge_type), POINTER :: image_charge_pot 00582 TYPE(cp_error_type), INTENT(inout) :: error 00583 00584 CHARACTER(len=*), PARAMETER :: routineN = 'qmmm_image_charge_dealloc', 00585 routineP = moduleN//':'//routineN 00586 00587 INTEGER :: stat 00588 00589 IF (ASSOCIATED(image_charge_pot)) THEN 00590 IF (ASSOCIATED(image_charge_pot%image_mm_list)) THEN 00591 IF(.NOT.image_charge_pot%all_mm) THEN 00592 DEALLOCATE(image_charge_pot%image_mm_list, stat=stat) 00593 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00594 END IF 00595 END IF 00596 IF (ASSOCIATED(image_charge_pot%image_forcesMM)) THEN 00597 DEALLOCATE(image_charge_pot%image_forcesMM, stat=stat) 00598 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00599 END IF 00600 DEALLOCATE(image_charge_pot, stat=stat) 00601 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00602 END IF 00603 00604 END SUBROUTINE qmmm_image_charge_dealloc 00605 00606 00607 ! ***************************************************************************** 00614 SUBROUTINE qmmm_pot_type_dealloc(Potentials, error) 00615 TYPE(qmmm_pot_p_type), DIMENSION(:), 00616 POINTER :: Potentials 00617 TYPE(cp_error_type), INTENT(inout) :: error 00618 00619 CHARACTER(len=*), PARAMETER :: routineN = 'qmmm_pot_type_dealloc', 00620 routineP = moduleN//':'//routineN 00621 00622 INTEGER :: I, stat 00623 00624 DO I = 1, SIZE(Potentials) 00625 IF (ASSOCIATED(Potentials(I)%Pot)) THEN 00626 IF (ASSOCIATED(Potentials(I)%Pot%pot0_2)) THEN 00627 DEALLOCATE(Potentials(I)%Pot%pot0_2,stat=stat) 00628 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00629 END IF 00630 IF (ASSOCIATED(Potentials(I)%Pot%mm_atom_index)) THEN 00631 DEALLOCATE(Potentials(I)%Pot%mm_atom_index,stat=stat) 00632 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00633 END IF 00634 DEALLOCATE(Potentials(I)%Pot,stat=stat) 00635 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00636 END IF 00637 END DO 00638 00639 END SUBROUTINE qmmm_pot_type_dealloc 00640 00641 ! ***************************************************************************** 00649 SUBROUTINE qmmm_per_pot_type_dealloc(Per_Potentials, error) 00650 TYPE(qmmm_per_pot_p_type), 00651 DIMENSION(:), POINTER :: Per_Potentials 00652 TYPE(cp_error_type), INTENT(inout) :: error 00653 00654 CHARACTER(len=*), PARAMETER :: routineN = 'qmmm_per_pot_type_dealloc', 00655 routineP = moduleN//':'//routineN 00656 00657 INTEGER :: I, stat 00658 00659 DO I = 1, SIZE(Per_Potentials) 00660 IF (ASSOCIATED(Per_Potentials(I)%Pot)) THEN 00661 IF (ASSOCIATED(Per_Potentials(I)%Pot%LG)) THEN 00662 DEALLOCATE(Per_Potentials(I)%Pot%LG,stat=stat) 00663 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00664 END IF 00665 IF (ASSOCIATED(Per_Potentials(I)%Pot%gx)) THEN 00666 DEALLOCATE(Per_Potentials(I)%Pot%gx,stat=stat) 00667 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00668 END IF 00669 IF (ASSOCIATED(Per_Potentials(I)%Pot%gy)) THEN 00670 DEALLOCATE(Per_Potentials(I)%Pot%gy,stat=stat) 00671 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00672 END IF 00673 IF (ASSOCIATED(Per_Potentials(I)%Pot%gz)) THEN 00674 DEALLOCATE(Per_Potentials(I)%Pot%gz,stat=stat) 00675 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00676 END IF 00677 IF (ASSOCIATED(Per_Potentials(I)%Pot%mm_atom_index)) THEN 00678 DEALLOCATE(Per_Potentials(I)%Pot%mm_atom_index,stat=stat) 00679 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00680 END IF 00681 IF (ASSOCIATED(Per_Potentials(I)%Pot%TabLR)) THEN 00682 CALL pw_pool_give_back_pw ( Per_Potentials(I)%Pot%pw_pool, Per_Potentials(I)%Pot%TabLR,error=error) 00683 END IF 00684 IF (ASSOCIATED(Per_Potentials(I)%Pot%pw_pool)) THEN 00685 CALL pw_pool_release ( Per_Potentials(I)%Pot%pw_pool, error=error) 00686 CPPostconditionNoFail(.NOT.ASSOCIATED(Per_Potentials(I)%Pot%pw_pool),cp_failure_level,routineP,error) 00687 END IF 00688 IF (ASSOCIATED(Per_Potentials(I)%Pot%pw_grid)) THEN 00689 CALL pw_grid_release ( Per_Potentials(I)%Pot%pw_grid, error=error) 00690 CPPostconditionNoFail(.NOT.ASSOCIATED(Per_Potentials(I)%Pot%pw_grid),cp_failure_level,routineP,error) 00691 END IF 00692 DEALLOCATE(Per_Potentials(I)%Pot,stat=stat) 00693 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00694 END IF 00695 END DO 00696 00697 END SUBROUTINE qmmm_per_pot_type_dealloc 00698 00699 ! ***************************************************************************** 00705 SUBROUTINE add_set_release(added_charges, error) 00706 TYPE(add_set_type), POINTER :: added_charges 00707 TYPE(cp_error_type), INTENT(inout) :: error 00708 00709 CHARACTER(len=*), PARAMETER :: routineN = 'add_set_release', 00710 routineP = moduleN//':'//routineN 00711 00712 INTEGER :: stat 00713 00714 IF (ASSOCIATED(added_charges)) THEN 00715 IF (ASSOCIATED(added_charges%add_env)) THEN 00716 DEALLOCATE(added_charges%add_env, stat=stat) 00717 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00718 END IF 00719 IF (ASSOCIATED(added_charges%added_particles)) THEN 00720 CALL deallocate_particle_set(added_charges%added_particles,error) 00721 END IF 00722 IF (ASSOCIATED(added_charges%mm_atom_index)) THEN 00723 DEALLOCATE(added_charges%mm_atom_index, stat=stat) 00724 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00725 END IF 00726 IF (ASSOCIATED(added_charges%mm_atom_chrg)) THEN 00727 DEALLOCATE(added_charges%mm_atom_chrg, stat=stat) 00728 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00729 END IF 00730 IF (ASSOCIATED(added_charges%mm_el_pot_radius)) THEN 00731 DEALLOCATE(added_charges%mm_el_pot_radius, stat=stat) 00732 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00733 END IF 00734 IF (ASSOCIATED(added_charges%mm_el_pot_radius_corr)) THEN 00735 DEALLOCATE(added_charges%mm_el_pot_radius_corr, stat=stat) 00736 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00737 END IF 00738 IF (ASSOCIATED(added_charges%Potentials)) THEN 00739 CALL qmmm_pot_type_dealloc(added_charges%Potentials, error) 00740 DEALLOCATE(added_charges%Potentials,stat=stat) 00741 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00742 END IF 00743 IF (ASSOCIATED(added_charges%Per_Potentials)) THEN 00744 CALL qmmm_per_pot_type_dealloc(added_charges%Per_Potentials, error) 00745 DEALLOCATE(added_charges%Per_Potentials,stat=stat) 00746 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00747 END IF 00748 IF (ASSOCIATED(added_charges%pgfs)) THEN 00749 CALL pgfs_release(added_charges%pgfs, error) 00750 DEALLOCATE(added_charges%pgfs,stat=stat) 00751 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00752 END IF 00753 DEALLOCATE(added_charges, stat=stat) 00754 CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) 00755 END IF 00756 END SUBROUTINE add_set_release 00757 00758 ! ***************************************************************************** 00764 SUBROUTINE create_add_set_type(added_charges, ndim, error) 00765 TYPE(add_set_type), POINTER :: added_charges 00766 INTEGER, INTENT(IN) :: ndim 00767 TYPE(cp_error_type), INTENT(inout) :: error 00768 00769 CHARACTER(len=*), PARAMETER :: routineN = 'create_add_set_type', 00770 routineP = moduleN//':'//routineN 00771 00772 INTEGER :: stat 00773 LOGICAL :: failure 00774 00775 failure = .FALSE. 00776 IF (ASSOCIATED(added_charges)) CALL add_set_release(added_charges, error) 00777 ALLOCATE(added_charges, stat=stat) 00778 CPPostcondition(stat==0,cp_failure_level,routineP,error,Failure) 00779 00780 IF (.NOT. failure) THEN 00781 NULLIFY(added_charges%add_env,& 00782 added_charges%mm_atom_index,& 00783 added_charges%added_particles,& 00784 added_charges%mm_atom_chrg,& 00785 added_charges%mm_el_pot_radius,& 00786 added_charges%mm_el_pot_radius_corr,& 00787 added_charges%potentials,& 00788 added_charges%per_potentials,& 00789 added_charges%pgfs) 00790 00791 added_charges%num_mm_atoms = ndim 00792 IF (ndim == 0) RETURN 00793 ! 00794 ! Allocate leave out just potential and pgfs... 00795 ! 00796 ALLOCATE(added_charges%add_env(ndim),stat=stat) 00797 CPPostcondition(stat==0,cp_failure_level,routineP,error,Failure) 00798 CALL allocate_particle_set(added_charges%added_particles,ndim,error) 00799 ALLOCATE(added_charges%mm_atom_index(ndim), stat=stat) 00800 CPPostcondition(stat==0,cp_failure_level,routineP,error,Failure) 00801 ALLOCATE(added_charges%mm_atom_chrg(ndim), stat=stat) 00802 CPPostcondition(stat==0,cp_failure_level,routineP,error,Failure) 00803 ALLOCATE(added_charges%mm_el_pot_radius(ndim), stat=stat) 00804 CPPostcondition(stat==0,cp_failure_level,routineP,error,Failure) 00805 ALLOCATE(added_charges%mm_el_pot_radius_corr(ndim), stat=stat) 00806 CPPostcondition(stat==0,cp_failure_level,routineP,error,Failure) 00807 END IF 00808 00809 END SUBROUTINE create_add_set_type 00810 00811 ! ***************************************************************************** 00817 SUBROUTINE create_image_charge_type(image_charge_pot,error) 00818 TYPE(image_charge_type), POINTER :: image_charge_pot 00819 TYPE(cp_error_type), INTENT(inout) :: error 00820 00821 CHARACTER(len=*), PARAMETER :: routineN = 'create_image_charge_type', 00822 routineP = moduleN//':'//routineN 00823 00824 INTEGER :: stat 00825 LOGICAL :: failure 00826 00827 failure = .FALSE. 00828 IF (ASSOCIATED(image_charge_pot)) CALL qmmm_image_charge_dealloc(image_charge_pot, error) 00829 ALLOCATE(image_charge_pot, stat=stat) 00830 CPPostcondition(stat==0,cp_failure_level,routineP,error,Failure) 00831 00832 IF (.NOT. failure) THEN 00833 NULLIFY(image_charge_pot%image_mm_list,& 00834 image_charge_pot%particles_all,& 00835 image_charge_pot%image_forcesMM) 00836 00837 END IF 00838 00839 image_charge_pot%all_mm=.TRUE. 00840 image_charge_pot%coeff_iterative=.FALSE. 00841 image_charge_pot%image_restart=.FALSE. 00842 00843 END SUBROUTINE create_image_charge_type 00844 00845 END MODULE qmmm_types
1.7.3