Line data Source code
1 : !!****m* ABINIT/m_out_spg_anal
2 : !! NAME
3 : !! m_out_spg_anal
4 : !!
5 : !! FUNCTION
6 : !!
7 : !!
8 : !! COPYRIGHT
9 : !! Copyright (C) 1998-2026 ABINIT group (DCA, XG, GMR)
10 : !! This file is distributed under the terms of the
11 : !! GNU General Public License, see ~abinit/COPYING
12 : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : !!
14 : !! SOURCE
15 :
16 : #if defined HAVE_CONFIG_H
17 : #include "config.h"
18 : #endif
19 :
20 : #include "abi_common.h"
21 :
22 : module m_out_spg_anal
23 :
24 : use defs_basis
25 : use m_results_out
26 : use m_dtset
27 : use m_abicore
28 : use m_errors
29 :
30 : use m_symfind, only : symfind_expert, symanal, symlatt
31 : use m_geometry, only : metric, mkrdim
32 : use m_spgdata, only : prtspgroup
33 :
34 : implicit none
35 :
36 : private
37 : !!***
38 :
39 : public :: out_spg_anal
40 : !!***
41 :
42 : contains
43 : !!***
44 :
45 : !!****f* ABINIT/out_spg_anal
46 : !! NAME
47 : !! out_spg_anal
48 : !!
49 : !! FUNCTION
50 : !! Perform final spacegroup analysis of the results of ABINIT, for each dataset.
51 : !! Compare with the initial one, and perform analysis, with adequate warning if there was a change.
52 : !! Possibly echo spacegroup for all dtsets and possibly all images
53 : !!
54 : !! INPUTS
55 : !! dtsets(0:ndtset_alloc)=<type datafiles_type>contains all input variables
56 : !! iout=unit number for echoed output - the echo is done to std_out anyhow.
57 : !! ndtset=number of datasets
58 : !! ndtset_alloc=number of datasets, corrected for allocation of at least
59 : !! one data set. Use for most dimensioned arrays.
60 : !! echo_spgroup = not relevant anymore, as at present set to 1 in the calling routine.
61 : !! (0 => write ; 1 => echo of spacegroup for all dtsets and possibly all images)
62 : !! results_out(0:ndtset_alloc)=<type results_out_type>contains the results
63 : !! needed for outvars, including evolving variables
64 : !!
65 : !! OUTPUT
66 : !! Only writing
67 : !!
68 : !! NOTES
69 : !! Note that this routine is called only by the processor me==0 .
70 : !! In consequence, no use of message and wrtout routine.
71 : !!
72 : !! SOURCE
73 :
74 1113 : subroutine out_spg_anal(dtsets,echo_spgroup,iout,ndtset,ndtset_alloc,results_out)
75 :
76 : !Arguments ------------------------------------
77 : !scalars
78 : integer,intent(in) :: echo_spgroup,iout
79 : integer,intent(in) :: ndtset,ndtset_alloc
80 : !arrays
81 : type(dataset_type),intent(in) :: dtsets(0:ndtset_alloc)
82 : type(results_out_type),intent(in) :: results_out(0:ndtset_alloc)
83 :
84 : !Local variables-------------------------------
85 : !scalars
86 : integer, save :: counter0=1, counter1=1
87 : integer :: idtset,iimage,invar_z,jdtset,msym,mu,natom,nimage,nptsym,nsym
88 : integer :: ptgroupma,spgroup,symmetry_changed
89 : real(dp) :: tolsym,ucvol
90 : character(len=500) :: msg
91 : !arrays
92 : integer :: bravais(11)
93 1113 : integer, allocatable :: ptsymrel(:,:,:),symafm(:),symrel(:,:,:)
94 : real(dp) :: acell(3),genafm(3),gmet(3,3),gprimd(3,3),rmet(3,3),rprim(3,3),rprimd(3,3)
95 1113 : real(dp), allocatable :: tnons(:,:)
96 :
97 : ! *************************************************************************
98 :
99 : !An upper bound on the number of symmetry operations is 48 (maximum of point symmetries) times 2 (for the spin flip)
100 : !times the number of atoms as the latter gives the maximum number of non-symmorphic translations.
101 : !Actually, a better bound might be obtained from the minimum of the numbers of atoms of the same type,
102 : !but this refinement is not needed here.
103 1113 : msym=96*dtsets(1)%natom
104 1113 : if(ndtset_alloc>1)then
105 4033 : do idtset=2,ndtset_alloc
106 4033 : msym=max(96*dtsets(idtset)%natom,msym)
107 : end do
108 : end if
109 3339 : ABI_MALLOC(ptsymrel,(3,3,msym))
110 3339 : ABI_MALLOC(symafm,(msym))
111 2226 : ABI_MALLOC(symrel,(3,3,msym))
112 3339 : ABI_MALLOC(tnons,(3,msym))
113 :
114 5509 : do idtset=1,ndtset_alloc
115 :
116 4396 : tolsym=dtsets(idtset)%tolsym
117 4396 : natom=dtsets(idtset)%natom
118 4396 : nimage=results_out(idtset)%nimage
119 4396 : jdtset=dtsets(idtset)%jdtset ; if(ndtset==0)jdtset=0
120 :
121 10093 : do iimage=1,nimage
122 :
123 18336 : acell=results_out(idtset)%acell(:,iimage)
124 59592 : rprim=results_out(idtset)%rprim(:,:,iimage)
125 4584 : call mkrdim(acell,rprim,rprimd)
126 4584 : call metric(gmet,gprimd,dev_null,rmet,rprimd,ucvol)
127 :
128 : !From rprimd and tolsym, compute bravais, nptsym and ptsymrel (with maximum size msym).
129 4584 : call symlatt(bravais,dev_null,msym,nptsym,ptsymrel,rprimd,tolsym)
130 :
131 : !DEBUG
132 : ! write(std_out,*)' out_spg_data : before symfind_expert, return, msym= ',msym
133 : ! write(std_out,*)' out_spg_data : before symfind_expert, continue '
134 : ! return
135 : !ENDDEBUG
136 :
137 4584 : invar_z=0 ; if(dtsets(idtset)%jellslab/=0 .or. dtsets(idtset)%nzchempot/=0)invar_z=2
138 :
139 : call symfind_expert(gprimd,msym,natom,nptsym,dtsets(idtset)%nspden,nsym,&
140 : dtsets(idtset)%pawspnorb,dtsets(idtset)%prtvol,ptsymrel,dtsets(idtset)%spinat,symafm,symrel,&
141 : tnons,tolsym,dtsets(idtset)%typat,dtsets(idtset)%usepaw,results_out(idtset)%xred(1:3,1:natom,iimage),&
142 : chrgat=dtsets(idtset)%chrgat,nucdipmom=dtsets(idtset)%nucdipmom,&
143 4584 : invardir_red=dtsets(idtset)%field_red,invaraxial_red=dtsets(idtset)%field_red_axial, invar_z=invar_z)
144 :
145 : !DEBUG
146 : ! write(std_out,*)' out_spg_data : before symfind_expert, return '
147 : ! write(std_out,*)' out_spg_data : after symfind_expert, return '
148 : ! return
149 : !ENDDEBUG
150 :
151 : !Set chkprim to 0, to allow detecting increase of multiplicity
152 4584 : call symanal(bravais,0,genafm,msym,nsym,ptgroupma,rprimd,spgroup,symafm,symrel,tnons,tolsym)
153 :
154 4584 : symmetry_changed=0
155 4584 : if( nsym/=dtsets(idtset)%nsym .or. spgroup/=dtsets(idtset)%spgroup .or. &
156 : & ptgroupma/=dtsets(idtset)%ptgroupma)then
157 : symmetry_changed=1
158 : endif
159 :
160 : !DEBUG
161 : ! write(std_out,*)' m_out_spg_anal : determined symmetry_changed =', symmetry_changed
162 : ! write(std_out,*)' m_out_spg_anal : nsym, dtsets(idtset)%nsym=',nsym, dtsets(idtset)%nsym
163 : ! write(std_out,*)' m_out_spg_anal : spgroup,dtsets(idtset)%spgroup=',spgroup,dtsets(idtset)%spgroup
164 : ! write(std_out,*)' m_out_spg_anal : ptgroupma,dtsets(idtset)%ptgroupma=',ptgroupma,dtsets(idtset)%ptgroupma
165 : !ENDDEBUG
166 :
167 : if(symmetry_changed==1)then
168 1129 : if(counter0==1)then
169 302 : write(msg,'(8a)')ch10,' The spacegroup number, the magnetic point group, and/or the number of symmetries',ch10,&
170 302 : & ' have changed between the initial recognition based on the input file',ch10,&
171 302 : & ' and a postprocessing based on the final acell, rprim, and xred.',ch10,&
172 604 : & ' More details in the log file.'
173 302 : call wrtout(iout,msg)
174 302 : counter0=0
175 : endif
176 1129 : if(echo_spgroup==1 .and. counter1==1)then
177 302 : write(msg,'(10a)')ch10,' The spacegroup number, the magnetic point group, and/or the number of symmetries',ch10,&
178 302 : & ' have changed between the initial recognition based on the input file',ch10,&
179 302 : & ' and a postprocessing based on the final acell, rprim, and xred.',ch10,&
180 302 : & ' These modifications are detailed below.',ch10,&
181 604 : & ' The updated tnons, symrel or symrel have NOT been reported in the final echo of variables after computation.'
182 302 : call wrtout(std_out,msg)
183 302 : write(msg,'(5a)')' Such change of spacegroup, or magnetic point group might happen in several cases.',ch10,&
184 302 : & ' (1) If spgroup (+ptgroupma) defined in the input file, but the actual groups are supergroups of these; ',ch10,&
185 604 : & ' (2) If symrel, tnons (+symafm) defined in the input file, while the system is more symmetric; '
186 302 : call wrtout(std_out,msg)
187 : write(msg,'(5a)')&
188 302 : & ' (3) If the geometry has been optimized and the final structure is more symmetric than the initial one;',ch10,&
189 302 : & ' (4) In case of GW of BSE calculation with inversion symmetry, as nsym has been reduced in such',ch10,&
190 604 : & ' dataset, excluding the improper symmetry operations (with determinant=-1), but not in the postprocessing.'
191 302 : call wrtout(std_out,msg)
192 302 : write(msg,'(5a)')' In some case, the recognition of symmetries strongly depends on the value of tolsym.',ch10,&
193 302 : ' You might investigate its effect by restarting abinit based on the final acell, rprim and xred,',ch10,&
194 604 : & ' and different values for tolsym.'
195 302 : counter1=0
196 : endif
197 : endif
198 :
199 : ! Echo the spacegroup (and ptgroupma) if requested, and give more information if the symmetry changed.
200 8980 : if(echo_spgroup==1)then
201 :
202 4584 : if(symmetry_changed==0)then
203 3455 : if(nimage==1)then
204 3324 : call prtspgroup(bravais,genafm,std_out,jdtset,ptgroupma,spgroup)
205 : else
206 131 : call prtspgroup(bravais,genafm,std_out,jdtset,ptgroupma,spgroup,iimage=iimage)
207 : endif
208 : else
209 1129 : write(msg,'(2a,3i8)')ch10,' Initial data. jdtset, iimage, nsym=',jdtset,iimage,dtsets(idtset)%nsym
210 1129 : call wrtout(std_out,msg)
211 1129 : if(nimage==1)then
212 : call prtspgroup(dtsets(idtset)%bravais,dtsets(idtset)%genafm,std_out,jdtset,&
213 1034 : & dtsets(idtset)%ptgroupma,dtsets(idtset)%spgroup)
214 : else
215 : call prtspgroup(dtsets(idtset)%bravais,dtsets(idtset)%genafm,std_out,jdtset,&
216 95 : & dtsets(idtset)%ptgroupma,dtsets(idtset)%spgroup,iimage=iimage)
217 : endif
218 1129 : write(msg,'(a,3i8)')' Final data. jdtset, iimage, nsym=',jdtset,iimage,nsym
219 1129 : call wrtout(std_out,msg)
220 1129 : if(nimage==1)then
221 1034 : call prtspgroup(bravais,genafm,std_out,jdtset,ptgroupma,spgroup)
222 : else
223 95 : call prtspgroup(bravais,genafm,std_out,jdtset,ptgroupma,spgroup,iimage=iimage)
224 : endif
225 : endif
226 :
227 : end if ! echo_spgroup==1
228 :
229 : enddo ! iimage
230 :
231 : enddo ! idtset
232 :
233 : !###########################################################
234 : !## Deallocations and cleaning
235 :
236 1113 : ABI_FREE(ptsymrel)
237 1113 : ABI_FREE(symafm)
238 1113 : ABI_FREE(symrel)
239 1113 : ABI_FREE(tnons)
240 :
241 1113 : if(echo_spgroup==1)then
242 90153 : write(msg,'(a,80a)')ch10,('=',mu=1,80)
243 1113 : call wrtout(std_out,msg)
244 : endif
245 :
246 : !**************************************************************************
247 :
248 1113 : end subroutine out_spg_anal
249 : !!***
250 :
251 : end module m_out_spg_anal
252 : !!***
|