LCOV - code coverage report
Current view: top level - src - min_basis_set.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 84.9 % 119 101
Test Date: 2025-07-25 12:55:17 Functions: 100.0 % 2 2

            Line data    Source code
       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2025 CP2K developers group <https://cp2k.org>                                   !
       4              : !                                                                                                  !
       5              : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6              : !--------------------------------------------------------------------------------------------------!
       7              : 
       8              : ! **************************************************************************************************
       9              : !> \brief generate or use from input minimal basis set
      10              : !> \par History
      11              : !>      03.2023 created [JGH]
      12              : !> \author JGH
      13              : ! **************************************************************************************************
      14              : MODULE min_basis_set
      15              :    USE basis_set_container_types,       ONLY: add_basis_set_to_container
      16              :    USE basis_set_types,                 ONLY: &
      17              :         allocate_sto_basis_set, create_gto_from_sto_basis, create_primitive_basis_set, &
      18              :         deallocate_gto_basis_set, deallocate_sto_basis_set, get_gto_basis_set, gto_basis_set_type, &
      19              :         init_orb_basis_set, set_sto_basis_set, srules, sto_basis_set_type
      20              :    USE cp_control_types,                ONLY: dft_control_type
      21              :    USE kinds,                           ONLY: default_string_length,&
      22              :                                               dp
      23              :    USE periodic_table,                  ONLY: get_ptable_info,&
      24              :                                               ptable
      25              :    USE qs_environment_types,            ONLY: get_qs_env,&
      26              :                                               qs_environment_type
      27              :    USE qs_interactions,                 ONLY: init_interaction_radii_orb_basis
      28              :    USE qs_kind_types,                   ONLY: get_qs_kind,&
      29              :                                               qs_kind_type
      30              : #include "./base/base_uses.f90"
      31              : 
      32              :    IMPLICIT NONE
      33              :    PRIVATE
      34              : 
      35              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'min_basis_set'
      36              : 
      37              :    PUBLIC ::  create_minbas_set
      38              : 
      39              : ! **************************************************************************************************
      40              : 
      41              : CONTAINS
      42              : 
      43              : ! **************************************************************************************************
      44              : !> \brief ...
      45              : !> \param qs_env ...
      46              : !> \param unit_nr ...
      47              : !> \param basis_type ...
      48              : !> \param primitive ...
      49              : ! **************************************************************************************************
      50           38 :    SUBROUTINE create_minbas_set(qs_env, unit_nr, basis_type, primitive)
      51              :       TYPE(qs_environment_type), POINTER                 :: qs_env
      52              :       INTEGER, INTENT(IN)                                :: unit_nr
      53              :       CHARACTER(LEN=*), INTENT(IN), OPTIONAL             :: basis_type
      54              :       INTEGER, INTENT(IN), OPTIONAL                      :: primitive
      55              : 
      56              :       CHARACTER(LEN=2)                                   :: element_symbol
      57              :       CHARACTER(LEN=default_string_length)               :: bname, btype
      58              :       INTEGER                                            :: ikind, lb, mao, ne, ngau, nkind, nprim, &
      59              :                                                             nsgf, ub, z
      60              :       INTEGER, DIMENSION(0:3)                            :: elcon
      61           38 :       INTEGER, DIMENSION(:), POINTER                     :: econf
      62              :       REAL(KIND=dp)                                      :: zval
      63              :       TYPE(dft_control_type), POINTER                    :: dft_control
      64              :       TYPE(gto_basis_set_type), POINTER                  :: pbasis, refbasis
      65           38 :       TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
      66              :       TYPE(qs_kind_type), POINTER                        :: qs_kind
      67              : 
      68           38 :       IF (PRESENT(basis_type)) THEN
      69            4 :          btype = TRIM(basis_type)
      70              :       ELSE
      71           34 :          btype = "MIN"
      72              :       END IF
      73           38 :       IF (PRESENT(primitive)) THEN
      74            4 :          nprim = primitive
      75              :       ELSE
      76              :          nprim = -1
      77              :       END IF
      78              : 
      79           38 :       IF (unit_nr > 0) THEN
      80           19 :          WRITE (unit_nr, '(T2,A,T60,A21)') "Generate MINBAS set", ADJUSTR(TRIM(btype))
      81              :       END IF
      82              :       ! check for or generate reference basis
      83           38 :       CALL get_qs_env(qs_env=qs_env, qs_kind_set=qs_kind_set)
      84           38 :       CALL get_qs_env(qs_env, dft_control=dft_control)
      85           38 :       nkind = SIZE(qs_kind_set)
      86          116 :       DO ikind = 1, nkind
      87           78 :          qs_kind => qs_kind_set(ikind)
      88           78 :          CALL get_qs_kind(qs_kind, zeff=zval, elec_conf=econf, element_symbol=element_symbol)
      89           78 :          CALL get_ptable_info(element_symbol, ielement=z)
      90           78 :          NULLIFY (refbasis, pbasis)
      91           78 :          CALL get_qs_kind(qs_kind=qs_kind, basis_set=refbasis, basis_type=btype)
      92           78 :          IF (.NOT. ASSOCIATED(refbasis)) THEN
      93           74 :             CALL get_qs_kind(qs_kind=qs_kind, mao=mao)
      94              :             ! generate a minimal basis set
      95           74 :             elcon = 0
      96           74 :             lb = LBOUND(econf, 1)
      97           74 :             ub = UBOUND(econf, 1)
      98           74 :             ne = ub - lb
      99          202 :             elcon(0:ne) = econf(lb:ub)
     100           74 :             IF (nprim > 0) THEN
     101            4 :                ngau = nprim
     102            4 :                CALL create_min_basis(refbasis, z, elcon, mao, ngau)
     103            4 :                CALL create_primitive_basis_set(refbasis, pbasis)
     104            4 :                CALL init_interaction_radii_orb_basis(pbasis, dft_control%qs_control%eps_pgf_orb)
     105            4 :                CALL add_basis_set_to_container(qs_kind%basis_sets, pbasis, btype)
     106            4 :                CALL deallocate_gto_basis_set(refbasis)
     107              :             ELSE
     108              :                ! STO-3G
     109           70 :                ngau = 3
     110           70 :                CALL create_min_basis(refbasis, z, elcon, mao, ngau)
     111           70 :                CALL init_interaction_radii_orb_basis(refbasis, dft_control%qs_control%eps_pgf_orb)
     112           70 :                CALL add_basis_set_to_container(qs_kind%basis_sets, refbasis, btype)
     113              :             END IF
     114           74 :             CALL get_qs_kind(qs_kind=qs_kind, basis_set=refbasis, basis_type=btype)
     115              :          END IF
     116          194 :          IF (unit_nr > 0) THEN
     117           39 :             CALL get_gto_basis_set(refbasis, name=bname, nsgf=nsgf)
     118           39 :             WRITE (unit_nr, '(T2,A,A,T14,A,I4,T40,A,A24)') "Kind: ", element_symbol, "NBasFun: ", nsgf, &
     119           78 :                "Reference Basis: ", ADJUSTL(TRIM(bname))
     120              :          END IF
     121              :       END DO
     122              : 
     123           38 :    END SUBROUTINE create_minbas_set
     124              : 
     125              : ! **************************************************************************************************
     126              : !> \brief Creates a minimal basis set based on Slater rules
     127              : !> \param min_basis_set ...
     128              : !> \param zval ...
     129              : !> \param econf ...
     130              : !> \param mao ...
     131              : !> \param ngau ...
     132              : !> \par History
     133              : !>      03.2023 created [JGH]
     134              : ! **************************************************************************************************
     135           74 :    SUBROUTINE create_min_basis(min_basis_set, zval, econf, mao, ngau)
     136              :       TYPE(gto_basis_set_type), POINTER                  :: min_basis_set
     137              :       INTEGER, INTENT(IN)                                :: zval
     138              :       INTEGER, DIMENSION(0:3)                            :: econf
     139              :       INTEGER, INTENT(IN)                                :: mao, ngau
     140              : 
     141              :       CHARACTER(len=1), DIMENSION(0:3), PARAMETER        :: lnam = (/"S", "P", "D", "F"/)
     142              : 
     143              :       CHARACTER(len=6)                                   :: str
     144           74 :       CHARACTER(len=6), DIMENSION(:), POINTER            :: sym
     145              :       CHARACTER(LEN=default_string_length)               :: bname
     146              :       INTEGER                                            :: i, iss, l, lm, n, nmao, nn, nss
     147              :       INTEGER, DIMENSION(0:3)                            :: nae, nco, npe
     148              :       INTEGER, DIMENSION(4, 7)                           :: ne
     149           74 :       INTEGER, DIMENSION(:), POINTER                     :: lq, nq
     150           74 :       REAL(KIND=dp), DIMENSION(:), POINTER               :: zet
     151              :       TYPE(sto_basis_set_type), POINTER                  :: sto_basis_set
     152              : 
     153            0 :       CPASSERT(.NOT. ASSOCIATED(min_basis_set))
     154           74 :       NULLIFY (sto_basis_set)
     155              : 
     156              :       ! electronic configuration
     157           74 :       ne = 0
     158          370 :       DO l = 1, 4
     159          296 :          nn = 2*(l - 1) + 1
     160         1998 :          DO i = l, 7
     161         1628 :             ne(l, i) = ptable(zval)%e_conv(l - 1) - 2*nn*(i - l)
     162         1628 :             ne(l, i) = MAX(ne(l, i), 0)
     163         1924 :             ne(l, i) = MIN(ne(l, i), 2*nn)
     164              :          END DO
     165              :       END DO
     166              :       ! STO definition
     167           74 :       nae = 0
     168           74 :       npe = 0
     169          370 :       DO l = 0, 3
     170          296 :          nn = 2*(2*l + 1)
     171          296 :          nae(l) = ptable(zval)%e_conv(l)/nn
     172          296 :          IF (MOD(ptable(zval)%e_conv(l), nn) /= 0) nae(l) = nae(l) + 1
     173          296 :          npe(l) = econf(l)/nn
     174          370 :          IF (MOD(econf(l), nn) /= 0) npe(l) = npe(l) + 1
     175              :       END DO
     176          370 :       CPASSERT(ALL(nae - npe >= 0))
     177          370 :       nco = nae - npe
     178              :       ! MAO count
     179              :       nmao = 0
     180          370 :       DO l = 0, 3
     181          370 :          nmao = nmao + npe(l)*(2*l + 1)
     182              :       END DO
     183              : 
     184           74 :       IF (mao > nmao) THEN
     185            2 :          nmao = mao - nmao
     186            2 :          SELECT CASE (nmao)
     187              :          CASE (1)
     188            2 :             npe(0) = npe(0) + 1
     189              :          CASE (2)
     190            0 :             npe(0) = npe(0) + 2
     191              :          CASE (3)
     192            0 :             npe(1) = npe(1) + 1
     193              :          CASE (4)
     194            0 :             npe(0) = npe(0) + 1
     195            0 :             npe(1) = npe(1) + 1
     196              :          CASE (5)
     197            0 :             IF (npe(2) == 0) THEN
     198            0 :                npe(2) = npe(2) + 1
     199              :             ELSE
     200            0 :                npe(0) = npe(0) + 2
     201            0 :                npe(1) = npe(1) + 1
     202              :             END IF
     203              :          CASE (6)
     204            0 :             npe(0) = npe(0) + 1
     205            0 :             npe(2) = npe(2) + 1
     206              :          CASE (7)
     207            0 :             npe(0) = npe(0) + 2
     208            0 :             npe(2) = npe(2) + 1
     209              :          CASE (8)
     210            0 :             npe(0) = npe(0) + 3
     211            0 :             npe(2) = npe(2) + 1
     212              :          CASE (9)
     213            0 :             npe(0) = npe(0) + 1
     214            0 :             npe(1) = npe(1) + 1
     215            0 :             npe(2) = npe(2) + 1
     216              :          CASE DEFAULT
     217            2 :             CPABORT("Default setting of minimal basis failed")
     218              :          END SELECT
     219            2 :          CALL cp_warn(__LOCATION__, "Reference basis has been adjusted according to MAO value.")
     220              :       END IF
     221              : 
     222              :       ! All shells should have at least 1 function
     223           74 :       lm = 0
     224          370 :       DO l = 0, 3
     225          370 :          IF (npe(l) > 0) lm = l
     226              :       END DO
     227          188 :       DO l = 0, lm
     228          188 :          IF (npe(l) == 0) npe(l) = 1
     229              :       END DO
     230              : 
     231          370 :       nss = SUM(npe)
     232          592 :       ALLOCATE (sym(nss), lq(nss), nq(nss), zet(nss))
     233           74 :       iss = 0
     234          370 :       DO l = 0, 3
     235          492 :          DO i = 1, npe(l)
     236          122 :             iss = iss + 1
     237          122 :             lq(iss) = l
     238          122 :             n = nco(l) + l
     239          122 :             nq(iss) = n + i
     240          122 :             str = "      "
     241          122 :             WRITE (str(5:5), FMT='(I1)') nq(iss)
     242          122 :             str(6:6) = lnam(l)
     243          122 :             sym(iss) = str
     244          418 :             zet(iss) = srules(zval, ne, nq(iss), lq(iss))
     245              :          END DO
     246              :       END DO
     247              : 
     248           74 :       bname = ADJUSTR(ptable(zval)%symbol)//"_MBas"
     249           74 :       CALL allocate_sto_basis_set(sto_basis_set)
     250              :       CALL set_sto_basis_set(sto_basis_set, name=bname, nshell=nss, nq=nq, &
     251           74 :                              lq=lq, zet=zet, symbol=sym)
     252           74 :       CALL create_gto_from_sto_basis(sto_basis_set, min_basis_set, ngau)
     253           74 :       min_basis_set%norm_type = 2
     254           74 :       CALL init_orb_basis_set(min_basis_set)
     255           74 :       CALL deallocate_sto_basis_set(sto_basis_set)
     256              : 
     257           74 :       DEALLOCATE (sym, lq, nq, zet)
     258              : 
     259           74 :    END SUBROUTINE create_min_basis
     260              : 
     261              : ! **************************************************************************************************
     262              : 
     263              : END MODULE min_basis_set
        

Generated by: LCOV version 2.0-1