|
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 ! ***************************************************************************** 00022 MODULE pw_types 00023 USE f77_blas 00024 USE kinds, ONLY: dp 00025 USE pw_grid_types, ONLY: pw_grid_type 00026 USE timings, ONLY: print_stack,& 00027 timeset,& 00028 timestop 00029 #include "cp_common_uses.h" 00030 00031 IMPLICIT NONE 00032 00033 PRIVATE 00034 PUBLIC :: pw_type, pw_p_type 00035 PUBLIC :: pw_retain, pw_release, pw_create 00036 00037 ! ***************************************************************************** 00038 TYPE pw_type 00039 REAL (KIND=dp), DIMENSION ( : ), POINTER :: cr 00040 REAL (KIND=dp), DIMENSION ( :, :, : ), POINTER :: cr3d 00041 COMPLEX (KIND=dp), DIMENSION ( : ), POINTER :: cc 00042 COMPLEX (KIND=dp), DIMENSION ( :, :, : ), POINTER :: cc3d 00043 00044 INTEGER :: in_use ! Which data is used [r1d/c1d/r3d/c3d] 00045 INTEGER :: in_space ! Real/Reciprocal space 00046 INTEGER :: id_nr ! unique identifier 00047 INTEGER :: ref_count ! reference count 00048 00049 TYPE ( pw_grid_type ), POINTER :: pw_grid 00050 END TYPE pw_type 00051 00052 ! ***************************************************************************** 00053 TYPE pw_p_type 00054 TYPE(pw_type), POINTER :: pw 00055 END TYPE pw_p_type 00056 00057 ! Flags for the structure member 'in_use' 00058 INTEGER, PARAMETER, PUBLIC :: REALDATA1D = 301, COMPLEXDATA1D = 302 00059 INTEGER, PARAMETER, PUBLIC :: REALDATA3D = 303, COMPLEXDATA3D = 304, NODATA = 305 00060 00061 ! Flags for the structure member 'in_space' 00062 INTEGER, PARAMETER, PUBLIC :: NOSPACE = 371, REALSPACE = 372, RECIPROCALSPACE = 373 00063 INTEGER, PUBLIC, PARAMETER :: SQUARE = 391, SQUAREROOT = 392 00064 00065 ! to generate unique id_nr 00066 INTEGER, SAVE, PRIVATE :: last_pw_id_nr=0 00067 INTEGER, SAVE, PRIVATE :: allocated_pw_count=0 00068 00069 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'pw_types' 00070 LOGICAL, PARAMETER, PRIVATE :: debug_this_module=.FALSE. 00071 00072 CONTAINS 00073 00074 ! ***************************************************************************** 00085 SUBROUTINE pw_retain(pw, error) 00086 TYPE(pw_type), POINTER :: pw 00087 TYPE(cp_error_type), INTENT(inout) :: error 00088 00089 CHARACTER(len=*), PARAMETER :: routineN = 'pw_retain', 00090 routineP = moduleN//':'//routineN 00091 00092 LOGICAL :: failure 00093 00094 failure=.FALSE. 00095 00096 CPPrecondition(ASSOCIATED(pw),cp_failure_level,routineP,error,failure) 00097 IF (.NOT. failure) THEN 00098 CPPreconditionNoFail(pw%ref_count>0,cp_failure_level,routineP,error) 00099 pw%ref_count=pw%ref_count+1 00100 END IF 00101 END SUBROUTINE pw_retain 00102 00103 ! ***************************************************************************** 00114 SUBROUTINE pw_release(pw, error) 00115 TYPE(pw_type), POINTER :: pw 00116 TYPE(cp_error_type), INTENT(inout) :: error 00117 00118 CHARACTER(len=*), PARAMETER :: routineN = 'pw_release', 00119 routineP = moduleN//':'//routineN 00120 00121 INTEGER :: stat 00122 LOGICAL :: failure 00123 00124 failure=.FALSE. 00125 00126 IF (ASSOCIATED(pw)) THEN 00127 CPPreconditionNoFail(pw%ref_count>0,cp_failure_level,routineP,error) 00128 pw%ref_count=pw%ref_count-1 00129 IF (pw%ref_count==0) THEN 00130 pw%ref_count=1 00131 00132 allocated_pw_count = allocated_pw_count - 1 00133 SELECT CASE(pw % in_use) 00134 CASE (REALDATA1D) 00135 DEALLOCATE ( pw % cr, STAT = stat ) 00136 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00137 CASE(COMPLEXDATA1D) 00138 DEALLOCATE ( pw % cc, STAT = stat ) 00139 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00140 CASE(REALDATA3D) 00141 IF (ASSOCIATED(pw%cr3d)) THEN 00142 !FM optimizations of pools might have removed the 3d field to cache it 00143 DEALLOCATE ( pw % cr3d, STAT = stat ) 00144 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00145 END IF 00146 CASE(COMPLEXDATA3D) 00147 DEALLOCATE ( pw % cc3d, STAT = stat ) 00148 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00149 CASE(NODATA) 00150 CASE default 00151 CALL cp_assert(.FALSE.,cp_failure_level,cp_assertion_failed,routineP,& 00152 "unknown data type "//cp_to_string(pw%in_use),error,failure) 00153 END SELECT 00154 pw%ref_count=0 00155 DEALLOCATE(pw, stat=stat) 00156 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00157 END IF 00158 END IF 00159 NULLIFY(pw) 00160 END SUBROUTINE pw_release 00161 00162 ! ***************************************************************************** 00175 SUBROUTINE pw_create(pw, pw_grid, use_data, in_space, cr3d_ptr, error) 00176 TYPE(pw_type), POINTER :: pw 00177 TYPE(pw_grid_type), POINTER :: pw_grid 00178 INTEGER, INTENT(in) :: use_data 00179 INTEGER, INTENT(in), OPTIONAL :: in_space 00180 REAL(KIND=dp), DIMENSION(:, :, :), 00181 OPTIONAL, POINTER :: cr3d_ptr 00182 TYPE(cp_error_type), INTENT(inout) :: error 00183 00184 CHARACTER(len=*), PARAMETER :: routineN = 'pw_create', 00185 routineP = moduleN//':'//routineN 00186 00187 INTEGER :: handle, stat 00188 INTEGER, DIMENSION(:, :), POINTER :: bounds 00189 LOGICAL :: failure 00190 TYPE(cp_logger_type), POINTER :: logger 00191 00192 failure=.FALSE. 00193 00194 CALL timeset(routineN,handle) 00195 CPPrecondition(.NOT.ASSOCIATED(pw),cp_failure_level,routineP,error,failure) 00196 ALLOCATE(pw,stat=stat) 00197 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00198 IF (.NOT. failure) THEN 00199 logger => cp_error_get_logger(error) 00200 IF (debug_this_module) THEN 00201 WRITE (cp_logger_get_default_unit_nr(logger),"('*** allocated pw ***')") 00202 IF (PRESENT(cr3d_ptr)) THEN 00203 IF (ASSOCIATED(cr3d_ptr)) THEN 00204 WRITE (cp_logger_get_default_unit_nr(logger),"('*** cr3d associated ***')") 00205 END IF 00206 END IF 00207 CALL print_stack(cp_logger_get_default_unit_nr(logger)) 00208 END IF 00209 00210 IF (PRESENT(cr3d_ptr)) THEN 00211 IF (ASSOCIATED(cr3d_ptr)) THEN 00212 CPAssertNoFail(use_data==REALDATA3D,cp_failure_level,routineP,error) 00213 END IF 00214 END IF 00215 00216 last_pw_id_nr=last_pw_id_nr+1 00217 pw % id_nr = last_pw_id_nr 00218 pw % ref_count = 1 00219 NULLIFY ( pw % pw_grid ) 00220 pw % in_use = use_data 00221 pw % pw_grid => pw_grid 00222 pw % in_space = NOSPACE 00223 bounds => pw % pw_grid % bounds_local 00224 00225 allocated_pw_count = allocated_pw_count + 1 00226 00227 NULLIFY ( pw % cr, pw % cc, pw % cr3d, pw % cc3d ) 00228 00229 SELECT CASE(use_data) 00230 CASE(REALDATA1D) 00231 ALLOCATE ( pw % cr ( pw % pw_grid % ngpts_cut_local ), STAT = stat ) 00232 CPPostcondition(stat==0,cp_fatal_level,routineP,error,failure) 00233 00234 CASE(COMPLEXDATA1D) 00235 ALLOCATE ( pw % cc ( pw % pw_grid % ngpts_cut_local ), STAT = stat ) 00236 CPPostcondition(stat==0,cp_fatal_level,routineP,error,failure) 00237 00238 CASE (REALDATA3D) 00239 IF (PRESENT(cr3d_ptr)) THEN 00240 IF (ASSOCIATED(cr3d_ptr)) THEN 00241 IF (ALL(bounds(1,:) <= bounds(2,:))) THEN 00242 CPPreconditionNoFail(ALL(LBOUND(cr3d_ptr)==bounds(1,:)),cp_failure_level,routineP,error) 00243 CPPreconditionNoFail(ALL(UBOUND(cr3d_ptr)==bounds(2,:)),cp_failure_level,routineP,error) 00244 END IF 00245 pw%cr3d => cr3d_ptr 00246 END IF 00247 END IF 00248 IF (.NOT.ASSOCIATED(pw%cr3d)) THEN 00249 ALLOCATE ( pw % cr3d ( & 00250 bounds ( 1, 1 ) : bounds ( 2, 1 ), & 00251 bounds ( 1, 2 ) : bounds ( 2, 2 ), & 00252 bounds ( 1, 3 ) : bounds ( 2, 3 ) ), STAT = stat ) 00253 CPPostcondition(stat==0,cp_fatal_level,routineP,error,failure) 00254 END IF 00255 00256 CASE(COMPLEXDATA3D) 00257 ALLOCATE ( pw % cc3d ( & 00258 bounds ( 1, 1 ) : bounds ( 2, 1 ), & 00259 bounds ( 1, 2 ) : bounds ( 2, 2 ), & 00260 bounds ( 1, 3 ) : bounds ( 2, 3 ) ), STAT = stat ) 00261 CPPostcondition(stat==0,cp_fatal_level,routineP,error,failure) 00262 CASE(NODATA) 00263 CASE default 00264 CALL cp_assert(.FALSE.,cp_failure_level,cp_assertion_failed,routineP,& 00265 "unknown data type",error,failure) 00266 END SELECT 00267 IF (PRESENT(in_space)) pw%in_space=in_space 00268 END IF 00269 CALL timestop(handle) 00270 END SUBROUTINE pw_create 00271 00272 END MODULE pw_types
1.7.3