TABLE OF CONTENTS


ABINIT/m_ebands [ Modules ]

[ Top ] [ Modules ]

NAME

  m_ebands

FUNCTION

  This module contains utilities to analyze and retrieve information from the ebands_t.

COPYRIGHT

 Copyright (C) 2008-2018 ABINIT group (MG, MJV, BXu)
 This file is distributed under the terms of the
 GNU General Public License, see ~abinit/COPYING
 or http://www.gnu.org/copyleft/gpl.txt .

PARENTS

TODO

 1) Remove npwarr, istwfk.
 2) Use 3d arrays for ebands%nband
 3) Solve issue with Hdr dependency

CHILDREN

SOURCE

 26 #if defined HAVE_CONFIG_H
 27 #include "config.h"
 28 #endif
 29 
 30 #include "abi_common.h"
 31 
 32 MODULE m_ebands
 33 
 34  use defs_basis
 35  use m_errors
 36  use m_abicore
 37  use m_xmpi
 38  use m_tetrahedron
 39  use m_bspline
 40  use m_nctk
 41 #ifdef HAVE_NETCDF
 42  use netcdf
 43 #endif
 44  use m_hdr
 45  use m_kptrank
 46  use m_skw
 47  use m_kpts
 48 
 49  use defs_datatypes,   only : ebands_t
 50  use defs_abitypes,    only : hdr_type, dataset_type
 51  use m_copy,           only : alloc_copy
 52  use m_io_tools,       only : file_exists, open_file
 53  use m_fstrings,       only : tolower, itoa, sjoin, ftoa, ltoa, ktoa, strcat, basename, replace
 54  use m_numeric_tools,  only : arth, imin_loc, imax_loc, bisect, stats_t, stats_eval, simpson_int, wrap2_zero_one,&
 55                               isdiagmat, isinside
 56  use m_special_funcs,  only : dirac_delta
 57  use m_geometry,       only : normv
 58  use m_cgtools,        only : set_istwfk
 59  use m_pptools,        only : printbxsf
 60  use m_occ,            only : getnel, newocc
 61  use m_nesting,        only : mknesting
 62  use m_crystal,        only : crystal_t
 63  use m_bz_mesh,        only : isamek, kpath_t, kpath_new, kpath_free, kpath_print
 64  use m_fftcore,        only : get_kg
 65 
 66  implicit none
 67 
 68  private
 69 
 70  public :: ebands_init             ! Main creation method.
 71  public :: ebands_from_hdr         ! Init object from the abinit header.
 72  public :: ebands_from_dtset       ! Init object from the abinit dataset.
 73  public :: ebands_free             ! Destruction method.
 74  public :: ebands_copy             ! Deep copy of the ebands_t.
 75  public :: ebands_print            ! Printout basic info on the data type.
 76  public :: unpack_eneocc           ! Helper function for reshaping (energies|occupancies|derivate of occupancies).
 77  public :: pack_eneocc             ! Helper function for reshaping (energies|occupancies|derivate of occupancies).
 78  public :: get_eneocc_vect         ! Reshape (ene|occ|docdde) returning a matrix instead of a vector.
 79  public :: put_eneocc_vect         ! Put (ene|occ|doccde) in vectorial form into the data type doing a reshape.
 80  public :: get_bandenergy          ! Returns the band energy of the system.
 81  public :: get_valence_idx         ! Gives the index of the (valence|bands at E_f).
 82  public :: apply_scissor           ! Apply a scissor operator (no k-dependency)
 83  public :: get_occupied            ! Returns band indeces after wich occupations are less than an input value.
 84  public :: enclose_degbands        ! Adjust band indeces such that all degenerate states are treated.
 85  public :: ebands_get_erange       ! Compute the minimum and maximum energy enclosing a list of states.
 86  public :: ebands_nelect_per_spin  ! Returns number of electrons per spin channel
 87  public :: get_minmax              ! Returns min and Max value of (eig|occ|doccde).
 88  public :: ebands_edstats          ! Compute statistical parameters of the energy differences e_ks[b+1] - e_ks[b]
 89  public :: ebands_has_metal_scheme ! .True. if metallic occupation scheme is used.
 90  public :: ebands_write_bxsf       ! Write 3D energies for Fermi surface visualization (XSF format)
 91  public :: ebands_update_occ       ! Update the occupation numbers.
 92  public :: ebands_set_scheme       ! Set the occupation scheme.
 93  public :: ebands_set_fermie       ! Change the fermi level (assume metallic scheme).
 94  public :: ebands_set_nelect       ! Change the number of electrons (assume metallic scheme).
 95  public :: ebands_report_gap       ! Print info on the fundamental and optical gap.
 96  public :: ebands_ncwrite          ! Dump the object into NETCDF file (use ncid)
 97  public :: ebands_ncwrite_path     ! Dump the object into NETCDF file (use filepath)
 98  public :: ebands_write_nesting    ! Calculate the nesting function and output data to file.
 99  public :: ebands_expandk          ! Build a new ebands_t in the full BZ.
100  public :: ebands_get_jdos         ! Compute the joint density of states.
101  public :: ebands_interp_kmesh     ! Interpolate energies on a k-mesh.
102  public :: ebands_interp_kpath     ! Interpolate energies on a k-path.
103  public :: ebands_interpolate_kpath
104 
105  public :: ebands_prtbltztrp          ! Output files for BoltzTraP code.
106  public :: ebands_prtbltztrp_tau_out  ! Output files for BoltzTraP code,
107  public :: ebands_write               ! Driver routine to write bands in different (txt) formats.

