LCOV - code coverage report
Current view: top level - kpoints - unfoldBandKPTS.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 223 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 7 0.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2018 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             : MODULE m_unfold_band_kpts
       8             : 
       9             : CONTAINS
      10             : 
      11           0 :   SUBROUTINE build_primitive_cell(banddos,p_cell,cell)
      12             :     USE m_types
      13             :     USE m_inv3
      14             :     USE m_constants, ONLY : tpi_const
      15             :     implicit none
      16             :     TYPE(t_banddos),INTENT(IN)  :: banddos
      17             :     TYPE(t_cell),INTENT(IN)     :: cell
      18             :     TYPE(t_cell),INTENT(INOUT)  :: p_cell
      19             : 
      20             :     INTEGER :: i
      21           0 :     DO i =1,3
      22           0 :         p_cell%amat(1,i)=cell%amat(1,i)/banddos%s_cell_x
      23           0 :         p_cell%amat(2,i)=cell%amat(2,i)/banddos%s_cell_y 
      24           0 :         p_cell%amat(3,i)=cell%amat(3,i)/banddos%s_cell_z 
      25             : !       p_cell%amat(i,1)=cell%amat(i,1)/banddos%s_cell_x
      26             : !       p_cell%amat(i,2)=cell%amat(i,2)/banddos%s_cell_y 
      27             : !       p_cell%amat(i,3)=cell%amat(i,3)/banddos%s_cell_z 
      28             :     END DO
      29           0 :     CALL inv3(p_cell%amat,p_cell%bmat,p_cell%omtil)
      30           0 :     p_cell%bmat=p_cell%bmat*tpi_const
      31           0 :     p_cell%latnam=cell%latnam
      32           0 :   END SUBROUTINE  build_primitive_cell
      33             : 
      34           0 :   SUBROUTINE unfold_band_kpts(banddos,p_cell,cell,p_kpts,kpts)
      35             :     USE m_types
      36             :     USE m_inv3
      37             :     USE m_constants, ONLY : tpi_const
      38             : 
      39             :     implicit none
      40             : 
      41             :     TYPE(t_banddos),INTENT(IN)  :: banddos
      42             :     TYPE(t_cell),INTENT(IN)     :: cell
      43             :     TYPE(t_cell),INTENT(INOUT)  :: p_cell
      44             :     TYPE(t_kpts),INTENT(INOUT)  :: p_kpts
      45             :     TYPE(t_kpts),INTENT(INOUT)  :: kpts
      46             :    
      47           0 :     CALL build_primitive_cell(banddos,p_cell,cell)
      48             : 
      49           0 :     p_kpts=kpts
      50             :     !write(1088,*) 'banddos%unfoldband: ', banddos%unfoldband
      51             :     !write(1088,*) 'brav. matrix: '
      52             :     !write(1088,'(f15.8,f15.8,f15.8)') cell%amat(1,1), cell%amat(1,2), cell%amat(1,3)
      53             :     !write(1088,'(f15.8,f15.8,f15.8)') cell%amat(2,1), cell%amat(2,2), cell%amat(2,3)
      54             :     !write(1088,'(f15.8,f15.8,f15.8)') cell%amat(3,1), cell%amat(3,2), cell%amat(3,3)
      55             :     !write(1088,*) 'brav. rez. matrix: '
      56             :     !write(1088,'(f15.8,f15.8,f15.8)') cell%bmat(1,1), cell%bmat(1,2), cell%bmat(1,3)
      57             :     !write(1088,'(f15.8,f15.8,f15.8)') cell%bmat(2,1), cell%bmat(2,2), cell%bmat(2,3)
      58             :     !write(1088,'(f15.8,f15.8,f15.8)') cell%bmat(3,1), cell%bmat(3,2), cell%bmat(3,3)
      59             :     !write(1088,*) ' primitive brav. matrix: '
      60             :     !write(1088,'(f15.8,f15.8,f15.8)') p_cell%amat(1,1), p_cell%amat(1,2), p_cell%amat(1,3)
      61             :     !write(1088,'(f15.8,f15.8,f15.8)') p_cell%amat(2,1), p_cell%amat(2,2), p_cell%amat(2,3)
      62             :     !write(1088,'(f15.8,f15.8,f15.8)') p_cell%amat(3,1), p_cell%amat(3,2), p_cell%amat(3,3)
      63             :     !write(1088,*) 'primitive brav. rez. matrix: '
      64             :     !write(89,'(3f15.8)') p_cell%bmat
      65             :     !write(1088,'(f15.8,f15.8,f15.8)') p_cell%bmat(1,1), p_cell%bmat(1,2), p_cell%bmat(1,3)
      66             :     !write(1088,'(f15.8,f15.8,f15.8)') p_cell%bmat(2,1), p_cell%bmat(2,2), p_cell%bmat(2,3)
      67             :     !write(1088,'(f15.8,f15.8,f15.8)') p_cell%bmat(3,1), p_cell%bmat(3,2), p_cell%bmat(3,3)
      68             :     !write(1088,'(a,i7,a,i7)') 'kpts%nkpt',kpts%nkpt,'   p_kpts%nkpt',p_kpts%nkpt
      69             :     !write(1088,*) kpts%specialPoints
      70           0 :   END SUBROUTINE unfold_band_kpts
      71             :   
      72           0 :   SUBROUTINE find_supercell_kpts(banddos,p_cell,cell,p_kpts,kpts)
      73             :     USE m_types
      74             :     USE m_juDFT
      75             :     USE m_inv3
      76             :     implicit none
      77             : 
      78             :     TYPE(t_banddos),INTENT(IN)  :: banddos
      79             :     TYPE(t_cell),INTENT(IN)     :: cell
      80             :     TYPE(t_cell),INTENT(IN)     :: p_cell
      81             :     TYPE(t_kpts),INTENT(IN)     :: p_kpts
      82             :     TYPE(t_kpts),INTENT(INOUT)  :: kpts
      83             :     
      84             :     INTEGER :: i,m1,m2,m3
      85             :     REAL    :: rez_inv_to_internal(3,3)
      86             :     REAL    :: rez_inv_det
      87           0 :     REAL    :: list(13,p_kpts%nkpt)  !cartesion coordinates for k,K,m
      88             :     REAL    :: pc_kpoint_i(3)    !primitive cell kpoint internal
      89             :     REAL    :: sc_kpoint_i(3)    !super cell kpoint internal
      90             :     REAL    :: pc_kpoint_c(3)    !primitive cell kpoint cartesian
      91             :     REAL    :: sc_kpoint_c(3)    !super cell kpoint cartesian
      92             :     REAL    :: eps(3)
      93             :     REAL    :: eps_r, eps_kpt
      94             :     LOGICAL :: representation_found
      95             :     REAL    ::kpt_dist
      96             : 
      97             :     eps = 1.0e-10
      98           0 :     eps_r = 0.000000001
      99             : 
     100           0 :     CALL inv3(cell%bmat,rez_inv_to_internal,rez_inv_det)
     101             :     !write(1088,*) p_kpts%specialPoints
     102             :     !write(333,'(3f15.8)')p_kpts%bk
     103           0 :     kpt_dist=0
     104           0 :     DO i= 1,size(list,2)
     105             :         !        pc_kpoint_c(1)=p_kpts%bk(1,i)*p_cell%bmat(1,1)+p_kpts%bk(2,i)*p_cell%bmat(1,2)+p_kpts%bk(3,i)*p_cell%bmat(1,3)
     106             :         !        pc_kpoint_c(2)=p_kpts%bk(1,i)*p_cell%bmat(2,1)+p_kpts%bk(2,i)*p_cell%bmat(2,2)+p_kpts%bk(3,i)*p_cell%bmat(2,3)
     107             :         !        pc_kpoint_c(3)=p_kpts%bk(1,i)*p_cell%bmat(3,1)+p_kpts%bk(2,i)*p_cell%bmat(3,2)+p_kpts%bk(3,i)*p_cell%bmat(3,3)
     108           0 :                 pc_kpoint_c(1)=p_kpts%bk(1,i)*p_cell%bmat(1,1)+p_kpts%bk(2,i)*p_cell%bmat(2,1)+p_kpts%bk(3,i)*p_cell%bmat(3,1)
     109           0 :                 pc_kpoint_c(2)=p_kpts%bk(1,i)*p_cell%bmat(1,2)+p_kpts%bk(2,i)*p_cell%bmat(2,2)+p_kpts%bk(3,i)*p_cell%bmat(3,2)
     110           0 :                 pc_kpoint_c(3)=p_kpts%bk(1,i)*p_cell%bmat(1,3)+p_kpts%bk(2,i)*p_cell%bmat(2,3)+p_kpts%bk(3,i)*p_cell%bmat(3,3)
     111           0 :                 list(1,i)=pc_kpoint_c(1)
     112           0 :                 list(2,i)=pc_kpoint_c(2)
     113           0 :                 list(3,i)=pc_kpoint_c(3)
     114             :         !!!!------- finding kpts in primitive rez. unit cell ----- 
     115             :         !       representation_found=.false.
     116             :         !m_loop:        DO m1= -banddos%s_cell_x,banddos%s_cell_x
     117             :         !               DO m2= -banddos%s_cell_y,banddos%s_cell_y
     118             :         !                       DO m3= -banddos%s_cell_z,banddos%s_cell_z
     119             :         !                               pc_kpoint_c(1)=list(1,i)-m1*cell%bmat(1,1)-m2*cell%bmat(1,2)-m3*cell%bmat(1,3)
     120             :         !                               pc_kpoint_c(2)=list(2,i)-m1*cell%bmat(2,1)-m2*cell%bmat(2,2)-m3*cell%bmat(2,3)
     121             :         !                               pc_kpoint_c(3)=list(3,i)-m1*cell%bmat(3,1)-m2*cell%bmat(3,2)-m3*cell%bmat(3,3)
     122             :         !!                              IF (         (dot_product(pc_kpoint_c(:)+eps(:), cell%bmat(:,1)) >= 0).AND.((dot_product(pc_kpoint_c(:)+eps(:), cell%bmat(:,1)) < dot_product(cell%bmat(:,1), cell%bmat(:,1)))) &
     123             :         !!                                   & .AND. (dot_product(pc_kpoint_c(:)+eps(:), cell%bmat(:,2)) >= 0).AND.((dot_product(pc_kpoint_c(:)+eps(:), cell%bmat(:,2)) < dot_product(cell%bmat(:,2), cell%bmat(:,2)))) &
     124             :         !!                                   & .AND. (dot_product(pc_kpoint_c(:)+eps(:), cell%bmat(:,3)) >= 0).AND.((dot_product(pc_kpoint_c(:)+eps(:), cell%bmat(:,3)) < dot_product(cell%bmat(:,3), cell%bmat(:,3))))) THEN
     125             :         !                               IF (all((matmul(rez_inv_to_internal,pc_kpoint_c)+eps(:))>=0).and.all((matmul(rez_inv_to_internal,pc_kpoint_c)+eps(:))<1)) THEN
     126             :         !                                       list(4,i)=pc_kpoint_c(1)
     127             :         !                                       list(5,i)=pc_kpoint_c(2)
     128             :         !                                       list(6,i)=pc_kpoint_c(3)
     129             :         !                                       list(7,i)=-m1
     130             :         !                                       list(8,i)=-m2
     131             :         !                                       list(9,i)=-m3
     132             :         !                                       representation_found=.true.
     133             :         !                               END IF
     134             :          !                                      IF (representation_found) EXIT m_loop
     135             :         !                       END DO
     136             :         !               END DO
     137             :         !       END DO m_loop
     138             :          !       IF (.not.representation_found) THEN
     139             :           !      write(*,'(a,f15.8,f15.8,f15.8)') 'No representation found for the following kpoint:',list(1,i),list(2,i),list(3,i)
     140             :            !     END IF
     141             :            !----------------------- method internal coordintes --------------------
     142           0 :             sc_kpoint_i(:)=matmul(pc_kpoint_c,rez_inv_to_internal)
     143             :             pc_kpoint_i(:)=p_kpts%bk(1:3,i)
     144             :             !sc_kpoint_i(:) = sc_kpoint_i(:) + 0.5
     145           0 :             m1 = FLOOR(sc_kpoint_i(1))
     146           0 :             m2 = FLOOR(sc_kpoint_i(2))
     147           0 :             m3 = FLOOR(sc_kpoint_i(3))
     148           0 :             m1=0
     149           0 :             m2=0
     150           0 :             m3=0
     151             :             sc_kpoint_i(1) = sc_kpoint_i(1) - m1
     152             :             sc_kpoint_i(2) = sc_kpoint_i(2) - m2
     153             :             sc_kpoint_i(3) = sc_kpoint_i(3) - m3 
     154             :             !sc_kpoint_i(:) = sc_kpoint_i(:) - 0.5
     155           0 :             list(4,i)=sc_kpoint_i(1)
     156           0 :             list(5,i)=sc_kpoint_i(2)
     157           0 :             list(6,i)=sc_kpoint_i(3)
     158           0 :             list(7,i)=m1
     159           0 :             list(8,i)=m2
     160           0 :             list(9,i)=m3 !this whole block is to move kpoints into first BZ within -0.5 to 0.5
     161             : 
     162             :         !       kpts%bk(:,i)=matmul(rez_inv_to_internal,pc_kpoint_c)
     163             :             !-------------saving old kpts----------
     164           0 :             list(11:13,i)=kpts%bk(:,i)
     165             :             !------finished---------
     166           0 :             kpts%bk(:,i)=list(4:6,i)
     167             :         
     168           0 :         IF (i>1) THEN
     169           0 :         kpt_dist=kpt_dist+sqrt(dot_product(list(1:3,i)-list(1:3,i-1),list(1:3,i)-list(1:3,i-1)))
     170             :         END IF
     171           0 :         list(10,i)=kpt_dist
     172             :     END DO
     173             :     !write(91,'(3f15.8)') kpts%bk
     174             :     !write(92,*) kpts%wtkpt
     175           0 :     ALLOCATE (kpts%sc_list(13,p_kpts%nkpt))
     176           0 :     kpts%specialPointIndices(:) = p_kpts%specialPointIndices(:)
     177           0 :     kpts%sc_list=list
     178             :     !write(90,'(10f15.8)') kpts%sc_list
     179           0 :   END SUBROUTINE find_supercell_kpts
     180             : 
     181           0 :  SUBROUTINE calculate_plot_w_n(banddos,cell,kpts,smat_unfold,zMat,lapw,i_kpt,jsp,eig,results,input,atoms,unfoldingBuffer,mpi)
     182             :         USE m_types
     183             :         USE m_juDFT
     184             :         USE m_inv3
     185             :         USE m_types_mpimat
     186             :         USE m_constants
     187             :         implicit none
     188             : 
     189             :         TYPE(t_input),INTENT(IN) :: input
     190             :         TYPE(t_atoms),INTENT(IN)     :: atoms
     191             :         TYPE(t_banddos),INTENT(IN)  :: banddos
     192             :         TYPE(t_results),INTENT(INOUT)  :: results
     193             :         TYPE(t_cell),INTENT(IN)     :: cell
     194             :         TYPE(t_kpts),INTENT(INOUT)     :: kpts
     195             :         CLASS(t_mat),INTENT(INOUT)  :: smat_unfold
     196             :         CLASS(t_mat),INTENT(IN)     :: zMat
     197             :         TYPE(t_lapw),INTENT(IN)     :: lapw
     198             :         TYPE(t_mpi),INTENT(IN)       :: mpi
     199             :         TYPE(t_cell)      :: p_cell
     200             :         INTEGER, INTENT(IN)         :: i_kpt,jsp
     201             :         REAL, INTENT(IN)            :: eig(:)
     202             :         COMPLEX, INTENT(INOUT)         :: unfoldingBuffer(:,:,:)
     203             :         INTEGER :: i,j,k,l,n
     204             :         INTEGER :: na,n_i,nn,nk,nki,gi,lo
     205           0 :         REAL, ALLOCATABLE       ::w_n(:)
     206           0 :         COMPLEX, ALLOCATABLE    ::w_n_c(:)
     207           0 :         REAL, ALLOCATABLE       ::w_n_sum(:)
     208           0 :         COMPLEX, ALLOCATABLE    ::w_n_c_sum(:)
     209             :         LOGICAL :: method_rubel=.false.
     210             :         LOGICAL :: write_to_file=.false.
     211           0 :         CLASS(t_mat), ALLOCATABLE :: zMat_s
     212             : 
     213             : !       method_rubel=.true.    !this switch is to switch between overlap matrix and rubel method (without overlap matrix)
     214             : 
     215           0 :         CALL build_primitive_cell(banddos,p_cell,cell)
     216           0 :         IF (.not. method_rubel) THEN
     217           0 :                 DO j = 1, lapw%nv(jsp)
     218           0 :                   DO i = 1, j-1
     219           0 :                         IF(smat_unfold%l_real) THEN
     220           0 :                                 smat_unfold%data_r(j,i) = smat_unfold%data_r(i,j)
     221             :                         ELSE
     222           0 :                                 smat_unfold%data_c(j,i) = CONJG(smat_unfold%data_c(i,j))
     223             :                         END IF
     224             :                    END DO
     225             :                 END DO
     226             :         END IF
     227             : !       write_to_file=.true.
     228           0 :         IF (write_to_file) THEN
     229           0 :                 IF (i_kpt==1) THEN
     230           0 :                         IF (jsp==1) OPEN (679,file='bands_sc_old.1',status='unknown') !This is kind of my birthday 6 july 1992 (S.R.)
     231           0 :                         IF (jsp==2) OPEN (680,file='bands_sc_old.2',status='unknown')
     232             :                 END IF
     233             :         END IF
     234             : 
     235             : !               write(*,*) 'real zmat size dim 1:', size(zMat%data_r,1), 'dim2:', size(zMat%data_r,2)
     236             : !               write(*,*) 'smat dim1', size(smat_unfold%data_r,1), 'dim2', size(smat_unfold%data_r,2),'data',smat_unfold%data_r(2,2)
     237             : !               write(222,'(234f15.8)') zMat%data_r
     238             : !               write(223,'(234f15.8)') smat_unfold%data_r
     239             : 
     240             : 
     241           0 :         IF (zmat%l_real) THEN   
     242           0 :                 ALLOCATE(w_n(zMat%matsize2))
     243           0 :                 w_n = 0
     244             : !           IF (method_rubel) THEN
     245           0 :                 ALLOCATE(w_n_sum(zMat%matsize2))
     246           0 :                 w_n_sum = 0
     247             : !           END IF
     248             :         ELSE
     249           0 :                 ALLOCATE(w_n_c(zMat%matsize2))
     250           0 :                 w_n_c=0 
     251             : !           IF (method_rubel) THEN
     252           0 :                 ALLOCATE(w_n_c_sum(zMat%matsize2))
     253           0 :                 w_n_c_sum=0     
     254             : !           END IF
     255             :         END IF
     256             : !---------create zmat_s--- smat*zmat---------------------
     257             :         select type(zMat)
     258             :                 type is (t_mat)
     259           0 :                 allocate(t_mat::zMat_s)
     260           0 :                 select type(zMat_s)
     261             :                         type is (t_mat)
     262           0 :                         zMat_s=zMat
     263             :                 end select
     264             :                 type is (t_mpimat)
     265           0 :                 allocate(t_mpimat::zMat_s)
     266           0 :                 select type(zMat_s)
     267             :                         type is (t_mpimat)
     268           0 :                         zMat_s=zMat
     269             :                 end select
     270             :         end select
     271             : !---------------------------------------------------------
     272             : !               write(345,'(3I6)') lapw%gvec(:,:,jsp)
     273           0 :         write (*,*)results%ef
     274           0 :         write (*,*) i_kpt
     275           0 :         IF (.not. method_rubel) THEN
     276             : !          IF (mpi%n_size==1) THEN       
     277             : !             call smat_unfold%multiply(zMat,zMat_s)
     278             : !          ELSE
     279             : !             call smat_unfold%mpimat_multiply(zMat,zMat_s)
     280             : !          ENDIF  
     281           0 :            call smat_unfold%multiply(zMat,zMat_s)
     282             :         END IF
     283           0 :        !$omp parallel private(j,n_i,nn,na,lo,nk,nki,gi)
     284           0 :        !$omp do
     285             :         DO i=1,zMat%matsize2
     286           0 :                 IF (method_rubel) THEN
     287           0 :                         DO j=1,lapw%nv(jsp)
     288           0 :                                 IF (zmat%l_real) THEN
     289           0 :                                         w_n_sum(i)=w_n_sum(i)+zMat%data_r(j,i)*zMat%data_r(j,i)
     290             : !                                               write(*,*) 'zMat is real'
     291             :                                 ELSE
     292           0 :                                         w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(j,i)
     293             : !                                               write(*,*) 'zMat is complex'
     294             :                                 END IF
     295             :                                 IF ((modulo(lapw%gvec(1,j,jsp)+NINT(kpts%sc_list(7,i_kpt)),banddos%s_cell_x)==0).AND.&
     296           0 :                                      &(modulo(lapw%gvec(2,j,jsp)+NINT(kpts%sc_list(8,i_kpt)),banddos%s_cell_y)==0).AND.&
     297           0 :                                      &(modulo(lapw%gvec(3,j,jsp)+NINT(kpts%sc_list(9,i_kpt)),banddos%s_cell_z)==0)) THEN
     298           0 :                                         IF (zmat%l_real) THEN
     299           0 :                                                 w_n(i)=w_n(i)+zMat%data_r(j,i)*zMat%data_r(j,i)
     300             : !                                                       write(*,*) 'zMat is real'
     301             :                                         ELSE
     302           0 :                                                 w_n_c(i)=w_n_c(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(j,i)
     303             : !                                                       write(*,*) 'zMat is complex'
     304             :                                         END IF
     305             :                                 END IF
     306             :                         END DO
     307             : !------------------LO's------------------------
     308           0 :                         na=0
     309           0 :                         DO n_i=1,atoms%ntype
     310           0 :                                 DO nn=1,atoms%neq(n_i)
     311           0 :                                         na=na+1
     312           0 :                                         DO lo=1,atoms%nlo(n_i)
     313           0 :                                                 nk=lapw%nkvec(lo,na)
     314           0 :                                                 DO nki=1,nk
     315           0 :                                                         gi=lapw%kvec(nki,lo,na)
     316           0 :                                                         j=lapw%nv(jsp)+lapw%index_lo(lo,na)+nki
     317           0 :                                                         IF (zmat%l_real) THEN
     318           0 :                                                                 w_n_sum(i)=w_n_sum(i)+zMat%data_r(j,i)*zMat%data_r(j,i)
     319             :                                                         ELSE
     320           0 :                                                                 w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(j,i)
     321             :                                                         END IF
     322             :                                                         IF ((modulo(lapw%gvec(1,gi,jsp)+NINT(kpts%sc_list(7,i_kpt)),banddos%s_cell_x)==0).AND.&
     323           0 :                                                            &(modulo(lapw%gvec(2,gi,jsp)+NINT(kpts%sc_list(8,i_kpt)),banddos%s_cell_y)==0).AND.&
     324           0 :                                                            &(modulo(lapw%gvec(3,gi,jsp)+NINT(kpts%sc_list(9,i_kpt)),banddos%s_cell_z)==0)) THEN
     325           0 :                                                                 IF (zmat%l_real) THEN
     326           0 :                                                                         w_n(i)=w_n(i)+zMat%data_r(j,i)*zMat%data_r(j,i)
     327             :                                                                 ELSE
     328           0 :                                                                         w_n_c(i)=w_n_c(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(j,i)
     329             :                                                                 END IF
     330             :                                                         END IF
     331             :                                                 END DO
     332             :                                         END DO
     333             :                                 END DO
     334             :                         END DO
     335             : !--------------------------LO's finished----------------
     336             :                 ELSE
     337           0 :                         DO j=1,lapw%nv(jsp)
     338             : !                               DO k=1,zMat%matsize1
     339           0 :                                         IF (zmat%l_real) THEN
     340             : !                                               w_n_sum(i)=w_n_sum(i)+zMat%data_r(j,i)*zMat%data_r(k,i)*smat_unfold%data_r(j,k)
     341           0 :                                                 w_n_sum(i)=w_n_sum(i)+zMat%data_r(j,i)*zMat_s%data_r(j,i)
     342             :                                         ELSE
     343             : !                                               w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(k,i)*smat_unfold%data_c(j,k)
     344           0 :                                                 w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zMat%data_c(j,i))*zMat_s%data_c(j,i)
     345             :                                         END IF
     346             : !                               END DO
     347             :                                 IF ((modulo(lapw%gvec(1,j,jsp)+NINT(kpts%sc_list(7,i_kpt)),banddos%s_cell_x)==0).AND.&
     348           0 :                                    &(modulo(lapw%gvec(2,j,jsp)+NINT(kpts%sc_list(8,i_kpt)),banddos%s_cell_y)==0).AND.&
     349           0 :                                    &(modulo(lapw%gvec(3,j,jsp)+NINT(kpts%sc_list(9,i_kpt)),banddos%s_cell_z)==0)) THEN
     350             : !                                       DO k=1,zMat%matsize1
     351           0 :                                                 IF (zmat%l_real) THEN
     352             : !                                                       w_n(i)=w_n(i)+zMat%data_r(j,i)*zMat%data_r(k,i)*smat_unfold%data_r(j,k)
     353           0 :                                                         w_n(i)=w_n(i)+zMat%data_r(j,i)*zMat_s%data_r(j,i)
     354             :                                                 ELSE
     355             : !                                                       w_n_c(i)=w_n_c(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(k,i)*smat_unfold%data_c(j,k)
     356           0 :                                                         w_n_c(i)=w_n_c(i)+CONJG(zMat%data_c(j,i))*zMat_s%data_c(j,i)
     357             :                                                 END IF
     358             : !                                       END DO
     359             :                                 END IF
     360             :                         END DO
     361             : !                       write(1250+mpi%irank,'(4f15.8)') w_n_c(i),w_n_c_sum(i)
     362             : !------------------LO's------------------------
     363           0 :                         na=0
     364           0 :                         DO n_i=1,atoms%ntype
     365           0 :                                 DO nn=1,atoms%neq(n_i)
     366           0 :                                         na=na+1
     367           0 :                                         DO lo=1,atoms%nlo(n_i)
     368           0 :                                                 nk=lapw%nkvec(lo,na)
     369           0 :                                                 DO nki=1,nk
     370           0 :                                                         gi=lapw%kvec(nki,lo,na)
     371           0 :                                                         j=lapw%nv(jsp)+lapw%index_lo(lo,na)+nki
     372             :                                 !                       DO k=1,zMat%matsize1
     373           0 :                                                                 IF (zmat%l_real) THEN
     374             :                                 !                                               w_n_sum(i)=w_n_sum(i)+zMat%data_r(j,i)*zMat%data_r(k,i)*smat_unfold%data_r(j,k)
     375           0 :                                                                         w_n_sum(i)=w_n_sum(i)+zMat%data_r(j,i)*zMat_s%data_r(j,i)
     376             :                                                                 ELSE
     377             :                                 !                                               w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(k,i)*smat_unfold%data_c(j,k)
     378           0 :                                                                         w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zMat%data_c(j,i))*zMat_s%data_c(j,i)
     379             :                                                                 END IF
     380             :                                 !                       END DO
     381             :                                                         IF ((modulo(lapw%gvec(1,gi,jsp)+NINT(kpts%sc_list(7,i_kpt)),banddos%s_cell_x)==0).AND.&
     382           0 :                                                            &(modulo(lapw%gvec(2,gi,jsp)+NINT(kpts%sc_list(8,i_kpt)),banddos%s_cell_y)==0).AND.&
     383           0 :                                                            &(modulo(lapw%gvec(3,gi,jsp)+NINT(kpts%sc_list(9,i_kpt)),banddos%s_cell_z)==0)) THEN
     384             :                         !                                       DO k=1,zMat%matsize1
     385           0 :                                                                         IF (zmat%l_real) THEN
     386             :                         !                                                       w_n(i)=w_n(i)+zMat%data_r(j,i)*zMat%data_r(k,i)*smat_unfold%data_r(j,k)
     387           0 :                                                                                 w_n(i)=w_n(i)+zMat%data_r(j,i)*zMat_s%data_r(j,i)
     388             :                                                                         ELSE
     389             :                         !                                                       w_n_c(i)=w_n_c(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(k,i)*smat_unfold%data_c(j,k)
     390           0 :                                                                                 w_n_c(i)=w_n_c(i)+CONJG(zMat%data_c(j,i))*zMat_s%data_c(j,i)
     391             :                                                                         END IF
     392             :                         !                                       END DO
     393             :                                                         END IF
     394             :                                                 END DO
     395             :                                         END DO
     396             :                                 END DO
     397             :                         END DO
     398             : !--------------------------LO's finished----------------
     399             :                 END IF
     400             : !               IF (method_rubel) THEN
     401           0 :                 IF (write_to_file) THEN
     402           0 :                         IF (zmat%l_real) THEN
     403           0 :                                 IF (w_n(i)/w_n_sum(i)<0) w_n(i)=0   ! delete negative entries
     404           0 :                                 IF (jsp==1) write(679,'(3f15.8)') kpts%sc_list(10,i_kpt), ((eig(i)-results%ef)*hartree_to_ev_const),w_n(i)/w_n_sum(i)
     405           0 :                                 IF (jsp==2) write(680,'(3f15.8)') kpts%sc_list(10,i_kpt), ((eig(i)-results%ef)*hartree_to_ev_const),w_n(i)/w_n_sum(i)
     406           0 :                                 IF ((w_n(i)/w_n_sum(i)>1).or.(w_n(i)/w_n_sum(i)<0)) write(*,*) 'w_n/sum larger 1 or smaller 0', w_n(i)/w_n_sum(i), 'eigenvalue',eig(i)
     407             :                         ELSE
     408           0 :                                 IF (real(w_n_c(i))<0) w_n_c(i)=0    ! delete negative entries
     409           0 :                                 IF (jsp==1) write(679,'(4f15.8)') kpts%sc_list(10,i_kpt), ((eig(i)-results%ef)*hartree_to_ev_const),w_n_c(i)/w_n_c_sum(i)
     410           0 :                                 IF (jsp==2) write(680,'(4f15.8)') kpts%sc_list(10,i_kpt), ((eig(i)-results%ef)*hartree_to_ev_const),w_n_c(i)/w_n_c_sum(i)
     411           0 :                                 IF ((abs(w_n_c(i)/w_n_c_sum(i))>1).or.(real(w_n_c(i))<0)) write(*,*) 'w_n_c/sum larger 1 or smaller 0', w_n_c(i)/w_n_c_sum(i), 'eigenvalue',eig(i)
     412             :                         END IF
     413             :                 END IF
     414           0 :                 IF (zmat%l_real) THEN
     415           0 :                         IF (w_n(i)/w_n_sum(i)<0) w_n(i)=0   ! delete negative entries
     416           0 :                         unfoldingBuffer(i,i_kpt,jsp)=w_n(i)/w_n_sum(i)
     417           0 :                         IF ((w_n(i)/w_n_sum(i)>1).or.(w_n(i)/w_n_sum(i)<0)) write(*,*) 'w_n/sum larger 1 or smaller 0', w_n(i)/w_n_sum(i), 'eigenvalue',eig(i)
     418             :                 ELSE
     419           0 :                         IF (real(w_n_c(i))<0) w_n_c(i)=0    ! delete negative entries
     420           0 :                         unfoldingBuffer(i,i_kpt,jsp)=w_n_c(i)/w_n_c_sum(i)
     421           0 :                         IF ((abs(w_n_c(i)/w_n_c_sum(i))>1).or.(real(w_n_c(i))<0)) write(*,*) 'w_n_c/sum larger 1 or smaller 0', w_n_c(i)/w_n_c_sum(i), 'eigenvalue',eig(i)
     422             :                 END IF
     423             : !               ELSE
     424             : !                       IF (zmat%l_real) THEN
     425             : !                               IF (jsp==1) write(679,'(3f15.8)') kpt_dist, ((eig(i)-results%ef)*hartree_to_ev_const),w_n(i)
     426             : !                               IF (jsp==2) write(680,'(3f15.8)') kpt_dist, ((eig(i)-results%ef)*hartree_to_ev_const),w_n(i)
     427             : !                               IF ((w_n(i)>1).or.(w_n(i)<0)) write(*,*) 'w_n larger 1 or smaller 0', w_n(i), 'eigenvalue',eig(i)
     428             : !                       ELSE
     429             : !                               IF (jsp==1) write(679,'(4f15.8)') kpt_dist, ((eig(i)-results%ef)*hartree_to_ev_const),w_n_c(i)
     430             : !                               IF (jsp==2) write(680,'(4f15.8)') kpt_dist, ((eig(i)-results%ef)*hartree_to_ev_const),w_n_c(i)
     431             : !                               IF ((abs(w_n_c(i))>1).or.(real(w_n_c(i))<0)) write(*,*) 'w_n_c larger 1 or smaller 0', w_n_c(i), 'eigenvalue',eig(i)
     432             : !                       END IF
     433             : !               END IF                  
     434             :         END DO
     435             :        !$omp end do
     436             :        !$omp end parallel
     437           0 :         write (*,*) 'finished',i_kpt
     438           0 :         IF (i_kpt==kpts%nkpt) THEN
     439           0 :                 IF (write_to_file .AND. jsp==1) CLOSE (679)
     440           0 :                 IF (jsp==input%jspins) THEN
     441           0 :                         IF (write_to_file .AND. jsp==2) CLOSE (680)
     442             :                         !kpts%bk(:,:)=kpts%sc_list(11:13,:)
     443           0 :                         write(*,*) 'Unfolded Bandstructure calculated succesfully, calledby=calculate_plot_w_n'
     444             :                         !CALL juDFT_error('Unfolded Bandstructure created succesfully - use band_sc.gnu to plot', calledby='calculate_plot_w_n')
     445             : 
     446             :                 END IF
     447             :         END IF
     448           0 :  END SUBROUTINE
     449             : 
     450             :         
     451           0 : SUBROUTINE write_band_sc(kpts,results,eFermiPrev)
     452             :      USE m_types
     453             :      USE m_juDFT
     454             :      USE m_constants
     455             :      IMPLICIT NONE
     456             :         TYPE(t_results),INTENT(IN)  :: results
     457             :         TYPE(t_kpts),INTENT(IN)     :: kpts
     458             :         REAL, INTENT(IN) :: eFermiPrev
     459             :         INTEGER :: i,i_kpt,jsp
     460             : 
     461           0 :         OPEN (679,file='bands_sc.1',status='unknown') !This is kind of my birthday 6 july 1992 (S.R.)
     462           0 :         IF (SIZE(results%unfolding_weights,3)==2) OPEN (680,file='bands_sc.2',status='unknown')
     463           0 :         DO jsp=1,SIZE(results%unfolding_weights,3)
     464           0 :                 DO i_kpt=1,SIZE(results%unfolding_weights,2)
     465           0 :                         DO i=1,results%neig(i_kpt,jsp)
     466           0 :                                 IF (jsp==1) write(679,'(4f15.8)') kpts%sc_list(10,i_kpt), ((results%eig(i,i_kpt,1)-eFermiPrev)*hartree_to_ev_const),results%unfolding_weights(i,i_kpt,1)
     467           0 :                                 IF (jsp==2) write(680,'(4f15.8)') kpts%sc_list(10,i_kpt), ((results%eig(i,i_kpt,2)-eFermiPrev)*hartree_to_ev_const),results%unfolding_weights(i,i_kpt,2)
     468             :                         END DO
     469             :                 END DO
     470             :         END DO
     471           0 :         CLOSE (679)
     472           0 :         IF (SIZE(results%unfolding_weights,3)==2) CLOSE (680)
     473           0 :         write(*,*) 'Unfolded Bandstructure written succesfully - use band_sc.gnu to plot, calledby=write_band_sc',eFermiPrev
     474           0 : END SUBROUTINE
     475             :         
     476           0 :       SUBROUTINE write_gnu_sc(nosyp,d,ssy,input)
     477             :         USE m_types
     478             :         USE m_juDFT
     479             :       IMPLICIT NONE
     480             : 
     481             :       TYPE(t_input),INTENT(IN) :: input
     482             :       INTEGER, INTENT (IN) :: nosyp
     483             :       REAL,    INTENT (IN) :: d(nosyp)
     484             :       CHARACTER(len=1), INTENT (IN) :: ssy(nosyp)
     485             :       
     486             :       INTEGER n,aoff,adel
     487             :       CHARACTER(LEN=200) tempTitle
     488           0 :       aoff = iachar('a')-1
     489           0 :       adel = iachar('a')-iachar('A')
     490             :       !write(*,*) aoff,adel 
     491             : 
     492           0 :       OPEN (27,file='band_sc.gnu',status='unknown')
     493           0 :       WRITE (27,*) 'reset'
     494           0 :       WRITE (27,900)
     495           0 :       WRITE (27,901)
     496           0 :       WRITE (27,902)
     497           0 :       WRITE (27,903)
     498           0 :       WRITE(tempTitle,'(10a)') input%comment
     499           0 :       IF(TRIM(ADJUSTL(tempTitle)).EQ.'') THEN
     500           0 :          tempTitle = "Fleur Bandstructure"
     501             :       END IF
     502           0 :       WRITE (27,904) TRIM(ADJUSTL(tempTitle))
     503           0 :       DO n = 1, nosyp
     504           0 :         WRITE (27,905) d(n),d(n)
     505             :       ENDDO
     506           0 :       WRITE (27,906) d(1),d(nosyp)
     507             : !
     508             : ! nomal labels
     509             : !
     510           0 :       IF (iachar(ssy(1)) < aoff ) THEN
     511           0 :         WRITE (27,907) ssy(1),d(1),achar(92)
     512             :       ELSE
     513           0 :         WRITE (27,907) " ",d(1),achar(92)
     514             :       ENDIF
     515           0 :       DO n = 2, nosyp-1
     516           0 :         IF (iachar(ssy(n)) < aoff ) THEN 
     517           0 :           WRITE (27,908) ssy(n),d(n),achar(92)
     518             :         ELSE
     519           0 :           WRITE (27,908) " ",d(n),achar(92)
     520             :         ENDIF
     521             :       ENDDO
     522           0 :       IF (iachar(ssy(nosyp)) < aoff ) THEN
     523           0 :         WRITE (27,909) ssy(nosyp),d(nosyp)
     524             :       ELSE
     525           0 :         WRITE (27,909) " ",d(nosyp)
     526             :       ENDIF
     527             : !
     528             : ! greek labels
     529             : !
     530           0 :       DO n = 1, nosyp
     531           0 :         IF (iachar(ssy(n)) > aoff ) THEN
     532           0 :           WRITE (27,914) achar(iachar(ssy(n))-adel),d(n)
     533             :         ENDIF
     534             :       ENDDO
     535             : !
     536             : ! now write the rest
     537             : !
     538           0 :       WRITE (27,910)
     539           0 :       WRITE (27,*) 'set palette model RGB'
     540           0 :       WRITE (27,*) 'set palette defined (-2 "black", -1 "white" ,0 "white",',achar(92)
     541           0 :       WRITE (27,*) '0.67 "light-blue",1 "blue")'
     542           0 :       WRITE (27,*) 'set cbrange [-2:1]'
     543           0 :       WRITE (27,*) 'unset colorbox'
     544           0 :       WRITE (27,*) 'size1(x)=0.9*x**(0.4)'
     545           0 :       WRITE (27,*) 'color1(x)=0.3+x/2.4'
     546           0 :       WRITE (27,*) 'size2(x)=0.35*(1-x**(0.01))'
     547           0 :       WRITE (27,*) 'color2(x)=1.15*(x-1)'
     548           0 :       WRITE (27,*) 'e_f=0.000000 #fermi energy is already corrected when using hdf5'
     549           0 :       WRITE (27,911) d(nosyp)+0.00001,achar(92)
     550           0 :       IF (input%jspins == 2) THEN
     551           0 :         WRITE (27,912) achar(92)
     552           0 :         WRITE (27,916) achar(92)
     553             :       END IF
     554           0 :       WRITE (27,913) achar(92)
     555           0 :       WRITE (27,915)
     556           0 :       CLOSE (27)
     557             : 
     558             :  900  FORMAT ('set terminal postscript enhanced color "Times-Roman" 20')
     559             :  901  FORMAT ('set xlabel ""')
     560             :  902  FORMAT ('set ylabel "E - E_F (eV)"')
     561             :  903  FORMAT ('set nokey')
     562             :  904  FORMAT ('set title "',a,'"')
     563             :  905  FORMAT ('set arrow from',f9.5,', -9.0 to',f9.5,',  5.0 nohead')
     564             :  906  FORMAT ('set arrow from',f9.5,', 0.0 to',f9.5,', 0.0 nohead lt 3')
     565             :  907  FORMAT ('set xtics ("',a1,'"',f9.5,', ',a)
     566             :  908  FORMAT ('           "',a1,'"',f9.5,', ',a)
     567             :  909  FORMAT ('           "',a1,'"',f9.5,'  )')
     568             :  910  FORMAT ('set ytics -8,2,4')
     569             :  911  FORMAT ('plot [0:',f9.5,'] [-9:5] ',a)
     570             :  912  FORMAT ('"bands_sc.2" using 1:($2-e_f):(size1($3)):(color1($3))  w p pt 7 ps variable lc palette, ',a)
     571             :  916  FORMAT ('"bands_sc.2" using 1:($2-e_f):(size2($3)):(color2($3)) w p pt 7 ps variable lc palette,',a)
     572             :  913  FORMAT ('"bands_sc.1" using 1:($2-e_f):(size1($3)):(color1($3))  w p pt 7 ps variable lc palette, ',a)
     573             :  915  FORMAT ('"bands_sc.1" using 1:($2-e_f):(size2($3)):(color2($3)) w p pt 7 ps variable lc palette')
     574             :  914  FORMAT ('set label "',a1,'" at ',f9.5,', -9.65 center font "Symbol,20"')
     575           0 :       END SUBROUTINE write_gnu_sc
     576           0 : END MODULE m_unfold_band_kpts

Generated by: LCOV version 1.13