LCOV - code coverage report
Current view: top level - src/fm - cp_fm_pool_types.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:58e3e09) Lines: 75 87 86.2 %
Date: 2024-03-29 07:50:05 Functions: 12 19 63.2 %

          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 pool for for elements that are retained and released
      10             : !> \par History
      11             : !>      08.2002 created [fawzi]
      12             : !> \author Fawzi Mohamed
      13             : ! **************************************************************************************************
      14             : MODULE cp_fm_pool_types
      15             :    USE cp_fm_struct, ONLY: cp_fm_struct_release, &
      16             :                            cp_fm_struct_retain, &
      17             :                            cp_fm_struct_type
      18             :    USE cp_fm_types, ONLY: cp_fm_create, &
      19             :                           cp_fm_p_type, &
      20             :                           cp_fm_release, &
      21             :                           cp_fm_type
      22             :    USE cp_linked_list_fm, ONLY: cp_sll_fm_dealloc, &
      23             :                                 cp_sll_fm_get_first_el, &
      24             :                                 cp_sll_fm_insert_el, &
      25             :                                 cp_sll_fm_next, &
      26             :                                 cp_sll_fm_rm_first_el, &
      27             :                                 cp_sll_fm_type
      28             :    USE cp_log_handling, ONLY: cp_to_string
      29             : #include "../base/base_uses.f90"
      30             : 
      31             :    IMPLICIT NONE
      32             :    PRIVATE
      33             : 
      34             :    LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
      35             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_fm_pool_types'
      36             : 
      37             :    PUBLIC :: cp_fm_pool_type, cp_fm_pool_p_type
      38             :    PUBLIC :: fm_pool_create, fm_pool_retain, &
      39             :              fm_pool_release, &
      40             :              fm_pool_create_fm, fm_pool_give_back_fm, &
      41             :              fm_pool_get_el_struct
      42             :    PUBLIC :: fm_pools_dealloc, &
      43             :              fm_pools_create_fm_vect, &
      44             :              fm_pools_give_back_fm_vect
      45             : !***
      46             : 
      47             : ! **************************************************************************************************
      48             : !> \brief represent a pool of elements with the same structure
      49             : !> \param ref_count reference count (see /cp2k/doc/ReferenceCounting.html)
      50             : !> \param el_struct the structure of the elements stored in this pool
      51             : !> \param cache linked list with the elements in the pool
      52             : !> \par History
      53             : !>      08.2002 created [fawzi]
      54             : !> \author Fawzi Mohamed
      55             : ! **************************************************************************************************
      56             :    TYPE cp_fm_pool_type
      57             :       PRIVATE
      58             :       INTEGER :: ref_count = -1
      59             :       TYPE(cp_fm_struct_type), POINTER :: el_struct => NULL()
      60             :       TYPE(cp_sll_fm_type), POINTER :: cache => NULL()
      61             :    END TYPE cp_fm_pool_type
      62             : 
      63             : ! **************************************************************************************************
      64             : !> \brief to create arrays of pools
      65             : !> \param pool the pool
      66             : !> \par History
      67             : !>      08.2002 created [fawzi]
      68             : !> \author Fawzi Mohamed
      69             : ! **************************************************************************************************
      70             :    TYPE cp_fm_pool_p_type
      71             :       TYPE(cp_fm_pool_type), POINTER :: pool => NULL()
      72             :    END TYPE cp_fm_pool_p_type
      73             : 
      74             :    INTERFACE fm_pools_create_fm_vect
      75             :       MODULE PROCEDURE fm_pools_create_fm_m1_p_type_pointer
      76             :       MODULE PROCEDURE fm_pools_create_fm_m1_p_type_alloc
      77             :       MODULE PROCEDURE fm_pools_create_fm_m1_array_pointer
      78             :       MODULE PROCEDURE fm_pools_create_fm_m1_array_alloc
      79             :    END INTERFACE
      80             : 
      81             :    INTERFACE fm_pools_give_back_fm_vect
      82             :       MODULE PROCEDURE fm_pools_give_back_fm_m1_p_type_pointer
      83             :       MODULE PROCEDURE fm_pools_give_back_fm_m1_p_type_alloc
      84             :       MODULE PROCEDURE fm_pools_give_back_fm_m1_array_pointer
      85             :       MODULE PROCEDURE fm_pools_give_back_fm_m1_array_alloc
      86             :    END INTERFACE
      87             : 
      88             : CONTAINS
      89             : 
      90             : ! **************************************************************************************************
      91             : !> \brief creates a pool of elements
      92             : !> \param pool the pool to create
      93             : !> \param el_struct the structure of the elements that are stored in
      94             : !>        this pool
      95             : !> \par History
      96             : !>      08.2002 created [fawzi]
      97             : !> \author Fawzi Mohamed
      98             : ! **************************************************************************************************
      99       22216 :    SUBROUTINE fm_pool_create(pool, el_struct)
     100             :       TYPE(cp_fm_pool_type), POINTER                     :: pool
     101             :       TYPE(cp_fm_struct_type), TARGET                    :: el_struct
     102             : 
     103       22216 :       ALLOCATE (pool)
     104       22216 :       pool%el_struct => el_struct
     105       22216 :       CALL cp_fm_struct_retain(pool%el_struct)
     106       22216 :       pool%ref_count = 1
     107             : 
     108       22216 :    END SUBROUTINE fm_pool_create
     109             : 
     110             : ! **************************************************************************************************
     111             : !> \brief retains the pool (see cp2k/doc/ReferenceCounting.html)
     112             : !> \param pool the pool to retain
     113             : !> \par History
     114             : !>      08.2002 created [fawzi]
     115             : !> \author Fawzi Mohamed
     116             : ! **************************************************************************************************
     117        2841 :    SUBROUTINE fm_pool_retain(pool)
     118             :       TYPE(cp_fm_pool_type), INTENT(INOUT)               :: pool
     119             : 
     120        2841 :       CPASSERT(pool%ref_count > 0)
     121             : 
     122        2841 :       pool%ref_count = pool%ref_count + 1
     123        2841 :    END SUBROUTINE fm_pool_retain
     124             : 
     125             : ! **************************************************************************************************
     126             : !> \brief deallocates all the cached elements
     127             : !> \param pool the pool to flush
     128             : !> \par History
     129             : !>      08.2002 created [fawzi]
     130             : !> \author Fawzi Mohamed
     131             : ! **************************************************************************************************
     132       22216 :    SUBROUTINE fm_pool_flush_cache(pool)
     133             :       TYPE(cp_fm_pool_type), INTENT(IN)                  :: pool
     134             : 
     135             :       TYPE(cp_fm_type), POINTER                          :: el_att
     136             :       TYPE(cp_sll_fm_type), POINTER                      :: iterator
     137             : 
     138       22216 :       iterator => pool%cache
     139       46126 :       DO
     140       68342 :          IF (.NOT. cp_sll_fm_next(iterator, el_att=el_att)) EXIT
     141       46126 :          CALL cp_fm_release(el_att)
     142       46126 :          DEALLOCATE (el_att)
     143       22216 :          NULLIFY (el_att)
     144             :       END DO
     145       22216 :       CALL cp_sll_fm_dealloc(pool%cache)
     146       22216 :    END SUBROUTINE fm_pool_flush_cache
     147             : 
     148             : ! **************************************************************************************************
     149             : !> \brief releases the given pool (see cp2k/doc/ReferenceCounting.html)
     150             : !> \param pool the pool to release
     151             : !> \par History
     152             : !>      08.2002 created [fawzi]
     153             : !> \author Fawzi Mohamed
     154             : ! **************************************************************************************************
     155       48928 :    SUBROUTINE fm_pool_release(pool)
     156             :       TYPE(cp_fm_pool_type), POINTER                     :: pool
     157             : 
     158       48928 :       IF (ASSOCIATED(pool)) THEN
     159       25057 :          CPASSERT(pool%ref_count > 0)
     160       25057 :          pool%ref_count = pool%ref_count - 1
     161       25057 :          IF (pool%ref_count == 0) THEN
     162       22216 :             pool%ref_count = 1
     163       22216 :             CALL fm_pool_flush_cache(pool)
     164       22216 :             CALL cp_fm_struct_release(pool%el_struct)
     165       22216 :             pool%ref_count = 0
     166             : 
     167       22216 :             DEALLOCATE (pool)
     168             :          END IF
     169             :       END IF
     170       48928 :       NULLIFY (pool)
     171       48928 :    END SUBROUTINE fm_pool_release
     172             : 
     173             : ! **************************************************************************************************
     174             : !> \brief returns an element, allocating it if none is in the pool
     175             : !> \param pool the pool from where you get the element
     176             : !> \param element will contain the new element
     177             : !>\param name the name for the new matrix (optional)
     178             : !> \param name ...
     179             : !> \par History
     180             : !>      08.2002 created [fawzi]
     181             : !> \author Fawzi Mohamed
     182             : ! **************************************************************************************************
     183       98058 :    SUBROUTINE fm_pool_create_fm(pool, element, &
     184             :                                 name)
     185             :       TYPE(cp_fm_pool_type), INTENT(IN)                  :: pool
     186             :       TYPE(cp_fm_type), INTENT(OUT)                      :: element
     187             :       CHARACTER(len=*), INTENT(in), OPTIONAL             :: name
     188             : 
     189             :       TYPE(cp_fm_type), POINTER                          :: el
     190             : 
     191       98058 :       NULLIFY (el)
     192       98058 :       IF (ASSOCIATED(pool%cache)) THEN
     193       20144 :          el => cp_sll_fm_get_first_el(pool%cache)
     194       20144 :          CALL cp_sll_fm_rm_first_el(pool%cache)
     195             :       END IF
     196       20144 :       IF (ASSOCIATED(el)) THEN
     197       20144 :          element = el
     198       20144 :          DEALLOCATE (el)
     199             :       ELSE
     200       77914 :          CALL cp_fm_create(element, matrix_struct=pool%el_struct)
     201             :       END IF
     202             : 
     203       98058 :       IF (PRESENT(name)) THEN
     204       27518 :          element%name = name
     205             :       ELSE
     206       70540 :          element%name = "tmp"
     207             :       END IF
     208             : 
     209       98058 :    END SUBROUTINE fm_pool_create_fm
     210             : 
     211             : ! **************************************************************************************************
     212             : !> \brief returns the element to the pool
     213             : !> \param pool the pool where to cache the element
     214             : !> \param element the element to give back
     215             : !> \par History
     216             : !>      08.2002 created [fawzi]
     217             : !> \author Fawzi Mohamed
     218             : !> \note
     219             : !>      transfers the ownership of the element to the pool
     220             : !>      (it is as if you had called cp_fm_release)
     221             : !>      Accept give_backs of non associated elements?
     222             : ! **************************************************************************************************
     223       66270 :    SUBROUTINE fm_pool_give_back_fm(pool, element)
     224             :       TYPE(cp_fm_pool_type), INTENT(IN)                  :: pool
     225             :       TYPE(cp_fm_type), INTENT(INOUT)                    :: element
     226             : 
     227       66270 :       IF (.NOT. ASSOCIATED(pool%el_struct, element%matrix_struct)) THEN
     228           0 :          CALL cp_fm_release(element)
     229             :       ELSE
     230             :          BLOCK
     231             :             TYPE(cp_fm_type), POINTER :: el
     232       66270 :             ALLOCATE (el)
     233       66270 :             el = element
     234       66270 :             CALL cp_sll_fm_insert_el(pool%cache, el=el)
     235       66270 :             NULLIFY (element%matrix_struct, element%local_data, element%local_data_sp)
     236             :          END BLOCK
     237             :       END IF
     238       66270 :    END SUBROUTINE fm_pool_give_back_fm
     239             : 
     240             : ! **************************************************************************************************
     241             : !> \brief returns the structure of the elements in this pool
     242             : !> \param pool the pool you are interested in
     243             : !> \return ...
     244             : !> \par History
     245             : !>      05.2002 created [fawzi]
     246             : !> \author Fawzi Mohamed
     247             : ! **************************************************************************************************
     248       18829 :    FUNCTION fm_pool_get_el_struct(pool) RESULT(res)
     249             :       TYPE(cp_fm_pool_type), INTENT(IN)                  :: pool
     250             :       TYPE(cp_fm_struct_type), POINTER                   :: res
     251             : 
     252       18829 :       res => pool%el_struct
     253       18829 :    END FUNCTION fm_pool_get_el_struct
     254             : 
     255             : !================== pools ================
     256             : 
     257             : ! **************************************************************************************************
     258             : !> \brief shallow copy of an array of pools (retains each pool)
     259             : !> \param source_pools the pools to copy
     260             : !> \param target_pools will contains the new pools
     261             : !> \par History
     262             : !>      11.2002 created [fawzi]
     263             : !> \author Fawzi Mohamed
     264             : ! **************************************************************************************************
     265           0 :    SUBROUTINE fm_pools_copy(source_pools, target_pools)
     266             :       TYPE(cp_fm_pool_p_type), DIMENSION(:), POINTER     :: source_pools, target_pools
     267             : 
     268             :       INTEGER                                            :: i
     269             : 
     270           0 :       CPASSERT(ASSOCIATED(source_pools))
     271           0 :       ALLOCATE (target_pools(SIZE(source_pools)))
     272           0 :       DO i = 1, SIZE(source_pools)
     273           0 :          target_pools(i)%pool => source_pools(i)%pool
     274           0 :          CALL fm_pool_retain(source_pools(i)%pool)
     275             :       END DO
     276           0 :    END SUBROUTINE fm_pools_copy
     277             : 
     278             : ! **************************************************************************************************
     279             : !> \brief deallocate an array of pools (releasing each pool)
     280             : !> \param pools the pools to release
     281             : !> \par History
     282             : !>      11.2002 created [fawzi]
     283             : !> \author Fawzi Mohamed
     284             : ! **************************************************************************************************
     285       19380 :    SUBROUTINE fm_pools_dealloc(pools)
     286             :       TYPE(cp_fm_pool_p_type), DIMENSION(:), POINTER     :: pools
     287             : 
     288             :       INTEGER                                            :: i
     289             : 
     290       19380 :       IF (ASSOCIATED(pools)) THEN
     291       43251 :          DO i = 1, SIZE(pools)
     292       43251 :             CALL fm_pool_release(pools(i)%pool)
     293             :          END DO
     294       19380 :          DEALLOCATE (pools)
     295             :       END IF
     296       19380 :    END SUBROUTINE fm_pools_dealloc
     297             : 
     298             :    #:mute
     299             :       #:set types = [("cp_fm_type", "array", ""), ("cp_fm_p_type", "p_type","%matrix")]
     300             :       #:set attributes = [("ALLOCATABLE", "alloc", "ALLOCATED"), ("POINTER", "pointer", "ASSOCIATED")]
     301             :    #:endmute
     302             : 
     303             :    #:for typename, shortname, appendix in types
     304             :       #:for attr, shortattr, create in attributes
     305             : ! **************************************************************************************************
     306             : !> \brief Returns a vector with an element from each pool
     307             : !> \param pools the pools to create the elements from
     308             : !> \param elements will contain the vector of elements
     309             : !> \param name the name for the new matrixes (optional)
     310             : !> \par History
     311             : !>      09.2002 created [fawzi]
     312             : !> \author Fawzi Mohamed
     313             : ! **************************************************************************************************
     314       14206 :          SUBROUTINE fm_pools_create_fm_m1_${shortname}$_${shortattr}$ (pools, elements, &
     315             :                                                                        name)
     316             :             TYPE(cp_fm_pool_p_type), DIMENSION(:), INTENT(IN)  :: pools
     317             :             TYPE(${typename}$), DIMENSION(:), ${attr}$          :: elements
     318             :             CHARACTER(len=*), INTENT(in), OPTIONAL             :: name
     319             : 
     320             :             INTEGER                                            :: i
     321             :             TYPE(cp_fm_pool_type), POINTER                     :: pool
     322             : 
     323       14206 :             NULLIFY (pool)
     324             : 
     325       59441 :             ALLOCATE (elements(SIZE(pools)))
     326       31029 :             DO i = 1, SIZE(pools)
     327       16823 :                pool => pools(i)%pool
     328             :                #:if typename=="cp_fm_p_type"
     329           0 :                   ALLOCATE (elements(i)%matrix)
     330             :                #:endif
     331       31029 :                IF (PRESENT(name)) THEN
     332             :                   CALL fm_pool_create_fm(pool, elements(i) ${appendix}$, &
     333       16823 :                                          name=name//"-"//ADJUSTL(cp_to_string(i)))
     334             :                ELSE
     335           0 :                   CALL fm_pool_create_fm(pool, elements(i) ${appendix}$)
     336             :                END IF
     337             : 
     338             :             END DO
     339             : 
     340       14206 :          END SUBROUTINE fm_pools_create_fm_m1_${shortname}$_${shortattr}$
     341             : 
     342             : ! **************************************************************************************************
     343             : !> \brief returns a vector to the pools. The vector is deallocated
     344             : !>      (like cp_fm_vect_dealloc)
     345             : !> \param pools the pool where to give back the vector
     346             : !> \param elements the vector of elements to give back
     347             : !> \par History
     348             : !>      09.2002 created [fawzi]
     349             : !> \author Fawzi Mohamed
     350             : !> \note
     351             : !>      accept unassociated vect?
     352             : ! **************************************************************************************************
     353         688 :          SUBROUTINE fm_pools_give_back_fm_m1_${shortname}$_${shortattr}$ (pools, elements)
     354             :             TYPE(cp_fm_pool_p_type), DIMENSION(:), INTENT(IN)  :: pools
     355             :             TYPE(${typename}$), DIMENSION(:), ${attr}$         :: elements
     356             : 
     357             :             INTEGER                                            :: i
     358             : 
     359         688 :             IF (${create}$ (elements)) THEN
     360         114 :                CPASSERT(SIZE(pools) == SIZE(elements))
     361         294 :                DO i = 1, SIZE(pools)
     362             :                   CALL fm_pool_give_back_fm(pools(i)%pool, &
     363         294 :                                             elements(i) ${appendix}$)
     364             :                   #:if typename == "cp_fm_p_type"
     365           0 :                      DEALLOCATE (elements(i)%matrix)
     366             :                   #:endif
     367             :                END DO
     368         114 :                DEALLOCATE (elements)
     369             :                #:if attr == "POINTER"
     370             :                   NULLIFY (elements)
     371             :                #:endif
     372             :             END IF
     373         688 :          END SUBROUTINE fm_pools_give_back_fm_m1_${shortname}$_${shortattr}$
     374             :       #:endfor
     375             :    #:endfor
     376             : 
     377           0 : END MODULE cp_fm_pool_types

Generated by: LCOV version 1.15