Line data Source code
1 : !!****m* ABINIT/functionals_pwscf.F90
2 : !! NAME
3 : !! functionals_pwscf
4 : !!
5 : !! FUNCTION
6 : !! This module contains data defining the DFT functional in use
7 : !! and a number of functions and subroutines to manage them.
8 : !! Data are PRIVATE and are accessed and set only by function calls.
9 : !! Basic drivers to compute XC quantities are also included.
10 : !!
11 : !! imported into abinit by MJV 20/6/2009
12 : ! changed module name
13 : ! removed DP references
14 : ! removed functions for explicit calculation of xc (E,V,fxc)
15 : !!
16 : !! COPYRIGHT
17 : !! Copyright (C) 2004 PWSCF group
18 : !! This file is distributed under the terms of the
19 : !! GNU General Public License. See the file `License'
20 : !! in the root directory of the present distribution,
21 : !! or http://www.gnu.org/copyleft/gpl.txt .
22 : !!
23 : !! SOURCE
24 : !
25 : !-------------------------------------------------------------------
26 :
27 : #if defined HAVE_CONFIG_H
28 : #include "config.h"
29 : #endif
30 :
31 : module funct_pwscf
32 : !-------------------------------------------------------------------
33 : !
34 : ! setting routines: set_dft_from_name (previously which_dft)
35 : ! set_dft_from_indices
36 : ! enforce_input_dft
37 : ! start_exx
38 : ! stop_exx
39 : ! retrive functions: get_dft_name
40 : ! get_iexch
41 : ! get_icorr
42 : ! get_igcx
43 : ! get_igcc
44 : ! get_exx_fraction
45 : ! dft_name
46 : ! write_dft_name
47 : ! logical functions: dft_is_gradient
48 : ! dft_is_meta
49 : ! dft_is_hybrid
50 : ! exx_is_active
51 : !
52 : ! XC computation drivers: xc, xc_spin, gcxc, gcx_spin, gcc_spin, gcc_spin_more
53 : ! derivatives of XC computation drivers: dmxc, dmxc_spin, dmxc_nc
54 : !
55 : use flib_pwscf
56 :
57 : IMPLICIT NONE
58 : PRIVATE
59 : SAVE
60 : ! subroutines/functions managing dft name and indices
61 : PUBLIC :: set_dft_from_indices, set_dft_from_name
62 : PUBLIC :: enforce_input_dft, write_dft_name, dft_name
63 : PUBLIC :: get_dft_name, get_iexch, get_icorr, get_igcx, get_igcc
64 : PUBLIC :: dft_is_gradient, dft_is_meta, dft_is_hybrid
65 : ! additional subroutines/functions for hybrid functionale
66 : PUBLIC :: start_exx, stop_exx, get_exx_fraction, exx_is_active
67 : !
68 : ! PRIVATE variables defining the DFT functional
69 : !
70 : PRIVATE :: dft, iexch, icorr, igcx, igcc
71 : PRIVATE :: discard_input_dft
72 : PRIVATE :: isgradient, ismeta, ishybrid
73 : PRIVATE :: exx_fraction, exx_started
74 : !PRIVATE :: dft_shortname
75 : !
76 : character (len=50) :: dft = 'not set'
77 : !character (len=4) :: dft_shortname = ' '
78 : !
79 : ! dft is the exchange-correlation functional, described by
80 : ! any nonconflicting combination of the following keywords
81 : ! (case-insensitive):
82 : !
83 : ! Exchange: "nox" none iexch=0
84 : ! "sla" Slater (alpha=2/3) iexch=1 (default)
85 : ! "sl1" Slater (alpha=1.0) iexch=2
86 : ! "rxc" Relativistic Slater iexch=3
87 : ! "oep" Optimized Effective Potential iexch=4
88 : ! "hf" Hartree-Fock iexch=5
89 : ! "pb0x" PBE0 iexch=6
90 : !
91 : ! Correlation: "noc" none icorr=0
92 : ! "pz" Perdew-Zunger icorr=1 (default)
93 : ! "vwn" Vosko-Wilk-Nusair icorr=2
94 : ! "lyp" Lee-Yang-Parr icorr=3
95 : ! "pw" Perdew-Wang icorr=4
96 : ! "wig" Wigner icorr=5
97 : ! "hl" Hedin-Lunqvist icorr=6
98 : ! "obz" Ortiz-Ballone form for PZ icorr=7
99 : ! "obw" Ortiz-Ballone form for PW icorr=8
100 : ! "gl" Gunnarson-Lunqvist icorr=9
101 : !
102 : ! Gradient Correction on Exchange:
103 : ! "nogx" none igcx =0 (default)
104 : ! "b88" Becke88 (beta=0.0042) igcx =1
105 : ! "ggx" Perdew-Wang 91 igcx =2
106 : ! "pbx" Perdew-Burke-Ernzenhof exch igcx =3
107 : ! "rpb" revised PBE by Zhang-Yang igcx =4
108 : ! "hcth" Cambridge exch, Handy et al igcx =5
109 : ! "optx" Handy's exchange functional igcx =6
110 : ! "meta" meta-gga igcx =7
111 : ! "pb0x" PBE0 igcx =8
112 : !
113 : ! Gradient Correction on Correlation:
114 : ! "nogc" none igcc =0 (default)
115 : ! "p86" Perdew86 igcc =1
116 : ! "ggc" Perdew-Wang 91 corr. igcc =2
117 : ! "blyp" Lee-Yang-Parr igcc =3
118 : ! "pbc" Perdew-Burke-Ernzenhof corr igcc =4
119 : ! "hcth" Cambridge corr, Handy et al igcc =5
120 : ! "meta" meta-gga igcc =6
121 : !
122 : ! Special cases (dft_shortnames):
123 : ! "bp" = "b88+p86" = Becke-Perdew grad.corr.
124 : ! "pw91" = "pw +ggx+ggc" = PW91 (aka GGA)
125 : ! "blyp" = "sla+b88+lyp+blyp"= BLYP
126 : ! "pbe" = "sla+pw+pbx+pbc" = PBE
127 : ! "revpbe"="sla+pw+rpb+pbc" = revPBE (Zhang-Yang)
128 : ! "hcth" = "nox+noc+hcth+hcth"=HCTH/120
129 : ! "olyp" = "nox+lyp+optx+blyp" !!! UNTESTED !!!
130 : !
131 : ! References:
132 : ! pz J.P.Perdew and A.Zunger, PRB 23, 5048 (1981) [[cite:Perdew1981]]
133 : ! vwn S.H.Vosko, L.Wilk, M.Nusair, Can.J.Phys. 58,1200(1980) [[cite:Vosko1980]]
134 : ! wig E.P.Wigner, Trans. Faraday Soc. 34, 67 (1938) [[cite:Wigner1938]]
135 : ! hl L.Hedin and B.I.Lundqvist, J. Phys. C4, 2064 (1971) [[cite:Hedin1971]]
136 : ! gl O.Gunnarsson and B.I.Lundqvist, PRB 13, 4274 (1976) [[cite:Gunnarsson1976]]
137 : ! pw J.P.Perdew and Y.Wang, PRB 45, 13244 (1992) [[cite:Perdew1992a]]
138 : ! obpz G.Ortiz and P.Ballone, PRB 50, 1391 (1994) [[cite:Ortiz1994]]
139 : ! obpw as above
140 : ! b88 A.D.Becke, PRA 38, 3098 (1988) [[cite:Becke1988]]
141 : ! p86 J.P.Perdew, PRB 33, 8822 (1986) [[cite:Perdew1986]]
142 : ! pbe J.P.Perdew, K.Burke, M.Ernzerhof, PRL 77, 3865 (1996) [[cite:Perdew1996]]
143 : ! pw91 J.P.Perdew and Y. Wang, PRB 46, 6671 (1992) [[cite:Perdew1992]]
144 : ! blyp C.Lee, W.Yang, R.G.Parr, PRB 37, 785 (1988) [[cite:Lee1988]]
145 : ! hcth Hamprecht et al, JCP 109, 6264 (1998) [[cite:Hamprecht1998]]
146 : ! olyp Handy and Cohen, JCP 116, 5411 (2002) [[cite:Handy2002]]
147 : ! revPBE Zhang and Yang, PRL 80, 890 (1998) [[cite:Zhang1998]]
148 : ! oep
149 :
150 : integer, parameter:: notset = -1
151 : !
152 : integer :: iexch = notset
153 : integer :: icorr = notset
154 : integer :: igcx = notset
155 : integer :: igcc = notset
156 : real(8):: exx_fraction = 0.0d0
157 : logical :: isgradient = .false.
158 : logical :: ismeta = .false.
159 : logical :: ishybrid = .false.
160 : logical :: exx_started = .false.
161 :
162 : logical :: discard_input_dft = .false.
163 : !
164 : ! internal indices for exchange-correlation
165 : ! iexch: type of exchange
166 : ! icorr: type of correlation
167 : ! igcx: type of gradient correction on exchange
168 : ! igcc: type of gradient correction on correlation
169 : !
170 : ! ismeta: .TRUE. if gradient correction is of meta-gga type
171 : ! ishybrid: .TRUE. if the xc finctional is an HF+DFT hybrid like
172 : ! PBE0 or B3LYP or HF itself
173 : !
174 : ! see comments above and routine "set_dft_from_name" below
175 : !
176 : ! data
177 : integer :: nxc, ncc, ngcx, ngcc
178 : parameter (nxc = 7, ncc =10, ngcx = 9, ngcc = 7)
179 : character (len=4) :: exc, corr
180 : character (len=4) :: gradx, gradc
181 : dimension exc (0:nxc), corr (0:ncc), gradx (0:ngcx), gradc (0: ngcc)
182 :
183 : data exc / 'NOX', 'SLA', 'SL1', 'RXC', 'OEP', 'HF', 'PB0X', 'B3LP' /
184 : data corr / 'NOC', 'PZ', 'VWN', 'LYP', 'PW', 'WIG', 'HL', 'OBZ', &
185 : 'OBW', 'GL' , 'B3LP' /
186 : data gradx / 'NOGX', 'B88', 'GGX', 'PBX', 'RPB', 'HCTH', 'OPTX', 'META', 'PB0X', 'B3LP' /
187 : data gradc / 'NOGC', 'P86', 'GGC', 'BLYP', 'PBC', 'HCTH', 'META', 'B3LP' /
188 :
189 : CONTAINS
190 : !!***
191 :
192 : !!****f* functionals_pwscf/set_dft_from_name
193 : !!
194 : !! NAME
195 : !! set_dft_from_name
196 : !!
197 : !! FUNCTION
198 : !! translates a string containing the exchange-correlation name
199 : !! into internal indices iexch, icorr, igcx, igcc
200 : !!
201 : !! INPUTS
202 : !!
203 : !! OUTPUT
204 : !!
205 : !! SOURCE
206 : !-----------------------------------------------------------------------
207 2 : subroutine set_dft_from_name( dft_ )
208 : !-----------------------------------------------------------------------
209 :
210 : use flib_pwscf
211 : !implicit none
212 : ! input
213 : character(len=*) :: dft_
214 : ! local
215 : integer :: len, l, i
216 : character (len=50):: dftout
217 : !
218 : !
219 : ! if
220 : !
221 2 : if ( discard_input_dft ) return
222 : !
223 : ! convert to uppercase
224 2 : len = len_trim(dft_)
225 2 : dftout = ' '
226 42 : do l = 1, len
227 42 : dftout (l:l) = capital (dft_(l:l) )
228 : enddo
229 :
230 : ! exchange
231 2 : iexch = notset
232 18 : do i = 0, nxc
233 18 : if (matches (exc (i), dftout) ) then
234 2 : call set_dft_value (iexch, i)
235 : end if
236 : enddo
237 :
238 : ! correlation
239 2 : icorr = notset
240 24 : do i = 0, ncc
241 24 : if (matches (corr (i), dftout) ) then
242 2 : call set_dft_value (icorr, i)
243 : end if
244 : enddo
245 :
246 : ! gradient correction, exchange
247 2 : igcx = notset
248 22 : do i = 0, ngcx
249 22 : if (matches (gradx (i), dftout) ) then
250 2 : call set_dft_value (igcx, i)
251 : end if
252 : enddo
253 :
254 : ! gradient correction, correlation
255 2 : igcc = notset
256 18 : do i = 0, ngcc
257 18 : if (matches (gradc (i), dftout) ) then
258 0 : call set_dft_value (igcc, i)
259 : end if
260 : enddo
261 :
262 : ! special case : BLYP => B88 for gradient correction on exchange
263 2 : if (matches ('BLYP', dftout) ) then
264 0 : call set_dft_value (igcx, 1)
265 : end if
266 :
267 : ! special case : revPBE
268 2 : if (matches ('REVPBE', dftout) ) then
269 0 : call set_dft_value (icorr,4)
270 0 : call set_dft_value (igcx, 4)
271 0 : call set_dft_value (igcc, 4)
272 2 : else if (matches('RPBE',dftout)) then
273 : call errore('set_dft_from_name', &
274 0 : & 'RPBE (Hammer-Hansen-Norskov) not implemented (revPBE is)',1)
275 2 : else if (matches ('PBE0', dftout) ) then
276 : ! special case : PBE0
277 0 : call set_dft_value (iexch,6)
278 0 : call set_dft_value (icorr,4)
279 0 : call set_dft_value (igcx, 8)
280 0 : call set_dft_value (igcc, 4)
281 2 : else if (matches ('PBE', dftout) ) then
282 : ! special case : PBE
283 0 : call set_dft_value (icorr,4)
284 0 : call set_dft_value (igcx, 3)
285 0 : call set_dft_value (igcc, 4)
286 : endif
287 :
288 2 : if (matches ('PBC', dftout) ) then
289 : ! special case : PBC = PW + PBC
290 0 : call set_dft_value (icorr,4)
291 0 : call set_dft_value (igcc, 4)
292 : endif
293 :
294 : ! special case : BP = B88 + P86
295 2 : if (matches ('BP', dftout) ) then
296 0 : call set_dft_value (igcx, 1)
297 0 : call set_dft_value (igcc, 1)
298 : endif
299 :
300 : ! special case : PW91 = GGX + GGC
301 2 : if (matches ('PW91', dftout) ) then
302 0 : call set_dft_value (igcx, 2)
303 0 : call set_dft_value (igcc, 2)
304 : endif
305 :
306 : ! special case : HCTH already contains LDA exchange and correlation
307 :
308 2 : if (matches('HCTH',dftout)) then
309 0 : call set_dft_value(iexch,0)
310 0 : call set_dft_value(icorr,0)
311 : end if
312 :
313 : ! special case : OPTX already contains LDA exchange
314 :
315 2 : if (matches('OPTX',dftout)) then
316 0 : call set_dft_value(iexch,0)
317 : end if
318 :
319 : ! special case : OLYP = OPTX + LYP
320 :
321 2 : if (matches('OLYP',dftout)) then
322 0 : call set_dft_value(iexch,0)
323 0 : call set_dft_value(icorr,3)
324 0 : call set_dft_value(igcx,6)
325 0 : call set_dft_value(igcc,3)
326 : end if
327 : !
328 : ! ... special case : TPSS meta-GGA Exc
329 : !
330 2 : IF ( matches( 'TPSS', dftout ) ) THEN
331 : !
332 0 : CALL set_dft_value( iexch, 1 )
333 0 : CALL set_dft_value( icorr, 4 )
334 0 : CALL set_dft_value( igcx, 7 )
335 0 : CALL set_dft_value( igcc, 6 )
336 : !
337 : END IF
338 : !
339 : ! ... special cases : OEP and HF need not GC part (nor LDA...)
340 : ! and include no correlation by default
341 : !
342 2 : IF ( matches( 'OEP', dftout ) .OR. matches( 'HF', dftout )) THEN
343 : !
344 0 : CALL set_dft_value( igcx, 0 )
345 0 : if (icorr == notset) then
346 0 : call set_dft_value (icorr, 0)
347 : end if
348 : !
349 : END IF
350 :
351 :
352 2 : if (igcx == 6) &
353 0 : call errore('set_dft_from_name','OPTX untested! please test',-igcx)
354 : ! Default value: Slater exchange
355 2 : if (iexch == notset) then
356 0 : call set_dft_value (iexch, 1)
357 : end if
358 :
359 : ! Default value: Perdew-Zunger correlation
360 2 : if (icorr == notset) then
361 0 : call set_dft_value (icorr, 1)
362 : end if
363 :
364 : ! Default value: no gradient correction on exchange
365 2 : if (igcx == notset) then
366 0 : call set_dft_value (igcx, 0)
367 : end if
368 :
369 : ! Default value: no gradient correction on correlation
370 2 : if (igcc == notset) then
371 2 : call set_dft_value (igcc, 0)
372 : end if
373 :
374 2 : dft = dftout
375 :
376 : dftout = exc (iexch) //'-'//corr (icorr) //'-'//gradx (igcx) //'-' &
377 2 : &//gradc (igcc)
378 :
379 2 : call set_auxiliary_flags
380 :
381 2 : return
382 : end subroutine set_dft_from_name
383 : !!***
384 :
385 : !!****f* functionals_pwscf/set_auxiliary_flags
386 : !!
387 : !! NAME
388 : !! set_auxiliary_flags
389 : !!
390 : !! FUNCTION
391 : !! set logical flags describing the complexity of the xc functional
392 : !! define the fraction of exact exchange used by hybrid fuctionals
393 : !!
394 : !! INPUTS
395 : !!
396 : !! OUTPUT
397 : !!
398 : !! SOURCE
399 :
400 : !-----------------------------------------------------------------------
401 4 : subroutine set_auxiliary_flags
402 : !-----------------------------------------------------------------------
403 :
404 : use flib_pwscf
405 4 : isgradient = (igcx > 0) .or. (igcc > 0)
406 4 : ismeta = (igcx == 7) .or. (igcx == 6 )
407 :
408 : ! PBE0
409 4 : IF ( iexch==6 .or. igcx==8 ) exx_fraction = 0.25d0
410 : ! HF or OEP
411 4 : IF ( iexch==4 .or. iexch==5 ) exx_fraction = 1.0d0
412 : !B3LYP
413 4 : IF ( matches( 'B3LP',dft ) ) exx_fraction = 0.2d0
414 4 : ishybrid = ( exx_fraction /= 0.0d0 )
415 :
416 4 : return
417 : end subroutine set_auxiliary_flags
418 : !!***
419 :
420 : !!****f* functionals_pwscf/set_dft_value
421 : !!
422 : !! NAME
423 : !! set_dft_value
424 : !!
425 : !! FUNCTION
426 : !!
427 : !! INPUTS
428 : !!
429 : !! OUTPUT
430 : !!
431 : !! SOURCE
432 : !-----------------------------------------------------------------------
433 8 : subroutine set_dft_value (m, i)
434 : !-----------------------------------------------------------------------
435 : use flib_pwscf
436 : !implicit none
437 : integer :: m, i
438 : ! local
439 :
440 8 : if ( m /= notset .and. m /= i) &
441 0 : call errore ('set_dft_value', 'two conflicting matching values', 1)
442 8 : m = i
443 8 : return
444 :
445 : end subroutine set_dft_value
446 : !!***
447 :
448 : !!****f* functionals_pwscf/enforce_input_dft
449 : !!
450 : !! NAME
451 : !! enforce_input_dft
452 : !!
453 : !! FUNCTION
454 : !! translates a string containing the exchange-correlation name
455 : !! into internal indices and force any subsequent call to set_dft_from_name
456 : !! to return without changing them
457 : !!
458 : !! INPUTS
459 : !!
460 : !! OUTPUT
461 : !!
462 : !! SOURCE
463 :
464 : !-----------------------------------------------------------------------
465 0 : subroutine enforce_input_dft (dft_)
466 : !
467 : use defs_basis, only : std_out,std_out_default
468 : use flib_pwscf
469 : !implicit none
470 : ! input
471 : character(len=*) :: dft_
472 : ! data
473 :
474 0 : call set_dft_from_name (dft_)
475 0 : if (dft == 'not set') then
476 0 : call errore('enforce_input_dft','cannot fix unset dft',1)
477 : end if
478 0 : discard_input_dft = .true.
479 :
480 0 : write(std_out,'(/,5x,a)') "!!! XC functional enforced from input :"
481 0 : call write_dft_name
482 0 : write(std_out,'(5x,a)') "!!! Any further DFT definition will be discarded"
483 0 : write(std_out,'(5x,a)') "!!! Please, verify this is what you really want !"
484 :
485 0 : return
486 : end subroutine enforce_input_dft
487 : !!***
488 :
489 : !!****f* functionals_pwscf/start_exx
490 : !!
491 : !! NAME
492 : !! start_exx
493 : !!
494 : !! FUNCTION
495 : !!
496 : !! INPUTS
497 : !!
498 : !! OUTPUT
499 : !!
500 : !! SOURCE
501 :
502 0 : subroutine start_exx
503 :
504 : use flib_pwscf
505 0 : if (.not. ishybrid) &
506 0 : call errore('start_exx','dft is not hybrid, wrong call',1)
507 0 : exx_started = .true.
508 0 : end subroutine start_exx
509 : !!***
510 :
511 : !!****f* functionals_pwscf/stop_exx
512 : !!
513 : !! NAME
514 : !! stop_exx
515 : !!
516 : !! FUNCTION
517 : !!
518 : !! INPUTS
519 : !!
520 : !! OUTPUT
521 : !!
522 : !! SOURCE
523 :
524 : !-----------------------------------------------------------------------
525 0 : subroutine stop_exx
526 :
527 : use flib_pwscf
528 0 : if (.not. ishybrid) &
529 0 : call errore('stop_exx','dft is not hybrid, wrong call',1)
530 0 : exx_started = .false.
531 0 : end subroutine stop_exx
532 : !!***
533 :
534 : !!****f* functionals_pwscf/exx_is_active
535 : !!
536 : !! NAME
537 : !! exx_is_active
538 : !!
539 : !! FUNCTION
540 : !!
541 : !! INPUTS
542 : !!
543 : !! OUTPUT
544 : !!
545 : !! SOURCE
546 :
547 0 : function exx_is_active ()
548 :
549 : logical exx_is_active
550 0 : exx_is_active = exx_started
551 0 : end function exx_is_active
552 : !!***
553 :
554 : !!****f* functionals_pwscf/get_iexch
555 : !!
556 : !! NAME
557 : !! get_iexch
558 : !!
559 : !! FUNCTION
560 : !!
561 : !! INPUTS
562 : !!
563 : !! OUTPUT
564 : !!
565 : !! SOURCE
566 : !-----------------------------------------------------------------------
567 2 : function get_iexch ()
568 :
569 : integer get_iexch
570 2 : get_iexch = iexch
571 : return
572 : end function get_iexch
573 : !!***
574 :
575 : !!****f* functionals_pwscf/get_icorr
576 : !!
577 : !! NAME
578 : !! get_icorr
579 : !!
580 : !! FUNCTION
581 : !!
582 : !! INPUTS
583 : !!
584 : !! OUTPUT
585 : !!
586 : !! SOURCE
587 : !-----------------------------------------------------------------------
588 2 : function get_icorr ()
589 :
590 : integer get_icorr
591 2 : get_icorr = icorr
592 : return
593 : end function get_icorr
594 : !!***
595 :
596 : !!****f* functionals_pwscf/get_igcx
597 : !!
598 : !! NAME
599 : !! get_igcx
600 : !!
601 : !! FUNCTION
602 : !!
603 : !! INPUTS
604 : !!
605 : !! OUTPUT
606 : !!
607 : !! SOURCE
608 : !-----------------------------------------------------------------------
609 2 : function get_igcx ()
610 :
611 : integer get_igcx
612 2 : get_igcx = igcx
613 : return
614 : end function get_igcx
615 : !!***
616 :
617 : !!****f* functionals_pwscf/get_igcc
618 : !!
619 : !! NAME
620 : !! get_igcc
621 : !!
622 : !! FUNCTION
623 : !!
624 : !! INPUTS
625 : !!
626 : !! OUTPUT
627 : !!
628 : !! SOURCE
629 : !-----------------------------------------------------------------------
630 2 : function get_igcc ()
631 :
632 : integer get_igcc
633 2 : get_igcc = igcc
634 : return
635 : end function get_igcc
636 : !!***
637 :
638 : !!****f* functionals_pwscf/get_exx_fraction
639 : !!
640 : !! NAME
641 : !! get_exx_fraction
642 : !!
643 : !! FUNCTION
644 : !!
645 : !! INPUTS
646 : !!
647 : !! OUTPUT
648 : !!
649 : !! SOURCE
650 : !-----------------------------------------------------------------------
651 0 : function get_exx_fraction ()
652 :
653 : real(8):: get_exx_fraction
654 0 : get_exx_fraction = exx_fraction
655 : return
656 : end function get_exx_fraction
657 : !!***
658 :
659 : !!****f* functionals_pwscf/get_dft_name
660 : !!
661 : !! NAME
662 : !! get_dft_name
663 : !!
664 : !! FUNCTION
665 : !!
666 : !! INPUTS
667 : !!
668 : !! OUTPUT
669 : !!
670 : !! SOURCE
671 : !-----------------------------------------------------------------------
672 0 : function get_dft_name ()
673 :
674 : character (len=50) :: get_dft_name
675 0 : get_dft_name = dft
676 0 : return
677 : end function get_dft_name
678 : !!***
679 :
680 : !!****f* functionals_pwscf/dft_is_gradient
681 : !!
682 : !! NAME
683 : !! dft_is_gradient
684 : !!
685 : !! FUNCTION
686 : !!
687 : !! INPUTS
688 : !!
689 : !! OUTPUT
690 : !!
691 : !! SOURCE
692 : !-----------------------------------------------------------------------
693 0 : function dft_is_gradient ()
694 :
695 : logical :: dft_is_gradient
696 0 : dft_is_gradient = isgradient
697 : return
698 : end function dft_is_gradient
699 : !!***
700 :
701 : !!****f* functionals_pwscf/dft_is_meta
702 : !!
703 : !! NAME
704 : !! dft_is_meta
705 : !!
706 : !! FUNCTION
707 : !!
708 : !! INPUTS
709 : !!
710 : !! OUTPUT
711 : !!
712 : !! SOURCE
713 : !-----------------------------------------------------------------------
714 0 : function dft_is_meta ()
715 :
716 : logical :: dft_is_meta
717 0 : dft_is_meta = ismeta
718 : return
719 : end function dft_is_meta
720 : !!***
721 :
722 : !!****f* functionals_pwscf/dft_is_hybrid
723 : !!
724 : !! NAME
725 : !! dft_is_hybrid
726 : !!
727 : !! FUNCTION
728 : !!
729 : !! INPUTS
730 : !!
731 : !! OUTPUT
732 : !!
733 : !! SOURCE
734 : !-----------------------------------------------------------------------
735 0 : function dft_is_hybrid ()
736 :
737 : logical :: dft_is_hybrid
738 0 : dft_is_hybrid = ishybrid
739 : return
740 : end function dft_is_hybrid
741 : !!***
742 :
743 : !!****f* functionals_pwscf/set_dft_from_indices
744 : !!
745 : !! NAME
746 : !! set_dft_from_indices
747 : !!
748 : !! FUNCTION
749 : !!
750 : !! INPUTS
751 : !!
752 : !! OUTPUT
753 : !!
754 : !! SOURCE
755 : !-----------------------------------------------------------------------
756 2 : subroutine set_dft_from_indices(iexch_,icorr_,igcx_,igcc_)
757 :
758 : use defs_basis, only : std_out,std_out_default
759 : use flib_pwscf
760 : !implicit none
761 : integer :: iexch_, icorr_, igcx_, igcc_
762 2 : if ( discard_input_dft ) return
763 2 : if (iexch == notset) iexch = iexch_
764 2 : if (iexch /= iexch_) then
765 0 : write(std_out,*) iexch, iexch_
766 0 : call errore('set_dft',' conflicting values for iexch',1)
767 : end if
768 2 : if (icorr == notset) icorr = icorr_
769 2 : if (icorr /= icorr_) then
770 0 : write(std_out,*) icorr, icorr_
771 0 : call errore('set_dft',' conflicting values for icorr',1)
772 : end if
773 2 : if (igcx == notset) igcx = igcx_
774 2 : if (igcx /= igcx_) then
775 0 : write(std_out,*) igcx, igcx_
776 0 : call errore('set_dft',' conflicting values for igcx',1)
777 : end if
778 2 : if (igcc == notset) igcc = igcc_
779 2 : if (igcc /= igcc_) then
780 0 : write(std_out,*) igcc, igcc_
781 0 : call errore('set_dft',' conflicting values for igcc',1)
782 : end if
783 : dft = exc (iexch) //'-'//corr (icorr) //'-'//gradx (igcx) //'-' &
784 2 : &//gradc (igcc)
785 : ! write(std_out,'(a)') dft
786 2 : call set_auxiliary_flags
787 2 : return
788 : end subroutine set_dft_from_indices
789 : !!***
790 :
791 : !!****f* functionals_pwscf/dft_name
792 : !!
793 : !! NAME
794 : !! dft_name
795 : !!
796 : !! FUNCTION
797 : !! convert the four indices iexch, icorr, igcx, igcc
798 : !! into user-readable strings
799 : !!
800 : !! INPUTS
801 : !!
802 : !! OUTPUT
803 : !!
804 : !! SOURCE
805 : !---------------------------------------------------------------------
806 0 : subroutine dft_name(iexch_, icorr_, igcx_, igcc_, longname_, shortname_)
807 : !---------------------------------------------------------------------
808 : !implicit none
809 : integer iexch_, icorr_, igcx_, igcc_
810 : character (len=4) :: shortname_
811 : character (len=20):: longname_
812 : !
813 0 : if (iexch_==1.and.igcx_==0.and.igcc_==0) then
814 0 : shortname_ = corr(icorr_)
815 0 : else if (iexch_==1.and.icorr_==3.and.igcx_==1.and.igcc_==3) then
816 0 : shortname_ = 'BLYP'
817 0 : else if (iexch_==1.and.icorr_==1.and.igcx_==1.and.igcc_==0) then
818 0 : shortname_ = 'B88'
819 0 : else if (iexch_==1.and.icorr_==1.and.igcx_==1.and.igcc_==1) then
820 0 : shortname_ = 'BP'
821 0 : else if (iexch_==1.and.icorr_==4.and.igcx_==2.and.igcc_==2) then
822 0 : shortname_ = 'PW91'
823 0 : else if (iexch_==1.and.icorr_==4.and.igcx_==3.and.igcc_==4) then
824 0 : shortname_ = 'PBE'
825 0 : else if (iexch_==6.and.icorr_==4.and.igcx_==8.and.igcc_==4) then
826 0 : shortname_ = 'PBE0'
827 : else
828 0 : shortname_ = ' '
829 : end if
830 0 : write(longname_,'(4a5)') exc(iexch_),corr(icorr_),gradx(igcx_),gradc(igcc_)
831 :
832 0 : return
833 : end subroutine dft_name
834 : !!***
835 :
836 : !!****f* functionals_pwscf/write_dft_name
837 : !!
838 : !! NAME
839 : !! write_dft_name
840 : !!
841 : !! FUNCTION
842 : !!
843 : !! INPUTS
844 : !!
845 : !! OUTPUT
846 : !!
847 : !! SOURCE
848 :
849 0 : subroutine write_dft_name
850 : !-----------------------------------------------------------------------
851 : use defs_basis, only : std_out,std_out_default
852 : !implicit none
853 :
854 : !write(std_out,'(5X,"Exchange-correlation = ",A, &
855 : ! & " (",4I1,")")') TRIM( dft ), iexch, icorr, igcx, igcc
856 :
857 0 : write(std_out,'(5X,a,A,a,4I1,a)') "Exchange-correlation = ", TRIM( dft ), " (", iexch, icorr, igcx, igcc, ")"
858 0 : return
859 : end subroutine write_dft_name
860 :
861 :
862 : end module funct_pwscf
863 : !!***
|
