|
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 ! ***************************************************************************** 00010 MODULE xc_derivative_types 00011 USE f77_blas 00012 USE kinds, ONLY: dp 00013 USE pw_pool_types, ONLY: pw_pool_give_back_cr3d,& 00014 pw_pool_type 00015 USE xc_derivative_desc, ONLY: MAX_DERIVATIVE_DESC_LENGTH,& 00016 MAX_LABEL_LENGTH,& 00017 create_split_derivative_desc,& 00018 standardize_derivative_desc 00019 #include "cp_common_uses.h" 00020 00021 IMPLICIT NONE 00022 00023 PRIVATE 00024 00025 INTEGER, SAVE :: derivative_id_nr = 1 00026 00027 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xc_derivative_types' 00028 00029 PUBLIC :: xc_derivative_type, xc_derivative_p_type 00030 PUBLIC :: xc_derivative_create, xc_derivative_release, xc_derivative_retain,& 00031 xc_derivative_get 00032 00033 ! ***************************************************************************** 00036 TYPE xc_derivative_type 00037 INTEGER :: ref_count, id_nr 00038 CHARACTER(len=MAX_DERIVATIVE_DESC_LENGTH) :: desc 00039 CHARACTER(len=MAX_LABEL_LENGTH), DIMENSION(:), POINTER :: split_desc 00040 REAL(KIND = dp), DIMENSION(:,:,:), POINTER :: deriv_data 00041 END TYPE xc_derivative_type 00042 00043 ! ***************************************************************************** 00050 TYPE xc_derivative_p_type 00051 TYPE(xc_derivative_type), POINTER :: deriv 00052 END TYPE xc_derivative_p_type 00053 00054 CONTAINS 00055 00056 ! ***************************************************************************** 00065 SUBROUTINE xc_derivative_create(derivative, desc, cr3d_ptr, error) 00066 00067 TYPE(xc_derivative_type), POINTER :: derivative 00068 CHARACTER(len=*), INTENT(in) :: desc 00069 REAL(kind=dp), DIMENSION(:, :, :), 00070 POINTER :: cr3d_ptr 00071 TYPE(cp_error_type), INTENT(inout) :: error 00072 00073 CHARACTER(len=*), PARAMETER :: routineN = 'xc_derivative_create', 00074 routineP = moduleN//':'//routineN 00075 00076 CHARACTER& 00077 (len=MAX_DERIVATIVE_DESC_LENGTH) :: my_desc 00078 INTEGER :: stat 00079 LOGICAL :: failure 00080 00081 failure=.FALSE. 00082 00083 ALLOCATE(derivative, stat=stat) 00084 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00085 00086 IF (.NOT. failure) THEN 00087 derivative%ref_count = 1 00088 derivative%id_nr = derivative_id_nr 00089 derivative_id_nr = derivative_id_nr + 1 00090 CALL standardize_derivative_desc(desc,my_desc,error=error) 00091 CALL create_split_derivative_desc(my_desc,derivative%split_desc,error=error) 00092 derivative%desc = my_desc 00093 derivative%deriv_data => cr3d_ptr 00094 END IF 00095 00096 END SUBROUTINE xc_derivative_create 00097 00098 ! ***************************************************************************** 00107 SUBROUTINE xc_derivative_retain(deriv,error) 00108 TYPE(xc_derivative_type), POINTER :: deriv 00109 TYPE(cp_error_type), INTENT(inout) :: error 00110 00111 CHARACTER(len=*), PARAMETER :: routineN = 'xc_derivative_retain', 00112 routineP = moduleN//':'//routineN 00113 00114 LOGICAL :: failure 00115 00116 failure=.FALSE. 00117 00118 CPPrecondition(ASSOCIATED(deriv),cp_failure_level,routineP,error,failure) 00119 IF (.NOT. failure) THEN 00120 CPPreconditionNoFail(deriv%ref_count>0,cp_failure_level,routineP,error) 00121 deriv%ref_count=deriv%ref_count+1 00122 END IF 00123 END SUBROUTINE xc_derivative_retain 00124 00125 ! ***************************************************************************** 00133 SUBROUTINE xc_derivative_release(derivative, pw_pool, error) 00134 00135 TYPE(xc_derivative_type), POINTER :: derivative 00136 TYPE(pw_pool_type), OPTIONAL, POINTER :: pw_pool 00137 TYPE(cp_error_type), INTENT(inout) :: error 00138 00139 CHARACTER(len=*), PARAMETER :: routineN = 'xc_derivative_release', 00140 routineP = moduleN//':'//routineN 00141 00142 INTEGER :: stat 00143 LOGICAL :: failure 00144 00145 failure=.FALSE. 00146 00147 CPPrecondition(ASSOCIATED(derivative),cp_failure_level,routineP,error,failure) 00148 CPPrecondition(derivative%ref_count>=1,cp_failure_level,routineP,error,failure) 00149 00150 IF (.not.failure) THEN 00151 derivative%ref_count = derivative%ref_count - 1 00152 IF (derivative%ref_count == 0) THEN 00153 IF (PRESENT(pw_pool)) THEN 00154 IF (ASSOCIATED(pw_pool)) THEN 00155 CALL pw_pool_give_back_cr3d(pw_pool, derivative%deriv_data,& 00156 accept_non_compatible=.TRUE.,error=error) 00157 END IF 00158 END IF 00159 IF (ASSOCIATED(derivative%deriv_data)) THEN 00160 DEALLOCATE(derivative%deriv_data, stat=stat) 00161 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00162 END IF 00163 DEALLOCATE(derivative%split_desc, stat=stat) 00164 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00165 00166 DEALLOCATE(derivative, stat=stat) 00167 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00168 END IF 00169 END IF 00170 NULLIFY(derivative) 00171 00172 END SUBROUTINE xc_derivative_release 00173 00174 ! ***************************************************************************** 00189 SUBROUTINE xc_derivative_get(deriv,desc,split_desc,& 00190 order,deriv_data,accept_null_data, error) 00191 TYPE(xc_derivative_type), POINTER :: deriv 00192 CHARACTER& 00193 (len=MAX_DERIVATIVE_DESC_LENGTH), & 00194 INTENT(out), OPTIONAL :: desc 00195 CHARACTER(len=MAX_LABEL_LENGTH), 00196 DIMENSION(:), OPTIONAL, POINTER :: split_desc 00197 INTEGER, INTENT(out), OPTIONAL :: order 00198 REAL(kind=dp), DIMENSION(:, :, :), 00199 OPTIONAL, POINTER :: deriv_data 00200 LOGICAL, INTENT(in), OPTIONAL :: accept_null_data 00201 TYPE(cp_error_type), INTENT(inout) :: error 00202 00203 CHARACTER(len=*), PARAMETER :: routineN = 'xc_derivative_get', 00204 routineP = moduleN//':'//routineN 00205 00206 LOGICAL :: failure, my_accept_null_data 00207 00208 failure=.FALSE. 00209 my_accept_null_data=.FALSE. 00210 IF (PRESENT(accept_null_data)) my_accept_null_data=accept_null_data 00211 00212 CPPrecondition(ASSOCIATED(deriv),cp_failure_level,routineP,error,failure) 00213 CPPrecondition(deriv%ref_count>0,cp_failure_level,routineP,error,failure) 00214 IF (.NOT. failure) THEN 00215 IF (PRESENT(desc)) desc = deriv%desc 00216 IF (PRESENT(split_desc)) split_desc => deriv%split_desc 00217 IF (PRESENT(deriv_data)) THEN 00218 deriv_data => deriv%deriv_data 00219 IF (.NOT.my_accept_null_data) THEN 00220 CPPrecondition(ASSOCIATED(deriv_data),cp_failure_level,routineP,error,failure) 00221 END IF 00222 END IF 00223 IF (PRESENT(order)) order=SIZE(deriv%split_desc) 00224 END IF 00225 END SUBROUTINE xc_derivative_get 00226 00227 END MODULE xc_derivative_types 00228
1.7.3