|
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 ! ***************************************************************************** 00023 MODULE qs_loc_types 00024 00025 USE cell_types, ONLY: cell_release,& 00026 cell_retain,& 00027 cell_type 00028 USE cp_array_r_utils, ONLY: cp_2d_r_p_type 00029 USE cp_dbcsr_operations, ONLY: cp_dbcsr_deallocate_matrix 00030 USE cp_dbcsr_types, ONLY: cp_dbcsr_p_type 00031 USE cp_fm_types, ONLY: cp_fm_p_type,& 00032 cp_fm_release 00033 USE cp_para_env, ONLY: cp_para_env_release,& 00034 cp_para_env_retain 00035 USE cp_para_types, ONLY: cp_para_env_type 00036 USE distribution_1d_types, ONLY: distribution_1d_release,& 00037 distribution_1d_retain,& 00038 distribution_1d_type 00039 USE f77_blas 00040 USE kinds, ONLY: default_string_length,& 00041 dp 00042 USE particle_types, ONLY: particle_type 00043 #include "cp_common_uses.h" 00044 00045 IMPLICIT NONE 00046 00047 PRIVATE 00048 00049 ! *** Global parameters *** 00050 00051 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_loc_types' 00052 00053 00054 !****t* qs_loc_types/qs_loc_env_new_type [1.0] * 00055 00056 ! ***************************************************************************** 00083 TYPE qs_loc_env_new_type 00084 INTEGER :: ref_count 00085 LOGICAL :: molecular_states, do_localize, first_time 00086 LOGICAL :: wannier_states 00087 CHARACTER(LEN=default_string_length) :: tag_mo 00088 TYPE ( cp_para_env_type ), POINTER :: para_env 00089 TYPE ( cp_fm_p_type), DIMENSION(:), 00090 POINTER :: moloc_coeff 00091 TYPE ( cp_fm_p_type), DIMENSION(:,:), 00092 POINTER :: op_fm_set 00093 TYPE(distribution_1d_type), POINTER :: local_molecules 00094 TYPE ( cell_type ), POINTER :: cell 00095 TYPE ( localized_wfn_control_type ), 00096 POINTER :: localized_wfn_control 00097 TYPE (particle_type), DIMENSION(:), 00098 POINTER :: particle_set 00099 TYPE (cp_dbcsr_p_type), DIMENSION(:,:), 00100 POINTER :: op_sm_set 00101 00102 REAL (KIND = dp) :: start_time,target_time 00103 REAL (KIND = dp) :: weights ( 6 ) 00104 INTEGER :: dim_op 00105 END TYPE qs_loc_env_new_type 00106 00107 00108 ! ***************************************************************************** 00126 TYPE localized_wfn_control_type 00127 INTEGER :: ref_count 00128 INTEGER :: min_or_max 00129 INTEGER :: localization_method 00130 INTEGER :: operator_type 00131 INTEGER, DIMENSION(2) :: nloc_states 00132 INTEGER :: set_of_states 00133 INTEGER, DIMENSION(2,2) :: lu_bound_states 00134 INTEGER :: max_iter 00135 INTEGER :: out_each 00136 REAL(KIND=dp) :: eps_localization 00137 REAL(KIND=dp) :: max_crazy_angle 00138 REAL(KIND=dp) :: crazy_scale 00139 REAL(KIND=dp) :: eps_occ 00140 REAL(KIND=dp), DIMENSION(2) :: lu_ene_bound 00141 LOGICAL :: crazy_use_diag 00142 LOGICAL :: print_cubes, jacobi_fallback 00143 LOGICAL :: print_centers 00144 LOGICAL :: print_spreads 00145 LOGICAL :: do_homo 00146 LOGICAL :: loc_restart 00147 LOGICAL :: use_history 00148 INTEGER, POINTER, DIMENSION(:,:) :: loc_states 00149 TYPE(cp_2d_r_p_type), DIMENSION(2) :: centers_set 00150 END TYPE localized_wfn_control_type 00151 00152 ! *** Public *** 00153 PUBLIC :: qs_loc_env_create, qs_loc_env_destroy, & 00154 qs_loc_env_release, qs_loc_env_retain, & 00155 get_qs_loc_env, set_qs_loc_env,& 00156 localized_wfn_control_create, localized_wfn_control_release 00157 PUBLIC :: qs_loc_env_new_type,localized_wfn_control_type 00158 00159 CONTAINS 00160 00161 !****f* qs_loc_types/qs_loc_env_create [1.0] * 00162 00163 ! ***************************************************************************** 00168 SUBROUTINE qs_loc_env_create(qs_loc_env,error) 00169 00170 TYPE(qs_loc_env_new_type), POINTER :: qs_loc_env 00171 TYPE(cp_error_type), INTENT(inout) :: error 00172 00173 CHARACTER(len=*), PARAMETER :: routineN = 'qs_loc_env_create', 00174 routineP = moduleN//':'//routineN 00175 00176 INTEGER :: istat 00177 LOGICAL :: failure 00178 00179 failure=.FALSE. 00180 00181 CPPrecondition(.NOT.ASSOCIATED(qs_loc_env),cp_failure_level,routineP,error,failure) 00182 00183 IF(.NOT. failure) THEN 00184 ALLOCATE(qs_loc_env,STAT=istat) 00185 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00186 00187 qs_loc_env%ref_count = 1 00188 qs_loc_env%tag_mo="" 00189 NULLIFY(qs_loc_env%para_env) 00190 NULLIFY(qs_loc_env%cell) 00191 NULLIFY(qs_loc_env%op_sm_set) 00192 NULLIFY(qs_loc_env%op_fm_set) 00193 NULLIFY(qs_loc_env%local_molecules) 00194 NULLIFY(qs_loc_env%moloc_coeff) 00195 NULLIFY(qs_loc_env%particle_set) 00196 NULLIFY(qs_loc_env%localized_wfn_control) 00197 qs_loc_env%weights = 0.0_dp 00198 END IF 00199 00200 END SUBROUTINE qs_loc_env_create 00201 00202 !****f* qs_loc_types/qs_loc_env_destroy [1.0] * 00203 00204 ! ***************************************************************************** 00209 SUBROUTINE qs_loc_env_destroy(qs_loc_env,error) 00210 00211 TYPE(qs_loc_env_new_type), POINTER :: qs_loc_env 00212 TYPE(cp_error_type), INTENT(inout) :: error 00213 00214 CHARACTER(len=*), PARAMETER :: routineN = 'qs_loc_env_destroy', 00215 routineP = moduleN//':'//routineN 00216 00217 INTEGER :: i, istat, j 00218 LOGICAL :: failure 00219 00220 failure =.FALSE. 00221 CPPrecondition(ASSOCIATED(qs_loc_env),cp_warning_level,routineP,error,failure) 00222 00223 IF(.NOT. failure) THEN 00224 IF(ASSOCIATED(qs_loc_env%cell)) CALL cell_release(qs_loc_env%cell,error=error) 00225 IF(ASSOCIATED(qs_loc_env%local_molecules)) & 00226 CALL distribution_1d_release(qs_loc_env%local_molecules,error=error) 00227 IF (ASSOCIATED(qs_loc_env%localized_wfn_control)) THEN 00228 CALL localized_wfn_control_release(qs_loc_env%localized_wfn_control,& 00229 error=error) 00230 END IF 00231 IF(ASSOCIATED(qs_loc_env%para_env)) CALL cp_para_env_release(qs_loc_env%para_env,error) 00232 IF(ASSOCIATED(qs_loc_env%particle_set)) NULLIFY(qs_loc_env%particle_set) 00233 00234 IF(ASSOCIATED(qs_loc_env%moloc_coeff)) THEN 00235 DO i=1,SIZE ( qs_loc_env % moloc_coeff,1) 00236 CALL cp_fm_release(qs_loc_env%moloc_coeff(i)%matrix,error=error) 00237 END DO 00238 DEALLOCATE(qs_loc_env%moloc_coeff,STAT=istat) 00239 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00240 END IF 00241 00242 IF(ASSOCIATED(qs_loc_env%op_fm_set)) THEN 00243 DO i=1,SIZE ( qs_loc_env % op_fm_set,2) 00244 DO j=1,SIZE ( qs_loc_env % op_fm_set,1) 00245 CALL cp_fm_release(qs_loc_env%op_fm_set(j,i)%matrix,error=error) 00246 END DO 00247 END DO 00248 DEALLOCATE(qs_loc_env%op_fm_set,STAT=istat) 00249 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00250 END IF 00251 00252 IF(ASSOCIATED(qs_loc_env%op_sm_set)) THEN 00253 DO i=1,SIZE ( qs_loc_env % op_sm_set, 2 ) 00254 DO j=1,SIZE ( qs_loc_env % op_sm_set, 1 ) 00255 CALL cp_dbcsr_deallocate_matrix(qs_loc_env%op_sm_set(j,i)%matrix,error=error) 00256 ENDDO 00257 END DO 00258 DEALLOCATE(qs_loc_env%op_sm_set,STAT=istat) 00259 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00260 END IF 00261 00262 DEALLOCATE(qs_loc_env,STAT=istat) 00263 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00264 END IF 00265 00266 END SUBROUTINE qs_loc_env_destroy 00267 00268 !****f* qs_loc_types/qs_loc_env_release [1.0] * 00269 00270 ! ***************************************************************************** 00275 SUBROUTINE qs_loc_env_release(qs_loc_env,error) 00276 00277 TYPE(qs_loc_env_new_type), POINTER :: qs_loc_env 00278 TYPE(cp_error_type), INTENT(inout) :: error 00279 00280 CHARACTER(len=*), PARAMETER :: routineN = 'qs_loc_env_release', 00281 routineP = moduleN//':'//routineN 00282 00283 LOGICAL :: failure 00284 00285 failure=.FALSE. 00286 00287 IF (ASSOCIATED(qs_loc_env)) THEN 00288 CPPreconditionNoFail(qs_loc_env%ref_count>0,cp_failure_level,routineP,error) 00289 qs_loc_env%ref_count = qs_loc_env%ref_count -1 00290 IF (qs_loc_env%ref_count==0) THEN 00291 CALL qs_loc_env_destroy(qs_loc_env,error) 00292 END IF 00293 END IF 00294 END SUBROUTINE qs_loc_env_release 00295 00296 !****f* qs_loc_types/qs_loc_env_retain [1.0] * 00297 00298 ! ***************************************************************************** 00303 SUBROUTINE qs_loc_env_retain(qs_loc_env,error) 00304 00305 TYPE(qs_loc_env_new_type), POINTER :: qs_loc_env 00306 TYPE(cp_error_type), INTENT(inout) :: error 00307 00308 CHARACTER(len=*), PARAMETER :: routineN = 'qs_loc_env_retain', 00309 routineP = moduleN//':'//routineN 00310 00311 LOGICAL :: failure 00312 00313 failure=.FALSE. 00314 00315 CPPrecondition(ASSOCIATED(qs_loc_env),cp_failure_level,routineP,error,failure) 00316 IF(.NOT. failure) THEN 00317 CPPreconditionNoFail(qs_loc_env%ref_count>0,cp_failure_level,routineP,error) 00318 qs_loc_env%ref_count = qs_loc_env%ref_count +1 00319 END IF 00320 END SUBROUTINE qs_loc_env_retain 00321 00322 00323 00324 ! ***************************************************************************** 00329 SUBROUTINE localized_wfn_control_create(localized_wfn_control,error) 00330 TYPE(localized_wfn_control_type), 00331 POINTER :: localized_wfn_control 00332 TYPE(cp_error_type), INTENT(inout) :: error 00333 00334 CHARACTER(len=*), PARAMETER :: routineN = 'localized_wfn_control_create', 00335 routineP = moduleN//':'//routineN 00336 00337 INTEGER :: stat 00338 LOGICAL :: failure 00339 00340 failure=.FALSE. 00341 00342 CPPrecondition(.NOT.ASSOCIATED(localized_wfn_control),cp_failure_level,routineP,error,failure) 00343 ALLOCATE(localized_wfn_control,stat=stat) 00344 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00345 00346 localized_wfn_control%ref_count= 1 00347 localized_wfn_control%nloc_states=0 00348 localized_wfn_control%lu_bound_states=0 00349 localized_wfn_control%lu_ene_bound=0.0_dp 00350 localized_wfn_control%print_cubes = .FALSE. 00351 localized_wfn_control%print_centers = .FALSE. 00352 localized_wfn_control%print_spreads = .FALSE. 00353 localized_wfn_control%do_homo = .TRUE. 00354 localized_wfn_control%use_history = .FALSE. 00355 NULLIFY(localized_wfn_control%loc_states) 00356 NULLIFY(localized_wfn_control%centers_set(1)%array) 00357 NULLIFY(localized_wfn_control%centers_set(2)%array) 00358 END SUBROUTINE localized_wfn_control_create 00359 00360 ! ***************************************************************************** 00365 SUBROUTINE localized_wfn_control_release(localized_wfn_control,error) 00366 00367 TYPE(localized_wfn_control_type), 00368 POINTER :: localized_wfn_control 00369 TYPE(cp_error_type), INTENT(inout) :: error 00370 00371 CHARACTER(len=*), PARAMETER :: 00372 routineN = 'localized_wfn_control_release', 00373 routineP = moduleN//':'//routineN 00374 00375 INTEGER :: istat 00376 LOGICAL :: failure 00377 00378 failure=.FALSE. 00379 IF(ASSOCIATED(localized_wfn_control)) THEN 00380 CPPrecondition(localized_wfn_control%ref_count>0,cp_failure_level,routineP,error,failure) 00381 localized_wfn_control%ref_count=localized_wfn_control%ref_count-1 00382 IF (localized_wfn_control%ref_count==0) THEN 00383 IF (ASSOCIATED(localized_wfn_control%loc_states)) THEN 00384 DEALLOCATE(localized_wfn_control%loc_states,STAT=istat) 00385 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00386 ENDIF 00387 IF (ASSOCIATED(localized_wfn_control%centers_set(1)%array)) THEN 00388 DEALLOCATE(localized_wfn_control%centers_set(1)%array,STAT=istat) 00389 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00390 ENDIF 00391 IF (ASSOCIATED(localized_wfn_control%centers_set(2)%array)) THEN 00392 DEALLOCATE(localized_wfn_control%centers_set(2)%array,STAT=istat) 00393 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00394 ENDIF 00395 localized_wfn_control%ref_count=0 00396 DEALLOCATE(localized_wfn_control,STAT=istat) 00397 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00398 ENDIF 00399 END IF 00400 END SUBROUTINE localized_wfn_control_release 00401 00402 ! ***************************************************************************** 00407 SUBROUTINE localized_wfn_control_retain(localized_wfn_control,error) 00408 TYPE(localized_wfn_control_type), 00409 POINTER :: localized_wfn_control 00410 TYPE(cp_error_type), INTENT(inout) :: error 00411 00412 CHARACTER(len=*), PARAMETER :: routineN = 'localized_wfn_control_retain', 00413 routineP = moduleN//':'//routineN 00414 00415 LOGICAL :: failure 00416 00417 failure=.FALSE. 00418 CPPrecondition(ASSOCIATED(localized_wfn_control),cp_failure_level,routineP,error,failure) 00419 00420 localized_wfn_control%ref_count=localized_wfn_control%ref_count+1 00421 END SUBROUTINE localized_wfn_control_retain 00422 00423 00424 00425 !****f* qs_loc_types/get_qs_loc_env [1.0] * 00426 00427 ! ***************************************************************************** 00432 SUBROUTINE get_qs_loc_env(qs_loc_env,cell,local_molecules,localized_wfn_control,& 00433 moloc_coeff,op_sm_set,op_fm_set,para_env,particle_set,weights,dim_op,error) 00434 00435 TYPE(qs_loc_env_new_type), POINTER :: qs_loc_env 00436 TYPE(cell_type), OPTIONAL, POINTER :: cell 00437 TYPE(distribution_1d_type), OPTIONAL, 00438 POINTER :: local_molecules 00439 TYPE(localized_wfn_control_type), 00440 OPTIONAL, POINTER :: localized_wfn_control 00441 TYPE(cp_fm_p_type), DIMENSION(:), 00442 OPTIONAL, POINTER :: moloc_coeff 00443 TYPE(cp_dbcsr_p_type), DIMENSION(:, :), 00444 OPTIONAL, POINTER :: op_sm_set 00445 TYPE(cp_fm_p_type), DIMENSION(:, :), 00446 OPTIONAL, POINTER :: op_fm_set 00447 TYPE(cp_para_env_type), OPTIONAL, 00448 POINTER :: para_env 00449 TYPE(particle_type), DIMENSION(:), 00450 OPTIONAL, POINTER :: particle_set 00451 REAL(dp), DIMENSION(6), OPTIONAL :: weights 00452 INTEGER, OPTIONAL :: dim_op 00453 TYPE(cp_error_type), INTENT(inout) :: error 00454 00455 CHARACTER(len=*), PARAMETER :: routineN = 'get_qs_loc_env', 00456 routineP = moduleN//':'//routineN 00457 00458 LOGICAL :: failure 00459 00460 failure =.FALSE. 00461 CPPrecondition(ASSOCIATED(qs_loc_env),cp_failure_level,routineP,error,failure) 00462 00463 IF(.NOT.failure) THEN 00464 IF (PRESENT(cell)) cell => qs_loc_env%cell 00465 IF (PRESENT(moloc_coeff)) moloc_coeff => qs_loc_env%moloc_coeff 00466 IF (PRESENT(local_molecules)) local_molecules => qs_loc_env%local_molecules 00467 IF (PRESENT(localized_wfn_control)) & 00468 localized_wfn_control => qs_loc_env%localized_wfn_control 00469 IF (PRESENT(op_sm_set)) op_sm_set => qs_loc_env%op_sm_set 00470 IF (PRESENT(op_fm_set)) op_fm_set => qs_loc_env%op_fm_set 00471 IF (PRESENT(para_env)) para_env => qs_loc_env%para_env 00472 IF (PRESENT(particle_set)) particle_set => qs_loc_env%particle_set 00473 IF (PRESENT(weights)) weights(1:6)= qs_loc_env%weights(1:6) 00474 IF (PRESENT(dim_op)) dim_op = qs_loc_env%dim_op 00475 END IF 00476 00477 END SUBROUTINE get_qs_loc_env 00478 00479 !****f* qs_loc_types/set_qs_loc_env [1.0] * 00480 00481 ! ***************************************************************************** 00486 SUBROUTINE set_qs_loc_env(qs_loc_env,cell,local_molecules,localized_wfn_control,& 00487 moloc_coeff,op_sm_set,op_fm_set,para_env,particle_set,weights,dim_op,error) 00488 00489 TYPE(qs_loc_env_new_type), POINTER :: qs_loc_env 00490 TYPE(cell_type), OPTIONAL, POINTER :: cell 00491 TYPE(distribution_1d_type), OPTIONAL, 00492 POINTER :: local_molecules 00493 TYPE(localized_wfn_control_type), 00494 OPTIONAL, POINTER :: localized_wfn_control 00495 TYPE(cp_fm_p_type), DIMENSION(:), 00496 OPTIONAL, POINTER :: moloc_coeff 00497 TYPE(cp_dbcsr_p_type), DIMENSION(:, :), 00498 OPTIONAL, POINTER :: op_sm_set 00499 TYPE(cp_fm_p_type), DIMENSION(:, :), 00500 OPTIONAL, POINTER :: op_fm_set 00501 TYPE(cp_para_env_type), OPTIONAL, 00502 POINTER :: para_env 00503 TYPE(particle_type), DIMENSION(:), 00504 OPTIONAL, POINTER :: particle_set 00505 REAL(dp), DIMENSION(6), OPTIONAL :: weights 00506 INTEGER, OPTIONAL :: dim_op 00507 TYPE(cp_error_type), INTENT(inout) :: error 00508 00509 CHARACTER(len=*), PARAMETER :: routineN = 'set_qs_loc_env', 00510 routineP = moduleN//':'//routineN 00511 00512 INTEGER :: i, istat 00513 LOGICAL :: failure 00514 00515 failure =.FALSE. 00516 CPPrecondition(ASSOCIATED(qs_loc_env),cp_failure_level,routineP,error,failure) 00517 IF(.NOT.failure) THEN 00518 IF (PRESENT(cell)) THEN 00519 CALL cell_retain(cell, error=error) 00520 CALL cell_release(qs_loc_env%cell,error=error) 00521 qs_loc_env%cell => cell 00522 END IF 00523 00524 IF (PRESENT(local_molecules)) THEN 00525 CALL distribution_1d_retain(local_molecules,error=error) 00526 IF(ASSOCIATED(qs_loc_env%local_molecules)) & 00527 CALL distribution_1d_release(qs_loc_env%local_molecules,error=error) 00528 qs_loc_env%local_molecules => local_molecules 00529 END IF 00530 00531 IF(PRESENT(localized_wfn_control)) THEN 00532 CALL localized_wfn_control_retain(localized_wfn_control,error=error) 00533 CALL localized_wfn_control_release(qs_loc_env%localized_wfn_control,error=error) 00534 qs_loc_env % localized_wfn_control => localized_wfn_control 00535 END IF 00536 IF(PRESENT(para_env)) THEN 00537 CALL cp_para_env_retain(para_env,error=error) 00538 CALL cp_para_env_release(qs_loc_env%para_env,error=error) 00539 qs_loc_env%para_env => para_env 00540 END IF 00541 IF (PRESENT(particle_set)) qs_loc_env%particle_set => particle_set 00542 IF(PRESENT(moloc_coeff)) THEN 00543 IF(ASSOCIATED(qs_loc_env%moloc_coeff )) THEN 00544 DO i=1,SIZE ( qs_loc_env % moloc_coeff,1) 00545 CALL cp_fm_release(qs_loc_env%moloc_coeff(i)%matrix,error=error) 00546 END DO 00547 DEALLOCATE(qs_loc_env%moloc_coeff,STAT=istat) 00548 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00549 NULLIFY(qs_loc_env%moloc_coeff) 00550 END IF 00551 qs_loc_env%moloc_coeff => moloc_coeff 00552 END IF 00553 IF(PRESENT(op_sm_set)) THEN 00554 qs_loc_env%op_sm_set => op_sm_set 00555 END IF 00556 IF(PRESENT(op_fm_set)) THEN 00557 qs_loc_env%op_fm_set => op_fm_set 00558 END IF 00559 IF(PRESENT(weights)) THEN 00560 qs_loc_env%weights = weights 00561 END IF 00562 IF(PRESENT(dim_op)) THEN 00563 qs_loc_env%dim_op = dim_op 00564 END IF 00565 END IF 00566 00567 END SUBROUTINE set_qs_loc_env 00568 00569 00570 END MODULE qs_loc_types 00571
1.7.3