fermie.F90 7.93 KB
 Markus Betzinger committed Apr 26, 2016 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 ``````MODULE m_fermie USE m_juDFT !----------------------------------------------------------------------- ! determines the fermi energy by ! gaussian-integration method c.l.fu ! triangular method (or tetrahedrons) ! or fermi-function p.kurz !---------------------------------------------------------------------- CONTAINS SUBROUTINE fermie(eig_id, mpi,kpts,obsolete,& input, noco,e_min,jij,cell,results) !---------------------------------------------------f-------------------- ! ! a fist (T=0) approximation to the fermi-energy is determined ! by: ! zelec = sum { spindg * we } ! e= READ IN EIGENVALUES ! spindg = 2.0/REAL(input%jspins) n = 0 results%seigsc = 0.0 ssc = 0.0 n_help = 0 ! !---> pk non-collinear IF (noco%l_noco) THEN nspins = 1 ELSE nspins = input%jspins ENDIF !---> pk non-collinear ! DO jsp = 1,nspins DO k = 1,kpts%nkpt CALL read_eig(eig_id,k,jsp,neig=ne(k,jsp),eig=eig(:,k,jsp)) IF ( mpi%irank == 0 ) THEN WRITE (6,'(a2,3f10.5,f12.6)') 'at',kpts%bk(:,k),kpts%wtkpt(k) WRITE (6,'(i5,a14)') ne(k,jsp),' eigenvalues :' WRITE (6,'(8f12.6)') (eig(i,k,jsp),i=1,ne(k,jsp)) END IF nv= -1 ! !---> STORE EIGENVALUES AND WEIGHTS IN A LINEAR LIST. AND MEMORIZE !---> CONECTION TO THE ORIGINAL ARRAYS ! DO j = 1,ne(k,jsp) e(n+j) = eig(j,k,jsp) we(n+j) = kpts%wtkpt(k) idxeig(n+j) = j+n_help idxkpt(n+j) = k idxjsp(n+j) = jsp ENDDO !---> COUNT THE NUMBER OF EIGENVALUES n = n + ne(k,jsp) ENDDO ENDDO CALL sort(n,e,index) ! Check if no deep eigenvalue is found IF (e_min-MINVAL(e(1:n))>1.0) THEN WRITE(6,*) 'WARNING: Too low eigenvalue detected:' WRITE(6,*) 'min E=', MINVAL(e(1:n)),' min(enpara)=',& & e_min CALL juDFT_warn("Too low eigenvalue detected",calledby="fermi" & & ,hint ="If the lowest eigenvalue is more than 1Htr below "//& & "the lowest energy parameter, you probably have picked up"//& & " a ghoststate") END IF ! !---> DETERMINE EF BY SUMMING WEIGHTS ! weight = input%zelec/spindg results%seigv = 0.0e0 ws = 0.0e0 l = 0 DO WHILE ((ws+del).LT.weight) l = l + 1 IF (l.GT.n) THEN IF ( mpi%irank == 0 ) THEN WRITE (16,FMT=8010) n,ws,weight WRITE (6,FMT=8010) n,ws,weight END IF CALL juDFT_error("fermi",calledby="fermie") 8010 FORMAT (/,10x,'error: not enough wavefunctions.',i10,& & 2d20.10) END IF ws = ws + we(INDEX(l)) results%seigv = results%seigv + e(INDEX(l))*we(INDEX(l))*spindg ! WRITE (6,FMT='(2f10.7)') e(index(l)),we(index(l)) END DO results%ef = e(INDEX(l)) nstef = l zc = input%zelec IF ( mpi%irank == 0 ) WRITE (6,FMT=8020) results%ef,nstef,results%seigv,ws,results%seigsc,ssc !+po results%ts = 0.0 !-po results%w_iks = 0.0 IF (input%gauss) THEN CALL fergwt(kpts,input,mpi,ne, eig,results) ELSE IF (input%tria) THEN CALL fertri(mpi%irank, ne,kpts%nkpt,nspins,zc,eig,kpts%bk,spindg,& results%ef,results%seigv,results%w_iks) ELSE nspins = input%jspins IF (noco%l_noco) nspins = 1 tkb_1 = input%tkb CALL ferhis(input,kpts,mpi,results,index,idxeig,idxkpt,idxjsp, n,& nstef,ws,spindg,weight,e,ne,we, noco,jij,cell) END IF ! 7.12.95 r.pentcheva seigscv must be calculated outside if (gauss) results%seigscv = results%seigsc + results%seigv ! DEALLOCATE ( idxeig,idxjsp,idxkpt,index,e,eig,we ) ! RETURN 8020 FORMAT (/,'FERMIE:',/,& `````` Daniel Wortmann committed Apr 29, 2016 222 `````` & 10x,'first approx. to ef (T=0) :',f10.6,' htr',& `````` Markus Betzinger committed Apr 26, 2016 223 224 `````` & ' (energy of the highest occ. eigenvalue)',/,& & 10x,'number of occ. states (T=0) :',i10,/,& `````` Daniel Wortmann committed Apr 29, 2016 225 `````` & 10x,'first approx. to seigv (T=0) :',f10.6,' htr',/,& `````` Markus Betzinger committed Apr 26, 2016 226 227 228 229 230 `````` & 10x,'sum of weights of occ. states :',f10.6,/,& & 10x,'sum of semicore eigenvalues :',f10.6,' htr',/,& & 10x,'sum of semicore charge :',f10.6,' e',/) END SUBROUTINE fermie END MODULE m_fermie``````