|
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 ! ***************************************************************************** 00015 MODULE array_types 00016 00017 IMPLICIT NONE 00018 PRIVATE 00019 00020 INTEGER, PARAMETER :: dp = KIND(0.0d0) 00021 00022 PUBLIC :: array_i1d_obj,& 00023 array_i2d_obj,& 00024 array_d1d_obj,& 00025 array_d2d_obj 00026 PUBLIC :: array_i1d_type,& 00027 array_i2d_type,& 00028 array_d1d_type,& 00029 array_d2d_type 00030 PUBLIC :: array_new,& 00031 array_hold,& 00032 array_release,& 00033 array_nullify,& 00034 array_exists 00035 PUBLIC :: array_data,& 00036 array_size,& 00037 array_equality 00038 PUBLIC :: array_get 00039 00040 00041 INTERFACE array_new 00042 MODULE PROCEDURE array_new_i1d, array_new_i1d_lb, array_new_i2d, array_new_i2d_lb,& 00043 array_new_d1d, array_new_d1d_lb, array_new_d2d, array_new_d2d_lb 00044 END INTERFACE 00045 INTERFACE array_hold 00046 MODULE PROCEDURE array_hold_i1d, array_hold_i2d,& 00047 array_hold_d1d, array_hold_d2d 00048 END INTERFACE 00049 INTERFACE array_release 00050 MODULE PROCEDURE array_release_i1d, array_release_i2d,& 00051 array_release_d1d, array_release_d2d 00052 END INTERFACE 00053 INTERFACE array_nullify 00054 MODULE PROCEDURE array_nullify_i1d, array_nullify_i2d,& 00055 array_nullify_d1d, array_nullify_d2d 00056 END INTERFACE 00057 00058 INTERFACE array_exists 00059 MODULE PROCEDURE array_exists_i1d, array_exists_i2d,& 00060 array_exists_d1d, array_exists_d2d 00061 END INTERFACE 00062 00063 INTERFACE array_data 00064 MODULE PROCEDURE array_data_i1d, array_data_i2d,& 00065 array_data_d1d, array_data_d2d 00066 END INTERFACE 00067 00068 INTERFACE array_size 00069 MODULE PROCEDURE array_size_i1d, array_size_i2d,& 00070 array_size_d1d, array_size_d2d 00071 END INTERFACE 00072 00073 INTERFACE array_equality 00074 MODULE PROCEDURE array_equality_i1d, array_equality_i2d,& 00075 array_equality_d1d, array_equality_d2d 00076 END INTERFACE 00077 00078 INTERFACE array_get 00079 MODULE PROCEDURE array_get_i1d,& 00080 array_get_d1d 00081 END INTERFACE 00082 00083 00084 TYPE array_i1d_type 00085 INTEGER, DIMENSION(:), POINTER :: DATA 00086 INTEGER :: refcount 00087 END TYPE array_i1d_type 00088 TYPE array_i1d_obj 00089 TYPE(array_i1d_type), POINTER :: low 00090 END TYPE array_i1d_obj 00091 00092 TYPE array_i2d_type 00093 INTEGER, DIMENSION(:,:), POINTER :: DATA 00094 INTEGER :: refcount 00095 END TYPE array_i2d_type 00096 TYPE array_i2d_obj 00097 TYPE(array_i2d_type), POINTER :: low 00098 END TYPE array_i2d_obj 00099 00100 TYPE array_d1d_type 00101 REAL(KIND=dp), DIMENSION(:), POINTER :: DATA 00102 INTEGER :: refcount 00103 END TYPE array_d1d_type 00104 TYPE array_d1d_obj 00105 TYPE(array_d1d_type), POINTER :: low 00106 END TYPE array_d1d_obj 00107 00108 TYPE array_d2d_type 00109 REAL(KIND=dp), DIMENSION(:,:), POINTER :: DATA 00110 INTEGER :: refcount 00111 END TYPE array_d2d_type 00112 TYPE array_d2d_obj 00113 TYPE(array_d2d_type), POINTER :: low 00114 END TYPE array_d2d_obj 00115 00116 ! 00117 00118 CONTAINS 00119 00120 ! 00121 00122 SUBROUTINE array_new_i1d(array, DATA, gift) 00123 TYPE(array_i1d_obj), INTENT(OUT) :: array 00124 INTEGER, DIMENSION(:), POINTER :: DATA 00125 LOGICAL, INTENT(IN), OPTIONAL :: gift 00126 00127 INTEGER :: lb, ub 00128 LOGICAL :: g 00129 00130 ALLOCATE (array%low) 00131 array%low%refcount = 1 00132 g = .FALSE. 00133 IF (PRESENT (gift)) g = gift 00134 IF (g) THEN 00135 array%low%data => DATA 00136 ELSE 00137 lb = LBOUND(DATA, 1) 00138 ub = UBOUND(DATA, 1) 00139 ALLOCATE (array%low%data(lb:ub)) 00140 array%low%data(:) = DATA(:) 00141 ENDIF 00142 END SUBROUTINE array_new_i1d 00143 SUBROUTINE array_new_i1d_lb(array, DATA, lb) 00144 TYPE(array_i1d_obj), INTENT(OUT) :: array 00145 INTEGER, DIMENSION(:), INTENT(IN) :: DATA 00146 INTEGER, INTENT(IN) :: lb 00147 00148 INTEGER :: ub 00149 00150 ALLOCATE (array%low) 00151 array%low%refcount = 1 00152 ub = lb + SIZE(DATA) - 1 00153 ALLOCATE (array%low%data(lb:ub)) 00154 array%low%data(:) = DATA(:) 00155 END SUBROUTINE array_new_i1d_lb 00156 SUBROUTINE array_new_i2d(array, DATA, gift) 00157 TYPE(array_i2d_obj), INTENT(OUT) :: array 00158 INTEGER, DIMENSION(:, :), POINTER :: DATA 00159 LOGICAL, INTENT(IN), OPTIONAL :: gift 00160 00161 INTEGER, DIMENSION(2) :: lb, ub 00162 LOGICAL :: g 00163 00164 ALLOCATE (array%low) 00165 array%low%refcount = 1 00166 g = .FALSE. 00167 IF (PRESENT (gift)) g = gift 00168 IF (g) THEN 00169 array%low%data => DATA 00170 ELSE 00171 lb = LBOUND(DATA) 00172 ub = UBOUND(DATA) 00173 ALLOCATE (array%low%data(lb(1):ub(1), lb(2):ub(2))) 00174 array%low%data(:,:) = DATA(:,:) 00175 ENDIF 00176 END SUBROUTINE array_new_i2d 00177 SUBROUTINE array_new_i2d_lb(array, DATA, lb) 00178 TYPE(array_i2d_obj), INTENT(OUT) :: array 00179 INTEGER, DIMENSION(:, :), INTENT(IN) :: DATA 00180 INTEGER, DIMENSION(2), INTENT(IN) :: lb 00181 00182 INTEGER, DIMENSION(2) :: ub 00183 00184 ALLOCATE (array%low) 00185 array%low%refcount = 1 00186 ub(1) = lb(1) + SIZE(DATA,1) - 1 00187 ub(2) = lb(2) + SIZE(DATA,2) - 1 00188 ALLOCATE (array%low%data(lb(1):ub(1), lb(2):ub(2))) 00189 array%low%data(:,:) = DATA(:,:) 00190 END SUBROUTINE array_new_i2d_lb 00191 SUBROUTINE array_new_d1d(array, DATA, gift) 00192 TYPE(array_d1d_obj), INTENT(OUT) :: array 00193 REAL(KIND=dp), DIMENSION(:), POINTER :: DATA 00194 LOGICAL, INTENT(IN), OPTIONAL :: gift 00195 00196 INTEGER :: lb, ub 00197 LOGICAL :: g 00198 00199 ALLOCATE (array%low) 00200 array%low%refcount = 1 00201 g = .FALSE. 00202 IF (PRESENT (gift)) g = gift 00203 IF (g) THEN 00204 array%low%data => DATA 00205 ELSE 00206 lb = LBOUND(DATA, 1) 00207 ub = UBOUND(DATA, 1) 00208 ALLOCATE (array%low%data(lb:ub)) 00209 array%low%data(:) = DATA(:) 00210 ENDIF 00211 END SUBROUTINE array_new_d1d 00212 SUBROUTINE array_new_d1d_lb(array, DATA, lb) 00213 TYPE(array_d1d_obj), INTENT(OUT) :: array 00214 REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: DATA 00215 INTEGER, INTENT(IN) :: lb 00216 00217 INTEGER :: ub 00218 00219 ALLOCATE (array%low) 00220 array%low%refcount = 1 00221 ub = lb + SIZE(DATA) - 1 00222 ALLOCATE (array%low%data(lb:ub)) 00223 array%low%data(:) = DATA(:) 00224 END SUBROUTINE array_new_d1d_lb 00225 SUBROUTINE array_new_d2d(array, DATA, gift) 00226 TYPE(array_d2d_obj), INTENT(OUT) :: array 00227 REAL(KIND=dp), DIMENSION(:, :), POINTER :: DATA 00228 LOGICAL, INTENT(IN), OPTIONAL :: gift 00229 00230 INTEGER, DIMENSION(2) :: lb, ub 00231 LOGICAL :: g 00232 00233 ALLOCATE (array%low) 00234 array%low%refcount = 1 00235 g = .FALSE. 00236 IF (PRESENT (gift)) g = gift 00237 IF (g) THEN 00238 array%low%data => DATA 00239 ELSE 00240 lb = LBOUND(DATA) 00241 ub = UBOUND(DATA) 00242 ALLOCATE (array%low%data(lb(1):ub(1), lb(2):ub(2))) 00243 array%low%data(:,:) = DATA(:,:) 00244 ENDIF 00245 END SUBROUTINE array_new_d2d 00246 SUBROUTINE array_new_d2d_lb(array, DATA, lb) 00247 TYPE(array_d2d_obj), INTENT(OUT) :: array 00248 REAL(KIND=dp), DIMENSION(:, :), 00249 INTENT(IN) :: DATA 00250 INTEGER, DIMENSION(2), INTENT(IN) :: lb 00251 00252 INTEGER, DIMENSION(2) :: ub 00253 00254 ALLOCATE (array%low) 00255 array%low%refcount = 1 00256 ub(1) = lb(1) + SIZE(DATA,1) - 1 00257 ub(2) = lb(2) + SIZE(DATA,2) - 1 00258 ALLOCATE (array%low%data(lb(1):ub(1), lb(2):ub(2))) 00259 array%low%data(:,:) = DATA(:,:) 00260 END SUBROUTINE array_new_d2d_lb 00261 00262 ! 00263 00264 PURE SUBROUTINE array_hold_i1d (array) 00265 TYPE(array_i1d_obj), INTENT(INOUT) :: array 00266 00267 array%low%refcount = array%low%refcount + 1 00268 END SUBROUTINE array_hold_i1d 00269 PURE SUBROUTINE array_hold_i2d (array) 00270 TYPE(array_i2d_obj), INTENT(INOUT) :: array 00271 00272 array%low%refcount = array%low%refcount + 1 00273 END SUBROUTINE array_hold_i2d 00274 PURE SUBROUTINE array_hold_d1d (array) 00275 TYPE(array_d1d_obj), INTENT(INOUT) :: array 00276 00277 array%low%refcount = array%low%refcount + 1 00278 END SUBROUTINE array_hold_d1d 00279 PURE SUBROUTINE array_hold_d2d (array) 00280 TYPE(array_d2d_obj), INTENT(INOUT) :: array 00281 00282 array%low%refcount = array%low%refcount + 1 00283 END SUBROUTINE array_hold_d2d 00284 00285 ! 00286 00287 SUBROUTINE array_release_i1d (array) 00288 TYPE(array_i1d_obj), INTENT(INOUT) :: array 00289 00290 IF (ASSOCIATED (array%low)) THEN 00291 array%low%refcount = array%low%refcount - 1 00292 IF (array%low%refcount .EQ. 0) THEN 00293 DEALLOCATE(array%low%data) 00294 DEALLOCATE(array%low) 00295 NULLIFY (array%low) 00296 ENDIF 00297 ENDIF 00298 END SUBROUTINE array_release_i1d 00299 SUBROUTINE array_release_i2d (array) 00300 TYPE(array_i2d_obj), INTENT(INOUT) :: array 00301 00302 IF (ASSOCIATED (array%low)) THEN 00303 array%low%refcount = array%low%refcount - 1 00304 IF (array%low%refcount .EQ. 0 .AND. ASSOCIATED (array%low)) THEN 00305 DEALLOCATE(array%low%data) 00306 DEALLOCATE(array%low) 00307 NULLIFY (array%low) 00308 ENDIF 00309 ENDIF 00310 END SUBROUTINE array_release_i2d 00311 SUBROUTINE array_release_d1d (array) 00312 TYPE(array_d1d_obj), INTENT(INOUT) :: array 00313 00314 IF (ASSOCIATED (array%low)) THEN 00315 array%low%refcount = array%low%refcount - 1 00316 IF (array%low%refcount .EQ. 0 .AND. ASSOCIATED (array%low)) THEN 00317 DEALLOCATE(array%low%data) 00318 DEALLOCATE(array%low) 00319 NULLIFY (array%low) 00320 ENDIF 00321 ENDIF 00322 END SUBROUTINE array_release_d1d 00323 SUBROUTINE array_release_d2d (array) 00324 TYPE(array_d2d_obj), INTENT(INOUT) :: array 00325 00326 IF (ASSOCIATED (array%low)) THEN 00327 array%low%refcount = array%low%refcount - 1 00328 IF (array%low%refcount .EQ. 0 .AND. ASSOCIATED (array%low)) THEN 00329 DEALLOCATE(array%low%data) 00330 DEALLOCATE(array%low) 00331 NULLIFY (array%low) 00332 ENDIF 00333 ENDIF 00334 END SUBROUTINE array_release_d2d 00335 00336 ! 00337 00338 PURE SUBROUTINE array_nullify_i1d (array) 00339 TYPE(array_i1d_obj), INTENT(INOUT) :: array 00340 00341 NULLIFY (array%low) 00342 END SUBROUTINE array_nullify_i1d 00343 PURE SUBROUTINE array_nullify_i2d (array) 00344 TYPE(array_i2d_obj), INTENT(INOUT) :: array 00345 00346 NULLIFY (array%low) 00347 END SUBROUTINE array_nullify_i2d 00348 PURE SUBROUTINE array_nullify_d1d (array) 00349 TYPE(array_d1d_obj), INTENT(INOUT) :: array 00350 00351 NULLIFY (array%low) 00352 END SUBROUTINE array_nullify_d1d 00353 PURE SUBROUTINE array_nullify_d2d (array) 00354 TYPE(array_d2d_obj), INTENT(INOUT) :: array 00355 00356 NULLIFY (array%low) 00357 END SUBROUTINE array_nullify_d2d 00358 00359 ! 00360 00361 PURE FUNCTION array_exists_i1d (array) RESULT (array_exists) 00362 TYPE(array_i1d_obj), INTENT(IN) :: array 00363 LOGICAL :: array_exists 00364 00365 array_exists = ASSOCIATED (array%low) 00366 IF (array_exists) array_exists = array%low%refcount .GT. 0 00367 END FUNCTION array_exists_i1d 00368 PURE FUNCTION array_exists_i2d (array) RESULT (array_exists) 00369 TYPE(array_i2d_obj), INTENT(IN) :: array 00370 LOGICAL :: array_exists 00371 00372 array_exists = ASSOCIATED (array%low) 00373 IF (array_exists) array_exists = array%low%refcount .GT. 0 00374 END FUNCTION array_exists_i2d 00375 PURE FUNCTION array_exists_d1d (array) RESULT (array_exists) 00376 TYPE(array_d1d_obj), INTENT(IN) :: array 00377 LOGICAL :: array_exists 00378 00379 array_exists = ASSOCIATED (array%low) 00380 IF (array_exists) array_exists = array%low%refcount .GT. 0 00381 00382 END FUNCTION array_exists_d1d 00383 PURE FUNCTION array_exists_d2d (array) RESULT (array_exists) 00384 TYPE(array_d2d_obj), INTENT(IN) :: array 00385 LOGICAL :: array_exists 00386 00387 array_exists = ASSOCIATED (array%low) 00388 IF (array_exists) array_exists = array%low%refcount .GT. 0 00389 00390 END FUNCTION array_exists_d2d 00391 00392 00393 ! 00394 00395 FUNCTION array_data_i1d(array) RESULT (DATA) 00396 TYPE(array_i1d_obj), INTENT(IN) :: array 00397 INTEGER, DIMENSION(:), POINTER :: DATA 00398 00399 IF (ASSOCIATED (array%low)) THEN 00400 DATA => array%low%data 00401 ELSE 00402 NULLIFY (DATA) 00403 ENDIF 00404 END FUNCTION array_data_i1d 00405 FUNCTION array_data_i2d(array) RESULT (DATA) 00406 TYPE(array_i2d_obj), INTENT(IN) :: array 00407 INTEGER, DIMENSION(:, :), POINTER :: DATA 00408 00409 IF (ASSOCIATED (array%low)) THEN 00410 DATA => array%low%data 00411 ELSE 00412 NULLIFY (DATA) 00413 ENDIF 00414 END FUNCTION array_data_i2d 00415 FUNCTION array_data_d1d(array) RESULT (DATA) 00416 TYPE(array_d1d_obj), INTENT(IN) :: array 00417 REAL(KIND=dp), DIMENSION(:), POINTER :: DATA 00418 00419 IF (ASSOCIATED (array%low)) THEN 00420 DATA => array%low%data 00421 ELSE 00422 NULLIFY (DATA) 00423 ENDIF 00424 END FUNCTION array_data_d1d 00425 FUNCTION array_data_d2d(array) RESULT (DATA) 00426 TYPE(array_d2d_obj), INTENT(IN) :: array 00427 REAL(KIND=dp), DIMENSION(:, :), POINTER :: DATA 00428 00429 IF (ASSOCIATED (array%low)) THEN 00430 DATA => array%low%data 00431 ELSE 00432 NULLIFY (DATA) 00433 ENDIF 00434 END FUNCTION array_data_d2d 00435 00436 ! 00437 00438 PURE FUNCTION array_size_i1d(array) RESULT (the_size) 00439 TYPE(array_i1d_obj), INTENT(IN) :: array 00440 INTEGER :: the_size 00441 00442 IF (ASSOCIATED (array%low)) THEN 00443 the_size = SIZE(array%low%data) 00444 ELSE 00445 the_size = 0 00446 ENDIF 00447 END FUNCTION array_size_i1d 00448 PURE FUNCTION array_size_i2d(array) RESULT (the_size) 00449 TYPE(array_i2d_obj), INTENT(IN) :: array 00450 INTEGER :: the_size 00451 00452 IF (ASSOCIATED (array%low)) THEN 00453 the_size = SIZE(array%low%data) 00454 ELSE 00455 the_size = 0 00456 ENDIF 00457 END FUNCTION array_size_i2d 00458 PURE FUNCTION array_size_d1d(array) RESULT (the_size) 00459 TYPE(array_d1d_obj), INTENT(IN) :: array 00460 INTEGER :: the_size 00461 00462 IF (ASSOCIATED (array%low)) THEN 00463 the_size = SIZE(array%low%data) 00464 ELSE 00465 the_size = 0 00466 ENDIF 00467 END FUNCTION array_size_d1d 00468 PURE FUNCTION array_size_d2d(array) RESULT (the_size) 00469 TYPE(array_d2d_obj), INTENT(IN) :: array 00470 INTEGER :: the_size 00471 00472 IF (ASSOCIATED (array%low)) THEN 00473 the_size = SIZE(array%low%data) 00474 ELSE 00475 the_size = 0 00476 ENDIF 00477 END FUNCTION array_size_d2d 00478 00479 ! 00480 00481 PURE FUNCTION array_equality_i1d(array1, array2) RESULT (are_equal) 00482 TYPE(array_i1d_obj), INTENT(IN) :: array1, array2 00483 LOGICAL :: are_equal 00484 00485 are_equal = .FALSE. 00486 IF (ASSOCIATED (array1%low) .AND. ASSOCIATED (array2%low)) THEN 00487 IF (SIZE(array1%low%data) .NE. SIZE(array2%low%data)) RETURN 00488 are_equal = ALL(array1%low%data .EQ. array2%low%data) 00489 ENDIF 00490 END FUNCTION array_equality_i1d 00491 PURE FUNCTION array_equality_i2d(array1, array2) RESULT (are_equal) 00492 TYPE(array_i2d_obj), INTENT(IN) :: array1, array2 00493 LOGICAL :: are_equal 00494 00495 are_equal = .FALSE. 00496 IF (ASSOCIATED (array1%low) .AND. ASSOCIATED (array2%low)) THEN 00497 IF (SIZE(array1%low%data) .NE. SIZE(array2%low%data)) RETURN 00498 are_equal = ALL(array1%low%data .EQ. array2%low%data) 00499 ENDIF 00500 END FUNCTION array_equality_i2d 00501 PURE FUNCTION array_equality_d1d(array1, array2) RESULT (are_equal) 00502 TYPE(array_d1d_obj), INTENT(IN) :: array1, array2 00503 LOGICAL :: are_equal 00504 00505 are_equal = .FALSE. 00506 IF (ASSOCIATED (array1%low) .AND. ASSOCIATED (array2%low)) THEN 00507 IF (SIZE(array1%low%data) .NE. SIZE(array2%low%data)) RETURN 00508 are_equal = ALL(array1%low%data .EQ. array2%low%data) 00509 ENDIF 00510 END FUNCTION array_equality_d1d 00511 PURE FUNCTION array_equality_d2d(array1, array2) RESULT (are_equal) 00512 TYPE(array_d2d_obj), INTENT(IN) :: array1, array2 00513 LOGICAL :: are_equal 00514 00515 are_equal = .FALSE. 00516 IF (ASSOCIATED (array1%low) .AND. ASSOCIATED (array2%low)) THEN 00517 IF (SIZE(array1%low%data) .NE. SIZE(array2%low%data)) RETURN 00518 are_equal = ALL(array1%low%data .EQ. array2%low%data) 00519 ENDIF 00520 END FUNCTION array_equality_d2d 00521 00522 ! 00523 00524 PURE FUNCTION array_get_i1d(array, index1) RESULT (value) 00525 TYPE(array_i1d_obj), INTENT(IN) :: array 00526 INTEGER, INTENT(IN) :: index1 00527 INTEGER :: value 00528 00529 value = array%low%data(index1) 00530 END FUNCTION array_get_i1d 00531 PURE FUNCTION array_get_i2d(array, index1, index2) RESULT (value) 00532 TYPE(array_i2d_obj), INTENT(IN) :: array 00533 INTEGER, INTENT(IN) :: index1, index2 00534 INTEGER :: value 00535 00536 value = array%low%data(index1, index2) 00537 END FUNCTION array_get_i2d 00538 PURE FUNCTION array_get_d1d(array, index1) RESULT (value) 00539 TYPE(array_d1d_obj), INTENT(IN) :: array 00540 INTEGER, INTENT(IN) :: index1 00541 REAL(KIND=dp) :: value 00542 00543 value = array%low%data(index1) 00544 END FUNCTION array_get_d1d 00545 PURE FUNCTION array_get_d2d(array, index1, index2) RESULT (value) 00546 TYPE(array_d2d_obj), INTENT(IN) :: array 00547 INTEGER, INTENT(IN) :: index1, index2 00548 REAL(KIND=dp) :: value 00549 00550 value = array%low%data(index1, index2) 00551 END FUNCTION array_get_d2d 00552 00553 00554 END MODULE array_types
1.7.3