1!=============================================================================
2!
3! Utilities:
4!
5! (1) degeneracy_check    Originally By DAS      Last Modified 12/13/2010 (DAS)
6!
7!     Determines numbers of bands that can be used, compatible with the
8!     degenerate subspaces. Any number of wavefunctions can be given,
9!     in new format.
10!
11!==============================================================================
12
13#include "f_defs.h"
14
15program degeneracy_check
16
17  use global_m
18  use wfn_rho_vxc_io_m
19  implicit none
20
21  type(crystal) :: crys
22  type(symmetry) :: syms
23  type(kpoints) :: kp
24  type(gspace) :: gvec
25  character*3 :: sheader
26  character*256 :: infile, usage
27  integer :: ib, iflavor, minband, minvband, mincband, ik, is
28  integer :: nargs, ifile
29  logical, allocatable :: ok(:), ok_vband(:), ok_cband(:)
30
31  usage = 'Usage: degeneracy_check.x wfn [wfn2 [...]]'
32
33! Get file names from command-line arguments
34
35  nargs = iargc()
36
37  if (nargs .lt. 1) then
38    call die(usage)
39  endif
40
41  do ifile = 1, nargs
42
43    call getarg(ifile, infile)
44    call open_file(unit=7,file=TRUNC(infile),form='unformatted',status='old')
45
46    sheader = 'WFN'
47    iflavor = -1
48    call read_binary_header_type(7, sheader, iflavor, kp, gvec, syms, crys, warn = .false., dont_warn_kgrid = .true.)
49
50    ! Output info
51    write(6,'(a)') 'Reading eigenvalues from file ' // TRUNC(infile)
52    write(6,'("Number of spins:",i16)') kp%nspin
53    write(6,'("Number of bands:",i16)') kp%mnband
54    write(6,'("Number of k-points:",i13)') kp%nrk
55
56    kp%nvband=minval(kp%ifmax(:,:)-kp%ifmin(:,:))+1
57    kp%ncband=kp%mnband-maxval(kp%ifmax(:,:))
58
59    if(ifile == 1) then
60      SAFE_ALLOCATE(ok,(kp%mnband - 1))
61      ok(1:kp%mnband - 1) = .true.
62      minband = kp%mnband
63
64      SAFE_ALLOCATE(ok_vband,(kp%nvband - 1))
65      ok_vband(:) = .true.
66      minvband = kp%nvband
67
68      if(kp%ncband - 1 > 0) then
69        ! avoid allocation <= 0
70        SAFE_ALLOCATE(ok_cband,(kp%ncband - 1))
71        ok_cband(:) = .true.
72      endif
73      mincband = kp%ncband
74    else
75      minband = min(minband, kp%mnband)
76      minvband = min(minvband, kp%nvband)
77      mincband = min(mincband, kp%ncband)
78    endif
79
80    do ib = 1, minband - 1
81      ok(ib) = ok(ib) .and. &
82        all(abs(kp%el(ib, 1:kp%nrk, 1:kp%nspin) - kp%el(ib + 1, 1:kp%nrk, 1:kp%nspin)) .gt. TOL_Degeneracy)
83    enddo
84
85    do ib = 1, minvband - 1
86      do is = 1, kp%nspin
87        do ik = 1, kp%nrk
88          ok_vband(ib) = ok_vband(ib) .and. &
89            (abs(kp%el(kp%ifmax(ik, is) - ib + 1, ik, is) &
90            - kp%el(kp%ifmax(ik, is) - ib, ik, is)) .gt. TOL_Degeneracy)
91        enddo
92      enddo
93    enddo
94
95    do ib = 1, mincband - 1
96      do is = 1, kp%nspin
97        do ik = 1, kp%nrk
98          ok_cband(ib) = ok_cband(ib) .and. &
99            (abs(kp%el(kp%ifmax(ik, is) + ib, ik, is) &
100            - kp%el(kp%ifmax(ik, is) + ib + 1, ik, is)) .gt. TOL_Degeneracy)
101        enddo
102      enddo
103    enddo
104
105    call dealloc_header_type(sheader, crys, kp)
106    call close_file(7)
107  enddo
108
109  if(nargs > 1) write(6,'(a,i6)') 'Minimum number of bands in files: ', minband
110
111  write(6,'(a)')
112  write(6,'(a)') '== Degeneracy-allowed numbers of bands (for epsilon and sigma) =='
113
114  do ib = 1, minband - 1
115    if(ok(ib)) then
116      write(6,*) ib
117    endif
118  enddo
119
120  write(6,'(a,i6,a)') 'Note: cannot assess whether or not highest band ', minband, ' is degenerate.'
121
122  write(6,'(a)')
123  write(6,'(a)') '== Degeneracy-allowed numbers of valence bands (for inteqp, kernel, and absorption) =='
124
125  do ib = 1, minvband - 1
126    if(ok_vband(ib)) then
127      write(6,*) ib
128    endif
129  enddo
130  write(6,*) minvband ! using all bands is always allowed ... ?
131
132  if(mincband - 1 > 0) then
133    write(6,'(a)')
134    write(6,'(a)') '== Degeneracy-allowed numbers of conduction bands (for inteqp, kernel, and absorption) =='
135
136    do ib = 1, mincband - 1
137      if(ok_cband(ib)) then
138        write(6,*) ib
139      endif
140    enddo
141
142    write(6,'(a,i6,a)') 'Note: cannot assess whether or not highest conduction band ', mincband, ' is degenerate.'
143    SAFE_DEALLOCATE(ok_cband)
144  endif
145
146  SAFE_DEALLOCATE(ok)
147  SAFE_DEALLOCATE(ok_vband)
148
149end program degeneracy_check
150