1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2020 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5 6! ************************************************************************************************** 7!> \brief Types for mixed CDFT calculations 8!> \par History 9!> Separated CDFT routines from mixed_environment_types 10!> \author Nico Holmberg [01.2017] 11! ************************************************************************************************** 12MODULE mixed_cdft_types 13 USE cp_array_utils, ONLY: cp_1d_r_p_type 14 USE cp_blacs_env, ONLY: cp_blacs_env_release,& 15 cp_blacs_env_type 16 USE cp_fm_types, ONLY: cp_fm_p_type,& 17 cp_fm_release 18 USE cp_log_handling, ONLY: cp_logger_p_type,& 19 cp_logger_release 20 USE dbcsr_api, ONLY: dbcsr_p_type,& 21 dbcsr_release_p,& 22 dbcsr_type 23 USE kinds, ONLY: dp 24 USE pw_env_types, ONLY: pw_env_release,& 25 pw_env_type 26 USE qs_cdft_types, ONLY: cdft_control_release,& 27 cdft_control_type 28 USE qs_kind_types, ONLY: deallocate_qs_kind_set,& 29 qs_kind_type 30#include "./base/base_uses.f90" 31 32 IMPLICIT NONE 33 PRIVATE 34 35! ************************************************************************************************** 36!> \brief Container for results related to a mixed CDFT calculation 37! ************************************************************************************************** 38 TYPE mixed_cdft_result_type 39 ! CDFT electronic couplings calculated with different methods 40 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: lowdin, nonortho, & 41 rotation, wfn 42 ! Energies of the CDFT states 43 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: energy 44 ! Lagrangian multipliers of the CDFT constraints 45 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: strength 46 ! Reliability metric for CDFT electronic couplings 47 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: metric 48 ! The mixed CDFT Hamiltonian matrix 49 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: H 50 ! Overlaps between CDFT states 51 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: S 52 ! S^(-1/2) 53 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: S_minushalf 54 ! Off-diagonal elements of the weight function matrices <Psi_j | w_i(r) | Psi_i> 55 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: Wad, Wda 56 ! Diagonal elements of the weight function matrices, i.e., the constraint values 57 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: W_diagonal 58 END TYPE mixed_cdft_result_type 59 60! ************************************************************************************************** 61!> \brief Container for mixed CDFT matrices 62! ************************************************************************************************** 63 TYPE mixed_cdft_work_type 64 ! Matrix representations of the CDFT weight functions 65 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: w_matrix 66 ! AO overlap matrix 67 TYPE(dbcsr_type), POINTER :: mixed_matrix_s 68 ! MO coefficients of each CDFT state 69 TYPE(cp_fm_p_type), DIMENSION(:, :), POINTER :: mixed_mo_coeff 70 ! Density matrices of the CDFT states 71 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: density_matrix 72 END TYPE mixed_cdft_work_type 73 74! ************************************************************************************************** 75!> \brief Buffers for load balancing 76!> \param rank indices of the processors the data in this buffer should be sent to 77!> \param tag mpi tags for the messages to send 78!> \param cavity the cavity to send 79!> \param weight the weight to send 80!> \param gradients the gradients to send 81! ************************************************************************************************** 82 TYPE buffers 83 INTEGER :: rank(2), tag(2) 84 REAL(KIND=dp), POINTER, & 85 DIMENSION(:, :, :) :: cavity, weight 86 REAL(KIND=dp), POINTER, & 87 DIMENSION(:, :, :, :) :: gradients 88 END TYPE buffers 89! ************************************************************************************************** 90!> \brief To build array of buffers 91!> \param buffs the pointer to the buffers type 92! ************************************************************************************************** 93 TYPE p_buffers 94 TYPE(buffers), DIMENSION(:), POINTER :: buffs 95 END TYPE p_buffers 96! ************************************************************************************************** 97!> \brief Information about load balancing 98!> \param matrix_info size of the target_list array to receive and grid point bounds of the data 99!> \param target_list the target_list array of the processor that sends me data 100! ************************************************************************************************** 101 TYPE repl_info 102 INTEGER, DIMENSION(:), POINTER :: matrix_info 103 INTEGER, DIMENSION(:, :), POINTER :: target_list 104 END TYPE repl_info 105! ************************************************************************************************** 106!> \brief Load balancing control for mixed CDFT calculation 107!> \param my_source index of the processor which will send this processor data 108!> \param distributed bounds that determine which grid points this processor will compute after 109!> applying load balancing (is_special = .FALSE.) 110!> \param my_dest_repl the dest_list arrays of all processors which send additional work to this 111!> processor (indices of the processors where the redistributed slices should be 112!> returned) 113!> \param dest_tags_repl tags for the send messages (is_special = .FALSE.) 114!> \param more_work allow heavily overloaded processors to redistribute more_work slices 115!> \param bo bounds of the data that this processor will send to other processors which tells the 116!> receivers how to rearrange the data correctly 117!> \param expected_work a list of the estimated work per processor 118!> \param prediction_error the difference between the estimated and actual work per processor 119!> \param target_list a list of processors to send data and the size of data to send 120!> \param recv_work flag that determines if this processor will receive data from others 121!> \param send_work flag that determines if this processor will send data to others 122!> \param recv_work_repl list of processor indices where this processor will send data during load 123!> balancing 124!> \param load_scale allow underloaded processors to accept load_scale additional work 125!> \param very_overloaded value to determine which processors are heavily overloaded 126!> \param cavity the cavity that this processor builds in addition to its own cavity defined 127!> on the grid points which were redistributed to this processor 128!> \param weight the weight that this processor builds in addition to its own weight 129!> \param gradients the gradients that this processor builds in addition to its own gradients 130!> \param sendbuffer buffer to hold the data this processor will send 131!> \param sendbuffer buffer to hold the data this processor will receive 132!> \param recv_info additional information on the data this processor will receive 133! ************************************************************************************************** 134 TYPE mixed_cdft_dlb_type 135 INTEGER :: my_source, distributed(2), & 136 my_dest_repl(2), dest_tags_repl(2), & 137 more_work 138 INTEGER, DIMENSION(:), POINTER :: bo, expected_work, & 139 prediction_error 140 INTEGER, DIMENSION(:, :), POINTER :: target_list 141 LOGICAL :: recv_work, send_work 142 LOGICAL, DIMENSION(:), POINTER :: recv_work_repl 143 REAL(KIND=dp) :: load_scale, very_overloaded 144 REAL(KIND=dp), POINTER, & 145 DIMENSION(:, :, :) :: cavity, weight 146 REAL(KIND=dp), POINTER, & 147 DIMENSION(:, :, :, :) :: gradients 148 ! Should convert to TYPE(p_buffers), POINTER 149 TYPE(buffers), DIMENSION(:), POINTER :: sendbuff 150 TYPE(p_buffers), DIMENSION(:), POINTER :: recvbuff 151 TYPE(repl_info), DIMENSION(:), POINTER :: recv_info 152 END TYPE mixed_cdft_dlb_type 153! ************************************************************************************************** 154!> \brief Main mixed CDFT control type 155!> \param sim_step counter to keep track of the simulation step for MD 156!> \param multiplicity spin multiplicity 157!> \param nconstraint the number of constraints 158!> \param run_type what type of mixed CDFT simulation to perform 159!> \param source_list a list of processors which will send this processor data 160!> \param dest_list a list of processors which this processor will send data to 161!> \param recv_bo bounds of the data which this processor will receive (is_special = .FALSE.) 162!> \param source_list_save permanent copy of source_list which might get reallocated during 163!> load balancing 164!> \param dest_list_save permanent copy of dest_list which might get reallocated during 165!> load balancing 166!> \param source_list_bo bounds of the data which this processor will receive (is_special = .TRUE.) 167!> \param dest_list_bo bounds of the data this processor will send (is_special = .TRUE.) 168!> \param source_bo_save permanent copy of source_list_bo 169!> \param deset_bo_save permanent copy of dest_list_bo 170!> \param is_pencil flag controlling which scheme to use for constraint replication 171!> \param dlb flag to enable dynamic load balancing 172!> \param is_special another flag controlling which scheme to use for constraint replication 173!> \param first_iteration flag to mark the first iteration e.g. during MD to output information 174!> \param calculate_metric flag which determines if the coupling reliability metric should be computed 175!> \param wnf_ovelap_method flag to enable the wavefunction overlap method for computing the coupling 176!> \param has_unit_metric flag to determine if the basis set has unit metric 177!> \param use_lowdin flag which determines if Lowdin orthogonalization is used to compute the coupling 178!> \param do_ci flag which determines if a CDFT-CI calculation was requested 179!> \param nonortho_coupling flag which determines if the nonorthogonal CDFT interaction energies 180!> should be printed out 181!> \param identical_constraints flag which determines if the constraint definitions are identical 182!> across all CDFT states 183!> \param block_diagonalize flag which determines if the CDFT Hamiltonian should be block 184!> diagonalized 185!> \param constraint_type list of integers which determine what type of constraint should be applied 186!> to each constraint group 187!> \param eps_rho_rspace threshold to determine when the realspace density can be considered zero 188!> \param sim_dt timestep of the MD simulation 189!> \param eps_svd value that controls which matrix inversion method to use 190!> \param weight the constraint weight function 191!> \param cavity the confinement cavity: the weight function is nonzero only within the cavity 192!> \param cdft_control container for cdft_control_type 193!> \param sendbuff buffer that holds the data to be replicated 194!> \param blacs_env the blacs_env needed to redistribute arrays during a coupling calculation 195!> \param results container for mixed CDFT results 196!> \param matrix container for mixed CDFT work matrices 197!> \param dlb_control container for load balancing structures 198!> \param qs_kind_set the qs_kind_set needed to setup a confinement cavity 199!> \param pw_env the pw_env that holds the fully distributed realspace grid 200!> \param occupations occupation numbers in case non-uniform occupation 201! ************************************************************************************************** 202 TYPE mixed_cdft_type 203 INTEGER :: sim_step, multiplicity, & 204 nconstraint, & 205 run_type 206 INTEGER, DIMENSION(:, :), ALLOCATABLE :: constraint_type 207 INTEGER, POINTER, DIMENSION(:) :: source_list, dest_list, & 208 recv_bo, source_list_save, & 209 dest_list_save 210 INTEGER, POINTER, DIMENSION(:, :) :: source_list_bo, dest_list_bo, & 211 source_bo_save, dest_bo_save 212 LOGICAL :: is_pencil, dlb, & 213 is_special, first_iteration, & 214 calculate_metric, & 215 wfn_overlap_method, & 216 has_unit_metric, & 217 use_lowdin, & 218 do_ci, nonortho_coupling, & 219 identical_constraints, & 220 block_diagonalize 221 REAL(KIND=dp) :: eps_rho_rspace, sim_dt, & 222 eps_svd 223 REAL(KIND=dp), POINTER, DIMENSION(:, :, :) :: weight, cavity 224 TYPE(cdft_control_type), POINTER :: cdft_control 225 TYPE(buffers), DIMENSION(:), POINTER :: sendbuff 226 TYPE(cp_1d_r_p_type), ALLOCATABLE, & 227 DIMENSION(:, :) :: occupations 228 TYPE(cp_blacs_env_type), POINTER :: blacs_env 229 TYPE(cp_logger_p_type), DIMENSION(:), POINTER :: sub_logger 230 TYPE(mixed_cdft_result_type) :: results 231 TYPE(mixed_cdft_work_type) :: matrix 232 TYPE(mixed_cdft_dlb_type), POINTER :: dlb_control 233 TYPE(pw_env_type), POINTER :: pw_env 234 TYPE(qs_kind_type), DIMENSION(:), & 235 POINTER :: qs_kind_set 236 END TYPE mixed_cdft_type 237 238! ************************************************************************************************** 239!> \brief Container for constraint settings to check consistency of force_evals 240! ************************************************************************************************** 241 TYPE mixed_cdft_settings_type 242 LOGICAL :: is_spherical, & 243 is_odd 244 LOGICAL, DIMENSION(:, :), POINTER :: sb 245 INTEGER :: ncdft, & 246 max_nkinds 247 INTEGER, DIMENSION(2, 3) :: bo 248 INTEGER, DIMENSION(:), POINTER :: grid_span, & 249 spherical, & 250 odd 251 INTEGER, DIMENSION(:, :), POINTER :: si, & 252 rs_dims, & 253 atoms, & 254 npts 255 REAL(KIND=dp) :: radius 256 REAL(KIND=dp), DIMENSION(:), POINTER :: cutoff, & 257 rel_cutoff 258 REAL(KIND=dp), DIMENSION(:, :), POINTER :: sr, & 259 coeffs, & 260 cutoffs, & 261 radii 262 END TYPE mixed_cdft_settings_type 263 264! *** Public data types *** 265 266 PUBLIC :: mixed_cdft_type, & 267 mixed_cdft_settings_type 268 269! *** Public subroutines *** 270 271 PUBLIC :: mixed_cdft_type_create, & 272 mixed_cdft_type_release, & 273 mixed_cdft_result_type_set, & 274 mixed_cdft_result_type_release, & 275 mixed_cdft_work_type_init, & 276 mixed_cdft_work_type_release 277 278 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'mixed_cdft_types' 279 280CONTAINS 281 282! ************************************************************************************************** 283!> \brief inits the given mixed_cdft_type 284!> \param cdft_control the object to init 285!> \author Nico Holmberg [01.2017] 286! ************************************************************************************************** 287 SUBROUTINE mixed_cdft_type_create(cdft_control) 288 TYPE(mixed_cdft_type), POINTER :: cdft_control 289 290 CHARACTER(len=*), PARAMETER :: routineN = 'mixed_cdft_type_create', & 291 routineP = moduleN//':'//routineN 292 293 NULLIFY (cdft_control%pw_env, cdft_control%blacs_env, cdft_control%qs_kind_set) 294 NULLIFY (cdft_control%dlb_control, cdft_control%dest_list_bo, cdft_control%dest_list) 295 NULLIFY (cdft_control%dest_bo_save, cdft_control%dest_list_save, cdft_control%source_list) 296 NULLIFY (cdft_control%source_list_save, cdft_control%source_bo_save, cdft_control%source_list_bo) 297 NULLIFY (cdft_control%cavity, cdft_control%weight, cdft_control%sendbuff) 298 NULLIFY (cdft_control%cdft_control, cdft_control%recv_bo) 299 NULLIFY (cdft_control%sub_logger) 300 301 END SUBROUTINE mixed_cdft_type_create 302 303! ************************************************************************************************** 304!> \brief releases the given mixed_cdft_type 305!> \param cdft_control the object to release 306!> \author Nico Holmberg [01.2017] 307! ************************************************************************************************** 308 SUBROUTINE mixed_cdft_type_release(cdft_control) 309 TYPE(mixed_cdft_type), POINTER :: cdft_control 310 311 CHARACTER(len=*), PARAMETER :: routineN = 'mixed_cdft_type_release', & 312 routineP = moduleN//':'//routineN 313 314 INTEGER :: i, j 315 316 CALL pw_env_release(cdft_control%pw_env) 317 IF (ASSOCIATED(cdft_control%dest_list)) & 318 DEALLOCATE (cdft_control%dest_list) 319 IF (ASSOCIATED(cdft_control%dest_list_save)) & 320 DEALLOCATE (cdft_control%dest_list_save) 321 IF (ASSOCIATED(cdft_control%dest_list_bo)) & 322 DEALLOCATE (cdft_control%dest_list_bo) 323 IF (ASSOCIATED(cdft_control%dest_bo_save)) & 324 DEALLOCATE (cdft_control%dest_bo_save) 325 IF (ASSOCIATED(cdft_control%source_list)) & 326 DEALLOCATE (cdft_control%source_list) 327 IF (ASSOCIATED(cdft_control%source_list_save)) & 328 DEALLOCATE (cdft_control%source_list_save) 329 IF (ASSOCIATED(cdft_control%source_list_bo)) & 330 DEALLOCATE (cdft_control%source_list_bo) 331 IF (ASSOCIATED(cdft_control%source_bo_save)) & 332 DEALLOCATE (cdft_control%source_bo_save) 333 IF (ASSOCIATED(cdft_control%recv_bo)) & 334 DEALLOCATE (cdft_control%recv_bo) 335 IF (ASSOCIATED(cdft_control%weight)) & 336 DEALLOCATE (cdft_control%weight) 337 IF (ASSOCIATED(cdft_control%cavity)) & 338 DEALLOCATE (cdft_control%cavity) 339 IF (ALLOCATED(cdft_control%constraint_type)) & 340 DEALLOCATE (cdft_control%constraint_type) 341 IF (ALLOCATED(cdft_control%occupations)) THEN 342 DO i = 1, SIZE(cdft_control%occupations, 1) 343 DO j = 1, SIZE(cdft_control%occupations, 2) 344 IF (ASSOCIATED(cdft_control%occupations(i, j)%array)) & 345 DEALLOCATE (cdft_control%occupations(i, j)%array) 346 END DO 347 END DO 348 DEALLOCATE (cdft_control%occupations) 349 END IF 350 IF (ASSOCIATED(cdft_control%dlb_control)) & 351 CALL mixed_cdft_dlb_release(cdft_control%dlb_control) 352 IF (ASSOCIATED(cdft_control%sendbuff)) THEN 353 DO i = 1, SIZE(cdft_control%sendbuff) 354 CALL mixed_cdft_buffers_release(cdft_control%sendbuff(i)) 355 END DO 356 DEALLOCATE (cdft_control%sendbuff) 357 END IF 358 IF (ASSOCIATED(cdft_control%cdft_control)) & 359 CALL cdft_control_release(cdft_control%cdft_control) 360 IF (ASSOCIATED(cdft_control%blacs_env)) & 361 CALL cp_blacs_env_release(cdft_control%blacs_env) 362 IF (ASSOCIATED(cdft_control%qs_kind_set)) & 363 CALL deallocate_qs_kind_set(cdft_control%qs_kind_set) 364 IF (ASSOCIATED(cdft_control%sub_logger)) THEN 365 DO i = 1, SIZE(cdft_control%sub_logger) 366 CALL cp_logger_release(cdft_control%sub_logger(i)%p) 367 END DO 368 DEALLOCATE (cdft_control%sub_logger) 369 END IF 370 CALL mixed_cdft_result_type_release(cdft_control%results) 371 CALL mixed_cdft_work_type_release(cdft_control%matrix) 372 DEALLOCATE (cdft_control) 373 374 END SUBROUTINE mixed_cdft_type_release 375 376! ************************************************************************************************** 377!> \brief releases the given load balancing control 378!> \param dlb_control the object to release 379!> \author Nico Holmberg [01.2017] 380! ************************************************************************************************** 381 SUBROUTINE mixed_cdft_dlb_release(dlb_control) 382 TYPE(mixed_cdft_dlb_type), POINTER :: dlb_control 383 384 CHARACTER(len=*), PARAMETER :: routineN = 'mixed_cdft_dlb_release', & 385 routineP = moduleN//':'//routineN 386 387 INTEGER :: i 388 389 IF (ASSOCIATED(dlb_control%recv_work_repl)) & 390 DEALLOCATE (dlb_control%recv_work_repl) 391 IF (ASSOCIATED(dlb_control%sendbuff)) THEN 392 DO i = 1, SIZE(dlb_control%sendbuff) 393 CALL mixed_cdft_buffers_release(dlb_control%sendbuff(i)) 394 END DO 395 DEALLOCATE (dlb_control%sendbuff) 396 END IF 397 IF (ASSOCIATED(dlb_control%recvbuff)) THEN 398 DO i = 1, SIZE(dlb_control%recvbuff) 399 CALL mixed_cdft_p_buffers_release(dlb_control%recvbuff(i)) 400 END DO 401 DEALLOCATE (dlb_control%recvbuff) 402 END IF 403 IF (ASSOCIATED(dlb_control%recv_info)) THEN 404 DO i = 1, SIZE(dlb_control%recv_info) 405 IF (ASSOCIATED(dlb_control%recv_info(i)%matrix_info)) & 406 DEALLOCATE (dlb_control%recv_info(i)%matrix_info) 407 IF (ASSOCIATED(dlb_control%recv_info(i)%target_list)) & 408 DEALLOCATE (dlb_control%recv_info(i)%target_list) 409 END DO 410 DEALLOCATE (dlb_control%recv_info) 411 END IF 412 IF (ASSOCIATED(dlb_control%bo)) & 413 DEALLOCATE (dlb_control%bo) 414 IF (ASSOCIATED(dlb_control%expected_work)) & 415 DEALLOCATE (dlb_control%expected_work) 416 IF (ASSOCIATED(dlb_control%prediction_error)) & 417 DEALLOCATE (dlb_control%prediction_error) 418 IF (ASSOCIATED(dlb_control%target_list)) & 419 DEALLOCATE (dlb_control%target_list) 420 IF (ASSOCIATED(dlb_control%cavity)) & 421 DEALLOCATE (dlb_control%cavity) 422 IF (ASSOCIATED(dlb_control%weight)) & 423 DEALLOCATE (dlb_control%weight) 424 IF (ASSOCIATED(dlb_control%gradients)) & 425 DEALLOCATE (dlb_control%gradients) 426 DEALLOCATE (dlb_control) 427 428 END SUBROUTINE mixed_cdft_dlb_release 429 430! ************************************************************************************************** 431!> \brief releases the given buffers 432!> \param buffer the object to release 433!> \author Nico Holmberg [01.2017] 434! ************************************************************************************************** 435 SUBROUTINE mixed_cdft_buffers_release(buffer) 436 TYPE(buffers) :: buffer 437 438 CHARACTER(len=*), PARAMETER :: routineN = 'mixed_cdft_buffers_release', & 439 routineP = moduleN//':'//routineN 440 441 IF (ASSOCIATED(buffer%cavity)) & 442 DEALLOCATE (buffer%cavity) 443 IF (ASSOCIATED(buffer%weight)) & 444 DEALLOCATE (buffer%weight) 445 IF (ASSOCIATED(buffer%gradients)) & 446 DEALLOCATE (buffer%gradients) 447 448 END SUBROUTINE mixed_cdft_buffers_release 449 450! ************************************************************************************************** 451!> \brief releases the given pointer of buffers 452!> \param p_buffer the object to release 453!> \author Nico Holmberg [01.2017] 454! ************************************************************************************************** 455 SUBROUTINE mixed_cdft_p_buffers_release(p_buffer) 456 TYPE(p_buffers) :: p_buffer 457 458 CHARACTER(len=*), PARAMETER :: routineN = 'mixed_cdft_p_buffers_release', & 459 routineP = moduleN//':'//routineN 460 461 INTEGER :: i 462 463 IF (ASSOCIATED(p_buffer%buffs)) THEN 464 DO i = 1, SIZE(p_buffer%buffs) 465 CALL mixed_cdft_buffers_release(p_buffer%buffs(i)) 466 END DO 467 DEALLOCATE (p_buffer%buffs) 468 END IF 469 470 END SUBROUTINE mixed_cdft_p_buffers_release 471 472! ************************************************************************************************** 473!> \brief Updates arrays within the mixed CDFT result container 474!> \param results the array container 475!> \param lowdin CDFT electronic couplings from Lowdin orthogonalization 476!> \param wfn CDFT electronic couplings from wavefunction overlap method 477!> \param nonortho CDFT electronic couplings (interaction energies) before orthogonalization 478!> \param metric Reliability metric for CDFT electronic couplings 479!> \param rotation CDFT electronic couplings using the weight function matrix for orthogonalization 480!> \param H The mixed CDFT Hamiltonian 481!> \param S The overlap matrix between CDFT states 482!> \param Wad Integrals of type <Psi_a | w_d(r) | Psi_d> 483!> \param Wda Integrals of type <Psi_d | w_a(r) | Psi_a> 484!> \param W_diagonal Values of the CDFT constraints 485!> \param energy Energies of the CDFT states 486!> \param strength Lagrangian multipliers of the CDFT states 487!> \param S_minushalf S^(-1/2) 488!> \author Nico Holmberg [11.2017] 489! ************************************************************************************************** 490 SUBROUTINE mixed_cdft_result_type_set(results, lowdin, wfn, nonortho, metric, rotation, & 491 H, S, Wad, Wda, W_diagonal, energy, strength, S_minushalf) 492 TYPE(mixed_cdft_result_type) :: results 493 REAL(KIND=dp), DIMENSION(:), OPTIONAL :: lowdin, wfn, nonortho 494 REAL(KIND=dp), DIMENSION(:, :), OPTIONAL :: metric 495 REAL(KIND=dp), DIMENSION(:), OPTIONAL :: rotation 496 REAL(KIND=dp), DIMENSION(:, :), OPTIONAL :: H, S, Wad, Wda, W_diagonal 497 REAL(KIND=dp), DIMENSION(:), OPTIONAL :: energy 498 REAL(KIND=dp), DIMENSION(:, :), OPTIONAL :: strength, S_minushalf 499 500 CHARACTER(len=*), PARAMETER :: routineN = 'mixed_cdft_result_type_set', & 501 routineP = moduleN//':'//routineN 502 503 IF (PRESENT(lowdin)) THEN 504 IF (ALLOCATED(results%lowdin)) DEALLOCATE (results%lowdin) 505 ALLOCATE (results%lowdin(SIZE(lowdin))) 506 results%lowdin(:) = lowdin(:) 507 END IF 508 IF (PRESENT(wfn)) THEN 509 IF (ALLOCATED(results%wfn)) DEALLOCATE (results%wfn) 510 ALLOCATE (results%wfn(SIZE(wfn))) 511 results%wfn(:) = wfn(:) 512 END IF 513 IF (PRESENT(nonortho)) THEN 514 IF (ALLOCATED(results%nonortho)) DEALLOCATE (results%nonortho) 515 ALLOCATE (results%nonortho(SIZE(nonortho))) 516 results%nonortho(:) = nonortho(:) 517 END IF 518 IF (PRESENT(rotation)) THEN 519 IF (ALLOCATED(results%rotation)) DEALLOCATE (results%rotation) 520 ALLOCATE (results%rotation(SIZE(rotation))) 521 results%rotation(:) = rotation(:) 522 END IF 523 IF (PRESENT(energy)) THEN 524 IF (ALLOCATED(results%energy)) DEALLOCATE (results%energy) 525 ALLOCATE (results%energy(SIZE(energy))) 526 results%energy(:) = energy(:) 527 END IF 528 IF (PRESENT(strength)) THEN 529 IF (ALLOCATED(results%strength)) DEALLOCATE (results%strength) 530 ALLOCATE (results%strength(SIZE(strength, 1), SIZE(strength, 2))) 531 results%strength(:, :) = strength(:, :) 532 END IF 533 IF (PRESENT(metric)) THEN 534 IF (ALLOCATED(results%metric)) DEALLOCATE (results%metric) 535 ALLOCATE (results%metric(SIZE(metric, 1), SIZE(metric, 2))) 536 results%metric(:, :) = metric(:, :) 537 END IF 538 IF (PRESENT(H)) THEN 539 IF (ALLOCATED(results%H)) DEALLOCATE (results%H) 540 ALLOCATE (results%H(SIZE(H, 1), SIZE(H, 2))) 541 results%H(:, :) = H(:, :) 542 END IF 543 IF (PRESENT(S)) THEN 544 IF (ALLOCATED(results%S)) DEALLOCATE (results%S) 545 ALLOCATE (results%S(SIZE(S, 1), SIZE(S, 2))) 546 results%S(:, :) = S(:, :) 547 END IF 548 IF (PRESENT(S_minushalf)) THEN 549 IF (ALLOCATED(results%S_minushalf)) DEALLOCATE (results%S_minushalf) 550 ALLOCATE (results%S_minushalf(SIZE(S_minushalf, 1), SIZE(S_minushalf, 2))) 551 results%S_minushalf(:, :) = S_minushalf(:, :) 552 END IF 553 IF (PRESENT(Wad)) THEN 554 IF (ALLOCATED(results%Wad)) DEALLOCATE (results%Wad) 555 ALLOCATE (results%Wad(SIZE(Wad, 1), SIZE(Wad, 2))) 556 results%Wad(:, :) = Wad(:, :) 557 END IF 558 IF (PRESENT(Wda)) THEN 559 IF (ALLOCATED(results%Wda)) DEALLOCATE (results%Wda) 560 ALLOCATE (results%Wda(SIZE(Wda, 1), SIZE(Wda, 2))) 561 results%Wda(:, :) = Wda(:, :) 562 END IF 563 IF (PRESENT(W_diagonal)) THEN 564 IF (ALLOCATED(results%W_diagonal)) DEALLOCATE (results%W_diagonal) 565 ALLOCATE (results%W_diagonal(SIZE(W_diagonal, 1), SIZE(W_diagonal, 2))) 566 results%W_diagonal(:, :) = W_diagonal(:, :) 567 END IF 568 569 END SUBROUTINE mixed_cdft_result_type_set 570 571! ************************************************************************************************** 572!> \brief Releases all arrays within the mixed CDFT result container 573!> \param results the container 574!> \author Nico Holmberg [11.2017] 575! ************************************************************************************************** 576 SUBROUTINE mixed_cdft_result_type_release(results) 577 TYPE(mixed_cdft_result_type) :: results 578 579 CHARACTER(len=*), PARAMETER :: routineN = 'mixed_cdft_result_type_release', & 580 routineP = moduleN//':'//routineN 581 582 IF (ALLOCATED(results%lowdin)) DEALLOCATE (results%lowdin) 583 IF (ALLOCATED(results%wfn)) DEALLOCATE (results%wfn) 584 IF (ALLOCATED(results%metric)) DEALLOCATE (results%metric) 585 IF (ALLOCATED(results%nonortho)) DEALLOCATE (results%nonortho) 586 IF (ALLOCATED(results%rotation)) DEALLOCATE (results%rotation) 587 IF (ALLOCATED(results%H)) DEALLOCATE (results%H) 588 IF (ALLOCATED(results%S)) DEALLOCATE (results%S) 589 IF (ALLOCATED(results%S_minushalf)) DEALLOCATE (results%S_minushalf) 590 IF (ALLOCATED(results%Wad)) DEALLOCATE (results%Wad) 591 IF (ALLOCATED(results%Wda)) DEALLOCATE (results%Wda) 592 IF (ALLOCATED(results%W_diagonal)) DEALLOCATE (results%W_diagonal) 593 IF (ALLOCATED(results%energy)) DEALLOCATE (results%energy) 594 IF (ALLOCATED(results%strength)) DEALLOCATE (results%strength) 595 596 END SUBROUTINE mixed_cdft_result_type_release 597 598! ************************************************************************************************** 599!> \brief Initializes the mixed_cdft_work_type 600!> \param matrix the type to initialize 601!> \author Nico Holmberg [01.2017] 602! ************************************************************************************************** 603 SUBROUTINE mixed_cdft_work_type_init(matrix) 604 TYPE(mixed_cdft_work_type) :: matrix 605 606 CHARACTER(len=*), PARAMETER :: routineN = 'mixed_cdft_work_type_init', & 607 routineP = moduleN//':'//routineN 608 609 NULLIFY (matrix%w_matrix) 610 NULLIFY (matrix%mixed_matrix_s) 611 NULLIFY (matrix%mixed_mo_coeff) 612 NULLIFY (matrix%density_matrix) 613 614 END SUBROUTINE mixed_cdft_work_type_init 615 616! ************************************************************************************************** 617!> \brief Releases arrays within the mixed CDFT work matrix container 618!> \param matrix the container 619!> \author Nico Holmberg [01.2017] 620! ************************************************************************************************** 621 SUBROUTINE mixed_cdft_work_type_release(matrix) 622 TYPE(mixed_cdft_work_type) :: matrix 623 624 CHARACTER(len=*), PARAMETER :: routineN = 'mixed_cdft_work_type_release', & 625 routineP = moduleN//':'//routineN 626 627 INTEGER :: i, j 628 629 IF (ASSOCIATED(matrix%w_matrix)) THEN 630 DO i = 1, SIZE(matrix%w_matrix, 2) 631 DO j = 1, SIZE(matrix%w_matrix, 1) 632 CALL dbcsr_release_p(matrix%w_matrix(j, i)%matrix) 633 END DO 634 END DO 635 DEALLOCATE (matrix%w_matrix) 636 END IF 637 IF (ASSOCIATED(matrix%mixed_matrix_s)) THEN 638 CALL dbcsr_release_p(matrix%mixed_matrix_s) 639 END IF 640 IF (ASSOCIATED(matrix%mixed_mo_coeff)) THEN 641 DO i = 1, SIZE(matrix%mixed_mo_coeff, 2) 642 DO j = 1, SIZE(matrix%mixed_mo_coeff, 1) 643 CALL cp_fm_release(matrix%mixed_mo_coeff(j, i)%matrix) 644 END DO 645 END DO 646 DEALLOCATE (matrix%mixed_mo_coeff) 647 END IF 648 IF (ASSOCIATED(matrix%density_matrix)) THEN 649 DO i = 1, SIZE(matrix%density_matrix, 2) 650 DO j = 1, SIZE(matrix%density_matrix, 1) 651 CALL dbcsr_release_p(matrix%density_matrix(j, i)%matrix) 652 END DO 653 END DO 654 DEALLOCATE (matrix%density_matrix) 655 END IF 656 657 END SUBROUTINE mixed_cdft_work_type_release 658 659END MODULE mixed_cdft_types 660