1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2020 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5MODULE optbas_opt_utils 6 USE admm_types, ONLY: admm_type 7 USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm 8 USE cp_fm_basic_linalg, ONLY: cp_fm_trace,& 9 cp_fm_upper_to_full 10 USE cp_fm_diag, ONLY: cp_fm_syevd 11 USE cp_fm_types, ONLY: cp_fm_create,& 12 cp_fm_get_info,& 13 cp_fm_release,& 14 cp_fm_type 15 USE cp_gemm_interface, ONLY: cp_gemm 16 USE dbcsr_api, ONLY: dbcsr_p_type,& 17 dbcsr_type 18 USE kinds, ONLY: dp 19 USE qs_mo_types, ONLY: get_mo_set,& 20 mo_set_p_type 21#include "./base/base_uses.f90" 22 23 IMPLICIT NONE 24 PRIVATE 25 26 PUBLIC :: evaluate_fval, evaluate_energy 27 28 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'optbas_opt_utils' 29 30CONTAINS 31 32! ************************************************************************************************** 33!> \brief ... 34!> \param mos ... 35!> \param matrix_ks ... 36!> \param S_inv_orb ... 37!> \param Q ... 38!> \param tmp1 ... 39!> \param energy ... 40! ************************************************************************************************** 41 SUBROUTINE evaluate_energy(mos, matrix_ks, S_inv_orb, Q, tmp1, energy) 42 TYPE(mo_set_p_type), DIMENSION(:), POINTER :: mos 43 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks 44 TYPE(cp_fm_type), POINTER :: S_inv_orb, Q, tmp1 45 REAL(KIND=dp) :: energy 46 47 CHARACTER(LEN=*), PARAMETER :: routineN = 'evaluate_energy', & 48 routineP = moduleN//':'//routineN 49 50 INTEGER :: ispin, naux, nmo, norb 51 REAL(KIND=dp) :: tmp_energy 52 TYPE(cp_fm_type), POINTER :: mo_coeff, QS_inv, tmp, tmp2, work, & 53 work_orb 54 55 CALL cp_fm_create(QS_inv, matrix_struct=Q%matrix_struct) 56 CALL cp_fm_create(tmp, matrix_struct=Q%matrix_struct) 57 CALL cp_fm_create(tmp2, matrix_struct=tmp1%matrix_struct) 58 CALL cp_fm_create(work, matrix_struct=S_inv_orb%matrix_struct) 59 CALL cp_fm_create(work_orb, matrix_struct=S_inv_orb%matrix_struct) 60 CALL cp_fm_get_info(Q, nrow_global=naux, ncol_global=norb) 61 CALL cp_gemm('N', 'N', naux, norb, norb, 1.0_dp, Q, S_inv_orb, 0.0_dp, QS_inv) 62 energy = 0.0_dp 63 DO ispin = 1, SIZE(matrix_ks) 64 CALL copy_dbcsr_to_fm(matrix_ks(ispin)%matrix, work) 65 CALL cp_fm_upper_to_full(work, work_orb) 66 67 CALL get_mo_set(mos(ispin)%mo_set, nmo=nmo, mo_coeff=mo_coeff) 68 CALL cp_gemm('N', 'N', naux, norb, norb, 1.0_dp, QS_inv, work, 0.0_dp, tmp) 69 CALL cp_gemm('N', 'T', naux, naux, norb, 1.0_dp, tmp, QS_inv, 0.0_dp, tmp1) 70 CALL cp_gemm('N', 'T', naux, naux, nmo, 1.0_dp, mo_coeff, mo_coeff, 0.0_dp, tmp2) 71 CALL cp_fm_trace(tmp1, tmp2, tmp_energy) 72 energy = energy + tmp_energy*(3.0_dp - REAL(SIZE(matrix_ks), dp)) 73 74 END DO 75 76 CALL cp_fm_release(work_orb) 77 CALL cp_fm_release(QS_inv) 78 CALL cp_fm_release(tmp) 79 CALL cp_fm_release(tmp2) 80 CALL cp_fm_release(work) 81 CALL cp_fm_release(work_orb) 82 83 END SUBROUTINE evaluate_energy 84 85! ************************************************************************************************** 86!> \brief ... 87!> \param mos ... 88!> \param mos_aux_fit ... 89!> \param Q ... 90!> \param Snew ... 91!> \param admm_env ... 92!> \param fval ... 93!> \param S_cond_number ... 94! ************************************************************************************************** 95 SUBROUTINE evaluate_fval(mos, mos_aux_fit, Q, Snew, admm_env, fval, S_cond_number) 96 TYPE(mo_set_p_type), DIMENSION(:), POINTER :: mos, mos_aux_fit 97 TYPE(dbcsr_type), POINTER :: Q, Snew 98 TYPE(admm_type), POINTER :: admm_env 99 REAL(KIND=dp) :: fval, S_cond_number 100 101 CHARACTER(LEN=*), PARAMETER :: routineN = 'evaluate_fval', routineP = moduleN//':'//routineN 102 103 INTEGER :: ispin, nao_aux_fit, nao_orb, nmo, nspins 104 REAL(KIND=dp) :: trace 105 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: eigenvalues 106 TYPE(cp_fm_type), POINTER :: mo_coeff, mo_coeff_aux_fit 107 108 nao_aux_fit = admm_env%nao_aux_fit 109 nao_orb = admm_env%nao_orb 110 nspins = SIZE(mos) 111 112 CALL copy_dbcsr_to_fm(Q, admm_env%Q) 113 fval = 0.0_dp 114 DO ispin = 1, nspins 115 nmo = admm_env%nmo(ispin) 116 CALL get_mo_set(mos(ispin)%mo_set, mo_coeff=mo_coeff) 117 CALL get_mo_set(mos_aux_fit(ispin)%mo_set, mo_coeff=mo_coeff_aux_fit) 118 119 CALL cp_gemm('N', 'N', nao_aux_fit, nmo, nao_orb, -2.0_dp, admm_env%Q, mo_coeff, & 120 0.0_dp, admm_env%work_aux_nmo(ispin)%matrix) 121 CALL cp_fm_trace(mo_coeff_aux_fit, admm_env%work_aux_nmo(ispin)%matrix, trace) 122 fval = fval + trace + 2.0_dp*nmo 123 END DO 124 125 ALLOCATE (eigenvalues(nao_aux_fit)) 126 CALL copy_dbcsr_to_fm(Snew, admm_env%work_aux_aux) 127 CALL cp_fm_syevd(admm_env%work_aux_aux, admm_env%work_aux_aux2, eigenvalues) 128 S_cond_number = MAXVAL(ABS(eigenvalues))/MAX(MINVAL(ABS(eigenvalues)), EPSILON(0.0_dp)) 129 DEALLOCATE (eigenvalues) 130 131 END SUBROUTINE evaluate_fval 132 133END MODULE optbas_opt_utils 134