LCOV - code coverage report
Current view: top level - src - hfx_get_pmax_val.fypp (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:34ef472) Lines: 64 163 39.3 %
Date: 2024-04-26 08:30:29 Functions: 3 3 100.0 %

          Line data    Source code
       1             : #!-------------------------------------------------------------------------------------------------!
       2             : #!   CP2K: A general program to perform molecular dynamics simulations                             !
       3             : #!   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                  !
       4             : #!                                                                                                 !
       5             : #!   SPDX-License-Identifier: GPL-2.0-or-later                                                     !
       6             : #!-------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief This routine calculates the maximum density matrix element, when
      10             : !>        screening on an initial density matrix is applied. Due to symmetry of
      11             : !>        the ERI's, there are always 4 matrix elements to be considered.
      12             : !>        CASE 0-15 belong to an energy calculation (linear screening)
      13             : !>        CASE 16-31 belong to a force calculation (square screening)
      14             : !> \param ptr_p_1 Pointers to atomic density matrices
      15             : !> \param ptr_p_2 Pointers to atomic density matrices
      16             : !> \param ptr_p_3 Pointers to atomic density matrices
      17             : !> \param ptr_p_4 Pointers to atomic density matrices
      18             : !> \param iset Current set
      19             : !> \param jset Current set
      20             : !> \param kset Current set
      21             : !> \param lset Current set
      22             : !> \param pmax_val value to be calculated
      23             : !> \param swap_id Defines how the matrices are accessed
      24             : !> \par History
      25             : !>      06.2009 created [Manuel Guidon]
      26             : !> \author Manuel Guidon
      27             : ! **************************************************************************************************
      28     2277432 : PURE SUBROUTINE get_pmax_val(ptr_p_1, ptr_p_2, ptr_p_3, ptr_p_4, iset, jset, kset, lset, pmax_val, swap_id)
      29             : 
      30             :    REAL(dp), DIMENSION(:, :), POINTER       :: ptr_p_1, ptr_p_2, ptr_p_3, ptr_p_4
      31             :    INTEGER, INTENT(IN)                      :: iset, jset, kset, lset
      32             : 
      33             :    REAL(dp), INTENT(OUT)                    :: pmax_val
      34             :    INTEGER, INTENT(IN)                      :: swap_id
      35             : 
      36             :    REAL(dp)                                 :: pmax_1, pmax_2, pmax_3, pmax_4
      37             : 
      38     2865721 :    SELECT CASE (swap_id)
      39             :    CASE (0)
      40      588289 :       pmax_1 = ptr_p_1(kset, iset)
      41      588289 :       pmax_2 = ptr_p_2(lset, jset)
      42      588289 :       pmax_3 = ptr_p_3(lset, iset)
      43      588289 :       pmax_4 = ptr_p_4(kset, jset)
      44      588289 :       pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
      45             :    CASE (1)
      46           0 :       pmax_1 = ptr_p_1(iset, kset)
      47           0 :       pmax_2 = ptr_p_2(lset, jset)
      48           0 :       pmax_3 = ptr_p_3(lset, iset)
      49           0 :       pmax_4 = ptr_p_4(kset, jset)
      50           0 :       pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
      51             :    CASE (2)
      52         691 :       pmax_1 = ptr_p_1(kset, iset)
      53         691 :       pmax_2 = ptr_p_2(jset, lset)
      54         691 :       pmax_3 = ptr_p_3(lset, iset)
      55         691 :       pmax_4 = ptr_p_4(kset, jset)
      56         691 :       pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
      57             :    CASE (3)
      58           0 :       pmax_1 = ptr_p_1(iset, kset)
      59           0 :       pmax_2 = ptr_p_2(jset, lset)
      60           0 :       pmax_3 = ptr_p_3(lset, iset)
      61           0 :       pmax_4 = ptr_p_4(kset, jset)
      62           0 :       pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
      63             :    CASE (4)
      64      155637 :       pmax_1 = ptr_p_1(kset, iset)
      65      155637 :       pmax_2 = ptr_p_2(lset, jset)
      66      155637 :       pmax_3 = ptr_p_3(iset, lset)
      67      155637 :       pmax_4 = ptr_p_4(kset, jset)
      68      155637 :       pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
      69             :    CASE (5)
      70       35780 :       pmax_1 = ptr_p_1(iset, kset)
      71       35780 :       pmax_2 = ptr_p_2(lset, jset)
      72       35780 :       pmax_3 = ptr_p_3(iset, lset)
      73       35780 :       pmax_4 = ptr_p_4(kset, jset)
      74       35780 :       pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
      75             :    CASE (6)
      76       54550 :       pmax_1 = ptr_p_1(kset, iset)
      77       54550 :       pmax_2 = ptr_p_2(jset, lset)
      78       54550 :       pmax_3 = ptr_p_3(iset, lset)
      79       54550 :       pmax_4 = ptr_p_4(kset, jset)
      80       54550 :       pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
      81             :    CASE (7)
      82           0 :       pmax_1 = ptr_p_1(iset, kset)
      83           0 :       pmax_2 = ptr_p_2(jset, lset)
      84           0 :       pmax_3 = ptr_p_3(iset, lset)
      85           0 :       pmax_4 = ptr_p_4(kset, jset)
      86           0 :       pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
      87             :    CASE (8)
      88         691 :       pmax_1 = ptr_p_1(kset, iset)
      89         691 :       pmax_2 = ptr_p_2(lset, jset)
      90         691 :       pmax_3 = ptr_p_3(lset, iset)
      91         691 :       pmax_4 = ptr_p_4(jset, kset)
      92         691 :       pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
      93             :    CASE (9)
      94         467 :       pmax_1 = ptr_p_1(iset, kset)
      95         467 :       pmax_2 = ptr_p_2(lset, jset)
      96         467 :       pmax_3 = ptr_p_3(lset, iset)
      97         467 :       pmax_4 = ptr_p_4(jset, kset)
      98         467 :       pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
      99             :    CASE (10)
     100        1139 :       pmax_1 = ptr_p_1(kset, iset)
     101        1139 :       pmax_2 = ptr_p_2(jset, lset)
     102        1139 :       pmax_3 = ptr_p_3(lset, iset)
     103        1139 :       pmax_4 = ptr_p_4(jset, kset)
     104        1139 :       pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
     105             :    CASE (11)
     106           0 :       pmax_1 = ptr_p_1(iset, kset)
     107           0 :       pmax_2 = ptr_p_2(jset, lset)
     108           0 :       pmax_3 = ptr_p_3(lset, iset)
     109           0 :       pmax_4 = ptr_p_4(jset, kset)
     110           0 :       pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
     111             :    CASE (12)
     112           0 :       pmax_1 = ptr_p_1(kset, iset)
     113           0 :       pmax_2 = ptr_p_2(lset, jset)
     114           0 :       pmax_3 = ptr_p_3(iset, lset)
     115           0 :       pmax_4 = ptr_p_4(jset, kset)
     116           0 :       pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
     117             :    CASE (13)
     118           0 :       pmax_1 = ptr_p_1(iset, kset)
     119           0 :       pmax_2 = ptr_p_2(lset, jset)
     120           0 :       pmax_3 = ptr_p_3(iset, lset)
     121           0 :       pmax_4 = ptr_p_4(jset, kset)
     122           0 :       pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
     123             :    CASE (14)
     124           0 :       pmax_1 = ptr_p_1(kset, iset)
     125           0 :       pmax_2 = ptr_p_2(jset, lset)
     126           0 :       pmax_3 = ptr_p_3(iset, lset)
     127           0 :       pmax_4 = ptr_p_4(jset, kset)
     128           0 :       pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
     129             :    CASE (15)
     130        1382 :       pmax_1 = ptr_p_1(iset, kset)
     131        1382 :       pmax_2 = ptr_p_2(jset, lset)
     132        1382 :       pmax_3 = ptr_p_3(iset, lset)
     133        1382 :       pmax_4 = ptr_p_4(jset, kset)
     134        1382 :       pmax_val = MAX(pmax_1, pmax_2, pmax_3, pmax_4)
     135             :    CASE (16)
     136     1137035 :       pmax_1 = ptr_p_1(kset, iset)
     137     1137035 :       pmax_2 = ptr_p_2(lset, jset)
     138     1137035 :       pmax_3 = ptr_p_3(lset, iset)
     139     1137035 :       pmax_4 = ptr_p_4(kset, jset)
     140     1137035 :       pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
     141             :    CASE (17)
     142           0 :       pmax_1 = ptr_p_1(iset, kset)
     143           0 :       pmax_2 = ptr_p_2(lset, jset)
     144           0 :       pmax_3 = ptr_p_3(lset, iset)
     145           0 :       pmax_4 = ptr_p_4(kset, jset)
     146           0 :       pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
     147             :    CASE (18)
     148           0 :       pmax_1 = ptr_p_1(kset, iset)
     149           0 :       pmax_2 = ptr_p_2(jset, lset)
     150           0 :       pmax_3 = ptr_p_3(lset, iset)
     151           0 :       pmax_4 = ptr_p_4(kset, jset)
     152           0 :       pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
     153             :    CASE (19)
     154           0 :       pmax_1 = ptr_p_1(iset, kset)
     155           0 :       pmax_2 = ptr_p_2(jset, lset)
     156           0 :       pmax_3 = ptr_p_3(lset, iset)
     157           0 :       pmax_4 = ptr_p_4(kset, jset)
     158           0 :       pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
     159             :    CASE (20)
     160      257399 :       pmax_1 = ptr_p_1(kset, iset)
     161      257399 :       pmax_2 = ptr_p_2(lset, jset)
     162      257399 :       pmax_3 = ptr_p_3(iset, lset)
     163      257399 :       pmax_4 = ptr_p_4(kset, jset)
     164      257399 :       pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
     165             :    CASE (21)
     166       44372 :       pmax_1 = ptr_p_1(iset, kset)
     167       44372 :       pmax_2 = ptr_p_2(lset, jset)
     168       44372 :       pmax_3 = ptr_p_3(iset, lset)
     169       44372 :       pmax_4 = ptr_p_4(kset, jset)
     170       44372 :       pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
     171             :    CASE (22)
     172           0 :       pmax_1 = ptr_p_1(kset, iset)
     173           0 :       pmax_2 = ptr_p_2(jset, lset)
     174           0 :       pmax_3 = ptr_p_3(iset, lset)
     175           0 :       pmax_4 = ptr_p_4(kset, jset)
     176           0 :       pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
     177             :    CASE (23)
     178           0 :       pmax_1 = ptr_p_1(iset, kset)
     179           0 :       pmax_2 = ptr_p_2(jset, lset)
     180           0 :       pmax_3 = ptr_p_3(iset, lset)
     181           0 :       pmax_4 = ptr_p_4(kset, jset)
     182           0 :       pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
     183             :    CASE (24)
     184           0 :       pmax_1 = ptr_p_1(kset, iset)
     185           0 :       pmax_2 = ptr_p_2(lset, jset)
     186           0 :       pmax_3 = ptr_p_3(lset, iset)
     187           0 :       pmax_4 = ptr_p_4(jset, kset)
     188           0 :       pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
     189             :    CASE (25)
     190           0 :       pmax_1 = ptr_p_1(iset, kset)
     191           0 :       pmax_2 = ptr_p_2(lset, jset)
     192           0 :       pmax_3 = ptr_p_3(lset, iset)
     193           0 :       pmax_4 = ptr_p_4(jset, kset)
     194           0 :       pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
     195             :    CASE (26)
     196           0 :       pmax_1 = ptr_p_1(kset, iset)
     197           0 :       pmax_2 = ptr_p_2(jset, lset)
     198           0 :       pmax_3 = ptr_p_3(lset, iset)
     199           0 :       pmax_4 = ptr_p_4(jset, kset)
     200           0 :       pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
     201             :    CASE (27)
     202           0 :       pmax_1 = ptr_p_1(iset, kset)
     203           0 :       pmax_2 = ptr_p_2(jset, lset)
     204           0 :       pmax_3 = ptr_p_3(lset, iset)
     205           0 :       pmax_4 = ptr_p_4(jset, kset)
     206           0 :       pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
     207             :    CASE (28)
     208           0 :       pmax_1 = ptr_p_1(kset, iset)
     209           0 :       pmax_2 = ptr_p_2(lset, jset)
     210           0 :       pmax_3 = ptr_p_3(iset, lset)
     211           0 :       pmax_4 = ptr_p_4(jset, kset)
     212           0 :       pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
     213             :    CASE (29)
     214           0 :       pmax_1 = ptr_p_1(iset, kset)
     215           0 :       pmax_2 = ptr_p_2(lset, jset)
     216           0 :       pmax_3 = ptr_p_3(iset, lset)
     217           0 :       pmax_4 = ptr_p_4(jset, kset)
     218           0 :       pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
     219             :    CASE (30)
     220           0 :       pmax_1 = ptr_p_1(kset, iset)
     221           0 :       pmax_2 = ptr_p_2(jset, lset)
     222           0 :       pmax_3 = ptr_p_3(iset, lset)
     223           0 :       pmax_4 = ptr_p_4(jset, kset)
     224           0 :       pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
     225             :    CASE (31)
     226           0 :       pmax_1 = ptr_p_1(iset, kset)
     227           0 :       pmax_2 = ptr_p_2(jset, lset)
     228           0 :       pmax_3 = ptr_p_3(iset, lset)
     229           0 :       pmax_4 = ptr_p_4(jset, kset)
     230     2277432 :       pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4)
     231             :    END SELECT
     232             : 
     233     2277432 : END SUBROUTINE get_pmax_val
     234             : 

Generated by: LCOV version 1.15