1 |
commit: a2f8c2a80e809353e74bc82d4381f2773199c4af |
2 |
Author: Honza Macháček <Hloupy.Honza <AT> centrum <DOT> cz> |
3 |
AuthorDate: Fri Jun 27 14:09:48 2014 +0000 |
4 |
Commit: Honza Macháček <Hloupy.Honza <AT> centrum <DOT> cz> |
5 |
CommitDate: Fri Jun 27 14:09:48 2014 +0000 |
6 |
URL: http://git.overlays.gentoo.org/gitweb/?p=proj/sci.git;a=commit;h=a2f8c2a8 |
7 |
|
8 |
Added forgotten patch files for sci-libs/bigdft-abi. bigdft-abi-1.0.4-0005.patch too big for repoman's taste. |
9 |
|
10 |
--- |
11 |
.../bigdft-abi/files/bigdft-abi-1.0.4-0002.patch | 37 + |
12 |
.../bigdft-abi/files/bigdft-abi-1.0.4-0003.patch | 49 + |
13 |
.../bigdft-abi/files/bigdft-abi-1.0.4-0004.patch | 20 + |
14 |
.../bigdft-abi/files/bigdft-abi-1.0.4-0005.patch | 5317 ++++++++++++++++++++ |
15 |
.../bigdft-abi/files/bigdft-abi-1.0.4-0006.patch | 43 + |
16 |
.../bigdft-abi/files/bigdft-abi-1.0.4-0007.patch | 344 ++ |
17 |
6 files changed, 5810 insertions(+) |
18 |
|
19 |
diff --git a/sci-libs/bigdft-abi/files/bigdft-abi-1.0.4-0002.patch b/sci-libs/bigdft-abi/files/bigdft-abi-1.0.4-0002.patch |
20 |
new file mode 100644 |
21 |
index 0000000..e533022 |
22 |
--- /dev/null |
23 |
+++ b/sci-libs/bigdft-abi/files/bigdft-abi-1.0.4-0002.patch |
24 |
@@ -0,0 +1,37 @@ |
25 |
+*** bigdft-abi-1.0.4/src/wfn_opt/applyh.f90 Tue May 28 15:42:28 2013 |
26 |
+--- bigdft-patch/src/wfn_opt/applyh.f90 Thu Jun 6 11:29:13 2013 |
27 |
+*************** |
28 |
+*** 1104,1110 **** |
29 |
+ istart_c=1 |
30 |
+ if(at%npspcode(iatype)==7) then |
31 |
+ call atom_projector_paw(ikpt,iat,idir,istart_c,iproj,nlpspd%nprojel,& |
32 |
+! lr,hx,hy,hz,rxyz(1,iat),at,orbs,nlpspd%plr(iat),proj,nwarnings,proj_G(iatype)) |
33 |
+ else |
34 |
+ call atom_projector(ikpt,iat,idir,istart_c,iproj,nlpspd%nprojel,& |
35 |
+ lr,hx,hy,hz,rxyz(1,iat),at,orbs,nlpspd%plr(iat),proj,nwarnings) |
36 |
+--- 1104,1110 ---- |
37 |
+ istart_c=1 |
38 |
+ if(at%npspcode(iatype)==7) then |
39 |
+ call atom_projector_paw(ikpt,iat,idir,istart_c,iproj,nlpspd%nprojel,& |
40 |
+! lr,hx,hy,hz,paw%rpaw(iatype),rxyz(1,iat),at,orbs,nlpspd%plr(iat),proj,nwarnings,proj_G(iatype)) |
41 |
+ else |
42 |
+ call atom_projector(ikpt,iat,idir,istart_c,iproj,nlpspd%nprojel,& |
43 |
+ lr,hx,hy,hz,rxyz(1,iat),at,orbs,nlpspd%plr(iat),proj,nwarnings) |
44 |
+*************** |
45 |
+*** 1116,1122 **** |
46 |
+ istart_c=1 |
47 |
+ if(at%npspcode(iatype)==7) then |
48 |
+ ! PAW case: |
49 |
+! call apply_atproj_iorb_paw(iat,iorb,nlpspd%nprojel,& |
50 |
+ at,orbs,wfd,nlpspd%plr(iat),proj,& |
51 |
+ psi(ispsi),hpsi(ispsi),eproj_sum,proj_G(iatype),paw) |
52 |
+ else |
53 |
+--- 1116,1123 ---- |
54 |
+ istart_c=1 |
55 |
+ if(at%npspcode(iatype)==7) then |
56 |
+ ! PAW case: |
57 |
+! call apply_atproj_iorb_paw(iat,iorb,ispsi,istart_c,& |
58 |
+! nlpspd%nprojel,& |
59 |
+ at,orbs,wfd,nlpspd%plr(iat),proj,& |
60 |
+ psi(ispsi),hpsi(ispsi),eproj_sum,proj_G(iatype),paw) |
61 |
+ else |
62 |
|
63 |
diff --git a/sci-libs/bigdft-abi/files/bigdft-abi-1.0.4-0003.patch b/sci-libs/bigdft-abi/files/bigdft-abi-1.0.4-0003.patch |
64 |
new file mode 100644 |
65 |
index 0000000..5b406a9 |
66 |
--- /dev/null |
67 |
+++ b/sci-libs/bigdft-abi/files/bigdft-abi-1.0.4-0003.patch |
68 |
@@ -0,0 +1,49 @@ |
69 |
+*** bigdft-abi-1.0.4/src/init/gautowav.f90 Mon Jul 9 16:43:33 2012 |
70 |
+--- bigdft-patch/src/init/gautowav.f90 Mon Jun 10 11:16:37 2013 |
71 |
+*************** |
72 |
+*** 675,680 **** |
73 |
+--- 675,681 ---- |
74 |
+ integer :: i_stat,i_all,ishell,iexpo,icoeff,iat,isat,ng,l,m,i,nterm,ig |
75 |
+ integer :: nterms_max,nterms,iterm,n_gau,ml1,mu1,ml2,mu2,ml3,mu3 !n(c) iscoeff |
76 |
+ real(gp) :: rx,ry,rz,gau_a |
77 |
++ real(gp) :: gau_cut !only for PAW |
78 |
+ integer, dimension(nterm_max) :: lx,ly,lz |
79 |
+ real(gp), dimension(nterm_max) :: fac_arr |
80 |
+ real(wp), allocatable, dimension(:,:,:) :: work |
81 |
+*************** |
82 |
+*** 746,762 **** |
83 |
+ gau_a=G%xp(1,iexpo+ig-1) |
84 |
+ n_gau=lx(i) |
85 |
+ !print *,'x',gau_a,nterm,ncplx,kx,ky,kz,ml1,mu1,lr%d%n1 |
86 |
+! call gauss_to_daub_k(hx,kx*hx,ncplx,1,ncplx,fac_arr(i),rx,gau_a,n_gau,& |
87 |
+ lr%ns1,lr%d%n1,ml1,mu1,& |
88 |
+ wx(1,0,1,iterm),work,nw,perx) |
89 |
+ n_gau=ly(i) |
90 |
+ !print *,'y',ml2,mu2,lr%d%n2 |
91 |
+! call gauss_to_daub_k(hy,ky*hy,ncplx,1,ncplx,wfn_gau(icoeff),ry,gau_a,n_gau,& |
92 |
+ lr%ns2,lr%d%n2,ml2,mu2,& |
93 |
+ wy(1,0,1,iterm),work,nw,pery) |
94 |
+ n_gau=lz(i) |
95 |
+ !print *,'z',ml3,mu3,lr%d%n3 |
96 |
+! call gauss_to_daub_k(hz,kz*hz,ncplx,1,ncplx,G%psiat(:,iexpo+ig-1),rz,gau_a,n_gau,& |
97 |
+ lr%ns3,lr%d%n3,ml3,mu3,& |
98 |
+ wz(1,0,1,iterm),work,nw,perz) |
99 |
+ iterm=iterm+1 |
100 |
+--- 747,763 ---- |
101 |
+ gau_a=G%xp(1,iexpo+ig-1) |
102 |
+ n_gau=lx(i) |
103 |
+ !print *,'x',gau_a,nterm,ncplx,kx,ky,kz,ml1,mu1,lr%d%n1 |
104 |
+! call gauss_to_daub_k(hx,kx*hx,ncplx,1,ncplx,fac_arr(i),rx,gau_a,gau_cut,n_gau,& |
105 |
+ lr%ns1,lr%d%n1,ml1,mu1,& |
106 |
+ wx(1,0,1,iterm),work,nw,perx) |
107 |
+ n_gau=ly(i) |
108 |
+ !print *,'y',ml2,mu2,lr%d%n2 |
109 |
+! call gauss_to_daub_k(hy,ky*hy,ncplx,1,ncplx,wfn_gau(icoeff),ry,gau_a,gau_cut,n_gau,& |
110 |
+ lr%ns2,lr%d%n2,ml2,mu2,& |
111 |
+ wy(1,0,1,iterm),work,nw,pery) |
112 |
+ n_gau=lz(i) |
113 |
+ !print *,'z',ml3,mu3,lr%d%n3 |
114 |
+! call gauss_to_daub_k(hz,kz*hz,ncplx,1,ncplx,G%psiat(:,iexpo+ig-1),rz,gau_a,gau_cut,n_gau,& |
115 |
+ lr%ns3,lr%d%n3,ml3,mu3,& |
116 |
+ wz(1,0,1,iterm),work,nw,perz) |
117 |
+ iterm=iterm+1 |
118 |
|
119 |
diff --git a/sci-libs/bigdft-abi/files/bigdft-abi-1.0.4-0004.patch b/sci-libs/bigdft-abi/files/bigdft-abi-1.0.4-0004.patch |
120 |
new file mode 100644 |
121 |
index 0000000..e9af11a |
122 |
--- /dev/null |
123 |
+++ b/sci-libs/bigdft-abi/files/bigdft-abi-1.0.4-0004.patch |
124 |
@@ -0,0 +1,20 @@ |
125 |
+*** bigdft-abi-1.0.4/src/hpsiortho.f90 Wed Jan 30 10:10:56 2013 |
126 |
+--- bigdft-patch/src/hpsiortho.f90 Tue Jun 11 09:49:22 2013 |
127 |
+*************** |
128 |
+*** 720,726 **** |
129 |
+ if(at%npspcode(1)==7) then |
130 |
+ call atom_projector_paw(ikpt,iat,0,istart_c,iproj,& |
131 |
+ nlpspd%nprojel,& |
132 |
+! Lzd%Glr,Lzd%hgrids(1),Lzd%hgrids(2),Lzd%hgrids(3),rxyz(1,iat),at,orbs,& |
133 |
+ nlpspd%plr(iat),proj,nwarnings,proj_G(iatype)) |
134 |
+ else |
135 |
+ call atom_projector(ikpt,iat,0,istart_c,iproj,& |
136 |
+--- 720,727 ---- |
137 |
+ if(at%npspcode(1)==7) then |
138 |
+ call atom_projector_paw(ikpt,iat,0,istart_c,iproj,& |
139 |
+ nlpspd%nprojel,& |
140 |
+! Lzd%Glr,Lzd%hgrids(1),Lzd%hgrids(2),Lzd%hgrids(3),& |
141 |
+! paw%rpaw(iatype),rxyz(1,iat),at,orbs,& |
142 |
+ nlpspd%plr(iat),proj,nwarnings,proj_G(iatype)) |
143 |
+ else |
144 |
+ call atom_projector(ikpt,iat,0,istart_c,iproj,& |
145 |
|
146 |
diff --git a/sci-libs/bigdft-abi/files/bigdft-abi-1.0.4-0005.patch b/sci-libs/bigdft-abi/files/bigdft-abi-1.0.4-0005.patch |
147 |
new file mode 100644 |
148 |
index 0000000..ae59b7b |
149 |
--- /dev/null |
150 |
+++ b/sci-libs/bigdft-abi/files/bigdft-abi-1.0.4-0005.patch |
151 |
@@ -0,0 +1,5317 @@ |
152 |
+diff -urN bigdft-abi-1.0.4.old/configure.ac bigdft-abi-1.0.4.new/configure.ac |
153 |
+--- bigdft-abi-1.0.4.old/configure.ac 2012-07-09 16:43:33.000000000 +0200 |
154 |
++++ bigdft-abi-1.0.4.new/configure.ac 2013-06-11 16:51:00.000000000 +0200 |
155 |
+@@ -806,8 +806,8 @@ |
156 |
+ |
157 |
+ dnl Test the given implementation of libabinit. |
158 |
+ AC_CHECK_LIB(abinit, symbrav, withlibabinit=yes, withlibabinit=no) |
159 |
+- AC_CHECK_FILE($ac_libabinit_dir/include/ab6_moldyn.$ax_fc_mod_ext, moldyn="yes", moldyn="no") |
160 |
+- AC_CHECK_FILE($ac_libabinit_dir/include/ab6_symmetry.$ax_fc_mod_ext, sym="yes", sym="no") |
161 |
++ AC_CHECK_FILE($ac_libabinit_dir/include/ab7_moldyn.$ax_fc_mod_ext, moldyn="yes", moldyn="no") |
162 |
++ AC_CHECK_FILE($ac_libabinit_dir/include/ab7_symmetry.$ax_fc_mod_ext, sym="yes", sym="no") |
163 |
+ AC_CHECK_FILE($ac_libabinit_dir/include/libxc_functionals.$ax_fc_mod_ext, libxc="yes", libxc="no") |
164 |
+ if test "$withlibabinit" = "yes" -a "$moldyn" = "yes" -a "$sym" = "yes" -a "$libxc" = "yes"; then |
165 |
+ ac_use_libabinit="yes" |
166 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/10_defs/defs_basis.F90 bigdft-abi-1.0.4.new/libABINIT/src/10_defs/defs_basis.F90 |
167 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/10_defs/defs_basis.F90 2012-07-09 16:43:33.000000000 +0200 |
168 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/10_defs/defs_basis.F90 2013-06-11 16:51:00.000000000 +0200 |
169 |
+@@ -211,18 +211,18 @@ |
170 |
+ integer, parameter :: abinit_comm_serial = -12345 |
171 |
+ |
172 |
+ ! Error codes used by the bindings. |
173 |
+- integer, parameter, public :: AB6_NO_ERROR = 0 |
174 |
+- integer, parameter, public :: AB6_ERROR_OBJ = 1 |
175 |
+- integer, parameter, public :: AB6_ERROR_ARG = 2 |
176 |
+- integer, parameter, public :: AB6_ERROR_INVARS_ATT = 3 |
177 |
+- integer, parameter, public :: AB6_ERROR_INVARS_ID = 4 |
178 |
+- integer, parameter, public :: AB6_ERROR_INVARS_SIZE = 5 |
179 |
+- integer, parameter, public :: AB6_ERROR_SYM_NOT_PRIMITIVE = 6 |
180 |
+- integer, parameter, public :: AB6_ERROR_SYM_BRAVAIS_XRED = 7 |
181 |
+- integer, parameter, public :: AB6_ERROR_MIXING_ARG = 8 |
182 |
+- integer, parameter, public :: AB6_ERROR_MIXING_CONVERGENCE = 9 |
183 |
+- integer, parameter, public :: AB6_ERROR_MIXING_INTERNAL = 10 |
184 |
+- integer, parameter, public :: AB6_ERROR_MIXING_INC_NNSLOOP = 11 |
185 |
++ integer, parameter, public :: AB7_NO_ERROR = 0 |
186 |
++ integer, parameter, public :: AB7_ERROR_OBJ = 1 |
187 |
++ integer, parameter, public :: AB7_ERROR_ARG = 2 |
188 |
++ integer, parameter, public :: AB7_ERROR_INVARS_ATT = 3 |
189 |
++ integer, parameter, public :: AB7_ERROR_INVARS_ID = 4 |
190 |
++ integer, parameter, public :: AB7_ERROR_INVARS_SIZE = 5 |
191 |
++ integer, parameter, public :: AB7_ERROR_SYM_NOT_PRIMITIVE = 6 |
192 |
++ integer, parameter, public :: AB7_ERROR_SYM_BRAVAIS_XRED = 7 |
193 |
++ integer, parameter, public :: AB7_ERROR_MIXING_ARG = 8 |
194 |
++ integer, parameter, public :: AB7_ERROR_MIXING_CONVERGENCE = 9 |
195 |
++ integer, parameter, public :: AB7_ERROR_MIXING_INTERNAL = 10 |
196 |
++ integer, parameter, public :: AB7_ERROR_MIXING_INC_NNSLOOP = 11 |
197 |
+ |
198 |
+ ! Values of optdriver corresponding to the different run-levels. |
199 |
+ integer, parameter, public :: RUNL_GSTATE = 0 |
200 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/14_hidewrite/wrtout.F90 bigdft-abi-1.0.4.new/libABINIT/src/14_hidewrite/wrtout.F90 |
201 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/14_hidewrite/wrtout.F90 2012-07-09 16:43:33.000000000 +0200 |
202 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/14_hidewrite/wrtout.F90 2013-06-11 16:51:00.000000000 +0200 |
203 |
+@@ -62,7 +62,7 @@ |
204 |
+ !! ioniondist,irrzg,isfile,jellium,klocal,kpgio,kpgsph,kpgstr |
205 |
+ !! kramerskronig,ks_ddiago,kxc_alda,kxc_eok,ladielmt,lattice,lavnl |
206 |
+ !! leave_new,leave_test,linemin,listkk,lobpcgIIwf,lobpcgccIIwf,lobpcgccwf |
207 |
+-!! lobpcgwf,loop3dte,loper3,lwf,m_ab6_invars_f90,m_abilasi,m_atom |
208 |
++!! lobpcgwf,loop3dte,loper3,lwf,m_ab7_invars_f90,m_abilasi,m_atom |
209 |
+ !! m_bands_sym,m_bs_defs,m_bz_mesh,m_coulombian,m_crystal,m_dyson_solver |
210 |
+ !! m_ebands,m_errors,m_fft_mesh,m_fftw3,m_geometry,m_green,m_gsphere |
211 |
+ !! m_gwdefs,m_hamiltonian,m_hidecudarec,m_initcuda,m_io_kss,m_io_screening |
212 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/16_hideleave/leave_new.F90 bigdft-abi-1.0.4.new/libABINIT/src/16_hideleave/leave_new.F90 |
213 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/16_hideleave/leave_new.F90 2012-07-09 16:43:33.000000000 +0200 |
214 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/16_hideleave/leave_new.F90 2013-06-11 16:51:00.000000000 +0200 |
215 |
+@@ -54,7 +54,7 @@ |
216 |
+ !! inupper,invars0,invars1,invars1m,invars2,invars9,invcb,inwffil,inwffil3 |
217 |
+ !! ioarr,ioddb8_in,iofn1,iofn2,irrzg,isfile,jellium,klocal,kpgsph,kpgstr |
218 |
+ !! kxc_alda,kxc_eok,ladielmt,lavnl,linemin,listkk,lobpcgIIwf,lobpcgccIIwf |
219 |
+-!! loper3,lwf,m_ab6_invars_f90,m_errors,m_green,m_libxc_functionals |
220 |
++!! loper3,lwf,m_ab7_invars_f90,m_errors,m_green,m_libxc_functionals |
221 |
+ !! m_matlu,m_matrix,m_oper,m_paw_dmft,m_special_funcs,m_wffile |
222 |
+ !! mat_mlms2jmj,mat_slm2ylm,matcginv,matcginv_dpc,mati3inv,matrginv |
223 |
+ !! matrixelmt_g,mean_fftr,meanvalue_g,memana,metcon,metric,metstr,mka2f |
224 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/18_timing/timab.F90 bigdft-abi-1.0.4.new/libABINIT/src/18_timing/timab.F90 |
225 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/18_timing/timab.F90 2012-07-09 16:43:33.000000000 +0200 |
226 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/18_timing/timab.F90 2013-06-11 16:51:00.000000000 +0200 |
227 |
+@@ -50,7 +50,7 @@ |
228 |
+ !! getgsc,getngrec,gran_potrec,green_kernel,gstate,gstateimg,hartre |
229 |
+ !! hartre1,initylmg,inkpts,invars2,inwffil,inwffil3,kpgio,kpgsph,ladielmt |
230 |
+ !! lavnl,leave_test,lobpcgIIwf,lobpcgccIIwf,lobpcgccwf,lobpcgwf,loop3dte |
231 |
+-!! loper3,m_ab6_invars_f90,m_hidecudarec,m_screening,matrixelmt_g |
232 |
++!! loper3,m_ab7_invars_f90,m_hidecudarec,m_screening,matrixelmt_g |
233 |
+ !! mean_fftr,meanvalue_g,mkcore,mkffnl,mklocl_realspace,mklocl_recipspace |
234 |
+ !! mkresi,mkrho,mkrho3,mkvxc3,mkvxcstr3,newkpt,newocc,newrho,newvtr |
235 |
+ !! newvtr3,nhatgrid,nlenergyrec,nonlinear,nonlop,nstdy3,nstwf3,odamix |
236 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/32_util/mati3inv.F90 bigdft-abi-1.0.4.new/libABINIT/src/32_util/mati3inv.F90 |
237 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/32_util/mati3inv.F90 2012-07-09 16:43:33.000000000 +0200 |
238 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/32_util/mati3inv.F90 2013-06-11 16:51:00.000000000 +0200 |
239 |
+@@ -32,7 +32,7 @@ |
240 |
+ !! TODO |
241 |
+ !! |
242 |
+ !! PARENTS |
243 |
+-!! ab6_symmetry_f90,debug_tools,get_full_kgrid,getkgrid,ingeo,invars2m |
244 |
++!! ab7_symmetry_f90,debug_tools,get_full_kgrid,getkgrid,ingeo,invars2m |
245 |
+ !! m_bands_sym,m_crystal,m_fft_mesh,m_io_kss,nstdy3,optic,outscfcv,rdddb9 |
246 |
+ !! read_gkk,setsym,strainsym,symdij,symdyma,wfconv |
247 |
+ !! |
248 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/42_geometry/chkprimit.F90 bigdft-abi-1.0.4.new/libABINIT/src/42_geometry/chkprimit.F90 |
249 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/42_geometry/chkprimit.F90 2012-07-09 16:43:33.000000000 +0200 |
250 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/42_geometry/chkprimit.F90 2013-06-11 16:51:00.000000000 +0200 |
251 |
+@@ -32,7 +32,7 @@ |
252 |
+ ! |
253 |
+ !! |
254 |
+ !! PARENTS |
255 |
+-!! ingeo,ab6_symmetry_f90 |
256 |
++!! ingeo,ab7_symmetry_f90 |
257 |
+ !! |
258 |
+ !! CHILDREN |
259 |
+ !! leave_new,wrtout |
260 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/42_geometry/m_ab6_symmetry.F90 bigdft-abi-1.0.4.new/libABINIT/src/42_geometry/m_ab6_symmetry.F90 |
261 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/42_geometry/m_ab6_symmetry.F90 2012-07-09 16:43:33.000000000 +0200 |
262 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/42_geometry/m_ab6_symmetry.F90 1970-01-01 01:00:00.000000000 +0100 |
263 |
+@@ -1,1088 +0,0 @@ |
264 |
+-!* * Fortran90 source file * |
265 |
+-!* |
266 |
+-!* Copyright (c) 2008-2010 ABINIT Group (Damien Caliste) |
267 |
+-!* All rights reserved. |
268 |
+-!* |
269 |
+-!* This file is part of the ABINIT software package. For license information, |
270 |
+-!* please see the COPYING file in the top-level directory of the ABINIT source |
271 |
+-!* distribution. |
272 |
+-!* |
273 |
+-!* |
274 |
+- |
275 |
+-module m_ab6_symmetry |
276 |
+- |
277 |
+- use defs_basis |
278 |
+- |
279 |
+- implicit none |
280 |
+- |
281 |
+- private |
282 |
+- |
283 |
+- integer, parameter, public :: AB6_MAX_SYMMETRIES = 384 |
284 |
+- |
285 |
+- type, public :: symmetry_type |
286 |
+- ! The input characteristics |
287 |
+- real(dp) :: tolsym |
288 |
+- real(dp) :: rprimd(3,3), gprimd(3,3), rmet(3,3) |
289 |
+- integer :: nAtoms |
290 |
+- integer, pointer :: typeAt(:) |
291 |
+- real(dp), pointer :: xRed(:,:) |
292 |
+- |
293 |
+- logical :: withField |
294 |
+- real(dp) :: field(3) |
295 |
+- |
296 |
+- logical :: withJellium |
297 |
+- |
298 |
+- integer :: withSpin |
299 |
+- real(dp), pointer :: spinAt(:,:) |
300 |
+- |
301 |
+- logical :: withSpinOrbit |
302 |
+- |
303 |
+- integer :: vacuum(3) |
304 |
+- |
305 |
+- ! The output characteristics |
306 |
+- ! The bravais parameters |
307 |
+- integer :: nBravSym |
308 |
+- integer :: bravais(11), bravSym(3, 3, AB6_MAX_SYMMETRIES) |
309 |
+- ! The symmetry matrices |
310 |
+- logical :: auto |
311 |
+- integer :: nSym |
312 |
+- integer, pointer :: sym(:,:,:) |
313 |
+- real(dp), pointer :: transNon(:,:) |
314 |
+- integer, pointer :: symAfm(:) |
315 |
+- ! Some additional information |
316 |
+- integer :: multiplicity |
317 |
+- real(dp) :: genAfm(3) |
318 |
+- integer :: spaceGroup, pointGroupMagn |
319 |
+- integer, pointer :: indexingAtoms(:,:,:) |
320 |
+- end type symmetry_type |
321 |
+- |
322 |
+- ! We store here a list of symmetry objects to be able to |
323 |
+- ! call several symmetry operations on different objects. |
324 |
+- ! The simplest portable way to do it, is to create |
325 |
+- ! a list of Fortran structure and to use the list index |
326 |
+- ! as an identifier that can be given to the other languages. |
327 |
+- type, private :: symmetry_list |
328 |
+- integer :: id |
329 |
+- type(symmetry_list), pointer :: next |
330 |
+- type(symmetry_type) :: data |
331 |
+- end type symmetry_list |
332 |
+- type(symmetry_list), pointer :: my_symmetries |
333 |
+- integer :: n_symmetries = 0 |
334 |
+- |
335 |
+- logical, private, parameter :: AB_DBG = .false. |
336 |
+- |
337 |
+- public :: symmetry_new |
338 |
+- public :: symmetry_free |
339 |
+- public :: symmetry_set_tolerance |
340 |
+- public :: symmetry_set_lattice |
341 |
+- public :: symmetry_set_structure |
342 |
+- public :: symmetry_set_collinear_spin |
343 |
+- public :: symmetry_set_spin |
344 |
+- public :: symmetry_set_spin_orbit |
345 |
+- public :: symmetry_set_field |
346 |
+- public :: symmetry_set_jellium |
347 |
+- public :: symmetry_set_periodicity |
348 |
+- public :: symmetry_set_n_sym |
349 |
+- |
350 |
+- public :: symmetry_get_from_id |
351 |
+- public :: symmetry_get_n_atoms |
352 |
+- public :: symmetry_get_n_sym |
353 |
+- public :: symmetry_get_multiplicity |
354 |
+- public :: symmetry_get_bravais |
355 |
+- public :: symmetry_get_matrices |
356 |
+- public :: symmetry_get_matrices_p |
357 |
+- public :: symmetry_get_group |
358 |
+- public :: symmetry_get_equivalent_atom |
359 |
+- |
360 |
+-contains |
361 |
+- |
362 |
+- subroutine new_item(token) |
363 |
+- |
364 |
+- |
365 |
+-!This section has been created automatically by the script Abilint (TD). |
366 |
+-!Do not modify the following lines by hand. |
367 |
+-!End of the abilint section |
368 |
+- |
369 |
+- type(symmetry_list), pointer :: token |
370 |
+- |
371 |
+- ! We allocate a new list token and prepend it. |
372 |
+- if (AB_DBG) write(0,*) "AB symmetry: create a new token." |
373 |
+- |
374 |
+- ! Init case, very first call. |
375 |
+- if (n_symmetries == 0) then |
376 |
+- nullify(my_symmetries) |
377 |
+- end if |
378 |
+- |
379 |
+- ! Normal treatment. |
380 |
+- n_symmetries = n_symmetries + 1 |
381 |
+- |
382 |
+- allocate(token) |
383 |
+- token%id = n_symmetries |
384 |
+- call new_symmetry(token%data) |
385 |
+- token%next => my_symmetries |
386 |
+- |
387 |
+- my_symmetries => token |
388 |
+- if (AB_DBG) write(0,*) "AB symmetry: creation OK with id ", token%id |
389 |
+- end subroutine new_item |
390 |
+- |
391 |
+- subroutine free_item(token) |
392 |
+- |
393 |
+- |
394 |
+-!This section has been created automatically by the script Abilint (TD). |
395 |
+-!Do not modify the following lines by hand. |
396 |
+-!End of the abilint section |
397 |
+- |
398 |
+- type(symmetry_list), pointer :: token |
399 |
+- |
400 |
+- type(symmetry_list), pointer :: tmp |
401 |
+- |
402 |
+- if (.not. associated(token)) then |
403 |
+- return |
404 |
+- end if |
405 |
+- |
406 |
+- call free_symmetry(token%data) |
407 |
+- |
408 |
+- if (AB_DBG) write(0,*) "AB symmetry: free request on token ", token%id |
409 |
+- ! We remove token from the list. |
410 |
+- if (my_symmetries%id == token%id) then |
411 |
+- my_symmetries => token%next |
412 |
+- else |
413 |
+- tmp => my_symmetries |
414 |
+- do |
415 |
+- if (.not.associated(tmp)) then |
416 |
+- return |
417 |
+- end if |
418 |
+- if (associated(tmp%next) .and. tmp%next%id == token%id) then |
419 |
+- exit |
420 |
+- end if |
421 |
+- tmp => tmp%next |
422 |
+- end do |
423 |
+- tmp%next => token%next |
424 |
+- end if |
425 |
+- deallocate(token) |
426 |
+- if (AB_DBG) write(0,*) "AB symmetry: free done" |
427 |
+- end subroutine free_item |
428 |
+- |
429 |
+- subroutine get_item(token, id) |
430 |
+- |
431 |
+- |
432 |
+- type(symmetry_list), pointer :: token |
433 |
+- integer, intent(in) :: id |
434 |
+- |
435 |
+- type(symmetry_list), pointer :: tmp |
436 |
+- |
437 |
+- if (AB_DBG) write(0,*) "AB symmetry: request list element ", id |
438 |
+- nullify(token) |
439 |
+- |
440 |
+- tmp => my_symmetries |
441 |
+- do |
442 |
+- if (.not. associated(tmp)) then |
443 |
+- exit |
444 |
+- end if |
445 |
+- if (tmp%id == id) then |
446 |
+- token => tmp |
447 |
+- return |
448 |
+- end if |
449 |
+- tmp => tmp%next |
450 |
+- end do |
451 |
+- end subroutine get_item |
452 |
+- |
453 |
+- subroutine symmetry_get_from_id(sym, id, errno) |
454 |
+- |
455 |
+- type(symmetry_type), pointer :: sym |
456 |
+- integer, intent(in) :: id |
457 |
+- integer, intent(out) :: errno |
458 |
+- |
459 |
+- type(symmetry_list), pointer :: token |
460 |
+- |
461 |
+- errno = AB6_NO_ERROR |
462 |
+- call get_item(token, id) |
463 |
+- if (associated(token)) then |
464 |
+- sym => token%data |
465 |
+- if (sym%nSym <= 0) then |
466 |
+- ! We do the computation of the matrix part. |
467 |
+- call compute_matrices(sym, errno) |
468 |
+- end if |
469 |
+- else |
470 |
+- errno = AB6_ERROR_OBJ |
471 |
+- nullify(sym) |
472 |
+- end if |
473 |
+- end subroutine symmetry_get_from_id |
474 |
+- |
475 |
+- subroutine new_symmetry(sym) |
476 |
+- |
477 |
+- |
478 |
+- type(symmetry_type), intent(out) :: sym |
479 |
+- |
480 |
+- if (AB_DBG) write(0,*) "AB symmetry: create a new symmetry object." |
481 |
+- nullify(sym%xRed) |
482 |
+- nullify(sym%spinAt) |
483 |
+- nullify(sym%typeAt) |
484 |
+- sym%tolsym = tol8 |
485 |
+- sym%auto = .true. |
486 |
+- sym%nSym = 0 |
487 |
+- nullify(sym%sym) |
488 |
+- nullify(sym%symAfm) |
489 |
+- nullify(sym%transNon) |
490 |
+- sym%nBravSym = -1 |
491 |
+- sym%withField = .false. |
492 |
+- sym%withJellium = .false. |
493 |
+- sym%withSpin = 1 |
494 |
+- sym%withSpinOrbit = .false. |
495 |
+- sym%multiplicity = -1 |
496 |
+- nullify(sym%indexingAtoms) |
497 |
+- sym%vacuum = 0 |
498 |
+- end subroutine new_symmetry |
499 |
+- |
500 |
+- subroutine free_symmetry(sym) |
501 |
+- |
502 |
+- |
503 |
+- type(symmetry_type), intent(inout) :: sym |
504 |
+- |
505 |
+- if (AB_DBG) write(0,*) "AB symmetry: free a symmetry." |
506 |
+- |
507 |
+- if (associated(sym%xRed)) deallocate(sym%xRed) |
508 |
+- if (associated(sym%spinAt)) deallocate(sym%spinAt) |
509 |
+- if (associated(sym%typeAt)) deallocate(sym%typeAt) |
510 |
+- if (associated(sym%indexingAtoms)) deallocate(sym%indexingAtoms) |
511 |
+- if (associated(sym%sym)) deallocate(sym%sym) |
512 |
+- if (associated(sym%symAfm)) deallocate(sym%symAfm) |
513 |
+- if (associated(sym%transNon)) deallocate(sym%transNon) |
514 |
+- end subroutine free_symmetry |
515 |
+- |
516 |
+- |
517 |
+- |
518 |
+- |
519 |
+- |
520 |
+- subroutine symmetry_new(id) |
521 |
+- |
522 |
+- |
523 |
+-!This section has been created automatically by the script Abilint (TD). |
524 |
+-!Do not modify the following lines by hand. |
525 |
+-!End of the abilint section |
526 |
+- |
527 |
+- integer, intent(out) :: id |
528 |
+- |
529 |
+- type(symmetry_list), pointer :: token |
530 |
+- |
531 |
+- if (AB_DBG) write(0,*) "AB symmetry: call new symmetry." |
532 |
+- call new_item(token) |
533 |
+- id = token%id |
534 |
+- end subroutine symmetry_new |
535 |
+- |
536 |
+- subroutine symmetry_free(id) |
537 |
+- |
538 |
+- |
539 |
+-!This section has been created automatically by the script Abilint (TD). |
540 |
+-!Do not modify the following lines by hand. |
541 |
+-!End of the abilint section |
542 |
+- |
543 |
+- integer, intent(in) :: id |
544 |
+- |
545 |
+- type(symmetry_list), pointer :: token |
546 |
+- |
547 |
+- if (AB_DBG) write(0,*) "AB symmetry: call free symmetry." |
548 |
+- |
549 |
+- call get_item(token, id) |
550 |
+- if (associated(token)) call free_item(token) |
551 |
+- end subroutine symmetry_free |
552 |
+- |
553 |
+- subroutine symmetry_set_tolerance(id, tolsym, errno) |
554 |
+- |
555 |
+- |
556 |
+-!This section has been created automatically by the script Abilint (TD). |
557 |
+-!Do not modify the following lines by hand. |
558 |
+-!End of the abilint section |
559 |
+- |
560 |
+- integer, intent(in) :: id |
561 |
+- real(dp), intent(in) :: tolsym |
562 |
+- integer, intent(out) :: errno |
563 |
+- |
564 |
+- type(symmetry_list), pointer :: token |
565 |
+- |
566 |
+- if (AB_DBG) write(0,*) "AB symmetry: call set tolerance." |
567 |
+- |
568 |
+- errno = AB6_NO_ERROR |
569 |
+- call get_item(token, id) |
570 |
+- if (.not. associated(token)) then |
571 |
+- errno = AB6_ERROR_OBJ |
572 |
+- return |
573 |
+- end if |
574 |
+- |
575 |
+- token%data%tolsym = tolsym |
576 |
+- |
577 |
+- ! We unset all the computed symmetries |
578 |
+- token%data%nBravSym = -1 |
579 |
+- if (token%data%auto) then |
580 |
+- token%data%nSym = 0 |
581 |
+- end if |
582 |
+- end subroutine symmetry_set_tolerance |
583 |
+- |
584 |
+- subroutine symmetry_set_lattice(id, rprimd, errno) |
585 |
+- |
586 |
+- |
587 |
+-!This section has been created automatically by the script Abilint (TD). |
588 |
+-!Do not modify the following lines by hand. |
589 |
+- use interfaces_42_geometry |
590 |
+-!End of the abilint section |
591 |
+- |
592 |
+- integer, intent(in) :: id |
593 |
+- real(dp), intent(in) :: rprimd(3,3) |
594 |
+- integer, intent(out) :: errno |
595 |
+- |
596 |
+- type(symmetry_list), pointer :: token |
597 |
+- real(dp) :: ucvol |
598 |
+- real(dp) :: gmet(3,3) |
599 |
+- |
600 |
+- if (AB_DBG) write(0,*) "AB symmetry: call set lattice." |
601 |
+- if (AB_DBG) write(0, "(A,3F12.6,A)") " (", rprimd(:,1), ")" |
602 |
+- if (AB_DBG) write(0, "(A,3F12.6,A)") " (", rprimd(:,2), ")" |
603 |
+- if (AB_DBG) write(0, "(A,3F12.6,A)") " (", rprimd(:,3), ")" |
604 |
+- |
605 |
+- errno = AB6_NO_ERROR |
606 |
+- call get_item(token, id) |
607 |
+- if (.not. associated(token)) then |
608 |
+- errno = AB6_ERROR_OBJ |
609 |
+- return |
610 |
+- end if |
611 |
+- |
612 |
+- token%data%rprimd = rprimd |
613 |
+- call metric(gmet, token%data%gprimd, -1, token%data%rmet, rprimd, ucvol) |
614 |
+- |
615 |
+- ! We unset all the computed symmetries |
616 |
+- token%data%nBravSym = -1 |
617 |
+- if (token%data%auto) then |
618 |
+- token%data%nSym = 0 |
619 |
+- end if |
620 |
+- end subroutine symmetry_set_lattice |
621 |
+- |
622 |
+- subroutine symmetry_set_structure(id, nAtoms, typeAt, xRed, errno) |
623 |
+- |
624 |
+- |
625 |
+-!This section has been created automatically by the script Abilint (TD). |
626 |
+-!Do not modify the following lines by hand. |
627 |
+-!End of the abilint section |
628 |
+- |
629 |
+- integer, intent(in) :: id |
630 |
+- integer, intent(in) :: nAtoms |
631 |
+- integer, intent(in) :: typeAt(nAtoms) |
632 |
+- real(dp), intent(in) :: xRed(3,nAtoms) |
633 |
+- integer, intent(out) :: errno |
634 |
+- |
635 |
+- type(symmetry_list), pointer :: token |
636 |
+- integer :: i |
637 |
+- |
638 |
+- if (AB_DBG) write(0,*) "AB symmetry: call set structure." |
639 |
+- if (AB_DBG) write(0, "(A,I3,A)") " ", nAtoms, " atoms" |
640 |
+- if (AB_DBG) then |
641 |
+- do i = 1, nAtoms, 1 |
642 |
+- write(0, "(A,3F12.6,I3)") " ", xRed(:, i), typeAt(i) |
643 |
+- end do |
644 |
+- end if |
645 |
+- |
646 |
+- errno = AB6_NO_ERROR |
647 |
+- call get_item(token, id) |
648 |
+- if (.not. associated(token)) then |
649 |
+- errno = AB6_ERROR_OBJ |
650 |
+- return |
651 |
+- end if |
652 |
+- |
653 |
+- token%data%nAtoms = nAtoms |
654 |
+- allocate(token%data%typeAt(nAtoms)) |
655 |
+- token%data%typeAt = typeAt |
656 |
+- allocate(token%data%xRed(3, nAtoms)) |
657 |
+- token%data%xRed = xRed |
658 |
+- |
659 |
+- ! We unset only the symmetries |
660 |
+- if (token%data%auto) then |
661 |
+- token%data%nSym = 0 |
662 |
+- end if |
663 |
+- if (associated(token%data%indexingAtoms)) deallocate(token%data%indexingAtoms) |
664 |
+- end subroutine symmetry_set_structure |
665 |
+- |
666 |
+- subroutine symmetry_set_spin(id, nAtoms, spinAt, errno) |
667 |
+- |
668 |
+- |
669 |
+-!This section has been created automatically by the script Abilint (TD). |
670 |
+-!Do not modify the following lines by hand. |
671 |
+-!End of the abilint section |
672 |
+- |
673 |
+- integer, intent(in) :: id |
674 |
+- integer, intent(in) :: nAtoms |
675 |
+- real(dp), intent(in) :: spinAt(3,nAtoms) |
676 |
+- integer, intent(out) :: errno |
677 |
+- |
678 |
+- type(symmetry_list), pointer :: token |
679 |
+- integer :: i |
680 |
+- |
681 |
+- if (AB_DBG) write(0,*) "AB symmetry: call set spin." |
682 |
+- if (AB_DBG) then |
683 |
+- do i = 1, nAtoms, 1 |
684 |
+- write(0, "(A,3F12.6)") " ", spinAt(:, i) |
685 |
+- end do |
686 |
+- end if |
687 |
+- |
688 |
+- errno = AB6_NO_ERROR |
689 |
+- call get_item(token, id) |
690 |
+- if (.not. associated(token)) then |
691 |
+- errno = AB6_ERROR_OBJ |
692 |
+- return |
693 |
+- end if |
694 |
+- if (token%data%nAtoms /= nAtoms) then |
695 |
+- errno = AB6_ERROR_ARG |
696 |
+- return |
697 |
+- end if |
698 |
+- |
699 |
+- token%data%withSpin = 4 |
700 |
+- allocate(token%data%spinAt(3, nAtoms)) |
701 |
+- token%data%spinAt = spinAt |
702 |
+- |
703 |
+- ! We unset only the symmetries |
704 |
+- if (token%data%auto) then |
705 |
+- token%data%nSym = 0 |
706 |
+- end if |
707 |
+- end subroutine symmetry_set_spin |
708 |
+- |
709 |
+- subroutine symmetry_set_collinear_spin(id, nAtoms, spinAt, errno) |
710 |
+- |
711 |
+- |
712 |
+-!This section has been created automatically by the script Abilint (TD). |
713 |
+-!Do not modify the following lines by hand. |
714 |
+-!End of the abilint section |
715 |
+- |
716 |
+- integer, intent(in) :: id |
717 |
+- integer, intent(in) :: nAtoms |
718 |
+- integer, intent(in) :: spinAt(nAtoms) |
719 |
+- integer, intent(out) :: errno |
720 |
+- |
721 |
+- type(symmetry_list), pointer :: token |
722 |
+- integer :: i |
723 |
+- |
724 |
+- if (AB_DBG) write(0,*) "AB symmetry: call set collinear spin." |
725 |
+- if (AB_DBG) then |
726 |
+- do i = 1, nAtoms, 1 |
727 |
+- write(0, "(A,I3)") " ", spinAt(i) |
728 |
+- end do |
729 |
+- end if |
730 |
+- |
731 |
+- errno = AB6_NO_ERROR |
732 |
+- call get_item(token, id) |
733 |
+- if (.not. associated(token)) then |
734 |
+- errno = AB6_ERROR_OBJ |
735 |
+- return |
736 |
+- end if |
737 |
+- if (token%data%nAtoms /= nAtoms) then |
738 |
+- errno = AB6_ERROR_ARG |
739 |
+- return |
740 |
+- end if |
741 |
+- |
742 |
+- token%data%withSpin = 2 |
743 |
+- allocate(token%data%spinAt(1, nAtoms)) |
744 |
+- token%data%spinAt = real(reshape(spinAt, (/ 1, nAtoms /)), dp) |
745 |
+- |
746 |
+- ! We unset only the symmetries |
747 |
+- if (token%data%auto) then |
748 |
+- token%data%nSym = 0 |
749 |
+- end if |
750 |
+- end subroutine symmetry_set_collinear_spin |
751 |
+- |
752 |
+- subroutine symmetry_set_spin_orbit(id, withSpinOrbit, errno) |
753 |
+- |
754 |
+- |
755 |
+-!This section has been created automatically by the script Abilint (TD). |
756 |
+-!Do not modify the following lines by hand. |
757 |
+-!End of the abilint section |
758 |
+- |
759 |
+- integer, intent(in) :: id |
760 |
+- logical, intent(in) :: withSpinOrbit |
761 |
+- integer, intent(out) :: errno |
762 |
+- |
763 |
+- type(symmetry_list), pointer :: token |
764 |
+- |
765 |
+- if (AB_DBG) write(0,*) "AB symmetry: call set spin orbit." |
766 |
+- |
767 |
+- errno = AB6_NO_ERROR |
768 |
+- call get_item(token, id) |
769 |
+- if (.not. associated(token)) then |
770 |
+- errno = AB6_ERROR_OBJ |
771 |
+- return |
772 |
+- end if |
773 |
+- |
774 |
+- token%data%withSpinOrbit = withSpinOrbit |
775 |
+- |
776 |
+- ! We unset only the symmetries |
777 |
+- if (token%data%auto) then |
778 |
+- token%data%nSym = 0 |
779 |
+- end if |
780 |
+- end subroutine symmetry_set_spin_orbit |
781 |
+- |
782 |
+- subroutine symmetry_set_field(id, field, errno) |
783 |
+- |
784 |
+- |
785 |
+-!This section has been created automatically by the script Abilint (TD). |
786 |
+-!Do not modify the following lines by hand. |
787 |
+-!End of the abilint section |
788 |
+- |
789 |
+- integer, intent(in) :: id |
790 |
+- real(dp), intent(in) :: field(3) |
791 |
+- integer, intent(out) :: errno |
792 |
+- |
793 |
+- type(symmetry_list), pointer :: token |
794 |
+- |
795 |
+- if (AB_DBG) write(0,*) "AB symmetry: call set field." |
796 |
+- |
797 |
+- errno = AB6_NO_ERROR |
798 |
+- call get_item(token, id) |
799 |
+- if (.not. associated(token)) then |
800 |
+- errno = AB6_ERROR_OBJ |
801 |
+- return |
802 |
+- end if |
803 |
+- |
804 |
+- token%data%withField = .true. |
805 |
+- token%data%field = field |
806 |
+- |
807 |
+- ! We unset all the computed symmetries |
808 |
+- token%data%nBravSym = -1 |
809 |
+- if (token%data%auto) then |
810 |
+- token%data%nSym = 0 |
811 |
+- end if |
812 |
+- end subroutine symmetry_set_field |
813 |
+- |
814 |
+- subroutine symmetry_set_jellium(id, jellium, errno) |
815 |
+- |
816 |
+- |
817 |
+-!This section has been created automatically by the script Abilint (TD). |
818 |
+-!Do not modify the following lines by hand. |
819 |
+-!End of the abilint section |
820 |
+- |
821 |
+- integer, intent(in) :: id |
822 |
+- logical, intent(in) :: jellium |
823 |
+- integer, intent(out) :: errno |
824 |
+- |
825 |
+- type(symmetry_list), pointer :: token |
826 |
+- |
827 |
+- if (AB_DBG) write(0,*) "AB symmetry: call set jellium." |
828 |
+- |
829 |
+- errno = AB6_NO_ERROR |
830 |
+- call get_item(token, id) |
831 |
+- if (.not. associated(token)) then |
832 |
+- errno = AB6_ERROR_OBJ |
833 |
+- return |
834 |
+- end if |
835 |
+- |
836 |
+- token%data%withJellium = jellium |
837 |
+- |
838 |
+- ! We unset only the symmetries |
839 |
+- if (token%data%auto) then |
840 |
+- token%data%nSym = 0 |
841 |
+- end if |
842 |
+- end subroutine symmetry_set_jellium |
843 |
+- |
844 |
+- subroutine symmetry_set_periodicity(id, periodic, errno) |
845 |
+- |
846 |
+- |
847 |
+-!This section has been created automatically by the script Abilint (TD). |
848 |
+-!Do not modify the following lines by hand. |
849 |
+-!End of the abilint section |
850 |
+- |
851 |
+- integer, intent(in) :: id |
852 |
+- logical, intent(in) :: periodic(3) |
853 |
+- integer, intent(out) :: errno |
854 |
+- |
855 |
+- type(symmetry_list), pointer :: token |
856 |
+- |
857 |
+- if (AB_DBG) write(0,*) "AB symmetry: call set periodicity." |
858 |
+- if (AB_DBG) write(0, "(A,3L1,A)") " (", periodic, ")" |
859 |
+- |
860 |
+- errno = AB6_NO_ERROR |
861 |
+- call get_item(token, id) |
862 |
+- if (.not. associated(token)) then |
863 |
+- errno = AB6_ERROR_OBJ |
864 |
+- return |
865 |
+- end if |
866 |
+- |
867 |
+- token%data%vacuum = 0 |
868 |
+- if (.not. periodic(1)) token%data%vacuum(1) = 1 |
869 |
+- if (.not. periodic(2)) token%data%vacuum(2) = 1 |
870 |
+- if (.not. periodic(3)) token%data%vacuum(3) = 1 |
871 |
+- end subroutine symmetry_set_periodicity |
872 |
+- |
873 |
+- |
874 |
+- |
875 |
+- |
876 |
+- |
877 |
+- subroutine symmetry_get_n_atoms(id, nAtoms, errno) |
878 |
+- !scalars |
879 |
+- |
880 |
+-!This section has been created automatically by the script Abilint (TD). |
881 |
+-!Do not modify the following lines by hand. |
882 |
+-!End of the abilint section |
883 |
+- |
884 |
+- integer, intent(in) :: id |
885 |
+- integer, intent(out) :: errno |
886 |
+- integer, intent(out) :: nAtoms |
887 |
+- |
888 |
+- type(symmetry_list), pointer :: token |
889 |
+- |
890 |
+- if (AB_DBG) write(0,*) "AB symmetry: call get nAtoms." |
891 |
+- |
892 |
+- errno = AB6_NO_ERROR |
893 |
+- call get_item(token, id) |
894 |
+- if (.not. associated(token)) then |
895 |
+- errno = AB6_ERROR_OBJ |
896 |
+- return |
897 |
+- end if |
898 |
+- |
899 |
+- nAtoms = token%data%nAtoms |
900 |
+- end subroutine symmetry_get_n_atoms |
901 |
+- |
902 |
+- subroutine compute_bravais(sym) |
903 |
+- |
904 |
+- |
905 |
+-!This section has been created automatically by the script Abilint (TD). |
906 |
+-!Do not modify the following lines by hand. |
907 |
+- use interfaces_42_geometry |
908 |
+-!End of the abilint section |
909 |
+- |
910 |
+- type(symmetry_type), intent(inout) :: sym |
911 |
+- |
912 |
+- integer :: berryopt |
913 |
+- |
914 |
+- ! We do the computation |
915 |
+- if (sym%withField) then |
916 |
+- berryopt = 4 |
917 |
+- else |
918 |
+- berryopt = 0 |
919 |
+- end if |
920 |
+- if (AB_DBG) write(0,*) "AB symmetry: call ABINIT symlatt." |
921 |
+- call symlatt(sym%bravais, AB6_MAX_SYMMETRIES, & |
922 |
+- & sym%nBravSym, sym%bravSym, sym%rprimd, sym%tolsym) |
923 |
+- if (AB_DBG) write(0,*) "AB symmetry: call ABINIT OK." |
924 |
+- if (AB_DBG) write(0, "(A,I3)") " nSymBrav :", sym%nBravSym |
925 |
+- if (AB_DBG) write(0, "(A,I3)") " holohedry:", sym%bravais(1) |
926 |
+- if (AB_DBG) write(0, "(A,I3)") " center :", sym%bravais(2) |
927 |
+- end subroutine compute_bravais |
928 |
+- |
929 |
+- subroutine symmetry_get_bravais(id, bravais, holohedry, center, & |
930 |
+- & nBravSym, bravSym, errno) |
931 |
+- !scalars |
932 |
+- |
933 |
+-!This section has been created automatically by the script Abilint (TD). |
934 |
+-!Do not modify the following lines by hand. |
935 |
+-!End of the abilint section |
936 |
+- |
937 |
+- integer, intent(in) :: id |
938 |
+- integer, intent(out) :: errno |
939 |
+- integer, intent(out) :: nBravSym, holohedry, center |
940 |
+- !arrays |
941 |
+- integer, intent(out) :: bravais(3,3), bravSym(3, 3, AB6_MAX_SYMMETRIES) |
942 |
+- |
943 |
+- type(symmetry_list), pointer :: token |
944 |
+- |
945 |
+- if (AB_DBG) write(0,*) "AB symmetry: call get bravais." |
946 |
+- |
947 |
+- errno = AB6_NO_ERROR |
948 |
+- call get_item(token, id) |
949 |
+- if (.not. associated(token)) then |
950 |
+- errno = AB6_ERROR_OBJ |
951 |
+- return |
952 |
+- end if |
953 |
+- |
954 |
+- if (token%data%nBravSym < 0) then |
955 |
+- ! We do the computation |
956 |
+- call compute_bravais(token%data) |
957 |
+- end if |
958 |
+- |
959 |
+- holohedry = token%data%bravais(1) |
960 |
+- center = token%data%bravais(2) |
961 |
+- bravais = reshape(token%data%bravais(3:11), (/ 3,3 /)) |
962 |
+- nBravSym = token%data%nBravSym |
963 |
+- bravSym(:, :, 1:nBravSym) = token%data%bravSym(:, :, 1:nBravSym) |
964 |
+- end subroutine symmetry_get_bravais |
965 |
+- |
966 |
+- subroutine compute_matrices(sym, errno) |
967 |
+- |
968 |
+- |
969 |
+-!This section has been created automatically by the script Abilint (TD). |
970 |
+-!Do not modify the following lines by hand. |
971 |
+- use interfaces_42_geometry |
972 |
+-!End of the abilint section |
973 |
+- |
974 |
+- type(symmetry_type), intent(inout) :: sym |
975 |
+- integer, intent(out) :: errno |
976 |
+- |
977 |
+- integer :: berryopt, jellslab, noncol |
978 |
+- integer :: use_inversion |
979 |
+- real(dp), pointer :: spinAt_(:,:) |
980 |
+- integer :: sym_(3, 3, AB6_MAX_SYMMETRIES) |
981 |
+- real(dp) :: transNon_(3, AB6_MAX_SYMMETRIES) |
982 |
+- integer :: symAfm_(AB6_MAX_SYMMETRIES) |
983 |
+- |
984 |
+- errno = AB6_NO_ERROR |
985 |
+- |
986 |
+- if (sym%nBravSym < 0) then |
987 |
+- ! We do the computation of the Bravais part. |
988 |
+- call compute_bravais(sym) |
989 |
+- end if |
990 |
+- |
991 |
+- if (sym%withField) then |
992 |
+- berryopt = 4 |
993 |
+- else |
994 |
+- berryopt = 0 |
995 |
+- end if |
996 |
+- if (sym%withJellium) then |
997 |
+- jellslab = 1 |
998 |
+- else |
999 |
+- jellslab = 0 |
1000 |
+- end if |
1001 |
+- if (sym%withSpin == 4) then |
1002 |
+- noncol = 1 |
1003 |
+- spinAt_ => sym%spinAt |
1004 |
+- else if (sym%withSpin == 2) then |
1005 |
+- noncol = 0 |
1006 |
+- spinAt_ => sym%spinAt |
1007 |
+- else |
1008 |
+- noncol = 0 |
1009 |
+- allocate(spinAt_(3, sym%nAtoms)) |
1010 |
+- spinAt_ = 0 |
1011 |
+- end if |
1012 |
+- if (sym%withSpinOrbit) then |
1013 |
+- use_inversion = 0 |
1014 |
+- else |
1015 |
+- use_inversion = 1 |
1016 |
+- end if |
1017 |
+- |
1018 |
+- if (sym%nsym == 0) then |
1019 |
+- if (AB_DBG) write(0,*) "AB symmetry: call ABINIT symfind." |
1020 |
+- call symfind(berryopt, sym%field, sym%gprimd, jellslab, AB6_MAX_SYMMETRIES, & |
1021 |
+- & sym%nAtoms, noncol, sym%nBravSym, sym%nSym, sym%bravSym, spinAt_, & |
1022 |
+- & symAfm_, sym_, transNon_, sym%tolsym, sym%typeAt, & |
1023 |
+- & use_inversion, sym%xRed) |
1024 |
+- if (AB_DBG) write(0,*) "AB symmetry: call ABINIT OK." |
1025 |
+- if (AB_DBG) write(0, "(A,I3)") " nSym:", sym%nSym |
1026 |
+- if (associated(sym%sym)) deallocate(sym%sym) |
1027 |
+- if (associated(sym%symAfm)) deallocate(sym%symAfm) |
1028 |
+- if (associated(sym%transNon)) deallocate(sym%transNon) |
1029 |
+- allocate(sym%sym(3, 3, sym%nSym)) |
1030 |
+- sym%sym(:,:,:) = sym_(:,:, 1:sym%nSym) |
1031 |
+- allocate(sym%symAfm(sym%nSym)) |
1032 |
+- sym%symAfm(:) = symAfm_(1:sym%nSym) |
1033 |
+- allocate(sym%transNon(3, sym%nSym)) |
1034 |
+- sym%transNon(:,:) = transNon_(:, 1:sym%nSym) |
1035 |
+- else if (sym%nsym < 0) then |
1036 |
+- sym%nsym = -sym%nsym |
1037 |
+- sym_(:,:, 1:sym%nSym) = sym%sym(:,:,:) |
1038 |
+- transNon_(:, 1:sym%nSym) = sym%transNon(:,:) |
1039 |
+- symAfm_(1:sym%nSym) = sym%symAfm(:) |
1040 |
+- end if |
1041 |
+- |
1042 |
+- if (sym%withSpin == 1) then |
1043 |
+- deallocate(spinAt_) |
1044 |
+- end if |
1045 |
+- |
1046 |
+- if (AB_DBG) write(0,*) "AB symmetry: call ABINIT symanal." |
1047 |
+- call symanal(sym%bravais, 0, sym%genAfm, AB6_MAX_SYMMETRIES, sym%nSym, & |
1048 |
+- & sym%pointGroupMagn, sym%rprimd, sym%spaceGroup, symAfm_, & |
1049 |
+- & sym_, transNon_, sym%tolsym) |
1050 |
+- if (AB_DBG) write(0,*) "AB symmetry: call ABINIT OK." |
1051 |
+- sym%transNon(:,:) = transNon_(:, 1:sym%nSym) |
1052 |
+- |
1053 |
+- if (sym%bravais(1) < 0) then |
1054 |
+- sym%multiplicity = 2 |
1055 |
+- else |
1056 |
+- sym%multiplicity = 1 |
1057 |
+- end if |
1058 |
+- if (AB_DBG) write(0, "(A,I3)") " multi:", sym%multiplicity |
1059 |
+- if (AB_DBG) write(0, "(A,I3)") " space:", sym%spaceGroup |
1060 |
+- end subroutine compute_matrices |
1061 |
+- |
1062 |
+- subroutine symmetry_get_n_sym(id, nSym, errno) |
1063 |
+- !scalars |
1064 |
+- |
1065 |
+-!This section has been created automatically by the script Abilint (TD). |
1066 |
+-!Do not modify the following lines by hand. |
1067 |
+-!End of the abilint section |
1068 |
+- |
1069 |
+- integer, intent(in) :: id |
1070 |
+- integer, intent(out) :: errno |
1071 |
+- integer, intent(out) :: nSym |
1072 |
+- |
1073 |
+- type(symmetry_list), pointer :: token |
1074 |
+- |
1075 |
+- if (AB_DBG) write(0,*) "AB symmetry: call get nSym." |
1076 |
+- |
1077 |
+- errno = AB6_NO_ERROR |
1078 |
+- call get_item(token, id) |
1079 |
+- if (.not. associated(token)) then |
1080 |
+- errno = AB6_ERROR_OBJ |
1081 |
+- return |
1082 |
+- end if |
1083 |
+- |
1084 |
+- if (token%data%nSym <= 0) then |
1085 |
+- ! We do the computation of the matrix part. |
1086 |
+- call compute_matrices(token%data, errno) |
1087 |
+- end if |
1088 |
+- |
1089 |
+- nSym = token%data%nSym |
1090 |
+- end subroutine symmetry_get_n_sym |
1091 |
+- |
1092 |
+- subroutine symmetry_set_n_sym(id, nSym, sym, transNon, symAfm, errno) |
1093 |
+- !scalars |
1094 |
+- |
1095 |
+-!This section has been created automatically by the script Abilint (TD). |
1096 |
+-!Do not modify the following lines by hand. |
1097 |
+-!End of the abilint section |
1098 |
+- |
1099 |
+- integer, intent(in) :: id |
1100 |
+- integer, intent(in) :: nSym |
1101 |
+- integer, intent(in) :: sym(3, 3, nSym) |
1102 |
+- real(dp), intent(in) :: transNon(3, nSym) |
1103 |
+- integer, intent(in) :: symAfm(nSym) |
1104 |
+- integer, intent(out) :: errno |
1105 |
+- |
1106 |
+- type(symmetry_list), pointer :: token |
1107 |
+- |
1108 |
+- if (AB_DBG) write(0,*) "AB symmetry: call get nSym." |
1109 |
+- |
1110 |
+- errno = AB6_NO_ERROR |
1111 |
+- call get_item(token, id) |
1112 |
+- if (.not. associated(token)) then |
1113 |
+- errno = AB6_ERROR_OBJ |
1114 |
+- return |
1115 |
+- end if |
1116 |
+- |
1117 |
+- if (nSym <= 0) then |
1118 |
+- errno = AB6_ERROR_ARG |
1119 |
+- return |
1120 |
+- else |
1121 |
+- allocate(token%data%sym(3, 3, nSym)) |
1122 |
+- token%data%sym(:,:,:) = sym(:,:,:) |
1123 |
+- allocate(token%data%symAfm(nSym)) |
1124 |
+- token%data%symAfm(:) = symAfm(:) |
1125 |
+- allocate(token%data%transNon(3, nSym)) |
1126 |
+- token%data%transNon(:,:) = transNon(:,:) |
1127 |
+- |
1128 |
+- token%data%auto = .false. |
1129 |
+- token%data%nsym = -nSym |
1130 |
+- end if |
1131 |
+- |
1132 |
+- ! We do the computation of the matrix part. |
1133 |
+- call compute_matrices(token%data, errno) |
1134 |
+- end subroutine symmetry_set_n_sym |
1135 |
+- |
1136 |
+- subroutine symmetry_get_matrices(id, nSym, sym, transNon, symAfm, errno) |
1137 |
+- |
1138 |
+- |
1139 |
+-!This section has been created automatically by the script Abilint (TD). |
1140 |
+-!Do not modify the following lines by hand. |
1141 |
+-!End of the abilint section |
1142 |
+- |
1143 |
+- integer, intent(in) :: id |
1144 |
+- integer, intent(out) :: errno |
1145 |
+- integer, intent(out) :: nSym |
1146 |
+- integer, intent(out) :: sym(3, 3, AB6_MAX_SYMMETRIES) |
1147 |
+- integer, intent(out) :: symAfm(AB6_MAX_SYMMETRIES) |
1148 |
+- real(dp), intent(out) :: transNon(3, AB6_MAX_SYMMETRIES) |
1149 |
+- |
1150 |
+- type(symmetry_list), pointer :: token |
1151 |
+- |
1152 |
+- if (AB_DBG) write(0,*) "AB symmetry: call get matrices." |
1153 |
+- |
1154 |
+- errno = AB6_NO_ERROR |
1155 |
+- call get_item(token, id) |
1156 |
+- if (.not. associated(token)) then |
1157 |
+- errno = AB6_ERROR_OBJ |
1158 |
+- return |
1159 |
+- end if |
1160 |
+- |
1161 |
+- if (token%data%nSym <= 0) then |
1162 |
+- ! We do the computation of the matrix part. |
1163 |
+- call compute_matrices(token%data, errno) |
1164 |
+- end if |
1165 |
+- |
1166 |
+- nSym = token%data%nSym |
1167 |
+- sym(:, :, 1:nSym) = token%data%sym(:, :,:) |
1168 |
+- symAfm(1:nSym) = token%data%symAfm(:) |
1169 |
+- transNon(:, 1:nSym) = token%data%transNon(:,:) |
1170 |
+- end subroutine symmetry_get_matrices |
1171 |
+- |
1172 |
+- subroutine symmetry_get_matrices_p(id, nSym, sym, transNon, symAfm, errno) |
1173 |
+- |
1174 |
+- |
1175 |
+-!This section has been created automatically by the script Abilint (TD). |
1176 |
+-!Do not modify the following lines by hand. |
1177 |
+-!End of the abilint section |
1178 |
+- |
1179 |
+- integer, intent(in) :: id |
1180 |
+- integer, intent(out) :: errno |
1181 |
+- integer, intent(out) :: nSym |
1182 |
+- integer, pointer :: sym(:,:,:) |
1183 |
+- integer, pointer :: symAfm(:) |
1184 |
+- real(dp), pointer :: transNon(:,:) |
1185 |
+- |
1186 |
+- type(symmetry_list), pointer :: token |
1187 |
+- |
1188 |
+- if (AB_DBG) write(0,*) "AB symmetry: call get matrices as pointers." |
1189 |
+- |
1190 |
+- errno = AB6_NO_ERROR |
1191 |
+- call get_item(token, id) |
1192 |
+- if (.not. associated(token)) then |
1193 |
+- errno = AB6_ERROR_OBJ |
1194 |
+- return |
1195 |
+- end if |
1196 |
+- |
1197 |
+- if (token%data%nSym <= 0) then |
1198 |
+- ! We do the computation of the matrix part. |
1199 |
+- call compute_matrices(token%data, errno) |
1200 |
+- end if |
1201 |
+- |
1202 |
+- nSym = token%data%nSym |
1203 |
+- sym => token%data%sym |
1204 |
+- symAfm => token%data%symAfm |
1205 |
+- transNon => token%data%transNon |
1206 |
+- end subroutine symmetry_get_matrices_p |
1207 |
+- |
1208 |
+- subroutine symmetry_get_multiplicity(id, multiplicity, errno) |
1209 |
+- |
1210 |
+- |
1211 |
+-!This section has been created automatically by the script Abilint (TD). |
1212 |
+-!Do not modify the following lines by hand. |
1213 |
+-!End of the abilint section |
1214 |
+- |
1215 |
+- integer, intent(in) :: id |
1216 |
+- integer, intent(out) :: multiplicity, errno |
1217 |
+- |
1218 |
+- type(symmetry_list), pointer :: token |
1219 |
+- |
1220 |
+- if (AB_DBG) write(0,*) "AB symmetry: call get multiplicity." |
1221 |
+- |
1222 |
+- errno = AB6_NO_ERROR |
1223 |
+- call get_item(token, id) |
1224 |
+- if (.not. associated(token)) then |
1225 |
+- errno = AB6_ERROR_OBJ |
1226 |
+- return |
1227 |
+- end if |
1228 |
+- |
1229 |
+- if (token%data%multiplicity < 0) then |
1230 |
+- ! We do the computation of the matrix part. |
1231 |
+- call compute_matrices(token%data, errno) |
1232 |
+- end if |
1233 |
+- multiplicity = token%data%multiplicity |
1234 |
+- end subroutine symmetry_get_multiplicity |
1235 |
+- |
1236 |
+- subroutine symmetry_get_group(id, spaceGroup, spaceGroupId, & |
1237 |
+- & pointGroupMagn, genAfm, errno) |
1238 |
+- |
1239 |
+- |
1240 |
+-!This section has been created automatically by the script Abilint (TD). |
1241 |
+-!Do not modify the following lines by hand. |
1242 |
+- use interfaces_42_geometry |
1243 |
+-!End of the abilint section |
1244 |
+- |
1245 |
+- integer, intent(in) :: id |
1246 |
+- integer, intent(out) :: errno |
1247 |
+- real(dp), intent(out) :: genAfm(3) |
1248 |
+- character(len=15), intent(out) :: spaceGroup |
1249 |
+- integer, intent(out) :: spaceGroupId, pointGroupMagn |
1250 |
+- |
1251 |
+- type(symmetry_list), pointer :: token |
1252 |
+- integer :: sporder |
1253 |
+- character(len=1) :: brvLattice |
1254 |
+- character(len=15) :: ptintsb,ptschsb,schsb,spgrp |
1255 |
+- character(len=35) :: intsbl |
1256 |
+- |
1257 |
+- if (AB_DBG) write(0,*) "AB symmetry: call get group." |
1258 |
+- |
1259 |
+- errno = AB6_NO_ERROR |
1260 |
+- call get_item(token, id) |
1261 |
+- if (.not. associated(token)) then |
1262 |
+- errno = AB6_ERROR_OBJ |
1263 |
+- return |
1264 |
+- end if |
1265 |
+- |
1266 |
+- if (token%data%multiplicity < 0) then |
1267 |
+- ! We do the computation of the matrix part. |
1268 |
+- call compute_matrices(token%data, errno) |
1269 |
+- end if |
1270 |
+- |
1271 |
+- if (token%data%multiplicity /= 1) then |
1272 |
+- errno = AB6_ERROR_SYM_NOT_PRIMITIVE |
1273 |
+- return |
1274 |
+- end if |
1275 |
+- |
1276 |
+- call spgdata(brvLattice,spgrp,intsbl,ptintsb,ptschsb,& |
1277 |
+- & schsb,1,token%data%spaceGroup,sporder,1) |
1278 |
+- |
1279 |
+- write(spaceGroup, "(3A)") brvLattice, " ", trim(spgrp(1:13)) |
1280 |
+- pointGroupMagn = token%data%pointGroupMagn |
1281 |
+- spaceGroupId = token%data%spaceGroup |
1282 |
+- genAfm = token%data%genAfm |
1283 |
+- end subroutine symmetry_get_group |
1284 |
+- |
1285 |
+- subroutine compute_equivalent_atoms(sym) |
1286 |
+- |
1287 |
+- |
1288 |
+-!This section has been created automatically by the script Abilint (TD). |
1289 |
+-!Do not modify the following lines by hand. |
1290 |
+- use interfaces_32_util |
1291 |
+- use interfaces_42_geometry |
1292 |
+-!End of the abilint section |
1293 |
+- |
1294 |
+- type(symmetry_type), intent(inout) :: sym |
1295 |
+- |
1296 |
+- integer, allocatable :: symrec(:,:,:) |
1297 |
+- integer :: isym |
1298 |
+- |
1299 |
+- if (.not. associated(sym%indexingAtoms)) & |
1300 |
+- & allocate(sym%indexingAtoms(4, sym%nSym, sym%nAtoms)) |
1301 |
+- |
1302 |
+- !Get the symmetry matrices in terms of reciprocal basis |
1303 |
+- allocate(symrec(3, 3, sym%nSym)) |
1304 |
+- do isym = 1, sym%nSym, 1 |
1305 |
+- call mati3inv(sym%sym(:,:,isym), symrec(:,:,isym)) |
1306 |
+- end do |
1307 |
+- |
1308 |
+- !Obtain a list of rotated atom labels: |
1309 |
+- call symatm(sym%indexingAtoms, sym%nAtoms, sym%nSym, symrec, & |
1310 |
+- & sym%transNon, sym%tolsym, sym%typeAt, sym%xRed) |
1311 |
+- |
1312 |
+- deallocate(symrec) |
1313 |
+- end subroutine compute_equivalent_atoms |
1314 |
+- |
1315 |
+- subroutine symmetry_get_equivalent_atom(id, equiv, iAtom, errno) |
1316 |
+- |
1317 |
+- |
1318 |
+-!This section has been created automatically by the script Abilint (TD). |
1319 |
+-!Do not modify the following lines by hand. |
1320 |
+-!End of the abilint section |
1321 |
+- |
1322 |
+- integer, intent(in) :: id |
1323 |
+- integer, intent(in) :: iAtom |
1324 |
+- integer, intent(out) :: equiv(4, AB6_MAX_SYMMETRIES) |
1325 |
+- integer, intent(out) :: errno |
1326 |
+- |
1327 |
+- type(symmetry_list), pointer :: token |
1328 |
+- |
1329 |
+- if (AB_DBG) write(0,*) "AB symmetry: call get equivalent." |
1330 |
+- |
1331 |
+- errno = AB6_NO_ERROR |
1332 |
+- call get_item(token, id) |
1333 |
+- if (.not. associated(token)) then |
1334 |
+- errno = AB6_ERROR_OBJ |
1335 |
+- return |
1336 |
+- end if |
1337 |
+- |
1338 |
+- if (iAtom < 1 .or. iAtom > token%data%nAtoms) then |
1339 |
+- errno = AB6_ERROR_ARG |
1340 |
+- return |
1341 |
+- end if |
1342 |
+- |
1343 |
+- if (.not. associated(token%data%indexingAtoms)) then |
1344 |
+- ! We do the computation of the matrix part. |
1345 |
+- call compute_equivalent_atoms(token%data) |
1346 |
+- end if |
1347 |
+- |
1348 |
+- equiv(:, 1:token%data%nSym) = token%data%indexingAtoms(:,:,iAtom) |
1349 |
+- end subroutine symmetry_get_equivalent_atom |
1350 |
+- |
1351 |
+-end module m_ab6_symmetry |
1352 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/42_geometry/m_ab7_symmetry.F90 bigdft-abi-1.0.4.new/libABINIT/src/42_geometry/m_ab7_symmetry.F90 |
1353 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/42_geometry/m_ab7_symmetry.F90 1970-01-01 01:00:00.000000000 +0100 |
1354 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/42_geometry/m_ab7_symmetry.F90 2013-06-11 16:51:00.000000000 +0200 |
1355 |
+@@ -0,0 +1,1088 @@ |
1356 |
++!* * Fortran90 source file * |
1357 |
++!* |
1358 |
++!* Copyright (c) 2008-2010 ABINIT Group (Damien Caliste) |
1359 |
++!* All rights reserved. |
1360 |
++!* |
1361 |
++!* This file is part of the ABINIT software package. For license information, |
1362 |
++!* please see the COPYING file in the top-level directory of the ABINIT source |
1363 |
++!* distribution. |
1364 |
++!* |
1365 |
++!* |
1366 |
++ |
1367 |
++module m_ab7_symmetry |
1368 |
++ |
1369 |
++ use defs_basis |
1370 |
++ |
1371 |
++ implicit none |
1372 |
++ |
1373 |
++ private |
1374 |
++ |
1375 |
++ integer, parameter, public :: AB7_MAX_SYMMETRIES = 384 |
1376 |
++ |
1377 |
++ type, public :: symmetry_type |
1378 |
++ ! The input characteristics |
1379 |
++ real(dp) :: tolsym |
1380 |
++ real(dp) :: rprimd(3,3), gprimd(3,3), rmet(3,3) |
1381 |
++ integer :: nAtoms |
1382 |
++ integer, pointer :: typeAt(:) |
1383 |
++ real(dp), pointer :: xRed(:,:) |
1384 |
++ |
1385 |
++ logical :: withField |
1386 |
++ real(dp) :: field(3) |
1387 |
++ |
1388 |
++ logical :: withJellium |
1389 |
++ |
1390 |
++ integer :: withSpin |
1391 |
++ real(dp), pointer :: spinAt(:,:) |
1392 |
++ |
1393 |
++ logical :: withSpinOrbit |
1394 |
++ |
1395 |
++ integer :: vacuum(3) |
1396 |
++ |
1397 |
++ ! The output characteristics |
1398 |
++ ! The bravais parameters |
1399 |
++ integer :: nBravSym |
1400 |
++ integer :: bravais(11), bravSym(3, 3, AB7_MAX_SYMMETRIES) |
1401 |
++ ! The symmetry matrices |
1402 |
++ logical :: auto |
1403 |
++ integer :: nSym |
1404 |
++ integer, pointer :: sym(:,:,:) |
1405 |
++ real(dp), pointer :: transNon(:,:) |
1406 |
++ integer, pointer :: symAfm(:) |
1407 |
++ ! Some additional information |
1408 |
++ integer :: multiplicity |
1409 |
++ real(dp) :: genAfm(3) |
1410 |
++ integer :: spaceGroup, pointGroupMagn |
1411 |
++ integer, pointer :: indexingAtoms(:,:,:) |
1412 |
++ end type symmetry_type |
1413 |
++ |
1414 |
++ ! We store here a list of symmetry objects to be able to |
1415 |
++ ! call several symmetry operations on different objects. |
1416 |
++ ! The simplest portable way to do it, is to create |
1417 |
++ ! a list of Fortran structure and to use the list index |
1418 |
++ ! as an identifier that can be given to the other languages. |
1419 |
++ type, private :: symmetry_list |
1420 |
++ integer :: id |
1421 |
++ type(symmetry_list), pointer :: next |
1422 |
++ type(symmetry_type) :: data |
1423 |
++ end type symmetry_list |
1424 |
++ type(symmetry_list), pointer :: my_symmetries |
1425 |
++ integer :: n_symmetries = 0 |
1426 |
++ |
1427 |
++ logical, private, parameter :: AB_DBG = .false. |
1428 |
++ |
1429 |
++ public :: symmetry_new |
1430 |
++ public :: symmetry_free |
1431 |
++ public :: symmetry_set_tolerance |
1432 |
++ public :: symmetry_set_lattice |
1433 |
++ public :: symmetry_set_structure |
1434 |
++ public :: symmetry_set_collinear_spin |
1435 |
++ public :: symmetry_set_spin |
1436 |
++ public :: symmetry_set_spin_orbit |
1437 |
++ public :: symmetry_set_field |
1438 |
++ public :: symmetry_set_jellium |
1439 |
++ public :: symmetry_set_periodicity |
1440 |
++ public :: symmetry_set_n_sym |
1441 |
++ |
1442 |
++ public :: symmetry_get_from_id |
1443 |
++ public :: symmetry_get_n_atoms |
1444 |
++ public :: symmetry_get_n_sym |
1445 |
++ public :: symmetry_get_multiplicity |
1446 |
++ public :: symmetry_get_bravais |
1447 |
++ public :: symmetry_get_matrices |
1448 |
++ public :: symmetry_get_matrices_p |
1449 |
++ public :: symmetry_get_group |
1450 |
++ public :: symmetry_get_equivalent_atom |
1451 |
++ |
1452 |
++contains |
1453 |
++ |
1454 |
++ subroutine new_item(token) |
1455 |
++ |
1456 |
++ |
1457 |
++!This section has been created automatically by the script Abilint (TD). |
1458 |
++!Do not modify the following lines by hand. |
1459 |
++!End of the abilint section |
1460 |
++ |
1461 |
++ type(symmetry_list), pointer :: token |
1462 |
++ |
1463 |
++ ! We allocate a new list token and prepend it. |
1464 |
++ if (AB_DBG) write(0,*) "AB symmetry: create a new token." |
1465 |
++ |
1466 |
++ ! Init case, very first call. |
1467 |
++ if (n_symmetries == 0) then |
1468 |
++ nullify(my_symmetries) |
1469 |
++ end if |
1470 |
++ |
1471 |
++ ! Normal treatment. |
1472 |
++ n_symmetries = n_symmetries + 1 |
1473 |
++ |
1474 |
++ allocate(token) |
1475 |
++ token%id = n_symmetries |
1476 |
++ call new_symmetry(token%data) |
1477 |
++ token%next => my_symmetries |
1478 |
++ |
1479 |
++ my_symmetries => token |
1480 |
++ if (AB_DBG) write(0,*) "AB symmetry: creation OK with id ", token%id |
1481 |
++ end subroutine new_item |
1482 |
++ |
1483 |
++ subroutine free_item(token) |
1484 |
++ |
1485 |
++ |
1486 |
++!This section has been created automatically by the script Abilint (TD). |
1487 |
++!Do not modify the following lines by hand. |
1488 |
++!End of the abilint section |
1489 |
++ |
1490 |
++ type(symmetry_list), pointer :: token |
1491 |
++ |
1492 |
++ type(symmetry_list), pointer :: tmp |
1493 |
++ |
1494 |
++ if (.not. associated(token)) then |
1495 |
++ return |
1496 |
++ end if |
1497 |
++ |
1498 |
++ call free_symmetry(token%data) |
1499 |
++ |
1500 |
++ if (AB_DBG) write(0,*) "AB symmetry: free request on token ", token%id |
1501 |
++ ! We remove token from the list. |
1502 |
++ if (my_symmetries%id == token%id) then |
1503 |
++ my_symmetries => token%next |
1504 |
++ else |
1505 |
++ tmp => my_symmetries |
1506 |
++ do |
1507 |
++ if (.not.associated(tmp)) then |
1508 |
++ return |
1509 |
++ end if |
1510 |
++ if (associated(tmp%next) .and. tmp%next%id == token%id) then |
1511 |
++ exit |
1512 |
++ end if |
1513 |
++ tmp => tmp%next |
1514 |
++ end do |
1515 |
++ tmp%next => token%next |
1516 |
++ end if |
1517 |
++ deallocate(token) |
1518 |
++ if (AB_DBG) write(0,*) "AB symmetry: free done" |
1519 |
++ end subroutine free_item |
1520 |
++ |
1521 |
++ subroutine get_item(token, id) |
1522 |
++ |
1523 |
++ |
1524 |
++ type(symmetry_list), pointer :: token |
1525 |
++ integer, intent(in) :: id |
1526 |
++ |
1527 |
++ type(symmetry_list), pointer :: tmp |
1528 |
++ |
1529 |
++ if (AB_DBG) write(0,*) "AB symmetry: request list element ", id |
1530 |
++ nullify(token) |
1531 |
++ |
1532 |
++ tmp => my_symmetries |
1533 |
++ do |
1534 |
++ if (.not. associated(tmp)) then |
1535 |
++ exit |
1536 |
++ end if |
1537 |
++ if (tmp%id == id) then |
1538 |
++ token => tmp |
1539 |
++ return |
1540 |
++ end if |
1541 |
++ tmp => tmp%next |
1542 |
++ end do |
1543 |
++ end subroutine get_item |
1544 |
++ |
1545 |
++ subroutine symmetry_get_from_id(sym, id, errno) |
1546 |
++ |
1547 |
++ type(symmetry_type), pointer :: sym |
1548 |
++ integer, intent(in) :: id |
1549 |
++ integer, intent(out) :: errno |
1550 |
++ |
1551 |
++ type(symmetry_list), pointer :: token |
1552 |
++ |
1553 |
++ errno = AB7_NO_ERROR |
1554 |
++ call get_item(token, id) |
1555 |
++ if (associated(token)) then |
1556 |
++ sym => token%data |
1557 |
++ if (sym%nSym <= 0) then |
1558 |
++ ! We do the computation of the matrix part. |
1559 |
++ call compute_matrices(sym, errno) |
1560 |
++ end if |
1561 |
++ else |
1562 |
++ errno = AB7_ERROR_OBJ |
1563 |
++ nullify(sym) |
1564 |
++ end if |
1565 |
++ end subroutine symmetry_get_from_id |
1566 |
++ |
1567 |
++ subroutine new_symmetry(sym) |
1568 |
++ |
1569 |
++ |
1570 |
++ type(symmetry_type), intent(out) :: sym |
1571 |
++ |
1572 |
++ if (AB_DBG) write(0,*) "AB symmetry: create a new symmetry object." |
1573 |
++ nullify(sym%xRed) |
1574 |
++ nullify(sym%spinAt) |
1575 |
++ nullify(sym%typeAt) |
1576 |
++ sym%tolsym = tol8 |
1577 |
++ sym%auto = .true. |
1578 |
++ sym%nSym = 0 |
1579 |
++ nullify(sym%sym) |
1580 |
++ nullify(sym%symAfm) |
1581 |
++ nullify(sym%transNon) |
1582 |
++ sym%nBravSym = -1 |
1583 |
++ sym%withField = .false. |
1584 |
++ sym%withJellium = .false. |
1585 |
++ sym%withSpin = 1 |
1586 |
++ sym%withSpinOrbit = .false. |
1587 |
++ sym%multiplicity = -1 |
1588 |
++ nullify(sym%indexingAtoms) |
1589 |
++ sym%vacuum = 0 |
1590 |
++ end subroutine new_symmetry |
1591 |
++ |
1592 |
++ subroutine free_symmetry(sym) |
1593 |
++ |
1594 |
++ |
1595 |
++ type(symmetry_type), intent(inout) :: sym |
1596 |
++ |
1597 |
++ if (AB_DBG) write(0,*) "AB symmetry: free a symmetry." |
1598 |
++ |
1599 |
++ if (associated(sym%xRed)) deallocate(sym%xRed) |
1600 |
++ if (associated(sym%spinAt)) deallocate(sym%spinAt) |
1601 |
++ if (associated(sym%typeAt)) deallocate(sym%typeAt) |
1602 |
++ if (associated(sym%indexingAtoms)) deallocate(sym%indexingAtoms) |
1603 |
++ if (associated(sym%sym)) deallocate(sym%sym) |
1604 |
++ if (associated(sym%symAfm)) deallocate(sym%symAfm) |
1605 |
++ if (associated(sym%transNon)) deallocate(sym%transNon) |
1606 |
++ end subroutine free_symmetry |
1607 |
++ |
1608 |
++ |
1609 |
++ |
1610 |
++ |
1611 |
++ |
1612 |
++ subroutine symmetry_new(id) |
1613 |
++ |
1614 |
++ |
1615 |
++!This section has been created automatically by the script Abilint (TD). |
1616 |
++!Do not modify the following lines by hand. |
1617 |
++!End of the abilint section |
1618 |
++ |
1619 |
++ integer, intent(out) :: id |
1620 |
++ |
1621 |
++ type(symmetry_list), pointer :: token |
1622 |
++ |
1623 |
++ if (AB_DBG) write(0,*) "AB symmetry: call new symmetry." |
1624 |
++ call new_item(token) |
1625 |
++ id = token%id |
1626 |
++ end subroutine symmetry_new |
1627 |
++ |
1628 |
++ subroutine symmetry_free(id) |
1629 |
++ |
1630 |
++ |
1631 |
++!This section has been created automatically by the script Abilint (TD). |
1632 |
++!Do not modify the following lines by hand. |
1633 |
++!End of the abilint section |
1634 |
++ |
1635 |
++ integer, intent(in) :: id |
1636 |
++ |
1637 |
++ type(symmetry_list), pointer :: token |
1638 |
++ |
1639 |
++ if (AB_DBG) write(0,*) "AB symmetry: call free symmetry." |
1640 |
++ |
1641 |
++ call get_item(token, id) |
1642 |
++ if (associated(token)) call free_item(token) |
1643 |
++ end subroutine symmetry_free |
1644 |
++ |
1645 |
++ subroutine symmetry_set_tolerance(id, tolsym, errno) |
1646 |
++ |
1647 |
++ |
1648 |
++!This section has been created automatically by the script Abilint (TD). |
1649 |
++!Do not modify the following lines by hand. |
1650 |
++!End of the abilint section |
1651 |
++ |
1652 |
++ integer, intent(in) :: id |
1653 |
++ real(dp), intent(in) :: tolsym |
1654 |
++ integer, intent(out) :: errno |
1655 |
++ |
1656 |
++ type(symmetry_list), pointer :: token |
1657 |
++ |
1658 |
++ if (AB_DBG) write(0,*) "AB symmetry: call set tolerance." |
1659 |
++ |
1660 |
++ errno = AB7_NO_ERROR |
1661 |
++ call get_item(token, id) |
1662 |
++ if (.not. associated(token)) then |
1663 |
++ errno = AB7_ERROR_OBJ |
1664 |
++ return |
1665 |
++ end if |
1666 |
++ |
1667 |
++ token%data%tolsym = tolsym |
1668 |
++ |
1669 |
++ ! We unset all the computed symmetries |
1670 |
++ token%data%nBravSym = -1 |
1671 |
++ if (token%data%auto) then |
1672 |
++ token%data%nSym = 0 |
1673 |
++ end if |
1674 |
++ end subroutine symmetry_set_tolerance |
1675 |
++ |
1676 |
++ subroutine symmetry_set_lattice(id, rprimd, errno) |
1677 |
++ |
1678 |
++ |
1679 |
++!This section has been created automatically by the script Abilint (TD). |
1680 |
++!Do not modify the following lines by hand. |
1681 |
++ use interfaces_42_geometry |
1682 |
++!End of the abilint section |
1683 |
++ |
1684 |
++ integer, intent(in) :: id |
1685 |
++ real(dp), intent(in) :: rprimd(3,3) |
1686 |
++ integer, intent(out) :: errno |
1687 |
++ |
1688 |
++ type(symmetry_list), pointer :: token |
1689 |
++ real(dp) :: ucvol |
1690 |
++ real(dp) :: gmet(3,3) |
1691 |
++ |
1692 |
++ if (AB_DBG) write(0,*) "AB symmetry: call set lattice." |
1693 |
++ if (AB_DBG) write(0, "(A,3F12.6,A)") " (", rprimd(:,1), ")" |
1694 |
++ if (AB_DBG) write(0, "(A,3F12.6,A)") " (", rprimd(:,2), ")" |
1695 |
++ if (AB_DBG) write(0, "(A,3F12.6,A)") " (", rprimd(:,3), ")" |
1696 |
++ |
1697 |
++ errno = AB7_NO_ERROR |
1698 |
++ call get_item(token, id) |
1699 |
++ if (.not. associated(token)) then |
1700 |
++ errno = AB7_ERROR_OBJ |
1701 |
++ return |
1702 |
++ end if |
1703 |
++ |
1704 |
++ token%data%rprimd = rprimd |
1705 |
++ call metric(gmet, token%data%gprimd, -1, token%data%rmet, rprimd, ucvol) |
1706 |
++ |
1707 |
++ ! We unset all the computed symmetries |
1708 |
++ token%data%nBravSym = -1 |
1709 |
++ if (token%data%auto) then |
1710 |
++ token%data%nSym = 0 |
1711 |
++ end if |
1712 |
++ end subroutine symmetry_set_lattice |
1713 |
++ |
1714 |
++ subroutine symmetry_set_structure(id, nAtoms, typeAt, xRed, errno) |
1715 |
++ |
1716 |
++ |
1717 |
++!This section has been created automatically by the script Abilint (TD). |
1718 |
++!Do not modify the following lines by hand. |
1719 |
++!End of the abilint section |
1720 |
++ |
1721 |
++ integer, intent(in) :: id |
1722 |
++ integer, intent(in) :: nAtoms |
1723 |
++ integer, intent(in) :: typeAt(nAtoms) |
1724 |
++ real(dp), intent(in) :: xRed(3,nAtoms) |
1725 |
++ integer, intent(out) :: errno |
1726 |
++ |
1727 |
++ type(symmetry_list), pointer :: token |
1728 |
++ integer :: i |
1729 |
++ |
1730 |
++ if (AB_DBG) write(0,*) "AB symmetry: call set structure." |
1731 |
++ if (AB_DBG) write(0, "(A,I3,A)") " ", nAtoms, " atoms" |
1732 |
++ if (AB_DBG) then |
1733 |
++ do i = 1, nAtoms, 1 |
1734 |
++ write(0, "(A,3F12.6,I3)") " ", xRed(:, i), typeAt(i) |
1735 |
++ end do |
1736 |
++ end if |
1737 |
++ |
1738 |
++ errno = AB7_NO_ERROR |
1739 |
++ call get_item(token, id) |
1740 |
++ if (.not. associated(token)) then |
1741 |
++ errno = AB7_ERROR_OBJ |
1742 |
++ return |
1743 |
++ end if |
1744 |
++ |
1745 |
++ token%data%nAtoms = nAtoms |
1746 |
++ allocate(token%data%typeAt(nAtoms)) |
1747 |
++ token%data%typeAt = typeAt |
1748 |
++ allocate(token%data%xRed(3, nAtoms)) |
1749 |
++ token%data%xRed = xRed |
1750 |
++ |
1751 |
++ ! We unset only the symmetries |
1752 |
++ if (token%data%auto) then |
1753 |
++ token%data%nSym = 0 |
1754 |
++ end if |
1755 |
++ if (associated(token%data%indexingAtoms)) deallocate(token%data%indexingAtoms) |
1756 |
++ end subroutine symmetry_set_structure |
1757 |
++ |
1758 |
++ subroutine symmetry_set_spin(id, nAtoms, spinAt, errno) |
1759 |
++ |
1760 |
++ |
1761 |
++!This section has been created automatically by the script Abilint (TD). |
1762 |
++!Do not modify the following lines by hand. |
1763 |
++!End of the abilint section |
1764 |
++ |
1765 |
++ integer, intent(in) :: id |
1766 |
++ integer, intent(in) :: nAtoms |
1767 |
++ real(dp), intent(in) :: spinAt(3,nAtoms) |
1768 |
++ integer, intent(out) :: errno |
1769 |
++ |
1770 |
++ type(symmetry_list), pointer :: token |
1771 |
++ integer :: i |
1772 |
++ |
1773 |
++ if (AB_DBG) write(0,*) "AB symmetry: call set spin." |
1774 |
++ if (AB_DBG) then |
1775 |
++ do i = 1, nAtoms, 1 |
1776 |
++ write(0, "(A,3F12.6)") " ", spinAt(:, i) |
1777 |
++ end do |
1778 |
++ end if |
1779 |
++ |
1780 |
++ errno = AB7_NO_ERROR |
1781 |
++ call get_item(token, id) |
1782 |
++ if (.not. associated(token)) then |
1783 |
++ errno = AB7_ERROR_OBJ |
1784 |
++ return |
1785 |
++ end if |
1786 |
++ if (token%data%nAtoms /= nAtoms) then |
1787 |
++ errno = AB7_ERROR_ARG |
1788 |
++ return |
1789 |
++ end if |
1790 |
++ |
1791 |
++ token%data%withSpin = 4 |
1792 |
++ allocate(token%data%spinAt(3, nAtoms)) |
1793 |
++ token%data%spinAt = spinAt |
1794 |
++ |
1795 |
++ ! We unset only the symmetries |
1796 |
++ if (token%data%auto) then |
1797 |
++ token%data%nSym = 0 |
1798 |
++ end if |
1799 |
++ end subroutine symmetry_set_spin |
1800 |
++ |
1801 |
++ subroutine symmetry_set_collinear_spin(id, nAtoms, spinAt, errno) |
1802 |
++ |
1803 |
++ |
1804 |
++!This section has been created automatically by the script Abilint (TD). |
1805 |
++!Do not modify the following lines by hand. |
1806 |
++!End of the abilint section |
1807 |
++ |
1808 |
++ integer, intent(in) :: id |
1809 |
++ integer, intent(in) :: nAtoms |
1810 |
++ integer, intent(in) :: spinAt(nAtoms) |
1811 |
++ integer, intent(out) :: errno |
1812 |
++ |
1813 |
++ type(symmetry_list), pointer :: token |
1814 |
++ integer :: i |
1815 |
++ |
1816 |
++ if (AB_DBG) write(0,*) "AB symmetry: call set collinear spin." |
1817 |
++ if (AB_DBG) then |
1818 |
++ do i = 1, nAtoms, 1 |
1819 |
++ write(0, "(A,I3)") " ", spinAt(i) |
1820 |
++ end do |
1821 |
++ end if |
1822 |
++ |
1823 |
++ errno = AB7_NO_ERROR |
1824 |
++ call get_item(token, id) |
1825 |
++ if (.not. associated(token)) then |
1826 |
++ errno = AB7_ERROR_OBJ |
1827 |
++ return |
1828 |
++ end if |
1829 |
++ if (token%data%nAtoms /= nAtoms) then |
1830 |
++ errno = AB7_ERROR_ARG |
1831 |
++ return |
1832 |
++ end if |
1833 |
++ |
1834 |
++ token%data%withSpin = 2 |
1835 |
++ allocate(token%data%spinAt(1, nAtoms)) |
1836 |
++ token%data%spinAt = real(reshape(spinAt, (/ 1, nAtoms /)), dp) |
1837 |
++ |
1838 |
++ ! We unset only the symmetries |
1839 |
++ if (token%data%auto) then |
1840 |
++ token%data%nSym = 0 |
1841 |
++ end if |
1842 |
++ end subroutine symmetry_set_collinear_spin |
1843 |
++ |
1844 |
++ subroutine symmetry_set_spin_orbit(id, withSpinOrbit, errno) |
1845 |
++ |
1846 |
++ |
1847 |
++!This section has been created automatically by the script Abilint (TD). |
1848 |
++!Do not modify the following lines by hand. |
1849 |
++!End of the abilint section |
1850 |
++ |
1851 |
++ integer, intent(in) :: id |
1852 |
++ logical, intent(in) :: withSpinOrbit |
1853 |
++ integer, intent(out) :: errno |
1854 |
++ |
1855 |
++ type(symmetry_list), pointer :: token |
1856 |
++ |
1857 |
++ if (AB_DBG) write(0,*) "AB symmetry: call set spin orbit." |
1858 |
++ |
1859 |
++ errno = AB7_NO_ERROR |
1860 |
++ call get_item(token, id) |
1861 |
++ if (.not. associated(token)) then |
1862 |
++ errno = AB7_ERROR_OBJ |
1863 |
++ return |
1864 |
++ end if |
1865 |
++ |
1866 |
++ token%data%withSpinOrbit = withSpinOrbit |
1867 |
++ |
1868 |
++ ! We unset only the symmetries |
1869 |
++ if (token%data%auto) then |
1870 |
++ token%data%nSym = 0 |
1871 |
++ end if |
1872 |
++ end subroutine symmetry_set_spin_orbit |
1873 |
++ |
1874 |
++ subroutine symmetry_set_field(id, field, errno) |
1875 |
++ |
1876 |
++ |
1877 |
++!This section has been created automatically by the script Abilint (TD). |
1878 |
++!Do not modify the following lines by hand. |
1879 |
++!End of the abilint section |
1880 |
++ |
1881 |
++ integer, intent(in) :: id |
1882 |
++ real(dp), intent(in) :: field(3) |
1883 |
++ integer, intent(out) :: errno |
1884 |
++ |
1885 |
++ type(symmetry_list), pointer :: token |
1886 |
++ |
1887 |
++ if (AB_DBG) write(0,*) "AB symmetry: call set field." |
1888 |
++ |
1889 |
++ errno = AB7_NO_ERROR |
1890 |
++ call get_item(token, id) |
1891 |
++ if (.not. associated(token)) then |
1892 |
++ errno = AB7_ERROR_OBJ |
1893 |
++ return |
1894 |
++ end if |
1895 |
++ |
1896 |
++ token%data%withField = .true. |
1897 |
++ token%data%field = field |
1898 |
++ |
1899 |
++ ! We unset all the computed symmetries |
1900 |
++ token%data%nBravSym = -1 |
1901 |
++ if (token%data%auto) then |
1902 |
++ token%data%nSym = 0 |
1903 |
++ end if |
1904 |
++ end subroutine symmetry_set_field |
1905 |
++ |
1906 |
++ subroutine symmetry_set_jellium(id, jellium, errno) |
1907 |
++ |
1908 |
++ |
1909 |
++!This section has been created automatically by the script Abilint (TD). |
1910 |
++!Do not modify the following lines by hand. |
1911 |
++!End of the abilint section |
1912 |
++ |
1913 |
++ integer, intent(in) :: id |
1914 |
++ logical, intent(in) :: jellium |
1915 |
++ integer, intent(out) :: errno |
1916 |
++ |
1917 |
++ type(symmetry_list), pointer :: token |
1918 |
++ |
1919 |
++ if (AB_DBG) write(0,*) "AB symmetry: call set jellium." |
1920 |
++ |
1921 |
++ errno = AB7_NO_ERROR |
1922 |
++ call get_item(token, id) |
1923 |
++ if (.not. associated(token)) then |
1924 |
++ errno = AB7_ERROR_OBJ |
1925 |
++ return |
1926 |
++ end if |
1927 |
++ |
1928 |
++ token%data%withJellium = jellium |
1929 |
++ |
1930 |
++ ! We unset only the symmetries |
1931 |
++ if (token%data%auto) then |
1932 |
++ token%data%nSym = 0 |
1933 |
++ end if |
1934 |
++ end subroutine symmetry_set_jellium |
1935 |
++ |
1936 |
++ subroutine symmetry_set_periodicity(id, periodic, errno) |
1937 |
++ |
1938 |
++ |
1939 |
++!This section has been created automatically by the script Abilint (TD). |
1940 |
++!Do not modify the following lines by hand. |
1941 |
++!End of the abilint section |
1942 |
++ |
1943 |
++ integer, intent(in) :: id |
1944 |
++ logical, intent(in) :: periodic(3) |
1945 |
++ integer, intent(out) :: errno |
1946 |
++ |
1947 |
++ type(symmetry_list), pointer :: token |
1948 |
++ |
1949 |
++ if (AB_DBG) write(0,*) "AB symmetry: call set periodicity." |
1950 |
++ if (AB_DBG) write(0, "(A,3L1,A)") " (", periodic, ")" |
1951 |
++ |
1952 |
++ errno = AB7_NO_ERROR |
1953 |
++ call get_item(token, id) |
1954 |
++ if (.not. associated(token)) then |
1955 |
++ errno = AB7_ERROR_OBJ |
1956 |
++ return |
1957 |
++ end if |
1958 |
++ |
1959 |
++ token%data%vacuum = 0 |
1960 |
++ if (.not. periodic(1)) token%data%vacuum(1) = 1 |
1961 |
++ if (.not. periodic(2)) token%data%vacuum(2) = 1 |
1962 |
++ if (.not. periodic(3)) token%data%vacuum(3) = 1 |
1963 |
++ end subroutine symmetry_set_periodicity |
1964 |
++ |
1965 |
++ |
1966 |
++ |
1967 |
++ |
1968 |
++ |
1969 |
++ subroutine symmetry_get_n_atoms(id, nAtoms, errno) |
1970 |
++ !scalars |
1971 |
++ |
1972 |
++!This section has been created automatically by the script Abilint (TD). |
1973 |
++!Do not modify the following lines by hand. |
1974 |
++!End of the abilint section |
1975 |
++ |
1976 |
++ integer, intent(in) :: id |
1977 |
++ integer, intent(out) :: errno |
1978 |
++ integer, intent(out) :: nAtoms |
1979 |
++ |
1980 |
++ type(symmetry_list), pointer :: token |
1981 |
++ |
1982 |
++ if (AB_DBG) write(0,*) "AB symmetry: call get nAtoms." |
1983 |
++ |
1984 |
++ errno = AB7_NO_ERROR |
1985 |
++ call get_item(token, id) |
1986 |
++ if (.not. associated(token)) then |
1987 |
++ errno = AB7_ERROR_OBJ |
1988 |
++ return |
1989 |
++ end if |
1990 |
++ |
1991 |
++ nAtoms = token%data%nAtoms |
1992 |
++ end subroutine symmetry_get_n_atoms |
1993 |
++ |
1994 |
++ subroutine compute_bravais(sym) |
1995 |
++ |
1996 |
++ |
1997 |
++!This section has been created automatically by the script Abilint (TD). |
1998 |
++!Do not modify the following lines by hand. |
1999 |
++ use interfaces_42_geometry |
2000 |
++!End of the abilint section |
2001 |
++ |
2002 |
++ type(symmetry_type), intent(inout) :: sym |
2003 |
++ |
2004 |
++ integer :: berryopt |
2005 |
++ |
2006 |
++ ! We do the computation |
2007 |
++ if (sym%withField) then |
2008 |
++ berryopt = 4 |
2009 |
++ else |
2010 |
++ berryopt = 0 |
2011 |
++ end if |
2012 |
++ if (AB_DBG) write(0,*) "AB symmetry: call ABINIT symlatt." |
2013 |
++ call symlatt(sym%bravais, AB7_MAX_SYMMETRIES, & |
2014 |
++ & sym%nBravSym, sym%bravSym, sym%rprimd, sym%tolsym) |
2015 |
++ if (AB_DBG) write(0,*) "AB symmetry: call ABINIT OK." |
2016 |
++ if (AB_DBG) write(0, "(A,I3)") " nSymBrav :", sym%nBravSym |
2017 |
++ if (AB_DBG) write(0, "(A,I3)") " holohedry:", sym%bravais(1) |
2018 |
++ if (AB_DBG) write(0, "(A,I3)") " center :", sym%bravais(2) |
2019 |
++ end subroutine compute_bravais |
2020 |
++ |
2021 |
++ subroutine symmetry_get_bravais(id, bravais, holohedry, center, & |
2022 |
++ & nBravSym, bravSym, errno) |
2023 |
++ !scalars |
2024 |
++ |
2025 |
++!This section has been created automatically by the script Abilint (TD). |
2026 |
++!Do not modify the following lines by hand. |
2027 |
++!End of the abilint section |
2028 |
++ |
2029 |
++ integer, intent(in) :: id |
2030 |
++ integer, intent(out) :: errno |
2031 |
++ integer, intent(out) :: nBravSym, holohedry, center |
2032 |
++ !arrays |
2033 |
++ integer, intent(out) :: bravais(3,3), bravSym(3, 3, AB7_MAX_SYMMETRIES) |
2034 |
++ |
2035 |
++ type(symmetry_list), pointer :: token |
2036 |
++ |
2037 |
++ if (AB_DBG) write(0,*) "AB symmetry: call get bravais." |
2038 |
++ |
2039 |
++ errno = AB7_NO_ERROR |
2040 |
++ call get_item(token, id) |
2041 |
++ if (.not. associated(token)) then |
2042 |
++ errno = AB7_ERROR_OBJ |
2043 |
++ return |
2044 |
++ end if |
2045 |
++ |
2046 |
++ if (token%data%nBravSym < 0) then |
2047 |
++ ! We do the computation |
2048 |
++ call compute_bravais(token%data) |
2049 |
++ end if |
2050 |
++ |
2051 |
++ holohedry = token%data%bravais(1) |
2052 |
++ center = token%data%bravais(2) |
2053 |
++ bravais = reshape(token%data%bravais(3:11), (/ 3,3 /)) |
2054 |
++ nBravSym = token%data%nBravSym |
2055 |
++ bravSym(:, :, 1:nBravSym) = token%data%bravSym(:, :, 1:nBravSym) |
2056 |
++ end subroutine symmetry_get_bravais |
2057 |
++ |
2058 |
++ subroutine compute_matrices(sym, errno) |
2059 |
++ |
2060 |
++ |
2061 |
++!This section has been created automatically by the script Abilint (TD). |
2062 |
++!Do not modify the following lines by hand. |
2063 |
++ use interfaces_42_geometry |
2064 |
++!End of the abilint section |
2065 |
++ |
2066 |
++ type(symmetry_type), intent(inout) :: sym |
2067 |
++ integer, intent(out) :: errno |
2068 |
++ |
2069 |
++ integer :: berryopt, jellslab, noncol |
2070 |
++ integer :: use_inversion |
2071 |
++ real(dp), pointer :: spinAt_(:,:) |
2072 |
++ integer :: sym_(3, 3, AB7_MAX_SYMMETRIES) |
2073 |
++ real(dp) :: transNon_(3, AB7_MAX_SYMMETRIES) |
2074 |
++ integer :: symAfm_(AB7_MAX_SYMMETRIES) |
2075 |
++ |
2076 |
++ errno = AB7_NO_ERROR |
2077 |
++ |
2078 |
++ if (sym%nBravSym < 0) then |
2079 |
++ ! We do the computation of the Bravais part. |
2080 |
++ call compute_bravais(sym) |
2081 |
++ end if |
2082 |
++ |
2083 |
++ if (sym%withField) then |
2084 |
++ berryopt = 4 |
2085 |
++ else |
2086 |
++ berryopt = 0 |
2087 |
++ end if |
2088 |
++ if (sym%withJellium) then |
2089 |
++ jellslab = 1 |
2090 |
++ else |
2091 |
++ jellslab = 0 |
2092 |
++ end if |
2093 |
++ if (sym%withSpin == 4) then |
2094 |
++ noncol = 1 |
2095 |
++ spinAt_ => sym%spinAt |
2096 |
++ else if (sym%withSpin == 2) then |
2097 |
++ noncol = 0 |
2098 |
++ spinAt_ => sym%spinAt |
2099 |
++ else |
2100 |
++ noncol = 0 |
2101 |
++ allocate(spinAt_(3, sym%nAtoms)) |
2102 |
++ spinAt_ = 0 |
2103 |
++ end if |
2104 |
++ if (sym%withSpinOrbit) then |
2105 |
++ use_inversion = 0 |
2106 |
++ else |
2107 |
++ use_inversion = 1 |
2108 |
++ end if |
2109 |
++ |
2110 |
++ if (sym%nsym == 0) then |
2111 |
++ if (AB_DBG) write(0,*) "AB symmetry: call ABINIT symfind." |
2112 |
++ call symfind(berryopt, sym%field, sym%gprimd, jellslab, AB7_MAX_SYMMETRIES, & |
2113 |
++ & sym%nAtoms, noncol, sym%nBravSym, sym%nSym, sym%bravSym, spinAt_, & |
2114 |
++ & symAfm_, sym_, transNon_, sym%tolsym, sym%typeAt, & |
2115 |
++ & use_inversion, sym%xRed) |
2116 |
++ if (AB_DBG) write(0,*) "AB symmetry: call ABINIT OK." |
2117 |
++ if (AB_DBG) write(0, "(A,I3)") " nSym:", sym%nSym |
2118 |
++ if (associated(sym%sym)) deallocate(sym%sym) |
2119 |
++ if (associated(sym%symAfm)) deallocate(sym%symAfm) |
2120 |
++ if (associated(sym%transNon)) deallocate(sym%transNon) |
2121 |
++ allocate(sym%sym(3, 3, sym%nSym)) |
2122 |
++ sym%sym(:,:,:) = sym_(:,:, 1:sym%nSym) |
2123 |
++ allocate(sym%symAfm(sym%nSym)) |
2124 |
++ sym%symAfm(:) = symAfm_(1:sym%nSym) |
2125 |
++ allocate(sym%transNon(3, sym%nSym)) |
2126 |
++ sym%transNon(:,:) = transNon_(:, 1:sym%nSym) |
2127 |
++ else if (sym%nsym < 0) then |
2128 |
++ sym%nsym = -sym%nsym |
2129 |
++ sym_(:,:, 1:sym%nSym) = sym%sym(:,:,:) |
2130 |
++ transNon_(:, 1:sym%nSym) = sym%transNon(:,:) |
2131 |
++ symAfm_(1:sym%nSym) = sym%symAfm(:) |
2132 |
++ end if |
2133 |
++ |
2134 |
++ if (sym%withSpin == 1) then |
2135 |
++ deallocate(spinAt_) |
2136 |
++ end if |
2137 |
++ |
2138 |
++ if (AB_DBG) write(0,*) "AB symmetry: call ABINIT symanal." |
2139 |
++ call symanal(sym%bravais, 0, sym%genAfm, AB7_MAX_SYMMETRIES, sym%nSym, & |
2140 |
++ & sym%pointGroupMagn, sym%rprimd, sym%spaceGroup, symAfm_, & |
2141 |
++ & sym_, transNon_, sym%tolsym) |
2142 |
++ if (AB_DBG) write(0,*) "AB symmetry: call ABINIT OK." |
2143 |
++ sym%transNon(:,:) = transNon_(:, 1:sym%nSym) |
2144 |
++ |
2145 |
++ if (sym%bravais(1) < 0) then |
2146 |
++ sym%multiplicity = 2 |
2147 |
++ else |
2148 |
++ sym%multiplicity = 1 |
2149 |
++ end if |
2150 |
++ if (AB_DBG) write(0, "(A,I3)") " multi:", sym%multiplicity |
2151 |
++ if (AB_DBG) write(0, "(A,I3)") " space:", sym%spaceGroup |
2152 |
++ end subroutine compute_matrices |
2153 |
++ |
2154 |
++ subroutine symmetry_get_n_sym(id, nSym, errno) |
2155 |
++ !scalars |
2156 |
++ |
2157 |
++!This section has been created automatically by the script Abilint (TD). |
2158 |
++!Do not modify the following lines by hand. |
2159 |
++!End of the abilint section |
2160 |
++ |
2161 |
++ integer, intent(in) :: id |
2162 |
++ integer, intent(out) :: errno |
2163 |
++ integer, intent(out) :: nSym |
2164 |
++ |
2165 |
++ type(symmetry_list), pointer :: token |
2166 |
++ |
2167 |
++ if (AB_DBG) write(0,*) "AB symmetry: call get nSym." |
2168 |
++ |
2169 |
++ errno = AB7_NO_ERROR |
2170 |
++ call get_item(token, id) |
2171 |
++ if (.not. associated(token)) then |
2172 |
++ errno = AB7_ERROR_OBJ |
2173 |
++ return |
2174 |
++ end if |
2175 |
++ |
2176 |
++ if (token%data%nSym <= 0) then |
2177 |
++ ! We do the computation of the matrix part. |
2178 |
++ call compute_matrices(token%data, errno) |
2179 |
++ end if |
2180 |
++ |
2181 |
++ nSym = token%data%nSym |
2182 |
++ end subroutine symmetry_get_n_sym |
2183 |
++ |
2184 |
++ subroutine symmetry_set_n_sym(id, nSym, sym, transNon, symAfm, errno) |
2185 |
++ !scalars |
2186 |
++ |
2187 |
++!This section has been created automatically by the script Abilint (TD). |
2188 |
++!Do not modify the following lines by hand. |
2189 |
++!End of the abilint section |
2190 |
++ |
2191 |
++ integer, intent(in) :: id |
2192 |
++ integer, intent(in) :: nSym |
2193 |
++ integer, intent(in) :: sym(3, 3, nSym) |
2194 |
++ real(dp), intent(in) :: transNon(3, nSym) |
2195 |
++ integer, intent(in) :: symAfm(nSym) |
2196 |
++ integer, intent(out) :: errno |
2197 |
++ |
2198 |
++ type(symmetry_list), pointer :: token |
2199 |
++ |
2200 |
++ if (AB_DBG) write(0,*) "AB symmetry: call get nSym." |
2201 |
++ |
2202 |
++ errno = AB7_NO_ERROR |
2203 |
++ call get_item(token, id) |
2204 |
++ if (.not. associated(token)) then |
2205 |
++ errno = AB7_ERROR_OBJ |
2206 |
++ return |
2207 |
++ end if |
2208 |
++ |
2209 |
++ if (nSym <= 0) then |
2210 |
++ errno = AB7_ERROR_ARG |
2211 |
++ return |
2212 |
++ else |
2213 |
++ allocate(token%data%sym(3, 3, nSym)) |
2214 |
++ token%data%sym(:,:,:) = sym(:,:,:) |
2215 |
++ allocate(token%data%symAfm(nSym)) |
2216 |
++ token%data%symAfm(:) = symAfm(:) |
2217 |
++ allocate(token%data%transNon(3, nSym)) |
2218 |
++ token%data%transNon(:,:) = transNon(:,:) |
2219 |
++ |
2220 |
++ token%data%auto = .false. |
2221 |
++ token%data%nsym = -nSym |
2222 |
++ end if |
2223 |
++ |
2224 |
++ ! We do the computation of the matrix part. |
2225 |
++ call compute_matrices(token%data, errno) |
2226 |
++ end subroutine symmetry_set_n_sym |
2227 |
++ |
2228 |
++ subroutine symmetry_get_matrices(id, nSym, sym, transNon, symAfm, errno) |
2229 |
++ |
2230 |
++ |
2231 |
++!This section has been created automatically by the script Abilint (TD). |
2232 |
++!Do not modify the following lines by hand. |
2233 |
++!End of the abilint section |
2234 |
++ |
2235 |
++ integer, intent(in) :: id |
2236 |
++ integer, intent(out) :: errno |
2237 |
++ integer, intent(out) :: nSym |
2238 |
++ integer, intent(out) :: sym(3, 3, AB7_MAX_SYMMETRIES) |
2239 |
++ integer, intent(out) :: symAfm(AB7_MAX_SYMMETRIES) |
2240 |
++ real(dp), intent(out) :: transNon(3, AB7_MAX_SYMMETRIES) |
2241 |
++ |
2242 |
++ type(symmetry_list), pointer :: token |
2243 |
++ |
2244 |
++ if (AB_DBG) write(0,*) "AB symmetry: call get matrices." |
2245 |
++ |
2246 |
++ errno = AB7_NO_ERROR |
2247 |
++ call get_item(token, id) |
2248 |
++ if (.not. associated(token)) then |
2249 |
++ errno = AB7_ERROR_OBJ |
2250 |
++ return |
2251 |
++ end if |
2252 |
++ |
2253 |
++ if (token%data%nSym <= 0) then |
2254 |
++ ! We do the computation of the matrix part. |
2255 |
++ call compute_matrices(token%data, errno) |
2256 |
++ end if |
2257 |
++ |
2258 |
++ nSym = token%data%nSym |
2259 |
++ sym(:, :, 1:nSym) = token%data%sym(:, :,:) |
2260 |
++ symAfm(1:nSym) = token%data%symAfm(:) |
2261 |
++ transNon(:, 1:nSym) = token%data%transNon(:,:) |
2262 |
++ end subroutine symmetry_get_matrices |
2263 |
++ |
2264 |
++ subroutine symmetry_get_matrices_p(id, nSym, sym, transNon, symAfm, errno) |
2265 |
++ |
2266 |
++ |
2267 |
++!This section has been created automatically by the script Abilint (TD). |
2268 |
++!Do not modify the following lines by hand. |
2269 |
++!End of the abilint section |
2270 |
++ |
2271 |
++ integer, intent(in) :: id |
2272 |
++ integer, intent(out) :: errno |
2273 |
++ integer, intent(out) :: nSym |
2274 |
++ integer, pointer :: sym(:,:,:) |
2275 |
++ integer, pointer :: symAfm(:) |
2276 |
++ real(dp), pointer :: transNon(:,:) |
2277 |
++ |
2278 |
++ type(symmetry_list), pointer :: token |
2279 |
++ |
2280 |
++ if (AB_DBG) write(0,*) "AB symmetry: call get matrices as pointers." |
2281 |
++ |
2282 |
++ errno = AB7_NO_ERROR |
2283 |
++ call get_item(token, id) |
2284 |
++ if (.not. associated(token)) then |
2285 |
++ errno = AB7_ERROR_OBJ |
2286 |
++ return |
2287 |
++ end if |
2288 |
++ |
2289 |
++ if (token%data%nSym <= 0) then |
2290 |
++ ! We do the computation of the matrix part. |
2291 |
++ call compute_matrices(token%data, errno) |
2292 |
++ end if |
2293 |
++ |
2294 |
++ nSym = token%data%nSym |
2295 |
++ sym => token%data%sym |
2296 |
++ symAfm => token%data%symAfm |
2297 |
++ transNon => token%data%transNon |
2298 |
++ end subroutine symmetry_get_matrices_p |
2299 |
++ |
2300 |
++ subroutine symmetry_get_multiplicity(id, multiplicity, errno) |
2301 |
++ |
2302 |
++ |
2303 |
++!This section has been created automatically by the script Abilint (TD). |
2304 |
++!Do not modify the following lines by hand. |
2305 |
++!End of the abilint section |
2306 |
++ |
2307 |
++ integer, intent(in) :: id |
2308 |
++ integer, intent(out) :: multiplicity, errno |
2309 |
++ |
2310 |
++ type(symmetry_list), pointer :: token |
2311 |
++ |
2312 |
++ if (AB_DBG) write(0,*) "AB symmetry: call get multiplicity." |
2313 |
++ |
2314 |
++ errno = AB7_NO_ERROR |
2315 |
++ call get_item(token, id) |
2316 |
++ if (.not. associated(token)) then |
2317 |
++ errno = AB7_ERROR_OBJ |
2318 |
++ return |
2319 |
++ end if |
2320 |
++ |
2321 |
++ if (token%data%multiplicity < 0) then |
2322 |
++ ! We do the computation of the matrix part. |
2323 |
++ call compute_matrices(token%data, errno) |
2324 |
++ end if |
2325 |
++ multiplicity = token%data%multiplicity |
2326 |
++ end subroutine symmetry_get_multiplicity |
2327 |
++ |
2328 |
++ subroutine symmetry_get_group(id, spaceGroup, spaceGroupId, & |
2329 |
++ & pointGroupMagn, genAfm, errno) |
2330 |
++ |
2331 |
++ |
2332 |
++!This section has been created automatically by the script Abilint (TD). |
2333 |
++!Do not modify the following lines by hand. |
2334 |
++ use interfaces_42_geometry |
2335 |
++!End of the abilint section |
2336 |
++ |
2337 |
++ integer, intent(in) :: id |
2338 |
++ integer, intent(out) :: errno |
2339 |
++ real(dp), intent(out) :: genAfm(3) |
2340 |
++ character(len=15), intent(out) :: spaceGroup |
2341 |
++ integer, intent(out) :: spaceGroupId, pointGroupMagn |
2342 |
++ |
2343 |
++ type(symmetry_list), pointer :: token |
2344 |
++ integer :: sporder |
2345 |
++ character(len=1) :: brvLattice |
2346 |
++ character(len=15) :: ptintsb,ptschsb,schsb,spgrp |
2347 |
++ character(len=35) :: intsbl |
2348 |
++ |
2349 |
++ if (AB_DBG) write(0,*) "AB symmetry: call get group." |
2350 |
++ |
2351 |
++ errno = AB7_NO_ERROR |
2352 |
++ call get_item(token, id) |
2353 |
++ if (.not. associated(token)) then |
2354 |
++ errno = AB7_ERROR_OBJ |
2355 |
++ return |
2356 |
++ end if |
2357 |
++ |
2358 |
++ if (token%data%multiplicity < 0) then |
2359 |
++ ! We do the computation of the matrix part. |
2360 |
++ call compute_matrices(token%data, errno) |
2361 |
++ end if |
2362 |
++ |
2363 |
++ if (token%data%multiplicity /= 1) then |
2364 |
++ errno = AB7_ERROR_SYM_NOT_PRIMITIVE |
2365 |
++ return |
2366 |
++ end if |
2367 |
++ |
2368 |
++ call spgdata(brvLattice,spgrp,intsbl,ptintsb,ptschsb,& |
2369 |
++ & schsb,1,token%data%spaceGroup,sporder,1) |
2370 |
++ |
2371 |
++ write(spaceGroup, "(3A)") brvLattice, " ", trim(spgrp(1:13)) |
2372 |
++ pointGroupMagn = token%data%pointGroupMagn |
2373 |
++ spaceGroupId = token%data%spaceGroup |
2374 |
++ genAfm = token%data%genAfm |
2375 |
++ end subroutine symmetry_get_group |
2376 |
++ |
2377 |
++ subroutine compute_equivalent_atoms(sym) |
2378 |
++ |
2379 |
++ |
2380 |
++!This section has been created automatically by the script Abilint (TD). |
2381 |
++!Do not modify the following lines by hand. |
2382 |
++ use interfaces_32_util |
2383 |
++ use interfaces_42_geometry |
2384 |
++!End of the abilint section |
2385 |
++ |
2386 |
++ type(symmetry_type), intent(inout) :: sym |
2387 |
++ |
2388 |
++ integer, allocatable :: symrec(:,:,:) |
2389 |
++ integer :: isym |
2390 |
++ |
2391 |
++ if (.not. associated(sym%indexingAtoms)) & |
2392 |
++ & allocate(sym%indexingAtoms(4, sym%nSym, sym%nAtoms)) |
2393 |
++ |
2394 |
++ !Get the symmetry matrices in terms of reciprocal basis |
2395 |
++ allocate(symrec(3, 3, sym%nSym)) |
2396 |
++ do isym = 1, sym%nSym, 1 |
2397 |
++ call mati3inv(sym%sym(:,:,isym), symrec(:,:,isym)) |
2398 |
++ end do |
2399 |
++ |
2400 |
++ !Obtain a list of rotated atom labels: |
2401 |
++ call symatm(sym%indexingAtoms, sym%nAtoms, sym%nSym, symrec, & |
2402 |
++ & sym%transNon, sym%tolsym, sym%typeAt, sym%xRed) |
2403 |
++ |
2404 |
++ deallocate(symrec) |
2405 |
++ end subroutine compute_equivalent_atoms |
2406 |
++ |
2407 |
++ subroutine symmetry_get_equivalent_atom(id, equiv, iAtom, errno) |
2408 |
++ |
2409 |
++ |
2410 |
++!This section has been created automatically by the script Abilint (TD). |
2411 |
++!Do not modify the following lines by hand. |
2412 |
++!End of the abilint section |
2413 |
++ |
2414 |
++ integer, intent(in) :: id |
2415 |
++ integer, intent(in) :: iAtom |
2416 |
++ integer, intent(out) :: equiv(4, AB7_MAX_SYMMETRIES) |
2417 |
++ integer, intent(out) :: errno |
2418 |
++ |
2419 |
++ type(symmetry_list), pointer :: token |
2420 |
++ |
2421 |
++ if (AB_DBG) write(0,*) "AB symmetry: call get equivalent." |
2422 |
++ |
2423 |
++ errno = AB7_NO_ERROR |
2424 |
++ call get_item(token, id) |
2425 |
++ if (.not. associated(token)) then |
2426 |
++ errno = AB7_ERROR_OBJ |
2427 |
++ return |
2428 |
++ end if |
2429 |
++ |
2430 |
++ if (iAtom < 1 .or. iAtom > token%data%nAtoms) then |
2431 |
++ errno = AB7_ERROR_ARG |
2432 |
++ return |
2433 |
++ end if |
2434 |
++ |
2435 |
++ if (.not. associated(token%data%indexingAtoms)) then |
2436 |
++ ! We do the computation of the matrix part. |
2437 |
++ call compute_equivalent_atoms(token%data) |
2438 |
++ end if |
2439 |
++ |
2440 |
++ equiv(:, 1:token%data%nSym) = token%data%indexingAtoms(:,:,iAtom) |
2441 |
++ end subroutine symmetry_get_equivalent_atom |
2442 |
++ |
2443 |
++end module m_ab7_symmetry |
2444 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/42_geometry/symfind.F90 bigdft-abi-1.0.4.new/libABINIT/src/42_geometry/symfind.F90 |
2445 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/42_geometry/symfind.F90 2012-07-09 16:43:33.000000000 +0200 |
2446 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/42_geometry/symfind.F90 2013-06-11 16:51:00.000000000 +0200 |
2447 |
+@@ -49,7 +49,7 @@ |
2448 |
+ !! be 0 0 0 each for a symmorphic space group) |
2449 |
+ !! |
2450 |
+ !! PARENTS |
2451 |
+-!! ingeo,ab6_symmetry_f90 |
2452 |
++!! ingeo,ab7_symmetry_f90 |
2453 |
+ !! |
2454 |
+ !! CHILDREN |
2455 |
+ !! leave_new,wrtout |
2456 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/findminscf.F90 bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/findminscf.F90 |
2457 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/findminscf.F90 2012-07-09 16:43:33.000000000 +0200 |
2458 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/findminscf.F90 2013-06-11 16:51:00.000000000 +0200 |
2459 |
+@@ -92,7 +92,7 @@ |
2460 |
+ !write(6,*)' choice,lambda_1,lambda_2=',choice,lambda_1,lambda_2 |
2461 |
+ !ENDDEBUG |
2462 |
+ |
2463 |
+- errid = AB6_NO_ERROR |
2464 |
++ errid = AB7_NO_ERROR |
2465 |
+ d_lambda=lambda_1-lambda_2 |
2466 |
+ |
2467 |
+ if(choice==1) then |
2468 |
+@@ -111,7 +111,7 @@ |
2469 |
+ & +0.5_dp*d2edv2_1*(lambda_2-lambda_1)**2 |
2470 |
+ |
2471 |
+ if(d2edv2_mid<0.0_dp)then |
2472 |
+- errid = AB6_ERROR_MIXING_INTERNAL |
2473 |
++ errid = AB7_ERROR_MIXING_INTERNAL |
2474 |
+ write(errmess, '(a,a,a,a,es18.10,a)' ) ch10,& |
2475 |
+ & ' findminscf : WARNING -',ch10,& |
2476 |
+ & ' (scfcge) The second derivative is negative, equal to',d2edv2_mid ,'.' |
2477 |
+@@ -128,7 +128,7 @@ |
2478 |
+ d2edv2_2=d2edv2_1 |
2479 |
+ d2edv2_predict=d2edv2_1 |
2480 |
+ if(d2edv2_predict<0.0_dp)then |
2481 |
+- errid = AB6_ERROR_MIXING_INTERNAL |
2482 |
++ errid = AB7_ERROR_MIXING_INTERNAL |
2483 |
+ write(errmess, '(a,a,a,a,es18.10,a,a,a)' ) ch10,& |
2484 |
+ & ' findmin : WARNING -',ch10,& |
2485 |
+ & ' (scfcge) The second derivative is negative, equal to',d2edv2_predict,'.',& |
2486 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/m_ab6_mixing.F90 bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/m_ab6_mixing.F90 |
2487 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/m_ab6_mixing.F90 2012-07-09 16:43:33.000000000 +0200 |
2488 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/m_ab6_mixing.F90 1970-01-01 01:00:00.000000000 +0100 |
2489 |
+@@ -1,688 +0,0 @@ |
2490 |
+-#if defined HAVE_CONFIG_H |
2491 |
+-#include "config.h" |
2492 |
+-#endif |
2493 |
+- |
2494 |
+- module m_ab6_mixing |
2495 |
+- |
2496 |
+- use m_profiling |
2497 |
+- use defs_basis |
2498 |
+- |
2499 |
+- implicit none |
2500 |
+- |
2501 |
+- private |
2502 |
+- |
2503 |
+- integer, parameter, public :: AB6_MIXING_NONE = 0 |
2504 |
+- integer, parameter, public :: AB6_MIXING_EIG = 1 |
2505 |
+- integer, parameter, public :: AB6_MIXING_SIMPLE = 2 |
2506 |
+- integer, parameter, public :: AB6_MIXING_ANDERSON = 3 |
2507 |
+- integer, parameter, public :: AB6_MIXING_ANDERSON_2 = 4 |
2508 |
+- integer, parameter, public :: AB6_MIXING_CG_ENERGY = 5 |
2509 |
+- integer, parameter, public :: AB6_MIXING_CG_ENERGY_2 = 6 |
2510 |
+- integer, parameter, public :: AB6_MIXING_PULAY = 7 |
2511 |
+- |
2512 |
+- integer, parameter, public :: AB6_MIXING_POTENTIAL = 0 |
2513 |
+- integer, parameter, public :: AB6_MIXING_DENSITY = 1 |
2514 |
+- |
2515 |
+- integer, parameter, public :: AB6_MIXING_REAL_SPACE = 1 |
2516 |
+- integer, parameter, public :: AB6_MIXING_FOURRIER_SPACE = 2 |
2517 |
+- |
2518 |
+- type, public :: ab6_mixing_object |
2519 |
+- integer :: iscf |
2520 |
+- integer :: nfft, nspden, kind, space |
2521 |
+- |
2522 |
+- logical :: useprec |
2523 |
+- integer :: mffmem |
2524 |
+- character(len = fnlen) :: diskCache |
2525 |
+- integer :: n_index, n_fftgr, n_pulayit, n_pawmix |
2526 |
+- integer, dimension(:), pointer :: i_rhor, i_vtrial, i_vresid, i_vrespc |
2527 |
+- real(dp), dimension(:,:,:), pointer :: f_fftgr, f_atm |
2528 |
+- real(dp), dimension(:,:), pointer :: f_paw |
2529 |
+- |
2530 |
+- ! Private |
2531 |
+- integer :: n_atom |
2532 |
+- real(dp), pointer :: xred(:,:), dtn_pc(:,:) |
2533 |
+- end type ab6_mixing_object |
2534 |
+- |
2535 |
+- public :: ab6_mixing_new |
2536 |
+- public :: ab6_mixing_deallocate |
2537 |
+- |
2538 |
+- public :: ab6_mixing_use_disk_cache |
2539 |
+- public :: ab6_mixing_use_moving_atoms |
2540 |
+- public :: ab6_mixing_copy_current_step |
2541 |
+- |
2542 |
+- public :: ab6_mixing_eval_allocate |
2543 |
+- public :: ab6_mixing_eval |
2544 |
+- public :: ab6_mixing_eval_deallocate |
2545 |
+- |
2546 |
+- contains |
2547 |
+- |
2548 |
+- subroutine init_(mix) |
2549 |
+- implicit none |
2550 |
+- |
2551 |
+- type(ab6_mixing_object), intent(out) :: mix |
2552 |
+- |
2553 |
+- ! Default values. |
2554 |
+- mix%iscf = AB6_MIXING_NONE |
2555 |
+- mix%mffmem = 1 |
2556 |
+- mix%n_index = 0 |
2557 |
+- mix%n_fftgr = 0 |
2558 |
+- mix%n_pulayit = 7 |
2559 |
+- mix%n_pawmix = 0 |
2560 |
+- mix%n_atom = 0 |
2561 |
+- mix%useprec = .true. |
2562 |
+- |
2563 |
+- call nullify_(mix) |
2564 |
+- end subroutine init_ |
2565 |
+- |
2566 |
+- subroutine nullify_(mix) |
2567 |
+- |
2568 |
+- |
2569 |
+- implicit none |
2570 |
+- |
2571 |
+- type(ab6_mixing_object), intent(inout) :: mix |
2572 |
+- |
2573 |
+- ! Nullify internal pointers. |
2574 |
+- nullify(mix%i_rhor) |
2575 |
+- nullify(mix%i_vtrial) |
2576 |
+- nullify(mix%i_vresid) |
2577 |
+- nullify(mix%i_vrespc) |
2578 |
+- nullify(mix%f_fftgr) |
2579 |
+- nullify(mix%f_atm) |
2580 |
+- nullify(mix%f_paw) |
2581 |
+- nullify(mix%dtn_pc) |
2582 |
+- nullify(mix%xred) |
2583 |
+- end subroutine nullify_ |
2584 |
+- |
2585 |
+- subroutine ab6_mixing_new(mix, iscf, kind, space, nfft, nspden, & |
2586 |
+- & npawmix, errid, errmess, npulayit, useprec) |
2587 |
+- implicit none |
2588 |
+- |
2589 |
+- type(ab6_mixing_object), intent(out) :: mix |
2590 |
+- integer, intent(in) :: iscf, kind, space, nfft, nspden, npawmix |
2591 |
+- integer, intent(out) :: errid |
2592 |
+- character(len = 500), intent(out) :: errmess |
2593 |
+- integer, intent(in), optional :: npulayit |
2594 |
+- logical, intent(in), optional :: useprec |
2595 |
+- |
2596 |
+- integer :: ii, i_stat |
2597 |
+- character(len = *), parameter :: subname = "ab6_mixing_new" |
2598 |
+- |
2599 |
+- ! Set default values. |
2600 |
+- call init_(mix) |
2601 |
+- |
2602 |
+- ! Argument checkings. |
2603 |
+- if (kind /= AB6_MIXING_POTENTIAL .and. kind /= AB6_MIXING_DENSITY) then |
2604 |
+- errid = AB6_ERROR_MIXING_ARG |
2605 |
+- write(errmess, '(a,a,a,a)' )ch10,& |
2606 |
+- & ' ab6_mixing_set_arrays: ERROR -',ch10,& |
2607 |
+- & ' Mixing must be done on density or potential only.' |
2608 |
+- return |
2609 |
+- end if |
2610 |
+- if (space /= AB6_MIXING_REAL_SPACE .and. & |
2611 |
+- & space /= AB6_MIXING_FOURRIER_SPACE) then |
2612 |
+- errid = AB6_ERROR_MIXING_ARG |
2613 |
+- write(errmess, '(a,a,a,a)' )ch10,& |
2614 |
+- & ' ab6_mixing_set_arrays: ERROR -',ch10,& |
2615 |
+- & ' Mixing must be done in real or Fourrier space only.' |
2616 |
+- return |
2617 |
+- end if |
2618 |
+- if (iscf /= AB6_MIXING_EIG .and. iscf /= AB6_MIXING_SIMPLE .and. & |
2619 |
+- & iscf /= AB6_MIXING_ANDERSON .and. & |
2620 |
+- & iscf /= AB6_MIXING_ANDERSON_2 .and. & |
2621 |
+- & iscf /= AB6_MIXING_CG_ENERGY .and. & |
2622 |
+- & iscf /= AB6_MIXING_PULAY .and. & |
2623 |
+- & iscf /= AB6_MIXING_CG_ENERGY_2) then |
2624 |
+- errid = AB6_ERROR_MIXING_ARG |
2625 |
+- write(errmess, "(A,I0,A)") "Unknown mixing scheme (", iscf, ")." |
2626 |
+- return |
2627 |
+- end if |
2628 |
+- errid = AB6_NO_ERROR |
2629 |
+- |
2630 |
+- ! Mandatory arguments. |
2631 |
+- mix%iscf = iscf |
2632 |
+- mix%kind = kind |
2633 |
+- mix%space = space |
2634 |
+- mix%nfft = nfft |
2635 |
+- mix%nspden = nspden |
2636 |
+- mix%n_pawmix = npawmix |
2637 |
+- |
2638 |
+- ! Optional arguments. |
2639 |
+- if (present(useprec)) mix%useprec = useprec |
2640 |
+- |
2641 |
+- ! Set-up internal dimensions. |
2642 |
+- !These arrays are needed only in the self-consistent case |
2643 |
+- if (iscf == AB6_MIXING_EIG) then |
2644 |
+- ! For iscf==1, five additional vectors are needed |
2645 |
+- ! The index 1 is attributed to the old trial potential, |
2646 |
+- ! The new residual potential, and the new |
2647 |
+- ! preconditioned residual potential receive now a temporary index |
2648 |
+- ! The indices number 4 and 5 are attributed to work vectors. |
2649 |
+- mix%n_fftgr=5 ; mix%n_index=1 |
2650 |
+- else if(iscf == AB6_MIXING_SIMPLE) then |
2651 |
+- ! For iscf==2, three additional vectors are needed. |
2652 |
+- ! The index number 1 is attributed to the old trial vector |
2653 |
+- ! The new residual potential, and the new preconditioned |
2654 |
+- ! residual potential, receive now a temporary index. |
2655 |
+- mix%n_fftgr=3 ; mix%n_index=1 |
2656 |
+- if (.not. mix%useprec) mix%n_fftgr = 2 |
2657 |
+- else if(iscf == AB6_MIXING_ANDERSON) then |
2658 |
+- ! For iscf==3 , four additional vectors are needed. |
2659 |
+- ! The index number 1 is attributed to the old trial vector |
2660 |
+- ! The new residual potential, and the new and old preconditioned |
2661 |
+- ! residual potential, receive now a temporary index. |
2662 |
+- mix%n_fftgr=4 ; mix%n_index=2 |
2663 |
+- if (.not. mix%useprec) mix%n_fftgr = 3 |
2664 |
+- else if (iscf == AB6_MIXING_ANDERSON_2) then |
2665 |
+- ! For iscf==4 , six additional vectors are needed. |
2666 |
+- ! The indices number 1 and 2 are attributed to two old trial vectors |
2667 |
+- ! The new residual potential, and the new and two old preconditioned |
2668 |
+- ! residual potentials, receive now a temporary index. |
2669 |
+- mix%n_fftgr=6 ; mix%n_index=3 |
2670 |
+- if (.not. mix%useprec) mix%n_fftgr = 5 |
2671 |
+- else if(iscf == AB6_MIXING_CG_ENERGY .or. iscf == AB6_MIXING_CG_ENERGY_2) then |
2672 |
+- ! For iscf==5 or 6, ten additional vectors are needed |
2673 |
+- ! The index number 1 is attributed to the old trial vector |
2674 |
+- ! The index number 6 is attributed to the search vector |
2675 |
+- ! Other indices are attributed now. Altogether ten vectors |
2676 |
+- mix%n_fftgr=10 ; mix%n_index=3 |
2677 |
+- else if(iscf == AB6_MIXING_PULAY) then |
2678 |
+- ! For iscf==7, lot of additional vectors are needed |
2679 |
+- ! The index number 1 is attributed to the old trial vector |
2680 |
+- ! The index number 2 is attributed to the old residual |
2681 |
+- ! The indices number 2 and 3 are attributed to two old precond. residuals |
2682 |
+- ! Other indices are attributed now. |
2683 |
+- if (present(npulayit)) mix%n_pulayit = npulayit |
2684 |
+- mix%n_fftgr=2+2*mix%n_pulayit ; mix%n_index=1+mix%n_pulayit |
2685 |
+- if (.not. mix%useprec) mix%n_fftgr = 1+2*mix%n_pulayit |
2686 |
+- end if ! iscf cases |
2687 |
+- |
2688 |
+- ! Allocate new arrays. |
2689 |
+- allocate(mix%i_rhor(mix%n_index), stat = i_stat) |
2690 |
+- call memocc(i_stat, mix%i_rhor, 'mix%i_rhor', subname) |
2691 |
+- allocate(mix%i_vtrial(mix%n_index), stat = i_stat) |
2692 |
+- call memocc(i_stat, mix%i_vtrial, 'mix%i_vtrial', subname) |
2693 |
+- allocate(mix%i_vresid(mix%n_index), stat = i_stat) |
2694 |
+- call memocc(i_stat, mix%i_vresid, 'mix%i_vresid', subname) |
2695 |
+- allocate(mix%i_vrespc(mix%n_index), stat = i_stat) |
2696 |
+- call memocc(i_stat, mix%i_vrespc, 'mix%i_vrespc', subname) |
2697 |
+- |
2698 |
+- ! Setup initial values. |
2699 |
+- if (iscf == AB6_MIXING_EIG) then |
2700 |
+- mix%i_vtrial(1)=1 ; mix%i_vresid(1)=2 ; mix%i_vrespc(1)=3 |
2701 |
+- else if(iscf == AB6_MIXING_SIMPLE) then |
2702 |
+- mix%i_vtrial(1)=1 ; mix%i_vresid(1)=2 ; mix%i_vrespc(1)=3 |
2703 |
+- if (.not. mix%useprec) mix%i_vrespc(1)=2 |
2704 |
+- else if(iscf == AB6_MIXING_ANDERSON) then |
2705 |
+- mix%i_vtrial(1)=1 ; mix%i_vresid(1)=2 |
2706 |
+- if (mix%useprec) then |
2707 |
+- mix%i_vrespc(1)=3 ; mix%i_vrespc(2)=4 |
2708 |
+- else |
2709 |
+- mix%i_vrespc(1)=2 ; mix%i_vrespc(2)=3 |
2710 |
+- end if |
2711 |
+- else if (iscf == AB6_MIXING_ANDERSON_2) then |
2712 |
+- mix%i_vtrial(1)=1 ; mix%i_vtrial(2)=2 |
2713 |
+- mix%i_vresid(1)=3 |
2714 |
+- if (mix%useprec) then |
2715 |
+- mix%i_vrespc(1)=4 ; mix%i_vrespc(2)=5 ; mix%i_vrespc(3)=6 |
2716 |
+- else |
2717 |
+- mix%i_vrespc(1)=3 ; mix%i_vrespc(2)=4 ; mix%i_vrespc(3)=5 |
2718 |
+- end if |
2719 |
+- else if(iscf == AB6_MIXING_CG_ENERGY .or. & |
2720 |
+- & iscf == AB6_MIXING_CG_ENERGY_2) then |
2721 |
+- mix%n_fftgr=10 ; mix%n_index=3 |
2722 |
+- mix%i_vtrial(1)=1 |
2723 |
+- mix%i_vresid(1)=2 ; mix%i_vresid(2)=4 ; mix%i_vresid(3)=7 |
2724 |
+- mix%i_vrespc(1)=3 ; mix%i_vrespc(2)=5 ; mix%i_vrespc(3)=8 |
2725 |
+- mix%i_rhor(2)=9 ; mix%i_rhor(3)=10 |
2726 |
+- else if(iscf == AB6_MIXING_PULAY) then |
2727 |
+- do ii=1,mix%n_pulayit |
2728 |
+- mix%i_vtrial(ii)=2*ii-1 ; mix%i_vrespc(ii)=2*ii |
2729 |
+- end do |
2730 |
+- mix%i_vrespc(mix%n_pulayit+1)=2*mix%n_pulayit+1 |
2731 |
+- mix%i_vresid(1)=2*mix%n_pulayit+2 |
2732 |
+- if (.not. mix%useprec) mix%i_vresid(1)=2 |
2733 |
+- end if ! iscf cases |
2734 |
+- end subroutine ab6_mixing_new |
2735 |
+- |
2736 |
+- subroutine ab6_mixing_use_disk_cache(mix, fnametmp_fft) |
2737 |
+- |
2738 |
+- |
2739 |
+- implicit none |
2740 |
+- |
2741 |
+- |
2742 |
+- type(ab6_mixing_object), intent(inout) :: mix |
2743 |
+- character(len = *), intent(in) :: fnametmp_fft |
2744 |
+- |
2745 |
+- if (len(trim(fnametmp_fft)) > 0) then |
2746 |
+- mix%mffmem = 0 |
2747 |
+- write(mix%diskCache, "(A)") fnametmp_fft |
2748 |
+- else |
2749 |
+- mix%mffmem = 1 |
2750 |
+- end if |
2751 |
+- end subroutine ab6_mixing_use_disk_cache |
2752 |
+- |
2753 |
+- subroutine ab6_mixing_use_moving_atoms(mix, natom, xred, dtn_pc) |
2754 |
+- |
2755 |
+- |
2756 |
+- type(ab6_mixing_object), intent(inout) :: mix |
2757 |
+- integer, intent(in) :: natom |
2758 |
+- real(dp), intent(in), target :: dtn_pc(3, natom) |
2759 |
+- real(dp), intent(in), target :: xred(3, natom) |
2760 |
+- |
2761 |
+- mix%n_atom = natom |
2762 |
+- mix%dtn_pc => dtn_pc |
2763 |
+- mix%xred => xred |
2764 |
+- end subroutine ab6_mixing_use_moving_atoms |
2765 |
+- |
2766 |
+- subroutine ab6_mixing_copy_current_step(mix, arr_resid, errid, errmess, & |
2767 |
+- & arr_respc, arr_paw_resid, arr_paw_respc, arr_atm) |
2768 |
+- |
2769 |
+- |
2770 |
+- type(ab6_mixing_object), intent(inout) :: mix |
2771 |
+- real(dp), intent(in) :: arr_resid(mix%space * mix%nfft, mix%nspden) |
2772 |
+- integer, intent(out) :: errid |
2773 |
+- character(len = 500), intent(out) :: errmess |
2774 |
+- real(dp), intent(in), optional :: arr_respc(mix%space * mix%nfft, mix%nspden) |
2775 |
+- real(dp), intent(in), optional :: arr_paw_resid(mix%n_pawmix), & |
2776 |
+- & arr_paw_respc(mix%n_pawmix) |
2777 |
+- real(dp), intent(in), optional :: arr_atm(3, mix%n_atom) |
2778 |
+- |
2779 |
+- if (.not. associated(mix%f_fftgr)) then |
2780 |
+- errid = AB6_ERROR_MIXING_ARG |
2781 |
+- write(errmess, '(a,a,a,a)' )ch10,& |
2782 |
+- & ' ab6_mixing_set_arr_current_step: ERROR -',ch10,& |
2783 |
+- & ' Working arrays not yet allocated.' |
2784 |
+- return |
2785 |
+- end if |
2786 |
+- errid = AB6_NO_ERROR |
2787 |
+- |
2788 |
+- mix%f_fftgr(:,:,mix%i_vresid(1)) = arr_resid(:,:) |
2789 |
+- if (present(arr_respc)) mix%f_fftgr(:,:,mix%i_vrespc(1)) = arr_respc(:,:) |
2790 |
+- if (present(arr_paw_resid)) mix%f_paw(:, mix%i_vresid(1)) = arr_paw_resid(:) |
2791 |
+- if (present(arr_paw_respc)) mix%f_paw(:, mix%i_vrespc(1)) = arr_paw_respc(:) |
2792 |
+- if (present(arr_atm)) mix%f_atm(:,:, mix%i_vresid(1)) = arr_atm(:,:) |
2793 |
+- end subroutine ab6_mixing_copy_current_step |
2794 |
+- |
2795 |
+- subroutine ab6_mixing_eval_allocate(mix, istep) |
2796 |
+- |
2797 |
+- |
2798 |
+-!This section has been created automatically by the script Abilint (TD). |
2799 |
+-!Do not modify the following lines by hand. |
2800 |
+- use interfaces_18_timing |
2801 |
+-!End of the abilint section |
2802 |
+- |
2803 |
+- implicit none |
2804 |
+- |
2805 |
+- type(ab6_mixing_object), intent(inout) :: mix |
2806 |
+- integer, intent(in), optional :: istep |
2807 |
+- |
2808 |
+- integer :: istep_, i_stat, usepaw |
2809 |
+- real(dp) :: tsec(2) |
2810 |
+- character(len = *), parameter :: subname = "ab6_mixing_eval_allocate" |
2811 |
+- |
2812 |
+- istep_ = 1 |
2813 |
+- if (present(istep)) istep_ = istep |
2814 |
+- |
2815 |
+- ! Allocate work array. |
2816 |
+- if (.not. associated(mix%f_fftgr)) then |
2817 |
+- allocate(mix%f_fftgr(mix%space * mix%nfft,mix%nspden,mix%n_fftgr), stat = i_stat) |
2818 |
+- call memocc(i_stat, mix%f_fftgr, 'mix%f_fftgr', subname) |
2819 |
+- mix%f_fftgr(:,:,:)=zero |
2820 |
+- if (mix%mffmem == 0 .and. istep_ > 1) then |
2821 |
+- call timab(83,1,tsec) |
2822 |
+- open(unit=tmp_unit,file=mix%diskCache,form='unformatted',status='old') |
2823 |
+- rewind(tmp_unit) |
2824 |
+- read(tmp_unit) mix%f_fftgr |
2825 |
+- if (mix%n_pawmix == 0) close(unit=tmp_unit) |
2826 |
+- call timab(83,2,tsec) |
2827 |
+- end if |
2828 |
+- end if |
2829 |
+- ! Allocate PAW work array. |
2830 |
+- if (.not. associated(mix%f_paw)) then |
2831 |
+- usepaw = 0 |
2832 |
+- if (mix%n_pawmix > 0) usepaw = 1 |
2833 |
+- allocate(mix%f_paw(max(1,mix%n_pawmix),max(1,mix%n_fftgr * usepaw)), & |
2834 |
+- & stat = i_stat) |
2835 |
+- call memocc(i_stat, mix%f_paw, 'mix%f_paw', subname) |
2836 |
+- if (mix%n_pawmix > 0) then |
2837 |
+- mix%f_paw(:,:)=zero |
2838 |
+- if (mix%mffmem == 0 .and. istep_ > 1) then |
2839 |
+- read(tmp_unit) mix%f_paw |
2840 |
+- close(unit=tmp_unit) |
2841 |
+- call timab(83,2,tsec) |
2842 |
+- end if |
2843 |
+- end if |
2844 |
+- end if |
2845 |
+- ! Allocate atom work array. |
2846 |
+- if (.not. associated(mix%f_atm)) then |
2847 |
+- allocate(mix%f_atm(3,mix%n_atom,mix%n_fftgr), stat = i_stat) |
2848 |
+- call memocc(i_stat, mix%f_atm, 'mix%f_atm', subname) |
2849 |
+- end if |
2850 |
+- end subroutine ab6_mixing_eval_allocate |
2851 |
+- |
2852 |
+- subroutine ab6_mixing_eval_deallocate(mix) |
2853 |
+- |
2854 |
+- |
2855 |
+-!This section has been created automatically by the script Abilint (TD). |
2856 |
+-!Do not modify the following lines by hand. |
2857 |
+- use interfaces_18_timing |
2858 |
+-!End of the abilint section |
2859 |
+- |
2860 |
+- implicit none |
2861 |
+- |
2862 |
+- type(ab6_mixing_object), intent(inout) :: mix |
2863 |
+- |
2864 |
+- integer :: i_all, i_stat |
2865 |
+- real(dp) :: tsec(2) |
2866 |
+- character(len = *), parameter :: subname = "ab6_mixing_eval_deallocate" |
2867 |
+- |
2868 |
+- ! Save on disk and deallocate work array in case on disk cache only. |
2869 |
+- if (mix%mffmem == 0) then |
2870 |
+- call timab(83,1,tsec) |
2871 |
+- open(unit=tmp_unit,file=mix%diskCache,form='unformatted',status='unknown') |
2872 |
+- rewind(tmp_unit) |
2873 |
+- ! VALGRIND complains not all of f_fftgr_disk is initialized |
2874 |
+- write(tmp_unit) mix%f_fftgr |
2875 |
+- if (mix%n_pawmix > 0) then |
2876 |
+- write(tmp_unit) mix%f_paw |
2877 |
+- end if |
2878 |
+- close(unit=tmp_unit) |
2879 |
+- call timab(83,2,tsec) |
2880 |
+- i_all = -product(shape(mix%f_fftgr))*kind(mix%f_fftgr) |
2881 |
+- deallocate(mix%f_fftgr, stat = i_stat) |
2882 |
+- call memocc(i_stat, i_all, 'mix%f_atm', subname) |
2883 |
+- nullify(mix%f_fftgr) |
2884 |
+- if (associated(mix%f_paw)) then |
2885 |
+- i_all = -product(shape(mix%f_paw))*kind(mix%f_paw) |
2886 |
+- deallocate(mix%f_paw, stat = i_stat) |
2887 |
+- call memocc(i_stat, i_all, 'mix%f_paw', subname) |
2888 |
+- nullify(mix%f_paw) |
2889 |
+- end if |
2890 |
+- end if |
2891 |
+- end subroutine ab6_mixing_eval_deallocate |
2892 |
+- |
2893 |
+- subroutine ab6_mixing_eval(mix, arr, istep, nfftot, ucvol, & |
2894 |
+- & mpi_comm, mpi_summarize, errid, errmess, & |
2895 |
+- & reset, isecur, pawarr, pawopt, response, etotal, potden, & |
2896 |
+- & resnrm, fnrm, fdot, user_data) |
2897 |
+- |
2898 |
+- |
2899 |
+-!This section has been created automatically by the script Abilint (TD). |
2900 |
+-!Do not modify the following lines by hand. |
2901 |
+- use interfaces_56_mixing |
2902 |
+-!End of the abilint section |
2903 |
+- |
2904 |
+- implicit none |
2905 |
+- |
2906 |
+- type(ab6_mixing_object), intent(inout) :: mix |
2907 |
+- integer, intent(in) :: istep, nfftot, mpi_comm |
2908 |
+- logical, intent(in) :: mpi_summarize |
2909 |
+- real(dp), intent(in) :: ucvol |
2910 |
+- real(dp), intent(inout) :: arr(mix%space * mix%nfft,mix%nspden) |
2911 |
+- integer, intent(out) :: errid |
2912 |
+- character(len = 500), intent(out) :: errmess |
2913 |
+- |
2914 |
+- logical, intent(in), optional :: reset |
2915 |
+- integer, intent(in), optional :: isecur, pawopt, response |
2916 |
+- real(dp), intent(inout), optional, target :: pawarr(mix%n_pawmix) |
2917 |
+- real(dp), intent(in), optional :: etotal |
2918 |
+- real(dp), intent(in), optional :: potden(mix%space * mix%nfft,mix%nspden) |
2919 |
+- real(dp), intent(out), optional :: resnrm |
2920 |
+- optional :: fnrm, fdot |
2921 |
+- integer, intent(in), optional :: user_data(:) |
2922 |
+- |
2923 |
+- interface |
2924 |
+- function fdot(x,y,cplex,nfft,nspden,opt_denpot,user_data) |
2925 |
+- integer, intent(in) :: cplex,nfft,nspden,opt_denpot |
2926 |
+- double precision, intent(in) :: x(*), y(*) |
2927 |
+- integer, intent(in) :: user_data(:) |
2928 |
+- |
2929 |
+- double precision :: fdot |
2930 |
+- end function fdot |
2931 |
+- |
2932 |
+- function fnrm(x,cplex,nfft,nspden,opt_denpot,user_data) |
2933 |
+- integer, intent(in) :: cplex,nfft,nspden,opt_denpot |
2934 |
+- double precision, intent(in) :: x(*) |
2935 |
+- integer, intent(in) :: user_data(:) |
2936 |
+- |
2937 |
+- double precision :: fnrm |
2938 |
+- end function fnrm |
2939 |
+- end interface |
2940 |
+- |
2941 |
+- character(len = *), parameter :: subname = "ab6_mixing_eval" |
2942 |
+- integer :: moveAtm, dbl_nnsclo, initialized, isecur_ |
2943 |
+- integer :: usepaw, pawoptmix_, response_, i_stat, i_all |
2944 |
+- integer :: user_data_(2) |
2945 |
+- real(dp) :: resnrm_ |
2946 |
+- real(dp), pointer :: pawarr_(:) |
2947 |
+- |
2948 |
+- ! Argument checkings. |
2949 |
+- if (mix%iscf == AB6_MIXING_NONE) then |
2950 |
+- errid = AB6_ERROR_MIXING_ARG |
2951 |
+- write(errmess, '(a,a,a,a)' )ch10,& |
2952 |
+- & ' ab6_mixing_eval: ERROR -',ch10,& |
2953 |
+- & ' No method has been chosen.' |
2954 |
+- return |
2955 |
+- end if |
2956 |
+- if (mix%n_pawmix > 0 .and. .not. present(pawarr)) then |
2957 |
+- errid = AB6_ERROR_MIXING_ARG |
2958 |
+- write(errmess, '(a,a,a,a)' )ch10,& |
2959 |
+- & ' ab6_mixing_eval: ERROR -',ch10,& |
2960 |
+- & ' PAW is used, but no pawarr argument provided.' |
2961 |
+- return |
2962 |
+- end if |
2963 |
+- if (mix%n_atom > 0 .and. (.not. associated(mix%dtn_pc) .or. & |
2964 |
+- & .not. associated(mix%xred))) then |
2965 |
+- errid = AB6_ERROR_MIXING_ARG |
2966 |
+- write(errmess, '(a,a,a,a)' )ch10,& |
2967 |
+- & ' ab6_mixing_eval: ERROR -',ch10,& |
2968 |
+- & ' Moving atoms is used, but no xred or dtn_pc attributes provided.' |
2969 |
+- return |
2970 |
+- end if |
2971 |
+- if ((present(fnrm) .or. present(fdot) .or. present(user_data)) .and. & |
2972 |
+- & .not. (present(fnrm) .and. present(fdot) .and. present(user_data))) then |
2973 |
+- errid = AB6_ERROR_MIXING_ARG |
2974 |
+- write(errmess, '(a,a,a,a)' )ch10,& |
2975 |
+- & ' ab6_mixing_eval: ERROR -',ch10,& |
2976 |
+- & ' Passing optional norm and dot product routines without user_data argument.' |
2977 |
+- return |
2978 |
+- end if |
2979 |
+- errid = AB6_NO_ERROR |
2980 |
+- |
2981 |
+- ! Miscellaneous |
2982 |
+- moveAtm = 0 |
2983 |
+- if (mix%n_atom > 0) moveAtm = 1 |
2984 |
+- initialized = 1 |
2985 |
+- if (present(reset)) then |
2986 |
+- if (reset) initialized = 0 |
2987 |
+- end if |
2988 |
+- isecur_ = 0 |
2989 |
+- if (present(isecur)) isecur_ = isecur |
2990 |
+- usepaw = 0 |
2991 |
+- if (mix%n_pawmix > 0) usepaw = 1 |
2992 |
+- pawoptmix_ = 0 |
2993 |
+- if (present(pawopt)) pawoptmix_ = pawopt |
2994 |
+- response_ = 0 |
2995 |
+- if (present(response)) response_ = response |
2996 |
+- if (present(pawarr)) then |
2997 |
+- pawarr_ => pawarr |
2998 |
+- else |
2999 |
+- allocate(pawarr_(1), stat = i_stat) |
3000 |
+- call memocc(i_stat, pawarr_, 'pawarr_', subname) |
3001 |
+- end if |
3002 |
+- |
3003 |
+- ! Norm and dot products. |
3004 |
+- if (.not. present(user_data)) then |
3005 |
+- user_data_(1) = 0 |
3006 |
+- if (mpi_summarize) user_data_(1) = 1 |
3007 |
+- user_data_(2) = mpi_comm |
3008 |
+- end if |
3009 |
+- |
3010 |
+- ! Do the mixing. |
3011 |
+- resnrm_ = 0.d0 |
3012 |
+- if (mix%iscf == AB6_MIXING_EIG) then |
3013 |
+- ! This routine compute the eigenvalues of the SCF operator |
3014 |
+- call scfeig(istep, mix%space * mix%nfft, mix%nspden, & |
3015 |
+- & mix%f_fftgr(:,:,mix%i_vrespc(1)), arr, & |
3016 |
+- & mix%f_fftgr(:,:,1), mix%f_fftgr(:,:,4:5), errid, errmess) |
3017 |
+- else if (mix%iscf == AB6_MIXING_SIMPLE .or. & |
3018 |
+- & mix%iscf == AB6_MIXING_ANDERSON .or. & |
3019 |
+- & mix%iscf == AB6_MIXING_ANDERSON_2 .or. & |
3020 |
+- & mix%iscf == AB6_MIXING_PULAY) then |
3021 |
+- if (present(user_data)) then |
3022 |
+- call scfopt(mix%space, mix%f_fftgr,mix%f_paw,mix%iscf,istep,& |
3023 |
+- & mix%i_vrespc,mix%i_vtrial, mix%nfft,mix%n_pawmix,mix%nspden, & |
3024 |
+- & mix%n_fftgr,mix%n_index,mix%kind,pawoptmix_,usepaw,pawarr_, & |
3025 |
+- & resnrm_, arr, fnrm, fdot, user_data, errid, errmess) |
3026 |
+- else |
3027 |
+- call scfopt(mix%space, mix%f_fftgr,mix%f_paw,mix%iscf,istep,& |
3028 |
+- & mix%i_vrespc,mix%i_vtrial, mix%nfft,mix%n_pawmix,mix%nspden, & |
3029 |
+- & mix%n_fftgr,mix%n_index,mix%kind,pawoptmix_,usepaw,pawarr_, & |
3030 |
+- & resnrm_, arr, fnrm_default, fdot_default, user_data_, errid, errmess) |
3031 |
+- end if |
3032 |
+- ! Change atomic positions |
3033 |
+- if((istep==1 .or. mix%iscf==AB6_MIXING_SIMPLE) .and. mix%n_atom > 0)then |
3034 |
+- ! GAF: 2009-06-03 |
3035 |
+- ! Apparently there are not reason |
3036 |
+- ! to restrict iscf=2 for ionmov=5 |
3037 |
+- mix%xred(:,:) = mix%xred(:,:) + mix%dtn_pc(:,:) |
3038 |
+- end if |
3039 |
+- else if (mix%iscf == AB6_MIXING_CG_ENERGY .or. & |
3040 |
+- & mix%iscf == AB6_MIXING_CG_ENERGY_2) then |
3041 |
+- ! Optimize next vtrial using an algorithm based |
3042 |
+- ! on the conjugate gradient minimization of etotal |
3043 |
+- if (.not. present(etotal) .or. .not. present(potden)) then |
3044 |
+- errid = AB6_ERROR_MIXING_ARG |
3045 |
+- write(errmess, '(a,a,a,a)' )ch10,& |
3046 |
+- & ' ab6_mixing_eval: ERROR -',ch10,& |
3047 |
+- & ' Arguments etotal or potden are missing for CG on energy methods.' |
3048 |
+- return |
3049 |
+- end if |
3050 |
+- if (mix%n_atom == 0) then |
3051 |
+- allocate(mix%xred(3,0), stat = i_stat) |
3052 |
+- call memocc(i_stat, mix%xred, 'mix%xred', subname) |
3053 |
+- allocate(mix%dtn_pc(3,0), stat = i_stat) |
3054 |
+- call memocc(i_stat, mix%dtn_pc, 'mix%dtn_pc', subname) |
3055 |
+- end if |
3056 |
+- if (present(user_data)) then |
3057 |
+- call scfcge(mix%space,dbl_nnsclo,mix%dtn_pc,etotal,mix%f_atm,& |
3058 |
+- & mix%f_fftgr,initialized,mix%iscf,isecur_,istep,& |
3059 |
+- & mix%i_rhor,mix%i_vresid,mix%i_vrespc,moveAtm,& |
3060 |
+- & mix%n_atom,mix%nfft,nfftot,& |
3061 |
+- & mix%nspden,mix%n_fftgr,mix%n_index,mix%kind,& |
3062 |
+- & response_,potden,ucvol,arr,mix%xred, & |
3063 |
+- & fnrm, fdot, user_data, errid, errmess) |
3064 |
+- else |
3065 |
+- call scfcge(mix%space,dbl_nnsclo,mix%dtn_pc,etotal,mix%f_atm,& |
3066 |
+- & mix%f_fftgr,initialized,mix%iscf,isecur_,istep,& |
3067 |
+- & mix%i_rhor,mix%i_vresid,mix%i_vrespc,moveAtm,& |
3068 |
+- & mix%n_atom,mix%nfft,nfftot,& |
3069 |
+- & mix%nspden,mix%n_fftgr,mix%n_index,mix%kind,& |
3070 |
+- & response_,potden,ucvol,arr,mix%xred, fnrm_default, & |
3071 |
+- & fdotn_default, user_data_, errid, errmess) |
3072 |
+- end if |
3073 |
+- if (mix%n_atom == 0) then |
3074 |
+- i_all = -product(shape(mix%xred))*kind(mix%xred) |
3075 |
+- deallocate(mix%xred, stat = i_stat) |
3076 |
+- call memocc(i_stat, i_all, 'mix%xred', subname) |
3077 |
+- i_all = -product(shape(mix%dtn_pc))*kind(mix%dtn_pc) |
3078 |
+- deallocate(mix%dtn_pc, stat = i_stat) |
3079 |
+- call memocc(i_stat, i_all, 'mix%dtn_pc', subname) |
3080 |
+- end if |
3081 |
+- if (dbl_nnsclo == 1) errid = AB6_ERROR_MIXING_INC_NNSLOOP |
3082 |
+- end if |
3083 |
+- |
3084 |
+- if (present(resnrm)) resnrm = resnrm_ |
3085 |
+- if (.not. present(pawarr)) then |
3086 |
+- i_all = -product(shape(pawarr_))*kind(pawarr_) |
3087 |
+- deallocate(pawarr_, stat = i_stat) |
3088 |
+- call memocc(i_stat, i_all, 'pawarr_', subname) |
3089 |
+- end if |
3090 |
+- end subroutine ab6_mixing_eval |
3091 |
+- |
3092 |
+- subroutine ab6_mixing_deallocate(mix) |
3093 |
+- implicit none |
3094 |
+- |
3095 |
+- type(ab6_mixing_object), intent(inout) :: mix |
3096 |
+- |
3097 |
+- integer :: i_all, i_stat |
3098 |
+- character(len = *), parameter :: subname = "ab6_mixing_deallocate" |
3099 |
+- |
3100 |
+- if (associated(mix%i_rhor)) then |
3101 |
+- i_all = -product(shape(mix%i_rhor))*kind(mix%i_rhor) |
3102 |
+- deallocate(mix%i_rhor, stat = i_stat) |
3103 |
+- call memocc(i_stat, i_all, 'mix%i_rhor', subname) |
3104 |
+- end if |
3105 |
+- if (associated(mix%i_vtrial)) then |
3106 |
+- i_all = -product(shape(mix%i_vtrial))*kind(mix%i_vtrial) |
3107 |
+- deallocate(mix%i_vtrial, stat = i_stat) |
3108 |
+- call memocc(i_stat, i_all, 'mix%i_vtrial', subname) |
3109 |
+- end if |
3110 |
+- if (associated(mix%i_vresid)) then |
3111 |
+- i_all = -product(shape(mix%i_vresid))*kind(mix%i_vresid) |
3112 |
+- deallocate(mix%i_vresid, stat = i_stat) |
3113 |
+- call memocc(i_stat, i_all, 'mix%i_vresid', subname) |
3114 |
+- end if |
3115 |
+- if (associated(mix%i_vrespc)) then |
3116 |
+- i_all = -product(shape(mix%i_vrespc))*kind(mix%i_vrespc) |
3117 |
+- deallocate(mix%i_vrespc, stat = i_stat) |
3118 |
+- call memocc(i_stat, i_all, 'mix%i_vrespc', subname) |
3119 |
+- end if |
3120 |
+- if (associated(mix%f_fftgr)) then |
3121 |
+- i_all = -product(shape(mix%f_fftgr))*kind(mix%f_fftgr) |
3122 |
+- deallocate(mix%f_fftgr, stat = i_stat) |
3123 |
+- call memocc(i_stat, i_all, 'mix%f_fftgr', subname) |
3124 |
+- end if |
3125 |
+- if (associated(mix%f_paw)) then |
3126 |
+- i_all = -product(shape(mix%f_paw))*kind(mix%f_paw) |
3127 |
+- deallocate(mix%f_paw, stat = i_stat) |
3128 |
+- call memocc(i_stat, i_all, 'mix%f_paw', subname) |
3129 |
+- end if |
3130 |
+- if (associated(mix%f_atm)) then |
3131 |
+- i_all = -product(shape(mix%f_atm))*kind(mix%f_atm) |
3132 |
+- deallocate(mix%f_atm, stat = i_stat) |
3133 |
+- call memocc(i_stat, i_all, 'mix%f_atm', subname) |
3134 |
+- end if |
3135 |
+- |
3136 |
+- call nullify_(mix) |
3137 |
+- end subroutine ab6_mixing_deallocate |
3138 |
+- |
3139 |
+- function fnrm_default(x,cplex,nfft,nspden,opt_denpot,user_data) |
3140 |
+- integer, intent(in) :: cplex,nfft,nspden,opt_denpot |
3141 |
+- double precision, intent(in) :: x(*) |
3142 |
+- integer, intent(in) :: user_data(:) |
3143 |
+- |
3144 |
+- double precision :: fnrm_default |
3145 |
+- real(dp) :: resid_new(1) |
3146 |
+- |
3147 |
+- call sqnormm_v(cplex,1,user_data(2),(user_data(1) /= 0),1,& |
3148 |
+- & nfft,resid_new,1,nspden,opt_denpot,x) |
3149 |
+- fnrm_default = resid_new(1) |
3150 |
+- end function fnrm_default |
3151 |
+- |
3152 |
+- function fdot_default(x,y,cplex,nfft,nspden,opt_denpot,user_data) |
3153 |
+- integer, intent(in) :: cplex,nfft,nspden,opt_denpot |
3154 |
+- double precision, intent(in) :: x(*), y(*) |
3155 |
+- integer, intent(in) :: user_data(:) |
3156 |
+- |
3157 |
+- double precision :: fdot_default |
3158 |
+- real(dp) :: prod_resid(1) |
3159 |
+- |
3160 |
+- call dotprodm_v(cplex,1,prod_resid,1,1,user_data(2),(user_data(1) /= 0),1,1,& |
3161 |
+- & nfft,1,1,nspden,opt_denpot,x,y) |
3162 |
+- fdot_default = prod_resid(1) |
3163 |
+- end function fdot_default |
3164 |
+- |
3165 |
+- function fdotn_default(x,y,cplex,nfft,nspden,opt_denpot,user_data) |
3166 |
+- integer, intent(in) :: cplex,nfft,nspden,opt_denpot |
3167 |
+- double precision, intent(in) :: x(*), y(*) |
3168 |
+- integer, intent(in) :: user_data(:) |
3169 |
+- |
3170 |
+- double precision :: fdotn_default |
3171 |
+- real(dp) :: prod_resid(1,1,1) |
3172 |
+- |
3173 |
+- call dotprodm_vn(cplex,1,x,prod_resid,1,1,user_data(2),(user_data(1) /= 0),1,1,& |
3174 |
+- & 1,nfft,1,nspden,y) |
3175 |
+- fdotn_default = prod_resid(1,1,1) |
3176 |
+- end function fdotn_default |
3177 |
+- end module m_ab6_mixing |
3178 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/m_ab7_mixing.F90 bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/m_ab7_mixing.F90 |
3179 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/m_ab7_mixing.F90 1970-01-01 01:00:00.000000000 +0100 |
3180 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/m_ab7_mixing.F90 2013-06-11 16:51:00.000000000 +0200 |
3181 |
+@@ -0,0 +1,688 @@ |
3182 |
++#if defined HAVE_CONFIG_H |
3183 |
++#include "config.h" |
3184 |
++#endif |
3185 |
++ |
3186 |
++ module m_ab7_mixing |
3187 |
++ |
3188 |
++ use m_profiling |
3189 |
++ use defs_basis |
3190 |
++ |
3191 |
++ implicit none |
3192 |
++ |
3193 |
++ private |
3194 |
++ |
3195 |
++ integer, parameter, public :: AB7_MIXING_NONE = 0 |
3196 |
++ integer, parameter, public :: AB7_MIXING_EIG = 1 |
3197 |
++ integer, parameter, public :: AB7_MIXING_SIMPLE = 2 |
3198 |
++ integer, parameter, public :: AB7_MIXING_ANDERSON = 3 |
3199 |
++ integer, parameter, public :: AB7_MIXING_ANDERSON_2 = 4 |
3200 |
++ integer, parameter, public :: AB7_MIXING_CG_ENERGY = 5 |
3201 |
++ integer, parameter, public :: AB7_MIXING_CG_ENERGY_2 = 6 |
3202 |
++ integer, parameter, public :: AB7_MIXING_PULAY = 7 |
3203 |
++ |
3204 |
++ integer, parameter, public :: AB7_MIXING_POTENTIAL = 0 |
3205 |
++ integer, parameter, public :: AB7_MIXING_DENSITY = 1 |
3206 |
++ |
3207 |
++ integer, parameter, public :: AB7_MIXING_REAL_SPACE = 1 |
3208 |
++ integer, parameter, public :: AB7_MIXING_FOURRIER_SPACE = 2 |
3209 |
++ |
3210 |
++ type, public :: ab7_mixing_object |
3211 |
++ integer :: iscf |
3212 |
++ integer :: nfft, nspden, kind, space |
3213 |
++ |
3214 |
++ logical :: useprec |
3215 |
++ integer :: mffmem |
3216 |
++ character(len = fnlen) :: diskCache |
3217 |
++ integer :: n_index, n_fftgr, n_pulayit, n_pawmix |
3218 |
++ integer, dimension(:), pointer :: i_rhor, i_vtrial, i_vresid, i_vrespc |
3219 |
++ real(dp), dimension(:,:,:), pointer :: f_fftgr, f_atm |
3220 |
++ real(dp), dimension(:,:), pointer :: f_paw |
3221 |
++ |
3222 |
++ ! Private |
3223 |
++ integer :: n_atom |
3224 |
++ real(dp), pointer :: xred(:,:), dtn_pc(:,:) |
3225 |
++ end type ab7_mixing_object |
3226 |
++ |
3227 |
++ public :: ab7_mixing_new |
3228 |
++ public :: ab7_mixing_deallocate |
3229 |
++ |
3230 |
++ public :: ab7_mixing_use_disk_cache |
3231 |
++ public :: ab7_mixing_use_moving_atoms |
3232 |
++ public :: ab7_mixing_copy_current_step |
3233 |
++ |
3234 |
++ public :: ab7_mixing_eval_allocate |
3235 |
++ public :: ab7_mixing_eval |
3236 |
++ public :: ab7_mixing_eval_deallocate |
3237 |
++ |
3238 |
++ contains |
3239 |
++ |
3240 |
++ subroutine init_(mix) |
3241 |
++ implicit none |
3242 |
++ |
3243 |
++ type(ab7_mixing_object), intent(out) :: mix |
3244 |
++ |
3245 |
++ ! Default values. |
3246 |
++ mix%iscf = AB7_MIXING_NONE |
3247 |
++ mix%mffmem = 1 |
3248 |
++ mix%n_index = 0 |
3249 |
++ mix%n_fftgr = 0 |
3250 |
++ mix%n_pulayit = 7 |
3251 |
++ mix%n_pawmix = 0 |
3252 |
++ mix%n_atom = 0 |
3253 |
++ mix%useprec = .true. |
3254 |
++ |
3255 |
++ call nullify_(mix) |
3256 |
++ end subroutine init_ |
3257 |
++ |
3258 |
++ subroutine nullify_(mix) |
3259 |
++ |
3260 |
++ |
3261 |
++ implicit none |
3262 |
++ |
3263 |
++ type(ab7_mixing_object), intent(inout) :: mix |
3264 |
++ |
3265 |
++ ! Nullify internal pointers. |
3266 |
++ nullify(mix%i_rhor) |
3267 |
++ nullify(mix%i_vtrial) |
3268 |
++ nullify(mix%i_vresid) |
3269 |
++ nullify(mix%i_vrespc) |
3270 |
++ nullify(mix%f_fftgr) |
3271 |
++ nullify(mix%f_atm) |
3272 |
++ nullify(mix%f_paw) |
3273 |
++ nullify(mix%dtn_pc) |
3274 |
++ nullify(mix%xred) |
3275 |
++ end subroutine nullify_ |
3276 |
++ |
3277 |
++ subroutine ab7_mixing_new(mix, iscf, kind, space, nfft, nspden, & |
3278 |
++ & npawmix, errid, errmess, npulayit, useprec) |
3279 |
++ implicit none |
3280 |
++ |
3281 |
++ type(ab7_mixing_object), intent(out) :: mix |
3282 |
++ integer, intent(in) :: iscf, kind, space, nfft, nspden, npawmix |
3283 |
++ integer, intent(out) :: errid |
3284 |
++ character(len = 500), intent(out) :: errmess |
3285 |
++ integer, intent(in), optional :: npulayit |
3286 |
++ logical, intent(in), optional :: useprec |
3287 |
++ |
3288 |
++ integer :: ii, i_stat |
3289 |
++ character(len = *), parameter :: subname = "ab7_mixing_new" |
3290 |
++ |
3291 |
++ ! Set default values. |
3292 |
++ call init_(mix) |
3293 |
++ |
3294 |
++ ! Argument checkings. |
3295 |
++ if (kind /= AB7_MIXING_POTENTIAL .and. kind /= AB7_MIXING_DENSITY) then |
3296 |
++ errid = AB7_ERROR_MIXING_ARG |
3297 |
++ write(errmess, '(a,a,a,a)' )ch10,& |
3298 |
++ & ' ab7_mixing_set_arrays: ERROR -',ch10,& |
3299 |
++ & ' Mixing must be done on density or potential only.' |
3300 |
++ return |
3301 |
++ end if |
3302 |
++ if (space /= AB7_MIXING_REAL_SPACE .and. & |
3303 |
++ & space /= AB7_MIXING_FOURRIER_SPACE) then |
3304 |
++ errid = AB7_ERROR_MIXING_ARG |
3305 |
++ write(errmess, '(a,a,a,a)' )ch10,& |
3306 |
++ & ' ab7_mixing_set_arrays: ERROR -',ch10,& |
3307 |
++ & ' Mixing must be done in real or Fourrier space only.' |
3308 |
++ return |
3309 |
++ end if |
3310 |
++ if (iscf /= AB7_MIXING_EIG .and. iscf /= AB7_MIXING_SIMPLE .and. & |
3311 |
++ & iscf /= AB7_MIXING_ANDERSON .and. & |
3312 |
++ & iscf /= AB7_MIXING_ANDERSON_2 .and. & |
3313 |
++ & iscf /= AB7_MIXING_CG_ENERGY .and. & |
3314 |
++ & iscf /= AB7_MIXING_PULAY .and. & |
3315 |
++ & iscf /= AB7_MIXING_CG_ENERGY_2) then |
3316 |
++ errid = AB7_ERROR_MIXING_ARG |
3317 |
++ write(errmess, "(A,I0,A)") "Unknown mixing scheme (", iscf, ")." |
3318 |
++ return |
3319 |
++ end if |
3320 |
++ errid = AB7_NO_ERROR |
3321 |
++ |
3322 |
++ ! Mandatory arguments. |
3323 |
++ mix%iscf = iscf |
3324 |
++ mix%kind = kind |
3325 |
++ mix%space = space |
3326 |
++ mix%nfft = nfft |
3327 |
++ mix%nspden = nspden |
3328 |
++ mix%n_pawmix = npawmix |
3329 |
++ |
3330 |
++ ! Optional arguments. |
3331 |
++ if (present(useprec)) mix%useprec = useprec |
3332 |
++ |
3333 |
++ ! Set-up internal dimensions. |
3334 |
++ !These arrays are needed only in the self-consistent case |
3335 |
++ if (iscf == AB7_MIXING_EIG) then |
3336 |
++ ! For iscf==1, five additional vectors are needed |
3337 |
++ ! The index 1 is attributed to the old trial potential, |
3338 |
++ ! The new residual potential, and the new |
3339 |
++ ! preconditioned residual potential receive now a temporary index |
3340 |
++ ! The indices number 4 and 5 are attributed to work vectors. |
3341 |
++ mix%n_fftgr=5 ; mix%n_index=1 |
3342 |
++ else if(iscf == AB7_MIXING_SIMPLE) then |
3343 |
++ ! For iscf==2, three additional vectors are needed. |
3344 |
++ ! The index number 1 is attributed to the old trial vector |
3345 |
++ ! The new residual potential, and the new preconditioned |
3346 |
++ ! residual potential, receive now a temporary index. |
3347 |
++ mix%n_fftgr=3 ; mix%n_index=1 |
3348 |
++ if (.not. mix%useprec) mix%n_fftgr = 2 |
3349 |
++ else if(iscf == AB7_MIXING_ANDERSON) then |
3350 |
++ ! For iscf==3 , four additional vectors are needed. |
3351 |
++ ! The index number 1 is attributed to the old trial vector |
3352 |
++ ! The new residual potential, and the new and old preconditioned |
3353 |
++ ! residual potential, receive now a temporary index. |
3354 |
++ mix%n_fftgr=4 ; mix%n_index=2 |
3355 |
++ if (.not. mix%useprec) mix%n_fftgr = 3 |
3356 |
++ else if (iscf == AB7_MIXING_ANDERSON_2) then |
3357 |
++ ! For iscf==4 , six additional vectors are needed. |
3358 |
++ ! The indices number 1 and 2 are attributed to two old trial vectors |
3359 |
++ ! The new residual potential, and the new and two old preconditioned |
3360 |
++ ! residual potentials, receive now a temporary index. |
3361 |
++ mix%n_fftgr=6 ; mix%n_index=3 |
3362 |
++ if (.not. mix%useprec) mix%n_fftgr = 5 |
3363 |
++ else if(iscf == AB7_MIXING_CG_ENERGY .or. iscf == AB7_MIXING_CG_ENERGY_2) then |
3364 |
++ ! For iscf==5 or 6, ten additional vectors are needed |
3365 |
++ ! The index number 1 is attributed to the old trial vector |
3366 |
++ ! The index number 6 is attributed to the search vector |
3367 |
++ ! Other indices are attributed now. Altogether ten vectors |
3368 |
++ mix%n_fftgr=10 ; mix%n_index=3 |
3369 |
++ else if(iscf == AB7_MIXING_PULAY) then |
3370 |
++ ! For iscf==7, lot of additional vectors are needed |
3371 |
++ ! The index number 1 is attributed to the old trial vector |
3372 |
++ ! The index number 2 is attributed to the old residual |
3373 |
++ ! The indices number 2 and 3 are attributed to two old precond. residuals |
3374 |
++ ! Other indices are attributed now. |
3375 |
++ if (present(npulayit)) mix%n_pulayit = npulayit |
3376 |
++ mix%n_fftgr=2+2*mix%n_pulayit ; mix%n_index=1+mix%n_pulayit |
3377 |
++ if (.not. mix%useprec) mix%n_fftgr = 1+2*mix%n_pulayit |
3378 |
++ end if ! iscf cases |
3379 |
++ |
3380 |
++ ! Allocate new arrays. |
3381 |
++ allocate(mix%i_rhor(mix%n_index), stat = i_stat) |
3382 |
++ call memocc(i_stat, mix%i_rhor, 'mix%i_rhor', subname) |
3383 |
++ allocate(mix%i_vtrial(mix%n_index), stat = i_stat) |
3384 |
++ call memocc(i_stat, mix%i_vtrial, 'mix%i_vtrial', subname) |
3385 |
++ allocate(mix%i_vresid(mix%n_index), stat = i_stat) |
3386 |
++ call memocc(i_stat, mix%i_vresid, 'mix%i_vresid', subname) |
3387 |
++ allocate(mix%i_vrespc(mix%n_index), stat = i_stat) |
3388 |
++ call memocc(i_stat, mix%i_vrespc, 'mix%i_vrespc', subname) |
3389 |
++ |
3390 |
++ ! Setup initial values. |
3391 |
++ if (iscf == AB7_MIXING_EIG) then |
3392 |
++ mix%i_vtrial(1)=1 ; mix%i_vresid(1)=2 ; mix%i_vrespc(1)=3 |
3393 |
++ else if(iscf == AB7_MIXING_SIMPLE) then |
3394 |
++ mix%i_vtrial(1)=1 ; mix%i_vresid(1)=2 ; mix%i_vrespc(1)=3 |
3395 |
++ if (.not. mix%useprec) mix%i_vrespc(1)=2 |
3396 |
++ else if(iscf == AB7_MIXING_ANDERSON) then |
3397 |
++ mix%i_vtrial(1)=1 ; mix%i_vresid(1)=2 |
3398 |
++ if (mix%useprec) then |
3399 |
++ mix%i_vrespc(1)=3 ; mix%i_vrespc(2)=4 |
3400 |
++ else |
3401 |
++ mix%i_vrespc(1)=2 ; mix%i_vrespc(2)=3 |
3402 |
++ end if |
3403 |
++ else if (iscf == AB7_MIXING_ANDERSON_2) then |
3404 |
++ mix%i_vtrial(1)=1 ; mix%i_vtrial(2)=2 |
3405 |
++ mix%i_vresid(1)=3 |
3406 |
++ if (mix%useprec) then |
3407 |
++ mix%i_vrespc(1)=4 ; mix%i_vrespc(2)=5 ; mix%i_vrespc(3)=6 |
3408 |
++ else |
3409 |
++ mix%i_vrespc(1)=3 ; mix%i_vrespc(2)=4 ; mix%i_vrespc(3)=5 |
3410 |
++ end if |
3411 |
++ else if(iscf == AB7_MIXING_CG_ENERGY .or. & |
3412 |
++ & iscf == AB7_MIXING_CG_ENERGY_2) then |
3413 |
++ mix%n_fftgr=10 ; mix%n_index=3 |
3414 |
++ mix%i_vtrial(1)=1 |
3415 |
++ mix%i_vresid(1)=2 ; mix%i_vresid(2)=4 ; mix%i_vresid(3)=7 |
3416 |
++ mix%i_vrespc(1)=3 ; mix%i_vrespc(2)=5 ; mix%i_vrespc(3)=8 |
3417 |
++ mix%i_rhor(2)=9 ; mix%i_rhor(3)=10 |
3418 |
++ else if(iscf == AB7_MIXING_PULAY) then |
3419 |
++ do ii=1,mix%n_pulayit |
3420 |
++ mix%i_vtrial(ii)=2*ii-1 ; mix%i_vrespc(ii)=2*ii |
3421 |
++ end do |
3422 |
++ mix%i_vrespc(mix%n_pulayit+1)=2*mix%n_pulayit+1 |
3423 |
++ mix%i_vresid(1)=2*mix%n_pulayit+2 |
3424 |
++ if (.not. mix%useprec) mix%i_vresid(1)=2 |
3425 |
++ end if ! iscf cases |
3426 |
++ end subroutine ab7_mixing_new |
3427 |
++ |
3428 |
++ subroutine ab7_mixing_use_disk_cache(mix, fnametmp_fft) |
3429 |
++ |
3430 |
++ |
3431 |
++ implicit none |
3432 |
++ |
3433 |
++ |
3434 |
++ type(ab7_mixing_object), intent(inout) :: mix |
3435 |
++ character(len = *), intent(in) :: fnametmp_fft |
3436 |
++ |
3437 |
++ if (len(trim(fnametmp_fft)) > 0) then |
3438 |
++ mix%mffmem = 0 |
3439 |
++ write(mix%diskCache, "(A)") fnametmp_fft |
3440 |
++ else |
3441 |
++ mix%mffmem = 1 |
3442 |
++ end if |
3443 |
++ end subroutine ab7_mixing_use_disk_cache |
3444 |
++ |
3445 |
++ subroutine ab7_mixing_use_moving_atoms(mix, natom, xred, dtn_pc) |
3446 |
++ |
3447 |
++ |
3448 |
++ type(ab7_mixing_object), intent(inout) :: mix |
3449 |
++ integer, intent(in) :: natom |
3450 |
++ real(dp), intent(in), target :: dtn_pc(3, natom) |
3451 |
++ real(dp), intent(in), target :: xred(3, natom) |
3452 |
++ |
3453 |
++ mix%n_atom = natom |
3454 |
++ mix%dtn_pc => dtn_pc |
3455 |
++ mix%xred => xred |
3456 |
++ end subroutine ab7_mixing_use_moving_atoms |
3457 |
++ |
3458 |
++ subroutine ab7_mixing_copy_current_step(mix, arr_resid, errid, errmess, & |
3459 |
++ & arr_respc, arr_paw_resid, arr_paw_respc, arr_atm) |
3460 |
++ |
3461 |
++ |
3462 |
++ type(ab7_mixing_object), intent(inout) :: mix |
3463 |
++ real(dp), intent(in) :: arr_resid(mix%space * mix%nfft, mix%nspden) |
3464 |
++ integer, intent(out) :: errid |
3465 |
++ character(len = 500), intent(out) :: errmess |
3466 |
++ real(dp), intent(in), optional :: arr_respc(mix%space * mix%nfft, mix%nspden) |
3467 |
++ real(dp), intent(in), optional :: arr_paw_resid(mix%n_pawmix), & |
3468 |
++ & arr_paw_respc(mix%n_pawmix) |
3469 |
++ real(dp), intent(in), optional :: arr_atm(3, mix%n_atom) |
3470 |
++ |
3471 |
++ if (.not. associated(mix%f_fftgr)) then |
3472 |
++ errid = AB7_ERROR_MIXING_ARG |
3473 |
++ write(errmess, '(a,a,a,a)' )ch10,& |
3474 |
++ & ' ab7_mixing_set_arr_current_step: ERROR -',ch10,& |
3475 |
++ & ' Working arrays not yet allocated.' |
3476 |
++ return |
3477 |
++ end if |
3478 |
++ errid = AB7_NO_ERROR |
3479 |
++ |
3480 |
++ mix%f_fftgr(:,:,mix%i_vresid(1)) = arr_resid(:,:) |
3481 |
++ if (present(arr_respc)) mix%f_fftgr(:,:,mix%i_vrespc(1)) = arr_respc(:,:) |
3482 |
++ if (present(arr_paw_resid)) mix%f_paw(:, mix%i_vresid(1)) = arr_paw_resid(:) |
3483 |
++ if (present(arr_paw_respc)) mix%f_paw(:, mix%i_vrespc(1)) = arr_paw_respc(:) |
3484 |
++ if (present(arr_atm)) mix%f_atm(:,:, mix%i_vresid(1)) = arr_atm(:,:) |
3485 |
++ end subroutine ab7_mixing_copy_current_step |
3486 |
++ |
3487 |
++ subroutine ab7_mixing_eval_allocate(mix, istep) |
3488 |
++ |
3489 |
++ |
3490 |
++!This section has been created automatically by the script Abilint (TD). |
3491 |
++!Do not modify the following lines by hand. |
3492 |
++ use interfaces_18_timing |
3493 |
++!End of the abilint section |
3494 |
++ |
3495 |
++ implicit none |
3496 |
++ |
3497 |
++ type(ab7_mixing_object), intent(inout) :: mix |
3498 |
++ integer, intent(in), optional :: istep |
3499 |
++ |
3500 |
++ integer :: istep_, i_stat, usepaw |
3501 |
++ real(dp) :: tsec(2) |
3502 |
++ character(len = *), parameter :: subname = "ab7_mixing_eval_allocate" |
3503 |
++ |
3504 |
++ istep_ = 1 |
3505 |
++ if (present(istep)) istep_ = istep |
3506 |
++ |
3507 |
++ ! Allocate work array. |
3508 |
++ if (.not. associated(mix%f_fftgr)) then |
3509 |
++ allocate(mix%f_fftgr(mix%space * mix%nfft,mix%nspden,mix%n_fftgr), stat = i_stat) |
3510 |
++ call memocc(i_stat, mix%f_fftgr, 'mix%f_fftgr', subname) |
3511 |
++ mix%f_fftgr(:,:,:)=zero |
3512 |
++ if (mix%mffmem == 0 .and. istep_ > 1) then |
3513 |
++ call timab(83,1,tsec) |
3514 |
++ open(unit=tmp_unit,file=mix%diskCache,form='unformatted',status='old') |
3515 |
++ rewind(tmp_unit) |
3516 |
++ read(tmp_unit) mix%f_fftgr |
3517 |
++ if (mix%n_pawmix == 0) close(unit=tmp_unit) |
3518 |
++ call timab(83,2,tsec) |
3519 |
++ end if |
3520 |
++ end if |
3521 |
++ ! Allocate PAW work array. |
3522 |
++ if (.not. associated(mix%f_paw)) then |
3523 |
++ usepaw = 0 |
3524 |
++ if (mix%n_pawmix > 0) usepaw = 1 |
3525 |
++ allocate(mix%f_paw(max(1,mix%n_pawmix),max(1,mix%n_fftgr * usepaw)), & |
3526 |
++ & stat = i_stat) |
3527 |
++ call memocc(i_stat, mix%f_paw, 'mix%f_paw', subname) |
3528 |
++ if (mix%n_pawmix > 0) then |
3529 |
++ mix%f_paw(:,:)=zero |
3530 |
++ if (mix%mffmem == 0 .and. istep_ > 1) then |
3531 |
++ read(tmp_unit) mix%f_paw |
3532 |
++ close(unit=tmp_unit) |
3533 |
++ call timab(83,2,tsec) |
3534 |
++ end if |
3535 |
++ end if |
3536 |
++ end if |
3537 |
++ ! Allocate atom work array. |
3538 |
++ if (.not. associated(mix%f_atm)) then |
3539 |
++ allocate(mix%f_atm(3,mix%n_atom,mix%n_fftgr), stat = i_stat) |
3540 |
++ call memocc(i_stat, mix%f_atm, 'mix%f_atm', subname) |
3541 |
++ end if |
3542 |
++ end subroutine ab7_mixing_eval_allocate |
3543 |
++ |
3544 |
++ subroutine ab7_mixing_eval_deallocate(mix) |
3545 |
++ |
3546 |
++ |
3547 |
++!This section has been created automatically by the script Abilint (TD). |
3548 |
++!Do not modify the following lines by hand. |
3549 |
++ use interfaces_18_timing |
3550 |
++!End of the abilint section |
3551 |
++ |
3552 |
++ implicit none |
3553 |
++ |
3554 |
++ type(ab7_mixing_object), intent(inout) :: mix |
3555 |
++ |
3556 |
++ integer :: i_all, i_stat |
3557 |
++ real(dp) :: tsec(2) |
3558 |
++ character(len = *), parameter :: subname = "ab7_mixing_eval_deallocate" |
3559 |
++ |
3560 |
++ ! Save on disk and deallocate work array in case on disk cache only. |
3561 |
++ if (mix%mffmem == 0) then |
3562 |
++ call timab(83,1,tsec) |
3563 |
++ open(unit=tmp_unit,file=mix%diskCache,form='unformatted',status='unknown') |
3564 |
++ rewind(tmp_unit) |
3565 |
++ ! VALGRIND complains not all of f_fftgr_disk is initialized |
3566 |
++ write(tmp_unit) mix%f_fftgr |
3567 |
++ if (mix%n_pawmix > 0) then |
3568 |
++ write(tmp_unit) mix%f_paw |
3569 |
++ end if |
3570 |
++ close(unit=tmp_unit) |
3571 |
++ call timab(83,2,tsec) |
3572 |
++ i_all = -product(shape(mix%f_fftgr))*kind(mix%f_fftgr) |
3573 |
++ deallocate(mix%f_fftgr, stat = i_stat) |
3574 |
++ call memocc(i_stat, i_all, 'mix%f_atm', subname) |
3575 |
++ nullify(mix%f_fftgr) |
3576 |
++ if (associated(mix%f_paw)) then |
3577 |
++ i_all = -product(shape(mix%f_paw))*kind(mix%f_paw) |
3578 |
++ deallocate(mix%f_paw, stat = i_stat) |
3579 |
++ call memocc(i_stat, i_all, 'mix%f_paw', subname) |
3580 |
++ nullify(mix%f_paw) |
3581 |
++ end if |
3582 |
++ end if |
3583 |
++ end subroutine ab7_mixing_eval_deallocate |
3584 |
++ |
3585 |
++ subroutine ab7_mixing_eval(mix, arr, istep, nfftot, ucvol, & |
3586 |
++ & mpi_comm, mpi_summarize, errid, errmess, & |
3587 |
++ & reset, isecur, pawarr, pawopt, response, etotal, potden, & |
3588 |
++ & resnrm, fnrm, fdot, user_data) |
3589 |
++ |
3590 |
++ |
3591 |
++!This section has been created automatically by the script Abilint (TD). |
3592 |
++!Do not modify the following lines by hand. |
3593 |
++ use interfaces_56_mixing |
3594 |
++!End of the abilint section |
3595 |
++ |
3596 |
++ implicit none |
3597 |
++ |
3598 |
++ type(ab7_mixing_object), intent(inout) :: mix |
3599 |
++ integer, intent(in) :: istep, nfftot, mpi_comm |
3600 |
++ logical, intent(in) :: mpi_summarize |
3601 |
++ real(dp), intent(in) :: ucvol |
3602 |
++ real(dp), intent(inout) :: arr(mix%space * mix%nfft,mix%nspden) |
3603 |
++ integer, intent(out) :: errid |
3604 |
++ character(len = 500), intent(out) :: errmess |
3605 |
++ |
3606 |
++ logical, intent(in), optional :: reset |
3607 |
++ integer, intent(in), optional :: isecur, pawopt, response |
3608 |
++ real(dp), intent(inout), optional, target :: pawarr(mix%n_pawmix) |
3609 |
++ real(dp), intent(in), optional :: etotal |
3610 |
++ real(dp), intent(in), optional :: potden(mix%space * mix%nfft,mix%nspden) |
3611 |
++ real(dp), intent(out), optional :: resnrm |
3612 |
++ optional :: fnrm, fdot |
3613 |
++ integer, intent(in), optional :: user_data(:) |
3614 |
++ |
3615 |
++ interface |
3616 |
++ function fdot(x,y,cplex,nfft,nspden,opt_denpot,user_data) |
3617 |
++ integer, intent(in) :: cplex,nfft,nspden,opt_denpot |
3618 |
++ double precision, intent(in) :: x(*), y(*) |
3619 |
++ integer, intent(in) :: user_data(:) |
3620 |
++ |
3621 |
++ double precision :: fdot |
3622 |
++ end function fdot |
3623 |
++ |
3624 |
++ function fnrm(x,cplex,nfft,nspden,opt_denpot,user_data) |
3625 |
++ integer, intent(in) :: cplex,nfft,nspden,opt_denpot |
3626 |
++ double precision, intent(in) :: x(*) |
3627 |
++ integer, intent(in) :: user_data(:) |
3628 |
++ |
3629 |
++ double precision :: fnrm |
3630 |
++ end function fnrm |
3631 |
++ end interface |
3632 |
++ |
3633 |
++ character(len = *), parameter :: subname = "ab7_mixing_eval" |
3634 |
++ integer :: moveAtm, dbl_nnsclo, initialized, isecur_ |
3635 |
++ integer :: usepaw, pawoptmix_, response_, i_stat, i_all |
3636 |
++ integer :: user_data_(2) |
3637 |
++ real(dp) :: resnrm_ |
3638 |
++ real(dp), pointer :: pawarr_(:) |
3639 |
++ |
3640 |
++ ! Argument checkings. |
3641 |
++ if (mix%iscf == AB7_MIXING_NONE) then |
3642 |
++ errid = AB7_ERROR_MIXING_ARG |
3643 |
++ write(errmess, '(a,a,a,a)' )ch10,& |
3644 |
++ & ' ab7_mixing_eval: ERROR -',ch10,& |
3645 |
++ & ' No method has been chosen.' |
3646 |
++ return |
3647 |
++ end if |
3648 |
++ if (mix%n_pawmix > 0 .and. .not. present(pawarr)) then |
3649 |
++ errid = AB7_ERROR_MIXING_ARG |
3650 |
++ write(errmess, '(a,a,a,a)' )ch10,& |
3651 |
++ & ' ab7_mixing_eval: ERROR -',ch10,& |
3652 |
++ & ' PAW is used, but no pawarr argument provided.' |
3653 |
++ return |
3654 |
++ end if |
3655 |
++ if (mix%n_atom > 0 .and. (.not. associated(mix%dtn_pc) .or. & |
3656 |
++ & .not. associated(mix%xred))) then |
3657 |
++ errid = AB7_ERROR_MIXING_ARG |
3658 |
++ write(errmess, '(a,a,a,a)' )ch10,& |
3659 |
++ & ' ab7_mixing_eval: ERROR -',ch10,& |
3660 |
++ & ' Moving atoms is used, but no xred or dtn_pc attributes provided.' |
3661 |
++ return |
3662 |
++ end if |
3663 |
++ if ((present(fnrm) .or. present(fdot) .or. present(user_data)) .and. & |
3664 |
++ & .not. (present(fnrm) .and. present(fdot) .and. present(user_data))) then |
3665 |
++ errid = AB7_ERROR_MIXING_ARG |
3666 |
++ write(errmess, '(a,a,a,a)' )ch10,& |
3667 |
++ & ' ab7_mixing_eval: ERROR -',ch10,& |
3668 |
++ & ' Passing optional norm and dot product routines without user_data argument.' |
3669 |
++ return |
3670 |
++ end if |
3671 |
++ errid = AB7_NO_ERROR |
3672 |
++ |
3673 |
++ ! Miscellaneous |
3674 |
++ moveAtm = 0 |
3675 |
++ if (mix%n_atom > 0) moveAtm = 1 |
3676 |
++ initialized = 1 |
3677 |
++ if (present(reset)) then |
3678 |
++ if (reset) initialized = 0 |
3679 |
++ end if |
3680 |
++ isecur_ = 0 |
3681 |
++ if (present(isecur)) isecur_ = isecur |
3682 |
++ usepaw = 0 |
3683 |
++ if (mix%n_pawmix > 0) usepaw = 1 |
3684 |
++ pawoptmix_ = 0 |
3685 |
++ if (present(pawopt)) pawoptmix_ = pawopt |
3686 |
++ response_ = 0 |
3687 |
++ if (present(response)) response_ = response |
3688 |
++ if (present(pawarr)) then |
3689 |
++ pawarr_ => pawarr |
3690 |
++ else |
3691 |
++ allocate(pawarr_(1), stat = i_stat) |
3692 |
++ call memocc(i_stat, pawarr_, 'pawarr_', subname) |
3693 |
++ end if |
3694 |
++ |
3695 |
++ ! Norm and dot products. |
3696 |
++ if (.not. present(user_data)) then |
3697 |
++ user_data_(1) = 0 |
3698 |
++ if (mpi_summarize) user_data_(1) = 1 |
3699 |
++ user_data_(2) = mpi_comm |
3700 |
++ end if |
3701 |
++ |
3702 |
++ ! Do the mixing. |
3703 |
++ resnrm_ = 0.d0 |
3704 |
++ if (mix%iscf == AB7_MIXING_EIG) then |
3705 |
++ ! This routine compute the eigenvalues of the SCF operator |
3706 |
++ call scfeig(istep, mix%space * mix%nfft, mix%nspden, & |
3707 |
++ & mix%f_fftgr(:,:,mix%i_vrespc(1)), arr, & |
3708 |
++ & mix%f_fftgr(:,:,1), mix%f_fftgr(:,:,4:5), errid, errmess) |
3709 |
++ else if (mix%iscf == AB7_MIXING_SIMPLE .or. & |
3710 |
++ & mix%iscf == AB7_MIXING_ANDERSON .or. & |
3711 |
++ & mix%iscf == AB7_MIXING_ANDERSON_2 .or. & |
3712 |
++ & mix%iscf == AB7_MIXING_PULAY) then |
3713 |
++ if (present(user_data)) then |
3714 |
++ call scfopt(mix%space, mix%f_fftgr,mix%f_paw,mix%iscf,istep,& |
3715 |
++ & mix%i_vrespc,mix%i_vtrial, mix%nfft,mix%n_pawmix,mix%nspden, & |
3716 |
++ & mix%n_fftgr,mix%n_index,mix%kind,pawoptmix_,usepaw,pawarr_, & |
3717 |
++ & resnrm_, arr, fnrm, fdot, user_data, errid, errmess) |
3718 |
++ else |
3719 |
++ call scfopt(mix%space, mix%f_fftgr,mix%f_paw,mix%iscf,istep,& |
3720 |
++ & mix%i_vrespc,mix%i_vtrial, mix%nfft,mix%n_pawmix,mix%nspden, & |
3721 |
++ & mix%n_fftgr,mix%n_index,mix%kind,pawoptmix_,usepaw,pawarr_, & |
3722 |
++ & resnrm_, arr, fnrm_default, fdot_default, user_data_, errid, errmess) |
3723 |
++ end if |
3724 |
++ ! Change atomic positions |
3725 |
++ if((istep==1 .or. mix%iscf==AB7_MIXING_SIMPLE) .and. mix%n_atom > 0)then |
3726 |
++ ! GAF: 2009-06-03 |
3727 |
++ ! Apparently there are not reason |
3728 |
++ ! to restrict iscf=2 for ionmov=5 |
3729 |
++ mix%xred(:,:) = mix%xred(:,:) + mix%dtn_pc(:,:) |
3730 |
++ end if |
3731 |
++ else if (mix%iscf == AB7_MIXING_CG_ENERGY .or. & |
3732 |
++ & mix%iscf == AB7_MIXING_CG_ENERGY_2) then |
3733 |
++ ! Optimize next vtrial using an algorithm based |
3734 |
++ ! on the conjugate gradient minimization of etotal |
3735 |
++ if (.not. present(etotal) .or. .not. present(potden)) then |
3736 |
++ errid = AB7_ERROR_MIXING_ARG |
3737 |
++ write(errmess, '(a,a,a,a)' )ch10,& |
3738 |
++ & ' ab7_mixing_eval: ERROR -',ch10,& |
3739 |
++ & ' Arguments etotal or potden are missing for CG on energy methods.' |
3740 |
++ return |
3741 |
++ end if |
3742 |
++ if (mix%n_atom == 0) then |
3743 |
++ allocate(mix%xred(3,0), stat = i_stat) |
3744 |
++ call memocc(i_stat, mix%xred, 'mix%xred', subname) |
3745 |
++ allocate(mix%dtn_pc(3,0), stat = i_stat) |
3746 |
++ call memocc(i_stat, mix%dtn_pc, 'mix%dtn_pc', subname) |
3747 |
++ end if |
3748 |
++ if (present(user_data)) then |
3749 |
++ call scfcge(mix%space,dbl_nnsclo,mix%dtn_pc,etotal,mix%f_atm,& |
3750 |
++ & mix%f_fftgr,initialized,mix%iscf,isecur_,istep,& |
3751 |
++ & mix%i_rhor,mix%i_vresid,mix%i_vrespc,moveAtm,& |
3752 |
++ & mix%n_atom,mix%nfft,nfftot,& |
3753 |
++ & mix%nspden,mix%n_fftgr,mix%n_index,mix%kind,& |
3754 |
++ & response_,potden,ucvol,arr,mix%xred, & |
3755 |
++ & fnrm, fdot, user_data, errid, errmess) |
3756 |
++ else |
3757 |
++ call scfcge(mix%space,dbl_nnsclo,mix%dtn_pc,etotal,mix%f_atm,& |
3758 |
++ & mix%f_fftgr,initialized,mix%iscf,isecur_,istep,& |
3759 |
++ & mix%i_rhor,mix%i_vresid,mix%i_vrespc,moveAtm,& |
3760 |
++ & mix%n_atom,mix%nfft,nfftot,& |
3761 |
++ & mix%nspden,mix%n_fftgr,mix%n_index,mix%kind,& |
3762 |
++ & response_,potden,ucvol,arr,mix%xred, fnrm_default, & |
3763 |
++ & fdotn_default, user_data_, errid, errmess) |
3764 |
++ end if |
3765 |
++ if (mix%n_atom == 0) then |
3766 |
++ i_all = -product(shape(mix%xred))*kind(mix%xred) |
3767 |
++ deallocate(mix%xred, stat = i_stat) |
3768 |
++ call memocc(i_stat, i_all, 'mix%xred', subname) |
3769 |
++ i_all = -product(shape(mix%dtn_pc))*kind(mix%dtn_pc) |
3770 |
++ deallocate(mix%dtn_pc, stat = i_stat) |
3771 |
++ call memocc(i_stat, i_all, 'mix%dtn_pc', subname) |
3772 |
++ end if |
3773 |
++ if (dbl_nnsclo == 1) errid = AB7_ERROR_MIXING_INC_NNSLOOP |
3774 |
++ end if |
3775 |
++ |
3776 |
++ if (present(resnrm)) resnrm = resnrm_ |
3777 |
++ if (.not. present(pawarr)) then |
3778 |
++ i_all = -product(shape(pawarr_))*kind(pawarr_) |
3779 |
++ deallocate(pawarr_, stat = i_stat) |
3780 |
++ call memocc(i_stat, i_all, 'pawarr_', subname) |
3781 |
++ end if |
3782 |
++ end subroutine ab7_mixing_eval |
3783 |
++ |
3784 |
++ subroutine ab7_mixing_deallocate(mix) |
3785 |
++ implicit none |
3786 |
++ |
3787 |
++ type(ab7_mixing_object), intent(inout) :: mix |
3788 |
++ |
3789 |
++ integer :: i_all, i_stat |
3790 |
++ character(len = *), parameter :: subname = "ab7_mixing_deallocate" |
3791 |
++ |
3792 |
++ if (associated(mix%i_rhor)) then |
3793 |
++ i_all = -product(shape(mix%i_rhor))*kind(mix%i_rhor) |
3794 |
++ deallocate(mix%i_rhor, stat = i_stat) |
3795 |
++ call memocc(i_stat, i_all, 'mix%i_rhor', subname) |
3796 |
++ end if |
3797 |
++ if (associated(mix%i_vtrial)) then |
3798 |
++ i_all = -product(shape(mix%i_vtrial))*kind(mix%i_vtrial) |
3799 |
++ deallocate(mix%i_vtrial, stat = i_stat) |
3800 |
++ call memocc(i_stat, i_all, 'mix%i_vtrial', subname) |
3801 |
++ end if |
3802 |
++ if (associated(mix%i_vresid)) then |
3803 |
++ i_all = -product(shape(mix%i_vresid))*kind(mix%i_vresid) |
3804 |
++ deallocate(mix%i_vresid, stat = i_stat) |
3805 |
++ call memocc(i_stat, i_all, 'mix%i_vresid', subname) |
3806 |
++ end if |
3807 |
++ if (associated(mix%i_vrespc)) then |
3808 |
++ i_all = -product(shape(mix%i_vrespc))*kind(mix%i_vrespc) |
3809 |
++ deallocate(mix%i_vrespc, stat = i_stat) |
3810 |
++ call memocc(i_stat, i_all, 'mix%i_vrespc', subname) |
3811 |
++ end if |
3812 |
++ if (associated(mix%f_fftgr)) then |
3813 |
++ i_all = -product(shape(mix%f_fftgr))*kind(mix%f_fftgr) |
3814 |
++ deallocate(mix%f_fftgr, stat = i_stat) |
3815 |
++ call memocc(i_stat, i_all, 'mix%f_fftgr', subname) |
3816 |
++ end if |
3817 |
++ if (associated(mix%f_paw)) then |
3818 |
++ i_all = -product(shape(mix%f_paw))*kind(mix%f_paw) |
3819 |
++ deallocate(mix%f_paw, stat = i_stat) |
3820 |
++ call memocc(i_stat, i_all, 'mix%f_paw', subname) |
3821 |
++ end if |
3822 |
++ if (associated(mix%f_atm)) then |
3823 |
++ i_all = -product(shape(mix%f_atm))*kind(mix%f_atm) |
3824 |
++ deallocate(mix%f_atm, stat = i_stat) |
3825 |
++ call memocc(i_stat, i_all, 'mix%f_atm', subname) |
3826 |
++ end if |
3827 |
++ |
3828 |
++ call nullify_(mix) |
3829 |
++ end subroutine ab7_mixing_deallocate |
3830 |
++ |
3831 |
++ function fnrm_default(x,cplex,nfft,nspden,opt_denpot,user_data) |
3832 |
++ integer, intent(in) :: cplex,nfft,nspden,opt_denpot |
3833 |
++ double precision, intent(in) :: x(*) |
3834 |
++ integer, intent(in) :: user_data(:) |
3835 |
++ |
3836 |
++ double precision :: fnrm_default |
3837 |
++ real(dp) :: resid_new(1) |
3838 |
++ |
3839 |
++ call sqnormm_v(cplex,1,user_data(2),(user_data(1) /= 0),1,& |
3840 |
++ & nfft,resid_new,1,nspden,opt_denpot,x) |
3841 |
++ fnrm_default = resid_new(1) |
3842 |
++ end function fnrm_default |
3843 |
++ |
3844 |
++ function fdot_default(x,y,cplex,nfft,nspden,opt_denpot,user_data) |
3845 |
++ integer, intent(in) :: cplex,nfft,nspden,opt_denpot |
3846 |
++ double precision, intent(in) :: x(*), y(*) |
3847 |
++ integer, intent(in) :: user_data(:) |
3848 |
++ |
3849 |
++ double precision :: fdot_default |
3850 |
++ real(dp) :: prod_resid(1) |
3851 |
++ |
3852 |
++ call dotprodm_v(cplex,1,prod_resid,1,1,user_data(2),(user_data(1) /= 0),1,1,& |
3853 |
++ & nfft,1,1,nspden,opt_denpot,x,y) |
3854 |
++ fdot_default = prod_resid(1) |
3855 |
++ end function fdot_default |
3856 |
++ |
3857 |
++ function fdotn_default(x,y,cplex,nfft,nspden,opt_denpot,user_data) |
3858 |
++ integer, intent(in) :: cplex,nfft,nspden,opt_denpot |
3859 |
++ double precision, intent(in) :: x(*), y(*) |
3860 |
++ integer, intent(in) :: user_data(:) |
3861 |
++ |
3862 |
++ double precision :: fdotn_default |
3863 |
++ real(dp) :: prod_resid(1,1,1) |
3864 |
++ |
3865 |
++ call dotprodm_vn(cplex,1,x,prod_resid,1,1,user_data(2),(user_data(1) /= 0),1,1,& |
3866 |
++ & 1,nfft,1,nspden,y) |
3867 |
++ fdotn_default = prod_resid(1,1,1) |
3868 |
++ end function fdotn_default |
3869 |
++ end module m_ab7_mixing |
3870 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/scfcge.F90 bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/scfcge.F90 |
3871 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/scfcge.F90 2012-07-09 16:43:33.000000000 +0200 |
3872 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/scfcge.F90 2013-06-11 16:51:00.000000000 +0200 |
3873 |
+@@ -182,7 +182,7 @@ |
3874 |
+ !DEBUG |
3875 |
+ !write(6,*)' scfcge : enter ' |
3876 |
+ !ENDDEBUG |
3877 |
+- errid = AB6_NO_ERROR |
3878 |
++ errid = AB7_NO_ERROR |
3879 |
+ dbl_nnsclo = 0 |
3880 |
+ |
3881 |
+ !reduction gives the level of reduction of the error in |
3882 |
+@@ -318,7 +318,7 @@ |
3883 |
+ & d2edv2_new,d2edv2_old,d2edv2_predict,& |
3884 |
+ & etotal,etotal_old,etotal_predict,& |
3885 |
+ & lambda_new,lambda_old,lambda_predict,errid_,message) |
3886 |
+- if (errid_ /= AB6_NO_ERROR) then |
3887 |
++ if (errid_ /= AB7_NO_ERROR) then |
3888 |
+ call wrtout(std_out,message,'COLL') |
3889 |
+ end if |
3890 |
+ |
3891 |
+@@ -388,7 +388,7 @@ |
3892 |
+ & (abs(lambda_predict)<0.005_dp*lambda_adapt .and. iscf==6).or. & |
3893 |
+ & ilinmin==mlinmin ) )then |
3894 |
+ if(number_of_restart>12)then |
3895 |
+- errid = AB6_ERROR_MIXING_CONVERGENCE |
3896 |
++ errid = AB7_ERROR_MIXING_CONVERGENCE |
3897 |
+ write(errmess, '(a,a,a,a,a,i3,a,a,a,a,a)' ) ch10,& |
3898 |
+ & ' scfcge : ERROR -',ch10,& |
3899 |
+ & ' Potential-based CG line minimization not',& |
3900 |
+@@ -572,7 +572,7 @@ |
3901 |
+ & d2edv2_new,d2edv2_old,d2edv2_predict,& |
3902 |
+ & etotal,etotal_old,etotal_predict,& |
3903 |
+ & lambda_new,lambda_old,lambda_predict,errid_,message) |
3904 |
+- if (errid_ /= AB6_NO_ERROR) then |
3905 |
++ if (errid_ /= AB7_NO_ERROR) then |
3906 |
+ call wrtout(std_out,message,'COLL') |
3907 |
+ end if |
3908 |
+ lambda_predict2=0.0_dp |
3909 |
+@@ -836,7 +836,7 @@ |
3910 |
+ ! End of choice between initialisation or more developed |
3911 |
+ ! parts of the CG algorithm |
3912 |
+ else |
3913 |
+- errid = AB6_ERROR_MIXING_ARG |
3914 |
++ errid = AB7_ERROR_MIXING_ARG |
3915 |
+ write(errmess, '(a,a,a,a)' ) ch10,& |
3916 |
+ & ' scfcge : BUG ',ch10,& |
3917 |
+ & ' You should not be here ! ' |
3918 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/scfeig.F90 bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/scfeig.F90 |
3919 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/scfeig.F90 2012-07-09 16:43:33.000000000 +0200 |
3920 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/scfeig.F90 2013-06-11 16:51:00.000000000 +0200 |
3921 |
+@@ -71,10 +71,10 @@ |
3922 |
+ |
3923 |
+ ! ************************************************************************* |
3924 |
+ |
3925 |
+- errid = AB6_NO_ERROR |
3926 |
++ errid = AB7_NO_ERROR |
3927 |
+ |
3928 |
+ if(nspden==4)then |
3929 |
+- errid = AB6_ERROR_MIXING_ARG |
3930 |
++ errid = AB7_ERROR_MIXING_ARG |
3931 |
+ write(errmess, *) ' scfeig : does not work yet for nspden=4' |
3932 |
+ return |
3933 |
+ end if |
3934 |
+@@ -103,7 +103,7 @@ |
3935 |
+ & ' scfeig : initial PC_residual square =',resid_old |
3936 |
+ call wrtout(std_out,message,'COLL') |
3937 |
+ if(resid_old>1.0d-8)then |
3938 |
+- errid = AB6_ERROR_MIXING_ARG |
3939 |
++ errid = AB7_ERROR_MIXING_ARG |
3940 |
+ write(errmess,'(a,a,a,a,a,a,a,a,a,a)') ch10,& |
3941 |
+ & ' scfeig : ERROR -',ch10,& |
3942 |
+ & ' This value is not good enough to allow',ch10,& |
3943 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/scfopt.F90 bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/scfopt.F90 |
3944 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/scfopt.F90 2012-07-09 16:43:33.000000000 +0200 |
3945 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/scfopt.F90 2013-06-11 16:51:00.000000000 +0200 |
3946 |
+@@ -136,7 +136,7 @@ |
3947 |
+ !DEBUG |
3948 |
+ !write(6,*)' scfopt : enter ; istep,iscf ',istep,iscf |
3949 |
+ !ENDDEBUG |
3950 |
+- errid = AB6_NO_ERROR |
3951 |
++ errid = AB7_NO_ERROR |
3952 |
+ |
3953 |
+ i_vstore=i_vtrial(1) |
3954 |
+ if (iscf==4) i_vstore=i_vtrial(2) |
3955 |
+@@ -322,7 +322,7 @@ |
3956 |
+ call wrtout(std_out,message,'COLL') |
3957 |
+ |
3958 |
+ if (npulay>npulaymax) then |
3959 |
+- errid = AB6_ERROR_MIXING_CONVERGENCE |
3960 |
++ errid = AB7_ERROR_MIXING_CONVERGENCE |
3961 |
+ write(errmess, '(4a)' ) ch10,& |
3962 |
+ & ' scfopt : ERROR - ',ch10,& |
3963 |
+ & ' Too much iterations required for Pulay algorithm (<50) !' |
3964 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/56_recipspace/m_ab6_kpoints.F90 bigdft-abi-1.0.4.new/libABINIT/src/56_recipspace/m_ab6_kpoints.F90 |
3965 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/56_recipspace/m_ab6_kpoints.F90 2012-07-09 16:43:33.000000000 +0200 |
3966 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/56_recipspace/m_ab6_kpoints.F90 1970-01-01 01:00:00.000000000 +0100 |
3967 |
+@@ -1,281 +0,0 @@ |
3968 |
+-!* * Fortran90 source file * |
3969 |
+-!* |
3970 |
+-!* Copyright (C) 2008-2011 ABINIT Group (Damien Caliste) |
3971 |
+-!* All rights reserved. |
3972 |
+-!* |
3973 |
+-!* This file is part of the ABINIT software package. For license information, |
3974 |
+-!* please see the COPYING file in the top-level directory of the ABINIT source |
3975 |
+-!* distribution. |
3976 |
+-!* |
3977 |
+-!* |
3978 |
+- |
3979 |
+-#if defined HAVE_CONFIG_H |
3980 |
+-#include "config.inc" |
3981 |
+-#endif |
3982 |
+- |
3983 |
+-module m_ab6_kpoints |
3984 |
+- |
3985 |
+- use defs_basis |
3986 |
+- use m_ab6_symmetry |
3987 |
+- |
3988 |
+- implicit none |
3989 |
+- |
3990 |
+- private |
3991 |
+- |
3992 |
+- logical, private, parameter :: AB_DBG = .false. |
3993 |
+- |
3994 |
+- public :: kpoints_get_irreductible_zone |
3995 |
+- |
3996 |
+- public :: kpoints_get_mp_k_grid |
3997 |
+- public :: kpoints_get_auto_k_grid |
3998 |
+- |
3999 |
+- public :: kpoints_binding_mp_k_1 |
4000 |
+- public :: kpoints_binding_mp_k_2 |
4001 |
+- public :: kpoints_binding_auto_k_1 |
4002 |
+- public :: kpoints_binding_auto_k_2 |
4003 |
+- |
4004 |
+-contains |
4005 |
+- |
4006 |
+- subroutine kpoints_get_irreductible_zone(irrzon, phnons, & |
4007 |
+- & n1, n2, n3, nsppol, nspden, symid, errno) |
4008 |
+- |
4009 |
+- |
4010 |
+-!This section has been created automatically by the script Abilint (TD). |
4011 |
+-!Do not modify the following lines by hand. |
4012 |
+- use interfaces_56_recipspace |
4013 |
+-!End of the abilint section |
4014 |
+- |
4015 |
+- integer, intent(in) :: symid |
4016 |
+- integer, intent(in) :: n1, n2, n3, nsppol, nspden |
4017 |
+- integer, intent(out) :: irrzon(n1*n2*n3,2,(nspden/nsppol)-3*(nspden/4)) |
4018 |
+- real(dp), intent(out) :: phnons(2,n1*n2*n3,(nspden/nsppol)-3*(nspden/4)) |
4019 |
+- integer, intent(out) :: errno |
4020 |
+- |
4021 |
+- type(symmetry_type), pointer :: sym |
4022 |
+- |
4023 |
+- if (AB_DBG) write(std_err,*) "AB kpoints: call get irreductible zone." |
4024 |
+- |
4025 |
+- errno = AB6_NO_ERROR |
4026 |
+- call symmetry_get_from_id(sym, symid, errno) |
4027 |
+- if (errno /= AB6_NO_ERROR) return |
4028 |
+- |
4029 |
+- if (sym%withSpin /= nspden) then |
4030 |
+- errno = AB6_ERROR_ARG |
4031 |
+- return |
4032 |
+- end if |
4033 |
+- |
4034 |
+- call irrzg(irrzon, nspden, nsppol, sym%nSym, n1, n2, n3, phnons, & |
4035 |
+- & sym%symAfm, sym%sym, sym%transNon) |
4036 |
+- end subroutine kpoints_get_irreductible_zone |
4037 |
+- |
4038 |
+- |
4039 |
+- |
4040 |
+- subroutine kpoints_binding_mp_k_1(symid, nkpt, ngkpt, & |
4041 |
+- & kptrlatt, kptrlen, nshiftk, shiftk, errno) |
4042 |
+- |
4043 |
+- |
4044 |
+-!This section has been created automatically by the script Abilint (TD). |
4045 |
+-!Do not modify the following lines by hand. |
4046 |
+- use interfaces_56_recipspace |
4047 |
+-!End of the abilint section |
4048 |
+- |
4049 |
+- integer, intent(in) :: symid |
4050 |
+- integer, intent(out) :: errno |
4051 |
+- integer, intent(in) :: ngkpt(3) |
4052 |
+- integer, intent(inout) :: nshiftk |
4053 |
+- real(dp), intent(inout) :: shiftk(3, 8) |
4054 |
+- real(dp), intent(out) :: kptrlen |
4055 |
+- integer, intent(out) :: kptrlatt(3,3) |
4056 |
+- integer, intent(out) :: nkpt |
4057 |
+- |
4058 |
+- type(symmetry_type), pointer :: sym |
4059 |
+- real(dp) :: kpt(3,1), wkpt(1) |
4060 |
+- |
4061 |
+- if (AB_DBG) write(std_err,*) "AB symmetry: call get k grid1." |
4062 |
+- |
4063 |
+- errno = AB6_NO_ERROR |
4064 |
+- call symmetry_get_from_id(sym, symid, errno) |
4065 |
+- if (errno /= AB6_NO_ERROR) return |
4066 |
+- |
4067 |
+- ! First, compute the number of kpoints |
4068 |
+- kptrlatt(:,:) = 0 |
4069 |
+- kptrlatt(1,1) = ngkpt(1) |
4070 |
+- kptrlatt(2,2) = ngkpt(2) |
4071 |
+- kptrlatt(3,3) = ngkpt(3) |
4072 |
+- kptrlen = 20. |
4073 |
+- |
4074 |
+- call getkgrid(6, 1, kpt, 1, kptrlatt, kptrlen, & |
4075 |
+- & AB6_MAX_SYMMETRIES, 0, nkpt, nshiftk, sym%nSym, & |
4076 |
+- & sym%rprimd, shiftk, sym%symAfm, sym%sym, & |
4077 |
+- & sym%vacuum, wkpt) |
4078 |
+- end subroutine kpoints_binding_mp_k_1 |
4079 |
+- |
4080 |
+- subroutine kpoints_binding_mp_k_2(symid, nkpt, kpt, wkpt, & |
4081 |
+- & kptrlatt, kptrlen, nshiftk, shiftk, errno) |
4082 |
+- |
4083 |
+- |
4084 |
+-!This section has been created automatically by the script Abilint (TD). |
4085 |
+-!Do not modify the following lines by hand. |
4086 |
+- use interfaces_56_recipspace |
4087 |
+-!End of the abilint section |
4088 |
+- |
4089 |
+- integer, intent(in) :: symid |
4090 |
+- integer, intent(out) :: errno |
4091 |
+- integer, intent(inout) :: nshiftk |
4092 |
+- real(dp), intent(inout) :: shiftk(3, 8) |
4093 |
+- integer, intent(in) :: nkpt |
4094 |
+- real(dp), intent(out) :: kpt(3,nkpt), wkpt(nkpt) |
4095 |
+- real(dp), intent(inout) :: kptrlen |
4096 |
+- integer, intent(inout) :: kptrlatt(3,3) |
4097 |
+- |
4098 |
+- type(symmetry_type), pointer :: sym |
4099 |
+- integer :: nkpt_ |
4100 |
+- |
4101 |
+- if (AB_DBG) write(std_err,*) "AB symmetry: call get k grid2." |
4102 |
+- |
4103 |
+- errno = AB6_NO_ERROR |
4104 |
+- call symmetry_get_from_id(sym, symid, errno) |
4105 |
+- if (errno /= AB6_NO_ERROR) return |
4106 |
+- |
4107 |
+- ! Then, we call it again to get the actual values for the k points. |
4108 |
+- call getkgrid(6, 1, kpt, 1, kptrlatt, kptrlen, & |
4109 |
+- & AB6_MAX_SYMMETRIES, nkpt, nkpt_, nshiftk, sym%nSym, & |
4110 |
+- & sym%rprimd, shiftk, sym%symAfm, sym%sym, & |
4111 |
+- & sym%vacuum, wkpt) |
4112 |
+- end subroutine kpoints_binding_mp_k_2 |
4113 |
+- |
4114 |
+- |
4115 |
+- subroutine kpoints_get_mp_k_grid(symid, nkpt, kpt, wkpt, & |
4116 |
+- & ngkpt, nshiftk, shiftk, errno) |
4117 |
+- |
4118 |
+- integer, intent(in) :: symid |
4119 |
+- integer, intent(out) :: errno |
4120 |
+- integer, intent(in) :: ngkpt(3) |
4121 |
+- integer, intent(in) :: nshiftk |
4122 |
+- real(dp), intent(in) :: shiftk(3, nshiftk) |
4123 |
+- integer, intent(out) :: nkpt |
4124 |
+- real(dp), pointer :: kpt(:,:), wkpt(:) |
4125 |
+- |
4126 |
+- real(dp) :: kptrlen |
4127 |
+- integer :: kptrlatt(3,3) |
4128 |
+- integer :: nshiftk_ |
4129 |
+- real(dp) :: shiftk_(3, 8) |
4130 |
+- |
4131 |
+- if (AB_DBG) write(std_err,*) "AB symmetry: call get k grid." |
4132 |
+- |
4133 |
+- nshiftk_ = nshiftk |
4134 |
+- shiftk_(:,1:nshiftk_) = shiftk(:,:) |
4135 |
+- |
4136 |
+- call kpoints_binding_mp_k_1(symid, nkpt, ngkpt, kptrlatt, kptrlen, & |
4137 |
+- & nshiftk_, shiftk_, errno) |
4138 |
+- if (errno /= AB6_NO_ERROR) return |
4139 |
+- allocate(kpt(3, nkpt)) |
4140 |
+- allocate(wkpt(nkpt)) |
4141 |
+- call kpoints_binding_mp_k_2(symid, nkpt, kpt, wkpt, & |
4142 |
+- & kptrlatt, kptrlen, nshiftk_, shiftk_, errno) |
4143 |
+- end subroutine kpoints_get_mp_k_grid |
4144 |
+- |
4145 |
+- |
4146 |
+- |
4147 |
+- subroutine kpoints_binding_auto_k_1(symid, nkpt, kptrlatt, kptrlen, & |
4148 |
+- & nshiftk, shiftk, errno) |
4149 |
+- |
4150 |
+- |
4151 |
+-!This section has been created automatically by the script Abilint (TD). |
4152 |
+-!Do not modify the following lines by hand. |
4153 |
+- use interfaces_56_recipspace |
4154 |
+-!End of the abilint section |
4155 |
+- |
4156 |
+- integer, intent(in) :: symid |
4157 |
+- integer, intent(out) :: errno |
4158 |
+- integer, intent(out) :: nkpt |
4159 |
+- real(dp), intent(inout) :: kptrlen |
4160 |
+- integer, intent(out) :: nshiftk |
4161 |
+- real(dp), intent(out) :: shiftk(3, 8) |
4162 |
+- integer, intent(out) :: kptrlatt(3,3) |
4163 |
+- |
4164 |
+- type(symmetry_type), pointer :: sym |
4165 |
+- real(dp), allocatable :: kpt(:,:), wkpt(:) |
4166 |
+- |
4167 |
+- if (AB_DBG) write(std_err,*) "AB symmetry: call get auto k grid1." |
4168 |
+- |
4169 |
+- errno = AB6_NO_ERROR |
4170 |
+- call symmetry_get_from_id(sym, symid, errno) |
4171 |
+- if (errno /= AB6_NO_ERROR) return |
4172 |
+- |
4173 |
+- ! The parameters of the k lattice are not known, compute |
4174 |
+- ! kptrlatt, nshiftk, shiftk. |
4175 |
+- call testkgrid(sym%bravais,6,kptrlatt,kptrlen,& |
4176 |
+- & AB6_MAX_SYMMETRIES,nshiftk,sym%nSym,0,sym%rprimd,& |
4177 |
+- & shiftk,sym%symAfm,sym%sym,sym%vacuum) |
4178 |
+- if (AB_DBG) write(std_err,*) "AB symmetry: testkgrid -> kptrlatt=", kptrlatt |
4179 |
+- |
4180 |
+- call getkgrid(6, 1, kpt, 1, kptrlatt, kptrlen, & |
4181 |
+- & AB6_MAX_SYMMETRIES, 0, nkpt, nshiftk, sym%nSym, & |
4182 |
+- & sym%rprimd, shiftk, sym%symAfm, sym%sym, & |
4183 |
+- & sym%vacuum, wkpt) |
4184 |
+- if (AB_DBG) write(std_err,*) "AB symmetry: getkgrid -> nkpt=", nkpt |
4185 |
+- end subroutine kpoints_binding_auto_k_1 |
4186 |
+- |
4187 |
+- |
4188 |
+- subroutine kpoints_binding_auto_k_2(symid, nkpt, kpt, wkpt, kptrlatt, kptrlen, & |
4189 |
+- & nshiftk, shiftk, errno) |
4190 |
+- |
4191 |
+- |
4192 |
+-!This section has been created automatically by the script Abilint (TD). |
4193 |
+-!Do not modify the following lines by hand. |
4194 |
+- use interfaces_56_recipspace |
4195 |
+-!End of the abilint section |
4196 |
+- |
4197 |
+- integer, intent(in) :: symid |
4198 |
+- integer, intent(out) :: errno |
4199 |
+- integer, intent(in) :: nkpt |
4200 |
+- real(dp), intent(out) :: kpt(3,nkpt), wkpt(nkpt) |
4201 |
+- real(dp), intent(inout) :: kptrlen |
4202 |
+- integer, intent(inout) :: nshiftk |
4203 |
+- real(dp), intent(inout) :: shiftk(3, 8) |
4204 |
+- integer, intent(inout) :: kptrlatt(3,3) |
4205 |
+- |
4206 |
+- type(symmetry_type), pointer :: sym |
4207 |
+- integer :: nkpt_ |
4208 |
+- |
4209 |
+- if (AB_DBG) write(std_err,*) "AB symmetry: call get auto k grid2." |
4210 |
+- |
4211 |
+- errno = AB6_NO_ERROR |
4212 |
+- call symmetry_get_from_id(sym, symid, errno) |
4213 |
+- if (errno /= AB6_NO_ERROR) return |
4214 |
+- |
4215 |
+- ! Then, we call it again to get the actual values for the k points. |
4216 |
+- call getkgrid(6, 1, kpt, 1, kptrlatt, kptrlen, & |
4217 |
+- & AB6_MAX_SYMMETRIES, nkpt, nkpt_, nshiftk, sym%nSym, & |
4218 |
+- & sym%rprimd, shiftk, sym%symAfm, sym%sym, & |
4219 |
+- & sym%vacuum, wkpt) |
4220 |
+- end subroutine kpoints_binding_auto_k_2 |
4221 |
+- |
4222 |
+- subroutine kpoints_get_auto_k_grid(symid, nkpt, kpt, wkpt, & |
4223 |
+- & kptrlen, errno) |
4224 |
+- |
4225 |
+- integer, intent(in) :: symid |
4226 |
+- integer, intent(out) :: errno |
4227 |
+- integer, intent(out) :: nkpt |
4228 |
+- real(dp), intent(in) :: kptrlen |
4229 |
+- real(dp), pointer :: kpt(:,:), wkpt(:) |
4230 |
+- |
4231 |
+- real(dp) :: kptrlen_ |
4232 |
+- integer :: kptrlatt(3,3) |
4233 |
+- integer :: nshiftk |
4234 |
+- real(dp) :: shiftk(3, 8) |
4235 |
+- |
4236 |
+- if (AB_DBG) write(std_err,*) "AB symmetry: call get auto k grid." |
4237 |
+- |
4238 |
+- kptrlen_ = kptrlen |
4239 |
+- call kpoints_binding_auto_k_1(symid, nkpt, kptrlatt, kptrlen_, & |
4240 |
+- & nshiftk, shiftk, errno) |
4241 |
+- if (errno /= AB6_NO_ERROR) return |
4242 |
+- allocate(kpt(3, nkpt)) |
4243 |
+- allocate(wkpt(nkpt)) |
4244 |
+- call kpoints_binding_auto_k_2(symid, nkpt, kpt, wkpt, kptrlatt, kptrlen_, & |
4245 |
+- & nshiftk, shiftk, errno) |
4246 |
+- end subroutine kpoints_get_auto_k_grid |
4247 |
+- |
4248 |
+-end module m_ab6_kpoints |
4249 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/56_recipspace/m_ab7_kpoints.F90 bigdft-abi-1.0.4.new/libABINIT/src/56_recipspace/m_ab7_kpoints.F90 |
4250 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/56_recipspace/m_ab7_kpoints.F90 1970-01-01 01:00:00.000000000 +0100 |
4251 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/56_recipspace/m_ab7_kpoints.F90 2013-06-11 16:51:00.000000000 +0200 |
4252 |
+@@ -0,0 +1,281 @@ |
4253 |
++!* * Fortran90 source file * |
4254 |
++!* |
4255 |
++!* Copyright (C) 2008-2011 ABINIT Group (Damien Caliste) |
4256 |
++!* All rights reserved. |
4257 |
++!* |
4258 |
++!* This file is part of the ABINIT software package. For license information, |
4259 |
++!* please see the COPYING file in the top-level directory of the ABINIT source |
4260 |
++!* distribution. |
4261 |
++!* |
4262 |
++!* |
4263 |
++ |
4264 |
++#if defined HAVE_CONFIG_H |
4265 |
++#include "config.inc" |
4266 |
++#endif |
4267 |
++ |
4268 |
++module m_ab7_kpoints |
4269 |
++ |
4270 |
++ use defs_basis |
4271 |
++ use m_ab7_symmetry |
4272 |
++ |
4273 |
++ implicit none |
4274 |
++ |
4275 |
++ private |
4276 |
++ |
4277 |
++ logical, private, parameter :: AB_DBG = .false. |
4278 |
++ |
4279 |
++ public :: kpoints_get_irreductible_zone |
4280 |
++ |
4281 |
++ public :: kpoints_get_mp_k_grid |
4282 |
++ public :: kpoints_get_auto_k_grid |
4283 |
++ |
4284 |
++ public :: kpoints_binding_mp_k_1 |
4285 |
++ public :: kpoints_binding_mp_k_2 |
4286 |
++ public :: kpoints_binding_auto_k_1 |
4287 |
++ public :: kpoints_binding_auto_k_2 |
4288 |
++ |
4289 |
++contains |
4290 |
++ |
4291 |
++ subroutine kpoints_get_irreductible_zone(irrzon, phnons, & |
4292 |
++ & n1, n2, n3, nsppol, nspden, symid, errno) |
4293 |
++ |
4294 |
++ |
4295 |
++!This section has been created automatically by the script Abilint (TD). |
4296 |
++!Do not modify the following lines by hand. |
4297 |
++ use interfaces_56_recipspace |
4298 |
++!End of the abilint section |
4299 |
++ |
4300 |
++ integer, intent(in) :: symid |
4301 |
++ integer, intent(in) :: n1, n2, n3, nsppol, nspden |
4302 |
++ integer, intent(out) :: irrzon(n1*n2*n3,2,(nspden/nsppol)-3*(nspden/4)) |
4303 |
++ real(dp), intent(out) :: phnons(2,n1*n2*n3,(nspden/nsppol)-3*(nspden/4)) |
4304 |
++ integer, intent(out) :: errno |
4305 |
++ |
4306 |
++ type(symmetry_type), pointer :: sym |
4307 |
++ |
4308 |
++ if (AB_DBG) write(std_err,*) "AB kpoints: call get irreductible zone." |
4309 |
++ |
4310 |
++ errno = AB7_NO_ERROR |
4311 |
++ call symmetry_get_from_id(sym, symid, errno) |
4312 |
++ if (errno /= AB7_NO_ERROR) return |
4313 |
++ |
4314 |
++ if (sym%withSpin /= nspden) then |
4315 |
++ errno = AB7_ERROR_ARG |
4316 |
++ return |
4317 |
++ end if |
4318 |
++ |
4319 |
++ call irrzg(irrzon, nspden, nsppol, sym%nSym, n1, n2, n3, phnons, & |
4320 |
++ & sym%symAfm, sym%sym, sym%transNon) |
4321 |
++ end subroutine kpoints_get_irreductible_zone |
4322 |
++ |
4323 |
++ |
4324 |
++ |
4325 |
++ subroutine kpoints_binding_mp_k_1(symid, nkpt, ngkpt, & |
4326 |
++ & kptrlatt, kptrlen, nshiftk, shiftk, errno) |
4327 |
++ |
4328 |
++ |
4329 |
++!This section has been created automatically by the script Abilint (TD). |
4330 |
++!Do not modify the following lines by hand. |
4331 |
++ use interfaces_56_recipspace |
4332 |
++!End of the abilint section |
4333 |
++ |
4334 |
++ integer, intent(in) :: symid |
4335 |
++ integer, intent(out) :: errno |
4336 |
++ integer, intent(in) :: ngkpt(3) |
4337 |
++ integer, intent(inout) :: nshiftk |
4338 |
++ real(dp), intent(inout) :: shiftk(3, 8) |
4339 |
++ real(dp), intent(out) :: kptrlen |
4340 |
++ integer, intent(out) :: kptrlatt(3,3) |
4341 |
++ integer, intent(out) :: nkpt |
4342 |
++ |
4343 |
++ type(symmetry_type), pointer :: sym |
4344 |
++ real(dp) :: kpt(3,1), wkpt(1) |
4345 |
++ |
4346 |
++ if (AB_DBG) write(std_err,*) "AB symmetry: call get k grid1." |
4347 |
++ |
4348 |
++ errno = AB7_NO_ERROR |
4349 |
++ call symmetry_get_from_id(sym, symid, errno) |
4350 |
++ if (errno /= AB7_NO_ERROR) return |
4351 |
++ |
4352 |
++ ! First, compute the number of kpoints |
4353 |
++ kptrlatt(:,:) = 0 |
4354 |
++ kptrlatt(1,1) = ngkpt(1) |
4355 |
++ kptrlatt(2,2) = ngkpt(2) |
4356 |
++ kptrlatt(3,3) = ngkpt(3) |
4357 |
++ kptrlen = 20. |
4358 |
++ |
4359 |
++ call getkgrid(6, 1, kpt, 1, kptrlatt, kptrlen, & |
4360 |
++ & AB7_MAX_SYMMETRIES, 0, nkpt, nshiftk, sym%nSym, & |
4361 |
++ & sym%rprimd, shiftk, sym%symAfm, sym%sym, & |
4362 |
++ & sym%vacuum, wkpt) |
4363 |
++ end subroutine kpoints_binding_mp_k_1 |
4364 |
++ |
4365 |
++ subroutine kpoints_binding_mp_k_2(symid, nkpt, kpt, wkpt, & |
4366 |
++ & kptrlatt, kptrlen, nshiftk, shiftk, errno) |
4367 |
++ |
4368 |
++ |
4369 |
++!This section has been created automatically by the script Abilint (TD). |
4370 |
++!Do not modify the following lines by hand. |
4371 |
++ use interfaces_56_recipspace |
4372 |
++!End of the abilint section |
4373 |
++ |
4374 |
++ integer, intent(in) :: symid |
4375 |
++ integer, intent(out) :: errno |
4376 |
++ integer, intent(inout) :: nshiftk |
4377 |
++ real(dp), intent(inout) :: shiftk(3, 8) |
4378 |
++ integer, intent(in) :: nkpt |
4379 |
++ real(dp), intent(out) :: kpt(3,nkpt), wkpt(nkpt) |
4380 |
++ real(dp), intent(inout) :: kptrlen |
4381 |
++ integer, intent(inout) :: kptrlatt(3,3) |
4382 |
++ |
4383 |
++ type(symmetry_type), pointer :: sym |
4384 |
++ integer :: nkpt_ |
4385 |
++ |
4386 |
++ if (AB_DBG) write(std_err,*) "AB symmetry: call get k grid2." |
4387 |
++ |
4388 |
++ errno = AB7_NO_ERROR |
4389 |
++ call symmetry_get_from_id(sym, symid, errno) |
4390 |
++ if (errno /= AB7_NO_ERROR) return |
4391 |
++ |
4392 |
++ ! Then, we call it again to get the actual values for the k points. |
4393 |
++ call getkgrid(6, 1, kpt, 1, kptrlatt, kptrlen, & |
4394 |
++ & AB7_MAX_SYMMETRIES, nkpt, nkpt_, nshiftk, sym%nSym, & |
4395 |
++ & sym%rprimd, shiftk, sym%symAfm, sym%sym, & |
4396 |
++ & sym%vacuum, wkpt) |
4397 |
++ end subroutine kpoints_binding_mp_k_2 |
4398 |
++ |
4399 |
++ |
4400 |
++ subroutine kpoints_get_mp_k_grid(symid, nkpt, kpt, wkpt, & |
4401 |
++ & ngkpt, nshiftk, shiftk, errno) |
4402 |
++ |
4403 |
++ integer, intent(in) :: symid |
4404 |
++ integer, intent(out) :: errno |
4405 |
++ integer, intent(in) :: ngkpt(3) |
4406 |
++ integer, intent(in) :: nshiftk |
4407 |
++ real(dp), intent(in) :: shiftk(3, nshiftk) |
4408 |
++ integer, intent(out) :: nkpt |
4409 |
++ real(dp), pointer :: kpt(:,:), wkpt(:) |
4410 |
++ |
4411 |
++ real(dp) :: kptrlen |
4412 |
++ integer :: kptrlatt(3,3) |
4413 |
++ integer :: nshiftk_ |
4414 |
++ real(dp) :: shiftk_(3, 8) |
4415 |
++ |
4416 |
++ if (AB_DBG) write(std_err,*) "AB symmetry: call get k grid." |
4417 |
++ |
4418 |
++ nshiftk_ = nshiftk |
4419 |
++ shiftk_(:,1:nshiftk_) = shiftk(:,:) |
4420 |
++ |
4421 |
++ call kpoints_binding_mp_k_1(symid, nkpt, ngkpt, kptrlatt, kptrlen, & |
4422 |
++ & nshiftk_, shiftk_, errno) |
4423 |
++ if (errno /= AB7_NO_ERROR) return |
4424 |
++ allocate(kpt(3, nkpt)) |
4425 |
++ allocate(wkpt(nkpt)) |
4426 |
++ call kpoints_binding_mp_k_2(symid, nkpt, kpt, wkpt, & |
4427 |
++ & kptrlatt, kptrlen, nshiftk_, shiftk_, errno) |
4428 |
++ end subroutine kpoints_get_mp_k_grid |
4429 |
++ |
4430 |
++ |
4431 |
++ |
4432 |
++ subroutine kpoints_binding_auto_k_1(symid, nkpt, kptrlatt, kptrlen, & |
4433 |
++ & nshiftk, shiftk, errno) |
4434 |
++ |
4435 |
++ |
4436 |
++!This section has been created automatically by the script Abilint (TD). |
4437 |
++!Do not modify the following lines by hand. |
4438 |
++ use interfaces_56_recipspace |
4439 |
++!End of the abilint section |
4440 |
++ |
4441 |
++ integer, intent(in) :: symid |
4442 |
++ integer, intent(out) :: errno |
4443 |
++ integer, intent(out) :: nkpt |
4444 |
++ real(dp), intent(inout) :: kptrlen |
4445 |
++ integer, intent(out) :: nshiftk |
4446 |
++ real(dp), intent(out) :: shiftk(3, 8) |
4447 |
++ integer, intent(out) :: kptrlatt(3,3) |
4448 |
++ |
4449 |
++ type(symmetry_type), pointer :: sym |
4450 |
++ real(dp), allocatable :: kpt(:,:), wkpt(:) |
4451 |
++ |
4452 |
++ if (AB_DBG) write(std_err,*) "AB symmetry: call get auto k grid1." |
4453 |
++ |
4454 |
++ errno = AB7_NO_ERROR |
4455 |
++ call symmetry_get_from_id(sym, symid, errno) |
4456 |
++ if (errno /= AB7_NO_ERROR) return |
4457 |
++ |
4458 |
++ ! The parameters of the k lattice are not known, compute |
4459 |
++ ! kptrlatt, nshiftk, shiftk. |
4460 |
++ call testkgrid(sym%bravais,6,kptrlatt,kptrlen,& |
4461 |
++ & AB7_MAX_SYMMETRIES,nshiftk,sym%nSym,0,sym%rprimd,& |
4462 |
++ & shiftk,sym%symAfm,sym%sym,sym%vacuum) |
4463 |
++ if (AB_DBG) write(std_err,*) "AB symmetry: testkgrid -> kptrlatt=", kptrlatt |
4464 |
++ |
4465 |
++ call getkgrid(6, 1, kpt, 1, kptrlatt, kptrlen, & |
4466 |
++ & AB7_MAX_SYMMETRIES, 0, nkpt, nshiftk, sym%nSym, & |
4467 |
++ & sym%rprimd, shiftk, sym%symAfm, sym%sym, & |
4468 |
++ & sym%vacuum, wkpt) |
4469 |
++ if (AB_DBG) write(std_err,*) "AB symmetry: getkgrid -> nkpt=", nkpt |
4470 |
++ end subroutine kpoints_binding_auto_k_1 |
4471 |
++ |
4472 |
++ |
4473 |
++ subroutine kpoints_binding_auto_k_2(symid, nkpt, kpt, wkpt, kptrlatt, kptrlen, & |
4474 |
++ & nshiftk, shiftk, errno) |
4475 |
++ |
4476 |
++ |
4477 |
++!This section has been created automatically by the script Abilint (TD). |
4478 |
++!Do not modify the following lines by hand. |
4479 |
++ use interfaces_56_recipspace |
4480 |
++!End of the abilint section |
4481 |
++ |
4482 |
++ integer, intent(in) :: symid |
4483 |
++ integer, intent(out) :: errno |
4484 |
++ integer, intent(in) :: nkpt |
4485 |
++ real(dp), intent(out) :: kpt(3,nkpt), wkpt(nkpt) |
4486 |
++ real(dp), intent(inout) :: kptrlen |
4487 |
++ integer, intent(inout) :: nshiftk |
4488 |
++ real(dp), intent(inout) :: shiftk(3, 8) |
4489 |
++ integer, intent(inout) :: kptrlatt(3,3) |
4490 |
++ |
4491 |
++ type(symmetry_type), pointer :: sym |
4492 |
++ integer :: nkpt_ |
4493 |
++ |
4494 |
++ if (AB_DBG) write(std_err,*) "AB symmetry: call get auto k grid2." |
4495 |
++ |
4496 |
++ errno = AB7_NO_ERROR |
4497 |
++ call symmetry_get_from_id(sym, symid, errno) |
4498 |
++ if (errno /= AB7_NO_ERROR) return |
4499 |
++ |
4500 |
++ ! Then, we call it again to get the actual values for the k points. |
4501 |
++ call getkgrid(6, 1, kpt, 1, kptrlatt, kptrlen, & |
4502 |
++ & AB7_MAX_SYMMETRIES, nkpt, nkpt_, nshiftk, sym%nSym, & |
4503 |
++ & sym%rprimd, shiftk, sym%symAfm, sym%sym, & |
4504 |
++ & sym%vacuum, wkpt) |
4505 |
++ end subroutine kpoints_binding_auto_k_2 |
4506 |
++ |
4507 |
++ subroutine kpoints_get_auto_k_grid(symid, nkpt, kpt, wkpt, & |
4508 |
++ & kptrlen, errno) |
4509 |
++ |
4510 |
++ integer, intent(in) :: symid |
4511 |
++ integer, intent(out) :: errno |
4512 |
++ integer, intent(out) :: nkpt |
4513 |
++ real(dp), intent(in) :: kptrlen |
4514 |
++ real(dp), pointer :: kpt(:,:), wkpt(:) |
4515 |
++ |
4516 |
++ real(dp) :: kptrlen_ |
4517 |
++ integer :: kptrlatt(3,3) |
4518 |
++ integer :: nshiftk |
4519 |
++ real(dp) :: shiftk(3, 8) |
4520 |
++ |
4521 |
++ if (AB_DBG) write(std_err,*) "AB symmetry: call get auto k grid." |
4522 |
++ |
4523 |
++ kptrlen_ = kptrlen |
4524 |
++ call kpoints_binding_auto_k_1(symid, nkpt, kptrlatt, kptrlen_, & |
4525 |
++ & nshiftk, shiftk, errno) |
4526 |
++ if (errno /= AB7_NO_ERROR) return |
4527 |
++ allocate(kpt(3, nkpt)) |
4528 |
++ allocate(wkpt(nkpt)) |
4529 |
++ call kpoints_binding_auto_k_2(symid, nkpt, kpt, wkpt, kptrlatt, kptrlen_, & |
4530 |
++ & nshiftk, shiftk, errno) |
4531 |
++ end subroutine kpoints_get_auto_k_grid |
4532 |
++ |
4533 |
++end module m_ab7_kpoints |
4534 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/72_geomoptim/ab6_moldyn.F90 bigdft-abi-1.0.4.new/libABINIT/src/72_geomoptim/ab6_moldyn.F90 |
4535 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/72_geomoptim/ab6_moldyn.F90 2012-07-09 16:43:33.000000000 +0200 |
4536 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/72_geomoptim/ab6_moldyn.F90 1970-01-01 01:00:00.000000000 +0100 |
4537 |
+@@ -1,42 +0,0 @@ |
4538 |
+-module ab6_moldyn |
4539 |
+- |
4540 |
+- use defs_basis |
4541 |
+- |
4542 |
+- implicit none |
4543 |
+- |
4544 |
+- interface |
4545 |
+- subroutine scfloop_main(acell, epot, fcart, grad, itime, me, natom, rprimd, xred) |
4546 |
+- use defs_basis |
4547 |
+- |
4548 |
+- integer, intent(in) :: natom, itime, me |
4549 |
+- real(dp), intent(out) :: epot |
4550 |
+- real(dp), intent(in) :: acell(3) |
4551 |
+- real(dp), intent(in) :: rprimd(3,3), xred(3,natom) |
4552 |
+- real(dp), intent(out) :: fcart(3, natom), grad(3, natom) |
4553 |
+- end subroutine scfloop_main |
4554 |
+- end interface |
4555 |
+- |
4556 |
+- interface |
4557 |
+- subroutine scfloop_output(acell, epot, ekin, fred, itime, me, natom, rprimd, vel, xred) |
4558 |
+- use defs_basis |
4559 |
+- |
4560 |
+- integer, intent(in) :: natom, itime, me |
4561 |
+- real(dp), intent(in) :: epot, ekin |
4562 |
+- real(dp), intent(in) :: acell(3) |
4563 |
+- real(dp), intent(in) :: rprimd(3,3), xred(3,natom) |
4564 |
+- real(dp), intent(in) :: fred(3, natom), vel(3, natom) |
4565 |
+- end subroutine scfloop_output |
4566 |
+- end interface |
4567 |
+- |
4568 |
+-contains |
4569 |
+- |
4570 |
+- include "velocity_verlet.F90" |
4571 |
+- include "quenched.F90" |
4572 |
+- include "langevin.F90" |
4573 |
+- include "nose.F90" |
4574 |
+- include "isokinetic.F90" |
4575 |
+- include "isotemp.F90" |
4576 |
+- include "isothermal.F90" |
4577 |
+- include "moldyn.F90" |
4578 |
+- |
4579 |
+-end module ab6_moldyn |
4580 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/72_geomoptim/ab7_moldyn.F90 bigdft-abi-1.0.4.new/libABINIT/src/72_geomoptim/ab7_moldyn.F90 |
4581 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/72_geomoptim/ab7_moldyn.F90 1970-01-01 01:00:00.000000000 +0100 |
4582 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/72_geomoptim/ab7_moldyn.F90 2013-06-11 16:51:00.000000000 +0200 |
4583 |
+@@ -0,0 +1,42 @@ |
4584 |
++module ab7_moldyn |
4585 |
++ |
4586 |
++ use defs_basis |
4587 |
++ |
4588 |
++ implicit none |
4589 |
++ |
4590 |
++ interface |
4591 |
++ subroutine scfloop_main(acell, epot, fcart, grad, itime, me, natom, rprimd, xred) |
4592 |
++ use defs_basis |
4593 |
++ |
4594 |
++ integer, intent(in) :: natom, itime, me |
4595 |
++ real(dp), intent(out) :: epot |
4596 |
++ real(dp), intent(in) :: acell(3) |
4597 |
++ real(dp), intent(in) :: rprimd(3,3), xred(3,natom) |
4598 |
++ real(dp), intent(out) :: fcart(3, natom), grad(3, natom) |
4599 |
++ end subroutine scfloop_main |
4600 |
++ end interface |
4601 |
++ |
4602 |
++ interface |
4603 |
++ subroutine scfloop_output(acell, epot, ekin, fred, itime, me, natom, rprimd, vel, xred) |
4604 |
++ use defs_basis |
4605 |
++ |
4606 |
++ integer, intent(in) :: natom, itime, me |
4607 |
++ real(dp), intent(in) :: epot, ekin |
4608 |
++ real(dp), intent(in) :: acell(3) |
4609 |
++ real(dp), intent(in) :: rprimd(3,3), xred(3,natom) |
4610 |
++ real(dp), intent(in) :: fred(3, natom), vel(3, natom) |
4611 |
++ end subroutine scfloop_output |
4612 |
++ end interface |
4613 |
++ |
4614 |
++contains |
4615 |
++ |
4616 |
++ include "velocity_verlet.F90" |
4617 |
++ include "quenched.F90" |
4618 |
++ include "langevin.F90" |
4619 |
++ include "nose.F90" |
4620 |
++ include "isokinetic.F90" |
4621 |
++ include "isotemp.F90" |
4622 |
++ include "isothermal.F90" |
4623 |
++ include "moldyn.F90" |
4624 |
++ |
4625 |
++end module ab7_moldyn |
4626 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/Makefile.am bigdft-abi-1.0.4.new/libABINIT/src/Makefile.am |
4627 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/Makefile.am 2012-11-08 11:12:57.000000000 +0100 |
4628 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/Makefile.am 2013-06-11 16:51:00.000000000 +0200 |
4629 |
+@@ -85,7 +85,7 @@ |
4630 |
+ 42_geometry/getspinrot.F90 \ |
4631 |
+ 42_geometry/gridgcart.F90 \ |
4632 |
+ 42_geometry/holocell.F90 \ |
4633 |
+- 42_geometry/m_ab6_symmetry.F90 \ |
4634 |
++ 42_geometry/m_ab7_symmetry.F90 \ |
4635 |
+ 42_geometry/metric.F90 \ |
4636 |
+ 42_geometry/mkrdim.F90 \ |
4637 |
+ 42_geometry/operat.F90 \ |
4638 |
+@@ -128,14 +128,14 @@ |
4639 |
+ 56_mixing/dotprodm_vn.F90 \ |
4640 |
+ 56_mixing/findminscf.F90 \ |
4641 |
+ 56_mixing/interfaces_56_mixing.F90 \ |
4642 |
+- 56_mixing/m_ab6_mixing.F90 \ |
4643 |
++ 56_mixing/m_ab7_mixing.F90 \ |
4644 |
+ 56_mixing/scfcge.F90 \ |
4645 |
+ 56_mixing/scfeig.F90 \ |
4646 |
+ 56_mixing/scfopt.F90 \ |
4647 |
+ 56_mixing/sqnormm_v.F90 \ |
4648 |
+ 56_recipspace/interfaces_56_recipspace.F90 \ |
4649 |
+ 56_recipspace/irrzg.F90 \ |
4650 |
+- 56_recipspace/m_ab6_kpoints.F90 \ |
4651 |
++ 56_recipspace/m_ab7_kpoints.F90 \ |
4652 |
+ 56_recipspace/getkgrid.F90 \ |
4653 |
+ 56_recipspace/smpbz.F90 \ |
4654 |
+ 56_recipspace/symkpt.F90 \ |
4655 |
+@@ -159,7 +159,7 @@ |
4656 |
+ 67_common/ewald2.F90 \ |
4657 |
+ 67_common/fconv.F90 \ |
4658 |
+ 67_common/prtxvf.F90 \ |
4659 |
+- 72_geomoptim/ab6_moldyn.F90 \ |
4660 |
++ 72_geomoptim/ab7_moldyn.F90 \ |
4661 |
+ 72_geomoptim/xfpack.F90 |
4662 |
+ |
4663 |
+ CLEANFILES = mpif.h *.@MODULE_EXT@ |
4664 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/Makefile.in bigdft-abi-1.0.4.new/libABINIT/src/Makefile.in |
4665 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/Makefile.in 2013-01-28 14:39:34.000000000 +0100 |
4666 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/Makefile.in 2013-06-11 16:51:00.000000000 +0200 |
4667 |
+@@ -91,7 +91,7 @@ |
4668 |
+ gensymshub4.$(OBJEXT) gensymshub.$(OBJEXT) \ |
4669 |
+ gensymspgr.$(OBJEXT) getptgroupma.$(OBJEXT) \ |
4670 |
+ getspinrot.$(OBJEXT) gridgcart.$(OBJEXT) holocell.$(OBJEXT) \ |
4671 |
+- m_ab6_symmetry.$(OBJEXT) metric.$(OBJEXT) mkrdim.$(OBJEXT) \ |
4672 |
++ m_ab7_symmetry.$(OBJEXT) metric.$(OBJEXT) mkrdim.$(OBJEXT) \ |
4673 |
+ operat.$(OBJEXT) prtspgroup.$(OBJEXT) ptgmadata.$(OBJEXT) \ |
4674 |
+ smallprim.$(OBJEXT) spgdata.$(OBJEXT) strainsym.$(OBJEXT) \ |
4675 |
+ strconv.$(OBJEXT) stresssym.$(OBJEXT) sym2cart.$(OBJEXT) \ |
4676 |
+@@ -106,10 +106,10 @@ |
4677 |
+ symzat.$(OBJEXT) xredxcart.$(OBJEXT) defs_abitypes.$(OBJEXT) \ |
4678 |
+ aprxdr.$(OBJEXT) dotprodm_v.$(OBJEXT) dotprodm_vn.$(OBJEXT) \ |
4679 |
+ findminscf.$(OBJEXT) interfaces_56_mixing.$(OBJEXT) \ |
4680 |
+- m_ab6_mixing.$(OBJEXT) scfcge.$(OBJEXT) scfeig.$(OBJEXT) \ |
4681 |
++ m_ab7_mixing.$(OBJEXT) scfcge.$(OBJEXT) scfeig.$(OBJEXT) \ |
4682 |
+ scfopt.$(OBJEXT) sqnormm_v.$(OBJEXT) \ |
4683 |
+ interfaces_56_recipspace.$(OBJEXT) irrzg.$(OBJEXT) \ |
4684 |
+- m_ab6_kpoints.$(OBJEXT) getkgrid.$(OBJEXT) smpbz.$(OBJEXT) \ |
4685 |
++ m_ab7_kpoints.$(OBJEXT) getkgrid.$(OBJEXT) smpbz.$(OBJEXT) \ |
4686 |
+ symkpt.$(OBJEXT) testkgrid.$(OBJEXT) \ |
4687 |
+ interfaces_56_xc.$(OBJEXT) drivexc.$(OBJEXT) invcb.$(OBJEXT) \ |
4688 |
+ mkdenpos.$(OBJEXT) m_libxc_functionals.$(OBJEXT) \ |
4689 |
+@@ -117,7 +117,7 @@ |
4690 |
+ xclb.$(OBJEXT) xcpbe.$(OBJEXT) xcpzca.$(OBJEXT) \ |
4691 |
+ xcspol.$(OBJEXT) xctetr.$(OBJEXT) xcwign.$(OBJEXT) \ |
4692 |
+ xcxalp.$(OBJEXT) ewald.$(OBJEXT) ewald2.$(OBJEXT) \ |
4693 |
+- fconv.$(OBJEXT) prtxvf.$(OBJEXT) ab6_moldyn.$(OBJEXT) \ |
4694 |
++ fconv.$(OBJEXT) prtxvf.$(OBJEXT) ab7_moldyn.$(OBJEXT) \ |
4695 |
+ xfpack.$(OBJEXT) |
4696 |
+ libabinit_a_OBJECTS = $(am_libabinit_a_OBJECTS) |
4697 |
+ DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir) |
4698 |
+@@ -352,7 +352,7 @@ |
4699 |
+ 42_geometry/getspinrot.F90 \ |
4700 |
+ 42_geometry/gridgcart.F90 \ |
4701 |
+ 42_geometry/holocell.F90 \ |
4702 |
+- 42_geometry/m_ab6_symmetry.F90 \ |
4703 |
++ 42_geometry/m_ab7_symmetry.F90 \ |
4704 |
+ 42_geometry/metric.F90 \ |
4705 |
+ 42_geometry/mkrdim.F90 \ |
4706 |
+ 42_geometry/operat.F90 \ |
4707 |
+@@ -395,14 +395,14 @@ |
4708 |
+ 56_mixing/dotprodm_vn.F90 \ |
4709 |
+ 56_mixing/findminscf.F90 \ |
4710 |
+ 56_mixing/interfaces_56_mixing.F90 \ |
4711 |
+- 56_mixing/m_ab6_mixing.F90 \ |
4712 |
++ 56_mixing/m_ab7_mixing.F90 \ |
4713 |
+ 56_mixing/scfcge.F90 \ |
4714 |
+ 56_mixing/scfeig.F90 \ |
4715 |
+ 56_mixing/scfopt.F90 \ |
4716 |
+ 56_mixing/sqnormm_v.F90 \ |
4717 |
+ 56_recipspace/interfaces_56_recipspace.F90 \ |
4718 |
+ 56_recipspace/irrzg.F90 \ |
4719 |
+- 56_recipspace/m_ab6_kpoints.F90 \ |
4720 |
++ 56_recipspace/m_ab7_kpoints.F90 \ |
4721 |
+ 56_recipspace/getkgrid.F90 \ |
4722 |
+ 56_recipspace/smpbz.F90 \ |
4723 |
+ 56_recipspace/symkpt.F90 \ |
4724 |
+@@ -426,7 +426,7 @@ |
4725 |
+ 67_common/ewald2.F90 \ |
4726 |
+ 67_common/fconv.F90 \ |
4727 |
+ 67_common/prtxvf.F90 \ |
4728 |
+- 72_geomoptim/ab6_moldyn.F90 \ |
4729 |
++ 72_geomoptim/ab7_moldyn.F90 \ |
4730 |
+ 72_geomoptim/xfpack.F90 |
4731 |
+ |
4732 |
+ CLEANFILES = mpif.h *.@MODULE_EXT@ |
4733 |
+@@ -633,8 +633,8 @@ |
4734 |
+ holocell.obj: 42_geometry/holocell.F90 |
4735 |
+ $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o holocell.obj `if test -f '42_geometry/holocell.F90'; then $(CYGPATH_W) '42_geometry/holocell.F90'; else $(CYGPATH_W) '$(srcdir)/42_geometry/holocell.F90'; fi` |
4736 |
+ |
4737 |
+-m_ab6_symmetry.obj: 42_geometry/m_ab6_symmetry.F90 |
4738 |
+- $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o m_ab6_symmetry.obj `if test -f '42_geometry/m_ab6_symmetry.F90'; then $(CYGPATH_W) '42_geometry/m_ab6_symmetry.F90'; else $(CYGPATH_W) '$(srcdir)/42_geometry/m_ab6_symmetry.F90'; fi` |
4739 |
++m_ab7_symmetry.obj: 42_geometry/m_ab7_symmetry.F90 |
4740 |
++ $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o m_ab7_symmetry.obj `if test -f '42_geometry/m_ab7_symmetry.F90'; then $(CYGPATH_W) '42_geometry/m_ab7_symmetry.F90'; else $(CYGPATH_W) '$(srcdir)/42_geometry/m_ab7_symmetry.F90'; fi` |
4741 |
+ |
4742 |
+ metric.obj: 42_geometry/metric.F90 |
4743 |
+ $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o metric.obj `if test -f '42_geometry/metric.F90'; then $(CYGPATH_W) '42_geometry/metric.F90'; else $(CYGPATH_W) '$(srcdir)/42_geometry/metric.F90'; fi` |
4744 |
+@@ -762,8 +762,8 @@ |
4745 |
+ interfaces_56_mixing.obj: 56_mixing/interfaces_56_mixing.F90 |
4746 |
+ $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o interfaces_56_mixing.obj `if test -f '56_mixing/interfaces_56_mixing.F90'; then $(CYGPATH_W) '56_mixing/interfaces_56_mixing.F90'; else $(CYGPATH_W) '$(srcdir)/56_mixing/interfaces_56_mixing.F90'; fi` |
4747 |
+ |
4748 |
+-m_ab6_mixing.obj: 56_mixing/m_ab6_mixing.F90 |
4749 |
+- $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o m_ab6_mixing.obj `if test -f '56_mixing/m_ab6_mixing.F90'; then $(CYGPATH_W) '56_mixing/m_ab6_mixing.F90'; else $(CYGPATH_W) '$(srcdir)/56_mixing/m_ab6_mixing.F90'; fi` |
4750 |
++m_ab7_mixing.obj: 56_mixing/m_ab7_mixing.F90 |
4751 |
++ $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o m_ab7_mixing.obj `if test -f '56_mixing/m_ab7_mixing.F90'; then $(CYGPATH_W) '56_mixing/m_ab7_mixing.F90'; else $(CYGPATH_W) '$(srcdir)/56_mixing/m_ab7_mixing.F90'; fi` |
4752 |
+ |
4753 |
+ scfcge.obj: 56_mixing/scfcge.F90 |
4754 |
+ $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o scfcge.obj `if test -f '56_mixing/scfcge.F90'; then $(CYGPATH_W) '56_mixing/scfcge.F90'; else $(CYGPATH_W) '$(srcdir)/56_mixing/scfcge.F90'; fi` |
4755 |
+@@ -783,8 +783,8 @@ |
4756 |
+ irrzg.obj: 56_recipspace/irrzg.F90 |
4757 |
+ $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o irrzg.obj `if test -f '56_recipspace/irrzg.F90'; then $(CYGPATH_W) '56_recipspace/irrzg.F90'; else $(CYGPATH_W) '$(srcdir)/56_recipspace/irrzg.F90'; fi` |
4758 |
+ |
4759 |
+-m_ab6_kpoints.obj: 56_recipspace/m_ab6_kpoints.F90 |
4760 |
+- $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o m_ab6_kpoints.obj `if test -f '56_recipspace/m_ab6_kpoints.F90'; then $(CYGPATH_W) '56_recipspace/m_ab6_kpoints.F90'; else $(CYGPATH_W) '$(srcdir)/56_recipspace/m_ab6_kpoints.F90'; fi` |
4761 |
++m_ab7_kpoints.obj: 56_recipspace/m_ab7_kpoints.F90 |
4762 |
++ $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o m_ab7_kpoints.obj `if test -f '56_recipspace/m_ab7_kpoints.F90'; then $(CYGPATH_W) '56_recipspace/m_ab7_kpoints.F90'; else $(CYGPATH_W) '$(srcdir)/56_recipspace/m_ab7_kpoints.F90'; fi` |
4763 |
+ |
4764 |
+ getkgrid.obj: 56_recipspace/getkgrid.F90 |
4765 |
+ $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o getkgrid.obj `if test -f '56_recipspace/getkgrid.F90'; then $(CYGPATH_W) '56_recipspace/getkgrid.F90'; else $(CYGPATH_W) '$(srcdir)/56_recipspace/getkgrid.F90'; fi` |
4766 |
+@@ -855,8 +855,8 @@ |
4767 |
+ prtxvf.obj: 67_common/prtxvf.F90 |
4768 |
+ $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o prtxvf.obj `if test -f '67_common/prtxvf.F90'; then $(CYGPATH_W) '67_common/prtxvf.F90'; else $(CYGPATH_W) '$(srcdir)/67_common/prtxvf.F90'; fi` |
4769 |
+ |
4770 |
+-ab6_moldyn.obj: 72_geomoptim/ab6_moldyn.F90 |
4771 |
+- $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o ab6_moldyn.obj `if test -f '72_geomoptim/ab6_moldyn.F90'; then $(CYGPATH_W) '72_geomoptim/ab6_moldyn.F90'; else $(CYGPATH_W) '$(srcdir)/72_geomoptim/ab6_moldyn.F90'; fi` |
4772 |
++ab7_moldyn.obj: 72_geomoptim/ab7_moldyn.F90 |
4773 |
++ $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o ab7_moldyn.obj `if test -f '72_geomoptim/ab7_moldyn.F90'; then $(CYGPATH_W) '72_geomoptim/ab7_moldyn.F90'; else $(CYGPATH_W) '$(srcdir)/72_geomoptim/ab7_moldyn.F90'; fi` |
4774 |
+ |
4775 |
+ xfpack.obj: 72_geomoptim/xfpack.F90 |
4776 |
+ $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o xfpack.obj `if test -f '72_geomoptim/xfpack.F90'; then $(CYGPATH_W) '72_geomoptim/xfpack.F90'; else $(CYGPATH_W) '$(srcdir)/72_geomoptim/xfpack.F90'; fi` |
4777 |
+@@ -1268,11 +1268,11 @@ |
4778 |
+ interfaces_42_geometry.o |
4779 |
+ $(PPFCCOMPILE) -c -o symptgroup.o `test -f '42_geometry/symptgroup.F90' || echo '$(srcdir)/'`42_geometry/symptgroup.F90 |
4780 |
+ |
4781 |
+-m_ab6_symmetry.o: 42_geometry/m_ab6_symmetry.F90 \ |
4782 |
++m_ab7_symmetry.o: 42_geometry/m_ab7_symmetry.F90 \ |
4783 |
+ defs_basis.o \ |
4784 |
+ interfaces_32_util.o \ |
4785 |
+ interfaces_42_geometry.o |
4786 |
+- $(PPFCCOMPILE) -c -o m_ab6_symmetry.o `test -f '42_geometry/m_ab6_symmetry.F90' || echo '$(srcdir)/'`42_geometry/m_ab6_symmetry.F90 |
4787 |
++ $(PPFCCOMPILE) -c -o m_ab7_symmetry.o `test -f '42_geometry/m_ab7_symmetry.F90' || echo '$(srcdir)/'`42_geometry/m_ab7_symmetry.F90 |
4788 |
+ |
4789 |
+ symchk.o: 42_geometry/symchk.F90 \ |
4790 |
+ defs_basis.o |
4791 |
+@@ -1498,11 +1498,11 @@ |
4792 |
+ interfaces_56_recipspace.o |
4793 |
+ $(PPFCCOMPILE) -c -o getkgrid.o `test -f '56_recipspace/getkgrid.F90' || echo '$(srcdir)/'`56_recipspace/getkgrid.F90 |
4794 |
+ |
4795 |
+-m_ab6_kpoints.o: 56_recipspace/m_ab6_kpoints.F90 \ |
4796 |
++m_ab7_kpoints.o: 56_recipspace/m_ab7_kpoints.F90 \ |
4797 |
+ defs_basis.o \ |
4798 |
+ interfaces_56_recipspace.o \ |
4799 |
+- m_ab6_symmetry.o |
4800 |
+- $(PPFCCOMPILE) -c -o m_ab6_kpoints.o `test -f '56_recipspace/m_ab6_kpoints.F90' || echo '$(srcdir)/'`56_recipspace/m_ab6_kpoints.F90 |
4801 |
++ m_ab7_symmetry.o |
4802 |
++ $(PPFCCOMPILE) -c -o m_ab7_kpoints.o `test -f '56_recipspace/m_ab7_kpoints.F90' || echo '$(srcdir)/'`56_recipspace/m_ab7_kpoints.F90 |
4803 |
+ |
4804 |
+ interfaces_56_recipspace.o: 56_recipspace/interfaces_56_recipspace.F90 \ |
4805 |
+ defs_abitypes.o \ |
4806 |
+@@ -1647,7 +1647,7 @@ |
4807 |
+ defs_datatypes.o |
4808 |
+ $(PPFCCOMPILE) -c -o moldyn.o `test -f '72_geomoptim/moldyn.F90' || echo '$(srcdir)/'`72_geomoptim/moldyn.F90 |
4809 |
+ |
4810 |
+-ab6_moldyn.o: 72_geomoptim/ab6_moldyn.F90 \ |
4811 |
++ab7_moldyn.o: 72_geomoptim/ab7_moldyn.F90 \ |
4812 |
+ defs_basis.o \ |
4813 |
+ defs_basis.o \ |
4814 |
+ 72_geomoptim/isokinetic.F90 \ |
4815 |
+@@ -1669,7 +1669,7 @@ |
4816 |
+ 72_geomoptim/quenched.F90 \ |
4817 |
+ defs_basis.o \ |
4818 |
+ 72_geomoptim/velocity_verlet.F90 |
4819 |
+- $(PPFCCOMPILE) -c -o ab6_moldyn.o `test -f '72_geomoptim/ab6_moldyn.F90' || echo '$(srcdir)/'`72_geomoptim/ab6_moldyn.F90 |
4820 |
++ $(PPFCCOMPILE) -c -o ab7_moldyn.o `test -f '72_geomoptim/ab7_moldyn.F90' || echo '$(srcdir)/'`72_geomoptim/ab7_moldyn.F90 |
4821 |
+ |
4822 |
+ velocity_verlet.o: 72_geomoptim/velocity_verlet.F90 \ |
4823 |
+ defs_basis.o |
4824 |
+@@ -1768,12 +1768,12 @@ |
4825 |
+ interfaces_14_hidewrite.o |
4826 |
+ $(PPFCCOMPILE) -c -o scfeig.o `test -f '56_mixing/scfeig.F90' || echo '$(srcdir)/'`56_mixing/scfeig.F90 |
4827 |
+ |
4828 |
+-m_ab6_mixing.o: 56_mixing/m_ab6_mixing.F90 \ |
4829 |
++m_ab7_mixing.o: 56_mixing/m_ab7_mixing.F90 \ |
4830 |
+ defs_basis.o \ |
4831 |
+ interfaces_18_timing.o \ |
4832 |
+ interfaces_56_mixing.o \ |
4833 |
+ m_profiling.o |
4834 |
+- $(PPFCCOMPILE) -c -o m_ab6_mixing.o `test -f '56_mixing/m_ab6_mixing.F90' || echo '$(srcdir)/'`56_mixing/m_ab6_mixing.F90 |
4835 |
++ $(PPFCCOMPILE) -c -o m_ab7_mixing.o `test -f '56_mixing/m_ab7_mixing.F90' || echo '$(srcdir)/'`56_mixing/m_ab7_mixing.F90 |
4836 |
+ |
4837 |
+ dotprodm_vn.o: 56_mixing/dotprodm_vn.F90 \ |
4838 |
+ defs_abitypes.o \ |
4839 |
+diff -urN bigdft-abi-1.0.4.old/libABINIT/src/deps bigdft-abi-1.0.4.new/libABINIT/src/deps |
4840 |
+--- bigdft-abi-1.0.4.old/libABINIT/src/deps 2012-11-08 11:13:29.000000000 +0100 |
4841 |
++++ bigdft-abi-1.0.4.new/libABINIT/src/deps 2013-06-11 16:51:00.000000000 +0200 |
4842 |
+@@ -194,11 +194,11 @@ |
4843 |
+ interfaces_42_geometry.o |
4844 |
+ $(PPFCCOMPILE) -c -o symptgroup.o `test -f '42_geometry/symptgroup.F90' || echo '$(srcdir)/'`42_geometry/symptgroup.F90 |
4845 |
+ |
4846 |
+-m_ab6_symmetry.o: 42_geometry/m_ab6_symmetry.F90 \ |
4847 |
++m_ab7_symmetry.o: 42_geometry/m_ab7_symmetry.F90 \ |
4848 |
+ defs_basis.o \ |
4849 |
+ interfaces_32_util.o \ |
4850 |
+ interfaces_42_geometry.o |
4851 |
+- $(PPFCCOMPILE) -c -o m_ab6_symmetry.o `test -f '42_geometry/m_ab6_symmetry.F90' || echo '$(srcdir)/'`42_geometry/m_ab6_symmetry.F90 |
4852 |
++ $(PPFCCOMPILE) -c -o m_ab7_symmetry.o `test -f '42_geometry/m_ab7_symmetry.F90' || echo '$(srcdir)/'`42_geometry/m_ab7_symmetry.F90 |
4853 |
+ |
4854 |
+ symchk.o: 42_geometry/symchk.F90 \ |
4855 |
+ defs_basis.o |
4856 |
+@@ -424,11 +424,11 @@ |
4857 |
+ interfaces_56_recipspace.o |
4858 |
+ $(PPFCCOMPILE) -c -o getkgrid.o `test -f '56_recipspace/getkgrid.F90' || echo '$(srcdir)/'`56_recipspace/getkgrid.F90 |
4859 |
+ |
4860 |
+-m_ab6_kpoints.o: 56_recipspace/m_ab6_kpoints.F90 \ |
4861 |
++m_ab7_kpoints.o: 56_recipspace/m_ab7_kpoints.F90 \ |
4862 |
+ defs_basis.o \ |
4863 |
+ interfaces_56_recipspace.o \ |
4864 |
+- m_ab6_symmetry.o |
4865 |
+- $(PPFCCOMPILE) -c -o m_ab6_kpoints.o `test -f '56_recipspace/m_ab6_kpoints.F90' || echo '$(srcdir)/'`56_recipspace/m_ab6_kpoints.F90 |
4866 |
++ m_ab7_symmetry.o |
4867 |
++ $(PPFCCOMPILE) -c -o m_ab7_kpoints.o `test -f '56_recipspace/m_ab7_kpoints.F90' || echo '$(srcdir)/'`56_recipspace/m_ab7_kpoints.F90 |
4868 |
+ |
4869 |
+ interfaces_56_recipspace.o: 56_recipspace/interfaces_56_recipspace.F90 \ |
4870 |
+ defs_abitypes.o \ |
4871 |
+@@ -573,7 +573,7 @@ |
4872 |
+ defs_datatypes.o |
4873 |
+ $(PPFCCOMPILE) -c -o moldyn.o `test -f '72_geomoptim/moldyn.F90' || echo '$(srcdir)/'`72_geomoptim/moldyn.F90 |
4874 |
+ |
4875 |
+-ab6_moldyn.o: 72_geomoptim/ab6_moldyn.F90 \ |
4876 |
++ab7_moldyn.o: 72_geomoptim/ab7_moldyn.F90 \ |
4877 |
+ defs_basis.o \ |
4878 |
+ defs_basis.o \ |
4879 |
+ 72_geomoptim/isokinetic.F90 \ |
4880 |
+@@ -595,7 +595,7 @@ |
4881 |
+ 72_geomoptim/quenched.F90 \ |
4882 |
+ defs_basis.o \ |
4883 |
+ 72_geomoptim/velocity_verlet.F90 |
4884 |
+- $(PPFCCOMPILE) -c -o ab6_moldyn.o `test -f '72_geomoptim/ab6_moldyn.F90' || echo '$(srcdir)/'`72_geomoptim/ab6_moldyn.F90 |
4885 |
++ $(PPFCCOMPILE) -c -o ab7_moldyn.o `test -f '72_geomoptim/ab7_moldyn.F90' || echo '$(srcdir)/'`72_geomoptim/ab7_moldyn.F90 |
4886 |
+ |
4887 |
+ velocity_verlet.o: 72_geomoptim/velocity_verlet.F90 \ |
4888 |
+ defs_basis.o |
4889 |
+@@ -694,12 +694,12 @@ |
4890 |
+ interfaces_14_hidewrite.o |
4891 |
+ $(PPFCCOMPILE) -c -o scfeig.o `test -f '56_mixing/scfeig.F90' || echo '$(srcdir)/'`56_mixing/scfeig.F90 |
4892 |
+ |
4893 |
+-m_ab6_mixing.o: 56_mixing/m_ab6_mixing.F90 \ |
4894 |
++m_ab7_mixing.o: 56_mixing/m_ab7_mixing.F90 \ |
4895 |
+ defs_basis.o \ |
4896 |
+ interfaces_18_timing.o \ |
4897 |
+ interfaces_56_mixing.o \ |
4898 |
+ m_profiling.o |
4899 |
+- $(PPFCCOMPILE) -c -o m_ab6_mixing.o `test -f '56_mixing/m_ab6_mixing.F90' || echo '$(srcdir)/'`56_mixing/m_ab6_mixing.F90 |
4900 |
++ $(PPFCCOMPILE) -c -o m_ab7_mixing.o `test -f '56_mixing/m_ab7_mixing.F90' || echo '$(srcdir)/'`56_mixing/m_ab7_mixing.F90 |
4901 |
+ |
4902 |
+ dotprodm_vn.o: 56_mixing/dotprodm_vn.F90 \ |
4903 |
+ defs_abitypes.o \ |
4904 |
+diff -urN bigdft-abi-1.0.4.old/src/abscalc.f90 bigdft-abi-1.0.4.new/src/abscalc.f90 |
4905 |
+--- bigdft-abi-1.0.4.old/src/abscalc.f90 2012-07-09 16:43:33.000000000 +0200 |
4906 |
++++ bigdft-abi-1.0.4.new/src/abscalc.f90 2013-06-11 16:51:00.000000000 +0200 |
4907 |
+@@ -13,7 +13,7 @@ |
4908 |
+ use module_base |
4909 |
+ use module_types |
4910 |
+ use module_interfaces |
4911 |
+- use m_ab6_symmetry |
4912 |
++ use m_ab7_symmetry |
4913 |
+ ! use minimization, only: parameterminimization |
4914 |
+ |
4915 |
+ implicit none |
4916 |
+@@ -323,9 +323,9 @@ |
4917 |
+ use module_xc |
4918 |
+ use vdwcorrection |
4919 |
+ use esatto |
4920 |
+- use m_ab6_symmetry |
4921 |
+- use m_ab6_mixing |
4922 |
+- use m_ab6_kpoints |
4923 |
++ use m_ab7_symmetry |
4924 |
++ use m_ab7_mixing |
4925 |
++ use m_ab7_kpoints |
4926 |
+ implicit none |
4927 |
+ integer, intent(in) :: nproc,iproc |
4928 |
+ real(gp), intent(inout) :: hx_old,hy_old,hz_old |
4929 |
+diff -urN bigdft-abi-1.0.4.old/src/cluster.f90 bigdft-abi-1.0.4.new/src/cluster.f90 |
4930 |
+--- bigdft-abi-1.0.4.old/src/cluster.f90 2012-11-29 11:18:04.000000000 +0100 |
4931 |
++++ bigdft-abi-1.0.4.new/src/cluster.f90 2013-06-11 16:51:00.000000000 +0200 |
4932 |
+@@ -192,7 +192,7 @@ |
4933 |
+ ! use Poisson_Solver |
4934 |
+ use module_xc |
4935 |
+ ! use vdwcorrection |
4936 |
+- use m_ab6_mixing |
4937 |
++ use m_ab7_mixing |
4938 |
+ use yaml_output |
4939 |
+ implicit none |
4940 |
+ integer, intent(in) :: nproc,iproc |
4941 |
+@@ -1140,7 +1140,7 @@ |
4942 |
+ use module_types |
4943 |
+ use module_interfaces, except_this_one => kswfn_optimization_loop |
4944 |
+ use yaml_output |
4945 |
+- use m_ab6_mixing |
4946 |
++ use m_ab7_mixing |
4947 |
+ implicit none |
4948 |
+ real(dp), dimension(6), intent(out) :: xcstr |
4949 |
+ integer, intent(in) :: iproc, nproc, idsx, inputpsi |
4950 |
+@@ -1306,7 +1306,7 @@ |
4951 |
+ if (nproc > 1) call MPI_BARRIER(MPI_COMM_WORLD,ierr) |
4952 |
+ !call kswfn_free_scf_data(KSwfn, (nproc > 1)) |
4953 |
+ !if (opt%iscf /= SCF_KIND_DIRECT_MINIMIZATION) then |
4954 |
+- ! call ab6_mixing_deallocate(denspot%mix) |
4955 |
++ ! call ab7_mixing_deallocate(denspot%mix) |
4956 |
+ ! deallocate(denspot%mix) |
4957 |
+ !end if |
4958 |
+ !>todo: change this return into a clean out of the routine, so the YAML is clean. |
4959 |
+diff -urN bigdft-abi-1.0.4.old/src/distances.f90 bigdft-abi-1.0.4.new/src/distances.f90 |
4960 |
+--- bigdft-abi-1.0.4.old/src/distances.f90 2012-07-09 16:43:33.000000000 +0200 |
4961 |
++++ bigdft-abi-1.0.4.new/src/distances.f90 2013-06-11 16:51:00.000000000 +0200 |
4962 |
+@@ -275,7 +275,7 @@ |
4963 |
+ subroutine box_features(whichone,contcar,nrep,nat,ntypes,iatype,pos,factor) |
4964 |
+ use BigDFT_API |
4965 |
+ use module_interfaces |
4966 |
+- use m_ab6_symmetry |
4967 |
++ use m_ab7_symmetry |
4968 |
+ implicit none |
4969 |
+ character(len=1), intent(in) :: whichone |
4970 |
+ character(len=40), intent(in) :: contcar |
4971 |
+@@ -375,7 +375,7 @@ |
4972 |
+ subroutine read_pos(iunit,whichone,nat,pos,nrep) |
4973 |
+ use BigDFT_API |
4974 |
+ use module_interfaces |
4975 |
+- use m_ab6_symmetry |
4976 |
++ use m_ab7_symmetry |
4977 |
+ implicit none |
4978 |
+ character(len=1), intent(in) :: whichone |
4979 |
+ integer, intent(in) :: iunit,nat,nrep |
4980 |
+diff -urN bigdft-abi-1.0.4.old/src/forces.f90 bigdft-abi-1.0.4.new/src/forces.f90 |
4981 |
+--- bigdft-abi-1.0.4.old/src/forces.f90 2012-07-09 16:43:33.000000000 +0200 |
4982 |
++++ bigdft-abi-1.0.4.new/src/forces.f90 2013-06-11 16:51:00.000000000 +0200 |
4983 |
+@@ -3757,7 +3757,7 @@ |
4984 |
+ subroutine symm_stress(dump,tens,symobj) |
4985 |
+ use defs_basis |
4986 |
+ use module_base, only: verbose,gp |
4987 |
+- use m_ab6_symmetry |
4988 |
++ use m_ab7_symmetry |
4989 |
+ use module_types |
4990 |
+ implicit none |
4991 |
+ !Arguments |
4992 |
+@@ -3773,7 +3773,7 @@ |
4993 |
+ real(gp),dimension(3,3) :: symtens |
4994 |
+ |
4995 |
+ call symmetry_get_matrices_p(symObj, nsym, sym, transNon, symAfm, errno) |
4996 |
+- if (errno /= AB6_NO_ERROR) stop |
4997 |
++ if (errno /= AB7_NO_ERROR) stop |
4998 |
+ if (nsym < 2) return |
4999 |
+ |
5000 |
+ if (dump)& |
5001 |
+@@ -3824,7 +3824,7 @@ |
5002 |
+ !> Symmetrize the atomic forces (needed with special k points) |
5003 |
+ subroutine symmetrise_forces(iproc, fxyz, at) |
5004 |
+ use defs_basis |
5005 |
+- use m_ab6_symmetry |
5006 |
++ use m_ab7_symmetry |
5007 |
+ use module_types |
5008 |
+ |
5009 |
+ implicit none |
5010 |
+@@ -3833,7 +3833,7 @@ |
5011 |
+ type(atoms_data), intent(in) :: at |
5012 |
+ real(gp), intent(inout) :: fxyz(3, at%nat) |
5013 |
+ integer :: ia, mu, isym, errno, ind, nsym |
5014 |
+- integer :: indsym(4, AB6_MAX_SYMMETRIES) |
5015 |
++ integer :: indsym(4, AB7_MAX_SYMMETRIES) |
5016 |
+ real(gp) :: summ |
5017 |
+ real(gp) :: alat(3) |
5018 |
+ real(gp), allocatable :: dedt(:,:) |
5019 |
+@@ -3843,7 +3843,7 @@ |
5020 |
+ real(gp), pointer :: transNon(:,:) |
5021 |
+ |
5022 |
+ call symmetry_get_matrices_p(at%sym%symObj, nsym, sym, transNon, symAfm, errno) |
5023 |
+- if (errno /= AB6_NO_ERROR) stop |
5024 |
++ if (errno /= AB7_NO_ERROR) stop |
5025 |
+ if (nsym < 2) return |
5026 |
+ |
5027 |
+ if (iproc == 0) write(*,"(1x,A,I0,A)") "Symmetrise forces with ", nsym, " symmetries." |
5028 |
+@@ -3866,7 +3866,7 @@ |
5029 |
+ ! actually conduct symmetrization |
5030 |
+ do ia = 1, at%nat |
5031 |
+ call symmetry_get_equivalent_atom(at%sym%symObj, indsym, ia, errno) |
5032 |
+- if (errno /= AB6_NO_ERROR) stop |
5033 |
++ if (errno /= AB7_NO_ERROR) stop |
5034 |
+ do mu = 1, 3 |
5035 |
+ summ = real(0, gp) |
5036 |
+ do isym = 1, nsym |
5037 |
+diff -urN bigdft-abi-1.0.4.old/src/frequencies.f90 bigdft-abi-1.0.4.new/src/frequencies.f90 |
5038 |
+--- bigdft-abi-1.0.4.old/src/frequencies.f90 2012-07-09 16:43:33.000000000 +0200 |
5039 |
++++ bigdft-abi-1.0.4.new/src/frequencies.f90 2013-06-11 16:51:00.000000000 +0200 |
5040 |
+@@ -20,7 +20,7 @@ |
5041 |
+ use module_base |
5042 |
+ use module_types |
5043 |
+ use module_interfaces |
5044 |
+- use m_ab6_symmetry |
5045 |
++ use m_ab7_symmetry |
5046 |
+ use yaml_output |
5047 |
+ implicit none |
5048 |
+ |
5049 |
+diff -urN bigdft-abi-1.0.4.old/src/geometry.f90 bigdft-abi-1.0.4.new/src/geometry.f90 |
5050 |
+--- bigdft-abi-1.0.4.old/src/geometry.f90 2012-07-09 16:43:33.000000000 +0200 |
5051 |
++++ bigdft-abi-1.0.4.new/src/geometry.f90 2013-06-11 16:51:00.000000000 +0200 |
5052 |
+@@ -159,7 +159,7 @@ |
5053 |
+ use module_base |
5054 |
+ use module_types |
5055 |
+ use scfloop_API |
5056 |
+- use ab6_moldyn |
5057 |
++ use ab7_moldyn |
5058 |
+ implicit none |
5059 |
+ integer, intent(in) :: nproc,iproc |
5060 |
+ integer, intent(inout) :: ncount_bigdft |
5061 |
+diff -urN bigdft-abi-1.0.4.old/src/hpsiortho.f90 bigdft-abi-1.0.4.new/src/hpsiortho.f90 |
5062 |
+--- bigdft-abi-1.0.4.old/src/hpsiortho.f90 2013-01-30 10:10:56.000000000 +0100 |
5063 |
++++ bigdft-abi-1.0.4.new/src/hpsiortho.f90 2013-06-11 16:51:00.000000000 +0200 |
5064 |
+@@ -17,7 +17,7 @@ |
5065 |
+ use module_types |
5066 |
+ use module_interfaces, fake_name => psitohpsi |
5067 |
+ use Poisson_Solver |
5068 |
+- use m_ab6_mixing |
5069 |
++ use m_ab7_mixing |
5070 |
+ use yaml_output |
5071 |
+ implicit none |
5072 |
+ logical, intent(in) :: scf |
5073 |
+@@ -144,7 +144,7 @@ |
5074 |
+ |
5075 |
+ !here the density can be mixed |
5076 |
+ if (iscf > SCF_KIND_DIRECT_MINIMIZATION ) then |
5077 |
+- if (denspot%mix%kind == AB6_MIXING_DENSITY) then |
5078 |
++ if (denspot%mix%kind == AB7_MIXING_DENSITY) then |
5079 |
+ call mix_rhopot(iproc,nproc,denspot%mix%nfft*denspot%mix%nspden,alphamix,denspot%mix,& |
5080 |
+ denspot%rhov,itrp,wfn%Lzd%Glr%d%n1i,wfn%Lzd%Glr%d%n2i,wfn%Lzd%Glr%d%n3i,& |
5081 |
+ atoms%alat1*atoms%alat2*atoms%alat3,&!hx*hy*hz,& !volume should be used |
5082 |
+@@ -215,7 +215,7 @@ |
5083 |
+ |
5084 |
+ !here the potential can be mixed |
5085 |
+ if (iscf > SCF_KIND_DIRECT_MINIMIZATION ) then |
5086 |
+- if (denspot%mix%kind == AB6_MIXING_POTENTIAL) then |
5087 |
++ if (denspot%mix%kind == AB7_MIXING_POTENTIAL) then |
5088 |
+ call mix_rhopot(iproc,nproc,denspot%mix%nfft*denspot%mix%nspden,alphamix,denspot%mix,& |
5089 |
+ denspot%rhov,itrp,wfn%Lzd%Glr%d%n1i,wfn%Lzd%Glr%d%n2i,wfn%Lzd%Glr%d%n3i,& |
5090 |
+ atoms%alat1*atoms%alat2*atoms%alat3,&!volume should be used |
5091 |
+diff -urN bigdft-abi-1.0.4.old/src/init/atoms.f90 bigdft-abi-1.0.4.new/src/init/atoms.f90 |
5092 |
+--- bigdft-abi-1.0.4.old/src/init/atoms.f90 2012-07-09 16:43:33.000000000 +0200 |
5093 |
++++ bigdft-abi-1.0.4.new/src/init/atoms.f90 2013-06-11 16:51:00.000000000 +0200 |
5094 |
+@@ -210,7 +210,7 @@ |
5095 |
+ use module_base |
5096 |
+ use module_types |
5097 |
+ use defs_basis |
5098 |
+- use m_ab6_symmetry |
5099 |
++ use m_ab7_symmetry |
5100 |
+ implicit none |
5101 |
+ type(atoms_data), intent(inout) :: atoms |
5102 |
+ real(gp), dimension(3,atoms%nat), intent(in) :: rxyz |
5103 |
+@@ -1901,8 +1901,8 @@ |
5104 |
+ subroutine symmetry_set_irreductible_zone(sym, geocode, n1i, n2i, n3i, nspin) |
5105 |
+ use module_base |
5106 |
+ use module_types |
5107 |
+- use m_ab6_kpoints |
5108 |
+- use m_ab6_symmetry |
5109 |
++ use m_ab7_kpoints |
5110 |
++ use m_ab7_symmetry |
5111 |
+ implicit none |
5112 |
+ type(symmetry_data), intent(inout) :: sym |
5113 |
+ integer, intent(in) :: n1i, n2i, n3i, nspin |
5114 |
+diff -urN bigdft-abi-1.0.4.old/src/init/denspotd.f90 bigdft-abi-1.0.4.new/src/init/denspotd.f90 |
5115 |
+--- bigdft-abi-1.0.4.old/src/init/denspotd.f90 2012-07-09 16:43:33.000000000 +0200 |
5116 |
++++ bigdft-abi-1.0.4.new/src/init/denspotd.f90 2013-06-11 16:51:00.000000000 +0200 |
5117 |
+@@ -95,7 +95,7 @@ |
5118 |
+ & n1i, n2i) !to be removed arguments when denspot has dimensions |
5119 |
+ use module_base |
5120 |
+ use module_types |
5121 |
+- use m_ab6_mixing |
5122 |
++ use m_ab7_mixing |
5123 |
+ implicit none |
5124 |
+ type(DFT_local_fields), intent(inout) :: denspot |
5125 |
+ integer, intent(in) :: iscf, n1i, n2i, nspin |
5126 |
+@@ -104,20 +104,20 @@ |
5127 |
+ character(len=500) :: errmess |
5128 |
+ |
5129 |
+ if (iscf < 10) then |
5130 |
+- potden = AB6_MIXING_POTENTIAL |
5131 |
++ potden = AB7_MIXING_POTENTIAL |
5132 |
+ npoints = n1i*n2i*denspot%dpbox%n3p |
5133 |
+ if (denspot%dpbox%n3p==0) npoints=1 |
5134 |
+ else |
5135 |
+- potden = AB6_MIXING_DENSITY |
5136 |
++ potden = AB7_MIXING_DENSITY |
5137 |
+ npoints = n1i*n2i*denspot%dpbox%n3d |
5138 |
+ if (denspot%dpbox%n3d==0) npoints=1 |
5139 |
+ end if |
5140 |
+ if (iscf > SCF_KIND_DIRECT_MINIMIZATION) then |
5141 |
+ allocate(denspot%mix) |
5142 |
+- call ab6_mixing_new(denspot%mix, modulo(iscf, 10), potden, & |
5143 |
+- AB6_MIXING_REAL_SPACE, npoints, nspin, 0, & |
5144 |
++ call ab7_mixing_new(denspot%mix, modulo(iscf, 10), potden, & |
5145 |
++ AB7_MIXING_REAL_SPACE, npoints, nspin, 0, & |
5146 |
+ ierr, errmess, useprec = .false.) |
5147 |
+- call ab6_mixing_eval_allocate(denspot%mix) |
5148 |
++ call ab7_mixing_eval_allocate(denspot%mix) |
5149 |
+ else |
5150 |
+ nullify(denspot%mix) |
5151 |
+ end if |
5152 |
+@@ -125,12 +125,12 @@ |
5153 |
+ |
5154 |
+ subroutine denspot_free_history(denspot) |
5155 |
+ use module_types |
5156 |
+- use m_ab6_mixing |
5157 |
++ use m_ab7_mixing |
5158 |
+ implicit none |
5159 |
+ type(DFT_local_fields), intent(inout) :: denspot |
5160 |
+ |
5161 |
+ if (associated(denspot%mix)) then |
5162 |
+- call ab6_mixing_deallocate(denspot%mix) |
5163 |
++ call ab7_mixing_deallocate(denspot%mix) |
5164 |
+ deallocate(denspot%mix) |
5165 |
+ end if |
5166 |
+ end subroutine denspot_free_history |
5167 |
+@@ -396,7 +396,7 @@ |
5168 |
+ use module_base |
5169 |
+ use module_types |
5170 |
+ use module_interfaces, except_this_one => allocateRhoPot |
5171 |
+- use m_ab6_mixing |
5172 |
++ use m_ab7_mixing |
5173 |
+ implicit none |
5174 |
+ integer, intent(in) :: iproc,nspin |
5175 |
+ type(locreg_descriptors), intent(in) :: Glr |
5176 |
+diff -urN bigdft-abi-1.0.4.old/src/init/sysprop.f90 bigdft-abi-1.0.4.new/src/init/sysprop.f90 |
5177 |
+--- bigdft-abi-1.0.4.old/src/init/sysprop.f90 2012-07-09 16:43:33.000000000 +0200 |
5178 |
++++ bigdft-abi-1.0.4.new/src/init/sysprop.f90 2013-06-11 16:51:00.000000000 +0200 |
5179 |
+@@ -879,7 +879,7 @@ |
5180 |
+ use module_base |
5181 |
+ use module_types |
5182 |
+ use module_xc |
5183 |
+- use m_ab6_symmetry |
5184 |
++ use m_ab7_symmetry |
5185 |
+ implicit none |
5186 |
+ character (len=*), intent(in) :: fileocc |
5187 |
+ type(atoms_data), intent(inout) :: atoms |
5188 |
+diff -urN bigdft-abi-1.0.4.old/src/input_variables.f90 bigdft-abi-1.0.4.new/src/input_variables.f90 |
5189 |
+--- bigdft-abi-1.0.4.old/src/input_variables.f90 2012-07-09 16:43:33.000000000 +0200 |
5190 |
++++ bigdft-abi-1.0.4.new/src/input_variables.f90 2013-06-11 16:51:00.000000000 +0200 |
5191 |
+@@ -908,7 +908,7 @@ |
5192 |
+ use module_base |
5193 |
+ use module_types |
5194 |
+ use defs_basis |
5195 |
+- use m_ab6_kpoints |
5196 |
++ use m_ab7_kpoints |
5197 |
+ use module_input |
5198 |
+ implicit none |
5199 |
+ character(len=*), intent(in) :: filename |
5200 |
+@@ -958,7 +958,7 @@ |
5201 |
+ comment='Equivalent length of K-space resolution (Bohr)') |
5202 |
+ call kpoints_get_auto_k_grid(sym%symObj, in%nkpt, in%kpt, in%wkpt, & |
5203 |
+ & kptrlen, ierror) |
5204 |
+- if (ierror /= AB6_NO_ERROR) then |
5205 |
++ if (ierror /= AB7_NO_ERROR) then |
5206 |
+ if (iproc==0) write(*,*) " ERROR in symmetry library. Error code is ", ierror |
5207 |
+ stop |
5208 |
+ end if |
5209 |
+@@ -984,7 +984,7 @@ |
5210 |
+ end do |
5211 |
+ call kpoints_get_mp_k_grid(sym%symObj, in%nkpt, in%kpt, in%wkpt, & |
5212 |
+ & ngkpt, nshiftk, shiftk, ierror) |
5213 |
+- if (ierror /= AB6_NO_ERROR) then |
5214 |
++ if (ierror /= AB7_NO_ERROR) then |
5215 |
+ if (iproc==0) write(*,*) " ERROR in symmetry library. Error code is ", ierror |
5216 |
+ stop |
5217 |
+ end if |
5218 |
+@@ -1126,7 +1126,7 @@ |
5219 |
+ use module_base |
5220 |
+ use module_types |
5221 |
+ use defs_basis |
5222 |
+- use m_ab6_kpoints |
5223 |
++ use m_ab7_kpoints |
5224 |
+ implicit none |
5225 |
+ character(len=*), intent(in) :: filename |
5226 |
+ integer, intent(in) :: iproc |
5227 |
+@@ -1178,11 +1178,11 @@ |
5228 |
+ call check() |
5229 |
+ call kpoints_get_auto_k_grid(atoms%sym%symObj, in%nkpt, in%kpt, in%wkpt, & |
5230 |
+ & kptrlen, ierror) |
5231 |
+- if (ierror /= AB6_NO_ERROR) then |
5232 |
++ if (ierror /= AB7_NO_ERROR) then |
5233 |
+ if (iproc==0) write(*,*) " ERROR in symmetry library. Error code is ", ierror |
5234 |
+ stop |
5235 |
+ end if |
5236 |
+- ! in%kpt and in%wkpt will be allocated by ab6_symmetry routine. |
5237 |
++ ! in%kpt and in%wkpt will be allocated by ab7_symmetry routine. |
5238 |
+ call memocc(0,in%kpt,'in%kpt',subname) |
5239 |
+ call memocc(0,in%wkpt,'in%wkpt',subname) |
5240 |
+ else if (trim(type) == "MPgrid" .or. trim(type) == "mpgrid") then |
5241 |
+@@ -1198,11 +1198,11 @@ |
5242 |
+ if (atoms%geocode == 'F') ngkpt = 1 |
5243 |
+ call kpoints_get_mp_k_grid(atoms%sym%symObj, in%nkpt, in%kpt, in%wkpt, & |
5244 |
+ & ngkpt, nshiftk, shiftk, ierror) |
5245 |
+- if (ierror /= AB6_NO_ERROR) then |
5246 |
++ if (ierror /= AB7_NO_ERROR) then |
5247 |
+ if (iproc==0) write(*,*) " ERROR in symmetry library. Error code is ", ierror |
5248 |
+ stop |
5249 |
+ end if |
5250 |
+- ! in%kpt and in%wkpt will be allocated by ab6_symmetry routine. |
5251 |
++ ! in%kpt and in%wkpt will be allocated by ab7_symmetry routine. |
5252 |
+ call memocc(0,in%kpt,'in%kpt',subname) |
5253 |
+ call memocc(0,in%wkpt,'in%wkpt',subname) |
5254 |
+ else if (trim(type) == "manual" .or. trim(type) == "Manual") then |
5255 |
+@@ -1858,7 +1858,7 @@ |
5256 |
+ use module_base |
5257 |
+ use module_types |
5258 |
+ use module_interfaces, except_this_one => read_atomic_file |
5259 |
+- use m_ab6_symmetry |
5260 |
++ use m_ab7_symmetry |
5261 |
+ use position_files |
5262 |
+ implicit none |
5263 |
+ character(len=*), intent(in) :: file |
5264 |
+@@ -2430,7 +2430,7 @@ |
5265 |
+ use module_base |
5266 |
+ use module_types |
5267 |
+ use module_interfaces, except_this_one => initialize_atomic_file |
5268 |
+- use m_ab6_symmetry |
5269 |
++ use m_ab7_symmetry |
5270 |
+ implicit none |
5271 |
+ integer, intent(in) :: iproc |
5272 |
+ type(atoms_data), intent(inout) :: atoms |
5273 |
+diff -urN bigdft-abi-1.0.4.old/src/memguess.f90 bigdft-abi-1.0.4.new/src/memguess.f90 |
5274 |
+--- bigdft-abi-1.0.4.old/src/memguess.f90 2012-07-09 16:43:33.000000000 +0200 |
5275 |
++++ bigdft-abi-1.0.4.new/src/memguess.f90 2013-06-11 16:51:00.000000000 +0200 |
5276 |
+@@ -16,7 +16,7 @@ |
5277 |
+ use module_types |
5278 |
+ use module_interfaces |
5279 |
+ use module_xc |
5280 |
+- use m_ab6_symmetry |
5281 |
++ use m_ab7_symmetry |
5282 |
+ |
5283 |
+ implicit none |
5284 |
+ character(len=*), parameter :: subname='memguess' |
5285 |
+diff -urN bigdft-abi-1.0.4.old/src/modules/defs.F90 bigdft-abi-1.0.4.new/src/modules/defs.F90 |
5286 |
+--- bigdft-abi-1.0.4.old/src/modules/defs.F90 2012-07-09 16:43:33.000000000 +0200 |
5287 |
++++ bigdft-abi-1.0.4.new/src/modules/defs.F90 2013-06-11 16:51:00.000000000 +0200 |
5288 |
+@@ -1074,7 +1074,7 @@ |
5289 |
+ end subroutine herk_double |
5290 |
+ |
5291 |
+ function fnrm_denpot(x,cplex,nfft,nspden,opt_denpot,user_data) |
5292 |
+- use m_ab6_mixing |
5293 |
++ use m_ab7_mixing |
5294 |
+ implicit none |
5295 |
+ integer, intent(in) :: cplex,nfft,nspden,opt_denpot |
5296 |
+ double precision, intent(in) :: x(*) |
5297 |
+@@ -1084,7 +1084,7 @@ |
5298 |
+ double precision :: fnrm_denpot, ar, nrm_local, dnrm2 |
5299 |
+ |
5300 |
+ ! In case of density, we use nscatterarr. |
5301 |
+- if (opt_denpot == AB6_MIXING_DENSITY) then |
5302 |
++ if (opt_denpot == AB7_MIXING_DENSITY) then |
5303 |
+ call MPI_COMM_RANK(MPI_COMM_WORLD,iproc,ierr) |
5304 |
+ if (ierr /= 0) then |
5305 |
+ call MPI_ABORT(MPI_COMM_WORLD, ierr, ie) |
5306 |
+@@ -1125,7 +1125,7 @@ |
5307 |
+ end function fnrm_denpot |
5308 |
+ |
5309 |
+ function fdot_denpot(x,y,cplex,nfft,nspden,opt_denpot,user_data) |
5310 |
+- use m_ab6_mixing |
5311 |
++ use m_ab7_mixing |
5312 |
+ implicit none |
5313 |
+ integer, intent(in) :: cplex,nfft,nspden,opt_denpot |
5314 |
+ double precision, intent(in) :: x(*), y(*) |
5315 |
+@@ -1135,7 +1135,7 @@ |
5316 |
+ double precision :: fdot_denpot, ar, dot_local, ddot |
5317 |
+ |
5318 |
+ ! In case of density, we use nscatterarr. |
5319 |
+- if (opt_denpot == AB6_MIXING_DENSITY) then |
5320 |
++ if (opt_denpot == AB7_MIXING_DENSITY) then |
5321 |
+ call MPI_COMM_RANK(MPI_COMM_WORLD,iproc,ierr) |
5322 |
+ if (ierr /= 0) then |
5323 |
+ call MPI_ABORT(MPI_COMM_WORLD, ierr, ie) |
5324 |
+diff -urN bigdft-abi-1.0.4.old/src/modules/interfaces.f90 bigdft-abi-1.0.4.new/src/modules/interfaces.f90 |
5325 |
+--- bigdft-abi-1.0.4.old/src/modules/interfaces.f90 2013-01-03 10:10:13.000000000 +0100 |
5326 |
++++ bigdft-abi-1.0.4.new/src/modules/interfaces.f90 2013-06-11 16:51:00.000000000 +0200 |
5327 |
+@@ -5857,7 +5857,7 @@ |
5328 |
+ energs,rpnrm,xcstr,proj_G,paw) |
5329 |
+ use module_base |
5330 |
+ use module_types |
5331 |
+- use m_ab6_mixing |
5332 |
++ use m_ab7_mixing |
5333 |
+ implicit none |
5334 |
+ logical, intent(in) :: scf |
5335 |
+ integer, intent(in) :: iproc,nproc,itrp,iscf,ixc,linflag,itwfn |
5336 |
+diff -urN bigdft-abi-1.0.4.old/src/modules/types.f90 bigdft-abi-1.0.4.new/src/modules/types.f90 |
5337 |
+--- bigdft-abi-1.0.4.old/src/modules/types.f90 2013-01-03 10:18:08.000000000 +0100 |
5338 |
++++ bigdft-abi-1.0.4.new/src/modules/types.f90 2013-06-11 16:51:00.000000000 +0200 |
5339 |
+@@ -12,7 +12,7 @@ |
5340 |
+ !! and the routines of allocations and de-allocations |
5341 |
+ module module_types |
5342 |
+ |
5343 |
+- use m_ab6_mixing, only : ab6_mixing_object |
5344 |
++ use m_ab7_mixing, only : ab7_mixing_object |
5345 |
+ use module_base, only : gp,wp,dp,tp,uninitialized |
5346 |
+ implicit none |
5347 |
+ |
5348 |
+@@ -828,7 +828,7 @@ |
5349 |
+ type, public :: DFT_local_fields |
5350 |
+ real(dp), dimension(:), pointer :: rhov !< generic workspace. What is there is indicated by rhov_is |
5351 |
+ |
5352 |
+- type(ab6_mixing_object), pointer :: mix !< History of rhov, allocated only when using diagonalisation |
5353 |
++ type(ab7_mixing_object), pointer :: mix !< History of rhov, allocated only when using diagonalisation |
5354 |
+ !local fields which are associated to their name |
5355 |
+ !normally given in parallel distribution |
5356 |
+ real(dp), dimension(:,:), pointer :: rho_psi !< density as given by square of el. WFN |
5357 |
+@@ -1658,7 +1658,7 @@ |
5358 |
+ |
5359 |
+ subroutine deallocate_symmetry(sym, subname) |
5360 |
+ use module_base |
5361 |
+- use m_ab6_symmetry |
5362 |
++ use m_ab7_symmetry |
5363 |
+ implicit none |
5364 |
+ type(symmetry_data), intent(inout) :: sym |
5365 |
+ character(len = *), intent(in) :: subname |
5366 |
+diff -urN bigdft-abi-1.0.4.old/src/output.f90 bigdft-abi-1.0.4.new/src/output.f90 |
5367 |
+--- bigdft-abi-1.0.4.old/src/output.f90 2012-07-09 16:43:33.000000000 +0200 |
5368 |
++++ bigdft-abi-1.0.4.new/src/output.f90 2013-06-11 16:51:00.000000000 +0200 |
5369 |
+@@ -63,7 +63,7 @@ |
5370 |
+ use module_base |
5371 |
+ use module_types |
5372 |
+ use defs_basis |
5373 |
+- use m_ab6_symmetry |
5374 |
++ use m_ab7_symmetry |
5375 |
+ implicit none |
5376 |
+ !Arguments |
5377 |
+ integer, intent(in) :: nproc |
5378 |
+@@ -71,9 +71,9 @@ |
5379 |
+ type(atoms_data), intent(in) :: atoms |
5380 |
+ |
5381 |
+ integer :: nSym, ierr, ityp, iat, i, lg |
5382 |
+- integer :: sym(3, 3, AB6_MAX_SYMMETRIES) |
5383 |
+- integer :: symAfm(AB6_MAX_SYMMETRIES) |
5384 |
+- real(gp) :: transNon(3, AB6_MAX_SYMMETRIES) |
5385 |
++ integer :: sym(3, 3, AB7_MAX_SYMMETRIES) |
5386 |
++ integer :: symAfm(AB7_MAX_SYMMETRIES) |
5387 |
++ real(gp) :: transNon(3, AB7_MAX_SYMMETRIES) |
5388 |
+ real(gp) :: genAfm(3) |
5389 |
+ character(len=15) :: spaceGroup |
5390 |
+ integer :: spaceGroupId, pointGroupMagn |
5391 |
+@@ -138,7 +138,7 @@ |
5392 |
+ call symmetry_get_matrices(atoms%sym%symObj, nSym, sym, transNon, symAfm, ierr) |
5393 |
+ call symmetry_get_group(atoms%sym%symObj, spaceGroup, & |
5394 |
+ & spaceGroupId, pointGroupMagn, genAfm, ierr) |
5395 |
+- if (ierr == AB6_ERROR_SYM_NOT_PRIMITIVE) write(spaceGroup, "(A)") "not prim." |
5396 |
++ if (ierr == AB7_ERROR_SYM_NOT_PRIMITIVE) write(spaceGroup, "(A)") "not prim." |
5397 |
+ write(add(1), '(a,i0)') "N. sym. = ", nSym |
5398 |
+ write(add(2), '(a,a,a)') "Sp. group = ", trim(spaceGroup) |
5399 |
+ else if (atoms%geocode /= 'F' .and. input%disableSym) then |
5400 |
+diff -urN bigdft-abi-1.0.4.old/src/splinedsaddle.f90 bigdft-abi-1.0.4.new/src/splinedsaddle.f90 |
5401 |
+--- bigdft-abi-1.0.4.old/src/splinedsaddle.f90 2012-07-09 16:43:33.000000000 +0200 |
5402 |
++++ bigdft-abi-1.0.4.new/src/splinedsaddle.f90 2013-06-11 16:51:00.000000000 +0200 |
5403 |
+@@ -14,7 +14,7 @@ |
5404 |
+ use module_base |
5405 |
+ use module_types |
5406 |
+ use module_interfaces |
5407 |
+- use m_ab6_symmetry |
5408 |
++ use m_ab7_symmetry |
5409 |
+ use yaml_output |
5410 |
+ implicit none |
5411 |
+ character(len=*), parameter :: subname='BigDFT' |
5412 |
+diff -urN bigdft-abi-1.0.4.old/src/sumrho.f90 bigdft-abi-1.0.4.new/src/sumrho.f90 |
5413 |
+--- bigdft-abi-1.0.4.old/src/sumrho.f90 2012-07-09 16:43:33.000000000 +0200 |
5414 |
++++ bigdft-abi-1.0.4.new/src/sumrho.f90 2013-06-11 16:51:00.000000000 +0200 |
5415 |
+@@ -719,7 +719,7 @@ |
5416 |
+ sym) |
5417 |
+ use module_base!, only: gp,dp,wp,ndebug,memocc |
5418 |
+ use module_types |
5419 |
+- use m_ab6_symmetry |
5420 |
++ use m_ab7_symmetry |
5421 |
+ |
5422 |
+ implicit none |
5423 |
+ integer, intent(in) :: iproc,nproc,nspin, n1i, n2i, n3i |
5424 |
+diff -urN bigdft-abi-1.0.4.old/src/test_forces.f90 bigdft-abi-1.0.4.new/src/test_forces.f90 |
5425 |
+--- bigdft-abi-1.0.4.old/src/test_forces.f90 2012-07-09 16:43:33.000000000 +0200 |
5426 |
++++ bigdft-abi-1.0.4.new/src/test_forces.f90 2013-06-11 16:51:00.000000000 +0200 |
5427 |
+@@ -22,7 +22,7 @@ |
5428 |
+ use module_base |
5429 |
+ use module_types |
5430 |
+ use module_interfaces |
5431 |
+- use m_ab6_symmetry |
5432 |
++ use m_ab7_symmetry |
5433 |
+ |
5434 |
+ implicit none |
5435 |
+ character(len=*), parameter :: subname='test_forces' |
5436 |
+diff -urN bigdft-abi-1.0.4.old/src/wfn_opt/diis.f90 bigdft-abi-1.0.4.new/src/wfn_opt/diis.f90 |
5437 |
+--- bigdft-abi-1.0.4.old/src/wfn_opt/diis.f90 2012-08-22 09:55:24.000000000 +0200 |
5438 |
++++ bigdft-abi-1.0.4.new/src/wfn_opt/diis.f90 2013-06-11 16:51:00.000000000 +0200 |
5439 |
+@@ -459,13 +459,13 @@ |
5440 |
+ subroutine mix_rhopot(iproc,nproc,npoints,alphamix,mix,rhopot,istep,& |
5441 |
+ & n1,n2,n3,ucvol,rpnrm,nscatterarr) |
5442 |
+ use module_base |
5443 |
+- use defs_basis, only: AB6_NO_ERROR |
5444 |
+- use m_ab6_mixing |
5445 |
++ use defs_basis, only: AB7_NO_ERROR |
5446 |
++ use m_ab7_mixing |
5447 |
+ implicit none |
5448 |
+ integer, intent(in) :: npoints, istep, n1, n2, n3, nproc, iproc |
5449 |
+ real(gp), intent(in) :: alphamix, ucvol |
5450 |
+ integer, dimension(0:nproc-1,4), intent(in) :: nscatterarr |
5451 |
+- type(ab6_mixing_object), intent(inout) :: mix |
5452 |
++ type(ab7_mixing_object), intent(inout) :: mix |
5453 |
+ real(dp), dimension(npoints), intent(inout) :: rhopot |
5454 |
+ real(gp), intent(out) :: rpnrm |
5455 |
+ !local variables |
5456 |
+@@ -497,10 +497,10 @@ |
5457 |
+ end do |
5458 |
+ |
5459 |
+ ! Do the mixing |
5460 |
+- call ab6_mixing_eval(mix, rhopot, istep, n1 * n2 * n3, ucvol, & |
5461 |
++ call ab7_mixing_eval(mix, rhopot, istep, n1 * n2 * n3, ucvol, & |
5462 |
+ & MPI_COMM_WORLD, (nproc > 1), ierr, errmess, resnrm = rpnrm, & |
5463 |
+ & fnrm = fnrm_denpot, fdot = fdot_denpot, user_data = user_data) |
5464 |
+- if (ierr /= AB6_NO_ERROR) then |
5465 |
++ if (ierr /= AB7_NO_ERROR) then |
5466 |
+ if (iproc == 0) write(0,*) errmess |
5467 |
+ call MPI_ABORT(MPI_COMM_WORLD, ierr, ie) |
5468 |
+ end if |
5469 |
|
5470 |
diff --git a/sci-libs/bigdft-abi/files/bigdft-abi-1.0.4-0006.patch b/sci-libs/bigdft-abi/files/bigdft-abi-1.0.4-0006.patch |
5471 |
new file mode 100644 |
5472 |
index 0000000..56a67fc |
5473 |
--- /dev/null |
5474 |
+++ b/sci-libs/bigdft-abi/files/bigdft-abi-1.0.4-0006.patch |
5475 |
@@ -0,0 +1,43 @@ |
5476 |
+diff -urN bigdft-abi-1.0.4.old/configure bigdft-abi-1.0.4.new/configure |
5477 |
+--- bigdft-abi-1.0.4.old/configure 2012-10-05 15:10:27.000000000 +0200 |
5478 |
++++ bigdft-abi-1.0.4.new/configure 2013-06-11 16:51:00.000000000 +0200 |
5479 |
+@@ -9185,15 +9185,15 @@ |
5480 |
+ withlibabinit=no |
5481 |
+ fi |
5482 |
+ |
5483 |
+- as_ac_File=`$as_echo "ac_cv_file_$ac_libabinit_dir/include/ab6_moldyn.$ax_fc_mod_ext" | $as_tr_sh` |
5484 |
+-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_libabinit_dir/include/ab6_moldyn.$ax_fc_mod_ext" >&5 |
5485 |
+-$as_echo_n "checking for $ac_libabinit_dir/include/ab6_moldyn.$ax_fc_mod_ext... " >&6; } |
5486 |
++ as_ac_File=`$as_echo "ac_cv_file_$ac_libabinit_dir/include/ab7_moldyn.$ax_fc_mod_ext" | $as_tr_sh` |
5487 |
++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_libabinit_dir/include/ab7_moldyn.$ax_fc_mod_ext" >&5 |
5488 |
++$as_echo_n "checking for $ac_libabinit_dir/include/ab7_moldyn.$ax_fc_mod_ext... " >&6; } |
5489 |
+ if eval \${$as_ac_File+:} false; then : |
5490 |
+ $as_echo_n "(cached) " >&6 |
5491 |
+ else |
5492 |
+ test "$cross_compiling" = yes && |
5493 |
+ as_fn_error $? "cannot check for file existence when cross compiling" "$LINENO" 5 |
5494 |
+-if test -r "$ac_libabinit_dir/include/ab6_moldyn.$ax_fc_mod_ext"; then |
5495 |
++if test -r "$ac_libabinit_dir/include/ab7_moldyn.$ax_fc_mod_ext"; then |
5496 |
+ eval "$as_ac_File=yes" |
5497 |
+ else |
5498 |
+ eval "$as_ac_File=no" |
5499 |
+@@ -9208,15 +9208,15 @@ |
5500 |
+ moldyn="no" |
5501 |
+ fi |
5502 |
+ |
5503 |
+- as_ac_File=`$as_echo "ac_cv_file_$ac_libabinit_dir/include/ab6_symmetry.$ax_fc_mod_ext" | $as_tr_sh` |
5504 |
+-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_libabinit_dir/include/ab6_symmetry.$ax_fc_mod_ext" >&5 |
5505 |
+-$as_echo_n "checking for $ac_libabinit_dir/include/ab6_symmetry.$ax_fc_mod_ext... " >&6; } |
5506 |
++ as_ac_File=`$as_echo "ac_cv_file_$ac_libabinit_dir/include/ab7_symmetry.$ax_fc_mod_ext" | $as_tr_sh` |
5507 |
++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_libabinit_dir/include/ab7_symmetry.$ax_fc_mod_ext" >&5 |
5508 |
++$as_echo_n "checking for $ac_libabinit_dir/include/ab7_symmetry.$ax_fc_mod_ext... " >&6; } |
5509 |
+ if eval \${$as_ac_File+:} false; then : |
5510 |
+ $as_echo_n "(cached) " >&6 |
5511 |
+ else |
5512 |
+ test "$cross_compiling" = yes && |
5513 |
+ as_fn_error $? "cannot check for file existence when cross compiling" "$LINENO" 5 |
5514 |
+-if test -r "$ac_libabinit_dir/include/ab6_symmetry.$ax_fc_mod_ext"; then |
5515 |
++if test -r "$ac_libabinit_dir/include/ab7_symmetry.$ax_fc_mod_ext"; then |
5516 |
+ eval "$as_ac_File=yes" |
5517 |
+ else |
5518 |
+ eval "$as_ac_File=no" |
5519 |
|
5520 |
diff --git a/sci-libs/bigdft-abi/files/bigdft-abi-1.0.4-0007.patch b/sci-libs/bigdft-abi/files/bigdft-abi-1.0.4-0007.patch |
5521 |
new file mode 100644 |
5522 |
index 0000000..8f871d8 |
5523 |
--- /dev/null |
5524 |
+++ b/sci-libs/bigdft-abi/files/bigdft-abi-1.0.4-0007.patch |
5525 |
@@ -0,0 +1,344 @@ |
5526 |
+diff -crB bigdft-abi-1.0.4/src/init/projectors.f90 bigdft-patch/src/init/projectors.f90 |
5527 |
+*** bigdft-abi-1.0.4/src/init/projectors.f90 Thu Nov 29 11:09:02 2012 |
5528 |
+--- bigdft-patch/src/init/projectors.f90 Thu Jun 6 11:31:46 2013 |
5529 |
+*************** |
5530 |
+*** 383,394 **** |
5531 |
+ END SUBROUTINE fill_projectors |
5532 |
+ |
5533 |
+ subroutine atom_projector_paw(ikpt,iat,idir,istart_c,iproj,nprojel,& |
5534 |
+! lr,hx,hy,hz,rxyz,at,orbs,plr,proj,nwarnings,proj_G) |
5535 |
+ use module_base |
5536 |
+ use module_types |
5537 |
+ implicit none |
5538 |
+ integer, intent(in) :: iat,idir,ikpt,nprojel |
5539 |
+! real(gp), intent(in) :: hx,hy,hz |
5540 |
+ type(atoms_data), intent(in) :: at |
5541 |
+ type(orbitals_data), intent(in) :: orbs |
5542 |
+ type(locreg_descriptors), intent(in) :: plr |
5543 |
+--- 383,394 ---- |
5544 |
+ END SUBROUTINE fill_projectors |
5545 |
+ |
5546 |
+ subroutine atom_projector_paw(ikpt,iat,idir,istart_c,iproj,nprojel,& |
5547 |
+! lr,hx,hy,hz,rpaw,rxyz,at,orbs,plr,proj,nwarnings,proj_G) |
5548 |
+ use module_base |
5549 |
+ use module_types |
5550 |
+ implicit none |
5551 |
+ integer, intent(in) :: iat,idir,ikpt,nprojel |
5552 |
+! real(gp), intent(in) :: hx,hy,hz,rpaw |
5553 |
+ type(atoms_data), intent(in) :: at |
5554 |
+ type(orbitals_data), intent(in) :: orbs |
5555 |
+ type(locreg_descriptors), intent(in) :: plr |
5556 |
+*************** |
5557 |
+*** 460,466 **** |
5558 |
+ ! plr%wfd%keyvglob,plr%wfd%keyglob,proj_tmp(1),nwarnings) |
5559 |
+ !END DEBUG |
5560 |
+ call projector_paw(at%geocode,at%atomnames(ityp),iat,idir,l,i,& |
5561 |
+! proj_G%psiat(:,jj),proj_G%xp(:,jj),rxyz(1),lr,& |
5562 |
+ hx,hy,hz,kx,ky,kz,proj_G%ncplx,ncplx_k,& |
5563 |
+ mbvctr_c,mbvctr_f,mbseg_c,mbseg_f,& |
5564 |
+ plr%wfd%keyvglob,plr%wfd%keyglob,proj_tmp(1),nwarnings) |
5565 |
+--- 460,466 ---- |
5566 |
+ ! plr%wfd%keyvglob,plr%wfd%keyglob,proj_tmp(1),nwarnings) |
5567 |
+ !END DEBUG |
5568 |
+ call projector_paw(at%geocode,at%atomnames(ityp),iat,idir,l,i,& |
5569 |
+! proj_G%psiat(:,jj),proj_G%xp(:,jj),rpaw,rxyz(1),lr,& |
5570 |
+ hx,hy,hz,kx,ky,kz,proj_G%ncplx,ncplx_k,& |
5571 |
+ mbvctr_c,mbvctr_f,mbseg_c,mbseg_f,& |
5572 |
+ plr%wfd%keyvglob,plr%wfd%keyglob,proj_tmp(1),nwarnings) |
5573 |
+*************** |
5574 |
+*** 646,651 **** |
5575 |
+--- 646,652 ---- |
5576 |
+ integer :: istart_c,nterm,idir2 |
5577 |
+ real(gp) :: fpi,factor,rx,ry,rz |
5578 |
+ real(dp) :: scpr |
5579 |
++ real(gp) :: gau_cut !dummy here just for PAW |
5580 |
+ integer, dimension(3) :: nterm_arr |
5581 |
+ integer, dimension(nterm_max) :: lx,ly,lz |
5582 |
+ integer, dimension(3,nterm_max,3) :: lxyz_arr |
5583 |
+*************** |
5584 |
+*** 709,715 **** |
5585 |
+ |
5586 |
+ call crtproj(geocode,nterm,lr,hx,hy,hz,kx,ky,kz,& |
5587 |
+ ncplx_g,ncplx,& |
5588 |
+! gau_a,factors,rx,ry,rz,lx,ly,lz,& |
5589 |
+ mbvctr_c,mbvctr_f,mseg_c,mseg_f,keyv_p,keyg_p,proj(istart_c)) |
5590 |
+ |
5591 |
+ ! testing |
5592 |
+--- 710,716 ---- |
5593 |
+ |
5594 |
+ call crtproj(geocode,nterm,lr,hx,hy,hz,kx,ky,kz,& |
5595 |
+ ncplx_g,ncplx,& |
5596 |
+! gau_a,gau_cut,factors,rx,ry,rz,lx,ly,lz,& |
5597 |
+ mbvctr_c,mbvctr_f,mseg_c,mseg_f,keyv_p,keyg_p,proj(istart_c)) |
5598 |
+ |
5599 |
+ ! testing |
5600 |
+*************** |
5601 |
+*** 1055,1061 **** |
5602 |
+ end subroutine projector_paw_isf |
5603 |
+ |
5604 |
+ subroutine projector_paw(geocode,atomname,iat,idir,l,i,& |
5605 |
+! factor,gau_a,rxyz,lr,& |
5606 |
+ hx,hy,hz,kx,ky,kz,ncplx_g,ncplx_k,& |
5607 |
+ mbvctr_c,mbvctr_f,mseg_c,mseg_f,keyv_p,keyg_p,proj,nwarnings) |
5608 |
+ use module_base |
5609 |
+--- 1056,1062 ---- |
5610 |
+ end subroutine projector_paw_isf |
5611 |
+ |
5612 |
+ subroutine projector_paw(geocode,atomname,iat,idir,l,i,& |
5613 |
+! factor,gau_a,gau_cut,rxyz,lr,& |
5614 |
+ hx,hy,hz,kx,ky,kz,ncplx_g,ncplx_k,& |
5615 |
+ mbvctr_c,mbvctr_f,mseg_c,mseg_f,keyv_p,keyg_p,proj,nwarnings) |
5616 |
+ use module_base |
5617 |
+*************** |
5618 |
+*** 1066,1072 **** |
5619 |
+ integer, intent(in) :: iat,idir,l,i,mbvctr_c,mbvctr_f,mseg_c,mseg_f |
5620 |
+ integer, intent(in) :: ncplx_k,ncplx_g |
5621 |
+ type(locreg_descriptors),intent(in) :: lr |
5622 |
+! real(gp), intent(in) :: hx,hy,hz,kx,ky,kz |
5623 |
+ !integer, dimension(2,3), intent(in) :: nboxp_c,nboxp_f |
5624 |
+ integer, dimension(mseg_c+mseg_f), intent(in) :: keyv_p |
5625 |
+ integer, dimension(2,mseg_c+mseg_f), intent(in) :: keyg_p |
5626 |
+--- 1067,1073 ---- |
5627 |
+ integer, intent(in) :: iat,idir,l,i,mbvctr_c,mbvctr_f,mseg_c,mseg_f |
5628 |
+ integer, intent(in) :: ncplx_k,ncplx_g |
5629 |
+ type(locreg_descriptors),intent(in) :: lr |
5630 |
+! real(gp), intent(in) :: hx,hy,hz,kx,ky,kz,gau_cut |
5631 |
+ !integer, dimension(2,3), intent(in) :: nboxp_c,nboxp_f |
5632 |
+ integer, dimension(mseg_c+mseg_f), intent(in) :: keyv_p |
5633 |
+ integer, dimension(2,mseg_c+mseg_f), intent(in) :: keyg_p |
5634 |
+*************** |
5635 |
+*** 1131,1137 **** |
5636 |
+ |
5637 |
+ call crtproj(geocode,nterm,lr,hx,hy,hz,kx,ky,kz,& |
5638 |
+ ncplx_g,ncplx_k,& |
5639 |
+! gau_a,factors(1:ncplx_g,1:nterm),& |
5640 |
+ rx,ry,rz,lx(1:nterm),ly(1:nterm),lz(1:nterm),& |
5641 |
+ mbvctr_c,mbvctr_f,mseg_c,mseg_f,keyv_p,keyg_p,& |
5642 |
+ proj(istart_c)) |
5643 |
+--- 1132,1138 ---- |
5644 |
+ |
5645 |
+ call crtproj(geocode,nterm,lr,hx,hy,hz,kx,ky,kz,& |
5646 |
+ ncplx_g,ncplx_k,& |
5647 |
+! gau_a,gau_cut,factors(1:ncplx_g,1:nterm),& |
5648 |
+ rx,ry,rz,lx(1:nterm),ly(1:nterm),lz(1:nterm),& |
5649 |
+ mbvctr_c,mbvctr_f,mseg_c,mseg_f,keyv_p,keyg_p,& |
5650 |
+ proj(istart_c)) |
5651 |
+*************** |
5652 |
+*** 1248,1254 **** |
5653 |
+ !! in the arrays proj_c, proj_f |
5654 |
+ subroutine crtproj(geocode,nterm,lr, & |
5655 |
+ hx,hy,hz,kx,ky,kz,ncplx_g,ncplx_k,& |
5656 |
+! gau_a,fac_arr,rx,ry,rz,lx,ly,lz, & |
5657 |
+ mvctr_c,mvctr_f,mseg_c,mseg_f,keyv_p,keyg_p,proj) |
5658 |
+ use module_base |
5659 |
+ use module_types |
5660 |
+--- 1249,1255 ---- |
5661 |
+ !! in the arrays proj_c, proj_f |
5662 |
+ subroutine crtproj(geocode,nterm,lr, & |
5663 |
+ hx,hy,hz,kx,ky,kz,ncplx_g,ncplx_k,& |
5664 |
+! gau_a,gau_cut,fac_arr,rx,ry,rz,lx,ly,lz, & |
5665 |
+ mvctr_c,mvctr_f,mseg_c,mseg_f,keyv_p,keyg_p,proj) |
5666 |
+ use module_base |
5667 |
+ use module_types |
5668 |
+*************** |
5669 |
+*** 1256,1262 **** |
5670 |
+ character(len=1), intent(in) :: geocode |
5671 |
+ integer, intent(in) :: nterm,mvctr_c,mvctr_f,mseg_c,mseg_f |
5672 |
+ integer, intent(in) :: ncplx_g,ncplx_k |
5673 |
+! real(gp), intent(in) :: hx,hy,hz,rx,ry,rz,kx,ky,kz |
5674 |
+ integer, dimension(nterm), intent(in) :: lx,ly,lz |
5675 |
+ real(gp), dimension(ncplx_g,nterm), intent(in) :: fac_arr |
5676 |
+ real(gp), dimension(ncplx_g),intent(in):: gau_a |
5677 |
+--- 1257,1263 ---- |
5678 |
+ character(len=1), intent(in) :: geocode |
5679 |
+ integer, intent(in) :: nterm,mvctr_c,mvctr_f,mseg_c,mseg_f |
5680 |
+ integer, intent(in) :: ncplx_g,ncplx_k |
5681 |
+! real(gp), intent(in) :: hx,hy,hz,rx,ry,rz,kx,ky,kz,gau_cut |
5682 |
+ integer, dimension(nterm), intent(in) :: lx,ly,lz |
5683 |
+ real(gp), dimension(ncplx_g,nterm), intent(in) :: fac_arr |
5684 |
+ real(gp), dimension(ncplx_g),intent(in):: gau_a |
5685 |
+*************** |
5686 |
+*** 1313,1327 **** |
5687 |
+ |
5688 |
+ factor(:)=fac_arr(:,iterm) |
5689 |
+ n_gau=lx(iterm) |
5690 |
+! call gauss_to_daub_k(hx,kx*hx,ncplx_w,ncplx_g,ncplx_k,factor,rx,gau_a,n_gau,ns1,n1,ml1,mu1,& |
5691 |
+ wprojx(1,0,1,iterm),work,nw,perx) |
5692 |
+ |
5693 |
+ n_gau=ly(iterm) |
5694 |
+! call gauss_to_daub_k(hy,ky*hy,ncplx_w,ncplx_g,ncplx_k,1.d0,ry,gau_a,n_gau,ns2,n2,ml2,mu2,& |
5695 |
+ wprojy(1,0,1,iterm),work,nw,pery) |
5696 |
+ |
5697 |
+ n_gau=lz(iterm) |
5698 |
+! call gauss_to_daub_k(hz,kz*hz,ncplx_w,ncplx_g,ncplx_k,1.d0,rz,gau_a,n_gau,ns3,n3,ml3,mu3,& |
5699 |
+ wprojz(1,0,1,iterm),work,nw,perz) |
5700 |
+ end do |
5701 |
+ !the filling of the projector should be different if ncplx_k==1 or 2 |
5702 |
+--- 1314,1328 ---- |
5703 |
+ |
5704 |
+ factor(:)=fac_arr(:,iterm) |
5705 |
+ n_gau=lx(iterm) |
5706 |
+! call gauss_to_daub_k(hx,kx*hx,ncplx_w,ncplx_g,ncplx_k,factor,rx,gau_a,gau_cut,n_gau,ns1,n1,ml1,mu1,& |
5707 |
+ wprojx(1,0,1,iterm),work,nw,perx) |
5708 |
+ |
5709 |
+ n_gau=ly(iterm) |
5710 |
+! call gauss_to_daub_k(hy,ky*hy,ncplx_w,ncplx_g,ncplx_k,1.d0,ry,gau_a,gau_cut,n_gau,ns2,n2,ml2,mu2,& |
5711 |
+ wprojy(1,0,1,iterm),work,nw,pery) |
5712 |
+ |
5713 |
+ n_gau=lz(iterm) |
5714 |
+! call gauss_to_daub_k(hz,kz*hz,ncplx_w,ncplx_g,ncplx_k,1.d0,rz,gau_a,gau_cut,n_gau,ns3,n3,ml3,mu3,& |
5715 |
+ wprojz(1,0,1,iterm),work,nw,perz) |
5716 |
+ end do |
5717 |
+ !the filling of the projector should be different if ncplx_k==1 or 2 |
5718 |
+diff -crB bigdft-abi-1.0.4/src/modules/types.f90 bigdft-patch/src/modules/types.f90 |
5719 |
+*** bigdft-abi-1.0.4/src/modules/types.f90 Thu Jan 3 10:18:08 2013 |
5720 |
+--- bigdft-patch/src/modules/types.f90 Thu Jun 6 11:27:48 2013 |
5721 |
+*************** |
5722 |
+*** 1119,1124 **** |
5723 |
+--- 1119,1125 ---- |
5724 |
+ type(cprj_objects),dimension(:,:),allocatable :: cprj |
5725 |
+ real(wp),dimension(:),pointer :: spsi |
5726 |
+ real(wp),dimension(:,:),pointer :: sij |
5727 |
++ real(dp),dimension(:),pointer :: rpaw |
5728 |
+ end type paw_objects |
5729 |
+ |
5730 |
+ contains |
5731 |
+*************** |
5732 |
+*** 2090,2095 **** |
5733 |
+--- 2091,2097 ---- |
5734 |
+ nullify(paw%indlmn) |
5735 |
+ nullify(paw%spsi) |
5736 |
+ nullify(paw%sij) |
5737 |
++ nullify(paw%rpaw) |
5738 |
+ |
5739 |
+ if(present(rholoc)) then |
5740 |
+ nullify(rholoc%msz) |
5741 |
+diff -crB bigdft-abi-1.0.4/src/wavelib/gauss_to_daub.f90 bigdft-patch/src/wavelib/gauss_to_daub.f90 |
5742 |
+*** bigdft-abi-1.0.4/src/wavelib/gauss_to_daub.f90 Mon Jul 9 16:43:33 2012 |
5743 |
+--- bigdft-patch/src/wavelib/gauss_to_daub.f90 Thu Jun 6 13:01:01 2013 |
5744 |
+*************** |
5745 |
+*** 448,454 **** |
5746 |
+ !! In this version, we dephase the projector to wrt the center of the gaussian |
5747 |
+ !! this should not have an impact on the results since the operator is unchanged |
5748 |
+ subroutine gauss_to_daub_k(hgrid,kval,ncplx_w,ncplx_g,ncplx_k,& |
5749 |
+! factor,gau_cen,gau_a,n_gau,&!no err, errsuc |
5750 |
+ nstart,nmax,n_left,n_right,c,& |
5751 |
+ ww,nwork,periodic) !added work arrays ww with dimension nwork |
5752 |
+ use module_base |
5753 |
+--- 448,454 ---- |
5754 |
+ !! In this version, we dephase the projector to wrt the center of the gaussian |
5755 |
+ !! this should not have an impact on the results since the operator is unchanged |
5756 |
+ subroutine gauss_to_daub_k(hgrid,kval,ncplx_w,ncplx_g,ncplx_k,& |
5757 |
+! factor,gau_cen,gau_a,gau_cut,n_gau,&!no err, errsuc |
5758 |
+ nstart,nmax,n_left,n_right,c,& |
5759 |
+ ww,nwork,periodic) !added work arrays ww with dimension nwork |
5760 |
+ use module_base |
5761 |
+*************** |
5762 |
+*** 458,464 **** |
5763 |
+ integer, intent(in) :: ncplx_w !size of the ww matrix |
5764 |
+ integer, intent(in) :: ncplx_g !1 or 2 for simple or complex gaussians, respectively. |
5765 |
+ integer, intent(in) :: ncplx_k !use 2 for k-points. |
5766 |
+! real(gp), intent(in) :: hgrid,gau_cen,kval |
5767 |
+ real(gp),dimension(ncplx_g),intent(in)::factor,gau_a |
5768 |
+ real(wp), dimension(0:nwork,2,ncplx_w), intent(inout) :: ww |
5769 |
+ integer, intent(out) :: n_left,n_right |
5770 |
+--- 458,464 ---- |
5771 |
+ integer, intent(in) :: ncplx_w !size of the ww matrix |
5772 |
+ integer, intent(in) :: ncplx_g !1 or 2 for simple or complex gaussians, respectively. |
5773 |
+ integer, intent(in) :: ncplx_k !use 2 for k-points. |
5774 |
+! real(gp), intent(in) :: hgrid,gau_cen,kval,gau_cut |
5775 |
+ real(gp),dimension(ncplx_g),intent(in)::factor,gau_a |
5776 |
+ real(wp), dimension(0:nwork,2,ncplx_w), intent(inout) :: ww |
5777 |
+ integer, intent(out) :: n_left,n_right |
5778 |
+*************** |
5779 |
+*** 467,473 **** |
5780 |
+ character(len=*), parameter :: subname='gauss_to_daub_k' |
5781 |
+ integer :: i_all,i_stat |
5782 |
+ integer :: rightx,leftx,right_t,i0,i,k,length,j,icplx |
5783 |
+! real(gp) :: a1,a2,z0,h,x,r,coeff,r2,rk |
5784 |
+ real(gp) :: fac(ncplx_g) |
5785 |
+ real(wp) :: func,cval,sval,cval2,sval2 |
5786 |
+ real(wp), dimension(:,:,:), allocatable :: cc |
5787 |
+--- 467,473 ---- |
5788 |
+ character(len=*), parameter :: subname='gauss_to_daub_k' |
5789 |
+ integer :: i_all,i_stat |
5790 |
+ integer :: rightx,leftx,right_t,i0,i,k,length,j,icplx |
5791 |
+! real(gp) :: a1,a2,z0,h,x,r,coeff,r2,rk,gcut |
5792 |
+ real(gp) :: fac(ncplx_g) |
5793 |
+ real(wp) :: func,cval,sval,cval2,sval2 |
5794 |
+ real(wp), dimension(:,:,:), allocatable :: cc |
5795 |
+*************** |
5796 |
+*** 487,492 **** |
5797 |
+--- 487,493 ---- |
5798 |
+ end if |
5799 |
+ i0=nint(gau_cen/hgrid) ! the array is centered at i0 |
5800 |
+ z0=gau_cen/hgrid-real(i0,gp) |
5801 |
++ gcut=gau_cut/hgrid |
5802 |
+ h=.125_gp*.5_gp |
5803 |
+ |
5804 |
+ !calculate the array sizes; |
5805 |
+*************** |
5806 |
+*** 655,681 **** |
5807 |
+ do i=leftx,rightx |
5808 |
+ x=real(i-i0*16,gp)*h |
5809 |
+ r=x-z0 |
5810 |
+! r2=r*r |
5811 |
+! cval=real(cos(a2*r2),wp) |
5812 |
+! sval=real(sin(a2*r2),wp) |
5813 |
+! r2=0.5_gp*r2/(a1**2) |
5814 |
+! func=real(dexp(-real(r2,kind=8)),wp) |
5815 |
+! ww(i-leftx,1,1)=func*cval |
5816 |
+! ww(i-leftx,1,2)=func*sval |
5817 |
+ enddo |
5818 |
+ else |
5819 |
+ do i=leftx,rightx |
5820 |
+ x=real(i-i0*16,gp)*h |
5821 |
+ r=x-z0 |
5822 |
+! r2=r*r |
5823 |
+! cval=real(cos(a2*r2),wp) |
5824 |
+! sval=real(sin(a2*r2),wp) |
5825 |
+! coeff=r**n_gau |
5826 |
+! r2=0.5_gp*r2/(a1**2) |
5827 |
+! func=real(dexp(-real(r2,kind=8)),wp) |
5828 |
+! func=real(coeff,wp)*func |
5829 |
+! ww(i-leftx,1,1)=func*cval |
5830 |
+! ww(i-leftx,1,2)=func*sval |
5831 |
+ enddo |
5832 |
+ end if |
5833 |
+ |
5834 |
+--- 656,690 ---- |
5835 |
+ do i=leftx,rightx |
5836 |
+ x=real(i-i0*16,gp)*h |
5837 |
+ r=x-z0 |
5838 |
+! if(abs(r)-gcut < 1e-8) then |
5839 |
+! r2=r*r |
5840 |
+! cval=real(cos(a2*r2),wp) |
5841 |
+! sval=real(sin(a2*r2),wp) |
5842 |
+! r2=0.5_gp*r2/(a1**2) |
5843 |
+! func=real(dexp(-real(r2,kind=8)),wp) |
5844 |
+! ww(i-leftx,1,1)=func*cval |
5845 |
+! ww(i-leftx,1,2)=func*sval |
5846 |
+! else |
5847 |
+! ww(i-leftx,1,:)=0.0_wp |
5848 |
+! end if |
5849 |
+ enddo |
5850 |
+ else |
5851 |
+ do i=leftx,rightx |
5852 |
+ x=real(i-i0*16,gp)*h |
5853 |
+ r=x-z0 |
5854 |
+! if( abs(r)-gcut < 1e-8 ) then |
5855 |
+! r2=r*r |
5856 |
+! cval=real(cos(a2*r2),wp) |
5857 |
+! sval=real(sin(a2*r2),wp) |
5858 |
+! coeff=r**n_gau |
5859 |
+! r2=0.5_gp*r2/(a1**2) |
5860 |
+! func=real(dexp(-real(r2,kind=8)),wp) |
5861 |
+! func=real(coeff,wp)*func |
5862 |
+! ww(i-leftx,1,1)=func*cval |
5863 |
+! ww(i-leftx,1,2)=func*sval |
5864 |
+! else |
5865 |
+! ww(i-leftx,1,:)=0.0_wp |
5866 |
+! end if |
5867 |
+ enddo |
5868 |
+ end if |
5869 |
+ |