LCOV - code coverage report
Current view: top level - src/80_tdep - m_tdep_qpt.F90 (source / functions) Coverage Total Hit
Test: coverage.info Lines: 75.6 % 311 235
Test Date: 2026-11-09 13:21:34 Functions: 44.4 % 9 4
Branches: 47.3 % 478 226

             Branch data     Line data    Source code
       1                 :             : !!****m* ABINIT/m_tdep_qpt
       2                 :             : !! NAME
       3                 :             : !!  m_tdep_qpt
       4                 :             : !!
       5                 :             : !! FUNCTION
       6                 :             : !!  This module contains the data types describing the q-points (the path in
       7                 :             : !!  the Brillouin zone, and the grid of the full and irreducible Brillouin
       8                 :             : !!  zones), and the routines building the q-point path.
       9                 :             : !!
      10                 :             : !! COPYRIGHT
      11                 :             : !! Copyright (C) 2011-2026 ABINIT group (GA,FB,JB)
      12                 :             : !! This file is distributed under the terms of the
      13                 :             : !! GNU General Public License, see ~abinit/COPYING
      14                 :             : !! or http://www.gnu.org/copyleft/gpl.txt .
      15                 :             : !!
      16                 :             : !! SOURCE
      17                 :             : 
      18                 :             : #if defined HAVE_CONFIG_H
      19                 :             : #include "config.h"
      20                 :             : #endif
      21                 :             : 
      22                 :             : #include "abi_common.h"
      23                 :             : 
      24                 :             : module m_tdep_qpt
      25                 :             : 
      26                 :             :  use defs_basis
      27                 :             :  use m_errors
      28                 :             :  use m_abicore
      29                 :             :  use m_xmpi
      30                 :             :  use m_tdep_dataset,     only : atdep_dataset_type, MPI_enreg_type
      31                 :             :  use m_tdep_latt,        only : Lattice_type
      32                 :             : 
      33                 :             :  implicit none
      34                 :             : !!***
      35                 :             : 
      36                 :             : !!****t* m_tdep_qpt/QptBound_type
      37                 :             : !! NAME
      38                 :             : !! QptBound_type
      39                 :             : !!
      40                 :             : !! FUNCTION
      41                 :             : !!  Defines a special q-point of the Brillouin zone, for a given Bravais lattice.
      42                 :             : !!
      43                 :             : !! SOURCE
      44                 :             : 
      45                 :             :   type QptBound_type
      46                 :             : 
      47                 :             :     integer :: ihol,center
      48                 :             :     ! Holohedry and centering of the Bravais lattice (see Invar%bravais)
      49                 :             : 
      50                 :             :     character (len=5) :: letter
      51                 :             :     ! Name of the special q-point
      52                 :             : 
      53                 :             :     double precision :: x,y,z
      54                 :             :     ! Reduced coordinates of the special q-point
      55                 :             : 
      56                 :             :   end type QptBound_type
      57                 :             : !!***
      58                 :             : 
      59                 :             : !!****t* m_tdep_qpt/Qpoints_type
      60                 :             : !! NAME
      61                 :             : !! Qpoints_type
      62                 :             : !!
      63                 :             : !! FUNCTION
      64                 :             : !!  Holds the q-point path in the Brillouin zone, used to compute the
      65                 :             : !!  phonon dispersion.
      66                 :             : !!
      67                 :             : !! SOURCE
      68                 :             : 
      69                 :             :   type Qpoints_type
      70                 :             : 
      71                 :             :     integer :: nqpt,qpt_tot,qptbound_tot
      72                 :             :     ! Number of q-points along the path, number of special q-points defining
      73                 :             :     ! the path, and number of special q-points available for this Bravais lattice
      74                 :             : 
      75                 :             :     integer, allocatable :: lgth_segments(:)
      76                 :             :     ! lgth_segments(qpt_tot-1)
      77                 :             :     ! Number of q-points along each segment of the path
      78                 :             : 
      79                 :             :     double precision, allocatable :: qpt_red(:,:),qpt_cart(:,:)
      80                 :             :     ! qpt_red(3,nqpt), qpt_cart(3,nqpt)
      81                 :             :     ! Reduced and cartesian coordinates of the q-points along the path
      82                 :             : 
      83                 :             :     double precision, allocatable :: special_red(:,:),special_cart(:,:)
      84                 :             :     ! special_red(qpt_tot,3), special_cart(qpt_tot,3)
      85                 :             :     ! Reduced and cartesian coordinates of the special q-points defining the path
      86                 :             : 
      87                 :             :     character (len=5), allocatable :: special_qpt(:)
      88                 :             :     ! special_qpt(qpt_tot)
      89                 :             :     ! Names of the special q-points defining the path
      90                 :             : 
      91                 :             :     contains
      92                 :             : 
      93                 :             :     procedure :: init => tdep_make_qptpath
      94                 :             :     procedure :: free => tdep_destroy_qpt
      95                 :             : 
      96                 :             :   end type Qpoints_type
      97                 :             : !!***
      98                 :             : 
      99                 :             : !!****t* m_tdep_qpt/Qbz_type
     100                 :             : !! NAME
     101                 :             : !! Qbz_type
     102                 :             : !!
     103                 :             : !! FUNCTION
     104                 :             : !!  Holds the q-points of a grid in the full and irreducible Brillouin zones,
     105                 :             : !!  and their weights (see tdep_init_ddb).
     106                 :             : !!
     107                 :             : !! SOURCE
     108                 :             : 
     109                 :             :   type Qbz_type
     110                 :             : 
     111                 :             :     integer :: nqbz,nqibz
     112                 :             :     ! Number of q-points in the full and in the irreducible Brillouin zone
     113                 :             : 
     114                 :             :     integer, allocatable :: ibz2bz(:)
     115                 :             :     ! ibz2bz(nqbz)
     116                 :             :     ! Index, in the full Brillouin zone, of each irreducible q-point
     117                 :             : 
     118                 :             :     double precision, allocatable :: wtq(:),wtqibz(:)
     119                 :             :     ! wtq(nqbz), wtqibz(nqibz)
     120                 :             :     ! Weights of the q-points in the full and in the irreducible Brillouin zone
     121                 :             : 
     122                 :             :     double precision, allocatable :: qbz(:,:), qbz_cart(:,:)
     123                 :             :     ! qbz(3,nqbz), qbz_cart(3,nqbz)
     124                 :             :     ! Reduced and cartesian coordinates of the q-points in the full Brillouin zone
     125                 :             : 
     126                 :             :     double precision, allocatable :: qibz(:,:),qibz_cart(:,:)
     127                 :             :     ! qibz(3,nqibz), qibz_cart(3,nqibz)
     128                 :             :     ! Reduced and cartesian coordinates of the q-points in the irreducible Brillouin zone
     129                 :             : 
     130                 :             :     contains
     131                 :             : 
     132                 :             :     procedure :: free => tdep_destroy_qbz
     133                 :             : 
     134                 :             :   end type Qbz_type
     135                 :             : !!***
     136                 :             : 
     137                 :             :   public :: tdep_make_qptpath
     138                 :             :   public :: tdep_make_specialqpt
     139                 :             :   public :: tdep_destroy_qpt
     140                 :             :   public :: tdep_destroy_qbz
     141                 :             : 
     142                 :             : contains
     143                 :             : 
     144                 :             : !=====================================================================================================
     145                 :             : 
     146                 :             : !!****f* ABINIT/m_tdep_qpt/tdep_make_specialqpt
     147                 :             : !! NAME
     148                 :             : !!  tdep_make_specialqpt
     149                 :             : !!
     150                 :             : !! FUNCTION
     151                 :             : !!  Define the special q-points available for the Bravais lattice of the
     152                 :             : !!  crystal (see Setyawan and Curtarolo, Comput. Mater. Sci. 49, 299 (2010)),
     153                 :             : !!  and the names of the special q-points defining the path: either a default
     154                 :             : !!  path for this Bravais lattice (Invar%bzpath=0), or the path given in the
     155                 :             : !!  input file (Invar%bzpath>0). Information is written on unit 40, which must
     156                 :             : !!  be opened by the caller (see tdep_make_qptpath).
     157                 :             : !!
     158                 :             : !! INPUTS
     159                 :             : !!  Invar = Input object containing the input variables.
     160                 :             : !!  MPIdata = Info on MPI parallelism.
     161                 :             : !!  Lattice = Lattice object describing the ideal structure.
     162                 :             : !!
     163                 :             : !! OUTPUT
     164                 :             : !!  Qpt = Qpoints object. Qpt%special_qpt, Qpt%qpt_tot and Qpt%qptbound_tot are set.
     165                 :             : !!  QptBound(qptbound_tot) = Special q-points available for this Bravais lattice.
     166                 :             : !!
     167                 :             : !! SOURCE
     168                 :             : 
     169   [ -  +  -  +  :          46 :  subroutine tdep_make_specialqpt(Invar,MPIdata,Lattice,Qpt,QptBound)
          -  +  -  +  -  
                +  -  + ]
     170                 :             : 
     171                 :             :   integer :: qpt_tot,qptbound_tot
     172                 :             :   double precision :: zeta,eta,delta,mu,nu,angle_alpha
     173                 :             :   type(atdep_dataset_type),intent(in) :: Invar
     174                 :             :   type(MPI_enreg_type), intent(in) :: MPIdata
     175                 :             :   type(QptBound_type), allocatable,intent(out) :: QptBound(:)
     176                 :             :   type(Lattice_type),intent(in) :: Lattice
     177                 :             :   type(Qpoints_type),intent(out) :: Qpt
     178                 :             : 
     179                 :             : ! For bravais(1):
     180                 :             : ! The holohedral groups are numbered as follows
     181                 :             : ! (see international tables for crystallography (1983), p. 13)
     182                 :             : ! iholohedry=1   triclinic      1bar
     183                 :             : ! iholohedry=2   monoclinic     2/m
     184                 :             : ! iholohedry=3   orthorhombic   mmm
     185                 :             : ! iholohedry=4   tetragonal     4/mmm
     186                 :             : ! iholohedry=5   trigonal       3bar m
     187                 :             : ! iholohedry=6   hexagonal      6/mmm
     188                 :             : ! iholohedry=7   cubic          m3bar m
     189                 :             : 
     190                 :             : ! For bravais(2):
     191                 :             : ! Centering
     192                 :             : ! center=0        no centering
     193                 :             : ! center=-1       body-centered
     194                 :             : ! center=-3       face-centered
     195                 :             : ! center=1        A-face centered
     196                 :             : ! center=2        B-face centered
     197                 :             : ! center=3        C-face centered
     198                 :             : 
     199                 :             : ! Define the special Q points IN GENERAL
     200                 :             : ! Here we use the definitions of special Q points in reduced coordinates
     201                 :             : ! as defined in the article: Setyawan and Curtarolo CMS 49, 299 (2010)
     202   [ +  +  -  +  :          46 :   if ((Invar%bravais(1).eq.2).and.(Invar%bravais(2).eq.0)) then
          -  +  +  +  +  
                +  +  - ]
     203                 :             : !FB    qptbound_tot=16
     204                 :           1 :     qptbound_tot=10
     205                 :           1 :     angle_alpha=Lattice%angle_alpha
     206                 :           1 :     eta=(1.-Lattice%acell_unitcell(2)*dcos(angle_alpha*pi/180.d0)/Lattice%acell_unitcell(3))/(2.*dsin(angle_alpha*pi/180.d0)**2)
     207                 :           1 :     nu = 1./2.-eta*Lattice%acell_unitcell(3)*dcos(angle_alpha*pi/180.d0)/Lattice%acell_unitcell(2)
     208   [ -  +  -  + ]:           1 :     ABI_MALLOC(QptBound,(qptbound_tot))
     209                 :             :     QptBound(:)=(/ QptBound_type (2, 0,'G ', 0.000, 0.000, 0.000),&
     210                 :             : &                  QptBound_type (2, 0,'A ', 0.500, 0.500, 0.000),&
     211                 :             : &                  QptBound_type (2, 0,'C ', 0.000, 0.500, 0.500),&
     212                 :             : &                  QptBound_type (2, 0,'D ', 0.500, 0.000, 0.500),&
     213                 :             : &                  QptBound_type (2, 0,'D1', 0.500, 0.000,-0.500),&
     214                 :             : &                  QptBound_type (2, 0,'E ', 0.500, 0.500, 0.500),&
     215                 :             : !FB&                  QptBound_type (2, 0,'H ', 0.000, eta  , 1-nu ),&
     216                 :             : !FB&                  QptBound_type (2, 0,'H1', 0.000, 1-eta, nu   ),&
     217                 :             : !FB&                  QptBound_type (2, 0,'H2', 0.000, eta  , -nu  ),&
     218                 :             : !FB&                  QptBound_type (2, 0,'M ', 0.500, eta  , 1-nu ),&
     219                 :             : !FB&                  QptBound_type (2, 0,'M1', 0.500, 1-eta, nu   ),&
     220                 :             : !FB&                  QptBound_type (2, 0,'M2', 0.500, eta  , -nu  ),&
     221                 :             : &                  QptBound_type (2, 0,'X ', 0.000, 0.500, 0.000),&
     222                 :             : &                  QptBound_type (2, 0,'Y ', 0.000, 0.000, 0.500),&
     223                 :             : &                  QptBound_type (2, 0,'Y1', 0.000, 0.000,-0.500),&
     224         [ +  + ]:          11 : &                  QptBound_type (2, 0,'Z ', 0.500, 0.000, 0.000) /)
     225                 :             :   else if ((Invar%bravais(1).eq.3).and.(Invar%bravais(2).eq.0)) then
     226                 :           2 :     qptbound_tot=8
     227   [ -  +  -  + ]:           2 :     ABI_MALLOC(QptBound,(qptbound_tot))
     228                 :             :     QptBound(:)=(/ QptBound_type (3, 0,'G ', 0.000, 0.000, 0.000),&
     229                 :             : &                  QptBound_type (3, 0,'R ', 0.500, 0.500, 0.500),&
     230                 :             : &                  QptBound_type (3, 0,'S ', 0.500, 0.500, 0.000),&
     231                 :             : &                  QptBound_type (3, 0,'T ', 0.000, 0.500, 0.500),&
     232                 :             : &                  QptBound_type (3, 0,'U ', 0.500, 0.000, 0.500),&
     233                 :             : &                  QptBound_type (3, 0,'X ', 0.500, 0.000, 0.000),&
     234                 :             : &                  QptBound_type (3, 0,'Y ', 0.000, 0.500, 0.000),&
     235         [ +  + ]:          18 : &                  QptBound_type (3, 0,'Z ', 0.000, 0.000, 0.500) /)
     236                 :             :   else if ((Invar%bravais(1).eq.3).and.(Invar%bravais(2).eq.-1)) then
     237                 :           0 :     zeta =(1.d0+Lattice%acell_unitcell(1)**2/Lattice%acell_unitcell(3)**2)/4.d0
     238                 :           0 :     eta  =(1.d0+Lattice%acell_unitcell(2)**2/Lattice%acell_unitcell(3)**2)/4.d0
     239                 :           0 :     delta=(Lattice%acell_unitcell(2)**2-Lattice%acell_unitcell(1)**2)/(4.d0*Lattice%acell_unitcell(3)**2)
     240                 :           0 :     mu   =(Lattice%acell_unitcell(1)**2+Lattice%acell_unitcell(2)**2)/(4.d0*Lattice%acell_unitcell(3)**2)
     241                 :           0 :     qptbound_tot=13
     242   [ #  #  #  # ]:           0 :     ABI_MALLOC(QptBound,(qptbound_tot))
     243                 :             :     QptBound(:)=(/ QptBound_type (3,-1,'G ', 0.000    , 0.000    , 0.000),&
     244                 :             : &                  QptBound_type (3,-1,'L ',-mu       , mu       , 0.5-delta),&
     245                 :             : &                  QptBound_type (3,-1,'L1', mu       ,-mu       , 0.5+delta),&
     246                 :             : &                  QptBound_type (3,-1,'L2', 0.5-delta, 0.5+delta,-mu),&
     247                 :             : &                  QptBound_type (3,-1,'R ', 0.000    , 0.500    , 0.000),&
     248                 :             : &                  QptBound_type (3,-1,'S ', 0.500    , 0.000    , 0.000),&
     249                 :             : &                  QptBound_type (3,-1,'T ', 0.000    , 0.000    , 0.500),&
     250                 :             : &                  QptBound_type (3,-1,'W ', 0.250    , 0.250    , 0.250),&
     251                 :             : &                  QptBound_type (3,-1,'X ',-zeta     , zeta     , zeta ),&
     252                 :             : &                  QptBound_type (3,-1,'X1', zeta     , 1-zeta   ,-zeta),&
     253                 :             : &                  QptBound_type (3,-1,'Y ', eta      ,-eta      , eta),&
     254                 :             : &                  QptBound_type (3,-1,'Y1', 1-eta    , eta      ,-eta),&
     255         [ #  # ]:           0 : &                  QptBound_type (3,-1,'Z ', 0.500    , 0.500    ,-0.500) /)
     256                 :             :   else if ((Invar%bravais(1).eq.3).and.(Invar%bravais(2).eq.3)) then
     257                 :           7 :     zeta=(1.d0+Lattice%acell_unitcell(1)**2/Lattice%acell_unitcell(2)**2)/4.d0
     258                 :           7 :     qptbound_tot=13
     259   [ -  +  -  + ]:           7 :     ABI_MALLOC(QptBound,(qptbound_tot))
     260                 :             :     QptBound(:)=(/ QptBound_type (3, 3,'G ', 0.000, 0.000, 0.000),&
     261                 :             : &                  QptBound_type (3, 3,'Gp', 1.000, 0.000, 0.000),&
     262                 :             : &                  QptBound_type (3, 3,'A ', zeta , zeta , 0.500),&
     263                 :             : &                  QptBound_type (3, 3,'A1',-zeta ,1-zeta, 0.500),&
     264                 :             : &                  QptBound_type (3, 3,'R ', 0.000, 0.500, 0.500),&
     265                 :             : &                  QptBound_type (3, 3,'S ', 0.000, 0.500, 0.000),&
     266                 :             : &                  QptBound_type (3, 3,'T ',-0.500, 0.500, 0.500),&
     267                 :             : &                  QptBound_type (3, 3,'X ', zeta , zeta , 0.000),&
     268                 :             : &                  QptBound_type (3, 3,'X1',-zeta ,1-zeta, 0.000),&
     269                 :             : &                  QptBound_type (3, 3,'Y ',-0.500, 0.500, 0.000),&
     270                 :             : &                  QptBound_type (3, 3,'Yp', 0.500, 0.500, 0.000),&
     271                 :             : &                  QptBound_type (3, 3,'Z ', 0.000, 0.000, 0.500),&
     272         [ +  + ]:          98 : &                  QptBound_type (3, 3,'Zp', 1.000, 0.000, 0.500) /)
     273                 :             :   else if ((Invar%bravais(1).eq.4).and.(Invar%bravais(2).eq.0)) then
     274                 :           0 :     qptbound_tot=6
     275   [ #  #  #  # ]:           0 :     ABI_MALLOC(QptBound,(qptbound_tot))
     276                 :             :     QptBound(:)=(/ QptBound_type (4, 0,'G ', 0.000, 0.000, 0.000),&
     277                 :             : &                  QptBound_type (4, 0,'A ', 0.500, 0.500, 0.500),&
     278                 :             : &                  QptBound_type (4, 0,'M ', 0.500, 0.500, 0.000),&
     279                 :             : &                  QptBound_type (4, 0,'R ', 0.000, 0.500, 0.500),&
     280                 :             : &                  QptBound_type (4, 0,'X ', 0.000, 0.500, 0.000),&
     281         [ #  # ]:           0 : &                  QptBound_type (4, 0,'Z ', 0.000, 0.000, 0.500) /)
     282                 :             :   else if ((Invar%bravais(1).eq.4).and.(Invar%bravais(2).eq.-1)) then
     283         [ +  - ]:           2 :     if (Lattice%acell_unitcell(3).lt.Lattice%acell_unitcell(1)) then
     284                 :           2 :       qptbound_tot=7
     285                 :           2 :       eta=(1.d0+Lattice%acell_unitcell(3)**2/Lattice%acell_unitcell(1)**2)/4.d0
     286   [ -  +  -  + ]:           2 :       ABI_MALLOC(QptBound,(qptbound_tot))
     287                 :             :       QptBound(:)=(/ QptBound_type (4,-1,'G ', 0.000, 0.000, 0.000),&
     288                 :             : &                    QptBound_type (4,-1,'M ',-0.500, 0.500, 0.500),&
     289                 :             : &                    QptBound_type (4,-1,'N ', 0.000, 0.500, 0.500),&
     290                 :             : &                    QptBound_type (4,-1,'P ', 0.250, 0.250, 0.250),&
     291                 :             : &                    QptBound_type (4,-1,'X ', 0.000, 0.000, 0.500),&
     292                 :             : &                    QptBound_type (4,-1,'Z ', eta  , eta  ,-eta  ),&
     293         [ +  + ]:          16 : &                    QptBound_type (4,-1,'Z1',-eta  ,1.-eta, eta  ) /)
     294                 :             :     else
     295                 :           0 :       qptbound_tot=9
     296                 :           0 :       eta=(1.d0+Lattice%acell_unitcell(1)**2/Lattice%acell_unitcell(3)**2)/4.d0
     297                 :           0 :       zeta=Lattice%acell_unitcell(1)**2/Lattice%acell_unitcell(3)**2/2.d0
     298   [ #  #  #  # ]:           0 :       ABI_MALLOC(QptBound,(qptbound_tot))
     299                 :             :       QptBound(:)=(/ QptBound_type (4,-1,'G ', 0.000, 0.000, 0.000),&
     300                 :             : &                    QptBound_type (4,-1,'N ', 0.000, 0.500, 0.000),&
     301                 :             : &                    QptBound_type (4,-1,'P ', 0.250, 0.250, 0.250),&
     302                 :             : &                    QptBound_type (4,-1,'S ',-eta  , eta  , eta  ),&
     303                 :             : &                    QptBound_type (4,-1,'S1', eta  ,1.-eta,-eta  ),&
     304                 :             : &                    QptBound_type (4,-1,'X ', 0.000, 0.000, 0.500),&
     305                 :             : &                    QptBound_type (4,-1,'Y ',-zeta , zeta , 0.500),&
     306                 :             : &                    QptBound_type (4,-1,'Y1', 0.500, 0.500,-zeta ),&
     307         [ #  # ]:           0 : &                    QptBound_type (4,-1,'Z ', 0.500, 0.500,-0.500) /)
     308                 :             :     end if
     309                 :             :   else if ((Invar%bravais(1).eq.5).and.(Invar%bravais(2).eq.0)) then
     310                 :           3 :     qptbound_tot=9
     311                 :           3 :     angle_alpha=Lattice%angle_alpha
     312                 :           3 :     eta=(1d0+4*dcos(angle_alpha*pi/180d0))/(2d0+4*dcos(angle_alpha*pi/180d0))
     313                 :           3 :     nu=3d0/4d0-eta/2d0
     314   [ -  +  -  + ]:           3 :     ABI_MALLOC(QptBound,(qptbound_tot))
     315                 :             :     QptBound(:)=(/ QptBound_type (5, 0,'G ', 0.000, 0.000, 0.000),&
     316                 :             : &                  QptBound_type (5, 0,'F ', 0.500, 0.500, 0.000),&
     317                 :             : &                  QptBound_type (5, 0,'F1 ', 0.500, 0.000, -0.500),&
     318                 :             : &                  QptBound_type (5, 0,'L ', 0.500, 0.000, 0.000),&
     319                 :             : &                  QptBound_type (5, 0,'Z ', 0.500, 0.500, 0.500),&
     320                 :             : &                  QptBound_type (5, 0,'Q ', 1-nu,nu,0),&
     321                 :             : &                  QptBound_type (5, 0,'X ', nu,0,-nu),&
     322                 :             : &                  QptBound_type (5, 0,'B1 ', 0.500,1-eta,eta-1),&
     323         [ +  + ]:          30 : &                  QptBound_type (5, 0,'B ', eta,0.500, 1-eta) /)
     324                 :             :   else if ((Invar%bravais(1).eq.6).and.(Invar%bravais(2).eq.0)) then
     325                 :           5 :     qptbound_tot=6
     326   [ -  +  -  + ]:           5 :     ABI_MALLOC(QptBound,(qptbound_tot))
     327                 :             :     QptBound(:)=(/ QptBound_type (6, 0,'G ', 0.000, 0.000, 0.000),&
     328                 :             : &                  QptBound_type (6, 0,'A ', 0.000, 0.000, 0.500),&
     329                 :             : &                  QptBound_type (6, 0,'H ', 0.333, 0.333, 0.500),&
     330                 :             : &                  QptBound_type (6, 0,'K ', 0.333, 0.333, 0.000),&
     331                 :             : &                  QptBound_type (6, 0,'L ', 0.500, 0.000, 0.500),&
     332         [ +  + ]:          35 : &                  QptBound_type (6, 0,'M ', 0.500, 0.000, 0.000) /)
     333                 :             :   else if ((Invar%bravais(1).eq.7).and.(Invar%bravais(2).eq.0)) then
     334                 :           6 :     qptbound_tot=8
     335   [ -  +  -  + ]:           6 :     ABI_MALLOC(QptBound,(qptbound_tot))
     336                 :             :     QptBound(:)=(/ QptBound_type (7, 0,'G ', 0.000, 0.000, 0.000),&
     337                 :             : &                  QptBound_type (7, 0,'M ', 0.500, 0.500, 0.000),&
     338                 :             : &                  QptBound_type (7, 0,'R ', 0.500, 0.500, 0.500),&
     339                 :             : &                  QptBound_type (7, 0,'X ', 0.000, 0.500, 0.000),&
     340                 :             : ! For testing purpose only!!!!!!!!
     341                 :             : &                  QptBound_type (7, 0,'A ', 0.000, 1.000, 0.000),&
     342                 :             : &                  QptBound_type (7, 0,'B ', 0.500, 1.000, 0.000),&
     343                 :             : &                  QptBound_type (7, 0,'C ', 1.000, 1.000, 0.000),&
     344         [ +  + ]:          54 : &                  QptBound_type (7, 0,'D ', 0.750, 0.750, 0.000) /)
     345                 :             :   else if ((Invar%bravais(1).eq.7).and.(Invar%bravais(2).eq.-1)) then
     346                 :           4 :     qptbound_tot=4
     347   [ -  +  -  + ]:           4 :     ABI_MALLOC(QptBound,(qptbound_tot))
     348                 :             :     QptBound(:)=(/ QptBound_type (7,-1,'G ', 0.000, 0.000, 0.000),&
     349                 :             : &                  QptBound_type (7,-1,'H ', 0.500,-0.500, 0.500),&
     350                 :             : &                  QptBound_type (7,-1,'P ', 0.250, 0.250, 0.250),&
     351         [ +  + ]:          20 : &                  QptBound_type (7,-1,'N ', 0.000, 0.000, 0.500) /)
     352                 :             :   else if ((Invar%bravais(1).eq.7).and.(Invar%bravais(2).eq.-3)) then
     353                 :          16 :     qptbound_tot=8
     354   [ -  +  -  + ]:          16 :     ABI_MALLOC(QptBound,(qptbound_tot))
     355                 :             :     QptBound(:)=(/ QptBound_type (7,-3,'G ', 0.000, 0.000, 0.000),&
     356                 :             : &                  QptBound_type (7,-3,'K ', 0.375, 0.375, 0.750),&
     357                 :             : &                  QptBound_type (7,-3,'L ', 0.500, 0.500, 0.500),&
     358                 :             : &                  QptBound_type (7,-3,'U ', 0.625, 0.250, 0.625),&
     359                 :             : &                  QptBound_type (7,-3,'W ', 0.500, 0.250, 0.750),&
     360                 :             : &                  QptBound_type (7,-3,'X ', 0.500, 0.000, 0.500),&
     361                 :             : &                  QptBound_type (7,-3,'M ', 0.500, 0.500, 0.000),&
     362         [ +  + ]:         144 : &                  QptBound_type (7,-3,'Xp', 0.500, 0.500, 1.000) /)
     363                 :             :   end if
     364                 :          46 :   Qpt%qptbound_tot=qptbound_tot
     365                 :             : 
     366                 :             : ! Define the special Q points USED IN THE CALCULATIONS
     367                 :             : ! Two cases of generation: default (0) or by hand (>=1)
     368         [ +  + ]:          46 :   if (Invar%bzpath.eq.0) then
     369                 :          36 :     write(ab_out,*) 'Generate the BZ path using the Q points defined by default'
     370         [ +  - ]:          36 :     if (MPIdata%iam_master) then
     371                 :          36 :       write(40,*)         'Generate the BZ path using the Q points defined by default'
     372                 :             :     end if
     373   [ +  +  -  +  :          36 :     if ((Invar%bravais(1).eq.2).and.(Invar%bravais(2).eq.0)) then
          -  +  +  +  +  
                +  +  - ]
     374                 :             : !     MONO: G-Y-H-C-E-M1-A-X-H1
     375                 :             : !FB      qpt_tot=9
     376                 :           1 :       qpt_tot=5
     377   [ -  +  -  + ]:           1 :       ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
     378                 :           1 :       Qpt%special_qpt(1)="X "
     379                 :           1 :       Qpt%special_qpt(2)="G "
     380                 :           1 :       Qpt%special_qpt(3)="Y "
     381                 :           1 :       Qpt%special_qpt(4)="G "
     382                 :           1 :       Qpt%special_qpt(5)="Z "
     383                 :             : !FB      Qpt%special_qpt(1)="G "
     384                 :             : !FB      Qpt%special_qpt(2)="Y "
     385                 :             : !FB      Qpt%special_qpt(3)="H "
     386                 :             : !FB      Qpt%special_qpt(4)="C "
     387                 :             : !FB      Qpt%special_qpt(5)="E "
     388                 :             : !FB      Qpt%special_qpt(6)="M1"
     389                 :             : !FB      Qpt%special_qpt(7)="A "
     390                 :             : !FB      Qpt%special_qpt(8)="X "
     391                 :             : !FB      Qpt%special_qpt(9)="H1"
     392                 :             :     else if ((Invar%bravais(1).eq.3).and.(Invar%bravais(2).eq.0)) then
     393                 :             : !     ORTH: G-X-S-Y-G-Z
     394                 :           2 :       qpt_tot=6
     395   [ -  +  -  + ]:           2 :       ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
     396                 :           2 :       Qpt%special_qpt(1)="G "
     397                 :           2 :       Qpt%special_qpt(2)="X "
     398                 :           2 :       Qpt%special_qpt(3)="S "
     399                 :           2 :       Qpt%special_qpt(4)="Y "
     400                 :           2 :       Qpt%special_qpt(5)="G "
     401                 :           2 :       Qpt%special_qpt(6)="Z "
     402                 :             :     else if ((Invar%bravais(1).eq.3).and.(Invar%bravais(2).eq.-1)) then
     403                 :             : !     BCO: G-X-L-T-W-R-X1-Z-G-Y-S-W
     404                 :           0 :       qpt_tot=12
     405   [ #  #  #  # ]:           0 :       ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
     406                 :           0 :       Qpt%special_qpt(1)="G "
     407                 :           0 :       Qpt%special_qpt(2)="X "
     408                 :           0 :       Qpt%special_qpt(3)="L "
     409                 :           0 :       Qpt%special_qpt(4)="T "
     410                 :           0 :       Qpt%special_qpt(5)="W "
     411                 :           0 :       Qpt%special_qpt(6)="R "
     412                 :           0 :       Qpt%special_qpt(7)="X1"
     413                 :           0 :       Qpt%special_qpt(8)="Z "
     414                 :           0 :       Qpt%special_qpt(9)="G "
     415                 :           0 :       Qpt%special_qpt(10)="Y "
     416                 :           0 :       Qpt%special_qpt(11)="S "
     417                 :           0 :       Qpt%special_qpt(12)="W "
     418                 :             :     else if ((Invar%bravais(1).eq.3).and.(Invar%bravais(2).eq.3)) then
     419                 :             : !     ORTH-C: G-Yp-Gp-Z
     420                 :           7 :       qpt_tot=4
     421   [ -  +  -  + ]:           7 :       ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
     422                 :           7 :       Qpt%special_qpt(1) ="G "
     423                 :           7 :       Qpt%special_qpt(2) ="Yp"
     424                 :           7 :       Qpt%special_qpt(3) ="Gp"
     425                 :           7 :       Qpt%special_qpt(4) ="Zp"
     426                 :             :     else if ((Invar%bravais(1).eq.4).and.(Invar%bravais(2).eq.0)) then
     427                 :             : !     TET: G-X-M-G-Z-R-A-Z
     428                 :           0 :       qpt_tot=8
     429   [ #  #  #  # ]:           0 :       ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
     430                 :           0 :       Qpt%special_qpt(1) ="G "
     431                 :           0 :       Qpt%special_qpt(2) ="X "
     432                 :           0 :       Qpt%special_qpt(3) ="M "
     433                 :           0 :       Qpt%special_qpt(4) ="G "
     434                 :           0 :       Qpt%special_qpt(5) ="Z "
     435                 :           0 :       Qpt%special_qpt(6) ="R "
     436                 :           0 :       Qpt%special_qpt(7) ="A "
     437                 :           0 :       Qpt%special_qpt(8) ="Z "
     438                 :             :     else if ((Invar%bravais(1).eq.4).and.(Invar%bravais(2).eq.-1)) then
     439         [ +  - ]:           2 :       if (Lattice%acell_unitcell(3).lt.Lattice%acell_unitcell(1)) then
     440                 :             : !       BCT1: G-X-M-G-Z-P-N-Z1-M
     441                 :           2 :         qpt_tot=9
     442   [ -  +  -  + ]:           2 :         ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
     443                 :           2 :         Qpt%special_qpt(1) ="G "
     444                 :           2 :         Qpt%special_qpt(2) ="X "
     445                 :           2 :         Qpt%special_qpt(3) ="M "
     446                 :           2 :         Qpt%special_qpt(4) ="G "
     447                 :           2 :         Qpt%special_qpt(5) ="Z "
     448                 :           2 :         Qpt%special_qpt(6) ="P "
     449                 :           2 :         Qpt%special_qpt(7) ="N "
     450                 :           2 :         Qpt%special_qpt(8) ="Z1"
     451                 :           2 :         Qpt%special_qpt(9) ="M "
     452                 :             :       else
     453                 :             : !       BCT2: G-X-Y-S-G-Z-S1-N-P-Y1-Z
     454                 :           0 :         qpt_tot=11
     455   [ #  #  #  # ]:           0 :         ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
     456                 :           0 :         Qpt%special_qpt(1) ="G "
     457                 :           0 :         Qpt%special_qpt(2) ="X "
     458                 :           0 :         Qpt%special_qpt(3) ="Y "
     459                 :           0 :         Qpt%special_qpt(4) ="S "
     460                 :           0 :         Qpt%special_qpt(5) ="G "
     461                 :           0 :         Qpt%special_qpt(6) ="Z "
     462                 :           0 :         Qpt%special_qpt(7) ="S1"
     463                 :           0 :         Qpt%special_qpt(8) ="N "
     464                 :           0 :         Qpt%special_qpt(9) ="P "
     465                 :           0 :         Qpt%special_qpt(10)="Y1"
     466                 :           0 :         Qpt%special_qpt(11)="Z "
     467                 :             :       end if
     468                 :             :     else if ((Invar%bravais(1).eq.5).and.(Invar%bravais(2).eq.0)) then
     469                 :             : !     RHOMBO:F1-Q-G-Z-B-B1-L-G-F
     470                 :           3 :       qpt_tot=9
     471   [ -  +  -  + ]:           3 :       ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
     472                 :           3 :       Qpt%special_qpt(1)="F1"
     473                 :           3 :       Qpt%special_qpt(2)="X"
     474                 :           3 :       Qpt%special_qpt(3)="G "
     475                 :           3 :       Qpt%special_qpt(4)="Z "
     476                 :           3 :       Qpt%special_qpt(5)="B "
     477                 :           3 :       Qpt%special_qpt(6)="B1 "
     478                 :           3 :       Qpt%special_qpt(7)="L "
     479                 :           3 :       Qpt%special_qpt(8)="G "
     480                 :           3 :       Qpt%special_qpt(9)="F "
     481                 :             :     else if ((Invar%bravais(1).eq.6).and.(Invar%bravais(2).eq.0)) then
     482                 :             : !     HEX: G-M-K-G-A-L-H-A
     483                 :           4 :       qpt_tot=8
     484   [ -  +  -  + ]:           4 :       ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
     485                 :           4 :       Qpt%special_qpt(1)="G "
     486                 :           4 :       Qpt%special_qpt(2)="M "
     487                 :           4 :       Qpt%special_qpt(3)="K "
     488                 :           4 :       Qpt%special_qpt(4)="G "
     489                 :           4 :       Qpt%special_qpt(5)="A "
     490                 :           4 :       Qpt%special_qpt(6)="L "
     491                 :           4 :       Qpt%special_qpt(7)="H "
     492                 :           4 :       Qpt%special_qpt(8)="A "
     493                 :             :     else if ((Invar%bravais(1).eq.7).and.(Invar%bravais(2).eq.0)) then
     494                 :             : !     SC: G-X-M-G-R
     495                 :           2 :       qpt_tot=5
     496   [ -  +  -  + ]:           2 :       ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
     497                 :           2 :       Qpt%special_qpt(1)="G "
     498                 :           2 :       Qpt%special_qpt(2)="X "
     499                 :           2 :       Qpt%special_qpt(3)="M "
     500                 :           2 :       Qpt%special_qpt(4)="G "
     501                 :           2 :       Qpt%special_qpt(5)="R "
     502                 :             :     else if ((Invar%bravais(1).eq.7).and.(Invar%bravais(2).eq.-1)) then
     503                 :             : !     BCC: G-P-H-G-N
     504                 :           3 :       qpt_tot=5
     505   [ -  +  -  + ]:           3 :       ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
     506                 :           3 :       Qpt%special_qpt(1)="G "
     507                 :           3 :       Qpt%special_qpt(2)="P "
     508                 :           3 :       Qpt%special_qpt(3)="H "
     509                 :           3 :       Qpt%special_qpt(4)="G "
     510                 :           3 :       Qpt%special_qpt(5)="N "
     511                 :             :     else if ((Invar%bravais(1).eq.7).and.(Invar%bravais(2).eq.-3)) then
     512                 :             : !     FCC: G-X-W-Xp-K-G-L
     513                 :          12 :       qpt_tot=7
     514   [ -  +  -  + ]:          12 :       ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
     515                 :          12 :       Qpt%special_qpt(1)="G "
     516                 :          12 :       Qpt%special_qpt(2)="X "
     517                 :          12 :       Qpt%special_qpt(3)="W "
     518                 :          12 :       Qpt%special_qpt(4)="Xp"
     519                 :          12 :       Qpt%special_qpt(5)="K "
     520                 :          12 :       Qpt%special_qpt(6)="G "
     521                 :          12 :       Qpt%special_qpt(7)="L "
     522                 :             :     end if
     523         [ -  + ]:          10 :   else if (Invar%bzpath.ge.1) then
     524                 :          10 :     write(ab_out,*) 'Generate the BZ path using the Q points given in the input file'
     525         [ +  - ]:          10 :     if (MPIdata%iam_master) then
     526                 :          10 :       write(40,*)         'Generate the BZ path using the Q points given in the input file'
     527                 :             :     end if
     528                 :          10 :     qpt_tot=Invar%bzpath
     529   [ -  +  +  -  :          30 :     ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
          +  -  -  +  -  
                +  -  + ]
     530         [ +  + ]:          64 :     Qpt%special_qpt(:)=Invar%special_qpt(:)
     531                 :             :   end if
     532                 :          46 :   Qpt%qpt_tot=qpt_tot
     533                 :             : 
     534                 :          46 :  end subroutine tdep_make_specialqpt
     535                 :             : !!***
     536                 :             : !=====================================================================================================
     537                 :             : 
     538                 :             : !!****f* ABINIT/m_tdep_qpt/tdep_make_qptpath
     539                 :             : !! NAME
     540                 :             : !!  tdep_make_qptpath
     541                 :             : !!
     542                 :             : !! FUNCTION
     543                 :             : !!  Initialize the Qpoints object with the q-point path used to compute the
     544                 :             : !!  phonon dispersion. The special q-points defining the path are obtained
     545                 :             : !!  from tdep_make_specialqpt, and their cartesian coordinates are computed.
     546                 :             : !!  The number of q-points along each segment is either proportional to its
     547                 :             : !!  length (Invar%bzlength=0, with Invar%ndivsm points along the smallest
     548                 :             : !!  segment) or given in the input file (Invar%bzlength>0). The path is
     549                 :             : !!  written in the _qpt.dat file.
     550                 :             : !!  Note that a path given by the reduced coordinates of the q-points
     551                 :             : !!  (Invar%bzpath<0) is currently not supported (the code stops).
     552                 :             : !!
     553                 :             : !! INPUTS
     554                 :             : !!  Invar = Input object containing the input variables.
     555                 :             : !!  MPIdata = Info on MPI parallelism.
     556                 :             : !!  Lattice = Lattice object describing the ideal structure.
     557                 :             : !!
     558                 :             : !! OUTPUT
     559                 :             : !!
     560                 :             : !! SIDE EFFECTS
     561                 :             : !!  Qpt = Qpoints object, initialized.
     562                 :             : !!
     563                 :             : !! SOURCE
     564                 :             : 
     565                 :          46 :  subroutine tdep_make_qptpath(Qpt,Invar,MPIdata,Lattice)
     566                 :             : 
     567                 :             :   class(Qpoints_type),intent(inout) :: Qpt
     568                 :             :   integer :: ii,jj,kk,nqpt,iqpt,qpt_tot
     569                 :             :   logical :: IsThisAllowed
     570                 :             :   double precision :: nfact
     571                 :          46 :   double precision, allocatable :: seg_length(:)
     572                 :             :   type(atdep_dataset_type),intent(in) :: Invar
     573                 :             :   type(MPI_enreg_type), intent(in) :: MPIdata
     574                 :             :   type(Lattice_type),intent(in) :: Lattice
     575                 :          46 :   type(QptBound_type), allocatable :: QptBound(:)
     576                 :             : 
     577                 :          46 :   nqpt=0
     578         [ +  - ]:          46 :   if (MPIdata%iam_master) open(unit=40,file=trim(Invar%output_prefix)//'_qpt.dat')
     579                 :          46 :   write(ab_out,*) ' '
     580                 :          46 :   write(ab_out,*) '#############################################################################'
     581                 :          46 :   write(ab_out,*) '########################## Q points generation  #############################'
     582                 :          46 :   write(ab_out,*) '#############################################################################'
     583                 :             : ! Define the special Q points
     584                 :          46 :   call tdep_make_specialqpt(Invar,MPIdata,Lattice,Qpt,QptBound)
     585                 :             : 
     586                 :          46 :   write(ab_out,*) 'Writing q-points in file qpt.dat'
     587                 :             : 
     588                 :             : ! Define the path in the BZ
     589                 :             : ! Two cases of generation: default (0) or by hand (>=1)
     590                 :          46 :   qpt_tot     =Qpt%qpt_tot
     591   [ -  +  +  -  :        1131 :   ABI_MALLOC(Qpt%special_red ,(qpt_tot,3)); Qpt%special_red (:,:)=zero
          +  -  +  -  -  
          +  -  +  -  +  
             +  +  +  + ]
     592   [ -  +  +  -  :        1085 :   ABI_MALLOC(Qpt%special_cart,(qpt_tot,3)); Qpt%special_cart(:,:)=zero
          -  +  -  +  -  
             +  +  +  +  
                      + ]
     593                 :             : 
     594         [ +  - ]:          46 :   if (Invar%bzpath.ge.0) then
     595                 :             : !   If "by hand", verify that the Letter defining the Qpt bound is allowed for this
     596                 :             : !   crystallographic group
     597         [ +  + ]:         331 :     do jj=1,qpt_tot
     598                 :         285 :       IsThisAllowed=.false.
     599         [ +  + ]:        2572 :       do ii=1,Qpt%qptbound_tot
     600   [ +  -  +  - ]:        2572 :         if ((QptBound(ii)%ihol.eq.Invar%bravais(1)).and.(QptBound(ii)%center.eq.Invar%bravais(2))) then
     601         [ +  + ]:        2287 :           if (QptBound(ii)%letter.eq.Qpt%special_qpt(jj)) then
     602                 :         285 :             IsThisAllowed=.true.
     603                 :         285 :             Qpt%special_red(jj,1)=QptBound(ii)%x
     604                 :         285 :             Qpt%special_red(jj,2)=QptBound(ii)%y
     605                 :         285 :             Qpt%special_red(jj,3)=QptBound(ii)%z
     606                 :             :           end if
     607                 :             :         end if
     608                 :             :       end do
     609         [ -  + ]:         331 :       if (.not.IsThisAllowed) then
     610                 :           0 :         ABI_ERROR('One of the Qpt bound (letter) is not allowed.')
     611                 :             :       end if
     612                 :             :     end do
     613                 :             : !   Compute the cartesian coordinates of the special Q points in the reciprocical lattice
     614         [ +  + ]:         331 :     do ii=1,qpt_tot
     615         [ +  + ]:        1186 :       do jj=1,3
     616         [ +  + ]:        3705 :         do kk=1,3
     617         [ +  + ]:        3420 :           if (Lattice%line==2) then
     618                 :         414 :             Qpt%special_cart(ii,jj)=Qpt%special_cart(ii,jj)+Lattice%gprimt(kk,jj)*Qpt%special_red(ii,kk)/Lattice%acell_unitcell(jj)
     619         [ +  - ]:        2151 :           else if (Lattice%line==0.or.Lattice%line==1) then
     620                 :        2151 :             Qpt%special_cart(ii,jj)=Qpt%special_cart(ii,jj)+Lattice%gprimt(kk,jj)*Qpt%special_red(ii,kk)/Lattice%acell_unitcell(kk)
     621                 :             :           end if
     622                 :             :         end do
     623                 :             :       end do
     624                 :             :     end do
     625                 :             : 
     626         [ +  - ]:          46 :     if (qpt_tot.gt.1) then
     627   [ -  +  +  -  :         377 :       ABI_MALLOC(Qpt%lgth_segments,(qpt_tot-1)); Qpt%lgth_segments(:)=0
          +  -  -  +  -  
             +  -  +  +  
                      + ]
     628         [ +  + ]:          46 :       if (Invar%bzlength.eq.0) then
     629   [ -  +  +  -  :         132 :         ABI_MALLOC(seg_length,(qpt_tot-1))
          +  -  -  +  -  
                      + ]
     630         [ +  + ]:         273 :         do ii=1,qpt_tot-1
     631                 :             :           seg_length(ii)=dsqrt((Qpt%special_cart(ii,1)-Qpt%special_cart(ii+1,1))**2+&
     632                 :             : &                             (Qpt%special_cart(ii,2)-Qpt%special_cart(ii+1,2))**2+&
     633                 :         273 : &                             (Qpt%special_cart(ii,3)-Qpt%special_cart(ii+1,3))**2)
     634                 :             :         end do
     635   [ -  +  +  -  :         317 :         if (minval(seg_length).lt.tol6) then
             +  +  -  + ]
     636                 :           0 :           ABI_ERROR('Found two identical consecutive special q-points in the path.')
     637                 :             :         end if
     638   [ -  +  +  -  :         317 :         nfact=minval(seg_length)/dble(Invar%ndivsm)
                   +  + ]
     639         [ +  + ]:         273 :         do ii=1,qpt_tot-1
     640                 :         273 :           Qpt%lgth_segments(ii)=nint(seg_length(ii)/nfact)
     641                 :             :         end do
     642         [ -  + ]:          44 :         ABI_FREE(seg_length)
     643         [ +  - ]:           2 :       else if (Invar%bzlength.gt.0) then
     644         [ +  + ]:          12 :         do ii=1,qpt_tot-1
     645                 :          12 :           Qpt%lgth_segments(ii)=Invar%lgth_segments(ii)
     646                 :             :         end do
     647                 :             :       else if (Invar%bzlength.lt.0) then
     648         [ #  # ]:           0 :         Qpt%lgth_segments(:)=0
     649                 :             :       end if
     650                 :             : 
     651                 :             : !     Allocate and define the qpt points along the segments
     652         [ +  + ]:         285 :       do ii=1,qpt_tot-1
     653                 :         285 :         nqpt=nqpt+Qpt%lgth_segments(ii)
     654                 :             :       end do
     655                 :          46 :       nqpt=nqpt+1
     656   [ -  +  +  -  :       37298 :       ABI_MALLOC(Qpt%qpt_red ,(3,nqpt)); Qpt%qpt_red (:,:)=zero
          +  -  +  -  -  
          +  -  +  -  +  
             +  +  +  + ]
     657   [ -  +  +  -  :       37252 :       ABI_MALLOC(Qpt%qpt_cart,(3,nqpt)); Qpt%qpt_cart(:,:)=zero
          -  +  -  +  -  
             +  +  +  +  
                      + ]
     658                 :          46 :       iqpt=0
     659         [ +  + ]:         285 :       do ii=1,qpt_tot-1
     660         [ +  - ]:         239 :         if (Qpt%lgth_segments(ii).eq.0) cycle
     661         [ +  + ]:        9529 :         do jj=1,Qpt%lgth_segments(ii)
     662                 :        9244 :           iqpt=iqpt+1
     663                 :             :           Qpt%qpt_red (:,iqpt)=((jj-1)*Qpt%special_red (ii+1,:)+(Qpt%lgth_segments(ii)-jj+1)*Qpt%special_red (ii,:))&
     664         [ +  + ]:       36976 : &           /Qpt%lgth_segments(ii)
     665                 :             :           Qpt%qpt_cart(:,iqpt)=((jj-1)*Qpt%special_cart(ii+1,:)+(Qpt%lgth_segments(ii)-jj+1)*Qpt%special_cart(ii,:))&
     666         [ +  + ]:       37215 : &           /Qpt%lgth_segments(ii)
     667                 :             :         end do
     668                 :             :       end do
     669         [ +  + ]:         184 :       Qpt%qpt_red (:,nqpt)=Qpt%special_red (qpt_tot,:)
     670         [ +  + ]:         184 :       Qpt%qpt_cart(:,nqpt)=Qpt%special_cart(qpt_tot,:)
     671         [ #  # ]:           0 :     else if (qpt_tot.eq.1) then
     672                 :           0 :       nqpt=1
     673   [ #  #  #  #  :           0 :       ABI_MALLOC(Qpt%qpt_red ,(3,nqpt)); Qpt%qpt_red (:,:)=zero
             #  #  #  # ]
     674   [ #  #  #  #  :           0 :       ABI_MALLOC(Qpt%qpt_cart,(3,nqpt)); Qpt%qpt_cart(:,:)=zero
             #  #  #  # ]
     675         [ #  # ]:           0 :       Qpt%qpt_red (:,1)=Qpt%special_red (1,:)
     676         [ #  # ]:           0 :       Qpt%qpt_cart(:,1)=Qpt%special_cart(1,:)
     677                 :             :     end if !qpt_tot.gt.1
     678         [ +  - ]:          46 :     if (MPIdata%iam_master) then
     679                 :          46 :       write(40,*) '  In reduced coordinates:'
     680         [ +  + ]:         331 :       do ii=1,qpt_tot
     681                 :         331 :         write(40,'(a,1x,3(f10.5,1x))') Qpt%special_qpt(ii),Qpt%special_red(ii,1),Qpt%special_red(ii,2),Qpt%special_red(ii,3)
     682                 :             :       end do
     683                 :          46 :       write(40,*) ' '
     684                 :          46 :       write(40,*) '  In cartesian coordinates:'
     685         [ +  + ]:         331 :       do ii=1,qpt_tot
     686                 :         331 :         write(40,'(a,1x,3(f10.5,1x))') Qpt%special_qpt(ii),Qpt%special_cart(ii,1),Qpt%special_cart(ii,2),Qpt%special_cart(ii,3)
     687                 :             :       end do
     688                 :          46 :       write(40,*) ' '
     689                 :          46 :       write(40,*) '  Using gprimt='
     690                 :          46 :       write(40,'(3(f10.5,1x))') Lattice%gprimt(1,1),Lattice%gprimt(1,2),Lattice%gprimt(1,3)
     691                 :          46 :       write(40,'(3(f10.5,1x))') Lattice%gprimt(2,1),Lattice%gprimt(2,2),Lattice%gprimt(2,3)
     692                 :          46 :       write(40,'(3(f10.5,1x))') Lattice%gprimt(3,1),Lattice%gprimt(3,2),Lattice%gprimt(3,3)
     693                 :          46 :       write(40,*) ' '
     694                 :          46 :       write(40,*) '  The number of points along each direction in the BZ='
     695         [ +  - ]:          46 :       if (qpt_tot.gt.1) then
     696         [ +  + ]:         285 :         do ii=1,qpt_tot-1
     697                 :         285 :           write(40,'(a2,a,a2,1x,i4)') Qpt%special_qpt(ii),'-',Qpt%special_qpt(ii+1),Qpt%lgth_segments(ii)
     698                 :             :         end do
     699                 :             :       end if
     700                 :             :     end if
     701                 :             : 
     702                 :             :   else
     703                 :           0 :     write(ab_out,*) 'The Q points path is defined in the input file'
     704         [ #  # ]:           0 :     if (MPIdata%iam_master) write(40,*)           'The Q points path is defined in the input file'
     705                 :           0 :     nqpt=abs(Invar%bzpath)
     706   [ #  #  #  #  :           0 :     ABI_MALLOC(Qpt%qpt_red ,(3,nqpt)); Qpt%qpt_red (:,:)=zero
          #  #  #  #  #  
          #  #  #  #  #  
                   #  # ]
     707   [ #  #  #  #  :           0 :     ABI_MALLOC(Qpt%qpt_cart,(3,nqpt)); Qpt%qpt_cart(:,:)=zero
          #  #  #  #  #  
             #  #  #  #  
                      # ]
     708   [ #  #  #  # ]:           0 :     Qpt%qpt_red(:,:)=Invar%qpt(:,:)
     709                 :           0 :     ABI_ERROR('The indices in the loop below are not consistent')
     710         [ #  # ]:           0 :     do ii=1,nqpt
     711         [ #  # ]:           0 :       do jj=1,3
     712         [ #  # ]:           0 :         do kk=1,3
     713         [ #  # ]:           0 :           if (Lattice%line==2) then
     714                 :           0 :             Qpt%qpt_cart(ii,jj)=Qpt%qpt_cart(ii,jj)+Lattice%gprimt(kk,jj)*Qpt%qpt_red(ii,kk)/Lattice%acell_unitcell(jj)
     715         [ #  # ]:           0 :           else if (Lattice%line==0.or.Lattice%line==1) then
     716                 :           0 :             Qpt%qpt_cart(ii,jj)=Qpt%qpt_cart(ii,jj)+Lattice%gprimt(kk,jj)*Qpt%qpt_red(ii,kk)/Lattice%acell_unitcell(kk)
     717                 :             :           end if
     718                 :             :         end do
     719                 :             :       end do
     720                 :             :     end do
     721                 :             :   end if  !BZpath>=0
     722                 :             : 
     723                 :             : ! Write the q-points along the path defined in the BZ, in the qpt.dat file
     724         [ +  - ]:          46 :   if (MPIdata%iam_master) then
     725                 :          46 :     write(40,*) ' '
     726                 :          46 :     write(40,*) '  Q-points path (in reduced coordinates) and (in cartesian coordinates)='
     727         [ +  + ]:        9336 :     do  iqpt=1,nqpt
     728                 :        9290 :       write(40,'(i4,1x,6(f10.5,1x))') iqpt,Qpt%qpt_red(1,iqpt),Qpt%qpt_red(2,iqpt),Qpt%qpt_red(3,iqpt),&
     729                 :       18626 : &       Qpt%qpt_cart(1,iqpt),Qpt%qpt_cart(2,iqpt),Qpt%qpt_cart(3,iqpt)
     730                 :             :     end do
     731                 :          46 :     close(40)
     732                 :             :   end if
     733                 :          46 :   Qpt%nqpt=nqpt
     734         [ -  + ]:          46 :   ABI_FREE(QptBound)
     735                 :          46 :  end subroutine tdep_make_qptpath
     736                 :             : !!***
     737                 :             : !=====================================================================================================
     738                 :             : 
     739                 :             : !!****f* ABINIT/m_tdep_qpt/tdep_destroy_qpt
     740                 :             : !! NAME
     741                 :             : !!  tdep_destroy_qpt
     742                 :             : !!
     743                 :             : !! FUNCTION
     744                 :             : !!  Free the memory allocated in the Qpoints object.
     745                 :             : !!
     746                 :             : !! SIDE EFFECTS
     747                 :             : !!  Qpt = Qpoints object. All its allocated arrays are deallocated.
     748                 :             : !!
     749                 :             : !! SOURCE
     750                 :             : 
     751                 :          46 :  subroutine tdep_destroy_qpt(Qpt)
     752                 :             : 
     753                 :             :   class(Qpoints_type),intent(inout) :: Qpt
     754                 :             : 
     755         [ -  + ]:          46 :   ABI_FREE(Qpt%special_qpt)
     756         [ -  + ]:          46 :   ABI_FREE(Qpt%special_red)
     757         [ -  + ]:          46 :   ABI_FREE(Qpt%special_cart)
     758         [ -  + ]:          46 :   ABI_FREE(Qpt%lgth_segments)
     759         [ -  + ]:          46 :   ABI_FREE(Qpt%qpt_red)
     760         [ -  + ]:          46 :   ABI_FREE(Qpt%qpt_cart)
     761                 :             : 
     762                 :          46 :  end subroutine tdep_destroy_qpt
     763                 :             : !!***
     764                 :             : !=====================================================================================================
     765                 :             : 
     766                 :             : !!****f* ABINIT/m_tdep_qpt/tdep_destroy_qbz
     767                 :             : !! NAME
     768                 :             : !!  tdep_destroy_qbz
     769                 :             : !!
     770                 :             : !! FUNCTION
     771                 :             : !!  Free the memory allocated in the Qbz object.
     772                 :             : !!
     773                 :             : !! SIDE EFFECTS
     774                 :             : !!  Qbz = Qbz object. All its allocated arrays are deallocated.
     775                 :             : !!
     776                 :             : !! SOURCE
     777                 :             : 
     778                 :          46 :  subroutine tdep_destroy_qbz(Qbz)
     779                 :             : 
     780                 :             :   class(Qbz_type),intent(inout) :: Qbz
     781                 :             : 
     782         [ -  + ]:          46 :   ABI_FREE(Qbz%qbz)
     783         [ -  + ]:          46 :   ABI_FREE(Qbz%qbz_cart)
     784         [ -  + ]:          46 :   ABI_FREE(Qbz%ibz2bz)
     785         [ -  + ]:          46 :   ABI_FREE(Qbz%wtq)
     786         [ -  + ]:          46 :   ABI_FREE(Qbz%wtqibz)
     787         [ -  + ]:          46 :   ABI_FREE(Qbz%qibz)
     788         [ -  + ]:          46 :   ABI_FREE(Qbz%qibz_cart)
     789                 :             : 
     790                 :          46 :  end subroutine tdep_destroy_qbz
     791                 :             : !!***
     792                 :             : 
     793                 :             : !=====================================================================================================
     794                 :             : 
     795   [ #  #  #  #  :           0 : end module m_tdep_qpt
          #  #  #  #  #  
          #  #  #  #  #  
          #  #  #  #  #  
          #  #  #  #  #  
                   #  # ]
     796                 :             : !!***
        

Generated by: LCOV version 2.3-1