LCOV - code coverage report
Current view: top level - src - submatrix_types.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:58e3e09) Lines: 74 83 89.2 %
Date: 2024-03-29 07:50:05 Functions: 12 21 57.1 %

          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             : MODULE submatrix_types
       9             : 
      10             :    USE kinds,                           ONLY: dp
      11             :    USE message_passing,                 ONLY: mp_request_null,&
      12             :                                               mp_request_type
      13             :    USE util,                            ONLY: sort
      14             : 
      15             :    IMPLICIT NONE
      16             :    PRIVATE
      17             : 
      18             :    INTEGER, PARAMETER                     :: extvec_alloc_factor = 2, extvec_initial_alloc = 32
      19             :    INTEGER, PARAMETER                     :: set_modulus = 257 ! determines the number of buckets, should be a prime
      20             : 
      21             :    TYPE :: extvec_type
      22             :       INTEGER, DIMENSION(:), ALLOCATABLE   :: darr
      23             :       INTEGER                              :: elements = 0, allocated = 0
      24             :    CONTAINS
      25             :       PROCEDURE :: insert => extvec_insert
      26             :       PROCEDURE :: reset => extvec_reset
      27             :    END TYPE extvec_type
      28             : 
      29             :    TYPE, PUBLIC :: set_type
      30             :       TYPE(extvec_type), DIMENSION(0:set_modulus - 1) :: data
      31             :       INTEGER, DIMENSION(:), ALLOCATABLE       :: sorted
      32             :       INTEGER                                  :: elements = 0
      33             :       LOGICAL                                  :: sorted_up_to_date = .FALSE.
      34             :    CONTAINS
      35             :       PROCEDURE :: insert => set_insert
      36             :       PROCEDURE :: reset => set_reset
      37             :       PROCEDURE :: find => set_find
      38             :       PROCEDURE :: get => set_get
      39             :       PROCEDURE :: getall => set_getall
      40             :       PROCEDURE :: update_sorted => set_update_sorted
      41             :    END TYPE set_type
      42             : 
      43             :    TYPE, PUBLIC :: intBuffer_type
      44             :       INTEGER, DIMENSION(:), POINTER                    :: data
      45             :       INTEGER                                           :: size = 0
      46             :       LOGICAL                                           :: allocated = .FALSE.
      47             :       TYPE(mp_request_type)                                           :: mpi_request = mp_request_null
      48             :    CONTAINS
      49             :       PROCEDURE :: alloc => intbuffer_alloc
      50             :       PROCEDURE :: dealloc => intbuffer_dealloc
      51             :    END TYPE intBuffer_type
      52             : 
      53             :    ! TODO: Make data type generic
      54             :    TYPE, PUBLIC :: buffer_type
      55             :       REAL(KIND=dp), DIMENSION(:), POINTER     :: data
      56             :       INTEGER                                           :: size = 0
      57             :       LOGICAL                                           :: allocated = .FALSE.
      58             :       TYPE(mp_request_type)                                           :: mpi_request = mp_request_null
      59             :    CONTAINS
      60             :       PROCEDURE :: alloc => buffer_alloc
      61             :       PROCEDURE :: dealloc => buffer_dealloc
      62             :    END TYPE buffer_type
      63             : 
      64             :    TYPE, PUBLIC :: bufptr_type
      65             :       REAL(KIND=dp), DIMENSION(:), POINTER :: target => NULL()
      66             :    END TYPE bufptr_type
      67             : 
      68             :    TYPE, PUBLIC :: setarray_type
      69             :       TYPE(set_type), DIMENSION(:), ALLOCATABLE :: sets
      70             :    END TYPE setarray_type
      71             : 
      72             : CONTAINS
      73             : 
      74             : ! **************************************************************************************************
      75             : !> \brief insert element into extendable vector
      76             : !> \param this - instance of extvec_type
      77             : !> \param elem - element to insert
      78             : ! **************************************************************************************************
      79          93 :    PURE SUBROUTINE extvec_insert(this, elem)
      80             :       CLASS(extvec_type), INTENT(INOUT)       :: this
      81             :       INTEGER, INTENT(IN)                     :: elem
      82          93 :       INTEGER, DIMENSION(:), ALLOCATABLE      :: tmp
      83             : 
      84          93 :       IF (this%allocated .EQ. 0) THEN
      85          93 :          this%allocated = extvec_initial_alloc
      86          93 :          ALLOCATE (this%darr(this%allocated))
      87             :       ELSE
      88           0 :          IF (this%elements .EQ. this%allocated) THEN
      89           0 :             ALLOCATE (tmp(this%allocated))
      90           0 :             tmp(:) = this%darr
      91           0 :             DEALLOCATE (this%darr)
      92           0 :             ALLOCATE (this%darr(this%allocated*extvec_alloc_factor))
      93           0 :             this%darr(1:this%allocated) = tmp
      94           0 :             DEALLOCATE (tmp)
      95           0 :             this%allocated = this%allocated*extvec_alloc_factor
      96             :          END IF
      97             :       END IF
      98             : 
      99          93 :       this%elements = this%elements + 1
     100          93 :       this%darr(this%elements) = elem
     101          93 :    END SUBROUTINE extvec_insert
     102             : 
     103             : ! **************************************************************************************************
     104             : !> \brief purge extendable vector and free allocated memory
     105             : !> \param this - instance of extvec_type
     106             : ! **************************************************************************************************
     107       54998 :    PURE SUBROUTINE extvec_reset(this)
     108             :       CLASS(extvec_type), INTENT(INOUT) :: this
     109             : 
     110       54998 :       IF (ALLOCATED(this%darr)) DEALLOCATE (this%darr)
     111       54998 :       this%allocated = 0
     112       54998 :       this%elements = 0
     113       54998 :    END SUBROUTINE extvec_reset
     114             : 
     115             : ! **************************************************************************************************
     116             : !> \brief insert element into set
     117             : !> \param this - instance of set_type
     118             : !> \param elem - element to insert
     119             : ! **************************************************************************************************
     120          93 :    PURE SUBROUTINE set_insert(this, elem)
     121             :       CLASS(set_type), INTENT(INOUT) :: this
     122             :       INTEGER, INTENT(IN)            :: elem
     123             : 
     124          93 :       IF (.NOT. this%find(elem)) THEN
     125          93 :          CALL this%data(MODULO(elem, set_modulus))%insert(elem)
     126          93 :          this%sorted_up_to_date = .FALSE.
     127          93 :          this%elements = this%elements + 1
     128             :       END IF
     129             : 
     130          93 :    END SUBROUTINE set_insert
     131             : 
     132             : ! **************************************************************************************************
     133             : !> \brief purse set and free allocated memory
     134             : !> \param this - instance of set_type
     135             : ! **************************************************************************************************
     136         214 :    PURE SUBROUTINE set_reset(this)
     137             :       CLASS(set_type), INTENT(INOUT) :: this
     138             :       INTEGER                        :: i
     139             : 
     140       55212 :       DO i = 0, set_modulus - 1
     141       55212 :          CALL this%data(i)%reset
     142             :       END DO
     143         214 :       IF (ALLOCATED(this%sorted)) DEALLOCATE (this%sorted)
     144         214 :       this%elements = 0
     145         214 :       this%sorted_up_to_date = .FALSE.
     146         214 :    END SUBROUTINE set_reset
     147             : 
     148             : ! **************************************************************************************************
     149             : !> \brief find element in set
     150             : !> \param this - instance of set_type
     151             : !> \param elem - element to look for
     152             : !> \return .TRUE. if element is contained in set, .FALSE. otherwise
     153             : ! **************************************************************************************************
     154          93 :    PURE FUNCTION set_find(this, elem) RESULT(found)
     155             :       CLASS(set_type), INTENT(IN)   :: this
     156             :       INTEGER, INTENT(IN)           :: elem
     157             :       LOGICAL                       :: found
     158             :       INTEGER                       :: i, idx
     159             : 
     160          93 :       found = .FALSE.
     161          93 :       idx = MODULO(elem, set_modulus)
     162             : 
     163          93 :       DO i = 1, this%data(idx)%elements
     164          93 :          IF (this%data(idx)%darr(i) .EQ. elem) THEN
     165             :             found = .TRUE.
     166             :             EXIT
     167             :          END IF
     168             :       END DO
     169             : 
     170          93 :    END FUNCTION set_find
     171             : 
     172             : ! **************************************************************************************************
     173             : !> \brief get element from specific position in set
     174             : !> \param this - instance of set_type
     175             : !> \param idx - position in set
     176             : !> \return element at position idx
     177             : ! **************************************************************************************************
     178         223 :    FUNCTION set_get(this, idx) RESULT(elem)
     179             :       CLASS(set_type), INTENT(INOUT) :: this
     180             :       INTEGER, INTENT(IN)            :: idx
     181             :       INTEGER                        :: elem
     182             : 
     183         223 :       IF (.NOT. this%sorted_up_to_date) CALL this%update_sorted
     184             : 
     185         223 :       elem = this%sorted(idx)
     186         223 :    END FUNCTION set_get
     187             : 
     188             : ! **************************************************************************************************
     189             : !> \brief get all elements in set as sorted list
     190             : !> \param this - instance of set_type
     191             : !> \return sorted array containing set elements
     192             : ! **************************************************************************************************
     193          20 :    FUNCTION set_getall(this) RESULT(darr)
     194             :       CLASS(set_type), INTENT(INOUT)           :: this
     195             :       INTEGER, DIMENSION(this%elements)        :: darr
     196             : 
     197          20 :       IF (.NOT. this%sorted_up_to_date) CALL this%update_sorted
     198             : 
     199          25 :       darr = this%sorted
     200          20 :    END FUNCTION set_getall
     201             : 
     202             : ! **************************************************************************************************
     203             : !> \brief update internal list of set elements
     204             : !> \param this - instance of extendable vector
     205             : ! **************************************************************************************************
     206         108 :    SUBROUTINE set_update_sorted(this)
     207             :       CLASS(set_type), INTENT(INOUT)     :: this
     208             :       INTEGER                            :: i, idx
     209         108 :       INTEGER, DIMENSION(:), ALLOCATABLE :: tmp
     210             : 
     211         108 :       IF (ALLOCATED(this%sorted)) DEALLOCATE (this%sorted)
     212         309 :       ALLOCATE (this%sorted(this%elements))
     213             : 
     214         108 :       idx = 1
     215       27864 :       DO i = 0, set_modulus - 1
     216       27864 :          IF (this%data(i)%elements .GT. 0) THEN
     217         186 :             this%sorted(idx:idx + this%data(i)%elements - 1) = this%data(i)%darr(1:this%data(i)%elements)
     218          93 :             idx = idx + this%data(i)%elements
     219             :          END IF
     220             :       END DO
     221             : 
     222         309 :       ALLOCATE (tmp(this%elements))
     223         108 :       CALL sort(this%sorted, this%elements, tmp)
     224         108 :       DEALLOCATE (tmp)
     225             : 
     226         108 :       this%sorted_up_to_date = .TRUE.
     227         108 :    END SUBROUTINE set_update_sorted
     228             : 
     229             : ! **************************************************************************************************
     230             : !> \brief allocate buffer
     231             : !> \param this - instance of buffer_type
     232             : !> \param elements - number of elements contained in buffer
     233             : ! **************************************************************************************************
     234          80 :    PURE SUBROUTINE buffer_alloc(this, elements)
     235             :       CLASS(buffer_type), INTENT(INOUT) :: this
     236             :       INTEGER, INTENT(IN)               :: elements
     237             : 
     238         180 :       ALLOCATE (this%data(elements))
     239          80 :       this%allocated = .TRUE.
     240          80 :       this%size = elements
     241          80 :    END SUBROUTINE buffer_alloc
     242             : 
     243             : ! **************************************************************************************************
     244             : !> \brief deallocate buffer
     245             : !> \param this - instance of buffer_type
     246             : ! **************************************************************************************************
     247          80 :    PURE SUBROUTINE buffer_dealloc(this)
     248             :       CLASS(buffer_type), INTENT(INOUT) :: this
     249             : 
     250          80 :       IF (this%allocated) DEALLOCATE (this%data)
     251          80 :       this%allocated = .FALSE.
     252          80 :       this%size = 0
     253          80 :    END SUBROUTINE buffer_dealloc
     254             : 
     255             : ! **************************************************************************************************
     256             : !> \brief allocate integer buffer
     257             : !> \param this - instance of intBuffer_type
     258             : !> \param elements - number of elements contained in buffer
     259             : ! **************************************************************************************************
     260          40 :    PURE SUBROUTINE intbuffer_alloc(this, elements)
     261             :       CLASS(intBuffer_type), INTENT(INOUT) :: this
     262             :       INTEGER, INTENT(IN)                  :: elements
     263             : 
     264          90 :       ALLOCATE (this%data(elements))
     265          40 :       this%allocated = .TRUE.
     266          40 :       this%size = elements
     267          40 :    END SUBROUTINE intbuffer_alloc
     268             : 
     269             : ! **************************************************************************************************
     270             : !> \brief deallocate integer buffer
     271             : !> \param this - instance of intBuffer_type
     272             : ! **************************************************************************************************
     273          40 :    PURE SUBROUTINE intbuffer_dealloc(this)
     274             :       CLASS(intBuffer_type), INTENT(INOUT) :: this
     275             : 
     276          40 :       IF (this%allocated) DEALLOCATE (this%data)
     277          40 :       this%allocated = .FALSE.
     278          40 :       this%size = 0
     279          40 :    END SUBROUTINE intbuffer_dealloc
     280             : 
     281           0 : END MODULE submatrix_types

Generated by: LCOV version 1.15