Branch data Line data Source code
1 : : !!****m* ABINIT/m_tdep_constraints
2 : : !! NAME
3 : : !! m_tdep_constraints
4 : : !!
5 : : !! FUNCTION
6 : : !! This module contains the data types used to build the constraints on the
7 : : !! IFC (products of symmetry operations, acoustic sum rules and rotational
8 : : !! invariance), and a routine to orthonormalize a set of vectors.
9 : : !!
10 : : !! COPYRIGHT
11 : : !! Copyright (C) 2011-2026 ABINIT group (GA,FB,JB)
12 : : !! This file is distributed under the terms of the
13 : : !! GNU General Public License, see ~abinit/COPYING
14 : : !! or http://www.gnu.org/copyleft/gpl.txt .
15 : : !!
16 : : !! SOURCE
17 : :
18 : : #if defined HAVE_CONFIG_H
19 : : #include "config.h"
20 : : #endif
21 : :
22 : : #include "abi_common.h"
23 : :
24 : : module m_tdep_constraints
25 : :
26 : : use defs_basis
27 : : use m_errors
28 : : use m_xmpi
29 : :
30 : : implicit none
31 : : !!***
32 : :
33 : : !!****t* m_tdep_constraints/S_product
34 : : !! NAME
35 : : !! S_product
36 : : !!
37 : : !! FUNCTION
38 : : !! Products of 2, 3 or 4 symmetry operations (in cartesian coordinates),
39 : : !! for a given symmetry operation and a given permutation of the atoms,
40 : : !! used to transform the IFC of the reference interaction of a shell
41 : : !! (SSS at the third order, SSSS at the fourth order; SS is currently unused).
42 : : !!
43 : : !! SOURCE
44 : :
45 : : type S_product
46 : : double precision, allocatable :: SS (:,:,:)
47 : : double precision, allocatable :: SSS (:,:,:,:)
48 : : double precision, allocatable :: SSSS(:,:,:,:,:)
49 : : end type S_product
50 : : !!***
51 : :
52 : : !!****t* m_tdep_constraints/Asr_Rot
53 : : !! NAME
54 : : !! Asr_Rot
55 : : !!
56 : : !! FUNCTION
57 : : !! For a given pair (or triplet) of atoms and a given IFC coefficient,
58 : : !! contributions to the constraints imposing the acoustic sum rules and the
59 : : !! invariance under an arbitrary rotation (see tdep_calc_constraints):
60 : : !! ABG for the acoustic sum rules at the 3rd order, ABGD for the rotational
61 : : !! invariances at the 3rd order (AsrRot3) or the acoustic sum rules at the
62 : : !! 4th order (AsrRot4). ABGDE is currently unused.
63 : : !!
64 : : !! SOURCE
65 : :
66 : : type Asr_Rot
67 : : double precision, allocatable :: ABG (:,:,:)
68 : : double precision, allocatable :: ABGD(:,:,:,:)
69 : : double precision, allocatable :: ABGDE(:,:,:,:,:)
70 : : end type Asr_Rot
71 : : !!***
72 : :
73 : : !!****t* m_tdep_constraints/Constraints_type
74 : : !! NAME
75 : : !! Constraints_type
76 : : !!
77 : : !! FUNCTION
78 : : !! Holds the products of symmetry operations, Sprod(nsym,npermutations),
79 : : !! and the contributions to the acoustic sum rules and rotational
80 : : !! invariances at the 3rd (AsrRot3) and 4th (AsrRot4) orders, used to build
81 : : !! the constraints on the IFC (see m_tdep_solver).
82 : : !!
83 : : !! SOURCE
84 : :
85 : : type,public :: Constraints_type
86 : : type(S_product),allocatable :: Sprod(:,:)
87 : : type(Asr_Rot),allocatable :: AsrRot3(:,:,:)
88 : : type(Asr_Rot),allocatable :: AsrRot4(:,:,:,:)
89 : : end type Constraints_type
90 : : !!***
91 : :
92 : : public :: tdep_calc_orthonorm
93 : :
94 : : contains
95 : :
96 : : !====================================================================================================
97 : :
98 : : !!****f* ABINIT/m_tdep_constraints/tdep_calc_orthonorm
99 : : !! NAME
100 : : !! tdep_calc_orthonorm
101 : : !!
102 : : !! FUNCTION
103 : : !! Build an orthonormal basis of the space spanned by a set of vectors:
104 : : !! the zero vectors are removed, the remaining ones are orthogonalized
105 : : !! (Gram-Schmidt) and normalized, and the vectors found to be linearly
106 : : !! dependent are removed.
107 : : !!
108 : : !! INPUTS
109 : : !! dim1 = Dimension of the vectors.
110 : : !! dim2 = Number of vectors.
111 : : !!
112 : : !! OUTPUT
113 : : !! nindep = Number of linearly independent vectors.
114 : : !!
115 : : !! SIDE EFFECTS
116 : : !! vect(dim1,dim2) = On entry, the set of vectors.
117 : : !! On exit, vect(:,1:nindep) contains the orthonormal basis.
118 : : !!
119 : : !! SOURCE
120 : :
121 : 216 : subroutine tdep_calc_orthonorm(dim1,dim2,nindep,vect)
122 : :
123 : : integer, intent(in) :: dim1,dim2
124 : : integer, intent(out) :: nindep
125 : : double precision, intent(inout) :: vect(dim1,dim2)
126 : :
127 : : integer :: ii,jj,kk
128 : : double precision :: prod_scal
129 : :
130 : : ! Filter non-zero vectors
131 : 216 : ii=0
132 [ + + ]: 625464 : do kk=1,dim2
133 [ + + + + ]: 57350034 : if (sum(abs(vect(:,kk))).gt.tol8) then
134 : 11786 : ii=ii+1
135 [ + + ]: 1594844 : vect(:,ii)=vect(:,kk)
136 : : end if
137 : : end do
138 : 216 : nindep=ii
139 : :
140 : : ! Gram-Schmidt orthogonalization
141 [ + + ]: 11939 : do kk=2,nindep
142 [ + + ]: 3994988 : do jj=1,kk-1
143 [ + + ]: 518867518 : prod_scal=sum(vect(:,jj)*vect(:,jj))
144 [ + + ]: 3994772 : if (abs(prod_scal).gt.tol8) then
145 [ + + + + ]: 44866328 : vect(:,kk)=vect(:,kk)-sum(vect(:,kk)*vect(:,jj))/prod_scal*vect(:,jj)
146 : : end if
147 : : end do
148 : : end do
149 : :
150 : : ! Store the non-zero vectors and normalize
151 : : ii=0
152 [ + + ]: 12002 : do kk=1,nindep
153 [ + + ]: 1594844 : prod_scal=sum(vect(:,kk)*vect(:,kk))
154 [ + + ]: 12002 : if (abs(prod_scal).gt.tol8) then
155 : 425 : ii=ii+1
156 [ + + ]: 93178 : vect(:,ii)=vect(:,kk)/dsqrt(prod_scal)
157 : : end if
158 : : end do
159 [ + + ]: 613678 : do kk=nindep+1,dim2
160 [ + + ]: 55755190 : vect(:,kk)=zero
161 : : end do
162 : 216 : nindep=ii
163 : :
164 : 216 : end subroutine tdep_calc_orthonorm
165 : : !!***
166 : :
167 : : !====================================================================================================
168 : :
169 [ # # # # : 0 : end module m_tdep_constraints
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # ]
170 : : !!***
|
