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 : 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 154 : 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 154 : TYPE(orbrotmat_type), DIMENSION(:), POINTER :: orbrot
61 154 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
62 :
63 0 : CPASSERT(ASSOCIATED(qs_env))
64 154 : CPASSERT(ASSOCIATED(kpoints))
65 154 : 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 154 : 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
|