LCOV - code coverage report
Current view: top level - src/aobasis - basis_set_container_types.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:4079a9e) Lines: 69 80 86.2 %
Date: 2024-09-19 07:03:30 Functions: 5 6 83.3 %

          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             : !> \par History
      10             : !>      - Container to hold basis sets
      11             : !> \author JGH (09.07.2015)
      12             : ! **************************************************************************************************
      13             : MODULE basis_set_container_types
      14             : 
      15             :    USE basis_set_types,                 ONLY: deallocate_gto_basis_set,&
      16             :                                               gto_basis_set_type
      17             :    USE kinds,                           ONLY: default_string_length
      18             : #include "../base/base_uses.f90"
      19             : 
      20             :    IMPLICIT NONE
      21             : 
      22             :    PRIVATE
      23             : 
      24             :    ! Global parameters (only in this module)
      25             : 
      26             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'basis_set_container_types'
      27             : 
      28             : ! **************************************************************************************************
      29             :    INTEGER, PARAMETER                       :: unknown_basis = 100, &
      30             :                                                orbital_basis = 101, &
      31             :                                                auxiliary_basis = 102, &
      32             :                                                ri_aux_basis = 103, &
      33             :                                                lri_aux_basis = 104, &
      34             :                                                aux_fit_basis = 105, &
      35             :                                                soft_basis = 106, &
      36             :                                                gapw_1c_basis = 107, &
      37             :                                                mao_basis = 108, &
      38             :                                                harris_basis = 109, &
      39             :                                                aux_gw_basis = 110, &
      40             :                                                ri_hxc_basis = 111, &
      41             :                                                ri_k_basis = 112, &
      42             :                                                ri_xas_basis = 113, &
      43             :                                                aux_fit_soft_basis = 114, &
      44             :                                                ri_hfx_basis = 115, &
      45             :                                                p_lri_aux_basis = 116, &
      46             :                                                aux_opt_basis = 117, &
      47             :                                                min_basis = 118, &
      48             :                                                tda_k_basis = 119, &
      49             :                                                rhoin_basis = 120
      50             : ! **************************************************************************************************
      51             :    TYPE basis_set_container_type
      52             :       PRIVATE
      53             :       CHARACTER(LEN=default_string_length)       :: basis_type = ""
      54             :       INTEGER                                    :: basis_type_nr = 0
      55             :       TYPE(gto_basis_set_type), POINTER          :: basis_set => NULL()
      56             :    END TYPE basis_set_container_type
      57             : ! **************************************************************************************************
      58             : 
      59             :    PUBLIC :: basis_set_container_type
      60             : 
      61             :    PUBLIC :: remove_basis_set_container, &
      62             :              add_basis_set_to_container, get_basis_from_container, &
      63             :              remove_basis_from_container
      64             : 
      65             : ! **************************************************************************************************
      66             : 
      67             : CONTAINS
      68             : 
      69             : ! **************************************************************************************************
      70             : !> \brief ...
      71             : !> \param basis ...
      72             : ! **************************************************************************************************
      73       12787 :    SUBROUTINE remove_basis_set_container(basis)
      74             :       TYPE(basis_set_container_type), DIMENSION(:), &
      75             :          INTENT(inout)                                   :: basis
      76             : 
      77             :       INTEGER                                            :: i
      78             : 
      79      268527 :       DO i = 1, SIZE(basis)
      80      255740 :          basis(i)%basis_type = ""
      81      255740 :          basis(i)%basis_type_nr = 0
      82      268527 :          IF (ASSOCIATED(basis(i)%basis_set)) THEN
      83       18824 :             CALL deallocate_gto_basis_set(basis(i)%basis_set)
      84             :          END IF
      85             :       END DO
      86             : 
      87       12787 :    END SUBROUTINE remove_basis_set_container
      88             : 
      89             : ! **************************************************************************************************
      90             : !> \brief ...
      91             : !> \param basis_set_type ...
      92             : !> \return ...
      93             : ! **************************************************************************************************
      94    14266798 :    FUNCTION get_basis_type(basis_set_type) RESULT(basis_type_nr)
      95             :       CHARACTER(len=*)                                   :: basis_set_type
      96             :       INTEGER                                            :: basis_type_nr
      97             : 
      98             :       SELECT CASE (basis_set_type)
      99             :       CASE ("ORB")
     100      113348 :          basis_type_nr = orbital_basis
     101             :       CASE ("AUX")
     102      113348 :          basis_type_nr = auxiliary_basis
     103             :       CASE ("MIN")
     104       16756 :          basis_type_nr = min_basis
     105             :       CASE ("RI_AUX")
     106     4044172 :          basis_type_nr = ri_aux_basis
     107             :       CASE ("RI_HXC")
     108       73840 :          basis_type_nr = ri_hxc_basis
     109             :       CASE ("RI_HFX")
     110       13040 :          basis_type_nr = ri_hfx_basis
     111             :       CASE ("RI_K")
     112       51114 :          basis_type_nr = ri_k_basis
     113             :       CASE ("LRI_AUX")
     114       78586 :          basis_type_nr = lri_aux_basis
     115             :       CASE ("P_LRI_AUX")
     116       17726 :          basis_type_nr = p_lri_aux_basis
     117             :       CASE ("AUX_FIT")
     118      175722 :          basis_type_nr = aux_fit_basis
     119             :       CASE ("AUX_FIT_SOFT")
     120        6318 :          basis_type_nr = aux_fit_soft_basis
     121             :       CASE ("ORB_SOFT")
     122       42850 :          basis_type_nr = soft_basis
     123             :       CASE ("GAPW_1C")
     124     2166206 :          basis_type_nr = gapw_1c_basis
     125             :       CASE ("TDA_HFX")
     126       16522 :          basis_type_nr = tda_k_basis
     127             :       CASE ("MAO")
     128      118830 :          basis_type_nr = mao_basis
     129             :       CASE ("HARRIS")
     130      136720 :          basis_type_nr = harris_basis
     131             :       CASE ("AUX_GW")
     132       24194 :          basis_type_nr = aux_gw_basis
     133             :       CASE ("RI_XAS")
     134       17564 :          basis_type_nr = ri_xas_basis
     135             :       CASE ("AUX_OPT")
     136       20066 :          basis_type_nr = aux_opt_basis
     137             :       CASE ("RHOIN")
     138       67808 :          basis_type_nr = rhoin_basis
     139             :       CASE DEFAULT
     140    14266798 :          basis_type_nr = unknown_basis
     141             :       END SELECT
     142             : 
     143    14266798 :    END FUNCTION get_basis_type
     144             : 
     145             : ! **************************************************************************************************
     146             : !> \brief ...
     147             : !> \param container ...
     148             : !> \param basis_set ...
     149             : !> \param basis_set_type ...
     150             : ! **************************************************************************************************
     151       37664 :    SUBROUTINE add_basis_set_to_container(container, basis_set, basis_set_type)
     152             :       TYPE(basis_set_container_type), DIMENSION(:), &
     153             :          INTENT(inout)                                   :: container
     154             :       TYPE(gto_basis_set_type), POINTER                  :: basis_set
     155             :       CHARACTER(len=*)                                   :: basis_set_type
     156             : 
     157             :       INTEGER                                            :: i
     158             :       LOGICAL                                            :: success
     159             : 
     160       18832 :       success = .FALSE.
     161       28741 :       DO i = 1, SIZE(container)
     162       28741 :          IF (container(i)%basis_type_nr == 0) THEN
     163       18832 :             container(i)%basis_type = basis_set_type
     164       18832 :             container(i)%basis_set => basis_set
     165       18832 :             container(i)%basis_type_nr = get_basis_type(basis_set_type)
     166             :             success = .TRUE.
     167             :             EXIT
     168             :          END IF
     169             :       END DO
     170           0 :       CPASSERT(success)
     171             : 
     172       18832 :    END SUBROUTINE add_basis_set_to_container
     173             : 
     174             : ! **************************************************************************************************
     175             : !> \brief ...
     176             : !> \param container ...
     177             : !> \param inum ...
     178             : !> \param basis_type ...
     179             : ! **************************************************************************************************
     180        1928 :    SUBROUTINE remove_basis_from_container(container, inum, basis_type)
     181             :       TYPE(basis_set_container_type), DIMENSION(:), &
     182             :          INTENT(inout)                                   :: container
     183             :       INTEGER, INTENT(IN), OPTIONAL                      :: inum
     184             :       CHARACTER(len=*), OPTIONAL                         :: basis_type
     185             : 
     186             :       INTEGER                                            :: basis_nr, i, ibas
     187             : 
     188        1928 :       IF (PRESENT(inum)) THEN
     189           0 :          CPASSERT(inum <= SIZE(container))
     190           0 :          CPASSERT(inum >= 1)
     191             :          ibas = inum
     192        1928 :       ELSE IF (PRESENT(basis_type)) THEN
     193        1928 :          basis_nr = get_basis_type(basis_type)
     194        1928 :          ibas = 0
     195       40336 :          DO i = 1, SIZE(container)
     196       40336 :             IF (container(i)%basis_type_nr == basis_nr) THEN
     197             :                ibas = i
     198             :                EXIT
     199             :             END IF
     200             :          END DO
     201             :       ELSE
     202           0 :          CPABORT("")
     203             :       END IF
     204             :       !
     205        1928 :       IF (ibas /= 0) THEN
     206           8 :          container(ibas)%basis_type = ""
     207           8 :          container(ibas)%basis_type_nr = 0
     208           8 :          IF (ASSOCIATED(container(ibas)%basis_set)) THEN
     209           8 :             CALL deallocate_gto_basis_set(container(ibas)%basis_set)
     210             :          END IF
     211             :          ! shift other basis sets
     212         152 :          DO i = ibas + 1, SIZE(container)
     213         144 :             IF (container(i)%basis_type_nr == 0) CYCLE
     214           0 :             container(i - 1)%basis_type = container(i)%basis_type
     215           0 :             container(i - 1)%basis_set => container(i)%basis_set
     216           0 :             container(i - 1)%basis_type_nr = container(i)%basis_type_nr
     217           0 :             container(i)%basis_type = ""
     218           0 :             container(i)%basis_type_nr = 0
     219         152 :             NULLIFY (container(i)%basis_set)
     220             :          END DO
     221             :       END IF
     222             : 
     223        1928 :    END SUBROUTINE remove_basis_from_container
     224             : 
     225             : ! **************************************************************************************************
     226             : !> \brief Retrieve a basis set from the container
     227             : !> \param container ...
     228             : !> \param basis_set ...
     229             : !> \param inumbas ...
     230             : !> \param basis_type ...
     231             : ! **************************************************************************************************
     232    30308014 :    SUBROUTINE get_basis_from_container(container, basis_set, inumbas, basis_type)
     233             :       TYPE(basis_set_container_type), DIMENSION(:), &
     234             :          INTENT(inout)                                   :: container
     235             :       TYPE(gto_basis_set_type), POINTER                  :: basis_set
     236             :       INTEGER, OPTIONAL                                  :: inumbas
     237             :       CHARACTER(len=*), OPTIONAL                         :: basis_type
     238             : 
     239             :       INTEGER                                            :: basis_nr, i
     240             : 
     241    15154007 :       IF (PRESENT(inumbas)) THEN
     242      907969 :          CPASSERT(inumbas <= SIZE(container))
     243      907969 :          CPASSERT(inumbas >= 1)
     244      907969 :          basis_set => container(inumbas)%basis_set
     245      907969 :          IF (PRESENT(basis_type)) THEN
     246      907969 :             basis_type = container(inumbas)%basis_type
     247             :          END IF
     248    14246038 :       ELSE IF (PRESENT(basis_type)) THEN
     249    14246038 :          NULLIFY (basis_set)
     250    14246038 :          basis_nr = get_basis_type(basis_type)
     251    44307661 :          DO i = 1, SIZE(container)
     252    44307661 :             IF (container(i)%basis_type_nr == basis_nr) THEN
     253    13187795 :                basis_set => container(i)%basis_set
     254    13187795 :                EXIT
     255             :             END IF
     256             :          END DO
     257             :       ELSE
     258           0 :          CPABORT("")
     259             :       END IF
     260             : 
     261    15154007 :    END SUBROUTINE get_basis_from_container
     262             : ! **************************************************************************************************
     263             : 
     264           0 : END MODULE basis_set_container_types

Generated by: LCOV version 1.15