Line data    Source code

       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2022 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \par History
      10             : !>      - Refactoring (4.4.2007, JGH)
      11             : !>      - Revise virial components (16.10.2020, MK)
      12             : ! **************************************************************************************************
      13             : MODULE virial_types
      14             : 
      15             :    USE kinds,                           ONLY: dp
      16             : #include "../base/base_uses.f90"
      17             : 
      18             :    IMPLICIT NONE
      19             : 
      20             :    PRIVATE
      21             : 
      22             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'virial_types'
      23             : 
      24             :    INTEGER, PRIVATE, SAVE :: last_virial_id_nr = 0
      25             : 
      26             :    PUBLIC :: virial_type, virial_p_type
      27             : 
      28             :    TYPE virial_type
      29             :       INTEGER                        :: ref_count, id_nr
      30             :       REAL(KIND=dp), DIMENSION(3, 3) :: pv_total, &
      31             :                                         pv_kinetic, &
      32             :                                         pv_virial, &
      33             :                                         pv_xc, &
      34             :                                         pv_fock_4c, &
      35             :                                         pv_constraint
      36             :       REAL(KIND=dp), DIMENSION(3, 3) :: pv_overlap, &
      37             :                                         pv_ekinetic, &
      38             :                                         pv_ppl, &
      39             :                                         pv_ppnl, &
      40             :                                         pv_ecore_overlap, &
      41             :                                         pv_ehartree, &
      42             :                                         pv_exc, &
      43             :                                         pv_exx, &
      44             :                                         pv_vdw, &
      45             :                                         pv_mp2, &
      46             :                                         pv_nlcc, &
      47             :                                         pv_gapw, &
      48             :                                         pv_lrigpw
      49             :       LOGICAL                        :: pv_availability, &
      50             :                                         pv_calculate, &
      51             :                                         pv_numer, &
      52             :                                         pv_diagonal
      53             :    END TYPE virial_type
      54             : 
      55             :    TYPE virial_p_type
      56             :       TYPE(virial_type), POINTER     :: virial
      57             :    END TYPE virial_p_type
      58             : 
      59             :    PUBLIC :: cp_virial, virial_create, virial_release, virial_set, &
      60             :              symmetrize_virial, zero_virial
      61             : 
      62             : CONTAINS
      63             : 
      64             : ! **************************************************************************************************
      65             : !> \brief   copy virial_in into virial_out
      66             : !> \param virial_in ...
      67             : !> \param virial_out ...
      68             : !> \version 1.0
      69             : ! **************************************************************************************************
      70        5624 :    SUBROUTINE cp_virial(virial_in, virial_out)
      71             :       TYPE(virial_type), INTENT(IN)                      :: virial_in
      72             :       TYPE(virial_type), INTENT(INOUT)                   :: virial_out
      73             : 
      74       73112 :       virial_out%pv_total = virial_in%pv_total
      75       73112 :       virial_out%pv_kinetic = virial_in%pv_kinetic
      76       73112 :       virial_out%pv_virial = virial_in%pv_virial
      77       73112 :       virial_out%pv_xc = virial_in%pv_xc
      78       73112 :       virial_out%pv_fock_4c = virial_in%pv_fock_4c
      79       73112 :       virial_out%pv_constraint = virial_in%pv_constraint
      80             : 
      81       73112 :       virial_out%pv_overlap = virial_in%pv_overlap
      82       73112 :       virial_out%pv_ekinetic = virial_in%pv_ekinetic
      83       73112 :       virial_out%pv_ppl = virial_in%pv_ppl
      84       73112 :       virial_out%pv_ppnl = virial_in%pv_ppnl
      85       73112 :       virial_out%pv_ecore_overlap = virial_in%pv_ecore_overlap
      86       73112 :       virial_out%pv_ehartree = virial_in%pv_ehartree
      87       73112 :       virial_out%pv_exc = virial_in%pv_exc
      88       73112 :       virial_out%pv_exx = virial_in%pv_exx
      89       73112 :       virial_out%pv_vdw = virial_in%pv_vdw
      90       73112 :       virial_out%pv_mp2 = virial_in%pv_mp2
      91       73112 :       virial_out%pv_nlcc = virial_in%pv_nlcc
      92       73112 :       virial_out%pv_gapw = virial_in%pv_gapw
      93       73112 :       virial_out%pv_lrigpw = virial_in%pv_lrigpw
      94             : 
      95        5624 :       virial_out%pv_availability = virial_in%pv_availability
      96        5624 :       virial_out%pv_calculate = virial_in%pv_calculate
      97        5624 :       virial_out%pv_numer = virial_in%pv_numer
      98        5624 :       virial_out%pv_diagonal = virial_in%pv_diagonal
      99             : 
     100        5624 :    END SUBROUTINE cp_virial
     101             : 
     102             : ! **************************************************************************************************
     103             : !> \brief   Symmetrize the virial components
     104             : !> \param virial ...
     105             : !> \version 1.0
     106             : ! **************************************************************************************************
     107       16514 :    SUBROUTINE symmetrize_virial(virial)
     108             :       TYPE(virial_type), INTENT(INOUT)                   :: virial
     109             : 
     110             :       INTEGER                                            :: i, j
     111             : 
     112       66056 :       DO i = 1, 3
     113      115598 :          DO j = 1, i - 1
     114       49542 :             virial%pv_total(j, i) = 0.5_dp*(virial%pv_total(i, j) + virial%pv_total(j, i))
     115       49542 :             virial%pv_total(i, j) = virial%pv_total(j, i)
     116       49542 :             virial%pv_kinetic(j, i) = 0.5_dp*(virial%pv_kinetic(i, j) + virial%pv_kinetic(j, i))
     117       49542 :             virial%pv_kinetic(i, j) = virial%pv_kinetic(j, i)
     118       49542 :             virial%pv_virial(j, i) = 0.5_dp*(virial%pv_virial(i, j) + virial%pv_virial(j, i))
     119       49542 :             virial%pv_virial(i, j) = virial%pv_virial(j, i)
     120       49542 :             virial%pv_xc(j, i) = 0.5_dp*(virial%pv_xc(i, j) + virial%pv_xc(j, i))
     121       49542 :             virial%pv_xc(i, j) = virial%pv_xc(j, i)
     122       49542 :             virial%pv_fock_4c(j, i) = 0.5_dp*(virial%pv_fock_4c(i, j) + virial%pv_fock_4c(j, i))
     123       49542 :             virial%pv_fock_4c(i, j) = virial%pv_fock_4c(j, i)
     124       49542 :             virial%pv_constraint(j, i) = 0.5_dp*(virial%pv_constraint(i, j) + virial%pv_constraint(j, i))
     125       49542 :             virial%pv_constraint(i, j) = virial%pv_constraint(j, i)
     126             :             ! Virial components
     127       49542 :             virial%pv_overlap(j, i) = 0.5_dp*(virial%pv_overlap(i, j) + virial%pv_overlap(j, i))
     128       49542 :             virial%pv_overlap(i, j) = virial%pv_overlap(j, i)
     129       49542 :             virial%pv_ekinetic(j, i) = 0.5_dp*(virial%pv_ekinetic(i, j) + virial%pv_ekinetic(j, i))
     130       49542 :             virial%pv_ekinetic(i, j) = virial%pv_ekinetic(j, i)
     131       49542 :             virial%pv_ppl(j, i) = 0.5_dp*(virial%pv_ppl(i, j) + virial%pv_ppl(j, i))
     132       49542 :             virial%pv_ppl(i, j) = virial%pv_ppl(j, i)
     133       49542 :             virial%pv_ppnl(j, i) = 0.5_dp*(virial%pv_ppnl(i, j) + virial%pv_ppnl(j, i))
     134       49542 :             virial%pv_ppnl(i, j) = virial%pv_ppnl(j, i)
     135       49542 :             virial%pv_ecore_overlap(j, i) = 0.5_dp*(virial%pv_ecore_overlap(i, j) + virial%pv_ecore_overlap(j, i))
     136       49542 :             virial%pv_ecore_overlap(i, j) = virial%pv_ecore_overlap(j, i)
     137       49542 :             virial%pv_ehartree(j, i) = 0.5_dp*(virial%pv_ehartree(i, j) + virial%pv_ehartree(j, i))
     138       49542 :             virial%pv_ehartree(i, j) = virial%pv_ehartree(j, i)
     139       49542 :             virial%pv_exc(j, i) = 0.5_dp*(virial%pv_exc(i, j) + virial%pv_exc(j, i))
     140       49542 :             virial%pv_exc(i, j) = virial%pv_exc(j, i)
     141       49542 :             virial%pv_exx(j, i) = 0.5_dp*(virial%pv_exx(i, j) + virial%pv_exx(j, i))
     142       49542 :             virial%pv_exx(i, j) = virial%pv_exx(j, i)
     143       49542 :             virial%pv_vdw(j, i) = 0.5_dp*(virial%pv_vdw(i, j) + virial%pv_vdw(j, i))
     144       49542 :             virial%pv_vdw(i, j) = virial%pv_vdw(j, i)
     145       49542 :             virial%pv_mp2(j, i) = 0.5_dp*(virial%pv_mp2(i, j) + virial%pv_mp2(j, i))
     146       49542 :             virial%pv_mp2(i, j) = virial%pv_mp2(j, i)
     147       49542 :             virial%pv_nlcc(j, i) = 0.5_dp*(virial%pv_nlcc(i, j) + virial%pv_nlcc(j, i))
     148       49542 :             virial%pv_nlcc(i, j) = virial%pv_nlcc(j, i)
     149       49542 :             virial%pv_gapw(j, i) = 0.5_dp*(virial%pv_gapw(i, j) + virial%pv_gapw(j, i))
     150       49542 :             virial%pv_gapw(i, j) = virial%pv_gapw(j, i)
     151       49542 :             virial%pv_lrigpw(j, i) = 0.5_dp*(virial%pv_lrigpw(i, j) + virial%pv_lrigpw(j, i))
     152       99084 :             virial%pv_lrigpw(i, j) = virial%pv_lrigpw(j, i)
     153             :          END DO
     154             :       END DO
     155             : 
     156       16514 :    END SUBROUTINE symmetrize_virial
     157             : 
     158             : ! **************************************************************************************************
     159             : !> \brief ...
     160             : !> \param virial ...
     161             : !> \param reset ...
     162             : ! **************************************************************************************************
     163       36551 :    SUBROUTINE zero_virial(virial, reset)
     164             :       TYPE(virial_type), INTENT(INOUT)                   :: virial
     165             :       LOGICAL, INTENT(IN), OPTIONAL                      :: reset
     166             : 
     167             :       LOGICAL                                            :: my_reset
     168             : 
     169       36551 :       my_reset = .TRUE.
     170       36551 :       IF (PRESENT(reset)) my_reset = reset
     171             : 
     172      475163 :       virial%pv_total = 0.0_dp
     173      475163 :       virial%pv_kinetic = 0.0_dp
     174      475163 :       virial%pv_virial = 0.0_dp
     175      475163 :       virial%pv_xc = 0.0_dp
     176      475163 :       virial%pv_fock_4c = 0.0_dp
     177      475163 :       virial%pv_constraint = 0.0_dp
     178             : 
     179      475163 :       virial%pv_overlap = 0.0_dp
     180      475163 :       virial%pv_ekinetic = 0.0_dp
     181      475163 :       virial%pv_ppl = 0.0_dp
     182      475163 :       virial%pv_ppnl = 0.0_dp
     183      475163 :       virial%pv_ecore_overlap = 0.0_dp
     184      475163 :       virial%pv_ehartree = 0.0_dp
     185      475163 :       virial%pv_exc = 0.0_dp
     186      475163 :       virial%pv_exx = 0.0_dp
     187      475163 :       virial%pv_vdw = 0.0_dp
     188      475163 :       virial%pv_mp2 = 0.0_dp
     189      475163 :       virial%pv_nlcc = 0.0_dp
     190      475163 :       virial%pv_gapw = 0.0_dp
     191      475163 :       virial%pv_lrigpw = 0.0_dp
     192             : 
     193       36551 :       IF (my_reset) THEN
     194       14919 :          virial%pv_availability = .FALSE.
     195       14919 :          virial%pv_calculate = .FALSE.
     196       14919 :          virial%pv_numer = .FALSE.
     197       14919 :          virial%pv_diagonal = .FALSE.
     198             :       END IF
     199             : 
     200       36551 :    END SUBROUTINE zero_virial
     201             : 
     202             : ! **************************************************************************************************
     203             : !> \brief ...
     204             : !> \param virial ...
     205             : !> \param pv_total ...
     206             : !> \param pv_kinetic ...
     207             : !> \param pv_virial ...
     208             : !> \param pv_xc ...
     209             : !> \param pv_fock_4c ...
     210             : !> \param pv_constraint ...
     211             : !> \param pv_overlap ...
     212             : !> \param pv_ekinetic ...
     213             : !> \param pv_ppl ...
     214             : !> \param pv_ppnl ...
     215             : !> \param pv_ecore_overlap ...
     216             : !> \param pv_ehartree ...
     217             : !> \param pv_exc ...
     218             : !> \param pv_exx ...
     219             : !> \param pv_vdw ...
     220             : !> \param pv_mp2 ...
     221             : !> \param pv_nlcc ...
     222             : !> \param pv_gapw ...
     223             : !> \param pv_lrigpw ...
     224             : !> \param pv_availability ...
     225             : !> \param pv_calculate ...
     226             : !> \param pv_numer ...
     227             : !> \param pv_diagonal ...
     228             : ! **************************************************************************************************
     229        8157 :    SUBROUTINE virial_set(virial, pv_total, pv_kinetic, pv_virial, pv_xc, pv_fock_4c, pv_constraint, &
     230             :                          pv_overlap, pv_ekinetic, pv_ppl, pv_ppnl, pv_ecore_overlap, pv_ehartree, &
     231             :                          pv_exc, pv_exx, pv_vdw, pv_mp2, pv_nlcc, pv_gapw, pv_lrigpw, &
     232             :                          pv_availability, pv_calculate, pv_numer, pv_diagonal)
     233             : 
     234             :       TYPE(virial_type), INTENT(INOUT)                   :: virial
     235             :       REAL(KIND=dp), DIMENSION(3, 3), OPTIONAL :: pv_total, pv_kinetic, pv_virial, pv_xc, &
     236             :          pv_fock_4c, pv_constraint, pv_overlap, pv_ekinetic, pv_ppl, pv_ppnl, pv_ecore_overlap, &
     237             :          pv_ehartree, pv_exc, pv_exx, pv_vdw, pv_mp2, pv_nlcc, pv_gapw, pv_lrigpw
     238             :       LOGICAL, OPTIONAL                                  :: pv_availability, pv_calculate, pv_numer, &
     239             :                                                             pv_diagonal
     240             : 
     241        8157 :       IF (PRESENT(pv_total)) virial%pv_total = pv_total
     242        8157 :       IF (PRESENT(pv_kinetic)) virial%pv_kinetic = pv_kinetic
     243        8157 :       IF (PRESENT(pv_virial)) virial%pv_virial = pv_virial
     244        8157 :       IF (PRESENT(pv_xc)) virial%pv_xc = pv_xc
     245        8157 :       IF (PRESENT(pv_fock_4c)) virial%pv_fock_4c = pv_fock_4c
     246        8157 :       IF (PRESENT(pv_constraint)) virial%pv_constraint = pv_constraint
     247             : 
     248        8157 :       IF (PRESENT(pv_overlap)) virial%pv_overlap = pv_overlap
     249        8157 :       IF (PRESENT(pv_ekinetic)) virial%pv_ekinetic = pv_ekinetic
     250        8157 :       IF (PRESENT(pv_ppl)) virial%pv_ppl = pv_ppl
     251        8157 :       IF (PRESENT(pv_ppnl)) virial%pv_ppnl = pv_ppnl
     252        8157 :       IF (PRESENT(pv_ecore_overlap)) virial%pv_ecore_overlap = pv_ecore_overlap
     253        8157 :       IF (PRESENT(pv_ehartree)) virial%pv_ehartree = pv_ehartree
     254        8157 :       IF (PRESENT(pv_exc)) virial%pv_exc = pv_exc
     255        8157 :       IF (PRESENT(pv_exx)) virial%pv_exx = pv_exx
     256        8157 :       IF (PRESENT(pv_vdw)) virial%pv_vdw = pv_vdw
     257        8157 :       IF (PRESENT(pv_mp2)) virial%pv_mp2 = pv_mp2
     258        8157 :       IF (PRESENT(pv_nlcc)) virial%pv_nlcc = pv_nlcc
     259        8157 :       IF (PRESENT(pv_gapw)) virial%pv_gapw = pv_gapw
     260        8157 :       IF (PRESENT(pv_lrigpw)) virial%pv_lrigpw = pv_lrigpw
     261             : 
     262        8157 :       IF (PRESENT(pv_availability)) virial%pv_availability = pv_availability
     263        8157 :       IF (PRESENT(pv_calculate)) virial%pv_calculate = pv_calculate
     264        8157 :       IF (PRESENT(pv_numer)) virial%pv_numer = pv_numer
     265        8157 :       IF (PRESENT(pv_diagonal)) virial%pv_diagonal = pv_diagonal
     266             : 
     267        8157 :    END SUBROUTINE virial_set
     268             : 
     269             : ! **************************************************************************************************
     270             : !> \brief ...
     271             : !> \param virial ...
     272             : ! **************************************************************************************************
     273       14819 :    SUBROUTINE virial_create(virial)
     274             :       TYPE(virial_type), POINTER                         :: virial
     275             : 
     276       14819 :       ALLOCATE (virial)
     277       14819 :       CALL zero_virial(virial)
     278       14819 :       last_virial_id_nr = last_virial_id_nr + 1
     279       14819 :       virial%id_nr = last_virial_id_nr
     280       14819 :       virial%ref_count = 1
     281             : 
     282       14819 :    END SUBROUTINE virial_create
     283             : 
     284             : ! **************************************************************************************************
     285             : !> \brief releases the given virial_type
     286             : !> \param virial the virial_type to release
     287             : !> \par History
     288             : !>      Created (04.2003, fawzi)
     289             : !> \author fawzi
     290             : !> \note
     291             : !>      see doc/ReferenceCounting.html
     292             : ! **************************************************************************************************
     293       16581 :    SUBROUTINE virial_release(virial)
     294             :       TYPE(virial_type), POINTER                         :: virial
     295             : 
     296       16581 :       IF (ASSOCIATED(virial)) THEN
     297       14819 :          CPASSERT(virial%ref_count > 0)
     298       14819 :          virial%ref_count = virial%ref_count - 1
     299       14819 :          IF (virial%ref_count == 0) THEN
     300       14819 :             DEALLOCATE (virial)
     301             :          END IF
     302       14819 :          NULLIFY (virial)
     303             :       END IF
     304             : 
     305       16581 :    END SUBROUTINE virial_release
     306             : 
     307           0 : END MODULE virial_types