|
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 ! ***************************************************************************** 00014 MODULE qs_wf_history_types 00015 USE cp_dbcsr_operations, ONLY: cp_dbcsr_deallocate_matrix,& 00016 cp_dbcsr_deallocate_matrix_set 00017 USE cp_dbcsr_types, ONLY: cp_dbcsr_p_type,& 00018 cp_dbcsr_type 00019 USE cp_fm_types, ONLY: cp_fm_p_type,& 00020 cp_fm_release 00021 USE f77_blas 00022 USE kinds, ONLY: dp 00023 USE pw_types, ONLY: pw_p_type 00024 USE qs_rho_types, ONLY: qs_rho_release,& 00025 qs_rho_type 00026 #include "cp_common_uses.h" 00027 00028 IMPLICIT NONE 00029 PRIVATE 00030 00031 LOGICAL, PRIVATE, PARAMETER :: debug_this_module=.TRUE. 00032 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_wf_history_types' 00033 00034 PUBLIC :: qs_wf_snapshot_type, qs_wf_snapshot_p_type, & 00035 qs_wf_history_type, qs_wf_history_p_type 00036 PUBLIC :: wfs_retain, wfs_release, wfi_retain, wfi_release, wfi_get_snapshot, & 00037 wfi_clear_history 00038 00039 ! ***************************************************************************** 00059 TYPE qs_wf_snapshot_type 00060 TYPE(cp_fm_p_type), DIMENSION(:), POINTER :: wf 00061 TYPE(pw_p_type), DIMENSION(:), POINTER :: rho_r 00062 TYPE(pw_p_type), DIMENSION(:), POINTER :: rho_g 00063 TYPE(cp_dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao 00064 TYPE(cp_dbcsr_type), POINTER :: overlap 00065 TYPE(qs_rho_type), POINTER :: rho_frozen 00066 REAL(KIND = dp) :: dt 00067 INTEGER :: id_nr, ref_count 00068 END TYPE qs_wf_snapshot_type 00069 00070 ! ***************************************************************************** 00077 TYPE qs_wf_snapshot_p_type 00078 TYPE(qs_wf_snapshot_type), POINTER :: snapshot 00079 END TYPE qs_wf_snapshot_p_type 00080 00081 ! ***************************************************************************** 00100 TYPE qs_wf_history_type 00101 INTEGER :: id_nr, ref_count, memory_depth, last_state_index, 00102 interpolation_method_nr, snapshot_count 00103 LOGICAL :: store_wf, store_rho_r, store_rho_g, store_rho_ao, 00104 store_overlap, store_frozen_density 00105 TYPE(qs_wf_snapshot_p_type), DIMENSION(:), POINTER :: past_states 00106 END TYPE qs_wf_history_type 00107 00108 ! ***************************************************************************** 00113 TYPE qs_wf_history_p_type 00114 TYPE(qs_wf_history_type), POINTER :: wf_history 00115 END TYPE qs_wf_history_p_type 00116 00117 CONTAINS 00118 00119 ! ***************************************************************************** 00128 SUBROUTINE wfs_retain(snapshot,error) 00129 TYPE(qs_wf_snapshot_type), POINTER :: snapshot 00130 TYPE(cp_error_type), INTENT(inout) :: error 00131 00132 CHARACTER(len=*), PARAMETER :: routineN = 'wfs_retain', 00133 routineP = moduleN//':'//routineN 00134 00135 LOGICAL :: failure 00136 00137 failure=.FALSE. 00138 00139 CPPrecondition(ASSOCIATED(snapshot),cp_failure_level,routineP,error,failure) 00140 IF (.NOT. failure) THEN 00141 snapshot%ref_count=snapshot%ref_count+1 00142 END IF 00143 END SUBROUTINE wfs_retain 00144 00145 ! ***************************************************************************** 00155 SUBROUTINE wfs_release(snapshot,error) 00156 TYPE(qs_wf_snapshot_type), POINTER :: snapshot 00157 TYPE(cp_error_type), INTENT(inout) :: error 00158 00159 CHARACTER(len=*), PARAMETER :: routineN = 'wfs_release', 00160 routineP = moduleN//':'//routineN 00161 00162 INTEGER :: i, stat 00163 LOGICAL :: failure 00164 00165 failure=.FALSE. 00166 00167 IF (ASSOCIATED(snapshot)) THEN 00168 CPPreconditionNoFail(snapshot%ref_count>0,cp_failure_level,routineP,error) 00169 snapshot%ref_count=snapshot%ref_count-1 00170 IF (snapshot%ref_count==0) THEN 00171 IF (ASSOCIATED(snapshot%wf)) THEN 00172 DO i=1,SIZE(snapshot%wf) 00173 CALL cp_fm_release(snapshot%wf(i)%matrix,error=error) 00174 END DO 00175 DEALLOCATE(snapshot%wf,stat=stat) 00176 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00177 END IF 00178 ! snapshot%rho_r & snapshot%rho_g is deallocated in wfs_update 00179 ! of qs_wf_history_methods, in case you wonder about it. 00180 IF (ASSOCIATED(snapshot%rho_ao)) THEN 00181 CALL cp_dbcsr_deallocate_matrix_set(snapshot%rho_ao,error=error) 00182 END IF 00183 IF (ASSOCIATED(snapshot%overlap)) THEN 00184 CALL cp_dbcsr_deallocate_matrix(snapshot%overlap,error=error) 00185 END IF 00186 IF (ASSOCIATED(snapshot%rho_frozen)) THEN 00187 CALL qs_rho_release(snapshot%rho_frozen,error=error) 00188 END IF 00189 DEALLOCATE(snapshot,stat=stat) 00190 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00191 END IF 00192 END IF 00193 NULLIFY(snapshot) 00194 END SUBROUTINE wfs_release 00195 00196 ! ***************************************************************************** 00205 SUBROUTINE wfi_retain(wf_history,error) 00206 TYPE(qs_wf_history_type), POINTER :: wf_history 00207 TYPE(cp_error_type), INTENT(inout) :: error 00208 00209 CHARACTER(len=*), PARAMETER :: routineN = 'wfi_retain', 00210 routineP = moduleN//':'//routineN 00211 00212 LOGICAL :: failure 00213 00214 failure=.FALSE. 00215 00216 CPPrecondition(ASSOCIATED(wf_history),cp_failure_level,routineP,error,failure) 00217 IF (.NOT. failure) THEN 00218 wf_history%ref_count=wf_history%ref_count+1 00219 END IF 00220 END SUBROUTINE wfi_retain 00221 00222 ! ***************************************************************************** 00232 SUBROUTINE wfi_release(wf_history,error) 00233 TYPE(qs_wf_history_type), POINTER :: wf_history 00234 TYPE(cp_error_type), INTENT(inout) :: error 00235 00236 CHARACTER(len=*), PARAMETER :: routineN = 'wfi_release', 00237 routineP = moduleN//':'//routineN 00238 00239 INTEGER :: i, stat 00240 LOGICAL :: failure 00241 00242 failure=.FALSE. 00243 00244 IF (ASSOCIATED(wf_history)) THEN 00245 CPPreconditionNoFail(wf_history%ref_count>0,cp_failure_level,routineP,error) 00246 wf_history%ref_count=wf_history%ref_count-1 00247 IF (wf_history%ref_count==0) THEN 00248 IF (ASSOCIATED(wf_history%past_states)) THEN 00249 DO i=1,SIZE(wf_history%past_states) 00250 CALL wfs_release(wf_history%past_states(i)%snapshot,& 00251 error=error) 00252 END DO 00253 DEALLOCATE(wf_history%past_states,stat=stat) 00254 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00255 END IF 00256 DEALLOCATE(wf_history,stat=stat) 00257 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00258 END IF 00259 END IF 00260 NULLIFY(wf_history) 00261 END SUBROUTINE wfi_release 00262 00263 ! ***************************************************************************** 00273 FUNCTION wfi_get_snapshot(wf_history, index, error) RESULT(res) 00274 TYPE(qs_wf_history_type), POINTER :: wf_history 00275 INTEGER, INTENT(in) :: index 00276 TYPE(cp_error_type), INTENT(inout) :: error 00277 TYPE(qs_wf_snapshot_type), POINTER :: res 00278 00279 CHARACTER(len=*), PARAMETER :: routineN = 'wfi_get_snapshot', 00280 routineP = moduleN//':'//routineN 00281 00282 LOGICAL :: failure 00283 00284 failure=.FALSE. 00285 NULLIFY(res) 00286 00287 CPPrecondition(ASSOCIATED(wf_history),cp_failure_level,routineP,error,failure) 00288 IF (.NOT. failure) THEN 00289 CPPrecondition(ASSOCIATED(wf_history%past_states),cp_failure_level,routineP,error,failure) 00290 IF (index>wf_history%memory_depth.OR.index>wf_history%snapshot_count) THEN 00291 CPPrecondition(.FALSE.,cp_warning_level,routineP,error,failure) 00292 END IF 00293 END IF 00294 IF (.not.failure) THEN 00295 res => wf_history%past_states(& 00296 MODULO(wf_history%snapshot_count+1-index,& 00297 wf_history%memory_depth)+1)%snapshot 00298 END IF 00299 END FUNCTION wfi_get_snapshot 00300 00301 ! ***************************************************************************** 00312 SUBROUTINE wfi_clear_history(wf_history,flush_buffer,error) 00313 TYPE(qs_wf_history_type), POINTER :: wf_history 00314 LOGICAL, INTENT(in), OPTIONAL :: flush_buffer 00315 TYPE(cp_error_type), INTENT(inout) :: error 00316 00317 CHARACTER(len=*), PARAMETER :: routineN = 'wfi_clear_history', 00318 routineP = moduleN//':'//routineN 00319 00320 INTEGER :: i 00321 LOGICAL :: failure, my_flush_buffer 00322 00323 failure=.FALSE. 00324 my_flush_buffer=.FALSE. 00325 IF (PRESENT(flush_buffer)) my_flush_buffer=flush_buffer 00326 00327 CPPrecondition(ASSOCIATED(wf_history),cp_failure_level,routineP,error,failure) 00328 CPPrecondition(wf_history%ref_count>0,cp_failure_level,routineP,error,failure) 00329 IF (.NOT. failure) THEN 00330 wf_history%snapshot_count=0 00331 IF (my_flush_buffer) THEN 00332 DO i=1,SIZE(wf_history%past_states) 00333 CALL wfs_release(wf_history%past_states(i)%snapshot,error=error) 00334 END DO 00335 END IF 00336 END IF 00337 END SUBROUTINE wfi_clear_history 00338 00339 END MODULE qs_wf_history_types
1.7.3