|
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 ! ***************************************************************************** 00012 MODULE ep_types 00013 USE cp_array_utils, ONLY: cp_2d_r_p_type 00014 USE cp_fm_types, ONLY: cp_fm_p_type 00015 USE cp_fm_vect, ONLY: cp_fm_vect_dealloc 00016 USE cp_para_env, ONLY: cp_para_env_release,& 00017 cp_para_env_retain 00018 USE cp_para_types, ONLY: cp_para_env_type 00019 USE f77_blas 00020 USE global_types, ONLY: global_environment_type,& 00021 globenv_release,& 00022 globenv_retain 00023 USE input_section_types, ONLY: section_vals_release,& 00024 section_vals_retain,& 00025 section_vals_type 00026 USE kinds, ONLY: dp 00027 USE preconditioner_types, ONLY: destroy_preconditioner,& 00028 preconditioner_p_type 00029 USE qs_environment_types, ONLY: qs_env_release,& 00030 qs_environment_type 00031 USE qs_p_env_types, ONLY: p_env_release,& 00032 qs_p_env_type 00033 USE qs_p_sparse_psi, ONLY: p_proj_release,& 00034 qs_p_projection_p_type 00035 USE replica_types, ONLY: rep_env_release,& 00036 replica_env_type 00037 USE timings, ONLY: timeset,& 00038 timestop 00039 #include "cp_common_uses.h" 00040 00041 IMPLICIT NONE 00042 PRIVATE 00043 00044 LOGICAL, PRIVATE, PARAMETER :: debug_this_module=.TRUE. 00045 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'ep_types' 00046 INTEGER, SAVE :: last_ep_env_id=0, last_force_id=0 00047 LOGICAL, SAVE, PRIVATE :: module_initialized=.FALSE. 00048 00049 PUBLIC :: ep_env_type, ep_env_p_type, ep_energy_type, ep_force_type 00050 PUBLIC :: ep_env_retain, ep_env_release, ep_env_get 00051 PUBLIC :: ep_envs_get_ep_env, ep_env_create, ep_env_calc_e_f 00052 PUBLIC :: ep_energy_zero, ep_force_create, ep_force_retain, & 00053 ep_force_release, ep_force_zero 00054 00055 ! ***************************************************************************** 00064 TYPE ep_energy_type 00065 REAL(dp) :: e_no_int,e0,e1,e_tot 00066 END TYPE ep_energy_type 00067 00068 ! ***************************************************************************** 00074 TYPE ep_force_type 00075 INTEGER :: id_nr, ref_count 00076 REAL(dp), DIMENSION(:,:), POINTER :: f0_internal 00077 END TYPE ep_force_type 00078 00079 ! ***************************************************************************** 00110 TYPE ep_env_type 00111 INTEGER :: id_nr, ref_count, f_env_id,nspins,nat,nmol,nat_per_mol 00112 TYPE(global_environment_type), POINTER :: globenv 00113 TYPE(section_vals_type), POINTER :: root_section 00114 TYPE(cp_para_env_type), POINTER :: para_env 00115 TYPE(section_vals_type), POINTER :: input 00116 TYPE(replica_env_type), POINTER :: mol_envs 00117 TYPE(qs_p_projection_p_type), 00118 DIMENSION(:), POINTER :: sub_proj 00119 TYPE(qs_environment_type), POINTER :: main_qs_env 00120 TYPE(qs_p_env_type), POINTER :: main_p_env, sub_p_env 00121 TYPE(cp_fm_p_type), DIMENSION(:), POINTER :: m_pi_Hrho_psi0d 00122 TYPE(cp_fm_p_type), DIMENSION(:), POINTER :: psi1 00123 TYPE(preconditioner_p_type), DIMENSION(:), POINTER :: precond 00124 INTEGER, DIMENSION(:), POINTER :: sub_nmo,sub_nao,full_nmo,full_nao,at2sub 00125 TYPE(ep_energy_type) :: energy 00126 TYPE(ep_force_type), POINTER :: force 00127 TYPE(cp_2d_r_p_type), DIMENSION(:), POINTER :: base_C0 00128 END TYPE ep_env_type 00129 00130 ! ***************************************************************************** 00137 TYPE ep_env_p_type 00138 TYPE(ep_env_type), POINTER :: ep_env 00139 END TYPE ep_env_p_type 00140 00141 TYPE(ep_env_p_type), DIMENSION(:), POINTER, PRIVATE :: ep_envs 00142 00143 CONTAINS 00144 00145 ! ***************************************************************************** 00152 SUBROUTINE ep_energy_zero(ep_energy,error) 00153 TYPE(ep_energy_type), INTENT(out) :: ep_energy 00154 TYPE(cp_error_type), INTENT(inout) :: error 00155 00156 CHARACTER(len=*), PARAMETER :: routineN = 'ep_energy_zero', 00157 routineP = moduleN//':'//routineN 00158 00159 ep_energy%e_no_int=0._dp 00160 ep_energy%e0=0._dp 00161 ep_energy%e1=0._dp 00162 ep_energy%e_tot=0._dp 00163 END SUBROUTINE ep_energy_zero 00164 00165 ! ***************************************************************************** 00174 SUBROUTINE ep_env_retain(ep_env, error) 00175 TYPE(ep_env_type), POINTER :: ep_env 00176 TYPE(cp_error_type), INTENT(inout) :: error 00177 00178 CHARACTER(len=*), PARAMETER :: routineN = 'ep_env_retain', 00179 routineP = moduleN//':'//routineN 00180 00181 LOGICAL :: failure 00182 00183 failure=.FALSE. 00184 00185 CPPrecondition(ASSOCIATED(ep_env),cp_failure_level,routineP,error,failure) 00186 IF (.NOT. failure) THEN 00187 CPPrecondition(ep_env%ref_count>0,cp_failure_level,routineP,error,failure) 00188 ep_env%ref_count=ep_env%ref_count+1 00189 END IF 00190 END SUBROUTINE ep_env_retain 00191 00192 ! ***************************************************************************** 00201 SUBROUTINE ep_env_release(ep_env, error) 00202 TYPE(ep_env_type), POINTER :: ep_env 00203 TYPE(cp_error_type), INTENT(inout) :: error 00204 00205 CHARACTER(len=*), PARAMETER :: routineN = 'ep_env_release', 00206 routineP = moduleN//':'//routineN 00207 00208 INTEGER :: i, ierr, stat 00209 LOGICAL :: failure 00210 00211 failure=.FALSE. 00212 00213 IF (ASSOCIATED(ep_env)) THEN 00214 CPPrecondition(ep_env%ref_count>0,cp_failure_level,routineP,error,failure) 00215 ep_env%ref_count=ep_env%ref_count-1 00216 IF (ep_env%ref_count<1) THEN 00217 CALL rep_env_release(ep_env%mol_envs,error=error) 00218 IF (ASSOCIATED(ep_env%sub_proj)) THEN 00219 DO i=1,SIZE(ep_env%sub_proj) 00220 CALL p_proj_release(ep_env%sub_proj(i)%projection,error=error) 00221 END DO 00222 DEALLOCATE(ep_env%sub_proj,stat=stat) 00223 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00224 END IF 00225 CALL qs_env_release(ep_env%main_qs_env,error=error) 00226 CALL p_env_release(ep_env%main_p_env,error=error) 00227 CALL p_env_release(ep_env%sub_p_env,error=error) 00228 CALL cp_fm_vect_dealloc(ep_env%m_pi_Hrho_psi0d,error=error) 00229 CALL cp_fm_vect_dealloc(ep_env%psi1,error=error) 00230 CALL cp_destroy_fenv(ep_env%f_env_id,ierr) 00231 CPAssert(ierr==0,cp_failure_level,routineP,error,failure) 00232 IF (ASSOCIATED(ep_env%precond)) THEN 00233 DO i=1,1 !SIZE(ep_env%precond) ! same precond for all spins 00234 CALL destroy_preconditioner(ep_env%precond(i)%preconditioner,error=error) 00235 END DO 00236 DEALLOCATE(ep_env%precond,stat=stat) 00237 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00238 END IF 00239 IF (ASSOCIATED(ep_env%sub_nmo)) THEN 00240 DEALLOCATE(ep_env%sub_nmo,ep_env%sub_nao,ep_env%full_nmo,ep_env%full_nao,& 00241 stat=stat) 00242 CPPostcondition(stat==0,cp_warning_level,routineP,error,failure) 00243 END IF 00244 IF (ASSOCIATED(ep_env%at2sub)) THEN 00245 DEALLOCATE(ep_env%at2sub,stat=stat) 00246 CPPostcondition(stat==0,cp_warning_level,routineP,error,failure) 00247 END IF 00248 CALL globenv_release(ep_env%globenv,error=error) 00249 CALL cp_para_env_release(ep_env%para_env,error=error) 00250 CALL section_vals_release(ep_env%input,error=error) 00251 CALL section_vals_release(ep_env%root_section,error=error) 00252 CALL ep_envs_rm_ep_env(ep_env,error=error) 00253 CALL ep_force_release(ep_env%force,error=error) 00254 IF (ASSOCIATED(ep_env%base_C0)) THEN 00255 DO i=1,SIZE(ep_env%base_C0) 00256 DEALLOCATE(ep_env%base_C0(i)%array,stat=stat) 00257 CPPostcondition(stat==0,cp_warning_level,routineP,error,failure) 00258 END DO 00259 DEALLOCATE(ep_env%base_C0,stat=stat) 00260 CPPostcondition(stat==0,cp_warning_level,routineP,error,failure) 00261 END IF 00262 DEALLOCATE(ep_env, stat=stat) 00263 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00264 END IF 00265 END IF 00266 NULLIFY(ep_env) 00267 END SUBROUTINE ep_env_release 00268 00269 ! ***************************************************************************** 00280 SUBROUTINE ep_env_get(ep_env,id_nr, mol_envs, sub_proj, main_qs_env,& 00281 main_p_env,sub_p_env, preconditioner, m_pi_Hrho_psi0d, psi1, f_env_id,& 00282 globenv,at2sub,error) 00283 TYPE(ep_env_type), POINTER :: ep_env 00284 INTEGER, INTENT(out), OPTIONAL :: id_nr 00285 TYPE(replica_env_type), OPTIONAL, 00286 POINTER :: mol_envs 00287 TYPE(qs_p_projection_p_type), 00288 DIMENSION(:), OPTIONAL, POINTER :: sub_proj 00289 TYPE(qs_environment_type), OPTIONAL, 00290 POINTER :: main_qs_env 00291 TYPE(qs_p_env_type), OPTIONAL, POINTER :: main_p_env, sub_p_env 00292 TYPE(preconditioner_p_type), 00293 DIMENSION(:), OPTIONAL, POINTER :: preconditioner 00294 TYPE(cp_fm_p_type), DIMENSION(:), 00295 OPTIONAL, POINTER :: m_pi_Hrho_psi0d, psi1 00296 INTEGER, INTENT(out), OPTIONAL :: f_env_id 00297 TYPE(global_environment_type), 00298 OPTIONAL, POINTER :: globenv 00299 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: at2sub 00300 TYPE(cp_error_type), INTENT(inout) :: error 00301 00302 CHARACTER(len=*), PARAMETER :: routineN = 'ep_env_get', 00303 routineP = moduleN//':'//routineN 00304 00305 LOGICAL :: failure 00306 00307 failure=.FALSE. 00308 00309 CPPrecondition(ASSOCIATED(ep_env),cp_failure_level,routineP,error,failure) 00310 IF (.not.failure) THEN 00311 CPPrecondition(ep_env%ref_count>0,cp_failure_level,routineP,error,failure) 00312 END IF 00313 00314 IF (.NOT. failure) THEN 00315 IF (PRESENT(id_nr)) id_nr=ep_env%id_nr 00316 IF (PRESENT(mol_envs)) mol_envs => ep_env%mol_envs 00317 IF (PRESENT(sub_proj)) sub_proj => ep_env%sub_proj 00318 IF (PRESENT(main_qs_env)) main_qs_env => ep_env%main_qs_env 00319 IF (PRESENT(main_p_env)) main_p_env => ep_env%main_p_env 00320 IF (PRESENT(sub_p_env)) sub_p_env => ep_env%sub_p_env 00321 IF (PRESENT(m_pi_Hrho_psi0d)) m_pi_Hrho_psi0d => ep_env%m_pi_Hrho_psi0d 00322 IF (PRESENT(psi1)) psi1 => ep_env%psi1 00323 !FM IF (PRESENT(nspins)) THEN 00324 !FM CPPrecondition(ASSOCIATED(ep_env%main_qs_env),cp_failure_level,routineP,error,failure) 00325 !FM IF (.not.failure) THEN 00326 !FM nspins=ep_env%main_qs_env%dft_control%nspins 00327 !FM END IF 00328 !FM END IF 00329 IF (PRESENT(preconditioner)) THEN 00330 preconditioner => ep_env%precond 00331 END IF 00332 IF (PRESENT(globenv)) globenv => ep_env%globenv 00333 IF (PRESENT(f_env_id)) f_env_id=ep_env%f_env_id 00334 IF (PRESENT(at2sub)) at2sub => ep_env%at2sub 00335 END IF 00336 END SUBROUTINE ep_env_get 00337 00338 ! ***************************************************************************** 00352 SUBROUTINE ep_env_create(ep_env,root_section,para_env,globenv, error) 00353 TYPE(ep_env_type), POINTER :: ep_env 00354 TYPE(section_vals_type), POINTER :: root_section 00355 TYPE(cp_para_env_type), POINTER :: para_env 00356 TYPE(global_environment_type), POINTER :: globenv 00357 TYPE(cp_error_type), INTENT(inout) :: error 00358 00359 CHARACTER(len=*), PARAMETER :: routineN = 'ep_env_create', 00360 routineP = moduleN//':'//routineN 00361 00362 INTEGER :: handle, ierr, stat 00363 LOGICAL :: failure 00364 00365 failure=.FALSE. 00366 CALL timeset(routineN,handle) 00367 CPPrecondition(.NOT.ASSOCIATED(ep_env),cp_failure_level,routineP,error,failure) 00368 IF (.NOT.failure) THEN 00369 ALLOCATE(ep_env,stat=stat) 00370 CPPostcondition(stat==0,cp_fatal_level,routineP,error,failure) 00371 00372 last_ep_env_id=last_ep_env_id+1 00373 ep_env%id_nr=last_ep_env_id 00374 ep_env%ref_count=1 00375 ep_env%f_env_id=-1 00376 ep_env%nspins=-1 00377 ep_env%nat=-1 00378 ep_env%nat_per_mol=-1 00379 ep_env%nmol=-1 00380 NULLIFY(ep_env%mol_envs,ep_env%sub_proj,ep_env%main_qs_env,& 00381 ep_env%main_p_env,ep_env%sub_p_env,ep_env%m_pi_Hrho_psi0d,& 00382 ep_env%psi1, ep_env%precond,ep_env%sub_nmo,ep_env%sub_nao,& 00383 ep_env%full_nmo,ep_env%full_nao,ep_env%input,ep_env%at2sub,& 00384 ep_env%force,ep_env%root_section,ep_env%base_C0) 00385 CALL ep_energy_zero(ep_env%energy,error=error) 00386 ep_env%root_section => root_section 00387 CALL section_vals_retain(root_section,error) 00388 ep_env%globenv => globenv 00389 CALL globenv_retain(globenv,error=error) 00390 ep_env%para_env=>para_env 00391 CALL cp_para_env_retain(ep_env%para_env,error=error) 00392 00393 CALL ep_envs_add_ep_env(ep_env,error=error) 00394 CALL cp_ep_init(ep_env%id_nr,ierr) 00395 00396 CPAssert(ierr==0,cp_failure_level,routineP,error,failure) 00397 END IF 00398 CALL timestop(handle) 00399 END SUBROUTINE ep_env_create 00400 00401 ! ***************************************************************************** 00406 FUNCTION ep_envs_get_ep_env(id_nr) RESULT(res) 00407 INTEGER, INTENT(in) :: id_nr 00408 TYPE(ep_env_type), POINTER :: res 00409 00410 CHARACTER(len=*), PARAMETER :: routineN = 'ep_envs_get_ep_env', 00411 routineP = moduleN//':'//routineN 00412 00413 INTEGER :: i 00414 00415 NULLIFY(res) 00416 IF (module_initialized) THEN 00417 IF (ASSOCIATED(ep_envs)) THEN 00418 DO i=1,SIZE(ep_envs) 00419 IF (ep_envs(i)%ep_env%id_nr==id_nr) THEN 00420 res => ep_envs(i)%ep_env 00421 EXIT 00422 END IF 00423 END DO 00424 END IF 00425 END IF 00426 END FUNCTION ep_envs_get_ep_env 00427 00428 ! ***************************************************************************** 00435 SUBROUTINE ep_envs_add_ep_env(ep_env,error) 00436 TYPE(ep_env_type), POINTER :: ep_env 00437 TYPE(cp_error_type), INTENT(inout) :: error 00438 00439 CHARACTER(len=*), PARAMETER :: routineN = 'ep_envs_add_ep_env', 00440 routineP = moduleN//':'//routineN 00441 00442 INTEGER :: i, stat 00443 LOGICAL :: failure 00444 TYPE(ep_env_p_type), DIMENSION(:), 00445 POINTER :: new_ep_envs 00446 TYPE(ep_env_type), POINTER :: ep_env2 00447 00448 failure=.FALSE. 00449 00450 IF (ASSOCIATED(ep_env)) THEN 00451 ep_env2 => ep_envs_get_ep_env(ep_env%id_nr) 00452 IF (.NOT.ASSOCIATED(ep_env2)) THEN 00453 IF (module_initialized) THEN 00454 IF (ASSOCIATED(ep_envs)) THEN 00455 ALLOCATE(new_ep_envs(SIZE(ep_envs)+1),stat=stat) 00456 CPPostcondition(stat==0,cp_fatal_level,routineP,error,failure) 00457 DO i=1,SIZE(ep_envs) 00458 new_ep_envs(i)%ep_env => ep_envs(i)%ep_env 00459 END DO 00460 DEALLOCATE(ep_envs,stat=stat) 00461 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00462 ep_envs => new_ep_envs 00463 ELSE 00464 ALLOCATE(ep_envs(1),stat=stat) 00465 CPPostcondition(stat==0,cp_fatal_level,routineP,error,failure) 00466 END IF 00467 ELSE 00468 ALLOCATE(ep_envs(1),stat=stat) 00469 CPPostcondition(stat==0,cp_fatal_level,routineP,error,failure) 00470 END IF 00471 ep_envs(SIZE(ep_envs))%ep_env => ep_env 00472 module_initialized=.TRUE. 00473 END IF 00474 END IF 00475 END SUBROUTINE ep_envs_add_ep_env 00476 00477 ! ***************************************************************************** 00484 SUBROUTINE ep_envs_rm_ep_env(ep_env,error) 00485 TYPE(ep_env_type), POINTER :: ep_env 00486 TYPE(cp_error_type), INTENT(inout) :: error 00487 00488 CHARACTER(len=*), PARAMETER :: routineN = 'ep_envs_rm_ep_env', 00489 routineP = moduleN//':'//routineN 00490 00491 INTEGER :: i, ii, stat 00492 LOGICAL :: failure 00493 TYPE(ep_env_p_type), DIMENSION(:), 00494 POINTER :: new_ep_envs 00495 00496 failure=.FALSE. 00497 00498 IF (ASSOCIATED(ep_env)) THEN 00499 CPPrecondition(module_initialized,cp_failure_level,routineP,error,failure) 00500 ALLOCATE(new_ep_envs(SIZE(ep_envs)-1),stat=stat) 00501 CPPostcondition(stat==0,cp_fatal_level,routineP,error,failure) 00502 ii=0 00503 DO i=1,SIZE(ep_envs) 00504 IF (ep_envs(i)%ep_env%id_nr/=ep_env%id_nr) THEN 00505 ii=ii+1 00506 new_ep_envs(ii)%ep_env => ep_envs(i)%ep_env 00507 END IF 00508 END DO 00509 CPPostcondition(ii==SIZE(new_ep_envs),cp_failure_level,routineP,error,failure) 00510 DEALLOCATE(ep_envs,stat=stat) 00511 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00512 ep_envs => new_ep_envs 00513 IF (SIZE(ep_envs)==0) THEN 00514 DEALLOCATE(ep_envs,stat=stat) 00515 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00516 END IF 00517 END IF 00518 END SUBROUTINE ep_envs_rm_ep_env 00519 00520 ! ***************************************************************************** 00526 SUBROUTINE ep_env_calc_e_f(ep_env,calc_f,error) 00527 TYPE(ep_env_type), POINTER :: ep_env 00528 LOGICAL, INTENT(in) :: calc_f 00529 TYPE(cp_error_type), INTENT(inout) :: error 00530 00531 CHARACTER(len=*), PARAMETER :: routineN = 'ep_env_calc_e_f', 00532 routineP = moduleN//':'//routineN 00533 00534 INTEGER :: ierr, my_calc_f 00535 LOGICAL :: failure 00536 00537 failure=.FALSE. 00538 00539 IF (.NOT.failure) THEN 00540 IF (calc_f) THEN 00541 my_calc_f=1 00542 ELSE 00543 my_calc_f=0 00544 END IF 00545 CALL cp_ep_calc_e_f(ep_env%id_nr,my_calc_f,ierr) 00546 CPAssert(ierr==0,cp_failure_level,routineP,error,failure) 00547 END IF 00548 END SUBROUTINE ep_env_calc_e_f 00549 00550 ! ***************************************************************************** 00558 SUBROUTINE ep_force_create(force,nat,error) 00559 TYPE(ep_force_type), POINTER :: force 00560 INTEGER, INTENT(in) :: nat 00561 TYPE(cp_error_type), INTENT(inout) :: error 00562 00563 CHARACTER(len=*), PARAMETER :: routineN = 'ep_force_create', 00564 routineP = moduleN//':'//routineN 00565 00566 INTEGER :: stat 00567 LOGICAL :: failure 00568 00569 failure=.FALSE. 00570 CPPrecondition(.NOT.ASSOCIATED(force),cp_failure_level,routineP,error,failure) 00571 IF (.NOT. failure) THEN 00572 ALLOCATE(force,stat=stat) 00573 CPPostcondition(stat==0,cp_fatal_level,routineP,error,failure) 00574 END IF 00575 IF (.NOT. failure) THEN 00576 last_force_id=last_force_id+1 00577 force%id_nr=last_force_id 00578 force%ref_count=1 00579 ALLOCATE(force%f0_internal(3,nat),stat=stat) 00580 CPPostcondition(stat==0,cp_fatal_level,routineP,error,failure) 00581 END IF 00582 END SUBROUTINE ep_force_create 00583 00584 ! ***************************************************************************** 00591 SUBROUTINE ep_force_zero(force,error) 00592 TYPE(ep_force_type), POINTER :: force 00593 TYPE(cp_error_type), INTENT(inout) :: error 00594 00595 CHARACTER(len=*), PARAMETER :: routineN = 'ep_force_zero', 00596 routineP = moduleN//':'//routineN 00597 00598 LOGICAL :: failure 00599 00600 failure=.FALSE. 00601 CPPrecondition(ASSOCIATED(force),cp_failure_level,routineP,error,failure) 00602 CPPrecondition(force%ref_count>0,cp_failure_level,routineP,error,failure) 00603 IF (.NOT. failure) THEN 00604 force%f0_internal=0._dp 00605 END IF 00606 END SUBROUTINE ep_force_zero 00607 00608 ! ***************************************************************************** 00615 SUBROUTINE ep_force_retain(force,error) 00616 TYPE(ep_force_type), POINTER :: force 00617 TYPE(cp_error_type), INTENT(inout) :: error 00618 00619 CHARACTER(len=*), PARAMETER :: routineN = 'ep_force_retain', 00620 routineP = moduleN//':'//routineN 00621 00622 LOGICAL :: failure 00623 00624 failure=.FALSE. 00625 CPPrecondition(ASSOCIATED(force),cp_failure_level,routineP,error,failure) 00626 CPPrecondition(force%ref_count>0,cp_failure_level,routineP,error,failure) 00627 IF (.NOT. failure) THEN 00628 force%ref_count=force%ref_count+1 00629 END IF 00630 END SUBROUTINE ep_force_retain 00631 00632 ! ***************************************************************************** 00639 SUBROUTINE ep_force_release(force,error) 00640 TYPE(ep_force_type), POINTER :: force 00641 TYPE(cp_error_type), INTENT(inout) :: error 00642 00643 CHARACTER(len=*), PARAMETER :: routineN = 'ep_force_release', 00644 routineP = moduleN//':'//routineN 00645 00646 INTEGER :: stat 00647 LOGICAL :: failure 00648 00649 failure=.FALSE. 00650 IF (ASSOCIATED(force)) THEN 00651 CPPrecondition(force%ref_count>0,cp_failure_level,routineP,error,failure) 00652 force%ref_count=force%ref_count-1 00653 IF (force%ref_count==0) THEN 00654 DEALLOCATE(force%f0_internal,stat=stat) 00655 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00656 DEALLOCATE(force,stat=stat) 00657 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00658 END IF 00659 END IF 00660 NULLIFY(force) 00661 END SUBROUTINE ep_force_release 00662 00663 END MODULE ep_types
1.7.3