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