|
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 ! ***************************************************************************** 00012 MODULE admm_types 00013 USE bibliography, ONLY: Guidon2010,& 00014 cite_reference 00015 USE cp_fm_struct, ONLY: cp_fm_struct_create,& 00016 cp_fm_struct_release,& 00017 cp_fm_struct_type 00018 USE cp_fm_types, ONLY: cp_fm_create,& 00019 cp_fm_p_type,& 00020 cp_fm_release,& 00021 cp_fm_type 00022 USE cp_para_types, ONLY: cp_para_env_type 00023 USE f77_blas 00024 USE input_constants, ONLY: do_admm_block_density_matrix 00025 USE input_section_types, ONLY: section_vals_get,& 00026 section_vals_get_subs_vals,& 00027 section_vals_release,& 00028 section_vals_type,& 00029 section_vals_val_get 00030 USE kinds, ONLY: dp 00031 USE mathconstants 00032 USE qs_mo_types, ONLY: get_mo_set,& 00033 mo_set_p_type 00034 #include "cp_common_uses.h" 00035 00036 IMPLICIT NONE 00037 PRIVATE 00038 PUBLIC admm_env_create, admm_env_release, admm_type, eigvals_p_type, eigvals_type,& 00039 admm_create_block_list, admm_block 00040 00041 00042 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'admm_types' 00043 00044 TYPE eigvals_type 00045 REAL(dp), DIMENSION(:), POINTER :: DATA 00046 END TYPE 00047 00048 TYPE eigvals_p_type 00049 TYPE(eigvals_type), POINTER :: eigvals 00050 END TYPE 00051 00052 TYPE admm_block 00053 INTEGER, DIMENSION(:), POINTER :: list 00054 END TYPE 00055 00056 00057 ! ***************************************************************************** 00082 00083 TYPE admm_type 00084 TYPE(cp_fm_type), POINTER :: S_inv, S 00085 TYPE(cp_fm_type), POINTER :: Q 00086 TYPE(cp_fm_type), POINTER :: A 00087 TYPE(cp_fm_type), POINTER :: B 00088 TYPE(cp_fm_type), POINTER :: work_orb_orb, work_orb_orb2 00089 TYPE(cp_fm_type), POINTER :: work_aux_orb, work_aux_orb2 00090 TYPE(cp_fm_p_type), DIMENSION(:), 00091 POINTER :: lambda, lambda_inv 00092 TYPE(cp_fm_p_type), DIMENSION(:), 00093 POINTER :: lambda_inv_sqrt 00094 TYPE(cp_fm_p_type), DIMENSION(:), 00095 POINTER :: R, R_purify 00096 TYPE(cp_fm_type), POINTER :: work_aux_aux, work_aux_aux2, work_aux_aux3 00097 TYPE(cp_fm_p_type), DIMENSION(:), 00098 POINTER :: work_orb_nmo 00099 TYPE(cp_fm_p_type), DIMENSION(:), 00100 POINTER :: work_nmo_nmo1 00101 TYPE(cp_fm_p_type), DIMENSION(:), 00102 POINTER :: R_schur_R_t 00103 TYPE(cp_fm_p_type), DIMENSION(:), 00104 POINTER :: work_nmo_nmo2 00105 TYPE(cp_fm_p_type), DIMENSION(:), 00106 POINTER :: work_aux_nmo 00107 TYPE(cp_fm_p_type), DIMENSION(:), 00108 POINTER :: work_aux_nmo2 00109 TYPE(cp_fm_p_type), DIMENSION(:), 00110 POINTER :: H, H_corr 00111 TYPE(cp_fm_p_type), DIMENSION(:), 00112 POINTER :: mo_derivs_tmp 00113 TYPE(cp_fm_p_type), DIMENSION(:), 00114 POINTER :: K 00115 TYPE(cp_fm_p_type), DIMENSION(:), 00116 POINTER :: M, M_purify, P_to_be_purified 00117 INTEGER :: nao_orb, nao_aux_fit, nmo(2) 00118 TYPE(eigvals_p_type), DIMENSION(:), 00119 POINTER :: eigvals_lambda, eigvals_P_to_be_purified 00120 TYPE(section_vals_type), POINTER :: xc_section_primary 00121 TYPE(section_vals_type), POINTER :: xc_section_aux 00122 TYPE(cp_fm_p_type), DIMENSION(:), 00123 POINTER :: lambda_inv2, C_hat, P_tilde 00124 TYPE(cp_fm_p_type), DIMENSION(:), 00125 POINTER :: ks_to_be_merged 00126 INTEGER :: method_id 00127 INTEGER :: purification_method 00128 INTEGER :: block_purification_method 00129 INTEGER :: block_projection_method 00130 TYPE(admm_block), DIMENSION(:), 00131 POINTER :: blocks 00132 INTEGER, DIMENSION(:,:), POINTER :: block_map 00133 END TYPE 00134 00135 00136 00137 CONTAINS 00138 00139 ! ***************************************************************************** 00153 00154 SUBROUTINE admm_env_create(mos, mos_aux_fit, para_env, admm_env, error) 00155 TYPE(mo_set_p_type), DIMENSION(:), 00156 POINTER :: mos, mos_aux_fit 00157 TYPE(cp_para_env_type), POINTER :: para_env 00158 TYPE(admm_type), POINTER :: admm_env 00159 TYPE(cp_error_type), INTENT(inout) :: error 00160 00161 CHARACTER(LEN=*), PARAMETER :: routineN = 'admm_env_create', 00162 routineP = moduleN//':'//routineN 00163 00164 INTEGER :: ispin, istat, nao_aux_fit, 00165 nao_orb, nmo, nspins 00166 LOGICAL :: failure 00167 TYPE(cp_fm_struct_type), POINTER :: fm_struct_aux_aux, fm_struct_aux_nmo, 00168 fm_struct_aux_orb, fm_struct_nmo_nmo, fm_struct_orb_aux, 00169 fm_struct_orb_nmo, fm_struct_orb_orb 00170 TYPE(cp_fm_type), POINTER :: mo_coeff 00171 00172 CALL cite_reference(Guidon2010) 00173 00174 ALLOCATE(admm_env, STAT=istat) 00175 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00176 nspins = SIZE(mos) 00177 CALL get_mo_set(mos(1)%mo_set,mo_coeff=mo_coeff, nmo=nmo, nao=nao_orb) 00178 CALL get_mo_set(mos_aux_fit(1)%mo_set,nao=nao_aux_fit) 00179 admm_env%nmo = 0 00180 admm_env%nao_aux_fit = nao_aux_fit 00181 admm_env%nao_orb = nao_orb 00182 CALL cp_fm_struct_create(fm_struct_aux_aux,& 00183 context=mo_coeff%matrix_struct%context,& 00184 nrow_global=nao_aux_fit,& 00185 ncol_global=nao_aux_fit,& 00186 para_env=para_env,& 00187 error=error) 00188 CALL cp_fm_struct_create(fm_struct_aux_orb,& 00189 context=mo_coeff%matrix_struct%context,& 00190 nrow_global=nao_aux_fit,& 00191 ncol_global=nao_orb,& 00192 para_env=para_env,& 00193 error=error) 00194 CALL cp_fm_struct_create(fm_struct_orb_aux,& 00195 context=mo_coeff%matrix_struct%context,& 00196 nrow_global=nao_orb,& 00197 ncol_global=nao_aux_fit,& 00198 para_env=para_env,& 00199 error=error) 00200 CALL cp_fm_struct_create(fm_struct_orb_orb,& 00201 context=mo_coeff%matrix_struct%context,& 00202 nrow_global=nao_orb,& 00203 ncol_global=nao_orb,& 00204 para_env=para_env,& 00205 error=error) 00206 00207 CALL cp_fm_create(admm_env%S,fm_struct_aux_aux,name="aux_fit_overlap",error=error) 00208 CALL cp_fm_create(admm_env%S_inv,fm_struct_aux_aux,name="aux_fit_overlap_inv",error=error) 00209 CALL cp_fm_create(admm_env%Q,fm_struct_aux_orb,name="mixed_overlap",error=error) 00210 CALL cp_fm_create(admm_env%A,fm_struct_aux_orb,name="work_A",error=error) 00211 CALL cp_fm_create(admm_env%B,fm_struct_orb_orb,name="work_B",error=error) 00212 CALL cp_fm_create(admm_env%work_orb_orb,fm_struct_orb_orb,name="work_orb_orb",error=error) 00213 CALL cp_fm_create(admm_env%work_orb_orb2,fm_struct_orb_orb,name="work_orb_orb",error=error) 00214 CALL cp_fm_create(admm_env%work_aux_orb,fm_struct_aux_orb,name="work_aux_orb",error=error) 00215 CALL cp_fm_create(admm_env%work_aux_orb2,fm_struct_aux_orb,name="work_aux_orb2",error=error) 00216 00217 CALL cp_fm_create(admm_env%work_aux_aux,fm_struct_aux_aux,name="work_aux_aux",error=error) 00218 CALL cp_fm_create(admm_env%work_aux_aux2,fm_struct_aux_aux,name="work_aux_aux2",error=error) 00219 CALL cp_fm_create(admm_env%work_aux_aux3,fm_struct_aux_aux,name="work_aux_aux3",error=error) 00220 00221 ALLOCATE(admm_env%lambda_inv(nspins),STAT=istat) 00222 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00223 ALLOCATE(admm_env%lambda(nspins),STAT=istat) 00224 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00225 ALLOCATE(admm_env%lambda_inv_sqrt(nspins),STAT=istat) 00226 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00227 ALLOCATE(admm_env%R(nspins),STAT=istat) 00228 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00229 ALLOCATE(admm_env%R_purify(nspins),STAT=istat) 00230 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00231 ALLOCATE(admm_env%work_orb_nmo(nspins),STAT=istat) 00232 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00233 ALLOCATE(admm_env%work_nmo_nmo1(nspins),STAT=istat) 00234 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00235 ALLOCATE(admm_env%R_schur_R_t(nspins),STAT=istat) 00236 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00237 ALLOCATE(admm_env%work_nmo_nmo2(nspins),STAT=istat) 00238 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00239 ALLOCATE(admm_env%eigvals_lambda(nspins),STAT=istat) 00240 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00241 ALLOCATE(admm_env%eigvals_P_to_be_purified(nspins),STAT=istat) 00242 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00243 ALLOCATE(admm_env%H(nspins),STAT=istat) 00244 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00245 ALLOCATE(admm_env%K(nspins),STAT=istat) 00246 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00247 ALLOCATE(admm_env%M(nspins),STAT=istat) 00248 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00249 ALLOCATE(admm_env%M_purify(nspins),STAT=istat) 00250 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00251 ALLOCATE(admm_env%P_to_be_purified(nspins),STAT=istat) 00252 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00253 ALLOCATE(admm_env%work_aux_nmo(nspins),STAT=istat) 00254 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00255 ALLOCATE(admm_env%work_aux_nmo2(nspins),STAT=istat) 00256 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00257 ALLOCATE(admm_env%mo_derivs_tmp(nspins),STAT=istat) 00258 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00259 ALLOCATE(admm_env%H_corr(nspins),STAT=istat) 00260 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00261 ALLOCATE(admm_env%ks_to_be_merged(nspins),STAT=istat) 00262 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00263 ALLOCATE(admm_env%lambda_inv2(nspins),STAT=istat) 00264 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00265 ALLOCATE(admm_env%C_hat(nspins),STAT=istat) 00266 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00267 ALLOCATE(admm_env%P_tilde(nspins),STAT=istat) 00268 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00269 00270 DO ispin = 1,nspins 00271 CALL get_mo_set(mos(ispin)%mo_set,mo_coeff=mo_coeff, nmo=nmo) 00272 admm_env%nmo(ispin)=nmo 00273 CALL cp_fm_struct_create(fm_struct_aux_nmo,& 00274 context=mo_coeff%matrix_struct%context,& 00275 nrow_global=nao_aux_fit,& 00276 ncol_global=nmo,& 00277 para_env=para_env,& 00278 error=error) 00279 CALL cp_fm_struct_create(fm_struct_orb_nmo,& 00280 context=mo_coeff%matrix_struct%context,& 00281 nrow_global=nao_orb,& 00282 ncol_global=nmo,& 00283 para_env=para_env,& 00284 error=error) 00285 CALL cp_fm_struct_create(fm_struct_nmo_nmo,& 00286 context=mo_coeff%matrix_struct%context,& 00287 nrow_global=nmo,& 00288 ncol_global=nmo,& 00289 para_env=para_env,& 00290 error=error) 00291 00292 CALL cp_fm_create(admm_env%work_orb_nmo(ispin)%matrix,fm_struct_orb_nmo,name="work_orb_nmo",error=error) 00293 CALL cp_fm_create(admm_env%work_nmo_nmo1(ispin)%matrix,fm_struct_nmo_nmo,name="work_nmo_nmo1",error=error) 00294 CALL cp_fm_create(admm_env%R_schur_R_t(ispin)%matrix,fm_struct_nmo_nmo,name="R_schur_R_t",error=error) 00295 CALL cp_fm_create(admm_env%work_nmo_nmo2(ispin)%matrix,fm_struct_nmo_nmo,name="work_nmo_nmo2",error=error) 00296 CALL cp_fm_create(admm_env%lambda(ispin)%matrix,fm_struct_nmo_nmo,name="lambda",error=error) 00297 CALL cp_fm_create(admm_env%lambda_inv(ispin)%matrix,fm_struct_nmo_nmo,name="lambda_inv",error=error) 00298 CALL cp_fm_create(admm_env%lambda_inv_sqrt(ispin)%matrix,fm_struct_nmo_nmo,name="lambda_inv_sqrt",error=error) 00299 CALL cp_fm_create(admm_env%R(ispin)%matrix,fm_struct_nmo_nmo,name="R",error=error) 00300 CALL cp_fm_create(admm_env%R_purify(ispin)%matrix,fm_struct_aux_aux,name="R_purify",error=error) 00301 CALL cp_fm_create(admm_env%K(ispin)%matrix,fm_struct_aux_aux,name="K",error=error) 00302 CALL cp_fm_create(admm_env%H(ispin)%matrix,fm_struct_aux_nmo,name="H",error=error) 00303 CALL cp_fm_create(admm_env%H_corr(ispin)%matrix,fm_struct_orb_orb,name="H_corr",error=error) 00304 CALL cp_fm_create(admm_env%M(ispin)%matrix,fm_struct_nmo_nmo,name="M",error=error) 00305 CALL cp_fm_create(admm_env%M_purify(ispin)%matrix,fm_struct_aux_aux,name="M aux",error=error) 00306 CALL cp_fm_create(admm_env%P_to_be_purified(ispin)%matrix,fm_struct_aux_aux,name="P_to_be_purified",error=error) 00307 CALL cp_fm_create(admm_env%work_aux_nmo(ispin)%matrix,fm_struct_aux_nmo,name="work_aux_nmo",error=error) 00308 CALL cp_fm_create(admm_env%work_aux_nmo2(ispin)%matrix,fm_struct_aux_nmo,name="work_aux_nmo2",error=error) 00309 CALL cp_fm_create(admm_env%mo_derivs_tmp(ispin)%matrix,fm_struct_orb_nmo,name="mo_derivs_tmp",error=error) 00310 00311 CALL cp_fm_create(admm_env%lambda_inv2(ispin)%matrix,fm_struct_nmo_nmo,name="lambda_inv2",error=error) 00312 CALL cp_fm_create(admm_env%C_hat(ispin)%matrix,fm_struct_aux_nmo,name="C_hat",error=error) 00313 CALL cp_fm_create(admm_env%P_tilde(ispin)%matrix,fm_struct_aux_aux,name="P_tilde",error=error) 00314 00315 CALL cp_fm_create(admm_env%ks_to_be_merged(ispin)%matrix,fm_struct_orb_orb,name="KS_to_be_merged ",error=error) 00316 00317 ALLOCATE(admm_env%eigvals_lambda(ispin)%eigvals, STAT=istat) 00318 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00319 ALLOCATE(admm_env%eigvals_P_to_be_purified(ispin)%eigvals, STAT=istat) 00320 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00321 ALLOCATE(admm_env%eigvals_lambda(ispin)%eigvals%data(nmo), STAT=istat) 00322 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00323 ALLOCATE(admm_env%eigvals_P_to_be_purified(ispin)%eigvals%data(nao_aux_fit), STAT=istat) 00324 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00325 admm_env%eigvals_lambda(ispin)%eigvals%data = 0.0_dp 00326 admm_env%eigvals_P_to_be_purified(ispin)%eigvals%data = 0.0_dp 00327 CALL cp_fm_struct_release(fm_struct_aux_nmo,error=error) 00328 CALL cp_fm_struct_release(fm_struct_orb_nmo,error=error) 00329 CALL cp_fm_struct_release(fm_struct_nmo_nmo,error=error) 00330 END DO 00331 00332 CALL cp_fm_struct_release(fm_struct_aux_aux,error=error) 00333 CALL cp_fm_struct_release(fm_struct_aux_orb,error=error) 00334 CALL cp_fm_struct_release(fm_struct_orb_aux,error=error) 00335 CALL cp_fm_struct_release(fm_struct_orb_orb,error=error) 00336 END SUBROUTINE admm_env_create 00337 00338 00339 ! ***************************************************************************** 00349 SUBROUTINE admm_env_release(admm_env, error) 00350 TYPE(admm_type), POINTER :: admm_env 00351 TYPE(cp_error_type), INTENT(inout) :: error 00352 00353 CHARACTER(LEN=*), PARAMETER :: routineN = 'admm_env_release', 00354 routineP = moduleN//':'//routineN 00355 00356 INTEGER :: ispin, istat 00357 LOGICAL :: failure 00358 00359 CALL cp_fm_release(admm_env%S, error=error) 00360 CALL cp_fm_release(admm_env%S_inv, error=error) 00361 CALL cp_fm_release(admm_env%Q, error=error) 00362 CALL cp_fm_release(admm_env%A, error=error) 00363 CALL cp_fm_release(admm_env%B, error=error) 00364 CALL cp_fm_release(admm_env%work_orb_orb, error=error) 00365 CALL cp_fm_release(admm_env%work_orb_orb2, error=error) 00366 CALL cp_fm_release(admm_env%work_aux_aux, error=error) 00367 CALL cp_fm_release(admm_env%work_aux_aux2, error=error) 00368 CALL cp_fm_release(admm_env%work_aux_aux3, error=error) 00369 CALL cp_fm_release(admm_env%work_aux_orb, error=error) 00370 CALL cp_fm_release(admm_env%work_aux_orb2, error=error) 00371 DO ispin = 1,SIZE(admm_env%lambda) 00372 CALL cp_fm_release(admm_env%lambda(ispin)%matrix, error=error) 00373 CALL cp_fm_release(admm_env%lambda_inv(ispin)%matrix, error=error) 00374 CALL cp_fm_release(admm_env%lambda_inv_sqrt(ispin)%matrix, error=error) 00375 CALL cp_fm_release(admm_env%lambda_inv2(ispin)%matrix, error=error) 00376 CALL cp_fm_release(admm_env%C_hat(ispin)%matrix, error=error) 00377 CALL cp_fm_release(admm_env%P_tilde(ispin)%matrix, error=error) 00378 CALL cp_fm_release(admm_env%R(ispin)%matrix, error=error) 00379 CALL cp_fm_release(admm_env%R_purify(ispin)%matrix, error=error) 00380 CALL cp_fm_release(admm_env%H(ispin)%matrix, error=error) 00381 CALL cp_fm_release(admm_env%H_corr(ispin)%matrix, error=error) 00382 CALL cp_fm_release(admm_env%K(ispin)%matrix, error=error) 00383 CALL cp_fm_release(admm_env%M(ispin)%matrix, error=error) 00384 CALL cp_fm_release(admm_env%M_purify(ispin)%matrix, error=error) 00385 CALL cp_fm_release(admm_env%P_to_be_purified(ispin)%matrix, error=error) 00386 CALL cp_fm_release(admm_env%work_orb_nmo(ispin)%matrix, error=error) 00387 CALL cp_fm_release(admm_env%work_nmo_nmo1(ispin)%matrix, error=error) 00388 CALL cp_fm_release(admm_env%R_schur_R_t(ispin)%matrix, error=error) 00389 CALL cp_fm_release(admm_env%work_nmo_nmo2(ispin)%matrix, error=error) 00390 CALL cp_fm_release(admm_env%work_aux_nmo(ispin)%matrix, error=error) 00391 CALL cp_fm_release(admm_env%work_aux_nmo2(ispin)%matrix, error=error) 00392 CALL cp_fm_release(admm_env%mo_derivs_tmp(ispin)%matrix, error=error) 00393 CALL cp_fm_release(admm_env%ks_to_be_merged(ispin)%matrix, error=error) 00394 CALL cp_fm_release(admm_env%lambda_inv2(ispin)%matrix, error=error) 00395 DEALLOCATE(admm_env%eigvals_lambda(ispin)%eigvals%data,STAT=istat) 00396 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00397 DEALLOCATE(admm_env%eigvals_P_to_be_purified(ispin)%eigvals%data,STAT=istat) 00398 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00399 DEALLOCATE(admm_env%eigvals_lambda(ispin)%eigvals,STAT=istat) 00400 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00401 DEALLOCATE(admm_env%eigvals_P_to_be_purified(ispin)%eigvals,STAT=istat) 00402 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00403 END DO 00404 DEALLOCATE(admm_env%eigvals_lambda,STAT=istat) 00405 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00406 DEALLOCATE(admm_env%eigvals_P_to_be_purified,STAT=istat) 00407 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00408 DEALLOCATE(admm_env%lambda,STAT=istat) 00409 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00410 DEALLOCATE(admm_env%lambda_inv,STAT=istat) 00411 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00412 DEALLOCATE(admm_env%lambda_inv_sqrt,STAT=istat) 00413 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00414 DEALLOCATE(admm_env%R,STAT=istat) 00415 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00416 DEALLOCATE(admm_env%R_purify,STAT=istat) 00417 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00418 DEALLOCATE(admm_env%M,STAT=istat) 00419 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00420 DEALLOCATE(admm_env%M_purify,STAT=istat) 00421 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00422 DEALLOCATE(admm_env%P_to_be_purified,STAT=istat) 00423 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00424 DEALLOCATE(admm_env%H,STAT=istat) 00425 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00426 DEALLOCATE(admm_env%H_corr,STAT=istat) 00427 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00428 DEALLOCATE(admm_env%K,STAT=istat) 00429 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00430 DEALLOCATE(admm_env%work_orb_nmo,STAT=istat) 00431 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00432 DEALLOCATE(admm_env%work_nmo_nmo1,STAT=istat) 00433 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00434 DEALLOCATE(admm_env%R_schur_R_t,STAT=istat) 00435 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00436 DEALLOCATE(admm_env%work_nmo_nmo2,STAT=istat) 00437 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00438 DEALLOCATE(admm_env%work_aux_nmo,STAT=istat) 00439 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00440 DEALLOCATE(admm_env%work_aux_nmo2,STAT=istat) 00441 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00442 DEALLOCATE(admm_env%mo_derivs_tmp,STAT=istat) 00443 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00444 DEALLOCATE(admm_env%ks_to_be_merged,STAT=istat) 00445 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00446 DEALLOCATE(admm_env%lambda_inv2,STAT=istat) 00447 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00448 DEALLOCATE(admm_env%C_hat,STAT=istat) 00449 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00450 DEALLOCATE(admm_env%P_tilde,STAT=istat) 00451 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00452 00453 IF( admm_env%method_id == do_admm_block_density_matrix) THEN 00454 DEALLOCATE(admm_env%block_map, STAT=istat) 00455 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00456 END IF 00457 00458 IF(ASSOCIATED(admm_env%xc_section_primary))& 00459 CALL section_vals_release(admm_env%xc_section_primary,error) 00460 IF(ASSOCIATED(admm_env%xc_section_aux))& 00461 CALL section_vals_release(admm_env%xc_section_aux,error) 00462 00463 DEALLOCATE(admm_env, STAT=istat) 00464 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00465 00466 END SUBROUTINE admm_env_release 00467 00468 00469 SUBROUTINE admm_create_block_list(admm_block_section, admm_env, natom, error) 00470 TYPE(section_vals_type), POINTER :: admm_block_section 00471 TYPE(admm_type), POINTER :: admm_env 00472 INTEGER :: natom 00473 TYPE(cp_error_type), INTENT(inout) :: error 00474 00475 CHARACTER(LEN=*), PARAMETER :: routineN = 'admm_create_block_list', 00476 routineP = moduleN//':'//routineN 00477 00478 INTEGER :: i, iatom, irep, j, jatom, 00479 list_size, n_rep, stat 00480 INTEGER, DIMENSION(:), POINTER :: tmplist 00481 LOGICAL :: failure 00482 TYPE(section_vals_type), POINTER :: list_section 00483 00484 NULLIFY(list_section) 00485 list_section => section_vals_get_subs_vals(admm_block_section,"BLOCK",error=error) 00486 CALL section_vals_get(list_section,n_repetition=n_rep,error=error) 00487 00488 ALLOCATE(admm_env%blocks(n_rep), STAT=stat) 00489 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00490 00491 DO irep = 1, n_rep 00492 CALL section_vals_val_get(list_section,"LIST", i_rep_section=irep, & 00493 i_vals=tmplist, error=error) 00494 list_size = SIZE(tmplist) 00495 ALLOCATE(admm_env%blocks(irep)%list(list_size), STAT=stat) 00496 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00497 admm_env%blocks(irep)%list = tmplist 00498 END DO 00499 00500 ALLOCATE(admm_env%block_map(natom,natom), STAT=stat) 00501 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00502 00503 admm_env%block_map = 0 00504 DO irep = 1,n_rep 00505 DO i = 1,SIZE(admm_env%blocks(irep)%list) 00506 iatom = admm_env%blocks(irep)%list(i) 00507 DO j = 1,SIZE(admm_env%blocks(irep)%list) 00508 jatom = admm_env%blocks(irep)%list(j) 00509 admm_env%block_map(iatom,jatom) = 1 00510 END DO 00511 END DO 00512 END DO 00513 00514 DO irep = 1, n_rep 00515 DEALLOCATE(admm_env%blocks(irep)%list, STAT=stat) 00516 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00517 END DO 00518 DEALLOCATE(admm_env%blocks, STAT=stat) 00519 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00520 00521 00522 END SUBROUTINE admm_create_block_list 00523 00524 END MODULE admm_types 00525
1.7.3