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 qs_fb_trial_fns_types
       9             : 
      10             : #include "./base/base_uses.f90"
      11             :    IMPLICIT NONE
      12             : 
      13             :    PRIVATE
      14             : 
      15             : ! public types
      16             :    PUBLIC :: fb_trial_fns_obj
      17             : 
      18             : ! public methods
      19             : !API
      20             :    PUBLIC :: fb_trial_fns_retain, &
      21             :              fb_trial_fns_release, &
      22             :              fb_trial_fns_nullify, &
      23             :              fb_trial_fns_associate, &
      24             :              fb_trial_fns_has_data, &
      25             :              fb_trial_fns_create, &
      26             :              fb_trial_fns_get, &
      27             :              fb_trial_fns_set
      28             : 
      29             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_fb_trial_fns_types'
      30             : 
      31             : ! **************************************************************************************************
      32             : !> \brief data containing information on trial functions used by filter
      33             : !>        matrix diagonalisation method
      34             : !> \param nfunctions : nfunctions(ikind) = number of trial functions for
      35             : !>                     atomic kind ikind
      36             : !> \param functions  : functions(itrial,ikind) = the index of the
      37             : !>                     GTO atomic orbital corresponding to itrial-th trial
      38             : !>                     function for kind ikind
      39             : !> \param ref_count  : reference counter for the object
      40             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
      41             : ! **************************************************************************************************
      42             :    TYPE fb_trial_fns_data
      43             :       INTEGER :: ref_count
      44             :       INTEGER, DIMENSION(:), POINTER :: nfunctions
      45             :       INTEGER, DIMENSION(:, :), POINTER :: functions
      46             :    END TYPE fb_trial_fns_data
      47             : 
      48             : ! **************************************************************************************************
      49             : !> \brief the object container which allows for the creation of an array
      50             : !>        of pointers to fb_trial_fns objects
      51             : !> \param obj : pointer to the fb_trial_fns object
      52             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
      53             : ! **************************************************************************************************
      54             :    TYPE fb_trial_fns_obj
      55             :       TYPE(fb_trial_fns_data), POINTER, PRIVATE :: obj
      56             :    END TYPE fb_trial_fns_obj
      57             : 
      58             : CONTAINS
      59             : 
      60             : ! **************************************************************************************************
      61             : !> \brief retains given object
      62             : !> \brief ...
      63             : !> \param trial_fns : the fb_trial_fns object in question
      64             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
      65             : ! **************************************************************************************************
      66          80 :    SUBROUTINE fb_trial_fns_retain(trial_fns)
      67             :       ! note INTENT(IN) is okay because the obj pointer contained in the
      68             :       ! obj type will not be changed
      69             :       TYPE(fb_trial_fns_obj), INTENT(IN)                 :: trial_fns
      70             : 
      71          80 :       CPASSERT(ASSOCIATED(trial_fns%obj))
      72          80 :       CPASSERT(trial_fns%obj%ref_count > 0)
      73          80 :       trial_fns%obj%ref_count = trial_fns%obj%ref_count + 1
      74          80 :    END SUBROUTINE fb_trial_fns_retain
      75             : 
      76             : ! **************************************************************************************************
      77             : !> \brief releases given object
      78             : !> \brief ...
      79             : !> \param trial_fns : the fb_trial_fns object in question
      80             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
      81             : ! **************************************************************************************************
      82         170 :    SUBROUTINE fb_trial_fns_release(trial_fns)
      83             :       TYPE(fb_trial_fns_obj), INTENT(INOUT)              :: trial_fns
      84             : 
      85         170 :       IF (ASSOCIATED(trial_fns%obj)) THEN
      86         160 :          CPASSERT(trial_fns%obj%ref_count > 0)
      87         160 :          trial_fns%obj%ref_count = trial_fns%obj%ref_count - 1
      88         160 :          IF (trial_fns%obj%ref_count == 0) THEN
      89          80 :             trial_fns%obj%ref_count = 1
      90          80 :             IF (ASSOCIATED(trial_fns%obj%nfunctions)) THEN
      91          80 :                DEALLOCATE (trial_fns%obj%nfunctions)
      92             :             END IF
      93          80 :             IF (ASSOCIATED(trial_fns%obj%functions)) THEN
      94          80 :                DEALLOCATE (trial_fns%obj%functions)
      95             :             END IF
      96          80 :             trial_fns%obj%ref_count = 0
      97          80 :             DEALLOCATE (trial_fns%obj)
      98             :          END IF
      99             :       ELSE
     100          10 :          NULLIFY (trial_fns%obj)
     101             :       END IF
     102         170 :    END SUBROUTINE fb_trial_fns_release
     103             : 
     104             : ! **************************************************************************************************
     105             : !> \brief nullifies the content of given object
     106             : !> \param trial_fns : the fb_trial_fns object in question
     107             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     108             : ! **************************************************************************************************
     109         170 :    SUBROUTINE fb_trial_fns_nullify(trial_fns)
     110             :       TYPE(fb_trial_fns_obj), INTENT(INOUT)              :: trial_fns
     111             : 
     112         170 :       NULLIFY (trial_fns%obj)
     113         170 :    END SUBROUTINE fb_trial_fns_nullify
     114             : 
     115             : ! **************************************************************************************************
     116             : !> \brief associates the content of an object to that of another object
     117             : !>        of the same type
     118             : !> \param a : the output object
     119             : !> \param b : the input object
     120             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     121             : ! **************************************************************************************************
     122         160 :    SUBROUTINE fb_trial_fns_associate(a, b)
     123             :       TYPE(fb_trial_fns_obj), INTENT(OUT)                :: a
     124             :       TYPE(fb_trial_fns_obj), INTENT(IN)                 :: b
     125             : 
     126         160 :       a%obj => b%obj
     127         160 :    END SUBROUTINE fb_trial_fns_associate
     128             : 
     129             : ! **************************************************************************************************
     130             : !> \brief check if the object has data associated to it
     131             : !> \param trial_fns : the fb_trial_fns object in question
     132             : !> \return : true if trial_fns%obj is associated, false otherwise
     133             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     134             : ! **************************************************************************************************
     135          80 :    FUNCTION fb_trial_fns_has_data(trial_fns) RESULT(res)
     136             :       TYPE(fb_trial_fns_obj), INTENT(IN)                 :: trial_fns
     137             :       LOGICAL                                            :: res
     138             : 
     139          80 :       res = ASSOCIATED(trial_fns%obj)
     140          80 :    END FUNCTION fb_trial_fns_has_data
     141             : 
     142             : ! **************************************************************************************************
     143             : !> \brief creates an fb_trial_fns object and initialises it
     144             : !> \param trial_fns : the fb_trial_fns object in question
     145             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     146             : ! **************************************************************************************************
     147          80 :    SUBROUTINE fb_trial_fns_create(trial_fns)
     148             :       TYPE(fb_trial_fns_obj), INTENT(INOUT)              :: trial_fns
     149             : 
     150          80 :       CPASSERT(.NOT. ASSOCIATED(trial_fns%obj))
     151          80 :       ALLOCATE (trial_fns%obj)
     152          80 :       NULLIFY (trial_fns%obj%nfunctions)
     153          80 :       NULLIFY (trial_fns%obj%functions)
     154          80 :       trial_fns%obj%ref_count = 1
     155          80 :    END SUBROUTINE fb_trial_fns_create
     156             : 
     157             : ! **************************************************************************************************
     158             : !> \brief initialises an fb_trial_fns object
     159             : !> \param trial_fns : the fb_trial_fns object in question
     160             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     161             : ! **************************************************************************************************
     162           0 :    SUBROUTINE fb_trial_fns_init(trial_fns)
     163             :       TYPE(fb_trial_fns_obj), INTENT(INOUT)              :: trial_fns
     164             : 
     165           0 :       CPASSERT(ASSOCIATED(trial_fns%obj))
     166             :       ! if halo_atoms are associated, then deallocate and de-associate
     167           0 :       IF (ASSOCIATED(trial_fns%obj%nfunctions)) THEN
     168           0 :          DEALLOCATE (trial_fns%obj%nfunctions)
     169             :       END IF
     170           0 :       IF (ASSOCIATED(trial_fns%obj%functions)) THEN
     171           0 :          DEALLOCATE (trial_fns%obj%functions)
     172             :       END IF
     173           0 :    END SUBROUTINE fb_trial_fns_init
     174             : 
     175             : ! **************************************************************************************************
     176             : !> \brief get values of the attributes of a fb_trial_fns object
     177             : !> \param trial_fns  : the fb_trial_fns object in question
     178             : !> \param nfunctions : outputs pointer to trial_fns%obj%nfunctions
     179             : !> \param functions  : outputs pointer to trial_fns%obj%functions
     180             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     181             : ! **************************************************************************************************
     182         400 :    SUBROUTINE fb_trial_fns_get(trial_fns, &
     183             :                                nfunctions, &
     184             :                                functions)
     185             :       TYPE(fb_trial_fns_obj), INTENT(IN)                 :: trial_fns
     186             :       INTEGER, DIMENSION(:), OPTIONAL, POINTER           :: nfunctions
     187             :       INTEGER, DIMENSION(:, :), OPTIONAL, POINTER        :: functions
     188             : 
     189         400 :       CPASSERT(ASSOCIATED(trial_fns%obj))
     190         400 :       IF (PRESENT(nfunctions)) nfunctions => trial_fns%obj%nfunctions
     191         400 :       IF (PRESENT(functions)) functions => trial_fns%obj%functions
     192         400 :    END SUBROUTINE fb_trial_fns_get
     193             : 
     194             : ! **************************************************************************************************
     195             : !> \brief sets the attributes of a fb_trial_fns object
     196             : !> \param trial_fns  : the fb_trial_fns object in question
     197             : !> \param nfunctions : associates trial_fns%obj%nfunctions to this pointer
     198             : !> \param functions  : associates trial_fns%obj%nfunctions to this pointer
     199             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     200             : ! **************************************************************************************************
     201          80 :    SUBROUTINE fb_trial_fns_set(trial_fns, &
     202             :                                nfunctions, &
     203             :                                functions)
     204             :       TYPE(fb_trial_fns_obj), INTENT(INOUT)              :: trial_fns
     205             :       INTEGER, DIMENSION(:), OPTIONAL, POINTER           :: nfunctions
     206             :       INTEGER, DIMENSION(:, :), OPTIONAL, POINTER        :: functions
     207             : 
     208          80 :       CPASSERT(ASSOCIATED(trial_fns%obj))
     209          80 :       IF (PRESENT(nfunctions)) THEN
     210          80 :          IF (ASSOCIATED(trial_fns%obj%nfunctions)) THEN
     211           0 :             DEALLOCATE (trial_fns%obj%nfunctions)
     212             :          END IF
     213          80 :          trial_fns%obj%nfunctions => nfunctions
     214             :       END IF
     215          80 :       IF (PRESENT(functions)) THEN
     216          80 :          IF (ASSOCIATED(trial_fns%obj%functions)) THEN
     217           0 :             DEALLOCATE (trial_fns%obj%functions)
     218             :          END IF
     219          80 :          trial_fns%obj%functions => functions
     220             :       END IF
     221          80 :    END SUBROUTINE fb_trial_fns_set
     222             : 
     223           0 : END MODULE qs_fb_trial_fns_types