LCOV - code coverage report
Current view: top level - src - qs_basis_rotation_methods.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 35.8 % 53 19
Test Date: 2025-07-25 12:55:17 Functions: 50.0 % 2 1

            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              : MODULE qs_basis_rotation_methods
      10              :    USE basis_set_types,                 ONLY: get_gto_basis_set,&
      11              :                                               gto_basis_set_type
      12              :    USE cell_types,                      ONLY: cell_type
      13              :    USE cp_control_types,                ONLY: dft_control_type
      14              :    USE input_constants,                 ONLY: do_method_dftb
      15              :    USE kinds,                           ONLY: dp
      16              :    USE kpoint_types,                    ONLY: kpoint_sym_type,&
      17              :                                               kpoint_type
      18              :    USE orbital_pointers,                ONLY: nso
      19              :    USE orbital_transformation_matrices, ONLY: calculate_rotmat,&
      20              :                                               orbrotmat_type,&
      21              :                                               release_rotmat
      22              :    USE qs_environment_types,            ONLY: get_qs_env,&
      23              :                                               qs_environment_type
      24              :    USE qs_kind_types,                   ONLY: get_qs_kind,&
      25              :                                               get_qs_kind_set,&
      26              :                                               qs_kind_type
      27              : #include "./base/base_uses.f90"
      28              : 
      29              :    IMPLICIT NONE
      30              : 
      31              :    PRIVATE
      32              : 
      33              :    ! Global parameters (only in this module)
      34              : 
      35              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_basis_rotation_methods'
      36              : 
      37              :    ! Public subroutines
      38              : 
      39              :    PUBLIC :: qs_basis_rotation
      40              : 
      41              : CONTAINS
      42              : 
      43              : ! **************************************************************************************************
      44              : !> \brief   Construct basis set rotation matrices
      45              : !> \param qs_env ...
      46              : !> \param kpoints ...
      47              : ! **************************************************************************************************
      48          170 :    SUBROUTINE qs_basis_rotation(qs_env, kpoints)
      49              : 
      50              :       TYPE(qs_environment_type), POINTER                 :: qs_env
      51              :       TYPE(kpoint_type), POINTER                         :: kpoints
      52              : 
      53              :       INTEGER                                            :: ik, ikind, ir, ira, irot, jr, lval, &
      54              :                                                             nkind, nrot
      55              :       REAL(KIND=dp), DIMENSION(3, 3)                     :: rotmat
      56              :       TYPE(cell_type), POINTER                           :: cell
      57              :       TYPE(dft_control_type), POINTER                    :: dft_control
      58              :       TYPE(gto_basis_set_type), POINTER                  :: orb_basis
      59              :       TYPE(kpoint_sym_type), POINTER                     :: kpsym
      60          170 :       TYPE(orbrotmat_type), DIMENSION(:), POINTER        :: orbrot
      61          170 :       TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
      62              : 
      63            0 :       CPASSERT(ASSOCIATED(qs_env))
      64          170 :       CPASSERT(ASSOCIATED(kpoints))
      65          170 :       IF (ASSOCIATED(kpoints%kind_rotmat)) THEN
      66           48 :          CALL get_qs_env(qs_env, cell=cell)
      67           48 :          CALL get_qs_env(qs_env, qs_kind_set=qs_kind_set)
      68           48 :          CALL get_qs_kind_set(qs_kind_set, maxlgto=lval)
      69           48 :          nrot = SIZE(kpoints%kind_rotmat, 1)
      70           48 :          nkind = SIZE(kpoints%kind_rotmat, 2)
      71              :          ! remove possible old rotation matrices
      72           48 :          DO irot = 1, nrot
      73           48 :             DO ikind = 1, nkind
      74            0 :                IF (ASSOCIATED(kpoints%kind_rotmat(irot, ikind)%rmat)) THEN
      75            0 :                   DEALLOCATE (kpoints%kind_rotmat(irot, ikind)%rmat)
      76              :                END IF
      77              :             END DO
      78              :          END DO
      79              :          ! check all rotations needed
      80           48 :          NULLIFY (orbrot)
      81           48 :          CALL get_qs_env(qs_env, dft_control=dft_control)
      82          640 :          DO ik = 1, kpoints%nkp
      83          592 :             kpsym => kpoints%kp_sym(ik)%kpoint_sym
      84          640 :             IF (kpsym%apply_symmetry) THEN
      85            0 :                DO irot = 1, SIZE(kpsym%rotp)
      86            0 :                   ir = kpsym%rotp(irot)
      87            0 :                   ira = 0
      88            0 :                   DO jr = 1, SIZE(kpoints%ibrot)
      89            0 :                      IF (ir == kpoints%ibrot(jr)) ira = jr
      90              :                   END DO
      91            0 :                   IF (ira > 0) THEN
      92            0 :                      IF (.NOT. ASSOCIATED(kpoints%kind_rotmat(ira, 1)%rmat)) THEN
      93            0 :                         rotmat(1:3, 1:3) = MATMUL(cell%h_inv, &
      94            0 :                                                   MATMUL(kpsym%rot(:, :, irot), cell%hmat))
      95            0 :                         CALL calculate_rotmat(orbrot, rotmat, lval)
      96            0 :                         IF (dft_control%qs_control%method_id == do_method_dftb) THEN
      97            0 :                            CPABORT("ROTMAT")
      98              :                         ELSE
      99            0 :                            DO ikind = 1, nkind
     100            0 :                               CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis)
     101            0 :                               NULLIFY (kpoints%kind_rotmat(ira, ikind)%rmat)
     102            0 :                               CALL set_rotmat_basis(kpoints%kind_rotmat(ira, ikind)%rmat, orbrot, orb_basis)
     103              :                            END DO
     104              :                         END IF
     105              :                      END IF
     106              :                   END IF
     107              :                END DO
     108              :             END IF
     109              :          END DO
     110           48 :          CALL release_rotmat(orbrot)
     111              :       END IF
     112              : 
     113          170 :    END SUBROUTINE qs_basis_rotation
     114              : 
     115              : ! **************************************************************************************************
     116              : !> \brief ...
     117              : !> \param rmat ...
     118              : !> \param orbrot ...
     119              : !> \param basis ...
     120              : ! **************************************************************************************************
     121            0 :    SUBROUTINE set_rotmat_basis(rmat, orbrot, basis)
     122              :       REAL(KIND=dp), DIMENSION(:, :), POINTER            :: rmat
     123              :       TYPE(orbrotmat_type), DIMENSION(:), POINTER        :: orbrot
     124              :       TYPE(gto_basis_set_type), POINTER                  :: basis
     125              : 
     126              :       INTEGER                                            :: fs1, fs2, iset, ishell, l, nset, nsgf
     127            0 :       INTEGER, DIMENSION(:), POINTER                     :: nshell
     128            0 :       INTEGER, DIMENSION(:, :), POINTER                  :: first_sgf, lshell
     129              : 
     130            0 :       CALL get_gto_basis_set(gto_basis_set=basis, nsgf=nsgf)
     131            0 :       ALLOCATE (rmat(nsgf, nsgf))
     132            0 :       rmat = 0.0_dp
     133              : 
     134              :       CALL get_gto_basis_set(gto_basis_set=basis, nset=nset, nshell=nshell, l=lshell, &
     135            0 :                              first_sgf=first_sgf)
     136            0 :       DO iset = 1, nset
     137            0 :          DO ishell = 1, nshell(iset)
     138            0 :             l = lshell(ishell, iset)
     139            0 :             fs1 = first_sgf(ishell, iset)
     140            0 :             fs2 = fs1 + nso(l) - 1
     141            0 :             rmat(fs1:fs2, fs1:fs2) = orbrot(l)%mat(1:nso(l), 1:nso(l))
     142              :          END DO
     143              :       END DO
     144              : 
     145            0 :    END SUBROUTINE set_rotmat_basis
     146              : 
     147            0 : END MODULE qs_basis_rotation_methods
        

Generated by: LCOV version 2.0-1