LCOV - code coverage report
Current view: top level - src/57_iopsp_parser - functionals_pwscf.F90 (source / functions) Coverage Total Hit
Test: coverage.info Lines: 43.3 % 178 77
Test Date: 2026-11-11 14:12:33 Functions: 42.1 % 19 8
Branches: 34.4 % 154 53

             Branch data     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                 :             : !!***
        

Generated by: LCOV version 2.3-1