|
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 ! ***************************************************************************** 00016 MODULE force_env_types 00017 USE atprop_types, ONLY: atprop_release,& 00018 atprop_type 00019 USE cell_types, ONLY: cell_type 00020 USE cp_para_env, ONLY: cp_para_env_release 00021 USE cp_para_types, ONLY: cp_para_env_type 00022 USE cp_result_types, ONLY: cp_result_release,& 00023 cp_result_retain,& 00024 cp_result_type 00025 USE cp_subsys_types, ONLY: cp_subsys_get,& 00026 cp_subsys_release,& 00027 cp_subsys_type,& 00028 pack_subsys_particles 00029 USE cpot_types, ONLY: cpot_release,& 00030 cpot_type 00031 USE eip_environment_types, ONLY: eip_env_get,& 00032 eip_env_release,& 00033 eip_environment_type 00034 USE ep_types, ONLY: ep_env_release,& 00035 ep_env_type 00036 USE ewald_environment_types, ONLY: ewald_environment_type 00037 USE ewald_pw_methods, ONLY: ewald_pw_grid_change 00038 USE ewald_pw_types, ONLY: ewald_pw_type 00039 USE f77_blas 00040 USE fist_energy_types, ONLY: fist_energy_type 00041 USE fist_environment_types, ONLY: fist_env_get,& 00042 fist_env_release,& 00043 fist_env_set,& 00044 fist_environment_type 00045 USE fp_types, ONLY: fp_env_release,& 00046 fp_env_retain,& 00047 fp_type 00048 USE global_types, ONLY: global_environment_type,& 00049 globenv_release 00050 USE input_section_types, ONLY: section_vals_get,& 00051 section_vals_release,& 00052 section_vals_retain,& 00053 section_vals_type,& 00054 section_vals_val_get 00055 USE kinds, ONLY: dp 00056 USE metadynamics_types, ONLY: meta_env_release,& 00057 meta_env_retain,& 00058 meta_env_type 00059 USE mixed_energy_types, ONLY: mixed_energy_type 00060 USE mixed_environment_types, ONLY: get_mixed_env,& 00061 mixed_env_release,& 00062 mixed_environment_type 00063 USE qmmm_types, ONLY: fist_subsys,& 00064 force_mixing_extended_subsys,& 00065 primary_subsys,& 00066 qmmm_env_qm_release,& 00067 qmmm_env_qm_type,& 00068 qs_subsys 00069 USE qs_energy_types, ONLY: qs_energy_type 00070 USE qs_environment_methods, ONLY: qs_env_rebuild_pw_env 00071 USE qs_environment_types, ONLY: get_qs_env,& 00072 qs_env_release,& 00073 qs_environment_type,& 00074 set_qs_env 00075 USE qs_ks_methods, ONLY: qs_ks_create 00076 USE qs_ks_scp_methods, ONLY: qs_ks_scp_create 00077 USE qs_ks_scp_types, ONLY: qs_ks_scp_env_type,& 00078 qs_ks_scp_release 00079 USE qs_ks_types, ONLY: qs_ks_env_type,& 00080 qs_ks_release 00081 USE scp_environment_types, ONLY: set_scp_env 00082 USE scp_rspw_methods, ONLY: scp_qs_rspw_rebuild 00083 USE timings, ONLY: timeset,& 00084 timestop 00085 USE virial_types, ONLY: virial_release,& 00086 virial_retain,& 00087 virial_type 00088 #include "cp_common_uses.h" 00089 00090 IMPLICIT NONE 00091 00092 PRIVATE 00093 00094 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'force_env_types' 00095 00096 INTEGER, PARAMETER, PUBLIC :: use_fist_force = 501, 00097 use_qs_force = 502, 00098 use_qmmm = 503, 00099 use_eip_force = 504, 00100 use_ep_force = 505, 00101 use_mixed_force= 506 00102 00103 CHARACTER(LEN=10), DIMENSION(501:506), PARAMETER, PUBLIC :: 00104 use_prog_name = (/ 00105 "FIST ", 00106 "QS ", 00107 "QMMM ", 00108 "EIP ", 00109 "EP ", 00110 "MIXED "/) 00111 00112 PUBLIC :: force_env_type,& 00113 force_env_p_type 00114 00115 PUBLIC :: force_env_retain,& 00116 force_env_release,& 00117 force_env_get,& 00118 force_env_get_natom,& 00119 force_env_get_nparticle,& 00120 force_env_get_frc,& 00121 force_env_get_pos,& 00122 force_env_get_vel,& 00123 force_env_set,& 00124 force_env_set_cell,& 00125 multiple_fe_list 00126 00127 ! ***************************************************************************** 00153 TYPE force_env_type 00154 INTEGER :: id_nr,ref_count,in_use,method_name_id 00155 REAL ( KIND=dp ) :: additional_potential 00156 TYPE ( fist_environment_type ), POINTER :: fist_env 00157 TYPE ( meta_env_type ), POINTER :: meta_env 00158 TYPE ( fp_type ), POINTER :: fp_env 00159 TYPE ( qs_environment_type ), POINTER :: qs_env 00160 TYPE ( eip_environment_type ), POINTER :: eip_env 00161 TYPE ( cp_subsys_type ), POINTER :: subsys 00162 TYPE ( global_environment_type ), POINTER :: globenv 00163 TYPE ( cp_para_env_type ), POINTER :: para_env 00164 TYPE ( force_env_p_type ), DIMENSION(:), POINTER :: sub_force_env 00165 TYPE ( qmmm_env_qm_type ), POINTER :: qmmm_env 00166 TYPE ( virial_type ), POINTER :: virial 00167 TYPE ( ep_env_type ), POINTER :: ep_env 00168 TYPE ( mixed_environment_type ), POINTER :: mixed_env 00169 TYPE ( section_vals_type), POINTER :: force_env_section 00170 TYPE ( section_vals_type), POINTER :: root_section 00171 TYPE ( cpot_type), POINTER :: cpot_env 00172 TYPE ( atprop_type), POINTER :: atprop_env 00173 TYPE ( cp_result_type), POINTER :: results 00174 END TYPE force_env_type 00175 00176 ! ***************************************************************************** 00183 TYPE force_env_p_type 00184 TYPE ( force_env_type ), POINTER :: force_env 00185 END TYPE force_env_p_type 00186 00187 CONTAINS 00188 00189 ! ***************************************************************************** 00200 SUBROUTINE force_env_retain(force_env, error) 00201 TYPE(force_env_type), POINTER :: force_env 00202 TYPE(cp_error_type), INTENT(inout) :: error 00203 00204 CHARACTER(len=*), PARAMETER :: routineN = 'force_env_retain', 00205 routineP = moduleN//':'//routineN 00206 00207 LOGICAL :: failure 00208 00209 failure=.FALSE. 00210 00211 CPPrecondition(ASSOCIATED(force_env),cp_failure_level,routineP,error,failure) 00212 IF (.NOT. failure) THEN 00213 CPPreconditionNoFail(force_env%ref_count>0,cp_failure_level,routineP,error) 00214 force_env%ref_count=force_env%ref_count+1 00215 END IF 00216 END SUBROUTINE force_env_retain 00217 00218 ! ***************************************************************************** 00229 RECURSIVE SUBROUTINE force_env_release(force_env, error) 00230 TYPE(force_env_type), POINTER :: force_env 00231 TYPE(cp_error_type), INTENT(inout) :: error 00232 00233 CHARACTER(len=*), PARAMETER :: routineN = 'force_env_release', 00234 routineP = moduleN//':'//routineN 00235 00236 INTEGER :: i, my_group, stat 00237 LOGICAL :: failure 00238 TYPE(cp_error_type) :: my_error 00239 00240 failure=.FALSE. 00241 IF (ASSOCIATED(force_env)) THEN 00242 CPPreconditionNoFail(force_env%ref_count>0,cp_failure_level,routineP,error) 00243 force_env%ref_count=force_env%ref_count-1 00244 IF (force_env%ref_count==0) THEN 00245 force_env%ref_count=1 00246 ! Deallocate Subsys 00247 IF (ASSOCIATED(force_env%subsys)) THEN 00248 CALL cp_subsys_release(force_env%subsys, error=error) 00249 END IF 00250 ! Deallocate SUB_FORCE_ENV 00251 IF (ASSOCIATED(force_env%sub_force_env)) THEN 00252 DO i=1,SIZE(force_env%sub_force_env) 00253 IF (.NOT.ASSOCIATED(force_env%sub_force_env(i)%force_env)) CYCLE 00254 ! Use the proper error to deallocate.. 00255 my_error=error 00256 IF (force_env%in_use==use_mixed_force) THEN 00257 my_group = force_env%mixed_env%group_distribution(force_env%para_env%mepos) 00258 my_error = force_env%mixed_env%sub_error(my_group+1) 00259 END IF 00260 CALL force_env_release(force_env%sub_force_env(i)%force_env,& 00261 error=my_error) 00262 CALL cp_error_check(my_error, failure) 00263 END DO 00264 DEALLOCATE(force_env%sub_force_env,stat=stat) 00265 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00266 END IF 00267 00268 SELECT CASE ( force_env%in_use ) 00269 CASE ( use_fist_force ) 00270 CALL fist_env_release(force_env%fist_env,error=error) 00271 CASE ( use_qs_force ) 00272 CALL qs_env_release(force_env%qs_env,error=error) 00273 CASE ( use_eip_force ) 00274 CALL eip_env_release(force_env%eip_env, error=error) 00275 CASE ( use_ep_force ) 00276 CALL ep_env_release(force_env%ep_env, error=error) 00277 CASE (use_mixed_force) 00278 CALL mixed_env_release(force_env%mixed_env,error=error) 00279 END SELECT 00280 CALL cp_result_release(results=force_env%results,error=error) 00281 CALL cpot_release(force_env%cpot_env,error=error) 00282 CALL atprop_release(force_env%atprop_env,error=error) 00283 CALL globenv_release(force_env%globenv,error=error) 00284 CALL cp_para_env_release(force_env%para_env,error=error) 00285 ! Not deallocated 00286 CPAssert(.NOT.ASSOCIATED(force_env%fist_env),cp_warning_level,routineP,error,failure) 00287 CPAssert(.NOT.ASSOCIATED(force_env%qs_env),cp_warning_level,routineP,error,failure) 00288 CPAssert(.NOT.ASSOCIATED(force_env%eip_env),cp_warning_level,routineP,error,failure) 00289 CPAssert(.NOT.ASSOCIATED(force_env%ep_env),cp_warning_level,routineP,error,failure) 00290 CPAssert(.NOT.ASSOCIATED(force_env%mixed_env),cp_warning_level,routineP,error,failure) 00291 CALL meta_env_release(force_env%meta_env,error=error) 00292 CALL fp_env_release(force_env%fp_env,error=error) 00293 CALL qmmm_env_qm_release(force_env%qmmm_env,error=error) 00294 CALL virial_release(force_env%virial,error=error) 00295 CALL section_vals_release(force_env%force_env_section,error=error) 00296 CALL section_vals_release(force_env%root_section,error=error) 00297 force_env%ref_count=0 00298 DEALLOCATE(force_env,stat=stat) 00299 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00300 END IF 00301 END IF 00302 NULLIFY(force_env) 00303 END SUBROUTINE force_env_release 00304 00305 ! ***************************************************************************** 00315 RECURSIVE SUBROUTINE force_env_get(force_env, in_use, fist_env, qs_env, & 00316 meta_env, fp_env, atprop_env, subsys, para_env, potential_energy, additional_potential, & 00317 kinetic_energy, harmonic_shell, kinetic_shell, cell, cell_ref, sub_force_env,& 00318 qmmm_env, eip_env, virial, use_ref_cell, globenv, input, ep_env, force_env_section, & 00319 method_name_id, root_section, mixed_env, results, error) 00320 00321 TYPE(force_env_type), POINTER :: force_env 00322 INTEGER, INTENT(out), OPTIONAL :: in_use 00323 TYPE(fist_environment_type), OPTIONAL, 00324 POINTER :: fist_env 00325 TYPE(qs_environment_type), OPTIONAL, 00326 POINTER :: qs_env 00327 TYPE(meta_env_type), OPTIONAL, POINTER :: meta_env 00328 TYPE(fp_type), OPTIONAL, POINTER :: fp_env 00329 TYPE(atprop_type), OPTIONAL, POINTER :: atprop_env 00330 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys 00331 TYPE(cp_para_env_type), OPTIONAL, 00332 POINTER :: para_env 00333 REAL(KIND=dp), INTENT(OUT), OPTIONAL :: potential_energy, 00334 additional_potential, kinetic_energy, harmonic_shell, kinetic_shell 00335 TYPE(cell_type), OPTIONAL, POINTER :: cell, cell_ref 00336 TYPE(force_env_p_type), DIMENSION(:), 00337 OPTIONAL, POINTER :: sub_force_env 00338 TYPE(qmmm_env_qm_type), OPTIONAL, 00339 POINTER :: qmmm_env 00340 TYPE(eip_environment_type), OPTIONAL, 00341 POINTER :: eip_env 00342 TYPE(virial_type), OPTIONAL, POINTER :: virial 00343 LOGICAL, INTENT(out), OPTIONAL :: use_ref_cell 00344 TYPE(global_environment_type), 00345 OPTIONAL, POINTER :: globenv 00346 TYPE(section_vals_type), OPTIONAL, 00347 POINTER :: input 00348 TYPE(ep_env_type), OPTIONAL, POINTER :: ep_env 00349 TYPE(section_vals_type), OPTIONAL, 00350 POINTER :: force_env_section 00351 INTEGER, INTENT(out), OPTIONAL :: method_name_id 00352 TYPE(section_vals_type), OPTIONAL, 00353 POINTER :: root_section 00354 TYPE(mixed_environment_type), OPTIONAL, 00355 POINTER :: mixed_env 00356 TYPE(cp_result_type), OPTIONAL, POINTER :: results 00357 TYPE(cp_error_type), INTENT(inout) :: error 00358 00359 CHARACTER(len=*), PARAMETER :: routineN = 'force_env_get', 00360 routineP = moduleN//':'//routineN 00361 00362 INTEGER :: cur_subsys 00363 LOGICAL :: failure 00364 REAL(KIND=dp) :: eip_kinetic_energy, 00365 eip_potential_energy, 00366 penergy_mm, penergy_qm 00367 TYPE(fist_energy_type), POINTER :: thermo 00368 TYPE(mixed_energy_type), POINTER :: mixed_energy 00369 TYPE(qs_energy_type), POINTER :: qs_energy 00370 00371 failure=.FALSE. 00372 00373 CPPrecondition(ASSOCIATED(force_env),cp_failure_level,routineP,error,failure) 00374 CPPrecondition(force_env%ref_count>0,cp_failure_level,routineP,error,failure) 00375 IF (.NOT. failure) THEN 00376 00377 SELECT CASE(force_env%in_use) 00378 CASE(use_ep_force) 00379 CPPrecondition(ASSOCIATED(force_env%ep_env),cp_failure_level,routineP,error,failure) 00380 CALL get_qs_env(force_env%ep_env%main_qs_env,& 00381 cell=cell,& 00382 cell_ref=cell_ref,& 00383 use_ref_cell=use_ref_cell,& 00384 input=input,& 00385 error=error) 00386 IF (PRESENT(potential_energy)) potential_energy = force_env%ep_env%energy%e_tot 00387 CPPrecondition(.NOT.PRESENT(kinetic_energy),cp_failure_level,routineP,error,failure) 00388 CASE (use_qs_force) 00389 CPPrecondition(ASSOCIATED(force_env%qs_env),cp_failure_level,routineP,error,failure) 00390 CPPreconditionNoFail(.NOT.PRESENT(fist_env),cp_warning_level,routineP,error) 00391 CPPreconditionNoFail(.NOT.PRESENT(eip_env),cp_warning_level,routineP,error) 00392 CALL get_qs_env(force_env%qs_env,& 00393 energy=qs_energy,& 00394 cell=cell,& 00395 cell_ref=cell_ref,& 00396 use_ref_cell=use_ref_cell,& 00397 input=input,& 00398 error=error) 00399 IF (PRESENT(potential_energy)) potential_energy = qs_energy%total 00400 CPPrecondition(.NOT.PRESENT(kinetic_energy),cp_failure_level,routineP,error,failure) 00401 CASE (use_fist_force) 00402 CPPrecondition(ASSOCIATED(force_env%fist_env),cp_failure_level,routineP,error,failure) 00403 CPPreconditionNoFail(.NOT.PRESENT(qs_env),cp_warning_level,routineP,error) 00404 CPPreconditionNoFail(.NOT.PRESENT(eip_env),cp_warning_level,routineP,error) 00405 CPPrecondition(.NOT.PRESENT(input),cp_failure_level,routineP,error,failure) 00406 CALL fist_env_get(force_env%fist_env,& 00407 thermo=thermo,& 00408 cell=cell,& 00409 cell_ref=cell_ref,& 00410 error=error) 00411 IF (PRESENT(potential_energy)) potential_energy = thermo%pot 00412 IF (PRESENT(kinetic_energy)) kinetic_energy = thermo%kin 00413 IF (PRESENT(use_ref_cell)) use_ref_cell = .FALSE. 00414 IF (PRESENT(kinetic_shell)) kinetic_shell = thermo%kin_shell 00415 IF (PRESENT(harmonic_shell)) harmonic_shell = thermo%harm_shell 00416 CASE (use_eip_force) 00417 CPPrecondition(ASSOCIATED(force_env%eip_env), cp_failure_level, routineP, error, failure) 00418 CPPreconditionNoFail(.NOT. PRESENT(qs_env), cp_warning_level, routineP, error) 00419 CPPreconditionNoFail(.NOT. PRESENT(fist_env), cp_warning_level, routineP, error) 00420 CALL eip_env_get(force_env%eip_env,& 00421 cell=cell,& 00422 cell_ref=cell_ref, & 00423 use_ref_cell=use_ref_cell,& 00424 eip_potential_energy=eip_potential_energy,& 00425 eip_kinetic_energy=eip_kinetic_energy,& 00426 error=error) 00427 IF (PRESENT(potential_energy)) THEN 00428 potential_energy = eip_potential_energy 00429 END IF 00430 IF (PRESENT(kinetic_energy)) kinetic_energy = eip_kinetic_energy 00431 CPPrecondition(.NOT.PRESENT(kinetic_energy),cp_failure_level,routineP,error,failure) 00432 CASE (use_qmmm) 00433 IF (PRESENT(cell)) THEN 00434 CALL force_env_get(force_env%sub_force_env(primary_subsys)%force_env,& 00435 cell=cell,& 00436 error=error) 00437 ENDIF 00438 IF (PRESENT(cell_ref)) THEN 00439 CALL force_env_get(force_env%sub_force_env(primary_subsys)%force_env,& 00440 cell_ref=cell_ref,& 00441 error=error) 00442 ENDIF 00443 IF (PRESENT(use_ref_cell)) use_ref_cell = .FALSE. 00444 IF (PRESENT(kinetic_energy)) THEN 00445 CALL force_env_get(force_env%sub_force_env(primary_subsys)%force_env,& 00446 kinetic_energy=kinetic_energy,& 00447 error=error) 00448 END IF 00449 IF (PRESENT(potential_energy)) THEN 00450 ! get the underlying energies from primary subsys. This is the only subsys 00451 ! for conventional QM/MM, and force-mixing knows to put relevant energy there. 00452 IF (SIZE(force_env%sub_force_env) == 1) THEN 00453 cur_subsys = primary_subsys 00454 ELSE IF (SIZE(force_env%sub_force_env) == 2) THEN 00455 cur_subsys = force_mixing_extended_subsys 00456 ELSE 00457 CALL cp_assert(.FALSE.,cp_failure_level,cp_assertion_failed,& 00458 routineP,"bad number of sub_force_envs getting qmmm potential energy "//& 00459 CPSourceFileRef,& 00460 error,failure) 00461 ENDIF 00462 CALL force_env_get(force_env%sub_force_env(cur_subsys)%force_env%sub_force_env(fist_subsys)%force_env,& 00463 potential_energy=penergy_mm,& 00464 error=error) 00465 CALL force_env_get(force_env%sub_force_env(cur_subsys)%force_env%sub_force_env(qs_subsys)%force_env,& 00466 potential_energy=penergy_qm,& 00467 error=error) 00468 potential_energy = penergy_qm+penergy_mm 00469 ENDIF 00470 CASE (use_mixed_force) 00471 CPPrecondition(ASSOCIATED(force_env%mixed_env),cp_failure_level,routineP,error,failure) 00472 CPPreconditionNoFail(.NOT.PRESENT(qs_env),cp_warning_level,routineP,error) 00473 CPPreconditionNoFail(.NOT.PRESENT(eip_env),cp_warning_level,routineP,error) 00474 CPPrecondition(.NOT.PRESENT(input),cp_failure_level,routineP,error,failure) 00475 CALL get_mixed_env(force_env%mixed_env,& 00476 mixed_energy=mixed_energy,& 00477 cell=cell,& 00478 cell_ref=cell_ref,& 00479 error=error) 00480 IF (PRESENT(potential_energy)) potential_energy = mixed_energy%pot 00481 IF (PRESENT(kinetic_energy)) kinetic_energy = mixed_energy%kin 00482 IF (PRESENT(use_ref_cell)) use_ref_cell = .FALSE. 00483 CASE DEFAULT 00484 CALL cp_assert(.FALSE.,cp_failure_level,cp_assertion_failed,& 00485 routineP,"unknown in_use flag value "//& 00486 CPSourceFileRef,& 00487 error,failure) 00488 END SELECT 00489 00490 IF (PRESENT(force_env_section)) force_env_section => force_env%force_env_section 00491 IF (PRESENT(in_use)) in_use=force_env%in_use 00492 IF (PRESENT(method_name_id))method_name_id=force_env%method_name_id 00493 IF (PRESENT(fist_env)) THEN 00494 fist_env => force_env%fist_env 00495 END IF 00496 IF (PRESENT(qs_env)) THEN 00497 qs_env => force_env%qs_env 00498 END IF 00499 IF (PRESENT(eip_env)) THEN 00500 eip_env => force_env%eip_env 00501 END IF 00502 IF (PRESENT(results)) results => force_env%results 00503 IF (PRESENT(subsys)) subsys => force_env%subsys 00504 IF (PRESENT(para_env)) para_env => force_env%para_env 00505 ! adjust the total energy for the metadynamics 00506 IF (ASSOCIATED(force_env%meta_env)) THEN 00507 IF (PRESENT(potential_energy)) THEN 00508 potential_energy=potential_energy + & 00509 force_env%meta_env%epot_s + & 00510 force_env%meta_env%epot_walls + & 00511 force_env%meta_env%hills_env%energy 00512 END IF 00513 IF (PRESENT(kinetic_energy)) THEN 00514 kinetic_energy=kinetic_energy+force_env%meta_env%ekin_s 00515 END IF 00516 END IF 00517 ! adjust the total energy for the flexible partitioning 00518 IF (ASSOCIATED(force_env%fp_env) .AND. PRESENT(potential_energy)) THEN 00519 IF (force_env%fp_env%use_fp) THEN 00520 potential_energy=potential_energy+force_env%fp_env%energy 00521 ENDIF 00522 ENDIF 00523 IF (PRESENT(potential_energy)) THEN 00524 potential_energy = potential_energy + force_env%additional_potential 00525 END IF 00526 IF (PRESENT(additional_potential)) THEN 00527 additional_potential = force_env%additional_potential 00528 END IF 00529 IF (PRESENT(fp_env)) fp_env => force_env%fp_env 00530 IF (PRESENT(atprop_env)) atprop_env => force_env%atprop_env 00531 IF (PRESENT(meta_env)) meta_env => force_env%meta_env 00532 IF (PRESENT(sub_force_env)) sub_force_env => force_env%sub_force_env 00533 IF (PRESENT(qmmm_env)) qmmm_env => force_env%qmmm_env 00534 IF (PRESENT(mixed_env)) mixed_env => force_env%mixed_env 00535 IF (PRESENT(virial)) virial => force_env%virial 00536 IF (PRESENT(globenv)) globenv => force_env%globenv 00537 IF (PRESENT(root_section)) root_section => force_env%root_section 00538 IF (PRESENT(ep_env)) ep_env => force_env%ep_env 00539 END IF 00540 00541 END SUBROUTINE force_env_get 00542 00543 ! ***************************************************************************** 00552 FUNCTION force_env_get_natom(force_env,error) RESULT(n_atom) 00553 00554 TYPE(force_env_type), POINTER :: force_env 00555 TYPE(cp_error_type), INTENT(inout) :: error 00556 INTEGER :: n_atom 00557 00558 CHARACTER(LEN=*), PARAMETER :: routineN = 'force_env_get_natom', 00559 routineP = moduleN//':'//routineN 00560 00561 LOGICAL :: failure 00562 TYPE(cp_subsys_type), POINTER :: subsys 00563 00564 failure = .FALSE. 00565 n_atom = 0 00566 NULLIFY (subsys) 00567 CALL force_env_get(force_env,subsys=subsys,error=error) 00568 CALL cp_error_check(error,failure) 00569 IF (.NOT.failure) THEN 00570 CALL cp_subsys_get(subsys,natom=n_atom,error=error) 00571 END IF 00572 00573 END FUNCTION force_env_get_natom 00574 00575 ! ***************************************************************************** 00584 FUNCTION force_env_get_nparticle(force_env,error) RESULT(n_particle) 00585 00586 TYPE(force_env_type), POINTER :: force_env 00587 TYPE(cp_error_type), INTENT(inout) :: error 00588 INTEGER :: n_particle 00589 00590 CHARACTER(LEN=*), PARAMETER :: routineN = 'force_env_get_nparticle', 00591 routineP = moduleN//':'//routineN 00592 00593 LOGICAL :: failure 00594 TYPE(cp_subsys_type), POINTER :: subsys 00595 00596 failure = .FALSE. 00597 n_particle = 0 00598 NULLIFY (subsys) 00599 CALL force_env_get(force_env,subsys=subsys,error=error) 00600 CALL cp_error_check(error,failure) 00601 IF (.NOT.failure) THEN 00602 CALL cp_subsys_get(subsys,nparticle=n_particle,error=error) 00603 END IF 00604 00605 END FUNCTION force_env_get_nparticle 00606 00607 ! ***************************************************************************** 00616 SUBROUTINE force_env_get_frc(force_env,frc,n,error) 00617 00618 TYPE(force_env_type), POINTER :: force_env 00619 REAL(KIND=dp), DIMENSION(*), INTENT(OUT) :: frc 00620 INTEGER, INTENT(IN) :: n 00621 TYPE(cp_error_type), INTENT(INOUT) :: error 00622 00623 CHARACTER(LEN=*), PARAMETER :: routineN = 'force_env_get_frc', 00624 routineP = moduleN//':'//routineN 00625 00626 INTEGER :: handle 00627 LOGICAL :: failure 00628 TYPE(cp_subsys_type), POINTER :: subsys 00629 00630 failure = .FALSE. 00631 CALL timeset(routineN,handle) 00632 CPPrecondition(ASSOCIATED(force_env),cp_failure_level,routineP,error,failure) 00633 CPPrecondition((force_env%ref_count > 0),cp_failure_level,routineP,error,failure) 00634 CALL force_env_get(force_env,subsys=subsys,error=error) 00635 CALL cp_error_check(error,failure) 00636 IF (.NOT.failure) THEN 00637 CALL pack_subsys_particles(subsys=subsys,f=frc(1:n),error=error) 00638 END IF 00639 CALL timestop(handle) 00640 00641 END SUBROUTINE force_env_get_frc 00642 00643 ! ***************************************************************************** 00652 SUBROUTINE force_env_get_pos(force_env,pos,n,error) 00653 00654 TYPE(force_env_type), POINTER :: force_env 00655 REAL(kind=dp), DIMENSION(*), INTENT(OUT) :: pos 00656 INTEGER, INTENT(IN) :: n 00657 TYPE(cp_error_type), INTENT(inout) :: error 00658 00659 CHARACTER(LEN=*), PARAMETER :: routineN = 'force_env_get_pos', 00660 routineP = moduleN//':'//routineN 00661 00662 INTEGER :: handle 00663 LOGICAL :: failure 00664 TYPE(cp_subsys_type), POINTER :: subsys 00665 00666 failure = .FALSE. 00667 CALL timeset(routineN,handle) 00668 CPPrecondition(ASSOCIATED(force_env),cp_failure_level,routineP,error,failure) 00669 CPPrecondition((force_env%ref_count > 0),cp_failure_level,routineP,error,failure) 00670 CALL force_env_get(force_env,subsys=subsys,error=error) 00671 CALL cp_error_check(error,failure) 00672 IF (.NOT.failure) THEN 00673 CALL pack_subsys_particles(subsys=subsys,r=pos(1:n),error=error) 00674 END IF 00675 CALL timestop(handle) 00676 00677 END SUBROUTINE force_env_get_pos 00678 00679 ! ***************************************************************************** 00688 SUBROUTINE force_env_get_vel(force_env,vel,n,error) 00689 00690 TYPE(force_env_type), POINTER :: force_env 00691 REAL(KIND=dp), DIMENSION(*), INTENT(OUT) :: vel 00692 INTEGER, INTENT(IN) :: n 00693 TYPE(cp_error_type), INTENT(INOUT) :: error 00694 00695 CHARACTER(LEN=*), PARAMETER :: routineN = 'force_env_get_vel', 00696 routineP = moduleN//':'//routineN 00697 00698 INTEGER :: handle 00699 LOGICAL :: failure 00700 TYPE(cp_subsys_type), POINTER :: subsys 00701 00702 failure = .FALSE. 00703 CALL timeset(routineN,handle) 00704 CPPrecondition(ASSOCIATED(force_env),cp_failure_level,routineP,error,failure) 00705 CPPrecondition((force_env%ref_count > 0),cp_failure_level,routineP,error,failure) 00706 CALL force_env_get(force_env,subsys=subsys,error=error) 00707 CALL cp_error_check(error,failure) 00708 IF (.NOT.failure) THEN 00709 CALL pack_subsys_particles(subsys=subsys,v=vel(1:n),error=error) 00710 END IF 00711 CALL timestop(handle) 00712 00713 END SUBROUTINE force_env_get_vel 00714 00715 ! ***************************************************************************** 00725 SUBROUTINE force_env_set(force_env, meta_env,fp_env, virial, force_env_section,& 00726 method_name_id, additional_potential, results, error) 00727 00728 TYPE(force_env_type), POINTER :: force_env 00729 TYPE(meta_env_type), OPTIONAL, POINTER :: meta_env 00730 TYPE(fp_type), OPTIONAL, POINTER :: fp_env 00731 TYPE(virial_type), OPTIONAL, POINTER :: virial 00732 TYPE(section_vals_type), OPTIONAL, 00733 POINTER :: force_env_section 00734 INTEGER, OPTIONAL :: method_name_id 00735 REAL(KIND=dp), INTENT(IN), OPTIONAL :: additional_potential 00736 TYPE(cp_result_type), OPTIONAL, POINTER :: results 00737 TYPE(cp_error_type), INTENT(inout) :: error 00738 00739 CHARACTER(len=*), PARAMETER :: routineN = 'force_env_set', 00740 routineP = moduleN//':'//routineN 00741 00742 LOGICAL :: failure 00743 00744 failure = .FALSE. 00745 CPPrecondition(ASSOCIATED(force_env),cp_failure_level,routineP,error,failure) 00746 IF (.NOT.failure) THEN 00747 CPPrecondition(force_env%ref_count>0,cp_failure_level,routineP,error,failure) 00748 END IF 00749 IF (.NOT.failure) THEN 00750 IF (PRESENT(meta_env)) THEN 00751 IF (ASSOCIATED(meta_env)) THEN 00752 CALL meta_env_retain(meta_env,error=error) 00753 END IF 00754 CALL meta_env_release(force_env%meta_env,error=error) 00755 force_env%meta_env => meta_env 00756 END IF 00757 IF (PRESENT(fp_env)) THEN 00758 CALL fp_env_retain(fp_env,error=error) 00759 CALL fp_env_release(force_env%fp_env,error=error) 00760 force_env%fp_env => fp_env 00761 END IF 00762 IF (PRESENT(virial)) THEN 00763 IF (ASSOCIATED(virial)) THEN 00764 CALL virial_retain(virial,error=error) 00765 END IF 00766 CALL virial_release(force_env%virial,error=error) 00767 force_env%virial => virial 00768 END IF 00769 IF (PRESENT(force_env_section)) THEN 00770 IF (ASSOCIATED(force_env_section)) THEN 00771 CALL section_vals_retain(force_env_section,error=error) 00772 CALL section_vals_release(force_env%force_env_section,error=error) 00773 force_env%force_env_section => force_env_section 00774 END IF 00775 END IF 00776 IF (PRESENT(additional_potential)) THEN 00777 force_env%additional_potential = additional_potential 00778 END IF 00779 IF (PRESENT(results)) THEN 00780 IF(ASSOCIATED(results)) THEN 00781 CALL cp_result_retain(results,error) 00782 END IF 00783 CALL cp_result_release(force_env%results,error) 00784 force_env%results => results 00785 END IF 00786 IF (PRESENT(method_name_id)) THEN 00787 force_env%method_name_id=method_name_id 00788 END IF 00789 END IF 00790 00791 END SUBROUTINE force_env_set 00792 00793 ! ***************************************************************************** 00806 RECURSIVE SUBROUTINE force_env_set_cell(force_env, cell, error) 00807 00808 TYPE(force_env_type), POINTER :: force_env 00809 TYPE(cell_type), POINTER :: cell 00810 TYPE(cp_error_type), INTENT(INOUT) :: error 00811 00812 CHARACTER(LEN=*), PARAMETER :: routineN = 'force_env_set_cell', 00813 routineP = moduleN//':'//routineN 00814 00815 INTEGER :: iforce_eval, my_group, 00816 nforce_eval 00817 LOGICAL :: failure 00818 TYPE(cp_error_type) :: my_error 00819 TYPE(ewald_environment_type), POINTER :: ewald_env 00820 TYPE(ewald_pw_type), POINTER :: ewald_pw 00821 TYPE(qs_ks_env_type), POINTER :: new_ks_env 00822 TYPE(qs_ks_scp_env_type), POINTER :: new_ks_scp_env 00823 00824 failure=.FALSE. 00825 CPPrecondition(ASSOCIATED(force_env),cp_failure_level,routineP,error,failure) 00826 CPPrecondition(force_env%ref_count>0,cp_failure_level,routineP,error,failure) 00827 CPPrecondition(ASSOCIATED(cell),cp_failure_level,routineP,error,failure) 00828 CPPrecondition(cell%ref_count>0,cp_failure_level,routineP,error,failure) 00829 IF (.NOT. failure) THEN 00830 SELECT CASE(force_env%in_use) 00831 CASE (use_qs_force) 00832 NULLIFY ( new_ks_env ) 00833 CPPrecondition(ASSOCIATED(force_env%qs_env),cp_failure_level,routineP,error,failure) 00834 CALL set_qs_env(force_env%qs_env,cell=cell,error=error) 00835 CALL qs_env_rebuild_pw_env( force_env % qs_env, error = error) 00836 CALL qs_ks_create ( new_ks_env, force_env % qs_env ,error = error ) 00837 CALL set_qs_env( force_env % qs_env, ks_env=new_ks_env ,error=error) 00838 CALL qs_ks_release ( new_ks_env ,error=error) 00839 IF ( force_env % qs_env % dft_control % scp ) THEN 00840 ! initialize the SCP env to the qs env 00841 CALL scp_qs_rspw_rebuild (force_env%qs_env%scp_env%rspw, & 00842 qs_env = force_env % qs_env, & 00843 error = error) 00844 ! update the ks_scp_environment 00845 CALL qs_ks_scp_create (new_ks_scp_env, force_env % qs_env, error ) 00846 CALL set_scp_env (force_env % qs_env % scp_env, & 00847 ks_scp_env = new_ks_scp_env, & 00848 error = error ) 00849 CALL qs_ks_scp_release ( new_ks_scp_env, error=error ) 00850 ENDIF 00851 CASE (use_ep_force) 00852 NULLIFY ( new_ks_env ) 00853 CPPrecondition(ASSOCIATED(force_env%ep_env),cp_failure_level,routineP,error,failure) 00854 CALL set_qs_env(force_env%ep_env%main_qs_env,cell=cell,error=error) 00855 CALL qs_env_rebuild_pw_env( force_env % ep_env%main_qs_env, error=error) 00856 CALL qs_ks_create ( new_ks_env, force_env % qs_env ,error=error) 00857 CALL set_qs_env( force_env % ep_env%main_qs_env, ks_env=new_ks_env ,error=error) 00858 CALL qs_ks_release ( new_ks_env ,error=error) 00859 CASE (use_fist_force) 00860 CPPrecondition(ASSOCIATED(force_env%fist_env),cp_failure_level,routineP,error,failure) 00861 CALL fist_env_get ( force_env%fist_env, ewald_pw = ewald_pw, & 00862 ewald_env = ewald_env ,error=error) 00863 CALL fist_env_set(force_env%fist_env, cell=cell, error=error) 00864 CALL ewald_pw_grid_change ( ewald_pw, ewald_env, cell, error ) 00865 CASE (use_eip_force) 00866 CPAssert(.FALSE., cp_failure_level, routineP, error, failure) 00867 CASE (use_mixed_force) 00868 CPPrecondition(ASSOCIATED(force_env%mixed_env),cp_failure_level,routineP,error,failure) 00869 nforce_eval = SIZE(force_env%sub_force_env) 00870 my_group = force_env%mixed_env%group_distribution(force_env%para_env%mepos) 00871 my_error = force_env%mixed_env%sub_error(my_group+1) 00872 DO iforce_eval = 1, nforce_eval 00873 IF (ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) THEN 00874 CALL force_env_set_cell(force_env=force_env%sub_force_env(iforce_eval)%force_env,& 00875 cell=cell, error=my_error) 00876 END IF 00877 END DO 00878 CASE default 00879 CALL cp_assert(.FALSE.,cp_failure_level,cp_assertion_failed,& 00880 routineP,"unknown in_use flag value "//& 00881 CPSourceFileRef,& 00882 error,failure) 00883 END SELECT 00884 END IF 00885 00886 END SUBROUTINE force_env_set_cell 00887 00888 ! ***************************************************************************** 00896 SUBROUTINE multiple_fe_list(force_env_sections, root_section, i_force_eval, nforce_eval, error) 00897 00898 TYPE(section_vals_type), POINTER :: force_env_sections, 00899 root_section 00900 INTEGER, DIMENSION(:), POINTER :: i_force_eval 00901 INTEGER :: nforce_eval 00902 TYPE(cp_error_type), INTENT(inout) :: error 00903 00904 CHARACTER(len=*), PARAMETER :: routineN = 'multiple_fe_list', 00905 routineP = moduleN//':'//routineN 00906 00907 INTEGER :: iforce_eval, main_force_eval, 00908 stat 00909 INTEGER, DIMENSION(:), POINTER :: my_i_force_eval 00910 LOGICAL :: failure 00911 00912 failure = .FALSE. 00913 ! Let's treat the case of Multiple force_eval 00914 CALL section_vals_get(force_env_sections, n_repetition=nforce_eval, error=error) 00915 CALL section_vals_val_get(root_section,"MULTIPLE_FORCE_EVALS%FORCE_EVAL_ORDER",& 00916 i_vals=my_i_force_eval,ignore_required=.TRUE.,error=error) 00917 ALLOCATE(i_force_eval(nforce_eval),stat=stat) 00918 CPPostcondition(stat==0,cp_fatal_level,routineP,error,failure) 00919 IF (nforce_eval>0) THEN 00920 IF (nforce_eval==SIZE(my_i_force_eval)) THEN 00921 i_force_eval = my_i_force_eval 00922 ELSE 00923 ! The difference in the amount of defined force_env MUST be one.. 00924 CPPostcondition(nforce_eval-SIZE(my_i_force_eval)==1,cp_fatal_level,routineP,error,failure) 00925 DO iforce_eval = 1, nforce_eval 00926 IF (ANY(my_i_force_eval==iforce_eval)) CYCLE 00927 main_force_eval = iforce_eval 00928 EXIT 00929 END DO 00930 i_force_eval(1) = main_force_eval 00931 i_force_eval(2:nforce_eval) = my_i_force_eval 00932 END IF 00933 END IF 00934 00935 END SUBROUTINE multiple_fe_list 00936 00937 END MODULE force_env_types 00938
1.7.3