LCOV - code coverage report
Current view: top level - wannier/uhu - wann_write_uHu.F (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 43 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

          Line data    Source code
       1             : c**************************c
       2             : c   write out uHu matrix   c
       3             : c**************************c
       4             :       module m_wann_write_uHu
       5             :       contains
       6           0 :       subroutine wann_write_uHu(
       7             :      >               jspin2,l_p0,fullnkpts,nntot,nntot2,wann,
       8           0 :      >               nbnd,bpt,gb,isize,irank,fending,ftype,
       9           0 :      <               uHu_in,nkpt_loc,counts,displs,nnodes,
      10             :      >               l_unformatted,l_symcc,l_check)
      11             :       use m_types
      12             :       use m_wann_uHu_symcheck
      13             : 
      14             :       implicit none
      15             :       integer, intent(in)     :: jspin2
      16             :       logical, intent(in)     :: l_p0,l_unformatted,l_symcc,l_check
      17             :       integer, intent(in)     :: fullnkpts,nkpt_loc
      18             :       integer, intent(in)     :: nntot,nntot2,nnodes
      19             :       type(t_wann),intent(in) :: wann
      20             : 
      21             :       integer, intent(in)     :: nbnd
      22             :       integer, intent(in)     :: bpt(nntot,fullnkpts)
      23             :       integer, intent(in)     :: gb(3,nntot,fullnkpts)
      24             :       integer, intent(in)     :: counts(0:nnodes-1),displs(0:nnodes-1)
      25             : 
      26             :       integer, intent(in)     :: isize,irank
      27             :       
      28             :       CHARACTER(len=12), INTENT(IN) :: fending  !for file ending
      29             :       CHARACTER(len=*),  INTENT(IN) :: ftype
      30             :       complex, intent(inout)  :: uHu_in(nbnd,nbnd,nntot2,nntot,nkpt_loc)
      31             : 
      32           0 :       complex, allocatable :: uHu(:,:,:,:,:)
      33             :       integer          :: ikpt,i,j,length
      34             :       integer          :: ikpt_b,ikpt_b2
      35             :       character(len=3) :: spin12(2)
      36             :       integer          :: cpu_index
      37             :       data   spin12/'WF1' , 'WF2'/
      38             : 
      39             : #ifdef CPP_MPI
      40             :       include 'mpif.h'
      41             :       integer :: ierr(3)
      42             :       integer :: stt(MPI_STATUS_SIZE)
      43             : #include "cpp_double.h"
      44             : #endif
      45             : 
      46           0 :       if(isize.gt.1) then
      47           0 :       if(l_p0) allocate(uHu(nbnd,nbnd,nntot2,nntot,fullnkpts))
      48             : #ifdef CPP_MPI
      49             : c******************************************************
      50             : c     Collect contributions to the mmnk matrix from the
      51             : c     various processors.
      52             : c******************************************************
      53           0 :       length = nbnd*nbnd*nntot2*nntot
      54           0 :       CALL MPI_BARRIER(MPI_COMM_WORLD,ierr)
      55             :       CALL MPI_GATHERV(
      56             :      >       uHu_in,length*nkpt_loc,MPI_DOUBLE_COMPLEX,
      57             :      >       uHu,length*counts,length*displs,MPI_DOUBLE_COMPLEX,
      58           0 :      >       0,MPI_COMM_WORLD,ierr)
      59             : #else
      60             : c      uHu = uHu_in
      61             : #endif
      62             :       endif
      63             : 
      64             : c******************************************************
      65             : c     Write mmnk matrix to file.
      66             : c******************************************************
      67           0 :       if (l_p0) then
      68           0 :        write(*,*)'symmetry-complete uHu: ',l_symcc
      69             :  
      70           0 :        if(l_symcc.and.(nntot.ne.nntot2)) stop 'wann_write_uHu'
      71             : 
      72             :        if(.false. .and. l_symcc) then
      73             :        ! exploit symmetry to complete matrix
      74             :        do ikpt = 1,fullnkpts
      75             :         do ikpt_b = 1,nntot
      76             :          do ikpt_b2 = 1,ikpt_b-1
      77             :           do i=1,nbnd
      78             :            do j=1,nbnd
      79             :             if(isize.gt.1) then
      80             :             uHu(j,i,ikpt_b,ikpt_b2,ikpt)
      81             :      >       = conjg(uHu(i,j,ikpt_b2,ikpt_b,ikpt))
      82             :             else
      83             :             uHu_in(j,i,ikpt_b,ikpt_b2,ikpt)
      84             :      >       = conjg(uHu_in(i,j,ikpt_b2,ikpt_b,ikpt))
      85             :             endif
      86             :            enddo
      87             :           enddo
      88             :          enddo
      89             :         enddo
      90             :        enddo
      91             :        endif
      92             : 
      93           0 :        if(.not.l_unformatted) then
      94             :         open (305,file=spin12(jspin2)//trim(fending)//'.uHu'
      95           0 :      >                               //trim(ftype))
      96           0 :         write (305,*) 'Elements uHu at k+b1 and k+b2'
      97           0 :         write (305,'(3i5)') nbnd,fullnkpts,nntot,nntot2
      98           0 :         do ikpt = 1,fullnkpts
      99           0 :          do ikpt_b = 1,nntot
     100           0 :           do ikpt_b2 = 1,nntot2
     101           0 :              write(305,'(i6,i6,i6)')ikpt,ikpt_b,ikpt_b2
     102           0 :            do i = 1,nbnd
     103           0 :             do j = 1,nbnd
     104           0 :              if(isize.gt.1) then
     105             :              write (305,'(2f24.18)')
     106           0 :      &          real(uHu(j,i,ikpt_b2,ikpt_b,ikpt)),
     107           0 :      &         -aimag(uHu(j,i,ikpt_b2,ikpt_b,ikpt))
     108             :              else
     109             :              write (305,'(2f24.18)')
     110           0 :      &          real(uHu_in(j,i,ikpt_b2,ikpt_b,ikpt)),
     111           0 :      &         -aimag(uHu_in(j,i,ikpt_b2,ikpt_b,ikpt))
     112             :              endif
     113             :             enddo
     114             :            enddo
     115             :           enddo
     116             :          enddo
     117             :         enddo !ikpt
     118           0 :         close (305)
     119             :        else
     120             :         open (305,file=spin12(jspin2)//trim(fending)//'.uHu'
     121           0 :      >                               //trim(ftype),form='unformatted')
     122           0 :         write (305) nbnd,fullnkpts,nntot,nntot2
     123           0 :         write (305) bpt,gb
     124           0 :         if(isize.gt.1) then
     125           0 :         write (305) conjg(uHu)
     126             :         else
     127           0 :         write (305) conjg(uHu_in)
     128             :         endif
     129           0 :         close (305)
     130             :        endif
     131             : 
     132           0 :        if((trim(ftype).ne.'_kq').and.l_check) then
     133           0 :         write(*,*)'perform symcheck...'
     134           0 :         if(isize.gt.1) then
     135           0 :            CALL wann_uHu_symcheck(uHu,nbnd,nntot,nntot2,fullnkpts)
     136             :         else
     137           0 :            CALL wann_uHu_symcheck(uHu_in,nbnd,nntot,nntot2,fullnkpts)
     138             :         endif
     139             :        endif
     140             : 
     141             :       endif !l_p0
     142             : 
     143           0 :       if(allocated(uHu)) deallocate( uHu )
     144             : 
     145             : #ifdef CPP_MPI
     146           0 :       CALL MPI_BARRIER(MPI_COMM_WORLD,ierr)
     147             : #endif
     148             : 
     149           0 :       end subroutine wann_write_uHu
     150             :       end module m_wann_write_uHu

Generated by: LCOV version 1.13