m_ebands/apply_scissor [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

  apply_scissor

FUNCTION

  Apply a scissor operator of amplitude scissor_energy.

INPUTS

  scissor_energy=The energy shift

OUTPUT

 SIDE EFFECT
  ebands<ebands_t>=The following quantities are modified:
   %eig(mband,nkpt,nsppol)=The band structure after the application of the scissor operator
   %fermi_energy

PARENTS

      screening,setup_bse,setup_bse_interp

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

1538 subroutine apply_scissor(ebands,scissor_energy)
1539 
1540 
1541 !This section has been created automatically by the script Abilint (TD).
1542 !Do not modify the following lines by hand.
1543 #undef ABI_FUNC
1544 #define ABI_FUNC 'apply_scissor'
1545 !End of the abilint section
1546 
1547  implicit none
1548 
1549 !Arguments ------------------------------------
1550 !scalars
1551  real(dp),intent(in) :: scissor_energy
1552  type(ebands_t),intent(inout) :: ebands
1553 
1554 !Local variables-------------------------------
1555  integer :: ikpt,spin,ival,nband_k
1556  real(dp) :: spinmagntarget_
1557  character(len=500) :: msg
1558 !arrays
1559  integer :: val_idx(ebands%nkpt,ebands%nsppol)
1560 ! *************************************************************************
1561 
1562  ! === Get the valence band index for each k and spin ===
1563  val_idx(:,:) = get_valence_idx(ebands)
1564 
1565  do spin=1,ebands%nsppol
1566    if (ANY(val_idx(:,spin)/=val_idx(1,spin))) then
1567      write(msg,'(a,i0,a)')&
1568       'Trying to apply a scissor operator on a metallic band structure for spin: ',spin,&
1569       'Assuming you know what you are doing, continuing anyway! '
1570      MSG_COMMENT(msg)
1571      !Likely newocc will stop, unless the system is semimetallic ?
1572    end if
1573  end do
1574 
1575  ! === Apply the scissor ===
1576  do spin=1,ebands%nsppol
1577    do ikpt=1,ebands%nkpt
1578      nband_k=ebands%nband(ikpt+(spin-1)*ebands%nkpt)
1579      ival=val_idx(ikpt,spin)
1580 
1581      if (nband_k>=ival+1) then
1582        ebands%eig(ival+1:,ikpt,spin) = ebands%eig(ival+1:,ikpt,spin)+scissor_energy
1583      else
1584        write(msg,'(2a,4(a,i0))')&
1585         'Not enough bands to apply the scissor operator. ',ch10,&
1586         'spin= ',spin,' ikpt= ',ikpt,' nband_k= ',nband_k,' but valence index= ',ival
1587        MSG_COMMENT(msg)
1588      end if
1589 
1590    end do
1591  end do
1592 
1593  ! === Recalculate the fermi level and occ. factors ===
1594  ! * For Semiconductors only the Fermi level is changed (in the middle of the new gap)
1595  spinmagntarget_=-99.99_dp !?; if (PRESENT(spinmagntarget)) spinmagntarget_=spinmagntarget
1596  call ebands_update_occ(ebands,spinmagntarget_)
1597 
1598 end subroutine apply_scissor

m_ebands/ebands_copy [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

  ebands_copy

FUNCTION

 This subroutine performs a deep copy of a ebands_t datatype.
 All the associated pointers in the input object will be copied preserving the shape.
 If a pointer in ibands happens to be not associated, the corresponding
 pointer in the copied object will be nullified.

INPUTS

  ibands<ebands_t>=The data type to be copied.

OUTPUT

  obands<ebands_t>=The copy.

PARENTS

      m_exc_spectra,m_haydock,m_sigmaph,optic,screening,setup_bse
      setup_bse_interp,sigma

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

934 subroutine ebands_copy(ibands,obands)
935 
936 
937 !This section has been created automatically by the script Abilint (TD).
938 !Do not modify the following lines by hand.
939 #undef ABI_FUNC
940 #define ABI_FUNC 'ebands_copy'
941 !End of the abilint section
942 
943  implicit none
944 
945 !Arguments ------------------------------------
946 !scalars
947  type(ebands_t),intent(in)  :: ibands
948  type(ebands_t),intent(out) :: obands
949 
950 ! *********************************************************************
951 
952  ! Copy scalars
953  obands%bantot  = ibands%bantot
954  obands%mband   = ibands%mband
955  obands%nkpt    = ibands%nkpt
956  obands%nspinor = ibands%nspinor
957  obands%nsppol  = ibands%nsppol
958  obands%occopt  = ibands%occopt
959  obands%kptopt  = ibands%kptopt
960  obands%nshiftk_orig = ibands%nshiftk_orig
961  obands%nshiftk     = ibands%nshiftk
962 
963  obands%charge  = ibands%charge
964  obands%entropy = ibands%entropy
965  obands%fermie  = ibands%fermie
966  obands%nelect  = ibands%nelect
967  obands%tphysel = ibands%tphysel
968  obands%tsmear  = ibands%tsmear
969 
970  obands%kptrlatt_orig = ibands%kptrlatt_orig
971  obands%kptrlatt = ibands%kptrlatt
972 
973  ! Copy allocatable arrays
974  ! integer
975  call alloc_copy(ibands%istwfk, obands%istwfk)
976  call alloc_copy(ibands%nband , obands%nband )
977  call alloc_copy(ibands%npwarr, obands%npwarr)
978 
979  ! real
980  call alloc_copy(ibands%kptns , obands%kptns )
981  call alloc_copy(ibands%eig   , obands%eig   )
982  call alloc_copy(ibands%occ   , obands%occ   )
983  call alloc_copy(ibands%doccde, obands%doccde)
984  call alloc_copy(ibands%wtk   , obands%wtk   )
985  call alloc_copy(ibands%shiftk_orig, obands%shiftk_orig)
986  call alloc_copy(ibands%shiftk, obands%shiftk)
987 
988  if(allocated(ibands%lifetime)) then
989    call alloc_copy(ibands%lifetime, obands%lifetime)
990  end if
991 
992 end subroutine ebands_copy

m_ebands/ebands_edstats [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_edstats

FUNCTION

  Compute statistical parameters of the energy differences e_ks[b+1] - e_ks[b]
  Returns stats_t record with the results (mean, stdev, min, max)

INPUTS

  ebands<ebands_t>=Band energies.

PARENTS

CHILDREN

SOURCE

2027 type(stats_t) function ebands_edstats(ebands) result(stats)
2028 
2029 
2030 !This section has been created automatically by the script Abilint (TD).
2031 !Do not modify the following lines by hand.
2032 #undef ABI_FUNC
2033 #define ABI_FUNC 'ebands_edstats'
2034 !End of the abilint section
2035 
2036  implicit none
2037 
2038 !Arguments ------------------------------------
2039 !scalars
2040  type(ebands_t),intent(in) :: ebands
2041 
2042 !Local variables-------------------------------
2043 !scalars
2044  integer :: ikibz,nband_k,spin
2045 !arrays
2046  real(dp),allocatable :: ediffs(:,:,:),edvec(:)
2047 
2048 ! *************************************************************************
2049 
2050  ! Compute energy difference between b+1 and b.
2051  ABI_CALLOC(ediffs, (ebands%mband-1,ebands%nkpt,ebands%nsppol))
2052 
2053  do spin=1,ebands%nsppol
2054    do ikibz=1,ebands%nkpt
2055      nband_k=ebands%nband(ikibz+(spin-1)*ebands%nkpt)
2056      if (nband_k > 1) then
2057        ediffs(1:nband_k-1,ikibz,spin) = ebands%eig(2:nband_k,ikibz,spin) - ebands%eig(1:nband_k-1,ikibz,spin)
2058      end if
2059    end do
2060  end do
2061 
2062  ! Calculate the statistical parameters
2063  ! Not completely correct if nband_k varies but ...
2064  ABI_MALLOC(edvec, ((ebands%mband-1)*ebands%nkpt*ebands%nsppol))
2065  edvec = reshape(ediffs, [(ebands%mband-1)*ebands%nkpt*ebands%nsppol])
2066 
2067  stats = stats_eval(edvec)
2068 
2069  ABI_FREE(ediffs)
2070  ABI_FREE(edvec)
2071 
2072 end function ebands_edstats

m_ebands/ebands_expandk [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_expandk

FUNCTION

  Return a new object of type ebands_t corresponding to a list of k-points
  specified in input. Symmetry properties of the eigenvectors are used to
  symmetrize energies and occupation numbers.

INPUTS

  inb<ebands_t>=Initial band structure with energies in the IBZ.
  ecut_eff=Effective cutoff energy i.e. ecut * dilatmx**2
  force_istwfk1=If True, istwfk if forced to 1 for all the k-points in the BZ.

OUTPUT

  dksqmax=maximal value of the norm**2 of the difference between
    a kpt in the BZ and the closest k-point found in the inb%kpts set, using symmetries.
  bz2ibz(nkpt2,6)=describe k point number of kpt1 that allows to
    generate wavefunctions closest to given kpt2
      bz2ibz(:,1)=k point number of kptns1
      bz2ibz(:,2)=symmetry operation to be applied to kpt1, to give kpt1a
        (if 0, means no symmetry operation, equivalent to identity )
      bz2ibz(:,3:5)=shift in reciprocal space to be given to kpt1a,
        to give kpt1b, that is the closest to kpt2.
      bz2ibz(:,6)=1 if time-reversal was used to generate kpt1a from kpt1, 0 otherwise
  outb<ebands_t>=band structure with energies in the BZ.

PARENTS

      m_wfk

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

3618 subroutine ebands_expandk(inb, cryst, ecut_eff, force_istwfk1, dksqmax, bz2ibz, outb)
3619 
3620 
3621 !This section has been created automatically by the script Abilint (TD).
3622 !Do not modify the following lines by hand.
3623 #undef ABI_FUNC
3624 #define ABI_FUNC 'ebands_expandk'
3625 !End of the abilint section
3626 
3627  implicit none
3628 
3629 !Arguments ------------------------------------
3630 !scalars
3631  real(dp),intent(in) :: ecut_eff
3632  real(dp),intent(out) :: dksqmax
3633  logical,intent(in) :: force_istwfk1
3634  type(ebands_t),intent(in) :: inb
3635  type(ebands_t),intent(out) :: outb
3636  type(crystal_t),intent(in) :: cryst
3637 !arrays
3638  integer,allocatable,intent(out) :: bz2ibz(:,:)
3639 
3640 !Local variables-------------------------------
3641 !scalars
3642  integer,parameter :: istwfk_1=1,kptopt3=3
3643  integer :: nkfull,timrev,bantot,sppoldbl,npw_k,nsppol,istw
3644  integer :: ik_ibz,ikf,isym,itimrev,spin,mband,my_nkibz
3645  logical :: isirred_k
3646  !character(len=500) :: msg
3647 !arrays
3648  integer :: g0(3)
3649  integer,allocatable :: istwfk(:),nband(:,:),npwarr(:),kg_k(:,:)
3650  real(dp),allocatable :: kfull(:,:),doccde(:),eig(:),occ(:),wtk(:),my_kibz(:,:)
3651  real(dp),allocatable :: doccde_3d(:,:,:),eig_3d(:,:,:),occ_3d(:,:,:)
3652 
3653 ! *********************************************************************
3654 
3655  ABI_CHECK(inb%kptopt /= 0, "ebands_expandk does not support kptopt == 0")
3656 
3657  nsppol = inb%nsppol
3658 
3659  ! Note kptopt=3
3660  call kpts_ibz_from_kptrlatt(cryst, inb%kptrlatt, kptopt3, inb%nshiftk, inb%shiftk, &
3661    my_nkibz, my_kibz, wtk, nkfull, kfull) ! new_kptrlatt, new_shiftk)
3662 
3663  ABI_FREE(my_kibz)
3664  ABI_FREE(wtk)
3665 
3666  ! Costruct full BZ and create mapping BZ --> IBZ
3667  ! Note:
3668  !   - we don't change the value of nsppol hence sppoldbl is set to 1
3669  !   - we use symrel so that bz2ibz can be used to reconstruct the wavefunctions.
3670  !
3671  sppoldbl = 1 !; if (any(cryst%symafm == -1) .and. inb%nsppol == 1) sppoldbl=2
3672  ABI_MALLOC(bz2ibz, (nkfull*sppoldbl,6))
3673 
3674  timrev = kpts_timrev_from_kptopt(inb%kptopt)
3675  call listkk(dksqmax,cryst%gmet,bz2ibz,inb%kptns,kfull,inb%nkpt,nkfull,cryst%nsym,&
3676    sppoldbl,cryst%symafm,cryst%symrel,timrev,use_symrec=.False.)
3677 
3678  ABI_MALLOC(wtk, (nkfull))
3679  wtk = one / nkfull ! weights normalized to one
3680 
3681  ABI_MALLOC(istwfk, (nkfull))
3682  ABI_MALLOC(nband, (nkfull, nsppol))
3683  ABI_MALLOC(npwarr, (nkfull))
3684 
3685  if (any(cryst%symrel(:,:,1) /= identity_3d) .and. any(abs(cryst%tnons(:,1)) > tol10) ) then
3686    MSG_ERROR('The first symmetry is not the identity operator!')
3687  end if
3688 
3689  do ikf=1,nkfull
3690    ik_ibz = bz2ibz(ikf,1)
3691    isym = bz2ibz(ikf,2)
3692    itimrev = bz2ibz(ikf,6)
3693    g0 = bz2ibz(ikf,3:5)        ! IS(k_ibz) + g0 = k_bz
3694    isirred_k = (isym == 1 .and. itimrev == 0 .and. all(g0 == 0))
3695 
3696    do spin=1,nsppol
3697      nband(ikf,spin) = inb%nband(ik_ibz+(spin-1)*inb%nkpt)
3698    end do
3699 
3700    if (force_istwfk1) then
3701      call get_kg(kfull(:,ikf),istwfk_1,ecut_eff,cryst%gmet,npw_k,kg_k)
3702      ABI_FREE(kg_k)
3703      istwfk(ikf) = 1
3704      npwarr(ikf) = npw_k
3705    else
3706      if (isirred_k) then
3707        istwfk(ikf) = inb%istwfk(ik_ibz)
3708        npwarr(ikf) = inb%npwarr(ik_ibz)
3709      else
3710        istw = set_istwfk(kfull(:,ikf))
3711        call get_kg(kfull(:,ikf),istw,ecut_eff,cryst%gmet,npw_k,kg_k)
3712        ABI_FREE(kg_k)
3713        istwfk(ikf) = istw
3714        npwarr(ikf) = npw_k
3715      end if
3716    end if
3717  end do
3718 
3719  ! Recostruct eig, occ and doccde in the BZ.
3720  bantot = sum(nband); mband = maxval(nband)
3721 
3722  ABI_MALLOC(doccde_3d, (mband, nkfull, nsppol))
3723  ABI_MALLOC(eig_3d, (mband, nkfull, nsppol))
3724  ABI_MALLOC(occ_3d, (mband, nkfull, nsppol))
3725 
3726  do spin=1,nsppol
3727    do ikf=1,nkfull
3728      ik_ibz = bz2ibz(ikf,1)
3729      doccde_3d(:,ikf,spin) = inb%doccde(:,ik_ibz,spin)
3730      eig_3d(:,ikf,spin) = inb%eig   (:,ik_ibz,spin)
3731      occ_3d(:,ikf,spin) = inb%occ   (:,ik_ibz,spin)
3732    end do
3733  end do
3734 
3735  ! Have to pack data to call ebands_init (I wonder who decided to use vectors!)
3736  ABI_MALLOC(doccde, (bantot))
3737  ABI_MALLOC(eig, (bantot))
3738  ABI_MALLOC(occ, (bantot))
3739 
3740  call pack_eneocc(nkfull,nsppol,mband,nband,bantot,doccde_3d,doccde)
3741  call pack_eneocc(nkfull,nsppol,mband,nband,bantot,eig_3d,eig)
3742  call pack_eneocc(nkfull,nsppol,mband,nband,bantot,occ_3d,occ)
3743 
3744  ABI_FREE(doccde_3d)
3745  ABI_FREE(eig_3d)
3746  ABI_FREE(occ_3d)
3747 
3748  call ebands_init(bantot,outb,inb%nelect,doccde,eig,istwfk,kfull,&
3749    nband,nkfull,npwarr,nsppol,inb%nspinor,inb%tphysel,inb%tsmear,inb%occopt,occ,wtk,&
3750    inb%charge, kptopt3, inb%kptrlatt_orig, inb%nshiftk_orig, inb%shiftk_orig, inb%kptrlatt, inb%nshiftk, inb%shiftk)
3751 
3752  ABI_FREE(istwfk)
3753  ABI_FREE(nband)
3754  ABI_FREE(npwarr)
3755  ABI_FREE(doccde)
3756  ABI_FREE(eig)
3757  ABI_FREE(occ)
3758  ABI_FREE(wtk)
3759  ABI_FREE(kfull)
3760 
3761 end subroutine ebands_expandk

m_ebands/ebands_free [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_free

FUNCTION

 Deallocates the components of the ebands_t structured datatype

INPUTS

  ebands<ebands_t>=The data type to be deallocated.

OUTPUT

  Deallocate the dynamic arrays in the ebands_t type.
  (only deallocate)

PARENTS

      bethe_salpeter,dfpt_looppert,eig2tot,elphon,eph,fold2Bloch,gstate
      m_ebands,m_exc_spectra,m_haydock,m_ioarr,m_iowf,m_shirley,m_sigmaph
      m_wfk,mlwfovlp_qp,nonlinear,optic,outscfcv,respfn,screening,sigma
      wfk_analyze

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

849 subroutine ebands_free(ebands)
850 
851 
852 !This section has been created automatically by the script Abilint (TD).
853 !Do not modify the following lines by hand.
854 #undef ABI_FUNC
855 #define ABI_FUNC 'ebands_free'
856 !End of the abilint section
857 
858  implicit none
859 
860 !Arguments ------------------------------------
861 !scalars
862  type(ebands_t),intent(inout) :: ebands
863 ! *************************************************************************
864 
865  DBG_ENTER("COLL")
866 
867  if (allocated(ebands%istwfk)) then
868    ABI_FREE(ebands%istwfk)
869  end if
870  if (allocated(ebands%nband)) then
871    ABI_FREE(ebands%nband)
872  end if
873  if (allocated(ebands%npwarr)) then
874    ABI_FREE(ebands%npwarr)
875  end if
876  if (allocated(ebands%kptns)) then
877    ABI_FREE(ebands%kptns)
878  end if
879  if (allocated(ebands%eig)) then
880    ABI_FREE(ebands%eig)
881  end if
882  if (allocated(ebands%lifetime)) then
883    ABI_FREE(ebands%lifetime)
884  end if
885  if (allocated(ebands%occ)) then
886    ABI_FREE(ebands%occ)
887  end if
888  if (allocated(ebands%doccde)) then
889    ABI_FREE(ebands%doccde)
890  end if
891  if (allocated(ebands%wtk)) then
892    ABI_FREE(ebands%wtk)
893  end if
894 
895  if (allocated(ebands%shiftk_orig)) then
896    ABI_FREE(ebands%shiftk_orig)
897  end if
898  if (allocated(ebands%shiftk)) then
899    ABI_FREE(ebands%shiftk)
900  end if
901 
902  DBG_EXIT("COLL")
903 
904 end subroutine ebands_free

m_ebands/ebands_from_dtset [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_from_dtset

FUNCTION

 Build and return a new ebands_t datatype. Dimensions are taken from the abinit dataset.

INPUTS

  dtset<dataset_type>=Abinit dataset
  npwarr(dtset%nkpt)=Number of G-vectors for each k-point.

OUTPUT

  ebands<ebands_t>=The ebands_t datatype completely initialized.
    The Fermi level and the entropy are set to zero.

PARENTS

CHILDREN

SOURCE

780 type(ebands_t) function ebands_from_dtset(dtset, npwarr) result(new)
781 
782 
783 !This section has been created automatically by the script Abilint (TD).
784 !Do not modify the following lines by hand.
785 #undef ABI_FUNC
786 #define ABI_FUNC 'ebands_from_dtset'
787 !End of the abilint section
788 
789  implicit none
790 
791 !Arguments ------------------------------------
792 !scalars
793  type(dataset_type),intent(in) :: dtset
794 !arrays
795  integer,intent(in) :: npwarr(dtset%nkpt)
796 
797 !Local variables-------------------------------
798 !scalars
799  integer :: bantot
800 !arrays
801  real(dp),allocatable :: ugly_doccde(:),ugly_ene(:),ugly_occ(:)
802 ! *************************************************************************
803 
804  ! Have to use ugly 1d vectors to call ebands_init
805  bantot = sum(dtset%nband)
806  ABI_CALLOC(ugly_doccde, (bantot))
807  ABI_CALLOC(ugly_ene, (bantot))
808  ABI_CALLOC(ugly_occ, (bantot))
809 
810  call ebands_init(bantot,new,dtset%nelect,ugly_doccde,ugly_ene,dtset%istwfk,dtset%kptns,dtset%nband,dtset%nkpt,&
811   npwarr,dtset%nsppol,dtset%nspinor,dtset%tphysel,dtset%tsmear,dtset%occopt,ugly_occ,dtset%wtk,&
812   dtset%charge, dtset%kptopt, dtset%kptrlatt_orig, dtset%nshiftk_orig, dtset%shiftk_orig, &
813   dtset%kptrlatt, dtset%nshiftk, dtset%shiftk)
814 
815  ABI_FREE(ugly_doccde)
816  ABI_FREE(ugly_ene)
817  ABI_FREE(ugly_occ)
818 
819 end function ebands_from_dtset

m_ebands/ebands_from_hdr [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_from_hdr

FUNCTION

 This subroutine initializes the ebands_t datatype from the abinit header by
 calling the main creation method.

INPUTS

  Hdr<hdr_type>=Abinit header.
  mband=Maximum number of bands.
  ene3d(mband,Hdr%nkpt,Hdr%nsppol)=Energies.
  [nelect]=Number of electrons per unit cell.
    Optional argument that can be used for performing a ridid shift of the fermi level.
    in the case of metallic occupancies.
    If not specified, nelect will be initialized from Hdr.

OUTPUT

  ebands<ebands_t>=The ebands_t datatype completely initialized.

PARENTS

      elphon,eph,m_iowf,m_wfk,wfk_analyze

CHILDREN

      destroy_tetra,get_full_kgrid,init_tetra,matr3inv,tetra_blochl_weights
      xmpi_sum

SOURCE

710 type(ebands_t) function ebands_from_hdr(hdr, mband, ene3d, nelect) result(ebands)
711 
712 
713 !This section has been created automatically by the script Abilint (TD).
714 !Do not modify the following lines by hand.
715 #undef ABI_FUNC
716 #define ABI_FUNC 'ebands_from_hdr'
717 !End of the abilint section
718 
719  implicit none
720 
721 !Arguments ------------------------------------
722 !scalars
723  integer,intent(in) :: mband
724  type(hdr_type),intent(in) :: hdr
725  real(dp),optional,intent(in) :: nelect
726 !arrays
727  real(dp),intent(in) :: ene3d(mband,hdr%nkpt,hdr%nsppol)
728 
729 !Local variables-------------------------------
730 !scalars
731  real(dp) :: my_nelect
732 !arrays
733  real(dp),allocatable :: ugly_doccde(:),ugly_ene(:)
734 ! *************************************************************************
735 
736  my_nelect = hdr%nelect; if (present(nelect)) my_nelect = nelect
737 
738  ! Have to use ugly 1d vectors to call ebands_init
739  ABI_CALLOC(ugly_doccde, (hdr%bantot))
740  ABI_MALLOC(ugly_ene,(hdr%bantot))
741 
742  call pack_eneocc(hdr%nkpt,hdr%nsppol,mband,hdr%nband,hdr%bantot,ene3d,ugly_ene)
743 
744  call ebands_init(hdr%bantot,ebands,my_nelect,ugly_doccde,ugly_ene,hdr%istwfk,hdr%kptns,hdr%nband,hdr%nkpt,&
745 &  hdr%npwarr,hdr%nsppol,hdr%nspinor,hdr%tphysel,hdr%tsmear,hdr%occopt,hdr%occ,hdr%wtk,&
746 &  hdr%charge, hdr%kptopt, hdr%kptrlatt_orig, hdr%nshiftk_orig, hdr%shiftk_orig, hdr%kptrlatt, hdr%nshiftk, hdr%shiftk)
747 
748  ! Copy the fermi level reported in the header
749  ebands%fermie = hdr%fermie
750 
751  ABI_FREE(ugly_doccde)
752  ABI_FREE(ugly_ene)
753 
754 end function ebands_from_hdr

m_ebands/ebands_get_edos [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

  ebands_get_edos

FUNCTION

  Calculate the electronic density of states from ebands_t

INPUTS

  ebands<ebands_t>=Band structure object.
  cryst<cryst_t>=Info on the crystalline structure.
  intmeth= 1 for gaussian, 2 or 3 for tetrahedrons (3 if Blochl corrections must be included).
  step=Step on the linear mesh in Ha. If <0, the routine will use the mean of the energy level spacing
  broad=Gaussian broadening, If <0, the routine will use a default
    value for the broadening computed from the mean of the energy level spacing.
    No meaning for tetrahedrons
  comm=MPI communicator

OUTPUT

  edos<edos_t>=Electronic DOS and IDOS.

PARENTS

      eph

CHILDREN

      destroy_tetra,get_full_kgrid,init_tetra,matr3inv,tetra_blochl_weights
      xmpi_sum

SOURCE

3032 type(edos_t) function ebands_get_edos(ebands,cryst,intmeth,step,broad,comm) result(edos)
3033 
3034 
3035 !This section has been created automatically by the script Abilint (TD).
3036 !Do not modify the following lines by hand.
3037 #undef ABI_FUNC
3038 #define ABI_FUNC 'ebands_get_edos'
3039 !End of the abilint section
3040 
3041  implicit none
3042 
3043 !Arguments ------------------------------------
3044 !scalars
3045  integer,intent(in) :: intmeth,comm
3046  real(dp),intent(in) :: step,broad
3047  type(ebands_t),target,intent(in)  :: ebands
3048  type(crystal_t),intent(in) :: cryst
3049 
3050 !Local variables-------------------------------
3051 !scalars
3052  integer :: nw,spin,band,ikpt,ief,nproc,my_rank,mpierr,cnt,ierr,bcorr
3053  real(dp) :: max_ene,min_ene,wtk,max_occ
3054  character(len=500) :: msg
3055  type(stats_t) :: ediffs
3056  type(t_tetrahedron) :: tetra
3057 !arrays
3058  real(dp) :: eminmax_spin(2,ebands%nsppol)
3059  real(dp),allocatable :: wme0(:),wdt(:,:),tmp_eigen(:)
3060 
3061 ! *********************************************************************
3062 
3063  nproc = xmpi_comm_size(comm); my_rank = xmpi_comm_rank(comm)
3064  ierr = 0
3065 
3066  edos%nkibz = ebands%nkpt; edos%intmeth = intmeth; edos%nsppol = ebands%nsppol
3067 
3068  edos%broad = broad; edos%step = step
3069  if (broad <= tol16 .or. step <= tol16) then
3070    ! Compute the mean value of the energy spacing.
3071    ediffs = ebands_edstats(ebands)
3072    if (edos%broad <= tol16) edos%broad = ediffs%mean
3073    if (edos%step <= tol16) edos%step = 0.1 * ediffs%mean
3074  end if
3075 
3076  ! Compute the linear mesh so that it encloses all bands.
3077  eminmax_spin = get_minmax(ebands, "eig")
3078  min_ene = minval(eminmax_spin(1,:)); min_ene = min_ene - 0.1_dp * abs(min_ene)
3079  max_ene = maxval(eminmax_spin(2,:)); max_ene = max_ene + 0.1_dp * abs(max_ene)
3080 
3081  nw = nint((max_ene - min_ene)/edos%step) + 1; edos%nw = nw
3082 
3083  ABI_MALLOC(edos%mesh, (nw))
3084  edos%mesh = arth(min_ene, edos%step, nw)
3085 
3086  ABI_CALLOC(edos%gef, (0:edos%nsppol))
3087  ABI_CALLOC(edos%dos,  (nw, 0:edos%nsppol))
3088  ABI_CALLOC(edos%idos, (nw, 0:edos%nsppol))
3089 
3090  select case (intmeth)
3091  case (1)
3092    ! Gaussian
3093    ABI_MALLOC(wme0, (nw))
3094    cnt = 0
3095    do spin=1,edos%nsppol
3096      do ikpt=1,ebands%nkpt
3097        cnt = cnt + 1; if (mod(cnt, nproc) /= my_rank) cycle
3098        wtk = ebands%wtk(ikpt)
3099        do band=1,ebands%nband(ikpt+(spin-1)*ebands%nkpt)
3100           wme0 = edos%mesh - ebands%eig(band, ikpt, spin)
3101           edos%dos(:, spin) = edos%dos(:, spin) + wtk * dirac_delta(wme0, edos%broad)
3102        end do
3103      end do
3104    end do
3105    ABI_FREE(wme0)
3106    call xmpi_sum(edos%dos, comm, mpierr)
3107 
3108  case (2, 3)
3109    ! Consistency test
3110    if (any(ebands%nband /= ebands%nband(1)) ) MSG_ERROR('for tetrahedrons, nband(:) must be constant')
3111 
3112    ! Build tetra object.
3113    tetra = tetra_from_kptrlatt(cryst, ebands%kptopt, ebands%kptrlatt, &
3114      ebands%nshiftk, ebands%shiftk, ebands%nkpt, ebands%kptns, msg, ierr)
3115    if (ierr /= 0) MSG_ERROR(msg)
3116 
3117    ! For each spin and band, interpolate over kpoints,
3118    ! calculate integration weights and DOS contribution.
3119    ABI_MALLOC(tmp_eigen, (ebands%nkpt))
3120    ABI_MALLOC(wdt, (nw, 2))
3121 
3122    bcorr = 0; if (intmeth == 3) bcorr = 1
3123    cnt = 0
3124    do spin=1,ebands%nsppol
3125      do band=1,ebands%nband(1)
3126        ! For each band get its contribution
3127        tmp_eigen = ebands%eig(band,:,spin)
3128        do ikpt=1,ebands%nkpt
3129          cnt = cnt + 1; if (mod(cnt, nproc) /= my_rank) cycle ! mpi parallelism.
3130 
3131          ! Calculate integration weights at each irred k-point (Blochl et al PRB 49 16223 [[cite:Bloechl1994a]])
3132          call tetra_get_onewk(tetra, ikpt, bcorr, nw, ebands%nkpt, tmp_eigen, min_ene, max_ene, one, wdt)
3133 
3134          edos%dos(:,spin) = edos%dos(:,spin) + wdt(:, 1)
3135          ! IDOS is computed afterwards with simpson
3136          !edos%idos(:,spin) = edos%idos(:,spin) + wdt(:, 2)
3137        end do ! ikpt
3138      end do ! band
3139    end do ! spin
3140 
3141    call xmpi_sum(edos%dos, comm, mpierr)
3142 
3143    ! Free memory
3144    ABI_FREE(tmp_eigen)
3145    ABI_FREE(wdt)
3146    call destroy_tetra(tetra)
3147 
3148    ! Filter so that dos[i] is always >= 0 and idos is monotonic
3149    ! IDOS is computed afterwards with simpson
3150    where (edos%dos(:,1:) <= zero)
3151      edos%dos(:,1:) = zero
3152    end where
3153 
3154  case default
3155    MSG_ERROR(sjoin("Wrong integration method:", itoa(intmeth)))
3156  end select
3157 
3158  ! Compute total DOS and IDOS
3159  max_occ = two/(ebands%nspinor*ebands%nsppol)
3160  edos%dos(:, 0) = max_occ * sum(edos%dos(:,1:), dim=2)
3161 
3162  do spin=1,edos%nsppol
3163    call simpson_int(nw,edos%step,edos%dos(:,spin),edos%idos(:,spin))
3164  end do
3165  edos%idos(:, 0) = max_occ * sum(edos%idos(:,1:), dim=2)
3166 
3167  ! Use bisection to find fermi level.
3168  ! Warning: this code assumes idos[i+1] >= idos[i]. This condition may not be
3169  ! fullfilled if we use tetra and this is the reason why we have filtered the DOS.
3170  ief = bisect(edos%idos(:,0), ebands%nelect)
3171 
3172  ! Handle out of range condition.
3173  if (ief == 0 .or. ief == nw) then
3174    write(msg,"(3a)")&
3175     "Bisection could not find an initial guess for the Fermi level!",ch10,&
3176     "Possible reasons: not enough bands or wrong number of electrons"
3177    MSG_WARNING(msg)
3178    return
3179  end if
3180 
3181  ! TODO: Use linear interpolation to find an improved estimate of the Fermi level?
3182  edos%ief = ief
3183  do spin=0,edos%nsppol
3184    edos%gef(spin) = edos%dos(ief,spin)
3185  end do
3186 
3187  if (.False.) then
3188    write(std_out,*)"fermie from ebands: ",ebands%fermie
3189    write(std_out,*)"fermie from IDOS: ",edos%mesh(ief)
3190    write(std_out,*)"gef:from ebands%fermie: " ,edos%dos(bisect(edos%mesh, ebands%fermie), 0)
3191    write(std_out,*)"gef:from edos: " ,edos%gef(0)
3192  end if
3193 
3194 end function ebands_get_edos

m_ebands/ebands_get_erange [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

  ebands_get_erange

FUNCTION

  Compute the minimum and maximum energy enclosing a list of states
  specified by k-points and band indices.

INPUTS

  ebands<ebands_t>=The object describing the band structure.
  nkpts=Number of k-points
  kpoints(3,nkpts)=K-points
  band_block(2,nkpts)=Gives for each k-points, the initial and the final band index to include.

OUTPUT

  emin,emax=min and max energy

PARENTS

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

1814 subroutine ebands_get_erange(ebands, nkpts, kpoints, band_block, emin, emax)
1815 
1816 
1817 !This section has been created automatically by the script Abilint (TD).
1818 !Do not modify the following lines by hand.
1819 #undef ABI_FUNC
1820 #define ABI_FUNC 'ebands_get_erange'
1821 !End of the abilint section
1822 
1823  implicit none
1824 
1825 !Arguments ------------------------------------
1826 !scalars
1827  integer,intent(in) :: nkpts
1828  real(dp),intent(out) :: emin,emax
1829  type(ebands_t),intent(in) :: ebands
1830 !arrays
1831  integer,intent(in) :: band_block(2,nkpts)
1832  real(dp),intent(in) :: kpoints(3,nkpts)
1833 
1834 !Local variables-------------------------------
1835 !scalars
1836  integer :: spin,ik,ikpt,cnt
1837  type(kptrank_type) :: krank
1838 
1839 ! *************************************************************************
1840 
1841  call mkkptrank(ebands%kptns, ebands%nkpt, krank)
1842 
1843  emin = huge(one); emax = -huge(one); cnt = 0
1844 
1845  do spin=1,ebands%nsppol
1846    do ik=1,nkpts
1847      ikpt = kptrank_index(krank, kpoints(:,ik))
1848      if (ikpt == -1) then
1849        MSG_WARNING(sjoin("Cannot find k-point:", ktoa(kpoints(:,ik))))
1850        cycle
1851      end if
1852      if (.not. (band_block(1,ik) >= 1 .and. band_block(2,ik) <= ebands%mband)) cycle
1853      cnt = cnt + 1
1854      emin = min(emin, minval(ebands%eig(band_block(1,ik):band_block(2,ik), ikpt, spin)))
1855      emax = max(emax, maxval(ebands%eig(band_block(1,ik):band_block(2,ik), ikpt, spin)))
1856    end do
1857  end do
1858 
1859  call destroy_kptrank(krank)
1860 
1861  ! This can happen if wrong input.
1862  if (cnt == 0) then
1863     MSG_WARNING("None of the k-points/bands provided was found in ebands%")
1864     emin = minval(ebands%eig); emax = maxval(ebands%eig)
1865  end if
1866 
1867 end subroutine ebands_get_erange

m_ebands/ebands_get_jdos [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_get_jdos

FUNCTION

  Compute the joint density of states.

INPUTS

  ebands<ebands_t>=Band structure object.
  cryst<cryst_t>=Info on the crystalline structure.
  intmeth= 1 for gaussian, 2 or 3 for tetrahedrons (3 if Blochl corrections must be included).
  step=Step on the linear mesh in Ha. If <0, the routine will use the mean of the energy level spacing
  broad=Gaussian broadening, If <0, the routine will use a default
    value for the broadening computed from the mean of the energy level spacing.
    No meaning if tetra method
  comm=MPI communicator

OUTPUT

PARENTS

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

4438 subroutine ebands_get_jdos(ebands, cryst, intmeth, step, broad, comm, ierr)
4439 
4440 
4441 !This section has been created automatically by the script Abilint (TD).
4442 !Do not modify the following lines by hand.
4443 #undef ABI_FUNC
4444 #define ABI_FUNC 'ebands_get_jdos'
4445 !End of the abilint section
4446 
4447  implicit none
4448 
4449 !Arguments ------------------------------------
4450 !scalars
4451  integer,intent(in) :: intmeth,comm
4452  integer,intent(out) :: ierr
4453  real(dp),intent(in) :: step,broad
4454  type(ebands_t),intent(in) :: ebands
4455  type(crystal_t),intent(in) :: cryst
4456 
4457 !Local variables-------------------------------
4458 !scalars
4459  integer :: ik_ibz,ibc,ibv,spin,iw,nw,nband_k,nbv,nproc,my_rank,nkibz,cnt,mpierr,unt,bcorr
4460  real(dp) :: wtk,wmax,wstep,wbroad
4461  type(stats_t) :: ediffs
4462  type(t_tetrahedron) :: tetra
4463  character(len=500) :: msg
4464  character(len=fnlen) :: path
4465 !arrays
4466  integer :: val_idx(ebands%nkpt,ebands%nsppol)
4467  real(dp) :: eminmax(2,ebands%nsppol)
4468  real(dp),allocatable :: jdos(:,:),wmesh(:),cvmw(:),wdt(:,:)
4469 
4470 ! *********************************************************************
4471 
4472  ierr = 0
4473  nproc = xmpi_comm_size(comm); my_rank = xmpi_comm_rank(comm)
4474 
4475  nkibz = ebands%nkpt
4476 
4477  ! Find the valence band index for each k and spin ===
4478  val_idx = get_valence_idx(ebands)
4479 
4480  do spin=1,ebands%nsppol
4481    if (any(val_idx(:,spin) /= val_idx(1,spin))) then
4482      write(msg,'(a,i0,a)')&
4483      'Trying to compute JDOS with a metallic band structure for spin: ',spin,&
4484      'Assuming you know what you are doing, continuing anyway! '
4485      MSG_COMMENT(msg)
4486    end if
4487  end do
4488 
4489  ! Compute the mean value of the energy spacing.
4490  ediffs = ebands_edstats(ebands)
4491  wbroad = broad; if (wbroad <= tol16) wbroad = 0.1 * ediffs%mean
4492  wstep = step; if (wstep <= tol16) wstep = 0.02 * ediffs%mean
4493 
4494  ! Compute the linear mesh so that it encloses all bands.
4495  eminmax = get_minmax(ebands, "eig")
4496  wmax = maxval(eminmax(2,:) - eminmax(1,:))
4497  nw = nint(wmax/wstep) + 1
4498 
4499  ABI_CALLOC(jdos, (nw, ebands%nsppol))
4500  ABI_MALLOC(wmesh, (nw))
4501  wmesh = arth(zero, wstep, nw)
4502 
4503  select case (intmeth)
4504  case (1)
4505    ! Gaussian
4506    ABI_MALLOC(cvmw, (nw))
4507 
4508    cnt = 0
4509    do spin=1,ebands%nsppol
4510      do ik_ibz=1,ebands%nkpt
4511        wtk = ebands%wtk(ik_ibz)
4512        nband_k = ebands%nband(ik_ibz + (spin-1)*ebands%nkpt)
4513        nbv = val_idx(ik_ibz, spin)
4514 
4515        do ibv=1,nbv
4516          cnt = cnt + 1; if (mod(cnt, nproc) /= my_rank) cycle
4517          do ibc=nbv+1,nband_k
4518            cvmw = ebands%eig(ibc,ik_ibz,spin) - ebands%eig(ibv,ik_ibz,spin) - wmesh
4519            jdos(:, spin) = jdos(:, spin) + wtk * dirac_delta(cvmw, wbroad)
4520          end do
4521        end do
4522 
4523      end do ! ik_ibz
4524    end do ! spin
4525 
4526    ABI_FREE(cvmw)
4527    call xmpi_sum(jdos, comm, mpierr)
4528 
4529  case (2, 3)
4530    ! Tetrahedron method
4531    if (any(ebands%nband /= ebands%nband(1)) ) then
4532      MSG_WARNING('for tetrahedrons, nband(:) must be constant')
4533      ierr = ierr + 1
4534    end if
4535    if (ierr/=0) return
4536 
4537    tetra = tetra_from_kptrlatt(cryst, ebands%kptopt, ebands%kptrlatt, &
4538      ebands%nshiftk, ebands%shiftk, ebands%nkpt, ebands%kptns, msg, ierr)
4539    if (ierr/=0) then
4540      call destroy_tetra(tetra); return
4541    end if
4542 
4543    ! For each spin and band, interpolate over kpoints,
4544    ! calculate integration weights and DOS contribution.
4545    ABI_MALLOC(cvmw, (nkibz))
4546    ABI_MALLOC(wdt, (nw, 2))
4547 
4548    bcorr = 0; if (intmeth == 3) bcorr = 1
4549    cnt = 0
4550    do spin=1,ebands%nsppol
4551      nbv = val_idx(1, spin)
4552      do ibv=1,nbv
4553        do ibc=nbv+1,ebands%mband
4554          ! For each (c,v) get its contribution
4555          cvmw = ebands%eig(ibc,:,spin) - ebands%eig(ibv,:,spin)
4556          do ik_ibz=1,ebands%nkpt
4557            cnt = cnt + 1; if (mod(cnt, nproc) /= my_rank) cycle  ! mpi-parallelism
4558 
4559            ! Calculate integration weights at each irred k-point (Blochl et al PRB 49 16223 [[cite:Bloechl1994a]])
4560            call tetra_get_onewk(tetra, ik_ibz, bcorr, nw, ebands%nkpt, cvmw, wmesh(0), wmesh(nw), one, wdt)
4561            jdos(:,spin) = jdos(:,spin) + wdt(:, 1)
4562          end do
4563        end do ! ibc
4564      end do ! ibv
4565    end do ! spin
4566 
4567    call xmpi_sum(jdos, comm, mpierr)
4568 
4569    ! Free memory
4570    ABI_FREE(wdt)
4571    ABI_FREE(cvmw)
4572    call destroy_tetra(tetra)
4573 
4574  case default
4575    MSG_ERROR(sjoin("Wrong integration method:", itoa(intmeth)))
4576  end select
4577 
4578  if (ebands%nsppol == 1) jdos = two * jdos
4579 
4580  ! Write data.
4581  if (my_rank == 0) then
4582    path = "jdos_gauss.data"; if (intmeth == 2) path = "jdos_tetra.data"
4583    if (open_file(path, msg, newunit=unt, form="formatted", action="write") /= 0) then
4584      MSG_ERROR(msg)
4585    end if
4586    do iw=1,nw
4587      write(unt,*)wmesh(iw),(jdos(iw,spin), spin=1,ebands%nsppol)
4588    end do
4589    close(unt)
4590  end if
4591 
4592  ABI_FREE(wmesh)
4593  ABI_FREE(jdos)
4594 
4595 end subroutine ebands_get_jdos

m_ebands/ebands_has_metal_scheme [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_metallic_scheme

FUNCTION

 Returns .TRUE. if metallic occupation scheme is used.
 Note that this does not imply that the system is metallic.

INPUTS

 ebands<ebands_t>=The ebands_t datatype

PARENTS

CHILDREN

SOURCE

2094 pure logical function ebands_has_metal_scheme(ebands) result(ans)
2095 
2096 
2097 !This section has been created automatically by the script Abilint (TD).
2098 !Do not modify the following lines by hand.
2099 #undef ABI_FUNC
2100 #define ABI_FUNC 'ebands_has_metal_scheme'
2101 !End of the abilint section
2102 
2103  implicit none
2104 
2105 !Arguments ------------------------------------
2106 !scalars
2107  type(ebands_t),intent(in) :: ebands
2108 
2109 ! *************************************************************************
2110 
2111  ans = (any(ebands%occopt == [3,4,5,6,7,8]))
2112 
2113 end function ebands_has_metal_scheme

m_ebands/ebands_init [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_init

FUNCTION

 This subroutine initializes the ebands_t structured datatype

INPUTS

 bantot=total number of bands (=sum(nband(:))
 doccde(bantot)=derivative of the occupation numbers with respect to the energy (Ha)
 eig(bantot)=eigenvalues (hartree)
 istwfk(nkpt)=parameter that describes the storage of wfs.
 kptns(3,nkpt)=k points in terms of recip primitive translations
 nband(nkpt*nsppol)=number of bands
 nelect=Number of electrons.
 nkpt=number of k points
 npwarr(nkpt)=number of planewaves at each k point
 nsppol=1 for unpolarized, 2 for spin-polarized
 nspinor=Number of spinor components
 occopt=Occupation options (see input variable)
 occ(bantot)=occupation numbers
 tphysel=Physical temperature (input variable)
 tsmear=Temperature of smearing.
 wtk(nkpt)=weight assigned to each k point
 charge=Additional charge added to the unit cell (input variable).
 kptopt=Option for k-point generation (see input variable)
 kptrlatt_orig=Original value of kptrlatt given in input
 nshiftk_orig=Original number of shifts given in input
 shiftk_orig(3,nshiftk_orig)=Original set of shifts given in input
 kptrlatt=Value of kptrlatt after inkpts
 nshiftk=Number of shifts after inkpts
 shiftk(3,nshiftk)=Set of shifts after inkpts.

OUTPUT

 ebands<ebands_t>=the ebands_t datatype

SIDE EFFECTS

  %entropy and %fermie initialized to zero.

PARENTS

      dfpt_looppert,eig2tot,gstate,m_ebands,mlwfovlp_qp,optic,outscfcv
      setup_bse,setup_bse_interp,setup_screening,setup_sigma

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

586 subroutine ebands_init(bantot,ebands,nelect,doccde,eig,istwfk,kptns,&
587 & nband,nkpt,npwarr,nsppol,nspinor,tphysel,tsmear,occopt,occ,wtk,&
588 & charge, kptopt, kptrlatt_orig, nshiftk_orig, shiftk_orig, kptrlatt, nshiftk, shiftk)
589 
590 
591 !This section has been created automatically by the script Abilint (TD).
592 !Do not modify the following lines by hand.
593 #undef ABI_FUNC
594 #define ABI_FUNC 'ebands_init'
595 !End of the abilint section
596 
597  implicit none
598 
599 !This section has been created automatically by the script Abilint (TD).
600 !Do not modify the following lines by hand.
601 #undef ABI_FUNC
602 #define ABI_FUNC 'ebands_init'
603 !End of the abilint section
604 
605 !Arguments ------------------------------------
606 !scalars
607  integer,intent(in) :: bantot,nkpt,nsppol,nspinor,occopt
608  real(dp),intent(in) :: nelect,tphysel,tsmear
609  type(ebands_t),intent(out) :: ebands
610 !arrays
611  integer,intent(in) :: istwfk(nkpt),nband(nkpt*nsppol),npwarr(nkpt)
612  real(dp),intent(in) :: doccde(bantot),eig(bantot),kptns(3,nkpt),occ(bantot)
613  real(dp),intent(in) :: wtk(nkpt)
614  integer,intent(in) :: kptopt, nshiftk_orig, nshiftk
615  real(dp),intent(in) :: charge
616  integer,intent(in) :: kptrlatt_orig(3,3),kptrlatt(3,3)
617  real(dp),intent(in) :: shiftk_orig(3,nshiftk_orig),shiftk(3,nshiftk)
618 
619 ! *************************************************************************
620 
621  ! Copy the scalars
622  ! MG TODO here there is a inconsistency in the way occ are treated in the header
623  ! (only the states used, bantot. are saved, and the way occ. and energies
624  ! are passed to routines (mband,nkpt,nsppol). It might happen that bantot<mband*nktp*nsppol
625  ! this should not lead to problems since arrays are passed by reference
626  ! anyway the treatment of these arrays have to be rationalized
627  ebands%bantot =bantot
628  ebands%mband  =MAXVAL(nband(1:nkpt*nsppol))
629  ebands%nkpt   =nkpt
630  ebands%nspinor=nspinor
631  ebands%nsppol =nsppol
632  ebands%occopt =occopt
633 
634  ebands%entropy=zero  ! Initialize results
635  ebands%fermie =zero  ! Initialize results
636  ebands%nelect =nelect
637  ebands%tphysel=tphysel
638  ebands%tsmear =tsmear
639 
640  ! Allocate the components
641  ABI_MALLOC(ebands%nband,(nkpt*nsppol))
642  ABI_MALLOC(ebands%istwfk,(nkpt))
643  ABI_MALLOC(ebands%npwarr,(nkpt))
644  ABI_MALLOC(ebands%kptns,(3,nkpt))
645 
646  ! Copy the arrays
647  ebands%nband(1:nkpt*nsppol)=nband(1:nkpt*nsppol)
648  ebands%istwfk(1:nkpt)      =istwfk(1:nkpt)
649  ebands%npwarr(1:nkpt)      =npwarr(1:nkpt)
650  ebands%kptns(1:3,1:nkpt)   =kptns(1:3,1:nkpt)
651 
652  ! In ebands, energies and occupations are stored in a matrix (mband,nkpt,nsppol).
653  ! put_eneocc_vect is used to reshape the values stored in vectorial form.
654  ABI_MALLOC(ebands%eig   ,(ebands%mband,nkpt,nsppol))
655  ABI_MALLOC(ebands%occ   ,(ebands%mband,nkpt,nsppol))
656  ABI_MALLOC(ebands%doccde,(ebands%mband,nkpt,nsppol))
657 
658  call put_eneocc_vect(ebands,'eig',   eig   )
659  call put_eneocc_vect(ebands,'occ',   occ   )
660  call put_eneocc_vect(ebands,'doccde',doccde)
661 
662  ABI_MALLOC(ebands%wtk,(nkpt))
663  ebands%wtk(1:nkpt)=wtk(1:nkpt)
664 
665 !EBANDS_NEW
666  ebands%kptopt = kptopt
667  ebands%nshiftk_orig = nshiftk_orig
668  ebands%nshiftk = nshiftk
669  ebands%charge = charge
670  ebands%kptrlatt_orig = kptrlatt_orig
671  ebands%kptrlatt = kptrlatt
672 
673  call alloc_copy(shiftk_orig, ebands%shiftk_orig)
674  call alloc_copy(shiftk, ebands%shiftk)
675 
676 end subroutine ebands_init

m_ebands/ebands_interp_kmesh [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_interp_kmesh

FUNCTION

  Interpolate energies on a k-mesh.

INPUTS

  ebands<ebands_t> = Object with input energies.
  cryst<crystal_t> = Crystalline structure.
  params(:)
  intp_kptrlatt(3,3) = New k-mesh
  intp_nshiftk= Number of shifts in new k-mesh.
  intp_shiftk(3,intp_nshiftk) = Shifts in new k-mesh.
  band_block(2)=Initial and final band index. If [0,0], all bands are used
    This is a global variable i.e. all MPI procs must call the routine with the same value.
  comm=MPI communicator

OUTPUT

  New ebands_t object with interpolated energies.

PARENTS

CHILDREN

SOURCE

4152 function ebands_interp_kmesh(ebands, cryst, params, intp_kptrlatt, intp_nshiftk, intp_shiftk, band_block, comm) result(new)
4153 
4154 
4155 !This section has been created automatically by the script Abilint (TD).
4156 !Do not modify the following lines by hand.
4157 #undef ABI_FUNC
4158 #define ABI_FUNC 'ebands_interp_kmesh'
4159 !End of the abilint section
4160 
4161  implicit none
4162 
4163 !Arguments ------------------------------------
4164 !scalars
4165  integer,intent(in) :: intp_nshiftk,comm
4166  type(ebands_t),intent(in) :: ebands
4167  type(crystal_t),intent(in) :: cryst
4168  type(ebands_t) :: new
4169 !arrays
4170  integer,intent(in) :: intp_kptrlatt(3,3),band_block(2)
4171  real(dp),intent(in) :: params(:)
4172  real(dp),intent(in) :: intp_shiftk(3,intp_nshiftk)
4173 
4174 !Local variables-------------------------------
4175 !scalars
4176  integer :: ik_ibz,spin,new_bantot,new_mband,cplex,itype,nb,ib
4177  integer :: nprocs,my_rank,cnt,ierr,band,new_nkbz,new_nkibz,new_nshiftk
4178  type(ebspl_t) :: ebspl
4179  type(skw_t) :: skw
4180 !arrays
4181  integer :: new_kptrlatt(3,3),bspl_ords(3),my_bblock(2)
4182  integer,allocatable :: new_istwfk(:),new_nband(:,:),new_npwarr(:)
4183  real(dp),allocatable :: new_shiftk(:,:),new_kibz(:,:),new_kbz(:,:),new_wtk(:)
4184  real(dp),allocatable :: new_doccde(:),new_eig(:),new_occ(:)
4185 
4186 ! *********************************************************************
4187 
4188  nprocs = xmpi_comm_size(comm); my_rank = xmpi_comm_rank(comm)
4189  itype = nint(params(1))
4190  my_bblock = band_block; if (all(band_block == 0)) my_bblock = [1, ebands%mband]
4191  nb = my_bblock(2) - my_bblock(1) + 1
4192 
4193  ! Get ibz, new shifts and new kptrlatt.
4194  call kpts_ibz_from_kptrlatt(cryst, intp_kptrlatt, ebands%kptopt, intp_nshiftk, intp_shiftk, &
4195    new_nkibz, new_kibz, new_wtk, new_nkbz, new_kbz, new_kptrlatt=new_kptrlatt, new_shiftk=new_shiftk)
4196  new_nshiftk = size(new_shiftk, dim=2)
4197 
4198  ! Initialize new ebands_t in new IBZ
4199  ABI_MALLOC(new_istwfk, (new_nkibz))
4200  new_istwfk = 1
4201  ABI_MALLOC(new_nband, (new_nkibz, ebands%nsppol))
4202  new_nband = nb
4203  ABI_MALLOC(new_npwarr, (new_nkibz))
4204  new_npwarr = maxval(ebands%npwarr)
4205  new_bantot = sum(new_nband); new_mband = maxval(new_nband)
4206  ABI_CALLOC(new_doccde, (new_bantot))
4207  ABI_CALLOC(new_eig, (new_bantot))
4208  ABI_CALLOC(new_occ, (new_bantot))
4209 
4210  call ebands_init(new_bantot,new,ebands%nelect,new_doccde,new_eig,new_istwfk,new_kibz,&
4211    new_nband,new_nkibz,new_npwarr,ebands%nsppol,ebands%nspinor,ebands%tphysel,ebands%tsmear,&
4212    ebands%occopt,new_occ,new_wtk,&
4213    ebands%charge, ebands%kptopt, intp_kptrlatt, intp_nshiftk, intp_shiftk, new_kptrlatt, new_nshiftk, new_shiftk)
4214  new%fermie = ebands%fermie
4215 
4216  ABI_FREE(new_kibz)
4217  ABI_FREE(new_wtk)
4218  ABI_FREE(new_shiftk)
4219  ABI_FREE(new_kbz)
4220  ABI_FREE(new_istwfk)
4221  ABI_FREE(new_nband)
4222  ABI_FREE(new_npwarr)
4223  ABI_FREE(new_doccde)
4224  ABI_FREE(new_eig)
4225  ABI_FREE(new_occ)
4226 
4227  ! Build (B-spline|SKW) object for all bands.
4228  select case (itype)
4229  case (1)
4230    cplex = 1; if (kpts_timrev_from_kptopt(ebands%kptopt) == 0) cplex = 2
4231    skw = skw_new(cryst, params(2:), cplex, ebands%mband, ebands%nkpt, ebands%nsppol, ebands%kptns, ebands%eig, &
4232                  band_block, comm)
4233  case (2)
4234    bspl_ords = nint(params(2:4))
4235    ebspl = ebspl_new(ebands, cryst, bspl_ords, band_block)
4236 
4237  case default
4238    MSG_ERROR(sjoin("Wrong params(1):", itoa(itype)))
4239  end select
4240 
4241  ! Interpolate eigenvalues.
4242  new%eig = zero; cnt = 0
4243  do spin=1,new%nsppol
4244    do ik_ibz=1,new%nkpt
4245      do ib=1,nb
4246        cnt = cnt + 1; if (mod(cnt, nprocs) /= my_rank) cycle  ! Mpi parallelism.
4247        band = my_bblock(1) + ib - 1
4248        select case (itype)
4249        case (1)
4250          call skw_eval_bks(skw, band, new%kptns(:,ik_ibz), spin, new%eig(band,ik_ibz,spin))
4251        case (2)
4252          call ebspl_eval_bks(ebspl, band, new%kptns(:,ik_ibz), spin, new%eig(band,ik_ibz,spin))
4253        case default
4254          MSG_ERROR(sjoin("Wrong params(1):", itoa(itype)))
4255        end select
4256      end do
4257    end do
4258  end do
4259  call xmpi_sum(new%eig, comm, ierr)
4260 
4261  call ebspl_free(ebspl)
4262  call skw_free(skw)
4263 
4264 end function ebands_interp_kmesh

m_ebands/ebands_interp_kpath [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_interp_kpath

FUNCTION

  Interpolate energies on a k-path

INPUTS

  ebands<ebands_t> = Object with input energies.
  cryst<crystal_t> = Crystalline structure.
  kpath<kpath_t> = Object describing the k-path
  params(:):
    params(1): 1 for SKW, 2 for B-spline.
  band_block(2)=Initial and final band index to be interpolated. [0,0] if all bands are used.
    This is a global variable i.e. all MPI procs must call the routine with the same value.
  comm=MPI communicator

OUTPUT

  New ebands_t object with interpolated energies.

PARENTS

CHILDREN

SOURCE

4295 type(ebands_t) function ebands_interp_kpath(ebands, cryst, kpath, params, band_block, comm) result(new)
4296 
4297 
4298 !This section has been created automatically by the script Abilint (TD).
4299 !Do not modify the following lines by hand.
4300 #undef ABI_FUNC
4301 #define ABI_FUNC 'ebands_interp_kpath'
4302 !End of the abilint section
4303 
4304  implicit none
4305 
4306 !Arguments ------------------------------------
4307 !scalars
4308  integer,intent(in) :: comm
4309  type(ebands_t),intent(in) :: ebands
4310  type(crystal_t),intent(in) :: cryst
4311  type(kpath_t),intent(in) :: kpath
4312 !arrays
4313  integer,intent(in) :: band_block(2)
4314  real(dp),intent(in) :: params(:)
4315 
4316 !Local variables-------------------------------
4317 !scalars
4318  integer,parameter :: new_nshiftk=1
4319  integer :: ik_ibz,spin,new_bantot,new_mband,cplex
4320  integer :: nprocs,my_rank,cnt,ierr,band,new_nkibz,itype,nb,ib
4321  type(ebspl_t) :: ebspl
4322  type(skw_t) :: skw
4323 !arrays
4324  integer,parameter :: new_kptrlatt(3,3)=0
4325  integer :: bspl_ords(3),my_bblock(2)
4326  integer,allocatable :: new_istwfk(:),new_nband(:,:),new_npwarr(:)
4327  real(dp),parameter :: new_shiftk(3,1) = zero
4328  real(dp),allocatable :: new_wtk(:),new_doccde(:),new_eig(:),new_occ(:)
4329 
4330 ! *********************************************************************
4331 
4332  nprocs = xmpi_comm_size(comm); my_rank = xmpi_comm_rank(comm)
4333  itype = nint(params(1))
4334  my_bblock = band_block; if (all(band_block == 0)) my_bblock = [1, ebands%mband]
4335  nb = my_bblock(2) - my_bblock(1) + 1
4336 
4337  if (ebands%nkpt == 1) then
4338    MSG_WARNING("Cannot interpolate band energies when nkpt = 1. Returning")
4339    return
4340  end if
4341 
4342  ! Initialize new ebands_t.
4343  new_nkibz = kpath%npts
4344  ABI_MALLOC(new_istwfk, (new_nkibz))
4345  new_istwfk = 1
4346  ABI_MALLOC(new_nband, (new_nkibz, ebands%nsppol))
4347  new_nband = nb
4348  ABI_MALLOC(new_npwarr, (new_nkibz))
4349  new_npwarr = maxval(ebands%npwarr)
4350  new_bantot = sum(new_nband); new_mband = maxval(new_nband)
4351  ABI_CALLOC(new_eig, (new_bantot))
4352  ABI_CALLOC(new_doccde, (new_bantot))
4353  ABI_CALLOC(new_occ, (new_bantot))
4354  ABI_CALLOC(new_wtk, (new_nkibz))
4355 
4356  call ebands_init(new_bantot,new,ebands%nelect,new_doccde,new_eig,new_istwfk,kpath%points,&
4357    new_nband,new_nkibz,new_npwarr,ebands%nsppol,ebands%nspinor,ebands%tphysel,ebands%tsmear,&
4358    ebands%occopt,new_occ,new_wtk,&
4359    ebands%charge, ebands%kptopt, new_kptrlatt, new_nshiftk, new_shiftk, new_kptrlatt, new_nshiftk, new_shiftk)
4360  new%fermie = ebands%fermie
4361 
4362  ABI_FREE(new_wtk)
4363  ABI_FREE(new_istwfk)
4364  ABI_FREE(new_nband)
4365  ABI_FREE(new_npwarr)
4366  ABI_FREE(new_doccde)
4367  ABI_FREE(new_eig)
4368  ABI_FREE(new_occ)
4369 
4370  ! Build (B-spline|SKW) object for all bands.
4371  select case (itype)
4372  case (1)
4373    cplex = 1; if (kpts_timrev_from_kptopt(ebands%kptopt) == 0) cplex = 2
4374    skw = skw_new(cryst, params(2:), cplex, ebands%mband, ebands%nkpt, ebands%nsppol, ebands%kptns, ebands%eig, &
4375                  my_bblock, comm)
4376  case (2)
4377    bspl_ords = nint(params(2:4))
4378    ebspl = ebspl_new(ebands, cryst, bspl_ords, my_bblock)
4379 
4380  case default
4381    MSG_ERROR(sjoin("Wrong params(1):", itoa(itype)))
4382  end select
4383 
4384  ! Interpolate eigenvalues.
4385  new%eig = zero; cnt = 0
4386  do spin=1,new%nsppol
4387    do ik_ibz=1,new%nkpt
4388      do ib=1,nb
4389        cnt = cnt + 1; if (mod(cnt, nprocs) /= my_rank) cycle  ! Mpi parallelism.
4390        band = my_bblock(1) + ib - 1
4391        select case (itype)
4392        case (1)
4393          call skw_eval_bks(skw, band, new%kptns(:,ik_ibz), spin, new%eig(band,ik_ibz,spin))
4394        case (2)
4395          call ebspl_eval_bks(ebspl, band, new%kptns(:,ik_ibz), spin, new%eig(band,ik_ibz,spin))
4396        case default
4397          MSG_ERROR(sjoin("Wrong params(1):", itoa(itype)))
4398        end select
4399      end do
4400    end do
4401  end do
4402  call xmpi_sum(new%eig, comm, ierr)
4403 
4404  call ebspl_free(ebspl)
4405  call skw_free(skw)
4406 
4407 end function ebands_interp_kpath

m_ebands/ebands_interpolate_kpath [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

  ebands_interpolate_kpath

FUNCTION

INPUTS

  dtset<dataset_type>=Abinit dataset
  band_block(2)=Initial and final band index to be interpolated. [0,0] if all bands are used.
    This is a global variable i.e. all MPI procs must call the routine with the same value.

OUTPUT

PARENTS

      outscfcv,sigma

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

5433 subroutine ebands_interpolate_kpath(ebands, dtset, cryst, band_block, prefix, comm)
5434 
5435 
5436 !This section has been created automatically by the script Abilint (TD).
5437 !Do not modify the following lines by hand.
5438 #undef ABI_FUNC
5439 #define ABI_FUNC 'ebands_interpolate_kpath'
5440 !End of the abilint section
5441 
5442  implicit none
5443 
5444 !Arguments ------------------------------------
5445 !scalars
5446  type(ebands_t),intent(in) :: ebands
5447  type(dataset_type),intent(in) :: dtset
5448  type(crystal_t),intent(in) :: cryst
5449  integer,intent(in) :: comm
5450  character(len=*),intent(in) :: prefix
5451 !arrays
5452  integer,intent(in) :: band_block(2)
5453 
5454 !Local variables-------------------------------
5455 !scalars
5456  integer,parameter :: master=0
5457  integer :: my_rank,ndivsm,nbounds,itype
5458  type(ebands_t) :: ebands_kpath
5459  type(kpath_t) :: kpath
5460  character(len=500) :: msg,tag
5461 !arrays
5462  real(dp),allocatable :: bounds(:,:)
5463 
5464 ! *********************************************************************
5465 
5466  my_rank = xmpi_comm_rank(comm)
5467 
5468  itype = nint(dtset%einterp(1)); tag =  "_SKW"
5469  if (itype == 2) then
5470    tag = "_BSPLINE"
5471    if (.not. (isdiagmat(ebands%kptrlatt) .and. ebands%nshiftk == 1 .and. ebands%nkpt > 1)) then
5472      write(msg,"(5a)") &
5473         "Cannot interpolate energies with B-spline because:",ch10,&
5474         ".not. (isdiagmat(ebands%kptrlatt) .and. ebands%nshiftk == 1 .and. ebands%nkpt > 1)",ch10,&
5475         "Returning to caller!"
5476      MSG_WARNING(msg)
5477      return
5478    end if
5479  end if
5480  tag = "_INTERP"
5481 
5482  ! Generate k-path
5483  ndivsm = dtset%ndivsm
5484  if (ndivsm <= 0) then
5485    MSG_WARNING("Setting ndivsm to 10 because variable is not given in input file")
5486    ndivsm = 10
5487  end if
5488  nbounds = dtset%nkpath
5489  if (nbounds <= 0) then
5490    MSG_WARNING("Using hard-coded k-path because nkpath not present in input file.")
5491    nbounds = 5
5492    ABI_MALLOC(bounds, (3,5))
5493    bounds = reshape([zero, zero, zero, half, zero, zero, zero, half, zero, zero, zero, zero, zero, zero, half], [3,5])
5494  else
5495    call alloc_copy(dtset%kptbounds, bounds)
5496  end if
5497 
5498  kpath = kpath_new(bounds, cryst%gprimd, ndivsm)
5499  call kpath_print(kpath, header="Interpolating energies on k-path", unit=std_out)
5500  ABI_FREE(bounds)
5501 
5502  ! Interpolate bands on k-path.
5503  ebands_kpath = ebands_interp_kpath(ebands, cryst, kpath, dtset%einterp, band_block, comm)
5504  if (my_rank == master) then
5505    call wrtout(ab_out, sjoin("- Writing interpolated bands to file:", strcat(prefix, tag)))
5506    call ebands_write(ebands_kpath, dtset%prtebands, strcat(prefix, tag), kptbounds=kpath%bounds)
5507  end if
5508  call ebands_free(ebands_kpath)
5509  call kpath_free(kpath)
5510 
5511  ! Interpolate bands on dense k-mesh.
5512  !!kptrlatt_fine = reshape([1,0,0,0,1,0,0,0,1], [3,3]); kptrlatt_fine = 12 * kptrlatt_fine
5513  !kptrlatt_fine = 2 * ebands%kptrlatt
5514  !nshiftk_fine = ebands%nshiftk
5515  !!nshiftk_fine = 5
5516  !ABI_CALLOC(shiftk_fine, (3,nshiftk_fine))
5517  !shiftk_fine = ebands%shiftk
5518  !!shiftk_fine = half * reshape([1,0,0,0,1,0,0,0,1,1,1,1,0,0,0], [3,5])
5519  !ABI_FREE(shiftk_fine)
5520  !ebands_bspl = ebands_interp_kmesh(ebands, cryst, dtset%einterp, kptrlatt_fine, nshiftk_fine, shiftk_fine, comm)
5521  !call ebands_update_occ(ebands_bspl, dtset%spinmagntarget, prtvol=dtset%prtvol)
5522  !ebands_skw = ebands_interp_kmesh(ebands, cryst, dtset%einterp, kptrlatt_fine, nshiftk_fine, shiftk_fine, comm)
5523  !call ebands_update_occ(ebands_skw, dtset%spinmagntarget, prtvol=dtset%prtvol)
5524  !call ebands_free(ebands_bspl)
5525  !call ebands_free(ebands_skw)
5526 
5527  !edos = ebands_get_edos(ebands_bspl, cryst, edos_intmeth, edos_step, edos_broad, comm)
5528  !call ebands_get_jdos(ebands, cryst, intmeth, step, broad, comm, ierr)
5529  !if (my_rank == master) then
5530  !  call edos_print(edos, unit=ab_out)
5531  !  path = strcat(prefix, "_BSPLINE_EDOS")
5532  !  call wrtout(ab_out, sjoin("- Writing electron DOS to file:", path))
5533  !  call edos_write(edos, path)
5534  !end if
5535  !call edos_free(edos)
5536 
5537 end subroutine ebands_interpolate_kpath

m_ebands/ebands_ncwrite [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_ncwrite

FUNCTION

  Writes the content of an ebands_t object to a NETCDF file
  according to the ETSF-IO specifications. Return nf90_noerr if success.

INPUTS

  ncid =NC file handle

PARENTS

      dfpt_looppert,eig2tot,ioarr,m_ebands,m_iowf,m_shirley,pawmkaewf,sigma

CHILDREN

      destroy_tetra,get_full_kgrid,init_tetra,matr3inv,tetra_blochl_weights
      xmpi_sum

SOURCE

2768 integer function ebands_ncwrite(ebands,ncid) result(ncerr)
2769 
2770 
2771 !This section has been created automatically by the script Abilint (TD).
2772 !Do not modify the following lines by hand.
2773 #undef ABI_FUNC
2774 #define ABI_FUNC 'ebands_ncwrite'
2775 !End of the abilint section
2776 
2777  implicit none
2778 
2779 !Arguments ------------------------------------
2780 !scalars
2781  integer,intent(in) :: ncid
2782  type(ebands_t),intent(in) :: ebands
2783 
2784 !Local variables-------------------------------
2785 !scalars
2786 #ifdef HAVE_NETCDF
2787  integer :: ii,nelect_int
2788  logical :: write_ngkpt
2789  character(len=etsfio_charlen) :: smearing,k_dependent
2790 !arrays
2791  integer :: ngkpt(3)
2792 
2793 ! *************************************************************************
2794 
2795  smearing = nctk_string_from_occopt(ebands%occopt)
2796 
2797  ! ==============================================
2798  ! === Write the dimensions specified by ETSF ===
2799  ! ==============================================
2800  ncerr = nctk_def_dims(ncid, [ &
2801    nctkdim_t("max_number_of_states", ebands%mband), &
2802    nctkdim_t("number_of_spinor_components", ebands%nspinor), &
2803    nctkdim_t("number_of_spins", ebands%nsppol), &
2804    nctkdim_t("number_of_kpoints", ebands%nkpt), &
2805    nctkdim_t("nshiftk_orig", ebands%nshiftk_orig), &
2806    nctkdim_t("nshiftk", ebands%nshiftk)], &
2807    defmode=.True.)
2808  NCF_CHECK(ncerr)
2809 
2810  ! FIXME
2811  ! Unofficial variables. Notes:
2812  ! 1) ETSF-IO does not support nshifts > 1
2813  ! 2) shiftk_orig, nshiftk_orig refers to the values specified in the input (most useful ones).
2814  ! 3) shiftk, kptrlatt refers to the values computed in inkpts.
2815  ! 4) Should define a protocol so that abipy understands if we have a path or a mesh.
2816  !write_kptrlatt = (SUM(ABS(ebands%kptrlatt))/=0)
2817  !write_kptrlatt = (ebands%kptopt /= 0)
2818 
2819  ngkpt = 0; write_ngkpt = .False.
2820  if (isdiagmat(ebands%kptrlatt) .and. ebands%nshiftk == 1) then
2821     write_ngkpt = .True.
2822     do ii=1,3
2823       ngkpt(ii) = ebands%kptrlatt(ii, ii)
2824     end do
2825     ncerr = nctk_def_dims(ncid, nctkdim_t('ngkpt_nshiftk', ebands%nshiftk_orig))
2826     NCF_CHECK(ncerr)
2827  end if
2828 
2829  ! Define k-points
2830  ncerr = nctk_def_arrays(ncid, [&
2831    nctkarr_t("reduced_coordinates_of_kpoints", "dp", "number_of_reduced_dimensions, number_of_kpoints"), &
2832    nctkarr_t("kpoint_weights", "dp", "number_of_kpoints"), &
2833    nctkarr_t("monkhorst_pack_folding", "int", "number_of_vectors") &
2834  ])
2835  NCF_CHECK(ncerr)
2836 
2837  ! Define states section.
2838  ncerr = nctk_def_arrays(ncid, [&
2839    nctkarr_t("number_of_states", "int", "number_of_kpoints, number_of_spins"), &
2840    nctkarr_t("eigenvalues", "dp", "max_number_of_states, number_of_kpoints, number_of_spins"), &
2841    nctkarr_t("occupations", "dp", "max_number_of_states, number_of_kpoints, number_of_spins"), &
2842    nctkarr_t("smearing_scheme", "char", "character_string_length")  &
2843  ])
2844  NCF_CHECK(ncerr)
2845 
2846  ncerr = nctk_def_iscalars(ncid, [character(len=nctk_slen) :: "number_of_electrons"])
2847  NCF_CHECK(ncerr)
2848  ncerr = nctk_def_dpscalars(ncid, [character(len=nctk_slen) :: "fermi_energy", "smearing_width"])
2849  NCF_CHECK(ncerr)
2850 
2851  ! Some variables require the specifications of units.
2852  NCF_CHECK(nctk_set_atomic_units(ncid, "eigenvalues"))
2853  NCF_CHECK(nctk_set_atomic_units(ncid, "fermi_energy"))
2854 
2855  k_dependent = "no"; if (any(ebands%nband(1) /= ebands%nband)) k_dependent = "yes"
2856  NCF_CHECK(nf90_put_att(ncid, vid("number_of_states"), "k_dependent", k_dependent))
2857 
2858  ! Write data.
2859  ! 1) Electrons.
2860  ! FIXME: in etsf_io the number of electrons is declared as integer!!!
2861  nelect_int = nint(ebands%nelect)
2862 
2863  NCF_CHECK(nctk_set_datamode(ncid))
2864  NCF_CHECK(nf90_put_var(ncid, vid("fermi_energy"), ebands%fermie))
2865  NCF_CHECK(nf90_put_var(ncid, vid("number_of_electrons"), nelect_int))
2866  NCF_CHECK(nf90_put_var(ncid, vid("smearing_width"), ebands%tsmear))
2867  NCF_CHECK(nf90_put_var(ncid, vid("number_of_states"), ebands%nband, count=[ebands%nkpt, ebands%nsppol]))
2868  NCF_CHECK(nf90_put_var(ncid, vid("eigenvalues"), ebands%eig))
2869  NCF_CHECK(nf90_put_var(ncid, vid("occupations"), ebands%occ))
2870  NCF_CHECK(nf90_put_var(ncid, vid("smearing_scheme"), smearing))
2871 
2872  ! K-points
2873  NCF_CHECK(nf90_put_var(ncid, vid("reduced_coordinates_of_kpoints"), ebands%kptns))
2874  NCF_CHECK(nf90_put_var(ncid, vid("kpoint_weights"), ebands%wtk))
2875 
2876  if (write_ngkpt) then
2877    NCF_CHECK(nf90_put_var(ncid, vid("monkhorst_pack_folding"), ngkpt))
2878  end if
2879 
2880  ! ===========================================================
2881  ! === Write abinit-related stuff (not covered by ETSF-IO) ===
2882  ! ===========================================================
2883  ! Define variables.
2884  NCF_CHECK(nctk_def_iscalars(ncid, [character(len=nctk_slen) :: "occopt", "kptopt"], defmode=.True.))
2885  NCF_CHECK(nctk_def_dpscalars(ncid, [character(len=nctk_slen) :: "tphysel", "charge"]))
2886 
2887  ncerr = nctk_def_arrays(ncid, nctkarr_t('istwfk', "i", 'number_of_kpoints'))
2888  NCF_CHECK(ncerr)
2889 
2890  ! Abinit variables defining the K-point sampling.
2891  ncerr = nctk_def_arrays(ncid, [&
2892    nctkarr_t('kptrlatt_orig', "i", 'number_of_reduced_dimensions, number_of_reduced_dimensions'), &
2893    nctkarr_t('shiftk_orig',  "dp", 'number_of_reduced_dimensions, nshiftk_orig'), &
2894    nctkarr_t('kptrlatt', "i", 'number_of_reduced_dimensions, number_of_reduced_dimensions'), &
2895    nctkarr_t('shiftk',  "dp", 'number_of_reduced_dimensions, nshiftk') &
2896  ])
2897  NCF_CHECK(ncerr)
2898 
2899  if (write_ngkpt) then
2900    ncerr = nctk_def_arrays(ncid, nctkarr_t('ngkpt_shiftk', "dp", "number_of_reduced_dimensions, ngkpt_nshiftk"))
2901    NCF_CHECK(ncerr)
2902  end if
2903 
2904  ! Write variables
2905  NCF_CHECK(nctk_set_datamode(ncid))
2906  NCF_CHECK(nf90_put_var(ncid, vid("tphysel"), ebands%tphysel))
2907  NCF_CHECK(nf90_put_var(ncid, vid("occopt"), ebands%occopt))
2908  NCF_CHECK(nf90_put_var(ncid, vid("istwfk"), ebands%istwfk))
2909  NCF_CHECK(nf90_put_var(ncid, vid("kptopt"), ebands%kptopt))
2910  NCF_CHECK(nf90_put_var(ncid, vid("charge"), ebands%charge))
2911  NCF_CHECK(nf90_put_var(ncid, vid('kptrlatt_orig'), ebands%kptrlatt_orig))
2912  NCF_CHECK(nf90_put_var(ncid, vid('shiftk_orig'), ebands%shiftk_orig))
2913  NCF_CHECK(nf90_put_var(ncid, vid('kptrlatt'),ebands%kptrlatt))
2914  NCF_CHECK(nf90_put_var(ncid, vid('shiftk'), ebands%shiftk))
2915 
2916  if (write_ngkpt) then
2917    !write(std_out,*)"nshiftk_orig",nshiftk_orig,"shiftk_orig",shiftk_orig
2918    NCF_CHECK(nf90_put_var(ncid, vid('ngkpt_shiftk'), ebands%shiftk_orig))
2919  end if
2920 
2921 #else
2922  MSG_ERROR("netcdf support is not activated. ")
2923 #endif
2924 
2925 contains
2926  integer function vid(vname)
2927 
2928 
2929 !This section has been created automatically by the script Abilint (TD).
2930 !Do not modify the following lines by hand.
2931 #undef ABI_FUNC
2932 #define ABI_FUNC 'vid'
2933 !End of the abilint section
2934 
2935    character(len=*),intent(in) :: vname
2936    vid = nctk_idname(ncid, vname)
2937  end function vid
2938 
2939 end function ebands_ncwrite

m_ebands/ebands_ncwrite_path [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_ncwrite_path

FUNCTION

  Writes the content of an ebands_t object to a NETCDF file

INPUTS

  path=File name

OUTPUT

PARENTS

CHILDREN

SOURCE

2962 integer function ebands_ncwrite_path(ebands,path) result(ncerr)
2963 
2964 
2965 !This section has been created automatically by the script Abilint (TD).
2966 !Do not modify the following lines by hand.
2967 #undef ABI_FUNC
2968 #define ABI_FUNC 'ebands_ncwrite_path'
2969 !End of the abilint section
2970 
2971  implicit none
2972 
2973 !Arguments ------------------------------------
2974 !scalars
2975  character(len=*),intent(in) :: path
2976  type(ebands_t),intent(in) :: ebands
2977 
2978 !Local variables-------------------------------
2979 !scalars
2980  integer :: ncid
2981 
2982 ! *************************************************************************
2983 
2984  ncerr = -1
2985 #ifdef HAVE_NETCDF
2986  ncerr = nf90_noerr
2987  if (file_exists(path)) then
2988     NCF_CHECK(nctk_open_modify(ncid, path, xmpi_comm_self))
2989  else
2990    ncerr = nctk_open_create(ncid, path, xmpi_comm_self)
2991    NCF_CHECK_MSG(ncerr, sjoin("creating", path))
2992  end if
2993 
2994  NCF_CHECK(ebands_ncwrite(ebands, ncid))
2995  NCF_CHECK(nf90_close(ncid))
2996 #endif
2997 
2998 end function ebands_ncwrite_path

m_ebands/ebands_nelect_per_spin [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

  ebands_nelect_per_spin

FUNCTION

   Return number of electrons in each spin channel (computed from occoputation factors if nsppol=2)

INPUTS

  ebands<ebands_t>=The object describing the band structure.

OUTPUT

  nelect_per_spin(ebands%nsppol)=For each spin the number of electrons (eventually fractional)

PARENTS

CHILDREN

SOURCE

1891 pure function ebands_nelect_per_spin(ebands) result(nelect_per_spin)
1892 
1893 
1894 !This section has been created automatically by the script Abilint (TD).
1895 !Do not modify the following lines by hand.
1896 #undef ABI_FUNC
1897 #define ABI_FUNC 'ebands_nelect_per_spin'
1898 !End of the abilint section
1899 
1900  implicit none
1901 
1902 !Arguments ------------------------------------
1903 !scalars
1904  type(ebands_t),intent(in) :: ebands
1905 !arrays
1906  real(dp) :: nelect_per_spin(ebands%nsppol)
1907 
1908 !Local variables-------------------------------
1909 !scalars
1910  integer :: iband,ikpt,spin
1911 
1912 ! *************************************************************************
1913 
1914  nelect_per_spin = ebands%nelect
1915  if (ebands%nsppol > 1) then
1916    nelect_per_spin = zero
1917    do spin=1,ebands%nsppol
1918      do ikpt=1,ebands%nkpt
1919        do iband=1,ebands%nband(ikpt+ebands%nkpt*(spin-1))
1920          nelect_per_spin(spin) = nelect_per_spin(spin) + ebands%wtk(ikpt)*ebands%occ(iband, ikpt, spin)
1921        end do
1922      end do
1923    end do
1924  end if
1925 
1926 end function ebands_nelect_per_spin

m_ebands/ebands_print [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_print

FUNCTION

 Print the content of the object.

INPUTS

  ebands<ebands_t>The type containing the data.
  [unit]=Unit number (std_out if None)
  [header]=title for info
  [prtvol]=Verbosity level (0 if None)
  [mode_paral]=Either 'COLL' or 'PERS' ('COLL' if None).

OUTPUT

  Only writing

PARENTS

      eph,setup_bse,setup_bse_interp,wfk_analyze

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

1022 subroutine ebands_print(ebands,header,unit,prtvol,mode_paral)
1023 
1024 
1025 !This section has been created automatically by the script Abilint (TD).
1026 !Do not modify the following lines by hand.
1027 #undef ABI_FUNC
1028 #define ABI_FUNC 'ebands_print'
1029 !End of the abilint section
1030 
1031  implicit none
1032 
1033 !Arguments ------------------------------------
1034 !scalars
1035  integer,optional,intent(in) :: prtvol,unit
1036  character(len=*),optional,intent(in) :: header
1037  character(len=4),optional,intent(in) :: mode_paral
1038  type(ebands_t),intent(in) :: ebands
1039 
1040 !Local variables-------------------------------
1041  integer :: spin,ikpt,my_unt,my_prtvol,ii
1042  character(len=4) :: my_mode
1043  character(len=500) :: msg
1044 ! *************************************************************************
1045 
1046  my_unt   =std_out; if (PRESENT(unit      )) my_unt   =unit
1047  my_prtvol=0      ; if (PRESENT(prtvol    )) my_prtvol=prtvol
1048  my_mode  ='COLL' ; if (PRESENT(mode_paral)) my_mode  =mode_paral
1049 
1050  msg=' ==== Info on the ebands_t ==== '
1051  if (PRESENT(header)) msg=' ==== '//TRIM(ADJUSTL(header))//' ==== '
1052  call wrtout(my_unt,msg,my_mode)
1053 
1054  write(msg,'(6(a,i0,a))')&
1055    '  Number of spinorial components ...... ',ebands%nspinor,ch10,&
1056    '  Number of spin polarizations ........ ',ebands%nsppol,ch10,&
1057    '  Number of k-points in the IBZ ....... ',ebands%nkpt,ch10,&
1058    '  kptopt .............................. ',ebands%kptopt,ch10,&
1059    '  Maximum number of bands ............. ',ebands%mband,ch10,&
1060    '  Occupation option ................... ',ebands%occopt,ch10
1061  call wrtout(my_unt,msg,my_mode)
1062 
1063  !EBANDS_NEW
1064  !write(msg,"(a)")&
1065  !  " kptrlatt ..............................",ltoa(ebands%kptrlatt)
1066 
1067  write(msg,'(2(a,f14.2,a),4(a,f14.6,a))')&
1068    '  Number of valence electrons ......... ',ebands%nelect,ch10,&
1069    '  Extra charge ........................ ',ebands%charge,ch10,&
1070    '  Fermi level  ........................ ',ebands%fermie,ch10,&
1071    '  Entropy ............................. ',ebands%entropy,ch10,&
1072    '  Tsmear value ........................ ',ebands%tsmear,ch10,&
1073    '  Tphysel value ....................... ',ebands%tphysel,ch10
1074  call wrtout(my_unt,msg,my_mode)
1075 
1076  if (my_prtvol > 10) then
1077    if (ebands%nsppol==1)then
1078      write(msg,'(a,i0,a)')' New occ. numbers for occopt= ',ebands%occopt,' , spin-unpolarized case. '
1079      call wrtout(my_unt,msg,my_mode)
1080    end if
1081 
1082    do spin=1,ebands%nsppol
1083      if (ebands%nsppol==2) then
1084        write(msg,'(a,i4,a,i2)')' New occ. numbers for occopt= ',ebands%occopt,' spin ',spin
1085        call wrtout(my_unt,msg,my_mode)
1086      end if
1087 
1088      do ikpt=1,ebands%nkpt
1089        write(msg,'(2a,i4,a,3f12.6,a,f6.3)')ch10,&
1090          ' k-point number ',ikpt,') ',ebands%kptns(:,ikpt),'; weight: ',ebands%wtk(ikpt)
1091        call wrtout(my_unt,msg,my_mode)
1092        do ii=1,ebands%nband(ikpt+(spin-1)*ebands%nkpt)
1093          write(msg,'(3(f7.3,1x))')ebands%eig(ii,ikpt,spin)*Ha_eV,ebands%occ(ii,ikpt,spin),ebands%doccde(ii,ikpt,spin)
1094          call wrtout(my_unt,msg,my_mode)
1095        end do
1096      end do !ikpt
1097 
1098    end do !spin
1099 
1100  end if !my_prtvol
1101 
1102 end subroutine ebands_print

m_ebands/ebands_prtbltztrp [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_prtbltztrp

FUNCTION

   Output files for BoltzTraP code, which integrates Boltzmann transport quantities
   over the Fermi surface for different T and chemical potentials. Abinit provides
   all necessary input files: struct, energy, input file, and def file for the unit
   definitions of fortran files in BT.
   See http://www.icams.de/content/departments/ams/madsen/boltztrap.html

INPUTS

  ebands<ebands_t>=Band structure object.
  cryst<cryst_t>=Info on the crystalline structure.
  fname_radix = radix of file names for output

OUTPUT

  (only writing, printing)

PARENTS

      eph,outscfcv

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

4627 subroutine ebands_prtbltztrp(ebands, crystal, fname_radix, tau_k)
4628 
4629 
4630 !This section has been created automatically by the script Abilint (TD).
4631 !Do not modify the following lines by hand.
4632 #undef ABI_FUNC
4633 #define ABI_FUNC 'ebands_prtbltztrp'
4634 !End of the abilint section
4635 
4636  implicit none
4637 
4638 !Arguments ------------------------------------
4639 !scalars
4640  type(ebands_t),intent(in) :: ebands
4641  type(crystal_t),intent(in) :: crystal
4642  character(len=fnlen), intent(in) :: fname_radix
4643 !arrays
4644  real(dp), intent(in), optional :: tau_k(ebands%nsppol,ebands%nkpt,ebands%mband)
4645 
4646 !Local variables-------------------------------
4647 !scalars
4648  integer :: iout, isym, iband, isppol, ikpt, nsppol, nband
4649  real(dp),parameter :: ha2ryd=two
4650  real(dp) :: ewindow
4651  character(len=fnlen) :: filename
4652  character(len=2) :: so_suffix
4653  character(len=500) :: msg
4654 !arrays
4655  real(dp) :: nelec(ebands%nsppol)
4656  character(len=3) :: spinsuffix(ebands%nsppol)
4657 
4658 ! *************************************************************************
4659 
4660  !MG FIXME The number of electrons is wrong if the file is produced in a NSCF run.
4661  ! See https://forum.abinit.org/viewtopic.php?f=19&t=3339
4662 
4663  nelec = ebands_nelect_per_spin(ebands)
4664  nsppol = ebands%nsppol
4665  nband = ebands%nband(1)
4666 
4667  so_suffix=""
4668  if (nsppol > 1 .or. ebands%nspinor > 1) so_suffix="so"
4669 
4670  if (nsppol == 1) then
4671    spinsuffix(1) = "ns_"
4672  else
4673    spinsuffix = ["up_", "dn_"]
4674  end if
4675 
4676  do isppol=1,nsppol
4677 
4678    !input file for boltztrap: general info, Ef, Nelec, etc...
4679    filename= trim(fname_radix)//"_"//trim(spinsuffix(isppol))//"BLZTRP.intrans"
4680    if (open_file(filename, msg, newunit=iout, form='formatted') /= 0) then
4681      MSG_ERROR(msg)
4682    end if
4683 
4684    ewindow = 1.1_dp * (ebands%fermie-minval(ebands%eig(1, :, isppol)))
4685    write (iout, '(a)') "GENE                      # Format of input: generic format, with Symmetries"
4686    write (iout, '(a)') "0 0 0 0.0                 # iskip (not presently used) idebug setgap shiftgap"
4687    write (iout, '(E15.5,a,2F10.4,a)') ebands%fermie*ha2ryd, " 0.0005 ", ewindow*ha2ryd, nelec(isppol), &
4688 &   "  # Fermilevel (Ry), energy grid spacing, energy span around Fermilevel, number of electrons for this spin"
4689    write (iout, '(a)') "CALC                      # CALC (calculate expansion coeff), NOCALC read from file"
4690    write (iout, '(a)') "3                         # lpfac, number of latt-points per k-point"
4691    write (iout, '(a)') "BOLTZ                     # run mode (only BOLTZ is supported)"
4692    write (iout, '(a)') ".15                       # (efcut) energy range of chemical potential"
4693    write (iout, '(a)') "300. 10.                  # Tmax, temperature grid spacing"
4694    write (iout, '(2a)') "-1                        # energyrange of bands given ",&
4695 &   "individual DOS output sig_xxx and dos_xxx (xxx is band number)"
4696    write (iout, '(a)') "HISTO                     # DOS calculation method. Other possibility is TETRA"
4697    write (iout, '(a)') "No                        # not using model for relaxation time"
4698    write (iout, '(a)') "3                         # Number of doping levels coefficients will be output for"
4699    write (iout, '(a)') "-1.e16 0.0d0 1.e16        # Values of doping levels (in carriers / cm^3"
4700    close(iout)
4701 
4702 !files file, with association of all units for Boltztrap
4703    filename= trim(fname_radix)//"_"//trim(spinsuffix(isppol))//"BLZTRP.def"
4704    if (open_file(filename, msg, newunit=iout, form='formatted') /= 0) then
4705      MSG_ERROR(msg)
4706    end if
4707 
4708    write (iout, '(3a)') "5, '", trim(fname_radix)//"_"//trim(spinsuffix(isppol))//"BLZTRP.intrans',      'old',    'formatted',0"
4709    write (iout, '(3a)') "6, '", trim(fname_radix)//"_BLZTRP", ".outputtrans',      'unknown',    'formatted',0"
4710    write (iout, '(3a)') "20,'", trim(fname_radix)//"_BLZTRP", ".struct',         'old',    'formatted',0"
4711    write (iout, '(3a)') "10,'", trim(fname_radix)//"_BLZTRP."//trim(spinsuffix(isppol))//"energy"//trim(so_suffix),&
4712 &   "',         'old',    'formatted',0"
4713    if (present (tau_k)) then
4714      write (iout, '(3a)') "11,'", trim(fname_radix)//"_BLZTRP", ".tau_k',         'old',    'formatted',0"
4715    end if
4716    write (iout, '(3a)') "48,'", trim(fname_radix)//"_BLZTRP", ".engre',         'unknown',    'unformatted',0"
4717    write (iout, '(3a)') "49,'", trim(fname_radix)//"_BLZTRP", ".transdos',        'unknown',    'formatted',0"
4718    write (iout, '(3a)') "50,'", trim(fname_radix)//"_BLZTRP", ".sigxx',        'unknown',    'formatted',0"
4719    write (iout, '(3a)') "51,'", trim(fname_radix)//"_BLZTRP", ".sigxxx',        'unknown',    'formatted',0"
4720    write (iout, '(3a)') "21,'", trim(fname_radix)//"_BLZTRP", ".trace',           'unknown',    'formatted',0"
4721    write (iout, '(3a)') "22,'", trim(fname_radix)//"_BLZTRP", ".condtens',           'unknown',    'formatted',0"
4722    write (iout, '(3a)') "24,'", trim(fname_radix)//"_BLZTRP", ".halltens',           'unknown',    'formatted',0"
4723    write (iout, '(3a)') "25,'", trim(fname_radix)//"_BLZTRP", ".trace_fixdoping',     'unknown',    'formatted',0"
4724    write (iout, '(3a)') "26,'", trim(fname_radix)//"_BLZTRP", ".condtens_fixdoping',           'unknown',    'formatted',0"
4725    write (iout, '(3a)') "27,'", trim(fname_radix)//"_BLZTRP", ".halltens_fixdoping',           'unknown',    'formatted',0"
4726    write (iout, '(3a)') "30,'", trim(fname_radix)//"_BLZTRP", "_BZ.dx',           'unknown',    'formatted',0"
4727    write (iout, '(3a)') "31,'", trim(fname_radix)//"_BLZTRP", "_fermi.dx',           'unknown',    'formatted',0"
4728    write (iout, '(3a)') "32,'", trim(fname_radix)//"_BLZTRP", "_sigxx.dx',           'unknown',    'formatted',0"
4729    write (iout, '(3a)') "33,'", trim(fname_radix)//"_BLZTRP", "_sigyy.dx',           'unknown',    'formatted',0"
4730    write (iout, '(3a)') "34,'", trim(fname_radix)//"_BLZTRP", "_sigzz.dx',           'unknown',    'formatted',0"
4731    write (iout, '(3a)') "35,'", trim(fname_radix)//"_BLZTRP", "_band.dat',           'unknown',    'formatted',0"
4732    write (iout, '(3a)') "36,'", trim(fname_radix)//"_BLZTRP", "_band.gpl',           'unknown',    'formatted',0"
4733    write (iout, '(3a)') "37,'", trim(fname_radix)//"_BLZTRP", "_deriv.dat',           'unknown',    'formatted',0"
4734    write (iout, '(3a)') "38,'", trim(fname_radix)//"_BLZTRP", "_mass.dat',           'unknown',    'formatted',0"
4735 
4736    close(iout)
4737  end do !isppol
4738 
4739 !file is for geometry symmetries etc
4740  filename= trim(fname_radix)//"_BLZTRP.struct"
4741  if (open_file(filename, msg, newunit=iout, form='formatted') /= 0) then
4742    MSG_ERROR(msg)
4743  end if
4744 
4745  write (iout, '(a)') "BoltzTraP geometry file generated by ABINIT."
4746 
4747 !here we need to print out the unit cell vectors
4748  write (iout, '(3E20.10)') crystal%rprimd(:,1)
4749  write (iout, '(3E20.10)') crystal%rprimd(:,2)
4750  write (iout, '(3E20.10)') crystal%rprimd(:,3)
4751  write (iout, '(I7)') crystal%nsym
4752 
4753  do isym=1,crystal%nsym
4754    write (iout,'(3(3I5,2x), a, I5)') &
4755 &   crystal%symrel(1,:,isym), &
4756 &   crystal%symrel(2,:,isym), &
4757 &   crystal%symrel(3,:,isym), &
4758 &   ' ! symmetry rotation matrix isym = ', isym
4759  end do
4760 
4761  close (iout)
4762 
4763 ! second file is for eigenvalues
4764 ! two file names for each spin, if necessary
4765  do isppol=1,nsppol
4766    filename=trim(fname_radix)//"_BLZTRP."//spinsuffix(isppol)//"energy"//trim(so_suffix)
4767 
4768    if (open_file (filename, msg, newunit=iout, form='formatted') /= 0) then
4769      MSG_ERROR(msg)
4770    end if
4771 
4772    write (iout, '(a,I5)') "BoltzTraP eigen-energies file generated by ABINIT. ispin = ", isppol
4773    write (iout, '(I7, I7, E20.10, a)') &
4774 &    ebands%nkpt, nsppol, ha2ryd*ebands%fermie, '     ! nk, nspin, Fermi level(Ry) : energies below in Ry'
4775 
4776    do ikpt=1,ebands%nkpt
4777 !    these need to be in reduced coordinates
4778      write (iout, '(3E20.10, I7, a)') &
4779 &      ebands%kptns(1,ikpt), ebands%kptns(2,ikpt), ebands%kptns(3,ikpt), nband, '    ! kpt nband'
4780      do iband=1,nband
4781 !      output in Rydberg
4782        write (iout, '(E20.10)') ha2ryd*ebands%eig(iband, ikpt, isppol)
4783      end do
4784    end do
4785 
4786    close (iout)
4787  end do
4788 
4789 !this file is for tau_k
4790  if (present (tau_k)) then
4791    do isppol = 1, nsppol
4792      filename= trim(fname_radix)//"_"//spinsuffix(isppol)//"BLZTRP.tau_k"
4793      if (open_file(filename, msg, newunit=iout, form='formatted') /= 0) then
4794        MSG_ERROR(msg)
4795      end if
4796 
4797      write (iout, '(a)') "BoltzTraP tau_k file generated by ANADDB."
4798      write (iout, '(I7, I7, E20.10, a)')&
4799 &      ebands%nkpt, nsppol, ha2ryd*ebands%fermie, '     ! nk, nspin, Fermi level(Ry) : energies below in Ry'
4800 
4801      do ikpt=1,ebands%nkpt
4802 !      these need to be in reduced coordinates
4803        write (iout, '(3E20.10, I7, a)') &
4804 &        ebands%kptns(1,ikpt), ebands%kptns(2,ikpt), ebands%kptns(3,ikpt), nband, '    ! kpt nband'
4805        do iband=1,nband
4806 !        output in eV
4807          write (iout, '(E20.10)') tau_k(isppol,ikpt,iband)
4808        end do
4809      end do
4810      close (iout)
4811    end do
4812 
4813  end if
4814 
4815 end subroutine ebands_prtbltztrp

m_ebands/ebands_prtbltztrp_tau_out [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_prtbltztrp_tau_out

FUNCTION

   output files for BoltzTraP code, which integrates Boltzmann transport quantities
   over the Fermi surface for different T and chemical potentials. Abinit provides
   all necessary input files: struct, energy, input file, and def file for the unit
   definitions of fortran files in BT.
   See http://www.icams.de/content/departments/ams/madsen/boltztrap.html
   Output T-depedent tau_k, modified from ebands_prtbltztrp

INPUTS

  eigen(mband*nkpt*nsppol) = array for holding eigenvalues (hartree)
  fermie = Fermi level
  fname_radix = radix of file names for output
  natom = number of atoms in cell.
  nband = number of bands
  nkpt = number of k points.
  nsppol = 1 for unpolarized, 2 for spin-polarized
  nsym = number of symmetries in space group
  rprimd(3,3) = dimensional primitive translations for real space (bohr)
  symrel = symmetry operations in reduced coordinates, real space
  to be used in future  xred(3,natom) = reduced dimensionless atomic coordinates

OUTPUT

  (only writing, printing)

SIDE EFFECTS

PARENTS

      get_tau_k

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

4856 subroutine ebands_prtbltztrp_tau_out (eigen, tempermin, temperinc, ntemper, fermie, fname_radix, kpt, &
4857 &       natom, nband, nelec, nkpt, nspinor, nsppol, nsym, &
4858 &       rprimd, symrel, tau_k)
4859 
4860 
4861 !This section has been created automatically by the script Abilint (TD).
4862 !Do not modify the following lines by hand.
4863 #undef ABI_FUNC
4864 #define ABI_FUNC 'ebands_prtbltztrp_tau_out'
4865 !End of the abilint section
4866 
4867  implicit none
4868 
4869 !Arguments ------------------------------------
4870 !scalars
4871  integer, intent(in) :: natom, nsym, nband, nkpt, nsppol, nspinor, ntemper
4872  real(dp), intent(in) :: tempermin, temperinc
4873  real(dp), intent(in) :: nelec
4874  character(len=fnlen), intent(in) :: fname_radix
4875 !arrays
4876  real(dp), intent(in) :: fermie(ntemper)
4877  integer, intent(in) :: symrel(3,3,nsym)
4878  real(dp), intent(in) :: kpt(3,nkpt)
4879  real(dp), intent(in) :: eigen(nband, nkpt, nsppol)
4880  real(dp), intent(in) :: rprimd(3,3)
4881  real(dp), intent(in) :: tau_k(ntemper,nsppol,nkpt,nband)
4882 
4883 !Local variables-------------------------------
4884 !scalars
4885  integer :: iout, isym, iband, isppol, ikpt, itemp
4886  real(dp) :: Temp
4887  real(dp),parameter :: ha2ryd = two
4888  character(len=500) :: msg
4889  character(len=fnlen) :: filename,appendix
4890 
4891 ! *************************************************************************
4892 
4893 !input file for boltztrap: general info, Ef, Nelec, etc...
4894  do itemp = 1, ntemper
4895    write(appendix,"(i0)") itemp
4896    filename= trim(fname_radix)//"_BLZTRP.intrans_"//trim(appendix)
4897    if (open_file(filename, msg, newunit=iout, form="formatted", action="write") /= 0) then
4898      MSG_ERROR(msg)
4899    end if
4900 
4901    write (iout, '(a)') "GENE                      # Format of input: generic format, with Symmetries"
4902    write (iout, '(a)') "0 0 0 0.0                 # iskip (not presently used) idebug setgap shiftgap"
4903    write (iout, '(E15.5,a,F10.4,a)') fermie(itemp)*two, " 0.0005 0.4  ", nelec, &
4904 &   "  # Fermilevel (Ry), energy grid spacing, energy span around Fermilevel, number of electrons"
4905    write (iout, '(a)') "CALC                      # CALC (calculate expansion coeff), NOCALC read from file"
4906    write (iout, '(a)') "3                         # lpfac, number of latt-points per k-point"
4907    write (iout, '(a)') "BOLTZ                     # run mode (only BOLTZ is supported)"
4908    write (iout, '(a)') ".15                       # (efcut) energy range of chemical potential"
4909    write (iout, '(2f8.2,a)')&
4910 &   tempermin+temperinc*dble(itemp),tempermin+temperinc*dble(itemp), "                  # Tmax, temperature grid spacing"
4911    write (iout, '(2a)') "-1                        # energyrange of bands given ",&
4912 &   "individual DOS output sig_xxx and dos_xxx (xxx is band number)"
4913    write (iout, '(a)') "TETRA                     # DOS calculation method. Other possibility is TETRA"
4914    write (iout, '(a)') "No                        # not using model for relaxation time"
4915    write (iout, '(a)') "3                         # Number of doping levels coefficients will be output for"
4916    write (iout, '(a)') "-1.e16 0.0d0 1.e16        # Values of doping levels (in carriers / cm^3"
4917    close(iout)
4918  end do
4919 
4920 !files file, with association of all units for Boltztrap
4921  filename= trim(fname_radix)//"_BLZTRP.def"
4922  if (open_file(filename, msg, newunit=iout, form="formatted", action="write") /= 0) then
4923    MSG_ERROR(msg)
4924  end if
4925  write (iout, '(3a)') "5, '", trim(fname_radix)//"_BLZTRP", ".intrans',      'old',    'formatted',0"
4926  write (iout, '(3a)') "6, '", trim(fname_radix)//"_BLZTRP", ".outputtrans',      'unknown',    'formatted',0"
4927  write (iout, '(3a)') "20,'", trim(fname_radix)//"_BLZTRP", ".struct',         'old',    'formatted',0"
4928  if (nspinor == 1) then
4929    write (iout, '(3a)') "10,'", trim(fname_radix)//"_BLZTRP", ".energy',         'old',    'formatted',0"
4930  else if (nspinor == 2) then
4931    write (iout, '(3a)') "10,'", trim(fname_radix)//"_BLZTRP", ".energyso',         'old',    'formatted',0"
4932  end if
4933  write (iout, '(3a)') "10,'", trim(fname_radix)//"_BLZTRP", ".energy',         'old',    'formatted',0"
4934  write (iout, '(3a)') "11,'", trim(fname_radix)//"_BLZTRP", ".tau_k',         'old',    'formatted',0"
4935  write (iout, '(3a)') "48,'", trim(fname_radix)//"_BLZTRP", ".engre',         'unknown',    'unformatted',0"
4936  write (iout, '(3a)') "49,'", trim(fname_radix)//"_BLZTRP", ".transdos',        'unknown',    'formatted',0"
4937  write (iout, '(3a)') "50,'", trim(fname_radix)//"_BLZTRP", ".sigxx',        'unknown',    'formatted',0"
4938  write (iout, '(3a)') "51,'", trim(fname_radix)//"_BLZTRP", ".sigxxx',        'unknown',    'formatted',0"
4939  write (iout, '(3a)') "21,'", trim(fname_radix)//"_BLZTRP", ".trace',           'unknown',    'formatted',0"
4940  write (iout, '(3a)') "22,'", trim(fname_radix)//"_BLZTRP", ".condtens',           'unknown',    'formatted',0"
4941  write (iout, '(3a)') "24,'", trim(fname_radix)//"_BLZTRP", ".halltens',           'unknown',    'formatted',0"
4942  write (iout, '(3a)') "25,'", trim(fname_radix)//"_BLZTRP", ".trace_fixdoping',     'unknown',    'formatted',0"
4943  write (iout, '(3a)') "26,'", trim(fname_radix)//"_BLZTRP", ".condtens_fixdoping',           'unknown',    'formatted',0"
4944  write (iout, '(3a)') "27,'", trim(fname_radix)//"_BLZTRP", ".halltens_fixdoping',           'unknown',    'formatted',0"
4945  write (iout, '(3a)') "30,'", trim(fname_radix)//"_BLZTRP", "_BZ.dx',           'unknown',    'formatted',0"
4946  write (iout, '(3a)') "31,'", trim(fname_radix)//"_BLZTRP", "_fermi.dx',           'unknown',    'formatted',0"
4947  write (iout, '(3a)') "32,'", trim(fname_radix)//"_BLZTRP", "_sigxx.dx',           'unknown',    'formatted',0"
4948  write (iout, '(3a)') "33,'", trim(fname_radix)//"_BLZTRP", "_sigyy.dx',           'unknown',    'formatted',0"
4949  write (iout, '(3a)') "34,'", trim(fname_radix)//"_BLZTRP", "_sigzz.dx',           'unknown',    'formatted',0"
4950  write (iout, '(3a)') "35,'", trim(fname_radix)//"_BLZTRP", "_band.dat',           'unknown',    'formatted',0"
4951  write (iout, '(3a)') "36,'", trim(fname_radix)//"_BLZTRP", "_band.gpl',           'unknown',    'formatted',0"
4952  write (iout, '(3a)') "37,'", trim(fname_radix)//"_BLZTRP", "_deriv.dat',           'unknown',    'formatted',0"
4953  write (iout, '(3a)') "38,'", trim(fname_radix)//"_BLZTRP", "_mass.dat',           'unknown',    'formatted',0"
4954  close(iout)
4955 
4956 !file is for geometry symmetries etc
4957  filename= trim(fname_radix)//"_BLZTRP.struct"
4958  if (open_file(filename, msg, newunit=iout, form="formatted", action="write") /= 0) then
4959    MSG_ERROR(msg)
4960  end if
4961  write (iout, '(a)') "BoltzTraP geometry file generated by ABINIT."
4962 
4963 !here we need to print out the unit cell vectors
4964  write (iout, '(3E20.10)') rprimd(:,1)
4965  write (iout, '(3E20.10)') rprimd(:,2)
4966  write (iout, '(3E20.10)') rprimd(:,3)
4967  write (iout, '(I7)') nsym
4968 
4969  do isym=1, nsym
4970    write (iout,'(3(3I5,2x), a, I5)') &
4971 &   symrel(1,:,isym), &
4972 &   symrel(2,:,isym), &
4973 &   symrel(3,:,isym), &
4974 &   ' ! symmetry rotation matrix isym = ', isym
4975  end do
4976  close (iout)
4977 
4978 !second file is for eigenvalues
4979  if (nspinor == 1) then
4980    filename= trim(fname_radix)//"_BLZTRP.energy"
4981  else if (nspinor == 2) then
4982    filename= trim(fname_radix)//"_BLZTRP.energyso"
4983  end if
4984 
4985  if (open_file(filename, msg, newunit=iout, form="formatted", action="write") /= 0) then
4986    MSG_ERROR(msg)
4987  end if
4988  write (iout, '(a)') "BoltzTraP eigen-energies file generated by ABINIT."
4989  write (iout, '(I7, I7, E20.10, a)') nkpt, nsppol, ha2ryd*fermie(1), '     ! nk, nspin, Fermi level(Ry) : energies below in Ry'
4990  do isppol = 1, nsppol
4991    do ikpt = 1, nkpt
4992 !    these need to be in reduced coordinates
4993      write (iout, '(3E20.10, I7, a)') kpt(1,ikpt), kpt(2,ikpt), kpt(3,ikpt), nband, '    ! kpt nband'
4994      do iband = 1, nband
4995 !      output in eV
4996        write (iout, '(E20.10)') ha2ryd*eigen(iband, ikpt, isppol)
4997      end do
4998    end do
4999  end do
5000  close (iout)
5001 
5002 !this file is for tau_k
5003  do itemp = 1, ntemper
5004    Temp=tempermin+temperinc*dble(itemp)
5005 
5006    write(appendix,"(i0)") itemp
5007    filename= trim(fname_radix)//"_BLZTRP.tau_k_"//trim(appendix)
5008    if (open_file(filename, msg, newunit=iout, form="formatted", action="write") /= 0) then
5009      MSG_ERROR(msg)
5010    end if
5011    write (iout, '(a,f12.6)') "BoltzTraP tau_k file generated by ANADDB for T= ", Temp
5012    write (iout, '(I7, I7, E20.10, a)') nkpt, nsppol, ha2ryd*fermie(itemp), &
5013    '     ! nk, nspin, Fermi level(Ry) : energies below in Ry'
5014    do isppol = 1, nsppol
5015      do ikpt = 1, nkpt
5016 !      these need to be in reduced coordinates
5017        write (iout, '(3E20.10, I7, a)') kpt(1,ikpt), kpt(2,ikpt), kpt(3,ikpt), nband, '    ! kpt nband'
5018        do iband = 1, nband
5019 !        output in sec
5020          write (iout, '(E20.10)') tau_k(itemp,isppol,ikpt,iband)
5021        end do
5022      end do
5023    end do
5024    close (iout)
5025  end do
5026 
5027 end subroutine ebands_prtbltztrp_tau_out

m_ebands/ebands_report_gap [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_report_gap

FUNCTION

  Print info on the fundamental and optical gap.

INPUTS

  ebands<ebands_t>=Info on the band structure, the smearing technique and the physical temperature used.
  [header]=Optional title.
  [kmask]=Logical mask used to exclude k-points.
  [unit]=Optional unit for output (std_out if not specified)
  [mode_paral]=Either "COLL" or "PERS", former is default.

OUTPUT

  writing.
  [gaps(3,nsppol)]=Fundamental and optical gaps. The third index corresponds to a "status":
      0.0dp if gaps were not computed (because there are only valence bands);
     -1.0dp if the system (or spin-channel) is metallic;
      1.0dp if the gap has been computed.

PARENTS

      gstate,m_exc_diago,m_sigmaph,setup_bse,setup_bse_interp,setup_sigma
      sigma

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

2637 subroutine ebands_report_gap(ebands,header,kmask,unit,mode_paral,gaps)
2638 
2639 
2640 !This section has been created automatically by the script Abilint (TD).
2641 !Do not modify the following lines by hand.
2642 #undef ABI_FUNC
2643 #define ABI_FUNC 'ebands_report_gap'
2644 !End of the abilint section
2645 
2646  implicit none
2647 
2648 !Arguments ------------------------------------
2649 !scalars
2650  integer,intent(in),optional :: unit
2651  character(len=4),intent(in),optional :: mode_paral
2652  character(len=*),intent(in),optional :: header
2653  type(ebands_t),intent(in)  :: ebands
2654 !arrays
2655  real(dp),optional,intent(out) :: gaps(3,ebands%nsppol)
2656  logical,optional,intent(in) ::  kmask(ebands%nkpt)
2657 
2658 !Local variables-------------------------------
2659 !scalars
2660  integer :: ikibz,nband_k,spin,nsppol,ikopt,ivk,ick,ivb,icb,my_unt,first
2661  real(dp),parameter :: tol_fermi=tol6
2662  real(dp) :: fun_gap,opt_gap
2663  logical :: ismetal
2664  character(len=4) :: my_mode
2665  character(len=500) :: msg
2666 !arrays
2667  integer :: val_idx(ebands%nkpt,ebands%nsppol)
2668  real(dp) :: top_valence(ebands%nkpt),bot_conduct(ebands%nkpt)
2669  logical :: my_kmask(ebands%nkpt)
2670 
2671 ! *********************************************************************
2672 
2673  nsppol = ebands%nsppol
2674 
2675  my_unt =std_out; if (PRESENT(unit      )) my_unt =unit
2676  my_mode='COLL' ; if (PRESENT(mode_paral)) my_mode=mode_paral
2677  my_kmask=.TRUE.; if (PRESENT(kmask     )) my_kmask=kmask
2678 
2679  if (PRESENT(gaps)) gaps=zero
2680 
2681  val_idx(:,:) = get_valence_idx(ebands,tol_fermi)
2682  first=0
2683 
2684 !Initialize the return status for the gaps
2685  if (PRESENT(gaps)) gaps(1:3,1:nsppol)=zero
2686 
2687  do spin=1,nsppol
2688 
2689    ! No output if system i metallic
2690    ismetal=ANY(val_idx(:,spin)/=val_idx(1,spin))
2691    if (ismetal) then
2692      if (PRESENT(gaps)) gaps(3,nsppol)=-one
2693      CYCLE
2694    endif
2695 
2696    first=first+1
2697    if (first==1) then
2698      msg=ch10
2699      if (PRESENT(header)) msg=ch10//' === '//TRIM(ADJUSTL(header))//' === '
2700      call wrtout(my_unt,msg,my_mode)
2701    end if
2702 
2703    ivb=val_idx(1,spin)
2704    icb=ivb+1
2705 
2706    do ikibz=1,ebands%nkpt
2707      if (.not.my_kmask(ikibz)) CYCLE
2708      nband_k = ebands%nband(ikibz+(spin-1)*ebands%nkpt)
2709      top_valence(ikibz) = ebands%eig(ivb,ikibz,spin)
2710      if (icb>nband_k) then
2711        GOTO 10 ! Only occupied states are present, no output!
2712      endif
2713      bot_conduct(ikibz) = ebands%eig(icb,ikibz,spin)
2714    end do
2715 
2716    ! === Get minimum of the optical Gap ===
2717    ikopt= imin_loc(bot_conduct-top_valence,MASK=my_kmask)
2718    opt_gap=bot_conduct(ikopt)-top_valence(ikopt)
2719 
2720    ! === Get fundamental Gap ===
2721    ick = imin_loc(bot_conduct,MASK=my_kmask)
2722    ivk = imax_loc(top_valence,MASK=my_kmask)
2723    fun_gap = ebands%eig(icb,ick,spin)-ebands%eig(ivb,ivk,spin)
2724 
2725    write(msg,'(a,i2,a,2(a,f8.4,a,3f8.4,a),33x,a,3f8.4)')&
2726 &    '  >>>> For spin ',spin,ch10,&
2727 &    '   Minimum optical gap = ',opt_gap*Ha_eV,' [eV], located at k-point      : ',ebands%kptns(:,ikopt),ch10,&
2728 &    '   Fundamental gap     = ',fun_gap*Ha_eV,' [eV], Top of valence bands at : ',ebands%kptns(:,ivk),ch10,  &
2729 &                                              '       Bottom of conduction at : ',ebands%kptns(:,ick)
2730    call wrtout(my_unt,msg,my_mode)
2731 
2732    if (PRESENT(gaps)) then
2733      gaps(:,spin) = (/fun_gap,opt_gap,one/)
2734    end if
2735 
2736  end do !spin
2737 
2738  return
2739 
2740  10 continue
2741  call wrtout(std_out, "Not enough states to calculate the band gap.", "COLL")
2742 
2743 end subroutine ebands_report_gap

m_ebands/ebands_set_fermie [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_set_fermie

FUNCTION

 Set the new Fermi level from eigenenergies eigen and change the number of electrons
 Compute also new occupation numbers at each k point, from eigenenergies eigen, according to the
 smearing scheme defined by occopt (and smearing width tsmear or tphysel) as well as
 entropy and derivative of occupancies wrt the energy for each band and k point.

INPUTS

 fermie=New fermi level

OUTPUT

 msg=String describing the changes in fermie and nelect.

NOTES

 The routine assumes metallic occupation scheme and will abort it this condition is not satisfied.
 Use ebands_set_scheme before calling this routine, if you have a semiconductor.

PARENTS

      eph

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

2466 subroutine ebands_set_fermie(ebands, fermie, msg)
2467 
2468 
2469 !This section has been created automatically by the script Abilint (TD).
2470 !Do not modify the following lines by hand.
2471 #undef ABI_FUNC
2472 #define ABI_FUNC 'ebands_set_fermie'
2473 !End of the abilint section
2474 
2475  implicit none
2476 
2477 !Arguments ------------------------------------
2478 !scalars
2479  type(ebands_t),intent(inout) :: ebands
2480  real(dp),intent(in) :: fermie
2481  character(len=*),intent(out) :: msg
2482 
2483 !Local variables-------------------------------
2484 !scalars
2485  integer,parameter :: option1=1,unitdos0=0
2486  integer :: mband,nkpt,nsppol
2487  real(dp),parameter :: dosdeltae0=zero
2488  real(dp) :: prev_fermie,prev_nelect,maxocc
2489 !arrays
2490  real(dp),allocatable :: doccde(:),occ(:),eigen(:)
2491 
2492 ! *************************************************************************
2493 
2494  if (ebands_has_metal_scheme(ebands)) then
2495    msg = "set_fermie assumes a metallic occupation scheme. Use ebands_set_scheme before calling ebands_set_ferme!"
2496    MSG_ERROR(msg)
2497  end if
2498 
2499  prev_fermie = ebands%fermie; prev_nelect = ebands%nelect
2500 
2501  ! newocc assumes eigenvalues and occupations packed in 1d-vector!!
2502  mband  = ebands%mband
2503  nkpt   = ebands%nkpt
2504  nsppol = ebands%nsppol
2505  maxocc = two/(nsppol*ebands%nspinor)
2506 
2507  ABI_MALLOC(eigen,(mband*nkpt*nsppol))
2508  call get_eneocc_vect(ebands,'eig',eigen)
2509  ABI_MALLOC(occ,(mband*nkpt*nsppol))
2510  ABI_MALLOC(doccde,(mband*nkpt*nsppol))
2511 
2512  ! Get the total number of electrons nelect, given the new fermi energy.
2513  call getnel(doccde,dosdeltae0,eigen,ebands%entropy,fermie,maxocc,mband,ebands%nband,&
2514    ebands%nelect,nkpt,nsppol,occ,ebands%occopt,option1,ebands%tphysel,ebands%tsmear,unitdos0,ebands%wtk)
2515 
2516  ! Save changes in ebands%.
2517  ebands%fermie = fermie
2518  call put_eneocc_vect(ebands,'occ'   ,occ)
2519  call put_eneocc_vect(ebands,'doccde',doccde)
2520  ABI_FREE(eigen)
2521  ABI_FREE(occ)
2522  ABI_FREE(doccde)
2523 
2524  write(msg,"(2(a,es16.6),a,2(a,es16.6))")&
2525    " Old fermi level: ",prev_fermie,", with nelect: ",prev_nelect,ch10,&
2526    " New fermi level: ",ebands%fermie,", with nelect: ",ebands%nelect
2527 
2528 end subroutine ebands_set_fermie

m_ebands/ebands_set_nelect [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_set_nelect

FUNCTION

 Set the new number of electrons. recompute Fermi level from eigenenergies
 and new occupation numbers according to the smearing scheme defined by occopt
 (and smearing width tsmear or tphysel) as well as
 entropy and derivative of occupancies wrt the energy for each band and k point.

INPUTS

  nelect=New number of electrons
  spinmagntarget=if differ from -99.99d0, fix the spin polarization (in Bohr magneton)
  [prtvol]=Verbosity level

OUTPUT

 msg=String describing the changes in fermie and nelect.

NOTES

 The routine assumes metallic occupation scheme and will abort it this condition is not satisfied.
 Use ebands_set_scheme before calling this routine, if you have a semiconductor.

PARENTS

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

2562 subroutine ebands_set_nelect(ebands, nelect, spinmagntarget, msg, prtvol)
2563 
2564 
2565 !This section has been created automatically by the script Abilint (TD).
2566 !Do not modify the following lines by hand.
2567 #undef ABI_FUNC
2568 #define ABI_FUNC 'ebands_set_nelect'
2569 !End of the abilint section
2570 
2571  implicit none
2572 
2573 !Arguments ------------------------------------
2574 !scalars
2575  type(ebands_t),intent(inout) :: ebands
2576  integer,optional,intent(in) :: prtvol
2577  real(dp),intent(in) :: nelect,spinmagntarget
2578  character(len=*),intent(out) :: msg
2579 
2580 !Local variables-------------------------------
2581 !scalars
2582  integer :: my_prtvol
2583  real(dp) :: prev_fermie,prev_nelect
2584 
2585 ! *************************************************************************
2586 
2587  my_prtvol = 0; if (present(prtvol)) my_prtvol = prtvol
2588 
2589  if (.not. ebands_has_metal_scheme(ebands)) then
2590    msg = "set_nelect assumes a metallic occupation scheme. Use ebands_set_scheme!"
2591    MSG_ERROR(msg)
2592  end if
2593 
2594  prev_fermie = ebands%fermie; prev_nelect = ebands%nelect
2595  ebands%nelect = nelect
2596  call ebands_update_occ(ebands,spinmagntarget,prtvol=my_prtvol)
2597 
2598  write(msg,"(2(a,es16.6),a,2(a,es16.6))")&
2599    "Old fermi level: ",prev_fermie,", with nelect: ",prev_nelect,ch10,&
2600    "New fermi level: ",ebands%fermie,", with nelect: ",ebands%nelect
2601 
2602 end subroutine ebands_set_nelect

m_ebands/ebands_set_scheme [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_set_scheme

FUNCTION

 Set the occupation scheme and re-calculate new occupation numbers,
 the Fermi level and the Max occupied band index for each spin channel starting
 from the the knowledge of eigenvalues. See ebands_update_occ for more info.

INPUTS

 occopt=Occupation options (see input variable)
 tsmear=Temperature of smearing.
 spinmagntarget=if differ from -99.99d0, fix the spin polarization (in Bohr magneton)
 [prtvol]=Verbosity level (0 for lowest level)

SIDE EFFECTS

 ebands<ebands_t>=Info on the band structure, see above for side effects

PARENTS

      eph,m_sigmaph

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

2393 subroutine ebands_set_scheme(ebands,occopt,tsmear,spinmagntarget,prtvol)
2394 
2395 
2396 !This section has been created automatically by the script Abilint (TD).
2397 !Do not modify the following lines by hand.
2398 #undef ABI_FUNC
2399 #define ABI_FUNC 'ebands_set_scheme'
2400 !End of the abilint section
2401 
2402  implicit none
2403 
2404 !Arguments ------------------------------------
2405 !scalars
2406  type(ebands_t),intent(inout) :: ebands
2407  integer,intent(in) :: occopt
2408  integer,optional,intent(in) :: prtvol
2409  real(dp),intent(in) :: tsmear,spinmagntarget
2410 
2411 !Local variables-------------------------------
2412 !scalars
2413  real(dp),parameter :: stmbias0=zero
2414  integer :: my_prtvol
2415 
2416 ! *************************************************************************
2417 
2418  my_prtvol = 0; if (present(prtvol)) my_prtvol = prtvol
2419  ebands%occopt = occopt; ebands%tsmear = tsmear
2420 
2421  if (prtvol > 10) then
2422    call wrtout(std_out, "Changing occupation scheme in electron bands")
2423    call wrtout(std_out, sjoin("occopt:", itoa(ebands%occopt), " ==> ", itoa(occopt)))
2424    call wrtout(std_out, sjoin("tsmear:", ftoa(ebands%tsmear), " ==> ", ftoa(tsmear)))
2425  end if
2426 
2427  call ebands_update_occ(ebands,spinmagntarget,stmbias0,prtvol=my_prtvol)
2428 
2429  if (prtvol > 10) then
2430    call wrtout(std_out, sjoin('Fermi level is now:', ftoa(ebands%fermie)))
2431  end if
2432 
2433 end subroutine ebands_set_scheme

m_ebands/ebands_update_occ [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_update_occ

FUNCTION

 Calculate new occupation numbers, the Fermi level and the Max occupied band index
 for each spin channel starting from the the knowledge of eigenvalues.

INPUTS

  spinmagntarget=if differ from -99.99d0, fix the spin polarization (in Bohr magneton)
  [stmbias]=
  [prtvol]=Verbosity level (0 for lowest level)
  ebands<ebands_t>=Info on the band structure, the smearing technique and the physical temperature used.

OUTPUT

  see also SIDE EFFECTS.

SIDE EFFECTS

  === For metallic occupation the following quantites are recalculated ===
   %fermie=the new Fermi energy
   %entropy=the new entropy associated with the smearing.
   %occ(mband,nkpt,nsppol)=occupation numbers
   %doccde(mband,nkpt,nsppol)=derivative of occupancies wrt the energy for each band and k point
  === In case of semiconductors ===
   All the quantitities in ebands are left unchanged with the exception of:
   %fermie=Redefined so that it is in the middle of the gap
   %entropy=Set to zero

PARENTS

      bethe_salpeter,elphon,eph,get_nv_fs_temp,get_tau_k,m_ebands,optic
      screening,setup_bse,setup_bse_interp,setup_sigma,sigma

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

2212 subroutine ebands_update_occ(ebands,spinmagntarget,stmbias,prtvol)
2213 
2214 
2215 !This section has been created automatically by the script Abilint (TD).
2216 !Do not modify the following lines by hand.
2217 #undef ABI_FUNC
2218 #define ABI_FUNC 'ebands_update_occ'
2219 !End of the abilint section
2220 
2221  implicit none
2222 
2223 !Arguments ------------------------------------
2224 !scalars
2225  type(ebands_t),intent(inout) :: ebands
2226  integer,optional,intent(in) :: prtvol
2227  real(dp),intent(in) :: spinmagntarget
2228  real(dp),optional,intent(in) :: stmbias
2229 
2230 !Local variables-------------------------------
2231 !scalars
2232  integer :: band,mband,ikibz,nkpt,spin,nsppol,my_prtvol,nband_k
2233  real(dp) :: entropy,fermie,stmbias_local,ndiff,cbot,vtop,maxocc
2234  character(len=500) :: msg
2235 !arrays
2236  real(dp) :: nelect_spin(ebands%nsppol),condbottom(ebands%nsppol),valencetop(ebands%nsppol)
2237  real(dp),allocatable :: doccde(:),occ(:),eigen(:)
2238 
2239 ! *************************************************************************
2240 
2241  my_prtvol=0; if (PRESENT(prtvol )) my_prtvol=prtvol
2242  stmbias_local=zero; if (PRESENT(stmbias)) stmbias_local=stmbias
2243 
2244  if (ebands_has_metal_scheme(ebands)) then
2245    !  If occupation is metallic have to compute new occupation numbers.
2246    if (my_prtvol > 10) then
2247      write(msg,'(a,f9.5)')' metallic scheme, calling newocc with spinmagntarget = ',spinmagntarget
2248      call wrtout(std_out,msg,'COLL')
2249    end if
2250 
2251    ! newocc assumes eigenvalues and occupations packed in 1d-vector!!
2252    mband  = ebands%mband
2253    nkpt   = ebands%nkpt
2254    nsppol = ebands%nsppol
2255 
2256    ABI_MALLOC(eigen,(mband*nkpt*nsppol))
2257    call get_eneocc_vect(ebands,'eig',eigen)
2258 
2259    ABI_MALLOC(occ,(mband*nkpt*nsppol))
2260    ABI_MALLOC(doccde,(mband*nkpt*nsppol))
2261 
2262    call newocc(doccde,eigen,entropy,fermie,spinmagntarget,mband,ebands%nband,&
2263 &    ebands%nelect,ebands%nkpt,ebands%nspinor,ebands%nsppol,occ,ebands%occopt,&
2264 &    my_prtvol,stmbias_local,ebands%tphysel,ebands%tsmear,ebands%wtk)
2265 
2266    ! Save output in ebands%.
2267    ebands%entropy = entropy
2268    ebands%fermie  = fermie
2269    call put_eneocc_vect(ebands,'occ'   ,occ)
2270    call put_eneocc_vect(ebands,'doccde',doccde)
2271    ABI_FREE(eigen)
2272    ABI_FREE(occ)
2273    ABI_FREE(doccde)
2274 
2275  else
2276    !  Semiconductor or Insulator.
2277    !
2278    ! FIXME here there is an inconsistency btw GW and Abinit
2279    ! In abinit Fermi is set to HOMO while in GW fermi is in the middle
2280    ! of Gap. In case of crystal systems, the later convention should be preferable.
2281    ! Anyway we have to decide and follow a unique convention to avoid problems.
2282    !
2283    ! occupation factors MUST be initialized
2284    if (ALL(ABS(ebands%occ) < tol6)) then
2285      msg = "occupation factors are not initialized, likely due to the use of iscf=-2"
2286      MSG_ERROR(msg)
2287    end if
2288 
2289    maxocc=two/(ebands%nsppol*ebands%nspinor)
2290 
2291    ! * Calculate the valence index for each spin channel.
2292    do spin=1,ebands%nsppol
2293      valencetop(spin)= smallest_real
2294      condbottom(spin)= greatest_real
2295 
2296      do ikibz=1,ebands%nkpt
2297        nband_k=ebands%nband(ikibz+(spin-1)*ebands%nkpt)
2298        do band=1,nband_k
2299          if (ebands%occ(band,ikibz,spin)/maxocc>one-tol6 .and. valencetop(spin)<ebands%eig(band,ikibz,spin)) then
2300            valencetop(spin)=ebands%eig(band,ikibz,spin)
2301          end if
2302          if (ebands%occ(band,ikibz,spin)/maxocc<tol6 .and. condbottom(spin)>ebands%eig(band,ikibz,spin)) then
2303            condbottom(spin)=ebands%eig(band,ikibz,spin)
2304          end if
2305        end do
2306      end do
2307 
2308    end do
2309 
2310    vtop=MAXVAL(valencetop)
2311    cbot=MINVAL(condbottom)
2312 
2313    write(msg,'(a,f6.2,2a,f6.2)')&
2314 &    ' top of valence       [eV] ',vtop*Ha_eV,ch10,&
2315 &    ' bottom of conduction [eV] ',cbot*Ha_eV
2316    call wrtout(std_out,msg,'COLL')
2317    if (ebands%nsppol==2) then
2318      if (ABS(vtop-MINVAL(valencetop))>tol6) then
2319        write(msg,'(a,i2)')' top of valence is spin ',MAXLOC(valencetop)
2320        call wrtout(std_out,msg,'COLL')
2321      end if
2322      if (ABS(cbot-MAXVAL(condbottom))>tol6) then
2323        write(msg,'(a,i2)')' bottom of conduction is spin ',MINLOC(condbottom)
2324        call wrtout(std_out,msg,'COLL')
2325      end if
2326    end if
2327 
2328    ! === Save output ===
2329    ! Here I dont know if it is better to be consistent with the abinit convention i.e fermi=vtop
2330    ebands%entropy=zero
2331    ebands%fermie=(vtop+cbot)/2
2332    if (ABS(cbot-vtop)<1.d-4) ebands%fermie=vtop ! To avoid error on the last digit FIXME is it really needed
2333  end if
2334 
2335  write(msg,'(a,f6.2,a)')' Fermi energy         [eV] ',ebands%fermie*Ha_eV,ch10
2336  call wrtout(std_out,msg,'COLL')
2337  !
2338  ! === Compute number of electrons for each spin channel ===
2339  nelect_spin(:)=zero
2340  do spin=1,ebands%nsppol
2341    do ikibz=1,ebands%nkpt
2342      nband_k=ebands%nband(ikibz+(spin-1)*ebands%nkpt)
2343      nelect_spin(spin)= nelect_spin(spin) + ebands%wtk(ikibz)*SUM(ebands%occ(1:nband_k,ikibz,spin))
2344    end do
2345  end do
2346 
2347  ndiff=ebands%nelect-SUM(nelect_spin)
2348  if (my_prtvol>0) then
2349    write(msg,'(2a,f6.2,2a,f7.4)')ch10,&
2350 &    ' total number of electrons = ',SUM(nelect_spin),ch10,&
2351 &    ' input and calculated no. of electrons differ by ',ndiff
2352    call wrtout(std_out,msg,'COLL')
2353  end if
2354 
2355  if (ABS(ndiff)>5.d-2*ebands%nelect) then
2356    write(msg,'(2a,2(a,es12.4))')&
2357     'Too large difference in no. of electrons:,',ch10,&
2358     'Expected= ',ebands%nelect,' Calculated= ',sum(nelect_spin)
2359    MSG_ERROR(msg)
2360  end if
2361 
2362 end subroutine ebands_update_occ

m_ebands/ebands_write [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_write

FUNCTION

  Driver routine to write bands in different (txt) formats.
  This routine should be called by a single processor.

INPUTS

  prtebands=Flag seleecting the output format:
    0 --> None
    1 --> xmgrace
    2 --> gnuplot     (not coded yet)
    3 --> EIG format  (not coded yet)
  prefix=Prefix for output filename.
  [kptbounds(:,:)]=Optional argument giving the extrema of the k-path.

OUTPUT

  Only writing.

PARENTS

      eph,m_ebands,outscfcv

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

5060 subroutine ebands_write(ebands, prtebands, prefix, kptbounds)
5061 
5062 
5063 !This section has been created automatically by the script Abilint (TD).
5064 !Do not modify the following lines by hand.
5065 #undef ABI_FUNC
5066 #define ABI_FUNC 'ebands_write'
5067 !End of the abilint section
5068 
5069  implicit none
5070 
5071 !Arguments ------------------------------------
5072 !scalars
5073  integer,intent(in) :: prtebands
5074  type(ebands_t),intent(in) :: ebands
5075  character(len=*),intent(in) :: prefix
5076  real(dp),optional,intent(in) :: kptbounds(:,:)
5077 
5078 ! *********************************************************************
5079 
5080  select case (prtebands)
5081  case (0)
5082     return
5083  case (1)
5084    if (present(kptbounds)) then
5085      call ebands_write_xmgrace(ebands, strcat(prefix, "_EBANDS.agr"), kptbounds=kptbounds)
5086    else
5087      call ebands_write_xmgrace(ebands, strcat(prefix, "_EBANDS.agr"))
5088    end if
5089  case (2)
5090    if (present(kptbounds)) then
5091      call ebands_write_gnuplot(ebands, prefix, kptbounds=kptbounds)
5092    else
5093      call ebands_write_gnuplot(ebands, prefix)
5094    end if
5095  !case (3)
5096  !  call ebands_write_eigfile(ebands, strcat(prefix, "_EIG"))
5097  case default
5098    MSG_WARNING(sjoin("Unsupported value for prtebands:", itoa(prtebands)))
5099  end select
5100 
5101 end subroutine ebands_write

m_ebands/ebands_write_bxsf [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

  ebands_write_bxsf

FUNCTION

  Write 3D energies for Fermi surface visualization (XSF format)

INPUTS

  ebands<ebands_t>=The object describing the band structure.
  crystal<crystal_t>=Info on unit cell and symmetries.
  fname=File name for output.

OUTPUT

  ierr=Status error.

SIDE EFFECTS

  Produce BXSF file.

PARENTS

CHILDREN

SOURCE

2142 integer function ebands_write_bxsf(ebands, crystal, fname) result(ierr)
2143 
2144 
2145 !This section has been created automatically by the script Abilint (TD).
2146 !Do not modify the following lines by hand.
2147 #undef ABI_FUNC
2148 #define ABI_FUNC 'ebands_write_bxsf'
2149 !End of the abilint section
2150 
2151  implicit none
2152 
2153 !Arguments ------------------------------------
2154 !scalars
2155  character(len=*),intent(in) :: fname
2156  type(ebands_t),intent(in) :: ebands
2157  type(crystal_t),intent(in) :: crystal
2158 
2159 !Local variables-------------------------------
2160  logical :: use_timrev
2161 
2162 ! *************************************************************************
2163 
2164  use_timrev = (crystal%timrev==2)
2165 
2166  call printbxsf(ebands%eig,zero,ebands%fermie,crystal%gprimd,ebands%kptrlatt,ebands%mband,&
2167    ebands%nkpt,ebands%kptns,crystal%nsym,crystal%use_antiferro,crystal%symrec,crystal%symafm,&
2168    use_timrev,ebands%nsppol,ebands%shiftk,ebands%nshiftk,fname,ierr)
2169 
2170 end function ebands_write_bxsf

m_ebands/ebands_write_gnuplot [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_write_gnuplot

FUNCTION

  Write bands in gnuplot format. This routine should be called by a single processor.
  Use the driver `ebands_write` to support different formats.

INPUTS

  prefix=prefix for files (.data, .gnuplot)
  [kptbounds(:,:)]=Optional argument giving the extrema of the k-path.

OUTPUT

  Only writing

PARENTS

      m_ebands

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

5271 subroutine ebands_write_gnuplot(ebands, prefix, kptbounds)
5272 
5273 
5274 !This section has been created automatically by the script Abilint (TD).
5275 !Do not modify the following lines by hand.
5276 #undef ABI_FUNC
5277 #define ABI_FUNC 'ebands_write_gnuplot'
5278 !End of the abilint section
5279 
5280  implicit none
5281 
5282 !Arguments ------------------------------------
5283 !scalars
5284  type(ebands_t),intent(in) :: ebands
5285  character(len=*),intent(in) :: prefix
5286  real(dp),optional,intent(in) :: kptbounds(:,:)
5287 
5288 !Local variables-------------------------------
5289 !scalars
5290  integer :: unt,gpl_unt,ik,spin,ii,start,nkbounds
5291  character(len=500) :: msg,fmt
5292  character(len=fnlen) :: datafile,basefile
5293 !arrays
5294  integer :: g0(3)
5295  integer,allocatable :: bounds2kpt(:)
5296 
5297 ! *********************************************************************
5298 
5299  nkbounds = 0
5300  if (present(kptbounds)) then
5301    if (product(shape(kptbounds)) > 0 ) then
5302      ! Find correspondence between kptbounds and k-points in ebands.
5303      nkbounds = size(kptbounds, dim=2)
5304      ABI_MALLOC(bounds2kpt, (nkbounds))
5305      bounds2kpt = 1; start = 1
5306      do ii=1,nkbounds
5307         do ik=start,ebands%nkpt
5308           if (isamek(ebands%kptns(:, ik), kptbounds(:, ii), g0)) then
5309             bounds2kpt(ii) = ik; start = ik + 1; exit
5310           end if
5311         end do
5312      end do
5313    end if
5314  end if
5315 
5316  datafile = strcat(prefix, "_EBANDS.data")
5317  if (open_file(datafile, msg, newunit=unt, form="formatted", action="write") /= 0) then
5318    MSG_ERROR(msg)
5319  end if
5320  if (open_file(strcat(prefix, "_EBANDS.gnuplot"), msg, newunit=gpl_unt, form="formatted", action="write") /= 0) then
5321    MSG_ERROR(msg)
5322  end if
5323  basefile = basename(datafile)
5324 
5325  write(unt,'(a)') "# Electron band structure data file"
5326  write(unt,'(a)') "# Generated by Abinit"
5327  write(unt,'(4(a,i0))') &
5328    "# mband: ",ebands%mband,", nkpt: ",ebands%nkpt,", nsppol: ",ebands%nsppol,", nspinor: ",ebands%nspinor
5329  write(unt,'(a,f8.2,a,i0,2(a,f8.2))') &
5330    "# nelect: ",ebands%nelect,", occopt: ",ebands%occopt,", tsmear: ",ebands%tsmear,", tphysel: ",ebands%tphysel
5331  write(unt,'(a,f8.2,a)') "# Energies are in eV. Zero set to efermi, Previously it was at: ",ebands%fermie * Ha_eV, " [eV]"
5332  write(unt,'(a)')"# List of k-points and their index (C notation i.e. count from 0)"
5333  do ik=1,ebands%nkpt
5334    write(unt, "(a)")sjoin("#", itoa(ik-1), ktoa(ebands%kptns(:,ik)))
5335  end do
5336 
5337  fmt = sjoin("(i0,1x,", itoa(ebands%mband), "(es16.8,1x))")
5338  write(unt,'(a)') ' '
5339  do spin=1,ebands%nsppol
5340    write(unt,'(a,i0)') '# [kpt-index, band_1, band_2 ...]  for spin: ',spin
5341    do ik=1,ebands%nkpt
5342      write(unt,fmt) ik-1, (ebands%eig(:, ik, spin) - ebands%fermie) * Ha_eV
5343    end do
5344    write(unt,'(a)') ' '
5345  end do
5346 
5347  ! gnuplot script file
5348 !set terminal postscript eps enhanced color font 'Times-Roman,26' lw 2
5349 !set output "Mos2_band.eps"
5350 !# set line style and point type
5351 !set style line 1 lt 1 ps 2 pt 1 lc rgb "black"
5352 !set style line 2 lt 1 ps 2 pt 1 lc rgb "red"
5353 !# set axes labels
5354 !set xtics("{/Symbol G}" 0, "M" 100, "K" 200, "H" 250,"A" 350,"{/Symbol G}" 400)
5355 !set yrange [-10:5]
5356 !set ytics -10,5,5
5357 !set xrange [0:400]
5358 !set ylabel "Energy -{/Symbol m} (eV)"
5359 !set xlabel "Momentum"
5360 !shift =-1.8
5361 !#Determine plot parameters
5362 !plot 'Mos2_band' using 1:($2 + shift) ls 1 w lines notitle,\
5363 
5364   write(gpl_unt,'(a)') '# File to plot phonon bandstructure with gnuplot'
5365   write(gpl_unt,'(a)') "#set terminal postscript eps enhanced color font 'Times-Roman,26' lw 2"
5366   write(gpl_unt,'(a)') '#use the next lines to make a nice figure for a paper'
5367   write(gpl_unt,'(a)') '#set term postscript enhanced eps color lw 0.5 dl 0.5'
5368   write(gpl_unt,'(a)') '#set pointsize 0.275'
5369   write(gpl_unt,'(a)') 'set palette defined ( 0 "blue", 3 "green", 6 "yellow", 10 "red" )'
5370   write(gpl_unt,'(a)') 'unset key'
5371   write(gpl_unt,'(a)') '# can make pointsize smaller (~0.5). Too small and nothing is printed'
5372   write(gpl_unt,'(a)') 'set pointsize 0.8'
5373   write(gpl_unt,'(a)') 'set view 0,0'
5374   write(gpl_unt,'(a,i0,a)') 'set xrange [0:',ebands%nkpt-1,']'
5375   write(gpl_unt,'(2(a,es16.8),a)')&
5376     'set yrange [',minval((ebands%eig - ebands%fermie) * Ha_eV),':',maxval((ebands%eig - ebands%fermie) * Ha_eV),']'
5377   write(gpl_unt,'(a)') 'set xlabel "Momentum"'
5378   write(gpl_unt,'(a)') 'set ylabel "Energy [eV]"'
5379   write(gpl_unt,'(a)') strcat('set title "', replace(basefile, "_", "\\_"), '"')
5380   if (nkbounds == 0) then
5381     write(gpl_unt,'(a)') 'set grid xtics'
5382   else
5383     write(gpl_unt,"(a)")"# Add vertical lines in correspondence of high-symmetry points."
5384     write(gpl_unt,'(a)') 'unset xtics'
5385     do ii=1,nkbounds
5386       write(gpl_unt,"(a,2(i0,a))") &
5387         "set arrow from ",bounds2kpt(ii)-1,",graph(0,0) to ",bounds2kpt(ii)-1,",graph(1,1) nohead ls 'dashed'"
5388       !write(gpl_unt,"(a)")sjoin("set xtics add('kname'", itoa(bounds2kpt(ii)-1), ")")
5389     end do
5390 
5391   end if
5392   write(gpl_unt,"(a)")sjoin("mband =", itoa(ebands%mband))
5393   write(gpl_unt,"(a)")strcat('plot for [i=2:mband] "', basefile, '" u 1:i every :1 with lines linetype -1')
5394   if (ebands%nsppol == 2) then
5395     write(gpl_unt,"(a)")strcat('replot for [i=2:mband] "', basefile, '" u 1:i every :2 with lines linetype 4')
5396   end if
5397  write(gpl_unt, "(a)")"pause -1"
5398 
5399  close(unt)
5400  close(gpl_unt)
5401 
5402  if (allocated(bounds2kpt)) then
5403    ABI_FREE(bounds2kpt)
5404  end if
5405 
5406 end subroutine ebands_write_gnuplot

m_ebands/ebands_write_nesting [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_write_nesting

FUNCTION

 Calculate the nesting function and output data to file.

INPUTS

  ebands<ebands_t>=the ebands_t datatype
  cryst<crystal_t>=Info on unit cell and symmetries.
  filepath=File name for output data.
  prtnest = flags governing the format of the output file. see mknesting.
  tsmear=Broadening used to approximation the delta function.
  fermie_nest
  qpath_vertices = vertices of the reciprocal space trajectory

OUTPUT

  Return non-zero exist status if netsting factor cannot be produced.
  The errmsg string gives information on the error.

SIDE EFFECTS

   Write data to file.

PARENTS

CHILDREN

SOURCE

3498 integer function ebands_write_nesting(ebands,cryst,filepath,prtnest,tsmear,fermie_nest,&
3499   qpath_vertices,errmsg) result(skipnest)
3500 
3501 
3502 !This section has been created automatically by the script Abilint (TD).
3503 !Do not modify the following lines by hand.
3504 #undef ABI_FUNC
3505 #define ABI_FUNC 'ebands_write_nesting'
3506 !End of the abilint section
3507 
3508  implicit none
3509 
3510 !This section has been created automatically by the script Abilint (TD).
3511 !Do not modify the following lines by hand.
3512 #undef ABI_FUNC
3513 #define ABI_FUNC 'ebands_write_nesting'
3514 !End of the abilint section
3515 
3516 !Arguments ------------------------------------
3517  type(ebands_t),intent(in) :: ebands
3518  type(crystal_t),intent(in) :: cryst
3519  integer,intent(in) :: prtnest
3520  real(dp),intent(in) :: tsmear,fermie_nest
3521  character(len=*),intent(in) :: filepath
3522  character(len=*),intent(out) :: errmsg
3523 !arrays
3524  real(dp),intent(in) :: qpath_vertices(:,:)
3525 
3526 !Local variables-------------------------------
3527 !scalaras
3528  integer :: ikpt,spin,iband,nqpath
3529  real(dp) :: invgauwidth,prefact,fermie
3530 !arrays
3531  real(dp), allocatable :: fs_weights(:,:,:)
3532 
3533 ! *********************************************************************
3534 
3535  skipnest = 0; errmsg = ""
3536  if (any(ebands%nband /= ebands%nband(1))) then
3537    errmsg = 'mknesting can not handle variable nband(1:nkpt). Skipped.'//&
3538      ch10//' Correct input file to get nesting output'
3539    skipnest = 1; return
3540  end if
3541 
3542  if (ebands%nshiftk /= 1) then
3543    errmsg = 'mknesting does not support nshiftk > 1. Change ngkpt and shiftk to have only one shift after inkpts'
3544    skipnest = 1; return
3545  end if
3546 
3547  ! FIXME: needs to be generalized to complete the k grid for one of the arguments to mknesting
3548 
3549  fermie = ebands%fermie
3550  nqpath = size(qpath_vertices, dim=2)
3551 
3552  ! Compute weights. Set sigma to 0.1 eV is tsmear is zero
3553  invgauwidth = one / (0.1_dp * eV_Ha); if (tsmear > tol10) invgauwidth = one / tsmear
3554  prefact = one / sqrt(pi) * invgauwidth
3555 
3556  ABI_MALLOC(fs_weights,(ebands%nband(1),ebands%nkpt,ebands%nsppol))
3557 
3558  do spin=1,ebands%nsppol
3559    do ikpt=1,ebands%nkpt
3560      do iband=1,ebands%nband(1)
3561        fs_weights(iband, ikpt, spin) = prefact * &
3562          exp(-(invgauwidth*(ebands%eig(iband,ikpt,spin)-(fermie + fermie_nest)))**2)
3563      end do
3564    end do
3565  end do
3566 
3567  if (any(ebands%kptopt == [3, 4])) then ! no symmetry
3568    call mknesting(ebands%nkpt,ebands%kptns,ebands%kptrlatt,ebands%nband(1),fs_weights,nqpath,&
3569      qpath_vertices,1,[zero, zero, zero],filepath,cryst%gprimd,cryst%gmet,prtnest,identity_3d)
3570  else
3571    call mknesting(ebands%nkpt,ebands%kptns,ebands%kptrlatt,ebands%nband(1),fs_weights,nqpath,&
3572      qpath_vertices,1, [zero, zero, zero], filepath,cryst%gprimd,cryst%gmet,prtnest,identity_3d,&
3573      nsym=cryst%nsym, symrec=cryst%symrec)
3574  end if
3575 
3576  ABI_FREE(fs_weights)
3577 
3578 end function ebands_write_nesting

m_ebands/ebands_write_xmgrace [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebands_write_xmgrace

FUNCTION

  Write bands in Xmgrace format. This routine should be called by a single processor.
  Use the driver `ebands_write` to support different formats.

INPUTS

  filename=Filename
  [kptbounds(:,:)]=Optional argument giving the extrema of the k-path.

OUTPUT

  Only writing

PARENTS

      m_ebands

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

5129 subroutine ebands_write_xmgrace(ebands, filename, kptbounds)
5130 
5131 
5132 !This section has been created automatically by the script Abilint (TD).
5133 !Do not modify the following lines by hand.
5134 #undef ABI_FUNC
5135 #define ABI_FUNC 'ebands_write_xmgrace'
5136 !End of the abilint section
5137 
5138  implicit none
5139 
5140 !Arguments ------------------------------------
5141 !scalars
5142  type(ebands_t),intent(in) :: ebands
5143  character(len=*),intent(in) :: filename
5144  real(dp),optional,intent(in) :: kptbounds(:,:)
5145 
5146 !Local variables-------------------------------
5147 !scalars
5148  integer :: unt,ik,spin,band,ii,start,nkbounds
5149  character(len=500) :: msg
5150 !arrays
5151  integer :: g0(3)
5152  integer,allocatable :: bounds2kpt(:)
5153 
5154 ! *********************************************************************
5155 
5156  nkbounds = 0
5157  if (present(kptbounds)) then
5158    if (product(shape(kptbounds)) > 0 ) then
5159      ! Find correspondence between kptbounds and k-points in ebands.
5160      nkbounds = size(kptbounds, dim=2)
5161      ABI_MALLOC(bounds2kpt, (nkbounds))
5162      bounds2kpt = 1; start = 1
5163      do ii=1,nkbounds
5164         do ik=start,ebands%nkpt
5165           if (isamek(ebands%kptns(:, ik), kptbounds(:, ii), g0)) then
5166             bounds2kpt(ii) = ik; start = ik + 1; exit
5167           end if
5168         end do
5169      end do
5170    end if
5171  end if
5172 
5173  if (open_file(filename, msg, newunit=unt, form="formatted", action="write") /= 0) then
5174    MSG_ERROR(msg)
5175  end if
5176 
5177  write(unt,'(a)') "# Grace project file"
5178  write(unt,'(a)') "# Generated by Abinit"
5179  write(unt,'(4(a,i0))') &
5180    "# mband: ",ebands%mband,", nkpt: ",ebands%nkpt,", nsppol: ",ebands%nsppol,", nspinor: ",ebands%nspinor
5181  write(unt,'(a,f8.2,a,i0,2(a,f8.2))') &
5182    "# nelect: ",ebands%nelect,", occopt: ",ebands%occopt,", tsmear: ",ebands%tsmear,", tphysel: ",ebands%tphysel
5183  write(unt,'(a,f8.2,a)') "# Energies are in eV. Zero set to efermi, previously it was at: ",ebands%fermie * Ha_eV, " [eV]"
5184  write(unt,'(a)')"# List of k-points and their index (C notation i.e. count from 0)"
5185  do ik=1,ebands%nkpt
5186    write(unt, "(a)")sjoin("#", itoa(ik-1), ktoa(ebands%kptns(:,ik)))
5187  end do
5188  write(unt,'(a)') "@page size 792, 612"
5189  write(unt,'(a)') "@page scroll 5%"
5190  write(unt,'(a)') "@page inout 5%"
5191  write(unt,'(a)') "@link page off"
5192  write(unt,'(a)') "@with g0"
5193  write(unt,'(a)') "@world xmin 0.00"
5194  write(unt,'(a,i0)') '@world xmax ',ebands%nkpt
5195  write(unt,'(a,es16.8)') '@world ymin ',minval((ebands%eig - ebands%fermie) * Ha_eV)
5196  write(unt,'(a,es16.8)') '@world ymax ',maxval((ebands%eig - ebands%fermie) * Ha_eV)
5197  write(unt,'(a)') '@default linewidth 1.5'
5198  write(unt,'(a)') '@xaxis  tick on'
5199  write(unt,'(a)') '@xaxis  tick major 1'
5200  write(unt,'(a)') '@xaxis  tick major color 1'
5201  write(unt,'(a)') '@xaxis  tick major linestyle 3'
5202  write(unt,'(a)') '@xaxis  tick major grid on'
5203  write(unt,'(a)') '@xaxis  tick spec type both'
5204  write(unt,'(a)') '@xaxis  tick major 0, 0'
5205  if (nkbounds /= 0) then
5206    write(unt,'(a,i0)') '@xaxis  tick spec ',nkbounds
5207    do ik=1,nkbounds
5208      !write(unt,'(a,i0,a,a)') '@xaxis  ticklabel ',ik-1,',', "foo"
5209      write(unt,'(a,i0,a,i0)') '@xaxis  tick major ',ik-1,' , ',bounds2kpt(ik) - 1
5210    end do
5211  end if
5212  write(unt,'(a)') '@xaxis  ticklabel char size 1.500000'
5213  write(unt,'(a)') '@yaxis  tick major 10'
5214  write(unt,'(a)') '@yaxis  label "Band Energy [eV]"'
5215  write(unt,'(a)') '@yaxis  label char size 1.500000'
5216  write(unt,'(a)') '@yaxis  ticklabel char size 1.500000'
5217  ii = -1
5218  do spin=1,ebands%nsppol
5219    do band=1,ebands%mband
5220      ii = ii + 1
5221      write(unt,'(a,i0,a,i0)') '@    s',ii,' line color ',spin
5222    end do
5223  end do
5224  ii = -1
5225  do spin=1,ebands%nsppol
5226    do band=1,ebands%mband
5227      ii = ii + 1
5228      write(unt,'(a,i0)') '@target G0.S',ii
5229      write(unt,'(a)') '@type xy'
5230      do ik=1,ebands%nkpt
5231         write(unt,'(i0,1x,es16.8)') ik-1, (ebands%eig(band, ik, spin) - ebands%fermie) * Ha_eV
5232      end do
5233      write(unt,'(a)') '&'
5234    end do
5235  end do
5236 
5237  close(unt)
5238 
5239  if (allocated(bounds2kpt)) then
5240    ABI_FREE(bounds2kpt)
5241  end if
5242 
5243 end subroutine ebands_write_xmgrace

m_ebands/ebspl_eval_bks [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebspl_eval_bks

FUNCTION

   Interpolate eigenvalues, 1st and 2nd derivates wrt k at an arbitrary k-point.

INPUTS

  band=Band index
  kpt(3)=K-point in reduced coordinate (will be wrapped in the interval [0,1[
  spin=Spin index

OUTPUT

  oeig=Interpolated eigenvalues.
    Note that oeig is not necessarily sorted in ascending order.
    The routine does not reorder the interpolated eigenvalues
    to be consistent with the interpolation of the derivatives.
  [oder1(3)]=First-order derivatives wrt k in reduced coordinates.
  [oder2(3,3)]=Second-order derivatives wrt k in reduced coordinates.

PARENTS

      m_ebands

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

3988 subroutine ebspl_eval_bks(ebspl, band, kpt, spin, oeig, oder1, oder2)
3989 
3990 
3991 !This section has been created automatically by the script Abilint (TD).
3992 !Do not modify the following lines by hand.
3993 #undef ABI_FUNC
3994 #define ABI_FUNC 'ebspl_eval_bks'
3995 !End of the abilint section
3996 
3997  implicit none
3998 
3999 !Arguments ------------------------------------
4000 !scalars
4001  integer,intent(in) :: band,spin
4002  type(ebspl_t),intent(in) :: ebspl
4003 !arrays
4004  real(dp),intent(in) :: kpt(3)
4005  real(dp),intent(out) :: oeig
4006  real(dp),optional,intent(out) :: oder1(3)
4007  real(dp),optional,intent(out) :: oder2(3,3)
4008 
4009 !Local variables-------------------------------
4010 !scalars
4011  integer :: ii,jj
4012 !arrays
4013  integer :: iders(3)
4014  real(dp) :: kred(3),shift(3)
4015 
4016 ! *********************************************************************
4017 
4018  DBG_CHECK(allocated(ebspl%coeff(band, spin)%vals), sjoin("Unallocated (band, spin):", ltoa([band, spin])))
4019 
4020  ! Wrap k-point in the interval [0,1[ where 1 is not included (tol12)
4021  ! This is required because the spline has been constructed in this region.
4022  call wrap2_zero_one(kpt, kred, shift)
4023 
4024  ! B-spline interpolation.
4025  oeig = dbs3vl(kred(1), kred(2), kred(3), ebspl%kxord, ebspl%kyord, ebspl%kzord, &
4026                ebspl%xknot, ebspl%yknot, ebspl%zknot, ebspl%nkx, ebspl%nky, ebspl%nkz, &
4027                ebspl%coeff(band,spin)%vals)
4028 
4029  if (present(oder1)) then
4030    ! Compute first-order derivatives.
4031    do ii=1,3
4032      iders = 0; iders(ii) = 1
4033      oder1(ii) = dbs3dr(iders(1), iders(2), iders(3), &
4034                         kred(1), kred(2), kred(3), ebspl%kxord, ebspl%kyord, ebspl%kzord, &
4035                         ebspl%xknot, ebspl%yknot, ebspl%zknot, ebspl%nkx, ebspl%nky, ebspl%nkz, &
4036                         ebspl%coeff(band,spin)%vals)
4037    end do
4038  end if
4039 
4040  if (present(oder2)) then
4041    ! Compute second-order derivatives.
4042    oder2 = zero
4043    do jj=1,3
4044      iders = 0; iders(jj) = 1
4045      do ii=1,jj
4046        iders(ii) = iders(ii) + 1
4047        oder2(ii, jj) = dbs3dr(iders(1), iders(2), iders(3), &
4048                         kred(1), kred(2), kred(3), ebspl%kxord, ebspl%kyord, ebspl%kzord, &
4049                         ebspl%xknot, ebspl%yknot, ebspl%zknot, ebspl%nkx, ebspl%nky, ebspl%nkz, &
4050                         ebspl%coeff(band,spin)%vals)
4051        if (ii /= jj) oder2(jj, ii) = oder2(ii, jj)
4052      end do
4053    end do
4054  end if
4055 
4056 end subroutine ebspl_eval_bks

m_ebands/ebspl_free [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebspl_free

FUNCTION

  Free dynamic memory.

PARENTS

      m_ebands

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

4076 subroutine ebspl_free(ebspl)
4077 
4078 
4079 !This section has been created automatically by the script Abilint (TD).
4080 !Do not modify the following lines by hand.
4081 #undef ABI_FUNC
4082 #define ABI_FUNC 'ebspl_free'
4083 !End of the abilint section
4084 
4085  implicit none
4086 
4087 !Arguments ------------------------------------
4088 !scalars
4089  type(ebspl_t),intent(inout) :: ebspl
4090 
4091 !Local variables-------------------------------
4092 !scalars
4093  integer :: ii,jj
4094 
4095 ! *********************************************************************
4096 
4097  if (allocated(ebspl%xknot)) then
4098    ABI_FREE(ebspl%xknot)
4099  end if
4100  if (allocated(ebspl%yknot)) then
4101    ABI_FREE(ebspl%yknot)
4102  end if
4103  if (allocated(ebspl%zknot)) then
4104    ABI_FREE(ebspl%zknot)
4105  end if
4106 
4107  ! Free B-spline coefficients.
4108  if (allocated(ebspl%coeff)) then
4109    do jj=1,size(ebspl%coeff, dim=2)
4110      do ii=1,size(ebspl%coeff, dim=1)
4111        if (allocated(ebspl%coeff(ii,jj)%vals)) then
4112          ABI_FREE(ebspl%coeff(ii,jj)%vals)
4113        end if
4114      end do
4115    end do
4116    ABI_DT_FREE(ebspl%coeff)
4117  end if
4118 
4119 end subroutine ebspl_free

m_ebands/ebspl_new [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 ebspl_new

FUNCTION

 Build the `ebspl_t` object used to interpolate the band structure.

INPUTS

  ords(3)=order of the spline for the three directions. ord(1) must be in [0, nkx] where
    nkx is the number of points along the x-axis.
  band_block(2)=Initial and final band index. If [0,0], all bands are used
    This is a global variable i.e. all MPI procs must call the routine with the same value.

OUTPUT

PARENTS

      m_ebands

CHILDREN

      destroy_tetra,get_full_kgrid,init_tetra,matr3inv,tetra_blochl_weights
      xmpi_sum

SOURCE

3790 type(ebspl_t) function ebspl_new(ebands, cryst, ords, band_block) result(new)
3791 
3792 
3793 !This section has been created automatically by the script Abilint (TD).
3794 !Do not modify the following lines by hand.
3795 #undef ABI_FUNC
3796 #define ABI_FUNC 'ebspl_new'
3797 !End of the abilint section
3798 
3799  implicit none
3800 
3801 !Arguments ------------------------------------
3802 !scalars
3803  type(ebands_t),intent(in) :: ebands
3804  type(crystal_t),intent(in) :: cryst
3805 !arrays
3806  integer,intent(in) :: ords(3), band_block(2)
3807 
3808 !Local variables-------------------------------
3809 !scalars
3810  integer,parameter :: sppoldbl1=1
3811  integer :: kxord,kyord,kzord,nxknot,nyknot,nzknot,ierr,nkfull,ikf
3812  integer :: spin,band,ik_ibz,timrev,ix,iy,iz,nkx,nky,nkz,ii
3813  real(dp) :: dksqmax
3814  character(len=500) :: msg
3815 !arrays
3816  integer :: ngkpt(3)
3817  integer,allocatable :: bz2ibz(:,:)
3818  logical :: shifted(3)
3819  real(dp),allocatable :: xvec(:),yvec(:),zvec(:),xyzdata(:,:,:),kfull(:,:)
3820 
3821 ! *********************************************************************
3822 
3823  ! Check input parameters
3824  ierr = 0
3825  if (ebands%nkpt == 1) then
3826    MSG_WARNING("Cannot interpolate with a single k-point")
3827    ierr = ierr + 1
3828  end if
3829  if (.not. isdiagmat(ebands%kptrlatt)) then
3830    MSG_WARNING('kptrlatt is not diagonal. Multiple shifts are not allowed')
3831    ierr = ierr + 1
3832  end if
3833  if (ebands%nshiftk /= 1) then
3834    MSG_WARNING('Multiple shifts not allowed')
3835    ierr = ierr + 1
3836  end if
3837  if (any(ebands%nband /= ebands%nband(1))) then
3838    MSG_WARNING("nband must be constant")
3839    ierr = ierr + 1
3840  end if
3841  if (ierr /= 0) then
3842    MSG_ERROR("bspline interpolation cannot be performed. See messages above.")
3843  end if
3844 
3845  ! Build BZ mesh Note that in the simplest case of unshifted mesh:
3846  ! 1) k-point coordinates are in [0, 1]
3847  ! 2) The mesh is closed i.e. (0,0,0) and (1,1,1) are included
3848  ngkpt(1)=ebands%kptrlatt(1,1)
3849  ngkpt(2)=ebands%kptrlatt(2,2)
3850  ngkpt(3)=ebands%kptrlatt(3,3)
3851 
3852  ! Multiple shifts are not supported here.
3853  shifted(:) = abs(ebands%shiftk(:,1)) > tol8
3854  nkx = ngkpt(1) + 1; if (shifted(1)) nkx = nkx + 1
3855  nky = ngkpt(2) + 1; if (shifted(2)) nky = nky + 1
3856  nkz = ngkpt(3) + 1; if (shifted(3)) nkz = nkz + 1
3857  ABI_MALLOC(xvec, (nkx))
3858  ABI_MALLOC(yvec, (nky))
3859  ABI_MALLOC(zvec, (nkz))
3860 
3861  do ix=1,nkx
3862    ii = ix; if (shifted(1)) ii = ii - 1
3863    xvec(ix) = (ii-1+ebands%shiftk(1,1)) / ngkpt(1)
3864  end do
3865  do iy=1,nky
3866    ii = iy; if (shifted(2)) ii = ii - 1
3867    yvec(iy) = (ii-1+ebands%shiftk(2,1)) / ngkpt(2)
3868  end do
3869  do iz=1,nkz
3870    ii = iz; if (shifted(3)) ii = ii - 1
3871    zvec(iz) = (ii-1+ebands%shiftk(3,1)) / ngkpt(3)
3872  end do
3873 
3874  ! Build list of k-points in full BZ (ordered as required by B-spline routines)
3875  nkfull = nkx*nky*nkz
3876  ABI_MALLOC(kfull, (3,nkfull))
3877  ikf = 0
3878  do iz=1,nkz
3879    do iy=1,nky
3880      do ix=1,nkx
3881        ikf = ikf + 1
3882        kfull(:,ikf) = [xvec(ix), yvec(iy), zvec(iz)]
3883      end do
3884    end do
3885  end do
3886 
3887  ! Build mapping kfull --> IBZ
3888  ABI_MALLOC(bz2ibz, (nkfull*sppoldbl1,6))
3889 
3890  timrev = kpts_timrev_from_kptopt(ebands%kptopt)
3891  call listkk(dksqmax,cryst%gmet,bz2ibz,ebands%kptns,kfull,ebands%nkpt,nkfull,cryst%nsym,&
3892    sppoldbl1,cryst%symafm,cryst%symrec,timrev,use_symrec=.True.)
3893  ABI_FREE(kfull)
3894 
3895  if (dksqmax > tol12) then
3896    write(msg, '(3a,es16.6,4a)' )&
3897    'At least one of the k points could not be generated from a symmetrical one.',ch10,&
3898    'dksqmax=',dksqmax,ch10,&
3899    'Action: check k-point input variables',ch10,&
3900    '        e.g. kptopt or shiftk might be wrong in the present dataset or the preparatory one.'
3901    MSG_ERROR(msg)
3902  end if
3903 
3904  ! Generate knots (ords is input)
3905  kxord = ords(1); kyord = ords(2); kzord = ords(3)
3906  nxknot = nkx + kxord
3907  nyknot = nky + kyord
3908  nzknot = nkz + kzord
3909 
3910  new%nkx = nkx; new%kxord = kxord
3911  new%nky = nky; new%kyord = kyord
3912  new%nkz = nkz; new%kzord = kzord
3913 
3914  ABI_MALLOC(new%xknot,(nxknot))
3915  ABI_MALLOC(new%yknot,(nyknot))
3916  ABI_MALLOC(new%zknot,(nzknot))
3917  call dbsnak(nkx, xvec, kxord, new%xknot)
3918  call dbsnak(nky, yvec, kyord, new%yknot)
3919  call dbsnak(nkz, zvec, kzord, new%zknot)
3920 
3921  ABI_MALLOC(xyzdata,(nkx,nky,nkz))
3922  ABI_DT_MALLOC(new%coeff, (ebands%mband,ebands%nsppol))
3923  new%band_block = band_block; if (all(band_block == 0)) new%band_block = [1, ebands%mband]
3924 
3925  do spin=1,ebands%nsppol
3926    do band=1,ebands%mband
3927      if (band < new%band_block(1) .or. band > new%band_block(2)) cycle
3928 
3929      ABI_MALLOC(new%coeff(band,spin)%vals, (nkx,nky,nkz))
3930 
3931      ! Build array in full bz to prepare call to dbs3in.
3932      ikf = 0
3933      do iz=1,nkz
3934        do iy=1,nky
3935          do ix=1,nkx
3936            ikf = ikf + 1
3937            ik_ibz = bz2ibz(ikf,1)
3938            xyzdata(ix,iy,iz) = ebands%eig(band,ik_ibz,spin)
3939          end do
3940        end do
3941      end do
3942 
3943      ! Construct 3D tensor for B-spline. Results in coeff(band,spin)%vals
3944      call dbs3in(nkx,xvec,nky,yvec,nkz,zvec,xyzdata,nkx,nky,kxord,kyord,kzord,new%xknot,new%yknot,new%zknot,&
3945         new%coeff(band,spin)%vals)
3946    end do
3947  end do
3948 
3949  ABI_FREE(xvec)
3950  ABI_FREE(yvec)
3951  ABI_FREE(zvec)
3952  ABI_FREE(bz2ibz)
3953  ABI_FREE(xyzdata)
3954 
3955 end function ebspl_new

m_ebands/ebspl_t [ Types ]

[ Top ] [ m_ebands ] [ Types ]

NAME

 ebspl_t

FUNCTION

  B-spline interpolation of electronic eigenvalues.

SOURCE

227  type :: bcoefs_t
228    real(dp),allocatable :: vals(:,:,:)
229  end type bcoefs_t
230 
231  type,public :: ebspl_t
232 
233    integer :: nkx,nky,nkz
234    ! Number of input data points
235 
236    integer :: kxord,kyord,kzord
237    ! Order of the spline.
238 
239    integer :: band_block(2)
240     ! Initial and final band index.
241 
242    !real(dp),allocatable :: xvec(:),yvec(:),zvec(:)
243    real(dp),allocatable :: xknot(:),yknot(:),zknot(:)
244    ! Array of length ndata+korder containing the knot
245 
246    type(bcoefs_t),allocatable :: coeff(:,:)
247    ! coeff(mband, nsppol)
248    ! coff(band, spin)%vals(nkx, nky, nkz)
249    ! B-spline coefficients for a given (band, spin)
250 
251  end type ebspl_t
252 
253  public :: ebspl_new         ! Build B-spline object.
254  public :: ebspl_eval_bks    ! Interpolate eigenvalues, 1st, 2nd derivates wrt k, at an arbitrary k-point.
255  public :: ebspl_free        ! Free memory.
256 
257 
258 CONTAINS  !=====================================================================================

m_ebands/edos_free [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

  edos_free

FUNCTION

  Free the memory allocated in edos_t

PARENTS

      eph

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

3214 subroutine edos_free(edos)
3215 
3216 
3217 !This section has been created automatically by the script Abilint (TD).
3218 !Do not modify the following lines by hand.
3219 #undef ABI_FUNC
3220 #define ABI_FUNC 'edos_free'
3221 !End of the abilint section
3222 
3223  implicit none
3224 
3225 !Arguments ------------------------------------
3226  type(edos_t),intent(inout) :: edos
3227 
3228 ! *********************************************************************
3229 
3230  !@edos_t
3231 !real
3232  if (allocated(edos%mesh)) then
3233    ABI_FREE(edos%mesh)
3234  end if
3235  if (allocated(edos%dos)) then
3236    ABI_FREE(edos%dos)
3237  end if
3238  if (allocated(edos%idos)) then
3239    ABI_FREE(edos%idos)
3240  end if
3241  if (allocated(edos%gef)) then
3242    ABI_FREE(edos%gef)
3243  end if
3244 
3245 end subroutine edos_free

m_ebands/edos_ncwrite [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 edos_ncwrite

FUNCTION

  Write results to netcdf file.

INPUTS

  edos<edos_t>=DOS container
  ncid=NC file handle.

OUTPUT

  ncerr= netcdf exit status.

PARENTS

CHILDREN

SOURCE

3362 integer function edos_ncwrite(edos, ncid) result(ncerr)
3363 
3364 
3365 !This section has been created automatically by the script Abilint (TD).
3366 !Do not modify the following lines by hand.
3367 #undef ABI_FUNC
3368 #define ABI_FUNC 'edos_ncwrite'
3369 !End of the abilint section
3370 
3371  implicit none
3372 
3373 !Arguments ------------------------------------
3374  integer,intent(in) :: ncid
3375  type(edos_t),intent(in) :: edos
3376 
3377 #ifdef HAVE_NETCDF
3378  ! Define dimensions.
3379  ncerr = nctk_def_dims(ncid, [ &
3380    nctkdim_t("nsppol_plus1", edos%nsppol + 1), nctkdim_t("edos_nw", edos%nw)], defmode=.True.)
3381  NCF_CHECK(ncerr)
3382 
3383  ! Define variables
3384  NCF_CHECK(nctk_def_iscalars(ncid, [character(len=nctk_slen) :: "edos_intmeth", "edos_nkibz", "edos_ief"]))
3385  NCF_CHECK(nctk_def_dpscalars(ncid, [character(len=nctk_slen) :: "edos_broad"]))
3386 
3387  ncerr = nctk_def_arrays(ncid, [ &
3388    nctkarr_t("edos_mesh", "dp", "edos_nw"), &
3389    nctkarr_t("edos_dos", "dp", "edos_nw, nsppol_plus1"), &
3390    nctkarr_t("edos_idos", "dp", "edos_nw, nsppol_plus1"), &
3391    nctkarr_t("edos_gef", "dp", "nsppol_plus1") &
3392  ])
3393  NCF_CHECK(ncerr)
3394 
3395  ! Write data.
3396  NCF_CHECK(nctk_set_datamode(ncid))
3397  NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, "edos_intmeth"), edos%intmeth))
3398  NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, "edos_nkibz"), edos%nkibz))
3399  NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, "edos_ief"), edos%ief))
3400  NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, "edos_broad"), edos%broad))
3401  NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, "edos_mesh"), edos%mesh))
3402  NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, "edos_dos"), edos%dos))
3403  NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, "edos_idos"), edos%idos))
3404  NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, "edos_gef"), edos%gef))
3405 
3406 #else
3407  MSG_ERROR("netcdf library not available")
3408 #endif
3409 
3410 end function edos_ncwrite

m_ebands/edos_print [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 edos_print

FUNCTION

 Print DOS info to Fortran unit.

INPUTS

  edos<edos_t>=DOS container
  [unit]=Unit number for output. Defaults to std_out

OUTPUT

  Only writing.

PARENTS

      eph

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

3435 subroutine edos_print(edos, unit)
3436 
3437 
3438 !This section has been created automatically by the script Abilint (TD).
3439 !Do not modify the following lines by hand.
3440 #undef ABI_FUNC
3441 #define ABI_FUNC 'edos_print'
3442 !End of the abilint section
3443 
3444  implicit none
3445 
3446 !Arguments ------------------------------------
3447  type(edos_t),intent(in) :: edos
3448  integer,optional,intent(in) :: unit
3449 
3450 !Local variables-------------------------------
3451  integer :: unt
3452 
3453 ! *************************************************************************
3454 
3455  unt = std_out; if (present(unit)) unt = unit
3456 
3457  write(unt,'(a,es16.8,a)')' Fermi level: ',edos%mesh(edos%ief)*Ha_eV," [eV]"
3458  write(unt,"(a,es16.8)")" Total electron DOS in states/eV : ",edos%gef(0) / Ha_eV
3459  if (edos%nsppol == 2) then
3460    write(unt,"(a,es16.8)")"   Spin up:  ",edos%gef(1) / Ha_eV
3461    write(unt,"(a,es16.8)")"   Spin down:",edos%gef(2) / Ha_eV
3462  end if
3463 
3464 end subroutine edos_print

m_ebands/edos_t [ Types ]

[ Top ] [ m_ebands ] [ Types ]

NAME

 edos_t

FUNCTION

 Store the electronic DOS

SOURCE

121  type,public :: edos_t
122 
123    integer :: nsppol
124     ! Number of spins.
125 
126    integer :: nkibz
127     ! Number of k-points in the IBZ.
128 
129    integer :: nw
130    ! Number of points in the frequency mesh.
131 
132    integer :: ief=0
133    ! Rightmost Index of the energy mesh such as IDOS[mesh[ief]] < nelect.
134    ! 0 if Fermi level could not be computed
135    ! Note the value of gef stored in edos_t is computed by performing
136    ! a linear interpolation between ief and ief+1
137 
138    integer :: intmeth
139    ! 1 for gaussian, 2 tetra
140 
141    real(dp) :: broad=zero
142    ! Gaussian broadening
143 
144    real(dp) :: step
145    ! Step of the mesh
146 
147    real(dp),allocatable :: mesh(:)
148    ! mesh(nw)
149 
150    real(dp),allocatable :: dos(:,:)
151    ! dos(nw,0:nsppol)
152    ! Total DOS, spin up and spin down component.
153 
154    real(dp),allocatable :: idos(:,:)
155    ! idos(nw,0:nsppol)
156    ! Integrated DOS, spin up and spin down component.
157 
158    real(dp),allocatable :: gef(:)
159    ! gef(0:nsppol)
160    ! DOS at the Fermi level. Total, spin up, spin down
161 
162  end type edos_t
163 
164  public :: ebands_get_edos   ! Compute electron DOS from band structure.
165  public :: edos_free         ! Free memory
166  public :: edos_write        ! Write results to file (formatted mode)
167  public :: edos_print        ! Print eDOS info to Fortran unit.
168  public :: edos_ncwrite      ! Write eDOS to netcdf file.

m_ebands/edos_write [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 edos_write

FUNCTION

 Write results to file.

INPUTS

  edos<edos_t>=DOS container
  path=File name.

OUTPUT

  Only writing.

PARENTS

      eph

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

3272 subroutine edos_write(edos, path)
3273 
3274 
3275 !This section has been created automatically by the script Abilint (TD).
3276 !Do not modify the following lines by hand.
3277 #undef ABI_FUNC
3278 #define ABI_FUNC 'edos_write'
3279 !End of the abilint section
3280 
3281  implicit none
3282 
3283 !Arguments ------------------------------------
3284  character(len=*),intent(in) :: path
3285  type(edos_t),intent(in) :: edos
3286 
3287 !Local variables-------------------------------
3288  integer :: iw,spin,unt
3289  real(dp) :: cfact,efermi
3290  character(len=500) :: msg
3291 
3292 ! *************************************************************************
3293 
3294  ! Convert everything into eV
3295  ! I know that Abinit should use Ha but Hartrees are not readable.
3296  ! Please don't change this code, in case add an optional argument to specify different units.
3297  cfact = Ha_eV
3298 
3299  if (open_file(path, msg, newunit=unt, form="formatted", action="write") /= 0) then
3300    MSG_ERROR(msg)
3301  end if
3302 
3303  ! Write header.
3304  write(unt,'(a)')'# Electron density of states: Energy in eV, DOS in states/eV per unit cell.'
3305  write(unt,"(a)")"# The zero of energies corresponds to the Fermi level."
3306 
3307  select case (edos%intmeth)
3308  case (1)
3309    write(unt,'(a,es16.8,a,i0)')&
3310      '# Gaussian method with smearing= ',edos%broad*cfact,' [eV], nkibz= ',edos%nkibz
3311  case (2)
3312    write(unt,'(a,i0)')'# Tetrahedron method, nkibz= ',edos%nkibz
3313  case default
3314    MSG_ERROR(sjoin("Wrong method:", itoa(edos%intmeth)))
3315  end select
3316 
3317  if (edos%ief == 0) then
3318    write(unt,'(a)')'# Fermi level: None'
3319    efermi = zero
3320  else
3321    write(unt,'(a,es16.8,a)')'# Fermi level: ',edos%mesh(edos%ief)*cfact," [eV]"
3322    efermi = edos%mesh(edos%ief)
3323  end if
3324 
3325  ! Write data.
3326  write(unt,"(a)")"# Energy           DOS_TOT          IDOS_TOT         DOS[spin=UP]     IDOS[spin=UP] ..."
3327  do iw=1,edos%nw
3328    write(unt,'(es17.8)',advance='no')(edos%mesh(iw) - efermi)*cfact
3329    do spin=0,edos%nsppol
3330      write(unt,'(2es17.8)',advance='no')edos%dos(iw,spin)/cfact,edos%idos(iw,spin)
3331    end do
3332    write(unt,*)
3333  end do
3334 
3335  close(unt)
3336 
3337 end subroutine edos_write

m_ebands/enclose_degbands [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

  enclose_degbands

FUNCTION

  Adjust ibmin and ibmax such that all the degenerate states are enclosed
  between ibmin and ibmax. The routine works for a given k-point a spin.

INPUTS

  ebands<ebands_t>=The object describing the band structure.
  ikibz=Index of the k-point.
  spin=Spin index.
  tol_enedif=Tolerance on the energy difference.

OUTPUT

  changed=.TRUE. if ibmin or ibmax has been changed.
  [degblock(2,ndeg)]=Table allocated by the routine containing the index
    of the bands in the `ndeg` degenerate sub-sets
    degblock(1, ii) = first band index in the ii-th degenerate subset.
    degblock(2, ii) = last band index in the ii-th degenerate subset.

SIDE EFFECTS

  ibmin,ibmax=
    Input: initial guess for the indeces
    Output: All the denerate states are between ibmin and ibmax

PARENTS

      m_sigmaph,setup_sigma

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

1709 subroutine enclose_degbands(ebands,ikibz,spin,ibmin,ibmax,changed,tol_enedif,degblock)
1710 
1711 
1712 !This section has been created automatically by the script Abilint (TD).
1713 !Do not modify the following lines by hand.
1714 #undef ABI_FUNC
1715 #define ABI_FUNC 'enclose_degbands'
1716 !End of the abilint section
1717 
1718  implicit none
1719 
1720 !Arguments ------------------------------------
1721 !scalars
1722  integer,intent(in) :: ikibz,spin
1723  integer,intent(inout) :: ibmin,ibmax
1724  real(dp),intent(in) :: tol_enedif
1725  logical,intent(out) :: changed
1726  type(ebands_t),intent(in) :: ebands
1727 !arrays
1728  integer,allocatable,optional,intent(out) :: degblock(:,:)
1729 
1730 !Local variables-------------------------------
1731 !scalars
1732  integer :: ib,ibmin_bkp,ibmax_bkp,ndeg
1733  real(dp) :: emin,emax
1734 
1735 
1736 ! *************************************************************************
1737 
1738  ibmin_bkp = ibmin; ibmax_bkp = ibmax
1739 
1740  emin = ebands%eig(ibmin,ikibz,spin)
1741  do ib=ibmin-1,1,-1
1742    if ( ABS(ebands%eig(ib,ikibz,spin) - emin) > tol_enedif) then
1743      ibmin = ib +1
1744      EXIT
1745    else
1746      ibmin = ib
1747    end if
1748  end do
1749 
1750  emax =  ebands%eig(ibmax,ikibz,spin)
1751  do ib=ibmax+1,ebands%nband(ikibz+(spin-1)*ebands%nkpt)
1752    if ( ABS(ebands%eig(ib,ikibz,spin) - emax) > tol_enedif) then
1753      ibmax = ib - 1
1754      EXIT
1755    else
1756      ibmax = ib
1757    end if
1758  end do
1759 
1760  changed = (ibmin /= ibmin_bkp) .or. (ibmax /= ibmax_bkp)
1761 
1762  ! Compute degeneracy table.
1763  if (present(degblock)) then
1764    ! Count number of degeneracies.
1765    ndeg = 1
1766    do ib=ibmin+1,ibmax
1767      if ( abs(ebands%eig(ib,ikibz,spin) - ebands%eig(ib-1,ikibz,spin) ) > tol_enedif) ndeg = ndeg + 1
1768    end do
1769    ! Build degblock table.
1770    if (allocated(degblock)) then
1771       ABI_FREE(degblock)
1772    end if
1773    ABI_MALLOC(degblock, (2, ndeg))
1774    ndeg = 1; degblock(1, 1) = ibmin
1775    do ib=ibmin+1,ibmax
1776      if ( abs(ebands%eig(ib,ikibz,spin) - ebands%eig(ib-1,ikibz,spin) ) > tol_enedif) then
1777        degblock(2, ndeg) = ib - 1
1778        ndeg = ndeg + 1
1779        degblock(1, ndeg) = ib
1780      end if
1781    end do
1782    degblock(2, ndeg) = ibmax
1783  end if
1784 
1785 end subroutine enclose_degbands

m_ebands/gaps_free [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

  gaps_free

FUNCTION

  Free the memory allocated in gaps_t

PARENTS

      m_sigmaph,setup_sigma

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

395 subroutine gaps_free(gaps)
396 
397 
398 !This section has been created automatically by the script Abilint (TD).
399 !Do not modify the following lines by hand.
400 #undef ABI_FUNC
401 #define ABI_FUNC 'gaps_free'
402 !End of the abilint section
403 
404  implicit none
405 
406 !This section has been created automatically by the script Abilint (TD).
407 !Do not modify the following lines by hand.
408 #undef ABI_FUNC
409 #define ABI_FUNC 'gaps_free'
410 !End of the abilint section
411 
412 !Arguments ------------------------------------
413  type(gaps_t),intent(inout) :: gaps
414 
415 ! *********************************************************************
416 
417  !@gaps_t
418 
419 !integer
420  if (allocated(gaps%fo_kpos)) then
421    ABI_FREE(gaps%fo_kpos)
422  end if
423  if (allocated(gaps%ierr)) then
424    ABI_FREE(gaps%ierr)
425  end if
426 
427 !real
428  if (allocated(gaps%fo_values)) then
429    ABI_FREE(gaps%fo_values)
430  end if
431 
432 !chars
433  if (allocated(gaps%errmsg_spin)) then
434    ABI_FREE(gaps%errmsg_spin)
435  end if
436 
437 ! nullify pointers
438  nullify(gaps%kpoints)
439 
440 end subroutine gaps_free

m_ebands/gaps_print [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 gaps_print

FUNCTION

  Print info on the fundamental and optical gap.

INPUTS

  gaps<gaps_t>=Object with info on the gaps.
  [header]=Optional title.
  [unit]=Optional unit for output (std_out if not specified)
  [mode_paral]=Either "COLL" or "PERS", former is default.

OUTPUT

  Only writing.

PARENTS

      m_sigmaph,setup_sigma

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

469 subroutine gaps_print(gaps,header,unit,mode_paral)
470 
471 
472 !This section has been created automatically by the script Abilint (TD).
473 !Do not modify the following lines by hand.
474 #undef ABI_FUNC
475 #define ABI_FUNC 'gaps_print'
476 !End of the abilint section
477 
478  implicit none
479 
480 !Arguments ------------------------------------
481 !scalars
482  integer,intent(in),optional :: unit
483  character(len=4),intent(in),optional :: mode_paral
484  character(len=*),intent(in),optional :: header
485  type(gaps_t),intent(in)  :: gaps
486 
487 !Local variables-------------------------------
488 !scalars
489  integer :: spin,ikopt,ivk,ick,my_unt
490  real(dp) :: fun_gap,opt_gap
491  character(len=4) :: my_mode
492  character(len=500) :: msg
493 
494 ! *********************************************************************
495 
496  my_unt =std_out; if (PRESENT(unit      )) my_unt =unit
497  my_mode='COLL' ; if (PRESENT(mode_paral)) my_mode=mode_paral
498 
499  do spin=1,gaps%nsppol
500 
501    if (spin==1) then
502      msg=ch10
503      if (PRESENT(header)) msg=ch10//' === '//TRIM(ADJUSTL(header))//' === '
504      call wrtout(my_unt,msg,my_mode)
505    end if
506 
507    if (gaps%ierr(spin) /= 0) then
508      call wrtout(my_unt,gaps%errmsg_spin(spin), my_mode)
509      continue
510    end if
511 
512    ! Get minimum of the optical Gap.
513    fun_gap = gaps%fo_values(1,spin)
514    opt_gap = gaps%fo_values(2,spin)
515 
516    if (any(gaps%fo_kpos(:,spin) == 0)) then
517      call wrtout(my_unt,sjoin("Cannot detect gap for spin: ",itoa(spin)),"COLL")
518      cycle
519    end if
520 
521    ivk = gaps%fo_kpos(1,spin)
522    ick = gaps%fo_kpos(2,spin)
523    ikopt = gaps%fo_kpos(3,spin)
524 
525    write(msg,'(a,i2,a,2(a,f8.4,a,3f8.4,a),33x,a,3f8.4)')&
526 &    '  >>>> For spin ',spin,ch10,&
527 &    '   Minimum optical gap = ',opt_gap*Ha_eV,' [eV], located at k-point      : ',gaps%kpoints(:,ikopt),ch10,&
528 &    '   Fundamental gap     = ',fun_gap*Ha_eV,' [eV], Top of valence bands at : ',gaps%kpoints(:,ivk),ch10,  &
529 &                                              '       Bottom of conduction at : ',gaps%kpoints(:,ick)
530    call wrtout(my_unt,msg,my_mode)
531  end do !spin
532 
533 end subroutine gaps_print

m_ebands/gaps_t [ Types ]

[ Top ] [ m_ebands ] [ Types ]

NAME

 gaps_t

FUNCTION

 Structure with information on the fundamental and optical gaps returned by ebands_report_gap.

SOURCE

182  type,public :: gaps_t
183 
184    integer :: nsppol
185     ! Number of spins.
186 
187    integer,allocatable :: fo_kpos(:,:)
188     ! fo_kpos(3,nsppol)
189     ! fo_kpos(1:2,spin) ==> Indices of the k-points where the homo, lumo states are located (for each spin).
190     ! fo_kpos(3,spin)   ==> the index of k-point where the optical gap is located (for each spin).
191 
192    integer,allocatable :: ierr(:)
193      ! The third index corresponds to a "status" :
194      !   0.0dp if gaps were not computed (because there are only valence bands);
195      !  -1.0dp if the system (or spin-channel) is metallic;
196      !   1.0dp if the gap was computed
197 
198    real(dp),allocatable :: fo_values(:,:)
199      ! fo_values(2,nsppol)]
200      ! Fundamental and optical gaps (in Hartree) for each spin.
201 
202    real(dp),pointer :: kpoints(:,:) => null()
203      ! Reference to the k-points of the band structure used to compute the gaps.
204 
205    character(len=500),allocatable :: errmsg_spin(:)
206      ! errmsg_spin(nsppol)
207      ! String with human-readable error messages if ierr(spin) != 0.
208 
209  end type gaps_t
210 
211  public :: get_gaps      ! Build the object from a bandstructure.
212  public :: gaps_free     ! Free the structure.
213  public :: gaps_print    ! Print info on the gaps

m_ebands/get_bandenergy [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 get_bandenergy

FUNCTION

  Return the band energy (weighted sum of occupied eigenvalues)

INPUTS

OUTPUT

NOTES

 TODO Likely this expression is not accurate since it is not variatonal
  One should use
   band_energy = \int e N(e) de   for e<Ef , where N(e) is the e-DOS

PARENTS

CHILDREN

SOURCE

1411 pure function get_bandenergy(ebands) result(band_energy)
1412 
1413 
1414 !This section has been created automatically by the script Abilint (TD).
1415 !Do not modify the following lines by hand.
1416 #undef ABI_FUNC
1417 #define ABI_FUNC 'get_bandenergy'
1418 !End of the abilint section
1419 
1420  implicit none
1421 
1422 !Arguments ------------------------------------
1423 !scalars
1424  type(ebands_t),intent(in) :: ebands
1425  real(dp) :: band_energy
1426 
1427 !Local variables-------------------------------
1428  integer :: spin,ikibz,nband_k
1429  real(dp) :: wtk
1430 ! *********************************************************************
1431 
1432  band_energy=zero
1433  do spin=1,ebands%nsppol
1434    do ikibz=1,ebands%nkpt
1435      wtk=ebands%wtk(ikibz)
1436      nband_k=ebands%nband(ikibz+(spin-1)*ebands%nkpt)
1437      band_energy = band_energy + wtk*SUM( ebands%eig(1:nband_k,ikibz,spin)*ebands%occ(1:nband_k,ikibz,spin) )
1438    end do
1439  end do
1440 
1441 end function get_bandenergy

m_ebands/get_eneocc_vect [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 get_eneocc_vect

FUNCTION

  Retrieve energies or occupations from a ebands_t structure accessing by name.
  Results are reported in a vector to facilitate the interface with other abinit routines.

INPUTS

  ebands<ebands_t>The type containing the data.
  arr_name=The name of the quantity to retrieve. Allowed values are
   == "eig"    == For the eigenvalues.
   == "occ"    == For the occupation numbers.
   == "doccde" == For the derivative of the occupancies wrt the energy.

OUTPUT

  vect(ebands%bantot)=The values required.

PARENTS

      m_ebands

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

1276 subroutine get_eneocc_vect(ebands,arr_name,vect)
1277 
1278 
1279 !This section has been created automatically by the script Abilint (TD).
1280 !Do not modify the following lines by hand.
1281 #undef ABI_FUNC
1282 #define ABI_FUNC 'get_eneocc_vect'
1283 !End of the abilint section
1284 
1285  implicit none
1286 
1287 !Arguments ------------------------------------
1288 !scalars
1289  character(len=*),intent(in) :: arr_name
1290  type(ebands_t),intent(in) :: ebands
1291  real(dp),intent(out) :: vect(ebands%bantot)
1292 
1293 !Local variables-------------------------------
1294  integer :: nkpt,nsppol,mband,bantot
1295 ! *************************************************************************
1296 
1297  mband =ebands%mband; bantot=ebands%bantot; nkpt=ebands%nkpt; nsppol=ebands%nsppol
1298 
1299  SELECT CASE (arr_name)
1300  CASE ('occ')
1301    call pack_eneocc(nkpt,nsppol,mband,ebands%nband,bantot,ebands%occ,vect)
1302  CASE ('eig')
1303    call pack_eneocc(nkpt,nsppol,mband,ebands%nband,bantot,ebands%eig,vect)
1304  CASE ('doccde')
1305    call pack_eneocc(nkpt,nsppol,mband,ebands%nband,bantot,ebands%doccde,vect)
1306  CASE DEFAULT
1307    MSG_BUG(sjoin('Wrong arr_name= ', arr_name))
1308  END SELECT
1309 
1310 end subroutine get_eneocc_vect

m_ebands/get_gaps [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 get_gaps

FUNCTION

  Returns a structure with info on the fundamental and optical gap.

INPUTS

  ebands<ebands_t>=Info on the band structure, the smearing technique and the physical temperature used.
  [kmask]=Logical mask used to exclude k-points.

OUTPUT

  retcode=Return code (!=0 signals failure)
  gaps<gaps_t>=object with info on the gaps (parent is responsible for freeing the object).

PARENTS

CHILDREN

SOURCE

284 function get_gaps(ebands,gaps,kmask) result(retcode)
285 
286 
287 !This section has been created automatically by the script Abilint (TD).
288 !Do not modify the following lines by hand.
289 #undef ABI_FUNC
290 #define ABI_FUNC 'get_gaps'
291 !End of the abilint section
292 
293  implicit none
294 
295 !Arguments ------------------------------------
296 !scalars
297  type(ebands_t),target,intent(in)  :: ebands
298  type(gaps_t),intent(out) :: gaps
299 !arrays
300  logical,optional,intent(in) :: kmask(ebands%nkpt)
301 
302 !Local variables-------------------------------
303 !scalars
304  integer :: ikibz,nband_k,spin,nsppol,ikopt,ivk,ick,ivb,icb,retcode
305  real(dp),parameter :: tol_fermi=tol6
306  real(dp) :: fun_gap,opt_gap
307  logical :: ismetal
308 !arrays
309  integer :: val_idx(ebands%nkpt,ebands%nsppol)
310  real(dp) :: top_valence(ebands%nkpt),bot_conduct(ebands%nkpt)
311  logical :: my_kmask(ebands%nkpt)
312 
313 ! *********************************************************************
314 
315  nsppol = ebands%nsppol
316 
317  ! Initialize gaps_t
318  gaps%nsppol = nsppol
319  ABI_MALLOC(gaps%fo_kpos, (3,nsppol))
320  ABI_MALLOC(gaps%ierr, (nsppol))
321  ABI_MALLOC(gaps%fo_values, (2, nsppol))
322  ABI_MALLOC(gaps%errmsg_spin, (nsppol))
323  gaps%kpoints => ebands%kptns
324 
325  gaps%fo_kpos = 0
326  gaps%ierr = 0
327  gaps%fo_values = zero
328  gaps%errmsg_spin(:) = ""
329 
330  my_kmask=.TRUE.; if (PRESENT(kmask)) my_kmask=kmask
331 
332  val_idx(:,:) = get_valence_idx(ebands,tol_fermi)
333 
334  spin_loop: &
335 &  do spin=1,nsppol
336 
337    ! No output if system i metallic
338    ismetal=ANY(val_idx(:,spin)/=val_idx(1,spin))
339    if (ismetal) then
340      gaps%ierr(spin) = 1
341      write(gaps%errmsg_spin(spin), "(a,i0)")"Metallic system for spin channel ",spin
342      CYCLE
343    endif
344 
345    ivb=val_idx(1,spin)
346    icb=ivb+1
347 
348    do ikibz=1,ebands%nkpt
349      if (.not.my_kmask(ikibz)) CYCLE
350      nband_k=ebands%nband(ikibz+(spin-1)*ebands%nkpt)
351      top_valence(ikibz)=ebands%eig(ivb,ikibz,spin)
352      if (icb>nband_k) then
353        gaps%ierr(spin) = 2
354        gaps%errmsg_spin(spin) = "Not enough states to calculate the band gap."
355        CYCLE spin_loop
356      endif
357      bot_conduct(ikibz)=ebands%eig(icb,ikibz,spin)
358    end do
359 
360    ! Minimum of the optical Gaps
361    ikopt= imin_loc(bot_conduct-top_valence,MASK=my_kmask)
362    opt_gap=bot_conduct(ikopt)-top_valence(ikopt)
363 
364    ! Fundamental Gap ===
365    ick = imin_loc(bot_conduct,MASK=my_kmask)
366    ivk = imax_loc(top_valence,MASK=my_kmask)
367    fun_gap = ebands%eig(icb,ick,spin)-ebands%eig(ivb,ivk,spin)
368 
369    gaps%fo_values(:,spin) = [fun_gap, opt_gap]
370    gaps%fo_kpos(:,spin) = [ivk, ick, ikopt]
371  end do spin_loop
372 
373  retcode = MAXVAL(gaps%ierr)
374 
375 end function get_gaps

m_ebands/get_minmax [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

  get_minmax

FUNCTION

  Report the min and max value over k-points and bands of (eig|occ|doccde) for each
  spin. Cannot use F90 array syntax due to the internal storage used in abinit.

INPUTS

  ebands<ebands_t>=The object describing the band structure.
  arr_name=The name of the array whose min and Max value has to be calculated.
   Possible values: 'occ', 'eig' 'doccde'

OUTPUT

 minmax(2,ebands%nsppol)=For each spin the min and max value of the quantity specified by "arr_name"

PARENTS

CHILDREN

SOURCE

1953 function get_minmax(ebands,arr_name) result(minmax)
1954 
1955 
1956 !This section has been created automatically by the script Abilint (TD).
1957 !Do not modify the following lines by hand.
1958 #undef ABI_FUNC
1959 #define ABI_FUNC 'get_minmax'
1960 !End of the abilint section
1961 
1962  implicit none
1963 
1964 !Arguments ------------------------------------
1965 !scalars
1966  type(ebands_t),target,intent(in) :: ebands
1967  character(len=*),intent(in) :: arr_name
1968 !arrays
1969  real(dp) :: minmax(2,ebands%nsppol)
1970 
1971 !Local variables-------------------------------
1972 !scalars
1973  integer :: band,ikpt,spin,nband_k
1974  real(dp) :: datum
1975 !arrays
1976  real(dp), ABI_CONTIGUOUS pointer :: rdata(:,:,:)
1977 
1978 ! *************************************************************************
1979 
1980  SELECT CASE (tolower(arr_name))
1981  CASE ('occ')
1982    rdata => ebands%occ
1983  CASE ('eig')
1984    rdata => ebands%eig
1985  CASE ('doccde')
1986    rdata => ebands%doccde
1987  CASE DEFAULT
1988    MSG_BUG(sjoin('Wrong arr_name:', arr_name))
1989  END SELECT
1990 
1991  minmax(1,:)=greatest_real
1992  minmax(2,:)=smallest_real
1993 
1994  do spin=1,ebands%nsppol
1995    do ikpt=1,ebands%nkpt
1996      nband_k=ebands%nband(ikpt+(spin-1)*ebands%nkpt)
1997      do band=1,nband_k
1998        datum=rdata(band,ikpt,spin)
1999        minmax(1,spin)=MIN(minmax(1,spin),datum)
2000        minmax(2,spin)=MAX(minmax(2,spin),datum)
2001      end do
2002    end do
2003  end do
2004 
2005 end function get_minmax

m_ebands/get_occupied [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

  get_occupied

FUNCTION

  For each k-point and spin polarisation, report the band index
  after which the occupation numbers are less than tol_occ.

INPUTS

  ebands<ebands_t>=The object describing the band structure.
  tol_occ[Optional]=Tollerance on the occupation factors.

OUTPUT

NOTES

  We assume that the occupation factors monotonically decrease as a function of energy.
  This is not always true for every smearing technique implemented in Abinit.

PARENTS

CHILDREN

SOURCE

1627 pure function get_occupied(ebands,tol_occ) result(occ_idx)
1628 
1629 
1630 !This section has been created automatically by the script Abilint (TD).
1631 !Do not modify the following lines by hand.
1632 #undef ABI_FUNC
1633 #define ABI_FUNC 'get_occupied'
1634 !End of the abilint section
1635 
1636  implicit none
1637 
1638 !Arguments ------------------------------------
1639 !scalars
1640  real(dp),optional,intent(in) :: tol_occ
1641  type(ebands_t),intent(in) :: ebands
1642 !arrays
1643  integer :: occ_idx(ebands%nkpt,ebands%nsppol)
1644 
1645 !Local variables-------------------------------
1646  integer :: band,ikpt,spin,idx,nband_k
1647  real(dp) :: tol_
1648 
1649 ! *************************************************************************
1650 
1651  tol_=tol8 ; if (PRESENT(tol_occ)) tol_=tol_occ
1652 
1653  do spin=1,ebands%nsppol
1654    do ikpt=1,ebands%nkpt
1655      nband_k=ebands%nband(ikpt+(spin-1)*ebands%nkpt)
1656 
1657      idx=0
1658      do band=1,nband_k
1659        if (ebands%occ(band,ikpt,spin)<ABS(tol_)) then
1660          idx=band; EXIT
1661        end if
1662      end do
1663      occ_idx(ikpt,spin)=idx-1
1664      if (idx==1) occ_idx(ikpt,spin)=idx
1665      if (idx==0) occ_idx(ikpt,spin)=nband_k
1666 
1667    end do
1668  end do
1669 
1670 end function get_occupied

m_ebands/get_valence_idx [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

  get_valence_idx

FUNCTION

  For each k-point and spin polarisation, report:
   The index of the valence in case of Semiconductors.
   The index of the band at the Fermi energy+toldfe

INPUTS

  ebands<ebands_t>=The object describing the band structure.
  tol_fermi[optional]

OUTPUT

PARENTS

CHILDREN

SOURCE

1465 pure function get_valence_idx(ebands,tol_fermi) result(val_idx)
1466 
1467 
1468 !This section has been created automatically by the script Abilint (TD).
1469 !Do not modify the following lines by hand.
1470 #undef ABI_FUNC
1471 #define ABI_FUNC 'get_valence_idx'
1472 !End of the abilint section
1473 
1474  implicit none
1475 
1476 !Arguments ------------------------------------
1477 !scalars
1478  real(dp),optional,intent(in) :: tol_fermi
1479  type(ebands_t),intent(in) :: ebands
1480 !arrays
1481  integer :: val_idx(ebands%nkpt,ebands%nsppol)
1482 
1483 !Local variables-------------------------------
1484  integer :: band,ikpt,spin,idx,nband_k
1485  real(dp) :: tol_
1486 
1487 ! *************************************************************************
1488 
1489  tol_=tol6; if (PRESENT(tol_fermi)) tol_=tol_fermi
1490 
1491  do spin=1,ebands%nsppol
1492    do ikpt=1,ebands%nkpt
1493      nband_k=ebands%nband(ikpt+(spin-1)*ebands%nkpt)
1494 
1495      idx=0
1496      do band=1,nband_k
1497        if (ebands%eig(band,ikpt,spin) > ebands%fermie+ABS(tol_)) then
1498          idx=band; EXIT
1499        end if
1500      end do
1501      val_idx(ikpt,spin)=idx-1
1502      if (idx==1) val_idx(ikpt,spin)=idx
1503      if (idx==0) val_idx(ikpt,spin)=nband_k
1504 
1505    end do
1506  end do
1507 
1508 end function get_valence_idx

m_ebands/pack_eneocc [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 pack_eneocc

FUNCTION

  Helper function to do a reshape of (energies|occupancies|derivate of occupancies)
  initially stored in a 3D arrays returning a vector.

INPUTS

  nkpt=number of k-points
  nsppol=number of spin polarizations
  mband=Max number of bands over k-points (just to dimension the output)
  nbands(nkpt*nsppol)=Number of bands at eack k and spin
  bantot=Total number of bands
  array3d(mband,nkpt,nsppol)=Arrays containing the values to reshape.

OUTPUT

  vect(bantot)=The input values stored in vector mode. Only the values really
   considered at each k-point and spin are copied.

PARENTS

      cchi0q0_intraband,m_ebands,m_shirley

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

1210 subroutine pack_eneocc(nkpt,nsppol,mband,nband,bantot,array3d,vect)
1211 
1212 
1213 !This section has been created automatically by the script Abilint (TD).
1214 !Do not modify the following lines by hand.
1215 #undef ABI_FUNC
1216 #define ABI_FUNC 'pack_eneocc'
1217 !End of the abilint section
1218 
1219  implicit none
1220 
1221 !Arguments ------------------------------------
1222 !scalars
1223  integer,intent(in) :: nkpt,nsppol,mband,bantot
1224 !arrays
1225  integer,intent(in) :: nband(nkpt*nsppol)
1226  real(dp),intent(in) :: array3d(mband,nkpt,nsppol)
1227  real(dp),intent(out) :: vect(bantot)
1228 
1229 !Local variables-------------------------------
1230  integer :: spin,ikpt,band,idx
1231 
1232 ! *************************************************************************
1233 
1234  vect(:)=zero
1235  idx=0
1236  do spin=1,nsppol
1237    do ikpt=1,nkpt
1238      do band=1,nband(ikpt+(spin-1)*nkpt)
1239        idx=idx+1
1240        vect(idx)=array3d(band,ikpt,spin)
1241      end do
1242    end do
1243  end do
1244 
1245 end subroutine pack_eneocc

m_ebands/put_eneocc_vect [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 put_eneocc_vect

FUNCTION

  Update the energies or the occupations stored in a ebands_t structure.
  The input values are stored in a vector according to the abinit convention
  In the data type, on the contrary,  we use 3D arrays (mband,nkpt,nsspol)
  which are much easier to use inside loops.

INPUTS

  vect(ebands%bantot)=The new values to be stored in the structure.
  arr_name=The name of the quantity to be saved (CASE insensitive).
  Allowed values are
   == "eig"    == For the eigenvalues.
   == "occ"    == For the occupation numbers.
   == "doccde" == For the derivative of the occupancies wrt the energy.

OUTPUT

  See SIDE EFFECTS

SIDE EFFECTS

  ebands<ebands_t>=The object with updated values depending on the value of arr_name

PARENTS

      dfpt_looppert,m_ebands

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

1347 subroutine put_eneocc_vect(ebands,arr_name,vect)
1348 
1349 
1350 !This section has been created automatically by the script Abilint (TD).
1351 !Do not modify the following lines by hand.
1352 #undef ABI_FUNC
1353 #define ABI_FUNC 'put_eneocc_vect'
1354 !End of the abilint section
1355 
1356  implicit none
1357 
1358 !Arguments ------------------------------------
1359 !scalars
1360  character(len=*),intent(in) :: arr_name
1361  type(ebands_t),intent(inout) :: ebands
1362  real(dp),intent(in) :: vect(ebands%bantot)
1363 
1364 !Local variables-------------------------------
1365  integer :: nkpt,nsppol,mband,bantot
1366 ! *************************************************************************
1367 
1368  mband =ebands%mband; bantot=ebands%bantot; nkpt  =ebands%nkpt; nsppol=ebands%nsppol
1369 
1370  select case (tolower(arr_name))
1371  case ('occ')
1372    call unpack_eneocc(nkpt,nsppol,mband,ebands%nband,vect,ebands%occ, val=zero)
1373  case ('eig')
1374    ! DFPT routines call ebands_init with the wrong bantot. Using maxval(vect) causes SIGFAULT
1375    ! so I have to recompute the correct bantot here
1376    !ABI_CHECK(sum(ebands%nband) == ebands%bantot, "bantot and nband are incosistent")
1377    call unpack_eneocc(nkpt,nsppol,mband,ebands%nband,vect,ebands%eig, val=maxval(vect(1:sum(ebands%nband))))
1378  case ('doccde')
1379    call unpack_eneocc(nkpt,nsppol,mband,ebands%nband,vect,ebands%doccde, val=zero)
1380  case default
1381    MSG_BUG(sjoin('Wrong arr_name= ', arr_name))
1382  end select
1383 
1384 end subroutine put_eneocc_vect

m_ebands/unpack_eneocc [ Functions ]

[ Top ] [ m_ebands ] [ Functions ]

NAME

 unpack_eneocc

FUNCTION

  Helper function to do a reshape of (energies|occupancies|derivate of occupancies)
  initially stored in a vector. Return a 3D array index by (band,ikpt,spin)

INPUTS

  nkpt=number of k-points
  nsppol=number of spin polarizations
  mband=Max number of bands over k-points (just to dimension the output)
  nbands(nkpt*nsppol)=Number of bands at eack k and spin
  vect(:)=The input values to reshape
  [val]=Optional value used to initialize the array.

OUTPUT

  array3d(mband,nkpt,nsppol)=Arrays containing the values of vect.
   Note that the first dimension is usually larger than the
   number of bands really used for a particular k-point and spin.

PARENTS

      cchi0q0_intraband,m_ebands,m_ioarr,m_iowf

CHILDREN

      alloc_copy,ebands_free,ebands_write,kpath_free,kpath_print,wrtout

SOURCE

1136 subroutine unpack_eneocc(nkpt,nsppol,mband,nband,vect,array3d,val)
1137 
1138 
1139 !This section has been created automatically by the script Abilint (TD).
1140 !Do not modify the following lines by hand.
1141 #undef ABI_FUNC
1142 #define ABI_FUNC 'unpack_eneocc'
1143 !End of the abilint section
1144 
1145  implicit none
1146 
1147 !Arguments ------------------------------------
1148 !scalars
1149  integer,intent(in) :: nkpt,nsppol,mband
1150  real(dp),optional,intent(in) :: val
1151 !arrays
1152  integer,intent(in) :: nband(nkpt*nsppol)
1153  real(dp),intent(in) :: vect(:)
1154  real(dp),intent(out) :: array3d(mband,nkpt,nsppol)
1155 
1156 !Local variables-------------------------------
1157  integer :: spin,ikpt,band,idx
1158 ! *************************************************************************
1159 
1160  if (present(val)) then
1161    array3d = val
1162  else
1163    array3d = huge(one)
1164  end if
1165 
1166  idx=0
1167  ! elements in vect are packed in the first positions.
1168  do spin=1,nsppol
1169    do ikpt=1,nkpt
1170      do band=1,nband(ikpt+(spin-1)*nkpt)
1171       idx=idx+1
1172       array3d(band,ikpt,spin)=vect(idx)
1173      end do
1174    end do
1175  end do
1176 
1177 end subroutine unpack_eneocc