LCOV - code coverage report
Current view: top level - src/pw - pw_pool_types.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:2fce0f8) Lines: 98 101 97.0 %
Date: 2024-12-21 06:28:57 Functions: 21 46 45.7 %

          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 Manages a pool of grids (to be used for example as tmp objects),
      10             : !>      but can also be used to instantiate grids that are never given back.
      11             : !>
      12             : !>      Multigrid pools are just an array of pw_pools
      13             : !> \note
      14             : !>      The pool could also work without pointers (doing = each time),
      15             : !>      but I find it *very* ugly.
      16             : !>
      17             : !>      The pool could be integrated into pw_grid_type, I don't know if
      18             : !>      it would be a good or bad idea (but would add a circular dependence
      19             : !>      between pw and pw_grid types).
      20             : !> \par History
      21             : !>      08.2002 created [fawzi]
      22             : !> \author Fawzi Mohamed
      23             : ! **************************************************************************************************
      24             : MODULE pw_pool_types
      25             :    #:include 'pw_types.fypp'
      26             :    #:for kind in pw_kinds
      27             :       USE cp_linked_list_pw, ONLY: cp_sll_${kind[1:]}$_${kind[0]}$_dealloc, cp_sll_${kind[1:]}$_${kind[0]}$_get_first_el, &
      28             :                                    cp_sll_${kind[1:]}$_${kind[0]}$_get_length, &
      29             :                                    cp_sll_${kind[1:]}$_${kind[0]}$_insert_el, cp_sll_${kind[1:]}$_${kind[0]}$_next, &
      30             :                                    cp_sll_${kind[1:]}$_${kind[0]}$_rm_first_el, cp_sll_${kind[1:]}$_${kind[0]}$_type
      31             :    #:endfor
      32             :    USE kinds, ONLY: dp
      33             :    USE pw_grid_types, ONLY: pw_grid_type
      34             :    USE pw_grids, ONLY: pw_grid_compare, &
      35             :                        pw_grid_release, &
      36             :                        pw_grid_retain
      37             :    #:for space in pw_spaces
      38             :       #:for kind in pw_kinds
      39             :          USE pw_types, ONLY: pw_${kind}$_${space}$_type
      40             :       #:endfor
      41             :    #:endfor
      42             : #include "../base/base_uses.f90"
      43             : 
      44             :    IMPLICIT NONE
      45             :    PRIVATE
      46             : 
      47             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'pw_pool_types'
      48             :    INTEGER, PARAMETER :: default_max_cache = 75, max_max_cache = 150
      49             : 
      50             :    PUBLIC :: pw_pool_type, pw_pool_p_type
      51             :    PUBLIC :: pw_pool_create, pw_pool_release
      52             :    PUBLIC :: pw_pools_copy, pw_pools_dealloc, &
      53             :              pw_pools_create_pws, pw_pools_give_back_pws
      54             : 
      55             : ! **************************************************************************************************
      56             : !> \brief Manages a pool of grids (to be used for example as tmp objects),
      57             : !>      but can also be used to instantiate grids that are never given back.
      58             : !> \param ref_count reference count (see /cp2k/doc/ReferenceCounting.html)
      59             : !> \param real 1d_array, c1d_array, complex3d_array: liked list with
      60             : !>        the cached grids of the corresponding type
      61             : !> \note
      62             : !>      As of now I would like replace the linked lists by arrays
      63             : !>      (no annoying list elements that are allocated would show up when
      64             : !>      tracking leaks) [fawzi]
      65             : !> \par History
      66             : !>      08.2002 created [fawzi]
      67             : !> \author Fawzi Mohamed
      68             : ! **************************************************************************************************
      69             :    TYPE pw_pool_type
      70             :       INTEGER :: ref_count = 0, max_cache = 0
      71             :       TYPE(pw_grid_type), POINTER :: pw_grid => NULL()
      72             :       #:for kind in pw_kinds
      73             :          TYPE(cp_sll_${kind[1:]}$_${kind[0]}$_type), POINTER :: ${kind}$_array => NULL()
      74             :       #:endfor
      75             :    CONTAINS
      76             :       PROCEDURE, PUBLIC, NON_OVERRIDABLE :: retain => pw_pool_retain
      77             :       #:for space in pw_spaces
      78             :          #:for i, kind in enumerate(pw_kinds)
      79             :             PROCEDURE, PUBLIC, NON_OVERRIDABLE ::            pw_pool_create_pw_${kind}$_${space}$
      80             :             GENERIC, PUBLIC :: create_pw => pw_pool_create_pw_${kind}$_${space}$
      81             :             PROCEDURE, PUBLIC, NON_OVERRIDABLE ::                  pw_pool_give_back_pw_${kind}$_${space}$
      82             :             GENERIC, PUBLIC :: give_back_pw => pw_pool_give_back_pw_${kind}$_${space}$
      83             :          #:endfor
      84             :       #:endfor
      85             :       PROCEDURE, PUBLIC, NON_OVERRIDABLE :: create_cr3d => pw_pool_create_cr3d
      86             :       PROCEDURE, PUBLIC, NON_OVERRIDABLE :: give_back_cr3d => pw_pool_give_back_cr3d
      87             :    END TYPE pw_pool_type
      88             : 
      89             : ! **************************************************************************************************
      90             : !> \brief to create arrays of pools
      91             : !> \param pool the pool
      92             : !> \par History
      93             : !>      08.2002 created [fawzi]
      94             : !> \author Fawzi Mohamed
      95             : ! **************************************************************************************************
      96             :    TYPE pw_pool_p_type
      97             :       TYPE(pw_pool_type), POINTER :: pool => NULL()
      98             :    END TYPE pw_pool_p_type
      99             : 
     100             :    INTERFACE pw_pools_create_pws
     101             :       #:for space in pw_spaces
     102             :          #:for kind in pw_kinds
     103             :             MODULE PROCEDURE pw_pools_create_pws_${kind}$_${space}$
     104             :          #:endfor
     105             :       #:endfor
     106             :    END INTERFACE
     107             : 
     108             :    INTERFACE pw_pools_give_back_pws
     109             :       #:for space in pw_spaces
     110             :          #:for kind in pw_kinds
     111             :             MODULE PROCEDURE pw_pools_give_back_pws_${kind}$_${space}$
     112             :          #:endfor
     113             :       #:endfor
     114             :    END INTERFACE
     115             : 
     116             : CONTAINS
     117             : 
     118             : ! **************************************************************************************************
     119             : !> \brief creates a pool for pw
     120             : !> \param pool the pool to create
     121             : !> \param pw_grid the grid that is used to create the pw
     122             : !> \param max_cache ...
     123             : !> \par History
     124             : !>      08.2002 created [fawzi]
     125             : !> \author Fawzi Mohamed
     126             : ! **************************************************************************************************
     127       93679 :    SUBROUTINE pw_pool_create(pool, pw_grid, max_cache)
     128             :       TYPE(pw_pool_type), POINTER                        :: pool
     129             :       TYPE(pw_grid_type), POINTER                        :: pw_grid
     130             :       INTEGER, OPTIONAL                                  :: max_cache
     131             : 
     132       93679 :       ALLOCATE (pool)
     133       93679 :       pool%pw_grid => pw_grid
     134       93679 :       CALL pw_grid_retain(pw_grid)
     135       93679 :       pool%ref_count = 1
     136       93679 :       pool%max_cache = default_max_cache
     137       93679 :       IF (PRESENT(max_cache)) pool%max_cache = max_cache
     138       93679 :       pool%max_cache = MIN(max_max_cache, pool%max_cache)
     139       93679 :    END SUBROUTINE pw_pool_create
     140             : 
     141             : ! **************************************************************************************************
     142             : !> \brief retains the pool (see cp2k/doc/ReferenceCounting.html)
     143             : !> \param pool the pool to retain
     144             : !> \par History
     145             : !>      08.2002 created [fawzi]
     146             : !> \author Fawzi Mohamed
     147             : ! **************************************************************************************************
     148      195159 :    SUBROUTINE pw_pool_retain(pool)
     149             :       CLASS(pw_pool_type), INTENT(INOUT)                  :: pool
     150             : 
     151      195159 :       CPASSERT(pool%ref_count > 0)
     152             : 
     153      195159 :       pool%ref_count = pool%ref_count + 1
     154      195159 :    END SUBROUTINE pw_pool_retain
     155             : 
     156             : ! **************************************************************************************************
     157             : !> \brief deallocates all the cached grids
     158             : !> \param pool the pool to flush
     159             : !> \par History
     160             : !>      08.2002 created [fawzi]
     161             : !> \author Fawzi Mohamed
     162             : ! **************************************************************************************************
     163       93679 :    SUBROUTINE pw_pool_flush_cache(pool)
     164             :       TYPE(pw_pool_type), INTENT(INOUT)                  :: pool
     165             : 
     166             :       #:for kind, type in zip(pw_kinds, pw_types)
     167       93679 :          ${type}$, CONTIGUOUS, POINTER                      :: ${kind}$_att
     168             :          TYPE(cp_sll_${kind[1:]}$_${kind[0]}$_type), POINTER   :: ${kind}$_iterator
     169             :       #:endfor
     170             : 
     171             :       #:for kind in pw_kinds
     172      374716 :          NULLIFY (${kind}$_iterator, ${kind}$_att)
     173      281037 :          ${kind}$_iterator => pool%${kind}$_array
     174      322822 :          DO
     175      697538 :             IF (.NOT. cp_sll_${kind[1:]}$_${kind[0]}$_next(${kind}$_iterator, el_att=${kind}$_att)) EXIT
     176      322822 :             DEALLOCATE (${kind}$_att)
     177             :          END DO
     178      374716 :          CALL cp_sll_${kind[1:]}$_${kind[0]}$_dealloc(pool%${kind}$_array)
     179             :       #:endfor
     180             : 
     181       93679 :    END SUBROUTINE pw_pool_flush_cache
     182             : 
     183             : ! **************************************************************************************************
     184             : !> \brief releases the given pool (see cp2k/doc/ReferenceCounting.html)
     185             : !> \param pool the pool to release
     186             : !> \par History
     187             : !>      08.2002 created [fawzi]
     188             : !> \author Fawzi Mohamed
     189             : ! **************************************************************************************************
     190      310965 :    SUBROUTINE pw_pool_release(pool)
     191             :       TYPE(pw_pool_type), POINTER                        :: pool
     192             : 
     193      310965 :       IF (ASSOCIATED(pool)) THEN
     194      288838 :          CPASSERT(pool%ref_count > 0)
     195      288838 :          pool%ref_count = pool%ref_count - 1
     196      288838 :          IF (pool%ref_count == 0) THEN
     197       93679 :             CALL pw_pool_flush_cache(pool)
     198       93679 :             CALL pw_grid_release(pool%pw_grid)
     199             : 
     200       93679 :             DEALLOCATE (pool)
     201             :          END IF
     202             :       END IF
     203      310965 :       NULLIFY (pool)
     204      310965 :    END SUBROUTINE pw_pool_release
     205             : 
     206             :    #:for kind, type in zip(pw_kinds, pw_types)
     207             : ! **************************************************************************************************
     208             : !> \brief tries to pop an element from the given list (no error on failure)
     209             : !> \param list the list to pop
     210             : !> \return ...
     211             : !> \par History
     212             : !>      08.2002 created [fawzi]
     213             : !> \author Fawzi Mohamed
     214             : !> \note
     215             : !>      private function
     216             : ! **************************************************************************************************
     217     6558787 :       FUNCTION try_pop_${kind}$ (list) RESULT(res)
     218             :          TYPE(cp_sll_${kind[1:]}$_${kind[0]}$_type), POINTER                    :: list
     219             :          ${type}$, CONTIGUOUS, POINTER                                         :: res
     220             : 
     221     6558787 :          IF (ASSOCIATED(list)) THEN
     222     6174297 :             res => cp_sll_${kind[1:]}$_${kind[0]}$_get_first_el(list)
     223     6174297 :             CALL cp_sll_${kind[1:]}$_${kind[0]}$_rm_first_el(list)
     224             :          ELSE
     225      384490 :             NULLIFY (res)
     226             :          END IF
     227     6558787 :       END FUNCTION try_pop_${kind}$
     228             : 
     229             :       #:for space in pw_spaces
     230             : ! **************************************************************************************************
     231             : !> \brief returns a pw, allocating it if none is in the pool
     232             : !> \param pool the pool from where you get the pw
     233             : !> \param pw will contain the new pw
     234             : !> \par History
     235             : !>      08.2002 created [fawzi]
     236             : !> \author Fawzi Mohamed
     237             : ! **************************************************************************************************
     238     6558787 :          SUBROUTINE pw_pool_create_pw_${kind}$_${space}$ (pool, pw)
     239             :             CLASS(pw_pool_type), INTENT(IN)                     :: pool
     240             :             TYPE(pw_${kind}$_${space}$_type), INTENT(OUT)                         :: pw
     241             : 
     242             :             CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_pool_create_pw'
     243             : 
     244             :             INTEGER                                            :: handle
     245     6558787 :             ${type}$, CONTIGUOUS, POINTER                      :: array_ptr
     246             : 
     247     6558787 :             CALL timeset(routineN, handle)
     248     6558787 :             NULLIFY (array_ptr)
     249             : 
     250     6558787 :             array_ptr => try_pop_${kind}$ (pool%${kind}$_array)
     251     6558787 :             CALL pw%create(pool%pw_grid, array_ptr=array_ptr)
     252             : 
     253     6558787 :             CALL timestop(handle)
     254             : 
     255     6558787 :          END SUBROUTINE pw_pool_create_pw_${kind}$_${space}$
     256             : 
     257             : ! **************************************************************************************************
     258             : !> \brief returns the pw to the pool
     259             : !> \param pool the pool where to reintegrate the pw
     260             : !> \param pw the pw to give back
     261             : !> \par History
     262             : !>      08.2002 created [fawzi]
     263             : !> \author Fawzi Mohamed
     264             : ! **************************************************************************************************
     265     7125349 :          SUBROUTINE pw_pool_give_back_pw_${kind}$_${space}$ (pool, pw)
     266             :             CLASS(pw_pool_type), INTENT(IN)                     :: pool
     267             :             TYPE(pw_${kind}$_${space}$_type), INTENT(INOUT)                       :: pw
     268             : 
     269             :             CHARACTER(len=*), PARAMETER :: routineN = 'pw_pool_give_back_pw'
     270             : 
     271             :             INTEGER                                            :: handle
     272             : 
     273     7125349 :             CALL timeset(routineN, handle)
     274     7125349 :             IF (ASSOCIATED(pw%pw_grid)) THEN
     275     6778841 :                IF (pw_grid_compare(pw%pw_grid, pool%pw_grid)) THEN
     276     6778837 :                   IF (ASSOCIATED(pw%array)) THEN
     277     6309995 :                      IF (cp_sll_${kind[1:]}$_${kind[0]}$_get_length(pool%${kind}$_array) < pool%max_cache) THEN
     278     6309995 :                         CALL cp_sll_${kind[1:]}$_${kind[0]}$_insert_el(pool%${kind}$_array, el=pw%array)
     279     6309995 :                         NULLIFY (pw%array)
     280             :                      ELSE IF (max_max_cache >= 0) THEN
     281           0 :                         CPWARN("hit max_cache")
     282             :                      END IF
     283             :                   END IF
     284             :                END IF
     285             :             END IF
     286     7125349 :             CALL pw%release()
     287     7125349 :             CALL timestop(handle)
     288     7125349 :          END SUBROUTINE pw_pool_give_back_pw_${kind}$_${space}$
     289             : 
     290             : ! **************************************************************************************************
     291             : !> \brief creates a multigrid structure
     292             : !> \param pools the multigrid pool (i.e. an array of pw_pool)
     293             : !> \param pws the multigrid of coefficent you want to initialize
     294             : !> \par History
     295             : !>      07.2004 created [fawzi]
     296             : !> \author Fawzi Mohamed
     297             : ! **************************************************************************************************
     298      930658 :          SUBROUTINE pw_pools_create_pws_${kind}$_${space}$ (pools, pws)
     299             :             TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN)     :: pools
     300             :             TYPE(pw_${kind}$_${space}$_type), ALLOCATABLE, DIMENSION(:), &
     301             :                INTENT(OUT)                                     :: pws
     302             : 
     303             :             INTEGER                                            :: i
     304             : 
     305     6480922 :             ALLOCATE (pws(SIZE(pools)))
     306     4619606 :             DO i = 1, SIZE(pools)
     307     4619606 :                CALL pw_pool_create_pw_${kind}$_${space}$ (pools(i)%pool, pws(i))
     308             :             END DO
     309      930658 :          END SUBROUTINE pw_pools_create_pws_${kind}$_${space}$
     310             : 
     311             : ! **************************************************************************************************
     312             : !> \brief returns the pw part of the coefficients into the pools
     313             : !> \param pools the pools that will cache the pws %pw
     314             : !> \param pws the coefficients to give back
     315             : !> \par History
     316             : !>      08.2002 created [fawzi]
     317             : !> \author Fawzi Mohamed
     318             : ! **************************************************************************************************
     319      930658 :          SUBROUTINE pw_pools_give_back_pws_${kind}$_${space}$ (pools, pws)
     320             :             TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN)     :: pools
     321             :             TYPE(pw_${kind}$_${space}$_type), ALLOCATABLE, DIMENSION(:), &
     322             :                INTENT(INOUT)                                   :: pws
     323             : 
     324             :             INTEGER                                            :: i
     325             : 
     326      930658 :             CPASSERT(SIZE(pws) == SIZE(pools))
     327     4619606 :             DO i = 1, SIZE(pools)
     328     4619606 :                CALL pw_pool_give_back_pw_${kind}$_${space}$ (pools(i)%pool, pws(i))
     329             :             END DO
     330      930658 :             DEALLOCATE (pws)
     331      930658 :          END SUBROUTINE pw_pools_give_back_pws_${kind}$_${space}$
     332             :       #:endfor
     333             :    #:endfor
     334             : 
     335             : ! **************************************************************************************************
     336             : !> \brief returns a 3d real array of coefficients as the one used by pw with
     337             : !>      REALDATA3D, allocating it if none is present in the pool
     338             : !> \param pw_pool the pool that caches the cr3d
     339             : !> \param cr3d the pointer that will contain the array
     340             : !> \par History
     341             : !>      11.2003 created [fawzi]
     342             : !> \author fawzi
     343             : ! **************************************************************************************************
     344      693826 :    SUBROUTINE pw_pool_create_cr3d(pw_pool, cr3d)
     345             :       CLASS(pw_pool_type), INTENT(IN)                     :: pw_pool
     346             :       REAL(kind=dp), DIMENSION(:, :, :), POINTER         :: cr3d
     347             : 
     348      693826 :       IF (ASSOCIATED(pw_pool%r3d_array)) THEN
     349      417556 :          cr3d => cp_sll_3d_r_get_first_el(pw_pool%r3d_array)
     350      417556 :          CALL cp_sll_3d_r_rm_first_el(pw_pool%r3d_array)
     351             :       END IF
     352      693826 :       IF (.NOT. ASSOCIATED(cr3d)) THEN
     353             :          ALLOCATE (cr3d(pw_pool%pw_grid%bounds_local(1, 1):pw_pool%pw_grid%bounds_local(2, 1), &
     354             :                         pw_pool%pw_grid%bounds_local(1, 2):pw_pool%pw_grid%bounds_local(2, 2), &
     355     1381350 :                         pw_pool%pw_grid%bounds_local(1, 3):pw_pool%pw_grid%bounds_local(2, 3)))
     356             :       END IF
     357      693826 :    END SUBROUTINE pw_pool_create_cr3d
     358             : 
     359             : ! **************************************************************************************************
     360             : !> \brief returns a 3d real array of coefficients as the one used by pw with
     361             : !>      REALDATA3D, allocating it if none is present in the pool
     362             : !> \param pw_pool the pool that caches the cr3d
     363             : !> \param cr3d the pointer that will contain the array
     364             : !> \par History
     365             : !>      11.2003 created [fawzi]
     366             : !> \author fawzi
     367             : ! **************************************************************************************************
     368     4620269 :    SUBROUTINE pw_pool_give_back_cr3d(pw_pool, cr3d)
     369             :       CLASS(pw_pool_type), INTENT(IN)                     :: pw_pool
     370             :       REAL(kind=dp), CONTIGUOUS, DIMENSION(:, :, :), &
     371             :          POINTER                                         :: cr3d
     372             : 
     373             :       LOGICAL                                            :: compatible
     374             : 
     375     4620269 :       IF (ASSOCIATED(cr3d)) THEN
     376             :          compatible = ALL(MERGE(pw_pool%pw_grid%bounds_local(1, :) == LBOUND(cr3d) .AND. &
     377             :                                 pw_pool%pw_grid%bounds_local(2, :) == UBOUND(cr3d), &
     378             :                                 pw_pool%pw_grid%bounds_local(2, :) < pw_pool%pw_grid%bounds_local(1, :), &
     379     6651524 :                                 UBOUND(cr3d) >= LBOUND(cr3d)))
     380      604684 :          IF (compatible) THEN
     381      604684 :             IF (cp_sll_3d_r_get_length(pw_pool%r3d_array) < pw_pool%max_cache) THEN
     382      604680 :                CALL cp_sll_3d_r_insert_el(pw_pool%r3d_array, el=cr3d)
     383             :             ELSE
     384           4 :                CPWARN_IF(max_max_cache >= 0, "hit max_cache")
     385           4 :                DEALLOCATE (cr3d)
     386             :             END IF
     387             :          ELSE
     388           0 :             DEALLOCATE (cr3d)
     389             :          END IF
     390             :       END IF
     391     4620269 :       NULLIFY (cr3d)
     392     4620269 :    END SUBROUTINE pw_pool_give_back_cr3d
     393             : 
     394             : ! **************************************************************************************************
     395             : !> \brief copies a multigrid pool, the underlying pools are shared
     396             : !> \param source_pools the pools to copy
     397             : !> \param target_pools will hold the copy of the pools
     398             : !> \par History
     399             : !>      08.2002 created [fawzi]
     400             : !> \author Fawzi Mohamed
     401             : ! **************************************************************************************************
     402       11772 :    SUBROUTINE pw_pools_copy(source_pools, target_pools)
     403             :       TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN)     :: source_pools
     404             :       TYPE(pw_pool_p_type), DIMENSION(:), POINTER        :: target_pools
     405             : 
     406             :       INTEGER                                            :: i
     407             : 
     408       66882 :       ALLOCATE (target_pools(SIZE(source_pools)))
     409       43338 :       DO i = 1, SIZE(source_pools)
     410       31566 :          target_pools(i)%pool => source_pools(i)%pool
     411       43338 :          CALL source_pools(i)%pool%retain()
     412             :       END DO
     413       11772 :    END SUBROUTINE pw_pools_copy
     414             : 
     415             : ! **************************************************************************************************
     416             : !> \brief deallocates the given pools (releasing each of the underlying
     417             : !>      pools)
     418             : !> \param pools the pols to deallocate
     419             : !> \par History
     420             : !>      08.2002 created [fawzi]
     421             : !> \author Fawzi Mohamed
     422             : ! **************************************************************************************************
     423       40690 :    SUBROUTINE pw_pools_dealloc(pools)
     424             :       TYPE(pw_pool_p_type), DIMENSION(:), POINTER        :: pools
     425             : 
     426             :       INTEGER                                            :: i
     427             : 
     428       40690 :       IF (ASSOCIATED(pools)) THEN
     429       83228 :          DO i = 1, SIZE(pools)
     430       83228 :             CALL pw_pool_release(pools(i)%pool)
     431             :          END DO
     432       21440 :          DEALLOCATE (pools)
     433             :       END IF
     434       40690 :       NULLIFY (pools)
     435       40690 :    END SUBROUTINE pw_pools_dealloc
     436             : 
     437           0 : END MODULE pw_pool_types

Generated by: LCOV version 1.15