Line data Source code
1 : !!****m*ABINIT/m_anaddb_dataset
2 : !! NAME
3 : !! m_anaddb_dataset
4 : !!
5 : !! FUNCTION
6 : !!
7 : !! COPYRIGHT
8 : !! Copyright (C) 2014-2026 ABINIT group (XG,JCC,CL,MVeithen,XW,MJV)
9 : !! This file is distributed under the terms of the
10 : !! GNU General Public License, see ~abinit/COPYING
11 : !! or http://www.gnu.org/copyleft/gpl.txt .
12 : !!
13 : !! SOURCE
14 :
15 : #if defined HAVE_CONFIG_H
16 : #include "config.h"
17 : #endif
18 :
19 : #include "abi_common.h"
20 :
21 : module m_anaddb_dataset
22 :
23 : use defs_basis
24 : use m_xmpi
25 : use m_abicore
26 : use m_errors
27 : use m_nctk
28 : use netcdf
29 :
30 : use m_parser, only : instrng
31 : use m_fstrings, only : next_token, rmquotes, sjoin, inupper, ltoa, itoa, basename
32 : use m_clib, only : clib_mkdir_if_needed
33 : use m_matrix, only : mati3det
34 : use m_parser, only : intagm, chkvars_in_string, instrng
35 : use m_crystal, only : crystal_t
36 : use m_ddb, only : DDB_QTOL, chkin9
37 : use m_ddb_hdr, only : ddb_hdr_type
38 :
39 : implicit none
40 :
41 : private
42 :
43 : public:: anaddb_dataset_type
44 : !!***
45 :
46 : !----------------------------------------------------------------------
47 :
48 : !!****t*m_anaddb_dataset/anaddb_dataset_type
49 : !! NAME
50 : !! anaddb_dataset_type
51 : !!
52 : !! FUNCTION
53 : !! The anaddb_dataset_type structured datatype
54 : !! gather all the input variables for the anaddb code.
55 : !!
56 : !! SOURCE
57 :
58 : type anaddb_dataset_type
59 :
60 : ! Variables should be declared on separated lines in order to reduce the occurence of git conflicts.
61 : ! Since all these input variables are described in the anaddb_help.html
62 : ! file, they are not described in length here ...
63 : ! Integer
64 : integer:: alphon
65 : integer:: asr
66 : integer:: brav
67 : integer:: chneut
68 : integer:: dieflag
69 : integer:: dipdip
70 : integer:: dipquad
71 : integer:: dossum
72 : integer:: dos_maxmode
73 : integer:: ep_scalprod
74 : integer:: eivec
75 : integer:: elaflag
76 : integer:: elphflag
77 : integer:: enunit
78 : integer:: flexoflag
79 : integer:: freqflag
80 : integer:: gkk2write
81 : integer:: gkk_rptwrite
82 : integer:: gkqwrite
83 : integer:: gruns_nddbs
84 : integer:: ifcana
85 : integer:: ifcflag
86 : integer:: ifcout
87 : integer:: ifltransport
88 : integer:: instrflag
89 : integer:: lwf_anchor_proj
90 : integer:: lwf_disentangle
91 : integer:: lwf_nwann
92 : integer:: lwfflag
93 : integer:: mpopt
94 : integer:: natfix
95 : integer:: natifc
96 : integer:: natprj_bs
97 : integer:: nchan
98 : integer:: ndivsm = 20
99 : integer:: nfreq
100 : integer:: ngrids
101 : integer:: nlflag
102 : integer:: nph1l
103 : integer:: nph2l
104 : integer:: nqpath
105 : integer:: nqshft
106 : integer:: nsphere
107 : integer:: nstrfix
108 : integer:: ntemper
109 : integer:: nwchan
110 : integer:: outboltztrap
111 : integer:: piezoflag
112 : integer:: polflag
113 : integer:: prtdos
114 : integer:: prt_ifc
115 : integer:: prtddb
116 : integer:: prtmbm
117 : integer:: prtfsurf
118 : integer:: prtnest
119 : integer:: prtphbands
120 : integer:: prtsrlr ! print the short-range/long-range decomposition of phonon freq.
121 : integer:: prtvol = 0
122 : integer:: ramansr
123 : integer:: relaxat
124 : integer:: relaxstr
125 : integer:: rfmeth
126 : integer:: selectz
127 : integer:: symdynmat
128 : integer:: sys_dim
129 : integer:: telphint
130 : integer:: thmflag
131 : integer:: qgrid_type
132 : integer:: quadquad
133 : integer:: ep_b_min
134 : integer:: ep_b_max
135 : integer:: ep_int_gkk
136 : integer:: ep_keepbands
137 : integer:: ep_nqpt
138 : integer:: ep_nspline
139 : integer:: ep_prt_yambo
140 : integer:: symgkq
141 : integer:: timdisp
142 : integer:: use_k_fine
143 : integer:: prtbltztrp
144 :
145 : ! These are not input variables, but important dimensions read from ddb
146 : integer:: natom
147 : integer:: msize
148 : integer:: mpert
149 :
150 : integer:: ngqpt(9) ! ngqpt(9) instead of ngqpt(3) is needed in wght9.f
151 : integer:: istrfix(6)
152 : integer:: lwf_ngqpt(3)
153 : integer:: ng2qpt(3)
154 : integer:: qrefine(3)
155 : integer:: kptrlatt(3, 3)
156 : integer:: kptrlatt_fine(3, 3)
157 : integer:: thermal_supercell(3, 3)
158 : integer:: mpatpol(2)
159 : integer:: mpdir(3)
160 :
161 : ! Real(dp)
162 : real(dp):: a2fsmear
163 : real(dp):: band_gap
164 : real(dp):: dielt_env
165 : real(dp):: dielt_thick(2)
166 : real(dp):: dosdeltae
167 : real(dp):: dossmear
168 : real(dp):: dostol
169 : real(dp):: elphsmear
170 : real(dp):: elph_fermie
171 : real(dp):: ep_extrael
172 : real(dp):: eta
173 : real(dp):: freeze_displ
174 : real(dp):: frmax
175 : real(dp):: frmin
176 :
177 : real(dp):: lwf_anchor_qpt(3)
178 : real(dp):: lwf_mu
179 : real(dp):: lwf_sigma
180 : real(dp):: magpen
181 : real(dp):: mustar
182 : real(dp):: temperinc
183 : real(dp):: tempermin
184 : real(dp):: thmtol
185 : real(dp):: rifcsph
186 :
187 : real(dp):: q1shft(3, 4)
188 : real(dp):: q2shft(3)
189 : real(dp):: targetpol(3)
190 : real(dp):: vs_qrad_tolkms(2) = 0
191 :
192 : character(len=fnlen):: filename_input
193 : character(len=fnlen):: filename_output
194 : character(len=fnlen):: prefix_outdata
195 : character(len=fnlen):: filename_ddb
196 : character(len=fnlen):: filename_ddk
197 : character(len=fnlen):: prefix_eph
198 : character(len=fnlen):: filename_gkk
199 : character(len=fnlen):: filename_eigr2d
200 :
201 : character(len=strlen):: input_string
202 : ! The entire input string.
203 : integer:: lenstr ! Length of the entire input string.
204 :
205 : ! Integer arrays
206 : integer, allocatable:: atifc(:)
207 : ! atifc(natom) Atoms for which IFC should be computed.
208 :
209 : integer, allocatable:: atifcflg(:)
210 : ! atifcflg(natom) Flag (0 or 1) to tell which atom is analysed in ifc.
211 :
212 : integer, allocatable:: iatfix(:)
213 : ! iatfix(natom)
214 :
215 : integer, allocatable:: iatprj_bs(:)
216 :
217 : integer, allocatable:: lwf_anchor_iband(:)
218 : integer, allocatable:: lwf_projector(:)
219 :
220 : ! Real arrays
221 : real(dp), allocatable:: qnrml1(:)
222 : ! qnrml1(nph1l)
223 :
224 : real(dp), allocatable:: qnrml2(:)
225 : ! qnrml2(nph2l)
226 :
227 : real(dp), allocatable:: qpath(:,:)
228 : ! qpath(3, nqpath)
229 :
230 : real(dp), allocatable:: qph1l(:,:)
231 : ! qph1l(3, nph1l)
232 :
233 : real(dp), allocatable:: qph2l(:,:)
234 : ! qph2l(3, nph2l)
235 :
236 : real(dp), allocatable:: ep_qptlist(:,:)
237 : ! qph2l(3, ep_nqpt)
238 :
239 : character(len = fnlen), allocatable:: gruns_ddbs(:)
240 : ! gruns_ddbs(gruns_nddbs)
241 :
242 : contains
243 :
244 : procedure :: init => anaddb_dtset_init
245 : ! Construct the object from the dtset.
246 :
247 : procedure :: free => anaddb_dtset_free
248 : ! Free dynamic memory.
249 :
250 : procedure :: read_input => anaddb_dtset_read_input
251 : ! Read input file, and some info from the ddb or IFC.
252 :
253 : procedure :: bcast_files => anaddb_dtset_bcast_files
254 : ! Broadcast file names
255 :
256 : procedure :: outvars => outvars_anaddb
257 : ! Broadcast file names
258 :
259 : end type anaddb_dataset_type
260 : !!***
261 :
262 : contains
263 : !!***
264 :
265 : !!****f*m_anaddb_dataset/anaddb_dtset_free
266 : !!
267 : !! NAME
268 : !! anaddb_dtset_free
269 : !!
270 : !! FUNCTION
271 : !! deallocate remaining arrays in the anaddb_dtset datastructure
272 : !!
273 : !! INPUTS
274 : !! anaddb_dtset = anaddb datastructure
275 : !!
276 : !! SOURCE
277 :
278 81 : subroutine anaddb_dtset_free(dtset)
279 :
280 : !Arguments------------------------------------
281 : !scalars
282 : class(anaddb_dataset_type), intent(inout):: dtset
283 :
284 : ! *************************************************************************
285 :
286 81 : ABI_SFREE(dtset%atifc)
287 81 : ABI_SFREE(dtset%atifcflg)
288 81 : ABI_SFREE(dtset%iatfix)
289 81 : ABI_SFREE(dtset%iatprj_bs)
290 81 : ABI_SFREE(dtset%qnrml1)
291 81 : ABI_SFREE(dtset%qnrml2)
292 81 : ABI_SFREE(dtset%qpath)
293 81 : ABI_SFREE(dtset%qph1l)
294 81 : ABI_SFREE(dtset%qph2l)
295 81 : ABI_SFREE(dtset%ep_qptlist)
296 81 : ABI_SFREE(dtset%gruns_ddbs)
297 81 : if (dtset%lwfflag==1) then
298 2 : ABI_SFREE(dtset%lwf_anchor_iband)
299 79 : else if (dtset%lwfflag==2) then
300 1 : ABI_SFREE(dtset%lwf_projector)
301 : end if
302 :
303 81 : end subroutine anaddb_dtset_free
304 : !!***
305 :
306 : !----------------------------------------------------------------------
307 :
308 : !!****f*m_anaddb_dataset/invars9
309 : !!
310 : !! NAME
311 : !! invars9
312 : !!
313 : !! FUNCTION
314 : !! Open input file for the anaddb code, then reads or echoes the input information.
315 : !!
316 : !! INPUTS
317 : !! lenstr = actual length of string
318 : !! natom = number of atoms, needed for atifc
319 : !! string*(*)=string of characters containing all input variables and data
320 : !!
321 : !! OUTPUT
322 : !! dtset= (derived datatype) contains all the input variables
323 : !!
324 : !! NOTES
325 : !! Should be executed by one processor only.
326 : !!
327 : !! 27/01/2009: MJV: I have cleaned this routine extensively, putting all
328 : !! variables in alphabetical order, and in a second segment the dependent
329 : !! variables which need to be allocated depending on the dimensions read in.
330 : !! Could be divided into two routines as in abinit.
331 : !! FIXME: move checks to chkin9?
332 : !!
333 : !! SOURCE
334 :
335 81 : subroutine invars9(dtset, lenstr, natom, string)
336 :
337 : !Arguments-------------------------------
338 : !scalars
339 : integer, intent(in):: lenstr, natom
340 : character(len=*), intent(in):: string
341 : type(anaddb_dataset_type), intent(inout):: dtset
342 :
343 : !Local variables-------------------------
344 : !scalars
345 : integer, parameter:: vrsddb = 100401 ! Set routine version number here:
346 : integer, parameter:: jdtset = 1
347 : integer:: ii, iph1, iph2, marr, tread, start, idet
348 : character(len = 500):: message
349 : character(len = fnlen):: path
350 : !arrays
351 81 : integer, allocatable:: intarr(:)
352 81 : real(dp), allocatable:: dprarr(:)
353 :
354 : !*********************************************************************
355 81 : marr = 3
356 81 : ABI_MALLOC(intarr, (marr))
357 81 : ABI_MALLOC(dprarr, (marr))
358 :
359 : !copy natom to dtset
360 81 : dtset%natom = natom
361 :
362 : !=====================================================================
363 : !start reading in dimensions and non-dependent variables
364 : !=====================================================================
365 :
366 : !A
367 :
368 : !typical value for gaussian smearing of a2F function
369 81 : dtset%a2fsmear = 0.00002_dp
370 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'a2fsmear',tread, 'ENE')
371 81 : if(tread == 1) dtset%a2fsmear = dprarr(1)
372 81 : if (dtset%a2fsmear < tol6) then
373 : write(message, '(a, f10.3, a, a, a, a, a)' )&
374 0 : 'a2fsmear is ',dtset%a2fsmear, ', but only values > 1.e-6 ',ch10, &
375 0 : 'are allowed',ch10, 'Action: correct a2fsmear in your input file.'
376 0 : ABI_ERROR(message)
377 : end if
378 :
379 81 : dtset%alphon = 0
380 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'alphon',tread, 'INT')
381 81 : if(tread == 1) dtset%alphon = intarr(1)
382 : !FIXME: need a test on input value
383 :
384 81 : dtset%asr = 1
385 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'asr',tread, 'INT')
386 81 : if(tread == 1) dtset%asr = intarr(1)
387 81 : if(dtset%asr < -2 .or. dtset%asr > 6)then
388 : write(message, '(a, i0, 5a)' )&
389 0 : 'asr is ',dtset%asr, ', but the only allowed values',ch10, &
390 0 : 'are 0, 1, 2, 3, 4, 5, 6, -1 or-2 .',ch10, 'Action: correct asr in your input file.'
391 : ! Note : negative values are allowed when the acoustic sum rule
392 : ! is to be applied after the analysis of IFCs
393 : ! 3, 4 are for rotational invariance (under development)
394 : ! 5 is for hermitian imposition of the ASR
395 0 : ABI_ERROR(message)
396 : end if
397 :
398 : !B
399 :
400 : !Target band gap in eV
401 : !The default value is just a very large number that will not be used in changing the band gap
402 81 : dtset%band_gap = 999.0d0
403 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'band_gap',tread, 'DPR')
404 81 : if(tread == 1) dtset%band_gap = dprarr(1)
405 :
406 81 : dtset%brav = 1
407 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'brav',tread, 'INT')
408 81 : if(tread == 1) dtset%brav = intarr(1)
409 81 : if(dtset%brav <= -2 .or. dtset%brav >= 5 .or. dtset%brav == 0)then
410 : write(message, '(a, i0, a5)' )&
411 0 : 'brav is ',dtset%brav, ', but the only allowed values',ch10, &
412 0 : 'are-1, 1, 2, 3 or 4 .',ch10, 'Action: correct brav in your input file.'
413 0 : ABI_ERROR(message)
414 : end if
415 :
416 : !C
417 :
418 81 : dtset%chneut = 1
419 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'chneut',tread, 'INT')
420 81 : if(tread == 1) dtset%chneut = intarr(1)
421 81 : if(dtset%chneut < 0 .or. dtset%chneut > 2)then
422 : write(message, '(a, i0, 5a)' )&
423 0 : 'chneut is ',dtset%chneut, ', but the only allowed values',ch10, &
424 0 : 'are 0, 1 or 2.',ch10, 'Action: correct chneut in your input file.'
425 0 : ABI_ERROR(message)
426 : end if
427 :
428 : !D
429 :
430 81 : dtset%dieflag = 0
431 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'dieflag',tread, 'INT')
432 81 : if(tread == 1) dtset%dieflag = intarr(1)
433 81 : if(dtset%dieflag < 0 .or. dtset%dieflag > 4)then
434 : write(message, '(a, i0, 5a)' )&
435 0 : 'dieflag is ',dtset%dieflag, ', but the only allowed values',ch10, &
436 0 : 'are 0, 1, 2, 3 or 4.',ch10, 'Action: correct dieflag in your input file.'
437 0 : ABI_ERROR(message)
438 : end if
439 :
440 81 : dtset%dielt_env = one
441 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'dielt_env',tread, 'DPR')
442 81 : if(tread == 1) dtset%dielt_env = dprarr(1)
443 :
444 243 : dtset%dielt_thick(:) = 0
445 81 : call intagm(dprarr, intarr, jdtset, marr, 2, string(1:lenstr), 'dielt_thick',tread, 'DPR')
446 85 : if(tread == 1) dtset%dielt_thick(:) = dprarr(1:2)
447 81 : if(dtset%dielt_thick(1) < zero)then
448 : write(message, '(a, es14.4, 3a)' )&
449 0 : 'dielt_thick is ',dtset%dielt_thick(1), ', which is lower than 0 .',ch10, &
450 0 : 'Action: correct dielt_thick in your input file.'
451 0 : ABI_ERROR(message)
452 : end if
453 :
454 81 : dtset%dipdip = 1
455 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'dipdip',tread, 'INT')
456 81 : if(tread == 1) dtset%dipdip = intarr(1)
457 81 : if(dtset%dipdip < -1 .or. dtset%dipdip > 1)then
458 : write(message, '(a, i0, 5a)' )&
459 0 : 'dipdip is ',dtset%dipdip, ', but the only allowed values',ch10, &
460 0 : 'are-1, 0 or 1 .',ch10, 'Action: correct dipdip in your input file.'
461 0 : ABI_ERROR(message)
462 : end if
463 :
464 81 : dtset%dipquad = 1
465 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'dipquad',tread, 'INT')
466 81 : if(tread == 1) dtset%dipquad = intarr(1)
467 81 : if(dtset%dipquad < -1 .or. dtset%dipquad > 1)then
468 : write(message, '(a, i0, 5a)' )&
469 0 : 'dipquad is ',dtset%dipquad, ', but the only allowed values',ch10, &
470 0 : 'are 0 or 1 .',ch10, 'Action: correct dipquad in your input file.'
471 0 : ABI_ERROR(message)
472 : end if
473 :
474 81 : dtset%ep_scalprod = 0
475 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'ep_scalprod',tread, 'INT')
476 81 : if(tread == 1) dtset%ep_scalprod = intarr(1)
477 81 : if(dtset%ep_scalprod < 0 .or. dtset%ep_scalprod > 1) then
478 : write(message, '(a, i0, 5a)' )&
479 0 : 'ep_scalprod is ',dtset%ep_scalprod, ', but the only allowed values',ch10, &
480 0 : 'are 0 or 1.',ch10, 'Action: correct ep_scalprod in your input file.'
481 0 : ABI_ERROR(message)
482 : end if
483 :
484 81 : dtset%dosdeltae = 0.2_dp/Ha_cmm1
485 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'dosdeltae',tread, 'DPR')
486 81 : if(tread == 1) dtset%dosdeltae = dprarr(1)
487 :
488 : !FIXME : should probably be smaller
489 81 : dtset%dossmear = one/Ha_cmm1
490 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'dossmear',tread, 'DPR')
491 81 : if(tread == 1) dtset%dossmear = dprarr(1)
492 81 : if(dtset%dossmear <= zero)then
493 : write(message, '(a, es14.4, 3a)' )&
494 0 : 'dossmear is ',dtset%dossmear, ', which is lower than 0 .',ch10, &
495 0 : 'Action: correct dossmear in your input file.'
496 0 : ABI_ERROR(message)
497 : end if
498 :
499 81 : dtset%dostol = 0.25_dp
500 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'dostol',tread, 'DPR')
501 81 : if(tread == 1) dtset%dostol = dprarr(1)
502 81 : if(dtset%dostol < zero)then
503 : write(message, '(a, es14.4, 3a)' )&
504 0 : 'dostol is ',dtset%dostol, ', which is lower than 0 .',ch10, &
505 0 : 'Action: correct dostol in your input file.'
506 0 : ABI_ERROR(message)
507 : end if
508 :
509 81 : dtset%dossum = 0
510 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'dossum',tread, 'INT')
511 81 : if(tread == 1) dtset%dossum = intarr(1)
512 81 : if(dtset%dossum < 0 .or. dtset%dossum > one)then
513 : write(message, '(a, i0, 5a)' )&
514 0 : 'dossum is ',dtset%dossum, ', but the only allowed values',ch10, &
515 0 : 'are 0, 1',ch10, 'Action: correct dossum in your input file.'
516 0 : ABI_ERROR(message)
517 : end if
518 :
519 81 : dtset%dos_maxmode = 0
520 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'dos_maxmode',tread, 'INT')
521 81 : if(tread == 1) dtset%dos_maxmode = intarr(1)
522 81 : if(dtset%dos_maxmode < 0 .or. dtset%dos_maxmode > 3*natom)then
523 : write(message, '(a, i0, 5a)' )&
524 0 : 'dos_maxmode is ',dtset%dos_maxmode, ', but the only allowed values',ch10, &
525 0 : 'are 0 to 3*natom ',ch10, 'Action: correct dos_maxmode in your input file.'
526 0 : ABI_ERROR(message)
527 : end if
528 :
529 : !E
530 :
531 81 : dtset%eivec = 0
532 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'eivec',tread, 'INT')
533 81 : if(tread == 1) dtset%eivec = intarr(1)
534 81 : if(dtset%eivec < 0 .or. dtset%eivec > 4)then
535 : write(message, '(a, i0, 5a)' )&
536 0 : 'eivec is ',dtset%eivec, ', but the only allowed values',ch10, &
537 0 : 'are 0, 1, 2, 3 or 4.',ch10, 'Action: correct eivec in your input file.'
538 0 : ABI_ERROR(message)
539 : end if
540 :
541 81 : dtset%elaflag = 0
542 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'elaflag',tread, 'INT')
543 81 : if(tread == 1) dtset%elaflag = intarr(1)
544 81 : if(dtset%elaflag < 0 .or. dtset%elaflag > 5)then
545 : write(message, '(a, i0, 5a)' )&
546 0 : 'elaflag is ',dtset%elaflag, ', but the only allowed values',ch10, &
547 0 : 'are 0, 1, 2, 3, 4 or 5 .',ch10, 'Action: correct elaflag in your input file.'
548 0 : ABI_ERROR(message)
549 : end if
550 :
551 : !By default use the real fermie (tests for abs(elph_fermie) < tol10 in the code)
552 81 : dtset%elph_fermie = zero
553 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'elph_fermie',tread, 'ENE')
554 81 : if(tread == 1) dtset%elph_fermie = dprarr(1)
555 :
556 : !extra charge in unit cell (number of electrons) wrt neutral cell
557 : !holes are negative values (reduce number of electrons)
558 81 : dtset%ep_extrael = zero
559 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'ep_extrael',tread, 'DPR')
560 81 : if(tread == 1) dtset%ep_extrael = dprarr(1)
561 :
562 : !number to control the spline interpolation in RTA
563 81 : dtset%ep_nspline = 20
564 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'ep_nspline',tread, 'INT')
565 81 : if(tread == 1) dtset%ep_nspline = intarr(1)
566 81 : if(dtset%ep_nspline < 0 .or. dtset%ep_nspline > 1000) then
567 : write(message, '(a, i0, 5a)' )&
568 0 : 'ep_nspline is ',dtset%ep_nspline, ', but this should not be ',ch10, &
569 0 : 'negative or too large .',ch10, 'Action: correct ep_nspline in your input file.'
570 0 : ABI_ERROR(message)
571 : end if
572 :
573 : !interpolate gkk or gamma. It should be better to interpolate gkk onto the
574 : !k_phon, since the integration weights will be treated the same way
575 81 : dtset%ep_int_gkk = 0
576 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'ep_int_gkk',tread, 'INT')
577 81 : if(tread == 1) dtset%ep_int_gkk = intarr(1)
578 81 : if(dtset%ep_int_gkk < 0 .or. dtset%ep_int_gkk > 1) then
579 : write(message, '(a, i0, 5a)' )&
580 0 : 'ep_int_gkk is ',dtset%ep_int_gkk, ', but the only allowed values',ch10, &
581 0 : 'are 0 or 1.',ch10, 'Action: correct ep_int_gkk in your input file.'
582 0 : ABI_ERROR(message)
583 : end if
584 :
585 81 : dtset%elphflag = 0
586 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'elphflag',tread, 'INT')
587 81 : if(tread == 1) dtset%elphflag = intarr(1)
588 81 : if(dtset%elphflag < 0 .or. dtset%elphflag > 1)then
589 : write(message, '(a, i0, 5a)' )&
590 0 : 'elphflag = ',dtset%elphflag, ', but the allowed values',ch10, &
591 0 : 'are 0, or 1.',ch10, 'Action: correct elphflag in your input file.'
592 0 : ABI_ERROR(message)
593 : end if
594 :
595 : !typical value for gaussian smearing, but can vary sensibly with the metal
596 81 : dtset%elphsmear = 0.01_dp
597 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'elphsmear',tread, 'ENE')
598 81 : if(tread == 1) dtset%elphsmear = dprarr(1)
599 81 : if (dtset%elphsmear < tol6) then
600 : write(message, '(a, f10.3, 5a)' )&
601 0 : 'elphsmear is ',dtset%elphsmear, '. Only values > 1.e-6 ',ch10, &
602 0 : 'are allowed',ch10, 'Action: correct elphsmear in your input file.'
603 0 : ABI_ERROR(message)
604 : end if
605 :
606 81 : dtset%enunit = 0
607 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'enunit',tread, 'INT')
608 81 : if(tread == 1) dtset%enunit = intarr(1)
609 81 : if(dtset%enunit < 0 .or. dtset%enunit > 2)then
610 : write(message, '(a, i0, 5a)' )&
611 0 : 'enunit is ',dtset%enunit, ', but the only allowed values',ch10, &
612 0 : 'are 0, 1 or 2.',ch10, 'Action: correct enunit in your input file.'
613 0 : ABI_ERROR(message)
614 : end if
615 :
616 : !Default is 0-not used unless telphint == 2
617 81 : dtset%ep_b_max = 0
618 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'ep_b_max',tread, 'INT')
619 81 : if(tread == 1) then
620 1 : dtset%ep_b_max = intarr(1)
621 1 : if(dtset%ep_b_max < 1) then
622 : write(message, '(a, i0, 5a)' )&
623 0 : 'ep_b_max is ',dtset%ep_b_max, ', but the only allowed values',ch10, &
624 0 : 'are between 1 and nband.',ch10, 'Action: correct ep_b_max in your input file.'
625 0 : ABI_ERROR(message)
626 : end if
627 : end if
628 :
629 : !Default is 0-not used unless telphint == 2
630 81 : dtset%ep_b_min = 0
631 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'ep_b_min',tread, 'INT')
632 81 : if(tread == 1) then
633 1 : dtset%ep_b_min = intarr(1)
634 1 : if(dtset%ep_b_min < 1) then
635 : write(message, '(a, i0, 5a)' )&
636 0 : 'ep_b_min is ',dtset%ep_b_min, ', but the only allowed values',ch10, &
637 0 : 'are between 1 and nband.',ch10, 'Action: correct ep_b_min in your input file.'
638 0 : ABI_ERROR(message)
639 : end if
640 : end if
641 :
642 81 : dtset%ep_keepbands = 0
643 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'ep_keepbands',tread, 'INT')
644 81 : if(tread == 1) dtset%ep_keepbands = intarr(1)
645 81 : if(dtset%ep_keepbands < 0 .or. dtset%ep_keepbands > 1) then
646 : write(message, '(a, i0, 5a)' )&
647 0 : 'ep_keepbands is ',dtset%ep_keepbands, ', but the only allowed values',ch10, &
648 0 : 'are 0 or 1 .',ch10, 'Action: correct ep_keepbands in your input file.'
649 0 : ABI_ERROR(message)
650 : end if
651 :
652 81 : dtset%ep_nqpt = 0
653 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'ep_nqpt',tread, 'INT')
654 81 : if(tread == 1) dtset%ep_nqpt = intarr(1)
655 81 : if(dtset%ep_nqpt < 0) then
656 : write(message, '(a, i0, 5a)' )&
657 0 : 'ep_nqpt is ',dtset%ep_nqpt, ', but the only allowed values',ch10, &
658 0 : 'are > 0.',ch10, 'Action: correct ep_nqpt in your input file.'
659 0 : ABI_ERROR(message)
660 : end if
661 :
662 81 : if (dtset%ep_nqpt > 0) then
663 3 : ABI_MALLOC(dtset%ep_qptlist, (3, dtset%ep_nqpt))
664 1 : if(3*dtset%ep_nqpt > marr)then
665 1 : marr = 3*dtset%ep_nqpt
666 1 : ABI_FREE(intarr)
667 1 : ABI_FREE(dprarr)
668 3 : ABI_MALLOC(intarr, (marr))
669 3 : ABI_MALLOC(dprarr, (marr))
670 : end if
671 13 : dtset%ep_qptlist(:,:)=zero
672 1 : call intagm(dprarr, intarr, jdtset, marr, 3*dtset%ep_nqpt, string(1:lenstr), 'ep_qptlist',tread, 'DPR')
673 1 : if(tread == 1) then
674 : dtset%ep_qptlist(1:3, 1:dtset%ep_nqpt)=&
675 15 : reshape(dprarr(1:3*dtset%ep_nqpt), (/3, dtset%ep_nqpt/))
676 : else
677 : write(message, '(3a)')&
678 0 : 'ep_nqpt is non zero but ep_qptlist is absent ',ch10, &
679 0 : 'Action: specify ep_qptlist in your input file.'
680 0 : ABI_ERROR(message)
681 : end if
682 : end if
683 :
684 81 : dtset%eta = 0.00000_dp
685 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'eta',tread, 'DPR')
686 81 : if(tread == 1) dtset%eta = dprarr(1)
687 :
688 : !F
689 :
690 81 : dtset%flexoflag = 0
691 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'flexoflag',tread, 'INT')
692 81 : if(tread == 1) dtset%flexoflag = intarr(1)
693 81 : if(dtset%flexoflag < 0 .or. dtset%flexoflag > 4)then
694 : write(message, '(3a, i0, 5a)' )&
695 0 : ' flexoflag is ',dtset%flexoflag, ', but the only allowed values',ch10, &
696 0 : 'are 0, 1, 2, 3, 4 .',ch10, 'Action: correct flexoflag in your input file.'
697 0 : ABI_ERROR(message)
698 : end if
699 :
700 81 : dtset%freeze_displ = zero
701 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'freeze_displ',tread, 'DPR')
702 81 : if(tread == 1) dtset%freeze_displ = dprarr(1)
703 :
704 81 : dtset%freqflag = 0
705 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'freqflag',tread, 'INT')
706 81 : if(tread == 1) dtset%freqflag = intarr(1)
707 81 : if(dtset%freqflag < 0 .or. dtset%freqflag > 3)then
708 : write(message, '(a, i0, 5a)' )&
709 0 : 'freqflag is ',dtset%freqflag, ', but the only allowed values',ch10, &
710 0 : 'are between 0 to 3 (included).',ch10, 'Action: correct freqflag in your input file.'
711 0 : ABI_ERROR(message)
712 : end if
713 :
714 81 : dtset%frmax = ten
715 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'frmax',tread, 'DPR')
716 81 : if(tread == 1) dtset%frmax = dprarr(1)
717 : ! if (dtset%frmax < 0) then
718 : ! write(message, '(a, f10.3, 5a)' )&
719 : ! 'frmax is ',dtset%frmax, '. Only values > 0 ',ch10, &
720 : ! 'are allowed',ch10, 'Action: correct frmax in your input file.'
721 : ! ABI_ERROR(message)
722 : ! end if
723 :
724 81 : dtset%frmin = zero
725 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'frmin',tread, 'DPR')
726 81 : if(tread == 1) dtset%frmin = dprarr(1)
727 : ! if (dtset%frmin < 0) then
728 : ! write(message, '(a, f10.3, 5a)' )&
729 : ! 'frmin is ',dtset%frmin, '. Only values > 0 ',ch10, &
730 : ! 'are allowed',ch10, 'Action: correct frmin in your input file.'
731 : ! ABI_ERROR(message)
732 : ! end if
733 :
734 : !G
735 :
736 81 : dtset%gkk2write = 0
737 : !call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'gkk2write',&
738 : !& tread, 'INT')
739 : !if(tread == 1) dtset%gkk2write = intarr(1)
740 : !if(dtset%gkk2write < 0 .or. dtset%gkk2write > 1) then
741 : !write(message, '(a, a, a, i8, a, a, a, a, a)' )&
742 : !& ' invars9 : ERROR -',ch10, &
743 : !& ' gkk2write is',dtset%gkk2write, &
744 : !& ', but the only allowed values',ch10, &
745 : !& ' are 0 or 1 .',ch10, &
746 : !& ' Action: correct gkk2write in your input file.'
747 : !ABI_ERROR(message)
748 : !end if
749 :
750 81 : dtset%gkk_rptwrite = 0
751 : !call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'gkk_rptwrite',&
752 : !& tread, 'INT')
753 : !if(tread == 1) dtset%gkk_rptwrite = intarr(1)
754 : !if(dtset%gkk_rptwrite < 0 .or. dtset%gkk_rptwrite > 1) then
755 : !write(message, '(a, a, a, i8, a, a, a, a, a)' )&
756 : !& ' invars9 : ERROR -',ch10, &
757 : !& ' gkk_rptwrite is',dtset%gkk_rptwrite, &
758 : !& ', but the only allowed values',ch10, &
759 : !& ' are 0 or 1 .',ch10, &
760 : !& ' Action: correct gkk_rptwrite in your input file.'
761 : !ABI_ERROR(message)
762 : !end if
763 :
764 81 : dtset%gkqwrite = 0
765 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'gkqwrite',tread, 'INT')
766 81 : if(tread == 1) dtset%gkqwrite = intarr(1)
767 81 : if(dtset%gkqwrite < 0 .or. dtset%gkqwrite > 1) then
768 : write(message, '(a, i0, 5a)' )&
769 0 : 'gkqwrite is ',dtset%gkqwrite, ', but the only allowed values',ch10, &
770 0 : 'are 0 or 1.',ch10, 'Action: correct gkqwrite in your input file.'
771 0 : ABI_ERROR(message)
772 : end if
773 :
774 81 : dtset%gruns_nddbs = 0
775 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'gruns_nddbs',tread, 'INT')
776 81 : if (tread == 1) dtset%gruns_nddbs = intarr(1)
777 :
778 81 : if (dtset%gruns_nddbs /= 0) then
779 : ! Read list of DDB paths.
780 3 : ABI_MALLOC(dtset%gruns_ddbs, (dtset%gruns_nddbs))
781 1 : start = index(string, "GRUNS_DDBS") + len("GRUNS_DDBS") + 1
782 4 : do ii = 1, dtset%gruns_nddbs
783 3 : if (next_token(string, start, path) /= 0) then
784 0 : ABI_ERROR(sjoin("Cannot find DDB path in input string:", ch10, string(start:)))
785 : end if
786 4 : dtset%gruns_ddbs(ii) = rmquotes(path)
787 : end do
788 : end if
789 :
790 : !H
791 :
792 : !I
793 :
794 81 : dtset%ifcana = 0
795 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'ifcana',tread, 'INT')
796 81 : if(tread == 1) dtset%ifcana = intarr(1)
797 81 : if(dtset%ifcana < 0 .or. dtset%ifcana > 1)then
798 : write(message, '(a, i0, 5a)' )&
799 0 : 'ifcana is ',dtset%ifcana, ', but the only allowed values',ch10, &
800 0 : 'are 0 or 1.',ch10, 'Action: correct ifcana in your input file.'
801 0 : ABI_ERROR(message)
802 : end if
803 :
804 81 : dtset%ifcflag = 0
805 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'ifcflag',tread, 'INT')
806 81 : if(tread == 1) dtset%ifcflag = intarr(1)
807 81 : if(dtset%ifcflag < 0 .or. dtset%ifcflag > 1)then
808 : write(message, '(a, i0, 5a)' )&
809 0 : 'ifcflag is ',dtset%ifcflag, ', but the only allowed values',ch10, &
810 0 : 'are 0 or 1.',ch10, 'Action: correct ifcflag in your input file.'
811 0 : ABI_ERROR(message)
812 : end if
813 :
814 81 : dtset%ifcout = 0
815 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'ifcout',tread, 'INT')
816 81 : if(tread == 1) dtset%ifcout = intarr(1)
817 81 : if(dtset%ifcout < -1)then
818 : write(message, '(a, i0, 3a)' )&
819 0 : 'ifcout is ',dtset%ifcout, ', which is lower than-1.',ch10, &
820 0 : 'Action: correct ifcout in your input file.'
821 0 : ABI_ERROR(message)
822 : end if
823 :
824 81 : dtset%ifltransport = 0
825 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'ifltransport',tread, 'INT')
826 81 : if(tread == 1) dtset%ifltransport = intarr(1)
827 81 : if(dtset%ifltransport < 0 .or. dtset%ifltransport > 3) then
828 : write(message, '(a, i0, 5a)' )&
829 0 : 'ifltransport is ',dtset%ifltransport, ', but the only allowed values',ch10, &
830 0 : 'are 0 or 1 or 2 or 3.',ch10, 'Action: correct ifltransport in your input file.'
831 0 : ABI_ERROR(message)
832 : end if
833 :
834 81 : dtset%instrflag = 0
835 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'instrflag',tread, 'INT')
836 81 : if(tread == 1) dtset%instrflag = intarr(1)
837 81 : if(dtset%instrflag < 0 .or. dtset%instrflag > 1)then
838 : write(message, '(a, i0, 5a)' )&
839 0 : 'instrflag is ',dtset%instrflag, ', but the only allowed values',ch10, &
840 0 : 'are 0, 1.',ch10, 'Action: correct instrflag in your input file.'
841 0 : ABI_ERROR(message)
842 : end if
843 :
844 : !J
845 :
846 : !K
847 :
848 1053 : dtset%kptrlatt = 0
849 : !why this test on reading in kptrlatt?
850 81 : marr = 9
851 81 : ABI_FREE(intarr)
852 81 : ABI_FREE(dprarr)
853 81 : ABI_MALLOC(intarr, (marr))
854 81 : ABI_MALLOC(dprarr, (marr))
855 81 : call intagm(dprarr, intarr, jdtset, marr, 9, string(1:lenstr), 'kptrlatt',tread, 'INT')
856 141 : if(tread == 1)dtset%kptrlatt(1:3, 1:3)=reshape(intarr(1:9), (/3, 3/))
857 : !NOTE: no a priori way to test the validity of the integers in kptrlatt
858 :
859 1053 : dtset%kptrlatt_fine(:,:)=0
860 : marr = 9
861 81 : ABI_FREE(intarr)
862 81 : ABI_FREE(dprarr)
863 81 : ABI_MALLOC(intarr, (marr))
864 81 : ABI_MALLOC(dprarr, (marr))
865 81 : call intagm(dprarr, intarr, jdtset, marr, 9, string(1:lenstr), 'kptrlatt_fine',tread, 'INT')
866 81 : if(tread == 1)dtset%kptrlatt_fine(1:3, 1:3)=reshape(intarr(1:9), (/3, 3/))
867 :
868 :
869 : !L
870 :
871 : ! lwf_*: lattic wannier function
872 324 : dtset%lwf_anchor_qpt(:) = 0.0_dp
873 81 : call intagm(dprarr, intarr, jdtset, marr, 3, string(1:lenstr), 'lwf_anchor_qpt',tread, 'DPR')
874 87 : if(tread == 1) dtset%lwf_anchor_qpt(1:3) = dprarr(1:3)
875 :
876 81 : dtset%lwf_disentangle = 0
877 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'lwf_disentangle',tread, 'INT')
878 81 : if(tread == 1) dtset%lwf_disentangle = intarr(1)
879 81 : if(dtset%lwf_disentangle < 0 .or. dtset%lwf_disentangle > 3)then
880 : write(message, '(a, i0, 5a)' )&
881 0 : 'lwf_disentangle is ',dtset%lwf_disentangle, ', but the only allowed values',ch10, &
882 0 : 'are 0, 1.',ch10, 'Action: correct lwf_disentangle in your input file.'
883 0 : ABI_ERROR(message)
884 : end if
885 :
886 81 : dtset%lwf_anchor_proj = 0
887 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'lwf_anchor_proj',tread, 'INT')
888 81 : if(tread == 1) dtset%lwf_anchor_proj = intarr(1)
889 81 : if(dtset%lwf_anchor_proj < 0 .or. dtset%lwf_anchor_proj > 2)then
890 : write(message, '(a, i0, 5a)' )&
891 0 : 'lwf_anchor_proj is ',dtset%lwf_anchor_proj, ', but the only allowed values',ch10, &
892 0 : 'are 0, 1, 2.',ch10, 'Action: correct lwf_anchor_proj in your input file.'
893 0 : ABI_ERROR(message)
894 : end if
895 :
896 :
897 324 : dtset%lwf_ngqpt(:)=0
898 81 : call intagm(dprarr, intarr, jdtset, marr, 3, string(1:lenstr), 'lwf_ngqpt',tread, 'INT')
899 90 : if(tread == 1) dtset%lwf_ngqpt(1:3)=intarr(1:3)
900 324 : do ii = 1, 3
901 324 : if(dtset%lwf_ngqpt(ii)<0)then
902 : write(message, '(a, i0, a, i0, 3a, i0, a)' )&
903 0 : 'lwf_ngqpt(',ii, ') is ',dtset%lwf_ngqpt(ii), ', which is lower than 0 .',ch10, &
904 0 : 'Action: correct lwf_ngqpt(',ii, ') in your input file.'
905 0 : ABI_ERROR(message)
906 : end if
907 : end do
908 :
909 :
910 81 : dtset%lwfflag = 0
911 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'lwfflag',tread, 'INT')
912 81 : if(tread == 1) dtset%lwfflag = intarr(1)
913 81 : if(dtset%lwfflag < 0 .or. dtset%lwfflag > 2)then
914 : write(message, '(a, i0, 5a)' )&
915 0 : 'lwfflag is ',dtset%lwfflag, ', but the only allowed values',ch10, &
916 0 : 'are 0, 1 and 2.',ch10, 'Action: correct lwfflag in your input file.'
917 0 : ABI_ERROR(message)
918 : end if
919 :
920 :
921 81 : dtset%lwf_mu = 0.0_dp
922 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'lwf_mu',tread, 'DPR')
923 81 : if(tread == 1) dtset%lwf_mu = dprarr(1)
924 :
925 :
926 81 : dtset%lwf_nwann = 0
927 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'lwf_nwann',tread, 'INT')
928 81 : if(tread == 1) dtset%lwf_nwann = intarr(1)
929 81 : if(dtset%lwf_nwann > natom*3)then
930 : write(message, '(a, i0, 2a, i0, 3a)' )&
931 0 : 'lwf_nwann is ',dtset%lwf_nwann, ', which is larger than natom*3',' (=',natom*3, ')',ch10, &
932 0 : 'Action: correct lwf_nwann in your input file.'
933 0 : ABI_ERROR(message)
934 : end if
935 :
936 81 : if( dtset%lwfflag > 0 .and. dtset%lwf_nwann .le. 0)then
937 : write(message, '(a, i0, 3a)' )&
938 0 : 'lwf_nwann is ',dtset%lwf_nwann, ', which is not positive',ch10, &
939 0 : 'Action: correct lwf_nwann in your input file.'
940 0 : ABI_ERROR(message)
941 : end if
942 :
943 81 : dtset%lwf_sigma = 0.01_dp
944 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'lwf_sigma',tread, 'DPR')
945 81 : if(tread == 1) dtset%lwf_sigma = dprarr(1)
946 :
947 : !M
948 :
949 81 : dtset%magpen = 0.0_dp
950 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'magpen',tread, 'DPR')
951 81 : if(tread == 1) dtset%magpen = dprarr(1)
952 :
953 324 : dtset%mpdir(:)=0
954 81 : call intagm(dprarr, intarr, jdtset, marr, 3, string(1:lenstr), 'mpdir',tread, 'INT')
955 90 : if(tread == 1) dtset%mpdir(:)=intarr(1:3)
956 324 : do ii = 1, 3
957 324 : if(dtset%mpdir(ii)<0.or.dtset%mpdir(ii)>1)then
958 : write(message, '(a, i0, a, i0, 3a, i0, a)' )&
959 0 : 'mpdir(',ii, ') is ',dtset%mpdir(ii), &
960 0 : ', whereas it can only be 0 or 1.',ch10, &
961 0 : 'Action: correct mpdir(',ii, ') in your input file.'
962 0 : ABI_ERROR(message)
963 : end if
964 : end do
965 :
966 243 : dtset%mpatpol(:)=0
967 81 : call intagm(dprarr, intarr, jdtset, marr, 2, string(1:lenstr), 'mpatpol',tread, 'INT')
968 87 : if(tread == 1) dtset%mpatpol(:)=intarr(1:2)
969 243 : do ii = 1, 2
970 243 : if(dtset%mpatpol(ii)<0.or.dtset%mpatpol(ii)>natom)then
971 : write(message, '(a, i0, a, i0, 3a, i0, a)' )&
972 0 : 'mpatpol(',ii, ') is ',dtset%mpatpol(ii), &
973 0 : ', which is lower than 0 or larget than the number of atoms in the cell.',ch10, &
974 0 : 'Action: correct mpatpol(',ii, ') in your input file.'
975 0 : ABI_ERROR(message)
976 : end if
977 : end do
978 :
979 81 : dtset%mpopt=2
980 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'mpopt',tread, 'INT')
981 81 : if(tread == 1) dtset%mpopt=intarr(1)
982 :
983 : !typical value for mustar, but can vary sensibly with the metal
984 81 : dtset%mustar = 0.1_dp
985 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'mustar',tread, 'DPR')
986 81 : if(tread == 1) dtset%mustar = dprarr(1)
987 81 : if (dtset%mustar < zero) then
988 : write(message, '(a, f10.3, 5a)' )&
989 0 : 'mustar is ',dtset%mustar, ', but only positive values',ch10, &
990 0 : 'are allowed',ch10, 'Action: correct mustar in your input file.'
991 0 : ABI_ERROR(message)
992 : end if
993 :
994 : !N
995 :
996 81 : dtset%natfix = 0
997 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'natfix',tread, 'INT')
998 81 : if(tread == 1) dtset%natfix = intarr(1)
999 81 : if(dtset%natfix > natom)then
1000 : write(message, '(a, i0, 2a, i0, 3a)' )&
1001 0 : 'natfix is ',dtset%natfix, ', which is larger than natom',' (=',natom, ')',ch10, &
1002 0 : 'Action: correct natfix in your input file.'
1003 0 : ABI_ERROR(message)
1004 : end if
1005 :
1006 81 : if(dtset%natfix < 0)then
1007 : write(message, '(a, i0, 3a)' )&
1008 0 : 'natfix is ',dtset%natfix, ', which is < 0',ch10, &
1009 0 : 'Action: correct natfix in your input file.'
1010 0 : ABI_ERROR(message)
1011 : end if
1012 :
1013 81 : dtset%natifc = 0
1014 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'natifc',tread, 'INT')
1015 81 : if(tread == 1) dtset%natifc = intarr(1)
1016 81 : if(dtset%natifc < 0)then
1017 : write(message, '(a, i0, 3a)' )&
1018 0 : 'natifc is ',dtset%natifc, ', which is lower than 0 .',ch10, &
1019 0 : 'Action: correct natifc in your input file.'
1020 0 : ABI_ERROR(message)
1021 : end if
1022 :
1023 81 : dtset%natprj_bs = 0
1024 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'natprj_bs',tread, 'INT')
1025 81 : if(tread == 1) dtset%natprj_bs = intarr(1)
1026 81 : if(dtset%natprj_bs < 0 .or. dtset%natprj_bs > natom)then
1027 : write(message, '(a, i0, a, i0, 2a)' )&
1028 0 : 'natprj_bs is ',dtset%natprj_bs, ', but must be between 0 and natom = ',natom, ch10, &
1029 0 : 'Action: correct natprj_bs in your input file.'
1030 0 : ABI_ERROR(message)
1031 : end if
1032 :
1033 81 : dtset%nchan = 800
1034 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'nchan',tread, 'INT')
1035 81 : if(tread == 1) dtset%nchan = intarr(1)
1036 : !FIXME: check this-it should probably be .ge. 1, not 0
1037 81 : if(dtset%nchan < 0)then
1038 : write(message, '(a, i0, 3a)' )&
1039 0 : 'nchan is ',dtset%nchan, ', which is lower than 0 .',ch10, &
1040 0 : 'Action: correct nchan in your input file.'
1041 0 : ABI_ERROR(message)
1042 : end if
1043 :
1044 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'ndivsm',tread, 'INT')
1045 81 : if(tread == 1) dtset%ndivsm = intarr(1)
1046 81 : if(dtset%ndivsm <= 0)then
1047 : write(message, '(a, i0, 3a)' )&
1048 0 : 'ndivsm is ',dtset%ndivsm, ', which is <= 0 .',ch10, &
1049 0 : 'Action: correct ndivsm in your input file.'
1050 0 : ABI_ERROR(message)
1051 : end if
1052 :
1053 81 : dtset%nfreq = 1
1054 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'nfreq',tread, 'INT')
1055 81 : if(tread == 1) dtset%nfreq = intarr(1)
1056 81 : if(dtset%nfreq < 0)then
1057 : write(message, '(a, i0, 3a)' )&
1058 0 : 'nfreq is ',dtset%nfreq, ', which is lower than 0 .',ch10, &
1059 0 : 'Action: correct nfreq in your input file.'
1060 0 : ABI_ERROR(message)
1061 : end if
1062 :
1063 324 : dtset%ng2qpt(:)=0
1064 81 : call intagm(dprarr, intarr, jdtset, marr, 3, string(1:lenstr), 'ng2qpt',tread, 'INT')
1065 141 : if(tread == 1) dtset%ng2qpt(:)=intarr(1:3)
1066 324 : do ii = 1, 3
1067 324 : if(dtset%ng2qpt(ii)<0)then
1068 : write(message, '(a, i0, a, i0, 3a, i0, a)' )&
1069 0 : 'ng2qpt(',ii, ') is ',dtset%ng2qpt(ii), ', which is lower than 0 .',ch10, &
1070 0 : 'Action: correct ng2qpt(',ii, ') in your input file.'
1071 0 : ABI_ERROR(message)
1072 : end if
1073 : end do
1074 :
1075 810 : dtset%ngqpt(:)=0
1076 81 : call intagm(dprarr, intarr, jdtset, marr, 3, string(1:lenstr), 'ngqpt',tread, 'INT')
1077 270 : if(tread == 1) dtset%ngqpt(1:3)=intarr(1:3)
1078 324 : do ii = 1, 3
1079 324 : if(dtset%ngqpt(ii)<0)then
1080 : write(message, '(a, i0, a, i0, 3a, i0, a)' )&
1081 0 : 'ngqpt(',ii, ') is ',dtset%ngqpt(ii), ', which is lower than 0 .',ch10, &
1082 0 : 'Action: correct ngqpt(',ii, ') in your input file.'
1083 0 : ABI_ERROR(message)
1084 : end if
1085 : end do
1086 :
1087 81 : dtset%ngrids = 4
1088 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'ngrids',tread, 'INT')
1089 81 : if(tread == 1) dtset%ngrids = intarr(1)
1090 81 : if(dtset%ngrids < 0)then
1091 : write(message, '(a, i0, 3a)' )&
1092 0 : 'ngrids is ',dtset%ngrids, ', which is lower than 0 .',ch10, &
1093 0 : 'Action: correct ngrids in your input file.'
1094 0 : ABI_ERROR(message)
1095 : end if
1096 :
1097 81 : dtset%nlflag = 0
1098 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'nlflag',tread, 'INT')
1099 81 : if(tread == 1) dtset%nlflag = intarr(1)
1100 81 : if(dtset%nlflag < 0 .or. dtset%nlflag > 3)then
1101 : write(message, '(a, i0, 5a)' )&
1102 0 : 'nlflag is ',dtset%nlflag, ', but the only allowed values',ch10, &
1103 0 : 'are 0, 1, 2 or 3.',ch10, 'Action: correct nlflag in your input file.'
1104 0 : ABI_ERROR(message)
1105 : end if
1106 :
1107 81 : dtset%nph1l = 0
1108 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'nph1l',tread, 'INT')
1109 81 : if(tread == 1) dtset%nph1l = intarr(1)
1110 81 : if(dtset%nph1l < 0)then
1111 : write(message, '(a, i0, 3a)' )&
1112 0 : 'nph1l is ',dtset%nph1l, ', which is lower than 0 .',ch10, &
1113 0 : 'Action: correct nph1l in your input file.'
1114 0 : ABI_ERROR(message)
1115 : end if
1116 :
1117 81 : dtset%nph2l = 0
1118 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'nph2l',tread, 'INT')
1119 81 : if(tread == 1) dtset%nph2l = intarr(1)
1120 81 : if(dtset%nph2l < 0)then
1121 : write(message, '(a, i0, 3a)' )&
1122 0 : 'nph2l is ',dtset%nph2l, ', which is lower than 0 .',ch10, &
1123 0 : 'Action: correct nph2l in your input file.'
1124 0 : ABI_ERROR(message)
1125 : end if
1126 :
1127 81 : dtset%nqpath = 0
1128 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'nqpath',tread, 'INT')
1129 81 : if(tread == 1) dtset%nqpath = intarr(1)
1130 81 : if(dtset%nqpath < 0)then
1131 : write(message, '(a, i0, 3a)' )&
1132 0 : 'nqpath is ',dtset%nqpath, ', but must be positive',ch10, &
1133 0 : 'Action: correct elphflag in your input file.'
1134 0 : ABI_ERROR(message)
1135 : end if
1136 :
1137 81 : dtset%nqshft = 1
1138 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'nqshft',tread, 'INT')
1139 81 : if(tread == 1) dtset%nqshft = intarr(1)
1140 81 : if(dtset%nqshft < 0 .or. dtset%nqshft == 3 .or. dtset%nqshft >= 5 )then
1141 : write(message, '(a, i0, 5a)' )&
1142 0 : 'nqshft is ',dtset%nqshft, ', but the only allowed values',ch10, &
1143 0 : 'are 1, 2 or 4 .',ch10, 'Action: correct nqshft in your input file.'
1144 0 : ABI_ERROR(message)
1145 : end if
1146 :
1147 81 : dtset%nsphere = 0
1148 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'nsphere',tread, 'INT')
1149 81 : if(tread == 1) dtset%nsphere = intarr(1)
1150 81 : if(dtset%nsphere < -1)then
1151 : write(message, '(a, i0, 3a)' )&
1152 0 : 'nsphere is ',dtset%nsphere, ', while it must be >= 0 or equal to-1',ch10, &
1153 0 : 'Action: correct nsphere in your input file.'
1154 0 : ABI_ERROR(message)
1155 : end if
1156 :
1157 81 : dtset%nstrfix = 0
1158 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'nstrfix',tread, 'INT')
1159 81 : if(tread == 1) dtset%nstrfix = intarr(1)
1160 81 : if(dtset%nstrfix > 6)then
1161 : write(message, '(a, i0, 3a)' )&
1162 0 : 'nstrfix is ',dtset%nstrfix, ', which is larger than 6',ch10, &
1163 0 : 'Action: correct nstrfix in your input file.'
1164 0 : ABI_ERROR(message)
1165 : end if
1166 :
1167 81 : if(dtset%nstrfix < 0)then
1168 : write(message, '(a, i0, 3a)' )&
1169 0 : 'nstrfix is ',dtset%nstrfix, ', which is < 0',ch10, &
1170 0 : 'Action: correct nstrfix in your input file.'
1171 0 : ABI_ERROR(message)
1172 : end if
1173 :
1174 81 : dtset%ntemper = 10
1175 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'ntemper',tread, 'INT')
1176 81 : if(tread == 1) dtset%ntemper = intarr(1)
1177 81 : if(dtset%ntemper < 0)then
1178 : write(message, '(a, i0, 3a)' )&
1179 0 : 'ntemper is ',dtset%ntemper, ', which is lower than 0',ch10, &
1180 0 : 'Action: correct ntemper in your input file.'
1181 0 : ABI_ERROR(message)
1182 : end if
1183 :
1184 81 : dtset%nwchan = 10
1185 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'nwchan',tread, 'INT')
1186 81 : if(tread == 1) dtset%nwchan = intarr(1)
1187 : !FIXME: check this-it should probably be .ge. 1, not 0
1188 81 : if(dtset%nwchan < 0)then
1189 : write(message, '(a, i0, 3a)' )&
1190 0 : 'nwchan is ',dtset%nwchan, ', which is lower than 0 .',ch10, &
1191 0 : 'Action: correct nwchan in your input file.'
1192 0 : ABI_ERROR(message)
1193 : end if
1194 :
1195 : !O
1196 81 : dtset%outboltztrap = 0
1197 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'outboltztrap',tread, 'INT')
1198 81 : if(tread == 1) dtset%outboltztrap = intarr(1)
1199 81 : if(dtset%outboltztrap < 0 .or. dtset%outboltztrap > 1)then
1200 : write(message, '(a, i0, 5a)' )&
1201 0 : 'outboltztrap is ',dtset%outboltztrap, ', but the only allowed values',ch10, &
1202 0 : 'are 0 or 1.',ch10, 'Action: correct outboltztrap in your input file.'
1203 0 : ABI_ERROR(message)
1204 : end if
1205 :
1206 :
1207 : !P
1208 81 : dtset%piezoflag = 0
1209 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'piezoflag',tread, 'INT')
1210 81 : if(tread == 1) dtset%piezoflag = intarr(1)
1211 81 : if(dtset%piezoflag < 0 .or. dtset%piezoflag > 7)then
1212 : write(message, '(3a, i0, 5a)' )&
1213 0 : ' piezoflag is ',dtset%piezoflag, ', but the only allowed values',ch10, &
1214 0 : 'are 0, 1, 2, 3, 4, 5, 6, 7 .',ch10, 'Action: correct piezoflag in your input file.'
1215 0 : ABI_ERROR(message)
1216 : end if
1217 :
1218 81 : dtset%polflag = 0
1219 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'polflag',tread, 'INT')
1220 81 : if(tread == 1) dtset%polflag = intarr(1)
1221 81 : if(dtset%polflag < 0 .or. dtset%polflag > 1)then
1222 : write(message, '(a, i0, 5a)' )&
1223 0 : 'polflag is ',dtset%polflag, ', but the only allowed values',ch10, &
1224 0 : 'are 0 or 1.',ch10, 'Action: correct polflag in your input file.'
1225 0 : ABI_ERROR(message)
1226 : end if
1227 :
1228 81 : dtset%prtbltztrp = 0
1229 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'prtbltztrp',tread, 'INT')
1230 81 : if(tread == 1) dtset%prtbltztrp = intarr(1)
1231 81 : if(dtset%prtbltztrp < 0 .or. dtset%prtbltztrp > 1)then
1232 : write(message, '(a, i0, 5a)' )&
1233 0 : 'prtbltztrp is ',dtset%prtbltztrp, ', but the only allowed values',ch10, &
1234 0 : 'are 0 or 1.',ch10, 'Action: correct prtbltztrp in your input file.'
1235 0 : ABI_ERROR(message)
1236 : end if
1237 :
1238 : ! Default is no output for PHDOS
1239 81 : dtset%prtdos = 0
1240 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'prtdos',tread, 'INT')
1241 81 : if(tread == 1) dtset%prtdos = intarr(1)
1242 81 : if(dtset%prtdos < 0 .or. dtset%prtdos > 2) then
1243 : write(message, '(a, i0, 5a)' )&
1244 0 : 'prtdos is ',dtset%prtdos, ', but the only allowed values',ch10, &
1245 0 : 'are 0 (no output) or 1 (gaussians) or 2 (tetrahedra) ',ch10, &
1246 0 : 'Action: correct prtdos in your input file.'
1247 0 : ABI_ERROR(message)
1248 : end if
1249 :
1250 : !Default is no output for the Fermi Surface
1251 81 : dtset%prtfsurf = 0
1252 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'prtfsurf',tread, 'INT')
1253 81 : if(tread == 1) dtset%prtfsurf = intarr(1)
1254 81 : if(dtset%prtfsurf < 0 .or. dtset%prtfsurf > 2) then
1255 : write(message, '(a, i0, 5a)' )&
1256 0 : 'prtfsurf is ',dtset%prtfsurf, '. The only allowed values',ch10, &
1257 0 : 'are 0 (no output) or 1 (Xcrysden bxsf format)',ch10, &
1258 0 : 'Action: correct prtfsurf in your input file.'
1259 0 : ABI_ERROR(message)
1260 : end if
1261 :
1262 : !Default is no output of the real space IFC to file
1263 81 : dtset%prt_ifc = 0
1264 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'prt_ifc',tread, 'INT')
1265 81 : if(tread == 1) dtset%prt_ifc = intarr(1)
1266 81 : if(dtset%prt_ifc < 0 .or. dtset%prt_ifc > 1) then
1267 : write(message, '(a, i0, 5a)' )&
1268 0 : 'prtf_ifc is ',dtset%prt_ifc, '. The only allowed values',ch10, &
1269 0 : 'are 0 (no output) or 1 (AI2PS format)',ch10, &
1270 0 : 'Action: correct prt_ifc in your input file.'
1271 0 : ABI_ERROR(message)
1272 : end if
1273 : ! check that ifcout is set
1274 81 : if (dtset%prt_ifc /= 0 .and. dtset%ifcout == 0) then
1275 0 : dtset%ifcout = -1 ! this forces output of all IFC
1276 : end if
1277 :
1278 : !Default is no output of the DDB to file
1279 81 : dtset%prtddb = 0
1280 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'prtddb',tread, 'INT')
1281 81 : if(tread == 1) dtset%prtddb = intarr(1)
1282 81 : if(dtset%prtddb < 0 .or. dtset%prtddb > 1) then
1283 : write(message, '(a, i0, 5a)' )&
1284 0 : 'prtf_ddb is ',dtset%prtddb, '. The only allowed values',ch10, &
1285 0 : 'are 0 (no output) or 1 (print DDB and DDB.nc files)',ch10, &
1286 0 : 'Action: correct prtddb in your input file.'
1287 0 : ABI_ERROR(message)
1288 : end if
1289 : ! check that ifcflag is set
1290 81 : if (dtset%prtddb /= 0 .and. dtset%ifcflag == 0) then
1291 0 : dtset%ifcflag = 1 ! this forces the use of IFC
1292 : end if
1293 :
1294 81 : dtset%prtmbm = 0
1295 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'prtmbm',tread, 'INT')
1296 81 : if(tread == 1) dtset%prtmbm = intarr(1)
1297 : !FIXME: should check whether value of prtmbm is valid
1298 :
1299 : !Default is no output of the nesting factor
1300 81 : dtset%prtnest = 0
1301 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'prtnest',tread, 'INT')
1302 81 : if(tread == 1) dtset%prtnest = intarr(1)
1303 81 : if(dtset%prtnest < 0 .or. dtset%prtnest > 2) then
1304 : write(message, '(a, i0, 5a)' )&
1305 0 : 'prtnest is ',dtset%prtnest, ' The only allowed values',ch10, &
1306 0 : 'are 0 (no nesting), 1 (XY format) or 2 (XY+Xcrysden format)',ch10, &
1307 0 : 'Action: correct prtnest in your input file.'
1308 0 : ABI_ERROR(message)
1309 : end if
1310 :
1311 81 : dtset%prtphbands = 1
1312 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'prtphbands',tread, 'INT')
1313 81 : if (tread == 1) dtset%prtphbands = intarr(1)
1314 81 : if (all(dtset%prtphbands /= [0, 1, 2])) then
1315 : write(message, '(a, i0, a)' )&
1316 0 : 'prtphbands is ',dtset%prtphbands, ', but the only allowed values are [0, 1, 2].'
1317 0 : ABI_ERROR(message)
1318 : end if
1319 :
1320 81 : dtset%prtsrlr = 0
1321 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'prtsrlr',tread, 'INT')
1322 81 : if(tread == 1) dtset%prtsrlr = intarr(1)
1323 81 : if(dtset%prtsrlr < 0 .or. dtset%prtsrlr > 1)then
1324 : write(message, '(a, i0, 5a)' )&
1325 0 : 'prtsrlr is ',dtset%prtsrlr, ', but the only allowed values',ch10, &
1326 0 : 'are 0 or 1.',ch10, 'Action: correct prtsrlr in your input file.'
1327 0 : ABI_ERROR(message)
1328 : end if
1329 :
1330 81 : dtset%prtvol = 0
1331 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'prtvol',tread, 'INT')
1332 81 : if(tread == 1) dtset%prtvol = intarr(1)
1333 :
1334 : !Q
1335 :
1336 324 : dtset%q2shft(:)=zero
1337 81 : call intagm(dprarr, intarr, jdtset, marr, 3, string(1:lenstr), 'q2shft',tread, 'DPR')
1338 93 : if(tread == 1) dtset%q2shft(:)=dprarr(1:3)
1339 : !FIXME: need a test on valid entries for q2shft
1340 :
1341 81 : dtset%qgrid_type = 1 ! default is uniform nqpt(:) grid
1342 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'qgrid_type',tread, 'INT')
1343 81 : if(tread == 1) dtset%qgrid_type = intarr(1)
1344 81 : if(dtset%qgrid_type < 1 .or. dtset%qgrid_type > 2) then
1345 : write(message, '(a, i0, 5a)' )&
1346 0 : 'qgrid_type is ',dtset%qgrid_type, ' The only allowed values',ch10, &
1347 0 : 'are 1 (uniform grid from nqpt) or 2 (listed in ep_nqpt, ep_qptlist)',ch10, &
1348 0 : 'Action: correct qgrid_type in your input file.'
1349 0 : ABI_ERROR(message)
1350 : end if
1351 :
1352 324 : dtset%qrefine = 1 ! default is no refinement
1353 81 : call intagm(dprarr, intarr, jdtset, marr, 3, string(1:lenstr), 'qrefine',tread, 'INT')
1354 84 : if(tread == 1) dtset%qrefine = intarr(1:3)
1355 324 : do ii = 1, 3
1356 324 : if(dtset%qrefine(ii) < 1) then
1357 : write(message, '(a, 3i0, a, a, a, a, a)' )&
1358 0 : 'qrefine is',dtset%qrefine, ' The only allowed values',ch10, &
1359 0 : 'are integers >= 1 giving the refinement of the ngqpt grid',ch10, &
1360 0 : 'Action: correct qrefine in your input file.'
1361 0 : ABI_ERROR(message)
1362 : end if
1363 : end do
1364 :
1365 81 : dtset%quadquad = 1
1366 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'quadquad',tread, 'INT')
1367 81 : if(tread == 1) dtset%quadquad = intarr(1)
1368 81 : if(dtset%quadquad < -1 .or. dtset%quadquad > 1)then
1369 : write(message, '(a, i0, 5a)' )&
1370 0 : 'quadquad is ',dtset%quadquad, ', but the only allowed values',ch10, &
1371 0 : 'are 0 or 1 .',ch10, 'Action: correct quadquad in your input file.'
1372 0 : ABI_ERROR(message)
1373 : end if
1374 :
1375 : !R
1376 :
1377 81 : dtset%ramansr = 0
1378 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'ramansr',tread, 'INT')
1379 81 : if(tread == 1) dtset%ramansr = intarr(1)
1380 81 : if(dtset%ramansr < 0 .or. dtset%ramansr > 2)then
1381 : write(message, '(a, i0, 5a)' )&
1382 0 : 'ramansr is ',dtset%ramansr, ', but the only allowed values',ch10, &
1383 0 : 'are 0, 1 or 2.',ch10, 'Action: correct ramansr in your input file.'
1384 0 : ABI_ERROR(message)
1385 : end if
1386 :
1387 81 : dtset%relaxat = 0
1388 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'relaxat',tread, 'INT')
1389 81 : if(tread == 1) dtset%relaxat = intarr(1)
1390 81 : if(dtset%relaxat < 0 .or. dtset%relaxat > 1)then
1391 : write(message, '(a, i0, 5a)' )&
1392 0 : 'relaxat is ',dtset%relaxat, ', but the only allowed values',ch10, &
1393 0 : 'are 0 or 1.',ch10, 'Action: correct relaxat in your input file.'
1394 0 : ABI_ERROR(message)
1395 : end if
1396 :
1397 81 : dtset%relaxstr = 0
1398 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'relaxstr',tread, 'INT')
1399 81 : if(tread == 1) dtset%relaxstr = intarr(1)
1400 81 : if(dtset%relaxstr < 0 .or. dtset%relaxstr > 1)then
1401 : write(message, '(a, i0, 5a)' )&
1402 0 : 'relaxstr is ',dtset%relaxstr, 'but the only allowed values',ch10, &
1403 0 : 'are 0 or 1.',ch10, 'Action: correct relaxstr in your input file.'
1404 0 : ABI_ERROR(message)
1405 : end if
1406 :
1407 81 : dtset%rfmeth = 1
1408 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'rfmeth',tread, 'INT')
1409 81 : if(tread == 1) dtset%rfmeth = intarr(1)
1410 81 : if(dtset%rfmeth < 1 .or. dtset%rfmeth > 2)then
1411 : write(message, '(a, i0, 5a)' )&
1412 0 : 'rfmeth is ',dtset%rfmeth, ', but the only allowed values',ch10, &
1413 0 : 'are 1 or 2.',ch10, 'Action: correct rfmeth in your input file.'
1414 0 : ABI_ERROR(message)
1415 : end if
1416 :
1417 81 : dtset%rifcsph = zero
1418 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'rifcsph',tread, 'DPR')
1419 81 : if(tread == 1) dtset%rifcsph = dprarr(1)
1420 : ! if(dtset%rifcsph < -tol12)then
1421 : ! write(message, '(a, f10.3, 3a)' )&
1422 : !& 'rifcsph is ',dtset%rifcsph, ', which is lower than zero.',ch10, &
1423 : !& 'Action: correct rifcsph in your input file.'
1424 : ! ABI_ERROR(message)
1425 : ! end if
1426 :
1427 : !S
1428 :
1429 81 : dtset%selectz = 0
1430 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'selectz',tread, 'INT')
1431 81 : if(tread == 1) dtset%selectz = intarr(1)
1432 81 : if(dtset%selectz < 0 .or. dtset%selectz > 2)then
1433 : write(message, '(a, i0, 5a)' )&
1434 0 : 'selectz is ',dtset%selectz, ', but the only allowed values',ch10, &
1435 0 : 'are 0, 1 or 2 .',ch10, 'Action: correct selectz in your input file.'
1436 0 : ABI_ERROR(message)
1437 : end if
1438 :
1439 81 : dtset%symdynmat = 1
1440 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'symdynmat',tread, 'INT')
1441 81 : if(tread == 1) dtset%symdynmat = intarr(1)
1442 81 : if(dtset%symdynmat /= 0 .and. dtset%symdynmat /= 1)then
1443 : write(message, '(a, i0, 5a)' )&
1444 0 : 'symdynmat is ',dtset%symdynmat, '. The only allowed values',ch10, &
1445 0 : 'are 0, or 1.',ch10, 'Action: correct symdynmat in your input file.'
1446 0 : ABI_ERROR(message)
1447 : end if
1448 :
1449 81 : dtset%sys_dim=1
1450 81 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'sys_dim',tread,'INT')
1451 81 : if(tread==1) dtset%sys_dim=intarr(1)
1452 81 : if(dtset%sys_dim<1.or.dtset%sys_dim>9)then
1453 : write(message, '(a,i0,5a)' )&
1454 0 : 'sys_dim is ',dtset%sys_dim,', but the only allowed values',ch10,&
1455 0 : 'are 1, 2, 3, 4, 5, 6, 7 or 8.',ch10,'Action: correct sys_dim in your input file.'
1456 0 : ABI_ERROR(message)
1457 : end if
1458 : !T
1459 :
1460 324 : dtset%targetpol(:) = 0._dp
1461 81 : call intagm(dprarr, intarr, jdtset, marr, 3, string(1:lenstr), 'targetpol',tread, 'DPR')
1462 87 : if(tread == 1) dtset%targetpol(1:3) = dprarr(1:3)
1463 :
1464 : !Default is use gaussian integration
1465 81 : dtset%telphint = 1
1466 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'telphint',tread, 'INT')
1467 81 : if(tread == 1) dtset%telphint = intarr(1)
1468 81 : if(dtset%telphint < 0 .or. dtset%telphint > 3) then
1469 : write(message, '(a, i0, 6a)' )&
1470 0 : 'telphint is ',dtset%telphint, '. The only allowed values',ch10, &
1471 0 : 'are 0 (tetrahedron) or 1 (gaussian) or ','2 (set of bands occupied ep_b_min, ep_b_max) or 3 (Fermi Dirac).',ch10, &
1472 0 : 'Action: correct telphint in your input file.'
1473 0 : ABI_ERROR(message)
1474 : end if
1475 :
1476 81 : dtset%temperinc = 100.0_dp
1477 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'temperinc',tread, 'DPR')
1478 81 : if(tread == 1) dtset%temperinc = dprarr(1)
1479 81 : if(dtset%temperinc < zero)then
1480 : write(message, '(a, f10.3, 3a)' )&
1481 0 : 'temperinc is ',dtset%temperinc, ', which is lower than 0 .',ch10, &
1482 0 : 'Action: correct temperinc in your input file.'
1483 0 : ABI_ERROR(message)
1484 : end if
1485 :
1486 81 : dtset%tempermin = 100.0_dp
1487 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'tempermin',tread, 'DPR')
1488 81 : if(tread == 1) dtset%tempermin = dprarr(1)
1489 81 : if(dtset%tempermin < -tol12)then
1490 : write(message, '(a, f10.3, 3a)' )&
1491 0 : 'tempermin is ',dtset%tempermin, ', which is lower than 0 .',ch10, &
1492 0 : 'Action: correct tempermin in your input file.'
1493 0 : ABI_ERROR(message)
1494 : end if
1495 :
1496 1053 : dtset%thermal_supercell(:,:)=0
1497 81 : marr = 9
1498 81 : ABI_FREE(intarr)
1499 81 : ABI_FREE(dprarr)
1500 81 : ABI_MALLOC(intarr, (marr))
1501 81 : ABI_MALLOC(dprarr, (marr))
1502 81 : call intagm(dprarr, intarr, jdtset, marr, 9, string(1:lenstr), 'thermal_supercell',tread, 'INT')
1503 93 : if(tread == 1) dtset%thermal_supercell(1:3, 1:3)=reshape(intarr(1:9), (/3, 3/))
1504 81 : call mati3det(dtset%thermal_supercell, idet)
1505 1053 : if(sum(abs(dtset%thermal_supercell))>0 .and. idet == 0) then
1506 : write(message, '(a, 9I6, 5a)' )&
1507 0 : 'thermal_supercell is ',dtset%thermal_supercell, ', but the matrix must be non singular',ch10, &
1508 0 : 'with a non zero determinant.',ch10, 'Action: correct thermal_supercell in your input file.'
1509 0 : ABI_ERROR(message)
1510 : end if
1511 :
1512 81 : dtset%thmflag = 0
1513 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'thmflag',tread, 'INT')
1514 81 : if(tread == 1) dtset%thmflag = intarr(1)
1515 81 : if(dtset%thmflag < 0 .or. dtset%thmflag > 8)then
1516 : write(message, '(a, i0, 5a)' )&
1517 0 : 'thmflag is ',dtset%thmflag, ', but the only allowed values',ch10, &
1518 0 : 'are between 0 to 8 (included).',ch10, 'Action: correct thmflag in your input file.'
1519 0 : ABI_ERROR(message)
1520 : end if
1521 :
1522 81 : dtset%thmtol = 0.25_dp
1523 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'thmtol',tread, 'DPR')
1524 81 : if(tread == 1) dtset%thmtol = dprarr(1)
1525 81 : if(dtset%thmtol < zero)then
1526 : write(message, '(a, es14.4, 3a)' )&
1527 0 : 'thmtol is ',dtset%thmtol, ', which is lower than 0 .',ch10, &
1528 0 : 'Action: correct thmtol in your input file.'
1529 0 : ABI_ERROR(message)
1530 : end if
1531 :
1532 81 : dtset%timdisp = 0
1533 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'timdisp',tread, 'INT')
1534 81 : if(tread == 1) dtset%timdisp = intarr(1)
1535 :
1536 81 : dtset%ep_prt_yambo = 0
1537 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'ep_prt_yambo',tread, 'INT')
1538 81 : if(tread == 1) dtset%ep_prt_yambo = intarr(1)
1539 81 : if(dtset%ep_prt_yambo < 0 .or. dtset%ep_prt_yambo > 1) then
1540 : write(message, '(a, i0, 5a)' )&
1541 0 : 'ep_prt_yambo is ',dtset%ep_prt_yambo, ', but the only allowed values',ch10, &
1542 0 : 'are 0 or 1.',ch10, 'Action: correct ep_prt_yambo in your input file.'
1543 0 : ABI_ERROR(message)
1544 : end if
1545 :
1546 : !default means _do_ symmetrize the ep coupling matrices over qpoints
1547 81 : dtset%symgkq = 1
1548 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'symgkq',tread, 'INT')
1549 81 : if(tread == 1) dtset%symgkq = intarr(1)
1550 81 : if(dtset%symgkq < 0 .or. dtset%symgkq > 1) then
1551 : write(message, '(a, i0, 5a)' )&
1552 0 : 'symgkq is ',dtset%symgkq, ', but the only allowed values',ch10, &
1553 0 : 'are 0 or 1.',ch10, 'Action: correct symgkq in your input file.'
1554 0 : ABI_ERROR(message)
1555 81 : else if (dtset%symgkq == 0) then
1556 1 : ABI_WARNING('You have turned off el-ph matrix symmetrization over q. Use at own risk')
1557 : end if
1558 :
1559 : !U
1560 :
1561 81 : dtset%use_k_fine = 0
1562 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'use_k_fine',tread, 'INT')
1563 81 : if(tread == 1) dtset%use_k_fine = intarr(1)
1564 81 : if(dtset%use_k_fine /= 1 .and. dtset%use_k_fine /= 0) then
1565 : write(message, '(a, i0, 5a)' )&
1566 0 : 'use_k_fine is ',dtset%use_k_fine, ', but the only allowed values',ch10, &
1567 0 : 'are 1 or 0.',ch10, 'Action: correct use_k_fine in your input file.'
1568 0 : ABI_ERROR(message)
1569 : end if
1570 :
1571 81 : if(dtset%use_k_fine == 1) then
1572 0 : if (sum(dtset%kptrlatt) == 0 .or. sum(dtset%kptrlatt_fine) == 0 ) then
1573 0 : ABI_ERROR('If a finer k-grid is used, you must specify both kptrlatt and kptrlatt_fine')
1574 : end if
1575 : end if
1576 :
1577 :
1578 : !V
1579 243 : dtset%vs_qrad_tolkms(:) = zero
1580 81 : call intagm(dprarr, intarr, jdtset, marr, 2, string(1:lenstr), 'vs_qrad_tolkms',tread, 'DPR')
1581 81 : if (tread == 1) then
1582 3 : dtset%vs_qrad_tolkms(:) = dprarr(1:2)
1583 1 : ABI_CHECK(dprarr(1) >= zero, "vs_qrad must be >= 0")
1584 1 : ABI_CHECK(dprarr(2) > zero, "vs_tolkms must be > zero")
1585 : end if
1586 : !W
1587 :
1588 : !X
1589 :
1590 : !Y
1591 :
1592 : !Z
1593 :
1594 : !=====================================================================
1595 : !end non-dependent variables
1596 : !=====================================================================
1597 :
1598 : !=======================================================================
1599 : !Read in dependent variables (dependent on dimensions above)
1600 : !=======================================================================
1601 :
1602 : !A
1603 :
1604 243 : ABI_MALLOC(dtset%atifc, (dtset%natifc))
1605 243 : ABI_MALLOC(dtset%atifcflg, (natom))
1606 107 : dtset%atifc(:) = 0
1607 81 : if(dtset%natifc >= 1)then
1608 : ! default to 1 for first natifc atoms
1609 42 : dtset%atifc(1:dtset%natifc)=1
1610 :
1611 16 : if(dtset%natifc > marr)then
1612 0 : marr = dtset%natifc
1613 0 : ABI_FREE(intarr)
1614 0 : ABI_FREE(dprarr)
1615 0 : ABI_MALLOC(intarr, (marr))
1616 0 : ABI_MALLOC(dprarr, (marr))
1617 : end if
1618 16 : call intagm(dprarr, intarr, jdtset, marr, dtset%natifc, string(1:lenstr), 'atifc',tread, 'INT')
1619 58 : if(tread == 1) dtset%atifc = intarr(1:dtset%natifc)
1620 : ! check of whether values of atifc are valid is done in chkin9
1621 : end if
1622 :
1623 : !B
1624 :
1625 : !C
1626 :
1627 : !D
1628 :
1629 : !E
1630 :
1631 : !F
1632 :
1633 : !G
1634 :
1635 : !H
1636 :
1637 : !I
1638 :
1639 162 : ABI_MALLOC(dtset%iatfix, (natom))
1640 341 : dtset%iatfix(:) = 0
1641 81 : if ((dtset%relaxat == 1).and.(dtset%natfix > 0)) then
1642 0 : if(natom > marr)then
1643 0 : marr = natom
1644 0 : ABI_FREE(intarr)
1645 0 : ABI_FREE(dprarr)
1646 0 : ABI_MALLOC(intarr, (marr))
1647 0 : ABI_MALLOC(dprarr, (marr))
1648 : end if
1649 0 : call intagm(dprarr, intarr, jdtset, marr, dtset%natfix, string(1:lenstr), 'iatfix',tread, 'INT')
1650 0 : if(tread == 1) dtset%iatfix(1:dtset%natfix) = intarr(1:dtset%natfix)
1651 : end if
1652 : !FIXME: need a test on values of iatfix: are they just 1 or 0?
1653 :
1654 81 : if ((dtset%relaxstr == 1).and.(dtset%nstrfix > 0)) then
1655 7 : dtset%istrfix(:) = 0
1656 1 : call intagm(dprarr, intarr, jdtset, marr, dtset%nstrfix, string(1:lenstr), 'istrfix',tread, 'INT')
1657 3 : if(tread == 1) dtset%istrfix(1:dtset%nstrfix) = intarr(1:dtset%nstrfix)
1658 : end if
1659 : !FIXME: need a test on values of istrfix
1660 :
1661 81 : if (dtset%natprj_bs > 0) then
1662 9 : ABI_MALLOC(dtset%iatprj_bs, (dtset%natprj_bs))
1663 3 : if(dtset%natprj_bs > marr)then
1664 0 : marr = dtset%natprj_bs
1665 0 : ABI_FREE(intarr)
1666 0 : ABI_FREE(dprarr)
1667 0 : ABI_MALLOC(intarr, (marr))
1668 3 : ABI_MALLOC(dprarr, (marr))
1669 : end if
1670 9 : dtset%iatprj_bs(:)=0
1671 3 : call intagm(dprarr, intarr, jdtset, marr, dtset%natprj_bs, string(1:lenstr), 'iatprj_bs',tread, 'INT')
1672 3 : if(tread == 1) then
1673 9 : dtset%iatprj_bs(1:dtset%natprj_bs)=intarr(1:dtset%natprj_bs)
1674 : else
1675 : write(message, '(3a)')&
1676 0 : 'natprj_bs is non zero but iatprj_bs is absent ',ch10, &
1677 0 : 'Action: specify iatprj_bs in your input file.'
1678 0 : ABI_ERROR(message)
1679 : end if
1680 : end if
1681 :
1682 : !J
1683 :
1684 : !K
1685 :
1686 : !L
1687 :
1688 :
1689 81 : if (dtset%lwfflag .eq. 1 ) then
1690 6 : ABI_MALLOC(dtset%lwf_anchor_iband, (dtset%lwf_nwann))
1691 :
1692 2 : if(dtset%lwf_nwann > marr)then
1693 0 : marr = dtset%lwf_nwann
1694 0 : ABI_FREE(intarr)
1695 0 : ABI_FREE(dprarr)
1696 0 : ABI_MALLOC(intarr, (marr))
1697 2 : ABI_MALLOC(dprarr, (marr))
1698 : end if
1699 8 : dtset%lwf_anchor_iband(:)=0
1700 2 : call intagm(dprarr, intarr, jdtset, marr, dtset%lwf_nwann, string(1:lenstr), 'lwf_anchor_iband',tread, 'INT')
1701 2 : if(tread == 1) then
1702 8 : dtset%lwf_anchor_iband(1:dtset%lwf_nwann)=intarr(1:dtset%lwf_nwann)
1703 : !else
1704 : ! write(message, '(3a)')&
1705 : ! 'lwfflag > 0 and lwf_anchor_proj = 1 but lwf_anchor_iband is absent ',ch10, &
1706 : ! 'Action: specify lwf_anchor_iband in your input file.'
1707 : ! ABI_ERROR(message)
1708 : end if
1709 :
1710 79 : else if (dtset%lwfflag .eq. 2 ) then
1711 :
1712 3 : ABI_MALLOC(dtset%lwf_projector, (dtset%lwf_nwann))
1713 :
1714 1 : if(dtset%lwf_nwann > marr)then
1715 0 : marr = dtset%lwf_nwann
1716 0 : ABI_FREE(intarr)
1717 0 : ABI_FREE(dprarr)
1718 0 : ABI_MALLOC(intarr, (marr))
1719 1 : ABI_MALLOC(dprarr, (marr))
1720 : end if
1721 4 : dtset%lwf_projector(:)=0
1722 1 : call intagm(dprarr, intarr, jdtset, marr, dtset%lwf_nwann, string(1:lenstr), 'lwf_projector',tread, 'INT')
1723 1 : if(tread == 1) then
1724 4 : dtset%lwf_projector(1:dtset%lwf_nwann)=intarr(1:dtset%lwf_nwann)
1725 : else
1726 : write(message, '(3a)')&
1727 0 : 'lwfflag = 2 and lwf_anchor_proj = 1 but lwf_projector is absent ',ch10, &
1728 0 : 'Action: specify lwf_projector in your input file.'
1729 0 : ABI_ERROR(message)
1730 : end if
1731 :
1732 : end if
1733 :
1734 : !M
1735 :
1736 : !N
1737 :
1738 : !O
1739 :
1740 : !P
1741 :
1742 : !Q
1743 :
1744 81 : if (dtset%nqshft /= 0)then
1745 81 : if(3*dtset%nqshft > marr)then
1746 4 : marr = 3*dtset%nqshft
1747 4 : ABI_FREE(intarr)
1748 4 : ABI_FREE(dprarr)
1749 12 : ABI_MALLOC(intarr, (marr))
1750 89 : ABI_MALLOC(dprarr, (marr))
1751 : end if
1752 1377 : dtset%q1shft(:,:)=zero
1753 81 : call intagm(dprarr, intarr, jdtset, marr, 3*dtset%nqshft, string(1:lenstr), 'q1shft',tread, 'DPR')
1754 81 : if(tread == 1) dtset%q1shft(1:3, 1:dtset%nqshft)=&
1755 476 : & reshape(dprarr(1:3*dtset%nqshft), (/3, dtset%nqshft/))
1756 : end if
1757 :
1758 243 : ABI_MALLOC(dtset%qph1l, (3, dtset%nph1l))
1759 243 : ABI_MALLOC(dtset%qnrml1, (dtset%nph1l))
1760 81 : if (dtset%nph1l /= 0)then
1761 57 : if(4*dtset%nph1l > marr)then
1762 33 : marr = 4*dtset%nph1l
1763 33 : ABI_FREE(intarr)
1764 33 : ABI_FREE(dprarr)
1765 99 : ABI_MALLOC(intarr, (marr))
1766 123 : ABI_MALLOC(dprarr, (marr))
1767 : end if
1768 2501 : dtset%qph1l(:,:)=zero
1769 668 : dtset%qnrml1(:)=zero
1770 57 : call intagm(dprarr, intarr, jdtset, marr, 4*dtset%nph1l, string(1:lenstr), 'qph1l',tread, 'DPR')
1771 57 : if(tread == 1)then
1772 668 : do iph1 = 1, dtset%nph1l
1773 2444 : do ii = 1, 3
1774 2444 : dtset%qph1l(ii, iph1)=dprarr(ii+(iph1-1)*4)
1775 : end do
1776 611 : dtset%qnrml1(iph1)=dprarr(4+(iph1-1)*4)
1777 668 : if(abs(dtset%qnrml1(iph1))<DDB_QTOL)then
1778 : write(message, '(5a)' )&
1779 0 : 'The first list of wavevectors ','should not have non-analytical data.',ch10, &
1780 0 : 'Action: correct the first list',' of wavevectors in the input file.'
1781 0 : ABI_ERROR(message)
1782 : end if
1783 : end do
1784 : end if
1785 : end if
1786 :
1787 243 : ABI_MALLOC(dtset%qph2l, (3, dtset%nph2l))
1788 243 : ABI_MALLOC(dtset%qnrml2, (dtset%nph2l))
1789 81 : if (dtset%nph2l /= 0)then
1790 24 : if(4*dtset%nph2l > marr)then
1791 6 : marr = 4*dtset%nph2l
1792 6 : ABI_FREE(intarr)
1793 6 : ABI_FREE(dprarr)
1794 18 : ABI_MALLOC(intarr, (marr))
1795 36 : ABI_MALLOC(dprarr, (marr))
1796 : end if
1797 172 : dtset%qph2l(:,:)=zero
1798 61 : dtset%qnrml2(:)=zero
1799 24 : call intagm(dprarr, intarr, jdtset, marr, 4*dtset%nph2l, string(1:lenstr), 'qph2l',tread, 'DPR')
1800 24 : if(tread == 1)then
1801 61 : do iph2 = 1, dtset%nph2l
1802 148 : do ii = 1, 3
1803 148 : dtset%qph2l(ii, iph2)=dprarr(ii+(iph2-1)*4)
1804 : end do
1805 37 : dtset%qnrml2(iph2)=dprarr(4+(iph2-1)*4)
1806 61 : if(abs(dtset%qnrml2(iph2))>DDB_QTOL)then
1807 : write(message, '(5a)' )&
1808 0 : 'The second list of wavevectors',' should have only non-analytical data.',ch10, &
1809 0 : 'Action: correct the second list','of wavevectors in the input file.'
1810 0 : ABI_ERROR(message)
1811 : end if
1812 : end do
1813 : end if
1814 : end if
1815 :
1816 81 : if (dtset%nqpath > 0) then
1817 72 : ABI_MALLOC(dtset%qpath, (3, dtset%nqpath))
1818 24 : if(3*dtset%nqpath > marr)then
1819 14 : marr = 3*dtset%nqpath
1820 14 : ABI_FREE(intarr)
1821 14 : ABI_FREE(dprarr)
1822 42 : ABI_MALLOC(intarr, (marr))
1823 52 : ABI_MALLOC(dprarr, (marr))
1824 : end if
1825 708 : dtset%qpath(:,:)=zero
1826 24 : call intagm(dprarr, intarr, jdtset, marr, 3*dtset%nqpath, string(1:lenstr), 'qpath',tread, 'DPR')
1827 24 : if(tread == 1) then
1828 756 : dtset%qpath(1:3, 1:dtset%nqpath)= reshape(dprarr(1:3*dtset%nqpath), (/3, dtset%nqpath/))
1829 : else
1830 : write(message, '(3a)')&
1831 0 : 'nqpath is non zero but qpath is absent ',ch10, &
1832 0 : 'Action: specify qpath in your input file.'
1833 0 : ABI_ERROR(message)
1834 : end if
1835 : end if
1836 :
1837 : !R
1838 :
1839 : !S
1840 :
1841 : !T
1842 :
1843 : !U
1844 :
1845 : !V
1846 :
1847 : !W
1848 :
1849 : !X
1850 :
1851 : !Y
1852 :
1853 : !Z
1854 :
1855 : !=======================================================================
1856 : !Finished reading in variables-deallocate
1857 : !=======================================================================
1858 :
1859 81 : ABI_FREE(dprarr)
1860 81 : ABI_FREE(intarr)
1861 :
1862 : !=======================================================================
1863 : !Check consistency of input variables:
1864 : !=======================================================================
1865 :
1866 81 : if (dtset%frmin > dtset%frmax) then
1867 : write(message, '(3a)' )&
1868 0 : 'frmax should be higher than frmin',ch10, &
1869 0 : 'Action: change frmax and/or frmin in your input file.'
1870 0 : ABI_ERROR(message)
1871 : end if
1872 :
1873 81 : if (dtset%nqpath == 0 .and. dtset%elphflag == 1) then
1874 : write(message, '(4a)' )&
1875 0 : 'elphflag is 1 but no nqpath has been specified','for phonon linewidths',ch10, &
1876 0 : 'Action: specify nqpath and qpath(3, nqpath) in your input file.'
1877 0 : ABI_ERROR(message)
1878 : end if
1879 :
1880 81 : if(dtset%telphint /= 2 .and. (dtset%ep_b_min /= 0 .or. dtset%ep_b_max /= 0)) then
1881 : write(message, '(a, i0, 3a)' )&
1882 0 : 'telphint is ',dtset%telphint, ', but ep_b_min or ep_b_max',ch10, &
1883 0 : 'are set /= 1. They will not be used'
1884 0 : call wrtout(std_out, message, 'COLL')
1885 0 : ABI_WARNING(message)
1886 :
1887 81 : else if(dtset%telphint == 2 .and. (dtset%ep_b_min == 0 .or. dtset%ep_b_max == 0)) then
1888 : write(message, '(a, i0, 4a)' )&
1889 0 : 'telphint is ',dtset%telphint, ', but ep_b_min or ep_b_max',ch10, &
1890 0 : 'are not both set. ',ch10, &
1891 0 : 'Action: set ep_b_min and ep_b_max in your input file.',ch10
1892 0 : ABI_ERROR(message)
1893 : end if
1894 :
1895 81 : if(dtset%thmflag < 3) then
1896 : if ((dtset%telphint == 0 .or. dtset%prtnest == 1 .or. &
1897 962 : dtset%prtnest == 2 .or. dtset%prtfsurf == 1) .and. sum(dtset%kptrlatt) == 0 ) then
1898 : write (message, '(3a)') &
1899 0 : 'if tetrahedron integration is used, ',&
1900 0 : 'or the output of the nesting function/Fermi surface is required, ',&
1901 0 : 'you must specify the kptrlatt'
1902 0 : ABI_ERROR(message)
1903 : end if
1904 : end if
1905 :
1906 81 : if(dtset%prtdos /= 0 .and. dtset%ifcflag /= 1) then
1907 : write(message, '(3a)' )&
1908 0 : 'ifcflag must be 1 when the calculation of the phonon DOS is required ',ch10, &
1909 0 : 'Action: correct ifcflag in your input file.'
1910 0 : ABI_ERROR(message)
1911 : end if
1912 :
1913 81 : if(dtset%prtsrlr /= 0 .and. dtset%ifcflag /= 1) then
1914 : write(message, '(3a)' )&
1915 0 : 'ifcflag must be 1 for the SR/LR decomposition of the phonon frequencies',ch10, &
1916 0 : 'Action: correct ifcflag in your input file.'
1917 0 : ABI_ERROR(message)
1918 : end if
1919 :
1920 81 : if (dtset%gruns_nddbs /= 0 .and. dtset%ifcflag /= 1) then
1921 0 : ABI_ERROR("ifcflag must be 1 for Gruneisen calculation")
1922 : end if
1923 :
1924 81 : if (dtset%vs_qrad_tolkms(1) /= zero .and. dtset%ifcflag /= 1) then
1925 0 : ABI_ERROR("ifcflag must be 1 to calculate speed of sound")
1926 : end if
1927 :
1928 324 : if(dtset%prtdos /= 0 .and. sum(abs(dtset%ng2qpt(:))) < 3 ) then
1929 : write(message, '(3a)' )&
1930 0 : 'ng2qpt must be specified when the calculation of the phonon DOS is required ',ch10, &
1931 0 : 'Action: correct ng2qpt in your input file.'
1932 0 : ABI_ERROR(message)
1933 : end if
1934 :
1935 81 : if (dtset%ifltransport /= 0 .and. dtset%ep_keepbands /= 1) then
1936 : write(message, '(3a)' )&
1937 0 : 'Band dependency of electron phonon matrix elements must be kept for transport ',ch10, &
1938 0 : 'Action: set ep_keepbands to 1 in your input file.'
1939 0 : ABI_ERROR(message)
1940 : end if
1941 :
1942 1053 : if (dtset%ifltransport > 1 .and. sum(abs(dtset%kptrlatt)) == 0) then
1943 : write(message, '(3a)' )&
1944 0 : 'For inelastic transport or electron lifetime calculations you must specify kprtlatt ',ch10, &
1945 0 : 'Action: copy kptrlatt from your abinit GS file to your anaddb input file.'
1946 0 : ABI_ERROR(message)
1947 : end if
1948 :
1949 : !FIXME: add check that if freeze_displ /= 0 then you need to be doing ifc and phonon interpolation
1950 :
1951 810 : if (dtset%ifcflag > 0 .and. sum(abs(dtset%ngqpt)) == 0) then
1952 : write(message, '(3a)' )&
1953 0 : 'if you want interatomic force constant output, anaddb needs ngqpt input variable ',ch10, &
1954 0 : 'Action: set ngqpt in your input file.'
1955 0 : ABI_ERROR(message)
1956 : end if
1957 :
1958 :
1959 81 : if (dtset%ifcflag /= 1 .and. dtset%lwfflag > 0) then
1960 : write(message, '(3a)' )&
1961 0 : 'if you want to construct the lattice wannier functions, IFC must be computed.', ch10, &
1962 0 : 'Action: set ifcflag to 1.'
1963 0 : ABI_ERROR(message)
1964 : end if
1965 :
1966 :
1967 :
1968 : !check that q-grid refinement is a divisor of ngqpt in each direction
1969 645 : if(any(dtset%qrefine(1:3) > 1) .and. &
1970 : any(abs(dmod(dble(dtset%ngqpt(1:3))/dble(dtset%qrefine(1:3)), one)) > tol10) ) then
1971 : write(message, '(a, 3i10, a, a, a, 3i8, a, a)' )&
1972 0 : 'qrefine is',dtset%qrefine(1:3), ' The only allowed values',ch10, &
1973 0 : 'are integers which are divisors of the ngqpt grid', dtset%ngqpt(1:3), ch10, &
1974 0 : 'Action: correct qrefine in your input file.'
1975 0 : ABI_ERROR(message)
1976 : end if
1977 :
1978 : !check that fermie and nelect are not both specified
1979 81 : if(abs(dtset%elph_fermie) > tol10 .and. abs(dtset%ep_extrael) > tol10) then
1980 : write(message, '(a, E10.2, a, E10.2, a, a, a)' )&
1981 0 : 'elph_fermie (',dtset%elph_fermie, ') and ep_extrael (',dtset%ep_extrael, '), may not both be non 0',ch10, &
1982 0 : 'Action: remove one of the two in your input file.'
1983 0 : ABI_ERROR(message)
1984 : end if
1985 :
1986 : ! Check for possible typos.
1987 81 : call anaddb_chkvars(string)
1988 :
1989 81 : end subroutine invars9
1990 : !!***
1991 :
1992 : !----------------------------------------------------------------------
1993 :
1994 : !!****f*m_anaddb_dataset/outvars_anaddb
1995 : !!
1996 : !! NAME
1997 : !! outvars_anaddb
1998 : !!
1999 : !! FUNCTION
2000 : !! Open input file for the anaddb code, then
2001 : !! echoes the input information.
2002 : !!
2003 : !! INPUTS
2004 : !! dtset= (derived datatype) contains all the input variables
2005 : !! nunit = unit number for input or output
2006 : !!
2007 : !! OUTPUT
2008 : !! (only writing)
2009 : !!
2010 : !! NOTES
2011 : !! Should be executed by one processor only.
2012 : !!
2013 : !! SOURCE
2014 :
2015 162 : subroutine outvars_anaddb(dtset, nunit)
2016 :
2017 : !Arguments-------------------------------
2018 : !scalars
2019 : class(anaddb_dataset_type), intent(inout):: dtset
2020 : integer, intent(in):: nunit
2021 :
2022 : !Local variables-------------------------
2023 : !scalars
2024 : integer:: ii, iph1, iph2, iqpt, iqshft
2025 :
2026 : !*********************************************************************
2027 :
2028 : !Write the heading
2029 13122 : write(nunit, '(a, 80a, a)') ch10, ('=',ii = 1, 80), ch10
2030 162 : write(nunit, '(2a)' )' -outvars_anaddb: echo values of input variables ----------------------',ch10
2031 :
2032 : !The flags
2033 : if (dtset%dieflag /= 0 .or. dtset%ifcflag /= 0 .or. &
2034 : dtset%flexoflag /= 0 .or. &
2035 : dtset%nlflag /= 0 .or. dtset%thmflag /= 0 .or. &
2036 : dtset%elaflag /= 0 .or. dtset%elphflag /= 0 .or. &
2037 : dtset%polflag /= 0 .or. dtset%instrflag /= 0 .or. &
2038 162 : dtset%piezoflag /= 0 .or. dtset%freqflag /= 0) then
2039 152 : write(nunit, '(a)')' Flags :'
2040 152 : if(dtset%dieflag /= 0)write(nunit, '(3x, a9, 3i10)')' dieflag',dtset%dieflag
2041 152 : if(dtset%flexoflag /= 0)write(nunit, '(3x, a9, 3i10)')'flexoflag',dtset%flexoflag
2042 152 : if(dtset%ifcflag /= 0)write(nunit, '(3x, a9, 3i10)')' ifcflag',dtset%ifcflag
2043 152 : if(dtset%nlflag /= 0)write(nunit, '(3x, a9, 3i10)')' nlflag',dtset%nlflag
2044 152 : if(dtset%thmflag /= 0)write(nunit, '(3x, a9, 3i10)')' thmflag',dtset%thmflag
2045 152 : if(dtset%elaflag /= 0)write(nunit, '(3x, a9, 3i10)')' elaflag',dtset%elaflag
2046 152 : if(dtset%elphflag /= 0)write(nunit, '(3x, a9, 3i10)')' elphflag',dtset%elphflag
2047 152 : if(dtset%polflag /= 0)write(nunit, '(3x, a9, 3i10)')' polflag',dtset%polflag
2048 152 : if(dtset%instrflag /= 0)write(nunit, '(3x, a9, 3i10)')'instrflag',dtset%instrflag
2049 152 : if(dtset%piezoflag /= 0)write(nunit, '(3x, a9, 3i10)')'piezoflag',dtset%piezoflag
2050 152 : if(dtset%lwfflag /= 0)write(nunit, '(3x, a9, 3i10)')'lwfflag',dtset%lwfflag
2051 152 : if(dtset%freqflag /= 0)write(nunit, '(3x, a9, 3i10)')'lwfflag',dtset%freqflag
2052 : end if
2053 :
2054 : !Write the general information
2055 : if (dtset%rfmeth /= 1 .or. &
2056 : dtset%enunit /= 0 .or. &
2057 : dtset%eivec /= 0 .or. &
2058 : dtset%asr /= 0 .or. &
2059 : dtset%chneut /= 0 .or. &
2060 162 : dtset%selectz /= 0 .or. dtset%symdynmat /= 1) then
2061 154 : write(nunit, '(a)')' Miscellaneous information :'
2062 154 : if(dtset%rfmeth /= 1)write(nunit, '(3x, a9, 3i10)')' rfmeth',dtset%rfmeth
2063 154 : if(dtset%enunit /= 0)write(nunit, '(3x, a9, 3i10)')' enunit',dtset%enunit
2064 154 : if(dtset%eivec /= 0) write(nunit, '(3x, a9, 3i10)')' eivec',dtset%eivec
2065 154 : if(dtset%asr /= 0) write(nunit, '(3x, a9, 3i10)')' asr',dtset%asr
2066 154 : if(dtset%chneut /= 1)write(nunit, '(3x, a9, 3i10)')' chneut',dtset%chneut
2067 154 : if(dtset%selectz /= 0)write(nunit, '(3x, a9, 3i10)')' selectz',dtset%selectz
2068 154 : if(dtset%symdynmat /= 1)write(nunit, '(3x, a9, 3i10)')'symdynmat',dtset%symdynmat
2069 : end if
2070 162 : if(dtset%prtvol /= 0) write(nunit, '(3x, a9, i10)')' prtvol',dtset%prtvol
2071 :
2072 : !Frequency information
2073 162 : if(dtset%dieflag == 1)then
2074 16 : write(nunit, '(a)')' Frequency information :'
2075 16 : write(nunit, '(3x, a9, 3i10)')' nfreq',dtset%nfreq
2076 16 : write(nunit, '(3x, a9, 7x, 3es16.8)')' frmin',dtset%frmin
2077 16 : write(nunit, '(3x, a9, 7x, 3es16.8)')' frmax',dtset%frmax
2078 : end if
2079 :
2080 : !For interatomic force constant information
2081 162 : if(dtset%ifcflag /= 0)then
2082 110 : write(nunit, '(a)')' Interatomic Force Constants Inputs :'
2083 110 : write(nunit, '(3x, a9, 3i10)')' dipdip',dtset%dipdip
2084 110 : write(nunit, '(3x, a9, 3i10)')' dipquad',dtset%dipquad
2085 110 : write(nunit, '(3x, a9, 3i10)')' quadquad',dtset%quadquad
2086 110 : if(dtset%nsphere /= 0)write(nunit, '(3x, a9, 3i10)')' nsphere',dtset%nsphere
2087 110 : if(abs(dtset%rifcsph)>tol10)write(nunit, '(3x, a9, E16.6)')' nsphere',dtset%rifcsph
2088 110 : write(nunit, '(3x, a9, 3i10)')' ifcana',dtset%ifcana
2089 110 : write(nunit, '(3x, a9, 3i10)')' ifcout',dtset%ifcout
2090 110 : if(dtset%natifc >= 1)then
2091 26 : write(nunit, '(3x, a9, 3i10)')' natifc',dtset%natifc
2092 66 : write(nunit, '(3x, a9, 8i10)')' atifc',(dtset%atifc(ii), ii = 1, dtset%natifc)
2093 : end if
2094 110 : write(nunit, '(a)')' Description of grid 1 :'
2095 110 : write(nunit, '(3x, a9, 3i10)')' brav',dtset%brav
2096 110 : write(nunit, '(3x, a9, 3i10)')' ngqpt',dtset%ngqpt(1:3)
2097 110 : write(nunit, '(3x, a9, 3i10)')' nqshft',dtset%nqshft
2098 110 : if (dtset%nqshft /= 0)then
2099 110 : write(nunit, '(3x, a9)')' q1shft'
2100 242 : do iqshft = 1, dtset%nqshft
2101 638 : write(nunit, '(19x, 4es16.8)') (dtset%q1shft(ii, iqshft), ii = 1, 3)
2102 : end do
2103 : end if
2104 434 : if (any(dtset%qrefine(:) > 1)) then
2105 2 : write(nunit, '(3x, a9, 3i10)')' qrefine', dtset%qrefine
2106 : end if
2107 : ! Speed of sound
2108 110 : if (dtset%vs_qrad_tolkms(1) > zero) then
2109 6 : write(nunit, '(a, 2es16.8)')"vs_qrad_tolkms", (dtset%vs_qrad_tolkms(:))
2110 : end if
2111 : end if
2112 :
2113 : !Phonon density of states with gaussian method
2114 162 : if(dtset%prtdos /= 0)then
2115 22 : write(nunit, '(a)')' Phonon DOS information :'
2116 22 : write(nunit, '(3x, a9, es16.8)')'dosdeltae',dtset%dosdeltae
2117 22 : write(nunit, '(3x, a9, es16.8)')' dossmear',dtset%dossmear
2118 : end if
2119 :
2120 : !Thermal information
2121 162 : if(dtset%thmflag /= 0)then
2122 22 : write(nunit, '(a)')' Thermal information :'
2123 22 : write(nunit, '(3x, a9, 3i10)')' nchan',dtset%nchan
2124 22 : write(nunit, '(3x, a9, 3i10)')' nwchan',dtset%nwchan
2125 22 : write(nunit, '(3x, a9, 7x, 3es16.8)')' dostol',dtset%dostol
2126 22 : write(nunit, '(3x, a9, 7x, 3es16.8)')' thmtol',dtset%thmtol
2127 22 : write(nunit, '(3x, a9, 3i10)')' ntemper',dtset%ntemper
2128 22 : write(nunit, '(3x, a9, 7x, 3es16.8)')'temperinc',dtset%temperinc
2129 22 : write(nunit, '(3x, a9, 7x, 3es16.8)')'tempermin',dtset%tempermin
2130 : endif
2131 :
2132 : !Grid 2 description
2133 162 : if(dtset%thmflag /= 0 .or. dtset%prtdos /= 0)then
2134 44 : write(nunit, '(a)')' Description of grid 2 (Fourier interp. or BZ sampling):'
2135 44 : write(nunit, '(3x, a9, 3i10)')' ng2qpt',dtset%ng2qpt(1:3)
2136 44 : write(nunit, '(3x, a9, 3i10)')' ngrids',dtset%ngrids
2137 44 : write(nunit, '(3x, a9, 7x, 3es16.8)')' q2shft',dtset%q2shft(1:3)
2138 : end if
2139 :
2140 : !Non-linear response information
2141 162 : if (dtset%nlflag /= 0) then
2142 8 : write(nunit, '(a)')' Non-linear response information :'
2143 8 : write(nunit, '(3x, a9, i10)') ' alphon',dtset%alphon
2144 8 : write(nunit, '(3x, a9, 3i10)')' prtmbm',dtset%prtmbm
2145 8 : write(nunit, '(3x, a9, 3i10)')' ramansr',dtset%ramansr
2146 : end if
2147 :
2148 : !Structural relaxation at fixed polarization
2149 162 : if (dtset%polflag /= 0) then
2150 6 : write(nunit, '(a)')' Relaxation at fixed polarization :'
2151 6 : if (dtset%relaxat == 1) then
2152 4 : write(nunit, '(3x, a9, i10)') ' relaxat',dtset%relaxat
2153 : end if
2154 6 : if (dtset%relaxstr == 1) then
2155 4 : write(nunit, '(a12, i10)') ' relaxstr',dtset%relaxstr
2156 : end if
2157 : end if
2158 :
2159 : !Elphon information
2160 162 : if (dtset%elphflag /= 0) then
2161 30 : write(nunit, '(a)')' Elphon calculation will be carried out'
2162 30 : write(nunit, '(a12, E16.6)') 'elphsmear', dtset%elphsmear
2163 30 : write(nunit, '(a12, E16.6)') 'a2fsmear', dtset%a2fsmear
2164 30 : write(nunit, '(a12, E16.6)') 'mustar', dtset%mustar
2165 30 : write(nunit, '(a12, i10)') 'nqpath', dtset%nqpath
2166 30 : write(nunit, '(a12)') 'qpath'
2167 270 : do iqpt = 1, dtset%nqpath
2168 270 : write(nunit, '(12x, 3(E16.6, 1x))') dtset%qpath(:,iqpt)
2169 : end do
2170 30 : write(nunit, '(a12, i10)') 'telphint', dtset%telphint
2171 30 : if (dtset%telphint == 0) then
2172 4 : write(nunit, '(a)') ' Tetrahedron integration for elphon'
2173 26 : else if (dtset%telphint == 1) then
2174 24 : write(nunit, '(a)') ' Smeared weight integration for elphon'
2175 2 : else if (dtset%telphint == 2) then
2176 2 : write(nunit, '(a)') ' Band filtered integration for elphon'
2177 : end if
2178 30 : if (abs(dtset%elph_fermie) > tol10) then
2179 4 : write(nunit, '(a12, E16.6)') 'elph_fermie', dtset%elph_fermie
2180 : end if
2181 30 : if (dtset%ep_extrael /= 0) then
2182 2 : if (abs(dtset%ep_extrael) > 1.0d2) then
2183 0 : write(nunit, '(a, E20.12)')' Doping set by the user is (negative for el doping) :',dtset%ep_extrael
2184 : else
2185 2 : write(nunit, '(a, E16.6)') 'Elphon: extra electrons per unit cell = ', dtset%ep_extrael
2186 : end if
2187 : end if
2188 30 : if (dtset%ep_nspline /= 20) then
2189 0 : write(nunit, '(a, I8)') 'Elphon: scale factor for spline interpolation in RTA = ', dtset%ep_nspline
2190 : end if
2191 30 : if (dtset%band_gap < 10.0d0) then
2192 0 : write(nunit, '(a, E16.6)') 'Elphon: set band gap to (in eV) = ', dtset%band_gap
2193 : end if
2194 :
2195 390 : if (sum(abs(dtset%kptrlatt)) > 0) then
2196 100 : write(nunit, '(a12, 3(3(i3, 1x), 2x))' ) 'kptrlatt',reshape( dtset%kptrlatt(:,:), (/9/) )
2197 : end if
2198 :
2199 390 : if (sum(abs(dtset%kptrlatt_fine)) > 0) then
2200 0 : write(nunit, '(a12, 3(3(i3, 1x), 2x))' ) 'kptrlatt_fine ',reshape( dtset%kptrlatt_fine(:,:), (/9/) )
2201 : end if
2202 :
2203 30 : if (dtset%ep_keepbands == 1) then
2204 10 : write(nunit, '(a)') ' Will keep band dependency in gkk in memory.'
2205 10 : write(nunit, '(a)') ' WARNING: the memory requirements will be multiplied by nbands**2 !!!'
2206 : end if
2207 :
2208 30 : if (dtset%ep_scalprod == 1) then
2209 8 : write(nunit, '(a)') ' scalar product will be performed when assembling the gamma matrices.'
2210 8 : write(nunit, '(a)') ' WARNING: with this option you can not distinguish which '
2211 8 : write(nunit, '(a)') ' linewidth comes from which phonon mode !!!'
2212 : end if
2213 :
2214 30 : if (dtset%prtbltztrp == 1) write(nunit, '(a)') ' Will output input files for BoltzTraP'
2215 30 : if (dtset%prtfsurf == 1) write(nunit, '(a)') ' Will output fermi surface in XCrysDen format'
2216 30 : if (dtset%prt_ifc == 1) write(nunit, '(a)') ' Will output real space IFC in AI2PS and TDEP format'
2217 30 : if (dtset%prtnest == 1) write(nunit, '(a)') ' Will output nesting factor'
2218 :
2219 30 : if (dtset%ifltransport == 1) then
2220 10 : write(nunit, '(a)') ' Will perform transport calculation in elphon to get'
2221 10 : write(nunit, '(a, a)') ' resistivity and thermal conductivity as a function of T',ch10
2222 10 : write(nunit, '(a, es16.6, a)' ) ' Minimum temperature for transport outputs: ', dtset%tempermin, ' K'
2223 10 : write(nunit, '(a, es16.6, a)' ) ' Maximum temperature for transport outputs: ', &
2224 20 : dtset%tempermin+dtset%temperinc*dtset%ntemper, ' K'
2225 10 : write(nunit, '(a, i6)' ) ' Number of temperature points for transport outputs: ', dtset%ntemper
2226 10 : write(nunit, '(a)' )
2227 : end if
2228 :
2229 30 : if (dtset%gkqwrite == 1) then
2230 2 : write(nunit, '(a, a)' ) 'Gkk matrix elements on input grid of ',&
2231 4 : 'qpoints will be written to disk. File gkqfile must be absent.'
2232 : end if
2233 30 : if (dtset%gkk_rptwrite == 1) then
2234 0 : write(nunit, '(a, a)' ) 'Gkk matrix elements in real space ',&
2235 0 : 'will be written to disk. File gkk_rpt_file must be absent.'
2236 : end if
2237 30 : if (dtset%gkk2write == 1) then
2238 0 : write(nunit, '(a, a)' ) 'Full grid gkk matrix elements ',&
2239 0 : 'will be written to disk. File gkk2file must be absent.'
2240 : end if
2241 : end if
2242 :
2243 162 : if (dtset%gruns_nddbs /= 0) then
2244 2 : write(nunit, '(a)' ) "Will compute Gruneisen parameters with finite difference method. DDB files:"
2245 8 : do ii = 1, dtset%gruns_nddbs
2246 8 : write(nunit, "(2a)")" ",trim(dtset%gruns_ddbs(ii))
2247 : end do
2248 : end if
2249 :
2250 : ! lattice wannier function Information
2251 162 : if (dtset%lwfflag > 0) then
2252 6 : write(nunit, '(a)')' Lattice Wannier function information:'
2253 6 : write(nunit, '(a20, i10)') ' lwfflag', dtset%lwfflag
2254 6 : write(nunit, '(a20, i10)') ' lwf_nwann', dtset%lwf_nwann
2255 6 : write(nunit, '(a20, i10)') ' lwf_anchor_proj', dtset%lwf_anchor_proj
2256 24 : write(nunit, '(a20, 3i10)') ' lwf_ngqpt',(dtset%lwf_ngqpt(ii), ii = 1, 3)
2257 6 : write(nunit, '(a20, i10)') ' lwf_disentangle', dtset%lwf_disentangle
2258 6 : write(nunit, '(a20, E16.6)') ' lwf_mu', dtset%lwf_mu
2259 6 : write(nunit, '(a20, E16.6)') ' lwf_sigma', dtset%lwf_sigma
2260 24 : write(nunit, '(a20, 3E16.6)') ' lwf_anchor_qpt',(dtset%lwf_anchor_qpt(ii), ii = 1, 3)
2261 6 : if (abs(dtset%lwf_anchor_proj) > 0) then
2262 4 : write(nunit, '(a20)',advance="no") ' lwf_anchor_iband'
2263 16 : do ii = 1, dtset%lwf_nwann
2264 16 : write(nunit, '(3x, I5)', advance="no") dtset%lwf_anchor_iband(ii)
2265 : end do
2266 4 : write(nunit, '(a)') ' '
2267 : end if
2268 :
2269 6 : if (dtset%lwfflag .eq. 2) then
2270 2 : write(nunit, '(a20)',advance="no") ' lwf_projector'
2271 8 : do ii = 1, dtset%lwf_nwann
2272 8 : write(nunit, '(3x, I5)', advance="no") dtset%lwf_projector(ii)
2273 : end do
2274 2 : write(nunit, '(a)') ' '
2275 : end if
2276 : end if
2277 :
2278 :
2279 : !List of vector 1 (reduced coordinates)
2280 162 : if(dtset%nph1l /= 0)then
2281 114 : write(nunit, '(a)')' First list of wavevector (reduced coord.) :'
2282 114 : write(nunit, '(3x, a9, 3i10)')' nph1l',dtset%nph1l
2283 114 : write(nunit, '(3x, a9)')' qph1l'
2284 1336 : do iph1 = 1, dtset%nph1l
2285 : write(nunit, '(19x, 3es16.8, 2x, es11.3)') &
2286 5002 : (dtset%qph1l(ii, iph1), ii = 1, 3), dtset%qnrml1(iph1)
2287 : end do
2288 : end if
2289 :
2290 : !List of vector 2 (cartesian coordinates)
2291 162 : if(dtset%nph2l /= 0)then
2292 48 : write(nunit, '(a)')' Second list of wavevector (cart. coord.) :'
2293 48 : write(nunit, '(3x, a9, 3i10)')' nph2l',dtset%nph2l
2294 48 : write(nunit, '(3x, a9)')' qph2l'
2295 122 : do iph2 = 1, dtset%nph2l
2296 344 : write(nunit, '(19x, 3es16.8, 2x, es11.3)') (dtset%qph2l(ii, iph2), ii = 1, 3), dtset%qnrml2(iph2)
2297 : end do
2298 : end if
2299 :
2300 : !phonon frozen in supercell
2301 162 : if (abs(dtset%freeze_displ) > tol10) then
2302 6 : write(nunit, '(a)') 'Phonon displacements will be output, frozen into supercells'
2303 6 : write(nunit, '(a, E20.10)') ' Chosen amplitude of frozen displacements = ', dtset%freeze_displ
2304 : end if
2305 :
2306 : !atom projected bs files
2307 162 : if (abs(dtset%natprj_bs) > 0) then
2308 6 : write(nunit, '(a)') 'Phonon band structure files, with atomic projections, will be output '
2309 6 : write(nunit, '(a)') ' Chosen atoms for projection = '
2310 6 : write(nunit, '(10I6)') dtset%iatprj_bs
2311 : end if
2312 :
2313 : !magnetic penalty (constrained DFPT)
2314 162 : if (abs(dtset%magpen) > tol8) then
2315 6 : write(nunit, '(a)') ' Second-order quantities calculated with constrained DFPT will be transformed'
2316 6 : write(nunit, '(3x, a9, 7x, 1es16.8)')' magpen',dtset%magpen
2317 6 : write(nunit, '(3x, a9, 2i3)') ' mpatpol',dtset%mpatpol(1:2)
2318 6 : write(nunit, '(3x, a9, 3i3)') ' mpdir',dtset%mpdir(1:3)
2319 6 : write(nunit, '(3x, a9, i3)') ' mpopt',dtset%mpopt
2320 6 : if (dtset%timdisp == 1) then
2321 4 : write(nunit, '(a)') ' Third-order frequency derivatives calculated with constrained DFPT response functions will be transformed'
2322 4 : write(nunit, '(3x, a9, i3)') ' timdisp',dtset%timdisp
2323 : end if
2324 : end if
2325 13122 : write(nunit, '(a, 80a, a)') ch10, ('=',ii = 1, 80), ch10
2326 :
2327 : !Frequency interpolation
2328 162 : if (abs(dtset%magpen) > tol8 .and. dtset%freqflag/=0) then
2329 6 : write(nunit, '(a)') ' Frequency interpolation of second-order quantities calculated with constrained DFPT '
2330 6 : write(nunit, '(3x, a9, i10)') ' nfreq',dtset%nfreq
2331 6 : write(nunit, '(3x, a9, 7x, es16.8)')' frmin',dtset%frmin
2332 6 : write(nunit, '(3x, a9, 7x, es16.8)')' frmax',dtset%frmax
2333 6 : write(nunit, '(3x, a9, 7x, es16.8)')' eta',dtset%eta
2334 : end if
2335 :
2336 :
2337 162 : end subroutine outvars_anaddb
2338 : !!***
2339 :
2340 : !----------------------------------------------------------------------
2341 :
2342 : !!****f*m_anaddb_dataset/anaddb_dtset_init
2343 : !!
2344 : !! NAME
2345 : !! anaddb_dtset_init
2346 : !!
2347 : !! FUNCTION
2348 : !! Initialize the code ppddb9: write heading and make the first i/os
2349 : !!
2350 : !! INPUTS
2351 : !! input_path: String with input file path. Empty string activates files file in legacy mode.
2352 : !!
2353 : !! OUTPUT
2354 : !! character(len = fnlen) filnam(7)=character strings giving file names
2355 : !!
2356 : !! NOTES
2357 : !! 1. Should be executed by one processor only.
2358 : !! 2. File names refer to following files, in order:
2359 : !! (1) Formatted input file
2360 : !! (2) Formatted output file
2361 : !! (3) Input Derivative Database
2362 : !! (4) Output Molecular Dynamics
2363 : !! (5) Input electron-phonon matrix elements
2364 : !! (6) Root name for electron-phonon file names
2365 : !! (7) Name of file containing the 3 ddk filenames and the GS wf file name
2366 : !!
2367 : !! SOURCE
2368 :
2369 81 : subroutine anaddb_dtset_init(dtset, input_path)
2370 :
2371 : !Arguments-------------------------------
2372 : class(anaddb_dataset_type), intent(inout):: dtset
2373 : character(len=*), intent(in):: input_path
2374 :
2375 : !Local variables-------------------------
2376 : !scalars
2377 : integer:: lenstr, marr, jdtset, tread, i1, ierr
2378 : character(len=strlen):: string, raw_string, fname, dirpath
2379 : character(len=fnlen):: unused
2380 : !character(len = 500):: msg
2381 : !arrays
2382 81 : integer, allocatable:: intarr(:)
2383 81 : real(dp), allocatable:: dprarr(:)
2384 : ! *********************************************************************
2385 :
2386 81 : dtset%filename_input = input_path
2387 81 : dtset%filename_output = "run.abo"
2388 81 : dtset%prefix_outdata = trim(" ")
2389 81 : dtset%filename_ddb = trim(" ")
2390 81 : dtset%filename_ddk = trim(" ")
2391 81 : dtset%prefix_eph = trim(" ")
2392 81 : dtset%filename_gkk = trim(" ")
2393 81 : dtset%filename_eigr2d = trim(" ")
2394 :
2395 :
2396 81 : if (len_trim(input_path) == 0) then
2397 : !write(msg, "(3a)") "Please run Anaddb as: anaddb input.in",ch10,&
2398 : ! "Note that using a files file is no longer supported in Abinit10."
2399 : !ABI_ERROR(msg)
2400 : ! Legacy Files file mode.
2401 1 : write(std_out, "(2a)")" DeprecationWarning: ",ch10
2402 1 : write(std_out, "(a)") " The files file has been deprecated in Abinit9 and will be removed in Abinit10."
2403 1 : write(std_out, "(2a)")" Use the syntax `anaddb t01.abi` where t01.abi is an anaddb input with ddb_filepath.",ch10
2404 1 : write(std_out, "(3a)")' ddb_filepath = "out_DDB"',ch10, ch10
2405 :
2406 1 : write(std_out, *)' Give name for formatted input file: '
2407 1 : read(std_in, '(a)' ) dtset%filename_input
2408 1 : write(std_out, '(a, a)' )'- ',trim(dtset%filename_input)
2409 1 : write(std_out, *)' Give name for formatted output file: '
2410 1 : read(std_in, '(a)' ) dtset%filename_output
2411 1 : write(std_out, '(a, a)' )'- ',trim(dtset%filename_output)
2412 1 : write(std_out, *)' Give name for input derivative database: '
2413 1 : read(std_in, '(a)' ) dtset%filename_ddb
2414 1 : write(std_out, '(a, a)' )'- ',trim(dtset%filename_ddb)
2415 1 : write(std_out, *)' Give name for output molecular dynamics: '
2416 1 : read(std_in, '(a)' ) unused
2417 1 : write(std_out, '(a, a)' )'- ',trim(unused)
2418 : ! GA: This message is confusing, because filnam(5) is also for EIG2D files.
2419 1 : write(std_out, *)' Give name for input elphon matrix elements (GKK file): '
2420 1 : read(std_in, '(a)' ) dtset%filename_gkk
2421 1 : write(std_out, '(a, a)' )'- ',trim(dtset%filename_gkk)
2422 1 : write(std_out, *)' Give root name for elphon output files: '
2423 1 : read(std_in, '(a)' ) dtset%prefix_eph
2424 1 : write(std_out, '(a, a)' )'- ',trim(dtset%prefix_eph)
2425 1 : write(std_out, *)' Give name for file containing ddk filenames for elphon/transport: '
2426 1 : read(std_in, '(a)' ) dtset%filename_ddk
2427 1 : write(std_out, '(a, a)' )'- ',trim(dtset%filename_ddk)
2428 1 : dtset%prefix_outdata = trim(" ")
2429 :
2430 : end if
2431 :
2432 : ! Read input
2433 81 : string = repeat(" ", strlen)
2434 81 : raw_string = repeat(" ", strlen)
2435 81 : call instrng(dtset%filename_input, lenstr, 1, strlen, string, raw_string)
2436 : ! To make case-insensitive, map characters to upper case.
2437 81 : call inupper(string(1:lenstr))
2438 :
2439 81 : marr = 3
2440 81 : ABI_MALLOC(intarr, (marr))
2441 81 : ABI_MALLOC(dprarr, (marr))
2442 81 : jdtset = 0
2443 :
2444 : ! Allow user to override default values
2445 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), "output_file", tread, 'KEY', key_value=dtset%filename_output)
2446 81 : write(std_out, '(2a)')'- Name for formatted output file: ', trim(dtset%filename_output)
2447 :
2448 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'ddb_filepath', tread, 'KEY', key_value=dtset%filename_ddb)
2449 : !Check that we didnt use a files file
2450 81 : if (len_trim(input_path) > 0) then
2451 80 : ABI_CHECK(tread == 1, 'ddb_filepath variable must be specified in the input file')
2452 : end if
2453 81 : write(std_out, "(2a)")'- Input derivative database: ', trim(dtset%filename_ddb)
2454 :
2455 : ! Nobody knows the scope of this line in the files file.
2456 : !call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), 'md_output', tread, 'KEY', key_value=filnam(4))
2457 :
2458 : ! GA: This variable name is confusing, because filnam(5) is also for EIG2D files.
2459 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), "gkk_filepath", tread, 'KEY', key_value=dtset%filename_gkk)
2460 81 : if (tread == 1) write(std_out, "(2a)")'- Name for input elphon matrix elements (GKK file): ', trim(dtset%filename_gkk)
2461 : ! GA: This is to keep old behavior. To be cleaned or removed.
2462 81 : dtset%filename_eigr2d = dtset%filename_gkk
2463 :
2464 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), "eph_prefix", tread, 'KEY', key_value=dtset%prefix_eph)
2465 81 : if (tread == 1) write(std_out, "(2a)")"- Root name for elphon output files: ", trim(dtset%prefix_eph)
2466 :
2467 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), "ddk_filepath", tread, 'KEY', key_value=dtset%filename_ddk)
2468 81 : if (tread == 1) write(std_out, "(2a)")"- File containing ddk filenames for elphon/transport: ", trim(dtset%filename_ddk)
2469 :
2470 81 : call intagm(dprarr, intarr, jdtset, marr, 1, string(1:lenstr), "outdata_prefix", tread, 'KEY', key_value=dtset%prefix_outdata)
2471 81 : if (tread == 1) then
2472 7 : write(std_out, "(2a)")'- Root name for output files: ', trim(dtset%prefix_outdata)
2473 : end if
2474 :
2475 81 : ABI_FREE(intarr)
2476 81 : ABI_FREE(dprarr)
2477 :
2478 : ! Compute OUTPUT_PREFIX as in abinit.
2479 : ! I do not change the "files" file to avoid backward compatibility issue
2480 81 : if (len_trim(dtset%prefix_outdata) == 0) then
2481 74 : fname = basename(trim(dtset%filename_output))
2482 74 : i1 = index(fname, ".",back=.true.)
2483 74 : if ( i1 > 1 ) then
2484 74 : dtset%prefix_outdata = fname(:i1-1)
2485 : end if
2486 74 : write(std_out, "(2a)")'- Root name for output files set to: ', trim(dtset%prefix_outdata)
2487 : endif
2488 :
2489 81 : i1 = index(dtset%prefix_outdata, "/", back=.True.)
2490 81 : if (i1 > 0) then
2491 0 : dirpath = dtset%prefix_outdata(1:i1-1)
2492 0 : call clib_mkdir_if_needed(dirpath, ierr)
2493 0 : ABI_CHECK(ierr == 0, sjoin("Error", itoa(ierr), "while trying to create directory", dirpath))
2494 : end if
2495 :
2496 81 : end subroutine anaddb_dtset_init
2497 : !!***
2498 :
2499 : !!****f*m_anaddb_dataset/anaddb_dtset_bcast_files
2500 : !! NAME
2501 : !! anaddb_dtset_bcast_files
2502 : !!
2503 : !! FUNCTION
2504 : !! Broadcast filenames
2505 : !!
2506 : !! INPUTS
2507 : !!
2508 : !! OUTPUT
2509 : !!
2510 : !! SOURCE
2511 :
2512 81 : subroutine anaddb_dtset_bcast_files(dtset, comm)
2513 :
2514 : class(anaddb_dataset_type), intent(inout):: dtset
2515 : integer, intent(in) :: comm
2516 :
2517 : integer, parameter :: master = 0
2518 : integer :: ierr
2519 :
2520 81 : call xmpi_bcast(dtset%filename_input, master, comm, ierr)
2521 81 : call xmpi_bcast(dtset%filename_output, master, comm, ierr)
2522 81 : call xmpi_bcast(dtset%prefix_outdata, master, comm, ierr)
2523 81 : call xmpi_bcast(dtset%filename_ddb, master, comm, ierr)
2524 81 : call xmpi_bcast(dtset%filename_ddk, master, comm, ierr)
2525 81 : call xmpi_bcast(dtset%prefix_eph, master, comm, ierr)
2526 81 : call xmpi_bcast(dtset%filename_gkk, master, comm, ierr)
2527 81 : call xmpi_bcast(dtset%filename_eigr2d, master, comm, ierr)
2528 :
2529 81 : end subroutine anaddb_dtset_bcast_files
2530 : !!***
2531 :
2532 : !!****f*m_anaddb_dataset/anaddb_chkvars
2533 : !! NAME
2534 : !! anaddb_chkvars
2535 : !!
2536 : !! FUNCTION
2537 : !! Examines the input string, to check whether all names are allowed.
2538 : !!
2539 : !! INPUTS
2540 : !! string*(*)=string of character
2541 : !! the string (with upper case) from the input file, to which the XYZ data is (possibly) appended
2542 : !!
2543 : !! OUTPUT
2544 : !!
2545 : !! SOURCE
2546 :
2547 81 : subroutine anaddb_chkvars(string)
2548 :
2549 : !Arguments------------------------------------
2550 : !scalars
2551 : character(len=*), intent(in):: string
2552 :
2553 : !Local variables-------------------------------
2554 : !scalars
2555 : integer, parameter:: protocol0 = 0
2556 : character(len = 100):: list_logicals, list_strings, list_vars_img
2557 : character(len = 10000):: list_vars
2558 :
2559 : !************************************************************************
2560 :
2561 : !Here, list all admitted variable names (max 10 per line, to fix the ideas)
2562 : !Note: Do not use "double quotation mark" for the string since it triggers a bug in docchk.py (abirules script)
2563 : !<ANADDB_VARS>
2564 : !A
2565 81 : list_vars= ' alphon asr a2fsmear atifc'
2566 : !B
2567 81 : list_vars = trim(list_vars)//' brav band_gap'
2568 : !C
2569 81 : list_vars = trim(list_vars)//' chneut'
2570 : !D
2571 81 : list_vars = trim(list_vars)//' dieflag dielt_env dielt_thick dipdip dipquad dossum dosdeltae dossmear dostol dos_maxmode'
2572 : !E
2573 81 : list_vars = trim(list_vars)//' ep_scalprod eivec elaflag elphflag enunit'
2574 81 : list_vars = trim(list_vars)//' ep_b_min ep_b_max ep_int_gkk ep_keepbands ep_nqpt ep_nspline ep_prt_yambo'
2575 81 : list_vars = trim(list_vars)//' elphsmear elph_fermie ep_extrael ep_qptlist eta'
2576 : !F
2577 81 : list_vars = trim(list_vars)//' flexoflag freeze_displ freqflag frmax frmin'
2578 : !G
2579 81 : list_vars = trim(list_vars)//' gkk2write gkk_rptwrite gkqwrite gruns_nddbs'
2580 : !H
2581 : !I
2582 81 : list_vars = trim(list_vars)//' ifcana ifcflag ifcout ifltransport instrflag istrfix iatfix iatprj_bs'
2583 : !J
2584 : !K
2585 81 : list_vars = trim(list_vars)//' kptrlatt kptrlatt_fine'
2586 : !L
2587 :
2588 81 : list_vars = trim(list_vars)//' lwf_anchor_iband lwf_anchor_proj lwf_anchor_qpt'
2589 81 : list_vars = trim(list_vars)//' lwf_disentangle lwf_mu lwf_ngqpt lwf_nwann lwf_projector lwf_sigma'
2590 81 : list_vars = trim(list_vars)//' lwfflag'
2591 : !M
2592 81 : list_vars = trim(list_vars)//' magpen mpatpol mpdir mpopt mustar'
2593 : !N
2594 81 : list_vars = trim(list_vars)//' natfix natifc natom natprj_bs nchan ndivsm nfreq ngrids nlflag nph1l nph2l'
2595 81 : list_vars = trim(list_vars)//' nqpath nqshft nsphere nstrfix ntemper nwchan ngqpt ng2qpt'
2596 : !O
2597 81 : list_vars = trim(list_vars)//' outboltztrap'
2598 : !P
2599 81 : list_vars = trim(list_vars)//' piezoflag polflag prtddb prtdos prt_ifc prtmbm prtfsurf'
2600 81 : list_vars = trim(list_vars)//' prtnest prtphbands prtsrlr prtvol prtbltztrp'
2601 : !Q
2602 81 : list_vars = trim(list_vars)//' qrefine qgrid_type q1shft q2shft qnrml1 qnrml2 qpath qph1l qph2l quadquad'
2603 : !R
2604 81 : list_vars = trim(list_vars)//' ramansr relaxat relaxstr rfmeth rifcsph'
2605 : !S
2606 81 : list_vars = trim(list_vars)//' selectz symdynmat symgkq sys_dim'
2607 : !T
2608 81 : list_vars = trim(list_vars)//' targetpol telphint thmflag temperinc tempermin thermal_supercell thmtol timdisp'
2609 : !U
2610 81 : list_vars = trim(list_vars)//' use_k_fine'
2611 : !V
2612 81 : list_vars = trim(list_vars)//' vs_qrad_tolkms'
2613 : !W
2614 : !X
2615 : !Y
2616 : !Z
2617 :
2618 : !
2619 81 : list_vars_img=' '
2620 :
2621 : !Logical input variables
2622 81 : list_logicals=' '
2623 :
2624 : !String input variables
2625 81 : list_strings=' gruns_ddbs ddb_filepath output_file outdata_prefix gkk_filepath eph_prefix ddk_filepath' ! md_output
2626 : !</ANADDB_VARS>
2627 :
2628 : !Extra token, also admitted:
2629 : !<ANADDB_UNITS>
2630 81 : list_vars = trim(list_vars)//' au Angstr Angstrom Angstroms Bohr Bohrs eV meV Ha'
2631 81 : list_vars = trim(list_vars)//' Hartree Hartrees K nm Ry Rydberg Rydbergs S Sec Second T Tesla'
2632 : !</ANADDB_UNITS>
2633 :
2634 : !<ANADDB_OPERATORS>
2635 81 : list_vars = trim(list_vars)//' sqrt '
2636 : !</ANADDB_OPERATORS>
2637 :
2638 : !Transform to upper case
2639 81 : call inupper(list_vars)
2640 81 : call inupper(list_vars_img)
2641 81 : call inupper(list_logicals)
2642 81 : call inupper(list_strings)
2643 :
2644 81 : call chkvars_in_string(protocol0, list_vars, list_vars_img, list_logicals, list_strings, string)
2645 :
2646 81 : end subroutine anaddb_chkvars
2647 : !!***
2648 :
2649 :
2650 : !!****f*m_anaddb_dataset/anaddb_dtset_read_input
2651 : !! NAME
2652 : !! anaddb_dtset_read_input
2653 : !!
2654 : !! FUNCTION
2655 : !!
2656 : !! INPUTS
2657 : !!
2658 : !! OUTPUT
2659 : !!
2660 : !! SOURCE
2661 :
2662 81 : subroutine anaddb_dtset_read_input(dtset, comm)
2663 :
2664 : class(anaddb_dataset_type), intent(inout):: dtset
2665 : integer, intent(in):: comm
2666 :
2667 : !Local variables-------------------------------
2668 : integer, parameter:: master = 0
2669 : integer :: lenstr
2670 : integer:: ierr
2671 : integer :: my_rank
2672 : logical :: iam_master
2673 : character(len = strlen):: string, raw_string
2674 4212 : type(ddb_hdr_type) :: ddb_hdr
2675 :
2676 81 : my_rank = xmpi_comm_rank(comm)
2677 81 : iam_master = (my_rank == master)
2678 :
2679 : ! Must read natom from the DDB before being able to allocate some arrays needed for invars9
2680 81 : call ddb_hdr%open_read(dtset%filename_ddb, comm=comm, dimonly = 1)
2681 :
2682 81 : dtset%natom = ddb_hdr%natom
2683 81 : dtset%mpert = ddb_hdr%mpert
2684 81 : dtset%msize = ddb_hdr%msize
2685 :
2686 : ! Read the input file, and store the information in a long string of characters
2687 : ! strlen from defs_basis module
2688 81 : if (iam_master) then
2689 81 : call instrng(dtset%filename_input, lenstr, 1, strlen, string, raw_string)
2690 : ! To make case-insensitive, map characters to upper case.
2691 81 : call inupper(string(1:lenstr))
2692 : end if
2693 :
2694 81 : call xmpi_bcast(string, master, comm, ierr)
2695 81 : call xmpi_bcast(raw_string, master, comm, ierr)
2696 81 : call xmpi_bcast(lenstr, master, comm, ierr)
2697 :
2698 81 : dtset%lenstr = lenstr
2699 81 : dtset%input_string = string
2700 :
2701 : ! Save input string in global variable so that we can access it in ntck_open_create
2702 81 : ABI_MALLOC_TYPE_SCALAR(character(len=len_trim(raw_string)), INPUT_STRING)
2703 81 : INPUT_STRING = trim(raw_string)
2704 :
2705 : ! Read the inputs
2706 81 : call invars9(dtset, dtset%lenstr, dtset%natom, dtset%input_string)
2707 :
2708 : ! Set some inputs depending on what the ddb contains
2709 81 : if (.not. ddb_hdr%has_d3E_lw) then
2710 : ! The default value is 1.
2711 : ! Here we set the flags to zero if Q*is not available.
2712 : ! iblock_quadrupoles = ddb_lw%get_quadrupoles(ddb_hdr%ddb_version, 1, BLKTYP_d3E_lw, qdrp_cart)
2713 73 : dtset%dipquad = 0
2714 73 : dtset%quadquad = 0
2715 : end if
2716 :
2717 81 : call ddb_hdr%free()
2718 :
2719 : ! GA: This used to be after the dry run exit.
2720 : ! Check the value and transform the meaning of atifc (1 and 0 only)
2721 81 : call chkin9(dtset%atifcflg,dtset%atifc,dtset%natifc,dtset%natom)
2722 :
2723 81 : end subroutine anaddb_dtset_read_input
2724 : !!***
2725 :
2726 0 : end module m_anaddb_dataset
2727 : !!***
|
